From 439274fea64852eb76f7eacd564516c686633168 Mon Sep 17 00:00:00 2001 From: Jason Sarich Date: Tue, 14 Aug 2018 11:13:49 -0500 Subject: [PATCH 001/467] edit clm,cam builds to allow moab interface --- components/eam/bld/config_files/definition.xml | 4 ++-- components/eam/bld/configure | 2 +- components/eam/cime_config/buildnml | 1 + components/elm/bld/config_files/config_definition.xml | 2 +- 4 files changed, 5 insertions(+), 4 deletions(-) diff --git a/components/eam/bld/config_files/definition.xml b/components/eam/bld/config_files/definition.xml index fa1cbff53b43..d176da1c1609 100644 --- a/components/eam/bld/config_files/definition.xml +++ b/components/eam/bld/config_files/definition.xml @@ -23,8 +23,8 @@ are specified as a comma separated list with no embedded white space. Switch specifies whether CAM is being built by the CCSM sequential scripts. 0 => no, 1 => yes. - -Component interfaces: mct or esmf. Default: mct. + +Component interfaces: mct, esmf, or moab. Default: mct. Dynamics package: eul, sld, fv, or se. diff --git a/components/eam/bld/configure b/components/eam/bld/configure index d9d6243d3403..6306efb1d782 100755 --- a/components/eam/bld/configure +++ b/components/eam/bld/configure @@ -130,7 +130,7 @@ OPTIONS clubb_single_prec (Run CLUBB in single precision) -co2_cycle This option is meant to be used with the -ccsm_seq option. It modifies the EAM configuration by increasing the number of advected constituents by 4. - -comp_intf Specify the component interfaces [mct | esmf] (default: mct). + -comp_intf Specify the component interfaces [mct | esmf | moab] (default: mct). -cppdefs A string of user specified CPP defines. Appended to Makefile defaults. E.g. -cppdefs '-DVAR1 -DVAR2' -dyn Build EAM with specified dynamical core [eul | sld | fv | se]. diff --git a/components/eam/cime_config/buildnml b/components/eam/cime_config/buildnml index ac2970eb30fe..cc634dae4741 100755 --- a/components/eam/cime_config/buildnml +++ b/components/eam/cime_config/buildnml @@ -90,6 +90,7 @@ def buildnml(case, caseroot, compname): comp = "" if comp_interface == "mct": comp = "mct" if comp_interface == "esmf": comp = "esmf" + if comp_interface == "moab": comp = "moab" cam_lib_dirs = "-cosp_libdir {}/atm/obj/cosp".format(exeroot) if "cosp" in cam_config_opts else "" diff --git a/components/elm/bld/config_files/config_definition.xml b/components/elm/bld/config_files/config_definition.xml index bc9bfd6481f5..043799502fd4 100644 --- a/components/elm/bld/config_files/config_definition.xml +++ b/components/elm/bld/config_files/config_definition.xml @@ -18,7 +18,7 @@ Root directory of CLM source distribution (directory above CLM configure). Component framework interface to use From 75b36527401923435e8213304293d3d4fb7add42 Mon Sep 17 00:00:00 2001 From: Jason Sarich Date: Tue, 14 Aug 2018 11:47:21 -0500 Subject: [PATCH 002/467] add iulian's changes --- components/eam/src/control/cam_comp.F90 | 15 + components/eam/src/cpl/atm_comp_mct.F90 | 5 + components/eam/src/dynamics/se/dyn_comp.F90 | 35 ++ components/eam/src/physics/cam/phys_grid.F90 | 21 + .../homme/src/share/prim_driver_base.F90 | 15 + components/homme/src/tool/semoab_mod.F90 | 565 ++++++++++++++++++ components/mpas-ocean/driver/ocn_comp_mct.F | 8 +- 7 files changed, 663 insertions(+), 1 deletion(-) create mode 100644 components/homme/src/tool/semoab_mod.F90 diff --git a/components/eam/src/control/cam_comp.F90 b/components/eam/src/control/cam_comp.F90 index e0a7ea8fb5db..e1df6483b04c 100644 --- a/components/eam/src/control/cam_comp.F90 +++ b/components/eam/src/control/cam_comp.F90 @@ -21,6 +21,10 @@ module cam_comp use cam_logfile, only: iulog use physics_buffer, only: physics_buffer_desc +#ifdef HAVE_MOAB + use semoab_mod, only: moab_export_data +#endif + implicit none private save @@ -33,6 +37,9 @@ module cam_comp public cam_run3 ! CAM run method phase 3 public cam_run4 ! CAM run method phase 4 public cam_final ! CAM Finalization +#ifdef HAVE_MOAB + public cam_moab_export ! load data from cam dynamics to moab api +#endif ! ! Private module data ! @@ -420,6 +427,14 @@ subroutine cam_run4( cam_out, cam_in, rstwr, nlend, & end subroutine cam_run4 +#ifdef HAVE_MOAB +subroutine cam_moab_export() ! load data from cam dynamics to moab api + ! + call moab_export_data(dyn_out%elem) +end subroutine cam_moab_export +#endif + + ! !----------------------------------------------------------------------- ! diff --git a/components/eam/src/cpl/atm_comp_mct.F90 b/components/eam/src/cpl/atm_comp_mct.F90 index 3849b97b2d82..f7af376c3c1e 100644 --- a/components/eam/src/cpl/atm_comp_mct.F90 +++ b/components/eam/src/cpl/atm_comp_mct.F90 @@ -585,6 +585,11 @@ subroutine atm_run_mct( EClock, cdata_a, x2a_a, a2x_a) end do +#ifdef HAVE_MOAB + ! move method out of the do while (.not. do send) loop; do not send yet + call cam_moab_export() +#endif + ! Get time of next radiation calculation - albedos will need to be ! calculated by each surface model at this time diff --git a/components/eam/src/dynamics/se/dyn_comp.F90 b/components/eam/src/dynamics/se/dyn_comp.F90 index 19e9a57aaa1b..2b8570dd3638 100644 --- a/components/eam/src/dynamics/se/dyn_comp.F90 +++ b/components/eam/src/dynamics/se/dyn_comp.F90 @@ -102,6 +102,11 @@ subroutine dyn_init1(fh, NLFileName, dyn_in, dyn_out) use cam_control_mod, only: moist_physics use cam_abortutils, only : endrun +#ifdef HAVE_MOAB + use seq_comm_mct, only: MHID, MHFID ! id of homme moab coarse and fine applications + use seq_comm_mct, only: ATMID +#endif + ! PARAMETERS: type(file_desc_t), intent(in) :: fh ! PIO file handle for initial or restart file character(len=*), intent(in) :: NLFileName @@ -112,6 +117,12 @@ subroutine dyn_init1(fh, NLFileName, dyn_in, dyn_out) integer :: npes_se integer :: npes_se_stride +#ifdef HAVE_MOAB + integer, external :: iMOAB_RegisterFortranApplication + integer :: ierr, ATM_ID1 + character*32 appname +#endif + !---------------------------------------------------------------------- ! Initialize dynamics grid variables @@ -146,6 +157,30 @@ subroutine dyn_init1(fh, NLFileName, dyn_in, dyn_out) #endif if(par%dynproc) then + +#ifdef HAVE_MOAB + appname="HM_COARSE"//CHAR(0) + ATM_ID1 = ATMID(1) ! first atmosphere instance; it should be 5 + ierr = iMOAB_RegisterFortranApplication(appname, par%comm, ATM_ID1, MHID) + if (ierr > 0 ) & + call endrun('Error: cannot register moab app') + if(par%masterproc) then + write(iulog,*) " " + write(iulog,*) "register MOAB app:", trim(appname), " MHID=", MHID + write(iulog,*) " " + endif + appname="HM_FINE"//CHAR(0) + ATM_ID1 = 119 + ierr = iMOAB_RegisterFortranApplication(appname, par%comm, ATM_ID1, MHFID) + if (ierr > 0 ) & + call endrun('Error: cannot register moab app for fine mesh') + if(par%masterproc) then + write(iulog,*) " " + write(iulog,*) "register MOAB app:", trim(appname), " MHFID=", MHFID + write(iulog,*) " " + endif +#endif + call prim_init1(elem,par,dom_mt,TimeLevel) dyn_in%elem => elem diff --git a/components/eam/src/physics/cam/phys_grid.F90 b/components/eam/src/physics/cam/phys_grid.F90 index 9d22ce7c0e1c..3657326745ea 100644 --- a/components/eam/src/physics/cam/phys_grid.F90 +++ b/components/eam/src/physics/cam/phys_grid.F90 @@ -103,6 +103,8 @@ module phys_grid use cam_abortutils, only: endrun use perf_mod use cam_logfile, only: iulog + ! debug chunks + use shr_file_mod, only: shr_file_getUnit, shr_file_freeUnit use scamMod, only: single_column, scmlat, scmlon use shr_const_mod, only: SHR_CONST_PI use dycore, only: dycore_is @@ -472,6 +474,11 @@ subroutine phys_grid_init( ) logical :: unstructured real(r8) :: lonmin, latmin +! debug chunks + integer :: unitn + character (len=32) localmeshfile, lnum +! debug + #if ( defined _OPENMP ) integer omp_get_max_threads external omp_get_max_threads @@ -1366,6 +1373,20 @@ subroutine phys_grid_init( ) deallocate(pcols_proc) deallocate(npthreads) + if (masterproc) then + unitn = shr_file_getUnit() + + localmeshfile = 'chunks_on_proc.txt' + open( unitn, file=trim(localmeshfile)) + do cid = 1, nchunks + ncols = chunks(cid)%ncols + write (unitn, *)chunks(cid)%owner, chunks(cid)%lcid, ncols, (chunks(cid)%gcol(i), i=1, ncols) + enddo + + close(unitn) + call shr_file_freeUnit( unitn ) + endif + call t_stopf("phys_grid_init") call t_adj_detailf(+2) return diff --git a/components/homme/src/share/prim_driver_base.F90 b/components/homme/src/share/prim_driver_base.F90 index bbdaf39d6692..3703b146c6bc 100644 --- a/components/homme/src/share/prim_driver_base.F90 +++ b/components/homme/src/share/prim_driver_base.F90 @@ -279,6 +279,10 @@ subroutine prim_init1_geometry(elem, par, dom_mt) use physical_constants, only : dd_pi ! -------------------------------- +#ifdef HAVE_MOAB + use semoab_mod, only : create_moab_mesh_fine +#endif + implicit none ! ! Locals @@ -702,6 +706,17 @@ subroutine prim_init1_buffers (elem,par) integer :: edgesz, sendsz, recvsz, n, den + allocate(dom_mt(0:hthreads-1)) + do ith=0,hthreads-1 + dom_mt(ith)=decompose(1,nelemd,hthreads,ith) + end do + ith=0 + nets=1 + nete=nelemd +#ifdef HAVE_MOAB + call create_moab_mesh_fine(par, elem, nets, nete) +#endif + call prim_advance_init1(par,elem,integration) #ifdef TRILINOS call prim_implicit_init(par, elem) diff --git a/components/homme/src/tool/semoab_mod.F90 b/components/homme/src/tool/semoab_mod.F90 new file mode 100644 index 000000000000..3cd63d3cc406 --- /dev/null +++ b/components/homme/src/tool/semoab_mod.F90 @@ -0,0 +1,565 @@ +#ifdef HAVE_CONFIG_H +#include "config.h" +#endif + + +module semoab_mod + + use kinds, only : real_kind, iulog, long_kind, int_kind +! use edge_mod, only : ghostbuffertr_t, initghostbufferTR, freeghostbuffertr, & +! ghostVpack, ghostVunpack, edgebuffer_t, initEdgebuffer + + use dimensions_mod, only: nelem, ne, np, nlev + use element_mod, only : element_t + use parallel_mod, only : parallel_t + + use m_MergeSorts, only: IndexSet, IndexSort + + use cam_grid_support, only: iMap + use cam_abortutils, only : endrun + + use seq_comm_mct, only: MHID, MHFID ! app id on moab side, for homme moab coarse and fine mesh + + implicit none + + save + + integer local_map(np,np) ! what is the index of gll point (i,j) in a local moabconn(start: start+(np-1)*(np-1)*4-1) + integer, target, allocatable :: moabconn(:) ! will have the connectivity in terms of local index in verts + integer num_calls_export + +#include "moab/MOABConfig.h" + +contains + + subroutine create_moab_mesh_fine(par, elem, nets, nete) + + use ISO_C_BINDING + use coordinate_systems_mod, only : cartesian3D_t, spherical_to_cart + type (element_t), intent(inout) :: elem(:) + + type (parallel_t) , intent(in) :: par + + integer, intent(in) :: nets ! starting thread element number (private) + integer, intent(in) :: nete + + integer ierr, i, j, ie, iv, block_ID, k, numvals + integer icol, irow, je, linx ! local indices in fine el connect + + real(kind=real_kind), allocatable, target :: moab_vert_coords(:) + + integer moab_dim_cquads, ix, idx, nverts, nverts_c ! used for indexing in loops; nverts will have the number of local vertices + + integer nelemd ! do not confuse this with dimensions_mod::nelemd + +! do we really need this? + integer , external :: iMOAB_CreateVertices, iMOAB_WriteMesh, iMOAB_CreateElements, & + iMOAB_ResolveSharedEntities, iMOAB_UpdateMeshInfo, iMOAB_DefineTagStorage, & + iMOAB_SetIntTagStorage, iMOAB_ReduceTagsMax, iMOAB_GetIntTagStorage + + integer(kind=long_kind), dimension(:), allocatable :: gdofv + integer, dimension(:), allocatable :: indx ! this will be ordered + + ! this will be moab vertex handle locally + integer, target, allocatable :: moabvh(:), vdone(:), elemids(:), vgids(:), gdofel(:) + integer, target, allocatable :: vdone_c(:), moabconn_c(:), moabvh_c(:) + integer currentval, dimcoord, dimen, num_el, mbtype, nve + + character*100 outfile, wopts, localmeshfile, lnum, tagname, newtagg + integer tagtype, numco, tag_sto_len, ent_type, tagindex + type (cartesian3D_t) :: cart + integer igcol, ii + + ! for np=4, + ! 28, 32, 36, 35 + ! 25, 29, 33, 34 + ! j | 13, 17, 21, 22 + ! 1, 5, 9, 10 + !(1,1) i-> + + ! character*100 outfile, wopts, localmeshfile, lnum, tagname + ! integer tagtype, numco, tag_sto_len, ent_type, tagindex + do j=1,np-1 + do i =1, np-1 + ix = (j-1)*(np-1)+i-1 + local_map(i,j) = ix*4 + 1 + enddo + enddo + do j=1, np-1 + i = j + local_map(np, j) = ((np-1)*j-1)*4 + 2 + local_map(i, np) = ( (np-1)*(np-2)+i-1)*4 + 4 + enddo + local_map(np, np) = ((np-1)*(np-1)-1)*4 + 3 + + nelemd = (nete-nets+1)*(np-1)*(np-1) + moab_dim_cquads = (nete-nets+1)*4*(np-1)*(np-1) + + if(par%masterproc) then + write (iulog, *) " MOAB: semoab_mod module: create_moab_mesh_fine; on processor " , par%rank ," elements: " , nets, nete + endif + + allocate(gdofv(moab_dim_cquads)) + allocate(elemids(nelemd)) + + k=0 ! will be the index for element global dofs + do ie=nets,nete + do j=1,np-1 + do i=1,np-1 + ix = (ie-nets)*(np-1)*(np-1)+(j-1)*(np-1)+i-1 + gdofv(ix*4+1) = elem(ie)%gdofP(i,j) + gdofv(ix*4+2) = elem(ie)%gdofP(i+1,j) + gdofv(ix*4+3) = elem(ie)%gdofP(i+1,j+1) + gdofv(ix*4+4) = elem(ie)%gdofP(i,j+1) + elemids(ix+1) = (elem(ie)%GlobalId-1)*(np-1)*(np-1)+(j-1)*(np-1)+i + enddo + enddo + enddo + +! order according to global dofs + allocate(indx(moab_dim_cquads)) + call IndexSet(moab_dim_cquads, indx) + call IndexSort(moab_dim_cquads, indx, gdofv, descend=.false.) +! after sort, gdofv( indx(i)) < gdofv( indx(i+1) ) + allocate(moabvh(moab_dim_cquads)) + + allocate(moabconn(moab_dim_cquads)) + idx=1 + currentval = gdofv( indx(1)) + do ix=1,moab_dim_cquads + if (gdofv(indx(ix)) .ne. currentval ) then + idx=idx+1 + currentval = gdofv(indx(ix)) + endif + moabvh(ix) = idx ! the vertex in connectivity array will be at this local index + ! this will be the moab connectivity + moabconn(indx(ix)) = idx + enddo + + nverts = idx + if(par%masterproc) then + write (iulog, *) " MOAB: there are ", nverts, " local vertices on master task ", currentval, " is the max local gdof" + endif + allocate(moab_vert_coords(3*nverts) ) + allocate(vdone(nverts)) + vdone = 0; + currentval = gdofv( indx(1)) ! start over to identify coordinates of the vertices + + do ix=1,moab_dim_cquads + idx = indx(ix) ! index in initial array, vertices in all fine quads + k = (idx-1)/(4*(np-1)*(np-1)) ! index of coarse quad, locally, starts at 0 + ie = nets + k ! this is the element number; starts at nets + je = ( idx -1 -k*(np-1)*(np-1)*4 ) / 4 + 1 ! local fine quad in coarse, 1 to (np-1) ^ 2 + irow = (je-1)/(np-1)+1 + icol = je - (np-1)*(irow-1) + linx = idx - k*(np-1)*(np-1)*4 -(je-1)*4 ! this should be 1, 2, 3, 4 + if( linx == 1) then + j = irow + i = icol + else if (linx == 2) then + j = irow + i = icol + 1 + else if (linx == 3) then + j = irow + 1 + i = icol + 1 + else ! linx == 4 + j = irow + 1 + i = icol + endif + + iv = moabvh(ix) + if (vdone(iv) .eq. 0) then + cart = spherical_to_cart (elem(ie)%spherep(i,j) ) + moab_vert_coords ( 3*(iv-1)+1 ) = cart%x + moab_vert_coords ( 3*(iv-1)+2 ) = cart%y + moab_vert_coords ( 3*(iv-1)+3 ) = cart%z + vdone(iv) = gdofv(indx(ix)) ! this will be now our tag used for resolving shared entities ! convert to int, from long int + endif + + enddo + + dimcoord = nverts*3 + dimen = 3 + ierr = iMOAB_CreateVertices(MHFID, dimcoord, dimen, moab_vert_coords) + if (ierr > 0 ) & + call endrun('Error: fail to create MOAB vertices ') + + num_el = nelemd + mbtype = 3 ! quadrilateral + nve = 4; + block_ID = 200 ! this will be for coarse mesh + + ierr = iMOAB_CreateElements( MHFID, num_el, mbtype, nve, moabconn, block_ID ); + if (ierr > 0 ) & + call endrun('Error: fail to create MOAB elements') + ! nverts: num vertices; vdone will store now the markers used in global resolve + ! for this particular problem, markers are the global dofs at corner nodes +! set the global id for vertices +! first, retrieve the tag + tagname='GDOF'//CHAR(0) + tagtype = 0 ! dense, integer + numco = 1 + ierr = iMOAB_DefineTagStorage(MHFID, tagname, tagtype, numco, tagindex ) + if (ierr > 0 ) & + call endrun('Error: fail to retrieve global id tag') + ! now set the values + ent_type = 0 ! vertex type + ierr = iMOAB_SetIntTagStorage ( MHFID, tagname, nverts , ent_type, vdone) + if (ierr > 0 ) & + call endrun('Error: fail to set marker id tag for vertices') + + ierr = iMOAB_ResolveSharedEntities( MHFID, nverts, vdone ); + if (ierr > 0 ) & + call endrun('Error: fail to resolve shared entities') + + vdone = -1 ! reuse vdone for the new tag, GLOBAL_ID (actual tag that we want to store global dof ) +! use element offset for actual global dofs + ! tagtype = 0 ! dense, integer + ! numco = 1 + newtagg='GLOBAL_ID'//CHAR(0) + ierr = iMOAB_DefineTagStorage(MHFID, newtagg, tagtype, numco, tagindex ) + if (ierr > 0 ) & + call endrun('Error: fail to create new GDOF tag') + do ie=nets,nete + do ii=1,elem(ie)%idxp%NumUniquePts + i=elem(ie)%idxp%ia(ii) + j=elem(ie)%idxp%ja(ii) + igcol = elem(ie)%idxp%UniquePtoffset+ii-1 + ix = local_map(i,j) + idx = moabconn((ie-1)*(np-1)*(np-1)*4 + ix) ! should + vdone ( idx ) = igcol + end do + end do + ! now set the values + ent_type = 0 ! vertex type + ierr = iMOAB_SetIntTagStorage ( MHFID, newtagg, nverts , ent_type, vdone) + if (ierr > 0 ) & + call endrun('Error: fail to set global dof tag for vertices') + + ierr = iMOAB_ReduceTagsMax ( MHFID, tagindex, ent_type) + if (ierr > 0 ) & + call endrun('Error: fail to reduce max tag') + + ! set global id tag for elements + ent_type = 1 ! now set the global id tag on elements + ierr = iMOAB_SetIntTagStorage ( MHFID, newtagg, nelemd , ent_type, elemids) + if (ierr > 0 ) & + call endrun('Error: fail to set global id tag for elements') + +! now, after reduction, we can get the actual global ids for each vertex in the fine mesh +! before, some vertices that were owned in MOAB but not owned in CAM did not have the right global ID tag +! so vdone will be now correct on every task (no -1 anymore ) + ent_type = 0 ! vertex type + allocate(vgids(nverts)) + ierr = iMOAB_GetIntTagStorage ( MHFID, newtagg, nverts , ent_type, vgids) + if (ierr > 0 ) & + call endrun('Error: fail to retrieve GLOBAL ID on each task') + +! write in serial, on each task, before ghosting + if (par%rank .lt. 4) then + write(lnum,"(I0.2)")par%rank + localmeshfile = 'fineh_'//trim(lnum)// '.h5m' // CHAR(0) + wopts = CHAR(0) + ierr = iMOAB_WriteMesh(MHFID, localmeshfile, wopts) + if (ierr > 0 ) & + call endrun('Error: fail to write local mesh file') + endif + + ierr = iMOAB_UpdateMeshInfo(MHFID) + if (ierr > 0 ) & + call endrun('Error: fail to update mesh info') +! write out the mesh file to disk, in parallel + outfile = 'wholeFineATM.h5m'//CHAR(0) + wopts = 'PARALLEL=WRITE_PART'//CHAR(0) + ierr = iMOAB_WriteMesh(MHFID, outfile, wopts) + if (ierr > 0 ) & + call endrun('Error: fail to write the mesh file') + + ! deallocate +! deallocate(moabvh) +! deallocate(moabconn) +! deallocate(vdone) +! deallocate(indx) +! deallocate(elemids) + + + + +! now create the coarse mesh, but the global dofs will come from fine mesh, after solving + nelemd = nete-nets+1 + moab_dim_cquads = (nete-nets+1)*4 + + allocate(gdofel(nelemd*np*np)) + k=0 ! will be the index for element global dofs + do ie=nets,nete + ix = ie-nets + ! + gdofv(ix*4+1) = elem(ie)%gdofP(1,1) + gdofv(ix*4+2) = elem(ie)%gdofP(np,1) + gdofv(ix*4+3) = elem(ie)%gdofP(np,np) + gdofv(ix*4+4) = elem(ie)%gdofP(1,np) + elemids(ix+1) = elem(ie)%GlobalId + enddo +! now original order + +! order according to global dofs +! allocate(indx(moab_dim_cquads)) + call IndexSet(moab_dim_cquads, indx) + call IndexSort(moab_dim_cquads, indx, gdofv, descend=.false.) +! after sort, gdofv( indx(i)) < gdofv( indx(i+1) ) + + allocate(moabvh_c(moab_dim_cquads)) + + allocate(moabconn_c(moab_dim_cquads)) + idx=1 + currentval = gdofv( indx(1)) + do ix=1,moab_dim_cquads + if (gdofv(indx(ix)) .ne. currentval ) then + idx=idx+1 + currentval = gdofv(indx(ix)) + endif + moabvh_c(ix) = idx ! the vertex in connectivity array will be at this local index + ! this will be the moab connectivity + moabconn_c(indx(ix)) = idx + enddo + nverts_c = idx + if(par%masterproc) then + write (iulog, *) " MOAB: there are ", nverts_c, " local vertices on master task, coarse mesh" + endif +! allocate(moab_vert_coords(3*idx) ) + allocate(vdone_c(nverts_c)) + vdone_c = 0; + currentval = gdofv( indx(1)) ! start over to identify coordinates of the vertices + + do ix=1,moab_dim_cquads + i = indx(ix) ! index in initial array + ie = nets+ (i-1)/4 ! this is the element number + j = i - ( i-1)/4*4 ! local index of vertex in element i + iv = moabvh_c(ix) + if (vdone_c(iv) .eq. 0) then + moab_vert_coords ( 3*(iv-1)+1 ) = elem(ie)%corners3d(j)%x + moab_vert_coords ( 3*(iv-1)+2 ) = elem(ie)%corners3d(j)%y + moab_vert_coords ( 3*(iv-1)+3 ) = elem(ie)%corners3d(j)%z + vdone_c(iv) = gdofv(indx(ix)) ! this will be now our tag used for resolving shared entities + endif + + enddo + + dimcoord = nverts_c*3 + dimen = 3 + ierr = iMOAB_CreateVertices(MHID, dimcoord, dimen, moab_vert_coords) + if (ierr > 0 ) & + call endrun('Error: fail to create MOAB vertices ') + + num_el = nete-nets+1 + mbtype = 3 ! quadrilateral + nve = 4; + block_ID = 100 ! this will be for coarse mesh + + ierr = iMOAB_CreateElements( MHID, num_el, mbtype, nve, moabconn_c, block_ID ); + if (ierr > 0 ) & + call endrun('Error: fail to create MOAB elements') + ! idx: num vertices; vdone will store now the markers used in global resolve + ! for this particular problem, markers are the global dofs at corner nodes +! set the global id for vertices +! first, retrieve the tag + tagname='GDOFV'//CHAR(0) + tagtype = 0 ! dense, integer + numco = 1 + ierr = iMOAB_DefineTagStorage(MHID, tagname, tagtype, numco, tagindex ) + if (ierr > 0 ) & + call endrun('Error: fail to retrieve GDOFV id tag') + ierr = iMOAB_DefineTagStorage(MHID, newtagg, tagtype, numco, tagindex ) + if (ierr > 0 ) & + call endrun('Error: fail to retrieve GLOBAL_ID tag on coarse mesh') + ! now set the values + ent_type = 0 ! vertex type + ierr = iMOAB_SetIntTagStorage ( MHID, tagname, nverts_c , ent_type, vdone_c) + if (ierr > 0 ) & + call endrun('Error: fail to set GDOFV tag for vertices') + ! set global id tag for coarse elements, too; they will start at nets, end at nete + ent_type = 1 ! now set the global id tag on elements + ierr = iMOAB_SetIntTagStorage ( MHID, newtagg, nelemd , ent_type, elemids) + if (ierr > 0 ) & + call endrun('Error: fail to set global id tag for vertices') + + ierr = iMOAB_ResolveSharedEntities( MHID, idx, vdone_c ); + if (ierr > 0 ) & + call endrun('Error: fail to resolve shared entities') + +! global dofs are the GLL points are set for each element + tagname='GLOBAL_DOFS'//CHAR(0) + tagtype = 0 ! dense, integer + numco = np*np ! usually, it is 16; each element will have the dofs in order + ierr = iMOAB_DefineTagStorage(MHID, tagname, tagtype, numco, tagindex ) + if (ierr > 0 ) & + call endrun('Error: fail to create global DOFS tag') + ! now set the values + ! set global dofs tag for coarse elements, too; they will start at nets, end at nete + ent_type = 1 ! now set the global id tag on elements + numvals = nelemd*np*np ! input is the total number of values + ! form gdofel from vgids + do ie=1, nelemd + ix = (ie-1)*np*np ! ie: index in coarse element + je = (ie-1) * 4 * (np-1) * (np -1) ! index in moabconn array + ! vgids are global ids for fine vertices (1,nverts) + iv = 1 + do j=1,np + do i=1,np + k = local_map(i,j) + gdofel(ix+iv) = vgids( moabconn( je + k ) ) + iv = iv + 1 + enddo + enddo + ! extract global ids + vdone_c( moabconn_c( (ie-1)*4+1) ) = vgids ( moabconn(je+1 )) + vdone_c( moabconn_c( (ie-1)*4+2) ) = vgids ( moabconn(je+ 4*(np-2)+2 )) ! valid for np = 4, 10 + vdone_c( moabconn_c( (ie-1)*4+3) ) = vgids ( moabconn(je+ 4*((np-1)*(np-1)-1) + 3 )) ! for np = 4, 35 + vdone_c( moabconn_c( (ie-1)*4+4) ) = vgids ( moabconn(je+ 4*(np-2)*(np-1) + 4 )) ! 28 for np = 4 + enddo + ierr = iMOAB_SetIntTagStorage ( MHID, tagname, numvals, ent_type, gdofel) + if (ierr > 0 ) & + call endrun('Error: fail to set globalDOFs tag for coarse elements') + + + ! set the global ids for coarse vertices the same as corresponding fine vertices + ent_type = 0 ! vertex type + ierr = iMOAB_SetIntTagStorage ( MHID, newtagg, nverts_c , ent_type, vdone_c) + + ! create a new tag, for transfer example ; will use it now for temperature on the surface + ! (bottom atm to surface of ocean) + tagname='a2oTAG'//CHAR(0) ! atm to ocean tag + tagtype = 1 ! dense, double + numco = np*np ! usually, it is 16; each element will have the same order as dofs + ierr = iMOAB_DefineTagStorage(MHID, tagname, tagtype, numco, tagindex ) + if (ierr > 0 ) & + call endrun('Error: fail to create atm to ocean tag') + + ! create a new tag, for transfer example ; will use it now for temperature on the surface + ! (bottom atm to surface of ocean); for debugging, use it on fine mesh + tagname='a2oDBG'//CHAR(0) ! atm to ocean tag + tagtype = 1 ! dense, double + numco = 1 ! usually, it is 1; one value per gdof + ierr = iMOAB_DefineTagStorage(MHFID, tagname, tagtype, numco, tagindex ) + if (ierr > 0 ) & + call endrun('Error: fail to create atm to ocean tag') + + +! write in serial, on each task, before ghosting + if (par%rank .lt. 5) then + write(lnum,"(I0.2)")par%rank + localmeshfile = 'owned_'//trim(lnum)// '.h5m' // CHAR(0) + wopts = CHAR(0) + ierr = iMOAB_WriteMesh(MHID, localmeshfile, wopts) + if (ierr > 0 ) & + call endrun('Error: fail to write local mesh file') + endif + + ierr = iMOAB_UpdateMeshInfo(MHID) + if (ierr > 0 ) & + call endrun('Error: fail to update mesh info') +! write out the mesh file to disk, in parallel + outfile = 'wholeATM.h5m'//CHAR(0) + wopts = 'PARALLEL=WRITE_PART'//CHAR(0) + ierr = iMOAB_WriteMesh(MHID, outfile, wopts) + if (ierr > 0 ) & + call endrun('Error: fail to write the mesh file') + + ! initialize + num_calls_export = 0 + + ! deallocate + deallocate(moabvh) +! deallocate(moabconn) keep it , it is useful to set the tag on fine mesh + deallocate(vdone) + deallocate(gdofel) + deallocate(indx) + deallocate(elemids) + deallocate(gdofv) + deallocate(moabvh_c) + deallocate(moabconn_c) + deallocate(vdone_c) +! end copy + + end subroutine create_moab_mesh_fine + + subroutine moab_export_data(elem) + + type(element_t), pointer :: elem(:) + + integer num_elem, ierr + integer nvert(3), nvise(3), nbl(3), nsurf(3), nvisBC(3) + integer, external :: iMOAB_GetMeshInfo, iMOAB_SetDoubleTagStorage, iMOAB_WriteMesh + integer :: size_tag_array, nvalperelem, ie, i, j, je, ix, ent_type, idx + + real(kind=real_kind), allocatable, target :: valuesTag(:) + character*100 outfile, wopts, tagname, lnum + + ! count number of calls + num_calls_export = num_calls_export + 1 + + ierr = iMOAB_GetMeshInfo ( MHID, nvert, nvise, nbl, nsurf, nvisBC ); + ! find out the number of local elements in moab mesh + num_elem = nvise(1) + ! now print the temperature from the state, and set it + nvalperelem = np*np + size_tag_array = nvalperelem*num_elem + !print *, 'num_elem = ', num_elem + !print *, ((local_map(i,j), i=1,np), j=1,np) + !print *, (moabconn(i), i=1,np*np) + ! now load the values on both tags + allocate(valuesTag(size_tag_array)) ! will use the same array for vertex array + + do ie=1,num_elem + do j=1,np + do i=1,np + valuesTag ( (ie-1)*np*np+(j-1)*np + i ) = elem(ie)%state%T(i,j,nlev,1) ! time level 1? + enddo + enddo + enddo + ! set the tag + tagname='a2oTAG'//CHAR(0) ! atm to ocean tag + ent_type = 1 ! element type + ierr = iMOAB_SetDoubleTagStorage ( MHID, tagname, size_tag_array, ent_type, valuesTag) + if (ierr > 0 ) & + call endrun('Error: fail to set a2oTAG tag for coarse elements') + + ! write out the mesh file to disk, in parallel + outfile = 'wholeATM_T.h5m'//CHAR(0) + wopts = 'PARALLEL=WRITE_PART'//CHAR(0) + ierr = iMOAB_WriteMesh(MHID, outfile, wopts) + if (ierr > 0 ) & + call endrun('Error: fail to write the mesh file') + + ! for debugging, set the tag on fine mesh too (for visu) + do ie=1,num_elem + je = (ie-1)*(np-1)*(np-1)*4 + do j=1,np + do i= 1,np + ix = local_map(i,j) + idx = moabconn( je + ix ) ! + valuesTag ( idx ) = elem(ie)%state%T(i,j,nlev,1) + end do + end do + end do + + tagname='a2oDBG'//CHAR(0) ! atm to ocean tag, on fine mesh + ierr = iMOAB_GetMeshInfo ( MHFID, nvert, nvise, nbl, nsurf, nvisBC ); + ent_type = 0 ! vertex type + ierr = iMOAB_SetDoubleTagStorage ( MHFID, tagname, nvert(1), ent_type, valuesTag) + if (ierr > 0 ) & + call endrun('Error: fail to set a2oTAG tag for coarse elements') + + ! write out the mesh file to disk, in parallel + + write(lnum,"(I0.2)")num_calls_export + outfile = 'wholeFineATM_T_'//trim(lnum)// '.h5m' // CHAR(0) + + ierr = iMOAB_WriteMesh(MHFID, outfile, wopts) + if (ierr > 0 ) & + call endrun('Error: fail to write the fine mesh file, with a temperature on it') + + deallocate(valuesTag) + end subroutine moab_export_data + +end module semoab_mod diff --git a/components/mpas-ocean/driver/ocn_comp_mct.F b/components/mpas-ocean/driver/ocn_comp_mct.F index 461b19222d87..bf67672428e1 100644 --- a/components/mpas-ocean/driver/ocn_comp_mct.F +++ b/components/mpas-ocean/driver/ocn_comp_mct.F @@ -37,7 +37,9 @@ module ocn_comp_mct use mpas_dmpar use mpas_constants use mpas_log - +#ifdef HAVE_MOAB + use mpas_moabmesh +#endif use iso_c_binding, only : c_char, c_loc, c_ptr, c_int use mpas_c_interfacing, only : mpas_f_to_c_string, mpas_c_to_f_string @@ -559,6 +561,10 @@ end subroutine xml_stream_get_attributes if ( ierr /= 0 ) then call mpas_log_write('Core init failed for core ' // trim(domain % core % coreName), MPAS_LOG_CRIT) end if +#ifdef HAVE_MOAB + call mpas_moab_instance(domain_ptr) ! should return MPOID .. + call mpas_log_write('initialized MOAB MPAS ocean instance... ') +#endif call t_stopf('mpaso_init2') !----------------------------------------------------------------------- From aa6b39b03662e041ad93be22fbbeec0b1328a4a0 Mon Sep 17 00:00:00 2001 From: Jason Sarich Date: Mon, 10 Sep 2018 13:08:45 -0500 Subject: [PATCH 003/467] fixes to get moab driver working (still mostly copy of mct driver) --- driver-moab/main/cime_comp_mod.F90 | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/driver-moab/main/cime_comp_mod.F90 b/driver-moab/main/cime_comp_mod.F90 index 8694d4188256..b48b235dbcb2 100644 --- a/driver-moab/main/cime_comp_mod.F90 +++ b/driver-moab/main/cime_comp_mod.F90 @@ -3548,7 +3548,8 @@ subroutine cime_run() call t_drvstartf ('CPL:BUDGETF',cplrun=.true.,budget=.true.,barrier=mpicom_CPLID) if (.not. dead_comps) then call seq_diag_print_mct(EClock_d,stop_alarm,budget_inst, & - budget_daily, budget_month, budget_ann, budget_ltann, budget_ltend) + budget_daily, budget_month, budget_ann, budget_ltann,& + budget_ltend, infodata) endif call seq_diag_zero_mct(EClock=EClock_d) From edaddeddee6098f706b3194ac98ef047bac004a6 Mon Sep 17 00:00:00 2001 From: Iulian Date: Mon, 17 Sep 2018 14:45:39 -0500 Subject: [PATCH 004/467] add zoltan dependency if moab is built with zoltan, use graph partitioning for migration ; use moab/MOABConfig.h to see if zoltan is available also, remove MOABConfig from semoab; it is not used there --- components/homme/src/tool/semoab_mod.F90 | 2 -- driver-moab/main/cplcomp_exchange_mod.F90 | 12 +++++++++--- 2 files changed, 9 insertions(+), 5 deletions(-) diff --git a/components/homme/src/tool/semoab_mod.F90 b/components/homme/src/tool/semoab_mod.F90 index 3cd63d3cc406..2426d338ed16 100644 --- a/components/homme/src/tool/semoab_mod.F90 +++ b/components/homme/src/tool/semoab_mod.F90 @@ -27,8 +27,6 @@ module semoab_mod integer local_map(np,np) ! what is the index of gll point (i,j) in a local moabconn(start: start+(np-1)*(np-1)*4-1) integer, target, allocatable :: moabconn(:) ! will have the connectivity in terms of local index in verts integer num_calls_export - -#include "moab/MOABConfig.h" contains diff --git a/driver-moab/main/cplcomp_exchange_mod.F90 b/driver-moab/main/cplcomp_exchange_mod.F90 index b664d2fedfdd..208c3b6957ae 100644 --- a/driver-moab/main/cplcomp_exchange_mod.F90 +++ b/driver-moab/main/cplcomp_exchange_mod.F90 @@ -19,6 +19,7 @@ module cplcomp_exchange_mod implicit none private ! except #include +#include "moab/MOABConfig.h" save !-------------------------------------------------------------------------- @@ -997,7 +998,7 @@ subroutine cplcomp_moab_Init(comp) integer :: ierr character*32 :: appname, outfile, wopts, tagnameProj integer :: maxMH, maxMPO ! max pids for moab apps - integer :: tagtype, numco, tagindex + integer :: tagtype, numco, tagindex, partMethod !----------------------------------------------------- @@ -1011,6 +1012,11 @@ subroutine cplcomp_moab_Init(comp) mpicom_old = comp%mpicom_compid mpicom_join = comp%mpicom_cplcompid + partMethod = 0 ! trivial partitioning +#ifdef MOAB_HAVE_ZOLTAN + partMethod = 1 +#endif + call seq_comm_getinfo(ID_old ,mpicom=mpicom_old) call seq_comm_getinfo(ID_new ,mpicom=mpicom_new) call seq_comm_getinfo(ID_join,mpicom=mpicom_join) @@ -1027,7 +1033,7 @@ subroutine cplcomp_moab_Init(comp) ! now, if on coupler pes, receive mesh; if on comp pes, send mesh if (MPI_COMM_NULL /= mpicom_old ) then ! it means we are on the component pes (atmosphere) ! send mesh to coupler - ierr = iMOAB_SendMesh(mhid, mpicom_join, mpigrp_cplid, id_join); + ierr = iMOAB_SendMesh(mhid, mpicom_join, mpigrp_cplid, id_join, partMethod) endif if (MPI_COMM_NULL /= mpicom_new ) then ! we are on the coupler pes appname = "COUPLE_ATM"//CHAR(0) @@ -1047,7 +1053,7 @@ subroutine cplcomp_moab_Init(comp) if (MPI_COMM_NULL /= mpicom_old ) then ! it means we are on the component pes (atmosphere) ! send mesh to coupler - ierr = iMOAB_SendMesh(mpoid, mpicom_join, mpigrp_cplid, id_join); + ierr = iMOAB_SendMesh(mpoid, mpicom_join, mpigrp_cplid, id_join, partMethod) endif if (MPI_COMM_NULL /= mpicom_new ) then ! we are on the coupler pes appname = "COUPLE_MPASO"//CHAR(0) From 3c00f5e660b0168e6ab2cf494b5a947478466d1d Mon Sep 17 00:00:00 2001 From: Iulian Date: Tue, 23 Oct 2018 17:25:46 -0500 Subject: [PATCH 005/467] migrate projected tag back to ocean pes need to change also the prep_ocn_mod.F90 for the moab driver some semoab changes just to make it easier to debug (more consistency for allocated arrays) --- components/homme/src/tool/semoab_mod.F90 | 39 ++++++++++++----------- driver-moab/main/cime_comp_mod.F90 | 6 ++++ driver-moab/main/cplcomp_exchange_mod.F90 | 11 ++++++- 3 files changed, 37 insertions(+), 19 deletions(-) diff --git a/components/homme/src/tool/semoab_mod.F90 b/components/homme/src/tool/semoab_mod.F90 index 2426d338ed16..f4f070d4ca80 100644 --- a/components/homme/src/tool/semoab_mod.F90 +++ b/components/homme/src/tool/semoab_mod.F90 @@ -25,7 +25,7 @@ module semoab_mod save integer local_map(np,np) ! what is the index of gll point (i,j) in a local moabconn(start: start+(np-1)*(np-1)*4-1) - integer, target, allocatable :: moabconn(:) ! will have the connectivity in terms of local index in verts + integer, allocatable :: moabconn(:) ! will have the connectivity in terms of local index in verts integer num_calls_export contains @@ -44,11 +44,11 @@ subroutine create_moab_mesh_fine(par, elem, nets, nete) integer ierr, i, j, ie, iv, block_ID, k, numvals integer icol, irow, je, linx ! local indices in fine el connect - real(kind=real_kind), allocatable, target :: moab_vert_coords(:) + real(kind=real_kind), allocatable :: moab_vert_coords(:) integer moab_dim_cquads, ix, idx, nverts, nverts_c ! used for indexing in loops; nverts will have the number of local vertices - integer nelemd ! do not confuse this with dimensions_mod::nelemd + integer nelemd2 ! do not confuse this with dimensions_mod::nelemd ! do we really need this? integer , external :: iMOAB_CreateVertices, iMOAB_WriteMesh, iMOAB_CreateElements, & @@ -56,11 +56,12 @@ subroutine create_moab_mesh_fine(par, elem, nets, nete) iMOAB_SetIntTagStorage, iMOAB_ReduceTagsMax, iMOAB_GetIntTagStorage integer(kind=long_kind), dimension(:), allocatable :: gdofv + ! this will be moab vertex handle locally + integer, dimension(:), allocatable :: moabvh integer, dimension(:), allocatable :: indx ! this will be ordered - ! this will be moab vertex handle locally - integer, target, allocatable :: moabvh(:), vdone(:), elemids(:), vgids(:), gdofel(:) - integer, target, allocatable :: vdone_c(:), moabconn_c(:), moabvh_c(:) + integer, dimension(:), allocatable :: vdone, elemids, vgids, gdofel + integer, dimension(:), allocatable :: vdone_c, moabconn_c, moabvh_c integer currentval, dimcoord, dimen, num_el, mbtype, nve character*100 outfile, wopts, localmeshfile, lnum, tagname, newtagg @@ -90,7 +91,7 @@ subroutine create_moab_mesh_fine(par, elem, nets, nete) enddo local_map(np, np) = ((np-1)*(np-1)-1)*4 + 3 - nelemd = (nete-nets+1)*(np-1)*(np-1) + nelemd2 = (nete-nets+1)*(np-1)*(np-1) moab_dim_cquads = (nete-nets+1)*4*(np-1)*(np-1) if(par%masterproc) then @@ -98,7 +99,7 @@ subroutine create_moab_mesh_fine(par, elem, nets, nete) endif allocate(gdofv(moab_dim_cquads)) - allocate(elemids(nelemd)) + allocate(elemids(nelemd2)) k=0 ! will be the index for element global dofs do ie=nets,nete @@ -115,13 +116,15 @@ subroutine create_moab_mesh_fine(par, elem, nets, nete) enddo ! order according to global dofs + + allocate(moabvh(moab_dim_cquads)) allocate(indx(moab_dim_cquads)) + + allocate(moabconn(moab_dim_cquads)) call IndexSet(moab_dim_cquads, indx) call IndexSort(moab_dim_cquads, indx, gdofv, descend=.false.) ! after sort, gdofv( indx(i)) < gdofv( indx(i+1) ) - allocate(moabvh(moab_dim_cquads)) - allocate(moabconn(moab_dim_cquads)) idx=1 currentval = gdofv( indx(1)) do ix=1,moab_dim_cquads @@ -182,7 +185,7 @@ subroutine create_moab_mesh_fine(par, elem, nets, nete) if (ierr > 0 ) & call endrun('Error: fail to create MOAB vertices ') - num_el = nelemd + num_el = nelemd2 mbtype = 3 ! quadrilateral nve = 4; block_ID = 200 ! this will be for coarse mesh @@ -240,7 +243,7 @@ subroutine create_moab_mesh_fine(par, elem, nets, nete) ! set global id tag for elements ent_type = 1 ! now set the global id tag on elements - ierr = iMOAB_SetIntTagStorage ( MHFID, newtagg, nelemd , ent_type, elemids) + ierr = iMOAB_SetIntTagStorage ( MHFID, newtagg, nelemd2 , ent_type, elemids) if (ierr > 0 ) & call endrun('Error: fail to set global id tag for elements') @@ -284,10 +287,10 @@ subroutine create_moab_mesh_fine(par, elem, nets, nete) ! now create the coarse mesh, but the global dofs will come from fine mesh, after solving - nelemd = nete-nets+1 + nelemd2 = nete-nets+1 moab_dim_cquads = (nete-nets+1)*4 - allocate(gdofel(nelemd*np*np)) + allocate(gdofel(nelemd2*np*np)) k=0 ! will be the index for element global dofs do ie=nets,nete ix = ie-nets @@ -377,7 +380,7 @@ subroutine create_moab_mesh_fine(par, elem, nets, nete) call endrun('Error: fail to set GDOFV tag for vertices') ! set global id tag for coarse elements, too; they will start at nets, end at nete ent_type = 1 ! now set the global id tag on elements - ierr = iMOAB_SetIntTagStorage ( MHID, newtagg, nelemd , ent_type, elemids) + ierr = iMOAB_SetIntTagStorage ( MHID, newtagg, nelemd2 , ent_type, elemids) if (ierr > 0 ) & call endrun('Error: fail to set global id tag for vertices') @@ -395,9 +398,9 @@ subroutine create_moab_mesh_fine(par, elem, nets, nete) ! now set the values ! set global dofs tag for coarse elements, too; they will start at nets, end at nete ent_type = 1 ! now set the global id tag on elements - numvals = nelemd*np*np ! input is the total number of values + numvals = nelemd2*np*np ! input is the total number of values ! form gdofel from vgids - do ie=1, nelemd + do ie=1, nelemd2 ix = (ie-1)*np*np ! ie: index in coarse element je = (ie-1) * 4 * (np-1) * (np -1) ! index in moabconn array ! vgids are global ids for fine vertices (1,nverts) @@ -490,7 +493,7 @@ subroutine moab_export_data(elem) integer, external :: iMOAB_GetMeshInfo, iMOAB_SetDoubleTagStorage, iMOAB_WriteMesh integer :: size_tag_array, nvalperelem, ie, i, j, je, ix, ent_type, idx - real(kind=real_kind), allocatable, target :: valuesTag(:) + real(kind=real_kind), allocatable :: valuesTag(:) character*100 outfile, wopts, tagname, lnum ! count number of calls diff --git a/driver-moab/main/cime_comp_mod.F90 b/driver-moab/main/cime_comp_mod.F90 index b48b235dbcb2..8aa534926328 100644 --- a/driver-moab/main/cime_comp_mod.F90 +++ b/driver-moab/main/cime_comp_mod.F90 @@ -3523,6 +3523,12 @@ subroutine cime_run() endif endif + ! send temp from atm to ocean mesh, after projection + if (iamin_CPLALLOCNID .and. ocn_c2_atm) then + ! migrate that tag from coupler pes to ocean pes + call prep_ocn_migrate_moab(infodata) + endif + !---------------------------------------------------------- !| Budget with new fractions !---------------------------------------------------------- diff --git a/driver-moab/main/cplcomp_exchange_mod.F90 b/driver-moab/main/cplcomp_exchange_mod.F90 index 208c3b6957ae..4e8948cc211a 100644 --- a/driver-moab/main/cplcomp_exchange_mod.F90 +++ b/driver-moab/main/cplcomp_exchange_mod.F90 @@ -1051,9 +1051,18 @@ subroutine cplcomp_moab_Init(comp) call seq_comm_getinfo(cplid ,mpigrp=mpigrp_cplid) ! receiver group call seq_comm_getinfo(id_old,mpigrp=mpigrp_old) ! component group pes - if (MPI_COMM_NULL /= mpicom_old ) then ! it means we are on the component pes (atmosphere) + if (MPI_COMM_NULL /= mpicom_old ) then ! it means we are on the component pes (ocean) ! send mesh to coupler ierr = iMOAB_SendMesh(mpoid, mpicom_join, mpigrp_cplid, id_join, partMethod) + + ! define here the tag that will be projected back from atmosphere + ! TODO where do we want to define this? + tagnameProj = 'a2oTAG_proj'//CHAR(0) + tagtype = 1 ! dense, double + numco = 1 ! one value per cell + ierr = iMOAB_DefineTagStorage(mpoid, tagnameProj, tagtype, numco, tagindex ) + + endif if (MPI_COMM_NULL /= mpicom_new ) then ! we are on the coupler pes appname = "COUPLE_MPASO"//CHAR(0) From f2e739f364be2c493168fcd808395d203c88c8d4 Mon Sep 17 00:00:00 2001 From: Iulian Date: Fri, 26 Oct 2018 21:35:59 -0500 Subject: [PATCH 006/467] correct comments no code is changed --- driver-moab/main/prep_ocn_mod.F90 | 67 +++++++++++++++++++++++++++++++ 1 file changed, 67 insertions(+) diff --git a/driver-moab/main/prep_ocn_mod.F90 b/driver-moab/main/prep_ocn_mod.F90 index e4f36146ea99..3a8ae4fb53c0 100644 --- a/driver-moab/main/prep_ocn_mod.F90 +++ b/driver-moab/main/prep_ocn_mod.F90 @@ -1460,4 +1460,71 @@ function prep_ocn_get_mapper_Sw2o() prep_ocn_get_mapper_Sw2o => mapper_Sw2o end function prep_ocn_get_mapper_Sw2o + ! exposed method to migrate projected tag from coupler pes to ocean pes + subroutine prep_ocn_migrate_moab(infodata) + !--------------------------------------------------------------- + ! Description + ! After a2oTAG_proj was computed on ocn mesh on coupler, it needs to be migrated to the ocean pes + ! maybe the ocean solver will use it (later)? + ! in this method, ocn temp on coupler pes from atm is moved to ocean pes + ! Arguments + type(seq_infodata_type) , intent(in) :: infodata + + integer :: ierr + + logical :: atm_present ! .true. => atm is present + logical :: ocn_present ! .true. => ocn is present + integer :: id_join + integer :: mpicom_join + integer :: atmid + character*32 :: dm1, dm2, tagName + character*32 :: outfile, wopts, tagnameProj + integer :: orderOCN, orderATM, volumetric, noConserve, validate + + integer, external :: iMOAB_SendElementTag, iMOAB_ReceiveElementTag, iMOAB_FreeSenderBuffers + integer, external :: iMOAB_WriteMesh + + call seq_infodata_getData(infodata, & + atm_present=atm_present, & + ocn_present=ocn_present) + + ! it involves initial ocn app; mpoid; also migrated ocn mesh mesh on coupler pes, mbaxid + ! after this, the sending of tags from coupler pes to ocn pes will use initial graph + ! (not processed for coverage) + ! how to get mpicomm for joint ocn + coupler + id_join = ocn(1)%cplcompid + ocnid = ocn(1)%compid + call seq_comm_getinfo(ID_join,mpicom=mpicom_join) + + ! now send the tag a2oTAG_proj from ocn on coupler pes towards original ocean mesh + tagName = 'a2oTAG_proj'//CHAR(0) ! it is defined in prep_atm_mod.F90!!! + + if (mboxid .ge. 0) then ! send because we are on coupler pes + + ! basically, use the initial partitioning + ierr = iMOAB_SendElementTag(mboxid, id_join, ocnid, tagName, mpicom_join) + + endif + if (mpoid .ge. 0 ) then ! we are on ocean pes, for sure + ! receive on ocean pes, a tag that was computed on coupler pes + ierr = iMOAB_ReceiveElementTag(mpoid, id_join, ocnid, tagName, mpicom_join) + !CHECKRC(ierr, "cannot receive tag values") + endif + + ! we can now free the sender buffers + if (mboxid .ge. 0) then + ierr = iMOAB_FreeSenderBuffers(mboxid, mpicom_join, id_join) + ! CHECKRC(ierr, "cannot free buffers used to send projected tag towards the ocean mesh") + endif + + if (mpoid .ge. 0 ) then ! we are on ocean pes, for sure + + outfile = 'wholeMPAS_proj.h5m'//CHAR(0) + wopts = ';PARALLEL=WRITE_PART'//CHAR(0) ! + ierr = iMOAB_WriteMesh(mpoid, trim(outfile), trim(wopts)) + + !CHECKRC(ierr, "cannot receive tag values") + endif + + end subroutine prep_ocn_migrate_moab end module prep_ocn_mod From 3f515e95dd6dd5e480552d989303057061e1fb7d Mon Sep 17 00:00:00 2001 From: Iulian Date: Fri, 2 Nov 2018 12:30:33 -0500 Subject: [PATCH 007/467] modified iMOAB interface for weights weights have now an identifier to be able to reuse the same intersection for multiple weights matrices the character id should uniquely identify it --- driver-moab/main/prep_atm_mod.F90 | 13 ++++++++----- 1 file changed, 8 insertions(+), 5 deletions(-) diff --git a/driver-moab/main/prep_atm_mod.F90 b/driver-moab/main/prep_atm_mod.F90 index b614457db571..1415f2da265e 100644 --- a/driver-moab/main/prep_atm_mod.F90 +++ b/driver-moab/main/prep_atm_mod.F90 @@ -269,7 +269,7 @@ subroutine prep_atm_ocn_moab(infodata) integer :: id_join integer :: mpicom_join integer :: atmid - character*32 :: dm1, dm2, dofnameATM, dofnameOCN + character*32 :: dm1, dm2, dofnameATM, dofnameOCN, wgtIdef integer :: orderOCN, orderATM, volumetric, noConserve, validate integer, external :: iMOAB_CoverageGraph, iMOAB_ComputeScalarProjectionWeights @@ -289,6 +289,7 @@ subroutine prep_atm_ocn_moab(infodata) ! it happens over joint communicator ierr = iMOAB_CoverageGraph(mpicom_join, mhid, atmid, mbaxid, id_join, mbintxoa); + wgtIdef = 'scalar'//CHAR(0) dm1 = "cgll"//CHAR(0) dm2 = "fv"//CHAR(0) dofnameATM="GLOBAL_DOFS"//CHAR(0) @@ -299,7 +300,7 @@ subroutine prep_atm_ocn_moab(infodata) noConserve = 0 validate = 1 if (mbintxoa .ge. 0 ) then - ierr = iMOAB_ComputeScalarProjectionWeights ( mbintxoa, & + ierr = iMOAB_ComputeScalarProjectionWeights ( mbintxoa, wgtIdef, & trim(dm1), orderATM, trim(dm2), orderOCN, & volumetric, noConserve, validate, & trim(dofnameATM), trim(dofnameOCN) ) @@ -321,7 +322,7 @@ subroutine prep_atm_migrate_moab(infodata) integer :: id_join integer :: mpicom_join integer :: atmid - character*32 :: dm1, dm2, tagName + character*32 :: dm1, dm2, tagName, wgtIdef character*32 :: outfile, wopts, tagnameProj integer :: orderOCN, orderATM, volumetric, noConserve, validate @@ -345,6 +346,7 @@ subroutine prep_atm_migrate_moab(infodata) ! now send the tag a2oTAG from original atmosphere mhid(pid1) towards migrated coverage mesh (pid3), using the new coverage graph communicator tagName = 'a2oTAG'//CHAR(0) ! it is defined in semoab_mod.F90!!! tagNameProj = 'a2oTAG_proj'//CHAR(0) + wgtIdef = 'scalar'//CHAR(0) if (mhid .ge. 0) then ! send because we are on atm pes ! basically, adjust the migration of the tag we want to project; it was sent initially with @@ -369,8 +371,9 @@ subroutine prep_atm_migrate_moab(infodata) ! we could do the projection now, on the ocean mesh, because we are on the coupler pes; ! the actual migrate could happen later , from coupler pes to the ocean pes if (mbintxoa .ge. 0 ) then ! we are on coupler pes, for sure - ! we could apply weights - ierr = iMOAB_ApplyScalarProjectionWeights ( mbintxoa, tagName, tagNameProj) + ! we could apply weights; need to use the same weight identifier wgtIdef as when we generated it + ! hard coded now, it should be a runtime option in the future + ierr = iMOAB_ApplyScalarProjectionWeights ( mbintxoa, wgtIdef, tagName, tagNameProj) ! we can also write the ocean mesh to file, just to see the projectd tag ! write out the mesh file to disk From cb1e5960228197f0b4cb7091f96d690afbf7da23 Mon Sep 17 00:00:00 2001 From: Iulian Date: Fri, 2 Nov 2018 12:34:16 -0500 Subject: [PATCH 008/467] remove debugging code was a leftover when I was trying to understand how are the chunks generated, and used in mct coupler it could be reused at some point --- components/eam/src/physics/cam/phys_grid.F90 | 19 ------------------- 1 file changed, 19 deletions(-) diff --git a/components/eam/src/physics/cam/phys_grid.F90 b/components/eam/src/physics/cam/phys_grid.F90 index 3657326745ea..90562d260576 100644 --- a/components/eam/src/physics/cam/phys_grid.F90 +++ b/components/eam/src/physics/cam/phys_grid.F90 @@ -474,11 +474,6 @@ subroutine phys_grid_init( ) logical :: unstructured real(r8) :: lonmin, latmin -! debug chunks - integer :: unitn - character (len=32) localmeshfile, lnum -! debug - #if ( defined _OPENMP ) integer omp_get_max_threads external omp_get_max_threads @@ -1373,20 +1368,6 @@ subroutine phys_grid_init( ) deallocate(pcols_proc) deallocate(npthreads) - if (masterproc) then - unitn = shr_file_getUnit() - - localmeshfile = 'chunks_on_proc.txt' - open( unitn, file=trim(localmeshfile)) - do cid = 1, nchunks - ncols = chunks(cid)%ncols - write (unitn, *)chunks(cid)%owner, chunks(cid)%lcid, ncols, (chunks(cid)%gcol(i), i=1, ncols) - enddo - - close(unitn) - call shr_file_freeUnit( unitn ) - endif - call t_stopf("phys_grid_init") call t_adj_detailf(+2) return From 0175183d37e84406a9d7fcb4b2e3eaf2864bed54 Mon Sep 17 00:00:00 2001 From: Iulian Date: Mon, 3 Dec 2018 10:45:50 -0600 Subject: [PATCH 009/467] export more data from spectral elements load more tags ( U and V velocities ), and set up migration and projection at the same time for all variables needs fixes on the MOAB branch too separator between tag names is ";" , semicolon It is a hard constraint, that needs to be used inside iMOAB tag migrate and iMOAB projection methods --- components/homme/src/tool/semoab_mod.F90 | 57 ++++++++++++++++++++--- driver-moab/main/cplcomp_exchange_mod.F90 | 8 +++- driver-moab/main/prep_atm_mod.F90 | 10 ++-- driver-moab/main/prep_ocn_mod.F90 | 9 ++-- 4 files changed, 68 insertions(+), 16 deletions(-) diff --git a/components/homme/src/tool/semoab_mod.F90 b/components/homme/src/tool/semoab_mod.F90 index f4f070d4ca80..cf774fb03d41 100644 --- a/components/homme/src/tool/semoab_mod.F90 +++ b/components/homme/src/tool/semoab_mod.F90 @@ -429,12 +429,23 @@ subroutine create_moab_mesh_fine(par, elem, nets, nete) ! create a new tag, for transfer example ; will use it now for temperature on the surface ! (bottom atm to surface of ocean) - tagname='a2oTAG'//CHAR(0) ! atm to ocean tag + tagname='a2oTbot'//CHAR(0) ! atm to ocean temp bottom tag tagtype = 1 ! dense, double numco = np*np ! usually, it is 16; each element will have the same order as dofs ierr = iMOAB_DefineTagStorage(MHID, tagname, tagtype, numco, tagindex ) if (ierr > 0 ) & - call endrun('Error: fail to create atm to ocean tag') + call endrun('Error: fail to create atm to ocean temp bottom tag') + + tagname='a2oUbot'//CHAR(0) ! atm to ocean U bottom tag + ierr = iMOAB_DefineTagStorage(MHID, tagname, tagtype, numco, tagindex ) + if (ierr > 0 ) & + call endrun('Error: fail to create atm to ocean U velocity bottom tag') + + tagname='a2oVbot'//CHAR(0) ! atm to ocean V bottom tag + ierr = iMOAB_DefineTagStorage(MHID, tagname, tagtype, numco, tagindex ) + if (ierr > 0 ) & + call endrun('Error: fail to create atm to ocean U velocity bottom tag') + ! create a new tag, for transfer example ; will use it now for temperature on the surface ! (bottom atm to surface of ocean); for debugging, use it on fine mesh @@ -519,14 +530,46 @@ subroutine moab_export_data(elem) enddo enddo ! set the tag - tagname='a2oTAG'//CHAR(0) ! atm to ocean tag + tagname='a2oTbot'//CHAR(0) ! atm to ocean tag for temperature + ent_type = 1 ! element type + ierr = iMOAB_SetDoubleTagStorage ( MHID, tagname, size_tag_array, ent_type, valuesTag) + if (ierr > 0 ) & + call endrun('Error: fail to set a2oTbot tag for coarse elements') + + ! loop now for U velocity ( a2oUbot tag) + do ie=1,num_elem + do j=1,np + do i=1,np + valuesTag ( (ie-1)*np*np+(j-1)*np + i ) = elem(ie)%state%v(i,j,1,nlev,1) ! time level 1, U comp + enddo + enddo + enddo + ! set the tag + tagname='a2oUbot'//CHAR(0) ! atm to ocean tag for U velocity ent_type = 1 ! element type ierr = iMOAB_SetDoubleTagStorage ( MHID, tagname, size_tag_array, ent_type, valuesTag) if (ierr > 0 ) & - call endrun('Error: fail to set a2oTAG tag for coarse elements') + call endrun('Error: fail to set a2oUbot tag for coarse elements') + + ! loop now for U velocity ( a2oUbot tag) + do ie=1,num_elem + do j=1,np + do i=1,np + valuesTag ( (ie-1)*np*np+(j-1)*np + i ) = elem(ie)%state%v(i,j,2,nlev,1) ! time level 1, V comp + enddo + enddo + enddo + ! set the tag + tagname='a2oVbot'//CHAR(0) ! atm to ocean tag for V velocity + ent_type = 1 ! element type + ierr = iMOAB_SetDoubleTagStorage ( MHID, tagname, size_tag_array, ent_type, valuesTag) + if (ierr > 0 ) & + call endrun('Error: fail to set a2oVbot tag for coarse elements') + ! write out the mesh file to disk, in parallel - outfile = 'wholeATM_T.h5m'//CHAR(0) + write(lnum,"(I0.2)")num_calls_export + outfile = 'wholeATM_T_'//trim(lnum)// '.h5m' // CHAR(0) wopts = 'PARALLEL=WRITE_PART'//CHAR(0) ierr = iMOAB_WriteMesh(MHID, outfile, wopts) if (ierr > 0 ) & @@ -549,11 +592,11 @@ subroutine moab_export_data(elem) ent_type = 0 ! vertex type ierr = iMOAB_SetDoubleTagStorage ( MHFID, tagname, nvert(1), ent_type, valuesTag) if (ierr > 0 ) & - call endrun('Error: fail to set a2oTAG tag for coarse elements') + call endrun('Error: fail to set a2oDBG tag for fine vertices') ! write out the mesh file to disk, in parallel - write(lnum,"(I0.2)")num_calls_export + outfile = 'wholeFineATM_T_'//trim(lnum)// '.h5m' // CHAR(0) ierr = iMOAB_WriteMesh(MHFID, outfile, wopts) diff --git a/driver-moab/main/cplcomp_exchange_mod.F90 b/driver-moab/main/cplcomp_exchange_mod.F90 index 4e8948cc211a..697556f98339 100644 --- a/driver-moab/main/cplcomp_exchange_mod.F90 +++ b/driver-moab/main/cplcomp_exchange_mod.F90 @@ -1074,11 +1074,17 @@ subroutine cplcomp_moab_Init(comp) wopts = ';PARALLEL=WRITE_PART'//CHAR(0) ! ! define here the tag that will be projected from atmosphere - tagnameProj = 'a2oTAG_proj'//CHAR(0) + tagnameProj = 'a2oTbot_proj'//CHAR(0) ! temperature tagtype = 1 ! dense, double numco = 1 ! one value per cell ierr = iMOAB_DefineTagStorage(mboxid, tagnameProj, tagtype, numco, tagindex ) + ! define more tags + tagnameProj = 'a2oUbot_proj'//CHAR(0) ! U component of velocity + ierr = iMOAB_DefineTagStorage(mboxid, tagnameProj, tagtype, numco, tagindex ) + tagnameProj = 'a2oVbot_proj'//CHAR(0) ! V component of velocity + ierr = iMOAB_DefineTagStorage(mboxid, tagnameProj, tagtype, numco, tagindex ) + ! write out the mesh file to disk ierr = iMOAB_WriteMesh(mboxid, trim(outfile), trim(wopts)) endif diff --git a/driver-moab/main/prep_atm_mod.F90 b/driver-moab/main/prep_atm_mod.F90 index 1415f2da265e..060c9df24efb 100644 --- a/driver-moab/main/prep_atm_mod.F90 +++ b/driver-moab/main/prep_atm_mod.F90 @@ -310,7 +310,8 @@ end subroutine prep_atm_ocn_moab subroutine prep_atm_migrate_moab(infodata) !--------------------------------------------------------------- ! Description - ! After a2oTAG was loaded on atm mesh, it needs to be migrated to the coupler pes, for weight application later + ! After a2oTbot, a2oUbot, a2oVbot tags were loaded on atm mesh, + ! they need to be migrated to the coupler pes, for weight application later ! ! Arguments type(seq_infodata_type) , intent(in) :: infodata @@ -343,9 +344,10 @@ subroutine prep_atm_migrate_moab(infodata) - ! now send the tag a2oTAG from original atmosphere mhid(pid1) towards migrated coverage mesh (pid3), using the new coverage graph communicator - tagName = 'a2oTAG'//CHAR(0) ! it is defined in semoab_mod.F90!!! - tagNameProj = 'a2oTAG_proj'//CHAR(0) + ! now send the tags a2o?bot from original atmosphere mhid(pid1) towards migrated coverage mesh (pid3), using the new coverage graph communicator + tagName = 'a2oTbot;a2oUbot;a2oVbot;'//CHAR(0) ! they are defined in semoab_mod.F90!!! + ! the separator will be ';' semicolon + tagNameProj = 'a2oTbot_proj;a2oUbot_proj;a2oVbot_proj;'//CHAR(0) wgtIdef = 'scalar'//CHAR(0) if (mhid .ge. 0) then ! send because we are on atm pes diff --git a/driver-moab/main/prep_ocn_mod.F90 b/driver-moab/main/prep_ocn_mod.F90 index 3a8ae4fb53c0..9481952b85df 100644 --- a/driver-moab/main/prep_ocn_mod.F90 +++ b/driver-moab/main/prep_ocn_mod.F90 @@ -1464,9 +1464,10 @@ end function prep_ocn_get_mapper_Sw2o subroutine prep_ocn_migrate_moab(infodata) !--------------------------------------------------------------- ! Description - ! After a2oTAG_proj was computed on ocn mesh on coupler, it needs to be migrated to the ocean pes + ! After a2oTbot_proj, a2oVbot_proj, a2oUbot_proj were computed on ocn mesh on coupler, they need + ! to be migrated to the ocean pes ! maybe the ocean solver will use it (later)? - ! in this method, ocn temp on coupler pes from atm is moved to ocean pes + ! in this method, ocn values on coupler pes from atm are moved to ocean pes ! Arguments type(seq_infodata_type) , intent(in) :: infodata @@ -1496,8 +1497,8 @@ subroutine prep_ocn_migrate_moab(infodata) ocnid = ocn(1)%compid call seq_comm_getinfo(ID_join,mpicom=mpicom_join) - ! now send the tag a2oTAG_proj from ocn on coupler pes towards original ocean mesh - tagName = 'a2oTAG_proj'//CHAR(0) ! it is defined in prep_atm_mod.F90!!! + ! now send the tag a2oTbot_proj, a2oUbot_proj, a2oVbot_proj from ocn on coupler pes towards original ocean mesh + tagName = 'a2oTbot_proj;a2oUbot_proj;a2oVbot_proj;'//CHAR(0) ! defined in prep_atm_mod.F90!!! if (mboxid .ge. 0) then ! send because we are on coupler pes From d6d5584ec75b503214f8bd6ef263f8cc9cec28f9 Mon Sep 17 00:00:00 2001 From: Iulian Date: Thu, 6 Dec 2018 14:01:34 -0600 Subject: [PATCH 010/467] character * size in fortran tags names are concatenated, increase the size it should be increased when we will export more tags --- driver-moab/main/prep_atm_mod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/driver-moab/main/prep_atm_mod.F90 b/driver-moab/main/prep_atm_mod.F90 index 060c9df24efb..a70e74073fc5 100644 --- a/driver-moab/main/prep_atm_mod.F90 +++ b/driver-moab/main/prep_atm_mod.F90 @@ -324,7 +324,7 @@ subroutine prep_atm_migrate_moab(infodata) integer :: mpicom_join integer :: atmid character*32 :: dm1, dm2, tagName, wgtIdef - character*32 :: outfile, wopts, tagnameProj + character*50 :: outfile, wopts, tagnameProj integer :: orderOCN, orderATM, volumetric, noConserve, validate integer, external :: iMOAB_SendElementTag, iMOAB_ReceiveElementTag, iMOAB_FreeSenderBuffers From 38e735e09aa5ccc2c012ae72c97ccf41d4b1778b Mon Sep 17 00:00:00 2001 From: Iulian Date: Thu, 6 Dec 2018 16:42:42 -0600 Subject: [PATCH 011/467] another size error --- driver-moab/main/prep_ocn_mod.F90 | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/driver-moab/main/prep_ocn_mod.F90 b/driver-moab/main/prep_ocn_mod.F90 index 9481952b85df..0905859e10c4 100644 --- a/driver-moab/main/prep_ocn_mod.F90 +++ b/driver-moab/main/prep_ocn_mod.F90 @@ -1478,8 +1478,9 @@ subroutine prep_ocn_migrate_moab(infodata) integer :: id_join integer :: mpicom_join integer :: atmid - character*32 :: dm1, dm2, tagName - character*32 :: outfile, wopts, tagnameProj + character*32 :: dm1, dm2 + character*50 :: tagName + character*32 :: outfile, wopts integer :: orderOCN, orderATM, volumetric, noConserve, validate integer, external :: iMOAB_SendElementTag, iMOAB_ReceiveElementTag, iMOAB_FreeSenderBuffers From 33ee3e5f9241a778da5acab20e7b39ed3a7eaecf Mon Sep 17 00:00:00 2001 From: Iulian Date: Wed, 2 Jan 2019 12:27:57 -0600 Subject: [PATCH 012/467] change iMOAB api for weight computation add user controllable monotonicity parameter to the weight computation routine in iMOAB API; before, it was hard coded to 0 inside iMOAB method; --- driver-moab/main/prep_atm_mod.F90 | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/driver-moab/main/prep_atm_mod.F90 b/driver-moab/main/prep_atm_mod.F90 index a70e74073fc5..827de46ae36a 100644 --- a/driver-moab/main/prep_atm_mod.F90 +++ b/driver-moab/main/prep_atm_mod.F90 @@ -271,6 +271,7 @@ subroutine prep_atm_ocn_moab(infodata) integer :: atmid character*32 :: dm1, dm2, dofnameATM, dofnameOCN, wgtIdef integer :: orderOCN, orderATM, volumetric, noConserve, validate + integer :: monotonicity integer, external :: iMOAB_CoverageGraph, iMOAB_ComputeScalarProjectionWeights @@ -296,13 +297,14 @@ subroutine prep_atm_ocn_moab(infodata) dofnameOCN="GLOBAL_ID"//CHAR(0) orderATM = np ! it should be 4 orderOCN = 1 ! not much arguing + monotonicity = 0 ! volumetric = 0 noConserve = 0 validate = 1 if (mbintxoa .ge. 0 ) then ierr = iMOAB_ComputeScalarProjectionWeights ( mbintxoa, wgtIdef, & trim(dm1), orderATM, trim(dm2), orderOCN, & - volumetric, noConserve, validate, & + monotonicity, volumetric, noConserve, validate, & trim(dofnameATM), trim(dofnameOCN) ) endif end subroutine prep_atm_ocn_moab From 4919feeded3c0be25dade1b56b7aa549501d31c6 Mon Sep 17 00:00:00 2001 From: Jason Sarich Date: Tue, 15 Jan 2019 15:44:12 -0600 Subject: [PATCH 013/467] update for anvil keys --- cime_config/machines/config_compilers.xml | 10 ++++++++++ 1 file changed, 10 insertions(+) diff --git a/cime_config/machines/config_compilers.xml b/cime_config/machines/config_compilers.xml index 7e947f0a12ae..b5940fdbbd6b 100644 --- a/cime_config/machines/config_compilers.xml +++ b/cime_config/machines/config_compilers.xml @@ -705,12 +705,17 @@ flags should be captured within MPAS CMake files. $SHELL{$ENV{NETCDF_FORTRAN_PATH}/bin/nf-config --flibs} -L$ENV{MKLROOT}/lib/intel64 -Wl,--no-as-needed -lmkl_intel_lp64 -lmkl_intel_thread -lmkl_core -liomp5 -lpthread -lm -ldl $SHELL{$ENV{NETCDF_C_PATH}/bin/nc-config --libs} +<<<<<<< HEAD -lstdc++ $ENV{NETCDF_C_PATH} $ENV{NETCDF_FORTRAN_PATH} $ENV{PNETCDF_PATH} +======= + /lcrc/project/ACME/MOAB/gcc-73-mvapich + /lcrc/project/ACME/MOAB/gcc-73-openmpi +>>>>>>> update for anvil keys @@ -757,9 +762,14 @@ flags should be captured within MPAS CMake files. $SHELL{$ENV{NETCDF_C_PATH}/bin/nc-config --libs} -Wl,--start-group $ENV{MKLROOT}/lib/intel64/libmkl_intel_lp64.a $ENV{MKLROOT}/lib/intel64/libmkl_sequential.a $ENV{MKLROOT}/lib/intel64/libmkl_core.a -Wl,--end-group -lpthread -lm -ldl +<<<<<<< HEAD $ENV{NETCDF_C_PATH} $ENV{NETCDF_FORTRAN_PATH} $ENV{PNETCDF_PATH} +======= + /lcrc/project/ACME/MOAB/intel-18-mvapich + /lcrc/project/ACME/MOAB/intel-18-openmpi +>>>>>>> update for anvil keys From 0aac418e6a703e9c059c25625b7b7a46b08fa14e Mon Sep 17 00:00:00 2001 From: Jason Sarich Date: Tue, 22 Jan 2019 10:28:20 -0600 Subject: [PATCH 014/467] fix anvil key --- cime_config/machines/config_machines.xml | 1 + 1 file changed, 1 insertion(+) diff --git a/cime_config/machines/config_machines.xml b/cime_config/machines/config_machines.xml index cc32c5da1cc1..493fc55a500b 100644 --- a/cime_config/machines/config_machines.xml +++ b/cime_config/machines/config_machines.xml @@ -2320,6 +2320,7 @@ PrgEnv-cray cce cce/8.1.9 cray-libsci/12.1.00 +======= PrgEnv-gnu From f1cdb3cf4f7c80f6619ea1669ed8e9e03b1eebf7 Mon Sep 17 00:00:00 2001 From: Iulian Date: Mon, 28 Jan 2019 10:52:21 -0600 Subject: [PATCH 015/467] add HAVE_MOAB guards for moab module in dynamics/se --- components/homme/src/tool/semoab_mod.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/components/homme/src/tool/semoab_mod.F90 b/components/homme/src/tool/semoab_mod.F90 index cf774fb03d41..964b90bbe658 100644 --- a/components/homme/src/tool/semoab_mod.F90 +++ b/components/homme/src/tool/semoab_mod.F90 @@ -4,7 +4,7 @@ module semoab_mod - +#ifdef HAVE_MOAB use kinds, only : real_kind, iulog, long_kind, int_kind ! use edge_mod, only : ghostbuffertr_t, initghostbufferTR, freeghostbuffertr, & ! ghostVpack, ghostVunpack, edgebuffer_t, initEdgebuffer @@ -605,5 +605,5 @@ subroutine moab_export_data(elem) deallocate(valuesTag) end subroutine moab_export_data - +#endif end module semoab_mod From 290637bd5f8c9993eca7c30ec497033cfd30a9ef Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Mon, 25 Feb 2019 06:37:59 -0600 Subject: [PATCH 016/467] correct order of components in receive element tag It still communicated what we want, because we did not use order (+1/-1) after finding the ParCommGraph instance --- driver-moab/main/prep_atm_mod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/driver-moab/main/prep_atm_mod.F90 b/driver-moab/main/prep_atm_mod.F90 index 827de46ae36a..aff414f49e45 100644 --- a/driver-moab/main/prep_atm_mod.F90 +++ b/driver-moab/main/prep_atm_mod.F90 @@ -362,7 +362,7 @@ subroutine prep_atm_migrate_moab(infodata) endif if (mbaxid .ge. 0 ) then ! we are on coupler pes, for sure ! receive on atm on coupler pes, that was redistributed according to coverage - ierr = iMOAB_ReceiveElementTag(mbaxid, id_join, atmid, tagName, mpicom_join) + ierr = iMOAB_ReceiveElementTag(mbaxid, atmid, id_join, tagName, mpicom_join) !CHECKRC(ierr, "cannot receive tag values") endif From e4d54b31a41e71655951db56722db515841899eb Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Mon, 25 Feb 2019 06:45:10 -0600 Subject: [PATCH 017/467] introduce iMOAB id for land mlnid iMOAB app id for land mesh, on land PEs mblxid iMOAB app id for land mesh, on coupler PEs (after migration) --- driver-mct/shr/seq_comm_mct.F90 | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/driver-mct/shr/seq_comm_mct.F90 b/driver-mct/shr/seq_comm_mct.F90 index cd185b54ff79..4f60d11d7727 100644 --- a/driver-mct/shr/seq_comm_mct.F90 +++ b/driver-mct/shr/seq_comm_mct.F90 @@ -213,6 +213,12 @@ module seq_comm_mct logical :: seq_comm_mct_initialized = .false. ! whether this module has been initialized + integer, external :: iMOAB_InitializeFortran + integer, public :: mhid, mhfid, mpoid, mlnid ! homme, homme fine, ocean, land moab ids + integer, public :: mbaxid ! iMOAB id for atm migrated mesh to coupler pes + integer, public :: mboxid ! iMOAB id for mpas ocean migrated mesh to coupler pes + integer, public :: mbintxoa ! iMOAB id for intx mesh between ocean and atmosphere + integer, public :: mblxid ! iMOAB id for land mesh migrated to coupler pes !======================================================================= contains !====================================================================== From fa892bf09121d76c3382cb5954520b63d1970bd6 Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Mon, 25 Feb 2019 10:43:07 -0600 Subject: [PATCH 018/467] register land iMOAB app --- components/elm/src/cpl/lnd_comp_mct.F90 | 39 ++++++++++++++++++++++++- 1 file changed, 38 insertions(+), 1 deletion(-) diff --git a/components/elm/src/cpl/lnd_comp_mct.F90 b/components/elm/src/cpl/lnd_comp_mct.F90 index d1c525a8141b..11bbdb25d48d 100644 --- a/components/elm/src/cpl/lnd_comp_mct.F90 +++ b/components/elm/src/cpl/lnd_comp_mct.F90 @@ -52,7 +52,7 @@ subroutine lnd_init_mct( EClock, cdata_l, x2l_l, l2x_l, NLFilename ) use domainMod , only : ldomain use shr_file_mod , only : shr_file_setLogUnit, shr_file_setLogLevel use shr_file_mod , only : shr_file_getLogUnit, shr_file_getLogLevel - use shr_file_mod , only : shr_file_getUnit, shr_file_setIO + use shr_file_mod , only : shr_file_getUnit, shr_file_setIO, shr_file_freeunit use shr_taskmap_mod , only : shr_taskmap_write use seq_cdata_mod , only : seq_cdata, seq_cdata_setptrs use seq_comm_mct , only : info_taskmap_comp @@ -68,6 +68,9 @@ subroutine lnd_init_mct( EClock, cdata_l, x2l_l, l2x_l, NLFilename ) use perf_mod , only : t_startf, t_stopf use mct_mod use ESMF +#ifdef HAVE_MOAB + use seq_comm_mct, only: mlnid ! id of moab land app +#endif ! ! !ARGUMENTS: type(ESMF_Clock), intent(inout) :: EClock ! Input synchronization clock @@ -115,6 +118,14 @@ subroutine lnd_init_mct( EClock, cdata_l, x2l_l, l2x_l, NLFilename ) type(bounds_type) :: bounds ! bounds character(len=32), parameter :: sub = 'lnd_init_mct' character(len=*), parameter :: format = "('("//trim(sub)//") :',A)" + +#ifdef HAVE_MOAB + integer, external :: iMOAB_RegisterFortranApplication + integer :: ierr + character*32 appname + ! debugIuli + integer :: debugGSMapFile, n +#endif !----------------------------------------------------------------------- ! Set cdata data @@ -259,6 +270,32 @@ subroutine lnd_init_mct( EClock, cdata_l, x2l_l, l2x_l, NLFilename ) call lnd_SetgsMap_mct( bounds, mpicom_lnd, LNDID, gsMap_lnd ) lsz = mct_gsMap_lsize(gsMap_lnd, mpicom_lnd) +#ifdef HAVE_MOAB + appname="LNDMB"//CHAR(0) + ! first land instance, should be 9 + ierr = iMOAB_RegisterFortranApplication(appname, mpicom_lnd, LNDID, mlnid) + if (ierr > 0 ) & + call endrun('Error: cannot register moab app') + if(masterproc) then + write(iulog,*) " " + write(iulog,*) "register MOAB app:", trim(appname), " mlnid=", mlnid + write(iulog,*) " " + endif +! debugIuli + if (masterproc) then + debugGSMapFile = shr_file_getUnit() + open( debugGSMapFile, file='LndGSmapC.txt') + write(debugGSMapFile,*) gsMap_lnd%comp_id + write(debugGSMapFile,*) gsMap_lnd%ngseg + write(debugGSMapFile,*) gsMap_lnd%gsize + do n=1,gsMap_lnd%ngseg + write(debugGSMapFile,*) gsMap_lnd%start(n),gsMap_lnd%length(n),gsMap_lnd%pe_loc(n) + end do + close(debugGSMapFile) + call shr_file_freeunit(debugGSMapFile) + endif +!end debugIULI +#endif call lnd_domain_mct( bounds, lsz, gsMap_lnd, dom_l ) From e5d1a313d65a37a218640c57cebd0de1bdaa203d Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Mon, 25 Feb 2019 10:46:44 -0600 Subject: [PATCH 019/467] comment out gs map dumping --- components/elm/src/cpl/lnd_comp_mct.F90 | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/components/elm/src/cpl/lnd_comp_mct.F90 b/components/elm/src/cpl/lnd_comp_mct.F90 index 11bbdb25d48d..727540dbb87c 100644 --- a/components/elm/src/cpl/lnd_comp_mct.F90 +++ b/components/elm/src/cpl/lnd_comp_mct.F90 @@ -281,7 +281,7 @@ subroutine lnd_init_mct( EClock, cdata_l, x2l_l, l2x_l, NLFilename ) write(iulog,*) "register MOAB app:", trim(appname), " mlnid=", mlnid write(iulog,*) " " endif -! debugIuli +#if 0 if (masterproc) then debugGSMapFile = shr_file_getUnit() open( debugGSMapFile, file='LndGSmapC.txt') @@ -294,7 +294,8 @@ subroutine lnd_init_mct( EClock, cdata_l, x2l_l, l2x_l, NLFilename ) close(debugGSMapFile) call shr_file_freeunit(debugGSMapFile) endif -!end debugIULI +#endif +! endif HAVE_MOAB #endif call lnd_domain_mct( bounds, lsz, gsMap_lnd, dom_l ) From 984b7c891602a876ecad08849d10df1b1e6153c4 Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Tue, 26 Feb 2019 00:22:46 -0600 Subject: [PATCH 020/467] instantiate moab land model on land PEs use the land domain created earlier read lat, lon and global grid number, to set the GLOBAL_ID tag on the cloud mesh the global ID, position should match exactly the atm mesh, land portion --- components/elm/src/cpl/lnd_comp_mct.F90 | 73 ++++++++++++++++++++++++- 1 file changed, 72 insertions(+), 1 deletion(-) diff --git a/components/elm/src/cpl/lnd_comp_mct.F90 b/components/elm/src/cpl/lnd_comp_mct.F90 index 727540dbb87c..836015d8e7a4 100644 --- a/components/elm/src/cpl/lnd_comp_mct.F90 +++ b/components/elm/src/cpl/lnd_comp_mct.F90 @@ -26,6 +26,10 @@ module lnd_comp_mct ! !private member functions: private :: lnd_setgsmap_mct ! set the land model mct gs map private :: lnd_domain_mct ! set the land model domain information + +#ifdef HAVE_MOAB + private :: init_land_moab ! create moab mesh (cloud of points) +#endif !--------------------------------------------------------------------------- contains @@ -281,6 +285,7 @@ subroutine lnd_init_mct( EClock, cdata_l, x2l_l, l2x_l, NLFilename ) write(iulog,*) "register MOAB app:", trim(appname), " mlnid=", mlnid write(iulog,*) " " endif + #if 0 if (masterproc) then debugGSMapFile = shr_file_getUnit() @@ -299,7 +304,9 @@ subroutine lnd_init_mct( EClock, cdata_l, x2l_l, l2x_l, NLFilename ) #endif call lnd_domain_mct( bounds, lsz, gsMap_lnd, dom_l ) - +#ifdef HAVE_MOAB + call init_land_moab(dom_l, lsz) +#endif call mct_aVect_init(x2l_l, rList=seq_flds_x2l_fields, lsize=lsz) call mct_aVect_zero(x2l_l) @@ -748,4 +755,68 @@ subroutine lnd_domain_mct( bounds, lsz, gsMap_l, dom_l ) end subroutine lnd_domain_mct +#ifdef HAVE_MOAB + subroutine init_land_moab(mct_ldom, lsz) + use seq_comm_mct, only: mlnid ! id of moab land app + use m_GeneralGrid , only: mct_ggrid_indexIA => indexIA + use m_GeneralGrid , only : MCT_GGrid_indexRA => indexRA + + type(mct_gGrid), pointer :: mct_ldom ! Land model domain data + integer , intent(in) :: lsz ! land model domain data size + integer , external :: iMOAB_CreateVertices, iMOAB_WriteMesh, & + iMOAB_DefineTagStorage, iMOAB_SetIntTagStorage + ! local variables to fill in data + integer, dimension(:), allocatable :: vgids + ! retrieve everything we need from land domain mct_ldom + ! number of vertices is the size of land domain + real(r8), dimension(:), allocatable :: moab_vert_coords ! temporary + real(r8) :: latv, lonv + integer dims, i, ilat, ilon, igdx, ierr, tagindex + integer tagtype, numco, ent_type + character*100 outfile, wopts, localmeshfile, tagname + real(R8),parameter :: SHR_CONST_PI = 3.14159265358979323846_R8 ! pi + + dims =3 ! store as 3d mesh + allocate(moab_vert_coords(lsz*dims)) + allocate(vgids(lsz)) + ilat = MCT_GGrid_indexRA(mct_ldom,'lat') + ilon = MCT_GGrid_indexRA(mct_ldom,'lon') + igdx = MCT_GGrid_indexIA(mct_ldom,'GlobGridNum') + do i = 1, lsz + latv = mct_ldom%data%rAttr(ilat, i) *SHR_CONST_PI/180. + lonv = mct_ldom%data%rAttr(ilon, i) *SHR_CONST_PI/180. + moab_vert_coords(3*i-2)=COS(latv)*COS(lonv) + moab_vert_coords(3*i-1)=COS(latv)*SIN(lonv) + moab_vert_coords(3*i )=SIN(latv) + vgids(i) = mct_ldom%data%iAttr(igdx, i) + enddo + + ierr = iMOAB_CreateVertices(mlnid, lsz*3, dims, moab_vert_coords) + if (ierr > 0 ) & + call endrun('Error: fail to create MOAB vertices in land model') + + tagtype = 0 ! dense, integer + numco = 1 + tagname='GLOBAL_ID'//CHAR(0) + ierr = iMOAB_DefineTagStorage(mlnid, tagname, tagtype, numco, tagindex ) + if (ierr > 0 ) & + call endrun('Error: fail to retrieve GLOBAL_ID tag ') + + ent_type = 0 ! vertex type + ierr = iMOAB_SetIntTagStorage ( mlnid, tagname, lsz , ent_type, vgids) + if (ierr > 0 ) & + call endrun('Error: fail to set GLOBAL_ID tag ') + deallocate(moab_vert_coords) + deallocate(vgids) + + ! write out the mesh file to disk, in parallel + outfile = 'wholeLnd.h5m'//CHAR(0) + wopts = 'PARALLEL=WRITE_PART'//CHAR(0) + ierr = iMOAB_WriteMesh(mlnid, outfile, wopts) + if (ierr > 0 ) & + call endrun('Error: fail to write the land mesh file') + + + end subroutine init_land_moab +#endif end module lnd_comp_mct From 7d49bbeaed98965d0d8a038b3512b2663c11f728 Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Tue, 26 Feb 2019 15:06:05 -0600 Subject: [PATCH 021/467] add more tags for the land mesh in moab add partition tag (special integer, because the VisIt moab plugin does not work with partition tag over set of vertices only) add frac and area tag on vertices They are obtained from the domain mct structure Also, the global id tag is obtained from the mect structure that was created Maybe later we will have to create them from the actual file Maybe later will not create the gsMap at all? The important thing is to match the atm mesh exactly including the position, and global id (GlobGridNum) --- components/elm/src/cpl/lnd_comp_mct.F90 | 49 +++++++++++++++++++++++-- 1 file changed, 46 insertions(+), 3 deletions(-) diff --git a/components/elm/src/cpl/lnd_comp_mct.F90 b/components/elm/src/cpl/lnd_comp_mct.F90 index 836015d8e7a4..ae030a464c5e 100644 --- a/components/elm/src/cpl/lnd_comp_mct.F90 +++ b/components/elm/src/cpl/lnd_comp_mct.F90 @@ -760,18 +760,18 @@ subroutine init_land_moab(mct_ldom, lsz) use seq_comm_mct, only: mlnid ! id of moab land app use m_GeneralGrid , only: mct_ggrid_indexIA => indexIA use m_GeneralGrid , only : MCT_GGrid_indexRA => indexRA - + use spmdMod , only: iam ! rank on the land communicator type(mct_gGrid), pointer :: mct_ldom ! Land model domain data integer , intent(in) :: lsz ! land model domain data size integer , external :: iMOAB_CreateVertices, iMOAB_WriteMesh, & - iMOAB_DefineTagStorage, iMOAB_SetIntTagStorage + iMOAB_DefineTagStorage, iMOAB_SetIntTagStorage, iMOAB_SetDoubleTagStorage ! local variables to fill in data integer, dimension(:), allocatable :: vgids ! retrieve everything we need from land domain mct_ldom ! number of vertices is the size of land domain real(r8), dimension(:), allocatable :: moab_vert_coords ! temporary real(r8) :: latv, lonv - integer dims, i, ilat, ilon, igdx, ierr, tagindex + integer dims, i, ilat, ilon, igdx, ierr, tagindex, ixarea, ixfrac integer tagtype, numco, ent_type character*100 outfile, wopts, localmeshfile, tagname real(R8),parameter :: SHR_CONST_PI = 3.14159265358979323846_R8 ! pi @@ -806,6 +806,49 @@ subroutine init_land_moab(mct_ldom, lsz) ierr = iMOAB_SetIntTagStorage ( mlnid, tagname, lsz , ent_type, vgids) if (ierr > 0 ) & call endrun('Error: fail to set GLOBAL_ID tag ') + + !there are no shared entities, but we will set a special partition tag, in order to see the + ! partitions ; it will be visible with a Pseudocolor plot in VisIt + tagname='partition'//CHAR(0) + ierr = iMOAB_DefineTagStorage(mlnid, tagname, tagtype, numco, tagindex ) + if (ierr > 0 ) & + call endrun('Error: fail to create new partition tag ') + + vgids = iam + ierr = iMOAB_SetIntTagStorage ( mlnid, tagname, lsz , ent_type, vgids) + if (ierr > 0 ) & + call endrun('Error: fail to set partition tag ') + + ! use moab_vert_coords as a data holder for a frac tag and area tag that we will create + ! on the vertices; do not allocate other data array + ! do not be confused by this ! + ixfrac = MCT_GGrid_indexRA(mct_ldom,'frac') + ixarea = MCT_GGrid_indexRA(mct_ldom,'area') + tagname='frac'//CHAR(0) + tagtype = 1 ! dense, double + ierr = iMOAB_DefineTagStorage(mlnid, tagname, tagtype, numco, tagindex ) + if (ierr > 0 ) & + call endrun('Error: fail to create frac tag ') + + do i = 1, lsz + moab_vert_coords(i) = mct_ldom%data%rAttr(ixfrac, i) + enddo + ierr = iMOAB_SetDoubleTagStorage ( mlnid, tagname, lsz , ent_type, moab_vert_coords) + if (ierr > 0 ) & + call endrun('Error: fail to set frac tag ') + + tagname='area'//CHAR(0) + ierr = iMOAB_DefineTagStorage(mlnid, tagname, tagtype, numco, tagindex ) + if (ierr > 0 ) & + call endrun('Error: fail to create area tag ') + do i = 1, lsz + moab_vert_coords(i) = mct_ldom%data%rAttr(ixarea, i) ! use the same doubles for second tag :) + enddo + + ierr = iMOAB_SetDoubleTagStorage ( mlnid, tagname, lsz , ent_type, moab_vert_coords ) + if (ierr > 0 ) & + call endrun('Error: fail to set area tag ') + deallocate(moab_vert_coords) deallocate(vgids) From f351b08ab4e60aa3bebb23963b757967ac39aa79 Mon Sep 17 00:00:00 2001 From: Robert Jacob Date: Fri, 15 Mar 2019 16:35:43 -0500 Subject: [PATCH 022/467] Add cpp to disable h5m timestep output Add a MOABDEBUG cpp around the various blocks of code that output h5m files every timestep. Off by default. --- components/homme/src/tool/semoab_mod.F90 | 13 ++++++++++--- driver-moab/main/prep_atm_mod.F90 | 2 ++ driver-moab/main/prep_ocn_mod.F90 | 2 ++ 3 files changed, 14 insertions(+), 3 deletions(-) diff --git a/components/homme/src/tool/semoab_mod.F90 b/components/homme/src/tool/semoab_mod.F90 index 964b90bbe658..9899ac77584a 100644 --- a/components/homme/src/tool/semoab_mod.F90 +++ b/components/homme/src/tool/semoab_mod.F90 @@ -269,12 +269,14 @@ subroutine create_moab_mesh_fine(par, elem, nets, nete) ierr = iMOAB_UpdateMeshInfo(MHFID) if (ierr > 0 ) & call endrun('Error: fail to update mesh info') +#ifdef MOABDEBUG ! write out the mesh file to disk, in parallel outfile = 'wholeFineATM.h5m'//CHAR(0) wopts = 'PARALLEL=WRITE_PART'//CHAR(0) ierr = iMOAB_WriteMesh(MHFID, outfile, wopts) if (ierr > 0 ) & call endrun('Error: fail to write the mesh file') +#endif ! deallocate ! deallocate(moabvh) @@ -444,7 +446,7 @@ subroutine create_moab_mesh_fine(par, elem, nets, nete) tagname='a2oVbot'//CHAR(0) ! atm to ocean V bottom tag ierr = iMOAB_DefineTagStorage(MHID, tagname, tagtype, numco, tagindex ) if (ierr > 0 ) & - call endrun('Error: fail to create atm to ocean U velocity bottom tag') + call endrun('Error: fail to create atm to ocean V velocity bottom tag') ! create a new tag, for transfer example ; will use it now for temperature on the surface @@ -470,12 +472,14 @@ subroutine create_moab_mesh_fine(par, elem, nets, nete) ierr = iMOAB_UpdateMeshInfo(MHID) if (ierr > 0 ) & call endrun('Error: fail to update mesh info') +#ifdef MOABDEBUG ! write out the mesh file to disk, in parallel outfile = 'wholeATM.h5m'//CHAR(0) wopts = 'PARALLEL=WRITE_PART'//CHAR(0) ierr = iMOAB_WriteMesh(MHID, outfile, wopts) if (ierr > 0 ) & call endrun('Error: fail to write the mesh file') +#endif ! initialize num_calls_export = 0 @@ -551,7 +555,7 @@ subroutine moab_export_data(elem) if (ierr > 0 ) & call endrun('Error: fail to set a2oUbot tag for coarse elements') - ! loop now for U velocity ( a2oUbot tag) + ! loop now for V velocity ( a2oVbot tag) do ie=1,num_elem do j=1,np do i=1,np @@ -567,6 +571,7 @@ subroutine moab_export_data(elem) call endrun('Error: fail to set a2oVbot tag for coarse elements') +#ifdef MOABDEBUG ! write out the mesh file to disk, in parallel write(lnum,"(I0.2)")num_calls_export outfile = 'wholeATM_T_'//trim(lnum)// '.h5m' // CHAR(0) @@ -574,6 +579,7 @@ subroutine moab_export_data(elem) ierr = iMOAB_WriteMesh(MHID, outfile, wopts) if (ierr > 0 ) & call endrun('Error: fail to write the mesh file') +#endif ! for debugging, set the tag on fine mesh too (for visu) do ie=1,num_elem @@ -594,14 +600,15 @@ subroutine moab_export_data(elem) if (ierr > 0 ) & call endrun('Error: fail to set a2oDBG tag for fine vertices') +#ifdef MOABDEBUG ! write out the mesh file to disk, in parallel - outfile = 'wholeFineATM_T_'//trim(lnum)// '.h5m' // CHAR(0) ierr = iMOAB_WriteMesh(MHFID, outfile, wopts) if (ierr > 0 ) & call endrun('Error: fail to write the fine mesh file, with a temperature on it') +#endif deallocate(valuesTag) end subroutine moab_export_data diff --git a/driver-moab/main/prep_atm_mod.F90 b/driver-moab/main/prep_atm_mod.F90 index aff414f49e45..f8da1f982792 100644 --- a/driver-moab/main/prep_atm_mod.F90 +++ b/driver-moab/main/prep_atm_mod.F90 @@ -379,11 +379,13 @@ subroutine prep_atm_migrate_moab(infodata) ! hard coded now, it should be a runtime option in the future ierr = iMOAB_ApplyScalarProjectionWeights ( mbintxoa, wgtIdef, tagName, tagNameProj) +#ifdef MOABDEBUG ! we can also write the ocean mesh to file, just to see the projectd tag ! write out the mesh file to disk outfile = 'ocn_proj.h5m'//CHAR(0) wopts = ';PARALLEL=WRITE_PART'//CHAR(0) ! ierr = iMOAB_WriteMesh(mboxid, trim(outfile), trim(wopts)) +#endif !CHECKRC(ierr, "cannot receive tag values") endif diff --git a/driver-moab/main/prep_ocn_mod.F90 b/driver-moab/main/prep_ocn_mod.F90 index 0905859e10c4..74ce4bee0f00 100644 --- a/driver-moab/main/prep_ocn_mod.F90 +++ b/driver-moab/main/prep_ocn_mod.F90 @@ -1519,6 +1519,7 @@ subroutine prep_ocn_migrate_moab(infodata) ! CHECKRC(ierr, "cannot free buffers used to send projected tag towards the ocean mesh") endif +#ifdef MOABDEBUG if (mpoid .ge. 0 ) then ! we are on ocean pes, for sure outfile = 'wholeMPAS_proj.h5m'//CHAR(0) @@ -1527,6 +1528,7 @@ subroutine prep_ocn_migrate_moab(infodata) !CHECKRC(ierr, "cannot receive tag values") endif +#endif end subroutine prep_ocn_migrate_moab end module prep_ocn_mod From 1730fcdac84b80701d950200adab62dbc713053c Mon Sep 17 00:00:00 2001 From: Jason Sarich Date: Fri, 19 Apr 2019 11:31:26 -0500 Subject: [PATCH 023/467] update bebop config files to use moab --- cime_config/machines/config_compilers.xml | 14 ++++++-------- 1 file changed, 6 insertions(+), 8 deletions(-) diff --git a/cime_config/machines/config_compilers.xml b/cime_config/machines/config_compilers.xml index b5940fdbbd6b..fbc67f9a12a4 100644 --- a/cime_config/machines/config_compilers.xml +++ b/cime_config/machines/config_compilers.xml @@ -705,17 +705,14 @@ flags should be captured within MPAS CMake files. $SHELL{$ENV{NETCDF_FORTRAN_PATH}/bin/nf-config --flibs} -L$ENV{MKLROOT}/lib/intel64 -Wl,--no-as-needed -lmkl_intel_lp64 -lmkl_intel_thread -lmkl_core -liomp5 -lpthread -lm -ldl $SHELL{$ENV{NETCDF_C_PATH}/bin/nc-config --libs} -<<<<<<< HEAD -lstdc++ $ENV{NETCDF_C_PATH} $ENV{NETCDF_FORTRAN_PATH} $ENV{PNETCDF_PATH} -======= /lcrc/project/ACME/MOAB/gcc-73-mvapich /lcrc/project/ACME/MOAB/gcc-73-openmpi ->>>>>>> update for anvil keys @@ -762,14 +759,11 @@ flags should be captured within MPAS CMake files. $SHELL{$ENV{NETCDF_C_PATH}/bin/nc-config --libs} -Wl,--start-group $ENV{MKLROOT}/lib/intel64/libmkl_intel_lp64.a $ENV{MKLROOT}/lib/intel64/libmkl_sequential.a $ENV{MKLROOT}/lib/intel64/libmkl_core.a -Wl,--end-group -lpthread -lm -ldl -<<<<<<< HEAD $ENV{NETCDF_C_PATH} $ENV{NETCDF_FORTRAN_PATH} $ENV{PNETCDF_PATH} -======= /lcrc/project/ACME/MOAB/intel-18-mvapich /lcrc/project/ACME/MOAB/intel-18-openmpi ->>>>>>> update for anvil keys @@ -888,20 +882,24 @@ flags should be captured within MPAS CMake files. /soft/climate/AlbanyTrilinos_06262017/Albany/buildintel/install + /home/iulian/moab-blds/bebop/moab-intel-17 -DHAVE_SLASHPROC + -DHAVE_SLASHPROC + -DMOABDEBUG -DNO_SHR_VMATH -lstdc++ - -O2 -debug minimal -qno-opt-dynamic-align + $SHELL{nf-config --fflags} -DNO_SHR_VMATH + $SHELL{nf-config --fflags} -O2 -debug minimal -qno-opt-dynamic-align mpiicc mpiicpc mpiifort - $SHELL{nf-config --flibs} -mkl + $SHELL{nf-config --flibs} -llapack -lblas $ENV{NETCDF_C_PATH} $ENV{NETCDF_FORTRAN_PATH} From ae82bb847656505fd768b3f10374f0abee107e37 Mon Sep 17 00:00:00 2001 From: Jason Sarich Date: Fri, 19 Apr 2019 11:32:32 -0500 Subject: [PATCH 024/467] remove USE_MOAB variable, since --driver moab implies this --- driver-moab/cime_config/config_component.xml | 9 --------- 1 file changed, 9 deletions(-) diff --git a/driver-moab/cime_config/config_component.xml b/driver-moab/cime_config/config_component.xml index 4d6773d93b1a..144c3b51912f 100644 --- a/driver-moab/cime_config/config_component.xml +++ b/driver-moab/cime_config/config_component.xml @@ -737,15 +737,6 @@ machines. - - logical - TRUE,FALSE - FALSE - build_def - env_build.xml - TRUE implies linking to the MOAB library - - logical TRUE,FALSE From a664e84c045a5100b49a234b61c6621f734b7c67 Mon Sep 17 00:00:00 2001 From: Jason Sarich Date: Mon, 22 Apr 2019 17:00:43 -0500 Subject: [PATCH 025/467] update anvil modules for intel mvapich stack --- cime_config/machines/config_compilers.xml | 2 + cime_config/machines/config_machines.xml | 94 ++++++++++++++++++----- cime_config/machines/config_pio.xml | 1 + 3 files changed, 78 insertions(+), 19 deletions(-) diff --git a/cime_config/machines/config_compilers.xml b/cime_config/machines/config_compilers.xml index fbc67f9a12a4..a0258778328b 100644 --- a/cime_config/machines/config_compilers.xml +++ b/cime_config/machines/config_compilers.xml @@ -697,6 +697,7 @@ flags should be captured within MPAS CMake files. + /home/sarich/software/moab-gnu-mvapich -DHAVE_NANOTIME -DBIT64 -DHAVE_SLASHPROC -DHAVE_GETTIMEOFDAY @@ -734,6 +735,7 @@ flags should be captured within MPAS CMake files. + /home/sarich/software/anvil/moab-intel-18-mvapich -static-intel -heap-arrays diff --git a/cime_config/machines/config_machines.xml b/cime_config/machines/config_machines.xml index 493fc55a500b..d2da2763989f 100644 --- a/cime_config/machines/config_machines.xml +++ b/cime_config/machines/config_machines.xml @@ -2257,6 +2257,16 @@ /software/user_tools/current/cades-ccsi/perl5/lib/perl5/ + + + + istanbul + 1 + + + dynamic + + @@ -2320,37 +2330,83 @@ PrgEnv-cray cce cce/8.1.9 cray-libsci/12.1.00 -======= + /home/software/spack-0.10.1/opt/spack/linux-centos7-x86_64/gcc-4.8.5/lmod-7.4.9-ic63herzfgw5u3na5mdtvp3nwxy6oj2z/lmod/lmod/init/sh;export + /home/software/spack-0.10.1/opt/spack/linux-centos7-x86_64/gcc-4.8.5/lmod-7.4.9-ic63herzfgw5u3na5mdtvp3nwxy6oj2z/lmod/lmod/init/csh;setenv + /home/software/spack-0.10.1/opt/spack/linux-centos7-x86_64/gcc-4.8.5/lmod-7.4.9-ic63herzfgw5u3na5mdtvp3nwxy6oj2z/lmod/lmod/init/env_modules_python.py + /home/software/spack-0.10.1/opt/spack/linux-centos7-x86_64/gcc-4.8.5/lmod-7.4.9-ic63herzfgw5u3na5mdtvp3nwxy6oj2z/lmod/lmod/libexec/lmod python + module + module + + - - PrgEnv-gnu - gcc gcc/4.8.0 - cray-libsci/12.1.00 + + intel/18.0.4-443hhug + mvapich2/2.3.1-verbs-dtbb6xk + intel-mkl/2018.4.274-jwaeshj + hdf5/1.10.5-4rufvi6 + parallel-netcdf/1.8.1-xqvwg7l + netcdf/4.4.1-4odwn5a + netcdf-fortran/4.4.4-kgp5hqm + netcdf-cxx/4.2-teppiwl + eigen + cmake + metis/5.1.0-rwurq5g - - cray-netcdf/4.3.2 + + intel/17.0.0-yil23id + intel-mkl/2017.0.098-gqttdpp + netcdf/4.4.1-qy35uvc + netcdf-fortran/4.4.4-2jrvsdv + openmpi/2.0.1-verbs-id2i464 + cmake/3.14.1-ymmizo4 - - cray-netcdf-hdf5parallel/4.3.3.1 - cray-parallel-netcdf/1.6.1 + + gcc/8.2.0-g7hppkz + intel-mkl/2018.4.274-2amycpi + hdf5/1.8.16-mz7lmxh + netcdf/4.4.1-xkjcghm + netcdf-cxx/4.2-kyva3os + netcdf-fortran/4.4.4-mpstomu - - cmake3/3.2.3 - python/2.7.9 + + mvapich2/2.3.1-verbs-wcfqbl5 + + + openmpi/3.1.3-verbs-q4swt25 - $ENV{MEMBERWORK}/$PROJECT/$CASE/run + $CIME_OUTPUT_ROOT/$CASE/run $CIME_OUTPUT_ROOT/$CASE/bld + 0.1 + 1000 - 1 - 1 - + $SHELL{which nc-config | xargs dirname | xargs dirname} + $SHELL{which nf-config | xargs dirname | xargs dirname} + /lcrc/group/acme/soft/perl/5.26.0/bin:$ENV{PATH} + + + $SHELL{pnetcdf-config --prefix} + + + 1 + 1 + 2 + + 64M - + + + granularity=thread,scatter + 1 + + + spread + threads +>>>>>>> update anvil modules for intel mvapich stack + LANL Linux Cluster, 36 pes/node, batch system slurm gr-fe.*.lanl.gov diff --git a/cime_config/machines/config_pio.xml b/cime_config/machines/config_pio.xml index 023532e4cd27..01179d55e708 100644 --- a/cime_config/machines/config_pio.xml +++ b/cime_config/machines/config_pio.xml @@ -66,6 +66,7 @@ netcdf netcdf netcdf + netcdf From 0c4880ce9bb30433f23b25938529739eee45aaf2 Mon Sep 17 00:00:00 2001 From: Jason Sarich Date: Tue, 23 Apr 2019 11:10:40 -0500 Subject: [PATCH 026/467] Add anvil gnu modules for moab --- cime_config/machines/config_compilers.xml | 2 +- cime_config/machines/config_machines.xml | 13 ++++++++----- 2 files changed, 9 insertions(+), 6 deletions(-) diff --git a/cime_config/machines/config_compilers.xml b/cime_config/machines/config_compilers.xml index a0258778328b..f554e1956de2 100644 --- a/cime_config/machines/config_compilers.xml +++ b/cime_config/machines/config_compilers.xml @@ -697,7 +697,7 @@ flags should be captured within MPAS CMake files. - /home/sarich/software/moab-gnu-mvapich + /home/sarich/software/anvil/moab-gcc-8-mvapich -DHAVE_NANOTIME -DBIT64 -DHAVE_SLASHPROC -DHAVE_GETTIMEOFDAY diff --git a/cime_config/machines/config_machines.xml b/cime_config/machines/config_machines.xml index d2da2763989f..f665de74f43f 100644 --- a/cime_config/machines/config_machines.xml +++ b/cime_config/machines/config_machines.xml @@ -2363,13 +2363,16 @@ gcc/8.2.0-g7hppkz intel-mkl/2018.4.274-2amycpi - hdf5/1.8.16-mz7lmxh - netcdf/4.4.1-xkjcghm - netcdf-cxx/4.2-kyva3os - netcdf-fortran/4.4.4-mpstomu + cmake + eigen mvapich2/2.3.1-verbs-wcfqbl5 + parallel-netcdf/1.8.1-mnott45 + hdf5/1.10.5-rd4hbge + netcdf/4.4.1-x43bojv + netcdf-fortran/4.4.4-nbrqul6 + netcdf-cxx/4.2-fmuu33d openmpi/3.1.3-verbs-q4swt25 @@ -2384,7 +2387,7 @@ $SHELL{which nf-config | xargs dirname | xargs dirname} /lcrc/group/acme/soft/perl/5.26.0/bin:$ENV{PATH} - + $SHELL{pnetcdf-config --prefix} From a2b862e1d338012aeba08bddfc85da208c4fc191 Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Tue, 26 Mar 2019 02:36:27 -0500 Subject: [PATCH 027/467] migrate land model to coupler pes also add more MOABDEBUG ifdefs when writing h5m debug files this branch needs to use moab branch iulian07/point_cloud_migrate --- components/elm/src/cpl/lnd_comp_mct.F90 | 11 ++++-- driver-mct/shr/seq_comm_mct.F90 | 1 - driver-moab/main/cplcomp_exchange_mod.F90 | 46 ++++++++++++++++++++--- 3 files changed, 48 insertions(+), 10 deletions(-) diff --git a/components/elm/src/cpl/lnd_comp_mct.F90 b/components/elm/src/cpl/lnd_comp_mct.F90 index ae030a464c5e..9f7c9861d889 100644 --- a/components/elm/src/cpl/lnd_comp_mct.F90 +++ b/components/elm/src/cpl/lnd_comp_mct.F90 @@ -764,7 +764,8 @@ subroutine init_land_moab(mct_ldom, lsz) type(mct_gGrid), pointer :: mct_ldom ! Land model domain data integer , intent(in) :: lsz ! land model domain data size integer , external :: iMOAB_CreateVertices, iMOAB_WriteMesh, & - iMOAB_DefineTagStorage, iMOAB_SetIntTagStorage, iMOAB_SetDoubleTagStorage + iMOAB_DefineTagStorage, iMOAB_SetIntTagStorage, iMOAB_SetDoubleTagStorage, & + iMOAB_ResolveSharedEntities ! local variables to fill in data integer, dimension(:), allocatable :: vgids ! retrieve everything we need from land domain mct_ldom @@ -807,6 +808,10 @@ subroutine init_land_moab(mct_ldom, lsz) if (ierr > 0 ) & call endrun('Error: fail to set GLOBAL_ID tag ') + ierr = iMOAB_ResolveSharedEntities( mlnid, lsz, vgids ); + if (ierr > 0 ) & + call endrun('Error: fail to resolve shared entities') + !there are no shared entities, but we will set a special partition tag, in order to see the ! partitions ; it will be visible with a Pseudocolor plot in VisIt tagname='partition'//CHAR(0) @@ -851,14 +856,14 @@ subroutine init_land_moab(mct_ldom, lsz) deallocate(moab_vert_coords) deallocate(vgids) - +#ifdef MOABDEBUG ! write out the mesh file to disk, in parallel outfile = 'wholeLnd.h5m'//CHAR(0) wopts = 'PARALLEL=WRITE_PART'//CHAR(0) ierr = iMOAB_WriteMesh(mlnid, outfile, wopts) if (ierr > 0 ) & call endrun('Error: fail to write the land mesh file') - +#endif end subroutine init_land_moab #endif diff --git a/driver-mct/shr/seq_comm_mct.F90 b/driver-mct/shr/seq_comm_mct.F90 index 4f60d11d7727..be0c6f813b62 100644 --- a/driver-mct/shr/seq_comm_mct.F90 +++ b/driver-mct/shr/seq_comm_mct.F90 @@ -218,7 +218,6 @@ module seq_comm_mct integer, public :: mbaxid ! iMOAB id for atm migrated mesh to coupler pes integer, public :: mboxid ! iMOAB id for mpas ocean migrated mesh to coupler pes integer, public :: mbintxoa ! iMOAB id for intx mesh between ocean and atmosphere - integer, public :: mblxid ! iMOAB id for land mesh migrated to coupler pes !======================================================================= contains !====================================================================== diff --git a/driver-moab/main/cplcomp_exchange_mod.F90 b/driver-moab/main/cplcomp_exchange_mod.F90 index 697556f98339..fa726c4bd6eb 100644 --- a/driver-moab/main/cplcomp_exchange_mod.F90 +++ b/driver-moab/main/cplcomp_exchange_mod.F90 @@ -14,6 +14,7 @@ module cplcomp_exchange_mod use seq_diag_mct use seq_comm_mct, only : mhid, mpoid, mbaxid, mboxid ! iMOAB app ids, for atm, ocean, ax mesh, ox mesh + use seq_comm_mct, only : mlnid , mlnxid ! iMOAB app id for land , on land pes and coupler pes use shr_mpi_mod, only: shr_mpi_max implicit none @@ -997,7 +998,7 @@ subroutine cplcomp_moab_Init(comp) integer, external :: iMOAB_WriteMesh, iMOAB_DefineTagStorage integer :: ierr character*32 :: appname, outfile, wopts, tagnameProj - integer :: maxMH, maxMPO ! max pids for moab apps + integer :: maxMH, maxMPO, maxMLID ! max pids for moab apps atm, ocn, lnd integer :: tagtype, numco, tagindex, partMethod !----------------------------------------------------- @@ -1023,8 +1024,10 @@ subroutine cplcomp_moab_Init(comp) call shr_mpi_max(mhid, maxMH, mpicom_join, all=.true.) call shr_mpi_max(mpoid, maxMPO, mpicom_join, all=.true.) + call shr_mpi_max(mlnid, maxMLID, mpicom_join, all=.true.) if (seq_comm_iamroot(CPLID) ) then - write(logunit, *) "MOAB coupling: maxMH: ", maxMH, " maxMPO: ", maxMPO + write(logunit, *) "MOAB coupling: maxMH: ", maxMH, " maxMPO: ", maxMPO, & + " maxMLID: ", maxMLID endif ! this works now for atmosphere; if ( comp%oneletterid == 'a' .and. maxMH /= -1) then @@ -1040,13 +1043,16 @@ subroutine cplcomp_moab_Init(comp) ! migrated mesh gets another app id, moab atm to coupler (mbax) ierr = iMOAB_RegisterFortranApplication(trim(appname), mpicom_new, id_join, mbaxid) ierr = iMOAB_ReceiveMesh(mbaxid, mpicom_join, mpigrp_old, id_old) +#ifdef MOABDEBUG ! debug test outfile = 'recMeshAtm.h5m'//CHAR(0) wopts = ';PARALLEL=WRITE_PART'//CHAR(0) ! write out the mesh file to disk ierr = iMOAB_WriteMesh(mbaxid, trim(outfile), trim(wopts)) +#endif endif endif + ! ocean if (comp%oneletterid == 'o' .and. maxMPO /= -1) then call seq_comm_getinfo(cplid ,mpigrp=mpigrp_cplid) ! receiver group call seq_comm_getinfo(id_old,mpigrp=mpigrp_old) ! component group pes @@ -1069,9 +1075,6 @@ subroutine cplcomp_moab_Init(comp) ! migrated mesh gets another app id, moab ocean to coupler (mbox) ierr = iMOAB_RegisterFortranApplication(trim(appname), mpicom_new, id_join, mboxid) ierr = iMOAB_ReceiveMesh(mboxid, mpicom_join, mpigrp_old, id_old) - ! debug test - outfile = 'recMeshOcn.h5m'//CHAR(0) - wopts = ';PARALLEL=WRITE_PART'//CHAR(0) ! ! define here the tag that will be projected from atmosphere tagnameProj = 'a2oTbot_proj'//CHAR(0) ! temperature @@ -1084,13 +1087,44 @@ subroutine cplcomp_moab_Init(comp) ierr = iMOAB_DefineTagStorage(mboxid, tagnameProj, tagtype, numco, tagindex ) tagnameProj = 'a2oVbot_proj'//CHAR(0) ! V component of velocity ierr = iMOAB_DefineTagStorage(mboxid, tagnameProj, tagtype, numco, tagindex ) - +#ifdef MOABDEBUG +! debug test + outfile = 'recMeshOcn.h5m'//CHAR(0) + wopts = ';PARALLEL=WRITE_PART'//CHAR(0) ! ! write out the mesh file to disk ierr = iMOAB_WriteMesh(mboxid, trim(outfile), trim(wopts)) +#endif endif endif +! land + if (comp%oneletterid == 'l' .and. maxMLID /= -1) then + call seq_comm_getinfo(cplid ,mpigrp=mpigrp_cplid) ! receiver group + call seq_comm_getinfo(id_old,mpigrp=mpigrp_old) ! component group pes + if (MPI_COMM_NULL /= mpicom_old ) then ! it means we are on the component pes (ocean) + ! send mesh to coupler +#ifdef MOAB_HAVE_ZOLTAN + partMethod = 2 ! RCB for point cloud +#endif + ierr = iMOAB_SendMesh(mlnid, mpicom_join, mpigrp_cplid, id_join, partMethod) + + endif + if (MPI_COMM_NULL /= mpicom_new ) then ! we are on the coupler pes + appname = "COUPLE_LAND"//CHAR(0) + ! migrated mesh gets another app id, moab ocean to coupler (mbox) + ierr = iMOAB_RegisterFortranApplication(trim(appname), mpicom_new, id_join, mlnxid) + ierr = iMOAB_ReceiveMesh(mlnxid, mpicom_join, mpigrp_old, id_old) + +#ifdef MOABDEBUG + ! debug test + outfile = 'recLand.h5m'//CHAR(0) + wopts = ';PARALLEL=WRITE_PART'//CHAR(0) ! +! write out the mesh file to disk + ierr = iMOAB_WriteMesh(mlnxid, trim(outfile), trim(wopts)) +#endif + endif + endif end subroutine cplcomp_moab_Init From af3008c9de0e4966fb601f52ed5e042417bed0d1 Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Sat, 30 Mar 2019 23:32:11 -0500 Subject: [PATCH 028/467] set partition tag after migration for visibility of the land model after migration it was not really needed; also, need to correct the setting of the tags in iMOAB --- driver-moab/main/cplcomp_exchange_mod.F90 | 26 +++++++++++++++++++---- 1 file changed, 22 insertions(+), 4 deletions(-) diff --git a/driver-moab/main/cplcomp_exchange_mod.F90 b/driver-moab/main/cplcomp_exchange_mod.F90 index fa726c4bd6eb..ae92c7d4bab6 100644 --- a/driver-moab/main/cplcomp_exchange_mod.F90 +++ b/driver-moab/main/cplcomp_exchange_mod.F90 @@ -995,15 +995,22 @@ subroutine cplcomp_moab_Init(comp) integer :: mpigrp_cplid ! coupler pes integer :: mpigrp_old ! component group pes integer, external :: iMOAB_RegisterFortranApplication, iMOAB_ReceiveMesh, iMOAB_SendMesh - integer, external :: iMOAB_WriteMesh, iMOAB_DefineTagStorage + integer, external :: iMOAB_WriteMesh, iMOAB_DefineTagStorage, iMOAB_GetMeshInfo + integer, external :: iMOAB_SetIntTagStorage integer :: ierr character*32 :: appname, outfile, wopts, tagnameProj integer :: maxMH, maxMPO, maxMLID ! max pids for moab apps atm, ocn, lnd integer :: tagtype, numco, tagindex, partMethod + integer :: rank, ent_type +#ifdef MOABDEBUG + integer , dimension(1:3) :: nverts, nelem, nblocks, nsbc, ndbc + integer, dimension(:), allocatable :: vgids + character*32 :: tagname +#endif - !----------------------------------------------------- +!----------------------------------------------------- - call seq_comm_getinfo(CPLID, mpicom=mpicom_CPLID) + call seq_comm_getinfo(CPLID, mpicom=mpicom_CPLID, iam=rank) id_new = cplid id_old = comp%compid @@ -1117,10 +1124,21 @@ subroutine cplcomp_moab_Init(comp) ierr = iMOAB_ReceiveMesh(mlnxid, mpicom_join, mpigrp_old, id_old) #ifdef MOABDEBUG + !there are no shared entities, but we will set a special partition tag, in order to see the + ! partitions ; it will be visible with a Pseudocolor plot in VisIt + tagname='partition'//CHAR(0) + tagtype = 0 ! dense, integer + numco = 1 ! one value per cell + ierr = iMOAB_DefineTagStorage(mlnxid, tagname, tagtype, numco, tagindex ) + ierr = iMOAB_GetMeshInfo(mlnxid, nverts, nelem, nblocks, nsbc, ndbc) + allocate(vgids(nverts(1))) + vgids = rank + ent_type = 0 ! vertex type + ierr = iMOAB_SetIntTagStorage ( mlnxid, tagname, nverts(1) , ent_type, vgids) ! debug test outfile = 'recLand.h5m'//CHAR(0) wopts = ';PARALLEL=WRITE_PART'//CHAR(0) ! -! write out the mesh file to disk +! write out the mesh file to disk ierr = iMOAB_WriteMesh(mlnxid, trim(outfile), trim(wopts)) #endif endif From d7e140577e5cf6471f1bbb8fb704f194460b54e9 Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Fri, 12 Apr 2019 13:12:21 -0500 Subject: [PATCH 029/467] prefer RCB to migrate RCB behaves better for intersection, later Also, it is more stable --- driver-moab/main/cplcomp_exchange_mod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/driver-moab/main/cplcomp_exchange_mod.F90 b/driver-moab/main/cplcomp_exchange_mod.F90 index ae92c7d4bab6..e80e117bec56 100644 --- a/driver-moab/main/cplcomp_exchange_mod.F90 +++ b/driver-moab/main/cplcomp_exchange_mod.F90 @@ -1022,7 +1022,7 @@ subroutine cplcomp_moab_Init(comp) partMethod = 0 ! trivial partitioning #ifdef MOAB_HAVE_ZOLTAN - partMethod = 1 + partMethod = 2 ! it is better to use RCB for atmosphere and ocean too #endif call seq_comm_getinfo(ID_old ,mpicom=mpicom_old) From 54e58935547ff4833cdccbccfc59dd896b33b146 Mon Sep 17 00:00:00 2001 From: Jason Sarich Date: Thu, 25 Apr 2019 15:33:50 -0500 Subject: [PATCH 030/467] Add soft keys for anlworkstation --- cime_config/machines/config_compilers.xml | 2 ++ 1 file changed, 2 insertions(+) diff --git a/cime_config/machines/config_compilers.xml b/cime_config/machines/config_compilers.xml index f554e1956de2..a794a0abe1f4 100644 --- a/cime_config/machines/config_compilers.xml +++ b/cime_config/machines/config_compilers.xml @@ -674,6 +674,7 @@ flags should be captured within MPAS CMake files. /projects/install/rhel6-x86_64/ACME/AlbanyTrilinos/Albany/build/install + /home/sarich/software/anlworkstation/gcc-6.2-mpich-3.2/moab -O2 @@ -685,6 +686,7 @@ flags should be captured within MPAS CMake files. -O2 + -DMOABDEBUG $SHELL{$ENV{NETCDF_PATH}/bin/nf-config --flibs} -lblas -llapack From a39bd46e03f3e57a8771aa2262a7c9c70c69816e Mon Sep 17 00:00:00 2001 From: Jason Sarich Date: Mon, 6 May 2019 15:43:52 -0500 Subject: [PATCH 031/467] reset anvil to centos6 --- cime_config/machines/config_compilers.xml | 4 +- cime_config/machines/config_machines.xml | 99 +++++++++++++++-------- 2 files changed, 69 insertions(+), 34 deletions(-) diff --git a/cime_config/machines/config_compilers.xml b/cime_config/machines/config_compilers.xml index a794a0abe1f4..09cc6e089a9c 100644 --- a/cime_config/machines/config_compilers.xml +++ b/cime_config/machines/config_compilers.xml @@ -699,7 +699,7 @@ flags should be captured within MPAS CMake files. - /home/sarich/software/anvil/moab-gcc-8-mvapich + /home/sarich/software/anvil/gnu-8-mvapich-2.3/moab -DHAVE_NANOTIME -DBIT64 -DHAVE_SLASHPROC -DHAVE_GETTIMEOFDAY @@ -737,7 +737,7 @@ flags should be captured within MPAS CMake files. - /home/sarich/software/anvil/moab-intel-18-mvapich + /home/sarich/software/anvil/intel-18-mvapich-2.3/moab -static-intel -heap-arrays diff --git a/cime_config/machines/config_machines.xml b/cime_config/machines/config_machines.xml index f665de74f43f..a5337f804ee9 100644 --- a/cime_config/machines/config_machines.xml +++ b/cime_config/machines/config_machines.xml @@ -2267,6 +2267,7 @@ dynamic +<<<<<<< HEAD @@ -2283,6 +2284,23 @@ $ENV{MEMBERWORK}/$PROJECT/archive/$CASE /lustre/atlas1/cli900/world-shared/cesm/baselines/$COMPILER /lustre/atlas1/cli900/world-shared/cesm/tools/cprnc/cprnc.eos +======= + + ANL/LCRC Linux Cluster + b51.*.lcrc.anl.gov + LINUX + intel,gnu + mvapich,openmpi + condo + /lcrc/group/acme + .* + /lcrc/group/acme/$USER/acme_scratch/anvil + /home/ccsm-data/inputdata + /home/ccsm-data/inputdata/atm/datm7 + /lcrc/group/acme/$USER/archive/$CASE + /lcrc/group/acme/acme_baselines/$COMPILER + /lcrc/group/acme/tools/cprnc/cprnc +>>>>>>> reset anvil to centos6 8 e3sm_developer pbs @@ -2293,17 +2311,25 @@ aprun +<<<<<<< HEAD -j {{ hyperthreading }} -S {{ tasks_per_numa }} -n {{ total_tasks }} -N $MAX_MPITASKS_PER_NODE -d $ENV{OMP_NUM_THREADS} -cc numa_node +======= + -l -n {{ total_tasks }} + --cpu_bind=cores + -c $SHELL{if [ FALSE = `./xmlquery --value SMP_PRESENT` ];then echo 1;else echo $OMP_NUM_THREADS;fi} + -m plane=$SHELL{if [ FALSE = `./xmlquery --value SMP_PRESENT` ];then echo 36;else echo 36/$OMP_NUM_THREADS|bc;fi} +>>>>>>> reset anvil to centos6 +<<<<<<< HEAD $MODULESHOME/init/sh $MODULESHOME/init/csh @@ -2336,46 +2362,52 @@ /home/software/spack-0.10.1/opt/spack/linux-centos7-x86_64/gcc-4.8.5/lmod-7.4.9-ic63herzfgw5u3na5mdtvp3nwxy6oj2z/lmod/lmod/libexec/lmod python module module +======= + + /etc/profile.d/a_softenv.csh + /etc/profile.d/a_softenv.sh + soft + soft +>>>>>>> reset anvil to centos6 - + +cmake-2.8.12 + +python-2.7 + +zlib-1.2.11 + + + +intel-18.0.3 + +mkl-11.2.1 - intel/18.0.4-443hhug - mvapich2/2.3.1-verbs-dtbb6xk - intel-mkl/2018.4.274-jwaeshj - hdf5/1.10.5-4rufvi6 - parallel-netcdf/1.8.1-xqvwg7l - netcdf/4.4.1-4odwn5a - netcdf-fortran/4.4.4-kgp5hqm - netcdf-cxx/4.2-teppiwl - eigen - cmake - metis/5.1.0-rwurq5g + +mvapich2-2.3-intel-18.0.3-acme + +hdf5-1.10.4-intel-18.0.3-mvapich2-2.3-acme + +netcdf-4.6.2-intel-18.0.3-mvapich2-2.3-acme + +netcdf-cxx-4.2-intel-18.0.3-mvapich2-2.3-acme + +netcdf-fortran-4.4.4-intel-18.0.3-mvapich2-2.3-acme + +parallel-netcdf-1.10.0-intel-18.0.3-mvapich2-2.3-acme - intel/17.0.0-yil23id - intel-mkl/2017.0.098-gqttdpp - netcdf/4.4.1-qy35uvc - netcdf-fortran/4.4.4-2jrvsdv - openmpi/2.0.1-verbs-id2i464 - cmake/3.14.1-ymmizo4 + +openmpi-3.1.3-intel-18.0.3-acme-new + +hdf5-1.10.4-intel-18.0.3-openmpi-3.1.3-acme + +netcdf-4.6.2-intel-18.0.3-openmpi-3.1.3-acme + +netcdf-cxx-4.2-intel-18.0.3-openmpi-3.1.3-acme + +netcdf-fortran-4.4.4-intel-18.0.3-openmpi-3.1.3-acme + +parallel-netcdf-1.10.0-intel-18.0.3-openmpi-3.1.3-acme - gcc/8.2.0-g7hppkz - intel-mkl/2018.4.274-2amycpi - cmake - eigen + +gcc-7.3.0 - mvapich2/2.3.1-verbs-wcfqbl5 - parallel-netcdf/1.8.1-mnott45 - hdf5/1.10.5-rd4hbge - netcdf/4.4.1-x43bojv - netcdf-fortran/4.4.4-nbrqul6 - netcdf-cxx/4.2-fmuu33d + +mvapich2-2.3-gcc-7.3.0-acme + +hdf5-1.10.4-gcc-7.3.0-mvapich2-2.3-acme + +netcdf-c-4.6.1-cxx-4.2-f77-4.4.4-gcc-7.3.0-mvapich2-2.3-acme + +parallel-netcdf-1.8.0-gcc-7.3.0-mvapich2-2.3-acme - openmpi/3.1.3-verbs-q4swt25 + +openmpi-3.1.2-gcc-7.3.0-acme + +netcdf-c-4.6.1-cxx-4.2-f77-4.4.4-gcc-7.3.0-openmpi-3.1.2-acme + +parallel-netcdf-1.8.0-gcc-7.3.0-openmpi-3.1.2-acme + +hdf5-1.10.4-gcc-7.3.0-openmpi-3.1.2-acme $CIME_OUTPUT_ROOT/$CASE/run @@ -2385,18 +2417,21 @@ $SHELL{which nc-config | xargs dirname | xargs dirname} $SHELL{which nf-config | xargs dirname | xargs dirname} - /lcrc/group/acme/soft/perl/5.26.0/bin:$ENV{PATH} + + + $SHELL{which pnetcdf_version | xargs dirname | xargs dirname} - $SHELL{pnetcdf-config --prefix} + 0 + 1 1 - 1 2 64M + 1 granularity=thread,scatter From 3f6b4d7a560a5935c4705e29ed2e5c02bf064bf9 Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Thu, 30 May 2019 00:01:12 -0500 Subject: [PATCH 032/467] projected tags need to be created in advance on ocean pes otherwise migration of the tag will fail (silently) --- driver-moab/main/cplcomp_exchange_mod.F90 | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) diff --git a/driver-moab/main/cplcomp_exchange_mod.F90 b/driver-moab/main/cplcomp_exchange_mod.F90 index e80e117bec56..c59ebfe08c67 100644 --- a/driver-moab/main/cplcomp_exchange_mod.F90 +++ b/driver-moab/main/cplcomp_exchange_mod.F90 @@ -1070,10 +1070,15 @@ subroutine cplcomp_moab_Init(comp) ! define here the tag that will be projected back from atmosphere ! TODO where do we want to define this? - tagnameProj = 'a2oTAG_proj'//CHAR(0) + tagnameProj = 'a2oTbot_proj'//CHAR(0) tagtype = 1 ! dense, double numco = 1 ! one value per cell ierr = iMOAB_DefineTagStorage(mpoid, tagnameProj, tagtype, numco, tagindex ) + ! define more tags + tagnameProj = 'a2oUbot_proj'//CHAR(0) ! U component of velocity + ierr = iMOAB_DefineTagStorage(mpoid, tagnameProj, tagtype, numco, tagindex ) + tagnameProj = 'a2oVbot_proj'//CHAR(0) ! V component of velocity + ierr = iMOAB_DefineTagStorage(mpoid, tagnameProj, tagtype, numco, tagindex ) endif From b38280c8eccf75398bc063e5e66b804ed3f71139 Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Wed, 12 Jun 2019 08:42:27 -0500 Subject: [PATCH 033/467] understand better mct domain for components use moab h5m file to dump mct grids activated only when MOABDEBUGMCT is defined --- driver-moab/main/cime_comp_mod.F90 | 30 +++ driver-moab/main/component_type_mod.F90 | 234 +++++++++++++++++++++++- 2 files changed, 261 insertions(+), 3 deletions(-) diff --git a/driver-moab/main/cime_comp_mod.F90 b/driver-moab/main/cime_comp_mod.F90 index 8aa534926328..4172977a2100 100644 --- a/driver-moab/main/cime_comp_mod.F90 +++ b/driver-moab/main/cime_comp_mod.F90 @@ -175,6 +175,11 @@ module cime_comp_mod ! --- timing routines --- use t_drv_timers_mod +#ifdef MOABDEBUGMCT + ! --- expose grid with MOAB + use component_type_mod , only: expose_mct_grid_moab +#endif + implicit none private @@ -2079,6 +2084,31 @@ subroutine cime_init() call shr_sys_flush(logunit) endif +#ifdef MOABDEBUGMCT + if (iamroot_CPLID )then + write(logunit,*) ' ' + write(logunit,F00) ' start output mct data with MOAB ' + write(logunit,*) ' ' + call shr_sys_flush(logunit) + endif + if (atm_present) then + call expose_mct_grid_moab(atm(1)) + endif + if (lnd_present) then + call expose_mct_grid_moab(lnd(1)) + endif + if (ocn_present) then + call expose_mct_grid_moab(ocn(1)) + endif + if (ice_present) then + call expose_mct_grid_moab(ice(1)) + endif + if (rof_present) then + call expose_mct_grid_moab(rof(1)) + endif + +#endif + call t_adj_detailf(-1) call t_stopf('CPL:cime_init') diff --git a/driver-moab/main/component_type_mod.F90 b/driver-moab/main/component_type_mod.F90 index 83a6be70c00f..a6fe05525536 100644 --- a/driver-moab/main/component_type_mod.F90 +++ b/driver-moab/main/component_type_mod.F90 @@ -14,10 +14,13 @@ module component_type_mod use seq_comm_mct , only: num_inst_ocn, num_inst_ice, num_inst_glc use seq_comm_mct , only: num_inst_wav, num_inst_esp use mct_mod - + use seq_comm_mct , only: CPLID + use seq_comm_mct , only: seq_comm_getinfo => seq_comm_setptrs + use abortutils , only : endrun implicit none save private +#include !-------------------------------------------------------------------------- ! Public interfaces @@ -48,7 +51,9 @@ module component_type_mod public :: component_get_name public :: component_get_suffix public :: component_get_iamin_compid - +#ifdef MOABDEBUGMCT + public :: expose_mct_grid_moab +#endif !-------------------------------------------------------------------------- ! Public data !-------------------------------------------------------------------------- @@ -86,7 +91,6 @@ module component_type_mod integer :: mpicom_compid integer :: mpicom_cplcompid integer :: mpicom_cplallcompid - integer :: mbcpid logical :: iamin_compid logical :: iamin_cplcompid logical :: iamin_cplallcompid @@ -263,4 +267,228 @@ subroutine check_fields(comp, comp_index) endif end subroutine check_fields +#ifdef MOABDEBUGMCT + subroutine expose_mct_grid_moab (comp) + use shr_mpi_mod, only: shr_mpi_commrank, shr_mpi_commsize + type(component_type), intent(in) :: comp + integer :: lsz + type(mct_gGrid), pointer :: dom + integer :: mpicom_CPLID ! MPI cpl communicator + integer :: imoabAPI + integer :: iamcomp , iamcpl + integer :: ext_id + integer , external :: iMOAB_RegisterFortranApplication, iMOAB_CreateVertices, iMOAB_WriteMesh, & + iMOAB_DefineTagStorage, iMOAB_SetIntTagStorage, iMOAB_SetDoubleTagStorage, & + iMOAB_ResolveSharedEntities + ! local variables to fill in data + integer, dimension(:), allocatable :: vgids + ! retrieve everything we need from land domain mct_ldom + ! number of vertices is the size of land domain + real(r8), dimension(:), allocatable :: moab_vert_coords ! temporary + real(r8) :: latv, lonv + integer dims, i, ilat, ilon, igdx, ierr, tagindex, ixarea, ixfrac + integer tagtype, numco, ent_type + character*100 outfile, wopts, localmeshfile, tagname + character*32 appname + real(R8),parameter :: SHR_CONST_PI = 3.14159265358979323846_R8 ! pi + + dims =3 ! store as 3d mesh + + + call seq_comm_getinfo(CPLID, mpicom=mpicom_CPLID) + if (comp%iamin_compid) then + call shr_mpi_commrank(comp%mpicom_compid, iamcomp , 'expose_mct_grid_moab') + dom => component_get_dom_cc(comp) + lsz = mct_gGrid_lsize(dom) + !print *, 'lsize: cc', lsz, ' iamcomp ' ,iamcomp + appname=comp%ntype//"MOAB"//CHAR(0) + ! component instance + ext_id = comp%compid + 100 ! avoid reuse + ierr = iMOAB_RegisterFortranApplication(appname, comp%mpicom_compid, ext_id, imoabAPI) + if (ierr > 0 ) & + call endrun('Error: cannot register moab app') + allocate(moab_vert_coords(lsz*dims)) + allocate(vgids(lsz)) + ilat = MCT_GGrid_indexRA(dom,'lat') + ilon = MCT_GGrid_indexRA(dom,'lon') + igdx = MCT_GGrid_indexIA(dom,'GlobGridNum') + do i = 1, lsz + latv = dom%data%rAttr(ilat, i) *SHR_CONST_PI/180. + lonv = dom%data%rAttr(ilon, i) *SHR_CONST_PI/180. + moab_vert_coords(3*i-2)=COS(latv)*COS(lonv) + moab_vert_coords(3*i-1)=COS(latv)*SIN(lonv) + moab_vert_coords(3*i )=SIN(latv) + vgids(i) = dom%data%iAttr(igdx, i) + enddo + + ierr = iMOAB_CreateVertices(imoabAPI, lsz*3, dims, moab_vert_coords) + if (ierr > 0 ) & + call endrun('Error: fail to create MOAB vertices in land model') + + tagtype = 0 ! dense, integer + numco = 1 + tagname='GLOBAL_ID'//CHAR(0) + ierr = iMOAB_DefineTagStorage(imoabAPI, tagname, tagtype, numco, tagindex ) + if (ierr > 0 ) & + call endrun('Error: fail to retrieve GLOBAL_ID tag ') + + ent_type = 0 ! vertex type + ierr = iMOAB_SetIntTagStorage ( imoabAPI, tagname, lsz , ent_type, vgids) + if (ierr > 0 ) & + call endrun('Error: fail to set GLOBAL_ID tag ') + + ierr = iMOAB_ResolveSharedEntities( imoabAPI, lsz, vgids ); + if (ierr > 0 ) & + call endrun('Error: fail to resolve shared entities') + + !there are no shared entities, but we will set a special partition tag, in order to see the + ! partitions ; it will be visible with a Pseudocolor plot in VisIt + tagname='partition'//CHAR(0) + ierr = iMOAB_DefineTagStorage(imoabAPI, tagname, tagtype, numco, tagindex ) + if (ierr > 0 ) & + call endrun('Error: fail to create new partition tag ') + + vgids = iamcomp + ierr = iMOAB_SetIntTagStorage ( imoabAPI, tagname, lsz , ent_type, vgids) + if (ierr > 0 ) & + call endrun('Error: fail to set partition tag ') + + ! use moab_vert_coords as a data holder for a frac tag and area tag that we will create + ! on the vertices; do not allocate other data array + ! do not be confused by this ! + ixfrac = MCT_GGrid_indexRA(dom,'frac') + ixarea = MCT_GGrid_indexRA(dom,'area') + tagname='frac'//CHAR(0) + tagtype = 1 ! dense, double + ierr = iMOAB_DefineTagStorage(imoabAPI, tagname, tagtype, numco, tagindex ) + if (ierr > 0 ) & + call endrun('Error: fail to create frac tag ') + + do i = 1, lsz + moab_vert_coords(i) = dom%data%rAttr(ixfrac, i) + enddo + ierr = iMOAB_SetDoubleTagStorage ( imoabAPI, tagname, lsz , ent_type, moab_vert_coords) + if (ierr > 0 ) & + call endrun('Error: fail to set frac tag ') + + tagname='area'//CHAR(0) + ierr = iMOAB_DefineTagStorage(imoabAPI, tagname, tagtype, numco, tagindex ) + if (ierr > 0 ) & + call endrun('Error: fail to create area tag ') + do i = 1, lsz + moab_vert_coords(i) = dom%data%rAttr(ixarea, i) ! use the same doubles for second tag :) + enddo + + ierr = iMOAB_SetDoubleTagStorage ( imoabAPI, tagname, lsz , ent_type, moab_vert_coords ) + if (ierr > 0 ) & + call endrun('Error: fail to set area tag ') + + deallocate(moab_vert_coords) + deallocate(vgids) + ! write out the mesh file to disk, in parallel + outfile = 'WHOLE_'//comp%ntype//'.h5m'//CHAR(0) + wopts = 'PARALLEL=WRITE_PART'//CHAR(0) + ierr = iMOAB_WriteMesh(imoabAPI, outfile, wopts) + if (ierr > 0 ) & + call endrun('Error: fail to write the land mesh file') + endif + if (mpicom_CPLID /= MPI_COMM_NULL) then + call shr_mpi_commrank(mpicom_CPLID, iamcpl , 'expose_mct_grid_moab') + dom => component_get_dom_cx(comp) + lsz = mct_gGrid_lsize(dom) + !print *, 'lsize: cx', lsz, ' iamcpl ' , iamcpl + appname=comp%ntype//"CPMOAB"//CHAR(0) + ! component instance + ext_id = comp%compid + 200 ! avoid reuse + ierr = iMOAB_RegisterFortranApplication(appname, mpicom_CPLID, ext_id, imoabAPI) + if (ierr > 0 ) & + call endrun('Error: cannot register moab app') + allocate(moab_vert_coords(lsz*dims)) + allocate(vgids(lsz)) + ilat = MCT_GGrid_indexRA(dom,'lat') + ilon = MCT_GGrid_indexRA(dom,'lon') + igdx = MCT_GGrid_indexIA(dom,'GlobGridNum') + do i = 1, lsz + latv = dom%data%rAttr(ilat, i) *SHR_CONST_PI/180. + lonv = dom%data%rAttr(ilon, i) *SHR_CONST_PI/180. + moab_vert_coords(3*i-2)=COS(latv)*COS(lonv) + moab_vert_coords(3*i-1)=COS(latv)*SIN(lonv) + moab_vert_coords(3*i )=SIN(latv) + vgids(i) = dom%data%iAttr(igdx, i) + enddo + + ierr = iMOAB_CreateVertices(imoabAPI, lsz*3, dims, moab_vert_coords) + if (ierr > 0 ) & + call endrun('Error: fail to create MOAB vertices in land model') + + tagtype = 0 ! dense, integer + numco = 1 + tagname='GLOBAL_ID'//CHAR(0) + ierr = iMOAB_DefineTagStorage(imoabAPI, tagname, tagtype, numco, tagindex ) + if (ierr > 0 ) & + call endrun('Error: fail to retrieve GLOBAL_ID tag ') + + ent_type = 0 ! vertex type + ierr = iMOAB_SetIntTagStorage ( imoabAPI, tagname, lsz , ent_type, vgids) + if (ierr > 0 ) & + call endrun('Error: fail to set GLOBAL_ID tag ') + + ierr = iMOAB_ResolveSharedEntities( imoabAPI, lsz, vgids ); + if (ierr > 0 ) & + call endrun('Error: fail to resolve shared entities') + + !there are no shared entities, but we will set a special partition tag, in order to see the + ! partitions ; it will be visible with a Pseudocolor plot in VisIt + tagname='partition'//CHAR(0) + ierr = iMOAB_DefineTagStorage(imoabAPI, tagname, tagtype, numco, tagindex ) + if (ierr > 0 ) & + call endrun('Error: fail to create new partition tag ') + + vgids = iamcpl + ierr = iMOAB_SetIntTagStorage ( imoabAPI, tagname, lsz , ent_type, vgids) + if (ierr > 0 ) & + call endrun('Error: fail to set partition tag ') + + ! use moab_vert_coords as a data holder for a frac tag and area tag that we will create + ! on the vertices; do not allocate other data array + ! do not be confused by this ! + ixfrac = MCT_GGrid_indexRA(dom,'frac') + ixarea = MCT_GGrid_indexRA(dom,'area') + tagname='frac'//CHAR(0) + tagtype = 1 ! dense, double + ierr = iMOAB_DefineTagStorage(imoabAPI, tagname, tagtype, numco, tagindex ) + if (ierr > 0 ) & + call endrun('Error: fail to create frac tag ') + + do i = 1, lsz + moab_vert_coords(i) = dom%data%rAttr(ixfrac, i) + enddo + ierr = iMOAB_SetDoubleTagStorage ( imoabAPI, tagname, lsz , ent_type, moab_vert_coords) + if (ierr > 0 ) & + call endrun('Error: fail to set frac tag ') + + tagname='area'//CHAR(0) + ierr = iMOAB_DefineTagStorage(imoabAPI, tagname, tagtype, numco, tagindex ) + if (ierr > 0 ) & + call endrun('Error: fail to create area tag ') + do i = 1, lsz + moab_vert_coords(i) = dom%data%rAttr(ixarea, i) ! use the same doubles for second tag :) + enddo + + ierr = iMOAB_SetDoubleTagStorage ( imoabAPI, tagname, lsz , ent_type, moab_vert_coords ) + if (ierr > 0 ) & + call endrun('Error: fail to set area tag ') + + deallocate(moab_vert_coords) + deallocate(vgids) + ! write out the mesh file to disk, in parallel + outfile = 'WHOLE_cx_'//comp%ntype//'.h5m'//CHAR(0) + wopts = 'PARALLEL=WRITE_PART'//CHAR(0) + ierr = iMOAB_WriteMesh(imoabAPI, outfile, wopts) + if (ierr > 0 ) & + call endrun('Error: fail to write the land mesh file') + endif + + end subroutine expose_mct_grid_moab +#endif end module component_type_mod From f88869aac09b259d68b186548bd2e835348bfc53 Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Mon, 29 Jul 2019 10:33:29 -0500 Subject: [PATCH 034/467] glc model is usually off, check flag before calling moab --- driver-moab/main/cime_comp_mod.F90 | 3 +++ 1 file changed, 3 insertions(+) diff --git a/driver-moab/main/cime_comp_mod.F90 b/driver-moab/main/cime_comp_mod.F90 index 4172977a2100..a1d96a570b67 100644 --- a/driver-moab/main/cime_comp_mod.F90 +++ b/driver-moab/main/cime_comp_mod.F90 @@ -2106,6 +2106,9 @@ subroutine cime_init() if (rof_present) then call expose_mct_grid_moab(rof(1)) endif + if (glc_present) then + call expose_mct_grid_moab(glc(1)) + endif #endif From 715bd8be68372c8b487e74de9c90cfd0c1c68a6e Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Wed, 23 Oct 2019 17:30:28 -0500 Subject: [PATCH 035/467] forgotten guard for writing moab files --- components/homme/src/tool/semoab_mod.F90 | 8 ++++---- driver-moab/main/prep_atm_mod.F90 | 2 ++ 2 files changed, 6 insertions(+), 4 deletions(-) diff --git a/components/homme/src/tool/semoab_mod.F90 b/components/homme/src/tool/semoab_mod.F90 index 9899ac77584a..2728874288f0 100644 --- a/components/homme/src/tool/semoab_mod.F90 +++ b/components/homme/src/tool/semoab_mod.F90 @@ -255,7 +255,7 @@ subroutine create_moab_mesh_fine(par, elem, nets, nete) ierr = iMOAB_GetIntTagStorage ( MHFID, newtagg, nverts , ent_type, vgids) if (ierr > 0 ) & call endrun('Error: fail to retrieve GLOBAL ID on each task') - +#ifdef MOABDEBUG ! write in serial, on each task, before ghosting if (par%rank .lt. 4) then write(lnum,"(I0.2)")par%rank @@ -265,7 +265,7 @@ subroutine create_moab_mesh_fine(par, elem, nets, nete) if (ierr > 0 ) & call endrun('Error: fail to write local mesh file') endif - +#endif ierr = iMOAB_UpdateMeshInfo(MHFID) if (ierr > 0 ) & call endrun('Error: fail to update mesh info') @@ -458,7 +458,7 @@ subroutine create_moab_mesh_fine(par, elem, nets, nete) if (ierr > 0 ) & call endrun('Error: fail to create atm to ocean tag') - +#ifdef MOABDEBUG ! write in serial, on each task, before ghosting if (par%rank .lt. 5) then write(lnum,"(I0.2)")par%rank @@ -468,7 +468,7 @@ subroutine create_moab_mesh_fine(par, elem, nets, nete) if (ierr > 0 ) & call endrun('Error: fail to write local mesh file') endif - +#endif ierr = iMOAB_UpdateMeshInfo(MHID) if (ierr > 0 ) & call endrun('Error: fail to update mesh info') diff --git a/driver-moab/main/prep_atm_mod.F90 b/driver-moab/main/prep_atm_mod.F90 index f8da1f982792..89a7edd18f1b 100644 --- a/driver-moab/main/prep_atm_mod.F90 +++ b/driver-moab/main/prep_atm_mod.F90 @@ -181,6 +181,7 @@ subroutine prep_atm_init(infodata, ocn_c2_atm, ice_c2_atm, lnd_c2_atm) idintx = atm(1)%cplcompid + 100*ocn(1)%cplcompid ! something different, to differentiate it ierr = iMOAB_RegisterFortranApplication(trim(appname), mpicom_CPLID, idintx, mbintxoa) ierr = iMOAB_ComputeMeshIntersectionOnSphere (mbaxid, mboxid, mbintxoa) +#ifdef MOABDEBUG wopts = CHAR(0) call shr_mpi_commrank( mpicom_CPLID, rank ) if (rank .lt. 5) then @@ -188,6 +189,7 @@ subroutine prep_atm_init(infodata, ocn_c2_atm, ice_c2_atm, lnd_c2_atm) outfile = 'intx'//trim(lnum)// '.h5m' // CHAR(0) ierr = iMOAB_WriteMesh(mbintxoa, outfile, wopts) ! write local intx file endif +#endif end if ! needed for domain checking From 21ce96b26c76ee5f66d473e7c73cf2469148bcee Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Wed, 23 Oct 2019 23:21:00 -0500 Subject: [PATCH 036/467] context argument for migrate tags and coverage mesh context is now the ocean-coupler --- driver-moab/main/prep_atm_mod.F90 | 16 +++++++++++----- driver-moab/main/prep_ocn_mod.F90 | 7 ++++--- 2 files changed, 15 insertions(+), 8 deletions(-) diff --git a/driver-moab/main/prep_atm_mod.F90 b/driver-moab/main/prep_atm_mod.F90 index 89a7edd18f1b..41177d5b06f8 100644 --- a/driver-moab/main/prep_atm_mod.F90 +++ b/driver-moab/main/prep_atm_mod.F90 @@ -270,6 +270,7 @@ subroutine prep_atm_ocn_moab(infodata) logical :: ocn_present ! .true. => ocn is present integer :: id_join integer :: mpicom_join + integer :: context_id ! used to define context for coverage (this case, ocean on coupler) integer :: atmid character*32 :: dm1, dm2, dofnameATM, dofnameOCN, wgtIdef integer :: orderOCN, orderATM, volumetric, noConserve, validate @@ -287,10 +288,13 @@ subroutine prep_atm_ocn_moab(infodata) ! how to get mpicomm for joint atm + coupler id_join = atm(1)%cplcompid atmid = atm(1)%compid + ! maybe we can use a moab-only id, defined like mbintxoa, mhid, somewhere else (seq_comm_mct) + ! we cannot use mbintxoa because it may not exist on atm comp yet; + context_id = ocn(1)%cplcompid call seq_comm_getinfo(ID_join,mpicom=mpicom_join) ! it happens over joint communicator - ierr = iMOAB_CoverageGraph(mpicom_join, mhid, atmid, mbaxid, id_join, mbintxoa); + ierr = iMOAB_CoverageGraph(mpicom_join, mhid, atmid, mbaxid, id_join, mbintxoa, context_id); wgtIdef = 'scalar'//CHAR(0) dm1 = "cgll"//CHAR(0) @@ -327,6 +331,7 @@ subroutine prep_atm_migrate_moab(infodata) integer :: id_join integer :: mpicom_join integer :: atmid + integer :: context_id ! we will use ocean context character*32 :: dm1, dm2, tagName, wgtIdef character*50 :: outfile, wopts, tagnameProj integer :: orderOCN, orderATM, volumetric, noConserve, validate @@ -344,10 +349,11 @@ subroutine prep_atm_migrate_moab(infodata) ! how to get mpicomm for joint atm + coupler id_join = atm(1)%cplcompid atmid = atm(1)%compid - call seq_comm_getinfo(ID_join,mpicom=mpicom_join) - + call seq_comm_getinfo(ID_join,mpicom=mpicom_join) + ! we should do this only of ocn_present + context_id = ocn(1)%cplcompid ! now send the tags a2o?bot from original atmosphere mhid(pid1) towards migrated coverage mesh (pid3), using the new coverage graph communicator tagName = 'a2oTbot;a2oUbot;a2oVbot;'//CHAR(0) ! they are defined in semoab_mod.F90!!! ! the separator will be ';' semicolon @@ -359,12 +365,12 @@ subroutine prep_atm_migrate_moab(infodata) ! trivial partitioning, now we need to adjust it for "coverage" mesh ! as always, use nonblocking sends - ierr = iMOAB_SendElementTag(mhid, atmid, id_join, tagName, mpicom_join) + ierr = iMOAB_SendElementTag(mhid, atmid, id_join, tagName, mpicom_join, context_id) endif if (mbaxid .ge. 0 ) then ! we are on coupler pes, for sure ! receive on atm on coupler pes, that was redistributed according to coverage - ierr = iMOAB_ReceiveElementTag(mbaxid, atmid, id_join, tagName, mpicom_join) + ierr = iMOAB_ReceiveElementTag(mbaxid, atmid, id_join, tagName, mpicom_join, context_id) !CHECKRC(ierr, "cannot receive tag values") endif diff --git a/driver-moab/main/prep_ocn_mod.F90 b/driver-moab/main/prep_ocn_mod.F90 index 74ce4bee0f00..04f1166a730d 100644 --- a/driver-moab/main/prep_ocn_mod.F90 +++ b/driver-moab/main/prep_ocn_mod.F90 @@ -1478,6 +1478,7 @@ subroutine prep_ocn_migrate_moab(infodata) integer :: id_join integer :: mpicom_join integer :: atmid + integer :: context_id character*32 :: dm1, dm2 character*50 :: tagName character*32 :: outfile, wopts @@ -1497,19 +1498,19 @@ subroutine prep_ocn_migrate_moab(infodata) id_join = ocn(1)%cplcompid ocnid = ocn(1)%compid call seq_comm_getinfo(ID_join,mpicom=mpicom_join) - + context_id = -1 ! now send the tag a2oTbot_proj, a2oUbot_proj, a2oVbot_proj from ocn on coupler pes towards original ocean mesh tagName = 'a2oTbot_proj;a2oUbot_proj;a2oVbot_proj;'//CHAR(0) ! defined in prep_atm_mod.F90!!! if (mboxid .ge. 0) then ! send because we are on coupler pes ! basically, use the initial partitioning - ierr = iMOAB_SendElementTag(mboxid, id_join, ocnid, tagName, mpicom_join) + ierr = iMOAB_SendElementTag(mboxid, id_join, ocnid, tagName, mpicom_join, context_id) endif if (mpoid .ge. 0 ) then ! we are on ocean pes, for sure ! receive on ocean pes, a tag that was computed on coupler pes - ierr = iMOAB_ReceiveElementTag(mpoid, id_join, ocnid, tagName, mpicom_join) + ierr = iMOAB_ReceiveElementTag(mpoid, id_join, ocnid, tagName, mpicom_join, context_id) !CHECKRC(ierr, "cannot receive tag values") endif From 545a74d545f1e28c668ab4f7beb23ba012ef9322 Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Thu, 24 Oct 2019 01:19:11 -0500 Subject: [PATCH 037/467] land atm coupling needs moab to be built on iulian07/atm-lnd-coupl branch it has the land atm projection --- driver-moab/main/cime_comp_mod.F90 | 10 +- driver-moab/main/cplcomp_exchange_mod.F90 | 25 ++- driver-moab/main/prep_atm_mod.F90 | 190 ++++++++++++++++++---- driver-moab/main/prep_ocn_mod.F90 | 2 +- 4 files changed, 184 insertions(+), 43 deletions(-) diff --git a/driver-moab/main/cime_comp_mod.F90 b/driver-moab/main/cime_comp_mod.F90 index a1d96a570b67..291e78b6958f 100644 --- a/driver-moab/main/cime_comp_mod.F90 +++ b/driver-moab/main/cime_comp_mod.F90 @@ -1647,6 +1647,8 @@ subroutine cime_init() ! need to finish up the computation of the atm - ocean map (tempest) if (iamin_CPLALLATMID .and. ocn_c2_atm) call prep_atm_ocn_moab(infodata) + ! need to finish up the computation of the atm - land map ( point cloud) + if (iamin_CPLALLATMID .and. atm_c2_lnd) call prep_atm_lnd_moab(infodata) !---------------------------------------------------------- !| Update aream in domains where appropriate !---------------------------------------------------------- @@ -3556,12 +3558,18 @@ subroutine cime_run() endif endif - ! send temp from atm to ocean mesh, after projection + ! send projected data from atm to ocean mesh, after projection in coupler if (iamin_CPLALLOCNID .and. ocn_c2_atm) then ! migrate that tag from coupler pes to ocean pes call prep_ocn_migrate_moab(infodata) endif + ! send projected data from atm to land mesh, after projection in coupler + if (iamin_CPLALLLNDID .and. atm_c2_lnd) then + ! migrate that tag from coupler pes to ocean pes + call prep_lnd_migrate_moab(infodata) + endif + !---------------------------------------------------------- !| Budget with new fractions !---------------------------------------------------------- diff --git a/driver-moab/main/cplcomp_exchange_mod.F90 b/driver-moab/main/cplcomp_exchange_mod.F90 index c59ebfe08c67..510cdeb8a6dd 100644 --- a/driver-moab/main/cplcomp_exchange_mod.F90 +++ b/driver-moab/main/cplcomp_exchange_mod.F90 @@ -14,7 +14,7 @@ module cplcomp_exchange_mod use seq_diag_mct use seq_comm_mct, only : mhid, mpoid, mbaxid, mboxid ! iMOAB app ids, for atm, ocean, ax mesh, ox mesh - use seq_comm_mct, only : mlnid , mlnxid ! iMOAB app id for land , on land pes and coupler pes + use seq_comm_mct, only : mlnid , mblxid ! iMOAB app id for land , on land pes and coupler pes use shr_mpi_mod, only: shr_mpi_max implicit none @@ -1125,26 +1125,37 @@ subroutine cplcomp_moab_Init(comp) if (MPI_COMM_NULL /= mpicom_new ) then ! we are on the coupler pes appname = "COUPLE_LAND"//CHAR(0) ! migrated mesh gets another app id, moab ocean to coupler (mbox) - ierr = iMOAB_RegisterFortranApplication(trim(appname), mpicom_new, id_join, mlnxid) - ierr = iMOAB_ReceiveMesh(mlnxid, mpicom_join, mpigrp_old, id_old) + ierr = iMOAB_RegisterFortranApplication(trim(appname), mpicom_new, id_join, mblxid) + ierr = iMOAB_ReceiveMesh(mblxid, mpicom_join, mpigrp_old, id_old) + ! define here the tag that will be projected from atmosphere + tagnameProj = 'a2lTbot_proj'//CHAR(0) ! temperature + tagtype = 1 ! dense, double + numco = 1 ! one value per vertex / entity + ierr = iMOAB_DefineTagStorage(mblxid, tagnameProj, tagtype, numco, tagindex ) + + ! define more tags + tagnameProj = 'a2lUbot_proj'//CHAR(0) ! U component of velocity + ierr = iMOAB_DefineTagStorage(mblxid, tagnameProj, tagtype, numco, tagindex ) + tagnameProj = 'a2lVbot_proj'//CHAR(0) ! V component of velocity + ierr = iMOAB_DefineTagStorage(mblxid, tagnameProj, tagtype, numco, tagindex ) #ifdef MOABDEBUG !there are no shared entities, but we will set a special partition tag, in order to see the ! partitions ; it will be visible with a Pseudocolor plot in VisIt tagname='partition'//CHAR(0) tagtype = 0 ! dense, integer numco = 1 ! one value per cell - ierr = iMOAB_DefineTagStorage(mlnxid, tagname, tagtype, numco, tagindex ) - ierr = iMOAB_GetMeshInfo(mlnxid, nverts, nelem, nblocks, nsbc, ndbc) + ierr = iMOAB_DefineTagStorage(mblxid, tagname, tagtype, numco, tagindex ) + ierr = iMOAB_GetMeshInfo(mblxid, nverts, nelem, nblocks, nsbc, ndbc) allocate(vgids(nverts(1))) vgids = rank ent_type = 0 ! vertex type - ierr = iMOAB_SetIntTagStorage ( mlnxid, tagname, nverts(1) , ent_type, vgids) + ierr = iMOAB_SetIntTagStorage ( mblxid, tagname, nverts(1) , ent_type, vgids) ! debug test outfile = 'recLand.h5m'//CHAR(0) wopts = ';PARALLEL=WRITE_PART'//CHAR(0) ! ! write out the mesh file to disk - ierr = iMOAB_WriteMesh(mlnxid, trim(outfile), trim(wopts)) + ierr = iMOAB_WriteMesh(mblxid, trim(outfile), trim(wopts)) #endif endif endif diff --git a/driver-moab/main/prep_atm_mod.F90 b/driver-moab/main/prep_atm_mod.F90 index 41177d5b06f8..707c676294f3 100644 --- a/driver-moab/main/prep_atm_mod.F90 +++ b/driver-moab/main/prep_atm_mod.F90 @@ -22,6 +22,8 @@ module prep_atm_mod use seq_comm_mct, only : mboxid ! iMOAB id for mpas ocean migrated mesh to coupler pes use seq_comm_mct, only : mbintxoa ! iMOAB id for intx mesh between ocean and atmosphere; output from this use seq_comm_mct, only : mhid ! iMOAB id for atm instance + use seq_comm_mct, only : mblxid ! iMOAB id for land migrated to coupler pes !! old name : mlnxid + use seq_comm_mct, only : mbintxla ! iMOAB id for intx mesh between land and atmmosphere use seq_comm_mct, only : seq_comm_getinfo => seq_comm_setptrs use dimensions_mod, only : np ! for atmosphere @@ -52,7 +54,7 @@ module prep_atm_mod public :: prep_atm_get_mapper_Si2a public :: prep_atm_get_mapper_Fi2a - public :: prep_atm_ocn_moab, prep_atm_migrate_moab + public :: prep_atm_ocn_moab, prep_atm_migrate_moab, prep_atm_lnd_moab !-------------------------------------------------------------------------- ! Private interfaces @@ -115,7 +117,7 @@ subroutine prep_atm_init(infodata, ocn_c2_atm, ice_c2_atm, lnd_c2_atm) character(*), parameter :: subname = '(prep_atm_init)' character(*), parameter :: F00 = "('"//subname//" : ', 4A )" integer, external :: iMOAB_ComputeMeshIntersectionOnSphere, iMOAB_RegisterFortranApplication, & - iMOAB_WriteMesh + iMOAB_WriteMesh, iMOAB_ComputePointDoFIntersection integer ierr, idintx, rank character*32 :: appname, outfile, wopts, lnum !--------------------------------------------------------------- @@ -178,7 +180,7 @@ subroutine prep_atm_init(infodata, ocn_c2_atm, ice_c2_atm, lnd_c2_atm) appname = "ATM_OCN_COU"//CHAR(0) ! idintx is a unique number of MOAB app that takes care of intx between ocn and atm mesh - idintx = atm(1)%cplcompid + 100*ocn(1)%cplcompid ! something different, to differentiate it + idintx = 100*atm(1)%cplcompid + ocn(1)%cplcompid ! something different, to differentiate it ierr = iMOAB_RegisterFortranApplication(trim(appname), mpicom_CPLID, idintx, mbintxoa) ierr = iMOAB_ComputeMeshIntersectionOnSphere (mbaxid, mboxid, mbintxoa) #ifdef MOABDEBUG @@ -246,6 +248,12 @@ subroutine prep_atm_init(infodata, ocn_c2_atm, ice_c2_atm, lnd_c2_atm) call seq_map_init_rcfile(mapper_Sl2a, lnd(1), atm(1), & 'seq_maps.rc','lnd2atm_smapname:','lnd2atm_smaptype:',samegrid_al, & 'mapper_Sl2a initialization',esmf_map_flag) + + appname = "ATM_LND_COU"//CHAR(0) + ! idintx is a unique number of MOAB app that takes care of intx between lnd and atm mesh + idintx = 100*atm(1)%cplcompid + lnd(1)%cplcompid ! something different, to differentiate it + ierr = iMOAB_RegisterFortranApplication(trim(appname), mpicom_CPLID, idintx, mbintxla) + ierr = iMOAB_ComputePointDoFIntersection (mbaxid, mblxid, mbintxla) end if @@ -315,6 +323,69 @@ subroutine prep_atm_ocn_moab(infodata) endif end subroutine prep_atm_ocn_moab + subroutine prep_atm_lnd_moab(infodata) + !--------------------------------------------------------------- + ! Description + ! After intersection of atm and land mesh, correct the communication graph + ! between atm instance and atm on coupler (due to coverage), in the context of land + ! also, compute the map; this would be equivalent to seq_map_init_rcfile on the + ! mapping file computed offline (this will be now online) + ! + ! Arguments + type(seq_infodata_type) , intent(in) :: infodata + + integer :: ierr + + logical :: atm_present ! .true. => atm is present + logical :: lnd_present ! .true. => lnd is present + integer :: id_join + integer :: mpicom_join + integer :: context_id ! used to define context for coverage (this case, land on coupler) + integer :: atmid + character*32 :: dm1, dm2, dofnameATM, dofnameLND, wgtIdef + integer :: orderLND, orderATM, volumetric, noConserve, validate + integer :: monotonicity + + integer, external :: iMOAB_CoverageGraph, iMOAB_ComputeScalarProjectionWeights + + call seq_infodata_getData(infodata, & + atm_present=atm_present, & + lnd_present=lnd_present) + + ! it involves initial atm app; mhid; also migrate atm mesh on coupler pes, mbaxid + ! intx lnd atm are in mbintxla ; remapper also has some info about coverage mesh + ! after this, the sending of tags from atm pes to coupler pes, in land context will use the new par + ! comm graph, that has more precise info about + ! how to get mpicomm for joint atm + coupler + id_join = atm(1)%cplcompid + atmid = atm(1)%compid + ! maybe we can use a moab-only id, defined like mbintxoa, mhid, somewhere else (seq_comm_mct) + ! we cannot use mbintxla because it may not exist on atm comp yet; + context_id = lnd(1)%cplcompid + call seq_comm_getinfo(ID_join,mpicom=mpicom_join) + + ! it happens over joint communicator + ierr = iMOAB_CoverageGraph(mpicom_join, mhid, atmid, mbaxid, id_join, mbintxla, context_id); + + wgtIdef = 'scalar'//CHAR(0) + dm1 = "cgll"//CHAR(0) + dm2 = "pcloud"//CHAR(0) + dofnameATM="GLOBAL_DOFS"//CHAR(0) + dofnameLND="GLOBAL_ID"//CHAR(0) + orderATM = np ! it should be 4 + orderLND = 1 ! not much arguing + monotonicity = 0 ! + volumetric = 0 + noConserve = 0 + validate = 1 + if (mbintxoa .ge. 0 ) then + ierr = iMOAB_ComputeScalarProjectionWeights ( mbintxla, wgtIdef, & + trim(dm1), orderATM, trim(dm2), orderLND, & + monotonicity, volumetric, noConserve, validate, & + trim(dofnameATM), trim(dofnameLND) ) + endif + end subroutine prep_atm_lnd_moab + subroutine prep_atm_migrate_moab(infodata) !--------------------------------------------------------------- ! Description @@ -328,6 +399,7 @@ subroutine prep_atm_migrate_moab(infodata) logical :: atm_present ! .true. => atm is present logical :: ocn_present ! .true. => ocn is present + logical :: lnd_present ! .true. => lnd is present integer :: id_join integer :: mpicom_join integer :: atmid @@ -341,7 +413,8 @@ subroutine prep_atm_migrate_moab(infodata) call seq_infodata_getData(infodata, & atm_present=atm_present, & - ocn_present=ocn_present) + ocn_present=ocn_present, & + lnd_present=lnd_present) ! it involves initial atm app; mhid; also migrate atm mesh on coupler pes, mbaxid ! intx ocean atm are in mbintxoa ; remapper also has some info about coverage mesh @@ -352,50 +425,99 @@ subroutine prep_atm_migrate_moab(infodata) call seq_comm_getinfo(ID_join,mpicom=mpicom_join) - ! we should do this only of ocn_present +! we should do this only of ocn_present + context_id = ocn(1)%cplcompid ! now send the tags a2o?bot from original atmosphere mhid(pid1) towards migrated coverage mesh (pid3), using the new coverage graph communicator tagName = 'a2oTbot;a2oUbot;a2oVbot;'//CHAR(0) ! they are defined in semoab_mod.F90!!! ! the separator will be ';' semicolon tagNameProj = 'a2oTbot_proj;a2oUbot_proj;a2oVbot_proj;'//CHAR(0) wgtIdef = 'scalar'//CHAR(0) - if (mhid .ge. 0) then ! send because we are on atm pes - - ! basically, adjust the migration of the tag we want to project; it was sent initially with - ! trivial partitioning, now we need to adjust it for "coverage" mesh - ! as always, use nonblocking sends + if (atm_present .and. ocn_present) then + if (mhid .ge. 0) then ! send because we are on atm pes + + ! basically, adjust the migration of the tag we want to project; it was sent initially with + ! trivial partitioning, now we need to adjust it for "coverage" mesh + ! as always, use nonblocking sends + + ierr = iMOAB_SendElementTag(mhid, atmid, id_join, tagName, mpicom_join, context_id) + + endif + if (mbaxid .ge. 0 ) then ! we are on coupler pes, for sure + ! receive on atm on coupler pes, that was redistributed according to coverage + ierr = iMOAB_ReceiveElementTag(mbaxid, atmid, id_join, tagName, mpicom_join, context_id) + !CHECKRC(ierr, "cannot receive tag values") + endif + + ! we can now free the sender buffers + if (mhid .ge. 0) then + ierr = iMOAB_FreeSenderBuffers(mhid, context_id) + ! CHECKRC(ierr, "cannot free buffers used to resend atm mesh tag towards the coverage mesh") + endif + + ! we could do the projection now, on the ocean mesh, because we are on the coupler pes; + ! the actual migrate could happen later , from coupler pes to the ocean pes + if (mbintxoa .ge. 0 ) then ! we are on coupler pes, for sure + ! we could apply weights; need to use the same weight identifier wgtIdef as when we generated it + ! hard coded now, it should be a runtime option in the future + ierr = iMOAB_ApplyScalarProjectionWeights ( mbintxoa, wgtIdef, tagName, tagNameProj) - ierr = iMOAB_SendElementTag(mhid, atmid, id_join, tagName, mpicom_join, context_id) +#ifdef MOABDEBUG + ! we can also write the ocean mesh to file, just to see the projectd tag + ! write out the mesh file to disk + outfile = 'ocn_proj.h5m'//CHAR(0) + wopts = ';PARALLEL=WRITE_PART'//CHAR(0) ! + ierr = iMOAB_WriteMesh(mboxid, trim(outfile), trim(wopts)) +#endif - endif - if (mbaxid .ge. 0 ) then ! we are on coupler pes, for sure - ! receive on atm on coupler pes, that was redistributed according to coverage - ierr = iMOAB_ReceiveElementTag(mbaxid, atmid, id_join, tagName, mpicom_join, context_id) - !CHECKRC(ierr, "cannot receive tag values") - endif + !CHECKRC(ierr, "cannot receive tag values") + endif - ! we can now free the sender buffers - if (mhid .ge. 0) then - ierr = iMOAB_FreeSenderBuffers(mhid, mpicom_join, id_join) - ! CHECKRC(ierr, "cannot free buffers used to resend atm mesh tag towards the coverage mesh") endif - - ! we could do the projection now, on the ocean mesh, because we are on the coupler pes; - ! the actual migrate could happen later , from coupler pes to the ocean pes - if (mbintxoa .ge. 0 ) then ! we are on coupler pes, for sure - ! we could apply weights; need to use the same weight identifier wgtIdef as when we generated it - ! hard coded now, it should be a runtime option in the future - ierr = iMOAB_ApplyScalarProjectionWeights ( mbintxoa, wgtIdef, tagName, tagNameProj) +! repeat this for land data, that is already on atm tag + tagNameProj = 'a2lTbot_proj;a2lUbot_proj;a2lVbot_proj;'//CHAR(0) + context_id = lnd(1)%cplcompid + wgtIdef = 'scalar-pc'//CHAR(0) + if (atm_present .and. lnd_present) then + if (mhid .ge. 0) then ! send because we are on atm pes + + ! basically, adjust the migration of the tag we want to project; it was sent initially with + ! original partitioning, now we need to adjust it for "coverage" mesh + ! as always, use nonblocking sends + + ierr = iMOAB_SendElementTag(mhid, atmid, id_join, tagName, mpicom_join, context_id) + + endif + if (mbaxid .ge. 0 ) then ! we are on coupler pes, for sure + ! receive on atm on coupler pes, that was redistributed according to coverage + ierr = iMOAB_ReceiveElementTag(mbaxid, atmid, id_join, tagName, mpicom_join, context_id) + !CHECKRC(ierr, "cannot receive tag values") + endif + + ! we can now free the sender buffers + if (mhid .ge. 0) then + ierr = iMOAB_FreeSenderBuffers(mhid, context_id) + ! CHECKRC(ierr, "cannot free buffers used to resend atm mesh tag towards the coverage mesh") + endif + + ! we could do the projection now, on the land mesh, because we are on the coupler pes; + ! the actual migrate back could happen later , from coupler pes to the land pes + if (mbintxla .ge. 0 ) then ! we are on coupler pes, for sure + ! we could apply weights; need to use the same weight identifier wgtIdef as when we generated it + ! hard coded now, it should be a runtime option in the future + ierr = iMOAB_ApplyScalarProjectionWeights ( mbintxla, wgtIdef, tagName, tagNameProj) #ifdef MOABDEBUG - ! we can also write the ocean mesh to file, just to see the projectd tag - ! write out the mesh file to disk - outfile = 'ocn_proj.h5m'//CHAR(0) - wopts = ';PARALLEL=WRITE_PART'//CHAR(0) ! - ierr = iMOAB_WriteMesh(mboxid, trim(outfile), trim(wopts)) + ! we can also write the ocean mesh to file, just to see the projectd tag + ! write out the mesh file to disk + outfile = 'lndCplProj.h5m'//CHAR(0) + wopts = ';PARALLEL=WRITE_PART'//CHAR(0) ! + ierr = iMOAB_WriteMesh(mblxid, trim(outfile), trim(wopts)) #endif - !CHECKRC(ierr, "cannot receive tag values") + !CHECKRC(ierr, "cannot receive tag values") + endif + endif end subroutine prep_atm_migrate_moab diff --git a/driver-moab/main/prep_ocn_mod.F90 b/driver-moab/main/prep_ocn_mod.F90 index 04f1166a730d..831f3440bee5 100644 --- a/driver-moab/main/prep_ocn_mod.F90 +++ b/driver-moab/main/prep_ocn_mod.F90 @@ -1516,7 +1516,7 @@ subroutine prep_ocn_migrate_moab(infodata) ! we can now free the sender buffers if (mboxid .ge. 0) then - ierr = iMOAB_FreeSenderBuffers(mboxid, mpicom_join, id_join) + ierr = iMOAB_FreeSenderBuffers(mboxid, context_id) ! CHECKRC(ierr, "cannot free buffers used to send projected tag towards the ocean mesh") endif From 33e99e87629ef99497ae14098a59ce80621f99ad Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Thu, 24 Oct 2019 09:09:00 -0500 Subject: [PATCH 038/467] weight id name is scalar-pc --- driver-moab/main/prep_atm_mod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/driver-moab/main/prep_atm_mod.F90 b/driver-moab/main/prep_atm_mod.F90 index 707c676294f3..b81ebe7375a9 100644 --- a/driver-moab/main/prep_atm_mod.F90 +++ b/driver-moab/main/prep_atm_mod.F90 @@ -367,7 +367,7 @@ subroutine prep_atm_lnd_moab(infodata) ! it happens over joint communicator ierr = iMOAB_CoverageGraph(mpicom_join, mhid, atmid, mbaxid, id_join, mbintxla, context_id); - wgtIdef = 'scalar'//CHAR(0) + wgtIdef = 'scalar-pc'//CHAR(0) dm1 = "cgll"//CHAR(0) dm2 = "pcloud"//CHAR(0) dofnameATM="GLOBAL_DOFS"//CHAR(0) From e5dcc8d221fa66023b9a520c446f520f6774181d Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Tue, 29 Oct 2019 16:12:25 -0500 Subject: [PATCH 039/467] change of iMOAB api do not need the components ids for coverage graph and migrate tags data; comm graph is found from context now --- driver-moab/main/prep_atm_mod.F90 | 12 +++--- driver-moab/main/prep_lnd_mod.F90 | 70 +++++++++++++++++++++++++++++++ driver-moab/main/prep_ocn_mod.F90 | 4 +- 3 files changed, 78 insertions(+), 8 deletions(-) diff --git a/driver-moab/main/prep_atm_mod.F90 b/driver-moab/main/prep_atm_mod.F90 index b81ebe7375a9..41c3d276f6b2 100644 --- a/driver-moab/main/prep_atm_mod.F90 +++ b/driver-moab/main/prep_atm_mod.F90 @@ -302,7 +302,7 @@ subroutine prep_atm_ocn_moab(infodata) call seq_comm_getinfo(ID_join,mpicom=mpicom_join) ! it happens over joint communicator - ierr = iMOAB_CoverageGraph(mpicom_join, mhid, atmid, mbaxid, id_join, mbintxoa, context_id); + ierr = iMOAB_CoverageGraph(mpicom_join, mhid, mbaxid, mbintxoa, context_id); wgtIdef = 'scalar'//CHAR(0) dm1 = "cgll"//CHAR(0) @@ -365,7 +365,7 @@ subroutine prep_atm_lnd_moab(infodata) call seq_comm_getinfo(ID_join,mpicom=mpicom_join) ! it happens over joint communicator - ierr = iMOAB_CoverageGraph(mpicom_join, mhid, atmid, mbaxid, id_join, mbintxla, context_id); + ierr = iMOAB_CoverageGraph(mpicom_join, mhid, mbaxid, mbintxla, context_id); wgtIdef = 'scalar-pc'//CHAR(0) dm1 = "cgll"//CHAR(0) @@ -440,12 +440,12 @@ subroutine prep_atm_migrate_moab(infodata) ! trivial partitioning, now we need to adjust it for "coverage" mesh ! as always, use nonblocking sends - ierr = iMOAB_SendElementTag(mhid, atmid, id_join, tagName, mpicom_join, context_id) + ierr = iMOAB_SendElementTag(mhid, tagName, mpicom_join, context_id) endif if (mbaxid .ge. 0 ) then ! we are on coupler pes, for sure ! receive on atm on coupler pes, that was redistributed according to coverage - ierr = iMOAB_ReceiveElementTag(mbaxid, atmid, id_join, tagName, mpicom_join, context_id) + ierr = iMOAB_ReceiveElementTag(mbaxid, tagName, mpicom_join, context_id) !CHECKRC(ierr, "cannot receive tag values") endif @@ -485,12 +485,12 @@ subroutine prep_atm_migrate_moab(infodata) ! original partitioning, now we need to adjust it for "coverage" mesh ! as always, use nonblocking sends - ierr = iMOAB_SendElementTag(mhid, atmid, id_join, tagName, mpicom_join, context_id) + ierr = iMOAB_SendElementTag(mhid, tagName, mpicom_join, context_id) endif if (mbaxid .ge. 0 ) then ! we are on coupler pes, for sure ! receive on atm on coupler pes, that was redistributed according to coverage - ierr = iMOAB_ReceiveElementTag(mbaxid, atmid, id_join, tagName, mpicom_join, context_id) + ierr = iMOAB_ReceiveElementTag(mbaxid, tagName, mpicom_join, context_id) !CHECKRC(ierr, "cannot receive tag values") endif diff --git a/driver-moab/main/prep_lnd_mod.F90 b/driver-moab/main/prep_lnd_mod.F90 index 344637f3fdcf..1e26c7c2997d 100644 --- a/driver-moab/main/prep_lnd_mod.F90 +++ b/driver-moab/main/prep_lnd_mod.F90 @@ -546,4 +546,74 @@ function prep_lnd_get_mapper_Fg2l() prep_lnd_get_mapper_Fg2l => mapper_Fg2l end function prep_lnd_get_mapper_Fg2l + ! exposed method to migrate projected tag from coupler pes back to land pes + subroutine prep_lnd_migrate_moab(infodata) + !--------------------------------------------------------------- + ! Description + ! After a2lTbot_proj, a2lVbot_proj, a2lUbot_proj were computed on lnd mesh on coupler, they need + ! to be migrated to the land pes + ! maybe the land solver will use it (later)? + ! Arguments + type(seq_infodata_type) , intent(in) :: infodata + + integer :: ierr + + logical :: atm_present ! .true. => atm is present + logical :: lnd_present ! .true. => lnd is present + integer :: id_join + integer :: mpicom_join + integer :: atmid + integer :: context_id + character*32 :: dm1, dm2 + character*50 :: tagName + character*32 :: outfile, wopts + integer :: orderLND, orderATM, volumetric, noConserve, validate + + integer, external :: iMOAB_SendElementTag, iMOAB_ReceiveElementTag, iMOAB_FreeSenderBuffers + integer, external :: iMOAB_WriteMesh + + call seq_infodata_getData(infodata, & + atm_present=atm_present, & + lnd_present=lnd_present) + + ! it involves initial ocn app; mpoid; also migrated ocn mesh mesh on coupler pes, mbaxid + ! after this, the sending of tags from coupler pes to ocn pes will use initial graph + ! (not processed for coverage) + ! how to get mpicomm for joint ocn + coupler + id_join = lnd(1)%cplcompid + lndid = lnd(1)%compid + call seq_comm_getinfo(ID_join,mpicom=mpicom_join) + context_id = -1 + ! now send the tag a2oTbot_proj, a2oUbot_proj, a2oVbot_proj from ocn on coupler pes towards original ocean mesh + tagName = 'a2lTbot_proj;a2lUbot_proj;a2lVbot_proj;'//CHAR(0) ! defined in prep_atm_mod.F90!!! + + if (mblxid .ge. 0) then ! send because we are on coupler pes + + ! basically, use the initial partitioning + ierr = iMOAB_SendElementTag(mblxid, tagName, mpicom_join, context_id) + + endif + if (mlnid .ge. 0 ) then ! we are on land pes, for sure + ! receive on land pes, a tag that was computed on coupler pes + ierr = iMOAB_ReceiveElementTag(mlnid, tagName, mpicom_join, context_id) + !CHECKRC(ierr, "cannot receive tag values") + endif + + ! we can now free the sender buffers + if (mblxid .ge. 0) then + ierr = iMOAB_FreeSenderBuffers(mblxid, context_id) + ! CHECKRC(ierr, "cannot free buffers used to send projected tag towards the ocean mesh") + endif + +#ifdef MOABDEBUG + if (mlnid .ge. 0 ) then ! we are on land pes, for sure + + outfile = 'wholeLND_proj.h5m'//CHAR(0) + wopts = ';PARALLEL=WRITE_PART'//CHAR(0) ! + ierr = iMOAB_WriteMesh(mlnid, trim(outfile), trim(wopts)) + endif +#endif + + end subroutine prep_lnd_migrate_moab + end module prep_lnd_mod diff --git a/driver-moab/main/prep_ocn_mod.F90 b/driver-moab/main/prep_ocn_mod.F90 index 831f3440bee5..014d1d3d1133 100644 --- a/driver-moab/main/prep_ocn_mod.F90 +++ b/driver-moab/main/prep_ocn_mod.F90 @@ -1505,12 +1505,12 @@ subroutine prep_ocn_migrate_moab(infodata) if (mboxid .ge. 0) then ! send because we are on coupler pes ! basically, use the initial partitioning - ierr = iMOAB_SendElementTag(mboxid, id_join, ocnid, tagName, mpicom_join, context_id) + ierr = iMOAB_SendElementTag(mboxid, tagName, mpicom_join, context_id) endif if (mpoid .ge. 0 ) then ! we are on ocean pes, for sure ! receive on ocean pes, a tag that was computed on coupler pes - ierr = iMOAB_ReceiveElementTag(mpoid, id_join, ocnid, tagName, mpicom_join, context_id) + ierr = iMOAB_ReceiveElementTag(mpoid, tagName, mpicom_join, context_id) !CHECKRC(ierr, "cannot receive tag values") endif From 715e49b223e68256fdacb52f05ceed40252e3535 Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Fri, 15 Nov 2019 23:36:29 -0600 Subject: [PATCH 040/467] initialize iMOAB id for land it was causing a crash in a 2+2 layout also, index the moab debug files for projection on coupler (land and ocean), and after migration back to components (land and ocean) --- components/homme/src/tool/semoab_mod.F90 | 8 ++++---- driver-moab/main/prep_atm_mod.F90 | 13 ++++++++++--- driver-moab/main/prep_lnd_mod.F90 | 14 ++++++++++---- driver-moab/main/prep_ocn_mod.F90 | 15 +++++++++++---- 4 files changed, 35 insertions(+), 15 deletions(-) diff --git a/components/homme/src/tool/semoab_mod.F90 b/components/homme/src/tool/semoab_mod.F90 index 2728874288f0..100e307c16ec 100644 --- a/components/homme/src/tool/semoab_mod.F90 +++ b/components/homme/src/tool/semoab_mod.F90 @@ -26,7 +26,7 @@ module semoab_mod integer local_map(np,np) ! what is the index of gll point (i,j) in a local moabconn(start: start+(np-1)*(np-1)*4-1) integer, allocatable :: moabconn(:) ! will have the connectivity in terms of local index in verts - integer num_calls_export + integer :: num_calls_export contains @@ -451,7 +451,7 @@ subroutine create_moab_mesh_fine(par, elem, nets, nete) ! create a new tag, for transfer example ; will use it now for temperature on the surface ! (bottom atm to surface of ocean); for debugging, use it on fine mesh - tagname='a2oDBG'//CHAR(0) ! atm to ocean tag + tagname='a2o_T'//CHAR(0) ! atm to ocean tag tagtype = 1 ! dense, double numco = 1 ! usually, it is 1; one value per gdof ierr = iMOAB_DefineTagStorage(MHFID, tagname, tagtype, numco, tagindex ) @@ -593,12 +593,12 @@ subroutine moab_export_data(elem) end do end do - tagname='a2oDBG'//CHAR(0) ! atm to ocean tag, on fine mesh + tagname='a2o_T'//CHAR(0) ! atm to ocean tag, on fine mesh ierr = iMOAB_GetMeshInfo ( MHFID, nvert, nvise, nbl, nsurf, nvisBC ); ent_type = 0 ! vertex type ierr = iMOAB_SetDoubleTagStorage ( MHFID, tagname, nvert(1), ent_type, valuesTag) if (ierr > 0 ) & - call endrun('Error: fail to set a2oDBG tag for fine vertices') + call endrun('Error: fail to set a2o_T tag for fine vertices') #ifdef MOABDEBUG ! write out the mesh file to disk, in parallel diff --git a/driver-moab/main/prep_atm_mod.F90 b/driver-moab/main/prep_atm_mod.F90 index 41c3d276f6b2..1bc5c0cef8b2 100644 --- a/driver-moab/main/prep_atm_mod.F90 +++ b/driver-moab/main/prep_atm_mod.F90 @@ -82,6 +82,9 @@ module prep_atm_mod ! other module variables integer :: mpicom_CPLID ! MPI cpl communicator logical :: iamroot_CPLID ! .true. => CPLID masterproc + + save + integer :: num_proj ! to index the coupler projection calls !================================================================================================ contains @@ -191,6 +194,7 @@ subroutine prep_atm_init(infodata, ocn_c2_atm, ice_c2_atm, lnd_c2_atm) outfile = 'intx'//trim(lnum)// '.h5m' // CHAR(0) ierr = iMOAB_WriteMesh(mbintxoa, outfile, wopts) ! write local intx file endif + num_proj = 0 ! to index projection files on coupler pes #endif end if @@ -405,7 +409,7 @@ subroutine prep_atm_migrate_moab(infodata) integer :: atmid integer :: context_id ! we will use ocean context character*32 :: dm1, dm2, tagName, wgtIdef - character*50 :: outfile, wopts, tagnameProj + character*50 :: outfile, wopts, tagnameProj, lnum integer :: orderOCN, orderATM, volumetric, noConserve, validate integer, external :: iMOAB_SendElementTag, iMOAB_ReceiveElementTag, iMOAB_FreeSenderBuffers @@ -433,6 +437,7 @@ subroutine prep_atm_migrate_moab(infodata) ! the separator will be ';' semicolon tagNameProj = 'a2oTbot_proj;a2oUbot_proj;a2oVbot_proj;'//CHAR(0) wgtIdef = 'scalar'//CHAR(0) + num_proj = num_proj + 1 if (atm_present .and. ocn_present) then if (mhid .ge. 0) then ! send because we are on atm pes @@ -465,7 +470,8 @@ subroutine prep_atm_migrate_moab(infodata) #ifdef MOABDEBUG ! we can also write the ocean mesh to file, just to see the projectd tag ! write out the mesh file to disk - outfile = 'ocn_proj.h5m'//CHAR(0) + write(lnum,"(I0.2)")num_proj + outfile = 'ocnCplProj'//trim(lnum)//'.h5m'//CHAR(0) wopts = ';PARALLEL=WRITE_PART'//CHAR(0) ! ierr = iMOAB_WriteMesh(mboxid, trim(outfile), trim(wopts)) #endif @@ -510,7 +516,8 @@ subroutine prep_atm_migrate_moab(infodata) #ifdef MOABDEBUG ! we can also write the ocean mesh to file, just to see the projectd tag ! write out the mesh file to disk - outfile = 'lndCplProj.h5m'//CHAR(0) + write(lnum,"(I0.2)")num_proj + outfile = 'lndCplProj'//trim(lnum)//'.h5m'//CHAR(0) wopts = ';PARALLEL=WRITE_PART'//CHAR(0) ! ierr = iMOAB_WriteMesh(mblxid, trim(outfile), trim(wopts)) #endif diff --git a/driver-moab/main/prep_lnd_mod.F90 b/driver-moab/main/prep_lnd_mod.F90 index 1e26c7c2997d..d2e5d601ec5b 100644 --- a/driver-moab/main/prep_lnd_mod.F90 +++ b/driver-moab/main/prep_lnd_mod.F90 @@ -85,6 +85,9 @@ module prep_lnd_mod character(CXX) :: glc2lnd_ec_extra_fields !================================================================================================ +#ifdef MOABDEBUG + integer :: number_calls ! it is a static variable, used to count the number of projections +#endif contains !================================================================================================ @@ -216,7 +219,9 @@ subroutine prep_lnd_init(infodata, atm_c2_lnd, rof_c2_lnd, glc_c2_lnd, iac_c2_ln call shr_sys_flush(logunit) end if - +#ifdef MOABDEBUG + number_calls = 0 ! it is a static variable, used to count the number of projections +#endif end subroutine prep_lnd_init !================================================================================================ @@ -566,7 +571,7 @@ subroutine prep_lnd_migrate_moab(infodata) integer :: context_id character*32 :: dm1, dm2 character*50 :: tagName - character*32 :: outfile, wopts + character*32 :: outfile, wopts, lnum integer :: orderLND, orderATM, volumetric, noConserve, validate integer, external :: iMOAB_SendElementTag, iMOAB_ReceiveElementTag, iMOAB_FreeSenderBuffers @@ -607,8 +612,9 @@ subroutine prep_lnd_migrate_moab(infodata) #ifdef MOABDEBUG if (mlnid .ge. 0 ) then ! we are on land pes, for sure - - outfile = 'wholeLND_proj.h5m'//CHAR(0) + number_calls = number_calls + 1 + write(lnum,"(I0.2)") number_calls + outfile = 'wholeLND_proj'//trim(lnum)//'.h5m'//CHAR(0) wopts = ';PARALLEL=WRITE_PART'//CHAR(0) ! ierr = iMOAB_WriteMesh(mlnid, trim(outfile), trim(wopts)) endif diff --git a/driver-moab/main/prep_ocn_mod.F90 b/driver-moab/main/prep_ocn_mod.F90 index 014d1d3d1133..40b0961d7752 100644 --- a/driver-moab/main/prep_ocn_mod.F90 +++ b/driver-moab/main/prep_ocn_mod.F90 @@ -115,6 +115,10 @@ module prep_ocn_mod #endif !================================================================================================ +#ifdef MOABDEBUG + integer :: number_proj ! it is a static variable, used to count the number of projections +#endif + contains !================================================================================================ @@ -386,7 +390,9 @@ subroutine prep_ocn_init(infodata, atm_c2_ocn, atm_c2_ice, ice_c2_ocn, rof_c2_oc call shr_sys_flush(logunit) end if - +#ifdef MOABDEBUG + number_proj = 0 ! it is a static variable, used to count the number of projections +#endif end subroutine prep_ocn_init !================================================================================================ @@ -1481,7 +1487,7 @@ subroutine prep_ocn_migrate_moab(infodata) integer :: context_id character*32 :: dm1, dm2 character*50 :: tagName - character*32 :: outfile, wopts + character*32 :: outfile, wopts, lnum integer :: orderOCN, orderATM, volumetric, noConserve, validate integer, external :: iMOAB_SendElementTag, iMOAB_ReceiveElementTag, iMOAB_FreeSenderBuffers @@ -1522,8 +1528,9 @@ subroutine prep_ocn_migrate_moab(infodata) #ifdef MOABDEBUG if (mpoid .ge. 0 ) then ! we are on ocean pes, for sure - - outfile = 'wholeMPAS_proj.h5m'//CHAR(0) + number_proj = number_proj+1 ! count the number of projections + write(lnum,"(I0.2)") number_proj + outfile = 'wholeMPAS_proj'//trim(lnum)//'.h5m'//CHAR(0) wopts = ';PARALLEL=WRITE_PART'//CHAR(0) ! ierr = iMOAB_WriteMesh(mpoid, trim(outfile), trim(wopts)) From 6b3084a5120d06f2642980ee9eade1561931e278 Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Mon, 9 Dec 2019 18:35:58 -0600 Subject: [PATCH 041/467] atm physics grid in moab implement it now as part of atm_mct_init method mesh is already distributed, so use ppgrid module for nlcols, lat, lon, area fraction is always 1, and mask too also, during writing of GS map moab files, use shr_CONST_PI, do not redefine it, from shr_const_mod --- components/eam/src/cpl/atm_comp_mct.F90 | 183 ++++++++++++++++++++++++ driver-mct/shr/seq_comm_mct.F90 | 1 + driver-moab/main/component_type_mod.F90 | 6 +- 3 files changed, 187 insertions(+), 3 deletions(-) diff --git a/components/eam/src/cpl/atm_comp_mct.F90 b/components/eam/src/cpl/atm_comp_mct.F90 index f7af376c3c1e..d5d5bb4393de 100644 --- a/components/eam/src/cpl/atm_comp_mct.F90 +++ b/components/eam/src/cpl/atm_comp_mct.F90 @@ -55,6 +55,9 @@ module atm_comp_mct use runtime_opts , only: read_namelist use scamMod , only: single_column,scmlat,scmlon +#ifdef HAVE_MOAB + use seq_comm_mct , only: mphaid ! atm physics grid id in MOAB, on atm pes +#endif ! ! !PUBLIC TYPES: implicit none @@ -372,6 +375,11 @@ subroutine atm_init_mct( EClock, cdata_a, x2a_a, a2x_a, NLFilename ) call shr_file_setLogUnit (shrlogunit) call shr_file_setLogLevel(shrloglev) + ! when called first time, initialize MOAB atm phis grid, and create the mesh + ! on the atm +#ifdef HAVE_MOAB + call initialize_moab_atm_phys( cdata_a ) +#endif first_time = .false. @@ -968,4 +976,179 @@ subroutine atm_write_srfrest_mct( x2a_a, a2x_a, & end subroutine atm_write_srfrest_mct +#ifdef HAVE_MOAB + subroutine initialize_moab_atm_phys( cdata_a ) + + use seq_comm_mct, only: mphaid ! imoab pid for atm physics + use shr_mpi_mod, only: shr_mpi_commrank, shr_mpi_commsize + use shr_const_mod, only: SHR_CONST_PI +!------------------------------------------------------------------- + use phys_grid, only : get_nlcols_p ! used to det local size ? + + type(seq_cdata), intent(in) :: cdata_a + + + integer :: ATMID + integer :: mpicom_atm + + integer :: ATM_PHYS ! our numbering + + integer , external :: iMOAB_RegisterFortranApplication, iMOAB_CreateVertices, iMOAB_WriteMesh, & + iMOAB_DefineTagStorage, iMOAB_SetIntTagStorage, iMOAB_SetDoubleTagStorage, & + iMOAB_ResolveSharedEntities + ! local variables to fill in data + integer, dimension(:), allocatable :: vgids + ! retrieve everything we need from mct + ! number of vertices is the size of mct grid + real(r8), dimension(:), allocatable :: moab_vert_coords ! temporary + real(r8), dimension(:), allocatable :: areavals + ! r + real(r8) :: latv, lonv + integer dims, i, ilat, ilon, igdx, ierr, tagindex + integer tagtype, numco, ent_type + + integer :: n, c, ncols, nlcols + + real(r8) :: lats(pcols) ! array of chunk latitudes pcol is defined in ppgrid + real(r8) :: lons(pcols) ! array of chunk longitude + real(r8) :: area(pcols) ! area in radians squared for each grid point + integer , dimension(:), allocatable :: chunk_index(:) ! temporary + !real(r8), parameter:: radtodeg = 180.0_r8/SHR_CONST_PI + + character*100 outfile, wopts, tagname + character*32 appname + + !dims =3 ! store as 3d mesh + + + call seq_cdata_setptrs(cdata_a, ID=ATMID, mpicom=mpicom_atm, & + infodata=infodata) + + appname="ATM_PHYS"//CHAR(0) + ATM_PHYS = 200 + ATMID ! + ierr = iMOAB_RegisterFortranApplication(appname, mpicom_atm, ATM_PHYS, mphaid) + if (ierr > 0 ) & + call endrun('Error: cannot register moab app for atm physics') + if(masterproc) then + write(iulog,*) " " + write(iulog,*) "register MOAB app:", trim(appname), " mphaid=", mphaid + write(iulog,*) " " + endif + + ! first, determine the size of local vertices + + nlcols = get_nlcols_p() + dims = 3 ! + allocate(vgids(nlcols)) + allocate(moab_vert_coords(nlcols*dims)) + allocate(areavals(nlcols)) + allocate(chunk_index(nlcols)) + n=0 + do c = begchunk, endchunk + ncols = get_ncols_p(c) + call get_rlat_all_p(c, ncols, lats) ! + call get_rlon_all_p(c, ncols, lons) + call get_area_all_p(c, ncols, area) + do i = 1,ncols + n=n+1 + vgids(n) = get_gcol_p(c,i) + latv = lats(i) ! these are in rads ? + lonv = lons(i) + moab_vert_coords(3*n-2)=COS(latv)*COS(lonv) + moab_vert_coords(3*n-1)=COS(latv)*SIN(lonv) + moab_vert_coords(3*n )=SIN(latv) + areavals(n) = area(i) + chunk_index(n) = c ! this is just for us, to see the chunk + end do + end do + + + ierr = iMOAB_CreateVertices(mphaid, nlcols*3, dims, moab_vert_coords) + if (ierr > 0 ) & + call endrun('Error: fail to create MOAB vertices in phys atm model') + + tagtype = 0 ! dense, integer + numco = 1 + tagname='GLOBAL_ID'//CHAR(0) + ierr = iMOAB_DefineTagStorage(mphaid, tagname, tagtype, numco, tagindex ) + if (ierr > 0 ) & + call endrun('Error: fail to retrieve GLOBAL_ID tag ') + + ent_type = 0 ! vertex type + ierr = iMOAB_SetIntTagStorage ( mphaid, tagname, nlcols , ent_type, vgids) + if (ierr > 0 ) & + call endrun('Error: fail to set GLOBAL_ID tag ') + + ierr = iMOAB_ResolveSharedEntities( mphaid, nlcols, vgids ); + if (ierr > 0 ) & + call endrun('Error: fail to resolve shared entities') + + !there are no shared entities, but we will set a special partition tag, in order to see the + ! partitions ; it will be visible with a Pseudocolor plot in VisIt + tagname='partition'//CHAR(0) + ierr = iMOAB_DefineTagStorage(mphaid, tagname, tagtype, numco, tagindex ) + if (ierr > 0 ) & + call endrun('Error: fail to create new partition tag ') + + vgids = iam + ierr = iMOAB_SetIntTagStorage ( mphaid, tagname, nlcols , ent_type, vgids) + if (ierr > 0 ) & + call endrun('Error: fail to set partition tag ') + + ! chunk_index ; it will be visible with a Pseudocolor plot in VisIt + tagname='chunk_id'//CHAR(0) + ierr = iMOAB_DefineTagStorage(mphaid, tagname, tagtype, numco, tagindex ) + if (ierr > 0 ) & + call endrun('Error: fail to create new chunk index tag ') + + ierr = iMOAB_SetIntTagStorage ( mphaid, tagname, nlcols , ent_type, chunk_index) + if (ierr > 0 ) & + call endrun('Error: fail to set partition tag ') + + ! use areavals for areas + + tagname='area'//CHAR(0) + tagtype = 1 ! dense, double + ierr = iMOAB_DefineTagStorage(mphaid, tagname, tagtype, numco, tagindex ) + if (ierr > 0 ) & + call endrun('Error: fail to create area tag ') + + + ierr = iMOAB_SetDoubleTagStorage ( mphaid, tagname, nlcols , ent_type, areavals) + if (ierr > 0 ) & + call endrun('Error: fail to set area tag ') + +! tagname='area'//CHAR(0) +! ierr = iMOAB_DefineTagStorage(mphaid, tagname, tagtype, numco, tagindex ) +! if (ierr > 0 ) & +! call endrun('Error: fail to create area tag ') +! do i = 1, lsz +! moab_vert_coords(i) = dom%data%rAttr(ixarea, i) ! use the same doubles for second tag :) +! enddo +! +! ierr = iMOAB_SetDoubleTagStorage ( mphaid, tagname, lsz , ent_type, moab_vert_coords ) +! if (ierr > 0 ) & +! call endrun('Error: fail to set area tag ') + + ! write out the mesh file to disk, in parallel +#ifdef MOABDEBUG + outfile = 'AtmPhys.h5m'//CHAR(0) + wopts = 'PARALLEL=WRITE_PART'//CHAR(0) + ierr = iMOAB_WriteMesh(mphaid, outfile, wopts) + if (ierr > 0 ) & + call endrun('Error: fail to write the atm phys mesh file') +#endif + deallocate(moab_vert_coords) + deallocate(vgids) + deallocate(areavals) + deallocate(chunk_index) + + ! similar logic to get lat, lon, area, frac, for each local cam point +!! start copy + ! + ! Fill in correct values for domain components + + end subroutine initialize_moab_atm_phys +#endif + end module atm_comp_mct diff --git a/driver-mct/shr/seq_comm_mct.F90 b/driver-mct/shr/seq_comm_mct.F90 index be0c6f813b62..1725a5595765 100644 --- a/driver-mct/shr/seq_comm_mct.F90 +++ b/driver-mct/shr/seq_comm_mct.F90 @@ -215,6 +215,7 @@ module seq_comm_mct integer, external :: iMOAB_InitializeFortran integer, public :: mhid, mhfid, mpoid, mlnid ! homme, homme fine, ocean, land moab ids + integer, public :: mphaid ! iMOAB id for atm phys grid, on atm pes integer, public :: mbaxid ! iMOAB id for atm migrated mesh to coupler pes integer, public :: mboxid ! iMOAB id for mpas ocean migrated mesh to coupler pes integer, public :: mbintxoa ! iMOAB id for intx mesh between ocean and atmosphere diff --git a/driver-moab/main/component_type_mod.F90 b/driver-moab/main/component_type_mod.F90 index a6fe05525536..3caf94348e93 100644 --- a/driver-moab/main/component_type_mod.F90 +++ b/driver-moab/main/component_type_mod.F90 @@ -270,6 +270,7 @@ end subroutine check_fields #ifdef MOABDEBUGMCT subroutine expose_mct_grid_moab (comp) use shr_mpi_mod, only: shr_mpi_commrank, shr_mpi_commsize + use shr_const_mod, only SHR_CONST_PI type(component_type), intent(in) :: comp integer :: lsz type(mct_gGrid), pointer :: dom @@ -282,15 +283,14 @@ subroutine expose_mct_grid_moab (comp) iMOAB_ResolveSharedEntities ! local variables to fill in data integer, dimension(:), allocatable :: vgids - ! retrieve everything we need from land domain mct_ldom - ! number of vertices is the size of land domain + ! retrieve everything we need from mct + ! number of vertices is the size of mct grid real(r8), dimension(:), allocatable :: moab_vert_coords ! temporary real(r8) :: latv, lonv integer dims, i, ilat, ilon, igdx, ierr, tagindex, ixarea, ixfrac integer tagtype, numco, ent_type character*100 outfile, wopts, localmeshfile, tagname character*32 appname - real(R8),parameter :: SHR_CONST_PI = 3.14159265358979323846_R8 ! pi dims =3 ! store as 3d mesh From e4ce41a2de8b9ba7d66fcc010b8aa8839cea8a83 Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Tue, 17 Dec 2019 17:41:10 -0600 Subject: [PATCH 042/467] build imoab land model from domain do not build it from mct data structures mct might be replaced with moab --- components/elm/src/cpl/lnd_comp_mct.F90 | 51 ++++++++++++++----------- driver-moab/main/component_type_mod.F90 | 2 +- 2 files changed, 30 insertions(+), 23 deletions(-) diff --git a/components/elm/src/cpl/lnd_comp_mct.F90 b/components/elm/src/cpl/lnd_comp_mct.F90 index 9f7c9861d889..50ed885316a4 100644 --- a/components/elm/src/cpl/lnd_comp_mct.F90 +++ b/components/elm/src/cpl/lnd_comp_mct.F90 @@ -305,7 +305,7 @@ subroutine lnd_init_mct( EClock, cdata_l, x2l_l, l2x_l, NLFilename ) call lnd_domain_mct( bounds, lsz, gsMap_lnd, dom_l ) #ifdef HAVE_MOAB - call init_land_moab(dom_l, lsz) + call init_land_moab(bounds) #endif call mct_aVect_init(x2l_l, rList=seq_flds_x2l_fields, lsize=lsz) call mct_aVect_zero(x2l_l) @@ -519,7 +519,7 @@ subroutine lnd_run_mct(EClock, cdata_l, x2l_l, l2x_l) nstep = get_nstep() caldayp1 = get_curr_calday(offset=dtime) if (nstep == 0) then - doalb = .false. + doalb = .false. else if (nstep == 1) then doalb = (abs(nextsw_cday- caldayp1) < 1.e-10_r8) else @@ -756,13 +756,19 @@ subroutine lnd_domain_mct( bounds, lsz, gsMap_l, dom_l ) end subroutine lnd_domain_mct #ifdef HAVE_MOAB - subroutine init_land_moab(mct_ldom, lsz) + subroutine init_land_moab(bounds) use seq_comm_mct, only: mlnid ! id of moab land app - use m_GeneralGrid , only: mct_ggrid_indexIA => indexIA - use m_GeneralGrid , only : MCT_GGrid_indexRA => indexRA use spmdMod , only: iam ! rank on the land communicator - type(mct_gGrid), pointer :: mct_ldom ! Land model domain data - integer , intent(in) :: lsz ! land model domain data size + use domainMod , only: ldomain ! ldomain is coming from module, not even passed + use clm_varcon , only: re + use shr_const_mod, only: SHR_CONST_PI + + type(bounds_type) , intent(in) :: bounds + + integer,allocatable :: gindex(:) ! Number the local grid points; used for global ID + integer lsz ! keep local size + integer gsize ! global size, that we do not need, actually + integer n integer , external :: iMOAB_CreateVertices, iMOAB_WriteMesh, & iMOAB_DefineTagStorage, iMOAB_SetIntTagStorage, iMOAB_SetDoubleTagStorage, & iMOAB_ResolveSharedEntities @@ -772,26 +778,29 @@ subroutine init_land_moab(mct_ldom, lsz) ! number of vertices is the size of land domain real(r8), dimension(:), allocatable :: moab_vert_coords ! temporary real(r8) :: latv, lonv - integer dims, i, ilat, ilon, igdx, ierr, tagindex, ixarea, ixfrac + integer dims, i, ilat, ilon, igdx, ierr, tagindex integer tagtype, numco, ent_type character*100 outfile, wopts, localmeshfile, tagname - real(R8),parameter :: SHR_CONST_PI = 3.14159265358979323846_R8 ! pi dims =3 ! store as 3d mesh + + ! number the local grid + lsz = bounds%endg - bounds%begg + 1 allocate(moab_vert_coords(lsz*dims)) allocate(vgids(lsz)) - ilat = MCT_GGrid_indexRA(mct_ldom,'lat') - ilon = MCT_GGrid_indexRA(mct_ldom,'lon') - igdx = MCT_GGrid_indexIA(mct_ldom,'GlobGridNum') + + do n = 1, lsz + vgids(n) = ldecomp%gdc2glo(bounds%begg+n-1) + end do + gsize = ldomain%ni * ldomain%nj do i = 1, lsz - latv = mct_ldom%data%rAttr(ilat, i) *SHR_CONST_PI/180. - lonv = mct_ldom%data%rAttr(ilon, i) *SHR_CONST_PI/180. + n = i-1 + bounds%begg + lonv = ldomain%lonc(n) *SHR_CONST_PI/180. + latv = ldomain%latc(n) *SHR_CONST_PI/180. moab_vert_coords(3*i-2)=COS(latv)*COS(lonv) moab_vert_coords(3*i-1)=COS(latv)*SIN(lonv) moab_vert_coords(3*i )=SIN(latv) - vgids(i) = mct_ldom%data%iAttr(igdx, i) enddo - ierr = iMOAB_CreateVertices(mlnid, lsz*3, dims, moab_vert_coords) if (ierr > 0 ) & call endrun('Error: fail to create MOAB vertices in land model') @@ -826,9 +835,6 @@ subroutine init_land_moab(mct_ldom, lsz) ! use moab_vert_coords as a data holder for a frac tag and area tag that we will create ! on the vertices; do not allocate other data array - ! do not be confused by this ! - ixfrac = MCT_GGrid_indexRA(mct_ldom,'frac') - ixarea = MCT_GGrid_indexRA(mct_ldom,'area') tagname='frac'//CHAR(0) tagtype = 1 ! dense, double ierr = iMOAB_DefineTagStorage(mlnid, tagname, tagtype, numco, tagindex ) @@ -836,7 +842,8 @@ subroutine init_land_moab(mct_ldom, lsz) call endrun('Error: fail to create frac tag ') do i = 1, lsz - moab_vert_coords(i) = mct_ldom%data%rAttr(ixfrac, i) + n = i-1 + bounds%begg + moab_vert_coords(i) = ldomain%frac(n) enddo ierr = iMOAB_SetDoubleTagStorage ( mlnid, tagname, lsz , ent_type, moab_vert_coords) if (ierr > 0 ) & @@ -847,7 +854,8 @@ subroutine init_land_moab(mct_ldom, lsz) if (ierr > 0 ) & call endrun('Error: fail to create area tag ') do i = 1, lsz - moab_vert_coords(i) = mct_ldom%data%rAttr(ixarea, i) ! use the same doubles for second tag :) + n = i-1 + bounds%begg + moab_vert_coords(i) = ldomain%area(n)/(re*re) ! use the same doubles for second tag :) enddo ierr = iMOAB_SetDoubleTagStorage ( mlnid, tagname, lsz , ent_type, moab_vert_coords ) @@ -864,7 +872,6 @@ subroutine init_land_moab(mct_ldom, lsz) if (ierr > 0 ) & call endrun('Error: fail to write the land mesh file') #endif - end subroutine init_land_moab #endif end module lnd_comp_mct diff --git a/driver-moab/main/component_type_mod.F90 b/driver-moab/main/component_type_mod.F90 index 3caf94348e93..e00d8d6f607e 100644 --- a/driver-moab/main/component_type_mod.F90 +++ b/driver-moab/main/component_type_mod.F90 @@ -270,7 +270,7 @@ end subroutine check_fields #ifdef MOABDEBUGMCT subroutine expose_mct_grid_moab (comp) use shr_mpi_mod, only: shr_mpi_commrank, shr_mpi_commsize - use shr_const_mod, only SHR_CONST_PI + use shr_const_mod, only: SHR_CONST_PI type(component_type), intent(in) :: comp integer :: lsz type(mct_gGrid), pointer :: dom From 212ff129d7a5df984b40ea5384b2771742a443da Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Fri, 10 Jan 2020 13:42:16 -0600 Subject: [PATCH 043/467] remove outdated comments --- components/eam/src/cpl/atm_comp_mct.F90 | 5 ----- 1 file changed, 5 deletions(-) diff --git a/components/eam/src/cpl/atm_comp_mct.F90 b/components/eam/src/cpl/atm_comp_mct.F90 index d5d5bb4393de..18d0851c87fb 100644 --- a/components/eam/src/cpl/atm_comp_mct.F90 +++ b/components/eam/src/cpl/atm_comp_mct.F90 @@ -1143,11 +1143,6 @@ subroutine initialize_moab_atm_phys( cdata_a ) deallocate(areavals) deallocate(chunk_index) - ! similar logic to get lat, lon, area, frac, for each local cam point -!! start copy - ! - ! Fill in correct values for domain components - end subroutine initialize_moab_atm_phys #endif From eeb21cba72a1a8951be1ec5f452b27b5f956f189 Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Tue, 14 Jan 2020 11:44:33 -0600 Subject: [PATCH 044/467] forgot to release buffers when sending mesh initially --- driver-moab/main/cplcomp_exchange_mod.F90 | 19 +++++++++++++++++-- 1 file changed, 17 insertions(+), 2 deletions(-) diff --git a/driver-moab/main/cplcomp_exchange_mod.F90 b/driver-moab/main/cplcomp_exchange_mod.F90 index 510cdeb8a6dd..aae897d009fc 100644 --- a/driver-moab/main/cplcomp_exchange_mod.F90 +++ b/driver-moab/main/cplcomp_exchange_mod.F90 @@ -996,8 +996,8 @@ subroutine cplcomp_moab_Init(comp) integer :: mpigrp_old ! component group pes integer, external :: iMOAB_RegisterFortranApplication, iMOAB_ReceiveMesh, iMOAB_SendMesh integer, external :: iMOAB_WriteMesh, iMOAB_DefineTagStorage, iMOAB_GetMeshInfo - integer, external :: iMOAB_SetIntTagStorage - integer :: ierr + integer, external :: iMOAB_SetIntTagStorage, iMOAB_FreeSenderBuffers + integer :: ierr, context_id character*32 :: appname, outfile, wopts, tagnameProj integer :: maxMH, maxMPO, maxMLID ! max pids for moab apps atm, ocn, lnd integer :: tagtype, numco, tagindex, partMethod @@ -1021,6 +1021,8 @@ subroutine cplcomp_moab_Init(comp) mpicom_join = comp%mpicom_cplcompid partMethod = 0 ! trivial partitioning + context_id = -1 ! original sends/receives, so the context is -1 + ! needed only to free send buffers #ifdef MOAB_HAVE_ZOLTAN partMethod = 2 ! it is better to use RCB for atmosphere and ocean too #endif @@ -1058,6 +1060,13 @@ subroutine cplcomp_moab_Init(comp) ierr = iMOAB_WriteMesh(mbaxid, trim(outfile), trim(wopts)) #endif endif + ! iMOAB_FreeSenderBuffers needs to be called after receiving + if (mhid .ge. 0) then ! we are on component atm pes + ierr = iMOAB_FreeSenderBuffers(mhid, context_id) + endif + ! now we have the spectral atm on coupler pes, and we want to send some data from + ! atm physics mesh to atm spectral on coupler side; compute a par comm graph + endif ! ocean if (comp%oneletterid == 'o' .and. maxMPO /= -1) then @@ -1107,6 +1116,9 @@ subroutine cplcomp_moab_Init(comp) ierr = iMOAB_WriteMesh(mboxid, trim(outfile), trim(wopts)) #endif endif + if (mpoid .ge. 0) then ! we are on component ocn pes + ierr = iMOAB_FreeSenderBuffers(mpoid, context_id) + endif endif ! land @@ -1158,6 +1170,9 @@ subroutine cplcomp_moab_Init(comp) ierr = iMOAB_WriteMesh(mblxid, trim(outfile), trim(wopts)) #endif endif + if (mlnid .ge. 0) then ! we are on component land pes + ierr = iMOAB_FreeSenderBuffers(mlnid, context_id) + endif endif end subroutine cplcomp_moab_Init From 7e2d3881aa75b424939416a458a5c7300d7c135c Mon Sep 17 00:00:00 2001 From: Jason Sarich Date: Mon, 11 May 2020 16:08:39 -0500 Subject: [PATCH 045/467] update mpas-source and revert machine files to master --- cime_config/machines/config_compilers.xml | 16 +-- cime_config/machines/config_machines.xml | 122 ++++------------------ 2 files changed, 20 insertions(+), 118 deletions(-) diff --git a/cime_config/machines/config_compilers.xml b/cime_config/machines/config_compilers.xml index 09cc6e089a9c..7e947f0a12ae 100644 --- a/cime_config/machines/config_compilers.xml +++ b/cime_config/machines/config_compilers.xml @@ -674,7 +674,6 @@ flags should be captured within MPAS CMake files. /projects/install/rhel6-x86_64/ACME/AlbanyTrilinos/Albany/build/install - /home/sarich/software/anlworkstation/gcc-6.2-mpich-3.2/moab -O2 @@ -686,7 +685,6 @@ flags should be captured within MPAS CMake files. -O2 - -DMOABDEBUG $SHELL{$ENV{NETCDF_PATH}/bin/nf-config --flibs} -lblas -llapack @@ -699,7 +697,6 @@ flags should be captured within MPAS CMake files. - /home/sarich/software/anvil/gnu-8-mvapich-2.3/moab -DHAVE_NANOTIME -DBIT64 -DHAVE_SLASHPROC -DHAVE_GETTIMEOFDAY @@ -714,8 +711,6 @@ flags should be captured within MPAS CMake files. $ENV{NETCDF_C_PATH} $ENV{NETCDF_FORTRAN_PATH} $ENV{PNETCDF_PATH} - /lcrc/project/ACME/MOAB/gcc-73-mvapich - /lcrc/project/ACME/MOAB/gcc-73-openmpi @@ -737,7 +732,6 @@ flags should be captured within MPAS CMake files. - /home/sarich/software/anvil/intel-18-mvapich-2.3/moab -static-intel -heap-arrays @@ -766,8 +760,6 @@ flags should be captured within MPAS CMake files. $ENV{NETCDF_C_PATH} $ENV{NETCDF_FORTRAN_PATH} $ENV{PNETCDF_PATH} - /lcrc/project/ACME/MOAB/intel-18-mvapich - /lcrc/project/ACME/MOAB/intel-18-openmpi @@ -886,24 +878,20 @@ flags should be captured within MPAS CMake files. /soft/climate/AlbanyTrilinos_06262017/Albany/buildintel/install - /home/iulian/moab-blds/bebop/moab-intel-17 -DHAVE_SLASHPROC - -DHAVE_SLASHPROC - -DMOABDEBUG -DNO_SHR_VMATH -lstdc++ - $SHELL{nf-config --fflags} -DNO_SHR_VMATH - $SHELL{nf-config --fflags} -O2 -debug minimal -qno-opt-dynamic-align + -O2 -debug minimal -qno-opt-dynamic-align mpiicc mpiicpc mpiifort - $SHELL{nf-config --flibs} -llapack -lblas + $SHELL{nf-config --flibs} -mkl $ENV{NETCDF_C_PATH} $ENV{NETCDF_FORTRAN_PATH} diff --git a/cime_config/machines/config_machines.xml b/cime_config/machines/config_machines.xml index a5337f804ee9..b944d4bcd41c 100644 --- a/cime_config/machines/config_machines.xml +++ b/cime_config/machines/config_machines.xml @@ -2266,8 +2266,6 @@ dynamic - -<<<<<<< HEAD @@ -2284,23 +2282,6 @@ $ENV{MEMBERWORK}/$PROJECT/archive/$CASE /lustre/atlas1/cli900/world-shared/cesm/baselines/$COMPILER /lustre/atlas1/cli900/world-shared/cesm/tools/cprnc/cprnc.eos -======= - - ANL/LCRC Linux Cluster - b51.*.lcrc.anl.gov - LINUX - intel,gnu - mvapich,openmpi - condo - /lcrc/group/acme - .* - /lcrc/group/acme/$USER/acme_scratch/anvil - /home/ccsm-data/inputdata - /home/ccsm-data/inputdata/atm/datm7 - /lcrc/group/acme/$USER/archive/$CASE - /lcrc/group/acme/acme_baselines/$COMPILER - /lcrc/group/acme/tools/cprnc/cprnc ->>>>>>> reset anvil to centos6 8 e3sm_developer pbs @@ -2311,25 +2292,17 @@ aprun -<<<<<<< HEAD -j {{ hyperthreading }} -S {{ tasks_per_numa }} -n {{ total_tasks }} -N $MAX_MPITASKS_PER_NODE -d $ENV{OMP_NUM_THREADS} -cc numa_node -======= - -l -n {{ total_tasks }} - --cpu_bind=cores - -c $SHELL{if [ FALSE = `./xmlquery --value SMP_PRESENT` ];then echo 1;else echo $OMP_NUM_THREADS;fi} - -m plane=$SHELL{if [ FALSE = `./xmlquery --value SMP_PRESENT` ];then echo 36;else echo 36/$OMP_NUM_THREADS|bc;fi} ->>>>>>> reset anvil to centos6 -<<<<<<< HEAD $MODULESHOME/init/sh $MODULESHOME/init/csh @@ -2356,95 +2329,36 @@ PrgEnv-cray cce cce/8.1.9 cray-libsci/12.1.00 - /home/software/spack-0.10.1/opt/spack/linux-centos7-x86_64/gcc-4.8.5/lmod-7.4.9-ic63herzfgw5u3na5mdtvp3nwxy6oj2z/lmod/lmod/init/sh;export - /home/software/spack-0.10.1/opt/spack/linux-centos7-x86_64/gcc-4.8.5/lmod-7.4.9-ic63herzfgw5u3na5mdtvp3nwxy6oj2z/lmod/lmod/init/csh;setenv - /home/software/spack-0.10.1/opt/spack/linux-centos7-x86_64/gcc-4.8.5/lmod-7.4.9-ic63herzfgw5u3na5mdtvp3nwxy6oj2z/lmod/lmod/init/env_modules_python.py - /home/software/spack-0.10.1/opt/spack/linux-centos7-x86_64/gcc-4.8.5/lmod-7.4.9-ic63herzfgw5u3na5mdtvp3nwxy6oj2z/lmod/lmod/libexec/lmod python - module - module -======= - - /etc/profile.d/a_softenv.csh - /etc/profile.d/a_softenv.sh - soft - soft ->>>>>>> reset anvil to centos6 - - +cmake-2.8.12 - +python-2.7 - +zlib-1.2.11 - - - +intel-18.0.3 - +mkl-11.2.1 - - - +mvapich2-2.3-intel-18.0.3-acme - +hdf5-1.10.4-intel-18.0.3-mvapich2-2.3-acme - +netcdf-4.6.2-intel-18.0.3-mvapich2-2.3-acme - +netcdf-cxx-4.2-intel-18.0.3-mvapich2-2.3-acme - +netcdf-fortran-4.4.4-intel-18.0.3-mvapich2-2.3-acme - +parallel-netcdf-1.10.0-intel-18.0.3-mvapich2-2.3-acme - - - +openmpi-3.1.3-intel-18.0.3-acme-new - +hdf5-1.10.4-intel-18.0.3-openmpi-3.1.3-acme - +netcdf-4.6.2-intel-18.0.3-openmpi-3.1.3-acme - +netcdf-cxx-4.2-intel-18.0.3-openmpi-3.1.3-acme - +netcdf-fortran-4.4.4-intel-18.0.3-openmpi-3.1.3-acme - +parallel-netcdf-1.10.0-intel-18.0.3-openmpi-3.1.3-acme - +gcc-7.3.0 + PrgEnv-gnu + gcc gcc/4.8.0 + cray-libsci/12.1.00 - - +mvapich2-2.3-gcc-7.3.0-acme - +hdf5-1.10.4-gcc-7.3.0-mvapich2-2.3-acme - +netcdf-c-4.6.1-cxx-4.2-f77-4.4.4-gcc-7.3.0-mvapich2-2.3-acme - +parallel-netcdf-1.8.0-gcc-7.3.0-mvapich2-2.3-acme + + cray-netcdf/4.3.2 - - +openmpi-3.1.2-gcc-7.3.0-acme - +netcdf-c-4.6.1-cxx-4.2-f77-4.4.4-gcc-7.3.0-openmpi-3.1.2-acme - +parallel-netcdf-1.8.0-gcc-7.3.0-openmpi-3.1.2-acme - +hdf5-1.10.4-gcc-7.3.0-openmpi-3.1.2-acme + + cray-netcdf-hdf5parallel/4.3.3.1 + cray-parallel-netcdf/1.6.1 + + + cmake3/3.2.3 + python/2.7.9 - $CIME_OUTPUT_ROOT/$CASE/run + $ENV{MEMBERWORK}/$PROJECT/$CASE/run $CIME_OUTPUT_ROOT/$CASE/bld - 0.1 - 1000 - $SHELL{which nc-config | xargs dirname | xargs dirname} - $SHELL{which nf-config | xargs dirname | xargs dirname} - - - $SHELL{which pnetcdf_version | xargs dirname | xargs dirname} - - - 0 - 1 - - - 1 - 2 - - + 1 + 1 + 64M - 1 - - - granularity=thread,scatter - 1 - - - spread - threads + ->>>>>>> update anvil modules for intel mvapich stack - LANL Linux Cluster, 36 pes/node, batch system slurm gr-fe.*.lanl.gov From 735ead9edf3df60a25cf7f4fb6405d2bdf16bdd4 Mon Sep 17 00:00:00 2001 From: Jason Sarich Date: Mon, 11 May 2020 16:43:47 -0500 Subject: [PATCH 046/467] take out some nete, nets setup so mct driver can compile --- components/homme/src/share/prim_driver_base.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/components/homme/src/share/prim_driver_base.F90 b/components/homme/src/share/prim_driver_base.F90 index 3703b146c6bc..c3830562d33e 100644 --- a/components/homme/src/share/prim_driver_base.F90 +++ b/components/homme/src/share/prim_driver_base.F90 @@ -706,6 +706,7 @@ subroutine prim_init1_buffers (elem,par) integer :: edgesz, sendsz, recvsz, n, den +#ifdef HAVE_MOAB allocate(dom_mt(0:hthreads-1)) do ith=0,hthreads-1 dom_mt(ith)=decompose(1,nelemd,hthreads,ith) @@ -713,7 +714,6 @@ subroutine prim_init1_buffers (elem,par) ith=0 nets=1 nete=nelemd -#ifdef HAVE_MOAB call create_moab_mesh_fine(par, elem, nets, nete) #endif From c22c745df46f5a71e906bc41357f1a20ce2cd80b Mon Sep 17 00:00:00 2001 From: Jason Sarich Date: Mon, 1 Jun 2020 13:28:46 -0500 Subject: [PATCH 047/467] merge mct driver updates into moab add cmake support --- cime_config/machines/config_compilers.xml | 1 + cime_config/machines/config_machines.xml.moab | 3167 +++++++++++++++++ components/cmake/common_setup.cmake | 31 +- driver-mct/shr/seq_comm_mct.F90 | 29 + driver-moab/cime_config/buildexe | 24 +- driver-moab/cime_config/buildlib_cmake | 46 + driver-moab/main/cime_comp_mod.F90 | 3086 +++++++++------- driver-moab/main/component_mod.F90 | 92 +- driver-moab/main/component_type_mod.F90 | 6 +- driver-moab/main/prep_atm_mod.F90 | 26 +- driver-moab/main/prep_iac_mod.F90 | 1 + driver-moab/shr/seq_pauseresume_mod.F90 | 1 + 12 files changed, 5129 insertions(+), 1381 deletions(-) create mode 100644 cime_config/machines/config_machines.xml.moab mode change 100755 => 100644 driver-moab/cime_config/buildexe create mode 100755 driver-moab/cime_config/buildlib_cmake create mode 120000 driver-moab/main/prep_iac_mod.F90 create mode 120000 driver-moab/shr/seq_pauseresume_mod.F90 diff --git a/cime_config/machines/config_compilers.xml b/cime_config/machines/config_compilers.xml index 7e947f0a12ae..6ba715f99514 100644 --- a/cime_config/machines/config_compilers.xml +++ b/cime_config/machines/config_compilers.xml @@ -674,6 +674,7 @@ flags should be captured within MPAS CMake files. /projects/install/rhel6-x86_64/ACME/AlbanyTrilinos/Albany/build/install + /home/sarich/software/anlworkstation/gcc-8.2.0/moab -O2 diff --git a/cime_config/machines/config_machines.xml.moab b/cime_config/machines/config_machines.xml.moab new file mode 100644 index 000000000000..4b09a4d6a4dd --- /dev/null +++ b/cime_config/machines/config_machines.xml.moab @@ -0,0 +1,3167 @@ + + + + + + + NERSC XC30, os is CNL, 24 pes/node, batch system is SLURM + edison + CNL + intel,intel18,gnu,gnu7 + mpt + acme + /project/projectdirs/acme + acme,m2830,m2833 + $ENV{CSCRATCH}/acme_scratch/edison + /project/projectdirs/acme/inputdata + /project/projectdirs/acme/inputdata/atm/datm7 + $CIME_OUTPUT_ROOT/archive/$CASE + /project/projectdirs/acme/baselines/$COMPILER + /project/projectdirs/acme/tools/cprnc.edison/cprnc + 8 + e3sm_developer + nersc_slurm + e3sm + 24 + 24 + TRUE + + srun + + --label + -n {{ total_tasks }} + -c $SHELL{echo 48/`./xmlquery --value MAX_MPITASKS_PER_NODE`|bc} + $SHELL{if [ 24 -ge `./xmlquery --value MAX_MPITASKS_PER_NODE` ]; then echo "--cpu_bind=cores"; else echo "--cpu_bind=threads";fi;} + -m plane=$SHELL{echo `./xmlquery --value MAX_MPITASKS_PER_NODE`} + + + + /opt/modules/default/init/perl.pm + /opt/modules/default/init/python.py + /opt/modules/default/init/sh + /opt/modules/default/init/csh + /opt/modules/default/bin/modulecmd perl + /opt/modules/default/bin/modulecmd python + module + module + + PrgEnv-intel + PrgEnv-cray + PrgEnv-gnu + intel + cce + gcc + cray-parallel-netcdf + cray-parallel-hdf5 + pmi + cray-libsci + cray-mpich2 + cray-mpich + cray-netcdf + cray-hdf5 + cray-netcdf-hdf5parallel + craype-sandybridge + craype-ivybridge + craype + papi + cray-petsc + esmf + + + + craype + craype/2.5.14 + craype-ivybridge + pmi + pmi/5.0.13 + cray-mpich + cray-mpich/7.7.0 + + + + PrgEnv-intel/6.0.4 + intel + intel/18.0.1.163 + cray-libsci + + + + PrgEnv-intel/6.0.4 + intel + intel/18.0.2.199 + cray-libsci + + + + PrgEnv-intel + PrgEnv-gnu/6.0.4 + gcc + gcc/7.3.0 + cray-libsci + cray-libsci/18.03.1 + + + + PrgEnv-intel + PrgEnv-gnu/6.0.4 + gcc + gcc/7.3.0 + cray-libsci + cray-libsci/18.03.1 + + + + cray-netcdf-hdf5parallel + cray-hdf5-parallel + cray-parallel-netcdf + cray-netcdf/4.4.1.1.6 + cray-hdf5/1.10.1.1 + + + cray-netcdf-hdf5parallel + cray-netcdf-hdf5parallel/4.4.1.1.6 + cray-hdf5-parallel/1.10.1.1 + cray-parallel-netcdf/1.8.1.3 + + + + $CIME_OUTPUT_ROOT/$CASE/run + $CIME_OUTPUT_ROOT/$CASE/bld + 0.1 + + 1 + 1 + + + 64M + spread + threads + + + FALSE + + + yes + + + yes + + + + + + Cori. XC40 Cray system at NERSC. Haswell partition. os is CNL, 32 pes/node, batch system is SLURM + cori-knl-is-default + CNL + intel,gnu + mpt + acme + /project/projectdirs/acme + acme,m2830,m2833 + $ENV{SCRATCH}/acme_scratch/cori-haswell + /project/projectdirs/acme/inputdata + /project/projectdirs/acme/inputdata/atm/datm7 + $CIME_OUTPUT_ROOT/archive/$CASE + /project/projectdirs/acme/baselines/$COMPILER + /project/projectdirs/acme/tools/cprnc.cori/cprnc + 8 + e3sm_developer + nersc_slurm + e3sm + 32 + 32 + TRUE + + srun + + --label + -n {{ total_tasks }} + -c $SHELL{echo 64/`./xmlquery --value MAX_MPITASKS_PER_NODE`|bc} + $SHELL{if [ 32 -ge `./xmlquery --value MAX_MPITASKS_PER_NODE` ]; then echo "--cpu_bind=cores"; else echo "--cpu_bind=threads";fi;} + -m plane=$SHELL{echo `./xmlquery --value MAX_MPITASKS_PER_NODE`} + + + + /opt/modules/default/init/perl + /opt/modules/default/init/python + /opt/modules/default/init/sh + /opt/modules/default/init/csh + /opt/modules/default/bin/modulecmd perl + /opt/modules/default/bin/modulecmd python + module + module + + + PrgEnv-intel + PrgEnv-cray + PrgEnv-gnu + intel + cce + gcc + cray-parallel-netcdf + cray-parallel-hdf5 + pmi + cray-libsci + cray-mpich2 + cray-mpich + cray-netcdf + cray-hdf5 + cray-netcdf-hdf5parallel + craype-sandybridge + craype-ivybridge + craype + papi + cmake + cray-petsc + esmf + zlib + + + + craype + craype/2.5.14 + pmi/5.0.13 + + cray-mpich + cray-mpich/7.7.0 + + + + PrgEnv-intel/6.0.4 + intel + intel/18.0.1.163 + + + + PrgEnv-intel PrgEnv-gnu/6.0.4 + gcc + gcc/7.3.0 + cray-libsci + cray-libsci/18.03.1 + + + + craype-mic-knl + craype-haswell + + + + cray-netcdf-hdf5parallel + cray-hdf5-parallel + cray-parallel-netcdf + cray-netcdf/4.4.1.1.6 + cray-hdf5/1.10.1.1 + + + cray-netcdf-hdf5parallel + cray-netcdf-hdf5parallel/4.4.1.1.6 + cray-hdf5-parallel/1.10.1.1 + cray-parallel-netcdf/1.8.1.3 + + + + git + git + cmake + cmake/3.3.2 + + + + $CIME_OUTPUT_ROOT/$CASE/run + $CIME_OUTPUT_ROOT/$CASE/bld + 0.1 + + + 1 + 1 + + + 128M + spread + threads + FALSE + + + yes + + + + + + Cori. XC40 Cray system at NERSC. KNL partition. os is CNL, 68 pes/node (for now only use 64), batch system is SLURM + cori + CNL + intel,gnu,intel19 + mpt,impi + acme + /project/projectdirs/acme + acme,m2830,m2833 + $ENV{SCRATCH}/acme_scratch/cori-knl + /project/projectdirs/acme/inputdata + /project/projectdirs/acme/inputdata/atm/datm7 + $CIME_OUTPUT_ROOT/archive/$CASE + /project/projectdirs/acme/baselines/$COMPILER + /project/projectdirs/acme/tools/cprnc.cori/cprnc + 8 + e3sm_developer + nersc_slurm + e3sm + 128 + 64 + TRUE + + srun + + --label + -n {{ total_tasks }} + -c $SHELL{echo 272/`./xmlquery --value MAX_MPITASKS_PER_NODE`|bc} + $SHELL{if [ 68 -ge `./xmlquery --value MAX_MPITASKS_PER_NODE` ]; then echo "--cpu_bind=cores"; else echo "--cpu_bind=threads";fi;} + -m plane=$SHELL{echo `./xmlquery --value MAX_MPITASKS_PER_NODE`} + + + + /opt/modules/default/init/perl + /opt/modules/default/init/python + /opt/modules/default/init/sh + /opt/modules/default/init/csh + /opt/modules/default/bin/modulecmd perl + /opt/modules/default/bin/modulecmd python + module + module + + craype + craype-mic-knl + craype-haswell + PrgEnv-intel + PrgEnv-cray + PrgEnv-gnu + intel + cce + gcc + cray-parallel-netcdf + cray-parallel-hdf5 + pmi + cray-mpich2 + cray-mpich + cray-netcdf + cray-hdf5 + cray-netcdf-hdf5parallel + cray-libsci + papi + cmake + cray-petsc + esmf + zlib + + + craype + PrgEnv-intel + cray-mpich + craype-haswell + craype-mic-knl + + + + cray-mpich cray-mpich/7.7.0 + + + + cray-mpich impi/2018.up2 + + + + PrgEnv-intel/6.0.4 + intel + intel/18.0.1.163 + + + + PrgEnv-intel/6.0.4 + intel + intel/19.0.0.117 + + + + PrgEnv-intel PrgEnv-gnu/6.0.4 + gcc + gcc/7.3.0 + cray-libsci + cray-libsci/18.03.1 + + + + craype craype/2.5.14 + pmi + pmi/5.0.13 + craype-haswell + craype-mic-knl + + + + cray-netcdf-hdf5parallel + cray-hdf5-parallel + cray-parallel-netcdf + cray-netcdf/4.4.1.1.6 + cray-hdf5/1.10.1.1 + + + cray-netcdf-hdf5parallel + cray-netcdf-hdf5parallel/4.4.1.1.6 + cray-hdf5-parallel/1.10.1.1 + cray-parallel-netcdf/1.8.1.3 + + + + git + git + cmake + cmake/3.3.2 + + + + + + + $CIME_OUTPUT_ROOT/$CASE/run + $CIME_OUTPUT_ROOT/$CASE/bld + 0.1 + + 1 + 1 + + + 128M + spread + threads + FALSE + + + + disabled + + + ofi + gni + yes + /global/common/cori/software/libfabric/1.6.1/gnu/lib/libfabric.so + /usr/lib64/slurmpmi/libpmi.so + + + yes + 1 + + + 1 + + + + + + Stampede2. Intel skylake nodes at TACC. 48 cores per node, batch system is SLURM + .*stampede2.* + LINUX + intel,gnu + impi + $ENV{SCRATCH} + acme + $ENV{SCRATCH}/acme_scratch/stampede2 + $ENV{SCRATCH}/inputdata + $ENV{SCRATCH}/inputdata/atm/datm7 + $CIME_OUTPUT_ROOT/archive/$CASE + $ENV{SCRATCH}/baselines/$COMPILER + $ENV{SCRATCH}/tools/cprnc.cori/cprnc + 8 + e3sm_developer + slurm + e3sm + 96 + 48 + FALSE + + ibrun + + + /opt/apps/lmod/lmod/init/perl + /opt/apps/lmod/lmod/init/python + /opt/apps/lmod/lmod/init/sh + /opt/apps/lmod/lmod/init/csh + /opt/apps/lmod/lmod/libexec/lmod perl + /opt/apps/lmod/lmod/libexec/lmod python + module -q + module -q + + + + + + + intel/18.0.0 + + + + gcc/6.3.0 + + + + impi/18.0.0 + + + + hdf5/1.8.16 + netcdf/4.3.3.1 + + + phdf5/1.8.16 + parallel-netcdf/4.3.3.1 + pnetcdf/1.8.1 + + + git + cmake + autotools + xalt + + + + + + + $CIME_OUTPUT_ROOT/$CASE/run + $CIME_OUTPUT_ROOT/$CASE/bld + 0.1 + + 1 + 1 + + 128M + spread + threads + 1 + -l + + + + + Mac OS/X workstation or laptop + + Darwin + gnu + openmpi,mpich + $ENV{HOME}/projects/acme/scratch + $ENV{HOME}/projects/acme/cesm-inputdata + $ENV{HOME}/projects/acme/ptclm-data + $ENV{HOME}/projects/acme/scratch/archive/$CASE + $ENV{HOME}/projects/acme/baselines/$COMPILER + $CCSMROOT/tools/cprnc/build/cprnc + 4 + e3sm_developer + none + jnjohnson at lbl dot gov + 4 + 2 + + mpirun + + + + $ENV{HOME}/projects/acme/scratch/$CASE/run + $ENV{HOME}/projects/acme/scratch/$CASE/bld + + + + + + Linux workstation or laptop + none + LINUX + gnu + openmpi,mpich + $ENV{HOME}/projects/acme/scratch + $ENV{HOME}/projects/acme/cesm-inputdata + $ENV{HOME}/projects/acme/ptclm-data + $ENV{HOME}/projects/acme/scratch/archive/$CASE + $ENV{HOME}/projects/acme/baselines/$COMPILER + $CCSMROOT/tools/cprnc/build/cprnc + 4 + e3sm_developer + none + jayesh at mcs dot anl dot gov + 4 + 2 + + mpirun + + -np {{ total_tasks }} + + + + $ENV{HOME}/projects/acme/scratch/$CASE/run + $ENV{HOME}/projects/acme/scratch/$CASE/bld + + + + + + Linux workstation for Jenkins testing + (melvin|watson|s999964|climate|penn|sems) + LINUX + sonproxy.sandia.gov:80 + gnu,intel + openmpi + /sems-data-store/ACME/timings + .* + $ENV{HOME}/acme/scratch + /sems-data-store/ACME/inputdata + /sems-data-store/ACME/inputdata/atm/datm7 + $CIME_OUTPUT_ROOT/archive/$CASE + /sems-data-store/ACME/baselines/$COMPILER + /sems-data-store/ACME/cprnc/build.new/cprnc + 32 + e3sm_developer + none + jgfouca at sandia dot gov + 48 + 48 + + mpirun + + -np {{ total_tasks }} + --map-by ppr:{{ tasks_per_numa }}:socket:PE=$ENV{OMP_NUM_THREADS} --bind-to hwthread:overload-allowed + + + + /usr/share/Modules/init/python.py + /usr/share/Modules/init/perl.pm + /usr/share/Modules/init/sh + /usr/share/Modules/init/csh + /usr/bin/modulecmd python + /usr/bin/modulecmd perl + module + module + + + sems-env + acme-env + sems-git + acme-binutils + sems-python/2.7.9 + sems-cmake/2.8.12 + + + sems-gcc/7.3.0 + + + sems-intel/16.0.3 + + + sems-netcdf/4.4.1/exo + acme-pfunit/3.2.8/base + + + acme-openmpi/2.1.5/acme + acme-netcdf/4.4.1/acme + + + $CIME_OUTPUT_ROOT/$CASE/run + $CIME_OUTPUT_ROOT/$CASE/bld + 0.1 + 1000 + + + $ENV{SEMS_NETCDF_ROOT} + 64M + spread + threads + + + $ENV{SEMS_NETCDF_ROOT} + + + + + IBM Power 8 Testbed machine + white + LINUX + gnu + openmpi + $ENV{HOME}/projects/e3sm/scratch + $ENV{HOME}/projects/e3sm/cesm-inputdata + $ENV{HOME}/projects/e3sm/ptclm-data + $ENV{HOME}/projects/e3sm/scratch/archive/$CASE + $ENV{HOME}/projects/e3sm/baselines/$COMPILER + $CCSMROOT/tools/cprnc/build/cprnc + 32 + e3sm_developer + lsf + mdeakin at sandia dot gov + 4 + 1 + + mpirun + + + + /usr/share/Modules/init/sh + /usr/share/Modules/init/python.py + module + /usr/bin/modulecmd python + + devpack/20181011/openmpi/2.1.2/gcc/7.2.0/cuda/9.2.88 + + + $ENV{HOME}/projects/e3sm/scratch/$CASE/run + $ENV{HOME}/projects/e3sm/scratch/$CASE/bld + + $ENV{NETCDF_ROOT} + /ascldap/users/jgfouca/packages/netcdf-fortran-4.4.4-white + $SRCROOT + + + + + Skylake Testbed machine + blake + LINUX + intel18 + openmpi + $ENV{HOME}/projects/e3sm/scratch + $ENV{HOME}/projects/e3sm/cesm-inputdata + $ENV{HOME}/projects/e3sm/ptclm-data + $ENV{HOME}/projects/e3sm/scratch/archive/$CASE + $ENV{HOME}/projects/e3sm/baselines/$COMPILER + $CCSMROOT/tools/cprnc/build/cprnc + 48 + e3sm_developer + slurm + mdeakin at sandia dot gov + 48 + 48 + + mpirun + + + + /usr/share/Modules/init/sh + /usr/share/Modules/init/python.py + module + module + + zlib/1.2.11 + intel/compilers/18.1.163 + openmpi/2.1.2/intel/18.1.163 + hdf5/1.10.1/openmpi/2.1.2/intel/18.1.163 + netcdf-exo/4.4.1.1/openmpi/2.1.2/intel/18.1.163 + + + $ENV{HOME}/projects/e3sm/scratch/$CASE/run + $ENV{HOME}/projects/e3sm/scratch/$CASE/bld + + $ENV{NETCDF_ROOT} + $ENV{NETCDFF_ROOT} + + + + + Linux workstation for ANL + compute.*mcs.anl.gov + LINUX + gnu + mpich + $ENV{HOME}/acme/scratch + /home/climate1/acme/inputdata + /home/climate1/acme/inputdata/atm/datm7 + $CIME_OUTPUT_ROOT/archive/$CASE + /home/climate1/acme/baselines/$COMPILER + /home/climate1/acme/cprnc/build/cprnc + make + 32 + e3sm_developer + none + jgfouca at sandia dot gov + 32 + 32 + + mpirun + + -l -np {{ total_tasks }} + + + + /software/common/adm/packages/softenv-1.6.2/etc/softenv-load.csh + /software/common/adm/packages/softenv-1.6.2/etc/softenv-load.sh + source /software/common/adm/packages/softenv-1.6.2/etc/softenv-aliases.csh ; soft + source /software/common/adm/packages/softenv-1.6.2/etc/softenv-aliases.sh ; soft + + +gcc-6.2.0 + +szip-2.1-gcc-6.2.0 + +cmake-2.8.12 + + + +netcdf-4.4.1c-4.2cxx-4.4.4f-serial-gcc6.2.0 + + + +mpich-3.2-gcc-6.2.0 + +hdf5-1.8.16-gcc-6.2.0-mpich-3.2-parallel + +netcdf-4.4.1c-4.2cxx-4.4.4f-parallel-gcc6.2.0-mpich-3.2 + +pnetcdf-1.6.1-gcc-6.2.0-mpich-3.2 + + + $CIME_OUTPUT_ROOT/$CASE/run + $CIME_OUTPUT_ROOT/$CASE/bld + + $SHELL{dirname $(dirname $(which ncdump))} + + + + /soft/apps/packages/climate/hdf5/1.8.16-serial/gcc-6.2.0/lib:$ENV{LD_LIBRARY_PATH} + + + $SHELL{dirname $(dirname $(which h5dump))} + + $SHELL{dirname $(dirname $(which pnetcdf_version))} + + + 64M + + + + + SNL clust + (skybridge|chama) + LINUX + wwwproxy.sandia.gov:80 + intel + openmpi + fy150001 + /projects/ccsm/timings + .* + /gpfs1/$USER/acme_scratch/sandiatoss3 + /projects/ccsm/inputdata + /projects/ccsm/inputdata/atm/datm7 + $CIME_OUTPUT_ROOT/archive/$CASE + /projects/ccsm/ccsm_baselines/$COMPILER + /projects/ccsm/cprnc/build.toss3/cprnc_wrap + 8 + e3sm_integration + slurm + jgfouca at sandia dot gov + 16 + 16 + TRUE + + mpiexec + + --n {{ total_tasks }} + --map-by ppr:{{ tasks_per_numa }}:socket:PE=$ENV{OMP_NUM_THREADS} --bind-to core + + + + + + + /usr/share/lmod/lmod/init/python.py + /usr/share/lmod/lmod/init/perl.pm + /usr/share/lmod/lmod/init/sh + /usr/share/lmod/lmod/init/csh + /usr/share/lmod/lmod/libexec/lmod python + /usr/share/lmod/lmod/libexec/lmod perl + module + module + + + sems-env + sems-git + sems-python/2.7.9 + sems-cmake + gnu/4.9.2 + sems-intel/17.0.0 + + + sems-openmpi/1.10.5 + sems-netcdf/4.4.1/exo_parallel + + + sems-netcdf/4.4.1/exo + + + /gscratch/$USER/acme_scratch/sandiatoss3/$CASE/run + $CIME_OUTPUT_ROOT/$CASE/bld + + + 0.1 + + + $ENV{SEMS_NETCDF_ROOT} + $ENV{SEMS_NETCDF_ROOT}/include + $ENV{SEMS_NETCDF_ROOT}/lib + 64M + + + $ENV{SEMS_NETCDF_ROOT} + + + + + SNL clust + ghost-login + LINUX + wwwproxy.sandia.gov:80 + intel + openmpi + fy150001 + + /gscratch/$USER/acme_scratch/ghost + /projects/ccsm/inputdata + /projects/ccsm/inputdata/atm/datm7 + $CIME_OUTPUT_ROOT/archive/$CASE + /projects/ccsm/ccsm_baselines/$COMPILER + /projects/ccsm/cprnc/build.toss3/cprnc_wrap + 8 + e3sm_integration + slurm + jgfouca at sandia dot gov + 36 + 36 + TRUE + + mpiexec + + --n {{ total_tasks }} + --map-by ppr:{{ tasks_per_numa }}:socket:PE=$ENV{OMP_NUM_THREADS} --bind-to core + + + + + + + /usr/share/lmod/lmod/init/python.py + /usr/share/lmod/lmod/init/perl.pm + /usr/share/lmod/lmod/init/sh + /usr/share/lmod/lmod/init/csh + /usr/share/lmod/lmod/libexec/lmod python + /usr/share/lmod/lmod/libexec/lmod perl + module + module + + + sems-env + sems-git + sems-python/2.7.9 + sems-cmake + gnu/4.9.2 + sems-intel/16.0.2 + mkl/16.0 + sems-netcdf/4.4.1/exo_parallel + + + sems-openmpi/1.10.5 + + + $CIME_OUTPUT_ROOT/$CASE/run + $CIME_OUTPUT_ROOT/$CASE/bld + + + + $ENV{SEMS_NETCDF_ROOT} + $ENV{SEMS_NETCDF_ROOT}/include + $ENV{SEMS_NETCDF_ROOT}/lib + 64M + + + $ENV{SEMS_NETCDF_ROOT} + + + + + ANL/LCRC Linux Cluster + blogin.*.lcrc.anl.gov + LINUX + gnu,pgi,intel,nag + mvapich,mpich,openmpi + ACME + /lcrc/project/$PROJECT/$USER/acme_scratch + /home/ccsm-data/inputdata + /home/ccsm-data/inputdata/atm/datm7 + /lcrc/project/ACME/$USER/archive/$CASE + /lcrc/group/acme/acme_baselines/blues/$COMPILER + /home/ccsm-data/tools/cprnc + 4 + e3sm_integration + pbs + acme + 16 + 16 + TRUE + + mpiexec + + -n {{ total_tasks }} + + + + mpiexec + + -n {{ total_tasks }} + + + + + + + /etc/profile.d/a_softenv.csh + /etc/profile.d/a_softenv.sh + soft + soft + + +cmake-2.8.12 + +python-2.7 + + + +gcc-5.3.0 + +hdf5-1.10.0-gcc-5.3.0-serial + +netcdf-c-4.4.0-f77-4.4.3-gcc-5.3.0-serial + + + +gcc-5.2 + +netcdf-4.3.3.1-gnu5.2-serial + + + +mvapich2-2.2b-gcc-5.3.0 + +pnetcdf-1.6.1-gcc-5.3.0-mvapich2-2.2b + + + +mvapich2-2.2b-gcc-5.2 + + + +intel-15.0 + +mkl-11.2.1 + + + +mvapich2-2.2b-intel-15.0 + +pnetcdf-1.6.1-mvapich2-2.2a-intel-15.0 + + + +pgi-15.7 + +binutils-2.27 + +netcdf-c-4.4.1-f77-4.4.4-pgi-15.7-serial + + + +mvapich2-2.2-pgi-15.7 + +pnetcdf-1.7.0-pgi-15.7-mvapich2-2.2 + + + +nag-6.0 + +hdf5-1.8.12-serial-nag + +netcdf-4.3.1-serial-nag + + + +mpich3-3.1.4-nag-6.0 + +pnetcdf-1.6.1-mpich-3.1.4-nag-6.0 + + + $CIME_OUTPUT_ROOT/$CASE/run + $CIME_OUTPUT_ROOT/$CASE/bld + 0.1 + + $SHELL{dirname $(dirname $(which ncdump))} + + + $SHELL{dirname $(dirname $(which pnetcdf_version))} + + + 64M + + + + + ANL/LCRC Linux Cluster + blueslogin.*.lcrc.anl.gov + LINUX + intel,gnu + mvapich,openmpi + condo + /lcrc/group/acme + .* + /lcrc/group/acme/$USER/acme_scratch/anvil + /home/ccsm-data/inputdata + /home/ccsm-data/inputdata/atm/datm7 + /lcrc/group/acme/$USER/archive/$CASE + /lcrc/group/acme/acme_baselines/$COMPILER + /lcrc/group/acme/tools/cprnc/cprnc + 8 + e3sm_integration + slurm + E3SM + 36 + 36 + FALSE + + srun + + -l -n {{ total_tasks }} + + + + + + + /home/software/spack-0.10.1/opt/spack/linux-centos7-x86_64/gcc-4.8.5/lmod-7.4.9-ic63herzfgw5u3na5mdtvp3nwxy6oj2z/lmod/lmod/init/sh;export MODULEPATH=/blues/gpfs/software/centos7/spack-0.12.1/share/spack/lmod/linux-centos7-x86_64/Core + /home/software/spack-0.10.1/opt/spack/linux-centos7-x86_64/gcc-4.8.5/lmod-7.4.9-ic63herzfgw5u3na5mdtvp3nwxy6oj2z/lmod/lmod/init/csh;setenv MODULEPATH /blues/gpfs/software/centos7/spack-0.12.1/share/spack/lmod/linux-centos7-x86_64/Core + /home/software/spack-0.10.1/opt/spack/linux-centos7-x86_64/gcc-4.8.5/lmod-7.4.9-ic63herzfgw5u3na5mdtvp3nwxy6oj2z/lmod/lmod/init/env_modules_python.py + export MODULEPATH=/blues/gpfs/software/centos7/spack-0.12.1/share/spack/lmod/linux-centos7-x86_64/Core;/home/software/spack-0.10.1/opt/spack/linux-centos7-x86_64/gcc-4.8.5/lmod-7.4.9-ic63herzfgw5u3na5mdtvp3nwxy6oj2z/lmod/lmod/libexec/lmod python + module + module + + + + + intel/17.0.4-74uvhji + intel-mkl/2017.3.196-v7uuj6z + netcdf/4.4.1-magkugi + netcdf-fortran/4.4.4-7obsouy + mvapich2/2.2-verbs-lxc4y7i + cmake + + + intel/17.0.0-yil23id + intel-mkl/2017.0.098-gqttdpp + netcdf/4.4.1-qy35uvc + netcdf-fortran/4.4.4-2jrvsdv + openmpi/2.0.1-verbs-id2i464 + cmake/3.14.1-ymmizo4 + + + gcc/8.2.0-g7hppkz + intel-mkl/2018.4.274-2amycpi + hdf5/1.8.16-mz7lmxh + netcdf/4.4.1-xkjcghm + netcdf-cxx/4.2-kyva3os + netcdf-fortran/4.4.4-mpstomu + + + mvapich2/2.3.1-verbs-wcfqbl5 + + + openmpi/3.1.3-verbs-q4swt25 + + + $CIME_OUTPUT_ROOT/$CASE/run + $CIME_OUTPUT_ROOT/$CASE/bld + 0.1 + 1000 + + $SHELL{which nc-config | xargs dirname | xargs dirname} + $SHELL{which nf-config | xargs dirname | xargs dirname} + /lcrc/group/acme/soft/perl/5.26.0/bin:$ENV{PATH} + + + /blues/gpfs/home/software/climate/pnetcdf/1.6.1/intel-17.0.4/mvapich2-2.2-verbs + + + 1 + 1 + 2 + + + 64M + + + granularity=thread,scatter + 1 + + + spread + threads + + + + + ANL/LCRC Cluster, Cray CS400, 352-nodes Xeon Phi 7230 KNLs 64C/1.3GHz + 672-nodes Xeon E5-2695v4 Broadwells 36C/2.10GHz, Intel Omni-Path network, SLURM batch system, Lmod module environment. + beboplogin.* + LINUX + intel,gnu + impi,mpich,mvapich,openmpi + acme + /lcrc/group/acme/$USER/acme_scratch/bebop + /home/ccsm-data/inputdata + /home/ccsm-data/inputdata/atm/datm7 + $CIME_OUTPUT_ROOT/archive/$CASE + /lcrc/group/acme/acme_baselines/bebop/$COMPILER + /lcrc/group/acme/tools/cprnc/cprnc + 8 + e3sm_integration + slurm + E3SM + 36 + 36 + TRUE + + mpirun + + -l -n {{ total_tasks }} + + + + + + + /home/software/spack-0.10.1/opt/spack/linux-centos7-x86_64/gcc-4.8.5/lmod-7.4.9-ic63herzfgw5u3na5mdtvp3nwxy6oj2z/lmod/lmod/init/sh + /home/software/spack-0.10.1/opt/spack/linux-centos7-x86_64/gcc-4.8.5/lmod-7.4.9-ic63herzfgw5u3na5mdtvp3nwxy6oj2z/lmod/lmod/init/csh + /home/software/spack-0.10.1/opt/spack/linux-centos7-x86_64/gcc-4.8.5/lmod-7.4.9-ic63herzfgw5u3na5mdtvp3nwxy6oj2z/lmod/lmod/init/env_modules_python.py + /home/software/spack-0.10.1/opt/spack/linux-centos7-x86_64/gcc-4.8.5/lmod-7.4.9-ic63herzfgw5u3na5mdtvp3nwxy6oj2z/lmod/lmod/libexec/lmod python + module + module + + + + + intel/17.0.4-74uvhji + intel-mkl/2017.3.196-jyjmyut + + + gcc/7.1.0-4bgguyp + + + intel-mpi/2017.3-dfphq6k + parallel-netcdf/1.6.1 + + + mvapich2/2.2-n6lclff + parallel-netcdf/1.6.1-mvapich2.2 + + + cmake + netcdf/4.4.1.1-prsuusl + netcdf-fortran/4.4.4-ojwazvy + + + $CIME_OUTPUT_ROOT/$CASE/run + $CIME_OUTPUT_ROOT/$CASE/bld + 0.1 + + $SHELL{which nc-config | xargs dirname | xargs dirname} + $SHELL{which nf-config | xargs dirname | xargs dirname} + /lcrc/group/acme/soft/perl/5.26.0/bin:$ENV{PATH} + + + $SHELL{which pnetcdf_version | xargs dirname | xargs dirname} + + + 128M + spread + threads + + + shm:tmi + + + + + ANL IBM BG/Q, os is BGQ, 16 cores/node, batch system is cobalt + cetus + BGQ + ibm + ibm + ClimateEnergy_2 + ClimateEnergy + /projects/$PROJECT/$USER + /projects/ccsm/inputdata + /projects/ccsm/inputdata/atm/datm7 + /projects/$PROJECT/$USER/archive/$CASE + /projects/ccsm/ccsm_baselines//$COMPILER + /projects/ccsm/tools/cprnc/cprnc + 8 + e3sm_developer + cobalt + jayesh -at- mcs.anl.gov + 64 + 4 + TRUE + + /usr/bin/runjob + + --label short + --ranks-per-node $MAX_MPITASKS_PER_NODE + --np {{ total_tasks }} + --block $COBALT_PARTNAME $LOCARGS + $ENV{BGQ_SMP_VARS} + $ENV{BGQ_STACKSIZE} + + + + /etc/profile.d/00softenv.csh + /etc/profile.d/00softenv.sh + soft + soft + + +mpiwrapper-xl + @ibm-compilers-2016-05 + +cmake + +python + + + $CIME_OUTPUT_ROOT/$CASE/run + $CIME_OUTPUT_ROOT/$CASE/bld + 0.1 + + 10000 + + + + + --envs BG_THREADLAYOUT=1 XL_BG_SPREADLAYOUT=YES OMP_DYNAMIC=FALSE OMP_NUM_THREADS=$ENV{OMP_NUM_THREADS} + + + --envs OMP_STACKSIZE=64M + + + --envs OMP_STACKSIZE=16M + + + + + LLNL Linux Cluster, Linux (pgi), 16 pes/node, batch system is Slurm + LINUX + intel + mpich + /p/lscratchh/$USER + /usr/gdata/climdat/ccsm3data/inputdata + /usr/gdata/climdat/ccsm3data/inputdata/atm/datm7 + /p/lscratchh/$CCSMUSER/archive/$CASE + /p/lscratchh/$CCSMUSER/ccsm_baselines/$COMPILER + /p/lscratchd/ma21/ccsm3data/tools/cprnc/cprnc + 8 + lc_slurm + donahue5 -at- llnl.gov + 16 + 16 + + + + + srun + + + /usr/share/lmod/lmod/init/env_modules_python.py + /usr/share/lmod/lmod/init/perl + /usr/share/lmod/lmod/init/sh + /usr/share/lmod/lmod/init/csh + module + module + /usr/share/lmod/lmod/libexec/lmod python + /usr/share/lmod/lmod/libexec/lmod perl + + python + git + intel/18.0.1 + pnetcdf/1.9.0 + mvapich2 + mvapich2/2.2 + netcdf-fortran/4.4.4 + pnetcdf/1.9.0 + + + /p/lscratchh/$CCSMUSER/ACME/$CASE/run + /p/lscratchh/$CCSMUSER/$CASE/bld + + /usr/tce/packages/netcdf-fortran/netcdf-fortran-4.4.4-intel-18.0.1/ + /usr/tce/packages/netcdf-fortran/netcdf-fortran-4.4.4-intel-18.0.1/ + + + /usr/tce/packages/pnetcdf/pnetcdf-1.9.0-intel-18.0.1-mvapich2-2.2/ + + + + + LLNL Linux Cluster, Linux (pgi), 36 pes/node, batch system is Slurm + LINUX + intel + mpich + /p/lscratchh/$USER + /usr/gdata/climdat/ccsm3data/inputdata + /usr/gdata/climdat/ccsm3data/inputdata/atm/datm7 + /p/lscratchh/$CCSMUSER/archive/$CASE + /p/lscratchh/$CCSMUSER/ccsm_baselines/$COMPILER + /p/lscratchd/ma21/ccsm3data/tools/cprnc/cprnc + 8 + lc_slurm + donahue5 -at- llnl.gov + 36 + 36 + + + + + srun + + + /usr/share/lmod/lmod/init/env_modules_python.py + /usr/share/lmod/lmod/init/perl + /usr/share/lmod/lmod/init/sh + /usr/share/lmod/lmod/init/csh + module + module + /usr/share/lmod/lmod/libexec/lmod python + /usr/share/lmod/lmod/libexec/lmod perl + + python + git + intel/18.0.1 + pnetcdf/1.9.0 + mvapich2 + mvapich2/2.2 + netcdf-fortran/4.4.4 + pnetcdf/1.9.0 + + + /p/lscratchh/$CCSMUSER/ACME/$CASE/run + /p/lscratchh/$CCSMUSER/$CASE/bld + + /usr/tce/packages/netcdf-fortran/netcdf-fortran-4.4.4-intel-18.0.1/ + /usr/tce/packages/netcdf-fortran/netcdf-fortran-4.4.4-intel-18.0.1/ + + + /usr/tce/packages/pnetcdf/pnetcdf-1.9.0-intel-18.0.1-mvapich2-2.2/ + + + + + ANL IBM BG/Q, os is BGQ, 16 cores/node, batch system is cobalt + mira.* + BGQ + ibm + ibm + ClimateEnergy_2 + /projects/$PROJECT + ClimateEnergy_2 + /projects/$PROJECT/$USER + /projects/ccsm/inputdata + /projects/ccsm/inputdata/atm/datm7 + /projects/$PROJECT/$USER/archive/$CASE + /projects/ccsm/ccsm_baselines//$COMPILER + /projects/ccsm/tools/cprnc/cprnc + 8 + e3sm_developer + cobalt + mickelso -at- mcs.anl.gov + 64 + 4 + TRUE + + /usr/bin/runjob + + --label short + --ranks-per-node $MAX_MPITASKS_PER_NODE + --np {{ total_tasks }} + --block $COBALT_PARTNAME $LOCARGS + $ENV{BGQ_SMP_VARS} + $ENV{BGQ_STACKSIZE} + + + + /etc/profile.d/00softenv.csh + /etc/profile.d/00softenv.sh + soft + soft + + +mpiwrapper-xl + @ibm-compilers-2016-05 + +cmake + +python + + + $CIME_OUTPUT_ROOT/$CASE/run + $CIME_OUTPUT_ROOT/$CASE/bld + 0.1 + + 10000 + + + + + --envs BG_THREADLAYOUT=1 XL_BG_SPREADLAYOUT=YES OMP_DYNAMIC=FALSE OMP_NUM_THREADS=$ENV{OMP_NUM_THREADS} + + + --envs OMP_STACKSIZE=64M + + + --envs OMP_STACKSIZE=16M + + + + + ALCF Cray XC40 KNL, os is CNL, 64 pes/node, batch system is cobalt + theta.* + CNL + intel,gnu,cray + mpt + /projects/$PROJECT + ClimateEnergy_3,OceanClimate_2 + /projects/$PROJECT/$USER + /projects/ccsm/acme/inputdata + /projects/ccsm/acme/inputdata/atm/datm7 + $CIME_OUTPUT_ROOT/archive/$CASE + /projects/$PROJECT/acme/baselines/$COMPILER + /projects/ccsm/acme/tools/cprnc/cprnc + 8 + e3sm_developer + cobalt_theta + E3SM + 128 + 64 + TRUE + + aprun + + -n {{ total_tasks }} + -N $SHELL{if [ `./xmlquery --value MAX_MPITASKS_PER_NODE` -gt `./xmlquery --value TOTAL_TASKS` ];then echo `./xmlquery --value TOTAL_TASKS`;else echo `./xmlquery --value MAX_MPITASKS_PER_NODE`;fi;} + --cc depth -d $SHELL{echo `./xmlquery --value MAX_TASKS_PER_NODE`/`./xmlquery --value MAX_MPITASKS_PER_NODE`|bc} -j $SHELL{if [ 64 -ge `./xmlquery --value MAX_TASKS_PER_NODE` ];then echo 1;else echo `./xmlquery --value MAX_TASKS_PER_NODE`/64|bc;fi;} + $ENV{SMP_VARS} $ENV{labeling} + + + + /opt/modules/default/init/perl.pm + /opt/modules/default/init/python.py + /opt/modules/default/init/sh + /opt/modules/default/init/csh + /opt/modules/default/bin/modulecmd perl + /opt/modules/default/bin/modulecmd python + module + module + + craype-mic-knl + PrgEnv-intel + PrgEnv-cray + PrgEnv-gnu + intel + cce + cray-mpich + cray-parallel-netcdf + cray-hdf5-parallel + cray-hdf5 + cray-netcdf + cray-netcdf-hdf5parallel + cray-libsci + craype + + + craype/2.5.12 + + + intel/18.0.0.128 + PrgEnv-intel/6.0.4 + + + cce/8.6.2 + PrgEnv-cray/6.0.4 + + + gcc/7.3.0 + PrgEnv-gnu/6.0.4 + + + cray-libsci/17.09.1 + + + craype-mic-knl + cray-mpich/7.6.2 + + + cray-netcdf/4.4.1.1.3 + cray-parallel-netcdf/1.8.1.3 + + + cray-netcdf/4.4.1.1.3 + + + $CIME_OUTPUT_ROOT/$CASE/run + $CIME_OUTPUT_ROOT/$CASE/bld + 0.1 + + 1 + 1 + + /projects/ccsm/acme/tools/mpas + 2 + + + + + -e OMP_NUM_THREADS=$ENV{OMP_NUM_THREADS} -e OMP_STACKSIZE=128M -e KMP_AFFINITY=granularity=thread,scatter + + + -e OMP_NUM_THREADS=$ENV{OMP_NUM_THREADS} -e OMP_STACKSIZE=128M -e OMP_PROC_BIND=spread -e OMP_PLACES=threads + + + -e PMI_LABEL_ERROUT=1 + + + + + ANL experimental/evaluation cluster, batch system is cobalt + jlse.* + LINUX + intel,gnu + mpich + $ENV{HOME}/acme/scratch + /home/azamat/acme/inputdata + /home/azamat/acme/inputdata/atm/datm7 + $CIME_OUTPUT_ROOT/archive/$CASE + $ENV{HOME}/acme/baselines/$COMPILER + /home/azamat/acme/tools/cprnc + 8 + acme_developer + cobalt_theta + e3sm + 128 + 64 + FALSE + + mpirun + + -n $TOTALPES + + + + /etc/bashrc + source + + /soft/compilers/intel/compilers_and_libraries/linux/bin/compilervars.sh intel64 + + + $CIME_OUTPUT_ROOT/$CASE/run + $CIME_OUTPUT_ROOT/$CASE/bld + + 1 + 1 + 1 + 1 + /home/azamat/perl5/bin:$ENV{PATH} + /home/azamat/perl5/lib/perl5 + /home/azamat/perl5 + "--install_base \"/home/azamat/perl5\"" + "INSTALL_BASE=/home/azamat/perl5" + + + /home/azamat/soft/netcdf/4.3.3.1c-4.2cxx-4.4.2f/intel18 + /home/azamat/soft/pnetcdf/1.6.1/intel18 + 10 + core + + + /home/azamat/soft/netcdf/4.3.3.1c-4.2cxx-4.4.2f/gnu-arm + /home/azamat/soft/pnetcdf/1.6.1/gnu-arm + + + verbose,granularity=thread,scatter + 256M + + + spread + threads + 256M + + + + + PNL cluster, OS is Linux, batch system is SLURM + sooty + LINUX + intel,pgi + mvapich2 + /lustre/$USER/cime_output_root + /lustre/climate/csmdata/ + /lustre/climate/csmdata/atm/datm7 + /lustre/$USER/archive/$CASE + /lustre/climate/acme_baselines/$COMPILER + /lustre/climate/acme_baselines/cprnc/cprnc + 8 + slurm + balwinder.singh -at- pnnl.gov + 8 + 8 + FALSE + + + + + srun + + --mpi=none + --ntasks={{ total_tasks }} + --cpu_bind=sockets --cpu_bind=verbose + --kill-on-bad-exit + + + + /share/apps/modules/Modules/3.2.10/init/perl.pm + /share/apps/modules/Modules/3.2.10/init/python.py + /etc/profile.d/modules.csh + /etc/profile.d/modules.sh + /share/apps/modules/Modules/3.2.10/bin/modulecmd perl + /share/apps/modules/Modules/3.2.10/bin/modulecmd python + module + module + + + + + perl/5.20.0 + cmake/3.3.0 + python/2.7.8 + svn/1.8.13 + + + intel/15.0.1 + mkl/15.0.1 + + + pgi/14.10 + + + mvapich2/2.1 + + + netcdf/4.3.2 + + + /lustre/$USER/csmruns/$CASE/run + /lustre/$USER/csmruns/$CASE/bld + + $ENV{MKLROOT} + $ENV{NETCDF_LIB}/../ + 64M + + + + + PNNL Intel KNC cluster, OS is Linux, batch system is SLURM + glogin + LINUX + intel + impi,mvapich2 + /dtemp/$PROJECT/$USER + /dtemp/st49401/sing201/acme/inputdata/ + /dtemp/st49401/sing201/acme/inputdata/atm/datm7 + $CIME_OUTPUT_ROOT/archive/$CASE + $CIME_OUTPUT_ROOT/acme/acme_baselines + $CIME_OUTPUT_ROOT/acme/acme_baselines/cprnc/cprnc + 8 + slurm + balwinder.singh -at- pnnl.gov + 16 + 16 + TRUE + + + + + mpirun + + -np {{ total_tasks }} + + + + srun + + --mpi=none + --ntasks={{ total_tasks }} + --cpu_bind=sockets --cpu_bind=verbose + --kill-on-bad-exit + + + + /opt/lmod/7.8.4/init/env_modules_python.py + /etc/profile.d/modules.csh + /etc/profile.d/modules.sh + /opt/lmod/7.8.4/libexec/lmod python + module + module + + + + + python/2.7.9 + + + intel/ips_18 + mkl/14.0 + + + impi/4.1.2.040 + + + mvapich2/1.9 + + + netcdf/4.3.0 + + + $CIME_OUTPUT_ROOT/csmruns/$CASE/run + $CIME_OUTPUT_ROOT/csmruns/$CASE/bld + + 64M + $ENV{NETCDF_ROOT} + + + $ENV{MLIBHOME} + intel + + + + + PNL Haswell cluster, OS is Linux, batch system is SLURM + constance + LINUX + intel,pgi,nag + mvapich2,openmpi,intelmpi,mvapich + /pic/scratch/$USER + /pic/projects/climate/csmdata/ + /pic/projects/climate/csmdata/atm/datm7 + /pic/scratch/$USER/archive/$CASE + /pic/projects/climate/acme_baselines/$COMPILER + /pic/projects/climate/acme_baselines/cprnc/cprnc + 8 + slurm + balwinder.singh -at- pnnl.gov + 24 + 24 + FALSE + + + + + srun + + --mpi=none + --ntasks={{ total_tasks }} + --cpu_bind=sockets --cpu_bind=verbose + --kill-on-bad-exit + + + + srun + + --ntasks={{ total_tasks }} + --cpu_bind=sockets --cpu_bind=verbose + --kill-on-bad-exit + + + + mpirun + + -n {{ total_tasks }} + + + + mpirun + + -n {{ total_tasks }} + + + + /share/apps/modules/Modules/3.2.10/init/perl.pm + /share/apps/modules/Modules/3.2.10/init/python.py + /etc/profile.d/modules.csh + /etc/profile.d/modules.sh + /share/apps/modules/Modules/3.2.10/bin/modulecmd perl + /share/apps/modules/Modules/3.2.10/bin/modulecmd python + module + module + + + + + perl/5.20.0 + cmake/3.3.0 + python/2.7.8 + + + intel/15.0.1 + mkl/15.0.1 + + + pgi/14.10 + + + nag/6.0 + mkl/15.0.1 + + + mvapich2/2.1 + + + mvapich2/2.1 + + + mvapich2/2.1 + + + mvapich2/2.3b + + + intelmpi/5.0.1.035 + + + openmpi/1.8.3 + + + netcdf/4.3.2 + + + netcdf/4.3.2 + + + netcdf/4.4.1.1 + + + /pic/scratch/$USER/csmruns/$CASE/run + /pic/scratch/$USER/csmruns/$CASE/bld + + 64M + $ENV{NETCDF_LIB}/../ + + + $ENV{MLIB_LIB} + + + $ENV{MLIB_LIB} + + + + + PNL E3SM Intel Xeon Gold 6148(Skylake) nodes, OS is Linux, SLURM + compy + LINUX + intel,pgi + mvapich2 + /compyfs/$USER/e3sm_scratch + /compyfs/inputdata + /compyfs/inputdata/atm/datm7 + /compyfs/$USER/e3sm_scratch/archive/$CASE + /compyfs/e3sm_baselines/$COMPILER + /compyfs/e3sm_baselines/cprnc/cprnc + 8 + slurm + bibi.mathew -at- pnnl.gov + 40 + 40 + TRUE + + + + + srun + + --mpi=none + --ntasks={{ total_tasks }} + --cpu_bind=sockets --cpu_bind=verbose + --kill-on-bad-exit + + + + /share/apps/modules/init/perl.pm + /share/apps/modules/init/python.py + /etc/profile.d/modules.csh + /etc/profile.d/modules.sh + /share/apps/modules/bin/modulecmd perl + /share/apps/modules/bin/modulecmd python + module + module + + + + + intel/19.0.3 + + + pgi/18.10 + + + mvapich2/2.3.1 + + + netcdf/4.6.3 + pnetcdf/1.9.0 + mkl/2019u3 + + + $CIME_OUTPUT_ROOT/$CASE/run + $CIME_OUTPUT_ROOT/$CASE/bld + + 64M + $ENV{NETCDF_ROOT}/ + + + $ENV{MKLROOT} + + + + + ORNL XK6, os is Linux, 32 pes/node, batch system is PBS + oic5 + LINUX + gnu + mpich,openmpi + /home/$USER/models/ACME + /home/zdr/models/ccsm_inputdata + /home/zdr/models/ccsm_inputdata/atm/datm7 + /home/$USER/models/ACME/run/archive/$CASE + 32 + e3sm_developer + pbs + dmricciuto + 32 + 32 + + /projects/cesm/devtools/mpich-3.0.4-gcc4.8.1/bin/mpirun + + -np {{ total_tasks }} + --hostfile $ENV{PBS_NODEFILE} + + + + + + + /home/$USER/models/ACME/run/$CASE/run + /home/$USER/models/ACME/run/$CASE/bld + + + + OR-CONDO, CADES-CCSI, os is Linux, 16 pes/nodes, batch system is PBS + or-condo + LINUX + gnu,intel + openmpi + /lustre/or-hydra/cades-ccsi/scratch/$USER + /lustre/or-hydra/cades-ccsi/proj-shared/project_acme/ACME_inputdata + /lustre/or-hydra/cades-ccsi/proj-shared/project_acme/ACME_inputdata/atm/datm7 + $CIME_OUTPUT_ROOT/archive/$CASE + /lustre/or-hydra/cades-ccsi/proj-shared/project_acme/baselines/$COMPILER + /lustre/or-hydra/cades-ccsi/proj-shared/tools/cprnc.orcondo + 4 + e3sm_developer + pbs + yinj -at- ornl.gov + 32 + 32 + FALSE + + mpirun + + -np {{ total_tasks }} + --hostfile $ENV{PBS_NODEFILE} + + + + + + + /usr/share/Modules/init/sh + /usr/share/Modules/init/csh + /usr/share/Modules/init/perl.pm + /usr/share/Modules/init/python.py + module + module + /usr/bin/modulecmd perl + /usr/bin/modulecmd python + + + + + PE-gnu + + + mkl/2017 + /lustre/or-hydra/cades-ccsi/proj-shared/tools/cmake/3.6.1 + python/2.7.12 + /lustre/or-hydra/cades-ccsi/proj-shared/tools/nco/4.6.4 + hdf5-parallel/1.8.17 + netcdf-hdf5parallel/4.3.3.1 + pnetcdf/1.9.0 + + + + + $CIME_OUTPUT_ROOT/$CASE/run + $CIME_OUTPUT_ROOT/$CASE/bld + + + /software/user_tools/current/cades-ccsi/petsc4pf/openmpi-1.10-gcc-5.3 + + + + + ORNL XK6, os is CNL, 16 pes/node, batch system is PBS + titan + Received node event ec_node + CNL + pgi,pgiacc,intel,cray + mpich + cli115 + $ENV{PROJWORK}/$PROJECT + cli106,cli115,cli127,cli133,csc190 + $ENV{HOME}/acme_scratch/$PROJECT + /lustre/atlas1/cli900/world-shared/cesm/inputdata + /lustre/atlas1/cli900/world-shared/cesm/inputdata/atm/datm7 + $ENV{MEMBERWORK}/$PROJECT/archive/$CASE + /lustre/atlas1/cli115/world-shared/E3SM/baselines/$COMPILER + /lustre/atlas1/cli900/world-shared/cesm/tools/cprnc/cprnc.titan + 8 + e3sm_developer + pbs + TRUE + E3SM + 16 + 16 + TRUE + + aprun + + + + aprun + + + + + /opt/modules/default/init/sh + /opt/modules/default/init/csh + /opt/modules/default/init/python.py + /opt/modules/default/init/perl.pm + + /opt/modules/default/bin/modulecmd perl + /opt/modules/default/bin/modulecmd python + module + module + + + + python/2.7.9 + subversion + subversion/1.9.3 + cmake + cmake3/3.6.0 + + + + PrgEnv-cray + PrgEnv-gnu + PrgEnv-intel + PrgEnv-pathscale + PrgEnv-pgi + pgi pgi/17.5.0 + cray-mpich + cray-libsci + atp + esmf + cudatoolkit + cray-mpich/7.6.3 + cray-libsci/16.11.1 + atp/2.1.1 + esmf/5.2.0rp2 + cudatoolkit + + + PrgEnv-cray + PrgEnv-gnu + PrgEnv-intel + PrgEnv-pathscale + PrgEnv-pgi + pgi pgi/17.5.0 + cray-mpich + cray-libsci + atp + esmf + cray-mpich/7.6.3 + cray-libsci/16.11.1 + atp/2.1.1 + esmf/5.2.0rp2 + + + PrgEnv-pgi + PrgEnv-cray + PrgEnv-gnu + PrgEnv-pathscale + PrgEnv-intel + intel + cray-libsci + cray-mpich + atp + intel/18.0.1.163 + cray-mpich/7.6.3 + atp/2.1.1 + + + PrgEnv-pgi + PrgEnv-gnu + PrgEnv-intel + PrgEnv-pathscale + PrgEnv-cray + cce + cray-mpich + cce/8.6.4 + cray-mpich/7.6.3 + + + + cray-netcdf + cray-netcdf-hdf5parallel + cray-netcdf/4.4.1.1.3 + + + cray-netcdf + cray-netcdf-hdf5parallel + cray-netcdf/4.4.1.1.3 + cray-parallel-netcdf/1.8.1.3 + + + $ENV{PROJWORK}/$PROJECT/$USER/$CASE/run + $CIME_OUTPUT_ROOT/$CASE/bld + + 0.1 + + + + $COMPILER + $MPILIB + 1 + 1 + + 128M + 128M + + + + + + istanbul + 1 + + + dynamic + + + + + ORNL XC30, os is CNL, 16 pes/node, batch system is PBS + eos + CNL + intel + mpich + $ENV{PROJWORK}/$PROJECT + cli115,cli127,cli106,csc190 + $ENV{HOME}/acme_scratch/$PROJECT + /lustre/atlas1/cli900/world-shared/cesm/inputdata + /lustre/atlas1/cli900/world-shared/cesm/inputdata/atm/datm7 + $ENV{MEMBERWORK}/$PROJECT/archive/$CASE + /lustre/atlas1/cli900/world-shared/cesm/baselines/$COMPILER + /lustre/atlas1/cli900/world-shared/cesm/tools/cprnc/cprnc.eos + 8 + e3sm_developer + pbs + E3SM + 32 + 16 + TRUE + + aprun + + -j {{ hyperthreading }} + -S {{ tasks_per_numa }} + -n {{ total_tasks }} + -N $MAX_MPITASKS_PER_NODE + -d $ENV{OMP_NUM_THREADS} + -cc numa_node + + + + + + + $MODULESHOME/init/sh + $MODULESHOME/init/csh + $MODULESHOME/init/perl.pm + $MODULESHOME/init/python.py + module + module + $MODULESHOME/bin/modulecmd perl + $MODULESHOME/bin/modulecmd python + + intel + cray + cray-parallel-netcdf + cray-libsci + cray-netcdf + cray-netcdf-hdf5parallel + netcdf + + + intel/18.0.1.163 + papi + + + PrgEnv-cray + cce cce/8.1.9 + cray-libsci/12.1.00 + + + PrgEnv-gnu + gcc gcc/4.8.0 + cray-libsci/12.1.00 + + + cray-netcdf/4.3.2 + + + cray-netcdf-hdf5parallel/4.3.3.1 + cray-parallel-netcdf/1.6.1 + + + cmake3/3.2.3 + python/2.7.9 + + + $ENV{MEMBERWORK}/$PROJECT/$CASE/run + $CIME_OUTPUT_ROOT/$CASE/bld + + 1 + 1 + + 64M + + + + + + LANL Linux Cluster, 36 pes/node, batch system slurm + gr-fe.*.lanl.gov + LINUX + gnu,intel + mvapich,openmpi + climateacme + /lustre/scratch3/turquoise/$ENV{USER}/E3SM/scratch + /lustre/scratch3/turquoise/$ENV{USER}/E3SM/input_data + /lustre/scratch3/turquoise/$ENV{USER}/E3SM/input_data/atm/datm7 + /lustre/scratch3/turquoise/$ENV{USER}/E3SM/archive/$CASE + /lustre/scratch3/turquoise/$ENV{USER}/E3SM/input_data/ccsm_baselines/$COMPILER + /turquoise/usr/projects/climate/SHARED_CLIMATE/software/wolf/cprnc/v0.40/cprnc + 4 + e3sm_developer + slurm + luke.vanroekel @ gmail.com + 36 + 32 + TRUE + + mpirun + + -n {{ total_tasks }} + + + + srun + + -n {{ total_tasks }} + + + + mpirun + + -n {{ total_tasks }} + + + + + + + /usr/share/Modules/init/perl.pm + /usr/share/Modules/init/python.py + /etc/profile.d/z00_lmod.sh + /etc/profile.d/z00_lmod.csh + /usr/share/lmod/lmod/libexec/lmod perl + /usr/share/lmod/lmod/libexec/lmod python + module + module + + + /usr/projects/climate/SHARED_CLIMATE/modulefiles/all + python/anaconda-2.7-climate + + + gcc/5.3.0 + + + intel/17.0.1 + + + openmpi/1.10.5 + + + mvapich2/2.2 + + + netcdf/4.4.1 + + + parallel-netcdf/1.5.0 + + + mkl + + + /lustre/scratch3/turquoise/$ENV{USER}/E3SM/cases/$CASE/run + /lustre/scratch3/turquoise/$ENV{USER}/E3SM/cases/$CASE/bld + + romio_ds_write=disable;romio_ds_read=disable;romio_cb_write=enable;romio_cb_read=enable + + + /opt/intel/17.0/mkl + + + + + LANL Linux Cluster, 36 pes/node, batch system slurm + ba-fe.*.lanl.gov + LINUX + gnu,intel + mvapich,openmpi + climateacme + /lustre/scratch3/turquoise/$ENV{USER}/E3SM/scratch + /lustre/scratch3/turquoise/$ENV{USER}/E3SM/input_data + /lustre/scratch3/turquoise/$ENV{USER}/E3SM/input_data/atm/datm7 + /lustre/scratch3/turquoise/$ENV{USER}/E3SM/archive/$CASE + /lustre/scratch3/turquoise/$ENV{USER}/E3SM/input_data/ccsm_baselines/$COMPILER + /turquoise/usr/projects/climate/SHARED_CLIMATE/software/wolf/cprnc/v0.40/cprnc + 4 + e3sm_developer + slurm + e3sm + 36 + 32 + TRUE + + mpirun + + -n {{ total_tasks }} + + + + srun + + -n {{ total_tasks }} + + + + mpirun + + -n {{ total_tasks }} + + + + + + + /usr/share/Modules/init/perl.pm + /usr/share/Modules/init/python.py + /etc/profile.d/z00_lmod.sh + /etc/profile.d/z00_lmod.csh + /usr/share/lmod/lmod/libexec/lmod perl + /usr/share/lmod/lmod/libexec/lmod python + module + module + + + /usr/projects/climate/SHARED_CLIMATE/modulefiles/all + python/anaconda-2.7-climate + + + gcc/6.4.0 + + + intel/17.0.4 + + + openmpi/2.1.2 + + + mvapich2/2.2 + + + netcdf/4.4.1.1 + + + parallel-netcdf/1.8.1 + + + mkl + + + /lustre/scratch3/turquoise/$ENV{USER}/E3SM/cases/$CASE/run + /lustre/scratch3/turquoise/$ENV{USER}/E3SM/cases/$CASE/bld + + romio_ds_write=disable;romio_ds_read=disable;romio_cb_write=enable;romio_cb_read=enable + + + /opt/intel/17.0/mkl + + + + + Mesabi batch queue + LINUX + intel + openmpi + /home/reichpb/scratch + /home/reichpb/shared/cesm_inputdata + /home/reichpb/shared/cesm_inputdata/atm/datm7 + USERDEFINED_optional_run + USERDEFINED_optional_run/$COMPILER + USERDEFINED_optional_test + 2 + pbs + chen1718 at umn dot edu + 24 + 24 + TRUE + + aprun + + -n {{ total_tasks }} + -S {{ tasks_per_numa }} + -N $MAX_MPITASKS_PER_NODE + -d $ENV{OMP_NUM_THREADS} + + + + $CASEROOT/run + + $CASEROOT/exedir + + + + + + + + + + + + + + Itasca batch queue + LINUX + intel + openmpi + /home/reichpb/scratch + /home/reichpb/shared/cesm_inputdata + /home/reichpb/shared/cesm_inputdata/atm/datm7 + USERDEFINED_optional_run + USERDEFINED_optional_run/$COMPILER + USERDEFINED_optional_test + 2 + pbs + chen1718 at umn dot edu + 8 + 8 + + aprun + + -n {{ total_tasks }} + -S {{ tasks_per_numa }} + -N $MAX_MPITASKS_PER_NODE + -d $ENV{OMP_NUM_THREADS} + + + + $CASEROOT/run + + $CASEROOT/exedir + + + + + + + + + + + + + + Lawrencium LR6 cluster at LBL, OS is Linux (intel), batch system is SLURM + n000* + LINUX + intel,gnu + openmpi + ac_acme + /global/scratch/$ENV{USER} + /global/scratch/$ENV{USER}/cesm_input_datasets/ + /global/scratch/$ENV{USER}/cesm_input_datasets/atm/datm7 + $CIME_OUTPUT_ROOT/cesm_archive/$CASE + $CIME_OUTPUT_ROOT/cesm_baselines/$COMPILER + /$CIME_OUTPUT_ROOT/cesm_tools/cprnc/cprnc + 4 + slurm + gbisht at lbl dot gov + 12 + 12 + TRUE + + mpirun + + -np {{ total_tasks }} + -npernode $MAX_MPITASKS_PER_NODE + + + + mpirun + + -np {{ total_tasks }} + -npernode $MAX_MPITASKS_PER_NODE + + + + /etc/profile.d/modules.sh + /etc/profile.d/modules.csh + /usr/Modules/init/perl.pm + /usr/Modules/python.py + module + module + /usr/Modules/bin/modulecmd perl + /usr/Modules/bin/modulecmd python + + + cmake + perl xml-libxml switch python/2.7 + + + intel/2016.4.072 + mkl + + + netcdf/4.4.1.1-intel-s + + + openmpi + netcdf/4.4.1.1-intel-p + + + gcc/6.3.0 + lapack/3.8.0-gcc + + + netcdf/5.4.1.1-gcc-s + openmpi/2.0.2-gcc + + + openmpi/3.0.1-gcc + netcdf/4.4.1.1-gcc-p + openmpi/2.0.2-gcc + + + + $CIME_OUTPUT_ROOT/$CASE/run + $CIME_OUTPUT_ROOT/$CASE/bld + + + + Lawrencium LR6 cluster at LBL, OS is Linux (intel), batch system is SLURM + n000* + LINUX + intel,gnu + openmpi + ac_acme + /global/scratch/$ENV{USER} + /global/scratch/$ENV{USER}/cesm_input_datasets/ + /global/scratch/$ENV{USER}/cesm_input_datasets/atm/datm7 + $CIME_OUTPUT_ROOT/cesm_archive/$CASE + $CIME_OUTPUT_ROOT/cesm_baselines/$COMPILER + /$CIME_OUTPUT_ROOT/cesm_tools/cprnc/cprnc + 4 + slurm + gbisht at lbl dot gov + 12 + 12 + TRUE + + mpirun + + -np {{ total_tasks }} + -npernode $MAX_MPITASKS_PER_NODE + + + + mpirun + + -np {{ total_tasks }} + -npernode $MAX_MPITASKS_PER_NODE + + + + /etc/profile.d/modules.sh + /etc/profile.d/modules.csh + /usr/Modules/init/perl.pm + /usr/Modules/python.py + module + module + /usr/Modules/bin/modulecmd perl + /usr/Modules/bin/modulecmd python + + + cmake + perl xml-libxml switch python/2.7 + + + intel/2016.4.072 + mkl + + + netcdf/4.4.1.1-intel-s + + + openmpi + netcdf/4.4.1.1-intel-p + + + gcc/6.3.0 + lapack/3.8.0-gcc + + + netcdf/5.4.1.1-gcc-s + openmpi/2.0.2-gcc + + + openmpi/3.0.1-gcc + netcdf/4.4.1.1-gcc-p + openmpi/2.0.2-gcc + + + + $CIME_OUTPUT_ROOT/$CASE/run + $CIME_OUTPUT_ROOT/$CASE/bld + + + + Lawrencium LR6 cluster at LBL, OS is Linux (intel), batch system is SLURM + n000* + LINUX + intel,gnu + openmpi + ac_acme + /global/scratch/$ENV{USER} + /global/scratch/$ENV{USER}/cesm_input_datasets/ + /global/scratch/$ENV{USER}/cesm_input_datasets/atm/datm7 + $CIME_OUTPUT_ROOT/cesm_archive/$CASE + $CIME_OUTPUT_ROOT/cesm_baselines/$COMPILER + /$CIME_OUTPUT_ROOT/cesm_tools/cprnc/cprnc + 4 + slurm + gbisht at lbl dot gov + 12 + 12 + TRUE + + mpirun + + -np {{ total_tasks }} + -npernode $MAX_MPITASKS_PER_NODE + + + + mpirun + + -np {{ total_tasks }} + -npernode $MAX_MPITASKS_PER_NODE + + + + /etc/profile.d/modules.sh + /etc/profile.d/modules.csh + /usr/Modules/init/perl.pm + /usr/Modules/python.py + module + module + /usr/Modules/bin/modulecmd perl + /usr/Modules/bin/modulecmd python + + + cmake + perl xml-libxml switch python/2.7 + + + intel/2016.4.072 + mkl + + + netcdf/4.4.1.1-intel-s + + + openmpi + netcdf/4.4.1.1-intel-p + + + gcc/6.3.0 + lapack/3.8.0-gcc + + + netcdf/5.4.1.1-gcc-s + openmpi/2.0.2-gcc + + + openmpi/3.0.1-gcc + netcdf/4.4.1.1-gcc-p + openmpi/2.0.2-gcc + + + + $CIME_OUTPUT_ROOT/$CASE/run + $CIME_OUTPUT_ROOT/$CASE/bld + + + + small developer workhorse at lbl climate sciences + LINUX + gnu + openmpi + ngeet + /home/lbleco/acme/ + /home/lbleco/cesm/cesm_input_datasets/ + /home/lbleco/cesm/cesm_input_datasets/atm/datm7/ + /home/lbleco/acme/cesm_archive/$CASE + /home/lbleco/acme/cesm_baselines/$COMPILER + /home/lbleco/cesm/cesm_tools/cprnc/cprnc + 1 + none + rgknox at lbl gov + 4 + 4 + FALSE + + + + + mpirun + + -np {{ total_tasks }} + -npernode $MAX_MPITASKS_PER_NODE + + + + + + + ORNL pre-Summit testbed. Node: 2x POWER8 + 4x Tesla P100, 20 cores/node, 8 HW threads/core. + summitdev-* + LINUX + ibm,pgi,pgiacc + spectrum-mpi,mpi-serial + csc249 + CSC249ADSE15 + /lustre/atlas/proj-shared/$PROJECT + cli115,cli127,cli106,csc190 + $ENV{HOME}/acme_scratch/$PROJECT + /lustre/atlas1/cli900/world-shared/cesm/inputdata + /lustre/atlas1/cli900/world-shared/cesm/inputdata/atm/datm7 + /lustre/atlas/scratch/$ENV{USER}/$PROJECT/archive/$CASE + /lustre/atlas1/cli900/world-shared/cesm/baselines/$COMPILER + /lustre/atlas1/cli900/world-shared/cesm/tools/cprnc/cprnc + 32 + e3sm_developer + lsf + acme + 160 + 80 + TRUE + + /lustre/atlas/world-shared/cli900/helper_scripts/mpirun.summitdev + + + -n {{ total_tasks }} -N $MAX_MPITASKS_PER_NODE + + + + + + + /sw/summitdev/lmod/7.4.0/rhel7.2_gnu4.8.5/lmod/7.4/init/sh + /sw/summitdev/lmod/7.4.0/rhel7.2_gnu4.8.5/lmod/7.4/init/csh + /sw/summitdev/lmod/7.4.0/rhel7.2_gnu4.8.5/lmod/7.4/init/env_modules_python.py + /sw/summitdev/lmod/7.4.0/rhel7.2_gnu4.8.5/lmod/7.4/init/perl + + module + /sw/summitdev/lmod/7.4.0/rhel7.2_gnu4.8.5/lmod/lmod/libexec/lmod python + module + module + + + + + + + DefApps + python/3.5.2 + subversion/1.9.3 + git/2.13.0 + cmake/3.6.1 + essl/5.5.0-20161110 + netlib-lapack/3.6.1 + + + + xl + pgi/17.9 + spectrum-mpi/10.1.0.4-20170915 + + + + pgi + xl/20170914-beta + spectrum-mpi/10.1.0.4-20170915 + + + + + + netcdf/4.4.1 + netcdf-fortran/4.4.4 + + + + netcdf/4.4.1 + netcdf-fortran/4.4.4 + parallel-netcdf/1.7.0 + hdf5/1.10.0-patch1 + + + netcdf/4.4.1 + netcdf-fortran/4.4.4 + parallel-netcdf/1.7.0 + hdf5/1.10.0-patch1 + + + /lustre/atlas/scratch/$ENV{USER}/$PROJECT/$CASE/run + $CIME_OUTPUT_ROOT/$CASE/bld + + + + + + $COMPILER + $MPILIB + 128M + $ENV{OLCF_NETCDF_ROOT} + $ENV{OLCF_NETCDF_FORTRAN_ROOT} + $ENV{OLCF_HDF5_ROOT} + $ENV{OLCF_ESSL_ROOT} + $ENV{OLCF_NETLIB_LAPACK_ROOT} + + + + + + $ENV{OLCF_PARALLEL_NETCDF_ROOT} + + + + + ORNL Summit. Node: 2x POWER9 + 6x Volta V100, 22 cores/socket, 4 HW threads/core. + .*summit.* + LINUX + ibm,pgi,pgiacc,gnu + spectrum-mpi,mpi-serial + cli115 + cli115 + /gpfs/alpine/proj-shared/$PROJECT + cli115,cli127,csc190 + /gpfs/alpine/$PROJECT/proj-shared/$ENV{USER}/e3sm_scratch + /gpfs/alpine/cli115/world-shared/e3sm/inputdata + /gpfs/alpine/cli115/world-shared/e3sm/inputdata/atm/datm7 + /gpfs/alpine/$PROJECT/proj-shared/$ENV{USER}/archive/$CASE + /gpfs/alpine/cli115/world-shared/e3sm/baselines/$COMPILER + /gpfs/alpine/cli115/world-shared/e3sm/tools/cprnc.summit/cprnc + 32 + e3sm_developer + lsf + e3sm + 84 + 84 + TRUE + + + /gpfs/alpine/world-shared/csc190/e3sm/mpirun.summit + + + -n {{ total_tasks }} -N $MAX_MPITASKS_PER_NODE + + + + + /sw/summit/lmod/7.7.10/rhel7.3_gnu4.8.5/lmod/lmod/init/sh + /sw/summit/lmod/7.7.10/rhel7.3_gnu4.8.5/lmod/lmod/init/csh + /sw/summit/lmod/7.7.10/rhel7.3_gnu4.8.5/lmod/lmod/init/env_modules_python.py + /sw/summit/lmod/7.7.10/rhel7.3_gnu4.8.5/lmod/lmod/init/perl + + module + /sw/summit/lmod/7.7.10/rhel7.3_gnu4.8.5/lmod/7.7.10/libexec/lmod python + module + module + + + + + + DefApps + python/3.5.2 + subversion/1.9.3 + git/2.13.0 + cmake/3.13.4 + essl/6.1.0-2 + netlib-lapack/3.8.0 + + + + pgi/18.10 + + + xl/16.1.1-1 + + + gcc/6.4.0 + + + + netcdf/4.6.1 + netcdf-fortran/4.4.4 + + + + + spectrum-mpi/10.2.0.11-20190201 + + + spectrum-mpi/10.2.0.11-20190201 + + + spectrum-mpi/10.2.0.11-20190201 + + + + parallel-netcdf/1.8.0 + hdf5/1.10.3 + + + + + + $CIME_OUTPUT_ROOT/$CASE/run + $CIME_OUTPUT_ROOT/$CASE/bld + + + + + + + $COMPILER + $MPILIB + 128M + $ENV{OLCF_NETCDF_ROOT} + $ENV{OLCF_NETCDF_FORTRAN_ROOT} + $ENV{OLCF_NETCDF_FORTRAN_ROOT} + $ENV{OLCF_NETCDF_FORTRAN_ROOT} + $ENV{OLCF_ESSL_ROOT} + $ENV{OLCF_NETLIB_LAPACK_ROOT} + + + $ENV{OMP_NUM_THREADS} + + + $ENV{OLCF_HDF5_ROOT} + + romio314 + $ENV{OLCF_PARALLEL_NETCDF_ROOT} + + + + + ${EXEROOT}/e3sm.exe + >> e3sm.log.$LID 2>&1 + + + diff --git a/components/cmake/common_setup.cmake b/components/cmake/common_setup.cmake index 3c6d85b25ee9..c12f685171db 100644 --- a/components/cmake/common_setup.cmake +++ b/components/cmake/common_setup.cmake @@ -256,22 +256,21 @@ if (USE_KOKKOS) endif() # JGF: No one seems to be using this -# if (USE_MOAB) -# if (MOAB_PATH) -# set(CPPDEFS "${CPPDEFS} -DHAVE_MOAB") -# if (NOT INC_MOAB) -# set(INC_MOAB ${MOAB_PATH}/include) -# endif() -# if (NOT LIB_MOAB) -# set(LIB_MOAB ${MOAB_PATH}/lib) -# endif() -# else() -# message(FATAL_ERROR "MOAB_PATH must be defined when USE_MOAB is TRUE") -# endif() - -# # # get the "IMESH_LIBS" list as an env var -# #include $(LIB_MOAB)/iMesh-Defs.inc -# endif() +if (COMP_INTERFACE STREQUAL "moab") + if (MOAB_PATH) + set(CPPDEFS "${CPPDEFS} -DHAVE_MOAB") + if (NOT INC_MOAB) + set(INC_MOAB ${MOAB_PATH}/include) + endif() + if (NOT LIB_MOAB) + set(LIB_MOAB ${MOAB_PATH}/lib) + endif() + else() + message(FATAL_ERROR "MOAB_PATH must be defined when USE_MOAB is TRUE") + endif() + + find_package(MOAB) +endif() # Set HAVE_SLASHPROC on LINUX systems which are not bluegene or Darwin (OSx) string(FIND "${CPPDEFS}" "-DLINUX" HAS_DLINUX) diff --git a/driver-mct/shr/seq_comm_mct.F90 b/driver-mct/shr/seq_comm_mct.F90 index 1725a5595765..b7cf751225be 100644 --- a/driver-mct/shr/seq_comm_mct.F90 +++ b/driver-mct/shr/seq_comm_mct.F90 @@ -250,7 +250,10 @@ subroutine seq_comm_init(global_comm_in, driver_comm_in, nmlfile, drv_comm_id) integer :: drv_inst character(len=8) :: c_drv_inst ! driver instance number character(len=8) :: c_driver_numpes ! number of pes in driver +<<<<<<< HEAD:driver-mct/shr/seq_comm_mct.F90 character(len=16):: c_comm_name ! comm. name +======= +>>>>>>> a7b4b52c7... merge mct driver updates into moab:cime/src/drivers/moab/shr/seq_comm_mct.F90 character(len=seq_comm_namelen) :: valid_comps(ncomps) integer :: & @@ -263,7 +266,12 @@ subroutine seq_comm_init(global_comm_in, driver_comm_in, nmlfile, drv_comm_id) ocn_ntasks, ocn_rootpe, ocn_pestride, ocn_nthreads, & esp_ntasks, esp_rootpe, esp_pestride, esp_nthreads, & iac_ntasks, iac_rootpe, iac_pestride, iac_nthreads, & +<<<<<<< HEAD:driver-mct/shr/seq_comm_mct.F90 cpl_ntasks, cpl_rootpe, cpl_pestride, cpl_nthreads +======= + cpl_ntasks, cpl_rootpe, cpl_pestride, cpl_nthreads, & + info_taskmap_model +>>>>>>> a7b4b52c7... merge mct driver updates into moab:cime/src/drivers/moab/shr/seq_comm_mct.F90 namelist /cime_pes/ & atm_ntasks, atm_rootpe, atm_pestride, atm_nthreads, atm_layout, & @@ -276,7 +284,11 @@ subroutine seq_comm_init(global_comm_in, driver_comm_in, nmlfile, drv_comm_id) esp_ntasks, esp_rootpe, esp_pestride, esp_nthreads, esp_layout, & iac_ntasks, iac_rootpe, iac_pestride, iac_nthreads, iac_layout, & cpl_ntasks, cpl_rootpe, cpl_pestride, cpl_nthreads, & +<<<<<<< HEAD:driver-mct/shr/seq_comm_mct.F90 info_taskmap_model, info_taskmap_comp, info_mprof, info_mprof_dt +======= + info_taskmap_model, info_taskmap_comp +>>>>>>> a7b4b52c7... merge mct driver updates into moab:cime/src/drivers/moab/shr/seq_comm_mct.F90 !---------------------------------------------------------- ! make sure this is first pass and set comms unset @@ -347,8 +359,11 @@ subroutine seq_comm_init(global_comm_in, driver_comm_in, nmlfile, drv_comm_id) call comp_pelayout_init(numpes, cpl_ntasks, cpl_rootpe, cpl_pestride, cpl_nthreads) info_taskmap_model = 0 info_taskmap_comp = 0 +<<<<<<< HEAD:driver-mct/shr/seq_comm_mct.F90 info_mprof = 0 info_mprof_dt = 86400 +======= +>>>>>>> a7b4b52c7... merge mct driver updates into moab:cime/src/drivers/moab/shr/seq_comm_mct.F90 ! Read namelist if it exists @@ -388,8 +403,11 @@ subroutine seq_comm_init(global_comm_in, driver_comm_in, nmlfile, drv_comm_id) call shr_mpi_bcast(info_taskmap_model,DRIVER_COMM,'info_taskmap_model') call shr_mpi_bcast(info_taskmap_comp, DRIVER_COMM,'info_taskmap_comp' ) +<<<<<<< HEAD:driver-mct/shr/seq_comm_mct.F90 call shr_mpi_bcast(info_mprof, DRIVER_COMM,'info_mprof') call shr_mpi_bcast(info_mprof_dt,DRIVER_COMM,'info_mprof_dt') +======= +>>>>>>> a7b4b52c7... merge mct driver updates into moab:cime/src/drivers/moab/shr/seq_comm_mct.F90 #ifdef TIMING if (info_taskmap_model > 0) then @@ -421,6 +439,7 @@ subroutine seq_comm_init(global_comm_in, driver_comm_in, nmlfile, drv_comm_id) call shr_sys_flush(logunit) endif +<<<<<<< HEAD:driver-mct/shr/seq_comm_mct.F90 if (info_mprof > 2) then allocate( driver_task_node_map(0:global_numpes-1), stat=ierr) if (ierr /= 0) call shr_sys_abort(trim(subname)//' allocate driver_task_node_map failed ') @@ -441,6 +460,16 @@ subroutine seq_comm_init(global_comm_in, driver_comm_in, nmlfile, drv_comm_id) else call shr_taskmap_write(logunit, DRIVER_COMM, & c_comm_name, & +======= + call t_startf("shr_taskmap_write") + if (drv_inst == 0) then + call shr_taskmap_write(logunit, DRIVER_COMM, & + 'GLOBAL', & + verbose=verbose_taskmap_output) + else + call shr_taskmap_write(logunit, DRIVER_COMM, & + 'DRIVER #'//trim(adjustl(c_drv_inst)), & +>>>>>>> a7b4b52c7... merge mct driver updates into moab:cime/src/drivers/moab/shr/seq_comm_mct.F90 verbose=verbose_taskmap_output) endif call t_stopf("shr_taskmap_write") diff --git a/driver-moab/cime_config/buildexe b/driver-moab/cime_config/buildexe old mode 100755 new mode 100644 index 686f6fb70988..5ca61bf3d76e --- a/driver-moab/cime_config/buildexe +++ b/driver-moab/cime_config/buildexe @@ -13,6 +13,7 @@ from standard_script_setup import * from CIME.buildlib import parse_input from CIME.case import Case from CIME.utils import expect, run_cmd +from CIME.build import get_standard_makefile_args logger = logging.getLogger(__name__) @@ -20,36 +21,41 @@ logger = logging.getLogger(__name__) def _main_func(): ############################################################################### - caseroot, libroot, _ = parse_input(sys.argv) + caseroot, _, _ = parse_input(sys.argv) logger.info("Building a single executable version of target coupled model") with Case(caseroot) as case: casetools = case.get_value("CASETOOLS") cimeroot = case.get_value("CIMEROOT") - exeroot = case.get_value("EXEROOT") gmake = case.get_value("GMAKE") gmake_j = case.get_value("GMAKE_J") - model = case.get_value("MODEL") num_esp = case.get_value("NUM_COMP_INST_ESP") - os.environ["PIO_VERSION"] = str(case.get_value("PIO_VERSION")) + ocn_model = case.get_value("COMP_OCN") + atm_model = case.get_value("COMP_ATM") + gmake_opts = get_standard_makefile_args(case) + blddir = os.path.join(case.get_value("EXEROOT"),"cpl","obj") + + if ocn_model == 'mom' or atm_model == "ufsatm": + gmake_opts += "USE_FMS=TRUE" + expect((num_esp is None) or (int(num_esp) == 1), "ESP component restricted to one instance") - with open('Filepath', 'w') as out: + with open(os.path.join(blddir,'Filepath'), 'w') as out: out.write(os.path.join(caseroot, "SourceMods", "src.drv") + "\n") out.write(os.path.join(cimeroot, "src", "drivers", "moab", "main") + "\n") # build model executable makefile = os.path.join(casetools, "Makefile") - exename = os.path.join(exeroot, model + ".exe") + exename = os.path.join(case.get_value("EXEROOT"), case.get_value("MODEL") + ".exe") - cmd = "%s exec_se -j %d EXEC_SE=%s MODEL=%s LIBROOT=%s -f %s "\ - % (gmake, gmake_j, exename, "driver", libroot, makefile) + cmd = "{gmake} exec_se -j {gmake_j} EXEC_SE={exename} MODEL=driver {gmake_opts} -f {makefile} ".format(gmake=gmake, gmake_j=gmake_j, exename=exename, + gmake_opts=gmake_opts, makefile=makefile) - rc, out, _ = run_cmd(cmd, combine_output=True) + rc, out, _ = run_cmd(cmd, combine_output=True, from_dir=blddir) expect(rc==0,"Command %s failed rc=%d\nout=%s"%(cmd,rc,out)) logger.info(out) diff --git a/driver-moab/cime_config/buildlib_cmake b/driver-moab/cime_config/buildlib_cmake new file mode 100755 index 000000000000..8120e2e0b4be --- /dev/null +++ b/driver-moab/cime_config/buildlib_cmake @@ -0,0 +1,46 @@ +#!/usr/bin/env python + +""" +build model executable +""" + +import sys, os + +_CIMEROOT = os.path.join(os.path.dirname(os.path.abspath(__file__)), "..","..","..","..") +sys.path.append(os.path.join(_CIMEROOT, "scripts", "Tools")) + +from standard_script_setup import * +from CIME.buildlib import parse_input +from CIME.case import Case +from CIME.utils import expect + +logger = logging.getLogger(__name__) + +############################################################################### +def buildlib(bldroot, installpath, case): # pylint: disable=unused-argument +############################################################################### + casebuild = case.get_value("CASEBUILD") + caseroot = case.get_value("CASEROOT") + cimeroot = case.get_value("CIMEROOT") + num_esp = case.get_value("NUM_COMP_INST_ESP") + + expect((num_esp is None) or (int(num_esp) == 1), "ESP component restricted to one instance") + + with open(os.path.join(casebuild, "cplconf", "Filepath"), "w") as out: + out.write(os.path.join(caseroot, "SourceMods", "src.drv") + "\n") + out.write(os.path.join(cimeroot, "src", "drivers", "moab", "main") + "\n") + + with open(os.path.join(casebuild, "cplconf", "CCSM_cppdefs"), "w") as out: + out.write("") + +############################################################################### +def _main_func(): +############################################################################### + caseroot, libroot, bldroot = parse_input(sys.argv) + with Case(caseroot, read_only=False) as case: + buildlib(bldroot, libroot, case) + +############################################################################### + +if __name__ == "__main__": + _main_func() diff --git a/driver-moab/main/cime_comp_mod.F90 b/driver-moab/main/cime_comp_mod.F90 index 291e78b6958f..ab8e893f6b6a 100644 --- a/driver-moab/main/cime_comp_mod.F90 +++ b/driver-moab/main/cime_comp_mod.F90 @@ -37,6 +37,7 @@ module cime_comp_mod use shr_orb_mod, only: shr_orb_params use shr_frz_mod, only: shr_frz_freezetemp_init use shr_reprosum_mod, only: shr_reprosum_setopts + use shr_taskmap_mod, only: shr_taskmap_write use mct_mod ! mct_ wrappers for mct lib use perf_mod use ESMF @@ -53,21 +54,24 @@ module cime_comp_mod use wav_comp_mct , only: wav_init=>wav_init_mct, wav_run=>wav_run_mct, wav_final=>wav_final_mct use rof_comp_mct , only: rof_init=>rof_init_mct, rof_run=>rof_run_mct, rof_final=>rof_final_mct use esp_comp_mct , only: esp_init=>esp_init_mct, esp_run=>esp_run_mct, esp_final=>esp_final_mct + use iac_comp_mct , only: iac_init=>iac_init_mct, iac_run=>iac_run_mct, iac_final=>iac_final_mct !---------------------------------------------------------------------------- ! cpl7 modules !---------------------------------------------------------------------------- ! mpi comm data & routines, plus logunit and loglevel - use seq_comm_mct, only: CPLID, GLOID, logunit, loglevel + use seq_comm_mct, only: CPLID, GLOID, logunit, loglevel, info_taskmap_comp use seq_comm_mct, only: ATMID, LNDID, OCNID, ICEID, GLCID, ROFID, WAVID, ESPID use seq_comm_mct, only: ALLATMID,ALLLNDID,ALLOCNID,ALLICEID,ALLGLCID,ALLROFID,ALLWAVID,ALLESPID use seq_comm_mct, only: CPLALLATMID,CPLALLLNDID,CPLALLOCNID,CPLALLICEID use seq_comm_mct, only: CPLALLGLCID,CPLALLROFID,CPLALLWAVID,CPLALLESPID use seq_comm_mct, only: CPLATMID,CPLLNDID,CPLOCNID,CPLICEID,CPLGLCID,CPLROFID,CPLWAVID,CPLESPID + use seq_comm_mct, only: IACID, ALLIACID, CPLALLIACID, CPLIACID use seq_comm_mct, only: num_inst_atm, num_inst_lnd, num_inst_rof use seq_comm_mct, only: num_inst_ocn, num_inst_ice, num_inst_glc use seq_comm_mct, only: num_inst_wav, num_inst_esp + use seq_comm_mct, only: num_inst_iac use seq_comm_mct, only: num_inst_xao, num_inst_frc, num_inst_phys use seq_comm_mct, only: num_inst_total, num_inst_max use seq_comm_mct, only: seq_comm_iamin, seq_comm_name, seq_comm_namelen @@ -100,6 +104,7 @@ module cime_comp_mod use seq_timemgr_mod, only: seq_timemgr_alarm_rofrun use seq_timemgr_mod, only: seq_timemgr_alarm_wavrun use seq_timemgr_mod, only: seq_timemgr_alarm_esprun + use seq_timemgr_mod, only: seq_timemgr_alarm_iacrun use seq_timemgr_mod, only: seq_timemgr_alarm_barrier use seq_timemgr_mod, only: seq_timemgr_alarm_pause use seq_timemgr_mod, only: seq_timemgr_pause_active @@ -123,7 +128,7 @@ module cime_comp_mod ! flux calc routines use seq_flux_mct, only: seq_flux_init_mct, seq_flux_initexch_mct, seq_flux_ocnalb_mct - use seq_flux_mct, only: seq_flux_atmocn_mct, seq_flux_atmocnexch_mct + use seq_flux_mct, only: seq_flux_atmocn_mct, seq_flux_atmocnexch_mct, seq_flux_readnl_mct ! domain fraction routines use seq_frac_mct, only : seq_frac_init, seq_frac_set @@ -148,15 +153,18 @@ module cime_comp_mod use seq_flds_mod, only : seq_flds_w2x_fluxes, seq_flds_x2w_fluxes use seq_flds_mod, only : seq_flds_r2x_fluxes, seq_flds_x2r_fluxes use seq_flds_mod, only : seq_flds_set + use seq_flds_mod, only : seq_flds_z2x_fluxes, seq_flds_x2z_fluxes ! component type and accessor functions - use component_type_mod , only: component_get_iamin_compid, component_get_suffix - use component_type_mod , only: component_get_name, component_get_c2x_cx - use component_type_mod , only: atm, lnd, ice, ocn, rof, glc, wav, esp - use component_mod , only: component_init_pre - use component_mod , only: component_init_cc, component_init_cx, component_run, component_final - use component_mod , only: component_init_areacor, component_init_aream - use component_mod , only: component_exch, component_diag + use component_type_mod, only: component_get_iamin_compid, component_get_suffix + use component_type_mod, only: component_get_iamroot_compid + use component_type_mod, only: component_get_name, component_get_c2x_cx + use component_type_mod, only: atm, lnd, ice, ocn, rof, glc, wav, esp, iac + use component_mod, only: component_init_pre + use component_mod, only: component_init_cc, component_init_cx + use component_mod, only: component_run, component_final + use component_mod, only: component_init_areacor, component_init_aream + use component_mod, only: component_exch, component_diag ! prep routines (includes mapping routines between components and merging routines) use prep_lnd_mod @@ -167,6 +175,7 @@ module cime_comp_mod use prep_ocn_mod use prep_atm_mod use prep_aoflux_mod + use prep_iac_mod !--- mapping routines --- use seq_map_type_mod @@ -175,6 +184,9 @@ module cime_comp_mod ! --- timing routines --- use t_drv_timers_mod + ! --- control variables --- + use seq_flds_mod, only : rof_heat + #ifdef MOABDEBUGMCT ! --- expose grid with MOAB use component_type_mod , only: expose_mct_grid_moab @@ -184,8 +196,48 @@ module cime_comp_mod private - public cime_pre_init1, cime_pre_init2, cime_init, cime_run, cime_final - public timing_dir, mpicom_GLOID + ! public data + public :: timing_dir, mpicom_GLOID + + ! public routines + public :: cime_pre_init1 + public :: cime_pre_init2 + public :: cime_init + public :: cime_run + public :: cime_final + + ! private routines + private :: cime_esmf_readnl + private :: cime_printlogheader + private :: cime_comp_barriers + private :: cime_cpl_init + private :: cime_run_atmocn_fluxes + private :: cime_run_ocn_albedos + private :: cime_run_atm_setup_send + private :: cime_run_atm_recv_post + private :: cime_run_ocn_setup_send + private :: cime_run_ocn_recv_post + private :: cime_run_atmocn_setup + private :: cime_run_lnd_setup_send + private :: cime_run_lnd_recv_post + private :: cime_run_glc_setup_send + private :: cime_run_glc_accum_avg + private :: cime_run_glc_recv_post + private :: cime_run_rof_setup_send + private :: cime_run_rof_recv_post + private :: cime_run_ice_setup_send + private :: cime_run_ice_recv_post + private :: cime_run_wav_setup_send + private :: cime_run_wav_recv_post + private :: cime_run_iac_setup_send + private :: cime_run_iac_recv_post + private :: cime_run_update_fractions + private :: cime_run_calc_budgets1 + private :: cime_run_calc_budgets2 + private :: cime_run_calc_budgets3 + private :: cime_run_write_history + private :: cime_run_write_restart + private :: cime_write_performance_checkpoint #include @@ -203,7 +255,7 @@ module cime_comp_mod type(mct_aVect) , pointer :: o2x_ox => null() type(mct_aVect) , pointer :: a2x_ax => null() - character(len=CL) :: suffix + character(len=CL) :: inst_suffix logical :: iamin_id character(len=seq_comm_namelen) :: compname @@ -219,6 +271,7 @@ module cime_comp_mod type(mct_aVect) , pointer :: fractions_gx(:) ! Fractions on glc grid, cpl processes type(mct_aVect) , pointer :: fractions_rx(:) ! Fractions on rof grid, cpl processes type(mct_aVect) , pointer :: fractions_wx(:) ! Fractions on wav grid, cpl processes + type(mct_aVect) , pointer :: fractions_zx(:) ! Fractions on iac grid, cpl processes !--- domain equivalent 2d grid size --- integer :: atm_nx, atm_ny ! nx, ny of 2d grid, if known @@ -228,6 +281,7 @@ module cime_comp_mod integer :: rof_nx, rof_ny integer :: glc_nx, glc_ny integer :: wav_nx, wav_ny + integer :: iac_nx, iac_ny !---------------------------------------------------------------------------- ! Infodata: inter-model control flags, domain info @@ -249,6 +303,7 @@ module cime_comp_mod type (ESMF_Clock), target :: EClock_r ! rof clock type (ESMF_Clock), target :: EClock_w ! wav clock type (ESMF_Clock), target :: EClock_e ! esp clock + type (ESMF_Clock), target :: EClock_z ! iac clock logical :: restart_alarm ! restart alarm logical :: history_alarm ! history alarm @@ -264,6 +319,7 @@ module cime_comp_mod logical :: rofrun_alarm ! rof run alarm logical :: wavrun_alarm ! wav run alarm logical :: esprun_alarm ! esp run alarm + logical :: iacrun_alarm ! iac run alarm logical :: tprof_alarm ! timing profile alarm logical :: barrier_alarm ! barrier alarm logical :: t1hr_alarm ! alarm every hour @@ -274,6 +330,7 @@ module cime_comp_mod logical :: t24hr_alarm ! alarm every twentyfour hours logical :: t1yr_alarm ! alarm every year, at start of year logical :: pause_alarm ! pause alarm + logical :: write_hist_alarm ! alarm to write a history file under multiple conditions integer :: drv_index ! seq_timemgr index for driver real(r8) :: days_per_year = 365.0 ! days per year @@ -344,6 +401,7 @@ module cime_comp_mod logical :: flood_present ! .true. => rof is computing flood logical :: wav_present ! .true. => wav is present logical :: esp_present ! .true. => esp is present + logical :: iac_present ! .true. => iac is present logical :: atm_prognostic ! .true. => atm comp expects input logical :: lnd_prognostic ! .true. => lnd comp expects input @@ -355,8 +413,10 @@ module cime_comp_mod logical :: rof_prognostic ! .true. => rof comp expects input logical :: wav_prognostic ! .true. => wav comp expects input logical :: esp_prognostic ! .true. => esp comp expects input + logical :: iac_prognostic ! .true. => iac comp expects input logical :: atm_c2_lnd ! .true. => atm to lnd coupling on + logical :: atm_c2_rof ! .true. => atm to rof coupling on logical :: atm_c2_ocn ! .true. => atm to ocn coupling on logical :: atm_c2_ice ! .true. => atm to ice coupling on logical :: atm_c2_wav ! .true. => atm to wav coupling on @@ -365,6 +425,7 @@ module cime_comp_mod logical :: lnd_c2_glc ! .true. => lnd to glc coupling on logical :: ocn_c2_atm ! .true. => ocn to atm coupling on logical :: ocn_c2_ice ! .true. => ocn to ice coupling on + logical :: ocn_c2_glcshelf ! .true. => ocn to glc ice shelf coupling on logical :: ocn_c2_wav ! .true. => ocn to wav coupling on logical :: ice_c2_atm ! .true. => ice to atm coupling on logical :: ice_c2_ocn ! .true. => ice to ocn coupling on @@ -375,8 +436,14 @@ module cime_comp_mod logical :: glc_c2_lnd ! .true. => glc to lnd coupling on logical :: glc_c2_ocn ! .true. => glc to ocn coupling on logical :: glc_c2_ice ! .true. => glc to ice coupling on + logical :: glcshelf_c2_ocn ! .true. => glc ice shelf to ocn coupling on + logical :: glcshelf_c2_ice ! .true. => glc ice shelf to ice coupling on logical :: wav_c2_ocn ! .true. => wav to ocn coupling on + logical :: iac_c2_lnd ! .true. => iac to lnd coupling on + logical :: iac_c2_atm ! .true. => iac to atm coupling on + logical :: lnd_c2_iac ! .true. => lnd to iac coupling on + logical :: dead_comps ! .true. => dead components logical :: esmf_map_flag ! .true. => use esmf for mapping @@ -403,6 +470,7 @@ module cime_comp_mod character(CL) :: rof_gnam ! rof grid character(CL) :: glc_gnam ! glc grid character(CL) :: wav_gnam ! wav grid + character(CL) :: iac_gnam ! iac grid logical :: samegrid_ao ! samegrid atm and ocean logical :: samegrid_al ! samegrid atm and land @@ -415,6 +483,7 @@ module cime_comp_mod logical :: samegrid_og ! samegrid glc and ocean logical :: samegrid_ig ! samegrid glc and ice logical :: samegrid_alo ! samegrid atm, lnd, ocean + logical :: samegrid_zl ! samegrid iac and land logical :: read_restart ! local read restart flag character(CL) :: rest_file ! restart file path + filename @@ -473,7 +542,9 @@ module cime_comp_mod &Sa_co2diag:Sa_co2prog' ! --- other --- + character(len=cs) :: cime_model + integer :: driver_id ! ID for multi-driver setup integer :: ocnrun_count ! number of times ocn run alarm went on logical :: exists ! true if file exists integer :: ierr ! MPI error return @@ -501,6 +572,7 @@ module cime_comp_mod integer :: nthreads_ROFID ! OMP glc number of threads integer :: nthreads_WAVID ! OMP wav number of threads integer :: nthreads_ESPID ! OMP esp number of threads + integer :: nthreads_IACID ! OMP iac number of threads integer :: pethreads_GLOID ! OMP number of threads per task @@ -521,6 +593,7 @@ module cime_comp_mod integer :: mpicom_CPLALLGLCID ! MPI comm for CPLALLGLCID integer :: mpicom_CPLALLROFID ! MPI comm for CPLALLROFID integer :: mpicom_CPLALLWAVID ! MPI comm for CPLALLWAVID + integer :: mpicom_CPLALLIACID ! MPI comm for CPLALLIACID integer :: iam_GLOID ! pe number in global id logical :: iamin_CPLID ! pe associated with CPLID @@ -534,6 +607,7 @@ module cime_comp_mod logical :: iamin_CPLALLGLCID ! pe associated with CPLALLGLCID logical :: iamin_CPLALLROFID ! pe associated with CPLALLROFID logical :: iamin_CPLALLWAVID ! pe associated with CPLALLWAVID + logical :: iamin_CPLALLIACID ! pe associated with CPLALLIACID !---------------------------------------------------------------------------- @@ -556,6 +630,7 @@ module cime_comp_mod integer, parameter :: comp_num_rof = 6 integer, parameter :: comp_num_wav = 7 integer, parameter :: comp_num_esp = 8 + integer, parameter :: comp_num_iac = 9 !---------------------------------------------------------------------------- ! misc @@ -563,7 +638,7 @@ module cime_comp_mod integer, parameter :: ens1=1 ! use first instance of ensemble only integer, parameter :: fix1=1 ! temporary hard-coding to first ensemble, needs to be fixed - integer :: eai, eli, eoi, eii, egi, eri, ewi, eei, exi, efi ! component instance counters + integer :: eai, eli, eoi, eii, egi, eri, ewi, eei, exi, efi, ezi ! component instance counters !---------------------------------------------------------------------------- ! formats @@ -574,7 +649,7 @@ module cime_comp_mod character(*), parameter :: F01 = "('"//subname//" : ', A, 2i8, 3x, A )" character(*), parameter :: F0R = "('"//subname//" : ', A, 2g23.15 )" character(*), parameter :: FormatA = '(A,": =============== ", A44, " ===============")' - character(*), parameter :: FormatD = '(A,": =============== ", A20,I10.8,I8,8x, " ===============")' + character(*), parameter :: FormatD = '(A,": =============== ", A20,I10.8,I8,6x, " ===============")' character(*), parameter :: FormatR = '(A,": =============== ", A31,F12.3,1x, " ===============")' character(*), parameter :: FormatQ = '(A,": =============== ", A20,2F10.2,4x," ===============")' !=============================================================================== @@ -585,19 +660,24 @@ module cime_comp_mod !******************************************************************************* !=============================================================================== - subroutine cime_pre_init1() + subroutine cime_pre_init1(esmf_log_option) use shr_pio_mod, only : shr_pio_init1, shr_pio_init2 use seq_comm_mct, only: num_inst_driver !---------------------------------------------------------- !| Initialize MCT and MPI communicators and IO !---------------------------------------------------------- + character(CS), intent(out) :: esmf_log_option ! For esmf_logfile_kind + integer, dimension(num_inst_total) :: comp_id, comp_comm, comp_comm_iam logical :: comp_iamin(num_inst_total) character(len=seq_comm_namelen) :: comp_name(num_inst_total) integer :: it - integer :: driver_id integer :: driver_comm + integer :: npes_CPLID + logical :: verbose_taskmap_output + character(len=8) :: c_cpl_inst ! coupler instance number + character(len=8) :: c_cpl_npes ! number of pes in coupler call mpi_init(ierr) call shr_mpi_chkerr(ierr,subname//' mpi_init') @@ -636,12 +716,10 @@ subroutine cime_pre_init1() if (iamroot_GLOID) output_perf = .true. call seq_comm_getinfo(CPLID,mpicom=mpicom_CPLID,& - iamroot=iamroot_CPLID,nthreads=nthreads_CPLID,& - iam=comp_comm_iam(it)) + iamroot=iamroot_CPLID,npes=npes_CPLID, & + nthreads=nthreads_CPLID,iam=comp_comm_iam(it)) if (iamroot_CPLID) output_perf = .true. - if (iamin_CPLID) complist = trim(complist)//' cpl' - comp_id(it) = CPLID comp_comm(it) = mpicom_CPLID iamin_CPLID = seq_comm_iamin(CPLID) @@ -655,9 +733,6 @@ subroutine cime_pre_init1() comp_name(it) = seq_comm_name(comp_id(it)) call seq_comm_getinfo(ATMID(eai), mpicom=comp_comm(it), & nthreads=nthreads_ATMID, iam=comp_comm_iam(it)) - if (seq_comm_iamin(ATMID(eai))) then - complist = trim(complist)//' '//trim(seq_comm_name(ATMID(eai))) - endif if (seq_comm_iamroot(ATMID(eai))) output_perf = .true. enddo call seq_comm_getinfo(CPLALLATMID, mpicom=mpicom_CPLALLATMID) @@ -670,9 +745,6 @@ subroutine cime_pre_init1() comp_name(it) = seq_comm_name(comp_id(it)) call seq_comm_getinfo(LNDID(eli), mpicom=comp_comm(it), & nthreads=nthreads_LNDID, iam=comp_comm_iam(it)) - if (seq_comm_iamin(LNDID(eli))) then - complist = trim(complist)//' '//trim(seq_comm_name(LNDID(eli))) - endif if (seq_comm_iamroot(LNDID(eli))) output_perf = .true. enddo call seq_comm_getinfo(CPLALLLNDID, mpicom=mpicom_CPLALLLNDID) @@ -685,9 +757,6 @@ subroutine cime_pre_init1() comp_name(it) = seq_comm_name(comp_id(it)) call seq_comm_getinfo(OCNID(eoi), mpicom=comp_comm(it), & nthreads=nthreads_OCNID, iam=comp_comm_iam(it)) - if (seq_comm_iamin (OCNID(eoi))) then - complist = trim(complist)//' '//trim(seq_comm_name(OCNID(eoi))) - endif if (seq_comm_iamroot(OCNID(eoi))) output_perf = .true. enddo call seq_comm_getinfo(CPLALLOCNID, mpicom=mpicom_CPLALLOCNID) @@ -700,9 +769,6 @@ subroutine cime_pre_init1() comp_name(it) = seq_comm_name(comp_id(it)) call seq_comm_getinfo(ICEID(eii), mpicom=comp_comm(it), & nthreads=nthreads_ICEID, iam=comp_comm_iam(it)) - if (seq_comm_iamin (ICEID(eii))) then - complist = trim(complist)//' '//trim(seq_comm_name(ICEID(eii))) - endif if (seq_comm_iamroot(ICEID(eii))) output_perf = .true. enddo call seq_comm_getinfo(CPLALLICEID, mpicom=mpicom_CPLALLICEID) @@ -714,9 +780,6 @@ subroutine cime_pre_init1() comp_iamin(it) = seq_comm_iamin(comp_id(it)) comp_name(it) = seq_comm_name(comp_id(it)) call seq_comm_getinfo(GLCID(egi), mpicom=comp_comm(it), nthreads=nthreads_GLCID, iam=comp_comm_iam(it)) - if (seq_comm_iamin (GLCID(egi))) then - complist = trim(complist)//' '//trim(seq_comm_name(GLCID(egi))) - endif if (seq_comm_iamroot(GLCID(egi))) output_perf = .true. enddo call seq_comm_getinfo(CPLALLGLCID, mpicom=mpicom_CPLALLGLCID) @@ -729,9 +792,6 @@ subroutine cime_pre_init1() comp_name(it) = seq_comm_name(comp_id(it)) call seq_comm_getinfo(ROFID(eri), mpicom=comp_comm(it), & nthreads=nthreads_ROFID, iam=comp_comm_iam(it)) - if (seq_comm_iamin(ROFID(eri))) then - complist = trim(complist)//' '//trim( seq_comm_name(ROFID(eri))) - endif if (seq_comm_iamroot(ROFID(eri))) output_perf = .true. enddo call seq_comm_getinfo(CPLALLROFID, mpicom=mpicom_CPLALLROFID) @@ -744,24 +804,34 @@ subroutine cime_pre_init1() comp_name(it) = seq_comm_name(comp_id(it)) call seq_comm_getinfo(WAVID(ewi), mpicom=comp_comm(it), & nthreads=nthreads_WAVID, iam=comp_comm_iam(it)) - if (seq_comm_iamin(WAVID(ewi))) then - complist = trim(complist)//' '//trim(seq_comm_name(WAVID(ewi))) - endif if (seq_comm_iamroot(WAVID(ewi))) output_perf = .true. enddo call seq_comm_getinfo(CPLALLWAVID, mpicom=mpicom_CPLALLWAVID) iamin_CPLALLWAVID = seq_comm_iamin(CPLALLWAVID) - do eei = 1,num_inst_esp + ! IAC mods + do ezi = 1,num_inst_iac + it=it+1 + comp_id(it) = IACID(ezi) + comp_iamin(it) = seq_comm_iamin(comp_id(it)) + comp_name(it) = seq_comm_name(comp_id(it)) + call seq_comm_getinfo(IACID(ezi), mpicom=comp_comm(it), & + nthreads=nthreads_IACID, iam=comp_comm_iam(it)) + if (seq_comm_iamin(IACID(ezi))) then + complist = trim(complist)//' '//trim(seq_comm_name(IACID(ezi))) + endif + if (seq_comm_iamroot(IACID(ezi))) output_perf = .true. + enddo + call seq_comm_getinfo(CPLALLIACID, mpicom=mpicom_CPLALLIACID) + iamin_CPLALLIACID = seq_comm_iamin(CPLALLIACID) + + do eei = 1,num_inst_esp it=it+1 comp_id(it) = ESPID(eei) comp_iamin(it) = seq_comm_iamin(comp_id(it)) comp_name(it) = seq_comm_name(comp_id(it)) call seq_comm_getinfo(ESPID(eei), mpicom=comp_comm(it), & nthreads=nthreads_ESPID, iam=comp_comm_iam(it)) - if (seq_comm_iamin (ESPID(eei))) then - complist = trim(complist)//' '//trim(seq_comm_name(ESPID(eei))) - endif enddo ! ESP components do not use the coupler (they are 'external') @@ -783,6 +853,42 @@ subroutine cime_pre_init1() call shr_file_setLogLevel(loglevel) endif + !---------------------------------------------------------- + !| Output task-to-node mapping data for coupler + !---------------------------------------------------------- + + if (info_taskmap_comp > 0) then + ! Identify SMP nodes and process/SMP mapping for the coupler. + ! (Assume that processor names are SMP node names on SMP clusters.) + + if (iamin_CPLID) then + + if (info_taskmap_comp == 1) then + verbose_taskmap_output = .false. + else + verbose_taskmap_output = .true. + endif + + write(c_cpl_inst,'(i8)') num_inst_driver + + if (iamroot_CPLID) then + write(c_cpl_npes,'(i8)') npes_CPLID + write(logunit,'(3A)') trim(adjustl(c_cpl_npes)), & + ' pes participating in computation of CPL instance #', & + trim(adjustl(c_cpl_inst)) + call shr_sys_flush(logunit) + endif + + call t_startf("shr_taskmap_write") + call shr_taskmap_write(logunit, mpicom_CPLID, & + 'CPL #'//trim(adjustl(c_cpl_inst)), & + verbose=verbose_taskmap_output ) + call t_stopf("shr_taskmap_write") + + endif + + endif + !---------------------------------------------------------- ! Log info about the environment settings !---------------------------------------------------------- @@ -798,6 +904,11 @@ subroutine cime_pre_init1() write(logunit,'(2A,I0,A)') subname,' Driver is running with',num_inst_driver,'instances' endif + !---------------------------------------------------------- + ! Read ESMF namelist settings + !---------------------------------------------------------- + call cime_esmf_readnl(NLFileName, mpicom_GLOID, esmf_log_option) + ! ! When using io servers (pio_async_interface=.true.) the server tasks do not return from ! shr_pio_init2 @@ -806,6 +917,48 @@ subroutine cime_pre_init1() end subroutine cime_pre_init1 + !=============================================================================== + + subroutine cime_esmf_readnl(NLFileName, mpicom, esmf_logfile_kind) + use shr_file_mod, only: shr_file_getUnit, shr_file_freeUnit + + character(len=*), intent(in) :: NLFileName + integer, intent(in) :: mpicom + character(len=CS), intent(out) :: esmf_logfile_kind + + integer :: ierr ! I/O error code + integer :: unitn ! Namelist unit number to read + integer :: rank + character(len=*), parameter :: subname = '(esmf_readnl) ' + + namelist /esmf_inparm/ esmf_logfile_kind + + esmf_logfile_kind = 'ESMF_LOGKIND_NONE' + call mpi_comm_rank(mpicom, rank, ierr) + + !------------------------------------------------------------------------- + ! Read in namelist + !------------------------------------------------------------------------- + if (rank == 0) then + unitn = shr_file_getUnit() + write(logunit,"(A)") subname,' read esmf_inparm namelist from: '//trim(NLFileName) + open(unitn, file=trim(NLFileName), status='old') + ierr = 1 + do while( ierr /= 0 ) + read(unitn, nml=esmf_inparm, iostat=ierr) + if (ierr < 0) then + call shr_sys_abort( subname//':: namelist read returns an'// & + ' end of file or end of record condition' ) + end if + end do + close(unitn) + call shr_file_freeUnit(unitn) + end if + + call mpi_bcast(esmf_logfile_kind, CS, MPI_CHARACTER, 0, mpicom, ierr) + + end subroutine cime_esmf_readnl + !=============================================================================== !******************************************************************************* !=============================================================================== @@ -833,10 +986,11 @@ subroutine cime_pre_init2() !---------------------------------------------------------- !| Timer initialization (has to be after mpi init) !---------------------------------------------------------- + maxthreads = max(nthreads_GLOID,nthreads_CPLID,nthreads_ATMID, & nthreads_LNDID,nthreads_ICEID,nthreads_OCNID,nthreads_GLCID, & - nthreads_ROFID, nthreads_WAVID, nthreads_ESPID, pethreads_GLOID ) - + nthreads_ROFID, nthreads_WAVID, nthreads_ESPID, nthreads_IACID, & + pethreads_GLOID ) call t_initf(NLFileName, LogPrint=.true., mpicom=mpicom_GLOID, & MasterTask=iamroot_GLOID,MaxThreads=maxthreads) @@ -861,12 +1015,18 @@ subroutine cime_pre_init2() else call seq_infodata_init(infodata,nlfilename, GLOID, pioid) end if + call seq_infodata_GetData(infodata, cime_model=cime_model) + + !---------------------------------------------------------- + ! Read shr_flux namelist settings + !---------------------------------------------------------- + call seq_flux_readnl_mct(nlfilename, CPLID) !---------------------------------------------------------- ! Print Model heading and copyright message !---------------------------------------------------------- - if (iamroot_CPLID) call seq_cime_printlogheader() + if (iamroot_CPLID) call cime_printlogheader() !---------------------------------------------------------- !| Initialize coupled fields (depends on infodata) @@ -902,6 +1062,7 @@ subroutine cime_pre_init2() rof_present=rof_present , & wav_present=wav_present , & esp_present=esp_present , & + iac_present=iac_present , & single_column=single_column , & aqua_planet=aqua_planet , & cpl_seq_option=cpl_seq_option , & @@ -935,6 +1096,7 @@ subroutine cime_pre_init2() rof_gnam=rof_gnam , & glc_gnam=glc_gnam , & wav_gnam=wav_gnam , & + iac_gnam=iac_gnam , & tfreeze_option = tfreeze_option , & cpl_decomp=seq_mctext_decomp , & shr_map_dopole=shr_map_dopole , & @@ -943,7 +1105,7 @@ subroutine cime_pre_init2() reprosum_use_ddpdd=reprosum_use_ddpdd , & reprosum_allow_infnan=reprosum_allow_infnan, & reprosum_diffmax=reprosum_diffmax , & - reprosum_recompute=reprosum_recompute, & + reprosum_recompute=reprosum_recompute , & max_cplstep_time=max_cplstep_time) ! above - cpl_decomp is set to pass the cpl_decomp value to seq_mctext_decomp @@ -959,12 +1121,12 @@ subroutine cime_pre_init2() ! Check cpl_seq_option - if (trim(cpl_seq_option) /= 'CESM1_ORIG' .and. & - trim(cpl_seq_option) /= 'CESM1_ORIG_TIGHT' .and. & - trim(cpl_seq_option) /= 'CESM1_MOD' .and. & - trim(cpl_seq_option) /= 'CESM1_MOD_TIGHT' .and. & - trim(cpl_seq_option) /= 'RASM_OPTION1' .and. & - trim(cpl_seq_option) /= 'RASM_OPTION2' ) then + if (trim(cpl_seq_option) /= 'CESM1_MOD' .and. & + trim(cpl_seq_option) /= 'CESM1_MOD_TIGHT' .and. & + trim(cpl_seq_option) /= 'RASM_OPTION1' .and. & + trim(cpl_seq_option) /= 'RASM_OPTION2' .and. & + trim(cpl_seq_option) /= 'NUOPC' .and. & + trim(cpl_seq_option) /= 'NUOPC_TIGHT' ) then call shr_sys_abort(subname//' invalid cpl_seq_option = '//trim(cpl_seq_option)) endif @@ -1006,6 +1168,9 @@ subroutine cime_pre_init2() call seq_comm_setnthreads(nthreads_ESPID) if (iamroot_GLOID) write(logunit,'(2A,2I4)') subname,' nthreads_ESPID = ',& nthreads_ESPID,seq_comm_getnthreads() + call seq_comm_setnthreads(nthreads_IACID) + if (iamroot_GLOID) write(logunit,'(2A,2I4)') subname,' nthreads_IACID = ',& + nthreads_IACID,seq_comm_getnthreads() if (iamroot_GLOID) write(logunit,*) ' ' call seq_comm_setnthreads(nthreads_GLOID) @@ -1018,7 +1183,8 @@ subroutine cime_pre_init2() call seq_timemgr_clockInit(seq_SyncClock, nlfilename, & read_restart, rest_file, pioid, mpicom_gloid, & EClock_d, EClock_a, EClock_l, EClock_o, & - EClock_i, Eclock_g, Eclock_r, Eclock_w, Eclock_e) + EClock_i, Eclock_g, Eclock_r, Eclock_w, Eclock_e, & + EClock_z) if (iamroot_CPLID) then call seq_timemgr_clockPrint(seq_SyncClock) @@ -1038,7 +1204,7 @@ subroutine cime_pre_init2() ! Initialize freezing point calculation for all components !---------------------------------------------------------- - call shr_frz_freezetemp_init(tfreeze_option) + call shr_frz_freezetemp_init(tfreeze_option, iamroot_GLOID) if (trim(orb_mode) == trim(seq_infodata_orb_variable_year)) then call seq_timemgr_EClockGetData( EClock_d, curr_ymd=ymd) @@ -1096,6 +1262,7 @@ subroutine cime_pre_init2() ice_phase=1, & glc_phase=1, & wav_phase=1, & + iac_phase=1, & esp_phase=1) !---------------------------------------------------------- @@ -1140,9 +1307,6 @@ end subroutine cime_pre_init2 subroutine cime_init() - character(CL), allocatable :: comp_resume(:) - - 104 format( A, i10.8, i8) !----------------------------------------------------------------------------- @@ -1162,7 +1326,7 @@ subroutine cime_init() call t_startf('CPL:init_comps') if (iamroot_CPLID )then write(logunit,*) ' ' - write(logunit,F00) 'Initialize each component: atm, lnd, rof, ocn, ice, glc, wav, esp' + write(logunit,F00) 'Initialize each component: atm, lnd, rof, ocn, ice, glc, wav, esp, iac' call shr_sys_flush(logunit) endif @@ -1175,6 +1339,8 @@ subroutine cime_init() call component_init_pre(glc, GLCID, CPLGLCID, CPLALLGLCID, infodata, ntype='glc') call component_init_pre(wav, WAVID, CPLWAVID, CPLALLWAVID, infodata, ntype='wav') call component_init_pre(esp, ESPID, CPLESPID, CPLALLESPID, infodata, ntype='esp') + call component_init_pre(iac, IACID, CPLIACID, CPLALLIACID, infodata, ntype='iac') + call t_stopf('CPL:comp_init_pre_all') call t_startf('CPL:comp_init_cc_atm') @@ -1226,6 +1392,12 @@ subroutine cime_init() call t_adj_detailf(-2) call t_stopf('CPL:comp_init_cc_esp') + call t_startf('comp_init_cc_iac') + call t_adj_detailf(+2) + call component_init_cc(Eclock_z, iac, iac_init, infodata, NLFilename) + call t_adj_detailf(-2) + call t_stopf('comp_init_cc_iac') + call t_startf('CPL:comp_init_cx_all') call t_adj_detailf(+2) call component_init_cx(atm, infodata) @@ -1235,6 +1407,7 @@ subroutine cime_init() call component_init_cx(ice, infodata) call component_init_cx(glc, infodata) call component_init_cx(wav, infodata) + call component_init_cx(iac, infodata) call t_adj_detailf(-2) call t_stopf('CPL:comp_init_cx_all') @@ -1288,6 +1461,14 @@ subroutine cime_init() endif enddo + do ezi = 1,num_inst_iac + iamin_ID = component_get_iamin_compid(iac(ezi)) + if (iamin_ID) then + compname = component_get_name(iac(ezi)) + complist = trim(complist)//' '//trim(compname) + endif + enddo + do eei = 1,num_inst_esp iamin_ID = component_get_iamin_compid(esp(eei)) if (iamin_ID) then @@ -1300,6 +1481,7 @@ subroutine cime_init() call t_stopf('CPL:comp_list_all') call t_stopf('CPL:init_comps') + !---------------------------------------------------------- !| Determine coupling interactions based on present and prognostic flags !---------------------------------------------------------- @@ -1311,6 +1493,7 @@ subroutine cime_init() if (iamin_CPLALLGLCID) call seq_infodata_exchange(infodata,CPLALLGLCID,'cpl2glc_init') if (iamin_CPLALLROFID) call seq_infodata_exchange(infodata,CPLALLROFID,'cpl2rof_init') if (iamin_CPLALLWAVID) call seq_infodata_exchange(infodata,CPLALLWAVID,'cpl2wav_init') + if (iamin_CPLALLIACID) call seq_infodata_exchange(infodata,CPLALLIACID,'cpl2iac_init') if (iamroot_CPLID) then write(logunit,F00) 'Determine final settings for presence of surface components' @@ -1329,6 +1512,7 @@ subroutine cime_init() rof_present=rof_present, & rofice_present=rofice_present, & wav_present=wav_present, & + iac_present=iac_present, & esp_present=esp_present, & flood_present=flood_present, & atm_prognostic=atm_prognostic, & @@ -1337,9 +1521,11 @@ subroutine cime_init() iceberg_prognostic=iceberg_prognostic, & ocn_prognostic=ocn_prognostic, & ocnrof_prognostic=ocnrof_prognostic, & + ocn_c2_glcshelf=ocn_c2_glcshelf, & glc_prognostic=glc_prognostic, & rof_prognostic=rof_prognostic, & wav_prognostic=wav_prognostic, & + iac_prognostic=iac_prognostic, & esp_prognostic=esp_prognostic, & dead_comps=dead_comps, & esmf_map_flag=esmf_map_flag, & @@ -1350,6 +1536,7 @@ subroutine cime_init() glc_nx=glc_nx, glc_ny=glc_ny, & ocn_nx=ocn_nx, ocn_ny=ocn_ny, & wav_nx=wav_nx, wav_ny=wav_ny, & + iac_nx=iac_nx, iac_ny=iac_ny, & atm_aero=atm_aero ) ! derive samegrid flags @@ -1384,6 +1571,7 @@ subroutine cime_init() ! derive coupling connection flags atm_c2_lnd = .false. + atm_c2_rof = .false. atm_c2_ocn = .false. atm_c2_ice = .false. atm_c2_wav = .false. @@ -1402,10 +1590,16 @@ subroutine cime_init() glc_c2_lnd = .false. glc_c2_ocn = .false. glc_c2_ice = .false. + glcshelf_c2_ocn = .false. + glcshelf_c2_ice = .false. wav_c2_ocn = .false. + iac_c2_atm = .false. + iac_c2_lnd = .false. + lnd_c2_iac = .false. if (atm_present) then if (lnd_prognostic) atm_c2_lnd = .true. + if (rof_prognostic .and. rof_heat) atm_c2_rof = .true. if (ocn_prognostic) atm_c2_ocn = .true. if (ocn_present ) atm_c2_ocn = .true. ! needed for aoflux calc if aoflux=ocn if (ice_prognostic) atm_c2_ice = .true. @@ -1415,12 +1609,14 @@ subroutine cime_init() if (atm_prognostic) lnd_c2_atm = .true. if (rof_prognostic) lnd_c2_rof = .true. if (glc_prognostic) lnd_c2_glc = .true. + if (iac_prognostic) lnd_c2_iac = .true. endif if (ocn_present) then if (atm_prognostic) ocn_c2_atm = .true. if (atm_present ) ocn_c2_atm = .true. ! needed for aoflux calc if aoflux=atm if (ice_prognostic) ocn_c2_ice = .true. if (wav_prognostic) ocn_c2_wav = .true. + endif if (ice_present) then if (atm_prognostic) ice_c2_atm = .true. @@ -1435,11 +1631,21 @@ subroutine cime_init() if (glc_present) then if (glclnd_present .and. lnd_prognostic) glc_c2_lnd = .true. if (glcocn_present .and. ocn_prognostic) glc_c2_ocn = .true. + ! For now, glcshelf->ocn only activated if the ocean has activated ocn->glcshelf + if (ocn_c2_glcshelf .and. glcocn_present .and. ocn_prognostic) glcshelf_c2_ocn = .true. + ! For now, glacshelf->ice also controlled by ocean's ocn_c2_glcshelf flag + ! Note that ice also has to be prognostic for glcshelf_c2_ice to be true. + ! It is not expected that glc and ice would ever be run without ocn prognostic. + if (ocn_c2_glcshelf .and. glcice_present .and. ice_prognostic) glcshelf_c2_ice = .true. if (glcice_present .and. iceberg_prognostic) glc_c2_ice = .true. endif if (wav_present) then if (ocn_prognostic) wav_c2_ocn = .true. endif + if (iac_present) then + if (lnd_prognostic) iac_c2_lnd = .true. + if (atm_prognostic) iac_c2_atm = .true. + endif !---------------------------------------------------------- ! Set domain check and other flag @@ -1481,6 +1687,7 @@ subroutine cime_init() write(logunit,F0L)'rof/ice present = ',rofice_present write(logunit,F0L)'rof/flood present = ',flood_present write(logunit,F0L)'wav model present = ',wav_present + write(logunit,F0L)'iac model present = ',iac_present write(logunit,F0L)'esp model present = ',esp_present write(logunit,F0L)'atm model prognostic = ',atm_prognostic @@ -1492,9 +1699,11 @@ subroutine cime_init() write(logunit,F0L)'rof model prognostic = ',rof_prognostic write(logunit,F0L)'ocn rof prognostic = ',ocnrof_prognostic write(logunit,F0L)'wav model prognostic = ',wav_prognostic + write(logunit,F0L)'iac model prognostic = ',iac_prognostic write(logunit,F0L)'esp model prognostic = ',esp_prognostic write(logunit,F0L)'atm_c2_lnd = ',atm_c2_lnd + write(logunit,F0L)'atm_c2_rof = ',atm_c2_rof write(logunit,F0L)'atm_c2_ocn = ',atm_c2_ocn write(logunit,F0L)'atm_c2_ice = ',atm_c2_ice write(logunit,F0L)'atm_c2_wav = ',atm_c2_wav @@ -1503,6 +1712,7 @@ subroutine cime_init() write(logunit,F0L)'lnd_c2_glc = ',lnd_c2_glc write(logunit,F0L)'ocn_c2_atm = ',ocn_c2_atm write(logunit,F0L)'ocn_c2_ice = ',ocn_c2_ice + write(logunit,F0L)'ocn_c2_glcshelf = ',ocn_c2_glcshelf write(logunit,F0L)'ocn_c2_wav = ',ocn_c2_wav write(logunit,F0L)'ice_c2_atm = ',ice_c2_atm write(logunit,F0L)'ice_c2_ocn = ',ice_c2_ocn @@ -1513,7 +1723,11 @@ subroutine cime_init() write(logunit,F0L)'glc_c2_lnd = ',glc_c2_lnd write(logunit,F0L)'glc_c2_ocn = ',glc_c2_ocn write(logunit,F0L)'glc_c2_ice = ',glc_c2_ice + write(logunit,F0L)'glcshelf_c2_ocn = ',glcshelf_c2_ocn + write(logunit,F0L)'glcshelf_c2_ice = ',glcshelf_c2_ice write(logunit,F0L)'wav_c2_ocn = ',wav_c2_ocn + write(logunit,F0L)'iac_c2_lnd = ',iac_c2_lnd + write(logunit,F0L)'iac_c2_atm = ',iac_c2_atm write(logunit,F0L)'dead components = ',dead_comps write(logunit,F0L)'domain_check = ',domain_check @@ -1524,6 +1738,7 @@ subroutine cime_init() write(logunit,F01)'ocn_nx,ocn_ny = ',ocn_nx,ocn_ny,trim(ocn_gnam) write(logunit,F01)'glc_nx,glc_ny = ',glc_nx,glc_ny,trim(glc_gnam) write(logunit,F01)'wav_nx,wav_ny = ',wav_nx,wav_ny,trim(wav_gnam) + write(logunit,F01)'iac_nx,iac_ny = ',iac_nx,iac_ny,trim(iac_gnam) write(logunit,F0L)'samegrid_ao = ',samegrid_ao write(logunit,F0L)'samegrid_al = ',samegrid_al write(logunit,F0L)'samegrid_ro = ',samegrid_ro @@ -1568,6 +1783,9 @@ subroutine cime_init() if (esp_prognostic .and. .not.esp_present) then call shr_sys_abort(subname//' ERROR: if prognostic esp must also have esp present') endif + if (iac_prognostic .and. .not.iac_present) then + call shr_sys_abort(subname//' ERROR: if prognostic iac must also have iac present') + endif #ifndef CPL_BYPASS if ((ice_prognostic .or. ocn_prognostic .or. lnd_prognostic) .and. .not. atm_present) then call shr_sys_abort(subname//' ERROR: if prognostic surface model must also have atm present') @@ -1576,6 +1794,11 @@ subroutine cime_init() if ((glclnd_present .or. glcocn_present .or. glcice_present) .and. .not.glc_present) then call shr_sys_abort(subname//' ERROR: if glcxxx present must also have glc present') endif + if ((ocn_c2_glcshelf .and. .not. glcshelf_c2_ocn) .or. (glcshelf_c2_ocn .and. .not. ocn_c2_glcshelf)) then + ! Current logic will not allow this to be true, but future changes could make it so, which may be nonsensical + call shr_sys_abort(subname//' ERROR: if glc_c2_ocn must also have ocn_c2_glc and vice versa. '//& + 'Boundary layer fluxes calculated in coupler require input from both components.') + endif if (rofice_present .and. .not.rof_present) then call shr_sys_abort(subname//' ERROR: if rofice present must also have rof present') endif @@ -1612,6 +1835,8 @@ subroutine cime_init() call shr_sys_abort(subname//' ERROR: rof_prognostic but num_inst_rof not num_inst_max') if (wav_prognostic .and. num_inst_wav /= num_inst_max) & call shr_sys_abort(subname//' ERROR: wav_prognostic but num_inst_wav not num_inst_max') + if (iac_prognostic .and. num_inst_iac /= num_inst_max) & + call shr_sys_abort(subname//' ERROR: iac_prognostic but num_inst_iac not num_inst_max') !---------------------------------------------------------- !| Initialize attribute vectors for prep_c2C_init_avs routines and fractions @@ -1624,20 +1849,22 @@ subroutine cime_init() call t_adj_detailf(+2) if (drv_threading) call seq_comm_setnthreads(nthreads_CPLID) - call prep_atm_init(infodata, ocn_c2_atm, ice_c2_atm, lnd_c2_atm) + call prep_atm_init(infodata, ocn_c2_atm, ice_c2_atm, lnd_c2_atm, iac_c2_lnd) - call prep_lnd_init(infodata, atm_c2_lnd, rof_c2_lnd, glc_c2_lnd) + call prep_lnd_init(infodata, atm_c2_lnd, rof_c2_lnd, glc_c2_lnd, iac_c2_lnd) - call prep_ocn_init(infodata, atm_c2_ocn, atm_c2_ice, ice_c2_ocn, rof_c2_ocn, wav_c2_ocn, glc_c2_ocn) + call prep_ocn_init(infodata, atm_c2_ocn, atm_c2_ice, ice_c2_ocn, rof_c2_ocn, wav_c2_ocn, glc_c2_ocn, glcshelf_c2_ocn) - call prep_ice_init(infodata, ocn_c2_ice, glc_c2_ice, rof_c2_ice ) + call prep_ice_init(infodata, ocn_c2_ice, glc_c2_ice, glcshelf_c2_ice, rof_c2_ice ) - call prep_rof_init(infodata, lnd_c2_rof) + call prep_rof_init(infodata, lnd_c2_rof, atm_c2_rof) - call prep_glc_init(infodata, lnd_c2_glc) + call prep_glc_init(infodata, lnd_c2_glc, ocn_c2_glcshelf) call prep_wav_init(infodata, atm_c2_wav, ocn_c2_wav, ice_c2_wav) + call prep_iac_init(infodata, lnd_c2_iac) + if (drv_threading) call seq_comm_setnthreads(nthreads_GLOID) call t_adj_detailf(-2) call t_stopf('CPL:init_maps') @@ -1649,6 +1876,7 @@ subroutine cime_init() ! need to finish up the computation of the atm - land map ( point cloud) if (iamin_CPLALLATMID .and. atm_c2_lnd) call prep_atm_lnd_moab(infodata) + !---------------------------------------------------------- !| Update aream in domains where appropriate !---------------------------------------------------------- @@ -1713,6 +1941,10 @@ subroutine cime_init() #endif if (single_column) areafact_samegrid = .true. +#ifdef COMPARE_TO_NUOPC + areafact_samegrid = .true. +#endif + call t_startf ('CPL:init_areacor') call t_adj_detailf(+2) @@ -1737,6 +1969,9 @@ subroutine cime_init() call mpi_barrier(mpicom_GLOID,ierr) if (wav_present) call component_init_areacor(wav, areafact_samegrid, seq_flds_w2x_fluxes) + call mpi_barrier(mpicom_GLOID,ierr) + if (iac_present) call component_init_areacor(iac, areafact_samegrid, seq_flds_z2x_fluxes) + call t_adj_detailf(-2) call t_stopf ('CPL:init_areacor') @@ -1777,6 +2012,10 @@ subroutine cime_init() call component_diag(infodata, wav, flow='c2x', comment='recv IC wav', & info_debug=info_debug) endif + if (iac_present) then + call component_diag(infodata, iac, flow='c2x', comment='recv IC iac', & + info_debug=info_debug) + endif if (drv_threading) call seq_comm_setnthreads(nthreads_GLOID) call t_adj_detailf(-2) @@ -1798,6 +2037,7 @@ subroutine cime_init() allocate(fractions_gx(num_inst_frc)) allocate(fractions_rx(num_inst_frc)) allocate(fractions_wx(num_inst_frc)) + allocate(fractions_zx(num_inst_frc)) if (drv_threading) call seq_comm_setnthreads(nthreads_CPLID) do efi = 1,num_inst_frc @@ -1811,10 +2051,10 @@ subroutine cime_init() call seq_frac_init(infodata, & atm(ens1), ice(ens1), lnd(ens1), & ocn(ens1), glc(ens1), rof(ens1), & - wav(ens1), & + wav(ens1), iac(ens1), & fractions_ax(efi), fractions_ix(efi), fractions_lx(efi), & fractions_ox(efi), fractions_gx(efi), fractions_rx(efi), & - fractions_wx(efi)) + fractions_wx(efi), fractions_zx(efi)) if (iamroot_CPLID) then write(logunit,*) ' ' @@ -1947,7 +2187,8 @@ subroutine cime_init() ! Data or dead atmosphere may just return on this phase. !---------------------------------------------------------- - if (atm_present) then + if (atm_prognostic) then + call t_startf('CPL:comp_init_cc_atm2') call t_adj_detailf(+2) @@ -2004,9 +2245,9 @@ subroutine cime_init() call seq_diag_zero_mct(mode='all') if (read_restart .and. iamin_CPLID) then call seq_rest_read(rest_file, infodata, & - atm, lnd, ice, ocn, rof, glc, wav, esp, & + atm, lnd, ice, ocn, rof, glc, wav, esp, iac, & fractions_ax, fractions_lx, fractions_ix, fractions_ox, & - fractions_rx, fractions_gx, fractions_wx) + fractions_rx, fractions_gx, fractions_wx, fractions_zx) endif call t_adj_detailf(-2) @@ -2023,12 +2264,22 @@ subroutine cime_init() if (glc_c2_ocn) then call prep_ocn_calc_g2x_ox(timer='CPL:init_glc2ocn') endif + + if (glcshelf_c2_ocn) then + call prep_ocn_shelf_calc_g2x_ox(timer='CPL:init_glc2ocn_shelf') + endif + if (rof_c2_ice) then call prep_ice_calc_r2x_ix(timer='CPL:init_rof2ice') endif if (glc_c2_ice) then call prep_ice_calc_g2x_ix(timer='CPL:init_glc2ice') endif + + if (glcshelf_c2_ice) then + call prep_ice_shelf_calc_g2x_ix(timer='CPL:init_glc2ice_shelf') + endif + if (rof_c2_lnd) then call prep_lnd_calc_r2x_lx(timer='CPL:init_rof2lnd') endif @@ -2037,22 +2288,6 @@ subroutine cime_init() endif endif - !---------------------------------------------------------- - !| Clear all resume signals - !---------------------------------------------------------- - allocate(comp_resume(num_inst_max)) - comp_resume = '' - call seq_infodata_putData(infodata, & - atm_resume=comp_resume(1:num_inst_atm), & - lnd_resume=comp_resume(1:num_inst_lnd), & - ocn_resume=comp_resume(1:num_inst_ocn), & - ice_resume=comp_resume(1:num_inst_ice), & - glc_resume=comp_resume(1:num_inst_glc), & - rof_resume=comp_resume(1:num_inst_rof), & - wav_resume=comp_resume(1:num_inst_wav), & - cpl_resume=comp_resume(1)) - deallocate(comp_resume) - !---------------------------------------------------------- !| Write histinit output file !---------------------------------------------------------- @@ -2068,10 +2303,12 @@ subroutine cime_init() write(logunit,104) ' Write history file at ',ymd,tod call shr_sys_flush(logunit) endif + + call seq_hist_write(infodata, EClock_d, & - atm, lnd, ice, ocn, rof, glc, wav, & + atm, lnd, ice, ocn, rof, glc, wav, iac, & fractions_ax, fractions_lx, fractions_ix, fractions_ox, & - fractions_rx, fractions_gx, fractions_wx, trim(cpl_inst_tag)) + fractions_rx, fractions_gx, fractions_wx, fractions_zx, trim(cpl_inst_tag)) if (drv_threading) call seq_comm_setnthreads(nthreads_GLOID) call t_adj_detailf(-2) @@ -2086,7 +2323,7 @@ subroutine cime_init() call shr_sys_flush(logunit) endif -#ifdef MOABDEBUGMCT + #ifdef MOABDEBUGMCT if (iamroot_CPLID )then write(logunit,*) ' ' write(logunit,F00) ' start output mct data with MOAB ' @@ -2124,21 +2361,26 @@ end subroutine cime_init !=============================================================================== subroutine cime_run() - use seq_comm_mct, only: atm_layout, lnd_layout, ice_layout, glc_layout, & - rof_layout, ocn_layout, wav_layout, esp_layout - use shr_string_mod, only: shr_string_listGetIndexF - use seq_comm_mct, only: num_inst_driver + use shr_string_mod, only: shr_string_listGetIndexF + use seq_comm_mct, only: atm_layout, lnd_layout, ice_layout + use seq_comm_mct, only: glc_layout, rof_layout, ocn_layout + use seq_comm_mct, only: wav_layout, esp_layout, iac_layout, num_inst_driver + use seq_comm_mct, only: seq_comm_inst + use seq_pauseresume_mod, only: seq_resume_store_comp, seq_resume_get_files + use seq_pauseresume_mod, only: seq_resume_free ! gptl timer lookup variables - integer, parameter :: hashcnt=7 - integer :: hashint(hashcnt) - ! Driver pause/resume - logical :: drv_pause ! Driver writes pause restart file - character(len=CL) :: drv_resume ! Driver resets state from restart file - - type(ESMF_Time) :: etime_curr ! Current model time - real(r8) :: tbnds1_offset ! Time offset for call to seq_hist_writeaux - logical :: lnd2glc_averaged_now ! Whether lnd2glc averages were taken this timestep + integer, parameter :: hashcnt=7 + integer :: hashint(hashcnt) + ! Driver pause/resume + logical :: drv_pause ! Driver writes pause restart file + character(len=CL) :: drv_resume ! Driver resets state from restart file + character(len=CL), pointer :: resume_files(:) ! Component resume files + + type(ESMF_Time) :: etime_curr ! Current model time + real(r8) :: tbnds1_offset ! Time offset for call to seq_hist_writeaux + logical :: lnd2glc_averaged_now ! Whether lnd2glc averages were taken this timestep + logical :: prep_glc_accum_avg_called ! Whether prep_glc_accum_avg has been called this timestep 101 format( A, i10.8, i8, 12A, A, F8.2, A, F8.2 ) 102 format( A, i10.8, i8, A, 8L3 ) @@ -2148,10 +2390,8 @@ subroutine cime_run() 108 format( A, f10.2, A, i8.8) 109 format( A, 2f10.3) - hashint = 0 - call seq_infodata_putData(infodata,atm_phase=1,lnd_phase=1,ocn_phase=1,ice_phase=1) call seq_timemgr_EClockGetData( EClock_d, stepno=begstep) call seq_timemgr_EClockGetData( EClock_d, dtime=dtime) @@ -2172,6 +2412,15 @@ subroutine cime_run() force_stop_ymd = -1 force_stop_tod = -1 + ! --- Write out performance data for initialization + call seq_timemgr_EClockGetData( EClock_d, curr_ymd=ymd, curr_tod=tod) + write(timing_file,'(a,i8.8,a1,i5.5)') & + trim(tchkpt_dir)//"/model_timing"//trim(cpl_inst_tag)//"_",ymd,"_",tod + + call t_set_prefixf("CPL:INIT_") + call cime_write_performance_checkpoint(output_perf,timing_file,mpicom_GLOID) + call t_unset_prefixf() + !|---------------------------------------------------------- !| Beginning of driver time step loop !|---------------------------------------------------------- @@ -2205,6 +2454,7 @@ subroutine cime_run() esprun_alarm = seq_timemgr_alarmIsOn(EClock_d,seq_timemgr_alarm_esprun) ocnrun_alarm = seq_timemgr_alarmIsOn(EClock_d,seq_timemgr_alarm_ocnrun) ocnnext_alarm = seq_timemgr_alarmIsOn(EClock_d,seq_timemgr_alarm_ocnnext) + iacrun_alarm = seq_timemgr_alarmIsOn(EClock_d,seq_timemgr_alarm_iacrun) restart_alarm = seq_timemgr_alarmIsOn(EClock_d,seq_timemgr_alarm_restart) history_alarm = seq_timemgr_alarmIsOn(EClock_d,seq_timemgr_alarm_history) histavg_alarm = seq_timemgr_alarmIsOn(EClock_d,seq_timemgr_alarm_histavg) @@ -2215,16 +2465,19 @@ subroutine cime_run() ! Does the driver need to pause? drv_pause = pause_alarm .and. seq_timemgr_pause_component_active(drv_index) - if (glc_prognostic) then + if (glc_prognostic .or. do_hist_l2x1yrg) then ! Is it time to average fields to pass to glc? ! ! Note that the glcrun_avg_alarm just controls what is passed to glc in terms ! of averaged fields - it does NOT control when glc is called currently - ! glc will be called on the glcrun_alarm setting - but it might not be passed relevant ! info if the time averaging period to accumulate information passed to glc is greater - ! than the glcrun interval + ! than the glcrun interval. + ! + ! Note also that we need to set glcrun_avg_alarm even if glc_prognostic is + ! false, if do_hist_l2x1yrg is set, so that we have valid cpl hist fields glcrun_avg_alarm = seq_timemgr_alarmIsOn(EClock_d,seq_timemgr_alarm_glcrun_avg) - if (glcrun_avg_alarm .and. .not. glcrun_alarm) then + if (glc_prognostic .and. glcrun_avg_alarm .and. .not. glcrun_alarm) then write(logunit,*) 'ERROR: glcrun_avg_alarm is true, but glcrun_alarm is false' write(logunit,*) 'Make sure that NCPL_BASE_PERIOD, GLC_NCPL and GLC_AVG_PERIOD' write(logunit,*) 'are set so that glc averaging only happens at glc coupling times.' @@ -2254,6 +2507,7 @@ subroutine cime_run() if (month==1 .and. day==1 .and. tod==0) t1yr_alarm = .true. lnd2glc_averaged_now = .false. + prep_glc_accum_avg_called = .false. if (seq_timemgr_alarmIsOn(EClock_d,seq_timemgr_alarm_datestop)) then if (iamroot_CPLID) then @@ -2293,7 +2547,7 @@ subroutine cime_run() write(logunit,102) ' Alarm_state: model date = ',ymd,tod, & ' aliogrw run alarms = ', atmrun_alarm, lndrun_alarm, & icerun_alarm, ocnrun_alarm, glcrun_alarm, & - rofrun_alarm, wavrun_alarm, esprun_alarm + rofrun_alarm, wavrun_alarm, esprun_alarm, iacrun_alarm write(logunit,102) ' Alarm_state: model date = ',ymd,tod, & ' 1.2.3.6.12.24 run alarms = ', t1hr_alarm, t2hr_alarm, & t3hr_alarm, t6hr_alarm, t12hr_alarm, t24hr_alarm @@ -2303,13 +2557,19 @@ subroutine cime_run() call t_stopf ('CPL:CLOCK_ADVANCE') + !---------------------------------------------------------- + !| IAC SETUP-SEND + !---------------------------------------------------------- + if (iac_present .and. iacrun_alarm) then + call cime_run_iac_setup_send() + endif + !---------------------------------------------------------- !| MAP ATM to OCN ! Set a2x_ox as a module variable in prep_ocn_mod ! This will be used later in the ice prep and in the ! atm/ocn flux calculation !---------------------------------------------------------- - if (iamin_CPLID .and. (atm_c2_ocn .or. atm_c2_ice)) then call cime_comp_barriers(mpicom=mpicom_CPLID, timer='CPL:OCNPRE1_BARRIER') call t_drvstartf ('CPL:OCNPRE1',cplrun=.true.,barrier=mpicom_CPLID,hashint=hashint(3)) @@ -2324,368 +2584,69 @@ subroutine cime_run() !---------------------------------------------------------- !| ATM/OCN SETUP (rasm_option1) !---------------------------------------------------------- - - if ((trim(cpl_seq_option) == 'RASM_OPTION1') .and. & - iamin_CPLID .and. ocn_present) then - - call cime_comp_barriers(mpicom=mpicom_CPLID, timer='CPL:ATMOCN1_BARRIER') - call t_drvstartf ('CPL:ATMOCN1',cplrun=.true.,barrier=mpicom_CPLID,hashint=hashint(4)) - if (drv_threading) call seq_comm_setnthreads(nthreads_CPLID) - - if (ocn_prognostic) then - ! Map ice to ocn - if (ice_c2_ocn) call prep_ocn_calc_i2x_ox(timer='CPL:atmocnp_ice2ocn') - - ! Map wav to ocn - if (wav_c2_ocn) call prep_ocn_calc_w2x_ox(timer='CPL:atmocnp_wav2ocn') - endif - - !---------------------------------------------------------- - !| atm/ocn flux on atm grid (rasm_option1 and aoflux='atm') - !---------------------------------------------------------- - - if (trim(aoflux_grid) == 'atm') then - ! compute o2x_ax for flux_atmocn, will be updated before atm merge - ! do not use fractions because fractions here are NOT consistent with fractions in atm_mrg - if (ocn_c2_atm) call prep_atm_calc_o2x_ax(timer='CPL:atmoca_ocn2atm') - - call t_drvstartf ('CPL:atmocna_fluxa',barrier=mpicom_CPLID) - do exi = 1,num_inst_xao - eai = mod((exi-1),num_inst_atm) + 1 - eoi = mod((exi-1),num_inst_ocn) + 1 - efi = mod((exi-1),num_inst_frc) + 1 - a2x_ax => component_get_c2x_cx(atm(eai)) - o2x_ax => prep_atm_get_o2x_ax() ! array over all instances - xao_ax => prep_aoflux_get_xao_ax() ! array over all instances - call seq_flux_atmocn_mct(infodata, tod, dtime, a2x_ax, o2x_ax(eoi), xao_ax(exi)) - enddo - call t_drvstopf ('CPL:atmocna_fluxa') - - if (atm_c2_ocn) call prep_aoflux_calc_xao_ox(timer='CPL:atmocna_atm2ocn') - endif ! aoflux_grid - - !---------------------------------------------------------- - !| atm/ocn flux on ocn grid (rasm_option1 and aoflux='ocn') - !---------------------------------------------------------- - - if (trim(aoflux_grid) == 'ocn') then - call t_drvstartf ('CPL:atmocnp_fluxo',barrier=mpicom_CPLID,hashint=hashint(6)) - do exi = 1,num_inst_xao - eai = mod((exi-1),num_inst_atm) + 1 - eoi = mod((exi-1),num_inst_ocn) + 1 - efi = mod((exi-1),num_inst_frc) + 1 - a2x_ox => prep_ocn_get_a2x_ox() - o2x_ox => component_get_c2x_cx(ocn(eoi)) - xao_ox => prep_aoflux_get_xao_ox() - call seq_flux_atmocn_mct(infodata, tod, dtime, a2x_ox(eai), o2x_ox, xao_ox(exi)) - enddo - call t_drvstopf ('CPL:atmocnp_fluxo',hashint=hashint(6)) - endif - - !---------------------------------------------------------- - !| ocn prep-merge (rasm_option1) - !---------------------------------------------------------- - - xao_ox => prep_aoflux_get_xao_ox() - call prep_ocn_mrg(infodata, fractions_ox, xao_ox=xao_ox, timer_mrg='CPL:atmocnp_mrgx2o') - - ! Accumulate ocn inputs - form partial sum of tavg ocn inputs (virtual "send" to ocn) - call prep_ocn_accum(timer='CPL:atmocnp_accum') - - !---------------------------------------------------------- - !| ocn albedos (rasm_option1) - ! (MUST BE AFTER prep_ocn_mrg for swnet to ocn to be computed properly - !---------------------------------------------------------- - - call t_drvstartf ('CPL:atmocnp_ocnalb', barrier=mpicom_CPLID,hashint=hashint(5)) - do exi = 1,num_inst_xao - efi = mod((exi-1),num_inst_frc) + 1 - eai = mod((exi-1),num_inst_atm) + 1 - xao_ox => prep_aoflux_get_xao_ox() ! array over all instances - a2x_ox => prep_ocn_get_a2x_ox() - call seq_flux_ocnalb_mct(infodata, ocn(1), a2x_ox(eai), fractions_ox(efi), xao_ox(exi)) - enddo - call t_drvstopf ('CPL:atmocnp_ocnalb',hashint=hashint(5)) - - !---------------------------------------------------------- - !| ocn budget (rasm_option1) - !---------------------------------------------------------- - - if (do_budgets) then - call cime_comp_barriers(mpicom=mpicom_CPLID, timer='CPL:BUDGET0_BARRIER') - call t_drvstartf ('CPL:BUDGET0',budget=.true.,barrier=mpicom_CPLID) - xao_ox => prep_aoflux_get_xao_ox() ! array over all instances - call seq_diag_ocn_mct(ocn(ens1), xao_ox(1), fractions_ox(ens1), infodata, & - do_o2x=.true., do_x2o=.true., do_xao=.true.) - call t_drvstopf ('CPL:BUDGET0',budget=.true.) - endif - - if (drv_threading) call seq_comm_setnthreads(nthreads_GLOID) - call t_drvstopf ('CPL:ATMOCN1',cplrun=.true.,hashint=hashint(4)) + ! The following maps to the ocean, computes atm/ocn fluxes, merges to the ocean, + ! accumulates ocn input and computes ocean albedos + if (ocn_present) then + if (trim(cpl_seq_option) == 'RASM_OPTION1') then + call cime_run_atmocn_setup(hashint) + end if endif !---------------------------------------------------------- - !| ATM/OCN SETUP-SEND (cesm1_orig, cesm1_orig_tight, cesm1_mod, cesm1_mod_tight, or rasm_option1) + !| OCN SETUP-SEND (cesm1_mod, cesm1_mod_tight, or rasm_option1) !---------------------------------------------------------- - - if ((trim(cpl_seq_option) == 'CESM1_ORIG' .or. & - trim(cpl_seq_option) == 'CESM1_ORIG_TIGHT' .or. & - trim(cpl_seq_option) == 'CESM1_MOD' .or. & - trim(cpl_seq_option) == 'CESM1_MOD_TIGHT' .or. & - trim(cpl_seq_option) == 'RASM_OPTION1' ) .and. & - ocn_present .and. ocnrun_alarm) then - - !---------------------------------------------------- - ! "startup" wait (cesm1_orig, cesm1_mod, or rasm_option1) - !---------------------------------------------------- - - if (iamin_CPLALLOCNID) then - ! want to know the time the ocean pes waited for the cpl pes - ! at the first ocnrun_alarm, min ocean wait is wait time - ! do not use t_barrierf here since it can be "off", use mpi_barrier - do eoi = 1,num_inst_ocn - if (ocn(eoi)%iamin_compid) call t_drvstartf ('CPL:C2O_INITWAIT') - enddo - call mpi_barrier(mpicom_CPLALLOCNID,ierr) - do eoi = 1,num_inst_ocn - if (ocn(eoi)%iamin_compid) call t_drvstopf ('CPL:C2O_INITWAIT') - enddo - cpl2ocn_first = .false. - endif - - !---------------------------------------------------- - !| ocn average (cesm1_orig, cesm1_orig_tight, cesm1_mod, cesm1_mod_tight, or rasm_option1) - !---------------------------------------------------- - - if (iamin_CPLID .and. ocn_prognostic) then - call cime_comp_barriers(mpicom=mpicom_CPLID, timer='CPL:OCNPREP_BARRIER') - call t_drvstartf ('CPL:OCNPREP',cplrun=.true.,barrier=mpicom_CPLID) - if (drv_threading) call seq_comm_setnthreads(nthreads_CPLID) - - ! finish accumulating ocean inputs - ! reset the value of x2o_ox with the value in x2oacc_ox - ! (module variable in prep_ocn_mod) - call prep_ocn_accum_avg(timer_accum='CPL:ocnprep_avg') - - call component_diag(infodata, ocn, flow='x2c', comment= 'send ocn', & - info_debug=info_debug, timer_diag='CPL:ocnprep_diagav') - - if (drv_threading) call seq_comm_setnthreads(nthreads_GLOID) - call t_drvstopf ('CPL:OCNPREP',cplrun=.true.) - endif - - !---------------------------------------------------- - !| cpl -> ocn (cesm1_orig, cesm1_orig_tight, cesm1_mod, cesm1_mod_tight, or rasm_option1) - !---------------------------------------------------- - - if (iamin_CPLALLOCNID .and. ocn_prognostic) then - call component_exch(ocn, flow='x2c', & - infodata=infodata, infodata_string='cpl2ocn_run', & - mpicom_barrier=mpicom_CPLALLOCNID, run_barriers=run_barriers, & - timer_barrier='CPL:C2O_BARRIER', timer_comp_exch='CPL:C2O', & - timer_map_exch='CPL:c2o_ocnx2ocno', timer_infodata_exch='CPL:c2o_infoexch') - endif - - endif ! end of OCN SETUP + if (ocn_present .and. ocnrun_alarm) then + if (trim(cpl_seq_option) == 'CESM1_MOD' .or. & + trim(cpl_seq_option) == 'CESM1_MOD_TIGHT' .or. & + trim(cpl_seq_option) == 'NUOPC_TIGHT' .or. & + trim(cpl_seq_option) == 'RASM_OPTION1') then + call cime_run_ocn_setup_send() + end if + endif !---------------------------------------------------------- !| LND SETUP-SEND !---------------------------------------------------------- - if (lnd_present .and. lndrun_alarm) then - - !---------------------------------------------------- - !| lnd prep-merge - !---------------------------------------------------- - - if (iamin_CPLID) then - call cime_comp_barriers(mpicom=mpicom_CPLID, timer='CPL:LNDPREP_BARRIER') - call t_drvstartf ('CPL:LNDPREP',cplrun=.true.,barrier=mpicom_CPLID) - if (drv_threading) call seq_comm_setnthreads(nthreads_CPLID) - - if (atm_c2_lnd) then - call prep_lnd_calc_a2x_lx(timer='CPL:lndprep_atm2lnd') - endif - - if (lnd_prognostic) then - call prep_lnd_mrg(infodata, timer_mrg='CPL:lndprep_mrgx2l') - - call component_diag(infodata, lnd, flow='x2c', comment= 'send lnd', & - info_debug=info_debug, timer_diag='CPL:lndprep_diagav') - endif - - if (drv_threading) call seq_comm_setnthreads(nthreads_GLOID) - call t_drvstopf ('CPL:LNDPREP',cplrun=.true.) - endif - - !---------------------------------------------------- - !| cpl -> lnd - !---------------------------------------------------- - - if (iamin_CPLALLLNDID) then - call component_exch(lnd, flow='x2c', & - infodata=infodata, infodata_string='cpl2lnd_run', & - mpicom_barrier=mpicom_CPLALLLNDID, run_barriers=run_barriers, & - timer_barrier='CPL:C2L_BARRIER', timer_comp_exch='CPL:C2L', & - timer_map_exch='CPL:c2l_lndx2lndl', timer_infodata_exch='CPL:c2l_infoexch') - endif - + call cime_run_lnd_setup_send() endif !---------------------------------------------------------- !| ICE SETUP-SEND - ! Note that for atm->ice mapping below will leverage the assumption that the - ! ice and ocn are on the same grid and that mapping of atm to ocean is - ! done already for use by atmocn flux and ice model prep !---------------------------------------------------------- - if (ice_present .and. icerun_alarm) then - - !---------------------------------------------------- - !| ice prep-merge - !---------------------------------------------------- - - if (iamin_CPLID .and. ice_prognostic) then - call cime_comp_barriers(mpicom=mpicom_CPLID, timer='CPL:ICEPREP_BARRIER') - - call t_drvstartf ('CPL:ICEPREP',cplrun=.true.,barrier=mpicom_CPLID) - if (drv_threading) call seq_comm_setnthreads(nthreads_CPLID) - - - if (ocn_c2_ice) then - call prep_ice_calc_o2x_ix(timer='CPL:iceprep_ocn2ice') - endif - - if (atm_c2_ice) then - ! This is special to avoid remapping atm to ocn - ! Note it is constrained that different prep modules cannot - ! use or call each other - a2x_ox => prep_ocn_get_a2x_ox() ! array - call prep_ice_calc_a2x_ix(a2x_ox, timer='CPL:iceprep_atm2ice') - endif - - call prep_ice_mrg(infodata, timer_mrg='CPL:iceprep_mrgx2i') - - call component_diag(infodata, ice, flow='x2c', comment= 'send ice', & - info_debug=info_debug, timer_diag='CPL:iceprep_diagav') - - if (drv_threading) call seq_comm_setnthreads(nthreads_GLOID) - call t_drvstopf ('CPL:ICEPREP',cplrun=.true.) - endif - - !---------------------------------------------------- - !| cpl -> ice - !---------------------------------------------------- - - if (iamin_CPLALLICEID .and. ice_prognostic) then - call component_exch(ice, flow='x2c', & - infodata=infodata, infodata_string='cpl2ice_run', & - mpicom_barrier=mpicom_CPLALLICEID, run_barriers=run_barriers, & - timer_barrier='CPL:C2I_BARRIER', timer_comp_exch='CPL:C2I', & - timer_map_exch='CPL:c2i_icex2icei', timer_infodata_exch='CPL:ice_infoexch') - endif - + call cime_run_ice_setup_send() endif !---------------------------------------------------------- !| WAV SETUP-SEND !---------------------------------------------------------- if (wav_present .and. wavrun_alarm) then - - !---------------------------------------------------------- - !| wav prep-merge - !---------------------------------------------------------- - - if (iamin_CPLID .and. wav_prognostic) then - call cime_comp_barriers(mpicom=mpicom_CPLID, timer='CPL:WAVPREP_BARRIER') - - call t_drvstartf ('CPL:WAVPREP',cplrun=.true.,barrier=mpicom_CPLID) - if (drv_threading) call seq_comm_setnthreads(nthreads_CPLID) - - if (atm_c2_wav) then - call prep_wav_calc_a2x_wx(timer='CPL:wavprep_atm2wav') - endif - - if (ocn_c2_wav) then - call prep_wav_calc_o2x_wx(timer='CPL:wavprep_ocn2wav') - endif - - if (ice_c2_wav) then - call prep_wav_calc_i2x_wx(timer='CPL:wavprep_ice2wav') - endif - - call prep_wav_mrg(infodata, fractions_wx, timer_mrg='CPL:wavprep_mrgx2w') - - call component_diag(infodata, wav, flow='x2c', comment= 'send wav', & - info_debug=info_debug, timer_diag='CPL:wavprep_diagav') - - if (drv_threading) call seq_comm_setnthreads(nthreads_GLOID) - call t_drvstopf ('CPL:WAVPREP',cplrun=.true.) - endif - - !---------------------------------------------------------- - !| cpl -> wav - !---------------------------------------------------------- - - if (iamin_CPLALLWAVID .and. wav_prognostic) then - call component_exch(wav, flow='x2c', & - infodata=infodata, infodata_string='cpl2wav_run', & - mpicom_barrier=mpicom_CPLALLWAVID, run_barriers=run_barriers, & - timer_barrier='CPL:C2W_BARRIER', timer_comp_exch='CPL:C2W', & - timer_map_exch='CPL:c2w_wavx2wavw', timer_infodata_exch='CPL:c2w_infoexch') - endif - + call cime_run_wav_setup_send() endif !---------------------------------------------------------- !| ROF SETUP-SEND !---------------------------------------------------------- - if (rof_present .and. rofrun_alarm) then + call cime_run_rof_setup_send() + endif - !---------------------------------------------------- - !| rof prep-merge - !---------------------------------------------------- - - if (iamin_CPLID .and. rof_prognostic) then - call cime_comp_barriers(mpicom=mpicom_CPLID, timer='CPL:ROFPREP_BARRIER') - - call t_drvstartf ('CPL:ROFPREP', cplrun=.true., barrier=mpicom_CPLID) - if (drv_threading) call seq_comm_setnthreads(nthreads_CPLID) - - call prep_rof_accum_avg(timer='CPL:rofprep_l2xavg') - - if (lnd_c2_rof) then - call prep_rof_calc_l2r_rx(fractions_lx, timer='CPL:rofprep_lnd2rof') - endif - - call prep_rof_mrg(infodata, fractions_rx, timer_mrg='CPL:rofprep_mrgx2r') - - call component_diag(infodata, rof, flow='x2c', comment= 'send rof', & - info_debug=info_debug, timer_diag='CPL:rofprep_diagav') - - if (drv_threading) call seq_comm_setnthreads(nthreads_GLOID) - call t_drvstopf ('CPL:ROFPREP',cplrun=.true.) - endif - - !---------------------------------------------------- - !| cpl -> rof - !---------------------------------------------------- - - if (iamin_CPLALLROFID .and. rof_prognostic) then - call component_exch(rof, flow='x2c', & - infodata=infodata, infodata_string='cpl2rof_run', & - mpicom_barrier=mpicom_CPLALLLNDID, run_barriers=run_barriers, & - timer_barrier='CPL:C2R_BARRIER', timer_comp_exch='CPL:C2R', & - timer_map_exch='CPL:c2r_rofx2rofr', timer_infodata_exch='CPL:c2r_infoexch') - endif - + !---------------------------------------------------------- + !| RUN IAC MODEL + !---------------------------------------------------------- + if (iac_present .and. iacrun_alarm) then + call component_run(Eclock_z, iac, iac_run, infodata, & + seq_flds_x2c_fluxes=seq_flds_x2z_fluxes, & + seq_flds_c2x_fluxes=seq_flds_z2x_fluxes, & + comp_prognostic=iac_prognostic, comp_num=comp_num_iac, & + timer_barrier= 'CPL:IAC_RUN_BARRIER', timer_comp_run='CPL:IAC_RUN', & + run_barriers=run_barriers, ymd=ymd, tod=tod,comp_layout=iac_layout) endif !---------------------------------------------------------- !| RUN ICE MODEL !---------------------------------------------------------- - if (ice_present .and. icerun_alarm) then call component_run(Eclock_i, ice, ice_run, infodata, & seq_flds_x2c_fluxes=seq_flds_x2i_fluxes, & @@ -2698,7 +2659,6 @@ subroutine cime_run() !---------------------------------------------------------- !| RUN LND MODEL !---------------------------------------------------------- - if (lnd_present .and. lndrun_alarm) then call component_run(Eclock_l, lnd, lnd_run, infodata, & seq_flds_x2c_fluxes=seq_flds_x2l_fluxes, & @@ -2711,7 +2671,6 @@ subroutine cime_run() !---------------------------------------------------------- !| RUN ROF MODEL !---------------------------------------------------------- - if (rof_present .and. rofrun_alarm) then call component_run(Eclock_r, rof, rof_run, infodata, & seq_flds_x2c_fluxes=seq_flds_x2r_fluxes, & @@ -2724,7 +2683,6 @@ subroutine cime_run() !---------------------------------------------------------- !| RUN WAV MODEL !---------------------------------------------------------- - if (wav_present .and. wavrun_alarm) then call component_run(Eclock_w, wav, wav_run, infodata, & seq_flds_x2c_fluxes=seq_flds_x2w_fluxes, & @@ -2735,343 +2693,82 @@ subroutine cime_run() endif !---------------------------------------------------------- - !| RUN OCN MODEL (cesm1_orig_tight or cesm1_mod_tight) + !| RUN OCN MODEL (cesm1_mod_tight, nuopc_tight) !---------------------------------------------------------- + if (ocn_present .and. ocnrun_alarm) then + if (trim(cpl_seq_option) == 'CESM1_MOD_TIGHT' .or. trim(cpl_seq_option) == 'NUOPC_TIGHT') then + call component_run(Eclock_o, ocn, ocn_run, infodata, & + seq_flds_x2c_fluxes=seq_flds_x2o_fluxes, & + seq_flds_c2x_fluxes=seq_flds_o2x_fluxes, & + comp_prognostic=ocn_prognostic, comp_num=comp_num_ocn, & + timer_barrier= 'CPL:OCNT_RUN_BARRIER', timer_comp_run='CPL:OCNT_RUN', & + run_barriers=run_barriers, ymd=ymd, tod=tod,comp_layout=ocn_layout) + endif + end if - if ((trim(cpl_seq_option) == 'CESM1_ORIG_TIGHT' .or. & - trim(cpl_seq_option) == 'CESM1_MOD_TIGHT' ) .and. & - ocn_present .and. ocnrun_alarm) then - call component_run(Eclock_o, ocn, ocn_run, infodata, & - seq_flds_x2c_fluxes=seq_flds_x2o_fluxes, & - seq_flds_c2x_fluxes=seq_flds_o2x_fluxes, & - comp_prognostic=ocn_prognostic, comp_num=comp_num_ocn, & - timer_barrier= 'CPL:OCNT_RUN_BARRIER', timer_comp_run='CPL:OCNT_RUN', & - run_barriers=run_barriers, ymd=ymd, tod=tod,comp_layout=ocn_layout) + !---------------------------------------------------------- + !| IAC RECV-POST + !---------------------------------------------------------- + if (iac_present .and. iacrun_alarm) then + call cime_run_iac_recv_post() endif !---------------------------------------------------------- - !| OCN RECV-POST (cesm1_orig_tight or cesm1_mod_tight) + !| OCN RECV-POST (cesm1_mod_tight, nuopc_tight) !---------------------------------------------------------- - - if ((trim(cpl_seq_option) == 'CESM1_ORIG_TIGHT' .or. & - trim(cpl_seq_option) == 'CESM1_MOD_TIGHT' ) .and. & - ocn_present .and. ocnnext_alarm) then - - !---------------------------------------------------------- - !| ocn -> cpl (cesm1_orig_tight or cesm1_mod_tight) - !---------------------------------------------------------- - - if (iamin_CPLALLOCNID) then - call component_exch(ocn, flow='c2x', & - infodata=infodata, infodata_string='ocn2cpl_run', & - mpicom_barrier=mpicom_CPLALLOCNID, run_barriers=run_barriers, & - timer_barrier='CPL:O2CT_BARRIER', timer_comp_exch='CPL:O2CT', & - timer_map_exch='CPL:o2c_ocno2ocnx', timer_infodata_exch='CPL:o2c_infoexch') - endif - - !---------------------------------------------------------- - !| ocn post (cesm1_orig_tight or cesm1_mod_tight) - !---------------------------------------------------------- - - if (iamin_CPLID) then - call cime_comp_barriers(mpicom=mpicom_CPLID, timer='CPL:OCNPOSTT_BARRIER') - call t_drvstartf ('CPL:OCNPOSTT',cplrun=.true.,barrier=mpicom_CPLID) - if (drv_threading) call seq_comm_setnthreads(nthreads_CPLID) - - call component_diag(infodata, ocn, flow='c2x', comment= 'recv ocn', & - info_debug=info_debug, timer_diag='CPL:ocnpost_diagav') - - if (drv_threading) call seq_comm_setnthreads(nthreads_GLOID) - call t_drvstopf ('CPL:OCNPOSTT',cplrun=.true.) + if (ocn_present .and. ocnnext_alarm) then + if (trim(cpl_seq_option) == 'CESM1_MOD_TIGHT' .or. trim(cpl_seq_option) == 'NUOPC_TIGHT') then + call cime_run_ocn_recv_post() endif + end if + !---------------------------------------------------------- + !| ATM/OCN SETUP (cesm1_mod or cesm1_mod_tight) + !---------------------------------------------------------- + ! The following maps to the ocean, computes atm/ocn fluxes, merges to the ocean, + ! accumulates ocn input and computes ocean albedos + if (ocn_present) then + if (trim(cpl_seq_option) == 'CESM1_MOD' .or. & + trim(cpl_seq_option) == 'CESM1_MOD_TIGHT' .or. & + trim(cpl_seq_option) == 'NUOPC' .or. & + trim(cpl_seq_option) == 'NUOPC_TIGHT' ) then + call cime_run_atmocn_setup(hashint) + end if endif !---------------------------------------------------------- - !| ATM/OCN SETUP (cesm1_orig, cesm1_orig_tight, cesm1_mod or cesm1_mod_tight) + !| LND RECV-POST !---------------------------------------------------------- - if ((trim(cpl_seq_option) == 'CESM1_ORIG' .or. & - trim(cpl_seq_option) == 'CESM1_ORIG_TIGHT' .or. & - trim(cpl_seq_option) == 'CESM1_MOD' .or. & - trim(cpl_seq_option) == 'CESM1_MOD_TIGHT' ) .and. & - iamin_CPLID .and. ocn_present) then - - call cime_comp_barriers(mpicom=mpicom_CPLID, timer='CPL:ATMOCNP_BARRIER') - call t_drvstartf ('CPL:ATMOCNP',cplrun=.true.,barrier=mpicom_CPLID,hashint=hashint(7)) - if (drv_threading) call seq_comm_setnthreads(nthreads_CPLID) - - !---------------------------------------------------------- - !| ocn prep-merge (cesm1_orig or cesm1_orig_tight) - !---------------------------------------------------------- - - if (ocn_prognostic) then - ! Map ice to ocn - if (ice_c2_ocn) call prep_ocn_calc_i2x_ox(timer='CPL:atmocnp_ice2ocn') - - ! Map wav to ocn - if (wav_c2_ocn) call prep_ocn_calc_w2x_ox(timer='CPL:atmocnp_wav2ocn') - - if (cpl_seq_option == 'CESM1_ORIG' .or. & - cpl_seq_option == 'CESM1_ORIG_TIGHT') then - xao_ox => prep_aoflux_get_xao_ox() - call prep_ocn_mrg(infodata, fractions_ox, xao_ox=xao_ox, timer_mrg='CPL:atmocnp_mrgx2o') - - ! Accumulate ocn inputs - form partial sum of tavg ocn inputs (virtual "send" to ocn) - call prep_ocn_accum(timer='CPL:atmocnp_accum') - endif - endif - - !---------------------------------------------------------- - !| atm/ocn flux on atm grid ((cesm1_orig, cesm1_orig_tight, cesm1_mod or cesm1_mod_tight) and aoflux='atm') - !---------------------------------------------------------- - - if (trim(aoflux_grid) == 'atm') then - ! compute o2x_ax for flux_atmocn, will be updated before atm merge - ! do not use fractions because fractions here are NOT consistent with fractions in atm_mrg - if (ocn_c2_atm) call prep_atm_calc_o2x_ax(timer='CPL:atmoca_ocn2atm') - - call t_drvstartf ('CPL:atmocna_fluxa',barrier=mpicom_CPLID) - do exi = 1,num_inst_xao - eai = mod((exi-1),num_inst_atm) + 1 - eoi = mod((exi-1),num_inst_ocn) + 1 - efi = mod((exi-1),num_inst_frc) + 1 - a2x_ax => component_get_c2x_cx(atm(eai)) - o2x_ax => prep_atm_get_o2x_ax() ! array over all instances - xao_ax => prep_aoflux_get_xao_ax() ! array over all instances - call seq_flux_atmocn_mct(infodata, tod, dtime, a2x_ax, o2x_ax(eoi), xao_ax(exi)) - enddo - call t_drvstopf ('CPL:atmocna_fluxa') - - if (atm_c2_ocn) call prep_aoflux_calc_xao_ox(timer='CPL:atmocna_atm2ocn') - endif ! aoflux_grid - - !---------------------------------------------------------- - !| atm/ocn flux on ocn grid ((cesm1_orig, cesm1_orig_tight, cesm1_mod or cesm1_mod_tight) and aoflux='ocn') - !---------------------------------------------------------- - - if (trim(aoflux_grid) == 'ocn') then - call t_drvstartf ('CPL:atmocnp_fluxo',barrier=mpicom_CPLID) - do exi = 1,num_inst_xao - eai = mod((exi-1),num_inst_atm) + 1 - eoi = mod((exi-1),num_inst_ocn) + 1 - efi = mod((exi-1),num_inst_frc) + 1 - a2x_ox => prep_ocn_get_a2x_ox() - o2x_ox => component_get_c2x_cx(ocn(eoi)) - xao_ox => prep_aoflux_get_xao_ox() - call seq_flux_atmocn_mct(infodata, tod, dtime, a2x_ox(eai), o2x_ox, xao_ox(exi)) - enddo - call t_drvstopf ('CPL:atmocnp_fluxo') - ! else if (trim(aoflux_grid) == 'atm') then - ! !--- compute later --- - ! - ! else if (trim(aoflux_grid) == 'exch') then - ! xao_ax => prep_aoflux_get_xao_ax() - ! xao_ox => prep_aoflux_get_xao_ox() - ! - ! call t_drvstartf ('CPL:atmocnp_fluxe',barrier=mpicom_CPLID) - ! call seq_flux_atmocnexch_mct( infodata, atm(eai), ocn(eoi), & - ! fractions_ax(efi), fractions_ox(efi), xao_ax(exi), xao_ox(exi) ) - ! call t_drvstopf ('CPL:atmocnp_fluxe') - endif ! aoflux_grid - - !---------------------------------------------------------- - !| ocn prep-merge (cesm1_mod or cesm1_mod_tight) - !---------------------------------------------------------- - - if (ocn_prognostic) then - if (cpl_seq_option == 'CESM1_MOD' .or. & - cpl_seq_option == 'CESM1_MOD_TIGHT') then - - xao_ox => prep_aoflux_get_xao_ox() - call prep_ocn_mrg(infodata, fractions_ox, xao_ox=xao_ox, timer_mrg='CPL:atmocnp_mrgx2o') - - ! Accumulate ocn inputs - form partial sum of tavg ocn inputs (virtual "send" to ocn) - call prep_ocn_accum(timer='CPL:atmocnp_accum') - endif - endif - - !---------------------------------------------------------- - !| ocn albedos (cesm1_orig, cesm1_orig_tight, cesm1_mod or cesm1_mod_tight) - ! (MUST BE AFTER prep_ocn_mrg for swnet to ocn to be computed properly - !---------------------------------------------------------- - - call t_drvstartf ('CPL:atmocnp_ocnalb', barrier=mpicom_CPLID) - do exi = 1,num_inst_xao - efi = mod((exi-1),num_inst_frc) + 1 - eai = mod((exi-1),num_inst_atm) + 1 - xao_ox => prep_aoflux_get_xao_ox() ! array over all instances - a2x_ox => prep_ocn_get_a2x_ox() - call seq_flux_ocnalb_mct(infodata, ocn(1), a2x_ox(eai), fractions_ox(efi), xao_ox(exi)) - enddo - call t_drvstopf ('CPL:atmocnp_ocnalb') - - !---------------------------------------------------------- - !| ocn budget (cesm1_orig, cesm1_orig_tight, cesm1_mod or cesm1_mod_tight) - !---------------------------------------------------------- - - if (do_budgets) then - call cime_comp_barriers(mpicom=mpicom_CPLID, timer='CPL:BUDGET0_BARRIER') - call t_drvstartf ('CPL:BUDGET0',budget=.true.,barrier=mpicom_CPLID) - xao_ox => prep_aoflux_get_xao_ox() ! array over all instances - call seq_diag_ocn_mct(ocn(ens1), xao_ox(1), fractions_ox(ens1), infodata, & - do_o2x=.true., do_x2o=.true., do_xao=.true.) - call t_drvstopf ('CPL:BUDGET0',budget=.true.) - endif - - if (drv_threading) call seq_comm_setnthreads(nthreads_GLOID) - call t_drvstopf ('CPL:ATMOCNP',cplrun=.true.,hashint=hashint(7)) - endif - - !---------------------------------------------------------- - !| LND RECV-POST - !---------------------------------------------------------- - - if (lnd_present .and. lndrun_alarm) then - - !---------------------------------------------------------- - !| lnd -> cpl - !---------------------------------------------------------- - - if (iamin_CPLALLLNDID) then - call component_exch(lnd, flow='c2x', infodata=infodata, infodata_string='lnd2cpl_run', & - mpicom_barrier=mpicom_CPLALLLNDID, run_barriers=run_barriers, & - timer_barrier='CPL:L2C_BARRIER', timer_comp_exch='CPL:L2C', & - timer_map_exch='CPL:l2c_lndl2lndx', timer_infodata_exch='lnd2cpl_run') - endif - - !---------------------------------------------------------- - !| lnd post - !---------------------------------------------------------- - - if (iamin_CPLID) then - call cime_comp_barriers(mpicom=mpicom_CPLID, timer='CPL:LNDPOST_BARRIER') - call t_drvstartf ('CPL:LNDPOST',cplrun=.true.,barrier=mpicom_CPLID) - if (drv_threading) call seq_comm_setnthreads(nthreads_CPLID) - - call component_diag(infodata, lnd, flow='c2x', comment='recv lnd', & - info_debug=info_debug, timer_diag='CPL:lndpost_diagav') - - ! Accumulate rof and glc inputs (module variables in prep_rof_mod and prep_glc_mod) - if (lnd_c2_rof) then - call prep_rof_accum(timer='CPL:lndpost_accl2r') - endif - if (lnd_c2_glc) then - call prep_glc_accum(timer='CPL:lndpost_accl2g' ) - endif - - if (drv_threading) call seq_comm_setnthreads(nthreads_GLOID) - call t_drvstopf ('CPL:LNDPOST',cplrun=.true.) - endif - endif + if (lnd_present .and. lndrun_alarm) then + call cime_run_lnd_recv_post() + endif !---------------------------------------------------------- !| GLC SETUP-SEND !---------------------------------------------------------- - if (glc_present .and. glcrun_alarm) then - - !---------------------------------------------------- - !| glc prep-merge - !---------------------------------------------------- - - if (iamin_CPLID .and. glc_prognostic) then - call cime_comp_barriers(mpicom=mpicom_CPLID, timer='CPL:GLCPREP_BARRIER') - call t_drvstartf ('CPL:GLCPREP',cplrun=.true.,barrier=mpicom_CPLID) - if (drv_threading) call seq_comm_setnthreads(nthreads_CPLID) - - if (lnd_c2_glc) then - ! NOTE - only create appropriate input to glc if the avg_alarm is on - if (glcrun_avg_alarm) then - call prep_glc_accum_avg(timer='CPL:glcprep_avg') - lnd2glc_averaged_now = .true. - - ! Note that l2x_gx is obtained from mapping the module variable l2gacc_lx - call prep_glc_calc_l2x_gx(fractions_lx, timer='CPL:glcprep_lnd2glc') - - call prep_glc_mrg(infodata, fractions_gx, timer_mrg='CPL:glcprep_mrgx2g') - - call component_diag(infodata, glc, flow='x2c', comment='send glc', & - info_debug=info_debug, timer_diag='CPL:glcprep_diagav') - - else - call prep_glc_zero_fields() - end if ! glcrun_avg_alarm - end if ! lnd_c2_glc - - if (drv_threading) call seq_comm_setnthreads(nthreads_GLOID) - call t_drvstopf ('CPL:GLCPREP',cplrun=.true.) - - end if ! iamin_CPLID .and. glc_prognostic - - ! Set the infodata field on all tasks (not just those with iamin_CPLID). - if (glc_prognostic) then - if (glcrun_avg_alarm) then - call seq_infodata_PutData(infodata, glc_valid_input=.true.) - else - call seq_infodata_PutData(infodata, glc_valid_input=.false.) - end if - end if - - !---------------------------------------------------- - !| cpl -> glc - !---------------------------------------------------- - - if (iamin_CPLALLGLCID .and. glc_prognostic) then - call component_exch(glc, flow='x2c', & - infodata=infodata, infodata_string='cpl2glc_run', & - mpicom_barrier=mpicom_CPLALLGLCID, run_barriers=run_barriers, & - timer_barrier='CPL:C2G_BARRIER', timer_comp_exch='CPL:C2G', & - timer_map_exch='CPL:c2g_glcx2glcg', timer_infodata_exch='CPL:c2g_infoexch') - endif - + call cime_run_glc_setup_send(lnd2glc_averaged_now, prep_glc_accum_avg_called) endif + ! ------------------------------------------------------------------------ + ! Also average lnd2glc fields if needed for requested l2x1yrg auxiliary history + ! files, even if running with a stub glc model. + ! ------------------------------------------------------------------------ + + if (do_hist_l2x1yrg .and. iamin_CPLID .and. glcrun_avg_alarm .and. & + .not. prep_glc_accum_avg_called) then + ! Checking .not. prep_glc_accum_avg_called ensures that we don't do this + ! averaging a second time if we already did it above (because we're running with + ! a prognostic glc model). + call cime_run_glc_accum_avg(lnd2glc_averaged_now, prep_glc_accum_avg_called) + end if + !---------------------------------------------------------- !| ROF RECV-POST !---------------------------------------------------------- - if (rof_present .and. rofrun_alarm) then - - !---------------------------------------------------------- - !| rof -> cpl - !---------------------------------------------------------- - - if (iamin_CPLALLROFID) then - call component_exch(rof, flow='c2x', & - infodata=infodata, infodata_string='rof2cpl_run', & - mpicom_barrier=mpicom_CPLALLROFID, run_barriers=run_barriers, & - timer_barrier='CPL:R2C_BARRIER', timer_comp_exch='CPL:R2C', & - timer_map_exch='CPL:r2c_rofr2rofx', timer_infodata_exch='CPL:r2c_infoexch') - endif - - !---------------------------------------------------------- - !| rof post - !---------------------------------------------------------- - - if (iamin_CPLID) then - call cime_comp_barriers(mpicom=mpicom_CPLID, timer='CPL:ROFPOST_BARRIER') - call t_drvstartf ('CPL:ROFPOST',cplrun=.true.,barrier=mpicom_CPLID) - if (drv_threading) call seq_comm_setnthreads(nthreads_CPLID) - - call component_diag(infodata, rof, flow='c2x', comment= 'recv rof', & - info_debug=info_debug, timer_diag='CPL:rofpost_diagav') - - if (rof_c2_lnd) then - call prep_lnd_calc_r2x_lx(timer='CPL:rofpost_rof2lnd') - endif - - if (rof_c2_ice) then - call prep_ice_calc_r2x_ix(timer='CPL:rofpost_rof2ice') - endif - - if (rof_c2_ocn) then - call prep_ocn_calc_r2x_ox(timer='CPL:rofpost_rof2ocn') - endif - - call t_drvstopf ('CPL:ROFPOST', cplrun=.true.) - endif + call cime_run_rof_recv_post() endif - if (rof_present) then if (iamin_CPLID) then call cime_comp_barriers(mpicom=mpicom_CPLID, timer='DRIVER_ROFPOST_BARRIER') @@ -3079,347 +2776,86 @@ subroutine cime_run() if (drv_threading) call seq_comm_setnthreads(nthreads_CPLID) if (do_hist_r2x) then call t_drvstartf ('driver_rofpost_histaux', barrier=mpicom_CPLID) + ! Write coupler's hr2x file at 24 hour marks, + ! and at the end of the run interval, even if that's not at a 24 hour mark. + write_hist_alarm = t24hr_alarm .or. stop_alarm do eri = 1,num_inst_rof - suffix = component_get_suffix(rof(eri)) + inst_suffix = component_get_suffix(rof(eri)) call seq_hist_writeaux(infodata, EClock_d, rof(eri), flow='c2x', & - aname='r2x'//trim(suffix), dname='domrb', & - nx=rof_nx, ny=rof_ny, nt=1, write_now=t24hr_alarm) + aname='r2x',dname='domrb',inst_suffix=trim(inst_suffix), & + nx=rof_nx, ny=rof_ny, nt=1, write_now=write_hist_alarm) enddo call t_drvstopf ('driver_rofpost_histaux') endif call t_drvstopf ('DRIVER_ROFPOST', cplrun=.true.) endif endif - !---------------------------------------------------------- !| Budget with old fractions !---------------------------------------------------------- - - ! WJS (2-17-11): I am just using the first instance for the budgets because we - ! don't expect budgets to be conserved for our case (I case). Also note that we - ! don't expect budgets to be conserved for the interactive ensemble use case either. - ! tcraig (aug 2012): put this after rof->cpl so the budget sees the new r2x_rx. - ! it will also use the current r2x_ox here which is the value from the last timestep - ! consistent with the ocean coupling - - if (iamin_CPLID .and. do_budgets) then - call cime_comp_barriers(mpicom=mpicom_CPLID, timer='CPL:BUDGET1_BARRIER') - call t_drvstartf ('CPL:BUDGET1',cplrun=.true.,budget=.true.,barrier=mpicom_CPLID) - if (lnd_present) then - call seq_diag_lnd_mct(lnd(ens1), fractions_lx(ens1), infodata, & - do_l2x=.true., do_x2l=.true.) - endif - if (rof_present) then - call seq_diag_rof_mct(rof(ens1), fractions_rx(ens1), infodata) - endif - if (ice_present) then - call seq_diag_ice_mct(ice(ens1), fractions_ix(ens1), infodata, & - do_x2i=.true.) - endif - call t_drvstopf ('CPL:BUDGET1',cplrun=.true.,budget=.true.) + if (do_budgets) then + call cime_run_calc_budgets1() endif - !---------------------------------------------------------- !| ICE RECV-POST !---------------------------------------------------------- - if (ice_present .and. icerun_alarm) then - - !---------------------------------------------------------- - !| ice -> cpl - !---------------------------------------------------------- - - if (iamin_CPLALLICEID) then - call component_exch(ice, flow='c2x', & - infodata=infodata, infodata_string='ice2cpl_run', & - mpicom_barrier=mpicom_CPLALLICEID, run_barriers=run_barriers, & - timer_barrier='CPL:I2C_BARRIER', timer_comp_exch='CPL:I2C', & - timer_map_exch='CPL:i2c_icei2icex', timer_infodata_exch='CPL:i2c_infoexch') - endif - - !---------------------------------------------------------- - !| ice post - !---------------------------------------------------------- - - if (iamin_CPLID) then - call cime_comp_barriers(mpicom=mpicom_CPLID, timer='CPL:ICEPOST_BARRIER') - call t_drvstartf ('CPL:ICEPOST',cplrun=.true.,barrier=mpicom_CPLID) - if (drv_threading) call seq_comm_setnthreads(nthreads_CPLID) - - call component_diag(infodata, ice, flow='c2x', comment= 'recv ice', & - info_debug=info_debug, timer_diag='CPL:icepost_diagav') - - if (drv_threading) call seq_comm_setnthreads(nthreads_GLOID) - call t_drvstopf ('CPL:ICEPOST',cplrun=.true.) - endif + call cime_run_ice_recv_post() endif !---------------------------------------------------------- !| Update fractions based on new ice fractions !---------------------------------------------------------- - - if (iamin_CPLID) then - call cime_comp_barriers(mpicom=mpicom_CPLID, timer='CPL:FRACSET_BARRIER') - call t_drvstartf ('CPL:FRACSET',cplrun=.true.,barrier=mpicom_CPLID) - if (drv_threading) call seq_comm_setnthreads(nthreads_CPLID) - call t_drvstartf ('CPL:fracset_fracset',barrier=mpicom_CPLID) - - do efi = 1,num_inst_frc - eii = mod((efi-1),num_inst_ice) + 1 - - call seq_frac_set(infodata, ice(eii), & - fractions_ax(efi), fractions_ix(efi), fractions_ox(efi)) - enddo - call t_drvstopf ('CPL:fracset_fracset') - - if (drv_threading) call seq_comm_setnthreads(nthreads_GLOID) - call t_drvstopf ('CPL:FRACSET',cplrun=.true.) - endif + call cime_run_update_fractions() !---------------------------------------------------------- !| ATM/OCN SETUP (rasm_option2) !---------------------------------------------------------- - - if ((trim(cpl_seq_option) == 'RASM_OPTION2') .and. & - iamin_CPLID .and. ocn_present) then - - call cime_comp_barriers(mpicom=mpicom_CPLID, timer='CPL:ATMOCN2_BARRIER') - call t_drvstartf ('CPL:ATMOCN2',cplrun=.true.,barrier=mpicom_CPLID) - if (drv_threading) call seq_comm_setnthreads(nthreads_CPLID) - - if (ocn_prognostic) then - ! Map ice to ocn - if (ice_c2_ocn) call prep_ocn_calc_i2x_ox(timer='CPL:atmocnp_ice2ocn') - - ! Map wav to ocn - if (wav_c2_ocn) call prep_ocn_calc_w2x_ox(timer='CPL:atmocnp_wav2ocn') - endif - - !---------------------------------------------------------- - !| atm/ocn flux on atm grid (rasm_option2 and aoflux_grid='atm') - !---------------------------------------------------------- - - if (trim(aoflux_grid) == 'atm') then - ! compute o2x_ax for flux_atmocn, will be updated before atm merge - ! can use fractions because fractions here are consistent with fractions in atm_mrg - if (ocn_c2_atm) call prep_atm_calc_o2x_ax(fractions_ox,timer='CPL:atmoca_ocn2atm') - - call t_drvstartf ('CPL:atmocna_fluxa',barrier=mpicom_CPLID) - do exi = 1,num_inst_xao - eai = mod((exi-1),num_inst_atm) + 1 - eoi = mod((exi-1),num_inst_ocn) + 1 - efi = mod((exi-1),num_inst_frc) + 1 - a2x_ax => component_get_c2x_cx(atm(eai)) - o2x_ax => prep_atm_get_o2x_ax() ! array over all instances - xao_ax => prep_aoflux_get_xao_ax() ! array over all instances - call seq_flux_atmocn_mct(infodata, tod, dtime, a2x_ax, o2x_ax(eoi), xao_ax(exi)) - enddo - call t_drvstopf ('CPL:atmocna_fluxa') - - if (atm_c2_ocn) call prep_aoflux_calc_xao_ox(timer='CPL:atmocna_atm2ocn') - endif ! aoflux_grid - - !---------------------------------------------------------- - !| atm/ocn flux on ocn grid (rasm_option2 and aoflux_grid='ocn') - !---------------------------------------------------------- - - if (trim(aoflux_grid) == 'ocn') then - call t_drvstartf ('CPL:atmocnp_fluxo',barrier=mpicom_CPLID) - do exi = 1,num_inst_xao - eai = mod((exi-1),num_inst_atm) + 1 - eoi = mod((exi-1),num_inst_ocn) + 1 - efi = mod((exi-1),num_inst_frc) + 1 - a2x_ox => prep_ocn_get_a2x_ox() - o2x_ox => component_get_c2x_cx(ocn(eoi)) - xao_ox => prep_aoflux_get_xao_ox() - call seq_flux_atmocn_mct(infodata, tod, dtime, a2x_ox(eai), o2x_ox, xao_ox(exi)) - enddo - call t_drvstopf ('CPL:atmocnp_fluxo') - endif ! aoflux_grid - - !---------------------------------------------------------- - !| ocn prep-merge (rasm_option2) - !---------------------------------------------------------- - - xao_ox => prep_aoflux_get_xao_ox() - call prep_ocn_mrg(infodata, fractions_ox, xao_ox=xao_ox, timer_mrg='CPL:atmocnp_mrgx2o') - - ! Accumulate ocn inputs - form partial sum of tavg ocn inputs (virtual "send" to ocn) - call prep_ocn_accum(timer='CPL:atmocnp_accum') - - !---------------------------------------------------------- - !| ocn albedos (rasm_option2) - ! (MUST BE AFTER prep_ocn_mrg for swnet to ocn to be computed properly - !---------------------------------------------------------- - - call t_drvstartf ('CPL:atmocnp_ocnalb', barrier=mpicom_CPLID) - do exi = 1,num_inst_xao - efi = mod((exi-1),num_inst_frc) + 1 - eai = mod((exi-1),num_inst_atm) + 1 - xao_ox => prep_aoflux_get_xao_ox() ! array over all instances - a2x_ox => prep_ocn_get_a2x_ox() - call seq_flux_ocnalb_mct(infodata, ocn(1), a2x_ox(eai), fractions_ox(efi), xao_ox(exi)) - enddo - call t_drvstopf ('CPL:atmocnp_ocnalb') - - !---------------------------------------------------------- - !| ocn budget (rasm_option2) - !---------------------------------------------------------- - - if (do_budgets) then - call cime_comp_barriers(mpicom=mpicom_CPLID, timer='CPL:BUDGET0_BARRIER') - call t_drvstartf ('CPL:BUDGET0',budget=.true.,barrier=mpicom_CPLID) - xao_ox => prep_aoflux_get_xao_ox() ! array over all instances - call seq_diag_ocn_mct(ocn(ens1), xao_ox(1), fractions_ox(ens1), infodata, & - do_o2x=.true., do_x2o=.true., do_xao=.true.) - call t_drvstopf ('CPL:BUDGET0',budget=.true.) - endif - - if (drv_threading) call seq_comm_setnthreads(nthreads_GLOID) - call t_drvstopf ('CPL:ATMOCN2',cplrun=.true.) + ! The following maps to the ocean, computes atm/ocn fluxes, merges to the ocean, + ! accumulates ocn input and computes ocean albedos + if (ocn_present) then + if (trim(cpl_seq_option) == 'RASM_OPTION2') then + call cime_run_atmocn_setup(hashint) + end if endif !---------------------------------------------------------- !| OCN SETUP-SEND (rasm_option2) !---------------------------------------------------------- - - if ((trim(cpl_seq_option) == 'RASM_OPTION2' ) .and. & - ocn_present .and. ocnrun_alarm) then - - !---------------------------------------------------- - ! "startup" wait (rasm_option2) - !---------------------------------------------------- - - if (iamin_CPLALLOCNID) then - ! want to know the time the ocean pes waited for the cpl pes - ! at the first ocnrun_alarm, min ocean wait is wait time - ! do not use t_barrierf here since it can be "off", use mpi_barrier - do eoi = 1,num_inst_ocn - if (ocn(eoi)%iamin_compid) call t_drvstartf ('CPL:C2O_INITWAIT') - enddo - call mpi_barrier(mpicom_CPLALLOCNID,ierr) - do eoi = 1,num_inst_ocn - if (ocn(eoi)%iamin_compid) call t_drvstopf ('CPL:C2O_INITWAIT') - enddo - cpl2ocn_first = .false. - endif - - !---------------------------------------------------- - !| ocn average (rasm_option2) - !---------------------------------------------------- - - if (iamin_CPLID .and. ocn_prognostic) then - call cime_comp_barriers(mpicom=mpicom_CPLID, timer='CPL:OCNPRE2_BARRIER') - call t_drvstartf ('CPL:OCNPRE2',cplrun=.true.,barrier=mpicom_CPLID) - if (drv_threading) call seq_comm_setnthreads(nthreads_CPLID) - - ! finish accumulating ocean inputs - ! reset the value of x2o_ox with the value in x2oacc_ox - ! (module variable in prep_ocn_mod) - call prep_ocn_accum_avg(timer_accum='CPL:ocnprep_avg') - - call component_diag(infodata, ocn, flow='x2c', comment= 'send ocn', & - info_debug=info_debug, timer_diag='CPL:ocnprep_diagav') - - if (drv_threading) call seq_comm_setnthreads(nthreads_GLOID) - call t_drvstopf ('CPL:OCNPRE2',cplrun=.true.) - endif - - !---------------------------------------------------- - !| cpl -> ocn (rasm_option2) - !---------------------------------------------------- - - if (iamin_CPLALLOCNID .and. ocn_prognostic) then - call component_exch(ocn, flow='x2c', & - infodata=infodata, infodata_string='cpl2ocn_run', & - mpicom_barrier=mpicom_CPLALLOCNID, run_barriers=run_barriers, & - timer_barrier='CPL:C2O2_BARRIER', timer_comp_exch='CPL:C2O2', & - timer_map_exch='CPL:c2o2_ocnx2ocno', timer_infodata_exch='CPL:c2o2_infoexch') - endif - + if (ocn_present .and. ocnrun_alarm) then + if (trim(cpl_seq_option) == 'RASM_OPTION2') then + call cime_run_ocn_setup_send() + end if endif !---------------------------------------------------------- !| ATM SETUP-SEND !---------------------------------------------------------- - if (atm_present .and. atmrun_alarm) then - - !---------------------------------------------------------- - !| atm prep-merge - !---------------------------------------------------------- - - if (iamin_CPLID .and. atm_prognostic) then - call cime_comp_barriers(mpicom=mpicom_CPLID, timer='CPL:ATMPREP_BARRIER') - call t_drvstartf ('CPL:ATMPREP',cplrun=.true.,barrier=mpicom_CPLID) - if (drv_threading) call seq_comm_setnthreads(nthreads_CPLID) - - if (ocn_c2_atm) then - if (trim(aoflux_grid) == 'ocn') then - ! map xao_ox states and fluxes to xao_ax if fluxes were computed on ocn grid - call prep_aoflux_calc_xao_ax(fractions_ox, flds='states_and_fluxes', & - timer='CPL:atmprep_xao2atm') - endif - - ! recompute o2x_ax now for the merge with fractions associated with merge - call prep_atm_calc_o2x_ax(fractions_ox, timer='CPL:atmprep_ocn2atm') - - ! map xao_ox albedos to the atm grid, these are always computed on the ocean grid - call prep_aoflux_calc_xao_ax(fractions_ox, flds='albedos', timer='CPL:atmprep_alb2atm') - endif - - if (ice_c2_atm) then - call prep_atm_calc_i2x_ax(fractions_ix, timer='CPL:atmprep_ice2atm') - endif - - if (lnd_c2_atm) then - call prep_atm_calc_l2x_ax(fractions_lx, timer='CPL:atmprep_lnd2atm') - endif - - if (associated(xao_ax)) then - call prep_atm_mrg(infodata, fractions_ax, xao_ax=xao_ax, timer_mrg='CPL:atmprep_mrgx2a') - endif - - call component_diag(infodata, atm, flow='x2c', comment= 'send atm', info_debug=info_debug, & - timer_diag='CPL:atmprep_diagav') - - call t_drvstopf ('CPL:ATMPREP',cplrun=.true.) - if (drv_threading) call seq_comm_setnthreads(nthreads_GLOID) - endif - - !---------------------------------------------------------- - !| cpl -> atm - !---------------------------------------------------------- - - if (iamin_CPLALLATMID .and. atm_prognostic) then - call component_exch(atm, flow='x2c', infodata=infodata, infodata_string='cpl2atm_run', & - mpicom_barrier=mpicom_CPLALLATMID, run_barriers=run_barriers, & - timer_barrier='CPL:C2A_BARRIER', timer_comp_exch='CPL:C2A', & - timer_map_exch='CPL:c2a_atmx2atmg', timer_infodata_exch='CPL:c2a_infoexch') - endif - + call cime_run_atm_setup_send() endif !---------------------------------------------------------- - !| RUN OCN MODEL (NOT cesm1_orig_tight or cesm1_mod_tight) + !| RUN OCN MODEL (NOT cesm1_mod_tight or nuopc_tight) !---------------------------------------------------------- - - if ((trim(cpl_seq_option) /= 'CESM1_ORIG_TIGHT' .and. & - trim(cpl_seq_option) /= 'CESM1_MOD_TIGHT' ) .and. & - ocn_present .and. ocnrun_alarm) then - call component_run(Eclock_o, ocn, ocn_run, infodata, & - seq_flds_x2c_fluxes=seq_flds_x2o_fluxes, & - seq_flds_c2x_fluxes=seq_flds_o2x_fluxes, & - comp_prognostic=ocn_prognostic, comp_num=comp_num_ocn, & - timer_barrier= 'CPL:OCN_RUN_BARRIER', timer_comp_run='CPL:OCN_RUN', & - run_barriers=run_barriers, ymd=ymd, tod=tod,comp_layout=ocn_layout) - endif + if (ocn_present .and. ocnrun_alarm) then + if (trim(cpl_seq_option) == 'CESM1_MOD' .or. & + trim(cpl_seq_option) == 'RASM_OPTION1' .or. & + trim(cpl_seq_option) == 'RASM_OPTION2' .or. & + trim(cpl_seq_option) == 'NUOPC') then + call component_run(Eclock_o, ocn, ocn_run, infodata, & + seq_flds_x2c_fluxes=seq_flds_x2o_fluxes, & + seq_flds_c2x_fluxes=seq_flds_o2x_fluxes, & + comp_prognostic=ocn_prognostic, comp_num=comp_num_ocn, & + timer_barrier= 'CPL:OCN_RUN_BARRIER', timer_comp_run='CPL:OCN_RUN', & + run_barriers=run_barriers, ymd=ymd, tod=tod,comp_layout=ocn_layout) + endif + end if !---------------------------------------------------------- !| RUN ATM MODEL !---------------------------------------------------------- - if (atm_present .and. atmrun_alarm) then call component_run(Eclock_a, atm, atm_run, infodata, & seq_flds_x2c_fluxes=seq_flds_x2a_fluxes, & @@ -3432,7 +2868,6 @@ subroutine cime_run() !---------------------------------------------------------- !| RUN GLC MODEL !---------------------------------------------------------- - if (glc_present .and. glcrun_alarm) then call component_run(Eclock_g, glc, glc_run, infodata, & seq_flds_x2c_fluxes=seq_flds_x2g_fluxes, & @@ -3445,225 +2880,53 @@ subroutine cime_run() !---------------------------------------------------------- !| WAV RECV-POST !---------------------------------------------------------- - if (wav_present .and. wavrun_alarm) then - - !---------------------------------------------------------- - !| wav -> cpl - !---------------------------------------------------------- - - if (iamin_CPLALLWAVID) then - call component_exch(wav, flow='c2x', infodata=infodata, infodata_string='wav2cpl_run', & - mpicom_barrier=mpicom_CPLALLWAVID, run_barriers=run_barriers, & - timer_barrier='CPL:W2C_BARRIER', timer_comp_exch='CPL:W2C', & - timer_map_exch='CPL:w2c_wavw2wavx', timer_infodata_exch='CPL:w2c_infoexch') - endif - - !---------------------------------------------------------- - !| wav post - !---------------------------------------------------------- - - if (iamin_CPLID) then - call cime_comp_barriers(mpicom=mpicom_CPLID, timer='CPL:WAVPOST_BARRIER') - call t_drvstartf ('CPL:WAVPOST',cplrun=.true.,barrier=mpicom_CPLID) - if (drv_threading) call seq_comm_setnthreads(nthreads_CPLID) - - call component_diag(infodata, wav, flow='c2x', comment= 'recv wav', & - info_debug=info_debug, timer_diag='CPL:wavpost_diagav') - - if (drv_threading) call seq_comm_setnthreads(nthreads_GLOID) - call t_drvstopf ('CPL:WAVPOST',cplrun=.true.) - endif + call cime_run_wav_recv_post() endif !---------------------------------------------------------- !| GLC RECV-POST !---------------------------------------------------------- - if (glc_present .and. glcrun_alarm) then - - !---------------------------------------------------------- - !| glc -> cpl - !---------------------------------------------------------- - - if (iamin_CPLALLGLCID) then - call component_exch(glc, flow='c2x', infodata=infodata, infodata_string='glc2cpl_run', & - mpicom_barrier=mpicom_CPLALLGLCID, run_barriers=run_barriers, & - timer_barrier='CPL:G2C_BARRIER', timer_comp_exch='CPL:G2C', & - timer_map_exch='CPL:g2c_glcg2glcx', timer_infodata_exch='CPL:g2c_infoexch') - endif - - !---------------------------------------------------------- - !| glc post - !---------------------------------------------------------- - - if (iamin_CPLID) then - call cime_comp_barriers(mpicom=mpicom_CPLID, timer='CPL:GLCPOST_BARRIER') - call t_drvstartf ('CPL:GLCPOST',cplrun=.true.,barrier=mpicom_CPLID) - if (drv_threading) call seq_comm_setnthreads(nthreads_CPLID) - - call component_diag(infodata, glc, flow='c2x', comment= 'recv glc', & - info_debug=info_debug, timer_diag='CPL:glcpost_diagav') - - if (glc_c2_lnd) then - call prep_lnd_calc_g2x_lx(timer='CPL:glcpost_glc2lnd') - endif - - if (glc_c2_ice) then - call prep_ice_calc_g2x_ix(timer='CPL:glcpost_glc2ice') - endif - - if (glc_c2_ocn) then - call prep_ocn_calc_g2x_ox(timer='CPL:glcpost_glc2ocn') - endif - - if (drv_threading) call seq_comm_setnthreads(nthreads_GLOID) - call t_drvstopf ('CPL:GLCPOST',cplrun=.true.) - endif + call cime_run_glc_recv_post() endif !---------------------------------------------------------- !| ATM RECV-POST !---------------------------------------------------------- - if (atm_present .and. atmrun_alarm) then - - !---------------------------------------------------------- - !| atm -> cpl - !---------------------------------------------------------- - - if (iamin_CPLALLATMID) then - call component_exch(atm, flow='c2x', infodata=infodata, infodata_string='atm2cpl_run', & - mpicom_barrier=mpicom_CPLALLATMID, run_barriers=run_barriers, & - timer_barrier='CPL:A2C_BARRIER', timer_comp_exch='CPL:A2C', & - timer_map_exch='CPL:a2c_atma2atmx', timer_infodata_exch='CPL:a2c_infoexch') - ! will migrate the tag from component pes to coupler pes, on atm mesh - call prep_atm_migrate_moab(infodata) - endif - - !---------------------------------------------------------- - !| atm post - !---------------------------------------------------------- - - if (iamin_CPLID) then - call cime_comp_barriers(mpicom=mpicom_CPLID, timer='CPL:ATMPOST_BARRIER') - call t_drvstartf ('CPL:ATMPOST',cplrun=.true.,barrier=mpicom_CPLID) - if (drv_threading) call seq_comm_setnthreads(nthreads_CPLID) - - call component_diag(infodata, atm, flow='c2x', comment= 'recv atm', & - info_debug=info_debug, timer_diag='CPL:atmpost_diagav') - - if (drv_threading) call seq_comm_setnthreads(nthreads_GLOID) - call t_drvstopf ('CPL:ATMPOST',cplrun=.true.) - endif + call cime_run_atm_recv_post endif - ! send projected data from atm to ocean mesh, after projection in coupler - if (iamin_CPLALLOCNID .and. ocn_c2_atm) then - ! migrate that tag from coupler pes to ocean pes - call prep_ocn_migrate_moab(infodata) + + !---------------------------------------------------------- + !| Budget with new fractions + !---------------------------------------------------------- + if (do_budgets) then + call cime_run_calc_budgets2() endif - ! send projected data from atm to land mesh, after projection in coupler - if (iamin_CPLALLLNDID .and. atm_c2_lnd) then - ! migrate that tag from coupler pes to ocean pes - call prep_lnd_migrate_moab(infodata) - endif + !---------------------------------------------------------- + !| OCN RECV-POST (NOT cesm1_mod_tight or nuopc_tight) + !---------------------------------------------------------- + if (ocn_present .and. ocnnext_alarm) then + if (trim(cpl_seq_option) == 'CESM1_MOD' .or. & + trim(cpl_seq_option) == 'RASM_OPTION1' .or. & + trim(cpl_seq_option) == 'RASM_OPTION2' .or. & + trim(cpl_seq_option) == 'NUOPC') then + call cime_run_ocn_recv_post() + end if + end if !---------------------------------------------------------- - !| Budget with new fractions + !| Write driver restart file !---------------------------------------------------------- - - if (iamin_CPLID .and. do_budgets) then - call cime_comp_barriers(mpicom=mpicom_CPLID, timer='CPL:BUDGET2_BARRIER') - - call t_drvstartf ('CPL:BUDGET2',cplrun=.true.,budget=.true.,barrier=mpicom_CPLID) - if (atm_present) then - call seq_diag_atm_mct(atm(ens1), fractions_ax(ens1), infodata, & - do_a2x=.true., do_x2a=.true.) - endif - if (ice_present) then - call seq_diag_ice_mct(ice(ens1), fractions_ix(ens1), infodata, & - do_i2x=.true.) - endif - call t_drvstopf ('CPL:BUDGET2',cplrun=.true.,budget=.true.) - - call t_drvstartf ('CPL:BUDGET3',cplrun=.true.,budget=.true.,barrier=mpicom_CPLID) - call seq_diag_accum_mct() - call t_drvstopf ('CPL:BUDGET3',cplrun=.true.,budget=.true.) - - call t_drvstartf ('CPL:BUDGETF',cplrun=.true.,budget=.true.,barrier=mpicom_CPLID) - if (.not. dead_comps) then - call seq_diag_print_mct(EClock_d,stop_alarm,budget_inst, & - budget_daily, budget_month, budget_ann, budget_ltann,& - budget_ltend, infodata) - endif - call seq_diag_zero_mct(EClock=EClock_d) - - call t_drvstopf ('CPL:BUDGETF',cplrun=.true.,budget=.true.) - endif - - !---------------------------------------------------------- - !| OCN RECV-POST (NOT cesm1_orig_tight and cesm1_mod_tight) - !---------------------------------------------------------- - - if ((trim(cpl_seq_option) /= 'CESM1_ORIG_TIGHT' .and. & - trim(cpl_seq_option) /= 'CESM1_MOD_TIGHT' ) .and. & - ocn_present .and. ocnnext_alarm) then - - !---------------------------------------------------------- - !| ocn -> cpl (NOT cesm1_orig_tight and cesm1_mod_tight) - !---------------------------------------------------------- - - if (iamin_CPLALLOCNID) then - call component_exch(ocn, flow='c2x', & - infodata=infodata, infodata_string='ocn2cpl_run', & - mpicom_barrier=mpicom_CPLALLOCNID, run_barriers=run_barriers, & - timer_barrier='CPL:O2C_BARRIER', timer_comp_exch='CPL:O2C', & - timer_map_exch='CPL:o2c_ocno2ocnx', timer_infodata_exch='CPL:o2c_infoexch') - endif - - !---------------------------------------------------------- - !| ocn post (NOT cesm1_orig_tight and cesm1_mod_tight) - !---------------------------------------------------------- - - if (iamin_CPLID) then - call cime_comp_barriers(mpicom=mpicom_CPLID, timer='CPL:OCNPOST_BARRIER') - call t_drvstartf ('CPL:OCNPOST',cplrun=.true.,barrier=mpicom_CPLID) - if (drv_threading) call seq_comm_setnthreads(nthreads_CPLID) - - call component_diag(infodata, ocn, flow='c2x', comment= 'recv ocn', & - info_debug=info_debug, timer_diag='CPL:ocnpost_diagav') - - if (drv_threading) call seq_comm_setnthreads(nthreads_GLOID) - call t_drvstopf ('CPL:OCNPOST',cplrun=.true.) - endif - endif - - !---------------------------------------------------------- - !| Write driver restart file - !---------------------------------------------------------- - if ( (restart_alarm .or. drv_pause) .and. iamin_CPLID) then - call cime_comp_barriers(mpicom=mpicom_CPLID, timer='CPL:RESTART_BARRIER') - call t_drvstartf ('CPL:RESTART',cplrun=.true.,barrier=mpicom_CPLID) - if (drv_threading) call seq_comm_setnthreads(nthreads_CPLID) - if (iamroot_CPLID) then - write(logunit,104) ' Write restart file at ',ymd,tod - call shr_sys_flush(logunit) - endif - - call seq_rest_write(EClock_d, seq_SyncClock, infodata, & - atm, lnd, ice, ocn, rof, glc, wav, esp, & - fractions_ax, fractions_lx, fractions_ix, fractions_ox, & - fractions_rx, fractions_gx, fractions_wx, trim(cpl_inst_tag)) - - if (drv_threading) call seq_comm_setnthreads(nthreads_GLOID) - call t_drvstopf ('CPL:RESTART',cplrun=.true.) - endif + call cime_run_write_restart(drv_pause, restart_alarm, drv_resume) !---------------------------------------------------------- !| Write history file, only AVs on CPLID !---------------------------------------------------------- + call cime_run_write_history() if (iamin_CPLID) then @@ -3677,29 +2940,29 @@ subroutine cime_run() endif call seq_hist_write(infodata, EClock_d, & - atm, lnd, ice, ocn, rof, glc, wav, & + atm, lnd, ice, ocn, rof, glc, wav, iac, & fractions_ax, fractions_lx, fractions_ix, fractions_ox, & - fractions_rx, fractions_gx, fractions_wx, trim(cpl_inst_tag)) + fractions_rx, fractions_gx, fractions_wx, fractions_zx, trim(cpl_inst_tag)) if (drv_threading) call seq_comm_setnthreads(nthreads_GLOID) endif if (do_histavg) then call seq_hist_writeavg(infodata, EClock_d, & - atm, lnd, ice, ocn, rof, glc, wav, histavg_alarm, & + atm, lnd, ice, ocn, rof, glc, wav, iac, histavg_alarm, & trim(cpl_inst_tag)) endif if (do_hist_a2x) then do eai = 1,num_inst_atm - suffix = component_get_suffix(atm(eai)) + inst_suffix = component_get_suffix(atm(eai)) if (trim(hist_a2x_flds) == 'all') then call seq_hist_writeaux(infodata, EClock_d, atm(eai), flow='c2x', & - aname='a2x'//trim(suffix), dname='doma', & + aname='a2x',dname='doma', inst_suffix=trim(inst_suffix), & nx=atm_nx, ny=atm_ny, nt=ncpl) else call seq_hist_writeaux(infodata, EClock_d, atm(eai), flow='c2x', & - aname='a2x'//trim(suffix), dname='doma', & + aname='a2x',dname='doma', inst_suffix=trim(inst_suffix), & nx=atm_nx, ny=atm_ny, nt=ncpl, flds=hist_a2x_flds) endif enddo @@ -3707,14 +2970,14 @@ subroutine cime_run() if (do_hist_a2x1hri .and. t1hr_alarm) then do eai = 1,num_inst_atm - suffix = component_get_suffix(atm(eai)) + inst_suffix = component_get_suffix(atm(eai)) if (trim(hist_a2x1hri_flds) == 'all') then call seq_hist_writeaux(infodata, EClock_d, atm(eai), flow='c2x', & - aname='a2x1hi'//trim(suffix), dname='doma', & + aname='a2x1hi',dname='doma',inst_suffix=trim(inst_suffix), & nx=atm_nx, ny=atm_ny, nt=24) else call seq_hist_writeaux(infodata, EClock_d, atm(eai), flow='c2x', & - aname='a2x1hi'//trim(suffix), dname='doma', & + aname='a2x1hi',dname='doma',inst_suffix=trim(inst_suffix), & nx=atm_nx, ny=atm_ny, nt=24, flds=hist_a2x1hri_flds) endif enddo @@ -3722,14 +2985,14 @@ subroutine cime_run() if (do_hist_a2x1hr) then do eai = 1,num_inst_atm - suffix = component_get_suffix(atm(eai)) + inst_suffix = component_get_suffix(atm(eai)) if (trim(hist_a2x1hr_flds) == 'all') then call seq_hist_writeaux(infodata, EClock_d, atm(eai), flow='c2x', & - aname='a2x1h'//trim(suffix), dname='doma', & + aname='a2x1h',dname='doma',inst_suffix=trim(inst_suffix), & nx=atm_nx, ny=atm_ny, nt=24, write_now=t1hr_alarm) else call seq_hist_writeaux(infodata, EClock_d, atm(eai), flow='c2x', & - aname='a2x1h'//trim(suffix), dname='doma', & + aname='a2x1h',dname='doma',inst_suffix=trim(inst_suffix), & nx=atm_nx, ny=atm_ny, nt=24, write_now=t1hr_alarm, flds=hist_a2x1hr_flds) endif enddo @@ -3737,14 +3000,14 @@ subroutine cime_run() if (do_hist_a2x3hr) then do eai = 1,num_inst_atm - suffix = component_get_suffix(atm(eai)) + inst_suffix = component_get_suffix(atm(eai)) if (trim(hist_a2x3hr_flds) == 'all') then call seq_hist_writeaux(infodata, EClock_d, atm(eai), flow='c2x', & - aname='a2x3h'//trim(suffix), dname='doma', & + aname='a2x3h',dname='doma',inst_suffix=trim(inst_suffix), & nx=atm_nx, ny=atm_ny, nt=8, write_now=t3hr_alarm) else call seq_hist_writeaux(infodata, EClock_d, atm(eai), flow='c2x', & - aname='a2x3h'//trim(suffix), dname='doma', & + aname='a2x3h',dname='doma',inst_suffix=trim(inst_suffix), & nx=atm_nx, ny=atm_ny, nt=8, write_now=t3hr_alarm, flds=hist_a2x3hr_flds) endif enddo @@ -3752,14 +3015,14 @@ subroutine cime_run() if (do_hist_a2x3hrp) then do eai = 1,num_inst_atm - suffix = component_get_suffix(atm(eai)) + inst_suffix = component_get_suffix(atm(eai)) if (trim(hist_a2x3hrp_flds) == 'all') then call seq_hist_writeaux(infodata, EClock_d, atm(eai), flow='c2x', & - aname='a2x3h_prec'//trim(suffix), dname='doma', & + aname='a2x3h_prec',dname='doma',inst_suffix=trim(inst_suffix), & nx=atm_nx, ny=atm_ny, nt=8, write_now=t3hr_alarm) else call seq_hist_writeaux(infodata, EClock_d, atm(eai), flow='c2x', & - aname='a2x3h_prec'//trim(suffix), dname='doma', & + aname='a2x3h_prec',dname='doma',inst_suffix=trim(inst_suffix), & nx=atm_nx, ny=atm_ny, nt=8, write_now=t3hr_alarm, flds=hist_a2x3hrp_flds) endif enddo @@ -3767,14 +3030,14 @@ subroutine cime_run() if (do_hist_a2x24hr) then do eai = 1,num_inst_atm - suffix = component_get_suffix(atm(eai)) + inst_suffix = component_get_suffix(atm(eai)) if (trim(hist_a2x24hr_flds) == 'all') then call seq_hist_writeaux(infodata, EClock_d, atm(eai), flow='c2x', & - aname='a2x1d'//trim(suffix), dname='doma', & + aname='a2x1d',dname='doma',inst_suffix=trim(inst_suffix), & nx=atm_nx, ny=atm_ny, nt=1, write_now=t24hr_alarm) else call seq_hist_writeaux(infodata, EClock_d, atm(eai), flow='c2x', & - aname='a2x1d'//trim(suffix), dname='doma', & + aname='a2x1d',dname='doma',inst_suffix=trim(inst_suffix), & nx=atm_nx, ny=atm_ny, nt=1, write_now=t24hr_alarm, flds=hist_a2x24hr_flds) endif enddo @@ -3796,8 +3059,6 @@ subroutine cime_run() if (t1yr_alarm .and. .not. lnd2glc_averaged_now) then write(logunit,*) 'ERROR: histaux_l2x1yrg requested;' write(logunit,*) 'it is the year boundary, but lnd2glc fields were not averaged this time step.' - write(logunit,*) 'One possible reason is that you are running with a stub glc model.' - write(logunit,*) '(It only works to request histaux_l2x1yrg if running with a prognostic glc model.)' call shr_sys_abort(subname// & ' do_hist_l2x1yrg and t1yr_alarm are true, but lnd2glc_averaged_now is false') end if @@ -3824,11 +3085,11 @@ subroutine cime_run() rdays_offset = tbnds1_offset, & years_offset = -1) do eli = 1,num_inst_lnd - suffix = component_get_suffix(lnd(eli)) + inst_suffix = component_get_suffix(lnd(eli)) ! Use yr_offset=-1 so the file with fields from year 1 has time stamp ! 0001-01-01 rather than 0002-01-01, etc. call seq_hist_writeaux(infodata, EClock_d, lnd(eli), flow='c2x', & - aname='l2x1yr_glc'//trim(suffix), dname='doml', & + aname='l2x1yr_glc',dname='doml',inst_suffix=trim(inst_suffix), & nx=lnd_nx, ny=lnd_ny, nt=1, write_now=.true., & tbnds1_offset = tbnds1_offset, yr_offset=-1, & av_to_write=prep_glc_get_l2gacc_lx_one_instance(eli)) @@ -3838,9 +3099,9 @@ subroutine cime_run() if (do_hist_l2x) then do eli = 1,num_inst_lnd - suffix = component_get_suffix(lnd(eli)) + inst_suffix = component_get_suffix(lnd(eli)) call seq_hist_writeaux(infodata, EClock_d, lnd(eli), flow='c2x', & - aname='l2x'//trim(suffix), dname='doml', & + aname='l2x',dname='doml',inst_suffix=trim(inst_suffix), & nx=lnd_nx, ny=lnd_ny, nt=ncpl) enddo endif @@ -3854,21 +3115,105 @@ subroutine cime_run() ! Make sure that all couplers are here in multicoupler mode before running ESP component if (num_inst_driver > 1) then call mpi_barrier(global_comm, ierr) - endif - call component_run(Eclock_e, esp, esp_run, infodata, & - comp_prognostic=esp_prognostic, comp_num=comp_num_esp, & + end if + ! Gather up each instance's 'resume' files (written before 'pause') + do eai = 1, num_inst_atm + call seq_resume_store_comp(atm(eai)%oneletterid, & + atm(eai)%cdata_cc%resume_filename, num_inst_atm, & + ATMID(eai), component_get_iamroot_compid(atm(eai))) + end do + do eli = 1, num_inst_lnd + call seq_resume_store_comp(lnd(eli)%oneletterid, & + lnd(eli)%cdata_cc%resume_filename, num_inst_lnd, & + LNDID(eli), component_get_iamroot_compid(lnd(eli))) + end do + do eoi = 1, num_inst_ocn + call seq_resume_store_comp(ocn(eoi)%oneletterid, & + ocn(eoi)%cdata_cc%resume_filename, num_inst_ocn, & + OCNID(eoi), component_get_iamroot_compid(ocn(eoi))) + end do + do eii = 1, num_inst_ice + call seq_resume_store_comp(ice(eii)%oneletterid, & + ice(eii)%cdata_cc%resume_filename, num_inst_ice, & + ICEID(eii), component_get_iamroot_compid(ice(eii))) + end do + do eri = 1, num_inst_rof + call seq_resume_store_comp(rof(eri)%oneletterid, & + rof(eri)%cdata_cc%resume_filename, num_inst_rof, & + ROFID(eri), component_get_iamroot_compid(rof(eri))) + end do + do egi = 1, num_inst_glc + call seq_resume_store_comp(glc(egi)%oneletterid, & + glc(egi)%cdata_cc%resume_filename, num_inst_glc, & + GLCID(egi), component_get_iamroot_compid(glc(egi))) + end do + do ewi = 1, num_inst_wav + call seq_resume_store_comp(wav(ewi)%oneletterid, & + wav(ewi)%cdata_cc%resume_filename, num_inst_wav, & + WAVID(ewi), component_get_iamroot_compid(wav(ewi))) + end do + ! Here we pass 1 as num_inst_driver as num_inst_driver is used inside + call seq_resume_store_comp('x', drv_resume, 1, & + driver_id, iamroot_CPLID) + call component_run(Eclock_e, esp, esp_run, infodata, & + comp_prognostic=esp_prognostic, comp_num=comp_num_esp, & timer_barrier= 'CPL:ESP_RUN_BARRIER', timer_comp_run='CPL:ESP_RUN', & run_barriers=run_barriers, ymd=ymd, tod=tod,comp_layout=esp_layout) + !--------------------------------------------------------------------- !| ESP computes resume options for other components -- update everyone !--------------------------------------------------------------------- - call seq_infodata_exchange(infodata, CPLALLESPID, 'esp2cpl_run') - endif + call seq_resume_get_files('a', resume_files) + if (associated(resume_files)) then + do eai = 1, num_inst_atm + atm(eai)%cdata_cc%resume_filename = resume_files(ATMID(eai)) + end do + end if + call seq_resume_get_files('l', resume_files) + if (associated(resume_files)) then + do eli = 1, num_inst_lnd + lnd(eli)%cdata_cc%resume_filename = resume_files(LNDID(eli)) + end do + end if + call seq_resume_get_files('o', resume_files) + if (associated(resume_files)) then + do eoi = 1, num_inst_ocn + ocn(eoi)%cdata_cc%resume_filename = resume_files(OCNID(eoi)) + end do + end if + call seq_resume_get_files('i', resume_files) + if (associated(resume_files)) then + do eii = 1, num_inst_ice + ice(eii)%cdata_cc%resume_filename = resume_files(ICEID(eii)) + end do + end if + call seq_resume_get_files('r', resume_files) + if (associated(resume_files)) then + do eri = 1, num_inst_rof + rof(eri)%cdata_cc%resume_filename = resume_files(ROFID(eri)) + end do + end if + call seq_resume_get_files('g', resume_files) + if (associated(resume_files)) then + do egi = 1, num_inst_glc + glc(egi)%cdata_cc%resume_filename = resume_files(GLCID(egi)) + end do + end if + call seq_resume_get_files('w', resume_files) + if (associated(resume_files)) then + do ewi = 1, num_inst_wav + wav(ewi)%cdata_cc%resume_filename = resume_files(WAVID(ewi)) + end do + end if + call seq_resume_get_files('x', resume_files) + if (associated(resume_files)) then + drv_resume = resume_files(driver_id) + end if + end if !---------------------------------------------------------- !| RESUME (read restart) if signaled !---------------------------------------------------------- - call seq_infodata_GetData(infodata, cpl_resume=drv_resume) if (len_trim(drv_resume) > 0) then if (iamroot_CPLID) then write(logunit,103) subname,' Reading restart (resume) file ',trim(drv_resume) @@ -3876,13 +3221,12 @@ subroutine cime_run() end if if (iamin_CPLID) then call seq_rest_read(drv_resume, infodata, & - atm, lnd, ice, ocn, rof, glc, wav, esp, & + atm, lnd, ice, ocn, rof, glc, wav, esp, iac, & fractions_ax, fractions_lx, fractions_ix, fractions_ox, & - fractions_rx, fractions_gx, fractions_wx) + fractions_rx, fractions_gx, fractions_wx, fractions_zx) end if ! Clear the resume file so we don't try to read it again drv_resume = ' ' - call seq_infodata_PutData(infodata, cpl_resume=drv_resume) end if !---------------------------------------------------------- @@ -3954,7 +3298,8 @@ subroutine cime_run() lnd(ens1)%iamroot_compid .or. & ice(ens1)%iamroot_compid .or. & glc(ens1)%iamroot_compid .or. & - wav(ens1)%iamroot_compid) then + wav(ens1)%iamroot_compid .or. & + iac(ens1)%iamroot_compid) then call shr_mem_getusage(msize,mrss,.true.) write(logunit,105) ' memory_write: model date = ',ymd,tod, & @@ -3981,30 +3326,14 @@ subroutine cime_run() if ((tod == 0) .and. in_first_day) then in_first_day = .false. endif - call t_adj_detailf(+1) - - call t_startf("CPL:sync1_tprof") - call mpi_barrier(mpicom_GLOID,ierr) - call t_stopf("CPL:sync1_tprof") write(timing_file,'(a,i8.8,a1,i5.5)') & - trim(tchkpt_dir)//"/model_timing"//trim(cpl_inst_tag)//"_",ymd,"_",tod + trim(tchkpt_dir)//"/model_timing"//trim(cpl_inst_tag)//"_",ymd,"_",tod - call t_set_prefixf("CPL:") - if (output_perf) then - call t_prf(filename=trim(timing_file), mpicom=mpicom_GLOID, & - num_outpe=0, output_thispe=output_perf) - else - call t_prf(filename=trim(timing_file), mpicom=mpicom_GLOID, & - num_outpe=0) - endif + call t_set_prefixf("CPL:RUN_LOOP_") + call cime_write_performance_checkpoint(output_perf,timing_file,mpicom_GLOID) call t_unset_prefixf() - call t_startf("CPL:sync2_tprof") - call mpi_barrier(mpicom_GLOID,ierr) - call t_stopf("CPL:sync2_tprof") - - call t_adj_detailf(-1) endif call t_stopf ('CPL:TPROF_WRITE') @@ -4024,6 +3353,7 @@ subroutine cime_run() call mpi_barrier(mpicom_GLOID,ierr) call t_stopf ('CPL:RUN_LOOP_BSTOP') + call seq_resume_free() Time_end = mpi_wtime() end subroutine cime_run @@ -4036,7 +3366,6 @@ subroutine cime_final() use shr_pio_mod, only : shr_pio_finalize use shr_wv_sat_mod, only: shr_wv_sat_final - character(len=cs) :: cime_model !------------------------------------------------------------------------ ! Finalization of all models @@ -4059,13 +3388,13 @@ subroutine cime_final() call component_final(EClock_o, ocn, ocn_final) call component_final(EClock_g, glc, glc_final) call component_final(EClock_w, wav, wav_final) + call component_final(EClock_w, iac, iac_final) !------------------------------------------------------------------------ ! End the run cleanly !------------------------------------------------------------------------ call shr_wv_sat_final() - call seq_infodata_GetData(infodata, cime_model=cime_model) call shr_pio_finalize( ) call shr_mpi_min(msize ,msize0,mpicom_GLOID,' driver msize0', all=.true.) @@ -4099,9 +3428,11 @@ subroutine cime_final() call t_adj_detailf(-1) call t_stopf ('CPL:FINAL') - call t_startf("sync3_tprof") + call t_set_prefixf("CPL:FINAL_") + + call t_startf("sync1_tprf") call mpi_barrier(mpicom_GLOID,ierr) - call t_stopf("sync3_tprof") + call t_stopf("sync1_tprf") if (output_perf) then call t_prf(trim(timing_dir)//'/model_timing'//trim(cpl_inst_tag), & @@ -4111,6 +3442,8 @@ subroutine cime_final() mpicom=mpicom_GLOID) endif + call t_unset_prefixf() + call t_finalizef() end subroutine cime_final @@ -4119,7 +3452,7 @@ end subroutine cime_final !******************************************************************************* !=============================================================================== - subroutine seq_cime_printlogheader() + subroutine cime_printlogheader() !----------------------------------------------------------------------- ! @@ -4135,12 +3468,9 @@ subroutine seq_cime_printlogheader() character(len=8) :: ctime ! System time integer :: values(8) character :: date*8, time*10, zone*5 - character(len=cs) :: cime_model !------------------------------------------------------------------------------- - call date_and_time (date, time, zone, values) - call seq_infodata_GetData(infodata, cime_model=cime_model) cdate(1:2) = date(5:6) cdate(3:3) = '/' cdate(4:5) = date(7:8) @@ -4158,14 +3488,14 @@ subroutine seq_cime_printlogheader() write(logunit,F00) ' github: http://esmci.github.io/cime/) ' write(logunit,F00) ' License information is available as a link from above ' write(logunit,F00) '------------------------------------------------------------' - write(logunit,F00) ' MODEL ',cime_model + write(logunit,F00) ' MODEL ',trim(cime_model) write(logunit,F00) '------------------------------------------------------------' write(logunit,F00) ' DATE ',cdate, ' TIME ', ctime write(logunit,F00) '------------------------------------------------------------' write(logunit,*)' ' write(logunit,*)' ' - end subroutine seq_cime_printlogheader + end subroutine cime_printlogheader !=============================================================================== @@ -4181,6 +3511,8 @@ subroutine cime_comp_barriers(mpicom, timer) endif end subroutine cime_comp_barriers + !=============================================================================== + subroutine cime_cpl_init(comm_in, comm_out, num_inst_driver, id) !----------------------------------------------------------------------- ! @@ -4207,7 +3539,7 @@ subroutine cime_cpl_init(comm_in, comm_out, num_inst_driver, id) call shr_mpi_commsize(comm_in, numpes, ' cime_cpl_init') num_inst_driver = 1 - id = 0 + id = 1 ! For compatiblity with component instance numbering if (mype == 0) then ! Read coupler namelist if it exists @@ -4244,6 +3576,1130 @@ subroutine cime_cpl_init(comm_in, comm_out, num_inst_driver, id) call shr_mpi_chkerr(ierr,subname//' mpi_comm_split') end if call shr_mpi_commsize(comm_out, drvpes, ' cime_cpl_init') + end subroutine cime_cpl_init + !=============================================================================== + + subroutine cime_run_atmocn_fluxes(hashint) + integer, intent(inout) :: hashint(:) + + !---------------------------------------------------------- + !| atm/ocn flux on atm grid + !---------------------------------------------------------- + if (trim(aoflux_grid) == 'atm') then + ! compute o2x_ax for flux_atmocn, will be updated before atm merge + ! do not use fractions because fractions here are NOT consistent with fractions in atm_mrg + if (ocn_c2_atm) call prep_atm_calc_o2x_ax(timer='CPL:atmoca_ocn2atm') + + call t_drvstartf ('CPL:atmocna_fluxa',barrier=mpicom_CPLID, hashint=hashint(6)) + do exi = 1,num_inst_xao + eai = mod((exi-1),num_inst_atm) + 1 + eoi = mod((exi-1),num_inst_ocn) + 1 + efi = mod((exi-1),num_inst_frc) + 1 + a2x_ax => component_get_c2x_cx(atm(eai)) + o2x_ax => prep_atm_get_o2x_ax() ! array over all instances + xao_ax => prep_aoflux_get_xao_ax() ! array over all instances + call seq_flux_atmocn_mct(infodata, tod, dtime, a2x_ax, o2x_ax(eoi), xao_ax(exi)) + enddo + call t_drvstopf ('CPL:atmocna_fluxa',hashint=hashint(6)) + + if (atm_c2_ocn) call prep_aoflux_calc_xao_ox(timer='CPL:atmocna_atm2ocn') + endif ! aoflux_grid + + !---------------------------------------------------------- + !| atm/ocn flux on ocn grid + !---------------------------------------------------------- + if (trim(aoflux_grid) == 'ocn') then + call t_drvstartf ('CPL:atmocnp_fluxo',barrier=mpicom_CPLID, hashint=hashint(6)) + do exi = 1,num_inst_xao + eai = mod((exi-1),num_inst_atm) + 1 + eoi = mod((exi-1),num_inst_ocn) + 1 + efi = mod((exi-1),num_inst_frc) + 1 + a2x_ox => prep_ocn_get_a2x_ox() + o2x_ox => component_get_c2x_cx(ocn(eoi)) + xao_ox => prep_aoflux_get_xao_ox() + call seq_flux_atmocn_mct(infodata, tod, dtime, a2x_ox(eai), o2x_ox, xao_ox(exi)) + enddo + call t_drvstopf ('CPL:atmocnp_fluxo',hashint=hashint(6)) + endif ! aoflux_grid + + end subroutine cime_run_atmocn_fluxes + +!---------------------------------------------------------------------------------- + + subroutine cime_run_ocn_albedos(hashint) + integer, intent(inout) :: hashint(:) + + call t_drvstartf ('CPL:atmocnp_ocnalb', barrier=mpicom_CPLID, hashint=hashint(5)) + do exi = 1,num_inst_xao + efi = mod((exi-1),num_inst_frc) + 1 + eai = mod((exi-1),num_inst_atm) + 1 + xao_ox => prep_aoflux_get_xao_ox() ! array over all instances + a2x_ox => prep_ocn_get_a2x_ox() + call seq_flux_ocnalb_mct(infodata, ocn(1), a2x_ox(eai), fractions_ox(efi), xao_ox(exi)) + enddo + call t_drvstopf ('CPL:atmocnp_ocnalb', hashint=hashint(5)) + + end subroutine cime_run_ocn_albedos + +!---------------------------------------------------------------------------------- + + subroutine cime_run_atm_setup_send() + + !---------------------------------------------------------- + !| atm prep-merge + !---------------------------------------------------------- + + if (iamin_CPLID .and. atm_prognostic) then + call cime_comp_barriers(mpicom=mpicom_CPLID, timer='CPL:ATMPREP_BARRIER') + call t_drvstartf ('CPL:ATMPREP',cplrun=.true.,barrier=mpicom_CPLID) + if (drv_threading) call seq_comm_setnthreads(nthreads_CPLID) + + if (ocn_c2_atm) then + if (trim(aoflux_grid) == 'ocn') then + ! map xao_ox states and fluxes to xao_ax if fluxes were computed on ocn grid + call prep_aoflux_calc_xao_ax(fractions_ox, flds='states_and_fluxes', & + timer='CPL:atmprep_xao2atm') + endif + + ! recompute o2x_ax now for the merge with fractions associated with merge + call prep_atm_calc_o2x_ax(fractions_ox, timer='CPL:atmprep_ocn2atm') + + ! map xao_ox albedos to the atm grid, these are always computed on the ocean grid + call prep_aoflux_calc_xao_ax(fractions_ox, flds='albedos', timer='CPL:atmprep_alb2atm') + endif + if (ice_c2_atm) then + call prep_atm_calc_i2x_ax(fractions_ix, timer='CPL:atmprep_ice2atm') + endif + if (lnd_c2_atm) then + call prep_atm_calc_l2x_ax(fractions_lx, timer='CPL:atmprep_lnd2atm') + endif + if (iac_c2_atm) then + call prep_atm_calc_z2x_ax(fractions_zx, timer='CPL:atmprep_iac2atm') + endif + if (associated(xao_ax)) then + call prep_atm_mrg(infodata, fractions_ax, xao_ax=xao_ax, timer_mrg='CPL:atmprep_mrgx2a') + endif + + call component_diag(infodata, atm, flow='x2c', comment= 'send atm', info_debug=info_debug, & + timer_diag='CPL:atmprep_diagav') + + call t_drvstopf ('CPL:ATMPREP',cplrun=.true.) + if (drv_threading) call seq_comm_setnthreads(nthreads_GLOID) + endif + + !---------------------------------------------------------- + !| cpl -> atm + !---------------------------------------------------------- + + if (iamin_CPLALLATMID .and. atm_prognostic) then + call component_exch(atm, flow='x2c', infodata=infodata, infodata_string='cpl2atm_run', & + mpicom_barrier=mpicom_CPLALLATMID, run_barriers=run_barriers, & + timer_barrier='CPL:C2A_BARRIER', timer_comp_exch='CPL:C2A', & + timer_map_exch='CPL:c2a_atmx2atmg', timer_infodata_exch='CPL:c2a_infoexch') + endif + + end subroutine cime_run_atm_setup_send + +!---------------------------------------------------------------------------------- + + subroutine cime_run_atm_recv_post() + + !---------------------------------------------------------- + !| atm -> cpl + !---------------------------------------------------------- + if (iamin_CPLALLATMID) then + call component_exch(atm, flow='c2x', infodata=infodata, infodata_string='atm2cpl_run', & + mpicom_barrier=mpicom_CPLALLATMID, run_barriers=run_barriers, & + timer_barrier='CPL:A2C_BARRIER', timer_comp_exch='CPL:A2C', & + timer_map_exch='CPL:a2c_atma2atmx', timer_infodata_exch='CPL:a2c_infoexch') + + ! will migrate the tag from component pes to coupler pes, on atm mesh + call prep_atm_migrate_moab(infodata) + endif + + !---------------------------------------------------------- + !| atm post + !---------------------------------------------------------- + if (iamin_CPLID) then + call cime_comp_barriers(mpicom=mpicom_CPLID, timer='CPL:ATMPOST_BARRIER') + call t_drvstartf ('CPL:ATMPOST',cplrun=.true.,barrier=mpicom_CPLID) + if (drv_threading) call seq_comm_setnthreads(nthreads_CPLID) + + if (atm_c2_rof) then + call prep_rof_accum_atm(timer='CPL:atmpost_acca2r') + endif + + call component_diag(infodata, atm, flow='c2x', comment= 'recv atm', & + info_debug=info_debug, timer_diag='CPL:atmpost_diagav') + + if (drv_threading) call seq_comm_setnthreads(nthreads_GLOID) + call t_drvstopf ('CPL:ATMPOST',cplrun=.true.) + endif + + ! send projected data from atm to ocean mesh, after projection in coupler + if (iamin_CPLALLOCNID .and. ocn_c2_atm) then + ! migrate that tag from coupler pes to ocean pes + call prep_ocn_migrate_moab(infodata) + endif + + ! send projected data from atm to land mesh, after projection in coupler + if (iamin_CPLALLLNDID .and. atm_c2_lnd) then + ! migrate that tag from coupler pes to ocean pes + call prep_lnd_migrate_moab(infodata) + endif + + + end subroutine cime_run_atm_recv_post + +!---------------------------------------------------------------------------------- + + subroutine cime_run_ocn_setup_send() + + !---------------------------------------------------- + ! "startup" wait + !---------------------------------------------------- + if (iamin_CPLALLOCNID) then + ! want to know the time the ocean pes waited for the cpl pes + ! at the first ocnrun_alarm, min ocean wait is wait time + ! do not use t_barrierf here since it can be "off", use mpi_barrier + do eoi = 1,num_inst_ocn + if (ocn(eoi)%iamin_compid) call t_drvstartf ('CPL:C2O_INITWAIT') + enddo + call mpi_barrier(mpicom_CPLALLOCNID,ierr) + do eoi = 1,num_inst_ocn + if (ocn(eoi)%iamin_compid) call t_drvstopf ('CPL:C2O_INITWAIT') + enddo + cpl2ocn_first = .false. + endif + + !---------------------------------------------------- + ! ocn average + !---------------------------------------------------- + if (iamin_CPLID .and. ocn_prognostic) then + call cime_comp_barriers(mpicom=mpicom_CPLID, timer='CPL:OCNPREP_BARRIER') + call t_drvstartf ('CPL:OCNPREP',cplrun=.true.,barrier=mpicom_CPLID) + if (drv_threading) call seq_comm_setnthreads(nthreads_CPLID) + + ! finish accumulating ocean inputs + ! reset the value of x2o_ox with the value in x2oacc_ox (module variable in prep_ocn_mod) + call prep_ocn_accum_avg(timer_accum='CPL:ocnprep_avg') + + call component_diag(infodata, ocn, flow='x2c', comment= 'send ocn', & + info_debug=info_debug, timer_diag='CPL:ocnprep_diagav') + + if (drv_threading) call seq_comm_setnthreads(nthreads_GLOID) + call t_drvstopf ('CPL:OCNPREP',cplrun=.true.) + endif + + !---------------------------------------------------- + ! cpl -> ocn + !---------------------------------------------------- + if (iamin_CPLALLOCNID .and. ocn_prognostic) then + call component_exch(ocn, flow='x2c', & + infodata=infodata, infodata_string='cpl2ocn_run', & + mpicom_barrier=mpicom_CPLALLOCNID, run_barriers=run_barriers, & + timer_barrier='CPL:C2O_BARRIER', timer_comp_exch='CPL:C2O', & + timer_map_exch='CPL:c2o_ocnx2ocno', timer_infodata_exch='CPL:c2o_infoexch') + endif + + end subroutine cime_run_ocn_setup_send + + !---------------------------------------------------------------------------------- + + subroutine cime_run_ocn_recv_post() + + !---------------------------------------------------------- + ! ocn -> cpl + !---------------------------------------------------------- + if (iamin_CPLALLOCNID) then + call component_exch(ocn, flow='c2x', & + infodata=infodata, infodata_string='ocn2cpl_run', & + mpicom_barrier=mpicom_CPLALLOCNID, run_barriers=run_barriers, & + timer_barrier='CPL:O2CT_BARRIER', timer_comp_exch='CPL:O2CT', & + timer_map_exch='CPL:o2c_ocno2ocnx', timer_infodata_exch='CPL:o2c_infoexch') + endif + + !---------------------------------------------------------- + ! ocn post + !---------------------------------------------------------- + if (iamin_CPLID) then + call cime_comp_barriers(mpicom=mpicom_CPLID, timer='CPL:OCNPOSTT_BARRIER') + call t_drvstartf ('CPL:OCNPOSTT',cplrun=.true.,barrier=mpicom_CPLID) + if (drv_threading) call seq_comm_setnthreads(nthreads_CPLID) + + call component_diag(infodata, ocn, flow='c2x', comment= 'recv ocn', & + info_debug=info_debug, timer_diag='CPL:ocnpost_diagav') + + call cime_run_ocnglc_coupling() + + if (drv_threading) call seq_comm_setnthreads(nthreads_GLOID) + call t_drvstopf ('CPL:OCNPOSTT',cplrun=.true.) + endif + + end subroutine cime_run_ocn_recv_post + + !---------------------------------------------------------------------------------- + subroutine cime_run_iac_setup_send() + + !------------------------------------------------------- + ! | iac prep-merge + !------------------------------------------------------- + + if (iamin_CPLID .and. iac_prognostic) then + call cime_comp_barriers(mpicom=mpicom_CPLID, timer='CPL:IACPREP_BARRIER') + + call t_drvstartf ('CPL:IACPREP', cplrun=.true., barrier=mpicom_CPLID) + if (drv_threading) call seq_comm_setnthreads(nthreads_CPLID) + + ! Average our accumulators + call prep_iac_accum_avg(timer='CPL:iacprep_l2xavg') + + ! Setup lnd inputs on iac grid. Right now I think they will be the same + ! thing, but I'm trying to code for the general case + if (lnd_c2_iac) then + call prep_iac_calc_l2x_zx(timer='CPL:iacprep_lnd2iac') + endif + + + call prep_iac_mrg(infodata, fractions_zx, timer_mrg='CPL:iacprep_mrgx2z') + + call component_diag(infodata, iac, flow='x2c', comment= 'send iac', & + info_debug=info_debug, timer_diag='CPL:iacprep_diagav') + + if (drv_threading) call seq_comm_setnthreads(nthreads_GLOID) + call t_drvstopf ('CPL:IACPREP',cplrun=.true.) + endif + + !---------------------------------------------------- + !| cpl -> iac + !---------------------------------------------------- + + if (iamin_CPLALLIACID .and. iac_prognostic) then + call component_exch(iac, flow='x2c', & + infodata=infodata, infodata_string='cpl2iac_run', & + mpicom_barrier=mpicom_CPLALLLNDID, run_barriers=run_barriers, & + timer_barrier='CPL:C2Z_BARRIER', timer_comp_exch='CPL:C2Z', & + timer_map_exch='CPL:c2z_iacx2iacr', timer_infodata_exch='CPL:c2z_infoexch') + endif + + end subroutine cime_run_iac_setup_send + + !---------------------------------------------------------------------------------- + subroutine cime_run_iac_recv_post() + + !---------------------------------------------------------- + !| iac -> cpl + !---------------------------------------------------------- + + if (iamin_CPLALLIACID) then + call component_exch(rof, flow='c2x', & + infodata=infodata, infodata_string='iac2cpl_run', & + mpicom_barrier=mpicom_CPLALLIACID, run_barriers=run_barriers, & + timer_barrier='CPL:Z2C_BARRIER', timer_comp_exch='CPL:Z2C', & + timer_map_exch='CPL:z2c_iacr2iacx', timer_infodata_exch='CPL:z2c_infoexch') + endif + + !---------------------------------------------------------- + !| iac post + !---------------------------------------------------------- + + if (iamin_CPLID) then + call cime_comp_barriers(mpicom=mpicom_CPLID, timer='CPL:IACPOST_BARRIER') + call t_drvstartf ('CPL:IACPOST',cplrun=.true.,barrier=mpicom_CPLID) + if (drv_threading) call seq_comm_setnthreads(nthreads_CPLID) + + call component_diag(infodata, iac, flow='c2x', comment= 'recv iac', & + info_debug=info_debug, timer_diag='CPL:iacpost_diagav') + + ! TRS I think this is wrong - review these prep functions. I think it's more likely + if (iac_c2_lnd) then + call prep_lnd_calc_z2x_lx(timer='CPL:iacpost_iac2lnd') + endif + + if (iac_c2_atm) then + call prep_atm_calc_z2x_ax(fractions_zx, timer='CPL:iacpost_iac2atm') + endif + + call t_drvstopf ('CPL:IACPOST', cplrun=.true.) + endif + + end subroutine cime_run_iac_recv_post + + !---------------------------------------------------------------------------------- + + subroutine cime_run_atmocn_setup(hashint) + integer, intent(inout) :: hashint(:) + + if (iamin_CPLID) then + call cime_comp_barriers(mpicom=mpicom_CPLID, timer='CPL:ATMOCNP_BARRIER') + call t_drvstartf ('CPL:ATMOCNP',cplrun=.true.,barrier=mpicom_CPLID,hashint=hashint(7)) + if (drv_threading) call seq_comm_setnthreads(nthreads_CPLID) + + if (trim(cpl_seq_option(1:5)) == 'NUOPC') then + if (atm_c2_ocn) call prep_ocn_calc_a2x_ox(timer='CPL:atmocnp_atm2ocn') + end if + + if (ocn_prognostic) then + ! Map to ocn + if (ice_c2_ocn) call prep_ocn_calc_i2x_ox(timer='CPL:atmocnp_ice2ocn') + if (wav_c2_ocn) call prep_ocn_calc_w2x_ox(timer='CPL:atmocnp_wav2ocn') + if (trim(cpl_seq_option(1:5)) == 'NUOPC') then + if (rof_c2_ocn) call prep_ocn_calc_r2x_ox(timer='CPL:atmocnp_rof2ocn') + if (glc_c2_ocn) call prep_ocn_calc_g2x_ox(timer='CPL:atmocnp_glc2ocn') + end if + end if + + ! atm/ocn flux on either atm or ocean grid + call cime_run_atmocn_fluxes(hashint) + + ! ocn prep-merge (cesm1_mod or cesm1_mod_tight) + if (ocn_prognostic) then +#if COMPARE_TO_NUOPC + !This is need to compare to nuopc + if (.not. skip_ocean_run) then + ! ocn prep-merge + xao_ox => prep_aoflux_get_xao_ox() + call prep_ocn_mrg(infodata, fractions_ox, xao_ox=xao_ox, timer_mrg='CPL:atmocnp_mrgx2o') + + ! Accumulate ocn inputs - form partial sum of tavg ocn inputs (virtual "send" to ocn) + call prep_ocn_accum(timer='CPL:atmocnp_accum') + end if +#else + ! ocn prep-merge + xao_ox => prep_aoflux_get_xao_ox() + call prep_ocn_mrg(infodata, fractions_ox, xao_ox=xao_ox, timer_mrg='CPL:atmocnp_mrgx2o') + + ! Accumulate ocn inputs - form partial sum of tavg ocn inputs (virtual "send" to ocn) + call prep_ocn_accum(timer='CPL:atmocnp_accum') +#endif + end if + + !---------------------------------------------------------- + ! ocn albedos + ! (MUST BE AFTER prep_ocn_mrg for swnet to ocn to be computed properly + !---------------------------------------------------------- + call cime_run_ocn_albedos(hashint) + + !---------------------------------------------------------- + ! ocn budget + !---------------------------------------------------------- + if (do_budgets) then + call cime_run_calc_budgets3() + endif + + if (drv_threading) call seq_comm_setnthreads(nthreads_GLOID) + call t_drvstopf ('CPL:ATMOCNP',cplrun=.true.,hashint=hashint(7)) + end if + + end subroutine cime_run_atmocn_setup + +!---------------------------------------------------------------------------------- + + subroutine cime_run_ocnglc_coupling() + !--------------------------------------- + ! Description: Run calculation of coupling fluxes between OCN and GLC + ! Note: this happens in the coupler to allow it be calculated on the + ! ocean time step but the GLC grid. + !--------------------------------------- + + if (glc_present) then + + if (ocn_c2_glcshelf .and. glcshelf_c2_ocn) then + ! the boundary flux calculations done in the coupler require inputs from both GLC and OCN, + ! so they will only be valid if both OCN->GLC and GLC->OCN + + call prep_glc_calc_o2x_gx(timer='CPL:glcprep_ocn2glc') !remap ocean fields to o2x_g at ocean couping interval + + call prep_glc_calculate_subshelf_boundary_fluxes ! this is actual boundary layer flux calculation + !this outputs + !x2g_g/g2x_g, where latter is going + !to ocean, so should get remapped to + !ocean grid in prep_ocn_shelf_calc_g2x_ox + call prep_ocn_shelf_calc_g2x_ox(timer='CPL:glcpost_glcshelf2ocn') + !Map g2x_gx shelf fields that were updated above, to g2x_ox. + !Do this at intrinsic coupling + !frequency + call prep_glc_accum_ocn(timer='CPL:glcprep_accum_ocn') !accum x2g_g fields here into x2g_gacc + endif + + if (glcshelf_c2_ice) then + call prep_ice_shelf_calc_g2x_ix(timer='CPL:glcpost_glcshelf2ice') + !Map g2x_gx shelf fields to g2x_ix. + !Do this at intrinsic coupling + !frequency. This is perhaps an + !unnecessary place to put this + !call, since these fields aren't + !changing on the intrinsic + !timestep. But I don't think it's + !unsafe to do it here. + endif + + endif + + end subroutine cime_run_ocnglc_coupling + +!---------------------------------------------------------------------------------- + + subroutine cime_run_lnd_setup_send() + + !---------------------------------------------------- + !| lnd prep-merge + !---------------------------------------------------- + if (iamin_CPLID) then + call cime_comp_barriers(mpicom=mpicom_CPLID, timer='CPL:LNDPREP_BARRIER') + call t_drvstartf ('CPL:LNDPREP',cplrun=.true.,barrier=mpicom_CPLID) + if (drv_threading) call seq_comm_setnthreads(nthreads_CPLID) + + if (atm_c2_lnd) call prep_lnd_calc_a2x_lx(timer='CPL:lndprep_atm2lnd') + if (trim(cpl_seq_option(1:5)) == 'NUOPC') then + if (glc_c2_lnd) call prep_lnd_calc_g2x_lx(timer='CPL:glcpost_glc2lnd') + end if + + ! IAC export onto lnd grid + if (iac_c2_lnd) then + call prep_lnd_calc_z2x_lx(timer='CPL:lndprep_iac2lnd') + endif + + if (lnd_prognostic) then + call prep_lnd_mrg(infodata, timer_mrg='CPL:lndprep_mrgx2l') + + call component_diag(infodata, lnd, flow='x2c', comment= 'send lnd', & + info_debug=info_debug, timer_diag='CPL:lndprep_diagav') + endif + + if (drv_threading) call seq_comm_setnthreads(nthreads_GLOID) + call t_drvstopf ('CPL:LNDPREP',cplrun=.true.) + endif + + !---------------------------------------------------- + !| cpl -> lnd + !---------------------------------------------------- + if (iamin_CPLALLLNDID) then + call component_exch(lnd, flow='x2c', & + infodata=infodata, infodata_string='cpl2lnd_run', & + mpicom_barrier=mpicom_CPLALLLNDID, run_barriers=run_barriers, & + timer_barrier='CPL:C2L_BARRIER', timer_comp_exch='CPL:C2L', & + timer_map_exch='CPL:c2l_lndx2lndl', timer_infodata_exch='CPL:c2l_infoexch') + endif + + end subroutine cime_run_lnd_setup_send + +!---------------------------------------------------------------------------------- + + subroutine cime_run_lnd_recv_post() + + !---------------------------------------------------------- + !| lnd -> cpl + !---------------------------------------------------------- + if (iamin_CPLALLLNDID) then + call component_exch(lnd, flow='c2x', infodata=infodata, infodata_string='lnd2cpl_run', & + mpicom_barrier=mpicom_CPLALLLNDID, run_barriers=run_barriers, & + timer_barrier='CPL:L2C_BARRIER', timer_comp_exch='CPL:L2C', & + timer_map_exch='CPL:l2c_lndl2lndx', timer_infodata_exch='lnd2cpl_run') + endif + + !---------------------------------------------------------- + !| lnd post + !---------------------------------------------------------- + if (iamin_CPLID) then + call cime_comp_barriers(mpicom=mpicom_CPLID, timer='CPL:LNDPOST_BARRIER') + call t_drvstartf ('CPL:LNDPOST',cplrun=.true.,barrier=mpicom_CPLID) + if (drv_threading) call seq_comm_setnthreads(nthreads_CPLID) + + call component_diag(infodata, lnd, flow='c2x', comment='recv lnd', & + info_debug=info_debug, timer_diag='CPL:lndpost_diagav') + + ! Accumulate rof and glc inputs (module variables in prep_rof_mod and prep_glc_mod) + if (lnd_c2_rof) call prep_rof_accum_lnd(timer='CPL:lndpost_accl2r') + if (lnd_c2_glc .or. do_hist_l2x1yrg) call prep_glc_accum_lnd(timer='CPL:lndpost_accl2g' ) + if (lnd_c2_iac) call prep_iac_accum(timer='CPL:lndpost_accl2z') + + if (drv_threading) call seq_comm_setnthreads(nthreads_GLOID) + call t_drvstopf ('CPL:LNDPOST',cplrun=.true.) + endif + + end subroutine cime_run_lnd_recv_post + +!---------------------------------------------------------------------------------- + + subroutine cime_run_glc_setup_send(lnd2glc_averaged_now, prep_glc_accum_avg_called) + + logical, intent(inout) :: lnd2glc_averaged_now ! Set to .true. if lnd2glc averages are taken this timestep (otherwise left unchanged) + logical, intent(inout) :: prep_glc_accum_avg_called ! Set to .true. if prep_glc_accum_avg is called here (otherwise left unchanged) + + !---------------------------------------------------- + !| glc prep-merge + !---------------------------------------------------- + if (iamin_CPLID .and. glc_prognostic) then + call cime_comp_barriers(mpicom=mpicom_CPLID, timer='CPL:GLCPREP_BARRIER') + call t_drvstartf ('CPL:GLCPREP',cplrun=.true.,barrier=mpicom_CPLID) + if (drv_threading) call seq_comm_setnthreads(nthreads_CPLID) + + ! NOTE - only create appropriate input to glc if the avg_alarm is on + if (lnd_c2_glc .or. ocn_c2_glcshelf) then + if (glcrun_avg_alarm) then + call prep_glc_accum_avg(timer='CPL:glcprep_avg', & + lnd2glc_averaged_now=lnd2glc_averaged_now) + prep_glc_accum_avg_called = .true. + + if (lnd_c2_glc) then + ! Note that l2x_gx is obtained from mapping the module variable l2gacc_lx + call prep_glc_calc_l2x_gx(fractions_lx, timer='CPL:glcprep_lnd2glc') + + call prep_glc_mrg_lnd(infodata, fractions_gx, timer_mrg='CPL:glcprep_mrgx2g') + endif + + call component_diag(infodata, glc, flow='x2c', comment='send glc', & + info_debug=info_debug, timer_diag='CPL:glcprep_diagav') + + else + call prep_glc_zero_fields() + endif ! glcrun_avg_alarm + end if ! lnd_c2_glc or ocn_c2_glcshelf + + if (drv_threading) call seq_comm_setnthreads(nthreads_GLOID) + call t_drvstopf ('CPL:GLCPREP',cplrun=.true.) + + end if ! iamin_CPLID .and. glc_prognostic + + ! Set the infodata field on all tasks (not just those with iamin_CPLID). + if (glc_prognostic) then + if (glcrun_avg_alarm) then + call seq_infodata_PutData(infodata, glc_valid_input=.true.) + else + call seq_infodata_PutData(infodata, glc_valid_input=.false.) + end if + end if + + !---------------------------------------------------- + !| cpl -> glc + !---------------------------------------------------- + if (iamin_CPLALLGLCID .and. glc_prognostic) then + call component_exch(glc, flow='x2c', & + infodata=infodata, infodata_string='cpl2glc_run', & + mpicom_barrier=mpicom_CPLALLGLCID, run_barriers=run_barriers, & + timer_barrier='CPL:C2G_BARRIER', timer_comp_exch='CPL:C2G', & + timer_map_exch='CPL:c2g_glcx2glcg', timer_infodata_exch='CPL:c2g_infoexch') + endif + + end subroutine cime_run_glc_setup_send + +!---------------------------------------------------------------------------------- + + subroutine cime_run_glc_accum_avg(lnd2glc_averaged_now, prep_glc_accum_avg_called) + ! Calls glc_accum_avg in case it's needed but hasn't already been called + + logical, intent(inout) :: lnd2glc_averaged_now ! Set to .true. if lnd2glc averages were taken this timestep (otherwise left unchanged) + logical, intent(inout) :: prep_glc_accum_avg_called ! Set to .true. if prep_glc_accum_avg is called here (otherwise left unchanged) + + call cime_comp_barriers(mpicom=mpicom_CPLID, timer='CPL:AVG_L2X1YRG_BARRIER') + call t_drvstartf ('CPL:AVG_L2X1YRG',cplrun=.true.,barrier=mpicom_CPLID) + if (drv_threading) call seq_comm_setnthreads(nthreads_CPLID) + + call prep_glc_accum_avg(timer='CPL:glcprep_avg', & + lnd2glc_averaged_now=lnd2glc_averaged_now) + prep_glc_accum_avg_called = .true. + + if (drv_threading) call seq_comm_setnthreads(nthreads_GLOID) + call t_drvstopf ('CPL:AVG_L2X1YRG',cplrun=.true.) + end subroutine cime_run_glc_accum_avg + +!---------------------------------------------------------------------------------- + + subroutine cime_run_glc_recv_post() + + !---------------------------------------------------------- + ! glc -> cpl + !---------------------------------------------------------- + if (iamin_CPLALLGLCID) then + call component_exch(glc, flow='c2x', infodata=infodata, infodata_string='glc2cpl_run', & + mpicom_barrier=mpicom_CPLALLGLCID, run_barriers=run_barriers, & + timer_barrier='CPL:G2C_BARRIER', timer_comp_exch='CPL:G2C', & + timer_map_exch='CPL:g2c_glcg2glcx', timer_infodata_exch='CPL:g2c_infoexch') + endif + + !---------------------------------------------------------- + ! glc post + !---------------------------------------------------------- + if (iamin_CPLID) then + call cime_comp_barriers(mpicom=mpicom_CPLID, timer='CPL:GLCPOST_BARRIER') + call t_drvstartf ('CPL:GLCPOST',cplrun=.true.,barrier=mpicom_CPLID) + if (drv_threading) call seq_comm_setnthreads(nthreads_CPLID) + + call component_diag(infodata, glc, flow='c2x', comment= 'recv glc', & + info_debug=info_debug, timer_diag='CPL:glcpost_diagav') + + if (trim(cpl_seq_option(1:5)) /= 'NUOPC') then + if (glc_c2_lnd) call prep_lnd_calc_g2x_lx(timer='CPL:glcpost_glc2lnd') + if (glc_c2_ocn) call prep_ocn_calc_g2x_ox(timer='CPL:glcpost_glc2ocn') + if (glc_c2_ice) call prep_ice_calc_g2x_ix(timer='CPL:glcpost_glc2ice') + end if + + if (drv_threading) call seq_comm_setnthreads(nthreads_GLOID) + call t_drvstopf ('CPL:GLCPOST',cplrun=.true.) + endif + + end subroutine cime_run_glc_recv_post + +!---------------------------------------------------------------------------------- + + subroutine cime_run_rof_setup_send() + !---------------------------------------------------- + ! rof prep-merge + !---------------------------------------------------- + if (iamin_CPLID .and. rof_prognostic) then + call cime_comp_barriers(mpicom=mpicom_CPLID, timer='CPL:ROFPREP_BARRIER') + + call t_drvstartf ('CPL:ROFPREP', cplrun=.true., barrier=mpicom_CPLID) + if (drv_threading) call seq_comm_setnthreads(nthreads_CPLID) + + call prep_rof_accum_avg(timer='CPL:rofprep_l2xavg') + + if (lnd_c2_rof) call prep_rof_calc_l2r_rx(fractions_lx, timer='CPL:rofprep_lnd2rof') + + if (atm_c2_rof) call prep_rof_calc_a2r_rx(timer='CPL:rofprep_atm2rof') + call prep_rof_mrg(infodata, fractions_rx, timer_mrg='CPL:rofprep_mrgx2r', cime_model=cime_model) + + call component_diag(infodata, rof, flow='x2c', comment= 'send rof', & + info_debug=info_debug, timer_diag='CPL:rofprep_diagav') + + if (drv_threading) call seq_comm_setnthreads(nthreads_GLOID) + call t_drvstopf ('CPL:ROFPREP',cplrun=.true.) + endif + + !---------------------------------------------------- + ! cpl -> rof + !---------------------------------------------------- + if (iamin_CPLALLROFID .and. rof_prognostic) then + call component_exch(rof, flow='x2c', & + infodata=infodata, infodata_string='cpl2rof_run', & + mpicom_barrier=mpicom_CPLALLLNDID, run_barriers=run_barriers, & + timer_barrier='CPL:C2R_BARRIER', timer_comp_exch='CPL:C2R', & + timer_map_exch='CPL:c2r_rofx2rofr', timer_infodata_exch='CPL:c2r_infoexch') + endif + + end subroutine cime_run_rof_setup_send + +!---------------------------------------------------------------------------------- + + subroutine cime_run_rof_recv_post() + + !---------------------------------------------------------- + ! rof -> cpl + !---------------------------------------------------------- + if (iamin_CPLALLROFID) then + call component_exch(rof, flow='c2x', & + infodata=infodata, infodata_string='rof2cpl_run', & + mpicom_barrier=mpicom_CPLALLROFID, run_barriers=run_barriers, & + timer_barrier='CPL:R2C_BARRIER', timer_comp_exch='CPL:R2C', & + timer_map_exch='CPL:r2c_rofr2rofx', timer_infodata_exch='CPL:r2c_infoexch') + endif + + !---------------------------------------------------------- + ! rof post + !---------------------------------------------------------- + if (iamin_CPLID) then + call cime_comp_barriers(mpicom=mpicom_CPLID, timer='CPL:ROFPOST_BARRIER') + call t_drvstartf ('CPL:ROFPOST',cplrun=.true.,barrier=mpicom_CPLID) + if (drv_threading) call seq_comm_setnthreads(nthreads_CPLID) + + call component_diag(infodata, rof, flow='c2x', comment= 'recv rof', & + info_debug=info_debug, timer_diag='CPL:rofpost_diagav') + + if (trim(cpl_seq_option(1:5)) /= 'NUOPC') then + if (rof_c2_lnd) call prep_lnd_calc_r2x_lx(timer='CPL:rofpost_rof2lnd') + if (rof_c2_ice) call prep_ice_calc_r2x_ix(timer='CPL:rofpost_rof2ice') + if (rof_c2_ocn) call prep_ocn_calc_r2x_ox(timer='CPL:rofpost_rof2ocn') + end if + call t_drvstopf ('CPL:ROFPOST', cplrun=.true.) + endif + + end subroutine cime_run_rof_recv_post + +!---------------------------------------------------------------------------------- + + subroutine cime_run_ice_setup_send() + + ! Note that for atm->ice mapping below will leverage the assumption that the + ! ice and ocn are on the same grid and that mapping of atm to ocean is + ! done already for use by atmocn flux and ice model prep + + !---------------------------------------------------- + ! ice prep-merge + !---------------------------------------------------- + if (iamin_CPLID .and. ice_prognostic) then + call cime_comp_barriers(mpicom=mpicom_CPLID, timer='CPL:ICEPREP_BARRIER') + + call t_drvstartf ('CPL:ICEPREP',cplrun=.true.,barrier=mpicom_CPLID) + if (drv_threading) call seq_comm_setnthreads(nthreads_CPLID) + + if (ocn_c2_ice) call prep_ice_calc_o2x_ix(timer='CPL:iceprep_ocn2ice') + if (trim(cpl_seq_option(1:5)) == 'NUOPC') then + if (rof_c2_ice) call prep_ice_calc_r2x_ix(timer='CPL:rofpost_rof2ice') + if (glc_c2_ice) call prep_ice_calc_g2x_ix(timer='CPL:glcpost_glc2ice') + end if + + if (atm_c2_ice) then + ! This is special to avoid remapping atm to ocn + ! Note it is constrained that different prep modules cannot use or call each other + a2x_ox => prep_ocn_get_a2x_ox() ! array + call prep_ice_calc_a2x_ix(a2x_ox, timer='CPL:iceprep_atm2ice') + endif + + call prep_ice_mrg(infodata, timer_mrg='CPL:iceprep_mrgx2i') + + call component_diag(infodata, ice, flow='x2c', comment= 'send ice', & + info_debug=info_debug, timer_diag='CPL:iceprep_diagav') + + if (drv_threading) call seq_comm_setnthreads(nthreads_GLOID) + call t_drvstopf ('CPL:ICEPREP',cplrun=.true.) + endif + + !---------------------------------------------------- + ! cpl -> ice + !---------------------------------------------------- + if (iamin_CPLALLICEID .and. ice_prognostic) then + call component_exch(ice, flow='x2c', & + infodata=infodata, infodata_string='cpl2ice_run', & + mpicom_barrier=mpicom_CPLALLICEID, run_barriers=run_barriers, & + timer_barrier='CPL:C2I_BARRIER', timer_comp_exch='CPL:C2I', & + timer_map_exch='CPL:c2i_icex2icei', timer_infodata_exch='CPL:ice_infoexch') + endif + + end subroutine cime_run_ice_setup_send + +!---------------------------------------------------------------------------------- + + subroutine cime_run_ice_recv_post() + + !---------------------------------------------------------- + ! ice -> cpl + !---------------------------------------------------------- + if (iamin_CPLALLICEID) then + call component_exch(ice, flow='c2x', & + infodata=infodata, infodata_string='ice2cpl_run', & + mpicom_barrier=mpicom_CPLALLICEID, run_barriers=run_barriers, & + timer_barrier='CPL:I2C_BARRIER', timer_comp_exch='CPL:I2C', & + timer_map_exch='CPL:i2c_icei2icex', timer_infodata_exch='CPL:i2c_infoexch') + endif + + !---------------------------------------------------------- + ! ice post + !---------------------------------------------------------- + if (iamin_CPLID) then + call cime_comp_barriers(mpicom=mpicom_CPLID, timer='CPL:ICEPOST_BARRIER') + call t_drvstartf ('CPL:ICEPOST',cplrun=.true.,barrier=mpicom_CPLID) + if (drv_threading) call seq_comm_setnthreads(nthreads_CPLID) + + call component_diag(infodata, ice, flow='c2x', comment= 'recv ice', & + info_debug=info_debug, timer_diag='CPL:icepost_diagav') + + if (drv_threading) call seq_comm_setnthreads(nthreads_GLOID) + call t_drvstopf ('CPL:ICEPOST',cplrun=.true.) + endif + + end subroutine cime_run_ice_recv_post + +!---------------------------------------------------------------------------------- + + subroutine cime_run_wav_setup_send() + + !---------------------------------------------------------- + ! wav prep-merge + !---------------------------------------------------------- + if (iamin_CPLID .and. wav_prognostic) then + call cime_comp_barriers(mpicom=mpicom_CPLID, timer='CPL:WAVPREP_BARRIER') + + call t_drvstartf ('CPL:WAVPREP',cplrun=.true.,barrier=mpicom_CPLID) + if (drv_threading) call seq_comm_setnthreads(nthreads_CPLID) + + if (atm_c2_wav) call prep_wav_calc_a2x_wx(timer='CPL:wavprep_atm2wav') + if (ocn_c2_wav) call prep_wav_calc_o2x_wx(timer='CPL:wavprep_ocn2wav') + if (ice_c2_wav) call prep_wav_calc_i2x_wx(timer='CPL:wavprep_ice2wav') + + call prep_wav_mrg(infodata, fractions_wx, timer_mrg='CPL:wavprep_mrgx2w') + + call component_diag(infodata, wav, flow='x2c', comment= 'send wav', & + info_debug=info_debug, timer_diag='CPL:wavprep_diagav') + + if (drv_threading) call seq_comm_setnthreads(nthreads_GLOID) + call t_drvstopf ('CPL:WAVPREP',cplrun=.true.) + endif + + !---------------------------------------------------------- + ! cpl -> wav + !---------------------------------------------------------- + if (iamin_CPLALLWAVID .and. wav_prognostic) then + call component_exch(wav, flow='x2c', & + infodata=infodata, infodata_string='cpl2wav_run', & + mpicom_barrier=mpicom_CPLALLWAVID, run_barriers=run_barriers, & + timer_barrier='CPL:C2W_BARRIER', timer_comp_exch='CPL:C2W', & + timer_map_exch='CPL:c2w_wavx2wavw', timer_infodata_exch='CPL:c2w_infoexch') + endif + + end subroutine cime_run_wav_setup_send + +!---------------------------------------------------------------------------------- + + subroutine cime_run_wav_recv_post() + + !---------------------------------------------------------- + ! wav -> cpl + !---------------------------------------------------------- + if (iamin_CPLALLWAVID) then + call component_exch(wav, flow='c2x', infodata=infodata, infodata_string='wav2cpl_run', & + mpicom_barrier=mpicom_CPLALLWAVID, run_barriers=run_barriers, & + timer_barrier='CPL:W2C_BARRIER', timer_comp_exch='CPL:W2C', & + timer_map_exch='CPL:w2c_wavw2wavx', timer_infodata_exch='CPL:w2c_infoexch') + endif + + !---------------------------------------------------------- + ! wav post + !---------------------------------------------------------- + if (iamin_CPLID) then + call cime_comp_barriers(mpicom=mpicom_CPLID, timer='CPL:WAVPOST_BARRIER') + call t_drvstartf ('CPL:WAVPOST',cplrun=.true.,barrier=mpicom_CPLID) + if (drv_threading) call seq_comm_setnthreads(nthreads_CPLID) + + call component_diag(infodata, wav, flow='c2x', comment= 'recv wav', & + info_debug=info_debug, timer_diag='CPL:wavpost_diagav') + + if (drv_threading) call seq_comm_setnthreads(nthreads_GLOID) + call t_drvstopf ('CPL:WAVPOST',cplrun=.true.) + endif + + end subroutine cime_run_wav_recv_post + +!---------------------------------------------------------------------------------- + + subroutine cime_run_update_fractions() + + if (iamin_CPLID) then + call cime_comp_barriers(mpicom=mpicom_CPLID, timer='CPL:FRACSET_BARRIER') + call t_drvstartf ('CPL:FRACSET',cplrun=.true.,barrier=mpicom_CPLID) + if (drv_threading) call seq_comm_setnthreads(nthreads_CPLID) + call t_drvstartf ('CPL:fracset_fracset',barrier=mpicom_CPLID) + + do efi = 1,num_inst_frc + eii = mod((efi-1),num_inst_ice) + 1 + call seq_frac_set(infodata, ice(eii), fractions_ax(efi), fractions_ix(efi), fractions_ox(efi)) + enddo + call t_drvstopf ('CPL:fracset_fracset') + + if (drv_threading) call seq_comm_setnthreads(nthreads_GLOID) + call t_drvstopf ('CPL:FRACSET',cplrun=.true.) + endif + + end subroutine cime_run_update_fractions + +!---------------------------------------------------------------------------------- + + subroutine cime_run_calc_budgets1() + + !---------------------------------------------------------- + ! Budget with old fractions + !---------------------------------------------------------- + + ! WJS (2-17-11): I am just using the first instance for the budgets because we + ! don't expect budgets to be conserved for our case (I case). Also note that we + ! don't expect budgets to be conserved for the interactive ensemble use case either. + ! tcraig (aug 2012): put this after rof->cpl so the budget sees the new r2x_rx. + ! it will also use the current r2x_ox here which is the value from the last timestep + ! consistent with the ocean coupling + + if (iamin_CPLID) then + call cime_comp_barriers(mpicom=mpicom_CPLID, timer='CPL:BUDGET1_BARRIER') + call t_drvstartf ('CPL:BUDGET1',cplrun=.true.,budget=.true.,barrier=mpicom_CPLID) + if (lnd_present) then + call seq_diag_lnd_mct(lnd(ens1), fractions_lx(ens1), infodata, do_l2x=.true., do_x2l=.true.) + endif + if (rof_present) then + call seq_diag_rof_mct(rof(ens1), fractions_rx(ens1), infodata) + endif + if (ice_present) then + call seq_diag_ice_mct(ice(ens1), fractions_ix(ens1), infodata, do_x2i=.true.) + endif + call t_drvstopf ('CPL:BUDGET1',cplrun=.true.,budget=.true.) + end if + end subroutine cime_run_calc_budgets1 + +!---------------------------------------------------------------------------------- + + subroutine cime_run_calc_budgets2() + + !---------------------------------------------------------- + ! Budget with new fractions + !---------------------------------------------------------- + + if (iamin_CPLID) then + call cime_comp_barriers(mpicom=mpicom_CPLID, timer='CPL:BUDGET2_BARRIER') + + call t_drvstartf ('CPL:BUDGET2',cplrun=.true.,budget=.true.,barrier=mpicom_CPLID) + if (atm_present) then + call seq_diag_atm_mct(atm(ens1), fractions_ax(ens1), infodata, do_a2x=.true., do_x2a=.true.) + endif + if (ice_present) then + call seq_diag_ice_mct(ice(ens1), fractions_ix(ens1), infodata, do_i2x=.true.) + endif + call t_drvstopf ('CPL:BUDGET2',cplrun=.true.,budget=.true.) + + call t_drvstartf ('CPL:BUDGET3',cplrun=.true.,budget=.true.,barrier=mpicom_CPLID) + call seq_diag_accum_mct() + call t_drvstopf ('CPL:BUDGET3',cplrun=.true.,budget=.true.) + + call t_drvstartf ('CPL:BUDGETF',cplrun=.true.,budget=.true.,barrier=mpicom_CPLID) + if (.not. dead_comps) then + call seq_diag_print_mct(EClock_d,stop_alarm,budget_inst, & + budget_daily, budget_month, budget_ann, budget_ltann, & + budget_ltend, infodata) + endif + call seq_diag_zero_mct(EClock=EClock_d) + + call t_drvstopf ('CPL:BUDGETF',cplrun=.true.,budget=.true.) + end if + end subroutine cime_run_calc_budgets2 + +!---------------------------------------------------------------------------------- + + subroutine cime_run_calc_budgets3() + + !---------------------------------------------------------- + ! ocn budget (rasm_option2) + !---------------------------------------------------------- + + if (iamin_CPLID) then + call cime_comp_barriers(mpicom=mpicom_CPLID, timer='CPL:BUDGET0_BARRIER') + call t_drvstartf ('CPL:BUDGET0',cplrun=.true.,budget=.true.,barrier=mpicom_CPLID) + xao_ox => prep_aoflux_get_xao_ox() ! array over all instances + call seq_diag_ocn_mct(ocn(ens1), xao_ox(1), fractions_ox(ens1), infodata, & + do_o2x=.true., do_x2o=.true., do_xao=.true.) + call t_drvstopf ('CPL:BUDGET0',cplrun=.true.,budget=.true.) + end if + end subroutine cime_run_calc_budgets3 + +!---------------------------------------------------------------------------------- + + subroutine cime_run_write_history() + + !---------------------------------------------------------- + ! Write history file, only AVs on CPLID + !---------------------------------------------------------- + + if (iamin_CPLID) then + + call cime_comp_barriers(mpicom=mpicom_CPLID, timer='CPL:HISTORY_BARRIER') + call t_drvstartf ('CPL:HISTORY',cplrun=.true.,barrier=mpicom_CPLID) + if ( history_alarm) then + if (drv_threading) call seq_comm_setnthreads(nthreads_CPLID) + if (iamroot_CPLID) then + write(logunit,104) ' Write history file at ',ymd,tod + call shr_sys_flush(logunit) + endif + + call seq_hist_write(infodata, EClock_d, & + atm, lnd, ice, ocn, rof, glc, wav, iac, & + fractions_ax, fractions_lx, fractions_ix, fractions_ox, & + fractions_rx, fractions_gx, fractions_wx, fractions_zx, trim(cpl_inst_tag)) + + if (drv_threading) call seq_comm_setnthreads(nthreads_GLOID) + endif + + if (do_histavg) then + call seq_hist_writeavg(infodata, EClock_d, & + atm, lnd, ice, ocn, rof, glc, wav, iac, histavg_alarm, & + trim(cpl_inst_tag)) + endif + + call t_drvstopf ('CPL:HISTORY',cplrun=.true.) + + end if + +104 format( A, i10.8, i8) + end subroutine cime_run_write_history + +!---------------------------------------------------------------------------------- + + subroutine cime_run_write_restart(drv_pause, write_restart, drv_resume) + + !---------------------------------------------------------- + ! Write driver restart file + !---------------------------------------------------------- + + logical , intent(in) :: drv_pause + logical , intent(in) :: write_restart + character(len=*), intent(inout) :: drv_resume ! Driver resets state from restart file + +103 format( 5A ) +104 format( A, i10.8, i8) + + if (iamin_CPLID) then + if ( (restart_alarm .or. drv_pause)) then + call cime_comp_barriers(mpicom=mpicom_CPLID, timer='CPL:RESTART_BARRIER') + call t_drvstartf ('CPL:RESTART',cplrun=.true.,barrier=mpicom_CPLID) + if (drv_threading) call seq_comm_setnthreads(nthreads_CPLID) + if (iamroot_CPLID) then + write(logunit,104) ' Write restart file at ',ymd,tod + call shr_sys_flush(logunit) + endif + + call seq_rest_write(EClock_d, seq_SyncClock, infodata, & + atm, lnd, ice, ocn, rof, glc, wav, esp, iac, & + fractions_ax, fractions_lx, fractions_ix, fractions_ox, & + fractions_rx, fractions_gx, fractions_wx, fractions_zx, & + trim(cpl_inst_tag), drv_resume) + + if (iamroot_CPLID) then + write(logunit,103) ' Restart filename: ',trim(drv_resume) + call shr_sys_flush(logunit) + endif + + if (drv_threading) call seq_comm_setnthreads(nthreads_GLOID) + call t_drvstopf ('CPL:RESTART',cplrun=.true.) + else + drv_resume = '' + endif + end if + + end subroutine cime_run_write_restart + +!---------------------------------------------------------------------------------- + + subroutine cime_write_performance_checkpoint(output_ckpt, ckpt_filename, & + ckpt_mpicom) + + !---------------------------------------------------------- + ! Checkpoint performance data + !---------------------------------------------------------- + + logical, intent(in) :: output_ckpt + character(len=*), intent(in) :: ckpt_filename + integer, intent(in) :: ckpt_mpicom + +103 format( 5A ) +104 format( A, i10.8, i8) + + call t_adj_detailf(+1) + + call t_startf("sync1_tprf") + call mpi_barrier(ckpt_mpicom,ierr) + call t_stopf("sync1_tprf") + + if (output_ckpt) then + call t_prf(filename=trim(ckpt_filename), mpicom=ckpt_mpicom, & + num_outpe=0, output_thispe=output_ckpt) + else + call t_prf(filename=trim(ckpt_filename), mpicom=ckpt_mpicom, & + num_outpe=0) + endif + + call t_startf("sync2_tprf") + call mpi_barrier(ckpt_mpicom,ierr) + call t_stopf("sync2_tprf") + + call t_adj_detailf(-1) + + end subroutine cime_write_performance_checkpoint + end module cime_comp_mod diff --git a/driver-moab/main/component_mod.F90 b/driver-moab/main/component_mod.F90 index 8b1c3bb6a1d7..e8104e59560f 100644 --- a/driver-moab/main/component_mod.F90 +++ b/driver-moab/main/component_mod.F90 @@ -27,7 +27,7 @@ module component_mod use seq_map_mod use t_drv_timers_mod use component_type_mod - use seq_cdata_mod, only : seq_cdata + use seq_cdata_mod, only : seq_cdata, seq_cdata_init use mct_mod ! mct_ wrappers for mct lib use perf_mod use ESMF @@ -91,8 +91,9 @@ subroutine component_init_pre(comp, compid, cplcompid, cplallcompid, & character(len=3) , intent(in) :: ntype ! ! Local Variables + logical :: flag + integer :: ierr integer :: eci ! index - character(len=cl), allocatable :: comp_resume(:) ! Set if comp needs post-DA process character(*), parameter :: subname = '(component_init_pre)' !--------------------------------------------------------------- @@ -104,7 +105,6 @@ subroutine component_init_pre(comp, compid, cplcompid, cplallcompid, & iamin_CPLID = seq_comm_iamin(CPLID) ! Initialize component type variables - allocate(comp_resume(size(comp))) do eci = 1,size(comp) comp(eci)%compid = compid(eci) @@ -123,7 +123,15 @@ subroutine component_init_pre(comp, compid, cplcompid, cplallcompid, & comp(eci)%suffix = seq_comm_suffix(comp(eci)%compid) comp(eci)%name = seq_comm_name (comp(eci)%compid) comp(eci)%ntype = ntype(1:3) - comp(eci)%oneletterid = ntype(1:1) + + select case(ntype) + case ('atm','cpl','ocn','wav','glc','ice','rof','lnd','esp') + comp(eci)%oneletterid = ntype(1:1) + case ('iac') + comp(eci)%oneletterid = 'z' + case default + call shr_sys_abort(subname//': ntype, "'//ntype//'" not recognized"') + end select if (eci == 1) then allocate(comp(1)%dom_cx) @@ -137,61 +145,43 @@ subroutine component_init_pre(comp, compid, cplcompid, cplallcompid, & allocate(comp(eci)%dom_cc) allocate(comp(eci)%gsmap_cc) allocate(comp(eci)%cdata_cc) - comp(eci)%cdata_cc%name = 'cdata_'//ntype(1:1)//ntype(1:1) - comp(eci)%cdata_cc%ID = comp(eci)%compid - comp(eci)%cdata_cc%mpicom = comp(eci)%mpicom_compid - comp(eci)%cdata_cc%dom => comp(eci)%dom_cc - comp(eci)%cdata_cc%gsmap => comp(eci)%gsmap_cc - comp(eci)%cdata_cc%infodata => infodata - - ! Does this component need to do post-data assimilation processing? - if (seq_timemgr_data_assimilation_active(ntype(1:3))) then - comp_resume(:) = 'TRUE' - else - comp_resume(:) = '' - end if + call seq_cdata_init(comp(eci)%cdata_cc, comp(eci)%compid, & + 'cdata_'//ntype(1:1)//ntype(1:1), comp(eci)%dom_cc, & + comp(eci)%gsmap_cc, infodata, seq_timemgr_data_assimilation_active(ntype(1:3))) ! Determine initial value of comp_present in infodata - to do - add this to component #ifdef CPRPGI if (comp(1)%oneletterid == 'a') then call seq_infodata_getData(infodata, atm_present=comp(eci)%present) - call seq_infodata_PutData(infodata, atm_resume=comp_resume) end if if (comp(1)%oneletterid == 'l') then call seq_infodata_getData(infodata, lnd_present=comp(eci)%present) - call seq_infodata_PutData(infodata, lnd_resume=comp_resume) end if if (comp(1)%oneletterid == 'i') then call seq_infodata_getData(infodata, ice_present=comp(eci)%present) - call seq_infodata_PutData(infodata, ice_resume=comp_resume) end if if (comp(1)%oneletterid == 'o') then call seq_infodata_getData(infodata, ocn_present=comp(eci)%present) - call seq_infodata_PutData(infodata, ocn_resume=comp_resume) end if if (comp(1)%oneletterid == 'r') then call seq_infodata_getData(infodata, rof_present=comp(eci)%present) - call seq_infodata_PutData(infodata, rof_resume=comp_resume) end if if (comp(1)%oneletterid == 'g') then call seq_infodata_getData(infodata, glc_present=comp(eci)%present) - call seq_infodata_PutData(infodata, glc_resume=comp_resume) end if if (comp(1)%oneletterid == 'w') then call seq_infodata_getData(infodata, wav_present=comp(eci)%present) - call seq_infodata_PutData(infodata, wav_resume=comp_resume) end if if (comp(1)%oneletterid == 'e') then call seq_infodata_getData(infodata, esp_present=comp(eci)%present) end if + if (comp(1)%oneletterid == 'z') then + call seq_infodata_getData(infodata, iac_present=comp(eci)%present) + end if #else call seq_infodata_getData(comp(1)%oneletterid, infodata, comp_present=comp(eci)%present) - - ! Does this component need to do post-data assimilation processing? - call seq_infodata_PutData(comp(1)%oneletterid, infodata, comp_resume=comp_resume) #endif end do - deallocate(comp_resume) end subroutine component_init_pre @@ -298,6 +288,7 @@ end subroutine comp_init if (comp(1)%oneletterid == 'g') call seq_infodata_getData(infodata, glc_present=comp(eci)%present) if (comp(1)%oneletterid == 'w') call seq_infodata_getData(infodata, wav_present=comp(eci)%present) if (comp(1)%oneletterid == 'e') call seq_infodata_getData(infodata, esp_present=comp(eci)%present) + if (comp(1)%oneletterid == 'z') call seq_infodata_getData(infodata, iac_present=comp(eci)%present) #else call seq_infodata_getData(comp(1)%oneletterid, infodata, comp_present=comp(eci)%present) #endif @@ -345,6 +336,7 @@ subroutine component_init_cx(comp, infodata) ! Local Variables integer :: eci integer :: rc ! return code + integer :: mpi_tag type(mct_gGrid) :: dom_tmp ! temporary character(*), parameter :: subname = '(component_init_cx)' character(*), parameter :: F0I = "('"//subname//" : ', A, 2i8 )" @@ -404,7 +396,14 @@ subroutine component_init_cx(comp, infodata) call shr_sys_flush(logunit) end if call seq_mctext_gGridInit(comp(1)) - call seq_map_map_exchange(comp(1), flow='c2x', dom_flag=.true., msgtag=comp(1)%cplcompid*10000+1*10+1) + + if (size(comp) > 1) then + mpi_tag = comp(eci)%cplcompid*100+eci*10+1 + else + mpi_tag = comp(eci)%cplcompid*10000+eci*10+1 + end if + call seq_map_map_exchange(comp(1), flow='c2x', dom_flag=.true., msgtag=mpi_tag) + else if (eci > 1) then if (iamroot_CPLID) then write(logunit,F0I) 'comparing comp domain ensemble number ',eci @@ -577,6 +576,7 @@ subroutine component_init_areacor(comp, samegrid, seq_flds_c2x_fluxes) ! ! Local Variables integer :: eci, num_inst + integer :: mpi_tag character(*), parameter :: subname = '(component_init_areacor)' !--------------------------------------------------------------- @@ -587,8 +587,12 @@ subroutine component_init_areacor(comp, samegrid, seq_flds_c2x_fluxes) if (comp(eci)%iamin_cplcompid) then ! Map component domain from coupler to component processes - call seq_map_map(comp(eci)%mapper_Cx2c, comp(eci)%dom_cx%data, & - comp(eci)%dom_cc%data, msgtag=comp(eci)%cplcompid*10000+eci*10+5) + if ( num_inst > 1) then + mpi_tag = comp(eci)%cplcompid*100+eci*10+5 + else + mpi_tag = comp(eci)%cplcompid*10000+eci*10+5 + end if + call seq_map_map(comp(eci)%mapper_Cx2c, comp(eci)%dom_cx%data, comp(eci)%dom_cc%data, msgtag=mpi_tag) ! For only component pes if (comp(eci)%iamin_compid) then @@ -606,8 +610,12 @@ subroutine component_init_areacor(comp, samegrid, seq_flds_c2x_fluxes) endif ! Map corrected initial component AVs from component to coupler pes - call seq_map_map(comp(eci)%mapper_cc2x, comp(eci)%c2x_cc, & - comp(eci)%c2x_cx, msgtag=comp(eci)%cplcompid*10000+eci*10+7) + if (num_inst > 1) then + mpi_tag = comp(eci)%cplcompid*100+eci*10+7 + else + mpi_tag = comp(eci)%cplcompid*10000+eci*10+7 + end if + call seq_map_map(comp(eci)%mapper_cc2x, comp(eci)%c2x_cc, comp(eci)%c2x_cx, msgtag=mpi_tag) endif enddo @@ -699,6 +707,7 @@ end subroutine comp_run if (comp(1)%oneletterid == 'g') call seq_infodata_putData(infodata, glc_phase=phase) if (comp(1)%oneletterid == 'w') call seq_infodata_putData(infodata, wav_phase=phase) if (comp(1)%oneletterid == 'e') call seq_infodata_putData(infodata, esp_phase=phase) + if (comp(1)%oneletterid == 'z') call seq_infodata_putData(infodata, iac_phase=phase) #else call seq_infodata_putData(comp(1)%oneletterid, infodata, comp_phase=phase) #endif @@ -841,6 +850,7 @@ subroutine component_exch(comp, flow, infodata, infodata_string, & ! Local Variables integer :: eci integer :: ierr + integer :: mpi_tag character(*), parameter :: subname = '(component_exch)' !--------------------------------------------------------------- @@ -865,11 +875,19 @@ subroutine component_exch(comp, flow, infodata, infodata_string, & end if if (flow == 'x2c') then ! coupler to component - call seq_map_map(comp(eci)%mapper_Cx2c, comp(eci)%x2c_cx, comp(eci)%x2c_cc, & - msgtag=comp(eci)%cplcompid*10000+eci*10+2) + if ( size(comp) > 1) then + mpi_tag = comp(eci)%cplcompid*100+eci*10+2 + else + mpi_tag = comp(eci)%cplcompid*10000+eci*10+2 + end if + call seq_map_map(comp(eci)%mapper_Cx2c, comp(eci)%x2c_cx, comp(eci)%x2c_cc, msgtag=mpi_tag) else if (flow == 'c2x') then ! component to coupler - call seq_map_map(comp(eci)%mapper_Cc2x, comp(eci)%c2x_cc, comp(eci)%c2x_cx, & - msgtag=comp(eci)%cplcompid*10000+eci*10+4) + if ( size(comp) > 1) then + mpi_tag = comp(eci)%cplcompid*100+eci*10+4 + else + mpi_tag = comp(eci)%cplcompid*10000+eci*10+4 + end if + call seq_map_map(comp(eci)%mapper_Cc2x, comp(eci)%c2x_cc, comp(eci)%c2x_cx, msgtag=mpi_tag) end if if (present(timer_map_exch)) then diff --git a/driver-moab/main/component_type_mod.F90 b/driver-moab/main/component_type_mod.F90 index e00d8d6f607e..ff88580db8de 100644 --- a/driver-moab/main/component_type_mod.F90 +++ b/driver-moab/main/component_type_mod.F90 @@ -12,7 +12,7 @@ module component_type_mod use seq_comm_mct , only: seq_comm_namelen use seq_comm_mct , only: num_inst_atm, num_inst_lnd, num_inst_rof use seq_comm_mct , only: num_inst_ocn, num_inst_ice, num_inst_glc - use seq_comm_mct , only: num_inst_wav, num_inst_esp + use seq_comm_mct , only: num_inst_wav, num_inst_esp, num_inst_iac use mct_mod use seq_comm_mct , only: CPLID use seq_comm_mct , only: seq_comm_getinfo => seq_comm_setptrs @@ -97,7 +97,6 @@ module component_type_mod logical :: iamroot_compid logical :: present ! true => component is present and not stub integer :: nthreads_compid - integer :: instn character(len=CL) :: suffix character(len=1) :: oneletterid character(len=3) :: ntype @@ -118,8 +117,9 @@ module component_type_mod type(component_type), target :: glc(num_inst_glc) type(component_type), target :: wav(num_inst_wav) type(component_type), target :: esp(num_inst_esp) + type(component_type), target :: iac(num_inst_iac) - public :: atm, lnd, rof, ocn, ice, glc, wav, esp + public :: atm, lnd, rof, ocn, ice, glc, wav, esp, iac !=============================================================================== diff --git a/driver-moab/main/prep_atm_mod.F90 b/driver-moab/main/prep_atm_mod.F90 index 1bc5c0cef8b2..bd1a50b00ed7 100644 --- a/driver-moab/main/prep_atm_mod.F90 +++ b/driver-moab/main/prep_atm_mod.F90 @@ -42,10 +42,12 @@ module prep_atm_mod public :: prep_atm_get_l2x_ax public :: prep_atm_get_i2x_ax public :: prep_atm_get_o2x_ax + public :: prep_atm_get_z2x_ax public :: prep_atm_calc_l2x_ax public :: prep_atm_calc_i2x_ax public :: prep_atm_calc_o2x_ax + public :: prep_atm_calc_z2x_ax public :: prep_atm_get_mapper_So2a public :: prep_atm_get_mapper_Fo2a @@ -78,6 +80,7 @@ module prep_atm_mod type(mct_aVect), pointer :: l2x_ax(:) ! Lnd export, atm grid, cpl pes - allocated in driver type(mct_aVect), pointer :: i2x_ax(:) ! Ice export, atm grid, cpl pes - allocated in driver type(mct_aVect), pointer :: o2x_ax(:) ! Ocn export, atm grid, cpl pes - allocated in driver + type(mct_aVect), pointer :: z2x_ax(:) ! Iac export, atm grid, cpl pes - allocated in driver ! other module variables integer :: mpicom_CPLID ! MPI cpl communicator @@ -91,7 +94,7 @@ module prep_atm_mod !================================================================================================ - subroutine prep_atm_init(infodata, ocn_c2_atm, ice_c2_atm, lnd_c2_atm) + subroutine prep_atm_init(infodata, ocn_c2_atm, ice_c2_atm, lnd_c2_atm, iac_c2_atm) !--------------------------------------------------------------- ! Description @@ -102,6 +105,7 @@ subroutine prep_atm_init(infodata, ocn_c2_atm, ice_c2_atm, lnd_c2_atm) logical , intent(in) :: ocn_c2_atm ! .true. => ocn to atm coupling on logical , intent(in) :: ice_c2_atm ! .true. => ice to atm coupling on logical , intent(in) :: lnd_c2_atm ! .true. => lnd to atm coupling on + logical , intent(in) :: iac_c2_atm ! .true. => iac to atm coupling on ! ! Local Variables integer :: lsize_a @@ -1046,6 +1050,21 @@ end subroutine prep_atm_calc_l2x_ax !================================================================================================ + subroutine prep_atm_calc_z2x_ax(fractions_zx, timer) + !--------------------------------------------------------------- + ! Description + ! Create z2x_ax (note that z2x_ax is a local module variable) + ! + ! Arguments + type(mct_aVect) , intent(in) :: fractions_zx(:) + character(len=*), intent(in) :: timer + ! + ! Local Variables + + end subroutine prep_atm_calc_z2x_ax + + !================================================================================================ + function prep_atm_get_l2x_ax() type(mct_aVect), pointer :: prep_atm_get_l2x_ax(:) prep_atm_get_l2x_ax => l2x_ax(:) @@ -1061,6 +1080,11 @@ function prep_atm_get_o2x_ax() prep_atm_get_o2x_ax => o2x_ax(:) end function prep_atm_get_o2x_ax + function prep_atm_get_z2x_ax() + type(mct_aVect), pointer :: prep_atm_get_z2x_ax(:) + prep_atm_get_z2x_ax => z2x_ax(:) + end function prep_atm_get_z2x_ax + function prep_atm_get_mapper_So2a() type(seq_map), pointer :: prep_atm_get_mapper_So2a prep_atm_get_mapper_So2a => mapper_So2a diff --git a/driver-moab/main/prep_iac_mod.F90 b/driver-moab/main/prep_iac_mod.F90 new file mode 120000 index 000000000000..fd46637f052b --- /dev/null +++ b/driver-moab/main/prep_iac_mod.F90 @@ -0,0 +1 @@ +../../mct/main/prep_iac_mod.F90 \ No newline at end of file diff --git a/driver-moab/shr/seq_pauseresume_mod.F90 b/driver-moab/shr/seq_pauseresume_mod.F90 new file mode 120000 index 000000000000..925e00b1fd1a --- /dev/null +++ b/driver-moab/shr/seq_pauseresume_mod.F90 @@ -0,0 +1 @@ +../../mct/shr/seq_pauseresume_mod.F90 \ No newline at end of file From 8ab328f29b45c55b10143244c5101d6dd3228d19 Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Tue, 2 Jun 2020 11:34:10 -0500 Subject: [PATCH 048/467] remove nets and nete from list of params *********1*********2*********3*********4*********5*********6*********7** * remove nets and nete from moab api call; use nelemd * ierr defined twice in HAVE_MOAB case [BFB] - Bit-For-Bit --- components/eam/src/dynamics/se/dyn_comp.F90 | 2 +- .../homme/src/share/prim_driver_base.F90 | 9 +---- components/homme/src/tool/semoab_mod.F90 | 39 +++++++++---------- 3 files changed, 20 insertions(+), 30 deletions(-) diff --git a/components/eam/src/dynamics/se/dyn_comp.F90 b/components/eam/src/dynamics/se/dyn_comp.F90 index 2b8570dd3638..77c299eac4ea 100644 --- a/components/eam/src/dynamics/se/dyn_comp.F90 +++ b/components/eam/src/dynamics/se/dyn_comp.F90 @@ -119,7 +119,7 @@ subroutine dyn_init1(fh, NLFileName, dyn_in, dyn_out) #ifdef HAVE_MOAB integer, external :: iMOAB_RegisterFortranApplication - integer :: ierr, ATM_ID1 + integer :: ATM_ID1 character*32 appname #endif diff --git a/components/homme/src/share/prim_driver_base.F90 b/components/homme/src/share/prim_driver_base.F90 index c3830562d33e..d84a9be2bd95 100644 --- a/components/homme/src/share/prim_driver_base.F90 +++ b/components/homme/src/share/prim_driver_base.F90 @@ -707,14 +707,7 @@ subroutine prim_init1_buffers (elem,par) integer :: edgesz, sendsz, recvsz, n, den #ifdef HAVE_MOAB - allocate(dom_mt(0:hthreads-1)) - do ith=0,hthreads-1 - dom_mt(ith)=decompose(1,nelemd,hthreads,ith) - end do - ith=0 - nets=1 - nete=nelemd - call create_moab_mesh_fine(par, elem, nets, nete) + call create_moab_mesh_fine(par, elem) #endif call prim_advance_init1(par,elem,integration) diff --git a/components/homme/src/tool/semoab_mod.F90 b/components/homme/src/tool/semoab_mod.F90 index 100e307c16ec..e32b3c064508 100644 --- a/components/homme/src/tool/semoab_mod.F90 +++ b/components/homme/src/tool/semoab_mod.F90 @@ -9,7 +9,7 @@ module semoab_mod ! use edge_mod, only : ghostbuffertr_t, initghostbufferTR, freeghostbuffertr, & ! ghostVpack, ghostVunpack, edgebuffer_t, initEdgebuffer - use dimensions_mod, only: nelem, ne, np, nlev + use dimensions_mod, only: nelem, ne, np, nelemd, nlev use element_mod, only : element_t use parallel_mod, only : parallel_t @@ -30,17 +30,14 @@ module semoab_mod contains - subroutine create_moab_mesh_fine(par, elem, nets, nete) + subroutine create_moab_mesh_fine(par, elem) use ISO_C_BINDING use coordinate_systems_mod, only : cartesian3D_t, spherical_to_cart - type (element_t), intent(inout) :: elem(:) + type (element_t), intent(inout) :: elem(:) type (parallel_t) , intent(in) :: par - integer, intent(in) :: nets ! starting thread element number (private) - integer, intent(in) :: nete - integer ierr, i, j, ie, iv, block_ID, k, numvals integer icol, irow, je, linx ! local indices in fine el connect @@ -91,21 +88,21 @@ subroutine create_moab_mesh_fine(par, elem, nets, nete) enddo local_map(np, np) = ((np-1)*(np-1)-1)*4 + 3 - nelemd2 = (nete-nets+1)*(np-1)*(np-1) - moab_dim_cquads = (nete-nets+1)*4*(np-1)*(np-1) + nelemd2 = (nelemd)*(np-1)*(np-1) + moab_dim_cquads = (nelemd)*4*(np-1)*(np-1) if(par%masterproc) then - write (iulog, *) " MOAB: semoab_mod module: create_moab_mesh_fine; on processor " , par%rank ," elements: " , nets, nete + write (iulog, *) " MOAB: semoab_mod module: create_moab_mesh_fine; on processor " , par%rank ," elements: " , 1, nelemd endif allocate(gdofv(moab_dim_cquads)) allocate(elemids(nelemd2)) k=0 ! will be the index for element global dofs - do ie=nets,nete + do ie=1,nelemd do j=1,np-1 do i=1,np-1 - ix = (ie-nets)*(np-1)*(np-1)+(j-1)*(np-1)+i-1 + ix = (ie-1)*(np-1)*(np-1)+(j-1)*(np-1)+i-1 gdofv(ix*4+1) = elem(ie)%gdofP(i,j) gdofv(ix*4+2) = elem(ie)%gdofP(i+1,j) gdofv(ix*4+3) = elem(ie)%gdofP(i+1,j+1) @@ -149,7 +146,7 @@ subroutine create_moab_mesh_fine(par, elem, nets, nete) do ix=1,moab_dim_cquads idx = indx(ix) ! index in initial array, vertices in all fine quads k = (idx-1)/(4*(np-1)*(np-1)) ! index of coarse quad, locally, starts at 0 - ie = nets + k ! this is the element number; starts at nets + ie = 1 + k ! this is the element number; starts at nets=1 je = ( idx -1 -k*(np-1)*(np-1)*4 ) / 4 + 1 ! local fine quad in coarse, 1 to (np-1) ^ 2 irow = (je-1)/(np-1)+1 icol = je - (np-1)*(irow-1) @@ -221,7 +218,7 @@ subroutine create_moab_mesh_fine(par, elem, nets, nete) ierr = iMOAB_DefineTagStorage(MHFID, newtagg, tagtype, numco, tagindex ) if (ierr > 0 ) & call endrun('Error: fail to create new GDOF tag') - do ie=nets,nete + do ie=1,nelemd do ii=1,elem(ie)%idxp%NumUniquePts i=elem(ie)%idxp%ia(ii) j=elem(ie)%idxp%ja(ii) @@ -289,13 +286,13 @@ subroutine create_moab_mesh_fine(par, elem, nets, nete) ! now create the coarse mesh, but the global dofs will come from fine mesh, after solving - nelemd2 = nete-nets+1 - moab_dim_cquads = (nete-nets+1)*4 + nelemd2 = nelemd + moab_dim_cquads = (nelemd)*4 allocate(gdofel(nelemd2*np*np)) k=0 ! will be the index for element global dofs - do ie=nets,nete - ix = ie-nets + do ie=1,nelemd + ix = ie-1 ! gdofv(ix*4+1) = elem(ie)%gdofP(1,1) gdofv(ix*4+2) = elem(ie)%gdofP(np,1) @@ -336,7 +333,7 @@ subroutine create_moab_mesh_fine(par, elem, nets, nete) do ix=1,moab_dim_cquads i = indx(ix) ! index in initial array - ie = nets+ (i-1)/4 ! this is the element number + ie = 1+ (i-1)/4 ! this is the element number j = i - ( i-1)/4*4 ! local index of vertex in element i iv = moabvh_c(ix) if (vdone_c(iv) .eq. 0) then @@ -354,7 +351,7 @@ subroutine create_moab_mesh_fine(par, elem, nets, nete) if (ierr > 0 ) & call endrun('Error: fail to create MOAB vertices ') - num_el = nete-nets+1 + num_el = nelemd mbtype = 3 ! quadrilateral nve = 4; block_ID = 100 ! this will be for coarse mesh @@ -380,7 +377,7 @@ subroutine create_moab_mesh_fine(par, elem, nets, nete) ierr = iMOAB_SetIntTagStorage ( MHID, tagname, nverts_c , ent_type, vdone_c) if (ierr > 0 ) & call endrun('Error: fail to set GDOFV tag for vertices') - ! set global id tag for coarse elements, too; they will start at nets, end at nete + ! set global id tag for coarse elements, too; they will start at nets=1, end at nete=nelemd ent_type = 1 ! now set the global id tag on elements ierr = iMOAB_SetIntTagStorage ( MHID, newtagg, nelemd2 , ent_type, elemids) if (ierr > 0 ) & @@ -398,7 +395,7 @@ subroutine create_moab_mesh_fine(par, elem, nets, nete) if (ierr > 0 ) & call endrun('Error: fail to create global DOFS tag') ! now set the values - ! set global dofs tag for coarse elements, too; they will start at nets, end at nete + ! set global dofs tag for coarse elements, too; they will start at nets=1, end at nete=nelemd ent_type = 1 ! now set the global id tag on elements numvals = nelemd2*np*np ! input is the total number of values ! form gdofel from vgids From 77ed47678a31a5e218af6a36e333ffc242c9722f Mon Sep 17 00:00:00 2001 From: Jason Sarich Date: Tue, 2 Jun 2020 15:35:51 -0500 Subject: [PATCH 049/467] some cmake fixes --- components/cmake/common_setup.cmake | 12 ++++++------ driver-moab/main/cime_comp_mod.F90 | 2 +- 2 files changed, 7 insertions(+), 7 deletions(-) diff --git a/components/cmake/common_setup.cmake b/components/cmake/common_setup.cmake index c12f685171db..d2f263cc5140 100644 --- a/components/cmake/common_setup.cmake +++ b/components/cmake/common_setup.cmake @@ -269,7 +269,7 @@ if (COMP_INTERFACE STREQUAL "moab") message(FATAL_ERROR "MOAB_PATH must be defined when USE_MOAB is TRUE") endif() - find_package(MOAB) + include(${MOAB_PATH}/lib/cmake/MOAB/MOABConfig.cmake) endif() # Set HAVE_SLASHPROC on LINUX systems which are not bluegene or Darwin (OSx) @@ -359,7 +359,7 @@ else() list(APPEND INCLDIR "${INC_NETCDF_C}" "${INC_NETCDF_FORTRAN}") endif() -foreach(ITEM MOD_NETCDF INC_MPI INC_PNETCDF INC_PETSC INC_TRILINOS INC_ALBANY) # INC_MOAB) +foreach(ITEM MOD_NETCDF INC_MPI INC_PNETCDF INC_PETSC INC_TRILINOS INC_ALBANY INC_MOAB) if (${ITEM}) list(APPEND INCLDIR "${${ITEM}}") endif() @@ -444,10 +444,10 @@ if (USE_ALBANY) set(SLIBS "${SLIBS} ${ALBANY_LINK_LIBS}") endif() -# Add MOAB libraries. These are defined in the MOAB_LINK_LIBS env var that was included above -# if (USE_MOAB) -# set(SLIBS "${SLIBS} ${IMESH_LIBS}") -# endif() +# Add MOAB libraries. +if (COMP_INTERFACE STREQUAL "moab") + set(SLIBS "${SLIBS} ${IMESH_LIBRARIES}") +endif() # Add libraries and flags that we need on the link line when C++ code is included # We need to do these additions after CONFIG_ARGS is set, because they can sometimes break configure for mct, etc., diff --git a/driver-moab/main/cime_comp_mod.F90 b/driver-moab/main/cime_comp_mod.F90 index ab8e893f6b6a..cebdd9ae59a3 100644 --- a/driver-moab/main/cime_comp_mod.F90 +++ b/driver-moab/main/cime_comp_mod.F90 @@ -2323,7 +2323,7 @@ subroutine cime_init() call shr_sys_flush(logunit) endif - #ifdef MOABDEBUGMCT +#ifdef MOABDEBUGMCT if (iamroot_CPLID )then write(logunit,*) ' ' write(logunit,F00) ' start output mct data with MOAB ' From 0b157ebc305efe8016e26373440b3ed25c03f26d Mon Sep 17 00:00:00 2001 From: Jason Sarich Date: Tue, 2 Jun 2020 16:16:04 -0500 Subject: [PATCH 050/467] more fixes for cmake and merge. Right now manually links to stdc++ and TempestRemap libs, will have to fix later --- cime_config/machines/config_compilers.xml | 1 + components/cmake/common_setup.cmake | 2 +- components/homme/src/share/prim_driver_base.F90 | 8 ++++---- 3 files changed, 6 insertions(+), 5 deletions(-) diff --git a/cime_config/machines/config_compilers.xml b/cime_config/machines/config_compilers.xml index 6ba715f99514..331272f79965 100644 --- a/cime_config/machines/config_compilers.xml +++ b/cime_config/machines/config_compilers.xml @@ -695,6 +695,7 @@ flags should be captured within MPAS CMake files. $ENV{HDF5_PATH} $ENV{SZIP_PATH} $ENV{ZLIB_PATH} + TRUE diff --git a/components/cmake/common_setup.cmake b/components/cmake/common_setup.cmake index d2f263cc5140..8b38eeffb103 100644 --- a/components/cmake/common_setup.cmake +++ b/components/cmake/common_setup.cmake @@ -446,7 +446,7 @@ endif() # Add MOAB libraries. if (COMP_INTERFACE STREQUAL "moab") - set(SLIBS "${SLIBS} ${IMESH_LIBRARIES}") + set(SLIBS "${SLIBS} ${IMESH_LIBRARIES} -lTempestRemap -lstdc++") endif() # Add libraries and flags that we need on the link line when C++ code is included diff --git a/components/homme/src/share/prim_driver_base.F90 b/components/homme/src/share/prim_driver_base.F90 index d84a9be2bd95..4b82559e1eb2 100644 --- a/components/homme/src/share/prim_driver_base.F90 +++ b/components/homme/src/share/prim_driver_base.F90 @@ -279,10 +279,6 @@ subroutine prim_init1_geometry(elem, par, dom_mt) use physical_constants, only : dd_pi ! -------------------------------- -#ifdef HAVE_MOAB - use semoab_mod, only : create_moab_mesh_fine -#endif - implicit none ! ! Locals @@ -698,6 +694,10 @@ subroutine prim_init1_buffers (elem,par) use dimensions_mod, only : max_corner_elem use compose_mod, only : compose_query_bufsz, compose_set_bufs #endif +#ifdef HAVE_MOAB + use semoab_mod, only : create_moab_mesh_fine +#endif + ! ! Inputs ! From f4a52aaa654e25731d54b2e475a3f39b36cf18b5 Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Fri, 5 Jun 2020 13:41:49 -0500 Subject: [PATCH 051/467] add iulian787/compute_graph changes *********1*********2*********3*********4*********5*********6*********7** * send now to intx atm oc from phys atm do not compute anymore the comm graph from phys atm to atm on coupler compute now a comm graph between phys atm and intx atm-ocn, similar to imoab_phatm_ocn_coupler.cpp on MOAB send from phys atm to intx , and project after that to ocean on coupler PEs still need to send back to the ocean comp * exercise comm between atm physics and atm on coupler * atm physics grid in moab implement it now as part of atm_mct_init method mesh is already distributed, so use ppgrid module for nlcols, lat, lon, area fraction is always 1, and mask too also, during writing of GS map moab files, use shr_CONST_PI, do not redefine it, from shr_const_mod [BFB] - Bit-For-Bit --- components/eam/src/cpl/atm_comp_mct.F90 | 34 ++++- components/eam/src/cpl/atm_import_export.F90 | 63 +++++++++ driver-mct/shr/seq_comm_mct.F90 | 26 ++++ driver-moab/main/cplcomp_exchange_mod.F90 | 40 +++++- driver-moab/main/prep_atm_mod.F90 | 140 +++++++++++++++++-- 5 files changed, 286 insertions(+), 17 deletions(-) diff --git a/components/eam/src/cpl/atm_comp_mct.F90 b/components/eam/src/cpl/atm_comp_mct.F90 index 18d0851c87fb..731695151496 100644 --- a/components/eam/src/cpl/atm_comp_mct.F90 +++ b/components/eam/src/cpl/atm_comp_mct.F90 @@ -23,7 +23,9 @@ module atm_comp_mct use shr_taskmap_mod , only: shr_taskmap_write use cam_cpl_indices + ! it has atm_import, atm_export and cam_moab_phys_export use atm_import_export + ! we defined cam_moab_export in cam_comp; it has cam_init, cam_run1, 2, 3, 4, cam_final use cam_comp use cam_instance , only: cam_instance_init, inst_index, inst_suffix use cam_control_mod , only: nsrest, aqua_planet, eccen, obliqr, lambm0, mvelpp @@ -596,6 +598,12 @@ subroutine atm_run_mct( EClock, cdata_a, x2a_a, a2x_a) #ifdef HAVE_MOAB ! move method out of the do while (.not. do send) loop; do not send yet call cam_moab_export() + + ! method to load temp, u and v on moab atm phys grd; + ! it will be moved then to Atm Spectral mesh on coupler ; just to show how to move it to atm spectral + ! on coupler + call cam_moab_phys_export(cam_out) + #endif ! Get time of next radiation calculation - albedos will need to be @@ -979,7 +987,7 @@ end subroutine atm_write_srfrest_mct #ifdef HAVE_MOAB subroutine initialize_moab_atm_phys( cdata_a ) - use seq_comm_mct, only: mphaid ! imoab pid for atm physics + use seq_comm_mct, only: mphaid, num_moab_exports ! imoab pid for atm physics use shr_mpi_mod, only: shr_mpi_commrank, shr_mpi_commsize use shr_const_mod, only: SHR_CONST_PI !------------------------------------------------------------------- @@ -995,7 +1003,7 @@ subroutine initialize_moab_atm_phys( cdata_a ) integer , external :: iMOAB_RegisterFortranApplication, iMOAB_CreateVertices, iMOAB_WriteMesh, & iMOAB_DefineTagStorage, iMOAB_SetIntTagStorage, iMOAB_SetDoubleTagStorage, & - iMOAB_ResolveSharedEntities + iMOAB_ResolveSharedEntities, iMOAB_UpdateMeshInfo ! local variables to fill in data integer, dimension(:), allocatable :: vgids ! retrieve everything we need from mct @@ -1018,8 +1026,6 @@ subroutine initialize_moab_atm_phys( cdata_a ) character*100 outfile, wopts, tagname character*32 appname - !dims =3 ! store as 3d mesh - call seq_cdata_setptrs(cdata_a, ID=ATMID, mpicom=mpicom_atm, & infodata=infodata) @@ -1118,6 +1124,25 @@ subroutine initialize_moab_atm_phys( cdata_a ) if (ierr > 0 ) & call endrun('Error: fail to set area tag ') + ! create some tags for T, u, v bottoms + + tagname='T_ph'//CHAR(0) + ierr = iMOAB_DefineTagStorage(mphaid, tagname, tagtype, numco, tagindex ) + if (ierr > 0 ) & + call endrun('Error: fail to create temp on phys tag ') + tagname='u_ph'//CHAR(0) + ierr = iMOAB_DefineTagStorage(mphaid, tagname, tagtype, numco, tagindex ) + if (ierr > 0 ) & + call endrun('Error: fail to create u velo on phys tag ') + tagname='v_ph'//CHAR(0) + ierr = iMOAB_DefineTagStorage(mphaid, tagname, tagtype, numco, tagindex ) + if (ierr > 0 ) & + call endrun('Error: fail to create v velo on phys tag ') + + ! need to identify that the mesh is indeed point cloud + ! this call will set the point_cloud to true inside iMOAB appData structure + ierr = iMOAB_UpdateMeshInfo(mphaid) + ! tagname='area'//CHAR(0) ! ierr = iMOAB_DefineTagStorage(mphaid, tagname, tagtype, numco, tagindex ) ! if (ierr > 0 ) & @@ -1138,6 +1163,7 @@ subroutine initialize_moab_atm_phys( cdata_a ) if (ierr > 0 ) & call endrun('Error: fail to write the atm phys mesh file') #endif + num_moab_exports = 0 ! will be used for counting number of calls deallocate(moab_vert_coords) deallocate(vgids) deallocate(areavals) diff --git a/components/eam/src/cpl/atm_import_export.F90 b/components/eam/src/cpl/atm_import_export.F90 index 3c755fa420ad..09d7752508f0 100644 --- a/components/eam/src/cpl/atm_import_export.F90 +++ b/components/eam/src/cpl/atm_import_export.F90 @@ -298,5 +298,68 @@ subroutine atm_export( cam_out, a2x ) end do end subroutine atm_export +#ifdef HAVE_MOAB + subroutine cam_moab_phys_export(cam_out) + !------------------------------------------------------------------- + use camsrfexch, only: cam_out_t + use phys_grid , only: get_ncols_p, get_nlcols_p + use ppgrid , only: begchunk, endchunk + use seq_comm_mct, only: mphaid ! imoab pid for atm physics + use seq_comm_mct, only : num_moab_exports ! + use cam_abortutils , only: endrun + ! + ! Arguments + ! + type(cam_out_t), intent(in) :: cam_out(begchunk:endchunk) + + real(r8), dimension(:), allocatable :: tbot, ubot, vbot ! temporary + integer tagtype, numco, ent_type + character*100 outfile, wopts, tagname, lnum + + integer ierr, c, nlcols, ig, i, ncols + integer , external :: iMOAB_WriteMesh, iMOAB_SetDoubleTagStorage + + ! load temp, u, and v on atm phys moab mesh, that is + + nlcols = get_nlcols_p() + + allocate(tbot(nlcols)) + allocate(ubot(nlcols)) + allocate(vbot(nlcols)) + + + ig=1 + do c=begchunk, endchunk + ncols = get_ncols_p(c) + do i=1,ncols + + ubot(ig) = cam_out(c)%ubot(i) + vbot(ig) = cam_out(c)%vbot(i) + tbot(ig) = cam_out(c)%tbot(i) + ig = ig+1 + enddo + enddo + + tagname='T_ph'//CHAR(0) + ent_type = 0 ! vertex type + ierr = iMOAB_SetDoubleTagStorage ( mphaid, tagname, nlcols , ent_type, tbot) + tagname ='u_ph'//CHAR(0) + ierr = iMOAB_SetDoubleTagStorage ( mphaid, tagname, nlcols , ent_type, ubot) + tagname ='v_ph'//CHAR(0) + ierr = iMOAB_SetDoubleTagStorage ( mphaid, tagname, nlcols , ent_type, vbot) +#ifdef MOABDEBUG + num_moab_exports = num_moab_exports +1 + write(lnum,"(I0.2)")num_moab_exports + outfile = 'AtmPhys_'//trim(lnum)//'.h5m'//CHAR(0) + wopts = 'PARALLEL=WRITE_PART'//CHAR(0) + ierr = iMOAB_WriteMesh(mphaid, outfile, wopts) + if (ierr > 0 ) & + call endrun('Error: fail to write the atm phys mesh file with data') +#endif + deallocate(tbot) + deallocate(ubot) + deallocate(vbot) + end subroutine cam_moab_phys_export +#endif end module atm_import_export diff --git a/driver-mct/shr/seq_comm_mct.F90 b/driver-mct/shr/seq_comm_mct.F90 index b7cf751225be..e5dba828f265 100644 --- a/driver-mct/shr/seq_comm_mct.F90 +++ b/driver-mct/shr/seq_comm_mct.F90 @@ -622,6 +622,32 @@ subroutine seq_comm_init(global_comm_in, driver_comm_in, nmlfile, drv_comm_id) call mct_world_init(ncomps, DRIVER_COMM, comms, comps) +<<<<<<< HEAD:driver-mct/shr/seq_comm_mct.F90 +======= + ierr = iMOAB_InitializeFortran() + if (ierr /= 0) then + write(logunit,*) trim(subname),' ERROR initialize MOAB ' + endif +#ifdef MOABDDD +! write the global_mype , for easier debugging with ddd +! will never use ddd for more than 10 processes + if (global_mype .le. 10) then + write(logunit,*) trim(subname), ' global_mype=', global_mype + endif +#endif + mhid = -1 ! iMOAB id for atm comp, coarse mesh + mhfid = -1 ! iMOAB id for atm, fine mesh + mpoid = -1 ! iMOAB id for ocn comp + mlnid = -1 ! iMOAB id for land comp + mphaid = -1 ! iMOAB id for phys grid on atm pes + mbaxid = -1 ! iMOAB id for atm migrated mesh to coupler pes + mboxid = -1 ! iMOAB id for mpas ocean migrated mesh to coupler pes + mbintxoa = -1 ! iMOAB id for atm intx with mpas ocean + mblxid = -1 ! iMOAB id for land on coupler pes + mbintxla = -1 ! iMOAB id for land intx with atm on coupler pes + num_moab_exports = 0 ! mostly used in debugging + +>>>>>>> 9f1898ff7... add iulian787/compute_graph changes:cime/src/drivers/moab/shr/seq_comm_mct.F90 deallocate(comps,comms) diff --git a/driver-moab/main/cplcomp_exchange_mod.F90 b/driver-moab/main/cplcomp_exchange_mod.F90 index aae897d009fc..e9426be5426a 100644 --- a/driver-moab/main/cplcomp_exchange_mod.F90 +++ b/driver-moab/main/cplcomp_exchange_mod.F90 @@ -15,6 +15,7 @@ module cplcomp_exchange_mod use seq_comm_mct, only : mhid, mpoid, mbaxid, mboxid ! iMOAB app ids, for atm, ocean, ax mesh, ox mesh use seq_comm_mct, only : mlnid , mblxid ! iMOAB app id for land , on land pes and coupler pes + use seq_comm_mct, only : mphaid ! iMOAB app id for phys atm; comp atm is 5, phys 5+200 use shr_mpi_mod, only: shr_mpi_max implicit none @@ -996,12 +997,15 @@ subroutine cplcomp_moab_Init(comp) integer :: mpigrp_old ! component group pes integer, external :: iMOAB_RegisterFortranApplication, iMOAB_ReceiveMesh, iMOAB_SendMesh integer, external :: iMOAB_WriteMesh, iMOAB_DefineTagStorage, iMOAB_GetMeshInfo - integer, external :: iMOAB_SetIntTagStorage, iMOAB_FreeSenderBuffers + integer, external :: iMOAB_SetIntTagStorage, iMOAB_FreeSenderBuffers, iMOAB_ComputeCommGraph integer :: ierr, context_id character*32 :: appname, outfile, wopts, tagnameProj integer :: maxMH, maxMPO, maxMLID ! max pids for moab apps atm, ocn, lnd integer :: tagtype, numco, tagindex, partMethod integer :: rank, ent_type + integer :: typeA, typeB, ATM_PHYS_CID ! used to compute par graph between atm phys + ! and atm spectral on coupler + #ifdef MOABDEBUG integer , dimension(1:3) :: nverts, nelem, nblocks, nsbc, ndbc integer, dimension(:), allocatable :: vgids @@ -1064,9 +1068,39 @@ subroutine cplcomp_moab_Init(comp) if (mhid .ge. 0) then ! we are on component atm pes ierr = iMOAB_FreeSenderBuffers(mhid, context_id) endif - ! now we have the spectral atm on coupler pes, and we want to send some data from - ! atm physics mesh to atm spectral on coupler side; compute a par comm graph +! comment out now; we will not send directly to atm spectral on coupler; we need to send in the +! context of ocean intx;; or directly to land on coupler, for projection to land + ! now we have the spectral atm on coupler pes, and we want to send some data from + ! atm physics mesh to atm spectral on coupler side; compute a par comm graph between + ! atm phys and spectral atm mesh on coupler PEs + ! ierr = iMOAB_ComputeCommGraph(cmpAtmPID, physAtmPID, &joinComm, &atmPEGroup, &atmPhysGroup, + ! &typeA, &typeB, &cmpatm, &physatm); + ! graph between atm phys, mphaid, and atm dyn on coupler, mbaxid + ! phys atm group is mpigrp_old, coupler group is mpigrp_cplid + !!typeA = 2 ! point cloud + !!typeB = 1 ! spectral elements + !!ATM_PHYS_CID = 200 + id_old ! 200 + 5 for atm, see line 969 ATM_PHYS = 200 + ATMID ! in + ! components/cam/src/cpl/atm_comp_mct.F90 + !!ierr = iMOAB_ComputeCommGraph( mphaid, mbaxid, mpicom_join, mpigrp_old, mpigrp_cplid, & + !! typeA, typeB, ATM_PHYS_CID, id_join) +! comment out this above part + + ! we also need to define the tags for receiving the physics data, on atm on coupler pes + ! corresponding to 'T_ph;u_ph;v_ph'; + ! we can receive those tags only on coupler pes, when mbaxid exists + ! we have to check that before we can define the tag + if (mbaxid .ge. 0 ) then + tagnameProj = 'T_ph16'//CHAR(0) + tagtype = 1 ! dense, double + numco = 16 ! hard coded, 16 values per cell! + ierr = iMOAB_DefineTagStorage(mbaxid, tagnameProj, tagtype, numco, tagindex ) + ! define more tags + tagnameProj = 'u_ph16'//CHAR(0) ! U component of velocity + ierr = iMOAB_DefineTagStorage(mbaxid, tagnameProj, tagtype, numco, tagindex ) + tagnameProj = 'v_ph16'//CHAR(0) ! V component of velocity + ierr = iMOAB_DefineTagStorage(mbaxid, tagnameProj, tagtype, numco, tagindex ) + endif endif ! ocean if (comp%oneletterid == 'o' .and. maxMPO /= -1) then diff --git a/driver-moab/main/prep_atm_mod.F90 b/driver-moab/main/prep_atm_mod.F90 index bd1a50b00ed7..bc0c37f56848 100644 --- a/driver-moab/main/prep_atm_mod.F90 +++ b/driver-moab/main/prep_atm_mod.F90 @@ -5,7 +5,7 @@ module prep_atm_mod use shr_kind_mod, only: cl => SHR_KIND_CL use shr_sys_mod, only: shr_sys_abort, shr_sys_flush use seq_comm_mct, only: num_inst_atm, num_inst_ocn, num_inst_ice, num_inst_lnd, num_inst_xao, & - num_inst_frc, num_inst_max, CPLID, ATMID, logunit + num_inst_frc, num_inst_max, CPLID, logunit use seq_comm_mct, only: seq_comm_getData=>seq_comm_setptrs use seq_infodata_mod, only: seq_infodata_type, seq_infodata_getdata use seq_map_type_mod @@ -19,11 +19,12 @@ module prep_atm_mod use shr_mpi_mod, only: shr_mpi_commrank use seq_comm_mct, only : mbaxid ! iMOAB id for atm migrated mesh to coupler pes + use seq_comm_mct, only : mphaid ! iMOAB id for phys atm on atm pes use seq_comm_mct, only : mboxid ! iMOAB id for mpas ocean migrated mesh to coupler pes use seq_comm_mct, only : mbintxoa ! iMOAB id for intx mesh between ocean and atmosphere; output from this use seq_comm_mct, only : mhid ! iMOAB id for atm instance use seq_comm_mct, only : mblxid ! iMOAB id for land migrated to coupler pes !! old name : mlnxid - use seq_comm_mct, only : mbintxla ! iMOAB id for intx mesh between land and atmmosphere + use seq_comm_mct, only : mbintxla ! iMOAB id for intx mesh between land and atmosphere use seq_comm_mct, only : seq_comm_getinfo => seq_comm_setptrs use dimensions_mod, only : np ! for atmosphere @@ -287,12 +288,17 @@ subroutine prep_atm_ocn_moab(infodata) integer :: id_join integer :: mpicom_join integer :: context_id ! used to define context for coverage (this case, ocean on coupler) - integer :: atmid + integer :: atm_id character*32 :: dm1, dm2, dofnameATM, dofnameOCN, wgtIdef integer :: orderOCN, orderATM, volumetric, noConserve, validate integer :: monotonicity - integer, external :: iMOAB_CoverageGraph, iMOAB_ComputeScalarProjectionWeights + integer :: mpigrp_CPLID ! coupler pes group, used for comm graph phys <-> atm-ocn + integer :: mpigrp_old ! component group pes (phys grid atm) == atm group + integer :: typeA, typeB ! type for computing graph; + integer :: idintx ! in this case, id of moab intersection between atm and ocn, on coupler pes + + integer, external :: iMOAB_CoverageGraph, iMOAB_ComputeScalarProjectionWeights, iMOAB_ComputeCommGraph call seq_infodata_getData(infodata, & atm_present=atm_present, & @@ -303,7 +309,7 @@ subroutine prep_atm_ocn_moab(infodata) ! after this, the sending of tags from atm pes to coupler pes will use the new par comm graph, that has more precise info about ! how to get mpicomm for joint atm + coupler id_join = atm(1)%cplcompid - atmid = atm(1)%compid + atm_id = atm(1)%compid ! maybe we can use a moab-only id, defined like mbintxoa, mhid, somewhere else (seq_comm_mct) ! we cannot use mbintxoa because it may not exist on atm comp yet; context_id = ocn(1)%cplcompid @@ -329,6 +335,24 @@ subroutine prep_atm_ocn_moab(infodata) monotonicity, volumetric, noConserve, validate, & trim(dofnameATM), trim(dofnameOCN) ) endif + + ! compute the comm graph between phys atm and intx-atm-ocn, to be able to send directly from phys atm + ! towards coverage mesh on atm for intx to ocean + ! this is similar to imoab_phatm_ocn_coupler.cpp test in moab + ! int typeA = 2; // point cloud + ! int typeB = 1; // quads in coverage set + ! ierr = iMOAB_ComputeCommGraph(cmpPhAtmPID, cplAtmOcnPID, &atmCouComm, &atmPEGroup, &couPEGroup, + ! &typeA, &typeB, &cmpatm, &atmocnid); + call seq_comm_getinfo(CPLID ,mpigrp=mpigrp_CPLID) ! second group, the coupler group CPLID is global variable + call seq_comm_getinfo(atm_id, mpigrp=mpigrp_old) ! component group pes, from atm id ( also ATMID(1) ) + + typeA = 2 ! point cloud, phys atm in this case + typeB = 1 ! atm cells involved in intersection (spectral in this case) + ! idintx is a unique number of MOAB app that takes care of intx between ocn and atm mesh + idintx = 100*atm(1)%cplcompid + ocn(1)%cplcompid ! something different, to differentiate it; ~ 618 ! + ierr = iMOAB_ComputeCommGraph( mphaid, mbintxoa, mpicom_join, mpigrp_old, mpigrp_CPLID, & + typeA, typeB, atm_id, idintx) + end subroutine prep_atm_ocn_moab subroutine prep_atm_lnd_moab(infodata) @@ -349,7 +373,7 @@ subroutine prep_atm_lnd_moab(infodata) integer :: id_join integer :: mpicom_join integer :: context_id ! used to define context for coverage (this case, land on coupler) - integer :: atmid + integer :: atm_id character*32 :: dm1, dm2, dofnameATM, dofnameLND, wgtIdef integer :: orderLND, orderATM, volumetric, noConserve, validate integer :: monotonicity @@ -366,7 +390,7 @@ subroutine prep_atm_lnd_moab(infodata) ! comm graph, that has more precise info about ! how to get mpicomm for joint atm + coupler id_join = atm(1)%cplcompid - atmid = atm(1)%compid + atm_id = atm(1)%compid ! maybe we can use a moab-only id, defined like mbintxoa, mhid, somewhere else (seq_comm_mct) ! we cannot use mbintxla because it may not exist on atm comp yet; context_id = lnd(1)%cplcompid @@ -386,7 +410,7 @@ subroutine prep_atm_lnd_moab(infodata) volumetric = 0 noConserve = 0 validate = 1 - if (mbintxoa .ge. 0 ) then + if (mbintxla .ge. 0 ) then ierr = iMOAB_ComputeScalarProjectionWeights ( mbintxla, wgtIdef, & trim(dm1), orderATM, trim(dm2), orderLND, & monotonicity, volumetric, noConserve, validate, & @@ -410,7 +434,7 @@ subroutine prep_atm_migrate_moab(infodata) logical :: lnd_present ! .true. => lnd is present integer :: id_join integer :: mpicom_join - integer :: atmid + integer :: atm_id integer :: context_id ! we will use ocean context character*32 :: dm1, dm2, tagName, wgtIdef character*50 :: outfile, wopts, tagnameProj, lnum @@ -429,7 +453,7 @@ subroutine prep_atm_migrate_moab(infodata) ! after this, the sending of tags from atm pes to coupler pes will use the new par comm graph, that has more precise info about ! how to get mpicomm for joint atm + coupler id_join = atm(1)%cplcompid - atmid = atm(1)%compid + atm_id = atm(1)%compid call seq_comm_getinfo(ID_join,mpicom=mpicom_join) @@ -531,6 +555,102 @@ subroutine prep_atm_migrate_moab(infodata) endif + ! we also know that phys atm was loaded with some data; send it to the coupler atm + ! send data to atm on coupler PEs, using the par comm graph computed + ! in clp comp exch: + ! ierr = iMOAB_ComputeCommGraph( mphaid, mbaxid, mpicom_join, mpigrp_old, mpigrp_CPLID, & + ! typeA, typeB, ATM_PHYS_CID, id_join) + !!context_id = -1 ! this is the original + + !!if (mphaid .ge. 0) then + ! we are on atm phys pes (atm pes) + !! tagname = 'T_ph;u_ph;v_ph'//CHAR(0) + ! context_id is the other comp id, in this case it has to be 6, id_join + !! context_id = id_join; + !! ierr = iMOAB_SendElementTag(mphaid, tagname, mpicom_join, context_id) + !!endif + + !!if (mbaxid .ge. 0 ) then ! we are on coupler pes, for sure + ! receive on atm tag on coupler pes, in original migrate + ! receive from ATM PHYS, which in this case is 200 + 5 + !! tagname = 'T_ph16;u_ph16;v_ph16'//CHAR(0) + !! context_id = 200 + atm_id ! 200 + 5 for atm + !! ierr = iMOAB_ReceiveElementTag(mbaxid, tagName, mpicom_join, context_id) + !CHECKRC(ierr, "cannot receive tag values") + !!endif + + ! we can now free the sender buffers + !!if (mhid .ge. 0) then + !! ierr = iMOAB_FreeSenderBuffers(mphaid, context_id) + !! ! CHECKRC(ierr, "cannot free buffers used to phys atm tag towards the coupler atm spectral mesh") + !!endif +!!#ifdef MOABDEBUG + ! we can also write the atm spectral mesh on coupler PEs to file + ! to check the tags received + !!if (mbaxid .ge. 0 ) then ! we are on coupler pes, for sure + !! write(lnum,"(I0.2)")num_proj + !! outfile = 'wholeATM_ph'//trim(lnum)//'.h5m'//CHAR(0) + !! wopts = ';PARALLEL=WRITE_PART'//CHAR(0) ! + !! ierr = iMOAB_WriteMesh(mbaxid, trim(outfile), trim(wopts)) + !!endif +!!#endif + +! similarly to imoab_phatm_ocn_coupler.cpp test, we can send data to atm intx ocn directly, from phys atm +! ierr = iMOAB_SendElementTag(cmpPhAtmPID, "T_ph;u_ph;v_ph;", &atmCouComm, &atmocnid, strlen("T_ph;u_ph;v_ph;")); +! we will use the *16* tags created before on spectral atm on coupler + ! we also know that phys atm was loaded with some data; send it to the coupler atm + ! send data to atm intx ocn on coupler pes: mbintxoa + ! in clp comp exch: + ! ierr = iMOAB_ComputeCommGraph( mphaid, mbintxoa, mpicom_join, mpigrp_old, mpigrp_CPLID, & + ! typeA, typeB, atm_id, idintx) + context_id = -1 ! this is the original migrate; we will use the context of atm-ocn intx: + ! idintx is a unique number of MOAB app that takes care of intx between ocn and atm mesh + ! idintx = 100*atm(1)%cplcompid + ocn(1)%cplcompid ! something different, to differentiate it; ~ 618 ! + if (mphaid .ge. 0) then + ! we are on atm phys pes (atm pes) + tagname = 'T_ph;u_ph;v_ph'//CHAR(0) + ! context_id is the other comp id, in this case it has to be 6, id_join + context_id = 100*atm(1)%cplcompid + ocn(1)%cplcompid + ierr = iMOAB_SendElementTag(mphaid, tagname, mpicom_join, context_id) + endif + + if (mbaxid .ge. 0 ) then ! we are on coupler pes, for sure + ! receive on atm tag on coupler pes, in original migrate + ! receive from ATM PHYS, which in this case is 200 + 5 + tagname = 'T_ph16;u_ph16;v_ph16'//CHAR(0) + context_id = atm_id ! 5 for atm + ierr = iMOAB_ReceiveElementTag(mbintxoa, tagName, mpicom_join, context_id) + !CHECKRC(ierr, "cannot receive tag values") + endif + + ! we can now free the sender buffers + if (mhid .ge. 0) then + ierr = iMOAB_FreeSenderBuffers(mphaid, context_id) + ! CHECKRC(ierr, "cannot free buffers used to phys atm tag towards the coupler atm spectral mesh") + endif + + ! we could do the projection now, on the ocean mesh, because we are on the coupler pes; + ! the actual migrate could happen later , from coupler pes to the ocean pes + if (mbintxoa .ge. 0 ) then ! we are on coupler pes, for sure + ! we could apply weights; need to use the same weight identifier wgtIdef as when we generated it + ! hard coded now, it should be a runtime option in the future + tagname = 'T_ph16;u_ph16;v_ph16'//CHAR(0) + tagNameProj = 'a2oTbot_proj;a2oUbot_proj;a2oVbot_proj;'//CHAR(0) + wgtIdef = 'scalar'//CHAR(0) ! ocean ! + ierr = iMOAB_ApplyScalarProjectionWeights ( mbintxoa, wgtIdef, tagName, tagNameProj) + +#ifdef MOABDEBUG + ! we can also write the ocean mesh to file, just to see the projectd tag + ! write out the mesh file to disk + write(lnum,"(I0.2)")num_proj + outfile = 'ocnCplProj2'//trim(lnum)//'.h5m'//CHAR(0) + wopts = ';PARALLEL=WRITE_PART'//CHAR(0) ! + ierr = iMOAB_WriteMesh(mboxid, trim(outfile), trim(wopts)) +#endif + + !CHECKRC(ierr, "cannot receive tag values") + endif + end subroutine prep_atm_migrate_moab !================================================================================================ From 298cc7d6f2eb67290e7d8db9e03af90230a347e5 Mon Sep 17 00:00:00 2001 From: Jason Sarich Date: Thu, 11 Jun 2020 12:19:29 -0500 Subject: [PATCH 052/467] fix up cmake variables for moab --- components/cmake/common_setup.cmake | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/components/cmake/common_setup.cmake b/components/cmake/common_setup.cmake index 8b38eeffb103..a03b6130cb52 100644 --- a/components/cmake/common_setup.cmake +++ b/components/cmake/common_setup.cmake @@ -259,6 +259,7 @@ endif() if (COMP_INTERFACE STREQUAL "moab") if (MOAB_PATH) set(CPPDEFS "${CPPDEFS} -DHAVE_MOAB") + set(USE_CXX TRUE) if (NOT INC_MOAB) set(INC_MOAB ${MOAB_PATH}/include) endif() @@ -446,7 +447,7 @@ endif() # Add MOAB libraries. if (COMP_INTERFACE STREQUAL "moab") - set(SLIBS "${SLIBS} ${IMESH_LIBRARIES} -lTempestRemap -lstdc++") + set(SLIBS "${SLIBS} ${IMESH_LIBRARIES}") endif() # Add libraries and flags that we need on the link line when C++ code is included From 369fc42f4756307acf72869b216c3bb29b571707 Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Fri, 19 Jun 2020 23:43:56 -0500 Subject: [PATCH 053/467] check imoab app ids for consistency *********1*********2*********3*********4*********5*********6*********7** in a simple case without mpas ocean(ne4pg2_ne4pg2 grid), we do not instantiate moab mpas app; we cannot do intersection, data transfer, etc [BFB] - Bit-For-Bit --- driver-moab/main/prep_atm_mod.F90 | 48 ++++++++++++++++++------------- 1 file changed, 28 insertions(+), 20 deletions(-) diff --git a/driver-moab/main/prep_atm_mod.F90 b/driver-moab/main/prep_atm_mod.F90 index bc0c37f56848..3a37154ac683 100644 --- a/driver-moab/main/prep_atm_mod.F90 +++ b/driver-moab/main/prep_atm_mod.F90 @@ -186,21 +186,24 @@ subroutine prep_atm_init(infodata, ocn_c2_atm, ice_c2_atm, lnd_c2_atm, iac_c2_at 'seq_maps.rc','ocn2atm_smapname:','ocn2atm_smaptype:',samegrid_ao, & 'mapper_So2a initialization',esmf_map_flag) - appname = "ATM_OCN_COU"//CHAR(0) - ! idintx is a unique number of MOAB app that takes care of intx between ocn and atm mesh - idintx = 100*atm(1)%cplcompid + ocn(1)%cplcompid ! something different, to differentiate it - ierr = iMOAB_RegisterFortranApplication(trim(appname), mpicom_CPLID, idintx, mbintxoa) - ierr = iMOAB_ComputeMeshIntersectionOnSphere (mbaxid, mboxid, mbintxoa) + ! Call moab intx only if atm and ocn are init in moab + if ((mbaxid .ge. 0) .and. (mboxid .ge. 0)) then + appname = "ATM_OCN_COU"//CHAR(0) + ! idintx is a unique number of MOAB app that takes care of intx between ocn and atm mesh + idintx = 100*atm(1)%cplcompid + ocn(1)%cplcompid ! something different, to differentiate it + ierr = iMOAB_RegisterFortranApplication(trim(appname), mpicom_CPLID, idintx, mbintxoa) + ierr = iMOAB_ComputeMeshIntersectionOnSphere (mbaxid, mboxid, mbintxoa) #ifdef MOABDEBUG - wopts = CHAR(0) - call shr_mpi_commrank( mpicom_CPLID, rank ) - if (rank .lt. 5) then - write(lnum,"(I0.2)")rank ! - outfile = 'intx'//trim(lnum)// '.h5m' // CHAR(0) - ierr = iMOAB_WriteMesh(mbintxoa, outfile, wopts) ! write local intx file - endif - num_proj = 0 ! to index projection files on coupler pes + wopts = CHAR(0) + call shr_mpi_commrank( mpicom_CPLID, rank ) + if (rank .lt. 5) then + write(lnum,"(I0.2)")rank ! + outfile = 'intx'//trim(lnum)// '.h5m' // CHAR(0) + ierr = iMOAB_WriteMesh(mbintxoa, outfile, wopts) ! write local intx file + endif + num_proj = 0 ! to index projection files on coupler pes #endif + end if end if ! needed for domain checking @@ -258,11 +261,13 @@ subroutine prep_atm_init(infodata, ocn_c2_atm, ice_c2_atm, lnd_c2_atm, iac_c2_at 'seq_maps.rc','lnd2atm_smapname:','lnd2atm_smaptype:',samegrid_al, & 'mapper_Sl2a initialization',esmf_map_flag) - appname = "ATM_LND_COU"//CHAR(0) - ! idintx is a unique number of MOAB app that takes care of intx between lnd and atm mesh - idintx = 100*atm(1)%cplcompid + lnd(1)%cplcompid ! something different, to differentiate it - ierr = iMOAB_RegisterFortranApplication(trim(appname), mpicom_CPLID, idintx, mbintxla) - ierr = iMOAB_ComputePointDoFIntersection (mbaxid, mblxid, mbintxla) + if ((mbaxid .ge. 0) .and. (mblxid .ge. 0)) then + appname = "ATM_LND_COU"//CHAR(0) + ! idintx is a unique number of MOAB app that takes care of intx between lnd and atm mesh + idintx = 100*atm(1)%cplcompid + lnd(1)%cplcompid ! something different, to differentiate it + ierr = iMOAB_RegisterFortranApplication(trim(appname), mpicom_CPLID, idintx, mbintxla) + ierr = iMOAB_ComputePointDoFIntersection (mbaxid, mblxid, mbintxla) + endif end if @@ -300,6 +305,7 @@ subroutine prep_atm_ocn_moab(infodata) integer, external :: iMOAB_CoverageGraph, iMOAB_ComputeScalarProjectionWeights, iMOAB_ComputeCommGraph + if (mbintxoa .lt. 0) return ! do nothing, as intx is not defined call seq_infodata_getData(infodata, & atm_present=atm_present, & ocn_present=ocn_present) @@ -380,6 +386,7 @@ subroutine prep_atm_lnd_moab(infodata) integer, external :: iMOAB_CoverageGraph, iMOAB_ComputeScalarProjectionWeights + if (mbintxla .lt. 0 ) return ! do nothing call seq_infodata_getData(infodata, & atm_present=atm_present, & lnd_present=lnd_present) @@ -611,10 +618,11 @@ subroutine prep_atm_migrate_moab(infodata) tagname = 'T_ph;u_ph;v_ph'//CHAR(0) ! context_id is the other comp id, in this case it has to be 6, id_join context_id = 100*atm(1)%cplcompid + ocn(1)%cplcompid - ierr = iMOAB_SendElementTag(mphaid, tagname, mpicom_join, context_id) + ierr = iMOAB_SendElementTag(mphaid, tagname, mpicom_join, context_id) ! it will fail if intx is not done + ! if intx is not done, context does not exist ! endif - if (mbaxid .ge. 0 ) then ! we are on coupler pes, for sure + if (mbintxoa .ge. 0 ) then ! we are on coupler pes, for sure ! receive on atm tag on coupler pes, in original migrate ! receive from ATM PHYS, which in this case is 200 + 5 tagname = 'T_ph16;u_ph16;v_ph16'//CHAR(0) From 5e642435cd3a1f3da8790be317fd8d2b8d1d816b Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Sun, 28 Jun 2020 11:49:50 -0500 Subject: [PATCH 054/467] revert some change from before *********1*********2*********3*********4*********5*********6*********7** coverage graph need to be called on component and coupler at the same time; we cannot skip it on component side [BFB] - Bit-For-Bit --- driver-moab/main/prep_atm_mod.F90 | 2 -- 1 file changed, 2 deletions(-) diff --git a/driver-moab/main/prep_atm_mod.F90 b/driver-moab/main/prep_atm_mod.F90 index 3a37154ac683..c0b68b9e8c4b 100644 --- a/driver-moab/main/prep_atm_mod.F90 +++ b/driver-moab/main/prep_atm_mod.F90 @@ -305,7 +305,6 @@ subroutine prep_atm_ocn_moab(infodata) integer, external :: iMOAB_CoverageGraph, iMOAB_ComputeScalarProjectionWeights, iMOAB_ComputeCommGraph - if (mbintxoa .lt. 0) return ! do nothing, as intx is not defined call seq_infodata_getData(infodata, & atm_present=atm_present, & ocn_present=ocn_present) @@ -386,7 +385,6 @@ subroutine prep_atm_lnd_moab(infodata) integer, external :: iMOAB_CoverageGraph, iMOAB_ComputeScalarProjectionWeights - if (mbintxla .lt. 0 ) return ! do nothing call seq_infodata_getData(infodata, & atm_present=atm_present, & lnd_present=lnd_present) From 14a3e8d12f9e05540c8c030a92eeb15817c20ed1 Mon Sep 17 00:00:00 2001 From: iulian07 Date: Mon, 6 Jul 2020 16:26:06 -0500 Subject: [PATCH 055/467] changes for bebop use newer netcdf modules, that are built with hdf5 parallel also, use current moab master (as of July 2020), installed here /home/iulian/moab-blds/bebop/moab-j3 --- cime_config/machines/config_compilers.xml | 1 + cime_config/machines/config_machines.xml | 11 +++++++---- 2 files changed, 8 insertions(+), 4 deletions(-) diff --git a/cime_config/machines/config_compilers.xml b/cime_config/machines/config_compilers.xml index 331272f79965..9294b5bc7ccc 100644 --- a/cime_config/machines/config_compilers.xml +++ b/cime_config/machines/config_compilers.xml @@ -880,6 +880,7 @@ flags should be captured within MPAS CMake files. /soft/climate/AlbanyTrilinos_06262017/Albany/buildintel/install + /home/iulian/moab-blds/bebop/moab-j3 -DHAVE_SLASHPROC diff --git a/cime_config/machines/config_machines.xml b/cime_config/machines/config_machines.xml index b944d4bcd41c..5d7f706d358f 100644 --- a/cime_config/machines/config_machines.xml +++ b/cime_config/machines/config_machines.xml @@ -1162,12 +1162,15 @@ module - subversion/1.14.0-e4smcy3 - perl/5.32.0-bsnc6lt + cmake/3.14.2-gvwazz3 - intel/20.0.4-kodw73g - intel-mkl/2020.4.304-g2qaxzf + intel/17.0.4-74uvhji + intel-mkl/2017.3.196-v7uuj6z + intel-mpi/2017.3-dfphq6k + hdf5/1.10.1-3zhckvj + netcdf/4.6.1-c2mecde + netcdf-fortran/4.4.4-ojwazvy openmpi/4.1.1-qiqkjbu From 703e752bd3a40817993f7553dcec18cfdf2e48fe Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Sat, 8 Aug 2020 00:14:53 -0500 Subject: [PATCH 056/467] add grid files for ne16pg2_r05_oQU240 these files are newer, but we still need them on the older branch [BFB] - Bit-For-Bit --- cime_config/config_grids.xml | 20 +++++++++++++++++--- 1 file changed, 17 insertions(+), 3 deletions(-) diff --git a/cime_config/config_grids.xml b/cime_config/config_grids.xml index 9a2d3f3e8d5f..e7b2e887a1d6 100755 --- a/cime_config/config_grids.xml +++ b/cime_config/config_grids.xml @@ -1144,6 +1144,16 @@ oQU240 + + ne16np4.pg2 + r05 + oQU240 + r05 + null + null + oQU240 + + ne30np4 ne30np4 @@ -2755,8 +2765,6 @@ 720 360 - $DIN_LOC_ROOT/share/domains/domain.lnd.r05_oQU480.200527.nc - $DIN_LOC_ROOT/share/domains/domain.lnd.r05_oQU480.200527.nc $DIN_LOC_ROOT/share/domains/domain.lnd.r05_oQU240.200527.nc $DIN_LOC_ROOT/share/domains/domain.lnd.r05_oQU240.200527.nc $DIN_LOC_ROOT/share/domains/domain.lnd.r05_oEC60to30v3.190418.nc @@ -3133,6 +3141,13 @@ cpl/gridmaps/ne16pg2/map_r05_to_ne16pg2_mono.200527.nc cpl/gridmaps/ne16pg2/map_r05_to_ne16pg2_mono.200527.nc + + cpl/gridmaps/ne11np4/map_ne11np4_to_oQU240_aave.160614.nc + cpl/gridmaps/ne11np4/map_ne11np4_to_oQU240_aave.160614.nc + cpl/gridmaps/ne11np4/map_ne11np4_to_oQU240_aave.160614.nc + cpl/gridmaps/oQU240/map_oQU240_to_ne11np4_aave.160614.nc + cpl/gridmaps/oQU240/map_oQU240_to_ne11np4_aave.160614.nc + cpl/cpl6/map_ne30np4_to_gx1v6_aave_110121.nc @@ -4032,7 +4047,6 @@ cpl/gridmaps/ne16pg2/map_ne16pg2_to_r05_mono.200527.nc cpl/gridmaps/ne16pg2/map_ne16pg2_to_r05_mono.200527.nc - lnd/clm2/mappingdata/maps/ne30np4/map_ne30np4_to_0.5x0.5rtm_aave_da_110320.nc lnd/clm2/mappingdata/maps/ne30np4/map_ne30np4_to_0.5x0.5rtm_aave_da_110320.nc From 64d9a80b92c3de6079cfdbc6a8d1206779f1023e Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Wed, 19 Aug 2020 17:16:37 -0500 Subject: [PATCH 057/467] start PGx mesh instance in MOAB *********1*********2*********3*********4*********5*********6*********7** introduce a new PID app, for PGx mesh use coarse mesh first, but will have to use coordinates from fvgrid generated already we do not want to recompute positions of new vertices in the middle Also, the center of FV cell is already computed, will use a tag to set the center position [BFB] - Bit-For-Bit --- components/eam/src/dynamics/se/dyn_comp.F90 | 16 ++++++++++++++- components/homme/src/tool/semoab_mod.F90 | 22 +++++++++++++++++++++ driver-mct/shr/seq_comm_mct.F90 | 1 + 3 files changed, 38 insertions(+), 1 deletion(-) diff --git a/components/eam/src/dynamics/se/dyn_comp.F90 b/components/eam/src/dynamics/se/dyn_comp.F90 index 77c299eac4ea..81e42940fb98 100644 --- a/components/eam/src/dynamics/se/dyn_comp.F90 +++ b/components/eam/src/dynamics/se/dyn_comp.F90 @@ -105,6 +105,7 @@ subroutine dyn_init1(fh, NLFileName, dyn_in, dyn_out) #ifdef HAVE_MOAB use seq_comm_mct, only: MHID, MHFID ! id of homme moab coarse and fine applications use seq_comm_mct, only: ATMID + use seq_comm_mct, only: mhpgid ! id of pgx moab application #endif ! PARAMETERS: @@ -170,7 +171,7 @@ subroutine dyn_init1(fh, NLFileName, dyn_in, dyn_out) write(iulog,*) " " endif appname="HM_FINE"//CHAR(0) - ATM_ID1 = 119 + ATM_ID1 = 119 ! this number should not conflict with other components IDs; how do we know? ierr = iMOAB_RegisterFortranApplication(appname, par%comm, ATM_ID1, MHFID) if (ierr > 0 ) & call endrun('Error: cannot register moab app for fine mesh') @@ -179,6 +180,19 @@ subroutine dyn_init1(fh, NLFileName, dyn_in, dyn_out) write(iulog,*) "register MOAB app:", trim(appname), " MHFID=", MHFID write(iulog,*) " " endif + if ( fv_nphys > 0 ) then + appname="HM_PGX"//CHAR(0) + ATM_ID1 = 120 ! this number should not conflict with other components IDs; how do we know? + ierr = iMOAB_RegisterFortranApplication(appname, par%comm, ATM_ID1, mhpgid) + if (ierr > 0 ) & + call endrun('Error: cannot register moab app for fine mesh') + if(par%masterproc) then + write(iulog,*) " " + write(iulog,*) "register MOAB app:", trim(appname), " MHPGID=", mhpgid + write(iulog,*) " " + endif + endif + #endif call prim_init1(elem,par,dom_mt,TimeLevel) diff --git a/components/homme/src/tool/semoab_mod.F90 b/components/homme/src/tool/semoab_mod.F90 index e32b3c064508..2e472862d917 100644 --- a/components/homme/src/tool/semoab_mod.F90 +++ b/components/homme/src/tool/semoab_mod.F90 @@ -19,6 +19,9 @@ module semoab_mod use cam_abortutils, only : endrun use seq_comm_mct, only: MHID, MHFID ! app id on moab side, for homme moab coarse and fine mesh + use seq_comm_mct, only: MHPGID ! app id on moab side, for PGx style mesh, uniform from se + + use dyn_grid, only: fv_nphys, fv_physgrid ! phys grid mesh will be replicated too implicit none @@ -66,6 +69,8 @@ subroutine create_moab_mesh_fine(par, elem) type (cartesian3D_t) :: cart integer igcol, ii + integer nedges_c, nverts_pg, nelem_pg + ! for np=4, ! 28, 32, 36, 35 ! 25, 29, 33, 34 @@ -478,6 +483,23 @@ subroutine create_moab_mesh_fine(par, elem) call endrun('Error: fail to write the mesh file') #endif + if (fv_nphys > 0 ) then + ! create FV mesh, base on PGx + ! first count the number of edges in the coarse mesh; + ! use euler: v-m+f = 2 => m = v + f - 2 + nedges_c = nverts_c + nelemd - 2 + nelem_pg = fv_nphys * fv_nphys * nelemd ! each coarse cell is divided in fv_nphys x fv_nphys subcells + ! + ! there are new vertices on each coarse edge (fv_phys - 1) , and (fv_nphys - 1) * (fv_nphys - 1) + ! new vertices on each coarse cell + nverts_pg = nverts_c + (fv_nphys - 1) * nedges_c + (fv_nphys - 1) * (fv_nphys - 1) * nelemd + + if(par%masterproc) then + write (iulog, *) " MOAB: there are ", nverts_pg, " local vertices on master task on pg mesh ", nedges_c , " local coarse edges " + endif + + endif + ! initialize num_calls_export = 0 diff --git a/driver-mct/shr/seq_comm_mct.F90 b/driver-mct/shr/seq_comm_mct.F90 index e5dba828f265..671a9de71708 100644 --- a/driver-mct/shr/seq_comm_mct.F90 +++ b/driver-mct/shr/seq_comm_mct.F90 @@ -215,6 +215,7 @@ module seq_comm_mct integer, external :: iMOAB_InitializeFortran integer, public :: mhid, mhfid, mpoid, mlnid ! homme, homme fine, ocean, land moab ids + integer, public :: mhpgid ! iMOAB id for atm pgx grid, on atm pes; created with se and gll grids integer, public :: mphaid ! iMOAB id for atm phys grid, on atm pes integer, public :: mbaxid ! iMOAB id for atm migrated mesh to coupler pes integer, public :: mboxid ! iMOAB id for mpas ocean migrated mesh to coupler pes From fa44d46074d8d71e175dc7e8c3e3b45174ed8afe Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Wed, 2 Sep 2020 00:24:12 -0500 Subject: [PATCH 058/467] Instance pg2 mesh *********1*********2*********3*********4*********5*********6*********7** create local mesh edges, using GraphVertex information about neighbors also, local elements are in increasing id order [BFB] - Bit-For-Bit --- components/homme/src/tool/semoab_mod.F90 | 157 +++++++++++++++++++++-- 1 file changed, 143 insertions(+), 14 deletions(-) diff --git a/components/homme/src/tool/semoab_mod.F90 b/components/homme/src/tool/semoab_mod.F90 index 2e472862d917..231779f09284 100644 --- a/components/homme/src/tool/semoab_mod.F90 +++ b/components/homme/src/tool/semoab_mod.F90 @@ -17,12 +17,15 @@ module semoab_mod use cam_grid_support, only: iMap use cam_abortutils, only : endrun + use edgetype_mod, only: edgedescriptor_t + use gridgraph_mod, only: gridvertex_t use seq_comm_mct, only: MHID, MHFID ! app id on moab side, for homme moab coarse and fine mesh use seq_comm_mct, only: MHPGID ! app id on moab side, for PGx style mesh, uniform from se use dyn_grid, only: fv_nphys, fv_physgrid ! phys grid mesh will be replicated too + use control_mod, only : west, east, south, north ! 1, 2, 3, 4 implicit none save @@ -33,6 +36,46 @@ module semoab_mod contains + integer function search_in(intarr, leng, value) + integer, intent(in) :: leng + integer, intent(in) :: intarr(leng) + integer, intent(in) :: value + + ! binary search, as the array is ordered + integer current, left, right + left = 1 + right = leng + + search_in = 0 + if ( (value .gt. intarr(leng) ) .or. ( value .lt. intarr(1) ) ) goto 10 + + if ( value .eq. intarr(1) ) then + search_in = 1 + goto 10 + endif + + if ( value .eq. intarr(leng) ) then + search_in = leng + goto 10 + endif + + do while (left < right ) + current = (right+left)/2 + if ( intarr(current) .eq. value ) then + search_in = current + goto 10 + else if ( intarr(current) .lt. value ) then + left = current + else + right = current + endif + if ( left .eq. right -1) goto 10 + enddo +10 continue + if ( intarr(right) .eq. value) search_in = right + + end function search_in + subroutine create_moab_mesh_fine(par, elem) use ISO_C_BINDING @@ -67,9 +110,16 @@ subroutine create_moab_mesh_fine(par, elem) character*100 outfile, wopts, localmeshfile, lnum, tagname, newtagg integer tagtype, numco, tag_sto_len, ent_type, tagindex type (cartesian3D_t) :: cart - integer igcol, ii + integer igcol, ii, neigh + + integer nedges_c, nverts_pg, nelem_pg, edge_index, j1 + integer, dimension(:), allocatable :: local_cell_gids, indx_cell + integer, dimension(:,:), allocatable :: elem_edge, edge - integer nedges_c, nverts_pg, nelem_pg + integer nat_edge_order(4) + integer internal_edges, boundary_edges, reverse_edges + + nat_edge_order = (/south, east, north, west/) ! for np=4, ! 28, 32, 36, 35 @@ -187,12 +237,12 @@ subroutine create_moab_mesh_fine(par, elem) if (ierr > 0 ) & call endrun('Error: fail to create MOAB vertices ') - num_el = nelemd2 + !!num_el = nelemd2 mbtype = 3 ! quadrilateral nve = 4; block_ID = 200 ! this will be for coarse mesh - ierr = iMOAB_CreateElements( MHFID, num_el, mbtype, nve, moabconn, block_ID ); + ierr = iMOAB_CreateElements( MHFID, nelemd2, mbtype, nve, moabconn, block_ID ); if (ierr > 0 ) & call endrun('Error: fail to create MOAB elements') ! nverts: num vertices; vdone will store now the markers used in global resolve @@ -291,10 +341,10 @@ subroutine create_moab_mesh_fine(par, elem) ! now create the coarse mesh, but the global dofs will come from fine mesh, after solving - nelemd2 = nelemd + ! nelemd2 = nelemd moab_dim_cquads = (nelemd)*4 - allocate(gdofel(nelemd2*np*np)) + allocate(gdofel(nelemd*np*np)) k=0 ! will be the index for element global dofs do ie=1,nelemd ix = ie-1 @@ -356,12 +406,12 @@ subroutine create_moab_mesh_fine(par, elem) if (ierr > 0 ) & call endrun('Error: fail to create MOAB vertices ') - num_el = nelemd + ! num_el = nelemd mbtype = 3 ! quadrilateral nve = 4; block_ID = 100 ! this will be for coarse mesh - ierr = iMOAB_CreateElements( MHID, num_el, mbtype, nve, moabconn_c, block_ID ); + ierr = iMOAB_CreateElements( MHID, nelemd, mbtype, nve, moabconn_c, block_ID ); if (ierr > 0 ) & call endrun('Error: fail to create MOAB elements') ! idx: num vertices; vdone will store now the markers used in global resolve @@ -384,7 +434,7 @@ subroutine create_moab_mesh_fine(par, elem) call endrun('Error: fail to set GDOFV tag for vertices') ! set global id tag for coarse elements, too; they will start at nets=1, end at nete=nelemd ent_type = 1 ! now set the global id tag on elements - ierr = iMOAB_SetIntTagStorage ( MHID, newtagg, nelemd2 , ent_type, elemids) + ierr = iMOAB_SetIntTagStorage ( MHID, newtagg, nelemd , ent_type, elemids) if (ierr > 0 ) & call endrun('Error: fail to set global id tag for vertices') @@ -402,9 +452,9 @@ subroutine create_moab_mesh_fine(par, elem) ! now set the values ! set global dofs tag for coarse elements, too; they will start at nets=1, end at nete=nelemd ent_type = 1 ! now set the global id tag on elements - numvals = nelemd2*np*np ! input is the total number of values + numvals = nelemd*np*np ! input is the total number of values ! form gdofel from vgids - do ie=1, nelemd2 + do ie=1, nelemd ix = (ie-1)*np*np ! ie: index in coarse element je = (ie-1) * 4 * (np-1) * (np -1) ! index in moabconn array ! vgids are global ids for fine vertices (1,nverts) @@ -487,16 +537,95 @@ subroutine create_moab_mesh_fine(par, elem) ! create FV mesh, base on PGx ! first count the number of edges in the coarse mesh; ! use euler: v-m+f = 2 => m = v + f - 2 - nedges_c = nverts_c + nelemd - 2 + nedges_c = nverts_c + nelemd - 1 ! could be more, if unconnected regions ? + internal_edges = 0 + boundary_edges = 0 + reverse_edges = 0 nelem_pg = fv_nphys * fv_nphys * nelemd ! each coarse cell is divided in fv_nphys x fv_nphys subcells ! ! there are new vertices on each coarse edge (fv_phys - 1) , and (fv_nphys - 1) * (fv_nphys - 1) ! new vertices on each coarse cell - nverts_pg = nverts_c + (fv_nphys - 1) * nedges_c + (fv_nphys - 1) * (fv_nphys - 1) * nelemd + allocate (local_cell_gids(nelemd)) + allocate (indx_cell(nelemd)) + allocate (edge(2,nedges_c)) ! + do ie=1, nelemd ! + local_cell_gids(ie) = elem(ie)%GlobalID + enddo + call IndexSet(nelemd, indx_cell) + call IndexSort(nelemd, indx_cell, local_cell_gids, descend=.false.) + print *, ' local_cell_gids ', local_cell_gids + print *, ' indx_cell ', indx_cell + allocate( elem_edge (4, nelemd) ) + edge_index = 0 + do ie=1, nelemd ! + ! we need to check if neighbor is with id smaller; that means it was already created ? + print *, '-------------- ' + print *, ' elem ', ie, elem(ie)%desc%actual_neigh_edges, elem(ie)%vertex%number, elem(ie)%GlobalID + print *, ' nodes ', ( moabconn_c( (ie-1)*4+j), j=1,4 ) + print *, ' ids ', (vdone_c( moabconn_c( (ie-1)*4+j) ), j=1,4) + print *, ' neigh: ', (elem(ie)%desc%globalID(j), j=1,4) + print *, ' neigh order ', ( elem(ie)%desc%globalID(nat_edge_order(j)),j = 1,4 ) + k = elem(ie)%GlobalID ! current id + do j = 1,4 + ix = j+1 + if (ix .eq. 5) ix = 1 ! next vertex in connectivity array + neigh = elem(ie)%desc%globalID(nat_edge_order(j)) ! id neighbor + idx = search_in(local_cell_gids, nelemd, neigh) ! index in local cells + print *, ' ', j, 'neigh:', neigh, ' index' , idx + + if ( idx .gt. 0 ) then + ! a local edge is interior + + if (k < neigh) then ! form the edge, increment edge index + edge_index = edge_index + 1 + edge(1, edge_index) = moabconn_c(4*(ie-1) + j) ! first vertex + edge(2, edge_index) = moabconn_c(4*(ie-1) + ix) ! second vertex index + elem_edge(j, ie) = edge_index + internal_edges = internal_edges + 1 + print *, ' edge:', edge_index, edge(1, edge_index), edge(2, edge_index), 'verts:' , & + vdone_c(edge(1, edge_index)), vdone_c(edge(2, edge_index)), ' element ', ie, ' intedge:', internal_edges + + else + ! find the edge in the other list elem(idx)%globalID( nat_edge_order(j) ) + do j1 = 1,4 + if ( elem(idx)%desc%globalID( nat_edge_order(j1) ) .eq. k ) then + elem_edge(j, ie) = - elem_edge(j1, idx) ! inverse oriented + reverse_edges = reverse_edges + 1 + print *, ' negative edge: ', elem_edge(j, ie), edge(1, -elem_edge(j, ie)), edge(2, -elem_edge(j, ie)), & + 'verts:', vdone_c(edge(1, -elem_edge(j, ie))), vdone_c(edge(2, -elem_edge(j, ie))), 'indx neg', reverse_edges + endif + enddo + + endif + else ! idx is 0, so it means the edge is on the boundary, form it + edge_index = edge_index + 1 + edge(1, edge_index) = moabconn_c(4*(ie-1) + j) ! first vertex + edge(2, edge_index) = moabconn_c(4*(ie-1) + ix) ! second vertex index + elem_edge(j, ie) = edge_index + boundary_edges = boundary_edges + 1 + print *, ' edge:', edge_index, edge(1, edge_index), edge(2, edge_index), 'verts:' , & + vdone_c(edge(1, edge_index)), vdone_c(edge(2, edge_index)), ' element ', ie, & + ' bedge:', boundary_edges + endif + enddo + enddo + ! show off + nverts_pg = nverts_c + (fv_nphys - 1) * edge_index + (fv_nphys - 1) * (fv_nphys - 1) * nelemd + print *, " MOAB: there are ", nverts_pg, " local vertices on master task on pg mesh ", edge_index , " local coarse edges ", & + boundary_edges , ' boundary edges ' if(par%masterproc) then - write (iulog, *) " MOAB: there are ", nverts_pg, " local vertices on master task on pg mesh ", nedges_c , " local coarse edges " + write (iulog, *) " MOAB: there are ", nverts_pg, " local vertices on master task on pg mesh ", edge_index , " local coarse edges " endif + print *, '\n ELEMENTS: ' + do ie=1,nelemd + print *, ie, elem(ie)%GlobalID, ' local nodes:', ( moabconn_c( (ie-1)*4+j), j=1,4 ), ' edges:', (elem_edge(j, ie), j=1,4) + enddo + print *, '\n EDGES:' + do ie=1,edge_index + print *, ie, (edge(j, ie), j=1,2) + enddo + endif From 2ca2b4106037664ca144e2ba018f4fa1473d5fae Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Wed, 2 Sep 2020 10:59:02 -0500 Subject: [PATCH 059/467] instance all moab atm meshes need to reuse the pg2 computed after phys grid init, not --- components/homme/src/tool/semoab_mod.F90 | 163 ++++++++++++++++++++++- 1 file changed, 162 insertions(+), 1 deletion(-) diff --git a/components/homme/src/tool/semoab_mod.F90 b/components/homme/src/tool/semoab_mod.F90 index 231779f09284..560026e82ad5 100644 --- a/components/homme/src/tool/semoab_mod.F90 +++ b/components/homme/src/tool/semoab_mod.F90 @@ -79,7 +79,7 @@ end function search_in subroutine create_moab_mesh_fine(par, elem) use ISO_C_BINDING - use coordinate_systems_mod, only : cartesian3D_t, spherical_to_cart + use coordinate_systems_mod, only : cartesian3D_t, spherical_to_cart, spherical_polar_t type (element_t), intent(inout) :: elem(:) type (parallel_t) , intent(in) :: par @@ -115,9 +115,14 @@ subroutine create_moab_mesh_fine(par, elem) integer nedges_c, nverts_pg, nelem_pg, edge_index, j1 integer, dimension(:), allocatable :: local_cell_gids, indx_cell integer, dimension(:,:), allocatable :: elem_edge, edge + integer, dimension(:), allocatable :: vdone_pg, moabconn_pg integer nat_edge_order(4) integer internal_edges, boundary_edges, reverse_edges + integer edge_verts(4) ! local per coarse element ! nverts_c < edge_verts <= nverts_c + edge_index + integer middle_vertex ! nverts_c + edge_index < middle_vertex <= verts_pg + type (spherical_polar_t) :: current_2d_vertex + logical pos_edge ! when looping over edges , use gdof for marking !! nat_edge_order = (/south, east, north, west/) @@ -625,7 +630,163 @@ subroutine create_moab_mesh_fine(par, elem) do ie=1,edge_index print *, ie, (edge(j, ie), j=1,2) enddo + ! now generate phys grid, uniform FV type mesh; + ! 2 cases: fv_nphys is 1 or 2; when 2, we need new nodes; will use the same id as + ! the gdof on edge is used, with the smaller id chosen, among + allocate(moabconn_pg(4*nelem_pg)) ! connectivity + ! reuse moab_vert_coords for coordinates of pg mesh + ! the first nverts_c coords are the same as coarse mesh; but we do create new + allocate(vdone_pg(nverts_pg)) + do iv = 1, nverts_c + vdone_pg(iv) = vdone_c(iv) ! also the coordinates will be the same !! + enddo + + ! copy the coordinates from the middle + j1 = 0 ! index in edge vertices; increase only for positive edges + ! still need some + if (fv_nphys .eq. 3) then + current_2d_vertex%r = 1. + do ie = 1,nelemd + do j=1,4 + idx = elem_edge(j, ie) ! + if (idx .gt. 0) then ! increment edges, add vertex ! + j1 = j1 + 1 ! index in moab_vert_coords for edges ! nverts_c + j1 for vertex edges ! + ! current_2d_vertex%lat, current_2d_vertex%lon + pos_edge = .true. + iv = nverts_c + j1 + edge_verts(j) = iv ! to form the local connectivity array + if ( vdone_c(edge(1, idx)) .gt. vdone_c(edge(2, edge_index)) ) pos_edge = .false. + if (j .eq. 1) then + current_2d_vertex%lat = fv_physgrid(ie)%corner_lat(1,1,2) + current_2d_vertex%lon = fv_physgrid(ie)%corner_lon(1,1,2) + if (pos_edge) then + vdone_pg (iv) = elem(ie)%gdofP(2,1) ! + else + vdone_pg (iv) = elem(ie)%gdofP(np-1,1) ! + endif + else if (j .eq. 2) then + current_2d_vertex%lat = fv_physgrid(ie)%corner_lat(1,2,3) + current_2d_vertex%lon = fv_physgrid(ie)%corner_lon(1,2,3) + if (pos_edge) then + vdone_pg (iv) = elem(ie)%gdofP(np,2) ! + else + vdone_pg (iv) = elem(ie)%gdofP(np,np - 1) ! + endif + else if (j .eq. 3) then + current_2d_vertex%lat = fv_physgrid(ie)%corner_lat(2,2,4) + current_2d_vertex%lon = fv_physgrid(ie)%corner_lon(2,2,4) + if (pos_edge) then + vdone_pg (iv) = elem(ie)%gdofP(np-1,np) ! + else + vdone_pg (iv) = elem(ie)%gdofP(2,np) ! + endif + else ! if (j .eq. 4) + current_2d_vertex%lat = fv_physgrid(ie)%corner_lat(1,2,1) + current_2d_vertex%lon = fv_physgrid(ie)%corner_lon(1,2,1) + if (pos_edge) then + vdone_pg (iv) = elem(ie)%gdofP(1,np-1) ! + else + vdone_pg (iv) = elem(ie)%gdofP(1,2) ! + endif + endif + ! create the 3d vertex ! + cart = spherical_to_cart (current_2d_vertex ) + moab_vert_coords ( 3*(iv-1)+1 ) = cart%x + moab_vert_coords ( 3*(iv-1)+2 ) = cart%y + moab_vert_coords ( 3*(iv-1)+3 ) = cart%z + else ! the vertex was already created, but we need the index for connectivity of local fv cells + edge_verts(j) = nverts_c + ( -idx ) ! idx is index of edge (negative for already created) + endif + + enddo ! do j=1,4 + ! create the middle vertex too, in the center + current_2d_vertex%lat = fv_physgrid(ie)%corner_lat(1,1,3) + current_2d_vertex%lon = fv_physgrid(ie)%corner_lon(1,1,3) + iv = nverts_c + edge_index + ie ! middle vertices are after corners, and edge vertices + middle_vertex = iv + vdone_pg (middle_vertex) = elem(ie)%gdofP(2,2) ! first in the interior, not on edges! + cart = spherical_to_cart (current_2d_vertex ) + moab_vert_coords ( 3*(iv-1)+1 ) = cart%x + moab_vert_coords ( 3*(iv-1)+2 ) = cart%y + moab_vert_coords ( 3*(iv-1)+3 ) = cart%z + + ! now form the local 2x2 cells, one by one; set the global id tag too! + idx = (ie-1)*4 + ! first + moabconn_pg(idx + 1) = moabconn_c(4*(ie-1)+1) + moabconn_pg(idx + 2) = edge_verts(1) + moabconn_pg(idx + 3) = middle_vertex + moabconn_pg(idx + 4) = edge_verts(4) + elemids(idx+1) = (elem(ie)%GlobalId-1)*4+1 + ! second + moabconn_pg(idx + 4 + 1) = edge_verts(1) + moabconn_pg(idx + 4 + 2) = moabconn_c(4*(ie-1)+2) + moabconn_pg(idx + 4 + 3) = edge_verts(2) + moabconn_pg(idx + 4 + 4) = middle_vertex + elemids(idx+2) = (elem(ie)%GlobalId-1)*4+2 + ! third + moabconn_pg(idx + 8 + 1) = edge_verts(4) + moabconn_pg(idx + 8 + 2) = middle_vertex + moabconn_pg(idx + 8 + 3) = edge_verts(3) + moabconn_pg(idx + 8 + 4) = moabconn_c(4*(ie-1)+4) + elemids(idx+3) = (elem(ie)%GlobalId-1)*4+3 + ! fourth + moabconn_pg(idx + 12 + 1) = middle_vertex + moabconn_pg(idx + 12 + 2) = edge_verts(2) + moabconn_pg(idx + 12 + 3) = moabconn_c(4*(ie-1)+3) + moabconn_pg(idx + 12 + 4) = edge_verts(3) + elemids(idx+4) = (elem(ie)%GlobalId-1)*4+4 + enddo + ! now copy from coarse for pg mesh + + dimcoord = nverts_pg*3 + dimen = 3 + ierr = iMOAB_CreateVertices(MHPGID, dimcoord, dimen, moab_vert_coords) + if (ierr > 0 ) & + call endrun('Error: fail to create MOAB vertices ') + + ! num_el = nelem_pg * + mbtype = 3 ! quadrilateral + nve = 4; + block_ID = 300 ! this will be for pg mesh + + ierr = iMOAB_CreateElements( MHPGID, nelem_pg, mbtype, nve, moabconn_pg, block_ID ); + if (ierr > 0 ) & + call endrun('Error: fail to create MOAB elements') + + tagname='GLOBAL_ID'//CHAR(0) + tagtype = 0 ! dense, integer + numco = 1 + ierr = iMOAB_DefineTagStorage(MHPGID, tagname, tagtype, numco, tagindex ) + if (ierr > 0 ) & + call endrun('Error: fail to retrieve GLOBAL id tag') + + ! now set the values + ent_type = 0 ! vertex type + ierr = iMOAB_SetIntTagStorage ( MHPGID, tagname, nverts_pg , ent_type, vdone_pg) + if (ierr > 0 ) & + call endrun('Error: fail to set global id tag for vertices') + ! set global id tag for pg2 elements, too; they will start at nets=1, end at nete=nelemd*4 + ent_type = 1 ! now set the global id tag on elements + ierr = iMOAB_SetIntTagStorage ( MHPGID, tagname, nelem_pg , ent_type, elemids) + if (ierr > 0 ) & + call endrun('Error: fail to set global id tag for edges') + + ierr = iMOAB_ResolveSharedEntities( MHPGID, nverts_pg, vdone_pg ); + + ierr = iMOAB_UpdateMeshInfo(MHPGID) + if (ierr > 0 ) & + call endrun('Error: fail to update mesh info for pg2 mesh') +#ifdef MOABDEBUG + ! write out the mesh file to disk, in parallel + outfile = 'wholeATM_PG2.h5m'//CHAR(0) + wopts = 'PARALLEL=WRITE_PART'//CHAR(0) + ierr = iMOAB_WriteMesh(MHPGID, outfile, wopts) + if (ierr > 0 ) & + call endrun('Error: fail to write the mesh file') +#endif + endif ! only valid for pg == 2 endif From 13ceb95edd3c2e7386c351a0ec2df62248ec21dc Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Wed, 2 Sep 2020 15:40:01 -0500 Subject: [PATCH 060/467] Correct connectivity for pg2 mesh connectivity is still wrong; [BFB] - Bit-For-Bit --- components/eam/src/dynamics/se/dyn_comp.F90 | 4 ++ .../homme/src/share/prim_driver_base.F90 | 28 +++++++++---- components/homme/src/tool/semoab_mod.F90 | 39 ++++++++++--------- 3 files changed, 45 insertions(+), 26 deletions(-) diff --git a/components/eam/src/dynamics/se/dyn_comp.F90 b/components/eam/src/dynamics/se/dyn_comp.F90 index 81e42940fb98..849b8a7ddbbc 100644 --- a/components/eam/src/dynamics/se/dyn_comp.F90 +++ b/components/eam/src/dynamics/se/dyn_comp.F90 @@ -106,6 +106,7 @@ subroutine dyn_init1(fh, NLFileName, dyn_in, dyn_out) use seq_comm_mct, only: MHID, MHFID ! id of homme moab coarse and fine applications use seq_comm_mct, only: ATMID use seq_comm_mct, only: mhpgid ! id of pgx moab application + use prim_driver_base, only: prim_init_moab_mesh ! insertion point for MOAB; after phys grid init #endif ! PARAMETERS: @@ -248,6 +249,9 @@ subroutine dyn_init1(fh, NLFileName, dyn_in, dyn_out) call fv_physgrid_init() end if +#ifdef HAVE_MOAB + call prim_init_moab_mesh(elem,par) +#endif ! Define the CAM grids (this has to be after dycore spinup). ! Physics-grid will be defined later by phys_grid_init call define_cam_grids() diff --git a/components/homme/src/share/prim_driver_base.F90 b/components/homme/src/share/prim_driver_base.F90 index 4b82559e1eb2..c181e7762e0c 100644 --- a/components/homme/src/share/prim_driver_base.F90 +++ b/components/homme/src/share/prim_driver_base.F90 @@ -44,6 +44,10 @@ module prim_driver_base public :: prim_init1_no_cam #endif +#ifdef HAVE_MOAB + public :: prim_init_moab_mesh +#endif + public :: smooth_topo_datasets, deriv1 public :: applyCAMforcing_tracers @@ -694,9 +698,7 @@ subroutine prim_init1_buffers (elem,par) use dimensions_mod, only : max_corner_elem use compose_mod, only : compose_query_bufsz, compose_set_bufs #endif -#ifdef HAVE_MOAB - use semoab_mod, only : create_moab_mesh_fine -#endif + ! ! Inputs @@ -706,10 +708,6 @@ subroutine prim_init1_buffers (elem,par) integer :: edgesz, sendsz, recvsz, n, den -#ifdef HAVE_MOAB - call create_moab_mesh_fine(par, elem) -#endif - call prim_advance_init1(par,elem,integration) #ifdef TRILINOS call prim_implicit_init(par, elem) @@ -742,6 +740,22 @@ subroutine prim_init1_buffers (elem,par) end subroutine prim_init1_buffers +#ifdef HAVE_MOAB + subroutine prim_init_moab_mesh(elem,par) + + use parallel_mod, only : parallel_t + use semoab_mod, only : create_moab_meshes + + ! + ! Inputs + ! + type (element_t), pointer :: elem(:) + type (parallel_t), intent(in) :: par + + call create_moab_meshes(par, elem) + + end subroutine prim_init_moab_mesh +#endif !_____________________________________________________________________ subroutine prim_init2(elem, hybrid, nets, nete, tl, hvcoord) diff --git a/components/homme/src/tool/semoab_mod.F90 b/components/homme/src/tool/semoab_mod.F90 index 560026e82ad5..eb7cafab38f0 100644 --- a/components/homme/src/tool/semoab_mod.F90 +++ b/components/homme/src/tool/semoab_mod.F90 @@ -76,7 +76,7 @@ integer function search_in(intarr, leng, value) end function search_in - subroutine create_moab_mesh_fine(par, elem) + subroutine create_moab_meshes(par, elem) use ISO_C_BINDING use coordinate_systems_mod, only : cartesian3D_t, spherical_to_cart, spherical_polar_t @@ -644,7 +644,7 @@ subroutine create_moab_mesh_fine(par, elem) ! copy the coordinates from the middle j1 = 0 ! index in edge vertices; increase only for positive edges ! still need some - if (fv_nphys .eq. 3) then + if (fv_nphys .eq. 2) then current_2d_vertex%r = 1. do ie = 1,nelemd do j=1,4 @@ -712,29 +712,30 @@ subroutine create_moab_mesh_fine(par, elem) ! now form the local 2x2 cells, one by one; set the global id tag too! idx = (ie-1)*4 + ix = idx * 4 ! ! first - moabconn_pg(idx + 1) = moabconn_c(4*(ie-1)+1) - moabconn_pg(idx + 2) = edge_verts(1) - moabconn_pg(idx + 3) = middle_vertex - moabconn_pg(idx + 4) = edge_verts(4) + moabconn_pg(ix + 1) = moabconn_c(4*(ie-1)+1) + moabconn_pg(ix + 2) = edge_verts(1) + moabconn_pg(ix + 3) = middle_vertex + moabconn_pg(ix + 4) = edge_verts(4) elemids(idx+1) = (elem(ie)%GlobalId-1)*4+1 ! second - moabconn_pg(idx + 4 + 1) = edge_verts(1) - moabconn_pg(idx + 4 + 2) = moabconn_c(4*(ie-1)+2) - moabconn_pg(idx + 4 + 3) = edge_verts(2) - moabconn_pg(idx + 4 + 4) = middle_vertex + moabconn_pg(ix + 4 + 1) = edge_verts(1) + moabconn_pg(ix + 4 + 2) = moabconn_c(4*(ie-1)+2) + moabconn_pg(ix + 4 + 3) = edge_verts(2) + moabconn_pg(ix + 4 + 4) = middle_vertex elemids(idx+2) = (elem(ie)%GlobalId-1)*4+2 ! third - moabconn_pg(idx + 8 + 1) = edge_verts(4) - moabconn_pg(idx + 8 + 2) = middle_vertex - moabconn_pg(idx + 8 + 3) = edge_verts(3) - moabconn_pg(idx + 8 + 4) = moabconn_c(4*(ie-1)+4) + moabconn_pg(ix + 8 + 1) = edge_verts(4) + moabconn_pg(ix + 8 + 2) = middle_vertex + moabconn_pg(ix + 8 + 3) = edge_verts(3) + moabconn_pg(ix + 8 + 4) = moabconn_c(4*(ie-1)+4) elemids(idx+3) = (elem(ie)%GlobalId-1)*4+3 ! fourth - moabconn_pg(idx + 12 + 1) = middle_vertex - moabconn_pg(idx + 12 + 2) = edge_verts(2) - moabconn_pg(idx + 12 + 3) = moabconn_c(4*(ie-1)+3) - moabconn_pg(idx + 12 + 4) = edge_verts(3) + moabconn_pg(ix + 12 + 1) = middle_vertex + moabconn_pg(ix + 12 + 2) = edge_verts(2) + moabconn_pg(ix + 12 + 3) = moabconn_c(4*(ie-1)+3) + moabconn_pg(ix + 12 + 4) = edge_verts(3) elemids(idx+4) = (elem(ie)%GlobalId-1)*4+4 enddo @@ -806,7 +807,7 @@ subroutine create_moab_mesh_fine(par, elem) deallocate(vdone_c) ! end copy - end subroutine create_moab_mesh_fine + end subroutine create_moab_meshes subroutine moab_export_data(elem) From 72fa3315ca3c2546d621a788930676b058a113ff Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Wed, 9 Sep 2020 20:14:59 -0500 Subject: [PATCH 061/467] use global id from gdofel not from GDOF elem()%gdof() does not have global ids only gdofel local array has them [BFB] - Bit-For-Bit --- components/homme/src/tool/semoab_mod.F90 | 29 ++++++++++++++---------- 1 file changed, 17 insertions(+), 12 deletions(-) diff --git a/components/homme/src/tool/semoab_mod.F90 b/components/homme/src/tool/semoab_mod.F90 index eb7cafab38f0..6f68404ade4b 100644 --- a/components/homme/src/tool/semoab_mod.F90 +++ b/components/homme/src/tool/semoab_mod.F90 @@ -562,6 +562,8 @@ subroutine create_moab_meshes(par, elem) print *, ' local_cell_gids ', local_cell_gids print *, ' indx_cell ', indx_cell allocate( elem_edge (4, nelemd) ) + print *, '------------------------------- ' + print *, "RANK:", par%rank edge_index = 0 do ie=1, nelemd ! ! we need to check if neighbor is with id smaller; that means it was already created ? @@ -647,6 +649,7 @@ subroutine create_moab_meshes(par, elem) if (fv_nphys .eq. 2) then current_2d_vertex%r = 1. do ie = 1,nelemd + ix = (ie-1)*np*np ! ie: index in coarse element do j=1,4 idx = elem_edge(j, ie) ! if (idx .gt. 0) then ! increment edges, add vertex ! @@ -655,38 +658,38 @@ subroutine create_moab_meshes(par, elem) pos_edge = .true. iv = nverts_c + j1 edge_verts(j) = iv ! to form the local connectivity array - if ( vdone_c(edge(1, idx)) .gt. vdone_c(edge(2, edge_index)) ) pos_edge = .false. + if ( vdone_c(edge(1, idx)) .gt. vdone_c(edge(2, idx)) ) pos_edge = .false. if (j .eq. 1) then current_2d_vertex%lat = fv_physgrid(ie)%corner_lat(1,1,2) current_2d_vertex%lon = fv_physgrid(ie)%corner_lon(1,1,2) if (pos_edge) then - vdone_pg (iv) = elem(ie)%gdofP(2,1) ! + vdone_pg (iv) = gdofel(ix + 2) ! elem(ie)%gdofP(2,1) ! gdofel(ix+ (j-1)*np + i) else - vdone_pg (iv) = elem(ie)%gdofP(np-1,1) ! + vdone_pg (iv) = gdofel(ix + np - 1) !elem(ie)%gdofP(np-1,1) ! endif else if (j .eq. 2) then - current_2d_vertex%lat = fv_physgrid(ie)%corner_lat(1,2,3) - current_2d_vertex%lon = fv_physgrid(ie)%corner_lon(1,2,3) + current_2d_vertex%lat = fv_physgrid(ie)%corner_lat(2,1,3) + current_2d_vertex%lon = fv_physgrid(ie)%corner_lon(2,1,3) if (pos_edge) then - vdone_pg (iv) = elem(ie)%gdofP(np,2) ! + vdone_pg (iv) = gdofel(ix + (2 - 1) * np + np)!elem(ie)%gdofP(np,2) ! ! gdofel(ix+ (j-1)*np + i) else - vdone_pg (iv) = elem(ie)%gdofP(np,np - 1) ! + vdone_pg (iv) = gdofel(ix + (np - 2) * np + np)!elem(ie)%gdofP(np,np - 1) ! endif else if (j .eq. 3) then current_2d_vertex%lat = fv_physgrid(ie)%corner_lat(2,2,4) current_2d_vertex%lon = fv_physgrid(ie)%corner_lon(2,2,4) if (pos_edge) then - vdone_pg (iv) = elem(ie)%gdofP(np-1,np) ! + vdone_pg (iv) = gdofel(ix+ (np - 1) * np + np - 1)!elem(ie)%gdofP(np-1,np) ! else - vdone_pg (iv) = elem(ie)%gdofP(2,np) ! + vdone_pg (iv) = gdofel(ix+ (np-1)*np + 2) !elem(ie)%gdofP(2,np) ! endif else ! if (j .eq. 4) current_2d_vertex%lat = fv_physgrid(ie)%corner_lat(1,2,1) current_2d_vertex%lon = fv_physgrid(ie)%corner_lon(1,2,1) if (pos_edge) then - vdone_pg (iv) = elem(ie)%gdofP(1,np-1) ! + vdone_pg (iv) = gdofel(ix+ (np - 2)*np + 1) !elem(ie)%gdofP(1,np-1) ! else - vdone_pg (iv) = elem(ie)%gdofP(1,2) ! + vdone_pg (iv) = gdofel(ix+ ( 2 - 1 )*np + 1) ! elem(ie)%gdofP(1,2) ! endif endif ! create the 3d vertex ! @@ -694,6 +697,7 @@ subroutine create_moab_meshes(par, elem) moab_vert_coords ( 3*(iv-1)+1 ) = cart%x moab_vert_coords ( 3*(iv-1)+2 ) = cart%y moab_vert_coords ( 3*(iv-1)+3 ) = cart%z + print *, 'ie, j, iv, vdone_pg(iv): ', ie, j, iv, vdone_pg(iv) else ! the vertex was already created, but we need the index for connectivity of local fv cells edge_verts(j) = nverts_c + ( -idx ) ! idx is index of edge (negative for already created) endif @@ -704,7 +708,8 @@ subroutine create_moab_meshes(par, elem) current_2d_vertex%lon = fv_physgrid(ie)%corner_lon(1,1,3) iv = nverts_c + edge_index + ie ! middle vertices are after corners, and edge vertices middle_vertex = iv - vdone_pg (middle_vertex) = elem(ie)%gdofP(2,2) ! first in the interior, not on edges! + vdone_pg (middle_vertex) = gdofel(ix+ np + 2)!elem(ie)%gdofP(2,2) ! first in the interior, not on edges! + print *, 'ie, middle = iv, vdone_pg(iv): ', ie, iv, vdone_pg(iv) cart = spherical_to_cart (current_2d_vertex ) moab_vert_coords ( 3*(iv-1)+1 ) = cart%x moab_vert_coords ( 3*(iv-1)+2 ) = cart%y From 4b3be6855a5c6e479f9c393b25e2709f5d8e3d1d Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Wed, 9 Sep 2020 20:27:44 -0500 Subject: [PATCH 062/467] comment out print statements --- components/homme/src/tool/semoab_mod.F90 | 60 ++++++++++++------------ 1 file changed, 30 insertions(+), 30 deletions(-) diff --git a/components/homme/src/tool/semoab_mod.F90 b/components/homme/src/tool/semoab_mod.F90 index 6f68404ade4b..87994f970361 100644 --- a/components/homme/src/tool/semoab_mod.F90 +++ b/components/homme/src/tool/semoab_mod.F90 @@ -559,27 +559,27 @@ subroutine create_moab_meshes(par, elem) enddo call IndexSet(nelemd, indx_cell) call IndexSort(nelemd, indx_cell, local_cell_gids, descend=.false.) - print *, ' local_cell_gids ', local_cell_gids - print *, ' indx_cell ', indx_cell + ! print *, ' local_cell_gids ', local_cell_gids + ! print *, ' indx_cell ', indx_cell allocate( elem_edge (4, nelemd) ) - print *, '------------------------------- ' - print *, "RANK:", par%rank + ! print *, '------------------------------- ' + ! print *, "RANK:", par%rank edge_index = 0 do ie=1, nelemd ! ! we need to check if neighbor is with id smaller; that means it was already created ? - print *, '-------------- ' - print *, ' elem ', ie, elem(ie)%desc%actual_neigh_edges, elem(ie)%vertex%number, elem(ie)%GlobalID - print *, ' nodes ', ( moabconn_c( (ie-1)*4+j), j=1,4 ) - print *, ' ids ', (vdone_c( moabconn_c( (ie-1)*4+j) ), j=1,4) - print *, ' neigh: ', (elem(ie)%desc%globalID(j), j=1,4) - print *, ' neigh order ', ( elem(ie)%desc%globalID(nat_edge_order(j)),j = 1,4 ) + ! print *, '-------------- ' + ! print *, ' elem ', ie, elem(ie)%desc%actual_neigh_edges, elem(ie)%vertex%number, elem(ie)%GlobalID + ! print *, ' nodes ', ( moabconn_c( (ie-1)*4+j), j=1,4 ) + ! print *, ' ids ', (vdone_c( moabconn_c( (ie-1)*4+j) ), j=1,4) + ! print *, ' neigh: ', (elem(ie)%desc%globalID(j), j=1,4) + ! print *, ' neigh order ', ( elem(ie)%desc%globalID(nat_edge_order(j)),j = 1,4 ) k = elem(ie)%GlobalID ! current id do j = 1,4 ix = j+1 if (ix .eq. 5) ix = 1 ! next vertex in connectivity array neigh = elem(ie)%desc%globalID(nat_edge_order(j)) ! id neighbor idx = search_in(local_cell_gids, nelemd, neigh) ! index in local cells - print *, ' ', j, 'neigh:', neigh, ' index' , idx + ! print *, ' ', j, 'neigh:', neigh, ' index' , idx if ( idx .gt. 0 ) then ! a local edge is interior @@ -590,8 +590,8 @@ subroutine create_moab_meshes(par, elem) edge(2, edge_index) = moabconn_c(4*(ie-1) + ix) ! second vertex index elem_edge(j, ie) = edge_index internal_edges = internal_edges + 1 - print *, ' edge:', edge_index, edge(1, edge_index), edge(2, edge_index), 'verts:' , & - vdone_c(edge(1, edge_index)), vdone_c(edge(2, edge_index)), ' element ', ie, ' intedge:', internal_edges + ! print *, ' edge:', edge_index, edge(1, edge_index), edge(2, edge_index), 'verts:' , & + ! vdone_c(edge(1, edge_index)), vdone_c(edge(2, edge_index)), ' element ', ie, ' intedge:', internal_edges else ! find the edge in the other list elem(idx)%globalID( nat_edge_order(j) ) @@ -599,8 +599,8 @@ subroutine create_moab_meshes(par, elem) if ( elem(idx)%desc%globalID( nat_edge_order(j1) ) .eq. k ) then elem_edge(j, ie) = - elem_edge(j1, idx) ! inverse oriented reverse_edges = reverse_edges + 1 - print *, ' negative edge: ', elem_edge(j, ie), edge(1, -elem_edge(j, ie)), edge(2, -elem_edge(j, ie)), & - 'verts:', vdone_c(edge(1, -elem_edge(j, ie))), vdone_c(edge(2, -elem_edge(j, ie))), 'indx neg', reverse_edges + ! print *, ' negative edge: ', elem_edge(j, ie), edge(1, -elem_edge(j, ie)), edge(2, -elem_edge(j, ie)), & + ! 'verts:', vdone_c(edge(1, -elem_edge(j, ie))), vdone_c(edge(2, -elem_edge(j, ie))), 'indx neg', reverse_edges endif enddo @@ -611,27 +611,27 @@ subroutine create_moab_meshes(par, elem) edge(2, edge_index) = moabconn_c(4*(ie-1) + ix) ! second vertex index elem_edge(j, ie) = edge_index boundary_edges = boundary_edges + 1 - print *, ' edge:', edge_index, edge(1, edge_index), edge(2, edge_index), 'verts:' , & - vdone_c(edge(1, edge_index)), vdone_c(edge(2, edge_index)), ' element ', ie, & - ' bedge:', boundary_edges + ! print *, ' edge:', edge_index, edge(1, edge_index), edge(2, edge_index), 'verts:' , & + ! vdone_c(edge(1, edge_index)), vdone_c(edge(2, edge_index)), ' element ', ie, & + ! ' bedge:', boundary_edges endif enddo enddo ! show off nverts_pg = nverts_c + (fv_nphys - 1) * edge_index + (fv_nphys - 1) * (fv_nphys - 1) * nelemd - print *, " MOAB: there are ", nverts_pg, " local vertices on master task on pg mesh ", edge_index , " local coarse edges ", & - boundary_edges , ' boundary edges ' + ! print *, " MOAB: there are ", nverts_pg, " local vertices on master task on pg mesh ", edge_index , " local coarse edges ", & + ! boundary_edges , ' boundary edges ' if(par%masterproc) then write (iulog, *) " MOAB: there are ", nverts_pg, " local vertices on master task on pg mesh ", edge_index , " local coarse edges " endif - print *, '\n ELEMENTS: ' - do ie=1,nelemd - print *, ie, elem(ie)%GlobalID, ' local nodes:', ( moabconn_c( (ie-1)*4+j), j=1,4 ), ' edges:', (elem_edge(j, ie), j=1,4) - enddo - print *, '\n EDGES:' - do ie=1,edge_index - print *, ie, (edge(j, ie), j=1,2) - enddo + !print *, '\n ELEMENTS: ' + !do ie=1,nelemd + ! print *, ie, elem(ie)%GlobalID, ' local nodes:', ( moabconn_c( (ie-1)*4+j), j=1,4 ), ' edges:', (elem_edge(j, ie), j=1,4) + !enddo + !print *, '\n EDGES:' + !do ie=1,edge_index + ! print *, ie, (edge(j, ie), j=1,2) + !enddo ! now generate phys grid, uniform FV type mesh; ! 2 cases: fv_nphys is 1 or 2; when 2, we need new nodes; will use the same id as ! the gdof on edge is used, with the smaller id chosen, among @@ -697,7 +697,7 @@ subroutine create_moab_meshes(par, elem) moab_vert_coords ( 3*(iv-1)+1 ) = cart%x moab_vert_coords ( 3*(iv-1)+2 ) = cart%y moab_vert_coords ( 3*(iv-1)+3 ) = cart%z - print *, 'ie, j, iv, vdone_pg(iv): ', ie, j, iv, vdone_pg(iv) + ! print *, 'ie, j, iv, vdone_pg(iv): ', ie, j, iv, vdone_pg(iv) else ! the vertex was already created, but we need the index for connectivity of local fv cells edge_verts(j) = nverts_c + ( -idx ) ! idx is index of edge (negative for already created) endif @@ -709,7 +709,7 @@ subroutine create_moab_meshes(par, elem) iv = nverts_c + edge_index + ie ! middle vertices are after corners, and edge vertices middle_vertex = iv vdone_pg (middle_vertex) = gdofel(ix+ np + 2)!elem(ie)%gdofP(2,2) ! first in the interior, not on edges! - print *, 'ie, middle = iv, vdone_pg(iv): ', ie, iv, vdone_pg(iv) + ! print *, 'ie, middle = iv, vdone_pg(iv): ', ie, iv, vdone_pg(iv) cart = spherical_to_cart (current_2d_vertex ) moab_vert_coords ( 3*(iv-1)+1 ) = cart%x moab_vert_coords ( 3*(iv-1)+2 ) = cart%y From 6073c09e8f0b60c827c3e429fa84921aaee9dab4 Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Sun, 13 Sep 2020 08:58:52 -0500 Subject: [PATCH 063/467] introduce pg atm mesh to the comp exchange atm_pg_active flag is defined in seq_comm_mct, to signal if we are using pgx atm mesh maybe it will become default if active, send FV / PG mesh, not coarse it has important implications on sending/receiving tags [BFB] - Bit-For-Bit --- components/homme/src/tool/semoab_mod.F90 | 3 +++ driver-mct/shr/seq_comm_mct.F90 | 2 ++ driver-moab/main/cplcomp_exchange_mod.F90 | 27 ++++++++++++++++++----- 3 files changed, 27 insertions(+), 5 deletions(-) diff --git a/components/homme/src/tool/semoab_mod.F90 b/components/homme/src/tool/semoab_mod.F90 index 87994f970361..a04bd601f5bf 100644 --- a/components/homme/src/tool/semoab_mod.F90 +++ b/components/homme/src/tool/semoab_mod.F90 @@ -22,6 +22,7 @@ module semoab_mod use seq_comm_mct, only: MHID, MHFID ! app id on moab side, for homme moab coarse and fine mesh use seq_comm_mct, only: MHPGID ! app id on moab side, for PGx style mesh, uniform from se + use seq_comm_mct, only: atm_pg_active ! turn it on when PG style mesh active use dyn_grid, only: fv_nphys, fv_physgrid ! phys grid mesh will be replicated too @@ -540,6 +541,7 @@ subroutine create_moab_meshes(par, elem) if (fv_nphys > 0 ) then ! create FV mesh, base on PGx + atm_pg_active = .true. ! from now on, we will migrate / send tags for FV / ATM_PG2 mesh ! first count the number of edges in the coarse mesh; ! use euler: v-m+f = 2 => m = v + f - 2 nedges_c = nverts_c + nelemd - 1 ! could be more, if unconnected regions ? @@ -826,6 +828,7 @@ subroutine moab_export_data(elem) real(kind=real_kind), allocatable :: valuesTag(:) character*100 outfile, wopts, tagname, lnum + if (atm_pg_active) return ! do nothing here, as we do not have to migrate from here; ! count number of calls num_calls_export = num_calls_export + 1 diff --git a/driver-mct/shr/seq_comm_mct.F90 b/driver-mct/shr/seq_comm_mct.F90 index 671a9de71708..bbcd77b910d4 100644 --- a/driver-mct/shr/seq_comm_mct.F90 +++ b/driver-mct/shr/seq_comm_mct.F90 @@ -216,6 +216,8 @@ module seq_comm_mct integer, external :: iMOAB_InitializeFortran integer, public :: mhid, mhfid, mpoid, mlnid ! homme, homme fine, ocean, land moab ids integer, public :: mhpgid ! iMOAB id for atm pgx grid, on atm pes; created with se and gll grids + logical, public :: atm_pg_active = .false. ! whether the atm uses FV mesh or not ; made true if fv_nphys > 0 + logical, public :: diff_atm_land = .false. ! whether atm and land use different mesh integer, public :: mphaid ! iMOAB id for atm phys grid, on atm pes integer, public :: mbaxid ! iMOAB id for atm migrated mesh to coupler pes integer, public :: mboxid ! iMOAB id for mpas ocean migrated mesh to coupler pes diff --git a/driver-moab/main/cplcomp_exchange_mod.F90 b/driver-moab/main/cplcomp_exchange_mod.F90 index e9426be5426a..838447d30818 100644 --- a/driver-moab/main/cplcomp_exchange_mod.F90 +++ b/driver-moab/main/cplcomp_exchange_mod.F90 @@ -14,9 +14,12 @@ module cplcomp_exchange_mod use seq_diag_mct use seq_comm_mct, only : mhid, mpoid, mbaxid, mboxid ! iMOAB app ids, for atm, ocean, ax mesh, ox mesh + use seq_comm_mct, only : mhpgid ! iMOAB app id for atm pgx grid, on atm pes + use seq_comm_mct, only : atm_pg_active ! flag if PG mesh instanced use seq_comm_mct, only : mlnid , mblxid ! iMOAB app id for land , on land pes and coupler pes use seq_comm_mct, only : mphaid ! iMOAB app id for phys atm; comp atm is 5, phys 5+200 use shr_mpi_mod, only: shr_mpi_max + use dimensions_mod, only : np ! for atmosphere implicit none private ! except @@ -1035,7 +1038,7 @@ subroutine cplcomp_moab_Init(comp) call seq_comm_getinfo(ID_new ,mpicom=mpicom_new) call seq_comm_getinfo(ID_join,mpicom=mpicom_join) - call shr_mpi_max(mhid, maxMH, mpicom_join, all=.true.) + call shr_mpi_max(mhid, maxMH, mpicom_join, all=.true.) ! if on atm / cpl joint, maxMH /= -1 call shr_mpi_max(mpoid, maxMPO, mpicom_join, all=.true.) call shr_mpi_max(mlnid, maxMLID, mpicom_join, all=.true.) if (seq_comm_iamroot(CPLID) ) then @@ -1049,7 +1052,12 @@ subroutine cplcomp_moab_Init(comp) ! now, if on coupler pes, receive mesh; if on comp pes, send mesh if (MPI_COMM_NULL /= mpicom_old ) then ! it means we are on the component pes (atmosphere) ! send mesh to coupler - ierr = iMOAB_SendMesh(mhid, mpicom_join, mpigrp_cplid, id_join, partMethod) + if (atm_pg_active) then ! change : send the pg2 mesh, not coarse mesh, when atm pg active + ierr = iMOAB_SendMesh(mhpgid, mpicom_join, mpigrp_cplid, id_join, partMethod) + else + ! still use the mhid, original coarse mesh + ierr = iMOAB_SendMesh(mhid, mpicom_join, mpigrp_cplid, id_join, partMethod) + endif endif if (MPI_COMM_NULL /= mpicom_new ) then ! we are on the coupler pes appname = "COUPLE_ATM"//CHAR(0) @@ -1064,9 +1072,14 @@ subroutine cplcomp_moab_Init(comp) ierr = iMOAB_WriteMesh(mbaxid, trim(outfile), trim(wopts)) #endif endif - ! iMOAB_FreeSenderBuffers needs to be called after receiving + ! iMOAB_FreeSenderBuffers needs to be called after receiving the mesh + if (mhid .ge. 0) then ! we are on component atm pes - ierr = iMOAB_FreeSenderBuffers(mhid, context_id) + if (atm_pg_active) then! we send mesh from mhpgid app + ierr = iMOAB_FreeSenderBuffers(mhpgid, context_id) + else + ierr = iMOAB_FreeSenderBuffers(mhid, context_id) + endif endif ! comment out now; we will not send directly to atm spectral on coupler; we need to send in the @@ -1093,7 +1106,11 @@ subroutine cplcomp_moab_Init(comp) if (mbaxid .ge. 0 ) then tagnameProj = 'T_ph16'//CHAR(0) tagtype = 1 ! dense, double - numco = 16 ! hard coded, 16 values per cell! + if (atm_pg_active) then + numco = 1 ! just one value per cell ! + else + numco = np*np ! usually 16 values per cell, GLL points; should be 4 x 4 = 16 + endif ierr = iMOAB_DefineTagStorage(mbaxid, tagnameProj, tagtype, numco, tagindex ) ! define more tags tagnameProj = 'u_ph16'//CHAR(0) ! U component of velocity From 1b456e198b9aafb55649038d04fdad830c75868f Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Sun, 13 Sep 2020 09:10:59 -0500 Subject: [PATCH 064/467] pg mesh and tri-grid start prep atm is changed in 2 major ways 1) pg mesh can be active now, an it is used for data transfer / projection 2) if land is coming from atm mesh, there is no intersection or projection needed, only comm graph directly , based on global_id of phys atm and global id of land mesh on top of it (they match) 3) start land on diff mesh logic; will need to instance land mesh for this to work; right now, land mesh is just a point cloud it will need to be proper mesh; connectivity and all enchilada [BFB] - Bit-For-Bit --- driver-moab/main/prep_atm_mod.F90 | 325 +++++++++++++++++++++--------- 1 file changed, 227 insertions(+), 98 deletions(-) diff --git a/driver-moab/main/prep_atm_mod.F90 b/driver-moab/main/prep_atm_mod.F90 index c0b68b9e8c4b..4e7a1d45d5f5 100644 --- a/driver-moab/main/prep_atm_mod.F90 +++ b/driver-moab/main/prep_atm_mod.F90 @@ -23,8 +23,11 @@ module prep_atm_mod use seq_comm_mct, only : mboxid ! iMOAB id for mpas ocean migrated mesh to coupler pes use seq_comm_mct, only : mbintxoa ! iMOAB id for intx mesh between ocean and atmosphere; output from this use seq_comm_mct, only : mhid ! iMOAB id for atm instance + use seq_comm_mct, only : mhpgid ! iMOAB id for atm pgx grid, on atm pes; created with se and gll grids + use seq_comm_mct, only : atm_pg_active ! whether the atm uses FV mesh or not ; made true if fv_nphys > 0 use seq_comm_mct, only : mblxid ! iMOAB id for land migrated to coupler pes !! old name : mlnxid use seq_comm_mct, only : mbintxla ! iMOAB id for intx mesh between land and atmosphere + use seq_comm_mct, only : diff_atm_land ! false by default, so land and atm on same mesh use seq_comm_mct, only : seq_comm_getinfo => seq_comm_setptrs use dimensions_mod, only : np ! for atmosphere @@ -266,7 +269,7 @@ subroutine prep_atm_init(infodata, ocn_c2_atm, ice_c2_atm, lnd_c2_atm, iac_c2_at ! idintx is a unique number of MOAB app that takes care of intx between lnd and atm mesh idintx = 100*atm(1)%cplcompid + lnd(1)%cplcompid ! something different, to differentiate it ierr = iMOAB_RegisterFortranApplication(trim(appname), mpicom_CPLID, idintx, mbintxla) - ierr = iMOAB_ComputePointDoFIntersection (mbaxid, mblxid, mbintxla) +! ierr = iMOAB_ComputePointDoFIntersection (mbaxid, mblxid, mbintxla) endif end if @@ -321,52 +324,68 @@ subroutine prep_atm_ocn_moab(infodata) call seq_comm_getinfo(ID_join,mpicom=mpicom_join) ! it happens over joint communicator - ierr = iMOAB_CoverageGraph(mpicom_join, mhid, mbaxid, mbintxoa, context_id); + if ( mbintxoa .ge. 0 ) then + if (atm_pg_active ) then ! use mhpgid mesh + ierr = iMOAB_CoverageGraph(mpicom_join, mhpgid, mbaxid, mbintxoa, context_id); + else + ierr = iMOAB_CoverageGraph(mpicom_join, mhid, mbaxid, mbintxoa, context_id); + endif + + wgtIdef = 'scalar'//CHAR(0) + if (atm_pg_active) then + dm1 = "fv"//CHAR(0) + dofnameATM="GLOBAL_ID"//CHAR(0) + orderATM = 1 ! fv-fv + volumetric = 1 ! maybe volumetric ? + else + dm1 = "cgll"//CHAR(0) + dofnameATM="GLOBAL_DOFS"//CHAR(0) + orderATM = np ! it should be 4 + volumetric = 0 + endif + dm2 = "fv"//CHAR(0) + dofnameOCN="GLOBAL_ID"//CHAR(0) + orderOCN = 1 ! not much arguing + monotonicity = 0 ! + noConserve = 0 + validate = 1 - wgtIdef = 'scalar'//CHAR(0) - dm1 = "cgll"//CHAR(0) - dm2 = "fv"//CHAR(0) - dofnameATM="GLOBAL_DOFS"//CHAR(0) - dofnameOCN="GLOBAL_ID"//CHAR(0) - orderATM = np ! it should be 4 - orderOCN = 1 ! not much arguing - monotonicity = 0 ! - volumetric = 0 - noConserve = 0 - validate = 1 - if (mbintxoa .ge. 0 ) then ierr = iMOAB_ComputeScalarProjectionWeights ( mbintxoa, wgtIdef, & trim(dm1), orderATM, trim(dm2), orderOCN, & monotonicity, volumetric, noConserve, validate, & trim(dofnameATM), trim(dofnameOCN) ) - endif - ! compute the comm graph between phys atm and intx-atm-ocn, to be able to send directly from phys atm - ! towards coverage mesh on atm for intx to ocean - ! this is similar to imoab_phatm_ocn_coupler.cpp test in moab - ! int typeA = 2; // point cloud - ! int typeB = 1; // quads in coverage set - ! ierr = iMOAB_ComputeCommGraph(cmpPhAtmPID, cplAtmOcnPID, &atmCouComm, &atmPEGroup, &couPEGroup, - ! &typeA, &typeB, &cmpatm, &atmocnid); - call seq_comm_getinfo(CPLID ,mpigrp=mpigrp_CPLID) ! second group, the coupler group CPLID is global variable - call seq_comm_getinfo(atm_id, mpigrp=mpigrp_old) ! component group pes, from atm id ( also ATMID(1) ) - - typeA = 2 ! point cloud, phys atm in this case - typeB = 1 ! atm cells involved in intersection (spectral in this case) - ! idintx is a unique number of MOAB app that takes care of intx between ocn and atm mesh - idintx = 100*atm(1)%cplcompid + ocn(1)%cplcompid ! something different, to differentiate it; ~ 618 ! - ierr = iMOAB_ComputeCommGraph( mphaid, mbintxoa, mpicom_join, mpigrp_old, mpigrp_CPLID, & - typeA, typeB, atm_id, idintx) + ! compute the comm graph between phys atm and intx-atm-ocn, to be able to send directly from phys atm + ! towards coverage mesh on atm for intx to ocean + ! this is similar to imoab_phatm_ocn_coupler.cpp test in moab + ! int typeA = 2; // point cloud + ! int typeB = 1; // quads in coverage set + ! ierr = iMOAB_ComputeCommGraph(cmpPhAtmPID, cplAtmOcnPID, &atmCouComm, &atmPEGroup, &couPEGroup, + ! &typeA, &typeB, &cmpatm, &atmocnid); + call seq_comm_getinfo(CPLID ,mpigrp=mpigrp_CPLID) ! second group, the coupler group CPLID is global variable + call seq_comm_getinfo(atm_id, mpigrp=mpigrp_old) ! component group pes, from atm id ( also ATMID(1) ) + + typeA = 2 ! point cloud, phys atm in this case + ! idintx is a unique number of MOAB app that takes care of intx between ocn and atm mesh + idintx = 100*atm(1)%cplcompid + ocn(1)%cplcompid ! something different, to differentiate it; ~ 618 ! + if (atm_pg_active) then + typeB = 2 ! fv on atm side too !! imoab_apg2_ol coupler example + else + typeB = 1 ! atm cells involved in intersection (spectral in this case) + endif + ierr = iMOAB_ComputeCommGraph( mphaid, mbintxoa, mpicom_join, mpigrp_old, mpigrp_CPLID, & + typeA, typeB, atm_id, idintx) + + endif ! only if atm and ocn intersect mbintxoa >= 0 end subroutine prep_atm_ocn_moab subroutine prep_atm_lnd_moab(infodata) !--------------------------------------------------------------- ! Description - ! After intersection of atm and land mesh, correct the communication graph - ! between atm instance and atm on coupler (due to coverage), in the context of land - ! also, compute the map; this would be equivalent to seq_map_init_rcfile on the - ! mapping file computed offline (this will be now online) + ! If the land is on the same mesh as atm, we do not need to compute intx + ! Just use compute graph between phys atm and lnd on coupler, to be able to send + ! data from atm phys to atm on coupler for projection on land ! ! Arguments type(seq_infodata_type) , intent(in) :: infodata @@ -382,44 +401,71 @@ subroutine prep_atm_lnd_moab(infodata) character*32 :: dm1, dm2, dofnameATM, dofnameLND, wgtIdef integer :: orderLND, orderATM, volumetric, noConserve, validate integer :: monotonicity + integer :: mpigrp_CPLID ! coupler pes group, used for comm graph phys <-> atm-ocn + integer :: mpigrp_old ! component group pes (phys grid atm) == atm group + integer :: typeA, typeB ! type for computing graph; - integer, external :: iMOAB_CoverageGraph, iMOAB_ComputeScalarProjectionWeights + integer, external :: iMOAB_CoverageGraph, iMOAB_ComputeScalarProjectionWeights, iMOAB_ComputeCommGraph call seq_infodata_getData(infodata, & atm_present=atm_present, & lnd_present=lnd_present) - ! it involves initial atm app; mhid; also migrate atm mesh on coupler pes, mbaxid - ! intx lnd atm are in mbintxla ; remapper also has some info about coverage mesh - ! after this, the sending of tags from atm pes to coupler pes, in land context will use the new par - ! comm graph, that has more precise info about - ! how to get mpicomm for joint atm + coupler - id_join = atm(1)%cplcompid - atm_id = atm(1)%compid - ! maybe we can use a moab-only id, defined like mbintxoa, mhid, somewhere else (seq_comm_mct) - ! we cannot use mbintxla because it may not exist on atm comp yet; - context_id = lnd(1)%cplcompid - call seq_comm_getinfo(ID_join,mpicom=mpicom_join) + if (mbintxla .ge. 0 ) then + ! it involves initial atm app; mhid; also migrate atm mesh on coupler pes, mbaxid + ! intx lnd atm are in mbintxla ; remapper also has some info about coverage mesh + ! after this, the sending of tags from atm pes to coupler pes, in land context will use the new par + ! comm graph, that has more precise info about + ! how to get mpicomm for joint atm + coupler + id_join = atm(1)%cplcompid + atm_id = atm(1)%compid + ! maybe we can use a moab-only id, defined like mbintxoa, mhid, somewhere else (seq_comm_mct) + ! we cannot use mbintxla because it may not exist on atm comp yet; + context_id = lnd(1)%cplcompid + call seq_comm_getinfo(ID_join,mpicom=mpicom_join) + if (diff_atm_land) then + ierr = iMOAB_CoverageGraph(mpicom_join, mhpgid, mbaxid, mbintxla, context_id); + dm1 = "fv"//CHAR(0) + dofnameATM="GLOBAL_ID"//CHAR(0) + orderATM = 1 + wgtIdef = 'scalar-pc'//CHAR(0) + + dm2 = "pcloud"//CHAR(0) + + dofnameLND="GLOBAL_ID"//CHAR(0) + + orderLND = 1 ! not much arguing + monotonicity = 0 ! + volumetric = 1 + noConserve = 0 + validate = 1 + + ierr = iMOAB_ComputeScalarProjectionWeights ( mbintxla, wgtIdef, & + trim(dm1), orderATM, trim(dm2), orderLND, & + monotonicity, volumetric, noConserve, validate, & + trim(dofnameATM), trim(dofnameLND) ) + else + ! it happens over joint communicator + ! we do not need intx, just comm graph computation; see imoab_phatm_ocn_coupler.cpp + ! prepare to send from phys atm towards land, based on GLOBAL_ID + +! if( atmCouComm != MPI_COMM_NULL ) +! { +! int typeA = 2; // point cloud +! int typeB = 2; // point cloud for land on coupler, too +! ierr = iMOAB_ComputeCommGraph( cmpPhAtmPID, cplLndPID, &atmCouComm, &atmPEGroup, &couPEGroup, &typeA, &typeB, +! &cmpatm, &cpllnd ); +! } + call seq_comm_getinfo(CPLID ,mpigrp=mpigrp_CPLID) ! second group, the coupler group CPLID is global variable + call seq_comm_getinfo(atm_id, mpigrp=mpigrp_old) ! component group pes, from atm id ( also ATMID(1) ) + typeA = 2 ! point cloud + typeB = 2 ! point cloud too, for land on coupler lnd(1)%cplcompid + ierr = iMOAB_ComputeCommGraph( mphaid, mblxid, mpicom_join, mpigrp_old, mpigrp_CPLID, & + typeA, typeB, atm_id, lnd(1)%cplcompid) + + endif - ! it happens over joint communicator - ierr = iMOAB_CoverageGraph(mpicom_join, mhid, mbaxid, mbintxla, context_id); - wgtIdef = 'scalar-pc'//CHAR(0) - dm1 = "cgll"//CHAR(0) - dm2 = "pcloud"//CHAR(0) - dofnameATM="GLOBAL_DOFS"//CHAR(0) - dofnameLND="GLOBAL_ID"//CHAR(0) - orderATM = np ! it should be 4 - orderLND = 1 ! not much arguing - monotonicity = 0 ! - volumetric = 0 - noConserve = 0 - validate = 1 - if (mbintxla .ge. 0 ) then - ierr = iMOAB_ComputeScalarProjectionWeights ( mbintxla, wgtIdef, & - trim(dm1), orderATM, trim(dm2), orderLND, & - monotonicity, volumetric, noConserve, validate, & - trim(dofnameATM), trim(dofnameLND) ) endif end subroutine prep_atm_lnd_moab @@ -440,7 +486,7 @@ subroutine prep_atm_migrate_moab(infodata) integer :: id_join integer :: mpicom_join integer :: atm_id - integer :: context_id ! we will use ocean context + integer :: context_id ! we will use ocean context or land context character*32 :: dm1, dm2, tagName, wgtIdef character*50 :: outfile, wopts, tagnameProj, lnum integer :: orderOCN, orderATM, volumetric, noConserve, validate @@ -518,46 +564,128 @@ subroutine prep_atm_migrate_moab(infodata) context_id = lnd(1)%cplcompid wgtIdef = 'scalar-pc'//CHAR(0) if (atm_present .and. lnd_present) then - if (mhid .ge. 0) then ! send because we are on atm pes + if (diff_atm_land) then ! we need to send either from pg mhpgid or coarse mhid + if (atm_pg_active ) then ! use mhpgid mesh + if (mhpgid .ge. 0) then ! send because we are on atm pes - ! basically, adjust the migration of the tag we want to project; it was sent initially with - ! original partitioning, now we need to adjust it for "coverage" mesh - ! as always, use nonblocking sends + ! basically, adjust the migration of the tag we want to project; it was sent initially with + ! original partitioning, now we need to adjust it for "coverage" mesh + ! as always, use nonblocking sends - ierr = iMOAB_SendElementTag(mhid, tagName, mpicom_join, context_id) + ierr = iMOAB_SendElementTag(mhpgid, tagName, mpicom_join, context_id) - endif - if (mbaxid .ge. 0 ) then ! we are on coupler pes, for sure - ! receive on atm on coupler pes, that was redistributed according to coverage - ierr = iMOAB_ReceiveElementTag(mbaxid, tagName, mpicom_join, context_id) - !CHECKRC(ierr, "cannot receive tag values") - endif + endif + if (mbaxid .ge. 0 ) then ! we are on coupler pes, for sure + ! receive on atm on coupler pes, that was redistributed according to coverage + ierr = iMOAB_ReceiveElementTag(mbaxid, tagName, mpicom_join, context_id) + !CHECKRC(ierr, "cannot receive tag values") + endif - ! we can now free the sender buffers - if (mhid .ge. 0) then - ierr = iMOAB_FreeSenderBuffers(mhid, context_id) - ! CHECKRC(ierr, "cannot free buffers used to resend atm mesh tag towards the coverage mesh") - endif + ! we can now free the sender buffers + if (mhpgid .ge. 0) then + ierr = iMOAB_FreeSenderBuffers(mhid, context_id) + ! CHECKRC(ierr, "cannot free buffers used to resend atm mesh tag towards the coverage mesh") + endif + else ! regular coarse homme mesh + if (mhid .ge. 0) then ! send because we are on atm pes - ! we could do the projection now, on the land mesh, because we are on the coupler pes; - ! the actual migrate back could happen later , from coupler pes to the land pes - if (mbintxla .ge. 0 ) then ! we are on coupler pes, for sure - ! we could apply weights; need to use the same weight identifier wgtIdef as when we generated it - ! hard coded now, it should be a runtime option in the future - ierr = iMOAB_ApplyScalarProjectionWeights ( mbintxla, wgtIdef, tagName, tagNameProj) + ! basically, adjust the migration of the tag we want to project; it was sent initially with + ! original partitioning, now we need to adjust it for "coverage" mesh + ! as always, use nonblocking sends + + ierr = iMOAB_SendElementTag(mhid, tagName, mpicom_join, context_id) + + endif + if (mbaxid .ge. 0 ) then ! we are on coupler pes, for sure + ! receive on atm on coupler pes, that was redistributed according to coverage + ierr = iMOAB_ReceiveElementTag(mbaxid, tagName, mpicom_join, context_id) + !CHECKRC(ierr, "cannot receive tag values") + endif + + ! we can now free the sender buffers + if (mhid .ge. 0) then + ierr = iMOAB_FreeSenderBuffers(mhid, context_id) + ! CHECKRC(ierr, "cannot free buffers used to resend atm mesh tag towards the coverage mesh") + endif + endif + + ! we could do the projection now, on the land mesh, because we are on the coupler pes; + ! the actual migrate back could happen later , from coupler pes to the land pes + if (mbintxla .ge. 0 ) then ! we are on coupler pes, for sure + ! we could apply weights; need to use the same weight identifier wgtIdef as when we generated it + ! hard coded now, it should be a runtime option in the future + ierr = iMOAB_ApplyScalarProjectionWeights ( mbintxla, wgtIdef, tagName, tagNameProj) #ifdef MOABDEBUG - ! we can also write the ocean mesh to file, just to see the projectd tag - ! write out the mesh file to disk - write(lnum,"(I0.2)")num_proj - outfile = 'lndCplProj'//trim(lnum)//'.h5m'//CHAR(0) - wopts = ';PARALLEL=WRITE_PART'//CHAR(0) ! - ierr = iMOAB_WriteMesh(mblxid, trim(outfile), trim(wopts)) + ! we can also write the ocean mesh to file, just to see the projectd tag + ! write out the mesh file to disk + write(lnum,"(I0.2)")num_proj + outfile = 'lndCplProj'//trim(lnum)//'.h5m'//CHAR(0) + wopts = ';PARALLEL=WRITE_PART'//CHAR(0) ! + ierr = iMOAB_WriteMesh(mblxid, trim(outfile), trim(wopts)) #endif - !CHECKRC(ierr, "cannot receive tag values") - endif - + !CHECKRC(ierr, "cannot receive tag values") + endif + else ! we are on same mesh, just send from phys grid atm directly to land cpl, no projection needed + ! we will do the same send , as imoab_phatm_ocn_coupler.cpp; no projection needed, just send to land coupler + ! directly, and data will be where we want it !! + ! this is how we are sending from phys grid directly to land coupler, in imoab_phatm_ocn_coupler.cpp +! if( atmComm != MPI_COMM_NULL ) +! { +! +! // as always, use nonblocking sends +! // this is for projection to land: +! ierr = +! iMOAB_SendElementTag( cmpPhAtmPID, "T_ph;u_ph;v_ph;", &atmCouComm, &cpllnd, strlen( "T_ph;u_ph;v_ph;" ) ); +! CHECKIERR( ierr, "cannot send tag values towards cpl on land" ) +! } +! if( couComm != MPI_COMM_NULL ) +! { +! // receive on lnd on coupler pes +! ierr = iMOAB_ReceiveElementTag( cplLndPID, "T_proj;u_proj;v_proj;", &atmCouComm, &cmpatm, +! strlen( "T_proj;u_proj;v_proj;" ) ); +! CHECKIERR( ierr, "cannot receive tag values on land on coupler" ) +! } +! POP_TIMER( MPI_COMM_WORLD, rankInGlobalComm ) +! +! // we can now free the sender buffers +! if( atmComm != MPI_COMM_NULL ) +! { +! ierr = iMOAB_FreeSenderBuffers( cmpPhAtmPID, &cpllnd ); +! CHECKIERR( ierr, "cannot free buffers used to resend atm tag towards the land on coupler" ) +! } + if (mphaid .ge. 0) then + ! we are on atm phys pes (atm pes) + tagname = 'T_ph;u_ph;v_ph'//CHAR(0) + ! context_id is the other comp id, in this case it has to be coupler on land, + context_id = lnd(1)%cplcompid + ierr = iMOAB_SendElementTag(mphaid, tagname, mpicom_join, context_id) ! it will fail if intx is not done + ! if intx is not done, context does not exist ! + endif + + if (mblxid .ge. 0 ) then ! we are on coupler pes, for sure, on land + ! receive on land tag on coupler pes, in original migrate + ! receive from ATM PHYS, which in this case is 200 + 5 + ! + context_id = atm_id ! 5 for atm + ierr = iMOAB_ReceiveElementTag(mblxid, tagNameProj, mpicom_join, context_id) + !CHECKRC(ierr, "cannot receive tag values") +#ifdef MOABDEBUG + ! + ! write out the lnd coupler mesh file to disk + write(lnum,"(I0.2)")num_proj + outfile = 'lndCplProj_PH'//trim(lnum)//'.h5m'//CHAR(0) + wopts = ';PARALLEL=WRITE_PART'//CHAR(0) ! + ierr = iMOAB_WriteMesh(mblxid, trim(outfile), trim(wopts)) +#endif + endif + if (mphaid .ge. 0) then ! free buffers + context_id = lnd(1)%cplcompid + ierr = iMOAB_FreeSenderBuffers(mphaid, context_id) + ! CHECKRC(ierr, "cannot free buffers used to phys atm tag towards the coupler atm spectral mesh") + endif + endif ! endif for diff_atm_land, we are on same mesh land and satm, use direct send, no projection endif ! we also know that phys atm was loaded with some data; send it to the coupler atm @@ -630,11 +758,12 @@ subroutine prep_atm_migrate_moab(infodata) endif ! we can now free the sender buffers - if (mhid .ge. 0) then + if (mphaid .ge. 0) then ierr = iMOAB_FreeSenderBuffers(mphaid, context_id) ! CHECKRC(ierr, "cannot free buffers used to phys atm tag towards the coupler atm spectral mesh") endif + ! we could do the projection now, on the ocean mesh, because we are on the coupler pes; ! the actual migrate could happen later , from coupler pes to the ocean pes if (mbintxoa .ge. 0 ) then ! we are on coupler pes, for sure From 0d858b1b297948dd04dcd33168e9665fc076634d Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Mon, 14 Sep 2020 23:15:54 -0500 Subject: [PATCH 065/467] fix prep_atm_ocn_moab logic it should be executed over joint atm/coupler communicator not only over coupler intx add Only weight generation is over intx app similar error in land/coupler in prep_atm_mod.F90 [BFB] - Bit-For-Bit --- driver-moab/main/prep_atm_mod.F90 | 103 +++++++++++++++--------------- 1 file changed, 51 insertions(+), 52 deletions(-) diff --git a/driver-moab/main/prep_atm_mod.F90 b/driver-moab/main/prep_atm_mod.F90 index 4e7a1d45d5f5..ee21f6b1c73c 100644 --- a/driver-moab/main/prep_atm_mod.F90 +++ b/driver-moab/main/prep_atm_mod.F90 @@ -324,13 +324,15 @@ subroutine prep_atm_ocn_moab(infodata) call seq_comm_getinfo(ID_join,mpicom=mpicom_join) ! it happens over joint communicator - if ( mbintxoa .ge. 0 ) then - if (atm_pg_active ) then ! use mhpgid mesh - ierr = iMOAB_CoverageGraph(mpicom_join, mhpgid, mbaxid, mbintxoa, context_id); - else - ierr = iMOAB_CoverageGraph(mpicom_join, mhid, mbaxid, mbintxoa, context_id); - endif + if (atm_pg_active ) then ! use mhpgid mesh + ierr = iMOAB_CoverageGraph(mpicom_join, mhpgid, mbaxid, mbintxoa, context_id); + else + ierr = iMOAB_CoverageGraph(mpicom_join, mhid, mbaxid, mbintxoa, context_id); + endif + + + if ( mbintxoa .ge. 0 ) then wgtIdef = 'scalar'//CHAR(0) if (atm_pg_active) then dm1 = "fv"//CHAR(0) @@ -349,35 +351,32 @@ subroutine prep_atm_ocn_moab(infodata) monotonicity = 0 ! noConserve = 0 validate = 1 - ierr = iMOAB_ComputeScalarProjectionWeights ( mbintxoa, wgtIdef, & trim(dm1), orderATM, trim(dm2), orderOCN, & monotonicity, volumetric, noConserve, validate, & trim(dofnameATM), trim(dofnameOCN) ) - - ! compute the comm graph between phys atm and intx-atm-ocn, to be able to send directly from phys atm - ! towards coverage mesh on atm for intx to ocean - ! this is similar to imoab_phatm_ocn_coupler.cpp test in moab - ! int typeA = 2; // point cloud - ! int typeB = 1; // quads in coverage set - ! ierr = iMOAB_ComputeCommGraph(cmpPhAtmPID, cplAtmOcnPID, &atmCouComm, &atmPEGroup, &couPEGroup, - ! &typeA, &typeB, &cmpatm, &atmocnid); - call seq_comm_getinfo(CPLID ,mpigrp=mpigrp_CPLID) ! second group, the coupler group CPLID is global variable - call seq_comm_getinfo(atm_id, mpigrp=mpigrp_old) ! component group pes, from atm id ( also ATMID(1) ) - - typeA = 2 ! point cloud, phys atm in this case - ! idintx is a unique number of MOAB app that takes care of intx between ocn and atm mesh - idintx = 100*atm(1)%cplcompid + ocn(1)%cplcompid ! something different, to differentiate it; ~ 618 ! - if (atm_pg_active) then - typeB = 2 ! fv on atm side too !! imoab_apg2_ol coupler example - else - typeB = 1 ! atm cells involved in intersection (spectral in this case) - endif - ierr = iMOAB_ComputeCommGraph( mphaid, mbintxoa, mpicom_join, mpigrp_old, mpigrp_CPLID, & - typeA, typeB, atm_id, idintx) - - endif ! only if atm and ocn intersect mbintxoa >= 0 + ! compute the comm graph between phys atm and intx-atm-ocn, to be able to send directly from phys atm + ! towards coverage mesh on atm for intx to ocean + ! this is similar to imoab_phatm_ocn_coupler.cpp test in moab + ! int typeA = 2; // point cloud + ! int typeB = 1; // quads in coverage set + ! ierr = iMOAB_ComputeCommGraph(cmpPhAtmPID, cplAtmOcnPID, &atmCouComm, &atmPEGroup, &couPEGroup, + ! &typeA, &typeB, &cmpatm, &atmocnid); + call seq_comm_getinfo(CPLID ,mpigrp=mpigrp_CPLID) ! second group, the coupler group CPLID is global variable + call seq_comm_getinfo(atm_id, mpigrp=mpigrp_old) ! component group pes, from atm id ( also ATMID(1) ) + + typeA = 2 ! point cloud, phys atm in this case + ! idintx is a unique number of MOAB app that takes care of intx between ocn and atm mesh + idintx = 100*atm(1)%cplcompid + ocn(1)%cplcompid ! something different, to differentiate it; ~ 618 ! + if (atm_pg_active) then + typeB = 2 ! fv on atm side too !! imoab_apg2_ol coupler example + else + typeB = 1 ! atm cells involved in intersection (spectral in this case) + endif + ierr = iMOAB_ComputeCommGraph( mphaid, mbintxoa, mpicom_join, mpigrp_old, mpigrp_CPLID, & + typeA, typeB, atm_id, idintx) + end subroutine prep_atm_ocn_moab subroutine prep_atm_lnd_moab(infodata) @@ -411,20 +410,21 @@ subroutine prep_atm_lnd_moab(infodata) atm_present=atm_present, & lnd_present=lnd_present) - if (mbintxla .ge. 0 ) then + ! it involves initial atm app; mhid; also migrate atm mesh on coupler pes, mbaxid ! intx lnd atm are in mbintxla ; remapper also has some info about coverage mesh ! after this, the sending of tags from atm pes to coupler pes, in land context will use the new par ! comm graph, that has more precise info about ! how to get mpicomm for joint atm + coupler - id_join = atm(1)%cplcompid - atm_id = atm(1)%compid - ! maybe we can use a moab-only id, defined like mbintxoa, mhid, somewhere else (seq_comm_mct) - ! we cannot use mbintxla because it may not exist on atm comp yet; - context_id = lnd(1)%cplcompid - call seq_comm_getinfo(ID_join,mpicom=mpicom_join) - if (diff_atm_land) then - ierr = iMOAB_CoverageGraph(mpicom_join, mhpgid, mbaxid, mbintxla, context_id); + id_join = atm(1)%cplcompid + atm_id = atm(1)%compid + ! maybe we can use a moab-only id, defined like mbintxoa, mhid, somewhere else (seq_comm_mct) + ! we cannot use mbintxla because it may not exist on atm comp yet; + context_id = lnd(1)%cplcompid + call seq_comm_getinfo(ID_join,mpicom=mpicom_join) + if (diff_atm_land) then + ierr = iMOAB_CoverageGraph(mpicom_join, mhpgid, mbaxid, mbintxla, context_id); + if (mbintxla .ge. 0 ) then ! weights are computed over coupler pes dm1 = "fv"//CHAR(0) dofnameATM="GLOBAL_ID"//CHAR(0) orderATM = 1 @@ -444,10 +444,11 @@ subroutine prep_atm_lnd_moab(infodata) trim(dm1), orderATM, trim(dm2), orderLND, & monotonicity, volumetric, noConserve, validate, & trim(dofnameATM), trim(dofnameLND) ) - else - ! it happens over joint communicator - ! we do not need intx, just comm graph computation; see imoab_phatm_ocn_coupler.cpp - ! prepare to send from phys atm towards land, based on GLOBAL_ID + endif + else + ! it happens over joint communicator + ! we do not need intx, just comm graph computation; see imoab_phatm_ocn_coupler.cpp + ! prepare to send from phys atm towards land, based on GLOBAL_ID ! if( atmCouComm != MPI_COMM_NULL ) ! { @@ -456,17 +457,15 @@ subroutine prep_atm_lnd_moab(infodata) ! ierr = iMOAB_ComputeCommGraph( cmpPhAtmPID, cplLndPID, &atmCouComm, &atmPEGroup, &couPEGroup, &typeA, &typeB, ! &cmpatm, &cpllnd ); ! } - call seq_comm_getinfo(CPLID ,mpigrp=mpigrp_CPLID) ! second group, the coupler group CPLID is global variable - call seq_comm_getinfo(atm_id, mpigrp=mpigrp_old) ! component group pes, from atm id ( also ATMID(1) ) - typeA = 2 ! point cloud - typeB = 2 ! point cloud too, for land on coupler lnd(1)%cplcompid - ierr = iMOAB_ComputeCommGraph( mphaid, mblxid, mpicom_join, mpigrp_old, mpigrp_CPLID, & - typeA, typeB, atm_id, lnd(1)%cplcompid) - - endif - + call seq_comm_getinfo(CPLID ,mpigrp=mpigrp_CPLID) ! second group, the coupler group CPLID is global variable + call seq_comm_getinfo(atm_id, mpigrp=mpigrp_old) ! component group pes, from atm id ( also ATMID(1) ) + typeA = 2 ! point cloud + typeB = 2 ! point cloud too, for land on coupler lnd(1)%cplcompid + ierr = iMOAB_ComputeCommGraph( mphaid, mblxid, mpicom_join, mpigrp_old, mpigrp_CPLID, & + typeA, typeB, atm_id, lnd(1)%cplcompid) endif + end subroutine prep_atm_lnd_moab subroutine prep_atm_migrate_moab(infodata) From 478b62c057348215937cd248fc2345d5158f6a17 Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Wed, 16 Sep 2020 16:15:12 -0500 Subject: [PATCH 066/467] correct tag migration pg2 ocn case For projection from atm to ocean, we need to send data from phys grid mesh towards the intersection of ocean and atm pg2 mesh; also, we will use for atm side still the T_ph16 names, as the tags are named as in the spectral case [BFB] - Bit-For-Bit --- driver-moab/main/prep_atm_mod.F90 | 73 ++++++++++++++++++++++--------- 1 file changed, 52 insertions(+), 21 deletions(-) diff --git a/driver-moab/main/prep_atm_mod.F90 b/driver-moab/main/prep_atm_mod.F90 index ee21f6b1c73c..4776ac288422 100644 --- a/driver-moab/main/prep_atm_mod.F90 +++ b/driver-moab/main/prep_atm_mod.F90 @@ -370,9 +370,16 @@ subroutine prep_atm_ocn_moab(infodata) ! idintx is a unique number of MOAB app that takes care of intx between ocn and atm mesh idintx = 100*atm(1)%cplcompid + ocn(1)%cplcompid ! something different, to differentiate it; ~ 618 ! if (atm_pg_active) then - typeB = 2 ! fv on atm side too !! imoab_apg2_ol coupler example + typeB = 3 ! fv on atm side too !! imoab_apg2_ol coupler example + ! atm cells involved in intersection (pg 2 in this case) + ! this will be used now to send + ! data from phys grid directly to atm-ocn intx , for later projection + ! context is the same, atm - ocn intx id ! + else - typeB = 1 ! atm cells involved in intersection (spectral in this case) + typeB = 1 ! atm cells involved in intersection (spectral in this case) ! this will be used now to send + ! data from phys grid directly to atm-ocn intx , for later projection + ! context is the same, atm - ocn intx id ! endif ierr = iMOAB_ComputeCommGraph( mphaid, mbintxoa, mpicom_join, mpigrp_old, mpigrp_CPLID, & typeA, typeB, atm_id, idintx) @@ -510,32 +517,56 @@ subroutine prep_atm_migrate_moab(infodata) ! we should do this only of ocn_present context_id = ocn(1)%cplcompid - ! now send the tags a2o?bot from original atmosphere mhid(pid1) towards migrated coverage mesh (pid3), using the new coverage graph communicator - tagName = 'a2oTbot;a2oUbot;a2oVbot;'//CHAR(0) ! they are defined in semoab_mod.F90!!! - ! the separator will be ';' semicolon - tagNameProj = 'a2oTbot_proj;a2oUbot_proj;a2oVbot_proj;'//CHAR(0) wgtIdef = 'scalar'//CHAR(0) num_proj = num_proj + 1 + if (atm_present .and. ocn_present) then - if (mhid .ge. 0) then ! send because we are on atm pes + if (atm_pg_active ) then ! use data from AtmPhys mesh, but mesh from pg + ! in this case, we will send from phys grid directly to intx atm ocn context! + if (mhpgid .ge. 0) then ! send because we are on atm pes, + + ! basically, adjust the migration of the tag we want to project; it was sent initially with + ! trivial partitioning, now we need to adjust it for "coverage" mesh + ! as always, use nonblocking sends + tagName = 'T_ph;u_ph;v_ph;'//CHAR(0) ! they are defined in initialize_moab_atm_phys in atm_comp_mct + context_id = 100*atm(1)%cplcompid + ocn(1)%cplcompid !send to atm/ocn intx ! + ierr = iMOAB_SendElementTag(mphaid, tagName, mpicom_join, context_id) + endif - ! basically, adjust the migration of the tag we want to project; it was sent initially with - ! trivial partitioning, now we need to adjust it for "coverage" mesh - ! as always, use nonblocking sends + if (mbintxoa .ge. 0 ) then ! we are for sure on coupler pes! + tagName = 'T_ph16;u_ph16;v_ph16;'//CHAR(0) ! they are defined in cplcomp_exchange mod + ! context_id = atm(1)%cplcompid == atm_id above (5) + ierr = iMOAB_ReceiveElementTag(mbintxoa, tagName, mpicom_join, atm_id) + endif + ! we can now free the sender buffers + if (mhpgid .ge. 0) then + ierr = iMOAB_FreeSenderBuffers(mhpgid, context_id) + ! CHECKRC(ierr, "cannot free buffers used to resend atm mesh tag towards the coverage mesh") + endif + else ! original send from spectral elements + tagName = 'a2oTbot;a2oUbot;a2oVbot;'//CHAR(0) ! they are defined in semoab_mod.F90!!! + ! the separator will be ';' semicolon + tagNameProj = 'a2oTbot_proj;a2oUbot_proj;a2oVbot_proj;'//CHAR(0) + if (mhid .ge. 0) then ! send because we are on atm pes - ierr = iMOAB_SendElementTag(mhid, tagName, mpicom_join, context_id) + ! basically, adjust the migration of the tag we want to project; it was sent initially with + ! trivial partitioning, now we need to adjust it for "coverage" mesh + ! as always, use nonblocking sends - endif - if (mbaxid .ge. 0 ) then ! we are on coupler pes, for sure - ! receive on atm on coupler pes, that was redistributed according to coverage - ierr = iMOAB_ReceiveElementTag(mbaxid, tagName, mpicom_join, context_id) - !CHECKRC(ierr, "cannot receive tag values") - endif + ierr = iMOAB_SendElementTag(mhid, tagName, mpicom_join, context_id) + endif + if (mbaxid .ge. 0 ) then ! we are on coupler pes, for sure + ! receive on atm on coupler pes, that was redistributed according to coverage + ierr = iMOAB_ReceiveElementTag(mbaxid, tagName, mpicom_join, context_id) + !CHECKRC(ierr, "cannot receive tag values") + endif + + ! we can now free the sender buffers + if (mhid .ge. 0) then + ierr = iMOAB_FreeSenderBuffers(mhid, context_id) + ! CHECKRC(ierr, "cannot free buffers used to resend atm mesh tag towards the coverage mesh") + endif - ! we can now free the sender buffers - if (mhid .ge. 0) then - ierr = iMOAB_FreeSenderBuffers(mhid, context_id) - ! CHECKRC(ierr, "cannot free buffers used to resend atm mesh tag towards the coverage mesh") endif ! we could do the projection now, on the ocean mesh, because we are on the coupler pes; From 94a21dd446f5f4312e4428f8e10d0c76a8b294bb Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Wed, 16 Sep 2020 18:13:22 -0500 Subject: [PATCH 067/467] add error checking mostly in cplcomp_exchange and in prep_atm_mod [BFB] - Bit-For-Bit --- driver-moab/main/cplcomp_exchange_mod.F90 | 71 +++++++- driver-moab/main/prep_atm_mod.F90 | 208 ++++++++++++++-------- 2 files changed, 206 insertions(+), 73 deletions(-) diff --git a/driver-moab/main/cplcomp_exchange_mod.F90 b/driver-moab/main/cplcomp_exchange_mod.F90 index 838447d30818..96ac2661f767 100644 --- a/driver-moab/main/cplcomp_exchange_mod.F90 +++ b/driver-moab/main/cplcomp_exchange_mod.F90 @@ -1008,7 +1008,6 @@ subroutine cplcomp_moab_Init(comp) integer :: rank, ent_type integer :: typeA, typeB, ATM_PHYS_CID ! used to compute par graph between atm phys ! and atm spectral on coupler - #ifdef MOABDEBUG integer , dimension(1:3) :: nverts, nelem, nblocks, nsbc, ndbc integer, dimension(:), allocatable :: vgids @@ -1058,18 +1057,34 @@ subroutine cplcomp_moab_Init(comp) ! still use the mhid, original coarse mesh ierr = iMOAB_SendMesh(mhid, mpicom_join, mpigrp_cplid, id_join, partMethod) endif + if (ierr .ne. 0) then + write(logunit,*) subname,' error in sending mesh from atm comp ' + call shr_sys_abort(subname//' ERROR in sending mesh from atm comp') + endif endif if (MPI_COMM_NULL /= mpicom_new ) then ! we are on the coupler pes appname = "COUPLE_ATM"//CHAR(0) ! migrated mesh gets another app id, moab atm to coupler (mbax) ierr = iMOAB_RegisterFortranApplication(trim(appname), mpicom_new, id_join, mbaxid) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in registering ', appname + call shr_sys_abort(subname//' ERROR registering '// appname) + endif ierr = iMOAB_ReceiveMesh(mbaxid, mpicom_join, mpigrp_old, id_old) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in receiving mesh on atm coupler ' + call shr_sys_abort(subname//' ERROR in receiving mesh on atm coupler ') + endif #ifdef MOABDEBUG ! debug test outfile = 'recMeshAtm.h5m'//CHAR(0) wopts = ';PARALLEL=WRITE_PART'//CHAR(0) ! write out the mesh file to disk ierr = iMOAB_WriteMesh(mbaxid, trim(outfile), trim(wopts)) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in writing mesh ' + call shr_sys_abort(subname//' ERROR in writing mesh ') + endif #endif endif ! iMOAB_FreeSenderBuffers needs to be called after receiving the mesh @@ -1080,6 +1095,10 @@ subroutine cplcomp_moab_Init(comp) else ierr = iMOAB_FreeSenderBuffers(mhid, context_id) endif + if (ierr .ne. 0) then + write(logunit,*) subname,' error in freeing send buffers ' + call shr_sys_abort(subname//' ERROR in freeing send buffers') + endif endif ! comment out now; we will not send directly to atm spectral on coupler; we need to send in the @@ -1117,6 +1136,10 @@ subroutine cplcomp_moab_Init(comp) ierr = iMOAB_DefineTagStorage(mbaxid, tagnameProj, tagtype, numco, tagindex ) tagnameProj = 'v_ph16'//CHAR(0) ! V component of velocity ierr = iMOAB_DefineTagStorage(mbaxid, tagnameProj, tagtype, numco, tagindex ) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in defining tags ' + call shr_sys_abort(subname//' ERROR in defining tags ') + endif endif endif ! ocean @@ -1127,6 +1150,10 @@ subroutine cplcomp_moab_Init(comp) if (MPI_COMM_NULL /= mpicom_old ) then ! it means we are on the component pes (ocean) ! send mesh to coupler ierr = iMOAB_SendMesh(mpoid, mpicom_join, mpigrp_cplid, id_join, partMethod) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in sending ocean mesh to coupler ' + call shr_sys_abort(subname//' ERROR in sending ocean mesh to coupler ') + endif ! define here the tag that will be projected back from atmosphere ! TODO where do we want to define this? @@ -1139,7 +1166,10 @@ subroutine cplcomp_moab_Init(comp) ierr = iMOAB_DefineTagStorage(mpoid, tagnameProj, tagtype, numco, tagindex ) tagnameProj = 'a2oVbot_proj'//CHAR(0) ! V component of velocity ierr = iMOAB_DefineTagStorage(mpoid, tagnameProj, tagtype, numco, tagindex ) - + if (ierr .ne. 0) then + write(logunit,*) subname,' error in defining tags on ocean comp ' + call shr_sys_abort(subname//' ERROR in defining tags on ocean comp ') + endif endif if (MPI_COMM_NULL /= mpicom_new ) then ! we are on the coupler pes @@ -1159,16 +1189,28 @@ subroutine cplcomp_moab_Init(comp) ierr = iMOAB_DefineTagStorage(mboxid, tagnameProj, tagtype, numco, tagindex ) tagnameProj = 'a2oVbot_proj'//CHAR(0) ! V component of velocity ierr = iMOAB_DefineTagStorage(mboxid, tagnameProj, tagtype, numco, tagindex ) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in defining tags on ocean coupler ' + call shr_sys_abort(subname//' ERROR in defining tags on ocean coupler ') + endif #ifdef MOABDEBUG ! debug test outfile = 'recMeshOcn.h5m'//CHAR(0) wopts = ';PARALLEL=WRITE_PART'//CHAR(0) ! ! write out the mesh file to disk ierr = iMOAB_WriteMesh(mboxid, trim(outfile), trim(wopts)) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in writing ocean mesh coupler ' + call shr_sys_abort(subname//' ERROR in writing ocean mesh coupler ') + endif #endif endif if (mpoid .ge. 0) then ! we are on component ocn pes ierr = iMOAB_FreeSenderBuffers(mpoid, context_id) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in freeing buffers ' + call shr_sys_abort(subname//' ERROR in freeing buffers ') + endif endif endif @@ -1183,14 +1225,25 @@ subroutine cplcomp_moab_Init(comp) partMethod = 2 ! RCB for point cloud #endif ierr = iMOAB_SendMesh(mlnid, mpicom_join, mpigrp_cplid, id_join, partMethod) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in sending land mesh ' + call shr_sys_abort(subname//' ERROR in sending land mesh ') + endif endif if (MPI_COMM_NULL /= mpicom_new ) then ! we are on the coupler pes appname = "COUPLE_LAND"//CHAR(0) ! migrated mesh gets another app id, moab ocean to coupler (mbox) ierr = iMOAB_RegisterFortranApplication(trim(appname), mpicom_new, id_join, mblxid) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in registering coupler land ' + call shr_sys_abort(subname//' ERROR in registering coupler land') + endif ierr = iMOAB_ReceiveMesh(mblxid, mpicom_join, mpigrp_old, id_old) - + if (ierr .ne. 0) then + write(logunit,*) subname,' error in receiving coupler land mesh' + call shr_sys_abort(subname//' ERROR in receiving coupler land mesh') + endif ! define here the tag that will be projected from atmosphere tagnameProj = 'a2lTbot_proj'//CHAR(0) ! temperature tagtype = 1 ! dense, double @@ -1202,6 +1255,10 @@ subroutine cplcomp_moab_Init(comp) ierr = iMOAB_DefineTagStorage(mblxid, tagnameProj, tagtype, numco, tagindex ) tagnameProj = 'a2lVbot_proj'//CHAR(0) ! V component of velocity ierr = iMOAB_DefineTagStorage(mblxid, tagnameProj, tagtype, numco, tagindex ) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in defining tags on land coupler' + call shr_sys_abort(subname//' ERROR in defining tags on land coupler') + endif #ifdef MOABDEBUG !there are no shared entities, but we will set a special partition tag, in order to see the ! partitions ; it will be visible with a Pseudocolor plot in VisIt @@ -1219,10 +1276,18 @@ subroutine cplcomp_moab_Init(comp) wopts = ';PARALLEL=WRITE_PART'//CHAR(0) ! ! write out the mesh file to disk ierr = iMOAB_WriteMesh(mblxid, trim(outfile), trim(wopts)) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in writing land coupler mesh' + call shr_sys_abort(subname//' ERROR in writing land coupler mesh') + endif #endif endif if (mlnid .ge. 0) then ! we are on component land pes ierr = iMOAB_FreeSenderBuffers(mlnid, context_id) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in freeing buffers' + call shr_sys_abort(subname//' ERROR in freeing buffers') + endif endif endif diff --git a/driver-moab/main/prep_atm_mod.F90 b/driver-moab/main/prep_atm_mod.F90 index 4776ac288422..a45c5b1bdede 100644 --- a/driver-moab/main/prep_atm_mod.F90 +++ b/driver-moab/main/prep_atm_mod.F90 @@ -195,7 +195,15 @@ subroutine prep_atm_init(infodata, ocn_c2_atm, ice_c2_atm, lnd_c2_atm, iac_c2_at ! idintx is a unique number of MOAB app that takes care of intx between ocn and atm mesh idintx = 100*atm(1)%cplcompid + ocn(1)%cplcompid ! something different, to differentiate it ierr = iMOAB_RegisterFortranApplication(trim(appname), mpicom_CPLID, idintx, mbintxoa) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in registering atm ocn intx' + call shr_sys_abort(subname//' ERROR in registering atm ocn intx') + endif ierr = iMOAB_ComputeMeshIntersectionOnSphere (mbaxid, mboxid, mbintxoa) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in computing atm ocn intx' + call shr_sys_abort(subname//' ERROR in computing atm ocn intx') + endif #ifdef MOABDEBUG wopts = CHAR(0) call shr_mpi_commrank( mpicom_CPLID, rank ) @@ -203,6 +211,10 @@ subroutine prep_atm_init(infodata, ocn_c2_atm, ice_c2_atm, lnd_c2_atm, iac_c2_at write(lnum,"(I0.2)")rank ! outfile = 'intx'//trim(lnum)// '.h5m' // CHAR(0) ierr = iMOAB_WriteMesh(mbintxoa, outfile, wopts) ! write local intx file + if (ierr .ne. 0) then + write(logunit,*) subname,' error in writing intx file ' + call shr_sys_abort(subname//' ERROR in writing intx file ') + endif endif num_proj = 0 ! to index projection files on coupler pes #endif @@ -269,6 +281,10 @@ subroutine prep_atm_init(infodata, ocn_c2_atm, ice_c2_atm, lnd_c2_atm, iac_c2_at ! idintx is a unique number of MOAB app that takes care of intx between lnd and atm mesh idintx = 100*atm(1)%cplcompid + lnd(1)%cplcompid ! something different, to differentiate it ierr = iMOAB_RegisterFortranApplication(trim(appname), mpicom_CPLID, idintx, mbintxla) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in registering atm lnd intx ' + call shr_sys_abort(subname//' ERROR in registering atm lnd intx ') + endif ! ierr = iMOAB_ComputePointDoFIntersection (mbaxid, mblxid, mbintxla) endif end if @@ -289,6 +305,7 @@ subroutine prep_atm_ocn_moab(infodata) ! Arguments type(seq_infodata_type) , intent(in) :: infodata + character(*), parameter :: subname = '(prep_atm_ocn_moab)' integer :: ierr logical :: atm_present ! .true. => atm is present @@ -330,7 +347,10 @@ subroutine prep_atm_ocn_moab(infodata) else ierr = iMOAB_CoverageGraph(mpicom_join, mhid, mbaxid, mbintxoa, context_id); endif - + if (ierr .ne. 0) then + write(logunit,*) subname,' error in computing coverage graph atm/ocn ' + call shr_sys_abort(subname//' ERROR in computing coverage graph atm/ocn ') + endif if ( mbintxoa .ge. 0 ) then wgtIdef = 'scalar'//CHAR(0) @@ -355,6 +375,10 @@ subroutine prep_atm_ocn_moab(infodata) trim(dm1), orderATM, trim(dm2), orderOCN, & monotonicity, volumetric, noConserve, validate, & trim(dofnameATM), trim(dofnameOCN) ) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in computing weights atm/ocn ' + call shr_sys_abort(subname//' ERROR in computing weights atm/ocn ') + endif endif ! only if atm and ocn intersect mbintxoa >= 0 ! compute the comm graph between phys atm and intx-atm-ocn, to be able to send directly from phys atm ! towards coverage mesh on atm for intx to ocean @@ -383,7 +407,10 @@ subroutine prep_atm_ocn_moab(infodata) endif ierr = iMOAB_ComputeCommGraph( mphaid, mbintxoa, mpicom_join, mpigrp_old, mpigrp_CPLID, & typeA, typeB, atm_id, idintx) - + if (ierr .ne. 0) then + write(logunit,*) subname,' error in computing graph phys grid - atm/ocn intx ' + call shr_sys_abort(subname//' ERROR in computing graph phys grid - atm/ocn intx ') + endif end subroutine prep_atm_ocn_moab subroutine prep_atm_lnd_moab(infodata) @@ -396,6 +423,7 @@ subroutine prep_atm_lnd_moab(infodata) ! Arguments type(seq_infodata_type) , intent(in) :: infodata + character(*), parameter :: subname = '(prep_atm_lnd_moab)' integer :: ierr logical :: atm_present ! .true. => atm is present @@ -429,8 +457,12 @@ subroutine prep_atm_lnd_moab(infodata) ! we cannot use mbintxla because it may not exist on atm comp yet; context_id = lnd(1)%cplcompid call seq_comm_getinfo(ID_join,mpicom=mpicom_join) - if (diff_atm_land) then + if (diff_atm_land) then ! we assume we are already on pg2 mesh ? ierr = iMOAB_CoverageGraph(mpicom_join, mhpgid, mbaxid, mbintxla, context_id); + if (ierr .ne. 0) then + write(logunit,*) subname,' error in computing cov graph atm - land ' + call shr_sys_abort(subname//' ERROR in computing cov graph atm - land') + endif if (mbintxla .ge. 0 ) then ! weights are computed over coupler pes dm1 = "fv"//CHAR(0) dofnameATM="GLOBAL_ID"//CHAR(0) @@ -451,6 +483,10 @@ subroutine prep_atm_lnd_moab(infodata) trim(dm1), orderATM, trim(dm2), orderLND, & monotonicity, volumetric, noConserve, validate, & trim(dofnameATM), trim(dofnameLND) ) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in computing weights atm-pg2 land ' + call shr_sys_abort(subname//' ERROR in computing weights atm-pg2 land') + endif endif else ! it happens over joint communicator @@ -470,6 +506,10 @@ subroutine prep_atm_lnd_moab(infodata) typeB = 2 ! point cloud too, for land on coupler lnd(1)%cplcompid ierr = iMOAB_ComputeCommGraph( mphaid, mblxid, mpicom_join, mpigrp_old, mpigrp_CPLID, & typeA, typeB, atm_id, lnd(1)%cplcompid) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in computing graph atm-phys-grid land ' + call shr_sys_abort(subname//' ERROR in computing graph atm-phys-grid land') + endif endif @@ -484,6 +524,8 @@ subroutine prep_atm_migrate_moab(infodata) ! Arguments type(seq_infodata_type) , intent(in) :: infodata + character(*), parameter :: subname = '(prep_atm_migrate_moab)' + integer :: ierr logical :: atm_present ! .true. => atm is present @@ -531,17 +573,30 @@ subroutine prep_atm_migrate_moab(infodata) tagName = 'T_ph;u_ph;v_ph;'//CHAR(0) ! they are defined in initialize_moab_atm_phys in atm_comp_mct context_id = 100*atm(1)%cplcompid + ocn(1)%cplcompid !send to atm/ocn intx ! ierr = iMOAB_SendElementTag(mphaid, tagName, mpicom_join, context_id) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in sending tag from phys atm to ocn atm intx ' + call shr_sys_abort(subname//' ERROR in sending tag from phys atm to ocn atm intx') + endif + endif if (mbintxoa .ge. 0 ) then ! we are for sure on coupler pes! tagName = 'T_ph16;u_ph16;v_ph16;'//CHAR(0) ! they are defined in cplcomp_exchange mod ! context_id = atm(1)%cplcompid == atm_id above (5) ierr = iMOAB_ReceiveElementTag(mbintxoa, tagName, mpicom_join, atm_id) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in receiving tag from phys atm to ocn atm intx ' + call shr_sys_abort(subname//' ERROR in receiving tag from phys atm to ocn atm intx') + endif + endif ! we can now free the sender buffers if (mhpgid .ge. 0) then - ierr = iMOAB_FreeSenderBuffers(mhpgid, context_id) - ! CHECKRC(ierr, "cannot free buffers used to resend atm mesh tag towards the coverage mesh") + ierr = iMOAB_FreeSenderBuffers(mhpgid, context_id) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in freeing buffers' + call shr_sys_abort(subname//' ERROR in freeing buffers') + endif endif else ! original send from spectral elements tagName = 'a2oTbot;a2oUbot;a2oVbot;'//CHAR(0) ! they are defined in semoab_mod.F90!!! @@ -554,17 +609,27 @@ subroutine prep_atm_migrate_moab(infodata) ! as always, use nonblocking sends ierr = iMOAB_SendElementTag(mhid, tagName, mpicom_join, context_id) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in sending tag from atm spectral to ocn atm intx ' + call shr_sys_abort(subname//' ERROR in sending tag from atm spectral to ocn atm intx') + endif endif if (mbaxid .ge. 0 ) then ! we are on coupler pes, for sure ! receive on atm on coupler pes, that was redistributed according to coverage ierr = iMOAB_ReceiveElementTag(mbaxid, tagName, mpicom_join, context_id) - !CHECKRC(ierr, "cannot receive tag values") + if (ierr .ne. 0) then + write(logunit,*) subname,' error in receiving tag from atm spectral to ocn atm intx ' + call shr_sys_abort(subname//' ERROR in receiving tag from atm spectral to ocn atm intx') + endif endif ! we can now free the sender buffers if (mhid .ge. 0) then - ierr = iMOAB_FreeSenderBuffers(mhid, context_id) - ! CHECKRC(ierr, "cannot free buffers used to resend atm mesh tag towards the coverage mesh") + ierr = iMOAB_FreeSenderBuffers(mhid, context_id) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in freeing buffers ' + call shr_sys_abort(subname//' ERROR in freeing buffers') + endif endif endif @@ -575,7 +640,10 @@ subroutine prep_atm_migrate_moab(infodata) ! we could apply weights; need to use the same weight identifier wgtIdef as when we generated it ! hard coded now, it should be a runtime option in the future ierr = iMOAB_ApplyScalarProjectionWeights ( mbintxoa, wgtIdef, tagName, tagNameProj) - + if (ierr .ne. 0) then + write(logunit,*) subname,' error in applying weights ' + call shr_sys_abort(subname//' ERROR in applying weights') + endif #ifdef MOABDEBUG ! we can also write the ocean mesh to file, just to see the projectd tag ! write out the mesh file to disk @@ -583,6 +651,10 @@ subroutine prep_atm_migrate_moab(infodata) outfile = 'ocnCplProj'//trim(lnum)//'.h5m'//CHAR(0) wopts = ';PARALLEL=WRITE_PART'//CHAR(0) ! ierr = iMOAB_WriteMesh(mboxid, trim(outfile), trim(wopts)) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in writing ocn mesh after projection ' + call shr_sys_abort(subname//' ERROR in writing ocn mesh after projection') + endif #endif !CHECKRC(ierr, "cannot receive tag values") @@ -594,27 +666,39 @@ subroutine prep_atm_migrate_moab(infodata) context_id = lnd(1)%cplcompid wgtIdef = 'scalar-pc'//CHAR(0) if (atm_present .and. lnd_present) then - if (diff_atm_land) then ! we need to send either from pg mhpgid or coarse mhid + if (diff_atm_land) then ! we need to send either from pg mhpgid or coarse mhid UNTESTED ! if (atm_pg_active ) then ! use mhpgid mesh if (mhpgid .ge. 0) then ! send because we are on atm pes ! basically, adjust the migration of the tag we want to project; it was sent initially with ! original partitioning, now we need to adjust it for "coverage" mesh ! as always, use nonblocking sends - - ierr = iMOAB_SendElementTag(mhpgid, tagName, mpicom_join, context_id) + ! FIXME TODO: use intx id, not just land id! + context_id = 100*atm(1)%cplcompid + lnd(1)%cplcompid !send to atm/lnd intx ! + ierr = iMOAB_SendElementTag(mphaid, tagName, mpicom_join, context_id) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in sending tag from atm to atm land intx ' + call shr_sys_abort(subname//' ERROR in sending tag from atm to atm land intx') + endif endif if (mbaxid .ge. 0 ) then ! we are on coupler pes, for sure ! receive on atm on coupler pes, that was redistributed according to coverage - ierr = iMOAB_ReceiveElementTag(mbaxid, tagName, mpicom_join, context_id) - !CHECKRC(ierr, "cannot receive tag values") + ierr = iMOAB_ReceiveElementTag(mbintxla, tagName, mpicom_join, atm_id) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in receiving tag from atm to atm land intx ' + call shr_sys_abort(subname//' ERROR in receiving tag from atm to atm land intx') + endif endif ! we can now free the sender buffers if (mhpgid .ge. 0) then - ierr = iMOAB_FreeSenderBuffers(mhid, context_id) - ! CHECKRC(ierr, "cannot free buffers used to resend atm mesh tag towards the coverage mesh") + context_id = 100*atm(1)%cplcompid + lnd(1)%cplcompid !send to atm/lnd intx ! + ierr = iMOAB_FreeSenderBuffers(mphaid, context_id) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in freeing buffer ' + call shr_sys_abort(subname//' ERROR in freeing buffer') + endif endif else ! regular coarse homme mesh if (mhid .ge. 0) then ! send because we are on atm pes @@ -624,18 +708,28 @@ subroutine prep_atm_migrate_moab(infodata) ! as always, use nonblocking sends ierr = iMOAB_SendElementTag(mhid, tagName, mpicom_join, context_id) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in sending tag from atm spectral to atm/lnd intx ' + call shr_sys_abort(subname//' ERROR in sending tag from atm spectral to atm/lnd intx ') + endif endif if (mbaxid .ge. 0 ) then ! we are on coupler pes, for sure ! receive on atm on coupler pes, that was redistributed according to coverage ierr = iMOAB_ReceiveElementTag(mbaxid, tagName, mpicom_join, context_id) - !CHECKRC(ierr, "cannot receive tag values") + if (ierr .ne. 0) then + write(logunit,*) subname,' error in receiving tag from atm spectral to atm/lnd intx ' + call shr_sys_abort(subname//' ERROR in receiving tag from atm spectral to atm/lnd intx ') + endif endif ! we can now free the sender buffers if (mhid .ge. 0) then ierr = iMOAB_FreeSenderBuffers(mhid, context_id) - ! CHECKRC(ierr, "cannot free buffers used to resend atm mesh tag towards the coverage mesh") + if (ierr .ne. 0) then + write(logunit,*) subname,' error in freeing buffer ' + call shr_sys_abort(subname//' ERROR in freeing buffer') + endif endif endif @@ -645,6 +739,10 @@ subroutine prep_atm_migrate_moab(infodata) ! we could apply weights; need to use the same weight identifier wgtIdef as when we generated it ! hard coded now, it should be a runtime option in the future ierr = iMOAB_ApplyScalarProjectionWeights ( mbintxla, wgtIdef, tagName, tagNameProj) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in projection on land ' + call shr_sys_abort(subname//' ERROR in projection on land') + endif #ifdef MOABDEBUG ! we can also write the ocean mesh to file, just to see the projectd tag @@ -653,6 +751,10 @@ subroutine prep_atm_migrate_moab(infodata) outfile = 'lndCplProj'//trim(lnum)//'.h5m'//CHAR(0) wopts = ';PARALLEL=WRITE_PART'//CHAR(0) ! ierr = iMOAB_WriteMesh(mblxid, trim(outfile), trim(wopts)) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in writing mesh on coupler land' + call shr_sys_abort(subname//' ERROR in writing mesh on coupler land') + endif #endif !CHECKRC(ierr, "cannot receive tag values") @@ -691,16 +793,22 @@ subroutine prep_atm_migrate_moab(infodata) ! context_id is the other comp id, in this case it has to be coupler on land, context_id = lnd(1)%cplcompid ierr = iMOAB_SendElementTag(mphaid, tagname, mpicom_join, context_id) ! it will fail if intx is not done - ! if intx is not done, context does not exist ! + if (ierr .ne. 0) then + write(logunit,*) subname,' error in sending from phys atm to atm/land intx' + call shr_sys_abort(subname//' ERROR in sending from phys atm to atm/land intx') + endif endif if (mblxid .ge. 0 ) then ! we are on coupler pes, for sure, on land ! receive on land tag on coupler pes, in original migrate ! receive from ATM PHYS, which in this case is 200 + 5 ! - context_id = atm_id ! 5 for atm - ierr = iMOAB_ReceiveElementTag(mblxid, tagNameProj, mpicom_join, context_id) - !CHECKRC(ierr, "cannot receive tag values") + context_id = atm_id ! 5 for atm + ierr = iMOAB_ReceiveElementTag(mblxid, tagNameProj, mpicom_join, context_id) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in receiving from phys atm to atm/land intx' + call shr_sys_abort(subname//' ERROR in receiving from phys atm to atm/land intx') + endif #ifdef MOABDEBUG ! ! write out the lnd coupler mesh file to disk @@ -708,64 +816,24 @@ subroutine prep_atm_migrate_moab(infodata) outfile = 'lndCplProj_PH'//trim(lnum)//'.h5m'//CHAR(0) wopts = ';PARALLEL=WRITE_PART'//CHAR(0) ! ierr = iMOAB_WriteMesh(mblxid, trim(outfile), trim(wopts)) + if (ierr .ne. 0) then + write(logunit,*) subname,' error writing land coupler' + call shr_sys_abort(subname//' ERROR in writing land coupler') + endif #endif endif if (mphaid .ge. 0) then ! free buffers context_id = lnd(1)%cplcompid ierr = iMOAB_FreeSenderBuffers(mphaid, context_id) - ! CHECKRC(ierr, "cannot free buffers used to phys atm tag towards the coupler atm spectral mesh") + if (ierr .ne. 0) then + write(logunit,*) subname,' error in freeing buffer ' + call shr_sys_abort(subname//' ERROR in freeing buffer') + endif endif endif ! endif for diff_atm_land, we are on same mesh land and satm, use direct send, no projection endif - ! we also know that phys atm was loaded with some data; send it to the coupler atm - ! send data to atm on coupler PEs, using the par comm graph computed - ! in clp comp exch: - ! ierr = iMOAB_ComputeCommGraph( mphaid, mbaxid, mpicom_join, mpigrp_old, mpigrp_CPLID, & - ! typeA, typeB, ATM_PHYS_CID, id_join) - !!context_id = -1 ! this is the original - !!if (mphaid .ge. 0) then - ! we are on atm phys pes (atm pes) - !! tagname = 'T_ph;u_ph;v_ph'//CHAR(0) - ! context_id is the other comp id, in this case it has to be 6, id_join - !! context_id = id_join; - !! ierr = iMOAB_SendElementTag(mphaid, tagname, mpicom_join, context_id) - !!endif - - !!if (mbaxid .ge. 0 ) then ! we are on coupler pes, for sure - ! receive on atm tag on coupler pes, in original migrate - ! receive from ATM PHYS, which in this case is 200 + 5 - !! tagname = 'T_ph16;u_ph16;v_ph16'//CHAR(0) - !! context_id = 200 + atm_id ! 200 + 5 for atm - !! ierr = iMOAB_ReceiveElementTag(mbaxid, tagName, mpicom_join, context_id) - !CHECKRC(ierr, "cannot receive tag values") - !!endif - - ! we can now free the sender buffers - !!if (mhid .ge. 0) then - !! ierr = iMOAB_FreeSenderBuffers(mphaid, context_id) - !! ! CHECKRC(ierr, "cannot free buffers used to phys atm tag towards the coupler atm spectral mesh") - !!endif -!!#ifdef MOABDEBUG - ! we can also write the atm spectral mesh on coupler PEs to file - ! to check the tags received - !!if (mbaxid .ge. 0 ) then ! we are on coupler pes, for sure - !! write(lnum,"(I0.2)")num_proj - !! outfile = 'wholeATM_ph'//trim(lnum)//'.h5m'//CHAR(0) - !! wopts = ';PARALLEL=WRITE_PART'//CHAR(0) ! - !! ierr = iMOAB_WriteMesh(mbaxid, trim(outfile), trim(wopts)) - !!endif -!!#endif - -! similarly to imoab_phatm_ocn_coupler.cpp test, we can send data to atm intx ocn directly, from phys atm -! ierr = iMOAB_SendElementTag(cmpPhAtmPID, "T_ph;u_ph;v_ph;", &atmCouComm, &atmocnid, strlen("T_ph;u_ph;v_ph;")); -! we will use the *16* tags created before on spectral atm on coupler - ! we also know that phys atm was loaded with some data; send it to the coupler atm - ! send data to atm intx ocn on coupler pes: mbintxoa - ! in clp comp exch: - ! ierr = iMOAB_ComputeCommGraph( mphaid, mbintxoa, mpicom_join, mpigrp_old, mpigrp_CPLID, & - ! typeA, typeB, atm_id, idintx) context_id = -1 ! this is the original migrate; we will use the context of atm-ocn intx: ! idintx is a unique number of MOAB app that takes care of intx between ocn and atm mesh ! idintx = 100*atm(1)%cplcompid + ocn(1)%cplcompid ! something different, to differentiate it; ~ 618 ! From bbef10fa2f6f5d3f0a98400a73f588ca8c1b29c9 Mon Sep 17 00:00:00 2001 From: iulian07 Date: Wed, 14 Oct 2020 09:57:55 -0500 Subject: [PATCH 068/467] change options for anvil for intel18 use different modules, for which moab / hdf5 parallel works define /home/iulian/moab-blds/blues/moabs29 as the MOAB_PATH ne11 small model works for coupled system (CASES/W22a) ne30 crashes during zoltan call, with seemingly a mvapich error ? --- cime_config/machines/config_compilers.xml | 1 + cime_config/machines/config_machines.xml | 13 +++++++------ 2 files changed, 8 insertions(+), 6 deletions(-) diff --git a/cime_config/machines/config_compilers.xml b/cime_config/machines/config_compilers.xml index 9294b5bc7ccc..9fd367dd87a8 100644 --- a/cime_config/machines/config_compilers.xml +++ b/cime_config/machines/config_compilers.xml @@ -768,6 +768,7 @@ flags should be captured within MPAS CMake files. -DHAVE_SLASHPROC + /home/iulian/moab-blds/blues/moabs29 --host=Linux diff --git a/cime_config/machines/config_machines.xml b/cime_config/machines/config_machines.xml index 5d7f706d358f..4f4c58ae520c 100644 --- a/cime_config/machines/config_machines.xml +++ b/cime_config/machines/config_machines.xml @@ -1067,15 +1067,16 @@ parallel-netcdf/1.11.0-6qz7skn - intel/18.0.4-62uvgmb + intel/18.0.4-443hhug intel-mkl/2018.4.274-jwaeshj - netcdf/4.4.1-fijcsqi - netcdf-cxx/4.2-cixenix - netcdf-fortran/4.4.4-mmtrep3 + netcdf-cxx/4.2-rzdxzwf - mvapich2/2.2-verbs-m57bia7 - parallel-netcdf/1.11.0-ny4vo3o + mvapich2/2.3.1-verbs-dtbb6xk + hdf5/1.10.5-4rufvi6 + netcdf/4.4.1-4odwn5a + netcdf-fortran/4.4.4-kgp5hqm + parallel-netcdf/1.8.1-xqvwg7l gcc/8.2.0-xhxgy33 From e508c7445cacd748f31b336da087ee74e3f6f2b3 Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Sat, 31 Oct 2020 23:34:28 -0500 Subject: [PATCH 069/467] instance land domain mesh *********1*********2*********3*********4*********5*********6*********7** read xv and yv variables from fatm fraction file use pio, and allocate ni * nj * nv array of doubles on each task extract only what is needed to fill the missing data from domain (latv and lonv) use that later in lnd_comp_mct to explicit vertices [BFB] - Bit-For-Bit --- components/elm/src/cpl/lnd_comp_mct.F90 | 247 ++++++++++++++++-------- components/elm/src/main/surfrdMod.F90 | 76 +++++++- 2 files changed, 244 insertions(+), 79 deletions(-) diff --git a/components/elm/src/cpl/lnd_comp_mct.F90 b/components/elm/src/cpl/lnd_comp_mct.F90 index 50ed885316a4..9529d2600b9d 100644 --- a/components/elm/src/cpl/lnd_comp_mct.F90 +++ b/components/elm/src/cpl/lnd_comp_mct.F90 @@ -73,7 +73,7 @@ subroutine lnd_init_mct( EClock, cdata_l, x2l_l, l2x_l, NLFilename ) use mct_mod use ESMF #ifdef HAVE_MOAB - use seq_comm_mct, only: mlnid ! id of moab land app + use seq_comm_mct, only: mlnid ! id of moab land app #endif ! ! !ARGUMENTS: @@ -771,97 +771,190 @@ subroutine init_land_moab(bounds) integer n integer , external :: iMOAB_CreateVertices, iMOAB_WriteMesh, & iMOAB_DefineTagStorage, iMOAB_SetIntTagStorage, iMOAB_SetDoubleTagStorage, & - iMOAB_ResolveSharedEntities + iMOAB_ResolveSharedEntities, iMOAB_CreateElements ! local variables to fill in data integer, dimension(:), allocatable :: vgids ! retrieve everything we need from land domain mct_ldom ! number of vertices is the size of land domain real(r8), dimension(:), allocatable :: moab_vert_coords ! temporary real(r8) :: latv, lonv - integer dims, i, ilat, ilon, igdx, ierr, tagindex - integer tagtype, numco, ent_type + integer dims, i, iv, ilat, ilon, igdx, ierr, tagindex + integer tagtype, numco, ent_type, mbtype, block_ID character*100 outfile, wopts, localmeshfile, tagname + integer, allocatable :: moabconn(:) ! will have the connectivity in terms of local index in verts + dims =3 ! store as 3d mesh ! number the local grid lsz = bounds%endg - bounds%begg + 1 - allocate(moab_vert_coords(lsz*dims)) - allocate(vgids(lsz)) + + allocate(vgids(lsz)) ! use it for global ids, for elements in full mesh or vertices in point cloud do n = 1, lsz - vgids(n) = ldecomp%gdc2glo(bounds%begg+n-1) + vgids(n) = ldecomp%gdc2glo(bounds%begg+n-1) ! local to global ! end do - gsize = ldomain%ni * ldomain%nj - do i = 1, lsz - n = i-1 + bounds%begg - lonv = ldomain%lonc(n) *SHR_CONST_PI/180. - latv = ldomain%latc(n) *SHR_CONST_PI/180. - moab_vert_coords(3*i-2)=COS(latv)*COS(lonv) - moab_vert_coords(3*i-1)=COS(latv)*SIN(lonv) - moab_vert_coords(3*i )=SIN(latv) - enddo - ierr = iMOAB_CreateVertices(mlnid, lsz*3, dims, moab_vert_coords) - if (ierr > 0 ) & - call endrun('Error: fail to create MOAB vertices in land model') - - tagtype = 0 ! dense, integer - numco = 1 - tagname='GLOBAL_ID'//CHAR(0) - ierr = iMOAB_DefineTagStorage(mlnid, tagname, tagtype, numco, tagindex ) - if (ierr > 0 ) & - call endrun('Error: fail to retrieve GLOBAL_ID tag ') - - ent_type = 0 ! vertex type - ierr = iMOAB_SetIntTagStorage ( mlnid, tagname, lsz , ent_type, vgids) - if (ierr > 0 ) & - call endrun('Error: fail to set GLOBAL_ID tag ') - - ierr = iMOAB_ResolveSharedEntities( mlnid, lsz, vgids ); - if (ierr > 0 ) & - call endrun('Error: fail to resolve shared entities') - - !there are no shared entities, but we will set a special partition tag, in order to see the - ! partitions ; it will be visible with a Pseudocolor plot in VisIt - tagname='partition'//CHAR(0) - ierr = iMOAB_DefineTagStorage(mlnid, tagname, tagtype, numco, tagindex ) - if (ierr > 0 ) & - call endrun('Error: fail to create new partition tag ') - - vgids = iam - ierr = iMOAB_SetIntTagStorage ( mlnid, tagname, lsz , ent_type, vgids) - if (ierr > 0 ) & - call endrun('Error: fail to set partition tag ') - - ! use moab_vert_coords as a data holder for a frac tag and area tag that we will create - ! on the vertices; do not allocate other data array - tagname='frac'//CHAR(0) - tagtype = 1 ! dense, double - ierr = iMOAB_DefineTagStorage(mlnid, tagname, tagtype, numco, tagindex ) - if (ierr > 0 ) & - call endrun('Error: fail to create frac tag ') - - do i = 1, lsz - n = i-1 + bounds%begg - moab_vert_coords(i) = ldomain%frac(n) - enddo - ierr = iMOAB_SetDoubleTagStorage ( mlnid, tagname, lsz , ent_type, moab_vert_coords) - if (ierr > 0 ) & - call endrun('Error: fail to set frac tag ') - - tagname='area'//CHAR(0) - ierr = iMOAB_DefineTagStorage(mlnid, tagname, tagtype, numco, tagindex ) - if (ierr > 0 ) & - call endrun('Error: fail to create area tag ') - do i = 1, lsz - n = i-1 + bounds%begg - moab_vert_coords(i) = ldomain%area(n)/(re*re) ! use the same doubles for second tag :) - enddo - - ierr = iMOAB_SetDoubleTagStorage ( mlnid, tagname, lsz , ent_type, moab_vert_coords ) - if (ierr > 0 ) & - call endrun('Error: fail to set area tag ') - + gsize = ldomain%ni * ldomain%nj ! size of the total grid + ! if ldomain%nv > 3 , create mesh + if (ldomain%nv .ge. 3 ) then + ! number of vertices is nv * lsz ! + allocate(moab_vert_coords(lsz*dims*ldomain%nv)) + ! loop over ldomain + allocate(moabconn(ldomain%nv * lsz)) + do n = bounds%begg, bounds%endg + i = (n - bounds%begg) * ldomain%nv + do iv = 1, ldomain%nv + lonv = ldomain%lonv(n, iv) * SHR_CONST_PI/180. + latv = ldomain%latv(n, iv) * SHR_CONST_PI/180. + i = i + 1 ! iv-th vertex of cell n; i starts at 1 ! should we repeat previous if nan + ! print *, i, n, ldomain%lonv(n, iv) , ldomain%latv(n, iv) + moab_vert_coords(3*i-2)=COS(latv)*COS(lonv) + moab_vert_coords(3*i-1)=COS(latv)*SIN(lonv) + moab_vert_coords(3*i )=SIN(latv) + moabconn(i) = i! + enddo + enddo + ierr = iMOAB_CreateVertices(mlnid, lsz * 3 * ldomain%nv, dims, moab_vert_coords) + if (ierr > 0 ) & + call endrun('Error: fail to create MOAB vertices in land model') + + + mbtype = 2 ! triangle + if (ldomain%nv .eq. 4) mbtype = 3 ! quad + if (ldomain%nv .gt. 4) mbtype = 4 ! polygon + block_ID = 100 !some value + ierr = iMOAB_CreateElements( mlnid, lsz, mbtype, ldomain%nv, moabconn, block_ID ); + ! define some tags on cells now, not on vertices + tagtype = 0 ! dense, integer + numco = 1 + tagname='GLOBAL_ID'//CHAR(0) + ierr = iMOAB_DefineTagStorage(mlnid, tagname, tagtype, numco, tagindex ) + if (ierr > 0 ) & + call endrun('Error: fail to retrieve GLOBAL_ID tag ') + + ent_type = 1 ! element type + ierr = iMOAB_SetIntTagStorage ( mlnid, tagname, lsz , ent_type, vgids) + if (ierr > 0 ) & + call endrun('Error: fail to set GLOBAL_ID tag ') + +! ierr = iMOAB_ResolveSharedEntities( mlnid, lsz, vgids ); +! if (ierr > 0 ) & +! call endrun('Error: fail to resolve shared entities') + +! !there are no shared entities, but we will set a special partition tag, in order to see the +! ! partitions ; it will be visible with a Pseudocolor plot in VisIt +! tagname='partition'//CHAR(0) +! ierr = iMOAB_DefineTagStorage(mlnid, tagname, tagtype, numco, tagindex ) +! if (ierr > 0 ) & +! call endrun('Error: fail to create new partition tag ') +! +! vgids = iam +! ierr = iMOAB_SetIntTagStorage ( mlnid, tagname, lsz , ent_type, vgids) +! if (ierr > 0 ) & +! call endrun('Error: fail to set partition tag ') + + ! use moab_vert_coords as a data holder for a frac tag and area tag that we will create + ! on the vertices; do not allocate other data array + tagname='frac'//CHAR(0) + tagtype = 1 ! dense, double + ierr = iMOAB_DefineTagStorage(mlnid, tagname, tagtype, numco, tagindex ) + if (ierr > 0 ) & + call endrun('Error: fail to create frac tag ') + + do i = 1, lsz + n = i-1 + bounds%begg + moab_vert_coords(i) = ldomain%frac(n) + enddo + ierr = iMOAB_SetDoubleTagStorage ( mlnid, tagname, lsz , ent_type, moab_vert_coords) + if (ierr > 0 ) & + call endrun('Error: fail to set frac tag ') + + tagname='area'//CHAR(0) + ierr = iMOAB_DefineTagStorage(mlnid, tagname, tagtype, numco, tagindex ) + if (ierr > 0 ) & + call endrun('Error: fail to create area tag ') + do i = 1, lsz + n = i-1 + bounds%begg + moab_vert_coords(i) = ldomain%area(n)/(re*re) ! use the same doubles for second tag :) + enddo + + ierr = iMOAB_SetDoubleTagStorage ( mlnid, tagname, lsz , ent_type, moab_vert_coords ) + if (ierr > 0 ) & + call endrun('Error: fail to set area tag ') + + deallocate(moabconn) + + else ! old point cloud mesh + allocate(moab_vert_coords(lsz*dims)) + do i = 1, lsz + n = i-1 + bounds%begg + lonv = ldomain%lonc(n) *SHR_CONST_PI/180. + latv = ldomain%latc(n) *SHR_CONST_PI/180. + moab_vert_coords(3*i-2)=COS(latv)*COS(lonv) + moab_vert_coords(3*i-1)=COS(latv)*SIN(lonv) + moab_vert_coords(3*i )=SIN(latv) + enddo + ierr = iMOAB_CreateVertices(mlnid, lsz*3, dims, moab_vert_coords) + if (ierr > 0 ) & + call endrun('Error: fail to create MOAB vertices in land model') + + tagtype = 0 ! dense, integer + numco = 1 + tagname='GLOBAL_ID'//CHAR(0) + ierr = iMOAB_DefineTagStorage(mlnid, tagname, tagtype, numco, tagindex ) + if (ierr > 0 ) & + call endrun('Error: fail to retrieve GLOBAL_ID tag ') + + ent_type = 0 ! vertex type + ierr = iMOAB_SetIntTagStorage ( mlnid, tagname, lsz , ent_type, vgids) + if (ierr > 0 ) & + call endrun('Error: fail to set GLOBAL_ID tag ') + + ierr = iMOAB_ResolveSharedEntities( mlnid, lsz, vgids ); + if (ierr > 0 ) & + call endrun('Error: fail to resolve shared entities') + + !there are no shared entities, but we will set a special partition tag, in order to see the + ! partitions ; it will be visible with a Pseudocolor plot in VisIt + tagname='partition'//CHAR(0) + ierr = iMOAB_DefineTagStorage(mlnid, tagname, tagtype, numco, tagindex ) + if (ierr > 0 ) & + call endrun('Error: fail to create new partition tag ') + + vgids = iam + ierr = iMOAB_SetIntTagStorage ( mlnid, tagname, lsz , ent_type, vgids) + if (ierr > 0 ) & + call endrun('Error: fail to set partition tag ') + + ! use moab_vert_coords as a data holder for a frac tag and area tag that we will create + ! on the vertices; do not allocate other data array + tagname='frac'//CHAR(0) + tagtype = 1 ! dense, double + ierr = iMOAB_DefineTagStorage(mlnid, tagname, tagtype, numco, tagindex ) + if (ierr > 0 ) & + call endrun('Error: fail to create frac tag ') + + do i = 1, lsz + n = i-1 + bounds%begg + moab_vert_coords(i) = ldomain%frac(n) + enddo + ierr = iMOAB_SetDoubleTagStorage ( mlnid, tagname, lsz , ent_type, moab_vert_coords) + if (ierr > 0 ) & + call endrun('Error: fail to set frac tag ') + + tagname='area'//CHAR(0) + ierr = iMOAB_DefineTagStorage(mlnid, tagname, tagtype, numco, tagindex ) + if (ierr > 0 ) & + call endrun('Error: fail to create area tag ') + do i = 1, lsz + n = i-1 + bounds%begg + moab_vert_coords(i) = ldomain%area(n)/(re*re) ! use the same doubles for second tag :) + enddo + + ierr = iMOAB_SetDoubleTagStorage ( mlnid, tagname, lsz , ent_type, moab_vert_coords ) + if (ierr > 0 ) & + call endrun('Error: fail to set area tag ') + endif deallocate(moab_vert_coords) deallocate(vgids) #ifdef MOABDEBUG diff --git a/components/elm/src/main/surfrdMod.F90 b/components/elm/src/main/surfrdMod.F90 index c000e504dbbf..a178c0d82de5 100644 --- a/components/elm/src/main/surfrdMod.F90 +++ b/components/elm/src/main/surfrdMod.F90 @@ -18,6 +18,11 @@ module surfrdMod use ncdio_pio , only : file_desc_t, var_desc_t, ncd_pio_openfile, ncd_pio_closefile use ncdio_pio , only : ncd_io, check_var, ncd_inqfdims, check_dim, ncd_inqdid, ncd_inqdlen use pio +#ifdef HAVE_MOAB + use mct_mod , only : mct_gsMap + use decompMod , only : get_clmlevel_gsmap + ! use spmdMod , only : iam ! rank on the land communicator +#endif use spmdMod ! ! !PUBLIC TYPES: @@ -102,7 +107,7 @@ subroutine surfrd_get_globmask(filename, mask, ni, nj) if (isgrid2d) then allocate(idata2d(ni,nj)) - idata2d(:,:) = 1 + idata2d(:,:) = 1 call ncd_io(ncid=ncid, varname='LANDMASK', data=idata2d, flag='read', readvar=readvar) if (.not. readvar) then call ncd_io(ncid=ncid, varname='mask', data=idata2d, flag='read', readvar=readvar) @@ -110,7 +115,7 @@ subroutine surfrd_get_globmask(filename, mask, ni, nj) if (readvar) then do j = 1,nj do i = 1,ni - n = (j-1)*ni + i + n = (j-1)*ni + i mask(n) = idata2d(i,j) enddo enddo @@ -171,6 +176,11 @@ subroutine surfrd_get_grid(begg, endg, ldomain, filename, glcfilename) ! pflotran:beg----------------------------- integer :: j, np, nv +#ifdef HAVE_MOAB + type(mct_gsMap), pointer :: gsMap + integer :: i, iv , iseg, ig, local ! ni, nj, nv, nseg, global ig + +#endif ! pflotran:end----------------------------- character(len=32) :: subname = 'surfrd_get_grid' ! subroutine name @@ -240,6 +250,68 @@ subroutine surfrd_get_grid(begg, endg, ldomain, filename, glcfilename) end if ! pflotran:end----------------------------------------------- +#ifdef HAVE_MOAB + ! read xv and yv anyway + if (ldomain%nv>=3 ) then + call get_clmlevel_gsmap (grlnd, gsMap) + allocate(rdata3d(nv,ni,nj)) ! transpose from c, as this is fortran + vname = 'xv' + ! this should be improved in a distributed read, that does not use full grid ni * nj * nv 720*360*4*8 ~ 8Mb + call ncd_io(ncid=ncid, varname=trim(vname), data=rdata3d, flag='read', readvar=readvar) + if (.not. readvar) call endrun( msg=trim(subname)//' ERROR: xv NOT on file'//errMsg(__FILE__, __LINE__)) + ! fill up the ldomain%lonv(begg:endg, 1:nv) array + local = begg + do iseg = 1, gsMap%ngseg + if (gsMap%pe_loc(iseg) .eq. iam) then + !write(iulog,*), iseg, gsMap%pe_loc(iseg), gsMap%start(iseg), gsMap%length(iseg) + do ig = gsMap%start(iseg), gsMap%start(iseg) + gsMap%length(iseg) - 1 + j = (ig-1)/ni + 1 + i = ig - ni*(j-1) + ! print *, iam, ig, j, i, rdata3d(1, i, j), rdata3d(2, i, j), rdata3d(3, i, j) + do iv = 1, nv + if (local .le. endg) then + ldomain%lonv(local, iv ) = rdata3d(iv, i, j) + else + write (iulog, *), 'OVERFLOW', iseg, gsMap%pe_loc(iseg), gsMap%start(iseg), gsMap%length(iseg), local + endif + enddo + local = local + 1 + enddo + endif + enddo + ! repeat for latv + vname = 'yv' + call ncd_io(ncid=ncid, varname=trim(vname), data=rdata3d, flag='read', readvar=readvar) + if (.not. readvar) call endrun( msg=trim(subname)//' ERROR: yv NOT on file'//errMsg(__FILE__, __LINE__)) + ! fill up the ldomain%lonv(begg:endg, 1:nv) array + local = begg + do iseg = 1, gsMap%ngseg + if (gsMap%pe_loc(iseg) .eq. iam) then + do ig = gsMap%start(iseg), gsMap%start(iseg) + gsMap%length(iseg) - 1 + j = (ig-1)/ni + 1 + i = ig - ni*(j-1) + do iv = 1, nv + if (local .le. endg) then + ldomain%latv(local, iv ) = rdata3d(iv, i, j) + endif + enddo + local = local + 1 + enddo + endif + enddo + ! deallocate what is not needed anymore (for half degree land model, ~8Mb) + deallocate(rdata3d) + ! fill ldomain%lonv data , in a loop +! call ncd_io(ncid=ncid, varname='xv', flag='read', data=ldomain%lonv, & +! dim1name=grlnd, readvar=readvar) +! if (.not. readvar) call endrun( msg=trim(subname)//' ERROR: xv NOT on file'//errMsg(__FILE__, __LINE__)) +! +! call ncd_io(ncid=ncid, varname='yv', flag='read', data=ldomain%latv, & +! dim1name=grlnd, readvar=readvar) +! if (.not. readvar) call endrun( msg=trim(subname)//' ERROR: yv NOT on file'//errMsg(__FILE__, __LINE__)) + + end if +#endif else call ncd_io(ncid=ncid, varname= 'AREA', flag='read', data=ldomain%area, & dim1name=grlnd, readvar=readvar) From 1074a0c8edba17d5cc71843922fedc4ec821dab1 Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Sun, 1 Nov 2020 23:38:20 -0600 Subject: [PATCH 070/467] merge vertices in land instance *********1*********2*********3*********4*********5*********6*********7** cells created in land/domain have repeated vertices that need to be merged out Maintaining a good mesh is not easy, as vertices have to be renumbered and deleted cells removed from material sets [BFB] - Bit-For-Bit --- components/elm/src/cpl/lnd_comp_mct.F90 | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/components/elm/src/cpl/lnd_comp_mct.F90 b/components/elm/src/cpl/lnd_comp_mct.F90 index 9529d2600b9d..68649c890d03 100644 --- a/components/elm/src/cpl/lnd_comp_mct.F90 +++ b/components/elm/src/cpl/lnd_comp_mct.F90 @@ -771,7 +771,7 @@ subroutine init_land_moab(bounds) integer n integer , external :: iMOAB_CreateVertices, iMOAB_WriteMesh, & iMOAB_DefineTagStorage, iMOAB_SetIntTagStorage, iMOAB_SetDoubleTagStorage, & - iMOAB_ResolveSharedEntities, iMOAB_CreateElements + iMOAB_ResolveSharedEntities, iMOAB_CreateElements, iMOAB_MergeVertices ! local variables to fill in data integer, dimension(:), allocatable :: vgids ! retrieve everything we need from land domain mct_ldom @@ -883,6 +883,10 @@ subroutine init_land_moab(bounds) call endrun('Error: fail to set area tag ') deallocate(moabconn) + ! use merge vertices new imoab method to fix cells + ierr = iMOAB_MergeVertices(mlnid) + if (ierr > 0 ) & + call endrun('Error: fail to fix vertices in land mesh ') else ! old point cloud mesh allocate(moab_vert_coords(lsz*dims)) From 9c50035f2457a113cf1d99f94879fd77e2558814 Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Sun, 20 Dec 2020 23:37:38 -0600 Subject: [PATCH 071/467] remove partition tag on land mesh --- driver-moab/main/cplcomp_exchange_mod.F90 | 13 +------------ 1 file changed, 1 insertion(+), 12 deletions(-) diff --git a/driver-moab/main/cplcomp_exchange_mod.F90 b/driver-moab/main/cplcomp_exchange_mod.F90 index 96ac2661f767..70cb58f21776 100644 --- a/driver-moab/main/cplcomp_exchange_mod.F90 +++ b/driver-moab/main/cplcomp_exchange_mod.F90 @@ -1238,7 +1238,7 @@ subroutine cplcomp_moab_Init(comp) if (ierr .ne. 0) then write(logunit,*) subname,' error in registering coupler land ' call shr_sys_abort(subname//' ERROR in registering coupler land') - endif + endif ierr = iMOAB_ReceiveMesh(mblxid, mpicom_join, mpigrp_old, id_old) if (ierr .ne. 0) then write(logunit,*) subname,' error in receiving coupler land mesh' @@ -1260,17 +1260,6 @@ subroutine cplcomp_moab_Init(comp) call shr_sys_abort(subname//' ERROR in defining tags on land coupler') endif #ifdef MOABDEBUG - !there are no shared entities, but we will set a special partition tag, in order to see the - ! partitions ; it will be visible with a Pseudocolor plot in VisIt - tagname='partition'//CHAR(0) - tagtype = 0 ! dense, integer - numco = 1 ! one value per cell - ierr = iMOAB_DefineTagStorage(mblxid, tagname, tagtype, numco, tagindex ) - ierr = iMOAB_GetMeshInfo(mblxid, nverts, nelem, nblocks, nsbc, ndbc) - allocate(vgids(nverts(1))) - vgids = rank - ent_type = 0 ! vertex type - ierr = iMOAB_SetIntTagStorage ( mblxid, tagname, nverts(1) , ent_type, vgids) ! debug test outfile = 'recLand.h5m'//CHAR(0) wopts = ';PARALLEL=WRITE_PART'//CHAR(0) ! From f800695d52bd92c1943a672dc719acd57c97a9df Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Mon, 21 Dec 2020 10:29:40 -0600 Subject: [PATCH 072/467] create the land projected tag on land component pes too --- driver-moab/main/cplcomp_exchange_mod.F90 | 13 ++++++++++++- 1 file changed, 12 insertions(+), 1 deletion(-) diff --git a/driver-moab/main/cplcomp_exchange_mod.F90 b/driver-moab/main/cplcomp_exchange_mod.F90 index 70cb58f21776..73ef310b0ab7 100644 --- a/driver-moab/main/cplcomp_exchange_mod.F90 +++ b/driver-moab/main/cplcomp_exchange_mod.F90 @@ -1228,7 +1228,18 @@ subroutine cplcomp_moab_Init(comp) if (ierr .ne. 0) then write(logunit,*) subname,' error in sending land mesh ' call shr_sys_abort(subname//' ERROR in sending land mesh ') - endif + endif + ! create the receiver on land mesh too: + tagnameProj = 'a2lTbot_proj'//CHAR(0) ! temperature + tagtype = 1 ! dense, double + numco = 1 ! one value per vertex / entity + ierr = iMOAB_DefineTagStorage(mlnid, tagnameProj, tagtype, numco, tagindex ) + + ! define more tags + tagnameProj = 'a2lUbot_proj'//CHAR(0) ! U component of velocity + ierr = iMOAB_DefineTagStorage(mlnid, tagnameProj, tagtype, numco, tagindex ) + tagnameProj = 'a2lVbot_proj'//CHAR(0) ! V component of velocity + ierr = iMOAB_DefineTagStorage(mlnid, tagnameProj, tagtype, numco, tagindex ) endif if (MPI_COMM_NULL /= mpicom_new ) then ! we are on the coupler pes From 08b11a0a9781ac2a8359394d862a13dbd663ea42 Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Tue, 22 Dec 2020 09:26:02 -0600 Subject: [PATCH 073/467] consider land a full mesh, similar to ocean *********1*********2*********3*********4*********5*********6*********7** [BFB] - Bit-For-Bit --- driver-mct/shr/seq_comm_mct.F90 | 1 - driver-moab/main/prep_atm_mod.F90 | 289 ++++++++++++------------------ 2 files changed, 114 insertions(+), 176 deletions(-) diff --git a/driver-mct/shr/seq_comm_mct.F90 b/driver-mct/shr/seq_comm_mct.F90 index bbcd77b910d4..964977ac4b5d 100644 --- a/driver-mct/shr/seq_comm_mct.F90 +++ b/driver-mct/shr/seq_comm_mct.F90 @@ -217,7 +217,6 @@ module seq_comm_mct integer, public :: mhid, mhfid, mpoid, mlnid ! homme, homme fine, ocean, land moab ids integer, public :: mhpgid ! iMOAB id for atm pgx grid, on atm pes; created with se and gll grids logical, public :: atm_pg_active = .false. ! whether the atm uses FV mesh or not ; made true if fv_nphys > 0 - logical, public :: diff_atm_land = .false. ! whether atm and land use different mesh integer, public :: mphaid ! iMOAB id for atm phys grid, on atm pes integer, public :: mbaxid ! iMOAB id for atm migrated mesh to coupler pes integer, public :: mboxid ! iMOAB id for mpas ocean migrated mesh to coupler pes diff --git a/driver-moab/main/prep_atm_mod.F90 b/driver-moab/main/prep_atm_mod.F90 index a45c5b1bdede..2eae0eacb235 100644 --- a/driver-moab/main/prep_atm_mod.F90 +++ b/driver-moab/main/prep_atm_mod.F90 @@ -27,7 +27,6 @@ module prep_atm_mod use seq_comm_mct, only : atm_pg_active ! whether the atm uses FV mesh or not ; made true if fv_nphys > 0 use seq_comm_mct, only : mblxid ! iMOAB id for land migrated to coupler pes !! old name : mlnxid use seq_comm_mct, only : mbintxla ! iMOAB id for intx mesh between land and atmosphere - use seq_comm_mct, only : diff_atm_land ! false by default, so land and atm on same mesh use seq_comm_mct, only : seq_comm_getinfo => seq_comm_setptrs use dimensions_mod, only : np ! for atmosphere @@ -128,7 +127,7 @@ subroutine prep_atm_init(infodata, ocn_c2_atm, ice_c2_atm, lnd_c2_atm, iac_c2_at character(*), parameter :: subname = '(prep_atm_init)' character(*), parameter :: F00 = "('"//subname//" : ', 4A )" integer, external :: iMOAB_ComputeMeshIntersectionOnSphere, iMOAB_RegisterFortranApplication, & - iMOAB_WriteMesh, iMOAB_ComputePointDoFIntersection + iMOAB_WriteMesh ! , iMOAB_ComputePointDoFIntersection ; not needed anymore: integer ierr, idintx, rank character*32 :: appname, outfile, wopts, lnum !--------------------------------------------------------------- @@ -286,6 +285,25 @@ subroutine prep_atm_init(infodata, ocn_c2_atm, ice_c2_atm, lnd_c2_atm, iac_c2_at call shr_sys_abort(subname//' ERROR in registering atm lnd intx ') endif ! ierr = iMOAB_ComputePointDoFIntersection (mbaxid, mblxid, mbintxla) + ierr = iMOAB_ComputeMeshIntersectionOnSphere (mbaxid, mblxid, mbintxla) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in computing atm lnd intx' + call shr_sys_abort(subname//' ERROR in computing atm lnd intx') + endif +#ifdef MOABDEBUG + wopts = CHAR(0) + call shr_mpi_commrank( mpicom_CPLID, rank ) + if (rank .lt. 5) then + write(lnum,"(I0.2)")rank ! + outfile = 'intx_la'//trim(lnum)// '.h5m' // CHAR(0) + ierr = iMOAB_WriteMesh(mbintxla, outfile, wopts) ! write local intx file + if (ierr .ne. 0) then + write(logunit,*) subname,' error in writing intx file land atm ' + call shr_sys_abort(subname//' ERROR in writing intx file ') + endif + endif + num_proj = 0 ! to index projection files on coupler pes +#endif endif end if @@ -419,6 +437,7 @@ subroutine prep_atm_lnd_moab(infodata) ! If the land is on the same mesh as atm, we do not need to compute intx ! Just use compute graph between phys atm and lnd on coupler, to be able to send ! data from atm phys to atm on coupler for projection on land + ! in the trigrid case, atm and land use different meshes, so use coverage anyway ! ! Arguments type(seq_infodata_type) , intent(in) :: infodata @@ -446,7 +465,7 @@ subroutine prep_atm_lnd_moab(infodata) lnd_present=lnd_present) - ! it involves initial atm app; mhid; also migrate atm mesh on coupler pes, mbaxid + ! it involves initial atm app; mhid; or pg2 mesh , in case atm_pg_active also migrate atm mesh on coupler pes, mbaxid ! intx lnd atm are in mbintxla ; remapper also has some info about coverage mesh ! after this, the sending of tags from atm pes to coupler pes, in land context will use the new par ! comm graph, that has more precise info about @@ -457,61 +476,47 @@ subroutine prep_atm_lnd_moab(infodata) ! we cannot use mbintxla because it may not exist on atm comp yet; context_id = lnd(1)%cplcompid call seq_comm_getinfo(ID_join,mpicom=mpicom_join) - if (diff_atm_land) then ! we assume we are already on pg2 mesh ? + if (atm_pg_active ) then ! use mhpgid mesh ierr = iMOAB_CoverageGraph(mpicom_join, mhpgid, mbaxid, mbintxla, context_id); - if (ierr .ne. 0) then - write(logunit,*) subname,' error in computing cov graph atm - land ' - call shr_sys_abort(subname//' ERROR in computing cov graph atm - land') - endif - if (mbintxla .ge. 0 ) then ! weights are computed over coupler pes + else + ierr = iMOAB_CoverageGraph(mpicom_join, mhid, mbaxid, mbintxla, context_id); + endif + if (ierr .ne. 0) then + write(logunit,*) subname,' error in computing coverage graph atm/lnd ' + call shr_sys_abort(subname//' ERROR in computing coverage graph atm/lnd ') + endif + + if (mbintxla .ge. 0 ) then ! weights are computed over coupler pes + ! copy from atm - ocn , it is now similar, as land is full mesh, not pc cloud + wgtIdef = 'scalar'//CHAR(0) + if (atm_pg_active) then dm1 = "fv"//CHAR(0) dofnameATM="GLOBAL_ID"//CHAR(0) - orderATM = 1 - wgtIdef = 'scalar-pc'//CHAR(0) - - dm2 = "pcloud"//CHAR(0) - - dofnameLND="GLOBAL_ID"//CHAR(0) - - orderLND = 1 ! not much arguing - monotonicity = 0 ! - volumetric = 1 - noConserve = 0 - validate = 1 - - ierr = iMOAB_ComputeScalarProjectionWeights ( mbintxla, wgtIdef, & - trim(dm1), orderATM, trim(dm2), orderLND, & - monotonicity, volumetric, noConserve, validate, & - trim(dofnameATM), trim(dofnameLND) ) - if (ierr .ne. 0) then - write(logunit,*) subname,' error in computing weights atm-pg2 land ' - call shr_sys_abort(subname//' ERROR in computing weights atm-pg2 land') - endif + orderATM = 1 ! fv-fv + volumetric = 1 ! maybe volumetric ? + else + dm1 = "cgll"//CHAR(0) + dofnameATM="GLOBAL_DOFS"//CHAR(0) + orderATM = np ! it should be 4 + volumetric = 0 endif - else - ! it happens over joint communicator - ! we do not need intx, just comm graph computation; see imoab_phatm_ocn_coupler.cpp - ! prepare to send from phys atm towards land, based on GLOBAL_ID - -! if( atmCouComm != MPI_COMM_NULL ) -! { -! int typeA = 2; // point cloud -! int typeB = 2; // point cloud for land on coupler, too -! ierr = iMOAB_ComputeCommGraph( cmpPhAtmPID, cplLndPID, &atmCouComm, &atmPEGroup, &couPEGroup, &typeA, &typeB, -! &cmpatm, &cpllnd ); -! } - call seq_comm_getinfo(CPLID ,mpigrp=mpigrp_CPLID) ! second group, the coupler group CPLID is global variable - call seq_comm_getinfo(atm_id, mpigrp=mpigrp_old) ! component group pes, from atm id ( also ATMID(1) ) - typeA = 2 ! point cloud - typeB = 2 ! point cloud too, for land on coupler lnd(1)%cplcompid - ierr = iMOAB_ComputeCommGraph( mphaid, mblxid, mpicom_join, mpigrp_old, mpigrp_CPLID, & - typeA, typeB, atm_id, lnd(1)%cplcompid) + dm2 = "fv"//CHAR(0) + dofnameLND="GLOBAL_ID"//CHAR(0) + orderLND = 1 ! not much arguing + monotonicity = 0 ! + noConserve = 0 + validate = 1 + + ierr = iMOAB_ComputeScalarProjectionWeights ( mbintxla, wgtIdef, & + trim(dm1), orderATM, trim(dm2), orderLND, & + monotonicity, volumetric, noConserve, validate, & + trim(dofnameATM), trim(dofnameLND) ) if (ierr .ne. 0) then - write(logunit,*) subname,' error in computing graph atm-phys-grid land ' - call shr_sys_abort(subname//' ERROR in computing graph atm-phys-grid land') + write(logunit,*) subname,' error in computing weights atm land ' + call shr_sys_abort(subname//' ERROR in computing weights atm land') endif - endif + ! do not do comm graph anymore : we will compute as with intersection atm - ocn end subroutine prep_atm_lnd_moab @@ -663,18 +668,20 @@ subroutine prep_atm_migrate_moab(infodata) endif ! repeat this for land data, that is already on atm tag tagNameProj = 'a2lTbot_proj;a2lUbot_proj;a2lVbot_proj;'//CHAR(0) + context_id = lnd(1)%cplcompid - wgtIdef = 'scalar-pc'//CHAR(0) + wgtIdef = 'scalar'//CHAR(0) ! from fv, need to be similar to ocean now if (atm_present .and. lnd_present) then - if (diff_atm_land) then ! we need to send either from pg mhpgid or coarse mhid UNTESTED ! if (atm_pg_active ) then ! use mhpgid mesh - if (mhpgid .ge. 0) then ! send because we are on atm pes + + if (mhpgid .ge. 0) then ! send because we are on atm pes ! basically, adjust the migration of the tag we want to project; it was sent initially with ! original partitioning, now we need to adjust it for "coverage" mesh ! as always, use nonblocking sends - ! FIXME TODO: use intx id, not just land id! + tagName = 'T_ph;u_ph;v_ph;'//CHAR(0) ! they are defined in initialize_moab_atm_phys in atm_comp_mct context_id = 100*atm(1)%cplcompid + lnd(1)%cplcompid !send to atm/lnd intx ! + ierr = iMOAB_SendElementTag(mphaid, tagName, mpicom_join, context_id) if (ierr .ne. 0) then write(logunit,*) subname,' error in sending tag from atm to atm land intx ' @@ -684,6 +691,7 @@ subroutine prep_atm_migrate_moab(infodata) endif if (mbaxid .ge. 0 ) then ! we are on coupler pes, for sure ! receive on atm on coupler pes, that was redistributed according to coverage + tagName = 'T_ph;u_ph;v_ph;'//CHAR(0) ! they are defined in initialize_moab_atm_phys ierr = iMOAB_ReceiveElementTag(mbintxla, tagName, mpicom_join, atm_id) if (ierr .ne. 0) then write(logunit,*) subname,' error in receiving tag from atm to atm land intx ' @@ -701,6 +709,8 @@ subroutine prep_atm_migrate_moab(infodata) endif endif else ! regular coarse homme mesh + tagName = 'a2oTbot;a2oUbot;a2oVbot;'//CHAR(0) + ! context_id = lnd(1)%cplcompid ! if (mhid .ge. 0) then ! send because we are on atm pes ! basically, adjust the migration of the tag we want to project; it was sent initially with @@ -759,130 +769,59 @@ subroutine prep_atm_migrate_moab(infodata) !CHECKRC(ierr, "cannot receive tag values") endif - else ! we are on same mesh, just send from phys grid atm directly to land cpl, no projection needed - ! we will do the same send , as imoab_phatm_ocn_coupler.cpp; no projection needed, just send to land coupler - ! directly, and data will be where we want it !! - ! this is how we are sending from phys grid directly to land coupler, in imoab_phatm_ocn_coupler.cpp -! if( atmComm != MPI_COMM_NULL ) -! { -! -! // as always, use nonblocking sends -! // this is for projection to land: -! ierr = -! iMOAB_SendElementTag( cmpPhAtmPID, "T_ph;u_ph;v_ph;", &atmCouComm, &cpllnd, strlen( "T_ph;u_ph;v_ph;" ) ); -! CHECKIERR( ierr, "cannot send tag values towards cpl on land" ) -! } -! if( couComm != MPI_COMM_NULL ) -! { -! // receive on lnd on coupler pes -! ierr = iMOAB_ReceiveElementTag( cplLndPID, "T_proj;u_proj;v_proj;", &atmCouComm, &cmpatm, -! strlen( "T_proj;u_proj;v_proj;" ) ); -! CHECKIERR( ierr, "cannot receive tag values on land on coupler" ) -! } -! POP_TIMER( MPI_COMM_WORLD, rankInGlobalComm ) -! -! // we can now free the sender buffers -! if( atmComm != MPI_COMM_NULL ) -! { -! ierr = iMOAB_FreeSenderBuffers( cmpPhAtmPID, &cpllnd ); -! CHECKIERR( ierr, "cannot free buffers used to resend atm tag towards the land on coupler" ) -! } - if (mphaid .ge. 0) then - ! we are on atm phys pes (atm pes) - tagname = 'T_ph;u_ph;v_ph'//CHAR(0) - ! context_id is the other comp id, in this case it has to be coupler on land, - context_id = lnd(1)%cplcompid - ierr = iMOAB_SendElementTag(mphaid, tagname, mpicom_join, context_id) ! it will fail if intx is not done - if (ierr .ne. 0) then - write(logunit,*) subname,' error in sending from phys atm to atm/land intx' - call shr_sys_abort(subname//' ERROR in sending from phys atm to atm/land intx') - endif - endif - - if (mblxid .ge. 0 ) then ! we are on coupler pes, for sure, on land - ! receive on land tag on coupler pes, in original migrate - ! receive from ATM PHYS, which in this case is 200 + 5 - ! - context_id = atm_id ! 5 for atm - ierr = iMOAB_ReceiveElementTag(mblxid, tagNameProj, mpicom_join, context_id) - if (ierr .ne. 0) then - write(logunit,*) subname,' error in receiving from phys atm to atm/land intx' - call shr_sys_abort(subname//' ERROR in receiving from phys atm to atm/land intx') - endif -#ifdef MOABDEBUG - ! - ! write out the lnd coupler mesh file to disk - write(lnum,"(I0.2)")num_proj - outfile = 'lndCplProj_PH'//trim(lnum)//'.h5m'//CHAR(0) - wopts = ';PARALLEL=WRITE_PART'//CHAR(0) ! - ierr = iMOAB_WriteMesh(mblxid, trim(outfile), trim(wopts)) - if (ierr .ne. 0) then - write(logunit,*) subname,' error writing land coupler' - call shr_sys_abort(subname//' ERROR in writing land coupler') - endif -#endif - endif - if (mphaid .ge. 0) then ! free buffers - context_id = lnd(1)%cplcompid - ierr = iMOAB_FreeSenderBuffers(mphaid, context_id) - if (ierr .ne. 0) then - write(logunit,*) subname,' error in freeing buffer ' - call shr_sys_abort(subname//' ERROR in freeing buffer') - endif - endif - endif ! endif for diff_atm_land, we are on same mesh land and satm, use direct send, no projection - endif - - - context_id = -1 ! this is the original migrate; we will use the context of atm-ocn intx: - ! idintx is a unique number of MOAB app that takes care of intx between ocn and atm mesh - ! idintx = 100*atm(1)%cplcompid + ocn(1)%cplcompid ! something different, to differentiate it; ~ 618 ! - if (mphaid .ge. 0) then - ! we are on atm phys pes (atm pes) - tagname = 'T_ph;u_ph;v_ph'//CHAR(0) - ! context_id is the other comp id, in this case it has to be 6, id_join - context_id = 100*atm(1)%cplcompid + ocn(1)%cplcompid - ierr = iMOAB_SendElementTag(mphaid, tagname, mpicom_join, context_id) ! it will fail if intx is not done - ! if intx is not done, context does not exist ! - endif - if (mbintxoa .ge. 0 ) then ! we are on coupler pes, for sure - ! receive on atm tag on coupler pes, in original migrate - ! receive from ATM PHYS, which in this case is 200 + 5 - tagname = 'T_ph16;u_ph16;v_ph16'//CHAR(0) - context_id = atm_id ! 5 for atm - ierr = iMOAB_ReceiveElementTag(mbintxoa, tagName, mpicom_join, context_id) - !CHECKRC(ierr, "cannot receive tag values") endif - ! we can now free the sender buffers - if (mphaid .ge. 0) then - ierr = iMOAB_FreeSenderBuffers(mphaid, context_id) - ! CHECKRC(ierr, "cannot free buffers used to phys atm tag towards the coupler atm spectral mesh") - endif - - - ! we could do the projection now, on the ocean mesh, because we are on the coupler pes; - ! the actual migrate could happen later , from coupler pes to the ocean pes - if (mbintxoa .ge. 0 ) then ! we are on coupler pes, for sure - ! we could apply weights; need to use the same weight identifier wgtIdef as when we generated it - ! hard coded now, it should be a runtime option in the future - tagname = 'T_ph16;u_ph16;v_ph16'//CHAR(0) - tagNameProj = 'a2oTbot_proj;a2oUbot_proj;a2oVbot_proj;'//CHAR(0) - wgtIdef = 'scalar'//CHAR(0) ! ocean ! - ierr = iMOAB_ApplyScalarProjectionWeights ( mbintxoa, wgtIdef, tagName, tagNameProj) -#ifdef MOABDEBUG - ! we can also write the ocean mesh to file, just to see the projectd tag - ! write out the mesh file to disk - write(lnum,"(I0.2)")num_proj - outfile = 'ocnCplProj2'//trim(lnum)//'.h5m'//CHAR(0) - wopts = ';PARALLEL=WRITE_PART'//CHAR(0) ! - ierr = iMOAB_WriteMesh(mboxid, trim(outfile), trim(wopts)) -#endif - - !CHECKRC(ierr, "cannot receive tag values") - endif +! context_id = -1 ! this is the original migrate; we will use the context of atm-ocn intx: +! ! idintx is a unique number of MOAB app that takes care of intx between ocn and atm mesh +! ! idintx = 100*atm(1)%cplcompid + ocn(1)%cplcompid ! something different, to differentiate it; ~ 618 ! +! if (mphaid .ge. 0) then +! ! we are on atm phys pes (atm pes) +! tagname = 'T_ph;u_ph;v_ph'//CHAR(0) +! ! context_id is the other comp id, in this case it has to be 6, id_join +! context_id = 100*atm(1)%cplcompid + ocn(1)%cplcompid +! ierr = iMOAB_SendElementTag(mphaid, tagname, mpicom_join, context_id) ! it will fail if intx is not done +! ! if intx is not done, context does not exist ! +! endif +! +! if (mbintxoa .ge. 0 ) then ! we are on coupler pes, for sure +! ! receive on atm tag on coupler pes, in original migrate +! ! receive from ATM PHYS, which in this case is 200 + 5 +! tagname = 'T_ph16;u_ph16;v_ph16'//CHAR(0) +! context_id = atm_id ! 5 for atm +! ierr = iMOAB_ReceiveElementTag(mbintxoa, tagName, mpicom_join, context_id) +! !CHECKRC(ierr, "cannot receive tag values") +! endif +! +! ! we can now free the sender buffers +! if (mphaid .ge. 0) then +! ierr = iMOAB_FreeSenderBuffers(mphaid, context_id) +! ! CHECKRC(ierr, "cannot free buffers used to phys atm tag towards the coupler atm spectral mesh") +! endif +! +! +! ! we could do the projection now, on the ocean mesh, because we are on the coupler pes; +! ! the actual migrate could happen later , from coupler pes to the ocean pes +! if (mbintxoa .ge. 0 ) then ! we are on coupler pes, for sure +! ! we could apply weights; need to use the same weight identifier wgtIdef as when we generated it +! ! hard coded now, it should be a runtime option in the future +! tagname = 'T_ph16;u_ph16;v_ph16'//CHAR(0) +! tagNameProj = 'a2oTbot_proj;a2oUbot_proj;a2oVbot_proj;'//CHAR(0) +! wgtIdef = 'scalar'//CHAR(0) ! ocean ! +! ierr = iMOAB_ApplyScalarProjectionWeights ( mbintxoa, wgtIdef, tagName, tagNameProj) +! +!#ifdef MOABDEBUG +! ! we can also write the ocean mesh to file, just to see the projectd tag +! ! write out the mesh file to disk +! write(lnum,"(I0.2)")num_proj +! outfile = 'ocnCplProj2'//trim(lnum)//'.h5m'//CHAR(0) +! wopts = ';PARALLEL=WRITE_PART'//CHAR(0) ! +! ierr = iMOAB_WriteMesh(mboxid, trim(outfile), trim(wopts)) +!#endif +! +! !CHECKRC(ierr, "cannot receive tag values") +! endif end subroutine prep_atm_migrate_moab From 07d78b7f50eddbc775dc2bb87bd13ab95939134a Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Thu, 31 Dec 2020 20:44:37 -0600 Subject: [PATCH 074/467] atm/lnd intx similar to atm/ocn similarity is that land is now a full mesh there is no more point cloud land [BFB] - Bit-For-Bit See confluence for a more detailed description about these tags. --- driver-moab/main/prep_atm_mod.F90 | 91 +++++++++++++------------------ 1 file changed, 37 insertions(+), 54 deletions(-) diff --git a/driver-moab/main/prep_atm_mod.F90 b/driver-moab/main/prep_atm_mod.F90 index 2eae0eacb235..54fed3f63a72 100644 --- a/driver-moab/main/prep_atm_mod.F90 +++ b/driver-moab/main/prep_atm_mod.F90 @@ -457,6 +457,7 @@ subroutine prep_atm_lnd_moab(infodata) integer :: mpigrp_CPLID ! coupler pes group, used for comm graph phys <-> atm-ocn integer :: mpigrp_old ! component group pes (phys grid atm) == atm group integer :: typeA, typeB ! type for computing graph; + integer :: idintx ! in this case, id of moab intersection between atm and lnd, on coupler pes integer, external :: iMOAB_CoverageGraph, iMOAB_ComputeScalarProjectionWeights, iMOAB_ComputeCommGraph @@ -516,7 +517,38 @@ subroutine prep_atm_lnd_moab(infodata) call shr_sys_abort(subname//' ERROR in computing weights atm land') endif endif - ! do not do comm graph anymore : we will compute as with intersection atm - ocn + ! as with ocn, data is sent from atm ph to the intx atm/lnd, not from pg2 mesh anymore + ! for that, we will use the comm graph between atm ph and atm pg2 intersected with land! + ! copy from ocn logic, just replace with land + ! compute the comm graph between phys atm and intx-atm-lnd, to be able to send directly from phys atm + ! towards coverage mesh on atm for intx to land / now that land is full mesh! + ! this is similar to imoab_phatm_ocn_coupler.cpp test in moab + ! int typeA = 2; // point cloud + call seq_comm_getinfo(CPLID ,mpigrp=mpigrp_CPLID) ! second group, the coupler group CPLID is global variable + call seq_comm_getinfo(atm_id, mpigrp=mpigrp_old) ! component group pes, from atm id ( also ATMID(1) ) + + typeA = 2 ! point cloud, phys atm in this case + ! idintx is a unique number of MOAB app that takes care of intx between ocn and atm mesh + idintx = 100*atm(1)%cplcompid + lnd(1)%cplcompid ! something different, to differentiate it; ~ 600+lnd ! + if (atm_pg_active) then + typeB = 3 ! fv on atm side too !! imoab_apg2_ol coupler example + ! atm cells involved in intersection (pg 2 in this case) + ! this will be used now to send + ! data from phys grid directly to atm-lnd intx , for later projection + ! context is the same, atm - lnd intx id ! + + else + typeB = 1 ! atm cells involved in intersection (spectral in this case) ! this will be used now to send + ! data from phys grid directly to atm-lnd intx , for later projection + ! context is the same, atm - lnd intx id ! + endif + ierr = iMOAB_ComputeCommGraph( mphaid, mbintxla, mpicom_join, mpigrp_old, mpigrp_CPLID, & + typeA, typeB, atm_id, idintx) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in computing graph phys grid - atm/lnd intx ' + call shr_sys_abort(subname//' ERROR in computing graph phys grid - atm/ocn intx ') + endif + ! end subroutine prep_atm_lnd_moab @@ -588,6 +620,8 @@ subroutine prep_atm_migrate_moab(infodata) if (mbintxoa .ge. 0 ) then ! we are for sure on coupler pes! tagName = 'T_ph16;u_ph16;v_ph16;'//CHAR(0) ! they are defined in cplcomp_exchange mod ! context_id = atm(1)%cplcompid == atm_id above (5) + ! we use the same name as spectral case, even thought in pg2 case, the size of tag is 1, not 16 + ! in imoab_apg2_ol_coupler.cpp we use at this stage, receiver, the same name as sender, T_ph ierr = iMOAB_ReceiveElementTag(mbintxoa, tagName, mpicom_join, atm_id) if (ierr .ne. 0) then write(logunit,*) subname,' error in receiving tag from phys atm to ocn atm intx ' @@ -597,7 +631,7 @@ subroutine prep_atm_migrate_moab(infodata) endif ! we can now free the sender buffers if (mhpgid .ge. 0) then - ierr = iMOAB_FreeSenderBuffers(mhpgid, context_id) + ierr = iMOAB_FreeSenderBuffers(mphaid, context_id) if (ierr .ne. 0) then write(logunit,*) subname,' error in freeing buffers' call shr_sys_abort(subname//' ERROR in freeing buffers') @@ -681,7 +715,7 @@ subroutine prep_atm_migrate_moab(infodata) ! as always, use nonblocking sends tagName = 'T_ph;u_ph;v_ph;'//CHAR(0) ! they are defined in initialize_moab_atm_phys in atm_comp_mct context_id = 100*atm(1)%cplcompid + lnd(1)%cplcompid !send to atm/lnd intx ! - + ! use computed graph ierr = iMOAB_SendElementTag(mphaid, tagName, mpicom_join, context_id) if (ierr .ne. 0) then write(logunit,*) subname,' error in sending tag from atm to atm land intx ' @@ -772,57 +806,6 @@ subroutine prep_atm_migrate_moab(infodata) endif - -! context_id = -1 ! this is the original migrate; we will use the context of atm-ocn intx: -! ! idintx is a unique number of MOAB app that takes care of intx between ocn and atm mesh -! ! idintx = 100*atm(1)%cplcompid + ocn(1)%cplcompid ! something different, to differentiate it; ~ 618 ! -! if (mphaid .ge. 0) then -! ! we are on atm phys pes (atm pes) -! tagname = 'T_ph;u_ph;v_ph'//CHAR(0) -! ! context_id is the other comp id, in this case it has to be 6, id_join -! context_id = 100*atm(1)%cplcompid + ocn(1)%cplcompid -! ierr = iMOAB_SendElementTag(mphaid, tagname, mpicom_join, context_id) ! it will fail if intx is not done -! ! if intx is not done, context does not exist ! -! endif -! -! if (mbintxoa .ge. 0 ) then ! we are on coupler pes, for sure -! ! receive on atm tag on coupler pes, in original migrate -! ! receive from ATM PHYS, which in this case is 200 + 5 -! tagname = 'T_ph16;u_ph16;v_ph16'//CHAR(0) -! context_id = atm_id ! 5 for atm -! ierr = iMOAB_ReceiveElementTag(mbintxoa, tagName, mpicom_join, context_id) -! !CHECKRC(ierr, "cannot receive tag values") -! endif -! -! ! we can now free the sender buffers -! if (mphaid .ge. 0) then -! ierr = iMOAB_FreeSenderBuffers(mphaid, context_id) -! ! CHECKRC(ierr, "cannot free buffers used to phys atm tag towards the coupler atm spectral mesh") -! endif -! -! -! ! we could do the projection now, on the ocean mesh, because we are on the coupler pes; -! ! the actual migrate could happen later , from coupler pes to the ocean pes -! if (mbintxoa .ge. 0 ) then ! we are on coupler pes, for sure -! ! we could apply weights; need to use the same weight identifier wgtIdef as when we generated it -! ! hard coded now, it should be a runtime option in the future -! tagname = 'T_ph16;u_ph16;v_ph16'//CHAR(0) -! tagNameProj = 'a2oTbot_proj;a2oUbot_proj;a2oVbot_proj;'//CHAR(0) -! wgtIdef = 'scalar'//CHAR(0) ! ocean ! -! ierr = iMOAB_ApplyScalarProjectionWeights ( mbintxoa, wgtIdef, tagName, tagNameProj) -! -!#ifdef MOABDEBUG -! ! we can also write the ocean mesh to file, just to see the projectd tag -! ! write out the mesh file to disk -! write(lnum,"(I0.2)")num_proj -! outfile = 'ocnCplProj2'//trim(lnum)//'.h5m'//CHAR(0) -! wopts = ';PARALLEL=WRITE_PART'//CHAR(0) ! -! ierr = iMOAB_WriteMesh(mboxid, trim(outfile), trim(wopts)) -!#endif -! -! !CHECKRC(ierr, "cannot receive tag values") -! endif - end subroutine prep_atm_migrate_moab !================================================================================================ From ceb92f339c104affa3c8cbda3092bcc089181356 Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Fri, 1 Jan 2021 23:58:24 -0600 Subject: [PATCH 075/467] define tag name proj correctly [BFB] - Bit-For-Bit --- driver-moab/main/prep_atm_mod.F90 | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/driver-moab/main/prep_atm_mod.F90 b/driver-moab/main/prep_atm_mod.F90 index 54fed3f63a72..bcf64019aab5 100644 --- a/driver-moab/main/prep_atm_mod.F90 +++ b/driver-moab/main/prep_atm_mod.F90 @@ -597,6 +597,7 @@ subroutine prep_atm_migrate_moab(infodata) context_id = ocn(1)%cplcompid wgtIdef = 'scalar'//CHAR(0) + tagNameProj = 'a2oTbot_proj;a2oUbot_proj;a2oVbot_proj;'//CHAR(0) num_proj = num_proj + 1 if (atm_present .and. ocn_present) then @@ -640,7 +641,7 @@ subroutine prep_atm_migrate_moab(infodata) else ! original send from spectral elements tagName = 'a2oTbot;a2oUbot;a2oVbot;'//CHAR(0) ! they are defined in semoab_mod.F90!!! ! the separator will be ';' semicolon - tagNameProj = 'a2oTbot_proj;a2oUbot_proj;a2oVbot_proj;'//CHAR(0) + if (mhid .ge. 0) then ! send because we are on atm pes ! basically, adjust the migration of the tag we want to project; it was sent initially with @@ -678,6 +679,7 @@ subroutine prep_atm_migrate_moab(infodata) if (mbintxoa .ge. 0 ) then ! we are on coupler pes, for sure ! we could apply weights; need to use the same weight identifier wgtIdef as when we generated it ! hard coded now, it should be a runtime option in the future + ierr = iMOAB_ApplyScalarProjectionWeights ( mbintxoa, wgtIdef, tagName, tagNameProj) if (ierr .ne. 0) then write(logunit,*) subname,' error in applying weights ' From d6958d6eadcfe19c83554bac697b8ea0c146a952 Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Tue, 5 Jan 2021 15:32:32 -0600 Subject: [PATCH 076/467] rename variables for clarification --- driver-moab/main/cplcomp_exchange_mod.F90 | 18 +++++++++++------- driver-moab/main/prep_atm_mod.F90 | 2 +- 2 files changed, 12 insertions(+), 8 deletions(-) diff --git a/driver-moab/main/cplcomp_exchange_mod.F90 b/driver-moab/main/cplcomp_exchange_mod.F90 index 73ef310b0ab7..21be65885012 100644 --- a/driver-moab/main/cplcomp_exchange_mod.F90 +++ b/driver-moab/main/cplcomp_exchange_mod.F90 @@ -1077,7 +1077,11 @@ subroutine cplcomp_moab_Init(comp) endif #ifdef MOABDEBUG ! debug test - outfile = 'recMeshAtm.h5m'//CHAR(0) + if (atm_pg_active) then ! + outfile = 'recMeshAtmPG.h5m'//CHAR(0) + else + outfile = 'recMeshAtm.h5m'//CHAR(0) + endif wopts = ';PARALLEL=WRITE_PART'//CHAR(0) ! write out the mesh file to disk ierr = iMOAB_WriteMesh(mbaxid, trim(outfile), trim(wopts)) @@ -1123,19 +1127,19 @@ subroutine cplcomp_moab_Init(comp) ! we can receive those tags only on coupler pes, when mbaxid exists ! we have to check that before we can define the tag if (mbaxid .ge. 0 ) then - tagnameProj = 'T_ph16'//CHAR(0) + tagname = 'T_ph16'//CHAR(0) tagtype = 1 ! dense, double if (atm_pg_active) then numco = 1 ! just one value per cell ! else numco = np*np ! usually 16 values per cell, GLL points; should be 4 x 4 = 16 endif - ierr = iMOAB_DefineTagStorage(mbaxid, tagnameProj, tagtype, numco, tagindex ) + ierr = iMOAB_DefineTagStorage(mbaxid, tagname, tagtype, numco, tagindex ) ! define more tags - tagnameProj = 'u_ph16'//CHAR(0) ! U component of velocity - ierr = iMOAB_DefineTagStorage(mbaxid, tagnameProj, tagtype, numco, tagindex ) - tagnameProj = 'v_ph16'//CHAR(0) ! V component of velocity - ierr = iMOAB_DefineTagStorage(mbaxid, tagnameProj, tagtype, numco, tagindex ) + tagname = 'u_ph16'//CHAR(0) ! U component of velocity + ierr = iMOAB_DefineTagStorage(mbaxid, tagname, tagtype, numco, tagindex ) + tagname = 'v_ph16'//CHAR(0) ! V component of velocity + ierr = iMOAB_DefineTagStorage(mbaxid, tagname, tagtype, numco, tagindex ) if (ierr .ne. 0) then write(logunit,*) subname,' error in defining tags ' call shr_sys_abort(subname//' ERROR in defining tags ') diff --git a/driver-moab/main/prep_atm_mod.F90 b/driver-moab/main/prep_atm_mod.F90 index bcf64019aab5..188935c406f1 100644 --- a/driver-moab/main/prep_atm_mod.F90 +++ b/driver-moab/main/prep_atm_mod.F90 @@ -603,7 +603,7 @@ subroutine prep_atm_migrate_moab(infodata) if (atm_present .and. ocn_present) then if (atm_pg_active ) then ! use data from AtmPhys mesh, but mesh from pg ! in this case, we will send from phys grid directly to intx atm ocn context! - if (mhpgid .ge. 0) then ! send because we are on atm pes, + if (mphaid .ge. 0) then ! send because we are on atm pes, also mphaid >= 0 ! basically, adjust the migration of the tag we want to project; it was sent initially with ! trivial partitioning, now we need to adjust it for "coverage" mesh From 4c22b904978be360a28b38493a00a8e2225b25bf Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Wed, 6 Jan 2021 12:12:52 -0600 Subject: [PATCH 077/467] replace MergeVertices iMOAB_MergeVertices affects even ocean projection. temporarily, use full vertices, unmerged, for land mesh. need to set a global ID for the vertices too, otherwise migration does not work properly --- components/elm/src/cpl/lnd_comp_mct.F90 | 21 ++++++++++++++++++--- 1 file changed, 18 insertions(+), 3 deletions(-) diff --git a/components/elm/src/cpl/lnd_comp_mct.F90 b/components/elm/src/cpl/lnd_comp_mct.F90 index 68649c890d03..463186b60fd2 100644 --- a/components/elm/src/cpl/lnd_comp_mct.F90 +++ b/components/elm/src/cpl/lnd_comp_mct.F90 @@ -771,7 +771,7 @@ subroutine init_land_moab(bounds) integer n integer , external :: iMOAB_CreateVertices, iMOAB_WriteMesh, & iMOAB_DefineTagStorage, iMOAB_SetIntTagStorage, iMOAB_SetDoubleTagStorage, & - iMOAB_ResolveSharedEntities, iMOAB_CreateElements, iMOAB_MergeVertices + iMOAB_ResolveSharedEntities, iMOAB_CreateElements, iMOAB_MergeVertices, iMOAB_UpdateMeshInfo ! local variables to fill in data integer, dimension(:), allocatable :: vgids ! retrieve everything we need from land domain mct_ldom @@ -884,9 +884,24 @@ subroutine init_land_moab(bounds) deallocate(moabconn) ! use merge vertices new imoab method to fix cells - ierr = iMOAB_MergeVertices(mlnid) + deallocate(vgids) ! use it for global ids, for elements in full mesh or vertices in point cloud + allocate(vgids(lsz*ldomain%nv)) ! + do n = 1, lsz + do i=1,ldomain%nv + vgids( (n-1)*ldomain%nv+i ) = (ldecomp%gdc2glo(bounds%begg+n-1)-1)*ldomain%nv+i ! local to global ! + end do + end do + ent_type = 0 ! vertices now + tagname = 'GLOBAL_ID'//CHAR(0) + ierr = iMOAB_SetIntTagStorage ( mlnid, tagname, lsz , ent_type, vgids ) if (ierr > 0 ) & - call endrun('Error: fail to fix vertices in land mesh ') + call endrun('Error: fail to set global ID tag on vertices in land mesh ') + ierr = iMOAB_UpdateMeshInfo( mlnid ) + if (ierr > 0 ) & + call endrun('Error: fail to update mesh info ') + !ierr = iMOAB_MergeVertices(mlnid) + !if (ierr > 0 ) & + ! call endrun('Error: fail to fix vertices in land mesh ') else ! old point cloud mesh allocate(moab_vert_coords(lsz*dims)) From 17ea9bf0e9775d8a32d22a11e61d436ce53789b4 Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Wed, 27 Jan 2021 20:09:23 -0600 Subject: [PATCH 078/467] allow tri-grid and original land derived from atm it is basically decided by the samegrid_al logical flag it turns false if trim(atm_gnam) /= trim(lnd_gnam) sameg_al = samegrid_al is set in init_land_moab, and it is a global variable exported from seq_comm_mct (this is where we keep all global moab variables) we basically use the old code if sameg_al is true, and use tri-grid when sameg_al is false; there are many cases now, due to pg2 and sameg_al supported at the same time [BFB] - Bit-For-Bit --- components/elm/src/cpl/lnd_comp_mct.F90 | 19 +- driver-moab/main/cplcomp_exchange_mod.F90 | 14 ++ driver-moab/main/prep_atm_mod.F90 | 289 ++++++++++++++-------- 3 files changed, 213 insertions(+), 109 deletions(-) diff --git a/components/elm/src/cpl/lnd_comp_mct.F90 b/components/elm/src/cpl/lnd_comp_mct.F90 index 463186b60fd2..9fd376776ef0 100644 --- a/components/elm/src/cpl/lnd_comp_mct.F90 +++ b/components/elm/src/cpl/lnd_comp_mct.F90 @@ -127,6 +127,9 @@ subroutine lnd_init_mct( EClock, cdata_l, x2l_l, l2x_l, NLFilename ) integer, external :: iMOAB_RegisterFortranApplication integer :: ierr character*32 appname + logical :: samegrid_al ! + character(len=SHR_KIND_CL) :: atm_gnam ! atm grid + character(len=SHR_KIND_CL) :: lnd_gnam ! lnd grid ! debugIuli integer :: debugGSMapFile, n #endif @@ -305,7 +308,13 @@ subroutine lnd_init_mct( EClock, cdata_l, x2l_l, l2x_l, NLFilename ) call lnd_domain_mct( bounds, lsz, gsMap_lnd, dom_l ) #ifdef HAVE_MOAB - call init_land_moab(bounds) +! find out samegrid_al or not; from infodata + samegrid_al = .true. + call seq_infodata_GetData(infodata , & + atm_gnam=atm_gnam , & + lnd_gnam=lnd_gnam ) + if (trim(atm_gnam) /= trim(lnd_gnam)) samegrid_al = .false. + call init_land_moab(bounds, samegrid_al) #endif call mct_aVect_init(x2l_l, rList=seq_flds_x2l_fields, lsize=lsz) call mct_aVect_zero(x2l_l) @@ -756,14 +765,16 @@ subroutine lnd_domain_mct( bounds, lsz, gsMap_l, dom_l ) end subroutine lnd_domain_mct #ifdef HAVE_MOAB - subroutine init_land_moab(bounds) + subroutine init_land_moab(bounds, samegrid_al) use seq_comm_mct, only: mlnid ! id of moab land app + use seq_comm_mct, only: sameg_al ! same grid as atm use spmdMod , only: iam ! rank on the land communicator use domainMod , only: ldomain ! ldomain is coming from module, not even passed use clm_varcon , only: re use shr_const_mod, only: SHR_CONST_PI type(bounds_type) , intent(in) :: bounds + logical :: samegrid_al integer,allocatable :: gindex(:) ! Number the local grid points; used for global ID integer lsz ! keep local size @@ -785,7 +796,7 @@ subroutine init_land_moab(bounds) integer, allocatable :: moabconn(:) ! will have the connectivity in terms of local index in verts dims =3 ! store as 3d mesh - + sameg_al = samegrid_al ! use a different name, but they do mean the same thing ! number the local grid lsz = bounds%endg - bounds%begg + 1 @@ -796,7 +807,7 @@ subroutine init_land_moab(bounds) end do gsize = ldomain%ni * ldomain%nj ! size of the total grid ! if ldomain%nv > 3 , create mesh - if (ldomain%nv .ge. 3 ) then + if (ldomain%nv .ge. 3 .and. .not.sameg_al) then ! number of vertices is nv * lsz ! allocate(moab_vert_coords(lsz*dims*ldomain%nv)) ! loop over ldomain diff --git a/driver-moab/main/cplcomp_exchange_mod.F90 b/driver-moab/main/cplcomp_exchange_mod.F90 index 21be65885012..be69df853521 100644 --- a/driver-moab/main/cplcomp_exchange_mod.F90 +++ b/driver-moab/main/cplcomp_exchange_mod.F90 @@ -18,6 +18,7 @@ module cplcomp_exchange_mod use seq_comm_mct, only : atm_pg_active ! flag if PG mesh instanced use seq_comm_mct, only : mlnid , mblxid ! iMOAB app id for land , on land pes and coupler pes use seq_comm_mct, only : mphaid ! iMOAB app id for phys atm; comp atm is 5, phys 5+200 + use seq_comm_mct, only : sameg_al ! same grid atm lnd, and land is point cloud use shr_mpi_mod, only: shr_mpi_max use dimensions_mod, only : np ! for atmosphere @@ -1276,6 +1277,19 @@ subroutine cplcomp_moab_Init(comp) endif #ifdef MOABDEBUG ! debug test + if (sameg_al) then + !there are no shared entities, but we will set a special partition tag, in order to see the + ! partitions ; it will be visible with a Pseudocolor plot in VisIt + tagname='partition'//CHAR(0) + tagtype = 0 ! dense, integer + numco = 1 ! one value per cell + ierr = iMOAB_DefineTagStorage(mblxid, tagname, tagtype, numco, tagindex ) + ierr = iMOAB_GetMeshInfo(mblxid, nverts, nelem, nblocks, nsbc, ndbc) + allocate(vgids(nverts(1))) + vgids = rank + ent_type = 0 ! vertex type + ierr = iMOAB_SetIntTagStorage ( mblxid, tagname, nverts(1) , ent_type, vgids) + endif outfile = 'recLand.h5m'//CHAR(0) wopts = ';PARALLEL=WRITE_PART'//CHAR(0) ! ! write out the mesh file to disk diff --git a/driver-moab/main/prep_atm_mod.F90 b/driver-moab/main/prep_atm_mod.F90 index 188935c406f1..30ba7795ba21 100644 --- a/driver-moab/main/prep_atm_mod.F90 +++ b/driver-moab/main/prep_atm_mod.F90 @@ -27,6 +27,7 @@ module prep_atm_mod use seq_comm_mct, only : atm_pg_active ! whether the atm uses FV mesh or not ; made true if fv_nphys > 0 use seq_comm_mct, only : mblxid ! iMOAB id for land migrated to coupler pes !! old name : mlnxid use seq_comm_mct, only : mbintxla ! iMOAB id for intx mesh between land and atmosphere + use seq_comm_mct, only : sameg_al ! true by default, so land and atm on same mesh use seq_comm_mct, only : seq_comm_getinfo => seq_comm_setptrs use dimensions_mod, only : np ! for atmosphere @@ -127,7 +128,7 @@ subroutine prep_atm_init(infodata, ocn_c2_atm, ice_c2_atm, lnd_c2_atm, iac_c2_at character(*), parameter :: subname = '(prep_atm_init)' character(*), parameter :: F00 = "('"//subname//" : ', 4A )" integer, external :: iMOAB_ComputeMeshIntersectionOnSphere, iMOAB_RegisterFortranApplication, & - iMOAB_WriteMesh ! , iMOAB_ComputePointDoFIntersection ; not needed anymore: + iMOAB_WriteMesh, iMOAB_ComputePointDoFIntersection ! use computedofintx if land is point cloud integer ierr, idintx, rank character*32 :: appname, outfile, wopts, lnum !--------------------------------------------------------------- @@ -284,25 +285,30 @@ subroutine prep_atm_init(infodata, ocn_c2_atm, ice_c2_atm, lnd_c2_atm, iac_c2_at write(logunit,*) subname,' error in registering atm lnd intx ' call shr_sys_abort(subname//' ERROR in registering atm lnd intx ') endif -! ierr = iMOAB_ComputePointDoFIntersection (mbaxid, mblxid, mbintxla) - ierr = iMOAB_ComputeMeshIntersectionOnSphere (mbaxid, mblxid, mbintxla) + if (sameg_al) then + ierr = iMOAB_ComputePointDoFIntersection (mbaxid, mblxid, mbintxla) + else + ierr = iMOAB_ComputeMeshIntersectionOnSphere (mbaxid, mblxid, mbintxla) + endif if (ierr .ne. 0) then write(logunit,*) subname,' error in computing atm lnd intx' call shr_sys_abort(subname//' ERROR in computing atm lnd intx') endif #ifdef MOABDEBUG - wopts = CHAR(0) - call shr_mpi_commrank( mpicom_CPLID, rank ) - if (rank .lt. 5) then - write(lnum,"(I0.2)")rank ! - outfile = 'intx_la'//trim(lnum)// '.h5m' // CHAR(0) - ierr = iMOAB_WriteMesh(mbintxla, outfile, wopts) ! write local intx file - if (ierr .ne. 0) then - write(logunit,*) subname,' error in writing intx file land atm ' - call shr_sys_abort(subname//' ERROR in writing intx file ') + ! write intx only if true intx file: + if (.not. sameg_al) then + wopts = CHAR(0) + call shr_mpi_commrank( mpicom_CPLID, rank ) + if (rank .lt. 5) then ! write only a few intx files + write(lnum,"(I0.2)")rank ! + outfile = 'intx_la'//trim(lnum)// '.h5m' // CHAR(0) + ierr = iMOAB_WriteMesh(mbintxla, outfile, wopts) ! write local intx file + if (ierr .ne. 0) then + write(logunit,*) subname,' error in writing intx file land atm ' + call shr_sys_abort(subname//' ERROR in writing intx file ') + endif endif - endif - num_proj = 0 ! to index projection files on coupler pes + endif ! if tri-grid #endif endif end if @@ -437,7 +443,7 @@ subroutine prep_atm_lnd_moab(infodata) ! If the land is on the same mesh as atm, we do not need to compute intx ! Just use compute graph between phys atm and lnd on coupler, to be able to send ! data from atm phys to atm on coupler for projection on land - ! in the trigrid case, atm and land use different meshes, so use coverage anyway + ! in the tri-grid case, atm and land use different meshes, so use coverage anyway ! ! Arguments type(seq_infodata_type) , intent(in) :: infodata @@ -458,6 +464,7 @@ subroutine prep_atm_lnd_moab(infodata) integer :: mpigrp_old ! component group pes (phys grid atm) == atm group integer :: typeA, typeB ! type for computing graph; integer :: idintx ! in this case, id of moab intersection between atm and lnd, on coupler pes + ! used only for tri-grid case integer, external :: iMOAB_CoverageGraph, iMOAB_ComputeScalarProjectionWeights, iMOAB_ComputeCommGraph @@ -501,9 +508,18 @@ subroutine prep_atm_lnd_moab(infodata) orderATM = np ! it should be 4 volumetric = 0 endif - dm2 = "fv"//CHAR(0) + dofnameLND="GLOBAL_ID"//CHAR(0) orderLND = 1 ! not much arguing + ! is the land mesh explicit or point cloud ? based on sameg_al flag: + if (sameg_al) then + dm2 = "pcloud"//CHAR(0) + wgtIdef = 'scalar-pc'//CHAR(0) + volumetric = 0 ! TODO: check this , for PC ; for imoab_coupler test, volumetric is 0 + else + dm2 = "fv"//CHAR(0) ! land is FV + volumetric = 1 + endif monotonicity = 0 ! noConserve = 0 validate = 1 @@ -517,43 +533,45 @@ subroutine prep_atm_lnd_moab(infodata) call shr_sys_abort(subname//' ERROR in computing weights atm land') endif endif - ! as with ocn, data is sent from atm ph to the intx atm/lnd, not from pg2 mesh anymore - ! for that, we will use the comm graph between atm ph and atm pg2 intersected with land! - ! copy from ocn logic, just replace with land - ! compute the comm graph between phys atm and intx-atm-lnd, to be able to send directly from phys atm - ! towards coverage mesh on atm for intx to land / now that land is full mesh! - ! this is similar to imoab_phatm_ocn_coupler.cpp test in moab - ! int typeA = 2; // point cloud - call seq_comm_getinfo(CPLID ,mpigrp=mpigrp_CPLID) ! second group, the coupler group CPLID is global variable - call seq_comm_getinfo(atm_id, mpigrp=mpigrp_old) ! component group pes, from atm id ( also ATMID(1) ) - - typeA = 2 ! point cloud, phys atm in this case - ! idintx is a unique number of MOAB app that takes care of intx between ocn and atm mesh - idintx = 100*atm(1)%cplcompid + lnd(1)%cplcompid ! something different, to differentiate it; ~ 600+lnd ! - if (atm_pg_active) then - typeB = 3 ! fv on atm side too !! imoab_apg2_ol coupler example - ! atm cells involved in intersection (pg 2 in this case) - ! this will be used now to send - ! data from phys grid directly to atm-lnd intx , for later projection - ! context is the same, atm - lnd intx id ! + ! we will use intx atm-lnd mesh only when land is explicit + if (.not. sameg_al) then + ! as with ocn, data is sent from atm ph to the intx atm/lnd, not from pg2 mesh anymore + ! for that, we will use the comm graph between atm ph and atm pg2 intersected with land! + ! copy from ocn logic, just replace with land + ! compute the comm graph between phys atm and intx-atm-lnd, to be able to send directly from phys atm + ! towards coverage mesh on atm for intx to land / now that land is full mesh! + ! this is similar to imoab_phatm_ocn_coupler.cpp test in moab + ! int typeA = 2; // point cloud + call seq_comm_getinfo(CPLID ,mpigrp=mpigrp_CPLID) ! second group, the coupler group CPLID is global variable + call seq_comm_getinfo(atm_id, mpigrp=mpigrp_old) ! component group pes, from atm id ( also ATMID(1) ) + + typeA = 2 ! point cloud, phys atm in this case + ! idintx is a unique number of MOAB app that takes care of intx between lnd and atm mesh + idintx = 100*atm(1)%cplcompid + lnd(1)%cplcompid ! something different, to differentiate it; ~ 600+lnd ! + if (atm_pg_active) then + typeB = 3 ! fv on atm side too !! imoab_apg2_ol coupler example + ! atm cells involved in intersection (pg 2 in this case) + ! this will be used now to send + ! data from phys grid directly to atm-lnd intx , for later projection + ! context is the same, atm - lnd intx id ! - else - typeB = 1 ! atm cells involved in intersection (spectral in this case) ! this will be used now to send - ! data from phys grid directly to atm-lnd intx , for later projection - ! context is the same, atm - lnd intx id ! - endif - ierr = iMOAB_ComputeCommGraph( mphaid, mbintxla, mpicom_join, mpigrp_old, mpigrp_CPLID, & - typeA, typeB, atm_id, idintx) - if (ierr .ne. 0) then - write(logunit,*) subname,' error in computing graph phys grid - atm/lnd intx ' - call shr_sys_abort(subname//' ERROR in computing graph phys grid - atm/ocn intx ') - endif - ! + else + typeB = 1 ! atm cells involved in intersection (spectral in this case) ! this will be used now to send + ! data from phys grid directly to atm-lnd intx , for later projection + ! context is the same, atm - lnd intx id ! + endif + ierr = iMOAB_ComputeCommGraph( mphaid, mbintxla, mpicom_join, mpigrp_old, mpigrp_CPLID, & + typeA, typeB, atm_id, idintx) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in computing graph phys grid - atm/lnd intx ' + call shr_sys_abort(subname//' ERROR in computing graph phys grid - atm/ocn intx ') + endif + endif ! if (.not. sameg_al) end subroutine prep_atm_lnd_moab subroutine prep_atm_migrate_moab(infodata) - !--------------------------------------------------------------- + !--------------------------------------------------------------- ! Description ! After a2oTbot, a2oUbot, a2oVbot tags were loaded on atm mesh, ! they need to be migrated to the coupler pes, for weight application later @@ -580,20 +598,20 @@ subroutine prep_atm_migrate_moab(infodata) integer, external :: iMOAB_ApplyScalarProjectionWeights, iMOAB_WriteMesh call seq_infodata_getData(infodata, & - atm_present=atm_present, & - ocn_present=ocn_present, & - lnd_present=lnd_present) + atm_present=atm_present, & + ocn_present=ocn_present, & + lnd_present=lnd_present) - ! it involves initial atm app; mhid; also migrate atm mesh on coupler pes, mbaxid - ! intx ocean atm are in mbintxoa ; remapper also has some info about coverage mesh - ! after this, the sending of tags from atm pes to coupler pes will use the new par comm graph, that has more precise info about - ! how to get mpicomm for joint atm + coupler + ! it involves initial atm app; mhid; also migrate atm mesh on coupler pes, mbaxid + ! intx ocean atm are in mbintxoa ; remapper also has some info about coverage mesh + ! after this, the sending of tags from atm pes to coupler pes will use the new par comm graph, that has more precise info about + ! how to get mpicomm for joint atm + coupler id_join = atm(1)%cplcompid atm_id = atm(1)%compid call seq_comm_getinfo(ID_join,mpicom=mpicom_join) -! we should do this only of ocn_present + ! we should do this only if ocn_present context_id = ocn(1)%cplcompid wgtIdef = 'scalar'//CHAR(0) @@ -701,50 +719,52 @@ subroutine prep_atm_migrate_moab(infodata) !CHECKRC(ierr, "cannot receive tag values") endif - endif -! repeat this for land data, that is already on atm tag + endif ! if atm and ocn + ! repeat this for land data, that is already on atm tag tagNameProj = 'a2lTbot_proj;a2lUbot_proj;a2lVbot_proj;'//CHAR(0) context_id = lnd(1)%cplcompid - wgtIdef = 'scalar'//CHAR(0) ! from fv, need to be similar to ocean now + if (atm_present .and. lnd_present) then + wgtIdef = 'scalar'//CHAR(0) ! from fv, need to be similar to ocean now + if (.not. sameg_al) then ! tri-grid case if (atm_pg_active ) then ! use mhpgid mesh - if (mhpgid .ge. 0) then ! send because we are on atm pes + if (mhpgid .ge. 0) then ! send because we are on atm pes ! basically, adjust the migration of the tag we want to project; it was sent initially with ! original partitioning, now we need to adjust it for "coverage" mesh ! as always, use nonblocking sends - tagName = 'T_ph;u_ph;v_ph;'//CHAR(0) ! they are defined in initialize_moab_atm_phys in atm_comp_mct - context_id = 100*atm(1)%cplcompid + lnd(1)%cplcompid !send to atm/lnd intx ! - ! use computed graph - ierr = iMOAB_SendElementTag(mphaid, tagName, mpicom_join, context_id) - if (ierr .ne. 0) then - write(logunit,*) subname,' error in sending tag from atm to atm land intx ' - call shr_sys_abort(subname//' ERROR in sending tag from atm to atm land intx') - endif + tagName = 'T_ph;u_ph;v_ph;'//CHAR(0) ! they are defined in initialize_moab_atm_phys in atm_comp_mct + context_id = 100*atm(1)%cplcompid + lnd(1)%cplcompid !send to atm/lnd intx ! + ! use computed graph + ierr = iMOAB_SendElementTag(mphaid, tagName, mpicom_join, context_id) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in sending tag from atm to atm land intx ' + call shr_sys_abort(subname//' ERROR in sending tag from atm to atm land intx') + endif endif if (mbaxid .ge. 0 ) then ! we are on coupler pes, for sure ! receive on atm on coupler pes, that was redistributed according to coverage - tagName = 'T_ph;u_ph;v_ph;'//CHAR(0) ! they are defined in initialize_moab_atm_phys - ierr = iMOAB_ReceiveElementTag(mbintxla, tagName, mpicom_join, atm_id) - if (ierr .ne. 0) then - write(logunit,*) subname,' error in receiving tag from atm to atm land intx ' - call shr_sys_abort(subname//' ERROR in receiving tag from atm to atm land intx') - endif + tagName = 'T_ph;u_ph;v_ph;'//CHAR(0) ! they are defined in initialize_moab_atm_phys + ierr = iMOAB_ReceiveElementTag(mbintxla, tagName, mpicom_join, atm_id) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in receiving tag from atm to atm land intx ' + call shr_sys_abort(subname//' ERROR in receiving tag from atm to atm land intx') + endif endif ! we can now free the sender buffers if (mhpgid .ge. 0) then - context_id = 100*atm(1)%cplcompid + lnd(1)%cplcompid !send to atm/lnd intx ! - ierr = iMOAB_FreeSenderBuffers(mphaid, context_id) - if (ierr .ne. 0) then - write(logunit,*) subname,' error in freeing buffer ' - call shr_sys_abort(subname//' ERROR in freeing buffer') - endif + context_id = 100*atm(1)%cplcompid + lnd(1)%cplcompid !send to atm/lnd intx ! + ierr = iMOAB_FreeSenderBuffers(mphaid, context_id) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in freeing buffer ' + call shr_sys_abort(subname//' ERROR in freeing buffer') + endif endif - else ! regular coarse homme mesh + else ! regular coarse homme mesh if (.not. atm_pg_active) tagName = 'a2oTbot;a2oUbot;a2oVbot;'//CHAR(0) ! context_id = lnd(1)%cplcompid ! if (mhid .ge. 0) then ! send because we are on atm pes @@ -753,29 +773,29 @@ subroutine prep_atm_migrate_moab(infodata) ! original partitioning, now we need to adjust it for "coverage" mesh ! as always, use nonblocking sends - ierr = iMOAB_SendElementTag(mhid, tagName, mpicom_join, context_id) - if (ierr .ne. 0) then - write(logunit,*) subname,' error in sending tag from atm spectral to atm/lnd intx ' - call shr_sys_abort(subname//' ERROR in sending tag from atm spectral to atm/lnd intx ') - endif + ierr = iMOAB_SendElementTag(mhid, tagName, mpicom_join, context_id) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in sending tag from atm spectral to atm/lnd intx ' + call shr_sys_abort(subname//' ERROR in sending tag from atm spectral to atm/lnd intx ') + endif endif if (mbaxid .ge. 0 ) then ! we are on coupler pes, for sure ! receive on atm on coupler pes, that was redistributed according to coverage - ierr = iMOAB_ReceiveElementTag(mbaxid, tagName, mpicom_join, context_id) - if (ierr .ne. 0) then - write(logunit,*) subname,' error in receiving tag from atm spectral to atm/lnd intx ' - call shr_sys_abort(subname//' ERROR in receiving tag from atm spectral to atm/lnd intx ') - endif + ierr = iMOAB_ReceiveElementTag(mbaxid, tagName, mpicom_join, context_id) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in receiving tag from atm spectral to atm/lnd intx ' + call shr_sys_abort(subname//' ERROR in receiving tag from atm spectral to atm/lnd intx ') + endif endif ! we can now free the sender buffers if (mhid .ge. 0) then - ierr = iMOAB_FreeSenderBuffers(mhid, context_id) - if (ierr .ne. 0) then - write(logunit,*) subname,' error in freeing buffer ' - call shr_sys_abort(subname//' ERROR in freeing buffer') - endif + ierr = iMOAB_FreeSenderBuffers(mhid, context_id) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in freeing buffer ' + call shr_sys_abort(subname//' ERROR in freeing buffer') + endif endif endif @@ -793,20 +813,79 @@ subroutine prep_atm_migrate_moab(infodata) #ifdef MOABDEBUG ! we can also write the ocean mesh to file, just to see the projectd tag ! write out the mesh file to disk - write(lnum,"(I0.2)")num_proj - outfile = 'lndCplProj'//trim(lnum)//'.h5m'//CHAR(0) - wopts = ';PARALLEL=WRITE_PART'//CHAR(0) ! - ierr = iMOAB_WriteMesh(mblxid, trim(outfile), trim(wopts)) - if (ierr .ne. 0) then - write(logunit,*) subname,' error in writing mesh on coupler land' - call shr_sys_abort(subname//' ERROR in writing mesh on coupler land') - endif + write(lnum,"(I0.2)")num_proj + outfile = 'lndCplProj'//trim(lnum)//'.h5m'//CHAR(0) + wopts = ';PARALLEL=WRITE_PART'//CHAR(0) ! + ierr = iMOAB_WriteMesh(mblxid, trim(outfile), trim(wopts)) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in writing mesh on coupler land' + call shr_sys_abort(subname//' ERROR in writing mesh on coupler land') + endif #endif !CHECKRC(ierr, "cannot receive tag values") endif + else ! sameg_al, original lnd from atm grid - endif + if (mhid .ge. 0) then ! send because we are on atm pes + + ! basically, adjust the migration of the tag we want to project; it was sent initially with + ! original partitioning, now we need to adjust it for "coverage" mesh + ! as always, use nonblocking sends + + ierr = iMOAB_SendElementTag(mhid, tagName, mpicom_join, context_id) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in sending tag for land projection' + call shr_sys_abort(subname//' ERROR in sending tag for land projection') + endif + endif + if (mbaxid .ge. 0 ) then ! we are on coupler pes, for sure + ! receive on atm on coupler pes, that was redistributed according to coverage + ierr = iMOAB_ReceiveElementTag(mbaxid, tagName, mpicom_join, context_id) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in receiving tag for land projection' + call shr_sys_abort(subname//' ERROR in receiving tag for land projection') + endif + endif + + ! we can now free the sender buffers + if (mhid .ge. 0) then + ierr = iMOAB_FreeSenderBuffers(mhid, context_id) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in freeing buffers' + call shr_sys_abort(subname//' ERROR in freeing buffers') + endif + endif + + ! we could do the projection now, on the land mesh, because we are on the coupler pes; + ! the actual migrate back could happen later , from coupler pes to the land pes + if (mbintxla .ge. 0 ) then ! we are on coupler pes, for sure + + ! we could apply weights; need to use the same weight identifier wgtIdef as when we generated it + ! hard coded now, it should be a runtime option in the future + wgtIdef = 'scalar-pc'//CHAR(0) + ierr = iMOAB_ApplyScalarProjectionWeights ( mbintxla, wgtIdef, tagName, tagNameProj) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in applying weights for land projection' + call shr_sys_abort(subname//' ERROR in applying weights for land projection') + endif + +#ifdef MOABDEBUG + ! we can also write the land mesh to file, just to see the projectd tag + ! write out the mesh file to disk + write(lnum,"(I0.2)")num_proj + outfile = 'lndCplProj'//trim(lnum)//'.h5m'//CHAR(0) + wopts = ';PARALLEL=WRITE_PART'//CHAR(0) ! + ierr = iMOAB_WriteMesh(mblxid, trim(outfile), trim(wopts)) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in writing land projection' + call shr_sys_abort(subname//' ERROR in writing land projection') + endif +#endif + endif ! if on coupler procs + + endif ! sameg_al, original + endif ! if (atm_present .and. lnd_present) end subroutine prep_atm_migrate_moab From 30922a39151f4e06a93e667b2ffbc5b85059e02e Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Thu, 25 Feb 2021 21:18:05 -0600 Subject: [PATCH 079/467] tagname used even without MOABDEBUG [BFB] - Bit-For-Bit --- driver-moab/main/cplcomp_exchange_mod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/driver-moab/main/cplcomp_exchange_mod.F90 b/driver-moab/main/cplcomp_exchange_mod.F90 index be69df853521..c63457faa9ae 100644 --- a/driver-moab/main/cplcomp_exchange_mod.F90 +++ b/driver-moab/main/cplcomp_exchange_mod.F90 @@ -1009,10 +1009,10 @@ subroutine cplcomp_moab_Init(comp) integer :: rank, ent_type integer :: typeA, typeB, ATM_PHYS_CID ! used to compute par graph between atm phys ! and atm spectral on coupler + character*32 :: tagname #ifdef MOABDEBUG integer , dimension(1:3) :: nverts, nelem, nblocks, nsbc, ndbc integer, dimension(:), allocatable :: vgids - character*32 :: tagname #endif !----------------------------------------------------- From 3fa30bf3ab3eb802ac56563ed0fbb94b8d4099e0 Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Sat, 27 Feb 2021 23:06:07 -0600 Subject: [PATCH 080/467] add sea-ice model modify the mpas_moabmesh api, to allow sea-ice, similar to MPAS ocean [BFB] - Bit-For-Bit --- .../cice/bld/config_files/definition.xml | 2 +- components/mpas-ocean/driver/ocn_comp_mct.F | 9 ++++-- components/mpas-seaice/driver/ice_comp_mct.F | 9 +++++- driver-mct/shr/seq_comm_mct.F90 | 1 + driver-moab/main/cplcomp_exchange_mod.F90 | 30 ++++++++++++++++++- 5 files changed, 46 insertions(+), 5 deletions(-) diff --git a/components/cice/bld/config_files/definition.xml b/components/cice/bld/config_files/definition.xml index f6ce6a2fe75e..e1f3ba890a47 100644 --- a/components/cice/bld/config_files/definition.xml +++ b/components/cice/bld/config_files/definition.xml @@ -4,7 +4,7 @@ - + CICE build directory; contains .o and .mod files. diff --git a/components/mpas-ocean/driver/ocn_comp_mct.F b/components/mpas-ocean/driver/ocn_comp_mct.F index bf67672428e1..0f07a3abf6a0 100644 --- a/components/mpas-ocean/driver/ocn_comp_mct.F +++ b/components/mpas-ocean/driver/ocn_comp_mct.F @@ -39,6 +39,7 @@ module ocn_comp_mct use mpas_log #ifdef HAVE_MOAB use mpas_moabmesh + use seq_comm_mct, only: MPOID #endif use iso_c_binding, only : c_char, c_loc, c_ptr, c_int use mpas_c_interfacing, only : mpas_f_to_c_string, mpas_c_to_f_string @@ -213,6 +214,9 @@ subroutine ocn_init_mct( EClock, cdata_o, x2o_o, o2x_o, NLFilename )!{{{ real (kind=RKIND), dimension(:), pointer :: filteredSSHGradientZonal, filteredSSHGradientMeridional real (kind=RKIND), dimension(:,:), pointer :: avgSSHGradient +#ifdef HAVE_MOAB + character*100 outfile, wopts +#endif interface subroutine xml_stream_parser(xmlname, mgr_p, comm, ierr) bind(c) use iso_c_binding, only : c_char, c_ptr, c_int @@ -561,11 +565,12 @@ end subroutine xml_stream_get_attributes if ( ierr /= 0 ) then call mpas_log_write('Core init failed for core ' // trim(domain % core % coreName), MPAS_LOG_CRIT) end if + call t_stopf('mpaso_init2') #ifdef HAVE_MOAB - call mpas_moab_instance(domain_ptr) ! should return MPOID .. + call mpas_moab_instance(domain_ptr, OCNID, MPOID) ! should return MPOID .. call mpas_log_write('initialized MOAB MPAS ocean instance... ') #endif - call t_stopf('mpaso_init2') + !----------------------------------------------------------------------- ! diff --git a/components/mpas-seaice/driver/ice_comp_mct.F b/components/mpas-seaice/driver/ice_comp_mct.F index 7b3e80d6730b..9d5bf9bd3be7 100644 --- a/components/mpas-seaice/driver/ice_comp_mct.F +++ b/components/mpas-seaice/driver/ice_comp_mct.F @@ -40,6 +40,10 @@ module ice_comp_mct use mpas_bootstrapping use mpas_dmpar use mpas_log +#ifdef HAVE_MOAB + use mpas_moabmesh + use seq_comm_mct, only: MPSIID +#endif use iso_c_binding, only : c_char, c_loc, c_ptr, c_int use mpas_c_interfacing, only : mpas_f_to_c_string, mpas_c_to_f_string @@ -612,7 +616,10 @@ end subroutine xml_stream_get_attributes if ( ierr /= 0 ) then call mpas_log_write('Core init failed for core ' // trim(domain % core % coreName), MPAS_LOG_CRIT) end if - +#ifdef HAVE_MOAB + call mpas_moab_instance(domain, ICEID, MPSIID) ! should return MPSIID .. + call mpas_log_write('initialized MOAB MPAS sea-ice instance... ') +#endif !----------------------------------------------------------------------- ! ! initialize time-stamp information diff --git a/driver-mct/shr/seq_comm_mct.F90 b/driver-mct/shr/seq_comm_mct.F90 index 964977ac4b5d..c613aee50949 100644 --- a/driver-mct/shr/seq_comm_mct.F90 +++ b/driver-mct/shr/seq_comm_mct.F90 @@ -647,6 +647,7 @@ subroutine seq_comm_init(global_comm_in, driver_comm_in, nmlfile, drv_comm_id) mbintxoa = -1 ! iMOAB id for atm intx with mpas ocean mblxid = -1 ! iMOAB id for land on coupler pes mbintxla = -1 ! iMOAB id for land intx with atm on coupler pes + mpsiid = -1 ! iMOAB for sea-ice num_moab_exports = 0 ! mostly used in debugging >>>>>>> 9f1898ff7... add iulian787/compute_graph changes:cime/src/drivers/moab/shr/seq_comm_mct.F90 diff --git a/driver-moab/main/cplcomp_exchange_mod.F90 b/driver-moab/main/cplcomp_exchange_mod.F90 index c63457faa9ae..a2852c3794f8 100644 --- a/driver-moab/main/cplcomp_exchange_mod.F90 +++ b/driver-moab/main/cplcomp_exchange_mod.F90 @@ -19,6 +19,7 @@ module cplcomp_exchange_mod use seq_comm_mct, only : mlnid , mblxid ! iMOAB app id for land , on land pes and coupler pes use seq_comm_mct, only : mphaid ! iMOAB app id for phys atm; comp atm is 5, phys 5+200 use seq_comm_mct, only : sameg_al ! same grid atm lnd, and land is point cloud + use seq_comm_mct, only : MPSIID ! sea-ice use shr_mpi_mod, only: shr_mpi_max use dimensions_mod, only : np ! for atmosphere @@ -1004,7 +1005,7 @@ subroutine cplcomp_moab_Init(comp) integer, external :: iMOAB_SetIntTagStorage, iMOAB_FreeSenderBuffers, iMOAB_ComputeCommGraph integer :: ierr, context_id character*32 :: appname, outfile, wopts, tagnameProj - integer :: maxMH, maxMPO, maxMLID ! max pids for moab apps atm, ocn, lnd + integer :: maxMH, maxMPO, maxMLID, maxMSID ! max pids for moab apps atm, ocn, lnd, sea-ice integer :: tagtype, numco, tagindex, partMethod integer :: rank, ent_type integer :: typeA, typeB, ATM_PHYS_CID ! used to compute par graph between atm phys @@ -1041,6 +1042,7 @@ subroutine cplcomp_moab_Init(comp) call shr_mpi_max(mhid, maxMH, mpicom_join, all=.true.) ! if on atm / cpl joint, maxMH /= -1 call shr_mpi_max(mpoid, maxMPO, mpicom_join, all=.true.) call shr_mpi_max(mlnid, maxMLID, mpicom_join, all=.true.) + call shr_mpi_max(MPSIID, maxMSID, mpicom_join, all=.true.) if (seq_comm_iamroot(CPLID) ) then write(logunit, *) "MOAB coupling: maxMH: ", maxMH, " maxMPO: ", maxMPO, & " maxMLID: ", maxMLID @@ -1153,6 +1155,17 @@ subroutine cplcomp_moab_Init(comp) call seq_comm_getinfo(id_old,mpigrp=mpigrp_old) ! component group pes if (MPI_COMM_NULL /= mpicom_old ) then ! it means we are on the component pes (ocean) + ! write out the mesh file to disk, in parallel +#ifdef MOABDEBUG + outfile = 'wholeOcn.h5m'//CHAR(0) + wopts = 'PARALLEL=WRITE_PART'//CHAR(0) + ierr = iMOAB_WriteMesh(MPOID, outfile, wopts) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in writing ocean mesh ' + call shr_sys_abort(subname//' ERROR in writing ocean mesh ') + endif +#endif + ! send mesh to coupler ierr = iMOAB_SendMesh(mpoid, mpicom_join, mpigrp_cplid, id_join, partMethod) if (ierr .ne. 0) then @@ -1309,6 +1322,21 @@ subroutine cplcomp_moab_Init(comp) endif endif + ! sea - ice + if (comp%oneletterid == 'i' .and. maxMSID /= -1) then + if (MPI_COMM_NULL /= mpicom_old ) then ! it means we are on the component p +#ifdef MOABDEBUG + outfile = 'wholeSeaIce.h5m'//CHAR(0) + wopts = 'PARALLEL=WRITE_PART'//CHAR(0) + ierr = iMOAB_WriteMesh(MPSIID, outfile, wopts) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in writing sea-ice' + call shr_sys_abort(subname//' ERROR in writing sea-ice') + endif +#endif + endif + endif + end subroutine cplcomp_moab_Init end module cplcomp_exchange_mod From fc3dcee5af2b834184068095e1e367db0bdba3c1 Mon Sep 17 00:00:00 2001 From: Jason Sarich Date: Wed, 17 Mar 2021 15:32:48 -0500 Subject: [PATCH 081/467] Update the MOAB driver to use deep copies of files from mct driver instead of symlinks. --- driver-moab/main/prep_iac_mod.F90 | 169 ++++++++- driver-moab/shr/seq_pauseresume_mod.F90 | 440 +++++++++++++++++++++++- 2 files changed, 607 insertions(+), 2 deletions(-) mode change 120000 => 100644 driver-moab/main/prep_iac_mod.F90 mode change 120000 => 100644 driver-moab/shr/seq_pauseresume_mod.F90 diff --git a/driver-moab/main/prep_iac_mod.F90 b/driver-moab/main/prep_iac_mod.F90 deleted file mode 120000 index fd46637f052b..000000000000 --- a/driver-moab/main/prep_iac_mod.F90 +++ /dev/null @@ -1 +0,0 @@ -../../mct/main/prep_iac_mod.F90 \ No newline at end of file diff --git a/driver-moab/main/prep_iac_mod.F90 b/driver-moab/main/prep_iac_mod.F90 new file mode 100644 index 000000000000..1ab5f6d02848 --- /dev/null +++ b/driver-moab/main/prep_iac_mod.F90 @@ -0,0 +1,168 @@ +module prep_iac_mod + +#include "shr_assert.h" + use shr_kind_mod, only: r8 => SHR_KIND_R8 + use shr_kind_mod, only: cs => SHR_KIND_CS + use shr_kind_mod, only: cl => SHR_KIND_CL + use shr_kind_mod, only: cxx => SHR_KIND_CXX + use shr_sys_mod, only: shr_sys_abort, shr_sys_flush + use seq_comm_mct, only: num_inst_lnd, num_inst_iac, num_inst_frc + use seq_comm_mct, only: CPLID, ROFID, logunit + use seq_comm_mct, only: seq_comm_getData=>seq_comm_setptrs + use seq_infodata_mod, only: seq_infodata_type, seq_infodata_getdata + use shr_log_mod , only: errMsg => shr_log_errMsg + use seq_map_type_mod + use seq_map_mod + use seq_flds_mod + use t_drv_timers_mod + use mct_mod + use perf_mod + use component_type_mod, only: component_get_x2c_cx, component_get_c2x_cx + use component_type_mod, only: iac, lnd + use prep_lnd_mod, only: prep_lnd_get_mapper_Fr2l + + implicit none + save + private + + !-------------------------------------------------------------------------- + ! Public interfaces + !-------------------------------------------------------------------------- + + public :: prep_iac_init + public :: prep_iac_mrg + + public :: prep_iac_accum + public :: prep_iac_accum_avg + + public :: prep_iac_calc_l2x_zx + + public :: prep_iac_get_l2zacc_lx + public :: prep_iac_get_l2zacc_lx_cnt + public :: prep_iac_get_mapper_Fl2z + + !-------------------------------------------------------------------------- + ! Private interfaces + !-------------------------------------------------------------------------- + + !-------------------------------------------------------------------------- + ! Private data + !-------------------------------------------------------------------------- + + ! mappers + type(seq_map), pointer :: mapper_Fl2z + + ! attribute vectors + type(mct_aVect), pointer :: l2x_zx(:) + + ! accumulation variables + type(mct_aVect), pointer :: l2zacc_lx(:) ! lnd export, lnd grid, cpl pes + integer , target :: l2zacc_lx_cnt ! l2racc_lx: number of time samples accumulated + + ! other module variables + integer :: mpicom_CPLID ! MPI cpl communicator + + !================================================================================================ + +contains + + !================================================================================================ + + subroutine prep_iac_init(infodata, lnd_c2_iac) + + !--------------------------------------------------------------- + ! Description + ! Initialize module attribute vectors and all other non-mapping + ! module variables + ! + ! Arguments + type(seq_infodata_type) , intent(in) :: infodata + logical , intent(in) :: lnd_c2_iac ! .true. => lnd to iac coupling on + ! + ! Local Variables + + end subroutine prep_iac_init + + !================================================================================================ + + subroutine prep_iac_accum(timer) + + !--------------------------------------------------------------- + ! Description + ! Accumulate land input to iac + ! + ! Arguments + character(len=*), intent(in) :: timer + ! + ! Local Variables + + end subroutine prep_iac_accum + + !================================================================================================ + + subroutine prep_iac_accum_avg(timer) + + !--------------------------------------------------------------- + ! Description + ! Finalize accumulation of land input to river component + ! + ! Arguments + character(len=*), intent(in) :: timer + ! + ! Local Variables + + end subroutine prep_iac_accum_avg + + !================================================================================================ + + subroutine prep_iac_mrg(infodata, fractions_zx, timer_mrg) + + !--------------------------------------------------------------- + ! Description + ! Merge iac inputs + ! + ! Arguments + type(seq_infodata_type) , intent(in) :: infodata + type(mct_aVect) , intent(in) :: fractions_zx(:) + character(len=*) , intent(in) :: timer_mrg + ! + ! Local Variables + + end subroutine prep_iac_mrg + + !================================================================================================ + + !================================================================================================ + + subroutine prep_iac_calc_l2x_zx(timer) + !--------------------------------------------------------------- + ! Description + ! Create l2x_zx (note that l2x_zx is a local module variable) + ! + ! Arguments + ! Don't know if we need these fractions just yet + ! type(mct_aVect) , intent(in) :: fractions_lx(:) + character(len=*), intent(in) :: timer + ! + ! Local Variables + + end subroutine prep_iac_calc_l2x_zx + + !================================================================================================ + + function prep_iac_get_l2zacc_lx() + type(mct_aVect), pointer :: prep_iac_get_l2zacc_lx(:) + prep_iac_get_l2zacc_lx => l2zacc_lx(:) + end function prep_iac_get_l2zacc_lx + + function prep_iac_get_l2zacc_lx_cnt() + integer, pointer :: prep_iac_get_l2zacc_lx_cnt + prep_iac_get_l2zacc_lx_cnt => l2zacc_lx_cnt + end function prep_iac_get_l2zacc_lx_cnt + + function prep_iac_get_mapper_Fl2z() + type(seq_map), pointer :: prep_iac_get_mapper_Fl2z + prep_iac_get_mapper_Fl2z => mapper_Fl2z + end function prep_iac_get_mapper_Fl2z + +end module prep_iac_mod diff --git a/driver-moab/shr/seq_pauseresume_mod.F90 b/driver-moab/shr/seq_pauseresume_mod.F90 deleted file mode 120000 index 925e00b1fd1a..000000000000 --- a/driver-moab/shr/seq_pauseresume_mod.F90 +++ /dev/null @@ -1 +0,0 @@ -../../mct/shr/seq_pauseresume_mod.F90 \ No newline at end of file diff --git a/driver-moab/shr/seq_pauseresume_mod.F90 b/driver-moab/shr/seq_pauseresume_mod.F90 new file mode 100644 index 000000000000..9d56f0cc6134 --- /dev/null +++ b/driver-moab/shr/seq_pauseresume_mod.F90 @@ -0,0 +1,439 @@ +! !MODULE: seq_pauseresume_mod --- Module for managing pause/resume data for ESP components +! +! !DESCRIPTION: +! +! A module to collect and distribute pause/resume information +! +! +! !INTERFACE: ------------------------------------------------------------------ + +module seq_pauseresume_mod + + ! !USES: + + use shr_kind_mod, only: CL => SHR_KIND_CL + use shr_sys_mod, only: shr_sys_flush, shr_sys_abort + use seq_comm_mct, only: num_inst_driver + + implicit none + + private +#include + + ! !PUBLIC INTERFACES: + public :: seq_resume_store_comp ! Store component resume filenames + public :: seq_resume_get_files ! Retrieve pointer to resume filenames + public :: seq_resume_free ! Free resume filename storage + public :: seq_resume_broadcast ! Broadcast component filenames to all PEs + + ! Type to hold resume filenames + type seq_resume_type + character(len=CL), pointer :: atm_resume(:) => NULL() ! atm resume file(s) + character(len=CL), pointer :: lnd_resume(:) => NULL() ! lnd resume file(s) + character(len=CL), pointer :: ice_resume(:) => NULL() ! ice resume file(s) + character(len=CL), pointer :: ocn_resume(:) => NULL() ! ocn resume file(s) + character(len=CL), pointer :: glc_resume(:) => NULL() ! glc resume file(s) + character(len=CL), pointer :: rof_resume(:) => NULL() ! rof resume file(s) + character(len=CL), pointer :: wav_resume(:) => NULL() ! wav resume file(s) + character(len=CL), pointer :: cpl_resume(:) => NULL() ! cpl resume file(s) + end type seq_resume_type + + type(seq_resume_type), pointer :: resume => NULL() ! For storing pause/resume files + + private :: seq_resume_broadcast_array + +CONTAINS + + !=========================================================================== + + !BOP ======================================================================= + ! + ! !IROUTINE: seq_resume_store_comp - Allocate space & store resume filenames + ! + ! !DESCRIPTION: + ! + ! Allocate data for resume filenames from all component instances + ! Store resume filenames for requested component + ! + ! Assumptions about instance numbers: + ! Multi-driver: num_inst_driver = total number of instances of each + ! num_inst_ = 1 + ! Single-driver: num_inst_driver = 1 + ! num_inst_ = total number of instances + ! + ! Assumption about resume names: All PEs should have the same value + ! for %cdata_cc%resume_filename + ! + ! !INTERFACE: -------------------------------------------------------------- + + subroutine seq_resume_store_comp(oid, filename, num_inst_comp, ninst, iamroot) + character(len=1), intent(in) :: oid ! 1 letter comp type + character(len=*), intent(in) :: filename ! resume filename + integer, intent(in) :: num_inst_comp ! # comp instances + integer, intent(in) :: ninst ! comp instance # + logical, intent(in) :: iamroot ! is comp root? + + integer :: num_inst ! # store instances + character(len=CL), pointer :: fname_ptr(:) + character(len=*), parameter :: subname = 'seq_resume_store_comp' + + nullify(fname_ptr) + + if (.not. associated(resume)) then + allocate(resume) + end if + + if (len_trim(filename) > 0) then + num_inst = num_inst_comp * num_inst_driver + else + num_inst = 0 + end if + + ! Make sure each comp field is allocated correctly + select case(oid) + case ('a') + if (associated(resume%atm_resume)) then + if ((num_inst == 0) .or. (size(resume%atm_resume) /= num_inst)) then + deallocate(resume%atm_resume) + nullify(resume%atm_resume) + end if + end if + if (num_inst > 0) then + if (.not. associated(resume%atm_resume)) then + allocate(resume%atm_resume(num_inst)) + end if + fname_ptr => resume%atm_resume + end if + case ('l') + if (associated(resume%lnd_resume)) then + if ((num_inst == 0) .or. (size(resume%lnd_resume) /= num_inst)) then + deallocate(resume%lnd_resume) + nullify(resume%lnd_resume) + end if + end if + if (num_inst > 0) then + if (.not. associated(resume%lnd_resume)) then + allocate(resume%lnd_resume(num_inst)) + end if + fname_ptr => resume%lnd_resume + end if + case ('o') + if (associated(resume%ocn_resume)) then + if ((num_inst == 0) .or. (size(resume%ocn_resume) /= num_inst)) then + deallocate(resume%ocn_resume) + nullify(resume%ocn_resume) + end if + end if + if (num_inst > 0) then + if (.not. associated(resume%ocn_resume)) then + allocate(resume%ocn_resume(num_inst)) + end if + fname_ptr => resume%ocn_resume + end if + case ('i') + if (associated(resume%ice_resume)) then + if ((num_inst == 0) .or. (size(resume%ice_resume) /= num_inst)) then + deallocate(resume%ice_resume) + nullify(resume%ice_resume) + end if + end if + if (num_inst > 0) then + if (.not. associated(resume%ice_resume)) then + allocate(resume%ice_resume(num_inst)) + end if + fname_ptr => resume%ice_resume + end if + case ('r') + if (associated(resume%rof_resume)) then + if ((num_inst == 0) .or. (size(resume%rof_resume) /= num_inst)) then + deallocate(resume%rof_resume) + nullify(resume%rof_resume) + end if + end if + if (num_inst > 0) then + if (.not. associated(resume%rof_resume)) then + allocate(resume%rof_resume(num_inst)) + end if + fname_ptr => resume%rof_resume + end if + case ('g') + if (associated(resume%glc_resume)) then + if ((num_inst == 0) .or. (size(resume%glc_resume) /= num_inst)) then + deallocate(resume%glc_resume) + nullify(resume%glc_resume) + end if + end if + if (num_inst > 0) then + if (.not. associated(resume%glc_resume)) then + allocate(resume%glc_resume(num_inst)) + end if + fname_ptr => resume%glc_resume + end if + case ('w') + if (associated(resume%wav_resume)) then + if ((num_inst == 0) .or. (size(resume%wav_resume) /= num_inst)) then + deallocate(resume%wav_resume) + nullify(resume%wav_resume) + end if + end if + if (num_inst > 0) then + if (.not. associated(resume%wav_resume)) then + allocate(resume%wav_resume(num_inst)) + end if + fname_ptr => resume%wav_resume + end if + case ('x') + if (associated(resume%cpl_resume)) then + if ((num_inst == 0) .or. (size(resume%cpl_resume) /= num_inst)) then + deallocate(resume%cpl_resume) + nullify(resume%cpl_resume) + end if + end if + if (num_inst > 0) then + if (.not. associated(resume%cpl_resume)) then + allocate(resume%cpl_resume(num_inst)) + end if + fname_ptr => resume%cpl_resume + end if + case default + call shr_sys_abort(subname//': Bad component id, '//oid) + end select + + ! Copy in the resume filename if it exists + if (associated(fname_ptr)) then + fname_ptr(ninst) = filename + end if + + end subroutine seq_resume_store_comp + + !=========================================================================== + !BOP ======================================================================= + ! + ! !IROUTINE: seq_resume_get_files -- Return resume filename info + ! + ! !DESCRIPTION: + ! + ! Return resume filename info + ! + ! !INTERFACE: -------------------------------------------------------------- + subroutine seq_resume_get_files(oneletterid, files, bcast) + character(len=1), intent(in) :: oneletterid + character(len=*), pointer :: files(:) + logical, optional, intent(in) :: bcast + + character(len=*), parameter :: subname = 'seq_resume_get_files' + + nullify(files) + if (present(bcast)) then + if (bcast) then + call seq_resume_broadcast(oneletterid) + end if + ! No else: if not present, assume false + end if + select case(oneletterid) + case ('a') + if (associated(resume%atm_resume)) then + files => resume%atm_resume + end if + case ('l') + if (associated(resume%lnd_resume)) then + files => resume%lnd_resume + end if + case ('o') + if (associated(resume%ocn_resume)) then + files => resume%ocn_resume + end if + case ('i') + if (associated(resume%ice_resume)) then + files => resume%ice_resume + end if + case ('r') + if (associated(resume%rof_resume)) then + files => resume%rof_resume + end if + case ('g') + if (associated(resume%glc_resume)) then + files => resume%glc_resume + end if + case ('w') + if (associated(resume%wav_resume)) then + files => resume%wav_resume + end if + case ('x') + if (associated(resume%cpl_resume)) then + files => resume%cpl_resume + end if + case default + call shr_sys_abort(subname//': Bad component id, '//oneletterid) + end select + end subroutine seq_resume_get_files + + !=========================================================================== + !BOP ======================================================================= + ! + ! !IROUTINE: seq_resume_free -- Free space for resume filenames + ! + ! !DESCRIPTION: + ! + ! Free data for resume filenames from all component instances + ! + ! !INTERFACE: -------------------------------------------------------------- + + subroutine seq_resume_free() + + if (associated(resume)) then + if (associated(resume%atm_resume)) then + deallocate(resume%atm_resume) + nullify(resume%atm_resume) + end if + + if (associated(resume%lnd_resume)) then + deallocate(resume%lnd_resume) + nullify(resume%lnd_resume) + end if + + if (associated(resume%ocn_resume)) then + deallocate(resume%ocn_resume) + nullify(resume%ocn_resume) + end if + + if (associated(resume%ice_resume)) then + deallocate(resume%ice_resume) + nullify(resume%ice_resume) + end if + + if (associated(resume%rof_resume)) then + deallocate(resume%rof_resume) + nullify(resume%rof_resume) + end if + + if (associated(resume%glc_resume)) then + deallocate(resume%glc_resume) + nullify(resume%glc_resume) + end if + + if (associated(resume%wav_resume)) then + deallocate(resume%wav_resume) + nullify(resume%wav_resume) + end if + + if (associated(resume%cpl_resume)) then + deallocate(resume%cpl_resume) + nullify(resume%cpl_resume) + end if + end if + end subroutine seq_resume_free + + !=========================================================================== + !BOP ======================================================================= + ! + ! !IROUTINE: seq_resume_broadcast + ! + ! !DESCRIPTION: + ! + ! Broadcast a component type's resume filenames to all PEs + ! + ! !INTERFACE: -------------------------------------------------------------- + + subroutine seq_resume_broadcast(oneletterid) + character(len=1), intent(in) :: oneletterid + + character(len=CL), pointer :: fname_ptr(:) + character(len=*), parameter :: subname = 'seq_resume_broadcast' + + ! This interface does a pointer dance. Because the array + ! passed to seq_resume_broadcast_array may be NULL on input + ! but allocated on output, we need to 'reconnect' it to the + ! resume structure + select case(oneletterid) + case ('a') + fname_ptr => resume%atm_resume + call seq_resume_broadcast_array(fname_ptr) + resume%atm_resume => fname_ptr + case ('l') + fname_ptr => resume%lnd_resume + call seq_resume_broadcast_array(fname_ptr) + resume%lnd_resume => fname_ptr + case ('o') + fname_ptr => resume%ocn_resume + call seq_resume_broadcast_array(fname_ptr) + resume%ocn_resume => fname_ptr + case ('i') + fname_ptr => resume%ice_resume + call seq_resume_broadcast_array(fname_ptr) + resume%ice_resume => fname_ptr + case ('r') + fname_ptr => resume%rof_resume + call seq_resume_broadcast_array(fname_ptr) + resume%rof_resume => fname_ptr + case ('g') + fname_ptr => resume%glc_resume + call seq_resume_broadcast_array(fname_ptr) + resume%glc_resume => fname_ptr + case ('w') + fname_ptr => resume%wav_resume + call seq_resume_broadcast_array(fname_ptr) + resume%wav_resume => fname_ptr + case ('x') + fname_ptr => resume%cpl_resume + call seq_resume_broadcast_array(fname_ptr) + resume%cpl_resume => fname_ptr + case default + call shr_sys_abort(subname//': Bad component id, '//oneletterid) + end select + end subroutine seq_resume_broadcast + + subroutine seq_resume_broadcast_array(filename_array) + use shr_mpi_mod, only: shr_mpi_bcast + ! Used to bcast component filenames across multiple drivers + use seq_comm_mct, only: global_comm + + character(len=CL), pointer :: filename_array(:) + + integer, allocatable :: active_entries(:) + integer :: global_numpes + integer :: num_entries + integer :: my_entry + integer :: index + integer :: ierr + character(len=128) :: errmsg + character(len=*), parameter :: subname = "(fill_array_pes)" + + call MPI_comm_rank(global_comm, global_numpes, ierr) + allocate(active_entries(global_numpes)) + + ! Find filled array element (if any) + ! Note, it is an error to find more than one. + active_entries = 0 + my_entry = 0 + if (associated(filename_array)) then + do index = 1, size(filename_array) + if (len_trim(filename_array(index)) > 0) then + if (my_entry > 0) then + write(errmsg, '(2(a,i0))') ': Bad entry, ', index, & + ', already have ',my_entry + call shr_sys_abort(subname//trim(errmsg)) + end if + my_entry = index + end if + end do + end if + ! Share my_entry with other PEs + call MPI_allgather(my_entry, 1, MPI_INTEGER, active_entries, 1, MPI_INTEGER, global_comm, ierr) + ! Allocate our array if needed + num_entries = MAXVAL(active_entries) + if ((num_entries > 0) .and. (.not. associated(filename_array))) then + allocate(filename_array(num_entries)) + end if + do index = 1, global_numpes + my_entry = active_entries(index) + if (my_entry > 0) then + call shr_mpi_bcast(filename_array(my_entry), global_comm, & + subname//': bcast', pebcast=index-1) + end if + end do + + deallocate(active_entries) + end subroutine seq_resume_broadcast_array + +end module seq_pauseresume_mod From f76a368cbbeab7bcbf3ef7b76fc52df925a44f35 Mon Sep 17 00:00:00 2001 From: iulian07 Date: Thu, 18 Mar 2021 15:09:13 -0500 Subject: [PATCH 082/467] add chrysalis machine to config files --- cime_config/machines/config_compilers.xml | 46 +++++++++ cime_config/machines/config_machines.xml | 109 ++++++++++++++++++++++ 2 files changed, 155 insertions(+) diff --git a/cime_config/machines/config_compilers.xml b/cime_config/machines/config_compilers.xml index 9fd367dd87a8..efe71d735c55 100644 --- a/cime_config/machines/config_compilers.xml +++ b/cime_config/machines/config_compilers.xml @@ -918,6 +918,52 @@ flags should be captured within MPAS CMake files. $ENV{PNETCDF_PATH} + + + -DHAVE_SLASHPROC + + /home/iulian/lib/moab/chrys + + -O2 -debug minimal -qno-opt-dynamic-align + + gpfs + + $SHELL{$ENV{NETCDF_FORTRAN_PATH}/bin/nf-config --flibs} $SHELL{$ENV{NETCDF_C_PATH}/bin/nc-config --libs} -mkl + + $ENV{NETCDF_C_PATH} + $ENV{NETCDF_FORTRAN_PATH} + $ENV{PNETCDF_PATH} + + -static-intel + + + -static-intel + + + -static-intel + + mpiicc + mpiicpc + mpiifort + + + + + -DHAVE_NANOTIME -DBIT64 -DHAVE_SLASHPROC -DHAVE_GETTIMEOFDAY + + gpfs + + $SHELL{$ENV{NETCDF_FORTRAN_PATH}/bin/nf-config --flibs} $SHELL{$ENV{NETCDF_C_PATH}/bin/nc-config --libs} + -Wl,--start-group $ENV{MKLROOT}/lib/intel64/libmkl_gf_lp64.a $ENV{MKLROOT}/lib/intel64/libmkl_sequential.a $ENV{MKLROOT}/lib/intel64/libmkl_core.a -Wl,--end-group -lpthread -lm -ldl + + + -lstdc++ + + $ENV{NETCDF_C_PATH} + $ENV{NETCDF_FORTRAN_PATH} + $ENV{PNETCDF_PATH} + + --host=Linux diff --git a/cime_config/machines/config_machines.xml b/cime_config/machines/config_machines.xml index 4f4c58ae520c..04738dc7cfc3 100644 --- a/cime_config/machines/config_machines.xml +++ b/cime_config/machines/config_machines.xml @@ -1234,6 +1234,115 @@ + + ANL LCRC cluster 512-node AMD Epyc 7532 2-sockets 64-cores per node + chr.* + LINUX + intel,gnu + impi,openmpi + e3sm + /lcrc/group/e3sm/PERF_Chrysalis + .* + /lcrc/group/e3sm/$USER/scratch/chrys + /lcrc/group/e3sm/data/inputdata + /lcrc/group/e3sm/data/inputdata/atm/datm7 + /lcrc/group/e3sm/$USER/scratch/chrys/archive/$CASE + /lcrc/group/e3sm/baselines/chrys/$COMPILER + /lcrc/group/e3sm/tools/cprnc/cprnc + 8 + e3sm_integration + slurm + E3SM + 64 + 64 + FALSE + + srun + + --mpi=pmi2 -l -n {{ total_tasks }} -N {{ num_nodes }} --kill-on-bad-exit + --cpu_bind=cores + -c $ENV{OMP_NUM_THREADS} + -m plane={{ tasks_per_node }} + + + + /gpfs/fs1/soft/chrysalis/spack/opt/spack/linux-centos8-x86_64/gcc-9.3.0/lmod-8.3-5be73rg/lmod/lmod/init/sh + /gpfs/fs1/soft/chrysalis/spack/opt/spack/linux-centos8-x86_64/gcc-9.3.0/lmod-8.3-5be73rg/lmod/lmod/init/csh + /gpfs/fs1/soft/chrysalis/spack/opt/spack/linux-centos8-x86_64/gcc-9.3.0/lmod-8.3-5be73rg/lmod/lmod/init/env_modules_python.py + /gpfs/fs1/soft/chrysalis/spack/opt/spack/linux-centos8-x86_64/gcc-9.3.0/lmod-8.3-5be73rg/lmod/lmod/libexec/lmod python + module + module + + + subversion/1.14.0-e4smcy3 + perl/5.32.0-bsnc6lt + + + intel/20.0.4-kodw73g + intel-mkl/2020.4.304-g2qaxzf + + + openmpi/4.0.4-hpcx-cy5n3ft + hdf5/1.8.16-m3bsibs + netcdf-c/4.4.1-7ejgpdm + netcdf-cxx/4.2-sag6n3x + netcdf-fortran/4.4.4-sjzkwoc + parallel-netcdf/1.11.0-l362p2g + + + intel-mpi/2019.9.304-tkzvizk + hdf5/1.8.16-se4xyo7 + netcdf-c/4.4.1-qvxyzq2 + netcdf-cxx/4.2-binixgj + netcdf-fortran/4.4.4-rdxohvp + parallel-netcdf/1.11.0-b74wv4m + + + gcc/9.2.0-ugetvbp + intel-mkl/2020.4.304-n3b5fye + + + openmpi/4.0.4-hpcx-hghvhj5 + hdf5/1.10.7-sbsigon + netcdf-c/4.7.4-a4uk6zy + netcdf-cxx/4.2-fz347dw + netcdf-fortran/4.5.3-i5ah7u2 + parallel-netcdf/1.12.1-e7w4x32 + + + intel-mpi/2019.9.304-jdih7h5 + hdf5/1.8.16-dtbpce3 + netcdf-c/4.4.1-zcoa44z + netcdf-cxx/4.2-ayxg4c7 + netcdf-fortran/4.4.4-2lfr2lr + parallel-netcdf/1.11.0-ifdodru + + + $CIME_OUTPUT_ROOT/$CASE/run + $CIME_OUTPUT_ROOT/$CASE/bld + 0.1 + 1000 + + /lcrc/group/e3sm/soft/perl/chrys/lib/perl5 + $SHELL{dirname $(dirname $(which nc-config))} + $SHELL{dirname $(dirname $(which nf-config))} + $SHELL{dirname $(dirname $(which pnetcdf_version))} + + + 128M + + + granularity=core,scatter + 1 + + + cores + + + sm,ud + + + ANL/LCRC Linux Cluster LINUX From c535ff67884f7001f77035772059b9a6d74cb511 Mon Sep 17 00:00:00 2001 From: iulian07 Date: Fri, 26 Mar 2021 11:00:26 -0500 Subject: [PATCH 083/467] set new moab paths for chrysalis and anvil for intel (intel 20) and intel 18 for anvil --- cime_config/machines/config_compilers.xml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/cime_config/machines/config_compilers.xml b/cime_config/machines/config_compilers.xml index efe71d735c55..f42ca369ef81 100644 --- a/cime_config/machines/config_compilers.xml +++ b/cime_config/machines/config_compilers.xml @@ -768,7 +768,7 @@ flags should be captured within MPAS CMake files. -DHAVE_SLASHPROC - /home/iulian/moab-blds/blues/moabs29 + /lcrc/soft/climate/moab/anvil/intel18 --host=Linux @@ -922,7 +922,7 @@ flags should be captured within MPAS CMake files. -DHAVE_SLASHPROC - /home/iulian/lib/moab/chrys + /lcrc/soft/climate/moab/chrysalis/intel -O2 -debug minimal -qno-opt-dynamic-align From d6607d74873f6b19196782803378f20c07f0ebdb Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Sun, 28 Mar 2021 01:26:56 -0500 Subject: [PATCH 084/467] add river model *********1*********2*********3*********4*********5*********6*********7** add river model in moab, as a point cloud for a half degree river model, there are 720*360 points; all points are distributed, by default in round robin way all segments in gsmap for r model are length 1 !! add mask and partition tag so far [BFB] - Bit-For-Bit --- components/mosart/src/cpl/rof_comp_mct.F90 | 148 +++++++++++++++++++++ 1 file changed, 148 insertions(+) diff --git a/components/mosart/src/cpl/rof_comp_mct.F90 b/components/mosart/src/cpl/rof_comp_mct.F90 index f942dbee9b2f..c0653b275272 100644 --- a/components/mosart/src/cpl/rof_comp_mct.F90 +++ b/components/mosart/src/cpl/rof_comp_mct.F90 @@ -51,6 +51,9 @@ module rof_comp_mct use mct_mod use ESMF +#ifdef HAVE_MOAB + use seq_comm_mct, only : mrofid ! id of moab rof app +#endif ! ! PUBLIC MEMBER FUNCTIONS: implicit none @@ -70,6 +73,9 @@ module rof_comp_mct private :: rof_domain_mct ! Set the river runoff model domain information private :: rof_export_mct ! Export the river runoff model data to the CESM coupler ! +#ifdef HAVE_MOAB + private :: init_rof_moab ! create moab mesh (cloud of points) +#endif ! PRIVATE DATA MEMBERS: ! REVISION HISTORY: @@ -127,6 +133,12 @@ subroutine rof_init_mct( EClock, cdata_r, x2r_r, r2x_r, NLFilename) character(len=8) :: c_npes ! number of pes character(len=32), parameter :: sub = 'rof_init_mct' character(len=*), parameter :: format = "('("//trim(sub)//") :',A)" + +#ifdef HAVE_MOAB + integer, external :: iMOAB_RegisterFortranApplication + integer :: ierr + character*32 appname +#endif !--------------------------------------------------------------------------- ! Obtain cdata_r (initalized in ccsm_comp_mod.F90 in the call to @@ -262,6 +274,37 @@ subroutine rof_init_mct( EClock, cdata_r, x2r_r, r2x_r, NLFilename) ! Create mct river runoff export state call rof_export_mct( r2x_r ) + +#ifdef HAVE_MOAB + appname="ROFMB"//CHAR(0) ! only if rof_prognostic + ! first rof instance, should be + ierr = iMOAB_RegisterFortranApplication(appname, mpicom_rof, ROFID, mrofid) + if (ierr > 0 ) & + call shr_sys_abort( sub//' Error: cannot register moab app') + if(masterproc) then + write(iulog,*) " " + write(iulog,*) "register MOAB ROF app:", trim(appname), " mrofid=", mrofid, " ROFID=", ROFID + write(iulog,*) " " + endif + call init_rof_moab() + +#if 0 + if (masterproc) then + debugGSMapFile = shr_file_getUnit() + open( debugGSMapFile, file='LndGSmapC.txt') + write(debugGSMapFile,*) gsMap_lnd%comp_id + write(debugGSMapFile,*) gsMap_lnd%ngseg + write(debugGSMapFile,*) gsMap_lnd%gsize + do n=1,gsMap_lnd%ngseg + write(debugGSMapFile,*) gsMap_lnd%start(n),gsMap_lnd%length(n),gsMap_lnd%pe_loc(n) + end do + close(debugGSMapFile) + call shr_file_freeunit(debugGSMapFile) + endif +#endif + +! endif HAVE_MOAB +#endif else call seq_infodata_PutData(infodata, rofice_present=.false.) end if @@ -730,4 +773,109 @@ subroutine rof_export_mct( r2x_r ) end subroutine rof_export_mct +#ifdef HAVE_MOAB + subroutine init_rof_moab() + ! use rtmCTL that has all we need + use seq_comm_mct, only: mrofid ! id of moab rof app + use shr_const_mod, only: SHR_CONST_PI + + integer,allocatable :: gindex(:) ! Number the local grid points; used for global ID + integer lsz ! keep local size + integer gsize ! global size, that we do not need, actually + integer n + integer , external :: iMOAB_CreateVertices, iMOAB_WriteMesh, & + iMOAB_DefineTagStorage, iMOAB_SetIntTagStorage, iMOAB_SetDoubleTagStorage, & + iMOAB_ResolveSharedEntities, iMOAB_CreateElements, iMOAB_MergeVertices, iMOAB_UpdateMeshInfo + ! local variables to fill in data + integer, dimension(:), allocatable :: vgids + ! retrieve everything we need from rtmCTL + ! number of vertices is the size of local rof gsmap ? + real(r8), dimension(:), allocatable :: moab_vert_coords ! temporary + real(r8) :: latv, lonv + integer dims, i, iv, ilat, ilon, igdx, ierr, tagindex + integer tagtype, numco, ent_type, mbtype, block_ID + character*100 outfile, wopts, localmeshfile, tagname + character(len=32), parameter :: sub = 'init_rof_moab' + character(len=*), parameter :: format = "('("//trim(sub)//") :',A)" + + dims =3 ! store as 3d mesh + + ! number the local grid + lsz = rtmCTL%lnumr + + allocate(vgids(lsz)) ! use it for global ids, for elements in full mesh or vertices in point cloud + + do n = 1, lsz + vgids(n) = rtmCTL%gindex(rtmCTL%begr+n-1) ! local to global ! + end do + gsize = rtmCTL%numr ! size of the total grid + ! old point cloud mesh + allocate(moab_vert_coords(lsz*dims)) + do i = 1, lsz + n = rtmCTL%begr+i-1 + lonv = rtmCTL%lonc(n) *SHR_CONST_PI/180. + latv = rtmCTL%latc(n) *SHR_CONST_PI/180. + moab_vert_coords(3*i-2)=COS(latv)*COS(lonv) + moab_vert_coords(3*i-1)=COS(latv)*SIN(lonv) + moab_vert_coords(3*i )=SIN(latv) + enddo + ierr = iMOAB_CreateVertices(mrofid, lsz*3, dims, moab_vert_coords) + if (ierr > 0 ) & + call shr_sys_abort( sub//' Error: fail to create MOAB vertices in runoff model') + + tagtype = 0 ! dense, integer + numco = 1 + tagname='GLOBAL_ID'//CHAR(0) + ierr = iMOAB_DefineTagStorage(mrofid, tagname, tagtype, numco, tagindex ) + if (ierr > 0 ) & + call shr_sys_abort( sub//' Error: fail to retrieve GLOBAL_ID tag ') + + ent_type = 0 ! vertex type + ierr = iMOAB_SetIntTagStorage ( mrofid, tagname, lsz , ent_type, vgids) + if (ierr > 0 ) & + call shr_sys_abort( sub//' Error: fail to set GLOBAL_ID tag ') + + ierr = iMOAB_ResolveSharedEntities( mrofid, lsz, vgids ); + if (ierr > 0 ) & + call shr_sys_abort( sub//' Error: fail to resolve shared entities') + + !there are no shared entities, but we will set a special partition tag, in order to see the + ! partitions ; it will be visible with a Pseudocolor plot in VisIt + tagname='partition'//CHAR(0) + ierr = iMOAB_DefineTagStorage(mrofid, tagname, tagtype, numco, tagindex ) + if (ierr > 0 ) & + call shr_sys_abort( sub//' Error: fail to create new partition tag ') + + vgids = iam + ierr = iMOAB_SetIntTagStorage ( mrofid, tagname, lsz , ent_type, vgids) + if (ierr > 0 ) & + call shr_sys_abort( sub//' Error: fail to set partition tag ') + + ! mask + tagname='mask'//CHAR(0) + ierr = iMOAB_DefineTagStorage(mrofid, tagname, tagtype, numco, tagindex ) + if (ierr > 0 ) & + call shr_sys_abort( sub//' Error: fail to create new mask tag ') + + do n = 1, lsz + vgids(n) = rtmCTL%mask(rtmCTL%begr+n-1) ! local to global ! + end do + + ierr = iMOAB_SetIntTagStorage ( mrofid, tagname, lsz , ent_type, vgids) + if (ierr > 0 ) & + call shr_sys_abort( sub//' Error: fail to set mask tag ') + + deallocate(moab_vert_coords) + deallocate(vgids) +#ifdef MOABDEBUG + ! write out the mesh file to disk, in parallel + outfile = 'wholeRof.h5m'//CHAR(0) + wopts = 'PARALLEL=WRITE_PART'//CHAR(0) + ierr = iMOAB_WriteMesh(mrofid, outfile, wopts) + if (ierr > 0 ) & + call shr_sys_abort( sub//' Error: fail to write the moab runoff mesh file') +#endif + end subroutine init_rof_moab +#endif + end module rof_comp_mct From 65272ed082bf6c88199c164bfbd902311481e9ff Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Mon, 29 Mar 2021 10:03:26 -0500 Subject: [PATCH 085/467] add sea ice moab instance on coupler pes add migrate mesh from sea ice comp to coupler fields are not yet added, intx not yet computed [BFB] - Bit-For-Bit --- driver-mct/shr/seq_comm_mct.F90 | 43 ++++---------- driver-moab/main/cplcomp_exchange_mod.F90 | 71 ++++++++++++++++++++++- 2 files changed, 82 insertions(+), 32 deletions(-) diff --git a/driver-mct/shr/seq_comm_mct.F90 b/driver-mct/shr/seq_comm_mct.F90 index c613aee50949..08b94d959570 100644 --- a/driver-mct/shr/seq_comm_mct.F90 +++ b/driver-mct/shr/seq_comm_mct.F90 @@ -221,6 +221,15 @@ module seq_comm_mct integer, public :: mbaxid ! iMOAB id for atm migrated mesh to coupler pes integer, public :: mboxid ! iMOAB id for mpas ocean migrated mesh to coupler pes integer, public :: mbintxoa ! iMOAB id for intx mesh between ocean and atmosphere + integer, public :: mblxid ! iMOAB id for land mesh migrated to coupler pes + logical, public :: sameg_al ! same grid atm and land; used throughout, initialized in lnd_init + integer, public :: mbintxla ! iMOAB id for intx mesh between land and atmosphere + integer, public :: mpsiid ! iMOAB id for sea-ice, mpas model + integer, public :: mbixid ! iMOAB id for sea-ice migrated to coupler pes + integer, public :: mrofid ! iMOAB id of moab rof app + + integer, public :: num_moab_exports ! iMOAB id for atm phys grid, on atm pes + !======================================================================= contains !====================================================================== @@ -252,10 +261,7 @@ subroutine seq_comm_init(global_comm_in, driver_comm_in, nmlfile, drv_comm_id) integer :: drv_inst character(len=8) :: c_drv_inst ! driver instance number character(len=8) :: c_driver_numpes ! number of pes in driver -<<<<<<< HEAD:driver-mct/shr/seq_comm_mct.F90 character(len=16):: c_comm_name ! comm. name -======= ->>>>>>> a7b4b52c7... merge mct driver updates into moab:cime/src/drivers/moab/shr/seq_comm_mct.F90 character(len=seq_comm_namelen) :: valid_comps(ncomps) integer :: & @@ -268,12 +274,8 @@ subroutine seq_comm_init(global_comm_in, driver_comm_in, nmlfile, drv_comm_id) ocn_ntasks, ocn_rootpe, ocn_pestride, ocn_nthreads, & esp_ntasks, esp_rootpe, esp_pestride, esp_nthreads, & iac_ntasks, iac_rootpe, iac_pestride, iac_nthreads, & -<<<<<<< HEAD:driver-mct/shr/seq_comm_mct.F90 - cpl_ntasks, cpl_rootpe, cpl_pestride, cpl_nthreads -======= cpl_ntasks, cpl_rootpe, cpl_pestride, cpl_nthreads, & info_taskmap_model ->>>>>>> a7b4b52c7... merge mct driver updates into moab:cime/src/drivers/moab/shr/seq_comm_mct.F90 namelist /cime_pes/ & atm_ntasks, atm_rootpe, atm_pestride, atm_nthreads, atm_layout, & @@ -286,11 +288,9 @@ subroutine seq_comm_init(global_comm_in, driver_comm_in, nmlfile, drv_comm_id) esp_ntasks, esp_rootpe, esp_pestride, esp_nthreads, esp_layout, & iac_ntasks, iac_rootpe, iac_pestride, iac_nthreads, iac_layout, & cpl_ntasks, cpl_rootpe, cpl_pestride, cpl_nthreads, & -<<<<<<< HEAD:driver-mct/shr/seq_comm_mct.F90 + info_taskmap_model, info_taskmap_comp, info_mprof, info_mprof_dt -======= - info_taskmap_model, info_taskmap_comp ->>>>>>> a7b4b52c7... merge mct driver updates into moab:cime/src/drivers/moab/shr/seq_comm_mct.F90 + !---------------------------------------------------------- ! make sure this is first pass and set comms unset @@ -361,11 +361,8 @@ subroutine seq_comm_init(global_comm_in, driver_comm_in, nmlfile, drv_comm_id) call comp_pelayout_init(numpes, cpl_ntasks, cpl_rootpe, cpl_pestride, cpl_nthreads) info_taskmap_model = 0 info_taskmap_comp = 0 -<<<<<<< HEAD:driver-mct/shr/seq_comm_mct.F90 info_mprof = 0 info_mprof_dt = 86400 -======= ->>>>>>> a7b4b52c7... merge mct driver updates into moab:cime/src/drivers/moab/shr/seq_comm_mct.F90 ! Read namelist if it exists @@ -405,11 +402,8 @@ subroutine seq_comm_init(global_comm_in, driver_comm_in, nmlfile, drv_comm_id) call shr_mpi_bcast(info_taskmap_model,DRIVER_COMM,'info_taskmap_model') call shr_mpi_bcast(info_taskmap_comp, DRIVER_COMM,'info_taskmap_comp' ) -<<<<<<< HEAD:driver-mct/shr/seq_comm_mct.F90 call shr_mpi_bcast(info_mprof, DRIVER_COMM,'info_mprof') call shr_mpi_bcast(info_mprof_dt,DRIVER_COMM,'info_mprof_dt') -======= ->>>>>>> a7b4b52c7... merge mct driver updates into moab:cime/src/drivers/moab/shr/seq_comm_mct.F90 #ifdef TIMING if (info_taskmap_model > 0) then @@ -441,7 +435,6 @@ subroutine seq_comm_init(global_comm_in, driver_comm_in, nmlfile, drv_comm_id) call shr_sys_flush(logunit) endif -<<<<<<< HEAD:driver-mct/shr/seq_comm_mct.F90 if (info_mprof > 2) then allocate( driver_task_node_map(0:global_numpes-1), stat=ierr) if (ierr /= 0) call shr_sys_abort(trim(subname)//' allocate driver_task_node_map failed ') @@ -462,16 +455,6 @@ subroutine seq_comm_init(global_comm_in, driver_comm_in, nmlfile, drv_comm_id) else call shr_taskmap_write(logunit, DRIVER_COMM, & c_comm_name, & -======= - call t_startf("shr_taskmap_write") - if (drv_inst == 0) then - call shr_taskmap_write(logunit, DRIVER_COMM, & - 'GLOBAL', & - verbose=verbose_taskmap_output) - else - call shr_taskmap_write(logunit, DRIVER_COMM, & - 'DRIVER #'//trim(adjustl(c_drv_inst)), & ->>>>>>> a7b4b52c7... merge mct driver updates into moab:cime/src/drivers/moab/shr/seq_comm_mct.F90 verbose=verbose_taskmap_output) endif call t_stopf("shr_taskmap_write") @@ -624,8 +607,6 @@ subroutine seq_comm_init(global_comm_in, driver_comm_in, nmlfile, drv_comm_id) call mct_world_init(ncomps, DRIVER_COMM, comms, comps) -<<<<<<< HEAD:driver-mct/shr/seq_comm_mct.F90 -======= ierr = iMOAB_InitializeFortran() if (ierr /= 0) then write(logunit,*) trim(subname),' ERROR initialize MOAB ' @@ -648,9 +629,9 @@ subroutine seq_comm_init(global_comm_in, driver_comm_in, nmlfile, drv_comm_id) mblxid = -1 ! iMOAB id for land on coupler pes mbintxla = -1 ! iMOAB id for land intx with atm on coupler pes mpsiid = -1 ! iMOAB for sea-ice + mbixid = -1 ! iMOAB for sea-ice migrated to coupler num_moab_exports = 0 ! mostly used in debugging ->>>>>>> 9f1898ff7... add iulian787/compute_graph changes:cime/src/drivers/moab/shr/seq_comm_mct.F90 deallocate(comps,comms) diff --git a/driver-moab/main/cplcomp_exchange_mod.F90 b/driver-moab/main/cplcomp_exchange_mod.F90 index a2852c3794f8..6b0b496f6e17 100644 --- a/driver-moab/main/cplcomp_exchange_mod.F90 +++ b/driver-moab/main/cplcomp_exchange_mod.F90 @@ -19,7 +19,7 @@ module cplcomp_exchange_mod use seq_comm_mct, only : mlnid , mblxid ! iMOAB app id for land , on land pes and coupler pes use seq_comm_mct, only : mphaid ! iMOAB app id for phys atm; comp atm is 5, phys 5+200 use seq_comm_mct, only : sameg_al ! same grid atm lnd, and land is point cloud - use seq_comm_mct, only : MPSIID ! sea-ice + use seq_comm_mct, only : MPSIID, mbixid ! sea-ice on comp pes and on coupler pes use shr_mpi_mod, only: shr_mpi_max use dimensions_mod, only : np ! for atmosphere @@ -1324,6 +1324,9 @@ subroutine cplcomp_moab_Init(comp) ! sea - ice if (comp%oneletterid == 'i' .and. maxMSID /= -1) then + call seq_comm_getinfo(cplid ,mpigrp=mpigrp_cplid) ! receiver group + call seq_comm_getinfo(id_old,mpigrp=mpigrp_old) ! component group pes + if (MPI_COMM_NULL /= mpicom_old ) then ! it means we are on the component p #ifdef MOABDEBUG outfile = 'wholeSeaIce.h5m'//CHAR(0) @@ -1334,7 +1337,73 @@ subroutine cplcomp_moab_Init(comp) call shr_sys_abort(subname//' ERROR in writing sea-ice') endif #endif +! start copy from ocean code + ! send sea ice mesh to coupler + ierr = iMOAB_SendMesh(MPSIID, mpicom_join, mpigrp_cplid, id_join, partMethod) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in sending sea ice mesh to coupler ' + call shr_sys_abort(subname//' ERROR in sending sea ice mesh to coupler ') + endif + + +! ! define here the tag that will be projected back from atmosphere +! ! TODO where do we want to define this? +! tagnameProj = 'a2oTbot_proj'//CHAR(0) +! tagtype = 1 ! dense, double +! numco = 1 ! one value per cell +! ierr = iMOAB_DefineTagStorage(mpoid, tagnameProj, tagtype, numco, tagindex ) +! ! define more tags +! tagnameProj = 'a2oUbot_proj'//CHAR(0) ! U component of velocity +! ierr = iMOAB_DefineTagStorage(mpoid, tagnameProj, tagtype, numco, tagindex ) +! tagnameProj = 'a2oVbot_proj'//CHAR(0) ! V component of velocity +! ierr = iMOAB_DefineTagStorage(mpoid, tagnameProj, tagtype, numco, tagindex ) +! if (ierr .ne. 0) then +! write(logunit,*) subname,' error in defining tags on ocean comp ' +! call shr_sys_abort(subname//' ERROR in defining tags on ocean comp ') +! endif + + endif + if (MPI_COMM_NULL /= mpicom_new ) then ! we are on the coupler pes + appname = "COUPLE_MPASSI"//CHAR(0) + ! migrated mesh gets another app id, moab moab sea ice to coupler (mbox) + ierr = iMOAB_RegisterFortranApplication(trim(appname), mpicom_new, id_join, mbixid) + ierr = iMOAB_ReceiveMesh(mbixid, mpicom_join, mpigrp_old, id_old) + +! ! define here the tag that will be projected from atmosphere +! tagnameProj = 'a2oTbot_proj'//CHAR(0) ! temperature +! tagtype = 1 ! dense, double +! numco = 1 ! one value per cell +! ierr = iMOAB_DefineTagStorage(mboxid, tagnameProj, tagtype, numco, tagindex ) +! +! ! define more tags +! tagnameProj = 'a2oUbot_proj'//CHAR(0) ! U component of velocity +! ierr = iMOAB_DefineTagStorage(mboxid, tagnameProj, tagtype, numco, tagindex ) +! tagnameProj = 'a2oVbot_proj'//CHAR(0) ! V component of velocity +! ierr = iMOAB_DefineTagStorage(mboxid, tagnameProj, tagtype, numco, tagindex ) +! if (ierr .ne. 0) then +! write(logunit,*) subname,' error in defining tags on ocean coupler ' +! call shr_sys_abort(subname//' ERROR in defining tags on ocean coupler ') +! endif +#ifdef MOABDEBUG +! debug test + outfile = 'recSeaIce.h5m'//CHAR(0) + wopts = ';PARALLEL=WRITE_PART'//CHAR(0) ! +! write out the mesh file to disk + ierr = iMOAB_WriteMesh(mbixid, trim(outfile), trim(wopts)) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in writing sea ice mesh on coupler ' + call shr_sys_abort(subname//' ERROR in writing sea ice mesh on coupler ') + endif +#endif + endif + if (MPSIID .ge. 0) then ! we are on component ocn pes + ierr = iMOAB_FreeSenderBuffers(mpoid, context_id) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in freeing buffers ' + call shr_sys_abort(subname//' ERROR in freeing buffers ') + endif endif +! end copy from ocean code endif end subroutine cplcomp_moab_Init From e10fa57ac544421ecebbaed69d5b2e47446aaf2e Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Sun, 18 Apr 2021 23:37:37 -0500 Subject: [PATCH 086/467] add more messages mostly to know where we are, and figure out where it is stuck [BFB] - Bit-For-Bit --- driver-moab/main/prep_atm_mod.F90 | 31 +++++++++++++++++++++++++++++++ 1 file changed, 31 insertions(+) diff --git a/driver-moab/main/prep_atm_mod.F90 b/driver-moab/main/prep_atm_mod.F90 index 30ba7795ba21..e30edd10e37f 100644 --- a/driver-moab/main/prep_atm_mod.F90 +++ b/driver-moab/main/prep_atm_mod.F90 @@ -204,6 +204,9 @@ subroutine prep_atm_init(infodata, ocn_c2_atm, ice_c2_atm, lnd_c2_atm, iac_c2_at write(logunit,*) subname,' error in computing atm ocn intx' call shr_sys_abort(subname//' ERROR in computing atm ocn intx') endif + if (iamroot_CPLID) then + write(logunit,*) 'iMOAB intersection between atm and ocean with id:', idintx + end if #ifdef MOABDEBUG wopts = CHAR(0) call shr_mpi_commrank( mpicom_CPLID, rank ) @@ -287,8 +290,14 @@ subroutine prep_atm_init(infodata, ocn_c2_atm, ice_c2_atm, lnd_c2_atm, iac_c2_at endif if (sameg_al) then ierr = iMOAB_ComputePointDoFIntersection (mbaxid, mblxid, mbintxla) + if (iamroot_CPLID) then + write(logunit,*) 'iMOAB intersection between atm and land pc with id:', idintx + end if else ierr = iMOAB_ComputeMeshIntersectionOnSphere (mbaxid, mblxid, mbintxla) + if (iamroot_CPLID) then + write(logunit,*) 'iMOAB intersection between atm and land with id:', idintx + end if endif if (ierr .ne. 0) then write(logunit,*) subname,' error in computing atm lnd intx' @@ -368,8 +377,14 @@ subroutine prep_atm_ocn_moab(infodata) if (atm_pg_active ) then ! use mhpgid mesh ierr = iMOAB_CoverageGraph(mpicom_join, mhpgid, mbaxid, mbintxoa, context_id); + if (iamroot_CPLID) then + write(logunit,*) 'iMOAB graph atmpg2-intxao context: ', context_id + end if else ierr = iMOAB_CoverageGraph(mpicom_join, mhid, mbaxid, mbintxoa, context_id); + if (iamroot_CPLID) then + write(logunit,*) 'iMOAB graph atmnp4-intxao context: ', context_id + end if endif if (ierr .ne. 0) then write(logunit,*) subname,' error in computing coverage graph atm/ocn ' @@ -395,6 +410,11 @@ subroutine prep_atm_ocn_moab(infodata) monotonicity = 0 ! noConserve = 0 validate = 1 + if (iamroot_CPLID) then + write(logunit,*) 'launch iMOAB weights with args ', mbintxoa, wgtIdef, & + trim(dm1), orderATM, trim(dm2), orderOCN, & + monotonicity, volumetric, noConserve, validate + end if ierr = iMOAB_ComputeScalarProjectionWeights ( mbintxoa, wgtIdef, & trim(dm1), orderATM, trim(dm2), orderOCN, & monotonicity, volumetric, noConserve, validate, & @@ -403,6 +423,9 @@ subroutine prep_atm_ocn_moab(infodata) write(logunit,*) subname,' error in computing weights atm/ocn ' call shr_sys_abort(subname//' ERROR in computing weights atm/ocn ') endif + if (iamroot_CPLID) then + write(logunit,*) 'finish iMOAB weights in atm-ocn' + endif endif ! only if atm and ocn intersect mbintxoa >= 0 ! compute the comm graph between phys atm and intx-atm-ocn, to be able to send directly from phys atm ! towards coverage mesh on atm for intx to ocean @@ -429,12 +452,20 @@ subroutine prep_atm_ocn_moab(infodata) ! data from phys grid directly to atm-ocn intx , for later projection ! context is the same, atm - ocn intx id ! endif + if (iamroot_CPLID) then + write(logunit,*) 'launch iMOAB graph with args ', & + mphaid, mbintxoa, mpicom_join, mpigrp_old, mpigrp_CPLID, & + typeA, typeB, atm_id, idintx + end if ierr = iMOAB_ComputeCommGraph( mphaid, mbintxoa, mpicom_join, mpigrp_old, mpigrp_CPLID, & typeA, typeB, atm_id, idintx) if (ierr .ne. 0) then write(logunit,*) subname,' error in computing graph phys grid - atm/ocn intx ' call shr_sys_abort(subname//' ERROR in computing graph phys grid - atm/ocn intx ') endif + if (iamroot_CPLID) then + write(logunit,*) 'finish iMOAB graph in atm-land prep ' + end if end subroutine prep_atm_ocn_moab subroutine prep_atm_lnd_moab(infodata) From 0bc0b4c9f8dc7e110277abfaea02eafb8d807009 Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Mon, 19 Apr 2021 00:20:54 -0500 Subject: [PATCH 087/467] use seaice component moab id bad copy from ocean code; need to use sea ice imoab APP id [BFB] - Bit-For-Bit --- driver-moab/main/cplcomp_exchange_mod.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/driver-moab/main/cplcomp_exchange_mod.F90 b/driver-moab/main/cplcomp_exchange_mod.F90 index 6b0b496f6e17..4f5c56f526a5 100644 --- a/driver-moab/main/cplcomp_exchange_mod.F90 +++ b/driver-moab/main/cplcomp_exchange_mod.F90 @@ -1396,8 +1396,8 @@ subroutine cplcomp_moab_Init(comp) endif #endif endif - if (MPSIID .ge. 0) then ! we are on component ocn pes - ierr = iMOAB_FreeSenderBuffers(mpoid, context_id) + if (MPSIID .ge. 0) then ! we are on component sea ice pes + ierr = iMOAB_FreeSenderBuffers(MPSIID, context_id) if (ierr .ne. 0) then write(logunit,*) subname,' error in freeing buffers ' call shr_sys_abort(subname//' ERROR in freeing buffers ') From eca7c965634715d3790e84dcc190a995b3bb0008 Mon Sep 17 00:00:00 2001 From: Jason Sarich Date: Thu, 13 May 2021 12:58:16 -0500 Subject: [PATCH 088/467] Rebase fixes to get mct driver to compile --- components/elm/src/main/surfrdMod.F90 | 4 +-- components/homme/src/tool/CMakeLists.txt | 2 ++ driver-mct/shr/seq_comm_mct.F90 | 42 ------------------------ driver-moab/shr/seq_comm_mct.F90 | 33 +++++++++++++++++++ 4 files changed, 37 insertions(+), 44 deletions(-) diff --git a/components/elm/src/main/surfrdMod.F90 b/components/elm/src/main/surfrdMod.F90 index a178c0d82de5..86ed76d90c43 100644 --- a/components/elm/src/main/surfrdMod.F90 +++ b/components/elm/src/main/surfrdMod.F90 @@ -20,7 +20,7 @@ module surfrdMod use pio #ifdef HAVE_MOAB use mct_mod , only : mct_gsMap - use decompMod , only : get_clmlevel_gsmap + use decompMod , only : get_elmlevel_gsmap ! use spmdMod , only : iam ! rank on the land communicator #endif use spmdMod @@ -253,7 +253,7 @@ subroutine surfrd_get_grid(begg, endg, ldomain, filename, glcfilename) #ifdef HAVE_MOAB ! read xv and yv anyway if (ldomain%nv>=3 ) then - call get_clmlevel_gsmap (grlnd, gsMap) + call get_elmlevel_gsmap (grlnd, gsMap) allocate(rdata3d(nv,ni,nj)) ! transpose from c, as this is fortran vname = 'xv' ! this should be improved in a distributed read, that does not use full grid ni * nj * nv 720*360*4*8 ~ 8Mb diff --git a/components/homme/src/tool/CMakeLists.txt b/components/homme/src/tool/CMakeLists.txt index 8398d0cba47e..725b9b408370 100644 --- a/components/homme/src/tool/CMakeLists.txt +++ b/components/homme/src/tool/CMakeLists.txt @@ -33,6 +33,7 @@ SET(TOOL_SRCS_F90 ${SRC_DIR}/restart_io_mod.F90 ${SRC_DIR}/surfaces_mod.F90 ${SRC_DIR}/test_mod.F90 + ${SRC_DIR}/semoab_mod.F90 # should probably check for moab first ${UTILS_SHARE_DIR}/shr_kind_mod.F90 ${UTILS_SHARE_DIR}/shr_mpi_mod.F90 ${UTILS_SHARE_DIR}/shr_sys_mod.F90 @@ -42,6 +43,7 @@ SET(TOOL_SRCS_F90 ${UTILS_SHARE_DIR}/shr_spfn_mod.F90 ) + # Make SRCS global so the tests can access it SET(EXEC_SOURCES ${TOOL_SRCS_F90}) diff --git a/driver-mct/shr/seq_comm_mct.F90 b/driver-mct/shr/seq_comm_mct.F90 index 08b94d959570..44ec451e6fe6 100644 --- a/driver-mct/shr/seq_comm_mct.F90 +++ b/driver-mct/shr/seq_comm_mct.F90 @@ -213,23 +213,6 @@ module seq_comm_mct logical :: seq_comm_mct_initialized = .false. ! whether this module has been initialized - integer, external :: iMOAB_InitializeFortran - integer, public :: mhid, mhfid, mpoid, mlnid ! homme, homme fine, ocean, land moab ids - integer, public :: mhpgid ! iMOAB id for atm pgx grid, on atm pes; created with se and gll grids - logical, public :: atm_pg_active = .false. ! whether the atm uses FV mesh or not ; made true if fv_nphys > 0 - integer, public :: mphaid ! iMOAB id for atm phys grid, on atm pes - integer, public :: mbaxid ! iMOAB id for atm migrated mesh to coupler pes - integer, public :: mboxid ! iMOAB id for mpas ocean migrated mesh to coupler pes - integer, public :: mbintxoa ! iMOAB id for intx mesh between ocean and atmosphere - integer, public :: mblxid ! iMOAB id for land mesh migrated to coupler pes - logical, public :: sameg_al ! same grid atm and land; used throughout, initialized in lnd_init - integer, public :: mbintxla ! iMOAB id for intx mesh between land and atmosphere - integer, public :: mpsiid ! iMOAB id for sea-ice, mpas model - integer, public :: mbixid ! iMOAB id for sea-ice migrated to coupler pes - integer, public :: mrofid ! iMOAB id of moab rof app - - integer, public :: num_moab_exports ! iMOAB id for atm phys grid, on atm pes - !======================================================================= contains !====================================================================== @@ -607,31 +590,6 @@ subroutine seq_comm_init(global_comm_in, driver_comm_in, nmlfile, drv_comm_id) call mct_world_init(ncomps, DRIVER_COMM, comms, comps) - ierr = iMOAB_InitializeFortran() - if (ierr /= 0) then - write(logunit,*) trim(subname),' ERROR initialize MOAB ' - endif -#ifdef MOABDDD -! write the global_mype , for easier debugging with ddd -! will never use ddd for more than 10 processes - if (global_mype .le. 10) then - write(logunit,*) trim(subname), ' global_mype=', global_mype - endif -#endif - mhid = -1 ! iMOAB id for atm comp, coarse mesh - mhfid = -1 ! iMOAB id for atm, fine mesh - mpoid = -1 ! iMOAB id for ocn comp - mlnid = -1 ! iMOAB id for land comp - mphaid = -1 ! iMOAB id for phys grid on atm pes - mbaxid = -1 ! iMOAB id for atm migrated mesh to coupler pes - mboxid = -1 ! iMOAB id for mpas ocean migrated mesh to coupler pes - mbintxoa = -1 ! iMOAB id for atm intx with mpas ocean - mblxid = -1 ! iMOAB id for land on coupler pes - mbintxla = -1 ! iMOAB id for land intx with atm on coupler pes - mpsiid = -1 ! iMOAB for sea-ice - mbixid = -1 ! iMOAB for sea-ice migrated to coupler - num_moab_exports = 0 ! mostly used in debugging - deallocate(comps,comms) diff --git a/driver-moab/shr/seq_comm_mct.F90 b/driver-moab/shr/seq_comm_mct.F90 index 4664143e0be8..f9f631c8610f 100644 --- a/driver-moab/shr/seq_comm_mct.F90 +++ b/driver-moab/shr/seq_comm_mct.F90 @@ -210,6 +210,22 @@ module seq_comm_mct logical :: seq_comm_mct_initialized = .false. ! whether this module has been initialized + integer, external :: iMOAB_InitializeFortran + integer, public :: mhid, mhfid, mpoid, mlnid ! homme, homme fine, ocean, land moab ids + integer, public :: mhpgid ! iMOAB id for atm pgx grid, on atm pes; created with se and gll grids + logical, public :: atm_pg_active = .false. ! whether the atm uses FV mesh or not ; made true if fv_nphys > 0 + integer, public :: mphaid ! iMOAB id for atm phys grid, on atm pes + integer, public :: mbaxid ! iMOAB id for atm migrated mesh to coupler pes + integer, public :: mboxid ! iMOAB id for mpas ocean migrated mesh to coupler pes + integer, public :: mbintxoa ! iMOAB id for intx mesh between ocean and atmosphere + integer, public :: mblxid ! iMOAB id for land mesh migrated to coupler pes + logical, public :: sameg_al ! same grid atm and land; used throughout, initialized in lnd_init + integer, public :: mbintxla ! iMOAB id for intx mesh between land and atmosphere + integer, public :: mpsiid ! iMOAB id for sea-ice, mpas model + integer, public :: mbixid ! iMOAB id for sea-ice migrated to coupler pes + integer, public :: mrofid ! iMOAB id of moab rof app + integer, public :: num_moab_exports ! iMOAB id for atm phys grid, on atm pes + !======================================================================= contains !====================================================================== @@ -568,6 +584,23 @@ subroutine seq_comm_init(global_comm_in, driver_comm_in, nmlfile, drv_comm_id) call mct_world_init(ncomps, DRIVER_COMM, comms, comps) + ierr = iMOAB_InitializeFortran() + if (ierr /= 0) then + write(logunit,*) trim(subname),' ERROR initialize MOAB ' + endif + mhid = -1 ! iMOAB id for atm comp, coarse mesh + mhfid = -1 ! iMOAB id for atm, fine mesh + mpoid = -1 ! iMOAB id for ocn comp + mlnid = -1 ! iMOAB id for land comp + mphaid = -1 ! iMOAB id for phys grid on atm pes + mbaxid = -1 ! iMOAB id for atm migrated mesh to coupler pes + mboxid = -1 ! iMOAB id for mpas ocean migrated mesh to coupler pes + mbintxoa = -1 ! iMOAB id for atm intx with mpas ocean + mblxid = -1 ! iMOAB id for land on coupler pes + mbintxla = -1 ! iMOAB id for land intx with atm on coupler pes + mpsiid = -1 ! iMOAB for sea-ice + num_moab_exports = 0 ! mostly used in debugging + deallocate(comps,comms) From f802379b47d0ef0fd94a4841d69e00e814826b57 Mon Sep 17 00:00:00 2001 From: Jason Sarich Date: Wed, 2 Jun 2021 13:53:41 -0500 Subject: [PATCH 089/467] Edit some of the driver-moab files that diverged from driver-mct --- .../src/dynamics/se}/semoab_mod.F90 | 17 +- components/elm/src/cpl/lnd_comp_mct.F90 | 2 +- components/homme/src/tool/CMakeLists.txt | 1 - driver-mct/cime_config/buildexe | 4 +- driver-moab/cime_config/buildexe | 5 +- driver-moab/cime_config/buildlib_cmake | 6 +- driver-moab/main/cime_comp_mod.F90 | 331 +++++++++++++++++- driver-moab/main/cime_driver.F90 | 46 ++- driver-moab/main/component_type_mod.F90 | 233 +----------- driver-moab/main/prep_lnd_mod.F90 | 4 + driver-moab/main/prep_ocn_mod.F90 | 8 + driver-moab/main/prep_rof_mod.F90 | 76 ++-- driver-moab/main/seq_diag_mct.F90 | 105 ++---- driver-moab/main/seq_frac_mct.F90 | 23 +- driver-moab/main/seq_hist_mod.F90 | 37 +- driver-moab/main/seq_io_mod.F90 | 124 ++++--- driver-moab/shr/seq_comm_mct.F90 | 47 ++- driver-moab/shr/seq_flds_mod.F90 | 73 ++-- driver-moab/shr/seq_infodata_mod.F90 | 16 +- 19 files changed, 679 insertions(+), 479 deletions(-) rename components/{homme/src/tool => eam/src/dynamics/se}/semoab_mod.F90 (97%) diff --git a/components/homme/src/tool/semoab_mod.F90 b/components/eam/src/dynamics/se/semoab_mod.F90 similarity index 97% rename from components/homme/src/tool/semoab_mod.F90 rename to components/eam/src/dynamics/se/semoab_mod.F90 index a04bd601f5bf..69cbc55a4b88 100644 --- a/components/homme/src/tool/semoab_mod.F90 +++ b/components/eam/src/dynamics/se/semoab_mod.F90 @@ -24,7 +24,7 @@ module semoab_mod use seq_comm_mct, only: MHPGID ! app id on moab side, for PGx style mesh, uniform from se use seq_comm_mct, only: atm_pg_active ! turn it on when PG style mesh active - use dyn_grid, only: fv_nphys, fv_physgrid ! phys grid mesh will be replicated too + use dyn_grid, only: fv_nphys ! phys grid mesh will be replicated too use control_mod, only : west, east, south, north ! 1, 2, 3, 4 implicit none @@ -662,32 +662,28 @@ subroutine create_moab_meshes(par, elem) edge_verts(j) = iv ! to form the local connectivity array if ( vdone_c(edge(1, idx)) .gt. vdone_c(edge(2, idx)) ) pos_edge = .false. if (j .eq. 1) then - current_2d_vertex%lat = fv_physgrid(ie)%corner_lat(1,1,2) - current_2d_vertex%lon = fv_physgrid(ie)%corner_lon(1,1,2) + call gfr_f_get_corner_latlon(ie, 1, 1, 2, current_2d_vertex%lat, current_2d_vertex%lon) if (pos_edge) then vdone_pg (iv) = gdofel(ix + 2) ! elem(ie)%gdofP(2,1) ! gdofel(ix+ (j-1)*np + i) else vdone_pg (iv) = gdofel(ix + np - 1) !elem(ie)%gdofP(np-1,1) ! endif else if (j .eq. 2) then - current_2d_vertex%lat = fv_physgrid(ie)%corner_lat(2,1,3) - current_2d_vertex%lon = fv_physgrid(ie)%corner_lon(2,1,3) + call gfr_f_get_corner_latlon(ie, 2, 1, 3, current_2d_vertex%lat, current_2d_vertex%lon) if (pos_edge) then vdone_pg (iv) = gdofel(ix + (2 - 1) * np + np)!elem(ie)%gdofP(np,2) ! ! gdofel(ix+ (j-1)*np + i) else vdone_pg (iv) = gdofel(ix + (np - 2) * np + np)!elem(ie)%gdofP(np,np - 1) ! endif else if (j .eq. 3) then - current_2d_vertex%lat = fv_physgrid(ie)%corner_lat(2,2,4) - current_2d_vertex%lon = fv_physgrid(ie)%corner_lon(2,2,4) + call gfr_f_get_corner_latlon(ie, 2, 2, 4, current_2d_vertex%lat, current_2d_vertex%lon) if (pos_edge) then vdone_pg (iv) = gdofel(ix+ (np - 1) * np + np - 1)!elem(ie)%gdofP(np-1,np) ! else vdone_pg (iv) = gdofel(ix+ (np-1)*np + 2) !elem(ie)%gdofP(2,np) ! endif else ! if (j .eq. 4) - current_2d_vertex%lat = fv_physgrid(ie)%corner_lat(1,2,1) - current_2d_vertex%lon = fv_physgrid(ie)%corner_lon(1,2,1) + call gfr_f_get_corner_latlon(ie, 1, 2, 1, current_2d_vertex%lat, current_2d_vertex%lon) if (pos_edge) then vdone_pg (iv) = gdofel(ix+ (np - 2)*np + 1) !elem(ie)%gdofP(1,np-1) ! else @@ -706,8 +702,7 @@ subroutine create_moab_meshes(par, elem) enddo ! do j=1,4 ! create the middle vertex too, in the center - current_2d_vertex%lat = fv_physgrid(ie)%corner_lat(1,1,3) - current_2d_vertex%lon = fv_physgrid(ie)%corner_lon(1,1,3) + call gfr_f_get_corner_latlon(ie, 1, 1, 3, current_2d_vertex%lat, current_2d_vertex%lon) iv = nverts_c + edge_index + ie ! middle vertices are after corners, and edge vertices middle_vertex = iv vdone_pg (middle_vertex) = gdofel(ix+ np + 2)!elem(ie)%gdofP(2,2) ! first in the interior, not on edges! diff --git a/components/elm/src/cpl/lnd_comp_mct.F90 b/components/elm/src/cpl/lnd_comp_mct.F90 index 9fd376776ef0..a79bf203ac61 100644 --- a/components/elm/src/cpl/lnd_comp_mct.F90 +++ b/components/elm/src/cpl/lnd_comp_mct.F90 @@ -770,7 +770,7 @@ subroutine init_land_moab(bounds, samegrid_al) use seq_comm_mct, only: sameg_al ! same grid as atm use spmdMod , only: iam ! rank on the land communicator use domainMod , only: ldomain ! ldomain is coming from module, not even passed - use clm_varcon , only: re + use elm_varcon , only: re use shr_const_mod, only: SHR_CONST_PI type(bounds_type) , intent(in) :: bounds diff --git a/components/homme/src/tool/CMakeLists.txt b/components/homme/src/tool/CMakeLists.txt index 725b9b408370..2b42f688583f 100644 --- a/components/homme/src/tool/CMakeLists.txt +++ b/components/homme/src/tool/CMakeLists.txt @@ -33,7 +33,6 @@ SET(TOOL_SRCS_F90 ${SRC_DIR}/restart_io_mod.F90 ${SRC_DIR}/surfaces_mod.F90 ${SRC_DIR}/test_mod.F90 - ${SRC_DIR}/semoab_mod.F90 # should probably check for moab first ${UTILS_SHARE_DIR}/shr_kind_mod.F90 ${UTILS_SHARE_DIR}/shr_mpi_mod.F90 ${UTILS_SHARE_DIR}/shr_sys_mod.F90 diff --git a/driver-mct/cime_config/buildexe b/driver-mct/cime_config/buildexe index 85b1cda8440b..375a697fc5dc 100755 --- a/driver-mct/cime_config/buildexe +++ b/driver-mct/cime_config/buildexe @@ -35,6 +35,7 @@ def _main_func(): atm_model = case.get_value("COMP_ATM") gmake_opts = get_standard_makefile_args(case) blddir = os.path.join(case.get_value("EXEROOT"),"cpl","obj") + srcroot = case.get_value("SRCROOT") if ocn_model == 'mom' or atm_model == "ufsatm": gmake_opts += "USE_FMS=TRUE" @@ -45,7 +46,8 @@ def _main_func(): with open(os.path.join(blddir,'Filepath'), 'w') as out: out.write(os.path.join(caseroot, "SourceMods", "src.drv") + "\n") - out.write(os.path.join(cimeroot, "src", "drivers", "mct", "main") + "\n") + out.write(os.path.join(srcroot, "driver-mct", "main") + "\n") + # build model executable diff --git a/driver-moab/cime_config/buildexe b/driver-moab/cime_config/buildexe index 5ca61bf3d76e..4710b1b521ed 100644 --- a/driver-moab/cime_config/buildexe +++ b/driver-moab/cime_config/buildexe @@ -35,6 +35,7 @@ def _main_func(): atm_model = case.get_value("COMP_ATM") gmake_opts = get_standard_makefile_args(case) blddir = os.path.join(case.get_value("EXEROOT"),"cpl","obj") + srcroot = case.get_value("SRCROOT") if ocn_model == 'mom' or atm_model == "ufsatm": gmake_opts += "USE_FMS=TRUE" @@ -42,10 +43,10 @@ def _main_func(): expect((num_esp is None) or (int(num_esp) == 1), "ESP component restricted to one instance") - + with open(os.path.join(blddir,'Filepath'), 'w') as out: out.write(os.path.join(caseroot, "SourceMods", "src.drv") + "\n") - out.write(os.path.join(cimeroot, "src", "drivers", "moab", "main") + "\n") + out.write(os.path.join(srcroot, "driver-moab", "main") + "\n") # build model executable diff --git a/driver-moab/cime_config/buildlib_cmake b/driver-moab/cime_config/buildlib_cmake index 8120e2e0b4be..2711848f5e0f 100755 --- a/driver-moab/cime_config/buildlib_cmake +++ b/driver-moab/cime_config/buildlib_cmake @@ -21,16 +21,16 @@ def buildlib(bldroot, installpath, case): # pylint: disable=unused-argument ############################################################################### casebuild = case.get_value("CASEBUILD") caseroot = case.get_value("CASEROOT") - cimeroot = case.get_value("CIMEROOT") + srcroot = case.get_value("SRCROOT") num_esp = case.get_value("NUM_COMP_INST_ESP") expect((num_esp is None) or (int(num_esp) == 1), "ESP component restricted to one instance") with open(os.path.join(casebuild, "cplconf", "Filepath"), "w") as out: out.write(os.path.join(caseroot, "SourceMods", "src.drv") + "\n") - out.write(os.path.join(cimeroot, "src", "drivers", "moab", "main") + "\n") + out.write(os.path.join(srcroot, "driver-moab", "main") + "\n") - with open(os.path.join(casebuild, "cplconf", "CCSM_cppdefs"), "w") as out: + with open(os.path.join(casebuild, "cplconf", "CIME_cppdefs"), "w") as out: out.write("") ############################################################################### diff --git a/driver-moab/main/cime_comp_mod.F90 b/driver-moab/main/cime_comp_mod.F90 index cebdd9ae59a3..4ed5a64b734d 100644 --- a/driver-moab/main/cime_comp_mod.F90 +++ b/driver-moab/main/cime_comp_mod.F90 @@ -21,9 +21,10 @@ module cime_comp_mod ! share code & libs !---------------------------------------------------------------------------- use shr_kind_mod, only: r8 => SHR_KIND_R8 + use shr_kind_mod, only: i8 => SHR_KIND_I8 use shr_kind_mod, only: cs => SHR_KIND_CS use shr_kind_mod, only: cl => SHR_KIND_CL - use shr_sys_mod, only: shr_sys_abort, shr_sys_flush + use shr_sys_mod, only: shr_sys_abort, shr_sys_flush, shr_sys_irtc use shr_const_mod, only: shr_const_cday use shr_file_mod, only: shr_file_setLogLevel, shr_file_setLogUnit use shr_file_mod, only: shr_file_setIO, shr_file_getUnit, shr_file_freeUnit @@ -61,7 +62,7 @@ module cime_comp_mod !---------------------------------------------------------------------------- ! mpi comm data & routines, plus logunit and loglevel - use seq_comm_mct, only: CPLID, GLOID, logunit, loglevel, info_taskmap_comp + use seq_comm_mct, only: CPLID, GLOID, logunit, loglevel, info_taskmap_comp, info_taskmap_model, info_mprof, info_mprof_dt use seq_comm_mct, only: ATMID, LNDID, OCNID, ICEID, GLCID, ROFID, WAVID, ESPID use seq_comm_mct, only: ALLATMID,ALLLNDID,ALLOCNID,ALLICEID,ALLGLCID,ALLROFID,ALLWAVID,ALLESPID use seq_comm_mct, only: CPLALLATMID,CPLALLLNDID,CPLALLOCNID,CPLALLICEID @@ -76,8 +77,9 @@ module cime_comp_mod use seq_comm_mct, only: num_inst_total, num_inst_max use seq_comm_mct, only: seq_comm_iamin, seq_comm_name, seq_comm_namelen use seq_comm_mct, only: seq_comm_init, seq_comm_setnthreads, seq_comm_getnthreads - use seq_comm_mct, only: seq_comm_getinfo => seq_comm_setptrs + use seq_comm_mct, only: seq_comm_getinfo => seq_comm_setptrs, seq_comm_gloroot use seq_comm_mct, only: cpl_inst_tag + use seq_comm_mct, only: driver_nnodes, driver_task_node_map ! clock & alarm routines and variables use seq_timemgr_mod, only: seq_timemgr_type @@ -197,7 +199,9 @@ module cime_comp_mod private ! public data - public :: timing_dir, mpicom_GLOID + public :: timing_dir + public :: mpicom_GLOID + public :: cime_pre_init2_lb ! public routines public :: cime_pre_init1 @@ -380,6 +384,8 @@ module cime_comp_mod real(r8) :: cktime_acc(10) ! cktime accumulator array 1 = all, 2 = atm, etc integer :: cktime_cnt(10) ! cktime counter array real(r8) :: max_cplstep_time + real(r8) :: mpi_init_time ! time elapsed in mpi_init call + real(r8) :: cime_pre_init2_lb ! time elapsed in cime_pre_init2 call after call to t_initf character(CL) :: timing_file ! Local path to tprof filename character(CL) :: timing_dir ! timing directory character(CL) :: tchkpt_dir ! timing checkpoint directory @@ -449,6 +455,7 @@ module cime_comp_mod logical :: areafact_samegrid ! areafact samegrid flag logical :: single_column ! scm mode logical + logical :: iop_mode ! iop mode logical real(r8) :: scmlon ! single column lon real(r8) :: scmlat ! single column lat logical :: aqua_planet ! aqua planet mode @@ -558,6 +565,9 @@ module cime_comp_mod !---------------------------------------------------------------------------- real(r8) :: msize,msize0,msize1 ! memory size (high water) real(r8) :: mrss ,mrss0 ,mrss1 ! resident size (current memory use) + real(r8),allocatable :: msizeOnTask(:),mrssOnTask(:) ! msize,mrss on each MPI task + real(r8),allocatable :: msizeOnNode(:),mrssOnNode(:) ! msize,mrss on each node + integer :: mlog !---------------------------------------------------------------------------- ! threading control @@ -596,6 +606,7 @@ module cime_comp_mod integer :: mpicom_CPLALLIACID ! MPI comm for CPLALLIACID integer :: iam_GLOID ! pe number in global id + integer :: npes_GLOID ! global number of pes logical :: iamin_CPLID ! pe associated with CPLID logical :: iamroot_GLOID ! GLOID masterproc logical :: iamroot_CPLID ! CPLID masterproc @@ -609,6 +620,8 @@ module cime_comp_mod logical :: iamin_CPLALLWAVID ! pe associated with CPLALLWAVID logical :: iamin_CPLALLIACID ! pe associated with CPLALLIACID + integer :: atm_rootpe,lnd_rootpe,ice_rootpe,ocn_rootpe,& + glc_rootpe,rof_rootpe,wav_rootpe,iac_rootpe !---------------------------------------------------------------------------- ! complist: list of comps on this pe @@ -679,8 +692,18 @@ subroutine cime_pre_init1(esmf_log_option) character(len=8) :: c_cpl_inst ! coupler instance number character(len=8) :: c_cpl_npes ! number of pes in coupler + integer(i8) :: beg_count ! start time + integer(i8) :: end_count ! end time + integer(i8) :: irtc_rate ! factor to convert time to seconds + + beg_count = shr_sys_irtc(irtc_rate) + call mpi_init(ierr) call shr_mpi_chkerr(ierr,subname//' mpi_init') + + end_count = shr_sys_irtc(irtc_rate) + mpi_init_time = real( (end_count-beg_count), r8)/real(irtc_rate, r8) + call mpi_comm_dup(MPI_COMM_WORLD, global_comm, ierr) call shr_mpi_chkerr(ierr,subname//' mpi_comm_dup') @@ -706,7 +729,7 @@ subroutine cime_pre_init1(esmf_log_option) end if !--- set task based threading counts --- - call seq_comm_getinfo(GLOID,pethreads=pethreads_GLOID,iam=iam_GLOID) + call seq_comm_getinfo(GLOID,pethreads=pethreads_GLOID,iam=iam_GLOID,npes=npes_GLOID) call seq_comm_setnthreads(pethreads_GLOID) !--- get some general data --- @@ -726,6 +749,15 @@ subroutine cime_pre_init1(esmf_log_option) comp_iamin(it) = seq_comm_iamin(comp_id(it)) comp_name(it) = seq_comm_name(comp_id(it)) + atm_rootpe = seq_comm_gloroot(ALLATMID) + lnd_rootpe = seq_comm_gloroot(ALLLNDID) + ice_rootpe = seq_comm_gloroot(ALLICEID) + ocn_rootpe = seq_comm_gloroot(ALLOCNID) + glc_rootpe = seq_comm_gloroot(ALLGLCID) + rof_rootpe = seq_comm_gloroot(ALLROFID) + wav_rootpe = seq_comm_gloroot(ALLWAVID) + iac_rootpe = seq_comm_gloroot(ALLIACID) + do eai = 1,num_inst_atm it=it+1 comp_id(it) = ATMID(eai) @@ -983,6 +1015,10 @@ subroutine cime_pre_init2() real(r8), parameter :: epsilo = shr_const_mwwv/shr_const_mwdair + integer(i8) :: beg_count ! start time + integer(i8) :: end_count ! end time + integer(i8) :: irtc_rate ! factor to convert time to seconds + !---------------------------------------------------------- !| Timer initialization (has to be after mpi init) !---------------------------------------------------------- @@ -994,6 +1030,24 @@ subroutine cime_pre_init2() call t_initf(NLFileName, LogPrint=.true., mpicom=mpicom_GLOID, & MasterTask=iamroot_GLOID,MaxThreads=maxthreads) + !---------------------------------------------------------- + !| Record timer parent/child relationships for what has + ! occurred previously. CPL:INIT timer is stopped in + ! cime_driver. + !---------------------------------------------------------- + call t_startf('CPL:INIT') + call t_adj_detailf(+1) + + call t_startf('CPL:cime_pre_init1') + call t_startstop_valsf('CPL:mpi_init', walltime=mpi_init_time) + call t_stopf('CPL:cime_pre_init1') + + call t_startf('CPL:ESMF_Initialize') + call t_stopf('CPL:ESMF_Initialize') + + call t_startf('CPL:cime_pre_init2') + beg_count = shr_sys_irtc(irtc_rate) + if (iamin_CPLID) then call seq_io_cpl_init() endif @@ -1064,6 +1118,7 @@ subroutine cime_pre_init2() esp_present=esp_present , & iac_present=iac_present , & single_column=single_column , & + iop_mode=iop_mode , & aqua_planet=aqua_planet , & cpl_seq_option=cpl_seq_option , & drv_threading=drv_threading , & @@ -1279,6 +1334,7 @@ subroutine cime_pre_init2() call seq_comm_getinfo(OCNID(ens1), mpicom=mpicom_OCNID) call shr_scam_checkSurface(scmlon, scmlat, & + iop_mode, & OCNID(ens1), mpicom_OCNID, & lnd_present=lnd_present, & ocn_present=ocn_present, & @@ -1299,6 +1355,21 @@ subroutine cime_pre_init2() call pio_closefile(pioid) endif + call t_stopf('CPL:cime_pre_init2') + + ! CPL:cime_pre_init2 timer elapsed time will be double counted + ! in cime_driver. Recording time spent in timer using shr_sys_irtc + ! so that this can be adjusted. Count is started inside the t_startf + ! call and stopped outside the t_stopf call to approximate the portion + ! of the cost of the two clocks in t_startf/t_stopf that is captured + ! by the cime_pre_init2 timer. + end_count = shr_sys_irtc(irtc_rate) + cime_pre_init2_lb = real( (end_count-beg_count), r8)/real(irtc_rate, r8) + + call t_adj_detailf(-1) + ! Remember: CPL:INIT timer is still running, and needs to be stopped + ! in cime_driver.F90. + end subroutine cime_pre_init2 !=============================================================================== @@ -1453,6 +1524,13 @@ subroutine cime_init() complist = trim(complist)//' '//trim(compname) endif enddo + do eri = 1,num_inst_rof + iamin_ID = component_get_iamin_compid(rof(eri)) + if (iamin_ID) then + compname = component_get_name(rof(eri)) + complist = trim(complist)//' '//trim(compname) + endif + enddo do ewi = 1,num_inst_wav iamin_ID = component_get_iamin_compid(wav(ewi)) if (iamin_ID) then @@ -1599,6 +1677,7 @@ subroutine cime_init() if (atm_present) then if (lnd_prognostic) atm_c2_lnd = .true. + if (lnd_present ) atm_c2_lnd = .true. ! needed for aream initialization if (rof_prognostic .and. rof_heat) atm_c2_rof = .true. if (ocn_prognostic) atm_c2_ocn = .true. if (ocn_present ) atm_c2_ocn = .true. ! needed for aoflux calc if aoflux=ocn @@ -2381,6 +2460,9 @@ subroutine cime_run() real(r8) :: tbnds1_offset ! Time offset for call to seq_hist_writeaux logical :: lnd2glc_averaged_now ! Whether lnd2glc averages were taken this timestep logical :: prep_glc_accum_avg_called ! Whether prep_glc_accum_avg has been called this timestep + integer :: i, nodeId + character(len=15) :: c_ymdtod + character(len=18) :: c_mprof_file 101 format( A, i10.8, i8, 12A, A, F8.2, A, F8.2 ) 102 format( A, i10.8, i8, A, 8L3 ) @@ -2389,7 +2471,12 @@ subroutine cime_run() 105 format( A, i10.8, i8, A, f10.2, A, f10.2, A, A, i5, A, A) 108 format( A, f10.2, A, i8.8) 109 format( A, 2f10.3) +110 format( A, 999999999(:, A8, i0, A8, i0) ) +111 format( A, 999999999(:, A12, i0, A12, i0) ) +112 format( A14, 999999999(:, ',', f13.3) ) +113 format( A14, 999999999(:, ',', f13.3) ) + call t_startf ('CPL:cime_run_init') hashint = 0 call seq_infodata_putData(infodata,atm_phase=1,lnd_phase=1,ocn_phase=1,ice_phase=1) @@ -2414,9 +2501,155 @@ subroutine cime_run() ! --- Write out performance data for initialization call seq_timemgr_EClockGetData( EClock_d, curr_ymd=ymd, curr_tod=tod) +#ifndef CPL_BYPASS + ! Report on memory usage + call shr_mem_getusage(msize,mrss) + + ! (For now, just look at the first instance of each component) + if ( iamroot_CPLID .or. & + ocn(ens1)%iamroot_compid .or. & + atm(ens1)%iamroot_compid .or. & + lnd(ens1)%iamroot_compid .or. & + ice(ens1)%iamroot_compid .or. & + glc(ens1)%iamroot_compid .or. & + rof(ens1)%iamroot_compid .or. & + wav(ens1)%iamroot_compid .or. & + iac(ens1)%iamroot_compid) then + + write(logunit,105) ' memory_write: model date = ',ymd,tod, & + ' memory = ',msize,' MB (highwater) ',mrss,' MB (usage)', & + ' (pe=',iam_GLOID,' comps=',trim(complist)//')' + endif + + if (info_mprof > 0) then ! memory profiling is enabled + allocate( msizeOnTask(0:npes_GLOID-1), mrssOnTask(0:npes_GLOID-1), stat=ierr) + if (ierr /= 0) call shr_sys_abort('cime_run: allocate msizeOnTask,mrssOnTask failed') + + ! log from cpl_rootpe only: first, gather from all tasks + msizeOnTask(:) = 0 + mrssOnTask(:) = 0 + call mpi_gather (msize, 1, mpi_real8, & + msizeOnTask, 1, mpi_real8, & + 0, mpicom_GLOID, ierr) + call mpi_gather (mrss, 1, mpi_real8, & + mrssOnTask, 1, mpi_real8, & + 0, mpicom_GLOID, ierr) + + if (info_mprof > 2) then ! aggregate task-level to node-level mem-usage + allocate( msizeOnNode(0:driver_nnodes-1), mrssOnNode(0:driver_nnodes-1), stat=ierr) + if (ierr /= 0) call shr_sys_abort('cime_run: allocate msizeOnNode,mrssOnNode failed') + msizeOnNode(:) = 0 + mrssOnNode(:) = 0 + do i=0,npes_GLOID-1 + nodeId = driver_task_node_map(i) + msizeOnNode(nodeId) = msizeOnNode(nodeId) + msizeOnTask(i) + mrssOnNode(nodeId) = mrssOnNode(nodeId) + mrssOnTask(i) + enddo + endif ! aggregate + + ! write to standalone file + if ( iamroot_CPLID) then + mlog = shr_file_getUnit() + ! log-name: memory.{0,1,2,3,4}.$nsecs.log + write(c_mprof_file,'(a7,i1,a1,i0,a4)') 'memory.',info_mprof,'.',info_mprof_dt,'.log' + inquire(file=trim(c_mprof_file),exist=exists) + if (exists) then + open(mlog, file=trim(c_mprof_file), status='old', position='append') + else + open(mlog, file=trim(c_mprof_file), status='new', position='append') + ! write header row + if (info_mprof == 2) then ! log each task + write(mlog,110) "#TOD", & + (", VSZ_T_",i,", RSS_T_",i,i=0,npes_GLOID-1) + else if (info_mprof == 1) then ! log ROOTPE tasks only + write(mlog,111) "#TOD",& + & ", VSZ_CPL_T_",iam_GLOID, ", RSS_CPL_T_",iam_GLOID, & + & ", VSZ_ATM_T_",atm_rootpe,", RSS_ATM_T_",atm_rootpe, & + & ", VSZ_LND_T_",lnd_rootpe,", RSS_LND_T_",lnd_rootpe, & + & ", VSZ_ICE_T_",ice_rootpe,", RSS_ICE_T_",ice_rootpe, & + & ", VSZ_OCN_T_",ocn_rootpe,", RSS_OCN_T_",ocn_rootpe, & + & ", VSZ_GLC_T_",glc_rootpe,", RSS_GLC_T_",glc_rootpe, & + & ", VSZ_ROF_T_",rof_rootpe,", RSS_ROF_T_",rof_rootpe, & + & ", VSZ_WAV_T_",wav_rootpe,", RSS_WAV_T_",wav_rootpe, & + & ", VSZ_IAC_T_",iac_rootpe,", RSS_IAC_T_",iac_rootpe + else if (info_mprof == 4) then ! log each node + write(mlog,110) "#TOD", & + (", VSZ_N_",i,", RSS_N_",i,i=0,driver_nnodes-1) + else if (info_mprof == 3) then ! log ROOTPE nodes + write(mlog,111) "#TOD",& + & ", VSZ_CPL_N_",driver_task_node_map(iam_GLOID), & + & ", RSS_CPL_N_",driver_task_node_map(iam_GLOID), & + & ", VSZ_ATM_N_",driver_task_node_map(atm_rootpe),& + & ", RSS_ATM_N_",driver_task_node_map(atm_rootpe),& + & ", VSZ_LND_N_",driver_task_node_map(lnd_rootpe),& + & ", RSS_LND_N_",driver_task_node_map(lnd_rootpe),& + & ", VSZ_ICE_N_",driver_task_node_map(ice_rootpe),& + & ", RSS_ICE_N_",driver_task_node_map(ice_rootpe),& + & ", VSZ_OCN_N_",driver_task_node_map(ocn_rootpe),& + & ", RSS_OCN_N_",driver_task_node_map(ocn_rootpe),& + & ", VSZ_GLC_N_",driver_task_node_map(glc_rootpe),& + & ", RSS_GLC_N_",driver_task_node_map(glc_rootpe),& + & ", VSZ_ROF_N_",driver_task_node_map(rof_rootpe),& + & ", RSS_ROF_N_",driver_task_node_map(rof_rootpe),& + & ", VSZ_WAV_N_",driver_task_node_map(wav_rootpe),& + & ", RSS_WAV_N_",driver_task_node_map(wav_rootpe),& + & ", VSZ_IAC_N_",driver_task_node_map(iac_rootpe),& + & ", RSS_IAC_N_",driver_task_node_map(iac_rootpe) + endif + endif + + ! log memory highwater and usage + write(c_ymdtod,'(f14.5)') ymd+tod/86400. + if (info_mprof == 2) then ! log each task + !---YMMDD.HHMMSS,--1234.567,--1234.567, msize,mrss (in MB) for each task + write(mlog,112) c_ymdtod, & + (msizeOnTask(i),mrssOnTask(i),i=0,npes_GLOID-1) + else if (info_mprof == 1) then ! log ROOTPE tasks only + write(mlog,113) c_ymdtod, & + (/msizeOnTask(iam_GLOID), mrssOnTask(iam_GLOID), & + & msizeOnTask(atm_rootpe),mrssOnTask(atm_rootpe), & + & msizeOnTask(lnd_rootpe),mrssOnTask(lnd_rootpe), & + & msizeOnTask(ice_rootpe),mrssOnTask(ice_rootpe), & + & msizeOnTask(ocn_rootpe),mrssOnTask(ocn_rootpe), & + & msizeOnTask(glc_rootpe),mrssOnTask(glc_rootpe), & + & msizeOnTask(rof_rootpe),mrssOnTask(rof_rootpe), & + & msizeOnTask(wav_rootpe),mrssOnTask(wav_rootpe), & + & msizeOnTask(iac_rootpe),mrssOnTask(iac_rootpe)/) + else if (info_mprof == 4) then ! log each node + write(mlog,112) c_ymdtod, & + (msizeOnNode(i),mrssOnNode(i),i=0,driver_nnodes-1) + else if (info_mprof == 3) then ! log ROOTPE nodes + write(mlog,113) c_ymdtod, & + (/msizeOnNode(driver_task_node_map(iam_GLOID)), & + & mrssOnNode(driver_task_node_map(iam_GLOID)), & + & msizeOnNode(driver_task_node_map(atm_rootpe)), & + & mrssOnNode(driver_task_node_map(atm_rootpe)), & + & msizeOnNode(driver_task_node_map(lnd_rootpe)), & + & mrssOnNode(driver_task_node_map(lnd_rootpe)), & + & msizeOnNode(driver_task_node_map(ice_rootpe)), & + & mrssOnNode(driver_task_node_map(ice_rootpe)), & + & msizeOnNode(driver_task_node_map(ocn_rootpe)), & + & mrssOnNode(driver_task_node_map(ocn_rootpe)), & + & msizeOnNode(driver_task_node_map(glc_rootpe)), & + & mrssOnNode(driver_task_node_map(glc_rootpe)), & + & msizeOnNode(driver_task_node_map(rof_rootpe)), & + & mrssOnNode(driver_task_node_map(rof_rootpe)), & + & msizeOnNode(driver_task_node_map(wav_rootpe)), & + & mrssOnNode(driver_task_node_map(wav_rootpe)), & + & msizeOnNode(driver_task_node_map(iac_rootpe)), & + & mrssOnNode(driver_task_node_map(iac_rootpe))/) + else + write(logunit,*) "cime_run: valid info_mprof values:0-4; given:",info_mprof + endif + endif ! iamroot_CPLID + endif ! info_mprof > 0 +#endif + ! Write out a timing file checkpoint write(timing_file,'(a,i8.8,a1,i5.5)') & trim(tchkpt_dir)//"/model_timing"//trim(cpl_inst_tag)//"_",ymd,"_",tod + call t_stopf ('CPL:cime_run_init') + call t_set_prefixf("CPL:INIT_") call cime_write_performance_checkpoint(output_perf,timing_file,mpicom_GLOID) call t_unset_prefixf() @@ -3289,24 +3522,92 @@ subroutine cime_run() endif endif #ifndef CPL_BYPASS - if (tod == 0 .or. info_debug > 1) then + if (tod == 0 .or. info_debug > 1 .or. (mod(tod, info_mprof_dt) == 0)) then + !! Report on memory usage + call shr_mem_getusage(msize,mrss) + !! For now, just look at the first instance of each component - if ( iamroot_CPLID .or. & + if ((tod == 0 .or. info_debug > 1) .and. & + (iamroot_CPLID .or. & ocn(ens1)%iamroot_compid .or. & atm(ens1)%iamroot_compid .or. & lnd(ens1)%iamroot_compid .or. & ice(ens1)%iamroot_compid .or. & glc(ens1)%iamroot_compid .or. & wav(ens1)%iamroot_compid .or. & - iac(ens1)%iamroot_compid) then - call shr_mem_getusage(msize,mrss,.true.) + rof(ens1)%iamroot_compid .or. & + iac(ens1)%iamroot_compid)) then write(logunit,105) ' memory_write: model date = ',ymd,tod, & ' memory = ',msize,' MB (highwater) ',mrss,' MB (usage)', & ' (pe=',iam_GLOID,' comps=',trim(complist)//')' endif - endif + if (info_mprof > 0) then ! memory profiling is enabled + call mpi_gather (msize, 1, mpi_real8, & + msizeOnTask, 1, mpi_real8, & + 0, mpicom_GLOID, ierr) + call mpi_gather (mrss, 1, mpi_real8, & + mrssOnTask, 1, mpi_real8, & + 0, mpicom_GLOID, ierr) + + if (info_mprof > 2) then ! aggregate task-level to node-level mem-usage + msizeOnNode(:) = 0 + mrssOnNode(:) = 0 + do i=0,npes_GLOID-1 + nodeId = driver_task_node_map(i) + msizeOnNode(nodeId) = msizeOnNode(nodeId) + msizeOnTask(i) + mrssOnNode(nodeId) = mrssOnNode(nodeId) + mrssOnTask(i) + enddo + endif + + if (iamroot_CPLID) then + ! log memory highwater and usage + write(c_ymdtod,'(f14.5)') ymd+tod/86400. + if (info_mprof == 2) then ! log each task + !---YMMDD.HHMMSS,--1234.567,--1234.567, msize,mrss (in MB) for each task + write(mlog,112) c_ymdtod, & + (msizeOnTask(i),mrssOnTask(i),i=0,npes_GLOID-1) + else if (info_mprof == 1) then ! ROOTPEs only + write(mlog,113) c_ymdtod, & + (/msizeOnTask(iam_GLOID), mrssOnTask(iam_GLOID), & + & msizeOnTask(atm_rootpe),mrssOnTask(atm_rootpe), & + & msizeOnTask(lnd_rootpe),mrssOnTask(lnd_rootpe), & + & msizeOnTask(ice_rootpe),mrssOnTask(ice_rootpe), & + & msizeOnTask(ocn_rootpe),mrssOnTask(ocn_rootpe), & + & msizeOnTask(glc_rootpe),mrssOnTask(glc_rootpe), & + & msizeOnTask(rof_rootpe),mrssOnTask(rof_rootpe), & + & msizeOnTask(wav_rootpe),mrssOnTask(wav_rootpe), & + & msizeOnTask(iac_rootpe),mrssOnTask(iac_rootpe)/) + else if (info_mprof == 4) then ! log each node + write(mlog,112) c_ymdtod, & + (msizeOnNode(i),mrssOnNode(i),i=0,driver_nnodes-1) + else if (info_mprof == 3) then ! log ROOTPE nodes + write(mlog,113) c_ymdtod, & + (/msizeOnNode(driver_task_node_map(iam_GLOID)), & + & mrssOnNode(driver_task_node_map(iam_GLOID)), & + & msizeOnNode(driver_task_node_map(atm_rootpe)), & + & mrssOnNode(driver_task_node_map(atm_rootpe)), & + & msizeOnNode(driver_task_node_map(lnd_rootpe)), & + & mrssOnNode(driver_task_node_map(lnd_rootpe)), & + & msizeOnNode(driver_task_node_map(ice_rootpe)), & + & mrssOnNode(driver_task_node_map(ice_rootpe)), & + & msizeOnNode(driver_task_node_map(ocn_rootpe)), & + & mrssOnNode(driver_task_node_map(ocn_rootpe)), & + & msizeOnNode(driver_task_node_map(glc_rootpe)), & + & mrssOnNode(driver_task_node_map(glc_rootpe)), & + & msizeOnNode(driver_task_node_map(rof_rootpe)), & + & mrssOnNode(driver_task_node_map(rof_rootpe)), & + & msizeOnNode(driver_task_node_map(wav_rootpe)), & + & mrssOnNode(driver_task_node_map(wav_rootpe)), & + & msizeOnNode(driver_task_node_map(iac_rootpe)), & + & mrssOnNode(driver_task_node_map(iac_rootpe))/) + else + write(logunit,*) "cime_run: valid info_mprof values:0-4; given:",info_mprof + endif + endif ! iamroot_CPLID + endif ! info_mprof > 0 + endif ! tod == 0 #endif if (info_debug > 1) then if (iamroot_CPLID) then @@ -3420,6 +3721,16 @@ subroutine cime_final() write(logunit,FormatR) subname,' pes max memory last usage (MB) = ',mrss1 write(logunit,'(//)') close(logunit) + if (info_mprof > 0) then + close(mlog) + call shr_file_freeUnit(mlog) + endif + endif + if (info_mprof > 0) then + deallocate(msizeOnTask, mrssOnTask) + if (info_mprof > 2) then + deallocate(msizeOnNode, mrssOnNode, driver_task_node_map) + endif endif call t_adj_detailf(-1) diff --git a/driver-moab/main/cime_driver.F90 b/driver-moab/main/cime_driver.F90 index c8cd51e48cde..d52683315725 100644 --- a/driver-moab/main/cime_driver.F90 +++ b/driver-moab/main/cime_driver.F90 @@ -36,6 +36,7 @@ program cime_driver use cime_comp_mod, only : cime_init use cime_comp_mod, only : cime_run use cime_comp_mod, only : cime_final + use cime_comp_mod, only : cime_pre_init2_lb use seq_comm_mct, only : logunit implicit none @@ -45,7 +46,8 @@ program cime_driver !-------------------------------------------------------------------------- integer(i8) :: beg_count, end_count, irtc_rate real(r8) :: cime_pre_init1_time, ESMF_Initialize_time, & - cime_pre_init2_time, cime_init_time_adjustment + cime_pre_init2_time, cime_pre_init2_time_adjustment, & + cime_init_time_adjustment !-------------------------------------------------------------------------- ! For ESMF logging @@ -98,8 +100,12 @@ program cime_driver !-------------------------------------------------------------------------- ! Timer initialization has to be after determination of the maximum number ! of threads used across all components, so called inside of - ! cime_pre_init2, as are t_startf and t_stopf for CPL:INIT and - ! cime_pre_init2. + ! cime_pre_init2, as are t_startf for CPL:INIT and t_startf and t_stopf for + ! cime_pre_init2. t_startf/t_stopf are also called for cime_pre_init1 and + ! cime_ESMF_initialize, to establish the correct parent/child + ! relationships. t_stopf for CPL:INIT is called below. + ! The wallclock times are later adjusted, as needed, for all of these + ! timers, using the timings collected in cime_driver using shr_sys_irtc. !-------------------------------------------------------------------------- beg_count = shr_sys_irtc(irtc_rate) @@ -109,27 +115,41 @@ program cime_driver cime_pre_init2_time = real( (end_count-beg_count), r8)/real(irtc_rate, r8) !-------------------------------------------------------------------------- - ! Call the initialize, run and finalize routines. + ! Call the initialize routines !-------------------------------------------------------------------------- - - call t_startf('CPL:INIT') call t_adj_detailf(+1) - call t_startstop_valsf('CPL:cime_pre_init1', walltime=cime_pre_init1_time) - call t_startstop_valsf('CPL:ESMF_Initialize', walltime=ESMF_Initialize_time) - call t_startstop_valsf('CPL:cime_pre_init2', walltime=cime_pre_init2_time) - call cime_init() call t_adj_detailf(-1) + + !-------------------------------------------------------------------------- + ! Adjust initialization timers, as needed + !-------------------------------------------------------------------------- + call t_startstop_valsf('CPL:cime_pre_init1', walltime=cime_pre_init1_time, & + callcount = 0) + call t_startstop_valsf('CPL:ESMF_Initialize', walltime=ESMF_Initialize_time, & + callcount = 0) + + ! Some of the time for cime_pre_init2 has already been recorded. Adjust for this. + cime_pre_init2_time_adjustment = cime_pre_init2_time - cime_pre_init2_lb + call t_startstop_valsf('CPL:cime_pre_init2', walltime=cime_pre_init2_time_adjustment, & + callcount = 0) + + ! CPL:INIT timer started in cime_pre_init2 call t_stopf('CPL:INIT') + ! Add in the time that was not captured by the CPL:INIT timer (because it was + ! started inside of cime_pre_init2 instead of before cime_pre_init1). cime_init_time_adjustment = cime_pre_init1_time & - + ESMF_Initialize_time & - + cime_pre_init2_time + + ESMF_Initialize_time & + + cime_pre_init2_time_adjustment call t_startstop_valsf('CPL:INIT', walltime=cime_init_time_adjustment, & - callcount=0) + callcount=0) + !-------------------------------------------------------------------------- + ! Call the run and finalize routines. + !-------------------------------------------------------------------------- call cime_run() call cime_final() diff --git a/driver-moab/main/component_type_mod.F90 b/driver-moab/main/component_type_mod.F90 index ff88580db8de..6d222c8a1d54 100644 --- a/driver-moab/main/component_type_mod.F90 +++ b/driver-moab/main/component_type_mod.F90 @@ -14,13 +14,10 @@ module component_type_mod use seq_comm_mct , only: num_inst_ocn, num_inst_ice, num_inst_glc use seq_comm_mct , only: num_inst_wav, num_inst_esp, num_inst_iac use mct_mod - use seq_comm_mct , only: CPLID - use seq_comm_mct , only: seq_comm_getinfo => seq_comm_setptrs - use abortutils , only : endrun + implicit none save private -#include !-------------------------------------------------------------------------- ! Public interfaces @@ -51,9 +48,7 @@ module component_type_mod public :: component_get_name public :: component_get_suffix public :: component_get_iamin_compid -#ifdef MOABDEBUGMCT - public :: expose_mct_grid_moab -#endif + !-------------------------------------------------------------------------- ! Public data !-------------------------------------------------------------------------- @@ -267,228 +262,4 @@ subroutine check_fields(comp, comp_index) endif end subroutine check_fields -#ifdef MOABDEBUGMCT - subroutine expose_mct_grid_moab (comp) - use shr_mpi_mod, only: shr_mpi_commrank, shr_mpi_commsize - use shr_const_mod, only: SHR_CONST_PI - type(component_type), intent(in) :: comp - integer :: lsz - type(mct_gGrid), pointer :: dom - integer :: mpicom_CPLID ! MPI cpl communicator - integer :: imoabAPI - integer :: iamcomp , iamcpl - integer :: ext_id - integer , external :: iMOAB_RegisterFortranApplication, iMOAB_CreateVertices, iMOAB_WriteMesh, & - iMOAB_DefineTagStorage, iMOAB_SetIntTagStorage, iMOAB_SetDoubleTagStorage, & - iMOAB_ResolveSharedEntities - ! local variables to fill in data - integer, dimension(:), allocatable :: vgids - ! retrieve everything we need from mct - ! number of vertices is the size of mct grid - real(r8), dimension(:), allocatable :: moab_vert_coords ! temporary - real(r8) :: latv, lonv - integer dims, i, ilat, ilon, igdx, ierr, tagindex, ixarea, ixfrac - integer tagtype, numco, ent_type - character*100 outfile, wopts, localmeshfile, tagname - character*32 appname - - dims =3 ! store as 3d mesh - - - call seq_comm_getinfo(CPLID, mpicom=mpicom_CPLID) - if (comp%iamin_compid) then - call shr_mpi_commrank(comp%mpicom_compid, iamcomp , 'expose_mct_grid_moab') - dom => component_get_dom_cc(comp) - lsz = mct_gGrid_lsize(dom) - !print *, 'lsize: cc', lsz, ' iamcomp ' ,iamcomp - appname=comp%ntype//"MOAB"//CHAR(0) - ! component instance - ext_id = comp%compid + 100 ! avoid reuse - ierr = iMOAB_RegisterFortranApplication(appname, comp%mpicom_compid, ext_id, imoabAPI) - if (ierr > 0 ) & - call endrun('Error: cannot register moab app') - allocate(moab_vert_coords(lsz*dims)) - allocate(vgids(lsz)) - ilat = MCT_GGrid_indexRA(dom,'lat') - ilon = MCT_GGrid_indexRA(dom,'lon') - igdx = MCT_GGrid_indexIA(dom,'GlobGridNum') - do i = 1, lsz - latv = dom%data%rAttr(ilat, i) *SHR_CONST_PI/180. - lonv = dom%data%rAttr(ilon, i) *SHR_CONST_PI/180. - moab_vert_coords(3*i-2)=COS(latv)*COS(lonv) - moab_vert_coords(3*i-1)=COS(latv)*SIN(lonv) - moab_vert_coords(3*i )=SIN(latv) - vgids(i) = dom%data%iAttr(igdx, i) - enddo - - ierr = iMOAB_CreateVertices(imoabAPI, lsz*3, dims, moab_vert_coords) - if (ierr > 0 ) & - call endrun('Error: fail to create MOAB vertices in land model') - - tagtype = 0 ! dense, integer - numco = 1 - tagname='GLOBAL_ID'//CHAR(0) - ierr = iMOAB_DefineTagStorage(imoabAPI, tagname, tagtype, numco, tagindex ) - if (ierr > 0 ) & - call endrun('Error: fail to retrieve GLOBAL_ID tag ') - - ent_type = 0 ! vertex type - ierr = iMOAB_SetIntTagStorage ( imoabAPI, tagname, lsz , ent_type, vgids) - if (ierr > 0 ) & - call endrun('Error: fail to set GLOBAL_ID tag ') - - ierr = iMOAB_ResolveSharedEntities( imoabAPI, lsz, vgids ); - if (ierr > 0 ) & - call endrun('Error: fail to resolve shared entities') - - !there are no shared entities, but we will set a special partition tag, in order to see the - ! partitions ; it will be visible with a Pseudocolor plot in VisIt - tagname='partition'//CHAR(0) - ierr = iMOAB_DefineTagStorage(imoabAPI, tagname, tagtype, numco, tagindex ) - if (ierr > 0 ) & - call endrun('Error: fail to create new partition tag ') - - vgids = iamcomp - ierr = iMOAB_SetIntTagStorage ( imoabAPI, tagname, lsz , ent_type, vgids) - if (ierr > 0 ) & - call endrun('Error: fail to set partition tag ') - - ! use moab_vert_coords as a data holder for a frac tag and area tag that we will create - ! on the vertices; do not allocate other data array - ! do not be confused by this ! - ixfrac = MCT_GGrid_indexRA(dom,'frac') - ixarea = MCT_GGrid_indexRA(dom,'area') - tagname='frac'//CHAR(0) - tagtype = 1 ! dense, double - ierr = iMOAB_DefineTagStorage(imoabAPI, tagname, tagtype, numco, tagindex ) - if (ierr > 0 ) & - call endrun('Error: fail to create frac tag ') - - do i = 1, lsz - moab_vert_coords(i) = dom%data%rAttr(ixfrac, i) - enddo - ierr = iMOAB_SetDoubleTagStorage ( imoabAPI, tagname, lsz , ent_type, moab_vert_coords) - if (ierr > 0 ) & - call endrun('Error: fail to set frac tag ') - - tagname='area'//CHAR(0) - ierr = iMOAB_DefineTagStorage(imoabAPI, tagname, tagtype, numco, tagindex ) - if (ierr > 0 ) & - call endrun('Error: fail to create area tag ') - do i = 1, lsz - moab_vert_coords(i) = dom%data%rAttr(ixarea, i) ! use the same doubles for second tag :) - enddo - - ierr = iMOAB_SetDoubleTagStorage ( imoabAPI, tagname, lsz , ent_type, moab_vert_coords ) - if (ierr > 0 ) & - call endrun('Error: fail to set area tag ') - - deallocate(moab_vert_coords) - deallocate(vgids) - ! write out the mesh file to disk, in parallel - outfile = 'WHOLE_'//comp%ntype//'.h5m'//CHAR(0) - wopts = 'PARALLEL=WRITE_PART'//CHAR(0) - ierr = iMOAB_WriteMesh(imoabAPI, outfile, wopts) - if (ierr > 0 ) & - call endrun('Error: fail to write the land mesh file') - endif - if (mpicom_CPLID /= MPI_COMM_NULL) then - call shr_mpi_commrank(mpicom_CPLID, iamcpl , 'expose_mct_grid_moab') - dom => component_get_dom_cx(comp) - lsz = mct_gGrid_lsize(dom) - !print *, 'lsize: cx', lsz, ' iamcpl ' , iamcpl - appname=comp%ntype//"CPMOAB"//CHAR(0) - ! component instance - ext_id = comp%compid + 200 ! avoid reuse - ierr = iMOAB_RegisterFortranApplication(appname, mpicom_CPLID, ext_id, imoabAPI) - if (ierr > 0 ) & - call endrun('Error: cannot register moab app') - allocate(moab_vert_coords(lsz*dims)) - allocate(vgids(lsz)) - ilat = MCT_GGrid_indexRA(dom,'lat') - ilon = MCT_GGrid_indexRA(dom,'lon') - igdx = MCT_GGrid_indexIA(dom,'GlobGridNum') - do i = 1, lsz - latv = dom%data%rAttr(ilat, i) *SHR_CONST_PI/180. - lonv = dom%data%rAttr(ilon, i) *SHR_CONST_PI/180. - moab_vert_coords(3*i-2)=COS(latv)*COS(lonv) - moab_vert_coords(3*i-1)=COS(latv)*SIN(lonv) - moab_vert_coords(3*i )=SIN(latv) - vgids(i) = dom%data%iAttr(igdx, i) - enddo - - ierr = iMOAB_CreateVertices(imoabAPI, lsz*3, dims, moab_vert_coords) - if (ierr > 0 ) & - call endrun('Error: fail to create MOAB vertices in land model') - - tagtype = 0 ! dense, integer - numco = 1 - tagname='GLOBAL_ID'//CHAR(0) - ierr = iMOAB_DefineTagStorage(imoabAPI, tagname, tagtype, numco, tagindex ) - if (ierr > 0 ) & - call endrun('Error: fail to retrieve GLOBAL_ID tag ') - - ent_type = 0 ! vertex type - ierr = iMOAB_SetIntTagStorage ( imoabAPI, tagname, lsz , ent_type, vgids) - if (ierr > 0 ) & - call endrun('Error: fail to set GLOBAL_ID tag ') - - ierr = iMOAB_ResolveSharedEntities( imoabAPI, lsz, vgids ); - if (ierr > 0 ) & - call endrun('Error: fail to resolve shared entities') - - !there are no shared entities, but we will set a special partition tag, in order to see the - ! partitions ; it will be visible with a Pseudocolor plot in VisIt - tagname='partition'//CHAR(0) - ierr = iMOAB_DefineTagStorage(imoabAPI, tagname, tagtype, numco, tagindex ) - if (ierr > 0 ) & - call endrun('Error: fail to create new partition tag ') - - vgids = iamcpl - ierr = iMOAB_SetIntTagStorage ( imoabAPI, tagname, lsz , ent_type, vgids) - if (ierr > 0 ) & - call endrun('Error: fail to set partition tag ') - - ! use moab_vert_coords as a data holder for a frac tag and area tag that we will create - ! on the vertices; do not allocate other data array - ! do not be confused by this ! - ixfrac = MCT_GGrid_indexRA(dom,'frac') - ixarea = MCT_GGrid_indexRA(dom,'area') - tagname='frac'//CHAR(0) - tagtype = 1 ! dense, double - ierr = iMOAB_DefineTagStorage(imoabAPI, tagname, tagtype, numco, tagindex ) - if (ierr > 0 ) & - call endrun('Error: fail to create frac tag ') - - do i = 1, lsz - moab_vert_coords(i) = dom%data%rAttr(ixfrac, i) - enddo - ierr = iMOAB_SetDoubleTagStorage ( imoabAPI, tagname, lsz , ent_type, moab_vert_coords) - if (ierr > 0 ) & - call endrun('Error: fail to set frac tag ') - - tagname='area'//CHAR(0) - ierr = iMOAB_DefineTagStorage(imoabAPI, tagname, tagtype, numco, tagindex ) - if (ierr > 0 ) & - call endrun('Error: fail to create area tag ') - do i = 1, lsz - moab_vert_coords(i) = dom%data%rAttr(ixarea, i) ! use the same doubles for second tag :) - enddo - - ierr = iMOAB_SetDoubleTagStorage ( imoabAPI, tagname, lsz , ent_type, moab_vert_coords ) - if (ierr > 0 ) & - call endrun('Error: fail to set area tag ') - - deallocate(moab_vert_coords) - deallocate(vgids) - ! write out the mesh file to disk, in parallel - outfile = 'WHOLE_cx_'//comp%ntype//'.h5m'//CHAR(0) - wopts = 'PARALLEL=WRITE_PART'//CHAR(0) - ierr = iMOAB_WriteMesh(imoabAPI, outfile, wopts) - if (ierr > 0 ) & - call endrun('Error: fail to write the land mesh file') - endif - - end subroutine expose_mct_grid_moab -#endif end module component_type_mod diff --git a/driver-moab/main/prep_lnd_mod.F90 b/driver-moab/main/prep_lnd_mod.F90 index d2e5d601ec5b..23dfa451df9d 100644 --- a/driver-moab/main/prep_lnd_mod.F90 +++ b/driver-moab/main/prep_lnd_mod.F90 @@ -10,6 +10,9 @@ module prep_lnd_mod use seq_comm_mct , only: CPLID, LNDID, logunit use seq_comm_mct , only: seq_comm_getData=>seq_comm_setptrs use seq_infodata_mod, only: seq_infodata_type, seq_infodata_getdata + use seq_comm_mct, only: mlnid ! iMOAB pid for ocean mesh on component pes + use seq_comm_mct, only: mblxid ! iMOAB id for mpas ocean migrated mesh to coupler pes + use seq_comm_mct, only : seq_comm_getinfo => seq_comm_setptrs use seq_map_type_mod use seq_map_mod use seq_flds_mod @@ -47,6 +50,7 @@ module prep_lnd_mod public :: prep_lnd_get_mapper_Sg2l public :: prep_lnd_get_mapper_Fg2l + public :: prep_lnd_migrate_moab !-------------------------------------------------------------------------- ! Private interfaces !-------------------------------------------------------------------------- diff --git a/driver-moab/main/prep_ocn_mod.F90 b/driver-moab/main/prep_ocn_mod.F90 index 40b0961d7752..c928eb3b3916 100644 --- a/driver-moab/main/prep_ocn_mod.F90 +++ b/driver-moab/main/prep_ocn_mod.F90 @@ -10,6 +10,11 @@ module prep_ocn_mod use seq_comm_mct, only: num_inst_max use seq_comm_mct, only: CPLID, OCNID, logunit use seq_comm_mct, only: seq_comm_getData=>seq_comm_setptrs + + use seq_comm_mct, only: mpoid ! iMOAB pid for ocean mesh on component pes + use seq_comm_mct, only: mboxid ! iMOAB id for mpas ocean migrated mesh to coupler pes + use seq_comm_mct, only : seq_comm_getinfo => seq_comm_setptrs + use seq_infodata_mod, only: seq_infodata_type, seq_infodata_getdata use seq_map_type_mod use seq_map_mod @@ -67,6 +72,7 @@ module prep_ocn_mod public :: prep_ocn_get_mapper_Fg2o public :: prep_ocn_get_mapper_Sw2o + public :: prep_ocn_migrate_moab !-------------------------------------------------------------------------- ! Private interfaces !-------------------------------------------------------------------------- @@ -1466,6 +1472,7 @@ function prep_ocn_get_mapper_Sw2o() prep_ocn_get_mapper_Sw2o => mapper_Sw2o end function prep_ocn_get_mapper_Sw2o + ! exposed method to migrate projected tag from coupler pes to ocean pes subroutine prep_ocn_migrate_moab(infodata) !--------------------------------------------------------------- @@ -1539,4 +1546,5 @@ subroutine prep_ocn_migrate_moab(infodata) #endif end subroutine prep_ocn_migrate_moab + end module prep_ocn_mod diff --git a/driver-moab/main/prep_rof_mod.F90 b/driver-moab/main/prep_rof_mod.F90 index d56506f43b8e..d45f607675cf 100644 --- a/driver-moab/main/prep_rof_mod.F90 +++ b/driver-moab/main/prep_rof_mod.F90 @@ -82,6 +82,8 @@ module prep_rof_mod character(CXX) :: lnd2rof_normal_fluxes ! whether the model is being run with a separate irrigation field logical :: have_irrig_field + ! samegrid atm and lnd + logical :: samegrid_al ! samegrid atm and lnd !================================================================================================ contains @@ -175,6 +177,8 @@ subroutine prep_rof_init(infodata, lnd_c2_rof, atm_c2_rof) samegrid_lr = .true. if (trim(lnd_gnam) /= trim(rof_gnam)) samegrid_lr = .false. + samegrid_al = .true. + if (trim(atm_gnam) /= trim(lnd_gnam)) samegrid_al = .false. if (lnd_c2_rof) then if (iamroot_CPLID) then @@ -447,11 +451,15 @@ subroutine prep_rof_merge(l2x_r, a2x_r, fractions_r, x2r_r, cime_model) integer, save :: index_x2r_Faxa_swvdr integer, save :: index_x2r_Faxa_swvdf integer, save :: index_x2r_Faxa_lwdn + + integer, save :: index_l2x_coszen_str + integer, save :: index_x2r_coszen_str - integer, save :: index_lfrac + integer, save :: index_frac + real(r8) :: frac + character(CL) :: fracstr logical, save :: first_time = .true. logical, save :: flds_wiso_rof = .false. - real(r8) :: lfrac integer :: nflds,lsize logical :: iamroot character(CL) :: field ! field string @@ -489,7 +497,6 @@ subroutine prep_rof_merge(l2x_r, a2x_r, fractions_r, x2r_r, cime_model) index_x2r_Flrl_rofsub = mct_aVect_indexRA(x2r_r,'Flrl_rofsub' ) index_x2r_Flrl_rofdto = mct_aVect_indexRA(x2r_r,'Flrl_rofdto' ) index_x2r_Flrl_rofi = mct_aVect_indexRA(x2r_r,'Flrl_rofi' ) - index_x2r_Flrl_demand = mct_aVect_indexRA(x2r_r,'Flrl_demand' ) if (have_irrig_field) then index_x2r_Flrl_irrig = mct_aVect_indexRA(x2r_r,'Flrl_irrig' ) end if @@ -517,27 +524,32 @@ subroutine prep_rof_merge(l2x_r, a2x_r, fractions_r, x2r_r, cime_model) index_x2r_Flrl_rofl_HDO = mct_aVect_indexRA(x2r_r,'Flrl_rofl_HDO' ) index_x2r_Flrl_rofi_HDO = mct_aVect_indexRA(x2r_r,'Flrl_rofi_HDO' ) end if - index_lfrac = mct_aVect_indexRA(fractions_r,"lfrac") - index_lfrac = mct_aVect_indexRA(fractions_r,"lfrac") + if (samegrid_al) then + index_frac = mct_aVect_indexRA(fractions_r,"lfrac") + fracstr = 'lfrac' + else + index_frac = mct_aVect_indexRA(fractions_r,"lfrin") + fracstr = 'lfrin' + endif mrgstr(index_x2r_Flrl_rofsur) = trim(mrgstr(index_x2r_Flrl_rofsur))//' = '// & - 'lfrac*l2x%Flrl_rofsur' + trim(fracstr)//'*l2x%Flrl_rofsur' mrgstr(index_x2r_Flrl_rofgwl) = trim(mrgstr(index_x2r_Flrl_rofgwl))//' = '// & - 'lfrac*l2x%Flrl_rofgwl' + trim(fracstr)//'*l2x%Flrl_rofgwl' mrgstr(index_x2r_Flrl_rofsub) = trim(mrgstr(index_x2r_Flrl_rofsub))//' = '// & - 'lfrac*l2x%Flrl_rofsub' + trim(fracstr)//'*l2x%Flrl_rofsub' mrgstr(index_x2r_Flrl_rofdto) = trim(mrgstr(index_x2r_Flrl_rofdto))//' = '// & - 'lfrac*l2x%Flrl_rofdto' + trim(fracstr)//'*l2x%Flrl_rofdto' mrgstr(index_x2r_Flrl_rofi) = trim(mrgstr(index_x2r_Flrl_rofi))//' = '// & - 'lfrac*l2x%Flrl_rofi' + trim(fracstr)//'*l2x%Flrl_rofi' if (trim(cime_model).eq.'e3sm') then mrgstr(index_x2r_Flrl_demand) = trim(mrgstr(index_x2r_Flrl_demand))//' = '// & - 'lfrac*l2x%Flrl_demand' + trim(fracstr)//'*l2x%Flrl_demand' endif if (have_irrig_field) then mrgstr(index_x2r_Flrl_irrig) = trim(mrgstr(index_x2r_Flrl_irrig))//' = '// & - 'lfrac*l2x%Flrl_irrig' + trim(fracstr)//'*l2x%Flrl_irrig' end if if(trim(cime_model) .eq. 'e3sm') then mrgstr(index_x2r_Flrl_Tqsur) = trim(mrgstr(index_x2r_Flrl_Tqsur))//' = '//'l2x%Flrl_Tqsur' @@ -545,17 +557,17 @@ subroutine prep_rof_merge(l2x_r, a2x_r, fractions_r, x2r_r, cime_model) endif if ( flds_wiso_rof ) then mrgstr(index_x2r_Flrl_rofl_16O) = trim(mrgstr(index_x2r_Flrl_rofl_16O))//' = '// & - 'lfrac*l2x%Flrl_rofl_16O' + trim(fracstr)//'*l2x%Flrl_rofl_16O' mrgstr(index_x2r_Flrl_rofi_16O) = trim(mrgstr(index_x2r_Flrl_rofi_16O))//' = '// & - 'lfrac*l2x%Flrl_rofi_16O' + trim(fracstr)//'*l2x%Flrl_rofi_16O' mrgstr(index_x2r_Flrl_rofl_18O) = trim(mrgstr(index_x2r_Flrl_rofl_18O))//' = '// & - 'lfrac*l2x%Flrl_rofl_18O' + trim(fracstr)//'*l2x%Flrl_rofl_18O' mrgstr(index_x2r_Flrl_rofi_18O) = trim(mrgstr(index_x2r_Flrl_rofi_18O))//' = '// & - 'lfrac*l2x%Flrl_rofi_18O' + trim(fracstr)//'*l2x%Flrl_rofi_18O' mrgstr(index_x2r_Flrl_rofl_HDO) = trim(mrgstr(index_x2r_Flrl_rofl_HDO))//' = '// & - 'lfrac*l2x%Flrl_rofl_HDO' + trim(fracstr)//'*l2x%Flrl_rofl_HDO' mrgstr(index_x2r_Flrl_rofi_HDO) = trim(mrgstr(index_x2r_Flrl_rofi_HDO))//' = '// & - 'lfrac*l2x%Flrl_rofi_HDO' + trim(fracstr)//'*l2x%Flrl_rofi_HDO' end if if ( rof_heat ) then @@ -596,29 +608,29 @@ subroutine prep_rof_merge(l2x_r, a2x_r, fractions_r, x2r_r, cime_model) end if do i = 1,lsize - lfrac = fractions_r%rAttr(index_lfrac,i) - x2r_r%rAttr(index_x2r_Flrl_rofsur,i) = l2x_r%rAttr(index_l2x_Flrl_rofsur,i) * lfrac - x2r_r%rAttr(index_x2r_Flrl_rofgwl,i) = l2x_r%rAttr(index_l2x_Flrl_rofgwl,i) * lfrac - x2r_r%rAttr(index_x2r_Flrl_rofsub,i) = l2x_r%rAttr(index_l2x_Flrl_rofsub,i) * lfrac - x2r_r%rAttr(index_x2r_Flrl_rofdto,i) = l2x_r%rAttr(index_l2x_Flrl_rofdto,i) * lfrac - x2r_r%rAttr(index_x2r_Flrl_rofi,i) = l2x_r%rAttr(index_l2x_Flrl_rofi,i) * lfrac + frac = fractions_r%rAttr(index_frac,i) + x2r_r%rAttr(index_x2r_Flrl_rofsur,i) = l2x_r%rAttr(index_l2x_Flrl_rofsur,i) * frac + x2r_r%rAttr(index_x2r_Flrl_rofgwl,i) = l2x_r%rAttr(index_l2x_Flrl_rofgwl,i) * frac + x2r_r%rAttr(index_x2r_Flrl_rofsub,i) = l2x_r%rAttr(index_l2x_Flrl_rofsub,i) * frac + x2r_r%rAttr(index_x2r_Flrl_rofdto,i) = l2x_r%rAttr(index_l2x_Flrl_rofdto,i) * frac + x2r_r%rAttr(index_x2r_Flrl_rofi,i) = l2x_r%rAttr(index_l2x_Flrl_rofi,i) * frac if (trim(cime_model).eq.'e3sm') then - x2r_r%rAttr(index_x2r_Flrl_demand,i) = l2x_r%rAttr(index_l2x_Flrl_demand,i) * lfrac + x2r_r%rAttr(index_x2r_Flrl_demand,i) = l2x_r%rAttr(index_l2x_Flrl_demand,i) * frac endif if (have_irrig_field) then - x2r_r%rAttr(index_x2r_Flrl_irrig,i) = l2x_r%rAttr(index_l2x_Flrl_irrig,i) * lfrac + x2r_r%rAttr(index_x2r_Flrl_irrig,i) = l2x_r%rAttr(index_l2x_Flrl_irrig,i) * frac end if if(trim(cime_model) .eq. 'e3sm') then x2r_r%rAttr(index_x2r_Flrl_Tqsur,i) = l2x_r%rAttr(index_l2x_Flrl_Tqsur,i) x2r_r%rAttr(index_x2r_Flrl_Tqsub,i) = l2x_r%rAttr(index_l2x_Flrl_Tqsub,i) endif if ( flds_wiso_rof ) then - x2r_r%rAttr(index_x2r_Flrl_rofl_16O,i) = l2x_r%rAttr(index_l2x_Flrl_rofl_16O,i) * lfrac - x2r_r%rAttr(index_x2r_Flrl_rofi_16O,i) = l2x_r%rAttr(index_l2x_Flrl_rofi_16O,i) * lfrac - x2r_r%rAttr(index_x2r_Flrl_rofl_18O,i) = l2x_r%rAttr(index_l2x_Flrl_rofl_18O,i) * lfrac - x2r_r%rAttr(index_x2r_Flrl_rofi_18O,i) = l2x_r%rAttr(index_l2x_Flrl_rofi_18O,i) * lfrac - x2r_r%rAttr(index_x2r_Flrl_rofl_HDO,i) = l2x_r%rAttr(index_l2x_Flrl_rofl_HDO,i) * lfrac - x2r_r%rAttr(index_x2r_Flrl_rofi_HDO,i) = l2x_r%rAttr(index_l2x_Flrl_rofi_HDO,i) * lfrac + x2r_r%rAttr(index_x2r_Flrl_rofl_16O,i) = l2x_r%rAttr(index_l2x_Flrl_rofl_16O,i) * frac + x2r_r%rAttr(index_x2r_Flrl_rofi_16O,i) = l2x_r%rAttr(index_l2x_Flrl_rofi_16O,i) * frac + x2r_r%rAttr(index_x2r_Flrl_rofl_18O,i) = l2x_r%rAttr(index_l2x_Flrl_rofl_18O,i) * frac + x2r_r%rAttr(index_x2r_Flrl_rofi_18O,i) = l2x_r%rAttr(index_l2x_Flrl_rofi_18O,i) * frac + x2r_r%rAttr(index_x2r_Flrl_rofl_HDO,i) = l2x_r%rAttr(index_l2x_Flrl_rofl_HDO,i) * frac + x2r_r%rAttr(index_x2r_Flrl_rofi_HDO,i) = l2x_r%rAttr(index_l2x_Flrl_rofi_HDO,i) * frac end if if ( rof_heat ) then diff --git a/driver-moab/main/seq_diag_mct.F90 b/driver-moab/main/seq_diag_mct.F90 index 0665acafd05d..a41a214c7494 100644 --- a/driver-moab/main/seq_diag_mct.F90 +++ b/driver-moab/main/seq_diag_mct.F90 @@ -137,12 +137,12 @@ module seq_diag_mct integer(in),parameter :: f_hlatf = 8 ! heat : latent, fusion, snow integer(in),parameter :: f_hioff = 9 ! heat : latent, fusion, frozen runoff integer(in),parameter :: f_hsen =10 ! heat : sensible - integer(in),parameter :: f_wfrz =11 ! water: freezing - integer(in),parameter :: f_wmelt =12 ! water: melting - integer(in),parameter :: f_wrain =13 ! water: precip, liquid - integer(in),parameter :: f_wsnow =14 ! water: precip, frozen - integer(in),parameter :: f_wevap =15 ! water: evaporation - integer(in),parameter :: f_wsalt =16 ! water: water equivalent of salt flux + integer(in),parameter :: f_hh2ot =11 ! heat : water temperature + integer(in),parameter :: f_wfrz =12 ! water: freezing + integer(in),parameter :: f_wmelt =13 ! water: melting + integer(in),parameter :: f_wrain =14 ! water: precip, liquid + integer(in),parameter :: f_wsnow =15 ! water: precip, frozen + integer(in),parameter :: f_wevap =16 ! water: evaporation integer(in),parameter :: f_wroff =17 ! water: runoff/flood integer(in),parameter :: f_wioff =18 ! water: frozen runoff integer(in),parameter :: f_wfrz_16O =19 ! water: freezing @@ -171,7 +171,7 @@ module seq_diag_mct integer(in),parameter :: f_a = f_area ! 1st index for area integer(in),parameter :: f_a_end = f_area ! last index for area integer(in),parameter :: f_h = f_hfrz ! 1st index for heat - integer(in),parameter :: f_h_end = f_hsen ! Last index for heat + integer(in),parameter :: f_h_end = f_hh2ot ! Last index for heat integer(in),parameter :: f_w = f_wfrz ! 1st index for water integer(in),parameter :: f_w_end = f_wioff ! Last index for water integer(in),parameter :: f_16O = f_wfrz_16O ! 1st index for 16O water isotope @@ -185,8 +185,8 @@ module seq_diag_mct (/' area',' hfreeze',' hmelt',' hnetsw',' hlwdn', & ' hlwup',' hlatvap',' hlatfus',' hiroff',' hsen', & - ' wfreeze',' wmelt',' wrain',' wsnow', & - ' wevap',' weqsaltf',' wrunoff',' wfrzrof', & + ' hh2otemp',' wfreeze',' wmelt',' wrain',' wsnow', & + ' wevap',' wrunoff',' wfrzrof', & ' wfreeze_16O',' wmelt_16O',' wrain_16O',' wsnow_16O', & ' wevap_16O',' wrunoff_16O',' wfrzrof_16O', & ' wfreeze_18O',' wmelt_18O',' wrain_18O',' wsnow_18O', & @@ -221,6 +221,7 @@ module seq_diag_mct character(len=*),parameter :: latname = 'lat' character(len=*),parameter :: afracname = 'afrac' character(len=*),parameter :: lfracname = 'lfrac' + character(len=*),parameter :: lfrinname = 'lfrin' character(len=*),parameter :: ofracname = 'ofrac' character(len=*),parameter :: ifracname = 'ifrac' @@ -241,6 +242,7 @@ module seq_diag_mct integer :: index_x2a_Faxx_lat integer :: index_x2a_Faxx_sen integer :: index_x2a_Faxx_evap + integer :: index_x2a_Faoo_h2otemp integer :: index_l2x_Fall_swnet integer :: index_l2x_Fall_lwup @@ -273,8 +275,9 @@ module seq_diag_mct integer :: index_x2r_Flrl_rofi integer :: index_x2r_Flrl_irrig - integer :: index_o2x_Fioo_frazil ! currently used by e3sm - integer :: index_o2x_Fioo_q ! currently used by cesm + integer :: index_o2x_Faoo_h2otemp + integer :: index_o2x_Fioo_frazil + integer :: index_o2x_Fioo_q integer :: index_xao_Faox_lwup integer :: index_xao_Faox_lat @@ -310,8 +313,8 @@ module seq_diag_mct integer :: index_x2i_Faxa_lwdn integer :: index_x2i_Faxa_rain integer :: index_x2i_Faxa_snow - integer :: index_x2i_Fioo_frazil !currently used by e3sm - integer :: index_x2i_Fioo_q !currently used by cesm + integer :: index_x2i_Fioo_frazil + integer :: index_x2i_Fioo_q integer :: index_x2i_Fixx_rofi integer :: index_g2x_Fogg_rofl @@ -750,6 +753,8 @@ subroutine seq_diag_atm_mct( atm, frac_a, infodata, do_a2x, do_x2a) index_x2a_Faxx_evap_18O = mct_aVect_indexRA(x2a_a,'Faxx_evap_18O') index_x2a_Faxx_evap_HDO = mct_aVect_indexRA(x2a_a,'Faxx_evap_HDO') end if + + index_x2a_Faoo_h2otemp = mct_aVect_indexRA(x2a_a,'Faoo_h2otemp') end if lSize = mct_avect_lSize(x2a_a) @@ -778,6 +783,7 @@ subroutine seq_diag_atm_mct( atm, frac_a, infodata, do_a2x, do_x2a) nf = f_hlwup; budg_dataL(nf,ic,ip) = budg_dataL(nf,ic,ip) + ca_a*x2a_a%rAttr(index_x2a_Faxx_lwup,n) nf = f_hlatv; budg_dataL(nf,ic,ip) = budg_dataL(nf,ic,ip) + ca_a*x2a_a%rAttr(index_x2a_Faxx_lat,n) nf = f_hsen ; budg_dataL(nf,ic,ip) = budg_dataL(nf,ic,ip) + ca_a*x2a_a%rAttr(index_x2a_Faxx_sen,n) + nf = f_hh2ot; budg_dataL(nf,ic,ip) = budg_dataL(nf,ic,ip) + ca_a*x2a_a%rAttr(index_x2a_Faoo_h2otemp,n) nf = f_wevap; budg_dataL(nf,ic,ip) = budg_dataL(nf,ic,ip) + ca_a*x2a_a%rAttr(index_x2a_Faxx_evap,n) if ( flds_wiso_atm )then @@ -853,7 +859,7 @@ subroutine seq_diag_lnd_mct( lnd, frac_l, infodata, do_l2x, do_x2l) ip = p_inst kArea = mct_aVect_indexRA(dom_l%data,afldname) - kl = mct_aVect_indexRA(frac_l,lfracname) + kl = mct_aVect_indexRA(frac_l,lfrinname) if (present(do_l2x)) then if (first_time) then @@ -1301,7 +1307,6 @@ subroutine seq_diag_ocn_mct( ocn, xao_o, frac_o, infodata, do_o2x, do_x2o, do_xa real(r8) :: ca_i,ca_o ! area of a grid cell logical,save :: first_time = .true. logical,save :: flds_wiso_ocn = .false. - character(len=cs) :: cime_model !----- formats ----- character(*),parameter :: subName = '(seq_diag_ocn_mct) ' @@ -1330,15 +1335,11 @@ subroutine seq_diag_ocn_mct( ocn, xao_o, frac_o, infodata, do_o2x, do_x2o, do_xa ko = mct_aVect_indexRA(frac_o,ofracname) ki = mct_aVect_indexRA(frac_o,ifracname) - call seq_infodata_GetData(infodata, cime_model=cime_model) - if (present(do_o2x)) then if (first_time) then - if (trim(cime_model) == 'e3sm') then - index_o2x_Fioo_frazil = mct_aVect_indexRA(o2x_o,'Fioo_frazil') - else if (trim(cime_model) == 'cesm') then - index_o2x_Fioo_q = mct_aVect_indexRA(o2x_o,'Fioo_q') - end if + index_o2x_Fioo_frazil = mct_aVect_indexRA(o2x_o,'Fioo_frazil') + index_o2x_Fioo_q = mct_aVect_indexRA(o2x_o,'Fioo_q') + index_o2x_Faoo_h2otemp = mct_aVect_indexRA(o2x_o,'Faoo_h2otemp') end if lSize = mct_avect_lSize(o2x_o) @@ -1347,17 +1348,10 @@ subroutine seq_diag_ocn_mct( ocn, xao_o, frac_o, infodata, do_o2x, do_x2o, do_xa ca_o = dom_o%data%rAttr(kArea,n) * frac_o%rAttr(ko,n) ca_i = dom_o%data%rAttr(kArea,n) * frac_o%rAttr(ki,n) nf = f_area; budg_dataL(nf,ic,ip) = budg_dataL(nf,ic,ip) + ca_o - if (trim(cime_model) == 'e3sm') then - nf = f_wfrz; budg_dataL(nf,ic,ip) = budg_dataL(nf,ic,ip) - (ca_o+ca_i)*max(0.0_r8,o2x_o%rAttr(index_o2x_Fioo_frazil,n)) - else if (trim(cime_model) == 'cesm') then - nf = f_hfrz; budg_dataL(nf,ic,ip) = budg_dataL(nf,ic,ip) + (ca_o+ca_i)*max(0.0_r8,o2x_o%rAttr(index_o2x_Fioo_q,n)) - end if + nf = f_wfrz; budg_dataL(nf,ic,ip) = budg_dataL(nf,ic,ip) - (ca_o+ca_i)*max(0.0_r8,o2x_o%rAttr(index_o2x_Fioo_frazil,n)) + nf = f_hfrz; budg_dataL(nf,ic,ip) = budg_dataL(nf,ic,ip) + (ca_o+ca_i)*max(0.0_r8,o2x_o%rAttr(index_o2x_Fioo_q,n)) + nf = f_hh2ot; budg_dataL(nf,ic,ip) = budg_dataL(nf,ic,ip) + (ca_o+ca_i)*o2x_o%rAttr(index_o2x_Faoo_h2otemp,n) end do - if (trim(cime_model) == 'e3sm') then - budg_dataL(f_hfrz,ic,ip) = -budg_dataL(f_wfrz,ic,ip) * shr_const_latice - else if (trim(cime_model) == 'cesm') then - budg_dataL(f_wfrz,ic,ip) = budg_dataL(f_hfrz,ic,ip) * HFLXtoWFLX - end if end if if (present(do_xao)) then @@ -1474,9 +1468,6 @@ subroutine seq_diag_ocn_mct( ocn, xao_o, frac_o, infodata, do_o2x, do_x2o, do_xa (ca_o+ca_i)*(x2o_o%rAttr(index_x2o_Fioi_melth,n)+x2o_o%rAttr(index_x2o_Fioi_bergh,n)) endif - if (trim(cime_model) == 'cesm') then - nf = f_wsalt ; budg_dataL(nf,ic,ip) = budg_dataL(nf,ic,ip) + (ca_o+ca_i)*x2o_o%rAttr(index_x2o_Fioi_salt,n) * SFLXtoWFLX - endif nf = f_hswnet; budg_dataL(nf,ic,ip) = budg_dataL(nf,ic,ip) + (ca_o+ca_i)*x2o_o%rAttr(index_x2o_Foxx_swnet,n) nf = f_hlwdn ; budg_dataL(nf,ic,ip) = budg_dataL(nf,ic,ip) + (ca_o+ca_i)*x2o_o%rAttr(index_x2o_Faxa_lwdn,n) nf = f_wrain ; budg_dataL(nf,ic,ip) = budg_dataL(nf,ic,ip) + (ca_o+ca_i)*x2o_o%rAttr(index_x2o_Faxa_rain,n) @@ -1574,16 +1565,11 @@ subroutine seq_diag_ice_mct( ice, frac_i, infodata, do_i2x, do_x2i) logical,save :: first_time = .true. logical,save :: flds_wiso_ice = .false. logical,save :: flds_wiso_ice_x2i = .false. - character(len=cs) :: cime_model !----- formats ----- character(*),parameter :: subName = '(seq_diag_ice_mct) ' !------------------------------------------------------------------------------- - ! - !------------------------------------------------------------------------------- - - call seq_infodata_GetData(infodata, cime_model=cime_model) !--------------------------------------------------------------------------- ! add values found in this bundle to the budget table @@ -1634,9 +1620,6 @@ subroutine seq_diag_ice_mct( ice, frac_i, infodata, do_i2x, do_x2i) nf = f_area ; budg_dataL(nf,ic,ip) = budg_dataL(nf,ic,ip) + ca_i nf = f_hmelt ; budg_dataL(nf,ic,ip) = budg_dataL(nf,ic,ip) - ca_i*i2x_i%rAttr(index_i2x_Fioi_melth,n) nf = f_wmelt ; budg_dataL(nf,ic,ip) = budg_dataL(nf,ic,ip) - ca_i*i2x_i%rAttr(index_i2x_Fioi_meltw,n) - if (trim(cime_model) == 'cesm') then - nf = f_wsalt ; budg_dataL(nf,ic,ip) = budg_dataL(nf,ic,ip) - ca_i*i2x_i%rAttr(index_i2x_Fioi_salt,n) * SFLXtoWFLX - endif nf = f_hswnet; budg_dataL(nf,ic,ip) = budg_dataL(nf,ic,ip) + ca_i*i2x_i%rAttr(index_i2x_Faii_swnet,n) & - ca_i*i2x_i%rAttr(index_i2x_Fioi_swpen,n) nf = f_hlwup ; budg_dataL(nf,ic,ip) = budg_dataL(nf,ic,ip) + ca_i*i2x_i%rAttr(index_i2x_Faii_lwup,n) @@ -1673,11 +1656,8 @@ subroutine seq_diag_ice_mct( ice, frac_i, infodata, do_i2x, do_x2i) index_x2i_Faxa_lwdn = mct_aVect_indexRA(x2i_i,'Faxa_lwdn') index_x2i_Faxa_rain = mct_aVect_indexRA(x2i_i,'Faxa_rain') index_x2i_Faxa_snow = mct_aVect_indexRA(x2i_i,'Faxa_snow') - if (trim(cime_model) == 'e3sm') then - index_x2i_Fioo_frazil = mct_aVect_indexRA(x2i_i,'Fioo_frazil') - else if (trim(cime_model) == 'cesm') then - index_x2i_Fioo_q = mct_aVect_indexRA(x2i_i,'Fioo_q') - end if + index_x2i_Fioo_frazil = mct_aVect_indexRA(x2i_i,'Fioo_frazil') + index_x2i_Fioo_q = mct_aVect_indexRA(x2i_i,'Fioo_q') index_x2i_Fixx_rofi = mct_aVect_indexRA(x2i_i,'Fixx_rofi') index_x2i_Faxa_rain_16O = mct_aVect_indexRA(x2i_i,'Faxa_rain_16O', perrWith='quiet') @@ -1707,13 +1687,10 @@ subroutine seq_diag_ice_mct( ice, frac_i, infodata, do_i2x, do_x2i) nf = f_wsnow; budg_dataL(nf,ic,ip) = budg_dataL(nf,ic,ip) + ca_i*x2i_i%rAttr(index_x2i_Faxa_snow,n) nf = f_wioff; budg_dataL(nf,ic,ip) = budg_dataL(nf,ic,ip) + ca_i*x2i_i%rAttr(index_x2i_Fixx_rofi,n) - if (trim(cime_model) == 'e3sm') then - nf = f_wfrz ; budg_dataL(nf,ic,ip) = budg_dataL(nf,ic,ip) + & - (ca_o+ca_i)*max(0.0_r8,x2i_i%rAttr(index_x2i_Fioo_frazil,n)) - else if (trim(cime_model) == 'cesm') then - nf = f_hfrz ; budg_dataL(nf,ic,ip) = budg_dataL(nf,ic,ip) - & - (ca_o+ca_i)*max(0.0_r8,x2i_i%rAttr(index_x2i_Fioo_q,n)) - end if + nf = f_wfrz ; budg_dataL(nf,ic,ip) = budg_dataL(nf,ic,ip) + & + (ca_o+ca_i)*max(0.0_r8,x2i_i%rAttr(index_x2i_Fioo_frazil,n)) + nf = f_hfrz ; budg_dataL(nf,ic,ip) = budg_dataL(nf,ic,ip) - & + (ca_o+ca_i)*max(0.0_r8,x2i_i%rAttr(index_x2i_Fioo_q,n)) if ( flds_wiso_ice_x2i )then nf = f_wrain_16O; budg_dataL(nf,ic,ip) = budg_dataL(nf,ic,ip) + & @@ -1739,20 +1716,10 @@ subroutine seq_diag_ice_mct( ice, frac_i, infodata, do_i2x, do_x2i) ic = c_inh_is budg_dataL(f_hlatf,ic,ip) = -budg_dataL(f_wsnow,ic,ip)*shr_const_latice budg_dataL(f_hioff,ic,ip) = -budg_dataL(f_wioff,ic,ip)*shr_const_latice - if (trim(cime_model) == 'e3sm') then - budg_dataL(f_hfrz ,ic,ip) = -budg_dataL(f_wfrz ,ic,ip)*shr_const_latice - else if (trim(cime_model) == 'cesm') then - budg_dataL(f_wfrz ,ic,ip) = budg_dataL(f_hfrz ,ic,ip)*HFLXtoWFLX - end if ic = c_ish_is budg_dataL(f_hlatf,ic,ip) = -budg_dataL(f_wsnow,ic,ip)*shr_const_latice budg_dataL(f_hioff,ic,ip) = -budg_dataL(f_wioff,ic,ip)*shr_const_latice - if (trim(cime_model) == 'e3sm') then - budg_dataL(f_hfrz ,ic,ip) = -budg_dataL(f_wfrz ,ic,ip)*shr_const_latice - else if (trim(cime_model) == 'cesm') then - budg_dataL(f_wfrz ,ic,ip) = budg_dataL(f_hfrz ,ic,ip)*HFLXtoWFLX - end if end if first_time = .false. @@ -1801,7 +1768,6 @@ SUBROUTINE seq_diag_print_mct(EClock, stop_alarm, & integer(in) :: plev ! print level logical :: sumdone ! has a sum been computed yet character(len=40):: str ! string - character(len=cs):: cime_model real(r8) :: dataGpr (f_size,c_size,p_size) ! values to print, scaled and such integer, parameter :: nisotopes = 3 character(len=5), parameter :: isoname(nisotopes) = (/ 'H216O', 'H218O', ' HDO' /) @@ -1820,10 +1786,6 @@ SUBROUTINE seq_diag_print_mct(EClock, stop_alarm, & character(*),parameter :: FA1r="(' ',a12,8f15.8)" !------------------------------------------------------------------------------- - ! - !------------------------------------------------------------------------------- - - call seq_infodata_GetData(infodata, cime_model=cime_model) !------------------------------------------------------------------------------- ! print instantaneous budget data @@ -1927,7 +1889,6 @@ SUBROUTINE seq_diag_print_mct(EClock, stop_alarm, & write(logunit,FAH) subname,trim(str)//' WATER BUDGET (kg/m2s*1e6): period = ',trim(pname(ip)),': date = ',cdate,sec write(logunit,FA0) cname(ica),cname(icl),cname(icn),cname(ics),cname(ico),' *SUM* ' do nf = f_w, f_w_end - if (nf == f_wsalt .and. trim(cime_model) == 'e3sm') cycle write(logunit,FA1) fname(nf),dataGpr(nf,ica,ip),dataGpr(nf,icl,ip), & dataGpr(nf,icn,ip),dataGpr(nf,ics,ip),dataGpr(nf,ico,ip), & dataGpr(nf,ica,ip)+dataGpr(nf,icl,ip)+ & @@ -2018,7 +1979,6 @@ SUBROUTINE seq_diag_print_mct(EClock, stop_alarm, & write(logunit,FAH) subname,trim(str)//' WATER BUDGET (kg/m2s*1e6): period = ',trim(pname(ip)),': date = ',cdate,sec write(logunit,FA0) cname(icar),cname(icxs),cname(icxr),cname(icas),' *SUM* ' do nf = f_w, f_w_end - if (nf == f_wsalt .and. trim(cime_model) == 'e3sm') cycle write(logunit,FA1) fname(nf),-dataGpr(nf,icar,ip),dataGpr(nf,icxs,ip), & dataGpr(nf,icxr,ip),-dataGpr(nf,icas,ip), & -dataGpr(nf,icar,ip)+dataGpr(nf,icxs,ip)+ & @@ -2132,7 +2092,6 @@ SUBROUTINE seq_diag_print_mct(EClock, stop_alarm, & write(logunit,FAH) subname,'NET WATER BUDGET (kg/m2s*1e6): period = ',trim(pname(ip)),': date = ',cdate,sec write(logunit,FA0r) ' atm',' lnd',' rof',' ocn',' ice nh',' ice sh',' glc',' *SUM* ' do nf = f_w, f_w_end - if (nf == f_wsalt .and. trim(cime_model) == 'e3sm') cycle write(logunit,FA1r) fname(nf),dataGpr(nf,c_atm_ar,ip)+dataGpr(nf,c_atm_as,ip), & dataGpr(nf,c_lnd_lr,ip)+dataGpr(nf,c_lnd_ls,ip), & dataGpr(nf,c_rof_rr,ip)+dataGpr(nf,c_rof_rs,ip), & diff --git a/driver-moab/main/seq_frac_mct.F90 b/driver-moab/main/seq_frac_mct.F90 index 11985ab9a58a..d0118e126905 100644 --- a/driver-moab/main/seq_frac_mct.F90 +++ b/driver-moab/main/seq_frac_mct.F90 @@ -22,7 +22,7 @@ ! character(*),parameter :: fraclist_i = 'afrac:ifrac:ofrac' ! character(*),parameter :: fraclist_l = 'afrac:lfrac:lfrin' ! character(*),parameter :: fraclist_g = 'gfrac:lfrac' -! character(*),parameter :: fraclist_r = 'lfrac:rfrac' +! character(*),parameter :: fraclist_r = 'lfrac:lfrin:rfrac' ! ! we assume ocean and ice are on the same grids, same masks ! we assume ocn2atm and ice2atm are masked maps @@ -71,6 +71,7 @@ ! to attempt to preserve non-land gridcells. ! fractions_l(lfrac) = mapa2l(fractions_a(lfrac)) ! fractions_r(lfrac) = mapl2r(fractions_l(lfrac)) +! fractions_r(lfrin) = mapl2r(fractions_l(lfrin)) ! fractions_g(lfrac) = mapl2g(fractions_l(lfrac)) ! ! run-time (frac_set): @@ -99,6 +100,20 @@ ! ! budgets use the standard afrac, ofrac, ifrac, and lfrac to compute ! +! NOTE: In trigrid configurations, lfrin MUST be defined as the +! conservative o2l mapping of the complement of the ocean mask. +! In non-trigrid configurations, lfrin is generally associated with +! the fraction of land grid defined by the surface dataset and might +! be 1 everywhere for instance. In many cases, the non-trigrid +! lfrin is defined to be the conservative o2a mapping of the complement +! of the ocean mask. In this case, it is defined the same as the +! trigrid. But to support all cases, +! for trigrid: +! mapping from the land grid should use the lfrin field (same in non-trigrid) +! budget diagnostics should use lfrin (lfrac in non-trigrid) +! merges in the atm should use lfrac (same in non-trigrid) +! the runoff should use the lfrin fraction in the runoff merge (lfrac in non-trigrid) +! ! fraction and domain checks ! initialization: ! dom_i = mapo2i(dom_o) ! lat, lon, mask, area @@ -273,7 +288,7 @@ subroutine seq_frac_init( infodata, & character(*),parameter :: fraclist_i = 'afrac:ifrac:ofrac' character(*),parameter :: fraclist_l = 'afrac:lfrac:lfrin' character(*),parameter :: fraclist_g = 'gfrac:lfrac' - character(*),parameter :: fraclist_r = 'lfrac:rfrac' + character(*),parameter :: fraclist_r = 'lfrac:lfrin:rfrac' character(*),parameter :: fraclist_w = 'wfrac' character(*),parameter :: fraclist_z = 'afrac:lfrac' @@ -461,7 +476,7 @@ subroutine seq_frac_init( infodata, & endif ! --- finally, set fractions_l(lfrac) from fractions_a(lfrac) - ! --- and fractions_r(lfrac) from fractions_l(lfrac) + ! --- and fractions_r(lfrac:lfrin) from fractions_l(lfrac:lfrin) ! --- and fractions_g(lfrac) from fractions_l(lfrac) if (lnd_present) then @@ -477,7 +492,7 @@ subroutine seq_frac_init( infodata, & end if if (lnd_present .and. rof_present) then mapper_l2r => prep_rof_get_mapper_Fl2r() - call seq_map_map(mapper_l2r, fractions_l, fractions_r, fldlist='lfrac', norm=.false.) + call seq_map_map(mapper_l2r, fractions_l, fractions_r, fldlist='lfrac:lfrin', norm=.false.) endif if (lnd_present .and. glc_present) then mapper_l2g => prep_glc_get_mapper_Fl2g() diff --git a/driver-moab/main/seq_hist_mod.F90 b/driver-moab/main/seq_hist_mod.F90 index 433854932003..d531f90cb945 100644 --- a/driver-moab/main/seq_hist_mod.F90 +++ b/driver-moab/main/seq_hist_mod.F90 @@ -131,7 +131,6 @@ subroutine seq_hist_write(infodata, EClock_d, & atm, lnd, ice, ocn, rof, glc, wav, iac, & fractions_ax, fractions_lx, fractions_ix, fractions_ox, fractions_rx, & fractions_gx, fractions_wx, fractions_zx, cpl_inst_tag) - implicit none ! ! Arguments @@ -168,10 +167,12 @@ subroutine seq_hist_write(infodata, EClock_d, & character(CL) :: hist_file ! Local path to history filename real(r8) :: tbnds(2) ! CF1.0 time bounds logical :: whead,wdata ! for writing restart/history cdf files + integer :: nmask ! location of mask in dom structure character(len=18) :: date_str type(mct_gsMap), pointer :: gsmap type(mct_gGrid), pointer :: dom ! comp domain on cpl pes - character(CL) :: model_doi_url + character(CL) :: model_doi_url + !------------------------------------------------------------------------------- ! !------------------------------------------------------------------------------- @@ -248,17 +249,9 @@ subroutine seq_hist_write(infodata, EClock_d, & end if tbnds = curr_time - !------- tcx nov 2011 tbnds of same values causes problems in ferret - if (tbnds(1) >= tbnds(2)) then - call seq_io_write(hist_file,& - time_units=time_units, time_cal=calendar, time_val=curr_time, & - whead=whead, wdata=wdata) - else - call seq_io_write(hist_file, & - time_units=time_units, time_cal=calendar, time_val=curr_time, & - whead=whead, wdata=wdata, tbnds=tbnds) - endif - + call seq_io_write(hist_file,& + time_units=time_units, time_cal=calendar, time_val=curr_time, & + nt=1,whead=whead, wdata=wdata) if (atm_present) then gsmap => component_get_gsmap_cx(atm(1)) dom => component_get_dom_cx(atm(1)) @@ -355,14 +348,15 @@ subroutine seq_hist_write(infodata, EClock_d, & if (ice_present) then gsmap => component_get_gsmap_cx(ice(1)) dom => component_get_dom_cx(ice(1)) + nmask = mct_aVect_indexRA(dom%data,'mask') call seq_io_write(hist_file, gsmap, dom%data, 'dom_ix', & nx=ice_nx, ny=ice_ny, nt=1, whead=whead, wdata=wdata, pre='domi') call seq_io_write(hist_file, gsmap, fractions_ix, 'fractions_ix', & nx=ice_nx, ny=ice_ny, nt=1, whead=whead, wdata=wdata, pre='fraci') call seq_io_write(hist_file, ice, 'c2x', 'i2x_ix', & - nx=ice_nx, ny=ice_ny, nt=1, whead=whead, wdata=wdata, pre='i2x') + nx=ice_nx, ny=ice_ny, nt=1, whead=whead, wdata=wdata, pre='i2x', mask=dom%data%rattr(nmask,:)) call seq_io_write(hist_file, ice, 'x2c', 'x2i_ix', & - nx=ice_nx, ny=ice_ny, nt=1, whead=whead, wdata=wdata, pre='x2i') + nx=ice_nx, ny=ice_ny, nt=1, whead=whead, wdata=wdata, pre='x2i', mask=dom%data%rattr(nmask,:)) endif if (glc_present) then @@ -404,7 +398,6 @@ subroutine seq_hist_write(infodata, EClock_d, & nx=iac_nx, ny=iac_ny, nt=1, whead=whead, wdata=wdata, pre='x2w') endif enddo - call seq_io_close(hist_file) if (drv_threading) call seq_comm_setnthreads(nthreads_GLOID) endif @@ -480,6 +473,7 @@ subroutine seq_hist_writeavg(infodata, EClock_d, & type(mct_avect), pointer :: c2x ! component->coupler avs on cpl pes type(mct_avect), pointer :: x2c ! coupler->component avs on cpl pes character(CL) :: model_doi_url + !------------------------------------------------------------------------------- ! !------------------------------------------------------------------------------- @@ -862,16 +856,18 @@ subroutine seq_hist_writeavg(infodata, EClock_d, & end if avg_time = 0.5_r8 * (tbnds(1) + tbnds(2)) + !---------- tcx nov 2011 tbnds of same values causes problems in ferret - if (tbnds(1) >= tbnds(2)) then + if (tbnds(1) == tbnds(2)) then call seq_io_write(hist_file, & time_units=time_units, time_cal=calendar, time_val=avg_time, & - whead=whead, wdata=wdata) + whead=whead, wdata=wdata, nt=1) else call seq_io_write(hist_file, & time_units=time_units, time_cal=calendar, time_val=avg_time, & - whead=whead, wdata=wdata, tbnds=tbnds) + whead=whead, wdata=wdata, nt=1, tbnds=tbnds) endif + if (atm_present .and. histavg_atm) then gsmap => component_get_gsmap_cx(atm(1)) dom => component_get_dom_cx(atm(1)) @@ -985,6 +981,7 @@ subroutine seq_hist_writeavg(infodata, EClock_d, & enddo call seq_io_close(hist_file) + if (drv_threading) call seq_comm_setnthreads(nthreads_GLOID) if (atm_present .and. histavg_atm) then @@ -1254,7 +1251,7 @@ subroutine seq_hist_writeaux(infodata, EClock_d, comp, flow, aname, dname, inst_ if (drv_threading) call seq_comm_setnthreads(nthreads_CPLID) if (fk1 == 1) then - call seq_io_wopen(hist_file(found), clobber=.true., file_ind=found, model_doi_url=model_doi_url) + call seq_io_wopen(hist_file(found), clobber=.true., file_ind=found, model_doi_url=model_doi_url, set_fill=.true.) endif ! loop twice, first time write header, second time write data for perf diff --git a/driver-moab/main/seq_io_mod.F90 b/driver-moab/main/seq_io_mod.F90 index 40d62278f6dd..d1ac852b095e 100644 --- a/driver-moab/main/seq_io_mod.F90 +++ b/driver-moab/main/seq_io_mod.F90 @@ -132,7 +132,7 @@ end subroutine seq_io_cpl_init ! ! !INTERFACE: ------------------------------------------------------------------ - subroutine seq_io_wopen(filename,clobber,file_ind, model_doi_url) + subroutine seq_io_wopen(filename,clobber,file_ind, model_doi_url, set_fill) ! !INPUT/OUTPUT PARAMETERS: implicit none @@ -140,9 +140,9 @@ subroutine seq_io_wopen(filename,clobber,file_ind, model_doi_url) logical,optional,intent(in):: clobber integer,optional,intent(in):: file_ind character(CL), optional, intent(in) :: model_doi_url - + logical, optional, intent(in) :: set_fill !EOP - + integer :: lset_fill = PIO_NOFILL, old_set_fill logical :: exists logical :: lclobber integer :: iam,mpicom @@ -158,7 +158,11 @@ subroutine seq_io_wopen(filename,clobber,file_ind, model_doi_url) !------------------------------------------------------------------------------- lversion=trim(version0) - +#ifdef PIO2 + if(present(set_fill)) then + if(set_fill) lset_fill = PIO_FILL + endif +#endif lclobber = .false. if (present(clobber)) lclobber=clobber @@ -168,7 +172,7 @@ subroutine seq_io_wopen(filename,clobber,file_ind, model_doi_url) lfile_ind = 0 if (present(file_ind)) lfile_ind=file_ind - call seq_comm_setptrs(CPLID, iam=iam, mpicom=mpicom) + call seq_comm_setptrs(CPLID, iam=iam, mpicom=mpicom) if (.not. pio_file_is_open(cpl_io_file(lfile_ind))) then ! filename not open @@ -186,6 +190,9 @@ subroutine seq_io_wopen(filename,clobber,file_ind, model_doi_url) rcode = pio_createfile(cpl_io_subsystem, cpl_io_file(lfile_ind), cpl_pio_iotype, trim(filename), nmode) if(iam==0) write(logunit,*) subname,' create file ',trim(filename) +#ifdef PIO2 + rcode = pio_set_fill(cpl_io_file(lfile_ind), lset_fill, old_set_fill) +#endif rcode = pio_put_att(cpl_io_file(lfile_ind),pio_global,"file_version",version) rcode = pio_put_att(cpl_io_file(lfile_ind),pio_global,"model_doi_url",lmodel_doi_url) else @@ -376,7 +383,7 @@ end function seq_io_sec2hms ! !INTERFACE: ------------------------------------------------------------------ subroutine seq_io_write_av(filename,gsmap,AV,dname,whead,wdata,nx,ny,nt,fillval,pre,tavg,& - use_float, file_ind, scolumn) + use_float, file_ind, mask, scolumn) ! !INPUT/OUTPUT PARAMETERS: implicit none @@ -395,7 +402,7 @@ subroutine seq_io_write_av(filename,gsmap,AV,dname,whead,wdata,nx,ny,nt,fillval, logical,optional,intent(in) :: use_float ! write output as float rather than double integer,optional,intent(in) :: file_ind logical,optional,intent(in) :: scolumn ! single column model flag - + real(r8),optional,intent(in) :: mask(:) !EOP integer(in) :: rcode @@ -425,6 +432,7 @@ subroutine seq_io_write_av(filename,gsmap,AV,dname,whead,wdata,nx,ny,nt,fillval, logical :: lcolumn real(r8), allocatable :: tmpdata(:) + real(r4), allocatable :: tmpr4data(:) !------------------------------------------------------------------------------- ! @@ -479,7 +487,7 @@ subroutine seq_io_write_av(filename,gsmap,AV,dname,whead,wdata,nx,ny,nt,fillval, if (present(ny)) then if (ny /= 0) lny = ny endif - if (lnx*lny /= ng .and. .not. lcolumn) then + if (lnx*lny /= ng .and. .not. lcolumn) then if(iam==0) write(logunit,*) subname,' ERROR: grid2d size not consistent ',ng,lnx,lny,trim(dname) call shr_sys_abort(subname//'ERROR: grid2d size not consistent ') endif @@ -528,10 +536,16 @@ subroutine seq_io_write_av(filename,gsmap,AV,dname,whead,wdata,nx,ny,nt,fillval, if (lwdata) then call mct_gsmap_OrderedPoints(gsmap, iam, Dof) - call pio_initdecomp(cpl_io_subsystem, pio_double, (/lnx,lny/), dof, iodesc) ns = size(dof) + if(luse_float) then + allocate(tmpr4data(ns)) + call pio_initdecomp(cpl_io_subsystem, pio_real, (/lnx,lny/), dof, iodesc) + else + allocate(tmpdata(ns)) + call pio_initdecomp(cpl_io_subsystem, pio_double, (/lnx,lny/), dof, iodesc) + endif deallocate(dof) - allocate(tmpdata(ns)) + do k = 1,nf call mct_aVect_getRList(mstring,k,AV) itemc = mct_string_toChar(mstring) @@ -541,12 +555,34 @@ subroutine seq_io_write_av(filename,gsmap,AV,dname,whead,wdata,nx,ny,nt,fillval, name1 = trim(lpre)//'_'//trim(itemc) rcode = pio_inq_varid(cpl_io_file(lfile_ind),trim(name1),varid) call pio_setframe(cpl_io_file(lfile_ind),varid,frame) - tmpdata = av%rattr(k,:) - call pio_write_darray(cpl_io_file(lfile_ind), varid, iodesc, tmpdata, rcode, fillval=lfillvalue) + if(luse_float) then + if(present(mask)) then + where(mask .ne. 0) + tmpr4data = real(av%rattr(k,:), kind=r4) + elsewhere + tmpr4data = real(lfillvalue, kind=r4) + end where + else + tmpr4data = real(av%rattr(k,:), kind=r4) + endif + call pio_write_darray(cpl_io_file(lfile_ind), varid, iodesc, tmpr4data, rcode, fillval=real(lfillvalue, kind=r4)) + else + if(present(mask)) then + where(mask .ne. 0) + tmpdata = av%rattr(k,:) + elsewhere + tmpdata = lfillvalue + end where + else + tmpdata = av%rattr(k,:) + endif + call pio_write_darray(cpl_io_file(lfile_ind), varid, iodesc, tmpdata, rcode, fillval=lfillvalue) + endif !-------tcraig endif enddo - deallocate(tmpdata) + if(allocated(tmpdata)) deallocate(tmpdata) + if(allocated(tmpr4data)) deallocate(tmpr4data) call pio_freedecomp(cpl_io_file(lfile_ind), iodesc) end if @@ -633,7 +669,7 @@ subroutine seq_io_write_avs(filename,gsmap,AVS,dname,whead,wdata,nx,ny,nt,fillva lwhead = .true. lwdata = .true. - lcolumn = .false. + lcolumn = .false. if (present(whead)) lwhead = whead if (present(wdata)) lwdata = wdata if (present(scolumn)) lcolumn = scolumn @@ -674,7 +710,7 @@ subroutine seq_io_write_avs(filename,gsmap,AVS,dname,whead,wdata,nx,ny,nt,fillva if (present(ny)) then if (ny /= 0) lny = ny endif - if (lnx*lny /= ng .and. .not. lcolumn) then + if (lnx*lny /= ng .and. .not. lcolumn) then if(iam==0) write(logunit,*) subname,' ERROR: grid2d size not consistent ',ng,lnx,lny,trim(dname) call shr_sys_abort(subname//' ERROR: grid2d size not consistent ') endif @@ -756,7 +792,7 @@ subroutine seq_io_write_avs(filename,gsmap,AVS,dname,whead,wdata,nx,ny,nt,fillva call mct_aVect_getRList(mstring,k,AVS(1)) itemc = mct_string_toChar(mstring) call mct_string_clean(mstring) - !-------tcraig, this is a temporary mod to NOT write hgt + !------- this is a temporary mod to NOT write hgt if (trim(itemc) /= "hgt") then name1 = trim(lpre)//'_'//trim(itemc) rcode = pio_inq_varid(cpl_io_file(lfile_ind),trim(name1),varid) @@ -767,13 +803,10 @@ subroutine seq_io_write_avs(filename,gsmap,AVS,dname,whead,wdata,nx,ny,nt,fillva n = n + ns enddo call pio_write_darray(cpl_io_file(lfile_ind), varid, iodesc, data, rcode, fillval=lfillvalue) - call pio_setdebuglevel(0) - !-------tcraig endif enddo - - deallocate(data) call pio_freedecomp(cpl_io_file(lfile_ind), iodesc) + deallocate(data) end if end subroutine seq_io_write_avs @@ -792,7 +825,7 @@ end subroutine seq_io_write_avs ! !INTERFACE: ------------------------------------------------------------------ subroutine seq_io_write_avscomp(filename, comp, flow, dname, & - whead, wdata, nx, ny, nt, fillval, pre, tavg, use_float, file_ind, scolumn) + whead, wdata, nx, ny, nt, fillval, pre, tavg, use_float, file_ind, scolumn, mask) ! !INPUT/OUTPUT PARAMETERS: implicit none @@ -810,8 +843,8 @@ subroutine seq_io_write_avscomp(filename, comp, flow, dname, & logical ,optional,intent(in) :: tavg ! is this a tavg logical ,optional,intent(in) :: use_float ! write output as float rather than double integer ,optional,intent(in) :: file_ind - logical ,optional,intent(in) :: scolumn ! single column model flag - + logical ,optional,intent(in) :: scolumn ! single column model flag + real(r8) ,optional,intent(in) :: mask(:) !EOP type(mct_gsMap), pointer :: gsmap ! global seg map on coupler processes @@ -862,7 +895,7 @@ subroutine seq_io_write_avscomp(filename, comp, flow, dname, & lwhead = .true. lwdata = .true. - lcolumn = .false. + lcolumn = .false. if (present(whead)) lwhead = whead if (present(wdata)) lwdata = wdata if (present(scolumn)) lcolumn = scolumn @@ -1001,18 +1034,28 @@ subroutine seq_io_write_avscomp(filename, comp, flow, dname, & do k1 = 1,ni if (trim(flow) == 'x2c') avcomp => component_get_x2c_cx(comp(k1)) if (trim(flow) == 'c2x') avcomp => component_get_c2x_cx(comp(k1)) - do k2 = 1,ns - n = n + 1 - data(n) = avcomp%rAttr(k,k2) - enddo + if (present(mask)) then + do k2=1,ns + n = n + 1 + if(mask(k2) /= 0) then + data(n) = avcomp%rattr(k,k2) + else + data(n) = lfillvalue + end if + end do + else + do k2 = 1,ns + n = n + 1 + data(n) = avcomp%rAttr(k,k2) + enddo + endif enddo call pio_write_darray(cpl_io_file(lfile_ind), varid, iodesc, data, rcode, fillval=lfillvalue) - !-------tcraig endif enddo - deallocate(data) call pio_freedecomp(cpl_io_file(lfile_ind), iodesc) + deallocate(data) end if end subroutine seq_io_write_avscomp @@ -1438,12 +1481,12 @@ subroutine seq_io_write_time(filename,time_units,time_cal,time_val,nt,whead,wdat integer(in) :: dimid2(2) type(var_desc_t) :: varid logical :: lwhead, lwdata - integer :: start(4),count(4) + integer :: start(2),count(2) character(len=shr_cal_calMaxLen) :: lcalendar real(r8) :: time_val_1d(1) integer :: lfile_ind character(*),parameter :: subName = '(seq_io_write_time) ' - + integer :: ndims !------------------------------------------------------------------------------- ! !------------------------------------------------------------------------------- @@ -1484,23 +1527,24 @@ subroutine seq_io_write_time(filename,time_units,time_cal,time_val,nt,whead,wdat endif if (lwdata) then - start = 1 - count = 1 + rcode = pio_inq_varid(cpl_io_file(lfile_ind),'time',varid) if (present(nt)) then - start(1) = nt + rcode = pio_put_var(cpl_io_file(lfile_ind),varid,(/nt/),time_val) + else + rcode = pio_put_var(cpl_io_file(lfile_ind),varid,time_val) endif - time_val_1d(1) = time_val - rcode = pio_inq_varid(cpl_io_file(lfile_ind),'time',varid) - rcode = pio_put_var(cpl_io_file(lfile_ind),varid,start,count,time_val_1d) if (present(tbnds)) then rcode = pio_inq_varid(cpl_io_file(lfile_ind),'time_bnds',varid) start = 1 - count = 1 + count = 0 + ndims = 1 if (present(nt)) then start(2) = nt + ndims = 2 endif count(1) = 2 - rcode = pio_put_var(cpl_io_file(lfile_ind),varid,start,count,tbnds) + count(2) = 1 + rcode = pio_put_var(cpl_io_file(lfile_ind),varid,start(1:ndims),count(1:ndims),tbnds) endif ! write(logunit,*) subname,' wrote time ',lwhead,lwdata diff --git a/driver-moab/shr/seq_comm_mct.F90 b/driver-moab/shr/seq_comm_mct.F90 index f9f631c8610f..5b74f0b123fe 100644 --- a/driver-moab/shr/seq_comm_mct.F90 +++ b/driver-moab/shr/seq_comm_mct.F90 @@ -161,7 +161,10 @@ module seq_comm_mct ! taskmap output level specifications for components ! (0:no output, 1:compact, 2:verbose) - integer, public :: info_taskmap_comp + integer, public :: info_taskmap_model, info_taskmap_comp + integer, public :: driver_nnodes + integer, public, allocatable :: driver_task_node_map(:) + integer, public :: info_mprof, info_mprof_dt ! suffix for log and timing files if multi coupler driver character(len=seq_comm_namelen), public :: cpl_inst_tag @@ -224,6 +227,8 @@ module seq_comm_mct integer, public :: mpsiid ! iMOAB id for sea-ice, mpas model integer, public :: mbixid ! iMOAB id for sea-ice migrated to coupler pes integer, public :: mrofid ! iMOAB id of moab rof app + integer, public :: mbrxid ! iMOAB id of moab rof migrated to coupler pes + integer, public :: num_moab_exports ! iMOAB id for atm phys grid, on atm pes !======================================================================= @@ -257,6 +262,7 @@ subroutine seq_comm_init(global_comm_in, driver_comm_in, nmlfile, drv_comm_id) integer :: drv_inst character(len=8) :: c_drv_inst ! driver instance number character(len=8) :: c_driver_numpes ! number of pes in driver + character(len=16):: c_comm_name ! comm. name character(len=seq_comm_namelen) :: valid_comps(ncomps) integer :: & @@ -269,8 +275,7 @@ subroutine seq_comm_init(global_comm_in, driver_comm_in, nmlfile, drv_comm_id) ocn_ntasks, ocn_rootpe, ocn_pestride, ocn_nthreads, & esp_ntasks, esp_rootpe, esp_pestride, esp_nthreads, & iac_ntasks, iac_rootpe, iac_pestride, iac_nthreads, & - cpl_ntasks, cpl_rootpe, cpl_pestride, cpl_nthreads, & - info_taskmap_model + cpl_ntasks, cpl_rootpe, cpl_pestride, cpl_nthreads namelist /cime_pes/ & atm_ntasks, atm_rootpe, atm_pestride, atm_nthreads, atm_layout, & @@ -283,7 +288,7 @@ subroutine seq_comm_init(global_comm_in, driver_comm_in, nmlfile, drv_comm_id) esp_ntasks, esp_rootpe, esp_pestride, esp_nthreads, esp_layout, & iac_ntasks, iac_rootpe, iac_pestride, iac_nthreads, iac_layout, & cpl_ntasks, cpl_rootpe, cpl_pestride, cpl_nthreads, & - info_taskmap_model, info_taskmap_comp + info_taskmap_model, info_taskmap_comp, info_mprof, info_mprof_dt !---------------------------------------------------------- ! make sure this is first pass and set comms unset @@ -354,6 +359,8 @@ subroutine seq_comm_init(global_comm_in, driver_comm_in, nmlfile, drv_comm_id) call comp_pelayout_init(numpes, cpl_ntasks, cpl_rootpe, cpl_pestride, cpl_nthreads) info_taskmap_model = 0 info_taskmap_comp = 0 + info_mprof = 0 + info_mprof_dt = 86400 ! Read namelist if it exists @@ -393,6 +400,8 @@ subroutine seq_comm_init(global_comm_in, driver_comm_in, nmlfile, drv_comm_id) call shr_mpi_bcast(info_taskmap_model,DRIVER_COMM,'info_taskmap_model') call shr_mpi_bcast(info_taskmap_comp, DRIVER_COMM,'info_taskmap_comp' ) + call shr_mpi_bcast(info_mprof, DRIVER_COMM,'info_mprof') + call shr_mpi_bcast(info_mprof_dt,DRIVER_COMM,'info_mprof_dt') #ifdef TIMING if (info_taskmap_model > 0) then @@ -424,14 +433,26 @@ subroutine seq_comm_init(global_comm_in, driver_comm_in, nmlfile, drv_comm_id) call shr_sys_flush(logunit) endif + if (info_mprof > 2) then + allocate( driver_task_node_map(0:global_numpes-1), stat=ierr) + if (ierr /= 0) call shr_sys_abort(trim(subname)//' allocate driver_task_node_map failed ') + endif + call t_startf("shr_taskmap_write") if (drv_inst == 0) then + c_comm_name = 'GLOBAL' + else + c_comm_name = 'DRIVER #'//trim(adjustl(c_drv_inst)) + endif + if (info_mprof > 2) then call shr_taskmap_write(logunit, DRIVER_COMM, & - 'GLOBAL', & - verbose=verbose_taskmap_output) + c_comm_name, & + verbose=verbose_taskmap_output, & + save_nnodes=driver_nnodes, & + save_task_node_map=driver_task_node_map) else call shr_taskmap_write(logunit, DRIVER_COMM, & - 'DRIVER #'//trim(adjustl(c_drv_inst)), & + c_comm_name, & verbose=verbose_taskmap_output) endif call t_stopf("shr_taskmap_write") @@ -588,6 +609,13 @@ subroutine seq_comm_init(global_comm_in, driver_comm_in, nmlfile, drv_comm_id) if (ierr /= 0) then write(logunit,*) trim(subname),' ERROR initialize MOAB ' endif +#ifdef MOABDDD +! write the global_mype , for easier debugging with ddd +! will never use ddd for more than 10 processes + if (global_mype .le. 10) then + write(logunit,*) trim(subname), ' global_mype=', global_mype + endif +#endif mhid = -1 ! iMOAB id for atm comp, coarse mesh mhfid = -1 ! iMOAB id for atm, fine mesh mpoid = -1 ! iMOAB id for ocn comp @@ -599,6 +627,9 @@ subroutine seq_comm_init(global_comm_in, driver_comm_in, nmlfile, drv_comm_id) mblxid = -1 ! iMOAB id for land on coupler pes mbintxla = -1 ! iMOAB id for land intx with atm on coupler pes mpsiid = -1 ! iMOAB for sea-ice + mbixid = -1 ! iMOAB for sea-ice migrated to coupler + mrofid = -1 ! iMOAB id of moab rof app + mbrxid = -1 ! iMOAB id of moab rof migrated to coupler num_moab_exports = 0 ! mostly used in debugging deallocate(comps,comms) @@ -723,6 +754,8 @@ subroutine seq_comm_clean() ! Also calls mct_world_clean, to be symmetric with the mct_world_init call from ! seq_comm_init. + integer :: id + character(*), parameter :: subName = '(seq_comm_clean) ' !---------------------------------------------------------- diff --git a/driver-moab/shr/seq_flds_mod.F90 b/driver-moab/shr/seq_flds_mod.F90 index aa3a310f8da6..28821b0547d2 100644 --- a/driver-moab/shr/seq_flds_mod.F90 +++ b/driver-moab/shr/seq_flds_mod.F90 @@ -702,6 +702,17 @@ subroutine seq_flds_set(nmlfile, ID, infodata) units = 'kg m-3' attname = 'Sa_dens' call metadata_set(attname, longname, stdname, units) + + ! UoverN for use by topounits + if (trim(cime_model) == 'e3sm') then + call seq_flds_add(a2x_states,"Sa_uovern") + call seq_flds_add(x2l_states,"Sa_uovern") + longname = 'Froude Number' + stdname = 'Froude Number' + units = 'Unitless' + attname = 'Sa_uovern' + call metadata_set(attname, longname, stdname, units) + end if ! convective precipitation rate ! large-scale (stable) snow rate (water equivalent) @@ -1401,6 +1412,15 @@ subroutine seq_flds_set(nmlfile, ID, infodata) attname = 'So_ustar' call metadata_set(attname, longname, stdname, units) + ! Water temperature heat flux from ocean + call seq_flds_add(o2x_fluxes, "Faoo_h2otemp") + call seq_flds_add(x2a_fluxes, "Faoo_h2otemp") + longname = 'Water temperature heat flux from ocean' + stdname = 'water_temperature_heat_flux' + units = 'W m-2' + attname = 'Faoo_h2otemp' + call metadata_set(attname, longname, stdname, units) + !----------------------------- ! ice<->ocn only exchange !----------------------------- @@ -1435,17 +1455,6 @@ subroutine seq_flds_set(nmlfile, ID, infodata) attname = 'Fioo_q' call metadata_set(attname, longname, stdname, units) - if (trim(cime_model) == 'e3sm') then - ! Ocean melt (q<0) potential - call seq_flds_add(o2x_fluxes,"Fioo_meltp") - call seq_flds_add(x2i_fluxes,"Fioo_meltp") - longname = 'Ocean melt (q<0) potential' - stdname = 'surface_snow_and_ice_melt_heat_flux' - units = 'W m-2' - attname = 'Fioo_meltp' - call metadata_set(attname, longname, stdname, units) - end if - if (trim(cime_model) == 'e3sm') then ! Ocean frazil production call seq_flds_add(o2x_fluxes,"Fioo_frazil") @@ -2060,23 +2069,33 @@ subroutine seq_flds_set(nmlfile, ID, infodata) units = 'kg m-2 s-1' attname = 'Flrl_demand' call metadata_set(attname, longname, stdname, units) - call seq_flds_add(l2x_fluxes,'Flrl_Tqsur') - call seq_flds_add(l2x_fluxes_to_rof,'Flrl_Tqsur') - call seq_flds_add(x2r_fluxes,'Flrl_Tqsur') - longname = 'Temperature of surface runoff' - stdname = 'Temperature_of_surface_runoff' - units = 'Kelvin' - attname = 'Flrl_Tqsur' - call metadata_set(attname, longname, stdname, units) - call seq_flds_add(l2x_fluxes,'Flrl_Tqsub') - call seq_flds_add(l2x_fluxes_to_rof,'Flrl_Tqsub') - call seq_flds_add(x2r_fluxes,'Flrl_Tqsub') - longname = 'Temperature of subsurface runoff' - stdname = 'Temperature_of_subsurface_runoff' - units = 'Kelvin' - attname = 'Flrl_Tqsub' - call metadata_set(attname, longname, stdname, units) + call seq_flds_add(l2x_fluxes,'Flrl_Tqsur') + call seq_flds_add(l2x_fluxes_to_rof,'Flrl_Tqsur') + call seq_flds_add(x2r_fluxes,'Flrl_Tqsur') + longname = 'Temperature of surface runoff' + stdname = 'Temperature_of_surface_runoff' + units = 'Kelvin' + attname = 'Flrl_Tqsur' + call metadata_set(attname, longname, stdname, units) + + call seq_flds_add(l2x_fluxes,'Flrl_Tqsub') + call seq_flds_add(l2x_fluxes_to_rof,'Flrl_Tqsub') + call seq_flds_add(x2r_fluxes,'Flrl_Tqsub') + longname = 'Temperature of subsurface runoff' + stdname = 'Temperature_of_subsurface_runoff' + units = 'Kelvin' + attname = 'Flrl_Tqsub' + call metadata_set(attname, longname, stdname, units) + + ! Cosine of Zenith angle (-) + call seq_flds_add(l2x_fluxes,'coszen_str') + call seq_flds_add(x2r_fluxes,'coszen_str') + longname = 'Cosine of Zenith angle' + stdname = 'coszen' + units = ' ' + attname = 'coszen_str' + call metadata_set(attname, longname, stdname, units) endif ! Currently only the CESM land and runoff models treat irrigation as a separate diff --git a/driver-moab/shr/seq_infodata_mod.F90 b/driver-moab/shr/seq_infodata_mod.F90 index 1af8e428f804..c8d129ee7a13 100644 --- a/driver-moab/shr/seq_infodata_mod.F90 +++ b/driver-moab/shr/seq_infodata_mod.F90 @@ -83,6 +83,7 @@ MODULE seq_infodata_mod character(SHR_KIND_CL) :: restart_pfile ! Restart pointer file character(SHR_KIND_CL) :: restart_file ! Full archive path to restart file logical :: single_column ! single column mode + logical :: iop_mode ! IOP mode real (SHR_KIND_R8) :: scmlat ! single column lat real (SHR_KIND_R8) :: scmlon ! single column lon character(SHR_KIND_CS) :: logFilePostFix ! postfix for output log files @@ -331,6 +332,7 @@ SUBROUTINE seq_infodata_Init( infodata, nmlfile, ID, pioid, cpl_tag) character(SHR_KIND_CL) :: restart_file ! Restart filename logical :: single_column ! single column mode + logical :: iop_mode ! IOP mode real (SHR_KIND_R8) :: scmlat ! single column mode latitude real (SHR_KIND_R8) :: scmlon ! single column mode longitude character(SHR_KIND_CS) :: logFilePostFix ! postfix for output log files @@ -428,7 +430,7 @@ SUBROUTINE seq_infodata_Init( infodata, nmlfile, ID, pioid, cpl_tag) brnch_retain_casename, info_debug, bfbflag, & restart_pfile, restart_file, run_barriers, & single_column, scmlat, force_stop_at, & - scmlon, logFilePostFix, outPathRoot, flux_diurnal,& + scmlon, iop_mode, logFilePostFix, outPathRoot, flux_diurnal,& ocn_surface_flux_scheme, & coldair_outbreak_mod, & flux_convergence, flux_max_iteration, & @@ -491,6 +493,7 @@ SUBROUTINE seq_infodata_Init( infodata, nmlfile, ID, pioid, cpl_tag) restart_pfile = 'rpointer.drv' restart_file = trim(sp_str) single_column = .false. + iop_mode = .false. scmlat = -999. scmlon = -999. logFilePostFix = '.log' @@ -626,6 +629,7 @@ SUBROUTINE seq_infodata_Init( infodata, nmlfile, ID, pioid, cpl_tag) infodata%restart_file = restart_file end if infodata%single_column = single_column + infodata%iop_mode = iop_mode infodata%scmlat = scmlat infodata%scmlon = scmlon infodata%logFilePostFix = logFilePostFix @@ -964,7 +968,7 @@ SUBROUTINE seq_infodata_GetData_explicit( infodata, cime_model, case_name, case_ model_version, username, hostname, rest_case_name, tchkpt_dir, & start_type, restart_pfile, restart_file, perpetual, perpetual_ymd, & aqua_planet,aqua_planet_sst, brnch_retain_casename, & - single_column, scmlat,scmlon,logFilePostFix, outPathRoot, & + single_column, scmlat,scmlon,iop_mode,logFilePostFix, outPathRoot,& atm_present, atm_prognostic, & lnd_present, lnd_prognostic, & rof_present, rof_prognostic, & @@ -1033,6 +1037,7 @@ SUBROUTINE seq_infodata_GetData_explicit( infodata, cime_model, case_name, case_ logical, optional, intent(OUT) :: single_column real (SHR_KIND_R8), optional, intent(OUT) :: scmlat real (SHR_KIND_R8), optional, intent(OUT) :: scmlon + logical, optional, intent(OUT) :: iop_mode character(len=*), optional, intent(OUT) :: logFilePostFix ! output log file postfix character(len=*), optional, intent(OUT) :: outPathRoot ! output file root logical, optional, intent(OUT) :: perpetual ! If this is perpetual @@ -1208,6 +1213,7 @@ SUBROUTINE seq_infodata_GetData_explicit( infodata, cime_model, case_name, case_ if ( present(restart_pfile) ) restart_pfile = infodata%restart_pfile if ( present(restart_file) ) restart_file = infodata%restart_file if ( present(single_column) ) single_column = infodata%single_column + if ( present(iop_mode ) ) iop_mode = infodata%iop_mode if ( present(scmlat) ) scmlat = infodata%scmlat if ( present(scmlon) ) scmlon = infodata%scmlon if ( present(logFilePostFix) ) logFilePostFix = infodata%logFilePostFix @@ -1499,7 +1505,7 @@ SUBROUTINE seq_infodata_PutData_explicit( infodata, cime_model, case_name, case_ model_version, username, hostname, rest_case_name, tchkpt_dir, & start_type, restart_pfile, restart_file, perpetual, perpetual_ymd, & aqua_planet,aqua_planet_sst, brnch_retain_casename, & - single_column, scmlat,scmlon,logFilePostFix, outPathRoot, & + single_column, scmlat,scmlon,iop_mode,logFilePostFix, outPathRoot, & atm_present, atm_prognostic, & lnd_present, lnd_prognostic, & rof_present, rof_prognostic, & @@ -1567,6 +1573,7 @@ SUBROUTINE seq_infodata_PutData_explicit( infodata, cime_model, case_name, case_ logical, optional, intent(IN) :: single_column real (SHR_KIND_R8), optional, intent(IN) :: scmlat real (SHR_KIND_R8), optional, intent(IN) :: scmlon + logical, optional, intent(IN) :: iop_mode character(len=*), optional, intent(IN) :: logFilePostFix ! output log file postfix character(len=*), optional, intent(IN) :: outPathRoot ! output file root logical, optional, intent(IN) :: perpetual ! If this is perpetual @@ -1739,6 +1746,7 @@ SUBROUTINE seq_infodata_PutData_explicit( infodata, cime_model, case_name, case_ if ( present(restart_pfile) ) infodata%restart_pfile = restart_pfile if ( present(restart_file) ) infodata%restart_file = restart_file if ( present(single_column) ) infodata%single_column = single_column + if ( present(iop_mode) ) infodata%iop_mode = iop_mode if ( present(scmlat) ) infodata%scmlat = scmlat if ( present(scmlon) ) infodata%scmlon = scmlon if ( present(logFilePostFix) ) infodata%logFilePostFix = logFilePostFix @@ -2041,6 +2049,7 @@ subroutine seq_infodata_bcast(infodata,mpicom) call shr_mpi_bcast(infodata%restart_pfile, mpicom) call shr_mpi_bcast(infodata%restart_file, mpicom) call shr_mpi_bcast(infodata%single_column, mpicom) + call shr_mpi_bcast(infodata%iop_mode, mpicom) call shr_mpi_bcast(infodata%scmlat, mpicom) call shr_mpi_bcast(infodata%scmlon, mpicom) call shr_mpi_bcast(infodata%logFilePostFix, mpicom) @@ -2723,6 +2732,7 @@ SUBROUTINE seq_infodata_print( infodata ) write(logunit,F0A) subname,'Restart file (full path) = ', trim(infodata%restart_file) write(logunit,F0L) subname,'single_column = ', infodata%single_column + write(logunit,F0L) subname,'iop_mode = ', infodata%iop_mode write(logunit,F0R) subname,'scmlat = ', infodata%scmlat write(logunit,F0R) subname,'scmlon = ', infodata%scmlon From 86cb2d291bf75fe5c89a724f5f2f2eb3b2466072 Mon Sep 17 00:00:00 2001 From: Jason Sarich Date: Tue, 8 Jun 2021 12:11:41 -0500 Subject: [PATCH 090/467] update moab driver from latest mct config changes --- driver-moab/cime_config/config_component.xml | 16 ++++++++++++++++ .../cime_config/config_component_e3sm.xml | 2 +- driver-moab/main/cime_comp_mod.F90 | 12 +++++++----- 3 files changed, 24 insertions(+), 6 deletions(-) diff --git a/driver-moab/cime_config/config_component.xml b/driver-moab/cime_config/config_component.xml index 144c3b51912f..458366b17c1d 100644 --- a/driver-moab/cime_config/config_component.xml +++ b/driver-moab/cime_config/config_component.xml @@ -169,6 +169,22 @@ username of user who created case + + char + case_desc + env_case.xml + + Optional string denoting that this case is part of a case group + + + + + char + case_desc + env_case.xml + Unique identifier for case + + diff --git a/driver-moab/cime_config/config_component_e3sm.xml b/driver-moab/cime_config/config_component_e3sm.xml index b9a37c19c3d1..aaa16692303d 100644 --- a/driver-moab/cime_config/config_component_e3sm.xml +++ b/driver-moab/cime_config/config_component_e3sm.xml @@ -150,7 +150,7 @@ char minus1p8,linear_salt,mushy - minus1p8 + mushy run_physics env_run.xml Freezing point calculation for salt water. diff --git a/driver-moab/main/cime_comp_mod.F90 b/driver-moab/main/cime_comp_mod.F90 index 4ed5a64b734d..207372280bff 100644 --- a/driver-moab/main/cime_comp_mod.F90 +++ b/driver-moab/main/cime_comp_mod.F90 @@ -455,9 +455,11 @@ module cime_comp_mod logical :: areafact_samegrid ! areafact samegrid flag logical :: single_column ! scm mode logical - logical :: iop_mode ! iop mode logical + logical :: scm_multcols ! scm mode over multiple columns logical real(r8) :: scmlon ! single column lon real(r8) :: scmlat ! single column lat + integer :: scm_nx ! points in x direction for SCM functionality + integer :: scm_ny ! points in y direction for SCM functionality logical :: aqua_planet ! aqua planet mode real(r8) :: nextsw_cday ! radiation control logical :: atm_aero ! atm provides aerosol data @@ -1118,7 +1120,9 @@ subroutine cime_pre_init2() esp_present=esp_present , & iac_present=iac_present , & single_column=single_column , & - iop_mode=iop_mode , & + scm_multcols=scm_multcols , & + scm_nx=scm_nx , & + scm_ny=scm_ny , & aqua_planet=aqua_planet , & cpl_seq_option=cpl_seq_option , & drv_threading=drv_threading , & @@ -1334,7 +1338,7 @@ subroutine cime_pre_init2() call seq_comm_getinfo(OCNID(ens1), mpicom=mpicom_OCNID) call shr_scam_checkSurface(scmlon, scmlat, & - iop_mode, & + scm_multcols,scm_nx,scm_ny, & OCNID(ens1), mpicom_OCNID, & lnd_present=lnd_present, & ocn_present=ocn_present, & @@ -2382,8 +2386,6 @@ subroutine cime_init() write(logunit,104) ' Write history file at ',ymd,tod call shr_sys_flush(logunit) endif - - call seq_hist_write(infodata, EClock_d, & atm, lnd, ice, ocn, rof, glc, wav, iac, & fractions_ax, fractions_lx, fractions_ix, fractions_ox, & From 00e4903da21bccf40bedc4b79be9754c0f5fd22f Mon Sep 17 00:00:00 2001 From: Jason Sarich Date: Sun, 27 Jun 2021 14:42:38 -0500 Subject: [PATCH 091/467] splice in moab changes to mpas-source submodule to subdirectory --- components/mpas-framework/Makefile | 14 ++ components/mpas-framework/src/CMakeLists.txt | 8 +- components/mpas-framework/src/Makefile | 2 +- .../mpas-framework/src/Makefile.in.E3SM | 14 +- .../src/driver/mpas_subdriver.F | 18 +- .../mpas-framework/src/framework/Makefile | 6 +- .../src/framework/mpas_moabmesh.F | 205 ++++++++++++++++++ 7 files changed, 261 insertions(+), 6 deletions(-) create mode 100644 components/mpas-framework/src/framework/mpas_moabmesh.F diff --git a/components/mpas-framework/Makefile b/components/mpas-framework/Makefile index 724c5b14b38a..749c9d3e2026 100644 --- a/components/mpas-framework/Makefile +++ b/components/mpas-framework/Makefile @@ -681,6 +681,13 @@ endif override CPPFLAGS += -DUSE_LAPACK endif +ifneq "$(MOAB_PATH)" "" + CPPINCLUDES += -DHAVE_MOAB -I$(MOAB_PATH)/include + FCINCLUDES += -DHAVE_MOAB -I$(MOAB_PATH)/include + include $(MOAB_PATH)/lib/moab.make + LIBS += ${MOAB_LIBS_LINK} -lstdc++ +endif + RM = rm -f CPP = cpp -P -traditional RANLIB = ranlib @@ -806,6 +813,12 @@ else # USE_PIO2 IF PIO_MESSAGE="Using the PIO 1.x library." endif # USE_PIO2 IF +ifneq "$(MOAB_PATH)" "" + MOAB_MESSAGE="Using MOAB library" +else # + MOAB_MESSAGE="Not using MOAB library" +endif + ifdef TIMER_LIB ifeq "$(TIMER_LIB)" "tau" override TAU=true @@ -1092,6 +1105,7 @@ endif @echo $(GEN_F90_MESSAGE) @echo $(TIMER_MESSAGE) @echo $(PIO_MESSAGE) + @echo $(MOAB_MESSAGE) @echo "*******************************************************************************" clean: cd $(FWPATH); $(MAKE) clean RM="$(RM)" CORE="$(CORE)" diff --git a/components/mpas-framework/src/CMakeLists.txt b/components/mpas-framework/src/CMakeLists.txt index 41375a53d261..8a43be6ace6a 100644 --- a/components/mpas-framework/src/CMakeLists.txt +++ b/components/mpas-framework/src/CMakeLists.txt @@ -1,4 +1,4 @@ -# + # # This is the interface between E3SM's new CMake-based build system and MPAS. # # The following CMake variables are expected to be defined: @@ -82,6 +82,12 @@ add_subdirectory(tools) set(COMMON_RAW_SOURCES external/ezxml/ezxml.c) include(${CMAKE_CURRENT_SOURCE_DIR}/framework/framework.cmake) +if (COMP_INTERFACE STREQUAL "moab") + list(APPEND COMMON_RAW_SOURCES framework/mpas_moabmesh.F) + include(${MOAB_PATH}/lib/cmake/MOAB/MOABConfig.cmake) + list(APPEND INCLUDES "${MOAB_PATH}/include") + list(APPEND CPPDEFS "-DHAVE_MOAB") +endif() include(${CMAKE_CURRENT_SOURCE_DIR}/operators/operators.cmake) add_library(common OBJECT) diff --git a/components/mpas-framework/src/Makefile b/components/mpas-framework/src/Makefile index 6acb1cdf3497..73a25cf81e61 100644 --- a/components/mpas-framework/src/Makefile +++ b/components/mpas-framework/src/Makefile @@ -23,7 +23,7 @@ build_tools: externals (cd tools; $(MAKE) CPPFLAGS="$(CPPFLAGS)" CC="$(SCC)" CFLAGS="$(CFLAGS)") frame: $(AUTOCLEAN_DEPS) externals - ( cd framework; $(MAKE) CPPFLAGS="$(CPPFLAGS)" CPPINCLUDES="$(CPPINCLUDES)" all ) + ( cd framework; $(MAKE) CPPFLAGS="$(CPPFLAGS)" CPPINCLUDES="$(CPPINCLUDES)" FCINCLUDES="$(FCINCLUDES)" MOAB_PATH=$(MOAB_PATH) all ) ln -sf framework/libframework.a libframework.a ops: $(AUTOCLEAN_DEPS) externals frame diff --git a/components/mpas-framework/src/Makefile.in.E3SM b/components/mpas-framework/src/Makefile.in.E3SM index dabf51adacf9..736d53d4f01a 100644 --- a/components/mpas-framework/src/Makefile.in.E3SM +++ b/components/mpas-framework/src/Makefile.in.E3SM @@ -41,6 +41,16 @@ else ESMFDIR = noesmf endif +# Set MOAB info if it is being used +ifeq ($(COMP_INTERFACE),moab) + ifdef MOAB_PATH + CPPDEFS += -DHAVE_MOAB + MOAB_INCLUDES = -I$(MOAB_PATH)/include + else + $(error MOAB_PATH must be defined when using moab driver) + endif +endif + RM = rm -f CPP = cpp -P -traditional FC=$(MPIFC) @@ -54,8 +64,8 @@ override CFLAGS += -DMPAS_NO_LOG_REDIRECT -DUSE_PIO2 -DMPAS_NO_ESMF_INIT -DMPAS_ override FFLAGS += -DMPAS_NO_LOG_REDIRECT -DUSE_PIO2 -DMPAS_NO_ESMF_INIT -DMPAS_ESM_SHR_CONST -DMPAS_PERF_MOD_TIMERS override CPPFLAGS += $(CPPDEFS) $(MODEL_FORMULATION) $(FILE_OFFSET) $(ZOLTAN_DEFINE) -DMPAS_NO_LOG_REDIRECT -DUSE_PIO2 -DMPAS_NO_ESMF_INIT -DMPAS_ESM_SHR_CONST -D_MPI -DMPAS_NAMELIST_SUFFIX=$(NAMELIST_SUFFIX) -DMPAS_EXE_NAME=$(EXE_NAME) -DMPAS_PERF_MOD_TIMERS override CPPINCLUDES += -I$(EXEROOT)/$(COMPONENT)/source/inc -I$(INSTALL_SHAREDPATH)/include -I$(INSTALL_SHAREDPATH)/$(COMP_INTERFACE)/$(ESMFDIR)/$(NINST_VALUE)/csm_share -I$(NETCDF)/include -I$(PIO) -I$(PNETCDF)/include -override FCINCLUDES += -I$(EXEROOT)/$(COMPONENT)/source/inc -I$(INSTALL_SHAREDPATH)/include -I$(INSTALL_SHAREDPATH)/$(COMP_INTERFACE)/$(ESMFDIR)/$(NINST_VALUE)/csm_share -I$(NETCDF)/include -I$(PIO) -I$(PNETCDF)/include -LIBS += -L$(PIO) -L$(PNETCDF)/lib -L$(NETCDF)/lib -L$(LIBROOT) -L$(INSTALL_SHAREDPATH)/lib -lpio -lpnetcdf -lnetcdf +override FCINCLUDES += -I$(EXEROOT)/$(COMPONENT)/source/inc -I$(INSTALL_SHAREDPATH)/include -I$(INSTALL_SHAREDPATH)/$(COMP_INTERFACE)/$(ESMFDIR)/$(NINST_VALUE)/csm_share -I$(NETCDF)/include -I$(PIO) -I$(PNETCDF)/include $(MOAB_INCLUDE) +LIBS += $(IMESH_LIBS) -L$(PIO) -L$(PNETCDF)/lib -L$(NETCDF)/lib -L$(LIBROOT) -L$(INSTALL_SHAREDPATH)/lib -lpio -lpnetcdf -lnetcdf ifeq ($(DEBUG), TRUE) override CPPFLAGS += -DMPAS_DEBUG diff --git a/components/mpas-framework/src/driver/mpas_subdriver.F b/components/mpas-framework/src/driver/mpas_subdriver.F index 2705777a25ad..9671fbbd4b8e 100644 --- a/components/mpas-framework/src/driver/mpas_subdriver.F +++ b/components/mpas-framework/src/driver/mpas_subdriver.F @@ -35,6 +35,12 @@ module mpas_subdriver use test_core_interface #endif +#ifdef HAVE_MOAB + use mpas_moabmesh +#endif + type (core_type), pointer :: corelist => null() + type (dm_info), pointer :: dminfo + type (domain_type), pointer :: domain_ptr contains @@ -83,7 +89,9 @@ subroutine mpas_init(corelist, domain_ptr, mpi_comm) logical :: streamsExists integer :: mesh_iotype integer, save :: domainID = 0 - +#ifdef HAVE_MOAB + integer, external :: iMOAB_InitializeFortran +#endif interface subroutine xml_stream_parser(xmlname, mgr_p, comm, ierr) bind(c) use iso_c_binding, only : c_char, c_ptr, c_int @@ -294,6 +302,14 @@ end subroutine xml_stream_get_attributes call mpas_set_timeInterval(filename_interval, timeString=filename_interval_temp, ierr=ierr) call mpas_build_stream_filename(ref_time, start_time, filename_interval, mesh_filename_temp, blockID, mesh_filename, ierr) end if +#ifdef HAVE_MOAB + ierr = iMOAB_InitializeFortran() + if ( ierr /= 0 ) then + call mpas_log_write('cannot initialize MOAB', messageType=MPAS_LOG_CRIT) + else + call mpas_log_write(' initialized MOAB', messageType=MPAS_LOG_WARN) + end if +#endif call mpas_log_write(' ** Attempting to bootstrap MPAS framework using stream: ' // trim(mesh_stream)) call mpas_bootstrap_framework_phase1(domain_ptr, mesh_filename, mesh_iotype) diff --git a/components/mpas-framework/src/framework/Makefile b/components/mpas-framework/src/framework/Makefile index d19cd78677b0..30fe011e4370 100644 --- a/components/mpas-framework/src/framework/Makefile +++ b/components/mpas-framework/src/framework/Makefile @@ -36,6 +36,10 @@ OBJS = mpas_kind_types.o \ mpas_field_accessor.o \ mpas_log.o +ifneq "$(MOAB_PATH)" "" + OBJS += mpas_moabmesh.o +endif + all: framework $(DEPS) framework: $(OBJS) @@ -118,7 +122,7 @@ clean: .F.o: $(RM) $@ $*.mod ifeq "$(GEN_F90)" "true" - $(CPP) $(CPPFLAGS) $(CPPINCLUDES) $< > $*.f90 + $(CPP) $(CPPFLAGS) $(CPPINCLUDES) $(FCINCLUDES) $< > $*.f90 $(FC) $(FFLAGS) -c $*.f90 $(FCINCLUDES) -I../external/esmf_time_f90 else $(FC) $(CPPFLAGS) $(FFLAGS) -c $*.F $(CPPINCLUDES) $(FCINCLUDES) -I../external/esmf_time_f90 diff --git a/components/mpas-framework/src/framework/mpas_moabmesh.F b/components/mpas-framework/src/framework/mpas_moabmesh.F new file mode 100644 index 000000000000..dfaa0dd3b1a9 --- /dev/null +++ b/components/mpas-framework/src/framework/mpas_moabmesh.F @@ -0,0 +1,205 @@ +module mpas_moabmesh +! use, intrinsic :: ISO_C_BINDING +#ifdef HAVE_MOAB + use mpas_log + use mpas_derived_types, only: dm_info, domain_type + use mpas_field_routines + use mpas_sort + use mpas_stream_manager + use mpas_pool_routines + !use mpas_vector_operations +#include "moab/MOABConfig.h" + implicit none + + contains + + SUBROUTINE errorout(ierr, message) + integer ierr + character*(*) message + if (ierr.ne.0) then + print *, message + call exit (1) + end if + return + end subroutine + + subroutine mpas_moab_instance(domain, ext_comp_id, pidmoab) + + type (domain_type), intent(inout) :: domain + integer , intent(in) :: ext_comp_id + integer , Intent(inout) :: pidmoab + + type (block_type), pointer :: block + type (mpas_pool_type), pointer :: meshPool + integer, pointer :: nCells, nVertices, maxEdges + integer :: pid, nblocks + integer, dimension(:,:), pointer :: verticesOnCell + integer, dimension(:), pointer :: nEdgesOnCell + integer, dimension(:), pointer :: indexToVertexID, indexToCellID + real(kind=RKIND), dimension(:), pointer :: xVertex, yVertex, zVertex + real (kind=RKIND), dimension(:), pointer :: xCell, yCell, zCell + logical, pointer :: on_a_sphere, is_periodic + real(kind=RKIND), pointer :: x_period, y_period + integer, pointer :: nCellsSolve, nEdgesSolve, nVerticesSolve + + integer , external :: iMOAB_RegisterFortranApplication, & + iMOAB_CreateVertices, iMOAB_CreateElements, & + iMOAB_ResolveSharedEntities, iMOAB_DetermineGhostEntities, & + iMOAB_DefineTagStorage, iMOAB_SetIntTagStorage , & + iMOAB_UpdateMeshInfo + integer :: c_comm, i1, j1, ic, lastvertex + character*12 appname + integer :: ierr, num_verts_in_cells + real(kind=RKIND), allocatable, target :: moab_vert_coords(:) + integer, allocatable, target :: indexUsed(:), invMap(:), localIds(:) + integer dimcoord, dimen, mbtype, block_ID, proc_id + integer ,allocatable , target :: all_connects(:) + character*100 tagname, lnum + integer tagtype, numco, tag_sto_len, ent_type, tagindex, currentVertex + + c_comm = domain % dminfo % comm + write(lnum,"(I0.2)")ext_comp_id + appname = 'MPAS_MB_'//trim(lnum)// CHAR(0) + ierr = iMOAB_RegisterFortranApplication(appname, c_comm, ext_comp_id, pid) + pidmoab = pid ! this is exported, need for send to work + call errorout(ierr, 'fail to register MPAS_MOAB mesh') + proc_id = domain % dminfo % my_proc_id + call mpas_log_write('MOAB MPAS app pid: $i task $i ', intArgs=(/pid, proc_id/) ) + +! blocks should be merged if there is more than one block per task + nblocks = 0 + block => domain % blocklist + do while (associated(block)) !{{{ + nblocks = nblocks + 1 + ! allocate scratch memory + call mpas_pool_get_subpool(block % structs, 'mesh', meshPool) + call mpas_pool_get_array(meshPool, 'xVertex', xVertex) + call mpas_pool_get_array(meshPool, 'yVertex', yVertex) + call mpas_pool_get_array(meshPool, 'zVertex', zVertex) + call mpas_pool_get_dimension(meshPool, 'nVertices', nVertices) + call mpas_pool_get_dimension(meshPool, 'maxEdges', maxEdges) + call mpas_pool_get_config(meshPool, 'on_a_sphere', on_a_sphere) + call mpas_pool_get_config(meshPool, 'is_periodic', is_periodic) + call mpas_pool_get_config(meshPool, 'x_period', x_period) + call mpas_pool_get_config(meshPool, 'y_period', y_period) + call mpas_pool_get_array(meshPool, 'verticesOnCell', verticesOnCell) + call mpas_pool_get_array(meshPool, 'indexToVertexID', indexToVertexID) + call mpas_pool_get_array(meshPool, 'indexToCellID', indexToCellID) + call mpas_pool_get_dimension(meshPool, 'nCells', nCells) + call mpas_pool_get_array(meshPool, 'nEdgesOnCell', nEdgesOnCell) + call mpas_pool_get_dimension(meshPool, 'nCellsSolve', nCellsSolve) + call mpas_pool_get_dimension(meshPool, 'nEdgesSolve', nEdgesSolve) + call mpas_pool_get_dimension(meshPool, 'nVerticesSolve', nVerticesSolve) +! call mpas_pool_get_array(meshPool, 'xCell', xCell) +! call mpas_pool_get_array(meshPool, 'yCell', yCell) +! call mpas_pool_get_array(meshPool, 'zCell', zCell) + + call mpas_log_write(' MOAB instance: number of vertices:: $i number of cells:: $i solve: v:$i c:$i', intArgs=(/nVertices, nCells, nVerticesSolve, nCellsSolve/) ) + !! + allocate(indexUsed(nVertices), invMap(nVertices) ) ! conservative, invMap should be smaller + indexUsed = 0 + invMap = 0 + ! fill now connectivity array, nCellsSolve; fist pad to max nc + num_verts_in_cells = nCellsSolve * maxEdges + allocate(all_connects(num_verts_in_cells)) +! collect all vertices, and also pad + j1 = 0 + do ic=1, nCellsSolve + do i1 = 1, nEdgesOnCell(ic) + j1 = j1 + 1 + all_connects(j1) = verticesOnCell( i1, ic) + indexUsed(all_connects(j1)) = 1 + enddo + lastvertex = verticesOnCell( nEdgesOnCell (ic), ic) + ! pad the rest with the last vertex + do i1 = nEdgesOnCell (ic) + 1, maxEdges + j1 = j1 + 1 + all_connects(j1) = lastvertex ! repeat the last vertex (pad) + enddo + ! call mpas_log_write('cell: $i v:: $i $i $i $i $i $i', intArgs=(/ic, all_connects(j1-5), all_connects(j1-4), all_connects(j1-3), all_connects(j1-2), all_connects(j1-1), all_connects(j1)/) ) + enddo + + currentVertex = 0 + do i1 = 1, nVertices + if (indexUsed(i1) > 0) then + currentVertex = currentVertex + 1 + indexUsed(i1) = currentVertex + invMap(currentVertex) = i1 + endif + enddo + !! convert all_connects to indexUsed + do i1 = 1, num_verts_in_cells + all_connects(i1) = indexUsed( all_connects(i1) ) + enddo + allocate(moab_vert_coords(3*currentVertex)) + do i1 =1, currentVertex + moab_vert_coords(3*i1-2) = xVertex(invMap(i1)) + moab_vert_coords(3*i1-1) = yVertex(invMap(i1)) + moab_vert_coords(3*i1 ) = zVertex(invMap(i1)) + ! call mpas_log_write('i:: $i coords:: $r $r $r $r', intArgs=(/i1/), realArgs=(/moab_vert_coords(3*i1-2),moab_vert_coords(3*i1-1), moab_vert_coords(3*i1)/) ) + enddo + dimcoord = 3*currentVertex + dimen = 3 + ierr = iMOAB_CreateVertices(pid, dimcoord, dimen, moab_vert_coords) + call errorout(ierr, 'fail to create vertices') + call mpas_log_write(' MOAB instance: created $i vertices on local proc $i ',intArgs=(/currentVertex, proc_id/)) +! so we know we used only currentvertex vertices in the pool (the rest are in halo) + mbtype = 4 ! polygon + + block_ID = 100*ext_comp_id + proc_id + nblocks ! we should have only one block right now + + ierr = iMOAB_CreateElements( pid, nCellsSolve, mbtype, maxEdges, all_connects, block_ID ); + call errorout(ierr, 'fail to create polygons') +! set the global id for vertices +! first, retrieve the tag + tagname='GLOBAL_ID'//CHAR(0) + tagtype = 0 ! dense, integer + numco = 1 + ierr = iMOAB_DefineTagStorage(pid, tagname, tagtype, numco, tagindex ) + call errorout(ierr, 'fail to get global id tag') +! now set the values + ent_type = 0 ! vertex type + allocate(localIds(currentVertex)) + do i1 = 1, currentVertex + localIds(i1) = indexToVertexID (invMap(i1)) + enddo + ierr = iMOAB_SetIntTagStorage ( pid, tagname, currentVertex , ent_type, localIds ) + call errorout(ierr, 'fail to set global id tag for vertices') + ! set global id tag for elements + ent_type = 1 ! now set the global id tag on elements + ierr = iMOAB_SetIntTagStorage ( pid, tagname, nCellsSolve, ent_type, indexToCellID) + call errorout(ierr, 'fail to set global id tag for polygons') + ! get next block +!#ifdef MPAS_DEBUG +! if (proc_id.lt. 5) then +! write(lnum,"(I0.2)")proc_id +! localmeshfile = 'ownedOcn_'//trim(lnum)// '.h5m' // CHAR(0) +! wopts = CHAR(0) +! ierr = iMOAB_WriteMesh(pid, localmeshfile, wopts) +! call errorout(ierr, 'fail to write local mesh file') +! endif +!#endif + ierr = iMOAB_ResolveSharedEntities( pid, currentVertex, localIds ); + call errorout(ierr, 'fail to resolve shared entities') + + deallocate (moab_vert_coords) + deallocate (all_connects) + deallocate (indexUsed) + deallocate (invMap) + deallocate (localIds) + block => block % next + + end do !}}} + + + if (nblocks .ne. 1) then + call errorout(1, 'more than one block per task') + endif + ierr = iMOAB_UpdateMeshInfo(pid) + call errorout(ierr, 'fail to update mesh info') + + + + end subroutine mpas_moab_instance +#endif +end module mpas_moabmesh From ae75d506746d4492c120f3763486eea39c71c741 Mon Sep 17 00:00:00 2001 From: Jason Sarich Date: Sun, 27 Jun 2021 19:14:19 -0500 Subject: [PATCH 092/467] more rebasing fixes --- driver-moab/cime_config/buildnml | 17 +- driver-moab/cime_config/config_component.xml | 46 ++++- .../cime_config/config_component_cesm.xml | 26 ++- .../cime_config/config_component_e3sm.xml | 185 ++++++++++-------- driver-moab/shr/seq_comm_mct.F90 | 3 +- driver-moab/shr/seq_infodata_mod.F90 | 49 +++-- 6 files changed, 223 insertions(+), 103 deletions(-) diff --git a/driver-moab/cime_config/buildnml b/driver-moab/cime_config/buildnml index ea34cccc9cf3..0b8c3ee152e3 100755 --- a/driver-moab/cime_config/buildnml +++ b/driver-moab/cime_config/buildnml @@ -171,6 +171,19 @@ def _create_drv_namelists(case, infile, confdir, nmlgen, files): nmlgen.set_value('esp_cpl_dt', value=esp_time) # End if pause is active + # Sanity checks on mem-prof options + info_mprof = case.get_value('INFO_MPROF') + info_taskmap_model = case.get_value('INFO_TASKMAP_MODEL') + expect(not (info_mprof > 2 and info_taskmap_model < 1), + "Node-level memory profiling (INFO_MPROF={:d}) expects positive INFO_TASKMAP_MODEL, given {:d}".\ + format(info_mprof, info_taskmap_model)) + + info_mprof_dt = case.get_value('INFO_MPROF_DT') + expect(info_mprof_dt >= 0 and + info_mprof_dt <= 86400, + "Expected INFO_MPROF_DT between 0 and 86400 secs; given {:d}".format(info_mprof_dt)) + # end mprof checks + #-------------------------------- # (1) Write output namelist file drv_in and input dataset list. #-------------------------------- @@ -381,8 +394,8 @@ def buildnml(case, caseroot, component): # create cplconf/namelist infile_text = "" - if case.get_value('COMP_ATM') == 'cam': - # cam is actually changing the driver namelist settings + if case.get_value('COMP_ATM') in ['cam','eam']: + # cam/eam is actually changing the driver namelist settings cam_config_opts = case.get_value("CAM_CONFIG_OPTS") if "aquaplanet" in cam_config_opts: infile_text = "aqua_planet = .true. \n aqua_planet_sst = 1" diff --git a/driver-moab/cime_config/config_component.xml b/driver-moab/cime_config/config_component.xml index 458366b17c1d..7554fa7a8bd8 100644 --- a/driver-moab/cime_config/config_component.xml +++ b/driver-moab/cime_config/config_component.xml @@ -173,8 +173,8 @@ char case_desc env_case.xml - - Optional string denoting that this case is part of a case group + + Optional string denoting that this case is part of a case group @@ -753,6 +753,15 @@ machines. + + logical + TRUE,FALSE + FALSE + build_def + env_build.xml + TRUE implies linking to the MOAB library + + logical TRUE,FALSE @@ -906,9 +915,9 @@ env_run.xml Determines what ESMF log files (if any) are generated when - USE_ESMF_LIB is TRUE. + USE_ESMF_LIB is TRUE. ESMF_LOGKIND_SINGLE: Use a single log file, combining messages from - all of the PETs. Not supported on some platforms. + all of the PETs. Not supported on some platforms. ESMF_LOGKIND_MULTI: Use multiple log files -- one per PET. ESMF_LOGKIND_NONE: Do not issue messages to a log file. By default, no ESMF log files are generated. @@ -1069,7 +1078,7 @@ char - gland20,gland10,gland5,gland5UM,gland4,mpas.aisgis20km,mpas.gis20km,mpas.ais20km,null + gland20,gland10,gland5,gland5UM,gland4,mpas.aisgis20km,mpas.gis20km,mpas.ais20km,mpas.gis1to10km,null gland5UM build_grid env_build.xml @@ -1149,6 +1158,31 @@ grid mask - DO NOT EDIT (for experts only) + + logical + TRUE,FALSE + FALSE + run_domain + env_run.xml + Use a single point of the global grid but propogate that point to multiple columns - DO NOT EDIT (for experts only) + + + + integer + 0 + run_domain + env_run.xml + number of cells for single point mode when operating on multiple columns in i direction + + + + integer + 0 + run_domain + env_run.xml + number of cells for single point mode when operating on multiple columns in j directions + + logical TRUE,FALSE @@ -2362,7 +2396,7 @@ integer - 1 + 2 1,2 build_macros env_build.xml diff --git a/driver-moab/cime_config/config_component_cesm.xml b/driver-moab/cime_config/config_component_cesm.xml index 426bd3c3c30b..c88aa7c58295 100644 --- a/driver-moab/cime_config/config_component_cesm.xml +++ b/driver-moab/cime_config/config_component_cesm.xml @@ -52,7 +52,7 @@ integer 0,1,2 - 0 + 1 run_flags env_run.xml Sets level of task-to-node mapping output for the whole model @@ -69,6 +69,30 @@ (0: no output; 1: compact; 2: verbose). + + integer + 0,1,2,3,4 + 3 + run_flags + env_run.xml + Sets level of memory profile logging: + 0: no output + 1: log mem-usage from component ROOTPE tasks + 2: log mem-usage from all tasks + 3: aggregate logging to node-level mem-usage on ROOTPE nodes + 4: aggregate logging to node-level mem-usage on all nodes + Aggregation requires INFO_TASKMAP_MODEL>0. + + + + + integer + 86400 + run_flags + env_run.xml + number of seconds between memory profiling logs + + logical TRUE,FALSE diff --git a/driver-moab/cime_config/config_component_e3sm.xml b/driver-moab/cime_config/config_component_e3sm.xml index aaa16692303d..1016b9ade797 100644 --- a/driver-moab/cime_config/config_component_e3sm.xml +++ b/driver-moab/cime_config/config_component_e3sm.xml @@ -40,6 +40,30 @@ (0: no output; 1: compact; 2: verbose). + + integer + 0,1,2,3,4 + 3 + run_flags + env_run.xml + Sets level of memory profile logging: + 0: no output + 1: log mem-usage from component ROOTPE tasks + 2: log mem-usage from all tasks + 3: aggregate logging to node-level mem-usage on ROOTPE nodes + 4: aggregate logging to node-level mem-usage on all nodes + Aggregation requires INFO_TASKMAP_MODEL>0. + + + + + integer + 86400 + run_flags + env_run.xml + number of seconds between memory profiling logs + + logical TRUE,FALSE @@ -125,7 +149,7 @@ none,never,nsteps,nstep,nseconds,nsecond,nminutes,nminute,nhours,nhour,ndays,nday,nmonths,nmonth,nyears,nyear,date,ifdays0,end never - ndays + ndays run_begin_stop_restart env_run.xml @@ -199,7 +223,7 @@ none,CO2A,CO2A_OI,CO2B,CO2C,CO2C_OI,CO2_DMSA none - CO2A + CO2A none CO2C CO2A @@ -271,9 +295,9 @@ day day day - day - day - day + day + day + day Base period associated with NCPL coupling frequency. This xml variable is only used to set the driver namelist variables, @@ -286,20 +310,20 @@ 48 48 - 48 + 48 48 - 144 - 288 - 288 - 48 - 48 + 144 + 288 + 288 + 48 + 48 72 - 48 + 48 4 24 24 24 - 1 + 48 1 1 24 @@ -310,23 +334,30 @@ 48 48 48 + 48 + 48 + 48 96 96 96 96 96 96 - 48 - 12 - 96 - 96 + 48 + 12 + 96 + 96 96 12 24 12 + 72 96 96 144 + 288 + 576 + 1152 144 96 96 @@ -347,10 +378,10 @@ 4 - 96 - 72 - 96 - 72 + 96 + 72 + 96 + 72 run_coupling env_run.xml @@ -367,11 +398,11 @@ 1 1 $ATM_NCPL - 48 - $ATM_NCPL - 12 - 96 - 96 + 48 + $ATM_NCPL + 12 + 96 + 96 run_coupling env_run.xml @@ -388,7 +419,7 @@ 1 1 $ATM_NCPL - $ATM_NCPL + $ATM_NCPL run_coupling env_run.xml @@ -403,12 +434,12 @@ 1 4 - 1 + 1 1 1 1 1 - 1 + 1 1 1 1 @@ -421,6 +452,9 @@ 48 48 48 + 48 + 48 + 48 48 48 48 @@ -444,9 +478,9 @@ 1 1 1 - 1 - 1 - 1 + 1 + 1 + 1 run_coupling env_run.xml @@ -489,10 +523,10 @@ 1 1 24 - 8 - 6 - 4 - 8 + 8 + 6 + 4 + 8 run_coupling env_run.xml @@ -608,9 +642,9 @@ FALSE TRUE - TRUE - TRUE - TRUE + TRUE + TRUE + TRUE run_budgets env_run.xml @@ -625,8 +659,6 @@ 284.7 284.7 284.7 - 0.000001 - 0.000001 367.0 379.000 284.7 @@ -640,16 +672,16 @@ 367.0 367.0 379.000 - 0.000001 - 0.000001 - 0.000001 - 0.000001 - 0.000001 - 0.000001 - 0.000001 - 0.000001 - 0.000001 - 0.000001 + 0.000001 + 0.000001 + 0.000001 + 0.000001 + 0.000001 + 0.000001 + 0.000001 + 0.000001 + 0.000001 + 0.000001 368.9 368.9 367.0 @@ -672,23 +704,23 @@ 284.317 284.317 284.317 - - 0.000001 - 0.000001 + + 0.000001 + 0.000001 - 284.7 - 368.9 - 0.000001 - 0.000001 - 0.000001 - 0.000001 - 0.000001 - 0.000001 + 284.7 + 368.9 + 0.000001 + 0.000001 + 0.000001 + 0.000001 + 0.000001 + 0.000001 348.0 run_co2 env_run.xml - This set the namelist values of CO2 ppmv for CAM and CLM. This variables is + This set the namelist values of CO2 ppmv for EAM and ELM. This variables is introduced to coordinate this value among multiple components. @@ -720,7 +752,7 @@ run_glc env_run.xml Glacier model number of elevation classes, 0 implies no glacier land unit in clm - Used by both CLM and CISM (even if CISM is not running, and only SGLC is used). + Used by both ELM and CISM (even if CISM is not running, and only SGLC is used). @@ -728,9 +760,8 @@ TRUE,FALSE FALSE - TRUE - TRUE - TRUE + TRUE + TRUE TRUE @@ -739,7 +770,7 @@ env_run.xml Whether the glacier component feeds back to the rest of the system This affects: - (1) Whether CLM updates its areas based on glacier areas sent from GLC + (1) Whether ELM updates its areas based on glacier areas sent from GLC (2) Whether GLC sends fluxes (e.g., calving fluxes) to the coupler Note that this is set to TRUE by default for TG compsets - even though there are no feedbacks for TG compsets, this enables extra coupler diagnostics for these @@ -792,12 +823,12 @@ RCP4.5 future scenario: RCP2.6 future scenario: RCP4.5 based scenario from 2013 (control for WACCM/CARMA nuclear winter study): - 1992 to 2005 transient: - prescribed meteorology: for stand-alone cam - ARM95 IOP: for stand-alone cam - ARM97 IOP: for stand-alone cam - CLM transient land use: - CLM transient land use: + 1992 to 2005 transient: + prescribed meteorology: for stand-alone cam + ARM95 IOP: for stand-alone cam + ARM97 IOP: for stand-alone cam + ELM transient land use: + ELM transient land use: pre-industrial (1850) to present day: -----------------------------WARNING ------------------------------------------------ @@ -806,11 +837,5 @@ (land-use, SST, sea ice, CO2, CH4, N2O) to present day and IPCC RCP4.5 scenario data. ------------------------------------------------------------------------------------- - - -----------------------------WARNING ------------------------------------------------ - This compset is not spun-up! In later versions of the model, spun-up initial - conditions will be provided and this warning will be removed. - ------------------------------------------------------------------------------------- - diff --git a/driver-moab/shr/seq_comm_mct.F90 b/driver-moab/shr/seq_comm_mct.F90 index 5b74f0b123fe..a31682c0d515 100644 --- a/driver-moab/shr/seq_comm_mct.F90 +++ b/driver-moab/shr/seq_comm_mct.F90 @@ -275,7 +275,8 @@ subroutine seq_comm_init(global_comm_in, driver_comm_in, nmlfile, drv_comm_id) ocn_ntasks, ocn_rootpe, ocn_pestride, ocn_nthreads, & esp_ntasks, esp_rootpe, esp_pestride, esp_nthreads, & iac_ntasks, iac_rootpe, iac_pestride, iac_nthreads, & - cpl_ntasks, cpl_rootpe, cpl_pestride, cpl_nthreads + cpl_ntasks, cpl_rootpe, cpl_pestride, cpl_nthreads, & + info_taskmap_model namelist /cime_pes/ & atm_ntasks, atm_rootpe, atm_pestride, atm_nthreads, atm_layout, & diff --git a/driver-moab/shr/seq_infodata_mod.F90 b/driver-moab/shr/seq_infodata_mod.F90 index c8d129ee7a13..522030273bbe 100644 --- a/driver-moab/shr/seq_infodata_mod.F90 +++ b/driver-moab/shr/seq_infodata_mod.F90 @@ -83,9 +83,11 @@ MODULE seq_infodata_mod character(SHR_KIND_CL) :: restart_pfile ! Restart pointer file character(SHR_KIND_CL) :: restart_file ! Full archive path to restart file logical :: single_column ! single column mode - logical :: iop_mode ! IOP mode + logical :: scm_multcols ! SCM mode extrapolated to multiple columns real (SHR_KIND_R8) :: scmlat ! single column lat real (SHR_KIND_R8) :: scmlon ! single column lon + integer(SHR_KIND_IN) :: scm_nx ! points in x direction for SCM functionality + integer(SHR_KIND_IN) :: scm_ny ! points in y direction for SCM functionality character(SHR_KIND_CS) :: logFilePostFix ! postfix for output log files character(SHR_KIND_CL) :: outPathRoot ! root for output log files logical :: perpetual ! perpetual flag @@ -332,9 +334,11 @@ SUBROUTINE seq_infodata_Init( infodata, nmlfile, ID, pioid, cpl_tag) character(SHR_KIND_CL) :: restart_file ! Restart filename logical :: single_column ! single column mode - logical :: iop_mode ! IOP mode + logical :: scm_multcols ! SCM mode extrapolated to multiple columns real (SHR_KIND_R8) :: scmlat ! single column mode latitude real (SHR_KIND_R8) :: scmlon ! single column mode longitude + integer(SHR_KIND_IN) :: scm_nx ! points in x direction for SCM functionality + integer(SHR_KIND_IN) :: scm_ny ! points in y direction for SCM functionality character(SHR_KIND_CS) :: logFilePostFix ! postfix for output log files character(SHR_KIND_CL) :: outPathRoot ! root output files logical :: perpetual ! perpetual mode @@ -430,7 +434,8 @@ SUBROUTINE seq_infodata_Init( infodata, nmlfile, ID, pioid, cpl_tag) brnch_retain_casename, info_debug, bfbflag, & restart_pfile, restart_file, run_barriers, & single_column, scmlat, force_stop_at, & - scmlon, iop_mode, logFilePostFix, outPathRoot, flux_diurnal,& + scmlon, logFilePostFix, outPathRoot, flux_diurnal,& + scm_multcols, scm_nx, scm_ny, & ocn_surface_flux_scheme, & coldair_outbreak_mod, & flux_convergence, flux_max_iteration, & @@ -493,9 +498,11 @@ SUBROUTINE seq_infodata_Init( infodata, nmlfile, ID, pioid, cpl_tag) restart_pfile = 'rpointer.drv' restart_file = trim(sp_str) single_column = .false. - iop_mode = .false. + scm_multcols = .false. scmlat = -999. scmlon = -999. + scm_nx = -1 + scm_ny = -1 logFilePostFix = '.log' outPathRoot = './' perpetual = .false. @@ -629,9 +636,11 @@ SUBROUTINE seq_infodata_Init( infodata, nmlfile, ID, pioid, cpl_tag) infodata%restart_file = restart_file end if infodata%single_column = single_column - infodata%iop_mode = iop_mode + infodata%scm_multcols = scm_multcols infodata%scmlat = scmlat infodata%scmlon = scmlon + infodata%scm_nx = scm_nx + infodata%scm_ny = scm_ny infodata%logFilePostFix = logFilePostFix infodata%outPathRoot = outPathRoot infodata%perpetual = perpetual @@ -968,7 +977,8 @@ SUBROUTINE seq_infodata_GetData_explicit( infodata, cime_model, case_name, case_ model_version, username, hostname, rest_case_name, tchkpt_dir, & start_type, restart_pfile, restart_file, perpetual, perpetual_ymd, & aqua_planet,aqua_planet_sst, brnch_retain_casename, & - single_column, scmlat,scmlon,iop_mode,logFilePostFix, outPathRoot,& + single_column, scmlat,scmlon,logFilePostFix, outPathRoot,& + scm_multcols, scm_nx, scm_ny, & atm_present, atm_prognostic, & lnd_present, lnd_prognostic, & rof_present, rof_prognostic, & @@ -1037,7 +1047,9 @@ SUBROUTINE seq_infodata_GetData_explicit( infodata, cime_model, case_name, case_ logical, optional, intent(OUT) :: single_column real (SHR_KIND_R8), optional, intent(OUT) :: scmlat real (SHR_KIND_R8), optional, intent(OUT) :: scmlon - logical, optional, intent(OUT) :: iop_mode + logical, optional, intent(OUT) :: scm_multcols + integer, optional, intent(OUT) :: scm_nx + integer, optional, intent(OUT) :: scm_ny character(len=*), optional, intent(OUT) :: logFilePostFix ! output log file postfix character(len=*), optional, intent(OUT) :: outPathRoot ! output file root logical, optional, intent(OUT) :: perpetual ! If this is perpetual @@ -1213,9 +1225,11 @@ SUBROUTINE seq_infodata_GetData_explicit( infodata, cime_model, case_name, case_ if ( present(restart_pfile) ) restart_pfile = infodata%restart_pfile if ( present(restart_file) ) restart_file = infodata%restart_file if ( present(single_column) ) single_column = infodata%single_column - if ( present(iop_mode ) ) iop_mode = infodata%iop_mode + if ( present(scm_multcols) ) scm_multcols = infodata%scm_multcols if ( present(scmlat) ) scmlat = infodata%scmlat if ( present(scmlon) ) scmlon = infodata%scmlon + if ( present(scm_nx) ) scm_nx = infodata%scm_nx + if ( present(scm_ny) ) scm_ny = infodata%scm_ny if ( present(logFilePostFix) ) logFilePostFix = infodata%logFilePostFix if ( present(outPathRoot) ) outPathRoot = infodata%outPathRoot if ( present(perpetual) ) perpetual = infodata%perpetual @@ -1505,7 +1519,8 @@ SUBROUTINE seq_infodata_PutData_explicit( infodata, cime_model, case_name, case_ model_version, username, hostname, rest_case_name, tchkpt_dir, & start_type, restart_pfile, restart_file, perpetual, perpetual_ymd, & aqua_planet,aqua_planet_sst, brnch_retain_casename, & - single_column, scmlat,scmlon,iop_mode,logFilePostFix, outPathRoot, & + single_column, scmlat,scmlon,logFilePostFix, outPathRoot, & + scm_multcols, scm_nx, scm_ny, & atm_present, atm_prognostic, & lnd_present, lnd_prognostic, & rof_present, rof_prognostic, & @@ -1573,7 +1588,9 @@ SUBROUTINE seq_infodata_PutData_explicit( infodata, cime_model, case_name, case_ logical, optional, intent(IN) :: single_column real (SHR_KIND_R8), optional, intent(IN) :: scmlat real (SHR_KIND_R8), optional, intent(IN) :: scmlon - logical, optional, intent(IN) :: iop_mode + logical, optional, intent(IN) :: scm_multcols + integer, optional, intent(IN) :: scm_nx + integer, optional, intent(IN) :: scm_ny character(len=*), optional, intent(IN) :: logFilePostFix ! output log file postfix character(len=*), optional, intent(IN) :: outPathRoot ! output file root logical, optional, intent(IN) :: perpetual ! If this is perpetual @@ -1746,9 +1763,11 @@ SUBROUTINE seq_infodata_PutData_explicit( infodata, cime_model, case_name, case_ if ( present(restart_pfile) ) infodata%restart_pfile = restart_pfile if ( present(restart_file) ) infodata%restart_file = restart_file if ( present(single_column) ) infodata%single_column = single_column - if ( present(iop_mode) ) infodata%iop_mode = iop_mode + if ( present(scm_multcols) ) infodata%scm_multcols = scm_multcols if ( present(scmlat) ) infodata%scmlat = scmlat if ( present(scmlon) ) infodata%scmlon = scmlon + if ( present(scm_nx) ) infodata%scm_nx = scm_nx + if ( present(scm_ny) ) infodata%scm_ny = scm_ny if ( present(logFilePostFix) ) infodata%logFilePostFix = logFilePostFix if ( present(outPathRoot) ) infodata%outPathRoot = outPathRoot if ( present(perpetual) ) infodata%perpetual = perpetual @@ -2049,9 +2068,11 @@ subroutine seq_infodata_bcast(infodata,mpicom) call shr_mpi_bcast(infodata%restart_pfile, mpicom) call shr_mpi_bcast(infodata%restart_file, mpicom) call shr_mpi_bcast(infodata%single_column, mpicom) - call shr_mpi_bcast(infodata%iop_mode, mpicom) + call shr_mpi_bcast(infodata%scm_multcols, mpicom) call shr_mpi_bcast(infodata%scmlat, mpicom) call shr_mpi_bcast(infodata%scmlon, mpicom) + call shr_mpi_bcast(infodata%scm_nx, mpicom) + call shr_mpi_bcast(infodata%scm_ny, mpicom) call shr_mpi_bcast(infodata%logFilePostFix, mpicom) call shr_mpi_bcast(infodata%outPathRoot, mpicom) call shr_mpi_bcast(infodata%perpetual, mpicom) @@ -2732,9 +2753,11 @@ SUBROUTINE seq_infodata_print( infodata ) write(logunit,F0A) subname,'Restart file (full path) = ', trim(infodata%restart_file) write(logunit,F0L) subname,'single_column = ', infodata%single_column - write(logunit,F0L) subname,'iop_mode = ', infodata%iop_mode + write(logunit,F0L) subname,'scm_multcols = ', infodata%scm_multcols write(logunit,F0R) subname,'scmlat = ', infodata%scmlat write(logunit,F0R) subname,'scmlon = ', infodata%scmlon + write(logunit,F0I) subname,'scm_nx = ', infodata%scm_nx + write(logunit,F0I) subname,'scm_ny = ', infodata%scm_ny write(logunit,F0A) subname,'Log output end name = ', trim(infodata%logFilePostFix) write(logunit,F0A) subname,'Output path dir = ', trim(infodata%outPathRoot) From 37e964fb98b10a3e04a4a14ad3a02998be7c9762 Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Thu, 15 Jul 2021 13:01:22 -0500 Subject: [PATCH 093/467] replace T with theta-l : vtheta_dp another solution would be to change the build options: xmlchange CAM_TARGET=preqx --- components/eam/src/dynamics/se/semoab_mod.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/components/eam/src/dynamics/se/semoab_mod.F90 b/components/eam/src/dynamics/se/semoab_mod.F90 index 69cbc55a4b88..95a982cb4485 100644 --- a/components/eam/src/dynamics/se/semoab_mod.F90 +++ b/components/eam/src/dynamics/se/semoab_mod.F90 @@ -842,7 +842,7 @@ subroutine moab_export_data(elem) do ie=1,num_elem do j=1,np do i=1,np - valuesTag ( (ie-1)*np*np+(j-1)*np + i ) = elem(ie)%state%T(i,j,nlev,1) ! time level 1? + valuesTag ( (ie-1)*np*np+(j-1)*np + i ) = elem(ie)%state%vtheta_dp(i,j,nlev,1) ! time level 1? enddo enddo enddo @@ -901,7 +901,7 @@ subroutine moab_export_data(elem) do i= 1,np ix = local_map(i,j) idx = moabconn( je + ix ) ! - valuesTag ( idx ) = elem(ie)%state%T(i,j,nlev,1) + valuesTag ( idx ) = elem(ie)%state%vtheta_dp(i,j,nlev,1) end do end do end do From b110f688fe17bb78fabe7b0accf1dc5d984727e5 Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Thu, 15 Jul 2021 13:20:41 -0500 Subject: [PATCH 094/467] new bubble option (same as commit 06f89c883a6a76346b6d on sarich/use-moab-driver-rebase) --- driver-moab/main/prep_atm_mod.F90 | 12 +++++++----- 1 file changed, 7 insertions(+), 5 deletions(-) diff --git a/driver-moab/main/prep_atm_mod.F90 b/driver-moab/main/prep_atm_mod.F90 index e30edd10e37f..856e9cd9870d 100644 --- a/driver-moab/main/prep_atm_mod.F90 +++ b/driver-moab/main/prep_atm_mod.F90 @@ -349,7 +349,7 @@ subroutine prep_atm_ocn_moab(infodata) integer :: atm_id character*32 :: dm1, dm2, dofnameATM, dofnameOCN, wgtIdef integer :: orderOCN, orderATM, volumetric, noConserve, validate - integer :: monotonicity + integer :: fNoBubble, monotonicity integer :: mpigrp_CPLID ! coupler pes group, used for comm graph phys <-> atm-ocn integer :: mpigrp_old ! component group pes (phys grid atm) == atm group @@ -407,17 +407,18 @@ subroutine prep_atm_ocn_moab(infodata) dm2 = "fv"//CHAR(0) dofnameOCN="GLOBAL_ID"//CHAR(0) orderOCN = 1 ! not much arguing + fNoBubble = 1 monotonicity = 0 ! noConserve = 0 validate = 1 if (iamroot_CPLID) then write(logunit,*) 'launch iMOAB weights with args ', mbintxoa, wgtIdef, & trim(dm1), orderATM, trim(dm2), orderOCN, & - monotonicity, volumetric, noConserve, validate + fNoBubble, monotonicity, volumetric, noConserve, validate end if ierr = iMOAB_ComputeScalarProjectionWeights ( mbintxoa, wgtIdef, & trim(dm1), orderATM, trim(dm2), orderOCN, & - monotonicity, volumetric, noConserve, validate, & + fNoBubble, monotonicity, volumetric, noConserve, validate, & trim(dofnameATM), trim(dofnameOCN) ) if (ierr .ne. 0) then write(logunit,*) subname,' error in computing weights atm/ocn ' @@ -490,7 +491,7 @@ subroutine prep_atm_lnd_moab(infodata) integer :: atm_id character*32 :: dm1, dm2, dofnameATM, dofnameLND, wgtIdef integer :: orderLND, orderATM, volumetric, noConserve, validate - integer :: monotonicity + integer :: fNoBubble, monotonicity integer :: mpigrp_CPLID ! coupler pes group, used for comm graph phys <-> atm-ocn integer :: mpigrp_old ! component group pes (phys grid atm) == atm group integer :: typeA, typeB ! type for computing graph; @@ -551,13 +552,14 @@ subroutine prep_atm_lnd_moab(infodata) dm2 = "fv"//CHAR(0) ! land is FV volumetric = 1 endif + fNoBubble = 1 monotonicity = 0 ! noConserve = 0 validate = 1 ierr = iMOAB_ComputeScalarProjectionWeights ( mbintxla, wgtIdef, & trim(dm1), orderATM, trim(dm2), orderLND, & - monotonicity, volumetric, noConserve, validate, & + fNoBubble, monotonicity, volumetric, noConserve, validate, & trim(dofnameATM), trim(dofnameLND) ) if (ierr .ne. 0) then write(logunit,*) subname,' error in computing weights atm land ' From dbd7bcfd192fa3e6e4df95f29541ebc605639834 Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Tue, 3 Aug 2021 11:30:11 -0500 Subject: [PATCH 095/467] changes required for new context logic before, context_id defaulted to -1 for initial migrate now, it will show the other component id also, iMOAB_GraphCoverage changed API it has ids for components from initial migrate this should work now against the branch iulian07/context_changes_master in MOAB --- driver-moab/main/cplcomp_exchange_mod.F90 | 4 ++++ driver-moab/main/prep_atm_mod.F90 | 8 ++++---- driver-moab/main/prep_lnd_mod.F90 | 9 ++++++--- driver-moab/main/prep_ocn_mod.F90 | 7 +++++-- 4 files changed, 19 insertions(+), 9 deletions(-) diff --git a/driver-moab/main/cplcomp_exchange_mod.F90 b/driver-moab/main/cplcomp_exchange_mod.F90 index 4f5c56f526a5..caabba4cdcca 100644 --- a/driver-moab/main/cplcomp_exchange_mod.F90 +++ b/driver-moab/main/cplcomp_exchange_mod.F90 @@ -1097,6 +1097,7 @@ subroutine cplcomp_moab_Init(comp) ! iMOAB_FreeSenderBuffers needs to be called after receiving the mesh if (mhid .ge. 0) then ! we are on component atm pes + context_id = id_join if (atm_pg_active) then! we send mesh from mhpgid app ierr = iMOAB_FreeSenderBuffers(mhpgid, context_id) else @@ -1224,6 +1225,7 @@ subroutine cplcomp_moab_Init(comp) #endif endif if (mpoid .ge. 0) then ! we are on component ocn pes + context_id = id_join ierr = iMOAB_FreeSenderBuffers(mpoid, context_id) if (ierr .ne. 0) then write(logunit,*) subname,' error in freeing buffers ' @@ -1314,6 +1316,7 @@ subroutine cplcomp_moab_Init(comp) #endif endif if (mlnid .ge. 0) then ! we are on component land pes + context_id = id_join ierr = iMOAB_FreeSenderBuffers(mlnid, context_id) if (ierr .ne. 0) then write(logunit,*) subname,' error in freeing buffers' @@ -1397,6 +1400,7 @@ subroutine cplcomp_moab_Init(comp) #endif endif if (MPSIID .ge. 0) then ! we are on component sea ice pes + context_id = id_join ierr = iMOAB_FreeSenderBuffers(MPSIID, context_id) if (ierr .ne. 0) then write(logunit,*) subname,' error in freeing buffers ' diff --git a/driver-moab/main/prep_atm_mod.F90 b/driver-moab/main/prep_atm_mod.F90 index 856e9cd9870d..272c6b638fe3 100644 --- a/driver-moab/main/prep_atm_mod.F90 +++ b/driver-moab/main/prep_atm_mod.F90 @@ -376,12 +376,12 @@ subroutine prep_atm_ocn_moab(infodata) ! it happens over joint communicator if (atm_pg_active ) then ! use mhpgid mesh - ierr = iMOAB_CoverageGraph(mpicom_join, mhpgid, mbaxid, mbintxoa, context_id); + ierr = iMOAB_CoverageGraph(mpicom_join, mhpgid, mbaxid, mbintxoa, atm_id, id_join, context_id); if (iamroot_CPLID) then write(logunit,*) 'iMOAB graph atmpg2-intxao context: ', context_id end if else - ierr = iMOAB_CoverageGraph(mpicom_join, mhid, mbaxid, mbintxoa, context_id); + ierr = iMOAB_CoverageGraph(mpicom_join, mhid, mbaxid, mbintxoa, atm_id, id_join, context_id); if (iamroot_CPLID) then write(logunit,*) 'iMOAB graph atmnp4-intxao context: ', context_id end if @@ -517,9 +517,9 @@ subroutine prep_atm_lnd_moab(infodata) context_id = lnd(1)%cplcompid call seq_comm_getinfo(ID_join,mpicom=mpicom_join) if (atm_pg_active ) then ! use mhpgid mesh - ierr = iMOAB_CoverageGraph(mpicom_join, mhpgid, mbaxid, mbintxla, context_id); + ierr = iMOAB_CoverageGraph(mpicom_join, mhpgid, mbaxid, mbintxla, atm_id, id_join, context_id); else - ierr = iMOAB_CoverageGraph(mpicom_join, mhid, mbaxid, mbintxla, context_id); + ierr = iMOAB_CoverageGraph(mpicom_join, mhid, mbaxid, mbintxla, atm_id, id_join, context_id); endif if (ierr .ne. 0) then write(logunit,*) subname,' error in computing coverage graph atm/lnd ' diff --git a/driver-moab/main/prep_lnd_mod.F90 b/driver-moab/main/prep_lnd_mod.F90 index 23dfa451df9d..f8bb4faa33a7 100644 --- a/driver-moab/main/prep_lnd_mod.F90 +++ b/driver-moab/main/prep_lnd_mod.F90 @@ -571,7 +571,7 @@ subroutine prep_lnd_migrate_moab(infodata) logical :: lnd_present ! .true. => lnd is present integer :: id_join integer :: mpicom_join - integer :: atmid + integer :: lndid1 integer :: context_id character*32 :: dm1, dm2 character*50 :: tagName @@ -590,7 +590,7 @@ subroutine prep_lnd_migrate_moab(infodata) ! (not processed for coverage) ! how to get mpicomm for joint ocn + coupler id_join = lnd(1)%cplcompid - lndid = lnd(1)%compid + lndid1 = lnd(1)%compid call seq_comm_getinfo(ID_join,mpicom=mpicom_join) context_id = -1 ! now send the tag a2oTbot_proj, a2oUbot_proj, a2oVbot_proj from ocn on coupler pes towards original ocean mesh @@ -599,17 +599,20 @@ subroutine prep_lnd_migrate_moab(infodata) if (mblxid .ge. 0) then ! send because we are on coupler pes ! basically, use the initial partitioning - ierr = iMOAB_SendElementTag(mblxid, tagName, mpicom_join, context_id) + context_id = lndid1 + ierr = iMOAB_SendElementTag(mblxid, tagName, mpicom_join, context_id) endif if (mlnid .ge. 0 ) then ! we are on land pes, for sure ! receive on land pes, a tag that was computed on coupler pes + context_id = id_join ierr = iMOAB_ReceiveElementTag(mlnid, tagName, mpicom_join, context_id) !CHECKRC(ierr, "cannot receive tag values") endif ! we can now free the sender buffers if (mblxid .ge. 0) then + context_id = lndid1 ierr = iMOAB_FreeSenderBuffers(mblxid, context_id) ! CHECKRC(ierr, "cannot free buffers used to send projected tag towards the ocean mesh") endif diff --git a/driver-moab/main/prep_ocn_mod.F90 b/driver-moab/main/prep_ocn_mod.F90 index c928eb3b3916..003987323312 100644 --- a/driver-moab/main/prep_ocn_mod.F90 +++ b/driver-moab/main/prep_ocn_mod.F90 @@ -1490,7 +1490,7 @@ subroutine prep_ocn_migrate_moab(infodata) logical :: ocn_present ! .true. => ocn is present integer :: id_join integer :: mpicom_join - integer :: atmid + integer :: ocnid1 integer :: context_id character*32 :: dm1, dm2 character*50 :: tagName @@ -1509,7 +1509,7 @@ subroutine prep_ocn_migrate_moab(infodata) ! (not processed for coverage) ! how to get mpicomm for joint ocn + coupler id_join = ocn(1)%cplcompid - ocnid = ocn(1)%compid + ocnid1 = ocn(1)%compid call seq_comm_getinfo(ID_join,mpicom=mpicom_join) context_id = -1 ! now send the tag a2oTbot_proj, a2oUbot_proj, a2oVbot_proj from ocn on coupler pes towards original ocean mesh @@ -1518,17 +1518,20 @@ subroutine prep_ocn_migrate_moab(infodata) if (mboxid .ge. 0) then ! send because we are on coupler pes ! basically, use the initial partitioning + context_id = ocnid1 ierr = iMOAB_SendElementTag(mboxid, tagName, mpicom_join, context_id) endif if (mpoid .ge. 0 ) then ! we are on ocean pes, for sure ! receive on ocean pes, a tag that was computed on coupler pes + context_id = id_join ierr = iMOAB_ReceiveElementTag(mpoid, tagName, mpicom_join, context_id) !CHECKRC(ierr, "cannot receive tag values") endif ! we can now free the sender buffers if (mboxid .ge. 0) then + context_id = ocnid1 ierr = iMOAB_FreeSenderBuffers(mboxid, context_id) ! CHECKRC(ierr, "cannot free buffers used to send projected tag towards the ocean mesh") endif From ef7b3d87adbde465c3ef15bae5e2e8c2a6a5389c Mon Sep 17 00:00:00 2001 From: Robert Jacob Date: Tue, 10 Aug 2021 23:16:40 -0500 Subject: [PATCH 096/467] Update config_compilers and machines to latest master Update config_compilers and machines to be identical to master as of Aug 12, 2021, d53497edf3a. Only change is to add MOAB_PATH to bebob, chrysalis and anlworkstation. --- cime_config/machines/config_compilers.xml | 343 +++++------------ cime_config/machines/config_machines.xml | 435 +++++++--------------- 2 files changed, 216 insertions(+), 562 deletions(-) diff --git a/cime_config/machines/config_compilers.xml b/cime_config/machines/config_compilers.xml index f42ca369ef81..1c94c907c9ec 100644 --- a/cime_config/machines/config_compilers.xml +++ b/cime_config/machines/config_compilers.xml @@ -195,6 +195,9 @@ flags should be captured within MPAS CMake files. -DFORTRANUNDERSCORE -DNO_R16 -DCPRGNU + + -DYAKL_DEBUG + FORTRAN -fdefault-real-8 @@ -678,9 +681,6 @@ flags should be captured within MPAS CMake files. -O2 - - --host=Linux - -lstdc++ @@ -753,6 +753,9 @@ flags should be captured within MPAS CMake files. -static-intel + mpiicc + mpiicpc + mpiifort gpfs $SHELL{$ENV{NETCDF_FORTRAN_PATH}/bin/nf-config --flibs} @@ -764,82 +767,25 @@ flags should be captured within MPAS CMake files. $ENV{PNETCDF_PATH} - + + /lcrc/soft/climate/moab/chrysalis/intel - -DHAVE_SLASHPROC + -DHAVE_SLASHPROC - /lcrc/soft/climate/moab/anvil/intel18 - - --host=Linux - - gpfs - - $SHELL{$ENV{NETCDF_FORTRAN_PATH}/bin/nf-config --flibs} - $SHELL{$ENV{NETCDF_C_PATH}/bin/nc-config --libs} - -Wl,--start-group $ENV{MKLROOT}/lib/intel64/libmkl_intel_lp64.a $ENV{MKLROOT}/lib/intel64/libmkl_sequential.a $ENV{MKLROOT}/lib/intel64/libmkl_core.a -Wl,--end-group -lpthread -lm -ldl - - $ENV{NETCDF_C_PATH} - $ENV{NETCDF_FORTRAN_PATH} - $ENV{PNETCDF_PATH} - -O2 -fp-model precise -std=gnu99 - -qopenmp -static-intel - -heap-arrays - -O2 -debug minimal - -O0 -g + -static-intel + -march=core-avx2 + -O3 - -std=c++14 -fp-model source - -qopenmp -static-intel - -O0 -g - -O2 + -static-intel + -axCORE-AVX2 + -O3 - - -DFORTRANUNDERSCORE -DNO_R16 -DCPRINTEL - - - -cxxlib - - FORTRAN - - -r8 - - -convert big_endian -assume byterecl -ftz -traceback -assume realloc_lhs -fp-model source - -qopenmp -static-intel - -heap-arrays - -O0 -g -check uninit -check bounds -check pointers -fpe0 -check noarg_temp_created - -O2 -debug minimal -qno-opt-dynamic-align - $SHELL{$ENV{NETCDF_FORTRAN_PATH}/bin/nf-config --fflags} - - - -O0 - - - -fixed -132 - - - -free - - TRUE - - -qopenmp -static-intel - - mpicc - mpicxx - mpif90 - icc - icpc - ifort - TRUE - - - - - -DHAVE_SLASHPROC - - - -O2 -debug minimal -qno-opt-dynamic-align + -static-intel + -axCORE-AVX2 + -O3 -qno-opt-dynamic-align gpfs @@ -848,12 +794,6 @@ flags should be captured within MPAS CMake files. $ENV{NETCDF_C_PATH} $ENV{NETCDF_FORTRAN_PATH} $ENV{PNETCDF_PATH} - - -static-intel - - - -static-intel - -static-intel @@ -918,56 +858,7 @@ flags should be captured within MPAS CMake files. $ENV{PNETCDF_PATH} - - - -DHAVE_SLASHPROC - - /lcrc/soft/climate/moab/chrysalis/intel - - -O2 -debug minimal -qno-opt-dynamic-align - - gpfs - - $SHELL{$ENV{NETCDF_FORTRAN_PATH}/bin/nf-config --flibs} $SHELL{$ENV{NETCDF_C_PATH}/bin/nc-config --libs} -mkl - - $ENV{NETCDF_C_PATH} - $ENV{NETCDF_FORTRAN_PATH} - $ENV{PNETCDF_PATH} - - -static-intel - - - -static-intel - - - -static-intel - - mpiicc - mpiicpc - mpiifort - - - - - -DHAVE_NANOTIME -DBIT64 -DHAVE_SLASHPROC -DHAVE_GETTIMEOFDAY - - gpfs - - $SHELL{$ENV{NETCDF_FORTRAN_PATH}/bin/nf-config --flibs} $SHELL{$ENV{NETCDF_C_PATH}/bin/nc-config --libs} - -Wl,--start-group $ENV{MKLROOT}/lib/intel64/libmkl_gf_lp64.a $ENV{MKLROOT}/lib/intel64/libmkl_sequential.a $ENV{MKLROOT}/lib/intel64/libmkl_core.a -Wl,--end-group -lpthread -lm -ldl - - - -lstdc++ - - $ENV{NETCDF_C_PATH} - $ENV{NETCDF_FORTRAN_PATH} - $ENV{PNETCDF_PATH} - - - - --host=Linux - -DGPU -DHAVE_NANOTIME -DBIT64 -DHAVE_SLASHPROC -DHAVE_GETTIMEOFDAY @@ -1051,7 +942,7 @@ flags should be captured within MPAS CMake files. - --host=Linux --enable-filesystem-hints=lustre + --enable-filesystem-hints=lustre -DLINUX @@ -1090,9 +981,6 @@ flags should be captured within MPAS CMake files. -O2 - - --host=Linux - -DLINUX @@ -1112,9 +1000,6 @@ flags should be captured within MPAS CMake files. -O2 - - --host=Linux - -DLINUX @@ -1134,9 +1019,6 @@ flags should be captured within MPAS CMake files. -O2 -kind=byte - - --host=Linux - -DLINUX @@ -1156,9 +1038,6 @@ flags should be captured within MPAS CMake files. -O2 - - --host=Linux - -DLINUX @@ -1180,9 +1059,6 @@ flags should be captured within MPAS CMake files. -O2 -DHAVE_SLASHPROC - - --host=Linux - -DLINUX @@ -1210,9 +1086,6 @@ flags should be captured within MPAS CMake files. -lstdc++ FORTRAN - - --host=Linux - -DLINUX @@ -1236,9 +1109,6 @@ flags should be captured within MPAS CMake files. /global/cfs/cdirs/e3sm/software/albany-trilinos/albany-install-2020-08-07 - - --host=Linux - -convert big_endian -assume byterecl -ftz -traceback -assume realloc_lhs -fp-model consistent -fimf-use-svml -O2 -debug minimal -qno-opt-dynamic-align @@ -1272,13 +1142,13 @@ flags should be captured within MPAS CMake files. - /global/cfs/cdirs/e3sm/software/albany-trilinos/albany-install-2020-08-07 + /global/homes/m/mperego/e3sm-software/albany-trilinos/albany-install-2021-01-05 + + --host=cray + -axMIC-AVX512 -xCORE-AVX2 - - --host=Linux - -DARCH_MIC_KNL @@ -1326,9 +1196,6 @@ flags should be captured within MPAS CMake files. -O2 - - --host=Linux - /projects/ccsm/esmf-6.3.0rp1/lib/libO/Linux.intel.64.openmpi.default -O2 @@ -1415,9 +1282,6 @@ flags should be captured within MPAS CMake files. -O2 - - --host=Linux - -lstdc++ -lmpi_cxx @@ -1468,9 +1332,6 @@ flags should be captured within MPAS CMake files. -O2 - - --host=Linux - -lstdc++ @@ -1493,9 +1354,6 @@ flags should be captured within MPAS CMake files. -O2 - - --host=Linux - -lstdc++ -lmpi_cxx @@ -1517,9 +1375,6 @@ flags should be captured within MPAS CMake files. -O2 - - --host=Linux - -lstdc++ @@ -1542,9 +1397,6 @@ flags should be captured within MPAS CMake files. -O2 - - --host=Linux - -lstdc++ -lmpi_cxx @@ -1625,9 +1477,6 @@ flags should be captured within MPAS CMake files. -O2 - - --host=Linux - /projects/ccsm/esmf-6.3.0rp1/lib/libO/Linux.intel.64.openmpi.default -O2 @@ -1648,9 +1497,6 @@ flags should be captured within MPAS CMake files. -xCORE-AVX2 - - --host=Linux - -DLINUX -DHAVE_NANOTIME -DBIT64 -DHAVE_VPRINTF -DHAVE_BACKTRACE -DHAVE_SLASHPROC -DHAVE_COMM_F2C -DHAVE_TIMES -DHAVE_GETTIMEOFDAY @@ -1684,9 +1530,6 @@ flags should be captured within MPAS CMake files. -O2 - - --host=Linux - -O2 @@ -1716,9 +1559,6 @@ flags should be captured within MPAS CMake files. -O2 - - --host=Linux - -O2 @@ -1751,9 +1591,6 @@ flags should be captured within MPAS CMake files. - - --host=Linux - -DLINUX -DHAVE_SLASHPROC @@ -1821,9 +1658,6 @@ flags should be captured within MPAS CMake files. -qsuffix=f=f90:cpp=F90 TRUE - - --host=Linux - -Wl,--relax -Wl,--allow-multiple-definition -qsmp -qoffload -lcudart -L$ENV{CUDA_DIR}/lib64 @@ -1851,9 +1685,6 @@ flags should be captured within MPAS CMake files. -O2 -Mvect=nosimd - - --host=Linux - -O2 -DSUMMITDEV_PGI @@ -1883,10 +1714,7 @@ flags should be captured within MPAS CMake files. -O2 -Mvect=nosimd - - --host=Linux - - + -DGPU -DHAVE_SLASHPROC @@ -1922,9 +1750,6 @@ flags should be captured within MPAS CMake files. -O2 - - --host=Linux - -O2 @@ -1954,9 +1779,6 @@ flags should be captured within MPAS CMake files. -O2 - - --host=Linux - -O2 @@ -1982,9 +1804,6 @@ flags should be captured within MPAS CMake files. - - --host=Linux - -DLINUX -DHAVE_SLASHPROC @@ -2053,9 +1872,6 @@ flags should be captured within MPAS CMake files. -qsuffix=f=f90:cpp=F90 TRUE - - --host=Linux - -Wl,--relax -Wl,--allow-multiple-definition -qsmp -qoffload -lcudart -L$ENV{CUDA_DIR}/lib64 @@ -2083,9 +1899,6 @@ flags should be captured within MPAS CMake files. -O2 -Mvect=nosimd - - --host=Linux - -O2 -DSUMMITDEV_PGI @@ -2115,10 +1928,7 @@ flags should be captured within MPAS CMake files. -O2 -Mvect=nosimd - - --host=Linux - - + -DGPU -DHAVE_SLASHPROC @@ -2154,9 +1964,6 @@ flags should be captured within MPAS CMake files. -O2 - - --host=Linux - -DNO_SHR_VMATH -DCNL @@ -2179,9 +1986,6 @@ flags should be captured within MPAS CMake files. -O2 - - --host=Linux - -DNO_SHR_VMATH -DCNL @@ -2201,9 +2005,6 @@ flags should be captured within MPAS CMake files. - - --host=Linux - -O2 -O0 @@ -2221,9 +2022,6 @@ flags should be captured within MPAS CMake files. - - --host=Linux - -DARCH_MIC_KNL @@ -2242,9 +2040,6 @@ flags should be captured within MPAS CMake files. - - --host=Linux - -DHAVE_SLASHPROC @@ -2259,9 +2054,6 @@ flags should be captured within MPAS CMake files. - - --host=Linux - -O1 @@ -2279,23 +2071,56 @@ flags should be captured within MPAS CMake files. - - - --host=Linux - - - -DHAVE_SLASHPROC - + + - -convert big_endian -assume byterecl -ftz -traceback -assume realloc_lhs -fp-model consistent - -O2 -debug minimal -qno-opt-dynamic-align -fp-speculation=off + -convert big_endian -assume byterecl -traceback -assume realloc_lhs -fp-model consistent + -qopenmp + -O2 + -O0 -g -check uninit -check bounds -check pointers -fpe0 -check noarg_temp_created - mpiifort - mpiicc - mpiicpc + + -fp-model precise -std=gnu99 -traceback + -qopenmp + -O2 + -O0 -g + + + -std=c++14 -fp-model precise -traceback + -qopenmp + -O2 + -O0 -g + + TRUE + FORTRAN + + -cxxlib + + + -DFORTRANUNDERSCORE -DNO_R16 -DCPRINTEL -DHAVE_SLASHPROC + + + -r8 + + + -O0 + + + -fixed -132 + + + -free + + TRUE + mpif90 + mpicc + mpicxx icc icpc ifort + + -qopenmp + $SHELL{$ENV{NETCDF_PATH}/bin/nf-config --flibs} -Wl,-rpath -Wl,$ENV{NETCDF_PATH}/lib -mkl $SHELL{$ENV{NETCDF_PATH}/bin/nc-config --libs} @@ -2303,37 +2128,36 @@ flags should be captured within MPAS CMake files. $ENV{NETCDF_PATH} $ENV{PNETCDF_PATH} + - + + - -convert big_endian -assume byterecl -assume realloc_lhs -fp-model consistent + -traceback -convert big_endian -assume byterecl -assume realloc_lhs -fp-model precise -qopenmp -O2 -O0 -g -check uninit -check bounds -check pointers -fpe0 -check noarg_temp_created - -fp-model precise -std=gnu99 + -traceback -fp-model precise -std=gnu99 -qopenmp -O2 -O0 -g - -std=c++14 -fp-model source + -traceback -std=c++17 -fp-model precise -qopenmp -O2 -O0 -g + TRUE + FORTRAN -cxxlib - TRUE - FORTRAN -DFORTRANUNDERSCORE -DNO_R16 -DCPRINTEL -DHAVE_SLASHPROC - - --host=Linux - -r8 @@ -2347,27 +2171,28 @@ flags should be captured within MPAS CMake files. -free TRUE + mpiifx mpiicx mpiicpx icx icpx ifx + -qopenmp - $SHELL{$ENV{NETCDF_PATH}/bin/nf-config --flibs} -Wl,-rpath -Wl,$ENV{NETCDF_PATH}/lib -mkl + $SHELL{$ENV{NETCDF_PATH}/bin/nf-config --flibs} -Wl,-rpath -Wl,$ENV{NETCDF_PATH}/lib -qmkl $SHELL{$ENV{NETCDF_PATH}/bin/nc-config --libs} + -fiopenmp -fopenmp-targets=spir64 $ENV{NETCDF_PATH} $ENV{PNETCDF_PATH} + - - --host=Linux - -DHAVE_SLASHPROC @@ -2380,7 +2205,7 @@ flags should be captured within MPAS CMake files. $SHELL{$ENV{NETCDF_PATH}/bin/nf-config --flibs} -Wl,-rpath -Wl,$ENV{NETCDF_PATH}/lib $SHELL{$ENV{NETCDF_PATH}/bin/nc-config --libs} - -L/gpfs/jlse-fs0/projects/climate/soft/libs -llapack -lblas + -L/home/azamat/soft/libs -llapack -lblas $ENV{NETCDF_PATH} $ENV{PNETCDF_PATH} diff --git a/cime_config/machines/config_machines.xml b/cime_config/machines/config_machines.xml index 04738dc7cfc3..a867a3fb6ce6 100644 --- a/cime_config/machines/config_machines.xml +++ b/cime_config/machines/config_machines.xml @@ -179,7 +179,7 @@ git git cmake - cmake/3.14.4 + cmake/3.20.2 perl5-extras @@ -332,7 +332,7 @@ git git cmake - cmake/3.14.4 + cmake/3.20.2 perl5-extras @@ -523,7 +523,7 @@ $ENV{HOME}/projects/e3sm/baselines/$COMPILER $CCSMROOT/tools/cprnc/build/cprnc make - 16 + 4 e3sm_developer none lukasz at uchicago dot edu @@ -559,7 +559,7 @@ Linux workstation for Jenkins testing (melvin|watson|s999964|climate|penn|sems) LINUX - sonproxy.sandia.gov:80 + proxy.sandia.gov:80 gnu,intel openmpi /sems-data-store/ACME/timings @@ -598,7 +598,7 @@ acme-env sems-git acme-binutils - sems-python/2.7.9 + sems-python/3.5.2 sems-cmake/3.12.2 @@ -633,7 +633,7 @@ Huge Linux workstation for Sandia climate scientists mappy LINUX - wwwproxy.sandia.gov:80 + proxy.sandia.gov:80 gnu,intel openmpi /sems-data-store/ACME/mappy/timings @@ -671,8 +671,8 @@ sems-env acme-env sems-git - sems-python/2.7.9 - sems-cmake/3.12.2 + sems-python/3.5.2 + sems-cmake/3.19.1 acme-gcc/8.1.0 @@ -821,9 +821,6 @@ /software/common/adm/packages/softenv-1.6.2/etc/softenv-load.sh source /software/common/adm/packages/softenv-1.6.2/etc/softenv-aliases.csh ; soft source /software/common/adm/packages/softenv-1.6.2/etc/softenv-aliases.sh ; soft - - +cmake-3.12.4 - +gcc-8.2.0 @@ -831,6 +828,7 @@ $CIME_OUTPUT_ROOT/$CASE/run $CIME_OUTPUT_ROOT/$CASE/bld + /soft/apps/packages/climate/cmake/3.18.4/bin:/soft/apps/packages/climate/gmake/bin:$ENV{PATH} /soft/apps/packages/climate/hdf5/1.8.16-serial/gcc-8.2.0/lib:/soft/apps/packages/climate/szip/2.1/gcc-8.2.0/lib:$ENV{LD_LIBRARY_PATH} @@ -840,7 +838,7 @@ /soft/apps/packages/climate/hdf5/1.8.16-parallel/mpich-3.3.2/gcc-8.2.0/lib:/soft/apps/packages/climate/szip/2.1/gcc-8.2.0/lib:$ENV{LD_LIBRARY_PATH} - /soft/apps/packages/climate/mpich/3.3.2/gcc-8.2.0/bin:$ENV{PATH} + /soft/apps/packages/climate/mpich/3.3.2/gcc-8.2.0/bin:/soft/apps/packages/climate/cmake/3.18.4/bin:/soft/apps/packages/climate/gmake/bin:$ENV{PATH} /soft/apps/packages/climate/hdf5/1.8.16-parallel/mpich-3.3.2/gcc-8.2.0 @@ -850,7 +848,7 @@ - /soft/apps/packages/climate/openmpi/2.1.5/gcc-8.2.0/bin:$ENV{PATH} + /soft/apps/packages/climate/openmpi/2.1.5/gcc-8.2.0/bin:/soft/apps/packages/climate/cmake/3.18.4/bin:/soft/apps/packages/climate/gmake/bin:$ENV{PATH} /soft/apps/packages/climate/zlib/1.2.11/gcc-8.2.0-static /soft/apps/packages/climate/szip/2.1/gcc-8.2.0-static /soft/apps/packages/climate/hdf5/1.8.12-parallel/openmpi-2.1.5/gcc-8.2.0-static @@ -866,10 +864,10 @@ SNL clust (skybridge|chama) LINUX - wwwproxy.sandia.gov:80 + proxy.sandia.gov:80 intel openmpi - fy190158 + fy210162 /projects/ccsm/timings .* /gpfs1/$USER/acme_scratch/sandiatoss3 @@ -909,9 +907,8 @@ sems-env acme-env sems-git - sems-python/2.7.9 - sems-cmake/3.12.2 - gnu/4.9.2 + sems-cmake/3.19.1 + gnu/6.3.1 sems-intel/17.0.0 @@ -943,10 +940,10 @@ SNL clust ghost-login LINUX - wwwproxy.sandia.gov:80 + proxy.sandia.gov:80 intel openmpi - fy190158 + fy210162 /gscratch/$USER/acme_scratch/ghost /projects/ccsm/inputdata @@ -984,7 +981,7 @@ sems-env sems-git - sems-python/2.7.9 + sems-python/3.5.2 sems-cmake gnu/4.9.2 sems-intel/16.0.2 @@ -1012,14 +1009,16 @@ ANL/LCRC Linux Cluster - blueslogin.*.lcrc.anl.gov + b.*.lcrc.anl.gov LINUX - intel,intel18,gnu - mvapich + intel,gnu + impi,openmpi,mvapich condo /lcrc/group/e3sm .* /lcrc/group/e3sm/$USER/scratch/anvil + /lcrc/group/e3sm/public_html/$ENV{USER} + https://web.lcrc.anl.gov/public/e3sm/$ENV{USER} /lcrc/group/e3sm/data/inputdata /lcrc/group/e3sm/data/inputdata/atm/datm7 /lcrc/group/e3sm/$USER/archive/$CASE @@ -1038,12 +1037,9 @@ -l -n {{ total_tasks }} -N {{ num_nodes }} --kill-on-bad-exit --cpu_bind=cores -c $ENV{OMP_NUM_THREADS} - -m plane=$SHELL{echo 36/$OMP_NUM_THREADS|bc} + -m plane={{ tasks_per_node }} - - - /home/software/spack-0.10.1/opt/spack/linux-centos7-x86_64/gcc-4.8.5/lmod-7.4.9-ic63herzfgw5u3na5mdtvp3nwxy6oj2z/lmod/lmod/init/sh;export MODULEPATH=$MODULEPATH:/software/centos7/spack-latest/share/spack/lmod/linux-centos7-x86_64/Core /home/software/spack-0.10.1/opt/spack/linux-centos7-x86_64/gcc-4.8.5/lmod-7.4.9-ic63herzfgw5u3na5mdtvp3nwxy6oj2z/lmod/lmod/init/csh;setenv MODULEPATH $MODULEPATH\:/software/centos7/spack-latest/share/spack/lmod/linux-centos7-x86_64/Core @@ -1053,42 +1049,59 @@ module - cmake/3.14.2-gvwazz3 + cmake/3.20.3-vedypwm - intel/17.0.0-pwabdn2 - intel-mkl/2017.1.132-6qy7y5f - netcdf/4.4.1-tckdgwl - netcdf-cxx/4.2-3qkutvv - netcdf-fortran/4.4.4-urmb6ss + gcc/7.4.0 + intel/20.0.4-lednsve + intel-mkl/2020.4.304-voqlapk - mvapich2/2.2-verbs-qwuab3b - parallel-netcdf/1.11.0-6qz7skn + mvapich2/2.3.6-verbs-x4iz7lq + netcdf-c/4.4.1-gei7x7w + netcdf-cxx/4.2-db2f5or + netcdf-fortran/4.4.4-b4ldb3a + parallel-netcdf/1.11.0-kj4jsvt - - intel/18.0.4-443hhug - intel-mkl/2018.4.274-jwaeshj - netcdf-cxx/4.2-rzdxzwf + + intel-mpi/2019.9.304-i42whlw + netcdf-c/4.4.1-blyisdg + netcdf-cxx/4.2-gkqc6fq + netcdf-fortran/4.4.4-eanrh5t + parallel-netcdf/1.11.0-y3nmmej - - mvapich2/2.3.1-verbs-dtbb6xk - hdf5/1.10.5-4rufvi6 - netcdf/4.4.1-4odwn5a - netcdf-fortran/4.4.4-kgp5hqm - parallel-netcdf/1.8.1-xqvwg7l + + openmpi/4.1.1-v3b3npd + netcdf-c/4.4.1-smyuxme + netcdf-cxx/4.2-kfb2aag + netcdf-fortran/4.4.4-mablvyc + parallel-netcdf/1.11.0-x4n5s7k gcc/8.2.0-xhxgy33 - intel-mkl/2018.4.274-2amycpi + intel-mkl/2020.4.304-d6zw4xa + + netcdf/4.4.1-ve2zfkw netcdf-cxx/4.2-2rkopdl netcdf-fortran/4.4.4-thtylny - - mvapich2/2.2-verbs-ppznoge parallel-netcdf/1.11.0-c22b2bn + + intel-mpi/2019.9.304-rxpzd6p + netcdf-c/4.4.1-fysjgfx + netcdf-cxx/4.2-oaiw2v6 + netcdf-fortran/4.4.4-kxgkaop + parallel-netcdf/1.11.0-fce7akl + + + openmpi/4.1.1-x5n4m36 + netcdf-c/4.4.1-mtfptpl + netcdf-cxx/4.2-osp27dq + netcdf-fortran/4.4.4-5yd6dos + parallel-netcdf/1.11.0-a7ohxsg + $CIME_OUTPUT_ROOT/$CASE/run $CIME_OUTPUT_ROOT/$CASE/bld @@ -1097,24 +1110,26 @@ $SHELL{dirname $(dirname $(which nc-config))} $SHELL{dirname $(dirname $(which nf-config))} - /lcrc/group/e3sm/soft/perl/5.26.0/bin:$ENV{PATH} - - $SHELL{dirname $(dirname $(which pnetcdf_version))} + /lcrc/group/e3sm/soft/perl/5.26.0/bin:$ENV{PATH} 0 1 + 1 1 2 + + 10 + 64M - - granularity=core,scatter + + granularity=core,balanced 1 @@ -1163,15 +1178,13 @@ module - cmake/3.14.2-gvwazz3 + subversion/1.14.0-e4smcy3 + perl/5.32.0-bsnc6lt + cmake/3.19.1-yisciec - intel/17.0.4-74uvhji - intel-mkl/2017.3.196-v7uuj6z - intel-mpi/2017.3-dfphq6k - hdf5/1.10.1-3zhckvj - netcdf/4.6.1-c2mecde - netcdf-fortran/4.4.4-ojwazvy + intel/20.0.4-kodw73g + intel-mkl/2020.4.304-g2qaxzf openmpi/4.1.1-qiqkjbu @@ -1234,115 +1247,6 @@ - - ANL LCRC cluster 512-node AMD Epyc 7532 2-sockets 64-cores per node - chr.* - LINUX - intel,gnu - impi,openmpi - e3sm - /lcrc/group/e3sm/PERF_Chrysalis - .* - /lcrc/group/e3sm/$USER/scratch/chrys - /lcrc/group/e3sm/data/inputdata - /lcrc/group/e3sm/data/inputdata/atm/datm7 - /lcrc/group/e3sm/$USER/scratch/chrys/archive/$CASE - /lcrc/group/e3sm/baselines/chrys/$COMPILER - /lcrc/group/e3sm/tools/cprnc/cprnc - 8 - e3sm_integration - slurm - E3SM - 64 - 64 - FALSE - - srun - - --mpi=pmi2 -l -n {{ total_tasks }} -N {{ num_nodes }} --kill-on-bad-exit - --cpu_bind=cores - -c $ENV{OMP_NUM_THREADS} - -m plane={{ tasks_per_node }} - - - - /gpfs/fs1/soft/chrysalis/spack/opt/spack/linux-centos8-x86_64/gcc-9.3.0/lmod-8.3-5be73rg/lmod/lmod/init/sh - /gpfs/fs1/soft/chrysalis/spack/opt/spack/linux-centos8-x86_64/gcc-9.3.0/lmod-8.3-5be73rg/lmod/lmod/init/csh - /gpfs/fs1/soft/chrysalis/spack/opt/spack/linux-centos8-x86_64/gcc-9.3.0/lmod-8.3-5be73rg/lmod/lmod/init/env_modules_python.py - /gpfs/fs1/soft/chrysalis/spack/opt/spack/linux-centos8-x86_64/gcc-9.3.0/lmod-8.3-5be73rg/lmod/lmod/libexec/lmod python - module - module - - - subversion/1.14.0-e4smcy3 - perl/5.32.0-bsnc6lt - - - intel/20.0.4-kodw73g - intel-mkl/2020.4.304-g2qaxzf - - - openmpi/4.0.4-hpcx-cy5n3ft - hdf5/1.8.16-m3bsibs - netcdf-c/4.4.1-7ejgpdm - netcdf-cxx/4.2-sag6n3x - netcdf-fortran/4.4.4-sjzkwoc - parallel-netcdf/1.11.0-l362p2g - - - intel-mpi/2019.9.304-tkzvizk - hdf5/1.8.16-se4xyo7 - netcdf-c/4.4.1-qvxyzq2 - netcdf-cxx/4.2-binixgj - netcdf-fortran/4.4.4-rdxohvp - parallel-netcdf/1.11.0-b74wv4m - - - gcc/9.2.0-ugetvbp - intel-mkl/2020.4.304-n3b5fye - - - openmpi/4.0.4-hpcx-hghvhj5 - hdf5/1.10.7-sbsigon - netcdf-c/4.7.4-a4uk6zy - netcdf-cxx/4.2-fz347dw - netcdf-fortran/4.5.3-i5ah7u2 - parallel-netcdf/1.12.1-e7w4x32 - - - intel-mpi/2019.9.304-jdih7h5 - hdf5/1.8.16-dtbpce3 - netcdf-c/4.4.1-zcoa44z - netcdf-cxx/4.2-ayxg4c7 - netcdf-fortran/4.4.4-2lfr2lr - parallel-netcdf/1.11.0-ifdodru - - - $CIME_OUTPUT_ROOT/$CASE/run - $CIME_OUTPUT_ROOT/$CASE/bld - 0.1 - 1000 - - /lcrc/group/e3sm/soft/perl/chrys/lib/perl5 - $SHELL{dirname $(dirname $(which nc-config))} - $SHELL{dirname $(dirname $(which nf-config))} - $SHELL{dirname $(dirname $(which pnetcdf_version))} - - - 128M - - - granularity=core,scatter - 1 - - - cores - - - sm,ud - - - ANL/LCRC Linux Cluster LINUX @@ -1383,7 +1287,7 @@ module - cmake/3.14.2-gvwazz3 + cmake/3.20.3-vedypwm nvhpc/20.9-5brtudu @@ -1467,7 +1371,7 @@ module - cmake/3.13.4-354d6wl + cmake/3.20.3-vedypwm intel/18.0.4-443hhug @@ -1673,7 +1577,7 @@ cray-netcdf cray-netcdf-hdf5parallel craype/2.6.5 - cmake/3.14.5 + cmake/3.18.0 PrgEnv-gnu @@ -1728,9 +1632,9 @@ ANL experimental/evaluation cluster, batch system is cobalt jlse.* LINUX - intel,gnu - impi,openmpi - /gpfs/jlse-fs0/projects/climate/$USER/scratch/jlse + oneapi-ifx,oneapi-ifort,gnu + mpich,impi,openmpi + /gpfs/jlse-fs0/projects/climate/$USER/scratch /gpfs/jlse-fs0/projects/climate/inputdata /gpfs/jlse-fs0/projects/climate/inputdata/atm/datm7 $CIME_OUTPUT_ROOT/archive/$CASE @@ -1744,7 +1648,7 @@ 112 112 FALSE - + mpirun -l -n {{ total_tasks }} @@ -1760,148 +1664,78 @@ /usr/share/Modules/init/sh /usr/share/Modules/init/csh - /usr/share/Modules/init/perl.pm /usr/share/Modules/init/python.py module module - /usr/bin/modulecmd perl /usr/bin/modulecmd python /soft/modulefiles /soft/packaging/spack-builds/modules/linux-rhel7-x86_64 + /soft/restricted/CNDA/modulefiles + /home/azamat/soft/modulefiles cmake/3.17.0-gcc-9.3.0-5dgh2gv - - intel/2019 - - - intelmpi/2019-intel + + e3sm-env-vars/2021.06.10 + oneapi/2021.04.30.003 - gcc/9.2.0 + cmake + gcc/8.2.0 $CIME_OUTPUT_ROOT/$CASE/run $CIME_OUTPUT_ROOT/$CASE/bld - /home/azamat/perl5/bin:$ENV{PATH} - /home/azamat/perl5/lib/perl5 - /home/azamat/perl5 - "--install_base \"/home/azamat/perl5\"" - "INSTALL_BASE=/home/azamat/perl5" - - - /gpfs/jlse-fs0/projects/climate/soft/netcdf/4.4.1c-4.2cxx-4.4.4f/intel19 - - - /gpfs/jlse-fs0/projects/climate/soft/netcdf/4.4.1c-4.2cxx-4.4.4f/gcc9.2.0 + /home/azamat/soft/perl/5.32.0/bin:$ENV{PATH} + /home/azamat/soft/netcdf/4.4.1c-4.2cxx-4.4.4f/oneapi-2020.12.15.004-intel_mpi-2019.4.243 + /home/azamat/soft/pnetcdf/1.12.1/oneapi-2020.12.15.004-intel_mpi-2019.4.243 - - /gpfs/jlse-fs0/projects/climate/soft/pnetcdf/1.12.1/intel19 + + 10 + omp + spread + unit icc icpc ifort - /gpfs/jlse-fs0/projects/climate/soft/openmpi/2.1.6/intel19/bin:$ENV{PATH} - /gpfs/jlse-fs0/projects/climate/soft/openmpi/2.1.6/intel19/lib:$ENV{LD_LIBRARY_PATH} - /gpfs/jlse-fs0/projects/climate/soft/pnetcdf/1.12.1/openmpi2.1.6 + /home/azamat/soft/openmpi/2.1.6/intel19/bin:$ENV{PATH} + /home/azamat/soft/openmpi/2.1.6/intel19/lib:$ENV{LD_LIBRARY_PATH} + /home/azamat/soft/netcdf/4.4.1c-4.2cxx-4.4.4f/intel19-openmpi2.1.6 + /home/azamat/soft/pnetcdf/1.12.1/intel19-openmpi2.1.6 gcc g++ gfortran - /gpfs/jlse-fs0/projects/climate/soft/openmpi/2.1.6/gcc9.2.0/bin:$ENV{PATH} - /gpfs/jlse-fs0/projects/climate/soft/openmpi/2.1.6/gcc9.2.0/lib:$ENV{LD_LIBRARY_PATH} - /gpfs/jlse-fs0/projects/climate/soft/pnetcdf/1.12.1/openmpi2.1.6-gcc9.2.0 - - - 10 - omp - spread - unit + /home/azamat/soft/openmpi/2.1.6/gcc8.2.0/lib:/home/azamat/soft/libs:$ENV{LD_LIBRARY_PATH} + /home/azamat/soft/openmpi/2.1.6/gcc8.2.0/bin:/home/azamat/soft/cmake/3.18.5/bin:$ENV{PATH} + /home/azamat/soft/cmake/3.18.5 + /home/azamat/soft/cmake/3.18.5/share/aclocal + /home/azamat/soft/cmake/3.18.5 + /home/azamat/soft/netcdf/4.4.1c-4.2cxx-4.4.4f/gcc8.2.0-openmpi2.1.6 + /home/azamat/soft/pnetcdf/1.12.1/gcc8.2.0-openmpi2.1.6 + + + 0 + - verbose,granularity=thread,scatter + verbose,granularity=thread,balanced 128M threads 128M + + -1 + - - ANL experimental/evaluation cluster, batch system is cobalt - jlse.* - LINUX - intelgpu - mpich - $ENV{HOME}/acme/scratch - /home/azamat/acme/inputdata - /home/azamat/acme/inputdata/atm/datm7 - $CIME_OUTPUT_ROOT/archive/$CASE - $ENV{HOME}/acme/baselines/$COMPILER - /home/azamat/acme/tools/cprnc/cprnc - 8 - acme_developer - cobalt_theta - e3sm - 128 - 64 - FALSE - - mpirun - - -l -n $TOTALPES - - - - /usr/share/Modules/init/sh - /usr/share/Modules/init/csh - /usr/share/Modules/init/perl.pm - /usr/share/Modules/init/python.py - module - module - /usr/bin/modulecmd perl - /usr/bin/modulecmd python - - - /soft/modulefiles - /soft/packaging/spack-builds/modules/linux-rhel7-x86_64 - /soft/restricted/intel_dga/modulefiles - cmake/3.17.0-gcc-9.3.0-5dgh2gv - - - omp - mkl - mpi - - - $CIME_OUTPUT_ROOT/$CASE/run - $CIME_OUTPUT_ROOT/$CASE/bld - - 1 - 1 - 1 - 1 - /home/azamat/perl5/bin:$ENV{PATH} - /home/azamat/perl5/lib/perl5 - /home/azamat/perl5 - "--install_base \"/home/azamat/perl5\"" - "INSTALL_BASE=/home/azamat/perl5" - - - /home/wuda/soft/hdf5/1.8.16-parallel/intel18/lib:/home/wuda/soft/szip/2.1.1/intel18/lib:/home/wuda/soft/zlib/1.2.11/intel18/lib:$ENV{LD_LIBRARY_PATH} - /home/wuda/soft/hdf5/1.8.16-parallel/intel18 - /home/wuda/soft/netcdf/4.4.1c-4.2cxx-4.4.4f-parallel/intel18 - /home/wuda/soft/pnetcdf/1.12.0/intel18 - 10 - core - - - PNL cluster, OS is Linux, batch system is SLURM sooty @@ -2225,9 +2059,10 @@ - cmake/3.11.4 + cmake/3.19.6 + gcc/8.1.0 intel/19.0.5 @@ -2256,6 +2091,9 @@ $ENV{NETCDF_ROOT}/ $ENV{MKLROOT} + + /share/apps/gcc/8.1.0/lib:/share/apps/gcc/8.1.0/lib64:$ENV{LD_LIBRARY_PATH} + 0 1 @@ -2370,15 +2208,6 @@ /software/user_tools/current/cades-ccsi/perl5/lib/perl5/ - - - - istanbul - 1 - - - dynamic - @@ -2935,14 +2764,16 @@ jsrun - -X 1 -E OMP_NUM_THREADS=$ENV{OMP_NUM_THREADS} + -X 1 --nrs $ENV{NUM_RS} --rs_per_host $ENV{RS_PER_NODE} --tasks_per_rs $SHELL{echo "({{ tasks_per_node }} + $RS_PER_NODE - 1)/$RS_PER_NODE"|bc} -d plane:$SHELL{echo "({{ tasks_per_node }} + $RS_PER_NODE - 1)/$RS_PER_NODE"|bc} --cpu_per_rs $ENV{CPU_PER_RS} --gpu_per_rs $ENV{GPU_PER_RS} - --bind packed:smt:$SHELL{echo "(`./xmlquery --value MAX_TASKS_PER_NODE`+41)/42"|bc} + --bind packed:smt:$ENV{OMP_NUM_THREADS} + -E OMP_NUM_THREADS=$ENV{OMP_NUM_THREADS} + -E OMP_PROC_BIND=spread -E OMP_PLACES=threads -E OMP_STACKSIZE=256M --latency_priority $ENV{LTC_PRT} --stdio_mode prepended @@ -2963,7 +2794,7 @@ python/3.5.2 subversion/1.9.3 git/2.13.0 - cmake/3.13.4 + cmake/3.20.2 essl/6.1.0-2 netlib-lapack/3.8.0 @@ -3023,15 +2854,13 @@ $ENV{OLCF_HDF5_ROOT} $ENV{OLCF_PARALLEL_NETCDF_ROOT} - - 128M - 2 21 0 cpu-cpu $SHELL{echo "2*((`./xmlquery --value TOTAL_TASKS` + `./xmlquery --value TASKS_PER_NODE` - 1)/`./xmlquery --value TASKS_PER_NODE`)"|bc} + $SHELL{echo "(`./xmlquery --value MAX_TASKS_PER_NODE`+41)/42"|bc} 6 @@ -3087,14 +2916,16 @@ jsrun - -X 1 -E OMP_NUM_THREADS=$ENV{OMP_NUM_THREADS} + -X 1 --nrs $ENV{NUM_RS} --rs_per_host $ENV{RS_PER_NODE} --tasks_per_rs $SHELL{echo "({{ tasks_per_node }} + $RS_PER_NODE - 1)/$RS_PER_NODE"|bc} -d plane:$SHELL{echo "({{ tasks_per_node }} + $RS_PER_NODE - 1)/$RS_PER_NODE"|bc} --cpu_per_rs $ENV{CPU_PER_RS} --gpu_per_rs $ENV{GPU_PER_RS} - --bind packed:smt:$SHELL{echo "(`./xmlquery --value MAX_TASKS_PER_NODE`+41)/42"|bc} + --bind packed:smt:$ENV{OMP_NUM_THREADS} + -E OMP_NUM_THREADS=$ENV{OMP_NUM_THREADS} + -E OMP_PROC_BIND=spread -E OMP_PLACES=threads -E OMP_STACKSIZE=256M --latency_priority $ENV{LTC_PRT} --stdio_mode prepended @@ -3113,7 +2944,7 @@ python/3.7.0 subversion/1.9.3 git/2.13.0 - cmake/3.13.4 + cmake/3.18.2 essl/6.1.0-2 netlib-lapack/3.8.0 @@ -3158,15 +2989,13 @@ $ENV{OLCF_PARALLEL_NETCDF_ROOT} 0 - - 128M - 2 21 0 cpu-cpu $SHELL{echo "2*((`./xmlquery --value TOTAL_TASKS` + `./xmlquery --value TASKS_PER_NODE` - 1)/`./xmlquery --value TASKS_PER_NODE`)"|bc} + $SHELL{echo "(`./xmlquery --value MAX_TASKS_PER_NODE`+41)/42"|bc} 6 From 03f5d69dd390a8c341437faaadd7790b066b7d93 Mon Sep 17 00:00:00 2001 From: iulian07 Date: Wed, 11 Aug 2021 21:10:42 -0500 Subject: [PATCH 097/467] fix compile error on atm / moab the method gfr_f_get_corner_latlon was not found by intel compiler on chrysalis, because the module it came from was not specified "use gllfvremap_mod, only: gfr_f_get_corner_latlon" not sure how gnu is able to find it on my laptop maybe because it is debug mode? Anyway, it needs to be specified, otherwise it should not compile --- components/eam/src/dynamics/se/semoab_mod.F90 | 1 + 1 file changed, 1 insertion(+) diff --git a/components/eam/src/dynamics/se/semoab_mod.F90 b/components/eam/src/dynamics/se/semoab_mod.F90 index 95a982cb4485..67b5cbae1182 100644 --- a/components/eam/src/dynamics/se/semoab_mod.F90 +++ b/components/eam/src/dynamics/se/semoab_mod.F90 @@ -25,6 +25,7 @@ module semoab_mod use seq_comm_mct, only: atm_pg_active ! turn it on when PG style mesh active use dyn_grid, only: fv_nphys ! phys grid mesh will be replicated too + use gllfvremap_mod, only: gfr_f_get_corner_latlon use control_mod, only : west, east, south, north ! 1, 2, 3, 4 implicit none From 25731511d2b62a3a9a6777692a26a8516cd6add3 Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Fri, 13 Aug 2021 11:22:36 -0500 Subject: [PATCH 098/467] use fortran wrappers for some iMOAB methods more exactly, all methods that have as parameters MPI_Comm* or MPI_Group* These are just int* in Fortran, and they need to be converted properly to C/C++ structures Because of that, change the actual methods for fortran to use int* in those places --- driver-moab/main/cplcomp_exchange_mod.F90 | 26 +++++++-------- driver-moab/main/prep_atm_mod.F90 | 40 +++++++++++------------ driver-moab/main/prep_lnd_mod.F90 | 6 ++-- driver-moab/main/prep_ocn_mod.F90 | 6 ++-- 4 files changed, 39 insertions(+), 39 deletions(-) diff --git a/driver-moab/main/cplcomp_exchange_mod.F90 b/driver-moab/main/cplcomp_exchange_mod.F90 index 4f5c56f526a5..a3a40a266a4c 100644 --- a/driver-moab/main/cplcomp_exchange_mod.F90 +++ b/driver-moab/main/cplcomp_exchange_mod.F90 @@ -1000,9 +1000,9 @@ subroutine cplcomp_moab_Init(comp) integer :: mpigrp_cplid ! coupler pes integer :: mpigrp_old ! component group pes - integer, external :: iMOAB_RegisterFortranApplication, iMOAB_ReceiveMesh, iMOAB_SendMesh + integer, external :: iMOAB_RegisterFortranApplication, iMOAB_ReceiveMeshFort, iMOAB_SendMeshFort integer, external :: iMOAB_WriteMesh, iMOAB_DefineTagStorage, iMOAB_GetMeshInfo - integer, external :: iMOAB_SetIntTagStorage, iMOAB_FreeSenderBuffers, iMOAB_ComputeCommGraph + integer, external :: iMOAB_SetIntTagStorage, iMOAB_FreeSenderBuffers integer :: ierr, context_id character*32 :: appname, outfile, wopts, tagnameProj integer :: maxMH, maxMPO, maxMLID, maxMSID ! max pids for moab apps atm, ocn, lnd, sea-ice @@ -1055,10 +1055,10 @@ subroutine cplcomp_moab_Init(comp) if (MPI_COMM_NULL /= mpicom_old ) then ! it means we are on the component pes (atmosphere) ! send mesh to coupler if (atm_pg_active) then ! change : send the pg2 mesh, not coarse mesh, when atm pg active - ierr = iMOAB_SendMesh(mhpgid, mpicom_join, mpigrp_cplid, id_join, partMethod) + ierr = iMOAB_SendMeshFort(mhpgid, mpicom_join, mpigrp_cplid, id_join, partMethod) else ! still use the mhid, original coarse mesh - ierr = iMOAB_SendMesh(mhid, mpicom_join, mpigrp_cplid, id_join, partMethod) + ierr = iMOAB_SendMeshFort(mhid, mpicom_join, mpigrp_cplid, id_join, partMethod) endif if (ierr .ne. 0) then write(logunit,*) subname,' error in sending mesh from atm comp ' @@ -1073,7 +1073,7 @@ subroutine cplcomp_moab_Init(comp) write(logunit,*) subname,' error in registering ', appname call shr_sys_abort(subname//' ERROR registering '// appname) endif - ierr = iMOAB_ReceiveMesh(mbaxid, mpicom_join, mpigrp_old, id_old) + ierr = iMOAB_ReceiveMeshFort(mbaxid, mpicom_join, mpigrp_old, id_old) if (ierr .ne. 0) then write(logunit,*) subname,' error in receiving mesh on atm coupler ' call shr_sys_abort(subname//' ERROR in receiving mesh on atm coupler ') @@ -1113,7 +1113,7 @@ subroutine cplcomp_moab_Init(comp) ! now we have the spectral atm on coupler pes, and we want to send some data from ! atm physics mesh to atm spectral on coupler side; compute a par comm graph between ! atm phys and spectral atm mesh on coupler PEs - ! ierr = iMOAB_ComputeCommGraph(cmpAtmPID, physAtmPID, &joinComm, &atmPEGroup, &atmPhysGroup, + ! ierr = iMOAB_ComputeCommGraphFort(cmpAtmPID, physAtmPID, &joinComm, &atmPEGroup, &atmPhysGroup, ! &typeA, &typeB, &cmpatm, &physatm); ! graph between atm phys, mphaid, and atm dyn on coupler, mbaxid ! phys atm group is mpigrp_old, coupler group is mpigrp_cplid @@ -1121,7 +1121,7 @@ subroutine cplcomp_moab_Init(comp) !!typeB = 1 ! spectral elements !!ATM_PHYS_CID = 200 + id_old ! 200 + 5 for atm, see line 969 ATM_PHYS = 200 + ATMID ! in ! components/cam/src/cpl/atm_comp_mct.F90 - !!ierr = iMOAB_ComputeCommGraph( mphaid, mbaxid, mpicom_join, mpigrp_old, mpigrp_cplid, & + !!ierr = iMOAB_ComputeCommGraphFort( mphaid, mbaxid, mpicom_join, mpigrp_old, mpigrp_cplid, & !! typeA, typeB, ATM_PHYS_CID, id_join) ! comment out this above part @@ -1167,7 +1167,7 @@ subroutine cplcomp_moab_Init(comp) #endif ! send mesh to coupler - ierr = iMOAB_SendMesh(mpoid, mpicom_join, mpigrp_cplid, id_join, partMethod) + ierr = iMOAB_SendMeshFort(mpoid, mpicom_join, mpigrp_cplid, id_join, partMethod) if (ierr .ne. 0) then write(logunit,*) subname,' error in sending ocean mesh to coupler ' call shr_sys_abort(subname//' ERROR in sending ocean mesh to coupler ') @@ -1194,7 +1194,7 @@ subroutine cplcomp_moab_Init(comp) appname = "COUPLE_MPASO"//CHAR(0) ! migrated mesh gets another app id, moab ocean to coupler (mbox) ierr = iMOAB_RegisterFortranApplication(trim(appname), mpicom_new, id_join, mboxid) - ierr = iMOAB_ReceiveMesh(mboxid, mpicom_join, mpigrp_old, id_old) + ierr = iMOAB_ReceiveMeshFort(mboxid, mpicom_join, mpigrp_old, id_old) ! define here the tag that will be projected from atmosphere tagnameProj = 'a2oTbot_proj'//CHAR(0) ! temperature @@ -1242,7 +1242,7 @@ subroutine cplcomp_moab_Init(comp) #ifdef MOAB_HAVE_ZOLTAN partMethod = 2 ! RCB for point cloud #endif - ierr = iMOAB_SendMesh(mlnid, mpicom_join, mpigrp_cplid, id_join, partMethod) + ierr = iMOAB_SendMeshFort(mlnid, mpicom_join, mpigrp_cplid, id_join, partMethod) if (ierr .ne. 0) then write(logunit,*) subname,' error in sending land mesh ' call shr_sys_abort(subname//' ERROR in sending land mesh ') @@ -1268,7 +1268,7 @@ subroutine cplcomp_moab_Init(comp) write(logunit,*) subname,' error in registering coupler land ' call shr_sys_abort(subname//' ERROR in registering coupler land') endif - ierr = iMOAB_ReceiveMesh(mblxid, mpicom_join, mpigrp_old, id_old) + ierr = iMOAB_ReceiveMeshFort(mblxid, mpicom_join, mpigrp_old, id_old) if (ierr .ne. 0) then write(logunit,*) subname,' error in receiving coupler land mesh' call shr_sys_abort(subname//' ERROR in receiving coupler land mesh') @@ -1339,7 +1339,7 @@ subroutine cplcomp_moab_Init(comp) #endif ! start copy from ocean code ! send sea ice mesh to coupler - ierr = iMOAB_SendMesh(MPSIID, mpicom_join, mpigrp_cplid, id_join, partMethod) + ierr = iMOAB_SendMeshFort(MPSIID, mpicom_join, mpigrp_cplid, id_join, partMethod) if (ierr .ne. 0) then write(logunit,*) subname,' error in sending sea ice mesh to coupler ' call shr_sys_abort(subname//' ERROR in sending sea ice mesh to coupler ') @@ -1367,7 +1367,7 @@ subroutine cplcomp_moab_Init(comp) appname = "COUPLE_MPASSI"//CHAR(0) ! migrated mesh gets another app id, moab moab sea ice to coupler (mbox) ierr = iMOAB_RegisterFortranApplication(trim(appname), mpicom_new, id_join, mbixid) - ierr = iMOAB_ReceiveMesh(mbixid, mpicom_join, mpigrp_old, id_old) + ierr = iMOAB_ReceiveMeshFort(mbixid, mpicom_join, mpigrp_old, id_old) ! ! define here the tag that will be projected from atmosphere ! tagnameProj = 'a2oTbot_proj'//CHAR(0) ! temperature diff --git a/driver-moab/main/prep_atm_mod.F90 b/driver-moab/main/prep_atm_mod.F90 index 856e9cd9870d..08e03bb6258b 100644 --- a/driver-moab/main/prep_atm_mod.F90 +++ b/driver-moab/main/prep_atm_mod.F90 @@ -356,7 +356,7 @@ subroutine prep_atm_ocn_moab(infodata) integer :: typeA, typeB ! type for computing graph; integer :: idintx ! in this case, id of moab intersection between atm and ocn, on coupler pes - integer, external :: iMOAB_CoverageGraph, iMOAB_ComputeScalarProjectionWeights, iMOAB_ComputeCommGraph + integer, external :: iMOAB_CoverageGraphFort, iMOAB_ComputeScalarProjectionWeights, iMOAB_ComputeCommGraphFort call seq_infodata_getData(infodata, & atm_present=atm_present, & @@ -376,12 +376,12 @@ subroutine prep_atm_ocn_moab(infodata) ! it happens over joint communicator if (atm_pg_active ) then ! use mhpgid mesh - ierr = iMOAB_CoverageGraph(mpicom_join, mhpgid, mbaxid, mbintxoa, context_id); + ierr = iMOAB_CoverageGraphFort(mpicom_join, mhpgid, mbaxid, mbintxoa, context_id); if (iamroot_CPLID) then write(logunit,*) 'iMOAB graph atmpg2-intxao context: ', context_id end if else - ierr = iMOAB_CoverageGraph(mpicom_join, mhid, mbaxid, mbintxoa, context_id); + ierr = iMOAB_CoverageGraphFort(mpicom_join, mhid, mbaxid, mbintxoa, context_id); if (iamroot_CPLID) then write(logunit,*) 'iMOAB graph atmnp4-intxao context: ', context_id end if @@ -433,7 +433,7 @@ subroutine prep_atm_ocn_moab(infodata) ! this is similar to imoab_phatm_ocn_coupler.cpp test in moab ! int typeA = 2; // point cloud ! int typeB = 1; // quads in coverage set - ! ierr = iMOAB_ComputeCommGraph(cmpPhAtmPID, cplAtmOcnPID, &atmCouComm, &atmPEGroup, &couPEGroup, + ! ierr = iMOAB_ComputeCommGraphFort(cmpPhAtmPID, cplAtmOcnPID, &atmCouComm, &atmPEGroup, &couPEGroup, ! &typeA, &typeB, &cmpatm, &atmocnid); call seq_comm_getinfo(CPLID ,mpigrp=mpigrp_CPLID) ! second group, the coupler group CPLID is global variable call seq_comm_getinfo(atm_id, mpigrp=mpigrp_old) ! component group pes, from atm id ( also ATMID(1) ) @@ -458,7 +458,7 @@ subroutine prep_atm_ocn_moab(infodata) mphaid, mbintxoa, mpicom_join, mpigrp_old, mpigrp_CPLID, & typeA, typeB, atm_id, idintx end if - ierr = iMOAB_ComputeCommGraph( mphaid, mbintxoa, mpicom_join, mpigrp_old, mpigrp_CPLID, & + ierr = iMOAB_ComputeCommGraphFort( mphaid, mbintxoa, mpicom_join, mpigrp_old, mpigrp_CPLID, & typeA, typeB, atm_id, idintx) if (ierr .ne. 0) then write(logunit,*) subname,' error in computing graph phys grid - atm/ocn intx ' @@ -498,7 +498,7 @@ subroutine prep_atm_lnd_moab(infodata) integer :: idintx ! in this case, id of moab intersection between atm and lnd, on coupler pes ! used only for tri-grid case - integer, external :: iMOAB_CoverageGraph, iMOAB_ComputeScalarProjectionWeights, iMOAB_ComputeCommGraph + integer, external :: iMOAB_CoverageGraphFort, iMOAB_ComputeScalarProjectionWeights, iMOAB_ComputeCommGraphFort call seq_infodata_getData(infodata, & atm_present=atm_present, & @@ -517,9 +517,9 @@ subroutine prep_atm_lnd_moab(infodata) context_id = lnd(1)%cplcompid call seq_comm_getinfo(ID_join,mpicom=mpicom_join) if (atm_pg_active ) then ! use mhpgid mesh - ierr = iMOAB_CoverageGraph(mpicom_join, mhpgid, mbaxid, mbintxla, context_id); + ierr = iMOAB_CoverageGraphFort(mpicom_join, mhpgid, mbaxid, mbintxla, context_id); else - ierr = iMOAB_CoverageGraph(mpicom_join, mhid, mbaxid, mbintxla, context_id); + ierr = iMOAB_CoverageGraphFort(mpicom_join, mhid, mbaxid, mbintxla, context_id); endif if (ierr .ne. 0) then write(logunit,*) subname,' error in computing coverage graph atm/lnd ' @@ -593,7 +593,7 @@ subroutine prep_atm_lnd_moab(infodata) ! data from phys grid directly to atm-lnd intx , for later projection ! context is the same, atm - lnd intx id ! endif - ierr = iMOAB_ComputeCommGraph( mphaid, mbintxla, mpicom_join, mpigrp_old, mpigrp_CPLID, & + ierr = iMOAB_ComputeCommGraphFort( mphaid, mbintxla, mpicom_join, mpigrp_old, mpigrp_CPLID, & typeA, typeB, atm_id, idintx) if (ierr .ne. 0) then write(logunit,*) subname,' error in computing graph phys grid - atm/lnd intx ' @@ -627,7 +627,7 @@ subroutine prep_atm_migrate_moab(infodata) character*50 :: outfile, wopts, tagnameProj, lnum integer :: orderOCN, orderATM, volumetric, noConserve, validate - integer, external :: iMOAB_SendElementTag, iMOAB_ReceiveElementTag, iMOAB_FreeSenderBuffers + integer, external :: iMOAB_SendElementTagFort, iMOAB_ReceiveElementTagFort, iMOAB_FreeSenderBuffers integer, external :: iMOAB_ApplyScalarProjectionWeights, iMOAB_WriteMesh call seq_infodata_getData(infodata, & @@ -661,7 +661,7 @@ subroutine prep_atm_migrate_moab(infodata) ! as always, use nonblocking sends tagName = 'T_ph;u_ph;v_ph;'//CHAR(0) ! they are defined in initialize_moab_atm_phys in atm_comp_mct context_id = 100*atm(1)%cplcompid + ocn(1)%cplcompid !send to atm/ocn intx ! - ierr = iMOAB_SendElementTag(mphaid, tagName, mpicom_join, context_id) + ierr = iMOAB_SendElementTagFort(mphaid, tagName, mpicom_join, context_id) if (ierr .ne. 0) then write(logunit,*) subname,' error in sending tag from phys atm to ocn atm intx ' call shr_sys_abort(subname//' ERROR in sending tag from phys atm to ocn atm intx') @@ -674,7 +674,7 @@ subroutine prep_atm_migrate_moab(infodata) ! context_id = atm(1)%cplcompid == atm_id above (5) ! we use the same name as spectral case, even thought in pg2 case, the size of tag is 1, not 16 ! in imoab_apg2_ol_coupler.cpp we use at this stage, receiver, the same name as sender, T_ph - ierr = iMOAB_ReceiveElementTag(mbintxoa, tagName, mpicom_join, atm_id) + ierr = iMOAB_ReceiveElementTagFort(mbintxoa, tagName, mpicom_join, atm_id) if (ierr .ne. 0) then write(logunit,*) subname,' error in receiving tag from phys atm to ocn atm intx ' call shr_sys_abort(subname//' ERROR in receiving tag from phys atm to ocn atm intx') @@ -699,7 +699,7 @@ subroutine prep_atm_migrate_moab(infodata) ! trivial partitioning, now we need to adjust it for "coverage" mesh ! as always, use nonblocking sends - ierr = iMOAB_SendElementTag(mhid, tagName, mpicom_join, context_id) + ierr = iMOAB_SendElementTagFort(mhid, tagName, mpicom_join, context_id) if (ierr .ne. 0) then write(logunit,*) subname,' error in sending tag from atm spectral to ocn atm intx ' call shr_sys_abort(subname//' ERROR in sending tag from atm spectral to ocn atm intx') @@ -707,7 +707,7 @@ subroutine prep_atm_migrate_moab(infodata) endif if (mbaxid .ge. 0 ) then ! we are on coupler pes, for sure ! receive on atm on coupler pes, that was redistributed according to coverage - ierr = iMOAB_ReceiveElementTag(mbaxid, tagName, mpicom_join, context_id) + ierr = iMOAB_ReceiveElementTagFort(mbaxid, tagName, mpicom_join, context_id) if (ierr .ne. 0) then write(logunit,*) subname,' error in receiving tag from atm spectral to ocn atm intx ' call shr_sys_abort(subname//' ERROR in receiving tag from atm spectral to ocn atm intx') @@ -771,7 +771,7 @@ subroutine prep_atm_migrate_moab(infodata) tagName = 'T_ph;u_ph;v_ph;'//CHAR(0) ! they are defined in initialize_moab_atm_phys in atm_comp_mct context_id = 100*atm(1)%cplcompid + lnd(1)%cplcompid !send to atm/lnd intx ! ! use computed graph - ierr = iMOAB_SendElementTag(mphaid, tagName, mpicom_join, context_id) + ierr = iMOAB_SendElementTagFort(mphaid, tagName, mpicom_join, context_id) if (ierr .ne. 0) then write(logunit,*) subname,' error in sending tag from atm to atm land intx ' call shr_sys_abort(subname//' ERROR in sending tag from atm to atm land intx') @@ -781,7 +781,7 @@ subroutine prep_atm_migrate_moab(infodata) if (mbaxid .ge. 0 ) then ! we are on coupler pes, for sure ! receive on atm on coupler pes, that was redistributed according to coverage tagName = 'T_ph;u_ph;v_ph;'//CHAR(0) ! they are defined in initialize_moab_atm_phys - ierr = iMOAB_ReceiveElementTag(mbintxla, tagName, mpicom_join, atm_id) + ierr = iMOAB_ReceiveElementTagFort(mbintxla, tagName, mpicom_join, atm_id) if (ierr .ne. 0) then write(logunit,*) subname,' error in receiving tag from atm to atm land intx ' call shr_sys_abort(subname//' ERROR in receiving tag from atm to atm land intx') @@ -806,7 +806,7 @@ subroutine prep_atm_migrate_moab(infodata) ! original partitioning, now we need to adjust it for "coverage" mesh ! as always, use nonblocking sends - ierr = iMOAB_SendElementTag(mhid, tagName, mpicom_join, context_id) + ierr = iMOAB_SendElementTagFort(mhid, tagName, mpicom_join, context_id) if (ierr .ne. 0) then write(logunit,*) subname,' error in sending tag from atm spectral to atm/lnd intx ' call shr_sys_abort(subname//' ERROR in sending tag from atm spectral to atm/lnd intx ') @@ -815,7 +815,7 @@ subroutine prep_atm_migrate_moab(infodata) endif if (mbaxid .ge. 0 ) then ! we are on coupler pes, for sure ! receive on atm on coupler pes, that was redistributed according to coverage - ierr = iMOAB_ReceiveElementTag(mbaxid, tagName, mpicom_join, context_id) + ierr = iMOAB_ReceiveElementTagFort(mbaxid, tagName, mpicom_join, context_id) if (ierr .ne. 0) then write(logunit,*) subname,' error in receiving tag from atm spectral to atm/lnd intx ' call shr_sys_abort(subname//' ERROR in receiving tag from atm spectral to atm/lnd intx ') @@ -866,7 +866,7 @@ subroutine prep_atm_migrate_moab(infodata) ! original partitioning, now we need to adjust it for "coverage" mesh ! as always, use nonblocking sends - ierr = iMOAB_SendElementTag(mhid, tagName, mpicom_join, context_id) + ierr = iMOAB_SendElementTagFort(mhid, tagName, mpicom_join, context_id) if (ierr .ne. 0) then write(logunit,*) subname,' error in sending tag for land projection' call shr_sys_abort(subname//' ERROR in sending tag for land projection') @@ -874,7 +874,7 @@ subroutine prep_atm_migrate_moab(infodata) endif if (mbaxid .ge. 0 ) then ! we are on coupler pes, for sure ! receive on atm on coupler pes, that was redistributed according to coverage - ierr = iMOAB_ReceiveElementTag(mbaxid, tagName, mpicom_join, context_id) + ierr = iMOAB_ReceiveElementTagFort(mbaxid, tagName, mpicom_join, context_id) if (ierr .ne. 0) then write(logunit,*) subname,' error in receiving tag for land projection' call shr_sys_abort(subname//' ERROR in receiving tag for land projection') diff --git a/driver-moab/main/prep_lnd_mod.F90 b/driver-moab/main/prep_lnd_mod.F90 index 23dfa451df9d..c3c7bce8dbfc 100644 --- a/driver-moab/main/prep_lnd_mod.F90 +++ b/driver-moab/main/prep_lnd_mod.F90 @@ -578,7 +578,7 @@ subroutine prep_lnd_migrate_moab(infodata) character*32 :: outfile, wopts, lnum integer :: orderLND, orderATM, volumetric, noConserve, validate - integer, external :: iMOAB_SendElementTag, iMOAB_ReceiveElementTag, iMOAB_FreeSenderBuffers + integer, external :: iMOAB_SendElementTagFort, iMOAB_ReceiveElementTagFort, iMOAB_FreeSenderBuffers integer, external :: iMOAB_WriteMesh call seq_infodata_getData(infodata, & @@ -599,12 +599,12 @@ subroutine prep_lnd_migrate_moab(infodata) if (mblxid .ge. 0) then ! send because we are on coupler pes ! basically, use the initial partitioning - ierr = iMOAB_SendElementTag(mblxid, tagName, mpicom_join, context_id) + ierr = iMOAB_SendElementTagFort(mblxid, tagName, mpicom_join, context_id) endif if (mlnid .ge. 0 ) then ! we are on land pes, for sure ! receive on land pes, a tag that was computed on coupler pes - ierr = iMOAB_ReceiveElementTag(mlnid, tagName, mpicom_join, context_id) + ierr = iMOAB_ReceiveElementTagFort(mlnid, tagName, mpicom_join, context_id) !CHECKRC(ierr, "cannot receive tag values") endif diff --git a/driver-moab/main/prep_ocn_mod.F90 b/driver-moab/main/prep_ocn_mod.F90 index c928eb3b3916..6e7908ae8b0d 100644 --- a/driver-moab/main/prep_ocn_mod.F90 +++ b/driver-moab/main/prep_ocn_mod.F90 @@ -1497,7 +1497,7 @@ subroutine prep_ocn_migrate_moab(infodata) character*32 :: outfile, wopts, lnum integer :: orderOCN, orderATM, volumetric, noConserve, validate - integer, external :: iMOAB_SendElementTag, iMOAB_ReceiveElementTag, iMOAB_FreeSenderBuffers + integer, external :: iMOAB_SendElementTagFort, iMOAB_ReceiveElementTagFort, iMOAB_FreeSenderBuffers integer, external :: iMOAB_WriteMesh call seq_infodata_getData(infodata, & @@ -1518,12 +1518,12 @@ subroutine prep_ocn_migrate_moab(infodata) if (mboxid .ge. 0) then ! send because we are on coupler pes ! basically, use the initial partitioning - ierr = iMOAB_SendElementTag(mboxid, tagName, mpicom_join, context_id) + ierr = iMOAB_SendElementTagFort(mboxid, tagName, mpicom_join, context_id) endif if (mpoid .ge. 0 ) then ! we are on ocean pes, for sure ! receive on ocean pes, a tag that was computed on coupler pes - ierr = iMOAB_ReceiveElementTag(mpoid, tagName, mpicom_join, context_id) + ierr = iMOAB_ReceiveElementTagFort(mpoid, tagName, mpicom_join, context_id) !CHECKRC(ierr, "cannot receive tag values") endif From a92f1375df3533d378a4df578a8d0f3a819cae65 Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Sat, 14 Aug 2021 16:34:15 -0500 Subject: [PATCH 099/467] rename iMOAB*Fort with iMOAB*Fortran also, rename for consistency iMOAB_RegisterFortranApplication with iMOAB_RegisterApplicationFortran --- components/eam/src/cpl/atm_comp_mct.F90 | 4 +- components/eam/src/dynamics/se/dyn_comp.F90 | 8 ++-- components/elm/src/cpl/lnd_comp_mct.F90 | 4 +- components/mosart/src/cpl/rof_comp_mct.F90 | 4 +- .../src/framework/mpas_moabmesh.F | 4 +- driver-moab/main/cplcomp_exchange_mod.F90 | 28 +++++------ driver-moab/main/prep_atm_mod.F90 | 46 +++++++++---------- driver-moab/main/prep_lnd_mod.F90 | 6 +-- driver-moab/main/prep_ocn_mod.F90 | 6 +-- 9 files changed, 55 insertions(+), 55 deletions(-) diff --git a/components/eam/src/cpl/atm_comp_mct.F90 b/components/eam/src/cpl/atm_comp_mct.F90 index 731695151496..e9781ceb07e0 100644 --- a/components/eam/src/cpl/atm_comp_mct.F90 +++ b/components/eam/src/cpl/atm_comp_mct.F90 @@ -1001,7 +1001,7 @@ subroutine initialize_moab_atm_phys( cdata_a ) integer :: ATM_PHYS ! our numbering - integer , external :: iMOAB_RegisterFortranApplication, iMOAB_CreateVertices, iMOAB_WriteMesh, & + integer , external :: iMOAB_RegisterApplicationFortran, iMOAB_CreateVertices, iMOAB_WriteMesh, & iMOAB_DefineTagStorage, iMOAB_SetIntTagStorage, iMOAB_SetDoubleTagStorage, & iMOAB_ResolveSharedEntities, iMOAB_UpdateMeshInfo ! local variables to fill in data @@ -1032,7 +1032,7 @@ subroutine initialize_moab_atm_phys( cdata_a ) appname="ATM_PHYS"//CHAR(0) ATM_PHYS = 200 + ATMID ! - ierr = iMOAB_RegisterFortranApplication(appname, mpicom_atm, ATM_PHYS, mphaid) + ierr = iMOAB_RegisterApplicationFortran(appname, mpicom_atm, ATM_PHYS, mphaid) if (ierr > 0 ) & call endrun('Error: cannot register moab app for atm physics') if(masterproc) then diff --git a/components/eam/src/dynamics/se/dyn_comp.F90 b/components/eam/src/dynamics/se/dyn_comp.F90 index 849b8a7ddbbc..06e35e16dde2 100644 --- a/components/eam/src/dynamics/se/dyn_comp.F90 +++ b/components/eam/src/dynamics/se/dyn_comp.F90 @@ -120,7 +120,7 @@ subroutine dyn_init1(fh, NLFileName, dyn_in, dyn_out) integer :: npes_se_stride #ifdef HAVE_MOAB - integer, external :: iMOAB_RegisterFortranApplication + integer, external :: iMOAB_RegisterApplicationFortran integer :: ATM_ID1 character*32 appname #endif @@ -163,7 +163,7 @@ subroutine dyn_init1(fh, NLFileName, dyn_in, dyn_out) #ifdef HAVE_MOAB appname="HM_COARSE"//CHAR(0) ATM_ID1 = ATMID(1) ! first atmosphere instance; it should be 5 - ierr = iMOAB_RegisterFortranApplication(appname, par%comm, ATM_ID1, MHID) + ierr = iMOAB_RegisterApplicationFortran(appname, par%comm, ATM_ID1, MHID) if (ierr > 0 ) & call endrun('Error: cannot register moab app') if(par%masterproc) then @@ -173,7 +173,7 @@ subroutine dyn_init1(fh, NLFileName, dyn_in, dyn_out) endif appname="HM_FINE"//CHAR(0) ATM_ID1 = 119 ! this number should not conflict with other components IDs; how do we know? - ierr = iMOAB_RegisterFortranApplication(appname, par%comm, ATM_ID1, MHFID) + ierr = iMOAB_RegisterApplicationFortran(appname, par%comm, ATM_ID1, MHFID) if (ierr > 0 ) & call endrun('Error: cannot register moab app for fine mesh') if(par%masterproc) then @@ -184,7 +184,7 @@ subroutine dyn_init1(fh, NLFileName, dyn_in, dyn_out) if ( fv_nphys > 0 ) then appname="HM_PGX"//CHAR(0) ATM_ID1 = 120 ! this number should not conflict with other components IDs; how do we know? - ierr = iMOAB_RegisterFortranApplication(appname, par%comm, ATM_ID1, mhpgid) + ierr = iMOAB_RegisterApplicationFortran(appname, par%comm, ATM_ID1, mhpgid) if (ierr > 0 ) & call endrun('Error: cannot register moab app for fine mesh') if(par%masterproc) then diff --git a/components/elm/src/cpl/lnd_comp_mct.F90 b/components/elm/src/cpl/lnd_comp_mct.F90 index a79bf203ac61..75fc34db6a49 100644 --- a/components/elm/src/cpl/lnd_comp_mct.F90 +++ b/components/elm/src/cpl/lnd_comp_mct.F90 @@ -124,7 +124,7 @@ subroutine lnd_init_mct( EClock, cdata_l, x2l_l, l2x_l, NLFilename ) character(len=*), parameter :: format = "('("//trim(sub)//") :',A)" #ifdef HAVE_MOAB - integer, external :: iMOAB_RegisterFortranApplication + integer, external :: iMOAB_RegisterApplicationFortran integer :: ierr character*32 appname logical :: samegrid_al ! @@ -280,7 +280,7 @@ subroutine lnd_init_mct( EClock, cdata_l, x2l_l, l2x_l, NLFilename ) #ifdef HAVE_MOAB appname="LNDMB"//CHAR(0) ! first land instance, should be 9 - ierr = iMOAB_RegisterFortranApplication(appname, mpicom_lnd, LNDID, mlnid) + ierr = iMOAB_RegisterApplicationFortran(appname, mpicom_lnd, LNDID, mlnid) if (ierr > 0 ) & call endrun('Error: cannot register moab app') if(masterproc) then diff --git a/components/mosart/src/cpl/rof_comp_mct.F90 b/components/mosart/src/cpl/rof_comp_mct.F90 index c0653b275272..1db12eb69d9c 100644 --- a/components/mosart/src/cpl/rof_comp_mct.F90 +++ b/components/mosart/src/cpl/rof_comp_mct.F90 @@ -135,7 +135,7 @@ subroutine rof_init_mct( EClock, cdata_r, x2r_r, r2x_r, NLFilename) character(len=*), parameter :: format = "('("//trim(sub)//") :',A)" #ifdef HAVE_MOAB - integer, external :: iMOAB_RegisterFortranApplication + integer, external :: iMOAB_RegisterApplicationFortran integer :: ierr character*32 appname #endif @@ -278,7 +278,7 @@ subroutine rof_init_mct( EClock, cdata_r, x2r_r, r2x_r, NLFilename) #ifdef HAVE_MOAB appname="ROFMB"//CHAR(0) ! only if rof_prognostic ! first rof instance, should be - ierr = iMOAB_RegisterFortranApplication(appname, mpicom_rof, ROFID, mrofid) + ierr = iMOAB_RegisterApplicationFortran(appname, mpicom_rof, ROFID, mrofid) if (ierr > 0 ) & call shr_sys_abort( sub//' Error: cannot register moab app') if(masterproc) then diff --git a/components/mpas-framework/src/framework/mpas_moabmesh.F b/components/mpas-framework/src/framework/mpas_moabmesh.F index dfaa0dd3b1a9..fd3e00d4fc1b 100644 --- a/components/mpas-framework/src/framework/mpas_moabmesh.F +++ b/components/mpas-framework/src/framework/mpas_moabmesh.F @@ -42,7 +42,7 @@ subroutine mpas_moab_instance(domain, ext_comp_id, pidmoab) real(kind=RKIND), pointer :: x_period, y_period integer, pointer :: nCellsSolve, nEdgesSolve, nVerticesSolve - integer , external :: iMOAB_RegisterFortranApplication, & + integer , external :: iMOAB_RegisterApplicationFortran, & iMOAB_CreateVertices, iMOAB_CreateElements, & iMOAB_ResolveSharedEntities, iMOAB_DetermineGhostEntities, & iMOAB_DefineTagStorage, iMOAB_SetIntTagStorage , & @@ -60,7 +60,7 @@ subroutine mpas_moab_instance(domain, ext_comp_id, pidmoab) c_comm = domain % dminfo % comm write(lnum,"(I0.2)")ext_comp_id appname = 'MPAS_MB_'//trim(lnum)// CHAR(0) - ierr = iMOAB_RegisterFortranApplication(appname, c_comm, ext_comp_id, pid) + ierr = iMOAB_RegisterApplicationFortran(appname, c_comm, ext_comp_id, pid) pidmoab = pid ! this is exported, need for send to work call errorout(ierr, 'fail to register MPAS_MOAB mesh') proc_id = domain % dminfo % my_proc_id diff --git a/driver-moab/main/cplcomp_exchange_mod.F90 b/driver-moab/main/cplcomp_exchange_mod.F90 index a3a40a266a4c..54a895a898d2 100644 --- a/driver-moab/main/cplcomp_exchange_mod.F90 +++ b/driver-moab/main/cplcomp_exchange_mod.F90 @@ -1000,7 +1000,7 @@ subroutine cplcomp_moab_Init(comp) integer :: mpigrp_cplid ! coupler pes integer :: mpigrp_old ! component group pes - integer, external :: iMOAB_RegisterFortranApplication, iMOAB_ReceiveMeshFort, iMOAB_SendMeshFort + integer, external :: iMOAB_RegisterApplicationFortran, iMOAB_ReceiveMeshFortran, iMOAB_SendMeshFortran integer, external :: iMOAB_WriteMesh, iMOAB_DefineTagStorage, iMOAB_GetMeshInfo integer, external :: iMOAB_SetIntTagStorage, iMOAB_FreeSenderBuffers integer :: ierr, context_id @@ -1055,10 +1055,10 @@ subroutine cplcomp_moab_Init(comp) if (MPI_COMM_NULL /= mpicom_old ) then ! it means we are on the component pes (atmosphere) ! send mesh to coupler if (atm_pg_active) then ! change : send the pg2 mesh, not coarse mesh, when atm pg active - ierr = iMOAB_SendMeshFort(mhpgid, mpicom_join, mpigrp_cplid, id_join, partMethod) + ierr = iMOAB_SendMeshFortran(mhpgid, mpicom_join, mpigrp_cplid, id_join, partMethod) else ! still use the mhid, original coarse mesh - ierr = iMOAB_SendMeshFort(mhid, mpicom_join, mpigrp_cplid, id_join, partMethod) + ierr = iMOAB_SendMeshFortran(mhid, mpicom_join, mpigrp_cplid, id_join, partMethod) endif if (ierr .ne. 0) then write(logunit,*) subname,' error in sending mesh from atm comp ' @@ -1068,12 +1068,12 @@ subroutine cplcomp_moab_Init(comp) if (MPI_COMM_NULL /= mpicom_new ) then ! we are on the coupler pes appname = "COUPLE_ATM"//CHAR(0) ! migrated mesh gets another app id, moab atm to coupler (mbax) - ierr = iMOAB_RegisterFortranApplication(trim(appname), mpicom_new, id_join, mbaxid) + ierr = iMOAB_RegisterApplicationFortran(trim(appname), mpicom_new, id_join, mbaxid) if (ierr .ne. 0) then write(logunit,*) subname,' error in registering ', appname call shr_sys_abort(subname//' ERROR registering '// appname) endif - ierr = iMOAB_ReceiveMeshFort(mbaxid, mpicom_join, mpigrp_old, id_old) + ierr = iMOAB_ReceiveMeshFortran(mbaxid, mpicom_join, mpigrp_old, id_old) if (ierr .ne. 0) then write(logunit,*) subname,' error in receiving mesh on atm coupler ' call shr_sys_abort(subname//' ERROR in receiving mesh on atm coupler ') @@ -1167,7 +1167,7 @@ subroutine cplcomp_moab_Init(comp) #endif ! send mesh to coupler - ierr = iMOAB_SendMeshFort(mpoid, mpicom_join, mpigrp_cplid, id_join, partMethod) + ierr = iMOAB_SendMeshFortran(mpoid, mpicom_join, mpigrp_cplid, id_join, partMethod) if (ierr .ne. 0) then write(logunit,*) subname,' error in sending ocean mesh to coupler ' call shr_sys_abort(subname//' ERROR in sending ocean mesh to coupler ') @@ -1193,8 +1193,8 @@ subroutine cplcomp_moab_Init(comp) if (MPI_COMM_NULL /= mpicom_new ) then ! we are on the coupler pes appname = "COUPLE_MPASO"//CHAR(0) ! migrated mesh gets another app id, moab ocean to coupler (mbox) - ierr = iMOAB_RegisterFortranApplication(trim(appname), mpicom_new, id_join, mboxid) - ierr = iMOAB_ReceiveMeshFort(mboxid, mpicom_join, mpigrp_old, id_old) + ierr = iMOAB_RegisterApplicationFortran(trim(appname), mpicom_new, id_join, mboxid) + ierr = iMOAB_ReceiveMeshFortran(mboxid, mpicom_join, mpigrp_old, id_old) ! define here the tag that will be projected from atmosphere tagnameProj = 'a2oTbot_proj'//CHAR(0) ! temperature @@ -1242,7 +1242,7 @@ subroutine cplcomp_moab_Init(comp) #ifdef MOAB_HAVE_ZOLTAN partMethod = 2 ! RCB for point cloud #endif - ierr = iMOAB_SendMeshFort(mlnid, mpicom_join, mpigrp_cplid, id_join, partMethod) + ierr = iMOAB_SendMeshFortran(mlnid, mpicom_join, mpigrp_cplid, id_join, partMethod) if (ierr .ne. 0) then write(logunit,*) subname,' error in sending land mesh ' call shr_sys_abort(subname//' ERROR in sending land mesh ') @@ -1263,12 +1263,12 @@ subroutine cplcomp_moab_Init(comp) if (MPI_COMM_NULL /= mpicom_new ) then ! we are on the coupler pes appname = "COUPLE_LAND"//CHAR(0) ! migrated mesh gets another app id, moab ocean to coupler (mbox) - ierr = iMOAB_RegisterFortranApplication(trim(appname), mpicom_new, id_join, mblxid) + ierr = iMOAB_RegisterApplicationFortran(trim(appname), mpicom_new, id_join, mblxid) if (ierr .ne. 0) then write(logunit,*) subname,' error in registering coupler land ' call shr_sys_abort(subname//' ERROR in registering coupler land') endif - ierr = iMOAB_ReceiveMeshFort(mblxid, mpicom_join, mpigrp_old, id_old) + ierr = iMOAB_ReceiveMeshFortran(mblxid, mpicom_join, mpigrp_old, id_old) if (ierr .ne. 0) then write(logunit,*) subname,' error in receiving coupler land mesh' call shr_sys_abort(subname//' ERROR in receiving coupler land mesh') @@ -1339,7 +1339,7 @@ subroutine cplcomp_moab_Init(comp) #endif ! start copy from ocean code ! send sea ice mesh to coupler - ierr = iMOAB_SendMeshFort(MPSIID, mpicom_join, mpigrp_cplid, id_join, partMethod) + ierr = iMOAB_SendMeshFortran(MPSIID, mpicom_join, mpigrp_cplid, id_join, partMethod) if (ierr .ne. 0) then write(logunit,*) subname,' error in sending sea ice mesh to coupler ' call shr_sys_abort(subname//' ERROR in sending sea ice mesh to coupler ') @@ -1366,8 +1366,8 @@ subroutine cplcomp_moab_Init(comp) if (MPI_COMM_NULL /= mpicom_new ) then ! we are on the coupler pes appname = "COUPLE_MPASSI"//CHAR(0) ! migrated mesh gets another app id, moab moab sea ice to coupler (mbox) - ierr = iMOAB_RegisterFortranApplication(trim(appname), mpicom_new, id_join, mbixid) - ierr = iMOAB_ReceiveMeshFort(mbixid, mpicom_join, mpigrp_old, id_old) + ierr = iMOAB_RegisterApplicationFortran(trim(appname), mpicom_new, id_join, mbixid) + ierr = iMOAB_ReceiveMeshFortran(mbixid, mpicom_join, mpigrp_old, id_old) ! ! define here the tag that will be projected from atmosphere ! tagnameProj = 'a2oTbot_proj'//CHAR(0) ! temperature diff --git a/driver-moab/main/prep_atm_mod.F90 b/driver-moab/main/prep_atm_mod.F90 index 08e03bb6258b..12188ffe13c9 100644 --- a/driver-moab/main/prep_atm_mod.F90 +++ b/driver-moab/main/prep_atm_mod.F90 @@ -127,7 +127,7 @@ subroutine prep_atm_init(infodata, ocn_c2_atm, ice_c2_atm, lnd_c2_atm, iac_c2_at type(mct_avect), pointer :: a2x_ax character(*), parameter :: subname = '(prep_atm_init)' character(*), parameter :: F00 = "('"//subname//" : ', 4A )" - integer, external :: iMOAB_ComputeMeshIntersectionOnSphere, iMOAB_RegisterFortranApplication, & + integer, external :: iMOAB_ComputeMeshIntersectionOnSphere, iMOAB_RegisterApplicationFortran, & iMOAB_WriteMesh, iMOAB_ComputePointDoFIntersection ! use computedofintx if land is point cloud integer ierr, idintx, rank character*32 :: appname, outfile, wopts, lnum @@ -194,7 +194,7 @@ subroutine prep_atm_init(infodata, ocn_c2_atm, ice_c2_atm, lnd_c2_atm, iac_c2_at appname = "ATM_OCN_COU"//CHAR(0) ! idintx is a unique number of MOAB app that takes care of intx between ocn and atm mesh idintx = 100*atm(1)%cplcompid + ocn(1)%cplcompid ! something different, to differentiate it - ierr = iMOAB_RegisterFortranApplication(trim(appname), mpicom_CPLID, idintx, mbintxoa) + ierr = iMOAB_RegisterApplicationFortran(trim(appname), mpicom_CPLID, idintx, mbintxoa) if (ierr .ne. 0) then write(logunit,*) subname,' error in registering atm ocn intx' call shr_sys_abort(subname//' ERROR in registering atm ocn intx') @@ -283,7 +283,7 @@ subroutine prep_atm_init(infodata, ocn_c2_atm, ice_c2_atm, lnd_c2_atm, iac_c2_at appname = "ATM_LND_COU"//CHAR(0) ! idintx is a unique number of MOAB app that takes care of intx between lnd and atm mesh idintx = 100*atm(1)%cplcompid + lnd(1)%cplcompid ! something different, to differentiate it - ierr = iMOAB_RegisterFortranApplication(trim(appname), mpicom_CPLID, idintx, mbintxla) + ierr = iMOAB_RegisterApplicationFortran(trim(appname), mpicom_CPLID, idintx, mbintxla) if (ierr .ne. 0) then write(logunit,*) subname,' error in registering atm lnd intx ' call shr_sys_abort(subname//' ERROR in registering atm lnd intx ') @@ -356,7 +356,7 @@ subroutine prep_atm_ocn_moab(infodata) integer :: typeA, typeB ! type for computing graph; integer :: idintx ! in this case, id of moab intersection between atm and ocn, on coupler pes - integer, external :: iMOAB_CoverageGraphFort, iMOAB_ComputeScalarProjectionWeights, iMOAB_ComputeCommGraphFort + integer, external :: iMOAB_CoverageGraphFortran, iMOAB_ComputeScalarProjectionWeights, iMOAB_ComputeCommGraphFortran call seq_infodata_getData(infodata, & atm_present=atm_present, & @@ -376,12 +376,12 @@ subroutine prep_atm_ocn_moab(infodata) ! it happens over joint communicator if (atm_pg_active ) then ! use mhpgid mesh - ierr = iMOAB_CoverageGraphFort(mpicom_join, mhpgid, mbaxid, mbintxoa, context_id); + ierr = iMOAB_CoverageGraphFortran(mpicom_join, mhpgid, mbaxid, mbintxoa, context_id); if (iamroot_CPLID) then write(logunit,*) 'iMOAB graph atmpg2-intxao context: ', context_id end if else - ierr = iMOAB_CoverageGraphFort(mpicom_join, mhid, mbaxid, mbintxoa, context_id); + ierr = iMOAB_CoverageGraphFortran(mpicom_join, mhid, mbaxid, mbintxoa, context_id); if (iamroot_CPLID) then write(logunit,*) 'iMOAB graph atmnp4-intxao context: ', context_id end if @@ -433,7 +433,7 @@ subroutine prep_atm_ocn_moab(infodata) ! this is similar to imoab_phatm_ocn_coupler.cpp test in moab ! int typeA = 2; // point cloud ! int typeB = 1; // quads in coverage set - ! ierr = iMOAB_ComputeCommGraphFort(cmpPhAtmPID, cplAtmOcnPID, &atmCouComm, &atmPEGroup, &couPEGroup, + ! ierr = iMOAB_ComputeCommGraphFortran(cmpPhAtmPID, cplAtmOcnPID, &atmCouComm, &atmPEGroup, &couPEGroup, ! &typeA, &typeB, &cmpatm, &atmocnid); call seq_comm_getinfo(CPLID ,mpigrp=mpigrp_CPLID) ! second group, the coupler group CPLID is global variable call seq_comm_getinfo(atm_id, mpigrp=mpigrp_old) ! component group pes, from atm id ( also ATMID(1) ) @@ -458,7 +458,7 @@ subroutine prep_atm_ocn_moab(infodata) mphaid, mbintxoa, mpicom_join, mpigrp_old, mpigrp_CPLID, & typeA, typeB, atm_id, idintx end if - ierr = iMOAB_ComputeCommGraphFort( mphaid, mbintxoa, mpicom_join, mpigrp_old, mpigrp_CPLID, & + ierr = iMOAB_ComputeCommGraphFortran( mphaid, mbintxoa, mpicom_join, mpigrp_old, mpigrp_CPLID, & typeA, typeB, atm_id, idintx) if (ierr .ne. 0) then write(logunit,*) subname,' error in computing graph phys grid - atm/ocn intx ' @@ -498,7 +498,7 @@ subroutine prep_atm_lnd_moab(infodata) integer :: idintx ! in this case, id of moab intersection between atm and lnd, on coupler pes ! used only for tri-grid case - integer, external :: iMOAB_CoverageGraphFort, iMOAB_ComputeScalarProjectionWeights, iMOAB_ComputeCommGraphFort + integer, external :: iMOAB_CoverageGraphFortran, iMOAB_ComputeScalarProjectionWeights, iMOAB_ComputeCommGraphFortran call seq_infodata_getData(infodata, & atm_present=atm_present, & @@ -517,9 +517,9 @@ subroutine prep_atm_lnd_moab(infodata) context_id = lnd(1)%cplcompid call seq_comm_getinfo(ID_join,mpicom=mpicom_join) if (atm_pg_active ) then ! use mhpgid mesh - ierr = iMOAB_CoverageGraphFort(mpicom_join, mhpgid, mbaxid, mbintxla, context_id); + ierr = iMOAB_CoverageGraphFortran(mpicom_join, mhpgid, mbaxid, mbintxla, context_id); else - ierr = iMOAB_CoverageGraphFort(mpicom_join, mhid, mbaxid, mbintxla, context_id); + ierr = iMOAB_CoverageGraphFortran(mpicom_join, mhid, mbaxid, mbintxla, context_id); endif if (ierr .ne. 0) then write(logunit,*) subname,' error in computing coverage graph atm/lnd ' @@ -593,7 +593,7 @@ subroutine prep_atm_lnd_moab(infodata) ! data from phys grid directly to atm-lnd intx , for later projection ! context is the same, atm - lnd intx id ! endif - ierr = iMOAB_ComputeCommGraphFort( mphaid, mbintxla, mpicom_join, mpigrp_old, mpigrp_CPLID, & + ierr = iMOAB_ComputeCommGraphFortran( mphaid, mbintxla, mpicom_join, mpigrp_old, mpigrp_CPLID, & typeA, typeB, atm_id, idintx) if (ierr .ne. 0) then write(logunit,*) subname,' error in computing graph phys grid - atm/lnd intx ' @@ -627,7 +627,7 @@ subroutine prep_atm_migrate_moab(infodata) character*50 :: outfile, wopts, tagnameProj, lnum integer :: orderOCN, orderATM, volumetric, noConserve, validate - integer, external :: iMOAB_SendElementTagFort, iMOAB_ReceiveElementTagFort, iMOAB_FreeSenderBuffers + integer, external :: iMOAB_SendElementTagFortran, iMOAB_ReceiveElementTagFortran, iMOAB_FreeSenderBuffers integer, external :: iMOAB_ApplyScalarProjectionWeights, iMOAB_WriteMesh call seq_infodata_getData(infodata, & @@ -661,7 +661,7 @@ subroutine prep_atm_migrate_moab(infodata) ! as always, use nonblocking sends tagName = 'T_ph;u_ph;v_ph;'//CHAR(0) ! they are defined in initialize_moab_atm_phys in atm_comp_mct context_id = 100*atm(1)%cplcompid + ocn(1)%cplcompid !send to atm/ocn intx ! - ierr = iMOAB_SendElementTagFort(mphaid, tagName, mpicom_join, context_id) + ierr = iMOAB_SendElementTagFortran(mphaid, tagName, mpicom_join, context_id) if (ierr .ne. 0) then write(logunit,*) subname,' error in sending tag from phys atm to ocn atm intx ' call shr_sys_abort(subname//' ERROR in sending tag from phys atm to ocn atm intx') @@ -674,7 +674,7 @@ subroutine prep_atm_migrate_moab(infodata) ! context_id = atm(1)%cplcompid == atm_id above (5) ! we use the same name as spectral case, even thought in pg2 case, the size of tag is 1, not 16 ! in imoab_apg2_ol_coupler.cpp we use at this stage, receiver, the same name as sender, T_ph - ierr = iMOAB_ReceiveElementTagFort(mbintxoa, tagName, mpicom_join, atm_id) + ierr = iMOAB_ReceiveElementTagFortran(mbintxoa, tagName, mpicom_join, atm_id) if (ierr .ne. 0) then write(logunit,*) subname,' error in receiving tag from phys atm to ocn atm intx ' call shr_sys_abort(subname//' ERROR in receiving tag from phys atm to ocn atm intx') @@ -699,7 +699,7 @@ subroutine prep_atm_migrate_moab(infodata) ! trivial partitioning, now we need to adjust it for "coverage" mesh ! as always, use nonblocking sends - ierr = iMOAB_SendElementTagFort(mhid, tagName, mpicom_join, context_id) + ierr = iMOAB_SendElementTagFortran(mhid, tagName, mpicom_join, context_id) if (ierr .ne. 0) then write(logunit,*) subname,' error in sending tag from atm spectral to ocn atm intx ' call shr_sys_abort(subname//' ERROR in sending tag from atm spectral to ocn atm intx') @@ -707,7 +707,7 @@ subroutine prep_atm_migrate_moab(infodata) endif if (mbaxid .ge. 0 ) then ! we are on coupler pes, for sure ! receive on atm on coupler pes, that was redistributed according to coverage - ierr = iMOAB_ReceiveElementTagFort(mbaxid, tagName, mpicom_join, context_id) + ierr = iMOAB_ReceiveElementTagFortran(mbaxid, tagName, mpicom_join, context_id) if (ierr .ne. 0) then write(logunit,*) subname,' error in receiving tag from atm spectral to ocn atm intx ' call shr_sys_abort(subname//' ERROR in receiving tag from atm spectral to ocn atm intx') @@ -771,7 +771,7 @@ subroutine prep_atm_migrate_moab(infodata) tagName = 'T_ph;u_ph;v_ph;'//CHAR(0) ! they are defined in initialize_moab_atm_phys in atm_comp_mct context_id = 100*atm(1)%cplcompid + lnd(1)%cplcompid !send to atm/lnd intx ! ! use computed graph - ierr = iMOAB_SendElementTagFort(mphaid, tagName, mpicom_join, context_id) + ierr = iMOAB_SendElementTagFortran(mphaid, tagName, mpicom_join, context_id) if (ierr .ne. 0) then write(logunit,*) subname,' error in sending tag from atm to atm land intx ' call shr_sys_abort(subname//' ERROR in sending tag from atm to atm land intx') @@ -781,7 +781,7 @@ subroutine prep_atm_migrate_moab(infodata) if (mbaxid .ge. 0 ) then ! we are on coupler pes, for sure ! receive on atm on coupler pes, that was redistributed according to coverage tagName = 'T_ph;u_ph;v_ph;'//CHAR(0) ! they are defined in initialize_moab_atm_phys - ierr = iMOAB_ReceiveElementTagFort(mbintxla, tagName, mpicom_join, atm_id) + ierr = iMOAB_ReceiveElementTagFortran(mbintxla, tagName, mpicom_join, atm_id) if (ierr .ne. 0) then write(logunit,*) subname,' error in receiving tag from atm to atm land intx ' call shr_sys_abort(subname//' ERROR in receiving tag from atm to atm land intx') @@ -806,7 +806,7 @@ subroutine prep_atm_migrate_moab(infodata) ! original partitioning, now we need to adjust it for "coverage" mesh ! as always, use nonblocking sends - ierr = iMOAB_SendElementTagFort(mhid, tagName, mpicom_join, context_id) + ierr = iMOAB_SendElementTagFortran(mhid, tagName, mpicom_join, context_id) if (ierr .ne. 0) then write(logunit,*) subname,' error in sending tag from atm spectral to atm/lnd intx ' call shr_sys_abort(subname//' ERROR in sending tag from atm spectral to atm/lnd intx ') @@ -815,7 +815,7 @@ subroutine prep_atm_migrate_moab(infodata) endif if (mbaxid .ge. 0 ) then ! we are on coupler pes, for sure ! receive on atm on coupler pes, that was redistributed according to coverage - ierr = iMOAB_ReceiveElementTagFort(mbaxid, tagName, mpicom_join, context_id) + ierr = iMOAB_ReceiveElementTagFortran(mbaxid, tagName, mpicom_join, context_id) if (ierr .ne. 0) then write(logunit,*) subname,' error in receiving tag from atm spectral to atm/lnd intx ' call shr_sys_abort(subname//' ERROR in receiving tag from atm spectral to atm/lnd intx ') @@ -866,7 +866,7 @@ subroutine prep_atm_migrate_moab(infodata) ! original partitioning, now we need to adjust it for "coverage" mesh ! as always, use nonblocking sends - ierr = iMOAB_SendElementTagFort(mhid, tagName, mpicom_join, context_id) + ierr = iMOAB_SendElementTagFortran(mhid, tagName, mpicom_join, context_id) if (ierr .ne. 0) then write(logunit,*) subname,' error in sending tag for land projection' call shr_sys_abort(subname//' ERROR in sending tag for land projection') @@ -874,7 +874,7 @@ subroutine prep_atm_migrate_moab(infodata) endif if (mbaxid .ge. 0 ) then ! we are on coupler pes, for sure ! receive on atm on coupler pes, that was redistributed according to coverage - ierr = iMOAB_ReceiveElementTagFort(mbaxid, tagName, mpicom_join, context_id) + ierr = iMOAB_ReceiveElementTagFortran(mbaxid, tagName, mpicom_join, context_id) if (ierr .ne. 0) then write(logunit,*) subname,' error in receiving tag for land projection' call shr_sys_abort(subname//' ERROR in receiving tag for land projection') diff --git a/driver-moab/main/prep_lnd_mod.F90 b/driver-moab/main/prep_lnd_mod.F90 index c3c7bce8dbfc..5b2ee9ecbd8e 100644 --- a/driver-moab/main/prep_lnd_mod.F90 +++ b/driver-moab/main/prep_lnd_mod.F90 @@ -578,7 +578,7 @@ subroutine prep_lnd_migrate_moab(infodata) character*32 :: outfile, wopts, lnum integer :: orderLND, orderATM, volumetric, noConserve, validate - integer, external :: iMOAB_SendElementTagFort, iMOAB_ReceiveElementTagFort, iMOAB_FreeSenderBuffers + integer, external :: iMOAB_SendElementTagFortran, iMOAB_ReceiveElementTagFortran, iMOAB_FreeSenderBuffers integer, external :: iMOAB_WriteMesh call seq_infodata_getData(infodata, & @@ -599,12 +599,12 @@ subroutine prep_lnd_migrate_moab(infodata) if (mblxid .ge. 0) then ! send because we are on coupler pes ! basically, use the initial partitioning - ierr = iMOAB_SendElementTagFort(mblxid, tagName, mpicom_join, context_id) + ierr = iMOAB_SendElementTagFortran(mblxid, tagName, mpicom_join, context_id) endif if (mlnid .ge. 0 ) then ! we are on land pes, for sure ! receive on land pes, a tag that was computed on coupler pes - ierr = iMOAB_ReceiveElementTagFort(mlnid, tagName, mpicom_join, context_id) + ierr = iMOAB_ReceiveElementTagFortran(mlnid, tagName, mpicom_join, context_id) !CHECKRC(ierr, "cannot receive tag values") endif diff --git a/driver-moab/main/prep_ocn_mod.F90 b/driver-moab/main/prep_ocn_mod.F90 index 6e7908ae8b0d..a96504ff12a5 100644 --- a/driver-moab/main/prep_ocn_mod.F90 +++ b/driver-moab/main/prep_ocn_mod.F90 @@ -1497,7 +1497,7 @@ subroutine prep_ocn_migrate_moab(infodata) character*32 :: outfile, wopts, lnum integer :: orderOCN, orderATM, volumetric, noConserve, validate - integer, external :: iMOAB_SendElementTagFort, iMOAB_ReceiveElementTagFort, iMOAB_FreeSenderBuffers + integer, external :: iMOAB_SendElementTagFortran, iMOAB_ReceiveElementTagFortran, iMOAB_FreeSenderBuffers integer, external :: iMOAB_WriteMesh call seq_infodata_getData(infodata, & @@ -1518,12 +1518,12 @@ subroutine prep_ocn_migrate_moab(infodata) if (mboxid .ge. 0) then ! send because we are on coupler pes ! basically, use the initial partitioning - ierr = iMOAB_SendElementTagFort(mboxid, tagName, mpicom_join, context_id) + ierr = iMOAB_SendElementTagFortran(mboxid, tagName, mpicom_join, context_id) endif if (mpoid .ge. 0 ) then ! we are on ocean pes, for sure ! receive on ocean pes, a tag that was computed on coupler pes - ierr = iMOAB_ReceiveElementTagFort(mpoid, tagName, mpicom_join, context_id) + ierr = iMOAB_ReceiveElementTagFortran(mpoid, tagName, mpicom_join, context_id) !CHECKRC(ierr, "cannot receive tag values") endif From 675cd78fc9a893e56f41b351155bac15d732abc2 Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Wed, 25 Aug 2021 10:20:09 -0500 Subject: [PATCH 100/467] add back deleted lines they were deleted by mistake in commit 703e752bd3a4081799 --- cime_config/config_grids.xml | 2 ++ 1 file changed, 2 insertions(+) diff --git a/cime_config/config_grids.xml b/cime_config/config_grids.xml index e7b2e887a1d6..ca7e2761b4b4 100755 --- a/cime_config/config_grids.xml +++ b/cime_config/config_grids.xml @@ -2752,6 +2752,8 @@ 180 90 + $DIN_LOC_ROOT/share/domains/domain.lnd.r05_oQU480.200527.nc + $DIN_LOC_ROOT/share/domains/domain.lnd.r05_oQU480.200527.nc $DIN_LOC_ROOT/share/domains/domain.lnd.r2_oQU480.210211.nc r2 is 2 degree river routing grid (only used for testing): From 1327683a5e3e8c62126487d6077c2b3a44705653 Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Mon, 30 Aug 2021 15:06:25 -0500 Subject: [PATCH 101/467] wrong fix before for missing config files --- cime_config/config_grids.xml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/cime_config/config_grids.xml b/cime_config/config_grids.xml index ca7e2761b4b4..82e900271235 100755 --- a/cime_config/config_grids.xml +++ b/cime_config/config_grids.xml @@ -2752,8 +2752,6 @@ 180 90 - $DIN_LOC_ROOT/share/domains/domain.lnd.r05_oQU480.200527.nc - $DIN_LOC_ROOT/share/domains/domain.lnd.r05_oQU480.200527.nc $DIN_LOC_ROOT/share/domains/domain.lnd.r2_oQU480.210211.nc r2 is 2 degree river routing grid (only used for testing): @@ -2767,6 +2765,8 @@ 720 360 + $DIN_LOC_ROOT/share/domains/domain.lnd.r05_oQU480.200527.nc + $DIN_LOC_ROOT/share/domains/domain.lnd.r05_oQU480.200527.nc $DIN_LOC_ROOT/share/domains/domain.lnd.r05_oQU240.200527.nc $DIN_LOC_ROOT/share/domains/domain.lnd.r05_oQU240.200527.nc $DIN_LOC_ROOT/share/domains/domain.lnd.r05_oEC60to30v3.190418.nc From 3971768939d1b18360b610c169345f458e8cb92a Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Mon, 30 Aug 2021 10:29:48 -0500 Subject: [PATCH 102/467] start r2o mapping implement moab_map_init_rcfile in seq_map_mod use it in prep ocn issues with reading the file with out ParNcFile reader maybe use pio or pnetcdf ? --- driver-moab/main/prep_ocn_mod.F90 | 22 ++++++++++- driver-moab/main/seq_map_mod.F90 | 63 +++++++++++++++++++++++++++++++ driver-moab/shr/seq_comm_mct.F90 | 3 ++ 3 files changed, 87 insertions(+), 1 deletion(-) diff --git a/driver-moab/main/prep_ocn_mod.F90 b/driver-moab/main/prep_ocn_mod.F90 index 8bca224444e7..530b236c9eee 100644 --- a/driver-moab/main/prep_ocn_mod.F90 +++ b/driver-moab/main/prep_ocn_mod.F90 @@ -13,11 +13,12 @@ module prep_ocn_mod use seq_comm_mct, only: mpoid ! iMOAB pid for ocean mesh on component pes use seq_comm_mct, only: mboxid ! iMOAB id for mpas ocean migrated mesh to coupler pes + use seq_comm_mct, only: mbrmapro ! iMOAB id for map read from rof2ocn map file use seq_comm_mct, only : seq_comm_getinfo => seq_comm_setptrs use seq_infodata_mod, only: seq_infodata_type, seq_infodata_getdata use seq_map_type_mod - use seq_map_mod + use seq_map_mod ! will have also moab_map_init_rcfile use seq_flds_mod use t_drv_timers_mod use mct_mod @@ -171,6 +172,11 @@ subroutine prep_ocn_init(infodata, atm_c2_ocn, atm_c2_ice, ice_c2_ocn, rof_c2_oc character(*), parameter :: subname = '(prep_ocn_init)' character(*), parameter :: F00 = "('"//subname//" : ', 4A )" character(*), parameter :: F01 = "('"//subname//" : ', A, I8 )" + + character*32 :: appname ! to register moab app + integer :: rmapid ! external id to identify the moab app + integer, external :: iMOAB_RegisterApplicationFortran ! + integer :: ierr ! !--------------------------------------------------------------- call seq_infodata_getData(infodata , & @@ -327,6 +333,20 @@ subroutine prep_ocn_init(infodata, atm_c2_ocn, atm_c2_ice, ice_c2_ocn, rof_c2_oc 'seq_maps.rc', 'rof2ocn_liq_rmapname:', 'rof2ocn_liq_rmaptype:',samegrid_ro, & 'mapper_Rr2o_liq initialization',esmf_map_flag) + + appname = "ROF_OCN_COU"//CHAR(0) + ! rmapid is a unique external number of MOAB app that takes care of map between rof and ocn mesh + rmapid = 100*rof(1)%cplcompid + ocn(1)%cplcompid ! something different, to differentiate it + ierr = iMOAB_RegisterApplicationFortran(trim(appname), mpicom_CPLID, rmapid, mbrmapro) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in registering rof 2 ocn moab map ' + call shr_sys_abort(subname//' ERROR in registering rof 2 ocn moab map ') + endif + + call moab_map_init_rcfile(mbrmapro, rof(1), ocn(1), & + 'seq_maps.rc', 'rof2ocn_liq_rmapname:', 'rof2ocn_liq_rmaptype:',samegrid_ro, & + 'mapper_Rr2o_liq moab initialization',esmf_map_flag) + if (iamroot_CPLID) then write(logunit,*) ' ' write(logunit,F00) 'Initializing mapper_Rr2o_ice' diff --git a/driver-moab/main/seq_map_mod.F90 b/driver-moab/main/seq_map_mod.F90 index 5fa449950e28..d77a23ad60ec 100644 --- a/driver-moab/main/seq_map_mod.F90 +++ b/driver-moab/main/seq_map_mod.F90 @@ -30,6 +30,7 @@ module seq_map_mod !-------------------------------------------------------------------------- public :: seq_map_init_rcfile ! cpl pes + public :: moab_map_init_rcfile ! cpl pes public :: seq_map_init_rearrolap ! cpl pes public :: seq_map_initvect ! cpl pes public :: seq_map_map ! cpl pes @@ -158,6 +159,68 @@ subroutine seq_map_init_rcfile( mapper, comp_s, comp_d, & end subroutine seq_map_init_rcfile + + subroutine moab_map_init_rcfile( mbappid, comp_s, comp_d, & + maprcfile, maprcname, maprctype, samegrid, string, esmf_map) + + implicit none + !----------------------------------------------------- + ! + ! Arguments + ! + type(integer) ,intent(in) :: mbappid ! moab app id, identifing the map from source to target + type(component_type) ,intent(inout) :: comp_s + type(component_type) ,intent(inout) :: comp_d + character(len=*) ,intent(in) :: maprcfile + character(len=*) ,intent(in) :: maprcname + character(len=*) ,intent(in) :: maprctype + logical ,intent(in) :: samegrid + character(len=*) ,intent(in),optional :: string + logical ,intent(in),optional :: esmf_map + ! + ! Local Variables + ! + !type(mct_gsmap), pointer :: gsmap_s ! temporary pointers + !type(mct_gsmap), pointer :: gsmap_d ! temporary pointers + integer(IN) :: mpicom + character(CX) :: mapfile + character(CX) :: mapfile_term + character(CL) :: maptype + integer(IN) :: mapid + integer, external :: iMOAB_LoadMappingWeightsFromFile + character(CX) :: sol_identifier ! /* "scalar", "flux", "custom" */ + integer :: ierr + + character(len=*),parameter :: subname = "(seq_map_init_rcfile) " + !----------------------------------------------------- + + if (seq_comm_iamroot(CPLID) .and. present(string)) then + write(logunit,'(A)') subname//' called for '//trim(string) + endif + + call seq_comm_setptrs(CPLID, mpicom=mpicom) + + ! --- Initialize Smatp + call shr_mct_queryConfigFile(mpicom,maprcfile,maprcname,mapfile,maprctype,maptype) + !call shr_mct_sMatPInitnc(mapper%sMatp, mapper%gsMap_s, mapper%gsMap_d, trim(mapfile),trim(maptype),mpicom) + sol_identifier = 'scalar'//CHAR(0) + mapfile_term = trim(mapfile)//CHAR(0) + if (seq_comm_iamroot(CPLID)) then + write(logunit,*) subname,' reading map file with iMOAB: ', mapfile_term + endif + ierr = iMOAB_LoadMappingWeightsFromFile( mbappid, sol_identifier, mapfile_term) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in loading map file' + call shr_sys_abort(subname//' ERROR in loading map file') + endif + if (seq_comm_iamroot(CPLID)) then + write(logunit,'(2A,I6,4A)') subname,' iMOAB map app ID, maptype, mapfile = ', & + mbappid,' ',trim(maptype),' ',trim(mapfile) + call shr_sys_flush(logunit) + endif + +end subroutine moab_map_init_rcfile + !======================================================================= subroutine seq_map_init_rearrolap(mapper, comp_s, comp_d, string) diff --git a/driver-moab/shr/seq_comm_mct.F90 b/driver-moab/shr/seq_comm_mct.F90 index a31682c0d515..501b75097b3a 100644 --- a/driver-moab/shr/seq_comm_mct.F90 +++ b/driver-moab/shr/seq_comm_mct.F90 @@ -228,6 +228,8 @@ module seq_comm_mct integer, public :: mbixid ! iMOAB id for sea-ice migrated to coupler pes integer, public :: mrofid ! iMOAB id of moab rof app integer, public :: mbrxid ! iMOAB id of moab rof migrated to coupler pes + 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 :: num_moab_exports ! iMOAB id for atm phys grid, on atm pes @@ -631,6 +633,7 @@ subroutine seq_comm_init(global_comm_in, driver_comm_in, nmlfile, drv_comm_id) mbixid = -1 ! iMOAB for sea-ice migrated to coupler mrofid = -1 ! iMOAB id of moab rof app mbrxid = -1 ! iMOAB id of moab rof migrated to coupler + mbrmapro = -1 ! iMOAB id of moab instance of map read from rof2ocn map file num_moab_exports = 0 ! mostly used in debugging deallocate(comps,comms) From eae031c81859b717c9de05f0fc061d1896b6c62b Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Tue, 21 Sep 2021 23:48:25 -0500 Subject: [PATCH 103/467] new iMOAB api for fortran adhere to ISO Binding 2003; use iMOAB module strings enf in C_NULL_CHAR remove Fortran designation --- components/eam/src/cpl/atm_comp_mct.F90 | 28 ++-- components/eam/src/dynamics/se/dyn_comp.F90 | 14 +- components/eam/src/dynamics/se/semoab_mod.F90 | 60 ++++---- components/elm/src/cpl/lnd_comp_mct.F90 | 36 ++--- components/mosart/src/cpl/rof_comp_mct.F90 | 24 ++-- .../src/framework/mpas_moabmesh.F | 21 +-- driver-moab/main/cplcomp_exchange_mod.F90 | 111 ++++++++------- driver-moab/main/prep_atm_mod.F90 | 133 +++++++++--------- driver-moab/main/prep_lnd_mod.F90 | 16 +-- driver-moab/main/prep_ocn_mod.F90 | 6 +- driver-moab/shr/seq_comm_mct.F90 | 4 +- 11 files changed, 228 insertions(+), 225 deletions(-) diff --git a/components/eam/src/cpl/atm_comp_mct.F90 b/components/eam/src/cpl/atm_comp_mct.F90 index e9781ceb07e0..71fc4851ed50 100644 --- a/components/eam/src/cpl/atm_comp_mct.F90 +++ b/components/eam/src/cpl/atm_comp_mct.F90 @@ -992,6 +992,9 @@ subroutine initialize_moab_atm_phys( cdata_a ) use shr_const_mod, only: SHR_CONST_PI !------------------------------------------------------------------- use phys_grid, only : get_nlcols_p ! used to det local size ? + use iMOAB, only : iMOAB_RegisterApplication, iMOAB_CreateVertices, iMOAB_WriteMesh, & + iMOAB_DefineTagStorage, iMOAB_SetIntTagStorage, iMOAB_SetDoubleTagStorage, & + iMOAB_ResolveSharedEntities, iMOAB_UpdateMeshInfo type(seq_cdata), intent(in) :: cdata_a @@ -1001,9 +1004,6 @@ subroutine initialize_moab_atm_phys( cdata_a ) integer :: ATM_PHYS ! our numbering - integer , external :: iMOAB_RegisterApplicationFortran, iMOAB_CreateVertices, iMOAB_WriteMesh, & - iMOAB_DefineTagStorage, iMOAB_SetIntTagStorage, iMOAB_SetDoubleTagStorage, & - iMOAB_ResolveSharedEntities, iMOAB_UpdateMeshInfo ! local variables to fill in data integer, dimension(:), allocatable :: vgids ! retrieve everything we need from mct @@ -1030,7 +1030,7 @@ subroutine initialize_moab_atm_phys( cdata_a ) call seq_cdata_setptrs(cdata_a, ID=ATMID, mpicom=mpicom_atm, & infodata=infodata) - appname="ATM_PHYS"//CHAR(0) + appname="ATM_PHYS"//C_NULL_CHAR ATM_PHYS = 200 + ATMID ! ierr = iMOAB_RegisterApplicationFortran(appname, mpicom_atm, ATM_PHYS, mphaid) if (ierr > 0 ) & @@ -1075,7 +1075,7 @@ subroutine initialize_moab_atm_phys( cdata_a ) tagtype = 0 ! dense, integer numco = 1 - tagname='GLOBAL_ID'//CHAR(0) + tagname='GLOBAL_ID'//C_NULL_CHAR ierr = iMOAB_DefineTagStorage(mphaid, tagname, tagtype, numco, tagindex ) if (ierr > 0 ) & call endrun('Error: fail to retrieve GLOBAL_ID tag ') @@ -1091,7 +1091,7 @@ subroutine initialize_moab_atm_phys( cdata_a ) !there are no shared entities, but we will set a special partition tag, in order to see the ! partitions ; it will be visible with a Pseudocolor plot in VisIt - tagname='partition'//CHAR(0) + tagname='partition'//C_NULL_CHAR ierr = iMOAB_DefineTagStorage(mphaid, tagname, tagtype, numco, tagindex ) if (ierr > 0 ) & call endrun('Error: fail to create new partition tag ') @@ -1102,7 +1102,7 @@ subroutine initialize_moab_atm_phys( cdata_a ) call endrun('Error: fail to set partition tag ') ! chunk_index ; it will be visible with a Pseudocolor plot in VisIt - tagname='chunk_id'//CHAR(0) + tagname='chunk_id'//C_NULL_CHAR ierr = iMOAB_DefineTagStorage(mphaid, tagname, tagtype, numco, tagindex ) if (ierr > 0 ) & call endrun('Error: fail to create new chunk index tag ') @@ -1113,7 +1113,7 @@ subroutine initialize_moab_atm_phys( cdata_a ) ! use areavals for areas - tagname='area'//CHAR(0) + tagname='area'//C_NULL_CHAR tagtype = 1 ! dense, double ierr = iMOAB_DefineTagStorage(mphaid, tagname, tagtype, numco, tagindex ) if (ierr > 0 ) & @@ -1126,15 +1126,15 @@ subroutine initialize_moab_atm_phys( cdata_a ) ! create some tags for T, u, v bottoms - tagname='T_ph'//CHAR(0) + tagname='T_ph'//C_NULL_CHAR ierr = iMOAB_DefineTagStorage(mphaid, tagname, tagtype, numco, tagindex ) if (ierr > 0 ) & call endrun('Error: fail to create temp on phys tag ') - tagname='u_ph'//CHAR(0) + tagname='u_ph'//C_NULL_CHAR ierr = iMOAB_DefineTagStorage(mphaid, tagname, tagtype, numco, tagindex ) if (ierr > 0 ) & call endrun('Error: fail to create u velo on phys tag ') - tagname='v_ph'//CHAR(0) + tagname='v_ph'//C_NULL_CHAR ierr = iMOAB_DefineTagStorage(mphaid, tagname, tagtype, numco, tagindex ) if (ierr > 0 ) & call endrun('Error: fail to create v velo on phys tag ') @@ -1143,7 +1143,7 @@ subroutine initialize_moab_atm_phys( cdata_a ) ! this call will set the point_cloud to true inside iMOAB appData structure ierr = iMOAB_UpdateMeshInfo(mphaid) -! tagname='area'//CHAR(0) +! tagname='area'//C_NULL_CHAR ! ierr = iMOAB_DefineTagStorage(mphaid, tagname, tagtype, numco, tagindex ) ! if (ierr > 0 ) & ! call endrun('Error: fail to create area tag ') @@ -1157,8 +1157,8 @@ subroutine initialize_moab_atm_phys( cdata_a ) ! write out the mesh file to disk, in parallel #ifdef MOABDEBUG - outfile = 'AtmPhys.h5m'//CHAR(0) - wopts = 'PARALLEL=WRITE_PART'//CHAR(0) + outfile = 'AtmPhys.h5m'//C_NULL_CHAR + wopts = 'PARALLEL=WRITE_PART'//C_NULL_CHAR ierr = iMOAB_WriteMesh(mphaid, outfile, wopts) if (ierr > 0 ) & call endrun('Error: fail to write the atm phys mesh file') diff --git a/components/eam/src/dynamics/se/dyn_comp.F90 b/components/eam/src/dynamics/se/dyn_comp.F90 index 06e35e16dde2..7996f3ae4a5d 100644 --- a/components/eam/src/dynamics/se/dyn_comp.F90 +++ b/components/eam/src/dynamics/se/dyn_comp.F90 @@ -107,6 +107,7 @@ subroutine dyn_init1(fh, NLFileName, dyn_in, dyn_out) use seq_comm_mct, only: ATMID use seq_comm_mct, only: mhpgid ! id of pgx moab application use prim_driver_base, only: prim_init_moab_mesh ! insertion point for MOAB; after phys grid init + use iMOAB, only : iMOAB_RegisterApplication #endif ! PARAMETERS: @@ -120,7 +121,6 @@ subroutine dyn_init1(fh, NLFileName, dyn_in, dyn_out) integer :: npes_se_stride #ifdef HAVE_MOAB - integer, external :: iMOAB_RegisterApplicationFortran integer :: ATM_ID1 character*32 appname #endif @@ -161,9 +161,9 @@ subroutine dyn_init1(fh, NLFileName, dyn_in, dyn_out) if(par%dynproc) then #ifdef HAVE_MOAB - appname="HM_COARSE"//CHAR(0) + appname="HM_COARSE"//C_NULL_CHAR ATM_ID1 = ATMID(1) ! first atmosphere instance; it should be 5 - ierr = iMOAB_RegisterApplicationFortran(appname, par%comm, ATM_ID1, MHID) + ierr = iMOAB_RegisterApplication(appname, par%comm, ATM_ID1, MHID) if (ierr > 0 ) & call endrun('Error: cannot register moab app') if(par%masterproc) then @@ -171,9 +171,9 @@ subroutine dyn_init1(fh, NLFileName, dyn_in, dyn_out) write(iulog,*) "register MOAB app:", trim(appname), " MHID=", MHID write(iulog,*) " " endif - appname="HM_FINE"//CHAR(0) + appname="HM_FINE"//C_NULL_CHAR ATM_ID1 = 119 ! this number should not conflict with other components IDs; how do we know? - ierr = iMOAB_RegisterApplicationFortran(appname, par%comm, ATM_ID1, MHFID) + ierr = iMOAB_RegisterApplication(appname, par%comm, ATM_ID1, MHFID) if (ierr > 0 ) & call endrun('Error: cannot register moab app for fine mesh') if(par%masterproc) then @@ -182,9 +182,9 @@ subroutine dyn_init1(fh, NLFileName, dyn_in, dyn_out) write(iulog,*) " " endif if ( fv_nphys > 0 ) then - appname="HM_PGX"//CHAR(0) + appname="HM_PGX"//C_NULL_CHAR ATM_ID1 = 120 ! this number should not conflict with other components IDs; how do we know? - ierr = iMOAB_RegisterApplicationFortran(appname, par%comm, ATM_ID1, mhpgid) + ierr = iMOAB_RegisterApplication(appname, par%comm, ATM_ID1, mhpgid) if (ierr > 0 ) & call endrun('Error: cannot register moab app for fine mesh') if(par%masterproc) then diff --git a/components/eam/src/dynamics/se/semoab_mod.F90 b/components/eam/src/dynamics/se/semoab_mod.F90 index 67b5cbae1182..78d0566b4e7d 100644 --- a/components/eam/src/dynamics/se/semoab_mod.F90 +++ b/components/eam/src/dynamics/se/semoab_mod.F90 @@ -81,6 +81,9 @@ end function search_in subroutine create_moab_meshes(par, elem) use ISO_C_BINDING + use iMOAB, only: iMOAB_CreateVertices, iMOAB_WriteMesh, iMOAB_CreateElements, & + iMOAB_ResolveSharedEntities, iMOAB_UpdateMeshInfo, iMOAB_DefineTagStorage, & + iMOAB_SetIntTagStorage, iMOAB_ReduceTagsMax, iMOAB_GetIntTagStorage use coordinate_systems_mod, only : cartesian3D_t, spherical_to_cart, spherical_polar_t type (element_t), intent(inout) :: elem(:) @@ -95,11 +98,6 @@ subroutine create_moab_meshes(par, elem) integer nelemd2 ! do not confuse this with dimensions_mod::nelemd -! do we really need this? - integer , external :: iMOAB_CreateVertices, iMOAB_WriteMesh, iMOAB_CreateElements, & - iMOAB_ResolveSharedEntities, iMOAB_UpdateMeshInfo, iMOAB_DefineTagStorage, & - iMOAB_SetIntTagStorage, iMOAB_ReduceTagsMax, iMOAB_GetIntTagStorage - integer(kind=long_kind), dimension(:), allocatable :: gdofv ! this will be moab vertex handle locally integer, dimension(:), allocatable :: moabvh @@ -256,7 +254,7 @@ subroutine create_moab_meshes(par, elem) ! for this particular problem, markers are the global dofs at corner nodes ! set the global id for vertices ! first, retrieve the tag - tagname='GDOF'//CHAR(0) + tagname='GDOF'//C_NULL_CHAR tagtype = 0 ! dense, integer numco = 1 ierr = iMOAB_DefineTagStorage(MHFID, tagname, tagtype, numco, tagindex ) @@ -276,7 +274,7 @@ subroutine create_moab_meshes(par, elem) ! use element offset for actual global dofs ! tagtype = 0 ! dense, integer ! numco = 1 - newtagg='GLOBAL_ID'//CHAR(0) + newtagg='GLOBAL_ID'//C_NULL_CHAR ierr = iMOAB_DefineTagStorage(MHFID, newtagg, tagtype, numco, tagindex ) if (ierr > 0 ) & call endrun('Error: fail to create new GDOF tag') @@ -318,8 +316,8 @@ subroutine create_moab_meshes(par, elem) ! write in serial, on each task, before ghosting if (par%rank .lt. 4) then write(lnum,"(I0.2)")par%rank - localmeshfile = 'fineh_'//trim(lnum)// '.h5m' // CHAR(0) - wopts = CHAR(0) + localmeshfile = 'fineh_'//trim(lnum)// '.h5m' // C_NULL_CHAR + wopts = C_NULL_CHAR ierr = iMOAB_WriteMesh(MHFID, localmeshfile, wopts) if (ierr > 0 ) & call endrun('Error: fail to write local mesh file') @@ -330,8 +328,8 @@ subroutine create_moab_meshes(par, elem) call endrun('Error: fail to update mesh info') #ifdef MOABDEBUG ! write out the mesh file to disk, in parallel - outfile = 'wholeFineATM.h5m'//CHAR(0) - wopts = 'PARALLEL=WRITE_PART'//CHAR(0) + outfile = 'wholeFineATM.h5m'//C_NULL_CHAR + wopts = 'PARALLEL=WRITE_PART'//C_NULL_CHAR ierr = iMOAB_WriteMesh(MHFID, outfile, wopts) if (ierr > 0 ) & call endrun('Error: fail to write the mesh file') @@ -425,7 +423,7 @@ subroutine create_moab_meshes(par, elem) ! for this particular problem, markers are the global dofs at corner nodes ! set the global id for vertices ! first, retrieve the tag - tagname='GDOFV'//CHAR(0) + tagname='GDOFV'//C_NULL_CHAR tagtype = 0 ! dense, integer numco = 1 ierr = iMOAB_DefineTagStorage(MHID, tagname, tagtype, numco, tagindex ) @@ -450,7 +448,7 @@ subroutine create_moab_meshes(par, elem) call endrun('Error: fail to resolve shared entities') ! global dofs are the GLL points are set for each element - tagname='GLOBAL_DOFS'//CHAR(0) + tagname='GLOBAL_DOFS'//C_NULL_CHAR tagtype = 0 ! dense, integer numco = np*np ! usually, it is 16; each element will have the dofs in order ierr = iMOAB_DefineTagStorage(MHID, tagname, tagtype, numco, tagindex ) @@ -490,19 +488,19 @@ subroutine create_moab_meshes(par, elem) ! create a new tag, for transfer example ; will use it now for temperature on the surface ! (bottom atm to surface of ocean) - tagname='a2oTbot'//CHAR(0) ! atm to ocean temp bottom tag + tagname='a2oTbot'//C_NULL_CHAR ! atm to ocean temp bottom tag tagtype = 1 ! dense, double numco = np*np ! usually, it is 16; each element will have the same order as dofs ierr = iMOAB_DefineTagStorage(MHID, tagname, tagtype, numco, tagindex ) if (ierr > 0 ) & call endrun('Error: fail to create atm to ocean temp bottom tag') - tagname='a2oUbot'//CHAR(0) ! atm to ocean U bottom tag + tagname='a2oUbot'//C_NULL_CHAR ! atm to ocean U bottom tag ierr = iMOAB_DefineTagStorage(MHID, tagname, tagtype, numco, tagindex ) if (ierr > 0 ) & call endrun('Error: fail to create atm to ocean U velocity bottom tag') - tagname='a2oVbot'//CHAR(0) ! atm to ocean V bottom tag + tagname='a2oVbot'//C_NULL_CHAR ! atm to ocean V bottom tag ierr = iMOAB_DefineTagStorage(MHID, tagname, tagtype, numco, tagindex ) if (ierr > 0 ) & call endrun('Error: fail to create atm to ocean V velocity bottom tag') @@ -510,7 +508,7 @@ subroutine create_moab_meshes(par, elem) ! create a new tag, for transfer example ; will use it now for temperature on the surface ! (bottom atm to surface of ocean); for debugging, use it on fine mesh - tagname='a2o_T'//CHAR(0) ! atm to ocean tag + tagname='a2o_T'//C_NULL_CHAR ! atm to ocean tag tagtype = 1 ! dense, double numco = 1 ! usually, it is 1; one value per gdof ierr = iMOAB_DefineTagStorage(MHFID, tagname, tagtype, numco, tagindex ) @@ -521,8 +519,8 @@ subroutine create_moab_meshes(par, elem) ! write in serial, on each task, before ghosting if (par%rank .lt. 5) then write(lnum,"(I0.2)")par%rank - localmeshfile = 'owned_'//trim(lnum)// '.h5m' // CHAR(0) - wopts = CHAR(0) + localmeshfile = 'owned_'//trim(lnum)// '.h5m' // C_NULL_CHAR + wopts = C_NULL_CHAR ierr = iMOAB_WriteMesh(MHID, localmeshfile, wopts) if (ierr > 0 ) & call endrun('Error: fail to write local mesh file') @@ -533,8 +531,8 @@ subroutine create_moab_meshes(par, elem) call endrun('Error: fail to update mesh info') #ifdef MOABDEBUG ! write out the mesh file to disk, in parallel - outfile = 'wholeATM.h5m'//CHAR(0) - wopts = 'PARALLEL=WRITE_PART'//CHAR(0) + outfile = 'wholeATM.h5m'//C_NULL_CHAR + wopts = 'PARALLEL=WRITE_PART'//C_NULL_CHAR ierr = iMOAB_WriteMesh(MHID, outfile, wopts) if (ierr > 0 ) & call endrun('Error: fail to write the mesh file') @@ -759,7 +757,7 @@ subroutine create_moab_meshes(par, elem) if (ierr > 0 ) & call endrun('Error: fail to create MOAB elements') - tagname='GLOBAL_ID'//CHAR(0) + tagname='GLOBAL_ID'//C_NULL_CHAR tagtype = 0 ! dense, integer numco = 1 ierr = iMOAB_DefineTagStorage(MHPGID, tagname, tagtype, numco, tagindex ) @@ -784,8 +782,8 @@ subroutine create_moab_meshes(par, elem) call endrun('Error: fail to update mesh info for pg2 mesh') #ifdef MOABDEBUG ! write out the mesh file to disk, in parallel - outfile = 'wholeATM_PG2.h5m'//CHAR(0) - wopts = 'PARALLEL=WRITE_PART'//CHAR(0) + outfile = 'wholeATM_PG2.h5m'//C_NULL_CHAR + wopts = 'PARALLEL=WRITE_PART'//C_NULL_CHAR ierr = iMOAB_WriteMesh(MHPGID, outfile, wopts) if (ierr > 0 ) & call endrun('Error: fail to write the mesh file') @@ -848,7 +846,7 @@ subroutine moab_export_data(elem) enddo enddo ! set the tag - tagname='a2oTbot'//CHAR(0) ! atm to ocean tag for temperature + tagname='a2oTbot'//C_NULL_CHAR ! atm to ocean tag for temperature ent_type = 1 ! element type ierr = iMOAB_SetDoubleTagStorage ( MHID, tagname, size_tag_array, ent_type, valuesTag) if (ierr > 0 ) & @@ -863,7 +861,7 @@ subroutine moab_export_data(elem) enddo enddo ! set the tag - tagname='a2oUbot'//CHAR(0) ! atm to ocean tag for U velocity + tagname='a2oUbot'//C_NULL_CHAR ! atm to ocean tag for U velocity ent_type = 1 ! element type ierr = iMOAB_SetDoubleTagStorage ( MHID, tagname, size_tag_array, ent_type, valuesTag) if (ierr > 0 ) & @@ -878,7 +876,7 @@ subroutine moab_export_data(elem) enddo enddo ! set the tag - tagname='a2oVbot'//CHAR(0) ! atm to ocean tag for V velocity + tagname='a2oVbot'//C_NULL_CHAR ! atm to ocean tag for V velocity ent_type = 1 ! element type ierr = iMOAB_SetDoubleTagStorage ( MHID, tagname, size_tag_array, ent_type, valuesTag) if (ierr > 0 ) & @@ -888,8 +886,8 @@ subroutine moab_export_data(elem) #ifdef MOABDEBUG ! write out the mesh file to disk, in parallel write(lnum,"(I0.2)")num_calls_export - outfile = 'wholeATM_T_'//trim(lnum)// '.h5m' // CHAR(0) - wopts = 'PARALLEL=WRITE_PART'//CHAR(0) + outfile = 'wholeATM_T_'//trim(lnum)// '.h5m' // C_NULL_CHAR + wopts = 'PARALLEL=WRITE_PART'//C_NULL_CHAR ierr = iMOAB_WriteMesh(MHID, outfile, wopts) if (ierr > 0 ) & call endrun('Error: fail to write the mesh file') @@ -907,7 +905,7 @@ subroutine moab_export_data(elem) end do end do - tagname='a2o_T'//CHAR(0) ! atm to ocean tag, on fine mesh + tagname='a2o_T'//C_NULL_CHAR ! atm to ocean tag, on fine mesh ierr = iMOAB_GetMeshInfo ( MHFID, nvert, nvise, nbl, nsurf, nvisBC ); ent_type = 0 ! vertex type ierr = iMOAB_SetDoubleTagStorage ( MHFID, tagname, nvert(1), ent_type, valuesTag) @@ -917,7 +915,7 @@ subroutine moab_export_data(elem) #ifdef MOABDEBUG ! write out the mesh file to disk, in parallel - outfile = 'wholeFineATM_T_'//trim(lnum)// '.h5m' // CHAR(0) + outfile = 'wholeFineATM_T_'//trim(lnum)// '.h5m' // C_NULL_CHAR ierr = iMOAB_WriteMesh(MHFID, outfile, wopts) if (ierr > 0 ) & diff --git a/components/elm/src/cpl/lnd_comp_mct.F90 b/components/elm/src/cpl/lnd_comp_mct.F90 index 75fc34db6a49..4bf3db34c783 100644 --- a/components/elm/src/cpl/lnd_comp_mct.F90 +++ b/components/elm/src/cpl/lnd_comp_mct.F90 @@ -73,7 +73,8 @@ subroutine lnd_init_mct( EClock, cdata_l, x2l_l, l2x_l, NLFilename ) use mct_mod use ESMF #ifdef HAVE_MOAB - use seq_comm_mct, only: mlnid ! id of moab land app + use iMOAB , only : iMOAB_RegisterApplication + use seq_comm_mct, only: mlnid ! id of moab land app #endif ! ! !ARGUMENTS: @@ -124,7 +125,6 @@ subroutine lnd_init_mct( EClock, cdata_l, x2l_l, l2x_l, NLFilename ) character(len=*), parameter :: format = "('("//trim(sub)//") :',A)" #ifdef HAVE_MOAB - integer, external :: iMOAB_RegisterApplicationFortran integer :: ierr character*32 appname logical :: samegrid_al ! @@ -278,9 +278,9 @@ subroutine lnd_init_mct( EClock, cdata_l, x2l_l, l2x_l, NLFilename ) call lnd_SetgsMap_mct( bounds, mpicom_lnd, LNDID, gsMap_lnd ) lsz = mct_gsMap_lsize(gsMap_lnd, mpicom_lnd) #ifdef HAVE_MOAB - appname="LNDMB"//CHAR(0) + appname="LNDMB"//C_NULL_CHAR ! first land instance, should be 9 - ierr = iMOAB_RegisterApplicationFortran(appname, mpicom_lnd, LNDID, mlnid) + ierr = iMOAB_RegisterApplication(appname, mpicom_lnd, LNDID, mlnid) if (ierr > 0 ) & call endrun('Error: cannot register moab app') if(masterproc) then @@ -772,6 +772,9 @@ subroutine init_land_moab(bounds, samegrid_al) use domainMod , only: ldomain ! ldomain is coming from module, not even passed use elm_varcon , only: re use shr_const_mod, only: SHR_CONST_PI + use iMOAB , only: iMOAB_CreateVertices, iMOAB_WriteMesh, & + iMOAB_DefineTagStorage, iMOAB_SetIntTagStorage, iMOAB_SetDoubleTagStorage, & + iMOAB_ResolveSharedEntities, iMOAB_CreateElements, iMOAB_MergeVertices, iMOAB_UpdateMeshInfo type(bounds_type) , intent(in) :: bounds logical :: samegrid_al @@ -780,9 +783,6 @@ subroutine init_land_moab(bounds, samegrid_al) integer lsz ! keep local size integer gsize ! global size, that we do not need, actually integer n - integer , external :: iMOAB_CreateVertices, iMOAB_WriteMesh, & - iMOAB_DefineTagStorage, iMOAB_SetIntTagStorage, iMOAB_SetDoubleTagStorage, & - iMOAB_ResolveSharedEntities, iMOAB_CreateElements, iMOAB_MergeVertices, iMOAB_UpdateMeshInfo ! local variables to fill in data integer, dimension(:), allocatable :: vgids ! retrieve everything we need from land domain mct_ldom @@ -838,7 +838,7 @@ subroutine init_land_moab(bounds, samegrid_al) ! define some tags on cells now, not on vertices tagtype = 0 ! dense, integer numco = 1 - tagname='GLOBAL_ID'//CHAR(0) + tagname='GLOBAL_ID'//C_NULL_CHAR ierr = iMOAB_DefineTagStorage(mlnid, tagname, tagtype, numco, tagindex ) if (ierr > 0 ) & call endrun('Error: fail to retrieve GLOBAL_ID tag ') @@ -854,7 +854,7 @@ subroutine init_land_moab(bounds, samegrid_al) ! !there are no shared entities, but we will set a special partition tag, in order to see the ! ! partitions ; it will be visible with a Pseudocolor plot in VisIt -! tagname='partition'//CHAR(0) +! tagname='partition'//C_NULL_CHAR ! ierr = iMOAB_DefineTagStorage(mlnid, tagname, tagtype, numco, tagindex ) ! if (ierr > 0 ) & ! call endrun('Error: fail to create new partition tag ') @@ -866,7 +866,7 @@ subroutine init_land_moab(bounds, samegrid_al) ! use moab_vert_coords as a data holder for a frac tag and area tag that we will create ! on the vertices; do not allocate other data array - tagname='frac'//CHAR(0) + tagname='frac'//C_NULL_CHAR tagtype = 1 ! dense, double ierr = iMOAB_DefineTagStorage(mlnid, tagname, tagtype, numco, tagindex ) if (ierr > 0 ) & @@ -880,7 +880,7 @@ subroutine init_land_moab(bounds, samegrid_al) if (ierr > 0 ) & call endrun('Error: fail to set frac tag ') - tagname='area'//CHAR(0) + tagname='area'//C_NULL_CHAR ierr = iMOAB_DefineTagStorage(mlnid, tagname, tagtype, numco, tagindex ) if (ierr > 0 ) & call endrun('Error: fail to create area tag ') @@ -903,7 +903,7 @@ subroutine init_land_moab(bounds, samegrid_al) end do end do ent_type = 0 ! vertices now - tagname = 'GLOBAL_ID'//CHAR(0) + tagname = 'GLOBAL_ID'//C_NULL_CHAR ierr = iMOAB_SetIntTagStorage ( mlnid, tagname, lsz , ent_type, vgids ) if (ierr > 0 ) & call endrun('Error: fail to set global ID tag on vertices in land mesh ') @@ -930,7 +930,7 @@ subroutine init_land_moab(bounds, samegrid_al) tagtype = 0 ! dense, integer numco = 1 - tagname='GLOBAL_ID'//CHAR(0) + tagname='GLOBAL_ID'//C_NULL_CHAR ierr = iMOAB_DefineTagStorage(mlnid, tagname, tagtype, numco, tagindex ) if (ierr > 0 ) & call endrun('Error: fail to retrieve GLOBAL_ID tag ') @@ -946,7 +946,7 @@ subroutine init_land_moab(bounds, samegrid_al) !there are no shared entities, but we will set a special partition tag, in order to see the ! partitions ; it will be visible with a Pseudocolor plot in VisIt - tagname='partition'//CHAR(0) + tagname='partition'//C_NULL_CHAR ierr = iMOAB_DefineTagStorage(mlnid, tagname, tagtype, numco, tagindex ) if (ierr > 0 ) & call endrun('Error: fail to create new partition tag ') @@ -958,7 +958,7 @@ subroutine init_land_moab(bounds, samegrid_al) ! use moab_vert_coords as a data holder for a frac tag and area tag that we will create ! on the vertices; do not allocate other data array - tagname='frac'//CHAR(0) + tagname='frac'//C_NULL_CHAR tagtype = 1 ! dense, double ierr = iMOAB_DefineTagStorage(mlnid, tagname, tagtype, numco, tagindex ) if (ierr > 0 ) & @@ -972,7 +972,7 @@ subroutine init_land_moab(bounds, samegrid_al) if (ierr > 0 ) & call endrun('Error: fail to set frac tag ') - tagname='area'//CHAR(0) + tagname='area'//C_NULL_CHAR ierr = iMOAB_DefineTagStorage(mlnid, tagname, tagtype, numco, tagindex ) if (ierr > 0 ) & call endrun('Error: fail to create area tag ') @@ -989,8 +989,8 @@ subroutine init_land_moab(bounds, samegrid_al) deallocate(vgids) #ifdef MOABDEBUG ! write out the mesh file to disk, in parallel - outfile = 'wholeLnd.h5m'//CHAR(0) - wopts = 'PARALLEL=WRITE_PART'//CHAR(0) + outfile = 'wholeLnd.h5m'//C_NULL_CHAR + wopts = 'PARALLEL=WRITE_PART'//C_NULL_CHAR ierr = iMOAB_WriteMesh(mlnid, outfile, wopts) if (ierr > 0 ) & call endrun('Error: fail to write the land mesh file') diff --git a/components/mosart/src/cpl/rof_comp_mct.F90 b/components/mosart/src/cpl/rof_comp_mct.F90 index 1db12eb69d9c..993775bb2791 100644 --- a/components/mosart/src/cpl/rof_comp_mct.F90 +++ b/components/mosart/src/cpl/rof_comp_mct.F90 @@ -94,6 +94,9 @@ subroutine rof_init_mct( EClock, cdata_r, x2r_r, r2x_r, NLFilename) ! back from (i.e. albedos, surface temperature and snow cover over land). ! ! !ARGUMENTS: +#ifdef HAVE_MOAB + use iMOAB , only : iMOAB_RegisterApplication +#endif type(ESMF_Clock), intent(inout) :: EClock ! Input synchronization clock type(seq_cdata), intent(inout) :: cdata_r ! Input runoff-model driver data type(mct_aVect) , intent(inout) :: x2r_r ! River import state @@ -135,7 +138,6 @@ subroutine rof_init_mct( EClock, cdata_r, x2r_r, r2x_r, NLFilename) character(len=*), parameter :: format = "('("//trim(sub)//") :',A)" #ifdef HAVE_MOAB - integer, external :: iMOAB_RegisterApplicationFortran integer :: ierr character*32 appname #endif @@ -276,9 +278,9 @@ subroutine rof_init_mct( EClock, cdata_r, x2r_r, r2x_r, NLFilename) call rof_export_mct( r2x_r ) #ifdef HAVE_MOAB - appname="ROFMB"//CHAR(0) ! only if rof_prognostic + appname="ROFMB"//C_NULL_CHAR ! only if rof_prognostic ! first rof instance, should be - ierr = iMOAB_RegisterApplicationFortran(appname, mpicom_rof, ROFID, mrofid) + ierr = iMOAB_RegisterApplication(appname, mpicom_rof, ROFID, mrofid) if (ierr > 0 ) & call shr_sys_abort( sub//' Error: cannot register moab app') if(masterproc) then @@ -778,14 +780,14 @@ subroutine init_rof_moab() ! use rtmCTL that has all we need use seq_comm_mct, only: mrofid ! id of moab rof app use shr_const_mod, only: SHR_CONST_PI + use iMOAB, only : iMOAB_CreateVertices, iMOAB_WriteMesh, & + iMOAB_DefineTagStorage, iMOAB_SetIntTagStorage, iMOAB_SetDoubleTagStorage, & + iMOAB_ResolveSharedEntities, iMOAB_CreateElements, iMOAB_MergeVertices, iMOAB_UpdateMeshInfo integer,allocatable :: gindex(:) ! Number the local grid points; used for global ID integer lsz ! keep local size integer gsize ! global size, that we do not need, actually integer n - integer , external :: iMOAB_CreateVertices, iMOAB_WriteMesh, & - iMOAB_DefineTagStorage, iMOAB_SetIntTagStorage, iMOAB_SetDoubleTagStorage, & - iMOAB_ResolveSharedEntities, iMOAB_CreateElements, iMOAB_MergeVertices, iMOAB_UpdateMeshInfo ! local variables to fill in data integer, dimension(:), allocatable :: vgids ! retrieve everything we need from rtmCTL @@ -825,7 +827,7 @@ subroutine init_rof_moab() tagtype = 0 ! dense, integer numco = 1 - tagname='GLOBAL_ID'//CHAR(0) + tagname='GLOBAL_ID'//C_NULL_CHAR ierr = iMOAB_DefineTagStorage(mrofid, tagname, tagtype, numco, tagindex ) if (ierr > 0 ) & call shr_sys_abort( sub//' Error: fail to retrieve GLOBAL_ID tag ') @@ -841,7 +843,7 @@ subroutine init_rof_moab() !there are no shared entities, but we will set a special partition tag, in order to see the ! partitions ; it will be visible with a Pseudocolor plot in VisIt - tagname='partition'//CHAR(0) + tagname='partition'//C_NULL_CHAR ierr = iMOAB_DefineTagStorage(mrofid, tagname, tagtype, numco, tagindex ) if (ierr > 0 ) & call shr_sys_abort( sub//' Error: fail to create new partition tag ') @@ -852,7 +854,7 @@ subroutine init_rof_moab() call shr_sys_abort( sub//' Error: fail to set partition tag ') ! mask - tagname='mask'//CHAR(0) + tagname='mask'//C_NULL_CHAR ierr = iMOAB_DefineTagStorage(mrofid, tagname, tagtype, numco, tagindex ) if (ierr > 0 ) & call shr_sys_abort( sub//' Error: fail to create new mask tag ') @@ -869,8 +871,8 @@ subroutine init_rof_moab() deallocate(vgids) #ifdef MOABDEBUG ! write out the mesh file to disk, in parallel - outfile = 'wholeRof.h5m'//CHAR(0) - wopts = 'PARALLEL=WRITE_PART'//CHAR(0) + outfile = 'wholeRof.h5m'//C_NULL_CHAR + wopts = 'PARALLEL=WRITE_PART'//C_NULL_CHAR ierr = iMOAB_WriteMesh(mrofid, outfile, wopts) if (ierr > 0 ) & call shr_sys_abort( sub//' Error: fail to write the moab runoff mesh file') diff --git a/components/mpas-framework/src/framework/mpas_moabmesh.F b/components/mpas-framework/src/framework/mpas_moabmesh.F index fd3e00d4fc1b..1e3832e316e2 100644 --- a/components/mpas-framework/src/framework/mpas_moabmesh.F +++ b/components/mpas-framework/src/framework/mpas_moabmesh.F @@ -7,6 +7,7 @@ module mpas_moabmesh use mpas_sort use mpas_stream_manager use mpas_pool_routines + !use mpas_vector_operations #include "moab/MOABConfig.h" implicit none @@ -24,7 +25,12 @@ SUBROUTINE errorout(ierr, message) end subroutine subroutine mpas_moab_instance(domain, ext_comp_id, pidmoab) - + use iMOAB, only : iMOAB_RegisterApplicationFortran, & + iMOAB_CreateVertices, iMOAB_CreateElements, & + iMOAB_ResolveSharedEntities, iMOAB_DetermineGhostEntities, & + iMOAB_DefineTagStorage, iMOAB_SetIntTagStorage , & + iMOAB_UpdateMeshInfo + type (domain_type), intent(inout) :: domain integer , intent(in) :: ext_comp_id integer , Intent(inout) :: pidmoab @@ -42,11 +48,6 @@ subroutine mpas_moab_instance(domain, ext_comp_id, pidmoab) real(kind=RKIND), pointer :: x_period, y_period integer, pointer :: nCellsSolve, nEdgesSolve, nVerticesSolve - integer , external :: iMOAB_RegisterApplicationFortran, & - iMOAB_CreateVertices, iMOAB_CreateElements, & - iMOAB_ResolveSharedEntities, iMOAB_DetermineGhostEntities, & - iMOAB_DefineTagStorage, iMOAB_SetIntTagStorage , & - iMOAB_UpdateMeshInfo integer :: c_comm, i1, j1, ic, lastvertex character*12 appname integer :: ierr, num_verts_in_cells @@ -59,7 +60,7 @@ subroutine mpas_moab_instance(domain, ext_comp_id, pidmoab) c_comm = domain % dminfo % comm write(lnum,"(I0.2)")ext_comp_id - appname = 'MPAS_MB_'//trim(lnum)// CHAR(0) + appname = 'MPAS_MB_'//trim(lnum)//C_NULL_CHAR ierr = iMOAB_RegisterApplicationFortran(appname, c_comm, ext_comp_id, pid) pidmoab = pid ! this is exported, need for send to work call errorout(ierr, 'fail to register MPAS_MOAB mesh') @@ -152,7 +153,7 @@ subroutine mpas_moab_instance(domain, ext_comp_id, pidmoab) call errorout(ierr, 'fail to create polygons') ! set the global id for vertices ! first, retrieve the tag - tagname='GLOBAL_ID'//CHAR(0) + tagname='GLOBAL_ID'//C_NULL_CHAR tagtype = 0 ! dense, integer numco = 1 ierr = iMOAB_DefineTagStorage(pid, tagname, tagtype, numco, tagindex ) @@ -173,8 +174,8 @@ subroutine mpas_moab_instance(domain, ext_comp_id, pidmoab) !#ifdef MPAS_DEBUG ! if (proc_id.lt. 5) then ! write(lnum,"(I0.2)")proc_id -! localmeshfile = 'ownedOcn_'//trim(lnum)// '.h5m' // CHAR(0) -! wopts = CHAR(0) +! localmeshfile = 'ownedOcn_'//trim(lnum)// '.h5m' // C_NULL_CHAR +! wopts = C_NULL_CHAR ! ierr = iMOAB_WriteMesh(pid, localmeshfile, wopts) ! call errorout(ierr, 'fail to write local mesh file') ! endif diff --git a/driver-moab/main/cplcomp_exchange_mod.F90 b/driver-moab/main/cplcomp_exchange_mod.F90 index 4d8f0d696132..f99016e40c94 100644 --- a/driver-moab/main/cplcomp_exchange_mod.F90 +++ b/driver-moab/main/cplcomp_exchange_mod.F90 @@ -982,7 +982,9 @@ subroutine cplcomp_moab_Init(comp) !----------------------------------------------------- ! - ! Arguments + use iMOAB, only: iMOAB_RegisterApplication, iMOAB_ReceiveMesh, iMOAB_SendMesh, & + iMOAB_WriteMesh, iMOAB_DefineTagStorage, iMOAB_GetMeshInfo, & + iMOAB_SetIntTagStorage, iMOAB_FreeSenderBuffers ! type(component_type), intent(inout) :: comp ! @@ -1000,9 +1002,6 @@ subroutine cplcomp_moab_Init(comp) integer :: mpigrp_cplid ! coupler pes integer :: mpigrp_old ! component group pes - integer, external :: iMOAB_RegisterApplicationFortran, iMOAB_ReceiveMeshFortran, iMOAB_SendMeshFortran - integer, external :: iMOAB_WriteMesh, iMOAB_DefineTagStorage, iMOAB_GetMeshInfo - integer, external :: iMOAB_SetIntTagStorage, iMOAB_FreeSenderBuffers integer :: ierr, context_id character*32 :: appname, outfile, wopts, tagnameProj integer :: maxMH, maxMPO, maxMLID, maxMSID ! max pids for moab apps atm, ocn, lnd, sea-ice @@ -1055,10 +1054,10 @@ subroutine cplcomp_moab_Init(comp) if (MPI_COMM_NULL /= mpicom_old ) then ! it means we are on the component pes (atmosphere) ! send mesh to coupler if (atm_pg_active) then ! change : send the pg2 mesh, not coarse mesh, when atm pg active - ierr = iMOAB_SendMeshFortran(mhpgid, mpicom_join, mpigrp_cplid, id_join, partMethod) + ierr = iMOAB_SendMesh(mhpgid, mpicom_join, mpigrp_cplid, id_join, partMethod) else ! still use the mhid, original coarse mesh - ierr = iMOAB_SendMeshFortran(mhid, mpicom_join, mpigrp_cplid, id_join, partMethod) + ierr = iMOAB_SendMesh(mhid, mpicom_join, mpigrp_cplid, id_join, partMethod) endif if (ierr .ne. 0) then write(logunit,*) subname,' error in sending mesh from atm comp ' @@ -1066,14 +1065,14 @@ subroutine cplcomp_moab_Init(comp) endif endif if (MPI_COMM_NULL /= mpicom_new ) then ! we are on the coupler pes - appname = "COUPLE_ATM"//CHAR(0) + appname = "COUPLE_ATM"//C_NULL_CHAR ! migrated mesh gets another app id, moab atm to coupler (mbax) - ierr = iMOAB_RegisterApplicationFortran(trim(appname), mpicom_new, id_join, mbaxid) + ierr = iMOAB_RegisterApplication(trim(appname), mpicom_new, id_join, mbaxid) if (ierr .ne. 0) then write(logunit,*) subname,' error in registering ', appname call shr_sys_abort(subname//' ERROR registering '// appname) endif - ierr = iMOAB_ReceiveMeshFortran(mbaxid, mpicom_join, mpigrp_old, id_old) + ierr = iMOAB_ReceiveMesh(mbaxid, mpicom_join, mpigrp_old, id_old) if (ierr .ne. 0) then write(logunit,*) subname,' error in receiving mesh on atm coupler ' call shr_sys_abort(subname//' ERROR in receiving mesh on atm coupler ') @@ -1081,11 +1080,11 @@ subroutine cplcomp_moab_Init(comp) #ifdef MOABDEBUG ! debug test if (atm_pg_active) then ! - outfile = 'recMeshAtmPG.h5m'//CHAR(0) + outfile = 'recMeshAtmPG.h5m'//C_NULL_CHAR else - outfile = 'recMeshAtm.h5m'//CHAR(0) + outfile = 'recMeshAtm.h5m'//C_NULL_CHAR endif - wopts = ';PARALLEL=WRITE_PART'//CHAR(0) + wopts = ';PARALLEL=WRITE_PART'//C_NULL_CHAR ! write out the mesh file to disk ierr = iMOAB_WriteMesh(mbaxid, trim(outfile), trim(wopts)) if (ierr .ne. 0) then @@ -1131,7 +1130,7 @@ subroutine cplcomp_moab_Init(comp) ! we can receive those tags only on coupler pes, when mbaxid exists ! we have to check that before we can define the tag if (mbaxid .ge. 0 ) then - tagname = 'T_ph16'//CHAR(0) + tagname = 'T_ph16'//C_NULL_CHAR tagtype = 1 ! dense, double if (atm_pg_active) then numco = 1 ! just one value per cell ! @@ -1140,9 +1139,9 @@ subroutine cplcomp_moab_Init(comp) endif ierr = iMOAB_DefineTagStorage(mbaxid, tagname, tagtype, numco, tagindex ) ! define more tags - tagname = 'u_ph16'//CHAR(0) ! U component of velocity + tagname = 'u_ph16'//C_NULL_CHAR ! U component of velocity ierr = iMOAB_DefineTagStorage(mbaxid, tagname, tagtype, numco, tagindex ) - tagname = 'v_ph16'//CHAR(0) ! V component of velocity + tagname = 'v_ph16'//C_NULL_CHAR ! V component of velocity ierr = iMOAB_DefineTagStorage(mbaxid, tagname, tagtype, numco, tagindex ) if (ierr .ne. 0) then write(logunit,*) subname,' error in defining tags ' @@ -1158,8 +1157,8 @@ subroutine cplcomp_moab_Init(comp) if (MPI_COMM_NULL /= mpicom_old ) then ! it means we are on the component pes (ocean) ! write out the mesh file to disk, in parallel #ifdef MOABDEBUG - outfile = 'wholeOcn.h5m'//CHAR(0) - wopts = 'PARALLEL=WRITE_PART'//CHAR(0) + outfile = 'wholeOcn.h5m'//C_NULL_CHAR + wopts = 'PARALLEL=WRITE_PART'//C_NULL_CHAR ierr = iMOAB_WriteMesh(MPOID, outfile, wopts) if (ierr .ne. 0) then write(logunit,*) subname,' error in writing ocean mesh ' @@ -1168,7 +1167,7 @@ subroutine cplcomp_moab_Init(comp) #endif ! send mesh to coupler - ierr = iMOAB_SendMeshFortran(mpoid, mpicom_join, mpigrp_cplid, id_join, partMethod) + ierr = iMOAB_SendMesh(mpoid, mpicom_join, mpigrp_cplid, id_join, partMethod) if (ierr .ne. 0) then write(logunit,*) subname,' error in sending ocean mesh to coupler ' call shr_sys_abort(subname//' ERROR in sending ocean mesh to coupler ') @@ -1176,14 +1175,14 @@ subroutine cplcomp_moab_Init(comp) ! define here the tag that will be projected back from atmosphere ! TODO where do we want to define this? - tagnameProj = 'a2oTbot_proj'//CHAR(0) + tagnameProj = 'a2oTbot_proj'//C_NULL_CHAR tagtype = 1 ! dense, double numco = 1 ! one value per cell ierr = iMOAB_DefineTagStorage(mpoid, tagnameProj, tagtype, numco, tagindex ) ! define more tags - tagnameProj = 'a2oUbot_proj'//CHAR(0) ! U component of velocity + tagnameProj = 'a2oUbot_proj'//C_NULL_CHAR ! U component of velocity ierr = iMOAB_DefineTagStorage(mpoid, tagnameProj, tagtype, numco, tagindex ) - tagnameProj = 'a2oVbot_proj'//CHAR(0) ! V component of velocity + tagnameProj = 'a2oVbot_proj'//C_NULL_CHAR ! V component of velocity ierr = iMOAB_DefineTagStorage(mpoid, tagnameProj, tagtype, numco, tagindex ) if (ierr .ne. 0) then write(logunit,*) subname,' error in defining tags on ocean comp ' @@ -1192,21 +1191,21 @@ subroutine cplcomp_moab_Init(comp) endif if (MPI_COMM_NULL /= mpicom_new ) then ! we are on the coupler pes - appname = "COUPLE_MPASO"//CHAR(0) + appname = "COUPLE_MPASO"//C_NULL_CHAR ! migrated mesh gets another app id, moab ocean to coupler (mbox) - ierr = iMOAB_RegisterApplicationFortran(trim(appname), mpicom_new, id_join, mboxid) - ierr = iMOAB_ReceiveMeshFortran(mboxid, mpicom_join, mpigrp_old, id_old) + ierr = iMOAB_RegisterApplication(trim(appname), mpicom_new, id_join, mboxid) + ierr = iMOAB_ReceiveMesh(mboxid, mpicom_join, mpigrp_old, id_old) ! define here the tag that will be projected from atmosphere - tagnameProj = 'a2oTbot_proj'//CHAR(0) ! temperature + tagnameProj = 'a2oTbot_proj'//C_NULL_CHAR ! temperature tagtype = 1 ! dense, double numco = 1 ! one value per cell ierr = iMOAB_DefineTagStorage(mboxid, tagnameProj, tagtype, numco, tagindex ) ! define more tags - tagnameProj = 'a2oUbot_proj'//CHAR(0) ! U component of velocity + tagnameProj = 'a2oUbot_proj'//C_NULL_CHAR ! U component of velocity ierr = iMOAB_DefineTagStorage(mboxid, tagnameProj, tagtype, numco, tagindex ) - tagnameProj = 'a2oVbot_proj'//CHAR(0) ! V component of velocity + tagnameProj = 'a2oVbot_proj'//C_NULL_CHAR ! V component of velocity ierr = iMOAB_DefineTagStorage(mboxid, tagnameProj, tagtype, numco, tagindex ) if (ierr .ne. 0) then write(logunit,*) subname,' error in defining tags on ocean coupler ' @@ -1214,8 +1213,8 @@ subroutine cplcomp_moab_Init(comp) endif #ifdef MOABDEBUG ! debug test - outfile = 'recMeshOcn.h5m'//CHAR(0) - wopts = ';PARALLEL=WRITE_PART'//CHAR(0) ! + outfile = 'recMeshOcn.h5m'//C_NULL_CHAR + wopts = ';PARALLEL=WRITE_PART'//C_NULL_CHAR ! ! write out the mesh file to disk ierr = iMOAB_WriteMesh(mboxid, trim(outfile), trim(wopts)) if (ierr .ne. 0) then @@ -1244,47 +1243,47 @@ subroutine cplcomp_moab_Init(comp) #ifdef MOAB_HAVE_ZOLTAN partMethod = 2 ! RCB for point cloud #endif - ierr = iMOAB_SendMeshFortran(mlnid, mpicom_join, mpigrp_cplid, id_join, partMethod) + ierr = iMOAB_SendMesh(mlnid, mpicom_join, mpigrp_cplid, id_join, partMethod) if (ierr .ne. 0) then write(logunit,*) subname,' error in sending land mesh ' call shr_sys_abort(subname//' ERROR in sending land mesh ') endif ! create the receiver on land mesh too: - tagnameProj = 'a2lTbot_proj'//CHAR(0) ! temperature + tagnameProj = 'a2lTbot_proj'//C_NULL_CHAR ! temperature tagtype = 1 ! dense, double numco = 1 ! one value per vertex / entity ierr = iMOAB_DefineTagStorage(mlnid, tagnameProj, tagtype, numco, tagindex ) ! define more tags - tagnameProj = 'a2lUbot_proj'//CHAR(0) ! U component of velocity + tagnameProj = 'a2lUbot_proj'//C_NULL_CHAR ! U component of velocity ierr = iMOAB_DefineTagStorage(mlnid, tagnameProj, tagtype, numco, tagindex ) - tagnameProj = 'a2lVbot_proj'//CHAR(0) ! V component of velocity + tagnameProj = 'a2lVbot_proj'//C_NULL_CHAR ! V component of velocity ierr = iMOAB_DefineTagStorage(mlnid, tagnameProj, tagtype, numco, tagindex ) endif if (MPI_COMM_NULL /= mpicom_new ) then ! we are on the coupler pes - appname = "COUPLE_LAND"//CHAR(0) + appname = "COUPLE_LAND"//C_NULL_CHAR ! migrated mesh gets another app id, moab ocean to coupler (mbox) - ierr = iMOAB_RegisterApplicationFortran(trim(appname), mpicom_new, id_join, mblxid) + ierr = iMOAB_RegisterApplication(trim(appname), mpicom_new, id_join, mblxid) if (ierr .ne. 0) then write(logunit,*) subname,' error in registering coupler land ' call shr_sys_abort(subname//' ERROR in registering coupler land') endif - ierr = iMOAB_ReceiveMeshFortran(mblxid, mpicom_join, mpigrp_old, id_old) + ierr = iMOAB_ReceiveMesh(mblxid, mpicom_join, mpigrp_old, id_old) if (ierr .ne. 0) then write(logunit,*) subname,' error in receiving coupler land mesh' call shr_sys_abort(subname//' ERROR in receiving coupler land mesh') endif ! define here the tag that will be projected from atmosphere - tagnameProj = 'a2lTbot_proj'//CHAR(0) ! temperature + tagnameProj = 'a2lTbot_proj'//C_NULL_CHAR ! temperature tagtype = 1 ! dense, double numco = 1 ! one value per vertex / entity ierr = iMOAB_DefineTagStorage(mblxid, tagnameProj, tagtype, numco, tagindex ) ! define more tags - tagnameProj = 'a2lUbot_proj'//CHAR(0) ! U component of velocity + tagnameProj = 'a2lUbot_proj'//C_NULL_CHAR ! U component of velocity ierr = iMOAB_DefineTagStorage(mblxid, tagnameProj, tagtype, numco, tagindex ) - tagnameProj = 'a2lVbot_proj'//CHAR(0) ! V component of velocity + tagnameProj = 'a2lVbot_proj'//C_NULL_CHAR ! V component of velocity ierr = iMOAB_DefineTagStorage(mblxid, tagnameProj, tagtype, numco, tagindex ) if (ierr .ne. 0) then write(logunit,*) subname,' error in defining tags on land coupler' @@ -1295,7 +1294,7 @@ subroutine cplcomp_moab_Init(comp) if (sameg_al) then !there are no shared entities, but we will set a special partition tag, in order to see the ! partitions ; it will be visible with a Pseudocolor plot in VisIt - tagname='partition'//CHAR(0) + tagname='partition'//C_NULL_CHAR tagtype = 0 ! dense, integer numco = 1 ! one value per cell ierr = iMOAB_DefineTagStorage(mblxid, tagname, tagtype, numco, tagindex ) @@ -1305,8 +1304,8 @@ subroutine cplcomp_moab_Init(comp) ent_type = 0 ! vertex type ierr = iMOAB_SetIntTagStorage ( mblxid, tagname, nverts(1) , ent_type, vgids) endif - outfile = 'recLand.h5m'//CHAR(0) - wopts = ';PARALLEL=WRITE_PART'//CHAR(0) ! + outfile = 'recLand.h5m'//C_NULL_CHAR + wopts = ';PARALLEL=WRITE_PART'//C_NULL_CHAR ! ! write out the mesh file to disk ierr = iMOAB_WriteMesh(mblxid, trim(outfile), trim(wopts)) if (ierr .ne. 0) then @@ -1332,8 +1331,8 @@ subroutine cplcomp_moab_Init(comp) if (MPI_COMM_NULL /= mpicom_old ) then ! it means we are on the component p #ifdef MOABDEBUG - outfile = 'wholeSeaIce.h5m'//CHAR(0) - wopts = 'PARALLEL=WRITE_PART'//CHAR(0) + outfile = 'wholeSeaIce.h5m'//C_NULL_CHAR + wopts = 'PARALLEL=WRITE_PART'//C_NULL_CHAR ierr = iMOAB_WriteMesh(MPSIID, outfile, wopts) if (ierr .ne. 0) then write(logunit,*) subname,' error in writing sea-ice' @@ -1342,7 +1341,7 @@ subroutine cplcomp_moab_Init(comp) #endif ! start copy from ocean code ! send sea ice mesh to coupler - ierr = iMOAB_SendMeshFortran(MPSIID, mpicom_join, mpigrp_cplid, id_join, partMethod) + ierr = iMOAB_SendMesh(MPSIID, mpicom_join, mpigrp_cplid, id_join, partMethod) if (ierr .ne. 0) then write(logunit,*) subname,' error in sending sea ice mesh to coupler ' call shr_sys_abort(subname//' ERROR in sending sea ice mesh to coupler ') @@ -1351,14 +1350,14 @@ subroutine cplcomp_moab_Init(comp) ! ! define here the tag that will be projected back from atmosphere ! ! TODO where do we want to define this? -! tagnameProj = 'a2oTbot_proj'//CHAR(0) +! tagnameProj = 'a2oTbot_proj'//C_NULL_CHAR ! tagtype = 1 ! dense, double ! numco = 1 ! one value per cell ! ierr = iMOAB_DefineTagStorage(mpoid, tagnameProj, tagtype, numco, tagindex ) ! ! define more tags -! tagnameProj = 'a2oUbot_proj'//CHAR(0) ! U component of velocity +! tagnameProj = 'a2oUbot_proj'//C_NULL_CHAR ! U component of velocity ! ierr = iMOAB_DefineTagStorage(mpoid, tagnameProj, tagtype, numco, tagindex ) -! tagnameProj = 'a2oVbot_proj'//CHAR(0) ! V component of velocity +! tagnameProj = 'a2oVbot_proj'//C_NULL_CHAR ! V component of velocity ! ierr = iMOAB_DefineTagStorage(mpoid, tagnameProj, tagtype, numco, tagindex ) ! if (ierr .ne. 0) then ! write(logunit,*) subname,' error in defining tags on ocean comp ' @@ -1367,21 +1366,21 @@ subroutine cplcomp_moab_Init(comp) endif if (MPI_COMM_NULL /= mpicom_new ) then ! we are on the coupler pes - appname = "COUPLE_MPASSI"//CHAR(0) + appname = "COUPLE_MPASSI"//C_NULL_CHAR ! migrated mesh gets another app id, moab moab sea ice to coupler (mbox) - ierr = iMOAB_RegisterApplicationFortran(trim(appname), mpicom_new, id_join, mbixid) - ierr = iMOAB_ReceiveMeshFortran(mbixid, mpicom_join, mpigrp_old, id_old) + ierr = iMOAB_RegisterApplication(trim(appname), mpicom_new, id_join, mbixid) + ierr = iMOAB_ReceiveMesh(mbixid, mpicom_join, mpigrp_old, id_old) ! ! define here the tag that will be projected from atmosphere -! tagnameProj = 'a2oTbot_proj'//CHAR(0) ! temperature +! tagnameProj = 'a2oTbot_proj'//C_NULL_CHAR ! temperature ! tagtype = 1 ! dense, double ! numco = 1 ! one value per cell ! ierr = iMOAB_DefineTagStorage(mboxid, tagnameProj, tagtype, numco, tagindex ) ! ! ! define more tags -! tagnameProj = 'a2oUbot_proj'//CHAR(0) ! U component of velocity +! tagnameProj = 'a2oUbot_proj'//C_NULL_CHAR ! U component of velocity ! ierr = iMOAB_DefineTagStorage(mboxid, tagnameProj, tagtype, numco, tagindex ) -! tagnameProj = 'a2oVbot_proj'//CHAR(0) ! V component of velocity +! tagnameProj = 'a2oVbot_proj'//C_NULL_CHAR ! V component of velocity ! ierr = iMOAB_DefineTagStorage(mboxid, tagnameProj, tagtype, numco, tagindex ) ! if (ierr .ne. 0) then ! write(logunit,*) subname,' error in defining tags on ocean coupler ' @@ -1389,8 +1388,8 @@ subroutine cplcomp_moab_Init(comp) ! endif #ifdef MOABDEBUG ! debug test - outfile = 'recSeaIce.h5m'//CHAR(0) - wopts = ';PARALLEL=WRITE_PART'//CHAR(0) ! + outfile = 'recSeaIce.h5m'//C_NULL_CHAR + wopts = ';PARALLEL=WRITE_PART'//C_NULL_CHAR ! ! write out the mesh file to disk ierr = iMOAB_WriteMesh(mbixid, trim(outfile), trim(wopts)) if (ierr .ne. 0) then diff --git a/driver-moab/main/prep_atm_mod.F90 b/driver-moab/main/prep_atm_mod.F90 index 5e2591761b72..b5815f43000c 100644 --- a/driver-moab/main/prep_atm_mod.F90 +++ b/driver-moab/main/prep_atm_mod.F90 @@ -100,6 +100,8 @@ module prep_atm_mod subroutine prep_atm_init(infodata, ocn_c2_atm, ice_c2_atm, lnd_c2_atm, iac_c2_atm) + use iMOAB, only: iMOAB_ComputeMeshIntersectionOnSphere, iMOAB_RegisterApplication, & + iMOAB_WriteMesh, iMOAB_ComputePointDoFIntersection ! use computedofintx if land is point cloud !--------------------------------------------------------------- ! Description ! Initialize module attribute vectors and mappers @@ -127,8 +129,6 @@ subroutine prep_atm_init(infodata, ocn_c2_atm, ice_c2_atm, lnd_c2_atm, iac_c2_at type(mct_avect), pointer :: a2x_ax character(*), parameter :: subname = '(prep_atm_init)' character(*), parameter :: F00 = "('"//subname//" : ', 4A )" - integer, external :: iMOAB_ComputeMeshIntersectionOnSphere, iMOAB_RegisterApplicationFortran, & - iMOAB_WriteMesh, iMOAB_ComputePointDoFIntersection ! use computedofintx if land is point cloud integer ierr, idintx, rank character*32 :: appname, outfile, wopts, lnum !--------------------------------------------------------------- @@ -191,10 +191,10 @@ subroutine prep_atm_init(infodata, ocn_c2_atm, ice_c2_atm, lnd_c2_atm, iac_c2_at ! Call moab intx only if atm and ocn are init in moab if ((mbaxid .ge. 0) .and. (mboxid .ge. 0)) then - appname = "ATM_OCN_COU"//CHAR(0) + appname = "ATM_OCN_COU"//C_NULL_CHAR ! idintx is a unique number of MOAB app that takes care of intx between ocn and atm mesh idintx = 100*atm(1)%cplcompid + ocn(1)%cplcompid ! something different, to differentiate it - ierr = iMOAB_RegisterApplicationFortran(trim(appname), mpicom_CPLID, idintx, mbintxoa) + ierr = iMOAB_RegisterApplication(trim(appname), mpicom_CPLID, idintx, mbintxoa) if (ierr .ne. 0) then write(logunit,*) subname,' error in registering atm ocn intx' call shr_sys_abort(subname//' ERROR in registering atm ocn intx') @@ -208,11 +208,11 @@ subroutine prep_atm_init(infodata, ocn_c2_atm, ice_c2_atm, lnd_c2_atm, iac_c2_at write(logunit,*) 'iMOAB intersection between atm and ocean with id:', idintx end if #ifdef MOABDEBUG - wopts = CHAR(0) + wopts = C_NULL_CHAR call shr_mpi_commrank( mpicom_CPLID, rank ) if (rank .lt. 5) then write(lnum,"(I0.2)")rank ! - outfile = 'intx'//trim(lnum)// '.h5m' // CHAR(0) + outfile = 'intx'//trim(lnum)// '.h5m' // C_NULL_CHAR ierr = iMOAB_WriteMesh(mbintxoa, outfile, wopts) ! write local intx file if (ierr .ne. 0) then write(logunit,*) subname,' error in writing intx file ' @@ -280,10 +280,10 @@ subroutine prep_atm_init(infodata, ocn_c2_atm, ice_c2_atm, lnd_c2_atm, iac_c2_at 'mapper_Sl2a initialization',esmf_map_flag) if ((mbaxid .ge. 0) .and. (mblxid .ge. 0)) then - appname = "ATM_LND_COU"//CHAR(0) + appname = "ATM_LND_COU"//C_NULL_CHAR ! idintx is a unique number of MOAB app that takes care of intx between lnd and atm mesh idintx = 100*atm(1)%cplcompid + lnd(1)%cplcompid ! something different, to differentiate it - ierr = iMOAB_RegisterApplicationFortran(trim(appname), mpicom_CPLID, idintx, mbintxla) + ierr = iMOAB_RegisterApplication(trim(appname), mpicom_CPLID, idintx, mbintxla) if (ierr .ne. 0) then write(logunit,*) subname,' error in registering atm lnd intx ' call shr_sys_abort(subname//' ERROR in registering atm lnd intx ') @@ -306,11 +306,11 @@ subroutine prep_atm_init(infodata, ocn_c2_atm, ice_c2_atm, lnd_c2_atm, iac_c2_at #ifdef MOABDEBUG ! write intx only if true intx file: if (.not. sameg_al) then - wopts = CHAR(0) + wopts = C_NULL_CHAR call shr_mpi_commrank( mpicom_CPLID, rank ) if (rank .lt. 5) then ! write only a few intx files write(lnum,"(I0.2)")rank ! - outfile = 'intx_la'//trim(lnum)// '.h5m' // CHAR(0) + outfile = 'intx_la'//trim(lnum)// '.h5m' // C_NULL_CHAR ierr = iMOAB_WriteMesh(mbintxla, outfile, wopts) ! write local intx file if (ierr .ne. 0) then write(logunit,*) subname,' error in writing intx file land atm ' @@ -328,6 +328,9 @@ subroutine prep_atm_init(infodata, ocn_c2_atm, ice_c2_atm, lnd_c2_atm, iac_c2_at end subroutine prep_atm_init subroutine prep_atm_ocn_moab(infodata) + + use iMOAB, only: iMOAB_CoverageGraph, iMOAB_ComputeScalarProjectionWeights, & + iMOAB_ComputeCommGraph !--------------------------------------------------------------- ! Description ! After intersection of atm and ocean mesh, correct the communication graph @@ -356,7 +359,6 @@ subroutine prep_atm_ocn_moab(infodata) integer :: typeA, typeB ! type for computing graph; integer :: idintx ! in this case, id of moab intersection between atm and ocn, on coupler pes - integer, external :: iMOAB_CoverageGraphFortran, iMOAB_ComputeScalarProjectionWeights, iMOAB_ComputeCommGraphFortran call seq_infodata_getData(infodata, & atm_present=atm_present, & @@ -376,12 +378,12 @@ subroutine prep_atm_ocn_moab(infodata) ! it happens over joint communicator if (atm_pg_active ) then ! use mhpgid mesh - ierr = iMOAB_CoverageGraphFortran(mpicom_join, mhpgid, mbaxid, mbintxoa, atm_id, id_join, context_id); + ierr = iMOAB_CoverageGraph(mpicom_join, mhpgid, mbaxid, mbintxoa, atm_id, id_join, context_id); if (iamroot_CPLID) then write(logunit,*) 'iMOAB graph atmpg2-intxao context: ', context_id end if else - ierr = iMOAB_CoverageGraphFortran(mpicom_join, mhid, mbaxid, mbintxoa, atm_id, id_join, context_id); + ierr = iMOAB_CoverageGraph(mpicom_join, mhid, mbaxid, mbintxoa, atm_id, id_join, context_id); if (iamroot_CPLID) then write(logunit,*) 'iMOAB graph atmnp4-intxao context: ', context_id end if @@ -392,20 +394,20 @@ subroutine prep_atm_ocn_moab(infodata) endif if ( mbintxoa .ge. 0 ) then - wgtIdef = 'scalar'//CHAR(0) + wgtIdef = 'scalar'//C_NULL_CHAR if (atm_pg_active) then - dm1 = "fv"//CHAR(0) - dofnameATM="GLOBAL_ID"//CHAR(0) + dm1 = "fv"//C_NULL_CHAR + dofnameATM="GLOBAL_ID"//C_NULL_CHAR orderATM = 1 ! fv-fv volumetric = 1 ! maybe volumetric ? else - dm1 = "cgll"//CHAR(0) - dofnameATM="GLOBAL_DOFS"//CHAR(0) + dm1 = "cgll"//C_NULL_CHAR + dofnameATM="GLOBAL_DOFS"//C_NULL_CHAR orderATM = np ! it should be 4 volumetric = 0 endif - dm2 = "fv"//CHAR(0) - dofnameOCN="GLOBAL_ID"//CHAR(0) + dm2 = "fv"//C_NULL_CHAR + dofnameOCN="GLOBAL_ID"//C_NULL_CHAR orderOCN = 1 ! not much arguing fNoBubble = 1 monotonicity = 0 ! @@ -433,7 +435,7 @@ subroutine prep_atm_ocn_moab(infodata) ! this is similar to imoab_phatm_ocn_coupler.cpp test in moab ! int typeA = 2; // point cloud ! int typeB = 1; // quads in coverage set - ! ierr = iMOAB_ComputeCommGraphFortran(cmpPhAtmPID, cplAtmOcnPID, &atmCouComm, &atmPEGroup, &couPEGroup, + ! ierr = iMOAB_ComputeCommGraph(cmpPhAtmPID, cplAtmOcnPID, &atmCouComm, &atmPEGroup, &couPEGroup, ! &typeA, &typeB, &cmpatm, &atmocnid); call seq_comm_getinfo(CPLID ,mpigrp=mpigrp_CPLID) ! second group, the coupler group CPLID is global variable call seq_comm_getinfo(atm_id, mpigrp=mpigrp_old) ! component group pes, from atm id ( also ATMID(1) ) @@ -458,7 +460,7 @@ subroutine prep_atm_ocn_moab(infodata) mphaid, mbintxoa, mpicom_join, mpigrp_old, mpigrp_CPLID, & typeA, typeB, atm_id, idintx end if - ierr = iMOAB_ComputeCommGraphFortran( mphaid, mbintxoa, mpicom_join, mpigrp_old, mpigrp_CPLID, & + ierr = iMOAB_ComputeCommGraph( mphaid, mbintxoa, mpicom_join, mpigrp_old, mpigrp_CPLID, & typeA, typeB, atm_id, idintx) if (ierr .ne. 0) then write(logunit,*) subname,' error in computing graph phys grid - atm/ocn intx ' @@ -470,6 +472,8 @@ subroutine prep_atm_ocn_moab(infodata) end subroutine prep_atm_ocn_moab subroutine prep_atm_lnd_moab(infodata) + + use iMOAB, only: iMOAB_CoverageGraph, iMOAB_ComputeScalarProjectionWeights, iMOAB_ComputeCommGraph !--------------------------------------------------------------- ! Description ! If the land is on the same mesh as atm, we do not need to compute intx @@ -498,8 +502,6 @@ subroutine prep_atm_lnd_moab(infodata) integer :: idintx ! in this case, id of moab intersection between atm and lnd, on coupler pes ! used only for tri-grid case - integer, external :: iMOAB_CoverageGraphFortran, iMOAB_ComputeScalarProjectionWeights, iMOAB_ComputeCommGraphFortran - call seq_infodata_getData(infodata, & atm_present=atm_present, & lnd_present=lnd_present) @@ -517,9 +519,9 @@ subroutine prep_atm_lnd_moab(infodata) context_id = lnd(1)%cplcompid call seq_comm_getinfo(ID_join,mpicom=mpicom_join) if (atm_pg_active ) then ! use mhpgid mesh - ierr = iMOAB_CoverageGraphFortran(mpicom_join, mhpgid, mbaxid, mbintxla, atm_id, id_join, context_id); + ierr = iMOAB_CoverageGraph(mpicom_join, mhpgid, mbaxid, mbintxla, atm_id, id_join, context_id); else - ierr = iMOAB_CoverageGraphFortran(mpicom_join, mhid, mbaxid, mbintxla, atm_id, id_join, context_id); + ierr = iMOAB_CoverageGraph(mpicom_join, mhid, mbaxid, mbintxla, atm_id, id_join, context_id); endif if (ierr .ne. 0) then write(logunit,*) subname,' error in computing coverage graph atm/lnd ' @@ -528,28 +530,28 @@ subroutine prep_atm_lnd_moab(infodata) if (mbintxla .ge. 0 ) then ! weights are computed over coupler pes ! copy from atm - ocn , it is now similar, as land is full mesh, not pc cloud - wgtIdef = 'scalar'//CHAR(0) + wgtIdef = 'scalar'//C_NULL_CHAR if (atm_pg_active) then - dm1 = "fv"//CHAR(0) - dofnameATM="GLOBAL_ID"//CHAR(0) + dm1 = "fv"//C_NULL_CHAR + dofnameATM="GLOBAL_ID"//C_NULL_CHAR orderATM = 1 ! fv-fv volumetric = 1 ! maybe volumetric ? else - dm1 = "cgll"//CHAR(0) - dofnameATM="GLOBAL_DOFS"//CHAR(0) + dm1 = "cgll"//C_NULL_CHAR + dofnameATM="GLOBAL_DOFS"//C_NULL_CHAR orderATM = np ! it should be 4 volumetric = 0 endif - dofnameLND="GLOBAL_ID"//CHAR(0) + dofnameLND="GLOBAL_ID"//C_NULL_CHAR orderLND = 1 ! not much arguing ! is the land mesh explicit or point cloud ? based on sameg_al flag: if (sameg_al) then - dm2 = "pcloud"//CHAR(0) - wgtIdef = 'scalar-pc'//CHAR(0) + dm2 = "pcloud"//C_NULL_CHAR + wgtIdef = 'scalar-pc'//C_NULL_CHAR volumetric = 0 ! TODO: check this , for PC ; for imoab_coupler test, volumetric is 0 else - dm2 = "fv"//CHAR(0) ! land is FV + dm2 = "fv"//C_NULL_CHAR ! land is FV volumetric = 1 endif fNoBubble = 1 @@ -593,7 +595,7 @@ subroutine prep_atm_lnd_moab(infodata) ! data from phys grid directly to atm-lnd intx , for later projection ! context is the same, atm - lnd intx id ! endif - ierr = iMOAB_ComputeCommGraphFortran( mphaid, mbintxla, mpicom_join, mpigrp_old, mpigrp_CPLID, & + ierr = iMOAB_ComputeCommGraph( mphaid, mbintxla, mpicom_join, mpigrp_old, mpigrp_CPLID, & typeA, typeB, atm_id, idintx) if (ierr .ne. 0) then write(logunit,*) subname,' error in computing graph phys grid - atm/lnd intx ' @@ -604,6 +606,9 @@ subroutine prep_atm_lnd_moab(infodata) end subroutine prep_atm_lnd_moab subroutine prep_atm_migrate_moab(infodata) + + use iMOAB, only: iMOAB_SendElementTag, iMOAB_ReceiveElementTag, iMOAB_FreeSenderBuffers, & + iMOAB_ApplyScalarProjectionWeights, iMOAB_WriteMesh !--------------------------------------------------------------- ! Description ! After a2oTbot, a2oUbot, a2oVbot tags were loaded on atm mesh, @@ -627,8 +632,6 @@ subroutine prep_atm_migrate_moab(infodata) character*50 :: outfile, wopts, tagnameProj, lnum integer :: orderOCN, orderATM, volumetric, noConserve, validate - integer, external :: iMOAB_SendElementTagFortran, iMOAB_ReceiveElementTagFortran, iMOAB_FreeSenderBuffers - integer, external :: iMOAB_ApplyScalarProjectionWeights, iMOAB_WriteMesh call seq_infodata_getData(infodata, & atm_present=atm_present, & @@ -647,8 +650,8 @@ subroutine prep_atm_migrate_moab(infodata) ! we should do this only if ocn_present context_id = ocn(1)%cplcompid - wgtIdef = 'scalar'//CHAR(0) - tagNameProj = 'a2oTbot_proj;a2oUbot_proj;a2oVbot_proj;'//CHAR(0) + wgtIdef = 'scalar'//C_NULL_CHAR + tagNameProj = 'a2oTbot_proj;a2oUbot_proj;a2oVbot_proj;'//C_NULL_CHAR num_proj = num_proj + 1 if (atm_present .and. ocn_present) then @@ -659,9 +662,9 @@ subroutine prep_atm_migrate_moab(infodata) ! basically, adjust the migration of the tag we want to project; it was sent initially with ! trivial partitioning, now we need to adjust it for "coverage" mesh ! as always, use nonblocking sends - tagName = 'T_ph;u_ph;v_ph;'//CHAR(0) ! they are defined in initialize_moab_atm_phys in atm_comp_mct + tagName = 'T_ph;u_ph;v_ph;'//C_NULL_CHAR ! they are defined in initialize_moab_atm_phys in atm_comp_mct context_id = 100*atm(1)%cplcompid + ocn(1)%cplcompid !send to atm/ocn intx ! - ierr = iMOAB_SendElementTagFortran(mphaid, tagName, mpicom_join, context_id) + ierr = iMOAB_SendElementTag(mphaid, tagName, mpicom_join, context_id) if (ierr .ne. 0) then write(logunit,*) subname,' error in sending tag from phys atm to ocn atm intx ' call shr_sys_abort(subname//' ERROR in sending tag from phys atm to ocn atm intx') @@ -670,11 +673,11 @@ subroutine prep_atm_migrate_moab(infodata) endif if (mbintxoa .ge. 0 ) then ! we are for sure on coupler pes! - tagName = 'T_ph16;u_ph16;v_ph16;'//CHAR(0) ! they are defined in cplcomp_exchange mod + tagName = 'T_ph16;u_ph16;v_ph16;'//C_NULL_CHAR ! they are defined in cplcomp_exchange mod ! context_id = atm(1)%cplcompid == atm_id above (5) ! we use the same name as spectral case, even thought in pg2 case, the size of tag is 1, not 16 ! in imoab_apg2_ol_coupler.cpp we use at this stage, receiver, the same name as sender, T_ph - ierr = iMOAB_ReceiveElementTagFortran(mbintxoa, tagName, mpicom_join, atm_id) + ierr = iMOAB_ReceiveElementTag(mbintxoa, tagName, mpicom_join, atm_id) if (ierr .ne. 0) then write(logunit,*) subname,' error in receiving tag from phys atm to ocn atm intx ' call shr_sys_abort(subname//' ERROR in receiving tag from phys atm to ocn atm intx') @@ -690,7 +693,7 @@ subroutine prep_atm_migrate_moab(infodata) endif endif else ! original send from spectral elements - tagName = 'a2oTbot;a2oUbot;a2oVbot;'//CHAR(0) ! they are defined in semoab_mod.F90!!! + tagName = 'a2oTbot;a2oUbot;a2oVbot;'//C_NULL_CHAR ! they are defined in semoab_mod.F90!!! ! the separator will be ';' semicolon if (mhid .ge. 0) then ! send because we are on atm pes @@ -699,7 +702,7 @@ subroutine prep_atm_migrate_moab(infodata) ! trivial partitioning, now we need to adjust it for "coverage" mesh ! as always, use nonblocking sends - ierr = iMOAB_SendElementTagFortran(mhid, tagName, mpicom_join, context_id) + ierr = iMOAB_SendElementTag(mhid, tagName, mpicom_join, context_id) if (ierr .ne. 0) then write(logunit,*) subname,' error in sending tag from atm spectral to ocn atm intx ' call shr_sys_abort(subname//' ERROR in sending tag from atm spectral to ocn atm intx') @@ -707,7 +710,7 @@ subroutine prep_atm_migrate_moab(infodata) endif if (mbaxid .ge. 0 ) then ! we are on coupler pes, for sure ! receive on atm on coupler pes, that was redistributed according to coverage - ierr = iMOAB_ReceiveElementTagFortran(mbaxid, tagName, mpicom_join, context_id) + ierr = iMOAB_ReceiveElementTag(mbaxid, tagName, mpicom_join, context_id) if (ierr .ne. 0) then write(logunit,*) subname,' error in receiving tag from atm spectral to ocn atm intx ' call shr_sys_abort(subname//' ERROR in receiving tag from atm spectral to ocn atm intx') @@ -740,8 +743,8 @@ subroutine prep_atm_migrate_moab(infodata) ! we can also write the ocean mesh to file, just to see the projectd tag ! write out the mesh file to disk write(lnum,"(I0.2)")num_proj - outfile = 'ocnCplProj'//trim(lnum)//'.h5m'//CHAR(0) - wopts = ';PARALLEL=WRITE_PART'//CHAR(0) ! + outfile = 'ocnCplProj'//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 write(logunit,*) subname,' error in writing ocn mesh after projection ' @@ -754,12 +757,12 @@ subroutine prep_atm_migrate_moab(infodata) endif ! if atm and ocn ! repeat this for land data, that is already on atm tag - tagNameProj = 'a2lTbot_proj;a2lUbot_proj;a2lVbot_proj;'//CHAR(0) + tagNameProj = 'a2lTbot_proj;a2lUbot_proj;a2lVbot_proj;'//C_NULL_CHAR context_id = lnd(1)%cplcompid if (atm_present .and. lnd_present) then - wgtIdef = 'scalar'//CHAR(0) ! from fv, need to be similar to ocean now + wgtIdef = 'scalar'//C_NULL_CHAR ! from fv, need to be similar to ocean now if (.not. sameg_al) then ! tri-grid case if (atm_pg_active ) then ! use mhpgid mesh @@ -768,10 +771,10 @@ subroutine prep_atm_migrate_moab(infodata) ! basically, adjust the migration of the tag we want to project; it was sent initially with ! original partitioning, now we need to adjust it for "coverage" mesh ! as always, use nonblocking sends - tagName = 'T_ph;u_ph;v_ph;'//CHAR(0) ! they are defined in initialize_moab_atm_phys in atm_comp_mct + tagName = 'T_ph;u_ph;v_ph;'//C_NULL_CHAR ! they are defined in initialize_moab_atm_phys in atm_comp_mct context_id = 100*atm(1)%cplcompid + lnd(1)%cplcompid !send to atm/lnd intx ! ! use computed graph - ierr = iMOAB_SendElementTagFortran(mphaid, tagName, mpicom_join, context_id) + ierr = iMOAB_SendElementTag(mphaid, tagName, mpicom_join, context_id) if (ierr .ne. 0) then write(logunit,*) subname,' error in sending tag from atm to atm land intx ' call shr_sys_abort(subname//' ERROR in sending tag from atm to atm land intx') @@ -780,8 +783,8 @@ subroutine prep_atm_migrate_moab(infodata) endif if (mbaxid .ge. 0 ) then ! we are on coupler pes, for sure ! receive on atm on coupler pes, that was redistributed according to coverage - tagName = 'T_ph;u_ph;v_ph;'//CHAR(0) ! they are defined in initialize_moab_atm_phys - ierr = iMOAB_ReceiveElementTagFortran(mbintxla, tagName, mpicom_join, atm_id) + tagName = 'T_ph;u_ph;v_ph;'//C_NULL_CHAR ! they are defined in initialize_moab_atm_phys + ierr = iMOAB_ReceiveElementTag(mbintxla, tagName, mpicom_join, atm_id) if (ierr .ne. 0) then write(logunit,*) subname,' error in receiving tag from atm to atm land intx ' call shr_sys_abort(subname//' ERROR in receiving tag from atm to atm land intx') @@ -798,7 +801,7 @@ subroutine prep_atm_migrate_moab(infodata) endif endif else ! regular coarse homme mesh if (.not. atm_pg_active) - tagName = 'a2oTbot;a2oUbot;a2oVbot;'//CHAR(0) + tagName = 'a2oTbot;a2oUbot;a2oVbot;'//C_NULL_CHAR ! context_id = lnd(1)%cplcompid ! if (mhid .ge. 0) then ! send because we are on atm pes @@ -806,7 +809,7 @@ subroutine prep_atm_migrate_moab(infodata) ! original partitioning, now we need to adjust it for "coverage" mesh ! as always, use nonblocking sends - ierr = iMOAB_SendElementTagFortran(mhid, tagName, mpicom_join, context_id) + ierr = iMOAB_SendElementTag(mhid, tagName, mpicom_join, context_id) if (ierr .ne. 0) then write(logunit,*) subname,' error in sending tag from atm spectral to atm/lnd intx ' call shr_sys_abort(subname//' ERROR in sending tag from atm spectral to atm/lnd intx ') @@ -815,7 +818,7 @@ subroutine prep_atm_migrate_moab(infodata) endif if (mbaxid .ge. 0 ) then ! we are on coupler pes, for sure ! receive on atm on coupler pes, that was redistributed according to coverage - ierr = iMOAB_ReceiveElementTagFortran(mbaxid, tagName, mpicom_join, context_id) + ierr = iMOAB_ReceiveElementTag(mbaxid, tagName, mpicom_join, context_id) if (ierr .ne. 0) then write(logunit,*) subname,' error in receiving tag from atm spectral to atm/lnd intx ' call shr_sys_abort(subname//' ERROR in receiving tag from atm spectral to atm/lnd intx ') @@ -847,8 +850,8 @@ subroutine prep_atm_migrate_moab(infodata) ! we can also write the ocean mesh to file, just to see the projectd tag ! write out the mesh file to disk write(lnum,"(I0.2)")num_proj - outfile = 'lndCplProj'//trim(lnum)//'.h5m'//CHAR(0) - wopts = ';PARALLEL=WRITE_PART'//CHAR(0) ! + outfile = 'lndCplProj'//trim(lnum)//'.h5m'//C_NULL_CHAR + wopts = ';PARALLEL=WRITE_PART'//C_NULL_CHAR ! ierr = iMOAB_WriteMesh(mblxid, trim(outfile), trim(wopts)) if (ierr .ne. 0) then write(logunit,*) subname,' error in writing mesh on coupler land' @@ -866,7 +869,7 @@ subroutine prep_atm_migrate_moab(infodata) ! original partitioning, now we need to adjust it for "coverage" mesh ! as always, use nonblocking sends - ierr = iMOAB_SendElementTagFortran(mhid, tagName, mpicom_join, context_id) + ierr = iMOAB_SendElementTag(mhid, tagName, mpicom_join, context_id) if (ierr .ne. 0) then write(logunit,*) subname,' error in sending tag for land projection' call shr_sys_abort(subname//' ERROR in sending tag for land projection') @@ -874,7 +877,7 @@ subroutine prep_atm_migrate_moab(infodata) endif if (mbaxid .ge. 0 ) then ! we are on coupler pes, for sure ! receive on atm on coupler pes, that was redistributed according to coverage - ierr = iMOAB_ReceiveElementTagFortran(mbaxid, tagName, mpicom_join, context_id) + ierr = iMOAB_ReceiveElementTag(mbaxid, tagName, mpicom_join, context_id) if (ierr .ne. 0) then write(logunit,*) subname,' error in receiving tag for land projection' call shr_sys_abort(subname//' ERROR in receiving tag for land projection') @@ -896,7 +899,7 @@ subroutine prep_atm_migrate_moab(infodata) ! we could apply weights; need to use the same weight identifier wgtIdef as when we generated it ! hard coded now, it should be a runtime option in the future - wgtIdef = 'scalar-pc'//CHAR(0) + wgtIdef = 'scalar-pc'//C_NULL_CHAR ierr = iMOAB_ApplyScalarProjectionWeights ( mbintxla, wgtIdef, tagName, tagNameProj) if (ierr .ne. 0) then write(logunit,*) subname,' error in applying weights for land projection' @@ -907,8 +910,8 @@ subroutine prep_atm_migrate_moab(infodata) ! we can also write the land mesh to file, just to see the projectd tag ! write out the mesh file to disk write(lnum,"(I0.2)")num_proj - outfile = 'lndCplProj'//trim(lnum)//'.h5m'//CHAR(0) - wopts = ';PARALLEL=WRITE_PART'//CHAR(0) ! + outfile = 'lndCplProj'//trim(lnum)//'.h5m'//C_NULL_CHAR + wopts = ';PARALLEL=WRITE_PART'//C_NULL_CHAR ! ierr = iMOAB_WriteMesh(mblxid, trim(outfile), trim(wopts)) if (ierr .ne. 0) then write(logunit,*) subname,' error in writing land projection' diff --git a/driver-moab/main/prep_lnd_mod.F90 b/driver-moab/main/prep_lnd_mod.F90 index 889794b8c47b..615f225f4a19 100644 --- a/driver-moab/main/prep_lnd_mod.F90 +++ b/driver-moab/main/prep_lnd_mod.F90 @@ -557,6 +557,9 @@ end function prep_lnd_get_mapper_Fg2l ! exposed method to migrate projected tag from coupler pes back to land pes subroutine prep_lnd_migrate_moab(infodata) + + use iMOAB, only: iMOAB_SendElementTag, iMOAB_ReceiveElementTag, iMOAB_FreeSenderBuffers, & + iMOAB_WriteMesh !--------------------------------------------------------------- ! Description ! After a2lTbot_proj, a2lVbot_proj, a2lUbot_proj were computed on lnd mesh on coupler, they need @@ -578,9 +581,6 @@ subroutine prep_lnd_migrate_moab(infodata) character*32 :: outfile, wopts, lnum integer :: orderLND, orderATM, volumetric, noConserve, validate - integer, external :: iMOAB_SendElementTagFortran, iMOAB_ReceiveElementTagFortran, iMOAB_FreeSenderBuffers - integer, external :: iMOAB_WriteMesh - call seq_infodata_getData(infodata, & atm_present=atm_present, & lnd_present=lnd_present) @@ -594,19 +594,19 @@ subroutine prep_lnd_migrate_moab(infodata) call seq_comm_getinfo(ID_join,mpicom=mpicom_join) context_id = -1 ! now send the tag a2oTbot_proj, a2oUbot_proj, a2oVbot_proj from ocn on coupler pes towards original ocean mesh - tagName = 'a2lTbot_proj;a2lUbot_proj;a2lVbot_proj;'//CHAR(0) ! defined in prep_atm_mod.F90!!! + tagName = 'a2lTbot_proj;a2lUbot_proj;a2lVbot_proj;'//C_NULL_CHAR ! defined in prep_atm_mod.F90!!! if (mblxid .ge. 0) then ! send because we are on coupler pes ! basically, use the initial partitioning context_id = lndid1 - ierr = iMOAB_SendElementTagFortran(mblxid, tagName, mpicom_join, context_id) + ierr = iMOAB_SendElementTag(mblxid, tagName, mpicom_join, context_id) endif if (mlnid .ge. 0 ) then ! we are on land pes, for sure ! receive on land pes, a tag that was computed on coupler pes context_id = id_join - ierr = iMOAB_ReceiveElementTagFortran(mlnid, tagName, mpicom_join, context_id) + ierr = iMOAB_ReceiveElementTag(mlnid, tagName, mpicom_join, context_id) !CHECKRC(ierr, "cannot receive tag values") endif @@ -621,8 +621,8 @@ subroutine prep_lnd_migrate_moab(infodata) if (mlnid .ge. 0 ) then ! we are on land pes, for sure number_calls = number_calls + 1 write(lnum,"(I0.2)") number_calls - outfile = 'wholeLND_proj'//trim(lnum)//'.h5m'//CHAR(0) - wopts = ';PARALLEL=WRITE_PART'//CHAR(0) ! + outfile = 'wholeLND_proj'//trim(lnum)//'.h5m'//C_NULL_CHAR + wopts = ';PARALLEL=WRITE_PART'//C_NULL_CHAR ! ierr = iMOAB_WriteMesh(mlnid, trim(outfile), trim(wopts)) endif #endif diff --git a/driver-moab/main/prep_ocn_mod.F90 b/driver-moab/main/prep_ocn_mod.F90 index 8bca224444e7..09e8db738daf 100644 --- a/driver-moab/main/prep_ocn_mod.F90 +++ b/driver-moab/main/prep_ocn_mod.F90 @@ -1513,7 +1513,7 @@ subroutine prep_ocn_migrate_moab(infodata) call seq_comm_getinfo(ID_join,mpicom=mpicom_join) context_id = -1 ! now send the tag a2oTbot_proj, a2oUbot_proj, a2oVbot_proj from ocn on coupler pes towards original ocean mesh - tagName = 'a2oTbot_proj;a2oUbot_proj;a2oVbot_proj;'//CHAR(0) ! defined in prep_atm_mod.F90!!! + tagName = 'a2oTbot_proj;a2oUbot_proj;a2oVbot_proj;'//C_NULL_CHAR ! defined in prep_atm_mod.F90!!! if (mboxid .ge. 0) then ! send because we are on coupler pes @@ -1540,8 +1540,8 @@ subroutine prep_ocn_migrate_moab(infodata) if (mpoid .ge. 0 ) then ! we are on ocean pes, for sure number_proj = number_proj+1 ! count the number of projections write(lnum,"(I0.2)") number_proj - outfile = 'wholeMPAS_proj'//trim(lnum)//'.h5m'//CHAR(0) - wopts = ';PARALLEL=WRITE_PART'//CHAR(0) ! + outfile = 'wholeMPAS_proj'//trim(lnum)//'.h5m'//C_NULL_CHAR + wopts = ';PARALLEL=WRITE_PART'//C_NULL_CHAR ! ierr = iMOAB_WriteMesh(mpoid, trim(outfile), trim(wopts)) !CHECKRC(ierr, "cannot receive tag values") diff --git a/driver-moab/shr/seq_comm_mct.F90 b/driver-moab/shr/seq_comm_mct.F90 index a31682c0d515..87f7bdcf3ef4 100644 --- a/driver-moab/shr/seq_comm_mct.F90 +++ b/driver-moab/shr/seq_comm_mct.F90 @@ -27,6 +27,7 @@ module seq_comm_mct #endif use esmf , only : ESMF_LogKind_Flag, ESMF_LOGKIND_NONE use esmf , only : ESMF_LOGKIND_SINGLE, ESMF_LOGKIND_MULTI + use iMOAB, only: iMOAB_Initialize implicit none @@ -213,7 +214,6 @@ module seq_comm_mct logical :: seq_comm_mct_initialized = .false. ! whether this module has been initialized - integer, external :: iMOAB_InitializeFortran integer, public :: mhid, mhfid, mpoid, mlnid ! homme, homme fine, ocean, land moab ids integer, public :: mhpgid ! iMOAB id for atm pgx grid, on atm pes; created with se and gll grids logical, public :: atm_pg_active = .false. ! whether the atm uses FV mesh or not ; made true if fv_nphys > 0 @@ -606,7 +606,7 @@ subroutine seq_comm_init(global_comm_in, driver_comm_in, nmlfile, drv_comm_id) call mct_world_init(ncomps, DRIVER_COMM, comms, comps) - ierr = iMOAB_InitializeFortran() + ierr = iMOAB_Initialize() if (ierr /= 0) then write(logunit,*) trim(subname),' ERROR initialize MOAB ' endif From 27edb0c0062ddaf70942c7579aa6268ad885dd65 Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Wed, 22 Sep 2021 14:04:55 -0500 Subject: [PATCH 104/467] some iso binding needed also, forgot some conversions --- components/eam/src/cpl/atm_comp_mct.F90 | 3 ++- components/eam/src/cpl/atm_import_export.F90 | 13 +++++++------ components/eam/src/dynamics/se/dyn_comp.F90 | 1 + components/eam/src/dynamics/se/semoab_mod.F90 | 3 ++- components/elm/src/cpl/lnd_comp_mct.F90 | 1 + components/mosart/src/cpl/rof_comp_mct.F90 | 1 + .../mpas-framework/src/framework/mpas_moabmesh.F | 4 ++-- driver-moab/main/cplcomp_exchange_mod.F90 | 1 + driver-moab/main/prep_atm_mod.F90 | 2 ++ driver-moab/main/prep_lnd_mod.F90 | 3 ++- driver-moab/main/prep_ocn_mod.F90 | 9 ++++----- 11 files changed, 25 insertions(+), 16 deletions(-) diff --git a/components/eam/src/cpl/atm_comp_mct.F90 b/components/eam/src/cpl/atm_comp_mct.F90 index 71fc4851ed50..37f027529c73 100644 --- a/components/eam/src/cpl/atm_comp_mct.F90 +++ b/components/eam/src/cpl/atm_comp_mct.F90 @@ -59,6 +59,7 @@ module atm_comp_mct #ifdef HAVE_MOAB use seq_comm_mct , only: mphaid ! atm physics grid id in MOAB, on atm pes + use iso_c_binding #endif ! ! !PUBLIC TYPES: @@ -1032,7 +1033,7 @@ subroutine initialize_moab_atm_phys( cdata_a ) appname="ATM_PHYS"//C_NULL_CHAR ATM_PHYS = 200 + ATMID ! - ierr = iMOAB_RegisterApplicationFortran(appname, mpicom_atm, ATM_PHYS, mphaid) + ierr = iMOAB_RegisterApplication(appname, mpicom_atm, ATM_PHYS, mphaid) if (ierr > 0 ) & call endrun('Error: cannot register moab app for atm physics') if(masterproc) then diff --git a/components/eam/src/cpl/atm_import_export.F90 b/components/eam/src/cpl/atm_import_export.F90 index 09d7752508f0..ba277eb525af 100644 --- a/components/eam/src/cpl/atm_import_export.F90 +++ b/components/eam/src/cpl/atm_import_export.F90 @@ -307,6 +307,8 @@ subroutine cam_moab_phys_export(cam_out) use seq_comm_mct, only: mphaid ! imoab pid for atm physics use seq_comm_mct, only : num_moab_exports ! use cam_abortutils , only: endrun + use iMOAB, only: iMOAB_WriteMesh, iMOAB_SetDoubleTagStorage + use iso_c_binding ! ! Arguments ! @@ -317,7 +319,6 @@ subroutine cam_moab_phys_export(cam_out) character*100 outfile, wopts, tagname, lnum integer ierr, c, nlcols, ig, i, ncols - integer , external :: iMOAB_WriteMesh, iMOAB_SetDoubleTagStorage ! load temp, u, and v on atm phys moab mesh, that is @@ -340,18 +341,18 @@ subroutine cam_moab_phys_export(cam_out) enddo enddo - tagname='T_ph'//CHAR(0) + tagname='T_ph'//C_NULL_CHAR ent_type = 0 ! vertex type ierr = iMOAB_SetDoubleTagStorage ( mphaid, tagname, nlcols , ent_type, tbot) - tagname ='u_ph'//CHAR(0) + tagname ='u_ph'//C_NULL_CHAR ierr = iMOAB_SetDoubleTagStorage ( mphaid, tagname, nlcols , ent_type, ubot) - tagname ='v_ph'//CHAR(0) + tagname ='v_ph'//C_NULL_CHAR ierr = iMOAB_SetDoubleTagStorage ( mphaid, tagname, nlcols , ent_type, vbot) #ifdef MOABDEBUG num_moab_exports = num_moab_exports +1 write(lnum,"(I0.2)")num_moab_exports - outfile = 'AtmPhys_'//trim(lnum)//'.h5m'//CHAR(0) - wopts = 'PARALLEL=WRITE_PART'//CHAR(0) + outfile = 'AtmPhys_'//trim(lnum)//'.h5m'//C_NULL_CHAR + wopts = 'PARALLEL=WRITE_PART'//C_NULL_CHAR ierr = iMOAB_WriteMesh(mphaid, outfile, wopts) if (ierr > 0 ) & call endrun('Error: fail to write the atm phys mesh file with data') diff --git a/components/eam/src/dynamics/se/dyn_comp.F90 b/components/eam/src/dynamics/se/dyn_comp.F90 index 7996f3ae4a5d..04e2c4eb8ba9 100644 --- a/components/eam/src/dynamics/se/dyn_comp.F90 +++ b/components/eam/src/dynamics/se/dyn_comp.F90 @@ -108,6 +108,7 @@ subroutine dyn_init1(fh, NLFileName, dyn_in, dyn_out) use seq_comm_mct, only: mhpgid ! id of pgx moab application use prim_driver_base, only: prim_init_moab_mesh ! insertion point for MOAB; after phys grid init use iMOAB, only : iMOAB_RegisterApplication + use iso_c_binding #endif ! PARAMETERS: diff --git a/components/eam/src/dynamics/se/semoab_mod.F90 b/components/eam/src/dynamics/se/semoab_mod.F90 index 78d0566b4e7d..792b9b394bed 100644 --- a/components/eam/src/dynamics/se/semoab_mod.F90 +++ b/components/eam/src/dynamics/se/semoab_mod.F90 @@ -5,6 +5,7 @@ module semoab_mod #ifdef HAVE_MOAB + use iso_c_binding use kinds, only : real_kind, iulog, long_kind, int_kind ! use edge_mod, only : ghostbuffertr_t, initghostbufferTR, freeghostbuffertr, & ! ghostVpack, ghostVunpack, edgebuffer_t, initEdgebuffer @@ -812,11 +813,11 @@ end subroutine create_moab_meshes subroutine moab_export_data(elem) + use iMOAB, only: iMOAB_GetMeshInfo, iMOAB_SetDoubleTagStorage, iMOAB_WriteMesh type(element_t), pointer :: elem(:) integer num_elem, ierr integer nvert(3), nvise(3), nbl(3), nsurf(3), nvisBC(3) - integer, external :: iMOAB_GetMeshInfo, iMOAB_SetDoubleTagStorage, iMOAB_WriteMesh integer :: size_tag_array, nvalperelem, ie, i, j, je, ix, ent_type, idx real(kind=real_kind), allocatable :: valuesTag(:) diff --git a/components/elm/src/cpl/lnd_comp_mct.F90 b/components/elm/src/cpl/lnd_comp_mct.F90 index 4bf3db34c783..e998963a8aa8 100644 --- a/components/elm/src/cpl/lnd_comp_mct.F90 +++ b/components/elm/src/cpl/lnd_comp_mct.F90 @@ -12,6 +12,7 @@ module lnd_comp_mct use mct_mod , only : mct_avect, mct_gsmap use decompmod , only : bounds_type, ldecomp use lnd_import_export + use iso_c_binding ! ! !public member functions: implicit none diff --git a/components/mosart/src/cpl/rof_comp_mct.F90 b/components/mosart/src/cpl/rof_comp_mct.F90 index 993775bb2791..5ebc31cc805b 100644 --- a/components/mosart/src/cpl/rof_comp_mct.F90 +++ b/components/mosart/src/cpl/rof_comp_mct.F90 @@ -53,6 +53,7 @@ module rof_comp_mct use ESMF #ifdef HAVE_MOAB use seq_comm_mct, only : mrofid ! id of moab rof app + use iso_c_binding #endif ! ! PUBLIC MEMBER FUNCTIONS: diff --git a/components/mpas-framework/src/framework/mpas_moabmesh.F b/components/mpas-framework/src/framework/mpas_moabmesh.F index 1e3832e316e2..53c598c3ebba 100644 --- a/components/mpas-framework/src/framework/mpas_moabmesh.F +++ b/components/mpas-framework/src/framework/mpas_moabmesh.F @@ -25,7 +25,7 @@ SUBROUTINE errorout(ierr, message) end subroutine subroutine mpas_moab_instance(domain, ext_comp_id, pidmoab) - use iMOAB, only : iMOAB_RegisterApplicationFortran, & + use iMOAB, only : iMOAB_RegisterApplication, & iMOAB_CreateVertices, iMOAB_CreateElements, & iMOAB_ResolveSharedEntities, iMOAB_DetermineGhostEntities, & iMOAB_DefineTagStorage, iMOAB_SetIntTagStorage , & @@ -61,7 +61,7 @@ subroutine mpas_moab_instance(domain, ext_comp_id, pidmoab) c_comm = domain % dminfo % comm write(lnum,"(I0.2)")ext_comp_id appname = 'MPAS_MB_'//trim(lnum)//C_NULL_CHAR - ierr = iMOAB_RegisterApplicationFortran(appname, c_comm, ext_comp_id, pid) + ierr = iMOAB_RegisterApplication(appname, c_comm, ext_comp_id, pid) pidmoab = pid ! this is exported, need for send to work call errorout(ierr, 'fail to register MPAS_MOAB mesh') proc_id = domain % dminfo % my_proc_id diff --git a/driver-moab/main/cplcomp_exchange_mod.F90 b/driver-moab/main/cplcomp_exchange_mod.F90 index f99016e40c94..0fb556c59427 100644 --- a/driver-moab/main/cplcomp_exchange_mod.F90 +++ b/driver-moab/main/cplcomp_exchange_mod.F90 @@ -22,6 +22,7 @@ module cplcomp_exchange_mod use seq_comm_mct, only : MPSIID, mbixid ! sea-ice on comp pes and on coupler pes use shr_mpi_mod, only: shr_mpi_max use dimensions_mod, only : np ! for atmosphere + use iso_c_binding implicit none private ! except diff --git a/driver-moab/main/prep_atm_mod.F90 b/driver-moab/main/prep_atm_mod.F90 index b5815f43000c..b48d1b335d27 100644 --- a/driver-moab/main/prep_atm_mod.F90 +++ b/driver-moab/main/prep_atm_mod.F90 @@ -31,6 +31,8 @@ module prep_atm_mod use seq_comm_mct, only : seq_comm_getinfo => seq_comm_setptrs use dimensions_mod, only : np ! for atmosphere + use iso_c_binding + implicit none save diff --git a/driver-moab/main/prep_lnd_mod.F90 b/driver-moab/main/prep_lnd_mod.F90 index 615f225f4a19..e5216c5e81b3 100644 --- a/driver-moab/main/prep_lnd_mod.F90 +++ b/driver-moab/main/prep_lnd_mod.F90 @@ -22,6 +22,7 @@ module prep_lnd_mod use component_type_mod, only: component_get_x2c_cx, component_get_c2x_cx use component_type_mod, only: lnd, atm, rof, glc use map_glc2lnd_mod , only: map_glc2lnd_ec + use iso_c_binding implicit none save @@ -579,7 +580,7 @@ subroutine prep_lnd_migrate_moab(infodata) character*32 :: dm1, dm2 character*50 :: tagName character*32 :: outfile, wopts, lnum - integer :: orderLND, orderATM, volumetric, noConserve, validate + integer :: orderLND, orderATM, volumetric, noConserve, validate call seq_infodata_getData(infodata, & atm_present=atm_present, & diff --git a/driver-moab/main/prep_ocn_mod.F90 b/driver-moab/main/prep_ocn_mod.F90 index 09e8db738daf..168c35567c0b 100644 --- a/driver-moab/main/prep_ocn_mod.F90 +++ b/driver-moab/main/prep_ocn_mod.F90 @@ -24,6 +24,7 @@ module prep_ocn_mod use perf_mod use component_type_mod, only: component_get_x2c_cx, component_get_c2x_cx use component_type_mod, only: ocn, atm, ice, rof, wav, glc + use iso_c_binding implicit none save @@ -1475,6 +1476,7 @@ end function prep_ocn_get_mapper_Sw2o ! exposed method to migrate projected tag from coupler pes to ocean pes subroutine prep_ocn_migrate_moab(infodata) + use iMOAB , only: iMOAB_SendElementTag, iMOAB_ReceiveElementTag, iMOAB_FreeSenderBuffers, iMOAB_WriteMesh !--------------------------------------------------------------- ! Description ! After a2oTbot_proj, a2oVbot_proj, a2oUbot_proj were computed on ocn mesh on coupler, they need @@ -1497,9 +1499,6 @@ subroutine prep_ocn_migrate_moab(infodata) character*32 :: outfile, wopts, lnum integer :: orderOCN, orderATM, volumetric, noConserve, validate - integer, external :: iMOAB_SendElementTagFortran, iMOAB_ReceiveElementTagFortran, iMOAB_FreeSenderBuffers - integer, external :: iMOAB_WriteMesh - call seq_infodata_getData(infodata, & atm_present=atm_present, & ocn_present=ocn_present) @@ -1519,13 +1518,13 @@ subroutine prep_ocn_migrate_moab(infodata) ! basically, use the initial partitioning context_id = ocnid1 - ierr = iMOAB_SendElementTagFortran(mboxid, tagName, mpicom_join, context_id) + ierr = iMOAB_SendElementTag(mboxid, tagName, mpicom_join, context_id) endif if (mpoid .ge. 0 ) then ! we are on ocean pes, for sure ! receive on ocean pes, a tag that was computed on coupler pes context_id = id_join - ierr = iMOAB_ReceiveElementTagFortran(mpoid, tagName, mpicom_join, context_id) + ierr = iMOAB_ReceiveElementTag(mpoid, tagName, mpicom_join, context_id) !CHECKRC(ierr, "cannot receive tag values") endif From 2162c694df462f7d6c5797b2c5ecf4ebe88d194d Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Wed, 17 Nov 2021 13:49:59 -0600 Subject: [PATCH 105/467] change in cime to include moab better --- cime | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/cime b/cime index 7653760bc260..43ea3fc77bf5 160000 --- a/cime +++ b/cime @@ -1 +1 @@ -Subproject commit 7653760bc260f0e747e3b2f4c22b1199b7155104 +Subproject commit 43ea3fc77bf57a5428db8330ea551dfc302161a6 From 3a7714061d55bb569a617184c21ef08c08b56b79 Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Wed, 17 Nov 2021 14:02:03 -0600 Subject: [PATCH 106/467] Revert "change in cime to include moab better" This reverts commit 2162c694df462f7d6c5797b2c5ecf4ebe88d194d. --- cime | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/cime b/cime index 43ea3fc77bf5..7653760bc260 160000 --- a/cime +++ b/cime @@ -1 +1 @@ -Subproject commit 43ea3fc77bf57a5428db8330ea551dfc302161a6 +Subproject commit 7653760bc260f0e747e3b2f4c22b1199b7155104 From 1c9b9c392aab036344e3e3204da5227d2d01bd43 Mon Sep 17 00:00:00 2001 From: Jason Sarich Date: Wed, 17 Nov 2021 16:35:59 -0600 Subject: [PATCH 107/467] update moab driver branch to use newer version of cime --- .gitmodules | 2 +- cime | 2 +- cime_config/allactive/config_compsets.xml | 158 ++--- cime_config/config_grids.xml | 559 ++++-------------- cime_config/machines/config_compilers.xml | 6 +- cime_config/machines/config_machines.xml | 9 + components/cmake/common_setup.cmake | 5 +- driver-mct/cime_config/config_component.xml | 9 - .../namelist_definition_modelio.xml | 1 + .../namelist_definition_modelio.xml | 1 + 10 files changed, 163 insertions(+), 589 deletions(-) diff --git a/.gitmodules b/.gitmodules index a89beb76feaa..fd7820c2a127 100644 --- a/.gitmodules +++ b/.gitmodules @@ -31,7 +31,7 @@ [submodule "cime"] path = cime url = git@github.com:ESMCI/cime.git - branch = master + branch = sarich/allow-moab-driver [submodule "externals/YAKL"] path = externals/YAKL url = git@github.com:mrnorman/YAKL.git diff --git a/cime b/cime index 7653760bc260..b8cef1061de6 160000 --- a/cime +++ b/cime @@ -1 +1 @@ -Subproject commit 7653760bc260f0e747e3b2f4c22b1199b7155104 +Subproject commit b8cef1061de61ffea2a70d972cb5d47d049b50b0 diff --git a/cime_config/allactive/config_compsets.xml b/cime_config/allactive/config_compsets.xml index a53494e74d97..fece8e1e010a 100644 --- a/cime_config/allactive/config_compsets.xml +++ b/cime_config/allactive/config_compsets.xml @@ -40,23 +40,29 @@ - A_WCYCL1850S_CMIP6 + WCYCL1850 1850SOI_EAM%CMIP6_ELM%SPBC_MPASSI_MPASO_MOSART_SGLC_SWAV - WCYCL1850 - 1850SOI_EAM%CMIP6_ELM%SPBC_MPASSI_MPASO_MOSART_SGLC_SWAV + WCYCL1850-1pctCO2 + 1850SOI_EAM%CMIP6-1pctCO2_ELM%SPBC_MPASSI_MPASO_MOSART_SGLC_SWAV - WCYCL1950 - 1950SOI_EAM%CMIP6_ELM%SPBC_MPASSI_MPASO_MOSART_SGLC_SWAV + WCYCL1850-4xCO2 + 1850SOI_EAM%CMIP6-4xCO2_ELM%SPBC_MPASSI_MPASO_MOSART_SGLC_SWAV + - A_WCYCL20TRS_CMIP6 - 20TRSOI_EAM%CMIP6_ELM%SPBC_MPASSI_MPASO_MOSART_SGLC_SWAV + WCYCL1850NS + 1850_EAM%CMIP6_ELM%SPBC_MPASSI_MPASO_MOSART_SGLC_SWAV + + + + WCYCL1950 + 1950SOI_EAM%CMIP6_ELM%SPBC_MPASSI_MPASO_MOSART_SGLC_SWAV @@ -65,7 +71,7 @@ - A_WCYCLSSP585_CMIP6 + WCYCLSSP585 SSP585SOI_EAM%CMIP6_ELM%SPBC_MPASSI_MPASO_MOSART_SGLC_SWAV @@ -81,83 +87,15 @@ 20TRSOI_EAM%AR5sf_ELM%SPBC_MPASSI_MPASO_MOSART_SGLC_SWAV - - A_WCYCL2000 - 2000_EAM%AV1C-L_ELM%SPBC_MPASSI_MPASO_MOSART_SGLC_SWAV - - - - A_WCYCL2000S - 2000SOI_EAM%AV1C-L_ELM%SPBC_MPASSI_MPASO_MOSART_SGLC_SWAV - - - - A_WCYCL1850 - 1850_EAM%AV1C-L_ELM%SPBC_MPASSI_MPASO_MOSART_SGLC_SWAV - - - - A_WCYCL1850S - 1850SOI_EAM%AV1C-L_ELM%SPBC_MPASSI_MPASO_MOSART_SGLC_SWAV - - - - A_WCYCL20TR - 20TR_EAM%AV1C-L_ELM%SPBC_MPASSI_MPASO_MOSART_SGLC_SWAV - - - - A_WCYCL20TRS - 20TRSOI_EAM%AV1C-L_ELM%SPBC_MPASSI_MPASO_MOSART_SGLC_SWAV - - - - A_CRYO - 2000_EAM%AV1C-L_ELM%SPBC_MPASSI_MPASO_MOSART_MALI_SWAV - - - - - - A_WCYCL2000_H01A - 2000_EAM%AV1C-H01A_ELM%SPBC_MPASSI_MPASO_MOSART_SGLC_SWAV - - - - A_WCYCL2000_H01AS - 2000SOI_EAM%AV1C-H01A_ELM%SPBC_MPASSI_MPASO_MOSART_SGLC_SWAV - - - - A_WCYCL1850_H01A - 1850_EAM%AV1C-H01A_ELM%SPBC_MPASSI_MPASO_MOSART_SGLC_SWAV - - - - A_WCYCL1850_H01AS - 1850SOI_EAM%AV1C-H01A_ELM%SPBC_MPASSI_MPASO_MOSART_SGLC_SWAV - - - - - A_WCYCL20TR_H01A - 20TR_EAM%AV1C-H01A_ELM%SPBC_MPASSI_MPASO_MOSART_SGLC_SWAV - - - - A_WCYCL20TR_H01AS - 20TRSOI_EAM%AV1C-H01A_ELM%SPBC_MPASSI_MPASO_MOSART_SGLC_SWAV - - - BGCEXP_BCRC_CNPRDCTC_1850 - 1850_EAM%CMIP6_ELM%CNPRDCTCBC_MPASSI%BGC_MPASO%OIECOOIDMS_MOSART_SGLC_SWAV_BGC%BCRC + BGCEXP_CNTL_CNPRDCTC_1850 + 1850_EAM%CMIP6_ELM%CNPRDCTCBC_MPASSI%BGC_MPASO_MOSART_SGLC_SWAV_BGC%BCRC - BGCEXP_BCRC_CNPRDCTC_1850S + BGCEXP_CNTL_CNPRDCTC_1850S 1850SOI_EAM%CMIP6_ELM%CNPRDCTCBC_MPASSI_MPASO_MOSART_SGLC_SWAV_BGC%BCRC @@ -242,12 +180,12 @@ - BGCEXP_BCRC_CNPECACNT_1850 - 1850_EAM%CMIP6_ELM%CNPECACNTBC_MPASSI%BGC_MPASO%OIECOOIDMS_MOSART_SGLC_SWAV_BGC%BCRC + BGCEXP_CNTL_CNPECACNT_1850 + 1850_EAM%CMIP6_ELM%CNPECACNTBC_MPASSI%BGC_MPASO_MOSART_SGLC_SWAV_BGC%BCRC - BGCEXP_BCRC_CNPECACNT_1850S + BGCEXP_CNTL_CNPECACNT_1850S 1850SOI_EAM%CMIP6_ELM%CNPECACNTBC_MPASSI_MPASO_MOSART_SGLC_SWAV_BGC%BCRC @@ -316,31 +254,37 @@ 20TR_EAM%CMIP6_ELM%CNPECACNTBC_MPASSI%BGC_MPASO%OIECOOIDMS_MOSART_SGLC_SWAV_BGC%BDRD - + + BGCEXP_BDRD_CNPECACNT_SSP585_CMIP6 + SSP585_EAM%CMIP6_ELM%CNPECACNTBC_MPASSI%BGC_MPASO%OIECOOIDMS_MOSART_SGLC_SWAV_BGC%BDRD + - CRYO1850 - 1850SOI_EAM%CMIP6_ELM%SPBC_MPASSI%DIB_MPASO%IBISMF_MOSART_SGLC_SWAV + BGCEXP_BDRD_CNPECACNT_20TRS + 20TRSOI_EAM%CMIP6_ELM%CNPECACNTBC_MPASSI_MPASO_MOSART_SGLC_SWAV_BGC%BDRD - A_WCYCL1850-DIB - 1850_EAM%AV1C-L_ELM%SPBC_MPASSI%DIB_MPASO%IB_MOSART_SGLC_SWAV + BGCEXP_BDRD_CNPECACNT_SSP585_CMIP6S + SSP585SOI_EAM%CMIP6_ELM%CNPECACNTBC_MPASSI_MPASO_MOSART_SGLC_SWAV_BGC%BDRD + + + - A_WCYCL1850-DIB-ISMF - 1850_EAM%AV1C-L_ELM%SPBC_MPASSI%DIB_MPASO%IBISMF_MOSART_SGLC_SWAV + CRYO1850 + 1850SOI_EAM%CMIP6_ELM%SPBC_MPASSI%DIB_MPASO%IBISMF_MOSART_SGLC_SWAV - A_WCYCL1850-DIB_CMIP6 - 1850_EAM%CMIP6_ELM%SPBC_MPASSI%DIB_MPASO%IB_MOSART_SGLC_SWAV + CRYO1850-4xCO2 + 1850SOI_EAM%CMIP6-4xCO2_ELM%SPBC_MPASSI%DIB_MPASO%IBISMF_MOSART_SGLC_SWAV - A_WCYCL1850-DIB-ISMF_CMIP6 - 1850_EAM%CMIP6_ELM%SPBC_MPASSI%DIB_MPASO%IBISMF_MOSART_SGLC_SWAV + CRYO1950 + 1950SOI_EAM%CMIP6_ELM%SPBC_MPASSI%DIB_MPASO%IBISMF_MOSART_SGLC_SWAV @@ -358,38 +302,16 @@ SSP585SOI_EAM%CMIP6_ELM%CNPECACNTBC_MPASSI_MPASO_MOSART_SGLC_SWAV_BGC%BDRD - - - A_WCYCL1850_v0atm - 1850_EAM_ELM%SP_MPASSI_MPASO_MOSART_SGLC_SWAV - - - - A_WCYCL2000_v0atm - 2000_EAM_ELM%SP_MPASSI_MPASO_MOSART_SGLC_SWAVi - - - - A_WCYCL1850S_v0atm - 1850SOI_EAM_ELM%SP_MPASSI_MPASO_MOSART_SGLC_SWAV - - - - A_WCYCL2000S_v0atm - 2000SOI_EAM_ELM%SP_MPASSI_MPASO_MOSART_SGLC_SWAVi - - - - A_BG1850CN + BG1850CN 1850_EAM_ELM%CN_MPASSI_MPASO_MOSART_MALI%SIA_SWAV - A_BGWCYCL1850 - 1850_EAM%AV1C-L_ELM%SPBC_MPASSI_MPASO_MOSART_MALI%STATIC_SWAV + BGWCYCL1850 + 1850_EAM%CMIP6_ELM%SPBC_MPASSI_MPASO_MOSART_MALI%STATIC_SWAV diff --git a/cime_config/config_grids.xml b/cime_config/config_grids.xml index 82e900271235..b80dd73752ed 100755 --- a/cime_config/config_grids.xml +++ b/cime_config/config_grids.xml @@ -250,36 +250,6 @@ gx1v6 - - T62 - T62 - mpas120 - rx1 - null - null - mpas120 - - - - T62 - T62 - mpasgx1 - rx1 - null - null - mpasgx1 - - - - T62 - T62 - oEC60to30 - rx1 - null - null - oEC60to30 - - T62 T62 @@ -290,16 +260,6 @@ oEC60to30v3 - - T62 - T62 - oEC60to30wLI - rx1 - null - null - oEC60to30wLI - - T62 T62 @@ -320,26 +280,6 @@ ECwISC30to60E1r2 - - T62 - T62 - oRRS30to10 - rx1 - null - null - oRRS30to10 - - - - T62 - T62 - oRRS30to10wLI - rx1 - null - null - oRRS30to10wLI - - T62 T62 @@ -360,16 +300,6 @@ oRRS30to10v3wLI - - T62 - T62 - oRRS18to6 - rx1 - null - null - oRRS18to6 - - T62 T62 @@ -592,16 +522,6 @@ gx1v6 - - 0.9x1.25 - 0.9x1.25 - mpas120 - r05 - null - null - mpas120 - - 0.9x1.25 0.9x1.25 @@ -824,26 +744,6 @@ gx1v6 - - ne30np4 - ne30np4 - mpas120 - r05 - null - null - mpas120 - - - - ne30np4 - ne30np4 - mpas120 - r05 - mpas.gis20km - null - mpas120 - - ne30np4 1.9x2.5 @@ -884,16 +784,6 @@ gx1v6 - - ne120np4 - ne120np4 - oRRS18to6 - r0125 - null - null - oRRS18to6 - - ne120np4 ne120np4 @@ -954,7 +844,7 @@ oQU480 - + ne4np4.pg2 ne4np4.pg2 oQU480 @@ -1144,16 +1034,6 @@ oQU240 - - ne16np4.pg2 - r05 - oQU240 - r05 - null - null - oQU240 - - ne30np4 ne30np4 @@ -1397,7 +1277,7 @@ oRRS18to6v3 - + ne120np4.pg2 r0125 oRRS18to6v3 @@ -1477,6 +1357,16 @@ oEC60to30v3 + + ne120np4.pg2 + r05 + EC30to60E2r2 + r05 + null + null + EC30to60E2r2 + + ne240np4 ne240np4 @@ -1547,6 +1437,16 @@ oRRS18to6v3 + + ne1024np4.pg2 + ne1024np4.pg2 + oRRS18to6v3 + r0125 + null + null + oRRS18to6v3 + + ne1024np4 360x720cru @@ -1599,6 +1499,36 @@ oEC60to30v3 + + ne30np4.pg2 + ne30np4.pg2 + oEC60to30v3 + r05 + mpas.gis1to10km + null + oEC60to30v3 + + + + ne30np4.pg2 + r0125 + EC30to60E2r2 + r0125 + mpas.gis1to10km + null + EC30to60E2r2 + + + + ne120np4.pg2 + r0125 + EC30to60E2r2 + r0125 + mpas.gis1to10km + null + EC30to60E2r2 + + 0.9x1.25 0.9x1.25 @@ -1619,28 +1549,6 @@ gx1v6 - - - - T62 - T62 - mpas120 - rx1 - mpas.gis20km - null - mpas120 - - - - 0.9x1.25 - 0.9x1.25 - oEC60to30 - r05 - mpas.ais20km - null - oEC60to30 - - @@ -1835,16 +1743,6 @@ oQU120 - - ne30np4 - ne30np4 - oEC60to30 - r05 - null - null - oEC60to30 - - ne30np4 ne30np4 @@ -1855,16 +1753,6 @@ oEC60to30v3 - - ne30np4 - ne30np4 - oEC60to30wLI - r05 - null - null - oEC60to30wLI - - ne30np4 ne30np4 @@ -2017,26 +1905,6 @@ oEC60to30v3 - - ne30np4 - ne30np4 - oRRS30to10 - r05 - null - null - oRRS30to10 - - - - ne30np4 - ne30np4 - oRRS30to10wLI - r05 - null - null - oRRS30to10wLI - - ne30np4 ne30np4 @@ -2292,21 +2160,15 @@ 96 $DIN_LOC_ROOT/share/domains/domain.lnd.T62_gx1v6.090320.nc $DIN_LOC_ROOT/share/domains/domain.lnd.T62_gx3v7.090911.nc - $DIN_LOC_ROOT/share/domains/domain.lnd.T62_mpasgx1.150903.nc $DIN_LOC_ROOT/share/domains/domain.lnd.T62_oQU480.151209.nc $DIN_LOC_ROOT/share/domains/domain.lnd.T62_oQU240.151209.nc $DIN_LOC_ROOT/share/domains/domain.lnd.T62_oQU240wLI_mask.160929.nc $DIN_LOC_ROOT/share/domains/domain.lnd.T62_oQU120.151209.nc - $DIN_LOC_ROOT/share/domains/domain.lnd.T62_oEC60to30.150616.nc $DIN_LOC_ROOT/share/domains/domain.lnd.T62_oEC60to30v3.161222.nc - $DIN_LOC_ROOT/share/domains/domain.lnd.T62_oEC60to30wLI_mask.160830.nc $DIN_LOC_ROOT/share/domains/domain.lnd.T62_oEC60to30v3wLI_mask.170328.nc $DIN_LOC_ROOT/share/domains/domain.lnd.T62_ECwISC30to60E1r2.200410.nc - $DIN_LOC_ROOT/share/domains/domain.lnd.T62_oRRS30to10.150722.nc - $DIN_LOC_ROOT/share/domains/domain.lnd.T62_oRRS30to10wLI_mask.171109.nc $DIN_LOC_ROOT/share/domains/domain.lnd.T62_oRRS30to10v3.171129.nc $DIN_LOC_ROOT/share/domains/domain.lnd.T62_oRRS30to10v3wLI_mask.171109.nc - $DIN_LOC_ROOT/share/domains/domain.lnd.T62_oRRS18to6.160831.nc $DIN_LOC_ROOT/share/domains/domain.lnd.T62_oRRS18to6v3.170111.nc $DIN_LOC_ROOT/share/domains/domain.lnd.T62_oRRS15to5.150722.nc $DIN_LOC_ROOT/share/domains/domain.lnd.T62_oARRM60to10.180716.nc @@ -2423,24 +2285,16 @@ 1 $DIN_LOC_ROOT/share/domains/domain.lnd.ne30np4_gx1v6.110905.nc $DIN_LOC_ROOT/share/domains/domain.lnd.ne30np4_oQU120.160401.nc - $DIN_LOC_ROOT/share/domains/domain.lnd.ne30np4_oEC60to30.20151214.nc $DIN_LOC_ROOT/share/domains/domain.lnd.ne30np4_oEC60to30v3.161222.nc - $DIN_LOC_ROOT/share/domains/domain.lnd.ne30np4_oEC60to30wLI_mask.160915.nc $DIN_LOC_ROOT/share/domains/domain.lnd.ne30np4_oEC60to30v3wLI_mask.170802.nc $DIN_LOC_ROOT/share/domains/domain.lnd.ne30np4_ECwISC30to60E1r2.200410.nc - $DIN_LOC_ROOT/share/domains/domain.lnd.ne30np4_oRRS30to10.160419.nc - $DIN_LOC_ROOT/share/domains/domain.lnd.ne30np4_oRRS30to10wLI.160930.nc $DIN_LOC_ROOT/share/domains/domain.lnd.ne30np4_oRRS30to10v3.171101.nc $DIN_LOC_ROOT/share/domains/domain.lnd.ne30np4_oRRS30to10v3wLI_mask.171109.nc $DIN_LOC_ROOT/share/domains/domain.ocn.ne30np4_gx1v6_110217.nc $DIN_LOC_ROOT/share/domains/domain.ocn.ne30np4_oQU120.160401.nc - $DIN_LOC_ROOT/share/domains/domain.ocn.ne30np4_oEC60to30.20151214.nc $DIN_LOC_ROOT/share/domains/domain.ocn.ne30np4_oEC60to30v3.161222.nc - $DIN_LOC_ROOT/share/domains/domain.ocn.ne30np4_oEC60to30wLI_mask.160915.nc $DIN_LOC_ROOT/share/domains/domain.ocn.ne30np4_oEC60to30v3wLI_mask.160915.nc $DIN_LOC_ROOT/share/domains/domain.ocn.ne30np4_ECwISC30to60E1r2.200410.nc - $DIN_LOC_ROOT/share/domains/domain.ocn.ne30np4_oRRS30to10.160419.nc - $DIN_LOC_ROOT/share/domains/domain.ocn.ne30np4_oRRS30to10wLI.160930.nc $DIN_LOC_ROOT/share/domains/domain.ocn.ne30np4_oRRS30to10v3.171101.nc $DIN_LOC_ROOT/share/domains/domain.ocn.ne30np4_oRRS30to10v3wLI_mask.171109.nc $DIN_LOC_ROOT/share/domains/domain.lnd.ne30np4_oEC60to30v3wLI_mask.170802.nc @@ -2515,11 +2369,9 @@ 777602 1 $DIN_LOC_ROOT/share/domains/domain.lnd.ne120np4_gx1v6.110502.nc - $DIN_LOC_ROOT/share/domains/domain.lnd.ne120np4_oRRS18to6.160831.nc $DIN_LOC_ROOT/share/domains/domain.lnd.ne120np4_oRRS18to6v3.170111.nc $DIN_LOC_ROOT/share/domains/domain.lnd.ne120np4_oRRS15to5.160207.nc $DIN_LOC_ROOT/share/domains/domain.ocn.ne120np4_gx1v6.121113.nc - $DIN_LOC_ROOT/share/domains/domain.ocn.ne120np4_oRRS18to6.160831.nc $DIN_LOC_ROOT/share/domains/domain.ocn.ne120np4_oRRS18to6v3.170111.nc $DIN_LOC_ROOT/share/domains/domain.ocn.ne120np4_oRRS15to5.160207.nc ne120np4 is Spectral Elem 1/4-deg grid: @@ -2530,6 +2382,8 @@ 1 $DIN_LOC_ROOT/share/domains/domain.lnd.ne120pg2_oEC60to30v3.200511.nc $DIN_LOC_ROOT/share/domains/domain.ocn.ne120pg2_oEC60to30v3.200511.nc + $DIN_LOC_ROOT/share/domains/domain.lnd.ne120pg2_EC30to60E2r2.210312.nc + $DIN_LOC_ROOT/share/domains/domain.ocn.ne120pg2_EC30to60E2r2.210312.nc ne120np4 is Spectral Elem 1/4-deg grid w/ 2x2 FV physics grid @@ -2607,27 +2461,6 @@ - - 86354 - 1 - $DIN_LOC_ROOT/share/domains/domain.ocn.mpasgx1.150903.nc - mpasgx1 is a MPAS seaice grid that is roughly 1 degree resolution: - - - - 28574 - 1 - $DIN_LOC_ROOT/share/domains/domain.ocn.mpas120.121116.nc - mpas120 is a MPAS ocean grid that is roughly 1 degree resolution: - - - - 234988 - 1 - $DIN_LOC_ROOT/share/domains/domain.ocn.oEC60to30.150616.nc - oEC60to30 is a MPAS ocean grid generated with the eddy closure density function that is roughly comparable to the pop 1 degree resolution: - - 235160 1 @@ -2635,13 +2468,6 @@ oEC60to30v3 is a MPAS ocean grid generated with the eddy closure density function that is roughly comparable to the pop 1 degree resolution: - - 236689 - 1 - $DIN_LOC_ROOT/share/domains/domain.ocn.oEC60to30wLI.160830.nc - oEC60to30wLI is a MPAS ocean grid generated with the eddy closure density function with 30 km gridcells at the equator, 60 km at mid-latitudes, and 35 km at high latitudes. It is roughly comparable to the POP 1 degree resolution. Additionally, it has ocean under landice cavities: - - 236358 1 @@ -2656,13 +2482,6 @@ ECwISC30to60E1r2 is a MPAS ocean grid generated with the eddy closure density function with 30 km gridcells at the equator, 60 km at mid-latitudes, and 35 km at high latitudes. It is roughly comparable to the POP 1 degree resolution. Additionally, it has ocean under landice cavities. Revision2: - - 1444565 - 1 - $DIN_LOC_ROOT/share/domains/domain.ocn.oRRS30to10.150722.nc - oRRS30to10 is an MPAS ocean grid with a mesh density function that is roughly proportional to the Rossby radius of deformation, with 30 km gridcells at low and 10 km gridcells at high latitudes: - - 1445361 1 @@ -2670,13 +2489,6 @@ oRRS30to10v3 is an MPAS ocean grid with a mesh density function that is roughly proportional to the Rossby radius of deformation, with 30 km gridcells at low and 10 km gridcells at high latitudes: - - 1462411 - 1 - $DIN_LOC_ROOT/share/domains/domain.ocn.oRRS30to10wLI.160930.nc - oRRS30to10wLI is an MPAS ocean grid with a mesh density function that is roughly proportional to the Rossby radius of deformation, with 30 km gridcells at low and 10 km gridcells at high latitudes: Additionally, it has ocean under landice cavities: - - 1460217 1 @@ -2684,13 +2496,6 @@ oRRS30to10v3wLI is an MPAS ocean grid with a mesh density function that is roughly proportional to the Rossby radius of deformation, with 30 km gridcells at low and 10 km gridcells at high latitudes: Additionally, it has ocean under landice cavities: - - 3697425 - 1 - $DIN_LOC_ROOT/share/domains/domain.ocn.oRRS18to6.160831.nc - oRRS18to6 is an MPAS ocean grid with a mesh density function that is roughly proportional to the Rossby radius of deformation, with 18 km gridcells at low and 6 km gridcells at high latitudes: - - 3693225 1 @@ -2736,7 +2541,7 @@ 569915 1 - /home/ac.dcomeau/cryo/SOwISC12to60E2r4/domain.ocn.SOwISC12to60E2r4-nomask.210119.nc + $DIN_LOC_ROOT/share/domains/domain.ocn.SOwISC12to60E2r4-nomask.210119.nc SOwISC12to60E2r4 is a MPAS ice/ocean grid with enhanced resolution of 12km in the Southern Ocean around Antarctica. The high resolution regions smoothly transition to the background resolution of the standard low resolution 60to30km grid: @@ -2798,6 +2603,8 @@ $DIN_LOC_ROOT/share/domains/domain.lnd.r0125_oRRS18to6v3.200212.nc $DIN_LOC_ROOT/share/domains/domain.lnd.r0125_WC14to60E2r3.200929.nc $DIN_LOC_ROOT/share/domains/domain.lnd.r0125_WC14to60E2r3.200929.nc + $DIN_LOC_ROOT/share/domains/domain.lnd.r0125_EC30to60E2r2.210412.nc + $DIN_LOC_ROOT/share/domains/domain.lnd.r0125_EC30to60E2r2.210412.nc $DIN_LOC_ROOT/share/domains/domain.lnd.r0125_gx1v6.191017.nc r0125 is 1/8 degree river routing grid: @@ -3034,14 +2841,6 @@ cpl/gridmaps/gx1v6/map_gx1v6_TO_fv0.9x1.25_aave.130322.nc - - cpl/gridmaps/fv0.9x1.25/map_0.9x1.25_TO_mpas120_aave.151109.nc - cpl/gridmaps/fv0.9x1.25/map_0.9x1.25_TO_mpas120_bilin.151109.nc - cpl/gridmaps/fv0.9x1.25/map_0.9x1.25_TO_mpas120_patc.151109.nc - cpl/gridmaps/mpas120/map_mpas120_TO_0.9x1.25_aave.151109.nc - cpl/gridmaps/mpas120/map_mpas120_TO_0.9x1.25_aave.151109.nc - - cpl/cpl6/map_fv0.9x1.25_to_mp120v1_aave_da_111004.nc cpl/cpl6/map_fv0.9x1.25_to_mp120v1_aave_da_111004.nc @@ -3143,13 +2942,6 @@ cpl/gridmaps/ne16pg2/map_r05_to_ne16pg2_mono.200527.nc cpl/gridmaps/ne16pg2/map_r05_to_ne16pg2_mono.200527.nc - - cpl/gridmaps/ne11np4/map_ne11np4_to_oQU240_aave.160614.nc - cpl/gridmaps/ne11np4/map_ne11np4_to_oQU240_aave.160614.nc - cpl/gridmaps/ne11np4/map_ne11np4_to_oQU240_aave.160614.nc - cpl/gridmaps/oQU240/map_oQU240_to_ne11np4_aave.160614.nc - cpl/gridmaps/oQU240/map_oQU240_to_ne11np4_aave.160614.nc - cpl/cpl6/map_ne30np4_to_gx1v6_aave_110121.nc @@ -3231,14 +3023,6 @@ cpl/gridmaps/oEC60to30v3/map_oEC60to30v3_to_ne30pg4_mono.200331.nc - - cpl/gridmaps/ne30np4/map_ne30np4_to_oEC60to30wLI_mask_aave.160915.nc - cpl/gridmaps/ne30np4/map_ne30np4_to_oEC60to30wLI_mask_aave.160915.nc - cpl/gridmaps/ne30np4/map_ne30np4_to_oEC60to30wLI_nomask_aave.160915.nc - cpl/gridmaps/oEC60to30wLI/map_oEC60to30wLI_mask_to_ne30np4_aave.160915.nc - cpl/gridmaps/oEC60to30wLI/map_oEC60to30wLI_mask_to_ne30np4_aave.160915.nc - - cpl/gridmaps/ne30np4/map_ne30np4_to_oEC60to30v3wLI_mask_aave.170802.nc cpl/gridmaps/ne30np4/map_ne30np4_to_oEC60to30v3wLI_mask_conserve.170802.nc @@ -3255,22 +3039,6 @@ cpl/gridmaps/ECwISC30to60E1r2/map_ECwISC30to60E1r2-nomask_to_ne30np4_aave.200408.nc - - cpl/gridmaps/ne30np4/map_ne30np4_to_oRRS30to10wLI_mask_aave.160930.nc - cpl/gridmaps/ne30np4/map_ne30np4_to_oRRS30to10wLI_mask_aave.160930.nc - cpl/gridmaps/ne30np4/map_ne30np4_to_oRRS30to10wLI_nomask_aave.160930.nc - cpl/gridmaps/oRRS30to10wLI/map_oRRS30to10wLI_mask_to_ne30np4_aave.160930.nc - cpl/gridmaps/oRRS30to10wLI/map_oRRS30to10wLI_mask_to_ne30np4_aave.160930.nc - - - - cpl/cpl6/map_ne30np4_TO_MPASO_QU120km_aave.151110.nc - cpl/cpl6/map_ne30np4_TO_MPASO_QU120km_bilin.151110.nc - cpl/cpl6/map_ne30np4_TO_MPASO_QU120km_bilin.151110.nc - cpl/cpl6/map_MPASO_QU120km_TO_ne30np4_aave.151110.nc - cpl/cpl6/map_MPASO_QU120km_TO_ne30np4_aave.151110.nc - - cpl/gridmaps/ne30np4/map_ne30np4_TO_fv0.9x1.25_aave.120712.nc cpl/gridmaps/ne30np4/map_ne30np4_TO_fv0.9x1.25_aave.120712.nc @@ -3444,6 +3212,14 @@ cpl/gridmaps/oEC60to30v3/map_oEC60to30v3_to_ne120pg2_mono.200331.nc + + cpl/gridmaps/ne120pg2/map_ne120pg2_to_EC30to60E2r2_mono.210311.nc + cpl/gridmaps/ne120pg2/map_ne120pg2_to_EC30to60E2r2_bilin.210311.nc + cpl/gridmaps/ne120pg2/map_ne120pg2_to_EC30to60E2r2_bilin.210311.nc + cpl/gridmaps/EC30to60E2r2/map_EC30to60E2r2_to_ne120pg2_mono.210311.nc + cpl/gridmaps/EC30to60E2r2/map_EC30to60E2r2_to_ne120pg2_mono.210311.nc + + cpl/gridmaps/ne120pg2/map_ne120pg2_to_r05_mono.200331.nc cpl/gridmaps/ne120pg2/map_ne120pg2_to_r05_bilin.200331.nc @@ -3560,6 +3336,10 @@ cpl/gridmaps/ne1024pg2/map_r0125_to_ne1024pg2_bilin.200212.nc + + cpl/gridmaps/ne1024pg2/map_ne1024pg2_to_r0125_mono.200212.nc + cpl/gridmaps/ne1024pg2/map_ne1024pg2_to_r0125_mono.200212.nc + cpl/gridmaps/conusx4v1/map_conusx4v1_to_oEC60to30v3_mono.200514.nc @@ -3701,22 +3481,6 @@ cpl/gridmaps/gx1v6/map_gx1v6_TO_T62_aave.130322.nc - - cpl/gridmaps/T62/map_T62_TO_mpas120_aave.121116.nc - cpl/gridmaps/T62/map_T62_TO_mpas120_aave.121116.nc - cpl/gridmaps/T62/map_T62_TO_mpas120_aave.121116.nc - cpl/gridmaps/mpas120/map_mpas120_TO_T62_aave.121116.nc - cpl/gridmaps/mpas120/map_mpas120_TO_T62_aave.121116.nc - - - - cpl/gridmaps/T62/map_T62_TO_mpasgx1_aave.150827.nc - cpl/gridmaps/T62/map_T62_TO_mpasgx1_blin.150827.nc - cpl/gridmaps/T62/map_T62_TO_mpasgx1_blin.150827.nc - cpl/gridmaps/mpasgx1/map_mpasgx1_TO_T62_aave.150827.nc - cpl/gridmaps/mpasgx1/map_mpasgx1_TO_T62_aave.150827.nc - - cpl/gridmaps/T62/map_T62_TO_oQU480_aave.151209.nc cpl/gridmaps/T62/map_T62_TO_oQU480_patc.151209.nc @@ -3749,14 +3513,6 @@ cpl/gridmaps/oQU120/map_oQU120_TO_T62_aave.151209.nc - - cpl/gridmaps/T62/map_T62_TO_oEC60to30_aave.150615.nc - cpl/gridmaps/T62/map_T62_TO_oEC60to30_bilin.150804.nc - cpl/gridmaps/T62/map_T62_TO_oEC60to30_patc.150804.nc - cpl/gridmaps/oEC60to30/map_oEC60to30_TO_T62_aave.150615.nc - cpl/gridmaps/oEC60to30/map_oEC60to30_TO_T62_aave.150615.nc - - cpl/gridmaps/T62/map_T62_TO_oEC60to30v3_aave.161222.nc cpl/gridmaps/T62/map_T62_TO_oEC60to30v3_blin.161222.nc @@ -3765,14 +3521,6 @@ cpl/gridmaps/oEC60to30v3/map_oEC60to30v3_TO_T62_aave.161222.nc - - cpl/gridmaps/T62/map_T62_TO_oEC60to30wLI_aave.160830.nc - cpl/gridmaps/T62/map_T62_TO_oEC60to30wLI_nm_aave.160830.nc - cpl/gridmaps/T62/map_T62_TO_oEC60to30wLI_blin.160830.nc - cpl/gridmaps/oEC60to30wLI/map_oEC60to30wLI_TO_T62_aave.160830.nc - cpl/gridmaps/oEC60to30wLI/map_oEC60to30wLI_TO_T62_aave.160830.nc - - cpl/gridmaps/T62/map_T62_TO_oEC60to30v3wLI_mask_aave.170328.nc cpl/gridmaps/T62/map_T62_TO_oEC60to30v3wLI_nomask_blin.170328.nc @@ -3789,14 +3537,6 @@ cpl/gridmaps/ECwISC30to60E1r2/map_ECwISC30to60E1r2_to_T62_aave.200410.nc - - cpl/gridmaps/T62/map_T62_TO_oRRS30to10_aave.150722.nc - cpl/gridmaps/T62/map_T62_TO_oRRS30to10_blin.150722.nc - cpl/gridmaps/T62/map_T62_TO_oRRS30to10_patc.150722.nc - cpl/gridmaps/oRRS30to10/map_oRRS30to10_TO_T62_aave.150722.nc - cpl/gridmaps/oRRS30to10/map_oRRS30to10_TO_T62_aave.150722.nc - - cpl/gridmaps/T62/map_T62_TO_oRRS30to10v3_aave.171128.nc cpl/gridmaps/T62/map_T62_TO_oRRS30to10v3_blin.171128.nc @@ -3805,14 +3545,6 @@ cpl/gridmaps/oRRS30to10v3/map_oRRS30to10v3_TO_T62_aave.171128.nc - - cpl/gridmaps/T62/map_T62_TO_oRRS30to10wLI_mask_aave.160930.nc - cpl/gridmaps/T62/map_T62_TO_oRRS30to10wLI_nomask_aave.160930.nc - cpl/gridmaps/T62/map_T62_TO_oRRS30to10wLI_mask_blin.160930.nc - cpl/gridmaps/oRRS30to10wLI/map_oRRS30to10wLI_mask_TO_T62_aave.160930.nc - cpl/gridmaps/oRRS30to10wLI/map_oRRS30to10wLI_mask_TO_T62_aave.160930.nc - - cpl/gridmaps/T62/map_T62_TO_oRRS30to10v3wLI_mask_aave.171109.nc cpl/gridmaps/T62/map_T62_TO_oRRS30to10v3wLI_nomask_blin.171109.nc @@ -3821,14 +3553,6 @@ cpl/gridmaps/oRRS30to10v3wLI/map_oRRS30to10v3wLI_mask_TO_T62_aave.171109.nc - - cpl/gridmaps/T62/map_T62_to_oRRS18to6_aave.160831.nc - cpl/gridmaps/T62/map_T62_to_oRRS18to6_patch.160831.nc - cpl/gridmaps/T62/map_T62_to_oRRS18to6_bilin.160831.nc - cpl/gridmaps/oRRS18to6/map_oRRS18to6_to_T62_aave.160831.nc - cpl/gridmaps/oRRS18to6/map_oRRS18to6_to_T62_aave.160831.nc - - cpl/gridmaps/T62/map_T62_to_oRRS18to6v3_aave.170111.nc cpl/gridmaps/T62/map_T62_to_oRRS18to6v3_patc.170111.nc @@ -4049,6 +3773,7 @@ cpl/gridmaps/ne16pg2/map_ne16pg2_to_r05_mono.200527.nc cpl/gridmaps/ne16pg2/map_ne16pg2_to_r05_mono.200527.nc + lnd/clm2/mappingdata/maps/ne30np4/map_ne30np4_to_0.5x0.5rtm_aave_da_110320.nc lnd/clm2/mappingdata/maps/ne30np4/map_ne30np4_to_0.5x0.5rtm_aave_da_110320.nc @@ -4207,6 +3932,11 @@ lnd/clm2/mappingdata/maps/ne240np4/map_0.5x0.5_nomask_to_ne240np4_nomask_aave_da_c121019.nc + + cpl/gridmaps/ne1024pg2/map_ne1024pg2_to_r0125_mono.200212.nc + cpl/gridmaps/ne1024pg2/map_r0125_to_ne1024pg2_mono.200212.nc + + lnd/clm2/mappingdata/maps/0.23x0.31/map_0.23x0.31_nomask_to_0.5x0.5_nomask_aave_da_c110920.nc lnd/clm2/mappingdata/maps/0.23x0.31/map_0.5x0.5_nomask_to_0.23x0.31_nomask_aave_da_c110920.nc @@ -4288,23 +4018,6 @@ cpl/cpl6/map_r01_to_gx1v6_120711.nc - - - - cpl/cpl6/map_rx1_to_mpasgx1_nn_150910.nc - cpl/cpl6/map_rx1_to_mpasgx1_nn_150910.nc - - - - cpl/cpl6/map_rx1_to_mpas120_nn_131217.nc - cpl/cpl6/map_rx1_to_mpas120_nn_131217.nc - - - - cpl/cpl6/map_r05_to_QU120km_nn_151110.nc - cpl/cpl6/map_r05_to_QU120km_nn_151110.nc - - @@ -4327,21 +4040,11 @@ cpl/cpl6/map_rx1_to_oQU120_nn.160527.nc - - cpl/cpl6/map_rx1_to_oEC60to30_nn.160527.nc - cpl/cpl6/map_rx1_to_oEC60to30_nn.160527.nc - - cpl/cpl6/map_rx1_to_oEC60to30v3_smoothed.r300e600.161222.nc cpl/cpl6/map_rx1_to_oEC60to30v3_smoothed.r300e600.161222.nc - - cpl/cpl6/map_rx1_to_oEC60to30wLI_nn.160830.nc - cpl/cpl6/map_rx1_to_oEC60to30wLI_nn.160830.nc - - cpl/cpl6/map_rx1_to_oEC60to30v3wLI_smoothed.r300e600.180601.nc cpl/cpl6/map_rx1_to_oEC60to30v3wLI_smoothed.r300e600.180601.nc @@ -4352,31 +4055,16 @@ cpl/cpl6/map_rx1_to_ECwISC30to60E1r2_smoothed.r150e300.200410.nc - - cpl/cpl6/map_rx1_to_oRRS30to10_nn.160527.nc - cpl/cpl6/map_rx1_to_oRRS30to10_nn.160527.nc - - cpl/cpl6/map_rx1_to_oRRS30to10v3_smoothed.r150e300.171129.nc cpl/cpl6/map_rx1_to_oRRS30to10v3_smoothed.r150e300.171129.nc - - cpl/cpl6/map_rx1_to_oRRS30to10wLI_smoothed.r150e300.160930.nc - cpl/cpl6/map_rx1_to_oRRS30to10wLI_smoothed.r150e300.160930.nc - - cpl/cpl6/map_rx1_to_oRRS30to10v3wLI-masked_smoothed.r150e300.180611.nc cpl/cpl6/map_rx1_to_oRRS30to10v3wLI-masked_smoothed.r150e300.180611.nc - - cpl/cpl6/map_rx1_to_oRRS18to6_nn.160830.nc - cpl/cpl6/map_rx1_to_oRRS18to6_nn.160830.nc - - cpl/cpl6/map_rx1_to_oRRS18to6v3_smoothed.r100e200.170111.nc cpl/cpl6/map_rx1_to_oRRS18to6v3_smoothed.r100e200.170111.nc @@ -4497,11 +4185,6 @@ cpl/cpl6/map_r05_to_oQU120_nn.160718.nc - - cpl/cpl6/map_r05_to_oEC60to30_smoothed.r175e350.160718.nc - cpl/cpl6/map_r05_to_oEC60to30_smoothed.r175e350.160718.nc - - cpl/cpl6/map_r05_to_oEC60to30v3_smoothed.r300e600.161222.nc cpl/cpl6/map_r05_to_oEC60to30v3_smoothed.r300e600.161222.nc @@ -4547,9 +4230,9 @@ cpl/cpl6/map_r0125_to_oEC60to30v3_smoothed.r150e300.190812.nc - - cpl/cpl6/map_r05_to_oEC60to30wLI_smoothed.r300e600.160926.nc - cpl/cpl6/map_r05_to_oEC60to30wLI_smoothed.r300e600.160926.nc + + cpl/cpl6/map_r0125_to_EC30to60E2r2_smoothed.r150e300.210311.nc + cpl/cpl6/map_r0125_to_EC30to60E2r2_smoothed.r150e300.210311.nc @@ -4562,16 +4245,6 @@ cpl/cpl6/map_r05_to_ECwISC30to60E1r2_smoothed.r150e300.200410.nc - - cpl/cpl6/map_r05_to_oRRS30to10_nn.160718.nc - cpl/cpl6/map_r05_to_oRRS30to10_nn.160718.nc - - - - cpl/cpl6/map_r05_to_oRRS30to10wLI_nn.160930.nc - cpl/cpl6/map_r05_to_oRRS30to10wLI_nn.160930.nc - - cpl/cpl6/map_r05_to_oRRS30to10v3_smoothed.r150e300.171109.nc cpl/cpl6/map_r05_to_oRRS30to10v3_smoothed.r150e300.171109.nc @@ -4587,11 +4260,6 @@ cpl/cpl6/map_r05_to_oRRS15to5_nn.160203.nc - - cpl/cpl6/map_r0125_to_oRRS18to6_nn.160831.nc - cpl/cpl6/map_r0125_to_oRRS18to6_nn.160831.nc - - cpl/cpl6/map_r0125_to_oRRS18to6v3_smoothed.r50e100.170111.nc cpl/cpl6/map_r0125_to_oRRS18to6v3_smoothed.r50e100.170111.nc @@ -4671,6 +4339,20 @@ cpl/gridmaps/mpas.gis1to10km/map_gis1to10km_to_r05_mono.200602.nc + + cpl/gridmaps/ne30pg2/map_ne30pg2_to_gis1to10km_mono.210304.nc + cpl/gridmaps/ne30pg2/map_ne30pg2_to_gis1to10km_bilin.210304.nc + cpl/gridmaps/mpas.gis1to10km/map_gis1to10km_to_ne30pg2_mono.210304.nc + cpl/gridmaps/mpas.gis1to10km/map_gis1to10km_to_ne30pg2_mono.210304.nc + + + + cpl/gridmaps/r0125/map_r0125_to_gis1to10km_mono.210304.nc + cpl/gridmaps/r0125/map_r0125_to_gis1to10km_bilin.210304.nc + cpl/gridmaps/mpas.gis1to10km/map_gis1to10km_to_r0125_mono.210304.nc + cpl/gridmaps/mpas.gis1to10km/map_gis1to10km_to_r0125_mono.210304.nc + + cpl/gridmaps/oEC60to30v3/map_oEC60to30v3_to_gis1to10km_aave.200602.nc cpl/gridmaps/oEC60to30v3/map_oEC60to30v3_to_gis1to10km_bilin.200602.nc @@ -4682,6 +4364,17 @@ cpl/gridmaps/mpas.gis1to10km/map_gis1to10km_to_oEC60to30v3_aave.200602.nc + + cpl/gridmaps/EC30to60E2r2/map_EC30to60E2r2_to_gis1to10km_aave.210304.nc + cpl/gridmaps/EC30to60E2r2/map_EC30to60E2r2_to_gis1to10km_bilin.210304.nc + cpl/gridmaps/mpas.gis1to10km/map_gis1to10km_to_EC30to60E2r2_aave.210304.nc + cpl/gridmaps/mpas.gis1to10km/map_gis1to10km_to_EC30to60E2r2_aave.210304.nc + cpl/gridmaps/mpas.gis1to10km/map_gis1to10km_to_EC30to60E2r2_aave.210304.nc + cpl/gridmaps/mpas.gis1to10km/map_gis1to10km_to_EC30to60E2r2_aave.210304.nc + cpl/gridmaps/mpas.gis1to10km/map_gis1to10km_to_EC30to60E2r2_aave.210304.nc + cpl/gridmaps/mpas.gis1to10km/map_gis1to10km_to_EC30to60E2r2_aave.210304.nc + + @@ -4704,20 +4397,6 @@ - - - - cpl/gridmaps/mpas.gis20km/map_mpas.gis20km_to_mpas120_nnsmooth_150924.nc - cpl/gridmaps/mpas.gis20km/map_mpas.gis20km_to_mpas120_nnsmooth_150924.nc - - - - cpl/gridmaps/mpas.ais20km/map_ais20km_to_oEC60to30_nearestdtos.151005.nc - cpl/gridmaps/mpas.ais20km/map_ais20km_to_oEC60to30_nearestdtos.151005.nc - cpl/gridmaps/oEC60to30/map_oEC60to30_to_ais20km_nearestdtos.151005.nc - cpl/gridmaps/oEC60to30/map_oEC60to30_to_ais20km_nearestdtos.151005.nc - - cpl/gridmaps/ne16np4/map_ne16np4_to_oQU240_aave.151209.nc cpl/gridmaps/ne16np4/map_ne16np4_to_oQU240_conserve.151209.nc @@ -4734,14 +4413,6 @@ cpl/gridmaps/oQU120/map_oQU120_to_ne30np4_aave.160322.nc - - cpl/gridmaps/ne30np4/map_ne30np4_TO_oEC60to30_aave.151207.nc - cpl/gridmaps/ne30np4/map_ne30np4_to_oEC60to30_conserve_151207.nc - cpl/gridmaps/ne30np4/map_ne30np4_to_oEC60to30_conserve_151207.nc - cpl/gridmaps/oEC60to30/map_oEC60to30_TO_ne30np4_aave.151207.nc - cpl/gridmaps/oEC60to30/map_oEC60to30_TO_ne30np4_aave.151207.nc - - cpl/gridmaps/ne30np4/map_ne30np4_to_oEC60to30v3_aave.161222.nc cpl/gridmaps/ne30np4/map_ne30np4_to_oEC60to30v3_conserve_161222.nc @@ -4750,22 +4421,6 @@ cpl/gridmaps/oEC60to30v3/map_oEC60to30v3_to_ne30np4_aave.161222.nc - - cpl/gridmaps/ne30np4/map_ne30np4_to_oRRS30to10_aave.160419.nc - cpl/gridmaps/ne30np4/map_ne30np4_to_oRRS30to10_aave.160419.nc - cpl/gridmaps/ne30np4/map_ne30np4_to_oRRS30to10_aave.160419.nc - cpl/gridmaps/oRRS30to10/map_oRRS30to10_to_ne30np4_aave.160419.nc - cpl/gridmaps/oRRS30to10/map_oRRS30to10_to_ne30np4_aave.160419.nc - - - - cpl/gridmaps/ne30np4/map_ne30np4_to_oRRS30to10wLI_mask_aave.160930.nc - cpl/gridmaps/ne30np4/map_ne30np4_to_oRRS30to10wLI_mask_aave.160930.nc - cpl/gridmaps/ne30np4/map_ne30np4_to_oRRS30to10wLI_nomask_aave.160930.nc - cpl/gridmaps/oRRS30to10wLI/map_oRRS30to10wLI_mask_to_ne30np4_aave.160930.nc - cpl/gridmaps/oRRS30to10wLI/map_oRRS30to10wLI_mask_to_ne30np4_aave.160930.nc - - cpl/gridmaps/ne30np4/map_ne30np4_to_oRRS30to10v3_aave.171218.nc cpl/gridmaps/ne30np4/map_ne30np4_to_oRRS30to10v3_conserve.171218.nc @@ -4789,14 +4444,6 @@ cpl/cpl6/map_fv1.9x2.5_to_ne30np4_aave_da_091230.nc - - cpl/gridmaps/ne120np4/map_ne120np4_to_oRRS18to6_aave.160831.nc - cpl/gridmaps/ne120np4/map_ne120np4_to_oRRS18to6_bilin.160831.nc - cpl/gridmaps/ne120np4/map_ne120np4_to_oRRS18to6_bilin.160831.nc - cpl/gridmaps/oRRS18to6/map_oRRS18to6_to_ne120np4_aave.160831.nc - cpl/gridmaps/oRRS18to6/map_oRRS18to6_to_ne120np4_aave.160831.nc - - cpl/gridmaps/ne120np4/map_ne120np4_to_oRRS18to6v3_aave.170111.nc cpl/gridmaps/ne120np4/map_ne120np4_to_oRRS18to6v3_conserve.170111.nc diff --git a/cime_config/machines/config_compilers.xml b/cime_config/machines/config_compilers.xml index 1c94c907c9ec..43006119dcd7 100644 --- a/cime_config/machines/config_compilers.xml +++ b/cime_config/machines/config_compilers.xml @@ -702,6 +702,7 @@ flags should be captured within MPAS CMake files. -DHAVE_NANOTIME -DBIT64 -DHAVE_SLASHPROC -DHAVE_GETTIMEOFDAY + $ENV{MOAB_PATH} gpfs $SHELL{$ENV{NETCDF_FORTRAN_PATH}/bin/nf-config --flibs} -L$ENV{MKLROOT}/lib/intel64 -Wl,--no-as-needed -lmkl_intel_lp64 -lmkl_intel_thread -lmkl_core -liomp5 -lpthread -lm -ldl @@ -710,6 +711,7 @@ flags should be captured within MPAS CMake files. -lstdc++ + $ENV{HDF5_PATH} $ENV{NETCDF_C_PATH} $ENV{NETCDF_FORTRAN_PATH} $ENV{PNETCDF_PATH} @@ -734,6 +736,7 @@ flags should be captured within MPAS CMake files. + $ENV{MOAB_PATH} -static-intel -heap-arrays @@ -760,8 +763,9 @@ flags should be captured within MPAS CMake files. $SHELL{$ENV{NETCDF_FORTRAN_PATH}/bin/nf-config --flibs} $SHELL{$ENV{NETCDF_C_PATH}/bin/nc-config --libs} - -Wl,--start-group $ENV{MKLROOT}/lib/intel64/libmkl_intel_lp64.a $ENV{MKLROOT}/lib/intel64/libmkl_sequential.a $ENV{MKLROOT}/lib/intel64/libmkl_core.a -Wl,--end-group -lpthread -lm -ldl + -Wl,--start-group $ENV{MKLROOT}/lib/intel64/libmkl_intel_lp64.a $ENV{MKLROOT}/lib/intel64/libmkl_sequential.a $ENV{MKLROOT}/lib/intel64/libmkl_core.a -Wl,--end-group -lpthread -lm -ldl + $ENV{HDF5_PATH} $ENV{NETCDF_C_PATH} $ENV{NETCDF_FORTRAN_PATH} $ENV{PNETCDF_PATH} diff --git a/cime_config/machines/config_machines.xml b/cime_config/machines/config_machines.xml index a867a3fb6ce6..24f4c5bccd43 100644 --- a/cime_config/machines/config_machines.xml +++ b/cime_config/machines/config_machines.xml @@ -1050,6 +1050,7 @@ cmake/3.20.3-vedypwm + anaconda3/2021.05 gcc/7.4.0 @@ -1062,6 +1063,7 @@ netcdf-cxx/4.2-db2f5or netcdf-fortran/4.4.4-b4ldb3a parallel-netcdf/1.11.0-kj4jsvt + hdf5/1.10.7-igh6foh intel-mpi/2019.9.304-i42whlw @@ -1069,6 +1071,7 @@ netcdf-cxx/4.2-gkqc6fq netcdf-fortran/4.4.4-eanrh5t parallel-netcdf/1.11.0-y3nmmej + hdf5/1.10.7-ugvomvt openmpi/4.1.1-v3b3npd @@ -1135,6 +1138,12 @@ cores + + /gpfs/fs1/home/software/climate/moab/devel/anvil/impi-2019.9.304/intel-20.0.4 + + + /gpfs/fs1/home/software/climate/moab/devel/anvil/mvapich-2.3.6/intel-20.0.4 + diff --git a/components/cmake/common_setup.cmake b/components/cmake/common_setup.cmake index a03b6130cb52..2818e60cde96 100644 --- a/components/cmake/common_setup.cmake +++ b/components/cmake/common_setup.cmake @@ -255,7 +255,6 @@ if (USE_KOKKOS) NO_DEFAULT_PATH) endif() -# JGF: No one seems to be using this if (COMP_INTERFACE STREQUAL "moab") if (MOAB_PATH) set(CPPDEFS "${CPPDEFS} -DHAVE_MOAB") @@ -267,7 +266,7 @@ if (COMP_INTERFACE STREQUAL "moab") set(LIB_MOAB ${MOAB_PATH}/lib) endif() else() - message(FATAL_ERROR "MOAB_PATH must be defined when USE_MOAB is TRUE") + message(FATAL_ERROR "MOAB_PATH must be defined when using moab driver") endif() include(${MOAB_PATH}/lib/cmake/MOAB/MOABConfig.cmake) @@ -447,7 +446,7 @@ endif() # Add MOAB libraries. if (COMP_INTERFACE STREQUAL "moab") - set(SLIBS "${SLIBS} ${IMESH_LIBRARIES}") + set(SLIBS "${SLIBS} ${MOAB_LIBRARIES}") endif() # Add libraries and flags that we need on the link line when C++ code is included diff --git a/driver-mct/cime_config/config_component.xml b/driver-mct/cime_config/config_component.xml index 7554fa7a8bd8..3da2c292e973 100644 --- a/driver-mct/cime_config/config_component.xml +++ b/driver-mct/cime_config/config_component.xml @@ -753,15 +753,6 @@ machines. - - logical - TRUE,FALSE - FALSE - build_def - env_build.xml - TRUE implies linking to the MOAB library - - logical TRUE,FALSE diff --git a/driver-mct/cime_config/namelist_definition_modelio.xml b/driver-mct/cime_config/namelist_definition_modelio.xml index 660bc93dee3e..ce0275e59bf3 100644 --- a/driver-mct/cime_config/namelist_definition_modelio.xml +++ b/driver-mct/cime_config/namelist_definition_modelio.xml @@ -172,6 +172,7 @@ $GLC_PIO_NETCDF_FORMAT $WAV_PIO_NETCDF_FORMAT $IAC_PIO_NETCDF_FORMAT + $ESP_PIO_NETCDF_FORMAT diff --git a/driver-moab/cime_config/namelist_definition_modelio.xml b/driver-moab/cime_config/namelist_definition_modelio.xml index 660bc93dee3e..ce0275e59bf3 100644 --- a/driver-moab/cime_config/namelist_definition_modelio.xml +++ b/driver-moab/cime_config/namelist_definition_modelio.xml @@ -172,6 +172,7 @@ $GLC_PIO_NETCDF_FORMAT $WAV_PIO_NETCDF_FORMAT $IAC_PIO_NETCDF_FORMAT + $ESP_PIO_NETCDF_FORMAT From 5ed2db34fb09da68ad7f3d73fc080e6d3d855be5 Mon Sep 17 00:00:00 2001 From: Jason Sarich Date: Thu, 18 Nov 2021 13:04:40 -0600 Subject: [PATCH 108/467] update cime to newer version --- cime | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/cime b/cime index b8cef1061de6..7a2523af3baa 160000 --- a/cime +++ b/cime @@ -1 +1 @@ -Subproject commit b8cef1061de61ffea2a70d972cb5d47d049b50b0 +Subproject commit 7a2523af3baaed9f888b7bf778c5674b02204b89 From 441f9ef72e1cb1af282edc283fdde462018d9342 Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Thu, 18 Nov 2021 15:40:37 -0600 Subject: [PATCH 109/467] do not need to define external anymore --- driver-moab/main/prep_ocn_mod.F90 | 3 +-- driver-moab/main/seq_map_mod.F90 | 1 - 2 files changed, 1 insertion(+), 3 deletions(-) diff --git a/driver-moab/main/prep_ocn_mod.F90 b/driver-moab/main/prep_ocn_mod.F90 index 81306c2cfa00..ba58c126eeca 100644 --- a/driver-moab/main/prep_ocn_mod.F90 +++ b/driver-moab/main/prep_ocn_mod.F90 @@ -176,7 +176,6 @@ subroutine prep_ocn_init(infodata, atm_c2_ocn, atm_c2_ice, ice_c2_ocn, rof_c2_oc character*32 :: appname ! to register moab app integer :: rmapid ! external id to identify the moab app - integer, external :: iMOAB_RegisterApplicationFortran ! integer :: ierr ! !--------------------------------------------------------------- @@ -338,7 +337,7 @@ subroutine prep_ocn_init(infodata, atm_c2_ocn, atm_c2_ice, ice_c2_ocn, rof_c2_oc appname = "ROF_OCN_COU"//CHAR(0) ! rmapid is a unique external number of MOAB app that takes care of map between rof and ocn mesh rmapid = 100*rof(1)%cplcompid + ocn(1)%cplcompid ! something different, to differentiate it - ierr = iMOAB_RegisterApplicationFortran(trim(appname), mpicom_CPLID, rmapid, mbrmapro) + ierr = iMOAB_RegisterApplication(trim(appname), mpicom_CPLID, rmapid, mbrmapro) if (ierr .ne. 0) then write(logunit,*) subname,' error in registering rof 2 ocn moab map ' call shr_sys_abort(subname//' ERROR in registering rof 2 ocn moab map ') diff --git a/driver-moab/main/seq_map_mod.F90 b/driver-moab/main/seq_map_mod.F90 index d77a23ad60ec..31c20daa33b7 100644 --- a/driver-moab/main/seq_map_mod.F90 +++ b/driver-moab/main/seq_map_mod.F90 @@ -187,7 +187,6 @@ subroutine moab_map_init_rcfile( mbappid, comp_s, comp_d, & character(CX) :: mapfile_term character(CL) :: maptype integer(IN) :: mapid - integer, external :: iMOAB_LoadMappingWeightsFromFile character(CX) :: sol_identifier ! /* "scalar", "flux", "custom" */ integer :: ierr From 4e5a06699ee78a30355d740a95df29e8a9621c9a Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Thu, 18 Nov 2021 16:06:37 -0600 Subject: [PATCH 110/467] instead of external we need to use iMOAB module --- driver-moab/main/prep_ocn_mod.F90 | 1 + driver-moab/main/seq_map_mod.F90 | 1 + 2 files changed, 2 insertions(+) diff --git a/driver-moab/main/prep_ocn_mod.F90 b/driver-moab/main/prep_ocn_mod.F90 index ba58c126eeca..04d4b9b4172e 100644 --- a/driver-moab/main/prep_ocn_mod.F90 +++ b/driver-moab/main/prep_ocn_mod.F90 @@ -134,6 +134,7 @@ module prep_ocn_mod subroutine prep_ocn_init(infodata, atm_c2_ocn, atm_c2_ice, ice_c2_ocn, rof_c2_ocn, & wav_c2_ocn, glc_c2_ocn, glcshelf_c2_ocn) + use iMOAB, only: iMOAB_RegisterApplication !--------------------------------------------------------------- ! Description ! Initialize module attribute vectors and all other non-mapping diff --git a/driver-moab/main/seq_map_mod.F90 b/driver-moab/main/seq_map_mod.F90 index 31c20daa33b7..274556dea987 100644 --- a/driver-moab/main/seq_map_mod.F90 +++ b/driver-moab/main/seq_map_mod.F90 @@ -163,6 +163,7 @@ end subroutine seq_map_init_rcfile subroutine moab_map_init_rcfile( mbappid, comp_s, comp_d, & maprcfile, maprcname, maprctype, samegrid, string, esmf_map) + use iMOAB, only: iMOAB_LoadMappingWeightsFromFile implicit none !----------------------------------------------------- ! From 03082fd38ae15b57a6c2b9efbfb68cbab6cf7367 Mon Sep 17 00:00:00 2001 From: jayeshkrishna Date: Fri, 8 Oct 2021 11:45:32 -0500 Subject: [PATCH 111/467] Adding cmake macro for anlgce Adding the cmake macros file for ANL CELS GCE compute nodes. The macro file was generated using the /cime_config/machines/scripts/converter script. --- .../machines/cmake_macros/gnu_anlgce.cmake | 15 +++++++++++++++ 1 file changed, 15 insertions(+) create mode 100644 cime_config/machines/cmake_macros/gnu_anlgce.cmake diff --git a/cime_config/machines/cmake_macros/gnu_anlgce.cmake b/cime_config/machines/cmake_macros/gnu_anlgce.cmake new file mode 100644 index 000000000000..4a05cc9f4de4 --- /dev/null +++ b/cime_config/machines/cmake_macros/gnu_anlgce.cmake @@ -0,0 +1,15 @@ +if (NOT DEBUG) + string(APPEND CFLAGS " -O2") +endif() +set(CXX_LIBS "-lstdc++") +if (NOT DEBUG) + string(APPEND FFLAGS " -O2") +endif() +string(APPEND FFLAGS " -fallow-argument-mismatch -fallow-invalid-boz") +execute_process(COMMAND $ENV{NETCDF_PATH}/bin/nf-config --flibs OUTPUT_VARIABLE SHELL_CMD_OUTPUT_BUILD_INTERNAL_IGNORE0 OUTPUT_STRIP_TRAILING_WHITESPACE) +execute_process(COMMAND $ENV{NETCDF_PATH}/bin/nc-config --libs OUTPUT_VARIABLE SHELL_CMD_OUTPUT_BUILD_INTERNAL_IGNORE1 OUTPUT_STRIP_TRAILING_WHITESPACE) +string(APPEND SLIBS " ${SHELL_CMD_OUTPUT_BUILD_INTERNAL_IGNORE0} ${SHELL_CMD_OUTPUT_BUILD_INTERNAL_IGNORE1} -lblas -llapack") +set(NETCDF_PATH "$ENV{NETCDF_PATH}") +set(PNETCDF_PATH "$ENV{PNETCDF_PATH}") +set(HDF5_PATH "$ENV{HDF5_PATH}") +set(ZLIB_PATH "$ENV{ZLIB_PATH}") From f2646111cfcc0a1cc4e002752d30c28468bfbdc4 Mon Sep 17 00:00:00 2001 From: jayeshkrishna Date: Thu, 7 Oct 2021 11:38:33 -0500 Subject: [PATCH 112/467] Force PE layout with 16 procs on anlgce Using the same PE layout as anlworkstation (old ANL compute nodes) for the new ANL CELS compute nodes --- cime_config/allactive/config_pesall.xml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/cime_config/allactive/config_pesall.xml b/cime_config/allactive/config_pesall.xml index e850789d5744..15f6f5b25b48 100644 --- a/cime_config/allactive/config_pesall.xml +++ b/cime_config/allactive/config_pesall.xml @@ -1543,7 +1543,7 @@ - + none From 26b868fd27926dedd854ce76362507f9b66e5c7f Mon Sep 17 00:00:00 2001 From: jayeshkrishna Date: Wed, 22 Sep 2021 10:56:30 -0500 Subject: [PATCH 113/467] Adding support for ANL GCE nodes Adding support for the ANL CELS GCE compute nodes --- cime_config/machines/config_compilers.xml | 20 ++++++- cime_config/machines/config_machines.xml | 65 +++++++++++++++++++++++ 2 files changed, 84 insertions(+), 1 deletion(-) diff --git a/cime_config/machines/config_compilers.xml b/cime_config/machines/config_compilers.xml index 43006119dcd7..a4e86f527659 100644 --- a/cime_config/machines/config_compilers.xml +++ b/cime_config/machines/config_compilers.xml @@ -693,7 +693,25 @@ flags should be captured within MPAS CMake files. $ENV{NETCDF_PATH} $ENV{PNETCDF_PATH} $ENV{HDF5_PATH} - $ENV{SZIP_PATH} + + + + + -O2 + + + -lstdc++ + + + -O2 + -fallow-argument-mismatch -fallow-invalid-boz + + + $SHELL{$ENV{NETCDF_PATH}/bin/nf-config --flibs} $SHELL{$ENV{NETCDF_PATH}/bin/nc-config --libs} -lblas -llapack + + $ENV{NETCDF_PATH} + $ENV{PNETCDF_PATH} + $ENV{HDF5_PATH} $ENV{ZLIB_PATH} TRUE diff --git a/cime_config/machines/config_machines.xml b/cime_config/machines/config_machines.xml index 24f4c5bccd43..06d5fdccacd6 100644 --- a/cime_config/machines/config_machines.xml +++ b/cime_config/machines/config_machines.xml @@ -860,6 +860,71 @@ + + ANL CELS General Computing Environment (Linux) workstation + compute-(240|386)-[0-9][0-9] + LINUX + gnu + mpich + /scratch/$ENV{USER}/e3sm/timings + .* + /scratch/$ENV{USER}/e3sm/scratch + /nfs/gce/projects/climate/inputdata + $DIN_LOC_ROOT/atm/datm7 + $CIME_OUTPUT_ROOT/archive/$CASE + /nfs/gce/projects/climate/e3sm/baselines/$COMPILER + /nfs/gce/projects/climate/e3sm/cprnc/build/cprnc + make + 8 + e3sm_developer + none + jayesh at mcs dot anl dot gov + 16 + 16 + + mpirun + + -l -np {{ total_tasks }} + + + + /nfs/gce/software/spack/opt/spack/linux-ubuntu18.04-x86_64/gcc-7.3.0/lmod-7.7.29-zg24dcc/lmod/lmod/init/env_modules_python.py + /nfs/gce/software/spack/opt/spack/linux-ubuntu18.04-x86_64/gcc-7.3.0/lmod-7.7.29-zg24dcc/lmod/lmod/init/perl + /nfs/gce/software/spack/opt/spack/linux-ubuntu18.04-x86_64/gcc-7.3.0/lmod-7.7.29-zg24dcc/lmod/lmod/init/bash + /nfs/gce/software/spack/opt/spack/linux-ubuntu18.04-x86_64/gcc-7.3.0/lmod-7.7.29-zg24dcc/lmod/lmod/init/sh + /nfs/gce/software/spack/opt/spack/linux-ubuntu18.04-x86_64/gcc-7.3.0/lmod-7.7.29-zg24dcc/lmod/lmod/init/csh + /nfs/gce/software/spack/opt/spack/linux-ubuntu18.04-x86_64/gcc-7.3.0/lmod-7.7.29-zg24dcc/lmod/lmod/libexec/lmod python + module + module + module + module + + + autoconf/2.69-tz6eue5 + automake/1.16.3-fm5m6qc + libtool/2.4.6-jdxbjft + m4/1.4.19-wq3bm42 + cmake/3.20.5-yjp2hz6 + gcc/11.1.0-5ikoznk + zlib/1.2.11-smoyzzo + + + $CIME_OUTPUT_ROOT/$CASE/run + $CIME_OUTPUT_ROOT/$CASE/bld + + + /nfs/gce/projects/climate/software/mpich/3.4.2/gcc-11.1.0/lib:$ENV{LD_LIBRARY_PATH} + /nfs/gce/projects/climate/software/mpich/3.4.2/gcc-11.1.0/bin:$ENV{PATH} + /nfs/gce/software/spack/opt/spack/linux-ubuntu18.04-x86_64/gcc-7.5.0/zlib-1.2.11-smoyzzo + /nfs/gce/projects/climate/software/hdf5/1.12.1/mpich-3.4.2/gcc-11.1.0 + /nfs/gce/projects/climate/software/netcdf/4.8.1c-4.3.1cxx-4.5.3f-parallel/mpich-3.4.2/gcc-11.1.0 + /nfs/gce/projects/climate/software/pnetcdf/1.12.2/mpich-3.4.2/gcc-11.1.0 + + + 64M + + + SNL clust (skybridge|chama) From 0a99749a68411e82c149a61e2c26771cc7c099fa Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Wed, 27 Oct 2021 13:46:56 -0500 Subject: [PATCH 114/467] use the new load map use the target mesh distribution (so distribute the map by rows) it will avoid using a new ocean instance on coupler, just use the existing one still need to instantiate the river runoff mesh on coupler side, for migration of the tag later --- driver-moab/main/prep_ocn_mod.F90 | 7 ++++--- driver-moab/main/seq_map_mod.F90 | 13 ++++++++++--- 2 files changed, 14 insertions(+), 6 deletions(-) diff --git a/driver-moab/main/prep_ocn_mod.F90 b/driver-moab/main/prep_ocn_mod.F90 index 04d4b9b4172e..1973df2a062a 100644 --- a/driver-moab/main/prep_ocn_mod.F90 +++ b/driver-moab/main/prep_ocn_mod.F90 @@ -177,7 +177,7 @@ subroutine prep_ocn_init(infodata, atm_c2_ocn, atm_c2_ice, ice_c2_ocn, rof_c2_oc character*32 :: appname ! to register moab app integer :: rmapid ! external id to identify the moab app - integer :: ierr ! + integer :: ierr, type_grid ! !--------------------------------------------------------------- call seq_infodata_getData(infodata , & @@ -343,8 +343,9 @@ subroutine prep_ocn_init(infodata, atm_c2_ocn, atm_c2_ice, ice_c2_ocn, rof_c2_oc write(logunit,*) subname,' error in registering rof 2 ocn moab map ' call shr_sys_abort(subname//' ERROR in registering rof 2 ocn moab map ') endif - - call moab_map_init_rcfile(mbrmapro, rof(1), ocn(1), & + ! integer, public :: mboxid ! iMOAB id for mpas ocean migrated mesh to coupler pes + type_grid = 3 ! this is type of grid, maybe should be saved on imoab app ? + call moab_map_init_rcfile(mbrmapro, mboxid, type_grid, rof(1), ocn(1), & 'seq_maps.rc', 'rof2ocn_liq_rmapname:', 'rof2ocn_liq_rmaptype:',samegrid_ro, & 'mapper_Rr2o_liq moab initialization',esmf_map_flag) diff --git a/driver-moab/main/seq_map_mod.F90 b/driver-moab/main/seq_map_mod.F90 index 274556dea987..9d68600aaaae 100644 --- a/driver-moab/main/seq_map_mod.F90 +++ b/driver-moab/main/seq_map_mod.F90 @@ -160,7 +160,7 @@ subroutine seq_map_init_rcfile( mapper, comp_s, comp_d, & end subroutine seq_map_init_rcfile - subroutine moab_map_init_rcfile( mbappid, comp_s, comp_d, & + subroutine moab_map_init_rcfile( mbappid, mbtsid, type_grid, comp_s, comp_d, & maprcfile, maprcname, maprctype, samegrid, string, esmf_map) use iMOAB, only: iMOAB_LoadMappingWeightsFromFile @@ -170,6 +170,8 @@ subroutine moab_map_init_rcfile( mbappid, comp_s, comp_d, & ! Arguments ! type(integer) ,intent(in) :: mbappid ! moab app id, identifing the map from source to target + type(integer) ,intent(in) :: mbtsid ! moab app id, identifying the target (now), for row based distribution + type(integer) ,intent(in) :: type_grid ! 1 for SE, 2 for PC, 3 for FV; should be a member data type(component_type) ,intent(inout) :: comp_s type(component_type) ,intent(inout) :: comp_d character(len=*) ,intent(in) :: maprcfile @@ -190,8 +192,10 @@ subroutine moab_map_init_rcfile( mbappid, comp_s, comp_d, & integer(IN) :: mapid character(CX) :: sol_identifier ! /* "scalar", "flux", "custom" */ integer :: ierr + integer :: col_or_row ! 0 for row based, 1 for col based (we use row distribution now) + - character(len=*),parameter :: subname = "(seq_map_init_rcfile) " + character(len=*),parameter :: subname = "(moab_map_init_rcfile) " !----------------------------------------------------- if (seq_comm_iamroot(CPLID) .and. present(string)) then @@ -208,7 +212,10 @@ subroutine moab_map_init_rcfile( mbappid, comp_s, comp_d, & if (seq_comm_iamroot(CPLID)) then write(logunit,*) subname,' reading map file with iMOAB: ', mapfile_term endif - ierr = iMOAB_LoadMappingWeightsFromFile( mbappid, sol_identifier, mapfile_term) + + col_or_row = 0 ! row based distribution + + ierr = iMOAB_LoadMappingWeights( mbappid, mbtsid, col_or_row, type_grid, sol_identifier, mapfile_term) if (ierr .ne. 0) then write(logunit,*) subname,' error in loading map file' call shr_sys_abort(subname//' ERROR in loading map file') From 91b7d934b323e1adaffa6d6fcabd337fe0b3fea7 Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Wed, 27 Oct 2021 14:34:47 -0500 Subject: [PATCH 115/467] register imoab app for rof on coupler, in ocean context we cannot migrate rof mesh to coupler in ocean context here it has to be over rof - coupler communicator --- driver-moab/main/prep_ocn_mod.F90 | 9 +++++++++ driver-moab/shr/seq_comm_mct.F90 | 2 ++ 2 files changed, 11 insertions(+) diff --git a/driver-moab/main/prep_ocn_mod.F90 b/driver-moab/main/prep_ocn_mod.F90 index 1973df2a062a..97f081278d74 100644 --- a/driver-moab/main/prep_ocn_mod.F90 +++ b/driver-moab/main/prep_ocn_mod.F90 @@ -14,6 +14,7 @@ module prep_ocn_mod use seq_comm_mct, only: mpoid ! iMOAB pid for ocean mesh on component pes use seq_comm_mct, only: mboxid ! iMOAB id for mpas ocean migrated mesh to coupler pes use seq_comm_mct, only: mbrmapro ! iMOAB id for map read from rof2ocn map file + use seq_comm_mct, only: mbrxoid ! iMOAB id for rof on coupler in ocean context; use seq_comm_mct, only : seq_comm_getinfo => seq_comm_setptrs use seq_infodata_mod, only: seq_infodata_type, seq_infodata_getdata @@ -348,6 +349,14 @@ subroutine prep_ocn_init(infodata, atm_c2_ocn, atm_c2_ice, ice_c2_ocn, rof_c2_oc call moab_map_init_rcfile(mbrmapro, mboxid, type_grid, rof(1), ocn(1), & 'seq_maps.rc', 'rof2ocn_liq_rmapname:', 'rof2ocn_liq_rmaptype:',samegrid_ro, & 'mapper_Rr2o_liq moab initialization',esmf_map_flag) + appname = "ROF_COU"//CHAR(0) + ! rmapid is a unique external number of MOAB app that identifies runoff on coupler side + rmapid = rof(1)%cplcompid + ierr = iMOAB_RegisterApplicationFortran(trim(appname), mpicom_CPLID, rmapid, mbrxoid) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in registering rof on coupler in ocean context ' + call shr_sys_abort(subname//' ERROR in registering rof on coupler in ocean context ') + endif if (iamroot_CPLID) then write(logunit,*) ' ' diff --git a/driver-moab/shr/seq_comm_mct.F90 b/driver-moab/shr/seq_comm_mct.F90 index 85315b54e5c6..3d280b82ad14 100644 --- a/driver-moab/shr/seq_comm_mct.F90 +++ b/driver-moab/shr/seq_comm_mct.F90 @@ -230,6 +230,7 @@ module seq_comm_mct integer, public :: mbrxid ! iMOAB id of moab rof migrated to coupler pes 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) integer, public :: num_moab_exports ! iMOAB id for atm phys grid, on atm pes @@ -634,6 +635,7 @@ subroutine seq_comm_init(global_comm_in, driver_comm_in, nmlfile, drv_comm_id) mrofid = -1 ! iMOAB id of moab rof app mbrxid = -1 ! iMOAB id of moab rof migrated to coupler mbrmapro = -1 ! iMOAB id of moab instance of map read from rof2ocn map file + mbrxoid = -1 ! iMOAB id of moab instance rof to coupler in ocean context num_moab_exports = 0 ! mostly used in debugging deallocate(comps,comms) From 41e0c6bf83144d0ef80f9d6cf57cd54a21502884 Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Thu, 28 Oct 2021 20:24:53 -0500 Subject: [PATCH 116/467] implement prep_rof_ocn_moab does the migration of rof mesh (point cloud) to the coupler, according to ocean distribution, after map is read from file --- driver-moab/main/cime_comp_mod.F90 | 3 ++ driver-moab/main/prep_rof_mod.F90 | 75 ++++++++++++++++++++++++++++++ 2 files changed, 78 insertions(+) diff --git a/driver-moab/main/cime_comp_mod.F90 b/driver-moab/main/cime_comp_mod.F90 index 207372280bff..2ea27c769c92 100644 --- a/driver-moab/main/cime_comp_mod.F90 +++ b/driver-moab/main/cime_comp_mod.F90 @@ -1960,6 +1960,9 @@ subroutine cime_init() ! need to finish up the computation of the atm - land map ( point cloud) if (iamin_CPLALLATMID .and. atm_c2_lnd) call prep_atm_lnd_moab(infodata) + ! need to finish up the migration of mesh for rof 2 ocn map ( read from file) + if (iamin_CPLALLROFID .and. rof_c2_ocn) call prep_rof_ocn_moab(infodata) + !---------------------------------------------------------- !| Update aream in domains where appropriate !---------------------------------------------------------- diff --git a/driver-moab/main/prep_rof_mod.F90 b/driver-moab/main/prep_rof_mod.F90 index d45f607675cf..88e0541b6b29 100644 --- a/driver-moab/main/prep_rof_mod.F90 +++ b/driver-moab/main/prep_rof_mod.F90 @@ -8,6 +8,9 @@ module prep_rof_mod use shr_sys_mod, only: shr_sys_abort, shr_sys_flush use seq_comm_mct, only: num_inst_lnd, num_inst_rof, num_inst_frc, num_inst_atm use seq_comm_mct, only: CPLID, ROFID, logunit + use seq_comm_mct, only: mrofid ! id for rof comp + use seq_comm_mct, only: mbrmapro ! iMOAB id of moab instance of map read from rof2ocn map file + use seq_comm_mct, only: mbrxoid ! iMOAB id for rof instance on coupler for ocn use seq_comm_mct, only: seq_comm_getData=>seq_comm_setptrs use seq_infodata_mod, only: seq_infodata_type, seq_infodata_getdata use shr_log_mod , only: errMsg => shr_log_errMsg @@ -48,6 +51,7 @@ module prep_rof_mod public :: prep_rof_get_mapper_Sa2r public :: prep_rof_get_mapper_Fa2r + public :: prep_rof_ocn_moab !-------------------------------------------------------------------------- ! Private interfaces !-------------------------------------------------------------------------- @@ -252,6 +256,77 @@ subroutine prep_rof_init(infodata, lnd_c2_rof, atm_c2_rof) end subroutine prep_rof_init + subroutine prep_rof_ocn_moab(infodata) +!--------------------------------------------------------------- + ! Description + ! After loading of rof 2 ocn map, migrate the rof mesh to coupler + ! and create the comm graph between rof comp and rof instance on coupler + ! this is a similar call compared to prep_atm_ocn_moab, that + ! computes the comm graph after intersection + ! + ! Arguments + type(seq_infodata_type) , intent(in) :: infodata + + character(*), parameter :: subname = '(prep_rof_ocn_moab)' + integer :: ierr + + logical :: rof_present ! .true. => rof is present + logical :: ocn_present ! .true. => ocn is present + integer :: id_join + integer :: rank_on_cpl ! just for debugging + integer :: mpicom_join + integer :: context_id ! used to define context for coverage (this case, runoff on coupler) + integer :: rof_id + + integer :: mpigrp_CPLID ! coupler pes group, used for comm graph phys <-> rof-ocn, to migrate map mesh + integer :: mpigrp_rof ! component group pes (rof ) == rof group + integer :: typeA ! type for computing graph, in this case it is 2 (point cloud) + integer :: direction ! will be 1, source to coupler + character*32 :: prefix_output ! for writing a coverage file for debugging + + integer, external :: iMOAB_MigrateMapMeshFortran, iMOAB_WriteLocalMesh + + call seq_infodata_getData(infodata, & + rof_present=rof_present, & + ocn_present=ocn_present) + + ! it involves initial rof app; mhid; also migrate rof mesh on coupler pes, in ocean context, mbrxoid + ! map between rof 2 ocn is in mbrmapro ; + ! after this, the sending of tags from rof pes to coupler pes will use the new par comm graph, that has more precise info about + ! how to get mpicomm for joint rof + coupler + id_join = rof(1)%cplcompid + rof_id = rof(1)%compid + + context_id = rof(1)%cplcompid ! maybe it should be clear it is for ocean ? + call seq_comm_getData(ID_join,mpicom=mpicom_join) ! this is joint comm + + call seq_comm_getData(CPLID ,mpigrp=mpigrp_CPLID) ! second group, the coupler group CPLID is global variable + call seq_comm_getData(rof_id, mpigrp=mpigrp_rof) ! component group pes, from rof id ( also ROFID(1) ) + typeA = 2 ! point cloud + direction = 1 ! + ierr = iMOAB_MigrateMapMeshFortran (mrofid, mbrmapro, mbrxoid, mpicom_join, mpigrp_rof, & + mpigrp_CPLID, typeA, rof_id, id_join, direction) + + if (ierr .ne. 0) then + write(logunit,*) subname,' error in migrating rof mesh for map rof c2 ocn ' + call shr_sys_abort(subname//' ERROR in migrating rof mesh for map rof c2 ocn ') + endif + write(logunit,*) subname,' migrate mesh for map rof 2 ocn ' +#ifdef MOABDEBUG + call seq_comm_getData(CPLID ,mpicom=mpicom_CPLID) + if (mbrxoid.ge.0) then ! we are on coupler PEs + call mpi_comm_rank(mpicom_CPLID, rank_on_cpl , ierr) + prefix_output = "rof_cov"//CHAR(0) + if (rank_on_cpl .lt. 16) then + ierr = iMOAB_WriteLocalMesh(mbrxoid, prefix_output) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in writing coverage mesh rof 2 ocn ' + endif + endif + endif +#endif + + end subroutine prep_rof_ocn_moab !================================================================================================ subroutine prep_rof_accum_lnd(timer) From 0adfac43a92b9744044c3a5486da5a752fc5bbdd Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Mon, 15 Nov 2021 17:16:57 -0600 Subject: [PATCH 117/467] start prep rof --- components/mosart/src/cpl/rof_comp_mct.F90 | 10 ++++++++++ driver-moab/main/cime_comp_mod.F90 | 1 + driver-moab/main/prep_ocn_mod.F90 | 2 +- driver-moab/main/prep_rof_mod.F90 | 16 +++++++++++++++- 4 files changed, 27 insertions(+), 2 deletions(-) diff --git a/components/mosart/src/cpl/rof_comp_mct.F90 b/components/mosart/src/cpl/rof_comp_mct.F90 index 5ebc31cc805b..9b72a8a5f6af 100644 --- a/components/mosart/src/cpl/rof_comp_mct.F90 +++ b/components/mosart/src/cpl/rof_comp_mct.F90 @@ -76,6 +76,7 @@ module rof_comp_mct ! #ifdef HAVE_MOAB private :: init_rof_moab ! create moab mesh (cloud of points) + private :: rof_export_moab ! Export the river runoff model data to the MOAB coupler #endif ! PRIVATE DATA MEMBERS: @@ -398,6 +399,10 @@ subroutine rof_run_mct( EClock, cdata_r, x2r_r, r2x_r) ! Map roff data to MCT datatype (input is rtmCTL%runoff, output is r2x_r) call t_startf ('lc_rof_export') call rof_export_mct( r2x_r ) +#ifdef HAVE_MOAB + ! Map roff data to MOAB datatype ; load fields/tags in MOAB from rtmCTL%runoff + call rof_export_moab() +#endif call t_stopf ('lc_rof_export') ! Check that internal clock is in sync with master clock @@ -881,4 +886,9 @@ subroutine init_rof_moab() end subroutine init_rof_moab #endif +subroutine rof_export_moab() + +end subroutine rof_export_moab + + end module rof_comp_mct diff --git a/driver-moab/main/cime_comp_mod.F90 b/driver-moab/main/cime_comp_mod.F90 index 2ea27c769c92..790b11f059f3 100644 --- a/driver-moab/main/cime_comp_mod.F90 +++ b/driver-moab/main/cime_comp_mod.F90 @@ -4611,6 +4611,7 @@ subroutine cime_run_rof_recv_post() mpicom_barrier=mpicom_CPLALLROFID, run_barriers=run_barriers, & timer_barrier='CPL:R2C_BARRIER', timer_comp_exch='CPL:R2C', & timer_map_exch='CPL:r2c_rofr2rofx', timer_infodata_exch='CPL:r2c_infoexch') + call prep_rof_migrate_moab(infodata) endif !---------------------------------------------------------- diff --git a/driver-moab/main/prep_ocn_mod.F90 b/driver-moab/main/prep_ocn_mod.F90 index 97f081278d74..bc047e5335c9 100644 --- a/driver-moab/main/prep_ocn_mod.F90 +++ b/driver-moab/main/prep_ocn_mod.F90 @@ -344,7 +344,7 @@ subroutine prep_ocn_init(infodata, atm_c2_ocn, atm_c2_ice, ice_c2_ocn, rof_c2_oc write(logunit,*) subname,' error in registering rof 2 ocn moab map ' call shr_sys_abort(subname//' ERROR in registering rof 2 ocn moab map ') endif - ! integer, public :: mboxid ! iMOAB id for mpas ocean migrated mesh to coupler pes + ! integer, public :: mboxid ! iMOAB id for mpas ocean already migrated mesh to coupler pes type_grid = 3 ! this is type of grid, maybe should be saved on imoab app ? call moab_map_init_rcfile(mbrmapro, mboxid, type_grid, rof(1), ocn(1), & 'seq_maps.rc', 'rof2ocn_liq_rmapname:', 'rof2ocn_liq_rmaptype:',samegrid_ro, & diff --git a/driver-moab/main/prep_rof_mod.F90 b/driver-moab/main/prep_rof_mod.F90 index 88e0541b6b29..9432ea34eb14 100644 --- a/driver-moab/main/prep_rof_mod.F90 +++ b/driver-moab/main/prep_rof_mod.F90 @@ -51,7 +51,7 @@ module prep_rof_mod public :: prep_rof_get_mapper_Sa2r public :: prep_rof_get_mapper_Fa2r - public :: prep_rof_ocn_moab + public :: prep_rof_ocn_moab, prep_rof_migrate_moab !-------------------------------------------------------------------------- ! Private interfaces !-------------------------------------------------------------------------- @@ -328,7 +328,21 @@ subroutine prep_rof_ocn_moab(infodata) end subroutine prep_rof_ocn_moab !================================================================================================ + subroutine prep_rof_migrate_moab(infodata) + !--------------------------------------------------------------- + ! Description + ! After a2oTbot, a2oUbot, a2oVbot tags were loaded on rof mesh, + ! they need to be migrated to the coupler pes, for weight application later + ! + ! Arguments + type(seq_infodata_type) , intent(in) :: infodata + + character(*), parameter :: subname = '(prep_rof_migrate_moab)' + integer :: ierr + ! end copy + end subroutine prep_rof_migrate_moab + !================================================================================================ subroutine prep_rof_accum_lnd(timer) !--------------------------------------------------------------- From dcd39cba601105314bef0cc5dfc394ee9e1fccc7 Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Tue, 23 Nov 2021 20:53:26 -0600 Subject: [PATCH 118/467] finish rebase to use-moab-driver after iso fortran --- driver-moab/main/prep_ocn_mod.F90 | 4 ++-- driver-moab/main/prep_rof_mod.F90 | 7 +++---- driver-moab/main/seq_map_mod.F90 | 2 +- 3 files changed, 6 insertions(+), 7 deletions(-) diff --git a/driver-moab/main/prep_ocn_mod.F90 b/driver-moab/main/prep_ocn_mod.F90 index bc047e5335c9..d283f2242852 100644 --- a/driver-moab/main/prep_ocn_mod.F90 +++ b/driver-moab/main/prep_ocn_mod.F90 @@ -349,10 +349,10 @@ subroutine prep_ocn_init(infodata, atm_c2_ocn, atm_c2_ice, ice_c2_ocn, rof_c2_oc call moab_map_init_rcfile(mbrmapro, mboxid, type_grid, rof(1), ocn(1), & 'seq_maps.rc', 'rof2ocn_liq_rmapname:', 'rof2ocn_liq_rmaptype:',samegrid_ro, & 'mapper_Rr2o_liq moab initialization',esmf_map_flag) - appname = "ROF_COU"//CHAR(0) + appname = "ROF_COU"//C_NULL_CHAR ! rmapid is a unique external number of MOAB app that identifies runoff on coupler side rmapid = rof(1)%cplcompid - ierr = iMOAB_RegisterApplicationFortran(trim(appname), mpicom_CPLID, rmapid, mbrxoid) + ierr = iMOAB_RegisterApplication(trim(appname), mpicom_CPLID, rmapid, mbrxoid) if (ierr .ne. 0) then write(logunit,*) subname,' error in registering rof on coupler in ocean context ' call shr_sys_abort(subname//' ERROR in registering rof on coupler in ocean context ') diff --git a/driver-moab/main/prep_rof_mod.F90 b/driver-moab/main/prep_rof_mod.F90 index 9432ea34eb14..d8d862e017bb 100644 --- a/driver-moab/main/prep_rof_mod.F90 +++ b/driver-moab/main/prep_rof_mod.F90 @@ -265,8 +265,9 @@ subroutine prep_rof_ocn_moab(infodata) ! computes the comm graph after intersection ! ! Arguments - type(seq_infodata_type) , intent(in) :: infodata + use iMOAB, only: iMOAB_MigrateMapMesh, iMOAB_WriteLocalMesh + type(seq_infodata_type) , intent(in) :: infodata character(*), parameter :: subname = '(prep_rof_ocn_moab)' integer :: ierr @@ -284,8 +285,6 @@ subroutine prep_rof_ocn_moab(infodata) integer :: direction ! will be 1, source to coupler character*32 :: prefix_output ! for writing a coverage file for debugging - integer, external :: iMOAB_MigrateMapMeshFortran, iMOAB_WriteLocalMesh - call seq_infodata_getData(infodata, & rof_present=rof_present, & ocn_present=ocn_present) @@ -304,7 +303,7 @@ subroutine prep_rof_ocn_moab(infodata) call seq_comm_getData(rof_id, mpigrp=mpigrp_rof) ! component group pes, from rof id ( also ROFID(1) ) typeA = 2 ! point cloud direction = 1 ! - ierr = iMOAB_MigrateMapMeshFortran (mrofid, mbrmapro, mbrxoid, mpicom_join, mpigrp_rof, & + ierr = iMOAB_MigrateMapMesh (mrofid, mbrmapro, mbrxoid, mpicom_join, mpigrp_rof, & mpigrp_CPLID, typeA, rof_id, id_join, direction) if (ierr .ne. 0) then diff --git a/driver-moab/main/seq_map_mod.F90 b/driver-moab/main/seq_map_mod.F90 index 9d68600aaaae..25898069db4a 100644 --- a/driver-moab/main/seq_map_mod.F90 +++ b/driver-moab/main/seq_map_mod.F90 @@ -163,7 +163,7 @@ end subroutine seq_map_init_rcfile subroutine moab_map_init_rcfile( mbappid, mbtsid, type_grid, comp_s, comp_d, & maprcfile, maprcname, maprctype, samegrid, string, esmf_map) - use iMOAB, only: iMOAB_LoadMappingWeightsFromFile + use iMOAB, only: iMOAB_LoadMappingWeights implicit none !----------------------------------------------------- ! From 75937f3a1a455343ce1c9ca820595b7202975882 Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Wed, 24 Nov 2021 09:46:58 -0600 Subject: [PATCH 119/467] finish export_rof_moab --- components/mosart/src/cpl/rof_comp_mct.F90 | 118 ++++++++++++++++++++- 1 file changed, 116 insertions(+), 2 deletions(-) diff --git a/components/mosart/src/cpl/rof_comp_mct.F90 b/components/mosart/src/cpl/rof_comp_mct.F90 index 9b72a8a5f6af..acf17c0efb6f 100644 --- a/components/mosart/src/cpl/rof_comp_mct.F90 +++ b/components/mosart/src/cpl/rof_comp_mct.F90 @@ -788,7 +788,7 @@ subroutine init_rof_moab() use shr_const_mod, only: SHR_CONST_PI use iMOAB, only : iMOAB_CreateVertices, iMOAB_WriteMesh, & iMOAB_DefineTagStorage, iMOAB_SetIntTagStorage, iMOAB_SetDoubleTagStorage, & - iMOAB_ResolveSharedEntities, iMOAB_CreateElements, iMOAB_MergeVertices, iMOAB_UpdateMeshInfo + iMOAB_ResolveSharedEntities, iMOAB_CreateElements, iMOAB_MergeVertices integer,allocatable :: gindex(:) ! Number the local grid points; used for global ID integer lsz ! keep local size @@ -873,6 +873,18 @@ subroutine init_rof_moab() if (ierr > 0 ) & call shr_sys_abort( sub//' Error: fail to set mask tag ') + ! define tags for data that will be sent to coupler + ! they will be associated to point cloud vertices + tagname='mbForr_rofl'//C_NULL_CHAR + tagtype = 1 ! dense, double + ierr = iMOAB_DefineTagStorage(mrofid, tagname, tagtype, numco, tagindex ) + if (ierr > 0 ) & + call shr_sys_abort( sub//' Error: fail to create mbForr_rofl tag ') + tagname='mbForr_rofi'//C_NULL_CHAR + ierr = iMOAB_DefineTagStorage(mrofid, tagname, tagtype, numco, tagindex ) + if (ierr > 0 ) & + call shr_sys_abort( sub//' Error: fail to create mbForr_rofi tag ') + deallocate(moab_vert_coords) deallocate(vgids) #ifdef MOABDEBUG @@ -884,11 +896,113 @@ subroutine init_rof_moab() call shr_sys_abort( sub//' Error: fail to write the moab runoff mesh file') #endif end subroutine init_rof_moab -#endif + subroutine rof_export_moab() + ! copy + !--------------------------------------------------------------------------- + ! DESCRIPTION: + ! Send the runoff model export state to the coupler + ! convert from m3/s to kg/m2s + ! + ! ARGUMENTS: + use seq_comm_mct, only: mrofid ! id of moab rof app + + use iMOAB, only : iMOAB_SetDoubleTagStorage, iMOAB_WriteMesh + implicit none + ! + ! LOCAL VARIABLES + integer :: ni, n, nt, nliq, nfrz, lsz, ierr, ent_type + integer, save :: num_mb_exports = 0 ! used for debugging + character(len=32), parameter :: sub = 'rof_export_moab' + real(r8), dimension(:), allocatable :: liqrof ! temporary + real(r8), dimension(:), allocatable :: icerof ! temporary + character*100 outfile, wopts, localmeshfile, tagname, lnum + !--------------------------------------------------------------------------- + + nliq = 0 + nfrz = 0 + do nt = 1,nt_rtm + if (trim(rtm_tracers(nt)) == 'LIQ') then + nliq = nt + endif + if (trim(rtm_tracers(nt)) == 'ICE') then + nfrz = nt + endif + enddo + if (nliq == 0 .or. nfrz == 0) then + write(iulog,*) trim(sub),': ERROR in rtm_tracers LIQ ICE ',nliq,nfrz,rtm_tracers + call shr_sys_abort() + endif + ! number the local grid + lsz = rtmCTL%lnumr + + allocate(liqrof(lsz) ) ! use it for setting fields (moab tags) + allocate(icerof(lsz) ) + liqrof(:) = 0.0 + icerof(:) = 0.0 + + ni = 0 + if ( ice_runoff )then + ! separate liquid and ice runoff + do n = rtmCTL%begr,rtmCTL%endr + ni = ni + 1 + liqrof(ni) = rtmCTL%direct(n,nliq) / (rtmCTL%area(n)*0.001_r8) + icerof(ni) = rtmCTL%direct(n,nfrz) / (rtmCTL%area(n)*0.001_r8) + if (rtmCTL%mask(n) >= 2) then + ! liquid and ice runoff are treated separately - this is what goes to the ocean + liqrof(ni) = liqrof(ni) + & + rtmCTL%runoff(n,nliq) / (rtmCTL%area(n)*0.001_r8) + icerof(ni) = icerof(ni) + & + rtmCTL%runoff(n,nfrz) / (rtmCTL%area(n)*0.001_r8) + if (ni > rtmCTL%lnumr) then + write(iulog,*) sub, ' : ERROR runoff count',n,ni + call shr_sys_abort( sub//' : ERROR runoff > expected' ) + endif + endif + end do + else + ! liquid and ice runoff added to liquid runoff, ice runoff is zero + do n = rtmCTL%begr,rtmCTL%endr + ni = ni + 1 + liqrof(ni) = & + (rtmCTL%direct(n,nfrz)+rtmCTL%direct(n,nliq)) / (rtmCTL%area(n)*0.001_r8) + if (rtmCTL%mask(n) >= 2) then + liqrof(ni) = liqrof(ni) + & + (rtmCTL%runoff(n,nfrz)+rtmCTL%runoff(n,nliq)) / (rtmCTL%area(n)*0.001_r8) + if (ni > rtmCTL%lnumr) then + write(iulog,*) sub, ' : ERROR runoff count',n,ni + call shr_sys_abort( sub//' : ERROR runoff > expected' ) + endif + endif + end do + end if + tagname='mbForr_rofl'//C_NULL_CHAR + ent_type = 0 ! vertices + ierr = iMOAB_SetDoubleTagStorage ( mrofid, tagname, lsz , ent_type, liqrof ) + if (ierr > 0 ) & + call shr_sys_abort( sub//' Error: fail to set mbForr_rofl tag ') + tagname='mbForr_rofi'//C_NULL_CHAR + ierr = iMOAB_SetDoubleTagStorage ( mrofid, tagname, lsz , ent_type, icerof ) + if (ierr > 0 ) & + call shr_sys_abort( sub//' Error: fail to set mbForr_rofi tag ') + +#ifdef MOABDEBUG + num_mb_exports = num_mb_exports +1 + write(lnum,"(I0.2)")num_mb_exports + outfile = 'wholeRof_'//trim(lnum)//'.h5m'//C_NULL_CHAR + wopts = 'PARALLEL=WRITE_PART'//C_NULL_CHAR + ierr = iMOAB_WriteMesh(mrofid, outfile, wopts) + if (ierr > 0 ) & + call shr_sys_abort( sub//' fail to write the runoff mesh file with data') +#endif + deallocate(liqrof) + deallocate(icerof) +! end copy end subroutine rof_export_moab +! end #ifdef HAVE_MOAB +#endif end module rof_comp_mct From 61202aa205b04e349d52f8b3ac8fa974ec211bc8 Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Wed, 24 Nov 2021 12:26:40 -0600 Subject: [PATCH 120/467] finish prep_rof_migrate_moab transfer fields from rof pes to coupler pes, then project using the map leaded from file, distributed according to ocean coupler dofs per task map is loaded by moab_map_init_rcfile, using new target load direction iMOAB_LoadMappingWeights (mbrmapro, mboxid,..) mesh is migrated from rof to coupler to create coverage fields liquid and ice runoff are migrated from rof to coverage rof, then applied towards ocean --- driver-moab/main/prep_rof_mod.F90 | 173 ++++++++++++++++++++++++++++-- driver-moab/main/seq_map_mod.F90 | 2 +- 2 files changed, 164 insertions(+), 11 deletions(-) diff --git a/driver-moab/main/prep_rof_mod.F90 b/driver-moab/main/prep_rof_mod.F90 index d8d862e017bb..177edb99deb4 100644 --- a/driver-moab/main/prep_rof_mod.F90 +++ b/driver-moab/main/prep_rof_mod.F90 @@ -11,6 +11,7 @@ module prep_rof_mod use seq_comm_mct, only: mrofid ! id for rof comp use seq_comm_mct, only: mbrmapro ! iMOAB id of moab instance of map read from rof2ocn map file use seq_comm_mct, only: mbrxoid ! iMOAB id for rof instance on coupler for ocn + use seq_comm_mct, only: mboxid ! iMOAB id for mpas ocean migrated mesh to coupler pes use seq_comm_mct, only: seq_comm_getData=>seq_comm_setptrs use seq_infodata_mod, only: seq_infodata_type, seq_infodata_getdata use shr_log_mod , only: errMsg => shr_log_errMsg @@ -22,9 +23,12 @@ module prep_rof_mod use perf_mod use component_type_mod, only: component_get_x2c_cx, component_get_c2x_cx use component_type_mod, only: rof, lnd, atm + use component_type_mod, only: ocn ! used for context for projection towards ocean from rof ! use prep_lnd_mod, only: prep_lnd_get_mapper_Fr2l use map_lnd2rof_irrig_mod, only: map_lnd2rof_irrig + use iso_c_binding + implicit none save private @@ -266,7 +270,7 @@ subroutine prep_rof_ocn_moab(infodata) ! ! Arguments - use iMOAB, only: iMOAB_MigrateMapMesh, iMOAB_WriteLocalMesh + use iMOAB, only: iMOAB_MigrateMapMesh, iMOAB_WriteLocalMesh, iMOAB_DefineTagStorage type(seq_infodata_type) , intent(in) :: infodata character(*), parameter :: subname = '(prep_rof_ocn_moab)' integer :: ierr @@ -284,6 +288,9 @@ subroutine prep_rof_ocn_moab(infodata) integer :: typeA ! type for computing graph, in this case it is 2 (point cloud) integer :: direction ! will be 1, source to coupler character*32 :: prefix_output ! for writing a coverage file for debugging + character*100 :: tagname ! define some tags for receiving later + integer :: tagtype, numco, tagindex ! for tag definition + logical :: iamroot_CPLID ! .true. => CPLID masterproc call seq_infodata_getData(infodata, & rof_present=rof_present, & @@ -293,7 +300,8 @@ subroutine prep_rof_ocn_moab(infodata) ! map between rof 2 ocn is in mbrmapro ; ! after this, the sending of tags from rof pes to coupler pes will use the new par comm graph, that has more precise info about ! how to get mpicomm for joint rof + coupler - id_join = rof(1)%cplcompid + call seq_comm_getData(CPLID, mpicom=mpicom_CPLID, iamroot=iamroot_CPLID) + id_join = rof(1)%cplcompid ! migrate rof mesh towards ocean on coupler ! rof_id = rof(1)%compid context_id = rof(1)%cplcompid ! maybe it should be clear it is for ocean ? @@ -303,14 +311,53 @@ subroutine prep_rof_ocn_moab(infodata) call seq_comm_getData(rof_id, mpigrp=mpigrp_rof) ! component group pes, from rof id ( also ROFID(1) ) typeA = 2 ! point cloud direction = 1 ! + context_id = ocn(1)%cplcompid ierr = iMOAB_MigrateMapMesh (mrofid, mbrmapro, mbrxoid, mpicom_join, mpigrp_rof, & - mpigrp_CPLID, typeA, rof_id, id_join, direction) + mpigrp_CPLID, typeA, rof_id, context_id, direction) if (ierr .ne. 0) then write(logunit,*) subname,' error in migrating rof mesh for map rof c2 ocn ' call shr_sys_abort(subname//' ERROR in migrating rof mesh for map rof c2 ocn ') endif - write(logunit,*) subname,' migrate mesh for map rof 2 ocn ' + if (iamroot_CPLID) then + write(logunit,*) subname,' migrated mesh for map rof 2 ocn ' + endif + if (mbrxoid .ge. 0) then ! we are on coupler side pes + tagname='mbForr_rofl'//C_NULL_CHAR + tagtype = 1 ! dense, double + numco= 1 ! 1 scalar per node + ierr = iMOAB_DefineTagStorage(mbrxoid, tagname, tagtype, numco, tagindex ) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in defining mbForr_rofl tag ' + call shr_sys_abort(subname//' ERROR in defining mbForr_rofl tag ') + endif + tagname='mbForr_rofi'//C_NULL_CHAR + ierr = iMOAB_DefineTagStorage(mbrxoid, tagname, tagtype, numco, tagindex ) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in defining mbForr_rofi tag ' + call shr_sys_abort(subname//' ERROR in defining mbForr_rofi tag ') + endif + + endif + if (mboxid .ge. 0) then ! we are on coupled side, define the tags for projection on ocea coupler side + tagname='mbForr_rofl_proj'//C_NULL_CHAR + tagtype = 1 ! dense, double + numco= 1 ! 1 scalar per node + ierr = iMOAB_DefineTagStorage(mboxid, tagname, tagtype, numco, tagindex ) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in defining mbForr_rofl_proj tag ' + call shr_sys_abort(subname//' ERROR in defining mbForr_rofl_proj tag ') + endif + tagname='mbForr_rofi_proj'//C_NULL_CHAR + ierr = iMOAB_DefineTagStorage(mboxid, tagname, tagtype, numco, tagindex ) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in defining mbForr_rofi_proj tag ' + call shr_sys_abort(subname//' ERROR in defining mbForr_rofi_proj tag ') + endif + endif + if (iamroot_CPLID) then + write(logunit,*) subname,' created moab tags for mbForr_rofl, mbForr_rofi ' + endif #ifdef MOABDEBUG call seq_comm_getData(CPLID ,mpicom=mpicom_CPLID) if (mbrxoid.ge.0) then ! we are on coupler PEs @@ -326,19 +373,125 @@ subroutine prep_rof_ocn_moab(infodata) #endif end subroutine prep_rof_ocn_moab + !================================================================================================ subroutine prep_rof_migrate_moab(infodata) - !--------------------------------------------------------------- - ! Description - ! After a2oTbot, a2oUbot, a2oVbot tags were loaded on rof mesh, - ! they need to be migrated to the coupler pes, for weight application later - ! - ! Arguments + ! + use iMOAB, only: iMOAB_SendElementTag, iMOAB_ReceiveElementTag, iMOAB_FreeSenderBuffers, & + iMOAB_ApplyScalarProjectionWeights, iMOAB_WriteMesh + !--------------------------------------------------------------- + ! Description similar to prep_atm_migrate_moab; will also do the projection on coupler pes + ! After mbForr_rofl, mbForr_rofi tags were loaded on rof mesh, + ! they need to be migrated to the coupler pes, for weight application ; later, we will send it to ocean pes + ! + ! Arguments type(seq_infodata_type) , intent(in) :: infodata character(*), parameter :: subname = '(prep_rof_migrate_moab)' integer :: ierr + + logical :: rof_present ! .true. => rof is present + logical :: ocn_present ! .true. => ocn is present + + integer :: id_join + integer :: mpicom_join + integer :: rof_id + integer :: context_id ! we will use ocean context on coupler + integer, save :: num_prof = 0 ! use to count the projections + character*32 :: dm1, dm2, tagName, wgtIdef + character*50 :: outfile, wopts, tagnameProj, lnum + integer :: orderROF, orderOCN, volumetric, noConserve, validate + integer, save :: num_proj = 0 ! for counting projections + + + call seq_infodata_getData(infodata, & + rof_present=rof_present, & + ocn_present=ocn_present) + + ! it involves initial rof app; mesh on coupler pes, + ! use seq_comm_mct, only: mrofid ! id for rof comp + ! mbrmapro ! iMOAB id of moab instance of map read from rof2ocn map file + ! mbrxoid ! iMOAB id for rof instance on coupler for ocn ; it exists as a coverage mesh ! + + ! after this, the sending of tags from rof pes to coupler pes will use the par comm graph, that has more precise info about + ! how to get mpicomm for joint rof + coupler + id_join = rof(1)%cplcompid + rof_id = rof(1)%compid + + call seq_comm_getData(ID_join,mpicom=mpicom_join) ! this is the joint comm between rof and coupler + + ! we should do this only if ocn_present + context_id = ocn(1)%cplcompid + wgtIdef = 'map-from-file'//C_NULL_CHAR + tagName = 'mbForr_rofl;mbForr_rofi;'//C_NULL_CHAR + tagNameProj = 'mbForr_rofl_proj;mbForr_rofi_proj;'//C_NULL_CHAR + num_proj = num_proj + 1 + + if (rof_present .and. ocn_present) then + + if (mrofid .ge. 0) then ! send because we are on rof pes + + ! basically, adjust the migration of the tag we want to project; it was sent initially with + ! trivial partitioning, now we need to adjust it for "coverage" mesh + ! as always, use nonblocking sends + + context_id = ocn(1)%cplcompid !send to rof/ocn on coupler ! + ierr = iMOAB_SendElementTag(mrofid, tagName, mpicom_join, context_id) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in sending tag from rof to rof cover for ocn on coupler ' + call shr_sys_abort(subname//' ERROR in sending tag from rof to rof cover for ocn on coupler') + endif + + endif + + if (mbrxoid .ge. 0 ) then ! we are for sure on coupler pes! + ! + ierr = iMOAB_ReceiveElementTag(mbrxoid, tagName, mpicom_join, rof_id) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in receiving tag from rof to rof cover for ocn on coupler ' + call shr_sys_abort(subname//' ERROR in receiving tag from rof to rof cover for ocn on coupler ') + endif + + endif + ! we can now free the sender buffers + if (mrofid .ge. 0) then + ierr = iMOAB_FreeSenderBuffers(mrofid, context_id) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in freeing buffers' + call shr_sys_abort(subname//' ERROR in freeing buffers') + endif + endif + + + ! we could do the projection now, on the ocean mesh, because we are on the coupler pes; + ! the actual migrate could happen later , from coupler pes to the ocean pes + if (mbrmapro .ge. 0 ) then ! we are on coupler pes, for sure + ! we could apply weights; need to use the same weight identifier wgtIdef as when we generated it + ! hard coded now, it should be a runtime option in the future + + ierr = iMOAB_ApplyScalarProjectionWeights ( mbrmapro, wgtIdef, tagName, tagNameProj) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in applying weights ' + call shr_sys_abort(subname//' ERROR in applying weights') + endif +#ifdef MOABDEBUG + ! we can also write the ocean mesh to file, just to see the projectd tag + ! write out the mesh file to disk + write(lnum,"(I0.2)")num_proj + outfile = 'ocnProj_fromRof'//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 + write(logunit,*) subname,' error in writing ocn mesh after projection ' + call shr_sys_abort(subname//' ERROR in writing ocn mesh after projection') + endif +#endif + + !CHECKRC(ierr, "cannot receive tag values") + endif + + endif ! if rof and ocn ! end copy end subroutine prep_rof_migrate_moab !================================================================================================ diff --git a/driver-moab/main/seq_map_mod.F90 b/driver-moab/main/seq_map_mod.F90 index 25898069db4a..c62334896e58 100644 --- a/driver-moab/main/seq_map_mod.F90 +++ b/driver-moab/main/seq_map_mod.F90 @@ -207,7 +207,7 @@ subroutine moab_map_init_rcfile( mbappid, mbtsid, type_grid, comp_s, comp_d, & ! --- Initialize Smatp call shr_mct_queryConfigFile(mpicom,maprcfile,maprcname,mapfile,maprctype,maptype) !call shr_mct_sMatPInitnc(mapper%sMatp, mapper%gsMap_s, mapper%gsMap_d, trim(mapfile),trim(maptype),mpicom) - sol_identifier = 'scalar'//CHAR(0) + sol_identifier = 'map-from-file'//CHAR(0) mapfile_term = trim(mapfile)//CHAR(0) if (seq_comm_iamroot(CPLID)) then write(logunit,*) subname,' reading map file with iMOAB: ', mapfile_term From 5541406c44e18e37a7b7db593bc4a9efa96404e9 Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Sun, 28 Nov 2021 22:53:46 -0600 Subject: [PATCH 121/467] rename iMOAB_LoadMappingWeights to iMOAB_LoadMappingWeightsFromFile the old iMOAB_LoadMappingWeightsFromFile in moab is renamed iMOAB_LoadMappingWeightsFromFile_Old, but this is not called anymore on this branch it is called on the sarich/use-moab-driver --- driver-moab/main/seq_map_mod.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/driver-moab/main/seq_map_mod.F90 b/driver-moab/main/seq_map_mod.F90 index c62334896e58..cef9ec29e585 100644 --- a/driver-moab/main/seq_map_mod.F90 +++ b/driver-moab/main/seq_map_mod.F90 @@ -163,7 +163,7 @@ end subroutine seq_map_init_rcfile subroutine moab_map_init_rcfile( mbappid, mbtsid, type_grid, comp_s, comp_d, & maprcfile, maprcname, maprctype, samegrid, string, esmf_map) - use iMOAB, only: iMOAB_LoadMappingWeights + use iMOAB, only: iMOAB_LoadMappingWeightsFromFile implicit none !----------------------------------------------------- ! @@ -215,7 +215,7 @@ subroutine moab_map_init_rcfile( mbappid, mbtsid, type_grid, comp_s, comp_d, & col_or_row = 0 ! row based distribution - ierr = iMOAB_LoadMappingWeights( mbappid, mbtsid, col_or_row, type_grid, sol_identifier, mapfile_term) + ierr = iMOAB_LoadMappingWeightsFromFile( mbappid, mbtsid, col_or_row, type_grid, sol_identifier, mapfile_term) if (ierr .ne. 0) then write(logunit,*) subname,' error in loading map file' call shr_sys_abort(subname//' ERROR in loading map file') From a34cd72f8035d5fc04f693b2dd6ad24c74002a75 Mon Sep 17 00:00:00 2001 From: Jason Sarich Date: Wed, 1 Dec 2021 16:38:22 -0600 Subject: [PATCH 122/467] Update MOAB driver branch to be usable with GCE requires a patch to sbetr: cd components/elm/src/external_models/sbetr git merge 51be6d5 --- cime_config/machines/config_compilers.xml | 3 ++- cime_config/machines/config_machines.xml | 1 + components/mpas-seaice/driver/ice_comp_mct.F | 12 ++++++------ 3 files changed, 9 insertions(+), 7 deletions(-) diff --git a/cime_config/machines/config_compilers.xml b/cime_config/machines/config_compilers.xml index a4e86f527659..ac66ae5361c9 100644 --- a/cime_config/machines/config_compilers.xml +++ b/cime_config/machines/config_compilers.xml @@ -704,7 +704,7 @@ flags should be captured within MPAS CMake files. -O2 - -fallow-argument-mismatch -fallow-invalid-boz + -fno-tree-pta -fallow-argument-mismatch -fallow-invalid-boz $SHELL{$ENV{NETCDF_PATH}/bin/nf-config --flibs} $SHELL{$ENV{NETCDF_PATH}/bin/nc-config --libs} -lblas -llapack @@ -713,6 +713,7 @@ flags should be captured within MPAS CMake files. $ENV{PNETCDF_PATH} $ENV{HDF5_PATH} $ENV{ZLIB_PATH} + $ENV{MOAB_PATH} TRUE diff --git a/cime_config/machines/config_machines.xml b/cime_config/machines/config_machines.xml index 06d5fdccacd6..be86f871a153 100644 --- a/cime_config/machines/config_machines.xml +++ b/cime_config/machines/config_machines.xml @@ -919,6 +919,7 @@ /nfs/gce/projects/climate/software/hdf5/1.12.1/mpich-3.4.2/gcc-11.1.0 /nfs/gce/projects/climate/software/netcdf/4.8.1c-4.3.1cxx-4.5.3f-parallel/mpich-3.4.2/gcc-11.1.0 /nfs/gce/projects/climate/software/pnetcdf/1.12.2/mpich-3.4.2/gcc-11.1.0 + /nfs/gce/projects/climate/software/moab/devel/mpich-3.4.2/gcc-11.1.0 64M diff --git a/components/mpas-seaice/driver/ice_comp_mct.F b/components/mpas-seaice/driver/ice_comp_mct.F index 9d5bf9bd3be7..8e2459c485b6 100644 --- a/components/mpas-seaice/driver/ice_comp_mct.F +++ b/components/mpas-seaice/driver/ice_comp_mct.F @@ -2079,12 +2079,12 @@ subroutine ice_import_mct(x2i_i, errorCode)!{{{ oceanParticulateIronConc(2,i) = x2i_i % rAttr(index_x2i_So_fep2, n) oceanDissolvedIronConc(1,i) = x2i_i % rAttr(index_x2i_So_fed1, n) oceanDissolvedIronConc(2,i) = x2i_i % rAttr(index_x2i_So_fed2, n) - oceanZAerosolConc(1,i) = x2i_i % rAttr(index_x2i_So_zaer1, n) !JW not used, set to 0? - oceanZAerosolConc(2,i) = x2i_i % rAttr(index_x2i_So_zaer2, n) !JW not used, set to 0? - oceanZAerosolConc(3,i) = x2i_i % rAttr(index_x2i_So_zaer3, n) !JW not used, set to 0? - oceanZAerosolConc(4,i) = x2i_i % rAttr(index_x2i_So_zaer4, n) !JW not used, set to 0? - oceanZAerosolConc(5,i) = x2i_i % rAttr(index_x2i_So_zaer5, n) !JW not used, set to 0? - oceanZAerosolConc(6,i) = x2i_i % rAttr(index_x2i_So_zaer6, n) !JW not used, set to 0? + oceanZAerosolConc(1,i) = 0.0_RKIND + oceanZAerosolConc(2,i) = 0.0_RKIND + oceanZAerosolConc(3,i) = 0.0_RKIND + oceanZAerosolConc(4,i) = 0.0_RKIND + oceanZAerosolConc(5,i) = 0.0_RKIND + oceanZAerosolConc(6,i) = 0.0_RKIND ! set aerosols, if configured if (config_use_zaerosols) then if (config_use_modal_aerosols) then From cca9f7d70292a70c81c8e6036bd747bdf5249bdb Mon Sep 17 00:00:00 2001 From: Jason Sarich Date: Wed, 1 Dec 2021 17:11:28 -0600 Subject: [PATCH 123/467] apply 'source' to '.' fix on cime --- cime | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/cime b/cime index 7a2523af3baa..c53e3d1c3b48 160000 --- a/cime +++ b/cime @@ -1 +1 @@ -Subproject commit 7a2523af3baaed9f888b7bf778c5674b02204b89 +Subproject commit c53e3d1c3b4814270478352fc76a37f8b0d4284a From c09e0a24d81f2b8e1d3b5b0f6dcc2b4ac1cd816f Mon Sep 17 00:00:00 2001 From: Jason Sarich Date: Thu, 16 Dec 2021 13:17:55 -0600 Subject: [PATCH 124/467] Roll back GCE NETCDF to 4.3.0 Protect against possible NC_EHDFERR from nc_enddef() (See PR 4706) --- cime_config/machines/config_machines.xml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/cime_config/machines/config_machines.xml b/cime_config/machines/config_machines.xml index be86f871a153..d202ee47e93d 100644 --- a/cime_config/machines/config_machines.xml +++ b/cime_config/machines/config_machines.xml @@ -917,7 +917,7 @@ /nfs/gce/projects/climate/software/mpich/3.4.2/gcc-11.1.0/bin:$ENV{PATH} /nfs/gce/software/spack/opt/spack/linux-ubuntu18.04-x86_64/gcc-7.5.0/zlib-1.2.11-smoyzzo /nfs/gce/projects/climate/software/hdf5/1.12.1/mpich-3.4.2/gcc-11.1.0 - /nfs/gce/projects/climate/software/netcdf/4.8.1c-4.3.1cxx-4.5.3f-parallel/mpich-3.4.2/gcc-11.1.0 + /nfs/gce/projects/climate/software/netcdf/4.8.0c-4.3.1cxx-4.5.3f-parallel/mpich-3.4.2/gcc-11.1.0 /nfs/gce/projects/climate/software/pnetcdf/1.12.2/mpich-3.4.2/gcc-11.1.0 /nfs/gce/projects/climate/software/moab/devel/mpich-3.4.2/gcc-11.1.0 From 2e75ebdf05339d6d83ddd4db7366c8f195ca270d Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Mon, 20 Dec 2021 14:25:05 -0600 Subject: [PATCH 125/467] iMOAB_ComputeScalarProjectionWeights changes it has a new argument: fInverseDistanceMap --- driver-moab/main/prep_atm_mod.F90 | 18 ++++++++++++------ 1 file changed, 12 insertions(+), 6 deletions(-) diff --git a/driver-moab/main/prep_atm_mod.F90 b/driver-moab/main/prep_atm_mod.F90 index b48d1b335d27..eea06d0a1146 100644 --- a/driver-moab/main/prep_atm_mod.F90 +++ b/driver-moab/main/prep_atm_mod.F90 @@ -353,7 +353,7 @@ subroutine prep_atm_ocn_moab(infodata) integer :: context_id ! used to define context for coverage (this case, ocean on coupler) integer :: atm_id character*32 :: dm1, dm2, dofnameATM, dofnameOCN, wgtIdef - integer :: orderOCN, orderATM, volumetric, noConserve, validate + integer :: orderOCN, orderATM, volumetric, noConserve, validate, fInverseDistanceMap integer :: fNoBubble, monotonicity integer :: mpigrp_CPLID ! coupler pes group, used for comm graph phys <-> atm-ocn @@ -415,14 +415,18 @@ subroutine prep_atm_ocn_moab(infodata) monotonicity = 0 ! noConserve = 0 validate = 1 + fInverseDistanceMap = 0 if (iamroot_CPLID) then write(logunit,*) 'launch iMOAB weights with args ', mbintxoa, wgtIdef, & - trim(dm1), orderATM, trim(dm2), orderOCN, & - fNoBubble, monotonicity, volumetric, noConserve, validate + trim(dm1), orderATM, trim(dm2), orderOCN, & + fNoBubble, monotonicity, volumetric, fInverseDistanceMap, & + noConserve, validate, & + trim(dofnameATM), trim(dofnameOCN) end if ierr = iMOAB_ComputeScalarProjectionWeights ( mbintxoa, wgtIdef, & trim(dm1), orderATM, trim(dm2), orderOCN, & - fNoBubble, monotonicity, volumetric, noConserve, validate, & + fNoBubble, monotonicity, volumetric, fInverseDistanceMap, & + noConserve, validate, & trim(dofnameATM), trim(dofnameOCN) ) if (ierr .ne. 0) then write(logunit,*) subname,' error in computing weights atm/ocn ' @@ -496,7 +500,7 @@ subroutine prep_atm_lnd_moab(infodata) integer :: context_id ! used to define context for coverage (this case, land on coupler) integer :: atm_id character*32 :: dm1, dm2, dofnameATM, dofnameLND, wgtIdef - integer :: orderLND, orderATM, volumetric, noConserve, validate + integer :: orderLND, orderATM, volumetric, fInverseDistanceMap, noConserve, validate integer :: fNoBubble, monotonicity integer :: mpigrp_CPLID ! coupler pes group, used for comm graph phys <-> atm-ocn integer :: mpigrp_old ! component group pes (phys grid atm) == atm group @@ -560,10 +564,12 @@ subroutine prep_atm_lnd_moab(infodata) monotonicity = 0 ! noConserve = 0 validate = 1 + fInverseDistanceMap = 0 ierr = iMOAB_ComputeScalarProjectionWeights ( mbintxla, wgtIdef, & trim(dm1), orderATM, trim(dm2), orderLND, & - fNoBubble, monotonicity, volumetric, noConserve, validate, & + fNoBubble, monotonicity, volumetric, fInverseDistanceMap, & + noConserve, validate, & trim(dofnameATM), trim(dofnameLND) ) if (ierr .ne. 0) then write(logunit,*) subname,' error in computing weights atm land ' From 43ff7c1cec15a5b29048f36cac6841d76c598dd4 Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Mon, 20 Dec 2021 18:21:21 -0600 Subject: [PATCH 126/467] do not validate point cloud maps validate now checks against areas, that are not computed for land meshes inside tempestremap / point cloud --- driver-moab/main/prep_atm_mod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/driver-moab/main/prep_atm_mod.F90 b/driver-moab/main/prep_atm_mod.F90 index eea06d0a1146..aecd502113cf 100644 --- a/driver-moab/main/prep_atm_mod.F90 +++ b/driver-moab/main/prep_atm_mod.F90 @@ -563,7 +563,7 @@ subroutine prep_atm_lnd_moab(infodata) fNoBubble = 1 monotonicity = 0 ! noConserve = 0 - validate = 1 + validate = 0 fInverseDistanceMap = 0 ierr = iMOAB_ComputeScalarProjectionWeights ( mbintxla, wgtIdef, & From 2c38ddf89febb17876c3352f160b082731099e6d Mon Sep 17 00:00:00 2001 From: Jason Sarich Date: Mon, 10 Jan 2022 15:50:08 -0600 Subject: [PATCH 127/467] Remove unneeded cime directories --- cime | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/cime b/cime index c53e3d1c3b48..e53f289a7644 160000 --- a/cime +++ b/cime @@ -1 +1 @@ -Subproject commit c53e3d1c3b4814270478352fc76a37f8b0d4284a +Subproject commit e53f289a7644931fbc5e6b26cff4a21376ba3fba From bcf658e2bd16e57cf6c4b578036ea552e78362a8 Mon Sep 17 00:00:00 2001 From: Jason Sarich Date: Mon, 14 Feb 2022 15:47:35 -0600 Subject: [PATCH 128/467] update sbetr submodule for gnu10 --- components/elm/src/external_models/sbetr | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/components/elm/src/external_models/sbetr b/components/elm/src/external_models/sbetr index f3636700b354..51be6d5f8581 160000 --- a/components/elm/src/external_models/sbetr +++ b/components/elm/src/external_models/sbetr @@ -1 +1 @@ -Subproject commit f3636700b35441dbd30bf2921310a66f238d8e9e +Subproject commit 51be6d5f858145654d3c94c2985b3e347dd5a1d4 From 7212885aae2898b1ffa832a0aa06ddfd2e7421b2 Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Sun, 27 Mar 2022 23:20:52 -0500 Subject: [PATCH 129/467] replace separator with colon --- driver-moab/main/prep_atm_mod.F90 | 16 ++++++++-------- driver-moab/main/prep_lnd_mod.F90 | 2 +- driver-moab/main/prep_ocn_mod.F90 | 2 +- driver-moab/main/prep_rof_mod.F90 | 4 ++-- 4 files changed, 12 insertions(+), 12 deletions(-) diff --git a/driver-moab/main/prep_atm_mod.F90 b/driver-moab/main/prep_atm_mod.F90 index aecd502113cf..0c638b9a0d97 100644 --- a/driver-moab/main/prep_atm_mod.F90 +++ b/driver-moab/main/prep_atm_mod.F90 @@ -659,7 +659,7 @@ subroutine prep_atm_migrate_moab(infodata) context_id = ocn(1)%cplcompid wgtIdef = 'scalar'//C_NULL_CHAR - tagNameProj = 'a2oTbot_proj;a2oUbot_proj;a2oVbot_proj;'//C_NULL_CHAR + tagNameProj = 'a2oTbot_proj:a2oUbot_proj:a2oVbot_proj:'//C_NULL_CHAR num_proj = num_proj + 1 if (atm_present .and. ocn_present) then @@ -670,7 +670,7 @@ subroutine prep_atm_migrate_moab(infodata) ! basically, adjust the migration of the tag we want to project; it was sent initially with ! trivial partitioning, now we need to adjust it for "coverage" mesh ! as always, use nonblocking sends - tagName = 'T_ph;u_ph;v_ph;'//C_NULL_CHAR ! they are defined in initialize_moab_atm_phys in atm_comp_mct + tagName = 'T_ph:u_ph:v_ph:'//C_NULL_CHAR ! they are defined in initialize_moab_atm_phys in atm_comp_mct context_id = 100*atm(1)%cplcompid + ocn(1)%cplcompid !send to atm/ocn intx ! ierr = iMOAB_SendElementTag(mphaid, tagName, mpicom_join, context_id) if (ierr .ne. 0) then @@ -681,7 +681,7 @@ subroutine prep_atm_migrate_moab(infodata) endif if (mbintxoa .ge. 0 ) then ! we are for sure on coupler pes! - tagName = 'T_ph16;u_ph16;v_ph16;'//C_NULL_CHAR ! they are defined in cplcomp_exchange mod + tagName = 'T_ph16:u_ph16:v_ph16:'//C_NULL_CHAR ! they are defined in cplcomp_exchange mod ! context_id = atm(1)%cplcompid == atm_id above (5) ! we use the same name as spectral case, even thought in pg2 case, the size of tag is 1, not 16 ! in imoab_apg2_ol_coupler.cpp we use at this stage, receiver, the same name as sender, T_ph @@ -701,7 +701,7 @@ subroutine prep_atm_migrate_moab(infodata) endif endif else ! original send from spectral elements - tagName = 'a2oTbot;a2oUbot;a2oVbot;'//C_NULL_CHAR ! they are defined in semoab_mod.F90!!! + tagName = 'a2oTbot:a2oUbot:a2oVbot:'//C_NULL_CHAR ! they are defined in semoab_mod.F90!!! ! the separator will be ';' semicolon if (mhid .ge. 0) then ! send because we are on atm pes @@ -765,7 +765,7 @@ subroutine prep_atm_migrate_moab(infodata) endif ! if atm and ocn ! repeat this for land data, that is already on atm tag - tagNameProj = 'a2lTbot_proj;a2lUbot_proj;a2lVbot_proj;'//C_NULL_CHAR + tagNameProj = 'a2lTbot_proj:a2lUbot_proj:a2lVbot_proj:'//C_NULL_CHAR context_id = lnd(1)%cplcompid @@ -779,7 +779,7 @@ subroutine prep_atm_migrate_moab(infodata) ! basically, adjust the migration of the tag we want to project; it was sent initially with ! original partitioning, now we need to adjust it for "coverage" mesh ! as always, use nonblocking sends - tagName = 'T_ph;u_ph;v_ph;'//C_NULL_CHAR ! they are defined in initialize_moab_atm_phys in atm_comp_mct + tagName = 'T_ph:u_ph:v_ph:'//C_NULL_CHAR ! they are defined in initialize_moab_atm_phys in atm_comp_mct context_id = 100*atm(1)%cplcompid + lnd(1)%cplcompid !send to atm/lnd intx ! ! use computed graph ierr = iMOAB_SendElementTag(mphaid, tagName, mpicom_join, context_id) @@ -791,7 +791,7 @@ subroutine prep_atm_migrate_moab(infodata) endif if (mbaxid .ge. 0 ) then ! we are on coupler pes, for sure ! receive on atm on coupler pes, that was redistributed according to coverage - tagName = 'T_ph;u_ph;v_ph;'//C_NULL_CHAR ! they are defined in initialize_moab_atm_phys + tagName = 'T_ph:u_ph:v_ph:'//C_NULL_CHAR ! they are defined in initialize_moab_atm_phys ierr = iMOAB_ReceiveElementTag(mbintxla, tagName, mpicom_join, atm_id) if (ierr .ne. 0) then write(logunit,*) subname,' error in receiving tag from atm to atm land intx ' @@ -809,7 +809,7 @@ subroutine prep_atm_migrate_moab(infodata) endif endif else ! regular coarse homme mesh if (.not. atm_pg_active) - tagName = 'a2oTbot;a2oUbot;a2oVbot;'//C_NULL_CHAR + tagName = 'a2oTbot:a2oUbot:a2oVbot:'//C_NULL_CHAR ! context_id = lnd(1)%cplcompid ! if (mhid .ge. 0) then ! send because we are on atm pes diff --git a/driver-moab/main/prep_lnd_mod.F90 b/driver-moab/main/prep_lnd_mod.F90 index e5216c5e81b3..86aa52d4192d 100644 --- a/driver-moab/main/prep_lnd_mod.F90 +++ b/driver-moab/main/prep_lnd_mod.F90 @@ -595,7 +595,7 @@ subroutine prep_lnd_migrate_moab(infodata) call seq_comm_getinfo(ID_join,mpicom=mpicom_join) context_id = -1 ! now send the tag a2oTbot_proj, a2oUbot_proj, a2oVbot_proj from ocn on coupler pes towards original ocean mesh - tagName = 'a2lTbot_proj;a2lUbot_proj;a2lVbot_proj;'//C_NULL_CHAR ! defined in prep_atm_mod.F90!!! + tagName = 'a2lTbot_proj:a2lUbot_proj:a2lVbot_proj:'//C_NULL_CHAR ! defined in prep_atm_mod.F90!!! if (mblxid .ge. 0) then ! send because we are on coupler pes diff --git a/driver-moab/main/prep_ocn_mod.F90 b/driver-moab/main/prep_ocn_mod.F90 index d283f2242852..1f68e847ce02 100644 --- a/driver-moab/main/prep_ocn_mod.F90 +++ b/driver-moab/main/prep_ocn_mod.F90 @@ -1542,7 +1542,7 @@ subroutine prep_ocn_migrate_moab(infodata) call seq_comm_getinfo(ID_join,mpicom=mpicom_join) context_id = -1 ! now send the tag a2oTbot_proj, a2oUbot_proj, a2oVbot_proj from ocn on coupler pes towards original ocean mesh - tagName = 'a2oTbot_proj;a2oUbot_proj;a2oVbot_proj;'//C_NULL_CHAR ! defined in prep_atm_mod.F90!!! + tagName = 'a2oTbot_proj:a2oUbot_proj:a2oVbot_proj:'//C_NULL_CHAR ! defined in prep_atm_mod.F90!!! if (mboxid .ge. 0) then ! send because we are on coupler pes diff --git a/driver-moab/main/prep_rof_mod.F90 b/driver-moab/main/prep_rof_mod.F90 index 177edb99deb4..ed0108d5f184 100644 --- a/driver-moab/main/prep_rof_mod.F90 +++ b/driver-moab/main/prep_rof_mod.F90 @@ -424,8 +424,8 @@ subroutine prep_rof_migrate_moab(infodata) ! we should do this only if ocn_present context_id = ocn(1)%cplcompid wgtIdef = 'map-from-file'//C_NULL_CHAR - tagName = 'mbForr_rofl;mbForr_rofi;'//C_NULL_CHAR - tagNameProj = 'mbForr_rofl_proj;mbForr_rofi_proj;'//C_NULL_CHAR + tagName = 'mbForr_rofl:mbForr_rofi:'//C_NULL_CHAR + tagNameProj = 'mbForr_rofl_proj:mbForr_rofi_proj:'//C_NULL_CHAR num_proj = num_proj + 1 if (rof_present .and. ocn_present) then From 2aad96c4880932aede25b8e3b002063f17f85675 Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Mon, 4 Apr 2022 11:36:25 -0500 Subject: [PATCH 130/467] define moab tags for ice-ocn coupling also, set the fields in ice_export_moab routine main issue is transposing of the attr vect fields for moab, first index is now along cell index, second index is the field index --- components/mpas-seaice/driver/ice_comp_mct.F | 383 +++++++++++++++++++ driver-moab/main/cplcomp_exchange_mod.F90 | 72 ++-- 2 files changed, 422 insertions(+), 33 deletions(-) diff --git a/components/mpas-seaice/driver/ice_comp_mct.F b/components/mpas-seaice/driver/ice_comp_mct.F index 8e2459c485b6..58d33be9a838 100644 --- a/components/mpas-seaice/driver/ice_comp_mct.F +++ b/components/mpas-seaice/driver/ice_comp_mct.F @@ -87,6 +87,11 @@ module ice_comp_mct private :: ice_SetGSMap_mct private :: ice_domain_mct ! +#ifdef HAVE_MOAB + private :: ice_export_moab + integer , private :: mblsize + real (kind=RKIND) , allocatable, private :: i2x_im(:,:) +#endif ! !PRIVATE MODULE VARIABLES integer, private :: my_task @@ -681,6 +686,12 @@ end subroutine xml_stream_get_attributes nsend = mct_avect_nRattr(i2x_i) nrecv = mct_avect_nRattr(x2i_i) +#ifdef HAVE_MOAB + ! initialize moab tag fields array + mblsize = lsize + allocate (i2x_im(lsize, nsend) ) +#endif + !----------------------------------------------------------------------- ! @@ -1201,6 +1212,9 @@ subroutine ice_run_mct( EClock, cdata_i, x2i_i, i2x_i)!{{{ ! Export state to coupler if (debugOn) call mpas_log_write('Exporting state', masterOnly=.true.) call ice_export_mct(i2x_i, ierr) +#ifdef HAVE_MOAB + call ice_export_moab() +#endif if (debugOn) call mpas_log_write('Finished exporting state', masterOnly=.true.) ! Check if clocks are in sync @@ -1395,6 +1409,10 @@ subroutine ice_final_mct( EClock, cdata_i, x2i_i, i2x_i)!{{{ call mpas_framework_finalize(domain % dminfo, domain, io_system) +#ifdef HAVE_MOAB + ! deallocate moab fields array + deallocate (i2x_im) +#endif ! Reset I/O logs call shr_file_setLogUnit (shrlogunit) call shr_file_setLogLevel(shrloglev) @@ -2862,7 +2880,372 @@ subroutine datetime(cdate, ctime) end subroutine datetime!}}} +#ifdef HAVE_MOAB + subroutine ice_export_moab() +!BOP + + ! !DESCRIPTION: + ! This routine calls the routines necessary to send MPASSI fields to MOAB coupler + ! + use iMOAB, only : iMOAB_SetDoubleTagStorage, iMOAB_WriteMesh + !EOP + !BOC + !----------------------------------------------------------------------- + ! + ! local variables + ! + !----------------------------------------------------------------------- + + integer :: & + i, n + + real(kind=RKIND) :: & + ailohi, & + Tsrf, & + tauxa, & + tauya, & + tauxo, & + tauyo, & + basalPressure + + type (block_type), pointer :: & + block_ptr + + type (mpas_pool_type), pointer :: & + configs, & + meshPool, & + tracersAggregate, & + velocitySolver, & + shortwave, & + atmosCoupling, & + oceanCoupling, & + atmosFluxes, & + oceanFluxes, & + icebergFluxes, & + biogeochemistry + + integer, pointer :: & + nCellsSolve + + logical, pointer :: & + config_rotate_cartesian_grid, & + config_use_topo_meltponds, & + config_use_column_biogeochemistry, & + config_use_column_shortwave, & + config_use_data_icebergs + real(kind=RKIND), pointer :: & + sphere_radius + + real (kind=RKIND), dimension(:), pointer :: & + latCell, & + lonCell, & + xCell, & + yCell, & + zCell, & + iceAreaCell, & + iceVolumeCell, & + snowVolumeCell, & + pondDepthCell, & + pondLidThicknessCell, & + pondAreaCell, & + surfaceTemperatureCell, & + airStressCellU, & + airStressCellV, & + oceanStressCellU, & + oceanStressCellV, & + albedoVisibleDirectCell, & + albedoIRDirectCell, & + albedoVisibleDiffuseCell, & + albedoIRDiffuseCell, & + atmosReferenceSpeed10m, & + atmosReferenceTemperature2m, & + atmosReferenceHumidity2m, & + latentHeatFlux, & + sensibleHeatFlux, & + longwaveUp, & + evaporativeWaterFlux, & + absorbedShortwaveFlux, & + oceanHeatFlux, & + oceanShortwaveFlux, & + oceanFreshWaterFlux, & + oceanSaltFlux, & + frazilMassAdjust, & + bergFreshwaterFlux, & + bergLatentHeatFlux, & + oceanNitrateFlux, & + oceanSilicateFlux, & + oceanAmmoniumFlux, & + oceanDMSFlux, & + oceanDMSPpFlux, & + oceanDMSPdFlux, & + oceanHumicsFlux, & + carbonToNitrogenRatioAlgae, & + carbonToNitrogenRatioDON + + real (kind=RKIND), dimension(:,:), pointer :: & + oceanAlgaeFlux, & + oceanDOCFlux, & + oceanDICFlux, & + oceanDONFlux, & + oceanParticulateIronFlux, & + oceanDissolvedIronFlux + + integer, save :: num_mb_exports = 0 ! used for debugging + integer :: ent_type, ierr + character(len=32), parameter :: sub = 'ice_export_moab' + + character*100 outfile, wopts, localmeshfile, tagname, lnum + !----------------------------------------------------------------------- + + n = 0 + i2x_im(: ,:) = 0.0_RKIND + block_ptr => domain % blocklist + do while(associated(block_ptr)) + + configs => block_ptr % configs + call MPAS_pool_get_config(configs, "config_rotate_cartesian_grid", config_rotate_cartesian_grid) + call MPAS_pool_get_config(configs, "config_use_topo_meltponds", config_use_topo_meltponds) + call MPAS_pool_get_config(configs, "config_use_column_biogeochemistry", config_use_column_biogeochemistry) + call MPAS_pool_get_config(configs, "config_use_column_shortwave", config_use_column_shortwave) + call MPAS_pool_get_config(configs, "config_use_data_icebergs", config_use_data_icebergs) + + call MPAS_pool_get_subpool(block_ptr % structs, 'mesh', meshPool) + call MPAS_pool_get_subpool(block_ptr % structs, "tracers_aggregate", tracersAggregate) + call MPAS_pool_get_subpool(block_ptr % structs, "velocity_solver", velocitySolver) + call MPAS_pool_get_subpool(block_ptr % structs, "shortwave", shortwave) + call MPAS_pool_get_subpool(block_ptr % structs, 'atmos_coupling', atmosCoupling) + call MPAS_pool_get_subpool(block_ptr % structs, 'ocean_coupling', oceanCoupling) + call MPAS_pool_get_subpool(block_ptr % structs, "atmos_fluxes", atmosFluxes) + call MPAS_pool_get_subpool(block_ptr % structs, "ocean_fluxes", oceanFluxes) + + call MPAS_pool_get_dimension(meshPool, 'nCellsSolve', nCellsSolve) + call MPAS_pool_get_config(meshPool, "sphere_radius", sphere_radius) + call MPAS_pool_get_array(meshPool, "latCell", latCell) + call MPAS_pool_get_array(meshPool, "lonCell", lonCell) + call MPAS_pool_get_array(meshPool, "xCell", xCell) + call MPAS_pool_get_array(meshPool, "yCell", yCell) + call MPAS_pool_get_array(meshPool, "zCell", zCell) + + call MPAS_pool_get_array(tracersAggregate, 'iceAreaCell', iceAreaCell) + call MPAS_pool_get_array(tracersAggregate, 'iceVolumeCell', iceVolumeCell) + call MPAS_pool_get_array(tracersAggregate, 'snowVolumeCell', snowVolumeCell) + call MPAS_pool_get_array(tracersAggregate, 'pondDepthCell', pondDepthCell) + call MPAS_pool_get_array(tracersAggregate, 'pondLidThicknessCell', pondLidThicknessCell) + call MPAS_pool_get_array(tracersAggregate, 'pondAreaCell', pondAreaCell) + call MPAS_pool_get_array(tracersAggregate, 'surfaceTemperatureCell', surfaceTemperatureCell) + + call MPAS_pool_get_array(velocitySolver, 'airStressCellU', airStressCellU) + call MPAS_pool_get_array(velocitySolver, 'airStressCellV', airStressCellV) + call MPAS_pool_get_array(velocitySolver, 'oceanStressCellU', oceanStressCellU) + call MPAS_pool_get_array(velocitySolver, 'oceanStressCellV', oceanStressCellV) + + call MPAS_pool_get_array(shortwave, 'albedoVisibleDirectCell', albedoVisibleDirectCell) + call MPAS_pool_get_array(shortwave, 'albedoIRDirectCell', albedoIRDirectCell) + call MPAS_pool_get_array(shortwave, 'albedoVisibleDiffuseCell', albedoVisibleDiffuseCell) + call MPAS_pool_get_array(shortwave, 'albedoIRDiffuseCell', albedoIRDiffuseCell) + call MPAS_pool_get_array(shortwave, 'absorbedShortwaveFlux', absorbedShortwaveFlux) + + call MPAS_pool_get_array(atmosCoupling, 'atmosReferenceSpeed10m', atmosReferenceSpeed10m) + call MPAS_pool_get_array(atmosCoupling, 'atmosReferenceTemperature2m', atmosReferenceTemperature2m) + call MPAS_pool_get_array(atmosCoupling, 'atmosReferenceHumidity2m', atmosReferenceHumidity2m) + + call MPAS_pool_get_array(oceanCoupling, 'frazilMassAdjust', frazilMassAdjust) + + call MPAS_pool_get_array(atmosFluxes, 'latentHeatFlux', latentHeatFlux) + call MPAS_pool_get_array(atmosFluxes, 'sensibleHeatFlux', sensibleHeatFlux) + call MPAS_pool_get_array(atmosFluxes, 'longwaveUp', longwaveUp) + call MPAS_pool_get_array(atmosFluxes, 'evaporativeWaterFlux', evaporativeWaterFlux) + + call MPAS_pool_get_array(oceanFluxes, 'oceanHeatFlux', oceanHeatFlux) + call MPAS_pool_get_array(oceanFluxes, 'oceanShortwaveFlux', oceanShortwaveFlux) + call MPAS_pool_get_array(oceanFluxes, 'oceanFreshWaterFlux', oceanFreshWaterFlux) + call MPAS_pool_get_array(oceanFluxes, 'oceanSaltFlux', oceanSaltFlux) + + if (config_use_data_icebergs) then + call MPAS_pool_get_subpool(block_ptr % structs, "berg_fluxes", icebergFluxes) + + call MPAS_pool_get_array(icebergFluxes, "bergFreshwaterFlux", bergFreshwaterFlux) + call MPAS_pool_get_array(icebergFluxes, "bergLatentHeatFlux", bergLatentHeatFlux) + endif + + if (config_use_column_biogeochemistry) then + call mpas_pool_get_subpool(block_ptr % structs, 'biogeochemistry', biogeochemistry) + + call mpas_pool_get_array(biogeochemistry, 'oceanAlgaeFlux', oceanAlgaeFlux) + call mpas_pool_get_array(biogeochemistry, 'oceanDOCFlux', oceanDOCFlux) + call mpas_pool_get_array(biogeochemistry, 'oceanDICFlux', oceanDICFlux) + call mpas_pool_get_array(biogeochemistry, 'oceanDONFlux', oceanDONFlux) + call mpas_pool_get_array(biogeochemistry, 'oceanNitrateFlux', oceanNitrateFlux) + call mpas_pool_get_array(biogeochemistry, 'oceanSilicateFlux', oceanSilicateFlux) + call mpas_pool_get_array(biogeochemistry, 'oceanAmmoniumFlux', oceanAmmoniumFlux) + call mpas_pool_get_array(biogeochemistry, 'oceanDMSFlux', oceanDMSFlux) + call mpas_pool_get_array(biogeochemistry, 'oceanDMSPpFlux', oceanDMSPpFlux) + call mpas_pool_get_array(biogeochemistry, 'oceanDMSPdFlux', oceanDMSPdFlux) + call mpas_pool_get_array(biogeochemistry, 'oceanHumicsFlux', oceanHumicsFlux) + call mpas_pool_get_array(biogeochemistry, 'oceanParticulateIronFlux', oceanParticulateIronFlux) + call mpas_pool_get_array(biogeochemistry, 'oceanDissolvedIronFlux', oceanDissolvedIronFlux) + call mpas_pool_get_array(biogeochemistry, 'carbonToNitrogenRatioAlgae', carbonToNitrogenRatioAlgae) + call mpas_pool_get_array(biogeochemistry, 'carbonToNitrogenRatioDON', carbonToNitrogenRatioDON) + endif + + do i = 1, nCellsSolve + n = n + 1 + + ! ice fraction + ailohi = min(iceAreaCell(i), 1.0_RKIND) + + !TODO: CICE has a check for ailohi < 0 + + ! surface temperature + Tsrf = seaiceFreshWaterFreezingPoint + surfaceTemperatureCell(i) + + ! basal pressure + if ( ailohi > 0.0_RKIND ) then + call basal_pressure(& + basalPressure, & + iceVolumeCell(i), & + snowVolumeCell(i), & + pondDepthCell(i), & + pondLidThicknessCell(i), & + pondAreaCell(i), & + config_use_topo_meltponds) + endif + + ! wind stress (on T-grid: convert to lat-lon) + call seaice_latlon_vector_rotation_backward(& + tauxa, & + tauya, & + airStressCellU(i), & + airStressCellV(i), & + latCell(i), & + lonCell(i), & + xCell(i), & + yCell(i), & + zCell(i), & + sphere_radius, & + config_rotate_cartesian_grid) + + ! ice/ocean stress (on POP T-grid: convert to lat-lon) + call seaice_latlon_vector_rotation_backward(& + tauxo, & + tauyo, & + -oceanStressCellU(i), & + -oceanStressCellV(i), & + latCell(i), & + lonCell(i), & + xCell(i), & + yCell(i), & + zCell(i), & + sphere_radius, & + config_rotate_cartesian_grid) + + !-------states-------------------- + i2x_im(n, index_i2x_Si_ifrac) = ailohi + + if (config_use_data_icebergs) then + i2x_im(n, index_i2x_Fioi_bergw) = bergFreshwaterFlux(i) + i2x_im(n, index_i2x_Fioi_bergh) = bergLatentHeatFlux(i) + endif + + if ( ailohi > 0.0_RKIND ) then + + !-------states-------------------- + i2x_im(n, index_i2x_Si_t) = Tsrf + i2x_im(n, index_i2x_Si_bpress) = basalPressure + i2x_im(n, index_i2x_Si_u10) = atmosReferenceSpeed10m(i) + i2x_im(n, index_i2x_Si_tref) = atmosReferenceTemperature2m(i) + i2x_im(n, index_i2x_Si_qref) = atmosReferenceHumidity2m(i) + i2x_im(n, index_i2x_Si_snowh) = snowVolumeCell(i) / ailohi + + !--- a/i fluxes computed by ice + i2x_im(n, index_i2x_Faii_taux) = tauxa + i2x_im(n, index_i2x_Faii_tauy) = tauya + i2x_im(n, index_i2x_Faii_lat ) = latentHeatFlux(i) + i2x_im(n, index_i2x_Faii_sen ) = sensibleHeatFlux(i) + i2x_im(n, index_i2x_Faii_lwup) = longwaveUp(i) + i2x_im(n, index_i2x_Faii_evap) = evaporativeWaterFlux(i) + i2x_im(n, index_i2x_Faii_swnet) = absorbedShortwaveFlux(i) + i2x_im(n, index_i2x_Faii_evap) = evaporativeWaterFlux(i) + + if (config_use_column_shortwave) then + i2x_im(n, index_i2x_Si_avsdr) = albedoVisibleDirectCell(i) + i2x_im(n, index_i2x_Si_anidr) = albedoIRDirectCell(i) + i2x_im(n, index_i2x_Si_avsdf) = albedoVisibleDiffuseCell(i) + i2x_im(n, index_i2x_Si_anidf) = albedoIRDiffuseCell(i) + + i2x_im(n, index_i2x_Faii_swnet) = absorbedShortwaveFlux(i) + endif + + ! i/o fluxes computed by ice, as well as additional freshwater and salt calculated at the last + ! coupling import and needed to grow sea ice from frazil passed from the ocean model in the + ! field frazilMassAdjust. + i2x_im(n, index_i2x_Fioi_melth) = oceanHeatFlux(i) + i2x_im(n, index_i2x_Fioi_swpen) = oceanShortwaveFlux(i) + i2x_im(n, index_i2x_Fioi_meltw) = oceanFreshWaterFlux(i) + frazilMassAdjust(i)/ailohi + i2x_im(n, index_i2x_Fioi_salt ) = oceanSaltFlux(i) + ice_ref_salinity*p001*frazilMassAdjust(i)/ailohi + i2x_im(n, index_i2x_Fioi_taux ) = tauxo + i2x_im(n, index_i2x_Fioi_tauy ) = tauyo + + ! export biogeochemistry fields, if configured + if (config_use_column_biogeochemistry) then + ! convert from mmol N/m^3 to mmol C/m^3 + i2x_im(n, index_i2x_Fioi_algae1) = oceanAlgaeFlux(1,i) * carbonToNitrogenRatioAlgae(1) + i2x_im(n, index_i2x_Fioi_algae2) = oceanAlgaeFlux(2,i) * carbonToNitrogenRatioAlgae(2) + i2x_im(n, index_i2x_Fioi_algae3) = oceanAlgaeFlux(3,i) * carbonToNitrogenRatioAlgae(3) + i2x_im(n, index_i2x_Fioi_doc1 ) = oceanDOCFlux(1,i) + i2x_im(n, index_i2x_Fioi_doc2 ) = oceanDOCFlux(2,i) + i2x_im(n, index_i2x_Fioi_doc3 ) = oceanDOCFlux(3,i) !JW set to 0? + i2x_im(n, index_i2x_Fioi_dic1 ) = oceanDICFlux(1,i) + i2x_im(n, index_i2x_Fioi_don1 ) = oceanDONFlux(1,i) + i2x_im(n, index_i2x_Fioi_no3 ) = oceanNitrateFlux(i) + i2x_im(n, index_i2x_Fioi_sio3 ) = oceanSilicateFlux(i) + i2x_im(n, index_i2x_Fioi_nh4 ) = oceanAmmoniumFlux(i) + i2x_im(n, index_i2x_Fioi_dms ) = oceanDMSFlux(i) + i2x_im(n, index_i2x_Fioi_dmspp ) = oceanDMSPpFlux(i) + i2x_im(n, index_i2x_Fioi_dmspd ) = oceanDMSPdFlux(i) + i2x_im(n, index_i2x_Fioi_docr ) = oceanHumicsFlux(i) + ! convert from umol Fe/m^3 to mmol Fe/m^3 + i2x_im(n, index_i2x_Fioi_fep1 ) = oceanParticulateIronFlux(1,i) / 1000._RKIND + i2x_im(n, index_i2x_Fioi_fep2 ) = oceanParticulateIronFlux(2,i) / 1000._RKIND + i2x_im(n, index_i2x_Fioi_fed1 ) = oceanDissolvedIronFlux(1,i) / 1000._RKIND + i2x_im(n, index_i2x_Fioi_fed2 ) = oceanDissolvedIronFlux(2,i) / 1000._RKIND + endif + endif + enddo + + block_ptr => block_ptr % next + enddo + + ent_type = 1 ! cells + tagname='Fioi_swpen'//C_NULL_CHAR + ierr = iMOAB_SetDoubleTagStorage ( MPSIID, tagname, mblsize , ent_type, i2x_im(1, index_i2x_Fioi_swpen) ) + tagname='Fioi_melth'//C_NULL_CHAR + ierr = iMOAB_SetDoubleTagStorage ( MPSIID, tagname, mblsize , ent_type, i2x_im(1, index_i2x_Fioi_melth) ) + tagname='Fioi_meltw'//C_NULL_CHAR + ierr = iMOAB_SetDoubleTagStorage ( MPSIID, tagname, mblsize , ent_type, i2x_im(1, index_i2x_Fioi_meltw) ) + tagname='Fioi_salt'//C_NULL_CHAR + ierr = iMOAB_SetDoubleTagStorage ( MPSIID, tagname, mblsize , ent_type, i2x_im(1, index_i2x_Fioi_salt) ) + tagname='Fioi_taux'//C_NULL_CHAR + ierr = iMOAB_SetDoubleTagStorage ( MPSIID, tagname, mblsize , ent_type, i2x_im(1, index_i2x_Fioi_taux) ) + tagname='Fioi_tauy'//C_NULL_CHAR + ierr = iMOAB_SetDoubleTagStorage ( MPSIID, tagname, mblsize , ent_type, i2x_im(1, index_i2x_Fioi_tauy) ) + if (config_use_data_icebergs) then + tagname='Fioi_bergw'//C_NULL_CHAR + ierr = iMOAB_SetDoubleTagStorage ( MPSIID, tagname, mblsize , ent_type, i2x_im(1, index_i2x_Fioi_bergw) ) + tagname='Fioi_bergh'//C_NULL_CHAR + ierr = iMOAB_SetDoubleTagStorage ( MPSIID, tagname, mblsize , ent_type, i2x_im(1, index_i2x_Fioi_bergh) ) + endif + +#ifdef MOABDEBUG + num_mb_exports = num_mb_exports +1 + write(lnum,"(I0.2)")num_mb_exports + outfile = 'ice_export_'//trim(lnum)//'.h5m'//C_NULL_CHAR + wopts = 'PARALLEL=WRITE_PART'//C_NULL_CHAR + ierr = iMOAB_WriteMesh(MPSIID, outfile, wopts) +#endif + end subroutine ice_export_moab +#endif end module ice_comp_mct !||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| diff --git a/driver-moab/main/cplcomp_exchange_mod.F90 b/driver-moab/main/cplcomp_exchange_mod.F90 index 0fb556c59427..2503891fdd24 100644 --- a/driver-moab/main/cplcomp_exchange_mod.F90 +++ b/driver-moab/main/cplcomp_exchange_mod.F90 @@ -1331,6 +1331,26 @@ subroutine cplcomp_moab_Init(comp) call seq_comm_getinfo(id_old,mpigrp=mpigrp_old) ! component group pes if (MPI_COMM_NULL /= mpicom_old ) then ! it means we are on the component p + ! define here the fields from seq_flds_i2x_fields to be received by ocean ! + tagtype = 1 ! dense, double + numco = 1 ! one value per cell / entity + tagname = 'Fioi_swpen'//C_NULL_CHAR ! sw: net penetrating ice + ierr = iMOAB_DefineTagStorage(MPSIID, tagname, tagtype, numco, tagindex ) + tagname = 'Fioi_melth'//C_NULL_CHAR ! heat flux from melting ice (<0) + ierr = iMOAB_DefineTagStorage(MPSIID, tagname, tagtype, numco, tagindex ) + tagname = 'Fioi_meltw'//C_NULL_CHAR ! water flux from melting ice + ierr = iMOAB_DefineTagStorage(MPSIID, tagname, tagtype, numco, tagindex ) + tagname = 'Fioi_salt'//C_NULL_CHAR ! salt flux from meting ice + ierr = iMOAB_DefineTagStorage(MPSIID, tagname, tagtype, numco, tagindex ) + tagname = 'Fioi_taux'//C_NULL_CHAR ! ice/ocn stress, zonal + ierr = iMOAB_DefineTagStorage(MPSIID, tagname, tagtype, numco, tagindex ) + tagname = 'Fioi_tauy'//C_NULL_CHAR ! ice/ocn stress, zonal + ierr = iMOAB_DefineTagStorage(MPSIID, tagname, tagtype, numco, tagindex ) + tagname = 'Fioi_bergh'//C_NULL_CHAR ! heat flux from melting icebergs (<0) + ierr = iMOAB_DefineTagStorage(MPSIID, tagname, tagtype, numco, tagindex ) + tagname = 'Fioi_bergw'//C_NULL_CHAR ! water flux from melting icebergs + ierr = iMOAB_DefineTagStorage(MPSIID, tagname, tagtype, numco, tagindex ) + #ifdef MOABDEBUG outfile = 'wholeSeaIce.h5m'//C_NULL_CHAR wopts = 'PARALLEL=WRITE_PART'//C_NULL_CHAR @@ -1348,45 +1368,31 @@ subroutine cplcomp_moab_Init(comp) call shr_sys_abort(subname//' ERROR in sending sea ice mesh to coupler ') endif - -! ! define here the tag that will be projected back from atmosphere -! ! TODO where do we want to define this? -! tagnameProj = 'a2oTbot_proj'//C_NULL_CHAR -! tagtype = 1 ! dense, double -! numco = 1 ! one value per cell -! ierr = iMOAB_DefineTagStorage(mpoid, tagnameProj, tagtype, numco, tagindex ) -! ! define more tags -! tagnameProj = 'a2oUbot_proj'//C_NULL_CHAR ! U component of velocity -! ierr = iMOAB_DefineTagStorage(mpoid, tagnameProj, tagtype, numco, tagindex ) -! tagnameProj = 'a2oVbot_proj'//C_NULL_CHAR ! V component of velocity -! ierr = iMOAB_DefineTagStorage(mpoid, tagnameProj, tagtype, numco, tagindex ) -! if (ierr .ne. 0) then -! write(logunit,*) subname,' error in defining tags on ocean comp ' -! call shr_sys_abort(subname//' ERROR in defining tags on ocean comp ') -! endif - endif if (MPI_COMM_NULL /= mpicom_new ) then ! we are on the coupler pes appname = "COUPLE_MPASSI"//C_NULL_CHAR ! migrated mesh gets another app id, moab moab sea ice to coupler (mbox) ierr = iMOAB_RegisterApplication(trim(appname), mpicom_new, id_join, mbixid) ierr = iMOAB_ReceiveMesh(mbixid, mpicom_join, mpigrp_old, id_old) - -! ! define here the tag that will be projected from atmosphere -! tagnameProj = 'a2oTbot_proj'//C_NULL_CHAR ! temperature -! tagtype = 1 ! dense, double -! numco = 1 ! one value per cell -! ierr = iMOAB_DefineTagStorage(mboxid, tagnameProj, tagtype, numco, tagindex ) -! -! ! define more tags -! tagnameProj = 'a2oUbot_proj'//C_NULL_CHAR ! U component of velocity -! ierr = iMOAB_DefineTagStorage(mboxid, tagnameProj, tagtype, numco, tagindex ) -! tagnameProj = 'a2oVbot_proj'//C_NULL_CHAR ! V component of velocity -! ierr = iMOAB_DefineTagStorage(mboxid, tagnameProj, tagtype, numco, tagindex ) -! if (ierr .ne. 0) then -! write(logunit,*) subname,' error in defining tags on ocean coupler ' -! call shr_sys_abort(subname//' ERROR in defining tags on ocean coupler ') -! endif + ! define the same tags on coupler side + tagtype = 1 ! dense, double + numco = 1 ! one value per cell / entity + tagname = 'Fioi_swpen'//C_NULL_CHAR ! sw: net penetrating ice + ierr = iMOAB_DefineTagStorage(mbixid, tagname, tagtype, numco, tagindex ) + tagname = 'Fioi_melth'//C_NULL_CHAR ! heat flux from melting ice (<0) + ierr = iMOAB_DefineTagStorage(mbixid, tagname, tagtype, numco, tagindex ) + tagname = 'Fioi_meltw'//C_NULL_CHAR ! water flux from melting ice + ierr = iMOAB_DefineTagStorage(mbixid, tagname, tagtype, numco, tagindex ) + tagname = 'Fioi_salt'//C_NULL_CHAR ! salt flux from meting ice + ierr = iMOAB_DefineTagStorage(mbixid, tagname, tagtype, numco, tagindex ) + tagname = 'Fioi_taux'//C_NULL_CHAR ! ice/ocn stress, zonal + ierr = iMOAB_DefineTagStorage(mbixid, tagname, tagtype, numco, tagindex ) + tagname = 'Fioi_tauy'//C_NULL_CHAR ! ice/ocn stress, zonal + ierr = iMOAB_DefineTagStorage(mbixid, tagname, tagtype, numco, tagindex ) + tagname = 'Fioi_bergh'//C_NULL_CHAR ! heat flux from melting icebergs (<0) + ierr = iMOAB_DefineTagStorage(mbixid, tagname, tagtype, numco, tagindex ) + tagname = 'Fioi_bergw'//C_NULL_CHAR ! water flux from melting icebergs + ierr = iMOAB_DefineTagStorage(mbixid, tagname, tagtype, numco, tagindex ) #ifdef MOABDEBUG ! debug test outfile = 'recSeaIce.h5m'//C_NULL_CHAR From 3f143bd95aa5934b0f25e65baeed2a17e6f1878d Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Fri, 8 Apr 2022 17:42:22 -0500 Subject: [PATCH 131/467] define tags and set them in one shot use the multiple tags options --- components/mpas-seaice/driver/ice_comp_mct.F | 49 +++++++++++--------- driver-moab/main/cplcomp_exchange_mod.F90 | 39 ---------------- 2 files changed, 26 insertions(+), 62 deletions(-) diff --git a/components/mpas-seaice/driver/ice_comp_mct.F b/components/mpas-seaice/driver/ice_comp_mct.F index 58d33be9a838..ab13707389f3 100644 --- a/components/mpas-seaice/driver/ice_comp_mct.F +++ b/components/mpas-seaice/driver/ice_comp_mct.F @@ -43,6 +43,7 @@ module ice_comp_mct #ifdef HAVE_MOAB use mpas_moabmesh use seq_comm_mct, only: MPSIID + use iMOAB, only: iMOAB_DefineTagStorage #endif use iso_c_binding, only : c_char, c_loc, c_ptr, c_int @@ -89,7 +90,7 @@ module ice_comp_mct ! #ifdef HAVE_MOAB private :: ice_export_moab - integer , private :: mblsize + integer , private :: mblsize, totalmbls real (kind=RKIND) , allocatable, private :: i2x_im(:,:) #endif ! !PRIVATE MODULE VARIABLES @@ -213,7 +214,10 @@ subroutine ice_init_mct( EClock, cdata_i, x2i_i, i2x_i, NLFilename )!{{{ character(len=strKIND) :: curdate character(len=strKIND) :: curtime character(len=strKIND) :: history - +#ifdef HAVE_MOAB + integer :: ierrmb, numco, tagtype, tagindex + character(len=400) :: tagname +#endif logical, pointer :: tempLogicalConfig character(len=StrKIND), pointer :: tempCharConfig real (kind=RKIND), pointer :: tempRealConfig @@ -689,7 +693,16 @@ end subroutine xml_stream_get_attributes #ifdef HAVE_MOAB ! initialize moab tag fields array mblsize = lsize + totalmbls = mblsize * nsend ! size of the double array allocate (i2x_im(lsize, nsend) ) + ! define tags according to the seq_flds_i2x_fields + tagtype = 1 ! dense, double + numco = 1 ! one value per cell / entity + tagname = trim(seq_flds_i2x_fields)//C_NULL_CHAR + ierrmb = iMOAB_DefineTagStorage(MPSIID, tagname, tagtype, numco, tagindex ) + if ( ierrmb == 1 ) then + call mpas_log_write('cannot define tags for MOAB i2x fields ' // trim(seq_flds_i2x_fields), MPAS_LOG_ERR) + endif #endif @@ -2995,9 +3008,10 @@ subroutine ice_export_moab() integer :: ent_type, ierr character(len=32), parameter :: sub = 'ice_export_moab' - character*100 outfile, wopts, localmeshfile, tagname, lnum + character(len=100) :: outfile, wopts, localmeshfile, lnum + character(len=400) :: tagname !----------------------------------------------------------------------- - + call shr_file_setLogUnit (iceLogUnit) n = 0 i2x_im(: ,:) = 0.0_RKIND block_ptr => domain % blocklist @@ -3218,32 +3232,21 @@ subroutine ice_export_moab() enddo ent_type = 1 ! cells - tagname='Fioi_swpen'//C_NULL_CHAR - ierr = iMOAB_SetDoubleTagStorage ( MPSIID, tagname, mblsize , ent_type, i2x_im(1, index_i2x_Fioi_swpen) ) - tagname='Fioi_melth'//C_NULL_CHAR - ierr = iMOAB_SetDoubleTagStorage ( MPSIID, tagname, mblsize , ent_type, i2x_im(1, index_i2x_Fioi_melth) ) - tagname='Fioi_meltw'//C_NULL_CHAR - ierr = iMOAB_SetDoubleTagStorage ( MPSIID, tagname, mblsize , ent_type, i2x_im(1, index_i2x_Fioi_meltw) ) - tagname='Fioi_salt'//C_NULL_CHAR - ierr = iMOAB_SetDoubleTagStorage ( MPSIID, tagname, mblsize , ent_type, i2x_im(1, index_i2x_Fioi_salt) ) - tagname='Fioi_taux'//C_NULL_CHAR - ierr = iMOAB_SetDoubleTagStorage ( MPSIID, tagname, mblsize , ent_type, i2x_im(1, index_i2x_Fioi_taux) ) - tagname='Fioi_tauy'//C_NULL_CHAR - ierr = iMOAB_SetDoubleTagStorage ( MPSIID, tagname, mblsize , ent_type, i2x_im(1, index_i2x_Fioi_tauy) ) - if (config_use_data_icebergs) then - tagname='Fioi_bergw'//C_NULL_CHAR - ierr = iMOAB_SetDoubleTagStorage ( MPSIID, tagname, mblsize , ent_type, i2x_im(1, index_i2x_Fioi_bergw) ) - tagname='Fioi_bergh'//C_NULL_CHAR - ierr = iMOAB_SetDoubleTagStorage ( MPSIID, tagname, mblsize , ent_type, i2x_im(1, index_i2x_Fioi_bergh) ) + ! set all tags in one method + tagname = trim(seq_flds_i2x_fields)//C_NULL_CHAR + ierr = iMOAB_SetDoubleTagStorage ( MPSIID, tagname, totalmbls , ent_type, i2x_im(1, 1) ) + if ( ierr /= 0 ) then + write(iceLogUnit,*) 'Fail to set MOAB fields ' endif + -#ifdef MOABDEBUG +!#ifdef MOABDEBUG num_mb_exports = num_mb_exports +1 write(lnum,"(I0.2)")num_mb_exports outfile = 'ice_export_'//trim(lnum)//'.h5m'//C_NULL_CHAR wopts = 'PARALLEL=WRITE_PART'//C_NULL_CHAR ierr = iMOAB_WriteMesh(MPSIID, outfile, wopts) -#endif +!#endif end subroutine ice_export_moab #endif end module ice_comp_mct diff --git a/driver-moab/main/cplcomp_exchange_mod.F90 b/driver-moab/main/cplcomp_exchange_mod.F90 index 2503891fdd24..9fc6aca472a6 100644 --- a/driver-moab/main/cplcomp_exchange_mod.F90 +++ b/driver-moab/main/cplcomp_exchange_mod.F90 @@ -1331,26 +1331,6 @@ subroutine cplcomp_moab_Init(comp) call seq_comm_getinfo(id_old,mpigrp=mpigrp_old) ! component group pes if (MPI_COMM_NULL /= mpicom_old ) then ! it means we are on the component p - ! define here the fields from seq_flds_i2x_fields to be received by ocean ! - tagtype = 1 ! dense, double - numco = 1 ! one value per cell / entity - tagname = 'Fioi_swpen'//C_NULL_CHAR ! sw: net penetrating ice - ierr = iMOAB_DefineTagStorage(MPSIID, tagname, tagtype, numco, tagindex ) - tagname = 'Fioi_melth'//C_NULL_CHAR ! heat flux from melting ice (<0) - ierr = iMOAB_DefineTagStorage(MPSIID, tagname, tagtype, numco, tagindex ) - tagname = 'Fioi_meltw'//C_NULL_CHAR ! water flux from melting ice - ierr = iMOAB_DefineTagStorage(MPSIID, tagname, tagtype, numco, tagindex ) - tagname = 'Fioi_salt'//C_NULL_CHAR ! salt flux from meting ice - ierr = iMOAB_DefineTagStorage(MPSIID, tagname, tagtype, numco, tagindex ) - tagname = 'Fioi_taux'//C_NULL_CHAR ! ice/ocn stress, zonal - ierr = iMOAB_DefineTagStorage(MPSIID, tagname, tagtype, numco, tagindex ) - tagname = 'Fioi_tauy'//C_NULL_CHAR ! ice/ocn stress, zonal - ierr = iMOAB_DefineTagStorage(MPSIID, tagname, tagtype, numco, tagindex ) - tagname = 'Fioi_bergh'//C_NULL_CHAR ! heat flux from melting icebergs (<0) - ierr = iMOAB_DefineTagStorage(MPSIID, tagname, tagtype, numco, tagindex ) - tagname = 'Fioi_bergw'//C_NULL_CHAR ! water flux from melting icebergs - ierr = iMOAB_DefineTagStorage(MPSIID, tagname, tagtype, numco, tagindex ) - #ifdef MOABDEBUG outfile = 'wholeSeaIce.h5m'//C_NULL_CHAR wopts = 'PARALLEL=WRITE_PART'//C_NULL_CHAR @@ -1374,25 +1354,6 @@ subroutine cplcomp_moab_Init(comp) ! migrated mesh gets another app id, moab moab sea ice to coupler (mbox) ierr = iMOAB_RegisterApplication(trim(appname), mpicom_new, id_join, mbixid) ierr = iMOAB_ReceiveMesh(mbixid, mpicom_join, mpigrp_old, id_old) - ! define the same tags on coupler side - tagtype = 1 ! dense, double - numco = 1 ! one value per cell / entity - tagname = 'Fioi_swpen'//C_NULL_CHAR ! sw: net penetrating ice - ierr = iMOAB_DefineTagStorage(mbixid, tagname, tagtype, numco, tagindex ) - tagname = 'Fioi_melth'//C_NULL_CHAR ! heat flux from melting ice (<0) - ierr = iMOAB_DefineTagStorage(mbixid, tagname, tagtype, numco, tagindex ) - tagname = 'Fioi_meltw'//C_NULL_CHAR ! water flux from melting ice - ierr = iMOAB_DefineTagStorage(mbixid, tagname, tagtype, numco, tagindex ) - tagname = 'Fioi_salt'//C_NULL_CHAR ! salt flux from meting ice - ierr = iMOAB_DefineTagStorage(mbixid, tagname, tagtype, numco, tagindex ) - tagname = 'Fioi_taux'//C_NULL_CHAR ! ice/ocn stress, zonal - ierr = iMOAB_DefineTagStorage(mbixid, tagname, tagtype, numco, tagindex ) - tagname = 'Fioi_tauy'//C_NULL_CHAR ! ice/ocn stress, zonal - ierr = iMOAB_DefineTagStorage(mbixid, tagname, tagtype, numco, tagindex ) - tagname = 'Fioi_bergh'//C_NULL_CHAR ! heat flux from melting icebergs (<0) - ierr = iMOAB_DefineTagStorage(mbixid, tagname, tagtype, numco, tagindex ) - tagname = 'Fioi_bergw'//C_NULL_CHAR ! water flux from melting icebergs - ierr = iMOAB_DefineTagStorage(mbixid, tagname, tagtype, numco, tagindex ) #ifdef MOABDEBUG ! debug test outfile = 'recSeaIce.h5m'//C_NULL_CHAR From a656690d13babad3026e827b2272a222e16f2808 Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Sun, 10 Apr 2022 00:37:10 -0500 Subject: [PATCH 132/467] export ocn to moab on ocn pes --- components/mpas-ocean/driver/ocn_comp_mct.F | 301 +++++++++++++++++++- 1 file changed, 298 insertions(+), 3 deletions(-) diff --git a/components/mpas-ocean/driver/ocn_comp_mct.F b/components/mpas-ocean/driver/ocn_comp_mct.F index 0f07a3abf6a0..9c7c2bc6b824 100644 --- a/components/mpas-ocean/driver/ocn_comp_mct.F +++ b/components/mpas-ocean/driver/ocn_comp_mct.F @@ -40,6 +40,7 @@ module ocn_comp_mct #ifdef HAVE_MOAB use mpas_moabmesh use seq_comm_mct, only: MPOID + use iMOAB, only: iMOAB_DefineTagStorage #endif use iso_c_binding, only : c_char, c_loc, c_ptr, c_int use mpas_c_interfacing, only : mpas_f_to_c_string, mpas_c_to_f_string @@ -85,6 +86,12 @@ module ocn_comp_mct private :: ocn_domain_mct ! ! !PRIVATE MODULE VARIABLES +#ifdef HAVE_MOAB + private :: ocn_export_moab + integer , private :: mblsize, totalmbls + real (kind=RKIND) , allocatable, private :: o2x_om(:,:) +#endif + integer, private :: & my_task @@ -216,6 +223,8 @@ subroutine ocn_init_mct( EClock, cdata_o, x2o_o, o2x_o, NLFilename )!{{{ #ifdef HAVE_MOAB character*100 outfile, wopts + integer :: ierrmb, numco, tagtype, tagindex + character(len=400) :: tagname #endif interface subroutine xml_stream_parser(xmlname, mgr_p, comm, ierr) bind(c) @@ -622,7 +631,20 @@ end subroutine xml_stream_get_attributes nsend = mct_avect_nRattr(o2x_o) nrecv = mct_avect_nRattr(x2o_o) - +#ifdef HAVE_MOAB + ! initialize moab tag fields array + mblsize = lsize + totalmbls = mblsize * nsend ! size of the double array + allocate (o2x_om(lsize, nsend) ) + ! define tags according to the seq_flds_i2x_fields + tagtype = 1 ! dense, double + numco = 1 ! one value per cell / entity + tagname = trim(seq_flds_o2x_fields)//C_NULL_CHAR + ierrmb = iMOAB_DefineTagStorage(MPOID, tagname, tagtype, numco, tagindex ) + if ( ierrmb == 1 ) then + call mpas_log_write('cannot define tags for MOAB o2x fields ' // trim(seq_flds_o2x_fields), MPAS_LOG_ERR) + endif +#endif !----------------------------------------------------------------------- ! ! initialize necessary coupling info @@ -1145,7 +1167,9 @@ subroutine ocn_run_mct( EClock, cdata_o, x2o_o, o2x_o)!{{{ if (debugOn) call mpas_log_write('Exporting ocean state') call ocn_export_mct(o2x_o, ierr) if (debugOn) call mpas_log_write('Finished exporting ocean state') - +#ifdef HAVE_MOAB + call ocn_export_moab() +#endif call check_clocks_sync(domain % clock, Eclock, ierr) ! Reset I/O logs @@ -1228,7 +1252,10 @@ subroutine ocn_final_mct( EClock, cdata_o, x2o_o, o2x_o)!{{{ end if call mpas_framework_finalize(domain % dminfo, domain, io_system) - +#ifdef HAVE_MOAB + ! deallocate moab fields array + deallocate (o2x_om) +#endif ! Reset I/O logs call shr_file_setLogUnit (shrlogunit) call shr_file_setLogLevel(shrloglev) @@ -2741,6 +2768,274 @@ subroutine datetime(cdate, ctime)!{{{ end subroutine datetime!}}} +#ifdef HAVE_MOAB + + subroutine ocn_export_moab() !{{{ + + ! !DESCRIPTION: + ! This routine calls the routines necessary to send mpas ocean fields to MOAB coupler + ! + use iMOAB, only : iMOAB_SetDoubleTagStorage, iMOAB_WriteMesh + !EOP + !BOC + !----------------------------------------------------------------------- + ! + ! local variables + !----------------------------------------------------------------------- + ! + ! local variables + ! + !----------------------------------------------------------------------- + integer, save :: num_mb_exports = 0 ! used for debugging + integer :: ent_type, ierr + character(len=100) :: outfile, wopts, localmeshfile, lnum + character(len=400) :: tagname + + integer :: i, n + integer, pointer :: nCellsSolve, index_temperatureSurfaceValue, index_salinitySurfaceValue, & + index_avgZonalSurfaceVelocity, index_avgMeridionalSurfaceVelocity + + type (block_type), pointer :: block_ptr + + type (mpas_pool_type), pointer :: meshPool, & + forcingPool, & + statePool, & + tracersPool, & + ecosysAuxiliary, & + ecosysSeaIceCoupling, & + DMSSeaIceCoupling, & + MacroMoleculesSeaIceCoupling + + integer, dimension(:), pointer :: landIceMask + + real (kind=RKIND), dimension(:), pointer :: seaIceEnergy, accumulatedFrazilIceMass, frazilSurfacePressure, & + filteredSSHGradientZonal, filteredSSHGradientMeridional, & + avgTotalFreshWaterTemperatureFlux, & + avgCO2_gas_flux, DMSFlux, surfaceUpwardCO2Flux, & + avgOceanSurfaceDIC, & + avgOceanSurfaceDON, & + avgOceanSurfaceNO3, & + avgOceanSurfaceSiO3, & + avgOceanSurfaceNH4, & + avgOceanSurfaceDMS, & + avgOceanSurfaceDMSP, & + avgOceanSurfaceDOCr, & + avgOceanSurfaceFeParticulate, & + avgOceanSurfaceFeDissolved + + real (kind=RKIND), dimension(:,:), pointer :: avgTracersSurfaceValue, avgSurfaceVelocity, & + avgOceanSurfacePhytoC, & + avgOceanSurfaceDOC, layerThickness + + real (kind=RKIND) :: surfaceFreezingTemp + + logical, pointer :: frazilIceActive, & + config_use_ecosysTracers, & + config_use_DMSTracers, & + config_use_MacroMoleculesTracers, & + config_use_ecosysTracers_sea_ice_coupling, & + config_use_DMSTracers_sea_ice_coupling, & + config_use_MacroMoleculesTracers_sea_ice_coupling + + character (len=StrKIND), pointer :: config_land_ice_flux_mode + + logical :: keepFrazil + + ! get configure options + call mpas_pool_get_package(domain % packages, 'frazilIceActive', frazilIceActive) + call mpas_pool_get_config(domain % configs, 'config_use_ecosysTracers', config_use_ecosysTracers) + call mpas_pool_get_config(domain % configs, 'config_land_ice_flux_mode', config_land_ice_flux_mode) + call mpas_pool_get_config(domain % configs, 'config_use_DMSTracers', config_use_DMSTracers) + call mpas_pool_get_config(domain % configs, 'config_use_MacroMoleculesTracers', config_use_MacroMoleculesTracers) + call mpas_pool_get_config(domain % configs, 'config_use_ecosysTracers_sea_ice_coupling', & + config_use_ecosysTracers_sea_ice_coupling) + call mpas_pool_get_config(domain % configs, 'config_use_DMSTracers_sea_ice_coupling', & + config_use_DMSTracers_sea_ice_coupling) + call mpas_pool_get_config(domain % configs, 'config_use_MacroMoleculesTracers_sea_ice_coupling', & + config_use_MacroMoleculesTracers_sea_ice_coupling) + + n = 0 + block_ptr => domain % blocklist + do while(associated(block_ptr)) + call mpas_pool_get_subpool(block_ptr % structs, 'mesh', meshPool) + call mpas_pool_get_subpool(block_ptr % structs, 'forcing', forcingPool) + call mpas_pool_get_subpool(block_ptr % structs, 'state', statePool) + + call mpas_pool_get_subpool(statePool, 'tracers', tracersPool) + + call mpas_pool_get_dimension(meshPool, 'nCellsSolve', nCellsSolve) + + call mpas_pool_get_dimension(forcingPool, 'index_avgTemperatureSurfaceValue', index_temperatureSurfaceValue) + call mpas_pool_get_dimension(forcingPool, 'index_avgSalinitySurfaceValue', index_salinitySurfaceValue) + call mpas_pool_get_dimension(forcingPool, 'index_avgSurfaceVelocityZonal', index_avgZonalSurfaceVelocity) + call mpas_pool_get_dimension(forcingPool, 'index_avgSurfaceVelocityMeridional', index_avgMeridionalSurfaceVelocity) + + call mpas_pool_get_array(statePool, 'layerThickness', layerThickness, 1) + + call mpas_pool_get_array(forcingPool, 'landIceMask', landIceMask) + call mpas_pool_get_array(forcingPool, 'avgTracersSurfaceValue', avgTracersSurfaceValue) + call mpas_pool_get_array(forcingPool, 'avgSurfaceVelocity', avgSurfaceVelocity) + call mpas_pool_get_array(forcingPool, 'filteredSSHGradientZonal', filteredSSHGradientZonal) + call mpas_pool_get_array(forcingPool, 'filteredSSHGradientMeridional', filteredSSHGradientMeridional) + call mpas_pool_get_array(forcingPool, 'avgTotalFreshWaterTemperatureFlux', avgTotalFreshWaterTemperatureFlux) + if ( frazilIceActive ) then + call mpas_pool_get_array(forcingPool, 'seaIceEnergy', seaIceEnergy) + call mpas_pool_get_array(forcingPool, 'frazilSurfacePressure', frazilSurfacePressure) + call mpas_pool_get_array(statePool, 'accumulatedFrazilIceMass', accumulatedFrazilIceMass, 1) + end if + + ! BGC fields + if (config_use_ecosysTracers) then + + call mpas_pool_get_subpool(forcingPool, 'ecosysAuxiliary', ecosysAuxiliary) + call mpas_pool_get_array(ecosysAuxiliary, 'avgCO2_gas_flux', avgCO2_gas_flux) + + end if + + if (config_use_ecosysTracers .and. config_use_ecosysTracers_sea_ice_coupling) then + call mpas_pool_get_subpool(forcingPool, 'ecosysSeaIceCoupling', ecosysSeaIceCoupling) + + call mpas_pool_get_array(ecosysSeaIceCoupling, 'avgOceanSurfacePhytoC', avgOceanSurfacePhytoC) + call mpas_pool_get_array(ecosysSeaIceCoupling, 'avgOceanSurfaceDIC', avgOceanSurfaceDIC) + call mpas_pool_get_array(ecosysSeaIceCoupling, 'avgOceanSurfaceNO3', avgOceanSurfaceNO3) + call mpas_pool_get_array(ecosysSeaIceCoupling, 'avgOceanSurfaceSiO3', avgOceanSurfaceSiO3) + call mpas_pool_get_array(ecosysSeaIceCoupling, 'avgOceanSurfaceNH4', avgOceanSurfaceNH4) + call mpas_pool_get_array(ecosysSeaIceCoupling, 'avgOceanSurfaceDOCr', avgOceanSurfaceDOCr) + call mpas_pool_get_array(ecosysSeaIceCoupling, 'avgOceanSurfaceFeParticulate', avgOceanSurfaceFeParticulate) + call mpas_pool_get_array(ecosysSeaIceCoupling, 'avgOceanSurfaceFeDissolved', avgOceanSurfaceFeDissolved) + endif + if (config_use_DMSTracers .and. config_use_DMSTracers_sea_ice_coupling) then + call mpas_pool_get_subpool(forcingPool, 'DMSSeaIceCoupling', DMSSeaIceCoupling) + + call mpas_pool_get_array(DMSSeaIceCoupling, 'avgOceanSurfaceDMS', avgOceanSurfaceDMS) + call mpas_pool_get_array(DMSSeaIceCoupling, 'avgOceanSurfaceDMSP', avgOceanSurfaceDMSP) + endif + if (config_use_MacroMoleculesTracers .and. config_use_MacroMoleculesTracers_sea_ice_coupling) then + call mpas_pool_get_subpool(forcingPool, 'MacroMoleculesSeaIceCoupling', MacroMoleculesSeaIceCoupling) + + call mpas_pool_get_array(MacroMoleculesSeaIceCoupling, 'avgOceanSurfaceDOC', avgOceanSurfaceDOC) + call mpas_pool_get_array(MacroMoleculesSeaIceCoupling, 'avgOceanSurfaceDON', avgOceanSurfaceDON) + endif + ! call mpas_pool_get_array(forcingPool, 'CO2Flux', CO2Flux) + ! call mpas_pool_get_array(forcingPool, 'DMSFlux', DMSFlux) + ! call mpas_pool_get_array(forcingPool, 'surfaceUpwardCO2Flux', surfaceUpwardCO2Flux) + + do i = 1, nCellsSolve + n = n + 1 + + o2x_om(n, index_o2x_So_t) = avgTracersSurfaceValue(index_temperatureSurfaceValue, i) + o2x_om(n, index_o2x_So_s) = avgTracersSurfaceValue(index_salinitySurfaceValue, i) + o2x_om(n, index_o2x_So_u) = avgSurfaceVelocity(index_avgZonalSurfaceVelocity, i) + o2x_om(n, index_o2x_So_v) = avgSurfaceVelocity(index_avgMeridionalSurfaceVelocity, i) + + o2x_om(n, index_o2x_So_dhdx) = filteredSSHGradientZonal(i) + o2x_om(n, index_o2x_So_dhdy) = filteredSSHGradientMeridional(i) + + o2x_om(n, index_o2x_Faoo_h2otemp) = avgTotalFreshWaterTemperatureFlux(i) * rho_sw * cp_sw + + if ( frazilIceActive ) then + ! negative when frazil ice can be melted + keepFrazil = .true. + if ( associated(landIceMask) ) then + if ( landIceMask(i) == 1 ) then + keepFrazil = .false. + end if + end if + + if ( keepFrazil ) then + + ! Calculate energy associated with frazil mass transfer to sea ice if frazil has accumulated + if ( accumulatedFrazilIceMass(i) > 0.0_RKIND ) then + + seaIceEnergy(i) = accumulatedFrazilIceMass(i) * config_frazil_heat_of_fusion + + ! Otherwise calculate the melt potential where avgTracersSurfaceValue represents only the + ! top layer of the ocean + else + + surfaceFreezingTemp = ocn_freezing_temperature(salinity=avgTracersSurfaceValue(index_salinitySurfaceValue, i), & + pressure=0.0_RKIND, inLandIceCavity=.false.) + + seaIceEnergy(i) = min(rho_sw*cp_sw*layerThickness(1, i)*( surfaceFreezingTemp + T0_Kelvin & + - avgTracersSurfaceValue(index_temperatureSurfaceValue, i) ), 0.0_RKIND ) + + end if + + o2x_om(n, index_o2x_Fioo_q) = seaIceEnergy(i) / ocn_cpl_dt + o2x_om(n, index_o2x_Fioo_frazil) = accumulatedFrazilIceMass(i) / ocn_cpl_dt + + else + + o2x_om(n, index_o2x_Fioo_q) = 0.0_RKIND + o2x_om(n, index_o2x_Fioo_frazil) = 0.0_RKIND + + end if + + ! Reset SeaIce Energy and Accumulated Frazil Ice + seaIceEnergy(i) = 0.0_RKIND + accumulatedFrazilIceMass(i) = 0.0_RKIND + frazilSurfacePressure(i) = 0.0_RKIND + end if + + ! BGC fields + if (config_use_ecosysTracers) then + ! convert from mmolC/m2/s to kg CO2/m2/s + o2x_om(n, index_o2x_Faoo_fco2_ocn) = avgCO2_gas_flux(i)*44.e-6_RKIND + endif + if (config_use_ecosysTracers .and. config_use_ecosysTracers_sea_ice_coupling) then + o2x_om(n, index_o2x_So_algae1) = max(0.0_RKIND,avgOceanSurfacePhytoC(1,i)) + o2x_om(n, index_o2x_So_algae2) = max(0.0_RKIND,avgOceanSurfacePhytoC(2,i)) + o2x_om(n, index_o2x_So_algae3) = max(0.0_RKIND,avgOceanSurfacePhytoC(3,i)) + o2x_om(n, index_o2x_So_dic1) = max(0.0_RKIND,avgOceanSurfaceDIC(i)) + o2x_om(n, index_o2x_So_no3) = max(0.0_RKIND,avgOceanSurfaceNO3(i)) + o2x_om(n, index_o2x_So_sio3) = max(0.0_RKIND,avgOceanSurfaceSiO3(i)) + o2x_om(n, index_o2x_So_nh4) = max(0.0_RKIND,avgOceanSurfaceNH4(i)) + o2x_om(n, index_o2x_So_docr) = max(0.0_RKIND,avgOceanSurfaceDOCr(i)) + o2x_om(n, index_o2x_So_fep1) = max(0.0_RKIND,avgOceanSurfaceFeParticulate(i)) + o2x_om(n, index_o2x_So_fed1) = max(0.0_RKIND,avgOceanSurfaceFeDissolved(i)) + endif + if (config_use_DMSTracers .and. config_use_DMSTracers_sea_ice_coupling) then + o2x_om(n, index_o2x_So_dms) = max(0.0_RKIND,avgOceanSurfaceDMS(i)) + o2x_om(n, index_o2x_So_dmsp) = max(0.0_RKIND,avgOceanSurfaceDMSP(i)) + endif + if (config_use_MacroMoleculesTracers .and. config_use_MacroMoleculesTracers_sea_ice_coupling) then + o2x_om(n, index_o2x_So_doc1) = max(0.0_RKIND,avgOceanSurfaceDOC(1,i)) + o2x_om(n, index_o2x_So_doc2) = max(0.0_RKIND,avgOceanSurfaceDOC(2,i)) + o2x_om(n, index_o2x_So_don1) = max(0.0_RKIND,avgOceanSurfaceDON(i)) + endif + + if ( trim(config_land_ice_flux_mode) .ne. 'pressure_only' ) then + o2x_om(n, index_o2x_So_blt) = landIceBoundaryLayerTracers(indexBLT,i) + o2x_om(n, index_o2x_So_bls) = landIceBoundaryLayerTracers(indexBLS,i) + o2x_om(n, index_o2x_So_htv) = landIceTracerTransferVelocities(indexHeatTrans,i) + o2x_om(n, index_o2x_So_stv) = landIceTracerTransferVelocities(indexSaltTrans,i) + o2x_om(n, index_o2x_So_rhoeff) = 0.0_RKIND + endif + + end do + + block_ptr => block_ptr % next + end do + + ent_type = 1 ! cells + ! set all tags in one method + tagname = trim(seq_flds_o2x_fields)//C_NULL_CHAR + ierr = iMOAB_SetDoubleTagStorage ( MPOID, tagname, totalmbls , ent_type, o2x_om(1, 1) ) + if ( ierr /= 0 ) then + write(ocnLogUnit,*) 'Fail to set MOAB fields ' + endif + !----------------------------------------------------------------------- + !EOC +!#ifdef MOABDEBUG + num_mb_exports = num_mb_exports +1 + write(lnum,"(I0.2)")num_mb_exports + outfile = 'ocn_export_'//trim(lnum)//'.h5m'//C_NULL_CHAR + wopts = 'PARALLEL=WRITE_PART'//C_NULL_CHAR + ierr = iMOAB_WriteMesh(MPOID, outfile, wopts) +!#endif + end subroutine ocn_export_moab!}}} +#endif + end module ocn_comp_mct !||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| From 1ccfc9af10a242b48b04655d41901da1feaf982d Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Mon, 11 Apr 2022 08:24:58 -0500 Subject: [PATCH 133/467] export rof fields also modify projection to ocean to project all fields from rof to ocean; save on ocean grid on coupler side for now --- components/mosart/src/cpl/rof_comp_mct.F90 | 218 ++++++++++++--------- driver-moab/main/prep_rof_mod.F90 | 44 ++--- 2 files changed, 139 insertions(+), 123 deletions(-) diff --git a/components/mosart/src/cpl/rof_comp_mct.F90 b/components/mosart/src/cpl/rof_comp_mct.F90 index acf17c0efb6f..dc46877ec926 100644 --- a/components/mosart/src/cpl/rof_comp_mct.F90 +++ b/components/mosart/src/cpl/rof_comp_mct.F90 @@ -54,6 +54,7 @@ module rof_comp_mct #ifdef HAVE_MOAB use seq_comm_mct, only : mrofid ! id of moab rof app use iso_c_binding + use iMOAB, only: iMOAB_DefineTagStorage #endif ! ! PUBLIC MEMBER FUNCTIONS: @@ -77,6 +78,8 @@ module rof_comp_mct #ifdef HAVE_MOAB private :: init_rof_moab ! create moab mesh (cloud of points) private :: rof_export_moab ! Export the river runoff model data to the MOAB coupler + integer , private :: mblsize, totalmbls + real (r8) , allocatable, private :: r2x_rm(:,:) ! moab fields, similar to r2x_rx transpose #endif ! PRIVATE DATA MEMBERS: @@ -98,6 +101,7 @@ subroutine rof_init_mct( EClock, cdata_r, x2r_r, r2x_r, NLFilename) ! !ARGUMENTS: #ifdef HAVE_MOAB use iMOAB , only : iMOAB_RegisterApplication + integer :: nsend ! number of fields in seq_flds_r2x_fields #endif type(ESMF_Clock), intent(inout) :: EClock ! Input synchronization clock type(seq_cdata), intent(inout) :: cdata_r ! Input runoff-model driver data @@ -140,8 +144,9 @@ subroutine rof_init_mct( EClock, cdata_r, x2r_r, r2x_r, NLFilename) character(len=*), parameter :: format = "('("//trim(sub)//") :',A)" #ifdef HAVE_MOAB - integer :: ierr + integer :: ierr, tagtype, numco, tagindex character*32 appname + character*400 tagname ! for fields #endif !--------------------------------------------------------------------------- @@ -292,21 +297,19 @@ subroutine rof_init_mct( EClock, cdata_r, x2r_r, r2x_r, NLFilename) endif call init_rof_moab() -#if 0 - if (masterproc) then - debugGSMapFile = shr_file_getUnit() - open( debugGSMapFile, file='LndGSmapC.txt') - write(debugGSMapFile,*) gsMap_lnd%comp_id - write(debugGSMapFile,*) gsMap_lnd%ngseg - write(debugGSMapFile,*) gsMap_lnd%gsize - do n=1,gsMap_lnd%ngseg - write(debugGSMapFile,*) gsMap_lnd%start(n),gsMap_lnd%length(n),gsMap_lnd%pe_loc(n) - end do - close(debugGSMapFile) - call shr_file_freeunit(debugGSMapFile) - endif -#endif - + ! initialize moab tag fields array + mblsize = lsize + nsend = mct_avect_nRattr(r2x_r) + totalmbls = mblsize * nsend ! size of the double array + allocate (r2x_rm(lsize, nsend) ) + ! define tags according to the seq_flds_r2x_fields + tagtype = 1 ! dense, double + numco = 1 ! one value per cell / entity + tagname = trim(seq_flds_r2x_fields)//C_NULL_CHAR + ierr = iMOAB_DefineTagStorage(mrofid, tagname, tagtype, numco, tagindex ) + if ( ierr == 1 ) then + call shr_sys_abort( sub//' ERROR: cannot define tags in moab' ) + end if ! endif HAVE_MOAB #endif else @@ -447,6 +450,10 @@ subroutine rof_final_mct( EClock, cdata_r, x2r_r, r2x_r) !----------------------------------------------------- ! fill this in +#ifdef HAVE_MOAB + ! deallocate moab fields array + deallocate (r2x_rm) +#endif end subroutine rof_final_mct !=============================================================================== @@ -873,17 +880,19 @@ subroutine init_rof_moab() if (ierr > 0 ) & call shr_sys_abort( sub//' Error: fail to set mask tag ') - ! define tags for data that will be sent to coupler - ! they will be associated to point cloud vertices - tagname='mbForr_rofl'//C_NULL_CHAR - tagtype = 1 ! dense, double - ierr = iMOAB_DefineTagStorage(mrofid, tagname, tagtype, numco, tagindex ) - if (ierr > 0 ) & - call shr_sys_abort( sub//' Error: fail to create mbForr_rofl tag ') - tagname='mbForr_rofi'//C_NULL_CHAR - ierr = iMOAB_DefineTagStorage(mrofid, tagname, tagtype, numco, tagindex ) - if (ierr > 0 ) & - call shr_sys_abort( sub//' Error: fail to create mbForr_rofi tag ') + ! ! define tags for data that will be sent to coupler + ! ! they will be associated to point cloud vertices + ! ! seq_flds_r2x_fields + + ! tagname='mbForr_rofl'//C_NULL_CHAR + ! tagtype = 1 ! dense, double + ! ierr = iMOAB_DefineTagStorage(mrofid, tagname, tagtype, numco, tagindex ) + ! if (ierr > 0 ) & + ! call shr_sys_abort( sub//' Error: fail to create mbForr_rofl tag ') + ! tagname='mbForr_rofi'//C_NULL_CHAR + ! ierr = iMOAB_DefineTagStorage(mrofid, tagname, tagtype, numco, tagindex ) + ! if (ierr > 0 ) & + ! call shr_sys_abort( sub//' Error: fail to create mbForr_rofi tag ') deallocate(moab_vert_coords) deallocate(vgids) @@ -913,79 +922,98 @@ subroutine rof_export_moab() ! ! LOCAL VARIABLES integer :: ni, n, nt, nliq, nfrz, lsz, ierr, ent_type + logical,save :: first_time = .true. integer, save :: num_mb_exports = 0 ! used for debugging character(len=32), parameter :: sub = 'rof_export_moab' - real(r8), dimension(:), allocatable :: liqrof ! temporary - real(r8), dimension(:), allocatable :: icerof ! temporary - character*100 outfile, wopts, localmeshfile, tagname, lnum + + character*100 outfile, wopts, localmeshfile, lnum + character*400 tagname !--------------------------------------------------------------------------- - nliq = 0 - nfrz = 0 - do nt = 1,nt_rtm - if (trim(rtm_tracers(nt)) == 'LIQ') then - nliq = nt - endif - if (trim(rtm_tracers(nt)) == 'ICE') then - nfrz = nt - endif - enddo - if (nliq == 0 .or. nfrz == 0) then - write(iulog,*) trim(sub),': ERROR in rtm_tracers LIQ ICE ',nliq,nfrz,rtm_tracers - call shr_sys_abort() - endif - ! number the local grid - lsz = rtmCTL%lnumr - - allocate(liqrof(lsz) ) ! use it for setting fields (moab tags) - allocate(icerof(lsz) ) - liqrof(:) = 0.0 - icerof(:) = 0.0 - - ni = 0 - if ( ice_runoff )then - ! separate liquid and ice runoff - do n = rtmCTL%begr,rtmCTL%endr - ni = ni + 1 - liqrof(ni) = rtmCTL%direct(n,nliq) / (rtmCTL%area(n)*0.001_r8) - icerof(ni) = rtmCTL%direct(n,nfrz) / (rtmCTL%area(n)*0.001_r8) - if (rtmCTL%mask(n) >= 2) then - ! liquid and ice runoff are treated separately - this is what goes to the ocean - liqrof(ni) = liqrof(ni) + & - rtmCTL%runoff(n,nliq) / (rtmCTL%area(n)*0.001_r8) - icerof(ni) = icerof(ni) + & - rtmCTL%runoff(n,nfrz) / (rtmCTL%area(n)*0.001_r8) - if (ni > rtmCTL%lnumr) then - write(iulog,*) sub, ' : ERROR runoff count',n,ni - call shr_sys_abort( sub//' : ERROR runoff > expected' ) - endif - endif - end do - else - ! liquid and ice runoff added to liquid runoff, ice runoff is zero - do n = rtmCTL%begr,rtmCTL%endr - ni = ni + 1 - liqrof(ni) = & - (rtmCTL%direct(n,nfrz)+rtmCTL%direct(n,nliq)) / (rtmCTL%area(n)*0.001_r8) - if (rtmCTL%mask(n) >= 2) then - liqrof(ni) = liqrof(ni) + & - (rtmCTL%runoff(n,nfrz)+rtmCTL%runoff(n,nliq)) / (rtmCTL%area(n)*0.001_r8) - if (ni > rtmCTL%lnumr) then - write(iulog,*) sub, ' : ERROR runoff count',n,ni - call shr_sys_abort( sub//' : ERROR runoff > expected' ) - endif - endif - end do - end if - tagname='mbForr_rofl'//C_NULL_CHAR + nfrz = 0 + do nt = 1,nt_rtm + if (trim(rtm_tracers(nt)) == 'LIQ') then + nliq = nt + endif + if (trim(rtm_tracers(nt)) == 'ICE') then + nfrz = nt + endif + enddo + if (nliq == 0 .or. nfrz == 0) then + write(iulog,*) trim(sub),': ERROR in rtm_tracers LIQ ICE ',nliq,nfrz,rtm_tracers + call shr_sys_abort() + endif + + r2x_rm = 0._r8 + + if (first_time) then + if (masterproc) then + if ( ice_runoff )then + write(iulog,*)'Snow capping will flow out in frozen river runoff' + else + write(iulog,*)'Snow capping will flow out in liquid river runoff' + endif + endif + first_time = .false. + end if + + ni = 0 + if ( ice_runoff )then + ! separate liquid and ice runoff + do n = rtmCTL%begr,rtmCTL%endr + ni = ni + 1 + r2x_rm(ni,index_r2x_Forr_rofl) = rtmCTL%direct(n,nliq) / (rtmCTL%area(n)*0.001_r8) + r2x_rm(ni,index_r2x_Forr_rofi) = rtmCTL%direct(n,nfrz) / (rtmCTL%area(n)*0.001_r8) + if (rtmCTL%mask(n) >= 2) then + ! liquid and ice runoff are treated separately - this is what goes to the ocean + r2x_rm(ni,index_r2x_Forr_rofl) = r2x_rm(ni,index_r2x_Forr_rofl) + & + rtmCTL%runoff(n,nliq) / (rtmCTL%area(n)*0.001_r8) + r2x_rm(ni,index_r2x_Forr_rofi) = r2x_rm(ni,index_r2x_Forr_rofi) + & + rtmCTL%runoff(n,nfrz) / (rtmCTL%area(n)*0.001_r8) + if (ni > rtmCTL%lnumr) then + write(iulog,*) sub, ' : ERROR runoff count',n,ni + call shr_sys_abort( sub//' : ERROR runoff > expected' ) + endif + endif + end do + else + ! liquid and ice runoff added to liquid runoff, ice runoff is zero + do n = rtmCTL%begr,rtmCTL%endr + ni = ni + 1 + r2x_rm(ni,index_r2x_Forr_rofl) = & + (rtmCTL%direct(n,nfrz)+rtmCTL%direct(n,nliq)) / (rtmCTL%area(n)*0.001_r8) + if (rtmCTL%mask(n) >= 2) then + r2x_rm(ni,index_r2x_Forr_rofl) = r2x_rm(ni,index_r2x_Forr_rofl) + & + (rtmCTL%runoff(n,nfrz)+rtmCTL%runoff(n,nliq)) / (rtmCTL%area(n)*0.001_r8) + if (ni > rtmCTL%lnumr) then + write(iulog,*) sub, ' : ERROR runoff count',n,ni + call shr_sys_abort( sub//' : ERROR runoff > expected' ) + endif + endif + end do + end if + + ! Flooding back to land, sign convention is positive in land->rof direction + ! so if water is sent from rof to land, the flux must be negative. + ni = 0 + do n = rtmCTL%begr, rtmCTL%endr + ni = ni + 1 + r2x_rm(ni,index_r2x_Flrr_flood) = -rtmCTL%flood(n) / (rtmCTL%area(n)*0.001_r8) + r2x_rm(ni,index_r2x_Flrr_volr) = (Trunoff%wr(n,nliq) + Trunoff%wt(n,nliq)) / rtmCTL%area(n) + r2x_rm(ni,index_r2x_Flrr_volrmch) = Trunoff%wr(n,nliq) / rtmCTL%area(n) + r2x_rm(ni,index_r2x_Flrr_supply) = 0._r8 + r2x_rm(ni,index_r2x_Flrr_deficit) = 0._r8 + if (wrmflag) then + r2x_rm(ni,index_r2x_Flrr_supply) = StorWater%Supply(n) / (rtmCTL%area(n)*0.001_r8) !converted to mm/s + r2x_rm(ni,index_r2x_Flrr_deficit) = (abs(rtmCTL%qdem(n,nliq)) - abs(StorWater%Supply(n))) / (rtmCTL%area(n)*0.001_r8) !send deficit back to ELM + endif + end do + + tagname=trim(seq_flds_r2x_fields)//C_NULL_CHAR ent_type = 0 ! vertices - ierr = iMOAB_SetDoubleTagStorage ( mrofid, tagname, lsz , ent_type, liqrof ) - if (ierr > 0 ) & - call shr_sys_abort( sub//' Error: fail to set mbForr_rofl tag ') - tagname='mbForr_rofi'//C_NULL_CHAR - ierr = iMOAB_SetDoubleTagStorage ( mrofid, tagname, lsz , ent_type, icerof ) + ierr = iMOAB_SetDoubleTagStorage ( mrofid, tagname, totalmbls , ent_type, r2x_rm(1,1) ) if (ierr > 0 ) & - call shr_sys_abort( sub//' Error: fail to set mbForr_rofi tag ') + call shr_sys_abort( sub//' Error: fail to set moab '// trim(seq_flds_r2x_fields) ) #ifdef MOABDEBUG num_mb_exports = num_mb_exports +1 @@ -997,8 +1025,6 @@ subroutine rof_export_moab() call shr_sys_abort( sub//' fail to write the runoff mesh file with data') #endif - deallocate(liqrof) - deallocate(icerof) ! end copy end subroutine rof_export_moab diff --git a/driver-moab/main/prep_rof_mod.F90 b/driver-moab/main/prep_rof_mod.F90 index ed0108d5f184..c7be310dc636 100644 --- a/driver-moab/main/prep_rof_mod.F90 +++ b/driver-moab/main/prep_rof_mod.F90 @@ -323,40 +323,30 @@ subroutine prep_rof_ocn_moab(infodata) write(logunit,*) subname,' migrated mesh for map rof 2 ocn ' endif if (mbrxoid .ge. 0) then ! we are on coupler side pes - tagname='mbForr_rofl'//C_NULL_CHAR + tagname=trim(seq_flds_r2x_fields)//C_NULL_CHAR tagtype = 1 ! dense, double numco= 1 ! 1 scalar per node ierr = iMOAB_DefineTagStorage(mbrxoid, tagname, tagtype, numco, tagindex ) if (ierr .ne. 0) then - write(logunit,*) subname,' error in defining mbForr_rofl tag ' - call shr_sys_abort(subname//' ERROR in defining mbForr_rofl tag ') + write(logunit,*) subname,' error in defining ' // trim(seq_flds_r2x_fields) // ' tags on coupler side in MOAB' + call shr_sys_abort(subname//' ERROR in defining MOAB tags ') endif - tagname='mbForr_rofi'//C_NULL_CHAR - ierr = iMOAB_DefineTagStorage(mbrxoid, tagname, tagtype, numco, tagindex ) - if (ierr .ne. 0) then - write(logunit,*) subname,' error in defining mbForr_rofi tag ' - call shr_sys_abort(subname//' ERROR in defining mbForr_rofi tag ') - endif - endif - if (mboxid .ge. 0) then ! we are on coupled side, define the tags for projection on ocea coupler side - tagname='mbForr_rofl_proj'//C_NULL_CHAR + + if (mboxid .ge. 0) then ! we are on coupler side pes, for ocean mesh + tagname=trim(seq_flds_r2x_fields)//C_NULL_CHAR tagtype = 1 ! dense, double numco= 1 ! 1 scalar per node ierr = iMOAB_DefineTagStorage(mboxid, tagname, tagtype, numco, tagindex ) if (ierr .ne. 0) then - write(logunit,*) subname,' error in defining mbForr_rofl_proj tag ' - call shr_sys_abort(subname//' ERROR in defining mbForr_rofl_proj tag ') + write(logunit,*) subname,' error in defining ' // trim(seq_flds_r2x_fields) // ' tags on coupler side in MOAB, for ocean app' + call shr_sys_abort(subname//' ERROR in defining MOAB tags ') endif - tagname='mbForr_rofi_proj'//C_NULL_CHAR - ierr = iMOAB_DefineTagStorage(mboxid, tagname, tagtype, numco, tagindex ) - if (ierr .ne. 0) then - write(logunit,*) subname,' error in defining mbForr_rofi_proj tag ' - call shr_sys_abort(subname//' ERROR in defining mbForr_rofi_proj tag ') - endif endif + + if (iamroot_CPLID) then - write(logunit,*) subname,' created moab tags for mbForr_rofl, mbForr_rofi ' + write(logunit,*) subname,' created moab tags for seq_flds_r2x_fields ' endif #ifdef MOABDEBUG call seq_comm_getData(CPLID ,mpicom=mpicom_CPLID) @@ -381,7 +371,7 @@ subroutine prep_rof_migrate_moab(infodata) iMOAB_ApplyScalarProjectionWeights, iMOAB_WriteMesh !--------------------------------------------------------------- ! Description similar to prep_atm_migrate_moab; will also do the projection on coupler pes - ! After mbForr_rofl, mbForr_rofi tags were loaded on rof mesh, + ! After seq_flds_r2x_fields tags were loaded on rof mesh, ! they need to be migrated to the coupler pes, for weight application ; later, we will send it to ocean pes ! ! Arguments @@ -399,8 +389,9 @@ subroutine prep_rof_migrate_moab(infodata) integer :: rof_id integer :: context_id ! we will use ocean context on coupler integer, save :: num_prof = 0 ! use to count the projections - character*32 :: dm1, dm2, tagName, wgtIdef - character*50 :: outfile, wopts, tagnameProj, lnum + character*32 :: dm1, dm2, wgtIdef + character*50 :: outfile, wopts, lnum + character*400 :: tagname ! for seq_flds_r2x_fields integer :: orderROF, orderOCN, volumetric, noConserve, validate integer, save :: num_proj = 0 ! for counting projections @@ -424,8 +415,7 @@ subroutine prep_rof_migrate_moab(infodata) ! we should do this only if ocn_present context_id = ocn(1)%cplcompid wgtIdef = 'map-from-file'//C_NULL_CHAR - tagName = 'mbForr_rofl:mbForr_rofi:'//C_NULL_CHAR - tagNameProj = 'mbForr_rofl_proj:mbForr_rofi_proj:'//C_NULL_CHAR + tagName = trim(seq_flds_r2x_fields)//C_NULL_CHAR num_proj = num_proj + 1 if (rof_present .and. ocn_present) then @@ -470,7 +460,7 @@ subroutine prep_rof_migrate_moab(infodata) ! we could apply weights; need to use the same weight identifier wgtIdef as when we generated it ! hard coded now, it should be a runtime option in the future - ierr = iMOAB_ApplyScalarProjectionWeights ( mbrmapro, wgtIdef, tagName, tagNameProj) + ierr = iMOAB_ApplyScalarProjectionWeights ( mbrmapro, wgtIdef, tagName, tagName) if (ierr .ne. 0) then write(logunit,*) subname,' error in applying weights ' call shr_sys_abort(subname//' ERROR in applying weights') From 5364e07d36dbbc8f6db248e0df8e9f709112c013 Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Mon, 11 Apr 2022 10:43:14 -0500 Subject: [PATCH 134/467] add land export --- components/elm/src/cpl/lnd_comp_mct.F90 | 184 +++++++++++++++++++++++- 1 file changed, 177 insertions(+), 7 deletions(-) diff --git a/components/elm/src/cpl/lnd_comp_mct.F90 b/components/elm/src/cpl/lnd_comp_mct.F90 index e998963a8aa8..817e4815626e 100644 --- a/components/elm/src/cpl/lnd_comp_mct.F90 +++ b/components/elm/src/cpl/lnd_comp_mct.F90 @@ -13,6 +13,10 @@ module lnd_comp_mct use decompmod , only : bounds_type, ldecomp use lnd_import_export use iso_c_binding + +#ifdef HAVE_MOAB + use seq_comm_mct, only: mlnid, sameg_al! id of moab land app +#endif ! ! !public member functions: implicit none @@ -30,6 +34,9 @@ module lnd_comp_mct #ifdef HAVE_MOAB private :: init_land_moab ! create moab mesh (cloud of points) + private :: lnd_export_moab ! it should be part of lnd_import_export, but we will keep it here + integer , private :: mblsize, totalmbls + real (r8) , allocatable, private :: l2x_lm(:,:) ! for tags in MOAB #endif !--------------------------------------------------------------------------- @@ -75,7 +82,6 @@ subroutine lnd_init_mct( EClock, cdata_l, x2l_l, l2x_l, NLFilename ) use ESMF #ifdef HAVE_MOAB use iMOAB , only : iMOAB_RegisterApplication - use seq_comm_mct, only: mlnid ! id of moab land app #endif ! ! !ARGUMENTS: @@ -85,7 +91,7 @@ subroutine lnd_init_mct( EClock, cdata_l, x2l_l, l2x_l, NLFilename ) character(len=*), optional, intent(in) :: NLFilename ! Namelist filename to read ! ! !LOCAL VARIABLES: - integer :: LNDID ! Land identifyer + integer :: LNDID ! Land identifier integer :: mpicom_lnd ! MPI communicator type(mct_gsMap), pointer :: GSMap_lnd ! Land model MCT GS map type(mct_gGrid), pointer :: dom_l ! Land model domain @@ -126,7 +132,7 @@ subroutine lnd_init_mct( EClock, cdata_l, x2l_l, l2x_l, NLFilename ) character(len=*), parameter :: format = "('("//trim(sub)//") :',A)" #ifdef HAVE_MOAB - integer :: ierr + integer :: ierr, nsend character*32 appname logical :: samegrid_al ! character(len=SHR_KIND_CL) :: atm_gnam ! atm grid @@ -276,7 +282,7 @@ subroutine lnd_init_mct( EClock, cdata_l, x2l_l, l2x_l, NLFilename ) call get_proc_bounds( bounds ) - call lnd_SetgsMap_mct( bounds, mpicom_lnd, LNDID, gsMap_lnd ) + call lnd_SetgsMap_mct( bounds, mpicom_lnd, LNDID, gsMap_lnd ) lsz = mct_gsMap_lsize(gsMap_lnd, mpicom_lnd) #ifdef HAVE_MOAB appname="LNDMB"//C_NULL_CHAR @@ -323,6 +329,12 @@ subroutine lnd_init_mct( EClock, cdata_l, x2l_l, l2x_l, NLFilename ) call mct_aVect_init(l2x_l, rList=seq_flds_l2x_fields, lsize=lsz) call mct_aVect_zero(l2x_l) +#ifdef HAVE_MOAB + mblsize = lsz + nsend = mct_avect_nRattr(l2x_l) + totalmbls = mblsize * nsend ! size of the double array + allocate (l2x_lm(lsz, nsend) ) +#endif ! Finish initializing elm call initialize2() @@ -346,6 +358,9 @@ subroutine lnd_init_mct( EClock, cdata_l, x2l_l, l2x_l, NLFilename ) if (atm_present) then call lnd_export(bounds, lnd2atm_vars, lnd2glc_vars, l2x_l%rattr) +#ifdef HAVE_MOAB + call lnd_export_moab(bounds, lnd2atm_vars, lnd2glc_vars) ! it is private here +#endif endif ! Fill in infodata settings @@ -623,6 +638,10 @@ subroutine lnd_final_mct( EClock, cdata_l, x2l_l, l2x_l) !--------------------------------------------------------------------------- ! fill this in +#ifdef HAVE_MOAB + ! deallocate moab fields array + deallocate (l2x_lm) +#endif call final() end subroutine lnd_final_mct @@ -767,8 +786,7 @@ end subroutine lnd_domain_mct #ifdef HAVE_MOAB subroutine init_land_moab(bounds, samegrid_al) - use seq_comm_mct, only: mlnid ! id of moab land app - use seq_comm_mct, only: sameg_al ! same grid as atm + use seq_flds_mod , only : seq_flds_l2x_fields use spmdMod , only: iam ! rank on the land communicator use domainMod , only: ldomain ! ldomain is coming from module, not even passed use elm_varcon , only: re @@ -792,7 +810,8 @@ subroutine init_land_moab(bounds, samegrid_al) real(r8) :: latv, lonv integer dims, i, iv, ilat, ilon, igdx, ierr, tagindex integer tagtype, numco, ent_type, mbtype, block_ID - character*100 outfile, wopts, localmeshfile, tagname + character*100 outfile, wopts, localmeshfile + character*400 tagname ! hold all fields integer, allocatable :: moabconn(:) ! will have the connectivity in terms of local index in verts @@ -996,6 +1015,157 @@ subroutine init_land_moab(bounds, samegrid_al) if (ierr > 0 ) & call endrun('Error: fail to write the land mesh file') #endif + ! define all tags from seq_flds_l2x_fields + ! define tags according to the seq_flds_l2x_fields + tagtype = 1 ! dense, double + numco = 1 ! one value per cell / entity + tagname = trim(seq_flds_l2x_fields)//C_NULL_CHAR + ierr = iMOAB_DefineTagStorage(mlnid, tagname, tagtype, numco, tagindex ) + if ( ierr > 0) then + call endrun('Error: fail to define seq_flds_l2x_fields for land moab mesh') + endif end subroutine init_land_moab + + subroutine lnd_export_moab( bounds, lnd2atm_vars, lnd2glc_vars) + + !--------------------------------------------------------------------------- + ! !DESCRIPTION: + ! Convert the data to be sent from the elm model to the moab coupler + ! + ! !USES: + use shr_kind_mod , only : r8 => shr_kind_r8 + use elm_varctl , only : iulog, create_glacier_mec_landunit + use clm_time_manager , only : get_nstep, get_step_size + use domainMod , only : ldomain + use seq_drydep_mod , only : n_drydep + use shr_megan_mod , only : shr_megan_mechcomps_n + use iMOAB, only : iMOAB_SetDoubleTagStorage, iMOAB_WriteMesh + use seq_flds_mod, only : seq_flds_l2x_fields + ! + ! !ARGUMENTS: + implicit none + type(bounds_type) , intent(in) :: bounds ! bounds + type(lnd2atm_type), intent(inout) :: lnd2atm_vars ! clm land to atmosphere exchange data type + type(lnd2glc_type), intent(inout) :: lnd2glc_vars ! clm land to atmosphere exchange data type + ! + ! !LOCAL VARIABLES: + integer :: g,i ! indices + integer :: ier ! error status + integer :: nstep ! time step index + integer :: dtime ! time step + integer :: num ! counter + character(len=*), parameter :: sub = 'lnd_export_moab' + integer, save :: num_mb_exports = 0 ! used for debugging + integer :: ent_type, ierr + character(len=100) :: outfile, wopts, lnum + character(len=400) :: tagname + !--------------------------------------------------------------------------- + + ! cesm sign convention is that fluxes are positive downward + + l2x_lm(:,:) = 0.0_r8 + + do g = bounds%begg,bounds%endg + i = 1 + (g-bounds%begg) + l2x_lm(i,index_l2x_Sl_t) = lnd2atm_vars%t_rad_grc(g) + l2x_lm(i,index_l2x_Sl_snowh) = lnd2atm_vars%h2osno_grc(g) + l2x_lm(i,index_l2x_Sl_avsdr) = lnd2atm_vars%albd_grc(g,1) + l2x_lm(i,index_l2x_Sl_anidr) = lnd2atm_vars%albd_grc(g,2) + l2x_lm(i,index_l2x_Sl_avsdf) = lnd2atm_vars%albi_grc(g,1) + l2x_lm(i,index_l2x_Sl_anidf) = lnd2atm_vars%albi_grc(g,2) + l2x_lm(i,index_l2x_Sl_tref) = lnd2atm_vars%t_ref2m_grc(g) + l2x_lm(i,index_l2x_Sl_qref) = lnd2atm_vars%q_ref2m_grc(g) + l2x_lm(i,index_l2x_Sl_u10) = lnd2atm_vars%u_ref10m_grc(g) + l2x_lm(i,index_l2x_Fall_taux) = -lnd2atm_vars%taux_grc(g) + l2x_lm(i,index_l2x_Fall_tauy) = -lnd2atm_vars%tauy_grc(g) + l2x_lm(i,index_l2x_Fall_lat) = -lnd2atm_vars%eflx_lh_tot_grc(g) + l2x_lm(i,index_l2x_Fall_sen) = -lnd2atm_vars%eflx_sh_tot_grc(g) + l2x_lm(i,index_l2x_Fall_lwup) = -lnd2atm_vars%eflx_lwrad_out_grc(g) + l2x_lm(i,index_l2x_Fall_evap) = -lnd2atm_vars%qflx_evap_tot_grc(g) + l2x_lm(i,index_l2x_Fall_swnet) = lnd2atm_vars%fsa_grc(g) + if (index_l2x_Fall_fco2_lnd /= 0) then + l2x_lm(i,index_l2x_Fall_fco2_lnd) = -lnd2atm_vars%nee_grc(g) + end if + + ! Additional fields for DUST, PROGSSLT, dry-deposition and VOC + ! These are now standard fields, but the check on the index makes sure the driver handles them + if (index_l2x_Sl_ram1 /= 0 ) l2x_lm(i,index_l2x_Sl_ram1) = lnd2atm_vars%ram1_grc(g) + if (index_l2x_Sl_fv /= 0 ) l2x_lm(i,index_l2x_Sl_fv) = lnd2atm_vars%fv_grc(g) + if (index_l2x_Sl_soilw /= 0 ) l2x_lm(i,index_l2x_Sl_soilw) = lnd2atm_vars%h2osoi_vol_grc(g,1) + if (index_l2x_Fall_flxdst1 /= 0 ) l2x_lm(i,index_l2x_Fall_flxdst1)= -lnd2atm_vars%flxdst_grc(g,1) + if (index_l2x_Fall_flxdst2 /= 0 ) l2x_lm(i,index_l2x_Fall_flxdst2)= -lnd2atm_vars%flxdst_grc(g,2) + if (index_l2x_Fall_flxdst3 /= 0 ) l2x_lm(i,index_l2x_Fall_flxdst3)= -lnd2atm_vars%flxdst_grc(g,3) + if (index_l2x_Fall_flxdst4 /= 0 ) l2x_lm(i,index_l2x_Fall_flxdst4)= -lnd2atm_vars%flxdst_grc(g,4) + + + ! for dry dep velocities + if (index_l2x_Sl_ddvel /= 0 ) then + l2x_lm(i,index_l2x_Sl_ddvel:index_l2x_Sl_ddvel+n_drydep-1) = & + lnd2atm_vars%ddvel_grc(g,:n_drydep) + end if + + ! for MEGAN VOC emis fluxes + if (index_l2x_Fall_flxvoc /= 0 ) then + l2x_lm(i,index_l2x_Fall_flxvoc:index_l2x_Fall_flxvoc+shr_megan_mechcomps_n-1) = & + -lnd2atm_vars%flxvoc_grc(g,:shr_megan_mechcomps_n) + end if + + if (index_l2x_Fall_methane /= 0) then + l2x_lm(i,index_l2x_Fall_methane) = -lnd2atm_vars%flux_ch4_grc(g) + endif + + ! sign convention is positive downward with + ! hierarchy of atm/glc/lnd/rof/ice/ocn. so water sent from land to rof is positive + + l2x_lm(i,index_l2x_Flrl_rofi) = lnd2atm_vars%qflx_rofice_grc(g) + l2x_lm(i,index_l2x_Flrl_rofsur) = lnd2atm_vars%qflx_rofliq_qsur_grc(g) & + + lnd2atm_vars%qflx_rofliq_qsurp_grc(g) ! surface ponding + l2x_lm(i,index_l2x_Flrl_rofsub) = lnd2atm_vars%qflx_rofliq_qsub_grc(g) & + + lnd2atm_vars%qflx_rofliq_qsubp_grc(g) ! perched drainiage + l2x_lm(i,index_l2x_Flrl_rofgwl) = lnd2atm_vars%qflx_rofliq_qgwl_grc(g) + + l2x_lm(i,index_l2x_Flrl_demand) = lnd2atm_vars%qflx_irr_demand_grc(g) ! needs to be filled in + if (l2x_lm(i,index_l2x_Flrl_demand) > 0.0_r8) then + write(iulog,*)'lnd2atm_vars%qflx_irr_demand_grc is',lnd2atm_vars%qflx_irr_demand_grc(g) + write(iulog,*)'l2x_lm(i,index_l2x_Flrl_demand) is',l2x_lm(i,index_l2x_Flrl_demand) + call endrun( sub//' ERROR: demand must be <= 0.') + endif + l2x_lm(i,index_l2x_Flrl_Tqsur) = lnd2atm_vars%Tqsur_grc(g) + l2x_lm(i,index_l2x_Flrl_Tqsub) = lnd2atm_vars%Tqsub_grc(g) + l2x_lm(i,index_l2x_coszen_str) = lnd2atm_vars%coszen_str(g) + ! glc coupling + + if (create_glacier_mec_landunit) then + do num = 0,glc_nec + l2x_lm(i,index_l2x_Sl_tsrf(num)) = lnd2glc_vars%tsrf_grc(g,num) + l2x_lm(i,index_l2x_Sl_topo(num)) = lnd2glc_vars%topo_grc(g,num) + l2x_lm(i,index_l2x_Flgl_qice(num)) = lnd2glc_vars%qice_grc(g,num) + end do + end if + + end do + tagname=trim(seq_flds_l2x_fields)//C_NULL_CHAR + if (sameg_al) then + ent_type = 0 ! vertices, cells only if sameg_al false + else + ent_type = 1 + endif + ierr = iMOAB_SetDoubleTagStorage ( mlnid, tagname, totalmbls , ent_type, l2x_lm(1,1) ) + if (ierr > 0 ) & + call shr_sys_abort( sub//' Error: fail to set moab '// trim(seq_flds_l2x_fields) ) + +#ifdef MOABDEBUG + num_mb_exports = num_mb_exports +1 + write(lnum,"(I0.2)")num_mb_exports + outfile = 'lnd_export_'//trim(lnum)//'.h5m'//C_NULL_CHAR + wopts = 'PARALLEL=WRITE_PART'//C_NULL_CHAR + ierr = iMOAB_WriteMesh(mlnid, outfile, wopts) + if (ierr > 0 ) & + call shr_sys_abort( sub//' fail to write the land mesh file with data') #endif + + end subroutine lnd_export_moab +! endif for ifdef HAVE_MOAB +#endif + end module lnd_comp_mct From 95b13f735b53e3a9e0a1618c8fa3abf74f2cf8fc Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Tue, 12 Apr 2022 23:35:54 -0500 Subject: [PATCH 135/467] modify atm phys grid export export all fields, and move it to atm_comp_mct file --- components/eam/src/cpl/atm_comp_mct.F90 | 151 ++++++++++++++++--- components/eam/src/cpl/atm_import_export.F90 | 64 -------- 2 files changed, 134 insertions(+), 81 deletions(-) diff --git a/components/eam/src/cpl/atm_comp_mct.F90 b/components/eam/src/cpl/atm_comp_mct.F90 index 37f027529c73..66728f5287be 100644 --- a/components/eam/src/cpl/atm_comp_mct.F90 +++ b/components/eam/src/cpl/atm_comp_mct.F90 @@ -23,8 +23,10 @@ module atm_comp_mct use shr_taskmap_mod , only: shr_taskmap_write use cam_cpl_indices - ! it has atm_import, atm_export and cam_moab_phys_export + ! it has atm_import, atm_export use atm_import_export + ! cam_moab_phys_export is private here + ! we defined cam_moab_export in cam_comp; it has cam_init, cam_run1, 2, 3, 4, cam_final use cam_comp use cam_instance , only: cam_instance_init, inst_index, inst_suffix @@ -104,6 +106,12 @@ module atm_comp_mct integer, pointer :: dof(:) ! needed for pio_init decomp for restarts type(seq_infodata_type), pointer :: infodata + +#ifdef HAVE_MOAB + ! to store all fields to be set in moab + integer , private :: mblsize, totalmbls, nsend + real(r8) , allocatable, private :: a2x_am(:,:) ! atm to coupler, on atm mesh +#endif ! !================================================================================ CONTAINS @@ -382,6 +390,10 @@ subroutine atm_init_mct( EClock, cdata_a, x2a_a, a2x_a, NLFilename ) ! on the atm #ifdef HAVE_MOAB call initialize_moab_atm_phys( cdata_a ) + mblsize = lsize + nsend = mct_avect_nRattr(a2x_a) + totalmbls = mblsize * nsend ! size of the double array + allocate (a2x_am(mblsize, nsend) ) #endif first_time = .false. @@ -600,7 +612,7 @@ subroutine atm_run_mct( EClock, cdata_a, x2a_a, a2x_a) ! move method out of the do while (.not. do send) loop; do not send yet call cam_moab_export() - ! method to load temp, u and v on moab atm phys grd; + ! call method to set all seq_flds_a2x_fields on phys grid point cloud; ! it will be moved then to Atm Spectral mesh on coupler ; just to show how to move it to atm spectral ! on coupler call cam_moab_phys_export(cam_out) @@ -1024,7 +1036,8 @@ subroutine initialize_moab_atm_phys( cdata_a ) integer , dimension(:), allocatable :: chunk_index(:) ! temporary !real(r8), parameter:: radtodeg = 180.0_r8/SHR_CONST_PI - character*100 outfile, wopts, tagname + character*100 outfile, wopts + character*400 tagname ! will store all seq_flds_a2x_fields character*32 appname @@ -1125,20 +1138,20 @@ subroutine initialize_moab_atm_phys( cdata_a ) if (ierr > 0 ) & call endrun('Error: fail to set area tag ') - ! create some tags for T, u, v bottoms - - tagname='T_ph'//C_NULL_CHAR - ierr = iMOAB_DefineTagStorage(mphaid, tagname, tagtype, numco, tagindex ) - if (ierr > 0 ) & - call endrun('Error: fail to create temp on phys tag ') - tagname='u_ph'//C_NULL_CHAR - ierr = iMOAB_DefineTagStorage(mphaid, tagname, tagtype, numco, tagindex ) - if (ierr > 0 ) & - call endrun('Error: fail to create u velo on phys tag ') - tagname='v_ph'//C_NULL_CHAR - ierr = iMOAB_DefineTagStorage(mphaid, tagname, tagtype, numco, tagindex ) - if (ierr > 0 ) & - call endrun('Error: fail to create v velo on phys tag ') + ! ! create some tags for T, u, v bottoms: not anymore + + ! tagname='T_ph'//C_NULL_CHAR + ! ierr = iMOAB_DefineTagStorage(mphaid, tagname, tagtype, numco, tagindex ) + ! if (ierr > 0 ) & + ! call endrun('Error: fail to create temp on phys tag ') + ! tagname='u_ph'//C_NULL_CHAR + ! ierr = iMOAB_DefineTagStorage(mphaid, tagname, tagtype, numco, tagindex ) + ! if (ierr > 0 ) & + ! call endrun('Error: fail to create u velo on phys tag ') + ! tagname='v_ph'//C_NULL_CHAR + ! ierr = iMOAB_DefineTagStorage(mphaid, tagname, tagtype, numco, tagindex ) + ! if (ierr > 0 ) & + ! call endrun('Error: fail to create v velo on phys tag ') ! need to identify that the mesh is indeed point cloud ! this call will set the point_cloud to true inside iMOAB appData structure @@ -1164,6 +1177,15 @@ subroutine initialize_moab_atm_phys( cdata_a ) if (ierr > 0 ) & call endrun('Error: fail to write the atm phys mesh file') #endif + ! define fields seq_flds_a2x_fields + tagtype = 1 ! dense, double + numco = 1 ! one value per vertex / entity + tagname = trim(seq_flds_a2x_fields)//C_NULL_CHAR + ierr = iMOAB_DefineTagStorage(mphaid, tagname, tagtype, numco, tagindex ) + if ( ierr > 0) then + call endrun('Error: fail to define seq_flds_a2x_fields for atm physgrid moab mesh') + endif + num_moab_exports = 0 ! will be used for counting number of calls deallocate(moab_vert_coords) deallocate(vgids) @@ -1171,6 +1193,101 @@ subroutine initialize_moab_atm_phys( cdata_a ) deallocate(chunk_index) end subroutine initialize_moab_atm_phys + + subroutine cam_moab_phys_export(cam_out) + !------------------------------------------------------------------- + use camsrfexch, only: cam_out_t + use phys_grid , only: get_ncols_p, get_nlcols_p + use ppgrid , only: begchunk, endchunk + use seq_comm_mct, only: mphaid ! imoab pid for atm physics + use seq_comm_mct, only : num_moab_exports ! + use cam_abortutils , only: endrun + use iMOAB, only: iMOAB_WriteMesh, iMOAB_SetDoubleTagStorage + use iso_c_binding + ! + ! Arguments + ! + type(cam_out_t), intent(in) :: cam_out(begchunk:endchunk) + + integer tagtype, numco, ent_type + character*100 outfile, wopts, lnum + character*400 tagname ! + + integer ierr, c, nlcols, ig, i, ncols + + ! Copy from component arrays into chunk array data structure + ! Rearrange data from chunk structure into lat-lon buffer and subsequently + ! create double array for moab tags + + ig=1 + do c=begchunk, endchunk + ncols = get_ncols_p(c) + do i=1,ncols + a2x_am(ig, index_a2x_Sa_pslv ) = cam_out(c)%psl(i) + a2x_am(ig, index_a2x_Sa_z ) = cam_out(c)%zbot(i) + a2x_am(ig, index_a2x_Sa_u ) = cam_out(c)%ubot(i) + a2x_am(ig, index_a2x_Sa_v ) = cam_out(c)%vbot(i) + a2x_am(ig, index_a2x_Sa_tbot ) = cam_out(c)%tbot(i) + a2x_am(ig, index_a2x_Sa_ptem ) = cam_out(c)%thbot(i) + a2x_am(ig, index_a2x_Sa_pbot ) = cam_out(c)%pbot(i) + a2x_am(ig, index_a2x_Sa_shum ) = cam_out(c)%qbot(i,1) + a2x_am(ig, index_a2x_Sa_dens ) = cam_out(c)%rho(i) + a2x_am(ig, index_a2x_Faxa_swnet) = cam_out(c)%netsw(i) + a2x_am(ig, index_a2x_Faxa_lwdn ) = cam_out(c)%flwds(i) + a2x_am(ig, index_a2x_Faxa_rainc) = (cam_out(c)%precc(i)-cam_out(c)%precsc(i))*1000._r8 + a2x_am(ig, index_a2x_Faxa_rainl) = (cam_out(c)%precl(i)-cam_out(c)%precsl(i))*1000._r8 + a2x_am(ig, index_a2x_Faxa_snowc) = cam_out(c)%precsc(i)*1000._r8 + a2x_am(ig, index_a2x_Faxa_snowl) = cam_out(c)%precsl(i)*1000._r8 + a2x_am(ig, index_a2x_Faxa_swndr) = cam_out(c)%soll(i) + a2x_am(ig, index_a2x_Faxa_swvdr) = cam_out(c)%sols(i) + a2x_am(ig, index_a2x_Faxa_swndf) = cam_out(c)%solld(i) + a2x_am(ig, index_a2x_Faxa_swvdf) = cam_out(c)%solsd(i) + + ! aerosol deposition fluxes + a2x_am(ig, index_a2x_Faxa_bcphidry) = cam_out(c)%bcphidry(i) + a2x_am(ig, index_a2x_Faxa_bcphodry) = cam_out(c)%bcphodry(i) + a2x_am(ig, index_a2x_Faxa_bcphiwet) = cam_out(c)%bcphiwet(i) + a2x_am(ig, index_a2x_Faxa_ocphidry) = cam_out(c)%ocphidry(i) + a2x_am(ig, index_a2x_Faxa_ocphodry) = cam_out(c)%ocphodry(i) + a2x_am(ig, index_a2x_Faxa_ocphiwet) = cam_out(c)%ocphiwet(i) + a2x_am(ig, index_a2x_Faxa_dstwet1) = cam_out(c)%dstwet1(i) + a2x_am(ig, index_a2x_Faxa_dstdry1) = cam_out(c)%dstdry1(i) + a2x_am(ig, index_a2x_Faxa_dstwet2) = cam_out(c)%dstwet2(i) + a2x_am(ig, index_a2x_Faxa_dstdry2) = cam_out(c)%dstdry2(i) + a2x_am(ig, index_a2x_Faxa_dstwet3) = cam_out(c)%dstwet3(i) + a2x_am(ig, index_a2x_Faxa_dstdry3) = cam_out(c)%dstdry3(i) + a2x_am(ig, index_a2x_Faxa_dstwet4) = cam_out(c)%dstwet4(i) + a2x_am(ig, index_a2x_Faxa_dstdry4) = cam_out(c)%dstdry4(i) + + if (index_a2x_Sa_co2prog /= 0) then + a2x_am(ig, index_a2x_Sa_co2prog) = cam_out(c)%co2prog(i) ! atm prognostic co2 + end if + if (index_a2x_Sa_co2diag /= 0) then + a2x_am(ig, index_a2x_Sa_co2diag) = cam_out(c)%co2diag(i) ! atm diagnostic co2 + end if + + ig=ig+1 + end do + end do + tagname=trim(seq_flds_a2x_fields)//C_NULL_CHAR + ent_type = 0 ! vertices, point cloud + ierr = iMOAB_SetDoubleTagStorage ( mphaid, tagname, totalmbls , ent_type, a2x_am(1,1) ) + if ( ierr > 0) then + call endrun('Error: fail to set seq_flds_a2x_fields for atm physgrid moab mesh') + endif +#ifdef MOABDEBUG + num_moab_exports = num_moab_exports + 1 + write(lnum,"(I0.2)")num_moab_exports + outfile = 'AtmPhys_'//trim(lnum)//'.h5m'//C_NULL_CHAR + wopts = 'PARALLEL=WRITE_PART'//C_NULL_CHAR + ierr = iMOAB_WriteMesh(mphaid, outfile, wopts) + if (ierr > 0 ) & + call endrun('Error: fail to write the atm phys mesh file with data') +#endif + + + end subroutine cam_moab_phys_export + #endif end module atm_comp_mct diff --git a/components/eam/src/cpl/atm_import_export.F90 b/components/eam/src/cpl/atm_import_export.F90 index ba277eb525af..3c755fa420ad 100644 --- a/components/eam/src/cpl/atm_import_export.F90 +++ b/components/eam/src/cpl/atm_import_export.F90 @@ -298,69 +298,5 @@ subroutine atm_export( cam_out, a2x ) end do end subroutine atm_export -#ifdef HAVE_MOAB - subroutine cam_moab_phys_export(cam_out) - !------------------------------------------------------------------- - use camsrfexch, only: cam_out_t - use phys_grid , only: get_ncols_p, get_nlcols_p - use ppgrid , only: begchunk, endchunk - use seq_comm_mct, only: mphaid ! imoab pid for atm physics - use seq_comm_mct, only : num_moab_exports ! - use cam_abortutils , only: endrun - use iMOAB, only: iMOAB_WriteMesh, iMOAB_SetDoubleTagStorage - use iso_c_binding - ! - ! Arguments - ! - type(cam_out_t), intent(in) :: cam_out(begchunk:endchunk) - - real(r8), dimension(:), allocatable :: tbot, ubot, vbot ! temporary - integer tagtype, numco, ent_type - character*100 outfile, wopts, tagname, lnum - - integer ierr, c, nlcols, ig, i, ncols - - ! load temp, u, and v on atm phys moab mesh, that is - - nlcols = get_nlcols_p() - - allocate(tbot(nlcols)) - allocate(ubot(nlcols)) - allocate(vbot(nlcols)) - - - ig=1 - do c=begchunk, endchunk - ncols = get_ncols_p(c) - do i=1,ncols - - ubot(ig) = cam_out(c)%ubot(i) - vbot(ig) = cam_out(c)%vbot(i) - tbot(ig) = cam_out(c)%tbot(i) - ig = ig+1 - enddo - enddo - - tagname='T_ph'//C_NULL_CHAR - ent_type = 0 ! vertex type - ierr = iMOAB_SetDoubleTagStorage ( mphaid, tagname, nlcols , ent_type, tbot) - tagname ='u_ph'//C_NULL_CHAR - ierr = iMOAB_SetDoubleTagStorage ( mphaid, tagname, nlcols , ent_type, ubot) - tagname ='v_ph'//C_NULL_CHAR - ierr = iMOAB_SetDoubleTagStorage ( mphaid, tagname, nlcols , ent_type, vbot) -#ifdef MOABDEBUG - num_moab_exports = num_moab_exports +1 - write(lnum,"(I0.2)")num_moab_exports - outfile = 'AtmPhys_'//trim(lnum)//'.h5m'//C_NULL_CHAR - wopts = 'PARALLEL=WRITE_PART'//C_NULL_CHAR - ierr = iMOAB_WriteMesh(mphaid, outfile, wopts) - if (ierr > 0 ) & - call endrun('Error: fail to write the atm phys mesh file with data') -#endif - deallocate(tbot) - deallocate(ubot) - deallocate(vbot) - end subroutine cam_moab_phys_export -#endif end module atm_import_export From e24bbd3f343361fbd73f1533875a762d4e7eb3e1 Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Tue, 19 Apr 2022 16:07:23 -0500 Subject: [PATCH 136/467] update to new sbetr module for g10 --- components/elm/src/external_models/sbetr | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/components/elm/src/external_models/sbetr b/components/elm/src/external_models/sbetr index f3636700b354..51be6d5f8581 160000 --- a/components/elm/src/external_models/sbetr +++ b/components/elm/src/external_models/sbetr @@ -1 +1 @@ -Subproject commit f3636700b35441dbd30bf2921310a66f238d8e9e +Subproject commit 51be6d5f858145654d3c94c2985b3e347dd5a1d4 From 331af21fde211fafae2c6f8a0b6cbbc7385b6be8 Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Tue, 19 Apr 2022 17:34:03 -0500 Subject: [PATCH 137/467] moabdebug is not passed thru yet --- components/mpas-ocean/driver/ocn_comp_mct.F | 4 ++-- components/mpas-seaice/driver/ice_comp_mct.F | 4 ++-- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/components/mpas-ocean/driver/ocn_comp_mct.F b/components/mpas-ocean/driver/ocn_comp_mct.F index 9c7c2bc6b824..d1323e03da96 100644 --- a/components/mpas-ocean/driver/ocn_comp_mct.F +++ b/components/mpas-ocean/driver/ocn_comp_mct.F @@ -3026,13 +3026,13 @@ subroutine ocn_export_moab() !{{{ endif !----------------------------------------------------------------------- !EOC -!#ifdef MOABDEBUG +#ifdef MOABDEBUG num_mb_exports = num_mb_exports +1 write(lnum,"(I0.2)")num_mb_exports outfile = 'ocn_export_'//trim(lnum)//'.h5m'//C_NULL_CHAR wopts = 'PARALLEL=WRITE_PART'//C_NULL_CHAR ierr = iMOAB_WriteMesh(MPOID, outfile, wopts) -!#endif +#endif end subroutine ocn_export_moab!}}} #endif diff --git a/components/mpas-seaice/driver/ice_comp_mct.F b/components/mpas-seaice/driver/ice_comp_mct.F index ab13707389f3..1bd1b51d77f2 100644 --- a/components/mpas-seaice/driver/ice_comp_mct.F +++ b/components/mpas-seaice/driver/ice_comp_mct.F @@ -3240,13 +3240,13 @@ subroutine ice_export_moab() endif -!#ifdef MOABDEBUG +#ifdef MOABDEBUG num_mb_exports = num_mb_exports +1 write(lnum,"(I0.2)")num_mb_exports outfile = 'ice_export_'//trim(lnum)//'.h5m'//C_NULL_CHAR wopts = 'PARALLEL=WRITE_PART'//C_NULL_CHAR ierr = iMOAB_WriteMesh(MPSIID, outfile, wopts) -!#endif +#endif end subroutine ice_export_moab #endif end module ice_comp_mct From 9d1fd31ff8f93176a262a58cb734fb373f8f5613 Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Mon, 2 May 2022 21:33:06 -0500 Subject: [PATCH 138/467] move prep_atm_ocn_moab to prep_ocn_mod it involves projection to ocean --- driver-moab/main/cime_comp_mod.F90 | 3 +- driver-moab/main/prep_atm_mod.F90 | 150 +-------------------------- driver-moab/main/prep_ocn_mod.F90 | 160 ++++++++++++++++++++++++++++- driver-moab/main/prep_rof_mod.F90 | 1 + 4 files changed, 162 insertions(+), 152 deletions(-) diff --git a/driver-moab/main/cime_comp_mod.F90 b/driver-moab/main/cime_comp_mod.F90 index 790b11f059f3..7b1689b74f1f 100644 --- a/driver-moab/main/cime_comp_mod.F90 +++ b/driver-moab/main/cime_comp_mod.F90 @@ -1955,7 +1955,8 @@ subroutine cime_init() endif ! need to finish up the computation of the atm - ocean map (tempest) - if (iamin_CPLALLATMID .and. ocn_c2_atm) call prep_atm_ocn_moab(infodata) + ! this needs to be in prep_ocn_mod, because it is for projection to ocean! + if (iamin_CPLALLATMID .and. atm_c2_ocn) call prep_atm_ocn_moab(infodata) ! need to finish up the computation of the atm - land map ( point cloud) if (iamin_CPLALLATMID .and. atm_c2_lnd) call prep_atm_lnd_moab(infodata) diff --git a/driver-moab/main/prep_atm_mod.F90 b/driver-moab/main/prep_atm_mod.F90 index 0c638b9a0d97..c3c4d52a30fc 100644 --- a/driver-moab/main/prep_atm_mod.F90 +++ b/driver-moab/main/prep_atm_mod.F90 @@ -62,7 +62,7 @@ module prep_atm_mod public :: prep_atm_get_mapper_Si2a public :: prep_atm_get_mapper_Fi2a - public :: prep_atm_ocn_moab, prep_atm_migrate_moab, prep_atm_lnd_moab + public :: prep_atm_migrate_moab, prep_atm_lnd_moab !-------------------------------------------------------------------------- ! Private interfaces @@ -329,154 +329,6 @@ subroutine prep_atm_init(infodata, ocn_c2_atm, ice_c2_atm, lnd_c2_atm, iac_c2_at end subroutine prep_atm_init - subroutine prep_atm_ocn_moab(infodata) - - use iMOAB, only: iMOAB_CoverageGraph, iMOAB_ComputeScalarProjectionWeights, & - iMOAB_ComputeCommGraph - !--------------------------------------------------------------- - ! Description - ! After intersection of atm and ocean mesh, correct the communication graph - ! between atm instance and atm on coupler (due to coverage) - ! also, compute the map; this would be equivalent to seq_map_init_rcfile on the - ! mapping file computed offline (this will be now online) - ! - ! Arguments - type(seq_infodata_type) , intent(in) :: infodata - - character(*), parameter :: subname = '(prep_atm_ocn_moab)' - integer :: ierr - - logical :: atm_present ! .true. => atm is present - logical :: ocn_present ! .true. => ocn is present - integer :: id_join - integer :: mpicom_join - integer :: context_id ! used to define context for coverage (this case, ocean on coupler) - integer :: atm_id - character*32 :: dm1, dm2, dofnameATM, dofnameOCN, wgtIdef - integer :: orderOCN, orderATM, volumetric, noConserve, validate, fInverseDistanceMap - integer :: fNoBubble, monotonicity - - integer :: mpigrp_CPLID ! coupler pes group, used for comm graph phys <-> atm-ocn - integer :: mpigrp_old ! component group pes (phys grid atm) == atm group - integer :: typeA, typeB ! type for computing graph; - integer :: idintx ! in this case, id of moab intersection between atm and ocn, on coupler pes - - - call seq_infodata_getData(infodata, & - atm_present=atm_present, & - ocn_present=ocn_present) - - ! it involves initial atm app; mhid; also migrate atm mesh on coupler pes, mbaxid - ! intx ocean atm are in mbintxoa ; remapper also has some info about coverage mesh - ! after this, the sending of tags from atm pes to coupler pes will use the new par comm graph, that has more precise info about - ! how to get mpicomm for joint atm + coupler - id_join = atm(1)%cplcompid - atm_id = atm(1)%compid - ! maybe we can use a moab-only id, defined like mbintxoa, mhid, somewhere else (seq_comm_mct) - ! we cannot use mbintxoa because it may not exist on atm comp yet; - context_id = ocn(1)%cplcompid - call seq_comm_getinfo(ID_join,mpicom=mpicom_join) - - ! it happens over joint communicator - - if (atm_pg_active ) then ! use mhpgid mesh - ierr = iMOAB_CoverageGraph(mpicom_join, mhpgid, mbaxid, mbintxoa, atm_id, id_join, context_id); - if (iamroot_CPLID) then - write(logunit,*) 'iMOAB graph atmpg2-intxao context: ', context_id - end if - else - ierr = iMOAB_CoverageGraph(mpicom_join, mhid, mbaxid, mbintxoa, atm_id, id_join, context_id); - if (iamroot_CPLID) then - write(logunit,*) 'iMOAB graph atmnp4-intxao context: ', context_id - end if - endif - if (ierr .ne. 0) then - write(logunit,*) subname,' error in computing coverage graph atm/ocn ' - call shr_sys_abort(subname//' ERROR in computing coverage graph atm/ocn ') - endif - - if ( mbintxoa .ge. 0 ) then - wgtIdef = 'scalar'//C_NULL_CHAR - if (atm_pg_active) then - dm1 = "fv"//C_NULL_CHAR - dofnameATM="GLOBAL_ID"//C_NULL_CHAR - orderATM = 1 ! fv-fv - volumetric = 1 ! maybe volumetric ? - else - dm1 = "cgll"//C_NULL_CHAR - dofnameATM="GLOBAL_DOFS"//C_NULL_CHAR - orderATM = np ! it should be 4 - volumetric = 0 - endif - dm2 = "fv"//C_NULL_CHAR - dofnameOCN="GLOBAL_ID"//C_NULL_CHAR - orderOCN = 1 ! not much arguing - fNoBubble = 1 - monotonicity = 0 ! - noConserve = 0 - validate = 1 - fInverseDistanceMap = 0 - if (iamroot_CPLID) then - write(logunit,*) 'launch iMOAB weights with args ', mbintxoa, wgtIdef, & - trim(dm1), orderATM, trim(dm2), orderOCN, & - fNoBubble, monotonicity, volumetric, fInverseDistanceMap, & - noConserve, validate, & - trim(dofnameATM), trim(dofnameOCN) - end if - ierr = iMOAB_ComputeScalarProjectionWeights ( mbintxoa, wgtIdef, & - trim(dm1), orderATM, trim(dm2), orderOCN, & - fNoBubble, monotonicity, volumetric, fInverseDistanceMap, & - noConserve, validate, & - trim(dofnameATM), trim(dofnameOCN) ) - if (ierr .ne. 0) then - write(logunit,*) subname,' error in computing weights atm/ocn ' - call shr_sys_abort(subname//' ERROR in computing weights atm/ocn ') - endif - if (iamroot_CPLID) then - write(logunit,*) 'finish iMOAB weights in atm-ocn' - endif - endif ! only if atm and ocn intersect mbintxoa >= 0 - ! compute the comm graph between phys atm and intx-atm-ocn, to be able to send directly from phys atm - ! towards coverage mesh on atm for intx to ocean - ! this is similar to imoab_phatm_ocn_coupler.cpp test in moab - ! int typeA = 2; // point cloud - ! int typeB = 1; // quads in coverage set - ! ierr = iMOAB_ComputeCommGraph(cmpPhAtmPID, cplAtmOcnPID, &atmCouComm, &atmPEGroup, &couPEGroup, - ! &typeA, &typeB, &cmpatm, &atmocnid); - call seq_comm_getinfo(CPLID ,mpigrp=mpigrp_CPLID) ! second group, the coupler group CPLID is global variable - call seq_comm_getinfo(atm_id, mpigrp=mpigrp_old) ! component group pes, from atm id ( also ATMID(1) ) - - typeA = 2 ! point cloud, phys atm in this case - ! idintx is a unique number of MOAB app that takes care of intx between ocn and atm mesh - idintx = 100*atm(1)%cplcompid + ocn(1)%cplcompid ! something different, to differentiate it; ~ 618 ! - if (atm_pg_active) then - typeB = 3 ! fv on atm side too !! imoab_apg2_ol coupler example - ! atm cells involved in intersection (pg 2 in this case) - ! this will be used now to send - ! data from phys grid directly to atm-ocn intx , for later projection - ! context is the same, atm - ocn intx id ! - - else - typeB = 1 ! atm cells involved in intersection (spectral in this case) ! this will be used now to send - ! data from phys grid directly to atm-ocn intx , for later projection - ! context is the same, atm - ocn intx id ! - endif - if (iamroot_CPLID) then - write(logunit,*) 'launch iMOAB graph with args ', & - mphaid, mbintxoa, mpicom_join, mpigrp_old, mpigrp_CPLID, & - typeA, typeB, atm_id, idintx - end if - ierr = iMOAB_ComputeCommGraph( mphaid, mbintxoa, mpicom_join, mpigrp_old, mpigrp_CPLID, & - typeA, typeB, atm_id, idintx) - if (ierr .ne. 0) then - write(logunit,*) subname,' error in computing graph phys grid - atm/ocn intx ' - call shr_sys_abort(subname//' ERROR in computing graph phys grid - atm/ocn intx ') - endif - if (iamroot_CPLID) then - write(logunit,*) 'finish iMOAB graph in atm-land prep ' - end if - end subroutine prep_atm_ocn_moab - subroutine prep_atm_lnd_moab(infodata) use iMOAB, only: iMOAB_CoverageGraph, iMOAB_ComputeScalarProjectionWeights, iMOAB_ComputeCommGraph diff --git a/driver-moab/main/prep_ocn_mod.F90 b/driver-moab/main/prep_ocn_mod.F90 index 1f68e847ce02..13a367790122 100644 --- a/driver-moab/main/prep_ocn_mod.F90 +++ b/driver-moab/main/prep_ocn_mod.F90 @@ -15,6 +15,14 @@ module prep_ocn_mod use seq_comm_mct, only: mboxid ! iMOAB id for mpas ocean migrated mesh to coupler pes use seq_comm_mct, only: mbrmapro ! iMOAB id for map read from rof2ocn map file use seq_comm_mct, only: mbrxoid ! iMOAB id for rof on coupler in ocean context; + use seq_comm_mct, only : atm_pg_active ! whether the atm uses FV mesh or not ; made true if fv_nphys > 0 + use seq_comm_mct, only : mbaxid ! iMOAB id for atm migrated mesh to coupler pes + use seq_comm_mct, only : mbintxoa ! iMOAB id for intx mesh between ocean and atmosphere; output from this + use seq_comm_mct, only : mhid ! iMOAB id for atm instance + use seq_comm_mct, only : mhpgid ! iMOAB id for atm pgx grid, on atm pes; created with se and gll grids + use dimensions_mod, only : np ! for atmosphere degree + use seq_comm_mct, only : mphaid ! iMOAB id for phys atm on atm pes + use seq_comm_mct, only : seq_comm_getinfo => seq_comm_setptrs use seq_infodata_mod, only: seq_infodata_type, seq_infodata_getdata @@ -75,7 +83,7 @@ module prep_ocn_mod public :: prep_ocn_get_mapper_Fg2o public :: prep_ocn_get_mapper_Sw2o - public :: prep_ocn_migrate_moab + public :: prep_atm_ocn_moab, prep_ocn_migrate_moab !-------------------------------------------------------------------------- ! Private interfaces !-------------------------------------------------------------------------- @@ -115,6 +123,7 @@ module prep_ocn_mod ! other module variables integer :: mpicom_CPLID ! MPI cpl communicator + logical :: iamroot_CPLID ! .true. => CPLID masterproc logical :: flood_present ! .true. => rof is computing flood character(CS) :: vect_map ! vector mapping type logical :: x2o_average ! logical for x2o averaging to 1 ocean instance from multi instances @@ -156,7 +165,6 @@ subroutine prep_ocn_init(infodata, atm_c2_ocn, atm_c2_ice, ice_c2_ocn, rof_c2_oc logical :: ocn_present ! .true. => ocn is present logical :: atm_present ! .true. => atm is present logical :: ice_present ! .true. => ice is present - logical :: iamroot_CPLID ! .true. => CPLID masterproc logical :: samegrid_ao ! samegrid atm and ocean logical :: samegrid_og ! samegrid glc and ocean logical :: samegrid_ow ! samegrid ocean and wave @@ -1579,4 +1587,152 @@ subroutine prep_ocn_migrate_moab(infodata) end subroutine prep_ocn_migrate_moab + subroutine prep_atm_ocn_moab(infodata) + + use iMOAB, only: iMOAB_CoverageGraph, iMOAB_ComputeScalarProjectionWeights, & + iMOAB_ComputeCommGraph + !--------------------------------------------------------------- + ! Description + ! After intersection of atm and ocean mesh, correct the communication graph + ! between atm instance and atm on coupler (due to coverage) + ! also, compute the map; this would be equivalent to seq_map_init_rcfile on the + ! mapping file computed offline (this will be now online) + ! + ! Arguments + type(seq_infodata_type) , intent(in) :: infodata + + character(*), parameter :: subname = '(prep_atm_ocn_moab)' + integer :: ierr + + logical :: atm_present ! .true. => atm is present + logical :: ocn_present ! .true. => ocn is present + integer :: id_join + integer :: mpicom_join + integer :: context_id ! used to define context for coverage (this case, ocean on coupler) + integer :: atm_id + character*32 :: dm1, dm2, dofnameATM, dofnameOCN, wgtIdef + integer :: orderOCN, orderATM, volumetric, noConserve, validate, fInverseDistanceMap + integer :: fNoBubble, monotonicity + + integer :: mpigrp_CPLID ! coupler pes group, used for comm graph phys <-> atm-ocn + integer :: mpigrp_old ! component group pes (phys grid atm) == atm group + integer :: typeA, typeB ! type for computing graph; + integer :: idintx ! in this case, id of moab intersection between atm and ocn, on coupler pes + + + call seq_infodata_getData(infodata, & + atm_present=atm_present, & + ocn_present=ocn_present) + + ! it involves initial atm app; mhid; also migrate atm mesh on coupler pes, mbaxid + ! intx ocean atm are in mbintxoa ; remapper also has some info about coverage mesh + ! after this, the sending of tags from atm pes to coupler pes will use the new par comm graph, that has more precise info about + ! how to get mpicomm for joint atm + coupler + id_join = atm(1)%cplcompid + atm_id = atm(1)%compid + ! maybe we can use a moab-only id, defined like mbintxoa, mhid, somewhere else (seq_comm_mct) + ! we cannot use mbintxoa because it may not exist on atm comp yet; + context_id = ocn(1)%cplcompid + call seq_comm_getinfo(ID_join,mpicom=mpicom_join) + + ! it happens over joint communicator + + if (atm_pg_active ) then ! use mhpgid mesh + ierr = iMOAB_CoverageGraph(mpicom_join, mhpgid, mbaxid, mbintxoa, atm_id, id_join, context_id); + if (iamroot_CPLID) then + write(logunit,*) 'iMOAB graph atmpg2-intxao context: ', context_id + end if + else + ierr = iMOAB_CoverageGraph(mpicom_join, mhid, mbaxid, mbintxoa, atm_id, id_join, context_id); + if (iamroot_CPLID) then + write(logunit,*) 'iMOAB graph atmnp4-intxao context: ', context_id + end if + endif + if (ierr .ne. 0) then + write(logunit,*) subname,' error in computing coverage graph atm/ocn ' + call shr_sys_abort(subname//' ERROR in computing coverage graph atm/ocn ') + endif + + if ( mbintxoa .ge. 0 ) then + wgtIdef = 'scalar'//C_NULL_CHAR + if (atm_pg_active) then + dm1 = "fv"//C_NULL_CHAR + dofnameATM="GLOBAL_ID"//C_NULL_CHAR + orderATM = 1 ! fv-fv + volumetric = 1 ! maybe volumetric ? + else + dm1 = "cgll"//C_NULL_CHAR + dofnameATM="GLOBAL_DOFS"//C_NULL_CHAR + orderATM = np ! it should be 4 + volumetric = 0 + endif + dm2 = "fv"//C_NULL_CHAR + dofnameOCN="GLOBAL_ID"//C_NULL_CHAR + orderOCN = 1 ! not much arguing + fNoBubble = 1 + monotonicity = 0 ! + noConserve = 0 + validate = 1 + fInverseDistanceMap = 0 + if (iamroot_CPLID) then + write(logunit,*) 'launch iMOAB weights with args ', mbintxoa, wgtIdef, & + trim(dm1), orderATM, trim(dm2), orderOCN, & + fNoBubble, monotonicity, volumetric, fInverseDistanceMap, & + noConserve, validate, & + trim(dofnameATM), trim(dofnameOCN) + end if + ierr = iMOAB_ComputeScalarProjectionWeights ( mbintxoa, wgtIdef, & + trim(dm1), orderATM, trim(dm2), orderOCN, & + fNoBubble, monotonicity, volumetric, fInverseDistanceMap, & + noConserve, validate, & + trim(dofnameATM), trim(dofnameOCN) ) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in computing weights atm/ocn ' + call shr_sys_abort(subname//' ERROR in computing weights atm/ocn ') + endif + if (iamroot_CPLID) then + write(logunit,*) 'finish iMOAB weights in atm-ocn' + endif + endif ! only if atm and ocn intersect mbintxoa >= 0 + ! compute the comm graph between phys atm and intx-atm-ocn, to be able to send directly from phys atm + ! towards coverage mesh on atm for intx to ocean + ! this is similar to imoab_phatm_ocn_coupler.cpp test in moab + ! int typeA = 2; // point cloud + ! int typeB = 1; // quads in coverage set + ! ierr = iMOAB_ComputeCommGraph(cmpPhAtmPID, cplAtmOcnPID, &atmCouComm, &atmPEGroup, &couPEGroup, + ! &typeA, &typeB, &cmpatm, &atmocnid); + call seq_comm_getinfo(CPLID ,mpigrp=mpigrp_CPLID) ! second group, the coupler group CPLID is global variable + call seq_comm_getinfo(atm_id, mpigrp=mpigrp_old) ! component group pes, from atm id ( also ATMID(1) ) + + typeA = 2 ! point cloud, phys atm in this case + ! idintx is a unique number of MOAB app that takes care of intx between ocn and atm mesh + idintx = 100*atm(1)%cplcompid + ocn(1)%cplcompid ! something different, to differentiate it; ~ 618 ! + if (atm_pg_active) then + typeB = 3 ! fv on atm side too !! imoab_apg2_ol coupler example + ! atm cells involved in intersection (pg 2 in this case) + ! this will be used now to send + ! data from phys grid directly to atm-ocn intx , for later projection + ! context is the same, atm - ocn intx id ! + + else + typeB = 1 ! atm cells involved in intersection (spectral in this case) ! this will be used now to send + ! data from phys grid directly to atm-ocn intx , for later projection + ! context is the same, atm - ocn intx id ! + endif + if (iamroot_CPLID) then + write(logunit,*) 'launch iMOAB graph with args ', & + mphaid, mbintxoa, mpicom_join, mpigrp_old, mpigrp_CPLID, & + typeA, typeB, atm_id, idintx + end if + ierr = iMOAB_ComputeCommGraph( mphaid, mbintxoa, mpicom_join, mpigrp_old, mpigrp_CPLID, & + typeA, typeB, atm_id, idintx) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in computing graph phys grid - atm/ocn intx ' + call shr_sys_abort(subname//' ERROR in computing graph phys grid - atm/ocn intx ') + endif + if (iamroot_CPLID) then + write(logunit,*) 'finish iMOAB graph in atm-land prep ' + end if + end subroutine prep_atm_ocn_moab + end module prep_ocn_mod diff --git a/driver-moab/main/prep_rof_mod.F90 b/driver-moab/main/prep_rof_mod.F90 index c7be310dc636..b8ad9d64b495 100644 --- a/driver-moab/main/prep_rof_mod.F90 +++ b/driver-moab/main/prep_rof_mod.F90 @@ -456,6 +456,7 @@ subroutine prep_rof_migrate_moab(infodata) ! we could do the projection now, on the ocean mesh, because we are on the coupler pes; ! the actual migrate could happen later , from coupler pes to the ocean pes + ! we should do this for consistency in the file prep_ocn_mode.F90, because this is part of ocean preparation if (mbrmapro .ge. 0 ) then ! we are on coupler pes, for sure ! we could apply weights; need to use the same weight identifier wgtIdef as when we generated it ! hard coded now, it should be a runtime option in the future From 9a488b8b8e424bed6a6cea27ab63018636ed5e27 Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Tue, 3 May 2022 15:25:00 -0500 Subject: [PATCH 139/467] rename mbintxoa to mbintxao it is intersection ocean - atmosphere --- driver-moab/main/prep_atm_mod.F90 | 20 ++++++++++---------- driver-moab/main/prep_ocn_mod.F90 | 24 ++++++++++++------------ driver-moab/shr/seq_comm_mct.F90 | 4 ++-- 3 files changed, 24 insertions(+), 24 deletions(-) diff --git a/driver-moab/main/prep_atm_mod.F90 b/driver-moab/main/prep_atm_mod.F90 index c3c4d52a30fc..cc3418db2398 100644 --- a/driver-moab/main/prep_atm_mod.F90 +++ b/driver-moab/main/prep_atm_mod.F90 @@ -21,7 +21,7 @@ module prep_atm_mod use seq_comm_mct, only : mbaxid ! iMOAB id for atm migrated mesh to coupler pes use seq_comm_mct, only : mphaid ! iMOAB id for phys atm on atm pes use seq_comm_mct, only : mboxid ! iMOAB id for mpas ocean migrated mesh to coupler pes - use seq_comm_mct, only : mbintxoa ! iMOAB id for intx mesh between ocean and atmosphere; output from this + use seq_comm_mct, only : mbintxao ! iMOAB id for intx mesh between ocean and atmosphere; output from this use seq_comm_mct, only : mhid ! iMOAB id for atm instance use seq_comm_mct, only : mhpgid ! iMOAB id for atm pgx grid, on atm pes; created with se and gll grids use seq_comm_mct, only : atm_pg_active ! whether the atm uses FV mesh or not ; made true if fv_nphys > 0 @@ -196,12 +196,12 @@ subroutine prep_atm_init(infodata, ocn_c2_atm, ice_c2_atm, lnd_c2_atm, iac_c2_at appname = "ATM_OCN_COU"//C_NULL_CHAR ! idintx is a unique number of MOAB app that takes care of intx between ocn and atm mesh idintx = 100*atm(1)%cplcompid + ocn(1)%cplcompid ! something different, to differentiate it - ierr = iMOAB_RegisterApplication(trim(appname), mpicom_CPLID, idintx, mbintxoa) + ierr = iMOAB_RegisterApplication(trim(appname), mpicom_CPLID, idintx, mbintxao) if (ierr .ne. 0) then write(logunit,*) subname,' error in registering atm ocn intx' call shr_sys_abort(subname//' ERROR in registering atm ocn intx') endif - ierr = iMOAB_ComputeMeshIntersectionOnSphere (mbaxid, mboxid, mbintxoa) + ierr = iMOAB_ComputeMeshIntersectionOnSphere (mbaxid, mboxid, mbintxao) if (ierr .ne. 0) then write(logunit,*) subname,' error in computing atm ocn intx' call shr_sys_abort(subname//' ERROR in computing atm ocn intx') @@ -215,7 +215,7 @@ subroutine prep_atm_init(infodata, ocn_c2_atm, ice_c2_atm, lnd_c2_atm, iac_c2_at if (rank .lt. 5) then write(lnum,"(I0.2)")rank ! outfile = 'intx'//trim(lnum)// '.h5m' // C_NULL_CHAR - ierr = iMOAB_WriteMesh(mbintxoa, outfile, wopts) ! write local intx file + ierr = iMOAB_WriteMesh(mbintxao, outfile, wopts) ! write local intx file if (ierr .ne. 0) then write(logunit,*) subname,' error in writing intx file ' call shr_sys_abort(subname//' ERROR in writing intx file ') @@ -372,7 +372,7 @@ subroutine prep_atm_lnd_moab(infodata) ! how to get mpicomm for joint atm + coupler id_join = atm(1)%cplcompid atm_id = atm(1)%compid - ! maybe we can use a moab-only id, defined like mbintxoa, mhid, somewhere else (seq_comm_mct) + ! maybe we can use a moab-only id, defined like mbintxao, mhid, somewhere else (seq_comm_mct) ! we cannot use mbintxla because it may not exist on atm comp yet; context_id = lnd(1)%cplcompid call seq_comm_getinfo(ID_join,mpicom=mpicom_join) @@ -499,7 +499,7 @@ subroutine prep_atm_migrate_moab(infodata) lnd_present=lnd_present) ! it involves initial atm app; mhid; also migrate atm mesh on coupler pes, mbaxid - ! intx ocean atm are in mbintxoa ; remapper also has some info about coverage mesh + ! intx ocean atm are in mbintxao ; remapper also has some info about coverage mesh ! after this, the sending of tags from atm pes to coupler pes will use the new par comm graph, that has more precise info about ! how to get mpicomm for joint atm + coupler id_join = atm(1)%cplcompid @@ -532,12 +532,12 @@ subroutine prep_atm_migrate_moab(infodata) endif - if (mbintxoa .ge. 0 ) then ! we are for sure on coupler pes! + if (mbintxao .ge. 0 ) then ! we are for sure on coupler pes! tagName = 'T_ph16:u_ph16:v_ph16:'//C_NULL_CHAR ! they are defined in cplcomp_exchange mod ! context_id = atm(1)%cplcompid == atm_id above (5) ! we use the same name as spectral case, even thought in pg2 case, the size of tag is 1, not 16 ! in imoab_apg2_ol_coupler.cpp we use at this stage, receiver, the same name as sender, T_ph - ierr = iMOAB_ReceiveElementTag(mbintxoa, tagName, mpicom_join, atm_id) + ierr = iMOAB_ReceiveElementTag(mbintxao, tagName, mpicom_join, atm_id) if (ierr .ne. 0) then write(logunit,*) subname,' error in receiving tag from phys atm to ocn atm intx ' call shr_sys_abort(subname//' ERROR in receiving tag from phys atm to ocn atm intx') @@ -590,11 +590,11 @@ subroutine prep_atm_migrate_moab(infodata) ! we could do the projection now, on the ocean mesh, because we are on the coupler pes; ! the actual migrate could happen later , from coupler pes to the ocean pes - if (mbintxoa .ge. 0 ) then ! we are on coupler pes, for sure + if (mbintxao .ge. 0 ) then ! we are on coupler pes, for sure ! we could apply weights; need to use the same weight identifier wgtIdef as when we generated it ! hard coded now, it should be a runtime option in the future - ierr = iMOAB_ApplyScalarProjectionWeights ( mbintxoa, wgtIdef, tagName, tagNameProj) + ierr = iMOAB_ApplyScalarProjectionWeights ( mbintxao, wgtIdef, tagName, tagNameProj) if (ierr .ne. 0) then write(logunit,*) subname,' error in applying weights ' call shr_sys_abort(subname//' ERROR in applying weights') diff --git a/driver-moab/main/prep_ocn_mod.F90 b/driver-moab/main/prep_ocn_mod.F90 index 13a367790122..1819aac1df34 100644 --- a/driver-moab/main/prep_ocn_mod.F90 +++ b/driver-moab/main/prep_ocn_mod.F90 @@ -17,7 +17,7 @@ module prep_ocn_mod use seq_comm_mct, only: mbrxoid ! iMOAB id for rof on coupler in ocean context; use seq_comm_mct, only : atm_pg_active ! whether the atm uses FV mesh or not ; made true if fv_nphys > 0 use seq_comm_mct, only : mbaxid ! iMOAB id for atm migrated mesh to coupler pes - use seq_comm_mct, only : mbintxoa ! iMOAB id for intx mesh between ocean and atmosphere; output from this + use seq_comm_mct, only : mbintxao ! iMOAB id for intx mesh between ocean and atmosphere; output from this use seq_comm_mct, only : mhid ! iMOAB id for atm instance use seq_comm_mct, only : mhpgid ! iMOAB id for atm pgx grid, on atm pes; created with se and gll grids use dimensions_mod, only : np ! for atmosphere degree @@ -1625,25 +1625,25 @@ subroutine prep_atm_ocn_moab(infodata) ocn_present=ocn_present) ! it involves initial atm app; mhid; also migrate atm mesh on coupler pes, mbaxid - ! intx ocean atm are in mbintxoa ; remapper also has some info about coverage mesh + ! intx atm ocean are in mbintxao ; remapper also has some info about coverage mesh ! after this, the sending of tags from atm pes to coupler pes will use the new par comm graph, that has more precise info about ! how to get mpicomm for joint atm + coupler id_join = atm(1)%cplcompid atm_id = atm(1)%compid - ! maybe we can use a moab-only id, defined like mbintxoa, mhid, somewhere else (seq_comm_mct) - ! we cannot use mbintxoa because it may not exist on atm comp yet; + ! maybe we can use a moab-only id, defined like mbintxao, mhid, somewhere else (seq_comm_mct) + ! we cannot use mbintxao because it may not exist on atm comp yet; context_id = ocn(1)%cplcompid call seq_comm_getinfo(ID_join,mpicom=mpicom_join) ! it happens over joint communicator if (atm_pg_active ) then ! use mhpgid mesh - ierr = iMOAB_CoverageGraph(mpicom_join, mhpgid, mbaxid, mbintxoa, atm_id, id_join, context_id); + ierr = iMOAB_CoverageGraph(mpicom_join, mhpgid, mbaxid, mbintxao, atm_id, id_join, context_id); if (iamroot_CPLID) then write(logunit,*) 'iMOAB graph atmpg2-intxao context: ', context_id end if else - ierr = iMOAB_CoverageGraph(mpicom_join, mhid, mbaxid, mbintxoa, atm_id, id_join, context_id); + ierr = iMOAB_CoverageGraph(mpicom_join, mhid, mbaxid, mbintxao, atm_id, id_join, context_id); if (iamroot_CPLID) then write(logunit,*) 'iMOAB graph atmnp4-intxao context: ', context_id end if @@ -1653,7 +1653,7 @@ subroutine prep_atm_ocn_moab(infodata) call shr_sys_abort(subname//' ERROR in computing coverage graph atm/ocn ') endif - if ( mbintxoa .ge. 0 ) then + if ( mbintxao .ge. 0 ) then wgtIdef = 'scalar'//C_NULL_CHAR if (atm_pg_active) then dm1 = "fv"//C_NULL_CHAR @@ -1675,13 +1675,13 @@ subroutine prep_atm_ocn_moab(infodata) validate = 1 fInverseDistanceMap = 0 if (iamroot_CPLID) then - write(logunit,*) 'launch iMOAB weights with args ', mbintxoa, wgtIdef, & + write(logunit,*) 'launch iMOAB weights with args ', mbintxao, wgtIdef, & trim(dm1), orderATM, trim(dm2), orderOCN, & fNoBubble, monotonicity, volumetric, fInverseDistanceMap, & noConserve, validate, & trim(dofnameATM), trim(dofnameOCN) end if - ierr = iMOAB_ComputeScalarProjectionWeights ( mbintxoa, wgtIdef, & + ierr = iMOAB_ComputeScalarProjectionWeights ( mbintxao, wgtIdef, & trim(dm1), orderATM, trim(dm2), orderOCN, & fNoBubble, monotonicity, volumetric, fInverseDistanceMap, & noConserve, validate, & @@ -1693,7 +1693,7 @@ subroutine prep_atm_ocn_moab(infodata) if (iamroot_CPLID) then write(logunit,*) 'finish iMOAB weights in atm-ocn' endif - endif ! only if atm and ocn intersect mbintxoa >= 0 + endif ! only if atm and ocn intersect mbintxao >= 0 ! compute the comm graph between phys atm and intx-atm-ocn, to be able to send directly from phys atm ! towards coverage mesh on atm for intx to ocean ! this is similar to imoab_phatm_ocn_coupler.cpp test in moab @@ -1721,10 +1721,10 @@ subroutine prep_atm_ocn_moab(infodata) endif if (iamroot_CPLID) then write(logunit,*) 'launch iMOAB graph with args ', & - mphaid, mbintxoa, mpicom_join, mpigrp_old, mpigrp_CPLID, & + mphaid, mbintxao, mpicom_join, mpigrp_old, mpigrp_CPLID, & typeA, typeB, atm_id, idintx end if - ierr = iMOAB_ComputeCommGraph( mphaid, mbintxoa, mpicom_join, mpigrp_old, mpigrp_CPLID, & + ierr = iMOAB_ComputeCommGraph( mphaid, mbintxao, mpicom_join, mpigrp_old, mpigrp_CPLID, & typeA, typeB, atm_id, idintx) if (ierr .ne. 0) then write(logunit,*) subname,' error in computing graph phys grid - atm/ocn intx ' diff --git a/driver-moab/shr/seq_comm_mct.F90 b/driver-moab/shr/seq_comm_mct.F90 index 3d280b82ad14..252ba3201dbe 100644 --- a/driver-moab/shr/seq_comm_mct.F90 +++ b/driver-moab/shr/seq_comm_mct.F90 @@ -220,7 +220,7 @@ module seq_comm_mct integer, public :: mphaid ! iMOAB id for atm phys grid, on atm pes integer, public :: mbaxid ! iMOAB id for atm migrated mesh to coupler pes integer, public :: mboxid ! iMOAB id for mpas ocean migrated mesh to coupler pes - integer, public :: mbintxoa ! iMOAB id for intx mesh between ocean and atmosphere + integer, public :: mbintxao ! iMOAB id for intx mesh between ocean and atmosphere integer, public :: mblxid ! iMOAB id for land mesh migrated to coupler pes logical, public :: sameg_al ! same grid atm and land; used throughout, initialized in lnd_init integer, public :: mbintxla ! iMOAB id for intx mesh between land and atmosphere @@ -627,7 +627,7 @@ subroutine seq_comm_init(global_comm_in, driver_comm_in, nmlfile, drv_comm_id) mphaid = -1 ! iMOAB id for phys grid on atm pes mbaxid = -1 ! iMOAB id for atm migrated mesh to coupler pes mboxid = -1 ! iMOAB id for mpas ocean migrated mesh to coupler pes - mbintxoa = -1 ! iMOAB id for atm intx with mpas ocean + mbintxao = -1 ! iMOAB id for atm intx with mpas ocean mblxid = -1 ! iMOAB id for land on coupler pes mbintxla = -1 ! iMOAB id for land intx with atm on coupler pes mpsiid = -1 ! iMOAB for sea-ice From e0206b4b3e18de42ce5e05396522091c43e1d648 Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Fri, 6 May 2022 10:06:36 -0500 Subject: [PATCH 140/467] move prep_atm_lnd to prep_lnd_mod also, do not use point intx anymore it is enough to compute a comm graph based on ids if the sameg_al is true , for atm-lnd coupling --- driver-moab/main/prep_atm_mod.F90 | 185 ++++-------------------------- driver-moab/main/prep_lnd_mod.F90 | 181 ++++++++++++++++++++++++++++- driver-moab/main/prep_ocn_mod.F90 | 38 +++--- 3 files changed, 223 insertions(+), 181 deletions(-) diff --git a/driver-moab/main/prep_atm_mod.F90 b/driver-moab/main/prep_atm_mod.F90 index cc3418db2398..1455b50c2b4a 100644 --- a/driver-moab/main/prep_atm_mod.F90 +++ b/driver-moab/main/prep_atm_mod.F90 @@ -62,7 +62,7 @@ module prep_atm_mod public :: prep_atm_get_mapper_Si2a public :: prep_atm_get_mapper_Fi2a - public :: prep_atm_migrate_moab, prep_atm_lnd_moab + public :: prep_atm_migrate_moab !-------------------------------------------------------------------------- ! Private interfaces @@ -281,7 +281,9 @@ subroutine prep_atm_init(infodata, ocn_c2_atm, ice_c2_atm, lnd_c2_atm, iac_c2_at 'seq_maps.rc','lnd2atm_smapname:','lnd2atm_smaptype:',samegrid_al, & 'mapper_Sl2a initialization',esmf_map_flag) - if ((mbaxid .ge. 0) .and. (mblxid .ge. 0)) then + ! important change: do not compute intx at all between atm and land when we have sameg_al + ! we will use just a comm graph to send data from phys grid to land on coupler + if ((mbaxid .ge. 0) .and. (mblxid .ge. 0) .and. .not. sameg_al ) then appname = "ATM_LND_COU"//C_NULL_CHAR ! idintx is a unique number of MOAB app that takes care of intx between lnd and atm mesh idintx = 100*atm(1)%cplcompid + lnd(1)%cplcompid ! something different, to differentiate it @@ -290,34 +292,25 @@ subroutine prep_atm_init(infodata, ocn_c2_atm, ice_c2_atm, lnd_c2_atm, iac_c2_at write(logunit,*) subname,' error in registering atm lnd intx ' call shr_sys_abort(subname//' ERROR in registering atm lnd intx ') endif - if (sameg_al) then - ierr = iMOAB_ComputePointDoFIntersection (mbaxid, mblxid, mbintxla) - if (iamroot_CPLID) then - write(logunit,*) 'iMOAB intersection between atm and land pc with id:', idintx - end if - else - ierr = iMOAB_ComputeMeshIntersectionOnSphere (mbaxid, mblxid, mbintxla) - if (iamroot_CPLID) then - write(logunit,*) 'iMOAB intersection between atm and land with id:', idintx - end if - endif + if (iamroot_CPLID) then + write(logunit,*) 'iMOAB intersection between atm and land with id:', idintx + end if + ierr = iMOAB_ComputeMeshIntersectionOnSphere (mbaxid, mblxid, mbintxla) if (ierr .ne. 0) then write(logunit,*) subname,' error in computing atm lnd intx' call shr_sys_abort(subname//' ERROR in computing atm lnd intx') endif #ifdef MOABDEBUG ! write intx only if true intx file: - if (.not. sameg_al) then - wopts = C_NULL_CHAR - call shr_mpi_commrank( mpicom_CPLID, rank ) - if (rank .lt. 5) then ! write only a few intx files - write(lnum,"(I0.2)")rank ! - outfile = 'intx_la'//trim(lnum)// '.h5m' // C_NULL_CHAR - ierr = iMOAB_WriteMesh(mbintxla, outfile, wopts) ! write local intx file - if (ierr .ne. 0) then - write(logunit,*) subname,' error in writing intx file land atm ' - call shr_sys_abort(subname//' ERROR in writing intx file ') - endif + wopts = C_NULL_CHAR + call shr_mpi_commrank( mpicom_CPLID, rank ) + if (rank .lt. 5) then ! write only a few intx files + write(lnum,"(I0.2)")rank ! + outfile = 'intx_la'//trim(lnum)// '.h5m' // C_NULL_CHAR + ierr = iMOAB_WriteMesh(mbintxla, outfile, wopts) ! write local intx file + if (ierr .ne. 0) then + write(logunit,*) subname,' error in writing intx file land atm ' + call shr_sys_abort(subname//' ERROR in writing intx file ') endif endif ! if tri-grid #endif @@ -329,142 +322,6 @@ subroutine prep_atm_init(infodata, ocn_c2_atm, ice_c2_atm, lnd_c2_atm, iac_c2_at end subroutine prep_atm_init - subroutine prep_atm_lnd_moab(infodata) - - use iMOAB, only: iMOAB_CoverageGraph, iMOAB_ComputeScalarProjectionWeights, iMOAB_ComputeCommGraph - !--------------------------------------------------------------- - ! Description - ! If the land is on the same mesh as atm, we do not need to compute intx - ! Just use compute graph between phys atm and lnd on coupler, to be able to send - ! data from atm phys to atm on coupler for projection on land - ! in the tri-grid case, atm and land use different meshes, so use coverage anyway - ! - ! Arguments - type(seq_infodata_type) , intent(in) :: infodata - - character(*), parameter :: subname = '(prep_atm_lnd_moab)' - integer :: ierr - - logical :: atm_present ! .true. => atm is present - logical :: lnd_present ! .true. => lnd is present - integer :: id_join - integer :: mpicom_join - integer :: context_id ! used to define context for coverage (this case, land on coupler) - integer :: atm_id - character*32 :: dm1, dm2, dofnameATM, dofnameLND, wgtIdef - integer :: orderLND, orderATM, volumetric, fInverseDistanceMap, noConserve, validate - integer :: fNoBubble, monotonicity - integer :: mpigrp_CPLID ! coupler pes group, used for comm graph phys <-> atm-ocn - integer :: mpigrp_old ! component group pes (phys grid atm) == atm group - integer :: typeA, typeB ! type for computing graph; - integer :: idintx ! in this case, id of moab intersection between atm and lnd, on coupler pes - ! used only for tri-grid case - - call seq_infodata_getData(infodata, & - atm_present=atm_present, & - lnd_present=lnd_present) - - - ! it involves initial atm app; mhid; or pg2 mesh , in case atm_pg_active also migrate atm mesh on coupler pes, mbaxid - ! intx lnd atm are in mbintxla ; remapper also has some info about coverage mesh - ! after this, the sending of tags from atm pes to coupler pes, in land context will use the new par - ! comm graph, that has more precise info about - ! how to get mpicomm for joint atm + coupler - id_join = atm(1)%cplcompid - atm_id = atm(1)%compid - ! maybe we can use a moab-only id, defined like mbintxao, mhid, somewhere else (seq_comm_mct) - ! we cannot use mbintxla because it may not exist on atm comp yet; - context_id = lnd(1)%cplcompid - call seq_comm_getinfo(ID_join,mpicom=mpicom_join) - if (atm_pg_active ) then ! use mhpgid mesh - ierr = iMOAB_CoverageGraph(mpicom_join, mhpgid, mbaxid, mbintxla, atm_id, id_join, context_id); - else - ierr = iMOAB_CoverageGraph(mpicom_join, mhid, mbaxid, mbintxla, atm_id, id_join, context_id); - endif - if (ierr .ne. 0) then - write(logunit,*) subname,' error in computing coverage graph atm/lnd ' - call shr_sys_abort(subname//' ERROR in computing coverage graph atm/lnd ') - endif - - if (mbintxla .ge. 0 ) then ! weights are computed over coupler pes - ! copy from atm - ocn , it is now similar, as land is full mesh, not pc cloud - wgtIdef = 'scalar'//C_NULL_CHAR - if (atm_pg_active) then - dm1 = "fv"//C_NULL_CHAR - dofnameATM="GLOBAL_ID"//C_NULL_CHAR - orderATM = 1 ! fv-fv - volumetric = 1 ! maybe volumetric ? - else - dm1 = "cgll"//C_NULL_CHAR - dofnameATM="GLOBAL_DOFS"//C_NULL_CHAR - orderATM = np ! it should be 4 - volumetric = 0 - endif - - dofnameLND="GLOBAL_ID"//C_NULL_CHAR - orderLND = 1 ! not much arguing - ! is the land mesh explicit or point cloud ? based on sameg_al flag: - if (sameg_al) then - dm2 = "pcloud"//C_NULL_CHAR - wgtIdef = 'scalar-pc'//C_NULL_CHAR - volumetric = 0 ! TODO: check this , for PC ; for imoab_coupler test, volumetric is 0 - else - dm2 = "fv"//C_NULL_CHAR ! land is FV - volumetric = 1 - endif - fNoBubble = 1 - monotonicity = 0 ! - noConserve = 0 - validate = 0 - fInverseDistanceMap = 0 - - ierr = iMOAB_ComputeScalarProjectionWeights ( mbintxla, wgtIdef, & - trim(dm1), orderATM, trim(dm2), orderLND, & - fNoBubble, monotonicity, volumetric, fInverseDistanceMap, & - noConserve, validate, & - trim(dofnameATM), trim(dofnameLND) ) - if (ierr .ne. 0) then - write(logunit,*) subname,' error in computing weights atm land ' - call shr_sys_abort(subname//' ERROR in computing weights atm land') - endif - endif - ! we will use intx atm-lnd mesh only when land is explicit - if (.not. sameg_al) then - ! as with ocn, data is sent from atm ph to the intx atm/lnd, not from pg2 mesh anymore - ! for that, we will use the comm graph between atm ph and atm pg2 intersected with land! - ! copy from ocn logic, just replace with land - ! compute the comm graph between phys atm and intx-atm-lnd, to be able to send directly from phys atm - ! towards coverage mesh on atm for intx to land / now that land is full mesh! - ! this is similar to imoab_phatm_ocn_coupler.cpp test in moab - ! int typeA = 2; // point cloud - call seq_comm_getinfo(CPLID ,mpigrp=mpigrp_CPLID) ! second group, the coupler group CPLID is global variable - call seq_comm_getinfo(atm_id, mpigrp=mpigrp_old) ! component group pes, from atm id ( also ATMID(1) ) - - typeA = 2 ! point cloud, phys atm in this case - ! idintx is a unique number of MOAB app that takes care of intx between lnd and atm mesh - idintx = 100*atm(1)%cplcompid + lnd(1)%cplcompid ! something different, to differentiate it; ~ 600+lnd ! - if (atm_pg_active) then - typeB = 3 ! fv on atm side too !! imoab_apg2_ol coupler example - ! atm cells involved in intersection (pg 2 in this case) - ! this will be used now to send - ! data from phys grid directly to atm-lnd intx , for later projection - ! context is the same, atm - lnd intx id ! - - else - typeB = 1 ! atm cells involved in intersection (spectral in this case) ! this will be used now to send - ! data from phys grid directly to atm-lnd intx , for later projection - ! context is the same, atm - lnd intx id ! - endif - ierr = iMOAB_ComputeCommGraph( mphaid, mbintxla, mpicom_join, mpigrp_old, mpigrp_CPLID, & - typeA, typeB, atm_id, idintx) - if (ierr .ne. 0) then - write(logunit,*) subname,' error in computing graph phys grid - atm/lnd intx ' - call shr_sys_abort(subname//' ERROR in computing graph phys grid - atm/ocn intx ') - endif - endif ! if (.not. sameg_al) - - end subroutine prep_atm_lnd_moab - subroutine prep_atm_migrate_moab(infodata) use iMOAB, only: iMOAB_SendElementTag, iMOAB_ReceiveElementTag, iMOAB_FreeSenderBuffers, & @@ -722,14 +579,18 @@ subroutine prep_atm_migrate_moab(infodata) !CHECKRC(ierr, "cannot receive tag values") endif else ! sameg_al, original lnd from atm grid + ! major change; we do not have intx anymore, we just send from phys grid to land on coupler, + ! using the comm graph computed at line 387 + ! ierr = iMOAB_ComputeCommGraph( mphaid, mblxid, mpicom_join, mpigrp_old, mpigrp_CPLID, & + ! typeA, typeB, atm_id, context_id) - if (mhid .ge. 0) then ! send because we are on atm pes + if (mphaid .ge. 0) then ! send because we are on atm pes ! basically, adjust the migration of the tag we want to project; it was sent initially with ! original partitioning, now we need to adjust it for "coverage" mesh ! as always, use nonblocking sends - ierr = iMOAB_SendElementTag(mhid, tagName, mpicom_join, context_id) + ierr = iMOAB_SendElementTag(mphaid, tagName, mpicom_join, context_id) if (ierr .ne. 0) then write(logunit,*) subname,' error in sending tag for land projection' call shr_sys_abort(subname//' ERROR in sending tag for land projection') diff --git a/driver-moab/main/prep_lnd_mod.F90 b/driver-moab/main/prep_lnd_mod.F90 index 86aa52d4192d..c036fb8625c7 100644 --- a/driver-moab/main/prep_lnd_mod.F90 +++ b/driver-moab/main/prep_lnd_mod.F90 @@ -10,9 +10,17 @@ module prep_lnd_mod use seq_comm_mct , only: CPLID, LNDID, logunit use seq_comm_mct , only: seq_comm_getData=>seq_comm_setptrs use seq_infodata_mod, only: seq_infodata_type, seq_infodata_getdata - use seq_comm_mct, only: mlnid ! iMOAB pid for ocean mesh on component pes + use seq_comm_mct, only: mlnid ! iMOAB pid for land mesh on component pes + use seq_comm_mct, only: mhid ! iMOAB id for atm instance + use seq_comm_mct, only: mphaid ! iMOAB id for phys atm on atm pes + use seq_comm_mct, only: mhpgid ! iMOAB id for atm pgx grid, on atm pes; created with se and gll grids use seq_comm_mct, only: mblxid ! iMOAB id for mpas ocean migrated mesh to coupler pes - use seq_comm_mct, only : seq_comm_getinfo => seq_comm_setptrs + use seq_comm_mct, only: mbintxla ! iMOAB id for intx mesh between land and atmosphere + use seq_comm_mct, only: mbaxid ! iMOAB id for atm migrated mesh to coupler pes + use seq_comm_mct, only: sameg_al ! true by default, so land and atm on same mesh + use seq_comm_mct, only: atm_pg_active ! whether the atm uses FV mesh or not ; made true if fv_nphys > 0 + use dimensions_mod, only: np ! for atmosphere + use seq_comm_mct, only: seq_comm_getinfo => seq_comm_setptrs use seq_map_type_mod use seq_map_mod use seq_flds_mod @@ -51,6 +59,8 @@ module prep_lnd_mod public :: prep_lnd_get_mapper_Sg2l public :: prep_lnd_get_mapper_Fg2l + public :: prep_atm_lnd_moab ! it belongs here now + public :: prep_lnd_migrate_moab !-------------------------------------------------------------------------- ! Private interfaces @@ -556,6 +566,173 @@ function prep_lnd_get_mapper_Fg2l() prep_lnd_get_mapper_Fg2l => mapper_Fg2l end function prep_lnd_get_mapper_Fg2l + ! moved from prep_atm + subroutine prep_atm_lnd_moab(infodata) + + use iMOAB, only: iMOAB_CoverageGraph, iMOAB_ComputeScalarProjectionWeights, iMOAB_ComputeCommGraph + use iMOAB, only: iMOAB_DefineTagStorage + !--------------------------------------------------------------- + ! Description + ! If the land is on the same mesh as atm, we do not need to compute intx + ! Just use compute graph between phys atm and lnd on coupler, to be able to send + ! data from atm phys to atm on coupler for projection on land + ! in the tri-grid case, atm and land use different meshes, so use coverage anyway + ! + ! Arguments + type(seq_infodata_type) , intent(in) :: infodata + + character(*), parameter :: subname = '(prep_atm_lnd_moab)' + integer :: ierr + + logical :: atm_present ! .true. => atm is present + logical :: lnd_present ! .true. => lnd is present + integer :: id_join + integer :: mpicom_join + integer :: context_id ! used to define context for coverage (this case, land on coupler) + integer :: atm_id + character*32 :: dm1, dm2, dofnameATM, dofnameLND, wgtIdef + integer :: orderLND, orderATM, volumetric, fInverseDistanceMap, noConserve, validate + integer :: fNoBubble, monotonicity + integer :: mpigrp_CPLID ! coupler pes group, used for comm graph phys <-> atm-ocn + integer :: mpigrp_old ! component group pes (phys grid atm) == atm group + integer :: typeA, typeB ! type for computing graph; + integer :: idintx ! in this case, id of moab intersection between atm and lnd, on coupler pes + ! used only for tri-grid case + integer :: tagtype, numco, tagindex + character*400 :: tagname ! will store all seq_flds_a2x_fields + + call seq_infodata_getData(infodata, & + atm_present=atm_present, & + lnd_present=lnd_present) + + ! it involves initial atm app; mhid; or pg2 mesh , in case atm_pg_active also migrate atm mesh on coupler pes, mbaxid + ! intx lnd atm are in mbintxla ; remapper also has some info about coverage mesh + ! after this, the sending of tags from atm pes to coupler pes, in land context will use the new par + ! comm graph, that has more precise info about + ! how to get mpicomm for joint atm + coupler + id_join = atm(1)%cplcompid + atm_id = atm(1)%compid + ! maybe we can use a moab-only id, defined like mbintxao, mhid, somewhere else (seq_comm_mct) + ! we cannot use mbintxla because it may not exist on atm comp yet; + context_id = lnd(1)%cplcompid + call seq_comm_getinfo(ID_join,mpicom=mpicom_join) + if ( .not. sameg_al ) then + if (atm_pg_active ) then ! use mhpgid mesh + ierr = iMOAB_CoverageGraph(mpicom_join, mhpgid, mbaxid, mbintxla, atm_id, id_join, context_id); + else + ierr = iMOAB_CoverageGraph(mpicom_join, mhid, mbaxid, mbintxla, atm_id, id_join, context_id); + endif + else + ! this is the moment we compute the comm graph between phys grid atm and land on coupler pes. + ! We do not need to compute intersection in this case, as the DOFs are exactly the same + ! see imoab_phatm_ocn_coupler.cpp in MOAB source code, no intx needed, just compute graph + typeA = 2 ! point cloud + typeB = 2 ! + call seq_comm_getinfo(CPLID ,mpigrp=mpigrp_CPLID) ! second group, the coupler group CPLID is global variable + call seq_comm_getinfo(atm_id, mpigrp=mpigrp_old) + ! context_id = lnd(1)%cplcompid + ierr = iMOAB_ComputeCommGraph( mphaid, mblxid, mpicom_join, mpigrp_old, mpigrp_CPLID, & + typeA, typeB, atm_id, context_id) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in computing graph phys grid - lnd on coupler ' + call shr_sys_abort(subname//' ERROR in computing graph phys grid - lnd on coupler ') + endif + + endif + if (ierr .ne. 0) then + write(logunit,*) subname,' error in computing coverage graph atm/lnd ' + call shr_sys_abort(subname//' ERROR in computing coverage graph atm/lnd ') + endif + + ! this is true only for tri-grid cases + if (mbintxla .ge. 0 ) then ! weights are computed over coupler pes + ! copy from atm - ocn , it is now similar, as land is full mesh, not pc cloud + wgtIdef = 'scalar'//C_NULL_CHAR + if (atm_pg_active) then + dm1 = "fv"//C_NULL_CHAR + dofnameATM="GLOBAL_ID"//C_NULL_CHAR + orderATM = 1 ! fv-fv + volumetric = 1 ! maybe volumetric ? + else + dm1 = "cgll"//C_NULL_CHAR + dofnameATM="GLOBAL_DOFS"//C_NULL_CHAR + orderATM = np ! it should be 4 + volumetric = 0 + endif + + dofnameLND="GLOBAL_ID"//C_NULL_CHAR + orderLND = 1 ! not much arguing + ! is the land mesh explicit or point cloud ? based on sameg_al flag: + if (sameg_al) then + dm2 = "pcloud"//C_NULL_CHAR + wgtIdef = 'scalar-pc'//C_NULL_CHAR + volumetric = 0 ! TODO: check this , for PC ; for imoab_coupler test, volumetric is 0 + else + dm2 = "fv"//C_NULL_CHAR ! land is FV + volumetric = 1 + endif + fNoBubble = 1 + monotonicity = 0 ! + noConserve = 0 + validate = 0 + fInverseDistanceMap = 0 + + ierr = iMOAB_ComputeScalarProjectionWeights ( mbintxla, wgtIdef, & + trim(dm1), orderATM, trim(dm2), orderLND, & + fNoBubble, monotonicity, volumetric, fInverseDistanceMap, & + noConserve, validate, & + trim(dofnameATM), trim(dofnameLND) ) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in computing weights atm land ' + call shr_sys_abort(subname//' ERROR in computing weights atm land') + endif + endif + ! we will use intx atm-lnd mesh only when land is explicit + if (.not. sameg_al) then + ! as with ocn, data is sent from atm ph to the intx atm/lnd, not from pg2 mesh anymore + ! for that, we will use the comm graph between atm ph and atm pg2 intersected with land! + ! copy from ocn logic, just replace with land + ! compute the comm graph between phys atm and intx-atm-lnd, to be able to send directly from phys atm + ! towards coverage mesh on atm for intx to land / now that land is full mesh! + ! this is similar to imoab_phatm_ocn_coupler.cpp test in moab + ! int typeA = 2; // point cloud + call seq_comm_getinfo(CPLID ,mpigrp=mpigrp_CPLID) ! second group, the coupler group CPLID is global variable + call seq_comm_getinfo(atm_id, mpigrp=mpigrp_old) ! component group pes, from atm id ( also ATMID(1) ) + + typeA = 2 ! point cloud, phys atm in this case + ! idintx is a unique number of MOAB app that takes care of intx between lnd and atm mesh + idintx = 100*atm(1)%cplcompid + lnd(1)%cplcompid ! something different, to differentiate it; ~ 600+lnd ! + if (atm_pg_active) then + typeB = 3 ! fv on atm side too !! imoab_apg2_ol coupler example + ! atm cells involved in intersection (pg 2 in this case) + ! this will be used now to send + ! data from phys grid directly to atm-lnd intx , for later projection + ! context is the same, atm - lnd intx id ! + + else + typeB = 1 ! atm cells involved in intersection (spectral in this case) ! this will be used now to send + ! data from phys grid directly to atm-lnd intx , for later projection + ! context is the same, atm - lnd intx id ! + endif + ierr = iMOAB_ComputeCommGraph( mphaid, mbintxla, mpicom_join, mpigrp_old, mpigrp_CPLID, & + typeA, typeB, atm_id, idintx) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in computing graph phys grid - atm/lnd intx ' + call shr_sys_abort(subname//' ERROR in computing graph phys grid - atm/ocn intx ') + endif + endif ! if (.not. sameg_al) + + ! in any case, we need to define the tags on landx from the phys atm seq_flds_a2x_fields + tagtype = 1 ! dense, double + numco = 1 ! one value per vertex / entity + tagname = trim(seq_flds_a2x_fields)//C_NULL_CHAR + ierr = iMOAB_DefineTagStorage(mblxid, tagname, tagtype, numco, tagindex ) + if ( ierr > 0) then + call shr_sys_abort(subname//' fail to define seq_flds_a2x_fields for lnd x moab mesh ') + endif + + end subroutine prep_atm_lnd_moab + ! exposed method to migrate projected tag from coupler pes back to land pes subroutine prep_lnd_migrate_moab(infodata) diff --git a/driver-moab/main/prep_ocn_mod.F90 b/driver-moab/main/prep_ocn_mod.F90 index 1819aac1df34..ca64b78743aa 100644 --- a/driver-moab/main/prep_ocn_mod.F90 +++ b/driver-moab/main/prep_ocn_mod.F90 @@ -1606,6 +1606,7 @@ subroutine prep_atm_ocn_moab(infodata) logical :: atm_present ! .true. => atm is present logical :: ocn_present ! .true. => ocn is present + logical :: ocn_prognostic ! .true. => ocn is present and expects input integer :: id_join integer :: mpicom_join integer :: context_id ! used to define context for coverage (this case, ocean on coupler) @@ -1622,7 +1623,8 @@ subroutine prep_atm_ocn_moab(infodata) call seq_infodata_getData(infodata, & atm_present=atm_present, & - ocn_present=ocn_present) + ocn_present=ocn_present, & + ocn_prognostic=ocn_prognostic) ! it involves initial atm app; mhid; also migrate atm mesh on coupler pes, mbaxid ! intx atm ocean are in mbintxao ; remapper also has some info about coverage mesh @@ -1635,22 +1637,24 @@ subroutine prep_atm_ocn_moab(infodata) context_id = ocn(1)%cplcompid call seq_comm_getinfo(ID_join,mpicom=mpicom_join) - ! it happens over joint communicator - - if (atm_pg_active ) then ! use mhpgid mesh - ierr = iMOAB_CoverageGraph(mpicom_join, mhpgid, mbaxid, mbintxao, atm_id, id_join, context_id); - if (iamroot_CPLID) then - write(logunit,*) 'iMOAB graph atmpg2-intxao context: ', context_id - end if - else - ierr = iMOAB_CoverageGraph(mpicom_join, mhid, mbaxid, mbintxao, atm_id, id_join, context_id); - if (iamroot_CPLID) then - write(logunit,*) 'iMOAB graph atmnp4-intxao context: ', context_id - end if - endif - if (ierr .ne. 0) then - write(logunit,*) subname,' error in computing coverage graph atm/ocn ' - call shr_sys_abort(subname//' ERROR in computing coverage graph atm/ocn ') + ! it happens over joint communicator, only if ocn_prognostic true + if (ocn_prognostic) then + + if (atm_pg_active ) then ! use mhpgid mesh + ierr = iMOAB_CoverageGraph(mpicom_join, mhpgid, mbaxid, mbintxao, atm_id, id_join, context_id); + if (iamroot_CPLID) then + write(logunit,*) 'iMOAB graph atmpg2-intxao context: ', context_id + end if + else + ierr = iMOAB_CoverageGraph(mpicom_join, mhid, mbaxid, mbintxao, atm_id, id_join, context_id); + if (iamroot_CPLID) then + write(logunit,*) 'iMOAB graph atmnp4-intxao context: ', context_id + end if + endif + if (ierr .ne. 0) then + write(logunit,*) subname,' error in computing coverage graph atm/ocn ' + call shr_sys_abort(subname//' ERROR in computing coverage graph atm/ocn ') + endif endif if ( mbintxao .ge. 0 ) then From a0a1c7e55ee9020593225610ed842c67b28715a7 Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Fri, 6 May 2022 13:11:48 -0500 Subject: [PATCH 141/467] land projection for samegrid_al is just a migrate no apply is needed --- driver-moab/main/prep_atm_mod.F90 | 37 +++++++++++++------------------ driver-moab/main/prep_rof_mod.F90 | 11 ++++++--- 2 files changed, 24 insertions(+), 24 deletions(-) diff --git a/driver-moab/main/prep_atm_mod.F90 b/driver-moab/main/prep_atm_mod.F90 index 1455b50c2b4a..0f893eb2df7f 100644 --- a/driver-moab/main/prep_atm_mod.F90 +++ b/driver-moab/main/prep_atm_mod.F90 @@ -341,19 +341,22 @@ subroutine prep_atm_migrate_moab(infodata) logical :: atm_present ! .true. => atm is present logical :: ocn_present ! .true. => ocn is present logical :: lnd_present ! .true. => lnd is present + logical :: ocn_prognostic ! .true. => ocn is prognostic integer :: id_join integer :: mpicom_join integer :: atm_id integer :: context_id ! we will use ocean context or land context - character*32 :: dm1, dm2, tagName, wgtIdef - character*50 :: outfile, wopts, tagnameProj, lnum + character*32 :: dm1, dm2, wgtIdef + character*50 :: outfile, wopts, lnum integer :: orderOCN, orderATM, volumetric, noConserve, validate + character*400 :: tagName, tagnameProj call seq_infodata_getData(infodata, & atm_present=atm_present, & ocn_present=ocn_present, & - lnd_present=lnd_present) + lnd_present=lnd_present, & + ocn_prognostic=ocn_prognostic) ! it involves initial atm app; mhid; also migrate atm mesh on coupler pes, mbaxid ! intx ocean atm are in mbintxao ; remapper also has some info about coverage mesh @@ -371,7 +374,7 @@ subroutine prep_atm_migrate_moab(infodata) tagNameProj = 'a2oTbot_proj:a2oUbot_proj:a2oVbot_proj:'//C_NULL_CHAR num_proj = num_proj + 1 - if (atm_present .and. ocn_present) then + if (atm_present .and. ocn_present .and. ocn_prognostic) then if (atm_pg_active ) then ! use data from AtmPhys mesh, but mesh from pg ! in this case, we will send from phys grid directly to intx atm ocn context! if (mphaid .ge. 0) then ! send because we are on atm pes, also mphaid >= 0 @@ -580,25 +583,26 @@ subroutine prep_atm_migrate_moab(infodata) endif else ! sameg_al, original lnd from atm grid ! major change; we do not have intx anymore, we just send from phys grid to land on coupler, - ! using the comm graph computed at line 387 + ! using the comm graph computed at line prep_atm_lnd_moab , prep_lnd_mod.70:621 ! ierr = iMOAB_ComputeCommGraph( mphaid, mblxid, mpicom_join, mpigrp_old, mpigrp_CPLID, & ! typeA, typeB, atm_id, context_id) - + tagName=trim(seq_flds_a2x_fields)//C_NULL_CHAR if (mphaid .ge. 0) then ! send because we are on atm pes ! basically, adjust the migration of the tag we want to project; it was sent initially with ! original partitioning, now we need to adjust it for "coverage" mesh ! as always, use nonblocking sends - + context_id = lnd(1)%cplcompid ierr = iMOAB_SendElementTag(mphaid, tagName, mpicom_join, context_id) if (ierr .ne. 0) then write(logunit,*) subname,' error in sending tag for land projection' call shr_sys_abort(subname//' ERROR in sending tag for land projection') endif endif - if (mbaxid .ge. 0 ) then ! we are on coupler pes, for sure + if (mblxid .ge. 0 ) then ! we are on coupler pes, for sure; no need to project anything ! receive on atm on coupler pes, that was redistributed according to coverage - ierr = iMOAB_ReceiveElementTag(mbaxid, tagName, mpicom_join, context_id) + context_id=atm(1)%compid + ierr = iMOAB_ReceiveElementTag(mblxid, tagName, mpicom_join, context_id) if (ierr .ne. 0) then write(logunit,*) subname,' error in receiving tag for land projection' call shr_sys_abort(subname//' ERROR in receiving tag for land projection') @@ -607,7 +611,8 @@ subroutine prep_atm_migrate_moab(infodata) ! we can now free the sender buffers if (mhid .ge. 0) then - ierr = iMOAB_FreeSenderBuffers(mhid, context_id) + context_id = lnd(1)%cplcompid + ierr = iMOAB_FreeSenderBuffers(mphaid, context_id) if (ierr .ne. 0) then write(logunit,*) subname,' error in freeing buffers' call shr_sys_abort(subname//' ERROR in freeing buffers') @@ -616,17 +621,7 @@ subroutine prep_atm_migrate_moab(infodata) ! we could do the projection now, on the land mesh, because we are on the coupler pes; ! the actual migrate back could happen later , from coupler pes to the land pes - if (mbintxla .ge. 0 ) then ! we are on coupler pes, for sure - - ! we could apply weights; need to use the same weight identifier wgtIdef as when we generated it - ! hard coded now, it should be a runtime option in the future - wgtIdef = 'scalar-pc'//C_NULL_CHAR - ierr = iMOAB_ApplyScalarProjectionWeights ( mbintxla, wgtIdef, tagName, tagNameProj) - if (ierr .ne. 0) then - write(logunit,*) subname,' error in applying weights for land projection' - call shr_sys_abort(subname//' ERROR in applying weights for land projection') - endif - + if (mblxid .ge. 0 ) then ! we are on coupler pes, for sure #ifdef MOABDEBUG ! we can also write the land mesh to file, just to see the projectd tag ! write out the mesh file to disk diff --git a/driver-moab/main/prep_rof_mod.F90 b/driver-moab/main/prep_rof_mod.F90 index b8ad9d64b495..b3f0474840ec 100644 --- a/driver-moab/main/prep_rof_mod.F90 +++ b/driver-moab/main/prep_rof_mod.F90 @@ -277,6 +277,8 @@ subroutine prep_rof_ocn_moab(infodata) logical :: rof_present ! .true. => rof is present logical :: ocn_present ! .true. => ocn is present + logical :: ocn_prognostic ! if true, component is prognostic + integer :: id_join integer :: rank_on_cpl ! just for debugging integer :: mpicom_join @@ -294,7 +296,8 @@ subroutine prep_rof_ocn_moab(infodata) call seq_infodata_getData(infodata, & rof_present=rof_present, & - ocn_present=ocn_present) + ocn_present=ocn_present, & + ocn_prognostic=ocn_prognostic) ! it involves initial rof app; mhid; also migrate rof mesh on coupler pes, in ocean context, mbrxoid ! map between rof 2 ocn is in mbrmapro ; @@ -383,6 +386,7 @@ subroutine prep_rof_migrate_moab(infodata) logical :: rof_present ! .true. => rof is present logical :: ocn_present ! .true. => ocn is present + logical :: ocn_prognostic ! integer :: id_join integer :: mpicom_join @@ -398,7 +402,8 @@ subroutine prep_rof_migrate_moab(infodata) call seq_infodata_getData(infodata, & rof_present=rof_present, & - ocn_present=ocn_present) + ocn_present=ocn_present, & + ocn_prognostic=ocn_prognostic) ! it involves initial rof app; mesh on coupler pes, ! use seq_comm_mct, only: mrofid ! id for rof comp @@ -418,7 +423,7 @@ subroutine prep_rof_migrate_moab(infodata) tagName = trim(seq_flds_r2x_fields)//C_NULL_CHAR num_proj = num_proj + 1 - if (rof_present .and. ocn_present) then + if (rof_present .and. ocn_present .and. ocn_prognostic) then if (mrofid .ge. 0) then ! send because we are on rof pes From 0ccc7b68f8769a0a1945b2d479cc8e2c5ac337f6 Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Tue, 10 May 2022 12:14:25 -0500 Subject: [PATCH 142/467] finish ice projection to ocean it is just a rearrange of ice fields to ocean mesh, instanced on coupler side (it is a migrate fields, using a comm graph computed between ice and ocn on coupler) Use the fact that ocean and sea-ice share the same mesh --- driver-moab/main/cime_comp_mod.F90 | 6 +- driver-moab/main/prep_ocn_mod.F90 | 113 ++++++++++++++++++++++++++++- 2 files changed, 117 insertions(+), 2 deletions(-) diff --git a/driver-moab/main/cime_comp_mod.F90 b/driver-moab/main/cime_comp_mod.F90 index 7b1689b74f1f..2c0512f6c61a 100644 --- a/driver-moab/main/cime_comp_mod.F90 +++ b/driver-moab/main/cime_comp_mod.F90 @@ -4260,7 +4260,11 @@ subroutine cime_run_atmocn_setup(hashint) if (ocn_prognostic) then ! Map to ocn - if (ice_c2_ocn) call prep_ocn_calc_i2x_ox(timer='CPL:atmocnp_ice2ocn') + if (ice_c2_ocn) then + call prep_ocn_calc_i2x_ox(timer='CPL:atmocnp_ice2ocn') + ! also call moab ice-ocn projection, which is just a migrate + call prep_ocn_calc_i2x_ox_moab() + endif if (wav_c2_ocn) call prep_ocn_calc_w2x_ox(timer='CPL:atmocnp_wav2ocn') if (trim(cpl_seq_option(1:5)) == 'NUOPC') then if (rof_c2_ocn) call prep_ocn_calc_r2x_ox(timer='CPL:atmocnp_rof2ocn') diff --git a/driver-moab/main/prep_ocn_mod.F90 b/driver-moab/main/prep_ocn_mod.F90 index ca64b78743aa..9cd68389eb39 100644 --- a/driver-moab/main/prep_ocn_mod.F90 +++ b/driver-moab/main/prep_ocn_mod.F90 @@ -3,6 +3,7 @@ module prep_ocn_mod use shr_kind_mod, only: r8 => SHR_KIND_R8 use shr_kind_mod, only: cs => SHR_KIND_CS use shr_kind_mod, only: cl => SHR_KIND_CL + use shr_kind_mod, only: CX => shr_kind_CX, CXX => shr_kind_CXX use shr_sys_mod, only: shr_sys_abort, shr_sys_flush use seq_comm_mct, only: num_inst_atm, num_inst_rof, num_inst_ice use seq_comm_mct, only: num_inst_glc, num_inst_wav, num_inst_ocn @@ -22,6 +23,9 @@ module prep_ocn_mod use seq_comm_mct, only : mhpgid ! iMOAB id for atm pgx grid, on atm pes; created with se and gll grids use dimensions_mod, only : np ! for atmosphere degree use seq_comm_mct, only : mphaid ! iMOAB id for phys atm on atm pes + use seq_comm_mct, only : mpsiid ! iMOAB id for sea-ice, mpas model + use seq_comm_mct, only : CPLALLICEID + use seq_comm_mct, only : seq_comm_iamin use seq_comm_mct, only : seq_comm_getinfo => seq_comm_setptrs @@ -52,6 +56,7 @@ module prep_ocn_mod public :: prep_ocn_calc_a2x_ox public :: prep_ocn_calc_i2x_ox + public :: prep_ocn_calc_i2x_ox_moab public :: prep_ocn_calc_r2x_ox public :: prep_ocn_calc_g2x_ox public :: prep_ocn_shelf_calc_g2x_ox @@ -137,6 +142,7 @@ module prep_ocn_mod integer :: number_proj ! it is a static variable, used to count the number of projections #endif + logical :: iamin_CPLALLICEID ! pe associated with CPLALLICEID contains !================================================================================================ @@ -144,7 +150,7 @@ module prep_ocn_mod subroutine prep_ocn_init(infodata, atm_c2_ocn, atm_c2_ice, ice_c2_ocn, rof_c2_ocn, & wav_c2_ocn, glc_c2_ocn, glcshelf_c2_ocn) - use iMOAB, only: iMOAB_RegisterApplication + use iMOAB, only: iMOAB_RegisterApplication, iMOAB_ComputeCommGraph, iMOAB_DefineTagStorage !--------------------------------------------------------------- ! Description ! Initialize module attribute vectors and all other non-mapping @@ -187,6 +193,14 @@ subroutine prep_ocn_init(infodata, atm_c2_ocn, atm_c2_ice, ice_c2_ocn, rof_c2_oc character*32 :: appname ! to register moab app integer :: rmapid ! external id to identify the moab app integer :: ierr, type_grid ! + + integer :: mpigrp_CPLID ! coupler pes group, used for comm graph phys <-> atm-ocn + integer :: mpigrp_old ! component group pes (phys grid atm) == atm group + integer :: typeA, typeB ! type for computing graph; + integer :: ocn_id_x, ice_id, id_join + integer :: mpicom_join ! join comm between ice and coupler + character(CXX) :: tagname + integer :: tagtype, numco, tagindex ! used to define tags !--------------------------------------------------------------- call seq_infodata_getData(infodata , & @@ -330,7 +344,40 @@ subroutine prep_ocn_init(infodata, atm_c2_ocn, atm_c2_ice, ice_c2_ocn, rof_c2_oc write(logunit,*) ' ' write(logunit,F00) 'Initializing mapper_SFi2o' end if + iamin_CPLALLICEID = seq_comm_iamin(CPLALLICEID) call seq_map_init_rearrolap(mapper_SFi2o, ice(1), ocn(1), 'mapper_SFi2o') + + ocn_id_x = ocn(1)%cplcompid + ice_id = ice(1)%compid + + id_join = ice(1)%cplcompid + call seq_comm_getinfo(ID_join,mpicom=mpicom_join) ! joint comm over ice and coupler + call seq_comm_getinfo(CPLID ,mpigrp=mpigrp_CPLID) ! second group, the coupler group CPLID is global variable + call seq_comm_getinfo(ice_id, mpigrp=mpigrp_old) + typeA = 3 + typeB = 3 ! fv-fv graph + + ! imoab compute comm graph ice-ocn, based on the same global id + ! it will be a simple migrate from ice mesh directly to ocean, using the comm graph computed here + if (iamin_CPLALLICEID) then + ierr = iMOAB_ComputeCommGraph( mpsiid, mboxid, mpicom_join, mpigrp_old, mpigrp_CPLID, & + typeA, typeB, ice_id, ocn_id_x) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in computing graph ice - ocn x ' + call shr_sys_abort(subname//' ERROR in computing graph ice - ocn x ') + endif + endif + if (mboxid .ge. 0) then ! we are on coupler pes, ocean app on coupler + ! define tags according to the seq_flds_i2x_fields + tagtype = 1 ! dense, double + numco = 1 ! one value per cell / entity + tagname = trim(seq_flds_i2x_fields)//C_NULL_CHAR + ierr = iMOAB_DefineTagStorage(mboxid, tagname, tagtype, numco, tagindex ) + if ( ierr == 1 ) then + call shr_sys_abort( subname//' ERROR: cannot define tags in moab' ) + end if + endif + endif call shr_sys_flush(logunit) @@ -1299,6 +1346,70 @@ subroutine prep_ocn_calc_i2x_ox(timer) end subroutine prep_ocn_calc_i2x_ox + subroutine prep_ocn_calc_i2x_ox_moab() + !--------------------------------------------------------------- + ! Description + ! simply migrate tags to ocean, from ice model, using comm graph computed at prep_ocn_init + ! ierr = iMOAB_ComputeCommGraph( mpsiid, mboxid,... + ! + ! Local Variables + use iMOAB , only: iMOAB_SendElementTag, iMOAB_ReceiveElementTag, iMOAB_FreeSenderBuffers, iMOAB_WriteMesh + character(*), parameter :: subname = '(prep_ocn_calc_i2x_ox_moab)' + character(CXX) :: tagname + character*32 :: outfile, wopts, lnum + integer :: ocn_id_x, ice_id, id_join, mpicom_join, ierr, context_id + !--------------------------------------------------------------- + ocn_id_x = ocn(1)%cplcompid + ice_id = ice(1)%compid + + id_join = ice(1)%cplcompid + call seq_comm_getinfo(ID_join,mpicom=mpicom_join) + + ! send from sea ice to ocean + ! if we are on sea ice pes: + + tagName=trim(seq_flds_i2x_fields)//C_NULL_CHAR + if (mpsiid .ge. 0) then ! send because we are on ice pes + + context_id = ocn(1)%cplcompid + ierr = iMOAB_SendElementTag(mpsiid, tagName, mpicom_join, context_id) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in sending tag for ice proj to ocean' + call shr_sys_abort(subname//' ERROR in sending tag for ice proj to ocean') + endif + endif + if (mboxid .ge. 0 ) then ! we are on coupler pes, for sure; no need to project anything + ! receive on ocn on coupler pes, from ice + context_id=ice(1)%compid + ierr = iMOAB_ReceiveElementTag(mboxid, tagName, mpicom_join, context_id) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in receiving tag for ice-ocn proj' + call shr_sys_abort(subname//' ERROR in receiving tag for ice-ocn proj') + endif + endif + + + ! we can now free the sender buffers + if (mpsiid .ge. 0) then + context_id = ocn(1)%cplcompid + ierr = iMOAB_FreeSenderBuffers(mpsiid, context_id) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in freeing buffers ice-ocn' + call shr_sys_abort(subname//' ERROR in freeing buffers ice-ocn') + endif + endif + +#ifdef MOABDEBUG + if (mboxid .ge. 0 ) then ! we are on ocean pes, for sure + write(lnum,"(I0.2)") number_proj + outfile = 'OcnCplAftIce'//trim(lnum)//'.h5m'//C_NULL_CHAR + wopts = ';PARALLEL=WRITE_PART'//C_NULL_CHAR ! + ierr = iMOAB_WriteMesh(mboxid, trim(outfile), trim(wopts)) + endif +#endif + + end subroutine prep_ocn_calc_i2x_ox_moab + !================================================================================================ subroutine prep_ocn_calc_r2x_ox(timer) From f038f81a4fcc9dc9154d336daec5c278cf9dcc71 Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Tue, 10 May 2022 15:44:57 -0500 Subject: [PATCH 143/467] ice-ocnx graph computed in a special method cannot be called only on coupler PEs --- driver-moab/main/cime_comp_mod.F90 | 3 + driver-moab/main/prep_ocn_mod.F90 | 102 +++++++++++++++++------------ 2 files changed, 62 insertions(+), 43 deletions(-) diff --git a/driver-moab/main/cime_comp_mod.F90 b/driver-moab/main/cime_comp_mod.F90 index 2c0512f6c61a..8aacc4e023f9 100644 --- a/driver-moab/main/cime_comp_mod.F90 +++ b/driver-moab/main/cime_comp_mod.F90 @@ -1958,6 +1958,9 @@ subroutine cime_init() ! this needs to be in prep_ocn_mod, because it is for projection to ocean! if (iamin_CPLALLATMID .and. atm_c2_ocn) call prep_atm_ocn_moab(infodata) + ! this needs to be in prep_ocn_mod, because it is for ice projection to ocean! + if (iamin_CPLALLICEID .and. ice_c2_ocn) call prep_ice_ocn_moab(infodata) + ! need to finish up the computation of the atm - land map ( point cloud) if (iamin_CPLALLATMID .and. atm_c2_lnd) call prep_atm_lnd_moab(infodata) diff --git a/driver-moab/main/prep_ocn_mod.F90 b/driver-moab/main/prep_ocn_mod.F90 index 9cd68389eb39..ce9fae879dfd 100644 --- a/driver-moab/main/prep_ocn_mod.F90 +++ b/driver-moab/main/prep_ocn_mod.F90 @@ -88,7 +88,7 @@ module prep_ocn_mod public :: prep_ocn_get_mapper_Fg2o public :: prep_ocn_get_mapper_Sw2o - public :: prep_atm_ocn_moab, prep_ocn_migrate_moab + public :: prep_atm_ocn_moab, prep_ice_ocn_moab, prep_ocn_migrate_moab !-------------------------------------------------------------------------- ! Private interfaces !-------------------------------------------------------------------------- @@ -150,7 +150,7 @@ module prep_ocn_mod subroutine prep_ocn_init(infodata, atm_c2_ocn, atm_c2_ice, ice_c2_ocn, rof_c2_ocn, & wav_c2_ocn, glc_c2_ocn, glcshelf_c2_ocn) - use iMOAB, only: iMOAB_RegisterApplication, iMOAB_ComputeCommGraph, iMOAB_DefineTagStorage + use iMOAB, only: iMOAB_RegisterApplication !--------------------------------------------------------------- ! Description ! Initialize module attribute vectors and all other non-mapping @@ -193,14 +193,7 @@ subroutine prep_ocn_init(infodata, atm_c2_ocn, atm_c2_ice, ice_c2_ocn, rof_c2_oc character*32 :: appname ! to register moab app integer :: rmapid ! external id to identify the moab app integer :: ierr, type_grid ! - - integer :: mpigrp_CPLID ! coupler pes group, used for comm graph phys <-> atm-ocn - integer :: mpigrp_old ! component group pes (phys grid atm) == atm group - integer :: typeA, typeB ! type for computing graph; - integer :: ocn_id_x, ice_id, id_join - integer :: mpicom_join ! join comm between ice and coupler - character(CXX) :: tagname - integer :: tagtype, numco, tagindex ! used to define tags + !--------------------------------------------------------------- call seq_infodata_getData(infodata , & @@ -344,40 +337,7 @@ subroutine prep_ocn_init(infodata, atm_c2_ocn, atm_c2_ice, ice_c2_ocn, rof_c2_oc write(logunit,*) ' ' write(logunit,F00) 'Initializing mapper_SFi2o' end if - iamin_CPLALLICEID = seq_comm_iamin(CPLALLICEID) call seq_map_init_rearrolap(mapper_SFi2o, ice(1), ocn(1), 'mapper_SFi2o') - - ocn_id_x = ocn(1)%cplcompid - ice_id = ice(1)%compid - - id_join = ice(1)%cplcompid - call seq_comm_getinfo(ID_join,mpicom=mpicom_join) ! joint comm over ice and coupler - call seq_comm_getinfo(CPLID ,mpigrp=mpigrp_CPLID) ! second group, the coupler group CPLID is global variable - call seq_comm_getinfo(ice_id, mpigrp=mpigrp_old) - typeA = 3 - typeB = 3 ! fv-fv graph - - ! imoab compute comm graph ice-ocn, based on the same global id - ! it will be a simple migrate from ice mesh directly to ocean, using the comm graph computed here - if (iamin_CPLALLICEID) then - ierr = iMOAB_ComputeCommGraph( mpsiid, mboxid, mpicom_join, mpigrp_old, mpigrp_CPLID, & - typeA, typeB, ice_id, ocn_id_x) - if (ierr .ne. 0) then - write(logunit,*) subname,' error in computing graph ice - ocn x ' - call shr_sys_abort(subname//' ERROR in computing graph ice - ocn x ') - endif - endif - if (mboxid .ge. 0) then ! we are on coupler pes, ocean app on coupler - ! define tags according to the seq_flds_i2x_fields - tagtype = 1 ! dense, double - numco = 1 ! one value per cell / entity - tagname = trim(seq_flds_i2x_fields)//C_NULL_CHAR - ierr = iMOAB_DefineTagStorage(mboxid, tagname, tagtype, numco, tagindex ) - if ( ierr == 1 ) then - call shr_sys_abort( subname//' ERROR: cannot define tags in moab' ) - end if - endif - endif call shr_sys_flush(logunit) @@ -1850,4 +1810,60 @@ subroutine prep_atm_ocn_moab(infodata) end if end subroutine prep_atm_ocn_moab + subroutine prep_ice_ocn_moab(infodata) + + use iMOAB, only: iMOAB_ComputeCommGraph, iMOAB_DefineTagStorage + type(seq_infodata_type) , intent(in) :: infodata + + character(*), parameter :: subname = '(prep_ice_ocn_moab)' + + integer :: typeA, typeB ! type for computing graph; + integer :: ocn_id_x, ice_id, id_join, ierr + integer :: mpicom_join ! join comm between ice and coupler + character(CXX) :: tagname + integer :: tagtype, numco, tagindex ! used to define tags + integer :: mpigrp_CPLID ! coupler pes group + integer :: mpigrp_old ! component group pes (ice here) + logical :: ice_present, ocn_present, ocn_prognostic + + call seq_infodata_getData(infodata, & + ice_present=ice_present, & + ocn_present=ocn_present, & + ocn_prognostic=ocn_prognostic) + + if ( ice_present .and. ocn_present .and. ocn_prognostic ) then + + ocn_id_x = ocn(1)%cplcompid + ice_id = ice(1)%compid + + id_join = ice(1)%cplcompid + call seq_comm_getinfo(ID_join,mpicom=mpicom_join) ! joint comm over ice and coupler + call seq_comm_getinfo(CPLID ,mpigrp=mpigrp_CPLID) ! second group, the coupler group CPLID is global variable + call seq_comm_getinfo(ice_id, mpigrp=mpigrp_old) + typeA = 3 + typeB = 3 ! fv-fv graph + + ! imoab compute comm graph ice-ocn, based on the same global id + ! it will be a simple migrate from ice mesh directly to ocean, using the comm graph computed here + + ierr = iMOAB_ComputeCommGraph( mpsiid, mboxid, mpicom_join, mpigrp_old, mpigrp_CPLID, & + typeA, typeB, ice_id, ocn_id_x) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in computing graph ice - ocn x ' + call shr_sys_abort(subname//' ERROR in computing graph ice - ocn x ') + endif + + if (mboxid .ge. 0) then ! we are on coupler pes, ocean app on coupler + ! define tags according to the seq_flds_i2x_fields + tagtype = 1 ! dense, double + numco = 1 ! one value per cell / entity + tagname = trim(seq_flds_i2x_fields)//C_NULL_CHAR + ierr = iMOAB_DefineTagStorage(mboxid, tagname, tagtype, numco, tagindex ) + if ( ierr == 1 ) then + call shr_sys_abort( subname//' ERROR: cannot define tags in moab' ) + end if + endif + endif + end subroutine prep_ice_ocn_moab + end module prep_ocn_mod From b2fd1b12eea8daf0c4a0763a96f00318b9da081c Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Tue, 10 May 2022 16:11:29 -0500 Subject: [PATCH 144/467] lnd tags should be defined when app is on --- driver-moab/main/prep_lnd_mod.F90 | 16 +++++++++------- 1 file changed, 9 insertions(+), 7 deletions(-) diff --git a/driver-moab/main/prep_lnd_mod.F90 b/driver-moab/main/prep_lnd_mod.F90 index c036fb8625c7..8c9a0a65887c 100644 --- a/driver-moab/main/prep_lnd_mod.F90 +++ b/driver-moab/main/prep_lnd_mod.F90 @@ -722,13 +722,15 @@ subroutine prep_atm_lnd_moab(infodata) endif endif ! if (.not. sameg_al) - ! in any case, we need to define the tags on landx from the phys atm seq_flds_a2x_fields - tagtype = 1 ! dense, double - numco = 1 ! one value per vertex / entity - tagname = trim(seq_flds_a2x_fields)//C_NULL_CHAR - ierr = iMOAB_DefineTagStorage(mblxid, tagname, tagtype, numco, tagindex ) - if ( ierr > 0) then - call shr_sys_abort(subname//' fail to define seq_flds_a2x_fields for lnd x moab mesh ') + if (mblxid .ge. 0) then + ! in any case, we need to define the tags on landx from the phys atm seq_flds_a2x_fields + tagtype = 1 ! dense, double + numco = 1 ! one value per vertex / entity + tagname = trim(seq_flds_a2x_fields)//C_NULL_CHAR + ierr = iMOAB_DefineTagStorage(mblxid, tagname, tagtype, numco, tagindex ) + if ( ierr > 0) then + call shr_sys_abort(subname//' fail to define seq_flds_a2x_fields for lnd x moab mesh ') + endif endif end subroutine prep_atm_lnd_moab From eb358fdada2c104dfb77f778534dfb1af7cd1c8d Mon Sep 17 00:00:00 2001 From: Robert Jacob Date: Tue, 10 May 2022 17:56:33 -0500 Subject: [PATCH 145/467] And fsurdat for ne4pg2 1850 Add elm fsurdat file for ne4pg2 1850 by copying from E3SM master. --- components/elm/bld/namelist_files/namelist_defaults.xml | 2 ++ 1 file changed, 2 insertions(+) diff --git a/components/elm/bld/namelist_files/namelist_defaults.xml b/components/elm/bld/namelist_files/namelist_defaults.xml index 254d39038819..3fede649c15c 100644 --- a/components/elm/bld/namelist_files/namelist_defaults.xml +++ b/components/elm/bld/namelist_files/namelist_defaults.xml @@ -347,6 +347,8 @@ lnd/clm2/surfdata_map/surfdata_ne120np4_simyr1850_c160211.nc lnd/clm2/surfdata_map/surfdata_ne11np4_simyr1850_c160614.nc lnd/clm2/surfdata_map/surfdata_ne4np4_simyr1850_c160614.nc + +lnd/clm2/surfdata_map/surfdata_ne4pg2_simyr1850_c210722.nc lnd/clm2/surfdata_map/surfdata_ne240np4_simyr1850_c170821.nc From 81cbf061051b5617bee067c1f757ea54915b7a84 Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Wed, 11 May 2022 13:43:50 -0500 Subject: [PATCH 146/467] ice-ocnx comm needs to happen in the driver before, we were doing it on coupler PEs only, which is wrong --- driver-moab/main/cime_comp_mod.F90 | 11 +++++++++-- driver-moab/main/prep_ocn_mod.F90 | 2 +- 2 files changed, 10 insertions(+), 3 deletions(-) diff --git a/driver-moab/main/cime_comp_mod.F90 b/driver-moab/main/cime_comp_mod.F90 index 8aacc4e023f9..04cff38d086d 100644 --- a/driver-moab/main/cime_comp_mod.F90 +++ b/driver-moab/main/cime_comp_mod.F90 @@ -4265,8 +4265,6 @@ subroutine cime_run_atmocn_setup(hashint) ! Map to ocn if (ice_c2_ocn) then call prep_ocn_calc_i2x_ox(timer='CPL:atmocnp_ice2ocn') - ! also call moab ice-ocn projection, which is just a migrate - call prep_ocn_calc_i2x_ox_moab() endif if (wav_c2_ocn) call prep_ocn_calc_w2x_ox(timer='CPL:atmocnp_wav2ocn') if (trim(cpl_seq_option(1:5)) == 'NUOPC') then @@ -4708,6 +4706,15 @@ subroutine cime_run_ice_recv_post() mpicom_barrier=mpicom_CPLALLICEID, run_barriers=run_barriers, & timer_barrier='CPL:I2C_BARRIER', timer_comp_exch='CPL:I2C', & timer_map_exch='CPL:i2c_icei2icex', timer_infodata_exch='CPL:i2c_infoexch') + + ! also call moab ice-ocn projection, which is just a migrate + ! this needs to happen between ice comp and ocn coupler directly + ! it needs to be called on the joint comm between ice and coupler + ! if we do a proper component_exch, then would another hop, just on coupler pes + ! TODO when do we need to send from ice to ocn? Usually after ice run ? + if (ice_c2_ocn ) then + call prep_ocn_calc_i2x_ox_moab() + endif endif !---------------------------------------------------------- diff --git a/driver-moab/main/prep_ocn_mod.F90 b/driver-moab/main/prep_ocn_mod.F90 index ce9fae879dfd..6fdece574fc5 100644 --- a/driver-moab/main/prep_ocn_mod.F90 +++ b/driver-moab/main/prep_ocn_mod.F90 @@ -1360,7 +1360,7 @@ subroutine prep_ocn_calc_i2x_ox_moab() endif #ifdef MOABDEBUG - if (mboxid .ge. 0 ) then ! we are on ocean pes, for sure + if (mboxid .ge. 0 ) then ! we are on coupler pes, for sure write(lnum,"(I0.2)") number_proj outfile = 'OcnCplAftIce'//trim(lnum)//'.h5m'//C_NULL_CHAR wopts = ';PARALLEL=WRITE_PART'//C_NULL_CHAR ! From 361c6819be15ea1c0fa2ecfa4720a5ed14c213cb Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Sat, 14 May 2022 14:43:15 -0500 Subject: [PATCH 147/467] fix pg2 cases use new convention for par comm graph also project all atm phys grid fields to ocean and land --- components/eam/src/dynamics/se/dyn_comp.F90 | 11 ++- driver-moab/main/cime_comp_mod.F90 | 2 +- driver-moab/main/prep_atm_mod.F90 | 88 +++++++++++++-------- driver-moab/main/prep_ocn_mod.F90 | 37 ++++++--- 4 files changed, 89 insertions(+), 49 deletions(-) diff --git a/components/eam/src/dynamics/se/dyn_comp.F90 b/components/eam/src/dynamics/se/dyn_comp.F90 index 04e2c4eb8ba9..104823b6d9b0 100644 --- a/components/eam/src/dynamics/se/dyn_comp.F90 +++ b/components/eam/src/dynamics/se/dyn_comp.F90 @@ -163,7 +163,11 @@ subroutine dyn_init1(fh, NLFileName, dyn_in, dyn_out) #ifdef HAVE_MOAB appname="HM_COARSE"//C_NULL_CHAR - ATM_ID1 = ATMID(1) ! first atmosphere instance; it should be 5 + if (fv_nphys > 0 ) then ! in this case HM_COARSE will not be used for transfers ... + ATM_ID1 = 120 ! + else + ATM_ID1 = ATMID(1) ! first atmosphere instance; it should be 5 + endif ierr = iMOAB_RegisterApplication(appname, par%comm, ATM_ID1, MHID) if (ierr > 0 ) & call endrun('Error: cannot register moab app') @@ -184,7 +188,10 @@ subroutine dyn_init1(fh, NLFileName, dyn_in, dyn_out) endif if ( fv_nphys > 0 ) then appname="HM_PGX"//C_NULL_CHAR - ATM_ID1 = 120 ! this number should not conflict with other components IDs; how do we know? + ATM_ID1 = ATMID(1) ! this number should not conflict with other components IDs; how do we know? + ! + ! in this case, we reuse the main atm id, mhid will not be used for intersection anymore + ! still, need to be careful ierr = iMOAB_RegisterApplication(appname, par%comm, ATM_ID1, mhpgid) if (ierr > 0 ) & call endrun('Error: cannot register moab app for fine mesh') diff --git a/driver-moab/main/cime_comp_mod.F90 b/driver-moab/main/cime_comp_mod.F90 index 04cff38d086d..21de13d44c69 100644 --- a/driver-moab/main/cime_comp_mod.F90 +++ b/driver-moab/main/cime_comp_mod.F90 @@ -4710,7 +4710,7 @@ subroutine cime_run_ice_recv_post() ! also call moab ice-ocn projection, which is just a migrate ! this needs to happen between ice comp and ocn coupler directly ! it needs to be called on the joint comm between ice and coupler - ! if we do a proper component_exch, then would another hop, just on coupler pes + ! if we do a proper component_exch, then would need another hop, just on coupler pes ! TODO when do we need to send from ice to ocn? Usually after ice run ? if (ice_c2_ocn ) then call prep_ocn_calc_i2x_ox_moab() diff --git a/driver-moab/main/prep_atm_mod.F90 b/driver-moab/main/prep_atm_mod.F90 index 0f893eb2df7f..9360c43db8a5 100644 --- a/driver-moab/main/prep_atm_mod.F90 +++ b/driver-moab/main/prep_atm_mod.F90 @@ -103,7 +103,7 @@ module prep_atm_mod subroutine prep_atm_init(infodata, ocn_c2_atm, ice_c2_atm, lnd_c2_atm, iac_c2_atm) use iMOAB, only: iMOAB_ComputeMeshIntersectionOnSphere, iMOAB_RegisterApplication, & - iMOAB_WriteMesh, iMOAB_ComputePointDoFIntersection ! use computedofintx if land is point cloud + iMOAB_WriteMesh !--------------------------------------------------------------- ! Description ! Initialize module attribute vectors and mappers @@ -371,19 +371,14 @@ subroutine prep_atm_migrate_moab(infodata) context_id = ocn(1)%cplcompid wgtIdef = 'scalar'//C_NULL_CHAR - tagNameProj = 'a2oTbot_proj:a2oUbot_proj:a2oVbot_proj:'//C_NULL_CHAR num_proj = num_proj + 1 if (atm_present .and. ocn_present .and. ocn_prognostic) then if (atm_pg_active ) then ! use data from AtmPhys mesh, but mesh from pg ! in this case, we will send from phys grid directly to intx atm ocn context! + tagname=trim(seq_flds_a2x_fields)//C_NULL_CHAR if (mphaid .ge. 0) then ! send because we are on atm pes, also mphaid >= 0 - - ! basically, adjust the migration of the tag we want to project; it was sent initially with - ! trivial partitioning, now we need to adjust it for "coverage" mesh - ! as always, use nonblocking sends - tagName = 'T_ph:u_ph:v_ph:'//C_NULL_CHAR ! they are defined in initialize_moab_atm_phys in atm_comp_mct - context_id = 100*atm(1)%cplcompid + ocn(1)%cplcompid !send to atm/ocn intx ! + context_id = 100*atm(1)%cplcompid + ocn(1)%cplcompid !send to atm/ocn intx ! ~ 618 ierr = iMOAB_SendElementTag(mphaid, tagName, mpicom_join, context_id) if (ierr .ne. 0) then write(logunit,*) subname,' error in sending tag from phys atm to ocn atm intx ' @@ -391,9 +386,7 @@ subroutine prep_atm_migrate_moab(infodata) endif endif - if (mbintxao .ge. 0 ) then ! we are for sure on coupler pes! - tagName = 'T_ph16:u_ph16:v_ph16:'//C_NULL_CHAR ! they are defined in cplcomp_exchange mod ! context_id = atm(1)%cplcompid == atm_id above (5) ! we use the same name as spectral case, even thought in pg2 case, the size of tag is 1, not 16 ! in imoab_apg2_ol_coupler.cpp we use at this stage, receiver, the same name as sender, T_ph @@ -412,8 +405,35 @@ subroutine prep_atm_migrate_moab(infodata) call shr_sys_abort(subname//' ERROR in freeing buffers') endif endif + + if (mbintxao .ge. 0 ) then ! we are on coupler pes, for sure + ! we could apply weights; need to use the same weight identifier wgtIdef as when we generated it + ! hard coded now, it should be a runtime option in the future + + ierr = iMOAB_ApplyScalarProjectionWeights ( mbintxao, wgtIdef, tagName, tagName) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in applying weights ' + call shr_sys_abort(subname//' ERROR in applying weights') + endif +#ifdef MOABDEBUG + ! we can also write the ocean mesh to file, just to see the projectd tag + ! write out the mesh file to disk + write(lnum,"(I0.2)")num_proj + outfile = 'ocnCplProj'//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 + write(logunit,*) subname,' error in writing ocn mesh after projection ' + call shr_sys_abort(subname//' ERROR in writing ocn mesh after projection') + endif +#endif + !CHECKRC(ierr, "cannot receive tag values") + endif + else ! original send from spectral elements + ! this will be reworked for all fields tagName = 'a2oTbot:a2oUbot:a2oVbot:'//C_NULL_CHAR ! they are defined in semoab_mod.F90!!! + tagNameProj = 'a2oTbot_proj:a2oUbot_proj:a2oVbot_proj'//C_NULL_CHAR ! the separator will be ';' semicolon if (mhid .ge. 0) then ! send because we are on atm pes @@ -446,36 +466,36 @@ subroutine prep_atm_migrate_moab(infodata) endif endif - endif - ! we could do the projection now, on the ocean mesh, because we are on the coupler pes; - ! the actual migrate could happen later , from coupler pes to the ocean pes - if (mbintxao .ge. 0 ) then ! we are on coupler pes, for sure - ! we could apply weights; need to use the same weight identifier wgtIdef as when we generated it - ! hard coded now, it should be a runtime option in the future + ! we could do the projection now, on the ocean mesh, because we are on the coupler pes; + ! the actual migrate could happen later , from coupler pes to the ocean pes + if (mbintxao .ge. 0 ) then ! we are on coupler pes, for sure + ! we could apply weights; need to use the same weight identifier wgtIdef as when we generated it + ! hard coded now, it should be a runtime option in the future - ierr = iMOAB_ApplyScalarProjectionWeights ( mbintxao, wgtIdef, tagName, tagNameProj) - if (ierr .ne. 0) then - write(logunit,*) subname,' error in applying weights ' - call shr_sys_abort(subname//' ERROR in applying weights') - endif + ierr = iMOAB_ApplyScalarProjectionWeights ( mbintxao, wgtIdef, tagName, tagNameProj) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in applying weights ' + call shr_sys_abort(subname//' ERROR in applying weights') + endif #ifdef MOABDEBUG - ! we can also write the ocean mesh to file, just to see the projectd tag - ! write out the mesh file to disk - write(lnum,"(I0.2)")num_proj - outfile = 'ocnCplProj'//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 - write(logunit,*) subname,' error in writing ocn mesh after projection ' - call shr_sys_abort(subname//' ERROR in writing ocn mesh after projection') - endif + ! we can also write the ocean mesh to file, just to see the projectd tag + ! write out the mesh file to disk + write(lnum,"(I0.2)")num_proj + outfile = 'ocnCplProj'//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 + write(logunit,*) subname,' error in writing ocn mesh after projection ' + call shr_sys_abort(subname//' ERROR in writing ocn mesh after projection') + endif #endif - - !CHECKRC(ierr, "cannot receive tag values") - endif + endif ! if (mbintxao .ge. 0 ) + !CHECKRC(ierr, "cannot receive tag values") + endif ! if (atp_pg_active) endif ! if atm and ocn + ! repeat this for land data, that is already on atm tag tagNameProj = 'a2lTbot_proj:a2lUbot_proj:a2lVbot_proj:'//C_NULL_CHAR diff --git a/driver-moab/main/prep_ocn_mod.F90 b/driver-moab/main/prep_ocn_mod.F90 index 6fdece574fc5..9794d6d246cc 100644 --- a/driver-moab/main/prep_ocn_mod.F90 +++ b/driver-moab/main/prep_ocn_mod.F90 @@ -1661,7 +1661,7 @@ end subroutine prep_ocn_migrate_moab subroutine prep_atm_ocn_moab(infodata) use iMOAB, only: iMOAB_CoverageGraph, iMOAB_ComputeScalarProjectionWeights, & - iMOAB_ComputeCommGraph + iMOAB_ComputeCommGraph, iMOAB_DefineTagStorage !--------------------------------------------------------------- ! Description ! After intersection of atm and ocean mesh, correct the communication graph @@ -1690,6 +1690,9 @@ subroutine prep_atm_ocn_moab(infodata) integer :: mpigrp_old ! component group pes (phys grid atm) == atm group integer :: typeA, typeB ! type for computing graph; integer :: idintx ! in this case, id of moab intersection between atm and ocn, on coupler pes + + character(CXX) :: tagname + integer :: tagtype, numco, tagindex ! used to define tags call seq_infodata_getData(infodata, & @@ -1712,15 +1715,15 @@ subroutine prep_atm_ocn_moab(infodata) if (ocn_prognostic) then if (atm_pg_active ) then ! use mhpgid mesh - ierr = iMOAB_CoverageGraph(mpicom_join, mhpgid, mbaxid, mbintxao, atm_id, id_join, context_id); - if (iamroot_CPLID) then - write(logunit,*) 'iMOAB graph atmpg2-intxao context: ', context_id - end if + ierr = iMOAB_CoverageGraph(mpicom_join, mhpgid, mbaxid, mbintxao, atm_id, id_join, context_id); + if (iamroot_CPLID) then + write(logunit,*) 'iMOAB graph atmpg2-intxao context: ', context_id + end if else - ierr = iMOAB_CoverageGraph(mpicom_join, mhid, mbaxid, mbintxao, atm_id, id_join, context_id); - if (iamroot_CPLID) then - write(logunit,*) 'iMOAB graph atmnp4-intxao context: ', context_id - end if + ierr = iMOAB_CoverageGraph(mpicom_join, mhid, mbaxid, mbintxao, atm_id, id_join, context_id); + if (iamroot_CPLID) then + write(logunit,*) 'iMOAB graph atmnp4-intxao context: ', context_id + end if endif if (ierr .ne. 0) then write(logunit,*) subname,' error in computing coverage graph atm/ocn ' @@ -1734,12 +1737,12 @@ subroutine prep_atm_ocn_moab(infodata) dm1 = "fv"//C_NULL_CHAR dofnameATM="GLOBAL_ID"//C_NULL_CHAR orderATM = 1 ! fv-fv - volumetric = 1 ! maybe volumetric ? + volumetric = 0 ! maybe volumetric ? else dm1 = "cgll"//C_NULL_CHAR dofnameATM="GLOBAL_DOFS"//C_NULL_CHAR orderATM = np ! it should be 4 - volumetric = 0 + volumetric = 1 endif dm2 = "fv"//C_NULL_CHAR dofnameOCN="GLOBAL_ID"//C_NULL_CHAR @@ -1768,6 +1771,16 @@ subroutine prep_atm_ocn_moab(infodata) if (iamroot_CPLID) then write(logunit,*) 'finish iMOAB weights in atm-ocn' endif + ! define here the tags atm-ocn projection + ! define tags according to the seq_flds_a2x_fields + tagtype = 1 ! dense, double + numco = 1 ! one value per cell / entity + tagname = trim(seq_flds_a2x_fields)//C_NULL_CHAR + ierr = iMOAB_DefineTagStorage(mboxid, tagname, tagtype, numco, tagindex ) + if ( ierr == 1 ) then + call shr_sys_abort( subname//' ERROR: cannot define tags in moab' ) + end if + endif ! only if atm and ocn intersect mbintxao >= 0 ! compute the comm graph between phys atm and intx-atm-ocn, to be able to send directly from phys atm ! towards coverage mesh on atm for intx to ocean @@ -1860,7 +1873,7 @@ subroutine prep_ice_ocn_moab(infodata) tagname = trim(seq_flds_i2x_fields)//C_NULL_CHAR ierr = iMOAB_DefineTagStorage(mboxid, tagname, tagtype, numco, tagindex ) if ( ierr == 1 ) then - call shr_sys_abort( subname//' ERROR: cannot define tags in moab' ) + call shr_sys_abort( subname//' ERROR: cannot define tags for ice proj to ocn' ) end if endif endif From 8df76ca1a2ede793b817f278982ac6a07b118163 Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Sun, 15 May 2022 16:23:26 -0500 Subject: [PATCH 148/467] volumetric is used only for Fv-> xgll --- driver-moab/main/prep_ocn_mod.F90 | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/driver-moab/main/prep_ocn_mod.F90 b/driver-moab/main/prep_ocn_mod.F90 index 9794d6d246cc..66715ef1fef6 100644 --- a/driver-moab/main/prep_ocn_mod.F90 +++ b/driver-moab/main/prep_ocn_mod.F90 @@ -1732,17 +1732,16 @@ subroutine prep_atm_ocn_moab(infodata) endif if ( mbintxao .ge. 0 ) then + volumetric = 0 ! can be 1 only for FV->DGLL or FV->CGLL; wgtIdef = 'scalar'//C_NULL_CHAR if (atm_pg_active) then dm1 = "fv"//C_NULL_CHAR dofnameATM="GLOBAL_ID"//C_NULL_CHAR orderATM = 1 ! fv-fv - volumetric = 0 ! maybe volumetric ? else dm1 = "cgll"//C_NULL_CHAR dofnameATM="GLOBAL_DOFS"//C_NULL_CHAR orderATM = np ! it should be 4 - volumetric = 1 endif dm2 = "fv"//C_NULL_CHAR dofnameOCN="GLOBAL_ID"//C_NULL_CHAR From ae499207803a87a06038648abbcb6781a111bbb5 Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Mon, 16 May 2022 21:30:41 -0500 Subject: [PATCH 149/467] add another seq_flds_a2x string for moab spectral atm spectral cells will have a tag sized 16 usually (4x4), so it will be different from the tag used by phys grid point cloud mesh add "_ext" to each field name, and use it for DOF_BASED tag migration, in which the comm graph is computed between phys grid and intx between atm spectral and ocean --- driver-moab/shr/seq_flds_mod.F90 | 62 ++++++++++++++++++++++++++++++++ 1 file changed, 62 insertions(+) diff --git a/driver-moab/shr/seq_flds_mod.F90 b/driver-moab/shr/seq_flds_mod.F90 index 28821b0547d2..605b2fbe299d 100644 --- a/driver-moab/shr/seq_flds_mod.F90 +++ b/driver-moab/shr/seq_flds_mod.F90 @@ -131,6 +131,16 @@ module seq_flds_mod use shr_ndep_mod , only : shr_ndep_readnl use shr_flds_mod , only : seq_flds_dom_coord=>shr_flds_dom_coord, seq_flds_dom_other=>shr_flds_dom_other + + use mct_mod +! use m_List ,only: mct_list => list +! use m_List ,only: mct_list_init => init +! use m_List ,only: mct_list_get => get +! use m_List ,only: mct_list_nitem => nitem +! use m_List ,only: mct_list_clean => clean +! use m_string ,only: mct_string => string +! use m_string ,only: mct_string_clean => clean + implicit none public @@ -166,6 +176,8 @@ module seq_flds_mod character(CXX) :: seq_flds_a2x_states character(CXX) :: seq_flds_a2x_fluxes + character(CXX) :: seq_flds_a2x_ext_states + character(CXX) :: seq_flds_a2x_ext_fluxes character(CXX) :: seq_flds_a2x_states_to_rof character(CXX) :: seq_flds_a2x_fluxes_to_rof character(CXX) :: seq_flds_x2a_states @@ -231,6 +243,7 @@ module seq_flds_mod character(CXX) :: seq_flds_dom_fields character(CXX) :: seq_flds_a2x_fields + character(CXX) :: seq_flds_a2x_ext_fields character(CXX) :: seq_flds_a2x_fields_to_rof character(CXX) :: seq_flds_x2a_fields character(CXX) :: seq_flds_i2x_fields @@ -353,6 +366,8 @@ subroutine seq_flds_set(nmlfile, ID, infodata) !------ namelist ----- character(len=CSS) :: fldname, fldflow + character(len=CSS) :: fldname_ext ! use for moab extensions + type(mct_string) :: mctOStr ! mct string for output outfield logical :: is_state, is_flux integer :: i,n @@ -379,6 +394,9 @@ subroutine seq_flds_set(nmlfile, ID, infodata) character(len=*),parameter :: subname = '(seq_flds_set) ' + type(mct_list) :: temp_list + integer :: size_list, index_list + !------------------------------------------------------------------------------- call seq_comm_setptrs(ID,mpicom=mpicom) @@ -3625,6 +3643,50 @@ subroutine seq_flds_set(nmlfile, ID, infodata) call catFields(seq_flds_w2x_fields, seq_flds_w2x_states, seq_flds_w2x_fluxes) call catFields(seq_flds_x2w_fields, seq_flds_x2w_states, seq_flds_x2w_fluxes) + ! form character(CXX) :: seq_flds_a2x_ext_states from seq_flds_a2x_states by adding _ext in each field + ! first form a list + call mct_list_init(temp_list ,seq_flds_a2x_fields) + size_list=mct_list_nitem (temp_list) + seq_flds_a2x_ext_fields='' + do index_list = 1, size_list + call mct_list_get(mctOStr,index_list,temp_list) + fldname = mct_string_toChar(mctOStr) + fldname_ext = trim(fldname)//'_ext' + call seq_flds_add(seq_flds_a2x_ext_fields,trim(fldname_ext)) + enddo + seq_flds_a2x_ext_fluxes='' + call mct_list_clean(temp_list) + ! seq_flds_a2x_fluxes + call mct_list_init(temp_list ,seq_flds_a2x_fluxes) + size_list=mct_list_nitem (temp_list) + do index_list = 1, size_list + call mct_list_get(mctOStr,index_list,temp_list) + fldname = mct_string_toChar(mctOStr) + fldname_ext = trim(fldname)//'_ext' + call seq_flds_add(seq_flds_a2x_ext_fluxes,trim(fldname_ext)) + enddo + call mct_list_clean(temp_list) + call mct_list_init(temp_list ,seq_flds_a2x_states) + size_list=mct_list_nitem (temp_list) + seq_flds_a2x_ext_states='' + do index_list = 1, size_list + call mct_list_get(mctOStr,index_list,temp_list) + fldname = mct_string_toChar(mctOStr) + fldname_ext = trim(fldname)//'_ext' + call seq_flds_add(seq_flds_a2x_ext_states,trim(fldname_ext)) + enddo + call mct_list_clean(temp_list) + + + + if (seq_comm_iamroot(ID)) then + write(logunit,*) subname//': seq_flds_a2x_ext_states= ',trim(seq_flds_a2x_ext_states) + write(logunit,*) subname//': seq_flds_a2x_ext_fluxes= ',trim(seq_flds_a2x_ext_fluxes) + write(logunit,*) subname//': seq_flds_a2x_ext_fields= ',trim(seq_flds_a2x_ext_fields) + endif + + + end subroutine seq_flds_set !=============================================================================== From 763a4c788a36e85de87b55b8691bc286baeb3ee2 Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Wed, 18 May 2022 00:46:15 -0500 Subject: [PATCH 150/467] do not send back yet to ocean and land after projection we need to do some merging first --- driver-moab/main/cime_comp_mod.F90 | 22 +++++++++++----------- 1 file changed, 11 insertions(+), 11 deletions(-) diff --git a/driver-moab/main/cime_comp_mod.F90 b/driver-moab/main/cime_comp_mod.F90 index 21de13d44c69..2cb0c8ae1512 100644 --- a/driver-moab/main/cime_comp_mod.F90 +++ b/driver-moab/main/cime_comp_mod.F90 @@ -4058,17 +4058,17 @@ subroutine cime_run_atm_recv_post() call t_drvstopf ('CPL:ATMPOST',cplrun=.true.) endif - ! send projected data from atm to ocean mesh, after projection in coupler - if (iamin_CPLALLOCNID .and. ocn_c2_atm) then - ! migrate that tag from coupler pes to ocean pes - call prep_ocn_migrate_moab(infodata) - endif - - ! send projected data from atm to land mesh, after projection in coupler - if (iamin_CPLALLLNDID .and. atm_c2_lnd) then - ! migrate that tag from coupler pes to ocean pes - call prep_lnd_migrate_moab(infodata) - endif + ! ! send projected data from atm to ocean mesh, after projection in coupler + ! if (iamin_CPLALLOCNID .and. ocn_c2_atm) then + ! ! migrate that tag from coupler pes to ocean pes + ! call prep_ocn_migrate_moab(infodata) + ! endif + + ! ! send projected data from atm to land mesh, after projection in coupler + ! if (iamin_CPLALLLNDID .and. atm_c2_lnd) then + ! ! migrate that tag from coupler pes to ocean pes + ! call prep_lnd_migrate_moab(infodata) + ! endif end subroutine cime_run_atm_recv_post From 94ec05b2414f22de8ea5e5816057e73f5b61397f Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Wed, 18 May 2022 00:51:50 -0500 Subject: [PATCH 151/467] define extended name tags for spectral atm --- driver-moab/main/cplcomp_exchange_mod.F90 | 22 +++++++--------------- 1 file changed, 7 insertions(+), 15 deletions(-) diff --git a/driver-moab/main/cplcomp_exchange_mod.F90 b/driver-moab/main/cplcomp_exchange_mod.F90 index 9fc6aca472a6..b2e0799873e8 100644 --- a/driver-moab/main/cplcomp_exchange_mod.F90 +++ b/driver-moab/main/cplcomp_exchange_mod.F90 @@ -9,6 +9,7 @@ module cplcomp_exchange_mod use seq_map_type_mod use component_type_mod use seq_flds_mod, only: seq_flds_dom_coord, seq_flds_dom_other + use seq_flds_mod, only: seq_flds_a2x_ext_fields ! use seq_comm_mct, only: cplid, logunit use seq_comm_mct, only: seq_comm_getinfo => seq_comm_setptrs, seq_comm_iamin use seq_diag_mct @@ -1010,7 +1011,7 @@ subroutine cplcomp_moab_Init(comp) integer :: rank, ent_type integer :: typeA, typeB, ATM_PHYS_CID ! used to compute par graph between atm phys ! and atm spectral on coupler - character*32 :: tagname + character(CXX) :: tagname #ifdef MOABDEBUG integer , dimension(1:3) :: nverts, nelem, nblocks, nsbc, ndbc integer, dimension(:), allocatable :: vgids @@ -1114,7 +1115,7 @@ subroutine cplcomp_moab_Init(comp) ! now we have the spectral atm on coupler pes, and we want to send some data from ! atm physics mesh to atm spectral on coupler side; compute a par comm graph between ! atm phys and spectral atm mesh on coupler PEs - ! ierr = iMOAB_ComputeCommGraphFort(cmpAtmPID, physAtmPID, &joinComm, &atmPEGroup, &atmPhysGroup, + ! ierr = iMOAB_ComputeCommGraph(cmpAtmPID, physAtmPID, &joinComm, &atmPEGroup, &atmPhysGroup, ! &typeA, &typeB, &cmpatm, &physatm); ! graph between atm phys, mphaid, and atm dyn on coupler, mbaxid ! phys atm group is mpigrp_old, coupler group is mpigrp_cplid @@ -1122,7 +1123,7 @@ subroutine cplcomp_moab_Init(comp) !!typeB = 1 ! spectral elements !!ATM_PHYS_CID = 200 + id_old ! 200 + 5 for atm, see line 969 ATM_PHYS = 200 + ATMID ! in ! components/cam/src/cpl/atm_comp_mct.F90 - !!ierr = iMOAB_ComputeCommGraphFort( mphaid, mbaxid, mpicom_join, mpigrp_old, mpigrp_cplid, & + !!ierr = iMOAB_ComputeCommGraph( mphaid, mbaxid, mpicom_join, mpigrp_old, mpigrp_cplid, & !! typeA, typeB, ATM_PHYS_CID, id_join) ! comment out this above part @@ -1130,19 +1131,10 @@ subroutine cplcomp_moab_Init(comp) ! corresponding to 'T_ph;u_ph;v_ph'; ! we can receive those tags only on coupler pes, when mbaxid exists ! we have to check that before we can define the tag - if (mbaxid .ge. 0 ) then - tagname = 'T_ph16'//C_NULL_CHAR + if (mbaxid .ge. 0 .and. .not. (atm_pg_active) ) then + tagname = trim(seq_flds_a2x_ext_fields)//C_NULL_CHAR tagtype = 1 ! dense, double - if (atm_pg_active) then - numco = 1 ! just one value per cell ! - else - numco = np*np ! usually 16 values per cell, GLL points; should be 4 x 4 = 16 - endif - ierr = iMOAB_DefineTagStorage(mbaxid, tagname, tagtype, numco, tagindex ) - ! define more tags - tagname = 'u_ph16'//C_NULL_CHAR ! U component of velocity - ierr = iMOAB_DefineTagStorage(mbaxid, tagname, tagtype, numco, tagindex ) - tagname = 'v_ph16'//C_NULL_CHAR ! V component of velocity + numco = np*np ! usually 16 values per cell, GLL points; should be 4 x 4 = 16 ierr = iMOAB_DefineTagStorage(mbaxid, tagname, tagtype, numco, tagindex ) if (ierr .ne. 0) then write(logunit,*) subname,' error in defining tags ' From f9cbada247a2533b62be36b95ae7a8fbdea983b0 Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Thu, 19 May 2022 11:14:45 -0500 Subject: [PATCH 152/467] finish dof based field transfer phys-grid to ocean in case of spectral mesh, phys grid has data, but intx is computed between spectral mesh and ocn. field transfer is done between phys grid and intx atm-ocn directly on the coverage mesh for intx atm-ocn. projection is using tags sized 4x4 on each spectral cell --- driver-moab/main/prep_atm_mod.F90 | 38 +++++++-------- driver-moab/main/prep_ocn_mod.F90 | 79 ++++++++++++++++--------------- 2 files changed, 59 insertions(+), 58 deletions(-) diff --git a/driver-moab/main/prep_atm_mod.F90 b/driver-moab/main/prep_atm_mod.F90 index 9360c43db8a5..1b17169616a1 100644 --- a/driver-moab/main/prep_atm_mod.F90 +++ b/driver-moab/main/prep_atm_mod.F90 @@ -3,6 +3,7 @@ module prep_atm_mod use shr_kind_mod, only: r8 => SHR_KIND_R8 use shr_kind_mod, only: cs => SHR_KIND_CS use shr_kind_mod, only: cl => SHR_KIND_CL + use shr_kind_mod, only: CX => shr_kind_CX, CXX => shr_kind_CXX use shr_sys_mod, only: shr_sys_abort, shr_sys_flush use seq_comm_mct, only: num_inst_atm, num_inst_ocn, num_inst_ice, num_inst_lnd, num_inst_xao, & num_inst_frc, num_inst_max, CPLID, logunit @@ -349,7 +350,7 @@ subroutine prep_atm_migrate_moab(infodata) character*32 :: dm1, dm2, wgtIdef character*50 :: outfile, wopts, lnum integer :: orderOCN, orderATM, volumetric, noConserve, validate - character*400 :: tagName, tagnameProj + character(CXX) :: tagName, tagnameProj, tagNameExt call seq_infodata_getData(infodata, & @@ -430,19 +431,16 @@ subroutine prep_atm_migrate_moab(infodata) !CHECKRC(ierr, "cannot receive tag values") endif - else ! original send from spectral elements - ! this will be reworked for all fields - tagName = 'a2oTbot:a2oUbot:a2oVbot:'//C_NULL_CHAR ! they are defined in semoab_mod.F90!!! - tagNameProj = 'a2oTbot_proj:a2oUbot_proj:a2oVbot_proj'//C_NULL_CHAR - ! the separator will be ';' semicolon + else ! original send from spectral elements is replaced by send from phys grid + ! this will be reworked for all fields, send from phys grid atm: + tagName = trim(seq_flds_a2x_fields)//C_NULL_CHAR ! they are exported on phys grid directly + tagNameExt = trim(seq_flds_a2x_ext_fields)//C_NULL_CHAR ! these are special moab tags + ! the separator will be ':' as in mct - if (mhid .ge. 0) then ! send because we are on atm pes - - ! basically, adjust the migration of the tag we want to project; it was sent initially with - ! trivial partitioning, now we need to adjust it for "coverage" mesh - ! as always, use nonblocking sends - - ierr = iMOAB_SendElementTag(mhid, tagName, mpicom_join, context_id) + if (mphaid .ge. 0) then ! send because we are on atm pes + ! + context_id = 100*atm(1)%cplcompid + ocn(1)%cplcompid !send to atm/ocn intx ! ~ 618 + ierr = iMOAB_SendElementTag(mphaid, tagName, mpicom_join, context_id) if (ierr .ne. 0) then write(logunit,*) subname,' error in sending tag from atm spectral to ocn atm intx ' call shr_sys_abort(subname//' ERROR in sending tag from atm spectral to ocn atm intx') @@ -450,30 +448,30 @@ subroutine prep_atm_migrate_moab(infodata) endif if (mbaxid .ge. 0 ) then ! we are on coupler pes, for sure ! receive on atm on coupler pes, that was redistributed according to coverage - ierr = iMOAB_ReceiveElementTag(mbaxid, tagName, mpicom_join, context_id) + context_id = atm(1)%compid ! atm_id + ierr = iMOAB_ReceiveElementTag(mbintxao, tagNameExt, mpicom_join, context_id) if (ierr .ne. 0) then - write(logunit,*) subname,' error in receiving tag from atm spectral to ocn atm intx ' - call shr_sys_abort(subname//' ERROR in receiving tag from atm spectral to ocn atm intx') + write(logunit,*) subname,' error in receiving tag from atm phys grid to ocn atm intx spectral ' + call shr_sys_abort(subname//' ERROR in receiving tag from atm phys grid to ocn atm intx spectral') endif endif ! we can now free the sender buffers if (mhid .ge. 0) then - ierr = iMOAB_FreeSenderBuffers(mhid, context_id) + context_id = 100*atm(1)%cplcompid + ocn(1)%cplcompid !send to atm/ocn intx ! ~ 618 + ierr = iMOAB_FreeSenderBuffers(mphaid, context_id) if (ierr .ne. 0) then write(logunit,*) subname,' error in freeing buffers ' call shr_sys_abort(subname//' ERROR in freeing buffers') endif endif - - ! we could do the projection now, on the ocean mesh, because we are on the coupler pes; ! the actual migrate could happen later , from coupler pes to the ocean pes if (mbintxao .ge. 0 ) then ! we are on coupler pes, for sure ! we could apply weights; need to use the same weight identifier wgtIdef as when we generated it ! hard coded now, it should be a runtime option in the future - ierr = iMOAB_ApplyScalarProjectionWeights ( mbintxao, wgtIdef, tagName, tagNameProj) + ierr = iMOAB_ApplyScalarProjectionWeights ( mbintxao, wgtIdef, tagNameExt, tagName) if (ierr .ne. 0) then write(logunit,*) subname,' error in applying weights ' call shr_sys_abort(subname//' ERROR in applying weights') diff --git a/driver-moab/main/prep_ocn_mod.F90 b/driver-moab/main/prep_ocn_mod.F90 index 66715ef1fef6..5602a38ace29 100644 --- a/driver-moab/main/prep_ocn_mod.F90 +++ b/driver-moab/main/prep_ocn_mod.F90 @@ -1361,6 +1361,7 @@ subroutine prep_ocn_calc_i2x_ox_moab() #ifdef MOABDEBUG if (mboxid .ge. 0 ) then ! we are on coupler pes, for sure + number_proj = number_proj +1 ! because it was commented out above write(lnum,"(I0.2)") number_proj outfile = 'OcnCplAftIce'//trim(lnum)//'.h5m'//C_NULL_CHAR wopts = ';PARALLEL=WRITE_PART'//C_NULL_CHAR ! @@ -1618,43 +1619,43 @@ subroutine prep_ocn_migrate_moab(infodata) ! how to get mpicomm for joint ocn + coupler id_join = ocn(1)%cplcompid ocnid1 = ocn(1)%compid - call seq_comm_getinfo(ID_join,mpicom=mpicom_join) - context_id = -1 - ! now send the tag a2oTbot_proj, a2oUbot_proj, a2oVbot_proj from ocn on coupler pes towards original ocean mesh - tagName = 'a2oTbot_proj:a2oUbot_proj:a2oVbot_proj:'//C_NULL_CHAR ! defined in prep_atm_mod.F90!!! - - if (mboxid .ge. 0) then ! send because we are on coupler pes - - ! basically, use the initial partitioning - context_id = ocnid1 - ierr = iMOAB_SendElementTag(mboxid, tagName, mpicom_join, context_id) - - endif - if (mpoid .ge. 0 ) then ! we are on ocean pes, for sure - ! receive on ocean pes, a tag that was computed on coupler pes - context_id = id_join - ierr = iMOAB_ReceiveElementTag(mpoid, tagName, mpicom_join, context_id) - !CHECKRC(ierr, "cannot receive tag values") - endif - - ! we can now free the sender buffers - if (mboxid .ge. 0) then - context_id = ocnid1 - ierr = iMOAB_FreeSenderBuffers(mboxid, context_id) - ! CHECKRC(ierr, "cannot free buffers used to send projected tag towards the ocean mesh") - endif - -#ifdef MOABDEBUG - if (mpoid .ge. 0 ) then ! we are on ocean pes, for sure - number_proj = number_proj+1 ! count the number of projections - write(lnum,"(I0.2)") number_proj - outfile = 'wholeMPAS_proj'//trim(lnum)//'.h5m'//C_NULL_CHAR - wopts = ';PARALLEL=WRITE_PART'//C_NULL_CHAR ! - ierr = iMOAB_WriteMesh(mpoid, trim(outfile), trim(wopts)) - - !CHECKRC(ierr, "cannot receive tag values") - endif -#endif +! call seq_comm_getinfo(ID_join,mpicom=mpicom_join) +! context_id = -1 +! ! now send the tag a2oTbot_proj, a2oUbot_proj, a2oVbot_proj from ocn on coupler pes towards original ocean mesh +! tagName = 'a2oTbot_proj:a2oUbot_proj:a2oVbot_proj:'//C_NULL_CHAR ! defined in prep_atm_mod.F90!!! + +! if (mboxid .ge. 0) then ! send because we are on coupler pes + +! ! basically, use the initial partitioning +! context_id = ocnid1 +! ierr = iMOAB_SendElementTag(mboxid, tagName, mpicom_join, context_id) + +! endif +! if (mpoid .ge. 0 ) then ! we are on ocean pes, for sure +! ! receive on ocean pes, a tag that was computed on coupler pes +! context_id = id_join +! ierr = iMOAB_ReceiveElementTag(mpoid, tagName, mpicom_join, context_id) +! !CHECKRC(ierr, "cannot receive tag values") +! endif + +! ! we can now free the sender buffers +! if (mboxid .ge. 0) then +! context_id = ocnid1 +! ierr = iMOAB_FreeSenderBuffers(mboxid, context_id) +! ! CHECKRC(ierr, "cannot free buffers used to send projected tag towards the ocean mesh") +! endif + +! #ifdef MOABDEBUG +! if (mpoid .ge. 0 ) then ! we are on ocean pes, for sure +! number_proj = number_proj+1 ! count the number of projections +! write(lnum,"(I0.2)") number_proj +! outfile = 'wholeMPAS_proj'//trim(lnum)//'.h5m'//C_NULL_CHAR +! wopts = ';PARALLEL=WRITE_PART'//C_NULL_CHAR ! +! ierr = iMOAB_WriteMesh(mpoid, trim(outfile), trim(wopts)) + +! !CHECKRC(ierr, "cannot receive tag values") +! endif +! #endif end subroutine prep_ocn_migrate_moab @@ -1811,6 +1812,8 @@ subroutine prep_atm_ocn_moab(infodata) mphaid, mbintxao, mpicom_join, mpigrp_old, mpigrp_CPLID, & typeA, typeB, atm_id, idintx end if + ! for these to work, we need to define the tags of size 16 (np x np) on coupler atm, + ! corresponding to this phys grid graph ierr = iMOAB_ComputeCommGraph( mphaid, mbintxao, mpicom_join, mpigrp_old, mpigrp_CPLID, & typeA, typeB, atm_id, idintx) if (ierr .ne. 0) then @@ -1818,7 +1821,7 @@ subroutine prep_atm_ocn_moab(infodata) call shr_sys_abort(subname//' ERROR in computing graph phys grid - atm/ocn intx ') endif if (iamroot_CPLID) then - write(logunit,*) 'finish iMOAB graph in atm-land prep ' + write(logunit,*) 'finish iMOAB graph in atm-ocn prep ' end if end subroutine prep_atm_ocn_moab From a5082025ec9d36a0584dccbdb7f5ebc7819f4913 Mon Sep 17 00:00:00 2001 From: Jason Sarich Date: Tue, 24 May 2022 17:18:59 -0500 Subject: [PATCH 153/467] Add python 3 module for chrysalis --- cime_config/machines/config_machines.xml | 1 + 1 file changed, 1 insertion(+) diff --git a/cime_config/machines/config_machines.xml b/cime_config/machines/config_machines.xml index d202ee47e93d..46c9ca3b34f1 100644 --- a/cime_config/machines/config_machines.xml +++ b/cime_config/machines/config_machines.xml @@ -1256,6 +1256,7 @@ subversion/1.14.0-e4smcy3 perl/5.32.0-bsnc6lt cmake/3.19.1-yisciec + python/3.8.6-cip7oix intel/20.0.4-kodw73g From db2f9e5bf7ad518db3b5a1f6d3c3bb2a30f4b6ee Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Mon, 13 Jun 2022 10:33:24 -0500 Subject: [PATCH 154/467] migrate atm phys to coupler it is needed for coupler calculations (fractions, merging) --- driver-moab/main/cplcomp_exchange_mod.F90 | 61 +++++++++++++++++++++++ 1 file changed, 61 insertions(+) diff --git a/driver-moab/main/cplcomp_exchange_mod.F90 b/driver-moab/main/cplcomp_exchange_mod.F90 index b2e0799873e8..ff0f351c4772 100644 --- a/driver-moab/main/cplcomp_exchange_mod.F90 +++ b/driver-moab/main/cplcomp_exchange_mod.F90 @@ -19,6 +19,7 @@ module cplcomp_exchange_mod use seq_comm_mct, only : atm_pg_active ! flag if PG mesh instanced use seq_comm_mct, only : mlnid , mblxid ! iMOAB app id for land , on land pes and coupler pes use seq_comm_mct, only : mphaid ! iMOAB app id for phys atm; comp atm is 5, phys 5+200 + use seq_comm_mct, only : mphaxid ! iMOAB app id for phys atm, on cpl pes use seq_comm_mct, only : sameg_al ! same grid atm lnd, and land is point cloud use seq_comm_mct, only : MPSIID, mbixid ! sea-ice on comp pes and on coupler pes use shr_mpi_mod, only: shr_mpi_max @@ -1010,6 +1011,8 @@ subroutine cplcomp_moab_Init(comp) integer :: tagtype, numco, tagindex, partMethod integer :: rank, ent_type integer :: typeA, typeB, ATM_PHYS_CID ! used to compute par graph between atm phys + integer :: ID_JOIN_ATMPHYS ! 200 + 6 + integer :: ID_OLD_ATMPHYS ! 200 + 5 ! and atm spectral on coupler character(CXX) :: tagname #ifdef MOABDEBUG @@ -1109,6 +1112,64 @@ subroutine cplcomp_moab_Init(comp) call shr_sys_abort(subname//' ERROR in freeing send buffers') endif endif + + ! send also the phys grid to coupler, because it will be used for fractions + ! start copy for mphaid->mphaxid + if (MPI_COMM_NULL /= mpicom_old ) then ! it means we are on the component pes (atmosphere) + ! send mesh to coupler + if (atm_pg_active) then ! do not send again, mbaxid will be the same as mphaxid + mphaxid = mbaxid ! we already have pg mesh on coupler, as an FV mesh + else + ! still use the mhid, original coarse mesh + ID_JOIN_ATMPHYS = id_join + 200 ! somewhat arbitrary, just a different comp id + ierr = iMOAB_SendMesh(mphaid, mpicom_join, mpigrp_cplid, ID_JOIN_ATMPHYS, partMethod) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in sending mesh from atm comp ' + call shr_sys_abort(subname//' ERROR in sending mesh from atm comp') + endif + endif + + endif + if (MPI_COMM_NULL /= mpicom_new .and. .not. atm_pg_active ) then ! we are on the coupler pes + + appname = "COUPLE_ATMPH"//C_NULL_CHAR + ! migrated mesh gets another app id, moab atm to coupler (mbax) + ID_JOIN_ATMPHYS = id_join + 200 ! somewhat arbitrary, just a different comp id + ierr = iMOAB_RegisterApplication(trim(appname), mpicom_new, ID_JOIN_ATMPHYS, mphaxid) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in registering ', appname + call shr_sys_abort(subname//' ERROR registering '// appname) + endif + ID_OLD_ATMPHYS = id_old + 200 ! kind of arbitrary + ierr = iMOAB_ReceiveMesh(mphaxid, mpicom_join, mpigrp_old, ID_OLD_ATMPHYS) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in receiving mesh on atm coupler ' + call shr_sys_abort(subname//' ERROR in receiving mesh on atm coupler ') + endif +#ifdef MOABDEBUG + ! debug test + + outfile = 'recPhysAtm.h5m'//C_NULL_CHAR + wopts = ';PARALLEL=WRITE_PART'//C_NULL_CHAR + ! write out the mesh file to disk + ierr = iMOAB_WriteMesh(mphaxid, trim(outfile), trim(wopts)) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in writing mesh ' + call shr_sys_abort(subname//' ERROR in writing mesh ') + endif +#endif + endif + ! iMOAB_FreeSenderBuffers needs to be called after receiving the mesh + if (MPI_COMM_NULL /= mpicom_old .and. .not. atm_pg_active) then ! it means we are on the component pes (atmosphere) + context_id = ID_JOIN_ATMPHYS + ierr = iMOAB_FreeSenderBuffers(mphaid, context_id) + + if (ierr .ne. 0) then + write(logunit,*) subname,' error in freeing send buffers ' + call shr_sys_abort(subname//' ERROR in freeing send buffers') + endif + endif + ! comment out now; we will not send directly to atm spectral on coupler; we need to send in the ! context of ocean intx;; or directly to land on coupler, for projection to land From ca27bee825959f4697f61ab32d8a0091b0288696 Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Mon, 13 Jun 2022 10:34:33 -0500 Subject: [PATCH 155/467] comment out old projected vars --- driver-moab/main/prep_lnd_mod.F90 | 70 +++++++++++++++---------------- 1 file changed, 35 insertions(+), 35 deletions(-) diff --git a/driver-moab/main/prep_lnd_mod.F90 b/driver-moab/main/prep_lnd_mod.F90 index 8c9a0a65887c..998dfe1a8203 100644 --- a/driver-moab/main/prep_lnd_mod.F90 +++ b/driver-moab/main/prep_lnd_mod.F90 @@ -771,41 +771,41 @@ subroutine prep_lnd_migrate_moab(infodata) ! how to get mpicomm for joint ocn + coupler id_join = lnd(1)%cplcompid lndid1 = lnd(1)%compid - call seq_comm_getinfo(ID_join,mpicom=mpicom_join) - context_id = -1 - ! now send the tag a2oTbot_proj, a2oUbot_proj, a2oVbot_proj from ocn on coupler pes towards original ocean mesh - tagName = 'a2lTbot_proj:a2lUbot_proj:a2lVbot_proj:'//C_NULL_CHAR ! defined in prep_atm_mod.F90!!! - - if (mblxid .ge. 0) then ! send because we are on coupler pes - - ! basically, use the initial partitioning - context_id = lndid1 - ierr = iMOAB_SendElementTag(mblxid, tagName, mpicom_join, context_id) - - endif - if (mlnid .ge. 0 ) then ! we are on land pes, for sure - ! receive on land pes, a tag that was computed on coupler pes - context_id = id_join - ierr = iMOAB_ReceiveElementTag(mlnid, tagName, mpicom_join, context_id) - !CHECKRC(ierr, "cannot receive tag values") - endif - - ! we can now free the sender buffers - if (mblxid .ge. 0) then - context_id = lndid1 - ierr = iMOAB_FreeSenderBuffers(mblxid, context_id) - ! CHECKRC(ierr, "cannot free buffers used to send projected tag towards the ocean mesh") - endif - -#ifdef MOABDEBUG - if (mlnid .ge. 0 ) then ! we are on land pes, for sure - number_calls = number_calls + 1 - write(lnum,"(I0.2)") number_calls - outfile = 'wholeLND_proj'//trim(lnum)//'.h5m'//C_NULL_CHAR - wopts = ';PARALLEL=WRITE_PART'//C_NULL_CHAR ! - ierr = iMOAB_WriteMesh(mlnid, trim(outfile), trim(wopts)) - endif -#endif +! call seq_comm_getinfo(ID_join,mpicom=mpicom_join) +! context_id = -1 +! ! now send the tag a2oTbot_proj, a2oUbot_proj, a2oVbot_proj from ocn on coupler pes towards original ocean mesh +! tagName = 'a2lTbot_proj:a2lUbot_proj:a2lVbot_proj:'//C_NULL_CHAR ! defined in prep_atm_mod.F90!!! + +! if (mblxid .ge. 0) then ! send because we are on coupler pes + +! ! basically, use the initial partitioning +! context_id = lndid1 +! ierr = iMOAB_SendElementTag(mblxid, tagName, mpicom_join, context_id) + +! endif +! if (mlnid .ge. 0 ) then ! we are on land pes, for sure +! ! receive on land pes, a tag that was computed on coupler pes +! context_id = id_join +! ierr = iMOAB_ReceiveElementTag(mlnid, tagName, mpicom_join, context_id) +! !CHECKRC(ierr, "cannot receive tag values") +! endif + +! ! we can now free the sender buffers +! if (mblxid .ge. 0) then +! context_id = lndid1 +! ierr = iMOAB_FreeSenderBuffers(mblxid, context_id) +! ! CHECKRC(ierr, "cannot free buffers used to send projected tag towards the ocean mesh") +! endif + +! #ifdef MOABDEBUG +! if (mlnid .ge. 0 ) then ! we are on land pes, for sure +! number_calls = number_calls + 1 +! write(lnum,"(I0.2)") number_calls +! outfile = 'wholeLND_proj'//trim(lnum)//'.h5m'//C_NULL_CHAR +! wopts = ';PARALLEL=WRITE_PART'//C_NULL_CHAR ! +! ierr = iMOAB_WriteMesh(mlnid, trim(outfile), trim(wopts)) +! endif +! #endif end subroutine prep_lnd_migrate_moab From f557b2309a3579bc17414cef1b2eef7da5e400ce Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Mon, 13 Jun 2022 10:36:32 -0500 Subject: [PATCH 156/467] phys atm moab pid on cpl side --- driver-moab/shr/seq_comm_mct.F90 | 2 ++ 1 file changed, 2 insertions(+) diff --git a/driver-moab/shr/seq_comm_mct.F90 b/driver-moab/shr/seq_comm_mct.F90 index 252ba3201dbe..e7af8bb85e65 100644 --- a/driver-moab/shr/seq_comm_mct.F90 +++ b/driver-moab/shr/seq_comm_mct.F90 @@ -218,6 +218,7 @@ module seq_comm_mct integer, public :: mhpgid ! iMOAB id for atm pgx grid, on atm pes; created with se and gll grids logical, public :: atm_pg_active = .false. ! whether the atm uses FV mesh or not ; made true if fv_nphys > 0 integer, public :: mphaid ! iMOAB id for atm phys grid, on atm pes + integer, public :: mphaxid ! iMOAB id for atm phys grid, on cpl pes; for atm_pg_active it will be the same as mbaxid integer, public :: mbaxid ! iMOAB id for atm migrated mesh to coupler pes integer, public :: mboxid ! iMOAB id for mpas ocean migrated mesh to coupler pes integer, public :: mbintxao ! iMOAB id for intx mesh between ocean and atmosphere @@ -625,6 +626,7 @@ subroutine seq_comm_init(global_comm_in, driver_comm_in, nmlfile, drv_comm_id) mpoid = -1 ! iMOAB id for ocn comp mlnid = -1 ! iMOAB id for land comp mphaid = -1 ! iMOAB id for phys grid on atm pes + mphaxid = -1 ! iMOAB id for phys grid on cpl pes mbaxid = -1 ! iMOAB id for atm migrated mesh to coupler pes mboxid = -1 ! iMOAB id for mpas ocean migrated mesh to coupler pes mbintxao = -1 ! iMOAB id for atm intx with mpas ocean From a7327355548d85ceca48b3307243d42ca65490df Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Mon, 13 Jun 2022 10:37:44 -0500 Subject: [PATCH 157/467] fractions on atm and land and ice and ocn define the tags and start init on them --- driver-moab/main/seq_frac_mct.F90 | 61 +++++++++++++++++++++++++++++-- 1 file changed, 58 insertions(+), 3 deletions(-) diff --git a/driver-moab/main/seq_frac_mct.F90 b/driver-moab/main/seq_frac_mct.F90 index d0118e126905..fdf241672330 100644 --- a/driver-moab/main/seq_frac_mct.F90 +++ b/driver-moab/main/seq_frac_mct.F90 @@ -162,6 +162,14 @@ module seq_frac_mct use component_type_mod + use iMOAB, only: iMOAB_DefineTagStorage + use seq_comm_mct, only : mphaxid ! iMOAB app id for phys atm, on cpl pes + use seq_comm_mct, only : mblxid ! iMOAB app id for lnd on cpl pes + use seq_comm_mct, only : mboxid ! iMOAB app id for ocn on cpl pes + use seq_comm_mct, only : mbixid ! iMOAB for sea-ice migrated to coupler + + use shr_kind_mod, only: CL => SHR_KIND_CL, CX => SHR_KIND_CX, CXX => SHR_KIND_CXX + use iso_c_binding ! C_NULL_CHAR implicit none private save @@ -292,6 +300,9 @@ subroutine seq_frac_init( infodata, & character(*),parameter :: fraclist_w = 'wfrac' character(*),parameter :: fraclist_z = 'afrac:lfrac' + ! moab + integer :: tagtype, numco, tagindex, ierr + character(CXX) :: tagname !----- formats ----- character(*),parameter :: subName = '(seq_frac_init) ' @@ -331,6 +342,19 @@ subroutine seq_frac_init( infodata, & ka = mct_aVect_indexRa(fractions_a,"afrac",perrWith=subName) fractions_a%rAttr(ka,:) = 1.0_r8 + + ! Initialize fractions on atm coupler mesh; on migrated ph atm to coupler + if (mphaxid .ge. 0 ) then ! // + tagname = trim(fraclist_a)//C_NULL_CHAR + tagtype = 1 ! dense, double + numco = 1 ! + ierr = iMOAB_DefineTagStorage(mphaxid, tagname, tagtype, numco, tagindex ) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in defining tags on atm phys mesh on cpl ' + call shr_sys_abort(subname//' ERROR in defining tags on atm phys mesh on cpl') + endif + ! we should set to 1 the 'afrac' tag + endif endif ! Initialize fractions on glc grid decomp, just an initial "guess", updated later @@ -351,11 +375,20 @@ subroutine seq_frac_init( infodata, & lSize = mct_aVect_lSize(dom_l%data) call mct_aVect_init(fractions_l,rList=fraclist_l,lsize=lsize) call mct_aVect_zero(fractions_l) - + if (mphaxid .ge. 0 ) then ! // + tagname = trim(fraclist_l)//C_NULL_CHAR + tagtype = 1 ! dense, double + numco = 1 ! + ierr = iMOAB_DefineTagStorage(mblxid, tagname, tagtype, numco, tagindex ) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in defining tags on lnd phys mesh on cpl ' + call shr_sys_abort(subname//' ERROR in defining tags on lnd phys mesh on cpl') + endif + endif kk = mct_aVect_indexRA(fractions_l,"lfrin",perrWith=subName) kf = mct_aVect_indexRA(dom_l%data ,"frac" ,perrWith=subName) fractions_l%rAttr(kk,:) = dom_l%data%rAttr(kf,:) - +! we should set the lfrin tag to fractions_l%rAttr(kk,:) (from input ?) if (atm_present) then mapper_l2a => prep_atm_get_mapper_Fl2a() mapper_a2l => prep_lnd_get_mapper_Fa2l() @@ -402,6 +435,18 @@ subroutine seq_frac_init( infodata, & call mct_aVect_init(fractions_i,rList=fraclist_i,lsize=lsize) call mct_aVect_zero(fractions_i) + if (mphaxid .ge. 0 ) then ! // + tagname = trim(fraclist_i)//C_NULL_CHAR + tagtype = 1 ! dense, double + numco = 1 ! + ierr = iMOAB_DefineTagStorage(mbixid, tagname, tagtype, numco, tagindex ) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in defining tags on ice phys mesh on cpl ' + call shr_sys_abort(subname//' ERROR in defining tags on ice phys mesh on cpl') + endif + + endif + ko = mct_aVect_indexRa(fractions_i,"ofrac",perrWith=subName) kf = mct_aVect_indexRA(dom_i%data ,"frac" ,perrWith=subName) fractions_i%rAttr(ko,:) = dom_i%data%rAttr(kf,:) @@ -419,7 +464,17 @@ subroutine seq_frac_init( infodata, & lSize = mct_aVect_lSize(dom_o%data) call mct_aVect_init(fractions_o,rList=fraclist_o,lsize=lsize) call mct_aVect_zero(fractions_o) - + if (mboxid .ge. 0 ) then ! // + tagname = trim(fraclist_o)//C_NULL_CHAR + tagtype = 1 ! dense, double + numco = 1 ! + ierr = iMOAB_DefineTagStorage(mboxid, tagname, tagtype, numco, tagindex ) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in defining tags on ocn phys mesh on cpl ' + call shr_sys_abort(subname//' ERROR in defining tags on ocn phys mesh on cpl') + endif + + endif if (ice_present) then mapper_i2o => prep_ocn_get_mapper_SFi2o() call seq_map_map(mapper_i2o,fractions_i,fractions_o,fldlist='ofrac',norm=.false.) From 7763219fdfd9556007c62d242b2adf0e4357d97d Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Tue, 21 Jun 2022 14:51:51 -0500 Subject: [PATCH 158/467] add a new method for setting tags moab distribution and mct partition for land on coupler pes are different. use iMOAB_SetDoubleTagStorageWithGid to set fractions on land, using the values on coupler --- driver-moab/main/component_type_mod.F90 | 142 ++++++++++++++++++++++++ driver-moab/main/seq_frac_mct.F90 | 75 ++++++++++++- driver-moab/shr/seq_comm_mct.F90 | 1 + 3 files changed, 213 insertions(+), 5 deletions(-) diff --git a/driver-moab/main/component_type_mod.F90 b/driver-moab/main/component_type_mod.F90 index 6d222c8a1d54..e79e42a53aeb 100644 --- a/driver-moab/main/component_type_mod.F90 +++ b/driver-moab/main/component_type_mod.F90 @@ -49,6 +49,10 @@ module component_type_mod public :: component_get_suffix public :: component_get_iamin_compid +! this is to replicate mct grid of a cx + public :: expose_mct_grid_moab + + !-------------------------------------------------------------------------- ! Public data !-------------------------------------------------------------------------- @@ -262,4 +266,142 @@ subroutine check_fields(comp, comp_index) endif end subroutine check_fields + subroutine expose_mct_grid_moab (comp, imoabAPI) + use shr_mpi_mod, only: shr_mpi_commrank, shr_mpi_commsize + use shr_sys_mod + use shr_const_mod, only: SHR_CONST_PI + use seq_comm_mct, only: cplid + use seq_comm_mct, only: seq_comm_iamin + use seq_comm_mct, only: seq_comm_getinfo => seq_comm_setptrs + use iMOAB, only : iMOAB_RegisterApplication, iMOAB_CreateVertices, iMOAB_WriteMesh, & + iMOAB_DefineTagStorage, iMOAB_SetIntTagStorage, iMOAB_SetDoubleTagStorage, & + iMOAB_ResolveSharedEntities + + type(component_type), intent(in) :: comp + integer , intent(out) :: imoabAPI + + integer :: lsz + type(mct_gGrid), pointer :: dom + integer :: mpicom_CPLID ! MPI cpl communicator + integer :: iamcomp , iamcpl + integer :: ext_id + + ! local variables to fill in data + integer, dimension(:), allocatable :: vgids + ! retrieve everything we need from mct + ! number of vertices is the size of mct grid + real(r8), dimension(:), allocatable :: moab_vert_coords ! temporary + real(r8) :: latv, lonv + integer dims, i, ilat, ilon, igdx, ierr, tagindex, ixarea, ixfrac + integer tagtype, numco, ent_type + character*100 outfile, wopts, localmeshfile, tagname + character*32 appname + +!----- formats ----- + character(*),parameter :: subName = '(expose_mct_grid_moab) ' + + dims = 3 ! store as 3d mesh + + call seq_comm_getinfo(CPLID, mpicom=mpicom_CPLID) + + if (seq_comm_iamin(CPLID)) then + call shr_mpi_commrank(mpicom_CPLID, iamcpl , 'expose_mct_grid_moab') + dom => component_get_dom_cx(comp) + lsz = mct_gGrid_lsize(dom) + !print *, 'lsize: cx', lsz, ' iamcpl ' , iamcpl + appname=comp%ntype//"CPMOAB"//CHAR(0) + ! component instance + ext_id = comp%compid + 200 ! avoid reuse + ierr = iMOAB_RegisterApplication(appname, mpicom_CPLID, ext_id, imoabAPI) + if (ierr > 0 ) & + call shr_sys_abort(subname//'Error: cannot register moab app') + allocate(moab_vert_coords(lsz*dims)) + allocate(vgids(lsz)) + ilat = MCT_GGrid_indexRA(dom,'lat') + ilon = MCT_GGrid_indexRA(dom,'lon') + igdx = MCT_GGrid_indexIA(dom,'GlobGridNum') + do i = 1, lsz + latv = dom%data%rAttr(ilat, i) *SHR_CONST_PI/180. + lonv = dom%data%rAttr(ilon, i) *SHR_CONST_PI/180. + moab_vert_coords(3*i-2)=COS(latv)*COS(lonv) + moab_vert_coords(3*i-1)=COS(latv)*SIN(lonv) + moab_vert_coords(3*i )=SIN(latv) + vgids(i) = dom%data%iAttr(igdx, i) + enddo + + ierr = iMOAB_CreateVertices(imoabAPI, lsz*3, dims, moab_vert_coords) + if (ierr > 0 ) & + call shr_sys_abort(subname//'Error: fail to create MOAB vertices in land model') + + tagtype = 0 ! dense, integer + numco = 1 + tagname='GLOBAL_ID'//CHAR(0) + ierr = iMOAB_DefineTagStorage(imoabAPI, tagname, tagtype, numco, tagindex ) + if (ierr > 0 ) & + call shr_sys_abort(subname//'Error: fail to retrieve GLOBAL_ID tag ') + + ent_type = 0 ! vertex type + ierr = iMOAB_SetIntTagStorage ( imoabAPI, tagname, lsz , ent_type, vgids) + if (ierr > 0 ) & + call shr_sys_abort(subname//'Error: fail to set GLOBAL_ID tag ') + + ierr = iMOAB_ResolveSharedEntities( imoabAPI, lsz, vgids ); + if (ierr > 0 ) & + call shr_sys_abort(subname//'Error: fail to resolve shared entities') + + !there are no shared entities, but we will set a special partition tag, in order to see the + ! partitions ; it will be visible with a Pseudocolor plot in VisIt + tagname='partition'//CHAR(0) + ierr = iMOAB_DefineTagStorage(imoabAPI, tagname, tagtype, numco, tagindex ) + if (ierr > 0 ) & + call shr_sys_abort(subname//'Error: fail to create new partition tag ') + + vgids = iamcpl + ierr = iMOAB_SetIntTagStorage ( imoabAPI, tagname, lsz , ent_type, vgids) + if (ierr > 0 ) & + call shr_sys_abort(subname//'Error: fail to set partition tag ') + + ! use moab_vert_coords as a data holder for a frac tag and area tag that we will create + ! on the vertices; do not allocate other data array + ! do not be confused by this ! + ixfrac = MCT_GGrid_indexRA(dom,'frac') + ixarea = MCT_GGrid_indexRA(dom,'area') + tagname='frac'//CHAR(0) + tagtype = 1 ! dense, double + ierr = iMOAB_DefineTagStorage(imoabAPI, tagname, tagtype, numco, tagindex ) + if (ierr > 0 ) & + call shr_sys_abort(subname//'Error: fail to create frac tag ') + + do i = 1, lsz + moab_vert_coords(i) = dom%data%rAttr(ixfrac, i) + enddo + ierr = iMOAB_SetDoubleTagStorage ( imoabAPI, tagname, lsz , ent_type, moab_vert_coords) + if (ierr > 0 ) & + call shr_sys_abort(subname//'Error: fail to set frac tag ') + + tagname='area'//CHAR(0) + ierr = iMOAB_DefineTagStorage(imoabAPI, tagname, tagtype, numco, tagindex ) + if (ierr > 0 ) & + call shr_sys_abort(subname//'Error: fail to create area tag ') + do i = 1, lsz + moab_vert_coords(i) = dom%data%rAttr(ixarea, i) ! use the same doubles for second tag :) + enddo + + ierr = iMOAB_SetDoubleTagStorage ( imoabAPI, tagname, lsz , ent_type, moab_vert_coords ) + if (ierr > 0 ) & + call shr_sys_abort(subname//'Error: fail to set area tag ') + + deallocate(moab_vert_coords) + deallocate(vgids) + ! write out the mesh file to disk, in parallel + outfile = 'WHOLE_cx_'//comp%ntype//'.h5m'//CHAR(0) + wopts = 'PARALLEL=WRITE_PART'//CHAR(0) + ierr = iMOAB_WriteMesh(imoabAPI, outfile, wopts) + if (ierr > 0 ) & + call shr_sys_abort(subname//'Error: fail to write the land mesh file') + endif + + end subroutine expose_mct_grid_moab + + end module component_type_mod diff --git a/driver-moab/main/seq_frac_mct.F90 b/driver-moab/main/seq_frac_mct.F90 index fdf241672330..2a58b7b17aa4 100644 --- a/driver-moab/main/seq_frac_mct.F90 +++ b/driver-moab/main/seq_frac_mct.F90 @@ -165,8 +165,14 @@ module seq_frac_mct use iMOAB, only: iMOAB_DefineTagStorage use seq_comm_mct, only : mphaxid ! iMOAB app id for phys atm, on cpl pes use seq_comm_mct, only : mblxid ! iMOAB app id for lnd on cpl pes + use seq_comm_mct, only : mblx2id ! iMOAB id for land mesh instanced from MCT on coupler pes use seq_comm_mct, only : mboxid ! iMOAB app id for ocn on cpl pes use seq_comm_mct, only : mbixid ! iMOAB for sea-ice migrated to coupler + use seq_comm_mct, only : atm_pg_active ! flag if PG mesh instanced + ! for tri grid, sameg_al would be false + use seq_comm_mct, only : sameg_al ! same grid atm and land; used throughout, initialized in lnd_init + use iMOAB, only : iMOAB_DefineTagStorage, iMOAB_SetDoubleTagStorage, & + iMOAB_GetMeshInfo, iMOAB_SetDoubleTagStorageWithGid use shr_kind_mod, only: CL => SHR_KIND_CL, CX => SHR_KIND_CX, CXX => SHR_KIND_CXX use iso_c_binding ! C_NULL_CHAR @@ -301,8 +307,13 @@ subroutine seq_frac_init( infodata, & character(*),parameter :: fraclist_z = 'afrac:lfrac' ! moab - integer :: tagtype, numco, tagindex, ierr + integer :: tagtype, numco, tagindex, ent_type, ierr, arrSize character(CXX) :: tagname + real(r8), allocatable :: tagValues(:) ! used for setting some default tags + integer , allocatable :: GlobalIds(:) ! used for setting values associated with ids + integer nvert(3), nvise(3), nbl(3), nsurf(3), nvisBC(3) + integer kgg ! index in global number attribute, used for global id in MOAB + !----- formats ----- character(*),parameter :: subName = '(seq_frac_init) ' @@ -345,7 +356,7 @@ subroutine seq_frac_init( infodata, & ! Initialize fractions on atm coupler mesh; on migrated ph atm to coupler if (mphaxid .ge. 0 ) then ! // - tagname = trim(fraclist_a)//C_NULL_CHAR + tagname = trim(fraclist_a)//C_NULL_CHAR ! 'afrac:ifrac:ofrac:lfrac:lfrin' tagtype = 1 ! dense, double numco = 1 ! ierr = iMOAB_DefineTagStorage(mphaxid, tagname, tagtype, numco, tagindex ) @@ -353,7 +364,29 @@ subroutine seq_frac_init( infodata, & write(logunit,*) subname,' error in defining tags on atm phys mesh on cpl ' call shr_sys_abort(subname//' ERROR in defining tags on atm phys mesh on cpl') endif + ! find out the number of local elements in moab mesh + ierr = iMOAB_GetMeshInfo ( mphaxid, nvert, nvise, nbl, nsurf, nvisBC ); + ! we should set to 1 the 'afrac' tag + arrSize = nvert(1) * 5 ! there are 5 tags that need to be zeroed out + allocate(tagValues(arrSize) ) + ent_type = 0 ! vertex type + if (atm_pg_active) ent_type = 1 ! cells type then + tagValues = 0 + ierr = iMOAB_SetDoubleTagStorage ( mphaxid, tagname, arrSize , ent_type, tagValues) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in zeroing out fracs ' + call shr_sys_abort(subname//' ERROR in zeroing out fracs on phys atm') + endif + + tagname = 'afrac'//C_NULL_CHAR + tagValues = 1 + ierr = iMOAB_SetDoubleTagStorage ( mphaxid, tagname, nvert(1) , ent_type, tagValues) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in setting afrac tag on phys atm ' + call shr_sys_abort(subname//' ERROR in setting afrac tag on phys atm') + endif + deallocate(tagValues) endif endif @@ -375,8 +408,8 @@ subroutine seq_frac_init( infodata, & lSize = mct_aVect_lSize(dom_l%data) call mct_aVect_init(fractions_l,rList=fraclist_l,lsize=lsize) call mct_aVect_zero(fractions_l) - if (mphaxid .ge. 0 ) then ! // - tagname = trim(fraclist_l)//C_NULL_CHAR + if (mblxid .ge. 0 ) then ! // + tagname = trim(fraclist_l)//C_NULL_CHAR ! 'afrac:lfrac:lfrin' tagtype = 1 ! dense, double numco = 1 ! ierr = iMOAB_DefineTagStorage(mblxid, tagname, tagtype, numco, tagindex ) @@ -384,11 +417,43 @@ subroutine seq_frac_init( infodata, & write(logunit,*) subname,' error in defining tags on lnd phys mesh on cpl ' call shr_sys_abort(subname//' ERROR in defining tags on lnd phys mesh on cpl') endif + ierr = iMOAB_GetMeshInfo ( mblxid, nvert, nvise, nbl, nsurf, nvisBC ); + arrSize = 3 * nVert(1) + allocate(tagValues(arrSize) ) + ent_type = 1 ! cell type, tri-grid case + tagValues = 0 + if (sameg_al) ent_type = 0 ! vertex type, land on atm grid + ierr = iMOAB_SetDoubleTagStorage ( mblxid, tagname, arrSize , ent_type, tagValues) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in setting fractions tags on lnd ' + call shr_sys_abort(subname//' ERROR in setting fractions tags on lnd') + endif + deallocate(tagValues) endif + ! mblx2id is the id for moab app exposing land cpl + call expose_mct_grid_moab(lnd, mblx2id) + + kk = mct_aVect_indexRA(fractions_l,"lfrin",perrWith=subName) kf = mct_aVect_indexRA(dom_l%data ,"frac" ,perrWith=subName) fractions_l%rAttr(kk,:) = dom_l%data%rAttr(kf,:) -! we should set the lfrin tag to fractions_l%rAttr(kk,:) (from input ?) + if (mblxid .ge. 0 ) then ! // + tagname = 'lfrin'//C_NULL_CHAR ! 'lfrin' + allocate(tagValues(lSize) ) + tagValues = dom_l%data%rAttr(kf,:) + kgg = mct_aVect_indexIA(dom_l%data ,"GlobGridNum" ,perrWith=subName) + allocate(GlobalIds(lSize)) + GlobalIds = dom_l%data%iAttr(kgg,:) + + ierr = iMOAB_SetDoubleTagStorageWithGid ( mblxid, tagname, lSize , ent_type, tagValues, GlobalIds ) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in setting lfrin on lnd ' + call shr_sys_abort(subname//' ERROR in setting lfrin on lnd') + endif + deallocate(GlobalIds) + deallocate(tagValues) + endif + if (atm_present) then mapper_l2a => prep_atm_get_mapper_Fl2a() mapper_a2l => prep_lnd_get_mapper_Fa2l() diff --git a/driver-moab/shr/seq_comm_mct.F90 b/driver-moab/shr/seq_comm_mct.F90 index e7af8bb85e65..42ba12acea5e 100644 --- a/driver-moab/shr/seq_comm_mct.F90 +++ b/driver-moab/shr/seq_comm_mct.F90 @@ -223,6 +223,7 @@ module seq_comm_mct integer, public :: mboxid ! iMOAB id for mpas ocean migrated mesh to coupler pes integer, public :: mbintxao ! iMOAB id for intx mesh between ocean and atmosphere integer, public :: mblxid ! iMOAB id for land mesh migrated to coupler pes + integer, public :: mblx2id ! iMOAB id for land mesh instanced from MCT on coupler pes logical, public :: sameg_al ! same grid atm and land; used throughout, initialized in lnd_init integer, public :: mbintxla ! iMOAB id for intx mesh between land and atmosphere integer, public :: mpsiid ! iMOAB id for sea-ice, mpas model From 91eae2cf36f35be2347549e0622fb66794912765 Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Tue, 21 Jun 2022 21:00:42 -0500 Subject: [PATCH 159/467] write the land file with fracs set --- driver-moab/main/seq_frac_mct.F90 | 16 +++++++++++++++- 1 file changed, 15 insertions(+), 1 deletion(-) diff --git a/driver-moab/main/seq_frac_mct.F90 b/driver-moab/main/seq_frac_mct.F90 index 2a58b7b17aa4..aaf318ddb48a 100644 --- a/driver-moab/main/seq_frac_mct.F90 +++ b/driver-moab/main/seq_frac_mct.F90 @@ -172,7 +172,7 @@ module seq_frac_mct ! for tri grid, sameg_al would be false use seq_comm_mct, only : sameg_al ! same grid atm and land; used throughout, initialized in lnd_init use iMOAB, only : iMOAB_DefineTagStorage, iMOAB_SetDoubleTagStorage, & - iMOAB_GetMeshInfo, iMOAB_SetDoubleTagStorageWithGid + iMOAB_GetMeshInfo, iMOAB_SetDoubleTagStorageWithGid, iMOAB_WriteMesh use shr_kind_mod, only: CL => SHR_KIND_CL, CX => SHR_KIND_CX, CXX => SHR_KIND_CXX use iso_c_binding ! C_NULL_CHAR @@ -313,6 +313,7 @@ subroutine seq_frac_init( infodata, & integer , allocatable :: GlobalIds(:) ! used for setting values associated with ids integer nvert(3), nvise(3), nbl(3), nsurf(3), nvisBC(3) integer kgg ! index in global number attribute, used for global id in MOAB + character(30) :: outfile, wopts !----- formats ----- character(*),parameter :: subName = '(seq_frac_init) ' @@ -452,6 +453,19 @@ subroutine seq_frac_init( infodata, & endif deallocate(GlobalIds) deallocate(tagValues) + +#ifdef MOABDEBUG + ! debug test + + outfile = 'lndCplFr.h5m'//C_NULL_CHAR + wopts = ';PARALLEL=WRITE_PART'//C_NULL_CHAR + ! write out the mesh file to disk + ierr = iMOAB_WriteMesh(mblxid, trim(outfile), trim(wopts)) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in writing mesh ' + call shr_sys_abort(subname//' ERROR in writing mesh ') + endif +#endif endif if (atm_present) then From a5759ad2762f8c8f69e1fbe98f95b2b85300a97a Mon Sep 17 00:00:00 2001 From: Robert Jacob Date: Fri, 15 Jul 2022 13:53:40 -0500 Subject: [PATCH 160/467] Define flux tags on ocean moab mesh Define flux tags on ocean moab mesh and remove two fraction arguments not used. --- driver-moab/main/cime_comp_mod.F90 | 2 +- driver-moab/main/prep_aoflux_mod.F90 | 28 ++++++++++++++++++++++++---- 2 files changed, 25 insertions(+), 5 deletions(-) diff --git a/driver-moab/main/cime_comp_mod.F90 b/driver-moab/main/cime_comp_mod.F90 index 2cb0c8ae1512..764e09b06cb8 100644 --- a/driver-moab/main/cime_comp_mod.F90 +++ b/driver-moab/main/cime_comp_mod.F90 @@ -2166,7 +2166,7 @@ subroutine cime_init() !---------------------------------------------------------- if (iamin_CPLID) then - call prep_aoflux_init(infodata, fractions_ox, fractions_ax) + call prep_aoflux_init(infodata) endif !---------------------------------------------------------- diff --git a/driver-moab/main/prep_aoflux_mod.F90 b/driver-moab/main/prep_aoflux_mod.F90 index af44a7ae707b..f58ed4602cdd 100644 --- a/driver-moab/main/prep_aoflux_mod.F90 +++ b/driver-moab/main/prep_aoflux_mod.F90 @@ -3,9 +3,11 @@ module prep_aoflux_mod use shr_kind_mod, only: r8 => SHR_KIND_R8 use shr_kind_mod, only: cs => SHR_KIND_CS use shr_kind_mod, only: cl => SHR_KIND_CL + use shr_kind_mod, only: CXX => SHR_KIND_CXX use shr_sys_mod, only: shr_sys_abort, shr_sys_flush use seq_comm_mct, only: num_inst_xao, num_inst_frc, num_inst_ocn use seq_comm_mct, only: CPLID, logunit + use seq_comm_mct, only : mboxid ! iMOAB app id for ocn on cpl pes use seq_comm_mct, only: seq_comm_getData=>seq_comm_setptrs use seq_infodata_mod, only: seq_infodata_getdata, seq_infodata_type use seq_map_type_mod @@ -17,6 +19,9 @@ module prep_aoflux_mod use component_type_mod, only: component_get_x2c_cx, component_get_c2x_cx use component_type_mod, only: atm, ocn + use iso_c_binding + + implicit none private ! except save @@ -52,22 +57,24 @@ module prep_aoflux_mod !================================================================================================ - subroutine prep_aoflux_init (infodata, fractions_ox, fractions_ax) + subroutine prep_aoflux_init (infodata) !--------------------------------------------------------------- ! Description ! Initialize atm/ocn flux component and compute ocean albedos ! module variables ! + use iMOAB, only : iMOAB_DefineTagStorage ! Arguments type (seq_infodata_type) , intent(inout) :: infodata - type(mct_aVect) , intent(in) :: fractions_ox(:) - type(mct_aVect) , intent(in) :: fractions_ax(:) ! ! Local Variables - integer :: exi + integer :: exi,ierr integer :: lsize_o integer :: lsize_a + integer :: tagtype, numco, tagindex + character(CXX) :: tagname + character(CS) :: aoflux_grid ! grid for atm ocn flux calc type(mct_avect) , pointer :: a2x_ax type(mct_avect) , pointer :: o2x_ox @@ -105,6 +112,19 @@ subroutine prep_aoflux_init (infodata, fractions_ox, fractions_ax) call mct_aVect_zero(xao_ox(exi)) enddo +! define flux tags on the moab ocean mesh + if (mboxid .ge. 0 ) then ! // + tagname = trim(seq_flds_xao_fields)//C_NULL_CHAR + tagtype = 1 ! dense, double + numco = 1 + ierr = iMOAB_DefineTagStorage(mboxid, tagname, tagtype, numco, tagindex ) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in defining tags on ocn phys mesh on cpl ' + call shr_sys_abort(subname//' ERROR in defining tags on ocn phys mesh on cpl') + endif + endif + + end subroutine prep_aoflux_init !================================================================================================ From 5de13177c2c78bc3cf7eed4fd4cfd8017548b924 Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Mon, 1 Aug 2022 08:43:20 -0500 Subject: [PATCH 161/467] zero out the xao fields --- driver-moab/main/prep_aoflux_mod.F90 | 30 ++++++++++++++++++++++++++-- driver-moab/shr/seq_flds_mod.F90 | 1 + 2 files changed, 29 insertions(+), 2 deletions(-) diff --git a/driver-moab/main/prep_aoflux_mod.F90 b/driver-moab/main/prep_aoflux_mod.F90 index f58ed4602cdd..648ac1f26145 100644 --- a/driver-moab/main/prep_aoflux_mod.F90 +++ b/driver-moab/main/prep_aoflux_mod.F90 @@ -19,6 +19,9 @@ module prep_aoflux_mod use component_type_mod, only: component_get_x2c_cx, component_get_c2x_cx use component_type_mod, only: atm, ocn + ! use m_List ,only: mct_list_nitem => nitem + ! use mct_mod ! for mct_list_nitem + use iso_c_binding @@ -64,7 +67,7 @@ subroutine prep_aoflux_init (infodata) ! Initialize atm/ocn flux component and compute ocean albedos ! module variables ! - use iMOAB, only : iMOAB_DefineTagStorage + use iMOAB, only : iMOAB_DefineTagStorage, iMOAB_SetDoubleTagStorage ! Arguments type (seq_infodata_type) , intent(inout) :: infodata ! @@ -72,8 +75,12 @@ subroutine prep_aoflux_init (infodata) integer :: exi,ierr integer :: lsize_o integer :: lsize_a - integer :: tagtype, numco, tagindex + integer :: tagtype, numco, tagindex, ent_type character(CXX) :: tagname + integer :: size_list ! for number of tags + real(r8), allocatable :: tagValues(:) ! used for setting some default tags + integer :: arrSize ! for the size of tagValues + type(mct_list) :: temp_list ! used to count the number of strings / fields character(CS) :: aoflux_grid ! grid for atm ocn flux calc type(mct_avect) , pointer :: a2x_ax @@ -122,6 +129,25 @@ subroutine prep_aoflux_init (infodata) write(logunit,*) subname,' error in defining tags on ocn phys mesh on cpl ' call shr_sys_abort(subname//' ERROR in defining tags on ocn phys mesh on cpl') endif + ! make it zero + ! first form a list + call mct_list_init(temp_list ,seq_flds_xao_fields) + size_list=mct_list_nitem (temp_list) + call mct_list_clean(temp_list) + ! find out the number of local elements in moab mesh + ! ierr = iMOAB_GetMeshInfo ( mboxid, nvert, nvise, nbl, nsurf, nvisBC ); should be lsize_o + + ! we should set to 1 the 'afrac' tag + arrSize = lsize_o * size_list ! there are size_list tags that need to be zeroed out + allocate(tagValues(arrSize) ) + ent_type = 0 ! vertex type + tagValues = 0 + ierr = iMOAB_SetDoubleTagStorage ( mboxid, tagname, arrSize , ent_type, tagValues) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in zeroing out xao_fields ' + call shr_sys_abort(subname//' ERROR in zeroing out xao_fields in init ') + endif + endif diff --git a/driver-moab/shr/seq_flds_mod.F90 b/driver-moab/shr/seq_flds_mod.F90 index 605b2fbe299d..59f70e45b150 100644 --- a/driver-moab/shr/seq_flds_mod.F90 +++ b/driver-moab/shr/seq_flds_mod.F90 @@ -3683,6 +3683,7 @@ subroutine seq_flds_set(nmlfile, ID, infodata) write(logunit,*) subname//': seq_flds_a2x_ext_states= ',trim(seq_flds_a2x_ext_states) write(logunit,*) subname//': seq_flds_a2x_ext_fluxes= ',trim(seq_flds_a2x_ext_fluxes) write(logunit,*) subname//': seq_flds_a2x_ext_fields= ',trim(seq_flds_a2x_ext_fields) + write(logunit,*) subname//': seq_flds_xao_fields= ',trim(seq_flds_xao_fields) endif From 85bf7372045cfc982db84c3ff6694f78cf9c98e4 Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Mon, 1 Aug 2022 15:10:18 -0500 Subject: [PATCH 162/467] local size can be different zero out according to MOAB sizes --- driver-moab/main/prep_aoflux_mod.F90 | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/driver-moab/main/prep_aoflux_mod.F90 b/driver-moab/main/prep_aoflux_mod.F90 index 648ac1f26145..52694e35190c 100644 --- a/driver-moab/main/prep_aoflux_mod.F90 +++ b/driver-moab/main/prep_aoflux_mod.F90 @@ -67,7 +67,7 @@ subroutine prep_aoflux_init (infodata) ! Initialize atm/ocn flux component and compute ocean albedos ! module variables ! - use iMOAB, only : iMOAB_DefineTagStorage, iMOAB_SetDoubleTagStorage + use iMOAB, only : iMOAB_DefineTagStorage, iMOAB_SetDoubleTagStorage, iMOAB_GetMeshInfo ! Arguments type (seq_infodata_type) , intent(inout) :: infodata ! @@ -81,6 +81,7 @@ subroutine prep_aoflux_init (infodata) real(r8), allocatable :: tagValues(:) ! used for setting some default tags integer :: arrSize ! for the size of tagValues type(mct_list) :: temp_list ! used to count the number of strings / fields + integer nvert(3), nvise(3), nbl(3), nsurf(3), nvisBC(3) ! used to find out the size of local mesh, in moab character(CS) :: aoflux_grid ! grid for atm ocn flux calc type(mct_avect) , pointer :: a2x_ax @@ -135,10 +136,9 @@ subroutine prep_aoflux_init (infodata) size_list=mct_list_nitem (temp_list) call mct_list_clean(temp_list) ! find out the number of local elements in moab mesh - ! ierr = iMOAB_GetMeshInfo ( mboxid, nvert, nvise, nbl, nsurf, nvisBC ); should be lsize_o - - ! we should set to 1 the 'afrac' tag - arrSize = lsize_o * size_list ! there are size_list tags that need to be zeroed out + ierr = iMOAB_GetMeshInfo ( mboxid, nvert, nvise, nbl, nsurf, nvisBC ); ! could be different of lsize_o + ! local size of vertices is different from lsize_o + arrSize = nvert(1) * size_list ! there are size_list tags that need to be zeroed out allocate(tagValues(arrSize) ) ent_type = 0 ! vertex type tagValues = 0 From b6c317a66bb5877c7d5d7a7dcdb28811d987bebc Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Wed, 3 Aug 2022 15:38:38 -0500 Subject: [PATCH 163/467] pass flux data to moab structures --- driver-moab/main/cime_comp_mod.F90 | 4 ++ driver-moab/main/prep_aoflux_mod.F90 | 54 +++++++++++++++++- driver-moab/main/seq_flux_mct.F90 | 82 ++++++++++++++++++++++++++++ 3 files changed, 138 insertions(+), 2 deletions(-) diff --git a/driver-moab/main/cime_comp_mod.F90 b/driver-moab/main/cime_comp_mod.F90 index 764e09b06cb8..35b2fe3bad4c 100644 --- a/driver-moab/main/cime_comp_mod.F90 +++ b/driver-moab/main/cime_comp_mod.F90 @@ -132,6 +132,8 @@ module cime_comp_mod use seq_flux_mct, only: seq_flux_init_mct, seq_flux_initexch_mct, seq_flux_ocnalb_mct use seq_flux_mct, only: seq_flux_atmocn_mct, seq_flux_atmocnexch_mct, seq_flux_readnl_mct + use seq_flux_mct, only: seq_flux_atmocn_moab ! will set the ao fluxes on atm or ocn coupler mesh + ! domain fraction routines use seq_frac_mct, only : seq_frac_init, seq_frac_set @@ -3921,6 +3923,7 @@ subroutine cime_run_atmocn_fluxes(hashint) o2x_ax => prep_atm_get_o2x_ax() ! array over all instances xao_ax => prep_aoflux_get_xao_ax() ! array over all instances call seq_flux_atmocn_mct(infodata, tod, dtime, a2x_ax, o2x_ax(eoi), xao_ax(exi)) + !call seq_flux_atmocn_moab( atm(eai), xao_ax(exi) ) ! should be only one ensemble probably enddo call t_drvstopf ('CPL:atmocna_fluxa',hashint=hashint(6)) @@ -3940,6 +3943,7 @@ subroutine cime_run_atmocn_fluxes(hashint) o2x_ox => component_get_c2x_cx(ocn(eoi)) xao_ox => prep_aoflux_get_xao_ox() call seq_flux_atmocn_mct(infodata, tod, dtime, a2x_ox(eai), o2x_ox, xao_ox(exi)) + call seq_flux_atmocn_moab( ocn(eoi), xao_ox(exi) ) enddo call t_drvstopf ('CPL:atmocnp_fluxo',hashint=hashint(6)) endif ! aoflux_grid diff --git a/driver-moab/main/prep_aoflux_mod.F90 b/driver-moab/main/prep_aoflux_mod.F90 index 52694e35190c..319eddba8f18 100644 --- a/driver-moab/main/prep_aoflux_mod.F90 +++ b/driver-moab/main/prep_aoflux_mod.F90 @@ -8,6 +8,7 @@ module prep_aoflux_mod use seq_comm_mct, only: num_inst_xao, num_inst_frc, num_inst_ocn use seq_comm_mct, only: CPLID, logunit use seq_comm_mct, only : mboxid ! iMOAB app id for ocn on cpl pes + use seq_comm_mct, only : mphaxid ! iMOAB app id for atm phys grid on cpl pes use seq_comm_mct, only: seq_comm_getData=>seq_comm_setptrs use seq_infodata_mod, only: seq_infodata_getdata, seq_infodata_type use seq_map_type_mod @@ -41,6 +42,9 @@ module prep_aoflux_mod public :: prep_aoflux_get_xao_ox public :: prep_aoflux_get_xao_ax + public :: prep_aoflux_get_xao_omct + public :: prep_aoflux_get_xao_amct + !-------------------------------------------------------------------------- ! Private data !-------------------------------------------------------------------------- @@ -49,6 +53,12 @@ module prep_aoflux_mod type(mct_aVect), pointer :: xao_ox(:) ! Atm-ocn fluxes, ocn grid, cpl pes type(mct_aVect), pointer :: xao_ax(:) ! Atm-ocn fluxes, atm grid, cpl pes + ! allocate xao_omct, but use lsize_o, size of the local mct ocn gsmap (and AVs) + real(r8) , private, pointer :: xao_omct(:,:) ! atm-ocn fluxes, ocn grid, mct local sizes + real(r8) , private, pointer :: xao_omoab(:,:) ! atm-ocn fluxes, ocn grid, moab local sizes + + real(r8) , private, pointer :: xao_amct(:,:) ! atm-ocn fluxes, atm grid, mct local sizes + ! seq_comm_getData variables logical :: iamroot_CPLID ! .true. => CPLID masterproc integer :: mpicom_CPLID ! MPI cpl communicator @@ -140,16 +150,46 @@ subroutine prep_aoflux_init (infodata) ! local size of vertices is different from lsize_o arrSize = nvert(1) * size_list ! there are size_list tags that need to be zeroed out allocate(tagValues(arrSize) ) - ent_type = 0 ! vertex type + ent_type = 1 ! cell type tagValues = 0 ierr = iMOAB_SetDoubleTagStorage ( mboxid, tagname, arrSize , ent_type, tagValues) if (ierr .ne. 0) then write(logunit,*) subname,' error in zeroing out xao_fields ' call shr_sys_abort(subname//' ERROR in zeroing out xao_fields in init ') endif - + allocate(xao_omct(lsize_o, size_list)) ! the transpose of xao_ox(size_list, lsize_o) + deallocate(tagValues) endif +! define atm-ocn flux tags on the moab atm mesh + if (mphaxid .ge. 0 ) then ! // + tagname = trim(seq_flds_xao_fields)//C_NULL_CHAR + tagtype = 1 ! dense, double + numco = 1 + ierr = iMOAB_DefineTagStorage(mphaxid, tagname, tagtype, numco, tagindex ) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in defining tags on atm phys mesh on cpl ' + call shr_sys_abort(subname//' ERROR in defining tags on atm phys mesh on cpl') + endif + ! make it zero + ! first form a list + call mct_list_init(temp_list ,seq_flds_xao_fields) + size_list=mct_list_nitem (temp_list) + call mct_list_clean(temp_list) + ! find out the number of local elements in moab mesh + ierr = iMOAB_GetMeshInfo ( mphaxid, nvert, nvise, nbl, nsurf, nvisBC ); ! could be different of lsize_o + ! local size of vertices is different from lsize_o + arrSize = nvert(1) * size_list ! there are size_list tags that need to be zeroed out + allocate(tagValues(arrSize) ) + ent_type = 0 ! vertex type + tagValues = 0 + ierr = iMOAB_SetDoubleTagStorage ( mphaxid, tagname, arrSize , ent_type, tagValues) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in zeroing out xao_fields ' + call shr_sys_abort(subname//' ERROR in zeroing out xao_fields in init ') + endif + allocate(xao_amct(lsize_a, size_list)) ! the transpose of xao_ax(size_list, lsize_a) + endif end subroutine prep_aoflux_init @@ -256,4 +296,14 @@ function prep_aoflux_get_xao_ax() prep_aoflux_get_xao_ax => xao_ax(:) end function prep_aoflux_get_xao_ax + function prep_aoflux_get_xao_omct() + real(r8), pointer :: prep_aoflux_get_xao_omct(:,:) + prep_aoflux_get_xao_omct => xao_omct + end function prep_aoflux_get_xao_omct + + function prep_aoflux_get_xao_amct() + real(r8), pointer :: prep_aoflux_get_xao_amct(:,:) + prep_aoflux_get_xao_amct => xao_amct + end function prep_aoflux_get_xao_amct + end module prep_aoflux_mod diff --git a/driver-moab/main/seq_flux_mct.F90 b/driver-moab/main/seq_flux_mct.F90 index 499c34a3ab02..64e9cbe0945c 100644 --- a/driver-moab/main/seq_flux_mct.F90 +++ b/driver-moab/main/seq_flux_mct.F90 @@ -6,12 +6,22 @@ module seq_flux_mct use shr_orb_mod, only: shr_orb_params, shr_orb_cosz, shr_orb_decl use shr_mct_mod, only: shr_mct_queryConfigFile, shr_mct_sMatReaddnc + use seq_comm_mct, only : mboxid ! iMOAB app id for ocn on cpl pes + use seq_comm_mct, only : mphaxid ! iMOAB app id for atm phys grid on cpl pes + + use prep_aoflux_mod, only: prep_aoflux_get_xao_omct, prep_aoflux_get_xao_amct + + use iMOAB, only : iMOAB_SetDoubleTagStorageWithGid, iMOAB_WriteMesh + use seq_comm_mct, only : num_moab_exports ! for debugging + use mct_mod use seq_flds_mod use seq_comm_mct use seq_infodata_mod use component_type_mod + + use iso_c_binding implicit none private @@ -28,6 +38,8 @@ module seq_flux_mct public seq_flux_ocnalb_mct public seq_flux_atmocn_mct + public seq_flux_atmocn_moab + public seq_flux_atmocnexch_mct !-------------------------------------------------------------------------- @@ -1587,8 +1599,78 @@ subroutine seq_flux_atmocn_mct(infodata, tod, dt, a2x, o2x, xao) end if enddo + ! transpose xao to xao_omct, to end subroutine seq_flux_atmocn_mct + subroutine seq_flux_atmocn_moab(comp, xao) + type(component_type), intent(inout) :: comp + type(mct_aVect) , intent(inout) :: xao + + real(r8) , pointer :: local_xao_mct(:,:) ! atm-ocn fluxes, transpose, mct local sizes + integer appId ! moab app id + integer i,j + integer nloc, listSize, kgg + + type(mct_ggrid), pointer :: dom + + ! moab + integer :: tagtype, numco, tagindex, ent_type, ierr, arrSize + character(CXX) :: tagname + integer , allocatable :: GlobalIds(:) ! used for setting values associated with ids + character*100 outfile, wopts, lnum + + + character(*),parameter :: subName = '(seq_flux_atmocn_moab) ' + + + if (comp%oneletterid == 'a' ) then + appId = mphaxid ! ocn on coupler + local_xao_mct => prep_aoflux_get_xao_amct() + else if (comp%oneletterid == 'o') then + appId = mboxid ! atm phys + local_xao_mct => prep_aoflux_get_xao_omct() + else + call mct_die(subName,'call for either ocean or atm',1) + endif + ! transpose into moab double array, then set with global id + nloc = mct_avect_lsize(xao) + listSize = mct_aVect_nRAttr(xao) + dom => component_get_dom_cx(comp) + kgg = mct_aVect_indexIA(dom%data ,"GlobGridNum" ,perrWith=subName) + + allocate(GlobalIds(nloc)) + GlobalIds = dom%data%iAttr(kgg,:) + + do i = 1, nloc + do j = 1, listSize + local_xao_mct(i, j) = xao%rAttr(j, i) + enddo + enddo + tagname = trim(seq_flds_xao_fields)//C_NULL_CHAR + arrSize = nloc * listSize + ent_type = 1 ! cells + ierr = iMOAB_SetDoubleTagStorageWithGid ( appId, tagname, arrSize , ent_type, local_xao_mct, GlobalIds ) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in setting atm-ocn fluxes ' + call shr_sys_abort(subname//' ERROR in setting atm-ocn fluxes') + endif + deallocate(GlobalIds) + +#ifdef MOABDEBUG + ! debug out file + write(lnum,"(I0.2)")num_moab_exports + outfile = comp%oneletterid//'_flux_'//trim(lnum)//'.h5m'//C_NULL_CHAR + wopts = 'PARALLEL=WRITE_PART'//C_NULL_CHAR + ierr = iMOAB_WriteMesh(appId, outfile, wopts) + + if (ierr .ne. 0) then + write(logunit,*) subname,' error in writing mesh ' + call shr_sys_abort(subname//' ERROR in writing mesh ') + endif +#endif + + + end subroutine seq_flux_atmocn_moab !=============================================================================== end module seq_flux_mct From 18e20bb09b9f42bf50d9b09abfb9bc33a3898221 Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Thu, 11 Aug 2022 18:02:54 -0500 Subject: [PATCH 164/467] send ocean fields to coupler --- driver-moab/main/cime_comp_mod.F90 | 5 +++ driver-moab/main/component_mod.F90 | 65 ++++++++++++++++++++++++++++++ 2 files changed, 70 insertions(+) diff --git a/driver-moab/main/cime_comp_mod.F90 b/driver-moab/main/cime_comp_mod.F90 index 35b2fe3bad4c..0eec97a171bf 100644 --- a/driver-moab/main/cime_comp_mod.F90 +++ b/driver-moab/main/cime_comp_mod.F90 @@ -170,6 +170,9 @@ module cime_comp_mod use component_mod, only: component_init_areacor, component_init_aream use component_mod, only: component_exch, component_diag +! used to send from components to coupler instances + use component_mod, only: ocn_cpl_moab + ! prep routines (includes mapping routines between components and merging routines) use prep_lnd_mod use prep_ice_mod @@ -4143,6 +4146,8 @@ subroutine cime_run_ocn_recv_post() mpicom_barrier=mpicom_CPLALLOCNID, run_barriers=run_barriers, & timer_barrier='CPL:O2CT_BARRIER', timer_comp_exch='CPL:O2CT', & timer_map_exch='CPL:o2c_ocno2ocnx', timer_infodata_exch='CPL:o2c_infoexch') + ! send from ocn pes to coupler + call ocn_cpl_moab(ocn) endif !---------------------------------------------------------- diff --git a/driver-moab/main/component_mod.F90 b/driver-moab/main/component_mod.F90 index e8104e59560f..cc92c11e7aab 100644 --- a/driver-moab/main/component_mod.F90 +++ b/driver-moab/main/component_mod.F90 @@ -53,6 +53,8 @@ module component_mod public :: component_exch public :: component_diag + public :: ocn_cpl_moab + !-------------------------------------------------------------------------- ! Private data @@ -964,4 +966,67 @@ subroutine component_diag(infodata, comp, flow, comment, info_debug, timer_diag end subroutine component_diag + subroutine ocn_cpl_moab(ocn) + + use seq_comm_mct , only : mboxid, mpoid ! + use seq_flds_mod , only : seq_flds_o2x_fields + use iMOAB , only: iMOAB_SendElementTag, iMOAB_ReceiveElementTag, iMOAB_WriteMesh, iMOAB_FreeSenderBuffers + use seq_comm_mct, only : num_moab_exports ! for debugging + use ISO_C_BINDING, only : C_NULL_CHAR + !--------------------------------------------------------------- + ! Description + ! send tags from ocean component to coupler instance + ! + ! it involves initial ocn app; mpoid; also migrated ocn mesh mesh on coupler pes, mboxid + ! the sending of tags from ocn pes to coupler pes will use initial graph/migrate + + type(component_type) , intent(in) :: ocn(:) + + integer :: id_join, ocnid1, context_id , ierr + integer :: mpicom_join + character(400) :: tagname + character*100 outfile, wopts, lnum + + ! how to get mpicomm for joint ocn + coupler + id_join = ocn(1)%cplcompid + ocnid1 = ocn(1)%compid + call seq_comm_getinfo(ID_join,mpicom=mpicom_join) + context_id = -1 +! + tagName = trim(seq_flds_o2x_fields)//C_NULL_CHAR + + if (mpoid .ge. 0) then ! send because we are on ocn pes + + ! basically, use the initial partitioning + context_id = id_join + ierr = iMOAB_SendElementTag(mpoid, tagName, mpicom_join, context_id) + + endif + if ( mboxid .ge. 0 ) then ! we are on coupler pes, for sure +! receive on couper pes, + context_id = ocnid1 + ierr = iMOAB_ReceiveElementTag(mboxid, tagName, mpicom_join, context_id) +! !CHECKRC(ierr, "cannot receive tag values") + endif + +! ! we can now free the sender buffers + if (mpoid .ge. 0) then + context_id = id_join + ierr = iMOAB_FreeSenderBuffers(mpoid, context_id) +! ! CHECKRC(ierr, "cannot free buffers used to send projected tag towards the ocean mesh") + endif + +#ifdef MOABDEBUG + if (mboxid .ge. 0 ) then ! we are on coupler pes, for sure + ! number_proj = number_proj+1 ! count the number of projections + write(lnum,"(I0.2)") num_moab_exports + outfile = 'ocnCpl_'//trim(lnum)//'.h5m'//C_NULL_CHAR + wopts = ';PARALLEL=WRITE_PART'//C_NULL_CHAR ! + ierr = iMOAB_WriteMesh(mpoid, trim(outfile), trim(wopts)) + + !CHECKRC(ierr, "cannot receive tag values") + endif +#endif + + end subroutine ocn_cpl_moab end module component_mod From 8a9f11380d84e1ab1cd323b66426a321adc040ca Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Fri, 12 Aug 2022 17:06:59 -0500 Subject: [PATCH 165/467] need to define o2x fields on coupler side too --- driver-moab/main/cplcomp_exchange_mod.F90 | 7 +++++++ 1 file changed, 7 insertions(+) diff --git a/driver-moab/main/cplcomp_exchange_mod.F90 b/driver-moab/main/cplcomp_exchange_mod.F90 index ff0f351c4772..28d519d18b03 100644 --- a/driver-moab/main/cplcomp_exchange_mod.F90 +++ b/driver-moab/main/cplcomp_exchange_mod.F90 @@ -10,6 +10,7 @@ module cplcomp_exchange_mod use component_type_mod use seq_flds_mod, only: seq_flds_dom_coord, seq_flds_dom_other use seq_flds_mod, only: seq_flds_a2x_ext_fields ! + use seq_flds_mod, only: seq_flds_o2x_fields ! needed for MOAB init of ocean fields o2x to be able to transfer to coupler use seq_comm_mct, only: cplid, logunit use seq_comm_mct, only: seq_comm_getinfo => seq_comm_setptrs, seq_comm_iamin use seq_diag_mct @@ -1265,6 +1266,12 @@ subroutine cplcomp_moab_Init(comp) write(logunit,*) subname,' error in defining tags on ocean coupler ' call shr_sys_abort(subname//' ERROR in defining tags on ocean coupler ') endif + tagname = trim(seq_flds_o2x_fields)//C_NULL_CHAR + ierr = iMOAB_DefineTagStorage(mboxid, tagname, tagtype, numco, tagindex ) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in defining tags o2x on coupler' + call shr_sys_abort(subname//' ERROR in defining tags o2x on coupler ') + endif #ifdef MOABDEBUG ! debug test outfile = 'recMeshOcn.h5m'//C_NULL_CHAR From 6b66274c6678cee59048168ace06b0d3a655c189 Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Fri, 12 Aug 2022 22:00:04 -0500 Subject: [PATCH 166/467] wrong id for writing (mboxid) --- driver-moab/main/component_mod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/driver-moab/main/component_mod.F90 b/driver-moab/main/component_mod.F90 index cc92c11e7aab..0dd2f7aa15c2 100644 --- a/driver-moab/main/component_mod.F90 +++ b/driver-moab/main/component_mod.F90 @@ -1022,7 +1022,7 @@ subroutine ocn_cpl_moab(ocn) write(lnum,"(I0.2)") num_moab_exports outfile = 'ocnCpl_'//trim(lnum)//'.h5m'//C_NULL_CHAR wopts = ';PARALLEL=WRITE_PART'//C_NULL_CHAR ! - ierr = iMOAB_WriteMesh(mpoid, trim(outfile), trim(wopts)) + ierr = iMOAB_WriteMesh(mboxid, trim(outfile), trim(wopts)) !CHECKRC(ierr, "cannot receive tag values") endif From c4e3dbe4132ba793e22438409f5931f7846a60ee Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Sun, 14 Aug 2022 20:40:01 -0500 Subject: [PATCH 167/467] introduce a new ocean instance on coupler just because of the tag So_fswpen, which is part of xao states and o2x states are they different or not ? Not sure, but creating a new instance solved a crash I could not fix maybe I took a cruise missile to a fly other ideas ? --- driver-moab/main/cplcomp_exchange_mod.F90 | 30 ++++++++++++++++++++++- driver-moab/main/prep_aoflux_mod.F90 | 12 ++++----- driver-moab/main/seq_flux_mct.F90 | 2 +- driver-moab/shr/seq_comm_mct.F90 | 2 ++ 4 files changed, 38 insertions(+), 8 deletions(-) diff --git a/driver-moab/main/cplcomp_exchange_mod.F90 b/driver-moab/main/cplcomp_exchange_mod.F90 index 28d519d18b03..015699bbc25e 100644 --- a/driver-moab/main/cplcomp_exchange_mod.F90 +++ b/driver-moab/main/cplcomp_exchange_mod.F90 @@ -15,7 +15,7 @@ module cplcomp_exchange_mod use seq_comm_mct, only: seq_comm_getinfo => seq_comm_setptrs, seq_comm_iamin use seq_diag_mct - use seq_comm_mct, only : mhid, mpoid, mbaxid, mboxid ! iMOAB app ids, for atm, ocean, ax mesh, ox mesh + use seq_comm_mct, only : mhid, mpoid, mbaxid, mboxid, mbofxid ! iMOAB app ids, for atm, ocean, ax mesh, ox mesh use seq_comm_mct, only : mhpgid ! iMOAB app id for atm pgx grid, on atm pes use seq_comm_mct, only : atm_pg_active ! flag if PG mesh instanced use seq_comm_mct, only : mlnid , mblxid ! iMOAB app id for land , on land pes and coupler pes @@ -1292,6 +1292,34 @@ subroutine cplcomp_moab_Init(comp) call shr_sys_abort(subname//' ERROR in freeing buffers ') endif endif + ! start copy + ! do another ocean copy of the mesh on the coupler, just because So_fswpen field + ! would appear twice on original mboxid, once from xao states, once from o2x states + id_join = id_join + 1000! kind of random + if (MPI_COMM_NULL /= mpicom_old ) then ! it means we are on the component pes (ocean) + ! send mesh to coupler, the second time! a copy would be cheaper + ierr = iMOAB_SendMesh(mpoid, mpicom_join, mpigrp_cplid, id_join, partMethod) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in sending ocean mesh to coupler the second time' + call shr_sys_abort(subname//' ERROR in sending ocean mesh to coupler the second time ') + endif + endif + if (MPI_COMM_NULL /= mpicom_new ) then ! we are on the coupler pes + appname = "COUPLE_MPASOF"//C_NULL_CHAR + ! migrated mesh gets another app id, moab ocean to coupler (mbox) + ierr = iMOAB_RegisterApplication(trim(appname), mpicom_new, id_join, mbofxid) + ierr = iMOAB_ReceiveMesh(mbofxid, mpicom_join, mpigrp_old, id_old) + + endif + if (mpoid .ge. 0) then ! we are on component ocn pes again, release buffers + context_id = id_join + ierr = iMOAB_FreeSenderBuffers(mpoid, context_id) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in freeing buffers ' + call shr_sys_abort(subname//' ERROR in freeing buffers ') + endif + endif + ! end copy endif ! land diff --git a/driver-moab/main/prep_aoflux_mod.F90 b/driver-moab/main/prep_aoflux_mod.F90 index 319eddba8f18..5f4e64b5f12b 100644 --- a/driver-moab/main/prep_aoflux_mod.F90 +++ b/driver-moab/main/prep_aoflux_mod.F90 @@ -7,7 +7,7 @@ module prep_aoflux_mod use shr_sys_mod, only: shr_sys_abort, shr_sys_flush use seq_comm_mct, only: num_inst_xao, num_inst_frc, num_inst_ocn use seq_comm_mct, only: CPLID, logunit - use seq_comm_mct, only : mboxid ! iMOAB app id for ocn on cpl pes + use seq_comm_mct, only : mbofxid ! iMOAB app id for ocn on cpl pes, the second copy of mboxid use seq_comm_mct, only : mphaxid ! iMOAB app id for atm phys grid on cpl pes use seq_comm_mct, only: seq_comm_getData=>seq_comm_setptrs use seq_infodata_mod, only: seq_infodata_getdata, seq_infodata_type @@ -130,12 +130,12 @@ subroutine prep_aoflux_init (infodata) call mct_aVect_zero(xao_ox(exi)) enddo -! define flux tags on the moab ocean mesh - if (mboxid .ge. 0 ) then ! // +! define flux tags on the moab ocean mesh, second copy of ocean mesh on coupler + if (mbofxid .ge. 0 ) then ! // tagname = trim(seq_flds_xao_fields)//C_NULL_CHAR tagtype = 1 ! dense, double numco = 1 - ierr = iMOAB_DefineTagStorage(mboxid, tagname, tagtype, numco, tagindex ) + ierr = iMOAB_DefineTagStorage(mbofxid, tagname, tagtype, numco, tagindex ) if (ierr .ne. 0) then write(logunit,*) subname,' error in defining tags on ocn phys mesh on cpl ' call shr_sys_abort(subname//' ERROR in defining tags on ocn phys mesh on cpl') @@ -146,13 +146,13 @@ subroutine prep_aoflux_init (infodata) size_list=mct_list_nitem (temp_list) call mct_list_clean(temp_list) ! find out the number of local elements in moab mesh - ierr = iMOAB_GetMeshInfo ( mboxid, nvert, nvise, nbl, nsurf, nvisBC ); ! could be different of lsize_o + ierr = iMOAB_GetMeshInfo ( mbofxid, nvert, nvise, nbl, nsurf, nvisBC ); ! could be different of lsize_o ! local size of vertices is different from lsize_o arrSize = nvert(1) * size_list ! there are size_list tags that need to be zeroed out allocate(tagValues(arrSize) ) ent_type = 1 ! cell type tagValues = 0 - ierr = iMOAB_SetDoubleTagStorage ( mboxid, tagname, arrSize , ent_type, tagValues) + ierr = iMOAB_SetDoubleTagStorage ( mbofxid, tagname, arrSize , ent_type, tagValues) if (ierr .ne. 0) then write(logunit,*) subname,' error in zeroing out xao_fields ' call shr_sys_abort(subname//' ERROR in zeroing out xao_fields in init ') diff --git a/driver-moab/main/seq_flux_mct.F90 b/driver-moab/main/seq_flux_mct.F90 index 64e9cbe0945c..9597f0e2e61e 100644 --- a/driver-moab/main/seq_flux_mct.F90 +++ b/driver-moab/main/seq_flux_mct.F90 @@ -1627,7 +1627,7 @@ subroutine seq_flux_atmocn_moab(comp, xao) appId = mphaxid ! ocn on coupler local_xao_mct => prep_aoflux_get_xao_amct() else if (comp%oneletterid == 'o') then - appId = mboxid ! atm phys + appId = mbofxid ! atm phys local_xao_mct => prep_aoflux_get_xao_omct() else call mct_die(subName,'call for either ocean or atm',1) diff --git a/driver-moab/shr/seq_comm_mct.F90 b/driver-moab/shr/seq_comm_mct.F90 index 42ba12acea5e..b91e69f93a8a 100644 --- a/driver-moab/shr/seq_comm_mct.F90 +++ b/driver-moab/shr/seq_comm_mct.F90 @@ -221,6 +221,7 @@ module seq_comm_mct integer, public :: mphaxid ! iMOAB id for atm phys grid, on cpl pes; for atm_pg_active it will be the same as mbaxid integer, public :: mbaxid ! iMOAB id for atm migrated mesh to coupler pes integer, public :: mboxid ! iMOAB id for mpas ocean migrated mesh to coupler pes + integer, public :: mbofxid ! iMOAB id for mpas ocean migrated mesh to coupler pes, just for xao flux calculations integer, public :: mbintxao ! iMOAB id for intx mesh between ocean and atmosphere integer, public :: mblxid ! iMOAB id for land mesh migrated to coupler pes integer, public :: mblx2id ! iMOAB id for land mesh instanced from MCT on coupler pes @@ -630,6 +631,7 @@ subroutine seq_comm_init(global_comm_in, driver_comm_in, nmlfile, drv_comm_id) mphaxid = -1 ! iMOAB id for phys grid on cpl pes mbaxid = -1 ! iMOAB id for atm migrated mesh to coupler pes mboxid = -1 ! iMOAB id for mpas ocean migrated mesh to coupler pes + mbofxid = -1 ! iMOAB id for second mpas ocean migrated mesh to coupler pes, for flux calculations mbintxao = -1 ! iMOAB id for atm intx with mpas ocean mblxid = -1 ! iMOAB id for land on coupler pes mbintxla = -1 ! iMOAB id for land intx with atm on coupler pes From b73af0477fcb2e8146cad042915c12ddb2035962 Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Sat, 27 Aug 2022 18:58:34 -0500 Subject: [PATCH 168/467] add mct ocn model on coupler used mainly for debugging --- driver-moab/main/prep_aoflux_mod.F90 | 46 ++++++++++++++++++++++++++-- driver-moab/main/seq_flux_mct.F90 | 27 +++++++++++++--- driver-moab/main/seq_frac_mct.F90 | 6 ++-- driver-moab/shr/seq_comm_mct.F90 | 2 ++ 4 files changed, 72 insertions(+), 9 deletions(-) diff --git a/driver-moab/main/prep_aoflux_mod.F90 b/driver-moab/main/prep_aoflux_mod.F90 index 5f4e64b5f12b..2e8f65aeae57 100644 --- a/driver-moab/main/prep_aoflux_mod.F90 +++ b/driver-moab/main/prep_aoflux_mod.F90 @@ -8,6 +8,7 @@ module prep_aoflux_mod use seq_comm_mct, only: num_inst_xao, num_inst_frc, num_inst_ocn use seq_comm_mct, only: CPLID, logunit use seq_comm_mct, only : mbofxid ! iMOAB app id for ocn on cpl pes, the second copy of mboxid + use seq_comm_mct, only : mbox2id ! use seq_comm_mct, only : mphaxid ! iMOAB app id for atm phys grid on cpl pes use seq_comm_mct, only: seq_comm_getData=>seq_comm_setptrs use seq_infodata_mod, only: seq_infodata_getdata, seq_infodata_type @@ -78,6 +79,9 @@ subroutine prep_aoflux_init (infodata) ! module variables ! use iMOAB, only : iMOAB_DefineTagStorage, iMOAB_SetDoubleTagStorage, iMOAB_GetMeshInfo +#ifdef MOABDEBUG + use iMOAB, only : iMOAB_WriteMesh ! for writing debug file +#endif ! Arguments type (seq_infodata_type) , intent(inout) :: infodata ! @@ -92,11 +96,14 @@ subroutine prep_aoflux_init (infodata) integer :: arrSize ! for the size of tagValues type(mct_list) :: temp_list ! used to count the number of strings / fields integer nvert(3), nvise(3), nbl(3), nsurf(3), nvisBC(3) ! used to find out the size of local mesh, in moab - +#ifdef MOABDEBUG + character*100 outfile, wopts ! for writing debug file +#endif character(CS) :: aoflux_grid ! grid for atm ocn flux calc type(mct_avect) , pointer :: a2x_ax type(mct_avect) , pointer :: o2x_ox character(*) , parameter :: subname = '(prep_aoflux_init)' + !--------------------------------------------------------------- call seq_infodata_getdata(infodata, & @@ -148,7 +155,8 @@ subroutine prep_aoflux_init (infodata) ! find out the number of local elements in moab mesh ierr = iMOAB_GetMeshInfo ( mbofxid, nvert, nvise, nbl, nsurf, nvisBC ); ! could be different of lsize_o ! local size of vertices is different from lsize_o - arrSize = nvert(1) * size_list ! there are size_list tags that need to be zeroed out + ! nvsise(1) is the number of primary elements locally + arrSize = nvise(1) * size_list ! there are size_list tags that need to be zeroed out allocate(tagValues(arrSize) ) ent_type = 1 ! cell type tagValues = 0 @@ -158,7 +166,41 @@ subroutine prep_aoflux_init (infodata) call shr_sys_abort(subname//' ERROR in zeroing out xao_fields in init ') endif allocate(xao_omct(lsize_o, size_list)) ! the transpose of xao_ox(size_list, lsize_o) + ! create for debugging the tags on mbox2id (mct grid on coupler) + ierr = iMOAB_DefineTagStorage(mbox2id, tagname, tagtype, numco, tagindex ) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in defining tags on ocn mct mesh on cpl ' + call shr_sys_abort(subname//' ERROR in defining tags on ocn mct mesh on cpl') + endif + xao_omct = 0. + ent_type = 0 ! cell type, this is point cloud mct + arrSize = lsize_o * size_list + ierr = iMOAB_SetDoubleTagStorage ( mbox2id, tagname, arrSize , ent_type, xao_omct) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in zeroing out xao_fields on mct instance ocn ' + call shr_sys_abort(subname//' ERROR in zeroing out xao_fields on mct instance ocn ') + endif deallocate(tagValues) +#ifdef MOABDEBUG + ! debug out file + outfile = 'o_flux.h5m'//C_NULL_CHAR + wopts = 'PARALLEL=WRITE_PART'//C_NULL_CHAR + ierr = iMOAB_WriteMesh(mbofxid, outfile, wopts) + + if (ierr .ne. 0) then + write(logunit,*) subname,' error in writing o_flux mesh ' + call shr_sys_abort(subname//' ERROR in writing o_flux mesh ') + endif + ! debug out file + outfile = 'ox_mct.h5m'//C_NULL_CHAR + ierr = iMOAB_WriteMesh(mbox2id, outfile, wopts) + + if (ierr .ne. 0) then + write(logunit,*) subname,' error in writing ox_mct mesh with 0 values ' + call shr_sys_abort(subname//' ERROR in writing ox_mct mesh ') + endif + +#endif endif ! define atm-ocn flux tags on the moab atm mesh diff --git a/driver-moab/main/seq_flux_mct.F90 b/driver-moab/main/seq_flux_mct.F90 index 9597f0e2e61e..2baa95c39d39 100644 --- a/driver-moab/main/seq_flux_mct.F90 +++ b/driver-moab/main/seq_flux_mct.F90 @@ -11,7 +11,7 @@ module seq_flux_mct use prep_aoflux_mod, only: prep_aoflux_get_xao_omct, prep_aoflux_get_xao_amct - use iMOAB, only : iMOAB_SetDoubleTagStorageWithGid, iMOAB_WriteMesh + use iMOAB, only : iMOAB_SetDoubleTagStorageWithGid, iMOAB_WriteMesh, iMOAB_SetDoubleTagStorage use seq_comm_mct, only : num_moab_exports ! for debugging use mct_mod @@ -1658,15 +1658,32 @@ subroutine seq_flux_atmocn_moab(comp, xao) #ifdef MOABDEBUG ! debug out file - write(lnum,"(I0.2)")num_moab_exports - outfile = comp%oneletterid//'_flux_'//trim(lnum)//'.h5m'//C_NULL_CHAR - wopts = 'PARALLEL=WRITE_PART'//C_NULL_CHAR - ierr = iMOAB_WriteMesh(appId, outfile, wopts) + write(lnum,"(I0.2)")num_moab_exports + outfile = comp%oneletterid//'_flux_'//trim(lnum)//'.h5m'//C_NULL_CHAR + wopts = 'PARALLEL=WRITE_PART'//C_NULL_CHAR + ierr = iMOAB_WriteMesh(appId, outfile, wopts) if (ierr .ne. 0) then write(logunit,*) subname,' error in writing mesh ' call shr_sys_abort(subname//' ERROR in writing mesh ') endif + + if (comp%oneletterid == 'o') then ! for debugging, set the mct ocn grid values, to see if they are the same + appId = mbox2id ! ocn on mct point cloud + ent_type = 0! vertices, it is point cloud + ierr = iMOAB_SetDoubleTagStorage( appId, tagname, arrSize , ent_type, local_xao_mct) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in setting local_xao_mct fluxes on mct grid for debugging ' + call shr_sys_abort(subname//' ERROR in setting local_xao_mct fluxes on mct grid for debugging') + endif + outfile = 'o_flux_mct_'//trim(lnum)//'.h5m'//C_NULL_CHAR + ierr = iMOAB_WriteMesh(appId, outfile, wopts) + + if (ierr .ne. 0) then + write(logunit,*) subname,' error in writing mesh ' + call shr_sys_abort(subname//' ERROR in writing mesh ') + endif + endif #endif diff --git a/driver-moab/main/seq_frac_mct.F90 b/driver-moab/main/seq_frac_mct.F90 index aaf318ddb48a..af353af0cf74 100644 --- a/driver-moab/main/seq_frac_mct.F90 +++ b/driver-moab/main/seq_frac_mct.F90 @@ -166,6 +166,7 @@ module seq_frac_mct use seq_comm_mct, only : mphaxid ! iMOAB app id for phys atm, on cpl pes use seq_comm_mct, only : mblxid ! iMOAB app id for lnd on cpl pes use seq_comm_mct, only : mblx2id ! iMOAB id for land mesh instanced from MCT on coupler pes + use seq_comm_mct, only : mbox2id ! iMOAB id for ocn mesh instanced from MCT on coupler pes use seq_comm_mct, only : mboxid ! iMOAB app id for ocn on cpl pes use seq_comm_mct, only : mbixid ! iMOAB for sea-ice migrated to coupler use seq_comm_mct, only : atm_pg_active ! flag if PG mesh instanced @@ -537,12 +538,14 @@ subroutine seq_frac_init( infodata, & end if ! Initialize fractions on ocean grid/decomp (initialize ice fraction to zero) - ! These are initialize the same as for ice + ! These are initialized the same as for ice if (ocn_present) then lSize = mct_aVect_lSize(dom_o%data) call mct_aVect_init(fractions_o,rList=fraclist_o,lsize=lsize) call mct_aVect_zero(fractions_o) + ! initialize ocn imoab app on mct grid + call expose_mct_grid_moab(ocn, mbox2id) ! will use then to set the data on it , for debugging if (mboxid .ge. 0 ) then ! // tagname = trim(fraclist_o)//C_NULL_CHAR tagtype = 1 ! dense, double @@ -552,7 +555,6 @@ subroutine seq_frac_init( infodata, & write(logunit,*) subname,' error in defining tags on ocn phys mesh on cpl ' call shr_sys_abort(subname//' ERROR in defining tags on ocn phys mesh on cpl') endif - endif if (ice_present) then mapper_i2o => prep_ocn_get_mapper_SFi2o() diff --git a/driver-moab/shr/seq_comm_mct.F90 b/driver-moab/shr/seq_comm_mct.F90 index b91e69f93a8a..1e9a66c299d4 100644 --- a/driver-moab/shr/seq_comm_mct.F90 +++ b/driver-moab/shr/seq_comm_mct.F90 @@ -225,6 +225,7 @@ module seq_comm_mct integer, public :: mbintxao ! iMOAB id for intx mesh between ocean and atmosphere integer, public :: mblxid ! iMOAB id for land mesh migrated to coupler pes integer, public :: mblx2id ! iMOAB id for land mesh instanced from MCT on coupler pes + integer, public :: mbox2id ! iMOAB id for ocn mesh instanced from MCT on coupler pes logical, public :: sameg_al ! same grid atm and land; used throughout, initialized in lnd_init integer, public :: mbintxla ! iMOAB id for intx mesh between land and atmosphere integer, public :: mpsiid ! iMOAB id for sea-ice, mpas model @@ -634,6 +635,7 @@ subroutine seq_comm_init(global_comm_in, driver_comm_in, nmlfile, drv_comm_id) mbofxid = -1 ! iMOAB id for second mpas ocean migrated mesh to coupler pes, for flux calculations mbintxao = -1 ! iMOAB id for atm intx with mpas ocean mblxid = -1 ! iMOAB id for land on coupler pes + mbox2id = -1 ! iMOAB id for ocn from mct on coupler pes mbintxla = -1 ! iMOAB id for land intx with atm on coupler pes mpsiid = -1 ! iMOAB for sea-ice mbixid = -1 ! iMOAB for sea-ice migrated to coupler From 43961225cb4f87a01595eeefbf6f978f9a00439d Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Tue, 30 Aug 2022 12:28:31 -0500 Subject: [PATCH 169/467] moab instance rof on coupler too also, various fractions sets/updates in seq_frac_init still need to project from atm to ocean to get some fractions_o fields do not conflict with mbrxid external id (22), make the external id of the mbroxid 22*100, because it is a special case, that is only used for coverage mesh. maybe we need to not use the cov_rof moab instance anyway, it is a little backward, and not a true moab instance, we cannot write it in parallel --- driver-moab/main/cplcomp_exchange_mod.F90 | 913 +++++++++++----------- driver-moab/main/prep_ocn_mod.F90 | 2 +- driver-moab/main/prep_rof_mod.F90 | 5 +- driver-moab/main/seq_frac_mct.F90 | 155 +++- 4 files changed, 626 insertions(+), 449 deletions(-) diff --git a/driver-moab/main/cplcomp_exchange_mod.F90 b/driver-moab/main/cplcomp_exchange_mod.F90 index 015699bbc25e..9328d3be735b 100644 --- a/driver-moab/main/cplcomp_exchange_mod.F90 +++ b/driver-moab/main/cplcomp_exchange_mod.F90 @@ -23,6 +23,7 @@ module cplcomp_exchange_mod use seq_comm_mct, only : mphaxid ! iMOAB app id for phys atm, on cpl pes use seq_comm_mct, only : sameg_al ! same grid atm lnd, and land is point cloud use seq_comm_mct, only : MPSIID, mbixid ! sea-ice on comp pes and on coupler pes + use seq_comm_mct, only : mrofid, mbrxid ! iMOAB id of moab rof app on comp pes and on coupler too use shr_mpi_mod, only: shr_mpi_max use dimensions_mod, only : np ! for atmosphere use iso_c_binding @@ -978,493 +979,533 @@ end function seq_mctext_gsmapIdentical !======================================================================= - subroutine cplcomp_moab_Init(comp) - - ! This routine initializes an iMOAB app on the coupler pes, - ! corresponding to the component pes. It uses send/receive - ! from iMOAB to replicate the mesh on coupler pes - - !----------------------------------------------------- - ! - use iMOAB, only: iMOAB_RegisterApplication, iMOAB_ReceiveMesh, iMOAB_SendMesh, & - iMOAB_WriteMesh, iMOAB_DefineTagStorage, iMOAB_GetMeshInfo, & - iMOAB_SetIntTagStorage, iMOAB_FreeSenderBuffers - ! - type(component_type), intent(inout) :: comp - ! - ! Local Variables - ! - integer :: mpicom_cplid - integer :: mpicom_old - integer :: mpicom_new - integer :: mpicom_join - integer :: ID_old - integer :: ID_new - integer :: ID_join - - character(len=*),parameter :: subname = "(cplcomp_moab_Init) " - - integer :: mpigrp_cplid ! coupler pes - integer :: mpigrp_old ! component group pes - integer :: ierr, context_id - character*32 :: appname, outfile, wopts, tagnameProj - integer :: maxMH, maxMPO, maxMLID, maxMSID ! max pids for moab apps atm, ocn, lnd, sea-ice - integer :: tagtype, numco, tagindex, partMethod - integer :: rank, ent_type - integer :: typeA, typeB, ATM_PHYS_CID ! used to compute par graph between atm phys - integer :: ID_JOIN_ATMPHYS ! 200 + 6 - integer :: ID_OLD_ATMPHYS ! 200 + 5 - ! and atm spectral on coupler - character(CXX) :: tagname + subroutine cplcomp_moab_Init(comp) + + ! This routine initializes an iMOAB app on the coupler pes, + ! corresponding to the component pes. It uses send/receive + ! from iMOAB to replicate the mesh on coupler pes + + !----------------------------------------------------- + ! + use iMOAB, only: iMOAB_RegisterApplication, iMOAB_ReceiveMesh, iMOAB_SendMesh, & + iMOAB_WriteMesh, iMOAB_DefineTagStorage, iMOAB_GetMeshInfo, & + iMOAB_SetIntTagStorage, iMOAB_FreeSenderBuffers + ! + type(component_type), intent(inout) :: comp + ! + ! Local Variables + ! + integer :: mpicom_cplid + integer :: mpicom_old + integer :: mpicom_new + integer :: mpicom_join + integer :: ID_old + integer :: ID_new + integer :: ID_join + + character(len=*),parameter :: subname = "(cplcomp_moab_Init) " + + integer :: mpigrp_cplid ! coupler pes + integer :: mpigrp_old ! component group pes + integer :: ierr, context_id + character*32 :: appname, outfile, wopts, tagnameProj + integer :: maxMH, maxMPO, maxMLID, maxMSID, maxMRID ! max pids for moab apps atm, ocn, lnd, sea-ice, rof + integer :: tagtype, numco, tagindex, partMethod + integer :: rank, ent_type + integer :: typeA, typeB, ATM_PHYS_CID ! used to compute par graph between atm phys + integer :: ID_JOIN_ATMPHYS ! 200 + 6 + integer :: ID_OLD_ATMPHYS ! 200 + 5 + ! and atm spectral on coupler + character(CXX) :: tagname #ifdef MOABDEBUG - integer , dimension(1:3) :: nverts, nelem, nblocks, nsbc, ndbc - integer, dimension(:), allocatable :: vgids + integer , dimension(1:3) :: nverts, nelem, nblocks, nsbc, ndbc + integer, dimension(:), allocatable :: vgids #endif -!----------------------------------------------------- + !----------------------------------------------------- - call seq_comm_getinfo(CPLID, mpicom=mpicom_CPLID, iam=rank) + call seq_comm_getinfo(CPLID, mpicom=mpicom_CPLID, iam=rank) - id_new = cplid - id_old = comp%compid - id_join = comp%cplcompid + id_new = cplid + id_old = comp%compid + id_join = comp%cplcompid - mpicom_new = mpicom_cplid - mpicom_old = comp%mpicom_compid - mpicom_join = comp%mpicom_cplcompid + mpicom_new = mpicom_cplid + mpicom_old = comp%mpicom_compid + mpicom_join = comp%mpicom_cplcompid - partMethod = 0 ! trivial partitioning - context_id = -1 ! original sends/receives, so the context is -1 - ! needed only to free send buffers + partMethod = 0 ! trivial partitioning + context_id = -1 ! original sends/receives, so the context is -1 + ! needed only to free send buffers #ifdef MOAB_HAVE_ZOLTAN - partMethod = 2 ! it is better to use RCB for atmosphere and ocean too + partMethod = 2 ! it is better to use RCB for atmosphere and ocean too #endif - call seq_comm_getinfo(ID_old ,mpicom=mpicom_old) - call seq_comm_getinfo(ID_new ,mpicom=mpicom_new) - call seq_comm_getinfo(ID_join,mpicom=mpicom_join) - - call shr_mpi_max(mhid, maxMH, mpicom_join, all=.true.) ! if on atm / cpl joint, maxMH /= -1 - call shr_mpi_max(mpoid, maxMPO, mpicom_join, all=.true.) - call shr_mpi_max(mlnid, maxMLID, mpicom_join, all=.true.) - call shr_mpi_max(MPSIID, maxMSID, mpicom_join, all=.true.) - if (seq_comm_iamroot(CPLID) ) then - write(logunit, *) "MOAB coupling: maxMH: ", maxMH, " maxMPO: ", maxMPO, & - " maxMLID: ", maxMLID - endif - ! this works now for atmosphere; - if ( comp%oneletterid == 'a' .and. maxMH /= -1) then - call seq_comm_getinfo(cplid ,mpigrp=mpigrp_cplid) ! receiver group - call seq_comm_getinfo(id_old,mpigrp=mpigrp_old) ! component group pes - ! now, if on coupler pes, receive mesh; if on comp pes, send mesh - if (MPI_COMM_NULL /= mpicom_old ) then ! it means we are on the component pes (atmosphere) - ! send mesh to coupler - if (atm_pg_active) then ! change : send the pg2 mesh, not coarse mesh, when atm pg active - ierr = iMOAB_SendMesh(mhpgid, mpicom_join, mpigrp_cplid, id_join, partMethod) - else - ! still use the mhid, original coarse mesh - ierr = iMOAB_SendMesh(mhid, mpicom_join, mpigrp_cplid, id_join, partMethod) - endif - if (ierr .ne. 0) then - write(logunit,*) subname,' error in sending mesh from atm comp ' - call shr_sys_abort(subname//' ERROR in sending mesh from atm comp') - endif - endif - if (MPI_COMM_NULL /= mpicom_new ) then ! we are on the coupler pes - appname = "COUPLE_ATM"//C_NULL_CHAR - ! migrated mesh gets another app id, moab atm to coupler (mbax) - ierr = iMOAB_RegisterApplication(trim(appname), mpicom_new, id_join, mbaxid) - if (ierr .ne. 0) then - write(logunit,*) subname,' error in registering ', appname - call shr_sys_abort(subname//' ERROR registering '// appname) - endif - ierr = iMOAB_ReceiveMesh(mbaxid, mpicom_join, mpigrp_old, id_old) - if (ierr .ne. 0) then - write(logunit,*) subname,' error in receiving mesh on atm coupler ' - call shr_sys_abort(subname//' ERROR in receiving mesh on atm coupler ') - endif -#ifdef MOABDEBUG - ! debug test - if (atm_pg_active) then ! - outfile = 'recMeshAtmPG.h5m'//C_NULL_CHAR - else - outfile = 'recMeshAtm.h5m'//C_NULL_CHAR - endif - wopts = ';PARALLEL=WRITE_PART'//C_NULL_CHAR -! write out the mesh file to disk - ierr = iMOAB_WriteMesh(mbaxid, trim(outfile), trim(wopts)) - if (ierr .ne. 0) then - write(logunit,*) subname,' error in writing mesh ' - call shr_sys_abort(subname//' ERROR in writing mesh ') - endif -#endif + call seq_comm_getinfo(ID_old ,mpicom=mpicom_old) + call seq_comm_getinfo(ID_new ,mpicom=mpicom_new) + call seq_comm_getinfo(ID_join,mpicom=mpicom_join) + + call shr_mpi_max(mhid, maxMH, mpicom_join, all=.true.) ! if on atm / cpl joint, maxMH /= -1 + call shr_mpi_max(mpoid, maxMPO, mpicom_join, all=.true.) + call shr_mpi_max(mlnid, maxMLID, mpicom_join, all=.true.) + call shr_mpi_max(MPSIID, maxMSID, mpicom_join, all=.true.) + call shr_mpi_max(mrofid, maxMRID, mpicom_join, all=.true.) + if (seq_comm_iamroot(CPLID) ) then + write(logunit, *) "MOAB coupling: maxMH: ", maxMH, " maxMPO: ", maxMPO, & + " maxMLID: ", maxMLID endif - ! iMOAB_FreeSenderBuffers needs to be called after receiving the mesh - - if (mhid .ge. 0) then ! we are on component atm pes - context_id = id_join - if (atm_pg_active) then! we send mesh from mhpgid app - ierr = iMOAB_FreeSenderBuffers(mhpgid, context_id) + ! this works now for atmosphere; + if ( comp%oneletterid == 'a' .and. maxMH /= -1) then + call seq_comm_getinfo(cplid ,mpigrp=mpigrp_cplid) ! receiver group + call seq_comm_getinfo(id_old,mpigrp=mpigrp_old) ! component group pes + ! now, if on coupler pes, receive mesh; if on comp pes, send mesh + if (MPI_COMM_NULL /= mpicom_old ) then ! it means we are on the component pes (atmosphere) + ! send mesh to coupler + if (atm_pg_active) then ! change : send the pg2 mesh, not coarse mesh, when atm pg active + ierr = iMOAB_SendMesh(mhpgid, mpicom_join, mpigrp_cplid, id_join, partMethod) else - ierr = iMOAB_FreeSenderBuffers(mhid, context_id) + ! still use the mhid, original coarse mesh + ierr = iMOAB_SendMesh(mhid, mpicom_join, mpigrp_cplid, id_join, partMethod) endif if (ierr .ne. 0) then - write(logunit,*) subname,' error in freeing send buffers ' - call shr_sys_abort(subname//' ERROR in freeing send buffers') - endif - endif - - ! send also the phys grid to coupler, because it will be used for fractions - ! start copy for mphaid->mphaxid - if (MPI_COMM_NULL /= mpicom_old ) then ! it means we are on the component pes (atmosphere) - ! send mesh to coupler - if (atm_pg_active) then ! do not send again, mbaxid will be the same as mphaxid - mphaxid = mbaxid ! we already have pg mesh on coupler, as an FV mesh - else - ! still use the mhid, original coarse mesh - ID_JOIN_ATMPHYS = id_join + 200 ! somewhat arbitrary, just a different comp id - ierr = iMOAB_SendMesh(mphaid, mpicom_join, mpigrp_cplid, ID_JOIN_ATMPHYS, partMethod) - if (ierr .ne. 0) then write(logunit,*) subname,' error in sending mesh from atm comp ' call shr_sys_abort(subname//' ERROR in sending mesh from atm comp') - endif - endif - - endif - if (MPI_COMM_NULL /= mpicom_new .and. .not. atm_pg_active ) then ! we are on the coupler pes - - appname = "COUPLE_ATMPH"//C_NULL_CHAR - ! migrated mesh gets another app id, moab atm to coupler (mbax) - ID_JOIN_ATMPHYS = id_join + 200 ! somewhat arbitrary, just a different comp id - ierr = iMOAB_RegisterApplication(trim(appname), mpicom_new, ID_JOIN_ATMPHYS, mphaxid) - if (ierr .ne. 0) then - write(logunit,*) subname,' error in registering ', appname - call shr_sys_abort(subname//' ERROR registering '// appname) - endif - ID_OLD_ATMPHYS = id_old + 200 ! kind of arbitrary - ierr = iMOAB_ReceiveMesh(mphaxid, mpicom_join, mpigrp_old, ID_OLD_ATMPHYS) - if (ierr .ne. 0) then - write(logunit,*) subname,' error in receiving mesh on atm coupler ' - call shr_sys_abort(subname//' ERROR in receiving mesh on atm coupler ') - endif + endif + endif + if (MPI_COMM_NULL /= mpicom_new ) then ! we are on the coupler pes + appname = "COUPLE_ATM"//C_NULL_CHAR + ! migrated mesh gets another app id, moab atm to coupler (mbax) + ierr = iMOAB_RegisterApplication(trim(appname), mpicom_new, id_join, mbaxid) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in registering ', appname + call shr_sys_abort(subname//' ERROR registering '// appname) + endif + ierr = iMOAB_ReceiveMesh(mbaxid, mpicom_join, mpigrp_old, id_old) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in receiving mesh on atm coupler ' + call shr_sys_abort(subname//' ERROR in receiving mesh on atm coupler ') + endif #ifdef MOABDEBUG - ! debug test - - outfile = 'recPhysAtm.h5m'//C_NULL_CHAR - wopts = ';PARALLEL=WRITE_PART'//C_NULL_CHAR - ! write out the mesh file to disk - ierr = iMOAB_WriteMesh(mphaxid, trim(outfile), trim(wopts)) - if (ierr .ne. 0) then - write(logunit,*) subname,' error in writing mesh ' - call shr_sys_abort(subname//' ERROR in writing mesh ') - endif + ! debug test + if (atm_pg_active) then ! + outfile = 'recMeshAtmPG.h5m'//C_NULL_CHAR + else + outfile = 'recMeshAtm.h5m'//C_NULL_CHAR + endif + wopts = ';PARALLEL=WRITE_PART'//C_NULL_CHAR + ! write out the mesh file to disk + ierr = iMOAB_WriteMesh(mbaxid, trim(outfile), trim(wopts)) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in writing mesh ' + call shr_sys_abort(subname//' ERROR in writing mesh ') + endif #endif - endif - ! iMOAB_FreeSenderBuffers needs to be called after receiving the mesh - if (MPI_COMM_NULL /= mpicom_old .and. .not. atm_pg_active) then ! it means we are on the component pes (atmosphere) - context_id = ID_JOIN_ATMPHYS - ierr = iMOAB_FreeSenderBuffers(mphaid, context_id) + endif + ! iMOAB_FreeSenderBuffers needs to be called after receiving the mesh + + if (mhid .ge. 0) then ! we are on component atm pes + context_id = id_join + if (atm_pg_active) then! we send mesh from mhpgid app + ierr = iMOAB_FreeSenderBuffers(mhpgid, context_id) + else + ierr = iMOAB_FreeSenderBuffers(mhid, context_id) + endif + if (ierr .ne. 0) then + write(logunit,*) subname,' error in freeing send buffers ' + call shr_sys_abort(subname//' ERROR in freeing send buffers') + endif + endif + + ! send also the phys grid to coupler, because it will be used for fractions + ! start copy for mphaid->mphaxid + if (MPI_COMM_NULL /= mpicom_old ) then ! it means we are on the component pes (atmosphere) + ! send mesh to coupler + if (atm_pg_active) then ! do not send again, mbaxid will be the same as mphaxid + mphaxid = mbaxid ! we already have pg mesh on coupler, as an FV mesh + else + ! still use the mhid, original coarse mesh + ID_JOIN_ATMPHYS = id_join + 200 ! somewhat arbitrary, just a different comp id + ierr = iMOAB_SendMesh(mphaid, mpicom_join, mpigrp_cplid, ID_JOIN_ATMPHYS, partMethod) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in sending mesh from atm comp ' + call shr_sys_abort(subname//' ERROR in sending mesh from atm comp') + endif + endif + endif + if (MPI_COMM_NULL /= mpicom_new .and. .not. atm_pg_active ) then ! we are on the coupler pes + + appname = "COUPLE_ATMPH"//C_NULL_CHAR + ! migrated mesh gets another app id, moab atm to coupler (mbax) + ID_JOIN_ATMPHYS = id_join + 200 ! somewhat arbitrary, just a different comp id + ierr = iMOAB_RegisterApplication(trim(appname), mpicom_new, ID_JOIN_ATMPHYS, mphaxid) if (ierr .ne. 0) then - write(logunit,*) subname,' error in freeing send buffers ' - call shr_sys_abort(subname//' ERROR in freeing send buffers') - endif - endif - - -! comment out now; we will not send directly to atm spectral on coupler; we need to send in the -! context of ocean intx;; or directly to land on coupler, for projection to land - ! now we have the spectral atm on coupler pes, and we want to send some data from - ! atm physics mesh to atm spectral on coupler side; compute a par comm graph between - ! atm phys and spectral atm mesh on coupler PEs - ! ierr = iMOAB_ComputeCommGraph(cmpAtmPID, physAtmPID, &joinComm, &atmPEGroup, &atmPhysGroup, - ! &typeA, &typeB, &cmpatm, &physatm); - ! graph between atm phys, mphaid, and atm dyn on coupler, mbaxid - ! phys atm group is mpigrp_old, coupler group is mpigrp_cplid - !!typeA = 2 ! point cloud - !!typeB = 1 ! spectral elements - !!ATM_PHYS_CID = 200 + id_old ! 200 + 5 for atm, see line 969 ATM_PHYS = 200 + ATMID ! in - ! components/cam/src/cpl/atm_comp_mct.F90 - !!ierr = iMOAB_ComputeCommGraph( mphaid, mbaxid, mpicom_join, mpigrp_old, mpigrp_cplid, & - !! typeA, typeB, ATM_PHYS_CID, id_join) -! comment out this above part - - ! we also need to define the tags for receiving the physics data, on atm on coupler pes - ! corresponding to 'T_ph;u_ph;v_ph'; - ! we can receive those tags only on coupler pes, when mbaxid exists - ! we have to check that before we can define the tag - if (mbaxid .ge. 0 .and. .not. (atm_pg_active) ) then - tagname = trim(seq_flds_a2x_ext_fields)//C_NULL_CHAR - tagtype = 1 ! dense, double - numco = np*np ! usually 16 values per cell, GLL points; should be 4 x 4 = 16 - ierr = iMOAB_DefineTagStorage(mbaxid, tagname, tagtype, numco, tagindex ) - if (ierr .ne. 0) then - write(logunit,*) subname,' error in defining tags ' - call shr_sys_abort(subname//' ERROR in defining tags ') - endif + write(logunit,*) subname,' error in registering ', appname + call shr_sys_abort(subname//' ERROR registering '// appname) + endif + ID_OLD_ATMPHYS = id_old + 200 ! kind of arbitrary + ierr = iMOAB_ReceiveMesh(mphaxid, mpicom_join, mpigrp_old, ID_OLD_ATMPHYS) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in receiving mesh on atm coupler ' + call shr_sys_abort(subname//' ERROR in receiving mesh on atm coupler ') + endif +#ifdef MOABDEBUG + ! debug test + + outfile = 'recPhysAtm.h5m'//C_NULL_CHAR + wopts = ';PARALLEL=WRITE_PART'//C_NULL_CHAR + ! write out the mesh file to disk + ierr = iMOAB_WriteMesh(mphaxid, trim(outfile), trim(wopts)) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in writing mesh ' + call shr_sys_abort(subname//' ERROR in writing mesh ') + endif +#endif + endif + ! iMOAB_FreeSenderBuffers needs to be called after receiving the mesh + if (MPI_COMM_NULL /= mpicom_old .and. .not. atm_pg_active) then ! it means we are on the component pes (atmosphere) + context_id = ID_JOIN_ATMPHYS + ierr = iMOAB_FreeSenderBuffers(mphaid, context_id) + + if (ierr .ne. 0) then + write(logunit,*) subname,' error in freeing send buffers ' + call shr_sys_abort(subname//' ERROR in freeing send buffers') + endif + endif + + + ! comment out now; we will not send directly to atm spectral on coupler; we need to send in the + ! context of ocean intx;; or directly to land on coupler, for projection to land + ! now we have the spectral atm on coupler pes, and we want to send some data from + ! atm physics mesh to atm spectral on coupler side; compute a par comm graph between + ! atm phys and spectral atm mesh on coupler PEs + ! ierr = iMOAB_ComputeCommGraph(cmpAtmPID, physAtmPID, &joinComm, &atmPEGroup, &atmPhysGroup, + ! &typeA, &typeB, &cmpatm, &physatm); + ! graph between atm phys, mphaid, and atm dyn on coupler, mbaxid + ! phys atm group is mpigrp_old, coupler group is mpigrp_cplid + !!typeA = 2 ! point cloud + !!typeB = 1 ! spectral elements + !!ATM_PHYS_CID = 200 + id_old ! 200 + 5 for atm, see line 969 ATM_PHYS = 200 + ATMID ! in + ! components/cam/src/cpl/atm_comp_mct.F90 + !!ierr = iMOAB_ComputeCommGraph( mphaid, mbaxid, mpicom_join, mpigrp_old, mpigrp_cplid, & + !! typeA, typeB, ATM_PHYS_CID, id_join) + ! comment out this above part + + ! we also need to define the tags for receiving the physics data, on atm on coupler pes + ! corresponding to 'T_ph;u_ph;v_ph'; + ! we can receive those tags only on coupler pes, when mbaxid exists + ! we have to check that before we can define the tag + if (mbaxid .ge. 0 .and. .not. (atm_pg_active) ) then + tagname = trim(seq_flds_a2x_ext_fields)//C_NULL_CHAR + tagtype = 1 ! dense, double + numco = np*np ! usually 16 values per cell, GLL points; should be 4 x 4 = 16 + ierr = iMOAB_DefineTagStorage(mbaxid, tagname, tagtype, numco, tagindex ) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in defining tags ' + call shr_sys_abort(subname//' ERROR in defining tags ') + endif + endif endif - endif - ! ocean - if (comp%oneletterid == 'o' .and. maxMPO /= -1) then - call seq_comm_getinfo(cplid ,mpigrp=mpigrp_cplid) ! receiver group - call seq_comm_getinfo(id_old,mpigrp=mpigrp_old) ! component group pes + ! ocean + if (comp%oneletterid == 'o' .and. maxMPO /= -1) then + call seq_comm_getinfo(cplid ,mpigrp=mpigrp_cplid) ! receiver group + call seq_comm_getinfo(id_old,mpigrp=mpigrp_old) ! component group pes - if (MPI_COMM_NULL /= mpicom_old ) then ! it means we are on the component pes (ocean) - ! write out the mesh file to disk, in parallel + if (MPI_COMM_NULL /= mpicom_old ) then ! it means we are on the component pes (ocean) + ! write out the mesh file to disk, in parallel #ifdef MOABDEBUG - outfile = 'wholeOcn.h5m'//C_NULL_CHAR - wopts = 'PARALLEL=WRITE_PART'//C_NULL_CHAR - ierr = iMOAB_WriteMesh(MPOID, outfile, wopts) - if (ierr .ne. 0) then - write(logunit,*) subname,' error in writing ocean mesh ' - call shr_sys_abort(subname//' ERROR in writing ocean mesh ') - endif + outfile = 'wholeOcn.h5m'//C_NULL_CHAR + wopts = 'PARALLEL=WRITE_PART'//C_NULL_CHAR + ierr = iMOAB_WriteMesh(MPOID, outfile, wopts) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in writing ocean mesh ' + call shr_sys_abort(subname//' ERROR in writing ocean mesh ') + endif #endif - ! send mesh to coupler - ierr = iMOAB_SendMesh(mpoid, mpicom_join, mpigrp_cplid, id_join, partMethod) - if (ierr .ne. 0) then - write(logunit,*) subname,' error in sending ocean mesh to coupler ' - call shr_sys_abort(subname//' ERROR in sending ocean mesh to coupler ') - endif - - ! define here the tag that will be projected back from atmosphere - ! TODO where do we want to define this? - tagnameProj = 'a2oTbot_proj'//C_NULL_CHAR - tagtype = 1 ! dense, double - numco = 1 ! one value per cell - ierr = iMOAB_DefineTagStorage(mpoid, tagnameProj, tagtype, numco, tagindex ) - ! define more tags - tagnameProj = 'a2oUbot_proj'//C_NULL_CHAR ! U component of velocity - ierr = iMOAB_DefineTagStorage(mpoid, tagnameProj, tagtype, numco, tagindex ) - tagnameProj = 'a2oVbot_proj'//C_NULL_CHAR ! V component of velocity - ierr = iMOAB_DefineTagStorage(mpoid, tagnameProj, tagtype, numco, tagindex ) - if (ierr .ne. 0) then - write(logunit,*) subname,' error in defining tags on ocean comp ' - call shr_sys_abort(subname//' ERROR in defining tags on ocean comp ') - endif + ! send mesh to coupler + ierr = iMOAB_SendMesh(mpoid, mpicom_join, mpigrp_cplid, id_join, partMethod) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in sending ocean mesh to coupler ' + call shr_sys_abort(subname//' ERROR in sending ocean mesh to coupler ') + endif - endif - if (MPI_COMM_NULL /= mpicom_new ) then ! we are on the coupler pes - appname = "COUPLE_MPASO"//C_NULL_CHAR - ! migrated mesh gets another app id, moab ocean to coupler (mbox) - ierr = iMOAB_RegisterApplication(trim(appname), mpicom_new, id_join, mboxid) - ierr = iMOAB_ReceiveMesh(mboxid, mpicom_join, mpigrp_old, id_old) - - ! define here the tag that will be projected from atmosphere - tagnameProj = 'a2oTbot_proj'//C_NULL_CHAR ! temperature - tagtype = 1 ! dense, double - numco = 1 ! one value per cell - ierr = iMOAB_DefineTagStorage(mboxid, tagnameProj, tagtype, numco, tagindex ) - - ! define more tags - tagnameProj = 'a2oUbot_proj'//C_NULL_CHAR ! U component of velocity - ierr = iMOAB_DefineTagStorage(mboxid, tagnameProj, tagtype, numco, tagindex ) - tagnameProj = 'a2oVbot_proj'//C_NULL_CHAR ! V component of velocity - ierr = iMOAB_DefineTagStorage(mboxid, tagnameProj, tagtype, numco, tagindex ) - if (ierr .ne. 0) then - write(logunit,*) subname,' error in defining tags on ocean coupler ' - call shr_sys_abort(subname//' ERROR in defining tags on ocean coupler ') - endif - tagname = trim(seq_flds_o2x_fields)//C_NULL_CHAR - ierr = iMOAB_DefineTagStorage(mboxid, tagname, tagtype, numco, tagindex ) - if (ierr .ne. 0) then - write(logunit,*) subname,' error in defining tags o2x on coupler' - call shr_sys_abort(subname//' ERROR in defining tags o2x on coupler ') - endif + ! define here the tag that will be projected back from atmosphere + ! TODO where do we want to define this? + tagnameProj = 'a2oTbot_proj'//C_NULL_CHAR + tagtype = 1 ! dense, double + numco = 1 ! one value per cell + ierr = iMOAB_DefineTagStorage(mpoid, tagnameProj, tagtype, numco, tagindex ) + ! define more tags + tagnameProj = 'a2oUbot_proj'//C_NULL_CHAR ! U component of velocity + ierr = iMOAB_DefineTagStorage(mpoid, tagnameProj, tagtype, numco, tagindex ) + tagnameProj = 'a2oVbot_proj'//C_NULL_CHAR ! V component of velocity + ierr = iMOAB_DefineTagStorage(mpoid, tagnameProj, tagtype, numco, tagindex ) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in defining tags on ocean comp ' + call shr_sys_abort(subname//' ERROR in defining tags on ocean comp ') + endif + + endif + if (MPI_COMM_NULL /= mpicom_new ) then ! we are on the coupler pes + appname = "COUPLE_MPASO"//C_NULL_CHAR + ! migrated mesh gets another app id, moab ocean to coupler (mbox) + ierr = iMOAB_RegisterApplication(trim(appname), mpicom_new, id_join, mboxid) + ierr = iMOAB_ReceiveMesh(mboxid, mpicom_join, mpigrp_old, id_old) + + ! define here the tag that will be projected from atmosphere + tagnameProj = 'a2oTbot_proj'//C_NULL_CHAR ! temperature + tagtype = 1 ! dense, double + numco = 1 ! one value per cell + ierr = iMOAB_DefineTagStorage(mboxid, tagnameProj, tagtype, numco, tagindex ) + + ! define more tags + tagnameProj = 'a2oUbot_proj'//C_NULL_CHAR ! U component of velocity + ierr = iMOAB_DefineTagStorage(mboxid, tagnameProj, tagtype, numco, tagindex ) + tagnameProj = 'a2oVbot_proj'//C_NULL_CHAR ! V component of velocity + ierr = iMOAB_DefineTagStorage(mboxid, tagnameProj, tagtype, numco, tagindex ) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in defining tags on ocean coupler ' + call shr_sys_abort(subname//' ERROR in defining tags on ocean coupler ') + endif + tagname = trim(seq_flds_o2x_fields)//C_NULL_CHAR + ierr = iMOAB_DefineTagStorage(mboxid, tagname, tagtype, numco, tagindex ) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in defining tags o2x on coupler' + call shr_sys_abort(subname//' ERROR in defining tags o2x on coupler ') + endif #ifdef MOABDEBUG -! debug test - outfile = 'recMeshOcn.h5m'//C_NULL_CHAR - wopts = ';PARALLEL=WRITE_PART'//C_NULL_CHAR ! -! write out the mesh file to disk - ierr = iMOAB_WriteMesh(mboxid, trim(outfile), trim(wopts)) - if (ierr .ne. 0) then - write(logunit,*) subname,' error in writing ocean mesh coupler ' - call shr_sys_abort(subname//' ERROR in writing ocean mesh coupler ') - endif -#endif - endif - if (mpoid .ge. 0) then ! we are on component ocn pes - context_id = id_join - ierr = iMOAB_FreeSenderBuffers(mpoid, context_id) + ! debug test + outfile = 'recMeshOcn.h5m'//C_NULL_CHAR + wopts = ';PARALLEL=WRITE_PART'//C_NULL_CHAR ! + ! write out the mesh file to disk + ierr = iMOAB_WriteMesh(mboxid, trim(outfile), trim(wopts)) if (ierr .ne. 0) then - write(logunit,*) subname,' error in freeing buffers ' - call shr_sys_abort(subname//' ERROR in freeing buffers ') + write(logunit,*) subname,' error in writing ocean mesh coupler ' + call shr_sys_abort(subname//' ERROR in writing ocean mesh coupler ') endif - endif - ! start copy - ! do another ocean copy of the mesh on the coupler, just because So_fswpen field - ! would appear twice on original mboxid, once from xao states, once from o2x states - id_join = id_join + 1000! kind of random - if (MPI_COMM_NULL /= mpicom_old ) then ! it means we are on the component pes (ocean) - ! send mesh to coupler, the second time! a copy would be cheaper - ierr = iMOAB_SendMesh(mpoid, mpicom_join, mpigrp_cplid, id_join, partMethod) - if (ierr .ne. 0) then - write(logunit,*) subname,' error in sending ocean mesh to coupler the second time' - call shr_sys_abort(subname//' ERROR in sending ocean mesh to coupler the second time ') - endif - endif - if (MPI_COMM_NULL /= mpicom_new ) then ! we are on the coupler pes - appname = "COUPLE_MPASOF"//C_NULL_CHAR - ! migrated mesh gets another app id, moab ocean to coupler (mbox) - ierr = iMOAB_RegisterApplication(trim(appname), mpicom_new, id_join, mbofxid) - ierr = iMOAB_ReceiveMesh(mbofxid, mpicom_join, mpigrp_old, id_old) - - endif - if (mpoid .ge. 0) then ! we are on component ocn pes again, release buffers - context_id = id_join - ierr = iMOAB_FreeSenderBuffers(mpoid, context_id) +#endif + endif + if (mpoid .ge. 0) then ! we are on component ocn pes + context_id = id_join + ierr = iMOAB_FreeSenderBuffers(mpoid, context_id) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in freeing buffers ' + call shr_sys_abort(subname//' ERROR in freeing buffers ') + endif + endif + ! start copy + ! do another ocean copy of the mesh on the coupler, just because So_fswpen field + ! would appear twice on original mboxid, once from xao states, once from o2x states + id_join = id_join + 1000! kind of random + if (MPI_COMM_NULL /= mpicom_old ) then ! it means we are on the component pes (ocean) + ! send mesh to coupler, the second time! a copy would be cheaper + ierr = iMOAB_SendMesh(mpoid, mpicom_join, mpigrp_cplid, id_join, partMethod) if (ierr .ne. 0) then - write(logunit,*) subname,' error in freeing buffers ' - call shr_sys_abort(subname//' ERROR in freeing buffers ') + write(logunit,*) subname,' error in sending ocean mesh to coupler the second time' + call shr_sys_abort(subname//' ERROR in sending ocean mesh to coupler the second time ') endif + endif + if (MPI_COMM_NULL /= mpicom_new ) then ! we are on the coupler pes + appname = "COUPLE_MPASOF"//C_NULL_CHAR + ! migrated mesh gets another app id, moab ocean to coupler (mbox) + ierr = iMOAB_RegisterApplication(trim(appname), mpicom_new, id_join, mbofxid) + ierr = iMOAB_ReceiveMesh(mbofxid, mpicom_join, mpigrp_old, id_old) + + endif + if (mpoid .ge. 0) then ! we are on component ocn pes again, release buffers + context_id = id_join + ierr = iMOAB_FreeSenderBuffers(mpoid, context_id) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in freeing buffers ' + call shr_sys_abort(subname//' ERROR in freeing buffers ') + endif + endif + ! end copy endif - ! end copy - endif -! land - if (comp%oneletterid == 'l' .and. maxMLID /= -1) then - call seq_comm_getinfo(cplid ,mpigrp=mpigrp_cplid) ! receiver group - call seq_comm_getinfo(id_old,mpigrp=mpigrp_old) ! component group pes + ! land + if (comp%oneletterid == 'l' .and. maxMLID /= -1) then + call seq_comm_getinfo(cplid ,mpigrp=mpigrp_cplid) ! receiver group + call seq_comm_getinfo(id_old,mpigrp=mpigrp_old) ! component group pes - if (MPI_COMM_NULL /= mpicom_old ) then ! it means we are on the component pes (ocean) - ! send mesh to coupler + if (MPI_COMM_NULL /= mpicom_old ) then ! it means we are on the component pes (ocean) + ! send mesh to coupler #ifdef MOAB_HAVE_ZOLTAN - partMethod = 2 ! RCB for point cloud + partMethod = 2 ! RCB for point cloud #endif - ierr = iMOAB_SendMesh(mlnid, mpicom_join, mpigrp_cplid, id_join, partMethod) - if (ierr .ne. 0) then - write(logunit,*) subname,' error in sending land mesh ' - call shr_sys_abort(subname//' ERROR in sending land mesh ') - endif - ! create the receiver on land mesh too: - tagnameProj = 'a2lTbot_proj'//C_NULL_CHAR ! temperature - tagtype = 1 ! dense, double - numco = 1 ! one value per vertex / entity - ierr = iMOAB_DefineTagStorage(mlnid, tagnameProj, tagtype, numco, tagindex ) - - ! define more tags - tagnameProj = 'a2lUbot_proj'//C_NULL_CHAR ! U component of velocity - ierr = iMOAB_DefineTagStorage(mlnid, tagnameProj, tagtype, numco, tagindex ) - tagnameProj = 'a2lVbot_proj'//C_NULL_CHAR ! V component of velocity - ierr = iMOAB_DefineTagStorage(mlnid, tagnameProj, tagtype, numco, tagindex ) + ierr = iMOAB_SendMesh(mlnid, mpicom_join, mpigrp_cplid, id_join, partMethod) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in sending land mesh ' + call shr_sys_abort(subname//' ERROR in sending land mesh ') + endif + ! create the receiver on land mesh too: + tagnameProj = 'a2lTbot_proj'//C_NULL_CHAR ! temperature + tagtype = 1 ! dense, double + numco = 1 ! one value per vertex / entity + ierr = iMOAB_DefineTagStorage(mlnid, tagnameProj, tagtype, numco, tagindex ) + + ! define more tags + tagnameProj = 'a2lUbot_proj'//C_NULL_CHAR ! U component of velocity + ierr = iMOAB_DefineTagStorage(mlnid, tagnameProj, tagtype, numco, tagindex ) + tagnameProj = 'a2lVbot_proj'//C_NULL_CHAR ! V component of velocity + ierr = iMOAB_DefineTagStorage(mlnid, tagnameProj, tagtype, numco, tagindex ) - endif - if (MPI_COMM_NULL /= mpicom_new ) then ! we are on the coupler pes - appname = "COUPLE_LAND"//C_NULL_CHAR - ! migrated mesh gets another app id, moab ocean to coupler (mbox) - ierr = iMOAB_RegisterApplication(trim(appname), mpicom_new, id_join, mblxid) - if (ierr .ne. 0) then - write(logunit,*) subname,' error in registering coupler land ' - call shr_sys_abort(subname//' ERROR in registering coupler land') - endif - ierr = iMOAB_ReceiveMesh(mblxid, mpicom_join, mpigrp_old, id_old) - if (ierr .ne. 0) then - write(logunit,*) subname,' error in receiving coupler land mesh' - call shr_sys_abort(subname//' ERROR in receiving coupler land mesh') endif - ! define here the tag that will be projected from atmosphere - tagnameProj = 'a2lTbot_proj'//C_NULL_CHAR ! temperature - tagtype = 1 ! dense, double - numco = 1 ! one value per vertex / entity - ierr = iMOAB_DefineTagStorage(mblxid, tagnameProj, tagtype, numco, tagindex ) - - ! define more tags - tagnameProj = 'a2lUbot_proj'//C_NULL_CHAR ! U component of velocity - ierr = iMOAB_DefineTagStorage(mblxid, tagnameProj, tagtype, numco, tagindex ) - tagnameProj = 'a2lVbot_proj'//C_NULL_CHAR ! V component of velocity - ierr = iMOAB_DefineTagStorage(mblxid, tagnameProj, tagtype, numco, tagindex ) - if (ierr .ne. 0) then - write(logunit,*) subname,' error in defining tags on land coupler' - call shr_sys_abort(subname//' ERROR in defining tags on land coupler') - endif + if (MPI_COMM_NULL /= mpicom_new ) then ! we are on the coupler pes + appname = "COUPLE_LAND"//C_NULL_CHAR + ! migrated mesh gets another app id, moab ocean to coupler (mbox) + ierr = iMOAB_RegisterApplication(trim(appname), mpicom_new, id_join, mblxid) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in registering coupler land ' + call shr_sys_abort(subname//' ERROR in registering coupler land') + endif + ierr = iMOAB_ReceiveMesh(mblxid, mpicom_join, mpigrp_old, id_old) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in receiving coupler land mesh' + call shr_sys_abort(subname//' ERROR in receiving coupler land mesh') + endif + ! define here the tag that will be projected from atmosphere + tagnameProj = 'a2lTbot_proj'//C_NULL_CHAR ! temperature + tagtype = 1 ! dense, double + numco = 1 ! one value per vertex / entity + ierr = iMOAB_DefineTagStorage(mblxid, tagnameProj, tagtype, numco, tagindex ) + + ! define more tags + tagnameProj = 'a2lUbot_proj'//C_NULL_CHAR ! U component of velocity + ierr = iMOAB_DefineTagStorage(mblxid, tagnameProj, tagtype, numco, tagindex ) + tagnameProj = 'a2lVbot_proj'//C_NULL_CHAR ! V component of velocity + ierr = iMOAB_DefineTagStorage(mblxid, tagnameProj, tagtype, numco, tagindex ) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in defining tags on land coupler' + call shr_sys_abort(subname//' ERROR in defining tags on land coupler') + endif #ifdef MOABDEBUG - ! debug test - if (sameg_al) then - !there are no shared entities, but we will set a special partition tag, in order to see the - ! partitions ; it will be visible with a Pseudocolor plot in VisIt - tagname='partition'//C_NULL_CHAR - tagtype = 0 ! dense, integer - numco = 1 ! one value per cell - ierr = iMOAB_DefineTagStorage(mblxid, tagname, tagtype, numco, tagindex ) - ierr = iMOAB_GetMeshInfo(mblxid, nverts, nelem, nblocks, nsbc, ndbc) - allocate(vgids(nverts(1))) - vgids = rank - ent_type = 0 ! vertex type - ierr = iMOAB_SetIntTagStorage ( mblxid, tagname, nverts(1) , ent_type, vgids) - endif - outfile = 'recLand.h5m'//C_NULL_CHAR - wopts = ';PARALLEL=WRITE_PART'//C_NULL_CHAR ! -! write out the mesh file to disk - ierr = iMOAB_WriteMesh(mblxid, trim(outfile), trim(wopts)) - if (ierr .ne. 0) then - write(logunit,*) subname,' error in writing land coupler mesh' - call shr_sys_abort(subname//' ERROR in writing land coupler mesh') - endif -#endif - endif - if (mlnid .ge. 0) then ! we are on component land pes - context_id = id_join - ierr = iMOAB_FreeSenderBuffers(mlnid, context_id) + ! debug test + if (sameg_al) then + !there are no shared entities, but we will set a special partition tag, in order to see the + ! partitions ; it will be visible with a Pseudocolor plot in VisIt + tagname='partition'//C_NULL_CHAR + tagtype = 0 ! dense, integer + numco = 1 ! one value per cell + ierr = iMOAB_DefineTagStorage(mblxid, tagname, tagtype, numco, tagindex ) + ierr = iMOAB_GetMeshInfo(mblxid, nverts, nelem, nblocks, nsbc, ndbc) + allocate(vgids(nverts(1))) + vgids = rank + ent_type = 0 ! vertex type + ierr = iMOAB_SetIntTagStorage ( mblxid, tagname, nverts(1) , ent_type, vgids) + endif + outfile = 'recLand.h5m'//C_NULL_CHAR + wopts = ';PARALLEL=WRITE_PART'//C_NULL_CHAR ! + ! write out the mesh file to disk + ierr = iMOAB_WriteMesh(mblxid, trim(outfile), trim(wopts)) if (ierr .ne. 0) then - write(logunit,*) subname,' error in freeing buffers' - call shr_sys_abort(subname//' ERROR in freeing buffers') - endif + write(logunit,*) subname,' error in writing land coupler mesh' + call shr_sys_abort(subname//' ERROR in writing land coupler mesh') + endif +#endif + endif + if (mlnid .ge. 0) then ! we are on component land pes + context_id = id_join + ierr = iMOAB_FreeSenderBuffers(mlnid, context_id) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in freeing buffers' + call shr_sys_abort(subname//' ERROR in freeing buffers') + endif + endif endif - endif - ! sea - ice - if (comp%oneletterid == 'i' .and. maxMSID /= -1) then - call seq_comm_getinfo(cplid ,mpigrp=mpigrp_cplid) ! receiver group - call seq_comm_getinfo(id_old,mpigrp=mpigrp_old) ! component group pes + ! sea - ice + if (comp%oneletterid == 'i' .and. maxMSID /= -1) then + call seq_comm_getinfo(cplid ,mpigrp=mpigrp_cplid) ! receiver group + call seq_comm_getinfo(id_old,mpigrp=mpigrp_old) ! component group pes - if (MPI_COMM_NULL /= mpicom_old ) then ! it means we are on the component p + if (MPI_COMM_NULL /= mpicom_old ) then ! it means we are on the component p #ifdef MOABDEBUG - outfile = 'wholeSeaIce.h5m'//C_NULL_CHAR - wopts = 'PARALLEL=WRITE_PART'//C_NULL_CHAR - ierr = iMOAB_WriteMesh(MPSIID, outfile, wopts) - if (ierr .ne. 0) then - write(logunit,*) subname,' error in writing sea-ice' - call shr_sys_abort(subname//' ERROR in writing sea-ice') - endif + outfile = 'wholeSeaIce.h5m'//C_NULL_CHAR + wopts = 'PARALLEL=WRITE_PART'//C_NULL_CHAR + ierr = iMOAB_WriteMesh(MPSIID, outfile, wopts) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in writing sea-ice' + call shr_sys_abort(subname//' ERROR in writing sea-ice') + endif #endif -! start copy from ocean code - ! send sea ice mesh to coupler - ierr = iMOAB_SendMesh(MPSIID, mpicom_join, mpigrp_cplid, id_join, partMethod) - if (ierr .ne. 0) then - write(logunit,*) subname,' error in sending sea ice mesh to coupler ' - call shr_sys_abort(subname//' ERROR in sending sea ice mesh to coupler ') - endif + ! start copy from ocean code + ! send sea ice mesh to coupler + ierr = iMOAB_SendMesh(MPSIID, mpicom_join, mpigrp_cplid, id_join, partMethod) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in sending sea ice mesh to coupler ' + call shr_sys_abort(subname//' ERROR in sending sea ice mesh to coupler ') + endif - endif - if (MPI_COMM_NULL /= mpicom_new ) then ! we are on the coupler pes - appname = "COUPLE_MPASSI"//C_NULL_CHAR - ! migrated mesh gets another app id, moab moab sea ice to coupler (mbox) - ierr = iMOAB_RegisterApplication(trim(appname), mpicom_new, id_join, mbixid) - ierr = iMOAB_ReceiveMesh(mbixid, mpicom_join, mpigrp_old, id_old) + endif + if (MPI_COMM_NULL /= mpicom_new ) then ! we are on the coupler pes + appname = "COUPLE_MPASSI"//C_NULL_CHAR + ! migrated mesh gets another app id, moab moab sea ice to coupler (mbox) + ierr = iMOAB_RegisterApplication(trim(appname), mpicom_new, id_join, mbixid) + ierr = iMOAB_ReceiveMesh(mbixid, mpicom_join, mpigrp_old, id_old) #ifdef MOABDEBUG -! debug test - outfile = 'recSeaIce.h5m'//C_NULL_CHAR - wopts = ';PARALLEL=WRITE_PART'//C_NULL_CHAR ! -! write out the mesh file to disk - ierr = iMOAB_WriteMesh(mbixid, trim(outfile), trim(wopts)) - if (ierr .ne. 0) then - write(logunit,*) subname,' error in writing sea ice mesh on coupler ' - call shr_sys_abort(subname//' ERROR in writing sea ice mesh on coupler ') - endif + ! debug test + outfile = 'recSeaIce.h5m'//C_NULL_CHAR + wopts = ';PARALLEL=WRITE_PART'//C_NULL_CHAR ! + ! write out the mesh file to disk + ierr = iMOAB_WriteMesh(mbixid, trim(outfile), trim(wopts)) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in writing sea ice mesh on coupler ' + call shr_sys_abort(subname//' ERROR in writing sea ice mesh on coupler ') + endif #endif + endif + if (MPSIID .ge. 0) then ! we are on component sea ice pes + context_id = id_join + ierr = iMOAB_FreeSenderBuffers(MPSIID, context_id) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in freeing buffers ' + call shr_sys_abort(subname//' ERROR in freeing buffers ') + endif + endif endif - if (MPSIID .ge. 0) then ! we are on component sea ice pes - context_id = id_join - ierr = iMOAB_FreeSenderBuffers(MPSIID, context_id) + ! rof + if (comp%oneletterid == 'r' .and. maxMRID /= -1) then + call seq_comm_getinfo(cplid ,mpigrp=mpigrp_cplid) ! receiver group + call seq_comm_getinfo(id_old,mpigrp=mpigrp_old) ! component group pes + + if (MPI_COMM_NULL /= mpicom_old ) then ! it means we are on the component p + + ierr = iMOAB_SendMesh(mrofid, mpicom_join, mpigrp_cplid, id_join, partMethod) if (ierr .ne. 0) then - write(logunit,*) subname,' error in freeing buffers ' - call shr_sys_abort(subname//' ERROR in freeing buffers ') + write(logunit,*) subname,' error in sending rof mesh to coupler ' + call shr_sys_abort(subname//' ERROR in sending rof mesh to coupler ') endif - endif -! end copy from ocean code - endif - end subroutine cplcomp_moab_Init + endif + if (MPI_COMM_NULL /= mpicom_new ) then ! we are on the coupler pes + appname = "COUPLE_MROF"//C_NULL_CHAR + ! migrated mesh gets another app id, moab moab rof to coupler (mbox) + ierr = iMOAB_RegisterApplication(trim(appname), mpicom_new, id_join, mbrxid) + ierr = iMOAB_ReceiveMesh(mbrxid, mpicom_join, mpigrp_old, id_old) +#ifdef MOABDEBUG + ! debug test + outfile = 'recRof.h5m'//C_NULL_CHAR + wopts = ';PARALLEL=WRITE_PART'//C_NULL_CHAR ! + ! write out the mesh file to disk + ierr = iMOAB_WriteMesh(mbrxid, trim(outfile), trim(wopts)) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in writing rof mesh on coupler ' + call shr_sys_abort(subname//' ERROR in writing rof mesh on coupler ') + endif +#endif + endif + if (mrofid .ge. 0) then ! we are on component sea ice pes + context_id = id_join + ierr = iMOAB_FreeSenderBuffers(mrofid, context_id) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in freeing buffers ' + call shr_sys_abort(subname//' ERROR in freeing buffers ') + endif + endif + endif ! end for rof coupler send + + end subroutine cplcomp_moab_Init end module cplcomp_exchange_mod diff --git a/driver-moab/main/prep_ocn_mod.F90 b/driver-moab/main/prep_ocn_mod.F90 index 5602a38ace29..a731bc9b0dba 100644 --- a/driver-moab/main/prep_ocn_mod.F90 +++ b/driver-moab/main/prep_ocn_mod.F90 @@ -366,7 +366,7 @@ subroutine prep_ocn_init(infodata, atm_c2_ocn, atm_c2_ice, ice_c2_ocn, rof_c2_oc 'mapper_Rr2o_liq moab initialization',esmf_map_flag) appname = "ROF_COU"//C_NULL_CHAR ! rmapid is a unique external number of MOAB app that identifies runoff on coupler side - rmapid = rof(1)%cplcompid + rmapid = 100*rof(1)%cplcompid ! this is a special case, because we also have a regular coupler instance mbrxid ierr = iMOAB_RegisterApplication(trim(appname), mpicom_CPLID, rmapid, mbrxoid) if (ierr .ne. 0) then write(logunit,*) subname,' error in registering rof on coupler in ocean context ' diff --git a/driver-moab/main/prep_rof_mod.F90 b/driver-moab/main/prep_rof_mod.F90 index b3f0474840ec..2ce5c588863f 100644 --- a/driver-moab/main/prep_rof_mod.F90 +++ b/driver-moab/main/prep_rof_mod.F90 @@ -408,7 +408,7 @@ subroutine prep_rof_migrate_moab(infodata) ! it involves initial rof app; mesh on coupler pes, ! use seq_comm_mct, only: mrofid ! id for rof comp ! mbrmapro ! iMOAB id of moab instance of map read from rof2ocn map file - ! mbrxoid ! iMOAB id for rof instance on coupler for ocn ; it exists as a coverage mesh ! + ! mbrxoid ! iMOAB id for rof instance on coupler for ocn ; it exists as a coverage mesh, it receives data from ocean ! after this, the sending of tags from rof pes to coupler pes will use the par comm graph, that has more precise info about ! how to get mpicomm for joint rof + coupler @@ -417,6 +417,9 @@ subroutine prep_rof_migrate_moab(infodata) call seq_comm_getData(ID_join,mpicom=mpicom_join) ! this is the joint comm between rof and coupler + ! should id_join be multiplied by 100 ? because it is not corresponding to the regular mbrxid , it is mbroxid + ! no need, because id_join is used now only to get the communicator + ! TODO understand better this ! we should do this only if ocn_present context_id = ocn(1)%cplcompid wgtIdef = 'map-from-file'//C_NULL_CHAR diff --git a/driver-moab/main/seq_frac_mct.F90 b/driver-moab/main/seq_frac_mct.F90 index af353af0cf74..c980f5215f14 100644 --- a/driver-moab/main/seq_frac_mct.F90 +++ b/driver-moab/main/seq_frac_mct.F90 @@ -172,6 +172,9 @@ module seq_frac_mct use seq_comm_mct, only : atm_pg_active ! flag if PG mesh instanced ! for tri grid, sameg_al would be false use seq_comm_mct, only : sameg_al ! same grid atm and land; used throughout, initialized in lnd_init + + use seq_comm_mct, only : mbrxid ! iMOAB id of moab rof migrated to coupler pes + use iMOAB, only : iMOAB_DefineTagStorage, iMOAB_SetDoubleTagStorage, & iMOAB_GetMeshInfo, iMOAB_SetDoubleTagStorageWithGid, iMOAB_WriteMesh @@ -488,6 +491,53 @@ subroutine seq_frac_init( infodata, & kr = mct_aVect_indexRa(fractions_r,"rfrac",perrWith=subName) kf = mct_aVect_indexRA(dom_r%data ,"frac" ,perrWith=subName) fractions_r%rAttr(kr,:) = dom_r%data%rAttr(kf,:) + ! fractions needs to be set on river grid (that has a mask ?) + ! copy from land code; we have on coupler the river instance that comes from river-ocean map + if (mbrxid .ge. 0 ) then ! // + ! set all to zero, and then modify rfrac + tagname = trim(fraclist_r)//C_NULL_CHAR ! 'lfrac:lfrin:rfrac' + tagtype = 1 ! dense, double + numco = 1 ! + ierr = iMOAB_DefineTagStorage(mbrxid, tagname, tagtype, numco, tagindex ) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in defining tags on rof phys mesh on cpl ' + call shr_sys_abort(subname//' ERROR in defining tags on rof phys mesh on cpl') + endif + ierr = iMOAB_GetMeshInfo ( mbrxid, nvert, nvise, nbl, nsurf, nvisBC ); + arrSize = 3 * nVert(1) ! there are 3 tags + allocate(tagValues(arrSize) ) + ent_type = 0 ! vertex type, rof is point cloud + tagValues = 0. + ierr = iMOAB_SetDoubleTagStorage ( mbrxid, tagname, arrSize , ent_type, tagValues) + deallocate(tagValues) + tagname = 'rfrac'//C_NULL_CHAR ! 'lfrin' + allocate(tagValues(lSize) ) + tagValues = dom_r%data%rAttr(kf,:) + kgg = mct_aVect_indexIA(dom_r%data ,"GlobGridNum" ,perrWith=subName) + allocate(GlobalIds(lSize)) + GlobalIds = dom_r%data%iAttr(kgg,:) + ! again, we are setting on the river instance that is also used for ocean coupling + ierr = iMOAB_SetDoubleTagStorageWithGid ( mbrxid, tagname, lSize , ent_type, tagValues, GlobalIds ) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in setting rfrac on rof ' + call shr_sys_abort(subname//' ERROR in setting rfrac on rof ') + endif + deallocate(GlobalIds) + deallocate(tagValues) + +#ifdef MOABDEBUG + ! debug test + + outfile = 'rofCplFr.h5m'//C_NULL_CHAR + wopts = ';PARALLEL=WRITE_PART'//C_NULL_CHAR + ! write out the mesh file to disk + ierr = iMOAB_WriteMesh(mbrxid, trim(outfile), trim(wopts)) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in writing mesh ' + call shr_sys_abort(subname//' ERROR in writing mesh ') + endif +#endif + endif end if ! Initialize fractions on wav grid decomp, just an initial "guess", updated later @@ -515,8 +565,18 @@ subroutine seq_frac_init( infodata, & call mct_aVect_init(fractions_i,rList=fraclist_i,lsize=lsize) call mct_aVect_zero(fractions_i) - if (mphaxid .ge. 0 ) then ! // - tagname = trim(fraclist_i)//C_NULL_CHAR + + ko = mct_aVect_indexRa(fractions_i,"ofrac",perrWith=subName) + kf = mct_aVect_indexRA(dom_i%data ,"frac" ,perrWith=subName) + fractions_i%rAttr(ko,:) = dom_i%data%rAttr(kf,:) + + if (atm_present) then + mapper_i2a => prep_atm_get_mapper_Fi2a() + call seq_map_map(mapper_i2a,fractions_i,fractions_a,fldlist='ofrac',norm=.false.) + endif + + if (mbixid .ge. 0 ) then ! // + tagname = trim(fraclist_i)//C_NULL_CHAR ! 'afrac:ifrac:ofrac' tagtype = 1 ! dense, double numco = 1 ! ierr = iMOAB_DefineTagStorage(mbixid, tagname, tagtype, numco, tagindex ) @@ -524,17 +584,45 @@ subroutine seq_frac_init( infodata, & write(logunit,*) subname,' error in defining tags on ice phys mesh on cpl ' call shr_sys_abort(subname//' ERROR in defining tags on ice phys mesh on cpl') endif - - endif + ! start copy from rof + ierr = iMOAB_GetMeshInfo ( mbixid, nvert, nvise, nbl, nsurf, nvisBC ); + arrSize = 3 * nvise(1) ! there are 3 tags 'afrac:ifrac:ofrac' + allocate(tagValues(arrSize) ) + ent_type = 1 ! cell type, ice is FV + tagValues = 0. + ierr = iMOAB_SetDoubleTagStorage ( mbixid, tagname, arrSize , ent_type, tagValues) + deallocate(tagValues) + tagname = 'ofrac'//C_NULL_CHAR ! 'lfrin' + allocate(tagValues(lSize) ) + tagValues = dom_i%data%rAttr(kf,:) + kgg = mct_aVect_indexIA(dom_i%data ,"GlobGridNum" ,perrWith=subName) + allocate(GlobalIds(lSize)) + GlobalIds = dom_i%data%iAttr(kgg,:) - ko = mct_aVect_indexRa(fractions_i,"ofrac",perrWith=subName) - kf = mct_aVect_indexRA(dom_i%data ,"frac" ,perrWith=subName) - fractions_i%rAttr(ko,:) = dom_i%data%rAttr(kf,:) + ierr = iMOAB_SetDoubleTagStorageWithGid ( mbixid, tagname, lSize , ent_type, tagValues, GlobalIds ) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in setting ofrac on ice ' + call shr_sys_abort(subname//' ERROR in setting ofrac on ice ') + endif + deallocate(GlobalIds) + deallocate(tagValues) + ! TODO : project ice ofrac to atm , using the mapper i2a in MOAB (that we do not have yet) - if (atm_present) then - mapper_i2a => prep_atm_get_mapper_Fi2a() - call seq_map_map(mapper_i2a,fractions_i,fractions_a,fldlist='ofrac',norm=.false.) +#ifdef MOABDEBUG + ! debug test + + outfile = 'iceCplFr.h5m'//C_NULL_CHAR + wopts = ';PARALLEL=WRITE_PART'//C_NULL_CHAR + ! write out the mesh file to disk + ierr = iMOAB_WriteMesh(mbixid, trim(outfile), trim(wopts)) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in writing mesh ' + call shr_sys_abort(subname//' ERROR in writing mesh ') + endif +#endif + ! end copy from rof endif + end if ! Initialize fractions on ocean grid/decomp (initialize ice fraction to zero) @@ -547,7 +635,7 @@ subroutine seq_frac_init( infodata, & ! initialize ocn imoab app on mct grid call expose_mct_grid_moab(ocn, mbox2id) ! will use then to set the data on it , for debugging if (mboxid .ge. 0 ) then ! // - tagname = trim(fraclist_o)//C_NULL_CHAR + tagname = trim(fraclist_o)//C_NULL_CHAR ! 'afrac:ifrac:ofrac:ifrad:ofrad' tagtype = 1 ! dense, double numco = 1 ! ierr = iMOAB_DefineTagStorage(mboxid, tagname, tagtype, numco, tagindex ) @@ -555,11 +643,39 @@ subroutine seq_frac_init( infodata, & write(logunit,*) subname,' error in defining tags on ocn phys mesh on cpl ' call shr_sys_abort(subname//' ERROR in defining tags on ocn phys mesh on cpl') endif + ierr = iMOAB_GetMeshInfo ( mboxid, nvert, nvise, nbl, nsurf, nvisBC ); + arrSize = 5 * nvise(1) ! there are 5 tags 'afrac:ifrac:ofrac:ifrad:ofrad' + allocate(tagValues(arrSize) ) + ent_type = 1 ! cell type, ocn is FV + tagValues = 0. + ierr = iMOAB_SetDoubleTagStorage ( mboxid, tagname, arrSize , ent_type, tagValues) + deallocate(tagValues) + endif if (ice_present) then mapper_i2o => prep_ocn_get_mapper_SFi2o() call seq_map_map(mapper_i2o,fractions_i,fractions_o,fldlist='ofrac',norm=.false.) + ! we can use the same logic as for ofrac on fractions_i, because ice and ocn is the same mesh + if (mboxid .ge. 0 ) then ! + ! we are using data from ofrac freom ice mesh !!!! + lSize = mct_aVect_lSize(dom_i%data) + tagname = 'ofrac'//C_NULL_CHAR ! 'lfrin' + allocate(tagValues(lSize) ) + tagValues = dom_i%data%rAttr(kf,:) + kgg = mct_aVect_indexIA(dom_i%data ,"GlobGridNum" ,perrWith=subName) + allocate(GlobalIds(lSize)) + GlobalIds = dom_i%data%iAttr(kgg,:) + + ierr = iMOAB_SetDoubleTagStorageWithGid ( mboxid, tagname, lSize , ent_type, tagValues, GlobalIds ) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in setting ofrac on ocn from ice ' + call shr_sys_abort(subname//' ERROR in setting ofrac on ocn from ice ') + endif + deallocate(GlobalIds) + deallocate(tagValues) + endif else + ! stil need to TODO moab case ko = mct_aVect_indexRa(fractions_o,"ofrac",perrWith=subName) kf = mct_aVect_indexRA(dom_o%data ,"frac" ,perrWith=subName) fractions_o%rAttr(ko,:) = dom_o%data%rAttr(kf,:) @@ -570,7 +686,24 @@ subroutine seq_frac_init( infodata, & if (atm_present) then mapper_a2o => prep_ocn_get_mapper_Fa2o() call seq_map_map(mapper_a2o, fractions_a, fractions_o, fldlist='afrac',norm=.false.) + ! TODO moab projection using a2o moab map endif + + +#ifdef MOABDEBUG + ! debug test + if (mboxid .ge. 0 ) then + outfile = 'ocnCplFr.h5m'//C_NULL_CHAR + wopts = ';PARALLEL=WRITE_PART'//C_NULL_CHAR + ! write out the mesh file to disk + ierr = iMOAB_WriteMesh(mboxid, trim(outfile), trim(wopts)) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in writing mesh ' + call shr_sys_abort(subname//' ERROR in writing mesh ') + endif + endif +#endif + if (ice_present) then ! --- this should be an atm2ice call above, but atm2ice doesn't work mapper_o2i => prep_ice_get_mapper_SFo2i() From e5d2064ab7e107100c4f39e1c814d5be30360871 Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Fri, 2 Sep 2022 04:59:26 -0500 Subject: [PATCH 170/467] project fractions afrac from atm to ocean --- driver-moab/main/prep_ocn_mod.F90 | 32 ++++++++++++ driver-moab/main/seq_frac_mct.F90 | 87 ++++++++++++++++++++++++++++++- 2 files changed, 117 insertions(+), 2 deletions(-) diff --git a/driver-moab/main/prep_ocn_mod.F90 b/driver-moab/main/prep_ocn_mod.F90 index a731bc9b0dba..89992e32d59c 100644 --- a/driver-moab/main/prep_ocn_mod.F90 +++ b/driver-moab/main/prep_ocn_mod.F90 @@ -19,6 +19,7 @@ module prep_ocn_mod use seq_comm_mct, only : atm_pg_active ! whether the atm uses FV mesh or not ; made true if fv_nphys > 0 use seq_comm_mct, only : mbaxid ! iMOAB id for atm migrated mesh to coupler pes use seq_comm_mct, only : mbintxao ! iMOAB id for intx mesh between ocean and atmosphere; output from this + use seq_comm_mct, only : mphaxid ! iMOAB id for atm phys grid, on cpl pes; for atm_pg_active it will be the same as mbaxid use seq_comm_mct, only : mhid ! iMOAB id for atm instance use seq_comm_mct, only : mhpgid ! iMOAB id for atm pgx grid, on atm pes; created with se and gll grids use dimensions_mod, only : np ! for atmosphere degree @@ -1823,6 +1824,37 @@ subroutine prep_atm_ocn_moab(infodata) if (iamroot_CPLID) then write(logunit,*) 'finish iMOAB graph in atm-ocn prep ' end if + + ! compute a second comm graph, used in a 2 hop migration, between phis grid on coupler and intx ao on coupler, + ! so first atm fields will be migrated to coupler, and then in another hop, distributed to the processors that actually need the + ! those degrees of freedom + ! start copy + ! compute the comm graph between phys atm on coupler side and intx-atm-ocn, to be able to project in a second hop + ! from atm to ocean + + ! to project from atm to ocean, first send using this comm graph, then + ! apply weights (map); send from + if (iamroot_CPLID) then + ! mpicom_CPLID is a module local variable, already initialized + write(logunit,*) 'launch iMOAB computecommgraph with args ', & + mphaxid, mbintxao, mpicom_CPLID, mpigrp_CPLID, mpigrp_CPLID, & + typeA, typeB, id_join, idintx + end if + ! for these to work, we need to define the tags of size 16 (np x np) on coupler atm, + ! corresponding to this phys grid graph + if (mphaxid .ge. 0) then + ierr = iMOAB_ComputeCommGraph( mphaxid, mbintxao, mpicom_CPLID, mpigrp_CPLID, mpigrp_CPLID, & + typeA, typeB, id_join, idintx) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in computing graph phys grid - atm/ocn intx ' + call shr_sys_abort(subname//' ERROR in computing graph phys grid - atm/ocn intx ') + endif + if (iamroot_CPLID) then + write(logunit,*) 'finish iMOAB graph in atm-ocn prep ' + end if + endif + + ! end copy end subroutine prep_atm_ocn_moab subroutine prep_ice_ocn_moab(infodata) diff --git a/driver-moab/main/seq_frac_mct.F90 b/driver-moab/main/seq_frac_mct.F90 index c980f5215f14..5e79eacad785 100644 --- a/driver-moab/main/seq_frac_mct.F90 +++ b/driver-moab/main/seq_frac_mct.F90 @@ -164,19 +164,22 @@ module seq_frac_mct use iMOAB, only: iMOAB_DefineTagStorage use seq_comm_mct, only : mphaxid ! iMOAB app id for phys atm, on cpl pes + use seq_comm_mct, only : mbaxid ! iMOAB id for atm migrated mesh to coupler pes (for spectral, different than mphaxid) use seq_comm_mct, only : mblxid ! iMOAB app id for lnd on cpl pes use seq_comm_mct, only : mblx2id ! iMOAB id for land mesh instanced from MCT on coupler pes use seq_comm_mct, only : mbox2id ! iMOAB id for ocn mesh instanced from MCT on coupler pes use seq_comm_mct, only : mboxid ! iMOAB app id for ocn on cpl pes use seq_comm_mct, only : mbixid ! iMOAB for sea-ice migrated to coupler use seq_comm_mct, only : atm_pg_active ! flag if PG mesh instanced + use seq_comm_mct, only : mbintxao ! iMOAB id for intx mesh between ocean and atmosphere ! for tri grid, sameg_al would be false use seq_comm_mct, only : sameg_al ! same grid atm and land; used throughout, initialized in lnd_init use seq_comm_mct, only : mbrxid ! iMOAB id of moab rof migrated to coupler pes use iMOAB, only : iMOAB_DefineTagStorage, iMOAB_SetDoubleTagStorage, & - iMOAB_GetMeshInfo, iMOAB_SetDoubleTagStorageWithGid, iMOAB_WriteMesh + iMOAB_GetMeshInfo, iMOAB_SetDoubleTagStorageWithGid, iMOAB_WriteMesh, & + iMOAB_ApplyScalarProjectionWeights, iMOAB_SendElementTag, iMOAB_ReceiveElementTag use shr_kind_mod, only: CL => SHR_KIND_CL, CX => SHR_KIND_CX, CXX => SHR_KIND_CXX use iso_c_binding ! C_NULL_CHAR @@ -312,11 +315,15 @@ subroutine seq_frac_init( infodata, & ! moab integer :: tagtype, numco, tagindex, ent_type, ierr, arrSize - character(CXX) :: tagname + character(CXX) :: tagname, tagNameExt + character*32 :: wgtIdef real(r8), allocatable :: tagValues(:) ! used for setting some default tags integer , allocatable :: GlobalIds(:) ! used for setting values associated with ids integer nvert(3), nvise(3), nbl(3), nsurf(3), nvisBC(3) integer kgg ! index in global number attribute, used for global id in MOAB + integer idintx ! used for context for intx atm - ocn + integer id_join ! used for example for atm%cplcompid + integer :: mpicom ! we are on coupler PES here character(30) :: outfile, wopts !----- formats ----- @@ -392,6 +399,15 @@ subroutine seq_frac_init( infodata, & call shr_sys_abort(subname//' ERROR in setting afrac tag on phys atm') endif deallocate(tagValues) +#ifdef MOABDEBUG + outfile = 'atmCplFr.h5m'//C_NULL_CHAR + wopts = ';PARALLEL=WRITE_PART'//C_NULL_CHAR + ierr = iMOAB_WriteMesh(mphaxid, trim(outfile), trim(wopts)) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in writing mesh ' + call shr_sys_abort(subname//' ERROR in writing mesh ') + endif +#endif endif endif @@ -686,7 +702,74 @@ subroutine seq_frac_init( infodata, & if (atm_present) then mapper_a2o => prep_ocn_get_mapper_Fa2o() call seq_map_map(mapper_a2o, fractions_a, fractions_o, fldlist='afrac',norm=.false.) + ! TODO moab projection using a2o moab map + ! first, send the field to atm on coupler + ! actually, afrac is 1 on all cells on mphaxid ; we need to project it to ocn + ! if on spectral mesh, we need to send it + ! afrac ext tag that is not defined yet ? + idintx = 100*atm%cplcompid + ocn%cplcompid ! something different, to differentiate it; ~ 618 ! + mpicom = seq_comm_mpicom(CPLID) ! + tagName = 'afrac'//C_NULL_CHAR + tagNameExt = 'afrac_ext'//C_NULL_CHAR + if (.not. atm_pg_active) then + tagtype = 1 ! dense, double + numco = 16 ! special case + ierr = iMOAB_DefineTagStorage(mbaxid, tagNameExt, tagtype, numco, tagindex ) + ! also, set it to 1.0, 16 times per cell + if (ierr .ne. 0) then + write(logunit,*) subname,' error in defining the afrac_ext tag ' + call shr_sys_abort(subname//' ERROR in setting ofrac_ext tag ') + endif + ierr = iMOAB_GetMeshInfo ( mbaxid, nvert, nvise, nbl, nsurf, nvisBC ); + arrSize = nvise(1)*16 ! this assumes always np = 4 + allocate(tagValues(arrSize) ) + tagValues = 1.0 + ent_type = 1 ! cells, actually spectral quads + ierr = iMOAB_SetDoubleTagStorage ( mbaxid, tagNameExt, arrSize , ent_type, tagValues) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in setting the afrac_ext tag ' + call shr_sys_abort(subname//' ERROR in setting ofracc_ext tag ') + endif + endif + ! we have to send towards the coverage, because local mesh is not "covering" the target + ! we have to use the graph computed at the end of prep_atm_ocn_moab + ! if (mphaxid .ge. 0) then + ! ierr = iMOAB_ComputeCommGraph( mphaxid, mbintxao, mpicom_CPLID, mpigrp_CPLID, mpigrp_CPLID, & + ! typeA, typeB, id_join, idintx) + if ((mphaxid .ge. 0) .and. (mbintxao .ge. 0)) then + id_join = atm%cplcompid ! atm cpl ext id for moab (6) + ierr = iMOAB_SendElementTag(mphaxid, tagName, mpicom, idintx) ! context is intx ao + if (ierr .ne. 0) then + write(logunit,*) subname,' error in sending afrac tag ' + call shr_sys_abort(subname//' ERROR in sending afrac tag ') + endif + ! now project to ocean grid; first receive, then project + wgtIdef = 'scalar'//C_NULL_CHAR + if (atm_pg_active) then + ierr = iMOAB_ReceiveElementTag(mbintxao, tagName, mpicom, id_join) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in receiving afrac tag ' + call shr_sys_abort(subname//' ERROR in receiving afrac tag ') + endif + ierr = iMOAB_ApplyScalarProjectionWeights ( mbintxao, wgtIdef, tagName, tagName) + + else + ierr = iMOAB_ReceiveElementTag(mbintxao, tagNameExt, mpicom, id_join) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in receiving afrac_ext tag ' + call shr_sys_abort(subname//' ERROR in receiving afrac_ext tag ') + endif + ierr = iMOAB_ApplyScalarProjectionWeights ( mbintxao, wgtIdef, tagNameExt, tagName) + endif + if (ierr .ne. 0) then + write(logunit,*) subname,' error in applying weights for afrac on ocean calculation' + call shr_sys_abort(subname//' ERROR in applying weights') + endif + + endif + + endif From 741c2df44854c85c5f1a9dcf29996061b6f1d5f5 Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Fri, 2 Sep 2022 22:33:53 -0500 Subject: [PATCH 171/467] phys grid atm is always point cloud even if it is pg2 mesh; pg2 mesh is used only for FV-FV intersection --- driver-moab/main/cplcomp_exchange_mod.F90 | 162 +++++++++++----------- driver-moab/main/seq_frac_mct.F90 | 1 - 2 files changed, 78 insertions(+), 85 deletions(-) diff --git a/driver-moab/main/cplcomp_exchange_mod.F90 b/driver-moab/main/cplcomp_exchange_mod.F90 index 9328d3be735b..82dfb7795927 100644 --- a/driver-moab/main/cplcomp_exchange_mod.F90 +++ b/driver-moab/main/cplcomp_exchange_mod.F90 @@ -1061,44 +1061,44 @@ subroutine cplcomp_moab_Init(comp) ! now, if on coupler pes, receive mesh; if on comp pes, send mesh if (MPI_COMM_NULL /= mpicom_old ) then ! it means we are on the component pes (atmosphere) ! send mesh to coupler - if (atm_pg_active) then ! change : send the pg2 mesh, not coarse mesh, when atm pg active - ierr = iMOAB_SendMesh(mhpgid, mpicom_join, mpigrp_cplid, id_join, partMethod) - else - ! still use the mhid, original coarse mesh - ierr = iMOAB_SendMesh(mhid, mpicom_join, mpigrp_cplid, id_join, partMethod) - endif - if (ierr .ne. 0) then - write(logunit,*) subname,' error in sending mesh from atm comp ' - call shr_sys_abort(subname//' ERROR in sending mesh from atm comp') - endif + if (atm_pg_active) then ! change : send the pg2 mesh, not coarse mesh, when atm pg active + ierr = iMOAB_SendMesh(mhpgid, mpicom_join, mpigrp_cplid, id_join, partMethod) + else + ! still use the mhid, original coarse mesh + ierr = iMOAB_SendMesh(mhid, mpicom_join, mpigrp_cplid, id_join, partMethod) + endif + if (ierr .ne. 0) then + write(logunit,*) subname,' error in sending mesh from atm comp ' + call shr_sys_abort(subname//' ERROR in sending mesh from atm comp') + endif endif if (MPI_COMM_NULL /= mpicom_new ) then ! we are on the coupler pes - appname = "COUPLE_ATM"//C_NULL_CHAR - ! migrated mesh gets another app id, moab atm to coupler (mbax) - ierr = iMOAB_RegisterApplication(trim(appname), mpicom_new, id_join, mbaxid) - if (ierr .ne. 0) then - write(logunit,*) subname,' error in registering ', appname - call shr_sys_abort(subname//' ERROR registering '// appname) - endif - ierr = iMOAB_ReceiveMesh(mbaxid, mpicom_join, mpigrp_old, id_old) - if (ierr .ne. 0) then - write(logunit,*) subname,' error in receiving mesh on atm coupler ' - call shr_sys_abort(subname//' ERROR in receiving mesh on atm coupler ') - endif + appname = "COUPLE_ATM"//C_NULL_CHAR + ! migrated mesh gets another app id, moab atm to coupler (mbax) + ierr = iMOAB_RegisterApplication(trim(appname), mpicom_new, id_join, mbaxid) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in registering ', appname + call shr_sys_abort(subname//' ERROR registering '// appname) + endif + ierr = iMOAB_ReceiveMesh(mbaxid, mpicom_join, mpigrp_old, id_old) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in receiving mesh on atm coupler ' + call shr_sys_abort(subname//' ERROR in receiving mesh on atm coupler ') + endif #ifdef MOABDEBUG - ! debug test - if (atm_pg_active) then ! - outfile = 'recMeshAtmPG.h5m'//C_NULL_CHAR - else - outfile = 'recMeshAtm.h5m'//C_NULL_CHAR - endif - wopts = ';PARALLEL=WRITE_PART'//C_NULL_CHAR - ! write out the mesh file to disk - ierr = iMOAB_WriteMesh(mbaxid, trim(outfile), trim(wopts)) - if (ierr .ne. 0) then - write(logunit,*) subname,' error in writing mesh ' - call shr_sys_abort(subname//' ERROR in writing mesh ') - endif + ! debug test + if (atm_pg_active) then ! + outfile = 'recMeshAtmPG.h5m'//C_NULL_CHAR + else + outfile = 'recMeshAtm.h5m'//C_NULL_CHAR + endif + wopts = ';PARALLEL=WRITE_PART'//C_NULL_CHAR + ! write out the mesh file to disk + ierr = iMOAB_WriteMesh(mbaxid, trim(outfile), trim(wopts)) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in writing mesh ' + call shr_sys_abort(subname//' ERROR in writing mesh ') + endif #endif endif ! iMOAB_FreeSenderBuffers needs to be called after receiving the mesh @@ -1106,24 +1106,19 @@ subroutine cplcomp_moab_Init(comp) if (mhid .ge. 0) then ! we are on component atm pes context_id = id_join if (atm_pg_active) then! we send mesh from mhpgid app - ierr = iMOAB_FreeSenderBuffers(mhpgid, context_id) + ierr = iMOAB_FreeSenderBuffers(mhpgid, context_id) else - ierr = iMOAB_FreeSenderBuffers(mhid, context_id) + ierr = iMOAB_FreeSenderBuffers(mhid, context_id) endif if (ierr .ne. 0) then - write(logunit,*) subname,' error in freeing send buffers ' - call shr_sys_abort(subname//' ERROR in freeing send buffers') - endif + write(logunit,*) subname,' error in freeing send buffers ' + call shr_sys_abort(subname//' ERROR in freeing send buffers') + endif endif ! send also the phys grid to coupler, because it will be used for fractions ! start copy for mphaid->mphaxid if (MPI_COMM_NULL /= mpicom_old ) then ! it means we are on the component pes (atmosphere) - ! send mesh to coupler - if (atm_pg_active) then ! do not send again, mbaxid will be the same as mphaxid - mphaxid = mbaxid ! we already have pg mesh on coupler, as an FV mesh - else - ! still use the mhid, original coarse mesh ID_JOIN_ATMPHYS = id_join + 200 ! somewhat arbitrary, just a different comp id ierr = iMOAB_SendMesh(mphaid, mpicom_join, mpigrp_cplid, ID_JOIN_ATMPHYS, partMethod) if (ierr .ne. 0) then @@ -1132,46 +1127,45 @@ subroutine cplcomp_moab_Init(comp) endif endif - endif - if (MPI_COMM_NULL /= mpicom_new .and. .not. atm_pg_active ) then ! we are on the coupler pes - - appname = "COUPLE_ATMPH"//C_NULL_CHAR - ! migrated mesh gets another app id, moab atm to coupler (mbax) - ID_JOIN_ATMPHYS = id_join + 200 ! somewhat arbitrary, just a different comp id - ierr = iMOAB_RegisterApplication(trim(appname), mpicom_new, ID_JOIN_ATMPHYS, mphaxid) - if (ierr .ne. 0) then - write(logunit,*) subname,' error in registering ', appname - call shr_sys_abort(subname//' ERROR registering '// appname) - endif - ID_OLD_ATMPHYS = id_old + 200 ! kind of arbitrary - ierr = iMOAB_ReceiveMesh(mphaxid, mpicom_join, mpigrp_old, ID_OLD_ATMPHYS) - if (ierr .ne. 0) then - write(logunit,*) subname,' error in receiving mesh on atm coupler ' - call shr_sys_abort(subname//' ERROR in receiving mesh on atm coupler ') - endif + if (MPI_COMM_NULL /= mpicom_new ) then ! we are on the coupler pes + appname = "COUPLE_ATMPH"//C_NULL_CHAR + ! migrated mesh gets another app id, moab atm to coupler (mbax) + ID_JOIN_ATMPHYS = id_join + 200 ! somewhat arbitrary, just a different comp id + ierr = iMOAB_RegisterApplication(trim(appname), mpicom_new, ID_JOIN_ATMPHYS, mphaxid) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in registering ', appname + call shr_sys_abort(subname//' ERROR registering '// appname) + endif + ID_OLD_ATMPHYS = id_old + 200 ! kind of arbitrary + ierr = iMOAB_ReceiveMesh(mphaxid, mpicom_join, mpigrp_old, ID_OLD_ATMPHYS) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in receiving mesh on atm coupler ' + call shr_sys_abort(subname//' ERROR in receiving mesh on atm coupler ') + endif #ifdef MOABDEBUG - ! debug test - - outfile = 'recPhysAtm.h5m'//C_NULL_CHAR - wopts = ';PARALLEL=WRITE_PART'//C_NULL_CHAR - ! write out the mesh file to disk - ierr = iMOAB_WriteMesh(mphaxid, trim(outfile), trim(wopts)) - if (ierr .ne. 0) then - write(logunit,*) subname,' error in writing mesh ' - call shr_sys_abort(subname//' ERROR in writing mesh ') - endif + ! debug test + + outfile = 'recPhysAtm.h5m'//C_NULL_CHAR + wopts = ';PARALLEL=WRITE_PART'//C_NULL_CHAR + ! write out the mesh file to disk + ierr = iMOAB_WriteMesh(mphaxid, trim(outfile), trim(wopts)) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in writing mesh ' + call shr_sys_abort(subname//' ERROR in writing mesh ') + endif #endif endif ! iMOAB_FreeSenderBuffers needs to be called after receiving the mesh - if (MPI_COMM_NULL /= mpicom_old .and. .not. atm_pg_active) then ! it means we are on the component pes (atmosphere) + if (MPI_COMM_NULL /= mpicom_old ) then ! it means we are on the component pes (atmosphere) context_id = ID_JOIN_ATMPHYS ierr = iMOAB_FreeSenderBuffers(mphaid, context_id) if (ierr .ne. 0) then - write(logunit,*) subname,' error in freeing send buffers ' - call shr_sys_abort(subname//' ERROR in freeing send buffers') - endif + write(logunit,*) subname,' error in freeing send buffers ' + call shr_sys_abort(subname//' ERROR in freeing send buffers') + endif endif + ! comment out now; we will not send directly to atm spectral on coupler; we need to send in the @@ -1196,14 +1190,14 @@ subroutine cplcomp_moab_Init(comp) ! we can receive those tags only on coupler pes, when mbaxid exists ! we have to check that before we can define the tag if (mbaxid .ge. 0 .and. .not. (atm_pg_active) ) then - tagname = trim(seq_flds_a2x_ext_fields)//C_NULL_CHAR - tagtype = 1 ! dense, double - numco = np*np ! usually 16 values per cell, GLL points; should be 4 x 4 = 16 - ierr = iMOAB_DefineTagStorage(mbaxid, tagname, tagtype, numco, tagindex ) - if (ierr .ne. 0) then - write(logunit,*) subname,' error in defining tags ' - call shr_sys_abort(subname//' ERROR in defining tags ') - endif + tagname = trim(seq_flds_a2x_ext_fields)//C_NULL_CHAR + tagtype = 1 ! dense, double + numco = np*np ! usually 16 values per cell, GLL points; should be 4 x 4 = 16 + ierr = iMOAB_DefineTagStorage(mbaxid, tagname, tagtype, numco, tagindex ) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in defining tags ' + call shr_sys_abort(subname//' ERROR in defining tags ') + endif endif endif ! ocean diff --git a/driver-moab/main/seq_frac_mct.F90 b/driver-moab/main/seq_frac_mct.F90 index 5e79eacad785..949ff2daf9dd 100644 --- a/driver-moab/main/seq_frac_mct.F90 +++ b/driver-moab/main/seq_frac_mct.F90 @@ -383,7 +383,6 @@ subroutine seq_frac_init( infodata, & arrSize = nvert(1) * 5 ! there are 5 tags that need to be zeroed out allocate(tagValues(arrSize) ) ent_type = 0 ! vertex type - if (atm_pg_active) ent_type = 1 ! cells type then tagValues = 0 ierr = iMOAB_SetDoubleTagStorage ( mphaxid, tagname, arrSize , ent_type, tagValues) if (ierr .ne. 0) then From 5f9c9393bdec2ca26859c9fbb98dc7e27c005ab3 Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Sat, 3 Sep 2022 23:03:15 -0500 Subject: [PATCH 172/467] introduce ocn atm intx too move the intx atm ocn to prep_ocn module create intx ocn - atm in prep_atm module --- driver-moab/main/prep_atm_mod.F90 | 23 +++++++++-------- driver-moab/main/prep_ocn_mod.F90 | 43 ++++++++++++++++++++++++++++--- driver-moab/shr/seq_comm_mct.F90 | 6 +++-- 3 files changed, 56 insertions(+), 16 deletions(-) diff --git a/driver-moab/main/prep_atm_mod.F90 b/driver-moab/main/prep_atm_mod.F90 index 1b17169616a1..3c3d79c7dc55 100644 --- a/driver-moab/main/prep_atm_mod.F90 +++ b/driver-moab/main/prep_atm_mod.F90 @@ -22,7 +22,8 @@ module prep_atm_mod use seq_comm_mct, only : mbaxid ! iMOAB id for atm migrated mesh to coupler pes use seq_comm_mct, only : mphaid ! iMOAB id for phys atm on atm pes use seq_comm_mct, only : mboxid ! iMOAB id for mpas ocean migrated mesh to coupler pes - use seq_comm_mct, only : mbintxao ! iMOAB id for intx mesh between ocean and atmosphere; output from this + use seq_comm_mct, only : mbintxoa ! iMOAB id for intx mesh between ocean and atmosphere + use seq_comm_mct, only : mbintxao ! iMOAB id for intx mesh between atm and ocean use seq_comm_mct, only : mhid ! iMOAB id for atm instance use seq_comm_mct, only : mhpgid ! iMOAB id for atm pgx grid, on atm pes; created with se and gll grids use seq_comm_mct, only : atm_pg_active ! whether the atm uses FV mesh or not ; made true if fv_nphys > 0 @@ -194,29 +195,29 @@ subroutine prep_atm_init(infodata, ocn_c2_atm, ice_c2_atm, lnd_c2_atm, iac_c2_at ! Call moab intx only if atm and ocn are init in moab if ((mbaxid .ge. 0) .and. (mboxid .ge. 0)) then - appname = "ATM_OCN_COU"//C_NULL_CHAR - ! idintx is a unique number of MOAB app that takes care of intx between ocn and atm mesh - idintx = 100*atm(1)%cplcompid + ocn(1)%cplcompid ! something different, to differentiate it - ierr = iMOAB_RegisterApplication(trim(appname), mpicom_CPLID, idintx, mbintxao) + appname = "OCN_ATM_COU"//C_NULL_CHAR + ! idintx is a unique number of MOAB app that takes care of intx between atm and ocn mesh + idintx = 100*ocn(1)%cplcompid + atm(1)%cplcompid ! something different, to differentiate it + ierr = iMOAB_RegisterApplication(trim(appname), mpicom_CPLID, idintx, mbintxoa) if (ierr .ne. 0) then write(logunit,*) subname,' error in registering atm ocn intx' call shr_sys_abort(subname//' ERROR in registering atm ocn intx') endif - ierr = iMOAB_ComputeMeshIntersectionOnSphere (mbaxid, mboxid, mbintxao) + ierr = iMOAB_ComputeMeshIntersectionOnSphere (mboxid, mbaxid, mbintxoa) if (ierr .ne. 0) then - write(logunit,*) subname,' error in computing atm ocn intx' - call shr_sys_abort(subname//' ERROR in computing atm ocn intx') + write(logunit,*) subname,' error in computing ocn atm intx' + call shr_sys_abort(subname//' ERROR in computing ocn atm intx') endif if (iamroot_CPLID) then - write(logunit,*) 'iMOAB intersection between atm and ocean with id:', idintx + write(logunit,*) 'iMOAB intersection between ocean and atm with id:', idintx end if #ifdef MOABDEBUG wopts = C_NULL_CHAR call shr_mpi_commrank( mpicom_CPLID, rank ) if (rank .lt. 5) then write(lnum,"(I0.2)")rank ! - outfile = 'intx'//trim(lnum)// '.h5m' // C_NULL_CHAR - ierr = iMOAB_WriteMesh(mbintxao, outfile, wopts) ! write local intx file + outfile = 'intx_oa_'//trim(lnum)// '.h5m' // C_NULL_CHAR + ierr = iMOAB_WriteMesh(mbintxoa, outfile, wopts) ! write local intx file if (ierr .ne. 0) then write(logunit,*) subname,' error in writing intx file ' call shr_sys_abort(subname//' ERROR in writing intx file ') diff --git a/driver-moab/main/prep_ocn_mod.F90 b/driver-moab/main/prep_ocn_mod.F90 index 89992e32d59c..ebf094f5b214 100644 --- a/driver-moab/main/prep_ocn_mod.F90 +++ b/driver-moab/main/prep_ocn_mod.F90 @@ -18,8 +18,9 @@ module prep_ocn_mod use seq_comm_mct, only: mbrxoid ! iMOAB id for rof on coupler in ocean context; use seq_comm_mct, only : atm_pg_active ! whether the atm uses FV mesh or not ; made true if fv_nphys > 0 use seq_comm_mct, only : mbaxid ! iMOAB id for atm migrated mesh to coupler pes - use seq_comm_mct, only : mbintxao ! iMOAB id for intx mesh between ocean and atmosphere; output from this - use seq_comm_mct, only : mphaxid ! iMOAB id for atm phys grid, on cpl pes; for atm_pg_active it will be the same as mbaxid + use seq_comm_mct, only : mbintxao ! iMOAB id for intx mesh between atm and ocean + use seq_comm_mct, only : mbintxoa ! iMOAB id for intx mesh between ocean and atmosphere + use seq_comm_mct, only : mphaxid ! iMOAB id for atm phys grid, on cpl pes; it is a point cloud always use seq_comm_mct, only : mhid ! iMOAB id for atm instance use seq_comm_mct, only : mhpgid ! iMOAB id for atm pgx grid, on atm pes; created with se and gll grids use dimensions_mod, only : np ! for atmosphere degree @@ -151,7 +152,8 @@ module prep_ocn_mod subroutine prep_ocn_init(infodata, atm_c2_ocn, atm_c2_ice, ice_c2_ocn, rof_c2_ocn, & wav_c2_ocn, glc_c2_ocn, glcshelf_c2_ocn) - use iMOAB, only: iMOAB_RegisterApplication + use iMOAB, only: iMOAB_ComputeMeshIntersectionOnSphere, iMOAB_RegisterApplication, & + iMOAB_WriteMesh !--------------------------------------------------------------- ! Description ! Initialize module attribute vectors and all other non-mapping @@ -194,6 +196,8 @@ subroutine prep_ocn_init(infodata, atm_c2_ocn, atm_c2_ice, ice_c2_ocn, rof_c2_oc character*32 :: appname ! to register moab app integer :: rmapid ! external id to identify the moab app integer :: ierr, type_grid ! + integer :: idintx, rank + character*32 :: outfile, wopts, lnum !--------------------------------------------------------------- @@ -303,6 +307,39 @@ subroutine prep_ocn_init(infodata, atm_c2_ocn, atm_c2_ice, ice_c2_ocn, rof_c2_oc 'seq_maps.rc','atm2ocn_fmapname:','atm2ocn_fmaptype:',samegrid_ao, & 'mapper_Fa2o initialization',esmf_map_flag) call shr_sys_flush(logunit) + ! Call moab intx only if atm and ocn are init in moab + if ((mbaxid .ge. 0) .and. (mboxid .ge. 0)) then + appname = "ATM_OCN_COU"//C_NULL_CHAR + ! idintx is a unique number of MOAB app that takes care of intx between ocn and atm mesh + idintx = 100*atm(1)%cplcompid + ocn(1)%cplcompid ! something different, to differentiate it + ierr = iMOAB_RegisterApplication(trim(appname), mpicom_CPLID, idintx, mbintxao) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in registering atm ocn intx' + call shr_sys_abort(subname//' ERROR in registering atm ocn intx') + endif + ierr = iMOAB_ComputeMeshIntersectionOnSphere (mbaxid, mboxid, mbintxao) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in computing atm ocn intx' + call shr_sys_abort(subname//' ERROR in computing atm ocn intx') + endif + if (iamroot_CPLID) then + write(logunit,*) 'iMOAB intersection between atm and ocean with id:', idintx + end if +#ifdef MOABDEBUG + wopts = C_NULL_CHAR + call shr_mpi_commrank( mpicom_CPLID, rank ) + if (rank .lt. 5) then + write(lnum,"(I0.2)")rank ! + outfile = 'intx_ao_'//trim(lnum)// '.h5m' // C_NULL_CHAR + ierr = iMOAB_WriteMesh(mbintxao, outfile, wopts) ! write local intx file + if (ierr .ne. 0) then + write(logunit,*) subname,' error in writing intx file ' + call shr_sys_abort(subname//' ERROR in writing intx file ') + endif + endif +#endif + end if + end if ! atm_c2_ice flag is here because ice and ocn are constrained to be on the same diff --git a/driver-moab/shr/seq_comm_mct.F90 b/driver-moab/shr/seq_comm_mct.F90 index 1e9a66c299d4..b65d4a780b4c 100644 --- a/driver-moab/shr/seq_comm_mct.F90 +++ b/driver-moab/shr/seq_comm_mct.F90 @@ -218,11 +218,12 @@ module seq_comm_mct integer, public :: mhpgid ! iMOAB id for atm pgx grid, on atm pes; created with se and gll grids logical, public :: atm_pg_active = .false. ! whether the atm uses FV mesh or not ; made true if fv_nphys > 0 integer, public :: mphaid ! iMOAB id for atm phys grid, on atm pes - integer, public :: mphaxid ! iMOAB id for atm phys grid, on cpl pes; for atm_pg_active it will be the same as mbaxid - integer, public :: mbaxid ! iMOAB id for atm migrated mesh to coupler pes + integer, public :: mphaxid ! iMOAB id for atm phys grid, on cpl pes; + integer, public :: mbaxid ! iMOAB id for atm migrated mesh to coupler pes (migrate either mhid or mhpgid, depending on atm_pg_active) integer, public :: mboxid ! iMOAB id for mpas ocean migrated mesh to coupler pes integer, public :: mbofxid ! iMOAB id for mpas ocean migrated mesh to coupler pes, just for xao flux calculations integer, public :: mbintxao ! iMOAB id for intx mesh between ocean and atmosphere + integer, public :: mbintxoa ! iMOAB id for intx mesh between atmosphere and ocean integer, public :: mblxid ! iMOAB id for land mesh migrated to coupler pes integer, public :: mblx2id ! iMOAB id for land mesh instanced from MCT on coupler pes integer, public :: mbox2id ! iMOAB id for ocn mesh instanced from MCT on coupler pes @@ -634,6 +635,7 @@ subroutine seq_comm_init(global_comm_in, driver_comm_in, nmlfile, drv_comm_id) mboxid = -1 ! iMOAB id for mpas ocean migrated mesh to coupler pes mbofxid = -1 ! iMOAB id for second mpas ocean migrated mesh to coupler pes, for flux calculations mbintxao = -1 ! iMOAB id for atm intx with mpas ocean + mbintxoa = -1 ! iMOAB id for mpas ocean intx with atm mblxid = -1 ! iMOAB id for land on coupler pes mbox2id = -1 ! iMOAB id for ocn from mct on coupler pes mbintxla = -1 ! iMOAB id for land intx with atm on coupler pes From b0b1c6a80762706b6cf71fb844701762bfad054e Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Tue, 6 Sep 2022 13:52:39 -0500 Subject: [PATCH 173/467] add a more general migrate tag can be used for any component, and in any direction --- driver-moab/main/cime_comp_mod.F90 | 9 +- driver-moab/main/component_mod.F90 | 130 +++++++++++++++++++++++------ 2 files changed, 110 insertions(+), 29 deletions(-) diff --git a/driver-moab/main/cime_comp_mod.F90 b/driver-moab/main/cime_comp_mod.F90 index 0eec97a171bf..d359c405351a 100644 --- a/driver-moab/main/cime_comp_mod.F90 +++ b/driver-moab/main/cime_comp_mod.F90 @@ -169,9 +169,10 @@ module cime_comp_mod use component_mod, only: component_run, component_final use component_mod, only: component_init_areacor, component_init_aream use component_mod, only: component_exch, component_diag + use component_mod, only: component_exch_moab ! used to send from components to coupler instances - use component_mod, only: ocn_cpl_moab + ! use component_mod, only: ocn_cpl_moab ! prep routines (includes mapping routines between components and merging routines) use prep_lnd_mod @@ -4137,6 +4138,8 @@ end subroutine cime_run_ocn_setup_send subroutine cime_run_ocn_recv_post() + use seq_flds_mod , only : seq_flds_o2x_fields + use seq_comm_mct , only : mboxid, mpoid ! !---------------------------------------------------------- ! ocn -> cpl !---------------------------------------------------------- @@ -4147,7 +4150,9 @@ subroutine cime_run_ocn_recv_post() timer_barrier='CPL:O2CT_BARRIER', timer_comp_exch='CPL:O2CT', & timer_map_exch='CPL:o2c_ocno2ocnx', timer_infodata_exch='CPL:o2c_infoexch') ! send from ocn pes to coupler - call ocn_cpl_moab(ocn) + ! call ocn_cpl_moab(ocn) + ! new way + call component_exch_moab(ocn(1), mpoid, mboxid, 0, seq_flds_o2x_fields) endif !---------------------------------------------------------- diff --git a/driver-moab/main/component_mod.F90 b/driver-moab/main/component_mod.F90 index 0dd2f7aa15c2..51944e82d7cd 100644 --- a/driver-moab/main/component_mod.F90 +++ b/driver-moab/main/component_mod.F90 @@ -52,8 +52,9 @@ module component_mod public :: component_final ! mct and esmf versions public :: component_exch public :: component_diag + public :: component_exch_moab - public :: ocn_cpl_moab + ! public :: ocn_cpl_moab !-------------------------------------------------------------------------- @@ -966,13 +967,77 @@ subroutine component_diag(infodata, comp, flow, comment, info_debug, timer_diag end subroutine component_diag - subroutine ocn_cpl_moab(ocn) +! subroutine ocn_cpl_moab(ocn) + +! use seq_comm_mct , only : mboxid, mpoid ! +! use seq_flds_mod , only : seq_flds_o2x_fields +! use iMOAB , only: iMOAB_SendElementTag, iMOAB_ReceiveElementTag, iMOAB_WriteMesh, iMOAB_FreeSenderBuffers +! use seq_comm_mct, only : num_moab_exports ! for debugging +! use ISO_C_BINDING, only : C_NULL_CHAR +! !--------------------------------------------------------------- +! ! Description +! ! send tags from ocean component to coupler instance +! ! +! ! it involves initial ocn app; mpoid; also migrated ocn mesh mesh on coupler pes, mboxid +! ! the sending of tags from ocn pes to coupler pes will use initial graph/migrate + +! type(component_type) , intent(in) :: ocn(:) + +! integer :: id_join, ocnid1, context_id , ierr +! integer :: mpicom_join +! character(400) :: tagname +! character*100 outfile, wopts, lnum + +! ! how to get mpicomm for joint ocn + coupler +! id_join = ocn(1)%cplcompid +! ocnid1 = ocn(1)%compid +! call seq_comm_getinfo(ID_join,mpicom=mpicom_join) +! context_id = -1 +! ! +! tagName = trim(seq_flds_o2x_fields)//C_NULL_CHAR + +! if (mpoid .ge. 0) then ! send because we are on ocn pes + +! ! basically, use the initial partitioning +! context_id = id_join +! ierr = iMOAB_SendElementTag(mpoid, tagName, mpicom_join, context_id) + +! endif +! if ( mboxid .ge. 0 ) then ! we are on coupler pes, for sure +! ! receive on couper pes, +! context_id = ocnid1 +! ierr = iMOAB_ReceiveElementTag(mboxid, tagName, mpicom_join, context_id) +! ! !CHECKRC(ierr, "cannot receive tag values") +! endif + +! ! ! we can now free the sender buffers +! if (mpoid .ge. 0) then +! context_id = id_join +! ierr = iMOAB_FreeSenderBuffers(mpoid, context_id) +! ! ! CHECKRC(ierr, "cannot free buffers used to send projected tag towards the ocean mesh") +! endif + +! #ifdef MOABDEBUG +! if (mboxid .ge. 0 ) then ! we are on coupler pes, for sure +! ! number_proj = number_proj+1 ! count the number of projections +! write(lnum,"(I0.2)") num_moab_exports +! outfile = 'ocnCpl_'//trim(lnum)//'.h5m'//C_NULL_CHAR +! wopts = ';PARALLEL=WRITE_PART'//C_NULL_CHAR ! +! ierr = iMOAB_WriteMesh(mboxid, trim(outfile), trim(wopts)) - use seq_comm_mct , only : mboxid, mpoid ! - use seq_flds_mod , only : seq_flds_o2x_fields +! !CHECKRC(ierr, "cannot receive tag values") +! endif +! #endif + +! end subroutine ocn_cpl_moab + + subroutine component_exch_moab(comp, mbAPPid1, mbAppid2, direction, fields ) + + use iMOAB , only: iMOAB_SendElementTag, iMOAB_ReceiveElementTag, iMOAB_WriteMesh, iMOAB_FreeSenderBuffers use seq_comm_mct, only : num_moab_exports ! for debugging use ISO_C_BINDING, only : C_NULL_CHAR + use shr_kind_mod , only : CXX => shr_kind_CXX !--------------------------------------------------------------- ! Description ! send tags from ocean component to coupler instance @@ -980,53 +1045,64 @@ subroutine ocn_cpl_moab(ocn) ! it involves initial ocn app; mpoid; also migrated ocn mesh mesh on coupler pes, mboxid ! the sending of tags from ocn pes to coupler pes will use initial graph/migrate - type(component_type) , intent(in) :: ocn(:) + type(component_type) , intent(in) :: comp + ! direction 0 is from component to coupler; 1 is from coupler to component + integer, intent(in) :: mbAPPid1, mbAppid2, direction + character(CXX) , intent(in) :: fields - integer :: id_join, ocnid1, context_id , ierr + integer :: id_join, lcompid, context_id , ierr integer :: mpicom_join - character(400) :: tagname - character*100 outfile, wopts, lnum + character(CXX) :: tagname + character*100 outfile, wopts, lnum, dir - ! how to get mpicomm for joint ocn + coupler - id_join = ocn(1)%cplcompid - ocnid1 = ocn(1)%compid + ! how to get mpicomm for joint comp + coupler + id_join = comp%cplcompid + lcompid = comp%compid + + call seq_comm_getinfo(ID_join,mpicom=mpicom_join) context_id = -1 ! - tagName = trim(seq_flds_o2x_fields)//C_NULL_CHAR + tagName = trim(fields)//C_NULL_CHAR - if (mpoid .ge. 0) then ! send because we are on ocn pes + if (direction .eq. 1) then! reverse + id_join = comp%compid + lcompid = comp%cplcompid + endif + if (mbAPPid1 .ge. 0) then ! send ! basically, use the initial partitioning context_id = id_join - ierr = iMOAB_SendElementTag(mpoid, tagName, mpicom_join, context_id) + ierr = iMOAB_SendElementTag(mbAPPid1, tagName, mpicom_join, context_id) endif - if ( mboxid .ge. 0 ) then ! we are on coupler pes, for sure -! receive on couper pes, - context_id = ocnid1 - ierr = iMOAB_ReceiveElementTag(mboxid, tagName, mpicom_join, context_id) + if ( mbAPPid2 .ge. 0 ) then ! we are on receiving end + context_id = lcompid + ierr = iMOAB_ReceiveElementTag(mbAPPid2, tagName, mpicom_join, context_id) ! !CHECKRC(ierr, "cannot receive tag values") endif ! ! we can now free the sender buffers - if (mpoid .ge. 0) then + if (mbAPPid1 .ge. 0) then context_id = id_join - ierr = iMOAB_FreeSenderBuffers(mpoid, context_id) -! ! CHECKRC(ierr, "cannot free buffers used to send projected tag towards the ocean mesh") + ierr = iMOAB_FreeSenderBuffers(mbAPPid1, context_id) +! ! CHECKRC(ierr, "cannot free buffers used to send tag") endif #ifdef MOABDEBUG - if (mboxid .ge. 0 ) then ! we are on coupler pes, for sure + if (mbAPPid2 .ge. 0 ) then ! we are on receiving pes, for sure ! number_proj = number_proj+1 ! count the number of projections write(lnum,"(I0.2)") num_moab_exports - outfile = 'ocnCpl_'//trim(lnum)//'.h5m'//C_NULL_CHAR + if (direction .eq. 0 ) then + dir = 'c2x' + else + dir = 'x2c' + endif + outfile = comp%ntype//'_'//trim(dir)//'_'//trim(lnum)//'.h5m'//C_NULL_CHAR wopts = ';PARALLEL=WRITE_PART'//C_NULL_CHAR ! - ierr = iMOAB_WriteMesh(mboxid, trim(outfile), trim(wopts)) - - !CHECKRC(ierr, "cannot receive tag values") + ierr = iMOAB_WriteMesh(mbAPPid2, trim(outfile), trim(wopts)) endif #endif - end subroutine ocn_cpl_moab + end subroutine component_exch_moab end module component_mod From 3ab4204d21e02d7c93c544411ab9edb9cf7da10e Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Tue, 6 Sep 2022 15:09:47 -0500 Subject: [PATCH 174/467] more comp to coupler migrations --- driver-moab/main/cime_comp_mod.F90 | 19 +++++++++++++++++-- 1 file changed, 17 insertions(+), 2 deletions(-) diff --git a/driver-moab/main/cime_comp_mod.F90 b/driver-moab/main/cime_comp_mod.F90 index d359c405351a..38e2b44e989a 100644 --- a/driver-moab/main/cime_comp_mod.F90 +++ b/driver-moab/main/cime_comp_mod.F90 @@ -4033,7 +4033,8 @@ end subroutine cime_run_atm_setup_send !---------------------------------------------------------------------------------- subroutine cime_run_atm_recv_post() - + use seq_flds_mod , only : seq_flds_a2x_fields + use seq_comm_mct , only : mphaid, mphaxid ! !---------------------------------------------------------- !| atm -> cpl !---------------------------------------------------------- @@ -4044,6 +4045,7 @@ subroutine cime_run_atm_recv_post() timer_map_exch='CPL:a2c_atma2atmx', timer_infodata_exch='CPL:a2c_infoexch') ! will migrate the tag from component pes to coupler pes, on atm mesh + call component_exch_moab(atm(1), mphaid, mphaxid, 0, seq_flds_a2x_fields) call prep_atm_migrate_moab(infodata) endif @@ -4139,7 +4141,7 @@ end subroutine cime_run_ocn_setup_send subroutine cime_run_ocn_recv_post() use seq_flds_mod , only : seq_flds_o2x_fields - use seq_comm_mct , only : mboxid, mpoid ! + use seq_comm_mct , only : mboxid, mpoid ! !---------------------------------------------------------- ! ocn -> cpl !---------------------------------------------------------- @@ -4426,6 +4428,8 @@ end subroutine cime_run_lnd_setup_send subroutine cime_run_lnd_recv_post() + use seq_flds_mod , only : seq_flds_l2x_fields + use seq_comm_mct , only : mlnid, mblxid ! !---------------------------------------------------------- !| lnd -> cpl !---------------------------------------------------------- @@ -4434,6 +4438,8 @@ subroutine cime_run_lnd_recv_post() mpicom_barrier=mpicom_CPLALLLNDID, run_barriers=run_barriers, & timer_barrier='CPL:L2C_BARRIER', timer_comp_exch='CPL:L2C', & timer_map_exch='CPL:l2c_lndl2lndx', timer_infodata_exch='lnd2cpl_run') + ! send from land to coupler, + call component_exch_moab(lnd(1), mlnid, mblxid, 0, seq_flds_l2x_fields) endif !---------------------------------------------------------- @@ -4582,6 +4588,9 @@ end subroutine cime_run_glc_recv_post !---------------------------------------------------------------------------------- subroutine cime_run_rof_setup_send() + + use seq_flds_mod , only : seq_flds_r2x_fields + use seq_comm_mct , only : mrofid, mbrxid ! !---------------------------------------------------- ! rof prep-merge !---------------------------------------------------- @@ -4614,6 +4623,8 @@ subroutine cime_run_rof_setup_send() mpicom_barrier=mpicom_CPLALLLNDID, run_barriers=run_barriers, & timer_barrier='CPL:C2R_BARRIER', timer_comp_exch='CPL:C2R', & timer_map_exch='CPL:c2r_rofx2rofr', timer_infodata_exch='CPL:c2r_infoexch') + + call component_exch_moab(rof(1), mrofid, mbrxid, 0, seq_flds_r2x_fields) endif end subroutine cime_run_rof_setup_send @@ -4659,6 +4670,9 @@ end subroutine cime_run_rof_recv_post subroutine cime_run_ice_setup_send() + use seq_flds_mod , only : seq_flds_i2x_fields + use seq_comm_mct , only : mpsiid, mbixid ! + ! Note that for atm->ice mapping below will leverage the assumption that the ! ice and ocn are on the same grid and that mapping of atm to ocean is ! done already for use by atmocn flux and ice model prep @@ -4703,6 +4717,7 @@ subroutine cime_run_ice_setup_send() mpicom_barrier=mpicom_CPLALLICEID, run_barriers=run_barriers, & timer_barrier='CPL:C2I_BARRIER', timer_comp_exch='CPL:C2I', & timer_map_exch='CPL:c2i_icex2icei', timer_infodata_exch='CPL:ice_infoexch') + call component_exch_moab(ice(1), mpsiid, mbixid, 0, seq_flds_i2x_fields) endif end subroutine cime_run_ice_setup_send From f7ab2e5f4f7b59f82ad82ca2299be6f3c8b0eda6 Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Wed, 7 Sep 2022 17:44:04 -0500 Subject: [PATCH 175/467] first pass at ocean merging in moab ignore wave and glacier model. that means that some variables, like Sw_*, Sg_*, are not set write out formulas comment out the calculations so far most of the variables are defined on ocean coupler instance already, for example (prep_ocn_merge_moab) x2o%Sa_pbot = = a2x%Sa_pbot so in moab this would be a no-op, because the tag Sa_pbot is already defined on ocean instance there are other variables that will need to be computed, like (prep_ocn_merge_moab) x2o%Faxa_rain = = afrac*(a2x%Faxa_rainc + a2x%Faxa_rainl)*flux_epbalfact --- driver-moab/main/cime_comp_mod.F90 | 3 + driver-moab/main/prep_ocn_mod.F90 | 684 +++++++++++++++++++++++++++++ 2 files changed, 687 insertions(+) diff --git a/driver-moab/main/cime_comp_mod.F90 b/driver-moab/main/cime_comp_mod.F90 index 38e2b44e989a..11dfd316a5eb 100644 --- a/driver-moab/main/cime_comp_mod.F90 +++ b/driver-moab/main/cime_comp_mod.F90 @@ -4309,6 +4309,9 @@ subroutine cime_run_atmocn_setup(hashint) xao_ox => prep_aoflux_get_xao_ox() call prep_ocn_mrg(infodata, fractions_ox, xao_ox=xao_ox, timer_mrg='CPL:atmocnp_mrgx2o') + ! moab version + call prep_ocn_mrg_moab(infodata, xao_ox) + ! Accumulate ocn inputs - form partial sum of tavg ocn inputs (virtual "send" to ocn) call prep_ocn_accum(timer='CPL:atmocnp_accum') #endif diff --git a/driver-moab/main/prep_ocn_mod.F90 b/driver-moab/main/prep_ocn_mod.F90 index ebf094f5b214..02d975d60cce 100644 --- a/driver-moab/main/prep_ocn_mod.F90 +++ b/driver-moab/main/prep_ocn_mod.F90 @@ -52,6 +52,8 @@ module prep_ocn_mod public :: prep_ocn_init public :: prep_ocn_mrg + ! moab version + public :: prep_ocn_mrg_moab public :: prep_ocn_accum public :: prep_ocn_accum_avg @@ -624,6 +626,688 @@ subroutine prep_ocn_mrg(infodata, fractions_ox, xao_ox, timer_mrg) end subroutine prep_ocn_mrg +subroutine prep_ocn_mrg_moab(infodata, xao_ox) + + !--------------------------------------------------------------- + ! Description + ! Merge all ocn inputs + ! + ! Arguments + type(seq_infodata_type) , intent(in) :: infodata + type(mct_aVect) , pointer , intent(in) :: xao_ox(:) ! Atm-ocn fluxes, ocn grid, cpl pes; used here just for indexing + + ! temporary, to compile + type(mct_aVect) :: fractions_o + + type(mct_avect) , pointer :: a2x_o ! used just for indexing + type(mct_avect) , pointer :: i2x_o + type(mct_avect) , pointer :: r2x_o + type(mct_avect) , pointer :: x2o_o + type(mct_aVect) , pointer :: xao_o + !--------------------------------------------------------------- + + + real(r8) :: flux_epbalfact ! adjusted precip factor + + ! will build x2o_om , similar to x2o_ox + ! no averages, just one ocn instance + ! start copy from prep_ocn_merge + ! Local variables + integer :: n,ka,ki,ko,kr,kw,kx,kir,kor,i,i1,o1 + integer :: kof,kif + integer :: lsize + integer :: noflds,naflds,niflds,nrflds,nxflds! ,ngflds,nwflds, no glacier or wave model + real(r8) :: ifrac,ifracr + real(r8) :: afrac,afracr + real(r8) :: frac_sum + real(r8) :: avsdr, anidr, avsdf, anidf ! albedos + real(r8) :: fswabsv, fswabsi ! sw + character(CL),allocatable :: field_ocn(:) ! string converted to char + character(CL),allocatable :: field_atm(:) ! string converted to char + character(CL),allocatable :: field_ice(:) ! string converted to char + character(CL),allocatable :: field_rof(:) ! string converted to char + !character(CL),allocatable :: field_wav(:) ! string converted to char + character(CL),allocatable :: field_xao(:) ! string converted to char + !character(CL),allocatable :: field_glc(:) ! string converted to char + character(CL),allocatable :: itemc_ocn(:) ! string converted to char + character(CL),allocatable :: itemc_atm(:) ! string converted to char + character(CL),allocatable :: itemc_ice(:) ! string converted to char + character(CL),allocatable :: itemc_rof(:) ! string converted to char + !character(CL),allocatable :: itemc_wav(:) ! string converted to char + character(CL),allocatable :: itemc_xao(:) ! string converted to char + !character(CL),allocatable :: itemc_g2x(:) ! string converted to char + integer, save :: index_a2x_Faxa_swvdr + integer, save :: index_a2x_Faxa_swvdf + integer, save :: index_a2x_Faxa_swndr + integer, save :: index_a2x_Faxa_swndf + integer, save :: index_i2x_Fioi_swpen + integer, save :: index_xao_So_avsdr + integer, save :: index_xao_So_anidr + integer, save :: index_xao_So_avsdf + integer, save :: index_xao_So_anidf + integer, save :: index_a2x_Faxa_snowc + integer, save :: index_a2x_Faxa_snowl + integer, save :: index_a2x_Faxa_rainc + integer, save :: index_a2x_Faxa_rainl + integer, save :: index_r2x_Forr_rofl + integer, save :: index_r2x_Forr_rofi + integer, save :: index_r2x_Forr_rofl_16O + integer, save :: index_r2x_Forr_rofi_16O + integer, save :: index_r2x_Forr_rofl_18O + integer, save :: index_r2x_Forr_rofi_18O + integer, save :: index_r2x_Forr_rofl_HDO + integer, save :: index_r2x_Forr_rofi_HDO + integer, save :: index_r2x_Flrr_flood + integer, save :: index_g2x_Fogg_rofl + integer, save :: index_g2x_Fogg_rofi + integer, save :: index_x2o_Foxx_swnet + integer, save :: index_x2o_Faxa_snow + integer, save :: index_x2o_Faxa_rain + integer, save :: index_x2o_Faxa_prec + integer, save :: index_x2o_Foxx_rofl + integer, save :: index_x2o_Foxx_rofi + integer, save :: index_x2o_Sf_afrac + integer, save :: index_x2o_Sf_afracr + integer, save :: index_x2o_Foxx_swnet_afracr + integer, save :: index_x2o_Foxx_rofl_16O + integer, save :: index_x2o_Foxx_rofi_16O + integer, save :: index_x2o_Foxx_rofl_18O + integer, save :: index_x2o_Foxx_rofi_18O + integer, save :: index_x2o_Foxx_rofl_HDO + integer, save :: index_x2o_Foxx_rofi_HDO + integer, save :: index_a2x_Faxa_snowc_16O + integer, save :: index_a2x_Faxa_snowl_16O + integer, save :: index_a2x_Faxa_rainc_16O + integer, save :: index_a2x_Faxa_rainl_16O + integer, save :: index_x2o_Faxa_rain_16O + integer, save :: index_x2o_Faxa_snow_16O + integer, save :: index_x2o_Faxa_prec_16O + integer, save :: index_a2x_Faxa_snowc_18O + integer, save :: index_a2x_Faxa_snowl_18O + integer, save :: index_a2x_Faxa_rainc_18O + integer, save :: index_a2x_Faxa_rainl_18O + integer, save :: index_x2o_Faxa_rain_18O + integer, save :: index_x2o_Faxa_snow_18O + integer, save :: index_x2o_Faxa_prec_18O + integer, save :: index_a2x_Faxa_snowc_HDO + integer, save :: index_a2x_Faxa_snowl_HDO + integer, save :: index_a2x_Faxa_rainc_HDO + integer, save :: index_a2x_Faxa_rainl_HDO + integer, save :: index_x2o_Faxa_rain_HDO + integer, save :: index_x2o_Faxa_snow_HDO + integer, save :: index_x2o_Faxa_prec_HDO + logical :: iamroot + logical, save, pointer :: amerge(:),imerge(:),xmerge(:) + integer, save, pointer :: aindx(:), iindx(:), xindx(:) + character(CL),allocatable :: mrgstr(:) ! temporary string + type(mct_aVect_sharedindices),save :: a2x_sharedindices + type(mct_aVect_sharedindices),save :: i2x_sharedindices + type(mct_aVect_sharedindices),save :: r2x_sharedindices + type(mct_aVect_sharedindices),save :: w2x_sharedindices + type(mct_aVect_sharedindices),save :: xao_sharedindices + type(mct_aVect_sharedindices),save :: g2x_sharedindices + logical, save :: first_time = .true. + character(*),parameter :: subName = '(prep_ocn_merge_moab) ' + !----------------------------------------------------------------------- + + call seq_infodata_GetData(infodata, & + flux_epbalfact=flux_epbalfact) + + call seq_comm_setptrs(CPLID, iamroot=iamroot) + + if (first_time) then + a2x_o => a2x_ox(1) + i2x_o => i2x_ox(1) + r2x_o => r2x_ox(1) + xao_o => xao_ox(1) + x2o_o => component_get_x2c_cx(ocn(1)) + + ! x2o_o => x2o_ox(1) + ! + + + noflds = mct_aVect_nRattr(x2o_o) + naflds = mct_aVect_nRattr(a2x_o) + niflds = mct_aVect_nRattr(i2x_o) + nrflds = mct_aVect_nRattr(r2x_o) + !nwflds = mct_aVect_nRattr(w2x_o) + nxflds = mct_aVect_nRattr(xao_o) + !ngflds = mct_aVect_nRattr(g2x_o) + + index_a2x_Faxa_swvdr = mct_aVect_indexRA(a2x_o,'Faxa_swvdr') + index_a2x_Faxa_swvdf = mct_aVect_indexRA(a2x_o,'Faxa_swvdf') + index_a2x_Faxa_swndr = mct_aVect_indexRA(a2x_o,'Faxa_swndr') + index_a2x_Faxa_swndf = mct_aVect_indexRA(a2x_o,'Faxa_swndf') + index_i2x_Fioi_swpen = mct_aVect_indexRA(i2x_o,'Fioi_swpen') + index_xao_So_avsdr = mct_aVect_indexRA(xao_o,'So_avsdr') + index_xao_So_anidr = mct_aVect_indexRA(xao_o,'So_anidr') + index_xao_So_avsdf = mct_aVect_indexRA(xao_o,'So_avsdf') + index_xao_So_anidf = mct_aVect_indexRA(xao_o,'So_anidf') + index_x2o_Foxx_swnet = mct_aVect_indexRA(x2o_o,'Foxx_swnet') + + index_a2x_Faxa_snowc = mct_aVect_indexRA(a2x_o,'Faxa_snowc') + index_a2x_Faxa_snowl = mct_aVect_indexRA(a2x_o,'Faxa_snowl') + index_a2x_Faxa_rainc = mct_aVect_indexRA(a2x_o,'Faxa_rainc') + index_a2x_Faxa_rainl = mct_aVect_indexRA(a2x_o,'Faxa_rainl') + index_r2x_Forr_rofl = mct_aVect_indexRA(r2x_o,'Forr_rofl') + index_r2x_Forr_rofi = mct_aVect_indexRA(r2x_o,'Forr_rofi') + index_r2x_Flrr_flood = mct_aVect_indexRA(r2x_o,'Flrr_flood') + !index_g2x_Fogg_rofl = mct_aVect_indexRA(g2x_o,'Fogg_rofl') + !index_g2x_Fogg_rofi = mct_aVect_indexRA(g2x_o,'Fogg_rofi') + index_x2o_Faxa_snow = mct_aVect_indexRA(x2o_o,'Faxa_snow') + index_x2o_Faxa_rain = mct_aVect_indexRA(x2o_o,'Faxa_rain') + index_x2o_Faxa_prec = mct_aVect_indexRA(x2o_o,'Faxa_prec') + index_x2o_Foxx_rofl = mct_aVect_indexRA(x2o_o,'Foxx_rofl') + index_x2o_Foxx_rofi = mct_aVect_indexRA(x2o_o,'Foxx_rofi') + + if (seq_flds_i2o_per_cat) then + index_x2o_Sf_afrac = mct_aVect_indexRA(x2o_o,'Sf_afrac') + index_x2o_Sf_afracr = mct_aVect_indexRA(x2o_o,'Sf_afracr') + index_x2o_Foxx_swnet_afracr = mct_aVect_indexRA(x2o_o,'Foxx_swnet_afracr') + endif + + !wiso: + ! H2_16O + index_a2x_Faxa_snowc_16O = mct_aVect_indexRA(a2x_o,'Faxa_snowc_16O', perrWith='quiet') + index_a2x_Faxa_snowl_16O = mct_aVect_indexRA(a2x_o,'Faxa_snowl_16O', perrWith='quiet') + index_a2x_Faxa_rainc_16O = mct_aVect_indexRA(a2x_o,'Faxa_rainc_16O', perrWith='quiet') + index_a2x_Faxa_rainl_16O = mct_aVect_indexRA(a2x_o,'Faxa_rainl_16O', perrWith='quiet') + index_r2x_Forr_rofl_16O = mct_aVect_indexRA(r2x_o,'Forr_rofl_16O' , perrWith='quiet') + index_r2x_Forr_rofi_16O = mct_aVect_indexRA(r2x_o,'Forr_rofi_16O' , perrWith='quiet') + index_x2o_Faxa_rain_16O = mct_aVect_indexRA(x2o_o,'Faxa_rain_16O' , perrWith='quiet') + index_x2o_Faxa_snow_16O = mct_aVect_indexRA(x2o_o,'Faxa_snow_16O' , perrWith='quiet') + index_x2o_Faxa_prec_16O = mct_aVect_indexRA(x2o_o,'Faxa_prec_16O' , perrWith='quiet') + index_x2o_Foxx_rofl_16O = mct_aVect_indexRA(x2o_o,'Foxx_rofl_16O' , perrWith='quiet') + index_x2o_Foxx_rofi_16O = mct_aVect_indexRA(x2o_o,'Foxx_rofi_16O' , perrWith='quiet') + ! H2_18O + index_a2x_Faxa_snowc_18O = mct_aVect_indexRA(a2x_o,'Faxa_snowc_18O', perrWith='quiet') + index_a2x_Faxa_snowl_18O = mct_aVect_indexRA(a2x_o,'Faxa_snowl_18O', perrWith='quiet') + index_a2x_Faxa_rainc_18O = mct_aVect_indexRA(a2x_o,'Faxa_rainc_18O', perrWith='quiet') + index_a2x_Faxa_rainl_18O = mct_aVect_indexRA(a2x_o,'Faxa_rainl_18O', perrWith='quiet') + index_r2x_Forr_rofl_18O = mct_aVect_indexRA(r2x_o,'Forr_rofl_18O' , perrWith='quiet') + index_r2x_Forr_rofi_18O = mct_aVect_indexRA(r2x_o,'Forr_rofi_18O' , perrWith='quiet') + index_x2o_Faxa_rain_18O = mct_aVect_indexRA(x2o_o,'Faxa_rain_18O' , perrWith='quiet') + index_x2o_Faxa_snow_18O = mct_aVect_indexRA(x2o_o,'Faxa_snow_18O' , perrWith='quiet') + index_x2o_Faxa_prec_18O = mct_aVect_indexRA(x2o_o,'Faxa_prec_18O' , perrWith='quiet') + index_x2o_Foxx_rofl_18O = mct_aVect_indexRA(x2o_o,'Foxx_rofl_18O' , perrWith='quiet') + index_x2o_Foxx_rofi_18O = mct_aVect_indexRA(x2o_o,'Foxx_rofi_18O' , perrWith='quiet') + ! HDO + index_a2x_Faxa_snowc_HDO = mct_aVect_indexRA(a2x_o,'Faxa_snowc_HDO', perrWith='quiet') + index_a2x_Faxa_snowl_HDO = mct_aVect_indexRA(a2x_o,'Faxa_snowl_HDO', perrWith='quiet') + index_a2x_Faxa_rainc_HDO = mct_aVect_indexRA(a2x_o,'Faxa_rainc_HDO', perrWith='quiet') + index_a2x_Faxa_rainl_HDO = mct_aVect_indexRA(a2x_o,'Faxa_rainl_HDO', perrWith='quiet') + index_r2x_Forr_rofl_HDO = mct_aVect_indexRA(r2x_o,'Forr_rofl_HDO' , perrWith='quiet') + index_r2x_Forr_rofi_HDO = mct_aVect_indexRA(r2x_o,'Forr_rofi_HDO' , perrWith='quiet') + index_x2o_Faxa_rain_HDO = mct_aVect_indexRA(x2o_o,'Faxa_rain_HDO' , perrWith='quiet') + index_x2o_Faxa_snow_HDO = mct_aVect_indexRA(x2o_o,'Faxa_snow_HDO' , perrWith='quiet') + index_x2o_Faxa_prec_HDO = mct_aVect_indexRA(x2o_o,'Faxa_prec_HDO' , perrWith='quiet') + index_x2o_Foxx_rofl_HDO = mct_aVect_indexRA(x2o_o,'Foxx_rofl_HDO' , perrWith='quiet') + index_x2o_Foxx_rofi_HDO = mct_aVect_indexRA(x2o_o,'Foxx_rofi_HDO' , perrWith='quiet') + + ! Compute all other quantities based on standardized naming convention (see below) + ! Only ocn field states that have the name-prefix Sx_ will be merged + ! Only field names have the same name-suffix (after the "_") will be merged + ! (e.g. Si_fldname, Sa_fldname => merged to => Sx_fldname) + ! All fluxes will be scaled by the corresponding afrac or ifrac + ! EXCEPT for + ! -- Faxa_snnet, Faxa_snow, Faxa_rain, Faxa_prec (derived) + ! All i2x_o fluxes that have the name-suffix "Faii" (atm/ice fluxes) will be ignored + ! - only ice fluxes that are Fioi_... will be used in the ocean merges + + allocate(aindx(noflds), amerge(noflds)) + allocate(iindx(noflds), imerge(noflds)) + allocate(xindx(noflds), xmerge(noflds)) + allocate(field_atm(naflds), itemc_atm(naflds)) + allocate(field_ice(niflds), itemc_ice(niflds)) + allocate(field_ocn(noflds), itemc_ocn(noflds)) + allocate(field_rof(nrflds), itemc_rof(nrflds)) + !allocate(field_wav(nwflds), itemc_wav(nwflds)) + allocate(field_xao(nxflds), itemc_xao(nxflds)) + !allocate(field_glc(ngflds), itemc_g2x(ngflds)) + allocate(mrgstr(noflds)) + aindx(:) = 0 + iindx(:) = 0 + xindx(:) = 0 + amerge(:) = .true. + imerge(:) = .true. + xmerge(:) = .true. + + do ko = 1,noflds + field_ocn(ko) = mct_aVect_getRList2c(ko, x2o_o) + itemc_ocn(ko) = trim(field_ocn(ko)(scan(field_ocn(ko),'_'):)) + enddo + do ka = 1,naflds + field_atm(ka) = mct_aVect_getRList2c(ka, a2x_o) + itemc_atm(ka) = trim(field_atm(ka)(scan(field_atm(ka),'_'):)) + enddo + do ki = 1,niflds + field_ice(ki) = mct_aVect_getRList2c(ki, i2x_o) + itemc_ice(ki) = trim(field_ice(ki)(scan(field_ice(ki),'_'):)) + enddo + do kr = 1,nrflds + field_rof(kr) = mct_aVect_getRList2c(kr, r2x_o) + itemc_rof(kr) = trim(field_rof(kr)(scan(field_rof(kr),'_'):)) + enddo + ! do kw = 1,nwflds + ! field_wav(kw) = mct_aVect_getRList2c(kw, w2x_o) + ! itemc_wav(kw) = trim(field_wav(kw)(scan(field_wav(kw),'_'):)) + ! enddo + do kx = 1,nxflds + field_xao(kx) = mct_aVect_getRList2c(kx, xao_o) + itemc_xao(kx) = trim(field_xao(kx)(scan(field_xao(kx),'_'):)) + enddo + ! do kx = 1,ngflds + ! field_glc(kx) = mct_aVect_getRList2c(kx, g2x_o) + ! itemc_g2x(kx) = trim(field_glc(kx)(scan(field_glc(kx),'_'):)) + ! enddo + + call mct_aVect_setSharedIndices(a2x_o, x2o_o, a2x_SharedIndices) + call mct_aVect_setSharedIndices(i2x_o, x2o_o, i2x_SharedIndices) + call mct_aVect_setSharedIndices(r2x_o, x2o_o, r2x_SharedIndices) + !call mct_aVect_setSharedIndices(w2x_o, x2o_o, w2x_SharedIndices) + call mct_aVect_setSharedIndices(xao_o, x2o_o, xao_SharedIndices) + !call mct_aVect_setSharedIndices(g2x_o, x2o_o, g2x_SharedIndices) + + do ko = 1,noflds + !--- document merge --- + mrgstr(ko) = subname//'x2o%'//trim(field_ocn(ko))//' =' + if (field_ocn(ko)(1:2) == 'PF') then + cycle ! if flux has first character as P, pass straight through + end if + if (field_ocn(ko)(1:1) == 'S' .and. field_ocn(ko)(2:2) /= 'x') then + cycle ! ignore all ocn states that do not have a Sx_ prefix + end if + if (trim(field_ocn(ko)) == 'Foxx_swnet' .or. & + trim(field_ocn(ko)) == 'Faxa_snow' .or. & + trim(field_ocn(ko)) == 'Faxa_rain' .or. & + trim(field_ocn(ko)) == 'Faxa_prec' )then + cycle ! ignore swnet, snow, rain, prec - treated explicitly above + end if + if (index(field_ocn(ko), 'Faxa_snow_' ) == 1 .or. & + index(field_ocn(ko), 'Faxa_rain_' ) == 1 .or. & + index(field_ocn(ko), 'Faxa_prec_' ) == 1 )then + cycle ! ignore isotope snow, rain, prec - treated explicitly above + end if + ! if (trim(field_ocn(ko)(1:5)) == 'Foxx_') then + ! cycle ! ignore runoff fields from land - treated in coupler + ! end if + + do ka = 1,naflds + if (trim(itemc_ocn(ko)) == trim(itemc_atm(ka))) then + if ((trim(field_ocn(ko)) == trim(field_atm(ka)))) then + if (field_atm(ka)(1:1) == 'F') amerge(ko) = .false. + end if + ! --- make sure only one field matches --- + if (aindx(ko) /= 0) then + write(logunit,*) subname,' ERROR: found multiple ka field matches for ',trim(itemc_atm(ka)) + call shr_sys_abort(subname//' ERROR multiple ka field matches') + endif + aindx(ko) = ka + end if + end do + do ki = 1,niflds + if (field_ice(ki)(1:1) == 'F' .and. field_ice(ki)(2:4) == 'aii') then + cycle ! ignore all i2x_o fluxes that are ice/atm fluxes + end if + if (trim(itemc_ocn(ko)) == trim(itemc_ice(ki))) then + if ((trim(field_ocn(ko)) == trim(field_ice(ki)))) then + if (field_ice(ki)(1:1) == 'F') imerge(ko) = .false. + end if + ! --- make sure only one field matches --- + if (iindx(ko) /= 0) then + write(logunit,*) subname,' ERROR: found multiple ki field matches for ',trim(itemc_ice(ki)) + call shr_sys_abort(subname//' ERROR multiple ki field matches') + endif + iindx(ko) = ki + end if + end do + do kx = 1,nxflds + if (trim(itemc_ocn(ko)) == trim(itemc_xao(kx))) then + if ((trim(field_ocn(ko)) == trim(field_xao(kx)))) then + if (field_xao(kx)(1:1) == 'F') xmerge(ko) = .false. + end if + ! --- make sure only one field matches --- + if (xindx(ko) /= 0) then + write(logunit,*) subname,' ERROR: found multiple kx field matches for ',trim(itemc_xao(kx)) + call shr_sys_abort(subname//' ERROR multiple kx field matches') + endif + xindx(ko) = kx + end if + end do + + ! --- add some checks --- + + ! --- make sure no merge of BOTH atm and xao --- + if (aindx(ko) > 0 .and. xindx(ko) > 0) then + write(logunit,*) subname,' ERROR: aindx and xindx both non-zero, not allowed' + call shr_sys_abort(subname//' ERROR aindx and xindx both non-zero') + endif + + ! --- make sure all terms agree on merge or non-merge aspect --- + if (aindx(ko) > 0 .and. iindx(ko) > 0 .and. (amerge(ko) .neqv. imerge(ko))) then + write(logunit,*) subname,' ERROR: aindx and iindx merge logic error' + call shr_sys_abort(subname//' ERROR aindx and iindx merge logic error') + endif + if (aindx(ko) > 0 .and. xindx(ko) > 0 .and. (amerge(ko) .neqv. xmerge(ko))) then + write(logunit,*) subname,' ERROR: aindx and xindx merge logic error' + call shr_sys_abort(subname//' ERROR aindx and xindx merge logic error') + endif + if (xindx(ko) > 0 .and. iindx(ko) > 0 .and. (xmerge(ko) .neqv. imerge(ko))) then + write(logunit,*) subname,' ERROR: xindx and iindx merge logic error' + call shr_sys_abort(subname//' ERROR xindx and iindx merge logic error') + endif + + end do + + end if + + !call mct_aVect_zero(x2o_o) + ! replace with something else + + !--- document copy operations --- + if (first_time) then + !--- document merge --- + do i=1,a2x_SharedIndices%shared_real%num_indices + i1=a2x_SharedIndices%shared_real%aVindices1(i) + o1=a2x_SharedIndices%shared_real%aVindices2(i) + mrgstr(o1) = trim(mrgstr(o1))//' = a2x%'//trim(field_atm(i1)) + enddo + do i=1,i2x_SharedIndices%shared_real%num_indices + i1=i2x_SharedIndices%shared_real%aVindices1(i) + o1=i2x_SharedIndices%shared_real%aVindices2(i) + mrgstr(o1) = trim(mrgstr(o1))//' = i2x%'//trim(field_ice(i1)) + enddo + do i=1,r2x_SharedIndices%shared_real%num_indices + i1=r2x_SharedIndices%shared_real%aVindices1(i) + o1=r2x_SharedIndices%shared_real%aVindices2(i) + mrgstr(o1) = trim(mrgstr(o1))//' = r2x%'//trim(field_rof(i1)) + enddo + ! do i=1,w2x_SharedIndices%shared_real%num_indices + ! i1=w2x_SharedIndices%shared_real%aVindices1(i) + ! o1=w2x_SharedIndices%shared_real%aVindices2(i) + ! mrgstr(o1) = trim(mrgstr(o1))//' = w2x%'//trim(field_wav(i1)) + ! enddo + do i=1,xao_SharedIndices%shared_real%num_indices + i1=xao_SharedIndices%shared_real%aVindices1(i) + o1=xao_SharedIndices%shared_real%aVindices2(i) + mrgstr(o1) = trim(mrgstr(o1))//' = xao%'//trim(field_xao(i1)) + enddo + ! do i=1,g2x_SharedIndices%shared_real%num_indices + ! i1=g2x_SharedIndices%shared_real%aVindices1(i) + ! o1=g2x_SharedIndices%shared_real%aVindices2(i) + ! mrgstr(o1) = trim(mrgstr(o1))//' = g2x%'//trim(field_glc(i1)) + ! enddo + endif + + ! call mct_aVect_copy(aVin=a2x_o, aVout=x2o_o, vector=mct_usevector) + ! call mct_aVect_copy(aVin=i2x_o, aVout=x2o_o, vector=mct_usevector) + ! call mct_aVect_copy(aVin=r2x_o, aVout=x2o_o, vector=mct_usevector) + ! call mct_aVect_copy(aVin=w2x_o, aVout=x2o_o, vector=mct_usevector) + ! call mct_aVect_copy(aVin=xao_o, aVout=x2o_o, vector=mct_usevector) + !call mct_aVect_copy(aVin=a2x_o, aVout=x2o_o, vector=mct_usevector, sharedIndices=a2x_SharedIndices) + !call mct_aVect_copy(aVin=i2x_o, aVout=x2o_o, vector=mct_usevector, sharedIndices=i2x_SharedIndices) + !call mct_aVect_copy(aVin=r2x_o, aVout=x2o_o, vector=mct_usevector, sharedIndices=r2x_SharedIndices) + !!call mct_aVect_copy(aVin=w2x_o, aVout=x2o_o, vector=mct_usevector, sharedIndices=w2x_SharedIndices) + !call mct_aVect_copy(aVin=xao_o, aVout=x2o_o, vector=mct_usevector, sharedIndices=xao_SharedIndices) + !!call mct_aVect_copy(aVin=g2x_o, aVout=x2o_o, vector=mct_usevector, sharedIndices=g2x_SharedIndices) + + !--- document manual merges --- + if (first_time) then + mrgstr(index_x2o_Foxx_swnet) = trim(mrgstr(index_x2o_Foxx_swnet))//' = '// & + 'afracr*(a2x%Faxa_swvdr*(1.0-xao%So_avsdr) + '// & + 'a2x%Faxa_swvdf*(1.0-xao%So_avsdf) + '// & + 'a2x%Faxa_swndr*(1.0-xao%So_anidr) + '// & + 'a2x%Faxa_swndf*(1.0-xao%So_anidf)) + '// & + 'ifrac*i2x%Fioi_swpen' + if (seq_flds_i2o_per_cat) then + mrgstr(index_x2o_Foxx_swnet_afracr) = trim(mrgstr(index_x2o_Foxx_swnet_afracr))//' = '// & + 'afracr*(a2x%Faxa_swvdr*(1.0-xao%So_avsdr) + '// & + 'a2x%Faxa_swvdf*(1.0-xao%So_avsdf) + '// & + 'a2x%Faxa_swndr*(1.0-xao%So_anidr) + '// & + 'a2x%Faxa_swndf*(1.0-xao%So_anidf))' + end if + mrgstr(index_x2o_Faxa_snow) = trim(mrgstr(index_x2o_Faxa_snow))//' = '// & + 'afrac*(a2x%Faxa_snowc + a2x%Faxa_snowl)*flux_epbalfact' + mrgstr(index_x2o_Faxa_rain) = trim(mrgstr(index_x2o_Faxa_rain))//' = '// & + 'afrac*(a2x%Faxa_rainc + a2x%Faxa_rainl)*flux_epbalfact' + mrgstr(index_x2o_Faxa_prec) = trim(mrgstr(index_x2o_Faxa_prec))//' = '// & + 'afrac*(a2x%Faxa_snowc + a2x%Faxa_snowl + a2x%Faxa_rainc + a2x%Faxa_rainl)*flux_epbalfact' + mrgstr(index_x2o_Foxx_rofl) = trim(mrgstr(index_x2o_Foxx_rofl))//' = '// & + '(r2x%Forr_rofl + r2x%Flrr_flood + g2x%Fogg_rofl)*flux_epbalfact' + mrgstr(index_x2o_Foxx_rofi) = trim(mrgstr(index_x2o_Foxx_rofi))//' = '// & + '(r2x%Forr_rofi + g2x%Fogg_rofi)*flux_epbalfact' + ! water isotope snow, rain prec + if ( index_x2o_Faxa_snow_16O /= 0 )then + mrgstr(index_x2o_Faxa_snow_16O) = trim(mrgstr(index_x2o_Faxa_snow_16O))//' = '// & + 'afrac*(a2x%Faxa_snowc_16O + a2x%Faxa_snowl_16O)*flux_epbalfact' + mrgstr(index_x2o_Faxa_rain_16O) = trim(mrgstr(index_x2o_Faxa_rain_16O))//' = '// & + 'afrac*(a2x%Faxa_rainc_16O + a2x%Faxa_rainl_16O)*flux_epbalfact' + mrgstr(index_x2o_Faxa_prec_16O) = trim(mrgstr(index_x2o_Faxa_prec_16O))//' = '// & + 'afrac*(a2x%Faxa_snowc_16O + a2x%Faxa_snowl_16O + a2x%Faxa_rainc_16O + '// & + 'a2x%Faxa_rainl_16O)*flux_epbalfact' + end if + if ( index_x2o_Faxa_snow_18O /= 0 )then + mrgstr(index_x2o_Faxa_snow_18O) = trim(mrgstr(index_x2o_Faxa_snow_18O))//' = '// & + 'afrac*(a2x%Faxa_snowc_18O + a2x%Faxa_snowl_18O)*flux_epbalfact' + mrgstr(index_x2o_Faxa_rain_18O) = trim(mrgstr(index_x2o_Faxa_rain_18O))//' = '// & + 'afrac*(a2x%Faxa_rainc_18O + a2x%Faxa_rainl_18O)*flux_epbalfact' + mrgstr(index_x2o_Faxa_prec_18O) = trim(mrgstr(index_x2o_Faxa_prec_18O))//' = '// & + 'afrac*(a2x%Faxa_snowc_18O + a2x%Faxa_snowl_18O + a2x%Faxa_rainc_18O + '// & + 'a2x%Faxa_rainl_18O)*flux_epbalfact' + end if + if ( index_x2o_Faxa_snow_HDO /= 0 )then + mrgstr(index_x2o_Faxa_snow_HDO) = trim(mrgstr(index_x2o_Faxa_snow_HDO))//' = '// & + 'afrac*(a2x%Faxa_snowc_HDO + a2x%Faxa_snowl_HDO)*flux_epbalfact' + mrgstr(index_x2o_Faxa_rain_HDO) = trim(mrgstr(index_x2o_Faxa_rain_HDO))//' = '// & + 'afrac*(a2x%Faxa_rainc_HDO + a2x%Faxa_rainl_HDO)*flux_epbalfact' + mrgstr(index_x2o_Faxa_prec_HDO) = trim(mrgstr(index_x2o_Faxa_prec_HDO))//' = '// & + 'afrac*(a2x%Faxa_snowc_HDO + a2x%Faxa_snowl_HDO + a2x%Faxa_rainc_HDO + '// & + 'a2x%Faxa_rainl_HDO)*flux_epbalfact' + end if + endif +#ifdef NOTDEF + ! Compute input ocn state (note that this only applies to non-land portion of gridcell) + ! character(*),parameter :: fraclist_o = 'afrac:ifrac:ofrac:ifrad:ofrad' + kif = mct_aVect_indexRa(fractions_o,"ifrac",perrWith=subName) + kof = mct_aVect_indexRa(fractions_o,"ofrac",perrWith=subName) + kir = mct_aVect_indexRa(fractions_o,"ifrad",perrWith=subName) + kor = mct_aVect_indexRa(fractions_o,"ofrad",perrWith=subName) + lsize = mct_aVect_lsize(x2o_o) + do n = 1,lsize + + ifrac = fractions_o%rAttr(kif,n) + afrac = fractions_o%rAttr(kof,n) + frac_sum = ifrac + afrac + if ((frac_sum) /= 0._r8) then + ifrac = ifrac / (frac_sum) + afrac = afrac / (frac_sum) + endif + + ifracr = fractions_o%rAttr(kir,n) + afracr = fractions_o%rAttr(kor,n) + frac_sum = ifracr + afracr + if ((frac_sum) /= 0._r8) then + ifracr = ifracr / (frac_sum) + afracr = afracr / (frac_sum) + endif + + ! Derived: compute net short-wave + avsdr = xao_o%rAttr(index_xao_So_avsdr,n) + anidr = xao_o%rAttr(index_xao_So_anidr,n) + avsdf = xao_o%rAttr(index_xao_So_avsdf,n) + anidf = xao_o%rAttr(index_xao_So_anidf,n) + fswabsv = a2x_o%rAttr(index_a2x_Faxa_swvdr,n) * (1.0_R8 - avsdr) & + + a2x_o%rAttr(index_a2x_Faxa_swvdf,n) * (1.0_R8 - avsdf) + fswabsi = a2x_o%rAttr(index_a2x_Faxa_swndr,n) * (1.0_R8 - anidr) & + + a2x_o%rAttr(index_a2x_Faxa_swndf,n) * (1.0_R8 - anidf) + x2o_o%rAttr(index_x2o_Foxx_swnet,n) = (fswabsv + fswabsi) * afracr + & + i2x_o%rAttr(index_i2x_Fioi_swpen,n) * ifrac + + if (seq_flds_i2o_per_cat) then + x2o_o%rAttr(index_x2o_Sf_afrac,n) = afrac + x2o_o%rAttr(index_x2o_Sf_afracr,n) = afracr + x2o_o%rAttr(index_x2o_Foxx_swnet_afracr,n) = (fswabsv + fswabsi) * afracr + end if + + ! Derived: compute total precipitation - scale total precip and runoff + + x2o_o%rAttr(index_x2o_Faxa_snow ,n) = a2x_o%rAttr(index_a2x_Faxa_snowc,n) * afrac + & + a2x_o%rAttr(index_a2x_Faxa_snowl,n) * afrac + x2o_o%rAttr(index_x2o_Faxa_rain ,n) = a2x_o%rAttr(index_a2x_Faxa_rainc,n) * afrac + & + a2x_o%rAttr(index_a2x_Faxa_rainl,n) * afrac + + x2o_o%rAttr(index_x2o_Faxa_snow ,n) = x2o_o%rAttr(index_x2o_Faxa_snow ,n) * flux_epbalfact + x2o_o%rAttr(index_x2o_Faxa_rain ,n) = x2o_o%rAttr(index_x2o_Faxa_rain ,n) * flux_epbalfact + + x2o_o%rAttr(index_x2o_Faxa_prec ,n) = x2o_o%rAttr(index_x2o_Faxa_rain ,n) + & + x2o_o%rAttr(index_x2o_Faxa_snow ,n) + + x2o_o%rAttr(index_x2o_Foxx_rofl, n) = (r2x_o%rAttr(index_r2x_Forr_rofl , n) + & + r2x_o%rAttr(index_r2x_Flrr_flood, n) ) * flux_epbalfact + ! g2x_o%rAttr(index_g2x_Fogg_rofl , n)) * flux_epbalfact + x2o_o%rAttr(index_x2o_Foxx_rofi, n) = (r2x_o%rAttr(index_r2x_Forr_rofi , n) ) * flux_epbalfact + ! g2x_o%rAttr(index_g2x_Fogg_rofi , n)) * flux_epbalfact + + + if ( index_x2o_Foxx_rofl_16O /= 0 ) then + x2o_o%rAttr(index_x2o_Foxx_rofl_16O, n) = (r2x_o%rAttr(index_r2x_Forr_rofl_16O, n) + & + r2x_o%rAttr(index_r2x_Flrr_flood, n) ) * flux_epbalfact + ! g2x_o%rAttr(index_g2x_Fogg_rofl , n)) * flux_epbalfact + x2o_o%rAttr(index_x2o_Foxx_rofi_16O, n) = (r2x_o%rAttr(index_r2x_Forr_rofi_16O , n) ) * flux_epbalfact + ! g2x_o%rAttr(index_g2x_Fogg_rofi , n)) * flux_epbalfact + x2o_o%rAttr(index_x2o_Foxx_rofl_18O, n) = (r2x_o%rAttr(index_r2x_Forr_rofl_18O, n) + & + r2x_o%rAttr(index_r2x_Flrr_flood, n) ) * flux_epbalfact + !g2x_o%rAttr(index_g2x_Fogg_rofl , n)) * flux_epbalfact + x2o_o%rAttr(index_x2o_Foxx_rofi_18O, n) = (r2x_o%rAttr(index_r2x_Forr_rofi_18O , n) ) * flux_epbalfact + !g2x_o%rAttr(index_g2x_Fogg_rofi , n)) * flux_epbalfact + x2o_o%rAttr(index_x2o_Foxx_rofl_HDO, n) = (r2x_o%rAttr(index_r2x_Forr_rofl_HDO, n) + & + r2x_o%rAttr(index_r2x_Flrr_flood, n) ) * flux_epbalfact + !g2x_o%rAttr(index_g2x_Fogg_rofl , n)) * flux_epbalfact + x2o_o%rAttr(index_x2o_Foxx_rofi_HDO, n) = (r2x_o%rAttr(index_r2x_Forr_rofi_HDO , n) ) * flux_epbalfact + !g2x_o%rAttr(index_g2x_Fogg_rofi , n)) * flux_epbalfact + end if + + ! Derived: water isotopes total preciptiation and scaling + + if ( index_x2o_Faxa_snow_16O /= 0 )then + x2o_o%rAttr(index_x2o_Faxa_snow_16O ,n) = a2x_o%rAttr(index_a2x_Faxa_snowc_16O,n) * afrac + & + a2x_o%rAttr(index_a2x_Faxa_snowl_16O,n) * afrac + x2o_o%rAttr(index_x2o_Faxa_rain_16O ,n) = a2x_o%rAttr(index_a2x_Faxa_rainc_16O,n) * afrac + & + a2x_o%rAttr(index_a2x_Faxa_rainl_16O,n) * afrac + + x2o_o%rAttr(index_x2o_Faxa_snow_16O ,n) = x2o_o%rAttr(index_x2o_Faxa_snow_16O ,n) * flux_epbalfact + x2o_o%rAttr(index_x2o_Faxa_rain_16O ,n) = x2o_o%rAttr(index_x2o_Faxa_rain_16O ,n) * flux_epbalfact + + x2o_o%rAttr(index_x2o_Faxa_prec_16O ,n) = x2o_o%rAttr(index_x2o_Faxa_rain_16O ,n) + & + x2o_o%rAttr(index_x2o_Faxa_snow_16O ,n) + end if + + if ( index_x2o_Faxa_snow_18O /= 0 )then + x2o_o%rAttr(index_x2o_Faxa_snow_18O ,n) = a2x_o%rAttr(index_a2x_Faxa_snowc_18O,n) * afrac + & + a2x_o%rAttr(index_a2x_Faxa_snowl_18O,n) * afrac + x2o_o%rAttr(index_x2o_Faxa_rain_18O ,n) = a2x_o%rAttr(index_a2x_Faxa_rainc_18O,n) * afrac + & + a2x_o%rAttr(index_a2x_Faxa_rainl_18O,n) * afrac + + x2o_o%rAttr(index_x2o_Faxa_snow_18O ,n) = x2o_o%rAttr(index_x2o_Faxa_snow_18O ,n) * flux_epbalfact + x2o_o%rAttr(index_x2o_Faxa_rain_18O ,n) = x2o_o%rAttr(index_x2o_Faxa_rain_18O ,n) * flux_epbalfact + + x2o_o%rAttr(index_x2o_Faxa_prec_18O ,n) = x2o_o%rAttr(index_x2o_Faxa_rain_18O ,n) + & + x2o_o%rAttr(index_x2o_Faxa_snow_18O ,n) + end if + + if ( index_x2o_Faxa_snow_HDO /= 0 )then + x2o_o%rAttr(index_x2o_Faxa_snow_HDO ,n) = a2x_o%rAttr(index_a2x_Faxa_snowc_HDO,n) * afrac + & + a2x_o%rAttr(index_a2x_Faxa_snowl_HDO,n) * afrac + x2o_o%rAttr(index_x2o_Faxa_rain_HDO ,n) = a2x_o%rAttr(index_a2x_Faxa_rainc_HDO,n) * afrac + & + a2x_o%rAttr(index_a2x_Faxa_rainl_HDO,n) * afrac + + x2o_o%rAttr(index_x2o_Faxa_snow_HDO ,n) = x2o_o%rAttr(index_x2o_Faxa_snow_HDO ,n) * flux_epbalfact + x2o_o%rAttr(index_x2o_Faxa_rain_HDO ,n) = x2o_o%rAttr(index_x2o_Faxa_rain_HDO ,n) * flux_epbalfact + + x2o_o%rAttr(index_x2o_Faxa_prec_HDO ,n) = x2o_o%rAttr(index_x2o_Faxa_rain_HDO ,n) + & + x2o_o%rAttr(index_x2o_Faxa_snow_HDO ,n) + end if + end do +#endif + do ko = 1,noflds + !--- document merge --- + if (first_time) then + if (iindx(ko) > 0) then + if (imerge(ko)) then + mrgstr(ko) = trim(mrgstr(ko))//' + ifrac*i2x%'//trim(field_ice(iindx(ko))) + else + mrgstr(ko) = trim(mrgstr(ko))//' = ifrac*i2x%'//trim(field_ice(iindx(ko))) + end if + end if + if (aindx(ko) > 0) then + if (amerge(ko)) then + mrgstr(ko) = trim(mrgstr(ko))//' + afrac*a2x%'//trim(field_atm(aindx(ko))) + else + mrgstr(ko) = trim(mrgstr(ko))//' = afrac*a2x%'//trim(field_atm(aindx(ko))) + end if + end if + if (xindx(ko) > 0) then + if (xmerge(ko)) then + mrgstr(ko) = trim(mrgstr(ko))//' + afrac*xao%'//trim(field_xao(xindx(ko))) + else + mrgstr(ko) = trim(mrgstr(ko))//' = afrac*xao%'//trim(field_xao(xindx(ko))) + end if + end if + endif +#ifdef NOTDEF + do n = 1,lsize + ifrac = fractions_o%rAttr(kif,n) + afrac = fractions_o%rAttr(kof,n) + frac_sum = ifrac + afrac + if ((frac_sum) /= 0._r8) then + ifrac = ifrac / (frac_sum) + afrac = afrac / (frac_sum) + endif + if (iindx(ko) > 0) then + if (imerge(ko)) then + x2o_o%rAttr(ko,n) = x2o_o%rAttr(ko,n) + i2x_o%rAttr(iindx(ko),n) * ifrac + else + x2o_o%rAttr(ko,n) = i2x_o%rAttr(iindx(ko),n) * ifrac + end if + end if + if (aindx(ko) > 0) then + if (amerge(ko)) then + x2o_o%rAttr(ko,n) = x2o_o%rAttr(ko,n) + a2x_o%rAttr(aindx(ko),n) * afrac + else + x2o_o%rAttr(ko,n) = a2x_o%rAttr(aindx(ko),n) * afrac + end if + end if + if (xindx(ko) > 0) then + if (xmerge(ko)) then + x2o_o%rAttr(ko,n) = x2o_o%rAttr(ko,n) + xao_o%rAttr(xindx(ko),n) * afrac + else + x2o_o%rAttr(ko,n) = xao_o%rAttr(xindx(ko),n) * afrac + end if + end if + end do +#endif + end do + if (first_time) then + if (iamroot) then + write(logunit,'(A)') subname//' Summary:' + do ko = 1,noflds + write(logunit,'(A)') trim(mrgstr(ko)) + enddo + endif + deallocate(mrgstr) + deallocate(field_atm,itemc_atm) + deallocate(field_ocn,itemc_ocn) + deallocate(field_ice,itemc_ice) + deallocate(field_rof,itemc_rof) + !Sdeallocate(field_wav,itemc_wav) + deallocate(field_xao,itemc_xao) + endif + + first_time = .false. + + !end copy + + end subroutine prep_ocn_mrg_moab !================================================================================================ subroutine prep_ocn_merge( flux_epbalfact, a2x_o, i2x_o, r2x_o, w2x_o, g2x_o, xao_o, & From 06f3ef1df6b531dde72e09cc2bcfbbd0e796044e Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Wed, 7 Sep 2022 18:52:01 -0500 Subject: [PATCH 176/467] define more tags on ocean instances some are duplicated from a2x fields on ocean (Sa_pbot for example) but this makes writing in parallel to fail major problem --- components/mpas-ocean/driver/ocn_comp_mct.F | 5 +++++ driver-moab/main/cplcomp_exchange_mod.F90 | 8 ++++++++ 2 files changed, 13 insertions(+) diff --git a/components/mpas-ocean/driver/ocn_comp_mct.F b/components/mpas-ocean/driver/ocn_comp_mct.F index d1323e03da96..8d5f0f6b4c8e 100644 --- a/components/mpas-ocean/driver/ocn_comp_mct.F +++ b/components/mpas-ocean/driver/ocn_comp_mct.F @@ -644,6 +644,11 @@ end subroutine xml_stream_get_attributes if ( ierrmb == 1 ) then call mpas_log_write('cannot define tags for MOAB o2x fields ' // trim(seq_flds_o2x_fields), MPAS_LOG_ERR) endif + tagname = trim(seq_flds_x2o_fields)//C_NULL_CHAR + ierrmb = iMOAB_DefineTagStorage(MPOID, tagname, tagtype, numco, tagindex ) + if ( ierrmb == 1 ) then + call mpas_log_write('cannot define tags for MOAB x2o fields ' // trim(seq_flds_x2o_fields), MPAS_LOG_ERR) + endif #endif !----------------------------------------------------------------------- ! diff --git a/driver-moab/main/cplcomp_exchange_mod.F90 b/driver-moab/main/cplcomp_exchange_mod.F90 index 82dfb7795927..6e6d7d3487ad 100644 --- a/driver-moab/main/cplcomp_exchange_mod.F90 +++ b/driver-moab/main/cplcomp_exchange_mod.F90 @@ -11,6 +11,7 @@ module cplcomp_exchange_mod use seq_flds_mod, only: seq_flds_dom_coord, seq_flds_dom_other use seq_flds_mod, only: seq_flds_a2x_ext_fields ! use seq_flds_mod, only: seq_flds_o2x_fields ! needed for MOAB init of ocean fields o2x to be able to transfer to coupler + use seq_flds_mod, only: seq_flds_x2o_fields ! needed for MOAB init of ocean fields x2o to be able to transfer from coupler use seq_comm_mct, only: cplid, logunit use seq_comm_mct, only: seq_comm_getinfo => seq_comm_setptrs, seq_comm_iamin use seq_diag_mct @@ -1268,6 +1269,13 @@ subroutine cplcomp_moab_Init(comp) write(logunit,*) subname,' error in defining tags o2x on coupler' call shr_sys_abort(subname//' ERROR in defining tags o2x on coupler ') endif + ! need also to define seq_flds_x2o_fields on coupler instance, and on ocean comp instance + tagname = trim(seq_flds_x2o_fields)//C_NULL_CHAR + ierr = iMOAB_DefineTagStorage(mboxid, tagname, tagtype, numco, tagindex ) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in defining tags x2o on coupler' + call shr_sys_abort(subname//' ERROR in defining tags x2o on coupler ') + endif #ifdef MOABDEBUG ! debug test outfile = 'recMeshOcn.h5m'//C_NULL_CHAR From 99632e9cd1fcc27ca21421bb8b02b6e5aab974cd Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Fri, 9 Sep 2022 16:19:58 -0500 Subject: [PATCH 177/467] add fractions arrays corresponding to ifrac, ofrac, etc, fields from ocean instance --- driver-moab/main/prep_ocn_mod.F90 | 61 +++++++++++++++++++++++++++---- 1 file changed, 53 insertions(+), 8 deletions(-) diff --git a/driver-moab/main/prep_ocn_mod.F90 b/driver-moab/main/prep_ocn_mod.F90 index 02d975d60cce..023a06a7e5e9 100644 --- a/driver-moab/main/prep_ocn_mod.F90 +++ b/driver-moab/main/prep_ocn_mod.F90 @@ -141,6 +141,21 @@ module prep_ocn_mod logical :: dummy_pgibugfix #endif !================================================================================================ +! for moab, local allocatable arrays for each field, size of local ocean mesh +! these are the fields that are merged, in general +! some fields are already on the ocean instance (coming from projection) +! (usually those on shared indices ) +! all the rest will be needed for computation +! arrays will be allocated the first time, then filled with get tag values, merged, and set back to x2o ocean fields +! kif = mct_aVect_indexRa(fractions_o,"ifrac",perrWith=subName) + ! kof = mct_aVect_indexRa(fractions_o,"ofrac",perrWith=subName) + ! kir = mct_aVect_indexRa(fractions_o,"ifrad",perrWith=subName) + ! kor = mct_aVect_indexRa(fractions_o,"ofrad",perrWith=subName) + real (kind=r8) , allocatable, private :: fo_kif_ifrac(:) ! ifrac from ocean instance + real (kind=r8) , allocatable, private :: fo_kof_ofrac(:) ! ofrac from ocean instance + real (kind=r8) , allocatable, private :: fo_kir_ifrad(:) ! ifrad from ocean instance + real (kind=r8) , allocatable, private :: fo_kor_ofrad(:) ! ofrad from ocean instance + ! number of primary cells will be local size for all these arrays #ifdef MOABDEBUG integer :: number_proj ! it is a static variable, used to count the number of projections @@ -628,6 +643,8 @@ end subroutine prep_ocn_mrg subroutine prep_ocn_mrg_moab(infodata, xao_ox) + use iMOAB , only : iMOAB_GetMeshInfo, iMOAB_GetDoubleTagStorage + use seq_comm_mct , only : mboxid, mbox2id ! ocean and atm-ocean flux instances !--------------------------------------------------------------- ! Description ! Merge all ocn inputs @@ -637,7 +654,7 @@ subroutine prep_ocn_mrg_moab(infodata, xao_ox) type(mct_aVect) , pointer , intent(in) :: xao_ox(:) ! Atm-ocn fluxes, ocn grid, cpl pes; used here just for indexing ! temporary, to compile - type(mct_aVect) :: fractions_o + ! type(mct_aVect) :: fractions_o type(mct_avect) , pointer :: a2x_o ! used just for indexing type(mct_avect) , pointer :: i2x_o @@ -747,6 +764,11 @@ subroutine prep_ocn_mrg_moab(infodata, xao_ox) type(mct_aVect_sharedindices),save :: xao_sharedindices type(mct_aVect_sharedindices),save :: g2x_sharedindices logical, save :: first_time = .true. + + integer nvert(3), nvise(3), nbl(3), nsurf(3), nvisBC(3) ! for moab info + character(CL) ::tagname + integer :: ent_type, ierr + character(*),parameter :: subName = '(prep_ocn_merge_moab) ' !----------------------------------------------------------------------- @@ -755,7 +777,16 @@ subroutine prep_ocn_mrg_moab(infodata, xao_ox) call seq_comm_setptrs(CPLID, iamroot=iamroot) + ierr = iMOAB_GetMeshInfo ( mboxid, nvert, nvise, nbl, nsurf, nvisBC ); + if (ierr .ne. 0) then + write(logunit,*) subname,' error in getting info ' + call shr_sys_abort(subname//' error in getting info ') + endif + lsize = nvise(1) ! number of active cells + if (first_time) then + ! find out the number of local elements in moab mesh ocean instance on coupler + a2x_o => a2x_ox(1) i2x_o => i2x_ox(1) r2x_o => r2x_ox(1) @@ -1105,14 +1136,28 @@ subroutine prep_ocn_mrg_moab(infodata, xao_ox) 'a2x%Faxa_rainl_HDO)*flux_epbalfact' end if endif + ! allocate + if (first_time) then ! allocate arrays for fractions + allocate(fo_kif_ifrac(lsize)) + allocate(fo_kof_ofrac(lsize)) + allocate(fo_kir_ifrad(lsize)) + allocate(fo_kor_ofrad(lsize)) + endif + + ! fill with fractions from ocean instance + ent_type = 1 ! cells + tagname = 'ifrac'//C_NULL_CHAR + ierr = iMOAB_GetDoubleTagStorage ( mboxid, tagname, lsize , ent_type, fo_kif_ifrac) + tagname = 'ofrac'//C_NULL_CHAR + ierr = iMOAB_GetDoubleTagStorage ( mboxid, tagname, lsize , ent_type, fo_kof_ofrac) + tagname = 'ifrad'//C_NULL_CHAR + ierr = iMOAB_GetDoubleTagStorage ( mboxid, tagname, lsize , ent_type, fo_kir_ifrad) + tagname = 'ofrad'//C_NULL_CHAR + ierr = iMOAB_GetDoubleTagStorage ( mboxid, tagname, lsize , ent_type, fo_kor_ofrad) + + #ifdef NOTDEF - ! Compute input ocn state (note that this only applies to non-land portion of gridcell) - ! character(*),parameter :: fraclist_o = 'afrac:ifrac:ofrac:ifrad:ofrad' - kif = mct_aVect_indexRa(fractions_o,"ifrac",perrWith=subName) - kof = mct_aVect_indexRa(fractions_o,"ofrac",perrWith=subName) - kir = mct_aVect_indexRa(fractions_o,"ifrad",perrWith=subName) - kor = mct_aVect_indexRa(fractions_o,"ofrad",perrWith=subName) - lsize = mct_aVect_lsize(x2o_o) + do n = 1,lsize ifrac = fractions_o%rAttr(kif,n) From 34c9881318c7bf7f3cb39e1d4c4c6ec62afa2829 Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Sat, 10 Sep 2022 23:01:32 -0500 Subject: [PATCH 178/467] close up ocean merging --- driver-moab/main/prep_ocn_mod.F90 | 661 ++++++++++++++++++++++++++---- 1 file changed, 581 insertions(+), 80 deletions(-) diff --git a/driver-moab/main/prep_ocn_mod.F90 b/driver-moab/main/prep_ocn_mod.F90 index 023a06a7e5e9..f1907c3f8026 100644 --- a/driver-moab/main/prep_ocn_mod.F90 +++ b/driver-moab/main/prep_ocn_mod.F90 @@ -141,21 +141,7 @@ module prep_ocn_mod logical :: dummy_pgibugfix #endif !================================================================================================ -! for moab, local allocatable arrays for each field, size of local ocean mesh -! these are the fields that are merged, in general -! some fields are already on the ocean instance (coming from projection) -! (usually those on shared indices ) -! all the rest will be needed for computation -! arrays will be allocated the first time, then filled with get tag values, merged, and set back to x2o ocean fields -! kif = mct_aVect_indexRa(fractions_o,"ifrac",perrWith=subName) - ! kof = mct_aVect_indexRa(fractions_o,"ofrac",perrWith=subName) - ! kir = mct_aVect_indexRa(fractions_o,"ifrad",perrWith=subName) - ! kor = mct_aVect_indexRa(fractions_o,"ofrad",perrWith=subName) - real (kind=r8) , allocatable, private :: fo_kif_ifrac(:) ! ifrac from ocean instance - real (kind=r8) , allocatable, private :: fo_kof_ofrac(:) ! ofrac from ocean instance - real (kind=r8) , allocatable, private :: fo_kir_ifrad(:) ! ifrad from ocean instance - real (kind=r8) , allocatable, private :: fo_kor_ofrad(:) ! ofrad from ocean instance - ! number of primary cells will be local size for all these arrays + #ifdef MOABDEBUG integer :: number_proj ! it is a static variable, used to count the number of projections @@ -753,6 +739,68 @@ subroutine prep_ocn_mrg_moab(infodata, xao_ox) integer, save :: index_x2o_Faxa_rain_HDO integer, save :: index_x2o_Faxa_snow_HDO integer, save :: index_x2o_Faxa_prec_HDO + + real (kind=r8) , allocatable, save :: a2x_Faxa_swvdr(:) + real (kind=r8) , allocatable, save :: a2x_Faxa_swvdf(:) + real (kind=r8) , allocatable, save :: a2x_Faxa_swndr(:) + real (kind=r8) , allocatable, save :: a2x_Faxa_swndf(:) + real (kind=r8) , allocatable, save :: i2x_Fioi_swpen(:) + real (kind=r8) , allocatable, save :: xao_So_avsdr(:) + real (kind=r8) , allocatable, save :: xao_So_anidr(:) + real (kind=r8) , allocatable, save :: xao_So_avsdf(:) + real (kind=r8) , allocatable, save :: xao_So_anidf(:) + real (kind=r8) , allocatable, save :: a2x_Faxa_snowc(:) + real (kind=r8) , allocatable, save :: a2x_Faxa_snowl(:) + real (kind=r8) , allocatable, save :: a2x_Faxa_rainc(:) + real (kind=r8) , allocatable, save :: a2x_Faxa_rainl(:) + real (kind=r8) , allocatable, save :: r2x_Forr_rofl(:) + real (kind=r8) , allocatable, save :: r2x_Forr_rofi(:) + real (kind=r8) , allocatable, save :: r2x_Forr_rofl_16O(:) + real (kind=r8) , allocatable, save :: r2x_Forr_rofi_16O(:) + real (kind=r8) , allocatable, save :: r2x_Forr_rofl_18O(:) + real (kind=r8) , allocatable, save :: r2x_Forr_rofi_18O(:) + real (kind=r8) , allocatable, save :: r2x_Forr_rofl_HDO(:) + real (kind=r8) , allocatable, save :: r2x_Forr_rofi_HDO(:) + real (kind=r8) , allocatable, save :: r2x_Flrr_flood(:) + real (kind=r8) , allocatable, save :: g2x_Fogg_rofl(:) + real (kind=r8) , allocatable, save :: g2x_Fogg_rofi(:) + real (kind=r8) , allocatable, save :: x2o_Foxx_swnet(:) + real (kind=r8) , allocatable, save :: x2o_Faxa_snow(:) + real (kind=r8) , allocatable, save :: x2o_Faxa_rain(:) + real (kind=r8) , allocatable, save :: x2o_Faxa_prec(:) + real (kind=r8) , allocatable, save :: x2o_Foxx_rofl(:) + real (kind=r8) , allocatable, save :: x2o_Foxx_rofi(:) + real (kind=r8) , allocatable, save :: x2o_Sf_afrac(:) + real (kind=r8) , allocatable, save :: x2o_Sf_afracr(:) + real (kind=r8) , allocatable, save :: x2o_Foxx_swnet_afracr(:) + real (kind=r8) , allocatable, save :: x2o_Foxx_rofl_16O(:) + real (kind=r8) , allocatable, save :: x2o_Foxx_rofi_16O(:) + real (kind=r8) , allocatable, save :: x2o_Foxx_rofl_18O(:) + real (kind=r8) , allocatable, save :: x2o_Foxx_rofi_18O(:) + real (kind=r8) , allocatable, save :: x2o_Foxx_rofl_HDO(:) + real (kind=r8) , allocatable, save :: x2o_Foxx_rofi_HDO(:) + real (kind=r8) , allocatable, save :: a2x_Faxa_snowc_16O(:) + real (kind=r8) , allocatable, save :: a2x_Faxa_snowl_16O(:) + real (kind=r8) , allocatable, save :: a2x_Faxa_rainc_16O(:) + real (kind=r8) , allocatable, save :: a2x_Faxa_rainl_16O(:) + real (kind=r8) , allocatable, save :: x2o_Faxa_rain_16O(:) + real (kind=r8) , allocatable, save :: x2o_Faxa_snow_16O(:) + real (kind=r8) , allocatable, save :: x2o_Faxa_prec_16O(:) + real (kind=r8) , allocatable, save :: a2x_Faxa_snowc_18O(:) + real (kind=r8) , allocatable, save :: a2x_Faxa_snowl_18O(:) + real (kind=r8) , allocatable, save :: a2x_Faxa_rainc_18O(:) + real (kind=r8) , allocatable, save :: a2x_Faxa_rainl_18O(:) + real (kind=r8) , allocatable, save :: x2o_Faxa_rain_18O(:) + real (kind=r8) , allocatable, save :: x2o_Faxa_snow_18O(:) + real (kind=r8) , allocatable, save :: x2o_Faxa_prec_18O(:) + real (kind=r8) , allocatable, save :: a2x_Faxa_snowc_HDO(:) + real (kind=r8) , allocatable, save :: a2x_Faxa_snowl_HDO(:) + real (kind=r8) , allocatable, save :: a2x_Faxa_rainc_HDO(:) + real (kind=r8) , allocatable, save :: a2x_Faxa_rainl_HDO(:) + real (kind=r8) , allocatable, save :: x2o_Faxa_rain_HDO(:) + real (kind=r8) , allocatable, save :: x2o_Faxa_snow_HDO(:) + real (kind=r8) , allocatable, save :: x2o_Faxa_prec_HDO(:) + logical :: iamroot logical, save, pointer :: amerge(:),imerge(:),xmerge(:) integer, save, pointer :: aindx(:), iindx(:), xindx(:) @@ -768,6 +816,21 @@ subroutine prep_ocn_mrg_moab(infodata, xao_ox) integer nvert(3), nvise(3), nbl(3), nsurf(3), nvisBC(3) ! for moab info character(CL) ::tagname integer :: ent_type, ierr +! for moab, local allocatable arrays for each field, size of local ocean mesh +! these are the fields that are merged, in general +! some fields are already on the ocean instance (coming from projection) +! (usually those on shared indices ) +! all the rest will be needed for computation +! arrays will be allocated the first time, then filled with get tag values, merged, and set back to x2o ocean fields +! kif = mct_aVect_indexRa(fractions_o,"ifrac",perrWith=subName) + ! kof = mct_aVect_indexRa(fractions_o,"ofrac",perrWith=subName) + ! kir = mct_aVect_indexRa(fractions_o,"ifrad",perrWith=subName) + ! kor = mct_aVect_indexRa(fractions_o,"ofrad",perrWith=subName) + real (kind=r8) , allocatable, save :: fo_kif_ifrac(:) ! ifrac from ocean instance + real (kind=r8) , allocatable, save :: fo_kof_ofrac(:) ! ofrac from ocean instance + real (kind=r8) , allocatable, save :: fo_kir_ifrad(:) ! ifrad from ocean instance + real (kind=r8) , allocatable, save :: fo_kor_ofrad(:) ! ofrad from ocean instance + ! number of primary cells will be local size for all these arrays character(*),parameter :: subName = '(prep_ocn_merge_moab) ' !----------------------------------------------------------------------- @@ -1142,34 +1205,470 @@ subroutine prep_ocn_mrg_moab(infodata, xao_ox) allocate(fo_kof_ofrac(lsize)) allocate(fo_kir_ifrad(lsize)) allocate(fo_kor_ofrad(lsize)) + ! now real fields + allocate(a2x_Faxa_swvdr(lsize)) + allocate(a2x_Faxa_swvdf(lsize)) + allocate(a2x_Faxa_swndr(lsize)) + allocate(a2x_Faxa_swndf(lsize)) + allocate(i2x_Fioi_swpen(lsize)) + allocate(xao_So_avsdr(lsize)) + allocate(xao_So_anidr(lsize)) + allocate(xao_So_avsdf(lsize)) + allocate(xao_So_anidf(lsize)) + allocate(a2x_Faxa_snowc(lsize)) + allocate(a2x_Faxa_snowl(lsize)) + allocate(a2x_Faxa_rainc(lsize)) + allocate(a2x_Faxa_rainl(lsize)) + allocate(r2x_Forr_rofl(lsize)) + allocate(r2x_Forr_rofi(lsize)) + allocate(r2x_Forr_rofl_16O(lsize)) + allocate(r2x_Forr_rofi_16O(lsize)) + allocate(r2x_Forr_rofl_18O(lsize)) + allocate(r2x_Forr_rofi_18O(lsize)) + allocate(r2x_Forr_rofl_HDO(lsize)) + allocate(r2x_Forr_rofi_HDO(lsize)) + allocate(r2x_Flrr_flood(lsize)) + allocate(g2x_Fogg_rofl(lsize)) + allocate(g2x_Fogg_rofi(lsize)) + allocate(x2o_Foxx_swnet(lsize)) + allocate(x2o_Faxa_snow(lsize)) + allocate(x2o_Faxa_rain(lsize)) + allocate(x2o_Faxa_prec(lsize)) + allocate(x2o_Foxx_rofl(lsize)) + allocate(x2o_Foxx_rofi(lsize)) + allocate(x2o_Sf_afrac(lsize)) + allocate(x2o_Sf_afracr(lsize)) + allocate(x2o_Foxx_swnet_afracr(lsize)) + allocate(x2o_Foxx_rofl_16O(lsize)) + allocate(x2o_Foxx_rofi_16O(lsize)) + allocate(x2o_Foxx_rofl_18O(lsize)) + allocate(x2o_Foxx_rofi_18O(lsize)) + allocate(x2o_Foxx_rofl_HDO(lsize)) + allocate(x2o_Foxx_rofi_HDO(lsize)) + allocate(a2x_Faxa_snowc_16O(lsize)) + allocate(a2x_Faxa_snowl_16O(lsize)) + allocate(a2x_Faxa_rainc_16O(lsize)) + allocate(a2x_Faxa_rainl_16O(lsize)) + allocate(x2o_Faxa_rain_16O(lsize)) + allocate(x2o_Faxa_snow_16O(lsize)) + allocate(x2o_Faxa_prec_16O(lsize)) + allocate(a2x_Faxa_snowc_18O(lsize)) + allocate(a2x_Faxa_snowl_18O(lsize)) + allocate(a2x_Faxa_rainc_18O(lsize)) + allocate(a2x_Faxa_rainl_18O(lsize)) + allocate(x2o_Faxa_rain_18O(lsize)) + allocate(x2o_Faxa_snow_18O(lsize)) + allocate(x2o_Faxa_prec_18O(lsize)) + allocate(a2x_Faxa_snowc_HDO(lsize)) + allocate(a2x_Faxa_snowl_HDO(lsize)) + allocate(a2x_Faxa_rainc_HDO(lsize)) + allocate(a2x_Faxa_rainl_HDO(lsize)) + allocate(x2o_Faxa_rain_HDO(lsize)) + allocate(x2o_Faxa_snow_HDO(lsize)) + allocate(x2o_Faxa_prec_HDO(lsize)) + endif ! fill with fractions from ocean instance ent_type = 1 ! cells tagname = 'ifrac'//C_NULL_CHAR ierr = iMOAB_GetDoubleTagStorage ( mboxid, tagname, lsize , ent_type, fo_kif_ifrac) + if (ierr .ne. 0) then + call shr_sys_abort(subname//' error in getting ifrac ') + endif tagname = 'ofrac'//C_NULL_CHAR ierr = iMOAB_GetDoubleTagStorage ( mboxid, tagname, lsize , ent_type, fo_kof_ofrac) + if (ierr .ne. 0) then + call shr_sys_abort(subname//' error in getting ofrac ') + endif tagname = 'ifrad'//C_NULL_CHAR ierr = iMOAB_GetDoubleTagStorage ( mboxid, tagname, lsize , ent_type, fo_kir_ifrad) + if (ierr .ne. 0) then + call shr_sys_abort(subname//' error in getting ifrad ') + endif tagname = 'ofrad'//C_NULL_CHAR ierr = iMOAB_GetDoubleTagStorage ( mboxid, tagname, lsize , ent_type, fo_kor_ofrad) + if (ierr .ne. 0) then + call shr_sys_abort(subname//' error in getting ofrad ') + endif + ! fill with values from various instances + tagname = 'Faxa_swvdr'//C_NULL_CHAR + ierr = iMOAB_GetDoubleTagStorage ( mboxid, tagname, lsize , ent_type, a2x_Faxa_swvdr) + if (ierr .ne. 0) then + call shr_sys_abort(subname//' error in getting Faxa_swvdr field') + endif + ! allocate(a2x_Faxa_swvdr(lsize)) + ! allocate(a2x_Faxa_swvdf(lsize)) + tagname = 'Faxa_swvdf'//C_NULL_CHAR + ierr = iMOAB_GetDoubleTagStorage ( mboxid, tagname, lsize , ent_type, a2x_Faxa_swvdf) + if (ierr .ne. 0) then + call shr_sys_abort(subname//' error in getting Faxa_swvdf field') + endif + ! allocate(a2x_Faxa_swndr(lsize)) + tagname = 'Faxa_swndr'//C_NULL_CHAR + ierr = iMOAB_GetDoubleTagStorage ( mboxid, tagname, lsize , ent_type, a2x_Faxa_swndr) + if (ierr .ne. 0) then + call shr_sys_abort(subname//' error in getting Faxa_swndr field') + endif + ! allocate(a2x_Faxa_swndf(lsize)) + tagname = 'Faxa_swndf'//C_NULL_CHAR + ierr = iMOAB_GetDoubleTagStorage ( mboxid, tagname, lsize , ent_type, a2x_Faxa_swndf) + if (ierr .ne. 0) then + call shr_sys_abort(subname//' error in getting Faxa_swndf field') + endif + ! allocate(i2x_Fioi_swpen(lsize)) + tagname = 'Fioi_swpen'//C_NULL_CHAR + ierr = iMOAB_GetDoubleTagStorage ( mboxid, tagname, lsize , ent_type, i2x_Fioi_swpen) + if (ierr .ne. 0) then + call shr_sys_abort(subname//' error in getting Fioi_swpen field') + endif -#ifdef NOTDEF + ! allocate(xao_So_avsdr(lsize)) + tagname = 'So_avsdr'//C_NULL_CHAR + ierr = iMOAB_GetDoubleTagStorage ( mbox2id, tagname, lsize , ent_type, xao_So_avsdr) + if (ierr .ne. 0) then + call shr_sys_abort(subname//' error in getting So_avsdr field') + endif + ! allocate(xao_So_anidr(lsize)) + tagname = 'So_anidr'//C_NULL_CHAR + ierr = iMOAB_GetDoubleTagStorage ( mbox2id, tagname, lsize , ent_type, xao_So_anidr) + if (ierr .ne. 0) then + call shr_sys_abort(subname//' error in getting So_anidr field') + endif + ! allocate(xao_So_avsdf(lsize)) + tagname = 'So_avsdf'//C_NULL_CHAR + ierr = iMOAB_GetDoubleTagStorage ( mbox2id, tagname, lsize , ent_type, xao_So_avsdf) + if (ierr .ne. 0) then + call shr_sys_abort(subname//' error in getting So_avsdf field') + endif + ! allocate(xao_So_anidf(lsize)) + tagname = 'So_anidf'//C_NULL_CHAR + ierr = iMOAB_GetDoubleTagStorage ( mbox2id, tagname, lsize , ent_type, xao_So_anidf) + if (ierr .ne. 0) then + call shr_sys_abort(subname//' error in getting So_anidf field') + endif + ! allocate(a2x_Faxa_snowc(lsize)) + tagname = 'Faxa_snowc'//C_NULL_CHAR + ierr = iMOAB_GetDoubleTagStorage ( mboxid, tagname, lsize , ent_type, a2x_Faxa_snowc) + if (ierr .ne. 0) then + call shr_sys_abort(subname//' error in getting Faxa_snowc field') + endif + ! allocate(a2x_Faxa_snowl(lsize)) + tagname = 'Faxa_snowl'//C_NULL_CHAR + ierr = iMOAB_GetDoubleTagStorage ( mboxid, tagname, lsize , ent_type, a2x_Faxa_snowl) + if (ierr .ne. 0) then + call shr_sys_abort(subname//' error in getting Faxa_snowl field') + endif + ! allocate(a2x_Faxa_rainc(lsize)) + tagname = 'Faxa_rainc'//C_NULL_CHAR + ierr = iMOAB_GetDoubleTagStorage ( mboxid, tagname, lsize , ent_type, a2x_Faxa_rainc) + if (ierr .ne. 0) then + call shr_sys_abort(subname//' error in getting Faxa_rainc field') + endif + ! allocate(a2x_Faxa_rainl(lsize)) + tagname = 'Faxa_rainl'//C_NULL_CHAR + ierr = iMOAB_GetDoubleTagStorage ( mboxid, tagname, lsize , ent_type, a2x_Faxa_rainl) + if (ierr .ne. 0) then + call shr_sys_abort(subname//' error in getting Faxa_rainl field') + endif + ! allocate(r2x_Forr_rofl(lsize)) + tagname = 'Forr_rofl'//C_NULL_CHAR + ierr = iMOAB_GetDoubleTagStorage ( mboxid, tagname, lsize , ent_type, r2x_Forr_rofl) + if (ierr .ne. 0) then + call shr_sys_abort(subname//' error in getting Forr_rofl field') + endif + ! allocate(r2x_Forr_rofi(lsize)) + tagname = 'Forr_rofi'//C_NULL_CHAR + ierr = iMOAB_GetDoubleTagStorage ( mboxid, tagname, lsize , ent_type, r2x_Forr_rofi) + if (ierr .ne. 0) then + call shr_sys_abort(subname//' error in getting Forr_rofi field') + endif + ! allocate(r2x_Forr_rofl_16O(lsize)) + tagname = 'Forr_rofl_16O'//C_NULL_CHAR + ierr = iMOAB_GetDoubleTagStorage ( mboxid, tagname, lsize , ent_type, r2x_Forr_rofl_16O) + if (ierr .ne. 0) then + call shr_sys_abort(subname//' error in getting Forr_rofl_16O field') + endif + ! allocate(r2x_Forr_rofi_16O(lsize)) + tagname = 'Forr_rofi_16O'//C_NULL_CHAR + ierr = iMOAB_GetDoubleTagStorage ( mboxid, tagname, lsize , ent_type, r2x_Forr_rofi_16O) + if (ierr .ne. 0) then + call shr_sys_abort(subname//' error in getting Forr_rofi_16O field') + endif + ! allocate(r2x_Forr_rofl_18O(lsize)) + tagname = 'Forr_rofl_18O'//C_NULL_CHAR + ierr = iMOAB_GetDoubleTagStorage ( mboxid, tagname, lsize , ent_type, r2x_Forr_rofl_18O) + if (ierr .ne. 0) then + call shr_sys_abort(subname//' error in getting Forr_rofl_18O field') + endif + ! allocate(r2x_Forr_rofi_18O(lsize)) + tagname = 'Forr_rofi_18O'//C_NULL_CHAR + ierr = iMOAB_GetDoubleTagStorage ( mboxid, tagname, lsize , ent_type, r2x_Forr_rofi_18O) + if (ierr .ne. 0) then + call shr_sys_abort(subname//' error in getting Forr_rofi_18O field') + endif + ! allocate(r2x_Forr_rofi_18O(lsize)) + tagname = 'Forr_rofi_18O'//C_NULL_CHAR + ierr = iMOAB_GetDoubleTagStorage ( mboxid, tagname, lsize , ent_type, r2x_Forr_rofi_18O) + if (ierr .ne. 0) then + call shr_sys_abort(subname//' error in getting Forr_rofi_18O field') + endif + ! allocate(r2x_Forr_rofi_HDO(lsize)) + tagname = 'Forr_rofi_HDO'//C_NULL_CHAR + ierr = iMOAB_GetDoubleTagStorage ( mboxid, tagname, lsize , ent_type, r2x_Forr_rofi_HDO) + if (ierr .ne. 0) then + call shr_sys_abort(subname//' error in getting Forr_rofi_HDO field') + endif + ! allocate(r2x_Flrr_flood(lsize)) + tagname = 'Flrr_flood'//C_NULL_CHAR + ierr = iMOAB_GetDoubleTagStorage ( mboxid, tagname, lsize , ent_type, r2x_Flrr_flood) + if (ierr .ne. 0) then + call shr_sys_abort(subname//' error in getting Flrr_flood field') + endif + ! ! allocate(g2x_Fogg_rofl(lsize)) + ! tagname = 'Faxa_swndf'//C_NULL_CHAR + ! ierr = iMOAB_GetDoubleTagStorage ( mboxid, tagname, lsize , ent_type, a2x_Faxa_swndf) + ! if (ierr .ne. 0) then + ! call shr_sys_abort(subname//' error in getting Faxa_swndf field') + ! endif + ! ! allocate(g2x_Fogg_rofi(lsize)) + ! tagname = 'Faxa_swndf'//C_NULL_CHAR + ! ierr = iMOAB_GetDoubleTagStorage ( mboxid, tagname, lsize , ent_type, a2x_Faxa_swndf) + ! if (ierr .ne. 0) then + ! call shr_sys_abort(subname//' error in getting Faxa_swndf field') + ! endif + ! allocate(x2o_Foxx_swnet(lsize)) + tagname = 'Foxx_swnet'//C_NULL_CHAR + ierr = iMOAB_GetDoubleTagStorage ( mboxid, tagname, lsize , ent_type, x2o_Foxx_swnet) + if (ierr .ne. 0) then + call shr_sys_abort(subname//' error in getting Foxx_swnet field') + endif + ! allocate(x2o_Faxa_snow(lsize)) + tagname = 'Faxa_snow'//C_NULL_CHAR + ierr = iMOAB_GetDoubleTagStorage ( mboxid, tagname, lsize , ent_type, x2o_Faxa_snow) + if (ierr .ne. 0) then + call shr_sys_abort(subname//' error in getting Faxa_snow field') + endif + ! allocate(x2o_Faxa_rain(lsize)) + tagname = 'Faxa_rain'//C_NULL_CHAR + ierr = iMOAB_GetDoubleTagStorage ( mboxid, tagname, lsize , ent_type, x2o_Faxa_rain) + if (ierr .ne. 0) then + call shr_sys_abort(subname//' error in getting Faxa_rain field') + endif + ! allocate(x2o_Faxa_prec(lsize)) + tagname = 'Faxa_prec'//C_NULL_CHAR + ierr = iMOAB_GetDoubleTagStorage ( mboxid, tagname, lsize , ent_type, x2o_Faxa_prec) + if (ierr .ne. 0) then + call shr_sys_abort(subname//' error in getting Faxa_prec field') + endif + ! allocate(x2o_Foxx_rofl(lsize)) + tagname = 'Foxx_rofl'//C_NULL_CHAR + ierr = iMOAB_GetDoubleTagStorage ( mboxid, tagname, lsize , ent_type, x2o_Foxx_rofl) + if (ierr .ne. 0) then + call shr_sys_abort(subname//' error in getting Foxx_rofl field') + endif + ! allocate(x2o_Foxx_rofi(lsize)) + tagname = 'Foxx_rofi'//C_NULL_CHAR + ierr = iMOAB_GetDoubleTagStorage ( mboxid, tagname, lsize , ent_type, x2o_Foxx_rofi) + if (ierr .ne. 0) then + call shr_sys_abort(subname//' error in getting Foxx_rofi field') + endif + ! allocate(x2o_Sf_afrac(lsize)) + tagname = 'Sf_afrac'//C_NULL_CHAR + ierr = iMOAB_GetDoubleTagStorage ( mboxid, tagname, lsize , ent_type, x2o_Sf_afrac) + if (ierr .ne. 0) then + call shr_sys_abort(subname//' error in getting Sf_afrac field') + endif + ! allocate(x2o_Sf_afracr(lsize)) + tagname = 'Sf_afracr'//C_NULL_CHAR + ierr = iMOAB_GetDoubleTagStorage ( mboxid, tagname, lsize , ent_type, x2o_Sf_afracr) + if (ierr .ne. 0) then + call shr_sys_abort(subname//' error in getting Sf_afracr field') + endif + ! allocate(x2o_Foxx_swnet_afracr(lsize)) + tagname = 'Foxx_swnet_afracr'//C_NULL_CHAR + ierr = iMOAB_GetDoubleTagStorage ( mboxid, tagname, lsize , ent_type, x2o_Foxx_swnet_afracr) + if (ierr .ne. 0) then + call shr_sys_abort(subname//' error in getting Foxx_swnet_afracr field') + endif + ! allocate(x2o_Foxx_rofl_16O(lsize)) + tagname = 'Foxx_rofl_16O'//C_NULL_CHAR + ierr = iMOAB_GetDoubleTagStorage ( mboxid, tagname, lsize , ent_type, x2o_Foxx_rofl_16O) + if (ierr .ne. 0) then + call shr_sys_abort(subname//' error in getting Foxx_rofl_16O field') + endif + ! allocate(x2o_Foxx_rofi_16O(lsize)) + tagname = 'Foxx_rofi_16O'//C_NULL_CHAR + ierr = iMOAB_GetDoubleTagStorage ( mboxid, tagname, lsize , ent_type, x2o_Foxx_rofi_16O) + if (ierr .ne. 0) then + call shr_sys_abort(subname//' error in getting Foxx_rofi_16O field') + endif + ! allocate(x2o_Foxx_rofl_18O(lsize)) + tagname = 'Foxx_rofl_18O'//C_NULL_CHAR + ierr = iMOAB_GetDoubleTagStorage ( mboxid, tagname, lsize , ent_type, x2o_Foxx_rofl_18O) + if (ierr .ne. 0) then + call shr_sys_abort(subname//' error in getting Foxx_rofl_18O field') + endif + ! allocate(x2o_Foxx_rofi_18O(lsize)) + tagname = 'Foxx_rofi_18O'//C_NULL_CHAR + ierr = iMOAB_GetDoubleTagStorage ( mboxid, tagname, lsize , ent_type, x2o_Foxx_rofi_18O) + if (ierr .ne. 0) then + call shr_sys_abort(subname//' error in getting Foxx_rofi_18O field') + endif + ! allocate(x2o_Foxx_rofl_HDO(lsize)) + tagname = 'Foxx_rofl_HDO'//C_NULL_CHAR + ierr = iMOAB_GetDoubleTagStorage ( mboxid, tagname, lsize , ent_type, x2o_Foxx_rofl_HDO) + if (ierr .ne. 0) then + call shr_sys_abort(subname//' error in getting Foxx_rofl_HDO field') + endif + ! allocate(x2o_Foxx_rofi_HDO(lsize)) + tagname = 'Foxx_rofi_HDO'//C_NULL_CHAR + ierr = iMOAB_GetDoubleTagStorage ( mboxid, tagname, lsize , ent_type, x2o_Foxx_rofi_HDO) + if (ierr .ne. 0) then + call shr_sys_abort(subname//' error in getting Foxx_rofi_HDO field') + endif + ! allocate(a2x_Faxa_snowc_16O(lsize)) + tagname = 'Faxa_snowc_16O'//C_NULL_CHAR + ierr = iMOAB_GetDoubleTagStorage ( mboxid, tagname, lsize , ent_type, a2x_Faxa_snowc_16O) + if (ierr .ne. 0) then + call shr_sys_abort(subname//' error in getting Faxa_snowc_16O field') + endif + ! allocate(a2x_Faxa_snowl_16O(lsize)) + tagname = 'Faxa_snowl_16O'//C_NULL_CHAR + ierr = iMOAB_GetDoubleTagStorage ( mboxid, tagname, lsize , ent_type, a2x_Faxa_snowl_16O) + if (ierr .ne. 0) then + call shr_sys_abort(subname//' error in getting Faxa_snowl_16O field') + endif + ! allocate(a2x_Faxa_rainc_16O(lsize)) + tagname = 'Faxa_rainc_16O'//C_NULL_CHAR + ierr = iMOAB_GetDoubleTagStorage ( mboxid, tagname, lsize , ent_type, a2x_Faxa_rainc_16O) + if (ierr .ne. 0) then + call shr_sys_abort(subname//' error in getting Faxa_rainc_16O field') + endif + ! allocate(a2x_Faxa_rainl_16O(lsize)) + tagname = 'Faxa_rainl_16O'//C_NULL_CHAR + ierr = iMOAB_GetDoubleTagStorage ( mboxid, tagname, lsize , ent_type, a2x_Faxa_rainl_16O) + if (ierr .ne. 0) then + call shr_sys_abort(subname//' error in getting Faxa_rainl_16O field') + endif + ! allocate(x2o_Faxa_rain_16O(lsize)) + tagname = 'Faxa_rain_16O'//C_NULL_CHAR + ierr = iMOAB_GetDoubleTagStorage ( mboxid, tagname, lsize , ent_type, x2o_Faxa_rain_16O) + if (ierr .ne. 0) then + call shr_sys_abort(subname//' error in getting Faxa_rain_16O field') + endif + ! allocate(x2o_Faxa_snow_16O(lsize)) + tagname = 'Faxa_snow_16O'//C_NULL_CHAR + ierr = iMOAB_GetDoubleTagStorage ( mboxid, tagname, lsize , ent_type, x2o_Faxa_snow_16O) + if (ierr .ne. 0) then + call shr_sys_abort(subname//' error in getting Faxa_snow_16O field') + endif + ! allocate(x2o_Faxa_prec_16O(lsize)) + tagname = 'Faxa_prec_16O'//C_NULL_CHAR + ierr = iMOAB_GetDoubleTagStorage ( mboxid, tagname, lsize , ent_type, x2o_Faxa_prec_16O) + if (ierr .ne. 0) then + call shr_sys_abort(subname//' error in getting Faxa_prec_16O field') + endif + ! allocate(a2x_Faxa_snowc_18O(lsize)) + tagname = 'Faxa_snowc_18O'//C_NULL_CHAR + ierr = iMOAB_GetDoubleTagStorage ( mboxid, tagname, lsize , ent_type, a2x_Faxa_snowc_18O) + if (ierr .ne. 0) then + call shr_sys_abort(subname//' error in getting Faxa_snowc_18O field') + endif + ! allocate(a2x_Faxa_snowl_18O(lsize)) + tagname = 'Faxa_snowl_18O'//C_NULL_CHAR + ierr = iMOAB_GetDoubleTagStorage ( mboxid, tagname, lsize , ent_type, a2x_Faxa_snowl_18O) + if (ierr .ne. 0) then + call shr_sys_abort(subname//' error in getting Faxa_snowl_18O field') + endif + ! allocate(a2x_Faxa_rainc_18O(lsize)) + tagname = 'Faxa_rainc_18O'//C_NULL_CHAR + ierr = iMOAB_GetDoubleTagStorage ( mboxid, tagname, lsize , ent_type, a2x_Faxa_rainc_18O) + if (ierr .ne. 0) then + call shr_sys_abort(subname//' error in getting Faxa_rainc_18O field') + endif + ! allocate(a2x_Faxa_rainl_18O(lsize)) + tagname = 'Faxa_rainl_18O'//C_NULL_CHAR + ierr = iMOAB_GetDoubleTagStorage ( mboxid, tagname, lsize , ent_type, a2x_Faxa_rainl_18O) + if (ierr .ne. 0) then + call shr_sys_abort(subname//' error in getting Faxa_rainl_18O field') + endif + ! allocate(x2o_Faxa_rain_18O(lsize)) + tagname = 'Faxa_rain_18O'//C_NULL_CHAR + ierr = iMOAB_GetDoubleTagStorage ( mboxid, tagname, lsize , ent_type, x2o_Faxa_rain_18O) + if (ierr .ne. 0) then + call shr_sys_abort(subname//' error in getting Faxa_rain_18O field') + endif + ! allocate(x2o_Faxa_snow_18O(lsize)) + tagname = 'Faxa_snow_18O'//C_NULL_CHAR + ierr = iMOAB_GetDoubleTagStorage ( mboxid, tagname, lsize , ent_type, x2o_Faxa_snow_18O) + if (ierr .ne. 0) then + call shr_sys_abort(subname//' error in getting Faxa_snow_18O field') + endif + ! allocate(x2o_Faxa_prec_18O(lsize)) + tagname = 'Faxa_prec_18O'//C_NULL_CHAR + ierr = iMOAB_GetDoubleTagStorage ( mboxid, tagname, lsize , ent_type, x2o_Faxa_prec_18O) + if (ierr .ne. 0) then + call shr_sys_abort(subname//' error in getting Faxa_prec_18O field') + endif + ! allocate(a2x_Faxa_snowc_HDO(lsize)) + tagname = 'Faxa_snowc_HDO'//C_NULL_CHAR + ierr = iMOAB_GetDoubleTagStorage ( mboxid, tagname, lsize , ent_type, a2x_Faxa_snowc_HDO) + if (ierr .ne. 0) then + call shr_sys_abort(subname//' error in getting Faxa_snowc_HDO field') + endif + ! allocate(a2x_Faxa_snowl_HDO(lsize)) + tagname = 'Faxa_snowl_HDO'//C_NULL_CHAR + ierr = iMOAB_GetDoubleTagStorage ( mboxid, tagname, lsize , ent_type, a2x_Faxa_snowl_HDO) + if (ierr .ne. 0) then + call shr_sys_abort(subname//' error in getting Faxa_snowl_HDO field') + endif + ! allocate(a2x_Faxa_rainc_HDO(lsize)) + tagname = 'Faxa_rainc_HDO'//C_NULL_CHAR + ierr = iMOAB_GetDoubleTagStorage ( mboxid, tagname, lsize , ent_type, a2x_Faxa_rainc_HDO) + if (ierr .ne. 0) then + call shr_sys_abort(subname//' error in getting Faxa_rainc_HDO field') + endif + ! allocate(a2x_Faxa_rainl_HDO(lsize)) + tagname = 'Faxa_rainl_HDO'//C_NULL_CHAR + ierr = iMOAB_GetDoubleTagStorage ( mboxid, tagname, lsize , ent_type, a2x_Faxa_rainl_HDO) + if (ierr .ne. 0) then + call shr_sys_abort(subname//' error in getting Faxa_rainl_HDO field') + endif + ! allocate(x2o_Faxa_rain_HDO(lsize)) + tagname = 'Faxa_rain_HDO'//C_NULL_CHAR + ierr = iMOAB_GetDoubleTagStorage ( mboxid, tagname, lsize , ent_type, x2o_Faxa_rain_HDO) + if (ierr .ne. 0) then + call shr_sys_abort(subname//' error in getting Faxa_rain_HDO field') + endif + ! allocate(x2o_Faxa_snow_HDO(lsize)) + tagname = 'Faxa_snow_HDO'//C_NULL_CHAR + ierr = iMOAB_GetDoubleTagStorage ( mboxid, tagname, lsize , ent_type, x2o_Faxa_snow_HDO) + if (ierr .ne. 0) then + call shr_sys_abort(subname//' error in getting Faxa_snow_HDO field') + endif + ! allocate(x2o_Faxa_prec_HDO(lsize)) + tagname = 'Faxa_prec_HDO'//C_NULL_CHAR + ierr = iMOAB_GetDoubleTagStorage ( mboxid, tagname, lsize , ent_type, x2o_Faxa_prec_HDO) + if (ierr .ne. 0) then + call shr_sys_abort(subname//' error in getting Faxa_prec_HDO field') + endif + +! #ifdef NOTDEF do n = 1,lsize - ifrac = fractions_o%rAttr(kif,n) - afrac = fractions_o%rAttr(kof,n) + ifrac = fo_kif_ifrac(n) ! fractions_o%rAttr(kif,n) + afrac = fo_kof_ofrac(n) ! fractions_o%rAttr(kof,n) frac_sum = ifrac + afrac if ((frac_sum) /= 0._r8) then ifrac = ifrac / (frac_sum) afrac = afrac / (frac_sum) endif - ifracr = fractions_o%rAttr(kir,n) - afracr = fractions_o%rAttr(kor,n) + ifracr = fo_kir_ifrad(n) ! fractions_o%rAttr(kir,n) + afracr = fo_kor_ofrad(n) ! fractions_o%rAttr(kor,n) frac_sum = ifracr + afracr if ((frac_sum) /= 0._r8) then ifracr = ifracr / (frac_sum) @@ -1177,103 +1676,103 @@ subroutine prep_ocn_mrg_moab(infodata, xao_ox) endif ! Derived: compute net short-wave - avsdr = xao_o%rAttr(index_xao_So_avsdr,n) - anidr = xao_o%rAttr(index_xao_So_anidr,n) - avsdf = xao_o%rAttr(index_xao_So_avsdf,n) - anidf = xao_o%rAttr(index_xao_So_anidf,n) - fswabsv = a2x_o%rAttr(index_a2x_Faxa_swvdr,n) * (1.0_R8 - avsdr) & - + a2x_o%rAttr(index_a2x_Faxa_swvdf,n) * (1.0_R8 - avsdf) - fswabsi = a2x_o%rAttr(index_a2x_Faxa_swndr,n) * (1.0_R8 - anidr) & - + a2x_o%rAttr(index_a2x_Faxa_swndf,n) * (1.0_R8 - anidf) - x2o_o%rAttr(index_x2o_Foxx_swnet,n) = (fswabsv + fswabsi) * afracr + & - i2x_o%rAttr(index_i2x_Fioi_swpen,n) * ifrac + avsdr = xao_So_avsdr(n) ! xao_o%rAttr(index_xao_So_avsdr,n) + anidr = xao_So_anidr(n) !xao_o%rAttr(index_xao_So_anidr,n) + avsdf = xao_So_avsdf(n) !xao_o%rAttr(index_xao_So_avsdf,n) + anidf = xao_So_anidf(n)! xao_o%rAttr(index_xao_So_anidf,n) + fswabsv = a2x_Faxa_swvdr(n) * (1.0_R8 - avsdr) & !a2x_o%rAttr(index_a2x_Faxa_swvdr,n) * (1.0_R8 - avsdr) & + + a2x_Faxa_swvdf(n) * (1.0_R8 - avsdf) !+ a2x_o%rAttr(index_a2x_Faxa_swvdf,n) * (1.0_R8 - avsdf) + fswabsi = a2x_Faxa_swndr(n) * (1.0_R8 - anidr) & !a2x_o%rAttr(index_a2x_Faxa_swndr,n) * (1.0_R8 - anidr) & + + a2x_Faxa_swndf(n) * (1.0_R8 - anidf) ! + a2x_o%rAttr(index_a2x_Faxa_swndf,n) * (1.0_R8 - anidf) + x2o_Foxx_swnet(n) = (fswabsv + fswabsi) * afracr + & !x2o_o%rAttr(index_x2o_Foxx_swnet,n) = (fswabsv + fswabsi) * afracr + & + i2x_Fioi_swpen(n) * ifrac ! i2x_o%rAttr(index_i2x_Fioi_swpen,n) * ifrac if (seq_flds_i2o_per_cat) then - x2o_o%rAttr(index_x2o_Sf_afrac,n) = afrac - x2o_o%rAttr(index_x2o_Sf_afracr,n) = afracr - x2o_o%rAttr(index_x2o_Foxx_swnet_afracr,n) = (fswabsv + fswabsi) * afracr + x2o_Sf_afrac(n) = afrac ! x2o_o%rAttr(index_x2o_Sf_afrac,n) = afrac + x2o_Sf_afracr(n) = afracr !x2o_o%rAttr(index_x2o_Sf_afracr,n) = afracr + x2o_Foxx_swnet_afracr(n) = (fswabsv + fswabsi) * afracr ! x2o_o%rAttr(index_x2o_Foxx_swnet_afracr,n) = (fswabsv + fswabsi) * afracr end if ! Derived: compute total precipitation - scale total precip and runoff - x2o_o%rAttr(index_x2o_Faxa_snow ,n) = a2x_o%rAttr(index_a2x_Faxa_snowc,n) * afrac + & - a2x_o%rAttr(index_a2x_Faxa_snowl,n) * afrac - x2o_o%rAttr(index_x2o_Faxa_rain ,n) = a2x_o%rAttr(index_a2x_Faxa_rainc,n) * afrac + & - a2x_o%rAttr(index_a2x_Faxa_rainl,n) * afrac + x2o_Faxa_snow (n) = a2x_Faxa_snowc(n) * afrac + & ! x2o_o%rAttr(index_x2o_Faxa_snow ,n) = a2x_o%rAttr(index_a2x_Faxa_snowc,n) * afrac + & + a2x_Faxa_snowl(n) * afrac ! a2x_o%rAttr(index_a2x_Faxa_snowl,n) * afrac + x2o_Faxa_rain (n) = a2x_Faxa_rainc(n) * afrac + & !x2o_o%rAttr(index_x2o_Faxa_rain ,n) = a2x_o%rAttr(index_a2x_Faxa_rainc,n) * afrac + & + a2x_Faxa_rainl(n) * afrac ! a2x_o%rAttr(index_a2x_Faxa_rainl,n) * afrac - x2o_o%rAttr(index_x2o_Faxa_snow ,n) = x2o_o%rAttr(index_x2o_Faxa_snow ,n) * flux_epbalfact - x2o_o%rAttr(index_x2o_Faxa_rain ,n) = x2o_o%rAttr(index_x2o_Faxa_rain ,n) * flux_epbalfact + x2o_Faxa_snow (n) = x2o_Faxa_snow (n) * flux_epbalfact! x2o_o%rAttr(index_x2o_Faxa_snow ,n) = x2o_o%rAttr(index_x2o_Faxa_snow ,n) * flux_epbalfact + x2o_Faxa_rain (n) = x2o_Faxa_rain (n) * flux_epbalfact! x2o_o%rAttr(index_x2o_Faxa_rain ,n) = x2o_o%rAttr(index_x2o_Faxa_rain ,n) * flux_epbalfact - x2o_o%rAttr(index_x2o_Faxa_prec ,n) = x2o_o%rAttr(index_x2o_Faxa_rain ,n) + & - x2o_o%rAttr(index_x2o_Faxa_snow ,n) + x2o_Faxa_prec (n) = x2o_Faxa_rain (n) + & ! x2o_o%rAttr(index_x2o_Faxa_prec ,n) = x2o_o%rAttr(index_x2o_Faxa_rain ,n) + & + x2o_Faxa_snow (n) ! x2o_o%rAttr(index_x2o_Faxa_snow ,n) - x2o_o%rAttr(index_x2o_Foxx_rofl, n) = (r2x_o%rAttr(index_r2x_Forr_rofl , n) + & - r2x_o%rAttr(index_r2x_Flrr_flood, n) ) * flux_epbalfact + x2o_Foxx_rofl (n) = (r2x_Forr_rofl (n) + & ! x2o_o%rAttr(index_x2o_Foxx_rofl, n) = (r2x_o%rAttr(index_r2x_Forr_rofl , n) + & + r2x_Flrr_flood (n) ) * flux_epbalfact ! r2x_o%rAttr(index_r2x_Flrr_flood, n) ) * flux_epbalfact ! g2x_o%rAttr(index_g2x_Fogg_rofl , n)) * flux_epbalfact - x2o_o%rAttr(index_x2o_Foxx_rofi, n) = (r2x_o%rAttr(index_r2x_Forr_rofi , n) ) * flux_epbalfact + x2o_Foxx_rofi( n) = r2x_Forr_rofi (n) * flux_epbalfact ! x2o_o%rAttr(index_x2o_Foxx_rofi, n) = (r2x_o%rAttr(index_r2x_Forr_rofi , n) ) * flux_epbalfact ! g2x_o%rAttr(index_g2x_Fogg_rofi , n)) * flux_epbalfact if ( index_x2o_Foxx_rofl_16O /= 0 ) then - x2o_o%rAttr(index_x2o_Foxx_rofl_16O, n) = (r2x_o%rAttr(index_r2x_Forr_rofl_16O, n) + & - r2x_o%rAttr(index_r2x_Flrr_flood, n) ) * flux_epbalfact + x2o_Foxx_rofl_16O (n) = (r2x_Forr_rofl_16O (n) + & ! x2o_o%rAttr(index_x2o_Foxx_rofl_16O, n) = (r2x_o%rAttr(index_r2x_Forr_rofl_16O, n) + & + r2x_Flrr_flood (n) ) * flux_epbalfact ! r2x_o%rAttr(index_r2x_Flrr_flood, n) ) * flux_epbalfact ! g2x_o%rAttr(index_g2x_Fogg_rofl , n)) * flux_epbalfact - x2o_o%rAttr(index_x2o_Foxx_rofi_16O, n) = (r2x_o%rAttr(index_r2x_Forr_rofi_16O , n) ) * flux_epbalfact + x2o_Foxx_rofi_16O (n) = (r2x_Forr_rofi_16O (n) ) * flux_epbalfact ! x2o_o%rAttr(index_x2o_Foxx_rofi_16O, n) = (r2x_o%rAttr(index_r2x_Forr_rofi_16O , n) ) * flux_epbalfact ! g2x_o%rAttr(index_g2x_Fogg_rofi , n)) * flux_epbalfact - x2o_o%rAttr(index_x2o_Foxx_rofl_18O, n) = (r2x_o%rAttr(index_r2x_Forr_rofl_18O, n) + & - r2x_o%rAttr(index_r2x_Flrr_flood, n) ) * flux_epbalfact + x2o_Foxx_rofl_18O (n) = (r2x_Forr_rofl_18O (n) + & ! x2o_o%rAttr(index_x2o_Foxx_rofl_18O, n) = (r2x_o%rAttr(index_r2x_Forr_rofl_18O, n) + & + r2x_Flrr_flood (n) ) * flux_epbalfact! r2x_o%rAttr(index_r2x_Flrr_flood, n) ) * flux_epbalfact !g2x_o%rAttr(index_g2x_Fogg_rofl , n)) * flux_epbalfact - x2o_o%rAttr(index_x2o_Foxx_rofi_18O, n) = (r2x_o%rAttr(index_r2x_Forr_rofi_18O , n) ) * flux_epbalfact + x2o_Foxx_rofi_18O (n) = (r2x_Forr_rofi_18O (n) ) * flux_epbalfact ! x2o_o%rAttr(index_x2o_Foxx_rofi_18O, n) = (r2x_o%rAttr(index_r2x_Forr_rofi_18O , n) ) * flux_epbalfact !g2x_o%rAttr(index_g2x_Fogg_rofi , n)) * flux_epbalfact - x2o_o%rAttr(index_x2o_Foxx_rofl_HDO, n) = (r2x_o%rAttr(index_r2x_Forr_rofl_HDO, n) + & - r2x_o%rAttr(index_r2x_Flrr_flood, n) ) * flux_epbalfact + x2o_Foxx_rofl_HDO (n) = (r2x_Forr_rofl_HDO (n) + & ! x2o_o%rAttr(index_x2o_Foxx_rofl_HDO, n) = (r2x_o%rAttr(index_r2x_Forr_rofl_HDO, n) + & + r2x_Flrr_flood (n) ) * flux_epbalfact ! r2x_o%rAttr(index_r2x_Flrr_flood, n) ) * flux_epbalfact !g2x_o%rAttr(index_g2x_Fogg_rofl , n)) * flux_epbalfact - x2o_o%rAttr(index_x2o_Foxx_rofi_HDO, n) = (r2x_o%rAttr(index_r2x_Forr_rofi_HDO , n) ) * flux_epbalfact + x2o_Foxx_rofi_HDO (n) = (r2x_Forr_rofi_HDO (n) ) * flux_epbalfact ! x2o_o%rAttr(index_x2o_Foxx_rofi_HDO, n) = (r2x_o%rAttr(index_r2x_Forr_rofi_HDO , n) ) * flux_epbalfact !g2x_o%rAttr(index_g2x_Fogg_rofi , n)) * flux_epbalfact end if ! Derived: water isotopes total preciptiation and scaling if ( index_x2o_Faxa_snow_16O /= 0 )then - x2o_o%rAttr(index_x2o_Faxa_snow_16O ,n) = a2x_o%rAttr(index_a2x_Faxa_snowc_16O,n) * afrac + & - a2x_o%rAttr(index_a2x_Faxa_snowl_16O,n) * afrac - x2o_o%rAttr(index_x2o_Faxa_rain_16O ,n) = a2x_o%rAttr(index_a2x_Faxa_rainc_16O,n) * afrac + & - a2x_o%rAttr(index_a2x_Faxa_rainl_16O,n) * afrac + x2o_Faxa_snow_16O (n) = a2x_Faxa_snowc_16O(n) * afrac + & !x2o_o%rAttr(index_x2o_Faxa_snow_16O ,n) = a2x_o%rAttr(index_a2x_Faxa_snowc_16O,n) * afrac + & + a2x_Faxa_snowl_16O(n) * afrac ! a2x_o%rAttr(index_a2x_Faxa_snowl_16O,n) * afrac + x2o_Faxa_rain_16O (n) = a2x_Faxa_rainc_16O(n) * afrac + & ! x2o_o%rAttr(index_x2o_Faxa_rain_16O ,n) = a2x_o%rAttr(index_a2x_Faxa_rainc_16O,n) * afrac + & + a2x_Faxa_rainl_16O(n) * afrac ! a2x_o%rAttr(index_a2x_Faxa_rainl_16O,n) * afrac - x2o_o%rAttr(index_x2o_Faxa_snow_16O ,n) = x2o_o%rAttr(index_x2o_Faxa_snow_16O ,n) * flux_epbalfact - x2o_o%rAttr(index_x2o_Faxa_rain_16O ,n) = x2o_o%rAttr(index_x2o_Faxa_rain_16O ,n) * flux_epbalfact + x2o_Faxa_snow_16O (n) = x2o_Faxa_snow_16O (n) * flux_epbalfact ! x2o_o%rAttr(index_x2o_Faxa_snow_16O ,n) = x2o_o%rAttr(index_x2o_Faxa_snow_16O ,n) * flux_epbalfact + x2o_Faxa_rain_16O (n) = x2o_Faxa_rain_16O (n) * flux_epbalfact ! x2o_o%rAttr(index_x2o_Faxa_rain_16O ,n) = x2o_o%rAttr(index_x2o_Faxa_rain_16O ,n) * flux_epbalfact - x2o_o%rAttr(index_x2o_Faxa_prec_16O ,n) = x2o_o%rAttr(index_x2o_Faxa_rain_16O ,n) + & - x2o_o%rAttr(index_x2o_Faxa_snow_16O ,n) + x2o_Faxa_prec_16O (n) = x2o_Faxa_rain_16O (n) + & ! x2o_o%rAttr(index_x2o_Faxa_prec_16O ,n) = x2o_o%rAttr(index_x2o_Faxa_rain_16O ,n) + & + x2o_Faxa_snow_16O (n) ! x2o_o%rAttr(index_x2o_Faxa_snow_16O ,n) end if if ( index_x2o_Faxa_snow_18O /= 0 )then - x2o_o%rAttr(index_x2o_Faxa_snow_18O ,n) = a2x_o%rAttr(index_a2x_Faxa_snowc_18O,n) * afrac + & - a2x_o%rAttr(index_a2x_Faxa_snowl_18O,n) * afrac - x2o_o%rAttr(index_x2o_Faxa_rain_18O ,n) = a2x_o%rAttr(index_a2x_Faxa_rainc_18O,n) * afrac + & - a2x_o%rAttr(index_a2x_Faxa_rainl_18O,n) * afrac + x2o_Faxa_snow_18O (n) = a2x_Faxa_snowc_18O(n) * afrac + & ! x2o_o%rAttr(index_x2o_Faxa_snow_18O ,n) = a2x_o%rAttr(index_a2x_Faxa_snowc_18O,n) * afrac + & + a2x_Faxa_snowl_18O(n) * afrac ! a2x_o%rAttr(index_a2x_Faxa_snowl_18O,n) * afrac + x2o_Faxa_rain_18O (n) = a2x_Faxa_rainc_18O(n) * afrac + & ! x2o_o%rAttr(index_x2o_Faxa_rain_18O ,n) = a2x_o%rAttr(index_a2x_Faxa_rainc_18O,n) * afrac + & + a2x_Faxa_rainl_18O(n) * afrac ! a2x_o%rAttr(index_a2x_Faxa_rainl_18O,n) * afrac - x2o_o%rAttr(index_x2o_Faxa_snow_18O ,n) = x2o_o%rAttr(index_x2o_Faxa_snow_18O ,n) * flux_epbalfact - x2o_o%rAttr(index_x2o_Faxa_rain_18O ,n) = x2o_o%rAttr(index_x2o_Faxa_rain_18O ,n) * flux_epbalfact + x2o_Faxa_snow_18O (n) = x2o_Faxa_snow_18O (n) * flux_epbalfact ! x2o_o%rAttr(index_x2o_Faxa_snow_18O ,n) = x2o_o%rAttr(index_x2o_Faxa_snow_18O ,n) * flux_epbalfact + x2o_Faxa_rain_18O (n) = x2o_Faxa_rain_18O (n) * flux_epbalfact ! x2o_o%rAttr(index_x2o_Faxa_rain_18O ,n) = x2o_o%rAttr(index_x2o_Faxa_rain_18O ,n) * flux_epbalfact - x2o_o%rAttr(index_x2o_Faxa_prec_18O ,n) = x2o_o%rAttr(index_x2o_Faxa_rain_18O ,n) + & - x2o_o%rAttr(index_x2o_Faxa_snow_18O ,n) + x2o_Faxa_prec_18O (n) = X2o_Faxa_rain_18O (n) + & ! x2o_o%rAttr(index_x2o_Faxa_prec_18O ,n) = x2o_o%rAttr(index_x2o_Faxa_rain_18O ,n) + & + x2o_Faxa_snow_18O (n) ! x2o_o%rAttr(index_x2o_Faxa_snow_18O ,n) end if if ( index_x2o_Faxa_snow_HDO /= 0 )then - x2o_o%rAttr(index_x2o_Faxa_snow_HDO ,n) = a2x_o%rAttr(index_a2x_Faxa_snowc_HDO,n) * afrac + & - a2x_o%rAttr(index_a2x_Faxa_snowl_HDO,n) * afrac - x2o_o%rAttr(index_x2o_Faxa_rain_HDO ,n) = a2x_o%rAttr(index_a2x_Faxa_rainc_HDO,n) * afrac + & - a2x_o%rAttr(index_a2x_Faxa_rainl_HDO,n) * afrac + x2o_Faxa_snow_HDO (n) = a2x_Faxa_snowc_HDO(n) * afrac + & ! x2o_o%rAttr(index_x2o_Faxa_snow_HDO ,n) = a2x_o%rAttr(index_a2x_Faxa_snowc_HDO,n) * afrac + & + a2x_Faxa_snowl_HDO(n) * afrac ! a2x_o%rAttr(index_a2x_Faxa_snowl_HDO,n) * afrac + x2o_Faxa_rain_HDO (n) = a2x_Faxa_rainc_HDO(n) * afrac + & !x2o_o%rAttr(index_x2o_Faxa_rain_HDO ,n) = a2x_o%rAttr(index_a2x_Faxa_rainc_HDO,n) * afrac + & + a2x_Faxa_rainl_HDO(n) * afrac ! a2x_o%rAttr(index_a2x_Faxa_rainl_HDO,n) * afrac - x2o_o%rAttr(index_x2o_Faxa_snow_HDO ,n) = x2o_o%rAttr(index_x2o_Faxa_snow_HDO ,n) * flux_epbalfact - x2o_o%rAttr(index_x2o_Faxa_rain_HDO ,n) = x2o_o%rAttr(index_x2o_Faxa_rain_HDO ,n) * flux_epbalfact + x2o_Faxa_snow_HDO (n) = x2o_Faxa_snow_HDO (n) * flux_epbalfact ! x2o_o%rAttr(index_x2o_Faxa_snow_HDO ,n) = x2o_o%rAttr(index_x2o_Faxa_snow_HDO ,n) * flux_epbalfact + x2o_Faxa_rain_HDO (n) = x2o_Faxa_rain_HDO (n) * flux_epbalfact ! x2o_o%rAttr(index_x2o_Faxa_rain_HDO ,n) = x2o_o%rAttr(index_x2o_Faxa_rain_HDO ,n) * flux_epbalfact - x2o_o%rAttr(index_x2o_Faxa_prec_HDO ,n) = x2o_o%rAttr(index_x2o_Faxa_rain_HDO ,n) + & - x2o_o%rAttr(index_x2o_Faxa_snow_HDO ,n) + x2o_Faxa_prec_HDO (n) = x2o_Faxa_rain_HDO (n) + & ! x2o_o%rAttr(index_x2o_Faxa_prec_HDO ,n) = x2o_o%rAttr(index_x2o_Faxa_rain_HDO ,n) + & + x2o_Faxa_snow_HDO (n) ! x2o_o%rAttr(index_x2o_Faxa_snow_HDO ,n) end if end do -#endif +! #endif do ko = 1,noflds !--- document merge --- if (first_time) then @@ -1301,8 +1800,10 @@ subroutine prep_ocn_mrg_moab(infodata, xao_ox) endif #ifdef NOTDEF do n = 1,lsize - ifrac = fractions_o%rAttr(kif,n) - afrac = fractions_o%rAttr(kof,n) + ifrac = fo_kif_ifrac(n) ! fractions_o%rAttr(kif,n) + afrac = fo_kof_ofrac(n) ! fractions_o%rAttr(kof,n) + ! ifrac = fractions_o%rAttr(kif,n) + ! afrac = fractions_o%rAttr(kof,n) frac_sum = ifrac + afrac if ((frac_sum) /= 0._r8) then ifrac = ifrac / (frac_sum) From 823bb059ca816b03fc445f45950c4d54c74942fa Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Sun, 11 Sep 2022 06:49:27 -0500 Subject: [PATCH 179/467] ocean merging wiso_flds means water isotopes fields they refer to fields that end in _160, _180, HDO they are skipped when namelist variable wiso_flds is false also, use iMOAB_SetDoubleTagStorage for x2o fields, after computations are done in general, change the code by using arrays instead of indices , like this: old code: avsdr = xao_o%rAttr(index_xao_So_avsdr,n) new code: avsdr = xao_So_avsdr(n) another example: old code: fswabsv = a2x_o%rAttr(index_a2x_Faxa_swvdr,n) * (1.0_R8 - avsdr) & + a2x_o%rAttr(index_a2x_Faxa_swvdf,n) * (1.0_R8 - avsdf) new code: fswabsv = a2x_Faxa_swvdr(n) * (1.0_R8 - avsdr) & + a2x_Faxa_swvdf(n) * (1.0_R8 - avsdf) --- driver-moab/main/prep_ocn_mod.F90 | 592 +++++++++++++++--------------- 1 file changed, 304 insertions(+), 288 deletions(-) diff --git a/driver-moab/main/prep_ocn_mod.F90 b/driver-moab/main/prep_ocn_mod.F90 index f1907c3f8026..da5581c040cc 100644 --- a/driver-moab/main/prep_ocn_mod.F90 +++ b/driver-moab/main/prep_ocn_mod.F90 @@ -629,7 +629,7 @@ end subroutine prep_ocn_mrg subroutine prep_ocn_mrg_moab(infodata, xao_ox) - use iMOAB , only : iMOAB_GetMeshInfo, iMOAB_GetDoubleTagStorage + use iMOAB , only : iMOAB_GetMeshInfo, iMOAB_GetDoubleTagStorage, iMOAB_SetDoubleTagStorage use seq_comm_mct , only : mboxid, mbox2id ! ocean and atm-ocean flux instances !--------------------------------------------------------------- ! Description @@ -1096,7 +1096,7 @@ subroutine prep_ocn_mrg_moab(infodata, xao_ox) end if !call mct_aVect_zero(x2o_o) - ! replace with something else + ! replace with something else; make all x2o_fields 0 ? TODO !--- document copy operations --- if (first_time) then @@ -1221,12 +1221,46 @@ subroutine prep_ocn_mrg_moab(infodata, xao_ox) allocate(a2x_Faxa_rainl(lsize)) allocate(r2x_Forr_rofl(lsize)) allocate(r2x_Forr_rofi(lsize)) - allocate(r2x_Forr_rofl_16O(lsize)) - allocate(r2x_Forr_rofi_16O(lsize)) - allocate(r2x_Forr_rofl_18O(lsize)) - allocate(r2x_Forr_rofi_18O(lsize)) - allocate(r2x_Forr_rofl_HDO(lsize)) - allocate(r2x_Forr_rofi_HDO(lsize)) + + if ( index_x2o_Foxx_rofl_16O /= 0 ) then ! also flds_wiso true + allocate(r2x_Forr_rofl_16O(lsize)) + allocate(r2x_Forr_rofi_16O(lsize)) + allocate(x2o_Foxx_rofl_16O(lsize)) + allocate(x2o_Foxx_rofi_16O(lsize)) + allocate(a2x_Faxa_snowc_16O(lsize)) + allocate(a2x_Faxa_snowl_16O(lsize)) + allocate(a2x_Faxa_rainc_16O(lsize)) + allocate(a2x_Faxa_rainl_16O(lsize)) + allocate(x2o_Faxa_rain_16O(lsize)) + allocate(x2o_Faxa_snow_16O(lsize)) + allocate(x2o_Faxa_prec_16O(lsize)) + allocate(r2x_Forr_rofl_18O(lsize)) + allocate(r2x_Forr_rofi_18O(lsize)) + allocate(r2x_Forr_rofl_HDO(lsize)) + allocate(r2x_Forr_rofi_HDO(lsize)) + allocate(x2o_Foxx_rofl_18O(lsize)) + allocate(x2o_Foxx_rofi_18O(lsize)) + allocate(x2o_Foxx_rofl_HDO(lsize)) + allocate(x2o_Foxx_rofi_HDO(lsize)) + + + allocate(a2x_Faxa_snowc_18O(lsize)) + allocate(a2x_Faxa_snowl_18O(lsize)) + allocate(a2x_Faxa_rainc_18O(lsize)) + allocate(a2x_Faxa_rainl_18O(lsize)) + allocate(x2o_Faxa_rain_18O(lsize)) + allocate(x2o_Faxa_snow_18O(lsize)) + allocate(x2o_Faxa_prec_18O(lsize)) + allocate(a2x_Faxa_snowc_HDO(lsize)) + allocate(a2x_Faxa_snowl_HDO(lsize)) + allocate(a2x_Faxa_rainc_HDO(lsize)) + allocate(a2x_Faxa_rainl_HDO(lsize)) + allocate(x2o_Faxa_rain_HDO(lsize)) + allocate(x2o_Faxa_snow_HDO(lsize)) + allocate(x2o_Faxa_prec_HDO(lsize)) + + endif + allocate(r2x_Flrr_flood(lsize)) allocate(g2x_Fogg_rofl(lsize)) allocate(g2x_Fogg_rofi(lsize)) @@ -1239,33 +1273,6 @@ subroutine prep_ocn_mrg_moab(infodata, xao_ox) allocate(x2o_Sf_afrac(lsize)) allocate(x2o_Sf_afracr(lsize)) allocate(x2o_Foxx_swnet_afracr(lsize)) - allocate(x2o_Foxx_rofl_16O(lsize)) - allocate(x2o_Foxx_rofi_16O(lsize)) - allocate(x2o_Foxx_rofl_18O(lsize)) - allocate(x2o_Foxx_rofi_18O(lsize)) - allocate(x2o_Foxx_rofl_HDO(lsize)) - allocate(x2o_Foxx_rofi_HDO(lsize)) - allocate(a2x_Faxa_snowc_16O(lsize)) - allocate(a2x_Faxa_snowl_16O(lsize)) - allocate(a2x_Faxa_rainc_16O(lsize)) - allocate(a2x_Faxa_rainl_16O(lsize)) - allocate(x2o_Faxa_rain_16O(lsize)) - allocate(x2o_Faxa_snow_16O(lsize)) - allocate(x2o_Faxa_prec_16O(lsize)) - allocate(a2x_Faxa_snowc_18O(lsize)) - allocate(a2x_Faxa_snowl_18O(lsize)) - allocate(a2x_Faxa_rainc_18O(lsize)) - allocate(a2x_Faxa_rainl_18O(lsize)) - allocate(x2o_Faxa_rain_18O(lsize)) - allocate(x2o_Faxa_snow_18O(lsize)) - allocate(x2o_Faxa_prec_18O(lsize)) - allocate(a2x_Faxa_snowc_HDO(lsize)) - allocate(a2x_Faxa_snowl_HDO(lsize)) - allocate(a2x_Faxa_rainc_HDO(lsize)) - allocate(a2x_Faxa_rainl_HDO(lsize)) - allocate(x2o_Faxa_rain_HDO(lsize)) - allocate(x2o_Faxa_snow_HDO(lsize)) - allocate(x2o_Faxa_prec_HDO(lsize)) endif @@ -1384,42 +1391,208 @@ subroutine prep_ocn_mrg_moab(infodata, xao_ox) if (ierr .ne. 0) then call shr_sys_abort(subname//' error in getting Forr_rofi field') endif - ! allocate(r2x_Forr_rofl_16O(lsize)) - tagname = 'Forr_rofl_16O'//C_NULL_CHAR - ierr = iMOAB_GetDoubleTagStorage ( mboxid, tagname, lsize , ent_type, r2x_Forr_rofl_16O) - if (ierr .ne. 0) then - call shr_sys_abort(subname//' error in getting Forr_rofl_16O field') - endif - ! allocate(r2x_Forr_rofi_16O(lsize)) - tagname = 'Forr_rofi_16O'//C_NULL_CHAR - ierr = iMOAB_GetDoubleTagStorage ( mboxid, tagname, lsize , ent_type, r2x_Forr_rofi_16O) - if (ierr .ne. 0) then - call shr_sys_abort(subname//' error in getting Forr_rofi_16O field') - endif - ! allocate(r2x_Forr_rofl_18O(lsize)) - tagname = 'Forr_rofl_18O'//C_NULL_CHAR - ierr = iMOAB_GetDoubleTagStorage ( mboxid, tagname, lsize , ent_type, r2x_Forr_rofl_18O) - if (ierr .ne. 0) then - call shr_sys_abort(subname//' error in getting Forr_rofl_18O field') - endif - ! allocate(r2x_Forr_rofi_18O(lsize)) - tagname = 'Forr_rofi_18O'//C_NULL_CHAR - ierr = iMOAB_GetDoubleTagStorage ( mboxid, tagname, lsize , ent_type, r2x_Forr_rofi_18O) - if (ierr .ne. 0) then - call shr_sys_abort(subname//' error in getting Forr_rofi_18O field') - endif - ! allocate(r2x_Forr_rofi_18O(lsize)) - tagname = 'Forr_rofi_18O'//C_NULL_CHAR - ierr = iMOAB_GetDoubleTagStorage ( mboxid, tagname, lsize , ent_type, r2x_Forr_rofi_18O) - if (ierr .ne. 0) then - call shr_sys_abort(subname//' error in getting Forr_rofi_18O field') - endif - ! allocate(r2x_Forr_rofi_HDO(lsize)) - tagname = 'Forr_rofi_HDO'//C_NULL_CHAR - ierr = iMOAB_GetDoubleTagStorage ( mboxid, tagname, lsize , ent_type, r2x_Forr_rofi_HDO) - if (ierr .ne. 0) then - call shr_sys_abort(subname//' error in getting Forr_rofi_HDO field') - endif + + if ( index_x2o_Foxx_rofl_16O /= 0 ) then ! also flds_wiso true + ! allocate(r2x_Forr_rofl_16O(lsize)) + tagname = 'Forr_rofl_16O'//C_NULL_CHAR + ierr = iMOAB_GetDoubleTagStorage ( mboxid, tagname, lsize , ent_type, r2x_Forr_rofl_16O) + if (ierr .ne. 0) then + call shr_sys_abort(subname//' error in getting Forr_rofl_16O field') + endif + ! allocate(r2x_Forr_rofi_16O(lsize)) + tagname = 'Forr_rofi_16O'//C_NULL_CHAR + ierr = iMOAB_GetDoubleTagStorage ( mboxid, tagname, lsize , ent_type, r2x_Forr_rofi_16O) + if (ierr .ne. 0) then + call shr_sys_abort(subname//' error in getting Forr_rofi_16O field') + endif + ! allocate(r2x_Forr_rofl_18O(lsize)) + tagname = 'Forr_rofl_18O'//C_NULL_CHAR + ierr = iMOAB_GetDoubleTagStorage ( mboxid, tagname, lsize , ent_type, r2x_Forr_rofl_18O) + if (ierr .ne. 0) then + call shr_sys_abort(subname//' error in getting Forr_rofl_18O field') + endif + ! allocate(r2x_Forr_rofi_18O(lsize)) + tagname = 'Forr_rofi_18O'//C_NULL_CHAR + ierr = iMOAB_GetDoubleTagStorage ( mboxid, tagname, lsize , ent_type, r2x_Forr_rofi_18O) + if (ierr .ne. 0) then + call shr_sys_abort(subname//' error in getting Forr_rofi_18O field') + endif + ! allocate(r2x_Forr_rofi_18O(lsize)) + tagname = 'Forr_rofi_18O'//C_NULL_CHAR + ierr = iMOAB_GetDoubleTagStorage ( mboxid, tagname, lsize , ent_type, r2x_Forr_rofi_18O) + if (ierr .ne. 0) then + call shr_sys_abort(subname//' error in getting Forr_rofi_18O field') + endif + ! allocate(r2x_Forr_rofi_HDO(lsize)) + tagname = 'Forr_rofi_HDO'//C_NULL_CHAR + ierr = iMOAB_GetDoubleTagStorage ( mboxid, tagname, lsize , ent_type, r2x_Forr_rofi_HDO) + if (ierr .ne. 0) then + call shr_sys_abort(subname//' error in getting Forr_rofi_HDO field') + endif + ! allocate(x2o_Foxx_rofl_16O(lsize)) + tagname = 'Foxx_rofl_16O'//C_NULL_CHAR + ierr = iMOAB_GetDoubleTagStorage ( mboxid, tagname, lsize , ent_type, x2o_Foxx_rofl_16O) + if (ierr .ne. 0) then + call shr_sys_abort(subname//' error in getting Foxx_rofl_16O field') + endif + ! allocate(x2o_Foxx_rofi_16O(lsize)) + tagname = 'Foxx_rofi_16O'//C_NULL_CHAR + ierr = iMOAB_GetDoubleTagStorage ( mboxid, tagname, lsize , ent_type, x2o_Foxx_rofi_16O) + if (ierr .ne. 0) then + call shr_sys_abort(subname//' error in getting Foxx_rofi_16O field') + endif + ! allocate(x2o_Foxx_rofl_18O(lsize)) + tagname = 'Foxx_rofl_18O'//C_NULL_CHAR + ierr = iMOAB_GetDoubleTagStorage ( mboxid, tagname, lsize , ent_type, x2o_Foxx_rofl_18O) + if (ierr .ne. 0) then + call shr_sys_abort(subname//' error in getting Foxx_rofl_18O field') + endif + ! allocate(x2o_Foxx_rofi_18O(lsize)) + tagname = 'Foxx_rofi_18O'//C_NULL_CHAR + ierr = iMOAB_GetDoubleTagStorage ( mboxid, tagname, lsize , ent_type, x2o_Foxx_rofi_18O) + if (ierr .ne. 0) then + call shr_sys_abort(subname//' error in getting Foxx_rofi_18O field') + endif + ! allocate(x2o_Foxx_rofl_HDO(lsize)) + tagname = 'Foxx_rofl_HDO'//C_NULL_CHAR + ierr = iMOAB_GetDoubleTagStorage ( mboxid, tagname, lsize , ent_type, x2o_Foxx_rofl_HDO) + if (ierr .ne. 0) then + call shr_sys_abort(subname//' error in getting Foxx_rofl_HDO field') + endif + ! allocate(x2o_Foxx_rofi_HDO(lsize)) + tagname = 'Foxx_rofi_HDO'//C_NULL_CHAR + ierr = iMOAB_GetDoubleTagStorage ( mboxid, tagname, lsize , ent_type, x2o_Foxx_rofi_HDO) + if (ierr .ne. 0) then + call shr_sys_abort(subname//' error in getting Foxx_rofi_HDO field') + endif + ! allocate(a2x_Faxa_snowc_16O(lsize)) + tagname = 'Faxa_snowc_16O'//C_NULL_CHAR + ierr = iMOAB_GetDoubleTagStorage ( mboxid, tagname, lsize , ent_type, a2x_Faxa_snowc_16O) + if (ierr .ne. 0) then + call shr_sys_abort(subname//' error in getting Faxa_snowc_16O field') + endif + ! allocate(a2x_Faxa_snowl_16O(lsize)) + tagname = 'Faxa_snowl_16O'//C_NULL_CHAR + ierr = iMOAB_GetDoubleTagStorage ( mboxid, tagname, lsize , ent_type, a2x_Faxa_snowl_16O) + if (ierr .ne. 0) then + call shr_sys_abort(subname//' error in getting Faxa_snowl_16O field') + endif + ! allocate(a2x_Faxa_rainc_16O(lsize)) + tagname = 'Faxa_rainc_16O'//C_NULL_CHAR + ierr = iMOAB_GetDoubleTagStorage ( mboxid, tagname, lsize , ent_type, a2x_Faxa_rainc_16O) + if (ierr .ne. 0) then + call shr_sys_abort(subname//' error in getting Faxa_rainc_16O field') + endif + ! allocate(a2x_Faxa_rainl_16O(lsize)) + tagname = 'Faxa_rainl_16O'//C_NULL_CHAR + ierr = iMOAB_GetDoubleTagStorage ( mboxid, tagname, lsize , ent_type, a2x_Faxa_rainl_16O) + if (ierr .ne. 0) then + call shr_sys_abort(subname//' error in getting Faxa_rainl_16O field') + endif + ! allocate(x2o_Faxa_rain_16O(lsize)) + tagname = 'Faxa_rain_16O'//C_NULL_CHAR + ierr = iMOAB_GetDoubleTagStorage ( mboxid, tagname, lsize , ent_type, x2o_Faxa_rain_16O) + if (ierr .ne. 0) then + call shr_sys_abort(subname//' error in getting Faxa_rain_16O field') + endif + ! allocate(x2o_Faxa_snow_16O(lsize)) + tagname = 'Faxa_snow_16O'//C_NULL_CHAR + ierr = iMOAB_GetDoubleTagStorage ( mboxid, tagname, lsize , ent_type, x2o_Faxa_snow_16O) + if (ierr .ne. 0) then + call shr_sys_abort(subname//' error in getting Faxa_snow_16O field') + endif + ! allocate(x2o_Faxa_prec_16O(lsize)) + tagname = 'Faxa_prec_16O'//C_NULL_CHAR + ierr = iMOAB_GetDoubleTagStorage ( mboxid, tagname, lsize , ent_type, x2o_Faxa_prec_16O) + if (ierr .ne. 0) then + call shr_sys_abort(subname//' error in getting Faxa_prec_16O field') + endif + ! allocate(a2x_Faxa_snowc_18O(lsize)) + tagname = 'Faxa_snowc_18O'//C_NULL_CHAR + ierr = iMOAB_GetDoubleTagStorage ( mboxid, tagname, lsize , ent_type, a2x_Faxa_snowc_18O) + if (ierr .ne. 0) then + call shr_sys_abort(subname//' error in getting Faxa_snowc_18O field') + endif + ! allocate(a2x_Faxa_snowl_18O(lsize)) + tagname = 'Faxa_snowl_18O'//C_NULL_CHAR + ierr = iMOAB_GetDoubleTagStorage ( mboxid, tagname, lsize , ent_type, a2x_Faxa_snowl_18O) + if (ierr .ne. 0) then + call shr_sys_abort(subname//' error in getting Faxa_snowl_18O field') + endif + ! allocate(a2x_Faxa_rainc_18O(lsize)) + tagname = 'Faxa_rainc_18O'//C_NULL_CHAR + ierr = iMOAB_GetDoubleTagStorage ( mboxid, tagname, lsize , ent_type, a2x_Faxa_rainc_18O) + if (ierr .ne. 0) then + call shr_sys_abort(subname//' error in getting Faxa_rainc_18O field') + endif + ! allocate(a2x_Faxa_rainl_18O(lsize)) + tagname = 'Faxa_rainl_18O'//C_NULL_CHAR + ierr = iMOAB_GetDoubleTagStorage ( mboxid, tagname, lsize , ent_type, a2x_Faxa_rainl_18O) + if (ierr .ne. 0) then + call shr_sys_abort(subname//' error in getting Faxa_rainl_18O field') + endif + ! allocate(x2o_Faxa_rain_18O(lsize)) + tagname = 'Faxa_rain_18O'//C_NULL_CHAR + ierr = iMOAB_GetDoubleTagStorage ( mboxid, tagname, lsize , ent_type, x2o_Faxa_rain_18O) + if (ierr .ne. 0) then + call shr_sys_abort(subname//' error in getting Faxa_rain_18O field') + endif + ! allocate(x2o_Faxa_snow_18O(lsize)) + tagname = 'Faxa_snow_18O'//C_NULL_CHAR + ierr = iMOAB_GetDoubleTagStorage ( mboxid, tagname, lsize , ent_type, x2o_Faxa_snow_18O) + if (ierr .ne. 0) then + call shr_sys_abort(subname//' error in getting Faxa_snow_18O field') + endif + ! allocate(x2o_Faxa_prec_18O(lsize)) + tagname = 'Faxa_prec_18O'//C_NULL_CHAR + ierr = iMOAB_GetDoubleTagStorage ( mboxid, tagname, lsize , ent_type, x2o_Faxa_prec_18O) + if (ierr .ne. 0) then + call shr_sys_abort(subname//' error in getting Faxa_prec_18O field') + endif + ! allocate(a2x_Faxa_snowc_HDO(lsize)) + tagname = 'Faxa_snowc_HDO'//C_NULL_CHAR + ierr = iMOAB_GetDoubleTagStorage ( mboxid, tagname, lsize , ent_type, a2x_Faxa_snowc_HDO) + if (ierr .ne. 0) then + call shr_sys_abort(subname//' error in getting Faxa_snowc_HDO field') + endif + ! allocate(a2x_Faxa_snowl_HDO(lsize)) + tagname = 'Faxa_snowl_HDO'//C_NULL_CHAR + ierr = iMOAB_GetDoubleTagStorage ( mboxid, tagname, lsize , ent_type, a2x_Faxa_snowl_HDO) + if (ierr .ne. 0) then + call shr_sys_abort(subname//' error in getting Faxa_snowl_HDO field') + endif + ! allocate(a2x_Faxa_rainc_HDO(lsize)) + tagname = 'Faxa_rainc_HDO'//C_NULL_CHAR + ierr = iMOAB_GetDoubleTagStorage ( mboxid, tagname, lsize , ent_type, a2x_Faxa_rainc_HDO) + if (ierr .ne. 0) then + call shr_sys_abort(subname//' error in getting Faxa_rainc_HDO field') + endif + ! allocate(a2x_Faxa_rainl_HDO(lsize)) + tagname = 'Faxa_rainl_HDO'//C_NULL_CHAR + ierr = iMOAB_GetDoubleTagStorage ( mboxid, tagname, lsize , ent_type, a2x_Faxa_rainl_HDO) + if (ierr .ne. 0) then + call shr_sys_abort(subname//' error in getting Faxa_rainl_HDO field') + endif + ! allocate(x2o_Faxa_rain_HDO(lsize)) + tagname = 'Faxa_rain_HDO'//C_NULL_CHAR + ierr = iMOAB_GetDoubleTagStorage ( mboxid, tagname, lsize , ent_type, x2o_Faxa_rain_HDO) + if (ierr .ne. 0) then + call shr_sys_abort(subname//' error in getting Faxa_rain_HDO field') + endif + ! allocate(x2o_Faxa_snow_HDO(lsize)) + tagname = 'Faxa_snow_HDO'//C_NULL_CHAR + ierr = iMOAB_GetDoubleTagStorage ( mboxid, tagname, lsize , ent_type, x2o_Faxa_snow_HDO) + if (ierr .ne. 0) then + call shr_sys_abort(subname//' error in getting Faxa_snow_HDO field') + endif + ! allocate(x2o_Faxa_prec_HDO(lsize)) + tagname = 'Faxa_prec_HDO'//C_NULL_CHAR + ierr = iMOAB_GetDoubleTagStorage ( mboxid, tagname, lsize , ent_type, x2o_Faxa_prec_HDO) + if (ierr .ne. 0) then + call shr_sys_abort(subname//' error in getting Faxa_prec_HDO field') + endif + + endif ! allocate(r2x_Flrr_flood(lsize)) tagname = 'Flrr_flood'//C_NULL_CHAR ierr = iMOAB_GetDoubleTagStorage ( mboxid, tagname, lsize , ent_type, r2x_Flrr_flood) @@ -1438,223 +1611,8 @@ subroutine prep_ocn_mrg_moab(infodata, xao_ox) ! if (ierr .ne. 0) then ! call shr_sys_abort(subname//' error in getting Faxa_swndf field') ! endif - ! allocate(x2o_Foxx_swnet(lsize)) - tagname = 'Foxx_swnet'//C_NULL_CHAR - ierr = iMOAB_GetDoubleTagStorage ( mboxid, tagname, lsize , ent_type, x2o_Foxx_swnet) - if (ierr .ne. 0) then - call shr_sys_abort(subname//' error in getting Foxx_swnet field') - endif - ! allocate(x2o_Faxa_snow(lsize)) - tagname = 'Faxa_snow'//C_NULL_CHAR - ierr = iMOAB_GetDoubleTagStorage ( mboxid, tagname, lsize , ent_type, x2o_Faxa_snow) - if (ierr .ne. 0) then - call shr_sys_abort(subname//' error in getting Faxa_snow field') - endif - ! allocate(x2o_Faxa_rain(lsize)) - tagname = 'Faxa_rain'//C_NULL_CHAR - ierr = iMOAB_GetDoubleTagStorage ( mboxid, tagname, lsize , ent_type, x2o_Faxa_rain) - if (ierr .ne. 0) then - call shr_sys_abort(subname//' error in getting Faxa_rain field') - endif - ! allocate(x2o_Faxa_prec(lsize)) - tagname = 'Faxa_prec'//C_NULL_CHAR - ierr = iMOAB_GetDoubleTagStorage ( mboxid, tagname, lsize , ent_type, x2o_Faxa_prec) - if (ierr .ne. 0) then - call shr_sys_abort(subname//' error in getting Faxa_prec field') - endif - ! allocate(x2o_Foxx_rofl(lsize)) - tagname = 'Foxx_rofl'//C_NULL_CHAR - ierr = iMOAB_GetDoubleTagStorage ( mboxid, tagname, lsize , ent_type, x2o_Foxx_rofl) - if (ierr .ne. 0) then - call shr_sys_abort(subname//' error in getting Foxx_rofl field') - endif - ! allocate(x2o_Foxx_rofi(lsize)) - tagname = 'Foxx_rofi'//C_NULL_CHAR - ierr = iMOAB_GetDoubleTagStorage ( mboxid, tagname, lsize , ent_type, x2o_Foxx_rofi) - if (ierr .ne. 0) then - call shr_sys_abort(subname//' error in getting Foxx_rofi field') - endif - ! allocate(x2o_Sf_afrac(lsize)) - tagname = 'Sf_afrac'//C_NULL_CHAR - ierr = iMOAB_GetDoubleTagStorage ( mboxid, tagname, lsize , ent_type, x2o_Sf_afrac) - if (ierr .ne. 0) then - call shr_sys_abort(subname//' error in getting Sf_afrac field') - endif - ! allocate(x2o_Sf_afracr(lsize)) - tagname = 'Sf_afracr'//C_NULL_CHAR - ierr = iMOAB_GetDoubleTagStorage ( mboxid, tagname, lsize , ent_type, x2o_Sf_afracr) - if (ierr .ne. 0) then - call shr_sys_abort(subname//' error in getting Sf_afracr field') - endif - ! allocate(x2o_Foxx_swnet_afracr(lsize)) - tagname = 'Foxx_swnet_afracr'//C_NULL_CHAR - ierr = iMOAB_GetDoubleTagStorage ( mboxid, tagname, lsize , ent_type, x2o_Foxx_swnet_afracr) - if (ierr .ne. 0) then - call shr_sys_abort(subname//' error in getting Foxx_swnet_afracr field') - endif - ! allocate(x2o_Foxx_rofl_16O(lsize)) - tagname = 'Foxx_rofl_16O'//C_NULL_CHAR - ierr = iMOAB_GetDoubleTagStorage ( mboxid, tagname, lsize , ent_type, x2o_Foxx_rofl_16O) - if (ierr .ne. 0) then - call shr_sys_abort(subname//' error in getting Foxx_rofl_16O field') - endif - ! allocate(x2o_Foxx_rofi_16O(lsize)) - tagname = 'Foxx_rofi_16O'//C_NULL_CHAR - ierr = iMOAB_GetDoubleTagStorage ( mboxid, tagname, lsize , ent_type, x2o_Foxx_rofi_16O) - if (ierr .ne. 0) then - call shr_sys_abort(subname//' error in getting Foxx_rofi_16O field') - endif - ! allocate(x2o_Foxx_rofl_18O(lsize)) - tagname = 'Foxx_rofl_18O'//C_NULL_CHAR - ierr = iMOAB_GetDoubleTagStorage ( mboxid, tagname, lsize , ent_type, x2o_Foxx_rofl_18O) - if (ierr .ne. 0) then - call shr_sys_abort(subname//' error in getting Foxx_rofl_18O field') - endif - ! allocate(x2o_Foxx_rofi_18O(lsize)) - tagname = 'Foxx_rofi_18O'//C_NULL_CHAR - ierr = iMOAB_GetDoubleTagStorage ( mboxid, tagname, lsize , ent_type, x2o_Foxx_rofi_18O) - if (ierr .ne. 0) then - call shr_sys_abort(subname//' error in getting Foxx_rofi_18O field') - endif - ! allocate(x2o_Foxx_rofl_HDO(lsize)) - tagname = 'Foxx_rofl_HDO'//C_NULL_CHAR - ierr = iMOAB_GetDoubleTagStorage ( mboxid, tagname, lsize , ent_type, x2o_Foxx_rofl_HDO) - if (ierr .ne. 0) then - call shr_sys_abort(subname//' error in getting Foxx_rofl_HDO field') - endif - ! allocate(x2o_Foxx_rofi_HDO(lsize)) - tagname = 'Foxx_rofi_HDO'//C_NULL_CHAR - ierr = iMOAB_GetDoubleTagStorage ( mboxid, tagname, lsize , ent_type, x2o_Foxx_rofi_HDO) - if (ierr .ne. 0) then - call shr_sys_abort(subname//' error in getting Foxx_rofi_HDO field') - endif - ! allocate(a2x_Faxa_snowc_16O(lsize)) - tagname = 'Faxa_snowc_16O'//C_NULL_CHAR - ierr = iMOAB_GetDoubleTagStorage ( mboxid, tagname, lsize , ent_type, a2x_Faxa_snowc_16O) - if (ierr .ne. 0) then - call shr_sys_abort(subname//' error in getting Faxa_snowc_16O field') - endif - ! allocate(a2x_Faxa_snowl_16O(lsize)) - tagname = 'Faxa_snowl_16O'//C_NULL_CHAR - ierr = iMOAB_GetDoubleTagStorage ( mboxid, tagname, lsize , ent_type, a2x_Faxa_snowl_16O) - if (ierr .ne. 0) then - call shr_sys_abort(subname//' error in getting Faxa_snowl_16O field') - endif - ! allocate(a2x_Faxa_rainc_16O(lsize)) - tagname = 'Faxa_rainc_16O'//C_NULL_CHAR - ierr = iMOAB_GetDoubleTagStorage ( mboxid, tagname, lsize , ent_type, a2x_Faxa_rainc_16O) - if (ierr .ne. 0) then - call shr_sys_abort(subname//' error in getting Faxa_rainc_16O field') - endif - ! allocate(a2x_Faxa_rainl_16O(lsize)) - tagname = 'Faxa_rainl_16O'//C_NULL_CHAR - ierr = iMOAB_GetDoubleTagStorage ( mboxid, tagname, lsize , ent_type, a2x_Faxa_rainl_16O) - if (ierr .ne. 0) then - call shr_sys_abort(subname//' error in getting Faxa_rainl_16O field') - endif - ! allocate(x2o_Faxa_rain_16O(lsize)) - tagname = 'Faxa_rain_16O'//C_NULL_CHAR - ierr = iMOAB_GetDoubleTagStorage ( mboxid, tagname, lsize , ent_type, x2o_Faxa_rain_16O) - if (ierr .ne. 0) then - call shr_sys_abort(subname//' error in getting Faxa_rain_16O field') - endif - ! allocate(x2o_Faxa_snow_16O(lsize)) - tagname = 'Faxa_snow_16O'//C_NULL_CHAR - ierr = iMOAB_GetDoubleTagStorage ( mboxid, tagname, lsize , ent_type, x2o_Faxa_snow_16O) - if (ierr .ne. 0) then - call shr_sys_abort(subname//' error in getting Faxa_snow_16O field') - endif - ! allocate(x2o_Faxa_prec_16O(lsize)) - tagname = 'Faxa_prec_16O'//C_NULL_CHAR - ierr = iMOAB_GetDoubleTagStorage ( mboxid, tagname, lsize , ent_type, x2o_Faxa_prec_16O) - if (ierr .ne. 0) then - call shr_sys_abort(subname//' error in getting Faxa_prec_16O field') - endif - ! allocate(a2x_Faxa_snowc_18O(lsize)) - tagname = 'Faxa_snowc_18O'//C_NULL_CHAR - ierr = iMOAB_GetDoubleTagStorage ( mboxid, tagname, lsize , ent_type, a2x_Faxa_snowc_18O) - if (ierr .ne. 0) then - call shr_sys_abort(subname//' error in getting Faxa_snowc_18O field') - endif - ! allocate(a2x_Faxa_snowl_18O(lsize)) - tagname = 'Faxa_snowl_18O'//C_NULL_CHAR - ierr = iMOAB_GetDoubleTagStorage ( mboxid, tagname, lsize , ent_type, a2x_Faxa_snowl_18O) - if (ierr .ne. 0) then - call shr_sys_abort(subname//' error in getting Faxa_snowl_18O field') - endif - ! allocate(a2x_Faxa_rainc_18O(lsize)) - tagname = 'Faxa_rainc_18O'//C_NULL_CHAR - ierr = iMOAB_GetDoubleTagStorage ( mboxid, tagname, lsize , ent_type, a2x_Faxa_rainc_18O) - if (ierr .ne. 0) then - call shr_sys_abort(subname//' error in getting Faxa_rainc_18O field') - endif - ! allocate(a2x_Faxa_rainl_18O(lsize)) - tagname = 'Faxa_rainl_18O'//C_NULL_CHAR - ierr = iMOAB_GetDoubleTagStorage ( mboxid, tagname, lsize , ent_type, a2x_Faxa_rainl_18O) - if (ierr .ne. 0) then - call shr_sys_abort(subname//' error in getting Faxa_rainl_18O field') - endif - ! allocate(x2o_Faxa_rain_18O(lsize)) - tagname = 'Faxa_rain_18O'//C_NULL_CHAR - ierr = iMOAB_GetDoubleTagStorage ( mboxid, tagname, lsize , ent_type, x2o_Faxa_rain_18O) - if (ierr .ne. 0) then - call shr_sys_abort(subname//' error in getting Faxa_rain_18O field') - endif - ! allocate(x2o_Faxa_snow_18O(lsize)) - tagname = 'Faxa_snow_18O'//C_NULL_CHAR - ierr = iMOAB_GetDoubleTagStorage ( mboxid, tagname, lsize , ent_type, x2o_Faxa_snow_18O) - if (ierr .ne. 0) then - call shr_sys_abort(subname//' error in getting Faxa_snow_18O field') - endif - ! allocate(x2o_Faxa_prec_18O(lsize)) - tagname = 'Faxa_prec_18O'//C_NULL_CHAR - ierr = iMOAB_GetDoubleTagStorage ( mboxid, tagname, lsize , ent_type, x2o_Faxa_prec_18O) - if (ierr .ne. 0) then - call shr_sys_abort(subname//' error in getting Faxa_prec_18O field') - endif - ! allocate(a2x_Faxa_snowc_HDO(lsize)) - tagname = 'Faxa_snowc_HDO'//C_NULL_CHAR - ierr = iMOAB_GetDoubleTagStorage ( mboxid, tagname, lsize , ent_type, a2x_Faxa_snowc_HDO) - if (ierr .ne. 0) then - call shr_sys_abort(subname//' error in getting Faxa_snowc_HDO field') - endif - ! allocate(a2x_Faxa_snowl_HDO(lsize)) - tagname = 'Faxa_snowl_HDO'//C_NULL_CHAR - ierr = iMOAB_GetDoubleTagStorage ( mboxid, tagname, lsize , ent_type, a2x_Faxa_snowl_HDO) - if (ierr .ne. 0) then - call shr_sys_abort(subname//' error in getting Faxa_snowl_HDO field') - endif - ! allocate(a2x_Faxa_rainc_HDO(lsize)) - tagname = 'Faxa_rainc_HDO'//C_NULL_CHAR - ierr = iMOAB_GetDoubleTagStorage ( mboxid, tagname, lsize , ent_type, a2x_Faxa_rainc_HDO) - if (ierr .ne. 0) then - call shr_sys_abort(subname//' error in getting Faxa_rainc_HDO field') - endif - ! allocate(a2x_Faxa_rainl_HDO(lsize)) - tagname = 'Faxa_rainl_HDO'//C_NULL_CHAR - ierr = iMOAB_GetDoubleTagStorage ( mboxid, tagname, lsize , ent_type, a2x_Faxa_rainl_HDO) - if (ierr .ne. 0) then - call shr_sys_abort(subname//' error in getting Faxa_rainl_HDO field') - endif - ! allocate(x2o_Faxa_rain_HDO(lsize)) - tagname = 'Faxa_rain_HDO'//C_NULL_CHAR - ierr = iMOAB_GetDoubleTagStorage ( mboxid, tagname, lsize , ent_type, x2o_Faxa_rain_HDO) - if (ierr .ne. 0) then - call shr_sys_abort(subname//' error in getting Faxa_rain_HDO field') - endif - ! allocate(x2o_Faxa_snow_HDO(lsize)) - tagname = 'Faxa_snow_HDO'//C_NULL_CHAR - ierr = iMOAB_GetDoubleTagStorage ( mboxid, tagname, lsize , ent_type, x2o_Faxa_snow_HDO) - if (ierr .ne. 0) then - call shr_sys_abort(subname//' error in getting Faxa_snow_HDO field') - endif - ! allocate(x2o_Faxa_prec_HDO(lsize)) - tagname = 'Faxa_prec_HDO'//C_NULL_CHAR - ierr = iMOAB_GetDoubleTagStorage ( mboxid, tagname, lsize , ent_type, x2o_Faxa_prec_HDO) - if (ierr .ne. 0) then - call shr_sys_abort(subname//' error in getting Faxa_prec_HDO field') - endif - + + ! #ifdef NOTDEF do n = 1,lsize @@ -1798,6 +1756,64 @@ subroutine prep_ocn_mrg_moab(infodata, xao_ox) end if end if endif + +! + ! all x2o vars needs to be set, not get, after calculations ! + ! allocate(x2o_Foxx_swnet(lsize)) + tagname = 'Foxx_swnet'//C_NULL_CHAR + ierr = iMOAB_SetDoubleTagStorage ( mboxid, tagname, lsize , ent_type, x2o_Foxx_swnet) + if (ierr .ne. 0) then + call shr_sys_abort(subname//' error in getting Foxx_swnet field') + endif + ! allocate(x2o_Faxa_snow(lsize)) + tagname = 'Faxa_snow'//C_NULL_CHAR + ierr = iMOAB_SetDoubleTagStorage ( mboxid, tagname, lsize , ent_type, x2o_Faxa_snow) + if (ierr .ne. 0) then + call shr_sys_abort(subname//' error in getting Faxa_snow field') + endif + ! allocate(x2o_Faxa_rain(lsize)) + tagname = 'Faxa_rain'//C_NULL_CHAR + ierr = iMOAB_SetDoubleTagStorage ( mboxid, tagname, lsize , ent_type, x2o_Faxa_rain) + if (ierr .ne. 0) then + call shr_sys_abort(subname//' error in getting Faxa_rain field') + endif + ! allocate(x2o_Faxa_prec(lsize)) + tagname = 'Faxa_prec'//C_NULL_CHAR + ierr = iMOAB_SetDoubleTagStorage ( mboxid, tagname, lsize , ent_type, x2o_Faxa_prec) + if (ierr .ne. 0) then + call shr_sys_abort(subname//' error in getting Faxa_prec field') + endif + ! allocate(x2o_Foxx_rofl(lsize)) + tagname = 'Foxx_rofl'//C_NULL_CHAR + ierr = iMOAB_SetDoubleTagStorage ( mboxid, tagname, lsize , ent_type, x2o_Foxx_rofl) + if (ierr .ne. 0) then + call shr_sys_abort(subname//' error in getting Foxx_rofl field') + endif + ! allocate(x2o_Foxx_rofi(lsize)) + tagname = 'Foxx_rofi'//C_NULL_CHAR + ierr = iMOAB_SetDoubleTagStorage ( mboxid, tagname, lsize , ent_type, x2o_Foxx_rofi) + if (ierr .ne. 0) then + call shr_sys_abort(subname//' error in getting Foxx_rofi field') + endif + ! allocate(x2o_Sf_afrac(lsize)) + tagname = 'Sf_afrac'//C_NULL_CHAR + ierr = iMOAB_SetDoubleTagStorage ( mboxid, tagname, lsize , ent_type, x2o_Sf_afrac) + if (ierr .ne. 0) then + call shr_sys_abort(subname//' error in getting Sf_afrac field') + endif + ! allocate(x2o_Sf_afracr(lsize)) + tagname = 'Sf_afracr'//C_NULL_CHAR + ierr = iMOAB_SetDoubleTagStorage ( mboxid, tagname, lsize , ent_type, x2o_Sf_afracr) + if (ierr .ne. 0) then + call shr_sys_abort(subname//' error in getting Sf_afracr field') + endif + ! allocate(x2o_Foxx_swnet_afracr(lsize)) + tagname = 'Foxx_swnet_afracr'//C_NULL_CHAR + ierr = iMOAB_SetDoubleTagStorage ( mboxid, tagname, lsize , ent_type, x2o_Foxx_swnet_afracr) + if (ierr .ne. 0) then + call shr_sys_abort(subname//' error in getting Foxx_swnet_afracr field') + endif + #ifdef NOTDEF do n = 1,lsize ifrac = fo_kif_ifrac(n) ! fractions_o%rAttr(kif,n) From 20780a408002760ac3f31c8dd61eb8c53a0c7f3e Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Sun, 11 Sep 2022 07:07:50 -0500 Subject: [PATCH 180/467] use seq_flds_i2o_per_cat namelist (logical) some fields do not exist if this is false logical :: seq_flds_i2o_per_cat ! .true. if select per ice thickness category fields are passed from ice to ocean --- driver-moab/main/prep_ocn_mod.F90 | 40 ++++++++++++++++--------------- 1 file changed, 21 insertions(+), 19 deletions(-) diff --git a/driver-moab/main/prep_ocn_mod.F90 b/driver-moab/main/prep_ocn_mod.F90 index da5581c040cc..95a091773549 100644 --- a/driver-moab/main/prep_ocn_mod.F90 +++ b/driver-moab/main/prep_ocn_mod.F90 @@ -1794,26 +1794,28 @@ subroutine prep_ocn_mrg_moab(infodata, xao_ox) ierr = iMOAB_SetDoubleTagStorage ( mboxid, tagname, lsize , ent_type, x2o_Foxx_rofi) if (ierr .ne. 0) then call shr_sys_abort(subname//' error in getting Foxx_rofi field') - endif + endif + + if (seq_flds_i2o_per_cat) then ! allocate(x2o_Sf_afrac(lsize)) - tagname = 'Sf_afrac'//C_NULL_CHAR - ierr = iMOAB_SetDoubleTagStorage ( mboxid, tagname, lsize , ent_type, x2o_Sf_afrac) - if (ierr .ne. 0) then - call shr_sys_abort(subname//' error in getting Sf_afrac field') - endif - ! allocate(x2o_Sf_afracr(lsize)) - tagname = 'Sf_afracr'//C_NULL_CHAR - ierr = iMOAB_SetDoubleTagStorage ( mboxid, tagname, lsize , ent_type, x2o_Sf_afracr) - if (ierr .ne. 0) then - call shr_sys_abort(subname//' error in getting Sf_afracr field') - endif - ! allocate(x2o_Foxx_swnet_afracr(lsize)) - tagname = 'Foxx_swnet_afracr'//C_NULL_CHAR - ierr = iMOAB_SetDoubleTagStorage ( mboxid, tagname, lsize , ent_type, x2o_Foxx_swnet_afracr) - if (ierr .ne. 0) then - call shr_sys_abort(subname//' error in getting Foxx_swnet_afracr field') - endif - + tagname = 'Sf_afrac'//C_NULL_CHAR + ierr = iMOAB_SetDoubleTagStorage ( mboxid, tagname, lsize , ent_type, x2o_Sf_afrac) + if (ierr .ne. 0) then + call shr_sys_abort(subname//' error in getting Sf_afrac field') + endif + ! allocate(x2o_Sf_afracr(lsize)) + tagname = 'Sf_afracr'//C_NULL_CHAR + ierr = iMOAB_SetDoubleTagStorage ( mboxid, tagname, lsize , ent_type, x2o_Sf_afracr) + if (ierr .ne. 0) then + call shr_sys_abort(subname//' error in getting Sf_afracr field') + endif + ! allocate(x2o_Foxx_swnet_afracr(lsize)) + tagname = 'Foxx_swnet_afracr'//C_NULL_CHAR + ierr = iMOAB_SetDoubleTagStorage ( mboxid, tagname, lsize , ent_type, x2o_Foxx_swnet_afracr) + if (ierr .ne. 0) then + call shr_sys_abort(subname//' error in getting Foxx_swnet_afracr field') + endif + endif #ifdef NOTDEF do n = 1,lsize ifrac = fo_kif_ifrac(n) ! fractions_o%rAttr(kif,n) From 3ca7786185271dab3280b2d75ed9049069c4ff3b Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Sun, 11 Sep 2022 23:37:15 -0500 Subject: [PATCH 181/467] finish ocean merging also, send back result from coupler to ocean --- driver-moab/main/cime_comp_mod.F90 | 6 +- driver-moab/main/prep_ocn_mod.F90 | 149 ++++++++++++++++++++--------- 2 files changed, 110 insertions(+), 45 deletions(-) diff --git a/driver-moab/main/cime_comp_mod.F90 b/driver-moab/main/cime_comp_mod.F90 index 11dfd316a5eb..849f6e1ffc01 100644 --- a/driver-moab/main/cime_comp_mod.F90 +++ b/driver-moab/main/cime_comp_mod.F90 @@ -4086,7 +4086,8 @@ end subroutine cime_run_atm_recv_post !---------------------------------------------------------------------------------- subroutine cime_run_ocn_setup_send() - + use seq_flds_mod , only : seq_flds_x2o_fields + use seq_comm_mct , only : mboxid, mpoid ! !---------------------------------------------------- ! "startup" wait !---------------------------------------------------- @@ -4132,6 +4133,9 @@ subroutine cime_run_ocn_setup_send() mpicom_barrier=mpicom_CPLALLOCNID, run_barriers=run_barriers, & timer_barrier='CPL:C2O_BARRIER', timer_comp_exch='CPL:C2O', & timer_map_exch='CPL:c2o_ocnx2ocno', timer_infodata_exch='CPL:c2o_infoexch') + ! will migrate the tag from component pes to coupler pes, on atm mesh + call component_exch_moab(ocn(1), mboxid, mpoid, 1, seq_flds_x2o_fields) + endif end subroutine cime_run_ocn_setup_send diff --git a/driver-moab/main/prep_ocn_mod.F90 b/driver-moab/main/prep_ocn_mod.F90 index 95a091773549..8ae0877ae659 100644 --- a/driver-moab/main/prep_ocn_mod.F90 +++ b/driver-moab/main/prep_ocn_mod.F90 @@ -630,7 +630,7 @@ end subroutine prep_ocn_mrg subroutine prep_ocn_mrg_moab(infodata, xao_ox) use iMOAB , only : iMOAB_GetMeshInfo, iMOAB_GetDoubleTagStorage, iMOAB_SetDoubleTagStorage - use seq_comm_mct , only : mboxid, mbox2id ! ocean and atm-ocean flux instances + use seq_comm_mct , only : mboxid, mbofxid ! ocean and atm-ocean flux instances !--------------------------------------------------------------- ! Description ! Merge all ocn inputs @@ -658,7 +658,7 @@ subroutine prep_ocn_mrg_moab(infodata, xao_ox) ! Local variables integer :: n,ka,ki,ko,kr,kw,kx,kir,kor,i,i1,o1 integer :: kof,kif - integer :: lsize + integer :: lsize, arrsize ! for double arrays integer :: noflds,naflds,niflds,nrflds,nxflds! ,ngflds,nwflds, no glacier or wave model real(r8) :: ifrac,ifracr real(r8) :: afrac,afracr @@ -814,7 +814,7 @@ subroutine prep_ocn_mrg_moab(infodata, xao_ox) logical, save :: first_time = .true. integer nvert(3), nvise(3), nbl(3), nsurf(3), nvisBC(3) ! for moab info - character(CL) ::tagname + character(CXX) ::tagname integer :: ent_type, ierr ! for moab, local allocatable arrays for each field, size of local ocean mesh ! these are the fields that are merged, in general @@ -830,6 +830,12 @@ subroutine prep_ocn_mrg_moab(infodata, xao_ox) real (kind=r8) , allocatable, save :: fo_kof_ofrac(:) ! ofrac from ocean instance real (kind=r8) , allocatable, save :: fo_kir_ifrad(:) ! ifrad from ocean instance real (kind=r8) , allocatable, save :: fo_kor_ofrad(:) ! ofrad from ocean instance + real (kind=r8) , allocatable, save :: x2o_om (:,:) + real (kind=r8) , allocatable, save :: a2x_om (:,:) + real (kind=r8) , allocatable, save :: i2x_om (:,:) + real (kind=r8) , allocatable, save :: r2x_om (:,:) + real (kind=r8) , allocatable, save :: xao_om (:,:) + ! number of primary cells will be local size for all these arrays character(*),parameter :: subName = '(prep_ocn_merge_moab) ' @@ -849,6 +855,8 @@ subroutine prep_ocn_mrg_moab(infodata, xao_ox) if (first_time) then ! find out the number of local elements in moab mesh ocean instance on coupler + ! mct avs are used just for their fields metadata, not the actual reals + ! (name of the fields) a2x_o => a2x_ox(1) i2x_o => i2x_ox(1) @@ -867,6 +875,11 @@ subroutine prep_ocn_mrg_moab(infodata, xao_ox) !nwflds = mct_aVect_nRattr(w2x_o) nxflds = mct_aVect_nRattr(xao_o) !ngflds = mct_aVect_nRattr(g2x_o) + allocate (x2o_om (lsize, noflds)) + allocate (a2x_om (lsize, naflds)) + allocate (i2x_om (lsize, niflds)) + allocate (r2x_om (lsize, nrflds)) + allocate (xao_om (lsize, nxflds)) index_a2x_Faxa_swvdr = mct_aVect_indexRA(a2x_o,'Faxa_swvdr') index_a2x_Faxa_swvdf = mct_aVect_indexRA(a2x_o,'Faxa_swvdf') @@ -1270,9 +1283,11 @@ subroutine prep_ocn_mrg_moab(infodata, xao_ox) allocate(x2o_Faxa_prec(lsize)) allocate(x2o_Foxx_rofl(lsize)) allocate(x2o_Foxx_rofi(lsize)) - allocate(x2o_Sf_afrac(lsize)) - allocate(x2o_Sf_afracr(lsize)) - allocate(x2o_Foxx_swnet_afracr(lsize)) + if (seq_flds_i2o_per_cat) then + allocate(x2o_Sf_afrac(lsize)) + allocate(x2o_Sf_afracr(lsize)) + allocate(x2o_Foxx_swnet_afracr(lsize)) + endif endif @@ -1333,25 +1348,25 @@ subroutine prep_ocn_mrg_moab(infodata, xao_ox) ! allocate(xao_So_avsdr(lsize)) tagname = 'So_avsdr'//C_NULL_CHAR - ierr = iMOAB_GetDoubleTagStorage ( mbox2id, tagname, lsize , ent_type, xao_So_avsdr) + ierr = iMOAB_GetDoubleTagStorage ( mbofxid, tagname, lsize , ent_type, xao_So_avsdr) if (ierr .ne. 0) then call shr_sys_abort(subname//' error in getting So_avsdr field') endif ! allocate(xao_So_anidr(lsize)) tagname = 'So_anidr'//C_NULL_CHAR - ierr = iMOAB_GetDoubleTagStorage ( mbox2id, tagname, lsize , ent_type, xao_So_anidr) + ierr = iMOAB_GetDoubleTagStorage ( mbofxid, tagname, lsize , ent_type, xao_So_anidr) if (ierr .ne. 0) then call shr_sys_abort(subname//' error in getting So_anidr field') endif ! allocate(xao_So_avsdf(lsize)) tagname = 'So_avsdf'//C_NULL_CHAR - ierr = iMOAB_GetDoubleTagStorage ( mbox2id, tagname, lsize , ent_type, xao_So_avsdf) + ierr = iMOAB_GetDoubleTagStorage ( mbofxid, tagname, lsize , ent_type, xao_So_avsdf) if (ierr .ne. 0) then call shr_sys_abort(subname//' error in getting So_avsdf field') endif ! allocate(xao_So_anidf(lsize)) tagname = 'So_anidf'//C_NULL_CHAR - ierr = iMOAB_GetDoubleTagStorage ( mbox2id, tagname, lsize , ent_type, xao_So_anidf) + ierr = iMOAB_GetDoubleTagStorage ( mbofxid, tagname, lsize , ent_type, xao_So_anidf) if (ierr .ne. 0) then call shr_sys_abort(subname//' error in getting So_anidf field') endif @@ -1731,33 +1746,7 @@ subroutine prep_ocn_mrg_moab(infodata, xao_ox) end if end do ! #endif - do ko = 1,noflds - !--- document merge --- - if (first_time) then - if (iindx(ko) > 0) then - if (imerge(ko)) then - mrgstr(ko) = trim(mrgstr(ko))//' + ifrac*i2x%'//trim(field_ice(iindx(ko))) - else - mrgstr(ko) = trim(mrgstr(ko))//' = ifrac*i2x%'//trim(field_ice(iindx(ko))) - end if - end if - if (aindx(ko) > 0) then - if (amerge(ko)) then - mrgstr(ko) = trim(mrgstr(ko))//' + afrac*a2x%'//trim(field_atm(aindx(ko))) - else - mrgstr(ko) = trim(mrgstr(ko))//' = afrac*a2x%'//trim(field_atm(aindx(ko))) - end if - end if - if (xindx(ko) > 0) then - if (xmerge(ko)) then - mrgstr(ko) = trim(mrgstr(ko))//' + afrac*xao%'//trim(field_xao(xindx(ko))) - else - mrgstr(ko) = trim(mrgstr(ko))//' = afrac*xao%'//trim(field_xao(xindx(ko))) - end if - end if - endif -! ! all x2o vars needs to be set, not get, after calculations ! ! allocate(x2o_Foxx_swnet(lsize)) tagname = 'Foxx_swnet'//C_NULL_CHAR @@ -1816,7 +1805,70 @@ subroutine prep_ocn_mrg_moab(infodata, xao_ox) call shr_sys_abort(subname//' error in getting Foxx_swnet_afracr field') endif endif -#ifdef NOTDEF + +! fill the r2x_om, etc double array fields noflds + tagname = trim(seq_flds_x2o_fields)//C_NULL_CHAR + arrsize = noflds * lsize + ierr = iMOAB_GetDoubleTagStorage ( mboxid, tagname, arrsize , ent_type, x2o_om(1,1)) + if (ierr .ne. 0) then + call shr_sys_abort(subname//' error in getting x2o_om array ') + endif + tagname = trim(seq_flds_a2x_fields)//C_NULL_CHAR + arrsize = naflds * lsize ! allocate (a2x_om (lsize, naflds)) + ierr = iMOAB_GetDoubleTagStorage ( mboxid, tagname, arrsize , ent_type, a2x_om(1,1)) + if (ierr .ne. 0) then + call shr_sys_abort(subname//' error in getting a2x_om array ') + endif + + tagname = trim(seq_flds_i2x_fields)//C_NULL_CHAR + arrsize = niflds * lsize ! allocate (i2x_om (lsize, niflds)) + ierr = iMOAB_GetDoubleTagStorage ( mboxid, tagname, arrsize , ent_type, i2x_om(1,1)) + if (ierr .ne. 0) then + call shr_sys_abort(subname//' error in getting i2x_om array ') + endif + + tagname = trim(seq_flds_r2x_fields)//C_NULL_CHAR + arrsize = naflds * lsize ! allocate (r2x_om (lsize, nrflds)) + ierr = iMOAB_GetDoubleTagStorage ( mboxid, tagname, arrsize , ent_type, r2x_om(1,1)) + if (ierr .ne. 0) then + call shr_sys_abort(subname//' error in getting r2x_om array ') + endif + + tagname = trim(seq_flds_xao_fields)//C_NULL_CHAR + arrsize = nxflds * lsize ! allocate (xao_om (lsize, nrflds)) + ierr = iMOAB_GetDoubleTagStorage ( mbofxid, tagname, arrsize , ent_type, xao_om(1,1)) + if (ierr .ne. 0) then + call shr_sys_abort(subname//' error in getting xao_om array ') + endif + + do ko = 1,noflds + !--- document merge --- + if (first_time) then + if (iindx(ko) > 0) then + if (imerge(ko)) then + mrgstr(ko) = trim(mrgstr(ko))//' + ifrac*i2x%'//trim(field_ice(iindx(ko))) + else + mrgstr(ko) = trim(mrgstr(ko))//' = ifrac*i2x%'//trim(field_ice(iindx(ko))) + end if + end if + if (aindx(ko) > 0) then + if (amerge(ko)) then + mrgstr(ko) = trim(mrgstr(ko))//' + afrac*a2x%'//trim(field_atm(aindx(ko))) + else + mrgstr(ko) = trim(mrgstr(ko))//' = afrac*a2x%'//trim(field_atm(aindx(ko))) + end if + end if + if (xindx(ko) > 0) then + if (xmerge(ko)) then + mrgstr(ko) = trim(mrgstr(ko))//' + afrac*xao%'//trim(field_xao(xindx(ko))) + else + mrgstr(ko) = trim(mrgstr(ko))//' = afrac*xao%'//trim(field_xao(xindx(ko))) + end if + end if + endif + +! + do n = 1,lsize ifrac = fo_kif_ifrac(n) ! fractions_o%rAttr(kif,n) afrac = fo_kof_ofrac(n) ! fractions_o%rAttr(kof,n) @@ -1829,28 +1881,37 @@ subroutine prep_ocn_mrg_moab(infodata, xao_ox) endif if (iindx(ko) > 0) then if (imerge(ko)) then - x2o_o%rAttr(ko,n) = x2o_o%rAttr(ko,n) + i2x_o%rAttr(iindx(ko),n) * ifrac + x2o_om(n, ko) = x2o_om(n, ko) + i2x_om(n, iindx(ko)) * ifrac else - x2o_o%rAttr(ko,n) = i2x_o%rAttr(iindx(ko),n) * ifrac + x2o_om(n, ko) = i2x_om(n,iindx(ko)) * ifrac end if end if if (aindx(ko) > 0) then if (amerge(ko)) then - x2o_o%rAttr(ko,n) = x2o_o%rAttr(ko,n) + a2x_o%rAttr(aindx(ko),n) * afrac + x2o_om(n,ko) = x2o_om(n,ko) + a2x_om(n,aindx(ko)) * afrac else - x2o_o%rAttr(ko,n) = a2x_o%rAttr(aindx(ko),n) * afrac + x2o_om(n,ko) = a2x_om(n, aindx(ko)) * afrac end if end if if (xindx(ko) > 0) then if (xmerge(ko)) then - x2o_o%rAttr(ko,n) = x2o_o%rAttr(ko,n) + xao_o%rAttr(xindx(ko),n) * afrac + x2o_om(n,ko) = x2o_om(n,ko) + xao_om(n,xindx(ko)) * afrac else - x2o_o%rAttr(ko,n) = xao_o%rAttr(xindx(ko),n) * afrac + x2o_om(n,ko) = xao_om(n,xindx(ko)) * afrac end if end if end do -#endif + end do +! after we aer done, set x2o_om to the mboxid + + tagname = trim(seq_flds_x2o_fields)//C_NULL_CHAR + arrsize = noflds * lsize + ierr = iMOAB_SetDoubleTagStorage ( mboxid, tagname, arrsize , ent_type, x2o_om(1,1)) + if (ierr .ne. 0) then + call shr_sys_abort(subname//' error in setting x2o_om array ') + endif + if (first_time) then if (iamroot) then write(logunit,'(A)') subname//' Summary:' From cea1aaea37723ca89f75d34b40e5ec6a5906da3a Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Mon, 12 Sep 2022 00:16:41 -0500 Subject: [PATCH 182/467] noflds, etc need to be saved between calls it is used to get/set fields --- driver-moab/main/prep_ocn_mod.F90 | 47 +++++++++++++++++-------------- 1 file changed, 26 insertions(+), 21 deletions(-) diff --git a/driver-moab/main/prep_ocn_mod.F90 b/driver-moab/main/prep_ocn_mod.F90 index 8ae0877ae659..795c2edda169 100644 --- a/driver-moab/main/prep_ocn_mod.F90 +++ b/driver-moab/main/prep_ocn_mod.F90 @@ -146,6 +146,11 @@ module prep_ocn_mod #ifdef MOABDEBUG integer :: number_proj ! it is a static variable, used to count the number of projections #endif + real (kind=r8) , allocatable, private :: x2o_om (:,:) + real (kind=r8) , allocatable, private :: a2x_om (:,:) + real (kind=r8) , allocatable, private :: i2x_om (:,:) + real (kind=r8) , allocatable, private :: r2x_om (:,:) + real (kind=r8) , allocatable, private :: xao_om (:,:) logical :: iamin_CPLALLICEID ! pe associated with CPLALLICEID contains @@ -659,7 +664,7 @@ subroutine prep_ocn_mrg_moab(infodata, xao_ox) integer :: n,ka,ki,ko,kr,kw,kx,kir,kor,i,i1,o1 integer :: kof,kif integer :: lsize, arrsize ! for double arrays - integer :: noflds,naflds,niflds,nrflds,nxflds! ,ngflds,nwflds, no glacier or wave model + integer , save :: noflds,naflds,niflds,nrflds,nxflds! ,ngflds,nwflds, no glacier or wave model real(r8) :: ifrac,ifracr real(r8) :: afrac,afracr real(r8) :: frac_sum @@ -830,11 +835,7 @@ subroutine prep_ocn_mrg_moab(infodata, xao_ox) real (kind=r8) , allocatable, save :: fo_kof_ofrac(:) ! ofrac from ocean instance real (kind=r8) , allocatable, save :: fo_kir_ifrad(:) ! ifrad from ocean instance real (kind=r8) , allocatable, save :: fo_kor_ofrad(:) ! ofrad from ocean instance - real (kind=r8) , allocatable, save :: x2o_om (:,:) - real (kind=r8) , allocatable, save :: a2x_om (:,:) - real (kind=r8) , allocatable, save :: i2x_om (:,:) - real (kind=r8) , allocatable, save :: r2x_om (:,:) - real (kind=r8) , allocatable, save :: xao_om (:,:) + ! number of primary cells will be local size for all these arrays @@ -845,35 +846,39 @@ subroutine prep_ocn_mrg_moab(infodata, xao_ox) flux_epbalfact=flux_epbalfact) call seq_comm_setptrs(CPLID, iamroot=iamroot) - + + ! find out the number of local elements in moab mesh ocean instance on coupler ierr = iMOAB_GetMeshInfo ( mboxid, nvert, nvise, nbl, nsurf, nvisBC ); if (ierr .ne. 0) then write(logunit,*) subname,' error in getting info ' call shr_sys_abort(subname//' error in getting info ') endif lsize = nvise(1) ! number of active cells + if (first_time) then - ! find out the number of local elements in moab mesh ocean instance on coupler + ! mct avs are used just for their fields metadata, not the actual reals ! (name of the fields) + ! need these always, not only the first time + a2x_o => a2x_ox(1) + i2x_o => i2x_ox(1) + r2x_o => r2x_ox(1) + xao_o => xao_ox(1) + x2o_o => component_get_x2c_cx(ocn(1)) + noflds = mct_aVect_nRattr(x2o_o) ! these are saved after first time + naflds = mct_aVect_nRattr(a2x_o) + niflds = mct_aVect_nRattr(i2x_o) + nrflds = mct_aVect_nRattr(r2x_o) + !nwflds = mct_aVect_nRattr(w2x_o) + nxflds = mct_aVect_nRattr(xao_o) - a2x_o => a2x_ox(1) - i2x_o => i2x_ox(1) - r2x_o => r2x_ox(1) - xao_o => xao_ox(1) - x2o_o => component_get_x2c_cx(ocn(1)) ! x2o_o => x2o_ox(1) ! - noflds = mct_aVect_nRattr(x2o_o) - naflds = mct_aVect_nRattr(a2x_o) - niflds = mct_aVect_nRattr(i2x_o) - nrflds = mct_aVect_nRattr(r2x_o) - !nwflds = mct_aVect_nRattr(w2x_o) - nxflds = mct_aVect_nRattr(xao_o) + !ngflds = mct_aVect_nRattr(g2x_o) allocate (x2o_om (lsize, noflds)) allocate (a2x_om (lsize, naflds)) @@ -1828,14 +1833,14 @@ subroutine prep_ocn_mrg_moab(infodata, xao_ox) endif tagname = trim(seq_flds_r2x_fields)//C_NULL_CHAR - arrsize = naflds * lsize ! allocate (r2x_om (lsize, nrflds)) + arrsize = nrflds * lsize ! allocate (r2x_om (lsize, nrflds)) ierr = iMOAB_GetDoubleTagStorage ( mboxid, tagname, arrsize , ent_type, r2x_om(1,1)) if (ierr .ne. 0) then call shr_sys_abort(subname//' error in getting r2x_om array ') endif tagname = trim(seq_flds_xao_fields)//C_NULL_CHAR - arrsize = nxflds * lsize ! allocate (xao_om (lsize, nrflds)) + arrsize = nxflds * lsize ! allocate (xao_om (lsize, nxflds)) ierr = iMOAB_GetDoubleTagStorage ( mbofxid, tagname, arrsize , ent_type, xao_om(1,1)) if (ierr .ne. 0) then call shr_sys_abort(subname//' error in getting xao_om array ') From fd050ab9b9252d58391ef1d64c6b54a4fddb4e95 Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Tue, 13 Sep 2022 16:12:23 -0500 Subject: [PATCH 183/467] simplify code do not use anymore a2x_., i2x, etc one dim fields they are redundant --- driver-moab/main/prep_ocn_mod.F90 | 762 +++++------------------------- 1 file changed, 117 insertions(+), 645 deletions(-) diff --git a/driver-moab/main/prep_ocn_mod.F90 b/driver-moab/main/prep_ocn_mod.F90 index 795c2edda169..ec497b3ae3a6 100644 --- a/driver-moab/main/prep_ocn_mod.F90 +++ b/driver-moab/main/prep_ocn_mod.F90 @@ -146,6 +146,9 @@ module prep_ocn_mod #ifdef MOABDEBUG integer :: number_proj ! it is a static variable, used to count the number of projections #endif + real (kind=r8) , allocatable, private :: fractions_om (:,:) ! will retrieve the fractions from ocean, and use them + ! they were init with + ! character(*),parameter :: fraclist_o = 'afrac:ifrac:ofrac:ifrad:ofrad' in moab, on the fractions real (kind=r8) , allocatable, private :: x2o_om (:,:) real (kind=r8) , allocatable, private :: a2x_om (:,:) real (kind=r8) , allocatable, private :: i2x_om (:,:) @@ -745,66 +748,6 @@ subroutine prep_ocn_mrg_moab(infodata, xao_ox) integer, save :: index_x2o_Faxa_snow_HDO integer, save :: index_x2o_Faxa_prec_HDO - real (kind=r8) , allocatable, save :: a2x_Faxa_swvdr(:) - real (kind=r8) , allocatable, save :: a2x_Faxa_swvdf(:) - real (kind=r8) , allocatable, save :: a2x_Faxa_swndr(:) - real (kind=r8) , allocatable, save :: a2x_Faxa_swndf(:) - real (kind=r8) , allocatable, save :: i2x_Fioi_swpen(:) - real (kind=r8) , allocatable, save :: xao_So_avsdr(:) - real (kind=r8) , allocatable, save :: xao_So_anidr(:) - real (kind=r8) , allocatable, save :: xao_So_avsdf(:) - real (kind=r8) , allocatable, save :: xao_So_anidf(:) - real (kind=r8) , allocatable, save :: a2x_Faxa_snowc(:) - real (kind=r8) , allocatable, save :: a2x_Faxa_snowl(:) - real (kind=r8) , allocatable, save :: a2x_Faxa_rainc(:) - real (kind=r8) , allocatable, save :: a2x_Faxa_rainl(:) - real (kind=r8) , allocatable, save :: r2x_Forr_rofl(:) - real (kind=r8) , allocatable, save :: r2x_Forr_rofi(:) - real (kind=r8) , allocatable, save :: r2x_Forr_rofl_16O(:) - real (kind=r8) , allocatable, save :: r2x_Forr_rofi_16O(:) - real (kind=r8) , allocatable, save :: r2x_Forr_rofl_18O(:) - real (kind=r8) , allocatable, save :: r2x_Forr_rofi_18O(:) - real (kind=r8) , allocatable, save :: r2x_Forr_rofl_HDO(:) - real (kind=r8) , allocatable, save :: r2x_Forr_rofi_HDO(:) - real (kind=r8) , allocatable, save :: r2x_Flrr_flood(:) - real (kind=r8) , allocatable, save :: g2x_Fogg_rofl(:) - real (kind=r8) , allocatable, save :: g2x_Fogg_rofi(:) - real (kind=r8) , allocatable, save :: x2o_Foxx_swnet(:) - real (kind=r8) , allocatable, save :: x2o_Faxa_snow(:) - real (kind=r8) , allocatable, save :: x2o_Faxa_rain(:) - real (kind=r8) , allocatable, save :: x2o_Faxa_prec(:) - real (kind=r8) , allocatable, save :: x2o_Foxx_rofl(:) - real (kind=r8) , allocatable, save :: x2o_Foxx_rofi(:) - real (kind=r8) , allocatable, save :: x2o_Sf_afrac(:) - real (kind=r8) , allocatable, save :: x2o_Sf_afracr(:) - real (kind=r8) , allocatable, save :: x2o_Foxx_swnet_afracr(:) - real (kind=r8) , allocatable, save :: x2o_Foxx_rofl_16O(:) - real (kind=r8) , allocatable, save :: x2o_Foxx_rofi_16O(:) - real (kind=r8) , allocatable, save :: x2o_Foxx_rofl_18O(:) - real (kind=r8) , allocatable, save :: x2o_Foxx_rofi_18O(:) - real (kind=r8) , allocatable, save :: x2o_Foxx_rofl_HDO(:) - real (kind=r8) , allocatable, save :: x2o_Foxx_rofi_HDO(:) - real (kind=r8) , allocatable, save :: a2x_Faxa_snowc_16O(:) - real (kind=r8) , allocatable, save :: a2x_Faxa_snowl_16O(:) - real (kind=r8) , allocatable, save :: a2x_Faxa_rainc_16O(:) - real (kind=r8) , allocatable, save :: a2x_Faxa_rainl_16O(:) - real (kind=r8) , allocatable, save :: x2o_Faxa_rain_16O(:) - real (kind=r8) , allocatable, save :: x2o_Faxa_snow_16O(:) - real (kind=r8) , allocatable, save :: x2o_Faxa_prec_16O(:) - real (kind=r8) , allocatable, save :: a2x_Faxa_snowc_18O(:) - real (kind=r8) , allocatable, save :: a2x_Faxa_snowl_18O(:) - real (kind=r8) , allocatable, save :: a2x_Faxa_rainc_18O(:) - real (kind=r8) , allocatable, save :: a2x_Faxa_rainl_18O(:) - real (kind=r8) , allocatable, save :: x2o_Faxa_rain_18O(:) - real (kind=r8) , allocatable, save :: x2o_Faxa_snow_18O(:) - real (kind=r8) , allocatable, save :: x2o_Faxa_prec_18O(:) - real (kind=r8) , allocatable, save :: a2x_Faxa_snowc_HDO(:) - real (kind=r8) , allocatable, save :: a2x_Faxa_snowl_HDO(:) - real (kind=r8) , allocatable, save :: a2x_Faxa_rainc_HDO(:) - real (kind=r8) , allocatable, save :: a2x_Faxa_rainl_HDO(:) - real (kind=r8) , allocatable, save :: x2o_Faxa_rain_HDO(:) - real (kind=r8) , allocatable, save :: x2o_Faxa_snow_HDO(:) - real (kind=r8) , allocatable, save :: x2o_Faxa_prec_HDO(:) logical :: iamroot logical, save, pointer :: amerge(:),imerge(:),xmerge(:) @@ -827,21 +770,14 @@ subroutine prep_ocn_mrg_moab(infodata, xao_ox) ! (usually those on shared indices ) ! all the rest will be needed for computation ! arrays will be allocated the first time, then filled with get tag values, merged, and set back to x2o ocean fields -! kif = mct_aVect_indexRa(fractions_o,"ifrac",perrWith=subName) - ! kof = mct_aVect_indexRa(fractions_o,"ofrac",perrWith=subName) - ! kir = mct_aVect_indexRa(fractions_o,"ifrad",perrWith=subName) - ! kor = mct_aVect_indexRa(fractions_o,"ofrad",perrWith=subName) - real (kind=r8) , allocatable, save :: fo_kif_ifrac(:) ! ifrac from ocean instance - real (kind=r8) , allocatable, save :: fo_kof_ofrac(:) ! ofrac from ocean instance - real (kind=r8) , allocatable, save :: fo_kir_ifrad(:) ! ifrad from ocean instance - real (kind=r8) , allocatable, save :: fo_kor_ofrad(:) ! ofrad from ocean instance - - - ! number of primary cells will be local size for all these arrays character(*),parameter :: subName = '(prep_ocn_merge_moab) ' !----------------------------------------------------------------------- - + ! fraclist_o = 'afrac:ifrac:ofrac:ifrad:ofrad' + kif = 2 ! kif = mct_aVect_indexRa(fractions_o,"ifrac",perrWith=subName) + kof = 3 ! kof = mct_aVect_indexRa(fractions_o,"ofrac",perrWith=subName) + kir = 4 ! kir = mct_aVect_indexRa(fractions_o,"ifrad",perrWith=subName) + kor = 5 ! kor = mct_aVect_indexRa(fractions_o,"ofrad",perrWith=subName) call seq_infodata_GetData(infodata, & flux_epbalfact=flux_epbalfact) @@ -880,11 +816,14 @@ subroutine prep_ocn_mrg_moab(infodata, xao_ox) !ngflds = mct_aVect_nRattr(g2x_o) - allocate (x2o_om (lsize, noflds)) - allocate (a2x_om (lsize, naflds)) - allocate (i2x_om (lsize, niflds)) - allocate (r2x_om (lsize, nrflds)) - allocate (xao_om (lsize, nxflds)) + allocate(x2o_om (lsize, noflds)) + allocate(a2x_om (lsize, naflds)) + allocate(i2x_om (lsize, niflds)) + allocate(r2x_om (lsize, nrflds)) + allocate(xao_om (lsize, nxflds)) + ! allocate fractions too + ! use the fraclist fraclist_o = 'afrac:ifrac:ofrac:ifrad:ofrad' + allocate(fractions_om(lsize,5)) ! there are 5 fields here index_a2x_Faxa_swvdr = mct_aVect_indexRA(a2x_o,'Faxa_swvdr') index_a2x_Faxa_swvdf = mct_aVect_indexRA(a2x_o,'Faxa_swvdf') @@ -1217,436 +1156,65 @@ subroutine prep_ocn_mrg_moab(infodata, xao_ox) 'a2x%Faxa_rainl_HDO)*flux_epbalfact' end if endif - ! allocate - if (first_time) then ! allocate arrays for fractions - allocate(fo_kif_ifrac(lsize)) - allocate(fo_kof_ofrac(lsize)) - allocate(fo_kir_ifrad(lsize)) - allocate(fo_kor_ofrad(lsize)) - ! now real fields - allocate(a2x_Faxa_swvdr(lsize)) - allocate(a2x_Faxa_swvdf(lsize)) - allocate(a2x_Faxa_swndr(lsize)) - allocate(a2x_Faxa_swndf(lsize)) - allocate(i2x_Fioi_swpen(lsize)) - allocate(xao_So_avsdr(lsize)) - allocate(xao_So_anidr(lsize)) - allocate(xao_So_avsdf(lsize)) - allocate(xao_So_anidf(lsize)) - allocate(a2x_Faxa_snowc(lsize)) - allocate(a2x_Faxa_snowl(lsize)) - allocate(a2x_Faxa_rainc(lsize)) - allocate(a2x_Faxa_rainl(lsize)) - allocate(r2x_Forr_rofl(lsize)) - allocate(r2x_Forr_rofi(lsize)) - - if ( index_x2o_Foxx_rofl_16O /= 0 ) then ! also flds_wiso true - allocate(r2x_Forr_rofl_16O(lsize)) - allocate(r2x_Forr_rofi_16O(lsize)) - allocate(x2o_Foxx_rofl_16O(lsize)) - allocate(x2o_Foxx_rofi_16O(lsize)) - allocate(a2x_Faxa_snowc_16O(lsize)) - allocate(a2x_Faxa_snowl_16O(lsize)) - allocate(a2x_Faxa_rainc_16O(lsize)) - allocate(a2x_Faxa_rainl_16O(lsize)) - allocate(x2o_Faxa_rain_16O(lsize)) - allocate(x2o_Faxa_snow_16O(lsize)) - allocate(x2o_Faxa_prec_16O(lsize)) - allocate(r2x_Forr_rofl_18O(lsize)) - allocate(r2x_Forr_rofi_18O(lsize)) - allocate(r2x_Forr_rofl_HDO(lsize)) - allocate(r2x_Forr_rofi_HDO(lsize)) - allocate(x2o_Foxx_rofl_18O(lsize)) - allocate(x2o_Foxx_rofi_18O(lsize)) - allocate(x2o_Foxx_rofl_HDO(lsize)) - allocate(x2o_Foxx_rofi_HDO(lsize)) - - - allocate(a2x_Faxa_snowc_18O(lsize)) - allocate(a2x_Faxa_snowl_18O(lsize)) - allocate(a2x_Faxa_rainc_18O(lsize)) - allocate(a2x_Faxa_rainl_18O(lsize)) - allocate(x2o_Faxa_rain_18O(lsize)) - allocate(x2o_Faxa_snow_18O(lsize)) - allocate(x2o_Faxa_prec_18O(lsize)) - allocate(a2x_Faxa_snowc_HDO(lsize)) - allocate(a2x_Faxa_snowl_HDO(lsize)) - allocate(a2x_Faxa_rainc_HDO(lsize)) - allocate(a2x_Faxa_rainl_HDO(lsize)) - allocate(x2o_Faxa_rain_HDO(lsize)) - allocate(x2o_Faxa_snow_HDO(lsize)) - allocate(x2o_Faxa_prec_HDO(lsize)) - - endif - - allocate(r2x_Flrr_flood(lsize)) - allocate(g2x_Fogg_rofl(lsize)) - allocate(g2x_Fogg_rofi(lsize)) - allocate(x2o_Foxx_swnet(lsize)) - allocate(x2o_Faxa_snow(lsize)) - allocate(x2o_Faxa_rain(lsize)) - allocate(x2o_Faxa_prec(lsize)) - allocate(x2o_Foxx_rofl(lsize)) - allocate(x2o_Foxx_rofi(lsize)) - if (seq_flds_i2o_per_cat) then - allocate(x2o_Sf_afrac(lsize)) - allocate(x2o_Sf_afracr(lsize)) - allocate(x2o_Foxx_swnet_afracr(lsize)) - endif - - endif ! fill with fractions from ocean instance ent_type = 1 ! cells - tagname = 'ifrac'//C_NULL_CHAR - ierr = iMOAB_GetDoubleTagStorage ( mboxid, tagname, lsize , ent_type, fo_kif_ifrac) - if (ierr .ne. 0) then - call shr_sys_abort(subname//' error in getting ifrac ') - endif - tagname = 'ofrac'//C_NULL_CHAR - ierr = iMOAB_GetDoubleTagStorage ( mboxid, tagname, lsize , ent_type, fo_kof_ofrac) + tagname = 'afrac:ifrac:ofrac:ifrad:ofrad'//C_NULL_CHAR + arrsize = 5 * lsize + ierr = iMOAB_GetDoubleTagStorage ( mboxid, tagname, arrsize , ent_type, fractions_om(1,1)) if (ierr .ne. 0) then - call shr_sys_abort(subname//' error in getting ofrac ') + call shr_sys_abort(subname//' error in getting fractions_om from ocean instance ') endif - tagname = 'ifrad'//C_NULL_CHAR - ierr = iMOAB_GetDoubleTagStorage ( mboxid, tagname, lsize , ent_type, fo_kir_ifrad) + + ! fill the r2x_om, etc double array fields noflds + tagname = trim(seq_flds_x2o_fields)//C_NULL_CHAR + arrsize = noflds * lsize + ierr = iMOAB_GetDoubleTagStorage ( mboxid, tagname, arrsize , ent_type, x2o_om(1,1)) if (ierr .ne. 0) then - call shr_sys_abort(subname//' error in getting ifrad ') - endif - tagname = 'ofrad'//C_NULL_CHAR - ierr = iMOAB_GetDoubleTagStorage ( mboxid, tagname, lsize , ent_type, fo_kor_ofrad) + call shr_sys_abort(subname//' error in getting x2o_om array ') + endif + tagname = trim(seq_flds_a2x_fields)//C_NULL_CHAR + arrsize = naflds * lsize ! allocate (a2x_om (lsize, naflds)) + ierr = iMOAB_GetDoubleTagStorage ( mboxid, tagname, arrsize , ent_type, a2x_om(1,1)) if (ierr .ne. 0) then - call shr_sys_abort(subname//' error in getting ofrad ') + call shr_sys_abort(subname//' error in getting a2x_om array ') endif - ! fill with values from various instances - tagname = 'Faxa_swvdr'//C_NULL_CHAR - ierr = iMOAB_GetDoubleTagStorage ( mboxid, tagname, lsize , ent_type, a2x_Faxa_swvdr) - if (ierr .ne. 0) then - call shr_sys_abort(subname//' error in getting Faxa_swvdr field') - endif - ! allocate(a2x_Faxa_swvdr(lsize)) - ! allocate(a2x_Faxa_swvdf(lsize)) - tagname = 'Faxa_swvdf'//C_NULL_CHAR - ierr = iMOAB_GetDoubleTagStorage ( mboxid, tagname, lsize , ent_type, a2x_Faxa_swvdf) - if (ierr .ne. 0) then - call shr_sys_abort(subname//' error in getting Faxa_swvdf field') - endif - ! allocate(a2x_Faxa_swndr(lsize)) - tagname = 'Faxa_swndr'//C_NULL_CHAR - ierr = iMOAB_GetDoubleTagStorage ( mboxid, tagname, lsize , ent_type, a2x_Faxa_swndr) + tagname = trim(seq_flds_i2x_fields)//C_NULL_CHAR + arrsize = niflds * lsize ! allocate (i2x_om (lsize, niflds)) + ierr = iMOAB_GetDoubleTagStorage ( mboxid, tagname, arrsize , ent_type, i2x_om(1,1)) if (ierr .ne. 0) then - call shr_sys_abort(subname//' error in getting Faxa_swndr field') + call shr_sys_abort(subname//' error in getting i2x_om array ') endif - ! allocate(a2x_Faxa_swndf(lsize)) - tagname = 'Faxa_swndf'//C_NULL_CHAR - ierr = iMOAB_GetDoubleTagStorage ( mboxid, tagname, lsize , ent_type, a2x_Faxa_swndf) - if (ierr .ne. 0) then - call shr_sys_abort(subname//' error in getting Faxa_swndf field') - endif - ! allocate(i2x_Fioi_swpen(lsize)) - tagname = 'Fioi_swpen'//C_NULL_CHAR - ierr = iMOAB_GetDoubleTagStorage ( mboxid, tagname, lsize , ent_type, i2x_Fioi_swpen) - if (ierr .ne. 0) then - call shr_sys_abort(subname//' error in getting Fioi_swpen field') - endif - ! allocate(xao_So_avsdr(lsize)) - tagname = 'So_avsdr'//C_NULL_CHAR - ierr = iMOAB_GetDoubleTagStorage ( mbofxid, tagname, lsize , ent_type, xao_So_avsdr) - if (ierr .ne. 0) then - call shr_sys_abort(subname//' error in getting So_avsdr field') - endif - ! allocate(xao_So_anidr(lsize)) - tagname = 'So_anidr'//C_NULL_CHAR - ierr = iMOAB_GetDoubleTagStorage ( mbofxid, tagname, lsize , ent_type, xao_So_anidr) - if (ierr .ne. 0) then - call shr_sys_abort(subname//' error in getting So_anidr field') - endif - ! allocate(xao_So_avsdf(lsize)) - tagname = 'So_avsdf'//C_NULL_CHAR - ierr = iMOAB_GetDoubleTagStorage ( mbofxid, tagname, lsize , ent_type, xao_So_avsdf) - if (ierr .ne. 0) then - call shr_sys_abort(subname//' error in getting So_avsdf field') - endif - ! allocate(xao_So_anidf(lsize)) - tagname = 'So_anidf'//C_NULL_CHAR - ierr = iMOAB_GetDoubleTagStorage ( mbofxid, tagname, lsize , ent_type, xao_So_anidf) - if (ierr .ne. 0) then - call shr_sys_abort(subname//' error in getting So_anidf field') - endif - ! allocate(a2x_Faxa_snowc(lsize)) - tagname = 'Faxa_snowc'//C_NULL_CHAR - ierr = iMOAB_GetDoubleTagStorage ( mboxid, tagname, lsize , ent_type, a2x_Faxa_snowc) - if (ierr .ne. 0) then - call shr_sys_abort(subname//' error in getting Faxa_snowc field') - endif - ! allocate(a2x_Faxa_snowl(lsize)) - tagname = 'Faxa_snowl'//C_NULL_CHAR - ierr = iMOAB_GetDoubleTagStorage ( mboxid, tagname, lsize , ent_type, a2x_Faxa_snowl) - if (ierr .ne. 0) then - call shr_sys_abort(subname//' error in getting Faxa_snowl field') - endif - ! allocate(a2x_Faxa_rainc(lsize)) - tagname = 'Faxa_rainc'//C_NULL_CHAR - ierr = iMOAB_GetDoubleTagStorage ( mboxid, tagname, lsize , ent_type, a2x_Faxa_rainc) - if (ierr .ne. 0) then - call shr_sys_abort(subname//' error in getting Faxa_rainc field') - endif - ! allocate(a2x_Faxa_rainl(lsize)) - tagname = 'Faxa_rainl'//C_NULL_CHAR - ierr = iMOAB_GetDoubleTagStorage ( mboxid, tagname, lsize , ent_type, a2x_Faxa_rainl) - if (ierr .ne. 0) then - call shr_sys_abort(subname//' error in getting Faxa_rainl field') - endif - ! allocate(r2x_Forr_rofl(lsize)) - tagname = 'Forr_rofl'//C_NULL_CHAR - ierr = iMOAB_GetDoubleTagStorage ( mboxid, tagname, lsize , ent_type, r2x_Forr_rofl) - if (ierr .ne. 0) then - call shr_sys_abort(subname//' error in getting Forr_rofl field') - endif - ! allocate(r2x_Forr_rofi(lsize)) - tagname = 'Forr_rofi'//C_NULL_CHAR - ierr = iMOAB_GetDoubleTagStorage ( mboxid, tagname, lsize , ent_type, r2x_Forr_rofi) + tagname = trim(seq_flds_r2x_fields)//C_NULL_CHAR + arrsize = nrflds * lsize ! allocate (r2x_om (lsize, nrflds)) + ierr = iMOAB_GetDoubleTagStorage ( mboxid, tagname, arrsize , ent_type, r2x_om(1,1)) if (ierr .ne. 0) then - call shr_sys_abort(subname//' error in getting Forr_rofi field') - endif - - if ( index_x2o_Foxx_rofl_16O /= 0 ) then ! also flds_wiso true - ! allocate(r2x_Forr_rofl_16O(lsize)) - tagname = 'Forr_rofl_16O'//C_NULL_CHAR - ierr = iMOAB_GetDoubleTagStorage ( mboxid, tagname, lsize , ent_type, r2x_Forr_rofl_16O) - if (ierr .ne. 0) then - call shr_sys_abort(subname//' error in getting Forr_rofl_16O field') - endif - ! allocate(r2x_Forr_rofi_16O(lsize)) - tagname = 'Forr_rofi_16O'//C_NULL_CHAR - ierr = iMOAB_GetDoubleTagStorage ( mboxid, tagname, lsize , ent_type, r2x_Forr_rofi_16O) - if (ierr .ne. 0) then - call shr_sys_abort(subname//' error in getting Forr_rofi_16O field') - endif - ! allocate(r2x_Forr_rofl_18O(lsize)) - tagname = 'Forr_rofl_18O'//C_NULL_CHAR - ierr = iMOAB_GetDoubleTagStorage ( mboxid, tagname, lsize , ent_type, r2x_Forr_rofl_18O) - if (ierr .ne. 0) then - call shr_sys_abort(subname//' error in getting Forr_rofl_18O field') - endif - ! allocate(r2x_Forr_rofi_18O(lsize)) - tagname = 'Forr_rofi_18O'//C_NULL_CHAR - ierr = iMOAB_GetDoubleTagStorage ( mboxid, tagname, lsize , ent_type, r2x_Forr_rofi_18O) - if (ierr .ne. 0) then - call shr_sys_abort(subname//' error in getting Forr_rofi_18O field') - endif - ! allocate(r2x_Forr_rofi_18O(lsize)) - tagname = 'Forr_rofi_18O'//C_NULL_CHAR - ierr = iMOAB_GetDoubleTagStorage ( mboxid, tagname, lsize , ent_type, r2x_Forr_rofi_18O) - if (ierr .ne. 0) then - call shr_sys_abort(subname//' error in getting Forr_rofi_18O field') - endif - ! allocate(r2x_Forr_rofi_HDO(lsize)) - tagname = 'Forr_rofi_HDO'//C_NULL_CHAR - ierr = iMOAB_GetDoubleTagStorage ( mboxid, tagname, lsize , ent_type, r2x_Forr_rofi_HDO) - if (ierr .ne. 0) then - call shr_sys_abort(subname//' error in getting Forr_rofi_HDO field') - endif - ! allocate(x2o_Foxx_rofl_16O(lsize)) - tagname = 'Foxx_rofl_16O'//C_NULL_CHAR - ierr = iMOAB_GetDoubleTagStorage ( mboxid, tagname, lsize , ent_type, x2o_Foxx_rofl_16O) - if (ierr .ne. 0) then - call shr_sys_abort(subname//' error in getting Foxx_rofl_16O field') - endif - ! allocate(x2o_Foxx_rofi_16O(lsize)) - tagname = 'Foxx_rofi_16O'//C_NULL_CHAR - ierr = iMOAB_GetDoubleTagStorage ( mboxid, tagname, lsize , ent_type, x2o_Foxx_rofi_16O) - if (ierr .ne. 0) then - call shr_sys_abort(subname//' error in getting Foxx_rofi_16O field') - endif - ! allocate(x2o_Foxx_rofl_18O(lsize)) - tagname = 'Foxx_rofl_18O'//C_NULL_CHAR - ierr = iMOAB_GetDoubleTagStorage ( mboxid, tagname, lsize , ent_type, x2o_Foxx_rofl_18O) - if (ierr .ne. 0) then - call shr_sys_abort(subname//' error in getting Foxx_rofl_18O field') - endif - ! allocate(x2o_Foxx_rofi_18O(lsize)) - tagname = 'Foxx_rofi_18O'//C_NULL_CHAR - ierr = iMOAB_GetDoubleTagStorage ( mboxid, tagname, lsize , ent_type, x2o_Foxx_rofi_18O) - if (ierr .ne. 0) then - call shr_sys_abort(subname//' error in getting Foxx_rofi_18O field') - endif - ! allocate(x2o_Foxx_rofl_HDO(lsize)) - tagname = 'Foxx_rofl_HDO'//C_NULL_CHAR - ierr = iMOAB_GetDoubleTagStorage ( mboxid, tagname, lsize , ent_type, x2o_Foxx_rofl_HDO) - if (ierr .ne. 0) then - call shr_sys_abort(subname//' error in getting Foxx_rofl_HDO field') - endif - ! allocate(x2o_Foxx_rofi_HDO(lsize)) - tagname = 'Foxx_rofi_HDO'//C_NULL_CHAR - ierr = iMOAB_GetDoubleTagStorage ( mboxid, tagname, lsize , ent_type, x2o_Foxx_rofi_HDO) - if (ierr .ne. 0) then - call shr_sys_abort(subname//' error in getting Foxx_rofi_HDO field') - endif - ! allocate(a2x_Faxa_snowc_16O(lsize)) - tagname = 'Faxa_snowc_16O'//C_NULL_CHAR - ierr = iMOAB_GetDoubleTagStorage ( mboxid, tagname, lsize , ent_type, a2x_Faxa_snowc_16O) - if (ierr .ne. 0) then - call shr_sys_abort(subname//' error in getting Faxa_snowc_16O field') - endif - ! allocate(a2x_Faxa_snowl_16O(lsize)) - tagname = 'Faxa_snowl_16O'//C_NULL_CHAR - ierr = iMOAB_GetDoubleTagStorage ( mboxid, tagname, lsize , ent_type, a2x_Faxa_snowl_16O) - if (ierr .ne. 0) then - call shr_sys_abort(subname//' error in getting Faxa_snowl_16O field') - endif - ! allocate(a2x_Faxa_rainc_16O(lsize)) - tagname = 'Faxa_rainc_16O'//C_NULL_CHAR - ierr = iMOAB_GetDoubleTagStorage ( mboxid, tagname, lsize , ent_type, a2x_Faxa_rainc_16O) - if (ierr .ne. 0) then - call shr_sys_abort(subname//' error in getting Faxa_rainc_16O field') - endif - ! allocate(a2x_Faxa_rainl_16O(lsize)) - tagname = 'Faxa_rainl_16O'//C_NULL_CHAR - ierr = iMOAB_GetDoubleTagStorage ( mboxid, tagname, lsize , ent_type, a2x_Faxa_rainl_16O) - if (ierr .ne. 0) then - call shr_sys_abort(subname//' error in getting Faxa_rainl_16O field') - endif - ! allocate(x2o_Faxa_rain_16O(lsize)) - tagname = 'Faxa_rain_16O'//C_NULL_CHAR - ierr = iMOAB_GetDoubleTagStorage ( mboxid, tagname, lsize , ent_type, x2o_Faxa_rain_16O) - if (ierr .ne. 0) then - call shr_sys_abort(subname//' error in getting Faxa_rain_16O field') - endif - ! allocate(x2o_Faxa_snow_16O(lsize)) - tagname = 'Faxa_snow_16O'//C_NULL_CHAR - ierr = iMOAB_GetDoubleTagStorage ( mboxid, tagname, lsize , ent_type, x2o_Faxa_snow_16O) - if (ierr .ne. 0) then - call shr_sys_abort(subname//' error in getting Faxa_snow_16O field') - endif - ! allocate(x2o_Faxa_prec_16O(lsize)) - tagname = 'Faxa_prec_16O'//C_NULL_CHAR - ierr = iMOAB_GetDoubleTagStorage ( mboxid, tagname, lsize , ent_type, x2o_Faxa_prec_16O) - if (ierr .ne. 0) then - call shr_sys_abort(subname//' error in getting Faxa_prec_16O field') - endif - ! allocate(a2x_Faxa_snowc_18O(lsize)) - tagname = 'Faxa_snowc_18O'//C_NULL_CHAR - ierr = iMOAB_GetDoubleTagStorage ( mboxid, tagname, lsize , ent_type, a2x_Faxa_snowc_18O) - if (ierr .ne. 0) then - call shr_sys_abort(subname//' error in getting Faxa_snowc_18O field') - endif - ! allocate(a2x_Faxa_snowl_18O(lsize)) - tagname = 'Faxa_snowl_18O'//C_NULL_CHAR - ierr = iMOAB_GetDoubleTagStorage ( mboxid, tagname, lsize , ent_type, a2x_Faxa_snowl_18O) - if (ierr .ne. 0) then - call shr_sys_abort(subname//' error in getting Faxa_snowl_18O field') - endif - ! allocate(a2x_Faxa_rainc_18O(lsize)) - tagname = 'Faxa_rainc_18O'//C_NULL_CHAR - ierr = iMOAB_GetDoubleTagStorage ( mboxid, tagname, lsize , ent_type, a2x_Faxa_rainc_18O) - if (ierr .ne. 0) then - call shr_sys_abort(subname//' error in getting Faxa_rainc_18O field') - endif - ! allocate(a2x_Faxa_rainl_18O(lsize)) - tagname = 'Faxa_rainl_18O'//C_NULL_CHAR - ierr = iMOAB_GetDoubleTagStorage ( mboxid, tagname, lsize , ent_type, a2x_Faxa_rainl_18O) - if (ierr .ne. 0) then - call shr_sys_abort(subname//' error in getting Faxa_rainl_18O field') - endif - ! allocate(x2o_Faxa_rain_18O(lsize)) - tagname = 'Faxa_rain_18O'//C_NULL_CHAR - ierr = iMOAB_GetDoubleTagStorage ( mboxid, tagname, lsize , ent_type, x2o_Faxa_rain_18O) - if (ierr .ne. 0) then - call shr_sys_abort(subname//' error in getting Faxa_rain_18O field') - endif - ! allocate(x2o_Faxa_snow_18O(lsize)) - tagname = 'Faxa_snow_18O'//C_NULL_CHAR - ierr = iMOAB_GetDoubleTagStorage ( mboxid, tagname, lsize , ent_type, x2o_Faxa_snow_18O) - if (ierr .ne. 0) then - call shr_sys_abort(subname//' error in getting Faxa_snow_18O field') - endif - ! allocate(x2o_Faxa_prec_18O(lsize)) - tagname = 'Faxa_prec_18O'//C_NULL_CHAR - ierr = iMOAB_GetDoubleTagStorage ( mboxid, tagname, lsize , ent_type, x2o_Faxa_prec_18O) - if (ierr .ne. 0) then - call shr_sys_abort(subname//' error in getting Faxa_prec_18O field') - endif - ! allocate(a2x_Faxa_snowc_HDO(lsize)) - tagname = 'Faxa_snowc_HDO'//C_NULL_CHAR - ierr = iMOAB_GetDoubleTagStorage ( mboxid, tagname, lsize , ent_type, a2x_Faxa_snowc_HDO) - if (ierr .ne. 0) then - call shr_sys_abort(subname//' error in getting Faxa_snowc_HDO field') - endif - ! allocate(a2x_Faxa_snowl_HDO(lsize)) - tagname = 'Faxa_snowl_HDO'//C_NULL_CHAR - ierr = iMOAB_GetDoubleTagStorage ( mboxid, tagname, lsize , ent_type, a2x_Faxa_snowl_HDO) - if (ierr .ne. 0) then - call shr_sys_abort(subname//' error in getting Faxa_snowl_HDO field') - endif - ! allocate(a2x_Faxa_rainc_HDO(lsize)) - tagname = 'Faxa_rainc_HDO'//C_NULL_CHAR - ierr = iMOAB_GetDoubleTagStorage ( mboxid, tagname, lsize , ent_type, a2x_Faxa_rainc_HDO) - if (ierr .ne. 0) then - call shr_sys_abort(subname//' error in getting Faxa_rainc_HDO field') - endif - ! allocate(a2x_Faxa_rainl_HDO(lsize)) - tagname = 'Faxa_rainl_HDO'//C_NULL_CHAR - ierr = iMOAB_GetDoubleTagStorage ( mboxid, tagname, lsize , ent_type, a2x_Faxa_rainl_HDO) - if (ierr .ne. 0) then - call shr_sys_abort(subname//' error in getting Faxa_rainl_HDO field') - endif - ! allocate(x2o_Faxa_rain_HDO(lsize)) - tagname = 'Faxa_rain_HDO'//C_NULL_CHAR - ierr = iMOAB_GetDoubleTagStorage ( mboxid, tagname, lsize , ent_type, x2o_Faxa_rain_HDO) - if (ierr .ne. 0) then - call shr_sys_abort(subname//' error in getting Faxa_rain_HDO field') - endif - ! allocate(x2o_Faxa_snow_HDO(lsize)) - tagname = 'Faxa_snow_HDO'//C_NULL_CHAR - ierr = iMOAB_GetDoubleTagStorage ( mboxid, tagname, lsize , ent_type, x2o_Faxa_snow_HDO) - if (ierr .ne. 0) then - call shr_sys_abort(subname//' error in getting Faxa_snow_HDO field') - endif - ! allocate(x2o_Faxa_prec_HDO(lsize)) - tagname = 'Faxa_prec_HDO'//C_NULL_CHAR - ierr = iMOAB_GetDoubleTagStorage ( mboxid, tagname, lsize , ent_type, x2o_Faxa_prec_HDO) - if (ierr .ne. 0) then - call shr_sys_abort(subname//' error in getting Faxa_prec_HDO field') - endif - + call shr_sys_abort(subname//' error in getting r2x_om array ') endif - ! allocate(r2x_Flrr_flood(lsize)) - tagname = 'Flrr_flood'//C_NULL_CHAR - ierr = iMOAB_GetDoubleTagStorage ( mboxid, tagname, lsize , ent_type, r2x_Flrr_flood) + + tagname = trim(seq_flds_xao_fields)//C_NULL_CHAR + arrsize = nxflds * lsize ! allocate (xao_om (lsize, nxflds)) + ierr = iMOAB_GetDoubleTagStorage ( mbofxid, tagname, arrsize , ent_type, xao_om(1,1)) if (ierr .ne. 0) then - call shr_sys_abort(subname//' error in getting Flrr_flood field') - endif - ! ! allocate(g2x_Fogg_rofl(lsize)) - ! tagname = 'Faxa_swndf'//C_NULL_CHAR - ! ierr = iMOAB_GetDoubleTagStorage ( mboxid, tagname, lsize , ent_type, a2x_Faxa_swndf) - ! if (ierr .ne. 0) then - ! call shr_sys_abort(subname//' error in getting Faxa_swndf field') - ! endif - ! ! allocate(g2x_Fogg_rofi(lsize)) - ! tagname = 'Faxa_swndf'//C_NULL_CHAR - ! ierr = iMOAB_GetDoubleTagStorage ( mboxid, tagname, lsize , ent_type, a2x_Faxa_swndf) - ! if (ierr .ne. 0) then - ! call shr_sys_abort(subname//' error in getting Faxa_swndf field') - ! endif - + call shr_sys_abort(subname//' error in getting xao_om array ') + endif ! #ifdef NOTDEF do n = 1,lsize - ifrac = fo_kif_ifrac(n) ! fractions_o%rAttr(kif,n) - afrac = fo_kof_ofrac(n) ! fractions_o%rAttr(kof,n) + ifrac = fractions_om(n,kif) ! fo_kif_ifrac(n) ! fractions_o%rAttr(kif,n) + afrac = fractions_om(n,kof) ! fo_kof_ofrac(n) ! fractions_o%rAttr(kof,n) frac_sum = ifrac + afrac if ((frac_sum) /= 0._r8) then ifrac = ifrac / (frac_sum) afrac = afrac / (frac_sum) endif - ifracr = fo_kir_ifrad(n) ! fractions_o%rAttr(kir,n) - afracr = fo_kor_ofrad(n) ! fractions_o%rAttr(kor,n) + ifracr = fractions_om(n,kir) ! fo_kir_ifrad(n) ! fractions_o%rAttr(kir,n) + afracr = fractions_om(n,kor) ! fo_kor_ofrad(n) ! fractions_o%rAttr(kor,n) frac_sum = ifracr + afracr if ((frac_sum) /= 0._r8) then ifracr = ifracr / (frac_sum) @@ -1654,198 +1222,104 @@ subroutine prep_ocn_mrg_moab(infodata, xao_ox) endif ! Derived: compute net short-wave - avsdr = xao_So_avsdr(n) ! xao_o%rAttr(index_xao_So_avsdr,n) - anidr = xao_So_anidr(n) !xao_o%rAttr(index_xao_So_anidr,n) - avsdf = xao_So_avsdf(n) !xao_o%rAttr(index_xao_So_avsdf,n) - anidf = xao_So_anidf(n)! xao_o%rAttr(index_xao_So_anidf,n) - fswabsv = a2x_Faxa_swvdr(n) * (1.0_R8 - avsdr) & !a2x_o%rAttr(index_a2x_Faxa_swvdr,n) * (1.0_R8 - avsdr) & - + a2x_Faxa_swvdf(n) * (1.0_R8 - avsdf) !+ a2x_o%rAttr(index_a2x_Faxa_swvdf,n) * (1.0_R8 - avsdf) - fswabsi = a2x_Faxa_swndr(n) * (1.0_R8 - anidr) & !a2x_o%rAttr(index_a2x_Faxa_swndr,n) * (1.0_R8 - anidr) & - + a2x_Faxa_swndf(n) * (1.0_R8 - anidf) ! + a2x_o%rAttr(index_a2x_Faxa_swndf,n) * (1.0_R8 - anidf) - x2o_Foxx_swnet(n) = (fswabsv + fswabsi) * afracr + & !x2o_o%rAttr(index_x2o_Foxx_swnet,n) = (fswabsv + fswabsi) * afracr + & - i2x_Fioi_swpen(n) * ifrac ! i2x_o%rAttr(index_i2x_Fioi_swpen,n) * ifrac - + avsdr = xao_om(n,index_xao_So_avsdr) ! avsdr = xao_So_avsdr(n) ! xao_o%rAttr(index_xao_So_avsdr,n) + anidr = xao_om(n,index_xao_So_anidr) ! xao_So_anidr(n) !xao_o%rAttr(index_xao_So_anidr,n) + avsdf = xao_om(n,index_xao_So_avsdf) !xao_So_avsdf(n) !xao_o%rAttr(index_xao_So_avsdf,n) + anidf = xao_om(n,index_xao_So_anidf) ! xao_So_anidf(n)! xao_o%rAttr(index_xao_So_anidf,n) + fswabsv = a2x_om(n,index_a2x_Faxa_swvdr) * (1.0_R8 - avsdr) & ! a2x_Faxa_swvdr(n) * (1.0_R8 - avsdr) & !a2x_o%rAttr(index_a2x_Faxa_swvdr,n) * (1.0_R8 - avsdr) & + + a2x_om(n,index_a2x_Faxa_swvdf) * (1.0_R8 - avsdf)! + a2x_Faxa_swvdf(n) * (1.0_R8 - avsdf) !+ a2x_o%rAttr(index_a2x_Faxa_swvdf,n) * (1.0_R8 - avsdf) + fswabsi = a2x_om(n,index_a2x_Faxa_swndr) * (1.0_R8 - anidr) & ! a2x_Faxa_swndr(n) * (1.0_R8 - anidr) & !a2x_o%rAttr(index_a2x_Faxa_swndr,n) * (1.0_R8 - anidr) & + + a2x_om(n,index_a2x_Faxa_swndf) * (1.0_R8 - anidf) !+ a2x_Faxa_swndf(n) * (1.0_R8 - anidf) ! + a2x_o%rAttr(index_a2x_Faxa_swndf,n) * (1.0_R8 - anidf) + x2o_om(n,index_x2o_Foxx_swnet) = (fswabsv + fswabsi) * afracr + & !x2o_Foxx_swnet(n) = (fswabsv + fswabsi) * afracr + & !x2o_o%rAttr(index_x2o_Foxx_swnet,n) = (fswabsv + fswabsi) * afracr + & + i2x_om(n,index_i2x_Fioi_swpen) * ifrac ! i2x_Fioi_swpen(n) * ifrac ! i2x_o%rAttr(index_i2x_Fioi_swpen,n) * ifrac + if (seq_flds_i2o_per_cat) then - x2o_Sf_afrac(n) = afrac ! x2o_o%rAttr(index_x2o_Sf_afrac,n) = afrac - x2o_Sf_afracr(n) = afracr !x2o_o%rAttr(index_x2o_Sf_afracr,n) = afracr - x2o_Foxx_swnet_afracr(n) = (fswabsv + fswabsi) * afracr ! x2o_o%rAttr(index_x2o_Foxx_swnet_afracr,n) = (fswabsv + fswabsi) * afracr + x2o_om(n,index_x2o_Sf_afrac) = afrac + x2o_om(n,index_x2o_Sf_afracr) = afracr + x2o_om(n,index_x2o_Foxx_swnet_afracr) = (fswabsv + fswabsi) * afracr end if ! Derived: compute total precipitation - scale total precip and runoff - x2o_Faxa_snow (n) = a2x_Faxa_snowc(n) * afrac + & ! x2o_o%rAttr(index_x2o_Faxa_snow ,n) = a2x_o%rAttr(index_a2x_Faxa_snowc,n) * afrac + & - a2x_Faxa_snowl(n) * afrac ! a2x_o%rAttr(index_a2x_Faxa_snowl,n) * afrac - x2o_Faxa_rain (n) = a2x_Faxa_rainc(n) * afrac + & !x2o_o%rAttr(index_x2o_Faxa_rain ,n) = a2x_o%rAttr(index_a2x_Faxa_rainc,n) * afrac + & - a2x_Faxa_rainl(n) * afrac ! a2x_o%rAttr(index_a2x_Faxa_rainl,n) * afrac + x2o_om(n,index_x2o_Faxa_snow ) = a2x_om(n,index_a2x_Faxa_snowc) * afrac + & + a2x_om(n,index_a2x_Faxa_snowl) * afrac + x2o_om(n,index_x2o_Faxa_rain ) = a2x_om(n,index_a2x_Faxa_rainc) * afrac + & + a2x_om(n,index_a2x_Faxa_rainl) * afrac - x2o_Faxa_snow (n) = x2o_Faxa_snow (n) * flux_epbalfact! x2o_o%rAttr(index_x2o_Faxa_snow ,n) = x2o_o%rAttr(index_x2o_Faxa_snow ,n) * flux_epbalfact - x2o_Faxa_rain (n) = x2o_Faxa_rain (n) * flux_epbalfact! x2o_o%rAttr(index_x2o_Faxa_rain ,n) = x2o_o%rAttr(index_x2o_Faxa_rain ,n) * flux_epbalfact + x2o_om(n,index_x2o_Faxa_snow ) = x2o_om(n,index_x2o_Faxa_snow ) * flux_epbalfact + x2o_om(n,index_x2o_Faxa_rain ) = x2o_om(n,index_x2o_Faxa_rain ) * flux_epbalfact - x2o_Faxa_prec (n) = x2o_Faxa_rain (n) + & ! x2o_o%rAttr(index_x2o_Faxa_prec ,n) = x2o_o%rAttr(index_x2o_Faxa_rain ,n) + & - x2o_Faxa_snow (n) ! x2o_o%rAttr(index_x2o_Faxa_snow ,n) + x2o_om(n,index_x2o_Faxa_prec ) = x2o_om(n,index_x2o_Faxa_rain ) + & + x2o_om(n,index_x2o_Faxa_snow ) - x2o_Foxx_rofl (n) = (r2x_Forr_rofl (n) + & ! x2o_o%rAttr(index_x2o_Foxx_rofl, n) = (r2x_o%rAttr(index_r2x_Forr_rofl , n) + & - r2x_Flrr_flood (n) ) * flux_epbalfact ! r2x_o%rAttr(index_r2x_Flrr_flood, n) ) * flux_epbalfact - ! g2x_o%rAttr(index_g2x_Fogg_rofl , n)) * flux_epbalfact - x2o_Foxx_rofi( n) = r2x_Forr_rofi (n) * flux_epbalfact ! x2o_o%rAttr(index_x2o_Foxx_rofi, n) = (r2x_o%rAttr(index_r2x_Forr_rofi , n) ) * flux_epbalfact - ! g2x_o%rAttr(index_g2x_Fogg_rofi , n)) * flux_epbalfact + x2o_om(n,index_x2o_Foxx_rofl) = (r2x_om(n,index_r2x_Forr_rofl ) + & + r2x_om(n,index_r2x_Flrr_flood) ) * flux_epbalfact + ! g2x_om(n,index_g2x_Fogg_rofl )) * flux_epbalfact + x2o_om(n,index_x2o_Foxx_rofi) = (r2x_om(n,index_r2x_Forr_rofi ) ) * flux_epbalfact + ! g2x_om(n,index_g2x_Fogg_rofi )) * flux_epbalfact if ( index_x2o_Foxx_rofl_16O /= 0 ) then - x2o_Foxx_rofl_16O (n) = (r2x_Forr_rofl_16O (n) + & ! x2o_o%rAttr(index_x2o_Foxx_rofl_16O, n) = (r2x_o%rAttr(index_r2x_Forr_rofl_16O, n) + & - r2x_Flrr_flood (n) ) * flux_epbalfact ! r2x_o%rAttr(index_r2x_Flrr_flood, n) ) * flux_epbalfact - ! g2x_o%rAttr(index_g2x_Fogg_rofl , n)) * flux_epbalfact - x2o_Foxx_rofi_16O (n) = (r2x_Forr_rofi_16O (n) ) * flux_epbalfact ! x2o_o%rAttr(index_x2o_Foxx_rofi_16O, n) = (r2x_o%rAttr(index_r2x_Forr_rofi_16O , n) ) * flux_epbalfact - ! g2x_o%rAttr(index_g2x_Fogg_rofi , n)) * flux_epbalfact - x2o_Foxx_rofl_18O (n) = (r2x_Forr_rofl_18O (n) + & ! x2o_o%rAttr(index_x2o_Foxx_rofl_18O, n) = (r2x_o%rAttr(index_r2x_Forr_rofl_18O, n) + & - r2x_Flrr_flood (n) ) * flux_epbalfact! r2x_o%rAttr(index_r2x_Flrr_flood, n) ) * flux_epbalfact - !g2x_o%rAttr(index_g2x_Fogg_rofl , n)) * flux_epbalfact - x2o_Foxx_rofi_18O (n) = (r2x_Forr_rofi_18O (n) ) * flux_epbalfact ! x2o_o%rAttr(index_x2o_Foxx_rofi_18O, n) = (r2x_o%rAttr(index_r2x_Forr_rofi_18O , n) ) * flux_epbalfact - !g2x_o%rAttr(index_g2x_Fogg_rofi , n)) * flux_epbalfact - x2o_Foxx_rofl_HDO (n) = (r2x_Forr_rofl_HDO (n) + & ! x2o_o%rAttr(index_x2o_Foxx_rofl_HDO, n) = (r2x_o%rAttr(index_r2x_Forr_rofl_HDO, n) + & - r2x_Flrr_flood (n) ) * flux_epbalfact ! r2x_o%rAttr(index_r2x_Flrr_flood, n) ) * flux_epbalfact - !g2x_o%rAttr(index_g2x_Fogg_rofl , n)) * flux_epbalfact - x2o_Foxx_rofi_HDO (n) = (r2x_Forr_rofi_HDO (n) ) * flux_epbalfact ! x2o_o%rAttr(index_x2o_Foxx_rofi_HDO, n) = (r2x_o%rAttr(index_r2x_Forr_rofi_HDO , n) ) * flux_epbalfact - !g2x_o%rAttr(index_g2x_Fogg_rofi , n)) * flux_epbalfact + x2o_om(n,index_x2o_Foxx_rofl_16O) = (r2x_om(n,index_r2x_Forr_rofl_16O) + & + r2x_om(n,index_r2x_Flrr_flood) ) * flux_epbalfact + ! g2x_om(n,index_g2x_Fogg_rofl )) * flux_epbalfact + x2o_om(n,index_x2o_Foxx_rofi_16O) = (r2x_om(n,index_r2x_Forr_rofi_16O ) ) * flux_epbalfact + ! g2x_om(n,index_g2x_Fogg_rofi )) * flux_epbalfact + x2o_om(n,index_x2o_Foxx_rofl_18O) = (r2x_om(n,index_r2x_Forr_rofl_18O) + & + r2x_om(n,index_r2x_Flrr_flood) ) * flux_epbalfact + ! g2x_om(n,index_g2x_Fogg_rofl )) * flux_epbalfact + x2o_om(n,index_x2o_Foxx_rofi_18O) = (r2x_om(n,index_r2x_Forr_rofi_18O ) ) * flux_epbalfact + !g2x_om(n,index_g2x_Fogg_rofi )) * flux_epbalfact + x2o_om(n,index_x2o_Foxx_rofl_HDO) = (r2x_om(n,index_r2x_Forr_rofl_HDO) + & + r2x_om(n,index_r2x_Flrr_flood) ) * flux_epbalfact + !g2x_om(n,index_g2x_Fogg_rofl )) * flux_epbalfact + x2o_om(n,index_x2o_Foxx_rofi_HDO) = (r2x_om(n,index_r2x_Forr_rofi_HDO ) ) * flux_epbalfact + ! g2x_om(n,index_g2x_Fogg_rofi )) * flux_epbalfact end if ! Derived: water isotopes total preciptiation and scaling if ( index_x2o_Faxa_snow_16O /= 0 )then - x2o_Faxa_snow_16O (n) = a2x_Faxa_snowc_16O(n) * afrac + & !x2o_o%rAttr(index_x2o_Faxa_snow_16O ,n) = a2x_o%rAttr(index_a2x_Faxa_snowc_16O,n) * afrac + & - a2x_Faxa_snowl_16O(n) * afrac ! a2x_o%rAttr(index_a2x_Faxa_snowl_16O,n) * afrac - x2o_Faxa_rain_16O (n) = a2x_Faxa_rainc_16O(n) * afrac + & ! x2o_o%rAttr(index_x2o_Faxa_rain_16O ,n) = a2x_o%rAttr(index_a2x_Faxa_rainc_16O,n) * afrac + & - a2x_Faxa_rainl_16O(n) * afrac ! a2x_o%rAttr(index_a2x_Faxa_rainl_16O,n) * afrac + x2o_om(n,index_x2o_Faxa_snow_16O ) = a2x_om(n,index_a2x_Faxa_snowc_16O) * afrac + & + a2x_om(n,index_a2x_Faxa_snowl_16O) * afrac + x2o_om(n,index_x2o_Faxa_rain_16O ) = a2x_om(n,index_a2x_Faxa_rainc_16O) * afrac + & + a2x_om(n,index_a2x_Faxa_rainl_16O) * afrac - x2o_Faxa_snow_16O (n) = x2o_Faxa_snow_16O (n) * flux_epbalfact ! x2o_o%rAttr(index_x2o_Faxa_snow_16O ,n) = x2o_o%rAttr(index_x2o_Faxa_snow_16O ,n) * flux_epbalfact - x2o_Faxa_rain_16O (n) = x2o_Faxa_rain_16O (n) * flux_epbalfact ! x2o_o%rAttr(index_x2o_Faxa_rain_16O ,n) = x2o_o%rAttr(index_x2o_Faxa_rain_16O ,n) * flux_epbalfact + x2o_om(n,index_x2o_Faxa_snow_16O ) = x2o_om(n,index_x2o_Faxa_snow_16O ) * flux_epbalfact + x2o_om(n,index_x2o_Faxa_rain_16O ) = x2o_om(n,index_x2o_Faxa_rain_16O ) * flux_epbalfact - x2o_Faxa_prec_16O (n) = x2o_Faxa_rain_16O (n) + & ! x2o_o%rAttr(index_x2o_Faxa_prec_16O ,n) = x2o_o%rAttr(index_x2o_Faxa_rain_16O ,n) + & - x2o_Faxa_snow_16O (n) ! x2o_o%rAttr(index_x2o_Faxa_snow_16O ,n) + x2o_om(n,index_x2o_Faxa_prec_16O ) = x2o_om(n,index_x2o_Faxa_rain_16O ) + & + x2o_om(n,index_x2o_Faxa_snow_16O ) end if if ( index_x2o_Faxa_snow_18O /= 0 )then - x2o_Faxa_snow_18O (n) = a2x_Faxa_snowc_18O(n) * afrac + & ! x2o_o%rAttr(index_x2o_Faxa_snow_18O ,n) = a2x_o%rAttr(index_a2x_Faxa_snowc_18O,n) * afrac + & - a2x_Faxa_snowl_18O(n) * afrac ! a2x_o%rAttr(index_a2x_Faxa_snowl_18O,n) * afrac - x2o_Faxa_rain_18O (n) = a2x_Faxa_rainc_18O(n) * afrac + & ! x2o_o%rAttr(index_x2o_Faxa_rain_18O ,n) = a2x_o%rAttr(index_a2x_Faxa_rainc_18O,n) * afrac + & - a2x_Faxa_rainl_18O(n) * afrac ! a2x_o%rAttr(index_a2x_Faxa_rainl_18O,n) * afrac + x2o_om(n,index_x2o_Faxa_snow_18O ) = a2x_om(n,index_a2x_Faxa_snowc_18O) * afrac + & + a2x_om(n,index_a2x_Faxa_snowl_18O) * afrac + x2o_om(n,index_x2o_Faxa_rain_18O ) = a2x_om(n,index_a2x_Faxa_rainc_18O) * afrac + & + a2x_om(n,index_a2x_Faxa_rainl_18O) * afrac - x2o_Faxa_snow_18O (n) = x2o_Faxa_snow_18O (n) * flux_epbalfact ! x2o_o%rAttr(index_x2o_Faxa_snow_18O ,n) = x2o_o%rAttr(index_x2o_Faxa_snow_18O ,n) * flux_epbalfact - x2o_Faxa_rain_18O (n) = x2o_Faxa_rain_18O (n) * flux_epbalfact ! x2o_o%rAttr(index_x2o_Faxa_rain_18O ,n) = x2o_o%rAttr(index_x2o_Faxa_rain_18O ,n) * flux_epbalfact + x2o_om(n,index_x2o_Faxa_snow_18O ) = x2o_om(n,index_x2o_Faxa_snow_18O ) * flux_epbalfact + x2o_om(n,index_x2o_Faxa_rain_18O ) = x2o_om(n,index_x2o_Faxa_rain_18O ) * flux_epbalfact - x2o_Faxa_prec_18O (n) = X2o_Faxa_rain_18O (n) + & ! x2o_o%rAttr(index_x2o_Faxa_prec_18O ,n) = x2o_o%rAttr(index_x2o_Faxa_rain_18O ,n) + & - x2o_Faxa_snow_18O (n) ! x2o_o%rAttr(index_x2o_Faxa_snow_18O ,n) + x2o_om(n,index_x2o_Faxa_prec_18O ) = x2o_om(n,index_x2o_Faxa_rain_18O ) + & + x2o_om(n,index_x2o_Faxa_snow_18O ) end if if ( index_x2o_Faxa_snow_HDO /= 0 )then - x2o_Faxa_snow_HDO (n) = a2x_Faxa_snowc_HDO(n) * afrac + & ! x2o_o%rAttr(index_x2o_Faxa_snow_HDO ,n) = a2x_o%rAttr(index_a2x_Faxa_snowc_HDO,n) * afrac + & - a2x_Faxa_snowl_HDO(n) * afrac ! a2x_o%rAttr(index_a2x_Faxa_snowl_HDO,n) * afrac - x2o_Faxa_rain_HDO (n) = a2x_Faxa_rainc_HDO(n) * afrac + & !x2o_o%rAttr(index_x2o_Faxa_rain_HDO ,n) = a2x_o%rAttr(index_a2x_Faxa_rainc_HDO,n) * afrac + & - a2x_Faxa_rainl_HDO(n) * afrac ! a2x_o%rAttr(index_a2x_Faxa_rainl_HDO,n) * afrac + x2o_om(n,index_x2o_Faxa_snow_HDO ) = a2x_om(n,index_a2x_Faxa_snowc_HDO) * afrac + & + a2x_om(n,index_a2x_Faxa_snowl_HDO) * afrac + x2o_om(n,index_x2o_Faxa_rain_HDO ) = a2x_om(n,index_a2x_Faxa_rainc_HDO) * afrac + & + a2x_om(n,index_a2x_Faxa_rainl_HDO) * afrac - x2o_Faxa_snow_HDO (n) = x2o_Faxa_snow_HDO (n) * flux_epbalfact ! x2o_o%rAttr(index_x2o_Faxa_snow_HDO ,n) = x2o_o%rAttr(index_x2o_Faxa_snow_HDO ,n) * flux_epbalfact - x2o_Faxa_rain_HDO (n) = x2o_Faxa_rain_HDO (n) * flux_epbalfact ! x2o_o%rAttr(index_x2o_Faxa_rain_HDO ,n) = x2o_o%rAttr(index_x2o_Faxa_rain_HDO ,n) * flux_epbalfact + x2o_om(n,index_x2o_Faxa_snow_HDO ) = x2o_om(n,index_x2o_Faxa_snow_HDO ) * flux_epbalfact + x2o_om(n,index_x2o_Faxa_rain_HDO ) = x2o_om(n,index_x2o_Faxa_rain_HDO ) * flux_epbalfact - x2o_Faxa_prec_HDO (n) = x2o_Faxa_rain_HDO (n) + & ! x2o_o%rAttr(index_x2o_Faxa_prec_HDO ,n) = x2o_o%rAttr(index_x2o_Faxa_rain_HDO ,n) + & - x2o_Faxa_snow_HDO (n) ! x2o_o%rAttr(index_x2o_Faxa_snow_HDO ,n) + x2o_om(n,index_x2o_Faxa_prec_HDO ) = x2o_om(n,index_x2o_Faxa_rain_HDO ) + & + x2o_om(n,index_x2o_Faxa_snow_HDO ) end if end do ! #endif - ! all x2o vars needs to be set, not get, after calculations ! - ! allocate(x2o_Foxx_swnet(lsize)) - tagname = 'Foxx_swnet'//C_NULL_CHAR - ierr = iMOAB_SetDoubleTagStorage ( mboxid, tagname, lsize , ent_type, x2o_Foxx_swnet) - if (ierr .ne. 0) then - call shr_sys_abort(subname//' error in getting Foxx_swnet field') - endif - ! allocate(x2o_Faxa_snow(lsize)) - tagname = 'Faxa_snow'//C_NULL_CHAR - ierr = iMOAB_SetDoubleTagStorage ( mboxid, tagname, lsize , ent_type, x2o_Faxa_snow) - if (ierr .ne. 0) then - call shr_sys_abort(subname//' error in getting Faxa_snow field') - endif - ! allocate(x2o_Faxa_rain(lsize)) - tagname = 'Faxa_rain'//C_NULL_CHAR - ierr = iMOAB_SetDoubleTagStorage ( mboxid, tagname, lsize , ent_type, x2o_Faxa_rain) - if (ierr .ne. 0) then - call shr_sys_abort(subname//' error in getting Faxa_rain field') - endif - ! allocate(x2o_Faxa_prec(lsize)) - tagname = 'Faxa_prec'//C_NULL_CHAR - ierr = iMOAB_SetDoubleTagStorage ( mboxid, tagname, lsize , ent_type, x2o_Faxa_prec) - if (ierr .ne. 0) then - call shr_sys_abort(subname//' error in getting Faxa_prec field') - endif - ! allocate(x2o_Foxx_rofl(lsize)) - tagname = 'Foxx_rofl'//C_NULL_CHAR - ierr = iMOAB_SetDoubleTagStorage ( mboxid, tagname, lsize , ent_type, x2o_Foxx_rofl) - if (ierr .ne. 0) then - call shr_sys_abort(subname//' error in getting Foxx_rofl field') - endif - ! allocate(x2o_Foxx_rofi(lsize)) - tagname = 'Foxx_rofi'//C_NULL_CHAR - ierr = iMOAB_SetDoubleTagStorage ( mboxid, tagname, lsize , ent_type, x2o_Foxx_rofi) - if (ierr .ne. 0) then - call shr_sys_abort(subname//' error in getting Foxx_rofi field') - endif - - if (seq_flds_i2o_per_cat) then - ! allocate(x2o_Sf_afrac(lsize)) - tagname = 'Sf_afrac'//C_NULL_CHAR - ierr = iMOAB_SetDoubleTagStorage ( mboxid, tagname, lsize , ent_type, x2o_Sf_afrac) - if (ierr .ne. 0) then - call shr_sys_abort(subname//' error in getting Sf_afrac field') - endif - ! allocate(x2o_Sf_afracr(lsize)) - tagname = 'Sf_afracr'//C_NULL_CHAR - ierr = iMOAB_SetDoubleTagStorage ( mboxid, tagname, lsize , ent_type, x2o_Sf_afracr) - if (ierr .ne. 0) then - call shr_sys_abort(subname//' error in getting Sf_afracr field') - endif - ! allocate(x2o_Foxx_swnet_afracr(lsize)) - tagname = 'Foxx_swnet_afracr'//C_NULL_CHAR - ierr = iMOAB_SetDoubleTagStorage ( mboxid, tagname, lsize , ent_type, x2o_Foxx_swnet_afracr) - if (ierr .ne. 0) then - call shr_sys_abort(subname//' error in getting Foxx_swnet_afracr field') - endif - endif - -! fill the r2x_om, etc double array fields noflds - tagname = trim(seq_flds_x2o_fields)//C_NULL_CHAR - arrsize = noflds * lsize - ierr = iMOAB_GetDoubleTagStorage ( mboxid, tagname, arrsize , ent_type, x2o_om(1,1)) - if (ierr .ne. 0) then - call shr_sys_abort(subname//' error in getting x2o_om array ') - endif - tagname = trim(seq_flds_a2x_fields)//C_NULL_CHAR - arrsize = naflds * lsize ! allocate (a2x_om (lsize, naflds)) - ierr = iMOAB_GetDoubleTagStorage ( mboxid, tagname, arrsize , ent_type, a2x_om(1,1)) - if (ierr .ne. 0) then - call shr_sys_abort(subname//' error in getting a2x_om array ') - endif - - tagname = trim(seq_flds_i2x_fields)//C_NULL_CHAR - arrsize = niflds * lsize ! allocate (i2x_om (lsize, niflds)) - ierr = iMOAB_GetDoubleTagStorage ( mboxid, tagname, arrsize , ent_type, i2x_om(1,1)) - if (ierr .ne. 0) then - call shr_sys_abort(subname//' error in getting i2x_om array ') - endif - - tagname = trim(seq_flds_r2x_fields)//C_NULL_CHAR - arrsize = nrflds * lsize ! allocate (r2x_om (lsize, nrflds)) - ierr = iMOAB_GetDoubleTagStorage ( mboxid, tagname, arrsize , ent_type, r2x_om(1,1)) - if (ierr .ne. 0) then - call shr_sys_abort(subname//' error in getting r2x_om array ') - endif - - tagname = trim(seq_flds_xao_fields)//C_NULL_CHAR - arrsize = nxflds * lsize ! allocate (xao_om (lsize, nxflds)) - ierr = iMOAB_GetDoubleTagStorage ( mbofxid, tagname, arrsize , ent_type, xao_om(1,1)) - if (ierr .ne. 0) then - call shr_sys_abort(subname//' error in getting xao_om array ') - endif - do ko = 1,noflds !--- document merge --- if (first_time) then @@ -1875,10 +1349,8 @@ subroutine prep_ocn_mrg_moab(infodata, xao_ox) ! do n = 1,lsize - ifrac = fo_kif_ifrac(n) ! fractions_o%rAttr(kif,n) - afrac = fo_kof_ofrac(n) ! fractions_o%rAttr(kof,n) - ! ifrac = fractions_o%rAttr(kif,n) - ! afrac = fractions_o%rAttr(kof,n) + ifrac = fractions_om(n,kif) !fo_kif_ifrac(n) ! fractions_o%rAttr(kif) + afrac = fractions_om(n,kof) ! fo_kof_ofrac(n) ! fractions_o%rAttr(kof,n) frac_sum = ifrac + afrac if ((frac_sum) /= 0._r8) then ifrac = ifrac / (frac_sum) From c500a133caa25a4cbb4823e21b12263871206f7c Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Tue, 13 Sep 2022 17:56:46 -0500 Subject: [PATCH 184/467] add fraction setting using ocean instance, and setting tag with global ids, by just copying the fractions from mct instance temporary solution --- driver-moab/main/cime_comp_mod.F90 | 4 +-- driver-moab/main/seq_frac_mct.F90 | 49 ++++++++++++++++++++++++++++-- 2 files changed, 49 insertions(+), 4 deletions(-) diff --git a/driver-moab/main/cime_comp_mod.F90 b/driver-moab/main/cime_comp_mod.F90 index 849f6e1ffc01..548b93c9be40 100644 --- a/driver-moab/main/cime_comp_mod.F90 +++ b/driver-moab/main/cime_comp_mod.F90 @@ -2157,7 +2157,7 @@ subroutine cime_init() if (efi == 1) write(logunit,F00) 'Setting fractions' endif - call seq_frac_set(infodata, ice(eii), & + call seq_frac_set(infodata, ice(eii), ocn(ens1), & fractions_ax(efi), fractions_ix(efi), fractions_ox(efi)) enddo @@ -4852,7 +4852,7 @@ subroutine cime_run_update_fractions() do efi = 1,num_inst_frc eii = mod((efi-1),num_inst_ice) + 1 - call seq_frac_set(infodata, ice(eii), fractions_ax(efi), fractions_ix(efi), fractions_ox(efi)) + call seq_frac_set(infodata, ice(eii), ocn(1), fractions_ax(efi), fractions_ix(efi), fractions_ox(efi)) enddo call t_drvstopf ('CPL:fracset_fracset') diff --git a/driver-moab/main/seq_frac_mct.F90 b/driver-moab/main/seq_frac_mct.F90 index 949ff2daf9dd..7e29c2d9d889 100644 --- a/driver-moab/main/seq_frac_mct.F90 +++ b/driver-moab/main/seq_frac_mct.F90 @@ -876,11 +876,15 @@ end subroutine seq_frac_init ! ! !INTERFACE: ------------------------------------------------------------------ - subroutine seq_frac_set(infodata, ice, fractions_a, fractions_i, fractions_o) + subroutine seq_frac_set(infodata, ice, ocn, fractions_a, fractions_i, fractions_o) + + use seq_comm_mct, only : mboxid ! iMOAB app id for ocn on cpl pes + use iMOAB, only : iMOAB_SetDoubleTagStorageWithGid ! !INPUT/OUTPUT PARAMETERS: type(seq_infodata_type) , intent(in) :: infodata type(component_type) , intent(in) :: ice + type(component_type) , intent(in) :: ocn type(mct_aVect) , intent(inout) :: fractions_a ! Fractions on atm type(mct_aVect) , intent(inout) :: fractions_i ! Fractions on ice type(mct_aVect) , intent(inout) :: fractions_o ! Fractions on ocn @@ -889,14 +893,23 @@ subroutine seq_frac_set(infodata, ice, fractions_a, fractions_i, fractions_o) !----- local ----- type(mct_aVect), pointer :: i2x_i type(mct_ggrid), pointer :: dom_i + type(mct_ggrid), pointer :: dom_o ! introduced just to update ocean moab fractions logical :: atm_present ! true => atm is present logical :: ice_present ! true => ice is present logical :: ocn_present ! true => ocn is present integer :: n integer :: ki, kl, ko, kf - integer :: lsize real(r8),allocatable :: fcorr(:) + logical, save :: first_time = .true. +! moab + integer :: ierr, kgg + integer , save :: lSize, ent_type + character(CXX) :: tagname + real(r8), allocatable, save :: tagValues(:) ! used for setting some tags + integer , allocatable, save :: GlobalIds(:) ! used for setting values associated with ids + + integer nvert(3), nvise(3), nbl(3), nsurf(3), nvisBC(3) !----- formats ----- character(*),parameter :: subName = '(seq_frac_set) ' @@ -920,6 +933,8 @@ subroutine seq_frac_set(infodata, ice, fractions_a, fractions_i, fractions_o) dom_i => component_get_dom_cx(ice) i2x_i => component_get_c2x_cx(ice) + dom_o => component_get_dom_cx(ocn) ! + if (ice_present) then call mct_aVect_copy(i2x_i, fractions_i, "Si_ifrac", "ifrac") @@ -936,6 +951,36 @@ subroutine seq_frac_set(infodata, ice, fractions_a, fractions_i, fractions_o) call seq_map_map(mapper_i2o, fractions_i, fractions_o, & fldlist='ofrac:ifrac',norm=.false.) call seq_frac_check(fractions_o, 'ocn set') + ! update ocean fractions on moab instance + if (first_time) then ! allocate some local arrays + lSize = mct_aVect_lSize(dom_o%data) + allocate(tagValues(lSize) ) + allocate(GlobalIds(lSize) ) + kgg = mct_aVect_indexIA(dom_o%data ,"GlobGridNum" ,perrWith=subName) + GlobalIds = dom_o%data%iAttr(kgg,:) + ent_type = 1 ! cells for mpas ocean + endif + ! something like this: + + tagname = 'ofrac'//C_NULL_CHAR + ! fraclist_o = 'afrac:ifrac:ofrac:ifrad:ofrad' + tagValues = fractions_o%rAttr(3,:) + ierr = iMOAB_SetDoubleTagStorageWithGid ( mboxid, tagname, lSize , ent_type, tagValues, GlobalIds ) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in setting ofrac on ocn moab instance ' + call shr_sys_abort(subname//' ERROR in setting ofrac on ocn moab instance ') + endif + tagname = 'ifrac'//C_NULL_CHAR + ! fraclist_o = 'afrac:ifrac:ofrac:ifrad:ofrad' + tagValues = fractions_o%rAttr(2,:) + ierr = iMOAB_SetDoubleTagStorageWithGid ( mboxid, tagname, lSize , ent_type, tagValues, GlobalIds ) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in setting ofrac on ocn moab instance ' + call shr_sys_abort(subname//' ERROR in setting ofrac on ocn moab instance ') + endif + + first_time = .false. + endif if (atm_present) then From c5c8e3100c38360a5fba9a92149c50a04a05eaf7 Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Fri, 16 Sep 2022 17:27:04 -0500 Subject: [PATCH 185/467] sameg_al rework it should be the same as samegrid_al sameg_al was valid only on the land pes but we need it in the coupler too replace it with original samegrid_al, and save it when necessary --- components/elm/src/cpl/lnd_comp_mct.F90 | 7 ++++--- driver-moab/main/cplcomp_exchange_mod.F90 | 6 +++--- driver-moab/main/prep_atm_mod.F90 | 10 +++++----- driver-moab/main/prep_lnd_mod.F90 | 10 +++++----- driver-moab/main/seq_frac_mct.F90 | 12 ++++++++---- driver-moab/shr/seq_comm_mct.F90 | 2 +- 6 files changed, 26 insertions(+), 21 deletions(-) diff --git a/components/elm/src/cpl/lnd_comp_mct.F90 b/components/elm/src/cpl/lnd_comp_mct.F90 index 817e4815626e..ce6be783ac5b 100644 --- a/components/elm/src/cpl/lnd_comp_mct.F90 +++ b/components/elm/src/cpl/lnd_comp_mct.F90 @@ -15,7 +15,7 @@ module lnd_comp_mct use iso_c_binding #ifdef HAVE_MOAB - use seq_comm_mct, only: mlnid, sameg_al! id of moab land app + use seq_comm_mct, only: mlnid! id of moab land app #endif ! ! !public member functions: @@ -37,6 +37,7 @@ module lnd_comp_mct private :: lnd_export_moab ! it should be part of lnd_import_export, but we will keep it here integer , private :: mblsize, totalmbls real (r8) , allocatable, private :: l2x_lm(:,:) ! for tags in MOAB + logical :: sameg_al ! save it for export :) #endif !--------------------------------------------------------------------------- @@ -322,6 +323,7 @@ subroutine lnd_init_mct( EClock, cdata_l, x2l_l, l2x_l, NLFilename ) lnd_gnam=lnd_gnam ) if (trim(atm_gnam) /= trim(lnd_gnam)) samegrid_al = .false. call init_land_moab(bounds, samegrid_al) + sameg_al = samegrid_al ! will use it for export too #endif call mct_aVect_init(x2l_l, rList=seq_flds_x2l_fields, lsize=lsz) call mct_aVect_zero(x2l_l) @@ -816,7 +818,6 @@ subroutine init_land_moab(bounds, samegrid_al) integer, allocatable :: moabconn(:) ! will have the connectivity in terms of local index in verts dims =3 ! store as 3d mesh - sameg_al = samegrid_al ! use a different name, but they do mean the same thing ! number the local grid lsz = bounds%endg - bounds%begg + 1 @@ -827,7 +828,7 @@ subroutine init_land_moab(bounds, samegrid_al) end do gsize = ldomain%ni * ldomain%nj ! size of the total grid ! if ldomain%nv > 3 , create mesh - if (ldomain%nv .ge. 3 .and. .not.sameg_al) then + if (ldomain%nv .ge. 3 .and. .not.samegrid_al) then ! number of vertices is nv * lsz ! allocate(moab_vert_coords(lsz*dims*ldomain%nv)) ! loop over ldomain diff --git a/driver-moab/main/cplcomp_exchange_mod.F90 b/driver-moab/main/cplcomp_exchange_mod.F90 index 6e6d7d3487ad..854e8659a362 100644 --- a/driver-moab/main/cplcomp_exchange_mod.F90 +++ b/driver-moab/main/cplcomp_exchange_mod.F90 @@ -22,7 +22,6 @@ module cplcomp_exchange_mod use seq_comm_mct, only : mlnid , mblxid ! iMOAB app id for land , on land pes and coupler pes use seq_comm_mct, only : mphaid ! iMOAB app id for phys atm; comp atm is 5, phys 5+200 use seq_comm_mct, only : mphaxid ! iMOAB app id for phys atm, on cpl pes - use seq_comm_mct, only : sameg_al ! same grid atm lnd, and land is point cloud use seq_comm_mct, only : MPSIID, mbixid ! sea-ice on comp pes and on coupler pes use seq_comm_mct, only : mrofid, mbrxid ! iMOAB id of moab rof app on comp pes and on coupler too use shr_mpi_mod, only: shr_mpi_max @@ -1384,14 +1383,15 @@ subroutine cplcomp_moab_Init(comp) endif #ifdef MOABDEBUG ! debug test - if (sameg_al) then + ! if only vertices, set a partition tag for help in visualizations + ierr = iMOAB_GetMeshInfo(mblxid, nverts, nelem, nblocks, nsbc, ndbc) + if (nelem(1) .eq. 0) then ! we have only vertices locally? !there are no shared entities, but we will set a special partition tag, in order to see the ! partitions ; it will be visible with a Pseudocolor plot in VisIt tagname='partition'//C_NULL_CHAR tagtype = 0 ! dense, integer numco = 1 ! one value per cell ierr = iMOAB_DefineTagStorage(mblxid, tagname, tagtype, numco, tagindex ) - ierr = iMOAB_GetMeshInfo(mblxid, nverts, nelem, nblocks, nsbc, ndbc) allocate(vgids(nverts(1))) vgids = rank ent_type = 0 ! vertex type diff --git a/driver-moab/main/prep_atm_mod.F90 b/driver-moab/main/prep_atm_mod.F90 index 3c3d79c7dc55..6a9fa6ff5edb 100644 --- a/driver-moab/main/prep_atm_mod.F90 +++ b/driver-moab/main/prep_atm_mod.F90 @@ -29,7 +29,6 @@ module prep_atm_mod use seq_comm_mct, only : atm_pg_active ! whether the atm uses FV mesh or not ; made true if fv_nphys > 0 use seq_comm_mct, only : mblxid ! iMOAB id for land migrated to coupler pes !! old name : mlnxid use seq_comm_mct, only : mbintxla ! iMOAB id for intx mesh between land and atmosphere - use seq_comm_mct, only : sameg_al ! true by default, so land and atm on same mesh use seq_comm_mct, only : seq_comm_getinfo => seq_comm_setptrs use dimensions_mod, only : np ! for atmosphere @@ -93,9 +92,10 @@ module prep_atm_mod ! other module variables integer :: mpicom_CPLID ! MPI cpl communicator logical :: iamroot_CPLID ! .true. => CPLID masterproc - + logical :: sameg_al ! saved for export / migrate save integer :: num_proj ! to index the coupler projection calls + !================================================================================================ contains @@ -182,6 +182,7 @@ subroutine prep_atm_init(infodata, ocn_c2_atm, ice_c2_atm, lnd_c2_atm, iac_c2_at samegrid_al = .true. samegrid_ao = .true. if (trim(atm_gnam) /= trim(lnd_gnam)) samegrid_al = .false. + sameg_al = samegrid_al ! sameg_al is now a local, private variable; use it later for migrate if (trim(atm_gnam) /= trim(ocn_gnam)) samegrid_ao = .false. if (ocn_c2_atm) then @@ -285,7 +286,7 @@ subroutine prep_atm_init(infodata, ocn_c2_atm, ice_c2_atm, lnd_c2_atm, iac_c2_at ! important change: do not compute intx at all between atm and land when we have sameg_al ! we will use just a comm graph to send data from phys grid to land on coupler - if ((mbaxid .ge. 0) .and. (mblxid .ge. 0) .and. .not. sameg_al ) then + if ((mbaxid .ge. 0) .and. (mblxid .ge. 0) .and. .not. samegrid_al ) then appname = "ATM_LND_COU"//C_NULL_CHAR ! idintx is a unique number of MOAB app that takes care of intx between lnd and atm mesh idintx = 100*atm(1)%cplcompid + lnd(1)%cplcompid ! something different, to differentiate it @@ -350,7 +351,6 @@ subroutine prep_atm_migrate_moab(infodata) integer :: context_id ! we will use ocean context or land context character*32 :: dm1, dm2, wgtIdef character*50 :: outfile, wopts, lnum - integer :: orderOCN, orderATM, volumetric, noConserve, validate character(CXX) :: tagName, tagnameProj, tagNameExt @@ -502,7 +502,7 @@ subroutine prep_atm_migrate_moab(infodata) if (atm_present .and. lnd_present) then wgtIdef = 'scalar'//C_NULL_CHAR ! from fv, need to be similar to ocean now - if (.not. sameg_al) then ! tri-grid case + if (.not. sameg_al) then ! tri-grid case if (atm_pg_active ) then ! use mhpgid mesh if (mhpgid .ge. 0) then ! send because we are on atm pes diff --git a/driver-moab/main/prep_lnd_mod.F90 b/driver-moab/main/prep_lnd_mod.F90 index 998dfe1a8203..804a5ed0a8e6 100644 --- a/driver-moab/main/prep_lnd_mod.F90 +++ b/driver-moab/main/prep_lnd_mod.F90 @@ -17,7 +17,6 @@ module prep_lnd_mod use seq_comm_mct, only: mblxid ! iMOAB id for mpas ocean migrated mesh to coupler pes use seq_comm_mct, only: mbintxla ! iMOAB id for intx mesh between land and atmosphere use seq_comm_mct, only: mbaxid ! iMOAB id for atm migrated mesh to coupler pes - use seq_comm_mct, only: sameg_al ! true by default, so land and atm on same mesh use seq_comm_mct, only: atm_pg_active ! whether the atm uses FV mesh or not ; made true if fv_nphys > 0 use dimensions_mod, only: np ! for atmosphere use seq_comm_mct, only: seq_comm_getinfo => seq_comm_setptrs @@ -103,6 +102,7 @@ module prep_lnd_mod #ifdef MOABDEBUG integer :: number_calls ! it is a static variable, used to count the number of projections #endif + logical :: sameg_al ! local private variable, store samegrid_al value contains !================================================================================================ @@ -181,6 +181,7 @@ subroutine prep_lnd_init(infodata, atm_c2_lnd, rof_c2_lnd, glc_c2_lnd, iac_c2_ln samegrid_lr = .true. samegrid_lg = .true. if (trim(atm_gnam) /= trim(lnd_gnam)) samegrid_al = .false. + sameg_al = samegrid_al ! save for future use if (trim(lnd_gnam) /= trim(rof_gnam)) samegrid_lr = .false. if (trim(lnd_gnam) /= trim(glc_gnam)) samegrid_lg = .false. @@ -648,28 +649,27 @@ subroutine prep_atm_lnd_moab(infodata) if (mbintxla .ge. 0 ) then ! weights are computed over coupler pes ! copy from atm - ocn , it is now similar, as land is full mesh, not pc cloud wgtIdef = 'scalar'//C_NULL_CHAR + volumetric = 0 ! TODO: check this , for PC ; for imoab_coupler test, volumetric is 0 if (atm_pg_active) then dm1 = "fv"//C_NULL_CHAR dofnameATM="GLOBAL_ID"//C_NULL_CHAR orderATM = 1 ! fv-fv - volumetric = 1 ! maybe volumetric ? else dm1 = "cgll"//C_NULL_CHAR dofnameATM="GLOBAL_DOFS"//C_NULL_CHAR orderATM = np ! it should be 4 - volumetric = 0 + volumetric = 1 endif dofnameLND="GLOBAL_ID"//C_NULL_CHAR orderLND = 1 ! not much arguing + ! is the land mesh explicit or point cloud ? based on sameg_al flag: if (sameg_al) then dm2 = "pcloud"//C_NULL_CHAR wgtIdef = 'scalar-pc'//C_NULL_CHAR - volumetric = 0 ! TODO: check this , for PC ; for imoab_coupler test, volumetric is 0 else dm2 = "fv"//C_NULL_CHAR ! land is FV - volumetric = 1 endif fNoBubble = 1 monotonicity = 0 ! diff --git a/driver-moab/main/seq_frac_mct.F90 b/driver-moab/main/seq_frac_mct.F90 index 7e29c2d9d889..22018e3c4429 100644 --- a/driver-moab/main/seq_frac_mct.F90 +++ b/driver-moab/main/seq_frac_mct.F90 @@ -173,7 +173,6 @@ module seq_frac_mct use seq_comm_mct, only : atm_pg_active ! flag if PG mesh instanced use seq_comm_mct, only : mbintxao ! iMOAB id for intx mesh between ocean and atmosphere ! for tri grid, sameg_al would be false - use seq_comm_mct, only : sameg_al ! same grid atm and land; used throughout, initialized in lnd_init use seq_comm_mct, only : mbrxid ! iMOAB id of moab rof migrated to coupler pes @@ -438,11 +437,16 @@ subroutine seq_frac_init( infodata, & call shr_sys_abort(subname//' ERROR in defining tags on lnd phys mesh on cpl') endif ierr = iMOAB_GetMeshInfo ( mblxid, nvert, nvise, nbl, nsurf, nvisBC ); - arrSize = 3 * nVert(1) + + if (nvise(1) .eq. 0) then + ent_type = 0 ! vertex type, land on atm grid, no cells + arrSize = 3 * nVert(1) + else + ent_type = 1 ! cell type, tri-grid case + arrSize = 3 * nvise(1) + endif ! real land mesh allocate(tagValues(arrSize) ) - ent_type = 1 ! cell type, tri-grid case tagValues = 0 - if (sameg_al) ent_type = 0 ! vertex type, land on atm grid ierr = iMOAB_SetDoubleTagStorage ( mblxid, tagname, arrSize , ent_type, tagValues) if (ierr .ne. 0) then write(logunit,*) subname,' error in setting fractions tags on lnd ' diff --git a/driver-moab/shr/seq_comm_mct.F90 b/driver-moab/shr/seq_comm_mct.F90 index b65d4a780b4c..3ee3d8fcef4b 100644 --- a/driver-moab/shr/seq_comm_mct.F90 +++ b/driver-moab/shr/seq_comm_mct.F90 @@ -227,7 +227,7 @@ module seq_comm_mct integer, public :: mblxid ! iMOAB id for land mesh migrated to coupler pes integer, public :: mblx2id ! iMOAB id for land mesh instanced from MCT on coupler pes integer, public :: mbox2id ! iMOAB id for ocn mesh instanced from MCT on coupler pes - logical, public :: sameg_al ! same grid atm and land; used throughout, initialized in lnd_init + logical, public :: sameg_al = .true. ! same grid atm and land; used throughout, initialized in lnd_init integer, public :: mbintxla ! iMOAB id for intx mesh between land and atmosphere integer, public :: mpsiid ! iMOAB id for sea-ice, mpas model integer, public :: mbixid ! iMOAB id for sea-ice migrated to coupler pes From b36adbfc1192fb84ed6d5489eefd5ac22e93ef72 Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Fri, 16 Sep 2022 23:24:36 -0500 Subject: [PATCH 186/467] get rid of sameg_al calculate every time samegrid_al, although painful there should be a better way save a infodata somewhere for trigrid config same for atm_pg_active --- driver-moab/main/prep_atm_mod.F90 | 18 ++++++++++++------ driver-moab/main/prep_lnd_mod.F90 | 21 +++++++++++++-------- 2 files changed, 25 insertions(+), 14 deletions(-) diff --git a/driver-moab/main/prep_atm_mod.F90 b/driver-moab/main/prep_atm_mod.F90 index 6a9fa6ff5edb..4ef9407d38b4 100644 --- a/driver-moab/main/prep_atm_mod.F90 +++ b/driver-moab/main/prep_atm_mod.F90 @@ -92,7 +92,6 @@ module prep_atm_mod ! other module variables integer :: mpicom_CPLID ! MPI cpl communicator logical :: iamroot_CPLID ! .true. => CPLID masterproc - logical :: sameg_al ! saved for export / migrate save integer :: num_proj ! to index the coupler projection calls @@ -182,7 +181,6 @@ subroutine prep_atm_init(infodata, ocn_c2_atm, ice_c2_atm, lnd_c2_atm, iac_c2_at samegrid_al = .true. samegrid_ao = .true. if (trim(atm_gnam) /= trim(lnd_gnam)) samegrid_al = .false. - sameg_al = samegrid_al ! sameg_al is now a local, private variable; use it later for migrate if (trim(atm_gnam) /= trim(ocn_gnam)) samegrid_ao = .false. if (ocn_c2_atm) then @@ -284,7 +282,7 @@ subroutine prep_atm_init(infodata, ocn_c2_atm, ice_c2_atm, lnd_c2_atm, iac_c2_at 'seq_maps.rc','lnd2atm_smapname:','lnd2atm_smaptype:',samegrid_al, & 'mapper_Sl2a initialization',esmf_map_flag) - ! important change: do not compute intx at all between atm and land when we have sameg_al + ! important change: do not compute intx at all between atm and land when we have samegrid_al ! we will use just a comm graph to send data from phys grid to land on coupler if ((mbaxid .ge. 0) .and. (mblxid .ge. 0) .and. .not. samegrid_al ) then appname = "ATM_LND_COU"//C_NULL_CHAR @@ -352,14 +350,22 @@ subroutine prep_atm_migrate_moab(infodata) character*32 :: dm1, dm2, wgtIdef character*50 :: outfile, wopts, lnum character(CXX) :: tagName, tagnameProj, tagNameExt + character(CL) :: atm_gnam ! atm grid + character(CL) :: lnd_gnam ! lnd grid + logical :: samegrid_al call seq_infodata_getData(infodata, & atm_present=atm_present, & ocn_present=ocn_present, & lnd_present=lnd_present, & + atm_gnam=atm_gnam, & + lnd_gnam=lnd_gnam, & ocn_prognostic=ocn_prognostic) + samegrid_al = .true. + if (trim(atm_gnam) /= trim(lnd_gnam)) samegrid_al = .false. + ! it involves initial atm app; mhid; also migrate atm mesh on coupler pes, mbaxid ! intx ocean atm are in mbintxao ; remapper also has some info about coverage mesh ! after this, the sending of tags from atm pes to coupler pes will use the new par comm graph, that has more precise info about @@ -502,7 +508,7 @@ subroutine prep_atm_migrate_moab(infodata) if (atm_present .and. lnd_present) then wgtIdef = 'scalar'//C_NULL_CHAR ! from fv, need to be similar to ocean now - if (.not. sameg_al) then ! tri-grid case + if (.not. samegrid_al) then ! tri-grid case if (atm_pg_active ) then ! use mhpgid mesh if (mhpgid .ge. 0) then ! send because we are on atm pes @@ -600,7 +606,7 @@ subroutine prep_atm_migrate_moab(infodata) !CHECKRC(ierr, "cannot receive tag values") endif - else ! sameg_al, original lnd from atm grid + else ! samegrid_al, original lnd from atm grid ! major change; we do not have intx anymore, we just send from phys grid to land on coupler, ! using the comm graph computed at line prep_atm_lnd_moab , prep_lnd_mod.70:621 ! ierr = iMOAB_ComputeCommGraph( mphaid, mblxid, mpicom_join, mpigrp_old, mpigrp_CPLID, & @@ -655,7 +661,7 @@ subroutine prep_atm_migrate_moab(infodata) #endif endif ! if on coupler procs - endif ! sameg_al, original + endif ! samegrid_al, original endif ! if (atm_present .and. lnd_present) end subroutine prep_atm_migrate_moab diff --git a/driver-moab/main/prep_lnd_mod.F90 b/driver-moab/main/prep_lnd_mod.F90 index 804a5ed0a8e6..42f1c94609ce 100644 --- a/driver-moab/main/prep_lnd_mod.F90 +++ b/driver-moab/main/prep_lnd_mod.F90 @@ -102,7 +102,6 @@ module prep_lnd_mod #ifdef MOABDEBUG integer :: number_calls ! it is a static variable, used to count the number of projections #endif - logical :: sameg_al ! local private variable, store samegrid_al value contains !================================================================================================ @@ -181,7 +180,6 @@ subroutine prep_lnd_init(infodata, atm_c2_lnd, rof_c2_lnd, glc_c2_lnd, iac_c2_ln samegrid_lr = .true. samegrid_lg = .true. if (trim(atm_gnam) /= trim(lnd_gnam)) samegrid_al = .false. - sameg_al = samegrid_al ! save for future use if (trim(lnd_gnam) /= trim(rof_gnam)) samegrid_lr = .false. if (trim(lnd_gnam) /= trim(glc_gnam)) samegrid_lg = .false. @@ -601,11 +599,18 @@ subroutine prep_atm_lnd_moab(infodata) ! used only for tri-grid case integer :: tagtype, numco, tagindex character*400 :: tagname ! will store all seq_flds_a2x_fields + character(CL) :: atm_gnam ! atm grid + character(CL) :: lnd_gnam ! lnd grid + logical :: samegrid_al call seq_infodata_getData(infodata, & atm_present=atm_present, & - lnd_present=lnd_present) + lnd_present=lnd_present, & + atm_gnam=atm_gnam, & + lnd_gnam=lnd_gnam) + samegrid_al = .true. + if (trim(atm_gnam) /= trim(lnd_gnam)) samegrid_al = .false. ! it involves initial atm app; mhid; or pg2 mesh , in case atm_pg_active also migrate atm mesh on coupler pes, mbaxid ! intx lnd atm are in mbintxla ; remapper also has some info about coverage mesh ! after this, the sending of tags from atm pes to coupler pes, in land context will use the new par @@ -617,7 +622,7 @@ subroutine prep_atm_lnd_moab(infodata) ! we cannot use mbintxla because it may not exist on atm comp yet; context_id = lnd(1)%cplcompid call seq_comm_getinfo(ID_join,mpicom=mpicom_join) - if ( .not. sameg_al ) then + if ( .not. samegrid_al ) then if (atm_pg_active ) then ! use mhpgid mesh ierr = iMOAB_CoverageGraph(mpicom_join, mhpgid, mbaxid, mbintxla, atm_id, id_join, context_id); else @@ -664,8 +669,8 @@ subroutine prep_atm_lnd_moab(infodata) dofnameLND="GLOBAL_ID"//C_NULL_CHAR orderLND = 1 ! not much arguing - ! is the land mesh explicit or point cloud ? based on sameg_al flag: - if (sameg_al) then + ! is the land mesh explicit or point cloud ? based on samegrid_al flag: + if (samegrid_al) then dm2 = "pcloud"//C_NULL_CHAR wgtIdef = 'scalar-pc'//C_NULL_CHAR else @@ -688,7 +693,7 @@ subroutine prep_atm_lnd_moab(infodata) endif endif ! we will use intx atm-lnd mesh only when land is explicit - if (.not. sameg_al) then + if (.not. samegrid_al) then ! as with ocn, data is sent from atm ph to the intx atm/lnd, not from pg2 mesh anymore ! for that, we will use the comm graph between atm ph and atm pg2 intersected with land! ! copy from ocn logic, just replace with land @@ -720,7 +725,7 @@ subroutine prep_atm_lnd_moab(infodata) write(logunit,*) subname,' error in computing graph phys grid - atm/lnd intx ' call shr_sys_abort(subname//' ERROR in computing graph phys grid - atm/ocn intx ') endif - endif ! if (.not. sameg_al) + endif ! if (.not. samegrid_al) if (mblxid .ge. 0) then ! in any case, we need to define the tags on landx from the phys atm seq_flds_a2x_fields From 328cc369e4d2276eaf4415b80a1841da885660ad Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Sun, 18 Sep 2022 16:23:11 -0500 Subject: [PATCH 187/467] size of character fields can be bigger than 400 --- components/elm/src/cpl/lnd_comp_mct.F90 | 3 +- components/mosart/src/cpl/rof_comp_mct.F90 | 4 +- components/mpas-ocean/driver/ocn_comp_mct.F | 5 +- components/mpas-seaice/driver/ice_comp_mct.F | 5 +- driver-moab/main/cime_comp_mod.F90 | 9 ++- driver-moab/main/component_mod.F90 | 64 -------------------- driver-moab/main/prep_lnd_mod.F90 | 2 +- 7 files changed, 15 insertions(+), 77 deletions(-) diff --git a/components/elm/src/cpl/lnd_comp_mct.F90 b/components/elm/src/cpl/lnd_comp_mct.F90 index ce6be783ac5b..20654c2f44eb 100644 --- a/components/elm/src/cpl/lnd_comp_mct.F90 +++ b/components/elm/src/cpl/lnd_comp_mct.F90 @@ -789,6 +789,7 @@ end subroutine lnd_domain_mct #ifdef HAVE_MOAB subroutine init_land_moab(bounds, samegrid_al) use seq_flds_mod , only : seq_flds_l2x_fields + use shr_kind_mod , only : CXX => SHR_KIND_CXX use spmdMod , only: iam ! rank on the land communicator use domainMod , only: ldomain ! ldomain is coming from module, not even passed use elm_varcon , only: re @@ -813,7 +814,7 @@ subroutine init_land_moab(bounds, samegrid_al) integer dims, i, iv, ilat, ilon, igdx, ierr, tagindex integer tagtype, numco, ent_type, mbtype, block_ID character*100 outfile, wopts, localmeshfile - character*400 tagname ! hold all fields + character(CXX) :: tagname ! hold all fields integer, allocatable :: moabconn(:) ! will have the connectivity in terms of local index in verts diff --git a/components/mosart/src/cpl/rof_comp_mct.F90 b/components/mosart/src/cpl/rof_comp_mct.F90 index dc46877ec926..94b308dfeddc 100644 --- a/components/mosart/src/cpl/rof_comp_mct.F90 +++ b/components/mosart/src/cpl/rof_comp_mct.F90 @@ -7,7 +7,7 @@ module rof_comp_mct ! in MCT (Model Coupling Toolkit) format and converting it to use by MOSART use seq_flds_mod - use shr_kind_mod , only : r8 => shr_kind_r8, SHR_KIND_CL + use shr_kind_mod , only : r8 => shr_kind_r8, SHR_KIND_CL, CXX => SHR_KIND_CXX use shr_file_mod , only : shr_file_setLogUnit, shr_file_setLogLevel, & shr_file_getLogUnit, shr_file_getLogLevel, & shr_file_getUnit, shr_file_setIO @@ -146,7 +146,7 @@ subroutine rof_init_mct( EClock, cdata_r, x2r_r, r2x_r, NLFilename) #ifdef HAVE_MOAB integer :: ierr, tagtype, numco, tagindex character*32 appname - character*400 tagname ! for fields + character(CXX) :: tagname ! for fields #endif !--------------------------------------------------------------------------- diff --git a/components/mpas-ocean/driver/ocn_comp_mct.F b/components/mpas-ocean/driver/ocn_comp_mct.F index 8d5f0f6b4c8e..ebca8316be80 100644 --- a/components/mpas-ocean/driver/ocn_comp_mct.F +++ b/components/mpas-ocean/driver/ocn_comp_mct.F @@ -38,6 +38,7 @@ module ocn_comp_mct use mpas_constants use mpas_log #ifdef HAVE_MOAB + use shr_kind_mod , only: cxx => SHR_KIND_CXX use mpas_moabmesh use seq_comm_mct, only: MPOID use iMOAB, only: iMOAB_DefineTagStorage @@ -224,7 +225,7 @@ subroutine ocn_init_mct( EClock, cdata_o, x2o_o, o2x_o, NLFilename )!{{{ #ifdef HAVE_MOAB character*100 outfile, wopts integer :: ierrmb, numco, tagtype, tagindex - character(len=400) :: tagname + character(CXX) :: tagname #endif interface subroutine xml_stream_parser(xmlname, mgr_p, comm, ierr) bind(c) @@ -2794,7 +2795,7 @@ subroutine ocn_export_moab() !{{{ integer, save :: num_mb_exports = 0 ! used for debugging integer :: ent_type, ierr character(len=100) :: outfile, wopts, localmeshfile, lnum - character(len=400) :: tagname + character(CXX) :: tagname integer :: i, n integer, pointer :: nCellsSolve, index_temperatureSurfaceValue, index_salinitySurfaceValue, & diff --git a/components/mpas-seaice/driver/ice_comp_mct.F b/components/mpas-seaice/driver/ice_comp_mct.F index 1bd1b51d77f2..ff78880c015f 100644 --- a/components/mpas-seaice/driver/ice_comp_mct.F +++ b/components/mpas-seaice/driver/ice_comp_mct.F @@ -44,6 +44,7 @@ module ice_comp_mct use mpas_moabmesh use seq_comm_mct, only: MPSIID use iMOAB, only: iMOAB_DefineTagStorage + use shr_kind_mod , only: cxx => SHR_KIND_CXX #endif use iso_c_binding, only : c_char, c_loc, c_ptr, c_int @@ -216,7 +217,7 @@ subroutine ice_init_mct( EClock, cdata_i, x2i_i, i2x_i, NLFilename )!{{{ character(len=strKIND) :: history #ifdef HAVE_MOAB integer :: ierrmb, numco, tagtype, tagindex - character(len=400) :: tagname + character(CXX) :: tagname #endif logical, pointer :: tempLogicalConfig character(len=StrKIND), pointer :: tempCharConfig @@ -3009,7 +3010,7 @@ subroutine ice_export_moab() character(len=32), parameter :: sub = 'ice_export_moab' character(len=100) :: outfile, wopts, localmeshfile, lnum - character(len=400) :: tagname + character(CXX) :: tagname !----------------------------------------------------------------------- call shr_file_setLogUnit (iceLogUnit) n = 0 diff --git a/driver-moab/main/cime_comp_mod.F90 b/driver-moab/main/cime_comp_mod.F90 index 548b93c9be40..37b6aea18018 100644 --- a/driver-moab/main/cime_comp_mod.F90 +++ b/driver-moab/main/cime_comp_mod.F90 @@ -4676,9 +4676,6 @@ end subroutine cime_run_rof_recv_post !---------------------------------------------------------------------------------- subroutine cime_run_ice_setup_send() - - use seq_flds_mod , only : seq_flds_i2x_fields - use seq_comm_mct , only : mpsiid, mbixid ! ! Note that for atm->ice mapping below will leverage the assumption that the ! ice and ocn are on the same grid and that mapping of atm to ocean is @@ -4724,7 +4721,6 @@ subroutine cime_run_ice_setup_send() mpicom_barrier=mpicom_CPLALLICEID, run_barriers=run_barriers, & timer_barrier='CPL:C2I_BARRIER', timer_comp_exch='CPL:C2I', & timer_map_exch='CPL:c2i_icex2icei', timer_infodata_exch='CPL:ice_infoexch') - call component_exch_moab(ice(1), mpsiid, mbixid, 0, seq_flds_i2x_fields) endif end subroutine cime_run_ice_setup_send @@ -4736,6 +4732,8 @@ subroutine cime_run_ice_recv_post() !---------------------------------------------------------- ! ice -> cpl !---------------------------------------------------------- + use seq_flds_mod , only : seq_flds_i2x_fields + use seq_comm_mct , only : mpsiid, mbixid ! if (iamin_CPLALLICEID) then call component_exch(ice, flow='c2x', & infodata=infodata, infodata_string='ice2cpl_run', & @@ -4748,8 +4746,9 @@ subroutine cime_run_ice_recv_post() ! it needs to be called on the joint comm between ice and coupler ! if we do a proper component_exch, then would need another hop, just on coupler pes ! TODO when do we need to send from ice to ocn? Usually after ice run ? + call component_exch_moab(ice(1), mpsiid, mbixid, 0, seq_flds_i2x_fields) ! this migrates all fields from ice to coupler if (ice_c2_ocn ) then - call prep_ocn_calc_i2x_ox_moab() + call prep_ocn_calc_i2x_ox_moab() ! this does projection ice-ocn with one hop endif endif diff --git a/driver-moab/main/component_mod.F90 b/driver-moab/main/component_mod.F90 index 51944e82d7cd..0e7752ef1306 100644 --- a/driver-moab/main/component_mod.F90 +++ b/driver-moab/main/component_mod.F90 @@ -967,70 +967,6 @@ subroutine component_diag(infodata, comp, flow, comment, info_debug, timer_diag end subroutine component_diag -! subroutine ocn_cpl_moab(ocn) - -! use seq_comm_mct , only : mboxid, mpoid ! -! use seq_flds_mod , only : seq_flds_o2x_fields -! use iMOAB , only: iMOAB_SendElementTag, iMOAB_ReceiveElementTag, iMOAB_WriteMesh, iMOAB_FreeSenderBuffers -! use seq_comm_mct, only : num_moab_exports ! for debugging -! use ISO_C_BINDING, only : C_NULL_CHAR -! !--------------------------------------------------------------- -! ! Description -! ! send tags from ocean component to coupler instance -! ! -! ! it involves initial ocn app; mpoid; also migrated ocn mesh mesh on coupler pes, mboxid -! ! the sending of tags from ocn pes to coupler pes will use initial graph/migrate - -! type(component_type) , intent(in) :: ocn(:) - -! integer :: id_join, ocnid1, context_id , ierr -! integer :: mpicom_join -! character(400) :: tagname -! character*100 outfile, wopts, lnum - -! ! how to get mpicomm for joint ocn + coupler -! id_join = ocn(1)%cplcompid -! ocnid1 = ocn(1)%compid -! call seq_comm_getinfo(ID_join,mpicom=mpicom_join) -! context_id = -1 -! ! -! tagName = trim(seq_flds_o2x_fields)//C_NULL_CHAR - -! if (mpoid .ge. 0) then ! send because we are on ocn pes - -! ! basically, use the initial partitioning -! context_id = id_join -! ierr = iMOAB_SendElementTag(mpoid, tagName, mpicom_join, context_id) - -! endif -! if ( mboxid .ge. 0 ) then ! we are on coupler pes, for sure -! ! receive on couper pes, -! context_id = ocnid1 -! ierr = iMOAB_ReceiveElementTag(mboxid, tagName, mpicom_join, context_id) -! ! !CHECKRC(ierr, "cannot receive tag values") -! endif - -! ! ! we can now free the sender buffers -! if (mpoid .ge. 0) then -! context_id = id_join -! ierr = iMOAB_FreeSenderBuffers(mpoid, context_id) -! ! ! CHECKRC(ierr, "cannot free buffers used to send projected tag towards the ocean mesh") -! endif - -! #ifdef MOABDEBUG -! if (mboxid .ge. 0 ) then ! we are on coupler pes, for sure -! ! number_proj = number_proj+1 ! count the number of projections -! write(lnum,"(I0.2)") num_moab_exports -! outfile = 'ocnCpl_'//trim(lnum)//'.h5m'//C_NULL_CHAR -! wopts = ';PARALLEL=WRITE_PART'//C_NULL_CHAR ! -! ierr = iMOAB_WriteMesh(mboxid, trim(outfile), trim(wopts)) - -! !CHECKRC(ierr, "cannot receive tag values") -! endif -! #endif - -! end subroutine ocn_cpl_moab - subroutine component_exch_moab(comp, mbAPPid1, mbAppid2, direction, fields ) diff --git a/driver-moab/main/prep_lnd_mod.F90 b/driver-moab/main/prep_lnd_mod.F90 index 42f1c94609ce..5eab97408acb 100644 --- a/driver-moab/main/prep_lnd_mod.F90 +++ b/driver-moab/main/prep_lnd_mod.F90 @@ -598,7 +598,7 @@ subroutine prep_atm_lnd_moab(infodata) integer :: idintx ! in this case, id of moab intersection between atm and lnd, on coupler pes ! used only for tri-grid case integer :: tagtype, numco, tagindex - character*400 :: tagname ! will store all seq_flds_a2x_fields + character(CXX) :: tagname ! will store all seq_flds_a2x_fields character(CL) :: atm_gnam ! atm grid character(CL) :: lnd_gnam ! lnd grid logical :: samegrid_al From 9aa9f84ac729d894b3cf38ce509362003214c342 Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Mon, 19 Sep 2022 22:35:11 -0500 Subject: [PATCH 188/467] land for tri-grid case more like ocean --- components/eam/src/cpl/atm_comp_mct.F90 | 36 +--- components/mosart/src/cpl/rof_comp_mct.F90 | 16 +- driver-moab/main/prep_atm_mod.F90 | 199 +++++++++++---------- 3 files changed, 113 insertions(+), 138 deletions(-) diff --git a/components/eam/src/cpl/atm_comp_mct.F90 b/components/eam/src/cpl/atm_comp_mct.F90 index 66728f5287be..764fa6a98791 100644 --- a/components/eam/src/cpl/atm_comp_mct.F90 +++ b/components/eam/src/cpl/atm_comp_mct.F90 @@ -13,7 +13,7 @@ module atm_comp_mct use seq_infodata_mod use seq_timemgr_mod - use shr_kind_mod , only: r8 => shr_kind_r8, cl=>shr_kind_cl + use shr_kind_mod , only: r8 => shr_kind_r8, cl=>shr_kind_cl, cxx=>shr_kind_cxx use shr_kind_mod , only: cs => shr_kind_cs use shr_file_mod , only: shr_file_getunit, shr_file_freeunit, & shr_file_setLogUnit, shr_file_setLogLevel, & @@ -1037,7 +1037,7 @@ subroutine initialize_moab_atm_phys( cdata_a ) !real(r8), parameter:: radtodeg = 180.0_r8/SHR_CONST_PI character*100 outfile, wopts - character*400 tagname ! will store all seq_flds_a2x_fields + character(CXX) :: tagname ! will store all seq_flds_a2x_fields character*32 appname @@ -1138,38 +1138,8 @@ subroutine initialize_moab_atm_phys( cdata_a ) if (ierr > 0 ) & call endrun('Error: fail to set area tag ') - ! ! create some tags for T, u, v bottoms: not anymore - - ! tagname='T_ph'//C_NULL_CHAR - ! ierr = iMOAB_DefineTagStorage(mphaid, tagname, tagtype, numco, tagindex ) - ! if (ierr > 0 ) & - ! call endrun('Error: fail to create temp on phys tag ') - ! tagname='u_ph'//C_NULL_CHAR - ! ierr = iMOAB_DefineTagStorage(mphaid, tagname, tagtype, numco, tagindex ) - ! if (ierr > 0 ) & - ! call endrun('Error: fail to create u velo on phys tag ') - ! tagname='v_ph'//C_NULL_CHAR - ! ierr = iMOAB_DefineTagStorage(mphaid, tagname, tagtype, numco, tagindex ) - ! if (ierr > 0 ) & - ! call endrun('Error: fail to create v velo on phys tag ') - - ! need to identify that the mesh is indeed point cloud - ! this call will set the point_cloud to true inside iMOAB appData structure ierr = iMOAB_UpdateMeshInfo(mphaid) -! tagname='area'//C_NULL_CHAR -! ierr = iMOAB_DefineTagStorage(mphaid, tagname, tagtype, numco, tagindex ) -! if (ierr > 0 ) & -! call endrun('Error: fail to create area tag ') -! do i = 1, lsz -! moab_vert_coords(i) = dom%data%rAttr(ixarea, i) ! use the same doubles for second tag :) -! enddo -! -! ierr = iMOAB_SetDoubleTagStorage ( mphaid, tagname, lsz , ent_type, moab_vert_coords ) -! if (ierr > 0 ) & -! call endrun('Error: fail to set area tag ') - - ! write out the mesh file to disk, in parallel #ifdef MOABDEBUG outfile = 'AtmPhys.h5m'//C_NULL_CHAR wopts = 'PARALLEL=WRITE_PART'//C_NULL_CHAR @@ -1211,7 +1181,7 @@ subroutine cam_moab_phys_export(cam_out) integer tagtype, numco, ent_type character*100 outfile, wopts, lnum - character*400 tagname ! + character(CXX) :: tagname ! integer ierr, c, nlcols, ig, i, ncols diff --git a/components/mosart/src/cpl/rof_comp_mct.F90 b/components/mosart/src/cpl/rof_comp_mct.F90 index 94b308dfeddc..5914813f4557 100644 --- a/components/mosart/src/cpl/rof_comp_mct.F90 +++ b/components/mosart/src/cpl/rof_comp_mct.F90 @@ -880,20 +880,6 @@ subroutine init_rof_moab() if (ierr > 0 ) & call shr_sys_abort( sub//' Error: fail to set mask tag ') - ! ! define tags for data that will be sent to coupler - ! ! they will be associated to point cloud vertices - ! ! seq_flds_r2x_fields - - ! tagname='mbForr_rofl'//C_NULL_CHAR - ! tagtype = 1 ! dense, double - ! ierr = iMOAB_DefineTagStorage(mrofid, tagname, tagtype, numco, tagindex ) - ! if (ierr > 0 ) & - ! call shr_sys_abort( sub//' Error: fail to create mbForr_rofl tag ') - ! tagname='mbForr_rofi'//C_NULL_CHAR - ! ierr = iMOAB_DefineTagStorage(mrofid, tagname, tagtype, numco, tagindex ) - ! if (ierr > 0 ) & - ! call shr_sys_abort( sub//' Error: fail to create mbForr_rofi tag ') - deallocate(moab_vert_coords) deallocate(vgids) #ifdef MOABDEBUG @@ -927,7 +913,7 @@ subroutine rof_export_moab() character(len=32), parameter :: sub = 'rof_export_moab' character*100 outfile, wopts, localmeshfile, lnum - character*400 tagname + character(CXX) :: tagname !--------------------------------------------------------------------------- nliq = 0 nfrz = 0 diff --git a/driver-moab/main/prep_atm_mod.F90 b/driver-moab/main/prep_atm_mod.F90 index 4ef9407d38b4..e83f0a5371e7 100644 --- a/driver-moab/main/prep_atm_mod.F90 +++ b/driver-moab/main/prep_atm_mod.F90 @@ -464,7 +464,7 @@ subroutine prep_atm_migrate_moab(infodata) endif ! we can now free the sender buffers - if (mhid .ge. 0) then + if (mphaid .ge. 0) then context_id = 100*atm(1)%cplcompid + ocn(1)%cplcompid !send to atm/ocn intx ! ~ 618 ierr = iMOAB_FreeSenderBuffers(mphaid, context_id) if (ierr .ne. 0) then @@ -502,111 +502,130 @@ subroutine prep_atm_migrate_moab(infodata) endif ! if atm and ocn ! repeat this for land data, that is already on atm tag - tagNameProj = 'a2lTbot_proj:a2lUbot_proj:a2lVbot_proj:'//C_NULL_CHAR - context_id = lnd(1)%cplcompid if (atm_present .and. lnd_present) then wgtIdef = 'scalar'//C_NULL_CHAR ! from fv, need to be similar to ocean now if (.not. samegrid_al) then ! tri-grid case - if (atm_pg_active ) then ! use mhpgid mesh - - if (mhpgid .ge. 0) then ! send because we are on atm pes + if (atm_pg_active ) then ! use mhpgid mesh + + if (mhpgid .ge. 0) then ! send because we are on atm pes + + ! basically, adjust the migration of the tag we want to project; it was sent initially with + ! original partitioning, now we need to adjust it for "coverage" mesh + ! as always, use nonblocking sends + tagName = trim(seq_flds_a2x_fields)//C_NULL_CHAR ! they are defined in initialize_moab_atm_phys in atm_comp_mct + context_id = 100*atm(1)%cplcompid + lnd(1)%cplcompid !send to atm/lnd intx ! + ! use computed graph + ierr = iMOAB_SendElementTag(mphaid, tagName, mpicom_join, context_id) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in sending tag from atm to atm land intx ' + call shr_sys_abort(subname//' ERROR in sending tag from atm to atm land intx') + endif - ! basically, adjust the migration of the tag we want to project; it was sent initially with - ! original partitioning, now we need to adjust it for "coverage" mesh - ! as always, use nonblocking sends - tagName = 'T_ph:u_ph:v_ph:'//C_NULL_CHAR ! they are defined in initialize_moab_atm_phys in atm_comp_mct - context_id = 100*atm(1)%cplcompid + lnd(1)%cplcompid !send to atm/lnd intx ! - ! use computed graph - ierr = iMOAB_SendElementTag(mphaid, tagName, mpicom_join, context_id) - if (ierr .ne. 0) then - write(logunit,*) subname,' error in sending tag from atm to atm land intx ' - call shr_sys_abort(subname//' ERROR in sending tag from atm to atm land intx') endif - - endif - if (mbaxid .ge. 0 ) then ! we are on coupler pes, for sure - ! receive on atm on coupler pes, that was redistributed according to coverage - tagName = 'T_ph:u_ph:v_ph:'//C_NULL_CHAR ! they are defined in initialize_moab_atm_phys - ierr = iMOAB_ReceiveElementTag(mbintxla, tagName, mpicom_join, atm_id) - if (ierr .ne. 0) then - write(logunit,*) subname,' error in receiving tag from atm to atm land intx ' - call shr_sys_abort(subname//' ERROR in receiving tag from atm to atm land intx') + if (mbaxid .ge. 0 ) then ! we are on coupler pes, for sure + ! receive on atm on coupler pes, that was redistributed according to coverage + tagName = trim(seq_flds_a2x_fields)//C_NULL_CHAR ! they are defined in initialize_moab_atm_phys + ierr = iMOAB_ReceiveElementTag(mbintxla, tagName, mpicom_join, atm_id) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in receiving tag from atm to atm land intx ' + call shr_sys_abort(subname//' ERROR in receiving tag from atm to atm land intx') + endif endif - endif - ! we can now free the sender buffers - if (mhpgid .ge. 0) then - context_id = 100*atm(1)%cplcompid + lnd(1)%cplcompid !send to atm/lnd intx ! - ierr = iMOAB_FreeSenderBuffers(mphaid, context_id) - if (ierr .ne. 0) then - write(logunit,*) subname,' error in freeing buffer ' - call shr_sys_abort(subname//' ERROR in freeing buffer') + ! we can now free the sender buffers + if (mphaid .ge. 0) then + context_id = 100*atm(1)%cplcompid + lnd(1)%cplcompid !send to atm/lnd intx ! + ierr = iMOAB_FreeSenderBuffers(mphaid, context_id) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in freeing buffer ' + call shr_sys_abort(subname//' ERROR in freeing buffer') + endif endif - endif - else ! regular coarse homme mesh if (.not. atm_pg_active) - tagName = 'a2oTbot:a2oUbot:a2oVbot:'//C_NULL_CHAR - ! context_id = lnd(1)%cplcompid ! - if (mhid .ge. 0) then ! send because we are on atm pes - ! basically, adjust the migration of the tag we want to project; it was sent initially with - ! original partitioning, now we need to adjust it for "coverage" mesh - ! as always, use nonblocking sends + if (mbintxla .ge. 0 ) then ! we are on coupler pes, for sure + ! we could apply weights; need to use the same weight identifier wgtIdef as when we generated it + ! hard coded now, it should be a runtime option in the future - ierr = iMOAB_SendElementTag(mhid, tagName, mpicom_join, context_id) - if (ierr .ne. 0) then - write(logunit,*) subname,' error in sending tag from atm spectral to atm/lnd intx ' - call shr_sys_abort(subname//' ERROR in sending tag from atm spectral to atm/lnd intx ') + ierr = iMOAB_ApplyScalarProjectionWeights ( mbintxla, wgtIdef, tagName, tagName) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in applying weights ' + call shr_sys_abort(subname//' ERROR in applying weights') + endif +#ifdef MOABDEBUG + ! we can also write the lnd mesh to file, just to see the projectd tag + ! write out the mesh file to disk + write(lnum,"(I0.2)")num_proj + outfile = 'lndCplProj'//trim(lnum)//'.h5m'//C_NULL_CHAR + wopts = ';PARALLEL=WRITE_PART'//C_NULL_CHAR ! + ierr = iMOAB_WriteMesh(mblxid, trim(outfile), trim(wopts)) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in writing ocn mesh after projection ' + call shr_sys_abort(subname//' ERROR in writing ocn mesh after projection') + endif +#endif + endif ! if (mbintxla .ge. 0 ) + + else ! regular coarse homme mesh if (.not. atm_pg_active) + tagName = trim(seq_flds_a2x_fields)//C_NULL_CHAR ! they are exported on phys grid directly + tagNameExt = trim(seq_flds_a2x_ext_fields)//C_NULL_CHAR ! these are special moab tags + ! the separator will be ':' as in mct + + if (mphaid .ge. 0) then ! send because we are on atm pes + ! + context_id = 100*atm(1)%cplcompid + lnd(1)%cplcompid !send to atm/lnd intx ! ~ + ierr = iMOAB_SendElementTag(mphaid, tagName, mpicom_join, context_id) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in sending tag from atm spectral to ocn atm intx ' + call shr_sys_abort(subname//' ERROR in sending tag from atm spectral to ocn atm intx') + endif endif - - endif - if (mbaxid .ge. 0 ) then ! we are on coupler pes, for sure - ! receive on atm on coupler pes, that was redistributed according to coverage - ierr = iMOAB_ReceiveElementTag(mbaxid, tagName, mpicom_join, context_id) - if (ierr .ne. 0) then - write(logunit,*) subname,' error in receiving tag from atm spectral to atm/lnd intx ' - call shr_sys_abort(subname//' ERROR in receiving tag from atm spectral to atm/lnd intx ') + if (mbaxid .ge. 0 ) then ! we are on coupler pes, for sure + ! receive on atm on coupler pes, that was redistributed according to coverage + context_id = atm(1)%compid ! atm_id + ierr = iMOAB_ReceiveElementTag(mbintxla, tagNameExt, mpicom_join, context_id) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in receiving tag from atm phys grid to lnd atm intx spectral ' + call shr_sys_abort(subname//' ERROR in receiving tag from atm phys grid to lnd atm intx spectral') + endif endif - endif - ! we can now free the sender buffers - if (mhid .ge. 0) then - ierr = iMOAB_FreeSenderBuffers(mhid, context_id) - if (ierr .ne. 0) then - write(logunit,*) subname,' error in freeing buffer ' - call shr_sys_abort(subname//' ERROR in freeing buffer') + ! we can now free the sender buffers + if (mphaid .ge. 0) then + context_id = 100*atm(1)%cplcompid + lnd(1)%cplcompid !send to atm/ocn intx ! ~ 618 + ierr = iMOAB_FreeSenderBuffers(mphaid, context_id) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in freeing buffers ' + call shr_sys_abort(subname//' ERROR in freeing buffers') + endif endif - endif - endif - - ! we could do the projection now, on the land mesh, because we are on the coupler pes; - ! the actual migrate back could happen later , from coupler pes to the land pes - if (mbintxla .ge. 0 ) then ! we are on coupler pes, for sure - ! we could apply weights; need to use the same weight identifier wgtIdef as when we generated it - ! hard coded now, it should be a runtime option in the future - ierr = iMOAB_ApplyScalarProjectionWeights ( mbintxla, wgtIdef, tagName, tagNameProj) - if (ierr .ne. 0) then - write(logunit,*) subname,' error in projection on land ' - call shr_sys_abort(subname//' ERROR in projection on land') - endif - + ! we could do the projection now, on the ocean mesh, because we are on the coupler pes; + ! the actual migrate could happen later , from coupler pes to the ocean pes + if (mbintxla .ge. 0 ) then ! we are on coupler pes, for sure + ! we could apply weights; need to use the same weight identifier wgtIdef as when we generated it + ! hard coded now, it should be a runtime option in the future + + ierr = iMOAB_ApplyScalarProjectionWeights ( mbintxla, wgtIdef, tagNameExt, tagName) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in applying weights ' + call shr_sys_abort(subname//' ERROR in applying weights') + endif #ifdef MOABDEBUG - ! we can also write the ocean mesh to file, just to see the projectd tag - ! write out the mesh file to disk - write(lnum,"(I0.2)")num_proj - outfile = 'lndCplProj'//trim(lnum)//'.h5m'//C_NULL_CHAR - wopts = ';PARALLEL=WRITE_PART'//C_NULL_CHAR ! - ierr = iMOAB_WriteMesh(mblxid, trim(outfile), trim(wopts)) - if (ierr .ne. 0) then - write(logunit,*) subname,' error in writing mesh on coupler land' - call shr_sys_abort(subname//' ERROR in writing mesh on coupler land') - endif + ! we can also write the lnd mesh to file, just to see the projectd tag + ! write out the mesh file to disk + write(lnum,"(I0.2)")num_proj + outfile = 'lndCplProj'//trim(lnum)//'.h5m'//C_NULL_CHAR + wopts = ';PARALLEL=WRITE_PART'//C_NULL_CHAR ! + ierr = iMOAB_WriteMesh(mblxid, trim(outfile), trim(wopts)) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in writing ocn mesh after projection ' + call shr_sys_abort(subname//' ERROR in writing ocn mesh after projection') + endif #endif - - !CHECKRC(ierr, "cannot receive tag values") - endif - else ! samegrid_al, original lnd from atm grid + endif ! if (mbintxla .ge. 0 ) + endif + else ! sameg_al, original lnd from atm grid ! major change; we do not have intx anymore, we just send from phys grid to land on coupler, ! using the comm graph computed at line prep_atm_lnd_moab , prep_lnd_mod.70:621 ! ierr = iMOAB_ComputeCommGraph( mphaid, mblxid, mpicom_join, mpigrp_old, mpigrp_CPLID, & @@ -661,8 +680,8 @@ subroutine prep_atm_migrate_moab(infodata) #endif endif ! if on coupler procs - endif ! samegrid_al, original - endif ! if (atm_present .and. lnd_present) + endif + endif ! if (atm_present .and. lnd_present) end subroutine prep_atm_migrate_moab From 5dd6a910d4ce31d7afdc47d52ecd422123e3a408 Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Tue, 20 Sep 2022 15:50:35 -0500 Subject: [PATCH 189/467] i2x fields need to be defined on coupler side otherwise they will not show up when we write in debug mode also, get rif of sameg_al still need to solve the problem of atm_pg_active this is not seen outside atm pes; luckily, coupler shares the same pes as atm, which is not guaranteed to be true in general --- driver-moab/main/cplcomp_exchange_mod.F90 | 9 +++++++++ driver-moab/shr/seq_comm_mct.F90 | 1 - 2 files changed, 9 insertions(+), 1 deletion(-) diff --git a/driver-moab/main/cplcomp_exchange_mod.F90 b/driver-moab/main/cplcomp_exchange_mod.F90 index 854e8659a362..faed8495d669 100644 --- a/driver-moab/main/cplcomp_exchange_mod.F90 +++ b/driver-moab/main/cplcomp_exchange_mod.F90 @@ -12,6 +12,7 @@ module cplcomp_exchange_mod use seq_flds_mod, only: seq_flds_a2x_ext_fields ! use seq_flds_mod, only: seq_flds_o2x_fields ! needed for MOAB init of ocean fields o2x to be able to transfer to coupler use seq_flds_mod, only: seq_flds_x2o_fields ! needed for MOAB init of ocean fields x2o to be able to transfer from coupler + use seq_flds_mod, only: seq_flds_i2x_fields ! needed for MOAB init of ice fields x2o on coupler side, to save them use seq_comm_mct, only: cplid, logunit use seq_comm_mct, only: seq_comm_getinfo => seq_comm_setptrs, seq_comm_iamin use seq_diag_mct @@ -1446,6 +1447,13 @@ subroutine cplcomp_moab_Init(comp) ! migrated mesh gets another app id, moab moab sea ice to coupler (mbox) ierr = iMOAB_RegisterApplication(trim(appname), mpicom_new, id_join, mbixid) ierr = iMOAB_ReceiveMesh(mbixid, mpicom_join, mpigrp_old, id_old) + tagtype = 1 ! dense, double + numco = 1 ! one value per cell / entity + tagname = trim(seq_flds_i2x_fields)//C_NULL_CHAR + ierr = iMOAB_DefineTagStorage(mbixid, tagname, tagtype, numco, tagindex ) + if ( ierr == 1 ) then + call shr_sys_abort( subname//' ERROR: cannot define tags for ice proj to ocn' ) + end if #ifdef MOABDEBUG ! debug test outfile = 'recSeaIce.h5m'//C_NULL_CHAR @@ -1466,6 +1474,7 @@ subroutine cplcomp_moab_Init(comp) call shr_sys_abort(subname//' ERROR in freeing buffers ') endif endif + endif ! rof if (comp%oneletterid == 'r' .and. maxMRID /= -1) then diff --git a/driver-moab/shr/seq_comm_mct.F90 b/driver-moab/shr/seq_comm_mct.F90 index 3ee3d8fcef4b..47e9d3ad4b02 100644 --- a/driver-moab/shr/seq_comm_mct.F90 +++ b/driver-moab/shr/seq_comm_mct.F90 @@ -227,7 +227,6 @@ module seq_comm_mct integer, public :: mblxid ! iMOAB id for land mesh migrated to coupler pes integer, public :: mblx2id ! iMOAB id for land mesh instanced from MCT on coupler pes integer, public :: mbox2id ! iMOAB id for ocn mesh instanced from MCT on coupler pes - logical, public :: sameg_al = .true. ! same grid atm and land; used throughout, initialized in lnd_init integer, public :: mbintxla ! iMOAB id for intx mesh between land and atmosphere integer, public :: mpsiid ! iMOAB id for sea-ice, mpas model integer, public :: mbixid ! iMOAB id for sea-ice migrated to coupler pes From 02a5c69a5281a73c31581e19947f56d34e85d8cd Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Tue, 27 Sep 2022 22:56:57 -0500 Subject: [PATCH 190/467] use only num_moab_exports for debug files also, error out in comp_exchange_moab with a proper message atm tag migration on phys grid involves a different external id (add 200), to differentiate from other atm meshes --- components/eam/src/cpl/atm_comp_mct.F90 | 4 +- components/mosart/src/cpl/rof_comp_mct.F90 | 5 +- .../src/framework/mpas_moabmesh.F | 9 ---- components/mpas-ocean/driver/ocn_comp_mct.F | 5 +- components/mpas-seaice/driver/ice_comp_mct.F | 4 +- driver-moab/main/cime_comp_mod.F90 | 4 +- driver-moab/main/component_mod.F90 | 51 +++++++++++-------- driver-moab/main/prep_atm_mod.F90 | 16 +++--- driver-moab/main/prep_ocn_mod.F90 | 10 +--- 9 files changed, 49 insertions(+), 59 deletions(-) diff --git a/components/eam/src/cpl/atm_comp_mct.F90 b/components/eam/src/cpl/atm_comp_mct.F90 index 764fa6a98791..0cfbcf57acda 100644 --- a/components/eam/src/cpl/atm_comp_mct.F90 +++ b/components/eam/src/cpl/atm_comp_mct.F90 @@ -1000,7 +1000,7 @@ end subroutine atm_write_srfrest_mct #ifdef HAVE_MOAB subroutine initialize_moab_atm_phys( cdata_a ) - use seq_comm_mct, only: mphaid, num_moab_exports ! imoab pid for atm physics + use seq_comm_mct, only: mphaid ! imoab pid for atm physics use shr_mpi_mod, only: shr_mpi_commrank, shr_mpi_commsize use shr_const_mod, only: SHR_CONST_PI !------------------------------------------------------------------- @@ -1156,7 +1156,6 @@ subroutine initialize_moab_atm_phys( cdata_a ) call endrun('Error: fail to define seq_flds_a2x_fields for atm physgrid moab mesh') endif - num_moab_exports = 0 ! will be used for counting number of calls deallocate(moab_vert_coords) deallocate(vgids) deallocate(areavals) @@ -1246,7 +1245,6 @@ subroutine cam_moab_phys_export(cam_out) call endrun('Error: fail to set seq_flds_a2x_fields for atm physgrid moab mesh') endif #ifdef MOABDEBUG - num_moab_exports = num_moab_exports + 1 write(lnum,"(I0.2)")num_moab_exports outfile = 'AtmPhys_'//trim(lnum)//'.h5m'//C_NULL_CHAR wopts = 'PARALLEL=WRITE_PART'//C_NULL_CHAR diff --git a/components/mosart/src/cpl/rof_comp_mct.F90 b/components/mosart/src/cpl/rof_comp_mct.F90 index 5914813f4557..452f5d4658f4 100644 --- a/components/mosart/src/cpl/rof_comp_mct.F90 +++ b/components/mosart/src/cpl/rof_comp_mct.F90 @@ -902,6 +902,7 @@ subroutine rof_export_moab() ! ! ARGUMENTS: use seq_comm_mct, only: mrofid ! id of moab rof app + use seq_comm_mct, only: num_moab_exports use iMOAB, only : iMOAB_SetDoubleTagStorage, iMOAB_WriteMesh implicit none @@ -909,7 +910,6 @@ subroutine rof_export_moab() ! LOCAL VARIABLES integer :: ni, n, nt, nliq, nfrz, lsz, ierr, ent_type logical,save :: first_time = .true. - integer, save :: num_mb_exports = 0 ! used for debugging character(len=32), parameter :: sub = 'rof_export_moab' character*100 outfile, wopts, localmeshfile, lnum @@ -1002,8 +1002,7 @@ subroutine rof_export_moab() call shr_sys_abort( sub//' Error: fail to set moab '// trim(seq_flds_r2x_fields) ) #ifdef MOABDEBUG - num_mb_exports = num_mb_exports +1 - write(lnum,"(I0.2)")num_mb_exports + write(lnum,"(I0.2)")num_moab_exports outfile = 'wholeRof_'//trim(lnum)//'.h5m'//C_NULL_CHAR wopts = 'PARALLEL=WRITE_PART'//C_NULL_CHAR ierr = iMOAB_WriteMesh(mrofid, outfile, wopts) diff --git a/components/mpas-framework/src/framework/mpas_moabmesh.F b/components/mpas-framework/src/framework/mpas_moabmesh.F index 53c598c3ebba..9ccbf97e8ee0 100644 --- a/components/mpas-framework/src/framework/mpas_moabmesh.F +++ b/components/mpas-framework/src/framework/mpas_moabmesh.F @@ -171,15 +171,6 @@ subroutine mpas_moab_instance(domain, ext_comp_id, pidmoab) ierr = iMOAB_SetIntTagStorage ( pid, tagname, nCellsSolve, ent_type, indexToCellID) call errorout(ierr, 'fail to set global id tag for polygons') ! get next block -!#ifdef MPAS_DEBUG -! if (proc_id.lt. 5) then -! write(lnum,"(I0.2)")proc_id -! localmeshfile = 'ownedOcn_'//trim(lnum)// '.h5m' // C_NULL_CHAR -! wopts = C_NULL_CHAR -! ierr = iMOAB_WriteMesh(pid, localmeshfile, wopts) -! call errorout(ierr, 'fail to write local mesh file') -! endif -!#endif ierr = iMOAB_ResolveSharedEntities( pid, currentVertex, localIds ); call errorout(ierr, 'fail to resolve shared entities') diff --git a/components/mpas-ocean/driver/ocn_comp_mct.F b/components/mpas-ocean/driver/ocn_comp_mct.F index ebca8316be80..9211b5e0472d 100644 --- a/components/mpas-ocean/driver/ocn_comp_mct.F +++ b/components/mpas-ocean/driver/ocn_comp_mct.F @@ -41,6 +41,7 @@ module ocn_comp_mct use shr_kind_mod , only: cxx => SHR_KIND_CXX use mpas_moabmesh use seq_comm_mct, only: MPOID + use seq_comm_mct, only: num_moab_exports use iMOAB, only: iMOAB_DefineTagStorage #endif use iso_c_binding, only : c_char, c_loc, c_ptr, c_int @@ -2792,7 +2793,6 @@ subroutine ocn_export_moab() !{{{ ! local variables ! !----------------------------------------------------------------------- - integer, save :: num_mb_exports = 0 ! used for debugging integer :: ent_type, ierr character(len=100) :: outfile, wopts, localmeshfile, lnum character(CXX) :: tagname @@ -3033,8 +3033,7 @@ subroutine ocn_export_moab() !{{{ !----------------------------------------------------------------------- !EOC #ifdef MOABDEBUG - num_mb_exports = num_mb_exports +1 - write(lnum,"(I0.2)")num_mb_exports + write(lnum,"(I0.2)")num_moab_exports outfile = 'ocn_export_'//trim(lnum)//'.h5m'//C_NULL_CHAR wopts = 'PARALLEL=WRITE_PART'//C_NULL_CHAR ierr = iMOAB_WriteMesh(MPOID, outfile, wopts) diff --git a/components/mpas-seaice/driver/ice_comp_mct.F b/components/mpas-seaice/driver/ice_comp_mct.F index ff78880c015f..56b09a3ff6d2 100644 --- a/components/mpas-seaice/driver/ice_comp_mct.F +++ b/components/mpas-seaice/driver/ice_comp_mct.F @@ -3241,13 +3241,13 @@ subroutine ice_export_moab() endif -#ifdef MOABDEBUG +!#ifdef MOABDEBUG num_mb_exports = num_mb_exports +1 write(lnum,"(I0.2)")num_mb_exports outfile = 'ice_export_'//trim(lnum)//'.h5m'//C_NULL_CHAR wopts = 'PARALLEL=WRITE_PART'//C_NULL_CHAR ierr = iMOAB_WriteMesh(MPSIID, outfile, wopts) -#endif +!#endif end subroutine ice_export_moab #endif end module ice_comp_mct diff --git a/driver-moab/main/cime_comp_mod.F90 b/driver-moab/main/cime_comp_mod.F90 index 37b6aea18018..5111d3257b92 100644 --- a/driver-moab/main/cime_comp_mod.F90 +++ b/driver-moab/main/cime_comp_mod.F90 @@ -2460,6 +2460,7 @@ subroutine cime_run() use seq_comm_mct, only: glc_layout, rof_layout, ocn_layout use seq_comm_mct, only: wav_layout, esp_layout, iac_layout, num_inst_driver use seq_comm_mct, only: seq_comm_inst + use seq_comm_mct, only: num_moab_exports ! used to count the steps for moab files use seq_pauseresume_mod, only: seq_resume_store_comp, seq_resume_get_files use seq_pauseresume_mod, only: seq_resume_free @@ -2680,6 +2681,7 @@ subroutine cime_run() Time_bstep = mpi_wtime() do while ( .not. stop_alarm) + num_moab_exports = num_moab_exports + 1 call t_startf('CPL:RUN_LOOP', hashint(1)) call t_startf('CPL:CLOCK_ADVANCE') @@ -4133,7 +4135,7 @@ subroutine cime_run_ocn_setup_send() mpicom_barrier=mpicom_CPLALLOCNID, run_barriers=run_barriers, & timer_barrier='CPL:C2O_BARRIER', timer_comp_exch='CPL:C2O', & timer_map_exch='CPL:c2o_ocnx2ocno', timer_infodata_exch='CPL:c2o_infoexch') - ! will migrate the tag from component pes to coupler pes, on atm mesh + ! will migrate the tag from coupler pes to component pes, on ocn mesh call component_exch_moab(ocn(1), mboxid, mpoid, 1, seq_flds_x2o_fields) endif diff --git a/driver-moab/main/component_mod.F90 b/driver-moab/main/component_mod.F90 index 0e7752ef1306..0c8ffcb11f7b 100644 --- a/driver-moab/main/component_mod.F90 +++ b/driver-moab/main/component_mod.F90 @@ -969,60 +969,66 @@ end subroutine component_diag subroutine component_exch_moab(comp, mbAPPid1, mbAppid2, direction, fields ) - use iMOAB , only: iMOAB_SendElementTag, iMOAB_ReceiveElementTag, iMOAB_WriteMesh, iMOAB_FreeSenderBuffers use seq_comm_mct, only : num_moab_exports ! for debugging use ISO_C_BINDING, only : C_NULL_CHAR use shr_kind_mod , only : CXX => shr_kind_CXX !--------------------------------------------------------------- ! Description - ! send tags from ocean component to coupler instance - ! - ! it involves initial ocn app; mpoid; also migrated ocn mesh mesh on coupler pes, mboxid - ! the sending of tags from ocn pes to coupler pes will use initial graph/migrate + ! send tags (fields) from component to coupler or from coupler to component type(component_type) , intent(in) :: comp ! direction 0 is from component to coupler; 1 is from coupler to component integer, intent(in) :: mbAPPid1, mbAppid2, direction character(CXX) , intent(in) :: fields - integer :: id_join, lcompid, context_id , ierr + character(*), parameter :: subname = '(component_exch_moab)' + integer :: id_join, source_id, target_id, ierr integer :: mpicom_join character(CXX) :: tagname character*100 outfile, wopts, lnum, dir ! how to get mpicomm for joint comp + coupler id_join = comp%cplcompid - lcompid = comp%compid - - call seq_comm_getinfo(ID_join,mpicom=mpicom_join) - context_id = -1 ! tagName = trim(fields)//C_NULL_CHAR - if (direction .eq. 1) then! reverse - id_join = comp%compid - lcompid = comp%cplcompid + if (direction .eq. 0) then + source_id = comp%compid + target_id = comp%cplcompid + else ! direction eq 1 + source_id = comp%cplcompid + target_id = comp%compid + endif + ! for atm, add 200 to target and source (see ID_JOIN_ATMPHYS and ID_OLD_ATMPHYS) + if (comp%oneletterid == 'a') then + ! more hacks + source_id = source_id + 200 + target_id = target_id + 200 endif if (mbAPPid1 .ge. 0) then ! send ! basically, use the initial partitioning - context_id = id_join - ierr = iMOAB_SendElementTag(mbAPPid1, tagName, mpicom_join, context_id) + ierr = iMOAB_SendElementTag(mbAPPid1, tagName, mpicom_join, target_id) + if (ierr .ne. 0) then + call shr_sys_abort(subname//' cannot send element tag') + endif endif if ( mbAPPid2 .ge. 0 ) then ! we are on receiving end - context_id = lcompid - ierr = iMOAB_ReceiveElementTag(mbAPPid2, tagName, mpicom_join, context_id) -! !CHECKRC(ierr, "cannot receive tag values") + ierr = iMOAB_ReceiveElementTag(mbAPPid2, tagName, mpicom_join, source_id) + if (ierr .ne. 0) then + call shr_sys_abort(subname//' cannot receive element tag') + endif endif ! ! we can now free the sender buffers if (mbAPPid1 .ge. 0) then - context_id = id_join - ierr = iMOAB_FreeSenderBuffers(mbAPPid1, context_id) -! ! CHECKRC(ierr, "cannot free buffers used to send tag") + ierr = iMOAB_FreeSenderBuffers(mbAPPid1, target_id) + if (ierr .ne. 0) then + call shr_sys_abort(subname//' cannot free sender buffers') + endif endif #ifdef MOABDEBUG @@ -1037,6 +1043,9 @@ subroutine component_exch_moab(comp, mbAPPid1, mbAppid2, direction, fields ) outfile = comp%ntype//'_'//trim(dir)//'_'//trim(lnum)//'.h5m'//C_NULL_CHAR wopts = ';PARALLEL=WRITE_PART'//C_NULL_CHAR ! ierr = iMOAB_WriteMesh(mbAPPid2, trim(outfile), trim(wopts)) + if (ierr .ne. 0) then + call shr_sys_abort(subname//' cannot write file '// outfile) + endif endif #endif diff --git a/driver-moab/main/prep_atm_mod.F90 b/driver-moab/main/prep_atm_mod.F90 index e83f0a5371e7..c869861c8227 100644 --- a/driver-moab/main/prep_atm_mod.F90 +++ b/driver-moab/main/prep_atm_mod.F90 @@ -30,6 +30,8 @@ module prep_atm_mod use seq_comm_mct, only : mblxid ! iMOAB id for land migrated to coupler pes !! old name : mlnxid use seq_comm_mct, only : mbintxla ! iMOAB id for intx mesh between land and atmosphere use seq_comm_mct, only : seq_comm_getinfo => seq_comm_setptrs + use seq_comm_mct, only : num_moab_exports + use dimensions_mod, only : np ! for atmosphere use iso_c_binding @@ -92,8 +94,6 @@ module prep_atm_mod ! other module variables integer :: mpicom_CPLID ! MPI cpl communicator logical :: iamroot_CPLID ! .true. => CPLID masterproc - save - integer :: num_proj ! to index the coupler projection calls !================================================================================================ @@ -222,7 +222,6 @@ subroutine prep_atm_init(infodata, ocn_c2_atm, ice_c2_atm, lnd_c2_atm, iac_c2_at call shr_sys_abort(subname//' ERROR in writing intx file ') endif endif - num_proj = 0 ! to index projection files on coupler pes #endif end if end if @@ -379,7 +378,6 @@ subroutine prep_atm_migrate_moab(infodata) context_id = ocn(1)%cplcompid wgtIdef = 'scalar'//C_NULL_CHAR - num_proj = num_proj + 1 if (atm_present .and. ocn_present .and. ocn_prognostic) then if (atm_pg_active ) then ! use data from AtmPhys mesh, but mesh from pg @@ -426,7 +424,7 @@ subroutine prep_atm_migrate_moab(infodata) #ifdef MOABDEBUG ! we can also write the ocean mesh to file, just to see the projectd tag ! write out the mesh file to disk - write(lnum,"(I0.2)")num_proj + write(lnum,"(I0.2)")num_moab_exports outfile = 'ocnCplProj'//trim(lnum)//'.h5m'//C_NULL_CHAR wopts = ';PARALLEL=WRITE_PART'//C_NULL_CHAR ! ierr = iMOAB_WriteMesh(mboxid, trim(outfile), trim(wopts)) @@ -486,7 +484,7 @@ subroutine prep_atm_migrate_moab(infodata) #ifdef MOABDEBUG ! we can also write the ocean mesh to file, just to see the projectd tag ! write out the mesh file to disk - write(lnum,"(I0.2)")num_proj + write(lnum,"(I0.2)")num_moab_exports outfile = 'ocnCplProj'//trim(lnum)//'.h5m'//C_NULL_CHAR wopts = ';PARALLEL=WRITE_PART'//C_NULL_CHAR ! ierr = iMOAB_WriteMesh(mboxid, trim(outfile), trim(wopts)) @@ -556,7 +554,7 @@ subroutine prep_atm_migrate_moab(infodata) #ifdef MOABDEBUG ! we can also write the lnd mesh to file, just to see the projectd tag ! write out the mesh file to disk - write(lnum,"(I0.2)")num_proj + write(lnum,"(I0.2)")num_moab_exports outfile = 'lndCplProj'//trim(lnum)//'.h5m'//C_NULL_CHAR wopts = ';PARALLEL=WRITE_PART'//C_NULL_CHAR ! ierr = iMOAB_WriteMesh(mblxid, trim(outfile), trim(wopts)) @@ -614,7 +612,7 @@ subroutine prep_atm_migrate_moab(infodata) #ifdef MOABDEBUG ! we can also write the lnd mesh to file, just to see the projectd tag ! write out the mesh file to disk - write(lnum,"(I0.2)")num_proj + write(lnum,"(I0.2)")num_moab_exports outfile = 'lndCplProj'//trim(lnum)//'.h5m'//C_NULL_CHAR wopts = ';PARALLEL=WRITE_PART'//C_NULL_CHAR ! ierr = iMOAB_WriteMesh(mblxid, trim(outfile), trim(wopts)) @@ -669,7 +667,7 @@ subroutine prep_atm_migrate_moab(infodata) #ifdef MOABDEBUG ! we can also write the land mesh to file, just to see the projectd tag ! write out the mesh file to disk - write(lnum,"(I0.2)")num_proj + write(lnum,"(I0.2)")num_moab_exports outfile = 'lndCplProj'//trim(lnum)//'.h5m'//C_NULL_CHAR wopts = ';PARALLEL=WRITE_PART'//C_NULL_CHAR ! ierr = iMOAB_WriteMesh(mblxid, trim(outfile), trim(wopts)) diff --git a/driver-moab/main/prep_ocn_mod.F90 b/driver-moab/main/prep_ocn_mod.F90 index ec497b3ae3a6..bbebe721bed2 100644 --- a/driver-moab/main/prep_ocn_mod.F90 +++ b/driver-moab/main/prep_ocn_mod.F90 @@ -28,6 +28,7 @@ module prep_ocn_mod use seq_comm_mct, only : mpsiid ! iMOAB id for sea-ice, mpas model use seq_comm_mct, only : CPLALLICEID use seq_comm_mct, only : seq_comm_iamin + use seq_comm_mct, only : num_moab_exports use seq_comm_mct, only : seq_comm_getinfo => seq_comm_setptrs @@ -143,9 +144,6 @@ module prep_ocn_mod !================================================================================================ -#ifdef MOABDEBUG - integer :: number_proj ! it is a static variable, used to count the number of projections -#endif real (kind=r8) , allocatable, private :: fractions_om (:,:) ! will retrieve the fractions from ocean, and use them ! they were init with ! character(*),parameter :: fraclist_o = 'afrac:ifrac:ofrac:ifrad:ofrad' in moab, on the fractions @@ -491,9 +489,6 @@ subroutine prep_ocn_init(infodata, atm_c2_ocn, atm_c2_ice, ice_c2_ocn, rof_c2_oc call shr_sys_flush(logunit) end if -#ifdef MOABDEBUG - number_proj = 0 ! it is a static variable, used to count the number of projections -#endif end subroutine prep_ocn_init !================================================================================================ @@ -2185,8 +2180,7 @@ subroutine prep_ocn_calc_i2x_ox_moab() #ifdef MOABDEBUG if (mboxid .ge. 0 ) then ! we are on coupler pes, for sure - number_proj = number_proj +1 ! because it was commented out above - write(lnum,"(I0.2)") number_proj + write(lnum,"(I0.2)")num_moab_exports outfile = 'OcnCplAftIce'//trim(lnum)//'.h5m'//C_NULL_CHAR wopts = ';PARALLEL=WRITE_PART'//C_NULL_CHAR ! ierr = iMOAB_WriteMesh(mboxid, trim(outfile), trim(wopts)) From 6ffbaadfde78aae415758efb3815cf21519a7a4d Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Mon, 10 Oct 2022 22:20:20 -0500 Subject: [PATCH 191/467] numbering moab debug --- components/mpas-seaice/driver/ice_comp_mct.F | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) diff --git a/components/mpas-seaice/driver/ice_comp_mct.F b/components/mpas-seaice/driver/ice_comp_mct.F index 56b09a3ff6d2..c1b15d124ced 100644 --- a/components/mpas-seaice/driver/ice_comp_mct.F +++ b/components/mpas-seaice/driver/ice_comp_mct.F @@ -2902,6 +2902,7 @@ subroutine ice_export_moab() ! This routine calls the routines necessary to send MPASSI fields to MOAB coupler ! use iMOAB, only : iMOAB_SetDoubleTagStorage, iMOAB_WriteMesh + use seq_comm_mct, only: num_moab_exports !EOP !BOC !----------------------------------------------------------------------- @@ -3005,7 +3006,6 @@ subroutine ice_export_moab() oceanParticulateIronFlux, & oceanDissolvedIronFlux - integer, save :: num_mb_exports = 0 ! used for debugging integer :: ent_type, ierr character(len=32), parameter :: sub = 'ice_export_moab' @@ -3242,8 +3242,7 @@ subroutine ice_export_moab() !#ifdef MOABDEBUG - num_mb_exports = num_mb_exports +1 - write(lnum,"(I0.2)")num_mb_exports + write(lnum,"(I0.2)")num_moab_exports outfile = 'ice_export_'//trim(lnum)//'.h5m'//C_NULL_CHAR wopts = 'PARALLEL=WRITE_PART'//C_NULL_CHAR ierr = iMOAB_WriteMesh(MPSIID, outfile, wopts) From 4c44e189559bdd5627f4fcd80b69548456e4c2ad Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Tue, 18 Oct 2022 13:19:20 -0500 Subject: [PATCH 192/467] add more debugging for comparing with mct merge track Foxx_swnet field on mct data, to compare with moab merge results use ocean instance on coupler, with mct data --- driver-moab/main/cplcomp_exchange_mod.F90 | 9 ++++ driver-moab/main/prep_ocn_mod.F90 | 59 +++++++++++++++++++++-- driver-moab/main/seq_flux_mct.F90 | 8 +-- 3 files changed, 69 insertions(+), 7 deletions(-) diff --git a/driver-moab/main/cplcomp_exchange_mod.F90 b/driver-moab/main/cplcomp_exchange_mod.F90 index faed8495d669..a5ce4fb15351 100644 --- a/driver-moab/main/cplcomp_exchange_mod.F90 +++ b/driver-moab/main/cplcomp_exchange_mod.F90 @@ -1276,6 +1276,15 @@ subroutine cplcomp_moab_Init(comp) write(logunit,*) subname,' error in defining tags x2o on coupler' call shr_sys_abort(subname//' ERROR in defining tags x2o on coupler ') endif +#ifdef MOABDEBUG + tagname='mct_Foxx_swnet'//C_NULL_CHAR + ierr = iMOAB_DefineTagStorage(mboxid, tagname, tagtype, numco, tagindex ) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in defining tags mct_Foxx_swnet on coupler' + call shr_sys_abort(subname//' ERROR in defining tags mct_Foxx_swnet on coupler ') + endif +#endif + #ifdef MOABDEBUG ! debug test outfile = 'recMeshOcn.h5m'//C_NULL_CHAR diff --git a/driver-moab/main/prep_ocn_mod.F90 b/driver-moab/main/prep_ocn_mod.F90 index bbebe721bed2..5d3ed20ea738 100644 --- a/driver-moab/main/prep_ocn_mod.F90 +++ b/driver-moab/main/prep_ocn_mod.F90 @@ -632,7 +632,8 @@ end subroutine prep_ocn_mrg subroutine prep_ocn_mrg_moab(infodata, xao_ox) - use iMOAB , only : iMOAB_GetMeshInfo, iMOAB_GetDoubleTagStorage, iMOAB_SetDoubleTagStorage + use iMOAB , only : iMOAB_GetMeshInfo, iMOAB_GetDoubleTagStorage, & + iMOAB_SetDoubleTagStorage, iMOAB_WriteMesh use seq_comm_mct , only : mboxid, mbofxid ! ocean and atm-ocean flux instances !--------------------------------------------------------------- ! Description @@ -759,6 +760,10 @@ subroutine prep_ocn_mrg_moab(infodata, xao_ox) integer nvert(3), nvise(3), nbl(3), nsurf(3), nvisBC(3) ! for moab info character(CXX) ::tagname integer :: ent_type, ierr +#ifdef MOABDEBUG + character*32 :: outfile, wopts, lnum +#endif + ! for moab, local allocatable arrays for each field, size of local ocean mesh ! these are the fields that are merged, in general ! some fields are already on the ocean instance (coming from projection) @@ -1383,7 +1388,14 @@ subroutine prep_ocn_mrg_moab(infodata, xao_ox) if (ierr .ne. 0) then call shr_sys_abort(subname//' error in setting x2o_om array ') endif - +#ifdef MOABDEBUG + if (mboxid .ge. 0 ) then ! we are on coupler pes, for sure + write(lnum,"(I0.2)")num_moab_exports + outfile = 'OcnCplAftMm'//trim(lnum)//'.h5m'//C_NULL_CHAR + wopts = ';PARALLEL=WRITE_PART'//C_NULL_CHAR ! + ierr = iMOAB_WriteMesh(mboxid, trim(outfile), trim(wopts)) + endif +#endif if (first_time) then if (iamroot) then write(logunit,'(A)') subname//' Summary:' @@ -1411,7 +1423,10 @@ subroutine prep_ocn_merge( flux_epbalfact, a2x_o, i2x_o, r2x_o, w2x_o, g2x_o, xa fractions_o, x2o_o ) use prep_glc_mod, only: prep_glc_calculate_subshelf_boundary_fluxes - +#ifdef MOABDEBUG + use iMOAB, only : iMOAB_SetDoubleTagStorageWithGid, iMOAB_WriteMesh + use component_type_mod, only : component_get_dom_cx +#endif !----------------------------------------------------------------------- ! ! Arguments @@ -1521,6 +1536,14 @@ subroutine prep_ocn_merge( flux_epbalfact, a2x_o, i2x_o, r2x_o, w2x_o, g2x_o, xa type(mct_aVect_sharedindices),save :: g2x_sharedindices logical, save :: first_time = .true. character(*),parameter :: subName = '(prep_ocn_merge) ' +#ifdef MOABDEBUG + real(r8) , allocatable :: values(:) + type(mct_ggrid), pointer :: dom + integer , allocatable :: GlobalIds(:) ! used for setting values associated with ids + character(CXX) ::tagname + integer :: kgg, ent_type, ierr + character*32 :: outfile, wopts, lnum +#endif !----------------------------------------------------------------------- call seq_comm_setptrs(CPLID, iamroot=iamroot) @@ -2063,6 +2086,36 @@ subroutine prep_ocn_merge( flux_epbalfact, a2x_o, i2x_o, r2x_o, w2x_o, g2x_o, xa endif first_time = .false. +#ifdef MOABDEBUG + ! index_x2o_Foxx_swnet + ! DEBUGGING + allocate(values(lsize)) + dom => component_get_dom_cx(ocn(1)) + kgg = mct_aVect_indexIA(dom%data ,"GlobGridNum" ,perrWith=subName) + + allocate(GlobalIds(lsize)) + GlobalIds = dom%data%iAttr(kgg,:) + tagname = 'mct_Foxx_swnet'//C_NULL_CHAR + !arrSize = nloc * listSize + ent_type = 1 ! cells + values = x2o_o%rAttr(index_x2o_Foxx_swnet, :) + ierr = iMOAB_SetDoubleTagStorageWithGid ( mboxid, tagname, lsize , ent_type, values, GlobalIds ) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in setting debug tag ' + call shr_sys_abort(subname//' ERROR in setting debug tag') + endif + deallocate(values) + deallocate(GlobalIds) + + if (mboxid .ge. 0 ) then ! we are on coupler pes, for sure + write(lnum,"(I0.2)")num_moab_exports + outfile = 'OcnCplAft_mrg'//trim(lnum)//'.h5m'//C_NULL_CHAR + wopts = ';PARALLEL=WRITE_PART'//C_NULL_CHAR ! + ierr = iMOAB_WriteMesh(mboxid, trim(outfile), trim(wopts)) + endif +#endif + + end subroutine prep_ocn_merge diff --git a/driver-moab/main/seq_flux_mct.F90 b/driver-moab/main/seq_flux_mct.F90 index 2baa95c39d39..953b025e7ae1 100644 --- a/driver-moab/main/seq_flux_mct.F90 +++ b/driver-moab/main/seq_flux_mct.F90 @@ -1641,11 +1641,11 @@ subroutine seq_flux_atmocn_moab(comp, xao) allocate(GlobalIds(nloc)) GlobalIds = dom%data%iAttr(kgg,:) - do i = 1, nloc - do j = 1, listSize - local_xao_mct(i, j) = xao%rAttr(j, i) - enddo + + do j = 1, listSize + local_xao_mct(:, j) = xao%rAttr(j, :) enddo + tagname = trim(seq_flds_xao_fields)//C_NULL_CHAR arrSize = nloc * listSize ent_type = 1 ! cells From 45be982ca568650b3ce31e015b058d6216f0f152 Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Wed, 19 Oct 2022 11:52:45 -0500 Subject: [PATCH 193/467] add method to compare mct av field with moab tag values --- driver-moab/main/component_type_mod.F90 | 91 ++++++++++++++++++++++++- driver-moab/main/prep_ocn_mod.F90 | 12 +++- 2 files changed, 101 insertions(+), 2 deletions(-) diff --git a/driver-moab/main/component_type_mod.F90 b/driver-moab/main/component_type_mod.F90 index e79e42a53aeb..6b0836c4a98a 100644 --- a/driver-moab/main/component_type_mod.F90 +++ b/driver-moab/main/component_type_mod.F90 @@ -51,7 +51,9 @@ module component_type_mod ! this is to replicate mct grid of a cx public :: expose_mct_grid_moab - +#ifdef MOABDEBUG + public :: compare_mct_av_moab_tag +#endif !-------------------------------------------------------------------------- ! Public data @@ -403,5 +405,92 @@ subroutine expose_mct_grid_moab (comp, imoabAPI) end subroutine expose_mct_grid_moab +#ifdef MOABDEBUG + ! assumes everything is on coupler pes here, to make sense + subroutine compare_mct_av_moab_tag(comp, attrVect, mct_field, appId, tagname, ent_type, difference) + + use shr_kind_mod, only: CXX => shr_kind_CXX + use iMOAB, only : iMOAB_DefineTagStorage, iMOAB_GetDoubleTagStorage, & + iMOAB_SetDoubleTagStorageWithGid, iMOAB_GetMeshInfo + use iso_c_binding + + type(component_type), intent(in) :: comp + integer , intent(in) :: appId, ent_type + type(mct_aVect) , intent(in), pointer :: attrVect + character(*) , intent(in) :: mct_field + character(*) , intent(in) :: tagname + + real(r8) , intent(out) :: difference + type(mct_ggrid), pointer :: dom + integer :: kgg, mbSize, nloc, index_avfield + + ! moab + integer :: tagtype, numco, tagindex, ierr + character(CXX) :: tagname_mct + integer , allocatable :: GlobalIds(:) ! used for setting values associated with ids + + real(r8) , allocatable :: values(:), mct_values(:) + integer nvert(3), nvise(3), nbl(3), nsurf(3), nvisBC(3) + + character(*),parameter :: subName = '(compare_mct_av_moab_tag) ' + + nloc = mct_avect_lsize(attrVect) + allocate(GlobalIds(nloc)) + allocate(values(nloc)) + dom => component_get_dom_cx(comp) + kgg = mct_aVect_indexIA(dom%data ,"GlobGridNum" ,perrWith=subName) + GlobalIds = dom%data%iAttr(kgg,:) + + index_avfield = mct_aVect_indexRA(attrVect,trim(mct_field)) + values(:) = attrVect%rAttr(index_avfield,:) + + tagname_mct = 'mct_'//trim(tagname)//C_NULL_CHAR + + + tagtype = 1 ! dense, double + numco = 1 + ierr = iMOAB_DefineTagStorage(appId, tagname_mct, tagtype, numco, tagindex ) + if (ierr > 0 ) & + call shr_sys_abort(subname//'Error: fail to define new tag for mct') + + ierr = iMOAB_SetDoubleTagStorageWithGid ( appId, tagname_mct, nloc , ent_type, values, GlobalIds ) + if (ierr > 0 ) & + call shr_sys_abort(subname//'Error: fail to set new tags') + + deallocate(values) + ! now start comparing tags after set + ierr = iMOAB_GetMeshInfo ( appId, nvert, nvise, nbl, nsurf, nvisBC ); + if (ierr > 0 ) & + call shr_sys_abort(subname//'Error: fail to get mesh info') + if (ent_type .eq. 0) then + mbSize = nvert(1) + else if (ent_type .eq. 1) then + mbSize = nvise(1) + endif + allocate(values(mbSize)) + allocate(mct_values(mbSize)) + + ierr = iMOAB_GetDoubleTagStorage ( appId, tagname_mct, mbSize , ent_type, mct_values) + if (ierr > 0 ) & + call shr_sys_abort(subname//'Error: fail to get mct tag values') + ierr = iMOAB_GetDoubleTagStorage ( appId, tagname, mbSize , ent_type, values) + if (ierr > 0 ) & + call shr_sys_abort(subname//'Error: fail to get moab tag values') + + values = mct_values - values + + difference = dot_product(values, values) + if (difference.gt.1.e-10) then + print * , 'difference = ', difference + call shr_sys_abort(subname//'differences between mct and moab values') + endif + deallocate(GlobalIds) + deallocate(values) + deallocate(mct_values) + + + end subroutine compare_mct_av_moab_tag + +#endif end module component_type_mod diff --git a/driver-moab/main/prep_ocn_mod.F90 b/driver-moab/main/prep_ocn_mod.F90 index 5d3ed20ea738..26c72de5baea 100644 --- a/driver-moab/main/prep_ocn_mod.F90 +++ b/driver-moab/main/prep_ocn_mod.F90 @@ -40,6 +40,9 @@ module prep_ocn_mod use mct_mod use perf_mod use component_type_mod, only: component_get_x2c_cx, component_get_c2x_cx +#ifdef MOABDEBUG + use component_type_mod, only: compare_mct_av_moab_tag +#endif use component_type_mod, only: ocn, atm, ice, rof, wav, glc use iso_c_binding @@ -758,10 +761,11 @@ subroutine prep_ocn_mrg_moab(infodata, xao_ox) logical, save :: first_time = .true. integer nvert(3), nvise(3), nbl(3), nsurf(3), nvisBC(3) ! for moab info - character(CXX) ::tagname + character(CXX) ::tagname, mct_field integer :: ent_type, ierr #ifdef MOABDEBUG character*32 :: outfile, wopts, lnum + real(r8) :: difference #endif ! for moab, local allocatable arrays for each field, size of local ocean mesh @@ -1389,6 +1393,12 @@ subroutine prep_ocn_mrg_moab(infodata, xao_ox) call shr_sys_abort(subname//' error in setting x2o_om array ') endif #ifdef MOABDEBUG + !compare_mct_av_moab_tag(comp, attrVect, field, imoabApp, tag_name, ent_type, difference) + mct_field = 'Foxx_swnet' + tagname= 'Foxx_swnet'//C_NULL_CHAR + x2o_o => component_get_x2c_cx(ocn(1)) + call compare_mct_av_moab_tag(ocn(1), x2o_o, mct_field, mboxid, tagname, ent_type, difference) + if (mboxid .ge. 0 ) then ! we are on coupler pes, for sure write(lnum,"(I0.2)")num_moab_exports outfile = 'OcnCplAftMm'//trim(lnum)//'.h5m'//C_NULL_CHAR From 41546af65a8c4ffd0575e48bd22d6ad947249d33 Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Wed, 19 Oct 2022 13:50:55 -0500 Subject: [PATCH 194/467] do not fail if differences are big let it run for the time being until I figure out what is wrong --- driver-moab/main/component_type_mod.F90 | 4 ++-- driver-moab/main/prep_ocn_mod.F90 | 2 +- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/driver-moab/main/component_type_mod.F90 b/driver-moab/main/component_type_mod.F90 index 6b0836c4a98a..bea19d114a2f 100644 --- a/driver-moab/main/component_type_mod.F90 +++ b/driver-moab/main/component_type_mod.F90 @@ -482,8 +482,8 @@ subroutine compare_mct_av_moab_tag(comp, attrVect, mct_field, appId, tagname, en difference = dot_product(values, values) if (difference.gt.1.e-10) then - print * , 'difference = ', difference - call shr_sys_abort(subname//'differences between mct and moab values') + print * , 'difference on tag ', tagname, ' = ', difference + !call shr_sys_abort(subname//'differences between mct and moab values') endif deallocate(GlobalIds) deallocate(values) diff --git a/driver-moab/main/prep_ocn_mod.F90 b/driver-moab/main/prep_ocn_mod.F90 index 26c72de5baea..2a1a7cace2a8 100644 --- a/driver-moab/main/prep_ocn_mod.F90 +++ b/driver-moab/main/prep_ocn_mod.F90 @@ -1384,7 +1384,7 @@ subroutine prep_ocn_mrg_moab(infodata, xao_ox) end do end do -! after we aer done, set x2o_om to the mboxid +! after we are done, set x2o_om to the mboxid tagname = trim(seq_flds_x2o_fields)//C_NULL_CHAR arrsize = noflds * lsize From 6a818e6ba69b484e323b101faf2b95fc37db61cf Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Wed, 19 Oct 2022 20:32:59 -0500 Subject: [PATCH 195/467] more checks, for fractions write only on root , always, the L2 norm of the difference seems like ifrad and ofrad are wrong :( --- driver-moab/main/cime_comp_mod.F90 | 31 +++++++++++++++++++++++++ driver-moab/main/component_type_mod.F90 | 18 +++++++++++--- driver-moab/main/prep_ocn_mod.F90 | 7 ------ 3 files changed, 46 insertions(+), 10 deletions(-) diff --git a/driver-moab/main/cime_comp_mod.F90 b/driver-moab/main/cime_comp_mod.F90 index 5111d3257b92..3af666412766 100644 --- a/driver-moab/main/cime_comp_mod.F90 +++ b/driver-moab/main/cime_comp_mod.F90 @@ -4272,7 +4272,17 @@ end subroutine cime_run_iac_recv_post !---------------------------------------------------------------------------------- subroutine cime_run_atmocn_setup(hashint) +#ifdef MOABDEBUG + use component_type_mod, only: compare_mct_av_moab_tag + use seq_comm_mct , only : mboxid + use iso_c_binding +#endif integer, intent(inout) :: hashint(:) +#ifdef MOABDEBUG + real(r8) :: difference + character(20) :: mct_field, tagname + integer :: ent_type +#endif if (iamin_CPLID) then call cime_comp_barriers(mpicom=mpicom_CPLID, timer='CPL:ATMOCNP_BARRIER') @@ -4315,6 +4325,27 @@ subroutine cime_run_atmocn_setup(hashint) xao_ox => prep_aoflux_get_xao_ox() call prep_ocn_mrg(infodata, fractions_ox, xao_ox=xao_ox, timer_mrg='CPL:atmocnp_mrgx2o') +#ifdef MOABDEBUG + ! before calling moab merge, check that the fractions are the same + ! compare_mct_av_moab_tag(comp, attrVect, mct_field, appId, tagname, ent_type, difference) + ! fraclist_o = 'afrac:ifrac:ofrac:ifrad:ofrad' + ent_type = 1 + mct_field = 'afrac' + tagname = 'afrac'//C_NULL_CHAR + call compare_mct_av_moab_tag(ocn(1), fractions_ox(1), mct_field, mboxid, tagname, ent_type, difference) + mct_field = 'ifrac' + tagname = 'ifrac'//C_NULL_CHAR + call compare_mct_av_moab_tag(ocn(1), fractions_ox(1), mct_field, mboxid, tagname, ent_type, difference) + mct_field = 'ofrac' + tagname = 'ofrac'//C_NULL_CHAR + call compare_mct_av_moab_tag(ocn(1), fractions_ox(1), mct_field, mboxid, tagname, ent_type, difference) + mct_field = 'ifrad' + tagname = 'ifrad'//C_NULL_CHAR + call compare_mct_av_moab_tag(ocn(1), fractions_ox(1), mct_field, mboxid, tagname, ent_type, difference) + mct_field = 'ofrad' + tagname = 'ofrad'//C_NULL_CHAR + call compare_mct_av_moab_tag(ocn(1), fractions_ox(1), mct_field, mboxid, tagname, ent_type, difference) +#endif ! moab version call prep_ocn_mrg_moab(infodata, xao_ox) diff --git a/driver-moab/main/component_type_mod.F90 b/driver-moab/main/component_type_mod.F90 index bea19d114a2f..3a66b52bf3bf 100644 --- a/driver-moab/main/component_type_mod.F90 +++ b/driver-moab/main/component_type_mod.F90 @@ -409,11 +409,13 @@ end subroutine expose_mct_grid_moab ! assumes everything is on coupler pes here, to make sense subroutine compare_mct_av_moab_tag(comp, attrVect, mct_field, appId, tagname, ent_type, difference) + use shr_mpi_mod, only: shr_mpi_sum use shr_kind_mod, only: CXX => shr_kind_CXX + use seq_comm_mct , only : CPLID, seq_comm_iamroot use iMOAB, only : iMOAB_DefineTagStorage, iMOAB_GetDoubleTagStorage, & iMOAB_SetDoubleTagStorageWithGid, iMOAB_GetMeshInfo + use iso_c_binding - type(component_type), intent(in) :: comp integer , intent(in) :: appId, ent_type @@ -422,6 +424,8 @@ subroutine compare_mct_av_moab_tag(comp, attrVect, mct_field, appId, tagname, en character(*) , intent(in) :: tagname real(r8) , intent(out) :: difference + + real(r8) :: differenceg ! global, reduced diff type(mct_ggrid), pointer :: dom integer :: kgg, mbSize, nloc, index_avfield @@ -432,9 +436,14 @@ subroutine compare_mct_av_moab_tag(comp, attrVect, mct_field, appId, tagname, en real(r8) , allocatable :: values(:), mct_values(:) integer nvert(3), nvise(3), nbl(3), nsurf(3), nvisBC(3) + integer :: mpicom + logical :: iamroot + character(*),parameter :: subName = '(compare_mct_av_moab_tag) ' + mpicom = comp%mpicom_cplcompid ! we are on the coupler side + nloc = mct_avect_lsize(attrVect) allocate(GlobalIds(nloc)) allocate(values(nloc)) @@ -481,8 +490,11 @@ subroutine compare_mct_av_moab_tag(comp, attrVect, mct_field, appId, tagname, en values = mct_values - values difference = dot_product(values, values) - if (difference.gt.1.e-10) then - print * , 'difference on tag ', tagname, ' = ', difference + call shr_mpi_sum(difference,differenceg,mpicom,subname) + difference = sqrt(differenceg) + iamroot = seq_comm_iamroot(CPLID) + if ( iamroot ) then + print * , trim(comp%ntype), ' comp, 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/prep_ocn_mod.F90 b/driver-moab/main/prep_ocn_mod.F90 index 2a1a7cace2a8..84f2c9feeb9a 100644 --- a/driver-moab/main/prep_ocn_mod.F90 +++ b/driver-moab/main/prep_ocn_mod.F90 @@ -813,12 +813,6 @@ subroutine prep_ocn_mrg_moab(infodata, xao_ox) !nwflds = mct_aVect_nRattr(w2x_o) nxflds = mct_aVect_nRattr(xao_o) - - ! x2o_o => x2o_ox(1) - ! - - - !ngflds = mct_aVect_nRattr(g2x_o) allocate(x2o_om (lsize, noflds)) allocate(a2x_om (lsize, naflds)) @@ -1169,7 +1163,6 @@ subroutine prep_ocn_mrg_moab(infodata, xao_ox) if (ierr .ne. 0) then call shr_sys_abort(subname//' error in getting fractions_om from ocean instance ') endif - ! fill the r2x_om, etc double array fields noflds tagname = trim(seq_flds_x2o_fields)//C_NULL_CHAR arrsize = noflds * lsize From 52084397f8e46d3bf2120c13947a414459d3cfff Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Thu, 20 Oct 2022 17:15:27 -0500 Subject: [PATCH 196/467] more fractions_o debug also correct name of subroutine in prep_aoflux_mod subname prep_aoflux_calc_xao_ax --- driver-moab/main/cime_comp_mod.F90 | 54 ++++++++++++++++++++++++---- driver-moab/main/prep_aoflux_mod.F90 | 2 +- 2 files changed, 48 insertions(+), 8 deletions(-) diff --git a/driver-moab/main/cime_comp_mod.F90 b/driver-moab/main/cime_comp_mod.F90 index 3af666412766..03e2a1e79882 100644 --- a/driver-moab/main/cime_comp_mod.F90 +++ b/driver-moab/main/cime_comp_mod.F90 @@ -200,6 +200,13 @@ module cime_comp_mod use component_type_mod , only: expose_mct_grid_moab #endif +#ifdef MOABDEBUG + use component_type_mod, only: compare_mct_av_moab_tag + use seq_comm_mct , only : mboxid + use iso_c_binding +#endif + + implicit none private @@ -1388,6 +1395,13 @@ end subroutine cime_pre_init2 subroutine cime_init() +#ifdef MOABDEBUG + real(r8) :: difference + character(20) :: mct_field, tagname + integer :: ent_type +#endif + + 104 format( A, i10.8, i8) !----------------------------------------------------------------------------- @@ -2151,7 +2165,17 @@ subroutine cime_init() fractions_ax(efi), fractions_ix(efi), fractions_lx(efi), & fractions_ox(efi), fractions_gx(efi), fractions_rx(efi), & fractions_wx(efi), fractions_zx(efi)) - +#ifdef MOABDEBUG + if (mboxid .ge. 0) then + ent_type = 1 ! cells for ocean mesh + mct_field = 'ifrad' + tagname = 'ifrad'//C_NULL_CHAR + call compare_mct_av_moab_tag(ocn(1), fractions_ox(1), mct_field, mboxid, tagname, ent_type, difference) + mct_field = 'ofrad' + tagname = 'ofrad'//C_NULL_CHAR + call compare_mct_av_moab_tag(ocn(1), fractions_ox(1), mct_field, mboxid, tagname, ent_type, difference) + endif +#endif if (iamroot_CPLID) then write(logunit,*) ' ' if (efi == 1) write(logunit,F00) 'Setting fractions' @@ -2159,6 +2183,17 @@ subroutine cime_init() call seq_frac_set(infodata, ice(eii), ocn(ens1), & fractions_ax(efi), fractions_ix(efi), fractions_ox(efi)) +#ifdef MOABDEBUG + if (mboxid .ge. 0) then + ent_type = 1 ! cells for ocean mesh + mct_field = 'ifrad' + tagname = 'ifrad'//C_NULL_CHAR + call compare_mct_av_moab_tag(ocn(1), fractions_ox(1), mct_field, mboxid, tagname, ent_type, difference) + mct_field = 'ofrad' + tagname = 'ofrad'//C_NULL_CHAR + call compare_mct_av_moab_tag(ocn(1), fractions_ox(1), mct_field, mboxid, tagname, ent_type, difference) + endif +#endif enddo if (drv_threading) call seq_comm_setnthreads(nthreads_GLOID) @@ -2193,7 +2228,17 @@ subroutine cime_init() if (trim(aoflux_grid) == 'ocn') then call seq_flux_init_mct(ocn(ens1), fractions_ox(ens1)) - +#ifdef MOABDEBUG + if (mboxid .ge. 0) then + ent_type = 1 ! cells for ocean mesh + mct_field = 'ifrad' + tagname = 'ifrad'//C_NULL_CHAR + call compare_mct_av_moab_tag(ocn(1), fractions_ox(1), mct_field, mboxid, tagname, ent_type, difference) + mct_field = 'ofrad' + tagname = 'ofrad'//C_NULL_CHAR + call compare_mct_av_moab_tag(ocn(1), fractions_ox(1), mct_field, mboxid, tagname, ent_type, difference) + endif +#endif elseif (trim(aoflux_grid) == 'atm') then call seq_flux_init_mct(atm(ens1), fractions_ax(ens1)) @@ -4272,11 +4317,6 @@ end subroutine cime_run_iac_recv_post !---------------------------------------------------------------------------------- subroutine cime_run_atmocn_setup(hashint) -#ifdef MOABDEBUG - use component_type_mod, only: compare_mct_av_moab_tag - use seq_comm_mct , only : mboxid - use iso_c_binding -#endif integer, intent(inout) :: hashint(:) #ifdef MOABDEBUG real(r8) :: difference diff --git a/driver-moab/main/prep_aoflux_mod.F90 b/driver-moab/main/prep_aoflux_mod.F90 index 2e8f65aeae57..c783d451ba23 100644 --- a/driver-moab/main/prep_aoflux_mod.F90 +++ b/driver-moab/main/prep_aoflux_mod.F90 @@ -306,7 +306,7 @@ subroutine prep_aoflux_calc_xao_ox(timer) ! Local Variables type(seq_map), pointer :: mapper_Fa2o integer :: exi - character(*), parameter :: subname = '(prep_aoflux_calc_xao_ax)' + character(*), parameter :: subname = '(prep_aoflux_calc_xao_ox)' character(*), parameter :: F00 = "('"//subname//" : ', 4A )" !--------------------------------------------------------------- From cfa287945fbaac92dfb61e1bf5d3c695c93ff0c1 Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Fri, 21 Oct 2022 17:23:15 -0500 Subject: [PATCH 197/467] set radiation fractions on ocean, too we were setting just the ofrac and ifrac this fixes Foxx_swnet problems after first iteration --- driver-moab/main/cime_comp_mod.F90 | 57 ++-------------------------- driver-moab/main/prep_aoflux_mod.F90 | 4 +- driver-moab/main/seq_frac_mct.F90 | 31 +++++++++++---- 3 files changed, 28 insertions(+), 64 deletions(-) diff --git a/driver-moab/main/cime_comp_mod.F90 b/driver-moab/main/cime_comp_mod.F90 index 03e2a1e79882..d27947900775 100644 --- a/driver-moab/main/cime_comp_mod.F90 +++ b/driver-moab/main/cime_comp_mod.F90 @@ -2165,17 +2165,7 @@ subroutine cime_init() fractions_ax(efi), fractions_ix(efi), fractions_lx(efi), & fractions_ox(efi), fractions_gx(efi), fractions_rx(efi), & fractions_wx(efi), fractions_zx(efi)) -#ifdef MOABDEBUG - if (mboxid .ge. 0) then - ent_type = 1 ! cells for ocean mesh - mct_field = 'ifrad' - tagname = 'ifrad'//C_NULL_CHAR - call compare_mct_av_moab_tag(ocn(1), fractions_ox(1), mct_field, mboxid, tagname, ent_type, difference) - mct_field = 'ofrad' - tagname = 'ofrad'//C_NULL_CHAR - call compare_mct_av_moab_tag(ocn(1), fractions_ox(1), mct_field, mboxid, tagname, ent_type, difference) - endif -#endif + if (iamroot_CPLID) then write(logunit,*) ' ' if (efi == 1) write(logunit,F00) 'Setting fractions' @@ -2183,17 +2173,6 @@ subroutine cime_init() call seq_frac_set(infodata, ice(eii), ocn(ens1), & fractions_ax(efi), fractions_ix(efi), fractions_ox(efi)) -#ifdef MOABDEBUG - if (mboxid .ge. 0) then - ent_type = 1 ! cells for ocean mesh - mct_field = 'ifrad' - tagname = 'ifrad'//C_NULL_CHAR - call compare_mct_av_moab_tag(ocn(1), fractions_ox(1), mct_field, mboxid, tagname, ent_type, difference) - mct_field = 'ofrad' - tagname = 'ofrad'//C_NULL_CHAR - call compare_mct_av_moab_tag(ocn(1), fractions_ox(1), mct_field, mboxid, tagname, ent_type, difference) - endif -#endif enddo if (drv_threading) call seq_comm_setnthreads(nthreads_GLOID) @@ -2228,17 +2207,7 @@ subroutine cime_init() if (trim(aoflux_grid) == 'ocn') then call seq_flux_init_mct(ocn(ens1), fractions_ox(ens1)) -#ifdef MOABDEBUG - if (mboxid .ge. 0) then - ent_type = 1 ! cells for ocean mesh - mct_field = 'ifrad' - tagname = 'ifrad'//C_NULL_CHAR - call compare_mct_av_moab_tag(ocn(1), fractions_ox(1), mct_field, mboxid, tagname, ent_type, difference) - mct_field = 'ofrad' - tagname = 'ofrad'//C_NULL_CHAR - call compare_mct_av_moab_tag(ocn(1), fractions_ox(1), mct_field, mboxid, tagname, ent_type, difference) - endif -#endif + elseif (trim(aoflux_grid) == 'atm') then call seq_flux_init_mct(atm(ens1), fractions_ax(ens1)) @@ -2260,6 +2229,7 @@ subroutine cime_init() xao_ox => prep_aoflux_get_xao_ox() ! array over all instances a2x_ox => prep_ocn_get_a2x_ox() call seq_flux_ocnalb_mct(infodata, ocn(1), a2x_ox(eai), fractions_ox(efi), xao_ox(exi)) + enddo if (drv_threading) call seq_comm_setnthreads(nthreads_GLOID) @@ -4365,27 +4335,6 @@ subroutine cime_run_atmocn_setup(hashint) xao_ox => prep_aoflux_get_xao_ox() call prep_ocn_mrg(infodata, fractions_ox, xao_ox=xao_ox, timer_mrg='CPL:atmocnp_mrgx2o') -#ifdef MOABDEBUG - ! before calling moab merge, check that the fractions are the same - ! compare_mct_av_moab_tag(comp, attrVect, mct_field, appId, tagname, ent_type, difference) - ! fraclist_o = 'afrac:ifrac:ofrac:ifrad:ofrad' - ent_type = 1 - mct_field = 'afrac' - tagname = 'afrac'//C_NULL_CHAR - call compare_mct_av_moab_tag(ocn(1), fractions_ox(1), mct_field, mboxid, tagname, ent_type, difference) - mct_field = 'ifrac' - tagname = 'ifrac'//C_NULL_CHAR - call compare_mct_av_moab_tag(ocn(1), fractions_ox(1), mct_field, mboxid, tagname, ent_type, difference) - mct_field = 'ofrac' - tagname = 'ofrac'//C_NULL_CHAR - call compare_mct_av_moab_tag(ocn(1), fractions_ox(1), mct_field, mboxid, tagname, ent_type, difference) - mct_field = 'ifrad' - tagname = 'ifrad'//C_NULL_CHAR - call compare_mct_av_moab_tag(ocn(1), fractions_ox(1), mct_field, mboxid, tagname, ent_type, difference) - mct_field = 'ofrad' - tagname = 'ofrad'//C_NULL_CHAR - call compare_mct_av_moab_tag(ocn(1), fractions_ox(1), mct_field, mboxid, tagname, ent_type, difference) -#endif ! moab version call prep_ocn_mrg_moab(infodata, xao_ox) diff --git a/driver-moab/main/prep_aoflux_mod.F90 b/driver-moab/main/prep_aoflux_mod.F90 index c783d451ba23..29dbdca37d15 100644 --- a/driver-moab/main/prep_aoflux_mod.F90 +++ b/driver-moab/main/prep_aoflux_mod.F90 @@ -43,6 +43,8 @@ module prep_aoflux_mod public :: prep_aoflux_get_xao_ox public :: prep_aoflux_get_xao_ax + ! these are to expose the artificial arrays created for setting moab tag + ! these are the transpose of the AVs for fluxes; public :: prep_aoflux_get_xao_omct public :: prep_aoflux_get_xao_amct @@ -56,8 +58,6 @@ module prep_aoflux_mod ! allocate xao_omct, but use lsize_o, size of the local mct ocn gsmap (and AVs) real(r8) , private, pointer :: xao_omct(:,:) ! atm-ocn fluxes, ocn grid, mct local sizes - real(r8) , private, pointer :: xao_omoab(:,:) ! atm-ocn fluxes, ocn grid, moab local sizes - real(r8) , private, pointer :: xao_amct(:,:) ! atm-ocn fluxes, atm grid, mct local sizes ! seq_comm_getData variables diff --git a/driver-moab/main/seq_frac_mct.F90 b/driver-moab/main/seq_frac_mct.F90 index 22018e3c4429..560c94f5d833 100644 --- a/driver-moab/main/seq_frac_mct.F90 +++ b/driver-moab/main/seq_frac_mct.F90 @@ -913,7 +913,6 @@ subroutine seq_frac_set(infodata, ice, ocn, fractions_a, fractions_i, fractions_ real(r8), allocatable, save :: tagValues(:) ! used for setting some tags integer , allocatable, save :: GlobalIds(:) ! used for setting values associated with ids - integer nvert(3), nvise(3), nbl(3), nsurf(3), nvisBC(3) !----- formats ----- character(*),parameter :: subName = '(seq_frac_set) ' @@ -938,7 +937,6 @@ subroutine seq_frac_set(infodata, ice, ocn, fractions_a, fractions_i, fractions_ i2x_i => component_get_c2x_cx(ice) dom_o => component_get_dom_cx(ocn) ! - if (ice_present) then call mct_aVect_copy(i2x_i, fractions_i, "Si_ifrac", "ifrac") @@ -965,17 +963,17 @@ subroutine seq_frac_set(infodata, ice, ocn, fractions_a, fractions_i, fractions_ ent_type = 1 ! cells for mpas ocean endif ! something like this: - - tagname = 'ofrac'//C_NULL_CHAR - ! fraclist_o = 'afrac:ifrac:ofrac:ifrad:ofrad' + + tagname = 'ofrac'//C_NULL_CHAR + ! fraclist_o = 'afrac:ifrac:ofrac:ifrad:ofrad' tagValues = fractions_o%rAttr(3,:) ierr = iMOAB_SetDoubleTagStorageWithGid ( mboxid, tagname, lSize , ent_type, tagValues, GlobalIds ) if (ierr .ne. 0) then write(logunit,*) subname,' error in setting ofrac on ocn moab instance ' call shr_sys_abort(subname//' ERROR in setting ofrac on ocn moab instance ') endif - tagname = 'ifrac'//C_NULL_CHAR - ! fraclist_o = 'afrac:ifrac:ofrac:ifrad:ofrad' + tagname = 'ifrac'//C_NULL_CHAR + ! fraclist_o = 'afrac:ifrac:ofrac:ifrad:ofrad' tagValues = fractions_o%rAttr(2,:) ierr = iMOAB_SetDoubleTagStorageWithGid ( mboxid, tagname, lSize , ent_type, tagValues, GlobalIds ) if (ierr .ne. 0) then @@ -983,6 +981,24 @@ subroutine seq_frac_set(infodata, ice, ocn, fractions_a, fractions_i, fractions_ call shr_sys_abort(subname//' ERROR in setting ofrac on ocn moab instance ') endif + ! correct ifrad and ofrad too in this method; remove fraco_rad_moab + tagname = 'ifrad'//C_NULL_CHAR + ! fraclist_o = 'afrac:ifrac:ofrac:ifrad:ofrad' + tagValues = fractions_o%rAttr(4,:) + ierr = iMOAB_SetDoubleTagStorageWithGid ( mboxid, tagname, lSize , ent_type, tagValues, GlobalIds ) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in setting ifrad on ocn moab instance ' + call shr_sys_abort(subname//' ERROR in setting ifrad on ocn moab instance ') + endif + tagname = 'ofrad'//C_NULL_CHAR + ! fraclist_o = 'afrac:ifrac:ofrac:ifrad:ofrad' + tagValues = fractions_o%rAttr(5,:) + ierr = iMOAB_SetDoubleTagStorageWithGid ( mboxid, tagname, lSize , ent_type, tagValues, GlobalIds ) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in setting ofrad on ocn moab instance ' + call shr_sys_abort(subname//' ERROR in setting ofrad on ocn moab instance ') + endif + first_time = .false. endif @@ -1018,7 +1034,6 @@ subroutine seq_frac_set(infodata, ice, ocn, fractions_a, fractions_i, fractions_ end if end subroutine seq_frac_set - !=============================================================================== !BOP =========================================================================== ! From 2daafa4094a09fd61243212dc9744160a863928f Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Mon, 24 Oct 2022 10:32:47 -0500 Subject: [PATCH 198/467] check all fields from x2o --- driver-moab/main/component_type_mod.F90 | 2 +- driver-moab/main/cplcomp_exchange_mod.F90 | 8 ---- driver-moab/main/prep_ocn_mod.F90 | 49 ++++++++--------------- 3 files changed, 17 insertions(+), 42 deletions(-) diff --git a/driver-moab/main/component_type_mod.F90 b/driver-moab/main/component_type_mod.F90 index 3a66b52bf3bf..765ad0215d59 100644 --- a/driver-moab/main/component_type_mod.F90 +++ b/driver-moab/main/component_type_mod.F90 @@ -494,7 +494,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 * , trim(comp%ntype), ' comp, difference on tag ', trim(tagname), ' = ', difference + print * , subname, trim(comp%ntype), ' comp, 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 a5ce4fb15351..3d6b00635862 100644 --- a/driver-moab/main/cplcomp_exchange_mod.F90 +++ b/driver-moab/main/cplcomp_exchange_mod.F90 @@ -1276,14 +1276,6 @@ subroutine cplcomp_moab_Init(comp) write(logunit,*) subname,' error in defining tags x2o on coupler' call shr_sys_abort(subname//' ERROR in defining tags x2o on coupler ') endif -#ifdef MOABDEBUG - tagname='mct_Foxx_swnet'//C_NULL_CHAR - ierr = iMOAB_DefineTagStorage(mboxid, tagname, tagtype, numco, tagindex ) - if (ierr .ne. 0) then - write(logunit,*) subname,' error in defining tags mct_Foxx_swnet on coupler' - call shr_sys_abort(subname//' ERROR in defining tags mct_Foxx_swnet on coupler ') - endif -#endif #ifdef MOABDEBUG ! debug test diff --git a/driver-moab/main/prep_ocn_mod.F90 b/driver-moab/main/prep_ocn_mod.F90 index 84f2c9feeb9a..940d00d95aa1 100644 --- a/driver-moab/main/prep_ocn_mod.F90 +++ b/driver-moab/main/prep_ocn_mod.F90 @@ -766,6 +766,9 @@ subroutine prep_ocn_mrg_moab(infodata, xao_ox) #ifdef MOABDEBUG character*32 :: outfile, wopts, lnum real(r8) :: difference + type(mct_list) :: temp_list + integer :: size_list, index_list + type(mct_string) :: mctOStr ! #endif ! for moab, local allocatable arrays for each field, size of local ocean mesh @@ -1387,10 +1390,20 @@ subroutine prep_ocn_mrg_moab(infodata, xao_ox) endif #ifdef MOABDEBUG !compare_mct_av_moab_tag(comp, attrVect, field, imoabApp, tag_name, ent_type, difference) - mct_field = 'Foxx_swnet' - tagname= 'Foxx_swnet'//C_NULL_CHAR x2o_o => component_get_x2c_cx(ocn(1)) - call compare_mct_av_moab_tag(ocn(1), x2o_o, mct_field, mboxid, tagname, ent_type, difference) + ! loop over all fields in seq_flds_x2o_fields + call mct_list_init(temp_list ,seq_flds_x2o_fields) + size_list=mct_list_nitem (temp_list) + ent_type = 1 ! cell for ocean + print *, num_moab_exports, trim(seq_flds_x2o_fields) + 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 compare_mct_av_moab_tag(ocn(1), x2o_o, mct_field, mboxid, tagname, ent_type, difference) + enddo + call mct_list_clean(temp_list) + if (mboxid .ge. 0 ) then ! we are on coupler pes, for sure write(lnum,"(I0.2)")num_moab_exports @@ -2089,36 +2102,6 @@ subroutine prep_ocn_merge( flux_epbalfact, a2x_o, i2x_o, r2x_o, w2x_o, g2x_o, xa endif first_time = .false. -#ifdef MOABDEBUG - ! index_x2o_Foxx_swnet - ! DEBUGGING - allocate(values(lsize)) - dom => component_get_dom_cx(ocn(1)) - kgg = mct_aVect_indexIA(dom%data ,"GlobGridNum" ,perrWith=subName) - - allocate(GlobalIds(lsize)) - GlobalIds = dom%data%iAttr(kgg,:) - tagname = 'mct_Foxx_swnet'//C_NULL_CHAR - !arrSize = nloc * listSize - ent_type = 1 ! cells - values = x2o_o%rAttr(index_x2o_Foxx_swnet, :) - ierr = iMOAB_SetDoubleTagStorageWithGid ( mboxid, tagname, lsize , ent_type, values, GlobalIds ) - if (ierr .ne. 0) then - write(logunit,*) subname,' error in setting debug tag ' - call shr_sys_abort(subname//' ERROR in setting debug tag') - endif - deallocate(values) - deallocate(GlobalIds) - - if (mboxid .ge. 0 ) then ! we are on coupler pes, for sure - write(lnum,"(I0.2)")num_moab_exports - outfile = 'OcnCplAft_mrg'//trim(lnum)//'.h5m'//C_NULL_CHAR - wopts = ';PARALLEL=WRITE_PART'//C_NULL_CHAR ! - ierr = iMOAB_WriteMesh(mboxid, trim(outfile), trim(wopts)) - endif -#endif - - end subroutine prep_ocn_merge From b627efe00d43ebbee948c72982dd344f6bd17866 Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Wed, 26 Oct 2022 16:35:33 -0500 Subject: [PATCH 199/467] copy *frad during seq_flux_ocnalb_mct this is called at init time, but also during runtime (albedos) --- driver-moab/main/prep_ocn_mod.F90 | 2 +- driver-moab/main/seq_flux_mct.F90 | 35 ++++++++++++++++++++++++++++++- driver-moab/main/seq_frac_mct.F90 | 34 +++++++++++++++--------------- 3 files changed, 52 insertions(+), 19 deletions(-) diff --git a/driver-moab/main/prep_ocn_mod.F90 b/driver-moab/main/prep_ocn_mod.F90 index 940d00d95aa1..ec2cee7e6110 100644 --- a/driver-moab/main/prep_ocn_mod.F90 +++ b/driver-moab/main/prep_ocn_mod.F90 @@ -1395,7 +1395,7 @@ subroutine prep_ocn_mrg_moab(infodata, xao_ox) call mct_list_init(temp_list ,seq_flds_x2o_fields) size_list=mct_list_nitem (temp_list) ent_type = 1 ! cell for ocean - print *, num_moab_exports, trim(seq_flds_x2o_fields) + if (iamroot) print *, num_moab_exports, trim(seq_flds_x2o_fields) do index_list = 1, size_list call mct_list_get(mctOStr,index_list,temp_list) mct_field = mct_string_toChar(mctOStr) diff --git a/driver-moab/main/seq_flux_mct.F90 b/driver-moab/main/seq_flux_mct.F90 index 953b025e7ae1..982d4281fd43 100644 --- a/driver-moab/main/seq_flux_mct.F90 +++ b/driver-moab/main/seq_flux_mct.F90 @@ -11,7 +11,8 @@ module seq_flux_mct use prep_aoflux_mod, only: prep_aoflux_get_xao_omct, prep_aoflux_get_xao_amct - use iMOAB, only : iMOAB_SetDoubleTagStorageWithGid, iMOAB_WriteMesh, iMOAB_SetDoubleTagStorage + use iMOAB, only : iMOAB_SetDoubleTagStorageWithGid, iMOAB_WriteMesh, iMOAB_SetDoubleTagStorage, iMOAB_GetDoubleTagStorage + use iMOAB, only : iMOAB_GetMeshInfo use seq_comm_mct, only : num_moab_exports ! for debugging use mct_mod @@ -125,6 +126,9 @@ module seq_flux_mct real(r8) :: seq_flux_mct_albdir = -1.0_r8 ! albedo, direct real(r8) :: seq_flux_atmocn_minwind ! minimum wind temperature for atmocn flux routines + ! moab + real(r8), allocatable :: tagValues(:) ! used for copying tag values from frac to frad + ! Coupler field indices integer :: index_a2x_Sa_z @@ -789,6 +793,12 @@ subroutine seq_flux_ocnalb_mct( infodata, ocn, a2x_o, fractions_o, xao_o ) integer(in) :: kx,kr ! fractions indices integer(in) :: klat,klon ! field indices logical :: update_alb ! was albedo updated + + integer nvert(3), nvise(3), nbl(3), nsurf(3), nvisBC(3) ! for moab info + character(CXX) ::tagname + integer :: ent_type, ierr + integer , save :: arrSize ! local size for moab tag arrays (number of cells locally) + logical,save :: first_call = .true. ! character(*),parameter :: subName = '(seq_flux_ocnalb_mct) ' @@ -831,6 +841,14 @@ subroutine seq_flux_ocnalb_mct( infodata, ocn, a2x_o, fractions_o, xao_o ) lats(n) = dom_o%data%rAttr(klat,n) lons(n) = dom_o%data%rAttr(klon,n) enddo + + if (mboxid .ge. 0) then + ! allocate a local small array to copy a tag from another + ierr = iMOAB_GetMeshInfo ( mboxid, nvert, nvise, nbl, nsurf, nvisBC ); + arrSize = nvise(1) * 2 ! we have ifrac and ofrac to copy to ifrad, ofrad + allocate(tagValues(arrSize) ) + endif + first_call = .false. endif @@ -927,6 +945,21 @@ subroutine seq_flux_ocnalb_mct( infodata, ocn, a2x_o, fractions_o, xao_o ) kx = mct_aVect_indexRA(fractions_o,"ofrac") kr = mct_aVect_indexRA(fractions_o,"ofrad") fractions_o%rAttr(kr,:) = fractions_o%rAttr(kx,:) + ! copy here fractions ifrad and ofrad to moab tags + tagname = 'ifrac:ofrac'//C_NULL_CHAR + ent_type = 1 ! cells for ocean mesh + ierr = iMOAB_GetDoubleTagStorage( mboxid, tagname, arrSize, ent_type, tagValues) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in getting ifrac, ofrac ' + call shr_sys_abort(subname//' ERROR in getting ifrac, ofrac') + endif + tagname = 'ifrad:ofrad'//C_NULL_CHAR + ierr = iMOAB_SetDoubleTagStorage( mboxid, tagname, arrSize, ent_type, tagValues) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in setting ifrad, ofrad ' + call shr_sys_abort(subname//' ERROR in setting ifrad, ofrad ') + endif + endif end subroutine seq_flux_ocnalb_mct diff --git a/driver-moab/main/seq_frac_mct.F90 b/driver-moab/main/seq_frac_mct.F90 index 560c94f5d833..3904d56f2bd5 100644 --- a/driver-moab/main/seq_frac_mct.F90 +++ b/driver-moab/main/seq_frac_mct.F90 @@ -981,23 +981,23 @@ subroutine seq_frac_set(infodata, ice, ocn, fractions_a, fractions_i, fractions_ call shr_sys_abort(subname//' ERROR in setting ofrac on ocn moab instance ') endif - ! correct ifrad and ofrad too in this method; remove fraco_rad_moab - tagname = 'ifrad'//C_NULL_CHAR - ! fraclist_o = 'afrac:ifrac:ofrac:ifrad:ofrad' - tagValues = fractions_o%rAttr(4,:) - ierr = iMOAB_SetDoubleTagStorageWithGid ( mboxid, tagname, lSize , ent_type, tagValues, GlobalIds ) - if (ierr .ne. 0) then - write(logunit,*) subname,' error in setting ifrad on ocn moab instance ' - call shr_sys_abort(subname//' ERROR in setting ifrad on ocn moab instance ') - endif - tagname = 'ofrad'//C_NULL_CHAR - ! fraclist_o = 'afrac:ifrac:ofrac:ifrad:ofrad' - tagValues = fractions_o%rAttr(5,:) - ierr = iMOAB_SetDoubleTagStorageWithGid ( mboxid, tagname, lSize , ent_type, tagValues, GlobalIds ) - if (ierr .ne. 0) then - write(logunit,*) subname,' error in setting ofrad on ocn moab instance ' - call shr_sys_abort(subname//' ERROR in setting ofrad on ocn moab instance ') - endif + ! ! correct ifrad and ofrad too in this method; remove fraco_rad_moab + ! tagname = 'ifrad'//C_NULL_CHAR + ! ! fraclist_o = 'afrac:ifrac:ofrac:ifrad:ofrad' + ! tagValues = fractions_o%rAttr(4,:) + ! ierr = iMOAB_SetDoubleTagStorageWithGid ( mboxid, tagname, lSize , ent_type, tagValues, GlobalIds ) + ! if (ierr .ne. 0) then + ! write(logunit,*) subname,' error in setting ifrad on ocn moab instance ' + ! call shr_sys_abort(subname//' ERROR in setting ifrad on ocn moab instance ') + ! endif + ! tagname = 'ofrad'//C_NULL_CHAR + ! ! fraclist_o = 'afrac:ifrac:ofrac:ifrad:ofrad' + ! tagValues = fractions_o%rAttr(5,:) + ! ierr = iMOAB_SetDoubleTagStorageWithGid ( mboxid, tagname, lSize , ent_type, tagValues, GlobalIds ) + ! if (ierr .ne. 0) then + ! write(logunit,*) subname,' error in setting ofrad on ocn moab instance ' + ! call shr_sys_abort(subname//' ERROR in setting ofrad on ocn moab instance ') + ! endif first_time = .false. From aa7ae873ea2335263d3a2e26ec26f1c2a693f0b6 Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Thu, 27 Oct 2022 00:20:05 -0500 Subject: [PATCH 200/467] move a2x_om calculation it was part of prep_atm_migrate_moab it should be done now in prep_ocn_calc_a2x_ox_moab which is called about the same time as prep_ocn_calc_a2x_ox (it does also a migrate) still, it does not help the first time step probably it is related to the second init_cc call for atm also call prep_ocn_calc_i2x_ox_moab it still does not help --- driver-moab/main/cime_comp_mod.F90 | 6 + driver-moab/main/prep_atm_mod.F90 | 236 ++++++++++++++--------------- driver-moab/main/prep_ocn_mod.F90 | 181 ++++++++++++++++++++++ 3 files changed, 305 insertions(+), 118 deletions(-) diff --git a/driver-moab/main/cime_comp_mod.F90 b/driver-moab/main/cime_comp_mod.F90 index d27947900775..cf0061f991a2 100644 --- a/driver-moab/main/cime_comp_mod.F90 +++ b/driver-moab/main/cime_comp_mod.F90 @@ -2845,6 +2845,10 @@ subroutine cime_run() if (drv_threading) call seq_comm_setnthreads(nthreads_GLOID) call t_drvstopf ('CPL:OCNPRE1',cplrun=.true.,hashint=hashint(3)) endif + ! is this really needed here ? + if ( atm_c2_ocn) then + call prep_ocn_calc_a2x_ox_moab(timer='CPL:ocnpre1_atm2ocn_moab', infodata=infodata) + endif !---------------------------------------------------------- !| ATM/OCN SETUP (rasm_option1) @@ -4294,6 +4298,7 @@ subroutine cime_run_atmocn_setup(hashint) integer :: ent_type #endif + call prep_ocn_calc_i2x_ox_moab() ! this does projection from ice to ocean on coupler, by simply matching if (iamin_CPLID) then call cime_comp_barriers(mpicom=mpicom_CPLID, timer='CPL:ATMOCNP_BARRIER') call t_drvstartf ('CPL:ATMOCNP',cplrun=.true.,barrier=mpicom_CPLID,hashint=hashint(7)) @@ -4307,6 +4312,7 @@ subroutine cime_run_atmocn_setup(hashint) ! Map to ocn if (ice_c2_ocn) then call prep_ocn_calc_i2x_ox(timer='CPL:atmocnp_ice2ocn') + endif if (wav_c2_ocn) call prep_ocn_calc_w2x_ox(timer='CPL:atmocnp_wav2ocn') if (trim(cpl_seq_option(1:5)) == 'NUOPC') then diff --git a/driver-moab/main/prep_atm_mod.F90 b/driver-moab/main/prep_atm_mod.F90 index c869861c8227..e57c2e12ef96 100644 --- a/driver-moab/main/prep_atm_mod.F90 +++ b/driver-moab/main/prep_atm_mod.F90 @@ -379,125 +379,125 @@ subroutine prep_atm_migrate_moab(infodata) context_id = ocn(1)%cplcompid wgtIdef = 'scalar'//C_NULL_CHAR - if (atm_present .and. ocn_present .and. ocn_prognostic) then - if (atm_pg_active ) then ! use data from AtmPhys mesh, but mesh from pg - ! in this case, we will send from phys grid directly to intx atm ocn context! - tagname=trim(seq_flds_a2x_fields)//C_NULL_CHAR - if (mphaid .ge. 0) then ! send because we are on atm pes, also mphaid >= 0 - context_id = 100*atm(1)%cplcompid + ocn(1)%cplcompid !send to atm/ocn intx ! ~ 618 - ierr = iMOAB_SendElementTag(mphaid, tagName, mpicom_join, context_id) - if (ierr .ne. 0) then - write(logunit,*) subname,' error in sending tag from phys atm to ocn atm intx ' - call shr_sys_abort(subname//' ERROR in sending tag from phys atm to ocn atm intx') - endif - - endif - if (mbintxao .ge. 0 ) then ! we are for sure on coupler pes! - ! context_id = atm(1)%cplcompid == atm_id above (5) - ! we use the same name as spectral case, even thought in pg2 case, the size of tag is 1, not 16 - ! in imoab_apg2_ol_coupler.cpp we use at this stage, receiver, the same name as sender, T_ph - ierr = iMOAB_ReceiveElementTag(mbintxao, tagName, mpicom_join, atm_id) - if (ierr .ne. 0) then - write(logunit,*) subname,' error in receiving tag from phys atm to ocn atm intx ' - call shr_sys_abort(subname//' ERROR in receiving tag from phys atm to ocn atm intx') - endif - - endif - ! we can now free the sender buffers - if (mhpgid .ge. 0) then - ierr = iMOAB_FreeSenderBuffers(mphaid, context_id) - if (ierr .ne. 0) then - write(logunit,*) subname,' error in freeing buffers' - call shr_sys_abort(subname//' ERROR in freeing buffers') - endif - endif - - if (mbintxao .ge. 0 ) then ! we are on coupler pes, for sure - ! we could apply weights; need to use the same weight identifier wgtIdef as when we generated it - ! hard coded now, it should be a runtime option in the future +! if (atm_present .and. ocn_present .and. ocn_prognostic) then +! if (atm_pg_active ) then ! use data from AtmPhys mesh, but mesh from pg +! ! in this case, we will send from phys grid directly to intx atm ocn context! +! tagname=trim(seq_flds_a2x_fields)//C_NULL_CHAR +! if (mphaid .ge. 0) then ! send because we are on atm pes, also mphaid >= 0 +! context_id = 100*atm(1)%cplcompid + ocn(1)%cplcompid !send to atm/ocn intx ! ~ 618 +! ierr = iMOAB_SendElementTag(mphaid, tagName, mpicom_join, context_id) +! if (ierr .ne. 0) then +! write(logunit,*) subname,' error in sending tag from phys atm to ocn atm intx ' +! call shr_sys_abort(subname//' ERROR in sending tag from phys atm to ocn atm intx') +! endif + +! endif +! if (mbintxao .ge. 0 ) then ! we are for sure on coupler pes! +! ! context_id = atm(1)%cplcompid == atm_id above (5) +! ! we use the same name as spectral case, even thought in pg2 case, the size of tag is 1, not 16 +! ! in imoab_apg2_ol_coupler.cpp we use at this stage, receiver, the same name as sender, T_ph +! ierr = iMOAB_ReceiveElementTag(mbintxao, tagName, mpicom_join, atm_id) +! if (ierr .ne. 0) then +! write(logunit,*) subname,' error in receiving tag from phys atm to ocn atm intx ' +! call shr_sys_abort(subname//' ERROR in receiving tag from phys atm to ocn atm intx') +! endif + +! endif +! ! we can now free the sender buffers +! if (mhpgid .ge. 0) then +! ierr = iMOAB_FreeSenderBuffers(mphaid, context_id) +! if (ierr .ne. 0) then +! write(logunit,*) subname,' error in freeing buffers' +! call shr_sys_abort(subname//' ERROR in freeing buffers') +! endif +! endif + +! if (mbintxao .ge. 0 ) then ! we are on coupler pes, for sure +! ! we could apply weights; need to use the same weight identifier wgtIdef as when we generated it +! ! hard coded now, it should be a runtime option in the future - ierr = iMOAB_ApplyScalarProjectionWeights ( mbintxao, wgtIdef, tagName, tagName) - if (ierr .ne. 0) then - write(logunit,*) subname,' error in applying weights ' - call shr_sys_abort(subname//' ERROR in applying weights') - endif -#ifdef MOABDEBUG - ! we can also write the ocean mesh to file, just to see the projectd tag - ! write out the mesh file to disk - write(lnum,"(I0.2)")num_moab_exports - outfile = 'ocnCplProj'//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 - write(logunit,*) subname,' error in writing ocn mesh after projection ' - call shr_sys_abort(subname//' ERROR in writing ocn mesh after projection') - endif -#endif - !CHECKRC(ierr, "cannot receive tag values") - endif - - else ! original send from spectral elements is replaced by send from phys grid - ! this will be reworked for all fields, send from phys grid atm: - tagName = trim(seq_flds_a2x_fields)//C_NULL_CHAR ! they are exported on phys grid directly - tagNameExt = trim(seq_flds_a2x_ext_fields)//C_NULL_CHAR ! these are special moab tags - ! the separator will be ':' as in mct - - if (mphaid .ge. 0) then ! send because we are on atm pes - ! - context_id = 100*atm(1)%cplcompid + ocn(1)%cplcompid !send to atm/ocn intx ! ~ 618 - ierr = iMOAB_SendElementTag(mphaid, tagName, mpicom_join, context_id) - if (ierr .ne. 0) then - write(logunit,*) subname,' error in sending tag from atm spectral to ocn atm intx ' - call shr_sys_abort(subname//' ERROR in sending tag from atm spectral to ocn atm intx') - endif - endif - if (mbaxid .ge. 0 ) then ! we are on coupler pes, for sure - ! receive on atm on coupler pes, that was redistributed according to coverage - context_id = atm(1)%compid ! atm_id - ierr = iMOAB_ReceiveElementTag(mbintxao, tagNameExt, mpicom_join, context_id) - if (ierr .ne. 0) then - write(logunit,*) subname,' error in receiving tag from atm phys grid to ocn atm intx spectral ' - call shr_sys_abort(subname//' ERROR in receiving tag from atm phys grid to ocn atm intx spectral') - endif - endif - - ! we can now free the sender buffers - if (mphaid .ge. 0) then - context_id = 100*atm(1)%cplcompid + ocn(1)%cplcompid !send to atm/ocn intx ! ~ 618 - ierr = iMOAB_FreeSenderBuffers(mphaid, context_id) - if (ierr .ne. 0) then - write(logunit,*) subname,' error in freeing buffers ' - call shr_sys_abort(subname//' ERROR in freeing buffers') - endif - endif - ! we could do the projection now, on the ocean mesh, because we are on the coupler pes; - ! the actual migrate could happen later , from coupler pes to the ocean pes - if (mbintxao .ge. 0 ) then ! we are on coupler pes, for sure - ! we could apply weights; need to use the same weight identifier wgtIdef as when we generated it - ! hard coded now, it should be a runtime option in the future - - ierr = iMOAB_ApplyScalarProjectionWeights ( mbintxao, wgtIdef, tagNameExt, tagName) - if (ierr .ne. 0) then - write(logunit,*) subname,' error in applying weights ' - call shr_sys_abort(subname//' ERROR in applying weights') - endif -#ifdef MOABDEBUG - ! we can also write the ocean mesh to file, just to see the projectd tag - ! write out the mesh file to disk - write(lnum,"(I0.2)")num_moab_exports - outfile = 'ocnCplProj'//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 - write(logunit,*) subname,' error in writing ocn mesh after projection ' - call shr_sys_abort(subname//' ERROR in writing ocn mesh after projection') - endif -#endif - endif ! if (mbintxao .ge. 0 ) - !CHECKRC(ierr, "cannot receive tag values") - endif ! if (atp_pg_active) - - endif ! if atm and ocn +! ierr = iMOAB_ApplyScalarProjectionWeights ( mbintxao, wgtIdef, tagName, tagName) +! if (ierr .ne. 0) then +! write(logunit,*) subname,' error in applying weights ' +! call shr_sys_abort(subname//' ERROR in applying weights') +! endif +! #ifdef MOABDEBUG +! ! we can also write the ocean mesh to file, just to see the projectd tag +! ! write out the mesh file to disk +! write(lnum,"(I0.2)")num_moab_exports +! outfile = 'ocnCplProj'//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 +! write(logunit,*) subname,' error in writing ocn mesh after projection ' +! call shr_sys_abort(subname//' ERROR in writing ocn mesh after projection') +! endif +! #endif +! !CHECKRC(ierr, "cannot receive tag values") +! endif + +! else ! original send from spectral elements is replaced by send from phys grid +! ! this will be reworked for all fields, send from phys grid atm: +! tagName = trim(seq_flds_a2x_fields)//C_NULL_CHAR ! they are exported on phys grid directly +! tagNameExt = trim(seq_flds_a2x_ext_fields)//C_NULL_CHAR ! these are special moab tags +! ! the separator will be ':' as in mct + +! if (mphaid .ge. 0) then ! send because we are on atm pes +! ! +! context_id = 100*atm(1)%cplcompid + ocn(1)%cplcompid !send to atm/ocn intx ! ~ 618 +! ierr = iMOAB_SendElementTag(mphaid, tagName, mpicom_join, context_id) +! if (ierr .ne. 0) then +! write(logunit,*) subname,' error in sending tag from atm spectral to ocn atm intx ' +! call shr_sys_abort(subname//' ERROR in sending tag from atm spectral to ocn atm intx') +! endif +! endif +! if (mbaxid .ge. 0 ) then ! we are on coupler pes, for sure +! ! receive on atm on coupler pes, that was redistributed according to coverage +! context_id = atm(1)%compid ! atm_id +! ierr = iMOAB_ReceiveElementTag(mbintxao, tagNameExt, mpicom_join, context_id) +! if (ierr .ne. 0) then +! write(logunit,*) subname,' error in receiving tag from atm phys grid to ocn atm intx spectral ' +! call shr_sys_abort(subname//' ERROR in receiving tag from atm phys grid to ocn atm intx spectral') +! endif +! endif + +! ! we can now free the sender buffers +! if (mphaid .ge. 0) then +! context_id = 100*atm(1)%cplcompid + ocn(1)%cplcompid !send to atm/ocn intx ! ~ 618 +! ierr = iMOAB_FreeSenderBuffers(mphaid, context_id) +! if (ierr .ne. 0) then +! write(logunit,*) subname,' error in freeing buffers ' +! call shr_sys_abort(subname//' ERROR in freeing buffers') +! endif +! endif +! ! we could do the projection now, on the ocean mesh, because we are on the coupler pes; +! ! the actual migrate could happen later , from coupler pes to the ocean pes +! if (mbintxao .ge. 0 ) then ! we are on coupler pes, for sure +! ! we could apply weights; need to use the same weight identifier wgtIdef as when we generated it +! ! hard coded now, it should be a runtime option in the future + +! ierr = iMOAB_ApplyScalarProjectionWeights ( mbintxao, wgtIdef, tagNameExt, tagName) +! if (ierr .ne. 0) then +! write(logunit,*) subname,' error in applying weights ' +! call shr_sys_abort(subname//' ERROR in applying weights') +! endif +! #ifdef MOABDEBUG +! ! we can also write the ocean mesh to file, just to see the projectd tag +! ! write out the mesh file to disk +! write(lnum,"(I0.2)")num_moab_exports +! outfile = 'ocnCplProj'//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 +! write(logunit,*) subname,' error in writing ocn mesh after projection ' +! call shr_sys_abort(subname//' ERROR in writing ocn mesh after projection') +! endif +! #endif +! endif ! if (mbintxao .ge. 0 ) +! !CHECKRC(ierr, "cannot receive tag values") +! endif ! if (atp_pg_active) + +! endif ! if atm and ocn ! repeat this for land data, that is already on atm tag context_id = lnd(1)%cplcompid diff --git a/driver-moab/main/prep_ocn_mod.F90 b/driver-moab/main/prep_ocn_mod.F90 index ec2cee7e6110..b3c4a7c1009b 100644 --- a/driver-moab/main/prep_ocn_mod.F90 +++ b/driver-moab/main/prep_ocn_mod.F90 @@ -63,6 +63,8 @@ module prep_ocn_mod public :: prep_ocn_accum_avg public :: prep_ocn_calc_a2x_ox + public :: prep_ocn_calc_a2x_ox_moab + public :: prep_ocn_calc_i2x_ox public :: prep_ocn_calc_i2x_ox_moab public :: prep_ocn_calc_r2x_ox @@ -2139,6 +2141,185 @@ subroutine prep_ocn_calc_a2x_ox(timer) end subroutine prep_ocn_calc_a2x_ox +subroutine prep_ocn_calc_a2x_ox_moab(timer, infodata) + ! start copy from prep_atm_migrate_moab + use iMOAB, only: iMOAB_SendElementTag, iMOAB_ReceiveElementTag, iMOAB_FreeSenderBuffers, & + iMOAB_ApplyScalarProjectionWeights, iMOAB_WriteMesh + !--------------------------------------------------------------- + + ! Arguments + character(len=*) , intent(in) :: timer + + type(seq_infodata_type) , intent(in) :: infodata + ! + ! Local Variables + type(mct_avect), pointer :: a2x_ax + character(*), parameter :: subname = '(prep_ocn_calc_a2x_ox_moab)' + + + integer :: ierr + + logical :: atm_present ! .true. => atm is present + logical :: ocn_present ! .true. => ocn is present + logical :: ocn_prognostic ! .true. => ocn is prognostic + integer :: id_join + integer :: mpicom_join + integer :: atm_id + integer :: context_id ! we will use ocean context + character*32 :: dm1, dm2, wgtIdef + character*50 :: outfile, wopts, lnum + character(CXX) :: tagName, tagnameProj, tagNameExt + !--------------------------------------------------------------- + + call t_drvstartf (trim(timer),barrier=mpicom_CPLID) + + a2x_ax => component_get_c2x_cx(atm(1)) ! is this needed? just to see if we have data on here + + call seq_infodata_getData(infodata, & + atm_present=atm_present, & + ocn_present=ocn_present, & + ocn_prognostic=ocn_prognostic) + + ! it involves initial atm app; mhid; also migrate atm mesh on coupler pes, mbaxid + ! intx ocean atm are in mbintxao ; remapper also has some info about coverage mesh + ! after this, the sending of tags from atm pes to coupler pes will use the new par comm graph, that has more precise info about + ! how to get mpicomm for joint atm + coupler + id_join = atm(1)%cplcompid + atm_id = atm(1)%compid + + call seq_comm_getinfo(ID_join,mpicom=mpicom_join) + + ! we should do this only if ocn_present + + context_id = ocn(1)%cplcompid + wgtIdef = 'scalar'//C_NULL_CHAR + + if (atm_present .and. ocn_present .and. ocn_prognostic) then + if (atm_pg_active ) then ! use data from AtmPhys mesh, but mesh from pg + ! in this case, we will send from phys grid directly to intx atm ocn context! + tagname=trim(seq_flds_a2x_fields)//C_NULL_CHAR + if (mphaid .ge. 0) then ! send because we are on atm pes, also mphaid >= 0 + context_id = 100*atm(1)%cplcompid + ocn(1)%cplcompid !send to atm/ocn intx ! ~ 618 + ierr = iMOAB_SendElementTag(mphaid, tagName, mpicom_join, context_id) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in sending tag from phys atm to ocn atm intx ' + call shr_sys_abort(subname//' ERROR in sending tag from phys atm to ocn atm intx') + endif + + endif + if (mbintxao .ge. 0 ) then ! we are for sure on coupler pes! + ! context_id = atm(1)%cplcompid == atm_id above (5) + ! we use the same name as spectral case, even thought in pg2 case, the size of tag is 1, not 16 + ! in imoab_apg2_ol_coupler.cpp we use at this stage, receiver, the same name as sender, T_ph + ierr = iMOAB_ReceiveElementTag(mbintxao, tagName, mpicom_join, atm_id) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in receiving tag from phys atm to ocn atm intx ' + call shr_sys_abort(subname//' ERROR in receiving tag from phys atm to ocn atm intx') + endif + + endif + ! we can now free the sender buffers + if (mhpgid .ge. 0) then + ierr = iMOAB_FreeSenderBuffers(mphaid, context_id) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in freeing buffers' + call shr_sys_abort(subname//' ERROR in freeing buffers') + endif + endif + + if (mbintxao .ge. 0 ) then ! we are on coupler pes, for sure + ! we could apply weights; need to use the same weight identifier wgtIdef as when we generated it + ! hard coded now, it should be a runtime option in the future + + ierr = iMOAB_ApplyScalarProjectionWeights ( mbintxao, wgtIdef, tagName, tagName) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in applying weights ' + call shr_sys_abort(subname//' ERROR in applying weights') + endif +#ifdef MOABDEBUG + ! we can also write the ocean mesh to file, just to see the projectd tag + ! write out the mesh file to disk + write(lnum,"(I0.2)")num_moab_exports + outfile = 'ocnCplProj'//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 + write(logunit,*) subname,' error in writing ocn mesh after projection ' + call shr_sys_abort(subname//' ERROR in writing ocn mesh after projection') + endif +#endif + !CHECKRC(ierr, "cannot receive tag values") + endif + + else ! original send from spectral elements is replaced by send from phys grid + ! this will be reworked for all fields, send from phys grid atm: + tagName = trim(seq_flds_a2x_fields)//C_NULL_CHAR ! they are exported on phys grid directly + tagNameExt = trim(seq_flds_a2x_ext_fields)//C_NULL_CHAR ! these are special moab tags + ! the separator will be ':' as in mct + + if (mphaid .ge. 0) then ! send because we are on atm pes + ! + context_id = 100*atm(1)%cplcompid + ocn(1)%cplcompid !send to atm/ocn intx ! ~ 618 + ierr = iMOAB_SendElementTag(mphaid, tagName, mpicom_join, context_id) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in sending tag from atm spectral to ocn atm intx ' + call shr_sys_abort(subname//' ERROR in sending tag from atm spectral to ocn atm intx') + endif + endif + if (mbaxid .ge. 0 ) then ! we are on coupler pes, for sure + ! receive on atm on coupler pes, that was redistributed according to coverage + context_id = atm(1)%compid ! atm_id + ierr = iMOAB_ReceiveElementTag(mbintxao, tagNameExt, mpicom_join, context_id) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in receiving tag from atm phys grid to ocn atm intx spectral ' + call shr_sys_abort(subname//' ERROR in receiving tag from atm phys grid to ocn atm intx spectral') + endif + endif + + ! we can now free the sender buffers + if (mphaid .ge. 0) then + context_id = 100*atm(1)%cplcompid + ocn(1)%cplcompid !send to atm/ocn intx ! ~ 618 + ierr = iMOAB_FreeSenderBuffers(mphaid, context_id) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in freeing buffers ' + call shr_sys_abort(subname//' ERROR in freeing buffers') + endif + endif + ! we could do the projection now, on the ocean mesh, because we are on the coupler pes; + ! the actual migrate could happen later , from coupler pes to the ocean pes + if (mbintxao .ge. 0 ) then ! we are on coupler pes, for sure + ! we could apply weights; need to use the same weight identifier wgtIdef as when we generated it + ! hard coded now, it should be a runtime option in the future + + ierr = iMOAB_ApplyScalarProjectionWeights ( mbintxao, wgtIdef, tagNameExt, tagName) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in applying weights ' + call shr_sys_abort(subname//' ERROR in applying weights') + endif +#ifdef MOABDEBUG + ! we can also write the ocean mesh to file, just to see the projectd tag + ! write out the mesh file to disk + write(lnum,"(I0.2)")num_moab_exports + outfile = 'ocnCplProj'//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 + write(logunit,*) subname,' error in writing ocn mesh after projection ' + call shr_sys_abort(subname//' ERROR in writing ocn mesh after projection') + endif +#endif + endif ! if (mbintxao .ge. 0 ) + !CHECKRC(ierr, "cannot receive tag values") + endif ! if (atp_pg_active) + + endif ! if atm and ocn + + ! end copy + + + call t_drvstopf (trim(timer)) + + end subroutine prep_ocn_calc_a2x_ox_moab !================================================================================================ subroutine prep_ocn_calc_i2x_ox(timer) From 1568b606adca0dff075ee6022a4f8a7ce56325b7 Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Sun, 30 Oct 2022 09:56:45 -0500 Subject: [PATCH 201/467] get mpicom from CPLID chrysalis crashed on shr_mpi_sum call not sure why yet, try to get mpicom with a different method --- driver-moab/main/component_type_mod.F90 | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/driver-moab/main/component_type_mod.F90 b/driver-moab/main/component_type_mod.F90 index 765ad0215d59..b081928b6761 100644 --- a/driver-moab/main/component_type_mod.F90 +++ b/driver-moab/main/component_type_mod.F90 @@ -412,6 +412,7 @@ subroutine compare_mct_av_moab_tag(comp, attrVect, mct_field, appId, tagname, en use shr_mpi_mod, only: shr_mpi_sum use shr_kind_mod, only: CXX => shr_kind_CXX use seq_comm_mct , only : CPLID, seq_comm_iamroot + use seq_comm_mct, only: seq_comm_setptrs use iMOAB, only : iMOAB_DefineTagStorage, iMOAB_GetDoubleTagStorage, & iMOAB_SetDoubleTagStorageWithGid, iMOAB_GetMeshInfo @@ -442,7 +443,7 @@ subroutine compare_mct_av_moab_tag(comp, attrVect, mct_field, appId, tagname, en character(*),parameter :: subName = '(compare_mct_av_moab_tag) ' - mpicom = comp%mpicom_cplcompid ! we are on the coupler side + call seq_comm_setptrs(CPLID, mpicom=mpicom) nloc = mct_avect_lsize(attrVect) allocate(GlobalIds(nloc)) From c6fd9cb680eababcd5cb36d056232391c4744ebc Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Fri, 18 Nov 2022 16:59:45 -0600 Subject: [PATCH 202/467] import of for atm component atm init is more complex, has 2 steps after albedos are calculated, a time step is run, and some variables are set after that initial step we do not actually import anything from moab yet, atm_import_moab call is commented out right now but the placeholder is there also, atm_import has more stuff, it is modifying cam_in sequentally, if we call it twice we modify something 2 times also, rename cam_export_phys_moab to simply atm_export_moab still need to remove unused export to spectral stuff --- components/eam/src/cpl/atm_comp_mct.F90 | 282 ++++++++++++++++++++++-- driver-moab/main/cime_comp_mod.F90 | 12 +- 2 files changed, 278 insertions(+), 16 deletions(-) diff --git a/components/eam/src/cpl/atm_comp_mct.F90 b/components/eam/src/cpl/atm_comp_mct.F90 index 0cfbcf57acda..6fde1615c3b6 100644 --- a/components/eam/src/cpl/atm_comp_mct.F90 +++ b/components/eam/src/cpl/atm_comp_mct.F90 @@ -9,7 +9,7 @@ module atm_comp_mct use seq_cdata_mod use esmf - use seq_flds_mod + use seq_flds_mod ! for seq_flds_x2a_fields use seq_infodata_mod use seq_timemgr_mod @@ -25,7 +25,7 @@ module atm_comp_mct use cam_cpl_indices ! it has atm_import, atm_export use atm_import_export - ! cam_moab_phys_export is private here + ! atm_export_moab is private here, atm_import_moab too ! we defined cam_moab_export in cam_comp; it has cam_init, cam_run1, 2, 3, 4, cam_final use cam_comp @@ -109,8 +109,9 @@ module atm_comp_mct #ifdef HAVE_MOAB ! to store all fields to be set in moab - integer , private :: mblsize, totalmbls, nsend - real(r8) , allocatable, private :: a2x_am(:,:) ! atm to coupler, on atm mesh + integer , private :: mblsize, totalmbls, nsend, totalmbls_r, nrecv + real(r8) , allocatable, private :: a2x_am(:,:) ! atm to coupler, on atm mesh, on atm component pes + real(r8) , allocatable, private :: x2a_am(:,:) ! coupler to atm, on atm mesh, on atm component pes #endif ! !================================================================================ @@ -394,6 +395,15 @@ subroutine atm_init_mct( EClock, cdata_a, x2a_a, a2x_a, NLFilename ) nsend = mct_avect_nRattr(a2x_a) totalmbls = mblsize * nsend ! size of the double array allocate (a2x_am(mblsize, nsend) ) + + nrecv = mct_avect_nRattr(x2a_a) + totalmbls_r = mblsize * nrecv ! size of the double array used to receive + allocate (x2a_am(mblsize, nrecv) ) ! these will be received by moab tags, then used to set cam in surf data + ! + ! Create initial atm export state inside moab + ! + call atm_export_moab( cam_out ) + #endif first_time = .false. @@ -416,8 +426,14 @@ subroutine atm_init_mct( EClock, cdata_a, x2a_a, a2x_a, NLFilename ) call seq_timemgr_EClockGetData(EClock,curr_ymd=CurrentYMD, StepNo=StepNo, dtime=DTime_Sync ) if (StepNo == 0) then call atm_import( x2a_a%rattr, cam_in ) +#ifdef HAVE_MOAB + !call atm_import_moab(cam_in) +#endif call cam_run1 ( cam_in, cam_out ) call atm_export( cam_out, a2x_a%rattr ) +#ifdef HAVE_MOAB + call atm_export_moab(cam_out) +#endif else call atm_read_srfrest_mct( EClock, x2a_a, a2x_a ) ! Sent .true. as an optional argument so that restart_init is set to .true. in atm_import @@ -544,6 +560,9 @@ subroutine atm_run_mct( EClock, cdata_a, x2a_a, a2x_a) call t_startf ('CAM_import') call atm_import( x2a_a%rattr, cam_in ) +#ifdef HAVE_MOAB + !call atm_import_moab(cam_in) +#endif call t_stopf ('CAM_import') ! Cycle over all time steps in the atm coupling interval @@ -604,20 +623,21 @@ subroutine atm_run_mct( EClock, cdata_a, x2a_a, a2x_a) call t_startf ('CAM_export') call atm_export( cam_out, a2x_a%rattr ) - call t_stopf ('CAM_export') - - end do - #ifdef HAVE_MOAB ! move method out of the do while (.not. do send) loop; do not send yet - call cam_moab_export() + ! call cam_moab_export() ! call method to set all seq_flds_a2x_fields on phys grid point cloud; ! it will be moved then to Atm Spectral mesh on coupler ; just to show how to move it to atm spectral ! on coupler - call cam_moab_phys_export(cam_out) + call atm_export_moab(cam_out) #endif + call t_stopf ('CAM_export') + + end do + + ! Get time of next radiation calculation - albedos will need to be ! calculated by each surface model at this time @@ -891,7 +911,7 @@ subroutine atm_read_srfrest_mct( EClock, x2a_a, a2x_a) call pio_read_darray(File, varid, iodesc, tmp, rcode) x2a_a%rattr(k,:) = tmp(:) else - if (masterproc) then + if (masterproc) then write(iulog,*)'srfrest warning: field ',trim(itemc),' is not on restart file' write(iulog,*)'for backwards compatibility will set it to 0' end if @@ -1000,7 +1020,6 @@ end subroutine atm_write_srfrest_mct #ifdef HAVE_MOAB subroutine initialize_moab_atm_phys( cdata_a ) - use seq_comm_mct, only: mphaid ! imoab pid for atm physics use shr_mpi_mod, only: shr_mpi_commrank, shr_mpi_commsize use shr_const_mod, only: SHR_CONST_PI !------------------------------------------------------------------- @@ -1155,6 +1174,13 @@ subroutine initialize_moab_atm_phys( cdata_a ) if ( ierr > 0) then call endrun('Error: fail to define seq_flds_a2x_fields for atm physgrid moab mesh') endif + ! make sure this is defined too; it could have the same fields, but in different order, or really different + ! fields; need to make sure we have them + tagname = trim(seq_flds_x2a_fields)//C_NULL_CHAR + ierr = iMOAB_DefineTagStorage(mphaid, tagname, tagtype, numco, tagindex ) + if ( ierr > 0) then + call endrun('Error: fail to define seq_flds_x2a_fields for atm physgrid moab mesh') + endif deallocate(moab_vert_coords) deallocate(vgids) @@ -1163,7 +1189,7 @@ subroutine initialize_moab_atm_phys( cdata_a ) end subroutine initialize_moab_atm_phys - subroutine cam_moab_phys_export(cam_out) + subroutine atm_export_moab(cam_out) !------------------------------------------------------------------- use camsrfexch, only: cam_out_t use phys_grid , only: get_ncols_p, get_nlcols_p @@ -1254,8 +1280,236 @@ subroutine cam_moab_phys_export(cam_out) #endif - end subroutine cam_moab_phys_export + end subroutine atm_export_moab + +subroutine atm_import_moab(cam_in, restart_init ) + + !----------------------------------------------------------------------- + use cam_cpl_indices + use camsrfexch, only: cam_in_t + use phys_grid , only: get_ncols_p + use ppgrid , only: begchunk, endchunk + use shr_const_mod, only: shr_const_stebol + use seq_drydep_mod, only: n_drydep + use co2_cycle , only: c_i, co2_readFlux_ocn, co2_readFlux_fuel + use co2_cycle , only: co2_transport, co2_time_interp_ocn, co2_time_interp_fuel + use co2_cycle , only: data_flux_ocn, data_flux_fuel + use physconst , only: mwco2 + use time_manager , only: is_first_step + use iMOAB, only: iMOAB_WriteMesh, iMOAB_GetDoubleTagStorage + use iso_c_binding + ! + ! Arguments + ! + ! real(r8) , intent(in) :: x2a_am(:,:) will be retrieved from moab tags, and used to set cam_in + type(cam_in_t), intent(inout) :: cam_in(begchunk:endchunk) + logical, optional, intent(in) :: restart_init + ! + ! Local variables + ! + integer :: i,lat,n,c,ig ! indices + integer :: ncols ! number of columns + logical, save :: first_time = .true. + integer, parameter :: ndst = 2 + integer, target :: spc_ndx(ndst) + integer, pointer :: dst_a5_ndx, dst_a7_ndx + integer, pointer :: dst_a1_ndx, dst_a3_ndx + logical :: overwrite_flds + + character(CXX) :: tagname ! + integer :: ent_type, ierr + !----------------------------------------------------------------------- + overwrite_flds = .true. + ! don't overwrite fields if invoked during the initialization phase + ! of a 'continue' or 'branch' run type with data from .rs file + if (present(restart_init)) overwrite_flds = .not. restart_init + + ! ccsm sign convention is that fluxes are positive downward + tagname=trim(seq_flds_x2a_fields)//C_NULL_CHAR + ent_type = 0 ! vertices, point cloud + ierr = iMOAB_GetDoubleTagStorage ( mphaid, tagname, totalmbls_r , ent_type, x2a_am(1,1) ) + if ( ierr > 0) then + call endrun('Error: fail to get seq_flds_a2x_fields for atm physgrid moab mesh') + endif + + ig=1 + do c=begchunk,endchunk + ncols = get_ncols_p(c) + + ! initialize constituent surface fluxes to zero + ! NOTE:overwrite_flds is .FALSE. for the first restart + ! time step making cflx(:,1)=0.0 for the first restart time step. + ! cflx(:,1) should not be zeroed out, start the second index of cflx from 2. + cam_in(c)%cflx(:,2:) = 0._r8 + + do i =1,ncols + if (overwrite_flds) then + ! Prior to this change, "overwrite_flds" was always .true. therefore wsx and wsy were always updated. + ! Now, overwrite_flds is .false. for the first time step of the restart run. Move wsx and wsy out of + ! this if-condition so that they are still updated everytime irrespective of the value of overwrite_flds. + + ! Move lhf to this if-block so that it is not overwritten to ensure BFB restarts when qneg4 correction + ! occurs at the restart time step + ! Modified by Wuyin Lin + cam_in(c)%shf(i) = -x2a_am(ig,index_x2a_Faxx_sen) + cam_in(c)%cflx(i,1) = -x2a_am(ig,index_x2a_Faxx_evap) + cam_in(c)%lhf(i) = -x2a_am(ig,index_x2a_Faxx_lat) + endif + + if (index_x2a_Faoo_h2otemp /= 0) then + cam_in(c)%h2otemp(i) = -x2a_am(ig,index_x2a_Faoo_h2otemp) + end if + + cam_in(c)%wsx(i) = -x2a_am(ig,index_x2a_Faxx_taux) + cam_in(c)%wsy(i) = -x2a_am(ig,index_x2a_Faxx_tauy) + cam_in(c)%lwup(i) = -x2a_am(ig,index_x2a_Faxx_lwup) + cam_in(c)%asdir(i) = x2a_am(ig,index_x2a_Sx_avsdr) + cam_in(c)%aldir(i) = x2a_am(ig,index_x2a_Sx_anidr) + cam_in(c)%asdif(i) = x2a_am(ig,index_x2a_Sx_avsdf) + cam_in(c)%aldif(i) = x2a_am(ig,index_x2a_Sx_anidf) + cam_in(c)%ts(i) = x2a_am(ig,index_x2a_Sx_t) + cam_in(c)%sst(i) = x2a_am(ig,index_x2a_So_t) + cam_in(c)%snowhland(i) = x2a_am(ig,index_x2a_Sl_snowh) + cam_in(c)%snowhice(i) = x2a_am(ig,index_x2a_Si_snowh) + cam_in(c)%tref(i) = x2a_am(ig,index_x2a_Sx_tref) + cam_in(c)%qref(i) = x2a_am(ig,index_x2a_Sx_qref) + cam_in(c)%u10(i) = x2a_am(ig,index_x2a_Sx_u10) + cam_in(c)%icefrac(i) = x2a_am(ig,index_x2a_Sf_ifrac) + cam_in(c)%ocnfrac(i) = x2a_am(ig,index_x2a_Sf_ofrac) + cam_in(c)%landfrac(i) = x2a_am(ig,index_x2a_Sf_lfrac) + if ( associated(cam_in(c)%ram1) ) & + cam_in(c)%ram1(i) = x2a_am(ig,index_x2a_Sl_ram1 ) + if ( associated(cam_in(c)%fv) ) & + cam_in(c)%fv(i) = x2a_am(ig,index_x2a_Sl_fv ) + if ( associated(cam_in(c)%soilw) ) & + cam_in(c)%soilw(i) = x2a_am(ig,index_x2a_Sl_soilw) + if ( associated(cam_in(c)%dstflx) ) then + cam_in(c)%dstflx(i,1) = x2a_am(ig,index_x2a_Fall_flxdst1) + cam_in(c)%dstflx(i,2) = x2a_am(ig,index_x2a_Fall_flxdst2) + cam_in(c)%dstflx(i,3) = x2a_am(ig,index_x2a_Fall_flxdst3) + cam_in(c)%dstflx(i,4) = x2a_am(ig,index_x2a_Fall_flxdst4) + endif + if ( associated(cam_in(c)%meganflx) ) then + cam_in(c)%meganflx(i,1:shr_megan_mechcomps_n) = & + x2a_am(ig,index_x2a_Fall_flxvoc:index_x2a_Fall_flxvoc+shr_megan_mechcomps_n-1) + endif + + ! dry dep velocities + if ( index_x2a_Sl_ddvel/=0 .and. n_drydep>0 ) then + cam_in(c)%depvel(i,:n_drydep) = & + x2a_am(ig,index_x2a_Sl_ddvel:index_x2a_Sl_ddvel+n_drydep-1) + endif + ! + ! fields needed to calculate water isotopes to ocean evaporation processes + ! + cam_in(c)%ustar(i) = x2a_am(ig,index_x2a_So_ustar) + cam_in(c)%re(i) = x2a_am(ig,index_x2a_So_re ) + cam_in(c)%ssq(i) = x2a_am(ig,index_x2a_So_ssq ) + ! + ! bgc scenarios + ! + if (index_x2a_Fall_fco2_lnd /= 0) then + cam_in(c)%fco2_lnd(i) = -x2a_am(ig,index_x2a_Fall_fco2_lnd) + end if + if (index_x2a_Faoo_fco2_ocn /= 0) then + cam_in(c)%fco2_ocn(i) = -x2a_am(ig,index_x2a_Faoo_fco2_ocn) + end if + if (index_x2a_Faoo_fdms_ocn /= 0) then + cam_in(c)%fdms(i) = -x2a_am(ig,index_x2a_Faoo_fdms_ocn) + end if + + ig=ig+1 + + end do + end do + + ! Get total co2 flux from components, + ! Note - co2_transport determines if cam_in(c)%cflx(i,c_i(1:4)) is allocated + + if (co2_transport().and.overwrite_flds) then + + ! Interpolate in time for flux data read in + if (co2_readFlux_ocn) then + call co2_time_interp_ocn + end if + if (co2_readFlux_fuel) then + call co2_time_interp_fuel + end if + + ! from ocn : data read in or from coupler or zero + ! from fuel: data read in or zero + ! from lnd : through coupler or zero + do c=begchunk,endchunk + ncols = get_ncols_p(c) + do i=1,ncols + + ! all co2 fluxes in unit kgCO2/m2/s ! co2 flux from ocn + if (index_x2a_Faoo_fco2_ocn /= 0) then + cam_in(c)%cflx(i,c_i(1)) = cam_in(c)%fco2_ocn(i) + else if (co2_readFlux_ocn) then + ! convert from molesCO2/m2/s to kgCO2/m2/s +! The below section involves a temporary workaround for fluxes from data (read in from a file) +! There is an issue with infld that does not allow time-varying 2D files to be read correctly. +! The work around involves adding a singleton 3rd dimension offline and reading the files as +! 3D fields. Once this issue is corrected, the old implementation can be reinstated. +! This is the case for both data_flux_ocn and data_flux_fuel +!++BEH vvv old implementation vvv +! cam_in(c)%cflx(i,c_i(1)) = & +! -data_flux_ocn%co2flx(i,c)*(1._r8- cam_in(c)%landfrac(i)) & +! *mwco2*1.0e-3_r8 +! ^^^ old implementation ^^^ /// vvv new implementation vvv + cam_in(c)%cflx(i,c_i(1)) = & + -data_flux_ocn%co2flx(i,1,c)*(1._r8- cam_in(c)%landfrac(i)) & + *mwco2*1.0e-3_r8 +!--BEH ^^^ new implementation ^^^ + else + cam_in(c)%cflx(i,c_i(1)) = 0._r8 + end if + + ! co2 flux from fossil fuel + if (co2_readFlux_fuel) then +!++BEH vvv old implementation vvv +! cam_in(c)%cflx(i,c_i(2)) = data_flux_fuel%co2flx(i,c) +! ^^^ old implementation ^^^ /// vvv new implementation vvv + cam_in(c)%cflx(i,c_i(2)) = data_flux_fuel%co2flx(i,1,c) +!--BEH ^^^ new implementation ^^^ + else + cam_in(c)%cflx(i,c_i(2)) = 0._r8 + end if + + ! co2 flux from land (cpl already multiplies flux by land fraction) + if (index_x2a_Fall_fco2_lnd /= 0) then + cam_in(c)%cflx(i,c_i(3)) = cam_in(c)%fco2_lnd(i) + else + cam_in(c)%cflx(i,c_i(3)) = 0._r8 + end if + + ! merged co2 flux + cam_in(c)%cflx(i,c_i(4)) = cam_in(c)%cflx(i,c_i(1)) + & + cam_in(c)%cflx(i,c_i(2)) + & + cam_in(c)%cflx(i,c_i(3)) + end do + end do + end if + ! + ! if first step, determine longwave up flux from the surface temperature + ! + if (first_time) then + if (is_first_step()) then + do c=begchunk, endchunk + ncols = get_ncols_p(c) + do i=1,ncols + cam_in(c)%lwup(i) = shr_const_stebol*(cam_in(c)%ts(i)**4) + end do + end do + end if + first_time = .false. + end if + + + end subroutine atm_import_moab +! endif for HAVE_MOAB #endif end module atm_comp_mct diff --git a/driver-moab/main/cime_comp_mod.F90 b/driver-moab/main/cime_comp_mod.F90 index cf0061f991a2..d6d33cdec049 100644 --- a/driver-moab/main/cime_comp_mod.F90 +++ b/driver-moab/main/cime_comp_mod.F90 @@ -1394,7 +1394,8 @@ end subroutine cime_pre_init2 !=============================================================================== subroutine cime_init() - + use seq_flds_mod , only : seq_flds_x2a_fields, seq_flds_a2x_fields + use seq_comm_mct , only : mphaid, mphaxid ! #ifdef MOABDEBUG real(r8) :: difference character(20) :: mct_field, tagname @@ -2311,6 +2312,8 @@ subroutine cime_init() if (atm_prognostic) then call component_exch(atm, flow='x2c', infodata=infodata, & infodata_string='cpl2atm_init') + ! moab too + call component_exch_moab(atm(1), mphaxid, mphaid, 1, seq_flds_x2a_fields) endif ! Set atm init phase to 2 for all atm instances on component instance pes @@ -2329,6 +2332,8 @@ subroutine cime_init() ! Map atm output data from atm pes to cpl pes call component_exch(atm, flow='c2x', infodata=infodata, & infodata_string='atm2cpl_init') + ! + call component_exch_moab(atm(1), mphaid, mphaxid, 0, seq_flds_a2x_fields) if (iamin_CPLID) then if (drv_threading) call seq_comm_setnthreads(nthreads_CPLID) @@ -3995,7 +4000,8 @@ end subroutine cime_run_ocn_albedos !---------------------------------------------------------------------------------- subroutine cime_run_atm_setup_send() - + use seq_flds_mod , only : seq_flds_x2a_fields + use seq_comm_mct , only : mphaid, mphaxid ! !---------------------------------------------------------- !| atm prep-merge !---------------------------------------------------------- @@ -4047,6 +4053,8 @@ subroutine cime_run_atm_setup_send() mpicom_barrier=mpicom_CPLALLATMID, run_barriers=run_barriers, & timer_barrier='CPL:C2A_BARRIER', timer_comp_exch='CPL:C2A', & timer_map_exch='CPL:c2a_atmx2atmg', timer_infodata_exch='CPL:c2a_infoexch') + ! will migrate the tag from coupler pes to component pes, on atm mesh + call component_exch_moab(atm(1), mphaxid, mphaid, 1, seq_flds_x2a_fields) endif end subroutine cime_run_atm_setup_send From 3e3235a9a9e7c7f6c20053385e7114c259611a1b Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Mon, 21 Nov 2022 17:31:53 -0600 Subject: [PATCH 203/467] compare_mct_av_moab_tag is not used in cime_comp --- driver-moab/main/cime_comp_mod.F90 | 1 - 1 file changed, 1 deletion(-) diff --git a/driver-moab/main/cime_comp_mod.F90 b/driver-moab/main/cime_comp_mod.F90 index d6d33cdec049..5f8487739683 100644 --- a/driver-moab/main/cime_comp_mod.F90 +++ b/driver-moab/main/cime_comp_mod.F90 @@ -201,7 +201,6 @@ module cime_comp_mod #endif #ifdef MOABDEBUG - use component_type_mod, only: compare_mct_av_moab_tag use seq_comm_mct , only : mboxid use iso_c_binding #endif From d178fdb73ad053e16c99f51853740ed18852d14d Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Mon, 21 Nov 2022 18:04:15 -0600 Subject: [PATCH 204/467] move atm_import_moab before actual atm_import this will ensure that the moab modifications will not affect run when compare_to_moab_tag will show no difference, we will comment out atm_import --- components/eam/src/cpl/atm_comp_mct.F90 | 155 ++++++++++++++++++++++-- 1 file changed, 148 insertions(+), 7 deletions(-) diff --git a/components/eam/src/cpl/atm_comp_mct.F90 b/components/eam/src/cpl/atm_comp_mct.F90 index 6fde1615c3b6..1d8e6c83912d 100644 --- a/components/eam/src/cpl/atm_comp_mct.F90 +++ b/components/eam/src/cpl/atm_comp_mct.F90 @@ -62,6 +62,10 @@ module atm_comp_mct #ifdef HAVE_MOAB use seq_comm_mct , only: mphaid ! atm physics grid id in MOAB, on atm pes use iso_c_binding + use seq_comm_mct, only : num_moab_exports +#endif +#ifdef MOABDEBUG + !use seq_comm_mct, only: compare_to_moab_tag #endif ! ! !PUBLIC TYPES: @@ -113,6 +117,10 @@ module atm_comp_mct real(r8) , allocatable, private :: a2x_am(:,:) ! atm to coupler, on atm mesh, on atm component pes real(r8) , allocatable, private :: x2a_am(:,:) ! coupler to atm, on atm mesh, on atm component pes #endif +#ifdef MOABDEBUG + integer :: mpicom_atm_moab ! used just for mpi-reducing the difference betweebn moab tags and mct avs + integer :: rank2 +#endif ! !================================================================================ CONTAINS @@ -174,6 +182,15 @@ subroutine atm_init_mct( EClock, cdata_a, x2a_a, a2x_a, NLFilename ) ! data structure, If 1D data structure, then ! hdim2_d == 1. character(len=64) :: filein ! Input namelist filename + +#ifdef MOABDEBUG + real(r8) :: difference + type(mct_list) :: temp_list + integer :: size_list, index_list, ent_type + type(mct_string) :: mctOStr ! + character(CXX) ::tagname, mct_field +#endif + !----------------------------------------------------------------------- ! ! Determine cdata points @@ -187,7 +204,10 @@ subroutine atm_init_mct( EClock, cdata_a, x2a_a, a2x_a, NLFilename ) call seq_cdata_setptrs(cdata_a, ID=ATMID, mpicom=mpicom_atm, & gsMap=gsMap_atm, dom=dom_a, infodata=infodata) - +#ifdef MOABDEBUG + mpicom_atm_moab = mpicom_atm ! just store it now, for later use + call shr_mpi_commrank( mpicom_atm_moab, rank2 ) +#endif if (first_time) then call cam_instance_init(ATMID) @@ -425,10 +445,30 @@ subroutine atm_init_mct( EClock, cdata_a, x2a_a, a2x_a, NLFilename ) call seq_timemgr_EClockGetData(EClock,curr_ymd=CurrentYMD, StepNo=StepNo, dtime=DTime_Sync ) if (StepNo == 0) then - call atm_import( x2a_a%rattr, cam_in ) +#ifdef MOABDEBUG + !compare_to_moab_tag(mpicom_atm_moab, attrVect, field, imoabApp, tag_name, ent_type, difference) + !x2o_o => component_get_x2c_cx(ocn(1)) + ! loop over all fields in seq_flds_x2a_fields + call mct_list_init(temp_list ,seq_flds_x2a_fields) + size_list=mct_list_nitem (temp_list) + ent_type = 0 ! entity type is vertex for phys atm + if (rank2 .eq. 0) print *, num_moab_exports, trim(seq_flds_x2a_fields), ' atm import check' + 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 compare_to_moab_tag(mpicom_atm_moab, x2a_a, mct_field, mphaid, tagname, ent_type, difference) + enddo + call mct_list_clean(temp_list) + +#endif + #ifdef HAVE_MOAB - !call atm_import_moab(cam_in) -#endif + call atm_import_moab(cam_in) +#endif + ! move moab import before cam import + ! so the cam import takes precedence, and fixes eventual problems in moab import + call atm_import( x2a_a%rattr, cam_in ) call cam_run1 ( cam_in, cam_out ) call atm_export( cam_out, a2x_a%rattr ) #ifdef HAVE_MOAB @@ -529,6 +569,13 @@ subroutine atm_run_mct( EClock, cdata_a, x2a_a, a2x_a) integer :: lbnum character(len=*), parameter :: subname="atm_run_mct" !----------------------------------------------------------------------- +#ifdef MOABDEBUG + real(r8) :: difference + type(mct_list) :: temp_list + integer :: size_list, index_list, ent_type + type(mct_string) :: mctOStr ! + character(CXX) ::tagname, mct_field +#endif #if (defined _MEMTRACE) if(masterproc) then @@ -559,10 +606,30 @@ subroutine atm_run_mct( EClock, cdata_a, x2a_a, a2x_a) ! Map input from mct to cam data structure call t_startf ('CAM_import') - call atm_import( x2a_a%rattr, cam_in ) + +#ifdef MOABDEBUG + !compare_to_moab_tag(mpicom_atm_moab, attrVect, field, imoabApp, tag_name, ent_type, difference) + !x2o_o => component_get_x2c_cx(ocn(1)) + ! loop over all fields in seq_flds_a2x_fields + call mct_list_init(temp_list ,seq_flds_x2a_fields) + size_list=mct_list_nitem (temp_list) + ent_type = 0 ! entity type is vertex for phys atm + if (rank2 .eq. 0) print *, num_moab_exports, trim(seq_flds_x2a_fields) + 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 compare_to_moab_tag(mpicom_atm_moab, x2a_a, mct_field, mphaid, tagname, ent_type, difference) + enddo + call mct_list_clean(temp_list) + +#endif + #ifdef HAVE_MOAB - !call atm_import_moab(cam_in) + call atm_import_moab(cam_in) #endif + ! move moab import before regular atm import, so it would hopefully not be a problem + call atm_import( x2a_a%rattr, cam_in ) call t_stopf ('CAM_import') ! Cycle over all time steps in the atm coupling interval @@ -1195,7 +1262,6 @@ subroutine atm_export_moab(cam_out) use phys_grid , only: get_ncols_p, get_nlcols_p use ppgrid , only: begchunk, endchunk use seq_comm_mct, only: mphaid ! imoab pid for atm physics - use seq_comm_mct, only : num_moab_exports ! use cam_abortutils , only: endrun use iMOAB, only: iMOAB_WriteMesh, iMOAB_SetDoubleTagStorage use iso_c_binding @@ -1512,4 +1578,79 @@ end subroutine atm_import_moab ! endif for HAVE_MOAB #endif + +#ifdef MOABDEBUG + ! assumes everything is on component side, to compare before imports + subroutine compare_to_moab_tag(mpicom, attrVect, mct_field, appId, tagname, ent_type, difference) + + use shr_mpi_mod, only: shr_mpi_sum, shr_mpi_commrank + use shr_kind_mod, only: CXX => shr_kind_CXX + use seq_comm_mct , only : CPLID, seq_comm_iamroot + use seq_comm_mct, only: seq_comm_setptrs + use iMOAB, only : iMOAB_DefineTagStorage, iMOAB_GetDoubleTagStorage, & + iMOAB_SetDoubleTagStorageWithGid, iMOAB_GetMeshInfo + + use iso_c_binding + + integer, intent(in) :: mpicom + integer , intent(in) :: appId, ent_type + type(mct_aVect) , intent(in) :: attrVect + character(*) , intent(in) :: mct_field + character(*) , intent(in) :: tagname + + real(r8) , intent(out) :: difference + + real(r8) :: differenceg ! global, reduced diff + integer :: mbSize, nloc, index_avfield, rank2 + + ! moab + integer :: tagtype, numco, tagindex, ierr + character(CXX) :: tagname_mct + + real(r8) , allocatable :: values(:), mct_values(:) + integer nvert(3), nvise(3), nbl(3), nsurf(3), nvisBC(3) + logical :: iamroot + + + character(*),parameter :: subName = '(compare_to_moab_tag) ' + + nloc = mct_avect_lsize(attrVect) + allocate(mct_values(nloc)) + + index_avfield = mct_aVect_indexRA(attrVect,trim(mct_field)) + mct_values(:) = attrVect%rAttr(index_avfield,:) + + ! now get moab tag values; first get info + ierr = iMOAB_GetMeshInfo ( appId, nvert, nvise, nbl, nsurf, nvisBC ); + if (ierr > 0 ) & + call shr_sys_abort(subname//'Error: fail to get mesh info') + if (ent_type .eq. 0) then + mbSize = nvert(1) + else if (ent_type .eq. 1) then + mbSize = nvise(1) + endif + allocate(values(mbSize)) + + ierr = iMOAB_GetDoubleTagStorage ( appId, tagname, mbSize , ent_type, values) + if (ierr > 0 ) & + call shr_sys_abort(subname//'Error: fail to get moab tag values') + + values = mct_values - values + + difference = dot_product(values, values) + call shr_mpi_sum(difference,differenceg,mpicom,subname) + difference = sqrt(differenceg) + call shr_mpi_commrank( mpicom, rank2 ) + if ( rank2 .eq. 0 ) then + print * , subname, ' , difference on tag ', trim(tagname), ' = ', difference + !call shr_sys_abort(subname//'differences between mct and moab values') + endif + deallocate(values) + deallocate(mct_values) + + end subroutine compare_to_moab_tag + ! #endif for MOABDEBUG +#endif + + end module atm_comp_mct From 248b01b1d3c8883566f7f0333b0cca52f8a43ecc Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Tue, 6 Dec 2022 10:57:11 -0600 Subject: [PATCH 205/467] moab app ids in seq_map type --- driver-moab/main/seq_map_type_mod.F90 | 14 ++++++++++++++ 1 file changed, 14 insertions(+) diff --git a/driver-moab/main/seq_map_type_mod.F90 b/driver-moab/main/seq_map_type_mod.F90 index 303972f42982..fadf04b8b23c 100644 --- a/driver-moab/main/seq_map_type_mod.F90 +++ b/driver-moab/main/seq_map_type_mod.F90 @@ -33,6 +33,15 @@ module seq_map_type_mod real(R8), pointer :: slat_d(:) real(R8), pointer :: clat_d(:) integer(IN) :: mpicom ! mpicom + + ! MOAB additional members, that store source, target and intx MOAB appids + ! these are integers greater than or equal to 0 + ! + ! in general, rearrange can be solved with a parcommgraph, true fv-fv intx with an actual intx + ! and a weight matrix; + ! intx appid should be used for one map usually + ! source and target app ids also make sense only on the coupler pes + integer :: src_mbid, tgt_mbid, intx_mbid ! end type seq_map public seq_map @@ -136,6 +145,11 @@ subroutine seq_map_mapinit(mapper,mpicom) mapper%strategy = "undefined" mapper%mapfile = "undefined" + mapper%src_mbid = -1 + mapper%tgt_mbid = -1 + mapper%intx_mbid = -1 + + end subroutine seq_map_mapinit !=============================================================================== From 5c1379caabff5782c2b92259f8eb5655047860c0 Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Wed, 7 Dec 2022 09:22:30 -0600 Subject: [PATCH 206/467] start moab atm merge --- driver-moab/main/cime_comp_mod.F90 | 2 ++ driver-moab/main/prep_atm_mod.F90 | 15 +++++++++++++++ 2 files changed, 17 insertions(+) diff --git a/driver-moab/main/cime_comp_mod.F90 b/driver-moab/main/cime_comp_mod.F90 index 5f8487739683..e2e957d9b5d8 100644 --- a/driver-moab/main/cime_comp_mod.F90 +++ b/driver-moab/main/cime_comp_mod.F90 @@ -2283,6 +2283,8 @@ subroutine cime_init() if (associated(xao_ax)) then call prep_atm_mrg(infodata, & fractions_ax=fractions_ax, xao_ax=xao_ax, timer_mrg='CPL:init_atminit') + ! MOAB + call prep_atm_mrg_moab(infodata, xao_ax) endif endif diff --git a/driver-moab/main/prep_atm_mod.F90 b/driver-moab/main/prep_atm_mod.F90 index e57c2e12ef96..96511eca478e 100644 --- a/driver-moab/main/prep_atm_mod.F90 +++ b/driver-moab/main/prep_atm_mod.F90 @@ -47,6 +47,7 @@ module prep_atm_mod public :: prep_atm_init public :: prep_atm_mrg + public :: prep_atm_mrg_moab public :: prep_atm_get_l2x_ax public :: prep_atm_get_i2x_ax @@ -722,6 +723,20 @@ subroutine prep_atm_mrg(infodata, fractions_ax, xao_ax, timer_mrg) end subroutine prep_atm_mrg + subroutine prep_atm_mrg_moab(infodata, xao_ax) + use iMOAB , only : iMOAB_GetMeshInfo, iMOAB_GetDoubleTagStorage, & + iMOAB_SetDoubleTagStorage, iMOAB_WriteMesh + ! use seq_comm_mct , only : mbaxid, mbofxid ! ocean and atm-ocean flux instances + !--------------------------------------------------------------- + ! Description + ! Merge all ocn inputs + ! + ! Arguments + type(seq_infodata_type) , intent(in) :: infodata + type(mct_aVect) , pointer , intent(in) :: xao_ax(:) ! Atm-ocn fluxes, atm grid, cpl pes; used here just for indexing + + + end subroutine prep_atm_mrg_moab !================================================================================================ subroutine prep_atm_merge( l2x_a, o2x_a, xao_a, i2x_a, fractions_a, x2a_a ) From 235db9f345358e427023d07f2f4fa8b816880f1e Mon Sep 17 00:00:00 2001 From: Vijay Mahadevan Date: Wed, 7 Dec 2022 15:39:58 -0600 Subject: [PATCH 207/467] Modify map application to support MOAB workflows --- driver-moab/main/seq_map_mod.F90 | 141 +++++++++++++++++++++++++- driver-moab/main/seq_map_type_mod.F90 | 16 ++- 2 files changed, 150 insertions(+), 7 deletions(-) diff --git a/driver-moab/main/seq_map_mod.F90 b/driver-moab/main/seq_map_mod.F90 index cef9ec29e585..133cf02177de 100644 --- a/driver-moab/main/seq_map_mod.F90 +++ b/driver-moab/main/seq_map_mod.F90 @@ -191,9 +191,9 @@ subroutine moab_map_init_rcfile( mbappid, mbtsid, type_grid, comp_s, comp_d, & character(CL) :: maptype integer(IN) :: mapid character(CX) :: sol_identifier ! /* "scalar", "flux", "custom" */ - integer :: ierr + integer :: ierr integer :: col_or_row ! 0 for row based, 1 for col based (we use row distribution now) - + character(len=*),parameter :: subname = "(moab_map_init_rcfile) " !----------------------------------------------------- @@ -211,7 +211,7 @@ subroutine moab_map_init_rcfile( mbappid, mbtsid, type_grid, comp_s, comp_d, & mapfile_term = trim(mapfile)//CHAR(0) if (seq_comm_iamroot(CPLID)) then write(logunit,*) subname,' reading map file with iMOAB: ', mapfile_term - endif + endif col_or_row = 0 ! row based distribution @@ -304,6 +304,10 @@ end subroutine seq_map_init_rearrolap subroutine seq_map_map( mapper, av_s, av_d, fldlist, norm, avwts_s, avwtsfld_s, & string, msgtag ) + use iso_c_binding + use iMOAB, only: iMOAB_GetMeshInfo, iMOAB_GetDoubleTagStorage, iMOAB_SetDoubleTagStorage, & + iMOAB_GetIntTagStorage, iMOAB_SetDoubleTagStorageWithGid, iMOAB_ApplyScalarProjectionWeights + implicit none !----------------------------------------------------- ! @@ -318,6 +322,15 @@ subroutine seq_map_map( mapper, av_s, av_d, fldlist, norm, avwts_s, avwtsfld_s, character(len=*),intent(in),optional :: avwtsfld_s character(len=*),intent(in),optional :: string integer(IN) ,intent(in),optional :: msgtag +#ifdef HAVE_MOAB + logical :: valid_moab_context + integer :: ierr, nfields, ntagdatalength + character, dimension(:), allocatable :: fldlist_moab + integer :: nvert(3), nvise(3), nbl(3), nsurf(3), nvisBC(3) ! for moab info + type(mct_list) :: temp_list + integer, dimension(:), allocatable :: globalIds + real(r8), dimension(:), allocatable :: moab_tag_data +#endif ! ! Local Variables ! @@ -350,6 +363,47 @@ subroutine seq_map_map( mapper, av_s, av_d, fldlist, norm, avwts_s, avwtsfld_s, call shr_sys_abort(subname//' ERROR: avwtsfld present') endif +#ifdef HAVE_MOAB + ! check whether the application ID is defined on the current process + if ( mapper%src_mbid .lt. 0 .or. mapper%tgt_mbid .lt. 0 ) then + valid_moab_context = .FALSE. + else + valid_moab_context = .TRUE. + endif + + if ( valid_moab_context ) then + ! if ( mapper % nentities == 0 ) then + ! ! tag_entity_type = 1 ! 0 = vertices, 1 = elements + ! ! find out the number of local elements in moab mesh ocean instance on coupler + ! ierr = iMOAB_GetMeshInfo ( mboxid, nvert, nvise, nbl, nsurf, nvisBC ) + ! if (ierr .ne. 0) then + ! write(logunit,*) subname,' error in getting mesh info ' + ! call shr_sys_abort(subname//' error in getting mesh info ') + ! endif + ! !! check tag_entity_type and then set nentieis accordingly + ! endif + + nfields = 1 + ! first get data from source tag and store in a temporary + ! then set it back to target tag to mimic a copy + if (present(fldlist)) then + ! find the number of fields in the list + ! Or should we decipher based on fldlist? + call mct_list_init(temp_list, fldlist) + nfields=mct_list_nitem (temp_list) + call mct_list_clean(temp_list) + allocate(fldlist_moab(len(fldlist))) + fldlist_moab(:) = fldlist(:) + else + ! Extract character strings from attribute vector + nfields = mct_aVect_nRAttr(av_s) + fldlist_moab = mct_aVect_exportRList2c(av_s) + endif + + ntagdatalength = nfields * mapper % nentities + endif ! valid_moab_context +#endif + if (mapper%copy_only) then !------------------------------------------- ! COPY data @@ -360,6 +414,32 @@ subroutine seq_map_map( mapper, av_s, av_d, fldlist, norm, avwts_s, avwtsfld_s, call mct_aVect_copy(aVin=av_s,aVout=av_d,vector=mct_usevector) endif +#ifdef HAVE_MOAB + if ( valid_moab_context ) then + ! first get data from source tag and store in a temporary + ! then set it back to target tag to mimic a copy + allocate(moab_tag_data(ntagdatalength)) + + ierr = iMOAB_GetDoubleTagStorage( mapper%src_mbid, & + fldlist_moab, & + ntagdatalength, & + mapper % tag_entity_type, & + moab_tag_data ) + if (ierr > 0 ) & + call shr_sys_abort( subname//'MOAB Error: failed to get source double tag ') + + ierr = iMOAB_SetDoubleTagStorage( mapper%tgt_mbid, & + fldlist_moab, & + ntagdatalength, & + mapper % tag_entity_type, & + moab_tag_data ) + if (ierr > 0 ) & + call shr_sys_abort( subname//'MOAB Error: failed to set target double tag ') + + deallocate(moab_tag_data) + endif +#endif + else if (mapper%rearrange_only) then !------------------------------------------- ! REARRANGE data @@ -372,6 +452,44 @@ subroutine seq_map_map( mapper, av_s, av_d, fldlist, norm, avwts_s, avwtsfld_s, ALLTOALL=mct_usealltoall) endif +#ifdef HAVE_MOAB + if ( valid_moab_context ) then + ! first get data from source tag and store in a temporary + ! then set it back to target tag to mimic a copy + allocate(moab_tag_data(ntagdatalength)) + + allocate(globalIds(mapper % nentities)) + ierr = iMOAB_GetIntTagStorage( mapper%src_mbid, & + 'GLOBAL_ID'//C_NULL_CHAR, & + mapper % nentities, & + mapper % tag_entity_type, & + globalIds ) + if (ierr > 0 ) & + call shr_sys_abort( subname//'MOAB Error: failed to get GLOBAL_ID tag ') + + ierr = iMOAB_GetDoubleTagStorage( mapper%src_mbid, & + fldlist_moab, & + ntagdatalength, & + mapper % tag_entity_type, & + moab_tag_data ) + if (ierr > 0 ) & + call shr_sys_abort( subname//'MOAB Error: failed to get fields tag ') + + !! TODO: Compute a comm graph and store it so that it is used for application at runtime + ierr = iMOAB_SetDoubleTagStorageWithGid( mapper%tgt_mbid, & + fldlist_moab, & + ntagdatalength, & + mapper % tag_entity_type, & + moab_tag_data, & + globalIds ) + if (ierr > 0 ) & + call shr_sys_abort( subname//'MOAB Error: failed to set fields tag ') + + deallocate(globalIds) + deallocate(moab_tag_data) + endif +#endif + else !------------------------------------------- ! MAP data @@ -391,8 +509,25 @@ subroutine seq_map_map( mapper, av_s, av_d, fldlist, norm, avwts_s, avwtsfld_s, call seq_map_avNorm(mapper, av_s, av_d, norm=lnorm) endif endif + +#ifdef HAVE_MOAB + if ( valid_moab_context ) then + ! wgtIdef = 'scalar'//C_NULL_CHAR + ierr = iMOAB_ApplyScalarProjectionWeights ( mapper%intx_mbid, mapper%weight_identifier, fldlist_moab, fldlist_moab) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in applying weights ' + call shr_sys_abort(subname//' ERROR in applying weights') + endif + endif +#endif end if +#ifdef HAVE_MOAB + if ( valid_moab_context ) then + deallocate(fldlist_moab) + endif +#endif + end subroutine seq_map_map !======================================================================= diff --git a/driver-moab/main/seq_map_type_mod.F90 b/driver-moab/main/seq_map_type_mod.F90 index fadf04b8b23c..6f15f4d461b5 100644 --- a/driver-moab/main/seq_map_type_mod.F90 +++ b/driver-moab/main/seq_map_type_mod.F90 @@ -34,15 +34,21 @@ module seq_map_type_mod real(R8), pointer :: clat_d(:) integer(IN) :: mpicom ! mpicom +#ifdef HAVE_MOAB ! MOAB additional members, that store source, target and intx MOAB appids ! these are integers greater than or equal to 0 - ! - ! in general, rearrange can be solved with a parcommgraph, true fv-fv intx with an actual intx - ! and a weight matrix; + ! + ! in general, rearrange can be solved with a parcommgraph, true fv-fv intx with an actual intx + ! and a weight matrix; ! intx appid should be used for one map usually ! source and target app ids also make sense only on the coupler pes integer :: src_mbid, tgt_mbid, intx_mbid + character*32 :: weight_identifier ! 'state' OR 'flux' + integer :: tag_entity_type + integer :: nentities ! +#endif + end type seq_map public seq_map @@ -145,10 +151,12 @@ subroutine seq_map_mapinit(mapper,mpicom) mapper%strategy = "undefined" mapper%mapfile = "undefined" +#ifdef HAVE_MOAB mapper%src_mbid = -1 mapper%tgt_mbid = -1 mapper%intx_mbid = -1 - + mapper%nentities = 0 +#endif end subroutine seq_map_mapinit From 601c2237e404950cee3df879a6e6560f8ce25ab8 Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Wed, 7 Dec 2022 16:41:09 -0600 Subject: [PATCH 208/467] remove some unused tags/definitions and commented code --- driver-moab/main/cplcomp_exchange_mod.F90 | 131 +++++++++------------- driver-moab/main/prep_lnd_mod.F90 | 35 ------ driver-moab/main/prep_ocn_mod.F90 | 37 ------ 3 files changed, 51 insertions(+), 152 deletions(-) diff --git a/driver-moab/main/cplcomp_exchange_mod.F90 b/driver-moab/main/cplcomp_exchange_mod.F90 index 3d6b00635862..4d87a3e7c99e 100644 --- a/driver-moab/main/cplcomp_exchange_mod.F90 +++ b/driver-moab/main/cplcomp_exchange_mod.F90 @@ -1209,84 +1209,55 @@ subroutine cplcomp_moab_Init(comp) if (MPI_COMM_NULL /= mpicom_old ) then ! it means we are on the component pes (ocean) ! write out the mesh file to disk, in parallel #ifdef MOABDEBUG - outfile = 'wholeOcn.h5m'//C_NULL_CHAR - wopts = 'PARALLEL=WRITE_PART'//C_NULL_CHAR - ierr = iMOAB_WriteMesh(MPOID, outfile, wopts) - if (ierr .ne. 0) then - write(logunit,*) subname,' error in writing ocean mesh ' - call shr_sys_abort(subname//' ERROR in writing ocean mesh ') - endif + outfile = 'wholeOcn.h5m'//C_NULL_CHAR + wopts = 'PARALLEL=WRITE_PART'//C_NULL_CHAR + ierr = iMOAB_WriteMesh(MPOID, outfile, wopts) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in writing ocean mesh ' + call shr_sys_abort(subname//' ERROR in writing ocean mesh ') + endif #endif - ! send mesh to coupler - ierr = iMOAB_SendMesh(mpoid, mpicom_join, mpigrp_cplid, id_join, partMethod) - if (ierr .ne. 0) then - write(logunit,*) subname,' error in sending ocean mesh to coupler ' - call shr_sys_abort(subname//' ERROR in sending ocean mesh to coupler ') - endif - - ! define here the tag that will be projected back from atmosphere - ! TODO where do we want to define this? - tagnameProj = 'a2oTbot_proj'//C_NULL_CHAR - tagtype = 1 ! dense, double - numco = 1 ! one value per cell - ierr = iMOAB_DefineTagStorage(mpoid, tagnameProj, tagtype, numco, tagindex ) - ! define more tags - tagnameProj = 'a2oUbot_proj'//C_NULL_CHAR ! U component of velocity - ierr = iMOAB_DefineTagStorage(mpoid, tagnameProj, tagtype, numco, tagindex ) - tagnameProj = 'a2oVbot_proj'//C_NULL_CHAR ! V component of velocity - ierr = iMOAB_DefineTagStorage(mpoid, tagnameProj, tagtype, numco, tagindex ) - if (ierr .ne. 0) then - write(logunit,*) subname,' error in defining tags on ocean comp ' - call shr_sys_abort(subname//' ERROR in defining tags on ocean comp ') - endif + ! send mesh to coupler + ierr = iMOAB_SendMesh(mpoid, mpicom_join, mpigrp_cplid, id_join, partMethod) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in sending ocean mesh to coupler ' + call shr_sys_abort(subname//' ERROR in sending ocean mesh to coupler ') + endif endif if (MPI_COMM_NULL /= mpicom_new ) then ! we are on the coupler pes - appname = "COUPLE_MPASO"//C_NULL_CHAR - ! migrated mesh gets another app id, moab ocean to coupler (mbox) - ierr = iMOAB_RegisterApplication(trim(appname), mpicom_new, id_join, mboxid) - ierr = iMOAB_ReceiveMesh(mboxid, mpicom_join, mpigrp_old, id_old) + appname = "COUPLE_MPASO"//C_NULL_CHAR + ! migrated mesh gets another app id, moab ocean to coupler (mbox) + ierr = iMOAB_RegisterApplication(trim(appname), mpicom_new, id_join, mboxid) + ierr = iMOAB_ReceiveMesh(mboxid, mpicom_join, mpigrp_old, id_old) - ! define here the tag that will be projected from atmosphere - tagnameProj = 'a2oTbot_proj'//C_NULL_CHAR ! temperature - tagtype = 1 ! dense, double - numco = 1 ! one value per cell - ierr = iMOAB_DefineTagStorage(mboxid, tagnameProj, tagtype, numco, tagindex ) - - ! define more tags - tagnameProj = 'a2oUbot_proj'//C_NULL_CHAR ! U component of velocity - ierr = iMOAB_DefineTagStorage(mboxid, tagnameProj, tagtype, numco, tagindex ) - tagnameProj = 'a2oVbot_proj'//C_NULL_CHAR ! V component of velocity - ierr = iMOAB_DefineTagStorage(mboxid, tagnameProj, tagtype, numco, tagindex ) - if (ierr .ne. 0) then - write(logunit,*) subname,' error in defining tags on ocean coupler ' - call shr_sys_abort(subname//' ERROR in defining tags on ocean coupler ') - endif - tagname = trim(seq_flds_o2x_fields)//C_NULL_CHAR - ierr = iMOAB_DefineTagStorage(mboxid, tagname, tagtype, numco, tagindex ) - if (ierr .ne. 0) then - write(logunit,*) subname,' error in defining tags o2x on coupler' - call shr_sys_abort(subname//' ERROR in defining tags o2x on coupler ') - endif - ! need also to define seq_flds_x2o_fields on coupler instance, and on ocean comp instance - tagname = trim(seq_flds_x2o_fields)//C_NULL_CHAR - ierr = iMOAB_DefineTagStorage(mboxid, tagname, tagtype, numco, tagindex ) - if (ierr .ne. 0) then - write(logunit,*) subname,' error in defining tags x2o on coupler' - call shr_sys_abort(subname//' ERROR in defining tags x2o on coupler ') - endif + tagname = trim(seq_flds_o2x_fields)//C_NULL_CHAR + tagtype = 1 ! dense, double + numco = 1 ! one value per cell + ierr = iMOAB_DefineTagStorage(mboxid, tagname, tagtype, numco, tagindex ) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in defining tags o2x on coupler' + call shr_sys_abort(subname//' ERROR in defining tags o2x on coupler ') + endif + ! need also to define seq_flds_x2o_fields on coupler instance, and on ocean comp instance + tagname = trim(seq_flds_x2o_fields)//C_NULL_CHAR + ierr = iMOAB_DefineTagStorage(mboxid, tagname, tagtype, numco, tagindex ) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in defining tags x2o on coupler' + call shr_sys_abort(subname//' ERROR in defining tags x2o on coupler ') + endif #ifdef MOABDEBUG - ! debug test - outfile = 'recMeshOcn.h5m'//C_NULL_CHAR - wopts = ';PARALLEL=WRITE_PART'//C_NULL_CHAR ! - ! write out the mesh file to disk - ierr = iMOAB_WriteMesh(mboxid, trim(outfile), trim(wopts)) - if (ierr .ne. 0) then - write(logunit,*) subname,' error in writing ocean mesh coupler ' - call shr_sys_abort(subname//' ERROR in writing ocean mesh coupler ') - endif + ! debug test + outfile = 'recMeshOcn.h5m'//C_NULL_CHAR + wopts = ';PARALLEL=WRITE_PART'//C_NULL_CHAR ! + ! write out the mesh file to disk + ierr = iMOAB_WriteMesh(mboxid, trim(outfile), trim(wopts)) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in writing ocean mesh coupler ' + call shr_sys_abort(subname//' ERROR in writing ocean mesh coupler ') + endif #endif endif if (mpoid .ge. 0) then ! we are on component ocn pes @@ -1302,18 +1273,18 @@ subroutine cplcomp_moab_Init(comp) ! would appear twice on original mboxid, once from xao states, once from o2x states id_join = id_join + 1000! kind of random if (MPI_COMM_NULL /= mpicom_old ) then ! it means we are on the component pes (ocean) - ! send mesh to coupler, the second time! a copy would be cheaper - ierr = iMOAB_SendMesh(mpoid, mpicom_join, mpigrp_cplid, id_join, partMethod) - if (ierr .ne. 0) then - write(logunit,*) subname,' error in sending ocean mesh to coupler the second time' - call shr_sys_abort(subname//' ERROR in sending ocean mesh to coupler the second time ') - endif + ! send mesh to coupler, the second time! a copy would be cheaper + ierr = iMOAB_SendMesh(mpoid, mpicom_join, mpigrp_cplid, id_join, partMethod) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in sending ocean mesh to coupler the second time' + call shr_sys_abort(subname//' ERROR in sending ocean mesh to coupler the second time ') + endif endif if (MPI_COMM_NULL /= mpicom_new ) then ! we are on the coupler pes - appname = "COUPLE_MPASOF"//C_NULL_CHAR - ! migrated mesh gets another app id, moab ocean to coupler (mbox) - ierr = iMOAB_RegisterApplication(trim(appname), mpicom_new, id_join, mbofxid) - ierr = iMOAB_ReceiveMesh(mbofxid, mpicom_join, mpigrp_old, id_old) + appname = "COUPLE_MPASOF"//C_NULL_CHAR + ! migrated mesh gets another app id, moab ocean to coupler (mbox) + ierr = iMOAB_RegisterApplication(trim(appname), mpicom_new, id_join, mbofxid) + ierr = iMOAB_ReceiveMesh(mbofxid, mpicom_join, mpigrp_old, id_old) endif if (mpoid .ge. 0) then ! we are on component ocn pes again, release buffers diff --git a/driver-moab/main/prep_lnd_mod.F90 b/driver-moab/main/prep_lnd_mod.F90 index 5eab97408acb..b21b6fd624c9 100644 --- a/driver-moab/main/prep_lnd_mod.F90 +++ b/driver-moab/main/prep_lnd_mod.F90 @@ -776,41 +776,6 @@ subroutine prep_lnd_migrate_moab(infodata) ! how to get mpicomm for joint ocn + coupler id_join = lnd(1)%cplcompid lndid1 = lnd(1)%compid -! call seq_comm_getinfo(ID_join,mpicom=mpicom_join) -! context_id = -1 -! ! now send the tag a2oTbot_proj, a2oUbot_proj, a2oVbot_proj from ocn on coupler pes towards original ocean mesh -! tagName = 'a2lTbot_proj:a2lUbot_proj:a2lVbot_proj:'//C_NULL_CHAR ! defined in prep_atm_mod.F90!!! - -! if (mblxid .ge. 0) then ! send because we are on coupler pes - -! ! basically, use the initial partitioning -! context_id = lndid1 -! ierr = iMOAB_SendElementTag(mblxid, tagName, mpicom_join, context_id) - -! endif -! if (mlnid .ge. 0 ) then ! we are on land pes, for sure -! ! receive on land pes, a tag that was computed on coupler pes -! context_id = id_join -! ierr = iMOAB_ReceiveElementTag(mlnid, tagName, mpicom_join, context_id) -! !CHECKRC(ierr, "cannot receive tag values") -! endif - -! ! we can now free the sender buffers -! if (mblxid .ge. 0) then -! context_id = lndid1 -! ierr = iMOAB_FreeSenderBuffers(mblxid, context_id) -! ! CHECKRC(ierr, "cannot free buffers used to send projected tag towards the ocean mesh") -! endif - -! #ifdef MOABDEBUG -! if (mlnid .ge. 0 ) then ! we are on land pes, for sure -! number_calls = number_calls + 1 -! write(lnum,"(I0.2)") number_calls -! outfile = 'wholeLND_proj'//trim(lnum)//'.h5m'//C_NULL_CHAR -! wopts = ';PARALLEL=WRITE_PART'//C_NULL_CHAR ! -! ierr = iMOAB_WriteMesh(mlnid, trim(outfile), trim(wopts)) -! endif -! #endif end subroutine prep_lnd_migrate_moab diff --git a/driver-moab/main/prep_ocn_mod.F90 b/driver-moab/main/prep_ocn_mod.F90 index b3c4a7c1009b..d6147142f7a6 100644 --- a/driver-moab/main/prep_ocn_mod.F90 +++ b/driver-moab/main/prep_ocn_mod.F90 @@ -2657,43 +2657,6 @@ subroutine prep_ocn_migrate_moab(infodata) ! how to get mpicomm for joint ocn + coupler id_join = ocn(1)%cplcompid ocnid1 = ocn(1)%compid -! call seq_comm_getinfo(ID_join,mpicom=mpicom_join) -! context_id = -1 -! ! now send the tag a2oTbot_proj, a2oUbot_proj, a2oVbot_proj from ocn on coupler pes towards original ocean mesh -! tagName = 'a2oTbot_proj:a2oUbot_proj:a2oVbot_proj:'//C_NULL_CHAR ! defined in prep_atm_mod.F90!!! - -! if (mboxid .ge. 0) then ! send because we are on coupler pes - -! ! basically, use the initial partitioning -! context_id = ocnid1 -! ierr = iMOAB_SendElementTag(mboxid, tagName, mpicom_join, context_id) - -! endif -! if (mpoid .ge. 0 ) then ! we are on ocean pes, for sure -! ! receive on ocean pes, a tag that was computed on coupler pes -! context_id = id_join -! ierr = iMOAB_ReceiveElementTag(mpoid, tagName, mpicom_join, context_id) -! !CHECKRC(ierr, "cannot receive tag values") -! endif - -! ! we can now free the sender buffers -! if (mboxid .ge. 0) then -! context_id = ocnid1 -! ierr = iMOAB_FreeSenderBuffers(mboxid, context_id) -! ! CHECKRC(ierr, "cannot free buffers used to send projected tag towards the ocean mesh") -! endif - -! #ifdef MOABDEBUG -! if (mpoid .ge. 0 ) then ! we are on ocean pes, for sure -! number_proj = number_proj+1 ! count the number of projections -! write(lnum,"(I0.2)") number_proj -! outfile = 'wholeMPAS_proj'//trim(lnum)//'.h5m'//C_NULL_CHAR -! wopts = ';PARALLEL=WRITE_PART'//C_NULL_CHAR ! -! ierr = iMOAB_WriteMesh(mpoid, trim(outfile), trim(wopts)) - -! !CHECKRC(ierr, "cannot receive tag values") -! endif -! #endif end subroutine prep_ocn_migrate_moab From 88377db80ebe5ea3682bc054b1ecde92472eeb40 Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Thu, 8 Dec 2022 17:24:42 -0600 Subject: [PATCH 209/467] start 2-hop projection of ocn to atm --- driver-moab/main/cplcomp_exchange_mod.F90 | 27 +-------- driver-moab/main/prep_atm_mod.F90 | 68 ++++++++++++++++++++++- 2 files changed, 68 insertions(+), 27 deletions(-) diff --git a/driver-moab/main/cplcomp_exchange_mod.F90 b/driver-moab/main/cplcomp_exchange_mod.F90 index 4d87a3e7c99e..5292d7766631 100644 --- a/driver-moab/main/cplcomp_exchange_mod.F90 +++ b/driver-moab/main/cplcomp_exchange_mod.F90 @@ -1313,17 +1313,6 @@ subroutine cplcomp_moab_Init(comp) write(logunit,*) subname,' error in sending land mesh ' call shr_sys_abort(subname//' ERROR in sending land mesh ') endif - ! create the receiver on land mesh too: - tagnameProj = 'a2lTbot_proj'//C_NULL_CHAR ! temperature - tagtype = 1 ! dense, double - numco = 1 ! one value per vertex / entity - ierr = iMOAB_DefineTagStorage(mlnid, tagnameProj, tagtype, numco, tagindex ) - - ! define more tags - tagnameProj = 'a2lUbot_proj'//C_NULL_CHAR ! U component of velocity - ierr = iMOAB_DefineTagStorage(mlnid, tagnameProj, tagtype, numco, tagindex ) - tagnameProj = 'a2lVbot_proj'//C_NULL_CHAR ! V component of velocity - ierr = iMOAB_DefineTagStorage(mlnid, tagnameProj, tagtype, numco, tagindex ) endif if (MPI_COMM_NULL /= mpicom_new ) then ! we are on the coupler pes @@ -1339,21 +1328,7 @@ subroutine cplcomp_moab_Init(comp) write(logunit,*) subname,' error in receiving coupler land mesh' call shr_sys_abort(subname//' ERROR in receiving coupler land mesh') endif - ! define here the tag that will be projected from atmosphere - tagnameProj = 'a2lTbot_proj'//C_NULL_CHAR ! temperature - tagtype = 1 ! dense, double - numco = 1 ! one value per vertex / entity - ierr = iMOAB_DefineTagStorage(mblxid, tagnameProj, tagtype, numco, tagindex ) - - ! define more tags - tagnameProj = 'a2lUbot_proj'//C_NULL_CHAR ! U component of velocity - ierr = iMOAB_DefineTagStorage(mblxid, tagnameProj, tagtype, numco, tagindex ) - tagnameProj = 'a2lVbot_proj'//C_NULL_CHAR ! V component of velocity - ierr = iMOAB_DefineTagStorage(mblxid, tagnameProj, tagtype, numco, tagindex ) - if (ierr .ne. 0) then - write(logunit,*) subname,' error in defining tags on land coupler' - call shr_sys_abort(subname//' ERROR in defining tags on land coupler') - endif + #ifdef MOABDEBUG ! debug test ! if only vertices, set a partition tag for help in visualizations diff --git a/driver-moab/main/prep_atm_mod.F90 b/driver-moab/main/prep_atm_mod.F90 index 96511eca478e..e8ee9cfba720 100644 --- a/driver-moab/main/prep_atm_mod.F90 +++ b/driver-moab/main/prep_atm_mod.F90 @@ -105,7 +105,7 @@ module prep_atm_mod subroutine prep_atm_init(infodata, ocn_c2_atm, ice_c2_atm, lnd_c2_atm, iac_c2_atm) use iMOAB, only: iMOAB_ComputeMeshIntersectionOnSphere, iMOAB_RegisterApplication, & - iMOAB_WriteMesh + iMOAB_WriteMesh , iMOAB_ComputeCommGraph, iMOAB_ComputeScalarProjectionWeights !--------------------------------------------------------------- ! Description ! Initialize module attribute vectors and mappers @@ -135,6 +135,16 @@ subroutine prep_atm_init(infodata, ocn_c2_atm, ice_c2_atm, lnd_c2_atm, iac_c2_at character(*), parameter :: F00 = "('"//subname//" : ', 4A )" integer ierr, idintx, rank character*32 :: appname, outfile, wopts, lnum + + ! MOAB stuff + character*32 :: dm1, dm2, dofnameS, dofnameT, wgtIdef + integer :: orderS, orderT, volumetric, noConserve, validate, fInverseDistanceMap + integer :: fNoBubble, monotonicity + ! will do comm graph over coupler PES, in 2-hop strategy + integer :: mpigrp_CPLID ! coupler pes group, used for comm graph phys <-> atm-ocn + + integer :: type1, type2 ! type for computing graph; should be the same type for ocean, 3 (FV) + !--------------------------------------------------------------- @@ -193,6 +203,7 @@ subroutine prep_atm_init(infodata, ocn_c2_atm, ice_c2_atm, lnd_c2_atm, iac_c2_at 'seq_maps.rc','ocn2atm_smapname:','ocn2atm_smaptype:',samegrid_ao, & 'mapper_So2a initialization',esmf_map_flag) +#ifdef HAVE_MOAB ! Call moab intx only if atm and ocn are init in moab if ((mbaxid .ge. 0) .and. (mboxid .ge. 0)) then appname = "OCN_ATM_COU"//C_NULL_CHAR @@ -211,6 +222,58 @@ subroutine prep_atm_init(infodata, ocn_c2_atm, ice_c2_atm, lnd_c2_atm, iac_c2_at if (iamroot_CPLID) then write(logunit,*) 'iMOAB intersection between ocean and atm with id:', idintx end if + + + ! we also need to compute the comm graph for the second hop, from the ocn on coupler to the + ! ocean for the intx ocean-atm context (coverage) + ! + call seq_comm_getinfo(CPLID ,mpigrp=mpigrp_CPLID) + type1 = 3; ! fv for ocean + type2 = 3; + ! ierr = iMOAB_ComputeCommGraph( mboxid, mbintxoa, &mpicom_CPLID, &mpigrp_CPLID, &mpigrp_CPLID, &type1, &type2, + ! &ocn_id, &idintx) + ierr = iMOAB_ComputeCommGraph( mboxid, mbintxoa, mpicom_CPLID, mpigrp_CPLID, mpigrp_CPLID, type1, type2, & + ocn(1)%cplcompid, idintx) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in computing comm graph for second hop, ocn-atm' + call shr_sys_abort(subname//' ERROR in computing comm graph for second hop, ocn-atm') + endif + ! now take care of the mapper + mapper_So2a%src_mbid = mboxid + mapper_So2a%tgt_mbid = mbaxid + !mapper_So2a%intx_mbid = mbintxoa ! comment out so it will do nothing yet + + volumetric = 0 ! can be 1 only for FV->DGLL or FV->CGLL; + wgtIdef = 'scalar'//C_NULL_CHAR + if (atm_pg_active) then + dm2 = "fv"//C_NULL_CHAR + dofnameT="GLOBAL_ID"//C_NULL_CHAR + orderT = 1 ! fv-fv + else + dm2 = "cgll"//C_NULL_CHAR + dofnameT="GLOBAL_DOFS"//C_NULL_CHAR + orderT = np ! it should be 4 + endif + dm1 = "fv"//C_NULL_CHAR + dofnameS="GLOBAL_ID"//C_NULL_CHAR + orderS = 1 ! not much arguing + fNoBubble = 1 + monotonicity = 0 ! + noConserve = 0 + validate = 1 + fInverseDistanceMap = 0 + + ierr = iMOAB_ComputeScalarProjectionWeights ( mbintxoa, wgtIdef, & + trim(dm1), orderS, trim(dm2), orderT, & + fNoBubble, monotonicity, volumetric, fInverseDistanceMap, & + noConserve, validate, & + trim(dofnameS), trim(dofnameT) ) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in computing ' + call shr_sys_abort(subname//' ERROR in writing intx file ') + endif + + #ifdef MOABDEBUG wopts = C_NULL_CHAR call shr_mpi_commrank( mpicom_CPLID, rank ) @@ -223,7 +286,10 @@ subroutine prep_atm_init(infodata, ocn_c2_atm, ice_c2_atm, lnd_c2_atm, iac_c2_at call shr_sys_abort(subname//' ERROR in writing intx file ') endif endif +! endif for MOABDEBUG #endif +! endif for HAVE_MOAB +#endif end if end if From e87ce4b4c75b9a0eeed020a9fb5ab9cd7de60d1c Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Thu, 8 Dec 2022 22:48:01 -0600 Subject: [PATCH 210/467] skip for now --- driver-moab/main/seq_map_mod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/driver-moab/main/seq_map_mod.F90 b/driver-moab/main/seq_map_mod.F90 index 133cf02177de..8cee4d7eb5dd 100644 --- a/driver-moab/main/seq_map_mod.F90 +++ b/driver-moab/main/seq_map_mod.F90 @@ -365,7 +365,7 @@ subroutine seq_map_map( mapper, av_s, av_d, fldlist, norm, avwts_s, avwtsfld_s, #ifdef HAVE_MOAB ! check whether the application ID is defined on the current process - if ( mapper%src_mbid .lt. 0 .or. mapper%tgt_mbid .lt. 0 ) then + if ( mapper%src_mbid .lt. 0 .or. mapper%tgt_mbid .lt. 0 .or. mapper%intx_mbid .lt.0 ) then valid_moab_context = .FALSE. else valid_moab_context = .TRUE. From f6f719d908f91ff28311575c41f95b70adaaa4d5 Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Tue, 13 Dec 2022 00:23:34 -0600 Subject: [PATCH 211/467] add second hop send/receive in mapper the comm graph is computed in prep_atm, init, it is between ocean on coupler and intx ocn-atm on coupler; it involves only the coupler MPI comm and MPI group --- driver-moab/main/prep_atm_mod.F90 | 18 ++++++++--- driver-moab/main/seq_map_mod.F90 | 43 +++++++++++++++++++-------- driver-moab/main/seq_map_type_mod.F90 | 2 +- 3 files changed, 46 insertions(+), 17 deletions(-) diff --git a/driver-moab/main/prep_atm_mod.F90 b/driver-moab/main/prep_atm_mod.F90 index e8ee9cfba720..ea622ed7fefd 100644 --- a/driver-moab/main/prep_atm_mod.F90 +++ b/driver-moab/main/prep_atm_mod.F90 @@ -228,7 +228,7 @@ subroutine prep_atm_init(infodata, ocn_c2_atm, ice_c2_atm, lnd_c2_atm, iac_c2_at ! ocean for the intx ocean-atm context (coverage) ! call seq_comm_getinfo(CPLID ,mpigrp=mpigrp_CPLID) - type1 = 3; ! fv for ocean + type1 = 3; ! fv for ocean and atm; fv-cgll does not work anyway type2 = 3; ! ierr = iMOAB_ComputeCommGraph( mboxid, mbintxoa, &mpicom_CPLID, &mpigrp_CPLID, &mpigrp_CPLID, &type1, &type2, ! &ocn_id, &idintx) @@ -241,10 +241,14 @@ subroutine prep_atm_init(infodata, ocn_c2_atm, ice_c2_atm, lnd_c2_atm, iac_c2_at ! now take care of the mapper mapper_So2a%src_mbid = mboxid mapper_So2a%tgt_mbid = mbaxid - !mapper_So2a%intx_mbid = mbintxoa ! comment out so it will do nothing yet + mapper_So2a%intx_mbid = mbintxoa + mapper_So2a%src_context = ocn(1)%cplcompid + mapper_So2a%intx_context = idintx + wgtIdef = 'scalar'//C_NULL_CHAR + mapper_So2a%weight_identifier = wgtIdef volumetric = 0 ! can be 1 only for FV->DGLL or FV->CGLL; - wgtIdef = 'scalar'//C_NULL_CHAR + if (atm_pg_active) then dm2 = "fv"//C_NULL_CHAR dofnameT="GLOBAL_ID"//C_NULL_CHAR @@ -262,7 +266,13 @@ subroutine prep_atm_init(infodata, ocn_c2_atm, ice_c2_atm, lnd_c2_atm, iac_c2_at noConserve = 0 validate = 1 fInverseDistanceMap = 0 - + if (iamroot_CPLID) then + write(logunit,*) subname, 'launch iMOAB weights with args ', 'mbintxoa=', mbintxoa, ' wgtIdef=', wgtIdef, & + 'dm1=', trim(dm1), ' orderS=', orderS, 'dm2=', trim(dm2), ' orderT=', orderT, & + fNoBubble, monotonicity, volumetric, fInverseDistanceMap, & + noConserve, validate, & + trim(dofnameS), trim(dofnameT) + end if ierr = iMOAB_ComputeScalarProjectionWeights ( mbintxoa, wgtIdef, & trim(dm1), orderS, trim(dm2), orderT, & fNoBubble, monotonicity, volumetric, fInverseDistanceMap, & diff --git a/driver-moab/main/seq_map_mod.F90 b/driver-moab/main/seq_map_mod.F90 index 8cee4d7eb5dd..c528fc0cd9fc 100644 --- a/driver-moab/main/seq_map_mod.F90 +++ b/driver-moab/main/seq_map_mod.F90 @@ -12,7 +12,7 @@ module seq_map_mod !--------------------------------------------------------------------- use shr_kind_mod ,only: R8 => SHR_KIND_R8, IN=>SHR_KIND_IN - use shr_kind_mod ,only: CL => SHR_KIND_CL, CX => SHR_KIND_CX + use shr_kind_mod ,only: CL => SHR_KIND_CL, CX => SHR_KIND_CX, CXX => SHR_KIND_CXX use shr_sys_mod use shr_const_mod use shr_mct_mod, only: shr_mct_sMatPInitnc, shr_mct_queryConfigFile @@ -306,7 +306,8 @@ subroutine seq_map_map( mapper, av_s, av_d, fldlist, norm, avwts_s, avwtsfld_s, use iso_c_binding use iMOAB, only: iMOAB_GetMeshInfo, iMOAB_GetDoubleTagStorage, iMOAB_SetDoubleTagStorage, & - iMOAB_GetIntTagStorage, iMOAB_SetDoubleTagStorageWithGid, iMOAB_ApplyScalarProjectionWeights + iMOAB_GetIntTagStorage, iMOAB_SetDoubleTagStorageWithGid, iMOAB_ApplyScalarProjectionWeights, & + iMOAB_SendElementTag, iMOAB_ReceiveElementTag implicit none !----------------------------------------------------- @@ -325,7 +326,7 @@ subroutine seq_map_map( mapper, av_s, av_d, fldlist, norm, avwts_s, avwtsfld_s, #ifdef HAVE_MOAB logical :: valid_moab_context integer :: ierr, nfields, ntagdatalength - character, dimension(:), allocatable :: fldlist_moab + character(len=CXX) :: fldlist_moab integer :: nvert(3), nvise(3), nbl(3), nsurf(3), nvisBC(3) ! for moab info type(mct_list) :: temp_list integer, dimension(:), allocatable :: globalIds @@ -392,12 +393,11 @@ subroutine seq_map_map( mapper, av_s, av_d, fldlist, norm, avwts_s, avwtsfld_s, call mct_list_init(temp_list, fldlist) nfields=mct_list_nitem (temp_list) call mct_list_clean(temp_list) - allocate(fldlist_moab(len(fldlist))) - fldlist_moab(:) = fldlist(:) + fldlist_moab= trim(fldlist)//C_NULL_CHAR else ! Extract character strings from attribute vector nfields = mct_aVect_nRAttr(av_s) - fldlist_moab = mct_aVect_exportRList2c(av_s) + fldlist_moab = trim(mct_aVect_exportRList2c(av_s))//C_NULL_CHAR endif ntagdatalength = nfields * mapper % nentities @@ -512,19 +512,38 @@ subroutine seq_map_map( mapper, av_s, av_d, fldlist, norm, avwts_s, avwtsfld_s, #ifdef HAVE_MOAB if ( valid_moab_context ) then + ! first have to do the second hop, iMOAB_ComputeCommGraph( src_mbid, intx_mbid, ! wgtIdef = 'scalar'//C_NULL_CHAR + ! + + ierr = iMOAB_SendElementTag( mapper%src_mbid, fldlist_moab, mapper%mpicom,mapper%intx_context ); + if (ierr .ne. 0) then + write(logunit,*) subname,' error in sending tags ', fldlist_moab + ! call shr_sys_abort(subname//' ERROR in sending tags') + valid_moab_context = .false. + endif + endif + if ( valid_moab_context ) then + ierr = iMOAB_ReceiveElementTag( mapper%tgt_mbid, fldlist_moab, mapper%mpicom,mapper%src_context ); + if (ierr .ne. 0) then + write(logunit,*) subname,' error in receiving tags ', fldlist_moab + !call shr_sys_abort(subname//' ERROR in receiving tags') + valid_moab_context = .false. + endif + endif + if ( valid_moab_context ) then ierr = iMOAB_ApplyScalarProjectionWeights ( mapper%intx_mbid, mapper%weight_identifier, fldlist_moab, fldlist_moab) - if (ierr .ne. 0) then - write(logunit,*) subname,' error in applying weights ' - call shr_sys_abort(subname//' ERROR in applying weights') - endif + if (ierr .ne. 0) then + write(logunit,*) subname,' error in applying weights ' + call shr_sys_abort(subname//' ERROR in applying weights') + endif endif #endif - end if + endif #ifdef HAVE_MOAB if ( valid_moab_context ) then - deallocate(fldlist_moab) + endif #endif diff --git a/driver-moab/main/seq_map_type_mod.F90 b/driver-moab/main/seq_map_type_mod.F90 index 6f15f4d461b5..e30aad33bbb9 100644 --- a/driver-moab/main/seq_map_type_mod.F90 +++ b/driver-moab/main/seq_map_type_mod.F90 @@ -42,7 +42,7 @@ module seq_map_type_mod ! and a weight matrix; ! intx appid should be used for one map usually ! source and target app ids also make sense only on the coupler pes - integer :: src_mbid, tgt_mbid, intx_mbid + integer :: src_mbid, tgt_mbid, intx_mbid, src_context, intx_context character*32 :: weight_identifier ! 'state' OR 'flux' integer :: tag_entity_type integer :: nentities From dda5c5cbffde4758c8b7efcb1969a40739102ebc Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Wed, 14 Dec 2022 07:24:32 -0600 Subject: [PATCH 212/467] define o2x fields on coupler atm to be able to do projection o2a --- driver-moab/main/prep_atm_mod.F90 | 19 +++++++++++++++++- driver-moab/main/seq_frac_mct.F90 | 2 +- driver-moab/main/seq_map_mod.F90 | 29 ++++++++++++++++++++++----- driver-moab/main/seq_map_type_mod.F90 | 2 +- 4 files changed, 44 insertions(+), 8 deletions(-) diff --git a/driver-moab/main/prep_atm_mod.F90 b/driver-moab/main/prep_atm_mod.F90 index ea622ed7fefd..2f0d74a49d02 100644 --- a/driver-moab/main/prep_atm_mod.F90 +++ b/driver-moab/main/prep_atm_mod.F90 @@ -105,7 +105,8 @@ module prep_atm_mod subroutine prep_atm_init(infodata, ocn_c2_atm, ice_c2_atm, lnd_c2_atm, iac_c2_atm) use iMOAB, only: iMOAB_ComputeMeshIntersectionOnSphere, iMOAB_RegisterApplication, & - iMOAB_WriteMesh , iMOAB_ComputeCommGraph, iMOAB_ComputeScalarProjectionWeights + iMOAB_WriteMesh , iMOAB_ComputeCommGraph, iMOAB_ComputeScalarProjectionWeights, & + iMOAB_DefineTagStorage !--------------------------------------------------------------- ! Description ! Initialize module attribute vectors and mappers @@ -144,6 +145,8 @@ subroutine prep_atm_init(infodata, ocn_c2_atm, ice_c2_atm, lnd_c2_atm, iac_c2_at integer :: mpigrp_CPLID ! coupler pes group, used for comm graph phys <-> atm-ocn integer :: type1, type2 ! type for computing graph; should be the same type for ocean, 3 (FV) + integer :: tagtype, numco, tagindex + character(CXX) :: tagName !--------------------------------------------------------------- @@ -246,6 +249,20 @@ subroutine prep_atm_init(infodata, ocn_c2_atm, ice_c2_atm, lnd_c2_atm, iac_c2_at mapper_So2a%intx_context = idintx wgtIdef = 'scalar'//C_NULL_CHAR mapper_So2a%weight_identifier = wgtIdef + ! because we will project fields from ocean to atm phys grid, we need to define + ! ocean o2x fields to atm phys grid (or atm spectral ext ) on coupler side + if (atm_pg_active) then + tagname = trim(seq_flds_o2x_fields)//C_NULL_CHAR + tagtype = 1 ! dense + numco = 1 ! + ierr = iMOAB_DefineTagStorage(mbaxid, tagname, tagtype, numco, tagindex ) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in defining tags for seq_flds_o2x_fields' + call shr_sys_abort(subname//' ERROR in coin defining tags for seq_flds_o2x_fields') + endif + else ! spectral case, fix later + + endif volumetric = 0 ! can be 1 only for FV->DGLL or FV->CGLL; diff --git a/driver-moab/main/seq_frac_mct.F90 b/driver-moab/main/seq_frac_mct.F90 index 3904d56f2bd5..298ed3678f2a 100644 --- a/driver-moab/main/seq_frac_mct.F90 +++ b/driver-moab/main/seq_frac_mct.F90 @@ -694,7 +694,7 @@ subroutine seq_frac_init( infodata, & deallocate(tagValues) endif else - ! stil need to TODO moab case + ! still need to TODO moab case ko = mct_aVect_indexRa(fractions_o,"ofrac",perrWith=subName) kf = mct_aVect_indexRA(dom_o%data ,"frac" ,perrWith=subName) fractions_o%rAttr(ko,:) = dom_o%data%rAttr(kf,:) diff --git a/driver-moab/main/seq_map_mod.F90 b/driver-moab/main/seq_map_mod.F90 index c528fc0cd9fc..ad44178d854c 100644 --- a/driver-moab/main/seq_map_mod.F90 +++ b/driver-moab/main/seq_map_mod.F90 @@ -401,6 +401,11 @@ subroutine seq_map_map( mapper, av_s, av_d, fldlist, norm, avwts_s, avwtsfld_s, endif ntagdatalength = nfields * mapper % nentities + if (seq_comm_iamroot(CPLID)) then + write(logunit,*) subname,' iMOAB_mapper nfields', & + nfields, ' fldlist_moab=', trim(fldlist_moab) + call shr_sys_flush(logunit) + endif endif ! valid_moab_context #endif @@ -457,6 +462,10 @@ subroutine seq_map_map( mapper, av_s, av_d, fldlist, norm, avwts_s, avwtsfld_s, ! first get data from source tag and store in a temporary ! then set it back to target tag to mimic a copy allocate(moab_tag_data(ntagdatalength)) + if (seq_comm_iamroot(CPLID)) then + write(logunit, *) subname,' iMOAB_mapper rearrange context TODO fix parcommgraph' + call shr_sys_flush(logunit) + endif allocate(globalIds(mapper % nentities)) ierr = iMOAB_GetIntTagStorage( mapper%src_mbid, & @@ -467,6 +476,7 @@ subroutine seq_map_map( mapper, av_s, av_d, fldlist, norm, avwts_s, avwtsfld_s, if (ierr > 0 ) & call shr_sys_abort( subname//'MOAB Error: failed to get GLOBAL_ID tag ') + ! this should set up a par comm graph in init, not use this ierr = iMOAB_GetDoubleTagStorage( mapper%src_mbid, & fldlist_moab, & ntagdatalength, & @@ -515,20 +525,29 @@ subroutine seq_map_map( mapper, av_s, av_d, fldlist, norm, avwts_s, avwtsfld_s, ! first have to do the second hop, iMOAB_ComputeCommGraph( src_mbid, intx_mbid, ! wgtIdef = 'scalar'//C_NULL_CHAR ! - + if (seq_comm_iamroot(CPLID)) then + write(logunit, *) subname,' iMOAB mapper before sending ', trim(fldlist_moab) + call shr_sys_flush(logunit) + endif ierr = iMOAB_SendElementTag( mapper%src_mbid, fldlist_moab, mapper%mpicom,mapper%intx_context ); if (ierr .ne. 0) then - write(logunit,*) subname,' error in sending tags ', fldlist_moab - ! call shr_sys_abort(subname//' ERROR in sending tags') + if (seq_comm_iamroot(CPLID)) then + write(logunit, *) subname,' iMOAB mapper error in sending tags ', trim(fldlist_moab) + call shr_sys_flush(logunit) + endif valid_moab_context = .false. endif endif if ( valid_moab_context ) then + if (seq_comm_iamroot(CPLID)) then + write(logunit, *) subname,' iMOAB mapper before receiving ', trim(fldlist_moab) + call shr_sys_flush(logunit) + endif ierr = iMOAB_ReceiveElementTag( mapper%tgt_mbid, fldlist_moab, mapper%mpicom,mapper%src_context ); if (ierr .ne. 0) then - write(logunit,*) subname,' error in receiving tags ', fldlist_moab + write(logunit,*) subname,' error in receiving tags ', trim(fldlist_moab) !call shr_sys_abort(subname//' ERROR in receiving tags') - valid_moab_context = .false. + valid_moab_context = .false. ! do not attempt to project endif endif if ( valid_moab_context ) then diff --git a/driver-moab/main/seq_map_type_mod.F90 b/driver-moab/main/seq_map_type_mod.F90 index e30aad33bbb9..998df9a526ad 100644 --- a/driver-moab/main/seq_map_type_mod.F90 +++ b/driver-moab/main/seq_map_type_mod.F90 @@ -45,7 +45,7 @@ module seq_map_type_mod integer :: src_mbid, tgt_mbid, intx_mbid, src_context, intx_context character*32 :: weight_identifier ! 'state' OR 'flux' integer :: tag_entity_type - integer :: nentities + integer :: nentities ! this should be used only if copy_only is true ! #endif From a46e4dc2fd0c50779a5785de3864c30bef3b6710 Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Wed, 14 Dec 2022 10:56:52 -0600 Subject: [PATCH 213/467] receive in the intx appid in seq_map_map --- driver-moab/main/seq_map_mod.F90 | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/driver-moab/main/seq_map_mod.F90 b/driver-moab/main/seq_map_mod.F90 index ad44178d854c..69e3d0e8fb42 100644 --- a/driver-moab/main/seq_map_mod.F90 +++ b/driver-moab/main/seq_map_mod.F90 @@ -400,7 +400,6 @@ subroutine seq_map_map( mapper, av_s, av_d, fldlist, norm, avwts_s, avwtsfld_s, fldlist_moab = trim(mct_aVect_exportRList2c(av_s))//C_NULL_CHAR endif - ntagdatalength = nfields * mapper % nentities if (seq_comm_iamroot(CPLID)) then write(logunit,*) subname,' iMOAB_mapper nfields', & nfields, ' fldlist_moab=', trim(fldlist_moab) @@ -423,6 +422,7 @@ subroutine seq_map_map( mapper, av_s, av_d, fldlist, norm, avwts_s, avwtsfld_s, if ( valid_moab_context ) then ! first get data from source tag and store in a temporary ! then set it back to target tag to mimic a copy + ntagdatalength = nfields * mapper % nentities allocate(moab_tag_data(ntagdatalength)) ierr = iMOAB_GetDoubleTagStorage( mapper%src_mbid, & @@ -543,7 +543,8 @@ subroutine seq_map_map( mapper, av_s, av_d, fldlist, norm, avwts_s, avwtsfld_s, write(logunit, *) subname,' iMOAB mapper before receiving ', trim(fldlist_moab) call shr_sys_flush(logunit) endif - ierr = iMOAB_ReceiveElementTag( mapper%tgt_mbid, fldlist_moab, mapper%mpicom,mapper%src_context ); + ! receive in the intx app, because it is redistributed according to coverage (trick) + ierr = iMOAB_ReceiveElementTag( mapper%intx_mbid, fldlist_moab, mapper%mpicom,mapper%src_context ); if (ierr .ne. 0) then write(logunit,*) subname,' error in receiving tags ', trim(fldlist_moab) !call shr_sys_abort(subname//' ERROR in receiving tags') From fbec91f04be008204dda85afb652b17a135a40b6 Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Wed, 14 Dec 2022 15:13:28 -0600 Subject: [PATCH 214/467] forgot to free moab buffers in seq_map_map --- driver-moab/main/seq_map_mod.F90 | 12 +++++++++--- 1 file changed, 9 insertions(+), 3 deletions(-) diff --git a/driver-moab/main/seq_map_mod.F90 b/driver-moab/main/seq_map_mod.F90 index 69e3d0e8fb42..5ea6afa0d649 100644 --- a/driver-moab/main/seq_map_mod.F90 +++ b/driver-moab/main/seq_map_mod.F90 @@ -307,7 +307,7 @@ subroutine seq_map_map( mapper, av_s, av_d, fldlist, norm, avwts_s, avwtsfld_s, use iso_c_binding use iMOAB, only: iMOAB_GetMeshInfo, iMOAB_GetDoubleTagStorage, iMOAB_SetDoubleTagStorage, & iMOAB_GetIntTagStorage, iMOAB_SetDoubleTagStorageWithGid, iMOAB_ApplyScalarProjectionWeights, & - iMOAB_SendElementTag, iMOAB_ReceiveElementTag + iMOAB_SendElementTag, iMOAB_ReceiveElementTag, iMOAB_FreeSenderBuffers implicit none !----------------------------------------------------- @@ -529,7 +529,7 @@ subroutine seq_map_map( mapper, av_s, av_d, fldlist, norm, avwts_s, avwtsfld_s, write(logunit, *) subname,' iMOAB mapper before sending ', trim(fldlist_moab) call shr_sys_flush(logunit) endif - ierr = iMOAB_SendElementTag( mapper%src_mbid, fldlist_moab, mapper%mpicom,mapper%intx_context ); + ierr = iMOAB_SendElementTag( mapper%src_mbid, fldlist_moab, mapper%mpicom, mapper%intx_context ); if (ierr .ne. 0) then if (seq_comm_iamroot(CPLID)) then write(logunit, *) subname,' iMOAB mapper error in sending tags ', trim(fldlist_moab) @@ -544,12 +544,18 @@ subroutine seq_map_map( mapper, av_s, av_d, fldlist, norm, avwts_s, avwtsfld_s, call shr_sys_flush(logunit) endif ! receive in the intx app, because it is redistributed according to coverage (trick) - ierr = iMOAB_ReceiveElementTag( mapper%intx_mbid, fldlist_moab, mapper%mpicom,mapper%src_context ); + ierr = iMOAB_ReceiveElementTag( mapper%intx_mbid, fldlist_moab, mapper%mpicom, mapper%src_context ); if (ierr .ne. 0) then write(logunit,*) subname,' error in receiving tags ', trim(fldlist_moab) !call shr_sys_abort(subname//' ERROR in receiving tags') valid_moab_context = .false. ! do not attempt to project endif + ! now free buffers + ierr = iMOAB_FreeSenderBuffers( mapper%src_mbid, mapper%intx_context ) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in freeing buffers ', trim(fldlist_moab) + call shr_sys_abort(subname//' ERROR in freeing buffers') ! serious enough + endif endif if ( valid_moab_context ) then ierr = iMOAB_ApplyScalarProjectionWeights ( mapper%intx_mbid, mapper%weight_identifier, fldlist_moab, fldlist_moab) From 5e4a0eb9c0652bee4ea0c1e0e590567bd63a05af Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Thu, 15 Dec 2022 01:15:33 -0600 Subject: [PATCH 215/467] remove mphaxid replace as necessary with mbaxid; for atm_pg_active, mbaxid will be phys grid pg2 mesh, cells 2x2 on spectral element will communicate between mphaid and mbaxid --- driver-moab/main/cime_comp_mod.F90 | 14 ++--- driver-moab/main/component_mod.F90 | 9 ++-- driver-moab/main/cplcomp_exchange_mod.F90 | 66 ++++------------------- driver-moab/main/prep_aoflux_mod.F90 | 14 ++--- driver-moab/main/prep_ocn_mod.F90 | 64 +++++----------------- driver-moab/main/seq_flux_mct.F90 | 4 +- driver-moab/main/seq_frac_mct.F90 | 46 ++++++++++------ driver-moab/shr/seq_comm_mct.F90 | 2 - 8 files changed, 73 insertions(+), 146 deletions(-) diff --git a/driver-moab/main/cime_comp_mod.F90 b/driver-moab/main/cime_comp_mod.F90 index e2e957d9b5d8..77890488f4b8 100644 --- a/driver-moab/main/cime_comp_mod.F90 +++ b/driver-moab/main/cime_comp_mod.F90 @@ -1394,7 +1394,7 @@ end subroutine cime_pre_init2 subroutine cime_init() use seq_flds_mod , only : seq_flds_x2a_fields, seq_flds_a2x_fields - use seq_comm_mct , only : mphaid, mphaxid ! + use seq_comm_mct , only : mphaid, mbaxid ! #ifdef MOABDEBUG real(r8) :: difference character(20) :: mct_field, tagname @@ -2314,7 +2314,7 @@ subroutine cime_init() call component_exch(atm, flow='x2c', infodata=infodata, & infodata_string='cpl2atm_init') ! moab too - call component_exch_moab(atm(1), mphaxid, mphaid, 1, seq_flds_x2a_fields) + call component_exch_moab(atm(1), mbaxid, mphaid, 1, seq_flds_x2a_fields) endif ! Set atm init phase to 2 for all atm instances on component instance pes @@ -2334,7 +2334,7 @@ subroutine cime_init() call component_exch(atm, flow='c2x', infodata=infodata, & infodata_string='atm2cpl_init') ! - call component_exch_moab(atm(1), mphaid, mphaxid, 0, seq_flds_a2x_fields) + call component_exch_moab(atm(1), mphaid, mbaxid, 0, seq_flds_a2x_fields) if (iamin_CPLID) then if (drv_threading) call seq_comm_setnthreads(nthreads_CPLID) @@ -4002,7 +4002,7 @@ end subroutine cime_run_ocn_albedos subroutine cime_run_atm_setup_send() use seq_flds_mod , only : seq_flds_x2a_fields - use seq_comm_mct , only : mphaid, mphaxid ! + use seq_comm_mct , only : mphaid, mbaxid ! !---------------------------------------------------------- !| atm prep-merge !---------------------------------------------------------- @@ -4055,7 +4055,7 @@ subroutine cime_run_atm_setup_send() timer_barrier='CPL:C2A_BARRIER', timer_comp_exch='CPL:C2A', & timer_map_exch='CPL:c2a_atmx2atmg', timer_infodata_exch='CPL:c2a_infoexch') ! will migrate the tag from coupler pes to component pes, on atm mesh - call component_exch_moab(atm(1), mphaxid, mphaid, 1, seq_flds_x2a_fields) + call component_exch_moab(atm(1), mbaxid, mphaid, 1, seq_flds_x2a_fields) endif end subroutine cime_run_atm_setup_send @@ -4064,7 +4064,7 @@ end subroutine cime_run_atm_setup_send subroutine cime_run_atm_recv_post() use seq_flds_mod , only : seq_flds_a2x_fields - use seq_comm_mct , only : mphaid, mphaxid ! + use seq_comm_mct , only : mphaid, mbaxid ! !---------------------------------------------------------- !| atm -> cpl !---------------------------------------------------------- @@ -4075,7 +4075,7 @@ subroutine cime_run_atm_recv_post() timer_map_exch='CPL:a2c_atma2atmx', timer_infodata_exch='CPL:a2c_infoexch') ! will migrate the tag from component pes to coupler pes, on atm mesh - call component_exch_moab(atm(1), mphaid, mphaxid, 0, seq_flds_a2x_fields) + call component_exch_moab(atm(1), mphaid, mbaxid, 0, seq_flds_a2x_fields) call prep_atm_migrate_moab(infodata) endif diff --git a/driver-moab/main/component_mod.F90 b/driver-moab/main/component_mod.F90 index 0c8ffcb11f7b..a53379c9fe34 100644 --- a/driver-moab/main/component_mod.F90 +++ b/driver-moab/main/component_mod.F90 @@ -1001,10 +1001,13 @@ subroutine component_exch_moab(comp, mbAPPid1, mbAppid2, direction, fields ) source_id = comp%cplcompid target_id = comp%compid endif - ! for atm, add 200 to target and source (see ID_JOIN_ATMPHYS and ID_OLD_ATMPHYS) - if (comp%oneletterid == 'a') then - ! more hacks + ! for atm, add 200 to component side, because we will involve always the point cloud + ! we are not supporting anymore the spectral case, at least for the time being + ! we need to fix fv-cgll projection first + if (comp%oneletterid == 'a' .and. direction .eq. 0 ) then source_id = source_id + 200 + endif + if (comp%oneletterid == 'a' .and. direction .eq. 1 ) then target_id = target_id + 200 endif if (mbAPPid1 .ge. 0) then ! send diff --git a/driver-moab/main/cplcomp_exchange_mod.F90 b/driver-moab/main/cplcomp_exchange_mod.F90 index 5292d7766631..cb69421fb106 100644 --- a/driver-moab/main/cplcomp_exchange_mod.F90 +++ b/driver-moab/main/cplcomp_exchange_mod.F90 @@ -22,7 +22,6 @@ module cplcomp_exchange_mod use seq_comm_mct, only : atm_pg_active ! flag if PG mesh instanced use seq_comm_mct, only : mlnid , mblxid ! iMOAB app id for land , on land pes and coupler pes use seq_comm_mct, only : mphaid ! iMOAB app id for phys atm; comp atm is 5, phys 5+200 - use seq_comm_mct, only : mphaxid ! iMOAB app id for phys atm, on cpl pes use seq_comm_mct, only : MPSIID, mbixid ! sea-ice on comp pes and on coupler pes use seq_comm_mct, only : mrofid, mbrxid ! iMOAB id of moab rof app on comp pes and on coupler too use shr_mpi_mod, only: shr_mpi_max @@ -990,7 +989,7 @@ subroutine cplcomp_moab_Init(comp) ! use iMOAB, only: iMOAB_RegisterApplication, iMOAB_ReceiveMesh, iMOAB_SendMesh, & iMOAB_WriteMesh, iMOAB_DefineTagStorage, iMOAB_GetMeshInfo, & - iMOAB_SetIntTagStorage, iMOAB_FreeSenderBuffers + iMOAB_SetIntTagStorage, iMOAB_FreeSenderBuffers, iMOAB_ComputeCommGraph ! type(component_type), intent(inout) :: comp ! @@ -1116,56 +1115,6 @@ subroutine cplcomp_moab_Init(comp) call shr_sys_abort(subname//' ERROR in freeing send buffers') endif endif - - ! send also the phys grid to coupler, because it will be used for fractions - ! start copy for mphaid->mphaxid - if (MPI_COMM_NULL /= mpicom_old ) then ! it means we are on the component pes (atmosphere) - ID_JOIN_ATMPHYS = id_join + 200 ! somewhat arbitrary, just a different comp id - ierr = iMOAB_SendMesh(mphaid, mpicom_join, mpigrp_cplid, ID_JOIN_ATMPHYS, partMethod) - if (ierr .ne. 0) then - write(logunit,*) subname,' error in sending mesh from atm comp ' - call shr_sys_abort(subname//' ERROR in sending mesh from atm comp') - endif - endif - - if (MPI_COMM_NULL /= mpicom_new ) then ! we are on the coupler pes - appname = "COUPLE_ATMPH"//C_NULL_CHAR - ! migrated mesh gets another app id, moab atm to coupler (mbax) - ID_JOIN_ATMPHYS = id_join + 200 ! somewhat arbitrary, just a different comp id - ierr = iMOAB_RegisterApplication(trim(appname), mpicom_new, ID_JOIN_ATMPHYS, mphaxid) - if (ierr .ne. 0) then - write(logunit,*) subname,' error in registering ', appname - call shr_sys_abort(subname//' ERROR registering '// appname) - endif - ID_OLD_ATMPHYS = id_old + 200 ! kind of arbitrary - ierr = iMOAB_ReceiveMesh(mphaxid, mpicom_join, mpigrp_old, ID_OLD_ATMPHYS) - if (ierr .ne. 0) then - write(logunit,*) subname,' error in receiving mesh on atm coupler ' - call shr_sys_abort(subname//' ERROR in receiving mesh on atm coupler ') - endif -#ifdef MOABDEBUG - ! debug test - - outfile = 'recPhysAtm.h5m'//C_NULL_CHAR - wopts = ';PARALLEL=WRITE_PART'//C_NULL_CHAR - ! write out the mesh file to disk - ierr = iMOAB_WriteMesh(mphaxid, trim(outfile), trim(wopts)) - if (ierr .ne. 0) then - write(logunit,*) subname,' error in writing mesh ' - call shr_sys_abort(subname//' ERROR in writing mesh ') - endif -#endif - endif - ! iMOAB_FreeSenderBuffers needs to be called after receiving the mesh - if (MPI_COMM_NULL /= mpicom_old ) then ! it means we are on the component pes (atmosphere) - context_id = ID_JOIN_ATMPHYS - ierr = iMOAB_FreeSenderBuffers(mphaid, context_id) - - if (ierr .ne. 0) then - write(logunit,*) subname,' error in freeing send buffers ' - call shr_sys_abort(subname//' ERROR in freeing send buffers') - endif - endif @@ -1178,12 +1127,15 @@ subroutine cplcomp_moab_Init(comp) ! &typeA, &typeB, &cmpatm, &physatm); ! graph between atm phys, mphaid, and atm dyn on coupler, mbaxid ! phys atm group is mpigrp_old, coupler group is mpigrp_cplid - !!typeA = 2 ! point cloud - !!typeB = 1 ! spectral elements - !!ATM_PHYS_CID = 200 + id_old ! 200 + 5 for atm, see line 969 ATM_PHYS = 200 + ATMID ! in + typeA = 2 ! point cloud for mphaid + typeB = 1 ! spectral elements + if (atm_pg_active) then + typeB = 3 ! in this case, we will have cells associated with DOFs as GLOBAL_ID tag + endif + ATM_PHYS_CID = 200 + id_old ! 200 + 5 for atm, see line 969 ATM_PHYS = 200 + ATMID ! in ! components/cam/src/cpl/atm_comp_mct.F90 - !!ierr = iMOAB_ComputeCommGraph( mphaid, mbaxid, mpicom_join, mpigrp_old, mpigrp_cplid, & - !! typeA, typeB, ATM_PHYS_CID, id_join) + ierr = iMOAB_ComputeCommGraph( mphaid, mbaxid, mpicom_join, mpigrp_old, mpigrp_cplid, & + typeA, typeB, ATM_PHYS_CID, id_join) ! ID_JOIN is now 6 ! comment out this above part ! we also need to define the tags for receiving the physics data, on atm on coupler pes diff --git a/driver-moab/main/prep_aoflux_mod.F90 b/driver-moab/main/prep_aoflux_mod.F90 index 29dbdca37d15..e6fda2cab757 100644 --- a/driver-moab/main/prep_aoflux_mod.F90 +++ b/driver-moab/main/prep_aoflux_mod.F90 @@ -9,7 +9,7 @@ module prep_aoflux_mod use seq_comm_mct, only: CPLID, logunit use seq_comm_mct, only : mbofxid ! iMOAB app id for ocn on cpl pes, the second copy of mboxid use seq_comm_mct, only : mbox2id ! - use seq_comm_mct, only : mphaxid ! iMOAB app id for atm phys grid on cpl pes + use seq_comm_mct, only : mbaxid ! iMOAB app id for atm on cpl pes use seq_comm_mct, only: seq_comm_getData=>seq_comm_setptrs use seq_infodata_mod, only: seq_infodata_getdata, seq_infodata_type use seq_map_type_mod @@ -204,11 +204,11 @@ subroutine prep_aoflux_init (infodata) endif ! define atm-ocn flux tags on the moab atm mesh - if (mphaxid .ge. 0 ) then ! // + if (mbaxid .ge. 0 ) then ! // tagname = trim(seq_flds_xao_fields)//C_NULL_CHAR tagtype = 1 ! dense, double numco = 1 - ierr = iMOAB_DefineTagStorage(mphaxid, tagname, tagtype, numco, tagindex ) + ierr = iMOAB_DefineTagStorage(mbaxid, tagname, tagtype, numco, tagindex ) if (ierr .ne. 0) then write(logunit,*) subname,' error in defining tags on atm phys mesh on cpl ' call shr_sys_abort(subname//' ERROR in defining tags on atm phys mesh on cpl') @@ -219,13 +219,13 @@ subroutine prep_aoflux_init (infodata) size_list=mct_list_nitem (temp_list) call mct_list_clean(temp_list) ! find out the number of local elements in moab mesh - ierr = iMOAB_GetMeshInfo ( mphaxid, nvert, nvise, nbl, nsurf, nvisBC ); ! could be different of lsize_o + ierr = iMOAB_GetMeshInfo ( mbaxid, nvert, nvise, nbl, nsurf, nvisBC ); ! could be different of lsize_o ! local size of vertices is different from lsize_o - arrSize = nvert(1) * size_list ! there are size_list tags that need to be zeroed out + arrSize = nvise(1) * size_list ! there are size_list tags that need to be zeroed out allocate(tagValues(arrSize) ) - ent_type = 0 ! vertex type + ent_type = 1 ! cell type now, not a point cloud anymore tagValues = 0 - ierr = iMOAB_SetDoubleTagStorage ( mphaxid, tagname, arrSize , ent_type, tagValues) + ierr = iMOAB_SetDoubleTagStorage ( mbaxid, tagname, arrSize , ent_type, tagValues) if (ierr .ne. 0) then write(logunit,*) subname,' error in zeroing out xao_fields ' call shr_sys_abort(subname//' ERROR in zeroing out xao_fields in init ') diff --git a/driver-moab/main/prep_ocn_mod.F90 b/driver-moab/main/prep_ocn_mod.F90 index d6147142f7a6..8e992c2aa751 100644 --- a/driver-moab/main/prep_ocn_mod.F90 +++ b/driver-moab/main/prep_ocn_mod.F90 @@ -20,7 +20,6 @@ module prep_ocn_mod use seq_comm_mct, only : mbaxid ! iMOAB id for atm migrated mesh to coupler pes use seq_comm_mct, only : mbintxao ! iMOAB id for intx mesh between atm and ocean use seq_comm_mct, only : mbintxoa ! iMOAB id for intx mesh between ocean and atmosphere - use seq_comm_mct, only : mphaxid ! iMOAB id for atm phys grid, on cpl pes; it is a point cloud always use seq_comm_mct, only : mhid ! iMOAB id for atm instance use seq_comm_mct, only : mhpgid ! iMOAB id for atm pgx grid, on atm pes; created with se and gll grids use dimensions_mod, only : np ! for atmosphere degree @@ -2713,7 +2712,7 @@ subroutine prep_atm_ocn_moab(infodata) context_id = ocn(1)%cplcompid call seq_comm_getinfo(ID_join,mpicom=mpicom_join) - ! it happens over joint communicator, only if ocn_prognostic true + ! ! it happens over joint communicator, only if ocn_prognostic true if (ocn_prognostic) then if (atm_pg_active ) then ! use mhpgid mesh @@ -2783,67 +2782,30 @@ subroutine prep_atm_ocn_moab(infodata) end if endif ! only if atm and ocn intersect mbintxao >= 0 - ! compute the comm graph between phys atm and intx-atm-ocn, to be able to send directly from phys atm - ! towards coverage mesh on atm for intx to ocean - ! this is similar to imoab_phatm_ocn_coupler.cpp test in moab - ! int typeA = 2; // point cloud - ! int typeB = 1; // quads in coverage set - ! ierr = iMOAB_ComputeCommGraph(cmpPhAtmPID, cplAtmOcnPID, &atmCouComm, &atmPEGroup, &couPEGroup, - ! &typeA, &typeB, &cmpatm, &atmocnid); - call seq_comm_getinfo(CPLID ,mpigrp=mpigrp_CPLID) ! second group, the coupler group CPLID is global variable - call seq_comm_getinfo(atm_id, mpigrp=mpigrp_old) ! component group pes, from atm id ( also ATMID(1) ) - - typeA = 2 ! point cloud, phys atm in this case - ! idintx is a unique number of MOAB app that takes care of intx between ocn and atm mesh - idintx = 100*atm(1)%cplcompid + ocn(1)%cplcompid ! something different, to differentiate it; ~ 618 ! - if (atm_pg_active) then - typeB = 3 ! fv on atm side too !! imoab_apg2_ol coupler example - ! atm cells involved in intersection (pg 2 in this case) - ! this will be used now to send - ! data from phys grid directly to atm-ocn intx , for later projection - ! context is the same, atm - ocn intx id ! - - else - typeB = 1 ! atm cells involved in intersection (spectral in this case) ! this will be used now to send - ! data from phys grid directly to atm-ocn intx , for later projection - ! context is the same, atm - ocn intx id ! - endif - if (iamroot_CPLID) then - write(logunit,*) 'launch iMOAB graph with args ', & - mphaid, mbintxao, mpicom_join, mpigrp_old, mpigrp_CPLID, & - typeA, typeB, atm_id, idintx - end if - ! for these to work, we need to define the tags of size 16 (np x np) on coupler atm, - ! corresponding to this phys grid graph - ierr = iMOAB_ComputeCommGraph( mphaid, mbintxao, mpicom_join, mpigrp_old, mpigrp_CPLID, & - typeA, typeB, atm_id, idintx) - if (ierr .ne. 0) then - write(logunit,*) subname,' error in computing graph phys grid - atm/ocn intx ' - call shr_sys_abort(subname//' ERROR in computing graph phys grid - atm/ocn intx ') - endif - if (iamroot_CPLID) then - write(logunit,*) 'finish iMOAB graph in atm-ocn prep ' - end if + + ! I removed comm graph computed for one hop, from atm phys to intxao - ! compute a second comm graph, used in a 2 hop migration, between phis grid on coupler and intx ao on coupler, + ! compute the comm graph, used in a 2 hop migration, between atm grid on coupler and intx ao on coupler, ! so first atm fields will be migrated to coupler, and then in another hop, distributed to the processors that actually need the ! those degrees of freedom ! start copy - ! compute the comm graph between phys atm on coupler side and intx-atm-ocn, to be able to project in a second hop + ! compute the comm graph between atm on coupler side and intx-atm-ocn, to be able to send in a second hop ! from atm to ocean - - ! to project from atm to ocean, first send using this comm graph, then - ! apply weights (map); send from + typeA = 3 ! (atm_pg_active) + typeB = 3 ! (atm_pg_active) + idintx = atm(1)%cplcompid * 100 + ocn(1)%cplcompid + call seq_comm_getinfo(CPLID ,mpigrp=mpigrp_CPLID) ! the coupler group CPLID is global variable if (iamroot_CPLID) then ! mpicom_CPLID is a module local variable, already initialized write(logunit,*) 'launch iMOAB computecommgraph with args ', & - mphaxid, mbintxao, mpicom_CPLID, mpigrp_CPLID, mpigrp_CPLID, & + mbaxid, mbintxao, mpicom_CPLID, mpigrp_CPLID, mpigrp_CPLID, & typeA, typeB, id_join, idintx + call shr_sys_flush(logunit) end if ! for these to work, we need to define the tags of size 16 (np x np) on coupler atm, ! corresponding to this phys grid graph - if (mphaxid .ge. 0) then - ierr = iMOAB_ComputeCommGraph( mphaxid, mbintxao, mpicom_CPLID, mpigrp_CPLID, mpigrp_CPLID, & + if (mbaxid .ge. 0) then + ierr = iMOAB_ComputeCommGraph( mbaxid, mbintxao, mpicom_CPLID, mpigrp_CPLID, mpigrp_CPLID, & typeA, typeB, id_join, idintx) if (ierr .ne. 0) then write(logunit,*) subname,' error in computing graph phys grid - atm/ocn intx ' diff --git a/driver-moab/main/seq_flux_mct.F90 b/driver-moab/main/seq_flux_mct.F90 index 982d4281fd43..bffe8a5e27b1 100644 --- a/driver-moab/main/seq_flux_mct.F90 +++ b/driver-moab/main/seq_flux_mct.F90 @@ -7,7 +7,7 @@ module seq_flux_mct use shr_mct_mod, only: shr_mct_queryConfigFile, shr_mct_sMatReaddnc use seq_comm_mct, only : mboxid ! iMOAB app id for ocn on cpl pes - use seq_comm_mct, only : mphaxid ! iMOAB app id for atm phys grid on cpl pes + use seq_comm_mct, only : mbaxid ! iMOAB app id for atm phys grid on cpl pes use prep_aoflux_mod, only: prep_aoflux_get_xao_omct, prep_aoflux_get_xao_amct @@ -1657,7 +1657,7 @@ subroutine seq_flux_atmocn_moab(comp, xao) if (comp%oneletterid == 'a' ) then - appId = mphaxid ! ocn on coupler + appId = mbaxid ! atm on coupler local_xao_mct => prep_aoflux_get_xao_amct() else if (comp%oneletterid == 'o') then appId = mbofxid ! atm phys diff --git a/driver-moab/main/seq_frac_mct.F90 b/driver-moab/main/seq_frac_mct.F90 index 298ed3678f2a..b983e800d309 100644 --- a/driver-moab/main/seq_frac_mct.F90 +++ b/driver-moab/main/seq_frac_mct.F90 @@ -163,8 +163,7 @@ module seq_frac_mct use component_type_mod use iMOAB, only: iMOAB_DefineTagStorage - use seq_comm_mct, only : mphaxid ! iMOAB app id for phys atm, on cpl pes - use seq_comm_mct, only : mbaxid ! iMOAB id for atm migrated mesh to coupler pes (for spectral, different than mphaxid) + use seq_comm_mct, only : mbaxid ! iMOAB id for atm migrated mesh to coupler pes use seq_comm_mct, only : mblxid ! iMOAB app id for lnd on cpl pes use seq_comm_mct, only : mblx2id ! iMOAB id for land mesh instanced from MCT on coupler pes use seq_comm_mct, only : mbox2id ! iMOAB id for ocn mesh instanced from MCT on coupler pes @@ -178,7 +177,8 @@ module seq_frac_mct use iMOAB, only : iMOAB_DefineTagStorage, iMOAB_SetDoubleTagStorage, & iMOAB_GetMeshInfo, iMOAB_SetDoubleTagStorageWithGid, iMOAB_WriteMesh, & - iMOAB_ApplyScalarProjectionWeights, iMOAB_SendElementTag, iMOAB_ReceiveElementTag + iMOAB_ApplyScalarProjectionWeights, iMOAB_SendElementTag, iMOAB_ReceiveElementTag, & + iMOAB_FreeSenderBuffers use shr_kind_mod, only: CL => SHR_KIND_CL, CX => SHR_KIND_CX, CXX => SHR_KIND_CXX use iso_c_binding ! C_NULL_CHAR @@ -365,25 +365,26 @@ subroutine seq_frac_init( infodata, & ka = mct_aVect_indexRa(fractions_a,"afrac",perrWith=subName) fractions_a%rAttr(ka,:) = 1.0_r8 - ! Initialize fractions on atm coupler mesh; on migrated ph atm to coupler - if (mphaxid .ge. 0 ) then ! // + ! Initialize fractions on atm coupler mesh; on migrated atm to coupler + if (mbaxid .ge. 0 ) then ! // tagname = trim(fraclist_a)//C_NULL_CHAR ! 'afrac:ifrac:ofrac:lfrac:lfrin' tagtype = 1 ! dense, double numco = 1 ! - ierr = iMOAB_DefineTagStorage(mphaxid, tagname, tagtype, numco, tagindex ) + ierr = iMOAB_DefineTagStorage(mbaxid, tagname, tagtype, numco, tagindex ) if (ierr .ne. 0) then write(logunit,*) subname,' error in defining tags on atm phys mesh on cpl ' call shr_sys_abort(subname//' ERROR in defining tags on atm phys mesh on cpl') endif ! find out the number of local elements in moab mesh - ierr = iMOAB_GetMeshInfo ( mphaxid, nvert, nvise, nbl, nsurf, nvisBC ); + ierr = iMOAB_GetMeshInfo ( mbaxid, nvert, nvise, nbl, nsurf, nvisBC ); ! we should set to 1 the 'afrac' tag - arrSize = nvert(1) * 5 ! there are 5 tags that need to be zeroed out + ! we are on cells now ! + arrSize = nvise(1) * 5 ! there are 5 tags that need to be zeroed out allocate(tagValues(arrSize) ) - ent_type = 0 ! vertex type + ent_type = 1 ! cell type tagValues = 0 - ierr = iMOAB_SetDoubleTagStorage ( mphaxid, tagname, arrSize , ent_type, tagValues) + ierr = iMOAB_SetDoubleTagStorage ( mbaxid, tagname, arrSize , ent_type, tagValues) if (ierr .ne. 0) then write(logunit,*) subname,' error in zeroing out fracs ' call shr_sys_abort(subname//' ERROR in zeroing out fracs on phys atm') @@ -391,7 +392,7 @@ subroutine seq_frac_init( infodata, & tagname = 'afrac'//C_NULL_CHAR tagValues = 1 - ierr = iMOAB_SetDoubleTagStorage ( mphaxid, tagname, nvert(1) , ent_type, tagValues) + ierr = iMOAB_SetDoubleTagStorage ( mbaxid, tagname, nvise(1) , ent_type, tagValues) if (ierr .ne. 0) then write(logunit,*) subname,' error in setting afrac tag on phys atm ' call shr_sys_abort(subname//' ERROR in setting afrac tag on phys atm') @@ -400,7 +401,7 @@ subroutine seq_frac_init( infodata, & #ifdef MOABDEBUG outfile = 'atmCplFr.h5m'//C_NULL_CHAR wopts = ';PARALLEL=WRITE_PART'//C_NULL_CHAR - ierr = iMOAB_WriteMesh(mphaxid, trim(outfile), trim(wopts)) + ierr = iMOAB_WriteMesh(mbaxid, trim(outfile), trim(wopts)) if (ierr .ne. 0) then write(logunit,*) subname,' error in writing mesh ' call shr_sys_abort(subname//' ERROR in writing mesh ') @@ -708,7 +709,7 @@ subroutine seq_frac_init( infodata, & ! TODO moab projection using a2o moab map ! first, send the field to atm on coupler - ! actually, afrac is 1 on all cells on mphaxid ; we need to project it to ocn + ! actually, afrac is 1 on all cells on mbaxid ; we need to project it to ocn ! if on spectral mesh, we need to send it ! afrac ext tag that is not defined yet ? idintx = 100*atm%cplcompid + ocn%cplcompid ! something different, to differentiate it; ~ 618 ! @@ -737,12 +738,12 @@ subroutine seq_frac_init( infodata, & endif ! we have to send towards the coverage, because local mesh is not "covering" the target ! we have to use the graph computed at the end of prep_atm_ocn_moab - ! if (mphaxid .ge. 0) then - ! ierr = iMOAB_ComputeCommGraph( mphaxid, mbintxao, mpicom_CPLID, mpigrp_CPLID, mpigrp_CPLID, & + ! if (mbaxid .ge. 0) then + ! ierr = iMOAB_ComputeCommGraph( mbaxid, mbintxao, mpicom_CPLID, mpigrp_CPLID, mpigrp_CPLID, & ! typeA, typeB, id_join, idintx) - if ((mphaxid .ge. 0) .and. (mbintxao .ge. 0)) then + if ((mbaxid .ge. 0) .and. (mbintxao .ge. 0)) then id_join = atm%cplcompid ! atm cpl ext id for moab (6) - ierr = iMOAB_SendElementTag(mphaxid, tagName, mpicom, idintx) ! context is intx ao + ierr = iMOAB_SendElementTag(mbaxid, tagName, mpicom, idintx) ! context is intx ao if (ierr .ne. 0) then write(logunit,*) subname,' error in sending afrac tag ' call shr_sys_abort(subname//' ERROR in sending afrac tag ') @@ -755,6 +756,12 @@ subroutine seq_frac_init( infodata, & write(logunit,*) subname,' error in receiving afrac tag ' call shr_sys_abort(subname//' ERROR in receiving afrac tag ') endif + ierr = iMOAB_FreeSenderBuffers(mbaxid, idintx) ! context is intx ao + if (ierr .ne. 0) then + write(logunit,*) subname,' error in freeing buffers ' + call shr_sys_abort(subname//' ERROR in freeing buffers ') + endif + ierr = iMOAB_ApplyScalarProjectionWeights ( mbintxao, wgtIdef, tagName, tagName) else @@ -763,6 +770,11 @@ subroutine seq_frac_init( infodata, & write(logunit,*) subname,' error in receiving afrac_ext tag ' call shr_sys_abort(subname//' ERROR in receiving afrac_ext tag ') endif + ierr = iMOAB_FreeSenderBuffers(mbaxid, idintx) ! context is intx ao + if (ierr .ne. 0) then + write(logunit,*) subname,' error in freeing buffers ' + call shr_sys_abort(subname//' ERROR in freeing buffers ') + endif ierr = iMOAB_ApplyScalarProjectionWeights ( mbintxao, wgtIdef, tagNameExt, tagName) endif if (ierr .ne. 0) then diff --git a/driver-moab/shr/seq_comm_mct.F90 b/driver-moab/shr/seq_comm_mct.F90 index 47e9d3ad4b02..eb5e39017208 100644 --- a/driver-moab/shr/seq_comm_mct.F90 +++ b/driver-moab/shr/seq_comm_mct.F90 @@ -218,7 +218,6 @@ module seq_comm_mct integer, public :: mhpgid ! iMOAB id for atm pgx grid, on atm pes; created with se and gll grids logical, public :: atm_pg_active = .false. ! whether the atm uses FV mesh or not ; made true if fv_nphys > 0 integer, public :: mphaid ! iMOAB id for atm phys grid, on atm pes - integer, public :: mphaxid ! iMOAB id for atm phys grid, on cpl pes; integer, public :: mbaxid ! iMOAB id for atm migrated mesh to coupler pes (migrate either mhid or mhpgid, depending on atm_pg_active) integer, public :: mboxid ! iMOAB id for mpas ocean migrated mesh to coupler pes integer, public :: mbofxid ! iMOAB id for mpas ocean migrated mesh to coupler pes, just for xao flux calculations @@ -629,7 +628,6 @@ subroutine seq_comm_init(global_comm_in, driver_comm_in, nmlfile, drv_comm_id) mpoid = -1 ! iMOAB id for ocn comp mlnid = -1 ! iMOAB id for land comp mphaid = -1 ! iMOAB id for phys grid on atm pes - mphaxid = -1 ! iMOAB id for phys grid on cpl pes mbaxid = -1 ! iMOAB id for atm migrated mesh to coupler pes mboxid = -1 ! iMOAB id for mpas ocean migrated mesh to coupler pes mbofxid = -1 ! iMOAB id for second mpas ocean migrated mesh to coupler pes, for flux calculations From c578f1c828bf29c653fd33e604ccfd5659753df4 Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Thu, 15 Dec 2022 08:03:51 -0600 Subject: [PATCH 216/467] skip temporarily moab projections outside seq_map except rof2ocn --- driver-moab/main/cime_comp_mod.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/driver-moab/main/cime_comp_mod.F90 b/driver-moab/main/cime_comp_mod.F90 index 77890488f4b8..29178173668a 100644 --- a/driver-moab/main/cime_comp_mod.F90 +++ b/driver-moab/main/cime_comp_mod.F90 @@ -2853,7 +2853,7 @@ subroutine cime_run() endif ! is this really needed here ? if ( atm_c2_ocn) then - call prep_ocn_calc_a2x_ox_moab(timer='CPL:ocnpre1_atm2ocn_moab', infodata=infodata) + !call prep_ocn_calc_a2x_ox_moab(timer='CPL:ocnpre1_atm2ocn_moab', infodata=infodata) endif !---------------------------------------------------------- @@ -4076,7 +4076,7 @@ subroutine cime_run_atm_recv_post() ! will migrate the tag from component pes to coupler pes, on atm mesh call component_exch_moab(atm(1), mphaid, mbaxid, 0, seq_flds_a2x_fields) - call prep_atm_migrate_moab(infodata) + !call prep_atm_migrate_moab(infodata) endif !---------------------------------------------------------- From d9df9d5705df6a2ecd12f2ff26f69c4dae9c582f Mon Sep 17 00:00:00 2001 From: Jason Sarich Date: Thu, 15 Dec 2022 10:09:31 -0600 Subject: [PATCH 217/467] merge changes in master from b71b609280 to 7591f33d54 into moab driver branch --- .gitmodules | 2 +- cime | 2 +- .../cmake_macros/gnu_anlgce-ub18.cmake | 1 + cime_config/machines/config_machines.xml | 4 +- components/eam/src/dynamics/se/dyn_comp.F90 | 1 + components/elm/src/external_models/fates | 2 +- components/elm/src/external_models/sbetr | 2 +- driver-moab/cime_config/buildlib_cmake | 2 +- driver-moab/cime_config/config_component.xml | 77 +- .../cime_config/config_component_e3sm.xml | 61 +- driver-moab/cime_config/config_pes.xml | 225 ++- .../cime_config/namelist_definition_drv.xml | 262 ++- driver-moab/main/cime_comp_mod.F90 | 623 ++++--- driver-moab/main/component_mod.F90 | 14 + driver-moab/main/component_type_mod.F90 | 2 + driver-moab/main/prep_atm_mod.F90 | 58 +- driver-moab/main/prep_ocn_mod.F90 | 88 + driver-moab/main/prep_rof_mod.F90 | 187 +- driver-moab/main/seq_diagBGC_mct.F90 | 1600 +++++++++++++++++ driver-moab/main/seq_diag_mct.F90 | 155 +- driver-moab/main/seq_flux_mct.F90 | 92 +- driver-moab/main/seq_hist_mod.F90 | 7 +- driver-moab/main/seq_io_mod.F90 | 26 +- driver-moab/main/seq_rest_mod.F90 | 82 +- driver-moab/shr/seq_comm_mct.F90 | 117 +- driver-moab/shr/seq_flds_mod.F90 | 434 ++++- driver-moab/shr/seq_infodata_mod.F90 | 49 +- externals/kokkos | 2 +- externals/scorpio | 2 +- 29 files changed, 3566 insertions(+), 613 deletions(-) create mode 100644 driver-moab/main/seq_diagBGC_mct.F90 diff --git a/.gitmodules b/.gitmodules index 08376598919f..7252cc96e46f 100644 --- a/.gitmodules +++ b/.gitmodules @@ -31,7 +31,7 @@ [submodule "cime"] path = cime url = git@github.com:ESMCI/cime.git - branch = sarich/allow-moab-driver + branch = sarich/fix-moab-driver-checks [submodule "externals/YAKL"] path = externals/YAKL url = git@github.com:mrnorman/YAKL.git diff --git a/cime b/cime index e53f289a7644..c7fd2ff83c9f 160000 --- a/cime +++ b/cime @@ -1 +1 @@ -Subproject commit e53f289a7644931fbc5e6b26cff4a21376ba3fba +Subproject commit c7fd2ff83c9ff3f2f75e0cae573319c1bcab3c83 diff --git a/cime_config/machines/cmake_macros/gnu_anlgce-ub18.cmake b/cime_config/machines/cmake_macros/gnu_anlgce-ub18.cmake index 7615540fce99..f6ac55f0ce61 100644 --- a/cime_config/machines/cmake_macros/gnu_anlgce-ub18.cmake +++ b/cime_config/machines/cmake_macros/gnu_anlgce-ub18.cmake @@ -13,3 +13,4 @@ set(NETCDF_PATH "$ENV{NETCDF_PATH}") set(PNETCDF_PATH "$ENV{PNETCDF_PATH}") set(HDF5_PATH "$ENV{HDF5_PATH}") set(ZLIB_PATH "$ENV{ZLIB_PATH}") +set(MOAB_PATH "$ENV{MOAB_PATH}") diff --git a/cime_config/machines/config_machines.xml b/cime_config/machines/config_machines.xml index e58aad45dc8a..ae4fb0120a9d 100644 --- a/cime_config/machines/config_machines.xml +++ b/cime_config/machines/config_machines.xml @@ -644,7 +644,6 @@ $CIME_OUTPUT_ROOT/$CASE/run $CIME_OUTPUT_ROOT/$CASE/bld 0.1 - 0.25 $ENV{NETCDF_DIR} $ENV{PNETCDF_DIR} @@ -1530,6 +1529,7 @@ /nfs/gce/projects/climate/software/hdf5/1.12.1/mpich-3.4.2/gcc-11.1.0 /nfs/gce/projects/climate/software/netcdf/4.8.0c-4.3.1cxx-4.5.3f-parallel/mpich-3.4.2/gcc-11.1.0 /nfs/gce/projects/climate/software/pnetcdf/1.12.2/mpich-3.4.2/gcc-11.1.0 + /nfs/gce/projects/climate/software/moab/devel/mpich-3.4.2/gcc-11.1.0 @@ -1539,6 +1539,7 @@ /nfs/gce/projects/climate/software/hdf5/1.12.1/openmpi-4.1.3/gcc-11.1.0 /nfs/gce/projects/climate/software/netcdf/4.8.0c-4.3.1cxx-4.5.3f-parallel/openmpi-4.1.3/gcc-11.1.0 /nfs/gce/projects/climate/software/pnetcdf/1.12.2/openmpi-4.1.3/gcc-11.1.0 + /nfs/gce/projects/climate/software/moab/devel/openmpi-4.1.3/gcc-11.1.0 64M @@ -2003,7 +2004,6 @@ $CIME_OUTPUT_ROOT/$CASE/run $CIME_OUTPUT_ROOT/$CASE/bld 0.05 - 0.05 1000 /lcrc/group/e3sm/soft/perl/chrys/lib/perl5 diff --git a/components/eam/src/dynamics/se/dyn_comp.F90 b/components/eam/src/dynamics/se/dyn_comp.F90 index 07f36c85ea8a..6cf284dee337 100644 --- a/components/eam/src/dynamics/se/dyn_comp.F90 +++ b/components/eam/src/dynamics/se/dyn_comp.F90 @@ -125,6 +125,7 @@ subroutine dyn_init1(fh, NLFileName, dyn_in, dyn_out) #if defined(HORIZ_OPENMP) || defined(COLUMN_OPENMP) call endrun( 'in this EAM configuration, kokkos dycore does not run with threads yet') #endif +#endif #ifdef HAVE_MOAB integer :: ATM_ID1 diff --git a/components/elm/src/external_models/fates b/components/elm/src/external_models/fates index 6c3e30ebe633..def6b3e76f9f 160000 --- a/components/elm/src/external_models/fates +++ b/components/elm/src/external_models/fates @@ -1 +1 @@ -Subproject commit 6c3e30ebe6335dd5ac891dfb567d5749f17c7cdd +Subproject commit def6b3e76f9ff3043150a777f403883b3e659374 diff --git a/components/elm/src/external_models/sbetr b/components/elm/src/external_models/sbetr index 51be6d5f8581..13fff9208624 160000 --- a/components/elm/src/external_models/sbetr +++ b/components/elm/src/external_models/sbetr @@ -1 +1 @@ -Subproject commit 51be6d5f858145654d3c94c2985b3e347dd5a1d4 +Subproject commit 13fff9208624ca5e7da1094f0d93043f8cd58926 diff --git a/driver-moab/cime_config/buildlib_cmake b/driver-moab/cime_config/buildlib_cmake index 2711848f5e0f..7fba385c65b6 100755 --- a/driver-moab/cime_config/buildlib_cmake +++ b/driver-moab/cime_config/buildlib_cmake @@ -1,4 +1,4 @@ -#!/usr/bin/env python +#!/usr/bin/env python3 """ build model executable diff --git a/driver-moab/cime_config/config_component.xml b/driver-moab/cime_config/config_component.xml index f564f51a0e3d..a5141dd679cf 100644 --- a/driver-moab/cime_config/config_component.xml +++ b/driver-moab/cime_config/config_component.xml @@ -753,15 +753,6 @@ machines. - - logical - TRUE,FALSE - FALSE - build_def - env_build.xml - TRUE implies linking to the MOAB library - - logical TRUE,FALSE @@ -896,6 +887,22 @@ logical to diagnose model timing at the end of the run + + real + 0.10 + run_flags + env_run.xml + Expected relative memory usage growth for test + + + + real + 0.25 + run_flags + env_run.xml + Expected throughput deviation + + logical TRUE,FALSE @@ -1880,6 +1887,23 @@ ocn2wav state mapping file decomp type + + char + idmap_ignore + run_domain + env_run.xml + ocn2rof state mapping file + + + + char + X,Y + Y + run_domain + env_run.xml + ocn2rof state mapping file decomp type + + char idmap @@ -2358,6 +2382,25 @@ + + integer + + 0 + 0 + 0 + 0 + 0 + 0 + 0 + 0 + 0 + 0 + + mach_pes + env_mach_pes.xml + Stride of MPI tasks owned exclusively by a component. If 0, exclusivity is disabled. + + integer 0 @@ -2705,22 +2748,6 @@ supplied or computed test id - - real - 0.10 - test - env_test.xml - Expected relative memory usage growth for test - - - - real - 0.25 - test - env_test.xml - Expected throughput deviation - - logical TRUE,FALSE diff --git a/driver-moab/cime_config/config_component_e3sm.xml b/driver-moab/cime_config/config_component_e3sm.xml index 7a1a8dc51bdf..3405face4b31 100644 --- a/driver-moab/cime_config/config_component_e3sm.xml +++ b/driver-moab/cime_config/config_component_e3sm.xml @@ -13,6 +13,7 @@ logical TRUE,FALSE + TRUE run_flags env_run.xml @@ -180,6 +181,36 @@ Freezing point calculation for salt water. + + char + explicit,implicit_stress + explicit + run_flags + env_run.xml + + Time integration method for calculation of fluxes to the atmosphere. + + explicit: Fluxes are calculated using the atmosphere's lowest-level state + at the current time step. + + implicit_stress: The atmosphere model exports a linearization of the + response of the boundary layer scheme to surface stress, and other + components use this linearization to solve for surface stress at the + next time step implicitly. + + + + + logical + TRUE,FALSE + FALSE + run_flags + env_run.xml + + Whether or not the atmosphere should supply an extra gustiness field. + + + @@ -240,6 +271,7 @@ CO2C_OI CO2C_OI CO2C_OI + CO2B run_coupling env_run.xml @@ -332,6 +364,9 @@ 12 24 48 + 48 + 48 + 48 96 96 96 @@ -349,13 +384,13 @@ 96 96 144 - 288 - 576 - 1152 + 144 + 432 + 864 144 96 - 96 - 96 + 48 + 48 144 144 96 @@ -370,12 +405,9 @@ 1 4 4 - - - 96 - 72 - 96 - 72 + + + 72 run_coupling env_run.xml @@ -444,6 +476,9 @@ 12 24 48 + 48 + 48 + 48 48 48 96 @@ -515,6 +550,7 @@ 6 4 8 + $ATM_NCPL run_coupling env_run.xml @@ -684,9 +720,11 @@ 368.865 368.865 284.317 + 1137.268 312.821 388.717 0.000001 + 0.000001 284.317 284.317 284.317 @@ -797,6 +835,7 @@ Historical 1850 to 2000 transient: AMIP for stand-alone cam: Future transient using CMIP6 SSP5_8.5 scenario: + Future transient using CMIP6 SSP3_7.0 scenario: CCMI REFC2 1950 to 2100 transient: CCMI REFC2 2004 to 2100 transient: 1948 to 2004 transient: diff --git a/driver-moab/cime_config/config_pes.xml b/driver-moab/cime_config/config_pes.xml index 2adfd248536d..7df15f2e2aa8 100644 --- a/driver-moab/cime_config/config_pes.xml +++ b/driver-moab/cime_config/config_pes.xml @@ -1,129 +1,116 @@ - - - none - - -1 - -1 - -1 - -1 - -1 - -1 - -1 - -1 - -1 - -1 - - - 1 - 1 - 1 - 1 - 1 - 1 - 1 - 1 - 1 - 1 - - - 0 - 0 - 0 - 0 - 0 - 0 - 0 - 0 - 0 - 0 - + driver-mct: any grid, any mach, any compset, any pesize + + -1 + -1 + -1 + -1 + -1 + -1 + -1 + -1 + -1 + -1 + - - - - - - - none - - 60 - 60 - 60 - 60 - 60 - 60 - 60 - 60 - 60 - - - 2 - 2 - 2 - 2 - 2 - 2 - 2 - 2 - 2 - - - 0 - 0 - 0 - 0 - 0 - 0 - 0 - 0 - 0 - + + driver-mct: any grid, any mach, compset XATM, pesize=threaded + + 4 + 4 + 4 + 4 + 4 + 4 + 4 + 4 + + + 4 + 4 + 4 + 4 + 4 + 4 + 4 + 4 + - - - - - - - none - - -8 - -8 - -8 - -8 - -8 - -8 - -8 - -8 - -8 - - - 2 - 2 - 2 - 2 - 2 - 2 - 2 - 2 - 1 - - - 0 - 0 - 0 - 0 - 0 - 0 - 0 - 0 - 0 - + + driver-mct: any grid, any mach, compset SATM, any pesize + + 8 + 8 + 8 + 8 + 8 + 8 + 8 + 8 + + + + driver-mct: any grid, any mach, compset SATM, pesize=threaded + + 2 + 2 + 2 + 2 + 2 + 2 + 2 + 2 + + + 4 + 4 + 4 + 4 + 4 + 4 + 4 + 4 + + + + driver-mct: any grid, any mach, compset all-data, any pesize + + -1 + -1 + -1 + -1 + -1 + -1 + -1 + -1 + + + + driver-mct: any grid, any mach, compset all-data, pesize=threaded + + 2 + 2 + 2 + 2 + 2 + 2 + 2 + 2 + + + 4 + 4 + 4 + 4 + 4 + 4 + 4 + 4 + diff --git a/driver-moab/cime_config/namelist_definition_drv.xml b/driver-moab/cime_config/namelist_definition_drv.xml index 2599d3b4b009..686afa60dd8f 100644 --- a/driver-moab/cime_config/namelist_definition_drv.xml +++ b/driver-moab/cime_config/namelist_definition_drv.xml @@ -149,6 +149,26 @@ + + char + seq_flds + seq_cplflds_inparm + Time integration method for atmospheric fluxes. Set by the xml variable ATM_FLUX_INTEGRATION_METHOD in env_run.xml + + $ATM_FLUX_INTEGRATION_METHOD + + + + + logical + seq_flds + seq_cplflds_inparm + Set to .true. if the atmosphere produces a gustiness velocity. Set by the xml variable ATM_SUPPLIES_GUSTINESS in env_run.xml + + $ATM_SUPPLIES_GUSTINESS + + + integer seq_flds @@ -212,6 +232,42 @@ + + logical + seq_flds + seq_cplflds_inparm + + If set to .true., adds fields needed to transfer nutrients from the runoff model to the ocn + + + .false. + + + + + logical + seq_flds + seq_cplflds_inparm + + If set to .true., adds fields needed to calculate land-river two-way coupling + + + .false. + + + + + logical + seq_flds + seq_cplflds_inparm + + If set to .true., adds fields needed to calculate river-ocean two-way coupling + + + .false. + + + @@ -763,11 +819,13 @@ control seq_infodata_inparm - Iterate atmocn flux calculation a max of this value + Maximum number of iterations in atmosphere-ocean flux calculation. + Setting this value to -1 will cause the model to use a default that + depends on the setting of atm_flux_method. 5 - 2 + -1 @@ -985,6 +1043,20 @@ + + logical + budget + seq_infodata_inparm + + logical that turns on BGC diagnostic budgets, false means BGC budgets will never be written + + + .false. + .true. + .true. + + + logical history @@ -1484,6 +1556,49 @@ + + logical + seq_infodata_inparm + seq_infodata_inparm + + Uses SCM functionality for multiple columns. Specifically, it takes the column + on the globe intended to be run in SCM mode, but propogates that point (i.e. + meaning surface type and properties etc.) to multiple columns, as defined by the + user. All columns are then forced identically according to the Intensive Observation + Period (IOP) file, which is typically required to run in SCM mode. This option + originally implemented to support running a doubly periodic cloud resolving model, but + could be used for other applications. + set by PTS_MULTCOLS_MODE in env_case.xml, default: false + + + $PTS_MULTCOLS_MODE + + + + + integer + seq_infodata_inparm + seq_infodata_inparm + + number of points in x direction when using SCM functionality for multiple columns + + + $PTS_NX + + + + + integer + seq_infodata_inparm + seq_infodata_inparm + + number of points in Y direction when using SCM functionality for multiple columns + + + $PTS_NY + + + logical seq_infodata_inparm @@ -2472,6 +2587,14 @@ + + integer + cime_pes + cime_pes + Stride of MPI tasks owned exclusively by a component. + $EXCL_STRIDE_ATM + + integer cime_pes @@ -2537,6 +2660,14 @@ + + integer + cime_pes + cime_pes + Stride of MPI tasks owned exclusively by a component. + $EXCL_STRIDE_LND + + integer cime_pes @@ -2602,6 +2733,14 @@ + + integer + cime_pes + cime_pes + Stride of MPI tasks owned exclusively by a component. + $EXCL_STRIDE_ICE + + integer cime_pes @@ -2667,6 +2806,14 @@ + + integer + cime_pes + cime_pes + Stride of MPI tasks owned exclusively by a component. + $EXCL_STRIDE_OCN + + integer cime_pes @@ -2732,6 +2879,14 @@ + + integer + cime_pes + cime_pes + Stride of MPI tasks owned exclusively by a component. + $EXCL_STRIDE_GLC + + integer cime_pes @@ -2797,6 +2952,14 @@ + + integer + cime_pes + cime_pes + Stride of MPI tasks owned exclusively by a component. + $EXCL_STRIDE_WAV + + integer cime_pes @@ -2862,6 +3025,14 @@ + + integer + cime_pes + cime_pes + Stride of MPI tasks owned exclusively by a component. + $EXCL_STRIDE_IAC + + integer cime_pes @@ -2927,6 +3098,14 @@ + + integer + cime_pes + cime_pes + Stride of MPI tasks owned exclusively by a component. + $EXCL_STRIDE_ROF + + integer cime_pes @@ -2992,6 +3171,14 @@ + + integer + cime_pes + cime_pes + Stride of MPI tasks owned exclusively by a component. + $EXCL_STRIDE_ESP + + integer cime_pes @@ -3044,6 +3231,14 @@ + + integer + cime_pes + cime_pes + Stride of MPI tasks owned exclusively by a component. + $EXCL_STRIDE_CPL + + integer cime_pes @@ -3070,6 +3265,36 @@ + + integer + cime_pes + cime_pes + + Sets level of memory profile logging: + 0: no output + 1: log mem-usage from component ROOTPE tasks + 2: log mem-usage from all tasks + 3: aggregate logging to node-level mem-usage on ROOTPE nodes + 4: aggregate logging to node-level mem-usage on all nodes + Aggregation requires info_taskmap_model>0. + + + $INFO_MPROF + + + + + integer + cime_pes + cime_pes + + number of seconds between memory profiling logs + + + $INFO_MPROF_DT + + + @@ -4581,7 +4806,8 @@ components that need to look at the same data. - Buildconf/camconf/drv_flds_in,Buildconf/clmconf/drv_flds_in + Buildconf/camconf/drv_flds_in,Buildconf/clmconf/drv_flds_in + Buildconf/eamconf/drv_flds_in,Buildconf/elmconf/drv_flds_in @@ -4705,6 +4931,36 @@ + + char + mapping + abs + seq_maps + + ocn to rof mapping file for states + + + $OCN2ROF_SMAPNAME + + + + + char + mapping + seq_maps + + The type of mapping desired, either "source" or "destination" mapping. + X is associated with rearrangement of the source grid to the + destination grid and then local mapping. Y is associated with mapping + on the source grid and then rearrangement and sum to the destination + grid. + + + $OCN2ROF_SMAPTYPE + X + + + logical data_assimilation diff --git a/driver-moab/main/cime_comp_mod.F90 b/driver-moab/main/cime_comp_mod.F90 index 5111d3257b92..4811852867c3 100644 --- a/driver-moab/main/cime_comp_mod.F90 +++ b/driver-moab/main/cime_comp_mod.F90 @@ -147,6 +147,9 @@ module cime_comp_mod use seq_diag_mct, only : seq_diag_zero_mct , seq_diag_avect_mct, seq_diag_lnd_mct use seq_diag_mct, only : seq_diag_rof_mct , seq_diag_ocn_mct , seq_diag_atm_mct use seq_diag_mct, only : seq_diag_ice_mct , seq_diag_accum_mct, seq_diag_print_mct + use seq_diagBGC_mct, only : seq_diagBGC_zero_mct , seq_diagBGC_avect_mct, seq_diagBGC_lnd_mct + use seq_diagBGC_mct, only : seq_diagBGC_rof_mct , seq_diagBGC_ocn_mct , seq_diagBGC_atm_mct + use seq_diagBGC_mct, only : seq_diagBGC_ice_mct , seq_diagBGC_accum_mct ! list of fields transferred between components use seq_flds_mod, only : seq_flds_a2x_fluxes, seq_flds_x2a_fluxes @@ -423,6 +426,7 @@ module cime_comp_mod logical :: ocnrof_prognostic ! .true. => ocn comp expects runoff input logical :: glc_prognostic ! .true. => glc comp expects input logical :: rof_prognostic ! .true. => rof comp expects input + logical :: rofocn_prognostic ! .true. => rof comp expects ssh input logical :: wav_prognostic ! .true. => wav comp expects input logical :: esp_prognostic ! .true. => esp comp expects input logical :: iac_prognostic ! .true. => iac comp expects input @@ -439,6 +443,7 @@ module cime_comp_mod logical :: ocn_c2_ice ! .true. => ocn to ice coupling on logical :: ocn_c2_glcshelf ! .true. => ocn to glc ice shelf coupling on logical :: ocn_c2_wav ! .true. => ocn to wav coupling on + logical :: ocn_c2_rof ! .true. => ocn to rof coupling on logical :: ice_c2_atm ! .true. => ice to atm coupling on logical :: ice_c2_ocn ! .true. => ice to ocn coupling on logical :: ice_c2_wav ! .true. => ice to wav coupling on @@ -515,6 +520,7 @@ module cime_comp_mod !--- history & budgets --- logical :: do_budgets ! heat/water budgets on + logical :: do_bgc_budgets ! BGC budgets on logical :: do_histinit ! initial hist file logical :: do_histavg ! histavg on or off logical :: do_hist_r2x ! create aux files: r2x @@ -1023,6 +1029,7 @@ subroutine cime_pre_init2() real(r8), parameter :: epsilo = shr_const_mwwv/shr_const_mwdair + logical :: bfbflag !.true. if bfbflag is true integer(i8) :: beg_count ! start time integer(i8) :: end_count ! end time integer(i8) :: irtc_rate ! factor to convert time to seconds @@ -1071,12 +1078,15 @@ subroutine cime_pre_init2() !| Initialize infodata !---------------------------------------------------------- + call t_startf('CPL:seq_infodata_init') if (len_trim(cpl_inst_tag) > 0) then call seq_infodata_init(infodata,nlfilename, GLOID, pioid, & cpl_tag=cpl_inst_tag) else call seq_infodata_init(infodata,nlfilename, GLOID, pioid) end if + call t_stopf('CPL:seq_infodata_init') + call seq_infodata_GetData(infodata, cime_model=cime_model) !---------------------------------------------------------- @@ -1134,6 +1144,7 @@ subroutine cime_pre_init2() drv_threading=drv_threading , & do_histinit=do_histinit , & do_budgets=do_budgets , & + do_bgc_budgets=do_bgc_budgets , & budget_inst=budget_inst , & budget_daily=budget_daily , & budget_month=budget_month , & @@ -1245,11 +1256,13 @@ subroutine cime_pre_init2() !| Initialize time manager !---------------------------------------------------------- + call t_startf('CPL:seq_timemgr_clockInit') call seq_timemgr_clockInit(seq_SyncClock, nlfilename, & read_restart, rest_file, pioid, mpicom_gloid, & EClock_d, EClock_a, EClock_l, EClock_o, & EClock_i, Eclock_g, Eclock_r, Eclock_w, Eclock_e, & EClock_z) + call t_stopf('CPL:seq_timemgr_clockInit') if (iamroot_CPLID) then call seq_timemgr_clockPrint(seq_SyncClock) @@ -1365,6 +1378,13 @@ subroutine cime_pre_init2() call pio_closefile(pioid) endif + !Print BFBFLAG value in the log file + if (iamroot_CPLID) then + call seq_infodata_GetData(infodata, bfbflag=bfbflag) + write(logunit,'(2A,L4)') subname,'BFBFLAG is:',bfbflag + endif + + call t_stopf('CPL:cime_pre_init2') ! CPL:cime_pre_init2 timer elapsed time will be double counted @@ -1388,6 +1408,7 @@ end subroutine cime_pre_init2 subroutine cime_init() +103 format( 5A ) 104 format( A, i10.8, i8) !----------------------------------------------------------------------------- @@ -1473,11 +1494,11 @@ subroutine cime_init() call t_adj_detailf(-2) call t_stopf('CPL:comp_init_cc_esp') - call t_startf('comp_init_cc_iac') + call t_startf('CPL:comp_init_cc_iac') call t_adj_detailf(+2) call component_init_cc(Eclock_z, iac, iac_init, infodata, NLFilename) call t_adj_detailf(-2) - call t_stopf('comp_init_cc_iac') + call t_stopf('CPL:comp_init_cc_iac') call t_startf('CPL:comp_init_cx_all') call t_adj_detailf(+2) @@ -1612,6 +1633,7 @@ subroutine cime_init() ocn_c2_glcshelf=ocn_c2_glcshelf, & glc_prognostic=glc_prognostic, & rof_prognostic=rof_prognostic, & + rofocn_prognostic=rofocn_prognostic, & wav_prognostic=wav_prognostic, & iac_prognostic=iac_prognostic, & esp_prognostic=esp_prognostic, & @@ -1669,6 +1691,7 @@ subroutine cime_init() ocn_c2_atm = .false. ocn_c2_ice = .false. ocn_c2_wav = .false. + ocn_c2_rof = .false. ice_c2_atm = .false. ice_c2_ocn = .false. ice_c2_wav = .false. @@ -1705,6 +1728,7 @@ subroutine cime_init() if (atm_present ) ocn_c2_atm = .true. ! needed for aoflux calc if aoflux=atm if (ice_prognostic) ocn_c2_ice = .true. if (wav_prognostic) ocn_c2_wav = .true. + if (rofocn_prognostic) ocn_c2_rof = .true. endif if (ice_present) then @@ -1786,6 +1810,7 @@ subroutine cime_init() write(logunit,F0L)'iceberg prognostic = ',iceberg_prognostic write(logunit,F0L)'glc model prognostic = ',glc_prognostic write(logunit,F0L)'rof model prognostic = ',rof_prognostic + write(logunit,F0L)'rof ocn prognostic = ',rofocn_prognostic write(logunit,F0L)'ocn rof prognostic = ',ocnrof_prognostic write(logunit,F0L)'wav model prognostic = ',wav_prognostic write(logunit,F0L)'iac model prognostic = ',iac_prognostic @@ -1803,6 +1828,7 @@ subroutine cime_init() write(logunit,F0L)'ocn_c2_ice = ',ocn_c2_ice write(logunit,F0L)'ocn_c2_glcshelf = ',ocn_c2_glcshelf write(logunit,F0L)'ocn_c2_wav = ',ocn_c2_wav + write(logunit,F0L)'ocn_c2_rof = ',ocn_c2_rof write(logunit,F0L)'ice_c2_atm = ',ice_c2_atm write(logunit,F0L)'ice_c2_ocn = ',ice_c2_ocn write(logunit,F0L)'ice_c2_wav = ',ice_c2_wav @@ -1897,6 +1923,12 @@ subroutine cime_init() call shr_sys_flush(logunit) endif endif + if (rofocn_prognostic .and. .not.ocn_present) then + if (iamroot_CPLID) then + write(logunit,F00) 'WARNING: rofocn_prognostic is TRUE but ocn_present is FALSE' + call shr_sys_flush(logunit) + endif + endif !---------------------------------------------------------- !| Samegrid checks @@ -1946,7 +1978,7 @@ subroutine cime_init() call prep_ice_init(infodata, ocn_c2_ice, glc_c2_ice, glcshelf_c2_ice, rof_c2_ice ) - call prep_rof_init(infodata, lnd_c2_rof, atm_c2_rof) + call prep_rof_init(infodata, lnd_c2_rof, atm_c2_rof, ocn_c2_rof) call prep_glc_init(infodata, lnd_c2_glc, ocn_c2_glcshelf) @@ -2339,11 +2371,21 @@ subroutine cime_init() call t_adj_detailf(+2) call seq_diag_zero_mct(mode='all') + call seq_diagBGC_zero_mct(mode='all') if (read_restart .and. iamin_CPLID) then + + if (iamroot_CPLID) then + write(logunit,103) subname,' Reading restart file ',trim(rest_file) + call shr_sys_flush(logunit) + end if + + call t_startf('CPL:seq_rest_read-init') call seq_rest_read(rest_file, infodata, & atm, lnd, ice, ocn, rof, glc, wav, esp, iac, & fractions_ax, fractions_lx, fractions_ix, fractions_ox, & fractions_rx, fractions_gx, fractions_wx, fractions_zx) + call t_stopf('CPL:seq_rest_read-init') + endif call t_adj_detailf(-2) @@ -2399,10 +2441,14 @@ subroutine cime_init() write(logunit,104) ' Write history file at ',ymd,tod call shr_sys_flush(logunit) endif + + call t_startf('CPL:seq_hist_write-init') call seq_hist_write(infodata, EClock_d, & atm, lnd, ice, ocn, rof, glc, wav, iac, & fractions_ax, fractions_lx, fractions_ix, fractions_ox, & fractions_rx, fractions_gx, fractions_wx, fractions_zx, trim(cpl_inst_tag)) + call t_stopf('CPL:seq_hist_write-init') + if (drv_threading) call seq_comm_setnthreads(nthreads_GLOID) call t_adj_detailf(-2) @@ -2469,11 +2515,10 @@ subroutine cime_run() integer :: hashint(hashcnt) ! Driver pause/resume logical :: drv_pause ! Driver writes pause restart file - character(len=CL) :: drv_resume ! Driver resets state from restart file + logical :: drv_resume ! Driver resets state from restart file + character(len=CL) :: drv_resume_file ! The restart (resume) file character(len=CL), pointer :: resume_files(:) ! Component resume files - type(ESMF_Time) :: etime_curr ! Current model time - real(r8) :: tbnds1_offset ! Time offset for call to seq_hist_writeaux logical :: lnd2glc_averaged_now ! Whether lnd2glc averages were taken this timestep logical :: prep_glc_accum_avg_called ! Whether prep_glc_accum_avg has been called this timestep integer :: i, nodeId @@ -2494,6 +2539,7 @@ subroutine cime_run() call t_startf ('CPL:cime_run_init') hashint = 0 + drv_resume=.FALSE. call seq_infodata_putData(infodata,atm_phase=1,lnd_phase=1,ocn_phase=1,ice_phase=1) call seq_timemgr_EClockGetData( EClock_d, stepno=begstep) @@ -2517,7 +2563,6 @@ subroutine cime_run() ! --- Write out performance data for initialization call seq_timemgr_EClockGetData( EClock_d, curr_ymd=ymd, curr_tod=tod) -#ifndef CPL_BYPASS ! Report on memory usage call shr_mem_getusage(msize,mrss) @@ -2530,7 +2575,8 @@ subroutine cime_run() glc(ens1)%iamroot_compid .or. & rof(ens1)%iamroot_compid .or. & wav(ens1)%iamroot_compid .or. & - iac(ens1)%iamroot_compid) then + iac(ens1)%iamroot_compid .or. & + info_mprof == 2) then write(logunit,105) ' memory_write: model date = ',ymd,tod, & ' memory = ',msize,' MB (highwater) ',mrss,' MB (usage)', & @@ -2659,7 +2705,6 @@ subroutine cime_run() endif endif ! iamroot_CPLID endif ! info_mprof > 0 -#endif ! Write out a timing file checkpoint write(timing_file,'(a,i8.8,a1,i5.5)') & trim(tchkpt_dir)//"/model_timing"//trim(cpl_inst_tag)//"_",ymd,"_",tod @@ -3021,23 +3066,27 @@ subroutine cime_run() endif if (rof_present) then if (iamin_CPLID) then - call cime_comp_barriers(mpicom=mpicom_CPLID, timer='DRIVER_ROFPOST_BARRIER') - call t_drvstartf ('DRIVER_ROFPOST',cplrun=.true.,barrier=mpicom_CPLID) + + call cime_comp_barriers(mpicom=mpicom_CPLID, timer='CPL:ROFPOST_BARRIER') + call t_drvstartf ('CPL:ROFPOST',cplrun=.true.,barrier=mpicom_CPLID) if (drv_threading) call seq_comm_setnthreads(nthreads_CPLID) if (do_hist_r2x) then - call t_drvstartf ('driver_rofpost_histaux', barrier=mpicom_CPLID) ! Write coupler's hr2x file at 24 hour marks, ! and at the end of the run interval, even if that's not at a 24 hour mark. write_hist_alarm = t24hr_alarm .or. stop_alarm + + call t_startf('CPL:seq_hist_writeaux-r2x') do eri = 1,num_inst_rof inst_suffix = component_get_suffix(rof(eri)) call seq_hist_writeaux(infodata, EClock_d, rof(eri), flow='c2x', & aname='r2x',dname='domrb',inst_suffix=trim(inst_suffix), & nx=rof_nx, ny=rof_ny, nt=1, write_now=write_hist_alarm) enddo - call t_drvstopf ('driver_rofpost_histaux') + call t_stopf('CPL:seq_hist_writeaux-r2x') + endif - call t_drvstopf ('DRIVER_ROFPOST', cplrun=.true.) + call t_drvstopf ('CPL:ROFPOST', cplrun=.true.) + endif endif !---------------------------------------------------------- @@ -3171,193 +3220,13 @@ subroutine cime_run() !---------------------------------------------------------- !| Write driver restart file !---------------------------------------------------------- - call cime_run_write_restart(drv_pause, restart_alarm, drv_resume) + call cime_run_write_restart(drv_pause, restart_alarm, drv_resume_file) !---------------------------------------------------------- !| Write history file, only AVs on CPLID !---------------------------------------------------------- - call cime_run_write_history() - - if (iamin_CPLID) then - - call cime_comp_barriers(mpicom=mpicom_CPLID, timer='CPL:HISTORY_BARRIER') - call t_drvstartf ('CPL:HISTORY',cplrun=.true.,barrier=mpicom_CPLID) - if ( history_alarm) then - if (drv_threading) call seq_comm_setnthreads(nthreads_CPLID) - if (iamroot_CPLID) then - write(logunit,104) ' Write history file at ',ymd,tod - call shr_sys_flush(logunit) - endif - - call seq_hist_write(infodata, EClock_d, & - atm, lnd, ice, ocn, rof, glc, wav, iac, & - fractions_ax, fractions_lx, fractions_ix, fractions_ox, & - fractions_rx, fractions_gx, fractions_wx, fractions_zx, trim(cpl_inst_tag)) - - if (drv_threading) call seq_comm_setnthreads(nthreads_GLOID) - endif + call cime_run_write_history(lnd2glc_averaged_now) - if (do_histavg) then - call seq_hist_writeavg(infodata, EClock_d, & - atm, lnd, ice, ocn, rof, glc, wav, iac, histavg_alarm, & - trim(cpl_inst_tag)) - endif - - if (do_hist_a2x) then - do eai = 1,num_inst_atm - inst_suffix = component_get_suffix(atm(eai)) - if (trim(hist_a2x_flds) == 'all') then - call seq_hist_writeaux(infodata, EClock_d, atm(eai), flow='c2x', & - aname='a2x',dname='doma', inst_suffix=trim(inst_suffix), & - nx=atm_nx, ny=atm_ny, nt=ncpl) - else - call seq_hist_writeaux(infodata, EClock_d, atm(eai), flow='c2x', & - aname='a2x',dname='doma', inst_suffix=trim(inst_suffix), & - nx=atm_nx, ny=atm_ny, nt=ncpl, flds=hist_a2x_flds) - endif - enddo - endif - - if (do_hist_a2x1hri .and. t1hr_alarm) then - do eai = 1,num_inst_atm - inst_suffix = component_get_suffix(atm(eai)) - if (trim(hist_a2x1hri_flds) == 'all') then - call seq_hist_writeaux(infodata, EClock_d, atm(eai), flow='c2x', & - aname='a2x1hi',dname='doma',inst_suffix=trim(inst_suffix), & - nx=atm_nx, ny=atm_ny, nt=24) - else - call seq_hist_writeaux(infodata, EClock_d, atm(eai), flow='c2x', & - aname='a2x1hi',dname='doma',inst_suffix=trim(inst_suffix), & - nx=atm_nx, ny=atm_ny, nt=24, flds=hist_a2x1hri_flds) - endif - enddo - endif - - if (do_hist_a2x1hr) then - do eai = 1,num_inst_atm - inst_suffix = component_get_suffix(atm(eai)) - if (trim(hist_a2x1hr_flds) == 'all') then - call seq_hist_writeaux(infodata, EClock_d, atm(eai), flow='c2x', & - aname='a2x1h',dname='doma',inst_suffix=trim(inst_suffix), & - nx=atm_nx, ny=atm_ny, nt=24, write_now=t1hr_alarm) - else - call seq_hist_writeaux(infodata, EClock_d, atm(eai), flow='c2x', & - aname='a2x1h',dname='doma',inst_suffix=trim(inst_suffix), & - nx=atm_nx, ny=atm_ny, nt=24, write_now=t1hr_alarm, flds=hist_a2x1hr_flds) - endif - enddo - endif - - if (do_hist_a2x3hr) then - do eai = 1,num_inst_atm - inst_suffix = component_get_suffix(atm(eai)) - if (trim(hist_a2x3hr_flds) == 'all') then - call seq_hist_writeaux(infodata, EClock_d, atm(eai), flow='c2x', & - aname='a2x3h',dname='doma',inst_suffix=trim(inst_suffix), & - nx=atm_nx, ny=atm_ny, nt=8, write_now=t3hr_alarm) - else - call seq_hist_writeaux(infodata, EClock_d, atm(eai), flow='c2x', & - aname='a2x3h',dname='doma',inst_suffix=trim(inst_suffix), & - nx=atm_nx, ny=atm_ny, nt=8, write_now=t3hr_alarm, flds=hist_a2x3hr_flds) - endif - enddo - endif - - if (do_hist_a2x3hrp) then - do eai = 1,num_inst_atm - inst_suffix = component_get_suffix(atm(eai)) - if (trim(hist_a2x3hrp_flds) == 'all') then - call seq_hist_writeaux(infodata, EClock_d, atm(eai), flow='c2x', & - aname='a2x3h_prec',dname='doma',inst_suffix=trim(inst_suffix), & - nx=atm_nx, ny=atm_ny, nt=8, write_now=t3hr_alarm) - else - call seq_hist_writeaux(infodata, EClock_d, atm(eai), flow='c2x', & - aname='a2x3h_prec',dname='doma',inst_suffix=trim(inst_suffix), & - nx=atm_nx, ny=atm_ny, nt=8, write_now=t3hr_alarm, flds=hist_a2x3hrp_flds) - endif - enddo - endif - - if (do_hist_a2x24hr) then - do eai = 1,num_inst_atm - inst_suffix = component_get_suffix(atm(eai)) - if (trim(hist_a2x24hr_flds) == 'all') then - call seq_hist_writeaux(infodata, EClock_d, atm(eai), flow='c2x', & - aname='a2x1d',dname='doma',inst_suffix=trim(inst_suffix), & - nx=atm_nx, ny=atm_ny, nt=1, write_now=t24hr_alarm) - else - call seq_hist_writeaux(infodata, EClock_d, atm(eai), flow='c2x', & - aname='a2x1d',dname='doma',inst_suffix=trim(inst_suffix), & - nx=atm_nx, ny=atm_ny, nt=1, write_now=t24hr_alarm, flds=hist_a2x24hr_flds) - endif - enddo - endif - - if (do_hist_l2x1yrg) then - ! We use a different approach here than for other aux hist files: For other - ! files, we let seq_hist_writeaux accumulate fields in time. However, if we - ! stop in the middle of an accumulation period, these accumulated fields get - ! reset (because they aren't written to the cpl restart file); this is - ! potentially a problem for this year-long accumulation. Thus, here, we use - ! the existing accumulated fields from prep_glc_mod, because those *do* - ! continue properly through a restart. - - ! The logic here assumes that we average the lnd2glc fields exactly at the - ! year boundary - no more and no less. If that's not the case, we're likely - ! to be writing the wrong thing to these aux files, so we check that - ! assumption here. - if (t1yr_alarm .and. .not. lnd2glc_averaged_now) then - write(logunit,*) 'ERROR: histaux_l2x1yrg requested;' - write(logunit,*) 'it is the year boundary, but lnd2glc fields were not averaged this time step.' - call shr_sys_abort(subname// & - ' do_hist_l2x1yrg and t1yr_alarm are true, but lnd2glc_averaged_now is false') - end if - if (lnd2glc_averaged_now .and. .not. t1yr_alarm) then - ! If we're averaging more frequently than yearly, then just writing the - ! current values of the averaged fields once per year won't give the true - ! annual averages. - write(logunit,*) 'ERROR: histaux_l2x1yrg requested;' - write(logunit,*) 'lnd2glc fields were averaged this time step, but it is not the year boundary.' - write(logunit,*) '(It only works to request histaux_l2x1yrg if GLC_AVG_PERIOD is yearly.)' - call shr_sys_abort(subname// & - ' do_hist_l2x1yrg and lnd2glc_averaged_now are true, but t1yr_alarm is false') - end if - - if (t1yr_alarm) then - call seq_timemgr_EClockGetData( EClock_d, ECurrTime = etime_curr) - ! We need to pass in tbnds1_offset because (unlike with most - ! seq_hist_writeaux calls) here we don't call seq_hist_writeaux every time - ! step, so the automatically determined lower time bound can be wrong. For - ! typical runs with a noleap calendar, we want tbnds1_offset = - ! -365. However, to determine this more generally, based on the calendar - ! we're using, we call this shr_cal routine. - call shr_cal_ymds2rday_offset(etime=etime_curr, & - rdays_offset = tbnds1_offset, & - years_offset = -1) - do eli = 1,num_inst_lnd - inst_suffix = component_get_suffix(lnd(eli)) - ! Use yr_offset=-1 so the file with fields from year 1 has time stamp - ! 0001-01-01 rather than 0002-01-01, etc. - call seq_hist_writeaux(infodata, EClock_d, lnd(eli), flow='c2x', & - aname='l2x1yr_glc',dname='doml',inst_suffix=trim(inst_suffix), & - nx=lnd_nx, ny=lnd_ny, nt=1, write_now=.true., & - tbnds1_offset = tbnds1_offset, yr_offset=-1, & - av_to_write=prep_glc_get_l2gacc_lx_one_instance(eli)) - enddo - endif - endif - - if (do_hist_l2x) then - do eli = 1,num_inst_lnd - inst_suffix = component_get_suffix(lnd(eli)) - call seq_hist_writeaux(infodata, EClock_d, lnd(eli), flow='c2x', & - aname='l2x',dname='doml',inst_suffix=trim(inst_suffix), & - nx=lnd_nx, ny=lnd_ny, nt=ncpl) - enddo - endif - call t_drvstopf ('CPL:HISTORY',cplrun=.true.) - - endif !---------------------------------------------------------- !| RUN ESP MODEL !---------------------------------------------------------- @@ -3403,7 +3272,7 @@ subroutine cime_run() WAVID(ewi), component_get_iamroot_compid(wav(ewi))) end do ! Here we pass 1 as num_inst_driver as num_inst_driver is used inside - call seq_resume_store_comp('x', drv_resume, 1, & + call seq_resume_store_comp('x', drv_resume_file, 1, & driver_id, iamroot_CPLID) call component_run(Eclock_e, esp, esp_run, infodata, & comp_prognostic=esp_prognostic, comp_num=comp_num_esp, & @@ -3457,26 +3326,36 @@ subroutine cime_run() end if call seq_resume_get_files('x', resume_files) if (associated(resume_files)) then - drv_resume = resume_files(driver_id) + drv_resume_file = resume_files(driver_id) end if end if !---------------------------------------------------------- !| RESUME (read restart) if signaled !---------------------------------------------------------- - if (len_trim(drv_resume) > 0) then + if (drv_resume) then if (iamroot_CPLID) then - write(logunit,103) subname,' Reading restart (resume) file ',trim(drv_resume) + write(logunit,103) subname,' Reading restart (resume) file ',trim(drv_resume_file) call shr_sys_flush(logunit) end if if (iamin_CPLID) then - call seq_rest_read(drv_resume, infodata, & + + call cime_comp_barriers(mpicom=mpicom_CPLID, timer='CPL:RESTART_READ_BARRIER') + call t_drvstartf ('CPL:RESTART_READ',cplrun=.true.,barrier=mpicom_CPLID) + + call t_startf('CPL:seq_rest_read') + call seq_rest_read(drv_resume_file, infodata, & atm, lnd, ice, ocn, rof, glc, wav, esp, iac, & fractions_ax, fractions_lx, fractions_ix, fractions_ox, & fractions_rx, fractions_gx, fractions_wx, fractions_zx) + call t_stopf('CPL:seq_rest_read') + + call t_drvstopf ('CPL:RESTART_READ',cplrun=.true.) + end if ! Clear the resume file so we don't try to read it again - drv_resume = ' ' + drv_resume = .FALSE. + drv_resume_file = ' ' end if !---------------------------------------------------------- @@ -3554,7 +3433,8 @@ subroutine cime_run() glc(ens1)%iamroot_compid .or. & wav(ens1)%iamroot_compid .or. & rof(ens1)%iamroot_compid .or. & - iac(ens1)%iamroot_compid)) then + iac(ens1)%iamroot_compid .or. & + info_mprof == 2)) then write(logunit,105) ' memory_write: model date = ',ymd,tod, & ' memory = ',msize,' MB (highwater) ',mrss,' MB (usage)', & @@ -3699,14 +3579,14 @@ subroutine cime_final() call seq_timemgr_EClockGetData( EClock_d, stepno=endstep) call shr_mem_getusage(msize,mrss) - call component_final(EClock_a, atm, atm_final) - call component_final(EClock_l, lnd, lnd_final) - call component_final(EClock_r, rof, rof_final) - call component_final(EClock_i, ice, ice_final) - call component_final(EClock_o, ocn, ocn_final) - call component_final(EClock_g, glc, glc_final) - call component_final(EClock_w, wav, wav_final) call component_final(EClock_w, iac, iac_final) + call component_final(EClock_w, wav, wav_final) + call component_final(EClock_g, glc, glc_final) + call component_final(EClock_o, ocn, ocn_final) + call component_final(EClock_i, ice, ice_final) + call component_final(EClock_r, rof, rof_final) + call component_final(EClock_l, lnd, lnd_final) + call component_final(EClock_a, atm, atm_final) !------------------------------------------------------------------------ ! End the run cleanly @@ -4174,6 +4054,8 @@ subroutine cime_run_ocn_recv_post() call component_diag(infodata, ocn, flow='c2x', comment= 'recv ocn', & info_debug=info_debug, timer_diag='CPL:ocnpost_diagav') + if (ocn_c2_rof) call prep_rof_accum_ocn(timer='CPL:ocnpost_acco2r') + call cime_run_ocnglc_coupling() if (drv_threading) call seq_comm_setnthreads(nthreads_GLOID) @@ -4333,7 +4215,7 @@ subroutine cime_run_atmocn_setup(hashint) ! ocn budget !---------------------------------------------------------- if (do_budgets) then - call cime_run_calc_budgets3() + call cime_run_calc_budgets3(in_cplrun=.true.) endif if (drv_threading) call seq_comm_setnthreads(nthreads_GLOID) @@ -4614,6 +4496,8 @@ subroutine cime_run_rof_setup_send() if (lnd_c2_rof) call prep_rof_calc_l2r_rx(fractions_lx, timer='CPL:rofprep_lnd2rof') if (atm_c2_rof) call prep_rof_calc_a2r_rx(timer='CPL:rofprep_atm2rof') + + if (ocn_c2_rof) call prep_rof_calc_o2r_rx(timer='CPL:rofprep_ocn2rof') call prep_rof_mrg(infodata, fractions_rx, timer_mrg='CPL:rofprep_mrgx2r', cime_model=cime_model) call component_diag(infodata, rof, flow='x2c', comment= 'send rof', & @@ -4658,8 +4542,10 @@ subroutine cime_run_rof_recv_post() ! rof post !---------------------------------------------------------- if (iamin_CPLID) then - call cime_comp_barriers(mpicom=mpicom_CPLID, timer='CPL:ROFPOST_BARRIER') - call t_drvstartf ('CPL:ROFPOST',cplrun=.true.,barrier=mpicom_CPLID) + + call cime_comp_barriers(mpicom=mpicom_CPLID, timer='CPL:ROFRUNPOST_BARRIER') + call t_drvstartf ('CPL:ROFRUNPOST',cplrun=.true.,barrier=mpicom_CPLID) + if (drv_threading) call seq_comm_setnthreads(nthreads_CPLID) call component_diag(infodata, rof, flow='c2x', comment= 'recv rof', & @@ -4670,7 +4556,9 @@ subroutine cime_run_rof_recv_post() if (rof_c2_ice) call prep_ice_calc_r2x_ix(timer='CPL:rofpost_rof2ice') if (rof_c2_ocn) call prep_ocn_calc_r2x_ox(timer='CPL:rofpost_rof2ocn') end if - call t_drvstopf ('CPL:ROFPOST', cplrun=.true.) + + call t_drvstopf ('CPL:ROFRUNPOST', cplrun=.true.) + endif end subroutine cime_run_rof_recv_post @@ -4865,7 +4753,7 @@ end subroutine cime_run_update_fractions !---------------------------------------------------------------------------------- - subroutine cime_run_calc_budgets1() + subroutine cime_run_calc_budgets1(in_cplrun) !---------------------------------------------------------- ! Budget with old fractions @@ -4878,9 +4766,21 @@ subroutine cime_run_calc_budgets1() ! it will also use the current r2x_ox here which is the value from the last timestep ! consistent with the ocean coupling + logical,intent(in),optional :: in_cplrun ! flag indicating whether routine + ! called within the scope of the + ! CPL:RUN timer + + logical :: lcplrun + !------------------------------------------------------------------------------- + + lcplrun = .true. + if (present(in_cplrun)) then + lcplrun = .not. in_cplrun + endif + if (iamin_CPLID) then call cime_comp_barriers(mpicom=mpicom_CPLID, timer='CPL:BUDGET1_BARRIER') - call t_drvstartf ('CPL:BUDGET1',cplrun=.true.,budget=.true.,barrier=mpicom_CPLID) + call t_drvstartf ('CPL:BUDGET1',cplrun=lcplrun,budget=.true.,barrier=mpicom_CPLID) if (lnd_present) then call seq_diag_lnd_mct(lnd(ens1), fractions_lx(ens1), infodata, do_l2x=.true., do_x2l=.true.) endif @@ -4890,76 +4790,133 @@ subroutine cime_run_calc_budgets1() if (ice_present) then call seq_diag_ice_mct(ice(ens1), fractions_ix(ens1), infodata, do_x2i=.true.) endif - call t_drvstopf ('CPL:BUDGET1',cplrun=.true.,budget=.true.) + if (do_bgc_budgets) then + if (rof_present) then + call seq_diagBGC_rof_mct(rof(ens1), fractions_rx(ens1), infodata) + endif + endif + call t_drvstopf ('CPL:BUDGET1',cplrun=lcplrun,budget=.true.) end if end subroutine cime_run_calc_budgets1 !---------------------------------------------------------------------------------- - subroutine cime_run_calc_budgets2() + subroutine cime_run_calc_budgets2(in_cplrun) !---------------------------------------------------------- ! Budget with new fractions !---------------------------------------------------------- + logical,intent(in),optional :: in_cplrun ! flag indicating whether routine + ! called within the scope of the + ! CPL:RUN timer + + logical :: lcplrun + !------------------------------------------------------------------------------- + + lcplrun = .true. + if (present(in_cplrun)) then + lcplrun = .not. in_cplrun + endif + if (iamin_CPLID) then call cime_comp_barriers(mpicom=mpicom_CPLID, timer='CPL:BUDGET2_BARRIER') - call t_drvstartf ('CPL:BUDGET2',cplrun=.true.,budget=.true.,barrier=mpicom_CPLID) + call t_drvstartf ('CPL:BUDGET2',cplrun=lcplrun,budget=.true.,barrier=mpicom_CPLID) if (atm_present) then call seq_diag_atm_mct(atm(ens1), fractions_ax(ens1), infodata, do_a2x=.true., do_x2a=.true.) endif if (ice_present) then call seq_diag_ice_mct(ice(ens1), fractions_ix(ens1), infodata, do_i2x=.true.) endif - call t_drvstopf ('CPL:BUDGET2',cplrun=.true.,budget=.true.) + if (do_bgc_budgets) then + if (atm_present) then + call seq_diagBGC_atm_mct(atm(ens1), fractions_ax(ens1), infodata, do_a2x=.true., do_x2a=.true.) + endif + if (ice_present) then + call seq_diagBGC_ice_mct(ice(ens1), fractions_ix(ens1), infodata, do_i2x=.true., do_x2i=.true.) + endif + if (lnd_present) then + call seq_diagBGC_lnd_mct(lnd(ens1), fractions_lx(ens1), infodata, do_l2x=.true., do_x2l=.true.) + endif + if (ocn_present) then + call seq_diagBGC_ocn_mct(ocn(ens1), xao_ox(1), fractions_ox(ens1), infodata, & + do_o2x=.true., do_x2o=.true., do_xao=.true.) + endif + endif + call t_drvstopf ('CPL:BUDGET2',cplrun=lcplrun,budget=.true.) - call t_drvstartf ('CPL:BUDGET3',cplrun=.true.,budget=.true.,barrier=mpicom_CPLID) + call t_drvstartf ('CPL:BUDGET3',cplrun=lcplrun,budget=.true.,barrier=mpicom_CPLID) call seq_diag_accum_mct() - call t_drvstopf ('CPL:BUDGET3',cplrun=.true.,budget=.true.) + if (do_bgc_budgets) then + call seq_diagBGC_accum_mct() + endif + call t_drvstopf ('CPL:BUDGET3',cplrun=lcplrun,budget=.true.) - call t_drvstartf ('CPL:BUDGETF',cplrun=.true.,budget=.true.,barrier=mpicom_CPLID) + call t_drvstartf ('CPL:BUDGETF',cplrun=lcplrun,budget=.true.,barrier=mpicom_CPLID) if (.not. dead_comps) then - call seq_diag_print_mct(EClock_d,stop_alarm,budget_inst, & + call seq_diag_print_mct(EClock_d,stop_alarm,do_bgc_budgets, budget_inst, & budget_daily, budget_month, budget_ann, budget_ltann, & budget_ltend, infodata) endif call seq_diag_zero_mct(EClock=EClock_d) + if (do_bgc_budgets) then + call seq_diagBGC_zero_mct(EClock=EClock_d) + endif - call t_drvstopf ('CPL:BUDGETF',cplrun=.true.,budget=.true.) + call t_drvstopf ('CPL:BUDGETF',cplrun=lcplrun,budget=.true.) end if end subroutine cime_run_calc_budgets2 !---------------------------------------------------------------------------------- - subroutine cime_run_calc_budgets3() + subroutine cime_run_calc_budgets3(in_cplrun) !---------------------------------------------------------- ! ocn budget (rasm_option2) !---------------------------------------------------------- + logical,intent(in),optional :: in_cplrun ! flag indicating whether routine + ! called within the scope of the + ! CPL:RUN timer + + logical :: lcplrun + !------------------------------------------------------------------------------- + + lcplrun = .true. + if (present(in_cplrun)) then + lcplrun = .not. in_cplrun + endif + if (iamin_CPLID) then call cime_comp_barriers(mpicom=mpicom_CPLID, timer='CPL:BUDGET0_BARRIER') - call t_drvstartf ('CPL:BUDGET0',cplrun=.true.,budget=.true.,barrier=mpicom_CPLID) + call t_drvstartf ('CPL:BUDGET0',cplrun=lcplrun,budget=.true.,barrier=mpicom_CPLID) xao_ox => prep_aoflux_get_xao_ox() ! array over all instances call seq_diag_ocn_mct(ocn(ens1), xao_ox(1), fractions_ox(ens1), infodata, & do_o2x=.true., do_x2o=.true., do_xao=.true.) - call t_drvstopf ('CPL:BUDGET0',cplrun=.true.,budget=.true.) + call t_drvstopf ('CPL:BUDGET0',cplrun=lcplrun,budget=.true.) end if end subroutine cime_run_calc_budgets3 !---------------------------------------------------------------------------------- - subroutine cime_run_write_history() + subroutine cime_run_write_history(lnd2glc_averaged_now) !---------------------------------------------------------- ! Write history file, only AVs on CPLID !---------------------------------------------------------- + logical,intent(in) :: lnd2glc_averaged_now ! Whether lnd2glc averages were taken this timestep + + type(ESMF_Time) :: etime_curr ! Current model time + real(r8) :: tbnds1_offset ! Time offset for call to seq_hist_writeaux + if (iamin_CPLID) then call cime_comp_barriers(mpicom=mpicom_CPLID, timer='CPL:HISTORY_BARRIER') call t_drvstartf ('CPL:HISTORY',cplrun=.true.,barrier=mpicom_CPLID) + call t_startf('CPL:cime_run_write_history') + if ( history_alarm) then if (drv_threading) call seq_comm_setnthreads(nthreads_CPLID) if (iamroot_CPLID) then @@ -4967,20 +4924,212 @@ subroutine cime_run_write_history() call shr_sys_flush(logunit) endif + call t_startf('CPL:seq_hist_write') call seq_hist_write(infodata, EClock_d, & atm, lnd, ice, ocn, rof, glc, wav, iac, & fractions_ax, fractions_lx, fractions_ix, fractions_ox, & fractions_rx, fractions_gx, fractions_wx, fractions_zx, trim(cpl_inst_tag)) + call t_stopf('CPL:seq_hist_write') if (drv_threading) call seq_comm_setnthreads(nthreads_GLOID) endif if (do_histavg) then + + call t_startf('CPL:seq_hist_writeavg') call seq_hist_writeavg(infodata, EClock_d, & atm, lnd, ice, ocn, rof, glc, wav, iac, histavg_alarm, & trim(cpl_inst_tag)) + call t_stopf('CPL:seq_hist_writeavg') + endif + if (do_hist_a2x) then + + call t_startf('CPL:seq_hist_writeaux-a2x') + do eai = 1,num_inst_atm + inst_suffix = component_get_suffix(atm(eai)) + if (trim(hist_a2x_flds) == 'all') then + call seq_hist_writeaux(infodata, EClock_d, atm(eai), flow='c2x', & + aname='a2x',dname='doma', inst_suffix=trim(inst_suffix), & + nx=atm_nx, ny=atm_ny, nt=ncpl) + else + call seq_hist_writeaux(infodata, EClock_d, atm(eai), flow='c2x', & + aname='a2x',dname='doma', inst_suffix=trim(inst_suffix), & + nx=atm_nx, ny=atm_ny, nt=ncpl, flds=hist_a2x_flds) + endif + enddo + call t_stopf('CPL:seq_hist_writeaux-a2x') + + endif + + if (do_hist_a2x1hri .and. t1hr_alarm) then + + call t_startf('CPL:seq_hist_writeaux-a2x1hri') + do eai = 1,num_inst_atm + inst_suffix = component_get_suffix(atm(eai)) + if (trim(hist_a2x1hri_flds) == 'all') then + call seq_hist_writeaux(infodata, EClock_d, atm(eai), flow='c2x', & + aname='a2x1hi',dname='doma',inst_suffix=trim(inst_suffix), & + nx=atm_nx, ny=atm_ny, nt=24) + else + call seq_hist_writeaux(infodata, EClock_d, atm(eai), flow='c2x', & + aname='a2x1hi',dname='doma',inst_suffix=trim(inst_suffix), & + nx=atm_nx, ny=atm_ny, nt=24, flds=hist_a2x1hri_flds) + endif + enddo + call t_stopf('CPL:seq_hist_writeaux-a2x1hri') + + endif + + if (do_hist_a2x1hr) then + + call t_startf('CPL:seq_hist_writeaux-a2x1hr') + do eai = 1,num_inst_atm + inst_suffix = component_get_suffix(atm(eai)) + if (trim(hist_a2x1hr_flds) == 'all') then + call seq_hist_writeaux(infodata, EClock_d, atm(eai), flow='c2x', & + aname='a2x1h',dname='doma',inst_suffix=trim(inst_suffix), & + nx=atm_nx, ny=atm_ny, nt=24, write_now=t1hr_alarm) + else + call seq_hist_writeaux(infodata, EClock_d, atm(eai), flow='c2x', & + aname='a2x1h',dname='doma',inst_suffix=trim(inst_suffix), & + nx=atm_nx, ny=atm_ny, nt=24, write_now=t1hr_alarm, flds=hist_a2x1hr_flds) + endif + enddo + call t_stopf('CPL:seq_hist_writeaux-a2x1hr') + + endif + + if (do_hist_a2x3hr) then + + call t_startf('CPL:seq_hist_writeaux-a2x3hr') + do eai = 1,num_inst_atm + inst_suffix = component_get_suffix(atm(eai)) + if (trim(hist_a2x3hr_flds) == 'all') then + call seq_hist_writeaux(infodata, EClock_d, atm(eai), flow='c2x', & + aname='a2x3h',dname='doma',inst_suffix=trim(inst_suffix), & + nx=atm_nx, ny=atm_ny, nt=8, write_now=t3hr_alarm) + else + call seq_hist_writeaux(infodata, EClock_d, atm(eai), flow='c2x', & + aname='a2x3h',dname='doma',inst_suffix=trim(inst_suffix), & + nx=atm_nx, ny=atm_ny, nt=8, write_now=t3hr_alarm, flds=hist_a2x3hr_flds) + endif + enddo + call t_stopf('CPL:seq_hist_writeaux-a2x3hr') + + endif + + if (do_hist_a2x3hrp) then + + call t_startf('CPL:seq_hist_writeaux-a2x3hrp') + do eai = 1,num_inst_atm + inst_suffix = component_get_suffix(atm(eai)) + if (trim(hist_a2x3hrp_flds) == 'all') then + call seq_hist_writeaux(infodata, EClock_d, atm(eai), flow='c2x', & + aname='a2x3h_prec',dname='doma',inst_suffix=trim(inst_suffix), & + nx=atm_nx, ny=atm_ny, nt=8, write_now=t3hr_alarm) + else + call seq_hist_writeaux(infodata, EClock_d, atm(eai), flow='c2x', & + aname='a2x3h_prec',dname='doma',inst_suffix=trim(inst_suffix), & + nx=atm_nx, ny=atm_ny, nt=8, write_now=t3hr_alarm, flds=hist_a2x3hrp_flds) + endif + enddo + call t_stopf('CPL:seq_hist_writeaux-a2x3hrp') + + endif + + if (do_hist_a2x24hr) then + + call t_startf('CPL:seq_hist_writeaux-a2x24hr') + do eai = 1,num_inst_atm + inst_suffix = component_get_suffix(atm(eai)) + if (trim(hist_a2x24hr_flds) == 'all') then + call seq_hist_writeaux(infodata, EClock_d, atm(eai), flow='c2x', & + aname='a2x1d',dname='doma',inst_suffix=trim(inst_suffix), & + nx=atm_nx, ny=atm_ny, nt=1, write_now=t24hr_alarm) + else + call seq_hist_writeaux(infodata, EClock_d, atm(eai), flow='c2x', & + aname='a2x1d',dname='doma',inst_suffix=trim(inst_suffix), & + nx=atm_nx, ny=atm_ny, nt=1, write_now=t24hr_alarm, flds=hist_a2x24hr_flds) + endif + enddo + call t_stopf('CPL:seq_hist_writeaux-a2x24hr') + + endif + + if (do_hist_l2x1yrg) then + ! We use a different approach here than for other aux hist files: For other + ! files, we let seq_hist_writeaux accumulate fields in time. However, if we + ! stop in the middle of an accumulation period, these accumulated fields get + ! reset (because they aren't written to the cpl restart file); this is + ! potentially a problem for this year-long accumulation. Thus, here, we use + ! the existing accumulated fields from prep_glc_mod, because those *do* + ! continue properly through a restart. + + ! The logic here assumes that we average the lnd2glc fields exactly at the + ! year boundary - no more and no less. If that's not the case, we're likely + ! to be writing the wrong thing to these aux files, so we check that + ! assumption here. + if (t1yr_alarm .and. .not. lnd2glc_averaged_now) then + write(logunit,*) 'ERROR: histaux_l2x1yrg requested;' + write(logunit,*) 'it is the year boundary, but lnd2glc fields were not averaged this time step.' + call shr_sys_abort(subname// & + ' do_hist_l2x1yrg and t1yr_alarm are true, but lnd2glc_averaged_now is false') + end if + if (lnd2glc_averaged_now .and. .not. t1yr_alarm) then + ! If we're averaging more frequently than yearly, then just writing the + ! current values of the averaged fields once per year won't give the true + ! annual averages. + write(logunit,*) 'ERROR: histaux_l2x1yrg requested;' + write(logunit,*) 'lnd2glc fields were averaged this time step, but it is not the year boundary.' + write(logunit,*) '(It only works to request histaux_l2x1yrg if GLC_AVG_PERIOD is yearly.)' + call shr_sys_abort(subname// & + ' do_hist_l2x1yrg and lnd2glc_averaged_now are true, but t1yr_alarm is false') + end if + + if (t1yr_alarm) then + call seq_timemgr_EClockGetData( EClock_d, ECurrTime = etime_curr) + ! We need to pass in tbnds1_offset because (unlike with most + ! seq_hist_writeaux calls) here we don't call seq_hist_writeaux every time + ! step, so the automatically determined lower time bound can be wrong. For + ! typical runs with a noleap calendar, we want tbnds1_offset = + ! -365. However, to determine this more generally, based on the calendar + ! we're using, we call this shr_cal routine. + call shr_cal_ymds2rday_offset(etime=etime_curr, & + rdays_offset = tbnds1_offset, & + years_offset = -1) + + call t_startf('CPL:seq_hist_writeaux-l2x1yrg') + do eli = 1,num_inst_lnd + inst_suffix = component_get_suffix(lnd(eli)) + ! Use yr_offset=-1 so the file with fields from year 1 has time stamp + ! 0001-01-01 rather than 0002-01-01, etc. + call seq_hist_writeaux(infodata, EClock_d, lnd(eli), flow='c2x', & + aname='l2x1yr_glc',dname='doml',inst_suffix=trim(inst_suffix), & + nx=lnd_nx, ny=lnd_ny, nt=1, write_now=.true., & + tbnds1_offset = tbnds1_offset, yr_offset=-1, & + av_to_write=prep_glc_get_l2gacc_lx_one_instance(eli)) + enddo + call t_stopf('CPL:seq_hist_writeaux-l2x1yrg') + + endif + endif + + if (do_hist_l2x) then + + call t_startf('CPL:seq_hist_writeaux-l2x') + do eli = 1,num_inst_lnd + inst_suffix = component_get_suffix(lnd(eli)) + call seq_hist_writeaux(infodata, EClock_d, lnd(eli), flow='c2x', & + aname='l2x',dname='doml',inst_suffix=trim(inst_suffix), & + nx=lnd_nx, ny=lnd_ny, nt=ncpl) + enddo + call t_stopf('CPL:seq_hist_writeaux-l2x') + + endif + + call t_stopf('CPL:cime_run_write_history') call t_drvstopf ('CPL:HISTORY',cplrun=.true.) end if @@ -4990,7 +5139,7 @@ end subroutine cime_run_write_history !---------------------------------------------------------------------------------- - subroutine cime_run_write_restart(drv_pause, write_restart, drv_resume) + subroutine cime_run_write_restart(drv_pause, write_restart, drv_resume_file) !---------------------------------------------------------- ! Write driver restart file @@ -4998,7 +5147,7 @@ subroutine cime_run_write_restart(drv_pause, write_restart, drv_resume) logical , intent(in) :: drv_pause logical , intent(in) :: write_restart - character(len=*), intent(inout) :: drv_resume ! Driver resets state from restart file + character(len=*), intent(inout) :: drv_resume_file ! Driver resets state from restart file 103 format( 5A ) 104 format( A, i10.8, i8) @@ -5007,27 +5156,33 @@ subroutine cime_run_write_restart(drv_pause, write_restart, drv_resume) if ( (restart_alarm .or. drv_pause)) then call cime_comp_barriers(mpicom=mpicom_CPLID, timer='CPL:RESTART_BARRIER') call t_drvstartf ('CPL:RESTART',cplrun=.true.,barrier=mpicom_CPLID) + call t_startf('CPL:cime_run_write_restart') + if (drv_threading) call seq_comm_setnthreads(nthreads_CPLID) if (iamroot_CPLID) then write(logunit,104) ' Write restart file at ',ymd,tod call shr_sys_flush(logunit) endif + call t_startf('CPL:seq_rest_write') call seq_rest_write(EClock_d, seq_SyncClock, infodata, & atm, lnd, ice, ocn, rof, glc, wav, esp, iac, & fractions_ax, fractions_lx, fractions_ix, fractions_ox, & fractions_rx, fractions_gx, fractions_wx, fractions_zx, & - trim(cpl_inst_tag), drv_resume) + trim(cpl_inst_tag), drv_resume_file) + call t_stopf('CPL:seq_rest_write') if (iamroot_CPLID) then - write(logunit,103) ' Restart filename: ',trim(drv_resume) + write(logunit,103) ' Restart filename: ',trim(drv_resume_file) call shr_sys_flush(logunit) endif if (drv_threading) call seq_comm_setnthreads(nthreads_GLOID) + + call t_stopf('CPL:cime_run_write_restart') call t_drvstopf ('CPL:RESTART',cplrun=.true.) else - drv_resume = '' + drv_resume_file = ' ' endif end if diff --git a/driver-moab/main/component_mod.F90 b/driver-moab/main/component_mod.F90 index 0c8ffcb11f7b..92092b89b7b3 100644 --- a/driver-moab/main/component_mod.F90 +++ b/driver-moab/main/component_mod.F90 @@ -500,10 +500,13 @@ subroutine component_init_aream(infodata, rof_c2_ocn, samegrid_ao, samegrid_al, dom_s => component_get_dom_cx(ocn(1)) ! dom_ox dom_d => component_get_dom_cx(atm(1)) ! dom_ax + call t_startf('CPL:seq_map_readdata-ocn2atm') call seq_map_readdata('seq_maps.rc','ocn2atm_fmapname:', mpicom_CPLID, CPLID, & gsmap_s=gsmap_s, av_s=dom_s%data, avfld_s='aream', filefld_s='area_a', & gsmap_d=gsmap_d, av_d=dom_d%data, avfld_d='aream', filefld_d='area_b', & string='ocn2atm aream initialization') + call t_stopf('CPL:seq_map_readdata-ocn2atm') + endif end if @@ -519,13 +522,18 @@ subroutine component_init_aream(infodata, rof_c2_ocn, samegrid_ao, samegrid_al, gsmap_s => component_get_gsmap_cx(rof(1)) ! gsmap_rx dom_s => component_get_dom_cx(rof(1)) ! dom_rx + call t_startf('CPL:seq_map_readdata-rof2ocn_liq') call seq_map_readdata('seq_maps.rc', 'rof2ocn_liq_rmapname:',mpicom_CPLID, CPLID, & gsmap_s=gsmap_s, av_s=dom_s%data, avfld_s='aream', filefld_s='area_a', & string='rof2ocn liq aream initialization') + call t_stopf('CPL:seq_map_readdata-rof2ocn_liq') + call t_startf('CPL:seq_map_readdata-rof2ocn_ice') call seq_map_readdata('seq_maps.rc', 'rof2ocn_ice_rmapname:',mpicom_CPLID, CPLID, & gsmap_s=gsmap_s, av_s=dom_s%data, avfld_s='aream', filefld_s='area_a', & string='rof2ocn ice aream initialization') + call t_stopf('CPL:seq_map_readdata-rof2ocn_ice') + endif end if @@ -539,9 +547,12 @@ subroutine component_init_aream(infodata, rof_c2_ocn, samegrid_ao, samegrid_al, gsmap_d => component_get_gsmap_cx(lnd(1)) ! gsmap_lx dom_d => component_get_dom_cx(lnd(1)) ! dom_lx + call t_startf('CPL:seq_map_readdata-atm2lnd') call seq_map_readdata('seq_maps.rc','atm2lnd_fmapname:',mpicom_CPLID, CPLID, & gsmap_d=gsmap_d, av_d=dom_d%data, avfld_d='aream', filefld_d='area_b', & string='atm2lnd aream initialization') + call t_stopf('CPL:seq_map_readdata-atm2lnd') + endif end if @@ -555,9 +566,12 @@ subroutine component_init_aream(infodata, rof_c2_ocn, samegrid_ao, samegrid_al, gsmap_d => component_get_gsmap_cx(glc(1)) ! gsmap_gx dom_d => component_get_dom_cx(glc(1)) ! dom_gx + call t_startf('CPL:seq_map_readdata-lnd2glc') call seq_map_readdata('seq_maps.rc','lnd2glc_fmapname:',mpicom_CPLID, CPLID, & gsmap_d=gsmap_d, av_d=dom_d%data, avfld_d='aream', filefld_d='area_b', & string='lnd2glc aream initialization') + call t_stopf('CPL:seq_map_readdata-lnd2glc') + endif endif diff --git a/driver-moab/main/component_type_mod.F90 b/driver-moab/main/component_type_mod.F90 index e79e42a53aeb..310deb14db68 100644 --- a/driver-moab/main/component_type_mod.F90 +++ b/driver-moab/main/component_type_mod.F90 @@ -250,6 +250,7 @@ subroutine check_fields(comp, comp_index) ! c2x_cc is allocated even if not used such as in stub models ! do not test this case. if(lsize <= 1 .and. nflds <= 1) return +#ifndef CPRFJ if(any(shr_infnan_isnan(comp%c2x_cc%rattr))) then do fld=1,nflds do n=1,lsize @@ -263,6 +264,7 @@ subroutine check_fields(comp, comp_index) enddo enddo endif +#endif endif end subroutine check_fields diff --git a/driver-moab/main/prep_atm_mod.F90 b/driver-moab/main/prep_atm_mod.F90 index c869861c8227..56b993af063d 100644 --- a/driver-moab/main/prep_atm_mod.F90 +++ b/driver-moab/main/prep_atm_mod.F90 @@ -94,7 +94,7 @@ module prep_atm_mod ! other module variables integer :: mpicom_CPLID ! MPI cpl communicator logical :: iamroot_CPLID ! .true. => CPLID masterproc - + logical :: samegrid_al ! samegrid atm and land !================================================================================================ contains @@ -120,7 +120,6 @@ subroutine prep_atm_init(infodata, ocn_c2_atm, ice_c2_atm, lnd_c2_atm, iac_c2_at integer :: lsize_a integer :: eli, eii, emi logical :: samegrid_ao ! samegrid atm and ocean - logical :: samegrid_al ! samegrid atm and land logical :: esmf_map_flag ! .true. => use esmf for mapping logical :: atm_present ! .true. => atm is present logical :: ocn_present ! .true. => ocn is present @@ -737,8 +736,8 @@ subroutine prep_atm_merge( l2x_a, o2x_a, xao_a, i2x_a, fractions_a, x2a_a ) type(mct_aVect), intent(inout) :: x2a_a ! ! Local workspace - real(r8) :: fracl, fraci, fraco - integer :: n,ka,ki,kl,ko,kx,kof,kif,klf,i,i1,o1 + real(r8) :: fracl, fraci, fraco, fracl_st + integer :: n,ka,ki,kl,ko,kx,kof,kif,klf,klf_st,i,i1,o1 integer :: lsize integer :: index_x2a_Sf_lfrac integer :: index_x2a_Sf_ifrac @@ -755,12 +754,13 @@ subroutine prep_atm_merge( l2x_a, o2x_a, xao_a, i2x_a, fractions_a, x2a_a ) character(CL),allocatable :: itemc_ocn(:) ! string converted to char logical :: iamroot character(CL),allocatable :: mrgstr(:) ! temporary string + character(CL) :: fracstr, fracstr_st logical, save :: first_time = .true. type(mct_aVect_sharedindices),save :: l2x_sharedindices type(mct_aVect_sharedindices),save :: o2x_sharedindices type(mct_aVect_sharedindices),save :: i2x_sharedindices type(mct_aVect_sharedindices),save :: xao_sharedindices - logical, pointer, save :: lmerge(:),imerge(:),xmerge(:),omerge(:) + logical, pointer, save :: lmerge(:),imerge(:),xmerge(:),omerge(:),lstate(:) integer, pointer, save :: lindx(:), iindx(:), oindx(:),xindx(:) integer, save :: naflds, nlflds,niflds,noflds,nxflds character(*), parameter :: subname = '(prep_atm_merge) ' @@ -780,6 +780,7 @@ subroutine prep_atm_merge( l2x_a, o2x_a, xao_a, i2x_a, fractions_a, x2a_a ) allocate(iindx(naflds), imerge(naflds)) allocate(xindx(naflds), xmerge(naflds)) allocate(oindx(naflds), omerge(naflds)) + allocate(lindx(naflds), lstate(naflds)) allocate(field_atm(naflds), itemc_atm(naflds)) allocate(field_lnd(nlflds), itemc_lnd(nlflds)) allocate(field_ice(niflds), itemc_ice(niflds)) @@ -795,6 +796,7 @@ subroutine prep_atm_merge( l2x_a, o2x_a, xao_a, i2x_a, fractions_a, x2a_a ) imerge(:) = .true. xmerge(:) = .true. omerge(:) = .true. + lstate(:) = .false. do ka = 1,naflds field_atm(ka) = mct_aVect_getRList2c(ka, x2a_a) @@ -836,6 +838,9 @@ subroutine prep_atm_merge( l2x_a, o2x_a, xao_a, i2x_a, fractions_a, x2a_a ) if (field_atm(ka)(1:1) == 'S' .and. field_atm(ka)(2:2) /= 'x') then cycle ! any state fields that are not Sx_ will just be copied end if + if (field_atm(ka)(1:1) == 'S') then + lstate(ka) = .true. + end if do kl = 1,nlflds if (trim(itemc_atm(ka)) == trim(itemc_lnd(kl))) then @@ -937,13 +942,23 @@ subroutine prep_atm_merge( l2x_a, o2x_a, xao_a, i2x_a, fractions_a, x2a_a ) ! Update surface fractions kif=mct_aVect_indexRA(fractions_a,"ifrac") - klf=mct_aVect_indexRA(fractions_a,"lfrac") kof=mct_aVect_indexRA(fractions_a,"ofrac") + klf_st = mct_aVect_indexRA(fractions_a,"lfrac") + fracstr_st = 'lfrac' + if (samegrid_al) then + klf = mct_aVect_indexRA(fractions_a,"lfrac") + fracstr = 'lfrac' + else + klf = mct_aVect_indexRA(fractions_a,"lfrin") + fracstr = 'lfrin' + endif + lsize = mct_avect_lsize(x2a_a) index_x2a_Sf_lfrac = mct_aVect_indexRA(x2a_a,'Sf_lfrac') index_x2a_Sf_ifrac = mct_aVect_indexRA(x2a_a,'Sf_ifrac') index_x2a_Sf_ofrac = mct_aVect_indexRA(x2a_a,'Sf_ofrac') + do n = 1,lsize x2a_a%rAttr(index_x2a_Sf_lfrac,n) = fractions_a%Rattr(klf,n) x2a_a%rAttr(index_x2a_Sf_ifrac,n) = fractions_a%Rattr(kif,n) @@ -952,7 +967,7 @@ subroutine prep_atm_merge( l2x_a, o2x_a, xao_a, i2x_a, fractions_a, x2a_a ) !--- document fraction operations --- if (first_time) then - mrgstr(index_x2a_sf_lfrac) = trim(mrgstr(index_x2a_sf_lfrac))//' = fractions_a%lfrac' + mrgstr(index_x2a_sf_lfrac) = trim(mrgstr(index_x2a_sf_lfrac))//' = fractions_a%'//trim(fracstr) mrgstr(index_x2a_sf_ifrac) = trim(mrgstr(index_x2a_sf_ifrac))//' = fractions_a%ifrac' mrgstr(index_x2a_sf_ofrac) = trim(mrgstr(index_x2a_sf_ofrac))//' = fractions_a%ofrac' endif @@ -1004,10 +1019,18 @@ subroutine prep_atm_merge( l2x_a, o2x_a, xao_a, i2x_a, fractions_a, x2a_a ) !--- document merge --- if (first_time) then if (lindx(ka) > 0) then - if (lmerge(ka)) then - mrgstr(ka) = trim(mrgstr(ka))//' + lfrac*l2x%'//trim(field_lnd(lindx(ka))) + if (lstate(ka)) then + if (lmerge(ka)) then + mrgstr(ka) = trim(mrgstr(ka))//' + '//trim(fracstr_st)//'*l2x%'//trim(field_lnd(lindx(ka))) + else + mrgstr(ka) = trim(mrgstr(ka))//' = '//trim(fracstr_st)//'*l2x%'//trim(field_lnd(lindx(ka))) + end if else - mrgstr(ka) = trim(mrgstr(ka))//' = lfrac*l2x%'//trim(field_lnd(lindx(ka))) + if (lmerge(ka)) then + mrgstr(ka) = trim(mrgstr(ka))//' + '//trim(fracstr)//'*l2x%'//trim(field_lnd(lindx(ka))) + else + mrgstr(ka) = trim(mrgstr(ka))//' = '//trim(fracstr)//'*l2x%'//trim(field_lnd(lindx(ka))) + end if end if end if if (iindx(ka) > 0) then @@ -1036,13 +1059,22 @@ subroutine prep_atm_merge( l2x_a, o2x_a, xao_a, i2x_a, fractions_a, x2a_a ) do n = 1,lsize fracl = fractions_a%Rattr(klf,n) + fracl_st = fractions_a%Rattr(klf_st,n) fraci = fractions_a%Rattr(kif,n) fraco = fractions_a%Rattr(kof,n) if (lindx(ka) > 0 .and. fracl > 0._r8) then - if (lmerge(ka)) then - x2a_a%rAttr(ka,n) = x2a_a%rAttr(ka,n) + l2x_a%rAttr(lindx(ka),n) * fracl + if (lstate(ka)) then + if (lmerge(ka)) then + x2a_a%rAttr(ka,n) = x2a_a%rAttr(ka,n) + l2x_a%rAttr(lindx(ka),n) * fracl_st + else + x2a_a%rAttr(ka,n) = l2x_a%rAttr(lindx(ka),n) * fracl_st + end if else - x2a_a%rAttr(ka,n) = l2x_a%rAttr(lindx(ka),n) * fracl + if (lmerge(ka)) then + x2a_a%rAttr(ka,n) = x2a_a%rAttr(ka,n) + l2x_a%rAttr(lindx(ka),n) * fracl + else + x2a_a%rAttr(ka,n) = l2x_a%rAttr(lindx(ka),n) * fracl + end if end if end if if (iindx(ka) > 0 .and. fraci > 0._r8) then diff --git a/driver-moab/main/prep_ocn_mod.F90 b/driver-moab/main/prep_ocn_mod.F90 index bbebe721bed2..acb44090d631 100644 --- a/driver-moab/main/prep_ocn_mod.F90 +++ b/driver-moab/main/prep_ocn_mod.F90 @@ -1464,6 +1464,17 @@ subroutine prep_ocn_merge( flux_epbalfact, a2x_o, i2x_o, r2x_o, w2x_o, g2x_o, xa integer, save :: index_a2x_Faxa_rainl integer, save :: index_r2x_Forr_rofl integer, save :: index_r2x_Forr_rofi + integer, save :: index_r2x_Forr_rofDIN + integer, save :: index_r2x_Forr_rofDIP + integer, save :: index_r2x_Forr_rofDON + integer, save :: index_r2x_Forr_rofDOP + integer, save :: index_r2x_Forr_rofDOC + integer, save :: index_r2x_Forr_rofPP + integer, save :: index_r2x_Forr_rofDSi + integer, save :: index_r2x_Forr_rofPOC + integer, save :: index_r2x_Forr_rofPN + integer, save :: index_r2x_Forr_rofDIC + integer, save :: index_r2x_Forr_rofFe integer, save :: index_r2x_Forr_rofl_16O integer, save :: index_r2x_Forr_rofi_16O integer, save :: index_r2x_Forr_rofl_18O @@ -1479,6 +1490,17 @@ subroutine prep_ocn_merge( flux_epbalfact, a2x_o, i2x_o, r2x_o, w2x_o, g2x_o, xa integer, save :: index_x2o_Faxa_prec integer, save :: index_x2o_Foxx_rofl integer, save :: index_x2o_Foxx_rofi + integer, save :: index_x2o_Foxx_rofDIN + integer, save :: index_x2o_Foxx_rofDIP + integer, save :: index_x2o_Foxx_rofDON + integer, save :: index_x2o_Foxx_rofDOP + integer, save :: index_x2o_Foxx_rofDOC + integer, save :: index_x2o_Foxx_rofPP + integer, save :: index_x2o_Foxx_rofDSi + integer, save :: index_x2o_Foxx_rofPOC + integer, save :: index_x2o_Foxx_rofPN + integer, save :: index_x2o_Foxx_rofDIC + integer, save :: index_x2o_Foxx_rofFe integer, save :: index_x2o_Sf_afrac integer, save :: index_x2o_Sf_afracr integer, save :: index_x2o_Foxx_swnet_afracr @@ -1551,6 +1573,19 @@ subroutine prep_ocn_merge( flux_epbalfact, a2x_o, i2x_o, r2x_o, w2x_o, g2x_o, xa index_a2x_Faxa_rainl = mct_aVect_indexRA(a2x_o,'Faxa_rainl') index_r2x_Forr_rofl = mct_aVect_indexRA(r2x_o,'Forr_rofl') index_r2x_Forr_rofi = mct_aVect_indexRA(r2x_o,'Forr_rofi') + if (rof2ocn_nutrients) then + index_r2x_Forr_rofDIN = mct_aVect_indexRA(r2x_o,'Forr_rofDIN') + index_r2x_Forr_rofDIP = mct_aVect_indexRA(r2x_o,'Forr_rofDIP') + index_r2x_Forr_rofDON = mct_aVect_indexRA(r2x_o,'Forr_rofDON') + index_r2x_Forr_rofDOP = mct_aVect_indexRA(r2x_o,'Forr_rofDOP') + index_r2x_Forr_rofDOC = mct_aVect_indexRA(r2x_o,'Forr_rofDOC') + index_r2x_Forr_rofPP = mct_aVect_indexRA(r2x_o,'Forr_rofPP') + index_r2x_Forr_rofDSi = mct_aVect_indexRA(r2x_o,'Forr_rofDSi') + index_r2x_Forr_rofPOC = mct_aVect_indexRA(r2x_o,'Forr_rofPOC') + index_r2x_Forr_rofPN = mct_aVect_indexRA(r2x_o,'Forr_rofPN') + index_r2x_Forr_rofDIC = mct_aVect_indexRA(r2x_o,'Forr_rofDIC') + index_r2x_Forr_rofFe = mct_aVect_indexRA(r2x_o,'Forr_rofFe') + endif index_r2x_Flrr_flood = mct_aVect_indexRA(r2x_o,'Flrr_flood') index_g2x_Fogg_rofl = mct_aVect_indexRA(g2x_o,'Fogg_rofl') index_g2x_Fogg_rofi = mct_aVect_indexRA(g2x_o,'Fogg_rofi') @@ -1559,6 +1594,19 @@ subroutine prep_ocn_merge( flux_epbalfact, a2x_o, i2x_o, r2x_o, w2x_o, g2x_o, xa index_x2o_Faxa_prec = mct_aVect_indexRA(x2o_o,'Faxa_prec') index_x2o_Foxx_rofl = mct_aVect_indexRA(x2o_o,'Foxx_rofl') index_x2o_Foxx_rofi = mct_aVect_indexRA(x2o_o,'Foxx_rofi') + if (rof2ocn_nutrients) then + index_x2o_Foxx_rofDIN = mct_aVect_indexRA(x2o_o,'Foxx_rofDIN') + index_x2o_Foxx_rofDIP = mct_aVect_indexRA(x2o_o,'Foxx_rofDIP') + index_x2o_Foxx_rofDON = mct_aVect_indexRA(x2o_o,'Foxx_rofDON') + index_x2o_Foxx_rofDOP = mct_aVect_indexRA(x2o_o,'Foxx_rofDOP') + index_x2o_Foxx_rofDOC = mct_aVect_indexRA(x2o_o,'Foxx_rofDOC') + index_x2o_Foxx_rofPP = mct_aVect_indexRA(x2o_o,'Foxx_rofPP') + index_x2o_Foxx_rofDSi = mct_aVect_indexRA(x2o_o,'Foxx_rofDSi') + index_x2o_Foxx_rofPOC = mct_aVect_indexRA(x2o_o,'Foxx_rofPOC') + index_x2o_Foxx_rofPN = mct_aVect_indexRA(x2o_o,'Foxx_rofPN') + index_x2o_Foxx_rofDIC = mct_aVect_indexRA(x2o_o,'Foxx_rofDIC') + index_x2o_Foxx_rofFe = mct_aVect_indexRA(x2o_o,'Foxx_rofFe') + endif if (seq_flds_i2o_per_cat) then index_x2o_Sf_afrac = mct_aVect_indexRA(x2o_o,'Sf_afrac') @@ -1835,6 +1883,33 @@ subroutine prep_ocn_merge( flux_epbalfact, a2x_o, i2x_o, r2x_o, w2x_o, g2x_o, xa '(r2x%Forr_rofl + r2x%Flrr_flood + g2x%Fogg_rofl)*flux_epbalfact' mrgstr(index_x2o_Foxx_rofi) = trim(mrgstr(index_x2o_Foxx_rofi))//' = '// & '(r2x%Forr_rofi + g2x%Fogg_rofi)*flux_epbalfact' + + ! river nutrients + if (rof2ocn_nutrients) then + mrgstr(index_x2o_Foxx_rofDIN) = trim(mrgstr(index_x2o_Foxx_rofDIN))//' = '// & + 'r2x%Forr_rofDIN' + mrgstr(index_x2o_Foxx_rofDIP) = trim(mrgstr(index_x2o_Foxx_rofDIP))//' = '// & + 'r2x%Forr_rofDIP' + mrgstr(index_x2o_Foxx_rofDON) = trim(mrgstr(index_x2o_Foxx_rofDON))//' = '// & + 'r2x%Forr_rofDON' + mrgstr(index_x2o_Foxx_rofDOP) = trim(mrgstr(index_x2o_Foxx_rofDOP))//' = '// & + 'r2x%Forr_rofDOP' + mrgstr(index_x2o_Foxx_rofDOC) = trim(mrgstr(index_x2o_Foxx_rofDOC))//' = '// & + 'r2x%Forr_rofDOC' + mrgstr(index_x2o_Foxx_rofPP) = trim(mrgstr(index_x2o_Foxx_rofPP))//' = '// & + 'r2x%Forr_rofPP' + mrgstr(index_x2o_Foxx_rofDSi) = trim(mrgstr(index_x2o_Foxx_rofDSi))//' = '// & + 'r2x%Forr_rofDSi' + mrgstr(index_x2o_Foxx_rofPOC) = trim(mrgstr(index_x2o_Foxx_rofPOC))//' = '// & + 'r2x%Forr_rofPOC' + mrgstr(index_x2o_Foxx_rofPN) = trim(mrgstr(index_x2o_Foxx_rofPN))//' = '// & + 'r2x%Forr_rofPN' + mrgstr(index_x2o_Foxx_rofDIC) = trim(mrgstr(index_x2o_Foxx_rofDIC))//' = '// & + 'r2x%Forr_rofDIC' + mrgstr(index_x2o_Foxx_rofFe) = trim(mrgstr(index_x2o_Foxx_rofFe))//' = '// & + 'r2x%Forr_rofFe' + endif + ! water isotope snow, rain prec if ( index_x2o_Faxa_snow_16O /= 0 )then mrgstr(index_x2o_Faxa_snow_16O) = trim(mrgstr(index_x2o_Faxa_snow_16O))//' = '// & @@ -1927,6 +2002,19 @@ subroutine prep_ocn_merge( flux_epbalfact, a2x_o, i2x_o, r2x_o, w2x_o, g2x_o, xa x2o_o%rAttr(index_x2o_Foxx_rofi, n) = (r2x_o%rAttr(index_r2x_Forr_rofi , n) + & g2x_o%rAttr(index_g2x_Fogg_rofi , n)) * flux_epbalfact + if (rof2ocn_nutrients) then + x2o_o%rAttr(index_x2o_Foxx_rofDIN, n) = r2x_o%rAttr(index_r2x_Forr_rofDIN , n) + x2o_o%rAttr(index_x2o_Foxx_rofDIP, n) = r2x_o%rAttr(index_r2x_Forr_rofDIP , n) + x2o_o%rAttr(index_x2o_Foxx_rofDON, n) = r2x_o%rAttr(index_r2x_Forr_rofDON , n) + x2o_o%rAttr(index_x2o_Foxx_rofDOP, n) = r2x_o%rAttr(index_r2x_Forr_rofDOP , n) + x2o_o%rAttr(index_x2o_Foxx_rofDOC, n) = r2x_o%rAttr(index_r2x_Forr_rofDOC , n) + x2o_o%rAttr(index_x2o_Foxx_rofPP , n) = r2x_o%rAttr(index_r2x_Forr_rofPP , n) + x2o_o%rAttr(index_x2o_Foxx_rofDSi, n) = r2x_o%rAttr(index_r2x_Forr_rofDSi , n) + x2o_o%rAttr(index_x2o_Foxx_rofPOC, n) = r2x_o%rAttr(index_r2x_Forr_rofPOC , n) + x2o_o%rAttr(index_x2o_Foxx_rofPN , n) = r2x_o%rAttr(index_r2x_Forr_rofPN , n) + x2o_o%rAttr(index_x2o_Foxx_rofDIC, n) = r2x_o%rAttr(index_r2x_Forr_rofDIC , n) + x2o_o%rAttr(index_x2o_Foxx_rofFe, n) = r2x_o%rAttr(index_r2x_Forr_rofFe , n) + endif if ( index_x2o_Foxx_rofl_16O /= 0 ) then x2o_o%rAttr(index_x2o_Foxx_rofl_16O, n) = (r2x_o%rAttr(index_r2x_Forr_rofl_16O, n) + & diff --git a/driver-moab/main/prep_rof_mod.F90 b/driver-moab/main/prep_rof_mod.F90 index 2ce5c588863f..55cc56dddc5a 100644 --- a/driver-moab/main/prep_rof_mod.F90 +++ b/driver-moab/main/prep_rof_mod.F90 @@ -6,7 +6,7 @@ module prep_rof_mod use shr_kind_mod, only: cl => SHR_KIND_CL use shr_kind_mod, only: cxx => SHR_KIND_CXX use shr_sys_mod, only: shr_sys_abort, shr_sys_flush - use seq_comm_mct, only: num_inst_lnd, num_inst_rof, num_inst_frc, num_inst_atm + use seq_comm_mct, only: num_inst_lnd, num_inst_rof, num_inst_frc, num_inst_atm, num_inst_ocn use seq_comm_mct, only: CPLID, ROFID, logunit use seq_comm_mct, only: mrofid ! id for rof comp use seq_comm_mct, only: mbrmapro ! iMOAB id of moab instance of map read from rof2ocn map file @@ -22,7 +22,7 @@ module prep_rof_mod use mct_mod use perf_mod use component_type_mod, only: component_get_x2c_cx, component_get_c2x_cx - use component_type_mod, only: rof, lnd, atm + use component_type_mod, only: rof, lnd, atm, ocn use component_type_mod, only: ocn ! used for context for projection towards ocean from rof ! use prep_lnd_mod, only: prep_lnd_get_mapper_Fr2l use map_lnd2rof_irrig_mod, only: map_lnd2rof_irrig @@ -42,13 +42,17 @@ module prep_rof_mod public :: prep_rof_accum_lnd public :: prep_rof_accum_atm + public :: prep_rof_accum_ocn public :: prep_rof_accum_avg public :: prep_rof_calc_l2r_rx public :: prep_rof_calc_a2r_rx + public :: prep_rof_calc_o2r_rx public :: prep_rof_get_l2racc_lx public :: prep_rof_get_l2racc_lx_cnt + public :: prep_rof_get_o2racc_ox + public :: prep_rof_get_o2racc_ox_cnt public :: prep_rof_get_mapper_Fl2r public :: prep_rof_get_a2racc_ax public :: prep_rof_get_a2racc_ax_cnt @@ -70,16 +74,20 @@ module prep_rof_mod type(seq_map), pointer :: mapper_Sa2r type(seq_map), pointer :: mapper_Fa2r type(seq_map), pointer :: mapper_Fl2r + type(seq_map), pointer :: mapper_So2r ! attribute vectors type(mct_aVect), pointer :: l2r_rx(:) type(mct_aVect), pointer :: a2r_rx(:) + type(mct_aVect), pointer :: o2r_rx(:) ! accumulation variables type(mct_aVect), pointer :: l2racc_lx(:) ! lnd export, lnd grid, cpl pes integer , target :: l2racc_lx_cnt ! l2racc_lx: number of time samples accumulated type(mct_aVect), pointer :: a2racc_ax(:) ! atm export, atm grid, cpl pes integer , target :: a2racc_ax_cnt ! a2racc_ax: number of time samples accumulated + type(mct_aVect), pointer :: o2racc_ox(:) ! ocn export, ocn grid, cpl pes + integer , target :: o2racc_ox_cnt ! o2racc_ox: number of time samples accumulated ! other module variables integer :: mpicom_CPLID ! MPI cpl communicator @@ -98,7 +106,7 @@ module prep_rof_mod !================================================================================================ - subroutine prep_rof_init(infodata, lnd_c2_rof, atm_c2_rof) + subroutine prep_rof_init(infodata, lnd_c2_rof, atm_c2_rof, ocn_c2_rof) !--------------------------------------------------------------- ! Description @@ -109,24 +117,30 @@ subroutine prep_rof_init(infodata, lnd_c2_rof, atm_c2_rof) type(seq_infodata_type) , intent(in) :: infodata logical , intent(in) :: lnd_c2_rof ! .true. => lnd to rof coupling on logical , intent(in) :: atm_c2_rof ! .true. => atm to rof coupling on + logical , intent(in) :: ocn_c2_rof ! .true. => ocn to rof coupling on ! ! Local Variables integer :: lsize_r integer :: lsize_l integer :: lsize_a - integer :: eli, eri, eai + integer :: lsize_o + integer :: eli, eri, eai, eoi logical :: samegrid_lr ! samegrid lnd and rof logical :: samegrid_ar ! samegrid atm and rof + logical :: samegrid_ro ! samegrid ocn and rof logical :: esmf_map_flag ! .true. => use esmf for mapping logical :: rof_present ! .true. => rof is present logical :: lnd_present ! .true. => lnd is present logical :: atm_present ! .true. => atm is present + logical :: ocn_present ! .true. => ocn is present logical :: iamroot_CPLID ! .true. => CPLID masterproc character(CL) :: atm_gnam ! atm grid character(CL) :: lnd_gnam ! lnd grid character(CL) :: rof_gnam ! rof grid + character(CL) :: ocn_gnam ! ocn grid type(mct_aVect) , pointer :: l2x_lx type(mct_aVect) , pointer :: a2x_ax + type(mct_aVect) , pointer :: o2x_ox type(mct_aVect) , pointer :: x2r_rx integer :: index_irrig character(*) , parameter :: subname = '(prep_rof_init)' @@ -138,6 +152,7 @@ subroutine prep_rof_init(infodata, lnd_c2_rof, atm_c2_rof) rof_present=rof_present , & lnd_present=lnd_present , & atm_present=atm_present , & + ocn_present=ocn_present , & lnd_gnam=lnd_gnam , & atm_gnam=atm_gnam , & rof_gnam=rof_gnam ) @@ -145,6 +160,7 @@ subroutine prep_rof_init(infodata, lnd_c2_rof, atm_c2_rof) allocate(mapper_Sa2r) allocate(mapper_Fa2r) allocate(mapper_Fl2r) + allocate(mapper_So2r) if (rof_present) then x2r_rx => component_get_x2c_cx(rof(1)) @@ -258,6 +274,47 @@ subroutine prep_rof_init(infodata, lnd_c2_rof, atm_c2_rof) end if + if (rof_present .and. ocn_present) then + + call seq_comm_getData(CPLID, & + mpicom=mpicom_CPLID, iamroot=iamroot_CPLID) + + lsize_r = mct_aVect_lsize(x2r_rx) + + o2x_ox => component_get_c2x_cx(ocn(1)) + lsize_o = mct_aVect_lsize(o2x_ox) + + allocate(o2racc_ox(num_inst_ocn)) + do eoi = 1,num_inst_ocn + call mct_aVect_initSharedFields(o2x_ox, x2r_rx, o2racc_ox(eoi), lsize=lsize_o) + call mct_aVect_zero(o2racc_ox(eoi)) + end do + o2racc_ox_cnt = 0 + + allocate(o2r_rx(num_inst_rof)) + do eri = 1,num_inst_rof + call mct_avect_init(o2r_rx(eri), rList=seq_flds_o2x_fields_to_rof, lsize=lsize_r) + call mct_avect_zero(o2r_rx(eri)) + end do + + samegrid_ro = .true. + if (trim(ocn_gnam) /= trim(rof_gnam)) samegrid_ro = .false. + + if (ocn_c2_rof) then + if (iamroot_CPLID) then + write(logunit,*) ' ' + write(logunit,F00) 'Initializing mapper_So2r' + end if + call seq_map_init_rcfile(mapper_So2r, ocn(1), rof(1), & + 'seq_maps.rc','ocn2rof_smapname:','ocn2rof_smaptype:',samegrid_ro, & + string='mapper_So2r initialization', esmf_map=esmf_map_flag) + + endif + + call shr_sys_flush(logunit) + + end if + end subroutine prep_rof_init subroutine prep_rof_ocn_moab(infodata) @@ -556,6 +613,38 @@ subroutine prep_rof_accum_atm(timer) end subroutine prep_rof_accum_atm + !================================================================================================ + subroutine prep_rof_accum_ocn(timer) + + !--------------------------------------------------------------- + ! Description + ! Accumulate ocean input to river component + ! + ! Arguments + character(len=*), intent(in) :: timer + ! + ! Local Variables + integer :: eoi + type(mct_aVect), pointer :: o2x_ox + character(*), parameter :: subname = '(prep_rof_accum_ocn)' + !--------------------------------------------------------------- + + call t_drvstartf (trim(timer),barrier=mpicom_CPLID) + + do eoi = 1,num_inst_ocn + o2x_ox => component_get_c2x_cx(ocn(eoi)) + if (o2racc_ox_cnt == 0) then + call mct_avect_copy(o2x_ox, o2racc_ox(eoi)) + else + call mct_avect_accum(o2x_ox, o2racc_ox(eoi)) + endif + end do + o2racc_ox_cnt = o2racc_ox_cnt + 1 + + call t_drvstopf (trim(timer)) + + end subroutine prep_rof_accum_ocn + !================================================================================================ subroutine prep_rof_accum_avg(timer) @@ -568,7 +657,7 @@ subroutine prep_rof_accum_avg(timer) character(len=*), intent(in) :: timer ! ! Local Variables - integer :: eri, eli, eai + integer :: eri, eli, eai, eoi character(*), parameter :: subname = '(prep_rof_accum_avg)' !--------------------------------------------------------------- @@ -588,6 +677,15 @@ subroutine prep_rof_accum_avg(timer) enddo endif a2racc_ax_cnt = 0 + + if(o2racc_ox_cnt > 1) then + do eri = 1,num_inst_rof + eoi = mod((eri-1),num_inst_ocn) + 1 + call mct_avect_avg(o2racc_ox(eoi),o2racc_ox_cnt) + enddo + endif + o2racc_ox_cnt = 0 + call t_drvstopf (trim(timer)) end subroutine prep_rof_accum_avg @@ -607,7 +705,7 @@ subroutine prep_rof_mrg(infodata, fractions_rx, timer_mrg, cime_model) character(len=*) , intent(in) :: cime_model ! ! Local Variables - integer :: eri, efi + integer :: eri, efi, eoi type(mct_aVect), pointer :: x2r_rx character(*), parameter :: subname = '(prep_rof_mrg)' !--------------------------------------------------------------- @@ -617,7 +715,12 @@ subroutine prep_rof_mrg(infodata, fractions_rx, timer_mrg, cime_model) efi = mod((eri-1),num_inst_frc) + 1 x2r_rx => component_get_x2c_cx(rof(eri)) ! This is actually modifying x2r_rx - call prep_rof_merge(l2r_rx(eri), a2r_rx(eri), fractions_rx(efi), x2r_rx, cime_model) + if(ocn_rof_two_way) then + call prep_rof_merge(l2r_rx(eri), a2r_rx(eri), fractions_rx(efi), x2r_rx, cime_model, o2x_r=o2r_rx(eri)) + else + call prep_rof_merge(l2r_rx(eri), a2r_rx(eri), fractions_rx(efi), x2r_rx, cime_model) + end if + end do call t_drvstopf (trim(timer_mrg)) @@ -625,7 +728,7 @@ end subroutine prep_rof_mrg !================================================================================================ - subroutine prep_rof_merge(l2x_r, a2x_r, fractions_r, x2r_r, cime_model) + subroutine prep_rof_merge(l2x_r, a2x_r, fractions_r, x2r_r, cime_model,o2x_r) !----------------------------------------------------------------------- ! Description @@ -637,6 +740,7 @@ subroutine prep_rof_merge(l2x_r, a2x_r, fractions_r, x2r_r, cime_model) type(mct_aVect),intent(in) :: fractions_r type(mct_aVect),intent(inout) :: x2r_r character(len=*) , intent(in) :: cime_model + type(mct_aVect),intent(in),optional :: o2x_r ! ! Local variables integer :: i @@ -666,7 +770,7 @@ subroutine prep_rof_merge(l2x_r, a2x_r, fractions_r, x2r_r, cime_model) integer, save :: index_l2x_Flrl_rofi_HDO integer, save :: index_x2r_Flrl_rofl_HDO integer, save :: index_x2r_Flrl_rofi_HDO - + integer, save :: index_l2x_Flrl_Tqsur integer, save :: index_l2x_Flrl_Tqsub integer, save :: index_a2x_Sa_tbot @@ -691,6 +795,11 @@ subroutine prep_rof_merge(l2x_r, a2x_r, fractions_r, x2r_r, cime_model) integer, save :: index_x2r_Faxa_swvdr integer, save :: index_x2r_Faxa_swvdf integer, save :: index_x2r_Faxa_lwdn + + integer, save :: index_l2x_Flrl_inundinf + integer, save :: index_x2r_Flrl_inundinf + integer, save :: index_x2r_So_ssh + integer, save :: index_o2x_So_ssh integer, save :: index_l2x_coszen_str integer, save :: index_x2r_coszen_str @@ -809,7 +918,7 @@ subroutine prep_rof_merge(l2x_r, a2x_r, fractions_r, x2r_r, cime_model) mrgstr(index_x2r_Flrl_rofi_HDO) = trim(mrgstr(index_x2r_Flrl_rofi_HDO))//' = '// & trim(fracstr)//'*l2x%Flrl_rofi_HDO' end if - + if ( rof_heat ) then index_a2x_Sa_tbot = mct_aVect_indexRA(a2x_r,'Sa_tbot') index_a2x_Sa_pbot = mct_aVect_indexRA(a2x_r,'Sa_pbot') @@ -843,8 +952,21 @@ subroutine prep_rof_merge(l2x_r, a2x_r, fractions_r, x2r_r, cime_model) mrgstr(index_x2r_Faxa_swvdr) = trim(mrgstr(index_x2r_Faxa_swvdr))//' = '//'a2x%Faxa_swvdr' mrgstr(index_x2r_Faxa_swvdf) = trim(mrgstr(index_x2r_Faxa_swvdf))//' = '//'a2x%Faxa_swvdf' mrgstr(index_x2r_Faxa_lwdn) = trim(mrgstr(index_x2r_Faxa_lwdn))//' = '//'a2x%Faxa_lwdn' + + if (lnd_rof_two_way) then + index_l2x_Flrl_inundinf = mct_aVect_indexRA(l2x_r,'Flrl_inundinf') + index_x2r_Flrl_inundinf = mct_aVect_indexRA(x2r_r,'Flrl_inundinf') + mrgstr(index_x2r_Flrl_inundinf) = trim(mrgstr(index_x2r_Flrl_inundinf))//' = '//'l2x%Flrl_inundinf' + endif + endif + if (ocn_rof_two_way) then + index_o2x_So_ssh = mct_aVect_indexRA(o2x_r,'So_ssh') + index_x2r_So_ssh = mct_aVect_indexRA(x2r_r,'So_ssh') + mrgstr(index_x2r_So_ssh) = trim(mrgstr(index_x2r_So_ssh))//' = '//'o2x%So_ssh' + endif + end if do i = 1,lsize @@ -886,8 +1008,18 @@ subroutine prep_rof_merge(l2x_r, a2x_r, fractions_r, x2r_r, cime_model) x2r_r%rAttr(index_x2r_Faxa_lwdn,i) = a2x_r%rAttr(index_a2x_Faxa_lwdn,i) endif + if (lnd_rof_two_way) then + x2r_r%rAttr(index_x2r_Flrl_inundinf,i) = l2x_r%rAttr(index_l2x_Flrl_inundinf,i) + endif + end do + if (ocn_rof_two_way) then + do i =1,lsize + x2r_r%rAttr(index_x2r_So_ssh,i) = o2x_r%rAttr(index_o2x_So_ssh,i) + enddo + endif + if (first_time) then if (iamroot) then write(logunit,'(A)') subname//' Summary:' @@ -976,6 +1108,31 @@ subroutine prep_rof_calc_a2r_rx(timer) end subroutine prep_rof_calc_a2r_rx + !================================================================================================ + subroutine prep_rof_calc_o2r_rx(timer) + !--------------------------------------------------------------- + ! Description + ! Create o2r_rx (note that o2r_rx is a local module variable) + ! + ! Arguments + character(len=*), intent(in) :: timer + ! + ! Local Variables + integer :: eri, eoi + type(mct_avect), pointer :: r2x_rx + character(*), parameter :: subname = '(prep_rof_calc_o2r_rx)' + !--------------------------------------------------------------- + + call t_drvstartf (trim(timer),barrier=mpicom_CPLID) + do eri = 1,num_inst_rof + eoi = mod((eri-1),num_inst_ocn) + 1 + r2x_rx => component_get_c2x_cx(rof(eri)) + call seq_map_map(mapper_So2r, o2racc_ox(eoi), o2r_rx(eri), fldlist=seq_flds_o2x_states_to_rof, norm=.true.) + end do + call t_drvstopf (trim(timer)) + + end subroutine prep_rof_calc_o2r_rx + !================================================================================================ function prep_rof_get_l2racc_lx() @@ -988,6 +1145,16 @@ function prep_rof_get_l2racc_lx_cnt() prep_rof_get_l2racc_lx_cnt => l2racc_lx_cnt end function prep_rof_get_l2racc_lx_cnt + function prep_rof_get_o2racc_ox() + type(mct_aVect), pointer :: prep_rof_get_o2racc_ox(:) + prep_rof_get_o2racc_ox => o2racc_ox(:) + end function prep_rof_get_o2racc_ox + + function prep_rof_get_o2racc_ox_cnt() + integer, pointer :: prep_rof_get_o2racc_ox_cnt + prep_rof_get_o2racc_ox_cnt => o2racc_ox_cnt + end function prep_rof_get_o2racc_ox_cnt + function prep_rof_get_mapper_Fl2r() type(seq_map), pointer :: prep_rof_get_mapper_Fl2r prep_rof_get_mapper_Fl2r => mapper_Fl2r diff --git a/driver-moab/main/seq_diagBGC_mct.F90 b/driver-moab/main/seq_diagBGC_mct.F90 new file mode 100644 index 000000000000..39a9ce611763 --- /dev/null +++ b/driver-moab/main/seq_diagBGC_mct.F90 @@ -0,0 +1,1600 @@ +!=============================================================================== +! +! !MODULE: seq_diagBGC_mod -- computes spatial \& time averages of fluxed BGC +! quatities +! +! !DESCRIPTION: +! The coupler is required to do certain diagnostics, those calculations are +! located in this module. +! +! !REMARKS: +! E3SM sign convention for fluxes is positive downward with hierarchy being +! atm/glc/lnd/rof/ice/ocn +! Sign convention: +! positive value <=> the model is gaining water, heat, momentum, etc. +! Unit convention: +! carbon flux ~ (kg-C/s)/m^2 +! +! !REVISION HISTORY: +! 2022-apr-12 - J. Wolfe - initial budget implementation +! +! !INTERFACE: ------------------------------------------------------------------ + +module seq_diagBGC_mct + ! !USES: + + use shr_kind_mod, only: r8 => shr_kind_r8, in=>shr_kind_in + use shr_kind_mod, only: i8 => shr_kind_i8, cl=>shr_kind_cl, cs=>shr_kind_cs + use shr_sys_mod, only : shr_sys_abort, shr_sys_flush + use shr_mpi_mod, only : shr_mpi_max, shr_mpi_sum + use shr_const_mod, only: shr_const_rearth, shr_const_pi, shr_const_isspval + use shr_const_mod, only: shr_const_mwc, shr_const_mwco2 + use mct_mod, only: mct_ggrid, mct_avect, mct_avect_lsize, mct_string, & + mct_string_tochar, mct_gsmap, mct_aVect_indexRA, MCT_AVECT_NRATTR, & + mct_string_clean, mct_avect_getrlist + use esmf, only : esmf_clock + use shr_log_mod, only: s_logunit=>shr_log_unit + use seq_comm_mct, only: logunit, cplid, seq_comm_setptrs, seq_comm_clean + use seq_timemgr_mod, only : seq_timemgr_EClockGetData + use component_type_mod, only : COMPONENT_GET_DOM_CX, COMPONENT_GET_C2X_CX, & + COMPONENT_GET_X2C_CX, COMPONENT_TYPE + use seq_infodata_mod, only : seq_infodata_type, seq_infodata_getdata + use shr_reprosum_mod, only: shr_reprosum_calc + + implicit none + save + private + + ! !PUBLIC TYPES: + + ! none + + !PUBLIC MEMBER FUNCTIONS: + + public seq_diagBGC_zero_mct + public seq_diagBGC_atm_mct + public seq_diagBGC_lnd_mct + public seq_diagBGC_rof_mct + public seq_diagBGC_glc_mct + public seq_diagBGC_ocn_mct + public seq_diagBGC_ice_mct + public seq_diagBGC_accum_mct + public seq_diagBGC_sum0_mct + public seq_diagBGC_preprint_mct + public seq_diagBGC_print_mct + public seq_diagBGC_avect_mct + public seq_diagBGC_avloc_mct + public seq_diagBGC_avdiff_mct + + !EOP + + !---------------------------------------------------------------------------- + ! Local data + !---------------------------------------------------------------------------- + + !----- local constants ----- + + !--- C for component --- + !--- "r" is receive in the coupler, "s" is send from the coupler + + integer(in),parameter :: c_size = 22 + + integer(in),parameter :: c_atm_as = 1 ! model index: atm + integer(in),parameter :: c_atm_ar = 2 ! model index: atm + integer(in),parameter :: c_inh_is = 3 ! model index: ice, northern + integer(in),parameter :: c_inh_ir = 4 ! model index: ice, northern + integer(in),parameter :: c_ish_is = 5 ! model index: ice, southern + integer(in),parameter :: c_ish_ir = 6 ! model index: ice, southern + integer(in),parameter :: c_lnd_ls = 7 ! model index: lnd + integer(in),parameter :: c_lnd_lr = 8 ! model index: lnd + integer(in),parameter :: c_ocn_os = 9 ! model index: ocn + integer(in),parameter :: c_ocn_or =10 ! model index: ocn + integer(in),parameter :: c_rof_rs =11 ! model index: rof + integer(in),parameter :: c_rof_rr =12 ! model index: rof + integer(in),parameter :: c_glc_gs =13 ! model index: glc + integer(in),parameter :: c_glc_gr =14 ! model index: glc + ! --- on atm grid --- + integer(in),parameter :: c_inh_as =15 ! model index: ice, northern + integer(in),parameter :: c_inh_ar =16 ! model index: ice, northern + integer(in),parameter :: c_ish_as =17 ! model index: ice, southern + integer(in),parameter :: c_ish_ar =18 ! model index: ice, southern + integer(in),parameter :: c_lnd_as =19 ! model index: lnd + integer(in),parameter :: c_lnd_ar =20 ! model index: lnd + integer(in),parameter :: c_ocn_as =21 ! model index: ocn + integer(in),parameter :: c_ocn_ar =22 ! model index: ocn + + character(len=8),parameter :: cname(c_size) = & + (/' c2a_atm',' a2c_atm',' c2i_inh',' i2c_inh',' c2i_ish',' i2c_ish', & + ' c2l_lnd',' l2c_lnd',' c2o_ocn',' o2c_ocn',' c2r_rof',' r2c_rof', & + ' c2g_glc',' g2c_glc',' c2a_inh',' a2c_inh',' c2a_ish',' a2c_ish', & + ' c2a_lnd',' a2c_lnd',' c2a_ocn',' a2c_ocn' /) + + !--- F for field --- + + integer(in),parameter :: f_area = 1 ! area (wrt to unit sphere) + integer(in),parameter :: f_csurf = 2 ! carbon : surface + integer(in),parameter :: f_cblack = 3 ! carbon : black carbon + integer(in),parameter :: f_corgnc = 4 ! carbon : organic + integer(in),parameter :: f_ioinor = 5 ! carbon : ice-ocn inorganic + integer(in),parameter :: f_ioorgn = 6 ! carbon : ice-ocn organic + + integer(in),parameter :: f_size = f_ioorgn ! Total array size of all elements + integer(in),parameter :: f_a = f_area ! 1st index for area + integer(in),parameter :: f_a_end = f_area ! last index for area + integer(in),parameter :: f_c = f_csurf ! 1st index for carbon + integer(in),parameter :: f_c_end = f_ioorgn ! Last index for carbon + + character(len=12),parameter :: fname(f_size) = & + (/' area',' surface co2','black carbon','orgnc carbon' ,& + ' i-o inorgnc',' i-o orgnc'/) + + !--- P for period --- + + integer(in),parameter :: p_size = 5 + + integer(in),parameter :: p_inst = 1 + integer(in),parameter :: p_day = 2 + integer(in),parameter :: p_mon = 3 + integer(in),parameter :: p_ann = 4 + integer(in),parameter :: p_inf = 5 + + character(len=8),parameter :: pname(p_size) = & + (/' inst',' daily',' monthly',' annual','all_time' /) + + ! !PUBLIC DATA MEMBERS + + !--- time-averaged (annual?) global budget diagnostics --- + !--- note: call sum0 then save budg_dataGBGC and budg_nsBGC on restart from/to root pe --- + real(r8),public :: budg_dataL (f_size,c_size,p_size) ! local sum, valid on all pes + real(r8),public :: budg_dataGBGC(f_size,c_size,p_size) ! global sum, valid only on root pe + real(r8),public :: budg_nsBGC (f_size,c_size,p_size) ! counter, valid only on root pe + real(r8),public :: dataGpr (f_size,c_size,p_size) ! values to print, scaled and such + + character(len=*),parameter :: afldname = 'aream' + character(len=*),parameter :: latname = 'lat' + character(len=*),parameter :: afracname = 'afrac' + character(len=*),parameter :: lfracname = 'lfrac' + character(len=*),parameter :: lfrinname = 'lfrin' + character(len=*),parameter :: ofracname = 'ofrac' + character(len=*),parameter :: ifracname = 'ifrac' + + character(*),parameter :: modName = "(seq_diagBGC_mct) " + + integer(in),parameter :: debug = 0 ! internal debug level + + real(r8),parameter :: CO2toC = shr_const_mwc/shr_const_mwco2 + + ! !PRIVATE DATA MEMBERS + + integer :: index_a2x_Faxa_bcphidry + integer :: index_a2x_Faxa_bcphodry + integer :: index_a2x_Faxa_bcphiwet + integer :: index_a2x_Faxa_ocphidry + integer :: index_a2x_Faxa_ocphodry + integer :: index_a2x_Faxa_ocphiwet + + integer :: index_x2a_Fall_fco2_lnd + integer :: index_x2a_Faoo_fco2_ocn + + integer :: index_l2x_Fall_fco2_lnd + + integer :: index_x2l_Faxa_bcphidry + integer :: index_x2l_Faxa_bcphodry + integer :: index_x2l_Faxa_bcphiwet + integer :: index_x2l_Faxa_ocphidry + integer :: index_x2l_Faxa_ocphodry + integer :: index_x2l_Faxa_ocphiwet + + integer :: index_o2x_Faoo_fco2_ocn + + integer :: index_x2o_Faxa_bcphidry + integer :: index_x2o_Faxa_bcphodry + integer :: index_x2o_Faxa_bcphiwet + integer :: index_x2o_Faxa_ocphidry + integer :: index_x2o_Faxa_ocphodry + integer :: index_x2o_Faxa_ocphiwet + integer :: index_x2o_Fioi_algae1 + integer :: index_x2o_Fioi_algae2 + integer :: index_x2o_Fioi_algae3 + integer :: index_x2o_Fioi_dic1 + integer :: index_x2o_Fioi_docr + integer :: index_x2o_Fioi_doc1 + integer :: index_x2o_Fioi_doc2 + integer :: index_x2o_Fioi_doc3 + + integer :: index_i2x_Fioi_algae1 + integer :: index_i2x_Fioi_algae2 + integer :: index_i2x_Fioi_algae3 + integer :: index_i2x_Fioi_dic1 + integer :: index_i2x_Fioi_docr + integer :: index_i2x_Fioi_doc1 + integer :: index_i2x_Fioi_doc2 + integer :: index_i2x_Fioi_doc3 + + integer :: index_x2i_Faxa_bcphidry + integer :: index_x2i_Faxa_bcphodry + integer :: index_x2i_Faxa_bcphiwet + integer :: index_x2i_Faxa_ocphidry + integer :: index_x2i_Faxa_ocphodry + integer :: index_x2i_Faxa_ocphiwet + + integer :: index_g2x_Fogg_rofl + integer :: index_g2x_Fogg_rofi + integer :: index_g2x_Figg_rofi + + !=============================================================================== +contains + !=============================================================================== + + !=============================================================================== + !BOP =========================================================================== + ! + ! !IROUTINE: seq_diagBGC_zero_mct - zero out global budget diagnostic data. + ! + ! !DESCRIPTION: + ! Zero out global budget diagnostic data. + ! + ! !REVISION HISTORY: + ! 2022-apr-12 - J. Wolfe - initial budget implementation + ! + ! !INTERFACE: ------------------------------------------------------------------ + + subroutine seq_diagBGC_zero_mct(EClock,mode) + + ! !INPUT/OUTPUT PARAMETERS: + + type(ESMF_Clock), intent(in),optional :: EClock + character(len=*), intent(in),optional :: mode + + !EOP + + integer(IN) :: ip,yr,mon,day,sec + !----- formats ----- + character(*),parameter :: subName = '(seq_diagBGC_zero_mct) ' + + !------------------------------------------------------------------------------- + ! + !------------------------------------------------------------------------------- + + if (.not. present(EClock) .and. .not. present(mode)) then + call shr_sys_abort(subName//' ERROR EClock or mode should be present') + endif + + if (present(EClock)) then + call seq_timemgr_EClockGetData(EClock,curr_yr=yr, & + curr_mon=mon,curr_day=day,curr_tod=sec) + + do ip = 1,p_size + if (ip == p_inst) then + budg_dataL(:,:,ip) = 0.0_r8 + budg_dataGBGC(:,:,ip) = 0.0_r8 + budg_nsBGC(:,:,ip) = 0.0_r8 + endif + if (ip==p_day .and. sec==0) then + budg_dataL(:,:,ip) = 0.0_r8 + budg_dataGBGC(:,:,ip) = 0.0_r8 + budg_nsBGC(:,:,ip) = 0.0_r8 + endif + if (ip==p_mon .and. day==1 .and. sec==0) then + budg_dataL(:,:,ip) = 0.0_r8 + budg_dataGBGC(:,:,ip) = 0.0_r8 + budg_nsBGC(:,:,ip) = 0.0_r8 + endif + if (ip==p_ann .and. mon==1 .and. day==1 .and. sec==0) then + budg_dataL(:,:,ip) = 0.0_r8 + budg_dataGBGC(:,:,ip) = 0.0_r8 + budg_nsBGC(:,:,ip) = 0.0_r8 + endif + enddo + endif + + if (present(mode)) then + if (trim(mode) == 'inst') then + budg_dataL(:,:,p_inst) = 0.0_r8 + budg_dataGBGC(:,:,p_inst) = 0.0_r8 + budg_nsBGC(:,:,p_inst) = 0.0_r8 + elseif (trim(mode) == 'day') then + budg_dataL(:,:,p_day) = 0.0_r8 + budg_dataGBGC(:,:,p_day) = 0.0_r8 + budg_nsBGC(:,:,p_day) = 0.0_r8 + elseif (trim(mode) == 'mon') then + budg_dataL(:,:,p_mon) = 0.0_r8 + budg_dataGBGC(:,:,p_mon) = 0.0_r8 + budg_nsBGC(:,:,p_mon) = 0.0_r8 + elseif (trim(mode) == 'ann') then + budg_dataL(:,:,p_ann) = 0.0_r8 + budg_dataGBGC(:,:,p_ann) = 0.0_r8 + budg_nsBGC(:,:,p_ann) = 0.0_r8 + elseif (trim(mode) == 'inf') then + budg_dataL(:,:,p_inf) = 0.0_r8 + budg_dataGBGC(:,:,p_inf) = 0.0_r8 + budg_nsBGC(:,:,p_inf) = 0.0_r8 + elseif (trim(mode) == 'all') then + budg_dataL(:,:,:) = 0.0_r8 + budg_dataGBGC(:,:,:) = 0.0_r8 + budg_nsBGC(:,:,:) = 0.0_r8 + else + call shr_sys_abort(subname//' ERROR in mode '//trim(mode)) + endif + endif + + end subroutine seq_diagBGC_zero_mct + + !=============================================================================== + !BOP =========================================================================== + ! + ! !IROUTINE: seq_diagBGC_accum_mct - accum out global budget diagnostic data. + ! + ! !DESCRIPTION: + ! Accum out global budget diagnostic data. + ! + ! !REVISION HISTORY: + ! 2022-apr-12 - J. Wolfe - initial budget implementation + ! + ! !INTERFACE: ------------------------------------------------------------------ + + subroutine seq_diagBGC_accum_mct() + + ! !INPUT/OUTPUT PARAMETERS: + + !EOP + + integer(in) :: ip + + !----- formats ----- + character(*),parameter :: subName = '(seq_diagBGC_accum_mct) ' + + !------------------------------------------------------------------------------- + ! + !------------------------------------------------------------------------------- + + do ip = p_inst+1,p_size + budg_dataL(:,:,ip) = budg_dataL(:,:,ip) + budg_dataL(:,:,p_inst) + enddo + budg_nsBGC(:,:,:) = budg_nsBGC(:,:,:) + 1.0_r8 + + end subroutine seq_diagBGC_accum_mct + + !=============================================================================== + !BOP =========================================================================== + ! + ! !IROUTINE: seq_diagBGC_sum0_mct - sum local to global on root + ! + ! !DESCRIPTION: + ! Sum local values to global on root + ! + ! !REVISION HISTORY: + ! 2022-apr-12 - J. Wolfe - initial budget implementation + ! + ! !INTERFACE: ------------------------------------------------------------------ + + subroutine seq_diagBGC_sum0_mct() + + ! !INPUT/OUTPUT PARAMETERS: + + !EOP + + real(r8) :: budg_dataGtmp(f_size,c_size,p_size) ! temporary sum + integer(in) :: mpicom ! mpi comm + !----- formats ----- + character(*),parameter :: subName = '(seq_diagBGC_sum0_mct) ' + + !------------------------------------------------------------------------------- + ! + !------------------------------------------------------------------------------- + + call seq_comm_setptrs(CPLID,mpicom=mpicom) + budg_dataGtmp = 0.0_r8 + call shr_mpi_sum(budg_dataL,budg_dataGtmp,mpicom,subName) + budg_dataGBGC = budg_dataGBGC + budg_dataGtmp + budg_dataL = 0.0_r8 + + end subroutine seq_diagBGC_sum0_mct + + !=============================================================================== + !BOP =========================================================================== + ! + ! !IROUTINE: seq_diagBGC_atm_mct - compute global atm input/output flux diagnostics + ! + ! !DESCRIPTION: + ! Compute global atm input/output flux diagnostics + ! + ! !REVISION HISTORY: + ! 2022-apr-12 - J. Wolfe - initial budget implementation + ! + ! !INTERFACE: ------------------------------------------------------------------ + + subroutine seq_diagBGC_atm_mct( atm, frac_a, infodata, do_a2x, do_x2a) + + ! !INPUT/OUTPUT PARAMETERS: + + type(component_type) , intent(in) :: atm ! component type for instance1 + type(mct_aVect) , intent(in) :: frac_a ! frac bundle + type(seq_infodata_type) , intent(in) :: infodata + logical , intent(in), optional :: do_a2x + logical , intent(in), optional :: do_x2a + + !EOP + + !----- local ----- + type(mct_aVect), pointer :: a2x_a ! model to drv bundle + type(mct_aVect), pointer :: x2a_a ! drv to model bundle + type(mct_ggrid), pointer :: dom_a + character(CL) :: atm_gnam ! atm grid + character(CL) :: lnd_gnam ! lnd grid + integer(in) :: k,n,ic,nf,ip ! generic index + integer(in) :: kArea ! index of area field in aVect + integer(in) :: kLat ! index of lat field in aVect + integer(in) :: kl,ka,ko,ki ! fraction indices + integer(in) :: lSize ! size of aVect + real(r8) :: ca_a ! area of a grid cell + logical,save :: first_time=.true. ! initialization flag + logical,save :: samegrid_al ! samegrid atm and lnd + + !----- formats ----- + character(*),parameter :: subName = '(seq_diagBGC_atm_mct) ' + + !------------------------------------------------------------------------------- + ! + !------------------------------------------------------------------------------- + + dom_a => component_get_dom_cx(atm) + a2x_a => component_get_c2x_cx(atm) + x2a_a => component_get_x2c_cx(atm) + + kArea = mct_aVect_indexRA(dom_a%data,afldname) + kLat = mct_aVect_indexRA(dom_a%data,latname) + ka = mct_aVect_indexRA(frac_a,afracname) + ko = mct_aVect_indexRA(frac_a,ofracname) + ki = mct_aVect_indexRA(frac_a,ifracname) + if (first_time) then + call seq_infodata_getData(infodata , & + lnd_gnam=lnd_gnam , & + atm_gnam=atm_gnam ) + samegrid_al = .true. + if (trim(atm_gnam) /= trim(lnd_gnam)) samegrid_al = .false. + end if + + if (samegrid_al) then + kl = mct_aVect_indexRA(frac_a,lfracname) + else + kl = mct_aVect_indexRA(frac_a,lfrinname) + endif + + !--------------------------------------------------------------------------- + ! add values found in this bundle to the budget table + !--------------------------------------------------------------------------- + + ip = p_inst + + if (present(do_a2x)) then + if (first_time) then + index_a2x_Faxa_bcphidry = mct_aVect_indexRA(a2x_a,'Faxa_bcphidry') + index_a2x_Faxa_bcphodry = mct_aVect_indexRA(a2x_a,'Faxa_bcphodry') + index_a2x_Faxa_bcphiwet = mct_aVect_indexRA(a2x_a,'Faxa_bcphiwet') + index_a2x_Faxa_ocphidry = mct_aVect_indexRA(a2x_a,'Faxa_ocphidry') + index_a2x_Faxa_ocphodry = mct_aVect_indexRA(a2x_a,'Faxa_ocphodry') + index_a2x_Faxa_ocphiwet = mct_aVect_indexRA(a2x_a,'Faxa_ocphiwet') + end if + + lSize = mct_avect_lSize(a2x_a) + do n=1,lSize + do k=1,4 + if (k == 1) then + ic = c_atm_ar + ca_a = -dom_a%data%rAttr(kArea,n) * frac_a%rAttr(ka,n) + elseif (k == 2) then + ic = c_lnd_ar + ca_a = dom_a%data%rAttr(kArea,n) * frac_a%rAttr(kl,n) + elseif (k == 3) then + ic = c_ocn_ar + ca_a = dom_a%data%rAttr(kArea,n) * frac_a%rAttr(ko,n) + elseif (k == 4) then + if (dom_a%data%rAttr(kLat,n) > 0.0_r8) then + ic = c_inh_ar + else + ic = c_ish_ar + endif + ca_a = dom_a%data%rAttr(kArea,n) * frac_a%rAttr(ki,n) + endif + + nf = f_area ; budg_dataL(nf,ic,ip) = budg_dataL(nf,ic,ip) + ca_a + nf = f_cblack; budg_dataL(nf,ic,ip) = budg_dataL(nf,ic,ip) + ca_a*a2x_a%rAttr(index_a2x_Faxa_bcphidry,n) & + + ca_a*a2x_a%rAttr(index_a2x_Faxa_bcphodry,n) & + + ca_a*a2x_a%rAttr(index_a2x_Faxa_bcphiwet,n) + nf = f_corgnc; budg_dataL(nf,ic,ip) = budg_dataL(nf,ic,ip) + ca_a*a2x_a%rAttr(index_a2x_Faxa_ocphidry,n) & + + ca_a*a2x_a%rAttr(index_a2x_Faxa_ocphodry,n) & + + ca_a*a2x_a%rAttr(index_a2x_Faxa_ocphiwet,n) + enddo + enddo + end if + + if (present(do_x2a)) then + if (first_time) then + index_x2a_Fall_fco2_lnd = mct_aVect_indexRA(x2a_a,'Fall_fco2_lnd',perrWith='quiet') + index_x2a_Faoo_fco2_ocn = mct_aVect_indexRA(x2a_a,'Faoo_fco2_ocn',perrWith='quiet') + end if + + lSize = mct_avect_lSize(x2a_a) + do n=1,lSize + do k=1,4 + if (k == 1) then + ic = c_atm_as + ca_a = -dom_a%data%rAttr(kArea,n) * frac_a%rAttr(ka,n) + elseif (k == 2) then + ic = c_lnd_as + ca_a = dom_a%data%rAttr(kArea,n) * frac_a%rAttr(kl,n) + elseif (k == 3) then + ic = c_ocn_as + ca_a = dom_a%data%rAttr(kArea,n) * frac_a%rAttr(ko,n) + elseif (k == 4) then + if (dom_a%data%rAttr(kLat,n) > 0.0_r8) then + ic = c_inh_as + else + ic = c_ish_as + endif + ca_a = dom_a%data%rAttr(kArea,n) * frac_a%rAttr(ki,n) + endif + + nf = f_area ; budg_dataL(nf,ic,ip) = budg_dataL(nf,ic,ip) + ca_a + if (index_x2a_Fall_fco2_lnd /= 0) then + nf = f_csurf ; budg_dataL(nf,ic,ip) = budg_dataL(nf,ic,ip) & + + ca_a*x2a_a%rAttr(index_x2a_Fall_fco2_lnd,n)*CO2toC + end if + if (index_x2a_Faoo_fco2_ocn /= 0) then + nf = f_csurf ; budg_dataL(nf,ic,ip) = budg_dataL(nf,ic,ip) & + + ca_a*x2a_a%rAttr(index_x2a_Faoo_fco2_ocn,n)*CO2toC + end if + + enddo + enddo + end if + + first_time = .false. + + end subroutine seq_diagBGC_atm_mct + + !=============================================================================== + !BOP =========================================================================== + ! + ! !IROUTINE: seq_diagBGC_lnd_mct - compute global lnd input/output flux diagnostics + ! + ! !DESCRIPTION: + ! Compute global lnd input/output flux diagnostics + ! + ! !REVISION HISTORY: + ! 2022-apr-12 - J. Wolfe - initial budget implementation + ! + ! !INTERFACE: ------------------------------------------------------------------ + + subroutine seq_diagBGC_lnd_mct( lnd, frac_l, infodata, do_l2x, do_x2l) + + type(component_type) , intent(in) :: lnd ! component type for instance1 + type(mct_aVect) , intent(in) :: frac_l ! frac bundle + type(seq_infodata_type) , intent(in) :: infodata + logical , intent(in), optional :: do_l2x + logical , intent(in), optional :: do_x2l + + !EOP + + !----- local ----- + type(mct_aVect), pointer :: l2x_l ! model to drv bundle + type(mct_aVect), pointer :: x2l_l ! drv to model bundle + type(mct_ggrid), pointer :: dom_l + integer(in) :: n,ic,nf,ip ! generic index + integer(in) :: kArea ! index of area field in aVect + integer(in) :: kl ! fraction indices + integer(in) :: lSize ! size of aVect + real(r8) :: ca_l ! area of a grid cell + logical,save :: first_time=.true. ! initialization flag + + !----- formats ----- + character(*),parameter :: subName = '(seq_diagBGC_lnd_mct) ' + + !------------------------------------------------------------------------------- + ! + !------------------------------------------------------------------------------- + + !--------------------------------------------------------------------------- + ! add values found in this bundle to the budget table + !--------------------------------------------------------------------------- + + dom_l => component_get_dom_cx(lnd) + l2x_l => component_get_c2x_cx(lnd) + x2l_l => component_get_x2c_cx(lnd) + + ip = p_inst + + kArea = mct_aVect_indexRA(dom_l%data,afldname) + kl = mct_aVect_indexRA(frac_l,lfrinname) + + if (present(do_l2x)) then + if (first_time) then + index_l2x_Fall_fco2_lnd = mct_aVect_indexRA(l2x_l,'Fall_fco2_lnd',perrWith='quiet') + end if + + lSize = mct_avect_lSize(l2x_l) + ic = c_lnd_lr + do n=1,lSize + ca_l = dom_l%data%rAttr(kArea,n) * frac_l%rAttr(kl,n) + nf = f_area ; budg_dataL(nf,ic,ip) = budg_dataL(nf,ic,ip) + ca_l + if (index_x2a_Fall_fco2_lnd /= 0) then + nf = f_csurf ; budg_dataL(nf,ic,ip) = budg_dataL(nf,ic,ip) & + + ca_l*l2x_l%rAttr(index_l2x_Fall_fco2_lnd,n)*CO2toC + end if + end do + end if + + if (present(do_x2l)) then + if (first_time) then + index_x2l_Faxa_bcphidry = mct_aVect_indexRA(x2l_l,'Faxa_bcphidry') + index_x2l_Faxa_bcphodry = mct_aVect_indexRA(x2l_l,'Faxa_bcphodry') + index_x2l_Faxa_bcphiwet = mct_aVect_indexRA(x2l_l,'Faxa_bcphiwet') + index_x2l_Faxa_ocphidry = mct_aVect_indexRA(x2l_l,'Faxa_ocphidry') + index_x2l_Faxa_ocphodry = mct_aVect_indexRA(x2l_l,'Faxa_ocphodry') + index_x2l_Faxa_ocphiwet = mct_aVect_indexRA(x2l_l,'Faxa_ocphiwet') + end if + + lSize = mct_avect_lSize(x2l_l) + ic = c_lnd_ls + do n=1,lSize + ca_l = dom_l%data%rAttr(kArea,n) * frac_l%rAttr(kl,n) + nf = f_area ; budg_dataL(nf,ic,ip) = budg_dataL(nf,ic,ip) + ca_l + nf = f_cblack; budg_dataL(nf,ic,ip) = budg_dataL(nf,ic,ip) + ca_l*x2l_l%rAttr(index_x2l_Faxa_bcphidry,n) & + + ca_l*x2l_l%rAttr(index_x2l_Faxa_bcphodry,n) & + + ca_l*x2l_l%rAttr(index_x2l_Faxa_bcphiwet,n) + nf = f_corgnc; budg_dataL(nf,ic,ip) = budg_dataL(nf,ic,ip) + ca_l*x2l_l%rAttr(index_x2l_Faxa_ocphidry,n) & + + ca_l*x2l_l%rAttr(index_x2l_Faxa_ocphodry,n) & + + ca_l*x2l_l%rAttr(index_x2l_Faxa_ocphiwet,n) + end do + end if + + first_time = .false. + + end subroutine seq_diagBGC_lnd_mct + + !=============================================================================== + !BOP =========================================================================== + ! + ! !IROUTINE: seq_diagBGC_rof_mct - compute global rof input/output flux diagnostics + ! + ! !DESCRIPTION: + ! Compute global rof input/output flux diagnostics + ! + ! !REVISION HISTORY: + ! 2022-apr-12 - J. Wolfe - initial budget implementation + ! + ! !INTERFACE: ------------------------------------------------------------------ + + subroutine seq_diagBGC_rof_mct( rof, frac_r, infodata) + + type(component_type) , intent(in) :: rof ! component type for instance1 + type(mct_aVect) , intent(in) :: frac_r ! frac bundle + type(seq_infodata_type) , intent(in) :: infodata + + !EOP + + !----- local ----- + type(mct_aVect), pointer :: r2x_r + type(mct_aVect), pointer :: x2r_r + type(mct_ggrid), pointer :: dom_r + integer(in) :: n,ic,nf,ip ! generic index + integer(in) :: kArea ! index of area field in aVect + integer(in) :: lSize ! size of aVect + real(r8) :: ca_r ! area of a grid cell + logical,save :: first_time=.true. ! initialization flag + + !----- formats ----- + character(*),parameter :: subName = '(seq_diagBGC_rof_mct) ' + + !------------------------------------------------------------------------------- + ! + !------------------------------------------------------------------------------- + + !--------------------------------------------------------------------------- + ! add values found in this bundle to the budget table + !--------------------------------------------------------------------------- + + dom_r => component_get_dom_cx(rof) + r2x_r => component_get_c2x_cx(rof) + x2r_r => component_get_x2c_cx(rof) + +! if (first_time) then +! end if + + ip = p_inst + ic = c_rof_rr + kArea = mct_aVect_indexRA(dom_r%data,afldname) + lSize = mct_avect_lSize(x2r_r) + do n=1,lSize + ca_r = dom_r%data%rAttr(kArea,n) + end do + +! if (first_time) then +! end if + + ip = p_inst + ic = c_rof_rs + kArea = mct_aVect_indexRA(dom_r%data,afldname) + lSize = mct_avect_lSize(r2x_r) + do n=1,lSize + ca_r = dom_r%data%rAttr(kArea,n) + end do + + first_time = .false. + + end subroutine seq_diagBGC_rof_mct + + !=============================================================================== + !BOP =========================================================================== + ! + ! !IROUTINE: seq_diagBGC_glc_mct - compute global glc input/output flux diagnostics + ! + ! !DESCRIPTION: + ! Compute global glc input/output flux diagnostics + ! + ! !REVISION HISTORY: + ! 2022-apr-12 - J. Wolfe - initial budget implementation + ! + ! !INTERFACE: ------------------------------------------------------------------ + + subroutine seq_diagBGC_glc_mct( glc, frac_g, infodata) + + type(component_type) , intent(in) :: glc ! component type for instance1 + type(mct_aVect) , intent(in) :: frac_g ! frac bundle + type(seq_infodata_type) , intent(in) :: infodata + + !EOP + + !----- local ----- + type(mct_aVect), pointer :: g2x_g + type(mct_aVect), pointer :: x2g_g + type(mct_ggrid), pointer :: dom_g + integer(in) :: n,ic,nf,ip ! generic index + integer(in) :: kArea ! index of area field in aVect + integer(in) :: lSize ! size of aVect + real(r8) :: ca_g ! area of a grid cell + logical,save :: first_time=.true. ! initialization flag + + !----- formats ----- + character(*),parameter :: subName = '(seq_diagBGC_glc_mct) ' + + !------------------------------------------------------------------------------- + ! + !------------------------------------------------------------------------------- + + !--------------------------------------------------------------------------- + ! add values found in this bundle to the budget table + !--------------------------------------------------------------------------- + + dom_g => component_get_dom_cx(glc) + g2x_g => component_get_c2x_cx(glc) + x2g_g => component_get_x2c_cx(glc) + +! if (first_time) then +! end if + + ip = p_inst + ic = c_glc_gs + kArea = mct_aVect_indexRA(dom_g%data,afldname) + lSize = mct_avect_lSize(g2x_g) + do n=1,lSize + ca_g = dom_g%data%rAttr(kArea,n) + end do + + first_time = .false. + + end subroutine seq_diagBGC_glc_mct + + !BOP =========================================================================== + ! + ! !IROUTINE: seq_diagBGC_ocn_mct - compute global ocn input/output flux diagnostics + ! + ! !DESCRIPTION: + ! Compute global ocn input/output flux diagnostics + ! + ! !REVISION HISTORY: + ! 2022-apr-12 - J. Wolfe - initial budget implementation + ! + ! !INTERFACE: ------------------------------------------------------------------ + + subroutine seq_diagBGC_ocn_mct( ocn, xao_o, frac_o, infodata, do_o2x, do_x2o, do_xao) + + type(component_type) , intent(in) :: ocn ! component type for instance1 + type(mct_aVect) , intent(in) :: frac_o ! frac bundle + type(mct_aVect) , intent(in) :: xao_o + type(seq_infodata_type) , intent(in) :: infodata + logical , intent(in),optional :: do_o2x + logical , intent(in),optional :: do_x2o + logical , intent(in),optional :: do_xao + + !EOP + + !----- local ----- + type(mct_aVect), pointer :: o2x_o ! model to drv bundle + type(mct_aVect), pointer :: x2o_o ! drv to model bundle + type(mct_ggrid), pointer :: dom_o + integer(in) :: n,nf,ic,ip ! generic index + integer(in) :: kArea ! index of area field in aVect + integer(in) :: ko,ki ! fraction indices + integer(in) :: lSize ! size of aVect + real(r8) :: ca_i,ca_o ! area of a grid cell + logical,save :: first_time=.true. ! initialization flag + logical,save :: flds_c_oi=.false. + + !----- formats ----- + character(*),parameter :: subName = '(seq_diagBGC_ocn_mct) ' + + !------------------------------------------------------------------------------- + ! + !------------------------------------------------------------------------------- + + if (.not. present(do_o2x) .and. & + .not. present(do_x2o) .and. & + .not. present(do_xao)) then + call shr_sys_abort(subName//"ERROR: must input a bundle") + end if + + !--------------------------------------------------------------------------- + ! add values found in this bundle to the budget table + !--------------------------------------------------------------------------- + + dom_o => component_get_dom_cx(ocn) + o2x_o => component_get_c2x_cx(ocn) + x2o_o => component_get_x2c_cx(ocn) + + ip = p_inst + + kArea = mct_aVect_indexRA(dom_o%data,afldname) + ko = mct_aVect_indexRA(frac_o,ofracname) + ki = mct_aVect_indexRA(frac_o,ifracname) + + if (present(do_o2x)) then + if (first_time) then + index_o2x_Faoo_fco2_ocn = mct_aVect_indexRA(o2x_o,'Faoo_fco2_ocn',perrWith='quiet') + end if + + lSize = mct_avect_lSize(o2x_o) + ic = c_ocn_or + do n=1,lSize + ca_o = dom_o%data%rAttr(kArea,n) * frac_o%rAttr(ko,n) + ca_i = dom_o%data%rAttr(kArea,n) * frac_o%rAttr(ki,n) + nf = f_area ; budg_dataL(nf,ic,ip) = budg_dataL(nf,ic,ip) + ca_o + if (index_x2a_Faoo_fco2_ocn /= 0) then + nf = f_csurf; budg_dataL(nf,ic,ip) = budg_dataL(nf,ic,ip) & + + (ca_o+ca_i)*o2x_o%rAttr(index_o2x_Faoo_fco2_ocn,n)*CO2toC + end if + end do + end if + + if (present(do_x2o)) then + if (first_time) then + index_x2o_Faxa_bcphidry = mct_aVect_indexRA(x2o_o,'Faxa_bcphidry') + index_x2o_Faxa_bcphodry = mct_aVect_indexRA(x2o_o,'Faxa_bcphodry') + index_x2o_Faxa_bcphiwet = mct_aVect_indexRA(x2o_o,'Faxa_bcphiwet') + index_x2o_Faxa_ocphidry = mct_aVect_indexRA(x2o_o,'Faxa_ocphidry') + index_x2o_Faxa_ocphodry = mct_aVect_indexRA(x2o_o,'Faxa_ocphodry') + index_x2o_Faxa_ocphiwet = mct_aVect_indexRA(x2o_o,'Faxa_ocphiwet') + index_x2o_Fioi_algae1 = mct_aVect_indexRA(x2o_o,'Fioi_algae1',perrWith='quiet') + if ( index_x2o_Fioi_algae1 /= 0 ) flds_c_oi = .true. + if ( flds_c_oi ) then + index_x2o_Fioi_algae2 = mct_aVect_indexRA(x2o_o,'Fioi_algae2') + index_x2o_Fioi_algae3 = mct_aVect_indexRA(x2o_o,'Fioi_algae3') + index_x2o_Fioi_dic1 = mct_aVect_indexRA(x2o_o,'Fioi_dic1') + index_x2o_Fioi_docr = mct_aVect_indexRA(x2o_o,'Fioi_docr') + index_x2o_Fioi_doc1 = mct_aVect_indexRA(x2o_o,'Fioi_doc1') + index_x2o_Fioi_doc2 = mct_aVect_indexRA(x2o_o,'Fioi_doc2') + index_x2o_Fioi_doc3 = mct_aVect_indexRA(x2o_o,'Fioi_doc3') + end if + end if + + lSize = mct_avect_lSize(x2o_o) + ic = c_ocn_os + do n=1,lSize + ca_o = dom_o%data%rAttr(kArea,n) * frac_o%rAttr(ko,n) + ca_i = dom_o%data%rAttr(kArea,n) * frac_o%rAttr(ki,n) + nf = f_area ; budg_dataL(nf,ic,ip) = budg_dataL(nf,ic,ip) + ca_o + + nf = f_cblack; + budg_dataL(nf,ic,ip) = budg_dataL(nf,ic,ip) + (ca_o+ca_i)*x2o_o%rAttr(index_x2o_Faxa_bcphidry,n) & + + (ca_o+ca_i)*x2o_o%rAttr(index_x2o_Faxa_bcphodry,n) & + + (ca_o+ca_i)*x2o_o%rAttr(index_x2o_Faxa_bcphiwet,n) + nf = f_corgnc; + budg_dataL(nf,ic,ip) = budg_dataL(nf,ic,ip) + (ca_o+ca_i)*x2o_o%rAttr(index_x2o_Faxa_ocphidry,n) & + + (ca_o+ca_i)*x2o_o%rAttr(index_x2o_Faxa_ocphodry,n) & + + (ca_o+ca_i)*x2o_o%rAttr(index_x2o_Faxa_ocphiwet,n) + if ( flds_c_oi ) then + nf = f_ioinor; + budg_dataL(nf,ic,ip) = budg_dataL(nf,ic,ip) + (ca_o+ca_i)*x2o_o%rAttr(index_x2o_Fioi_dic1,n) & + * shr_const_mwc * 1.0e-06_R8 + nf = f_ioorgn; + budg_dataL(nf,ic,ip) = budg_dataL(nf,ic,ip) + ((ca_o+ca_i)*x2o_o%rAttr(index_x2o_Fioi_algae1,n) & + + (ca_o+ca_i)*x2o_o%rAttr(index_x2o_Fioi_algae2,n) & + + (ca_o+ca_i)*x2o_o%rAttr(index_x2o_Fioi_algae3,n) & + + (ca_o+ca_i)*x2o_o%rAttr(index_x2o_Fioi_docr,n) & + + (ca_o+ca_i)*x2o_o%rAttr(index_x2o_Fioi_doc1,n) & + + (ca_o+ca_i)*x2o_o%rAttr(index_x2o_Fioi_doc2,n) & + + (ca_o+ca_i)*x2o_o%rAttr(index_x2o_Fioi_doc3,n)) & + * shr_const_mwc * 1.0e-06_R8 + end if + end do + end if + + first_time = .false. + + end subroutine seq_diagBGC_ocn_mct + + !=============================================================================== + !BOP =========================================================================== + ! + ! !IROUTINE: seq_diagBGC_ice_mct - compute global ice input/output flux diagnostics + ! + ! !DESCRIPTION: + ! Compute global ice input/output flux diagnostics + ! + ! !REVISION HISTORY: + ! 2022-apr-12 - J. Wolfe - initial budget implementation + ! + ! !INTERFACE: ------------------------------------------------------------------ + + subroutine seq_diagBGC_ice_mct( ice, frac_i, infodata, do_i2x, do_x2i) + + type(component_type) , intent(in) :: ice ! component type for instance1 + type(mct_aVect) , intent(in) :: frac_i ! frac bundle + type(seq_infodata_type) , intent(in) :: infodata + logical , intent(in), optional :: do_i2x + logical , intent(in), optional :: do_x2i + + !EOP + + !----- local ----- + type(mct_aVect), pointer :: i2x_i ! model to drv bundle + type(mct_aVect), pointer :: x2i_i ! drv to model bundle + type(mct_ggrid), pointer :: dom_i + integer(in) :: n,ic,nf,ip ! generic index + integer(in) :: kArea ! index of area field in aVect + integer(in) :: kLat ! index of lat field in aVect + integer(in) :: ko,ki ! fraction indices + integer(in) :: lSize ! size of aVect + real(r8) :: ca_i,ca_o ! area of a grid cell + logical,save :: first_time=.true. ! initialization flag + logical,save :: flds_c_oi=.false. + + !----- formats ----- + character(*),parameter :: subName = '(seq_diagBGC_ice_mct) ' + + !------------------------------------------------------------------------------- + + !--------------------------------------------------------------------------- + ! add values found in this bundle to the budget table + !--------------------------------------------------------------------------- + + dom_i => component_get_dom_cx(ice) + i2x_i => component_get_c2x_cx(ice) + x2i_i => component_get_x2c_cx(ice) + + ip = p_inst + + kArea = mct_aVect_indexRA(dom_i%data,afldname) + kLat = mct_aVect_indexRA(dom_i%data,latname) + ki = mct_aVect_indexRA(frac_i,ifracname) + ko = mct_aVect_indexRA(frac_i,ofracname) + + if (present(do_i2x)) then + if (first_time) then + index_i2x_Fioi_algae1 = mct_aVect_indexRA(i2x_i,'Fioi_algae1',perrWith='quiet') + if ( index_i2x_Fioi_algae1 /= 0 ) flds_c_oi = .true. + if ( flds_c_oi ) then + index_i2x_Fioi_algae2 = mct_aVect_indexRA(i2x_i,'Fioi_algae2') + index_i2x_Fioi_algae3 = mct_aVect_indexRA(i2x_i,'Fioi_algae3') + index_i2x_Fioi_dic1 = mct_aVect_indexRA(i2x_i,'Fioi_dic1') + index_i2x_Fioi_docr = mct_aVect_indexRA(i2x_i,'Fioi_docr') + index_i2x_Fioi_doc1 = mct_aVect_indexRA(i2x_i,'Fioi_doc1') + index_i2x_Fioi_doc2 = mct_aVect_indexRA(i2x_i,'Fioi_doc2') + index_i2x_Fioi_doc3 = mct_aVect_indexRA(i2x_i,'Fioi_doc3') + end if + endif + + lSize = mct_avect_lSize(i2x_i) + do n=1,lSize + if (dom_i%data%rAttr(kLat,n) > 0.0_r8) then + ic = c_inh_ir + else + ic = c_ish_ir + endif + ca_o = dom_i%data%rAttr(kArea,n) * frac_i%rAttr(ko,n) + ca_i = dom_i%data%rAttr(kArea,n) * frac_i%rAttr(ki,n) + nf = f_area ; budg_dataL(nf,ic,ip) = budg_dataL(nf,ic,ip) + ca_i + if ( flds_c_oi ) then + nf = f_ioinor; + budg_dataL(nf,ic,ip) = budg_dataL(nf,ic,ip) - ca_i*i2x_i%rAttr(index_i2x_Fioi_dic1,n) & + * shr_const_mwc * 1.0e-06_R8 + nf = f_ioorgn; + budg_dataL(nf,ic,ip) = budg_dataL(nf,ic,ip) - (ca_i*i2x_i%rAttr(index_i2x_Fioi_algae1,n) & + + ca_i*i2x_i%rAttr(index_i2x_Fioi_algae2,n) & + + ca_i*i2x_i%rAttr(index_i2x_Fioi_algae3,n) & + + ca_i*i2x_i%rAttr(index_i2x_Fioi_docr,n) & + + ca_i*i2x_i%rAttr(index_i2x_Fioi_doc1,n) & + + ca_i*i2x_i%rAttr(index_i2x_Fioi_doc2,n) & + + ca_i*i2x_i%rAttr(index_i2x_Fioi_doc3,n)) & + * shr_const_mwc * 1.0e-06_R8 + end if + end do + end if + + if (present(do_x2i)) then + if (first_time) then + index_x2i_Faxa_bcphidry = mct_aVect_indexRA(x2i_i,'Faxa_bcphidry') + index_x2i_Faxa_bcphodry = mct_aVect_indexRA(x2i_i,'Faxa_bcphodry') + index_x2i_Faxa_bcphiwet = mct_aVect_indexRA(x2i_i,'Faxa_bcphiwet') + index_x2i_Faxa_ocphidry = mct_aVect_indexRA(x2i_i,'Faxa_ocphidry') + index_x2i_Faxa_ocphodry = mct_aVect_indexRA(x2i_i,'Faxa_ocphodry') + index_x2i_Faxa_ocphiwet = mct_aVect_indexRA(x2i_i,'Faxa_ocphiwet') + end if + + lSize = mct_avect_lSize(x2i_i) + do n=1,lSize + if (dom_i%data%rAttr(kLat,n) > 0.0_r8) then + ic = c_inh_is + else + ic = c_ish_is + endif + ca_o = dom_i%data%rAttr(kArea,n) * frac_i%rAttr(ko,n) + ca_i = dom_i%data%rAttr(kArea,n) * frac_i%rAttr(ki,n) + nf = f_area ; budg_dataL(nf,ic,ip) = budg_dataL(nf,ic,ip) + ca_i + nf = f_cblack; budg_dataL(nf,ic,ip) = budg_dataL(nf,ic,ip) + ca_i*x2i_i%rAttr(index_x2i_Faxa_bcphidry,n) & + + ca_i*x2i_i%rAttr(index_x2i_Faxa_bcphodry,n) & + + ca_i*x2i_i%rAttr(index_x2i_Faxa_bcphiwet,n) + nf = f_corgnc; budg_dataL(nf,ic,ip) = budg_dataL(nf,ic,ip) + ca_i*x2i_i%rAttr(index_x2i_Faxa_ocphidry,n) & + + ca_i*x2i_i%rAttr(index_x2i_Faxa_ocphodry,n) & + + ca_i*x2i_i%rAttr(index_x2i_Faxa_ocphiwet,n) + end do + end if + + first_time = .false. + + end subroutine seq_diagBGC_ice_mct + + !=============================================================================== + !BOP =========================================================================== + ! + ! !IROUTINE: seq_diagBGC_preprint_mct - print global BGC budget diagnostics + ! + ! !DESCRIPTION: + ! Print global BGC budget diagnostics. + ! + ! !REVISION HISTORY: + ! 2022-apr-12 - J. Wolfe - initial budget implementation + ! + ! !INTERFACE: ------------------------------------------------------------------ + + SUBROUTINE seq_diagBGC_preprint_mct + + implicit none + + ! !INPUT/OUTPUT PARAMETERS: + + !EOP + + !--- local --- + + !------------------------------------------------------------------------------- + + !------------------------------------------------------------------------------- + ! prepare instantaneous budget data for printing + !------------------------------------------------------------------------------- + + call seq_diagBGC_sum0_mct() + dataGpr = budg_dataGBGC + + ! old budget normalizations (global area and 1e10 for carbon) + dataGpr = dataGpr/(4.0_r8*shr_const_pi) + dataGpr(f_c:f_c_end,:,:) = dataGpr(f_c:f_c_end,:,:) * 1.0e10_r8 + dataGpr = dataGpr/budg_nsBGC + + end subroutine seq_diagBGC_preprint_mct + + !=============================================================================== + !BOP =========================================================================== + ! + ! !IROUTINE: seq_diagBGC_print_mct - print global BGC budget diagnostics + ! + ! !DESCRIPTION: + ! Print global BGC budget diagnostics. + ! + ! !REVISION HISTORY: + ! 2022-apr-12 - J. Wolfe - initial budget implementation + ! + ! !INTERFACE: ------------------------------------------------------------------ + + SUBROUTINE seq_diagBGC_print_mct(EClock, ip, plev) + + implicit none + + ! !INPUT/OUTPUT PARAMETERS: + + type(ESMF_Clock) , intent(in) :: EClock + integer(in) , intent(in) :: ip + integer(in) , intent(in) :: plev ! print level + + !EOP + + !--- local --- + integer(in) :: ic,nf,is ! data array indicies + integer(in) :: ica,icl,icn,ics,ico + integer(in) :: icar,icxs,icxr,icas + integer(in) :: cdate,sec ! coded date, seconds + integer(in) :: yr,mon,day ! date + integer(in) :: iam ! pe number + character(len=40):: str ! string + + !----- formats ----- + character(*),parameter :: subName = '(seq_diagBGC_print_mct) ' + character(*),parameter :: F00 = "('(seq_diagBGC_print_mct) ',4a)" + + !----- formats ----- + character(*),parameter :: FAH="(4a,i9,i6)" + character(*),parameter :: FA0= "(' ',12x,6(6x,a8,1x))" + character(*),parameter :: FA1= "(' ',a12,6f15.8)" + character(*),parameter :: FA0r="(' ',12x,8(6x,a8,1x))" + character(*),parameter :: FA1r="(' ',a12,8f15.8)" + + !------------------------------------------------------------------------------- + + !------------------------------------------------------------------------------- + ! print instantaneous budget data + !------------------------------------------------------------------------------- + + call seq_comm_setptrs(CPLID,iam=iam) + call seq_timemgr_EClockGetData(EClock,curr_yr=yr, & + curr_mon=mon,curr_day=day,curr_tod=sec) + cdate = yr*10000+mon*100+day + + if (plev > 0) then + ! ---- doprint ---- doprint ---- doprint ---- + + ! --------------------------------------------------------- + ! ---- detail atm budgets and breakdown into components --- + ! --------------------------------------------------------- + + if (plev >= 3) then + do ic = 1,2 + if (ic == 1) then + ica = c_atm_ar + icl = c_lnd_ar + icn = c_inh_ar + ics = c_ish_ar + ico = c_ocn_ar + str = "ATM_to_CPL" + elseif (ic == 2) then + ica = c_atm_as + icl = c_lnd_as + icn = c_inh_as + ics = c_ish_as + ico = c_ocn_as + str = "CPL_TO_ATM" + else + call shr_sys_abort(subname//' ERROR in ic index code 411') + endif + + write(logunit,*) ' ' + write(logunit,FAH) subname,trim(str)//' CARBON BUDGET (kg-C/m2s*1e10): period = ',trim(pname(ip)),': date = ',cdate,sec + write(logunit,FA0) cname(ica),cname(icl),cname(icn),cname(ics),cname(ico),' *SUM* ' + do nf = f_c, f_c_end + write(logunit,FA1) fname(nf),dataGpr(nf,ica,ip),dataGpr(nf,icl,ip), & + dataGpr(nf,icn,ip),dataGpr(nf,ics,ip),dataGpr(nf,ico,ip), & + dataGpr(nf,ica,ip)+dataGpr(nf,icl,ip)+ & + dataGpr(nf,icn,ip)+dataGpr(nf,ics,ip)+dataGpr(nf,ico,ip) + enddo + write(logunit,FA1) ' *SUM*' ,sum(dataGpr(f_c:f_c_end,ica,ip)),sum(dataGpr(f_c:f_c_end,icl,ip)), & + sum(dataGpr(f_c:f_c_end,icn,ip)),sum(dataGpr(f_c:f_c_end,ics,ip)),sum(dataGpr(f_c:f_c_end,ico,ip)), & + sum(dataGpr(f_c:f_c_end,ica,ip))+sum(dataGpr(f_c:f_c_end,icl,ip))+ & + sum(dataGpr(f_c:f_c_end,icn,ip))+sum(dataGpr(f_c:f_c_end,ics,ip))+sum(dataGpr(f_c:f_c_end,ico,ip)) + enddo + endif ! plev + + ! --------------------------------------------------------- + ! ---- detail lnd/ocn/ice component budgets ---- + ! --------------------------------------------------------- + + if (plev >= 2) then + do ic = 1,4 + if (ic == 1) then + icar = c_lnd_ar + icxs = c_lnd_ls + icxr = c_lnd_lr + icas = c_lnd_as + str = "LND" + elseif (ic == 2) then + icar = c_ocn_ar + icxs = c_ocn_os + icxr = c_ocn_or + icas = c_ocn_as + str = "OCN" + elseif (ic == 3) then + icar = c_inh_ar + icxs = c_inh_is + icxr = c_inh_ir + icas = c_inh_as + str = "ICE_NH" + elseif (ic == 4) then + icar = c_ish_ar + icxs = c_ish_is + icxr = c_ish_ir + icas = c_ish_as + str = "ICE_SH" + else + call shr_sys_abort(subname//' ERROR in ic index code 412') + endif + + write(logunit,*) ' ' + write(logunit,FAH) subname,trim(str)//' CARBON BUDGET (kg-C/m2s*1e10): period = ',trim(pname(ip)),': date = ',cdate,sec + write(logunit,FA0) cname(icar),cname(icxs),cname(icxr),cname(icas),' *SUM* ' + do nf = f_c, f_c_end + write(logunit,FA1) fname(nf),-dataGpr(nf,icar,ip),dataGpr(nf,icxs,ip), & + dataGpr(nf,icxr,ip),-dataGpr(nf,icas,ip), & + -dataGpr(nf,icar,ip)+dataGpr(nf,icxs,ip)+ & + dataGpr(nf,icxr,ip)-dataGpr(nf,icas,ip) + enddo + write(logunit,FA1) ' *SUM*',-sum(dataGpr(f_c:f_c_end,icar,ip)),sum(dataGpr(f_c:f_c_end,icxs,ip)), & + sum(dataGpr(f_c:f_c_end,icxr,ip)),-sum(dataGpr(f_c:f_c_end,icas,ip)), & + -sum(dataGpr(f_c:f_c_end,icar,ip))+sum(dataGpr(f_c:f_c_end,icxs,ip))+ & + sum(dataGpr(f_c:f_c_end,icxr,ip))-sum(dataGpr(f_c:f_c_end,icas,ip)) + + enddo + endif ! plev + + ! --------------------------------------------------------- + ! ---- net summary budgets ---- + ! --------------------------------------------------------- + + if (plev >= 1) then + + write(logunit,*) ' ' + write(logunit,FAH) subname,'NET CARBON BUDGET (kg-C/m2s*1e10): period = ',trim(pname(ip)),': date = ',cdate,sec + write(logunit,FA0r) ' atm',' lnd',' rof',' ocn',' ice nh',' ice sh',' glc',' *SUM* ' + do nf = f_c, f_c_end + write(logunit,FA1r) fname(nf),dataGpr(nf,c_atm_ar,ip)+dataGpr(nf,c_atm_as,ip), & + dataGpr(nf,c_lnd_lr,ip)+dataGpr(nf,c_lnd_ls,ip), & + dataGpr(nf,c_rof_rr,ip)+dataGpr(nf,c_rof_rs,ip), & + dataGpr(nf,c_ocn_or,ip)+dataGpr(nf,c_ocn_os,ip), & + dataGpr(nf,c_inh_ir,ip)+dataGpr(nf,c_inh_is,ip), & + dataGpr(nf,c_ish_ir,ip)+dataGpr(nf,c_ish_is,ip), & + dataGpr(nf,c_glc_gr,ip)+dataGpr(nf,c_glc_gs,ip), & + dataGpr(nf,c_atm_ar,ip)+dataGpr(nf,c_atm_as,ip)+ & + dataGpr(nf,c_lnd_lr,ip)+dataGpr(nf,c_lnd_ls,ip)+ & + dataGpr(nf,c_rof_rr,ip)+dataGpr(nf,c_rof_rs,ip)+ & + dataGpr(nf,c_ocn_or,ip)+dataGpr(nf,c_ocn_os,ip)+ & + dataGpr(nf,c_inh_ir,ip)+dataGpr(nf,c_inh_is,ip)+ & + dataGpr(nf,c_ish_ir,ip)+dataGpr(nf,c_ish_is,ip)+ & + dataGpr(nf,c_glc_gr,ip)+dataGpr(nf,c_glc_gs,ip) + enddo + write(logunit,FA1r)' *SUM*',sum(dataGpr(f_c:f_c_end,c_atm_ar,ip))+sum(dataGpr(f_c:f_c_end,c_atm_as,ip)), & + sum(dataGpr(f_c:f_c_end,c_lnd_lr,ip))+sum(dataGpr(f_c:f_c_end,c_lnd_ls,ip)), & + sum(dataGpr(f_c:f_c_end,c_rof_rr,ip))+sum(dataGpr(f_c:f_c_end,c_rof_rs,ip)), & + sum(dataGpr(f_c:f_c_end,c_ocn_or,ip))+sum(dataGpr(f_c:f_c_end,c_ocn_os,ip)), & + sum(dataGpr(f_c:f_c_end,c_inh_ir,ip))+sum(dataGpr(f_c:f_c_end,c_inh_is,ip)), & + sum(dataGpr(f_c:f_c_end,c_ish_ir,ip))+sum(dataGpr(f_c:f_c_end,c_ish_is,ip)), & + sum(dataGpr(f_c:f_c_end,c_glc_gr,ip))+sum(dataGpr(f_c:f_c_end,c_glc_gs,ip)), & + sum(dataGpr(f_c:f_c_end,c_atm_ar,ip))+sum(dataGpr(f_c:f_c_end,c_atm_as,ip))+ & + sum(dataGpr(f_c:f_c_end,c_lnd_lr,ip))+sum(dataGpr(f_c:f_c_end,c_lnd_ls,ip))+ & + sum(dataGpr(f_c:f_c_end,c_rof_rr,ip))+sum(dataGpr(f_c:f_c_end,c_rof_rs,ip))+ & + sum(dataGpr(f_c:f_c_end,c_ocn_or,ip))+sum(dataGpr(f_c:f_c_end,c_ocn_os,ip))+ & + sum(dataGpr(f_c:f_c_end,c_inh_ir,ip))+sum(dataGpr(f_c:f_c_end,c_inh_is,ip))+ & + sum(dataGpr(f_c:f_c_end,c_ish_ir,ip))+sum(dataGpr(f_c:f_c_end,c_ish_is,ip))+ & + sum(dataGpr(f_c:f_c_end,c_glc_gr,ip))+sum(dataGpr(f_c:f_c_end,c_glc_gs,ip)) + endif + + write(logunit,*) ' ' + ! ---- doprint ---- doprint ---- doprint ---- + endif ! plev > 0 + + end subroutine seq_diagBGC_print_mct + + !=============================================================================== + !BOP =========================================================================== + ! + ! !IROUTINE: seq_diagBGC_avect_mct - print global budget diagnostics + ! + ! !DESCRIPTION: + ! Print global diagnostics for AV/ID. + ! + ! !REVISION HISTORY: + ! + ! !INTERFACE: ------------------------------------------------------------------ + + SUBROUTINE seq_diagBGC_avect_mct(infodata, id, av, dom, gsmap, comment) + + implicit none + + ! !INPUT/OUTPUT PARAMETERS: + + type(seq_infodata_type) , intent(in) :: infodata + integer(in) , intent(in) :: ID + type(mct_aVect) , intent(in) :: av + type(mct_gGrid) , pointer :: dom + type(mct_gsMap) , pointer :: gsmap + character(len=*) , intent(in), optional :: comment + + !EOP + + !--- local --- + logical :: bfbflag + integer(in) :: n,k ! counters + integer(in) :: npts,nptsg ! number of local/global pts in AV + integer(in) :: kflds ! number of fields in AV + real(r8), pointer :: sumbuf (:) ! sum buffer + real(r8), pointer :: maxbuf (:) ! max buffer + real(r8), pointer :: sumbufg(:) ! sum buffer reduced + real(r8), pointer :: maxbufg(:) ! max buffer reduced + integer(i8), pointer :: isumbuf (:) ! integer local sum + integer(i8), pointer :: isumbufg(:) ! integer global sum + integer(i8) :: ihuge ! huge + integer(in) :: mpicom ! mpi comm + integer(in) :: iam ! pe number + integer(in) :: km,ka ! field indices + integer(in) :: ns ! size of local AV + integer(in) :: rcode ! allocate return code + real(r8), pointer :: weight(:) ! weight + real(r8), allocatable :: weighted_data(:,:) ! weighted data + type(mct_string) :: mstring ! mct char type + character(CL) :: lcomment ! should be long enough + character(CL) :: itemc ! string converted to char + + !----- formats ----- + character(*),parameter :: subName = '(seq_diagBGC_avect_mct) ' + character(*),parameter :: F00 = "('(seq_diagBGC_avect_mct) ',4a)" + + !------------------------------------------------------------------------------- + ! print instantaneous budget data + !------------------------------------------------------------------------------- + + call seq_comm_setptrs(ID, mpicom=mpicom, iam=iam) + call seq_infodata_GetData(infodata, bfbflag=bfbflag) + + lcomment = '' + if (present(comment)) then + lcomment=trim(comment) + endif + + ns = mct_aVect_lsize(AV) + npts = mct_aVect_lsize(dom%data) + if (ns /= npts) call shr_sys_abort(trim(subname)//' ERROR: size of AV,dom') + km = mct_aVect_indexRA(dom%data,'mask') + ka = mct_aVect_indexRA(dom%data,afldname) + kflds = mct_aVect_nRattr(AV) + allocate(sumbufg(kflds),stat=rcode) + if (rcode /= 0) call shr_sys_abort(trim(subname)//' allocate sumbufg') + + npts = mct_aVect_lsize(AV) + allocate(weight(npts),stat=rcode) + if (rcode /= 0) call shr_sys_abort(trim(subname)//' allocate weight') + + weight(:) = 1.0_r8 + do n = 1,npts + if (dom%data%rAttr(km,n) <= 1.0e-06_R8) then + weight(n) = 0.0_r8 + else + weight(n) = dom%data%rAttr(ka,n)*shr_const_rearth*shr_const_rearth + endif + enddo + + if (bfbflag) then + allocate(weighted_data(npts,kflds),stat=rcode) + if (rcode /= 0) call shr_sys_abort(trim(subname)//' allocate weighted_data') + + weighted_data = 0.0_r8 + do n = 1,npts + do k = 1,kflds + if (.not. shr_const_isspval(AV%rAttr(k,n))) then + weighted_data(n,k) = AV%rAttr(k,n)*weight(n) + endif + enddo + enddo + + call shr_reprosum_calc (weighted_data, sumbufg, npts, npts, kflds, & + commid=mpicom) + + deallocate(weighted_data) + + else + allocate(sumbuf(kflds),stat=rcode) + if (rcode /= 0) call shr_sys_abort(trim(subname)//' allocate sumbuf') + sumbuf = 0.0_r8 + + do n = 1,npts + do k = 1,kflds + if (.not. shr_const_isspval(AV%rAttr(k,n))) then + sumbuf(k) = sumbuf(k) + AV%rAttr(k,n)*weight(n) + endif + enddo + enddo + + !--- global reduction --- + call shr_mpi_sum(sumbuf,sumbufg,mpicom,subname) + + deallocate(sumbuf) + + endif + deallocate(weight) + + if (iam == 0) then + do k = 1,kflds + call mct_aVect_getRList(mstring,k,AV) + itemc = mct_string_toChar(mstring) + call mct_string_clean(mstring) + if (len_trim(lcomment) > 0) then + write(logunit,100) 'xxx','sorr',k,sumbufg(k),trim(lcomment),trim(itemc) + else + write(logunit,101) 'xxx','sorr',k,sumbufg(k),trim(itemc) + endif + enddo + call shr_sys_flush(logunit) + endif + + deallocate(sumbufg) + +100 format('comm_diag ',a3,1x,a4,1x,i3,es26.19,1x,a,1x,a) +101 format('comm_diag ',a3,1x,a4,1x,i3,es26.19,1x,a) + + end subroutine seq_diagBGC_avect_mct + + !=============================================================================== + !BOP =========================================================================== + ! + ! !IROUTINE: seq_diagBGC_avloc_mct - print local budget diagnostics + ! + ! !DESCRIPTION: + ! Print local diagnostics for AV/ID. + ! + ! !REVISION HISTORY: + ! + ! !INTERFACE: ------------------------------------------------------------------ + + SUBROUTINE seq_diagBGC_avloc_mct(av, comment) + + implicit none + + ! !INPUT/OUTPUT PARAMETERS: + + type(mct_aVect) , intent(in) :: av + character(len=*), intent(in), optional :: comment + + !EOP + + !--- local --- + integer(in) :: n,k ! counters + integer(in) :: npts ! number of local/global pts in AV + integer(in) :: kflds ! number of fields in AV + real(r8), pointer :: sumbuf (:) ! sum buffer + type(mct_string) :: mstring ! mct char type + character(CL) :: lcomment ! should be long enough + character(CL) :: itemc ! string converted to char + + !----- formats ----- + character(*),parameter :: subName = '(seq_diagBGC_avloc_mct) ' + character(*),parameter :: F00 = "('(seq_diagBGC_avloc_mct) ',4a)" + + !------------------------------------------------------------------------------- + ! print instantaneous budget data + !------------------------------------------------------------------------------- + + lcomment = '' + if (present(comment)) then + lcomment=trim(comment) + endif + + npts = mct_aVect_lsize(AV) + kflds = mct_aVect_nRattr(AV) + allocate(sumbuf(kflds)) + + sumbuf = 0.0_r8 + do n = 1,npts + do k = 1,kflds + ! if (.not. shr_const_isspval(AV%rAttr(k,n))) then + sumbuf(k) = sumbuf(k) + AV%rAttr(k,n) + ! endif + enddo + enddo + + do k = 1,kflds + call mct_aVect_getRList(mstring,k,AV) + itemc = mct_string_toChar(mstring) + call mct_string_clean(mstring) + if (len_trim(lcomment) > 0) then + write(logunit,100) 'xxx','sorr',k,sumbuf(k),trim(lcomment),trim(itemc) + else + write(logunit,101) 'xxx','sorr',k,sumbuf(k),trim(itemc) + endif + enddo + call shr_sys_flush(logunit) + + deallocate(sumbuf) + +100 format('avloc_diag ',a3,1x,a4,1x,i3,es26.19,1x,a,1x,a) +101 format('avloc_diag ',a3,1x,a4,1x,i3,es26.19,1x,a) + + end subroutine seq_diagBGC_avloc_mct + + !=============================================================================== + !BOP =========================================================================== + ! + ! !IROUTINE: seq_diagBGC_avdiff_mct - print global budget diagnostics + ! + ! !DESCRIPTION: + ! Print global diagnostics for AV/ID. + ! + ! !REVISION HISTORY: + ! + ! !INTERFACE: ------------------------------------------------------------------ + + SUBROUTINE seq_diagBGC_avdiff_mct(AV1,AV2,ID,comment) + + implicit none + + ! !INPUT/OUTPUT PARAMETERS: + + type(mct_aVect) , intent(in) :: AV1 + type(mct_aVect) , intent(in) :: AV2 + integer , intent(in) :: ID + character(len=*), intent(in), optional :: comment + + !EOP + + !--- local --- + integer(in) :: n,k,n1,k1,n2,k2 ! counters + integer(in) :: iam ! pe number + integer(in) :: cnt ! counter + real(r8) :: adiff,rdiff ! diff values + type(mct_string) :: mstring ! mct char type + character(len=64):: lcomment ! should be long enough + + !----- formats ----- + character(*),parameter :: subName = '(seq_diagBGC_avdiff_mct) ' + character(*),parameter :: F00 = "('(seq_diagBGC_avdiff_mct) ',4a)" + + !------------------------------------------------------------------------------- + ! print instantaneous budget data + !------------------------------------------------------------------------------- + + call seq_comm_setptrs(ID,iam=iam) + + lcomment = '' + if (present(comment)) then + lcomment=trim(comment) + endif + + n1 = mct_aVect_lsize(AV1) + k1 = mct_aVect_nRattr(AV1) + n2 = mct_aVect_lsize(AV2) + k2 = mct_aVect_nRattr(AV2) + + if (n1 /= n2 .or. k1 /= k2) then + write(s_logunit,*) subname,trim(lcomment),' AV sizes different ',n1,n2,k1,k2 + return + endif + + do k = 1,k1 + cnt = 0 + adiff = 0. + rdiff = 0. + do n = 1,n1 + if (AV1%rAttr(k,n) /= AV2%rAttr(k,n)) then + cnt = cnt + 1 + adiff = max(adiff, abs(AV1%rAttr(k,n)-AV2%rAttr(k,n))) + rdiff = max(rdiff, abs(AV1%rAttr(k,n)-AV2%rAttr(k,n))/(abs(AV1%rAttr(k,n))+abs(AV2%rAttr(k,n)))) + endif + enddo + if (cnt > 0) then + call mct_aVect_getRList(mstring,k,AV1) + write(s_logunit,*) subname,trim(lcomment),' AVs fld k diff ', & + iam,mct_string_toChar(mstring),cnt,adiff,rdiff, & + minval(AV1%rAttr(k,:)),minval(AV1%rAttr(k,:)), & + maxval(AV1%rAttr(k,:)),maxval(AV2%rAttr(k,:)) + call mct_string_clean(mstring) + endif + enddo + + end subroutine seq_diagBGC_avdiff_mct + +end module seq_diagBGC_mct diff --git a/driver-moab/main/seq_diag_mct.F90 b/driver-moab/main/seq_diag_mct.F90 index a41a214c7494..2a7d999ccc5e 100644 --- a/driver-moab/main/seq_diag_mct.F90 +++ b/driver-moab/main/seq_diag_mct.F90 @@ -45,7 +45,8 @@ module seq_diag_mct use component_type_mod, only : COMPONENT_GET_DOM_CX, COMPONENT_GET_C2X_CX, & COMPONENT_GET_X2C_CX, COMPONENT_TYPE use seq_infodata_mod, only : seq_infodata_type, seq_infodata_getdata - use shr_reprosum_mod, only: shr_reprosum_calc + use shr_reprosum_mod, only : shr_reprosum_calc + use seq_diagBGC_mct, only : seq_diagBGC_preprint_mct, seq_diagBGC_print_mct implicit none save @@ -137,35 +138,38 @@ module seq_diag_mct integer(in),parameter :: f_hlatf = 8 ! heat : latent, fusion, snow integer(in),parameter :: f_hioff = 9 ! heat : latent, fusion, frozen runoff integer(in),parameter :: f_hsen =10 ! heat : sensible - integer(in),parameter :: f_hh2ot =11 ! heat : water temperature - integer(in),parameter :: f_wfrz =12 ! water: freezing - integer(in),parameter :: f_wmelt =13 ! water: melting - integer(in),parameter :: f_wrain =14 ! water: precip, liquid - integer(in),parameter :: f_wsnow =15 ! water: precip, frozen - integer(in),parameter :: f_wevap =16 ! water: evaporation - integer(in),parameter :: f_wroff =17 ! water: runoff/flood - integer(in),parameter :: f_wioff =18 ! water: frozen runoff - integer(in),parameter :: f_wfrz_16O =19 ! water: freezing - integer(in),parameter :: f_wmelt_16O =20 ! water: melting - integer(in),parameter :: f_wrain_16O =21 ! water: precip, liquid - integer(in),parameter :: f_wsnow_16O =22 ! water: precip, frozen - integer(in),parameter :: f_wevap_16O =23 ! water: evaporation - integer(in),parameter :: f_wroff_16O =24 ! water: runoff/flood - integer(in),parameter :: f_wioff_16O =25 ! water: frozen runoff - integer(in),parameter :: f_wfrz_18O =26 ! water: freezing - integer(in),parameter :: f_wmelt_18O =27 ! water: melting - integer(in),parameter :: f_wrain_18O =28 ! water: precip, liquid - integer(in),parameter :: f_wsnow_18O =29 ! water: precip, frozen - integer(in),parameter :: f_wevap_18O =30 ! water: evaporation - integer(in),parameter :: f_wroff_18O =31 ! water: runoff/flood - integer(in),parameter :: f_wioff_18O =32 ! water: frozen runoff - integer(in),parameter :: f_wfrz_HDO =33 ! water: freezing - integer(in),parameter :: f_wmelt_HDO =34 ! water: melting - integer(in),parameter :: f_wrain_HDO =35 ! water: precip, liquid - integer(in),parameter :: f_wsnow_HDO =36 ! water: precip, frozen - integer(in),parameter :: f_wevap_HDO =37 ! water: evaporation - integer(in),parameter :: f_wroff_HDO =38 ! water: runoff/flood - integer(in),parameter :: f_wioff_HDO =39 ! water: frozen runoff + integer(in),parameter :: f_hberg =11 ! heat : data icebergs + integer(in),parameter :: f_hh2ot =12 ! heat : water temperature + integer(in),parameter :: f_wfrz =13 ! water: freezing + integer(in),parameter :: f_wmelt =14 ! water: melting + integer(in),parameter :: f_wrain =15 ! water: precip, liquid + integer(in),parameter :: f_wsnow =16 ! water: precip, frozen + integer(in),parameter :: f_wberg =17 ! water: data icebergs + integer(in),parameter :: f_wevap =18 ! water: evaporation + integer(in),parameter :: f_wroff =19 ! water: runoff/flood + integer(in),parameter :: f_wioff =20 ! water: frozen runoff + integer(in),parameter :: f_wirrig =21 ! water: irrigation + integer(in),parameter :: f_wfrz_16O =22 ! water: freezing + integer(in),parameter :: f_wmelt_16O =23 ! water: melting + integer(in),parameter :: f_wrain_16O =24 ! water: precip, liquid + integer(in),parameter :: f_wsnow_16O =25 ! water: precip, frozen + integer(in),parameter :: f_wevap_16O =26 ! water: evaporation + integer(in),parameter :: f_wroff_16O =27 ! water: runoff/flood + integer(in),parameter :: f_wioff_16O =28 ! water: frozen runoff + integer(in),parameter :: f_wfrz_18O =29 ! water: freezing + integer(in),parameter :: f_wmelt_18O =30 ! water: melting + integer(in),parameter :: f_wrain_18O =31 ! water: precip, liquid + integer(in),parameter :: f_wsnow_18O =32 ! water: precip, frozen + integer(in),parameter :: f_wevap_18O =33 ! water: evaporation + integer(in),parameter :: f_wroff_18O =34 ! water: runoff/flood + integer(in),parameter :: f_wioff_18O =35 ! water: frozen runoff + integer(in),parameter :: f_wfrz_HDO =36 ! water: freezing + integer(in),parameter :: f_wmelt_HDO =37 ! water: melting + integer(in),parameter :: f_wrain_HDO =38 ! water: precip, liquid + integer(in),parameter :: f_wsnow_HDO =39 ! water: precip, frozen + integer(in),parameter :: f_wevap_HDO =40 ! water: evaporation + integer(in),parameter :: f_wroff_HDO =41 ! water: runoff/flood + integer(in),parameter :: f_wioff_HDO =42 ! water: frozen runoff integer(in),parameter :: f_size = f_wioff_HDO ! Total array size of all elements integer(in),parameter :: f_a = f_area ! 1st index for area @@ -173,7 +177,7 @@ module seq_diag_mct integer(in),parameter :: f_h = f_hfrz ! 1st index for heat integer(in),parameter :: f_h_end = f_hh2ot ! Last index for heat integer(in),parameter :: f_w = f_wfrz ! 1st index for water - integer(in),parameter :: f_w_end = f_wioff ! Last index for water + integer(in),parameter :: f_w_end = f_wirrig ! Last index for water integer(in),parameter :: f_16O = f_wfrz_16O ! 1st index for 16O water isotope integer(in),parameter :: f_18O = f_wfrz_18O ! 1st index for 18O water isotope integer(in),parameter :: f_HDO = f_wfrz_HDO ! 1st index for HDO water isotope @@ -185,8 +189,9 @@ module seq_diag_mct (/' area',' hfreeze',' hmelt',' hnetsw',' hlwdn', & ' hlwup',' hlatvap',' hlatfus',' hiroff',' hsen', & - ' hh2otemp',' wfreeze',' wmelt',' wrain',' wsnow', & - ' wevap',' wrunoff',' wfrzrof', & + ' hberg',' hh2otemp',' wfreeze',' wmelt',' wrain', & + ' wsnow',' wberg',' wevap',' wrunoff',' wfrzrof', & + ' wirrig', & ' wfreeze_16O',' wmelt_16O',' wrain_16O',' wsnow_16O', & ' wevap_16O',' wrunoff_16O',' wfrzrof_16O', & ' wfreeze_18O',' wmelt_18O',' wrain_18O',' wsnow_18O', & @@ -255,6 +260,8 @@ module seq_diag_mct integer :: index_l2x_Flrl_rofdto integer :: index_l2x_Flrl_rofi integer :: index_l2x_Flrl_irrig + integer :: index_l2x_Flrl_wslake + integer :: index_x2l_Faxa_lwdn integer :: index_x2l_Faxa_rainc @@ -262,11 +269,13 @@ module seq_diag_mct integer :: index_x2l_Faxa_snowc integer :: index_x2l_Faxa_snowl integer :: index_x2l_Flrr_flood + integer :: index_x2l_Flrr_supply integer :: index_r2x_Forr_rofl integer :: index_r2x_Forr_rofi integer :: index_r2x_Firr_rofi integer :: index_r2x_Flrr_flood + integer :: index_r2x_Flrr_supply integer :: index_x2r_Flrl_rofsur integer :: index_x2r_Flrl_rofgwl @@ -302,6 +311,8 @@ module seq_diag_mct integer :: index_i2x_Fioi_melth integer :: index_i2x_Fioi_meltw + integer :: index_i2x_Fioi_bergh + integer :: index_i2x_Fioi_bergw integer :: index_i2x_Fioi_salt integer :: index_i2x_Faii_swnet integer :: index_i2x_Fioi_swpen @@ -612,17 +623,20 @@ subroutine seq_diag_atm_mct( atm, frac_a, infodata, do_a2x, do_x2a) !EOP !----- local ----- - type(mct_aVect), pointer :: a2x_a ! model to drv bundle - type(mct_aVect), pointer :: x2a_a ! drv to model bundle + type(mct_aVect), pointer :: a2x_a ! model to drv bundle + type(mct_aVect), pointer :: x2a_a ! drv to model bundle type(mct_ggrid), pointer :: dom_a + character(CL) :: atm_gnam ! atm grid + character(CL) :: lnd_gnam ! lnd grid integer(in) :: k,n,ic,nf,ip ! generic index integer(in) :: kArea ! index of area field in aVect integer(in) :: kLat ! index of lat field in aVect integer(in) :: kl,ka,ko,ki ! fraction indices integer(in) :: lSize ! size of aVect - real(r8) :: ca_a ! area of a grid cell + real(r8) :: ca_a ! area of a grid cell logical,save :: first_time = .true. logical,save :: flds_wiso_atm = .false. + logical,save :: samegrid_al ! samegrid atm and lnd !----- formats ----- character(*),parameter :: subName = '(seq_diag_atm_mct) ' @@ -638,9 +652,22 @@ subroutine seq_diag_atm_mct( atm, frac_a, infodata, do_a2x, do_x2a) kArea = mct_aVect_indexRA(dom_a%data,afldname) kLat = mct_aVect_indexRA(dom_a%data,latname) ka = mct_aVect_indexRA(frac_a,afracname) - kl = mct_aVect_indexRA(frac_a,lfracname) + kl = mct_aVect_indexRA(frac_a,lfrinname) ko = mct_aVect_indexRA(frac_a,ofracname) ki = mct_aVect_indexRA(frac_a,ifracname) + if (first_time) then + call seq_infodata_getData(infodata , & + lnd_gnam=lnd_gnam , & + atm_gnam=atm_gnam ) + samegrid_al = .true. + if (trim(atm_gnam) /= trim(lnd_gnam)) samegrid_al = .false. + end if + + if (samegrid_al) then + kl = mct_aVect_indexRA(frac_a,lfracname) + else + kl = mct_aVect_indexRA(frac_a,lfrinname) + endif !--------------------------------------------------------------------------- ! add values found in this bundle to the budget table @@ -874,6 +901,7 @@ subroutine seq_diag_lnd_mct( lnd, frac_l, infodata, do_l2x, do_x2l) index_l2x_Flrl_rofdto = mct_aVect_indexRA(l2x_l,'Flrl_rofdto') index_l2x_Flrl_rofi = mct_aVect_indexRA(l2x_l,'Flrl_rofi') index_l2x_Flrl_irrig = mct_aVect_indexRA(l2x_l,'Flrl_irrig', perrWith='quiet') + index_l2x_Flrl_wslake = mct_aVect_indexRA(l2x_l,'Flrl_wslake') index_l2x_Fall_evap_16O = mct_aVect_indexRA(l2x_l,'Fall_evap_16O',perrWith='quiet') if ( index_l2x_Fall_evap_16O /= 0 ) flds_wiso_lnd = .true. @@ -903,7 +931,8 @@ subroutine seq_diag_lnd_mct( lnd, frac_l, infodata, do_l2x, do_x2l) nf = f_wroff ; budg_dataL(nf,ic,ip) = budg_dataL(nf,ic,ip) - ca_l*l2x_l%rAttr(index_l2x_Flrl_rofsur,n) & - ca_l*l2x_l%rAttr(index_l2x_Flrl_rofgwl,n) & - ca_l*l2x_l%rAttr(index_l2x_Flrl_rofsub,n) & - - ca_l*l2x_l%rAttr(index_l2x_Flrl_rofdto,n) + - ca_l*l2x_l%rAttr(index_l2x_Flrl_rofdto,n) & + - ca_l*l2x_l%rAttr(index_l2x_Flrl_wslake,n) if (index_l2x_Flrl_irrig /= 0) then nf = f_wroff ; budg_dataL(nf,ic,ip) = budg_dataL(nf,ic,ip) - ca_l*l2x_l%rAttr(index_l2x_Flrl_irrig,n) end if @@ -952,6 +981,7 @@ subroutine seq_diag_lnd_mct( lnd, frac_l, infodata, do_l2x, do_x2l) index_x2l_Faxa_snowc = mct_aVect_indexRA(x2l_l,'Faxa_snowc') index_x2l_Faxa_snowl = mct_aVect_indexRA(x2l_l,'Faxa_snowl') index_x2l_Flrr_flood = mct_aVect_indexRA(x2l_l,'Flrr_flood') + index_x2l_Flrr_supply = mct_aVect_indexRA(x2l_l,'Flrr_supply') if ( flds_wiso_lnd )then index_x2l_Faxa_rainc_16O = mct_aVect_indexRA(x2l_l,'Faxa_rainc_16O') @@ -983,6 +1013,7 @@ subroutine seq_diag_lnd_mct( lnd, frac_l, infodata, do_l2x, do_x2l) nf = f_wsnow; budg_dataL(nf,ic,ip) = budg_dataL(nf,ic,ip) + ca_l*x2l_l%rAttr(index_x2l_Faxa_snowc,n) & + ca_l*x2l_l%rAttr(index_x2l_Faxa_snowl,n) nf = f_wroff; budg_dataL(nf,ic,ip) = budg_dataL(nf,ic,ip) - ca_l*x2l_l%rAttr(index_x2l_Flrr_flood,n) + nf = f_wirrig ; budg_dataL(nf,ic,ip) = budg_dataL(nf,ic,ip) + ca_l*x2l_l%rAttr(index_x2l_Flrr_supply,n) if ( flds_wiso_lnd )then nf = f_wrain_16O; @@ -1141,6 +1172,7 @@ subroutine seq_diag_rof_mct( rof, frac_r, infodata) index_r2x_Forr_rofi = mct_aVect_indexRA(r2x_r,'Forr_rofi') index_r2x_Firr_rofi = mct_aVect_indexRA(r2x_r,'Firr_rofi') index_r2x_Flrr_flood = mct_aVect_indexRA(r2x_r,'Flrr_flood') + index_r2x_Flrr_supply = mct_aVect_indexRA(r2x_r,'Flrr_supply') if ( flds_wiso_rof )then index_r2x_Forr_rofl_16O = mct_aVect_indexRA(r2x_r,'Forr_rofl_16O') @@ -1165,6 +1197,7 @@ subroutine seq_diag_rof_mct( rof, frac_r, infodata) + ca_r*r2x_r%rAttr(index_r2x_Flrr_flood,n) nf = f_wioff; budg_dataL(nf,ic,ip) = budg_dataL(nf,ic,ip) - ca_r*r2x_r%rAttr(index_r2x_Forr_rofi,n) & - ca_r*r2x_r%rAttr(index_r2x_Firr_rofi,n) + nf = f_wirrig ; budg_dataL(nf,ic,ip) = budg_dataL(nf,ic,ip) - ca_r*r2x_r%rAttr(index_r2x_Flrr_supply,n) if ( flds_wiso_rof )then nf = f_wroff_16O; @@ -1398,8 +1431,8 @@ subroutine seq_diag_ocn_mct( ocn, xao_o, frac_o, infodata, do_o2x, do_x2o, do_xa if (first_time) then index_x2o_Fioi_melth = mct_aVect_indexRA(x2o_o,'Fioi_melth') index_x2o_Fioi_meltw = mct_aVect_indexRA(x2o_o,'Fioi_meltw') - index_x2o_Fioi_bergh = mct_aVect_indexRA(x2o_o,'PFioi_bergh', perrWith='quiet') - index_x2o_Fioi_bergw = mct_aVect_indexRA(x2o_o,'PFioi_bergw', perrWith='quiet') + index_x2o_Fioi_bergh = mct_aVect_indexRA(x2o_o,'PFioi_bergh') + index_x2o_Fioi_bergw = mct_aVect_indexRA(x2o_o,'PFioi_bergw') index_x2o_Fioi_salt = mct_aVect_indexRA(x2o_o,'Fioi_salt') index_x2o_Foxx_swnet = mct_aVect_indexRA(x2o_o,'Foxx_swnet') index_x2o_Faxa_lwdn = mct_aVect_indexRA(x2o_o,'Faxa_lwdn') @@ -1454,27 +1487,18 @@ subroutine seq_diag_ocn_mct( ocn, xao_o, frac_o, infodata, do_o2x, do_x2o, do_xa ca_i = dom_o%data%rAttr(kArea,n) * frac_o%rAttr(ki,n) nf = f_area ; budg_dataL(nf,ic,ip) = budg_dataL(nf,ic,ip) + ca_o - if (index_x2o_Fioi_bergw == 0) then - nf = f_wmelt ; budg_dataL(nf,ic,ip) = budg_dataL(nf,ic,ip) + (ca_o+ca_i)*x2o_o%rAttr(index_x2o_Fioi_meltw,n) - else - nf = f_wmelt ; budg_dataL(nf,ic,ip) = budg_dataL(nf,ic,ip) + & - (ca_o+ca_i)*(x2o_o%rAttr(index_x2o_Fioi_meltw,n)+x2o_o%rAttr(index_x2o_Fioi_bergw,n)) - endif - - if (index_x2o_Fioi_bergh == 0) then - nf = f_hmelt ; budg_dataL(nf,ic,ip) = budg_dataL(nf,ic,ip) + (ca_o+ca_i)*x2o_o%rAttr(index_x2o_Fioi_melth,n) - else - nf = f_hmelt ; budg_dataL(nf,ic,ip) = budg_dataL(nf,ic,ip) + & - (ca_o+ca_i)*(x2o_o%rAttr(index_x2o_Fioi_melth,n)+x2o_o%rAttr(index_x2o_Fioi_bergh,n)) - endif - + nf = f_hmelt ; budg_dataL(nf,ic,ip) = budg_dataL(nf,ic,ip) + (ca_o+ca_i)*x2o_o%rAttr(index_x2o_Fioi_melth,n) nf = f_hswnet; budg_dataL(nf,ic,ip) = budg_dataL(nf,ic,ip) + (ca_o+ca_i)*x2o_o%rAttr(index_x2o_Foxx_swnet,n) nf = f_hlwdn ; budg_dataL(nf,ic,ip) = budg_dataL(nf,ic,ip) + (ca_o+ca_i)*x2o_o%rAttr(index_x2o_Faxa_lwdn,n) + nf = f_hberg ; budg_dataL(nf,ic,ip) = budg_dataL(nf,ic,ip) + (ca_o+ca_i)*x2o_o%rAttr(index_x2o_Fioi_bergh,n) + nf = f_wmelt ; budg_dataL(nf,ic,ip) = budg_dataL(nf,ic,ip) + (ca_o+ca_i)*x2o_o%rAttr(index_x2o_Fioi_meltw,n) nf = f_wrain ; budg_dataL(nf,ic,ip) = budg_dataL(nf,ic,ip) + (ca_o+ca_i)*x2o_o%rAttr(index_x2o_Faxa_rain,n) nf = f_wsnow ; budg_dataL(nf,ic,ip) = budg_dataL(nf,ic,ip) + (ca_o+ca_i)*x2o_o%rAttr(index_x2o_Faxa_snow,n) + nf = f_wberg ; budg_dataL(nf,ic,ip) = budg_dataL(nf,ic,ip) + (ca_o+ca_i)*x2o_o%rAttr(index_x2o_Fioi_bergw,n) nf = f_wroff ; budg_dataL(nf,ic,ip) = budg_dataL(nf,ic,ip) + (ca_o+ca_i)*x2o_o%rAttr(index_x2o_Foxx_rofl,n) nf = f_wioff ; budg_dataL(nf,ic,ip) = budg_dataL(nf,ic,ip) + (ca_o+ca_i)*x2o_o%rAttr(index_x2o_Foxx_rofi,n) + if ( flds_wiso_ocn )then nf = f_wmelt_16O; budg_dataL(nf,ic,ip) = budg_dataL(nf,ic,ip) + & @@ -1589,6 +1613,8 @@ subroutine seq_diag_ice_mct( ice, frac_i, infodata, do_i2x, do_x2i) if (present(do_i2x)) then index_i2x_Fioi_melth = mct_aVect_indexRA(i2x_i,'Fioi_melth') index_i2x_Fioi_meltw = mct_aVect_indexRA(i2x_i,'Fioi_meltw') + index_i2x_Fioi_bergh = mct_aVect_indexRA(i2x_i,'PFioi_bergh') + index_i2x_Fioi_bergw = mct_aVect_indexRA(i2x_i,'PFioi_bergw') index_i2x_Fioi_swpen = mct_aVect_indexRA(i2x_i,'Fioi_swpen') index_i2x_Faii_swnet = mct_aVect_indexRA(i2x_i,'Faii_swnet') index_i2x_Faii_lwup = mct_aVect_indexRA(i2x_i,'Faii_lwup') @@ -1619,12 +1645,14 @@ subroutine seq_diag_ice_mct( ice, frac_i, infodata, do_i2x, do_x2i) ca_i = dom_i%data%rAttr(kArea,n) * frac_i%rAttr(ki,n) nf = f_area ; budg_dataL(nf,ic,ip) = budg_dataL(nf,ic,ip) + ca_i nf = f_hmelt ; budg_dataL(nf,ic,ip) = budg_dataL(nf,ic,ip) - ca_i*i2x_i%rAttr(index_i2x_Fioi_melth,n) - nf = f_wmelt ; budg_dataL(nf,ic,ip) = budg_dataL(nf,ic,ip) - ca_i*i2x_i%rAttr(index_i2x_Fioi_meltw,n) nf = f_hswnet; budg_dataL(nf,ic,ip) = budg_dataL(nf,ic,ip) + ca_i*i2x_i%rAttr(index_i2x_Faii_swnet,n) & - ca_i*i2x_i%rAttr(index_i2x_Fioi_swpen,n) nf = f_hlwup ; budg_dataL(nf,ic,ip) = budg_dataL(nf,ic,ip) + ca_i*i2x_i%rAttr(index_i2x_Faii_lwup,n) nf = f_hlatv ; budg_dataL(nf,ic,ip) = budg_dataL(nf,ic,ip) + ca_i*i2x_i%rAttr(index_i2x_Faii_lat,n) nf = f_hsen ; budg_dataL(nf,ic,ip) = budg_dataL(nf,ic,ip) + ca_i*i2x_i%rAttr(index_i2x_Faii_sen,n) + nf = f_hberg ; budg_dataL(nf,ic,ip) = budg_dataL(nf,ic,ip) - (ca_o+ca_i)*i2x_i%rAttr(index_i2x_Fioi_bergh,n) + nf = f_wmelt ; budg_dataL(nf,ic,ip) = budg_dataL(nf,ic,ip) - ca_i*i2x_i%rAttr(index_i2x_Fioi_meltw,n) + nf = f_wberg ; budg_dataL(nf,ic,ip) = budg_dataL(nf,ic,ip) - (ca_o+ca_i)*i2x_i%rAttr(index_i2x_Fioi_bergw,n) nf = f_wevap ; budg_dataL(nf,ic,ip) = budg_dataL(nf,ic,ip) + ca_i*i2x_i%rAttr(index_i2x_Faii_evap,n) if ( flds_wiso_ice )then @@ -1691,6 +1719,7 @@ subroutine seq_diag_ice_mct( ice, frac_i, infodata, do_i2x, do_x2i) (ca_o+ca_i)*max(0.0_r8,x2i_i%rAttr(index_x2i_Fioo_frazil,n)) nf = f_hfrz ; budg_dataL(nf,ic,ip) = budg_dataL(nf,ic,ip) - & (ca_o+ca_i)*max(0.0_r8,x2i_i%rAttr(index_x2i_Fioo_q,n)) + if ( flds_wiso_ice_x2i )then nf = f_wrain_16O; budg_dataL(nf,ic,ip) = budg_dataL(nf,ic,ip) + & @@ -1738,7 +1767,7 @@ end subroutine seq_diag_ice_mct ! ! !INTERFACE: ------------------------------------------------------------------ - SUBROUTINE seq_diag_print_mct(EClock, stop_alarm, & + SUBROUTINE seq_diag_print_mct(EClock, stop_alarm, do_bgc_budg, & budg_print_inst, budg_print_daily, budg_print_month, & budg_print_ann, budg_print_ltann, budg_print_ltend, infodata) @@ -1748,6 +1777,7 @@ SUBROUTINE seq_diag_print_mct(EClock, stop_alarm, & type(ESMF_Clock) , intent(in) :: EClock logical , intent(in) :: stop_alarm + logical , intent(in) :: do_bgc_budg integer , intent(in) :: budg_print_inst integer , intent(in) :: budg_print_daily integer , intent(in) :: budg_print_month @@ -1820,8 +1850,13 @@ SUBROUTINE seq_diag_print_mct(EClock, stop_alarm, & if (plev > 0) then ! ---- doprint ---- doprint ---- doprint ---- - + if (.not.sumdone) then + + if (do_bgc_budg) then + call seq_diagBGC_preprint_mct() + endif + call seq_diag_sum0_mct() dataGpr = budg_dataG sumdone = .true. @@ -2179,8 +2214,12 @@ SUBROUTINE seq_diag_print_mct(EClock, stop_alarm, & endif - write(logunit,*) ' ' ! ---- doprint ---- doprint ---- doprint ---- + + if (do_bgc_budg) then + call seq_diagBGC_print_mct(EClock, ip, plev) + endif + endif ! plev > 0 enddo ! ip = 1,p_size diff --git a/driver-moab/main/seq_flux_mct.F90 b/driver-moab/main/seq_flux_mct.F90 index 2baa95c39d39..bc8dd8bdb2e4 100644 --- a/driver-moab/main/seq_flux_mct.F90 +++ b/driver-moab/main/seq_flux_mct.F90 @@ -57,6 +57,9 @@ module seq_flux_mct real(r8), allocatable :: zbot (:) ! atm level height real(r8), allocatable :: ubot (:) ! atm velocity, zonal real(r8), allocatable :: vbot (:) ! atm velocity, meridional + real(r8), allocatable :: wsresp(:) ! atm response to surface stress + real(r8), allocatable :: tau_est(:)! estimation of tau in equilibrium with wind + real(r8), allocatable :: ugust_atm(:) ! atm gustiness real(r8), allocatable :: thbot(:) ! atm potential T real(r8), allocatable :: shum (:) ! atm specific humidity real(r8), allocatable :: shum_16O (:) ! atm H2O tracer @@ -130,6 +133,9 @@ module seq_flux_mct integer :: index_a2x_Sa_z integer :: index_a2x_Sa_u integer :: index_a2x_Sa_v + integer :: index_a2x_Sa_wsresp + integer :: index_a2x_Sa_tau_est + integer :: index_a2x_Sa_ugust integer :: index_a2x_Sa_tbot integer :: index_a2x_Sa_ptem integer :: index_a2x_Sa_shum @@ -247,6 +253,19 @@ subroutine seq_flux_init_mct(comp, fractions) allocate( vbot(nloc)) if(ier/=0) call mct_die(subName,'allocate vbot',ier) vbot = 0.0_r8 + if (atm_flux_method == 'implicit_stress') then + allocate(wsresp(nloc)) + if(ier/=0) call mct_die(subName,'allocate wsresp',ier) + wsresp = 0.0_r8 + allocate(tau_est(nloc)) + if(ier/=0) call mct_die(subName,'allocate tau_est',ier) + tau_est = 0.0_r8 + end if + if (atm_gustiness) then + allocate(ugust_atm(nloc)) + if(ier/=0) call mct_die(subName,'allocate ugust_atm',ier) + ugust_atm = 0.0_r8 + end if allocate(thbot(nloc),stat=ier) if(ier/=0) call mct_die(subName,'allocate thbot',ier) thbot = 0.0_r8 @@ -671,8 +690,18 @@ subroutine seq_flux_initexch_mct(atm, ocn, mpicom_cplid, cplid) if(ier/=0) call mct_die(subName,'allocate zbot',ier) allocate( ubot(nloc_a2o),stat=ier) if(ier/=0) call mct_die(subName,'allocate ubot',ier) - allocate( vbot(nloc_a2o)) + allocate( vbot(nloc_a2o),stat=ier) if(ier/=0) call mct_die(subName,'allocate vbot',ier) + if (atm_flux_method == 'implicit_stress') then + allocate( wsresp(nloc_a2o),stat=ier) + if(ier/=0) call mct_die(subName,'allocate wsresp',ier) + allocate( tau_est(nloc_a2o),stat=ier) + if(ier/=0) call mct_die(subName,'allocate tau_est',ier) + end if + if (atm_gustiness) then + allocate( ugust_atm(nloc_a2o),stat=ier) + if(ier/=0) call mct_die(subName,'allocate ugust_atm',ier) + end if allocate(thbot(nloc_a2o),stat=ier) if(ier/=0) call mct_die(subName,'allocate thbot',ier) allocate(shum(nloc_a2o),stat=ier) @@ -1034,6 +1063,13 @@ subroutine seq_flux_atmocnexch_mct( infodata, atm, ocn, fractions_a, fractions_o zbot(n) = 55.0_r8 ! atm height of bottom layer ~ m ubot(n) = 0.0_r8 ! atm velocity, zonal ~ m/s vbot(n) = 2.0_r8 ! atm velocity, meridional ~ m/s + if (atm_flux_method == 'implicit_stress') then + wsresp(n) = 0.0_r8 ! response of wind to surface stress ~ m/s/Pa + tau_est(n) = 0.0_r8 ! estimation of stress in equilibrium with ubot/vbot ~ Pa + end if + if (atm_gustiness) then + ugust_atm(n) = 0.0_r8 ! gustiness ~ m/s + end if thbot(n)= 301.0_r8 ! atm potential temperature ~ Kelvin shum(n) = 1.e-2_r8 ! atm specific humidity ~ kg/kg shum_16O(n) = 1.e-2_r8 ! H216O specific humidity ~ kg/kg @@ -1070,6 +1106,13 @@ subroutine seq_flux_atmocnexch_mct( infodata, atm, ocn, fractions_a, fractions_o zbot(n) = a2x_e%rAttr(index_a2x_Sa_z ,ia) ubot(n) = a2x_e%rAttr(index_a2x_Sa_u ,ia) vbot(n) = a2x_e%rAttr(index_a2x_Sa_v ,ia) + if (atm_flux_method == 'implicit_stress') then + wsresp(n) = a2x_e%rAttr(index_a2x_Sa_wsresp,ia) + tau_est(n) = a2x_e%rAttr(index_a2x_Sa_tau_est,ia) + end if + if (atm_gustiness) then + ugust_atm(n) = a2x_e%rAttr(index_a2x_Sa_ugust,ia) + end if thbot(n)= a2x_e%rAttr(index_a2x_Sa_ptem,ia) shum(n) = a2x_e%rAttr(index_a2x_Sa_shum,ia) shum_16O(n) = a2x_e%rAttr(index_a2x_Sa_shum_16O,ia) @@ -1108,14 +1151,15 @@ subroutine seq_flux_atmocnexch_mct( infodata, atm, ocn, fractions_a, fractions_o tbulk, tskin, tskin_day, tskin_night, & cskin, cskin_night, tod, dt, & duu10n,ustar, re , ssq , missval = 0.0_r8, & - cold_start=cold_start) + cold_start=cold_start, wsresp=wsresp, tau_est=tau_est) else if (ocn_surface_flux_scheme.eq.2) then call shr_flux_atmOcn_UA(nloc_a2o , zbot , ubot, vbot, thbot, & shum , shum_16O , shum_HDO, shum_18O, dens , tbot, pslv, & uocn, vocn , tocn , emask, sen , lat , lwup , & roce_16O, roce_HDO, roce_18O, & evap , evap_16O, evap_HDO, evap_18O, taux, tauy, tref, qref , & - duu10n,ustar, re , ssq , missval = 0.0_r8 ) + duu10n,ustar, re , ssq , missval = 0.0_r8, & + wsresp=wsresp, tau_est=tau_est) else call shr_flux_atmocn (nloc_a2o , zbot , ubot, vbot, thbot, & @@ -1125,7 +1169,8 @@ subroutine seq_flux_atmocnexch_mct( infodata, atm, ocn, fractions_a, fractions_o roce_16O, roce_HDO, roce_18O, & evap , evap_16O, evap_HDO, evap_18O, taux, tauy, tref, qref , & ocn_surface_flux_scheme, & - duu10n,ustar, re , ssq , missval = 0.0_r8 ) + duu10n,ustar, re , ssq , missval = 0.0_r8, & + wsresp=wsresp, tau_est=tau_est, ugust=ugust) endif !--- create temporary aVects on exchange, atm, or ocn decomp as needed @@ -1315,6 +1360,17 @@ subroutine seq_flux_atmocn_mct(infodata, tod, dt, a2x, o2x, xao) flux_convergence=flux_convergence, & flux_max_iteration=flux_max_iteration) + ! If flux_max_iteration is not set, choose a value based on + ! atm_flux_method. + if (flux_max_iteration == -1) then + select case(atm_flux_method) + case('implicit_stress') + flux_max_iteration = 30 + case default + flux_max_iteration = 2 + end select + end if + if (.not.read_restart) cold_start = .true. index_xao_So_tref = mct_aVect_indexRA(xao,'So_tref') index_xao_So_qref = mct_aVect_indexRA(xao,'So_qref') @@ -1358,6 +1414,13 @@ subroutine seq_flux_atmocn_mct(infodata, tod, dt, a2x, o2x, xao) index_a2x_Sa_z = mct_aVect_indexRA(a2x,'Sa_z') index_a2x_Sa_u = mct_aVect_indexRA(a2x,'Sa_u') index_a2x_Sa_v = mct_aVect_indexRA(a2x,'Sa_v') + if (atm_flux_method == 'implicit_stress') then + index_a2x_Sa_wsresp = mct_aVect_indexRA(a2x,'Sa_wsresp') + index_a2x_Sa_tau_est = mct_aVect_indexRA(a2x,'Sa_tau_est') + end if + if (atm_gustiness) then + index_a2x_Sa_ugust = mct_aVect_indexRA(a2x,'Sa_ugust') + end if index_a2x_Sa_tbot = mct_aVect_indexRA(a2x,'Sa_tbot') index_a2x_Sa_pslv = mct_aVect_indexRA(a2x,'Sa_pslv') index_a2x_Sa_ptem = mct_aVect_indexRA(a2x,'Sa_ptem') @@ -1411,6 +1474,13 @@ subroutine seq_flux_atmocn_mct(infodata, tod, dt, a2x, o2x, xao) zbot(n) = 55.0_r8 ! atm height of bottom layer ~ m ubot(n) = 0.0_r8 ! atm velocity, zonal ~ m/s vbot(n) = 2.0_r8 ! atm velocity, meridional ~ m/s + if (atm_flux_method == 'implicit_stress') then + wsresp(n) = 0.0_r8 ! response of wind to surface stress ~ m/s/Pa + tau_est(n) = 0.0_r8 ! stress consistent w/ u/v ~ Pa + end if + if (atm_gustiness) then + ugust_atm(n) = 0.0_r8 ! gustiness ~ m/s + end if thbot(n)= 301.0_r8 ! atm potential temperature ~ Kelvin shum(n) = 1.e-2_r8 ! atm specific humidity ~ kg/kg !wiso note: shum_* should be multiplied by Rstd_* here? @@ -1458,6 +1528,13 @@ subroutine seq_flux_atmocn_mct(infodata, tod, dt, a2x, o2x, xao) zbot(n) = a2x%rAttr(index_a2x_Sa_z ,n) ubot(n) = a2x%rAttr(index_a2x_Sa_u ,n) vbot(n) = a2x%rAttr(index_a2x_Sa_v ,n) + if (atm_flux_method == 'implicit_stress') then + wsresp(n) = a2x%rAttr(index_a2x_Sa_wsresp,n) + tau_est(n) = a2x%rAttr(index_a2x_Sa_tau_est,n) + end if + if (atm_gustiness) then + ugust_atm(n) = a2x%rAttr(index_a2x_Sa_ugust,n) + end if thbot(n)= a2x%rAttr(index_a2x_Sa_ptem,n) shum(n) = a2x%rAttr(index_a2x_Sa_shum,n) if ( index_a2x_Sa_shum_16O /= 0 ) shum_16O(n) = a2x%rAttr(index_a2x_Sa_shum_16O,n) @@ -1536,14 +1613,14 @@ subroutine seq_flux_atmocn_mct(infodata, tod, dt, a2x, o2x, xao) !missval should not be needed if flux calc !consistent with mrgx2a fraction !duu10n,ustar, re , ssq, missval = 0.0_r8 ) - cold_start=cold_start) + cold_start=cold_start, wsresp=wsresp, tau_est=tau_est) else if (ocn_surface_flux_scheme.eq.2) then call shr_flux_atmOcn_UA(nloc , zbot , ubot, vbot, thbot, & shum , shum_16O , shum_HDO, shum_18O, dens , tbot, pslv, & uocn, vocn , tocn , emask, sen , lat , lwup , & roce_16O, roce_HDO, roce_18O, & evap , evap_16O, evap_HDO, evap_18O, taux , tauy, tref, qref , & - duu10n,ustar, re , ssq) + duu10n,ustar, re , ssq, wsresp=wsresp, tau_est=tau_est) else call shr_flux_atmocn (nloc , zbot , ubot, vbot, thbot, & shum , shum_16O , shum_HDO, shum_18O, dens , tbot, uocn, vocn , & @@ -1552,7 +1629,8 @@ subroutine seq_flux_atmocn_mct(infodata, tod, dt, a2x, o2x, xao) roce_16O, roce_HDO, roce_18O, & evap , evap_16O, evap_HDO, evap_18O, taux , tauy, tref, qref , & ocn_surface_flux_scheme, & - duu10n,ustar, re , ssq) + duu10n,ustar, re , ssq, & + wsresp=wsresp, tau_est=tau_est, ugust=ugust_atm) !missval should not be needed if flux calc !consistent with mrgx2a fraction !duu10n,ustar, re , ssq, missval = 0.0_r8 ) diff --git a/driver-moab/main/seq_hist_mod.F90 b/driver-moab/main/seq_hist_mod.F90 index d531f90cb945..81c8cb03190c 100644 --- a/driver-moab/main/seq_hist_mod.F90 +++ b/driver-moab/main/seq_hist_mod.F90 @@ -172,6 +172,7 @@ subroutine seq_hist_write(infodata, EClock_d, & type(mct_gsMap), pointer :: gsmap type(mct_gGrid), pointer :: dom ! comp domain on cpl pes character(CL) :: model_doi_url + logical :: bfbflag !to write out bfbflag value !------------------------------------------------------------------------------- ! @@ -214,7 +215,9 @@ subroutine seq_hist_write(infodata, EClock_d, & ocn_nx=ocn_nx, ocn_ny=ocn_ny, & single_column=single_column, & case_name=case_name, & - model_doi_url=model_doi_url) + model_doi_url=model_doi_url, & + bfbflag=bfbflag) + !--- Get current date from clock needed to label the history pointer file --- @@ -232,7 +235,7 @@ subroutine seq_hist_write(infodata, EClock_d, & if (iamin_CPLID) then if (drv_threading) call seq_comm_setnthreads(nthreads_CPLID) - call seq_io_wopen(hist_file,clobber=.true., model_doi_url=model_doi_url) + call seq_io_wopen(hist_file,clobber=.true., model_doi_url=model_doi_url, bfbflag=bfbflag) ! loop twice, first time write header, second time write data for perf diff --git a/driver-moab/main/seq_io_mod.F90 b/driver-moab/main/seq_io_mod.F90 index d1ac852b095e..9739fbf256a6 100644 --- a/driver-moab/main/seq_io_mod.F90 +++ b/driver-moab/main/seq_io_mod.F90 @@ -132,7 +132,7 @@ end subroutine seq_io_cpl_init ! ! !INTERFACE: ------------------------------------------------------------------ - subroutine seq_io_wopen(filename,clobber,file_ind, model_doi_url, set_fill) + subroutine seq_io_wopen(filename,clobber,file_ind, model_doi_url, set_fill, bfbflag) ! !INPUT/OUTPUT PARAMETERS: implicit none @@ -141,6 +141,7 @@ subroutine seq_io_wopen(filename,clobber,file_ind, model_doi_url, set_fill) integer,optional,intent(in):: file_ind character(CL), optional, intent(in) :: model_doi_url logical, optional, intent(in) :: set_fill + logical, optional, intent(in) :: bfbflag !for priting bfbflag value in the history files !EOP integer :: lset_fill = PIO_NOFILL, old_set_fill logical :: exists @@ -149,8 +150,9 @@ subroutine seq_io_wopen(filename,clobber,file_ind, model_doi_url, set_fill) integer :: rcode integer :: nmode integer :: lfile_ind - character(CL) :: lversion - character(CL) :: lmodel_doi_url + character(CL) :: lbfbflag + character(CL) :: lversion + character(CL) :: lmodel_doi_url character(*),parameter :: subName = '(seq_io_wopen) ' !------------------------------------------------------------------------------- @@ -172,6 +174,12 @@ subroutine seq_io_wopen(filename,clobber,file_ind, model_doi_url, set_fill) lfile_ind = 0 if (present(file_ind)) lfile_ind=file_ind + lbfbflag = 'unset' ! default value for bfbflag + if(present(bfbflag)) then + if(bfbflag) lbfbflag = 'TRUE' + if(.not. bfbflag) lbfbflag = 'FALSE' + endif + call seq_comm_setptrs(CPLID, iam=iam, mpicom=mpicom) if (.not. pio_file_is_open(cpl_io_file(lfile_ind))) then @@ -195,6 +203,7 @@ subroutine seq_io_wopen(filename,clobber,file_ind, model_doi_url, set_fill) #endif rcode = pio_put_att(cpl_io_file(lfile_ind),pio_global,"file_version",version) rcode = pio_put_att(cpl_io_file(lfile_ind),pio_global,"model_doi_url",lmodel_doi_url) + rcode = pio_put_att(cpl_io_file(lfile_ind),pio_global,"BFBFLAG",trim(lbfbflag)) else rcode = pio_openfile(cpl_io_subsystem, cpl_io_file(lfile_ind), cpl_pio_iotype, trim(filename), pio_write) @@ -220,6 +229,7 @@ subroutine seq_io_wopen(filename,clobber,file_ind, model_doi_url, set_fill) if(iam==0) write(logunit,*) subname,' create file ',trim(filename) rcode = pio_put_att(cpl_io_file(lfile_ind),pio_global,"file_version",version) rcode = pio_put_att(cpl_io_file(lfile_ind),pio_global,"model_doi_url",lmodel_doi_url) + rcode = pio_put_att(cpl_io_file(lfile_ind),pio_global,"BFBFLAG",trim(lbfbflag)) endif elseif (trim(wfilename) /= trim(filename)) then ! filename is open, better match open filename @@ -1745,7 +1755,7 @@ subroutine seq_io_read_avs(filename,gsmap,AVS,dname,pre) call shr_mpi_bcast(exists,mpicom,'seq_io_read_avs exists') if (exists) then rcode = pio_openfile(cpl_io_subsystem, pioid, cpl_pio_iotype, trim(filename),pio_nowrite) - if(iam==0) write(logunit,*) subname,' open file ',trim(filename) + if(iam==0) write(logunit,*) subname,' open file ',trim(filename),' for ',trim(dname) call pio_seterrorhandling(pioid,PIO_BCAST_ERROR) rcode = pio_get_att(pioid,pio_global,"file_version",lversion) call pio_seterrorhandling(pioid,PIO_INTERNAL_ERROR) @@ -1847,7 +1857,7 @@ end subroutine seq_io_read_avs !=============================================================================== !BOP =========================================================================== ! - ! !IROUTINE: seq_io_read_avs - read AV from netcdf file + ! !IROUTINE: seq_io_read_avscomp - read AV from netcdf file ! ! !DESCRIPTION: ! Read AV from netcdf file @@ -1890,7 +1900,7 @@ subroutine seq_io_read_avscomp(filename, comp, flow, dname, pre) character(CL) :: lversion character(CL) :: name1 character(CL) :: lpre - character(*),parameter :: subName = '(seq_io_read_avs) ' + character(*),parameter :: subName = '(seq_io_read_avscomp) ' !------------------------------------------------------------------------------- ! !------------------------------------------------------------------------------- @@ -1915,10 +1925,10 @@ subroutine seq_io_read_avscomp(filename, comp, flow, dname, pre) ng = mct_gsmap_gsize(gsmap) if (iam==0) inquire(file=trim(filename),exist=exists) - call shr_mpi_bcast(exists,mpicom,'seq_io_read_avs exists') + call shr_mpi_bcast(exists,mpicom,'seq_io_read_avscomp exists') if (exists) then rcode = pio_openfile(cpl_io_subsystem, pioid, cpl_pio_iotype, trim(filename),pio_nowrite) - if(iam==0) write(logunit,*) subname,' open file ',trim(filename) + if(iam==0) write(logunit,*) subname,' open file ',trim(filename),' for ',trim(dname) call pio_seterrorhandling(pioid,PIO_BCAST_ERROR) rcode = pio_get_att(pioid,pio_global,"file_version",lversion) call pio_seterrorhandling(pioid,PIO_INTERNAL_ERROR) diff --git a/driver-moab/main/seq_rest_mod.F90 b/driver-moab/main/seq_rest_mod.F90 index 12437a4d4339..0ad62de966f4 100644 --- a/driver-moab/main/seq_rest_mod.F90 +++ b/driver-moab/main/seq_rest_mod.F90 @@ -33,7 +33,8 @@ module seq_rest_mod use component_type_mod ! diagnostic routines - use seq_diag_mct, only : budg_dataG, budg_ns + use seq_diag_mct, only: budg_dataG, budg_ns + use seq_diagBGC_mct, only: budg_dataGBGC, budg_nsBGC ! Sets mpi communicators, logunit and loglevel use seq_comm_mct, only: seq_comm_getdata=>seq_comm_setptrs, seq_comm_setnthreads, & @@ -45,9 +46,6 @@ module seq_rest_mod ! clock & alarm routines use seq_timemgr_mod, only: seq_timemgr_type, seq_timemgr_EClockGetData - ! diagnostic routines - use seq_diag_mct, only: budg_datag - ! lower level io routines use seq_io_mod, only: seq_io_read, seq_io_write, seq_io_enddef use seq_io_mod, only: seq_io_wopen, seq_io_close @@ -60,6 +58,8 @@ module seq_rest_mod #endif use prep_rof_mod, only: prep_rof_get_l2racc_lx use prep_rof_mod, only: prep_rof_get_l2racc_lx_cnt + use prep_rof_mod, only: prep_rof_get_o2racc_ox + use prep_rof_mod, only: prep_rof_get_o2racc_ox_cnt use prep_glc_mod, only: prep_glc_get_l2gacc_lx use prep_glc_mod, only: prep_glc_get_l2gacc_lx_cnt use prep_glc_mod, only: prep_glc_get_x2gacc_gx @@ -105,6 +105,7 @@ module seq_rest_mod logical :: ocn_present ! .true. => ocn is present logical :: rof_present ! .true. => land runoff is present logical :: rof_prognostic ! .true. => rof comp expects input + logical :: rofocn_prognostic ! .true. => rof comp expects ocn input logical :: glc_present ! .true. => glc is present logical :: wav_present ! .true. => wav is present logical :: esp_present ! .true. => esp is present @@ -122,12 +123,16 @@ module seq_rest_mod logical :: ocn_c2_glcshelf ! .true. => ocn to glcshelf coupling on + logical :: do_bgc_budgets ! BGC budgets on + !--- temporary pointers --- type(mct_gsMap), pointer :: gsmap type(mct_aVect), pointer :: x2oacc_ox(:) integer , pointer :: x2oacc_ox_cnt type(mct_aVect), pointer :: l2racc_lx(:) integer , pointer :: l2racc_lx_cnt + type(mct_aVect), pointer :: o2racc_ox(:) + integer , pointer :: o2racc_ox_cnt type(mct_aVect), pointer :: l2gacc_lx(:) integer , pointer :: l2gacc_lx_cnt type(mct_aVect), pointer :: x2gacc_gx(:) @@ -200,13 +205,15 @@ subroutine seq_rest_read(rest_file, infodata, & lnd_prognostic=lnd_prognostic, & ice_prognostic=ice_prognostic, & ocn_prognostic=ocn_prognostic, & + rofocn_prognostic=rofocn_prognostic, & rof_prognostic=rof_prognostic, & ocnrof_prognostic=ocnrof_prognostic, & glc_prognostic=glc_prognostic, & wav_prognostic=wav_prognostic, & iac_prognostic=iac_prognostic, & esp_prognostic=esp_prognostic, & - ocn_c2_glcshelf=ocn_c2_glcshelf) + ocn_c2_glcshelf=ocn_c2_glcshelf, & + do_bgc_budgets=do_bgc_budgets) if (iamin_CPLID) then if (drv_threading) call seq_comm_setnthreads(nthreads_CPLID) @@ -228,6 +235,13 @@ subroutine seq_rest_read(rest_file, infodata, & call seq_io_read(rest_file, gsmap, l2racc_lx, 'l2racc_lx') call seq_io_read(rest_file, l2racc_lx_cnt ,'l2racc_lx_cnt') end if + if (ocn_present .and. rofocn_prognostic) then + gsmap => component_get_gsmap_cx(ocn(1)) + o2racc_ox => prep_rof_get_o2racc_ox() + o2racc_ox_cnt => prep_rof_get_o2racc_ox_cnt() + call seq_io_read(rest_file, gsmap, o2racc_ox, 'o2racc_ox') + call seq_io_read(rest_file, o2racc_ox_cnt ,'o2racc_ox_cnt') + end if if (lnd_present .and. glc_prognostic) then gsmap => component_get_gsmap_cx(lnd(1)) l2gacc_lx => prep_glc_get_l2gacc_lx() @@ -301,9 +315,28 @@ subroutine seq_rest_read(rest_file, infodata, & enddo enddo ! call shr_mpi_bcast(budg_dataG,cpl_io_root) ! not necessary, io lib does bcast - deallocate(ds,ns) + if (do_bgc_budgets) then + n = size(budg_dataGBGC) + allocate(ds(n),ns(n)) + call seq_io_read(rest_file, ds, 'budg_dataGBGC') + call seq_io_read(rest_file, ns, 'budg_nsBGC') + + n = 0 + do n1 = 1,size(budg_dataGBGC,dim=1) + do n2 = 1,size(budg_dataGBGC,dim=2) + do n3 = 1,size(budg_dataGBGC,dim=3) + n = n + 1 + budg_dataGBGC(n1,n2,n3) = ds(n) + budg_nsBGC (n1,n2,n3) = ns(n) + enddo + enddo + enddo + ! call shr_mpi_bcast(budg_dataG,cpl_io_root) ! not necessary, io lib does bcast + deallocate(ds,ns) + endif + if (drv_threading) call seq_comm_setnthreads(nthreads_GLOID) endif @@ -359,6 +392,8 @@ subroutine seq_rest_write(EClock_d, seq_SyncClock, infodata, & real(r8),allocatable :: ds(:) ! for reshaping diag data for restart file real(r8),allocatable :: ns(:) ! for reshaping diag data for restart file + real(r8),allocatable :: dsBGC(:) ! for reshaping diag data for restart file + real(r8),allocatable :: nsBGC(:) ! for reshaping diag data for restart file character(CL) :: model_doi_url character(len=*),parameter :: subname = "(seq_rest_write) " @@ -392,6 +427,7 @@ subroutine seq_rest_write(EClock_d, seq_SyncClock, infodata, & lnd_prognostic=lnd_prognostic, & ice_prognostic=ice_prognostic, & rof_prognostic=rof_prognostic, & + rofocn_prognostic=rofocn_prognostic, & ocn_prognostic=ocn_prognostic, & ocnrof_prognostic=ocnrof_prognostic, & glc_prognostic=glc_prognostic, & @@ -399,6 +435,7 @@ subroutine seq_rest_write(EClock_d, seq_SyncClock, infodata, & esp_prognostic=esp_prognostic, & iac_prognostic=iac_prognostic, & ocn_c2_glcshelf=ocn_c2_glcshelf, & + do_bgc_budgets=do_bgc_budgets, & case_name=case_name, & model_doi_url=model_doi_url) @@ -432,6 +469,24 @@ subroutine seq_rest_write(EClock_d, seq_SyncClock, infodata, & enddo enddo + ! copy budg_dataGBGC into 1d array if BGC budgets are on + if (do_bgc_budgets) then + n = size(budg_dataGBGC) + allocate(dsBGC(n),nsBGC(n)) + call shr_mpi_bcast(budg_dataGBGC,mpicom_CPLID) ! pio requires data on all pe's? + + n = 0 + do n1 = 1,size(budg_dataGBGC,dim=1) + do n2 = 1,size(budg_dataGBGC,dim=2) + do n3 = 1,size(budg_dataGBGC,dim=3) + n = n + 1 + dsBGC(n) = budg_dataGBGC(n1,n2,n3) + nsBGC(n) = budg_nsBGC(n1,n2,n3) + enddo + enddo + enddo + endif + if (cplroot) then iun = shr_file_getUnit() call seq_infodata_GetData(infodata,restart_pfile=cvar) @@ -481,6 +536,11 @@ subroutine seq_rest_write(EClock_d, seq_SyncClock, infodata, & call seq_io_write(rest_file,ds,'budg_dataG',whead=whead,wdata=wdata) call seq_io_write(rest_file,ns,'budg_ns',whead=whead,wdata=wdata) + if (do_bgc_budgets) then + call seq_io_write(rest_file,dsBGC,'budg_dataGBGC',whead=whead,wdata=wdata) + call seq_io_write(rest_file,nsBGC,'budg_nsBGC',whead=whead,wdata=wdata) + endif + if (atm_present) then gsmap => component_get_gsmap_cx(atm(1)) xao_ax => prep_aoflux_get_xao_ax() @@ -505,6 +565,15 @@ subroutine seq_rest_write(EClock_d, seq_SyncClock, infodata, & call seq_io_write(rest_file, l2racc_lx_cnt, 'l2racc_lx_cnt', & whead=whead, wdata=wdata) end if + if (ocn_present .and. rofocn_prognostic) then + gsmap => component_get_gsmap_cx(ocn(1)) + o2racc_ox => prep_rof_get_o2racc_ox() + o2racc_ox_cnt => prep_rof_get_o2racc_ox_cnt() + call seq_io_write(rest_file, gsmap, o2racc_ox, 'o2racc_ox', & + whead=whead, wdata=wdata) + call seq_io_write(rest_file, o2racc_ox_cnt, 'o2racc_ox_cnt', & + whead=whead, wdata=wdata) + end if if (lnd_present .and. glc_prognostic) then gsmap => component_get_gsmap_cx(lnd(1)) l2gacc_lx => prep_glc_get_l2gacc_lx() @@ -582,6 +651,7 @@ subroutine seq_rest_write(EClock_d, seq_SyncClock, infodata, & call seq_io_close(rest_file) deallocate(ds,ns) + if (do_bgc_budgets) deallocate(dsBGC,nsBGC) if (drv_threading) call seq_comm_setnthreads(nthreads_GLOID) endif diff --git a/driver-moab/shr/seq_comm_mct.F90 b/driver-moab/shr/seq_comm_mct.F90 index 47e9d3ad4b02..d439ae49006e 100644 --- a/driver-moab/shr/seq_comm_mct.F90 +++ b/driver-moab/shr/seq_comm_mct.F90 @@ -191,6 +191,7 @@ module seq_comm_mct integer :: cmppe ! a common task in mpicom from the component group for join mpicoms ! cmppe is used to broadcast information from the component to the coupler logical :: set ! has this datatype been set + integer :: excl_group ! mpi group of tasks owned exclusively by this component end type seq_comm_type @@ -262,6 +263,7 @@ subroutine seq_comm_init(global_comm_in, driver_comm_in, nmlfile, drv_comm_id) character(*), parameter :: subName = '(seq_comm_init) ' integer :: mype,numpes,myncomps,max_threads,gloroot, global_numpes integer :: pelist(3,1) ! start, stop, stride for group + integer :: exlist(3), mpigrp_world, exgrp integer, pointer :: comps(:) ! array with component ids integer, pointer :: comms(:) ! array with mpicoms integer :: nu @@ -273,29 +275,28 @@ subroutine seq_comm_init(global_comm_in, driver_comm_in, nmlfile, drv_comm_id) character(len=seq_comm_namelen) :: valid_comps(ncomps) integer :: & - atm_ntasks, atm_rootpe, atm_pestride, atm_nthreads, & - lnd_ntasks, lnd_rootpe, lnd_pestride, lnd_nthreads, & - ice_ntasks, ice_rootpe, ice_pestride, ice_nthreads, & - glc_ntasks, glc_rootpe, glc_pestride, glc_nthreads, & - wav_ntasks, wav_rootpe, wav_pestride, wav_nthreads, & - rof_ntasks, rof_rootpe, rof_pestride, rof_nthreads, & - ocn_ntasks, ocn_rootpe, ocn_pestride, ocn_nthreads, & - esp_ntasks, esp_rootpe, esp_pestride, esp_nthreads, & - iac_ntasks, iac_rootpe, iac_pestride, iac_nthreads, & - cpl_ntasks, cpl_rootpe, cpl_pestride, cpl_nthreads, & - info_taskmap_model + atm_ntasks, atm_rootpe, atm_pestride, atm_excl_stride, atm_nthreads, & + lnd_ntasks, lnd_rootpe, lnd_pestride, lnd_excl_stride, lnd_nthreads, & + ice_ntasks, ice_rootpe, ice_pestride, ice_excl_stride, ice_nthreads, & + glc_ntasks, glc_rootpe, glc_pestride, glc_excl_stride, glc_nthreads, & + wav_ntasks, wav_rootpe, wav_pestride, wav_excl_stride, wav_nthreads, & + rof_ntasks, rof_rootpe, rof_pestride, rof_excl_stride, rof_nthreads, & + ocn_ntasks, ocn_rootpe, ocn_pestride, ocn_excl_stride, ocn_nthreads, & + esp_ntasks, esp_rootpe, esp_pestride, esp_excl_stride, esp_nthreads, & + iac_ntasks, iac_rootpe, iac_pestride, iac_excl_stride, iac_nthreads, & + cpl_ntasks, cpl_rootpe, cpl_pestride, cpl_excl_stride, cpl_nthreads namelist /cime_pes/ & - atm_ntasks, atm_rootpe, atm_pestride, atm_nthreads, atm_layout, & - lnd_ntasks, lnd_rootpe, lnd_pestride, lnd_nthreads, lnd_layout, & - ice_ntasks, ice_rootpe, ice_pestride, ice_nthreads, ice_layout, & - glc_ntasks, glc_rootpe, glc_pestride, glc_nthreads, glc_layout, & - wav_ntasks, wav_rootpe, wav_pestride, wav_nthreads, wav_layout, & - rof_ntasks, rof_rootpe, rof_pestride, rof_nthreads, rof_layout, & - ocn_ntasks, ocn_rootpe, ocn_pestride, ocn_nthreads, ocn_layout, & - esp_ntasks, esp_rootpe, esp_pestride, esp_nthreads, esp_layout, & - iac_ntasks, iac_rootpe, iac_pestride, iac_nthreads, iac_layout, & - cpl_ntasks, cpl_rootpe, cpl_pestride, cpl_nthreads, & + atm_ntasks, atm_rootpe, atm_pestride, atm_excl_stride, atm_nthreads, atm_layout, & + lnd_ntasks, lnd_rootpe, lnd_pestride, lnd_excl_stride, lnd_nthreads, lnd_layout, & + ice_ntasks, ice_rootpe, ice_pestride, ice_excl_stride, ice_nthreads, ice_layout, & + glc_ntasks, glc_rootpe, glc_pestride, glc_excl_stride, glc_nthreads, glc_layout, & + wav_ntasks, wav_rootpe, wav_pestride, wav_excl_stride, wav_nthreads, wav_layout, & + rof_ntasks, rof_rootpe, rof_pestride, rof_excl_stride, rof_nthreads, rof_layout, & + ocn_ntasks, ocn_rootpe, ocn_pestride, ocn_excl_stride, ocn_nthreads, ocn_layout, & + esp_ntasks, esp_rootpe, esp_pestride, esp_excl_stride, esp_nthreads, esp_layout, & + iac_ntasks, iac_rootpe, iac_pestride, iac_excl_stride, iac_nthreads, iac_layout, & + cpl_ntasks, cpl_rootpe, cpl_pestride, cpl_excl_stride, cpl_nthreads, & info_taskmap_model, info_taskmap_comp, info_mprof, info_mprof_dt !---------------------------------------------------------- @@ -325,6 +326,7 @@ subroutine seq_comm_init(global_comm_in, driver_comm_in, nmlfile, drv_comm_id) seq_comms(n)%pethreads = -1 seq_comms(n)%cplpe = -1 seq_comms(n)%cmppe = -1 + seq_comms(n)%excl_group = -1 enddo @@ -524,28 +526,48 @@ subroutine seq_comm_init(global_comm_in, driver_comm_in, nmlfile, drv_comm_id) pelist(1,1) = cpl_rootpe pelist(2,1) = cpl_rootpe + (cpl_ntasks -1) * cpl_pestride pelist(3,1) = cpl_pestride + exlist(1) = pelist(1,1) + exlist(2) = pelist(2,1) + exlist(3) = cpl_excl_stride end if call mpi_bcast(pelist, size(pelist), MPI_INTEGER, 0, DRIVER_COMM, ierr) + call mpi_bcast(exlist, size(exlist), MPI_INTEGER, 0, DRIVER_COMM, ierr) + if (exlist(3) > 0) then + call mpi_comm_group(DRIVER_COMM, mpigrp_world, ierr) + call shr_mpi_chkerr(ierr,subname//' mpi_comm_group mpigrp_world') + call mpi_group_range_incl(mpigrp_world, 1, exlist, exgrp, ierr) + call shr_mpi_chkerr(ierr,subname//' mpi_group_range_incl CPLID') + seq_comms(CPLID)%excl_group = exgrp + endif call seq_comm_setcomm(CPLID,pelist,nthreads=cpl_nthreads,iname='CPL') - call comp_comm_init(driver_comm, atm_rootpe, atm_nthreads, atm_layout, atm_ntasks, atm_pestride, num_inst_atm, & + call comp_comm_init(driver_comm, atm_rootpe, atm_nthreads, atm_layout, & + atm_ntasks, atm_pestride, atm_excl_stride, num_inst_atm, & CPLID, ATMID, CPLATMID, ALLATMID, CPLALLATMID, 'ATM', count, drv_comm_id) - call comp_comm_init(driver_comm, lnd_rootpe, lnd_nthreads, lnd_layout, lnd_ntasks, lnd_pestride, num_inst_lnd, & + call comp_comm_init(driver_comm, lnd_rootpe, lnd_nthreads, lnd_layout, & + lnd_ntasks, lnd_pestride, lnd_excl_stride, num_inst_lnd, & CPLID, LNDID, CPLLNDID, ALLLNDID, CPLALLLNDID, 'LND', count, drv_comm_id) - call comp_comm_init(driver_comm, ice_rootpe, ice_nthreads, ice_layout, ice_ntasks, ice_pestride, num_inst_ice, & + call comp_comm_init(driver_comm, ice_rootpe, ice_nthreads, ice_layout, & + ice_ntasks, ice_pestride, ice_excl_stride, num_inst_ice, & CPLID, ICEID, CPLICEID, ALLICEID, CPLALLICEID, 'ICE', count, drv_comm_id) - call comp_comm_init(driver_comm, ocn_rootpe, ocn_nthreads, ocn_layout, ocn_ntasks, ocn_pestride, num_inst_ocn, & + call comp_comm_init(driver_comm, ocn_rootpe, ocn_nthreads, ocn_layout, & + ocn_ntasks, ocn_pestride, ocn_excl_stride, num_inst_ocn, & CPLID, OCNID, CPLOCNID, ALLOCNID, CPLALLOCNID, 'OCN', count, drv_comm_id) - call comp_comm_init(driver_comm, rof_rootpe, rof_nthreads, rof_layout, rof_ntasks, rof_pestride, num_inst_rof, & + call comp_comm_init(driver_comm, rof_rootpe, rof_nthreads, rof_layout, & + rof_ntasks, rof_pestride, rof_excl_stride, num_inst_rof, & CPLID, ROFID, CPLROFID, ALLROFID, CPLALLROFID, 'ROF', count, drv_comm_id) - call comp_comm_init(driver_comm, glc_rootpe, glc_nthreads, glc_layout, glc_ntasks, glc_pestride, num_inst_glc, & + call comp_comm_init(driver_comm, glc_rootpe, glc_nthreads, glc_layout, & + glc_ntasks, glc_pestride, glc_excl_stride, num_inst_glc, & CPLID, GLCID, CPLGLCID, ALLGLCID, CPLALLGLCID, 'GLC', count, drv_comm_id) - call comp_comm_init(driver_comm, wav_rootpe, wav_nthreads, wav_layout, wav_ntasks, wav_pestride, num_inst_wav, & + call comp_comm_init(driver_comm, wav_rootpe, wav_nthreads, wav_layout, & + wav_ntasks, wav_pestride, wav_excl_stride, num_inst_wav, & CPLID, WAVID, CPLWAVID, ALLWAVID, CPLALLWAVID, 'WAV', count, drv_comm_id) - call comp_comm_init(driver_comm, esp_rootpe, esp_nthreads, esp_layout, esp_ntasks, esp_pestride, num_inst_esp, & + call comp_comm_init(driver_comm, esp_rootpe, esp_nthreads, esp_layout, & + esp_ntasks, esp_pestride, esp_excl_stride, num_inst_esp, & CPLID, ESPID, CPLESPID, ALLESPID, CPLALLESPID, 'ESP', count, drv_comm_id) - call comp_comm_init(driver_comm, iac_rootpe, iac_nthreads, iac_layout, iac_ntasks, iac_pestride, num_inst_iac, & + call comp_comm_init(driver_comm, iac_rootpe, iac_nthreads, iac_layout, & + iac_ntasks, iac_pestride, iac_excl_stride, num_inst_iac, & CPLID, IACID, CPLIACID, ALLIACID, CPLALLIACID, 'IAC', count, drv_comm_id) if (count /= ncomps) then @@ -654,7 +676,7 @@ subroutine seq_comm_init(global_comm_in, driver_comm_in, nmlfile, drv_comm_id) end subroutine seq_comm_init subroutine comp_comm_init(driver_comm, comp_rootpe, comp_nthreads, comp_layout, & - comp_ntasks, comp_pestride, num_inst_comp, & + comp_ntasks, comp_pestride, comp_exstride, num_inst_comp, & CPLID, COMPID, CPLCOMPID, ALLCOMPID, CPLALLCOMPID, name, count, drv_comm_id) integer, intent(in) :: driver_comm integer, intent(in) :: comp_rootpe @@ -662,6 +684,7 @@ subroutine comp_comm_init(driver_comm, comp_rootpe, comp_nthreads, comp_layout, character(len=*), intent(in) :: comp_layout integer, intent(in) :: comp_ntasks integer, intent(in) :: comp_pestride + integer, intent(in) :: comp_exstride integer, intent(in) :: num_inst_comp integer, intent(in) :: CPLID integer, intent(out) :: COMPID(num_inst_comp) @@ -672,13 +695,13 @@ subroutine comp_comm_init(driver_comm, comp_rootpe, comp_nthreads, comp_layout, integer, intent(in), optional :: drv_comm_id character(len=*), intent(in) :: name - character(len=*), parameter :: subname = "comp_comm_init" + character(len=*), parameter :: subname = "(comp_comm_init) " integer :: comp_inst_tasks integer :: droot integer :: current_task_rootpe integer :: cmin(num_inst_comp), cmax(num_inst_comp), cstr(num_inst_comp) integer :: n - integer :: pelist (3,1) + integer :: pelist(3,1), exlist(3), mpigrp_world, exgrp integer :: ierr integer :: mype @@ -726,13 +749,25 @@ subroutine comp_comm_init(driver_comm, comp_rootpe, comp_nthreads, comp_layout, current_task_rootpe = current_task_rootpe + droot end do endif + do n = 1, num_inst_comp if (mype==0) then pelist(1,1) = cmin(n) pelist(2,1) = cmax(n) pelist(3,1) = cstr(n) + exlist(1) = cmin(n) + exlist(2) = cmax(n) + exlist(3) = comp_exstride endif call mpi_bcast(pelist, size(pelist), MPI_INTEGER, 0, DRIVER_COMM, ierr) + call mpi_bcast(exlist, size(exlist), MPI_INTEGER, 0, DRIVER_COMM, ierr) + if (exlist(3) > 0) then + call mpi_comm_group(DRIVER_COMM, mpigrp_world, ierr) + call shr_mpi_chkerr(ierr,subname//' mpi_comm_group mpigrp_world') + call mpi_group_range_incl(mpigrp_world, 1, exlist, exgrp, ierr) + call shr_mpi_chkerr(ierr,subname//' mpi_group_range_incl COMPID') + seq_comms(COMPID(n))%excl_group = exgrp + endif if (present(drv_comm_id)) then call seq_comm_setcomm(COMPID(n),pelist,nthreads=comp_nthreads,iname=name,inst=drv_comm_id) else @@ -795,10 +830,10 @@ subroutine seq_comm_setcomm(ID,pelist,nthreads,iname,inst,tinst) integer,intent(IN),optional :: tinst ! total number of instances for this component integer :: mpigrp_world - integer :: mpigrp + integer :: mpigrp, newgrp integer :: mpicom integer :: ntasks - integer :: ierr + integer :: ierr, n character(len=seq_comm_namelen) :: cname logical :: set_suffix character(*),parameter :: subName = '(seq_comm_setcomm) ' @@ -812,8 +847,18 @@ subroutine seq_comm_setcomm(ID,pelist,nthreads,iname,inst,tinst) call shr_mpi_chkerr(ierr,subname//' mpi_comm_group mpigrp_world') call mpi_group_range_incl(mpigrp_world, 1, pelist, mpigrp,ierr) call shr_mpi_chkerr(ierr,subname//' mpi_group_range_incl mpigrp') - call mpi_comm_create(DRIVER_COMM, mpigrp, mpicom, ierr) + ! exclude tasks dedicated to other components + do n = 3, ID + if (seq_comms(n)%excl_group >= 0) then + if (n == ID) cycle ! don't exclude self + call mpi_group_difference(mpigrp, seq_comms(n)%excl_group, newgrp, ierr) + call shr_mpi_chkerr(ierr,subname//' mpi_group_difference excl_group') + mpigrp = newgrp + endif + enddo + + call mpi_comm_create(DRIVER_COMM, mpigrp, mpicom, ierr) call shr_mpi_chkerr(ierr,subname//' mpi_comm_create mpigrp') ntasks = ((pelist(2,1) - pelist(1,1)) / pelist(3,1)) + 1 diff --git a/driver-moab/shr/seq_flds_mod.F90 b/driver-moab/shr/seq_flds_mod.F90 index 59f70e45b150..ed888e280e65 100644 --- a/driver-moab/shr/seq_flds_mod.F90 +++ b/driver-moab/shr/seq_flds_mod.F90 @@ -121,7 +121,7 @@ module seq_flds_mod ! variables CCSM_VOC, CCSM_BGC and GLC_NEC. !==================================================================== - use shr_kind_mod , only : CX => shr_kind_CX, CXX => shr_kind_CXX + use shr_kind_mod , only : CS => shr_kind_CS, CX => shr_kind_CX, CXX => shr_kind_CXX use shr_sys_mod , only : shr_sys_abort use seq_comm_mct , only : seq_comm_iamroot, seq_comm_setptrs, logunit use seq_drydep_mod , only : seq_drydep_init, seq_drydep_readnl, lnd_drydep @@ -161,6 +161,13 @@ module seq_flds_mod logical :: rof_heat ! .true. if river model includes temperature logical :: add_ndep_fields ! .true. => add ndep fields + character(len=CS) :: atm_flux_method ! explicit => no extra fields needed + ! implicit_stress => atm provides wsresp and tau_est + logical :: atm_gustiness ! .true. if the atmosphere model produces gustiness + logical :: rof2ocn_nutrients ! .true. if the runoff model passes nutrient fields to the ocn + logical :: lnd_rof_two_way ! .true. if land-river two-way coupling turned on + logical :: ocn_rof_two_way ! .true. if river-ocean two-way coupling turned on + !---------------------------------------------------------------------------- ! metadata !---------------------------------------------------------------------------- @@ -202,6 +209,8 @@ module seq_flds_mod character(CXX) :: seq_flds_o2x_fluxes character(CXX) :: seq_flds_x2o_states character(CXX) :: seq_flds_x2o_fluxes + character(CXX) :: seq_flds_o2x_states_to_rof + character(CXX) :: seq_flds_o2x_fluxes_to_rof character(CXX) :: seq_flds_g2x_states character(CXX) :: seq_flds_g2x_states_to_lnd @@ -262,6 +271,7 @@ module seq_flds_mod character(CXX) :: seq_flds_x2g_fields character(CXX) :: seq_flds_w2x_fields character(CXX) :: seq_flds_x2w_fields + character(CXX) :: seq_flds_o2x_fields_to_rof !---------------------------------------------------------------------------- ! component names @@ -334,6 +344,8 @@ subroutine seq_flds_set(nmlfile, ID, infodata) character(CXX) :: x2l_fluxes_from_glc = '' character(CXX) :: o2x_states = '' character(CXX) :: o2x_fluxes = '' + character(CXX) :: o2x_states_to_rof = '' + character(CXX) :: o2x_fluxes_to_rof = '' character(CXX) :: x2o_states = '' character(CXX) :: x2o_fluxes = '' character(CXX) :: g2x_states = '' @@ -383,7 +395,8 @@ subroutine seq_flds_set(nmlfile, ID, infodata) namelist /seq_cplflds_inparm/ & flds_co2a, flds_co2b, flds_co2c, flds_co2_dmsa, flds_wiso, glc_nec, & ice_ncat, seq_flds_i2o_per_cat, flds_bgc_oi, & - nan_check_component_fields, rof_heat + nan_check_component_fields, rof_heat, atm_flux_method, atm_gustiness, & + rof2ocn_nutrients, lnd_rof_two_way, ocn_rof_two_way ! user specified new fields integer, parameter :: nfldmax = 200 @@ -422,6 +435,11 @@ subroutine seq_flds_set(nmlfile, ID, infodata) seq_flds_i2o_per_cat = .false. nan_check_component_fields = .false. rof_heat = .false. + atm_flux_method = 'explicit' + atm_gustiness = .false. + rof2ocn_nutrients = .false. + lnd_rof_two_way = .false. + ocn_rof_two_way = .false. unitn = shr_file_getUnit() write(logunit,"(A)") subname//': read seq_cplflds_inparm namelist from: '& @@ -449,6 +467,11 @@ subroutine seq_flds_set(nmlfile, ID, infodata) call shr_mpi_bcast(seq_flds_i2o_per_cat, mpicom) call shr_mpi_bcast(nan_check_component_fields, mpicom) call shr_mpi_bcast(rof_heat , mpicom) + call shr_mpi_bcast(atm_flux_method, mpicom) + call shr_mpi_bcast(atm_gustiness, mpicom) + call shr_mpi_bcast(rof2ocn_nutrients, mpicom) + call shr_mpi_bcast(lnd_rof_two_way, mpicom) + call shr_mpi_bcast(ocn_rof_two_way, mpicom) call glc_elevclass_init(glc_nec) @@ -656,6 +679,40 @@ subroutine seq_flds_set(nmlfile, ID, infodata) attname = 'Sa_v' call metadata_set(attname, longname, stdname, units) + if (atm_flux_method == 'implicit_stress') then + ! first-order response of wind to surface stresses (m/s/Pa) + call seq_flds_add(a2x_states,"Sa_wsresp") + call seq_flds_add(x2l_states,"Sa_wsresp") + call seq_flds_add(x2i_states,"Sa_wsresp") + longname = 'Response of wind to surface stress' + stdname = '' + units = 'm s-1 Pa-1' + attname = 'Sa_wsresp' + call metadata_set(attname, longname, stdname, units) + + ! surface stress compatible with low level wind (Pa) + call seq_flds_add(a2x_states,"Sa_tau_est") + call seq_flds_add(x2l_states,"Sa_tau_est") + call seq_flds_add(x2i_states,"Sa_tau_est") + longname = 'Estimate of surface stress in equilibrium with boundary layer' + stdname = '' + units = 'Pa' + attname = 'Sa_tau_est' + call metadata_set(attname, longname, stdname, units) + end if + + if (atm_gustiness) then + ! extra mean wind speed associated with gustiness (m/s) + call seq_flds_add(a2x_states,"Sa_ugust") + call seq_flds_add(x2l_states,"Sa_ugust") + call seq_flds_add(x2i_states,"Sa_ugust") + longname = 'Extra wind speed due to gustiness' + stdname = '' + units = 'm s-1' + attname = 'Sa_ugust' + call metadata_set(attname, longname, stdname, units) + end if + ! temperature at the lowest model level (K) call seq_flds_add(a2x_states,"Sa_tbot") call seq_flds_add(x2l_states,"Sa_tbot") @@ -1363,6 +1420,13 @@ subroutine seq_flds_set(nmlfile, ID, infodata) attname = 'Faxx_evap' call metadata_set(attname, longname, stdname, units) + call seq_flds_add(l2x_states,"Flrl_wslake") + longname = 'Lake water storage flux' + stdname = 'lake_water_storage_flux' + units = 'kg m-2 s-1' + attname = 'Flrl_wslake' + call metadata_set(attname, longname, stdname, units) + ! Dust flux (particle bin number 1) call seq_flds_add(l2x_fluxes,"Fall_flxdst1") call seq_flds_add(x2a_fluxes,"Fall_flxdst1") @@ -1598,6 +1662,17 @@ subroutine seq_flds_set(nmlfile, ID, infodata) attname = 'So_dhdx' call metadata_set(attname, longname, stdname, units) + ! sea surface height + call seq_flds_add(o2x_states,"So_ssh") + call seq_flds_add(x2r_states,"So_ssh") + call seq_flds_add(o2x_states_to_rof,"So_ssh") + call seq_flds_add(x2w_states,'So_ssh') + longname = 'Sea surface height' + stdname = 'sea_surface_height' + units = 'm' + attname = 'So_ssh' + call metadata_set(attname, longname, stdname, units) + ! Meridional sea surface slope call seq_flds_add(o2x_states,"So_dhdy") call seq_flds_add(x2i_states,"So_dhdy") @@ -2027,6 +2102,19 @@ subroutine seq_flds_set(nmlfile, ID, infodata) endif + !------------------------------ + ! ice<->wav only exchange + !------------------------------ + + ! Sea ice thickness + call seq_flds_add(i2x_states,"Si_ithick") + call seq_flds_add(x2w_states,"Si_ithick") + longname = 'Sea ice thickness' + stdname = 'sea_ice_thickness' + units = 'm' + attname = 'Si_ithick' + call metadata_set(attname, longname, stdname, units) + !----------------------------- ! lnd->rof exchange @@ -2116,27 +2204,6 @@ subroutine seq_flds_set(nmlfile, ID, infodata) call metadata_set(attname, longname, stdname, units) endif - ! Currently only the CESM land and runoff models treat irrigation as a separate - ! field: in E3SM, this field is folded in to the other runoff fields. Eventually, - ! E3SM may want to update its land and runoff models to map irrigation specially, as - ! CESM does. - ! - ! (Once E3SM is using this irrigation field, all that needs to be done is to remove - ! this conditional: Code in other places in the coupler is written to trigger off of - ! whether Flrl_irrig has been added to the field list, so it should Just Work if this - ! conditional is removed.) - if (trim(cime_model) == 'cesm') then - ! Irrigation flux (land/rof only) - call seq_flds_add(l2x_fluxes,"Flrl_irrig") - call seq_flds_add(x2r_fluxes,"Flrl_irrig") - call seq_flds_add(l2x_fluxes_to_rof,'Flrl_irrig') - longname = 'Irrigation flux (withdrawal from rivers)' - stdname = 'irrigation' - units = 'kg m-2 s-1' - attname = 'Flrl_irrig' - call metadata_set(attname, longname, stdname, units) - end if - !----------------------------- ! rof->ocn (runoff) and rof->lnd (flooding) !----------------------------- @@ -2197,59 +2264,295 @@ subroutine seq_flds_set(nmlfile, ID, infodata) attname = 'Flrr_volrmch' call metadata_set(attname, longname, stdname, units) - if (trim(cime_model) == 'e3sm') then - call seq_flds_add(r2x_fluxes,'Flrr_supply') - call seq_flds_add(x2l_fluxes,'Flrr_supply') - longname = 'River model supply for land use' - stdname = 'rtm_supply' - units = 'kg m-2 s-1' - attname = 'Flrr_supply' - call metadata_set(attname, longname, stdname, units) - endif + call seq_flds_add(r2x_fluxes,'Flrr_supply') + call seq_flds_add(x2l_fluxes,'Flrr_supply') + longname = 'River model supply for land use' + stdname = 'rtm_supply' + units = 'kg m-2 s-1' + attname = 'Flrr_supply' + call metadata_set(attname, longname, stdname, units) - if (trim(cime_model) == 'e3sm') then - call seq_flds_add(r2x_fluxes,'Flrr_deficit') - call seq_flds_add(x2l_fluxes,'Flrr_deficit') - longname = 'River model supply deficit' - stdname = 'rtm_deficit' - units = 'kg m-2 s-1' - attname = 'Flrr_deficit' - call metadata_set(attname, longname, stdname, units) + call seq_flds_add(r2x_fluxes,'Flrr_deficit') + call seq_flds_add(x2l_fluxes,'Flrr_deficit') + longname = 'River model supply deficit' + stdname = 'rtm_deficit' + units = 'kg m-2 s-1' + attname = 'Flrr_deficit' + call metadata_set(attname, longname, stdname, units) + + ! land river two way coupling + if (lnd_rof_two_way) then + call seq_flds_add(r2x_fluxes, 'Sr_h2orof') + call seq_flds_add(x2l_fluxes, 'Sr_h2orof') + longname = 'Inundation floodplain water volume' + stdname = 'rtm_inundwf' + units = 'mm' + attname = 'inundwf' + call metadata_set(attname, longname, stdname, units) + + call seq_flds_add(r2x_fluxes, 'Sr_frac_h2orof') + call seq_flds_add(x2l_fluxes, 'Sr_frac_h2orof') + longname = 'Inundation floodplain water area fraction' + stdname = 'rtm_inundff' + units = '1' + attname = 'inundff' + call metadata_set(attname, longname, stdname, units) + + call seq_flds_add(l2x_fluxes, 'Flrl_inundinf') + call seq_flds_add(x2r_fluxes, 'Flrl_inundinf') + call seq_flds_add(l2x_fluxes_to_rof,'Flrl_inundinf') + longname = 'Infiltration from floodplain inundation volume' + stdname = 'floodplain_inundation_infiltration' + units = 'mm/s' + attname = 'inundinf' + call metadata_set(attname, longname, stdname, units) endif + + if (rof2ocn_nutrients) then + call seq_flds_add(r2x_fluxes,'Forr_rofDIN') + call seq_flds_add(x2o_fluxes,'Foxx_rofDIN') + call seq_flds_add(r2o_liq_fluxes,'Forr_rofDIN') + longname = 'DIN flux due to runoff' + stdname = 'DIN_flux_into_sea_water' + units = 'kg N per kg water' + attname = 'Forr_rofDIN' + call metadata_set(attname, longname, stdname, units) + attname = 'Foxx_rofDIN' + call metadata_set(attname, longname, stdname, units) + + call seq_flds_add(r2x_fluxes,'Forr_rofDIP') + call seq_flds_add(x2o_fluxes,'Foxx_rofDIP') + call seq_flds_add(r2o_liq_fluxes,'Forr_rofDIP') + longname = 'DIP flux due to runoff' + stdname = 'DIP_flux_into_sea_water' + units = 'kg P per kg water' + attname = 'Forr_rofDIP' + call metadata_set(attname, longname, stdname, units) + attname = 'Foxx_rofDIP' + call metadata_set(attname, longname, stdname, units) + + call seq_flds_add(r2x_fluxes,'Forr_rofDON') + call seq_flds_add(x2o_fluxes,'Foxx_rofDON') + call seq_flds_add(r2o_liq_fluxes,'Forr_rofDON') + longname = 'DON flux due to runoff' + stdname = 'DON_flux_into_sea_water' + units = 'kg N per kg water' + attname = 'Forr_rofDON' + call metadata_set(attname, longname, stdname, units) + attname = 'Foxx_rofDON' + call metadata_set(attname, longname, stdname, units) + + call seq_flds_add(r2x_fluxes,'Forr_rofDOP') + call seq_flds_add(x2o_fluxes,'Foxx_rofDOP') + call seq_flds_add(r2o_liq_fluxes,'Forr_rofDOP') + longname = 'DOP flux due to runoff' + stdname = 'DOP_flux_into_sea_water' + units = 'kg P per kg water' + attname = 'Forr_rofDOP' + call metadata_set(attname, longname, stdname, units) + attname = 'Foxx_rofDOP' + call metadata_set(attname, longname, stdname, units) + + call seq_flds_add(r2x_fluxes,'Forr_rofDOC') + call seq_flds_add(x2o_fluxes,'Foxx_rofDOC') + call seq_flds_add(r2o_liq_fluxes,'Forr_rofDOC') + longname = 'DOC flux due to runoff' + stdname = 'DOC_flux_into_sea_water' + units = 'kg C per kg water' + attname = 'Forr_rofDOC' + call metadata_set(attname, longname, stdname, units) + attname = 'Foxx_rofDOC' + call metadata_set(attname, longname, stdname, units) + + call seq_flds_add(r2x_fluxes,'Forr_rofPP') + call seq_flds_add(x2o_fluxes,'Foxx_rofPP') + call seq_flds_add(r2o_liq_fluxes,'Forr_rofPP') + longname = 'PP flux due to runoff' + stdname = 'PP_flux_into_sea_water' + units = 'kg P per kg water' + attname = 'Forr_rofPP' + call metadata_set(attname, longname, stdname, units) + attname = 'Foxx_rofPP' + call metadata_set(attname, longname, stdname, units) + + call seq_flds_add(r2x_fluxes,'Forr_rofDSi') + call seq_flds_add(x2o_fluxes,'Foxx_rofDSi') + call seq_flds_add(r2o_liq_fluxes,'Forr_rofDSi') + longname = 'DSi flux due to runoff' + stdname = 'DSi_flux_into_sea_water' + units = 'kg Si per kg water' + attname = 'Forr_rofDSi' + call metadata_set(attname, longname, stdname, units) + attname = 'Foxx_rofDSi' + call metadata_set(attname, longname, stdname, units) + + call seq_flds_add(r2x_fluxes,'Forr_rofPOC') + call seq_flds_add(x2o_fluxes,'Foxx_rofPOC') + call seq_flds_add(r2o_liq_fluxes,'Forr_rofPOC') + longname = 'POC flux due to runoff' + stdname = 'POC_flux_into_sea_water' + units = 'kg C per kg water' + attname = 'Forr_rofPOC' + call metadata_set(attname, longname, stdname, units) + attname = 'Foxx_rofPOC' + call metadata_set(attname, longname, stdname, units) + + call seq_flds_add(r2x_fluxes,'Forr_rofPN') + call seq_flds_add(x2o_fluxes,'Foxx_rofPN') + call seq_flds_add(r2o_liq_fluxes,'Forr_rofPN') + longname = 'PN flux due to runoff' + stdname = 'PN_flux_into_sea_water' + units = 'kg N per kg water' + attname = 'Forr_rofPN' + call metadata_set(attname, longname, stdname, units) + attname = 'Foxx_rofPN' + call metadata_set(attname, longname, stdname, units) + + call seq_flds_add(r2x_fluxes,'Forr_rofDIC') + call seq_flds_add(x2o_fluxes,'Foxx_rofDIC') + call seq_flds_add(r2o_liq_fluxes,'Forr_rofDIC') + longname = 'DIC flux due to runoff' + stdname = 'DIC_flux_into_sea_water' + units = 'kg C per kg water' + attname = 'Forr_rofDIC' + call metadata_set(attname, longname, stdname, units) + attname = 'Foxx_rofDIC' + call metadata_set(attname, longname, stdname, units) + + call seq_flds_add(r2x_fluxes,'Forr_rofFe') + call seq_flds_add(x2o_fluxes,'Foxx_rofFe') + call seq_flds_add(r2o_liq_fluxes,'Forr_rofFe') + longname = 'Fe flux due to runoff' + stdname = 'Fe_flux_into_sea_water' + units = 'kg Fe per kg water' + attname = 'Forr_rofFe' + call metadata_set(attname, longname, stdname, units) + attname = 'Foxx_rofFe' + call metadata_set(attname, longname, stdname, units) + endif !rof2ocn_nutrients + !----------------------------- ! wav->ocn and ocn->wav !----------------------------- - call seq_flds_add(w2x_states,'Sw_lamult') - call seq_flds_add(x2o_states,'Sw_lamult') - longname = 'Langmuir multiplier' - stdname = 'wave_model_langmuir_multiplier' - units = '' - attname = 'Sw_lamult' + call seq_flds_add(w2x_states,'Sw_ustokes_wavenumber_1') + call seq_flds_add(x2o_states,'Sw_ustokes_wavenumber_1') + longname = 'Partitioned Stokes drift u component, wavenumber 1' + stdname = 'wave_model_partitioned_stokes_drift_u_wavenumber_1' + units = 'm/s' + attname = 'Sw_ustokes_wavenumber_1' + call metadata_set(attname, longname, stdname, units) + + call seq_flds_add(w2x_states,'Sw_vstokes_wavenumber_1') + call seq_flds_add(x2o_states,'Sw_vstokes_wavenumber_1') + longname = 'Partitioned Stokes drift v component, wavenumber 1' + stdname = 'wave_model_partitioned_stokes_drift_v_wavenumber_1' + units = 'm/s' + attname = 'Sw_vstokes_wavenumber_1' + call metadata_set(attname, longname, stdname, units) + + call seq_flds_add(w2x_states,'Sw_ustokes_wavenumber_2') + call seq_flds_add(x2o_states,'Sw_ustokes_wavenumber_2') + longname = 'Partitioned Stokes drift u component, wavenumber 2' + stdname = 'wave_model_partitioned_stokes_drift_u_wavenumber_2' + units = 'm/s' + attname = 'Sw_ustokes_wavenumber_2' + call metadata_set(attname, longname, stdname, units) + + call seq_flds_add(w2x_states,'Sw_vstokes_wavenumber_2') + call seq_flds_add(x2o_states,'Sw_vstokes_wavenumber_2') + longname = 'Partitioned Stokes drift v component, wavenumber 2' + stdname = 'wave_model_partitioned_stokes_drift_v_wavenumber_2' + units = 'm/s' + attname = 'Sw_vstokes_wavenumber_2' + call metadata_set(attname, longname, stdname, units) + + call seq_flds_add(w2x_states,'Sw_ustokes_wavenumber_3') + call seq_flds_add(x2o_states,'Sw_ustokes_wavenumber_3') + longname = 'Partitioned Stokes drift u component, wavenumber 3' + stdname = 'wave_model_partitioned_stokes_drift_u_wavenumber_3' + units = 'm/s' + attname = 'Sw_ustokes_wavenumber_3' + call metadata_set(attname, longname, stdname, units) + + call seq_flds_add(w2x_states,'Sw_vstokes_wavenumber_3') + call seq_flds_add(x2o_states,'Sw_vstokes_wavenumber_3') + longname = 'Partitioned Stokes drift v component, wavenumber 3' + stdname = 'wave_model_partitioned_stokes_drift_v_wavenumber_3' + units = 'm/s' + attname = 'Sw_vstokes_wavenumber_3' + call metadata_set(attname, longname, stdname, units) + + call seq_flds_add(w2x_states,'Sw_ustokes_wavenumber_4') + call seq_flds_add(x2o_states,'Sw_ustokes_wavenumber_4') + longname = 'Partitioned Stokes drift u component, wavenumber 4' + stdname = 'wave_model_partitioned_stokes_drift_u_wavenumber_4' + units = 'm/s' + attname = 'Sw_ustokes_wavenumber_4' + call metadata_set(attname, longname, stdname, units) + + call seq_flds_add(w2x_states,'Sw_vstokes_wavenumber_4') + call seq_flds_add(x2o_states,'Sw_vstokes_wavenumber_4') + longname = 'Partitioned Stokes drift v component, wavenumber 4' + stdname = 'wave_model_partitioned_stokes_drift_v_wavenumber_4' + units = 'm/s' + attname = 'Sw_vstokes_wavenumber_4' call metadata_set(attname, longname, stdname, units) - call seq_flds_add(w2x_states,'Sw_ustokes') - call seq_flds_add(x2o_states,'Sw_ustokes') - longname = 'Stokes drift u component' - stdname = 'wave_model_stokes_drift_eastward_velocity' + call seq_flds_add(w2x_states,'Sw_ustokes_wavenumber_5') + call seq_flds_add(x2o_states,'Sw_ustokes_wavenumber_5') + longname = 'Partitioned Stokes drift u component, wavenumber 5' + stdname = 'wave_model_partitioned_stokes_drift_u_wavenumber_5' units = 'm/s' - attname = 'Sw_ustokes' + attname = 'Sw_ustokes_wavenumber_5' call metadata_set(attname, longname, stdname, units) - call seq_flds_add(w2x_states,'Sw_vstokes') - call seq_flds_add(x2o_states,'Sw_vstokes') - longname = 'Stokes drift v component' - stdname = 'wave_model_stokes_drift_northward_velocity' + call seq_flds_add(w2x_states,'Sw_vstokes_wavenumber_5') + call seq_flds_add(x2o_states,'Sw_vstokes_wavenumber_5') + longname = 'Partitioned Stokes drift v component, wavenumber 5' + stdname = 'wave_model_partitioned_stokes_drift_v_wavenumber_5' units = 'm/s' - attname = 'Sw_vstokes' + attname = 'Sw_vstokes_wavenumber_5' call metadata_set(attname, longname, stdname, units) - call seq_flds_add(w2x_states,'Sw_hstokes') - call seq_flds_add(x2o_states,'Sw_hstokes') - longname = 'Stokes drift depth' - stdname = 'wave_model_stokes_drift_depth' + call seq_flds_add(w2x_states,'Sw_ustokes_wavenumber_6') + call seq_flds_add(x2o_states,'Sw_ustokes_wavenumber_6') + longname = 'Partitioned Stokes drift u component, wavenumber 6' + stdname = 'wave_model_partitioned_stokes_drift_u_wavenumber_6' + units = 'm/s' + attname = 'Sw_ustokes_wavenumber_6' + call metadata_set(attname, longname, stdname, units) + + call seq_flds_add(w2x_states,'Sw_vstokes_wavenumber_6') + call seq_flds_add(x2o_states,'Sw_vstokes_wavenumber_6') + longname = 'Partitioned Stokes drift v component, wavenumber 6' + stdname = 'wave_model_partitioned_stokes_drift_v_wavenumber_6' + units = 'm/s' + attname = 'Sw_vstokes_wavenumber_6' + call metadata_set(attname, longname, stdname, units) + + call seq_flds_add(w2x_states,'Sw_Hs') + call seq_flds_add(x2o_states,'Sw_Hs') + longname = 'Significant wave height' + stdname = 'significant_wave_height' units = 'm' - attname = 'Sw_hstokes' + attname = 'Sw_Hs' + call metadata_set(attname, longname, stdname, units) + + call seq_flds_add(w2x_states,'Sw_Fp') + call seq_flds_add(x2o_states,'Sw_Fp') + longname = 'Peak wave frequency' + stdname = 'peak_wave_frequency' + units = 's-1' + attname = 'Sw_Fp' + call metadata_set(attname, longname, stdname, units) + + call seq_flds_add(w2x_states,'Sw_Dp') + call seq_flds_add(x2o_states,'Sw_Dp') + longname = 'Peak wave direction' + stdname = 'peak_wave_direction' + units = 'deg' + attname = 'Sw_Dp' call metadata_set(attname, longname, stdname, units) !----------------------------- @@ -2774,7 +3077,7 @@ subroutine seq_flds_set(nmlfile, ID, infodata) longname = 'Surface flux of CO2 from land' stdname = 'surface_upward_flux_of_carbon_dioxide_where_land' units = 'moles m-2 s-1' - attname = 'Fall_foc2_lnd' + attname = 'Fall_fco2_lnd' call metadata_set(attname, longname, stdname, units) call seq_flds_add(o2x_fluxes, "Faoo_fco2_ocn") @@ -2816,7 +3119,7 @@ subroutine seq_flds_set(nmlfile, ID, infodata) longname = 'Surface flux of CO2 from land' stdname = 'surface_upward_flux_of_carbon_dioxide_where_land' units = 'moles m-2 s-1' - attname = 'Fall_foc2_lnd' + attname = 'Fall_fco2_lnd' call metadata_set(attname, longname, stdname, units) call seq_flds_add(o2x_fluxes, "Faoo_fco2_ocn") @@ -3569,6 +3872,8 @@ subroutine seq_flds_set(nmlfile, ID, infodata) seq_flds_x2w_fluxes = trim(x2w_fluxes) seq_flds_r2o_liq_fluxes = trim(r2o_liq_fluxes) seq_flds_r2o_ice_fluxes = trim(r2o_ice_fluxes) + seq_flds_o2x_states_to_rof = trim(o2x_states_to_rof) + seq_flds_o2x_fluxes_to_rof = trim(o2x_fluxes_to_rof) if (seq_comm_iamroot(ID)) then write(logunit,*) subname//': seq_flds_a2x_states= ',trim(seq_flds_a2x_states) @@ -3618,6 +3923,7 @@ subroutine seq_flds_set(nmlfile, ID, infodata) write(logunit,*) subname//': seq_flds_w2x_fluxes= ',trim(seq_flds_w2x_fluxes) write(logunit,*) subname//': seq_flds_x2w_states= ',trim(seq_flds_x2w_states) write(logunit,*) subname//': seq_flds_x2w_fluxes= ',trim(seq_flds_x2w_fluxes) + write(logunit,*) subname//': seq_flds_o2x_states_to_rof=',trim(seq_flds_o2x_states_to_rof) end if call catFields(seq_flds_dom_fields, seq_flds_dom_coord , seq_flds_dom_other ) @@ -3642,7 +3948,7 @@ subroutine seq_flds_set(nmlfile, ID, infodata) call catFields(seq_flds_x2r_fields, seq_flds_x2r_states, seq_flds_x2r_fluxes) call catFields(seq_flds_w2x_fields, seq_flds_w2x_states, seq_flds_w2x_fluxes) call catFields(seq_flds_x2w_fields, seq_flds_x2w_states, seq_flds_x2w_fluxes) - + call catFields(seq_flds_o2x_fields_to_rof, seq_flds_o2x_states_to_rof, seq_flds_o2x_fluxes_to_rof) ! form character(CXX) :: seq_flds_a2x_ext_states from seq_flds_a2x_states by adding _ext in each field ! first form a list call mct_list_init(temp_list ,seq_flds_a2x_fields) diff --git a/driver-moab/shr/seq_infodata_mod.F90 b/driver-moab/shr/seq_infodata_mod.F90 index 522030273bbe..962fd4d25ca8 100644 --- a/driver-moab/shr/seq_infodata_mod.F90 +++ b/driver-moab/shr/seq_infodata_mod.F90 @@ -111,6 +111,8 @@ MODULE seq_infodata_mod logical :: flux_albav ! T => no diurnal cycle in ocn albedos logical :: flux_diurnal ! T => diurnal cycle in atm/ocn fluxes integer :: ocn_surface_flux_scheme ! 0: E3SMv1 1: COARE 2: UA + character(SHR_KIND_CS) :: precip_downscaling_method !Precipitation downscaling method used + !in the land model(current possible options: ERMM (default), FNM) logical :: coldair_outbreak_mod ! (Mahrt & Sun 1995,MWR) real(SHR_KIND_R8) :: flux_convergence ! atmocn flux calc convergence value integer :: flux_max_iteration ! max number of iterations of atmocn flux loop @@ -132,6 +134,7 @@ MODULE seq_infodata_mod character(SHR_KIND_CL) :: cpl_seq_option ! coupler sequencing option logical :: do_budgets ! do heat/water budgets diagnostics + logical :: do_bgc_budgets ! do BGC budgets diagnostics logical :: do_histinit ! write out initial history file integer :: budget_inst ! instantaneous budget level integer :: budget_daily ! daily budget level @@ -188,6 +191,7 @@ MODULE seq_infodata_mod logical :: rof_present ! does rof component exist logical :: rofice_present ! does rof have iceberg coupling on logical :: rof_prognostic ! does rof component need input data + logical :: rofocn_prognostic ! does component need ocn data logical :: flood_present ! does rof have flooding on logical :: ocn_present ! does component model exist logical :: ocn_prognostic ! does component model need input data from driver @@ -383,6 +387,7 @@ SUBROUTINE seq_infodata_Init( infodata, nmlfile, ID, pioid, cpl_tag) character(SHR_KIND_CL) :: cpl_seq_option ! coupler sequencing option logical :: do_budgets ! do heat/water budgets diagnostics + logical :: do_bgc_budgets ! do BGC budgets diagnostics logical :: do_histinit ! write out initial history file integer :: budget_inst ! instantaneous budget level integer :: budget_daily ! daily budget level @@ -449,7 +454,7 @@ SUBROUTINE seq_infodata_Init( infodata, nmlfile, ID, pioid, cpl_tag) ice_gnam, rof_gnam, glc_gnam, wav_gnam, & atm_gnam, lnd_gnam, ocn_gnam, iac_gnam, cpl_decomp, & shr_map_dopole, vect_map, aoflux_grid, do_histinit, & - do_budgets, drv_threading, & + do_budgets, do_bgc_budgets, drv_threading, & budget_inst, budget_daily, budget_month, & budget_ann, budget_ltann, budget_ltend, & histaux_a2x,histaux_a2x1hri,histaux_a2x1hr, & @@ -543,6 +548,7 @@ SUBROUTINE seq_infodata_Init( infodata, nmlfile, ID, pioid, cpl_tag) cpl_decomp = 0 cpl_seq_option = 'CESM1_MOD' do_budgets = .false. + do_bgc_budgets = .false. do_histinit = .false. budget_inst = 0 budget_daily = 0 @@ -678,6 +684,7 @@ SUBROUTINE seq_infodata_Init( infodata, nmlfile, ID, pioid, cpl_tag) infodata%cpl_decomp = cpl_decomp infodata%cpl_seq_option = cpl_seq_option infodata%do_budgets = do_budgets + infodata%do_bgc_budgets = do_bgc_budgets infodata%do_histinit = do_histinit infodata%budget_inst = budget_inst infodata%budget_daily = budget_daily @@ -741,6 +748,7 @@ SUBROUTINE seq_infodata_Init( infodata, nmlfile, ID, pioid, cpl_tag) infodata%atm_prognostic = .false. infodata%lnd_prognostic = .false. infodata%rof_prognostic = .false. + infodata%rofocn_prognostic = .false. infodata%ocn_prognostic = .false. infodata%ocnrof_prognostic = .false. infodata%ocn_c2_glcshelf = .false. @@ -976,12 +984,13 @@ END SUBROUTINE seq_infodata_Init2 SUBROUTINE seq_infodata_GetData_explicit( infodata, cime_model, case_name, case_desc, timing_dir, & model_version, username, hostname, rest_case_name, tchkpt_dir, & start_type, restart_pfile, restart_file, perpetual, perpetual_ymd, & + precip_downscaling_method, & aqua_planet,aqua_planet_sst, brnch_retain_casename, & single_column, scmlat,scmlon,logFilePostFix, outPathRoot,& scm_multcols, scm_nx, scm_ny, & atm_present, atm_prognostic, & lnd_present, lnd_prognostic, & - rof_present, rof_prognostic, & + rof_present, rof_prognostic, rofocn_prognostic, & ocn_present, ocn_prognostic, ocnrof_prognostic, ocn_c2_glcshelf, & ice_present, ice_prognostic, & glc_present, glc_prognostic, & @@ -996,8 +1005,8 @@ SUBROUTINE seq_infodata_GetData_explicit( infodata, cime_model, case_name, case_ shr_map_dopole, vect_map, aoflux_grid, flux_epbalfact, & nextsw_cday, precip_fact, flux_epbal, flux_albav, & glc_g2lupdate, atm_aero, run_barriers, esmf_map_flag, & - do_budgets, do_histinit, drv_threading, flux_diurnal, & - ocn_surface_flux_scheme, & + do_budgets, do_bgc_budgets, do_histinit, drv_threading, & + flux_diurnal, ocn_surface_flux_scheme, & coldair_outbreak_mod, & flux_convergence, flux_max_iteration, & budget_inst, budget_daily, budget_month, wall_time_limit, & @@ -1054,6 +1063,8 @@ SUBROUTINE seq_infodata_GetData_explicit( infodata, cime_model, case_name, case_ character(len=*), optional, intent(OUT) :: outPathRoot ! output file root logical, optional, intent(OUT) :: perpetual ! If this is perpetual integer, optional, intent(OUT) :: perpetual_ymd ! If perpetual, date + character(len=*), optional, intent(OUT) :: precip_downscaling_method!precip downscaling method from the land model + !ERMM (default) or FNM character(len=*), optional, intent(OUT) :: orb_mode ! orbital mode integer, optional, intent(OUT) :: orb_iyear ! orbital year integer, optional, intent(OUT) :: orb_iyear_align ! orbital year model year align @@ -1093,6 +1104,7 @@ SUBROUTINE seq_infodata_GetData_explicit( infodata, cime_model, case_name, case_ integer, optional, intent(OUT) :: cpl_decomp ! coupler decomp character(len=*), optional, intent(OUT) :: cpl_seq_option ! coupler sequencing option logical, optional, intent(OUT) :: do_budgets ! heat/water budgets + logical, optional, intent(OUT) :: do_bgc_budgets ! BGC budgets logical, optional, intent(OUT) :: do_histinit ! initial history file integer, optional, intent(OUT) :: budget_inst ! inst budget integer, optional, intent(OUT) :: budget_daily ! daily budget @@ -1146,6 +1158,7 @@ SUBROUTINE seq_infodata_GetData_explicit( infodata, cime_model, case_name, case_ logical, optional, intent(OUT) :: rof_present logical, optional, intent(OUT) :: rofice_present logical, optional, intent(OUT) :: rof_prognostic + logical, optional, intent(OUT) :: rofocn_prognostic logical, optional, intent(OUT) :: flood_present logical, optional, intent(OUT) :: ocn_present logical, optional, intent(OUT) :: ocn_prognostic @@ -1234,6 +1247,7 @@ SUBROUTINE seq_infodata_GetData_explicit( infodata, cime_model, case_name, case_ if ( present(outPathRoot) ) outPathRoot = infodata%outPathRoot if ( present(perpetual) ) perpetual = infodata%perpetual if ( present(perpetual_ymd) ) perpetual_ymd = infodata%perpetual_ymd + if ( present(precip_downscaling_method)) precip_downscaling_method = infodata%precip_downscaling_method if ( present(orb_iyear) ) orb_iyear = infodata%orb_iyear if ( present(orb_iyear_align)) orb_iyear_align= infodata%orb_iyear_align if ( present(orb_mode) ) orb_mode = infodata%orb_mode @@ -1274,6 +1288,7 @@ SUBROUTINE seq_infodata_GetData_explicit( infodata, cime_model, case_name, case_ if ( present(cpl_decomp) ) cpl_decomp = infodata%cpl_decomp if ( present(cpl_seq_option) ) cpl_seq_option = infodata%cpl_seq_option if ( present(do_budgets) ) do_budgets = infodata%do_budgets + if ( present(do_bgc_budgets) ) do_bgc_budgets = infodata%do_bgc_budgets if ( present(do_histinit) ) do_histinit = infodata%do_histinit if ( present(budget_inst) ) budget_inst = infodata%budget_inst if ( present(budget_daily) ) budget_daily = infodata%budget_daily @@ -1327,6 +1342,7 @@ SUBROUTINE seq_infodata_GetData_explicit( infodata, cime_model, case_name, case_ if ( present(rof_present) ) rof_present = infodata%rof_present if ( present(rofice_present) ) rofice_present = infodata%rofice_present if ( present(rof_prognostic) ) rof_prognostic = infodata%rof_prognostic + if ( present(rofocn_prognostic) ) rofocn_prognostic = infodata%rofocn_prognostic if ( present(flood_present) ) flood_present = infodata%flood_present if ( present(ocn_present) ) ocn_present = infodata%ocn_present if ( present(ocn_prognostic) ) ocn_prognostic = infodata%ocn_prognostic @@ -1523,7 +1539,7 @@ SUBROUTINE seq_infodata_PutData_explicit( infodata, cime_model, case_name, case_ scm_multcols, scm_nx, scm_ny, & atm_present, atm_prognostic, & lnd_present, lnd_prognostic, & - rof_present, rof_prognostic, & + rof_present, rof_prognostic, rofocn_prognostic, & ocn_present, ocn_prognostic, ocnrof_prognostic, ocn_c2_glcshelf, & ice_present, ice_prognostic, & glc_present, glc_prognostic, & @@ -1538,9 +1554,10 @@ SUBROUTINE seq_infodata_PutData_explicit( infodata, cime_model, case_name, case_ shr_map_dopole, vect_map, aoflux_grid, run_barriers, & nextsw_cday, precip_fact, flux_epbal, flux_albav, & glc_g2lupdate, atm_aero, esmf_map_flag, wall_time_limit, & - do_budgets, do_histinit, drv_threading, flux_diurnal, & - ocn_surface_flux_scheme, & - coldair_outbreak_mod, & + do_budgets, do_bgc_budgets, do_histinit, drv_threading, & + flux_diurnal, precip_downscaling_method, & + ocn_surface_flux_scheme, & + coldair_outbreak_mod, & flux_convergence, flux_max_iteration, & budget_inst, budget_daily, budget_month, force_stop_at, & budget_ann, budget_ltann, budget_ltend , & @@ -1613,6 +1630,8 @@ SUBROUTINE seq_infodata_PutData_explicit( infodata, cime_model, case_name, case_ logical, optional, intent(IN) :: flux_albav ! T => no diurnal cycle in ocn albedos logical, optional, intent(IN) :: flux_diurnal ! T => diurnal cycle in atm/ocn flux integer, optional, intent(IN) :: ocn_surface_flux_scheme ! 0: E3SMv1 1: COARE 2:UA + character(len=*), optional, intent(IN) :: precip_downscaling_method!precip downscaling method from the land model + !ERMM (default) or FNM logical, optional, intent(in) :: coldair_outbreak_mod real(SHR_KIND_R8), optional, intent(IN) :: flux_convergence ! atmocn flux calc convergence value integer, optional, intent(IN) :: flux_max_iteration ! max number of iterations of atmocn flux loop @@ -1633,6 +1652,7 @@ SUBROUTINE seq_infodata_PutData_explicit( infodata, cime_model, case_name, case_ integer, optional, intent(IN) :: cpl_decomp ! coupler decomp character(len=*), optional, intent(IN) :: cpl_seq_option ! coupler sequencing option logical, optional, intent(IN) :: do_budgets ! heat/water budgets + logical, optional, intent(IN) :: do_bgc_budgets ! BGC budgets logical, optional, intent(IN) :: do_histinit ! initial history file integer, optional, intent(IN) :: budget_inst ! inst budget integer, optional, intent(IN) :: budget_daily ! daily budget @@ -1686,6 +1706,7 @@ SUBROUTINE seq_infodata_PutData_explicit( infodata, cime_model, case_name, case_ logical, optional, intent(IN) :: rof_present logical, optional, intent(IN) :: rofice_present logical, optional, intent(IN) :: rof_prognostic + logical, optional, intent(IN) :: rofocn_prognostic logical, optional, intent(IN) :: flood_present logical, optional, intent(IN) :: ocn_present logical, optional, intent(IN) :: ocn_prognostic @@ -1792,6 +1813,8 @@ SUBROUTINE seq_infodata_PutData_explicit( infodata, cime_model, case_name, case_ if ( present(flux_diurnal) ) infodata%flux_diurnal = flux_diurnal if ( present(ocn_surface_flux_scheme) ) infodata%ocn_surface_flux_scheme = & ocn_surface_flux_scheme + if ( present(precip_downscaling_method) ) infodata%precip_downscaling_method = & + precip_downscaling_method if ( present(coldair_outbreak_mod) ) infodata%coldair_outbreak_mod = coldair_outbreak_mod if ( present(flux_convergence)) infodata%flux_convergence = flux_convergence if ( present(flux_max_iteration)) infodata%flux_max_iteration = flux_max_iteration @@ -1812,6 +1835,7 @@ SUBROUTINE seq_infodata_PutData_explicit( infodata, cime_model, case_name, case_ if ( present(cpl_decomp) ) infodata%cpl_decomp = cpl_decomp if ( present(cpl_seq_option) ) infodata%cpl_seq_option = cpl_seq_option if ( present(do_budgets) ) infodata%do_budgets = do_budgets + if ( present(do_bgc_budgets) ) infodata%do_bgc_budgets = do_bgc_budgets if ( present(do_histinit) ) infodata%do_histinit = do_histinit if ( present(budget_inst) ) infodata%budget_inst = budget_inst if ( present(budget_daily) ) infodata%budget_daily = budget_daily @@ -1865,6 +1889,7 @@ SUBROUTINE seq_infodata_PutData_explicit( infodata, cime_model, case_name, case_ if ( present(rof_present) ) infodata%rof_present = rof_present if ( present(rofice_present) ) infodata%rofice_present = rofice_present if ( present(rof_prognostic) ) infodata%rof_prognostic = rof_prognostic + if ( present(rofocn_prognostic) ) infodata%rofocn_prognostic = rofocn_prognostic if ( present(flood_present) ) infodata%flood_present = flood_present if ( present(ocn_present) ) infodata%ocn_present = ocn_present if ( present(ocn_prognostic) ) infodata%ocn_prognostic = ocn_prognostic @@ -2095,6 +2120,7 @@ subroutine seq_infodata_bcast(infodata,mpicom) call shr_mpi_bcast(infodata%flux_albav, mpicom) call shr_mpi_bcast(infodata%flux_diurnal, mpicom) call shr_mpi_bcast(infodata%ocn_surface_flux_scheme, mpicom) + call shr_mpi_bcast(infodata%precip_downscaling_method, mpicom) call shr_mpi_bcast(infodata%coldair_outbreak_mod, mpicom) call shr_mpi_bcast(infodata%flux_convergence, mpicom) call shr_mpi_bcast(infodata%flux_max_iteration, mpicom) @@ -2115,6 +2141,7 @@ subroutine seq_infodata_bcast(infodata,mpicom) call shr_mpi_bcast(infodata%cpl_decomp, mpicom) call shr_mpi_bcast(infodata%cpl_seq_option, mpicom) call shr_mpi_bcast(infodata%do_budgets, mpicom) + call shr_mpi_bcast(infodata%do_bgc_budgets, mpicom) call shr_mpi_bcast(infodata%do_histinit, mpicom) call shr_mpi_bcast(infodata%budget_inst, mpicom) call shr_mpi_bcast(infodata%budget_daily, mpicom) @@ -2168,6 +2195,7 @@ subroutine seq_infodata_bcast(infodata,mpicom) call shr_mpi_bcast(infodata%rof_present, mpicom) call shr_mpi_bcast(infodata%rofice_present, mpicom) call shr_mpi_bcast(infodata%rof_prognostic, mpicom) + call shr_mpi_bcast(infodata%rofocn_prognostic, mpicom) call shr_mpi_bcast(infodata%flood_present, mpicom) call shr_mpi_bcast(infodata%ocn_present, mpicom) call shr_mpi_bcast(infodata%ocn_prognostic, mpicom) @@ -2444,6 +2472,7 @@ subroutine seq_infodata_Exchange(infodata,ID,type) call shr_mpi_bcast(infodata%rof_present, mpicom, pebcast=cmppe) call shr_mpi_bcast(infodata%rofice_present, mpicom, pebcast=cmppe) call shr_mpi_bcast(infodata%rof_prognostic, mpicom, pebcast=cmppe) + call shr_mpi_bcast(infodata%rofocn_prognostic, mpicom, pebcast=cmppe) call shr_mpi_bcast(infodata%rof_nx, mpicom, pebcast=cmppe) call shr_mpi_bcast(infodata%rof_ny, mpicom, pebcast=cmppe) call shr_mpi_bcast(infodata%flood_present, mpicom, pebcast=cmppe) @@ -2528,6 +2557,7 @@ subroutine seq_infodata_Exchange(infodata,ID,type) call shr_mpi_bcast(infodata%rof_present, mpicom, pebcast=cplpe) call shr_mpi_bcast(infodata%rofice_present, mpicom, pebcast=cplpe) call shr_mpi_bcast(infodata%rof_prognostic, mpicom, pebcast=cplpe) + call shr_mpi_bcast(infodata%rofocn_prognostic, mpicom, pebcast=cplpe) call shr_mpi_bcast(infodata%flood_present, mpicom, pebcast=cplpe) call shr_mpi_bcast(infodata%ocn_present, mpicom, pebcast=cplpe) call shr_mpi_bcast(infodata%ocn_prognostic, mpicom, pebcast=cplpe) @@ -2796,6 +2826,7 @@ SUBROUTINE seq_infodata_print( infodata ) write(logunit,F0L) subname,'flux_albav = ', infodata%flux_albav write(logunit,F0L) subname,'flux_diurnal = ', infodata%flux_diurnal write(logunit,F0L) subname,'ocn_surface_flux_scheme = ', infodata%ocn_surface_flux_scheme + write(logunit,F0A) subname,'precip_downscaling_method = ', infodata%precip_downscaling_method write(logunit,F0L) subname,'coldair_outbreak_mod = ', infodata%coldair_outbreak_mod write(logunit,F0R) subname,'flux_convergence = ', infodata%flux_convergence write(logunit,F0I) subname,'flux_max_iteration = ', infodata%flux_max_iteration @@ -2816,6 +2847,7 @@ SUBROUTINE seq_infodata_print( infodata ) write(logunit,F0A) subname,'cpl_seq_option = ', trim(infodata%cpl_seq_option) write(logunit,F0S) subname,'cpl_decomp = ', infodata%cpl_decomp write(logunit,F0L) subname,'do_budgets = ', infodata%do_budgets + write(logunit,F0L) subname,'do_bgc_budgets = ', infodata%do_bgc_budgets write(logunit,F0L) subname,'do_histinit = ', infodata%do_histinit write(logunit,F0S) subname,'budget_inst = ', infodata%budget_inst write(logunit,F0S) subname,'budget_daily = ', infodata%budget_daily @@ -2873,6 +2905,7 @@ SUBROUTINE seq_infodata_print( infodata ) write(logunit,F0L) subname,'rof_present = ', infodata%rof_present write(logunit,F0L) subname,'rofice_present = ', infodata%rofice_present write(logunit,F0L) subname,'rof_prognostic = ', infodata%rof_prognostic + write(logunit,F0L) subname,'rofocn_prognostic = ', infodata%rofocn_prognostic write(logunit,F0L) subname,'flood_present = ', infodata%flood_present write(logunit,F0L) subname,'ocn_present = ', infodata%ocn_present write(logunit,F0L) subname,'ocn_prognostic = ', infodata%ocn_prognostic diff --git a/externals/kokkos b/externals/kokkos index 8d62288677f9..290a073f38c0 160000 --- a/externals/kokkos +++ b/externals/kokkos @@ -1 +1 @@ -Subproject commit 8d62288677f9f7ed20d0e6a15009f0d9087e3170 +Subproject commit 290a073f38c024ba37113716d7ed4ac921f3db85 diff --git a/externals/scorpio b/externals/scorpio index 1fad001f88eb..7a1a1b3d6333 160000 --- a/externals/scorpio +++ b/externals/scorpio @@ -1 +1 @@ -Subproject commit 1fad001f88eba49aac2d1838869515b6eead0691 +Subproject commit 7a1a1b3d63338a3d0e8518aa2bf01d8f59d15be9 From 4a4a32bee925c18db53cc6019e680beccb81ff27 Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Thu, 15 Dec 2022 13:18:43 -0600 Subject: [PATCH 218/467] define a2x_fields on coupler side how does export work for this ? --- driver-moab/main/cplcomp_exchange_mod.F90 | 19 +++++++----- driver-moab/main/prep_atm_mod.F90 | 37 +++++++++++++++++++++-- 2 files changed, 46 insertions(+), 10 deletions(-) diff --git a/driver-moab/main/cplcomp_exchange_mod.F90 b/driver-moab/main/cplcomp_exchange_mod.F90 index cb69421fb106..a6ab05da8e22 100644 --- a/driver-moab/main/cplcomp_exchange_mod.F90 +++ b/driver-moab/main/cplcomp_exchange_mod.F90 @@ -9,7 +9,7 @@ module cplcomp_exchange_mod use seq_map_type_mod use component_type_mod use seq_flds_mod, only: seq_flds_dom_coord, seq_flds_dom_other - use seq_flds_mod, only: seq_flds_a2x_ext_fields ! + use seq_flds_mod, only: seq_flds_a2x_ext_fields, seq_flds_a2x_fields ! use seq_flds_mod, only: seq_flds_o2x_fields ! needed for MOAB init of ocean fields o2x to be able to transfer to coupler use seq_flds_mod, only: seq_flds_x2o_fields ! needed for MOAB init of ocean fields x2o to be able to transfer from coupler use seq_flds_mod, only: seq_flds_i2x_fields ! needed for MOAB init of ice fields x2o on coupler side, to save them @@ -1138,17 +1138,20 @@ subroutine cplcomp_moab_Init(comp) typeA, typeB, ATM_PHYS_CID, id_join) ! ID_JOIN is now 6 ! comment out this above part - ! we also need to define the tags for receiving the physics data, on atm on coupler pes - ! corresponding to 'T_ph;u_ph;v_ph'; ! we can receive those tags only on coupler pes, when mbaxid exists ! we have to check that before we can define the tag - if (mbaxid .ge. 0 .and. .not. (atm_pg_active) ) then - tagname = trim(seq_flds_a2x_ext_fields)//C_NULL_CHAR - tagtype = 1 ! dense, double - numco = np*np ! usually 16 values per cell, GLL points; should be 4 x 4 = 16 + if (mbaxid .ge. 0 ) then + tagtype = 1 ! dense, double + if (atm_pg_active) then + tagname = trim(seq_flds_a2x_fields)//C_NULL_CHAR + numco = 1 ! usually 1 value per cell + else ! this is not supported now, but leave it here + tagname = trim(seq_flds_a2x_ext_fields)//C_NULL_CHAR + numco = np*np ! usually 16 values per cell, GLL points; should be 4 x 4 = 16 + endif ierr = iMOAB_DefineTagStorage(mbaxid, tagname, tagtype, numco, tagindex ) if (ierr .ne. 0) then - write(logunit,*) subname,' error in defining tags ' + write(logunit,*) subname,' error in defining tags on atm on coupler ' call shr_sys_abort(subname//' ERROR in defining tags ') endif endif diff --git a/driver-moab/main/prep_atm_mod.F90 b/driver-moab/main/prep_atm_mod.F90 index 2f0d74a49d02..eedd361ad999 100644 --- a/driver-moab/main/prep_atm_mod.F90 +++ b/driver-moab/main/prep_atm_mod.F90 @@ -329,6 +329,22 @@ subroutine prep_atm_init(infodata, ocn_c2_atm, ice_c2_atm, lnd_c2_atm, iac_c2_at call seq_map_init_rcfile(mapper_Fo2a, ocn(1), atm(1), & 'seq_maps.rc','ocn2atm_fmapname:','ocn2atm_fmaptype:',samegrid_ao, & 'mapper_Fo2a initialization',esmf_map_flag) +! copy mapper_So2a , maybe change the matrix ? still based on intersection ? +#ifdef HAVE_MOAB + ! Call moab intx only if atm and ocn are init in moab + if ((mbaxid .ge. 0) .and. (mboxid .ge. 0)) then + ! now take care of the mapper + mapper_Fo2a%src_mbid = mboxid + mapper_Fo2a%tgt_mbid = mbaxid + mapper_Fo2a%intx_mbid = mbintxoa + mapper_Fo2a%src_context = ocn(1)%cplcompid + mapper_Fo2a%intx_context = idintx + wgtIdef = 'scalar'//C_NULL_CHAR + mapper_Fo2a%weight_identifier = wgtIdef + endif +! endif for HAVE_MOAB +#endif + endif call shr_sys_flush(logunit) @@ -1205,7 +1221,9 @@ subroutine prep_atm_calc_o2x_ax(fractions_ox, timer) !--------------------------------------------------------------- ! Description ! Create o2x_ax (note that o2x_ax is a local module variable) - ! +#ifdef MOABDEBUG + use iMOAB, only : iMOAB_WriteMesh +#endif ! Arguments type(mct_aVect) , optional, intent(in) :: fractions_ox(:) character(len=*), optional, intent(in) :: timer @@ -1215,8 +1233,11 @@ subroutine prep_atm_calc_o2x_ax(fractions_ox, timer) type(mct_aVect) , pointer :: o2x_ox character(*), parameter :: subname = '(prep_atm_calc_o2x_ax)' character(*), parameter :: F00 = "('"//subname//" : ', 4A )" +#ifdef MOABDEBUG + character*50 :: outfile, wopts, lnum + integer :: ierr +#endif !--------------------------------------------------------------- - call t_drvstartf (trim(timer),barrier=mpicom_CPLID) do emi = 1,num_inst_max eoi = mod((emi-1),num_inst_ocn) + 1 @@ -1233,6 +1254,18 @@ subroutine prep_atm_calc_o2x_ax(fractions_ox, timer) endif call seq_map_map(mapper_Fo2a, o2x_ox, o2x_ax(emi),& fldlist=seq_flds_o2x_fluxes,norm=.true.) + +#ifdef MOABDEBUG + ! projection of atm to ocean fields + write(lnum,"(I0.2)")num_moab_exports + outfile = 'Ocn2Atm'//trim(lnum)//'.h5m'//C_NULL_CHAR + wopts = ';PARALLEL=WRITE_PART'//C_NULL_CHAR ! + ierr = iMOAB_WriteMesh(mbaxid, trim(outfile), trim(wopts)) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in writing ocean to atm projection' + call shr_sys_abort(subname//' ERROR in writing ocean to atm projection') + endif +#endif enddo call t_drvstopf (trim(timer)) From a4c63d03a3f8169d5558fc3ba6e06682041eb6ae Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Thu, 15 Dec 2022 15:31:50 -0600 Subject: [PATCH 219/467] add ice - atm projection --- driver-moab/main/prep_atm_mod.F90 | 136 +++++++++++++++++++++++++++++- driver-moab/shr/seq_comm_mct.F90 | 2 + 2 files changed, 134 insertions(+), 4 deletions(-) diff --git a/driver-moab/main/prep_atm_mod.F90 b/driver-moab/main/prep_atm_mod.F90 index eedd361ad999..2e69f889a755 100644 --- a/driver-moab/main/prep_atm_mod.F90 +++ b/driver-moab/main/prep_atm_mod.F90 @@ -24,6 +24,8 @@ module prep_atm_mod use seq_comm_mct, only : mboxid ! iMOAB id for mpas ocean migrated mesh to coupler pes use seq_comm_mct, only : mbintxoa ! iMOAB id for intx mesh between ocean and atmosphere use seq_comm_mct, only : mbintxao ! iMOAB id for intx mesh between atm and ocean + use seq_comm_mct, only : mbixid ! iMOAB id for mpas ice migrated mesh to coupler pes + use seq_comm_mct, only : mbintxia ! iMOAB id for intx mesh between ice and atm use seq_comm_mct, only : mhid ! iMOAB id for atm instance use seq_comm_mct, only : mhpgid ! iMOAB id for atm pgx grid, on atm pes; created with se and gll grids use seq_comm_mct, only : atm_pg_active ! whether the atm uses FV mesh or not ; made true if fv_nphys > 0 @@ -317,8 +319,8 @@ subroutine prep_atm_init(infodata, ocn_c2_atm, ice_c2_atm, lnd_c2_atm, iac_c2_at #endif ! endif for HAVE_MOAB #endif - end if - end if + end if ! if ((mbaxid .ge. 0) .and. (mboxid .ge. 0)) then + end if ! if (ocn_c2_atm) then ! needed for domain checking if (ocn_present) then @@ -345,7 +347,7 @@ subroutine prep_atm_init(infodata, ocn_c2_atm, ice_c2_atm, lnd_c2_atm, iac_c2_at ! endif for HAVE_MOAB #endif - endif + endif ! end if (ocn_present) then call shr_sys_flush(logunit) if (ice_c2_atm) then @@ -356,7 +358,121 @@ subroutine prep_atm_init(infodata, ocn_c2_atm, ice_c2_atm, lnd_c2_atm, iac_c2_at call seq_map_init_rcfile(mapper_Si2a, ice(1), atm(1), & 'seq_maps.rc','ice2atm_smapname:','ice2atm_smaptype:',samegrid_ao, & 'mapper_Si2a initialization',esmf_map_flag) - end if + ! similar to ocn-atm mapping, do ice 2 atm mapping / set up + +#ifdef HAVE_MOAB + ! Call moab intx only if atm and ice are init in moab coupler + if ((mbaxid .ge. 0) .and. (mbixid .ge. 0)) then + appname = "ICE_ATM_COU"//C_NULL_CHAR + ! idintx is a unique number of MOAB app that takes care of intx between ice and atm mesh + idintx = 100*ice(1)%cplcompid + atm(1)%cplcompid ! something different, to differentiate it + ierr = iMOAB_RegisterApplication(trim(appname), mpicom_CPLID, idintx, mbintxia) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in registering ice atm intx' + call shr_sys_abort(subname//' ERROR in registering ice atm intx') + endif + ierr = iMOAB_ComputeMeshIntersectionOnSphere (mbixid, mbaxid, mbintxia) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in computing ice atm intx' + call shr_sys_abort(subname//' ERROR in computing ice atm intx') + endif + if (iamroot_CPLID) then + write(logunit,*) 'iMOAB intersection between ice and atm with id:', idintx + end if + + + ! we also need to compute the comm graph for the second hop, from the ice on coupler to the + ! ice for the intx ice-atm context (coverage) + ! + call seq_comm_getinfo(CPLID ,mpigrp=mpigrp_CPLID) + type1 = 3; ! fv for ice and atm; fv-cgll does not work anyway + type2 = 3; + ! ierr = iMOAB_ComputeCommGraph( mboxid, mbintxoa, &mpicom_CPLID, &mpigrp_CPLID, &mpigrp_CPLID, &type1, &type2, + ! &ocn_id, &idintx) + ierr = iMOAB_ComputeCommGraph( mbixid, mbintxia, mpicom_CPLID, mpigrp_CPLID, mpigrp_CPLID, type1, type2, & + ice(1)%cplcompid, idintx) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in computing comm graph for second hop, ice-atm' + call shr_sys_abort(subname//' ERROR in computing comm graph for second hop, ice-atm') + endif + ! now take care of the mapper + mapper_Si2a%src_mbid = mbixid + mapper_Si2a%tgt_mbid = mbaxid + mapper_Si2a%intx_mbid = mbintxia + mapper_Si2a%src_context = ice(1)%cplcompid + mapper_Si2a%intx_context = idintx + wgtIdef = 'scalar'//C_NULL_CHAR + mapper_Si2a%weight_identifier = wgtIdef + ! because we will project fields from ocean to atm phys grid, we need to define + ! ice i2x fields to atm phys grid (or atm spectral ext ) on coupler side + if (atm_pg_active) then + tagname = trim(seq_flds_i2x_fields)//C_NULL_CHAR + tagtype = 1 ! dense + numco = 1 ! + ierr = iMOAB_DefineTagStorage(mbixid, tagname, tagtype, numco, tagindex ) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in defining tags for seq_flds_i2x_fields' + call shr_sys_abort(subname//' ERROR in coin defining tags for seq_flds_i2x_fields') + endif + else ! spectral case, fix later + tagtype = 1 ! dense + endif + + volumetric = 0 ! can be 1 only for FV->DGLL or FV->CGLL; + + if (atm_pg_active) then + dm2 = "fv"//C_NULL_CHAR + dofnameT="GLOBAL_ID"//C_NULL_CHAR + orderT = 1 ! fv-fv + else + dm2 = "cgll"//C_NULL_CHAR + dofnameT="GLOBAL_DOFS"//C_NULL_CHAR + orderT = np ! it should be 4 + endif + dm1 = "fv"//C_NULL_CHAR + dofnameS="GLOBAL_ID"//C_NULL_CHAR + orderS = 1 ! not much arguing + fNoBubble = 1 + monotonicity = 0 ! + noConserve = 0 + validate = 1 + fInverseDistanceMap = 0 + if (iamroot_CPLID) then + write(logunit,*) subname, 'launch iMOAB weights with args ', 'mbintxia=', mbintxia, ' wgtIdef=', wgtIdef, & + 'dm1=', trim(dm1), ' orderS=', orderS, 'dm2=', trim(dm2), ' orderT=', orderT, & + fNoBubble, monotonicity, volumetric, fInverseDistanceMap, & + noConserve, validate, & + trim(dofnameS), trim(dofnameT) + end if + ierr = iMOAB_ComputeScalarProjectionWeights ( mbintxia, wgtIdef, & + trim(dm1), orderS, trim(dm2), orderT, & + fNoBubble, monotonicity, volumetric, fInverseDistanceMap, & + noConserve, validate, & + trim(dofnameS), trim(dofnameT) ) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in computing ' + call shr_sys_abort(subname//' ERROR in writing intx file ') + endif + + +#ifdef MOABDEBUG + wopts = C_NULL_CHAR + call shr_mpi_commrank( mpicom_CPLID, rank ) + if (rank .lt. 3) then + write(lnum,"(I0.2)")rank ! + outfile = 'intx_ia_'//trim(lnum)// '.h5m' // C_NULL_CHAR + ierr = iMOAB_WriteMesh(mbintxia, outfile, wopts) ! write local intx file + if (ierr .ne. 0) then + write(logunit,*) subname,' error in writing intx file ice-atm ' + call shr_sys_abort(subname//' ERROR in writing intx file ice-atm ') + endif + endif +! endif for MOABDEBUG +#endif +! endif for HAVE_MOAB +#endif + endif ! if ((mbaxid .ge. 0) .and. (mbixid .ge. 0)) then + endif ! if (ice_c2_atm) then ! needed for domain checking if (ice_present) then @@ -367,6 +483,17 @@ subroutine prep_atm_init(infodata, ocn_c2_atm, ice_c2_atm, lnd_c2_atm, iac_c2_at call seq_map_init_rcfile(mapper_Fi2a, ice(1), atm(1), & 'seq_maps.rc','ice2atm_fmapname:','ice2atm_fmaptype:',samegrid_ao, & 'mapper_Fi2a initialization',esmf_map_flag) + +#ifdef HAVE_MOAB + ! now take care of the mapper for MOAB + mapper_Fi2a%src_mbid = mbixid + mapper_Fi2a%tgt_mbid = mbaxid + mapper_Fi2a%intx_mbid = mbintxia + mapper_Fi2a%src_context = ice(1)%cplcompid + mapper_Fi2a%intx_context = idintx + wgtIdef = 'scalar'//C_NULL_CHAR + mapper_Fi2a%weight_identifier = wgtIdef +#endif endif call shr_sys_flush(logunit) @@ -393,6 +520,7 @@ subroutine prep_atm_init(infodata, ocn_c2_atm, ice_c2_atm, lnd_c2_atm, iac_c2_at ! important change: do not compute intx at all between atm and land when we have samegrid_al ! we will use just a comm graph to send data from phys grid to land on coupler + ! this is just a rearrange in a way if ((mbaxid .ge. 0) .and. (mblxid .ge. 0) .and. .not. samegrid_al ) then appname = "ATM_LND_COU"//C_NULL_CHAR ! idintx is a unique number of MOAB app that takes care of intx between lnd and atm mesh diff --git a/driver-moab/shr/seq_comm_mct.F90 b/driver-moab/shr/seq_comm_mct.F90 index eb5e39017208..15e60e044547 100644 --- a/driver-moab/shr/seq_comm_mct.F90 +++ b/driver-moab/shr/seq_comm_mct.F90 @@ -229,6 +229,7 @@ module seq_comm_mct integer, public :: mbintxla ! iMOAB id for intx mesh between land and atmosphere integer, public :: mpsiid ! iMOAB id for sea-ice, mpas model integer, public :: mbixid ! iMOAB id for sea-ice migrated to coupler pes + integer, public :: mbintxia ! iMOAB id for intx mesh between ice and atmosphere integer, public :: mrofid ! iMOAB id of moab rof app integer, public :: mbrxid ! iMOAB id of moab rof migrated to coupler pes integer, public :: mbrmapro ! iMOAB id for read map between river and ocean; it exists on coupler PEs @@ -638,6 +639,7 @@ subroutine seq_comm_init(global_comm_in, driver_comm_in, nmlfile, drv_comm_id) mbintxla = -1 ! iMOAB id for land intx with atm on coupler pes mpsiid = -1 ! iMOAB for sea-ice mbixid = -1 ! iMOAB for sea-ice migrated to coupler + mbintxia = -1 ! iMOAB id for ice intx with atm on coupler pes mrofid = -1 ! iMOAB id of moab rof app mbrxid = -1 ! iMOAB id of moab rof migrated to coupler mbrmapro = -1 ! iMOAB id of moab instance of map read from rof2ocn map file From a516e9f89984c28399ffa8b462d125bf4ca1f042 Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Fri, 16 Dec 2022 09:31:16 -0600 Subject: [PATCH 220/467] add land - atm moab map --- driver-moab/main/prep_atm_mod.F90 | 558 ++++++++++++++++-------------- 1 file changed, 305 insertions(+), 253 deletions(-) diff --git a/driver-moab/main/prep_atm_mod.F90 b/driver-moab/main/prep_atm_mod.F90 index 2e69f889a755..aaaa68004c4f 100644 --- a/driver-moab/main/prep_atm_mod.F90 +++ b/driver-moab/main/prep_atm_mod.F90 @@ -106,111 +106,111 @@ module prep_atm_mod subroutine prep_atm_init(infodata, ocn_c2_atm, ice_c2_atm, lnd_c2_atm, iac_c2_atm) - use iMOAB, only: iMOAB_ComputeMeshIntersectionOnSphere, iMOAB_RegisterApplication, & - iMOAB_WriteMesh , iMOAB_ComputeCommGraph, iMOAB_ComputeScalarProjectionWeights, & - iMOAB_DefineTagStorage - !--------------------------------------------------------------- - ! Description - ! Initialize module attribute vectors and mappers - ! - ! Arguments - type (seq_infodata_type) , intent(inout) :: infodata - logical , intent(in) :: ocn_c2_atm ! .true. => ocn to atm coupling on - logical , intent(in) :: ice_c2_atm ! .true. => ice to atm coupling on - logical , intent(in) :: lnd_c2_atm ! .true. => lnd to atm coupling on - logical , intent(in) :: iac_c2_atm ! .true. => iac to atm coupling on - ! - ! Local Variables - integer :: lsize_a - integer :: eli, eii, emi - logical :: samegrid_ao ! samegrid atm and ocean - logical :: samegrid_al ! samegrid atm and land - logical :: esmf_map_flag ! .true. => use esmf for mapping - logical :: atm_present ! .true. => atm is present - logical :: ocn_present ! .true. => ocn is present - logical :: ice_present ! .true. => ice is present - logical :: lnd_present ! .true. => lnd is prsent - character(CL) :: ocn_gnam ! ocn grid - character(CL) :: atm_gnam ! atm grid - character(CL) :: lnd_gnam ! lnd grid - type(mct_avect), pointer :: a2x_ax - character(*), parameter :: subname = '(prep_atm_init)' - character(*), parameter :: F00 = "('"//subname//" : ', 4A )" - integer ierr, idintx, rank - character*32 :: appname, outfile, wopts, lnum - - ! MOAB stuff - character*32 :: dm1, dm2, dofnameS, dofnameT, wgtIdef - integer :: orderS, orderT, volumetric, noConserve, validate, fInverseDistanceMap - integer :: fNoBubble, monotonicity - ! will do comm graph over coupler PES, in 2-hop strategy - integer :: mpigrp_CPLID ! coupler pes group, used for comm graph phys <-> atm-ocn - - integer :: type1, type2 ! type for computing graph; should be the same type for ocean, 3 (FV) - integer :: tagtype, numco, tagindex - character(CXX) :: tagName - - !--------------------------------------------------------------- - - - call seq_infodata_getData(infodata, & - atm_present=atm_present, & - ocn_present=ocn_present, & - ice_present=ice_present, & - lnd_present=lnd_present, & - atm_gnam=atm_gnam, & - ocn_gnam=ocn_gnam, & - lnd_gnam=lnd_gnam, & - esmf_map_flag=esmf_map_flag) - - allocate(mapper_So2a) - allocate(mapper_Sl2a) - allocate(mapper_Si2a) - allocate(mapper_Fo2a) - allocate(mapper_Fl2a) - allocate(mapper_Fi2a) - - if (atm_present) then - - call seq_comm_getData(CPLID, & - mpicom=mpicom_CPLID, iamroot=iamroot_CPLID) - - a2x_ax => component_get_c2x_cx(atm(1)) - lsize_a = mct_aVect_lsize(a2x_ax) - - allocate(l2x_ax(num_inst_lnd)) - do eli = 1,num_inst_lnd - call mct_aVect_init(l2x_ax(eli), rList=seq_flds_l2x_fields, lsize=lsize_a) - call mct_aVect_zero(l2x_ax(eli)) - end do - allocate(o2x_ax(num_inst_max)) - do emi = 1,num_inst_max - call mct_aVect_init(o2x_ax(emi), rList=seq_flds_o2x_fields, lsize=lsize_a) - call mct_aVect_zero(o2x_ax(emi)) - enddo - allocate(i2x_ax(num_inst_ice)) - do eii = 1,num_inst_ice - call mct_aVect_init(i2x_ax(eii), rList=seq_flds_i2x_fields, lsize=lsize_a) - call mct_aVect_zero(i2x_ax(eii)) - enddo + use iMOAB, only: iMOAB_ComputeMeshIntersectionOnSphere, iMOAB_RegisterApplication, & + iMOAB_WriteMesh , iMOAB_ComputeCommGraph, iMOAB_ComputeScalarProjectionWeights, & + iMOAB_DefineTagStorage + !--------------------------------------------------------------- + ! Description + ! Initialize module attribute vectors and mappers + ! + ! Arguments + type (seq_infodata_type) , intent(inout) :: infodata + logical , intent(in) :: ocn_c2_atm ! .true. => ocn to atm coupling on + logical , intent(in) :: ice_c2_atm ! .true. => ice to atm coupling on + logical , intent(in) :: lnd_c2_atm ! .true. => lnd to atm coupling on + logical , intent(in) :: iac_c2_atm ! .true. => iac to atm coupling on + ! + ! Local Variables + integer :: lsize_a + integer :: eli, eii, emi + logical :: samegrid_ao ! samegrid atm and ocean + logical :: samegrid_al ! samegrid atm and land + logical :: esmf_map_flag ! .true. => use esmf for mapping + logical :: atm_present ! .true. => atm is present + logical :: ocn_present ! .true. => ocn is present + logical :: ice_present ! .true. => ice is present + logical :: lnd_present ! .true. => lnd is prsent + character(CL) :: ocn_gnam ! ocn grid + character(CL) :: atm_gnam ! atm grid + character(CL) :: lnd_gnam ! lnd grid + type(mct_avect), pointer :: a2x_ax + character(*), parameter :: subname = '(prep_atm_init)' + character(*), parameter :: F00 = "('"//subname//" : ', 4A )" + integer ierr, idintx, rank + character*32 :: appname, outfile, wopts, lnum + + ! MOAB stuff + character*32 :: dm1, dm2, dofnameS, dofnameT, wgtIdef + integer :: orderS, orderT, volumetric, noConserve, validate, fInverseDistanceMap + integer :: fNoBubble, monotonicity +! will do comm graph over coupler PES, in 2-hop strategy + integer :: mpigrp_CPLID ! coupler pes group, used for comm graph phys <-> atm-ocn + + integer :: type1, type2 ! type for computing graph; should be the same type for ocean, 3 (FV) + integer :: tagtype, numco, tagindex + character(CXX) :: tagName + + !--------------------------------------------------------------- + + + call seq_infodata_getData(infodata, & + atm_present=atm_present, & + ocn_present=ocn_present, & + ice_present=ice_present, & + lnd_present=lnd_present, & + atm_gnam=atm_gnam, & + ocn_gnam=ocn_gnam, & + lnd_gnam=lnd_gnam, & + esmf_map_flag=esmf_map_flag) + + allocate(mapper_So2a) + allocate(mapper_Sl2a) + allocate(mapper_Si2a) + allocate(mapper_Fo2a) + allocate(mapper_Fl2a) + allocate(mapper_Fi2a) + + if (atm_present) then + + call seq_comm_getData(CPLID, & + mpicom=mpicom_CPLID, iamroot=iamroot_CPLID) + + a2x_ax => component_get_c2x_cx(atm(1)) + lsize_a = mct_aVect_lsize(a2x_ax) + + allocate(l2x_ax(num_inst_lnd)) + do eli = 1,num_inst_lnd + call mct_aVect_init(l2x_ax(eli), rList=seq_flds_l2x_fields, lsize=lsize_a) + call mct_aVect_zero(l2x_ax(eli)) + end do + allocate(o2x_ax(num_inst_max)) + do emi = 1,num_inst_max + call mct_aVect_init(o2x_ax(emi), rList=seq_flds_o2x_fields, lsize=lsize_a) + call mct_aVect_zero(o2x_ax(emi)) + enddo + allocate(i2x_ax(num_inst_ice)) + do eii = 1,num_inst_ice + call mct_aVect_init(i2x_ax(eii), rList=seq_flds_i2x_fields, lsize=lsize_a) + call mct_aVect_zero(i2x_ax(eii)) + enddo - samegrid_al = .true. - samegrid_ao = .true. - if (trim(atm_gnam) /= trim(lnd_gnam)) samegrid_al = .false. - if (trim(atm_gnam) /= trim(ocn_gnam)) samegrid_ao = .false. + samegrid_al = .true. + samegrid_ao = .true. + if (trim(atm_gnam) /= trim(lnd_gnam)) samegrid_al = .false. + if (trim(atm_gnam) /= trim(ocn_gnam)) samegrid_ao = .false. - if (ocn_c2_atm) then - if (iamroot_CPLID) then - write(logunit,*) ' ' - write(logunit,F00) 'Initializing mapper_So2a' - end if - call seq_map_init_rcfile(mapper_So2a, ocn(1), atm(1), & - 'seq_maps.rc','ocn2atm_smapname:','ocn2atm_smaptype:',samegrid_ao, & - 'mapper_So2a initialization',esmf_map_flag) + if (ocn_c2_atm) then + if (iamroot_CPLID) then + write(logunit,*) ' ' + write(logunit,F00) 'Initializing mapper_So2a' + endif + call seq_map_init_rcfile(mapper_So2a, ocn(1), atm(1), & + 'seq_maps.rc','ocn2atm_smapname:','ocn2atm_smaptype:',samegrid_ao, & + 'mapper_So2a initialization',esmf_map_flag) #ifdef HAVE_MOAB - ! Call moab intx only if atm and ocn are init in moab - if ((mbaxid .ge. 0) .and. (mboxid .ge. 0)) then + ! Call moab intx only if atm and ocn are init in moab + if ((mbaxid .ge. 0) .and. (mboxid .ge. 0)) then appname = "OCN_ATM_COU"//C_NULL_CHAR ! idintx is a unique number of MOAB app that takes care of intx between atm and ocn mesh idintx = 100*ocn(1)%cplcompid + atm(1)%cplcompid ! something different, to differentiate it @@ -226,7 +226,7 @@ subroutine prep_atm_init(infodata, ocn_c2_atm, ice_c2_atm, lnd_c2_atm, iac_c2_at endif if (iamroot_CPLID) then write(logunit,*) 'iMOAB intersection between ocean and atm with id:', idintx - end if + endif ! we also need to compute the comm graph for the second hop, from the ocn on coupler to the @@ -262,9 +262,9 @@ subroutine prep_atm_init(infodata, ocn_c2_atm, ice_c2_atm, lnd_c2_atm, iac_c2_at write(logunit,*) subname,' error in defining tags for seq_flds_o2x_fields' call shr_sys_abort(subname//' ERROR in coin defining tags for seq_flds_o2x_fields') endif - else ! spectral case, fix later - - endif + else ! spectral case, fix later TODO + numco = np*np ! + endif ! volumetric = 0 ! can be 1 only for FV->DGLL or FV->CGLL; @@ -291,7 +291,7 @@ subroutine prep_atm_init(infodata, ocn_c2_atm, ice_c2_atm, lnd_c2_atm, iac_c2_at fNoBubble, monotonicity, volumetric, fInverseDistanceMap, & noConserve, validate, & trim(dofnameS), trim(dofnameT) - end if + endif ierr = iMOAB_ComputeScalarProjectionWeights ( mbintxoa, wgtIdef, & trim(dm1), orderS, trim(dm2), orderT, & fNoBubble, monotonicity, volumetric, fInverseDistanceMap, & @@ -306,7 +306,7 @@ subroutine prep_atm_init(infodata, ocn_c2_atm, ice_c2_atm, lnd_c2_atm, iac_c2_at #ifdef MOABDEBUG wopts = C_NULL_CHAR call shr_mpi_commrank( mpicom_CPLID, rank ) - if (rank .lt. 5) then + if (rank .lt. 3) then write(lnum,"(I0.2)")rank ! outfile = 'intx_oa_'//trim(lnum)// '.h5m' // C_NULL_CHAR ierr = iMOAB_WriteMesh(mbintxoa, outfile, wopts) ! write local intx file @@ -317,24 +317,24 @@ subroutine prep_atm_init(infodata, ocn_c2_atm, ice_c2_atm, lnd_c2_atm, iac_c2_at endif ! endif for MOABDEBUG #endif + endif ! if ((mbaxid .ge. 0) .and. (mboxid .ge. 0)) then ! endif for HAVE_MOAB #endif - end if ! if ((mbaxid .ge. 0) .and. (mboxid .ge. 0)) then - end if ! if (ocn_c2_atm) then - - ! needed for domain checking - if (ocn_present) then - if (iamroot_CPLID) then - write(logunit,*) ' ' - write(logunit,F00) 'Initializing mapper_Fo2a' - end if - call seq_map_init_rcfile(mapper_Fo2a, ocn(1), atm(1), & - 'seq_maps.rc','ocn2atm_fmapname:','ocn2atm_fmaptype:',samegrid_ao, & - 'mapper_Fo2a initialization',esmf_map_flag) + + endif ! if (ocn_c2_atm) then + + ! needed for domain checking + if (ocn_present) then + if (iamroot_CPLID) then + write(logunit,*) ' ' + write(logunit,F00) 'Initializing mapper_Fo2a' + endif + call seq_map_init_rcfile(mapper_Fo2a, ocn(1), atm(1), & + 'seq_maps.rc','ocn2atm_fmapname:','ocn2atm_fmaptype:',samegrid_ao, & + 'mapper_Fo2a initialization',esmf_map_flag) ! copy mapper_So2a , maybe change the matrix ? still based on intersection ? #ifdef HAVE_MOAB - ! Call moab intx only if atm and ocn are init in moab - if ((mbaxid .ge. 0) .and. (mboxid .ge. 0)) then + if ((mbaxid .ge. 0) .and. (mboxid .ge. 0)) then ! now take care of the mapper mapper_Fo2a%src_mbid = mboxid mapper_Fo2a%tgt_mbid = mbaxid @@ -343,26 +343,26 @@ subroutine prep_atm_init(infodata, ocn_c2_atm, ice_c2_atm, lnd_c2_atm, iac_c2_at mapper_Fo2a%intx_context = idintx wgtIdef = 'scalar'//C_NULL_CHAR mapper_Fo2a%weight_identifier = wgtIdef - endif + endif ! endif for HAVE_MOAB #endif - endif ! end if (ocn_present) then - call shr_sys_flush(logunit) + endif ! endif (ocn_present) then + call shr_sys_flush(logunit) - if (ice_c2_atm) then - if (iamroot_CPLID) then - write(logunit,*) ' ' - write(logunit,F00) 'Initializing mapper_Si2a' - end if - call seq_map_init_rcfile(mapper_Si2a, ice(1), atm(1), & - 'seq_maps.rc','ice2atm_smapname:','ice2atm_smaptype:',samegrid_ao, & - 'mapper_Si2a initialization',esmf_map_flag) - ! similar to ocn-atm mapping, do ice 2 atm mapping / set up + if (ice_c2_atm) then + if (iamroot_CPLID) then + write(logunit,*) ' ' + write(logunit,F00) 'Initializing mapper_Si2a' + endif + call seq_map_init_rcfile(mapper_Si2a, ice(1), atm(1), & + 'seq_maps.rc','ice2atm_smapname:','ice2atm_smaptype:',samegrid_ao, & + 'mapper_Si2a initialization',esmf_map_flag) + ! similar to ocn-atm mapping, do ice 2 atm mapping / set up #ifdef HAVE_MOAB - ! Call moab intx only if atm and ice are init in moab coupler - if ((mbaxid .ge. 0) .and. (mbixid .ge. 0)) then + ! Call moab intx only if atm and ice are init in moab coupler + if ((mbaxid .ge. 0) .and. (mbixid .ge. 0)) then appname = "ICE_ATM_COU"//C_NULL_CHAR ! idintx is a unique number of MOAB app that takes care of intx between ice and atm mesh idintx = 100*ice(1)%cplcompid + atm(1)%cplcompid ! something different, to differentiate it @@ -378,7 +378,7 @@ subroutine prep_atm_init(infodata, ocn_c2_atm, ice_c2_atm, lnd_c2_atm, iac_c2_at endif if (iamroot_CPLID) then write(logunit,*) 'iMOAB intersection between ice and atm with id:', idintx - end if + endif ! we also need to compute the comm graph for the second hop, from the ice on coupler to the @@ -414,7 +414,7 @@ subroutine prep_atm_init(infodata, ocn_c2_atm, ice_c2_atm, lnd_c2_atm, iac_c2_at write(logunit,*) subname,' error in defining tags for seq_flds_i2x_fields' call shr_sys_abort(subname//' ERROR in coin defining tags for seq_flds_i2x_fields') endif - else ! spectral case, fix later + else ! spectral case, TODO tagtype = 1 ! dense endif @@ -443,7 +443,7 @@ subroutine prep_atm_init(infodata, ocn_c2_atm, ice_c2_atm, lnd_c2_atm, iac_c2_at fNoBubble, monotonicity, volumetric, fInverseDistanceMap, & noConserve, validate, & trim(dofnameS), trim(dofnameT) - end if + endif ierr = iMOAB_ComputeScalarProjectionWeights ( mbintxia, wgtIdef, & trim(dm1), orderS, trim(dm2), orderT, & fNoBubble, monotonicity, volumetric, fInverseDistanceMap, & @@ -459,31 +459,32 @@ subroutine prep_atm_init(infodata, ocn_c2_atm, ice_c2_atm, lnd_c2_atm, iac_c2_at wopts = C_NULL_CHAR call shr_mpi_commrank( mpicom_CPLID, rank ) if (rank .lt. 3) then - write(lnum,"(I0.2)")rank ! - outfile = 'intx_ia_'//trim(lnum)// '.h5m' // C_NULL_CHAR - ierr = iMOAB_WriteMesh(mbintxia, outfile, wopts) ! write local intx file - if (ierr .ne. 0) then - write(logunit,*) subname,' error in writing intx file ice-atm ' - call shr_sys_abort(subname//' ERROR in writing intx file ice-atm ') - endif + write(lnum,"(I0.2)")rank ! + outfile = 'intx_ia_'//trim(lnum)// '.h5m' // C_NULL_CHAR + ierr = iMOAB_WriteMesh(mbintxia, outfile, wopts) ! write local intx file + if (ierr .ne. 0) then + write(logunit,*) subname,' error in writing intx file ice-atm ' + call shr_sys_abort(subname//' ERROR in writing intx file ice-atm ') + endif endif ! endif for MOABDEBUG #endif + endif ! if ((mbaxid .ge. 0) .and. (mbixid .ge. 0)) then ! endif for HAVE_MOAB #endif - endif ! if ((mbaxid .ge. 0) .and. (mbixid .ge. 0)) then - endif ! if (ice_c2_atm) then - - ! needed for domain checking - if (ice_present) then - if (iamroot_CPLID) then - write(logunit,*) ' ' - write(logunit,F00) 'Initializing mapper_Fi2a' - end if - call seq_map_init_rcfile(mapper_Fi2a, ice(1), atm(1), & - 'seq_maps.rc','ice2atm_fmapname:','ice2atm_fmaptype:',samegrid_ao, & - 'mapper_Fi2a initialization',esmf_map_flag) - + + endif ! if (ice_c2_atm) then + + ! needed for domain checking + if (ice_present) then + if (iamroot_CPLID) then + write(logunit,*) ' ' + write(logunit,F00) 'Initializing mapper_Fi2a' + endif + call seq_map_init_rcfile(mapper_Fi2a, ice(1), atm(1), & + 'seq_maps.rc','ice2atm_fmapname:','ice2atm_fmaptype:',samegrid_ao, & + 'mapper_Fi2a initialization',esmf_map_flag) + #ifdef HAVE_MOAB ! now take care of the mapper for MOAB mapper_Fi2a%src_mbid = mbixid @@ -494,69 +495,119 @@ subroutine prep_atm_init(infodata, ocn_c2_atm, ice_c2_atm, lnd_c2_atm, iac_c2_at wgtIdef = 'scalar'//C_NULL_CHAR mapper_Fi2a%weight_identifier = wgtIdef #endif - endif - call shr_sys_flush(logunit) - - ! needed for domain checking - if (lnd_present) then - if (iamroot_CPLID) then - write(logunit,*) ' ' - write(logunit,F00) 'Initializing mapper_Fl2a' - end if - call seq_map_init_rcfile(mapper_Fl2a, lnd(1), atm(1), & - 'seq_maps.rc','lnd2atm_fmapname:','lnd2atm_fmaptype:',samegrid_al, & - 'mapper_Fl2a initialization',esmf_map_flag) - endif - call shr_sys_flush(logunit) - - if (lnd_c2_atm) then - if (iamroot_CPLID) then - write(logunit,*) ' ' - write(logunit,F00) 'Initializing mapper_Sl2a' - end if - call seq_map_init_rcfile(mapper_Sl2a, lnd(1), atm(1), & - 'seq_maps.rc','lnd2atm_smapname:','lnd2atm_smaptype:',samegrid_al, & - 'mapper_Sl2a initialization',esmf_map_flag) - - ! important change: do not compute intx at all between atm and land when we have samegrid_al - ! we will use just a comm graph to send data from phys grid to land on coupler - ! this is just a rearrange in a way - if ((mbaxid .ge. 0) .and. (mblxid .ge. 0) .and. .not. samegrid_al ) then - appname = "ATM_LND_COU"//C_NULL_CHAR + endif ! if (ice_present) then + call shr_sys_flush(logunit) + + ! needed for domain checking + if (lnd_present) then + if (iamroot_CPLID) then + write(logunit,*) ' ' + write(logunit,F00) 'Initializing mapper_Fl2a' + endif + call seq_map_init_rcfile(mapper_Fl2a, lnd(1), atm(1), & + 'seq_maps.rc','lnd2atm_fmapname:','lnd2atm_fmaptype:',samegrid_al, & + 'mapper_Fl2a initialization',esmf_map_flag) + +#ifdef HAVE_MOAB + ! important change: do not compute intx at all between atm and land when we have samegrid_al + ! we will use just a comm graph to send data from phys grid to land on coupler + ! this is just a rearrange in a way + if ((mbaxid .ge. 0) .and. (mblxid .ge. 0) ) then + appname = "LND_ATM_COU"//C_NULL_CHAR ! idintx is a unique number of MOAB app that takes care of intx between lnd and atm mesh - idintx = 100*atm(1)%cplcompid + lnd(1)%cplcompid ! something different, to differentiate it + idintx = 100*lnd(1)%cplcompid + atm(1)%cplcompid ! something different, to differentiate it ierr = iMOAB_RegisterApplication(trim(appname), mpicom_CPLID, idintx, mbintxla) if (ierr .ne. 0) then - write(logunit,*) subname,' error in registering atm lnd intx ' - call shr_sys_abort(subname//' ERROR in registering atm lnd intx ') - endif - if (iamroot_CPLID) then - write(logunit,*) 'iMOAB intersection between atm and land with id:', idintx - end if - ierr = iMOAB_ComputeMeshIntersectionOnSphere (mbaxid, mblxid, mbintxla) - if (ierr .ne. 0) then - write(logunit,*) subname,' error in computing atm lnd intx' - call shr_sys_abort(subname//' ERROR in computing atm lnd intx') + write(logunit,*) subname,' error in registering lnd atm intx ' + call shr_sys_abort(subname//' ERROR in registering lnd atm intx ') endif + mapper_Fl2a%src_mbid = mblxid + mapper_Fl2a%tgt_mbid = mbaxid + mapper_Fl2a%src_mbid = mbintxla + mapper_Fl2a%src_context = lnd(1)%cplcompid + mapper_Fl2a%intx_context = idintx + wgtIdef = 'scalar'//C_NULL_CHAR + mapper_Fl2a%weight_identifier = wgtIdef + + if (.not. samegrid_al) then ! tri grid case + if (iamroot_CPLID) then + write(logunit,*) 'iMOAB intersection between atm and land with id:', idintx + endif + ierr = iMOAB_ComputeMeshIntersectionOnSphere (mblxid, mbaxid, mbintxla) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in computing atm lnd intx' + call shr_sys_abort(subname//' ERROR in computing atm lnd intx') + endif #ifdef MOABDEBUG - ! write intx only if true intx file: - wopts = C_NULL_CHAR - call shr_mpi_commrank( mpicom_CPLID, rank ) - if (rank .lt. 5) then ! write only a few intx files - write(lnum,"(I0.2)")rank ! - outfile = 'intx_la'//trim(lnum)// '.h5m' // C_NULL_CHAR - ierr = iMOAB_WriteMesh(mbintxla, outfile, wopts) ! write local intx file - if (ierr .ne. 0) then - write(logunit,*) subname,' error in writing intx file land atm ' - call shr_sys_abort(subname//' ERROR in writing intx file ') - endif - endif ! if tri-grid + ! write intx only if true intx file: + wopts = C_NULL_CHAR + call shr_mpi_commrank( mpicom_CPLID, rank ) + if (rank .lt. 5) then ! write only a few intx files + write(lnum,"(I0.2)")rank ! + outfile = 'intx_la'//trim(lnum)// '.h5m' // C_NULL_CHAR + ierr = iMOAB_WriteMesh(mbintxla, outfile, wopts) ! write local intx file + if (ierr .ne. 0) then + write(logunit,*) subname,' error in writing intx file land atm ' + call shr_sys_abort(subname//' ERROR in writing intx file ') + endif + endif #endif - endif - end if + + ! we also need to compute the comm graph for the second hop, from the lnd on coupler to the + ! lnd for the intx ice-atm context (coverage) + ! + call seq_comm_getinfo(CPLID ,mpigrp=mpigrp_CPLID) + type1 = 3; ! fv for lnd and atm; fv-cgll does not work anyway + type2 = 3; + ! ierr = iMOAB_ComputeCommGraph( mboxid, mbintxoa, &mpicom_CPLID, &mpigrp_CPLID, &mpigrp_CPLID, &type1, &type2, + ! &ocn_id, &idintx) + ierr = iMOAB_ComputeCommGraph( mblxid, mbintxla, mpicom_CPLID, mpigrp_CPLID, mpigrp_CPLID, type1, type2, & + lnd(1)%cplcompid, idintx) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in computing comm graph for second hop, ice-atm' + call shr_sys_abort(subname//' ERROR in computing comm graph for second hop, ice-atm') + endif + else ! the same mesh , atm and lnd use the same dofs, but restricted + ! we do not compute intersection, so we will have to just send data from atm to land and viceversa, by GLOBAL_ID matching + ! so we compute just a comm graph, between lnd and atm dofs, on the coupler; target is atm + ! land is point cloud in this case, type1 = 2 + type1 = 2; ! point cloud for lnd + type2 = 3; ! fv for target atm + ierr = iMOAB_ComputeCommGraph( mblxid, mbaxid, mpicom_CPLID, mpigrp_CPLID, mpigrp_CPLID, type1, type2, & + lnd(1)%cplcompid, atm(1)%cplcompid) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in computing comm graph for second hop, lnd-atm' + call shr_sys_abort(subname//' ERROR in computing comm graph for second hop, lnd-atm') + endif + endif ! if tri-grid + endif ! if ((mbaxid .ge. 0) .and. (mblxid .ge. 0) ) then +#endif + endif ! if lnd_present + call shr_sys_flush(logunit) + + if (lnd_c2_atm) then + if (iamroot_CPLID) then + write(logunit,*) ' ' + write(logunit,F00) 'Initializing mapper_Sl2a' + endif + call seq_map_init_rcfile(mapper_Sl2a, lnd(1), atm(1), & + 'seq_maps.rc','lnd2atm_smapname:','lnd2atm_smaptype:',samegrid_al, & + 'mapper_Sl2a initialization',esmf_map_flag) +#ifdef HAVE_MOAB + if ((mbaxid .ge. 0) .and. (mblxid .ge. 0) ) then + mapper_Fl2a%src_mbid = mblxid + mapper_Fl2a%tgt_mbid = mbaxid + mapper_Fl2a%src_mbid = mbintxla + mapper_Fl2a%src_context = lnd(1)%cplcompid + mapper_Fl2a%intx_context = idintx + wgtIdef = 'scalar'//C_NULL_CHAR + mapper_Fl2a%weight_identifier = wgtIdef + endif +#endif + endif ! if (lnd_c2_atm) then - end if + endif ! if atm_present end subroutine prep_atm_init @@ -1084,65 +1135,65 @@ subroutine prep_atm_merge( l2x_a, o2x_a, xao_a, i2x_a, fractions_a, x2a_a ) mrgstr(ka) = subname//'x2a%'//trim(field_atm(ka))//' =' if (field_atm(ka)(1:2) == 'PF') then cycle ! if flux has first character as P, pass straight through - end if + endif if (field_atm(ka)(1:1) == 'S' .and. field_atm(ka)(2:2) /= 'x') then cycle ! any state fields that are not Sx_ will just be copied - end if + endif do kl = 1,nlflds if (trim(itemc_atm(ka)) == trim(itemc_lnd(kl))) then if ((trim(field_atm(ka)) == trim(field_lnd(kl)))) then if (field_lnd(kl)(1:1) == 'F') lmerge(ka) = .false. - end if + endif ! --- make sure only one field matches --- if (lindx(ka) /= 0) then write(logunit,*) subname,' ERROR: found multiple kl field matches for ',trim(itemc_lnd(kl)) call shr_sys_abort(subname//' ERROR multiple kl field matches') endif lindx(ka) = kl - end if + endif end do do ki = 1,niflds if (field_ice(ki)(1:1) == 'F' .and. field_ice(ki)(2:4) == 'ioi') then cycle ! ignore all fluxes that are ice/ocn fluxes - end if + endif if (trim(itemc_atm(ka)) == trim(itemc_ice(ki))) then if ((trim(field_atm(ka)) == trim(field_ice(ki)))) then if (field_ice(ki)(1:1) == 'F') imerge(ka) = .false. - end if + endif ! --- make sure only one field matches --- if (iindx(ka) /= 0) then write(logunit,*) subname,' ERROR: found multiple ki field matches for ',trim(itemc_ice(ki)) call shr_sys_abort(subname//' ERROR multiple ki field matches') endif iindx(ka) = ki - end if + endif end do do kx = 1,nxflds if (trim(itemc_atm(ka)) == trim(itemc_xao(kx))) then if ((trim(field_atm(ka)) == trim(field_xao(kx)))) then if (field_xao(kx)(1:1) == 'F') xmerge(ka) = .false. - end if + endif ! --- make sure only one field matches --- if (xindx(ka) /= 0) then write(logunit,*) subname,' ERROR: found multiple kx field matches for ',trim(itemc_xao(kx)) call shr_sys_abort(subname//' ERROR multiple kx field matches') endif xindx(ka) = kx - end if + endif end do do ko = 1,noflds if (trim(itemc_atm(ka)) == trim(itemc_ocn(ko))) then if ((trim(field_atm(ka)) == trim(field_ocn(ko)))) then if (field_ocn(ko)(1:1) == 'F') omerge(ka) = .false. - end if + endif ! --- make sure only one field matches --- if (oindx(ka) /= 0) then write(logunit,*) subname,' ERROR: found multiple ko field matches for ',trim(itemc_ocn(ko)) call shr_sys_abort(subname//' ERROR multiple ko field matches') endif oindx(ka) = ko - end if + endif end do ! --- add some checks --- @@ -1180,7 +1231,7 @@ subroutine prep_atm_merge( l2x_a, o2x_a, xao_a, i2x_a, fractions_a, x2a_a ) endif end do - end if + endif ! Zero attribute vector @@ -1260,30 +1311,30 @@ subroutine prep_atm_merge( l2x_a, o2x_a, xao_a, i2x_a, fractions_a, x2a_a ) mrgstr(ka) = trim(mrgstr(ka))//' + lfrac*l2x%'//trim(field_lnd(lindx(ka))) else mrgstr(ka) = trim(mrgstr(ka))//' = lfrac*l2x%'//trim(field_lnd(lindx(ka))) - end if - end if + endif + endif if (iindx(ka) > 0) then if (imerge(ka)) then mrgstr(ka) = trim(mrgstr(ka))//' + ifrac*i2x%'//trim(field_ice(iindx(ka))) else mrgstr(ka) = trim(mrgstr(ka))//' = ifrac*i2x%'//trim(field_ice(iindx(ka))) - end if - end if + endif + endif if (xindx(ka) > 0) then if (xmerge(ka)) then mrgstr(ka) = trim(mrgstr(ka))//' + ofrac*xao%'//trim(field_xao(xindx(ka))) else mrgstr(ka) = trim(mrgstr(ka))//' = ofrac*xao%'//trim(field_xao(xindx(ka))) - end if - end if + endif + endif if (oindx(ka) > 0) then if (omerge(ka)) then mrgstr(ka) = trim(mrgstr(ka))//' + ofrac*o2x%'//trim(field_ocn(oindx(ka))) - end if + endif if (.not. omerge(ka)) then mrgstr(ka) = trim(mrgstr(ka))//' + (ifrac+ofrac)*o2x%'//trim(field_ocn(oindx(ka))) - end if - end if + endif + endif endif do n = 1,lsize @@ -1295,32 +1346,32 @@ subroutine prep_atm_merge( l2x_a, o2x_a, xao_a, i2x_a, fractions_a, x2a_a ) x2a_a%rAttr(ka,n) = x2a_a%rAttr(ka,n) + l2x_a%rAttr(lindx(ka),n) * fracl else x2a_a%rAttr(ka,n) = l2x_a%rAttr(lindx(ka),n) * fracl - end if - end if + endif + endif if (iindx(ka) > 0 .and. fraci > 0._r8) then if (imerge(ka)) then x2a_a%rAttr(ka,n) = x2a_a%rAttr(ka,n) + i2x_a%rAttr(iindx(ka),n) * fraci else x2a_a%rAttr(ka,n) = i2x_a%rAttr(iindx(ka),n) * fraci - end if - end if + endif + endif if (xindx(ka) > 0 .and. fraco > 0._r8) then if (xmerge(ka)) then x2a_a%rAttr(ka,n) = x2a_a%rAttr(ka,n) + xao_a%rAttr(xindx(ka),n) * fraco else x2a_a%rAttr(ka,n) = xao_a%rAttr(xindx(ka),n) * fraco - end if - end if + endif + endif if (oindx(ka) > 0) then if (omerge(ka) .and. fraco > 0._r8) then x2a_a%rAttr(ka,n) = x2a_a%rAttr(ka,n) + o2x_a%rAttr(oindx(ka),n) * fraco - end if + endif if (.not. omerge(ka)) then !--- NOTE: This IS using the ocean fields and ice fraction !! --- x2a_a%rAttr(ka,n) = o2x_a%rAttr(oindx(ka),n) * fraci x2a_a%rAttr(ka,n) = x2a_a%rAttr(ka,n) + o2x_a%rAttr(oindx(ka),n) * fraco - end if - end if + endif + endif end do end do @@ -1382,19 +1433,19 @@ subroutine prep_atm_calc_o2x_ax(fractions_ox, timer) endif call seq_map_map(mapper_Fo2a, o2x_ox, o2x_ax(emi),& fldlist=seq_flds_o2x_fluxes,norm=.true.) + enddo #ifdef MOABDEBUG - ! projection of atm to ocean fields - write(lnum,"(I0.2)")num_moab_exports - outfile = 'Ocn2Atm'//trim(lnum)//'.h5m'//C_NULL_CHAR - wopts = ';PARALLEL=WRITE_PART'//C_NULL_CHAR ! - ierr = iMOAB_WriteMesh(mbaxid, trim(outfile), trim(wopts)) - if (ierr .ne. 0) then - write(logunit,*) subname,' error in writing ocean to atm projection' - call shr_sys_abort(subname//' ERROR in writing ocean to atm projection') - endif + ! projections on atm + write(lnum,"(I0.2)")num_moab_exports + outfile = 'OIL2Atm'//trim(lnum)//'.h5m'//C_NULL_CHAR + wopts = ';PARALLEL=WRITE_PART'//C_NULL_CHAR ! + ierr = iMOAB_WriteMesh(mbaxid, trim(outfile), trim(wopts)) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in writing ocean to atm projection' + call shr_sys_abort(subname//' ERROR in writing ocean to atm projection') + endif #endif - enddo call t_drvstopf (trim(timer)) end subroutine prep_atm_calc_o2x_ax @@ -1463,6 +1514,7 @@ subroutine prep_atm_calc_l2x_ax(fractions_lx, timer) fldlist=seq_flds_l2x_fluxes, norm=.true., & avwts_s=fractions_lx(efi), avwtsfld_s='lfrin') enddo + call t_drvstopf (trim(timer)) end subroutine prep_atm_calc_l2x_ax From 9aa9b0fac4274a689d67289a218802ed7facabe4 Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Fri, 16 Dec 2022 17:16:35 -0600 Subject: [PATCH 221/467] remove 1 hop projection use everywhere the modified 2 hop, except for rof 2 ocn projection that will go away too at some point --- driver-moab/main/cime_comp_mod.F90 | 15 +- driver-moab/main/prep_atm_mod.F90 | 128 +----- driver-moab/main/prep_lnd_mod.F90 | 390 +++++++---------- driver-moab/main/prep_ocn_mod.F90 | 674 +++++++---------------------- driver-moab/main/seq_map_mod.F90 | 65 ++- driver-moab/shr/seq_comm_mct.F90 | 2 + 6 files changed, 359 insertions(+), 915 deletions(-) diff --git a/driver-moab/main/cime_comp_mod.F90 b/driver-moab/main/cime_comp_mod.F90 index 29178173668a..2822eea236f4 100644 --- a/driver-moab/main/cime_comp_mod.F90 +++ b/driver-moab/main/cime_comp_mod.F90 @@ -1974,16 +1974,6 @@ subroutine cime_init() endif - ! need to finish up the computation of the atm - ocean map (tempest) - ! this needs to be in prep_ocn_mod, because it is for projection to ocean! - if (iamin_CPLALLATMID .and. atm_c2_ocn) call prep_atm_ocn_moab(infodata) - - ! this needs to be in prep_ocn_mod, because it is for ice projection to ocean! - if (iamin_CPLALLICEID .and. ice_c2_ocn) call prep_ice_ocn_moab(infodata) - - ! need to finish up the computation of the atm - land map ( point cloud) - if (iamin_CPLALLATMID .and. atm_c2_lnd) call prep_atm_lnd_moab(infodata) - ! need to finish up the migration of mesh for rof 2 ocn map ( read from file) if (iamin_CPLALLROFID .and. rof_c2_ocn) call prep_rof_ocn_moab(infodata) @@ -4307,7 +4297,7 @@ subroutine cime_run_atmocn_setup(hashint) integer :: ent_type #endif - call prep_ocn_calc_i2x_ox_moab() ! this does projection from ice to ocean on coupler, by simply matching + ! call prep_ocn_calc_i2x_ox_moab() ! this does projection from ice to ocean on coupler, by simply matching if (iamin_CPLID) then call cime_comp_barriers(mpicom=mpicom_CPLID, timer='CPL:ATMOCNP_BARRIER') call t_drvstartf ('CPL:ATMOCNP',cplrun=.true.,barrier=mpicom_CPLID,hashint=hashint(7)) @@ -4784,9 +4774,6 @@ subroutine cime_run_ice_recv_post() ! if we do a proper component_exch, then would need another hop, just on coupler pes ! TODO when do we need to send from ice to ocn? Usually after ice run ? call component_exch_moab(ice(1), mpsiid, mbixid, 0, seq_flds_i2x_fields) ! this migrates all fields from ice to coupler - if (ice_c2_ocn ) then - call prep_ocn_calc_i2x_ox_moab() ! this does projection ice-ocn with one hop - endif endif !---------------------------------------------------------- diff --git a/driver-moab/main/prep_atm_mod.F90 b/driver-moab/main/prep_atm_mod.F90 index aaaa68004c4f..e8263b45637e 100644 --- a/driver-moab/main/prep_atm_mod.F90 +++ b/driver-moab/main/prep_atm_mod.F90 @@ -136,10 +136,10 @@ subroutine prep_atm_init(infodata, ocn_c2_atm, ice_c2_atm, lnd_c2_atm, iac_c2_at type(mct_avect), pointer :: a2x_ax character(*), parameter :: subname = '(prep_atm_init)' character(*), parameter :: F00 = "('"//subname//" : ', 4A )" - integer ierr, idintx, rank - character*32 :: appname, outfile, wopts, lnum - ! MOAB stuff + ! MOAB stuff + integer :: ierr, idintx, rank + character*32 :: appname, outfile, wopts, lnum character*32 :: dm1, dm2, dofnameS, dofnameT, wgtIdef integer :: orderS, orderT, volumetric, noConserve, validate, fInverseDistanceMap integer :: fNoBubble, monotonicity @@ -554,7 +554,7 @@ subroutine prep_atm_init(infodata, ocn_c2_atm, ice_c2_atm, lnd_c2_atm, iac_c2_at #endif ! we also need to compute the comm graph for the second hop, from the lnd on coupler to the - ! lnd for the intx ice-atm context (coverage) + ! lnd for the intx lnd-atm context (coverage) ! call seq_comm_getinfo(CPLID ,mpigrp=mpigrp_CPLID) type1 = 3; ! fv for lnd and atm; fv-cgll does not work anyway @@ -668,126 +668,6 @@ subroutine prep_atm_migrate_moab(infodata) context_id = ocn(1)%cplcompid wgtIdef = 'scalar'//C_NULL_CHAR -! if (atm_present .and. ocn_present .and. ocn_prognostic) then -! if (atm_pg_active ) then ! use data from AtmPhys mesh, but mesh from pg -! ! in this case, we will send from phys grid directly to intx atm ocn context! -! tagname=trim(seq_flds_a2x_fields)//C_NULL_CHAR -! if (mphaid .ge. 0) then ! send because we are on atm pes, also mphaid >= 0 -! context_id = 100*atm(1)%cplcompid + ocn(1)%cplcompid !send to atm/ocn intx ! ~ 618 -! ierr = iMOAB_SendElementTag(mphaid, tagName, mpicom_join, context_id) -! if (ierr .ne. 0) then -! write(logunit,*) subname,' error in sending tag from phys atm to ocn atm intx ' -! call shr_sys_abort(subname//' ERROR in sending tag from phys atm to ocn atm intx') -! endif - -! endif -! if (mbintxao .ge. 0 ) then ! we are for sure on coupler pes! -! ! context_id = atm(1)%cplcompid == atm_id above (5) -! ! we use the same name as spectral case, even thought in pg2 case, the size of tag is 1, not 16 -! ! in imoab_apg2_ol_coupler.cpp we use at this stage, receiver, the same name as sender, T_ph -! ierr = iMOAB_ReceiveElementTag(mbintxao, tagName, mpicom_join, atm_id) -! if (ierr .ne. 0) then -! write(logunit,*) subname,' error in receiving tag from phys atm to ocn atm intx ' -! call shr_sys_abort(subname//' ERROR in receiving tag from phys atm to ocn atm intx') -! endif - -! endif -! ! we can now free the sender buffers -! if (mhpgid .ge. 0) then -! ierr = iMOAB_FreeSenderBuffers(mphaid, context_id) -! if (ierr .ne. 0) then -! write(logunit,*) subname,' error in freeing buffers' -! call shr_sys_abort(subname//' ERROR in freeing buffers') -! endif -! endif - -! if (mbintxao .ge. 0 ) then ! we are on coupler pes, for sure -! ! we could apply weights; need to use the same weight identifier wgtIdef as when we generated it -! ! hard coded now, it should be a runtime option in the future - -! ierr = iMOAB_ApplyScalarProjectionWeights ( mbintxao, wgtIdef, tagName, tagName) -! if (ierr .ne. 0) then -! write(logunit,*) subname,' error in applying weights ' -! call shr_sys_abort(subname//' ERROR in applying weights') -! endif -! #ifdef MOABDEBUG -! ! we can also write the ocean mesh to file, just to see the projectd tag -! ! write out the mesh file to disk -! write(lnum,"(I0.2)")num_moab_exports -! outfile = 'ocnCplProj'//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 -! write(logunit,*) subname,' error in writing ocn mesh after projection ' -! call shr_sys_abort(subname//' ERROR in writing ocn mesh after projection') -! endif -! #endif -! !CHECKRC(ierr, "cannot receive tag values") -! endif - -! else ! original send from spectral elements is replaced by send from phys grid -! ! this will be reworked for all fields, send from phys grid atm: -! tagName = trim(seq_flds_a2x_fields)//C_NULL_CHAR ! they are exported on phys grid directly -! tagNameExt = trim(seq_flds_a2x_ext_fields)//C_NULL_CHAR ! these are special moab tags -! ! the separator will be ':' as in mct - -! if (mphaid .ge. 0) then ! send because we are on atm pes -! ! -! context_id = 100*atm(1)%cplcompid + ocn(1)%cplcompid !send to atm/ocn intx ! ~ 618 -! ierr = iMOAB_SendElementTag(mphaid, tagName, mpicom_join, context_id) -! if (ierr .ne. 0) then -! write(logunit,*) subname,' error in sending tag from atm spectral to ocn atm intx ' -! call shr_sys_abort(subname//' ERROR in sending tag from atm spectral to ocn atm intx') -! endif -! endif -! if (mbaxid .ge. 0 ) then ! we are on coupler pes, for sure -! ! receive on atm on coupler pes, that was redistributed according to coverage -! context_id = atm(1)%compid ! atm_id -! ierr = iMOAB_ReceiveElementTag(mbintxao, tagNameExt, mpicom_join, context_id) -! if (ierr .ne. 0) then -! write(logunit,*) subname,' error in receiving tag from atm phys grid to ocn atm intx spectral ' -! call shr_sys_abort(subname//' ERROR in receiving tag from atm phys grid to ocn atm intx spectral') -! endif -! endif - -! ! we can now free the sender buffers -! if (mphaid .ge. 0) then -! context_id = 100*atm(1)%cplcompid + ocn(1)%cplcompid !send to atm/ocn intx ! ~ 618 -! ierr = iMOAB_FreeSenderBuffers(mphaid, context_id) -! if (ierr .ne. 0) then -! write(logunit,*) subname,' error in freeing buffers ' -! call shr_sys_abort(subname//' ERROR in freeing buffers') -! endif -! endif -! ! we could do the projection now, on the ocean mesh, because we are on the coupler pes; -! ! the actual migrate could happen later , from coupler pes to the ocean pes -! if (mbintxao .ge. 0 ) then ! we are on coupler pes, for sure -! ! we could apply weights; need to use the same weight identifier wgtIdef as when we generated it -! ! hard coded now, it should be a runtime option in the future - -! ierr = iMOAB_ApplyScalarProjectionWeights ( mbintxao, wgtIdef, tagNameExt, tagName) -! if (ierr .ne. 0) then -! write(logunit,*) subname,' error in applying weights ' -! call shr_sys_abort(subname//' ERROR in applying weights') -! endif -! #ifdef MOABDEBUG -! ! we can also write the ocean mesh to file, just to see the projectd tag -! ! write out the mesh file to disk -! write(lnum,"(I0.2)")num_moab_exports -! outfile = 'ocnCplProj'//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 -! write(logunit,*) subname,' error in writing ocn mesh after projection ' -! call shr_sys_abort(subname//' ERROR in writing ocn mesh after projection') -! endif -! #endif -! endif ! if (mbintxao .ge. 0 ) -! !CHECKRC(ierr, "cannot receive tag values") -! endif ! if (atp_pg_active) - -! endif ! if atm and ocn - ! repeat this for land data, that is already on atm tag context_id = lnd(1)%cplcompid diff --git a/driver-moab/main/prep_lnd_mod.F90 b/driver-moab/main/prep_lnd_mod.F90 index b21b6fd624c9..a2203ac54717 100644 --- a/driver-moab/main/prep_lnd_mod.F90 +++ b/driver-moab/main/prep_lnd_mod.F90 @@ -15,7 +15,7 @@ module prep_lnd_mod use seq_comm_mct, only: mphaid ! iMOAB id for phys atm on atm pes use seq_comm_mct, only: mhpgid ! iMOAB id for atm pgx grid, on atm pes; created with se and gll grids use seq_comm_mct, only: mblxid ! iMOAB id for mpas ocean migrated mesh to coupler pes - use seq_comm_mct, only: mbintxla ! iMOAB id for intx mesh between land and atmosphere + use seq_comm_mct, only: mbintxal ! iMOAB id for intx mesh between land and atmosphere use seq_comm_mct, only: mbaxid ! iMOAB id for atm migrated mesh to coupler pes use seq_comm_mct, only: atm_pg_active ! whether the atm uses FV mesh or not ; made true if fv_nphys > 0 use dimensions_mod, only: np ! for atmosphere @@ -30,7 +30,10 @@ module prep_lnd_mod use component_type_mod, only: lnd, atm, rof, glc use map_glc2lnd_mod , only: map_glc2lnd_ec use iso_c_binding - +#ifdef HAVE_MOAB + use iMOAB , only: iMOAB_ComputeCommGraph, iMOAB_ComputeMeshIntersectionOnSphere, & + iMOAB_ComputeScalarProjectionWeights, iMOAB_DefineTagStorage, iMOAB_RegisterApplication +#endif implicit none save private @@ -58,9 +61,6 @@ module prep_lnd_mod public :: prep_lnd_get_mapper_Sg2l public :: prep_lnd_get_mapper_Fg2l - public :: prep_atm_lnd_moab ! it belongs here now - - public :: prep_lnd_migrate_moab !-------------------------------------------------------------------------- ! Private interfaces !-------------------------------------------------------------------------- @@ -99,9 +99,6 @@ module prep_lnd_mod character(CXX) :: glc2lnd_ec_extra_fields !================================================================================================ -#ifdef MOABDEBUG - integer :: number_calls ! it is a static variable, used to count the number of projections -#endif contains !================================================================================================ @@ -134,6 +131,21 @@ subroutine prep_lnd_init(infodata, atm_c2_lnd, rof_c2_lnd, glc_c2_lnd, iac_c2_ln character(CL) :: rof_gnam ! rof grid character(CL) :: glc_gnam ! glc grid type(mct_avect), pointer :: l2x_lx +#ifdef HAVE_MOAB + ! MOAB stuff + integer :: ierr, idintx, rank + character*32 :: appname, outfile, wopts, lnum + character*32 :: dm1, dm2, dofnameS, dofnameT, wgtIdef + integer :: orderS, orderT, volumetric, noConserve, validate, fInverseDistanceMap + integer :: fNoBubble, monotonicity + ! will do comm graph over coupler PES, in 2-hop strategy + integer :: mpigrp_CPLID ! coupler pes group, used for comm graph phys <-> atm-ocn + + integer :: type1, type2 ! type for computing graph; should be the same type for ocean, 3 (FV) + integer :: tagtype, numco, tagindex + character(CXX) :: tagName + +#endif character(*), parameter :: subname = '(prep_lnd_init)' character(*), parameter :: F00 = "('"//subname//" : ', 4A )" !--------------------------------------------------------------- @@ -209,6 +221,150 @@ subroutine prep_lnd_init(infodata, atm_c2_lnd, rof_c2_lnd, glc_c2_lnd, iac_c2_ln call seq_map_init_rcfile(mapper_Fa2l, atm(1), lnd(1), & 'seq_maps.rc','atm2lnd_fmapname:','atm2lnd_fmaptype:',samegrid_al, & 'mapper_Fa2l initialization',esmf_map_flag) +! similar to prep_atm_init, lnd and atm reversed +#ifdef HAVE_MOAB + ! important change: do not compute intx at all between atm and land when we have samegrid_al + ! we will use just a comm graph to send data from atm to land on coupler + ! this is just a rearrange in a way + if ((mbaxid .ge. 0) .and. (mblxid .ge. 0) ) then + appname = "ATM_LND_COU"//C_NULL_CHAR + ! idintx is a unique number of MOAB app that takes care of intx between lnd and atm mesh + idintx = 100*atm(1)%cplcompid + lnd(1)%cplcompid ! something different, to differentiate it + ierr = iMOAB_RegisterApplication(trim(appname), mpicom_CPLID, idintx, mbintxal) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in registering atm lnd intx ' + call shr_sys_abort(subname//' ERROR in registering atm lnd intx ') + endif + mapper_Sa2l%src_mbid = mbaxid + mapper_Sa2l%tgt_mbid = mblxid + mapper_Sa2l%src_mbid = mbintxal + mapper_Sa2l%src_context = lnd(1)%cplcompid + mapper_Sa2l%intx_context = idintx + wgtIdef = 'scalar'//C_NULL_CHAR + mapper_Sa2l%weight_identifier = wgtIdef + + if (.not. samegrid_al) then ! tri grid case + if (iamroot_CPLID) then + write(logunit,*) 'iMOAB intersection between atm and land with id:', idintx + endif + ierr = iMOAB_ComputeMeshIntersectionOnSphere (mbaxid, mblxid, mbintxal) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in computing atm lnd intx' + call shr_sys_abort(subname//' ERROR in computing atm lnd intx') + endif +#ifdef MOABDEBUG + ! write intx only if true intx file: + wopts = C_NULL_CHAR + call shr_mpi_commrank( mpicom_CPLID, rank ) + if (rank .lt. 3) then ! write only a few intx files + write(lnum,"(I0.2)")rank ! + outfile = 'intx_al'//trim(lnum)// '.h5m' // C_NULL_CHAR + ierr = iMOAB_WriteMesh(mbintxal, outfile, wopts) ! write local intx file + if (ierr .ne. 0) then + write(logunit,*) subname,' error in writing intx file atm land ' + call shr_sys_abort(subname//' ERROR in writing intx file atm lnd') + endif + endif +#endif + + ! we also need to compute the comm graph for the second hop, from the atm on coupler to the + ! lnd for the intx atm-lnd context (coverage) + ! + call seq_comm_getinfo(CPLID ,mpigrp=mpigrp_CPLID) + type1 = 1 ! this projection works (cgll to fv), but reverse does not ( fv - cgll) + type2 = 3; ! land is fv in this case (separate grid) + ! ierr = iMOAB_ComputeCommGraph( mboxid, mbintxoa, &mpicom_CPLID, &mpigrp_CPLID, &mpigrp_CPLID, &type1, &type2, + ! &ocn_id, &idintx) + ierr = iMOAB_ComputeCommGraph( mbaxid, mbintxal, mpicom_CPLID, mpigrp_CPLID, mpigrp_CPLID, type1, type2, & + atm(1)%cplcompid, idintx) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in computing comm graph for second hop, atm-lnd' + call shr_sys_abort(subname//' ERROR in computing comm graph for second hop, atm-lnd') + endif + + volumetric = 0 ! can be 1 only for FV->DGLL or FV->CGLL; + + if (atm_pg_active) then + dm1 = "fv"//C_NULL_CHAR + dofnameS="GLOBAL_ID"//C_NULL_CHAR + orderS = 1 ! fv-fv + else + dm1 = "cgll"//C_NULL_CHAR + dofnameS="GLOBAL_DOFS"//C_NULL_CHAR + orderS = np ! it should be 4 + endif + dm2 = "fv"//C_NULL_CHAR + dofnameT="GLOBAL_ID"//C_NULL_CHAR + orderT = 1 ! not much arguing + fNoBubble = 1 + monotonicity = 0 ! + noConserve = 0 + validate = 1 + fInverseDistanceMap = 0 + if (iamroot_CPLID) then + write(logunit,*) subname, 'launch iMOAB weights with args ', 'mbintxal=', mbintxal, ' wgtIdef=', wgtIdef, & + 'dm1=', trim(dm1), ' orderS=', orderS, 'dm2=', trim(dm2), ' orderT=', orderT, & + fNoBubble, monotonicity, volumetric, fInverseDistanceMap, & + noConserve, validate, & + trim(dofnameS), trim(dofnameT) + endif + ierr = iMOAB_ComputeScalarProjectionWeights ( mbintxal, wgtIdef, & + trim(dm1), orderS, trim(dm2), orderT, & + fNoBubble, monotonicity, volumetric, fInverseDistanceMap, & + noConserve, validate, & + trim(dofnameS), trim(dofnameT) ) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in computing weights for atm-lnd ' + call shr_sys_abort(subname//' ERROR in computing weights for atm-lnd ') + endif + + + + + + else ! the same mesh , atm and lnd use the same dofs, but lnd is a subset of atm + ! we do not compute intersection, so we will have to just send data from atm to land and viceversa, by GLOBAL_ID matching + ! so we compute just a comm graph, between atm and lnd dofs, on the coupler; target is lnd + ! land is point cloud in this case, type1 = 2 + + if (atm_pg_active) then + type1 = 3; ! fv for atm; cgll does not work anyway + else + type1 = 1 ! this projection works (cgll to fv), but reverse does not ( fv - cgll) + endif + type2 = 2; ! point cloud for target lnd in this case + ierr = iMOAB_ComputeCommGraph( mbaxid, mblxid, mpicom_CPLID, mpigrp_CPLID, mpigrp_CPLID, type1, type2, & + atm(1)%cplcompid, lnd(1)%cplcompid) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in computing comm graph for second hop, atm-lnd' + call shr_sys_abort(subname//' ERROR in computing comm graph for second hop, atm-lnd') + endif + + endif ! if tri-grid + + ! use the same map for fluxes too + mapper_Fa2l%src_mbid = mbaxid + mapper_Fa2l%tgt_mbid = mblxid + mapper_Fa2l%src_mbid = mbintxal + mapper_Fa2l%src_context = lnd(1)%cplcompid + mapper_Fa2l%intx_context = idintx + wgtIdef = 'scalar'//C_NULL_CHAR + mapper_Fa2l%weight_identifier = wgtIdef + + + ! in any case, we need to define the tags on landx from the phys atm seq_flds_a2x_fields + tagtype = 1 ! dense, double + numco = 1 ! one value per vertex / entity + tagname = trim(seq_flds_a2x_fields)//C_NULL_CHAR + ierr = iMOAB_DefineTagStorage(mblxid, tagname, tagtype, numco, tagindex ) + if ( ierr > 0) then + call shr_sys_abort(subname//' fail to define seq_flds_a2x_fields for lnd x moab mesh ') + endif + + endif ! if ((mbaxid .ge. 0) .and. (mblxid .ge. 0) ) then + + +#endif endif call shr_sys_flush(logunit) @@ -233,9 +389,7 @@ subroutine prep_lnd_init(infodata, atm_c2_lnd, rof_c2_lnd, glc_c2_lnd, iac_c2_ln call shr_sys_flush(logunit) end if -#ifdef MOABDEBUG - number_calls = 0 ! it is a static variable, used to count the number of projections -#endif + end subroutine prep_lnd_init !================================================================================================ @@ -565,218 +719,4 @@ function prep_lnd_get_mapper_Fg2l() prep_lnd_get_mapper_Fg2l => mapper_Fg2l end function prep_lnd_get_mapper_Fg2l - ! moved from prep_atm - subroutine prep_atm_lnd_moab(infodata) - - use iMOAB, only: iMOAB_CoverageGraph, iMOAB_ComputeScalarProjectionWeights, iMOAB_ComputeCommGraph - use iMOAB, only: iMOAB_DefineTagStorage - !--------------------------------------------------------------- - ! Description - ! If the land is on the same mesh as atm, we do not need to compute intx - ! Just use compute graph between phys atm and lnd on coupler, to be able to send - ! data from atm phys to atm on coupler for projection on land - ! in the tri-grid case, atm and land use different meshes, so use coverage anyway - ! - ! Arguments - type(seq_infodata_type) , intent(in) :: infodata - - character(*), parameter :: subname = '(prep_atm_lnd_moab)' - integer :: ierr - - logical :: atm_present ! .true. => atm is present - logical :: lnd_present ! .true. => lnd is present - integer :: id_join - integer :: mpicom_join - integer :: context_id ! used to define context for coverage (this case, land on coupler) - integer :: atm_id - character*32 :: dm1, dm2, dofnameATM, dofnameLND, wgtIdef - integer :: orderLND, orderATM, volumetric, fInverseDistanceMap, noConserve, validate - integer :: fNoBubble, monotonicity - integer :: mpigrp_CPLID ! coupler pes group, used for comm graph phys <-> atm-ocn - integer :: mpigrp_old ! component group pes (phys grid atm) == atm group - integer :: typeA, typeB ! type for computing graph; - integer :: idintx ! in this case, id of moab intersection between atm and lnd, on coupler pes - ! used only for tri-grid case - integer :: tagtype, numco, tagindex - character(CXX) :: tagname ! will store all seq_flds_a2x_fields - character(CL) :: atm_gnam ! atm grid - character(CL) :: lnd_gnam ! lnd grid - logical :: samegrid_al - - call seq_infodata_getData(infodata, & - atm_present=atm_present, & - lnd_present=lnd_present, & - atm_gnam=atm_gnam, & - lnd_gnam=lnd_gnam) - - samegrid_al = .true. - if (trim(atm_gnam) /= trim(lnd_gnam)) samegrid_al = .false. - ! it involves initial atm app; mhid; or pg2 mesh , in case atm_pg_active also migrate atm mesh on coupler pes, mbaxid - ! intx lnd atm are in mbintxla ; remapper also has some info about coverage mesh - ! after this, the sending of tags from atm pes to coupler pes, in land context will use the new par - ! comm graph, that has more precise info about - ! how to get mpicomm for joint atm + coupler - id_join = atm(1)%cplcompid - atm_id = atm(1)%compid - ! maybe we can use a moab-only id, defined like mbintxao, mhid, somewhere else (seq_comm_mct) - ! we cannot use mbintxla because it may not exist on atm comp yet; - context_id = lnd(1)%cplcompid - call seq_comm_getinfo(ID_join,mpicom=mpicom_join) - if ( .not. samegrid_al ) then - if (atm_pg_active ) then ! use mhpgid mesh - ierr = iMOAB_CoverageGraph(mpicom_join, mhpgid, mbaxid, mbintxla, atm_id, id_join, context_id); - else - ierr = iMOAB_CoverageGraph(mpicom_join, mhid, mbaxid, mbintxla, atm_id, id_join, context_id); - endif - else - ! this is the moment we compute the comm graph between phys grid atm and land on coupler pes. - ! We do not need to compute intersection in this case, as the DOFs are exactly the same - ! see imoab_phatm_ocn_coupler.cpp in MOAB source code, no intx needed, just compute graph - typeA = 2 ! point cloud - typeB = 2 ! - call seq_comm_getinfo(CPLID ,mpigrp=mpigrp_CPLID) ! second group, the coupler group CPLID is global variable - call seq_comm_getinfo(atm_id, mpigrp=mpigrp_old) - ! context_id = lnd(1)%cplcompid - ierr = iMOAB_ComputeCommGraph( mphaid, mblxid, mpicom_join, mpigrp_old, mpigrp_CPLID, & - typeA, typeB, atm_id, context_id) - if (ierr .ne. 0) then - write(logunit,*) subname,' error in computing graph phys grid - lnd on coupler ' - call shr_sys_abort(subname//' ERROR in computing graph phys grid - lnd on coupler ') - endif - - endif - if (ierr .ne. 0) then - write(logunit,*) subname,' error in computing coverage graph atm/lnd ' - call shr_sys_abort(subname//' ERROR in computing coverage graph atm/lnd ') - endif - - ! this is true only for tri-grid cases - if (mbintxla .ge. 0 ) then ! weights are computed over coupler pes - ! copy from atm - ocn , it is now similar, as land is full mesh, not pc cloud - wgtIdef = 'scalar'//C_NULL_CHAR - volumetric = 0 ! TODO: check this , for PC ; for imoab_coupler test, volumetric is 0 - if (atm_pg_active) then - dm1 = "fv"//C_NULL_CHAR - dofnameATM="GLOBAL_ID"//C_NULL_CHAR - orderATM = 1 ! fv-fv - else - dm1 = "cgll"//C_NULL_CHAR - dofnameATM="GLOBAL_DOFS"//C_NULL_CHAR - orderATM = np ! it should be 4 - volumetric = 1 - endif - - dofnameLND="GLOBAL_ID"//C_NULL_CHAR - orderLND = 1 ! not much arguing - - ! is the land mesh explicit or point cloud ? based on samegrid_al flag: - if (samegrid_al) then - dm2 = "pcloud"//C_NULL_CHAR - wgtIdef = 'scalar-pc'//C_NULL_CHAR - else - dm2 = "fv"//C_NULL_CHAR ! land is FV - endif - fNoBubble = 1 - monotonicity = 0 ! - noConserve = 0 - validate = 0 - fInverseDistanceMap = 0 - - ierr = iMOAB_ComputeScalarProjectionWeights ( mbintxla, wgtIdef, & - trim(dm1), orderATM, trim(dm2), orderLND, & - fNoBubble, monotonicity, volumetric, fInverseDistanceMap, & - noConserve, validate, & - trim(dofnameATM), trim(dofnameLND) ) - if (ierr .ne. 0) then - write(logunit,*) subname,' error in computing weights atm land ' - call shr_sys_abort(subname//' ERROR in computing weights atm land') - endif - endif - ! we will use intx atm-lnd mesh only when land is explicit - if (.not. samegrid_al) then - ! as with ocn, data is sent from atm ph to the intx atm/lnd, not from pg2 mesh anymore - ! for that, we will use the comm graph between atm ph and atm pg2 intersected with land! - ! copy from ocn logic, just replace with land - ! compute the comm graph between phys atm and intx-atm-lnd, to be able to send directly from phys atm - ! towards coverage mesh on atm for intx to land / now that land is full mesh! - ! this is similar to imoab_phatm_ocn_coupler.cpp test in moab - ! int typeA = 2; // point cloud - call seq_comm_getinfo(CPLID ,mpigrp=mpigrp_CPLID) ! second group, the coupler group CPLID is global variable - call seq_comm_getinfo(atm_id, mpigrp=mpigrp_old) ! component group pes, from atm id ( also ATMID(1) ) - - typeA = 2 ! point cloud, phys atm in this case - ! idintx is a unique number of MOAB app that takes care of intx between lnd and atm mesh - idintx = 100*atm(1)%cplcompid + lnd(1)%cplcompid ! something different, to differentiate it; ~ 600+lnd ! - if (atm_pg_active) then - typeB = 3 ! fv on atm side too !! imoab_apg2_ol coupler example - ! atm cells involved in intersection (pg 2 in this case) - ! this will be used now to send - ! data from phys grid directly to atm-lnd intx , for later projection - ! context is the same, atm - lnd intx id ! - - else - typeB = 1 ! atm cells involved in intersection (spectral in this case) ! this will be used now to send - ! data from phys grid directly to atm-lnd intx , for later projection - ! context is the same, atm - lnd intx id ! - endif - ierr = iMOAB_ComputeCommGraph( mphaid, mbintxla, mpicom_join, mpigrp_old, mpigrp_CPLID, & - typeA, typeB, atm_id, idintx) - if (ierr .ne. 0) then - write(logunit,*) subname,' error in computing graph phys grid - atm/lnd intx ' - call shr_sys_abort(subname//' ERROR in computing graph phys grid - atm/ocn intx ') - endif - endif ! if (.not. samegrid_al) - - if (mblxid .ge. 0) then - ! in any case, we need to define the tags on landx from the phys atm seq_flds_a2x_fields - tagtype = 1 ! dense, double - numco = 1 ! one value per vertex / entity - tagname = trim(seq_flds_a2x_fields)//C_NULL_CHAR - ierr = iMOAB_DefineTagStorage(mblxid, tagname, tagtype, numco, tagindex ) - if ( ierr > 0) then - call shr_sys_abort(subname//' fail to define seq_flds_a2x_fields for lnd x moab mesh ') - endif - endif - - end subroutine prep_atm_lnd_moab - - ! exposed method to migrate projected tag from coupler pes back to land pes - subroutine prep_lnd_migrate_moab(infodata) - - use iMOAB, only: iMOAB_SendElementTag, iMOAB_ReceiveElementTag, iMOAB_FreeSenderBuffers, & - iMOAB_WriteMesh - !--------------------------------------------------------------- - ! Description - ! After a2lTbot_proj, a2lVbot_proj, a2lUbot_proj were computed on lnd mesh on coupler, they need - ! to be migrated to the land pes - ! maybe the land solver will use it (later)? - ! Arguments - type(seq_infodata_type) , intent(in) :: infodata - - integer :: ierr - - logical :: atm_present ! .true. => atm is present - logical :: lnd_present ! .true. => lnd is present - integer :: id_join - integer :: mpicom_join - integer :: lndid1 - integer :: context_id - character*32 :: dm1, dm2 - character*50 :: tagName - character*32 :: outfile, wopts, lnum - integer :: orderLND, orderATM, volumetric, noConserve, validate - - call seq_infodata_getData(infodata, & - atm_present=atm_present, & - lnd_present=lnd_present) - - ! it involves initial ocn app; mpoid; also migrated ocn mesh mesh on coupler pes, mbaxid - ! after this, the sending of tags from coupler pes to ocn pes will use initial graph - ! (not processed for coverage) - ! how to get mpicomm for joint ocn + coupler - id_join = lnd(1)%cplcompid - lndid1 = lnd(1)%compid - - end subroutine prep_lnd_migrate_moab - end module prep_lnd_mod diff --git a/driver-moab/main/prep_ocn_mod.F90 b/driver-moab/main/prep_ocn_mod.F90 index 8e992c2aa751..c86362c45fee 100644 --- a/driver-moab/main/prep_ocn_mod.F90 +++ b/driver-moab/main/prep_ocn_mod.F90 @@ -23,8 +23,7 @@ module prep_ocn_mod use seq_comm_mct, only : mhid ! iMOAB id for atm instance use seq_comm_mct, only : mhpgid ! iMOAB id for atm pgx grid, on atm pes; created with se and gll grids use dimensions_mod, only : np ! for atmosphere degree - use seq_comm_mct, only : mphaid ! iMOAB id for phys atm on atm pes - use seq_comm_mct, only : mpsiid ! iMOAB id for sea-ice, mpas model + use seq_comm_mct, only : mbixid ! iMOAB for sea-ice migrated to coupler use seq_comm_mct, only : CPLALLICEID use seq_comm_mct, only : seq_comm_iamin use seq_comm_mct, only : num_moab_exports @@ -62,10 +61,8 @@ module prep_ocn_mod public :: prep_ocn_accum_avg public :: prep_ocn_calc_a2x_ox - public :: prep_ocn_calc_a2x_ox_moab public :: prep_ocn_calc_i2x_ox - public :: prep_ocn_calc_i2x_ox_moab public :: prep_ocn_calc_r2x_ox public :: prep_ocn_calc_g2x_ox public :: prep_ocn_shelf_calc_g2x_ox @@ -97,7 +94,6 @@ module prep_ocn_mod public :: prep_ocn_get_mapper_Fg2o public :: prep_ocn_get_mapper_Sw2o - public :: prep_atm_ocn_moab, prep_ice_ocn_moab, prep_ocn_migrate_moab !-------------------------------------------------------------------------- ! Private interfaces !-------------------------------------------------------------------------- @@ -166,7 +162,7 @@ subroutine prep_ocn_init(infodata, atm_c2_ocn, atm_c2_ice, ice_c2_ocn, rof_c2_oc wav_c2_ocn, glc_c2_ocn, glcshelf_c2_ocn) use iMOAB, only: iMOAB_ComputeMeshIntersectionOnSphere, iMOAB_RegisterApplication, & - iMOAB_WriteMesh + iMOAB_WriteMesh, iMOAB_DefineTagStorage, iMOAB_ComputeCommGraph, iMOAB_ComputeScalarProjectionWeights !--------------------------------------------------------------- ! Description ! Initialize module attribute vectors and all other non-mapping @@ -206,11 +202,22 @@ subroutine prep_ocn_init(infodata, atm_c2_ocn, atm_c2_ice, ice_c2_ocn, rof_c2_oc character(*), parameter :: F00 = "('"//subname//" : ', 4A )" character(*), parameter :: F01 = "('"//subname//" : ', A, I8 )" - character*32 :: appname ! to register moab app + ! MOAB stuff + integer :: ierr, idintx, rank + character*32 :: appname, outfile, wopts, lnum + character*32 :: dm1, dm2, dofnameS, dofnameT, wgtIdef + integer :: orderS, orderT, volumetric, noConserve, validate, fInverseDistanceMap + integer :: fNoBubble, monotonicity +! will do comm graph over coupler PES, in 2-hop strategy + integer :: mpigrp_CPLID ! coupler pes group, used for comm graph phys <-> atm-ocn + + integer :: type1, type2 ! type for computing graph; should be the same type for ocean, 3 (FV) + integer :: tagtype, numco, tagindex + character(CXX) :: tagName + integer :: rmapid ! external id to identify the moab app - integer :: ierr, type_grid ! - integer :: idintx, rank - character*32 :: outfile, wopts, lnum + integer :: type_grid ! + !--------------------------------------------------------------- @@ -320,6 +327,7 @@ subroutine prep_ocn_init(infodata, atm_c2_ocn, atm_c2_ice, ice_c2_ocn, rof_c2_oc 'seq_maps.rc','atm2ocn_fmapname:','atm2ocn_fmaptype:',samegrid_ao, & 'mapper_Fa2o initialization',esmf_map_flag) call shr_sys_flush(logunit) +#ifdef HAVE_MOAB ! Call moab intx only if atm and ocn are init in moab if ((mbaxid .ge. 0) .and. (mboxid .ge. 0)) then appname = "ATM_OCN_COU"//C_NULL_CHAR @@ -338,6 +346,81 @@ subroutine prep_ocn_init(infodata, atm_c2_ocn, atm_c2_ice, ice_c2_ocn, rof_c2_oc if (iamroot_CPLID) then write(logunit,*) 'iMOAB intersection between atm and ocean with id:', idintx end if + + + ! we also need to compute the comm graph for the second hop, from the atm on coupler to the + ! atm for the intx atm-ocn context (coverage) + ! + call seq_comm_getinfo(CPLID ,mpigrp=mpigrp_CPLID) + if (atm_pg_active) then + type1 = 3; ! fv for both ocean and atm; fv-cgll does not work anyway + else + type1 = 1 ! this works in this direction, but it will not be used + endif + type2 = 3; + ! ierr = iMOAB_ComputeCommGraph( mboxid, mbintxoa, &mpicom_CPLID, &mpigrp_CPLID, &mpigrp_CPLID, &type1, &type2, + ! &ocn_id, &idintx) + ierr = iMOAB_ComputeCommGraph( mbaxid, mbintxao, mpicom_CPLID, mpigrp_CPLID, mpigrp_CPLID, type1, type2, & + atm(1)%cplcompid, idintx) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in computing comm graph for second hop, atm-ocn' + call shr_sys_abort(subname//' ERROR in computing comm graph for second hop, atm-ocn') + endif + ! now take care of the mapper + mapper_Fa2o%src_mbid = mbaxid + mapper_Fa2o%tgt_mbid = mboxid + mapper_Fa2o%intx_mbid = mbintxao + mapper_Fa2o%src_context = atm(1)%cplcompid + mapper_Fa2o%intx_context = idintx + wgtIdef = 'scalar'//C_NULL_CHAR + mapper_Fa2o%weight_identifier = wgtIdef + ! because we will project fields from atm to ocn grid, we need to define + ! atm a2x fields to ocn grid on coupler side + + tagname = trim(seq_flds_a2x_fields)//C_NULL_CHAR + tagtype = 1 ! dense + numco = 1 ! + ierr = iMOAB_DefineTagStorage(mboxid, tagname, tagtype, numco, tagindex ) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in defining tags for seq_flds_a2x_fields on ocn cpl' + call shr_sys_abort(subname//' ERROR in coin defining tags for seq_flds_a2x_fields on ocn cpl') + endif + volumetric = 0 ! can be 1 only for FV->DGLL or FV->CGLL; + + if (atm_pg_active) then + dm1 = "fv"//C_NULL_CHAR + dofnameS="GLOBAL_ID"//C_NULL_CHAR + orderS = 1 ! fv-fv + else + dm1 = "cgll"//C_NULL_CHAR + dofnameS="GLOBAL_DOFS"//C_NULL_CHAR + orderS = np ! it should be 4 + endif + dm2 = "fv"//C_NULL_CHAR + dofnameT="GLOBAL_ID"//C_NULL_CHAR + orderT = 1 ! not much arguing + fNoBubble = 1 + monotonicity = 0 ! + noConserve = 0 + validate = 1 + fInverseDistanceMap = 0 + if (iamroot_CPLID) then + write(logunit,*) subname, 'launch iMOAB weights with args ', 'mbintxao=', mbintxao, ' wgtIdef=', wgtIdef, & + 'dm1=', trim(dm1), ' orderS=', orderS, 'dm2=', trim(dm2), ' orderT=', orderT, & + fNoBubble, monotonicity, volumetric, fInverseDistanceMap, & + noConserve, validate, & + trim(dofnameS), trim(dofnameT) + endif + ierr = iMOAB_ComputeScalarProjectionWeights ( mbintxao, wgtIdef, & + trim(dm1), orderS, trim(dm2), orderT, & + fNoBubble, monotonicity, volumetric, fInverseDistanceMap, & + noConserve, validate, & + trim(dofnameS), trim(dofnameT) ) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in computing ao weights ' + call shr_sys_abort(subname//' ERROR in computing ao weights ') + endif + #ifdef MOABDEBUG wopts = C_NULL_CHAR call shr_mpi_commrank( mpicom_CPLID, rank ) @@ -351,9 +434,10 @@ subroutine prep_ocn_init(infodata, atm_c2_ocn, atm_c2_ice, ice_c2_ocn, rof_c2_oc endif endif #endif - end if - - end if + end if ! if ((mbaxid .ge. 0) .and. (mboxid .ge. 0)) +! endif HAVE_MOAB +#endif + end if ! if (atm_present) ! atm_c2_ice flag is here because ice and ocn are constrained to be on the same ! grid so the atm->ice mapping is set to the atm->ocn mapping to improve performance @@ -379,7 +463,28 @@ subroutine prep_ocn_init(infodata, atm_c2_ocn, atm_c2_ice, ice_c2_ocn, rof_c2_oc write(logunit,F00) 'Initializing mapper_Va2o vect with vect_map = ',trim(vect_map) end if call seq_map_initvect(mapper_Va2o, vect_map, atm(1), ocn(1), string='mapper_Va2o initvect') - endif + + ! will use the same map for mapper_Sa2o and Va2o, although it is using bilinear option + ! in seq_maps.rc + if ((mbaxid .ge. 0) .and. (mboxid .ge. 0)) then + ! now take care of the 2 new mappers + mapper_Sa2o%src_mbid = mbaxid + mapper_Sa2o%tgt_mbid = mboxid + mapper_Sa2o%intx_mbid = mbintxao + mapper_Sa2o%src_context = atm(1)%cplcompid + mapper_Sa2o%intx_context = idintx + wgtIdef = 'scalar'//C_NULL_CHAR + mapper_Sa2o%weight_identifier = wgtIdef + + mapper_Va2o%src_mbid = mbaxid + mapper_Va2o%tgt_mbid = mboxid + mapper_Va2o%intx_mbid = mbintxao + mapper_Va2o%src_context = atm(1)%cplcompid + mapper_Va2o%intx_context = idintx + wgtIdef = 'scalar'//C_NULL_CHAR + mapper_Va2o%weight_identifier = wgtIdef + endif ! if ((mbaxid .ge. 0) .and. (mboxid .ge. 0)) + endif ! if (atm_c2_ocn .or. atm_c2_ice) call shr_sys_flush(logunit) ! needed for domain checking @@ -389,7 +494,45 @@ subroutine prep_ocn_init(infodata, atm_c2_ocn, atm_c2_ice, ice_c2_ocn, rof_c2_oc write(logunit,F00) 'Initializing mapper_SFi2o' end if call seq_map_init_rearrolap(mapper_SFi2o, ice(1), ocn(1), 'mapper_SFi2o') - endif +#ifdef HAVE_MOAB + if ( (mbixid .ge. 0) .and. (mboxid .ge. 0)) then + ! moab also will do just a rearrange, hopefully, in this case, based on the comm graph + ! that is computed here + call seq_comm_getinfo(CPLID ,mpigrp=mpigrp_CPLID) ! second group, the coupler group CPLID is global variable + + type1 = 3 + type2 = 3 ! fv-fv graph + + ! imoab compute comm graph ice-ocn, based on the same global id + ! it will be a simple migrate from ice mesh directly to ocean, using the comm graph computed here + + ierr = iMOAB_ComputeCommGraph( mbixid, mboxid, mpicom_CPLID, mpigrp_CPLID, mpigrp_CPLID, & + type1, type2, ice(1)%cplcompid, ocn(1)%cplcompid) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in computing graph ice - ocn x ' + call shr_sys_abort(subname//' ERROR in computing graph ice - ocn x ') + endif + + + ! define tags according to the seq_flds_i2x_fields + tagtype = 1 ! dense, double + numco = 1 ! one value per cell / entity + tagname = trim(seq_flds_i2x_fields)//C_NULL_CHAR + ierr = iMOAB_DefineTagStorage(mboxid, tagname, tagtype, numco, tagindex ) + if ( ierr == 1 ) then + call shr_sys_abort( subname//' ERROR: cannot define tags for ice proj to ocn' ) + end if + mapper_SFi2o%src_mbid = mbixid + mapper_SFi2o%tgt_mbid = mboxid + ! no intersection, so will have to do without it + mapper_Va2o%src_context = ice(1)%cplcompid + mapper_Va2o%intx_context = ocn(1)%cplcompid + + endif + +#endif + + endif ! if (ice_present) call shr_sys_flush(logunit) if (rof_c2_ocn) then @@ -401,7 +544,6 @@ subroutine prep_ocn_init(infodata, atm_c2_ocn, atm_c2_ice, ice_c2_ocn, rof_c2_oc 'seq_maps.rc', 'rof2ocn_liq_rmapname:', 'rof2ocn_liq_rmaptype:',samegrid_ro, & 'mapper_Rr2o_liq initialization',esmf_map_flag) - appname = "ROF_OCN_COU"//CHAR(0) ! rmapid is a unique external number of MOAB app that takes care of map between rof and ocn mesh rmapid = 100*rof(1)%cplcompid + ocn(1)%cplcompid ! something different, to differentiate it @@ -2140,187 +2282,6 @@ subroutine prep_ocn_calc_a2x_ox(timer) end subroutine prep_ocn_calc_a2x_ox -subroutine prep_ocn_calc_a2x_ox_moab(timer, infodata) - ! start copy from prep_atm_migrate_moab - use iMOAB, only: iMOAB_SendElementTag, iMOAB_ReceiveElementTag, iMOAB_FreeSenderBuffers, & - iMOAB_ApplyScalarProjectionWeights, iMOAB_WriteMesh - !--------------------------------------------------------------- - - ! Arguments - character(len=*) , intent(in) :: timer - - type(seq_infodata_type) , intent(in) :: infodata - ! - ! Local Variables - type(mct_avect), pointer :: a2x_ax - character(*), parameter :: subname = '(prep_ocn_calc_a2x_ox_moab)' - - - integer :: ierr - - logical :: atm_present ! .true. => atm is present - logical :: ocn_present ! .true. => ocn is present - logical :: ocn_prognostic ! .true. => ocn is prognostic - integer :: id_join - integer :: mpicom_join - integer :: atm_id - integer :: context_id ! we will use ocean context - character*32 :: dm1, dm2, wgtIdef - character*50 :: outfile, wopts, lnum - character(CXX) :: tagName, tagnameProj, tagNameExt - !--------------------------------------------------------------- - - call t_drvstartf (trim(timer),barrier=mpicom_CPLID) - - a2x_ax => component_get_c2x_cx(atm(1)) ! is this needed? just to see if we have data on here - - call seq_infodata_getData(infodata, & - atm_present=atm_present, & - ocn_present=ocn_present, & - ocn_prognostic=ocn_prognostic) - - ! it involves initial atm app; mhid; also migrate atm mesh on coupler pes, mbaxid - ! intx ocean atm are in mbintxao ; remapper also has some info about coverage mesh - ! after this, the sending of tags from atm pes to coupler pes will use the new par comm graph, that has more precise info about - ! how to get mpicomm for joint atm + coupler - id_join = atm(1)%cplcompid - atm_id = atm(1)%compid - - call seq_comm_getinfo(ID_join,mpicom=mpicom_join) - - ! we should do this only if ocn_present - - context_id = ocn(1)%cplcompid - wgtIdef = 'scalar'//C_NULL_CHAR - - if (atm_present .and. ocn_present .and. ocn_prognostic) then - if (atm_pg_active ) then ! use data from AtmPhys mesh, but mesh from pg - ! in this case, we will send from phys grid directly to intx atm ocn context! - tagname=trim(seq_flds_a2x_fields)//C_NULL_CHAR - if (mphaid .ge. 0) then ! send because we are on atm pes, also mphaid >= 0 - context_id = 100*atm(1)%cplcompid + ocn(1)%cplcompid !send to atm/ocn intx ! ~ 618 - ierr = iMOAB_SendElementTag(mphaid, tagName, mpicom_join, context_id) - if (ierr .ne. 0) then - write(logunit,*) subname,' error in sending tag from phys atm to ocn atm intx ' - call shr_sys_abort(subname//' ERROR in sending tag from phys atm to ocn atm intx') - endif - - endif - if (mbintxao .ge. 0 ) then ! we are for sure on coupler pes! - ! context_id = atm(1)%cplcompid == atm_id above (5) - ! we use the same name as spectral case, even thought in pg2 case, the size of tag is 1, not 16 - ! in imoab_apg2_ol_coupler.cpp we use at this stage, receiver, the same name as sender, T_ph - ierr = iMOAB_ReceiveElementTag(mbintxao, tagName, mpicom_join, atm_id) - if (ierr .ne. 0) then - write(logunit,*) subname,' error in receiving tag from phys atm to ocn atm intx ' - call shr_sys_abort(subname//' ERROR in receiving tag from phys atm to ocn atm intx') - endif - - endif - ! we can now free the sender buffers - if (mhpgid .ge. 0) then - ierr = iMOAB_FreeSenderBuffers(mphaid, context_id) - if (ierr .ne. 0) then - write(logunit,*) subname,' error in freeing buffers' - call shr_sys_abort(subname//' ERROR in freeing buffers') - endif - endif - - if (mbintxao .ge. 0 ) then ! we are on coupler pes, for sure - ! we could apply weights; need to use the same weight identifier wgtIdef as when we generated it - ! hard coded now, it should be a runtime option in the future - - ierr = iMOAB_ApplyScalarProjectionWeights ( mbintxao, wgtIdef, tagName, tagName) - if (ierr .ne. 0) then - write(logunit,*) subname,' error in applying weights ' - call shr_sys_abort(subname//' ERROR in applying weights') - endif -#ifdef MOABDEBUG - ! we can also write the ocean mesh to file, just to see the projectd tag - ! write out the mesh file to disk - write(lnum,"(I0.2)")num_moab_exports - outfile = 'ocnCplProj'//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 - write(logunit,*) subname,' error in writing ocn mesh after projection ' - call shr_sys_abort(subname//' ERROR in writing ocn mesh after projection') - endif -#endif - !CHECKRC(ierr, "cannot receive tag values") - endif - - else ! original send from spectral elements is replaced by send from phys grid - ! this will be reworked for all fields, send from phys grid atm: - tagName = trim(seq_flds_a2x_fields)//C_NULL_CHAR ! they are exported on phys grid directly - tagNameExt = trim(seq_flds_a2x_ext_fields)//C_NULL_CHAR ! these are special moab tags - ! the separator will be ':' as in mct - - if (mphaid .ge. 0) then ! send because we are on atm pes - ! - context_id = 100*atm(1)%cplcompid + ocn(1)%cplcompid !send to atm/ocn intx ! ~ 618 - ierr = iMOAB_SendElementTag(mphaid, tagName, mpicom_join, context_id) - if (ierr .ne. 0) then - write(logunit,*) subname,' error in sending tag from atm spectral to ocn atm intx ' - call shr_sys_abort(subname//' ERROR in sending tag from atm spectral to ocn atm intx') - endif - endif - if (mbaxid .ge. 0 ) then ! we are on coupler pes, for sure - ! receive on atm on coupler pes, that was redistributed according to coverage - context_id = atm(1)%compid ! atm_id - ierr = iMOAB_ReceiveElementTag(mbintxao, tagNameExt, mpicom_join, context_id) - if (ierr .ne. 0) then - write(logunit,*) subname,' error in receiving tag from atm phys grid to ocn atm intx spectral ' - call shr_sys_abort(subname//' ERROR in receiving tag from atm phys grid to ocn atm intx spectral') - endif - endif - - ! we can now free the sender buffers - if (mphaid .ge. 0) then - context_id = 100*atm(1)%cplcompid + ocn(1)%cplcompid !send to atm/ocn intx ! ~ 618 - ierr = iMOAB_FreeSenderBuffers(mphaid, context_id) - if (ierr .ne. 0) then - write(logunit,*) subname,' error in freeing buffers ' - call shr_sys_abort(subname//' ERROR in freeing buffers') - endif - endif - ! we could do the projection now, on the ocean mesh, because we are on the coupler pes; - ! the actual migrate could happen later , from coupler pes to the ocean pes - if (mbintxao .ge. 0 ) then ! we are on coupler pes, for sure - ! we could apply weights; need to use the same weight identifier wgtIdef as when we generated it - ! hard coded now, it should be a runtime option in the future - - ierr = iMOAB_ApplyScalarProjectionWeights ( mbintxao, wgtIdef, tagNameExt, tagName) - if (ierr .ne. 0) then - write(logunit,*) subname,' error in applying weights ' - call shr_sys_abort(subname//' ERROR in applying weights') - endif -#ifdef MOABDEBUG - ! we can also write the ocean mesh to file, just to see the projectd tag - ! write out the mesh file to disk - write(lnum,"(I0.2)")num_moab_exports - outfile = 'ocnCplProj'//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 - write(logunit,*) subname,' error in writing ocn mesh after projection ' - call shr_sys_abort(subname//' ERROR in writing ocn mesh after projection') - endif -#endif - endif ! if (mbintxao .ge. 0 ) - !CHECKRC(ierr, "cannot receive tag values") - endif ! if (atp_pg_active) - - endif ! if atm and ocn - - ! end copy - - - call t_drvstopf (trim(timer)) - - end subroutine prep_ocn_calc_a2x_ox_moab - !================================================================================================ - subroutine prep_ocn_calc_i2x_ox(timer) !--------------------------------------------------------------- ! Description @@ -2344,70 +2305,6 @@ subroutine prep_ocn_calc_i2x_ox(timer) end subroutine prep_ocn_calc_i2x_ox - subroutine prep_ocn_calc_i2x_ox_moab() - !--------------------------------------------------------------- - ! Description - ! simply migrate tags to ocean, from ice model, using comm graph computed at prep_ocn_init - ! ierr = iMOAB_ComputeCommGraph( mpsiid, mboxid,... - ! - ! Local Variables - use iMOAB , only: iMOAB_SendElementTag, iMOAB_ReceiveElementTag, iMOAB_FreeSenderBuffers, iMOAB_WriteMesh - character(*), parameter :: subname = '(prep_ocn_calc_i2x_ox_moab)' - character(CXX) :: tagname - character*32 :: outfile, wopts, lnum - integer :: ocn_id_x, ice_id, id_join, mpicom_join, ierr, context_id - !--------------------------------------------------------------- - ocn_id_x = ocn(1)%cplcompid - ice_id = ice(1)%compid - - id_join = ice(1)%cplcompid - call seq_comm_getinfo(ID_join,mpicom=mpicom_join) - - ! send from sea ice to ocean - ! if we are on sea ice pes: - - tagName=trim(seq_flds_i2x_fields)//C_NULL_CHAR - if (mpsiid .ge. 0) then ! send because we are on ice pes - - context_id = ocn(1)%cplcompid - ierr = iMOAB_SendElementTag(mpsiid, tagName, mpicom_join, context_id) - if (ierr .ne. 0) then - write(logunit,*) subname,' error in sending tag for ice proj to ocean' - call shr_sys_abort(subname//' ERROR in sending tag for ice proj to ocean') - endif - endif - if (mboxid .ge. 0 ) then ! we are on coupler pes, for sure; no need to project anything - ! receive on ocn on coupler pes, from ice - context_id=ice(1)%compid - ierr = iMOAB_ReceiveElementTag(mboxid, tagName, mpicom_join, context_id) - if (ierr .ne. 0) then - write(logunit,*) subname,' error in receiving tag for ice-ocn proj' - call shr_sys_abort(subname//' ERROR in receiving tag for ice-ocn proj') - endif - endif - - - ! we can now free the sender buffers - if (mpsiid .ge. 0) then - context_id = ocn(1)%cplcompid - ierr = iMOAB_FreeSenderBuffers(mpsiid, context_id) - if (ierr .ne. 0) then - write(logunit,*) subname,' error in freeing buffers ice-ocn' - call shr_sys_abort(subname//' ERROR in freeing buffers ice-ocn') - endif - endif - -#ifdef MOABDEBUG - if (mboxid .ge. 0 ) then ! we are on coupler pes, for sure - write(lnum,"(I0.2)")num_moab_exports - outfile = 'OcnCplAftIce'//trim(lnum)//'.h5m'//C_NULL_CHAR - wopts = ';PARALLEL=WRITE_PART'//C_NULL_CHAR ! - ierr = iMOAB_WriteMesh(mboxid, trim(outfile), trim(wopts)) - endif -#endif - - end subroutine prep_ocn_calc_i2x_ox_moab - !================================================================================================ subroutine prep_ocn_calc_r2x_ox(timer) @@ -2620,259 +2517,4 @@ function prep_ocn_get_mapper_Sw2o() prep_ocn_get_mapper_Sw2o => mapper_Sw2o end function prep_ocn_get_mapper_Sw2o - - ! exposed method to migrate projected tag from coupler pes to ocean pes - subroutine prep_ocn_migrate_moab(infodata) - use iMOAB , only: iMOAB_SendElementTag, iMOAB_ReceiveElementTag, iMOAB_FreeSenderBuffers, iMOAB_WriteMesh - !--------------------------------------------------------------- - ! Description - ! After a2oTbot_proj, a2oVbot_proj, a2oUbot_proj were computed on ocn mesh on coupler, they need - ! to be migrated to the ocean pes - ! maybe the ocean solver will use it (later)? - ! in this method, ocn values on coupler pes from atm are moved to ocean pes - ! Arguments - type(seq_infodata_type) , intent(in) :: infodata - - integer :: ierr - - logical :: atm_present ! .true. => atm is present - logical :: ocn_present ! .true. => ocn is present - integer :: id_join - integer :: mpicom_join - integer :: ocnid1 - integer :: context_id - character*32 :: dm1, dm2 - character*50 :: tagName - character*32 :: outfile, wopts, lnum - integer :: orderOCN, orderATM, volumetric, noConserve, validate - - call seq_infodata_getData(infodata, & - atm_present=atm_present, & - ocn_present=ocn_present) - - ! it involves initial ocn app; mpoid; also migrated ocn mesh mesh on coupler pes, mbaxid - ! after this, the sending of tags from coupler pes to ocn pes will use initial graph - ! (not processed for coverage) - ! how to get mpicomm for joint ocn + coupler - id_join = ocn(1)%cplcompid - ocnid1 = ocn(1)%compid - - end subroutine prep_ocn_migrate_moab - - subroutine prep_atm_ocn_moab(infodata) - - use iMOAB, only: iMOAB_CoverageGraph, iMOAB_ComputeScalarProjectionWeights, & - iMOAB_ComputeCommGraph, iMOAB_DefineTagStorage - !--------------------------------------------------------------- - ! Description - ! After intersection of atm and ocean mesh, correct the communication graph - ! between atm instance and atm on coupler (due to coverage) - ! also, compute the map; this would be equivalent to seq_map_init_rcfile on the - ! mapping file computed offline (this will be now online) - ! - ! Arguments - type(seq_infodata_type) , intent(in) :: infodata - - character(*), parameter :: subname = '(prep_atm_ocn_moab)' - integer :: ierr - - logical :: atm_present ! .true. => atm is present - logical :: ocn_present ! .true. => ocn is present - logical :: ocn_prognostic ! .true. => ocn is present and expects input - integer :: id_join - integer :: mpicom_join - integer :: context_id ! used to define context for coverage (this case, ocean on coupler) - integer :: atm_id - character*32 :: dm1, dm2, dofnameATM, dofnameOCN, wgtIdef - integer :: orderOCN, orderATM, volumetric, noConserve, validate, fInverseDistanceMap - integer :: fNoBubble, monotonicity - - integer :: mpigrp_CPLID ! coupler pes group, used for comm graph phys <-> atm-ocn - integer :: mpigrp_old ! component group pes (phys grid atm) == atm group - integer :: typeA, typeB ! type for computing graph; - integer :: idintx ! in this case, id of moab intersection between atm and ocn, on coupler pes - - character(CXX) :: tagname - integer :: tagtype, numco, tagindex ! used to define tags - - - call seq_infodata_getData(infodata, & - atm_present=atm_present, & - ocn_present=ocn_present, & - ocn_prognostic=ocn_prognostic) - - ! it involves initial atm app; mhid; also migrate atm mesh on coupler pes, mbaxid - ! intx atm ocean are in mbintxao ; remapper also has some info about coverage mesh - ! after this, the sending of tags from atm pes to coupler pes will use the new par comm graph, that has more precise info about - ! how to get mpicomm for joint atm + coupler - id_join = atm(1)%cplcompid - atm_id = atm(1)%compid - ! maybe we can use a moab-only id, defined like mbintxao, mhid, somewhere else (seq_comm_mct) - ! we cannot use mbintxao because it may not exist on atm comp yet; - context_id = ocn(1)%cplcompid - call seq_comm_getinfo(ID_join,mpicom=mpicom_join) - - ! ! it happens over joint communicator, only if ocn_prognostic true - if (ocn_prognostic) then - - if (atm_pg_active ) then ! use mhpgid mesh - ierr = iMOAB_CoverageGraph(mpicom_join, mhpgid, mbaxid, mbintxao, atm_id, id_join, context_id); - if (iamroot_CPLID) then - write(logunit,*) 'iMOAB graph atmpg2-intxao context: ', context_id - end if - else - ierr = iMOAB_CoverageGraph(mpicom_join, mhid, mbaxid, mbintxao, atm_id, id_join, context_id); - if (iamroot_CPLID) then - write(logunit,*) 'iMOAB graph atmnp4-intxao context: ', context_id - end if - endif - if (ierr .ne. 0) then - write(logunit,*) subname,' error in computing coverage graph atm/ocn ' - call shr_sys_abort(subname//' ERROR in computing coverage graph atm/ocn ') - endif - endif - - if ( mbintxao .ge. 0 ) then - volumetric = 0 ! can be 1 only for FV->DGLL or FV->CGLL; - wgtIdef = 'scalar'//C_NULL_CHAR - if (atm_pg_active) then - dm1 = "fv"//C_NULL_CHAR - dofnameATM="GLOBAL_ID"//C_NULL_CHAR - orderATM = 1 ! fv-fv - else - dm1 = "cgll"//C_NULL_CHAR - dofnameATM="GLOBAL_DOFS"//C_NULL_CHAR - orderATM = np ! it should be 4 - endif - dm2 = "fv"//C_NULL_CHAR - dofnameOCN="GLOBAL_ID"//C_NULL_CHAR - orderOCN = 1 ! not much arguing - fNoBubble = 1 - monotonicity = 0 ! - noConserve = 0 - validate = 1 - fInverseDistanceMap = 0 - if (iamroot_CPLID) then - write(logunit,*) 'launch iMOAB weights with args ', mbintxao, wgtIdef, & - trim(dm1), orderATM, trim(dm2), orderOCN, & - fNoBubble, monotonicity, volumetric, fInverseDistanceMap, & - noConserve, validate, & - trim(dofnameATM), trim(dofnameOCN) - end if - ierr = iMOAB_ComputeScalarProjectionWeights ( mbintxao, wgtIdef, & - trim(dm1), orderATM, trim(dm2), orderOCN, & - fNoBubble, monotonicity, volumetric, fInverseDistanceMap, & - noConserve, validate, & - trim(dofnameATM), trim(dofnameOCN) ) - if (ierr .ne. 0) then - write(logunit,*) subname,' error in computing weights atm/ocn ' - call shr_sys_abort(subname//' ERROR in computing weights atm/ocn ') - endif - if (iamroot_CPLID) then - write(logunit,*) 'finish iMOAB weights in atm-ocn' - endif - ! define here the tags atm-ocn projection - ! define tags according to the seq_flds_a2x_fields - tagtype = 1 ! dense, double - numco = 1 ! one value per cell / entity - tagname = trim(seq_flds_a2x_fields)//C_NULL_CHAR - ierr = iMOAB_DefineTagStorage(mboxid, tagname, tagtype, numco, tagindex ) - if ( ierr == 1 ) then - call shr_sys_abort( subname//' ERROR: cannot define tags in moab' ) - end if - - endif ! only if atm and ocn intersect mbintxao >= 0 - - ! I removed comm graph computed for one hop, from atm phys to intxao - - ! compute the comm graph, used in a 2 hop migration, between atm grid on coupler and intx ao on coupler, - ! so first atm fields will be migrated to coupler, and then in another hop, distributed to the processors that actually need the - ! those degrees of freedom - ! start copy - ! compute the comm graph between atm on coupler side and intx-atm-ocn, to be able to send in a second hop - ! from atm to ocean - typeA = 3 ! (atm_pg_active) - typeB = 3 ! (atm_pg_active) - idintx = atm(1)%cplcompid * 100 + ocn(1)%cplcompid - call seq_comm_getinfo(CPLID ,mpigrp=mpigrp_CPLID) ! the coupler group CPLID is global variable - if (iamroot_CPLID) then - ! mpicom_CPLID is a module local variable, already initialized - write(logunit,*) 'launch iMOAB computecommgraph with args ', & - mbaxid, mbintxao, mpicom_CPLID, mpigrp_CPLID, mpigrp_CPLID, & - typeA, typeB, id_join, idintx - call shr_sys_flush(logunit) - end if - ! for these to work, we need to define the tags of size 16 (np x np) on coupler atm, - ! corresponding to this phys grid graph - if (mbaxid .ge. 0) then - ierr = iMOAB_ComputeCommGraph( mbaxid, mbintxao, mpicom_CPLID, mpigrp_CPLID, mpigrp_CPLID, & - typeA, typeB, id_join, idintx) - if (ierr .ne. 0) then - write(logunit,*) subname,' error in computing graph phys grid - atm/ocn intx ' - call shr_sys_abort(subname//' ERROR in computing graph phys grid - atm/ocn intx ') - endif - if (iamroot_CPLID) then - write(logunit,*) 'finish iMOAB graph in atm-ocn prep ' - end if - endif - - ! end copy - end subroutine prep_atm_ocn_moab - - subroutine prep_ice_ocn_moab(infodata) - - use iMOAB, only: iMOAB_ComputeCommGraph, iMOAB_DefineTagStorage - type(seq_infodata_type) , intent(in) :: infodata - - character(*), parameter :: subname = '(prep_ice_ocn_moab)' - - integer :: typeA, typeB ! type for computing graph; - integer :: ocn_id_x, ice_id, id_join, ierr - integer :: mpicom_join ! join comm between ice and coupler - character(CXX) :: tagname - integer :: tagtype, numco, tagindex ! used to define tags - integer :: mpigrp_CPLID ! coupler pes group - integer :: mpigrp_old ! component group pes (ice here) - logical :: ice_present, ocn_present, ocn_prognostic - - call seq_infodata_getData(infodata, & - ice_present=ice_present, & - ocn_present=ocn_present, & - ocn_prognostic=ocn_prognostic) - - if ( ice_present .and. ocn_present .and. ocn_prognostic ) then - - ocn_id_x = ocn(1)%cplcompid - ice_id = ice(1)%compid - - id_join = ice(1)%cplcompid - call seq_comm_getinfo(ID_join,mpicom=mpicom_join) ! joint comm over ice and coupler - call seq_comm_getinfo(CPLID ,mpigrp=mpigrp_CPLID) ! second group, the coupler group CPLID is global variable - call seq_comm_getinfo(ice_id, mpigrp=mpigrp_old) - typeA = 3 - typeB = 3 ! fv-fv graph - - ! imoab compute comm graph ice-ocn, based on the same global id - ! it will be a simple migrate from ice mesh directly to ocean, using the comm graph computed here - - ierr = iMOAB_ComputeCommGraph( mpsiid, mboxid, mpicom_join, mpigrp_old, mpigrp_CPLID, & - typeA, typeB, ice_id, ocn_id_x) - if (ierr .ne. 0) then - write(logunit,*) subname,' error in computing graph ice - ocn x ' - call shr_sys_abort(subname//' ERROR in computing graph ice - ocn x ') - endif - - if (mboxid .ge. 0) then ! we are on coupler pes, ocean app on coupler - ! define tags according to the seq_flds_i2x_fields - tagtype = 1 ! dense, double - numco = 1 ! one value per cell / entity - tagname = trim(seq_flds_i2x_fields)//C_NULL_CHAR - ierr = iMOAB_DefineTagStorage(mboxid, tagname, tagtype, numco, tagindex ) - if ( ierr == 1 ) then - call shr_sys_abort( subname//' ERROR: cannot define tags for ice proj to ocn' ) - end if - endif - endif - end subroutine prep_ice_ocn_moab - end module prep_ocn_mod diff --git a/driver-moab/main/seq_map_mod.F90 b/driver-moab/main/seq_map_mod.F90 index 5ea6afa0d649..efe2c4075217 100644 --- a/driver-moab/main/seq_map_mod.F90 +++ b/driver-moab/main/seq_map_mod.F90 @@ -366,7 +366,7 @@ subroutine seq_map_map( mapper, av_s, av_d, fldlist, norm, avwts_s, avwtsfld_s, #ifdef HAVE_MOAB ! check whether the application ID is defined on the current process - if ( mapper%src_mbid .lt. 0 .or. mapper%tgt_mbid .lt. 0 .or. mapper%intx_mbid .lt.0 ) then + if ( mapper%src_mbid .lt. 0 .or. mapper%tgt_mbid .lt. 0 ) then valid_moab_context = .FALSE. else valid_moab_context = .TRUE. @@ -459,44 +459,37 @@ subroutine seq_map_map( mapper, av_s, av_d, fldlist, norm, avwts_s, avwtsfld_s, #ifdef HAVE_MOAB if ( valid_moab_context ) then - ! first get data from source tag and store in a temporary - ! then set it back to target tag to mimic a copy - allocate(moab_tag_data(ntagdatalength)) + ! right now, this is used for ice-ocn projection, which involves just a send/recv, usually if (seq_comm_iamroot(CPLID)) then - write(logunit, *) subname,' iMOAB_mapper rearrange context TODO fix parcommgraph' + write(logunit, *) subname,' iMOAB rearrange mapper before sending ', trim(fldlist_moab) call shr_sys_flush(logunit) endif - - allocate(globalIds(mapper % nentities)) - ierr = iMOAB_GetIntTagStorage( mapper%src_mbid, & - 'GLOBAL_ID'//C_NULL_CHAR, & - mapper % nentities, & - mapper % tag_entity_type, & - globalIds ) - if (ierr > 0 ) & - call shr_sys_abort( subname//'MOAB Error: failed to get GLOBAL_ID tag ') - - ! this should set up a par comm graph in init, not use this - ierr = iMOAB_GetDoubleTagStorage( mapper%src_mbid, & - fldlist_moab, & - ntagdatalength, & - mapper % tag_entity_type, & - moab_tag_data ) - if (ierr > 0 ) & - call shr_sys_abort( subname//'MOAB Error: failed to get fields tag ') - - !! TODO: Compute a comm graph and store it so that it is used for application at runtime - ierr = iMOAB_SetDoubleTagStorageWithGid( mapper%tgt_mbid, & - fldlist_moab, & - ntagdatalength, & - mapper % tag_entity_type, & - moab_tag_data, & - globalIds ) - if (ierr > 0 ) & - call shr_sys_abort( subname//'MOAB Error: failed to set fields tag ') - - deallocate(globalIds) - deallocate(moab_tag_data) + ierr = iMOAB_SendElementTag( mapper%src_mbid, fldlist_moab, mapper%mpicom, mapper%intx_context ); + if (ierr .ne. 0) then + if (seq_comm_iamroot(CPLID)) then + write(logunit, *) subname,' iMOAB mapper error in sending tags ', trim(fldlist_moab) + call shr_sys_flush(logunit) + endif + valid_moab_context = .false. + endif + endif + if ( valid_moab_context ) then + if (seq_comm_iamroot(CPLID)) then + write(logunit, *) subname,' iMOAB mapper before receiving ', trim(fldlist_moab) + call shr_sys_flush(logunit) + endif + ! receive in the intx app, because it is redistributed according to coverage (trick) + ierr = iMOAB_ReceiveElementTag( mapper%tgt_mbid, fldlist_moab, mapper%mpicom, mapper%src_context ); + if (ierr .ne. 0) then + write(logunit,*) subname,' error in receiving tags ', trim(fldlist_moab) + !call shr_sys_abort(subname//' ERROR in receiving tags') + endif + ! now free buffers + ierr = iMOAB_FreeSenderBuffers( mapper%src_mbid, mapper%intx_context ) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in freeing buffers ', trim(fldlist_moab) + call shr_sys_abort(subname//' ERROR in freeing buffers') ! serious enough + endif endif #endif diff --git a/driver-moab/shr/seq_comm_mct.F90 b/driver-moab/shr/seq_comm_mct.F90 index 15e60e044547..f293ecac6cc1 100644 --- a/driver-moab/shr/seq_comm_mct.F90 +++ b/driver-moab/shr/seq_comm_mct.F90 @@ -227,6 +227,7 @@ module seq_comm_mct integer, public :: mblx2id ! iMOAB id for land mesh instanced from MCT on coupler pes integer, public :: mbox2id ! iMOAB id for ocn mesh instanced from MCT on coupler pes integer, public :: mbintxla ! iMOAB id for intx mesh between land and atmosphere + integer, public :: mbintxal ! iMOAB id for intx mesh between atmosphere and land integer, public :: mpsiid ! iMOAB id for sea-ice, mpas model integer, public :: mbixid ! iMOAB id for sea-ice migrated to coupler pes integer, public :: mbintxia ! iMOAB id for intx mesh between ice and atmosphere @@ -637,6 +638,7 @@ subroutine seq_comm_init(global_comm_in, driver_comm_in, nmlfile, drv_comm_id) mblxid = -1 ! iMOAB id for land on coupler pes mbox2id = -1 ! iMOAB id for ocn from mct on coupler pes mbintxla = -1 ! iMOAB id for land intx with atm on coupler pes + mbintxal = -1 ! iMOAB id for atm intx with lnd on coupler pes mpsiid = -1 ! iMOAB for sea-ice mbixid = -1 ! iMOAB for sea-ice migrated to coupler mbintxia = -1 ! iMOAB id for ice intx with atm on coupler pes From 5c75466c587d0ee49145fa660f83137aab099256 Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Fri, 16 Dec 2022 19:07:30 -0600 Subject: [PATCH 222/467] bugs in getting mpi group --- driver-moab/main/prep_lnd_mod.F90 | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) diff --git a/driver-moab/main/prep_lnd_mod.F90 b/driver-moab/main/prep_lnd_mod.F90 index a2203ac54717..4e80c163c51f 100644 --- a/driver-moab/main/prep_lnd_mod.F90 +++ b/driver-moab/main/prep_lnd_mod.F90 @@ -32,7 +32,8 @@ module prep_lnd_mod use iso_c_binding #ifdef HAVE_MOAB use iMOAB , only: iMOAB_ComputeCommGraph, iMOAB_ComputeMeshIntersectionOnSphere, & - iMOAB_ComputeScalarProjectionWeights, iMOAB_DefineTagStorage, iMOAB_RegisterApplication + iMOAB_ComputeScalarProjectionWeights, iMOAB_DefineTagStorage, iMOAB_RegisterApplication, & + iMOAB_WriteMesh #endif implicit none save @@ -242,7 +243,8 @@ subroutine prep_lnd_init(infodata, atm_c2_lnd, rof_c2_lnd, glc_c2_lnd, iac_c2_ln mapper_Sa2l%intx_context = idintx wgtIdef = 'scalar'//C_NULL_CHAR mapper_Sa2l%weight_identifier = wgtIdef - + + call seq_comm_getinfo(CPLID ,mpigrp=mpigrp_CPLID) if (.not. samegrid_al) then ! tri grid case if (iamroot_CPLID) then write(logunit,*) 'iMOAB intersection between atm and land with id:', idintx @@ -270,7 +272,7 @@ subroutine prep_lnd_init(infodata, atm_c2_lnd, rof_c2_lnd, glc_c2_lnd, iac_c2_ln ! we also need to compute the comm graph for the second hop, from the atm on coupler to the ! lnd for the intx atm-lnd context (coverage) ! - call seq_comm_getinfo(CPLID ,mpigrp=mpigrp_CPLID) + type1 = 1 ! this projection works (cgll to fv), but reverse does not ( fv - cgll) type2 = 3; ! land is fv in this case (separate grid) ! ierr = iMOAB_ComputeCommGraph( mboxid, mbintxoa, &mpicom_CPLID, &mpigrp_CPLID, &mpigrp_CPLID, &type1, &type2, From d52d4b40e2216f56def277d874b4704bd710ddc8 Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Tue, 20 Dec 2022 13:33:33 -0600 Subject: [PATCH 223/467] atmosphere merge --- driver-moab/main/cplcomp_exchange_mod.F90 | 18 +- driver-moab/main/prep_atm_mod.F90 | 515 +++++++++++++++++++++- driver-moab/main/prep_ocn_mod.F90 | 2 +- 3 files changed, 530 insertions(+), 5 deletions(-) diff --git a/driver-moab/main/cplcomp_exchange_mod.F90 b/driver-moab/main/cplcomp_exchange_mod.F90 index a6ab05da8e22..c4ea1b532b77 100644 --- a/driver-moab/main/cplcomp_exchange_mod.F90 +++ b/driver-moab/main/cplcomp_exchange_mod.F90 @@ -9,10 +9,10 @@ module cplcomp_exchange_mod use seq_map_type_mod use component_type_mod use seq_flds_mod, only: seq_flds_dom_coord, seq_flds_dom_other - use seq_flds_mod, only: seq_flds_a2x_ext_fields, seq_flds_a2x_fields ! + use seq_flds_mod, only: seq_flds_a2x_ext_fields, seq_flds_a2x_fields, seq_flds_x2a_fields ! use seq_flds_mod, only: seq_flds_o2x_fields ! needed for MOAB init of ocean fields o2x to be able to transfer to coupler use seq_flds_mod, only: seq_flds_x2o_fields ! needed for MOAB init of ocean fields x2o to be able to transfer from coupler - use seq_flds_mod, only: seq_flds_i2x_fields ! needed for MOAB init of ice fields x2o on coupler side, to save them + use seq_flds_mod, only: seq_flds_i2x_fields, seq_flds_x2i_fields ! needed for MOAB init of ice fields x2o on coupler side, to save them use seq_comm_mct, only: cplid, logunit use seq_comm_mct, only: seq_comm_getinfo => seq_comm_setptrs, seq_comm_iamin use seq_diag_mct @@ -1154,6 +1154,13 @@ subroutine cplcomp_moab_Init(comp) write(logunit,*) subname,' error in defining tags on atm on coupler ' call shr_sys_abort(subname//' ERROR in defining tags ') endif + tagname = trim(seq_flds_x2a_fields)//C_NULL_CHAR ! TODO should be also x2a_ext for spectral case + ierr = iMOAB_DefineTagStorage(mbaxid, tagname, tagtype, numco, tagindex ) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in defining tags seq_flds_x2a_fields on atm on coupler ' + call shr_sys_abort(subname//' ERROR in defining tags ') + endif + endif endif ! ocean @@ -1354,7 +1361,12 @@ subroutine cplcomp_moab_Init(comp) tagname = trim(seq_flds_i2x_fields)//C_NULL_CHAR ierr = iMOAB_DefineTagStorage(mbixid, tagname, tagtype, numco, tagindex ) if ( ierr == 1 ) then - call shr_sys_abort( subname//' ERROR: cannot define tags for ice proj to ocn' ) + call shr_sys_abort( subname//' ERROR: cannot define tags for ice on coupler' ) + end if + tagname = trim(seq_flds_x2i_fields)//C_NULL_CHAR + ierr = iMOAB_DefineTagStorage(mbixid, tagname, tagtype, numco, tagindex ) + if ( ierr == 1 ) then + call shr_sys_abort( subname//' ERROR: cannot define tags for ice on coupler' ) end if #ifdef MOABDEBUG ! debug test diff --git a/driver-moab/main/prep_atm_mod.F90 b/driver-moab/main/prep_atm_mod.F90 index e8263b45637e..a31a36278e28 100644 --- a/driver-moab/main/prep_atm_mod.F90 +++ b/driver-moab/main/prep_atm_mod.F90 @@ -35,6 +35,9 @@ module prep_atm_mod use seq_comm_mct, only : num_moab_exports use dimensions_mod, only : np ! for atmosphere +#ifdef MOABDEBUG + use component_type_mod, only: compare_mct_av_moab_tag +#endif use iso_c_binding @@ -98,6 +101,17 @@ module prep_atm_mod integer :: mpicom_CPLID ! MPI cpl communicator logical :: iamroot_CPLID ! .true. => CPLID masterproc +#ifdef HAVE_MOAB + real (kind=r8) , allocatable, private :: fractions_am (:,:) ! will retrieve the fractions from atm, and use them + ! they were init with + ! character(*),parameter :: fraclist_a = 'afrac:ifrac:ofrac:ifrad:ofrad' in moab, on the fractions + real (kind=r8) , allocatable, private :: x2a_am (:,:) + real (kind=r8) , allocatable, private :: l2x_am (:,:) + real (kind=r8) , allocatable, private :: i2x_am (:,:) + real (kind=r8) , allocatable, private :: o2x_am (:,:) + !real (kind=r8) , allocatable, private :: z2x_am (:,:) + real (kind=r8) , allocatable, private :: xao_am (:,:) ! ? +#endif !================================================================================================ contains @@ -409,7 +423,7 @@ subroutine prep_atm_init(infodata, ocn_c2_atm, ice_c2_atm, lnd_c2_atm, iac_c2_at tagname = trim(seq_flds_i2x_fields)//C_NULL_CHAR tagtype = 1 ! dense numco = 1 ! - ierr = iMOAB_DefineTagStorage(mbixid, tagname, tagtype, numco, tagindex ) + ierr = iMOAB_DefineTagStorage(mbaxid, tagname, tagtype, numco, tagindex ) if (ierr .ne. 0) then write(logunit,*) subname,' error in defining tags for seq_flds_i2x_fields' call shr_sys_abort(subname//' ERROR in coin defining tags for seq_flds_i2x_fields') @@ -581,6 +595,19 @@ subroutine prep_atm_init(infodata, ocn_c2_atm, ice_c2_atm, lnd_c2_atm, iac_c2_at endif endif ! if tri-grid + ! we still need to defne seq_flds_l2x_fields on atm cpl mesh + if (atm_pg_active) then + tagname = trim(seq_flds_l2x_fields)//C_NULL_CHAR + tagtype = 1 ! dense + numco = 1 ! + ierr = iMOAB_DefineTagStorage(mbaxid, tagname, tagtype, numco, tagindex ) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in defining tags for seq_flds_l2x_fields' + call shr_sys_abort(subname//' ERROR in coin defining tags for seq_flds_l2x_fields') + endif + else ! spectral case, TODO + tagtype = 1 ! dense + endif endif ! if ((mbaxid .ge. 0) .and. (mblxid .ge. 0) ) then #endif endif ! if lnd_present @@ -903,7 +930,493 @@ subroutine prep_atm_mrg_moab(infodata, xao_ax) type(seq_infodata_type) , intent(in) :: infodata type(mct_aVect) , pointer , intent(in) :: xao_ax(:) ! Atm-ocn fluxes, atm grid, cpl pes; used here just for indexing + ! Arguments + type(mct_aVect), pointer :: l2x_a ! needed just for indexing + type(mct_aVect), pointer :: o2x_a + type(mct_aVect), pointer :: i2x_a + type(mct_aVect), pointer :: xao_a + type(mct_aVect), pointer :: x2a_a + ! type(mct_aVect) :: fractions_a + + !type(mct_aVect), intent(inout) :: x2a_am + ! ! will build x2a_am , similar to x2a_ax + ! no averages, just one instance for atm + ! start copy from prep_atm_merge + ! + ! Local workspace + real(r8) :: fracl, fraci, fraco + integer :: n,ka,ki,kl,ko,kx,kof,kif,klf,i,i1,o1 + integer, save :: lsize + integer, save :: index_x2a_Sf_lfrac, index_x2a_Sf_ifrac, index_x2a_Sf_ofrac + + character(CL),allocatable :: field_atm(:) ! string converted to char + character(CL),allocatable :: field_lnd(:) ! string converted to char + character(CL),allocatable :: field_ice(:) ! string converted to char + character(CL),allocatable :: field_xao(:) ! string converted to char + character(CL),allocatable :: field_ocn(:) ! string converted to char + character(CL),allocatable :: itemc_atm(:) ! string converted to char + character(CL),allocatable :: itemc_lnd(:) ! string converted to char + character(CL),allocatable :: itemc_ice(:) ! string converted to char + character(CL),allocatable :: itemc_xao(:) ! string converted to char + character(CL),allocatable :: itemc_ocn(:) ! string converted to char + logical :: iamroot + character(CL),allocatable :: mrgstr(:) ! temporary string + logical, save :: first_time = .true. + type(mct_aVect_sharedindices),save :: l2x_sharedindices + type(mct_aVect_sharedindices),save :: o2x_sharedindices + type(mct_aVect_sharedindices),save :: i2x_sharedindices + type(mct_aVect_sharedindices),save :: xao_sharedindices + logical, pointer, save :: lmerge(:),imerge(:),xmerge(:),omerge(:) + integer, pointer, save :: lindx(:), iindx(:), oindx(:),xindx(:) + integer, save :: naflds, nlflds,niflds,noflds,nxflds + + integer nvert(3), nvise(3), nbl(3), nsurf(3), nvisBC(3) ! for moab info + character(CXX) ::tagname, mct_field + integer :: ent_type, ierr, arrsize +#ifdef MOABDEBUG + character*32 :: outfile, wopts, lnum + real(r8) :: difference + type(mct_list) :: temp_list + integer :: size_list, index_list + type(mct_string) :: mctOStr ! +#endif + + character(*), parameter :: subname = '(prep_atm_mrg_moab) ' + !----------------------------------------------------------------------- + ! + call seq_comm_getdata(CPLID, iamroot=iamroot) + + + + if (first_time) then + + ! find out the number of local elements in moab mesh atm instance on coupler + ! right now, we work only on FV mesh, which is a cell mesh + ! eventually we will fix spectral case too + ierr = iMOAB_GetMeshInfo ( mbaxid, nvert, nvise, nbl, nsurf, nvisBC ); + if (ierr .ne. 0) then + write(logunit,*) subname,' error in getting info ' + call shr_sys_abort(subname//' error in getting info ') + endif + lsize = nvise(1) ! number of active cells + ! mct avs are used just for their fields metadata, not the actual reals + ! (name of the fields) + ! need these always, not only the first time + l2x_a => l2x_ax(1) + i2x_a => i2x_ax(1) + o2x_a => o2x_ax(1) + xao_a => xao_ax(1) + x2a_a => component_get_x2c_cx(atm(1)) + naflds = mct_aVect_nRattr(x2a_a) + nlflds = mct_aVect_nRattr(l2x_a) + niflds = mct_aVect_nRattr(i2x_a) + noflds = mct_aVect_nRattr(o2x_a) + nxflds = mct_aVect_nRattr(xao_a) + index_x2a_Sf_lfrac = mct_aVect_indexRA(x2a_a,'Sf_lfrac') + index_x2a_Sf_ifrac = mct_aVect_indexRA(x2a_a,'Sf_ifrac') + index_x2a_Sf_ofrac = mct_aVect_indexRA(x2a_a,'Sf_ofrac') + + !ngflds = mct_aVect_nRattr(g2x_o) + allocate(fractions_am(lsize,5)) ! there are 5 fractions 'afrac:ifrac:ofrac:lfrac:lfrin' + allocate(x2a_am (lsize, naflds)) + allocate(o2x_am (lsize, noflds)) + allocate(i2x_am (lsize, niflds)) + allocate(l2x_am (lsize, nlflds)) + !allocate(r2x_om (lsize, nrflds)) + allocate(xao_am (lsize, nxflds)) + + + + allocate(lindx(naflds), lmerge(naflds)) + allocate(iindx(naflds), imerge(naflds)) + allocate(xindx(naflds), xmerge(naflds)) + allocate(oindx(naflds), omerge(naflds)) + allocate(field_atm(naflds), itemc_atm(naflds)) + allocate(field_lnd(nlflds), itemc_lnd(nlflds)) + allocate(field_ice(niflds), itemc_ice(niflds)) + allocate(field_ocn(noflds), itemc_ocn(noflds)) + allocate(field_xao(nxflds), itemc_xao(nxflds)) + allocate(mrgstr(naflds)) + + lindx(:) = 0 + iindx(:) = 0 + xindx(:) = 0 + oindx(:) = 0 + lmerge(:) = .true. + imerge(:) = .true. + xmerge(:) = .true. + omerge(:) = .true. + + do ka = 1,naflds + field_atm(ka) = mct_aVect_getRList2c(ka, x2a_a) + itemc_atm(ka) = trim(field_atm(ka)(scan(field_atm(ka),'_'):)) + enddo + do kl = 1,nlflds + field_lnd(kl) = mct_aVect_getRList2c(kl, l2x_a) + itemc_lnd(kl) = trim(field_lnd(kl)(scan(field_lnd(kl),'_'):)) + enddo + do ki = 1,niflds + field_ice(ki) = mct_aVect_getRList2c(ki, i2x_a) + itemc_ice(ki) = trim(field_ice(ki)(scan(field_ice(ki),'_'):)) + enddo + do ko = 1,noflds + field_ocn(ko) = mct_aVect_getRList2c(ko, o2x_a) + itemc_ocn(ko) = trim(field_ocn(ko)(scan(field_ocn(ko),'_'):)) + enddo + do kx = 1,nxflds + field_xao(kx) = mct_aVect_getRList2c(kx, xao_a) + itemc_xao(kx) = trim(field_xao(kx)(scan(field_xao(kx),'_'):)) + enddo + + call mct_aVect_setSharedIndices(l2x_a, x2a_a, l2x_SharedIndices) + call mct_aVect_setSharedIndices(o2x_a, x2a_a, o2x_SharedIndices) + call mct_aVect_setSharedIndices(i2x_a, x2a_a, i2x_SharedIndices) + call mct_aVect_setSharedIndices(xao_a, x2a_a, xao_SharedIndices) + + ! Field naming rules + ! Only atm states that are Sx_... will be merged + ! Only fluxes that are F??x_... will be merged + ! All fluxes will be multiplied by corresponding component fraction + + do ka = 1,naflds + !--- document merge --- + mrgstr(ka) = subname//'x2a%'//trim(field_atm(ka))//' =' + if (field_atm(ka)(1:2) == 'PF') then + cycle ! if flux has first character as P, pass straight through + endif + if (field_atm(ka)(1:1) == 'S' .and. field_atm(ka)(2:2) /= 'x') then + cycle ! any state fields that are not Sx_ will just be copied + endif + + do kl = 1,nlflds + if (trim(itemc_atm(ka)) == trim(itemc_lnd(kl))) then + if ((trim(field_atm(ka)) == trim(field_lnd(kl)))) then + if (field_lnd(kl)(1:1) == 'F') lmerge(ka) = .false. + endif + ! --- make sure only one field matches --- + if (lindx(ka) /= 0) then + write(logunit,*) subname,' ERROR: found multiple kl field matches for ',trim(itemc_lnd(kl)) + call shr_sys_abort(subname//' ERROR multiple kl field matches') + endif + lindx(ka) = kl + endif + end do + do ki = 1,niflds + if (field_ice(ki)(1:1) == 'F' .and. field_ice(ki)(2:4) == 'ioi') then + cycle ! ignore all fluxes that are ice/ocn fluxes + endif + if (trim(itemc_atm(ka)) == trim(itemc_ice(ki))) then + if ((trim(field_atm(ka)) == trim(field_ice(ki)))) then + if (field_ice(ki)(1:1) == 'F') imerge(ka) = .false. + endif + ! --- make sure only one field matches --- + if (iindx(ka) /= 0) then + write(logunit,*) subname,' ERROR: found multiple ki field matches for ',trim(itemc_ice(ki)) + call shr_sys_abort(subname//' ERROR multiple ki field matches') + endif + iindx(ka) = ki + endif + end do + do kx = 1,nxflds + if (trim(itemc_atm(ka)) == trim(itemc_xao(kx))) then + if ((trim(field_atm(ka)) == trim(field_xao(kx)))) then + if (field_xao(kx)(1:1) == 'F') xmerge(ka) = .false. + endif + ! --- make sure only one field matches --- + if (xindx(ka) /= 0) then + write(logunit,*) subname,' ERROR: found multiple kx field matches for ',trim(itemc_xao(kx)) + call shr_sys_abort(subname//' ERROR multiple kx field matches') + endif + xindx(ka) = kx + endif + end do + do ko = 1,noflds + if (trim(itemc_atm(ka)) == trim(itemc_ocn(ko))) then + if ((trim(field_atm(ka)) == trim(field_ocn(ko)))) then + if (field_ocn(ko)(1:1) == 'F') omerge(ka) = .false. + endif + ! --- make sure only one field matches --- + if (oindx(ka) /= 0) then + write(logunit,*) subname,' ERROR: found multiple ko field matches for ',trim(itemc_ocn(ko)) + call shr_sys_abort(subname//' ERROR multiple ko field matches') + endif + oindx(ka) = ko + endif + end do + + ! --- add some checks --- + + ! --- make sure all terms agree on merge or non-merge aspect --- + if (oindx(ka) > 0 .and. xindx(ka) > 0) then + write(logunit,*) subname,' ERROR: oindx and xindx both non-zero, not allowed ',trim(itemc_atm(ka)) + call shr_sys_abort(subname//' ERROR oindx and xindx both non-zero') + endif + + ! --- make sure all terms agree on merge or non-merge aspect --- + if (lindx(ka) > 0 .and. iindx(ka) > 0 .and. (lmerge(ka) .neqv. imerge(ka))) then + write(logunit,*) subname,' ERROR: lindx and iindx merge logic error ',trim(itemc_atm(ka)) + call shr_sys_abort(subname//' ERROR lindx and iindx merge logic error') + endif + if (lindx(ka) > 0 .and. xindx(ka) > 0 .and. (lmerge(ka) .neqv. xmerge(ka))) then + write(logunit,*) subname,' ERROR: lindx and xindx merge logic error ',trim(itemc_atm(ka)) + call shr_sys_abort(subname//' ERROR lindx and xindx merge logic error') + endif + if (lindx(ka) > 0 .and. oindx(ka) > 0 .and. (lmerge(ka) .neqv. omerge(ka))) then + write(logunit,*) subname,' ERROR: lindx and oindx merge logic error ',trim(itemc_atm(ka)) + call shr_sys_abort(subname//' ERROR lindx and oindx merge logic error') + endif + if (xindx(ka) > 0 .and. iindx(ka) > 0 .and. (xmerge(ka) .neqv. imerge(ka))) then + write(logunit,*) subname,' ERROR: xindx and iindx merge logic error ',trim(itemc_atm(ka)) + call shr_sys_abort(subname//' ERROR xindx and iindx merge logic error') + endif + if (xindx(ka) > 0 .and. oindx(ka) > 0 .and. (xmerge(ka) .neqv. omerge(ka))) then + write(logunit,*) subname,' ERROR: xindx and oindx merge logic error ',trim(itemc_atm(ka)) + call shr_sys_abort(subname//' ERROR xindx and oindx merge logic error') + endif + if (iindx(ka) > 0 .and. oindx(ka) > 0 .and. (imerge(ka) .neqv. omerge(ka))) then + write(logunit,*) subname,' ERROR: iindx and oindx merge logic error ',trim(itemc_atm(ka)) + call shr_sys_abort(subname//' ERROR iindx and oindx merge logic error') + endif + + end do + endif + + ! Zero attribute vector + + !call mct_avect_zero(x2a_a) ? + + !x2a_am = 0 + ent_type = 1 ! cells + tagname = trim(seq_flds_x2a_fields)//C_NULL_CHAR + arrsize = naflds * lsize + ierr = iMOAB_GetDoubleTagStorage ( mbaxid, tagname, arrsize , ent_type, x2a_am(1,1)) + + ! Update surface fractions + ! fraclist_a = 'afrac:ifrac:ofrac:lfrac:lfrin' + kif = 2 ! kif=mct_aVect_indexRA(fractions_a,"ifrac") + klf = 4 ! klf=mct_aVect_indexRA(fractions_a,"lfrac") + kof = 3 ! kof=mct_aVect_indexRA(fractions_a,"ofrac") + ! lsize = mct_avect_lsize(x2a_a) + + + ! fill with fractions from atm instance + + tagname = 'afrac:ifrac:ofrac:lfrac:lfrin'//C_NULL_CHAR + arrsize = 5 * lsize + ierr = iMOAB_GetDoubleTagStorage ( mbaxid, tagname, arrsize , ent_type, fractions_am(1,1)) + if (ierr .ne. 0) then + call shr_sys_abort(subname//' error in getting fractions_am from atm instance ') + endif + + tagname = trim(seq_flds_o2x_fields)//C_NULL_CHAR + arrsize = noflds * lsize ! allocate (o2x_am (lsize, noflds)) + ierr = iMOAB_GetDoubleTagStorage ( mbaxid, tagname, arrsize , ent_type, o2x_am(1,1)) + if (ierr .ne. 0) then + call shr_sys_abort(subname//' error in getting o2x_am array ') + endif + + tagname = trim(seq_flds_i2x_fields)//C_NULL_CHAR + arrsize = niflds * lsize ! allocate (i2x_am (lsize, niflds)) + ierr = iMOAB_GetDoubleTagStorage ( mbaxid, tagname, arrsize , ent_type, i2x_am(1,1)) + if (ierr .ne. 0) then + call shr_sys_abort(subname//' error in getting i2x_am array ') + endif + + tagname = trim(seq_flds_l2x_fields)//C_NULL_CHAR + arrsize = nlflds * lsize ! allocate (l2x_am (lsize, nlflds)) + ierr = iMOAB_GetDoubleTagStorage ( mbaxid, tagname, arrsize , ent_type, l2x_am(1,1)) + if (ierr .ne. 0) then + call shr_sys_abort(subname//' error in getting l2x_am array ') + endif + + tagname = trim(seq_flds_xao_fields)//C_NULL_CHAR + arrsize = nxflds * lsize ! allocate (xao_am (lsize, nxflds)) + ierr = iMOAB_GetDoubleTagStorage ( mbaxid, tagname, arrsize , ent_type, xao_am(1,1)) + if (ierr .ne. 0) then + call shr_sys_abort(subname//' error in getting xao_om array ') + endif + + + do n = 1,lsize + x2a_am(n, index_x2a_Sf_lfrac) = fractions_am(n, klf) ! x2a_a%rAttr(index_x2a_Sf_lfrac,n) = fractions_a%Rattr(klf,n) + x2a_am(n, index_x2a_Sf_ifrac) = fractions_am(n, kif) ! x2a_a%rAttr(index_x2a_Sf_ifrac,n) = fractions_a%Rattr(kif,n) + x2a_am(n, index_x2a_Sf_ofrac) = fractions_am(n, kof) ! x2a_a%rAttr(index_x2a_Sf_ofrac,n) = fractions_a%Rattr(kof,n) + end do + + !--- document fraction operations --- + if (first_time) then + mrgstr(index_x2a_sf_lfrac) = trim(mrgstr(index_x2a_sf_lfrac))//' = fractions_a%lfrac' + mrgstr(index_x2a_sf_ifrac) = trim(mrgstr(index_x2a_sf_ifrac))//' = fractions_a%ifrac' + mrgstr(index_x2a_sf_ofrac) = trim(mrgstr(index_x2a_sf_ofrac))//' = fractions_a%ofrac' + endif + + ! Copy attributes that do not need to be merged + ! These are assumed to have the same name in + ! (o2x_a and x2a_a) and in (l2x_a and x2a_a), etc. + + !--- document copy operations --- + if (first_time) then + !--- document merge --- + do i=1,l2x_SharedIndices%shared_real%num_indices + i1=l2x_SharedIndices%shared_real%aVindices1(i) + o1=l2x_SharedIndices%shared_real%aVindices2(i) + mrgstr(o1) = trim(mrgstr(o1))//' = l2x%'//trim(field_lnd(i1)) + enddo + do i=1,o2x_SharedIndices%shared_real%num_indices + i1=o2x_SharedIndices%shared_real%aVindices1(i) + o1=o2x_SharedIndices%shared_real%aVindices2(i) + mrgstr(o1) = trim(mrgstr(o1))//' = o2x%'//trim(field_ocn(i1)) + enddo + do i=1,i2x_SharedIndices%shared_real%num_indices + i1=i2x_SharedIndices%shared_real%aVindices1(i) + o1=i2x_SharedIndices%shared_real%aVindices2(i) + mrgstr(o1) = trim(mrgstr(o1))//' = i2x%'//trim(field_ice(i1)) + enddo + do i=1,xao_SharedIndices%shared_real%num_indices + i1=xao_SharedIndices%shared_real%aVindices1(i) + o1=xao_SharedIndices%shared_real%aVindices2(i) + mrgstr(o1) = trim(mrgstr(o1))//' = xao%'//trim(field_xao(i1)) + enddo + endif + + ! call mct_aVect_copy(aVin=l2x_a, aVout=x2a_a, vector=mct_usevector) + ! call mct_aVect_copy(aVin=o2x_a, aVout=x2a_a, vector=mct_usevector) + ! call mct_aVect_copy(aVin=i2x_a, aVout=x2a_a, vector=mct_usevector) + ! call mct_aVect_copy(aVin=xao_a, aVout=x2a_a, vector=mct_usevector) + ! we need to do something equivalent, to copy in a2x_am the tags from those shared indices + ! call mct_aVect_copy(aVin=l2x_a, aVout=x2a_a, vector=mct_usevector, sharedIndices=l2x_SharedIndices) + !call mct_aVect_copy(aVin=o2x_a, aVout=x2a_a, vector=mct_usevector, sharedIndices=o2x_SharedIndices) + !call mct_aVect_copy(aVin=i2x_a, aVout=x2a_a, vector=mct_usevector, sharedIndices=i2x_SharedIndices) + !call mct_aVect_copy(aVin=xao_a, aVout=x2a_a, vector=mct_usevector, sharedIndices=xao_SharedIndices) + + ! If flux to atm is coming only from the ocean (based on field being in o2x_a) - + ! -- then scale by both ocean and ice fraction + ! If flux to atm is coming only from the land or ice or coupler + ! -- then do scale by fraction above + + do ka = 1,naflds + !--- document merge --- + if (first_time) then + if (lindx(ka) > 0) then + if (lmerge(ka)) then + mrgstr(ka) = trim(mrgstr(ka))//' + lfrac*l2x%'//trim(field_lnd(lindx(ka))) + else + mrgstr(ka) = trim(mrgstr(ka))//' = lfrac*l2x%'//trim(field_lnd(lindx(ka))) + endif + endif + if (iindx(ka) > 0) then + if (imerge(ka)) then + mrgstr(ka) = trim(mrgstr(ka))//' + ifrac*i2x%'//trim(field_ice(iindx(ka))) + else + mrgstr(ka) = trim(mrgstr(ka))//' = ifrac*i2x%'//trim(field_ice(iindx(ka))) + endif + endif + if (xindx(ka) > 0) then + if (xmerge(ka)) then + mrgstr(ka) = trim(mrgstr(ka))//' + ofrac*xao%'//trim(field_xao(xindx(ka))) + else + mrgstr(ka) = trim(mrgstr(ka))//' = ofrac*xao%'//trim(field_xao(xindx(ka))) + endif + endif + if (oindx(ka) > 0) then + if (omerge(ka)) then + mrgstr(ka) = trim(mrgstr(ka))//' + ofrac*o2x%'//trim(field_ocn(oindx(ka))) + endif + if (.not. omerge(ka)) then + mrgstr(ka) = trim(mrgstr(ka))//' + (ifrac+ofrac)*o2x%'//trim(field_ocn(oindx(ka))) + endif + endif + endif + + do n = 1,lsize + fracl = fractions_am(n, klf) ! fractions_a%Rattr(klf,n) + fraci = fractions_am(n, kif) ! fractions_a%Rattr(kif,n) + fraco = fractions_am(n, kof) ! fractions_a%Rattr(kof,n) + if (lindx(ka) > 0 .and. fracl > 0._r8) then + if (lmerge(ka)) then + x2a_am(n, ka) = x2a_am(n, ka) + l2x_am(n, lindx(ka)) * fracl ! x2a_a%rAttr(ka,n) = x2a_a%rAttr(ka,n) + l2x_a%rAttr(lindx(ka),n) * fracl + else + x2a_am(n, ka) = l2x_am(n, lindx(ka)) * fracl ! x2a_a%rAttr(ka,n) = l2x_a%rAttr(lindx(ka),n) * fracl + endif + endif + if (iindx(ka) > 0 .and. fraci > 0._r8) then + if (imerge(ka)) then + x2a_am(n, ka) = x2a_am(n, ka) + i2x_am(n, iindx(ka)) * fraci ! x2a_a%rAttr(ka,n) = x2a_a%rAttr(ka,n) + i2x_a%rAttr(iindx(ka),n) * fraci + else + x2a_am(n, ka) = i2x_am(n, iindx(ka)) * fraci ! x2a_a%rAttr(ka,n) = i2x_a%rAttr(iindx(ka),n) * fraci + endif + endif + if (xindx(ka) > 0 .and. fraco > 0._r8) then + if (xmerge(ka)) then + x2a_am(n, ka) = x2a_am(n, ka) + xao_am(n, xindx(ka)) * fraco !x2a_a%rAttr(ka,n) = x2a_a%rAttr(ka,n) + xao_a%rAttr(xindx(ka),n) * fraco + else + x2a_am(n, ka) = xao_am(n, xindx(ka)) * fraco ! x2a_a%rAttr(ka,n) = xao_a%rAttr(xindx(ka),n) * fraco + endif + endif + if (oindx(ka) > 0) then + if (omerge(ka) .and. fraco > 0._r8) then + x2a_am(n, ka) = x2a_am(n, ka) + o2x_am(n, oindx(ka)) * fraco ! x2a_a%rAttr(ka,n) = x2a_a%rAttr(ka,n) + o2x_a%rAttr(oindx(ka),n) * fraco + endif + if (.not. omerge(ka)) then + !--- NOTE: This IS using the ocean fields and ice fraction !! --- + x2a_am(n, ka) = o2x_am(n, oindx(ka)) * fraci ! x2a_a%rAttr(ka,n) = o2x_a%rAttr(oindx(ka),n) * fraci + x2a_am(n, ka) = x2a_am(n, ka) + o2x_am(n, oindx(ka)) * fraco ! x2a_a%rAttr(ka,n) = x2a_a%rAttr(ka,n) + o2x_a%rAttr(oindx(ka),n) * fraco + endif + endif + end do + end do + +! after we are done, set x2a_am to the mbaxid + + tagname = trim(seq_flds_x2a_fields)//C_NULL_CHAR + arrsize = naflds * lsize + ierr = iMOAB_SetDoubleTagStorage ( mbaxid, tagname, arrsize , ent_type, x2a_am(1,1)) + if (ierr .ne. 0) then + call shr_sys_abort(subname//' error in setting x2o_om array ') + endif +#ifdef MOABDEBUG + !compare_mct_av_moab_tag(comp, attrVect, field, imoabApp, tag_name, ent_type, difference) + x2a_a => component_get_x2c_cx(atm(1)) + ! loop over all fields in seq_flds_x2a_fields + call mct_list_init(temp_list ,seq_flds_x2a_fields) + size_list=mct_list_nitem (temp_list) + ent_type = 1 ! cell for atm, atm_pg_active + if (iamroot) print *, num_moab_exports, trim(seq_flds_x2a_fields) + 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 compare_mct_av_moab_tag(atm(1), x2a_a, mct_field, mbaxid, tagname, ent_type, difference) + enddo + call mct_list_clean(temp_list) + + + if (mboxid .ge. 0 ) then ! we are on coupler pes, for sure + write(lnum,"(I0.2)")num_moab_exports + outfile = 'AtmCplAftMm'//trim(lnum)//'.h5m'//C_NULL_CHAR + wopts = ';PARALLEL=WRITE_PART'//C_NULL_CHAR ! + ierr = iMOAB_WriteMesh(mbaxid, trim(outfile), trim(wopts)) + endif +#endif + + if (first_time) then + if (iamroot) then + write(logunit,'(A)') subname//' Summary:' + do ka = 1,naflds + write(logunit,'(A)') trim(mrgstr(ka)) + enddo + endif + deallocate(mrgstr) + deallocate(field_atm,itemc_atm) + deallocate(field_lnd,itemc_lnd) + deallocate(field_ice,itemc_ice) + deallocate(field_ocn,itemc_ocn) + deallocate(field_xao,itemc_xao) + endif + + first_time = .false. + ! end copy from prep_atm_merge end subroutine prep_atm_mrg_moab !================================================================================================ diff --git a/driver-moab/main/prep_ocn_mod.F90 b/driver-moab/main/prep_ocn_mod.F90 index c86362c45fee..3053620d2060 100644 --- a/driver-moab/main/prep_ocn_mod.F90 +++ b/driver-moab/main/prep_ocn_mod.F90 @@ -1309,7 +1309,7 @@ subroutine prep_ocn_mrg_moab(infodata, xao_ox) if (ierr .ne. 0) then call shr_sys_abort(subname//' error in getting fractions_om from ocean instance ') endif - ! fill the r2x_om, etc double array fields noflds + ! fill the o2x_om, etc double array fields noflds tagname = trim(seq_flds_x2o_fields)//C_NULL_CHAR arrsize = noflds * lsize ierr = iMOAB_GetDoubleTagStorage ( mboxid, tagname, arrsize , ent_type, x2o_om(1,1)) From 45d71449c8ad8f79944f8bacb228b6155c46c2d3 Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Tue, 20 Dec 2022 20:42:13 -0600 Subject: [PATCH 224/467] call merge atm moab during runtime too --- driver-moab/main/cime_comp_mod.F90 | 2 ++ driver-moab/main/prep_atm_mod.F90 | 2 +- driver-moab/main/seq_map_mod.F90 | 22 ++++++++++++---------- 3 files changed, 15 insertions(+), 11 deletions(-) diff --git a/driver-moab/main/cime_comp_mod.F90 b/driver-moab/main/cime_comp_mod.F90 index 2822eea236f4..581f010791eb 100644 --- a/driver-moab/main/cime_comp_mod.F90 +++ b/driver-moab/main/cime_comp_mod.F90 @@ -4026,6 +4026,8 @@ subroutine cime_run_atm_setup_send() endif if (associated(xao_ax)) then call prep_atm_mrg(infodata, fractions_ax, xao_ax=xao_ax, timer_mrg='CPL:atmprep_mrgx2a') + ! call moab atm merge too + call prep_atm_mrg_moab(infodata, xao_ax) endif call component_diag(infodata, atm, flow='x2c', comment= 'send atm', info_debug=info_debug, & diff --git a/driver-moab/main/prep_atm_mod.F90 b/driver-moab/main/prep_atm_mod.F90 index a31a36278e28..502507d32e2c 100644 --- a/driver-moab/main/prep_atm_mod.F90 +++ b/driver-moab/main/prep_atm_mod.F90 @@ -1382,7 +1382,7 @@ subroutine prep_atm_mrg_moab(infodata, xao_ax) call mct_list_init(temp_list ,seq_flds_x2a_fields) size_list=mct_list_nitem (temp_list) ent_type = 1 ! cell for atm, atm_pg_active - if (iamroot) print *, num_moab_exports, trim(seq_flds_x2a_fields) + if (iamroot) print *, subname, num_moab_exports, trim(seq_flds_x2a_fields) do index_list = 1, size_list call mct_list_get(mctOStr,index_list,temp_list) mct_field = mct_string_toChar(mctOStr) diff --git a/driver-moab/main/seq_map_mod.F90 b/driver-moab/main/seq_map_mod.F90 index efe2c4075217..d99781de956c 100644 --- a/driver-moab/main/seq_map_mod.F90 +++ b/driver-moab/main/seq_map_mod.F90 @@ -422,6 +422,12 @@ subroutine seq_map_map( mapper, av_s, av_d, fldlist, norm, avwts_s, avwtsfld_s, if ( valid_moab_context ) then ! first get data from source tag and store in a temporary ! then set it back to target tag to mimic a copy +#ifdef MOABDEBUG + if (seq_comm_iamroot(CPLID)) then + write(logunit, *) subname,' iMOAB copy_only between mbids: ', mapper%src_mbid, ' and ', mapper%tgt_mbid, trim(fldlist_moab) + call shr_sys_flush(logunit) + endif +#endif ntagdatalength = nfields * mapper % nentities allocate(moab_tag_data(ntagdatalength)) @@ -532,10 +538,6 @@ subroutine seq_map_map( mapper, av_s, av_d, fldlist, norm, avwts_s, avwtsfld_s, endif endif if ( valid_moab_context ) then - if (seq_comm_iamroot(CPLID)) then - write(logunit, *) subname,' iMOAB mapper before receiving ', trim(fldlist_moab) - call shr_sys_flush(logunit) - endif ! receive in the intx app, because it is redistributed according to coverage (trick) ierr = iMOAB_ReceiveElementTag( mapper%intx_mbid, fldlist_moab, mapper%mpicom, mapper%src_context ); if (ierr .ne. 0) then @@ -551,6 +553,12 @@ subroutine seq_map_map( mapper, av_s, av_d, fldlist, norm, avwts_s, avwtsfld_s, endif endif if ( valid_moab_context ) then +#ifdef MOABDEBUG + if (seq_comm_iamroot(CPLID)) then + write(logunit, *) subname,' iMOAB mapper: between ', mapper%src_mbid, ' and ', mapper%tgt_mbid, trim(fldlist_moab) + call shr_sys_flush(logunit) + endif +#endif ierr = iMOAB_ApplyScalarProjectionWeights ( mapper%intx_mbid, mapper%weight_identifier, fldlist_moab, fldlist_moab) if (ierr .ne. 0) then write(logunit,*) subname,' error in applying weights ' @@ -560,12 +568,6 @@ subroutine seq_map_map( mapper, av_s, av_d, fldlist, norm, avwts_s, avwtsfld_s, #endif endif -#ifdef HAVE_MOAB - if ( valid_moab_context ) then - - endif -#endif - end subroutine seq_map_map !======================================================================= From b1d3b525221afd19f53b18dd7b6ccf3aa7e8cfc0 Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Tue, 20 Dec 2022 22:41:06 -0600 Subject: [PATCH 225/467] more comms in moab need more error checks in sending in mapper --- components/elm/src/cpl/lnd_comp_mct.F90 | 9 ++++++--- components/mpas-seaice/driver/ice_comp_mct.F | 5 +++++ driver-moab/main/cime_comp_mod.F90 | 15 +++++++++++++-- driver-moab/main/cplcomp_exchange_mod.F90 | 20 +++++++++++++++++++- 4 files changed, 43 insertions(+), 6 deletions(-) diff --git a/components/elm/src/cpl/lnd_comp_mct.F90 b/components/elm/src/cpl/lnd_comp_mct.F90 index 20654c2f44eb..0dc4dde1862b 100644 --- a/components/elm/src/cpl/lnd_comp_mct.F90 +++ b/components/elm/src/cpl/lnd_comp_mct.F90 @@ -578,6 +578,9 @@ subroutine lnd_run_mct(EClock, cdata_l, x2l_l, l2x_l) #ifndef CPL_BYPASS call t_startf ('lc_lnd_export') call lnd_export(bounds, lnd2atm_vars, lnd2glc_vars, l2x_l%rattr) +#ifdef HAVE_MOAB + call lnd_export_moab(bounds, lnd2atm_vars, lnd2glc_vars) ! it is private here +#endif call t_stopf ('lc_lnd_export') #endif @@ -1043,6 +1046,7 @@ subroutine lnd_export_moab( bounds, lnd2atm_vars, lnd2glc_vars) use shr_megan_mod , only : shr_megan_mechcomps_n use iMOAB, only : iMOAB_SetDoubleTagStorage, iMOAB_WriteMesh use seq_flds_mod, only : seq_flds_l2x_fields + use seq_comm_mct, only : num_moab_exports ! ! !ARGUMENTS: implicit none @@ -1057,7 +1061,7 @@ subroutine lnd_export_moab( bounds, lnd2atm_vars, lnd2glc_vars) integer :: dtime ! time step integer :: num ! counter character(len=*), parameter :: sub = 'lnd_export_moab' - integer, save :: num_mb_exports = 0 ! used for debugging + integer :: ent_type, ierr character(len=100) :: outfile, wopts, lnum character(len=400) :: tagname @@ -1157,8 +1161,7 @@ subroutine lnd_export_moab( bounds, lnd2atm_vars, lnd2glc_vars) call shr_sys_abort( sub//' Error: fail to set moab '// trim(seq_flds_l2x_fields) ) #ifdef MOABDEBUG - num_mb_exports = num_mb_exports +1 - write(lnum,"(I0.2)")num_mb_exports + write(lnum,"(I0.2)")num_moab_exports outfile = 'lnd_export_'//trim(lnum)//'.h5m'//C_NULL_CHAR wopts = 'PARALLEL=WRITE_PART'//C_NULL_CHAR ierr = iMOAB_WriteMesh(mlnid, outfile, wopts) diff --git a/components/mpas-seaice/driver/ice_comp_mct.F b/components/mpas-seaice/driver/ice_comp_mct.F index c1b15d124ced..a68c147b022d 100644 --- a/components/mpas-seaice/driver/ice_comp_mct.F +++ b/components/mpas-seaice/driver/ice_comp_mct.F @@ -704,6 +704,11 @@ end subroutine xml_stream_get_attributes if ( ierrmb == 1 ) then call mpas_log_write('cannot define tags for MOAB i2x fields ' // trim(seq_flds_i2x_fields), MPAS_LOG_ERR) endif + tagname = trim(seq_flds_x2i_fields)//C_NULL_CHAR + ierrmb = iMOAB_DefineTagStorage(MPSIID, tagname, tagtype, numco, tagindex ) + if ( ierrmb == 1 ) then + call mpas_log_write('cannot define tags for MOAB i2x fields ' // trim(seq_flds_x2i_fields), MPAS_LOG_ERR) + endif #endif diff --git a/driver-moab/main/cime_comp_mod.F90 b/driver-moab/main/cime_comp_mod.F90 index 581f010791eb..20c310b75093 100644 --- a/driver-moab/main/cime_comp_mod.F90 +++ b/driver-moab/main/cime_comp_mod.F90 @@ -4417,7 +4417,8 @@ end subroutine cime_run_ocnglc_coupling !---------------------------------------------------------------------------------- subroutine cime_run_lnd_setup_send() - + use seq_flds_mod, only : seq_flds_x2l_fields + use seq_comm_mct, only : mblxid, mlnid !---------------------------------------------------- !| lnd prep-merge !---------------------------------------------------- @@ -4456,6 +4457,7 @@ subroutine cime_run_lnd_setup_send() mpicom_barrier=mpicom_CPLALLLNDID, run_barriers=run_barriers, & timer_barrier='CPL:C2L_BARRIER', timer_comp_exch='CPL:C2L', & timer_map_exch='CPL:c2l_lndx2lndl', timer_infodata_exch='CPL:c2l_infoexch') + call component_exch_moab(lnd(1), mblxid, mlnid, 1, seq_flds_x2l_fields) endif end subroutine cime_run_lnd_setup_send @@ -4669,6 +4671,8 @@ end subroutine cime_run_rof_setup_send subroutine cime_run_rof_recv_post() + use seq_comm_mct, only: mrofid, mbrxid + use seq_flds_mod, only: seq_flds_r2x_fields !---------------------------------------------------------- ! rof -> cpl !---------------------------------------------------------- @@ -4678,6 +4682,9 @@ subroutine cime_run_rof_recv_post() mpicom_barrier=mpicom_CPLALLROFID, run_barriers=run_barriers, & timer_barrier='CPL:R2C_BARRIER', timer_comp_exch='CPL:R2C', & timer_map_exch='CPL:r2c_rofr2rofx', timer_infodata_exch='CPL:r2c_infoexch') + ! this is for one hop + call component_exch_moab(rof(1), mrofid, mbrxid, 0, seq_flds_r2x_fields) + call prep_rof_migrate_moab(infodata) endif @@ -4706,6 +4713,8 @@ end subroutine cime_run_rof_recv_post subroutine cime_run_ice_setup_send() + use seq_flds_mod, only : seq_flds_x2i_fields + use seq_comm_mct, only : mpsiid, mbixid ! Note that for atm->ice mapping below will leverage the assumption that the ! ice and ocn are on the same grid and that mapping of atm to ocean is ! done already for use by atmocn flux and ice model prep @@ -4750,6 +4759,7 @@ subroutine cime_run_ice_setup_send() mpicom_barrier=mpicom_CPLALLICEID, run_barriers=run_barriers, & timer_barrier='CPL:C2I_BARRIER', timer_comp_exch='CPL:C2I', & timer_map_exch='CPL:c2i_icex2icei', timer_infodata_exch='CPL:ice_infoexch') + call component_exch_moab(ice(1), mbixid, mpsiid, 1, seq_flds_x2i_fields) endif end subroutine cime_run_ice_setup_send @@ -4757,7 +4767,8 @@ end subroutine cime_run_ice_setup_send !---------------------------------------------------------------------------------- subroutine cime_run_ice_recv_post() - + use seq_comm_mct, only : mpsiid, mbixid + use seq_flds_mod, only : seq_flds_i2x_fields !---------------------------------------------------------- ! ice -> cpl !---------------------------------------------------------- diff --git a/driver-moab/main/cplcomp_exchange_mod.F90 b/driver-moab/main/cplcomp_exchange_mod.F90 index c4ea1b532b77..f0f459a433fd 100644 --- a/driver-moab/main/cplcomp_exchange_mod.F90 +++ b/driver-moab/main/cplcomp_exchange_mod.F90 @@ -13,6 +13,7 @@ module cplcomp_exchange_mod use seq_flds_mod, only: seq_flds_o2x_fields ! needed for MOAB init of ocean fields o2x to be able to transfer to coupler use seq_flds_mod, only: seq_flds_x2o_fields ! needed for MOAB init of ocean fields x2o to be able to transfer from coupler use seq_flds_mod, only: seq_flds_i2x_fields, seq_flds_x2i_fields ! needed for MOAB init of ice fields x2o on coupler side, to save them + use seq_flds_mod, only: seq_flds_l2x_fields, seq_flds_x2l_fields ! use seq_comm_mct, only: cplid, logunit use seq_comm_mct, only: seq_comm_getinfo => seq_comm_setptrs, seq_comm_iamin use seq_diag_mct @@ -1289,7 +1290,24 @@ subroutine cplcomp_moab_Init(comp) if (ierr .ne. 0) then write(logunit,*) subname,' error in receiving coupler land mesh' call shr_sys_abort(subname//' ERROR in receiving coupler land mesh') - endif + endif + +! need to define tags on land too + tagname = trim(seq_flds_l2x_fields)//C_NULL_CHAR + tagtype = 1 ! dense, double + numco = 1 ! one value per cell + ierr = iMOAB_DefineTagStorage(mblxid, tagname, tagtype, numco, tagindex ) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in defining tags l2x on coupler land' + call shr_sys_abort(subname//' ERROR in defining tags l2x on coupler ') + endif + ! need also to define seq_flds_x2o_fields on coupler instance, and on ocean comp instance + tagname = trim(seq_flds_x2l_fields)//C_NULL_CHAR + ierr = iMOAB_DefineTagStorage(mblxid, tagname, tagtype, numco, tagindex ) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in defining tags x2l on coupler land' + call shr_sys_abort(subname//' ERROR in defining tags x2l on coupler land') + endif #ifdef MOABDEBUG ! debug test From 995980c78e6a0cdb8214884b3dd433dbd2b66f3a Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Wed, 21 Dec 2022 15:22:54 -0600 Subject: [PATCH 226/467] add more info to moab mapper --- driver-moab/main/prep_atm_mod.F90 | 18 +++++++++++------ driver-moab/main/prep_lnd_mod.F90 | 6 ++++-- driver-moab/main/prep_ocn_mod.F90 | 9 ++++++++- driver-moab/main/seq_map_mod.F90 | 4 ++-- driver-moab/main/seq_map_type_mod.F90 | 29 ++++++++++++++++++++++++--- 5 files changed, 52 insertions(+), 14 deletions(-) diff --git a/driver-moab/main/prep_atm_mod.F90 b/driver-moab/main/prep_atm_mod.F90 index 502507d32e2c..b4e00345d72d 100644 --- a/driver-moab/main/prep_atm_mod.F90 +++ b/driver-moab/main/prep_atm_mod.F90 @@ -265,6 +265,7 @@ subroutine prep_atm_init(infodata, ocn_c2_atm, ice_c2_atm, lnd_c2_atm, iac_c2_at mapper_So2a%intx_context = idintx wgtIdef = 'scalar'//C_NULL_CHAR mapper_So2a%weight_identifier = wgtIdef + mapper_So2a%mbname = 'mapper_So2a' ! because we will project fields from ocean to atm phys grid, we need to define ! ocean o2x fields to atm phys grid (or atm spectral ext ) on coupler side if (atm_pg_active) then @@ -357,6 +358,7 @@ subroutine prep_atm_init(infodata, ocn_c2_atm, ice_c2_atm, lnd_c2_atm, iac_c2_at mapper_Fo2a%intx_context = idintx wgtIdef = 'scalar'//C_NULL_CHAR mapper_Fo2a%weight_identifier = wgtIdef + mapper_Fo2a%mbname = 'mapper_Fo2a' endif ! endif for HAVE_MOAB #endif @@ -417,6 +419,7 @@ subroutine prep_atm_init(infodata, ocn_c2_atm, ice_c2_atm, lnd_c2_atm, iac_c2_at mapper_Si2a%intx_context = idintx wgtIdef = 'scalar'//C_NULL_CHAR mapper_Si2a%weight_identifier = wgtIdef + mapper_Si2a%mbname = 'mapper_Si2a' ! because we will project fields from ocean to atm phys grid, we need to define ! ice i2x fields to atm phys grid (or atm spectral ext ) on coupler side if (atm_pg_active) then @@ -508,6 +511,7 @@ subroutine prep_atm_init(infodata, ocn_c2_atm, ice_c2_atm, lnd_c2_atm, iac_c2_at mapper_Fi2a%intx_context = idintx wgtIdef = 'scalar'//C_NULL_CHAR mapper_Fi2a%weight_identifier = wgtIdef + mapper_Fi2a%mbname = 'mapper_Fi2a' #endif endif ! if (ice_present) then call shr_sys_flush(logunit) @@ -542,6 +546,7 @@ subroutine prep_atm_init(infodata, ocn_c2_atm, ice_c2_atm, lnd_c2_atm, iac_c2_at mapper_Fl2a%intx_context = idintx wgtIdef = 'scalar'//C_NULL_CHAR mapper_Fl2a%weight_identifier = wgtIdef + mapper_Fl2a%mbname = 'mapper_Fl2a' if (.not. samegrid_al) then ! tri grid case if (iamroot_CPLID) then @@ -623,13 +628,14 @@ subroutine prep_atm_init(infodata, ocn_c2_atm, ice_c2_atm, lnd_c2_atm, iac_c2_at 'mapper_Sl2a initialization',esmf_map_flag) #ifdef HAVE_MOAB if ((mbaxid .ge. 0) .and. (mblxid .ge. 0) ) then - mapper_Fl2a%src_mbid = mblxid - mapper_Fl2a%tgt_mbid = mbaxid - mapper_Fl2a%src_mbid = mbintxla - mapper_Fl2a%src_context = lnd(1)%cplcompid - mapper_Fl2a%intx_context = idintx + mapper_Sl2a%src_mbid = mblxid + mapper_Sl2a%tgt_mbid = mbaxid + mapper_Sl2a%src_mbid = mbintxla + mapper_Sl2a%src_context = lnd(1)%cplcompid + mapper_Sl2a%intx_context = idintx wgtIdef = 'scalar'//C_NULL_CHAR - mapper_Fl2a%weight_identifier = wgtIdef + mapper_Sl2a%weight_identifier = wgtIdef + mapper_Sl2a%mbname = 'mapper_Sl2a' endif #endif endif ! if (lnd_c2_atm) then diff --git a/driver-moab/main/prep_lnd_mod.F90 b/driver-moab/main/prep_lnd_mod.F90 index 4e80c163c51f..395be38c47c3 100644 --- a/driver-moab/main/prep_lnd_mod.F90 +++ b/driver-moab/main/prep_lnd_mod.F90 @@ -238,11 +238,12 @@ subroutine prep_lnd_init(infodata, atm_c2_lnd, rof_c2_lnd, glc_c2_lnd, iac_c2_ln endif mapper_Sa2l%src_mbid = mbaxid mapper_Sa2l%tgt_mbid = mblxid - mapper_Sa2l%src_mbid = mbintxal + mapper_Sa2l%intx_mbid = mbintxal mapper_Sa2l%src_context = lnd(1)%cplcompid mapper_Sa2l%intx_context = idintx wgtIdef = 'scalar'//C_NULL_CHAR mapper_Sa2l%weight_identifier = wgtIdef + mapper_Sa2l%mbname = 'mapper_Sa2l' call seq_comm_getinfo(CPLID ,mpigrp=mpigrp_CPLID) if (.not. samegrid_al) then ! tri grid case @@ -347,11 +348,12 @@ subroutine prep_lnd_init(infodata, atm_c2_lnd, rof_c2_lnd, glc_c2_lnd, iac_c2_ln ! use the same map for fluxes too mapper_Fa2l%src_mbid = mbaxid mapper_Fa2l%tgt_mbid = mblxid - mapper_Fa2l%src_mbid = mbintxal + mapper_Fa2l%intx_mbid = mbintxal mapper_Fa2l%src_context = lnd(1)%cplcompid mapper_Fa2l%intx_context = idintx wgtIdef = 'scalar'//C_NULL_CHAR mapper_Fa2l%weight_identifier = wgtIdef + mapper_Fa2l%mbname = 'mapper_Fa2l' ! in any case, we need to define the tags on landx from the phys atm seq_flds_a2x_fields diff --git a/driver-moab/main/prep_ocn_mod.F90 b/driver-moab/main/prep_ocn_mod.F90 index 3053620d2060..16477c91365f 100644 --- a/driver-moab/main/prep_ocn_mod.F90 +++ b/driver-moab/main/prep_ocn_mod.F90 @@ -32,7 +32,7 @@ module prep_ocn_mod use seq_infodata_mod, only: seq_infodata_type, seq_infodata_getdata use seq_map_type_mod - use seq_map_mod ! will have also moab_map_init_rcfile + use seq_map_mod ! will have also moab_map_init_rcfile , seq_map_set_type use seq_flds_mod use t_drv_timers_mod use mct_mod @@ -374,6 +374,7 @@ subroutine prep_ocn_init(infodata, atm_c2_ocn, atm_c2_ice, ice_c2_ocn, rof_c2_oc mapper_Fa2o%intx_context = idintx wgtIdef = 'scalar'//C_NULL_CHAR mapper_Fa2o%weight_identifier = wgtIdef + mapper_Fa2o%mbname = 'mapper_Fa2o' ! because we will project fields from atm to ocn grid, we need to define ! atm a2x fields to ocn grid on coupler side @@ -475,6 +476,7 @@ subroutine prep_ocn_init(infodata, atm_c2_ocn, atm_c2_ice, ice_c2_ocn, rof_c2_oc mapper_Sa2o%intx_context = idintx wgtIdef = 'scalar'//C_NULL_CHAR mapper_Sa2o%weight_identifier = wgtIdef + mapper_Sa2o%mbname = 'mapper_Sa2o' mapper_Va2o%src_mbid = mbaxid mapper_Va2o%tgt_mbid = mboxid @@ -483,6 +485,7 @@ subroutine prep_ocn_init(infodata, atm_c2_ocn, atm_c2_ice, ice_c2_ocn, rof_c2_oc mapper_Va2o%intx_context = idintx wgtIdef = 'scalar'//C_NULL_CHAR mapper_Va2o%weight_identifier = wgtIdef + mapper_Va2o%mbname = 'mapper_Va2o' endif ! if ((mbaxid .ge. 0) .and. (mboxid .ge. 0)) endif ! if (atm_c2_ocn .or. atm_c2_ice) call shr_sys_flush(logunit) @@ -528,6 +531,10 @@ subroutine prep_ocn_init(infodata, atm_c2_ocn, atm_c2_ice, ice_c2_ocn, rof_c2_oc mapper_Va2o%src_context = ice(1)%cplcompid mapper_Va2o%intx_context = ocn(1)%cplcompid + if(mapper_SFi2o%copy_only) then + call seq_map_set_type(mapper_SFi2o, mbixid, 1) ! type is cells + endif + endif #endif diff --git a/driver-moab/main/seq_map_mod.F90 b/driver-moab/main/seq_map_mod.F90 index d99781de956c..1c6334bf7104 100644 --- a/driver-moab/main/seq_map_mod.F90 +++ b/driver-moab/main/seq_map_mod.F90 @@ -401,7 +401,7 @@ subroutine seq_map_map( mapper, av_s, av_d, fldlist, norm, avwts_s, avwtsfld_s, endif if (seq_comm_iamroot(CPLID)) then - write(logunit,*) subname,' iMOAB_mapper nfields', & + write(logunit,*) subname, 'iMOAB mapper ',trim(mapper%mbname), ' iMOAB_mapper nfields', & nfields, ' fldlist_moab=', trim(fldlist_moab) call shr_sys_flush(logunit) endif @@ -424,7 +424,7 @@ subroutine seq_map_map( mapper, av_s, av_d, fldlist, norm, avwts_s, avwtsfld_s, ! then set it back to target tag to mimic a copy #ifdef MOABDEBUG if (seq_comm_iamroot(CPLID)) then - write(logunit, *) subname,' iMOAB copy_only between mbids: ', mapper%src_mbid, ' and ', mapper%tgt_mbid, trim(fldlist_moab) + write(logunit, *) subname, 'iMOAB mapper', trim(mapper%mbname), ' iMOAB copy_only between mbids: ', mapper%src_mbid, ' and ', mapper%tgt_mbid, trim(fldlist_moab) call shr_sys_flush(logunit) endif #endif diff --git a/driver-moab/main/seq_map_type_mod.F90 b/driver-moab/main/seq_map_type_mod.F90 index 998df9a526ad..950528e9be83 100644 --- a/driver-moab/main/seq_map_type_mod.F90 +++ b/driver-moab/main/seq_map_type_mod.F90 @@ -44,6 +44,7 @@ module seq_map_type_mod ! source and target app ids also make sense only on the coupler pes integer :: src_mbid, tgt_mbid, intx_mbid, src_context, intx_context character*32 :: weight_identifier ! 'state' OR 'flux' + character*16 :: mbname integer :: tag_entity_type integer :: nentities ! this should be used only if copy_only is true ! @@ -152,10 +153,11 @@ subroutine seq_map_mapinit(mapper,mpicom) mapper%mapfile = "undefined" #ifdef HAVE_MOAB - mapper%src_mbid = -1 - mapper%tgt_mbid = -1 + mapper%src_mbid = -1 + mapper%tgt_mbid = -1 mapper%intx_mbid = -1 - mapper%nentities = 0 + mapper%nentities = 0 + mapper%mbname = "undefined" #endif end subroutine seq_map_mapinit @@ -196,6 +198,27 @@ subroutine seq_map_gsmapcheck(gsmap1,gsmap2) endif end subroutine seq_map_gsmapcheck + + !=============================================================================== + + subroutine seq_map_set_type(mapper, mbid, ent_type) + use iMOAB, only: iMOAB_GetMeshInfo + type(seq_map) ,intent(in),pointer :: mapper + integer ,intent(in) :: mbid + integer ,intent(in) :: ent_type + + integer nvert(3), nvise(3), nbl(3), nsurf(3), nvisBC(3), ierr + + + ierr = iMOAB_GetMeshInfo ( mbid, nvert, nvise, nbl, nsurf, nvisBC ); + if (ent_type .eq. 0) then + mapper%nentities = nvert(1) + else if (ent_type .eq. 1) then + mapper%nentities = nvise(1) + endif + + mapper%tag_entity_type = ent_type + end subroutine seq_map_set_type end module seq_map_type_mod From ae0ae708e6331db69614177e6b4ab70fc8320dcc Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Wed, 21 Dec 2022 17:39:04 -0600 Subject: [PATCH 227/467] x2l tags on land --- components/elm/src/cpl/lnd_comp_mct.F90 | 8 +++++++- 1 file changed, 7 insertions(+), 1 deletion(-) diff --git a/components/elm/src/cpl/lnd_comp_mct.F90 b/components/elm/src/cpl/lnd_comp_mct.F90 index 0dc4dde1862b..ac3e814cfd9a 100644 --- a/components/elm/src/cpl/lnd_comp_mct.F90 +++ b/components/elm/src/cpl/lnd_comp_mct.F90 @@ -791,7 +791,7 @@ end subroutine lnd_domain_mct #ifdef HAVE_MOAB subroutine init_land_moab(bounds, samegrid_al) - use seq_flds_mod , only : seq_flds_l2x_fields + use seq_flds_mod , only : seq_flds_l2x_fields, seq_flds_x2l_fields use shr_kind_mod , only : CXX => SHR_KIND_CXX use spmdMod , only: iam ! rank on the land communicator use domainMod , only: ldomain ! ldomain is coming from module, not even passed @@ -1029,6 +1029,12 @@ subroutine init_land_moab(bounds, samegrid_al) if ( ierr > 0) then call endrun('Error: fail to define seq_flds_l2x_fields for land moab mesh') endif + tagname = trim(seq_flds_x2l_fields)//C_NULL_CHAR + ierr = iMOAB_DefineTagStorage(mlnid, tagname, tagtype, numco, tagindex ) + if ( ierr > 0) then + call endrun('Error: fail to define seq_flds_x2l_fields for land moab mesh') + endif + end subroutine init_land_moab subroutine lnd_export_moab( bounds, lnd2atm_vars, lnd2glc_vars) From 479a524df15dd0d8ee5f73c814aa2c78e5688785 Mon Sep 17 00:00:00 2001 From: Robert Jacob Date: Thu, 29 Dec 2022 23:11:26 -0600 Subject: [PATCH 228/467] Add aream to atm mesh Add aream to atm mesh when its created. Its a copy of area --- components/eam/src/cpl/atm_comp_mct.F90 | 10 ++++++++++ 1 file changed, 10 insertions(+) diff --git a/components/eam/src/cpl/atm_comp_mct.F90 b/components/eam/src/cpl/atm_comp_mct.F90 index 1d8e6c83912d..4e4e1b37dc35 100644 --- a/components/eam/src/cpl/atm_comp_mct.F90 +++ b/components/eam/src/cpl/atm_comp_mct.F90 @@ -1224,6 +1224,16 @@ subroutine initialize_moab_atm_phys( cdata_a ) if (ierr > 0 ) & call endrun('Error: fail to set area tag ') + tagname='aream'//C_NULL_CHAR + tagtype = 1 ! dense, double + ierr = iMOAB_DefineTagStorage(mphaid, tagname, tagtype, numco, tagindex ) + if (ierr > 0 ) & + call endrun('Error: fail to create aream tag ') + + ierr = iMOAB_SetDoubleTagStorage ( mphaid, tagname, nlcols , ent_type, areavals) + if (ierr > 0 ) & + call endrun('Error: fail to set aream tag ') + ierr = iMOAB_UpdateMeshInfo(mphaid) #ifdef MOABDEBUG From 251622958d3ff6395412352701c390ea9cc74bff Mon Sep 17 00:00:00 2001 From: Robert Jacob Date: Thu, 29 Dec 2022 23:12:25 -0600 Subject: [PATCH 229/467] Add aream to elm moab mesh Add aream to elm moab mesh when its created. Copy of area. --- components/elm/src/cpl/lnd_comp_mct.F90 | 18 ++++++++++++++++++ 1 file changed, 18 insertions(+) diff --git a/components/elm/src/cpl/lnd_comp_mct.F90 b/components/elm/src/cpl/lnd_comp_mct.F90 index ac3e814cfd9a..eb72fa616311 100644 --- a/components/elm/src/cpl/lnd_comp_mct.F90 +++ b/components/elm/src/cpl/lnd_comp_mct.F90 @@ -918,6 +918,15 @@ subroutine init_land_moab(bounds, samegrid_al) if (ierr > 0 ) & call endrun('Error: fail to set area tag ') + ! aream needed in cime_init for now. + tagname='aream'//C_NULL_CHAR + ierr = iMOAB_DefineTagStorage(mlnid, tagname, tagtype, numco, tagindex ) + if (ierr > 0 ) & + call endrun('Error: fail to create aream tag ') + ierr = iMOAB_SetDoubleTagStorage ( mlnid, tagname, lsz , ent_type, moab_vert_coords ) + if (ierr > 0 ) & + call endrun('Error: fail to set aream tag ') + deallocate(moabconn) ! use merge vertices new imoab method to fix cells deallocate(vgids) ! use it for global ids, for elements in full mesh or vertices in point cloud @@ -1009,6 +1018,15 @@ subroutine init_land_moab(bounds, samegrid_al) ierr = iMOAB_SetDoubleTagStorage ( mlnid, tagname, lsz , ent_type, moab_vert_coords ) if (ierr > 0 ) & call endrun('Error: fail to set area tag ') + + ! aream needed in cime_init for now. + tagname='aream'//C_NULL_CHAR + ierr = iMOAB_DefineTagStorage(mlnid, tagname, tagtype, numco, tagindex ) + if (ierr > 0 ) & + call endrun('Error: fail to create aream tag ') + ierr = iMOAB_SetDoubleTagStorage ( mlnid, tagname, lsz , ent_type, moab_vert_coords ) + if (ierr > 0 ) & + call endrun('Error: fail to set aream tag ') endif deallocate(moab_vert_coords) deallocate(vgids) From 68545d7a4bb57d9d3b78edf2825a0aa52116b294 Mon Sep 17 00:00:00 2001 From: Robert Jacob Date: Thu, 29 Dec 2022 23:14:35 -0600 Subject: [PATCH 230/467] Add area and aream to mosart moab mesh Add area and aream to mosart moab mesh. Also add code to calculate area in moab section. aream is a copy of area. --- components/mosart/src/cpl/rof_comp_mct.F90 | 33 +++++++++++++++++++++- 1 file changed, 32 insertions(+), 1 deletion(-) diff --git a/components/mosart/src/cpl/rof_comp_mct.F90 b/components/mosart/src/cpl/rof_comp_mct.F90 index 452f5d4658f4..ddb1a6dfe8e3 100644 --- a/components/mosart/src/cpl/rof_comp_mct.F90 +++ b/components/mosart/src/cpl/rof_comp_mct.F90 @@ -800,9 +800,10 @@ subroutine init_rof_moab() integer,allocatable :: gindex(:) ! Number the local grid points; used for global ID integer lsz ! keep local size integer gsize ! global size, that we do not need, actually - integer n + integer n, ni ! local variables to fill in data integer, dimension(:), allocatable :: vgids + real(r8), dimension(:), allocatable :: coords ! retrieve everything we need from rtmCTL ! number of vertices is the size of local rof gsmap ? real(r8), dimension(:), allocatable :: moab_vert_coords ! temporary @@ -810,6 +811,7 @@ subroutine init_rof_moab() integer dims, i, iv, ilat, ilon, igdx, ierr, tagindex integer tagtype, numco, ent_type, mbtype, block_ID character*100 outfile, wopts, localmeshfile, tagname + real(r8) :: re = SHR_CONST_REARTH*0.001_r8 ! radius of earth (km) character(len=32), parameter :: sub = 'init_rof_moab' character(len=*), parameter :: format = "('("//trim(sub)//") :',A)" @@ -819,6 +821,7 @@ subroutine init_rof_moab() lsz = rtmCTL%lnumr allocate(vgids(lsz)) ! use it for global ids, for elements in full mesh or vertices in point cloud + allocate(coords(lsz)) ! use it for area, lats lons do n = 1, lsz vgids(n) = rtmCTL%gindex(rtmCTL%begr+n-1) ! local to global ! @@ -880,8 +883,36 @@ subroutine init_rof_moab() if (ierr > 0 ) & call shr_sys_abort( sub//' Error: fail to set mask tag ') + ni = 0 + do n = rtmCTL%begr,rtmCTL%endr + ni = ni + 1 + coords(ni) = rtmCTL%area(n)*1.0e-6_r8/(re*re) + end do + + tagname='area'//C_NULL_CHAR + tagtype = 1 ! dense, double + ierr = iMOAB_DefineTagStorage(mrofid, tagname, tagtype, numco, tagindex ) + if (ierr > 0 ) & + call shr_sys_abort(sub//' Error: fail to create area tag ') + + ierr = iMOAB_SetDoubleTagStorage ( mrofid, tagname, lsz , ent_type, coords) + if (ierr > 0 ) & + call shr_sys_abort(sub//' Error: fail to set area tag ') + + tagname='aream'//C_NULL_CHAR + tagtype = 1 ! dense, double + ierr = iMOAB_DefineTagStorage(mrofid, tagname, tagtype, numco, tagindex ) + if (ierr > 0 ) & + call shr_sys_abort(sub//' Error: fail to create aream tag ') + + ierr = iMOAB_SetDoubleTagStorage ( mrofid, tagname, lsz , ent_type, coords) + if (ierr > 0 ) & + call shr_sys_abort(sub//' Error: fail to set aream tag ') + + deallocate(moab_vert_coords) deallocate(vgids) + deallocate(coords) #ifdef MOABDEBUG ! write out the mesh file to disk, in parallel outfile = 'wholeRof.h5m'//C_NULL_CHAR From c6f07e454f473526b62d2f861453754f6cd787a9 Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Sat, 31 Dec 2022 17:32:55 -0600 Subject: [PATCH 231/467] forgotten commits main problem was one name +++ b/driver-moab/main/prep_ocn_mod.F90 @@ -528,8 +528,9 @@ contains mapper_SFi2o%src_mbid = mbixid mapper_SFi2o%tgt_mbid = mboxid ! no intersection, so will have to do without it - mapper_Va2o%src_context = ice(1)%cplcompid - mapper_Va2o%intx_context = ocn(1)%cplcompid + mapper_SFi2o%src_context = ice(1)%cplcompid + mapper_SFi2o%intx_context = ocn(1)%cplcompid + mapper_SFi2o%mbname = 'mapper_SFi2o' --- driver-moab/main/prep_ocn_mod.F90 | 5 +++-- driver-moab/main/seq_map_mod.F90 | 4 ++-- 2 files changed, 5 insertions(+), 4 deletions(-) diff --git a/driver-moab/main/prep_ocn_mod.F90 b/driver-moab/main/prep_ocn_mod.F90 index 16477c91365f..9c0857dc4b92 100644 --- a/driver-moab/main/prep_ocn_mod.F90 +++ b/driver-moab/main/prep_ocn_mod.F90 @@ -528,8 +528,9 @@ subroutine prep_ocn_init(infodata, atm_c2_ocn, atm_c2_ice, ice_c2_ocn, rof_c2_oc mapper_SFi2o%src_mbid = mbixid mapper_SFi2o%tgt_mbid = mboxid ! no intersection, so will have to do without it - mapper_Va2o%src_context = ice(1)%cplcompid - mapper_Va2o%intx_context = ocn(1)%cplcompid + mapper_SFi2o%src_context = ice(1)%cplcompid + mapper_SFi2o%intx_context = ocn(1)%cplcompid + mapper_SFi2o%mbname = 'mapper_SFi2o' if(mapper_SFi2o%copy_only) then call seq_map_set_type(mapper_SFi2o, mbixid, 1) ! type is cells diff --git a/driver-moab/main/seq_map_mod.F90 b/driver-moab/main/seq_map_mod.F90 index 1c6334bf7104..ca224f1467cc 100644 --- a/driver-moab/main/seq_map_mod.F90 +++ b/driver-moab/main/seq_map_mod.F90 @@ -531,7 +531,7 @@ subroutine seq_map_map( mapper, av_s, av_d, fldlist, norm, avwts_s, avwtsfld_s, ierr = iMOAB_SendElementTag( mapper%src_mbid, fldlist_moab, mapper%mpicom, mapper%intx_context ); if (ierr .ne. 0) then if (seq_comm_iamroot(CPLID)) then - write(logunit, *) subname,' iMOAB mapper error in sending tags ', trim(fldlist_moab) + write(logunit, *) subname,' iMOAB mapper error in sending tags ', mapper%mbname, trim(fldlist_moab) call shr_sys_flush(logunit) endif valid_moab_context = .false. @@ -541,7 +541,7 @@ subroutine seq_map_map( mapper, av_s, av_d, fldlist, norm, avwts_s, avwtsfld_s, ! receive in the intx app, because it is redistributed according to coverage (trick) ierr = iMOAB_ReceiveElementTag( mapper%intx_mbid, fldlist_moab, mapper%mpicom, mapper%src_context ); if (ierr .ne. 0) then - write(logunit,*) subname,' error in receiving tags ', trim(fldlist_moab) + write(logunit,*) subname,' error in receiving tags ', mapper%mbname, trim(fldlist_moab) !call shr_sys_abort(subname//' ERROR in receiving tags') valid_moab_context = .false. ! do not attempt to project endif From 40748e1fa6618ef399728e30e12ed11537136d62 Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Sat, 31 Dec 2022 17:37:01 -0600 Subject: [PATCH 232/467] intx id for lnd-atm intx --- driver-moab/main/prep_atm_mod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/driver-moab/main/prep_atm_mod.F90 b/driver-moab/main/prep_atm_mod.F90 index b4e00345d72d..2b33026112c1 100644 --- a/driver-moab/main/prep_atm_mod.F90 +++ b/driver-moab/main/prep_atm_mod.F90 @@ -541,7 +541,7 @@ subroutine prep_atm_init(infodata, ocn_c2_atm, ice_c2_atm, lnd_c2_atm, iac_c2_at endif mapper_Fl2a%src_mbid = mblxid mapper_Fl2a%tgt_mbid = mbaxid - mapper_Fl2a%src_mbid = mbintxla + mapper_Fl2a%intx_mbid = mbintxla mapper_Fl2a%src_context = lnd(1)%cplcompid mapper_Fl2a%intx_context = idintx wgtIdef = 'scalar'//C_NULL_CHAR From 184116aa347eed0d99b2983051394e3ed48f230e Mon Sep 17 00:00:00 2001 From: Robert Jacob Date: Sat, 31 Dec 2022 17:56:49 -0600 Subject: [PATCH 233/467] Add area and aream to moab mesh Add area and aream tags and values to moab mesh --- .../src/framework/mpas_moabmesh.F | 38 +++++++++++++++++-- 1 file changed, 34 insertions(+), 4 deletions(-) diff --git a/components/mpas-framework/src/framework/mpas_moabmesh.F b/components/mpas-framework/src/framework/mpas_moabmesh.F index 9ccbf97e8ee0..c7fe6e8a45f0 100644 --- a/components/mpas-framework/src/framework/mpas_moabmesh.F +++ b/components/mpas-framework/src/framework/mpas_moabmesh.F @@ -29,7 +29,7 @@ subroutine mpas_moab_instance(domain, ext_comp_id, pidmoab) iMOAB_CreateVertices, iMOAB_CreateElements, & iMOAB_ResolveSharedEntities, iMOAB_DetermineGhostEntities, & iMOAB_DefineTagStorage, iMOAB_SetIntTagStorage , & - iMOAB_UpdateMeshInfo + iMOAB_UpdateMeshInfo, iMOAB_SetDoubleTagStorage type (domain_type), intent(inout) :: domain integer , intent(in) :: ext_comp_id @@ -43,20 +43,21 @@ subroutine mpas_moab_instance(domain, ext_comp_id, pidmoab) integer, dimension(:), pointer :: nEdgesOnCell integer, dimension(:), pointer :: indexToVertexID, indexToCellID real(kind=RKIND), dimension(:), pointer :: xVertex, yVertex, zVertex - real (kind=RKIND), dimension(:), pointer :: xCell, yCell, zCell + real (kind=RKIND), dimension(:), pointer :: xCell, yCell, zCell, areaCell logical, pointer :: on_a_sphere, is_periodic real(kind=RKIND), pointer :: x_period, y_period integer, pointer :: nCellsSolve, nEdgesSolve, nVerticesSolve - integer :: c_comm, i1, j1, ic, lastvertex + integer :: c_comm, i1, j1, ic, lastvertex,n character*12 appname integer :: ierr, num_verts_in_cells - real(kind=RKIND), allocatable, target :: moab_vert_coords(:) + real(kind=RKIND), allocatable, target :: moab_vert_coords(:), data(:) integer, allocatable, target :: indexUsed(:), invMap(:), localIds(:) integer dimcoord, dimen, mbtype, block_ID, proc_id integer ,allocatable , target :: all_connects(:) character*100 tagname, lnum integer tagtype, numco, tag_sto_len, ent_type, tagindex, currentVertex + real (kind=RKIND), pointer :: sphere_radius c_comm = domain % dminfo % comm write(lnum,"(I0.2)")ext_comp_id @@ -91,6 +92,8 @@ subroutine mpas_moab_instance(domain, ext_comp_id, pidmoab) call mpas_pool_get_dimension(meshPool, 'nCellsSolve', nCellsSolve) call mpas_pool_get_dimension(meshPool, 'nEdgesSolve', nEdgesSolve) call mpas_pool_get_dimension(meshPool, 'nVerticesSolve', nVerticesSolve) + call mpas_pool_get_array(meshPool, 'areaCell', areaCell) + call mpas_pool_get_config(meshPool, 'sphere_radius', sphere_radius) ! call mpas_pool_get_array(meshPool, 'xCell', xCell) ! call mpas_pool_get_array(meshPool, 'yCell', yCell) ! call mpas_pool_get_array(meshPool, 'zCell', zCell) @@ -151,6 +154,7 @@ subroutine mpas_moab_instance(domain, ext_comp_id, pidmoab) ierr = iMOAB_CreateElements( pid, nCellsSolve, mbtype, maxEdges, all_connects, block_ID ); call errorout(ierr, 'fail to create polygons') + ! set the global id for vertices ! first, retrieve the tag tagname='GLOBAL_ID'//C_NULL_CHAR @@ -166,6 +170,7 @@ subroutine mpas_moab_instance(domain, ext_comp_id, pidmoab) enddo ierr = iMOAB_SetIntTagStorage ( pid, tagname, currentVertex , ent_type, localIds ) call errorout(ierr, 'fail to set global id tag for vertices') + ! set global id tag for elements ent_type = 1 ! now set the global id tag on elements ierr = iMOAB_SetIntTagStorage ( pid, tagname, nCellsSolve, ent_type, indexToCellID) @@ -174,7 +179,32 @@ subroutine mpas_moab_instance(domain, ext_comp_id, pidmoab) ierr = iMOAB_ResolveSharedEntities( pid, currentVertex, localIds ); call errorout(ierr, 'fail to resolve shared entities') + allocate(data(nCellsSolve)) + n=0 + do ic=1, nCellsSolve + n= n+1 + data(n)=areaCell(ic) / (sphere_radius * sphere_radius) + enddo + + tagname='area'//C_NULL_CHAR + tagtype = 1 + ierr = iMOAB_DefineTagStorage(pid, tagname, tagtype, numco, tagindex ) + if (ierr > 0 ) & + call errorout(ierr, 'Error: fail to create area tag ') + ierr = iMOAB_SetDoubleTagStorage ( pid, tagname, nCellsSolve , ent_type, data) + if (ierr > 0 ) & + call errorout(ierr,'Error: fail to set area tag ') + + tagname='aream'//C_NULL_CHAR + ierr = iMOAB_DefineTagStorage(pid, tagname, tagtype, numco, tagindex ) + if (ierr > 0 ) & + call errorout(ierr,'Error: fail to create aream tag ') + ierr = iMOAB_SetDoubleTagStorage ( pid, tagname, nCellsSolve , ent_type, data) + if (ierr > 0 ) & + call errorout(ierr,'Error: fail to set aream tag ') + deallocate (moab_vert_coords) + deallocate (data) deallocate (all_connects) deallocate (indexUsed) deallocate (invMap) From 90708284e3cdad37ff0e169376d21728cd7d66f8 Mon Sep 17 00:00:00 2001 From: Robert Jacob Date: Sun, 1 Jan 2023 16:10:49 -0600 Subject: [PATCH 234/467] Add more tags to coupler-side meshes Add the domain tags to all the coupler-side meshes. Also add r2x and x2r fields to the river-coupler mesh Move the write of RecvAtm.h5m to after tags added. Fix a few comments. Add a call to exchangee aream from atm component to coupler. --- driver-moab/main/cplcomp_exchange_mod.F90 | 106 +++++++++++++++++----- 1 file changed, 85 insertions(+), 21 deletions(-) diff --git a/driver-moab/main/cplcomp_exchange_mod.F90 b/driver-moab/main/cplcomp_exchange_mod.F90 index f0f459a433fd..3a794d3d324d 100644 --- a/driver-moab/main/cplcomp_exchange_mod.F90 +++ b/driver-moab/main/cplcomp_exchange_mod.F90 @@ -9,11 +9,13 @@ module cplcomp_exchange_mod use seq_map_type_mod use component_type_mod use seq_flds_mod, only: seq_flds_dom_coord, seq_flds_dom_other + use seq_flds_mod, only: seq_flds_dom_fields use seq_flds_mod, only: seq_flds_a2x_ext_fields, seq_flds_a2x_fields, seq_flds_x2a_fields ! use seq_flds_mod, only: seq_flds_o2x_fields ! needed for MOAB init of ocean fields o2x to be able to transfer to coupler use seq_flds_mod, only: seq_flds_x2o_fields ! needed for MOAB init of ocean fields x2o to be able to transfer from coupler use seq_flds_mod, only: seq_flds_i2x_fields, seq_flds_x2i_fields ! needed for MOAB init of ice fields x2o on coupler side, to save them use seq_flds_mod, only: seq_flds_l2x_fields, seq_flds_x2l_fields ! + use seq_flds_mod, only: seq_flds_r2x_fields, seq_flds_x2r_fields ! use seq_comm_mct, only: cplid, logunit use seq_comm_mct, only: seq_comm_getinfo => seq_comm_setptrs, seq_comm_iamin use seq_diag_mct @@ -991,6 +993,7 @@ subroutine cplcomp_moab_Init(comp) use iMOAB, only: iMOAB_RegisterApplication, iMOAB_ReceiveMesh, iMOAB_SendMesh, & iMOAB_WriteMesh, iMOAB_DefineTagStorage, iMOAB_GetMeshInfo, & iMOAB_SetIntTagStorage, iMOAB_FreeSenderBuffers, iMOAB_ComputeCommGraph + use component_mod, only: component_exch_moab ! type(component_type), intent(inout) :: comp ! @@ -1014,9 +1017,9 @@ subroutine cplcomp_moab_Init(comp) integer :: tagtype, numco, tagindex, partMethod integer :: rank, ent_type integer :: typeA, typeB, ATM_PHYS_CID ! used to compute par graph between atm phys + ! and atm spectral on coupler integer :: ID_JOIN_ATMPHYS ! 200 + 6 integer :: ID_OLD_ATMPHYS ! 200 + 5 - ! and atm spectral on coupler character(CXX) :: tagname #ifdef MOABDEBUG integer , dimension(1:3) :: nverts, nelem, nblocks, nsbc, ndbc @@ -1086,21 +1089,7 @@ subroutine cplcomp_moab_Init(comp) write(logunit,*) subname,' error in receiving mesh on atm coupler ' call shr_sys_abort(subname//' ERROR in receiving mesh on atm coupler ') endif -#ifdef MOABDEBUG - ! debug test - if (atm_pg_active) then ! - outfile = 'recMeshAtmPG.h5m'//C_NULL_CHAR - else - outfile = 'recMeshAtm.h5m'//C_NULL_CHAR - endif - wopts = ';PARALLEL=WRITE_PART'//C_NULL_CHAR - ! write out the mesh file to disk - ierr = iMOAB_WriteMesh(mbaxid, trim(outfile), trim(wopts)) - if (ierr .ne. 0) then - write(logunit,*) subname,' error in writing mesh ' - call shr_sys_abort(subname//' ERROR in writing mesh ') - endif -#endif + endif ! iMOAB_FreeSenderBuffers needs to be called after receiving the mesh @@ -1162,7 +1151,41 @@ subroutine cplcomp_moab_Init(comp) call shr_sys_abort(subname//' ERROR in defining tags ') endif + tagname = trim(seq_flds_dom_fields)//C_NULL_CHAR + ierr = iMOAB_DefineTagStorage(mbaxid, tagname, tagtype, numco, tagindex ) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in defining tags seq_flds_dom_fields on atm on coupler ' + call shr_sys_abort(subname//' ERROR in defining tags ') + endif + endif + + ! send aream values from component to coupler + tagname = 'aream' + if (MPI_COMM_NULL /= mpicom_join ) then ! we are on the joint pes + call component_exch_moab(comp, mphaid, mbaxid, 0, tagname) + endif + +#ifdef MOABDEBUG + if (MPI_COMM_NULL /= mpicom_new ) then ! we are on the coupler pes + ! debug test + if (atm_pg_active) then ! + outfile = 'recMeshAtmPG.h5m'//C_NULL_CHAR + else + outfile = 'recMeshAtm.h5m'//C_NULL_CHAR + endif + wopts = ';PARALLEL=WRITE_PART'//C_NULL_CHAR + ! write out the mesh file to disk + ierr = iMOAB_WriteMesh(mbaxid, trim(outfile), trim(wopts)) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in writing mesh ' + call shr_sys_abort(subname//' ERROR in writing mesh ') + endif + endif +#endif + + + endif ! ocean if (comp%oneletterid == 'o' .and. maxMPO /= -1) then @@ -1211,6 +1234,13 @@ subroutine cplcomp_moab_Init(comp) call shr_sys_abort(subname//' ERROR in defining tags x2o on coupler ') endif + tagname = trim(seq_flds_dom_fields)//C_NULL_CHAR + ierr = iMOAB_DefineTagStorage(mboxid, tagname, tagtype, numco, tagindex ) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in defining tags seq_flds_dom_fields on ocn on coupler ' + call shr_sys_abort(subname//' ERROR in defining tags ') + endif + #ifdef MOABDEBUG ! debug test outfile = 'recMeshOcn.h5m'//C_NULL_CHAR @@ -1280,7 +1310,7 @@ subroutine cplcomp_moab_Init(comp) endif if (MPI_COMM_NULL /= mpicom_new ) then ! we are on the coupler pes appname = "COUPLE_LAND"//C_NULL_CHAR - ! migrated mesh gets another app id, moab ocean to coupler (mbox) + ! migrated mesh gets another app id, moab land to coupler (mblx) ierr = iMOAB_RegisterApplication(trim(appname), mpicom_new, id_join, mblxid) if (ierr .ne. 0) then write(logunit,*) subname,' error in registering coupler land ' @@ -1301,7 +1331,7 @@ subroutine cplcomp_moab_Init(comp) write(logunit,*) subname,' error in defining tags l2x on coupler land' call shr_sys_abort(subname//' ERROR in defining tags l2x on coupler ') endif - ! need also to define seq_flds_x2o_fields on coupler instance, and on ocean comp instance + ! need also to define seq_flds_x2l_fields on coupler instance, and on land comp instance tagname = trim(seq_flds_x2l_fields)//C_NULL_CHAR ierr = iMOAB_DefineTagStorage(mblxid, tagname, tagtype, numco, tagindex ) if (ierr .ne. 0) then @@ -1309,6 +1339,13 @@ subroutine cplcomp_moab_Init(comp) call shr_sys_abort(subname//' ERROR in defining tags x2l on coupler land') endif + tagname = trim(seq_flds_dom_fields)//C_NULL_CHAR + ierr = iMOAB_DefineTagStorage(mblxid, tagname, tagtype, numco, tagindex ) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in defining tags seq_flds_dom_fields on lnd on coupler ' + call shr_sys_abort(subname//' ERROR in defining tags ') + endif + #ifdef MOABDEBUG ! debug test ! if only vertices, set a partition tag for help in visualizations @@ -1371,7 +1408,7 @@ subroutine cplcomp_moab_Init(comp) endif if (MPI_COMM_NULL /= mpicom_new ) then ! we are on the coupler pes appname = "COUPLE_MPASSI"//C_NULL_CHAR - ! migrated mesh gets another app id, moab moab sea ice to coupler (mbox) + ! migrated mesh gets another app id, moab moab sea ice to coupler (mbix) ierr = iMOAB_RegisterApplication(trim(appname), mpicom_new, id_join, mbixid) ierr = iMOAB_ReceiveMesh(mbixid, mpicom_join, mpigrp_old, id_old) tagtype = 1 ! dense, double @@ -1386,6 +1423,13 @@ subroutine cplcomp_moab_Init(comp) if ( ierr == 1 ) then call shr_sys_abort( subname//' ERROR: cannot define tags for ice on coupler' ) end if + + tagname = trim(seq_flds_dom_fields)//C_NULL_CHAR + ierr = iMOAB_DefineTagStorage(mbixid, tagname, tagtype, numco, tagindex ) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in defining tags seq_flds_dom_fields on ice on coupler ' + call shr_sys_abort(subname//' ERROR in defining tags ') + endif #ifdef MOABDEBUG ! debug test outfile = 'recSeaIce.h5m'//C_NULL_CHAR @@ -1424,9 +1468,29 @@ subroutine cplcomp_moab_Init(comp) endif if (MPI_COMM_NULL /= mpicom_new ) then ! we are on the coupler pes appname = "COUPLE_MROF"//C_NULL_CHAR - ! migrated mesh gets another app id, moab moab rof to coupler (mbox) + ! migrated mesh gets another app id, moab moab rof to coupler (mbrx) ierr = iMOAB_RegisterApplication(trim(appname), mpicom_new, id_join, mbrxid) ierr = iMOAB_ReceiveMesh(mbrxid, mpicom_join, mpigrp_old, id_old) + + tagtype = 1 ! dense, double + numco = 1 ! one value per cell / entity + tagname = trim(seq_flds_r2x_fields)//C_NULL_CHAR + ierr = iMOAB_DefineTagStorage(mbrxid, tagname, tagtype, numco, tagindex ) + if ( ierr == 1 ) then + call shr_sys_abort( subname//' ERROR: cannot define tags for rof on coupler' ) + end if + tagname = trim(seq_flds_x2r_fields)//C_NULL_CHAR + ierr = iMOAB_DefineTagStorage(mbrxid, tagname, tagtype, numco, tagindex ) + if ( ierr == 1 ) then + call shr_sys_abort( subname//' ERROR: cannot define tags for rof on coupler' ) + end if + + tagname = trim(seq_flds_dom_fields)//C_NULL_CHAR + ierr = iMOAB_DefineTagStorage(mbrxid, tagname, tagtype, numco, tagindex ) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in defining tags seq_flds_dom_fields on rof on coupler ' + call shr_sys_abort(subname//' ERROR in defining tags ') + endif #ifdef MOABDEBUG ! debug test outfile = 'recRof.h5m'//C_NULL_CHAR @@ -1439,7 +1503,7 @@ subroutine cplcomp_moab_Init(comp) endif #endif endif - if (mrofid .ge. 0) then ! we are on component sea ice pes + if (mrofid .ge. 0) then ! we are on component rof pes context_id = id_join ierr = iMOAB_FreeSenderBuffers(mrofid, context_id) if (ierr .ne. 0) then From 1546281db96587128f2236a87dae8a22e79110c9 Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Mon, 2 Jan 2023 13:56:55 -0600 Subject: [PATCH 235/467] mask tag should be double in moab too it is used in projections --- components/eam/src/cpl/atm_comp_mct.F90 | 53 +++++++++++++++++----- components/mosart/src/cpl/rof_comp_mct.F90 | 5 +- 2 files changed, 44 insertions(+), 14 deletions(-) diff --git a/components/eam/src/cpl/atm_comp_mct.F90 b/components/eam/src/cpl/atm_comp_mct.F90 index 4e4e1b37dc35..57dee37d118c 100644 --- a/components/eam/src/cpl/atm_comp_mct.F90 +++ b/components/eam/src/cpl/atm_comp_mct.F90 @@ -9,7 +9,7 @@ module atm_comp_mct use seq_cdata_mod use esmf - use seq_flds_mod ! for seq_flds_x2a_fields + use seq_flds_mod ! for seq_flds_x2a_fields, seq_flds_dom_fields, etc use seq_infodata_mod use seq_timemgr_mod @@ -1120,7 +1120,7 @@ subroutine initialize_moab_atm_phys( cdata_a ) real(r8) :: lons(pcols) ! array of chunk longitude real(r8) :: area(pcols) ! area in radians squared for each grid point integer , dimension(:), allocatable :: chunk_index(:) ! temporary - !real(r8), parameter:: radtodeg = 180.0_r8/SHR_CONST_PI + real(r8), parameter:: radtodeg = 180.0_r8/SHR_CONST_PI character*100 outfile, wopts character(CXX) :: tagname ! will store all seq_flds_a2x_fields @@ -1189,6 +1189,10 @@ subroutine initialize_moab_atm_phys( cdata_a ) if (ierr > 0 ) & call endrun('Error: fail to resolve shared entities') + ierr = iMOAB_UpdateMeshInfo(mphaid) + if (ierr > 0 ) & + call endrun('Error: fail to update mesh info') + !there are no shared entities, but we will set a special partition tag, in order to see the ! partitions ; it will be visible with a Pseudocolor plot in VisIt tagname='partition'//C_NULL_CHAR @@ -1209,32 +1213,57 @@ subroutine initialize_moab_atm_phys( cdata_a ) ierr = iMOAB_SetIntTagStorage ( mphaid, tagname, nlcols , ent_type, chunk_index) if (ierr > 0 ) & - call endrun('Error: fail to set partition tag ') + call endrun('Error: fail to set chunk id tag tag ') - ! use areavals for areas + ! use areavals for area, aream; define also dom fields + ! define all on moab - tagname='area'//C_NULL_CHAR + tagname=trim(seq_flds_dom_fields)//C_NULL_CHAR ! mask is double too lat:lon:hgt:area:aream:mask:frac tagtype = 1 ! dense, double ierr = iMOAB_DefineTagStorage(mphaid, tagname, tagtype, numco, tagindex ) if (ierr > 0 ) & - call endrun('Error: fail to create area tag ') - + call endrun('Error: fail to create tags from seq_flds_dom_fields ') + tagname='area'//C_NULL_CHAR ierr = iMOAB_SetDoubleTagStorage ( mphaid, tagname, nlcols , ent_type, areavals) if (ierr > 0 ) & call endrun('Error: fail to set area tag ') tagname='aream'//C_NULL_CHAR - tagtype = 1 ! dense, double - ierr = iMOAB_DefineTagStorage(mphaid, tagname, tagtype, numco, tagindex ) + ierr = iMOAB_SetDoubleTagStorage ( mphaid, tagname, nlcols , ent_type, areavals) if (ierr > 0 ) & - call endrun('Error: fail to create aream tag ') + call endrun('Error: fail to set aream tag ') + areavals = 1._r8 ! double + tagname='mask'//C_NULL_CHAR ierr = iMOAB_SetDoubleTagStorage ( mphaid, tagname, nlcols , ent_type, areavals) if (ierr > 0 ) & - call endrun('Error: fail to set aream tag ') + call endrun('Error: fail to set mask tag ') + + areavals = 1._r8 ! double + + ! set lat, lon, and frac tags at the same time, reusing the moab_vert_coords array already allocated + ! we set all at the same time, so use the 1-d array carefully, with values interlaced/or not + n=0 + do c = begchunk, endchunk + ncols = get_ncols_p(c) + call get_rlat_all_p(c, ncols, lats) ! + call get_rlon_all_p(c, ncols, lons) + do i = 1,ncols + n=n+1 + vgids(n) = get_gcol_p(c,i) + latv = lats(i) ! these are in rads ? + lonv = lons(i) + moab_vert_coords( n ) = lats(i) * radtodeg + moab_vert_coords( nlcols + n ) = lons(i) * radtodeg + moab_vert_coords( 2*nlcols + n )= 1._r8 ! this for fractions + end do + end do + tagname = 'lat:lon:frac'//C_NULL_CHAR + ierr = iMOAB_SetDoubleTagStorage ( mphaid, tagname, nlcols*3 , ent_type, moab_vert_coords) + if (ierr > 0 ) & + call endrun('Error: fail to set lat lon frac tag ') - ierr = iMOAB_UpdateMeshInfo(mphaid) #ifdef MOABDEBUG outfile = 'AtmPhys.h5m'//C_NULL_CHAR diff --git a/components/mosart/src/cpl/rof_comp_mct.F90 b/components/mosart/src/cpl/rof_comp_mct.F90 index ddb1a6dfe8e3..9a1aacc035b1 100644 --- a/components/mosart/src/cpl/rof_comp_mct.F90 +++ b/components/mosart/src/cpl/rof_comp_mct.F90 @@ -871,15 +871,16 @@ subroutine init_rof_moab() ! mask tagname='mask'//C_NULL_CHAR + tagtype = 1 ! dense, double; make mask double too ierr = iMOAB_DefineTagStorage(mrofid, tagname, tagtype, numco, tagindex ) if (ierr > 0 ) & call shr_sys_abort( sub//' Error: fail to create new mask tag ') do n = 1, lsz - vgids(n) = rtmCTL%mask(rtmCTL%begr+n-1) ! local to global ! + coords(n) = rtmCTL%mask(rtmCTL%begr+n-1) ! local to global ! end do - ierr = iMOAB_SetIntTagStorage ( mrofid, tagname, lsz , ent_type, vgids) + ierr = iMOAB_SetDoubleTagStorage ( mrofid, tagname, lsz , ent_type, coords) if (ierr > 0 ) & call shr_sys_abort( sub//' Error: fail to set mask tag ') From 564c043b59213b8afde9f82d32b2fc1b839b8888 Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Mon, 2 Jan 2023 16:26:44 -0600 Subject: [PATCH 236/467] land context for samegrid_al, land and atm are not intersecting, mapping is a rearrange use same context as when we compute comm graph between atm and land --- driver-moab/main/prep_lnd_mod.F90 | 3 ++- driver-moab/main/seq_map_mod.F90 | 9 +++++---- 2 files changed, 7 insertions(+), 5 deletions(-) diff --git a/driver-moab/main/prep_lnd_mod.F90 b/driver-moab/main/prep_lnd_mod.F90 index 395be38c47c3..465c3369c901 100644 --- a/driver-moab/main/prep_lnd_mod.F90 +++ b/driver-moab/main/prep_lnd_mod.F90 @@ -342,6 +342,7 @@ subroutine prep_lnd_init(infodata, atm_c2_lnd, rof_c2_lnd, glc_c2_lnd, iac_c2_ln write(logunit,*) subname,' error in computing comm graph for second hop, atm-lnd' call shr_sys_abort(subname//' ERROR in computing comm graph for second hop, atm-lnd') endif + mapper_Sa2l%intx_context = lnd(1)%cplcompid endif ! if tri-grid @@ -350,7 +351,7 @@ subroutine prep_lnd_init(infodata, atm_c2_lnd, rof_c2_lnd, glc_c2_lnd, iac_c2_ln mapper_Fa2l%tgt_mbid = mblxid mapper_Fa2l%intx_mbid = mbintxal mapper_Fa2l%src_context = lnd(1)%cplcompid - mapper_Fa2l%intx_context = idintx + mapper_Fa2l%intx_context = mapper_Sa2l%intx_context wgtIdef = 'scalar'//C_NULL_CHAR mapper_Fa2l%weight_identifier = wgtIdef mapper_Fa2l%mbname = 'mapper_Fa2l' diff --git a/driver-moab/main/seq_map_mod.F90 b/driver-moab/main/seq_map_mod.F90 index ca224f1467cc..e50880339fa8 100644 --- a/driver-moab/main/seq_map_mod.F90 +++ b/driver-moab/main/seq_map_mod.F90 @@ -467,13 +467,13 @@ subroutine seq_map_map( mapper, av_s, av_d, fldlist, norm, avwts_s, avwtsfld_s, if ( valid_moab_context ) then ! right now, this is used for ice-ocn projection, which involves just a send/recv, usually if (seq_comm_iamroot(CPLID)) then - write(logunit, *) subname,' iMOAB rearrange mapper before sending ', trim(fldlist_moab) + write(logunit, *) subname,' iMOAB mapper ', mapper%mbname, ' rearrange mapper before sending ', trim(fldlist_moab) call shr_sys_flush(logunit) endif ierr = iMOAB_SendElementTag( mapper%src_mbid, fldlist_moab, mapper%mpicom, mapper%intx_context ); if (ierr .ne. 0) then if (seq_comm_iamroot(CPLID)) then - write(logunit, *) subname,' iMOAB mapper error in sending tags ', trim(fldlist_moab) + write(logunit, *) subname,' iMOAB mapper ', mapper%mbname, ' error in sending tags ', trim(fldlist_moab) call shr_sys_flush(logunit) endif valid_moab_context = .false. @@ -484,10 +484,11 @@ subroutine seq_map_map( mapper, av_s, av_d, fldlist, norm, avwts_s, avwtsfld_s, write(logunit, *) subname,' iMOAB mapper before receiving ', trim(fldlist_moab) call shr_sys_flush(logunit) endif - ! receive in the intx app, because it is redistributed according to coverage (trick) + ! receive in the target app ierr = iMOAB_ReceiveElementTag( mapper%tgt_mbid, fldlist_moab, mapper%mpicom, mapper%src_context ); if (ierr .ne. 0) then - write(logunit,*) subname,' error in receiving tags ', trim(fldlist_moab) + write(logunit,*) subname,' error in receiving tags iMOAB mapper ', mapper%mbname, trim(fldlist_moab) + call shr_sys_flush(logunit) !call shr_sys_abort(subname//' ERROR in receiving tags') endif ! now free buffers From 7272f11bf083445158b2e4df4c3004d880738e11 Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Mon, 2 Jan 2023 17:22:40 -0600 Subject: [PATCH 237/467] fix land atm same grid case too intx context is target id in this case, as no intx happens it is just a rearrange --- driver-moab/main/prep_atm_mod.F90 | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/driver-moab/main/prep_atm_mod.F90 b/driver-moab/main/prep_atm_mod.F90 index 2b33026112c1..71693774e0e4 100644 --- a/driver-moab/main/prep_atm_mod.F90 +++ b/driver-moab/main/prep_atm_mod.F90 @@ -598,6 +598,8 @@ subroutine prep_atm_init(infodata, ocn_c2_atm, ice_c2_atm, lnd_c2_atm, iac_c2_at write(logunit,*) subname,' error in computing comm graph for second hop, lnd-atm' call shr_sys_abort(subname//' ERROR in computing comm graph for second hop, lnd-atm') endif + ! context for rearrange is target in this case + mapper_Fl2a%intx_context = atm(1)%cplcompid endif ! if tri-grid ! we still need to defne seq_flds_l2x_fields on atm cpl mesh @@ -632,7 +634,7 @@ subroutine prep_atm_init(infodata, ocn_c2_atm, ice_c2_atm, lnd_c2_atm, iac_c2_at mapper_Sl2a%tgt_mbid = mbaxid mapper_Sl2a%src_mbid = mbintxla mapper_Sl2a%src_context = lnd(1)%cplcompid - mapper_Sl2a%intx_context = idintx + mapper_Sl2a%intx_context = mapper_Fl2a%intx_context wgtIdef = 'scalar'//C_NULL_CHAR mapper_Sl2a%weight_identifier = wgtIdef mapper_Sl2a%mbname = 'mapper_Sl2a' From 8b79e9888b12397b2cdb5b2028300a4fa56f76a6 Mon Sep 17 00:00:00 2001 From: Robert Jacob Date: Mon, 2 Jan 2023 19:33:38 -0600 Subject: [PATCH 238/467] Add seq_domain tags to mosart moab mesh Add all seq_domain tags to mosart moab mesh. --- components/mosart/src/cpl/rof_comp_mct.F90 | 18 ++++++------------ 1 file changed, 6 insertions(+), 12 deletions(-) diff --git a/components/mosart/src/cpl/rof_comp_mct.F90 b/components/mosart/src/cpl/rof_comp_mct.F90 index 9a1aacc035b1..3ea9f8b00934 100644 --- a/components/mosart/src/cpl/rof_comp_mct.F90 +++ b/components/mosart/src/cpl/rof_comp_mct.F90 @@ -869,17 +869,19 @@ subroutine init_rof_moab() if (ierr > 0 ) & call shr_sys_abort( sub//' Error: fail to set partition tag ') - ! mask - tagname='mask'//C_NULL_CHAR - tagtype = 1 ! dense, double; make mask double too + ! set domain tags + tagtype = 1 ! dense, double; + + tagname=seq_flds_dom_fields//C_NULL_CHAR ierr = iMOAB_DefineTagStorage(mrofid, tagname, tagtype, numco, tagindex ) if (ierr > 0 ) & - call shr_sys_abort( sub//' Error: fail to create new mask tag ') + call shr_sys_abort( sub//' Error: fail to create domain tags ') do n = 1, lsz coords(n) = rtmCTL%mask(rtmCTL%begr+n-1) ! local to global ! end do + tagname='mask'//C_NULL_CHAR ierr = iMOAB_SetDoubleTagStorage ( mrofid, tagname, lsz , ent_type, coords) if (ierr > 0 ) & call shr_sys_abort( sub//' Error: fail to set mask tag ') @@ -891,20 +893,12 @@ subroutine init_rof_moab() end do tagname='area'//C_NULL_CHAR - tagtype = 1 ! dense, double - ierr = iMOAB_DefineTagStorage(mrofid, tagname, tagtype, numco, tagindex ) - if (ierr > 0 ) & - call shr_sys_abort(sub//' Error: fail to create area tag ') ierr = iMOAB_SetDoubleTagStorage ( mrofid, tagname, lsz , ent_type, coords) if (ierr > 0 ) & call shr_sys_abort(sub//' Error: fail to set area tag ') tagname='aream'//C_NULL_CHAR - tagtype = 1 ! dense, double - ierr = iMOAB_DefineTagStorage(mrofid, tagname, tagtype, numco, tagindex ) - if (ierr > 0 ) & - call shr_sys_abort(sub//' Error: fail to create aream tag ') ierr = iMOAB_SetDoubleTagStorage ( mrofid, tagname, lsz , ent_type, coords) if (ierr > 0 ) & From 8db3122120021339c869e5e13c301e4137705ed1 Mon Sep 17 00:00:00 2001 From: Robert Jacob Date: Mon, 2 Jan 2023 19:38:37 -0600 Subject: [PATCH 239/467] Add domain tags to mpas moab mesh Add all domain tags to mpas moab mesh on mpas side. --- .../mpas-framework/src/framework/mpas_moabmesh.F | 11 ++++++----- 1 file changed, 6 insertions(+), 5 deletions(-) diff --git a/components/mpas-framework/src/framework/mpas_moabmesh.F b/components/mpas-framework/src/framework/mpas_moabmesh.F index c7fe6e8a45f0..2d52ad6c36d7 100644 --- a/components/mpas-framework/src/framework/mpas_moabmesh.F +++ b/components/mpas-framework/src/framework/mpas_moabmesh.F @@ -30,6 +30,7 @@ subroutine mpas_moab_instance(domain, ext_comp_id, pidmoab) iMOAB_ResolveSharedEntities, iMOAB_DetermineGhostEntities, & iMOAB_DefineTagStorage, iMOAB_SetIntTagStorage , & iMOAB_UpdateMeshInfo, iMOAB_SetDoubleTagStorage + use seq_flds_mod, only: seq_flds_dom_fields type (domain_type), intent(inout) :: domain integer , intent(in) :: ext_comp_id @@ -186,19 +187,19 @@ subroutine mpas_moab_instance(domain, ext_comp_id, pidmoab) data(n)=areaCell(ic) / (sphere_radius * sphere_radius) enddo - tagname='area'//C_NULL_CHAR + ! add domain tags + tagname=seq_flds_dom_fields//C_NULL_CHAR tagtype = 1 ierr = iMOAB_DefineTagStorage(pid, tagname, tagtype, numco, tagindex ) if (ierr > 0 ) & - call errorout(ierr, 'Error: fail to create area tag ') + call errorout(ierr, 'Error: fail to define domain tags ') + + tagname='area'//C_NULL_CHAR ierr = iMOAB_SetDoubleTagStorage ( pid, tagname, nCellsSolve , ent_type, data) if (ierr > 0 ) & call errorout(ierr,'Error: fail to set area tag ') tagname='aream'//C_NULL_CHAR - ierr = iMOAB_DefineTagStorage(pid, tagname, tagtype, numco, tagindex ) - if (ierr > 0 ) & - call errorout(ierr,'Error: fail to create aream tag ') ierr = iMOAB_SetDoubleTagStorage ( pid, tagname, nCellsSolve , ent_type, data) if (ierr > 0 ) & call errorout(ierr,'Error: fail to set aream tag ') From 76074bc41464b24f6eda943bab8766112c4e1aee Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Mon, 2 Jan 2023 20:20:22 -0600 Subject: [PATCH 240/467] comment out aream exchange --- driver-moab/main/cplcomp_exchange_mod.F90 | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/driver-moab/main/cplcomp_exchange_mod.F90 b/driver-moab/main/cplcomp_exchange_mod.F90 index 3a794d3d324d..5eacaef33a6d 100644 --- a/driver-moab/main/cplcomp_exchange_mod.F90 +++ b/driver-moab/main/cplcomp_exchange_mod.F90 @@ -993,7 +993,7 @@ subroutine cplcomp_moab_Init(comp) use iMOAB, only: iMOAB_RegisterApplication, iMOAB_ReceiveMesh, iMOAB_SendMesh, & iMOAB_WriteMesh, iMOAB_DefineTagStorage, iMOAB_GetMeshInfo, & iMOAB_SetIntTagStorage, iMOAB_FreeSenderBuffers, iMOAB_ComputeCommGraph - use component_mod, only: component_exch_moab + ! use component_mod, only: component_exch_moab ! type(component_type), intent(inout) :: comp ! @@ -1161,10 +1161,10 @@ subroutine cplcomp_moab_Init(comp) endif ! send aream values from component to coupler - tagname = 'aream' - if (MPI_COMM_NULL /= mpicom_join ) then ! we are on the joint pes - call component_exch_moab(comp, mphaid, mbaxid, 0, tagname) - endif + ! tagname = 'aream' + ! if (MPI_COMM_NULL /= mpicom_join ) then ! we are on the joint pes + ! call component_exch_moab(comp, mphaid, mbaxid, 0, tagname) + ! endif #ifdef MOABDEBUG if (MPI_COMM_NULL /= mpicom_new ) then ! we are on the coupler pes From 673bc86453f93d3ef1240da4d7126d9414f77210 Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Mon, 2 Jan 2023 21:35:20 -0600 Subject: [PATCH 241/467] wrong src context for a2l maps really bad habit of copy and paste --- driver-moab/main/prep_lnd_mod.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/driver-moab/main/prep_lnd_mod.F90 b/driver-moab/main/prep_lnd_mod.F90 index 465c3369c901..17127e419973 100644 --- a/driver-moab/main/prep_lnd_mod.F90 +++ b/driver-moab/main/prep_lnd_mod.F90 @@ -239,7 +239,7 @@ subroutine prep_lnd_init(infodata, atm_c2_lnd, rof_c2_lnd, glc_c2_lnd, iac_c2_ln mapper_Sa2l%src_mbid = mbaxid mapper_Sa2l%tgt_mbid = mblxid mapper_Sa2l%intx_mbid = mbintxal - mapper_Sa2l%src_context = lnd(1)%cplcompid + mapper_Sa2l%src_context = atm(1)%cplcompid mapper_Sa2l%intx_context = idintx wgtIdef = 'scalar'//C_NULL_CHAR mapper_Sa2l%weight_identifier = wgtIdef @@ -350,7 +350,7 @@ subroutine prep_lnd_init(infodata, atm_c2_lnd, rof_c2_lnd, glc_c2_lnd, iac_c2_ln mapper_Fa2l%src_mbid = mbaxid mapper_Fa2l%tgt_mbid = mblxid mapper_Fa2l%intx_mbid = mbintxal - mapper_Fa2l%src_context = lnd(1)%cplcompid + mapper_Fa2l%src_context = atm(1)%cplcompid mapper_Fa2l%intx_context = mapper_Sa2l%intx_context wgtIdef = 'scalar'//C_NULL_CHAR mapper_Fa2l%weight_identifier = wgtIdef From a69b3e3d5708e1c722c0b15fb33bc2b77e10e0a6 Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Tue, 3 Jan 2023 10:07:20 -0600 Subject: [PATCH 242/467] add rest of domain tags to comp land model lat, lon, mask are set hgt is left default --- components/elm/src/cpl/lnd_comp_mct.F90 | 24 +++++++++++++++++++++++- 1 file changed, 23 insertions(+), 1 deletion(-) diff --git a/components/elm/src/cpl/lnd_comp_mct.F90 b/components/elm/src/cpl/lnd_comp_mct.F90 index eb72fa616311..a448370727ab 100644 --- a/components/elm/src/cpl/lnd_comp_mct.F90 +++ b/components/elm/src/cpl/lnd_comp_mct.F90 @@ -854,7 +854,6 @@ subroutine init_land_moab(bounds, samegrid_al) if (ierr > 0 ) & call endrun('Error: fail to create MOAB vertices in land model') - mbtype = 2 ! triangle if (ldomain%nv .eq. 4) mbtype = 3 ! quad if (ldomain%nv .gt. 4) mbtype = 4 ! polygon @@ -1028,6 +1027,29 @@ subroutine init_land_moab(bounds, samegrid_al) if (ierr > 0 ) & call endrun('Error: fail to set aream tag ') endif + ! add more domain fields that are missing from domain fields: lat, lon, mask, hgt + tagname = 'lat:lon:mask:hgt'//C_NULL_CHAR + tagtype = 1 ! dense, double + numco = 1 + ierr = iMOAB_DefineTagStorage(mlnid, tagname, tagtype, numco, tagindex ) + if (ierr > 0 ) & + call endrun('Error: fail to create lat:lon:mask:hgt tags ') + ! moab_vert_coords is big enough in both case to hold enough data for us: lat, lon, mask + do i = 1, lsz + n = i-1 + bounds%begg + moab_vert_coords(i) = ldomain%latc(n) ! lat + moab_vert_coords(lsz + i) = ldomain%lonc(n) ! lon + moab_vert_coords(2*lsz + i) = ldomain%mask(n) ! mask + enddo + tagname = 'lat:lon:mask'//C_NULL_CHAR + + ent_type = 0 ! point cloud usually + if (ldomain%nv .ge. 3 .and. .not.samegrid_al) then + ent_type = 1 ! cell in tri-grid case + endif + ierr = iMOAB_SetDoubleTagStorage ( mlnid, tagname, lsz*3 , ent_type, moab_vert_coords) + if (ierr > 0 ) & + call endrun('Error: fail to set lat lon mask tag ') deallocate(moab_vert_coords) deallocate(vgids) #ifdef MOABDEBUG From f9d04114e2be421f6dae6b6f3a798d44e8e4bd14 Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Tue, 3 Jan 2023 10:16:56 -0600 Subject: [PATCH 243/467] big typo in setting intx_mbid instead of doing mapper_Sl2a%intx_mbid = mbintxla I was doing mapper_Sl2a%src_mbid = mbintxla which overwrote important stuff --- driver-moab/main/prep_atm_mod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/driver-moab/main/prep_atm_mod.F90 b/driver-moab/main/prep_atm_mod.F90 index 71693774e0e4..325f60bea4ef 100644 --- a/driver-moab/main/prep_atm_mod.F90 +++ b/driver-moab/main/prep_atm_mod.F90 @@ -632,7 +632,7 @@ subroutine prep_atm_init(infodata, ocn_c2_atm, ice_c2_atm, lnd_c2_atm, iac_c2_at if ((mbaxid .ge. 0) .and. (mblxid .ge. 0) ) then mapper_Sl2a%src_mbid = mblxid mapper_Sl2a%tgt_mbid = mbaxid - mapper_Sl2a%src_mbid = mbintxla + mapper_Sl2a%intx_mbid = mbintxla mapper_Sl2a%src_context = lnd(1)%cplcompid mapper_Sl2a%intx_context = mapper_Fl2a%intx_context wgtIdef = 'scalar'//C_NULL_CHAR From dab96708a964f718b92042dcdbe7734d644c4884 Mon Sep 17 00:00:00 2001 From: Vijay Mahadevan Date: Tue, 3 Jan 2023 15:14:38 -0600 Subject: [PATCH 244/467] Move all MOAB map logic together at the end of the map routine; copy/rearrange will use same logic now for MOAB. --- driver-moab/main/seq_map_mod.F90 | 84 +++++++++++--------------------- 1 file changed, 29 insertions(+), 55 deletions(-) diff --git a/driver-moab/main/seq_map_mod.F90 b/driver-moab/main/seq_map_mod.F90 index e50880339fa8..4e362e2fad1f 100644 --- a/driver-moab/main/seq_map_mod.F90 +++ b/driver-moab/main/seq_map_mod.F90 @@ -418,39 +418,6 @@ subroutine seq_map_map( mapper, av_s, av_d, fldlist, norm, avwts_s, avwtsfld_s, call mct_aVect_copy(aVin=av_s,aVout=av_d,vector=mct_usevector) endif -#ifdef HAVE_MOAB - if ( valid_moab_context ) then - ! first get data from source tag and store in a temporary - ! then set it back to target tag to mimic a copy -#ifdef MOABDEBUG - if (seq_comm_iamroot(CPLID)) then - write(logunit, *) subname, 'iMOAB mapper', trim(mapper%mbname), ' iMOAB copy_only between mbids: ', mapper%src_mbid, ' and ', mapper%tgt_mbid, trim(fldlist_moab) - call shr_sys_flush(logunit) - endif -#endif - ntagdatalength = nfields * mapper % nentities - allocate(moab_tag_data(ntagdatalength)) - - ierr = iMOAB_GetDoubleTagStorage( mapper%src_mbid, & - fldlist_moab, & - ntagdatalength, & - mapper % tag_entity_type, & - moab_tag_data ) - if (ierr > 0 ) & - call shr_sys_abort( subname//'MOAB Error: failed to get source double tag ') - - ierr = iMOAB_SetDoubleTagStorage( mapper%tgt_mbid, & - fldlist_moab, & - ntagdatalength, & - mapper % tag_entity_type, & - moab_tag_data ) - if (ierr > 0 ) & - call shr_sys_abort( subname//'MOAB Error: failed to set target double tag ') - - deallocate(moab_tag_data) - endif -#endif - else if (mapper%rearrange_only) then !------------------------------------------- ! REARRANGE data @@ -463,6 +430,30 @@ subroutine seq_map_map( mapper, av_s, av_d, fldlist, norm, avwts_s, avwtsfld_s, ALLTOALL=mct_usealltoall) endif + else + !------------------------------------------- + ! MAP data + !------------------------------------------- + if (present(avwts_s)) then + if (present(fldlist)) then + call seq_map_avNorm(mapper, av_s, av_d, avwts_s, trim(avwtsfld_s), & + rList=fldlist, norm=lnorm) + else + call seq_map_avNorm(mapper, av_s, av_d, avwts_s, trim(avwtsfld_s), & + norm=lnorm) + endif + else + if (present(fldlist)) then + call seq_map_avNorm(mapper, av_s, av_d, rList=fldlist, norm=lnorm) + else + call seq_map_avNorm(mapper, av_s, av_d, norm=lnorm) + endif + endif + + endif + + if (mapper%copy_only .or. mapper%rearrange_only) then + #ifdef HAVE_MOAB if ( valid_moab_context ) then ! right now, this is used for ice-ocn projection, which involves just a send/recv, usually @@ -476,7 +467,7 @@ subroutine seq_map_map( mapper, av_s, av_d, fldlist, norm, avwts_s, avwtsfld_s, write(logunit, *) subname,' iMOAB mapper ', mapper%mbname, ' error in sending tags ', trim(fldlist_moab) call shr_sys_flush(logunit) endif - valid_moab_context = .false. + valid_moab_context = .false. endif endif if ( valid_moab_context ) then @@ -500,31 +491,13 @@ subroutine seq_map_map( mapper, av_s, av_d, fldlist, norm, avwts_s, avwtsfld_s, endif #endif - else - !------------------------------------------- - ! MAP data - !------------------------------------------- - if (present(avwts_s)) then - if (present(fldlist)) then - call seq_map_avNorm(mapper, av_s, av_d, avwts_s, trim(avwtsfld_s), & - rList=fldlist, norm=lnorm) - else - call seq_map_avNorm(mapper, av_s, av_d, avwts_s, trim(avwtsfld_s), & - norm=lnorm) - endif - else - if (present(fldlist)) then - call seq_map_avNorm(mapper, av_s, av_d, rList=fldlist, norm=lnorm) - else - call seq_map_avNorm(mapper, av_s, av_d, norm=lnorm) - endif - endif + else #ifdef HAVE_MOAB if ( valid_moab_context ) then ! first have to do the second hop, iMOAB_ComputeCommGraph( src_mbid, intx_mbid, ! wgtIdef = 'scalar'//C_NULL_CHAR - ! + ! if (seq_comm_iamroot(CPLID)) then write(logunit, *) subname,' iMOAB mapper before sending ', trim(fldlist_moab) call shr_sys_flush(logunit) @@ -535,7 +508,7 @@ subroutine seq_map_map( mapper, av_s, av_d, fldlist, norm, avwts_s, avwtsfld_s, write(logunit, *) subname,' iMOAB mapper error in sending tags ', mapper%mbname, trim(fldlist_moab) call shr_sys_flush(logunit) endif - valid_moab_context = .false. + valid_moab_context = .false. endif endif if ( valid_moab_context ) then @@ -567,6 +540,7 @@ subroutine seq_map_map( mapper, av_s, av_d, fldlist, norm, avwts_s, avwtsfld_s, endif endif #endif + endif end subroutine seq_map_map From ff21a67a9422bd36d281f8fb2a8b012f49a6f149 Mon Sep 17 00:00:00 2001 From: Robert Jacob Date: Tue, 3 Jan 2023 21:57:12 -0600 Subject: [PATCH 245/467] Turn off domain check and add log msgs Turn off domain check for the MOAB case and add log messages about aream and areacor sections of init. --- driver-moab/main/cime_comp_mod.F90 | 13 +++++++++++++ 1 file changed, 13 insertions(+) diff --git a/driver-moab/main/cime_comp_mod.F90 b/driver-moab/main/cime_comp_mod.F90 index 20c310b75093..1c342d71d7a7 100644 --- a/driver-moab/main/cime_comp_mod.F90 +++ b/driver-moab/main/cime_comp_mod.F90 @@ -1757,6 +1757,9 @@ subroutine cime_init() domain_check = .true. if (single_column ) domain_check = .false. if (dead_comps ) domain_check = .false. +#ifdef HAVE_MOAB + domain_check = .false. +#endif ! set skip_ocean_run flag, used primarily for ocn run on first timestep ! use reading a restart as a surrogate from whether this is a startup run @@ -1986,6 +1989,11 @@ subroutine cime_init() call t_adj_detailf(+2) if (drv_threading) call seq_comm_setnthreads(nthreads_CPLID) + if (iamroot_CPLID) then + write(logunit,*) ' ' + write(logunit,F00) 'Updating aream' + call shr_sys_flush(logunit) + endif call component_init_aream(infodata, rof_c2_ocn, samegrid_ao, samegrid_al, & samegrid_ro, samegrid_lg) @@ -2047,6 +2055,11 @@ subroutine cime_init() call t_startf ('CPL:init_areacor') call t_adj_detailf(+2) + if (iamroot_CPLID) then + write(logunit,*) ' ' + write(logunit,F00) 'Calculating area corrections, sending initial data' + call shr_sys_flush(logunit) + endif call mpi_barrier(mpicom_GLOID,ierr) if (atm_present) call component_init_areacor(atm, areafact_samegrid, seq_flds_a2x_fluxes) From 8963258380f6ab7c89856af300c9acac2ffa7fd1 Mon Sep 17 00:00:00 2001 From: Robert Jacob Date: Tue, 3 Jan 2023 22:25:25 -0600 Subject: [PATCH 246/467] Change VECT_MAP default to none Change VECT_MAP default from cart3d to none Need to see if that should be the default in production settings as well. --- driver-moab/cime_config/config_component.xml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/driver-moab/cime_config/config_component.xml b/driver-moab/cime_config/config_component.xml index 7554fa7a8bd8..fc50848ce6c2 100644 --- a/driver-moab/cime_config/config_component.xml +++ b/driver-moab/cime_config/config_component.xml @@ -1985,7 +1985,7 @@ char none,npfix,cart3d,cart3d_diag,cart3d_uvw,cart3d_uvw_diag - cart3d + none run_domain env_run.xml vector mapping option From 2509d598ee1ffe173821ebb4eacbf69740df1220 Mon Sep 17 00:00:00 2001 From: Robert Jacob Date: Tue, 3 Jan 2023 22:31:45 -0600 Subject: [PATCH 247/467] Abort if iMOAB has error in mapping Put back the abort calls for any nonzero error in the MOAB seq_map_map section. Don not set valid_context to false. --- driver-moab/main/seq_map_mod.F90 | 31 ++++++++++++++----------------- 1 file changed, 14 insertions(+), 17 deletions(-) diff --git a/driver-moab/main/seq_map_mod.F90 b/driver-moab/main/seq_map_mod.F90 index 4e362e2fad1f..c208c55383d5 100644 --- a/driver-moab/main/seq_map_mod.F90 +++ b/driver-moab/main/seq_map_mod.F90 @@ -463,11 +463,10 @@ subroutine seq_map_map( mapper, av_s, av_d, fldlist, norm, avwts_s, avwtsfld_s, endif ierr = iMOAB_SendElementTag( mapper%src_mbid, fldlist_moab, mapper%mpicom, mapper%intx_context ); if (ierr .ne. 0) then - if (seq_comm_iamroot(CPLID)) then - write(logunit, *) subname,' iMOAB mapper ', mapper%mbname, ' error in sending tags ', trim(fldlist_moab) - call shr_sys_flush(logunit) - endif - valid_moab_context = .false. + write(logunit, *) subname,' iMOAB mapper ', mapper%mbname, ' error in sending tags ', trim(fldlist_moab) + call shr_sys_flush(logunit) + call shr_sys_abort(subname//' ERROR in sending tags') + !valid_moab_context = .false. endif endif if ( valid_moab_context ) then @@ -480,7 +479,7 @@ subroutine seq_map_map( mapper, av_s, av_d, fldlist, norm, avwts_s, avwtsfld_s, if (ierr .ne. 0) then write(logunit,*) subname,' error in receiving tags iMOAB mapper ', mapper%mbname, trim(fldlist_moab) call shr_sys_flush(logunit) - !call shr_sys_abort(subname//' ERROR in receiving tags') + call shr_sys_abort(subname//' ERROR in receiving tags') endif ! now free buffers ierr = iMOAB_FreeSenderBuffers( mapper%src_mbid, mapper%intx_context ) @@ -498,17 +497,14 @@ subroutine seq_map_map( mapper, av_s, av_d, fldlist, norm, avwts_s, avwtsfld_s, ! first have to do the second hop, iMOAB_ComputeCommGraph( src_mbid, intx_mbid, ! wgtIdef = 'scalar'//C_NULL_CHAR ! - if (seq_comm_iamroot(CPLID)) then - write(logunit, *) subname,' iMOAB mapper before sending ', trim(fldlist_moab) - call shr_sys_flush(logunit) - endif + write(logunit, *) subname,' iMOAB real mapper before sending ', trim(fldlist_moab) + call shr_sys_flush(logunit) ierr = iMOAB_SendElementTag( mapper%src_mbid, fldlist_moab, mapper%mpicom, mapper%intx_context ); if (ierr .ne. 0) then - if (seq_comm_iamroot(CPLID)) then - write(logunit, *) subname,' iMOAB mapper error in sending tags ', mapper%mbname, trim(fldlist_moab) - call shr_sys_flush(logunit) - endif - valid_moab_context = .false. + write(logunit, *) subname,' iMOAB mapper error in sending tags ', mapper%mbname, trim(fldlist_moab) + call shr_sys_flush(logunit) + call shr_sys_abort(subname//' ERROR in sending tags') + !valid_moab_context = .false. endif endif if ( valid_moab_context ) then @@ -516,8 +512,9 @@ subroutine seq_map_map( mapper, av_s, av_d, fldlist, norm, avwts_s, avwtsfld_s, ierr = iMOAB_ReceiveElementTag( mapper%intx_mbid, fldlist_moab, mapper%mpicom, mapper%src_context ); if (ierr .ne. 0) then write(logunit,*) subname,' error in receiving tags ', mapper%mbname, trim(fldlist_moab) - !call shr_sys_abort(subname//' ERROR in receiving tags') - valid_moab_context = .false. ! do not attempt to project + call shr_sys_flush(logunit) + call shr_sys_abort(subname//' ERROR in receiving tags') + !valid_moab_context = .false. ! do not attempt to project endif ! now free buffers ierr = iMOAB_FreeSenderBuffers( mapper%src_mbid, mapper%intx_context ) From 15150579a0cd67db1eb20b96dd372b57cf245c3f Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Wed, 4 Jan 2023 11:31:57 -0600 Subject: [PATCH 248/467] send initial data with comp_exchange_moab --- driver-moab/main/cime_comp_mod.F90 | 11 +++++++++-- driver-moab/main/prep_ocn_mod.F90 | 4 ++-- 2 files changed, 11 insertions(+), 4 deletions(-) diff --git a/driver-moab/main/cime_comp_mod.F90 b/driver-moab/main/cime_comp_mod.F90 index 1c342d71d7a7..651f67b18f76 100644 --- a/driver-moab/main/cime_comp_mod.F90 +++ b/driver-moab/main/cime_comp_mod.F90 @@ -1393,8 +1393,9 @@ end subroutine cime_pre_init2 !=============================================================================== subroutine cime_init() - use seq_flds_mod , only : seq_flds_x2a_fields, seq_flds_a2x_fields - use seq_comm_mct , only : mphaid, mbaxid ! + use seq_flds_mod , only : seq_flds_x2a_fields, seq_flds_a2x_fields, seq_flds_l2x_fields, & + seq_flds_o2x_fields, seq_flds_r2x_fields, seq_flds_i2x_fields + use seq_comm_mct , only : mphaid, mbaxid, mlnid, mblxid, mrofid, mbrxid, mpoid, mboxid, mpsiid, mbixid #ifdef MOABDEBUG real(r8) :: difference character(20) :: mct_field, tagname @@ -2063,18 +2064,24 @@ subroutine cime_init() call mpi_barrier(mpicom_GLOID,ierr) if (atm_present) call component_init_areacor(atm, areafact_samegrid, seq_flds_a2x_fluxes) + ! send initial data to coupler + if (atm_present) call component_exch_moab(atm(1), mphaid, mbaxid, 0, seq_flds_a2x_fields) call mpi_barrier(mpicom_GLOID,ierr) if (lnd_present) call component_init_areacor(lnd, areafact_samegrid, seq_flds_l2x_fluxes) + if (lnd_present) call component_exch_moab(lnd(1), mlnid, mblxid, 0, seq_flds_l2x_fields) call mpi_barrier(mpicom_GLOID,ierr) if (rof_present) call component_init_areacor(rof, areafact_samegrid, seq_flds_r2x_fluxes) + if (rof_present) call component_exch_moab(rof(1), mrofid, mbrxid, 0, seq_flds_r2x_fields) call mpi_barrier(mpicom_GLOID,ierr) if (ocn_present) call component_init_areacor(ocn, areafact_samegrid, seq_flds_o2x_fluxes) + if (ocn_present) call component_exch_moab(ocn(1), mpoid, mboxid, 0, seq_flds_o2x_fields) call mpi_barrier(mpicom_GLOID,ierr) if (ice_present) call component_init_areacor(ice, areafact_samegrid, seq_flds_i2x_fluxes) + if (ice_present) call component_exch_moab(ice(1), mpsiid, mbixid, 0, seq_flds_i2x_fields) call mpi_barrier(mpicom_GLOID,ierr) if (glc_present) call component_init_areacor(glc, areafact_samegrid, seq_flds_g2x_fluxes) diff --git a/driver-moab/main/prep_ocn_mod.F90 b/driver-moab/main/prep_ocn_mod.F90 index 9c0857dc4b92..dbac04d3dfe2 100644 --- a/driver-moab/main/prep_ocn_mod.F90 +++ b/driver-moab/main/prep_ocn_mod.F90 @@ -478,8 +478,8 @@ subroutine prep_ocn_init(infodata, atm_c2_ocn, atm_c2_ice, ice_c2_ocn, rof_c2_oc mapper_Sa2o%weight_identifier = wgtIdef mapper_Sa2o%mbname = 'mapper_Sa2o' - mapper_Va2o%src_mbid = mbaxid - mapper_Va2o%tgt_mbid = mboxid + !mapper_Va2o%src_mbid = mbaxid + !mapper_Va2o%tgt_mbid = mboxid mapper_Va2o%intx_mbid = mbintxao mapper_Va2o%src_context = atm(1)%cplcompid mapper_Va2o%intx_context = idintx From 75fe49d59d29d2b7e0301cc784d60c1113ec89d0 Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Wed, 4 Jan 2023 12:37:15 -0600 Subject: [PATCH 249/467] mapper_Va2o is not used anyway --- driver-moab/main/prep_ocn_mod.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/driver-moab/main/prep_ocn_mod.F90 b/driver-moab/main/prep_ocn_mod.F90 index dbac04d3dfe2..9c0857dc4b92 100644 --- a/driver-moab/main/prep_ocn_mod.F90 +++ b/driver-moab/main/prep_ocn_mod.F90 @@ -478,8 +478,8 @@ subroutine prep_ocn_init(infodata, atm_c2_ocn, atm_c2_ice, ice_c2_ocn, rof_c2_oc mapper_Sa2o%weight_identifier = wgtIdef mapper_Sa2o%mbname = 'mapper_Sa2o' - !mapper_Va2o%src_mbid = mbaxid - !mapper_Va2o%tgt_mbid = mboxid + mapper_Va2o%src_mbid = mbaxid + mapper_Va2o%tgt_mbid = mboxid mapper_Va2o%intx_mbid = mbintxao mapper_Va2o%src_context = atm(1)%cplcompid mapper_Va2o%intx_context = idintx From a894a8e96583e03aa16675434c6313e38ce3d2ad Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Wed, 4 Jan 2023 14:18:48 -0600 Subject: [PATCH 250/467] increase number used to count moab steps used in debug mode only --- driver-moab/main/cime_comp_mod.F90 | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/driver-moab/main/cime_comp_mod.F90 b/driver-moab/main/cime_comp_mod.F90 index 651f67b18f76..9fa2ce47571e 100644 --- a/driver-moab/main/cime_comp_mod.F90 +++ b/driver-moab/main/cime_comp_mod.F90 @@ -201,7 +201,6 @@ module cime_comp_mod #endif #ifdef MOABDEBUG - use seq_comm_mct , only : mboxid use iso_c_binding #endif @@ -1396,6 +1395,7 @@ subroutine cime_init() use seq_flds_mod , only : seq_flds_x2a_fields, seq_flds_a2x_fields, seq_flds_l2x_fields, & seq_flds_o2x_fields, seq_flds_r2x_fields, seq_flds_i2x_fields use seq_comm_mct , only : mphaid, mbaxid, mlnid, mblxid, mrofid, mbrxid, mpoid, mboxid, mpsiid, mbixid + use seq_comm_mct, only: num_moab_exports ! used to count the steps for moab files #ifdef MOABDEBUG real(r8) :: difference character(20) :: mct_field, tagname @@ -2062,6 +2062,9 @@ subroutine cime_init() call shr_sys_flush(logunit) endif + ! mostly for debug mode + num_moab_exports = num_moab_exports + 1 + call mpi_barrier(mpicom_GLOID,ierr) if (atm_present) call component_init_areacor(atm, areafact_samegrid, seq_flds_a2x_fluxes) ! send initial data to coupler From 98c0194c490da8f1bcbd4743483fae1e5b806510 Mon Sep 17 00:00:00 2001 From: Robert Jacob Date: Wed, 4 Jan 2023 17:42:13 -0600 Subject: [PATCH 251/467] Add moab parts to mapper_SFo2i Add moab parts to mapper_SFo2i. Only 2i mapper we need for now. --- driver-moab/main/prep_ice_mod.F90 | 63 +++++++++++++++++++++++++++++++ 1 file changed, 63 insertions(+) diff --git a/driver-moab/main/prep_ice_mod.F90 b/driver-moab/main/prep_ice_mod.F90 index 36c478f6fc21..ccb2e53835d4 100644 --- a/driver-moab/main/prep_ice_mod.F90 +++ b/driver-moab/main/prep_ice_mod.F90 @@ -8,6 +8,11 @@ module prep_ice_mod use seq_comm_mct , only: num_inst_ice, num_inst_frc, num_inst_rof use seq_comm_mct , only: CPLID, ICEID, logunit use seq_comm_mct , only: seq_comm_getData=>seq_comm_setptrs + use seq_comm_mct, only: mboxid ! iMOAB id for mpas ocean migrated mesh to coupler pes + use seq_comm_mct, only : mbixid ! iMOAB for sea-ice migrated to coupler + + use seq_comm_mct, only : seq_comm_getinfo => seq_comm_setptrs + use seq_infodata_mod, only: seq_infodata_type, seq_infodata_getdata use seq_map_type_mod use seq_map_mod @@ -17,6 +22,7 @@ module prep_ice_mod use perf_mod use component_type_mod, only: component_get_x2c_cx, component_get_c2x_cx use component_type_mod, only: ice, atm, ocn, glc, rof + use iso_c_binding implicit none save @@ -78,6 +84,8 @@ module prep_ice_mod subroutine prep_ice_init(infodata, ocn_c2_ice, glc_c2_ice, glcshelf_c2_ice, rof_c2_ice) + use iMOAB, only: iMOAB_ComputeMeshIntersectionOnSphere, iMOAB_RegisterApplication, & + iMOAB_WriteMesh, iMOAB_DefineTagStorage, iMOAB_ComputeCommGraph, iMOAB_ComputeScalarProjectionWeights !--------------------------------------------------------------- ! Description ! Initialize module attribute vectors and all other non-mapping @@ -105,6 +113,20 @@ subroutine prep_ice_init(infodata, ocn_c2_ice, glc_c2_ice, glcshelf_c2_ice, rof_ type(mct_avect), pointer :: i2x_ix character(*), parameter :: subname = '(prep_ice_init)' character(*), parameter :: F00 = "('"//subname//" : ', 4A )" +!MOAB stuff + ! MOAB stuff + integer :: ierr, idintx, rank + character*32 :: appname, outfile, wopts, lnum + character*32 :: dm1, dm2, dofnameS, dofnameT, wgtIdef + integer :: orderS, orderT, volumetric, noConserve, validate, fInverseDistanceMap + integer :: fNoBubble, monotonicity +! will do comm graph over coupler PES, in 2-hop strategy + integer :: mpigrp_CPLID ! coupler pes group, used for comm graph phys <-> atm-ocn + + integer :: type1, type2 ! type for computing graph; should be the same type for ocean, 3 (FV) + integer :: tagtype, numco, tagindex + character(CXX) :: tagName + !--------------------------------------------------------------- call seq_infodata_getData(infodata, & @@ -161,6 +183,47 @@ subroutine prep_ice_init(infodata, ocn_c2_ice, glc_c2_ice, glcshelf_c2_ice, rof_ write(logunit,F00) 'Initializing mapper_SFo2i' end if call seq_map_init_rearrolap(mapper_SFo2i, ocn(1), ice(1), 'mapper_SFo2i') + +#ifdef HAVE_MOAB + if ( (mbixid .ge. 0) .and. (mboxid .ge. 0)) then + ! moab also will do just a rearrange, hopefully, in this case, based on the comm graph + ! that is computed here + call seq_comm_getinfo(CPLID ,mpigrp=mpigrp_CPLID) ! second group, the coupler group CPLID is global variable + + type1 = 3 + type2 = 3 ! fv-fv graph + ! imoab compute comm graph ice-ocn, based on the same global id + ! it will be a simple migrate from ice mesh directly to ocean, using the comm graph computed here + ! TODO: find if CommGraph already exists. + + ierr = iMOAB_ComputeCommGraph( mboxid, mbixid, mpicom_CPLID, mpigrp_CPLID, mpigrp_CPLID, & + type1, type2, ocn(1)%cplcompid, ice(1)%cplcompid) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in computing graph ocn - ice x ' + call shr_sys_abort(subname//' ERROR in computing graph ocn -ice x ') + endif + + ! define tags according to the seq_flds_i2x_fields + tagtype = 1 ! dense, double + numco = 1 ! one value per cell / entity + tagname = trim(seq_flds_o2x_fields)//C_NULL_CHAR + ierr = iMOAB_DefineTagStorage(mbixid, tagname, tagtype, numco, tagindex ) + if ( ierr == 1 ) then + call shr_sys_abort( subname//' ERROR: cannot define tags for ice proj to ocn' ) + end if + mapper_SFo2i%src_mbid = mboxid + mapper_SFo2i%tgt_mbid = mbixid + ! no intersection, so willihave to do without it + mapper_SFo2i%src_context = ocn(1)%cplcompid + mapper_SFo2i%intx_context = ice(1)%cplcompid + mapper_SFo2i%mbname = 'mapper_SFo2i' + + if(mapper_SFo2i%copy_only) then + call seq_map_set_type(mapper_SFo2i, mboxid, 1) ! type is cells + endif + + endif +#endif endif if (glc_c2_ice) then From 5e92c34774787547a33fb3450827c91dfe32fe15 Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Wed, 4 Jan 2023 19:57:01 -0600 Subject: [PATCH 252/467] need trim for seq_flds_dom_fields --- components/mosart/src/cpl/rof_comp_mct.F90 | 2 +- components/mpas-framework/src/framework/mpas_moabmesh.F | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/components/mosart/src/cpl/rof_comp_mct.F90 b/components/mosart/src/cpl/rof_comp_mct.F90 index 3ea9f8b00934..2341bf7a2c36 100644 --- a/components/mosart/src/cpl/rof_comp_mct.F90 +++ b/components/mosart/src/cpl/rof_comp_mct.F90 @@ -872,7 +872,7 @@ subroutine init_rof_moab() ! set domain tags tagtype = 1 ! dense, double; - tagname=seq_flds_dom_fields//C_NULL_CHAR + tagname=trim(seq_flds_dom_fields)//C_NULL_CHAR ierr = iMOAB_DefineTagStorage(mrofid, tagname, tagtype, numco, tagindex ) if (ierr > 0 ) & call shr_sys_abort( sub//' Error: fail to create domain tags ') diff --git a/components/mpas-framework/src/framework/mpas_moabmesh.F b/components/mpas-framework/src/framework/mpas_moabmesh.F index 2d52ad6c36d7..ac17c88f5cd8 100644 --- a/components/mpas-framework/src/framework/mpas_moabmesh.F +++ b/components/mpas-framework/src/framework/mpas_moabmesh.F @@ -188,7 +188,7 @@ subroutine mpas_moab_instance(domain, ext_comp_id, pidmoab) enddo ! add domain tags - tagname=seq_flds_dom_fields//C_NULL_CHAR + tagname=trim(seq_flds_dom_fields)//C_NULL_CHAR tagtype = 1 ierr = iMOAB_DefineTagStorage(pid, tagname, tagtype, numco, tagindex ) if (ierr > 0 ) & From abdfc4403cb9762e8c7e06f00345bfa6d72b18cd Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Wed, 4 Jan 2023 22:36:45 -0600 Subject: [PATCH 253/467] initial state export for atm add more counters in debug mode intial state export was missing for rof, ocn, ice --- components/eam/src/cpl/atm_comp_mct.F90 | 9 +++++++-- components/mosart/src/cpl/rof_comp_mct.F90 | 3 +++ components/mpas-ocean/driver/ocn_comp_mct.F | 5 ++++- components/mpas-seaice/driver/ice_comp_mct.F | 3 +++ 4 files changed, 17 insertions(+), 3 deletions(-) diff --git a/components/eam/src/cpl/atm_comp_mct.F90 b/components/eam/src/cpl/atm_comp_mct.F90 index 57dee37d118c..f3cb757544db 100644 --- a/components/eam/src/cpl/atm_comp_mct.F90 +++ b/components/eam/src/cpl/atm_comp_mct.F90 @@ -1314,7 +1314,10 @@ subroutine atm_export_moab(cam_out) character(CXX) :: tagname ! integer ierr, c, nlcols, ig, i, ncols - +#ifdef MOABDEBUG + integer, save :: local_count = 0 + character*100 lnum2 +#endif ! Copy from component arrays into chunk array data structure ! Rearrange data from chunk structure into lat-lon buffer and subsequently ! create double array for moab tags @@ -1377,7 +1380,9 @@ subroutine atm_export_moab(cam_out) endif #ifdef MOABDEBUG write(lnum,"(I0.2)")num_moab_exports - outfile = 'AtmPhys_'//trim(lnum)//'.h5m'//C_NULL_CHAR + local_count = local_count + 1 + write(lnum2,"(I0.2)")local_count + outfile = 'AtmPhys_'//trim(lnum)//'_'//trim(lnum2)//'.h5m'//C_NULL_CHAR wopts = 'PARALLEL=WRITE_PART'//C_NULL_CHAR ierr = iMOAB_WriteMesh(mphaid, outfile, wopts) if (ierr > 0 ) & diff --git a/components/mosart/src/cpl/rof_comp_mct.F90 b/components/mosart/src/cpl/rof_comp_mct.F90 index 2341bf7a2c36..c7eb2c358470 100644 --- a/components/mosart/src/cpl/rof_comp_mct.F90 +++ b/components/mosart/src/cpl/rof_comp_mct.F90 @@ -310,6 +310,9 @@ subroutine rof_init_mct( EClock, cdata_r, x2r_r, r2x_r, NLFilename) if ( ierr == 1 ) then call shr_sys_abort( sub//' ERROR: cannot define tags in moab' ) end if + ! also load initial data to moab tags + call rof_export_moab() + ! endif HAVE_MOAB #endif else diff --git a/components/mpas-ocean/driver/ocn_comp_mct.F b/components/mpas-ocean/driver/ocn_comp_mct.F index 9211b5e0472d..9119033a5f3e 100644 --- a/components/mpas-ocean/driver/ocn_comp_mct.F +++ b/components/mpas-ocean/driver/ocn_comp_mct.F @@ -801,7 +801,10 @@ end subroutine xml_stream_get_attributes if (errorCode /= 0) then call mpas_log_write('ERROR in ocn_export_mct', MPAS_LOG_CRIT) endif - +#ifdef HAVE_MOAB + ! initial state has to be exported to moab too + call ocn_export_moab() +#endif ! Setup clock for initial runs if (runtype == "continue" .or. runtype == "branch" ) then block_ptr => domain % blocklist diff --git a/components/mpas-seaice/driver/ice_comp_mct.F b/components/mpas-seaice/driver/ice_comp_mct.F index a68c147b022d..a5bc97422767 100644 --- a/components/mpas-seaice/driver/ice_comp_mct.F +++ b/components/mpas-seaice/driver/ice_comp_mct.F @@ -781,6 +781,9 @@ end subroutine xml_stream_get_attributes if (errorCode /= 0) then call mpas_log_write('Error in ice_export_mct', MPAS_LOG_CRIT) endif +#ifdef HAVE_MOAB + call ice_export_moab() +#endif call t_stopf ('mpassi_mct_init') From 07c9b650f568e64fa01f585924c9c5ea271d3b55 Mon Sep 17 00:00:00 2001 From: Robert Jacob Date: Thu, 5 Jan 2023 20:25:48 -0600 Subject: [PATCH 254/467] Comment out abort in moab seq_map_map Comment out abort in copy portion of moab seq_map_map. Temporary until atm_import branch is merged. --- driver-moab/main/seq_map_mod.F90 | 14 ++++++++++---- 1 file changed, 10 insertions(+), 4 deletions(-) diff --git a/driver-moab/main/seq_map_mod.F90 b/driver-moab/main/seq_map_mod.F90 index efe2c4075217..89b9978acd42 100644 --- a/driver-moab/main/seq_map_mod.F90 +++ b/driver-moab/main/seq_map_mod.F90 @@ -430,16 +430,22 @@ subroutine seq_map_map( mapper, av_s, av_d, fldlist, norm, avwts_s, avwtsfld_s, ntagdatalength, & mapper % tag_entity_type, & moab_tag_data ) - if (ierr > 0 ) & - call shr_sys_abort( subname//'MOAB Error: failed to get source double tag ') + if (ierr > 0 ) then +! call shr_sys_abort( subname//'MOAB Error: failed to get source double tag ') + write(logunit, *) subname,' iMOAB copy get Error ', trim(fldlist_moab) + valid_moab_context = .false. + endif ierr = iMOAB_SetDoubleTagStorage( mapper%tgt_mbid, & fldlist_moab, & ntagdatalength, & mapper % tag_entity_type, & moab_tag_data ) - if (ierr > 0 ) & - call shr_sys_abort( subname//'MOAB Error: failed to set target double tag ') + if (ierr > 0 ) then +! call shr_sys_abort( subname//'MOAB Error: failed to set target double tag ') + write(logunit, *) subname,' iMOAB copy Set Error ', trim(fldlist_moab) + valid_moab_context = .false. + endif deallocate(moab_tag_data) endif From 0863ef4a27341d0f13c92de9a3e80b4b5b3179ed Mon Sep 17 00:00:00 2001 From: Robert Jacob Date: Sun, 8 Jan 2023 20:35:38 -0600 Subject: [PATCH 255/467] Adjust num_moab_export values Adjust num_moab_export values. first use in cime_init will be 00. Second use in cime_init for atm will be 01. --- driver-moab/main/cime_comp_mod.F90 | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/driver-moab/main/cime_comp_mod.F90 b/driver-moab/main/cime_comp_mod.F90 index 9fa2ce47571e..da75bf2eed1f 100644 --- a/driver-moab/main/cime_comp_mod.F90 +++ b/driver-moab/main/cime_comp_mod.F90 @@ -2063,7 +2063,7 @@ subroutine cime_init() endif ! mostly for debug mode - num_moab_exports = num_moab_exports + 1 + num_moab_exports = 0 call mpi_barrier(mpicom_GLOID,ierr) if (atm_present) call component_init_areacor(atm, areafact_samegrid, seq_flds_a2x_fluxes) @@ -2337,6 +2337,7 @@ subroutine cime_init() endif enddo + num_moab_exports = num_moab_exports + 1 ! Run atm_init_mct with init phase of 2 call component_init_cc(Eclock_a, atm, atm_init, & infodata, NLFilename, & From 0baab0fbc09f8eeff40bd34cfce8ecd2ef465bff Mon Sep 17 00:00:00 2001 From: Robert Jacob Date: Sun, 8 Jan 2023 20:38:09 -0600 Subject: [PATCH 256/467] Add a FlxAlb2Atm h5m file for MOABDEBUG Add a FlxAlb2Atm h5m file for MOABDEBUG from prep_aoflux_calc_xao_ax --- driver-moab/main/prep_aoflux_mod.F90 | 19 +++++++++++++++++++ 1 file changed, 19 insertions(+) diff --git a/driver-moab/main/prep_aoflux_mod.F90 b/driver-moab/main/prep_aoflux_mod.F90 index e6fda2cab757..85fcf8434e10 100644 --- a/driver-moab/main/prep_aoflux_mod.F90 +++ b/driver-moab/main/prep_aoflux_mod.F90 @@ -11,6 +11,7 @@ module prep_aoflux_mod use seq_comm_mct, only : mbox2id ! use seq_comm_mct, only : mbaxid ! iMOAB app id for atm on cpl pes use seq_comm_mct, only: seq_comm_getData=>seq_comm_setptrs + use seq_comm_mct, only : num_moab_exports use seq_infodata_mod, only: seq_infodata_getdata, seq_infodata_type use seq_map_type_mod use seq_map_mod @@ -245,6 +246,9 @@ subroutine prep_aoflux_calc_xao_ax(fractions_ox, flds, timer) ! Uses use prep_atm_mod, only: prep_atm_get_mapper_So2a use prep_atm_mod, only: prep_atm_get_mapper_Fo2a +#ifdef MOABDEBUG + use iMOAB, only : iMOAB_WriteMesh +#endif ! ! Arguments type(mct_aVect) , intent(in) :: fractions_ox(:) @@ -257,6 +261,10 @@ subroutine prep_aoflux_calc_xao_ax(fractions_ox, flds, timer) integer :: exi, efi character(*), parameter :: subname = '(prep_aoflux_calc_xao_ax)' character(*), parameter :: F00 = "('"//subname//" : ', 4A )" +#ifdef MOABDEBUG + character*50 :: outfile, wopts, lnum + integer :: ierr +#endif !--------------------------------------------------------------- call t_drvstartf (trim(timer),barrier=mpicom_CPLID) @@ -285,6 +293,17 @@ subroutine prep_aoflux_calc_xao_ax(fractions_ox, flds, timer) fldlist=seq_flds_xao_fluxes, norm=.true., & avwts_s=fractions_ox(efi),avwtsfld_s='ofrac') enddo +#ifdef MOABDEBUG + ! projections on atm + write(lnum,"(I0.2)")num_moab_exports + outfile = 'FlxAlb2Atm'//trim(lnum)//'.h5m'//C_NULL_CHAR + wopts = ';PARALLEL=WRITE_PART'//C_NULL_CHAR ! + ierr = iMOAB_WriteMesh(mbaxid, trim(outfile), trim(wopts)) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in writing ocean to atm projection' + call shr_sys_abort(subname//' ERROR in writing ocean to atm projection') + endif +#endif end if call t_drvstopf (trim(timer)) From f5f496ce36d9ce231bd66d907c8247e597415179 Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Sun, 8 Jan 2023 21:51:51 -0600 Subject: [PATCH 257/467] read rof scrip file instead of migrating point cloud rof need to use branch moab : iulian07/check_existing_pargraph --- driver-moab/main/cime_comp_mod.F90 | 2 +- driver-moab/main/cplcomp_exchange_mod.F90 | 116 ++++++++++++---------- 2 files changed, 67 insertions(+), 51 deletions(-) diff --git a/driver-moab/main/cime_comp_mod.F90 b/driver-moab/main/cime_comp_mod.F90 index 9fa2ce47571e..1ab4c3e575a0 100644 --- a/driver-moab/main/cime_comp_mod.F90 +++ b/driver-moab/main/cime_comp_mod.F90 @@ -1979,7 +1979,7 @@ subroutine cime_init() endif ! need to finish up the migration of mesh for rof 2 ocn map ( read from file) - if (iamin_CPLALLROFID .and. rof_c2_ocn) call prep_rof_ocn_moab(infodata) + ! if (iamin_CPLALLROFID .and. rof_c2_ocn) call prep_rof_ocn_moab(infodata) !---------------------------------------------------------- !| Update aream in domains where appropriate diff --git a/driver-moab/main/cplcomp_exchange_mod.F90 b/driver-moab/main/cplcomp_exchange_mod.F90 index 5eacaef33a6d..c4b3eda18f30 100644 --- a/driver-moab/main/cplcomp_exchange_mod.F90 +++ b/driver-moab/main/cplcomp_exchange_mod.F90 @@ -992,7 +992,7 @@ subroutine cplcomp_moab_Init(comp) ! use iMOAB, only: iMOAB_RegisterApplication, iMOAB_ReceiveMesh, iMOAB_SendMesh, & iMOAB_WriteMesh, iMOAB_DefineTagStorage, iMOAB_GetMeshInfo, & - iMOAB_SetIntTagStorage, iMOAB_FreeSenderBuffers, iMOAB_ComputeCommGraph + iMOAB_SetIntTagStorage, iMOAB_FreeSenderBuffers, iMOAB_ComputeCommGraph, iMOAB_LoadMesh ! use component_mod, only: component_exch_moab ! type(component_type), intent(inout) :: comp @@ -1012,14 +1012,12 @@ subroutine cplcomp_moab_Init(comp) integer :: mpigrp_cplid ! coupler pes integer :: mpigrp_old ! component group pes integer :: ierr, context_id - character*32 :: appname, outfile, wopts, tagnameProj + character*100 :: appname, outfile, wopts, ropts integer :: maxMH, maxMPO, maxMLID, maxMSID, maxMRID ! max pids for moab apps atm, ocn, lnd, sea-ice, rof - integer :: tagtype, numco, tagindex, partMethod + integer :: tagtype, numco, tagindex, partMethod, nghlay integer :: rank, ent_type integer :: typeA, typeB, ATM_PHYS_CID ! used to compute par graph between atm phys ! and atm spectral on coupler - integer :: ID_JOIN_ATMPHYS ! 200 + 6 - integer :: ID_OLD_ATMPHYS ! 200 + 5 character(CXX) :: tagname #ifdef MOABDEBUG integer , dimension(1:3) :: nverts, nelem, nblocks, nsbc, ndbc @@ -1457,61 +1455,79 @@ subroutine cplcomp_moab_Init(comp) call seq_comm_getinfo(cplid ,mpigrp=mpigrp_cplid) ! receiver group call seq_comm_getinfo(id_old,mpigrp=mpigrp_old) ! component group pes - if (MPI_COMM_NULL /= mpicom_old ) then ! it means we are on the component p + ! if (MPI_COMM_NULL /= mpicom_old ) then ! it means we are on the component p - ierr = iMOAB_SendMesh(mrofid, mpicom_join, mpigrp_cplid, id_join, partMethod) - if (ierr .ne. 0) then - write(logunit,*) subname,' error in sending rof mesh to coupler ' - call shr_sys_abort(subname//' ERROR in sending rof mesh to coupler ') - endif + ! ierr = iMOAB_SendMesh(mrofid, mpicom_join, mpigrp_cplid, id_join, partMethod) + ! if (ierr .ne. 0) then + ! write(logunit,*) subname,' error in sending rof mesh to coupler ' + ! call shr_sys_abort(subname//' ERROR in sending rof mesh to coupler ') + ! endif - endif + ! endif if (MPI_COMM_NULL /= mpicom_new ) then ! we are on the coupler pes - appname = "COUPLE_MROF"//C_NULL_CHAR - ! migrated mesh gets another app id, moab moab rof to coupler (mbrx) - ierr = iMOAB_RegisterApplication(trim(appname), mpicom_new, id_join, mbrxid) - ierr = iMOAB_ReceiveMesh(mbrxid, mpicom_join, mpigrp_old, id_old) + appname = "COUPLE_MROF"//C_NULL_CHAR + ierr = iMOAB_RegisterApplication(trim(appname), mpicom_new, id_join, mbrxid) - tagtype = 1 ! dense, double - numco = 1 ! one value per cell / entity - tagname = trim(seq_flds_r2x_fields)//C_NULL_CHAR - ierr = iMOAB_DefineTagStorage(mbrxid, tagname, tagtype, numco, tagindex ) - if ( ierr == 1 ) then - call shr_sys_abort( subname//' ERROR: cannot define tags for rof on coupler' ) - end if - tagname = trim(seq_flds_x2r_fields)//C_NULL_CHAR - ierr = iMOAB_DefineTagStorage(mbrxid, tagname, tagtype, numco, tagindex ) - if ( ierr == 1 ) then - call shr_sys_abort( subname//' ERROR: cannot define tags for rof on coupler' ) - end if + ! load mesh from scrip file,then send it locally, maybe it will defeat the crash in writing it + outfile = '/home/iulian/rofscrip/SCRIPgrid_2x2_nomask_c210211.nc'//C_NULL_CHAR + ropts = 'PARALLEL=READ_PART;PARTITION_METHOD=RCBZOLTAN'//C_NULL_CHAR + + nghlay = 0 ! no ghost layers + ierr = iMOAB_LoadMesh(mbrxid, outfile, ropts, nghlay) + if ( ierr .ne. 0 ) then + call shr_sys_abort( subname//' ERROR: cannot read rof mesh on coupler' ) + end if - tagname = trim(seq_flds_dom_fields)//C_NULL_CHAR - ierr = iMOAB_DefineTagStorage(mbrxid, tagname, tagtype, numco, tagindex ) - if (ierr .ne. 0) then - write(logunit,*) subname,' error in defining tags seq_flds_dom_fields on rof on coupler ' - call shr_sys_abort(subname//' ERROR in defining tags ') - endif + tagtype = 1 ! dense, double + numco = 1 ! one value per cell / entity + tagname = trim(seq_flds_r2x_fields)//C_NULL_CHAR + ierr = iMOAB_DefineTagStorage(mbrxid, tagname, tagtype, numco, tagindex ) + if ( ierr == 1 ) then + call shr_sys_abort( subname//' ERROR: cannot define tags for rof on coupler' ) + end if + tagname = trim(seq_flds_x2r_fields)//C_NULL_CHAR + ierr = iMOAB_DefineTagStorage(mbrxid, tagname, tagtype, numco, tagindex ) + if ( ierr == 1 ) then + call shr_sys_abort( subname//' ERROR: cannot define tags for rof on coupler' ) + end if + + tagname = trim(seq_flds_dom_fields)//C_NULL_CHAR + ierr = iMOAB_DefineTagStorage(mbrxid, tagname, tagtype, numco, tagindex ) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in defining tags seq_flds_dom_fields on rof on coupler ' + call shr_sys_abort(subname//' ERROR in defining tags ') + endif #ifdef MOABDEBUG ! debug test - outfile = 'recRof.h5m'//C_NULL_CHAR - wopts = ';PARALLEL=WRITE_PART'//C_NULL_CHAR ! - ! write out the mesh file to disk - ierr = iMOAB_WriteMesh(mbrxid, trim(outfile), trim(wopts)) - if (ierr .ne. 0) then - write(logunit,*) subname,' error in writing rof mesh on coupler ' - call shr_sys_abort(subname//' ERROR in writing rof mesh on coupler ') - endif -#endif - endif - if (mrofid .ge. 0) then ! we are on component rof pes - context_id = id_join - ierr = iMOAB_FreeSenderBuffers(mrofid, context_id) + outfile = 'recRof.h5m'//C_NULL_CHAR + wopts = ';PARALLEL=WRITE_PART'//C_NULL_CHAR ! + ! write out the mesh file to disk + ierr = iMOAB_WriteMesh(mbrxid, trim(outfile), trim(wopts)) if (ierr .ne. 0) then - write(logunit,*) subname,' error in freeing buffers ' - call shr_sys_abort(subname//' ERROR in freeing buffers ') + write(logunit,*) subname,' error in writing rof mesh on coupler ' + call shr_sys_abort(subname//' ERROR in writing rof mesh on coupler ') endif +#endif endif - endif ! end for rof coupler send + ! we are now on joint pes, compute comm graph between rof and coupler model + typeA = 2 ! point cloud on component PEs + typeB = 3 ! full mesh on coupler pes, we just read it + ierr = iMOAB_ComputeCommGraph( mrofid, mbrxid, mpicom_join, mpigrp_old, mpigrp_cplid, & + typeA, typeB, id_old, id_join) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in computing comm graph for rof model ' + call shr_sys_abort(subname//' ERROR in computing comm graph for rof model ') + endif + + ! if (mrofid .ge. 0) then ! we are on component rof pes + ! context_id = id_join + ! ierr = iMOAB_FreeSenderBuffers(mrofid, context_id) + ! if (ierr .ne. 0) then + ! write(logunit,*) subname,' error in freeing buffers ' + ! call shr_sys_abort(subname//' ERROR in freeing buffers ') + ! endif + ! endif + endif ! end for rof coupler set up end subroutine cplcomp_moab_Init From a3e89e692589c7bca5038e86abce65b0209b343e Mon Sep 17 00:00:00 2001 From: Robert Jacob Date: Sun, 8 Jan 2023 23:28:49 -0600 Subject: [PATCH 258/467] Move Debug h5m in seq_frac_init Move writing of h5m files to end of seq_frac_init since each fraction set is modified throughout the routine. reallocated a TagValues array and make sure init value is 0._r8 --- driver-moab/main/seq_frac_mct.F90 | 111 ++++++++++++++---------------- 1 file changed, 50 insertions(+), 61 deletions(-) diff --git a/driver-moab/main/seq_frac_mct.F90 b/driver-moab/main/seq_frac_mct.F90 index b983e800d309..46d7723223a3 100644 --- a/driver-moab/main/seq_frac_mct.F90 +++ b/driver-moab/main/seq_frac_mct.F90 @@ -383,30 +383,26 @@ subroutine seq_frac_init( infodata, & arrSize = nvise(1) * 5 ! there are 5 tags that need to be zeroed out allocate(tagValues(arrSize) ) ent_type = 1 ! cell type - tagValues = 0 + tagValues = 0.0_r8 ierr = iMOAB_SetDoubleTagStorage ( mbaxid, tagname, arrSize , ent_type, tagValues) if (ierr .ne. 0) then write(logunit,*) subname,' error in zeroing out fracs ' call shr_sys_abort(subname//' ERROR in zeroing out fracs on phys atm') endif + deallocate(tagValues) + + allocate(tagValues(nvise(1))) tagname = 'afrac'//C_NULL_CHAR - tagValues = 1 + tagValues = 1.0_r8 ierr = iMOAB_SetDoubleTagStorage ( mbaxid, tagname, nvise(1) , ent_type, tagValues) + + if (ierr .ne. 0) then write(logunit,*) subname,' error in setting afrac tag on phys atm ' call shr_sys_abort(subname//' ERROR in setting afrac tag on phys atm') endif deallocate(tagValues) -#ifdef MOABDEBUG - outfile = 'atmCplFr.h5m'//C_NULL_CHAR - wopts = ';PARALLEL=WRITE_PART'//C_NULL_CHAR - ierr = iMOAB_WriteMesh(mbaxid, trim(outfile), trim(wopts)) - if (ierr .ne. 0) then - write(logunit,*) subname,' error in writing mesh ' - call shr_sys_abort(subname//' ERROR in writing mesh ') - endif -#endif endif endif @@ -478,18 +474,6 @@ subroutine seq_frac_init( infodata, & deallocate(GlobalIds) deallocate(tagValues) -#ifdef MOABDEBUG - ! debug test - - outfile = 'lndCplFr.h5m'//C_NULL_CHAR - wopts = ';PARALLEL=WRITE_PART'//C_NULL_CHAR - ! write out the mesh file to disk - ierr = iMOAB_WriteMesh(mblxid, trim(outfile), trim(wopts)) - if (ierr .ne. 0) then - write(logunit,*) subname,' error in writing mesh ' - call shr_sys_abort(subname//' ERROR in writing mesh ') - endif -#endif endif if (atm_present) then @@ -545,18 +529,6 @@ subroutine seq_frac_init( infodata, & deallocate(GlobalIds) deallocate(tagValues) -#ifdef MOABDEBUG - ! debug test - - outfile = 'rofCplFr.h5m'//C_NULL_CHAR - wopts = ';PARALLEL=WRITE_PART'//C_NULL_CHAR - ! write out the mesh file to disk - ierr = iMOAB_WriteMesh(mbrxid, trim(outfile), trim(wopts)) - if (ierr .ne. 0) then - write(logunit,*) subname,' error in writing mesh ' - call shr_sys_abort(subname//' ERROR in writing mesh ') - endif -#endif endif end if @@ -628,18 +600,6 @@ subroutine seq_frac_init( infodata, & deallocate(tagValues) ! TODO : project ice ofrac to atm , using the mapper i2a in MOAB (that we do not have yet) -#ifdef MOABDEBUG - ! debug test - - outfile = 'iceCplFr.h5m'//C_NULL_CHAR - wopts = ';PARALLEL=WRITE_PART'//C_NULL_CHAR - ! write out the mesh file to disk - ierr = iMOAB_WriteMesh(mbixid, trim(outfile), trim(wopts)) - if (ierr .ne. 0) then - write(logunit,*) subname,' error in writing mesh ' - call shr_sys_abort(subname//' ERROR in writing mesh ') - endif -#endif ! end copy from rof endif @@ -788,20 +748,6 @@ subroutine seq_frac_init( infodata, & endif -#ifdef MOABDEBUG - ! debug test - if (mboxid .ge. 0 ) then - outfile = 'ocnCplFr.h5m'//C_NULL_CHAR - wopts = ';PARALLEL=WRITE_PART'//C_NULL_CHAR - ! write out the mesh file to disk - ierr = iMOAB_WriteMesh(mboxid, trim(outfile), trim(wopts)) - if (ierr .ne. 0) then - write(logunit,*) subname,' error in writing mesh ' - call shr_sys_abort(subname//' ERROR in writing mesh ') - endif - endif -#endif - if (ice_present) then ! --- this should be an atm2ice call above, but atm2ice doesn't work mapper_o2i => prep_ice_get_mapper_SFo2i() @@ -876,6 +822,49 @@ subroutine seq_frac_init( infodata, & if (atm_present .and. (lnd_present.or.ice_present.or.ocn_present)) & call seq_frac_check(fractions_a,'atm init') seq_frac_debug = debug_old +#ifdef MOABDEBUG + wopts = ';PARALLEL=WRITE_PART'//C_NULL_CHAR + if (mbaxid .ge. 0 ) then + outfile = 'atmCplFr.h5m'//C_NULL_CHAR + ierr = iMOAB_WriteMesh(mbaxid, trim(outfile), trim(wopts)) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in writing mesh ' + call shr_sys_abort(subname//' ERROR in writing mesh ') + endif + endif + if (mblxid .ge. 0 ) then + outfile = 'lndCplFr.h5m'//C_NULL_CHAR + ierr = iMOAB_WriteMesh(mblxid, trim(outfile), trim(wopts)) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in writing mesh ' + call shr_sys_abort(subname//' ERROR in writing mesh ') + endif + endif + if (mbrxid .ge. 0 ) then + outfile = 'rofCplFr.h5m'//C_NULL_CHAR + ierr = iMOAB_WriteMesh(mbrxid, trim(outfile), trim(wopts)) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in writing mesh ' + call shr_sys_abort(subname//' ERROR in writing mesh ') + endif + endif + if (mbixid .ge. 0 ) then + outfile = 'iceCplFr.h5m'//C_NULL_CHAR + ierr = iMOAB_WriteMesh(mbixid, trim(outfile), trim(wopts)) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in writing mesh ' + call shr_sys_abort(subname//' ERROR in writing mesh ') + endif + endif + if (mboxid .ge. 0 ) then + outfile = 'ocnCplFr.h5m'//C_NULL_CHAR + ierr = iMOAB_WriteMesh(mboxid, trim(outfile), trim(wopts)) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in writing mesh ' + call shr_sys_abort(subname//' ERROR in writing mesh ') + endif + endif +#endif end subroutine seq_frac_init From c35ca3e376057fc0cf2b1ee6f0ffe50a1f6bd617 Mon Sep 17 00:00:00 2001 From: Robert Jacob Date: Mon, 9 Jan 2023 00:27:41 -0600 Subject: [PATCH 259/467] Fix some mapping in seq_frac_init Move a seq_map call to the correct place and remove some code no longer needed now that seq_map_map works for MOAB. Start to introduce mbofxid --- driver-moab/main/seq_frac_mct.F90 | 47 ++++++++++++------------------- 1 file changed, 18 insertions(+), 29 deletions(-) diff --git a/driver-moab/main/seq_frac_mct.F90 b/driver-moab/main/seq_frac_mct.F90 index 46d7723223a3..1e7cbce9af52 100644 --- a/driver-moab/main/seq_frac_mct.F90 +++ b/driver-moab/main/seq_frac_mct.F90 @@ -168,6 +168,7 @@ module seq_frac_mct use seq_comm_mct, only : mblx2id ! iMOAB id for land mesh instanced from MCT on coupler pes use seq_comm_mct, only : mbox2id ! iMOAB id for ocn mesh instanced from MCT on coupler pes use seq_comm_mct, only : mboxid ! iMOAB app id for ocn on cpl pes + use seq_comm_mct, only : mbofxid ! iMOAB app id for ocn on cpl pes use seq_comm_mct, only : mbixid ! iMOAB for sea-ice migrated to coupler use seq_comm_mct, only : atm_pg_active ! flag if PG mesh instanced use seq_comm_mct, only : mbintxao ! iMOAB id for intx mesh between ocean and atmosphere @@ -445,6 +446,7 @@ subroutine seq_frac_init( infodata, & allocate(tagValues(arrSize) ) tagValues = 0 ierr = iMOAB_SetDoubleTagStorage ( mblxid, tagname, arrSize , ent_type, tagValues) + if (ierr .ne. 0) then write(logunit,*) subname,' error in setting fractions tags on lnd ' call shr_sys_abort(subname//' ERROR in setting fractions tags on lnd') @@ -514,6 +516,7 @@ subroutine seq_frac_init( infodata, & tagValues = 0. ierr = iMOAB_SetDoubleTagStorage ( mbrxid, tagname, arrSize , ent_type, tagValues) deallocate(tagValues) + tagname = 'rfrac'//C_NULL_CHAR ! 'lfrin' allocate(tagValues(lSize) ) tagValues = dom_r%data%rAttr(kf,:) @@ -557,16 +560,10 @@ subroutine seq_frac_init( infodata, & call mct_aVect_init(fractions_i,rList=fraclist_i,lsize=lsize) call mct_aVect_zero(fractions_i) - ko = mct_aVect_indexRa(fractions_i,"ofrac",perrWith=subName) kf = mct_aVect_indexRA(dom_i%data ,"frac" ,perrWith=subName) fractions_i%rAttr(ko,:) = dom_i%data%rAttr(kf,:) - if (atm_present) then - mapper_i2a => prep_atm_get_mapper_Fi2a() - call seq_map_map(mapper_i2a,fractions_i,fractions_a,fldlist='ofrac',norm=.false.) - endif - if (mbixid .ge. 0 ) then ! // tagname = trim(fraclist_i)//C_NULL_CHAR ! 'afrac:ifrac:ofrac' tagtype = 1 ! dense, double @@ -584,7 +581,7 @@ subroutine seq_frac_init( infodata, & tagValues = 0. ierr = iMOAB_SetDoubleTagStorage ( mbixid, tagname, arrSize , ent_type, tagValues) deallocate(tagValues) - tagname = 'ofrac'//C_NULL_CHAR ! 'lfrin' + tagname = 'ofrac'//C_NULL_CHAR ! 'ofrac' allocate(tagValues(lSize) ) tagValues = dom_i%data%rAttr(kf,:) kgg = mct_aVect_indexIA(dom_i%data ,"GlobGridNum" ,perrWith=subName) @@ -598,9 +595,11 @@ subroutine seq_frac_init( infodata, & endif deallocate(GlobalIds) deallocate(tagValues) - ! TODO : project ice ofrac to atm , using the mapper i2a in MOAB (that we do not have yet) + endif - ! end copy from rof + if (atm_present) then + mapper_i2a => prep_atm_get_mapper_Fi2a() + call seq_map_map(mapper_i2a,fractions_i,fractions_a,fldlist='ofrac',norm=.false.) endif end if @@ -619,6 +618,11 @@ subroutine seq_frac_init( infodata, & tagtype = 1 ! dense, double numco = 1 ! ierr = iMOAB_DefineTagStorage(mboxid, tagname, tagtype, numco, tagindex ) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in defining tags on ocn phys mesh on cpl ' + call shr_sys_abort(subname//' ERROR in defining tags on ocn phys mesh on cpl') + endif + ierr = iMOAB_DefineTagStorage(mbofxid, tagname, tagtype, numco, tagindex ) if (ierr .ne. 0) then write(logunit,*) subname,' error in defining tags on ocn phys mesh on cpl ' call shr_sys_abort(subname//' ERROR in defining tags on ocn phys mesh on cpl') @@ -629,31 +633,14 @@ subroutine seq_frac_init( infodata, & ent_type = 1 ! cell type, ocn is FV tagValues = 0. ierr = iMOAB_SetDoubleTagStorage ( mboxid, tagname, arrSize , ent_type, tagValues) + ierr = iMOAB_SetDoubleTagStorage ( mbofxid, tagname, arrSize , ent_type, tagValues) deallocate(tagValues) endif if (ice_present) then mapper_i2o => prep_ocn_get_mapper_SFi2o() call seq_map_map(mapper_i2o,fractions_i,fractions_o,fldlist='ofrac',norm=.false.) - ! we can use the same logic as for ofrac on fractions_i, because ice and ocn is the same mesh - if (mboxid .ge. 0 ) then ! - ! we are using data from ofrac freom ice mesh !!!! - lSize = mct_aVect_lSize(dom_i%data) - tagname = 'ofrac'//C_NULL_CHAR ! 'lfrin' - allocate(tagValues(lSize) ) - tagValues = dom_i%data%rAttr(kf,:) - kgg = mct_aVect_indexIA(dom_i%data ,"GlobGridNum" ,perrWith=subName) - allocate(GlobalIds(lSize)) - GlobalIds = dom_i%data%iAttr(kgg,:) - - ierr = iMOAB_SetDoubleTagStorageWithGid ( mboxid, tagname, lSize , ent_type, tagValues, GlobalIds ) - if (ierr .ne. 0) then - write(logunit,*) subname,' error in setting ofrac on ocn from ice ' - call shr_sys_abort(subname//' ERROR in setting ofrac on ocn from ice ') - endif - deallocate(GlobalIds) - deallocate(tagValues) - endif + else ! still need to TODO moab case ko = mct_aVect_indexRa(fractions_o,"ofrac",perrWith=subName) @@ -667,6 +654,8 @@ subroutine seq_frac_init( infodata, & mapper_a2o => prep_ocn_get_mapper_Fa2o() call seq_map_map(mapper_a2o, fractions_a, fractions_o, fldlist='afrac',norm=.false.) +! No longer need this block because mapper_a2o exists and seq_map_map works. +#if 0 ! TODO moab projection using a2o moab map ! first, send the field to atm on coupler ! actually, afrac is 1 on all cells on mbaxid ; we need to project it to ocn @@ -743,7 +732,7 @@ subroutine seq_frac_init( infodata, & endif endif - +#endif endif From e50a6f203fba0ba34c621d8eb4598ad03e4c5950 Mon Sep 17 00:00:00 2001 From: Jason Sarich Date: Mon, 9 Jan 2023 11:36:53 -0600 Subject: [PATCH 260/467] add more checks in cime for moab driver --- cime | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/cime b/cime index c7fd2ff83c9f..c61a7d75f1e3 160000 --- a/cime +++ b/cime @@ -1 +1 @@ -Subproject commit c7fd2ff83c9ff3f2f75e0cae573319c1bcab3c83 +Subproject commit c61a7d75f1e3091360d80cfd80c10355c95461e9 From 86e1120d68c252b432ad7b6a78fd6d538636f604 Mon Sep 17 00:00:00 2001 From: Jason Sarich Date: Mon, 9 Jan 2023 11:54:03 -0600 Subject: [PATCH 261/467] fixed type in cime branch --- cime | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/cime b/cime index c61a7d75f1e3..48268c97b5df 160000 --- a/cime +++ b/cime @@ -1 +1 @@ -Subproject commit c61a7d75f1e3091360d80cfd80c10355c95461e9 +Subproject commit 48268c97b5df522b0c7c007cb79aa5b0be845bfe From 5ad42f320cf5102ba6192a0eabbfdb2a1b265c06 Mon Sep 17 00:00:00 2001 From: Robert Jacob Date: Tue, 10 Jan 2023 00:19:21 -0600 Subject: [PATCH 262/467] Add mappers for fluxes Add mapper_Fof2a and mapper_Sof2a which will map from the flux copy of the ocean mesh to atmosphere for MOAB. Also initialize them for MCT so seq_map_map doesn't need any changes. --- driver-moab/main/prep_atm_mod.F90 | 76 ++++++++++++++++++++++++++++++- 1 file changed, 75 insertions(+), 1 deletion(-) diff --git a/driver-moab/main/prep_atm_mod.F90 b/driver-moab/main/prep_atm_mod.F90 index 325f60bea4ef..2b53482a456a 100644 --- a/driver-moab/main/prep_atm_mod.F90 +++ b/driver-moab/main/prep_atm_mod.F90 @@ -22,7 +22,9 @@ module prep_atm_mod use seq_comm_mct, only : mbaxid ! iMOAB id for atm migrated mesh to coupler pes use seq_comm_mct, only : mphaid ! iMOAB id for phys atm on atm pes use seq_comm_mct, only : mboxid ! iMOAB id for mpas ocean migrated mesh to coupler pes + use seq_comm_mct, only : mbofxid ! iMOAB id for mpas ocean migrated mesh to coupler pes use seq_comm_mct, only : mbintxoa ! iMOAB id for intx mesh between ocean and atmosphere + use seq_comm_mct, only : mbintxofa ! iMOAB id for intx mesh between flux ocean and atmosphere use seq_comm_mct, only : mbintxao ! iMOAB id for intx mesh between atm and ocean use seq_comm_mct, only : mbixid ! iMOAB id for mpas ice migrated mesh to coupler pes use seq_comm_mct, only : mbintxia ! iMOAB id for intx mesh between ice and atm @@ -66,6 +68,8 @@ module prep_atm_mod public :: prep_atm_get_mapper_So2a public :: prep_atm_get_mapper_Fo2a + public :: prep_atm_get_mapper_Sof2a + public :: prep_atm_get_mapper_Fof2a public :: prep_atm_get_mapper_Sl2a public :: prep_atm_get_mapper_Fl2a public :: prep_atm_get_mapper_Si2a @@ -85,9 +89,11 @@ module prep_atm_mod ! mappers type(seq_map), pointer :: mapper_So2a + type(seq_map), pointer :: mapper_Sof2a ! for moab fluxes type(seq_map), pointer :: mapper_Sl2a type(seq_map), pointer :: mapper_Si2a type(seq_map), pointer :: mapper_Fo2a ! needed for seq_frac_init + type(seq_map), pointer :: mapper_Fof2a type(seq_map), pointer :: mapper_Fl2a ! needed for seq_frac_init type(seq_map), pointer :: mapper_Fi2a ! needed for seq_frac_init @@ -178,9 +184,11 @@ subroutine prep_atm_init(infodata, ocn_c2_atm, ice_c2_atm, lnd_c2_atm, iac_c2_at esmf_map_flag=esmf_map_flag) allocate(mapper_So2a) + allocate(mapper_Sof2a) allocate(mapper_Sl2a) allocate(mapper_Si2a) allocate(mapper_Fo2a) + allocate(mapper_Fof2a) allocate(mapper_Fl2a) allocate(mapper_Fi2a) @@ -222,6 +230,14 @@ subroutine prep_atm_init(infodata, ocn_c2_atm, ice_c2_atm, lnd_c2_atm, iac_c2_at 'seq_maps.rc','ocn2atm_smapname:','ocn2atm_smaptype:',samegrid_ao, & 'mapper_So2a initialization',esmf_map_flag) + if (iamroot_CPLID) then + write(logunit,*) ' ' + write(logunit,F00) 'Initializing mapper_Sof2a' + endif + call seq_map_init_rcfile(mapper_Sof2a, ocn(1), atm(1), & + 'seq_maps.rc','ocn2atm_smapname:','ocn2atm_smaptype:',samegrid_ao, & + 'mapper_Sof2a initialization',esmf_map_flag) + #ifdef HAVE_MOAB ! Call moab intx only if atm and ocn are init in moab if ((mbaxid .ge. 0) .and. (mboxid .ge. 0)) then @@ -257,6 +273,7 @@ subroutine prep_atm_init(infodata, ocn_c2_atm, ice_c2_atm, lnd_c2_atm, iac_c2_at write(logunit,*) subname,' error in computing comm graph for second hop, ocn-atm' call shr_sys_abort(subname//' ERROR in computing comm graph for second hop, ocn-atm') endif + ! now take care of the mapper mapper_So2a%src_mbid = mboxid mapper_So2a%tgt_mbid = mbaxid @@ -266,8 +283,10 @@ subroutine prep_atm_init(infodata, ocn_c2_atm, ice_c2_atm, lnd_c2_atm, iac_c2_at wgtIdef = 'scalar'//C_NULL_CHAR mapper_So2a%weight_identifier = wgtIdef mapper_So2a%mbname = 'mapper_So2a' + ! because we will project fields from ocean to atm phys grid, we need to define ! ocean o2x fields to atm phys grid (or atm spectral ext ) on coupler side + if (atm_pg_active) then tagname = trim(seq_flds_o2x_fields)//C_NULL_CHAR tagtype = 1 ! dense @@ -332,7 +351,33 @@ subroutine prep_atm_init(infodata, ocn_c2_atm, ice_c2_atm, lnd_c2_atm, iac_c2_at endif ! endif for MOABDEBUG #endif - endif ! if ((mbaxid .ge. 0) .and. (mboxid .ge. 0)) then + endif ! if ((mbaxid .ge. 0) .and. (mboxid .ge. 0)) then + +! FLUX make the app and mapper for the a2o flux mappings + if ((mbaxid .ge. 0) .and. (mbofxid .ge. 0)) then + ! we also need to compute the comm graph for the second hop, from the ocn on coupler to the + ! ocean for the intx ocean-atm context (coverage) + ! + call seq_comm_getinfo(CPLID ,mpigrp=mpigrp_CPLID) + type1 = 3; ! fv for ocean and atm; fv-cgll does not work anyway + type2 = 3; + ierr = iMOAB_ComputeCommGraph( mbofxid, mbintxoa, mpicom_CPLID, mpigrp_CPLID, mpigrp_CPLID, type1, type2, & + ocn(1)%cplcompid, idintx) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in computing comm graph for second hop, ocnf -atm' + call shr_sys_abort(subname//' ERROR in computing comm graph for second hop, ocnf-atm') + endif + + mapper_Sof2a%src_mbid = mbofxid + mapper_Sof2a%tgt_mbid = mbaxid + mapper_Sof2a%intx_mbid = mbintxoa + mapper_Sof2a%src_context = ocn(1)%cplcompid + mapper_Sof2a%intx_context = idintx + wgtIdef = 'scalar'//C_NULL_CHAR + mapper_Sof2a%weight_identifier = wgtIdef + mapper_Sof2a%mbname = 'mapper_Sof2a' + endif + ! endif for HAVE_MOAB #endif @@ -347,6 +392,15 @@ subroutine prep_atm_init(infodata, ocn_c2_atm, ice_c2_atm, lnd_c2_atm, iac_c2_at call seq_map_init_rcfile(mapper_Fo2a, ocn(1), atm(1), & 'seq_maps.rc','ocn2atm_fmapname:','ocn2atm_fmaptype:',samegrid_ao, & 'mapper_Fo2a initialization',esmf_map_flag) + + if (iamroot_CPLID) then + write(logunit,*) ' ' + write(logunit,F00) 'Initializing mapper_Fof2a' + endif + call seq_map_init_rcfile(mapper_Fof2a, ocn(1), atm(1), & + 'seq_maps.rc','ocn2atm_fmapname:','ocn2atm_fmaptype:',samegrid_ao, & + 'mapper_Fof2a initialization',esmf_map_flag) + ! copy mapper_So2a , maybe change the matrix ? still based on intersection ? #ifdef HAVE_MOAB if ((mbaxid .ge. 0) .and. (mboxid .ge. 0)) then @@ -360,6 +414,16 @@ subroutine prep_atm_init(infodata, ocn_c2_atm, ice_c2_atm, lnd_c2_atm, iac_c2_at mapper_Fo2a%weight_identifier = wgtIdef mapper_Fo2a%mbname = 'mapper_Fo2a' endif + if ((mbaxid .ge. 0) .and. (mbofxid .ge. 0)) then + mapper_Fof2a%src_mbid = mbofxid + mapper_Fof2a%tgt_mbid = mbaxid + mapper_Fof2a%intx_mbid = mbintxoa + mapper_Fof2a%src_context = ocn(1)%cplcompid + mapper_Fof2a%intx_context = idintx + wgtIdef = 'scalar'//C_NULL_CHAR + mapper_Fof2a%weight_identifier = wgtIdef + mapper_Fof2a%mbname = 'mapper_Fof2a' + endif ! endif for HAVE_MOAB #endif @@ -1967,6 +2031,16 @@ function prep_atm_get_mapper_Fo2a() prep_atm_get_mapper_Fo2a => mapper_Fo2a end function prep_atm_get_mapper_Fo2a + function prep_atm_get_mapper_Sof2a() + type(seq_map), pointer :: prep_atm_get_mapper_Sof2a + prep_atm_get_mapper_Sof2a => mapper_Sof2a + end function prep_atm_get_mapper_Sof2a + + function prep_atm_get_mapper_Fof2a() + type(seq_map), pointer :: prep_atm_get_mapper_Fof2a + prep_atm_get_mapper_Fof2a => mapper_Fof2a + end function prep_atm_get_mapper_Fof2a + function prep_atm_get_mapper_Sl2a() type(seq_map), pointer :: prep_atm_get_mapper_Sl2a prep_atm_get_mapper_Sl2a => mapper_Sl2a From e04a5eba85a826f755324056327740276d7f8733 Mon Sep 17 00:00:00 2001 From: Robert Jacob Date: Tue, 10 Jan 2023 00:25:07 -0600 Subject: [PATCH 263/467] Use new flux mappers Use new mapper_Fof2a and mapper_Sof2a to map the xao fluxes. These are needed for MOAB to operate on the correct mesh. Also output a .h5m file of the ocean flux mesh. --- driver-moab/main/prep_aoflux_mod.F90 | 31 +++++++++++++++++++--------- 1 file changed, 21 insertions(+), 10 deletions(-) diff --git a/driver-moab/main/prep_aoflux_mod.F90 b/driver-moab/main/prep_aoflux_mod.F90 index 85fcf8434e10..3d44d7175309 100644 --- a/driver-moab/main/prep_aoflux_mod.F90 +++ b/driver-moab/main/prep_aoflux_mod.F90 @@ -160,7 +160,7 @@ subroutine prep_aoflux_init (infodata) arrSize = nvise(1) * size_list ! there are size_list tags that need to be zeroed out allocate(tagValues(arrSize) ) ent_type = 1 ! cell type - tagValues = 0 + tagValues = 0._r8 ierr = iMOAB_SetDoubleTagStorage ( mbofxid, tagname, arrSize , ent_type, tagValues) if (ierr .ne. 0) then write(logunit,*) subname,' error in zeroing out xao_fields ' @@ -173,7 +173,7 @@ subroutine prep_aoflux_init (infodata) write(logunit,*) subname,' error in defining tags on ocn mct mesh on cpl ' call shr_sys_abort(subname//' ERROR in defining tags on ocn mct mesh on cpl') endif - xao_omct = 0. + xao_omct = 0._r8 ent_type = 0 ! cell type, this is point cloud mct arrSize = lsize_o * size_list ierr = iMOAB_SetDoubleTagStorage ( mbox2id, tagname, arrSize , ent_type, xao_omct) @@ -182,6 +182,7 @@ subroutine prep_aoflux_init (infodata) call shr_sys_abort(subname//' ERROR in zeroing out xao_fields on mct instance ocn ') endif deallocate(tagValues) + deallocate(xao_omct) #ifdef MOABDEBUG ! debug out file outfile = 'o_flux.h5m'//C_NULL_CHAR @@ -225,7 +226,7 @@ subroutine prep_aoflux_init (infodata) arrSize = nvise(1) * size_list ! there are size_list tags that need to be zeroed out allocate(tagValues(arrSize) ) ent_type = 1 ! cell type now, not a point cloud anymore - tagValues = 0 + tagValues = 0._r8 ierr = iMOAB_SetDoubleTagStorage ( mbaxid, tagname, arrSize , ent_type, tagValues) if (ierr .ne. 0) then write(logunit,*) subname,' error in zeroing out xao_fields ' @@ -246,6 +247,8 @@ subroutine prep_aoflux_calc_xao_ax(fractions_ox, flds, timer) ! Uses use prep_atm_mod, only: prep_atm_get_mapper_So2a use prep_atm_mod, only: prep_atm_get_mapper_Fo2a + use prep_atm_mod, only: prep_atm_get_mapper_Sof2a + use prep_atm_mod, only: prep_atm_get_mapper_Fof2a #ifdef MOABDEBUG use iMOAB, only : iMOAB_WriteMesh #endif @@ -258,6 +261,8 @@ subroutine prep_aoflux_calc_xao_ax(fractions_ox, flds, timer) ! Local Variables type(seq_map) , pointer :: mapper_So2a type(seq_map) , pointer :: mapper_Fo2a + type(seq_map) , pointer :: mapper_Sof2a + type(seq_map) , pointer :: mapper_Fof2a integer :: exi, efi character(*), parameter :: subname = '(prep_aoflux_calc_xao_ax)' character(*), parameter :: F00 = "('"//subname//" : ', 4A )" @@ -272,8 +277,8 @@ subroutine prep_aoflux_calc_xao_ax(fractions_ox, flds, timer) do exi = 1,num_inst_xao efi = mod((exi-1),num_inst_frc) + 1 - mapper_So2a => prep_atm_get_mapper_So2a() - call seq_map_map(mapper_So2a, xao_ox(exi), xao_ax(exi), & + mapper_Sof2a => prep_atm_get_mapper_Sof2a() + call seq_map_map(mapper_Sof2a, xao_ox(exi), xao_ax(exi), & fldlist=seq_flds_xao_albedo, norm=.true., & avwts_s=fractions_ox(efi),avwtsfld_s='ofrac') enddo @@ -283,26 +288,32 @@ subroutine prep_aoflux_calc_xao_ax(fractions_ox, flds, timer) do exi = 1,num_inst_xao efi = mod((exi-1),num_inst_frc) + 1 - mapper_So2a => prep_atm_get_mapper_So2a() - call seq_map_map(mapper_So2a, xao_ox(exi), xao_ax(exi), & + mapper_Sof2a => prep_atm_get_mapper_Sof2a() + call seq_map_map(mapper_Sof2a, xao_ox(exi), xao_ax(exi), & fldlist=seq_flds_xao_states, norm=.true., & avwts_s=fractions_ox(efi),avwtsfld_s='ofrac') - mapper_Fo2a => prep_atm_get_mapper_Fo2a() - call seq_map_map(mapper_Fo2a, xao_ox(exi), xao_ax(exi),& + mapper_Fof2a => prep_atm_get_mapper_Fof2a() + call seq_map_map(mapper_Fof2a, xao_ox(exi), xao_ax(exi),& fldlist=seq_flds_xao_fluxes, norm=.true., & avwts_s=fractions_ox(efi),avwtsfld_s='ofrac') enddo #ifdef MOABDEBUG ! projections on atm + wopts = ';PARALLEL=WRITE_PART'//C_NULL_CHAR ! write(lnum,"(I0.2)")num_moab_exports outfile = 'FlxAlb2Atm'//trim(lnum)//'.h5m'//C_NULL_CHAR - wopts = ';PARALLEL=WRITE_PART'//C_NULL_CHAR ! ierr = iMOAB_WriteMesh(mbaxid, trim(outfile), trim(wopts)) if (ierr .ne. 0) then write(logunit,*) subname,' error in writing ocean to atm projection' call shr_sys_abort(subname//' ERROR in writing ocean to atm projection') endif + outfile = 'FlxAlb2Ocn'//trim(lnum)//'.h5m'//C_NULL_CHAR + ierr = iMOAB_WriteMesh(mbofxid, trim(outfile), trim(wopts)) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in writing ocean to atm projection' + call shr_sys_abort(subname//' ERROR in writing ocean to atm projection') + endif #endif end if call t_drvstopf (trim(timer)) From 49b4211490c5cc0c8756f5c677c204ed013bcd09 Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Tue, 10 Jan 2023 14:10:40 -0600 Subject: [PATCH 264/467] no mbintxofa needed --- driver-moab/main/prep_atm_mod.F90 | 1 - 1 file changed, 1 deletion(-) diff --git a/driver-moab/main/prep_atm_mod.F90 b/driver-moab/main/prep_atm_mod.F90 index 2b53482a456a..bbeb49a8eabd 100644 --- a/driver-moab/main/prep_atm_mod.F90 +++ b/driver-moab/main/prep_atm_mod.F90 @@ -24,7 +24,6 @@ module prep_atm_mod use seq_comm_mct, only : mboxid ! iMOAB id for mpas ocean migrated mesh to coupler pes use seq_comm_mct, only : mbofxid ! iMOAB id for mpas ocean migrated mesh to coupler pes use seq_comm_mct, only : mbintxoa ! iMOAB id for intx mesh between ocean and atmosphere - use seq_comm_mct, only : mbintxofa ! iMOAB id for intx mesh between flux ocean and atmosphere use seq_comm_mct, only : mbintxao ! iMOAB id for intx mesh between atm and ocean use seq_comm_mct, only : mbixid ! iMOAB id for mpas ice migrated mesh to coupler pes use seq_comm_mct, only : mbintxia ! iMOAB id for intx mesh between ice and atm From b1e2ca24bc97c2d06d9b338c7e3253c95b732e3e Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Tue, 10 Jan 2023 15:01:10 -0600 Subject: [PATCH 265/467] context for mbofxid it is different from ocean cplid ocn(1)%cplcompid + 1000 xao_omct is like an AV, it needs to live longer --- driver-moab/main/prep_aoflux_mod.F90 | 2 +- driver-moab/main/prep_atm_mod.F90 | 8 ++++++-- 2 files changed, 7 insertions(+), 3 deletions(-) diff --git a/driver-moab/main/prep_aoflux_mod.F90 b/driver-moab/main/prep_aoflux_mod.F90 index 3d44d7175309..b10d19115cb6 100644 --- a/driver-moab/main/prep_aoflux_mod.F90 +++ b/driver-moab/main/prep_aoflux_mod.F90 @@ -182,7 +182,7 @@ subroutine prep_aoflux_init (infodata) call shr_sys_abort(subname//' ERROR in zeroing out xao_fields on mct instance ocn ') endif deallocate(tagValues) - deallocate(xao_omct) + !deallocate(xao_omct) #ifdef MOABDEBUG ! debug out file outfile = 'o_flux.h5m'//C_NULL_CHAR diff --git a/driver-moab/main/prep_atm_mod.F90 b/driver-moab/main/prep_atm_mod.F90 index bbeb49a8eabd..17c9f84a43a4 100644 --- a/driver-moab/main/prep_atm_mod.F90 +++ b/driver-moab/main/prep_atm_mod.F90 @@ -168,6 +168,7 @@ subroutine prep_atm_init(infodata, ocn_c2_atm, ice_c2_atm, lnd_c2_atm, iac_c2_at integer :: type1, type2 ! type for computing graph; should be the same type for ocean, 3 (FV) integer :: tagtype, numco, tagindex character(CXX) :: tagName + integer :: context_id ! we will use a special context for the extra flux ocean instance !--------------------------------------------------------------- @@ -360,8 +361,11 @@ subroutine prep_atm_init(infodata, ocn_c2_atm, ice_c2_atm, lnd_c2_atm, iac_c2_at call seq_comm_getinfo(CPLID ,mpigrp=mpigrp_CPLID) type1 = 3; ! fv for ocean and atm; fv-cgll does not work anyway type2 = 3; + ! we ideintified the app mbofxid with !id_join = id_join + 1000! kind of random + ! line 1267 in cplcomp_exchange_mod.F90 + context_id = ocn(1)%cplcompid + 1000 ierr = iMOAB_ComputeCommGraph( mbofxid, mbintxoa, mpicom_CPLID, mpigrp_CPLID, mpigrp_CPLID, type1, type2, & - ocn(1)%cplcompid, idintx) + context_id, idintx) if (ierr .ne. 0) then write(logunit,*) subname,' error in computing comm graph for second hop, ocnf -atm' call shr_sys_abort(subname//' ERROR in computing comm graph for second hop, ocnf-atm') @@ -370,7 +374,7 @@ subroutine prep_atm_init(infodata, ocn_c2_atm, ice_c2_atm, lnd_c2_atm, iac_c2_at mapper_Sof2a%src_mbid = mbofxid mapper_Sof2a%tgt_mbid = mbaxid mapper_Sof2a%intx_mbid = mbintxoa - mapper_Sof2a%src_context = ocn(1)%cplcompid + mapper_Sof2a%src_context = context_id mapper_Sof2a%intx_context = idintx wgtIdef = 'scalar'//C_NULL_CHAR mapper_Sof2a%weight_identifier = wgtIdef From de3161aed9ddef8d028edabc53e4825406ac0bd8 Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Tue, 10 Jan 2023 16:59:14 -0600 Subject: [PATCH 266/467] need to update rof app otherwise communication does not work --- components/mosart/src/cpl/rof_comp_mct.F90 | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/components/mosart/src/cpl/rof_comp_mct.F90 b/components/mosart/src/cpl/rof_comp_mct.F90 index c7eb2c358470..59c3cdcd8ab9 100644 --- a/components/mosart/src/cpl/rof_comp_mct.F90 +++ b/components/mosart/src/cpl/rof_comp_mct.F90 @@ -798,7 +798,7 @@ subroutine init_rof_moab() use shr_const_mod, only: SHR_CONST_PI use iMOAB, only : iMOAB_CreateVertices, iMOAB_WriteMesh, & iMOAB_DefineTagStorage, iMOAB_SetIntTagStorage, iMOAB_SetDoubleTagStorage, & - iMOAB_ResolveSharedEntities, iMOAB_CreateElements, iMOAB_MergeVertices + iMOAB_ResolveSharedEntities, iMOAB_CreateElements, iMOAB_MergeVertices, iMOAB_UpdateMeshInfo integer,allocatable :: gindex(:) ! Number the local grid points; used for global ID integer lsz ! keep local size @@ -907,7 +907,9 @@ subroutine init_rof_moab() if (ierr > 0 ) & call shr_sys_abort(sub//' Error: fail to set aream tag ') - + ierr = iMOAB_UpdateMeshInfo ( mrofid ) + if (ierr > 0 ) & + call shr_sys_abort(sub//' Error: fail to update mesh info ') deallocate(moab_vert_coords) deallocate(vgids) deallocate(coords) From 2c5b439fec0f5bee10b05ae16e70b0f8d9e325ee Mon Sep 17 00:00:00 2001 From: Robert Jacob Date: Tue, 10 Jan 2023 19:38:42 -0600 Subject: [PATCH 267/467] Set lfrac on atmosphere for MOAB Add code to set the calculated lfrac on the MOAB atm mesh. Also remove some commented out/blocked out code. --- driver-moab/main/seq_frac_mct.F90 | 119 +++++------------------------- 1 file changed, 19 insertions(+), 100 deletions(-) diff --git a/driver-moab/main/seq_frac_mct.F90 b/driver-moab/main/seq_frac_mct.F90 index 1e7cbce9af52..4314cf3e8b1e 100644 --- a/driver-moab/main/seq_frac_mct.F90 +++ b/driver-moab/main/seq_frac_mct.F90 @@ -642,7 +642,7 @@ subroutine seq_frac_init( infodata, & call seq_map_map(mapper_i2o,fractions_i,fractions_o,fldlist='ofrac',norm=.false.) else - ! still need to TODO moab case + ! still need to TODO moab case when no sea ice ko = mct_aVect_indexRa(fractions_o,"ofrac",perrWith=subName) kf = mct_aVect_indexRA(dom_o%data ,"frac" ,perrWith=subName) fractions_o%rAttr(ko,:) = dom_o%data%rAttr(kf,:) @@ -653,87 +653,6 @@ subroutine seq_frac_init( infodata, & if (atm_present) then mapper_a2o => prep_ocn_get_mapper_Fa2o() call seq_map_map(mapper_a2o, fractions_a, fractions_o, fldlist='afrac',norm=.false.) - -! No longer need this block because mapper_a2o exists and seq_map_map works. -#if 0 - ! TODO moab projection using a2o moab map - ! first, send the field to atm on coupler - ! actually, afrac is 1 on all cells on mbaxid ; we need to project it to ocn - ! if on spectral mesh, we need to send it - ! afrac ext tag that is not defined yet ? - idintx = 100*atm%cplcompid + ocn%cplcompid ! something different, to differentiate it; ~ 618 ! - mpicom = seq_comm_mpicom(CPLID) ! - tagName = 'afrac'//C_NULL_CHAR - tagNameExt = 'afrac_ext'//C_NULL_CHAR - if (.not. atm_pg_active) then - tagtype = 1 ! dense, double - numco = 16 ! special case - ierr = iMOAB_DefineTagStorage(mbaxid, tagNameExt, tagtype, numco, tagindex ) - ! also, set it to 1.0, 16 times per cell - if (ierr .ne. 0) then - write(logunit,*) subname,' error in defining the afrac_ext tag ' - call shr_sys_abort(subname//' ERROR in setting ofrac_ext tag ') - endif - ierr = iMOAB_GetMeshInfo ( mbaxid, nvert, nvise, nbl, nsurf, nvisBC ); - arrSize = nvise(1)*16 ! this assumes always np = 4 - allocate(tagValues(arrSize) ) - tagValues = 1.0 - ent_type = 1 ! cells, actually spectral quads - ierr = iMOAB_SetDoubleTagStorage ( mbaxid, tagNameExt, arrSize , ent_type, tagValues) - if (ierr .ne. 0) then - write(logunit,*) subname,' error in setting the afrac_ext tag ' - call shr_sys_abort(subname//' ERROR in setting ofracc_ext tag ') - endif - endif - ! we have to send towards the coverage, because local mesh is not "covering" the target - ! we have to use the graph computed at the end of prep_atm_ocn_moab - ! if (mbaxid .ge. 0) then - ! ierr = iMOAB_ComputeCommGraph( mbaxid, mbintxao, mpicom_CPLID, mpigrp_CPLID, mpigrp_CPLID, & - ! typeA, typeB, id_join, idintx) - if ((mbaxid .ge. 0) .and. (mbintxao .ge. 0)) then - id_join = atm%cplcompid ! atm cpl ext id for moab (6) - ierr = iMOAB_SendElementTag(mbaxid, tagName, mpicom, idintx) ! context is intx ao - if (ierr .ne. 0) then - write(logunit,*) subname,' error in sending afrac tag ' - call shr_sys_abort(subname//' ERROR in sending afrac tag ') - endif - ! now project to ocean grid; first receive, then project - wgtIdef = 'scalar'//C_NULL_CHAR - if (atm_pg_active) then - ierr = iMOAB_ReceiveElementTag(mbintxao, tagName, mpicom, id_join) - if (ierr .ne. 0) then - write(logunit,*) subname,' error in receiving afrac tag ' - call shr_sys_abort(subname//' ERROR in receiving afrac tag ') - endif - ierr = iMOAB_FreeSenderBuffers(mbaxid, idintx) ! context is intx ao - if (ierr .ne. 0) then - write(logunit,*) subname,' error in freeing buffers ' - call shr_sys_abort(subname//' ERROR in freeing buffers ') - endif - - ierr = iMOAB_ApplyScalarProjectionWeights ( mbintxao, wgtIdef, tagName, tagName) - - else - ierr = iMOAB_ReceiveElementTag(mbintxao, tagNameExt, mpicom, id_join) - if (ierr .ne. 0) then - write(logunit,*) subname,' error in receiving afrac_ext tag ' - call shr_sys_abort(subname//' ERROR in receiving afrac_ext tag ') - endif - ierr = iMOAB_FreeSenderBuffers(mbaxid, idintx) ! context is intx ao - if (ierr .ne. 0) then - write(logunit,*) subname,' error in freeing buffers ' - call shr_sys_abort(subname//' ERROR in freeing buffers ') - endif - ierr = iMOAB_ApplyScalarProjectionWeights ( mbintxao, wgtIdef, tagNameExt, tagName) - endif - if (ierr .ne. 0) then - write(logunit,*) subname,' error in applying weights for afrac on ocean calculation' - call shr_sys_abort(subname//' ERROR in applying weights') - endif - - endif -#endif - endif @@ -765,7 +684,25 @@ subroutine seq_frac_init( infodata, & if (atm_frac_correct) fractions_a%rAttr(ko,n) = 1.0_r8 endif enddo + ! TODO: replace this with math + if (mbaxid .ge. 0 ) then ! // + tagname = 'lfrac'//C_NULL_CHAR ! 'lfrac + allocate(tagValues(lSize) ) + tagValues = fractions_a%rAttr(kl,:) + kgg = mct_aVect_indexIA(dom_a%data ,"GlobGridNum" ,perrWith=subName) + allocate(GlobalIds(lSize)) + GlobalIds = dom_a%data%iAttr(kgg,:) + ! set on atmosphere instance + ierr = iMOAB_SetDoubleTagStorageWithGid ( mbaxid, tagname, lSize , ent_type, tagValues, GlobalIds ) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in setting lfrac on atm ' + call shr_sys_abort(subname//' ERROR in setting lfrac on atm ') + endif + deallocate(GlobalIds) + deallocate(tagValues) + endif else if (lnd_present) then + ! TODO: MOAB case. do n = 1,lsize fractions_a%rAttr(kl,n) = fractions_a%rAttr(kk,n) fractions_a%rAttr(ko,n) = 1.0_r8 - fractions_a%rAttr(kl,n) @@ -971,24 +908,6 @@ subroutine seq_frac_set(infodata, ice, ocn, fractions_a, fractions_i, fractions_ call shr_sys_abort(subname//' ERROR in setting ofrac on ocn moab instance ') endif - ! ! correct ifrad and ofrad too in this method; remove fraco_rad_moab - ! tagname = 'ifrad'//C_NULL_CHAR - ! ! fraclist_o = 'afrac:ifrac:ofrac:ifrad:ofrad' - ! tagValues = fractions_o%rAttr(4,:) - ! ierr = iMOAB_SetDoubleTagStorageWithGid ( mboxid, tagname, lSize , ent_type, tagValues, GlobalIds ) - ! if (ierr .ne. 0) then - ! write(logunit,*) subname,' error in setting ifrad on ocn moab instance ' - ! call shr_sys_abort(subname//' ERROR in setting ifrad on ocn moab instance ') - ! endif - ! tagname = 'ofrad'//C_NULL_CHAR - ! ! fraclist_o = 'afrac:ifrac:ofrac:ifrad:ofrad' - ! tagValues = fractions_o%rAttr(5,:) - ! ierr = iMOAB_SetDoubleTagStorageWithGid ( mboxid, tagname, lSize , ent_type, tagValues, GlobalIds ) - ! if (ierr .ne. 0) then - ! write(logunit,*) subname,' error in setting ofrad on ocn moab instance ' - ! call shr_sys_abort(subname//' ERROR in setting ofrad on ocn moab instance ') - ! endif - first_time = .false. endif From 110be6630f0cc51b941b11c105c86af09de83f80 Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Tue, 10 Jan 2023 21:17:59 -0600 Subject: [PATCH 268/467] add r2o 2 hop logic not working yet --- driver-moab/main/cime_comp_mod.F90 | 2 +- driver-moab/main/cplcomp_exchange_mod.F90 | 24 ++--- driver-moab/main/prep_ocn_mod.F90 | 121 ++++++++++++++++++++-- 3 files changed, 126 insertions(+), 21 deletions(-) diff --git a/driver-moab/main/cime_comp_mod.F90 b/driver-moab/main/cime_comp_mod.F90 index 37ab43c64370..118c5593cab3 100644 --- a/driver-moab/main/cime_comp_mod.F90 +++ b/driver-moab/main/cime_comp_mod.F90 @@ -4709,7 +4709,7 @@ subroutine cime_run_rof_recv_post() ! this is for one hop call component_exch_moab(rof(1), mrofid, mbrxid, 0, seq_flds_r2x_fields) - call prep_rof_migrate_moab(infodata) + !call prep_rof_migrate_moab(infodata) endif !---------------------------------------------------------- diff --git a/driver-moab/main/cplcomp_exchange_mod.F90 b/driver-moab/main/cplcomp_exchange_mod.F90 index c4b3eda18f30..37412e220e98 100644 --- a/driver-moab/main/cplcomp_exchange_mod.F90 +++ b/driver-moab/main/cplcomp_exchange_mod.F90 @@ -1477,7 +1477,17 @@ subroutine cplcomp_moab_Init(comp) if ( ierr .ne. 0 ) then call shr_sys_abort( subname//' ERROR: cannot read rof mesh on coupler' ) end if - +#ifdef MOABDEBUG + ! debug test + outfile = 'recRof.h5m'//C_NULL_CHAR + wopts = ';PARALLEL=WRITE_PART'//C_NULL_CHAR ! + ! write out the mesh file to disk + ierr = iMOAB_WriteMesh(mbrxid, trim(outfile), trim(wopts)) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in writing rof mesh on coupler ' + call shr_sys_abort(subname//' ERROR in writing rof mesh on coupler ') + endif +#endif tagtype = 1 ! dense, double numco = 1 ! one value per cell / entity tagname = trim(seq_flds_r2x_fields)//C_NULL_CHAR @@ -1497,17 +1507,7 @@ subroutine cplcomp_moab_Init(comp) write(logunit,*) subname,' error in defining tags seq_flds_dom_fields on rof on coupler ' call shr_sys_abort(subname//' ERROR in defining tags ') endif -#ifdef MOABDEBUG - ! debug test - outfile = 'recRof.h5m'//C_NULL_CHAR - wopts = ';PARALLEL=WRITE_PART'//C_NULL_CHAR ! - ! write out the mesh file to disk - ierr = iMOAB_WriteMesh(mbrxid, trim(outfile), trim(wopts)) - if (ierr .ne. 0) then - write(logunit,*) subname,' error in writing rof mesh on coupler ' - call shr_sys_abort(subname//' ERROR in writing rof mesh on coupler ') - endif -#endif + endif ! we are now on joint pes, compute comm graph between rof and coupler model typeA = 2 ! point cloud on component PEs diff --git a/driver-moab/main/prep_ocn_mod.F90 b/driver-moab/main/prep_ocn_mod.F90 index 9c0857dc4b92..3c39e70d29d5 100644 --- a/driver-moab/main/prep_ocn_mod.F90 +++ b/driver-moab/main/prep_ocn_mod.F90 @@ -16,6 +16,7 @@ module prep_ocn_mod use seq_comm_mct, only: mboxid ! iMOAB id for mpas ocean migrated mesh to coupler pes use seq_comm_mct, only: mbrmapro ! iMOAB id for map read from rof2ocn map file use seq_comm_mct, only: mbrxoid ! iMOAB id for rof on coupler in ocean context; + use seq_comm_mct, only: mbrxid ! iMOAB id of moab rof read on couple pes use seq_comm_mct, only : atm_pg_active ! whether the atm uses FV mesh or not ; made true if fv_nphys > 0 use seq_comm_mct, only : mbaxid ! iMOAB id for atm migrated mesh to coupler pes use seq_comm_mct, only : mbintxao ! iMOAB id for intx mesh between atm and ocean @@ -162,7 +163,8 @@ subroutine prep_ocn_init(infodata, atm_c2_ocn, atm_c2_ice, ice_c2_ocn, rof_c2_oc wav_c2_ocn, glc_c2_ocn, glcshelf_c2_ocn) use iMOAB, only: iMOAB_ComputeMeshIntersectionOnSphere, iMOAB_RegisterApplication, & - iMOAB_WriteMesh, iMOAB_DefineTagStorage, iMOAB_ComputeCommGraph, iMOAB_ComputeScalarProjectionWeights + iMOAB_WriteMesh, iMOAB_DefineTagStorage, iMOAB_ComputeCommGraph, iMOAB_ComputeScalarProjectionWeights, & + iMOAB_MigrateMapMesh, iMOAB_WriteLocalMesh !--------------------------------------------------------------- ! Description ! Initialize module attribute vectors and all other non-mapping @@ -215,8 +217,11 @@ subroutine prep_ocn_init(infodata, atm_c2_ocn, atm_c2_ice, ice_c2_ocn, rof_c2_oc integer :: tagtype, numco, tagindex character(CXX) :: tagName - integer :: rmapid ! external id to identify the moab app + integer :: rmapid, rmapid2 ! external id to identify the moab app ; 2 is for rof in ocean context (coverage) integer :: type_grid ! + integer :: context_id, direction + character*32 :: prefix_output ! for writing a coverage file for debugging + integer :: rank_on_cpl ! just for debugging !--------------------------------------------------------------- @@ -551,7 +556,8 @@ subroutine prep_ocn_init(infodata, atm_c2_ocn, atm_c2_ice, ice_c2_ocn, rof_c2_oc call seq_map_init_rcfile(mapper_Rr2o_liq, rof(1), ocn(1), & 'seq_maps.rc', 'rof2ocn_liq_rmapname:', 'rof2ocn_liq_rmaptype:',samegrid_ro, & 'mapper_Rr2o_liq initialization',esmf_map_flag) - + +#ifdef HAVE_MOAB appname = "ROF_OCN_COU"//CHAR(0) ! rmapid is a unique external number of MOAB app that takes care of map between rof and ocn mesh rmapid = 100*rof(1)%cplcompid + ocn(1)%cplcompid ! something different, to differentiate it @@ -565,14 +571,91 @@ subroutine prep_ocn_init(infodata, atm_c2_ocn, atm_c2_ice, ice_c2_ocn, rof_c2_oc call moab_map_init_rcfile(mbrmapro, mboxid, type_grid, rof(1), ocn(1), & 'seq_maps.rc', 'rof2ocn_liq_rmapname:', 'rof2ocn_liq_rmaptype:',samegrid_ro, & 'mapper_Rr2o_liq moab initialization',esmf_map_flag) - appname = "ROF_COU"//C_NULL_CHAR - ! rmapid is a unique external number of MOAB app that identifies runoff on coupler side - rmapid = 100*rof(1)%cplcompid ! this is a special case, because we also have a regular coupler instance mbrxid - ierr = iMOAB_RegisterApplication(trim(appname), mpicom_CPLID, rmapid, mbrxoid) + ! this is a special rof mesh redistribution, for the ocean context + ! it will be used to project from rof to ocean + ! the mesh will be migrated, to be able to do the second hop + appname = "ROF_OCOU"//C_NULL_CHAR + ! rmapid is a unique external number of MOAB app that identifies runoff on coupler side + rmapid2 = 100*rof(1)%cplcompid ! this is a special case, because we also have a regular coupler instance mbrxid + ierr = iMOAB_RegisterApplication(trim(appname), mpicom_CPLID, rmapid2, mbrxoid) if (ierr .ne. 0) then write(logunit,*) subname,' error in registering rof on coupler in ocean context ' call shr_sys_abort(subname//' ERROR in registering rof on coupler in ocean context ') endif + ! this code was moved from prep_rof_ocn_moab, because we will do everything on coupler side, not + ! needed to be on joint comm anymore for the second hop + + ! it read on the coupler side, from file, the scrip mosart, that has a full mesh; + ! also migrate rof mesh on coupler pes, in ocean context, mbrxoid + ! map between rof 2 ocn is in mbrmapro ; + ! after this, the sending of tags for second hop (ocn context) will use the new par comm graph, + ! that has more precise info + call seq_comm_getData(CPLID, mpicom=mpicom_CPLID, iamroot=iamroot_CPLID) + + call seq_comm_getData(CPLID ,mpigrp=mpigrp_CPLID) ! second group, the coupler group CPLID is global variable + + type1 = 3 ! fv mesh nowadays + direction = 1 ! + context_id = ocn(1)%cplcompid + ierr = iMOAB_MigrateMapMesh (mbrxid, mbrmapro, mbrxoid, mpicom_CPLID, mpigrp_CPLID, & + mpigrp_CPLID, type1, rof(1)%cplcompid, context_id, direction) + + if (ierr .ne. 0) then + write(logunit,*) subname,' error in migrating rof mesh for map rof c2 ocn ' + call shr_sys_abort(subname//' ERROR in migrating rof mesh for map rof c2 ocn ') + endif + if (iamroot_CPLID) then + write(logunit,*) subname,' migrated mesh for map rof 2 ocn ' + endif + if (mbrxoid .ge. 0) then ! we are on coupler side pes + tagname=trim(seq_flds_r2x_fields)//C_NULL_CHAR + tagtype = 1 ! dense, double + numco= 1 ! 1 scalar per node + ierr = iMOAB_DefineTagStorage(mbrxoid, tagname, tagtype, numco, tagindex ) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in defining ' // trim(seq_flds_r2x_fields) // ' tags on coupler side in MOAB' + call shr_sys_abort(subname//' ERROR in defining MOAB tags ') + endif + endif + + if (mboxid .ge. 0) then ! we are on coupler side pes, for ocean mesh + tagname=trim(seq_flds_r2x_fields)//C_NULL_CHAR + tagtype = 1 ! dense, double + numco= 1 ! 1 scalar per node + ierr = iMOAB_DefineTagStorage(mboxid, tagname, tagtype, numco, tagindex ) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in defining ' // trim(seq_flds_r2x_fields) // ' tags on coupler side in MOAB, for ocean app' + call shr_sys_abort(subname//' ERROR in defining MOAB tags ') + endif + endif + + + if (iamroot_CPLID) then + write(logunit,*) subname,' created moab tags for seq_flds_r2x_fields ' + endif + ! now we have to populate the map with the right moab attibutes, so that it does the right projection +#ifdef MOABDEBUG + if (mbrxoid.ge.0) then ! we are on coupler PEs + call mpi_comm_rank(mpicom_CPLID, rank_on_cpl , ierr) + if (rank_on_cpl .lt. 4) then + prefix_output = "rof_cov"//CHAR(0) + ierr = iMOAB_WriteLocalMesh(mbrxoid, prefix_output) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in writing coverage mesh rof 2 ocn ' + endif + endif + endif +#endif +! now take care of the mapper for MOAB mapper_Rr2o_liq + mapper_Rr2o_liq%src_mbid = mbrxid + mapper_Rr2o_liq%tgt_mbid = mbrxoid + mapper_Rr2o_liq%intx_mbid = mbrmapro + mapper_Rr2o_liq%src_context = rof(1)%cplcompid + mapper_Rr2o_liq%intx_context = rmapid + wgtIdef = 'scalar'//C_NULL_CHAR + mapper_Rr2o_liq%weight_identifier = wgtIdef + mapper_Rr2o_liq%mbname = 'mapper_Rr2o_liq' +#endif if (iamroot_CPLID) then write(logunit,*) ' ' @@ -581,7 +664,18 @@ subroutine prep_ocn_init(infodata, atm_c2_ocn, atm_c2_ice, ice_c2_ocn, rof_c2_oc call seq_map_init_rcfile(mapper_Rr2o_ice, rof(1), ocn(1), & 'seq_maps.rc', 'rof2ocn_ice_rmapname:', 'rof2ocn_ice_rmaptype:',samegrid_ro, & 'mapper_Rr2o_ice initialization',esmf_map_flag) - +! us the same one for mapper_Rr2o_ice and mapper_Fr2o +#ifdef HAVE_MOAB +! now take care of the mapper for MOAB mapper_Rr2o_ice + mapper_Rr2o_ice%src_mbid = mbrxid + mapper_Rr2o_ice%tgt_mbid = mbrxoid + mapper_Rr2o_ice%intx_mbid = mbrmapro + mapper_Rr2o_ice%src_context = rof(1)%cplcompid + mapper_Rr2o_ice%intx_context = rmapid + wgtIdef = 'scalar'//C_NULL_CHAR + mapper_Rr2o_ice%weight_identifier = wgtIdef + mapper_Rr2o_ice%mbname = 'mapper_Rr2o_ice' +#endif if (flood_present) then if (iamroot_CPLID) then write(logunit,*) ' ' @@ -590,6 +684,17 @@ subroutine prep_ocn_init(infodata, atm_c2_ocn, atm_c2_ice, ice_c2_ocn, rof_c2_oc call seq_map_init_rcfile( mapper_Fr2o, rof(1), ocn(1), & 'seq_maps.rc', 'rof2ocn_fmapname:', 'rof2ocn_fmaptype:',samegrid_ro, & string='mapper_Fr2o initialization', esmf_map=esmf_map_flag) +#ifdef HAVE_MOAB +! now take care of the mapper for MOAB mapper_Fr2o + mapper_Fr2o%src_mbid = mbrxid + mapper_Fr2o%tgt_mbid = mbrxoid + mapper_Fr2o%intx_mbid = mbrmapro + mapper_Fr2o%src_context = rof(1)%cplcompid + mapper_Fr2o%intx_context = rmapid + wgtIdef = 'scalar'//C_NULL_CHAR + mapper_Fr2o%weight_identifier = wgtIdef + mapper_Fr2o%mbname = 'mapper_Fr2o' +#endif endif endif call shr_sys_flush(logunit) From 8dd28fca9674610a84a9b6ddd5891d2d9a2a1009 Mon Sep 17 00:00:00 2001 From: Robert Jacob Date: Tue, 10 Jan 2023 21:35:42 -0600 Subject: [PATCH 269/467] Fix seq_frac_set for MOAB Fix seq_frac_set for MOAB. Old code was taking result of seq_map_map and placing it in fractions_o. New code modifies 2 fracstions in fractions_i and set's those in the ice mesh. seq_map_map i2o does the rest. --- driver-moab/main/seq_frac_mct.F90 | 65 +++++++++++++++++-------------- 1 file changed, 35 insertions(+), 30 deletions(-) diff --git a/driver-moab/main/seq_frac_mct.F90 b/driver-moab/main/seq_frac_mct.F90 index 4314cf3e8b1e..09ec634326c6 100644 --- a/driver-moab/main/seq_frac_mct.F90 +++ b/driver-moab/main/seq_frac_mct.F90 @@ -875,43 +875,48 @@ subroutine seq_frac_set(infodata, ice, ocn, fractions_a, fractions_i, fractions_ call seq_frac_check(fractions_i,'ice set') + ! update ice fractions on moab instance + if (first_time) then ! allocate some local arrays + lSize = mct_aVect_lSize(dom_i%data) + allocate(tagValues(lSize) ) + allocate(GlobalIds(lSize) ) + kgg = mct_aVect_indexIA(dom_o%data ,"GlobGridNum" ,perrWith=subName) + GlobalIds = dom_i%data%iAttr(kgg,:) + ent_type = 1 ! cells for mpas sea ice + endif + + ! something like this: + if (mbixid > 0 ) then + + tagname = 'ifrac'//C_NULL_CHAR + ! fraclist_i = 'afrac:ifrac:ofrac' + ! + tagValues = fractions_i%rAttr(ki,:) + ierr = iMOAB_SetDoubleTagStorageWithGid ( mbixid, tagname, lSize , ent_type, tagValues, GlobalIds ) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in setting ifrac on ice moab instance ' + call shr_sys_abort(subname//' ERROR in setting ifrac on ice moab instance ') + endif + + tagname = 'ofrac'//C_NULL_CHAR + tagValues = fractions_i%rAttr(ko,:) + ierr = iMOAB_SetDoubleTagStorageWithGid ( mbixid, tagname, lSize , ent_type, tagValues, GlobalIds ) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in setting ofrac on ice moab instance ' + call shr_sys_abort(subname//' ERROR in setting ofrac on ice moab instance ') + endif + + first_time = .false. + endif + if (ocn_present) then mapper_i2o => prep_ocn_get_mapper_SFi2o() call seq_map_map(mapper_i2o, fractions_i, fractions_o, & fldlist='ofrac:ifrac',norm=.false.) call seq_frac_check(fractions_o, 'ocn set') - ! update ocean fractions on moab instance - if (first_time) then ! allocate some local arrays - lSize = mct_aVect_lSize(dom_o%data) - allocate(tagValues(lSize) ) - allocate(GlobalIds(lSize) ) - kgg = mct_aVect_indexIA(dom_o%data ,"GlobGridNum" ,perrWith=subName) - GlobalIds = dom_o%data%iAttr(kgg,:) - ent_type = 1 ! cells for mpas ocean - endif - ! something like this: - - tagname = 'ofrac'//C_NULL_CHAR - ! fraclist_o = 'afrac:ifrac:ofrac:ifrad:ofrad' - tagValues = fractions_o%rAttr(3,:) - ierr = iMOAB_SetDoubleTagStorageWithGid ( mboxid, tagname, lSize , ent_type, tagValues, GlobalIds ) - if (ierr .ne. 0) then - write(logunit,*) subname,' error in setting ofrac on ocn moab instance ' - call shr_sys_abort(subname//' ERROR in setting ofrac on ocn moab instance ') - endif - tagname = 'ifrac'//C_NULL_CHAR - ! fraclist_o = 'afrac:ifrac:ofrac:ifrad:ofrad' - tagValues = fractions_o%rAttr(2,:) - ierr = iMOAB_SetDoubleTagStorageWithGid ( mboxid, tagname, lSize , ent_type, tagValues, GlobalIds ) - if (ierr .ne. 0) then - write(logunit,*) subname,' error in setting ofrac on ocn moab instance ' - call shr_sys_abort(subname//' ERROR in setting ofrac on ocn moab instance ') - endif - - first_time = .false. - endif + if (atm_present) then mapper_i2a => prep_atm_get_mapper_Fi2a() call seq_map_map(mapper_i2a, fractions_i, fractions_a, & From 5bc9c162899e4d3800220e5fb3c7aa73c1570546 Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Tue, 10 Jan 2023 22:00:03 -0600 Subject: [PATCH 270/467] local changes need to be merged back --- driver-moab/main/prep_ocn_mod.F90 | 6 +++--- driver-moab/main/seq_map_mod.F90 | 11 ----------- 2 files changed, 3 insertions(+), 14 deletions(-) diff --git a/driver-moab/main/prep_ocn_mod.F90 b/driver-moab/main/prep_ocn_mod.F90 index 3c39e70d29d5..66206646644d 100644 --- a/driver-moab/main/prep_ocn_mod.F90 +++ b/driver-moab/main/prep_ocn_mod.F90 @@ -647,7 +647,7 @@ subroutine prep_ocn_init(infodata, atm_c2_ocn, atm_c2_ice, ice_c2_ocn, rof_c2_oc endif #endif ! now take care of the mapper for MOAB mapper_Rr2o_liq - mapper_Rr2o_liq%src_mbid = mbrxid + !mapper_Rr2o_liq%src_mbid = mbrxid mapper_Rr2o_liq%tgt_mbid = mbrxoid mapper_Rr2o_liq%intx_mbid = mbrmapro mapper_Rr2o_liq%src_context = rof(1)%cplcompid @@ -667,7 +667,7 @@ subroutine prep_ocn_init(infodata, atm_c2_ocn, atm_c2_ice, ice_c2_ocn, rof_c2_oc ! us the same one for mapper_Rr2o_ice and mapper_Fr2o #ifdef HAVE_MOAB ! now take care of the mapper for MOAB mapper_Rr2o_ice - mapper_Rr2o_ice%src_mbid = mbrxid + !mapper_Rr2o_ice%src_mbid = mbrxid mapper_Rr2o_ice%tgt_mbid = mbrxoid mapper_Rr2o_ice%intx_mbid = mbrmapro mapper_Rr2o_ice%src_context = rof(1)%cplcompid @@ -686,7 +686,7 @@ subroutine prep_ocn_init(infodata, atm_c2_ocn, atm_c2_ice, ice_c2_ocn, rof_c2_oc string='mapper_Fr2o initialization', esmf_map=esmf_map_flag) #ifdef HAVE_MOAB ! now take care of the mapper for MOAB mapper_Fr2o - mapper_Fr2o%src_mbid = mbrxid + !mapper_Fr2o%src_mbid = mbrxid mapper_Fr2o%tgt_mbid = mbrxoid mapper_Fr2o%intx_mbid = mbrmapro mapper_Fr2o%src_context = rof(1)%cplcompid diff --git a/driver-moab/main/seq_map_mod.F90 b/driver-moab/main/seq_map_mod.F90 index c208c55383d5..d2bf3654925a 100644 --- a/driver-moab/main/seq_map_mod.F90 +++ b/driver-moab/main/seq_map_mod.F90 @@ -373,17 +373,6 @@ subroutine seq_map_map( mapper, av_s, av_d, fldlist, norm, avwts_s, avwtsfld_s, endif if ( valid_moab_context ) then - ! if ( mapper % nentities == 0 ) then - ! ! tag_entity_type = 1 ! 0 = vertices, 1 = elements - ! ! find out the number of local elements in moab mesh ocean instance on coupler - ! ierr = iMOAB_GetMeshInfo ( mboxid, nvert, nvise, nbl, nsurf, nvisBC ) - ! if (ierr .ne. 0) then - ! write(logunit,*) subname,' error in getting mesh info ' - ! call shr_sys_abort(subname//' error in getting mesh info ') - ! endif - ! !! check tag_entity_type and then set nentieis accordingly - ! endif - nfields = 1 ! first get data from source tag and store in a temporary ! then set it back to target tag to mimic a copy From 43e6b066d868134244fdac7f0b8703e4f39d0d80 Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Tue, 10 Jan 2023 23:31:36 -0600 Subject: [PATCH 271/467] add Sr2a and Fr2a moab mappers follow the same routine as ocean to atm mappers (compute intx, comm graph for second hop) uses the scrip file --- driver-moab/main/prep_rof_mod.F90 | 376 +++++++++++------------------- driver-moab/shr/seq_comm_mct.F90 | 3 +- 2 files changed, 144 insertions(+), 235 deletions(-) diff --git a/driver-moab/main/prep_rof_mod.F90 b/driver-moab/main/prep_rof_mod.F90 index 2ce5c588863f..204d8b0578bf 100644 --- a/driver-moab/main/prep_rof_mod.F90 +++ b/driver-moab/main/prep_rof_mod.F90 @@ -12,6 +12,11 @@ module prep_rof_mod use seq_comm_mct, only: mbrmapro ! iMOAB id of moab instance of map read from rof2ocn map file use seq_comm_mct, only: mbrxoid ! iMOAB id for rof instance on coupler for ocn use seq_comm_mct, only: mboxid ! iMOAB id for mpas ocean migrated mesh to coupler pes + use seq_comm_mct, only: mbaxid ! iMOAB id for atm migrated mesh to coupler pes (migrate either mhid or mhpgx, depending on atm_pg_active) + use seq_comm_mct, only: mbrxid ! iMOAB id of moab rof read on couple pes + use seq_comm_mct, only: mbintxra ! iMOAB id for intx mesh between river and atmosphere + use seq_comm_mct, only : atm_pg_active ! whether the atm uses FV mesh or not ; made true if fv_nphys > 0 + use dimensions_mod, only : np ! for atmosphere degree use seq_comm_mct, only: seq_comm_getData=>seq_comm_setptrs use seq_infodata_mod, only: seq_infodata_type, seq_infodata_getdata use shr_log_mod , only: errMsg => shr_log_errMsg @@ -55,7 +60,6 @@ module prep_rof_mod public :: prep_rof_get_mapper_Sa2r public :: prep_rof_get_mapper_Fa2r - public :: prep_rof_ocn_moab, prep_rof_migrate_moab !-------------------------------------------------------------------------- ! Private interfaces !-------------------------------------------------------------------------- @@ -100,6 +104,8 @@ module prep_rof_mod subroutine prep_rof_init(infodata, lnd_c2_rof, atm_c2_rof) + use iMOAB, only: iMOAB_ComputeMeshIntersectionOnSphere, iMOAB_RegisterApplication, & + iMOAB_WriteMesh, iMOAB_DefineTagStorage, iMOAB_ComputeCommGraph, iMOAB_ComputeScalarProjectionWeights !--------------------------------------------------------------- ! Description ! Initialize module attribute vectors and all other non-mapping @@ -131,6 +137,20 @@ subroutine prep_rof_init(infodata, lnd_c2_rof, atm_c2_rof) integer :: index_irrig character(*) , parameter :: subname = '(prep_rof_init)' character(*) , parameter :: F00 = "('"//subname//" : ', 4A )" + + ! MOAB stuff + integer :: ierr, idintx, rank + character*32 :: appname, outfile, wopts, lnum + character*32 :: dm1, dm2, dofnameS, dofnameT, wgtIdef + integer :: orderS, orderT, volumetric, noConserve, validate, fInverseDistanceMap + integer :: fNoBubble, monotonicity +! will do comm graph over coupler PES, in 2-hop strategy + integer :: mpigrp_CPLID ! coupler pes group, used for comm graph phys <-> atm-ocn + + integer :: type1, type2 ! type for computing graph; should be the same type for ocean, 3 (FV) + integer :: tagtype, numco, tagindex + character(CXX) :: tagName + !--------------------------------------------------------------- call seq_infodata_getData(infodata , & @@ -244,6 +264,116 @@ subroutine prep_rof_init(infodata, lnd_c2_rof, atm_c2_rof) call seq_map_init_rcfile(mapper_Fa2r, atm(1), rof(1), & 'seq_maps.rc','atm2rof_fmapname:','atm2rof_fmaptype:',samegrid_ar, & string='mapper_Fa2r initialization', esmf_map=esmf_map_flag) +! similar to a2o, prep_ocn +#ifdef HAVE_MOAB + ! Call moab intx only if atm and ocn are init in moab + if ((mbrxid .ge. 0) .and. (mbaxid .ge. 0)) then + appname = "ROF_ATM_COU"//C_NULL_CHAR + ! idintx is a unique number of MOAB app that takes care of intx between rof and atm mesh + idintx = 100*rof(1)%cplcompid + atm(1)%cplcompid ! something different, to differentiate it + ierr = iMOAB_RegisterApplication(trim(appname), mpicom_CPLID, idintx, mbintxra) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in registering rof atm intx' + call shr_sys_abort(subname//' ERROR in registering rof atm intx') + endif + ierr = iMOAB_ComputeMeshIntersectionOnSphere (mbrxid, mbaxid, mbintxra) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in computing rof atm intx' + call shr_sys_abort(subname//' ERROR in computing rof atm intx') + endif + if (iamroot_CPLID) then + write(logunit,*) 'iMOAB intersection between rof atm with id:', idintx + end if + ! we also need to compute the comm graph for the second hop, from the rof on coupler to the + ! atm for the intx rof-atm context (coverage) + ! + call seq_comm_getData(CPLID ,mpigrp=mpigrp_CPLID) + if (atm_pg_active) then + type2 = 3; ! fv for both rof and atm; fv-cgll does not work anyway + else + type2 = 1 ! this does not work anyway in this direction + endif + type1 = 3; + ! ierr = iMOAB_ComputeCommGraph( mboxid, mbintxoa, &mpicom_CPLID, &mpigrp_CPLID, &mpigrp_CPLID, &type1, &type2, + ! &ocn_id, &idintx) + ierr = iMOAB_ComputeCommGraph( mbrxid, mbintxra, mpicom_CPLID, mpigrp_CPLID, mpigrp_CPLID, type1, type2, & + rof(1)%cplcompid, idintx) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in computing comm graph for second hop, rof-atm' + call shr_sys_abort(subname//' ERROR in computing comm graph for second hop, rof-atm') + endif + ! now take care of the mapper + mapper_Fa2r%src_mbid = mbrxid + mapper_Fa2r%tgt_mbid = mbaxid + mapper_Fa2r%intx_mbid = mbintxra + mapper_Fa2r%src_context = rof(1)%cplcompid + mapper_Fa2r%intx_context = idintx + wgtIdef = 'scalar'//C_NULL_CHAR + mapper_Fa2r%weight_identifier = wgtIdef + mapper_Fa2r%mbname = 'mapper_Fa2r' + ! because we will project fields from rof to atm grid, we need to define + ! rof r2x fields to atm grid on coupler side + + tagname = trim(seq_flds_r2x_fields)//C_NULL_CHAR + tagtype = 1 ! dense + numco = 1 ! + ierr = iMOAB_DefineTagStorage(mbaxid, tagname, tagtype, numco, tagindex ) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in defining tags for seq_flds_r2x_fields on atm cpl' + call shr_sys_abort(subname//' ERROR in defining tags for seq_flds_r2x_fields on atm cpl') + endif + volumetric = 0 ! can be 1 only for FV->DGLL or FV->CGLL; + + if (atm_pg_active) then + dm2 = "fv"//C_NULL_CHAR + dofnameT="GLOBAL_ID"//C_NULL_CHAR + orderT = 1 ! fv-fv + else ! this part does not work, anyway + dm2 = "cgll"//C_NULL_CHAR + dofnameT="GLOBAL_DOFS"//C_NULL_CHAR + orderT = np ! it should be 4 + endif + dm1 = "fv"//C_NULL_CHAR + dofnameS="GLOBAL_ID"//C_NULL_CHAR + orderS = 1 ! not much arguing + fNoBubble = 1 + monotonicity = 0 ! + noConserve = 0 + validate = 1 + fInverseDistanceMap = 0 + if (iamroot_CPLID) then + write(logunit,*) subname, 'launch iMOAB weights with args ', 'mbintxra=', mbintxra, ' wgtIdef=', wgtIdef, & + 'dm1=', trim(dm1), ' orderS=', orderS, 'dm2=', trim(dm2), ' orderT=', orderT, & + fNoBubble, monotonicity, volumetric, fInverseDistanceMap, & + noConserve, validate, & + trim(dofnameS), trim(dofnameT) + endif + ierr = iMOAB_ComputeScalarProjectionWeights ( mbintxra, wgtIdef, & + trim(dm1), orderS, trim(dm2), orderT, & + fNoBubble, monotonicity, volumetric, fInverseDistanceMap, & + noConserve, validate, & + trim(dofnameS), trim(dofnameT) ) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in computing ra weights ' + call shr_sys_abort(subname//' ERROR in computing ra weights ') + endif + +#ifdef MOABDEBUG + wopts = C_NULL_CHAR + call shr_mpi_commrank( mpicom_CPLID, rank ) + if (rank .lt. 5) then + write(lnum,"(I0.2)")rank ! + outfile = 'intx_ra_'//trim(lnum)// '.h5m' // C_NULL_CHAR + ierr = iMOAB_WriteMesh(mbintxra, outfile, wopts) ! write local intx file + if (ierr .ne. 0) then + write(logunit,*) subname,' error in writing intx ra file ' + call shr_sys_abort(subname//' ERROR in writing intx ra file ') + endif + endif +#endif + end if ! if ((mbrxid .ge. 0) .and. (mbaxid .ge. 0)) +! endif HAVE_MOAB +#endif if (iamroot_CPLID) then write(logunit,*) ' ' @@ -252,6 +382,17 @@ subroutine prep_rof_init(infodata, lnd_c2_rof, atm_c2_rof) call seq_map_init_rcfile(mapper_Sa2r, atm(1), rof(1), & 'seq_maps.rc','atm2rof_smapname:','atm2rof_smaptype:',samegrid_ar, & string='mapper_Sa2r initialization', esmf_map=esmf_map_flag) +#ifdef HAVE_MOAB + ! now take care of the mapper, use the same one as before + mapper_Sa2r%src_mbid = mbrxid + mapper_Sa2r%tgt_mbid = mbaxid + mapper_Sa2r%intx_mbid = mbintxra + mapper_Sa2r%src_context = rof(1)%cplcompid + mapper_Sa2r%intx_context = idintx + wgtIdef = 'scalar'//C_NULL_CHAR + mapper_Sa2r%weight_identifier = wgtIdef + mapper_Sa2r%mbname = 'mapper_Sa2r' +#endif endif call shr_sys_flush(logunit) @@ -260,239 +401,6 @@ subroutine prep_rof_init(infodata, lnd_c2_rof, atm_c2_rof) end subroutine prep_rof_init - subroutine prep_rof_ocn_moab(infodata) -!--------------------------------------------------------------- - ! Description - ! After loading of rof 2 ocn map, migrate the rof mesh to coupler - ! and create the comm graph between rof comp and rof instance on coupler - ! this is a similar call compared to prep_atm_ocn_moab, that - ! computes the comm graph after intersection - ! - ! Arguments - - use iMOAB, only: iMOAB_MigrateMapMesh, iMOAB_WriteLocalMesh, iMOAB_DefineTagStorage - type(seq_infodata_type) , intent(in) :: infodata - character(*), parameter :: subname = '(prep_rof_ocn_moab)' - integer :: ierr - - logical :: rof_present ! .true. => rof is present - logical :: ocn_present ! .true. => ocn is present - logical :: ocn_prognostic ! if true, component is prognostic - - integer :: id_join - integer :: rank_on_cpl ! just for debugging - integer :: mpicom_join - integer :: context_id ! used to define context for coverage (this case, runoff on coupler) - integer :: rof_id - - integer :: mpigrp_CPLID ! coupler pes group, used for comm graph phys <-> rof-ocn, to migrate map mesh - integer :: mpigrp_rof ! component group pes (rof ) == rof group - integer :: typeA ! type for computing graph, in this case it is 2 (point cloud) - integer :: direction ! will be 1, source to coupler - character*32 :: prefix_output ! for writing a coverage file for debugging - character*100 :: tagname ! define some tags for receiving later - integer :: tagtype, numco, tagindex ! for tag definition - logical :: iamroot_CPLID ! .true. => CPLID masterproc - - call seq_infodata_getData(infodata, & - rof_present=rof_present, & - ocn_present=ocn_present, & - ocn_prognostic=ocn_prognostic) - - ! it involves initial rof app; mhid; also migrate rof mesh on coupler pes, in ocean context, mbrxoid - ! map between rof 2 ocn is in mbrmapro ; - ! after this, the sending of tags from rof pes to coupler pes will use the new par comm graph, that has more precise info about - ! how to get mpicomm for joint rof + coupler - call seq_comm_getData(CPLID, mpicom=mpicom_CPLID, iamroot=iamroot_CPLID) - id_join = rof(1)%cplcompid ! migrate rof mesh towards ocean on coupler ! - rof_id = rof(1)%compid - - context_id = rof(1)%cplcompid ! maybe it should be clear it is for ocean ? - call seq_comm_getData(ID_join,mpicom=mpicom_join) ! this is joint comm - - call seq_comm_getData(CPLID ,mpigrp=mpigrp_CPLID) ! second group, the coupler group CPLID is global variable - call seq_comm_getData(rof_id, mpigrp=mpigrp_rof) ! component group pes, from rof id ( also ROFID(1) ) - typeA = 2 ! point cloud - direction = 1 ! - context_id = ocn(1)%cplcompid - ierr = iMOAB_MigrateMapMesh (mrofid, mbrmapro, mbrxoid, mpicom_join, mpigrp_rof, & - mpigrp_CPLID, typeA, rof_id, context_id, direction) - - if (ierr .ne. 0) then - write(logunit,*) subname,' error in migrating rof mesh for map rof c2 ocn ' - call shr_sys_abort(subname//' ERROR in migrating rof mesh for map rof c2 ocn ') - endif - if (iamroot_CPLID) then - write(logunit,*) subname,' migrated mesh for map rof 2 ocn ' - endif - if (mbrxoid .ge. 0) then ! we are on coupler side pes - tagname=trim(seq_flds_r2x_fields)//C_NULL_CHAR - tagtype = 1 ! dense, double - numco= 1 ! 1 scalar per node - ierr = iMOAB_DefineTagStorage(mbrxoid, tagname, tagtype, numco, tagindex ) - if (ierr .ne. 0) then - write(logunit,*) subname,' error in defining ' // trim(seq_flds_r2x_fields) // ' tags on coupler side in MOAB' - call shr_sys_abort(subname//' ERROR in defining MOAB tags ') - endif - endif - - if (mboxid .ge. 0) then ! we are on coupler side pes, for ocean mesh - tagname=trim(seq_flds_r2x_fields)//C_NULL_CHAR - tagtype = 1 ! dense, double - numco= 1 ! 1 scalar per node - ierr = iMOAB_DefineTagStorage(mboxid, tagname, tagtype, numco, tagindex ) - if (ierr .ne. 0) then - write(logunit,*) subname,' error in defining ' // trim(seq_flds_r2x_fields) // ' tags on coupler side in MOAB, for ocean app' - call shr_sys_abort(subname//' ERROR in defining MOAB tags ') - endif - endif - - - if (iamroot_CPLID) then - write(logunit,*) subname,' created moab tags for seq_flds_r2x_fields ' - endif -#ifdef MOABDEBUG - call seq_comm_getData(CPLID ,mpicom=mpicom_CPLID) - if (mbrxoid.ge.0) then ! we are on coupler PEs - call mpi_comm_rank(mpicom_CPLID, rank_on_cpl , ierr) - prefix_output = "rof_cov"//CHAR(0) - if (rank_on_cpl .lt. 16) then - ierr = iMOAB_WriteLocalMesh(mbrxoid, prefix_output) - if (ierr .ne. 0) then - write(logunit,*) subname,' error in writing coverage mesh rof 2 ocn ' - endif - endif - endif -#endif - - end subroutine prep_rof_ocn_moab - - !================================================================================================ - subroutine prep_rof_migrate_moab(infodata) - ! - use iMOAB, only: iMOAB_SendElementTag, iMOAB_ReceiveElementTag, iMOAB_FreeSenderBuffers, & - iMOAB_ApplyScalarProjectionWeights, iMOAB_WriteMesh - !--------------------------------------------------------------- - ! Description similar to prep_atm_migrate_moab; will also do the projection on coupler pes - ! After seq_flds_r2x_fields tags were loaded on rof mesh, - ! they need to be migrated to the coupler pes, for weight application ; later, we will send it to ocean pes - ! - ! Arguments - type(seq_infodata_type) , intent(in) :: infodata - - character(*), parameter :: subname = '(prep_rof_migrate_moab)' - - integer :: ierr - - logical :: rof_present ! .true. => rof is present - logical :: ocn_present ! .true. => ocn is present - logical :: ocn_prognostic ! - - integer :: id_join - integer :: mpicom_join - integer :: rof_id - integer :: context_id ! we will use ocean context on coupler - integer, save :: num_prof = 0 ! use to count the projections - character*32 :: dm1, dm2, wgtIdef - character*50 :: outfile, wopts, lnum - character*400 :: tagname ! for seq_flds_r2x_fields - integer :: orderROF, orderOCN, volumetric, noConserve, validate - integer, save :: num_proj = 0 ! for counting projections - - - call seq_infodata_getData(infodata, & - rof_present=rof_present, & - ocn_present=ocn_present, & - ocn_prognostic=ocn_prognostic) - - ! it involves initial rof app; mesh on coupler pes, - ! use seq_comm_mct, only: mrofid ! id for rof comp - ! mbrmapro ! iMOAB id of moab instance of map read from rof2ocn map file - ! mbrxoid ! iMOAB id for rof instance on coupler for ocn ; it exists as a coverage mesh, it receives data from ocean - - ! after this, the sending of tags from rof pes to coupler pes will use the par comm graph, that has more precise info about - ! how to get mpicomm for joint rof + coupler - id_join = rof(1)%cplcompid - rof_id = rof(1)%compid - - call seq_comm_getData(ID_join,mpicom=mpicom_join) ! this is the joint comm between rof and coupler - - ! should id_join be multiplied by 100 ? because it is not corresponding to the regular mbrxid , it is mbroxid - ! no need, because id_join is used now only to get the communicator - ! TODO understand better this - ! we should do this only if ocn_present - context_id = ocn(1)%cplcompid - wgtIdef = 'map-from-file'//C_NULL_CHAR - tagName = trim(seq_flds_r2x_fields)//C_NULL_CHAR - num_proj = num_proj + 1 - - if (rof_present .and. ocn_present .and. ocn_prognostic) then - - if (mrofid .ge. 0) then ! send because we are on rof pes - - ! basically, adjust the migration of the tag we want to project; it was sent initially with - ! trivial partitioning, now we need to adjust it for "coverage" mesh - ! as always, use nonblocking sends - - context_id = ocn(1)%cplcompid !send to rof/ocn on coupler ! - ierr = iMOAB_SendElementTag(mrofid, tagName, mpicom_join, context_id) - if (ierr .ne. 0) then - write(logunit,*) subname,' error in sending tag from rof to rof cover for ocn on coupler ' - call shr_sys_abort(subname//' ERROR in sending tag from rof to rof cover for ocn on coupler') - endif - - endif - - if (mbrxoid .ge. 0 ) then ! we are for sure on coupler pes! - ! - ierr = iMOAB_ReceiveElementTag(mbrxoid, tagName, mpicom_join, rof_id) - if (ierr .ne. 0) then - write(logunit,*) subname,' error in receiving tag from rof to rof cover for ocn on coupler ' - call shr_sys_abort(subname//' ERROR in receiving tag from rof to rof cover for ocn on coupler ') - endif - - endif - ! we can now free the sender buffers - if (mrofid .ge. 0) then - ierr = iMOAB_FreeSenderBuffers(mrofid, context_id) - if (ierr .ne. 0) then - write(logunit,*) subname,' error in freeing buffers' - call shr_sys_abort(subname//' ERROR in freeing buffers') - endif - endif - - - ! we could do the projection now, on the ocean mesh, because we are on the coupler pes; - ! the actual migrate could happen later , from coupler pes to the ocean pes - ! we should do this for consistency in the file prep_ocn_mode.F90, because this is part of ocean preparation - if (mbrmapro .ge. 0 ) then ! we are on coupler pes, for sure - ! we could apply weights; need to use the same weight identifier wgtIdef as when we generated it - ! hard coded now, it should be a runtime option in the future - - ierr = iMOAB_ApplyScalarProjectionWeights ( mbrmapro, wgtIdef, tagName, tagName) - if (ierr .ne. 0) then - write(logunit,*) subname,' error in applying weights ' - call shr_sys_abort(subname//' ERROR in applying weights') - endif -#ifdef MOABDEBUG - ! we can also write the ocean mesh to file, just to see the projectd tag - ! write out the mesh file to disk - write(lnum,"(I0.2)")num_proj - outfile = 'ocnProj_fromRof'//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 - write(logunit,*) subname,' error in writing ocn mesh after projection ' - call shr_sys_abort(subname//' ERROR in writing ocn mesh after projection') - endif -#endif - - !CHECKRC(ierr, "cannot receive tag values") - endif - - endif ! if rof and ocn - ! end copy - end subroutine prep_rof_migrate_moab !================================================================================================ subroutine prep_rof_accum_lnd(timer) diff --git a/driver-moab/shr/seq_comm_mct.F90 b/driver-moab/shr/seq_comm_mct.F90 index f293ecac6cc1..68cdcc4a0211 100644 --- a/driver-moab/shr/seq_comm_mct.F90 +++ b/driver-moab/shr/seq_comm_mct.F90 @@ -232,10 +232,11 @@ module seq_comm_mct integer, public :: mbixid ! iMOAB id for sea-ice migrated to coupler pes integer, public :: mbintxia ! iMOAB id for intx mesh between ice and atmosphere integer, public :: mrofid ! iMOAB id of moab rof app - integer, public :: mbrxid ! iMOAB id of moab rof migrated to coupler pes + integer, public :: mbrxid ! iMOAB id of moab rof read from file on coupler pes 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) + integer, public :: mbintxra ! iMOAB id for intx mesh between river and atmosphere integer, public :: num_moab_exports ! iMOAB id for atm phys grid, on atm pes From c590510122c2aa4e150f6037967390951d556a51 Mon Sep 17 00:00:00 2001 From: Robert Jacob Date: Tue, 10 Jan 2023 23:54:47 -0600 Subject: [PATCH 272/467] Update albedos in MOAB Make sure newly calculated albedos are added to MOAB flux mesh --- driver-moab/main/seq_flux_mct.F90 | 80 +++++++++++++++++++++++++------ 1 file changed, 66 insertions(+), 14 deletions(-) diff --git a/driver-moab/main/seq_flux_mct.F90 b/driver-moab/main/seq_flux_mct.F90 index bffe8a5e27b1..35dea8fda4f6 100644 --- a/driver-moab/main/seq_flux_mct.F90 +++ b/driver-moab/main/seq_flux_mct.F90 @@ -7,6 +7,7 @@ module seq_flux_mct use shr_mct_mod, only: shr_mct_queryConfigFile, shr_mct_sMatReaddnc use seq_comm_mct, only : mboxid ! iMOAB app id for ocn on cpl pes + use seq_comm_mct, only : mbofxid ! iMOAB app id for ocn on cpl pes use seq_comm_mct, only : mbaxid ! iMOAB app id for atm phys grid on cpl pes use prep_aoflux_mod, only: prep_aoflux_get_xao_omct, prep_aoflux_get_xao_amct @@ -128,6 +129,8 @@ module seq_flux_mct ! moab real(r8), allocatable :: tagValues(:) ! used for copying tag values from frac to frad + real(r8), allocatable :: tagValues2(:) ! used for copying tag values for albedos + integer , allocatable :: GlobalIds(:) ! used for setting values associated with ids ! Coupler field indices @@ -794,9 +797,10 @@ subroutine seq_flux_ocnalb_mct( infodata, ocn, a2x_o, fractions_o, xao_o ) integer(in) :: klat,klon ! field indices logical :: update_alb ! was albedo updated + integer nvert(3), nvise(3), nbl(3), nsurf(3), nvisBC(3) ! for moab info character(CXX) ::tagname - integer :: ent_type, ierr + integer :: ent_type, ierr, kgg, lSize integer , save :: arrSize ! local size for moab tag arrays (number of cells locally) logical,save :: first_call = .true. @@ -849,8 +853,17 @@ subroutine seq_flux_ocnalb_mct( infodata, ocn, a2x_o, fractions_o, xao_o ) allocate(tagValues(arrSize) ) endif + if (mbofxid .ge. 0) then + lSize = mct_aVect_lSize(xao_o) + allocate(tagValues2(lSize) ) + allocate(GlobalIds(lSize) ) + kgg = mct_aVect_indexIA(dom_o%data ,"GlobGridNum" ,perrWith=subName) + GlobalIds = dom_o%data%iAttr(kgg,:) + endif + first_call = .false. endif + ent_type = 1 ! cells for mpas ocean if (flux_albav) then @@ -936,28 +949,67 @@ subroutine seq_flux_ocnalb_mct( infodata, ocn, a2x_o, fractions_o, xao_o ) update_alb = .true. endif ! nextsw_cday end if ! flux_albav - !--- update current ifrad/ofrad values if albedo was updated +! update MOAB versions + if (mbofxid > 0 ) then + tagname = 'So_avsdr'//C_NULL_CHAR + tagValues2 = xao_o%rAttr(index_xao_So_avsdr,:) + ierr = iMOAB_SetDoubleTagStorageWithGid ( mbofxid, tagname, lSize , ent_type, tagValues2, GlobalIds ) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in setting avsdr on ocnf moab instance ' + call shr_sys_abort(subname//' ERROR in setting avsdr on ocnf moab instance ') + endif + + tagname = 'So_anidr'//C_NULL_CHAR + tagValues2 = xao_o%rAttr(index_xao_So_anidr,:) + ierr = iMOAB_SetDoubleTagStorageWithGid ( mbofxid, tagname, lSize , ent_type, tagValues2, GlobalIds ) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in setting anidr on ocnf moab instance ' + call shr_sys_abort(subname//' ERROR in setting anidr on ocnf moab instance ') + endif + + tagname = 'So_avsdf'//C_NULL_CHAR + tagValues2 = xao_o%rAttr(index_xao_So_avsdf,:) + ierr = iMOAB_SetDoubleTagStorageWithGid ( mbofxid, tagname, lSize , ent_type, tagValues2, GlobalIds ) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in setting avsdf on ocnf moab instance ' + call shr_sys_abort(subname//' ERROR in setting avsdf on ocnf moab instance ') + endif + + tagname = 'So_anidf'//C_NULL_CHAR + tagValues2 = xao_o%rAttr(index_xao_So_anidf,:) + ierr = iMOAB_SetDoubleTagStorageWithGid ( mbofxid, tagname, lSize , ent_type, tagValues2, GlobalIds ) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in setting anidf on ocnf moab instance ' + call shr_sys_abort(subname//' ERROR in setting anidf on ocnf moab instance ') + endif + endif + + !--- update current ifrad/ofrad values if albedo was updated if (update_alb) then kx = mct_aVect_indexRA(fractions_o,"ifrac") kr = mct_aVect_indexRA(fractions_o,"ifrad") fractions_o%rAttr(kr,:) = fractions_o%rAttr(kx,:) + kx = mct_aVect_indexRA(fractions_o,"ofrac") kr = mct_aVect_indexRA(fractions_o,"ofrad") fractions_o%rAttr(kr,:) = fractions_o%rAttr(kx,:) + ! copy here fractions ifrad and ofrad to moab tags - tagname = 'ifrac:ofrac'//C_NULL_CHAR - ent_type = 1 ! cells for ocean mesh - ierr = iMOAB_GetDoubleTagStorage( mboxid, tagname, arrSize, ent_type, tagValues) - if (ierr .ne. 0) then - write(logunit,*) subname,' error in getting ifrac, ofrac ' - call shr_sys_abort(subname//' ERROR in getting ifrac, ofrac') - endif - tagname = 'ifrad:ofrad'//C_NULL_CHAR - ierr = iMOAB_SetDoubleTagStorage( mboxid, tagname, arrSize, ent_type, tagValues) - if (ierr .ne. 0) then - write(logunit,*) subname,' error in setting ifrad, ofrad ' - call shr_sys_abort(subname//' ERROR in setting ifrad, ofrad ') + if (mboxid > 0 ) then + tagname = 'ifrac:ofrac'//C_NULL_CHAR + ent_type = 1 ! cells for ocean mesh + ierr = iMOAB_GetDoubleTagStorage( mboxid, tagname, arrSize, ent_type, tagValues) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in getting ifrac, ofrac ' + call shr_sys_abort(subname//' ERROR in getting ifrac, ofrac') + endif + tagname = 'ifrad:ofrad'//C_NULL_CHAR + ierr = iMOAB_SetDoubleTagStorage( mboxid, tagname, arrSize, ent_type, tagValues) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in setting ifrad, ofrad ' + call shr_sys_abort(subname//' ERROR in setting ifrad, ofrad ') + endif endif endif From 34ee4b435ac800d6c30cb16cc3a1da5912bd99e1 Mon Sep 17 00:00:00 2001 From: Robert Jacob Date: Tue, 10 Jan 2023 23:55:51 -0600 Subject: [PATCH 273/467] Change when FlxAlb2 file is written Change when MOABDEBUG FlxAlb2*.h5m file is written. It should be when flux_alb is true because that version is called second. --- driver-moab/main/prep_aoflux_mod.F90 | 11 +++++++++-- 1 file changed, 9 insertions(+), 2 deletions(-) diff --git a/driver-moab/main/prep_aoflux_mod.F90 b/driver-moab/main/prep_aoflux_mod.F90 index b10d19115cb6..1b08f5130344 100644 --- a/driver-moab/main/prep_aoflux_mod.F90 +++ b/driver-moab/main/prep_aoflux_mod.F90 @@ -298,24 +298,31 @@ subroutine prep_aoflux_calc_xao_ax(fractions_ox, flds, timer) fldlist=seq_flds_xao_fluxes, norm=.true., & avwts_s=fractions_ox(efi),avwtsfld_s='ofrac') enddo + end if #ifdef MOABDEBUG - ! projections on atm +! albedos is called second so wait until then to write + if (trim(flds) == 'albedos') then wopts = ';PARALLEL=WRITE_PART'//C_NULL_CHAR ! write(lnum,"(I0.2)")num_moab_exports + if(mbaxid > 0 ) then + ! projections on atm outfile = 'FlxAlb2Atm'//trim(lnum)//'.h5m'//C_NULL_CHAR ierr = iMOAB_WriteMesh(mbaxid, trim(outfile), trim(wopts)) if (ierr .ne. 0) then write(logunit,*) subname,' error in writing ocean to atm projection' call shr_sys_abort(subname//' ERROR in writing ocean to atm projection') endif + endif + if(mbofxid > 0) then outfile = 'FlxAlb2Ocn'//trim(lnum)//'.h5m'//C_NULL_CHAR ierr = iMOAB_WriteMesh(mbofxid, trim(outfile), trim(wopts)) if (ierr .ne. 0) then write(logunit,*) subname,' error in writing ocean to atm projection' call shr_sys_abort(subname//' ERROR in writing ocean to atm projection') endif -#endif + endif end if +#endif call t_drvstopf (trim(timer)) end subroutine prep_aoflux_calc_xao_ax From 42ae27cd2f639a20fd0e124e4471108ff31cf3c2 Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Wed, 11 Jan 2023 09:33:12 -0600 Subject: [PATCH 274/467] zero out x2z_am before merge it was using uninitialized values --- driver-moab/main/prep_atm_mod.F90 | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) diff --git a/driver-moab/main/prep_atm_mod.F90 b/driver-moab/main/prep_atm_mod.F90 index 17c9f84a43a4..f05aed3a8828 100644 --- a/driver-moab/main/prep_atm_mod.F90 +++ b/driver-moab/main/prep_atm_mod.F90 @@ -1261,12 +1261,14 @@ subroutine prep_atm_mrg_moab(infodata, xao_ax) !call mct_avect_zero(x2a_a) ? - !x2a_am = 0 + x2a_am = 0._r8 ent_type = 1 ! cells tagname = trim(seq_flds_x2a_fields)//C_NULL_CHAR arrsize = naflds * lsize - ierr = iMOAB_GetDoubleTagStorage ( mbaxid, tagname, arrsize , ent_type, x2a_am(1,1)) - + ! ierr = iMOAB_SetDoubleTagStorage ( mbaxid, tagname, arrsize , ent_type, x2a_am(1,1)) + ! if (ierr .ne. 0) then + ! call shr_sys_abort(subname//' error in setting moab tags with 0 ') + ! endif ! Update surface fractions ! fraclist_a = 'afrac:ifrac:ofrac:lfrac:lfrin' kif = 2 ! kif=mct_aVect_indexRA(fractions_a,"ifrac") From 85633eeff5886fac007893614c5ad6c9b939756f Mon Sep 17 00:00:00 2001 From: Jason Sarich Date: Wed, 11 Jan 2023 12:21:40 -0600 Subject: [PATCH 275/467] fix bad relics from merge --- driver-moab/main/prep_atm_mod.F90 | 40 +++++++------------------------ 1 file changed, 9 insertions(+), 31 deletions(-) diff --git a/driver-moab/main/prep_atm_mod.F90 b/driver-moab/main/prep_atm_mod.F90 index 286c98d9b865..a31a36278e28 100644 --- a/driver-moab/main/prep_atm_mod.F90 +++ b/driver-moab/main/prep_atm_mod.F90 @@ -1433,8 +1433,8 @@ subroutine prep_atm_merge( l2x_a, o2x_a, xao_a, i2x_a, fractions_a, x2a_a ) type(mct_aVect), intent(inout) :: x2a_a ! ! Local workspace - real(r8) :: fracl, fraci, fraco, fracl_st - integer :: n,ka,ki,kl,ko,kx,kof,kif,klf,klf_st,i,i1,o1 + real(r8) :: fracl, fraci, fraco + integer :: n,ka,ki,kl,ko,kx,kof,kif,klf,i,i1,o1 integer :: lsize integer :: index_x2a_Sf_lfrac integer :: index_x2a_Sf_ifrac @@ -1451,13 +1451,12 @@ subroutine prep_atm_merge( l2x_a, o2x_a, xao_a, i2x_a, fractions_a, x2a_a ) character(CL),allocatable :: itemc_ocn(:) ! string converted to char logical :: iamroot character(CL),allocatable :: mrgstr(:) ! temporary string - character(CL) :: fracstr, fracstr_st logical, save :: first_time = .true. type(mct_aVect_sharedindices),save :: l2x_sharedindices type(mct_aVect_sharedindices),save :: o2x_sharedindices type(mct_aVect_sharedindices),save :: i2x_sharedindices type(mct_aVect_sharedindices),save :: xao_sharedindices - logical, pointer, save :: lmerge(:),imerge(:),xmerge(:),omerge(:),lstate(:) + logical, pointer, save :: lmerge(:),imerge(:),xmerge(:),omerge(:) integer, pointer, save :: lindx(:), iindx(:), oindx(:),xindx(:) integer, save :: naflds, nlflds,niflds,noflds,nxflds character(*), parameter :: subname = '(prep_atm_merge) ' @@ -1477,7 +1476,6 @@ subroutine prep_atm_merge( l2x_a, o2x_a, xao_a, i2x_a, fractions_a, x2a_a ) allocate(iindx(naflds), imerge(naflds)) allocate(xindx(naflds), xmerge(naflds)) allocate(oindx(naflds), omerge(naflds)) - allocate(lindx(naflds), lstate(naflds)) allocate(field_atm(naflds), itemc_atm(naflds)) allocate(field_lnd(nlflds), itemc_lnd(nlflds)) allocate(field_ice(niflds), itemc_ice(niflds)) @@ -1493,7 +1491,6 @@ subroutine prep_atm_merge( l2x_a, o2x_a, xao_a, i2x_a, fractions_a, x2a_a ) imerge(:) = .true. xmerge(:) = .true. omerge(:) = .true. - lstate(:) = .false. do ka = 1,naflds field_atm(ka) = mct_aVect_getRList2c(ka, x2a_a) @@ -1636,23 +1633,13 @@ subroutine prep_atm_merge( l2x_a, o2x_a, xao_a, i2x_a, fractions_a, x2a_a ) ! Update surface fractions kif=mct_aVect_indexRA(fractions_a,"ifrac") + klf=mct_aVect_indexRA(fractions_a,"lfrac") kof=mct_aVect_indexRA(fractions_a,"ofrac") - klf_st = mct_aVect_indexRA(fractions_a,"lfrac") - fracstr_st = 'lfrac' - if (samegrid_al) then - klf = mct_aVect_indexRA(fractions_a,"lfrac") - fracstr = 'lfrac' - else - klf = mct_aVect_indexRA(fractions_a,"lfrin") - fracstr = 'lfrin' - endif - lsize = mct_avect_lsize(x2a_a) index_x2a_Sf_lfrac = mct_aVect_indexRA(x2a_a,'Sf_lfrac') index_x2a_Sf_ifrac = mct_aVect_indexRA(x2a_a,'Sf_ifrac') index_x2a_Sf_ofrac = mct_aVect_indexRA(x2a_a,'Sf_ofrac') - do n = 1,lsize x2a_a%rAttr(index_x2a_Sf_lfrac,n) = fractions_a%Rattr(klf,n) x2a_a%rAttr(index_x2a_Sf_ifrac,n) = fractions_a%Rattr(kif,n) @@ -1661,7 +1648,7 @@ subroutine prep_atm_merge( l2x_a, o2x_a, xao_a, i2x_a, fractions_a, x2a_a ) !--- document fraction operations --- if (first_time) then - mrgstr(index_x2a_sf_lfrac) = trim(mrgstr(index_x2a_sf_lfrac))//' = fractions_a%'//trim(fracstr) + mrgstr(index_x2a_sf_lfrac) = trim(mrgstr(index_x2a_sf_lfrac))//' = fractions_a%lfrac' mrgstr(index_x2a_sf_ifrac) = trim(mrgstr(index_x2a_sf_ifrac))//' = fractions_a%ifrac' mrgstr(index_x2a_sf_ofrac) = trim(mrgstr(index_x2a_sf_ofrac))//' = fractions_a%ofrac' endif @@ -1713,12 +1700,8 @@ subroutine prep_atm_merge( l2x_a, o2x_a, xao_a, i2x_a, fractions_a, x2a_a ) !--- document merge --- if (first_time) then if (lindx(ka) > 0) then - if (lstate(ka)) then - if (lmerge(ka)) then - mrgstr(ka) = trim(mrgstr(ka))//' + '//trim(fracstr_st)//'*l2x%'//trim(field_lnd(lindx(ka))) - else - mrgstr(ka) = trim(mrgstr(ka))//' = '//trim(fracstr_st)//'*l2x%'//trim(field_lnd(lindx(ka))) - end if + if (lmerge(ka)) then + mrgstr(ka) = trim(mrgstr(ka))//' + lfrac*l2x%'//trim(field_lnd(lindx(ka))) else mrgstr(ka) = trim(mrgstr(ka))//' = lfrac*l2x%'//trim(field_lnd(lindx(ka))) endif @@ -1749,16 +1732,11 @@ subroutine prep_atm_merge( l2x_a, o2x_a, xao_a, i2x_a, fractions_a, x2a_a ) do n = 1,lsize fracl = fractions_a%Rattr(klf,n) - fracl_st = fractions_a%Rattr(klf_st,n) fraci = fractions_a%Rattr(kif,n) fraco = fractions_a%Rattr(kof,n) if (lindx(ka) > 0 .and. fracl > 0._r8) then - if (lstate(ka)) then - if (lmerge(ka)) then - x2a_a%rAttr(ka,n) = x2a_a%rAttr(ka,n) + l2x_a%rAttr(lindx(ka),n) * fracl_st - else - x2a_a%rAttr(ka,n) = l2x_a%rAttr(lindx(ka),n) * fracl_st - end if + if (lmerge(ka)) then + x2a_a%rAttr(ka,n) = x2a_a%rAttr(ka,n) + l2x_a%rAttr(lindx(ka),n) * fracl else x2a_a%rAttr(ka,n) = l2x_a%rAttr(lindx(ka),n) * fracl endif From 07eb3af90230a9d101c346215121f176b6ab5f63 Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Wed, 11 Jan 2023 18:38:21 -0600 Subject: [PATCH 276/467] lSize needs to be saved it crashed only in debug mode my guess is that in optimized mode, the variable is saved between calls --- driver-moab/main/seq_flux_mct.F90 | 13 +++++++------ 1 file changed, 7 insertions(+), 6 deletions(-) diff --git a/driver-moab/main/seq_flux_mct.F90 b/driver-moab/main/seq_flux_mct.F90 index 35dea8fda4f6..249822676bb3 100644 --- a/driver-moab/main/seq_flux_mct.F90 +++ b/driver-moab/main/seq_flux_mct.F90 @@ -800,10 +800,11 @@ subroutine seq_flux_ocnalb_mct( infodata, ocn, a2x_o, fractions_o, xao_o ) integer nvert(3), nvise(3), nbl(3), nsurf(3), nvisBC(3) ! for moab info character(CXX) ::tagname - integer :: ent_type, ierr, kgg, lSize + integer :: ent_type, ierr, kgg integer , save :: arrSize ! local size for moab tag arrays (number of cells locally) logical,save :: first_call = .true. + integer, save :: lSize ! character(*),parameter :: subName = '(seq_flux_ocnalb_mct) ' ! @@ -1701,7 +1702,7 @@ subroutine seq_flux_atmocn_moab(comp, xao) ! moab integer :: tagtype, numco, tagindex, ent_type, ierr, arrSize character(CXX) :: tagname - integer , allocatable :: GlobalIds(:) ! used for setting values associated with ids + integer , allocatable :: GlobalIdsLocal(:) ! used for setting values associated with ids character*100 outfile, wopts, lnum @@ -1723,8 +1724,8 @@ subroutine seq_flux_atmocn_moab(comp, xao) dom => component_get_dom_cx(comp) kgg = mct_aVect_indexIA(dom%data ,"GlobGridNum" ,perrWith=subName) - allocate(GlobalIds(nloc)) - GlobalIds = dom%data%iAttr(kgg,:) + allocate(GlobalIdsLocal(nloc)) + GlobalIdsLocal = dom%data%iAttr(kgg,:) do j = 1, listSize @@ -1734,12 +1735,12 @@ subroutine seq_flux_atmocn_moab(comp, xao) tagname = trim(seq_flds_xao_fields)//C_NULL_CHAR arrSize = nloc * listSize ent_type = 1 ! cells - ierr = iMOAB_SetDoubleTagStorageWithGid ( appId, tagname, arrSize , ent_type, local_xao_mct, GlobalIds ) + ierr = iMOAB_SetDoubleTagStorageWithGid ( appId, tagname, arrSize , ent_type, local_xao_mct, GlobalIdsLocal ) if (ierr .ne. 0) then write(logunit,*) subname,' error in setting atm-ocn fluxes ' call shr_sys_abort(subname//' ERROR in setting atm-ocn fluxes') endif - deallocate(GlobalIds) + deallocate(GlobalIdsLocal) #ifdef MOABDEBUG ! debug out file From bd11b862b39edb43d6f50aab64faffd2ffc520af Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Thu, 12 Jan 2023 00:47:33 -0600 Subject: [PATCH 277/467] change in seq_map_map for receiving mbid for a real map, we have to send to intx mbid we were receiving to intx_mbid, and projecting on intx_mbid but for map read from file, we have to send to the coverage mesh computed with migratemesh, which is different than intx_mbid so change all the tgt_mbid to actually be the intx apps, for the real maps still need to deactivate rof 2 ocn map, because Apply goes to point cloud ? --- driver-moab/main/prep_atm_mod.F90 | 17 +++++++++-------- driver-moab/main/prep_lnd_mod.F90 | 9 +++------ driver-moab/main/prep_ocn_mod.F90 | 23 ++++++++++++----------- driver-moab/main/prep_rof_mod.F90 | 4 ++-- driver-moab/main/seq_map_mod.F90 | 4 +++- 5 files changed, 29 insertions(+), 28 deletions(-) diff --git a/driver-moab/main/prep_atm_mod.F90 b/driver-moab/main/prep_atm_mod.F90 index f05aed3a8828..c252b7071327 100644 --- a/driver-moab/main/prep_atm_mod.F90 +++ b/driver-moab/main/prep_atm_mod.F90 @@ -276,7 +276,7 @@ subroutine prep_atm_init(infodata, ocn_c2_atm, ice_c2_atm, lnd_c2_atm, iac_c2_at ! now take care of the mapper mapper_So2a%src_mbid = mboxid - mapper_So2a%tgt_mbid = mbaxid + mapper_So2a%tgt_mbid = mbintxoa ! mapper_So2a%intx_mbid = mbintxoa mapper_So2a%src_context = ocn(1)%cplcompid mapper_So2a%intx_context = idintx @@ -372,7 +372,7 @@ subroutine prep_atm_init(infodata, ocn_c2_atm, ice_c2_atm, lnd_c2_atm, iac_c2_at endif mapper_Sof2a%src_mbid = mbofxid - mapper_Sof2a%tgt_mbid = mbaxid + mapper_Sof2a%tgt_mbid = mbintxoa mapper_Sof2a%intx_mbid = mbintxoa mapper_Sof2a%src_context = context_id mapper_Sof2a%intx_context = idintx @@ -409,7 +409,7 @@ subroutine prep_atm_init(infodata, ocn_c2_atm, ice_c2_atm, lnd_c2_atm, iac_c2_at if ((mbaxid .ge. 0) .and. (mboxid .ge. 0)) then ! now take care of the mapper mapper_Fo2a%src_mbid = mboxid - mapper_Fo2a%tgt_mbid = mbaxid + mapper_Fo2a%tgt_mbid = mbintxoa mapper_Fo2a%intx_mbid = mbintxoa mapper_Fo2a%src_context = ocn(1)%cplcompid mapper_Fo2a%intx_context = idintx @@ -419,7 +419,7 @@ subroutine prep_atm_init(infodata, ocn_c2_atm, ice_c2_atm, lnd_c2_atm, iac_c2_at endif if ((mbaxid .ge. 0) .and. (mbofxid .ge. 0)) then mapper_Fof2a%src_mbid = mbofxid - mapper_Fof2a%tgt_mbid = mbaxid + mapper_Fof2a%tgt_mbid = mbintxoa mapper_Fof2a%intx_mbid = mbintxoa mapper_Fof2a%src_context = ocn(1)%cplcompid mapper_Fof2a%intx_context = idintx @@ -480,7 +480,7 @@ subroutine prep_atm_init(infodata, ocn_c2_atm, ice_c2_atm, lnd_c2_atm, iac_c2_at endif ! now take care of the mapper mapper_Si2a%src_mbid = mbixid - mapper_Si2a%tgt_mbid = mbaxid + mapper_Si2a%tgt_mbid = mbintxia mapper_Si2a%intx_mbid = mbintxia mapper_Si2a%src_context = ice(1)%cplcompid mapper_Si2a%intx_context = idintx @@ -572,7 +572,7 @@ subroutine prep_atm_init(infodata, ocn_c2_atm, ice_c2_atm, lnd_c2_atm, iac_c2_at #ifdef HAVE_MOAB ! now take care of the mapper for MOAB mapper_Fi2a%src_mbid = mbixid - mapper_Fi2a%tgt_mbid = mbaxid + mapper_Fi2a%tgt_mbid = mbintxia mapper_Fi2a%intx_mbid = mbintxia mapper_Fi2a%src_context = ice(1)%cplcompid mapper_Fi2a%intx_context = idintx @@ -607,7 +607,7 @@ subroutine prep_atm_init(infodata, ocn_c2_atm, ice_c2_atm, lnd_c2_atm, iac_c2_at call shr_sys_abort(subname//' ERROR in registering lnd atm intx ') endif mapper_Fl2a%src_mbid = mblxid - mapper_Fl2a%tgt_mbid = mbaxid + mapper_Fl2a%tgt_mbid = mbintxla ! mapper_Fl2a%intx_mbid = mbintxla mapper_Fl2a%src_context = lnd(1)%cplcompid mapper_Fl2a%intx_context = idintx @@ -666,6 +666,7 @@ subroutine prep_atm_init(infodata, ocn_c2_atm, ice_c2_atm, lnd_c2_atm, iac_c2_at call shr_sys_abort(subname//' ERROR in computing comm graph for second hop, lnd-atm') endif ! context for rearrange is target in this case + mapper_Fl2a%tgt_mbid = mbaxid mapper_Fl2a%intx_context = atm(1)%cplcompid endif ! if tri-grid @@ -698,7 +699,7 @@ subroutine prep_atm_init(infodata, ocn_c2_atm, ice_c2_atm, lnd_c2_atm, iac_c2_at #ifdef HAVE_MOAB if ((mbaxid .ge. 0) .and. (mblxid .ge. 0) ) then mapper_Sl2a%src_mbid = mblxid - mapper_Sl2a%tgt_mbid = mbaxid + mapper_Sl2a%tgt_mbid = mapper_Fl2a%tgt_mbid mapper_Sl2a%intx_mbid = mbintxla mapper_Sl2a%src_context = lnd(1)%cplcompid mapper_Sl2a%intx_context = mapper_Fl2a%intx_context diff --git a/driver-moab/main/prep_lnd_mod.F90 b/driver-moab/main/prep_lnd_mod.F90 index 17127e419973..fd4dc31c83b8 100644 --- a/driver-moab/main/prep_lnd_mod.F90 +++ b/driver-moab/main/prep_lnd_mod.F90 @@ -237,7 +237,7 @@ subroutine prep_lnd_init(infodata, atm_c2_lnd, rof_c2_lnd, glc_c2_lnd, iac_c2_ln call shr_sys_abort(subname//' ERROR in registering atm lnd intx ') endif mapper_Sa2l%src_mbid = mbaxid - mapper_Sa2l%tgt_mbid = mblxid + mapper_Sa2l%tgt_mbid = mbintxal mapper_Sa2l%intx_mbid = mbintxal mapper_Sa2l%src_context = atm(1)%cplcompid mapper_Sa2l%intx_context = idintx @@ -320,10 +320,6 @@ subroutine prep_lnd_init(infodata, atm_c2_lnd, rof_c2_lnd, glc_c2_lnd, iac_c2_ln write(logunit,*) subname,' error in computing weights for atm-lnd ' call shr_sys_abort(subname//' ERROR in computing weights for atm-lnd ') endif - - - - else ! the same mesh , atm and lnd use the same dofs, but lnd is a subset of atm ! we do not compute intersection, so we will have to just send data from atm to land and viceversa, by GLOBAL_ID matching @@ -342,13 +338,14 @@ subroutine prep_lnd_init(infodata, atm_c2_lnd, rof_c2_lnd, glc_c2_lnd, iac_c2_ln write(logunit,*) subname,' error in computing comm graph for second hop, atm-lnd' call shr_sys_abort(subname//' ERROR in computing comm graph for second hop, atm-lnd') endif + mapper_Sa2l%tgt_mbid = mblxid mapper_Sa2l%intx_context = lnd(1)%cplcompid endif ! if tri-grid ! use the same map for fluxes too mapper_Fa2l%src_mbid = mbaxid - mapper_Fa2l%tgt_mbid = mblxid + mapper_Fa2l%tgt_mbid = mapper_Sa2l%tgt_mbid mapper_Fa2l%intx_mbid = mbintxal mapper_Fa2l%src_context = atm(1)%cplcompid mapper_Fa2l%intx_context = mapper_Sa2l%intx_context diff --git a/driver-moab/main/prep_ocn_mod.F90 b/driver-moab/main/prep_ocn_mod.F90 index 66206646644d..36effbd39f02 100644 --- a/driver-moab/main/prep_ocn_mod.F90 +++ b/driver-moab/main/prep_ocn_mod.F90 @@ -373,7 +373,7 @@ subroutine prep_ocn_init(infodata, atm_c2_ocn, atm_c2_ice, ice_c2_ocn, rof_c2_oc endif ! now take care of the mapper mapper_Fa2o%src_mbid = mbaxid - mapper_Fa2o%tgt_mbid = mboxid + mapper_Fa2o%tgt_mbid = mbintxao mapper_Fa2o%intx_mbid = mbintxao mapper_Fa2o%src_context = atm(1)%cplcompid mapper_Fa2o%intx_context = idintx @@ -475,7 +475,7 @@ subroutine prep_ocn_init(infodata, atm_c2_ocn, atm_c2_ice, ice_c2_ocn, rof_c2_oc if ((mbaxid .ge. 0) .and. (mboxid .ge. 0)) then ! now take care of the 2 new mappers mapper_Sa2o%src_mbid = mbaxid - mapper_Sa2o%tgt_mbid = mboxid + mapper_Sa2o%tgt_mbid = mbintxao mapper_Sa2o%intx_mbid = mbintxao mapper_Sa2o%src_context = atm(1)%cplcompid mapper_Sa2o%intx_context = idintx @@ -484,7 +484,7 @@ subroutine prep_ocn_init(infodata, atm_c2_ocn, atm_c2_ice, ice_c2_ocn, rof_c2_oc mapper_Sa2o%mbname = 'mapper_Sa2o' mapper_Va2o%src_mbid = mbaxid - mapper_Va2o%tgt_mbid = mboxid + mapper_Va2o%tgt_mbid = mbintxao mapper_Va2o%intx_mbid = mbintxao mapper_Va2o%src_context = atm(1)%cplcompid mapper_Va2o%intx_context = idintx @@ -586,10 +586,11 @@ subroutine prep_ocn_init(infodata, atm_c2_ocn, atm_c2_ice, ice_c2_ocn, rof_c2_oc ! needed to be on joint comm anymore for the second hop ! it read on the coupler side, from file, the scrip mosart, that has a full mesh; - ! also migrate rof mesh on coupler pes, in ocean context, mbrxoid + ! also migrate rof mesh on coupler pes, in ocean context, mbrxoid (this will be like coverage mesh, + ! it will cover ocean target per process) ! map between rof 2 ocn is in mbrmapro ; ! after this, the sending of tags for second hop (ocn context) will use the new par comm graph, - ! that has more precise info + ! that has more precise info, that got created call seq_comm_getData(CPLID, mpicom=mpicom_CPLID, iamroot=iamroot_CPLID) call seq_comm_getData(CPLID ,mpigrp=mpigrp_CPLID) ! second group, the coupler group CPLID is global variable @@ -648,10 +649,10 @@ subroutine prep_ocn_init(infodata, atm_c2_ocn, atm_c2_ice, ice_c2_ocn, rof_c2_oc #endif ! now take care of the mapper for MOAB mapper_Rr2o_liq !mapper_Rr2o_liq%src_mbid = mbrxid - mapper_Rr2o_liq%tgt_mbid = mbrxoid + mapper_Rr2o_liq%tgt_mbid = mbrxoid ! this is special, it will really need this coverage type mesh mapper_Rr2o_liq%intx_mbid = mbrmapro mapper_Rr2o_liq%src_context = rof(1)%cplcompid - mapper_Rr2o_liq%intx_context = rmapid + mapper_Rr2o_liq%intx_context = ocn(1)%cplcompid wgtIdef = 'scalar'//C_NULL_CHAR mapper_Rr2o_liq%weight_identifier = wgtIdef mapper_Rr2o_liq%mbname = 'mapper_Rr2o_liq' @@ -668,10 +669,10 @@ subroutine prep_ocn_init(infodata, atm_c2_ocn, atm_c2_ice, ice_c2_ocn, rof_c2_oc #ifdef HAVE_MOAB ! now take care of the mapper for MOAB mapper_Rr2o_ice !mapper_Rr2o_ice%src_mbid = mbrxid - mapper_Rr2o_ice%tgt_mbid = mbrxoid + mapper_Rr2o_ice%tgt_mbid = mbrxoid ! special mapper_Rr2o_ice%intx_mbid = mbrmapro mapper_Rr2o_ice%src_context = rof(1)%cplcompid - mapper_Rr2o_ice%intx_context = rmapid + mapper_Rr2o_ice%intx_context = ocn(1)%cplcompid wgtIdef = 'scalar'//C_NULL_CHAR mapper_Rr2o_ice%weight_identifier = wgtIdef mapper_Rr2o_ice%mbname = 'mapper_Rr2o_ice' @@ -687,10 +688,10 @@ subroutine prep_ocn_init(infodata, atm_c2_ocn, atm_c2_ice, ice_c2_ocn, rof_c2_oc #ifdef HAVE_MOAB ! now take care of the mapper for MOAB mapper_Fr2o !mapper_Fr2o%src_mbid = mbrxid - mapper_Fr2o%tgt_mbid = mbrxoid + mapper_Fr2o%tgt_mbid = mbrxoid ! special mapper_Fr2o%intx_mbid = mbrmapro mapper_Fr2o%src_context = rof(1)%cplcompid - mapper_Fr2o%intx_context = rmapid + mapper_Fr2o%intx_context = ocn(1)%cplcompid wgtIdef = 'scalar'//C_NULL_CHAR mapper_Fr2o%weight_identifier = wgtIdef mapper_Fr2o%mbname = 'mapper_Fr2o' diff --git a/driver-moab/main/prep_rof_mod.F90 b/driver-moab/main/prep_rof_mod.F90 index 204d8b0578bf..d9b03c10cbd1 100644 --- a/driver-moab/main/prep_rof_mod.F90 +++ b/driver-moab/main/prep_rof_mod.F90 @@ -304,7 +304,7 @@ subroutine prep_rof_init(infodata, lnd_c2_rof, atm_c2_rof) endif ! now take care of the mapper mapper_Fa2r%src_mbid = mbrxid - mapper_Fa2r%tgt_mbid = mbaxid + mapper_Fa2r%tgt_mbid = mbintxra mapper_Fa2r%intx_mbid = mbintxra mapper_Fa2r%src_context = rof(1)%cplcompid mapper_Fa2r%intx_context = idintx @@ -385,7 +385,7 @@ subroutine prep_rof_init(infodata, lnd_c2_rof, atm_c2_rof) #ifdef HAVE_MOAB ! now take care of the mapper, use the same one as before mapper_Sa2r%src_mbid = mbrxid - mapper_Sa2r%tgt_mbid = mbaxid + mapper_Sa2r%tgt_mbid = mbintxra mapper_Sa2r%intx_mbid = mbintxra mapper_Sa2r%src_context = rof(1)%cplcompid mapper_Sa2r%intx_context = idintx diff --git a/driver-moab/main/seq_map_mod.F90 b/driver-moab/main/seq_map_mod.F90 index d2bf3654925a..ece6a14eaf85 100644 --- a/driver-moab/main/seq_map_mod.F90 +++ b/driver-moab/main/seq_map_mod.F90 @@ -498,7 +498,9 @@ subroutine seq_map_map( mapper, av_s, av_d, fldlist, norm, avwts_s, avwtsfld_s, endif if ( valid_moab_context ) then ! receive in the intx app, because it is redistributed according to coverage (trick) - ierr = iMOAB_ReceiveElementTag( mapper%intx_mbid, fldlist_moab, mapper%mpicom, mapper%src_context ); + ! for true intx cases, tgt_mbid is set to be the same as intx_mbid + ! just read map is special + ierr = iMOAB_ReceiveElementTag( mapper%tgt_mbid, fldlist_moab, mapper%mpicom, mapper%src_context ); if (ierr .ne. 0) then write(logunit,*) subname,' error in receiving tags ', mapper%mbname, trim(fldlist_moab) call shr_sys_flush(logunit) From 7b6c263c4af2e2d612b87086966da9c42b0a36a5 Mon Sep 17 00:00:00 2001 From: iulian07 Date: Thu, 12 Jan 2023 08:40:16 -0600 Subject: [PATCH 278/467] wrong map identifier --- driver-moab/main/prep_ocn_mod.F90 | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/driver-moab/main/prep_ocn_mod.F90 b/driver-moab/main/prep_ocn_mod.F90 index 36effbd39f02..4511e8e364d3 100644 --- a/driver-moab/main/prep_ocn_mod.F90 +++ b/driver-moab/main/prep_ocn_mod.F90 @@ -648,12 +648,12 @@ subroutine prep_ocn_init(infodata, atm_c2_ocn, atm_c2_ice, ice_c2_ocn, rof_c2_oc endif #endif ! now take care of the mapper for MOAB mapper_Rr2o_liq - !mapper_Rr2o_liq%src_mbid = mbrxid + mapper_Rr2o_liq%src_mbid = mbrxid mapper_Rr2o_liq%tgt_mbid = mbrxoid ! this is special, it will really need this coverage type mesh mapper_Rr2o_liq%intx_mbid = mbrmapro mapper_Rr2o_liq%src_context = rof(1)%cplcompid mapper_Rr2o_liq%intx_context = ocn(1)%cplcompid - wgtIdef = 'scalar'//C_NULL_CHAR + wgtIdef = 'map-from-file'//C_NULL_CHAR mapper_Rr2o_liq%weight_identifier = wgtIdef mapper_Rr2o_liq%mbname = 'mapper_Rr2o_liq' #endif @@ -668,12 +668,12 @@ subroutine prep_ocn_init(infodata, atm_c2_ocn, atm_c2_ice, ice_c2_ocn, rof_c2_oc ! us the same one for mapper_Rr2o_ice and mapper_Fr2o #ifdef HAVE_MOAB ! now take care of the mapper for MOAB mapper_Rr2o_ice - !mapper_Rr2o_ice%src_mbid = mbrxid + mapper_Rr2o_ice%src_mbid = mbrxid mapper_Rr2o_ice%tgt_mbid = mbrxoid ! special mapper_Rr2o_ice%intx_mbid = mbrmapro mapper_Rr2o_ice%src_context = rof(1)%cplcompid mapper_Rr2o_ice%intx_context = ocn(1)%cplcompid - wgtIdef = 'scalar'//C_NULL_CHAR + wgtIdef = 'map-from-file'//C_NULL_CHAR mapper_Rr2o_ice%weight_identifier = wgtIdef mapper_Rr2o_ice%mbname = 'mapper_Rr2o_ice' #endif @@ -687,12 +687,12 @@ subroutine prep_ocn_init(infodata, atm_c2_ocn, atm_c2_ice, ice_c2_ocn, rof_c2_oc string='mapper_Fr2o initialization', esmf_map=esmf_map_flag) #ifdef HAVE_MOAB ! now take care of the mapper for MOAB mapper_Fr2o - !mapper_Fr2o%src_mbid = mbrxid + mapper_Fr2o%src_mbid = mbrxid mapper_Fr2o%tgt_mbid = mbrxoid ! special mapper_Fr2o%intx_mbid = mbrmapro mapper_Fr2o%src_context = rof(1)%cplcompid mapper_Fr2o%intx_context = ocn(1)%cplcompid - wgtIdef = 'scalar'//C_NULL_CHAR + wgtIdef = 'map-from-file'//C_NULL_CHAR mapper_Fr2o%weight_identifier = wgtIdef mapper_Fr2o%mbname = 'mapper_Fr2o' #endif From ac4d83557d46e9bcdafa3ecf9ec5332cb7d551ca Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Thu, 12 Jan 2023 14:07:18 -0600 Subject: [PATCH 279/467] clarify comment on mbofxid mbofxid ! iMOAB id for mpas ocean migrated mesh to coupler pes, used just just for xao flux it represents a full copy of the ocean mesh shared indices between ocn fields and flux fields need to be copied explicitly to moab fileds, from xao instance to ocean instance --- driver-moab/main/prep_aoflux_mod.F90 | 2 +- driver-moab/main/prep_atm_mod.F90 | 2 +- driver-moab/main/seq_flux_mct.F90 | 2 +- 3 files changed, 3 insertions(+), 3 deletions(-) diff --git a/driver-moab/main/prep_aoflux_mod.F90 b/driver-moab/main/prep_aoflux_mod.F90 index 1b08f5130344..8c4504f2d016 100644 --- a/driver-moab/main/prep_aoflux_mod.F90 +++ b/driver-moab/main/prep_aoflux_mod.F90 @@ -7,7 +7,7 @@ module prep_aoflux_mod use shr_sys_mod, only: shr_sys_abort, shr_sys_flush use seq_comm_mct, only: num_inst_xao, num_inst_frc, num_inst_ocn use seq_comm_mct, only: CPLID, logunit - use seq_comm_mct, only : mbofxid ! iMOAB app id for ocn on cpl pes, the second copy of mboxid + use seq_comm_mct, only : mbofxid ! iMOAB id for mpas ocean migrated mesh to coupler pes, just for xao flux calculations use seq_comm_mct, only : mbox2id ! use seq_comm_mct, only : mbaxid ! iMOAB app id for atm on cpl pes use seq_comm_mct, only: seq_comm_getData=>seq_comm_setptrs diff --git a/driver-moab/main/prep_atm_mod.F90 b/driver-moab/main/prep_atm_mod.F90 index c252b7071327..e7c10e8af200 100644 --- a/driver-moab/main/prep_atm_mod.F90 +++ b/driver-moab/main/prep_atm_mod.F90 @@ -22,7 +22,7 @@ module prep_atm_mod use seq_comm_mct, only : mbaxid ! iMOAB id for atm migrated mesh to coupler pes use seq_comm_mct, only : mphaid ! iMOAB id for phys atm on atm pes use seq_comm_mct, only : mboxid ! iMOAB id for mpas ocean migrated mesh to coupler pes - use seq_comm_mct, only : mbofxid ! iMOAB id for mpas ocean migrated mesh to coupler pes + use seq_comm_mct, only : mbofxid ! iMOAB id for mpas ocean migrated mesh to coupler pes, just for xao flux calculations use seq_comm_mct, only : mbintxoa ! iMOAB id for intx mesh between ocean and atmosphere use seq_comm_mct, only : mbintxao ! iMOAB id for intx mesh between atm and ocean use seq_comm_mct, only : mbixid ! iMOAB id for mpas ice migrated mesh to coupler pes diff --git a/driver-moab/main/seq_flux_mct.F90 b/driver-moab/main/seq_flux_mct.F90 index 249822676bb3..5660edbc66de 100644 --- a/driver-moab/main/seq_flux_mct.F90 +++ b/driver-moab/main/seq_flux_mct.F90 @@ -7,7 +7,7 @@ module seq_flux_mct use shr_mct_mod, only: shr_mct_queryConfigFile, shr_mct_sMatReaddnc use seq_comm_mct, only : mboxid ! iMOAB app id for ocn on cpl pes - use seq_comm_mct, only : mbofxid ! iMOAB app id for ocn on cpl pes + use seq_comm_mct, only : mbofxid ! iMOAB id for mpas ocean migrated mesh to coupler pes, just for xao flux calculations use seq_comm_mct, only : mbaxid ! iMOAB app id for atm phys grid on cpl pes use prep_aoflux_mod, only: prep_aoflux_get_xao_omct, prep_aoflux_get_xao_amct From 198f08db915671e7740b66ead1e38fd60924d33b Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Thu, 12 Jan 2023 15:08:48 -0600 Subject: [PATCH 280/467] get/set shared values between xao and ocean instances use a local array, and decipher name of the common tags --- driver-moab/main/prep_ocn_mod.F90 | 29 +++++++++++++++++++++++++++++ 1 file changed, 29 insertions(+) diff --git a/driver-moab/main/prep_ocn_mod.F90 b/driver-moab/main/prep_ocn_mod.F90 index 4511e8e364d3..08634e99b378 100644 --- a/driver-moab/main/prep_ocn_mod.F90 +++ b/driver-moab/main/prep_ocn_mod.F90 @@ -154,6 +154,13 @@ module prep_ocn_mod real (kind=r8) , allocatable, private :: r2x_om (:,:) real (kind=r8) , allocatable, private :: xao_om (:,:) + ! this will be constructed first time, and be used to copy fields for shared indices + ! between xao and x2o + character(CXX) :: shared_fields_xao_x2o + ! will need some array to hold the data for copying + real(r8) , allocatable, save :: shared_values(:) ! will be the size of shared indices * lsize + integer :: size_of_shared_values + logical :: iamin_CPLALLICEID ! pe associated with CPLALLICEID contains @@ -1018,6 +1025,7 @@ subroutine prep_ocn_mrg_moab(infodata, xao_ox) logical, save :: first_time = .true. integer nvert(3), nvise(3), nbl(3), nsurf(3), nvisBC(3) ! for moab info + character(CXX) ::tagname, mct_field integer :: ent_type, ierr #ifdef MOABDEBUG @@ -1315,6 +1323,7 @@ subroutine prep_ocn_mrg_moab(infodata, xao_ox) !--- document copy operations --- if (first_time) then + shared_fields_xao_x2o='' ! nothing in it yet !--- document merge --- do i=1,a2x_SharedIndices%shared_real%num_indices i1=a2x_SharedIndices%shared_real%aVindices1(i) @@ -1340,7 +1349,12 @@ subroutine prep_ocn_mrg_moab(infodata, xao_ox) i1=xao_SharedIndices%shared_real%aVindices1(i) o1=xao_SharedIndices%shared_real%aVindices2(i) mrgstr(o1) = trim(mrgstr(o1))//' = xao%'//trim(field_xao(i1)) + ! will build tagname for moab set/get tag values + shared_fields_xao_x2o = trim(shared_fields_xao_x2o)//trim(field_xao(i1))//':' + size_of_shared_values = size_of_shared_values + lSize enddo + ! first time, allocate data for values_holder + allocate(shared_values (size_of_shared_values)) ! do i=1,g2x_SharedIndices%shared_real%num_indices ! i1=g2x_SharedIndices%shared_real%aVindices1(i) ! o1=g2x_SharedIndices%shared_real%aVindices2(i) @@ -1645,6 +1659,20 @@ subroutine prep_ocn_mrg_moab(infodata, xao_ox) if (ierr .ne. 0) then call shr_sys_abort(subname//' error in setting x2o_om array ') endif + + ! we still need to get/set the shared fields between xao and x2o: + tagname = trim(shared_fields_xao_x2o)//C_NULL_CHAR + ierr = iMOAB_GetDoubleTagStorage ( mbofxid, tagname, size_of_shared_values , ent_type, shared_values) + if (ierr .ne. 0) then + call shr_sys_abort(subname//' error in getting shared_values array ') + endif + ierr = iMOAB_SetDoubleTagStorage ( mboxid, tagname, size_of_shared_values , ent_type, shared_values) + if (ierr .ne. 0) then + call shr_sys_abort(subname//' error in setting shared_values array on ocean instance') + endif + + + #ifdef MOABDEBUG !compare_mct_av_moab_tag(comp, attrVect, field, imoabApp, tag_name, ent_type, difference) x2o_o => component_get_x2c_cx(ocn(1)) @@ -1675,6 +1703,7 @@ subroutine prep_ocn_mrg_moab(infodata, xao_ox) do ko = 1,noflds write(logunit,'(A)') trim(mrgstr(ko)) enddo + write(logunit,'(A)') subname//' shared fields between xao and x2o '//trim(shared_fields_xao_x2o) endif deallocate(mrgstr) deallocate(field_atm,itemc_atm) From 2ae22cfbee8e57bfc86d963c362e85bb91f4d745 Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Fri, 13 Jan 2023 01:22:55 -0600 Subject: [PATCH 281/467] read land on coupler from processed h5m file it had global ids the same as atm mesh it came from (ne4pg2) --- driver-moab/main/cime_comp_mod.F90 | 1 - driver-moab/main/cplcomp_exchange_mod.F90 | 161 +++++++------- driver-moab/main/prep_atm_mod.F90 | 246 +--------------------- driver-moab/main/seq_frac_mct.F90 | 15 +- 4 files changed, 80 insertions(+), 343 deletions(-) diff --git a/driver-moab/main/cime_comp_mod.F90 b/driver-moab/main/cime_comp_mod.F90 index 118c5593cab3..1176d8ec73aa 100644 --- a/driver-moab/main/cime_comp_mod.F90 +++ b/driver-moab/main/cime_comp_mod.F90 @@ -4092,7 +4092,6 @@ subroutine cime_run_atm_recv_post() ! will migrate the tag from component pes to coupler pes, on atm mesh call component_exch_moab(atm(1), mphaid, mbaxid, 0, seq_flds_a2x_fields) - !call prep_atm_migrate_moab(infodata) endif !---------------------------------------------------------- diff --git a/driver-moab/main/cplcomp_exchange_mod.F90 b/driver-moab/main/cplcomp_exchange_mod.F90 index 37412e220e98..59cdc404012c 100644 --- a/driver-moab/main/cplcomp_exchange_mod.F90 +++ b/driver-moab/main/cplcomp_exchange_mod.F90 @@ -1012,7 +1012,7 @@ subroutine cplcomp_moab_Init(comp) integer :: mpigrp_cplid ! coupler pes integer :: mpigrp_old ! component group pes integer :: ierr, context_id - character*100 :: appname, outfile, wopts, ropts + character*200 :: appname, outfile, wopts, ropts integer :: maxMH, maxMPO, maxMLID, maxMSID, maxMRID ! max pids for moab apps atm, ocn, lnd, sea-ice, rof integer :: tagtype, numco, tagindex, partMethod, nghlay integer :: rank, ent_type @@ -1293,91 +1293,78 @@ subroutine cplcomp_moab_Init(comp) if (comp%oneletterid == 'l' .and. maxMLID /= -1) then call seq_comm_getinfo(cplid ,mpigrp=mpigrp_cplid) ! receiver group call seq_comm_getinfo(id_old,mpigrp=mpigrp_old) ! component group pes - - if (MPI_COMM_NULL /= mpicom_old ) then ! it means we are on the component pes (ocean) - ! send mesh to coupler -#ifdef MOAB_HAVE_ZOLTAN - partMethod = 2 ! RCB for point cloud + ! use land full mesh + if (MPI_COMM_NULL /= mpicom_new ) then ! we are on the coupler pes + appname = "COUPLE_LAND"//C_NULL_CHAR + ! migrated mesh gets another app id, moab land to coupler (mblx) + ierr = iMOAB_RegisterApplication(trim(appname), mpicom_new, id_join, mblxid) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in registering coupler land ' + call shr_sys_abort(subname//' ERROR in registering coupler land') + endif + ! do not receive the mesh anymore, read it from file, then pair it with mlnid, component land PC mesh + ! similar to rof mosart mesh + ! on lcrc: + ! outfile = '/lcrc/group/e3sm/data/inputdata/share/meshes/lnd/land_np4pg2_oQU480_230112.h5m'//C_NULL_CHAR + ! on gce: + ! /nfs/gce/projects/climate/inputdata/share/meshes/lnd/land_np4pg2_oQU480_230112.h5m'//C_NULL_CHAR + ! iulian's laptop + outfile = '/media/iulian/ExtraDrive1/inputdata/share/meshes/lnd/land_np4pg2_oQU480_230112.h5m'//C_NULL_CHAR + ropts = 'PARALLEL=READ_PART;PARTITION=PARALLEL_PARTITION;PARALLEL_RESOLVE_SHARED_ENTS'//C_NULL_CHAR + + nghlay = 0 ! no ghost layers + ierr = iMOAB_LoadMesh(mblxid, outfile, ropts, nghlay) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in reading land coupler mesh' + call shr_sys_abort(subname//' ERROR in reading land coupler mesh') + endif +#ifdef MOABDEBUG + outfile = 'recLand.h5m'//C_NULL_CHAR + wopts = ';PARALLEL=WRITE_PART'//C_NULL_CHAR ! + ! write out the mesh file to disk + ierr = iMOAB_WriteMesh(mblxid, trim(outfile), trim(wopts)) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in writing land coupler mesh' + call shr_sys_abort(subname//' ERROR in writing land coupler mesh') + endif #endif - ierr = iMOAB_SendMesh(mlnid, mpicom_join, mpigrp_cplid, id_join, partMethod) - if (ierr .ne. 0) then - write(logunit,*) subname,' error in sending land mesh ' - call shr_sys_abort(subname//' ERROR in sending land mesh ') - endif + ! need to define tags on land too + tagname = trim(seq_flds_l2x_fields)//C_NULL_CHAR + tagtype = 1 ! dense, double + numco = 1 ! one value per cell + ierr = iMOAB_DefineTagStorage(mblxid, tagname, tagtype, numco, tagindex ) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in defining tags l2x on coupler land' + call shr_sys_abort(subname//' ERROR in defining tags l2x on coupler ') + endif + ! need also to define seq_flds_x2l_fields on coupler instance, and on land comp instance + tagname = trim(seq_flds_x2l_fields)//C_NULL_CHAR + ierr = iMOAB_DefineTagStorage(mblxid, tagname, tagtype, numco, tagindex ) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in defining tags x2l on coupler land' + call shr_sys_abort(subname//' ERROR in defining tags x2l on coupler land') + endif - endif - if (MPI_COMM_NULL /= mpicom_new ) then ! we are on the coupler pes - appname = "COUPLE_LAND"//C_NULL_CHAR - ! migrated mesh gets another app id, moab land to coupler (mblx) - ierr = iMOAB_RegisterApplication(trim(appname), mpicom_new, id_join, mblxid) - if (ierr .ne. 0) then - write(logunit,*) subname,' error in registering coupler land ' - call shr_sys_abort(subname//' ERROR in registering coupler land') - endif - ierr = iMOAB_ReceiveMesh(mblxid, mpicom_join, mpigrp_old, id_old) - if (ierr .ne. 0) then - write(logunit,*) subname,' error in receiving coupler land mesh' - call shr_sys_abort(subname//' ERROR in receiving coupler land mesh') - endif + tagname = trim(seq_flds_dom_fields)//C_NULL_CHAR + ierr = iMOAB_DefineTagStorage(mblxid, tagname, tagtype, numco, tagindex ) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in defining tags seq_flds_dom_fields on lnd on coupler ' + call shr_sys_abort(subname//' ERROR in defining tags ') + endif -! need to define tags on land too - tagname = trim(seq_flds_l2x_fields)//C_NULL_CHAR - tagtype = 1 ! dense, double - numco = 1 ! one value per cell - ierr = iMOAB_DefineTagStorage(mblxid, tagname, tagtype, numco, tagindex ) - if (ierr .ne. 0) then - write(logunit,*) subname,' error in defining tags l2x on coupler land' - call shr_sys_abort(subname//' ERROR in defining tags l2x on coupler ') - endif - ! need also to define seq_flds_x2l_fields on coupler instance, and on land comp instance - tagname = trim(seq_flds_x2l_fields)//C_NULL_CHAR - ierr = iMOAB_DefineTagStorage(mblxid, tagname, tagtype, numco, tagindex ) - if (ierr .ne. 0) then - write(logunit,*) subname,' error in defining tags x2l on coupler land' - call shr_sys_abort(subname//' ERROR in defining tags x2l on coupler land') - endif - tagname = trim(seq_flds_dom_fields)//C_NULL_CHAR - ierr = iMOAB_DefineTagStorage(mblxid, tagname, tagtype, numco, tagindex ) - if (ierr .ne. 0) then - write(logunit,*) subname,' error in defining tags seq_flds_dom_fields on lnd on coupler ' - call shr_sys_abort(subname//' ERROR in defining tags ') endif -#ifdef MOABDEBUG - ! debug test - ! if only vertices, set a partition tag for help in visualizations - ierr = iMOAB_GetMeshInfo(mblxid, nverts, nelem, nblocks, nsbc, ndbc) - if (nelem(1) .eq. 0) then ! we have only vertices locally? - !there are no shared entities, but we will set a special partition tag, in order to see the - ! partitions ; it will be visible with a Pseudocolor plot in VisIt - tagname='partition'//C_NULL_CHAR - tagtype = 0 ! dense, integer - numco = 1 ! one value per cell - ierr = iMOAB_DefineTagStorage(mblxid, tagname, tagtype, numco, tagindex ) - allocate(vgids(nverts(1))) - vgids = rank - ent_type = 0 ! vertex type - ierr = iMOAB_SetIntTagStorage ( mblxid, tagname, nverts(1) , ent_type, vgids) - endif - outfile = 'recLand.h5m'//C_NULL_CHAR - wopts = ';PARALLEL=WRITE_PART'//C_NULL_CHAR ! - ! write out the mesh file to disk - ierr = iMOAB_WriteMesh(mblxid, trim(outfile), trim(wopts)) + ! we are now on joint pes, compute comm graph between lnd and coupler model + typeA = 2 ! point cloud on component PEs, land + typeB = 3 ! full mesh on coupler pes, we just read it + ierr = iMOAB_ComputeCommGraph( mlnid, mblxid, mpicom_join, mpigrp_old, mpigrp_cplid, & + typeA, typeB, id_old, id_join) if (ierr .ne. 0) then - write(logunit,*) subname,' error in writing land coupler mesh' - call shr_sys_abort(subname//' ERROR in writing land coupler mesh') - endif -#endif - endif - if (mlnid .ge. 0) then ! we are on component land pes - context_id = id_join - ierr = iMOAB_FreeSenderBuffers(mlnid, context_id) - if (ierr .ne. 0) then - write(logunit,*) subname,' error in freeing buffers' - call shr_sys_abort(subname//' ERROR in freeing buffers') - endif + write(logunit,*) subname,' error in computing comm graph for rof model ' + call shr_sys_abort(subname//' ERROR in computing comm graph for rof model ') endif + endif ! sea - ice @@ -1455,21 +1442,17 @@ subroutine cplcomp_moab_Init(comp) call seq_comm_getinfo(cplid ,mpigrp=mpigrp_cplid) ! receiver group call seq_comm_getinfo(id_old,mpigrp=mpigrp_old) ! component group pes - ! if (MPI_COMM_NULL /= mpicom_old ) then ! it means we are on the component p - - ! ierr = iMOAB_SendMesh(mrofid, mpicom_join, mpigrp_cplid, id_join, partMethod) - ! if (ierr .ne. 0) then - ! write(logunit,*) subname,' error in sending rof mesh to coupler ' - ! call shr_sys_abort(subname//' ERROR in sending rof mesh to coupler ') - ! endif - - ! endif if (MPI_COMM_NULL /= mpicom_new ) then ! we are on the coupler pes appname = "COUPLE_MROF"//C_NULL_CHAR ierr = iMOAB_RegisterApplication(trim(appname), mpicom_new, id_join, mbrxid) - ! load mesh from scrip file,then send it locally, maybe it will defeat the crash in writing it - outfile = '/home/iulian/rofscrip/SCRIPgrid_2x2_nomask_c210211.nc'//C_NULL_CHAR + ! load mesh from scrip file + ! on lcrc: + ! outfile = '/lcrc/group/e3sm/data/inputdata/share/meshes/rof/SCRIPgrid_2x2_nomask_c210211.nc'//C_NULL_CHAR + ! on gce: + ! /nfs/gce/projects/climate/inputdata/share/meshes/rof/SCRIPgrid_2x2_nomask_c210211.nc'//C_NULL_CHAR + ! iulian's laptop + outfile = '/media/iulian/ExtraDrive1/inputdata/share/meshes/rof/SCRIPgrid_2x2_nomask_c210211.nc'//C_NULL_CHAR ropts = 'PARALLEL=READ_PART;PARTITION_METHOD=RCBZOLTAN'//C_NULL_CHAR nghlay = 0 ! no ghost layers diff --git a/driver-moab/main/prep_atm_mod.F90 b/driver-moab/main/prep_atm_mod.F90 index e7c10e8af200..085558670eff 100644 --- a/driver-moab/main/prep_atm_mod.F90 +++ b/driver-moab/main/prep_atm_mod.F90 @@ -74,7 +74,6 @@ module prep_atm_mod public :: prep_atm_get_mapper_Si2a public :: prep_atm_get_mapper_Fi2a - public :: prep_atm_migrate_moab !-------------------------------------------------------------------------- ! Private interfaces @@ -657,7 +656,7 @@ subroutine prep_atm_init(infodata, ocn_c2_atm, ice_c2_atm, lnd_c2_atm, iac_c2_at ! we do not compute intersection, so we will have to just send data from atm to land and viceversa, by GLOBAL_ID matching ! so we compute just a comm graph, between lnd and atm dofs, on the coupler; target is atm ! land is point cloud in this case, type1 = 2 - type1 = 2; ! point cloud for lnd + type1 = 3; ! full mesh for land now type2 = 3; ! fv for target atm ierr = iMOAB_ComputeCommGraph( mblxid, mbaxid, mpicom_CPLID, mpigrp_CPLID, mpigrp_CPLID, type1, type2, & lnd(1)%cplcompid, atm(1)%cplcompid) @@ -713,248 +712,7 @@ subroutine prep_atm_init(infodata, ocn_c2_atm, ice_c2_atm, lnd_c2_atm, iac_c2_at endif ! if atm_present end subroutine prep_atm_init - - subroutine prep_atm_migrate_moab(infodata) - - use iMOAB, only: iMOAB_SendElementTag, iMOAB_ReceiveElementTag, iMOAB_FreeSenderBuffers, & - iMOAB_ApplyScalarProjectionWeights, iMOAB_WriteMesh - !--------------------------------------------------------------- - ! Description - ! After a2oTbot, a2oUbot, a2oVbot tags were loaded on atm mesh, - ! they need to be migrated to the coupler pes, for weight application later - ! - ! Arguments - type(seq_infodata_type) , intent(in) :: infodata - - character(*), parameter :: subname = '(prep_atm_migrate_moab)' - - integer :: ierr - - logical :: atm_present ! .true. => atm is present - logical :: ocn_present ! .true. => ocn is present - logical :: lnd_present ! .true. => lnd is present - logical :: ocn_prognostic ! .true. => ocn is prognostic - integer :: id_join - integer :: mpicom_join - integer :: atm_id - integer :: context_id ! we will use ocean context or land context - character*32 :: dm1, dm2, wgtIdef - character*50 :: outfile, wopts, lnum - character(CXX) :: tagName, tagnameProj, tagNameExt - character(CL) :: atm_gnam ! atm grid - character(CL) :: lnd_gnam ! lnd grid - logical :: samegrid_al - - - call seq_infodata_getData(infodata, & - atm_present=atm_present, & - ocn_present=ocn_present, & - lnd_present=lnd_present, & - atm_gnam=atm_gnam, & - lnd_gnam=lnd_gnam, & - ocn_prognostic=ocn_prognostic) - - samegrid_al = .true. - if (trim(atm_gnam) /= trim(lnd_gnam)) samegrid_al = .false. - - ! it involves initial atm app; mhid; also migrate atm mesh on coupler pes, mbaxid - ! intx ocean atm are in mbintxao ; remapper also has some info about coverage mesh - ! after this, the sending of tags from atm pes to coupler pes will use the new par comm graph, that has more precise info about - ! how to get mpicomm for joint atm + coupler - id_join = atm(1)%cplcompid - atm_id = atm(1)%compid - - call seq_comm_getinfo(ID_join,mpicom=mpicom_join) - - ! we should do this only if ocn_present - - context_id = ocn(1)%cplcompid - wgtIdef = 'scalar'//C_NULL_CHAR - - ! repeat this for land data, that is already on atm tag - context_id = lnd(1)%cplcompid - - if (atm_present .and. lnd_present) then - wgtIdef = 'scalar'//C_NULL_CHAR ! from fv, need to be similar to ocean now - if (.not. samegrid_al) then ! tri-grid case - if (atm_pg_active ) then ! use mhpgid mesh - - if (mhpgid .ge. 0) then ! send because we are on atm pes - - ! basically, adjust the migration of the tag we want to project; it was sent initially with - ! original partitioning, now we need to adjust it for "coverage" mesh - ! as always, use nonblocking sends - tagName = trim(seq_flds_a2x_fields)//C_NULL_CHAR ! they are defined in initialize_moab_atm_phys in atm_comp_mct - context_id = 100*atm(1)%cplcompid + lnd(1)%cplcompid !send to atm/lnd intx ! - ! use computed graph - ierr = iMOAB_SendElementTag(mphaid, tagName, mpicom_join, context_id) - if (ierr .ne. 0) then - write(logunit,*) subname,' error in sending tag from atm to atm land intx ' - call shr_sys_abort(subname//' ERROR in sending tag from atm to atm land intx') - endif - - endif - if (mbaxid .ge. 0 ) then ! we are on coupler pes, for sure - ! receive on atm on coupler pes, that was redistributed according to coverage - tagName = trim(seq_flds_a2x_fields)//C_NULL_CHAR ! they are defined in initialize_moab_atm_phys - ierr = iMOAB_ReceiveElementTag(mbintxla, tagName, mpicom_join, atm_id) - if (ierr .ne. 0) then - write(logunit,*) subname,' error in receiving tag from atm to atm land intx ' - call shr_sys_abort(subname//' ERROR in receiving tag from atm to atm land intx') - endif - endif - - ! we can now free the sender buffers - if (mphaid .ge. 0) then - context_id = 100*atm(1)%cplcompid + lnd(1)%cplcompid !send to atm/lnd intx ! - ierr = iMOAB_FreeSenderBuffers(mphaid, context_id) - if (ierr .ne. 0) then - write(logunit,*) subname,' error in freeing buffer ' - call shr_sys_abort(subname//' ERROR in freeing buffer') - endif - endif - - if (mbintxla .ge. 0 ) then ! we are on coupler pes, for sure - ! we could apply weights; need to use the same weight identifier wgtIdef as when we generated it - ! hard coded now, it should be a runtime option in the future - - ierr = iMOAB_ApplyScalarProjectionWeights ( mbintxla, wgtIdef, tagName, tagName) - if (ierr .ne. 0) then - write(logunit,*) subname,' error in applying weights ' - call shr_sys_abort(subname//' ERROR in applying weights') - endif -#ifdef MOABDEBUG - ! we can also write the lnd mesh to file, just to see the projectd tag - ! write out the mesh file to disk - write(lnum,"(I0.2)")num_moab_exports - outfile = 'lndCplProj'//trim(lnum)//'.h5m'//C_NULL_CHAR - wopts = ';PARALLEL=WRITE_PART'//C_NULL_CHAR ! - ierr = iMOAB_WriteMesh(mblxid, trim(outfile), trim(wopts)) - if (ierr .ne. 0) then - write(logunit,*) subname,' error in writing ocn mesh after projection ' - call shr_sys_abort(subname//' ERROR in writing ocn mesh after projection') - endif -#endif - endif ! if (mbintxla .ge. 0 ) - - else ! regular coarse homme mesh if (.not. atm_pg_active) - tagName = trim(seq_flds_a2x_fields)//C_NULL_CHAR ! they are exported on phys grid directly - tagNameExt = trim(seq_flds_a2x_ext_fields)//C_NULL_CHAR ! these are special moab tags - ! the separator will be ':' as in mct - - if (mphaid .ge. 0) then ! send because we are on atm pes - ! - context_id = 100*atm(1)%cplcompid + lnd(1)%cplcompid !send to atm/lnd intx ! ~ - ierr = iMOAB_SendElementTag(mphaid, tagName, mpicom_join, context_id) - if (ierr .ne. 0) then - write(logunit,*) subname,' error in sending tag from atm spectral to ocn atm intx ' - call shr_sys_abort(subname//' ERROR in sending tag from atm spectral to ocn atm intx') - endif - endif - if (mbaxid .ge. 0 ) then ! we are on coupler pes, for sure - ! receive on atm on coupler pes, that was redistributed according to coverage - context_id = atm(1)%compid ! atm_id - ierr = iMOAB_ReceiveElementTag(mbintxla, tagNameExt, mpicom_join, context_id) - if (ierr .ne. 0) then - write(logunit,*) subname,' error in receiving tag from atm phys grid to lnd atm intx spectral ' - call shr_sys_abort(subname//' ERROR in receiving tag from atm phys grid to lnd atm intx spectral') - endif - endif - - ! we can now free the sender buffers - if (mphaid .ge. 0) then - context_id = 100*atm(1)%cplcompid + lnd(1)%cplcompid !send to atm/ocn intx ! ~ 618 - ierr = iMOAB_FreeSenderBuffers(mphaid, context_id) - if (ierr .ne. 0) then - write(logunit,*) subname,' error in freeing buffers ' - call shr_sys_abort(subname//' ERROR in freeing buffers') - endif - endif - ! we could do the projection now, on the ocean mesh, because we are on the coupler pes; - ! the actual migrate could happen later , from coupler pes to the ocean pes - if (mbintxla .ge. 0 ) then ! we are on coupler pes, for sure - ! we could apply weights; need to use the same weight identifier wgtIdef as when we generated it - ! hard coded now, it should be a runtime option in the future - - ierr = iMOAB_ApplyScalarProjectionWeights ( mbintxla, wgtIdef, tagNameExt, tagName) - if (ierr .ne. 0) then - write(logunit,*) subname,' error in applying weights ' - call shr_sys_abort(subname//' ERROR in applying weights') - endif -#ifdef MOABDEBUG - ! we can also write the lnd mesh to file, just to see the projectd tag - ! write out the mesh file to disk - write(lnum,"(I0.2)")num_moab_exports - outfile = 'lndCplProj'//trim(lnum)//'.h5m'//C_NULL_CHAR - wopts = ';PARALLEL=WRITE_PART'//C_NULL_CHAR ! - ierr = iMOAB_WriteMesh(mblxid, trim(outfile), trim(wopts)) - if (ierr .ne. 0) then - write(logunit,*) subname,' error in writing ocn mesh after projection ' - call shr_sys_abort(subname//' ERROR in writing ocn mesh after projection') - endif -#endif - endif ! if (mbintxla .ge. 0 ) - endif - else ! sameg_al, original lnd from atm grid - ! major change; we do not have intx anymore, we just send from phys grid to land on coupler, - ! using the comm graph computed at line prep_atm_lnd_moab , prep_lnd_mod.70:621 - ! ierr = iMOAB_ComputeCommGraph( mphaid, mblxid, mpicom_join, mpigrp_old, mpigrp_CPLID, & - ! typeA, typeB, atm_id, context_id) - tagName=trim(seq_flds_a2x_fields)//C_NULL_CHAR - if (mphaid .ge. 0) then ! send because we are on atm pes - - ! basically, adjust the migration of the tag we want to project; it was sent initially with - ! original partitioning, now we need to adjust it for "coverage" mesh - ! as always, use nonblocking sends - context_id = lnd(1)%cplcompid - ierr = iMOAB_SendElementTag(mphaid, tagName, mpicom_join, context_id) - if (ierr .ne. 0) then - write(logunit,*) subname,' error in sending tag for land projection' - call shr_sys_abort(subname//' ERROR in sending tag for land projection') - endif - endif - if (mblxid .ge. 0 ) then ! we are on coupler pes, for sure; no need to project anything - ! receive on atm on coupler pes, that was redistributed according to coverage - context_id=atm(1)%compid - ierr = iMOAB_ReceiveElementTag(mblxid, tagName, mpicom_join, context_id) - if (ierr .ne. 0) then - write(logunit,*) subname,' error in receiving tag for land projection' - call shr_sys_abort(subname//' ERROR in receiving tag for land projection') - endif - endif - - ! we can now free the sender buffers - if (mhid .ge. 0) then - context_id = lnd(1)%cplcompid - ierr = iMOAB_FreeSenderBuffers(mphaid, context_id) - if (ierr .ne. 0) then - write(logunit,*) subname,' error in freeing buffers' - call shr_sys_abort(subname//' ERROR in freeing buffers') - endif - endif - - ! we could do the projection now, on the land mesh, because we are on the coupler pes; - ! the actual migrate back could happen later , from coupler pes to the land pes - if (mblxid .ge. 0 ) then ! we are on coupler pes, for sure -#ifdef MOABDEBUG - ! we can also write the land mesh to file, just to see the projectd tag - ! write out the mesh file to disk - write(lnum,"(I0.2)")num_moab_exports - outfile = 'lndCplProj'//trim(lnum)//'.h5m'//C_NULL_CHAR - wopts = ';PARALLEL=WRITE_PART'//C_NULL_CHAR ! - ierr = iMOAB_WriteMesh(mblxid, trim(outfile), trim(wopts)) - if (ierr .ne. 0) then - write(logunit,*) subname,' error in writing land projection' - call shr_sys_abort(subname//' ERROR in writing land projection') - endif -#endif - endif ! if on coupler procs - - endif - endif ! if (atm_present .and. lnd_present) - - end subroutine prep_atm_migrate_moab - + !================================================================================================ subroutine prep_atm_mrg(infodata, fractions_ax, xao_ax, timer_mrg) diff --git a/driver-moab/main/seq_frac_mct.F90 b/driver-moab/main/seq_frac_mct.F90 index 09ec634326c6..7a6026d0accd 100644 --- a/driver-moab/main/seq_frac_mct.F90 +++ b/driver-moab/main/seq_frac_mct.F90 @@ -168,7 +168,7 @@ module seq_frac_mct use seq_comm_mct, only : mblx2id ! iMOAB id for land mesh instanced from MCT on coupler pes use seq_comm_mct, only : mbox2id ! iMOAB id for ocn mesh instanced from MCT on coupler pes use seq_comm_mct, only : mboxid ! iMOAB app id for ocn on cpl pes - use seq_comm_mct, only : mbofxid ! iMOAB app id for ocn on cpl pes + use seq_comm_mct, only : mbofxid ! iMOAB id for mpas ocean migrated mesh to coupler pes, just for xao flux calculations use seq_comm_mct, only : mbixid ! iMOAB for sea-ice migrated to coupler use seq_comm_mct, only : atm_pg_active ! flag if PG mesh instanced use seq_comm_mct, only : mbintxao ! iMOAB id for intx mesh between ocean and atmosphere @@ -435,14 +435,10 @@ subroutine seq_frac_init( infodata, & call shr_sys_abort(subname//' ERROR in defining tags on lnd phys mesh on cpl') endif ierr = iMOAB_GetMeshInfo ( mblxid, nvert, nvise, nbl, nsurf, nvisBC ); - - if (nvise(1) .eq. 0) then - ent_type = 0 ! vertex type, land on atm grid, no cells - arrSize = 3 * nVert(1) - else - ent_type = 1 ! cell type, tri-grid case - arrSize = 3 * nvise(1) - endif ! real land mesh + ! this should have some cells + ent_type = 1 ! cells from now on + arrSize = 3 * nvise(1) + allocate(tagValues(arrSize) ) tagValues = 0 ierr = iMOAB_SetDoubleTagStorage ( mblxid, tagname, arrSize , ent_type, tagValues) @@ -468,6 +464,7 @@ subroutine seq_frac_init( infodata, & allocate(GlobalIds(lSize)) GlobalIds = dom_l%data%iAttr(kgg,:) + ! ent_type should be 3, FV ierr = iMOAB_SetDoubleTagStorageWithGid ( mblxid, tagname, lSize , ent_type, tagValues, GlobalIds ) if (ierr .ne. 0) then write(logunit,*) subname,' error in setting lfrin on lnd ' From 5776ebe6890478dabd10c801f43a8565b080f197 Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Fri, 13 Jan 2023 02:29:45 -0600 Subject: [PATCH 282/467] failed to save before --- driver-moab/main/prep_lnd_mod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/driver-moab/main/prep_lnd_mod.F90 b/driver-moab/main/prep_lnd_mod.F90 index fd4dc31c83b8..d5acae0e3540 100644 --- a/driver-moab/main/prep_lnd_mod.F90 +++ b/driver-moab/main/prep_lnd_mod.F90 @@ -331,7 +331,7 @@ subroutine prep_lnd_init(infodata, atm_c2_lnd, rof_c2_lnd, glc_c2_lnd, iac_c2_ln else type1 = 1 ! this projection works (cgll to fv), but reverse does not ( fv - cgll) endif - type2 = 2; ! point cloud for target lnd in this case + type2 = 3; ! FV mesh on coupler land ierr = iMOAB_ComputeCommGraph( mbaxid, mblxid, mpicom_CPLID, mpigrp_CPLID, mpigrp_CPLID, type1, type2, & atm(1)%cplcompid, lnd(1)%cplcompid) if (ierr .ne. 0) then From e5ba721e8d9423e1f1dee5238b6d494ccd3da719 Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Fri, 13 Jan 2023 03:21:37 -0600 Subject: [PATCH 283/467] need to update mesh app on land hard to find bug --- components/elm/src/cpl/lnd_comp_mct.F90 | 3 +++ 1 file changed, 3 insertions(+) diff --git a/components/elm/src/cpl/lnd_comp_mct.F90 b/components/elm/src/cpl/lnd_comp_mct.F90 index a448370727ab..93b97f97afd2 100644 --- a/components/elm/src/cpl/lnd_comp_mct.F90 +++ b/components/elm/src/cpl/lnd_comp_mct.F90 @@ -1026,6 +1026,9 @@ subroutine init_land_moab(bounds, samegrid_al) ierr = iMOAB_SetDoubleTagStorage ( mlnid, tagname, lsz , ent_type, moab_vert_coords ) if (ierr > 0 ) & call endrun('Error: fail to set aream tag ') + ierr = iMOAB_UpdateMeshInfo( mlnid ) + if (ierr > 0 ) & + call endrun('Error: fail to update mesh info ') endif ! add more domain fields that are missing from domain fields: lat, lon, mask, hgt tagname = 'lat:lon:mask:hgt'//C_NULL_CHAR From 7fa01526fb2e7c2426f5d3bfebec9e6dbdeb1af4 Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Fri, 13 Jan 2023 03:35:55 -0600 Subject: [PATCH 284/467] put the files in iulian's directory --- driver-moab/main/cplcomp_exchange_mod.F90 | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/driver-moab/main/cplcomp_exchange_mod.F90 b/driver-moab/main/cplcomp_exchange_mod.F90 index 59cdc404012c..fcdf99a973ae 100644 --- a/driver-moab/main/cplcomp_exchange_mod.F90 +++ b/driver-moab/main/cplcomp_exchange_mod.F90 @@ -1309,9 +1309,9 @@ subroutine cplcomp_moab_Init(comp) ! on gce: ! /nfs/gce/projects/climate/inputdata/share/meshes/lnd/land_np4pg2_oQU480_230112.h5m'//C_NULL_CHAR ! iulian's laptop - outfile = '/media/iulian/ExtraDrive1/inputdata/share/meshes/lnd/land_np4pg2_oQU480_230112.h5m'//C_NULL_CHAR + !outfile = '/media/iulian/ExtraDrive1/inputdata/share/meshes/lnd/land_np4pg2_oQU480_230112.h5m'//C_NULL_CHAR ropts = 'PARALLEL=READ_PART;PARTITION=PARALLEL_PARTITION;PARALLEL_RESOLVE_SHARED_ENTS'//C_NULL_CHAR - + outfile = '/home/iulian/rofscrip/land_np4pg2_oQU480_230112.h5m'//C_NULL_CHAR nghlay = 0 ! no ghost layers ierr = iMOAB_LoadMesh(mblxid, outfile, ropts, nghlay) if (ierr .ne. 0) then @@ -1452,7 +1452,8 @@ subroutine cplcomp_moab_Init(comp) ! on gce: ! /nfs/gce/projects/climate/inputdata/share/meshes/rof/SCRIPgrid_2x2_nomask_c210211.nc'//C_NULL_CHAR ! iulian's laptop - outfile = '/media/iulian/ExtraDrive1/inputdata/share/meshes/rof/SCRIPgrid_2x2_nomask_c210211.nc'//C_NULL_CHAR + !outfile = '/media/iulian/ExtraDrive1/inputdata/share/meshes/rof/SCRIPgrid_2x2_nomask_c210211.nc'//C_NULL_CHAR + outfile = '/home/iulian/rofscrip/SCRIPgrid_2x2_nomask_c210211.nc'//C_NULL_CHAR ropts = 'PARALLEL=READ_PART;PARTITION_METHOD=RCBZOLTAN'//C_NULL_CHAR nghlay = 0 ! no ghost layers From 89ef8c7eb9a5f2f7cbed30408dfb03f917e42593 Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Fri, 13 Jan 2023 11:08:22 -0600 Subject: [PATCH 285/467] need to do atm river, not river atm --- driver-moab/main/prep_rof_mod.F90 | 88 +++++++++++++++---------------- driver-moab/shr/seq_comm_mct.F90 | 2 +- 2 files changed, 45 insertions(+), 45 deletions(-) diff --git a/driver-moab/main/prep_rof_mod.F90 b/driver-moab/main/prep_rof_mod.F90 index d9b03c10cbd1..709f3bc4d415 100644 --- a/driver-moab/main/prep_rof_mod.F90 +++ b/driver-moab/main/prep_rof_mod.F90 @@ -14,7 +14,7 @@ module prep_rof_mod use seq_comm_mct, only: mboxid ! iMOAB id for mpas ocean migrated mesh to coupler pes use seq_comm_mct, only: mbaxid ! iMOAB id for atm migrated mesh to coupler pes (migrate either mhid or mhpgx, depending on atm_pg_active) use seq_comm_mct, only: mbrxid ! iMOAB id of moab rof read on couple pes - use seq_comm_mct, only: mbintxra ! iMOAB id for intx mesh between river and atmosphere + use seq_comm_mct, only: mbintxar ! iMOAB id for intx mesh between atm and river use seq_comm_mct, only : atm_pg_active ! whether the atm uses FV mesh or not ; made true if fv_nphys > 0 use dimensions_mod, only : np ! for atmosphere degree use seq_comm_mct, only: seq_comm_getData=>seq_comm_setptrs @@ -268,73 +268,73 @@ subroutine prep_rof_init(infodata, lnd_c2_rof, atm_c2_rof) #ifdef HAVE_MOAB ! Call moab intx only if atm and ocn are init in moab if ((mbrxid .ge. 0) .and. (mbaxid .ge. 0)) then - appname = "ROF_ATM_COU"//C_NULL_CHAR + appname = "ATM_ROF_COU"//C_NULL_CHAR ! idintx is a unique number of MOAB app that takes care of intx between rof and atm mesh - idintx = 100*rof(1)%cplcompid + atm(1)%cplcompid ! something different, to differentiate it - ierr = iMOAB_RegisterApplication(trim(appname), mpicom_CPLID, idintx, mbintxra) + idintx = 100*atm(1)%cplcompid + rof(1)%cplcompid ! something different, to differentiate it + ierr = iMOAB_RegisterApplication(trim(appname), mpicom_CPLID, idintx, mbintxar) if (ierr .ne. 0) then - write(logunit,*) subname,' error in registering rof atm intx' - call shr_sys_abort(subname//' ERROR in registering rof atm intx') + write(logunit,*) subname,' error in registering atm rof intx' + call shr_sys_abort(subname//' ERROR in registering atm rof intx') endif - ierr = iMOAB_ComputeMeshIntersectionOnSphere (mbrxid, mbaxid, mbintxra) + ierr = iMOAB_ComputeMeshIntersectionOnSphere (mbaxid, mbrxid, mbintxar) if (ierr .ne. 0) then - write(logunit,*) subname,' error in computing rof atm intx' - call shr_sys_abort(subname//' ERROR in computing rof atm intx') + write(logunit,*) subname,' error in computing atm rof intx' + call shr_sys_abort(subname//' ERROR in computing atm rof intx') endif if (iamroot_CPLID) then - write(logunit,*) 'iMOAB intersection between rof atm with id:', idintx + write(logunit,*) 'iMOAB intersection between atm and rof with id:', idintx end if ! we also need to compute the comm graph for the second hop, from the rof on coupler to the ! atm for the intx rof-atm context (coverage) ! call seq_comm_getData(CPLID ,mpigrp=mpigrp_CPLID) if (atm_pg_active) then - type2 = 3; ! fv for both rof and atm; fv-cgll does not work anyway + type1 = 3; ! fv for both rof and atm; fv-cgll does not work anyway else - type2 = 1 ! this does not work anyway in this direction + type1 = 1 ! this does not work anyway in this direction endif - type1 = 3; + type2 = 3; ! ierr = iMOAB_ComputeCommGraph( mboxid, mbintxoa, &mpicom_CPLID, &mpigrp_CPLID, &mpigrp_CPLID, &type1, &type2, ! &ocn_id, &idintx) - ierr = iMOAB_ComputeCommGraph( mbrxid, mbintxra, mpicom_CPLID, mpigrp_CPLID, mpigrp_CPLID, type1, type2, & - rof(1)%cplcompid, idintx) + ierr = iMOAB_ComputeCommGraph( mbaxid, mbintxar, mpicom_CPLID, mpigrp_CPLID, mpigrp_CPLID, type1, type2, & + atm(1)%cplcompid, idintx) if (ierr .ne. 0) then write(logunit,*) subname,' error in computing comm graph for second hop, rof-atm' call shr_sys_abort(subname//' ERROR in computing comm graph for second hop, rof-atm') endif ! now take care of the mapper - mapper_Fa2r%src_mbid = mbrxid - mapper_Fa2r%tgt_mbid = mbintxra - mapper_Fa2r%intx_mbid = mbintxra + mapper_Fa2r%src_mbid = mbaxid + mapper_Fa2r%tgt_mbid = mbintxar + mapper_Fa2r%intx_mbid = mbintxar mapper_Fa2r%src_context = rof(1)%cplcompid mapper_Fa2r%intx_context = idintx wgtIdef = 'scalar'//C_NULL_CHAR mapper_Fa2r%weight_identifier = wgtIdef mapper_Fa2r%mbname = 'mapper_Fa2r' - ! because we will project fields from rof to atm grid, we need to define - ! rof r2x fields to atm grid on coupler side + ! because we will project fields from atm to rof grid, we need to define + ! rof a2x fields to rof grid on coupler side - tagname = trim(seq_flds_r2x_fields)//C_NULL_CHAR + tagname = trim(seq_flds_a2x_fields)//C_NULL_CHAR tagtype = 1 ! dense numco = 1 ! - ierr = iMOAB_DefineTagStorage(mbaxid, tagname, tagtype, numco, tagindex ) + ierr = iMOAB_DefineTagStorage(mbrxid, tagname, tagtype, numco, tagindex ) if (ierr .ne. 0) then - write(logunit,*) subname,' error in defining tags for seq_flds_r2x_fields on atm cpl' - call shr_sys_abort(subname//' ERROR in defining tags for seq_flds_r2x_fields on atm cpl') + write(logunit,*) subname,' error in defining tags for seq_flds_a2x_fields on rof cpl' + call shr_sys_abort(subname//' ERROR in defining tags for seq_flds_a2x_fields on rof cpl') endif volumetric = 0 ! can be 1 only for FV->DGLL or FV->CGLL; if (atm_pg_active) then - dm2 = "fv"//C_NULL_CHAR - dofnameT="GLOBAL_ID"//C_NULL_CHAR - orderT = 1 ! fv-fv + dm1 = "fv"//C_NULL_CHAR + dofnameS="GLOBAL_ID"//C_NULL_CHAR + orderS = 1 ! fv-fv else ! this part does not work, anyway - dm2 = "cgll"//C_NULL_CHAR - dofnameT="GLOBAL_DOFS"//C_NULL_CHAR - orderT = np ! it should be 4 + dm1 = "cgll"//C_NULL_CHAR + dofnameS="GLOBAL_DOFS"//C_NULL_CHAR + orderS = np ! it should be 4 endif - dm1 = "fv"//C_NULL_CHAR - dofnameS="GLOBAL_ID"//C_NULL_CHAR + dm2 = "fv"//C_NULL_CHAR + dofnameT="GLOBAL_ID"//C_NULL_CHAR orderS = 1 ! not much arguing fNoBubble = 1 monotonicity = 0 ! @@ -342,20 +342,20 @@ subroutine prep_rof_init(infodata, lnd_c2_rof, atm_c2_rof) validate = 1 fInverseDistanceMap = 0 if (iamroot_CPLID) then - write(logunit,*) subname, 'launch iMOAB weights with args ', 'mbintxra=', mbintxra, ' wgtIdef=', wgtIdef, & + write(logunit,*) subname, 'launch iMOAB weights with args ', 'mbintxar=', mbintxar, ' wgtIdef=', wgtIdef, & 'dm1=', trim(dm1), ' orderS=', orderS, 'dm2=', trim(dm2), ' orderT=', orderT, & fNoBubble, monotonicity, volumetric, fInverseDistanceMap, & noConserve, validate, & trim(dofnameS), trim(dofnameT) endif - ierr = iMOAB_ComputeScalarProjectionWeights ( mbintxra, wgtIdef, & + ierr = iMOAB_ComputeScalarProjectionWeights ( mbintxar, wgtIdef, & trim(dm1), orderS, trim(dm2), orderT, & fNoBubble, monotonicity, volumetric, fInverseDistanceMap, & noConserve, validate, & trim(dofnameS), trim(dofnameT) ) if (ierr .ne. 0) then - write(logunit,*) subname,' error in computing ra weights ' - call shr_sys_abort(subname//' ERROR in computing ra weights ') + write(logunit,*) subname,' error in computing ar weights ' + call shr_sys_abort(subname//' ERROR in computing ar weights ') endif #ifdef MOABDEBUG @@ -363,11 +363,11 @@ subroutine prep_rof_init(infodata, lnd_c2_rof, atm_c2_rof) call shr_mpi_commrank( mpicom_CPLID, rank ) if (rank .lt. 5) then write(lnum,"(I0.2)")rank ! - outfile = 'intx_ra_'//trim(lnum)// '.h5m' // C_NULL_CHAR - ierr = iMOAB_WriteMesh(mbintxra, outfile, wopts) ! write local intx file + outfile = 'intx_ar_'//trim(lnum)// '.h5m' // C_NULL_CHAR + ierr = iMOAB_WriteMesh(mbintxar, outfile, wopts) ! write local intx file if (ierr .ne. 0) then - write(logunit,*) subname,' error in writing intx ra file ' - call shr_sys_abort(subname//' ERROR in writing intx ra file ') + write(logunit,*) subname,' error in writing intx ar file ' + call shr_sys_abort(subname//' ERROR in writing intx ar file ') endif endif #endif @@ -384,10 +384,10 @@ subroutine prep_rof_init(infodata, lnd_c2_rof, atm_c2_rof) string='mapper_Sa2r initialization', esmf_map=esmf_map_flag) #ifdef HAVE_MOAB ! now take care of the mapper, use the same one as before - mapper_Sa2r%src_mbid = mbrxid - mapper_Sa2r%tgt_mbid = mbintxra - mapper_Sa2r%intx_mbid = mbintxra - mapper_Sa2r%src_context = rof(1)%cplcompid + mapper_Sa2r%src_mbid = mbaxid + mapper_Sa2r%tgt_mbid = mbintxar + mapper_Sa2r%intx_mbid = mbintxar + mapper_Sa2r%src_context = atm(1)%cplcompid mapper_Sa2r%intx_context = idintx wgtIdef = 'scalar'//C_NULL_CHAR mapper_Sa2r%weight_identifier = wgtIdef diff --git a/driver-moab/shr/seq_comm_mct.F90 b/driver-moab/shr/seq_comm_mct.F90 index 68cdcc4a0211..6715e75001e1 100644 --- a/driver-moab/shr/seq_comm_mct.F90 +++ b/driver-moab/shr/seq_comm_mct.F90 @@ -236,7 +236,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) - integer, public :: mbintxra ! iMOAB id for intx mesh between river and atmosphere + integer, public :: mbintxar ! iMOAB id for intx mesh between atm and river integer, public :: num_moab_exports ! iMOAB id for atm phys grid, on atm pes From b56cdf4c9e5d44a5211e409e5927988ab30e2feb Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Fri, 13 Jan 2023 11:33:10 -0600 Subject: [PATCH 286/467] land to river map l2r similar to a2r --- driver-moab/main/prep_rof_mod.F90 | 113 +++++++++++++++++++++++++++--- driver-moab/shr/seq_comm_mct.F90 | 3 + 2 files changed, 108 insertions(+), 8 deletions(-) diff --git a/driver-moab/main/prep_rof_mod.F90 b/driver-moab/main/prep_rof_mod.F90 index 709f3bc4d415..7e286a1b8569 100644 --- a/driver-moab/main/prep_rof_mod.F90 +++ b/driver-moab/main/prep_rof_mod.F90 @@ -9,12 +9,11 @@ module prep_rof_mod use seq_comm_mct, only: num_inst_lnd, num_inst_rof, num_inst_frc, num_inst_atm use seq_comm_mct, only: CPLID, ROFID, logunit use seq_comm_mct, only: mrofid ! id for rof comp - use seq_comm_mct, only: mbrmapro ! iMOAB id of moab instance of map read from rof2ocn map file - use seq_comm_mct, only: mbrxoid ! iMOAB id for rof instance on coupler for ocn - use seq_comm_mct, only: mboxid ! iMOAB id for mpas ocean migrated mesh to coupler pes + use seq_comm_mct, only: mblxid ! iMOAB id for land on coupler (read now from h5m file) use seq_comm_mct, only: mbaxid ! iMOAB id for atm migrated mesh to coupler pes (migrate either mhid or mhpgx, depending on atm_pg_active) use seq_comm_mct, only: mbrxid ! iMOAB id of moab rof read on couple pes use seq_comm_mct, only: mbintxar ! iMOAB id for intx mesh between atm and river + use seq_comm_mct, only: mbintxlr ! iMOAB id for intx mesh between land and river use seq_comm_mct, only : atm_pg_active ! whether the atm uses FV mesh or not ; made true if fv_nphys > 0 use dimensions_mod, only : np ! for atmosphere degree use seq_comm_mct, only: seq_comm_getData=>seq_comm_setptrs @@ -216,7 +215,106 @@ subroutine prep_rof_init(infodata, lnd_c2_rof, atm_c2_rof) call seq_map_init_rcfile(mapper_Fl2r, lnd(1), rof(1), & 'seq_maps.rc','lnd2rof_fmapname:','lnd2rof_fmaptype:',samegrid_lr, & string='mapper_Fl2r initialization', esmf_map=esmf_map_flag) +! similar to a2r, from below +#ifdef HAVE_MOAB + ! Call moab intx only if land and river are init in moab + if ((mblxid .ge. 0) .and. (mbrxid .ge. 0)) then + appname = "LND_ROF_COU"//C_NULL_CHAR + ! idintx is a unique number of MOAB app that takes care of intx between lnd and rof mesh + idintx = 100*lnd(1)%cplcompid + rof(1)%cplcompid ! something different, to differentiate it + ierr = iMOAB_RegisterApplication(trim(appname), mpicom_CPLID, idintx, mbintxlr) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in registering lnd rof intx' + call shr_sys_abort(subname//' ERROR in registering lnd rof intx') + endif + ierr = iMOAB_ComputeMeshIntersectionOnSphere (mblxid, mbrxid, mbintxlr) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in computing land rof intx' + call shr_sys_abort(subname//' ERROR in computing land rof intx') + endif + if (iamroot_CPLID) then + write(logunit,*) 'iMOAB intersection between land and rof with id:', idintx + end if + ! we also need to compute the comm graph for the second hop, from the lnd on coupler to the + ! lnd for the intx lnd-rof context (coverage) + ! + call seq_comm_getData(CPLID ,mpigrp=mpigrp_CPLID) + type1 = 3 ! land is FV now on coupler side + type2 = 3; + + ierr = iMOAB_ComputeCommGraph( mblxid, mbintxlr, mpicom_CPLID, mpigrp_CPLID, mpigrp_CPLID, type1, type2, & + lnd(1)%cplcompid, idintx) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in computing comm graph for second hop, lnd-rof' + call shr_sys_abort(subname//' ERROR in computing comm graph for second hop, lnd-rof') + endif + ! now take care of the mapper + mapper_Fl2r%src_mbid = mblxid + mapper_Fl2r%tgt_mbid = mbintxlr + mapper_Fl2r%intx_mbid = mbintxlr + mapper_Fl2r%src_context = rof(1)%cplcompid + mapper_Fl2r%intx_context = idintx + wgtIdef = 'scalar'//C_NULL_CHAR + mapper_Fl2r%weight_identifier = wgtIdef + mapper_Fl2r%mbname = 'mapper_Fl2r' + ! because we will project fields from lnd to rof grid, we need to define + ! the l2x fields to rof grid on coupler side + + tagname = trim(seq_flds_l2x_fields)//C_NULL_CHAR + tagtype = 1 ! dense + numco = 1 ! + ierr = iMOAB_DefineTagStorage(mbrxid, tagname, tagtype, numco, tagindex ) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in defining tags for seq_flds_a2x_fields on rof cpl' + call shr_sys_abort(subname//' ERROR in defining tags for seq_flds_a2x_fields on rof cpl') + endif + volumetric = 0 ! can be 1 only for FV->DGLL or FV->CGLL; + + dm1 = "fv"//C_NULL_CHAR + dofnameS="GLOBAL_ID"//C_NULL_CHAR + orderS = 1 ! fv-fv + + dm2 = "fv"//C_NULL_CHAR + dofnameT="GLOBAL_ID"//C_NULL_CHAR + orderS = 1 ! not much arguing + fNoBubble = 1 + monotonicity = 0 ! + noConserve = 0 + validate = 1 + fInverseDistanceMap = 0 + if (iamroot_CPLID) then + write(logunit,*) subname, 'launch iMOAB weights with args ', 'mbintxlr=', mbintxlr, ' wgtIdef=', wgtIdef, & + 'dm1=', trim(dm1), ' orderS=', orderS, 'dm2=', trim(dm2), ' orderT=', orderT, & + fNoBubble, monotonicity, volumetric, fInverseDistanceMap, & + noConserve, validate, & + trim(dofnameS), trim(dofnameT) + endif + ierr = iMOAB_ComputeScalarProjectionWeights ( mbintxlr, wgtIdef, & + trim(dm1), orderS, trim(dm2), orderT, & + fNoBubble, monotonicity, volumetric, fInverseDistanceMap, & + noConserve, validate, & + trim(dofnameS), trim(dofnameT) ) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in computing lr weights ' + call shr_sys_abort(subname//' ERROR in computing lr weights ') + endif +#ifdef MOABDEBUG + wopts = C_NULL_CHAR + call shr_mpi_commrank( mpicom_CPLID, rank ) + if (rank .lt. 5) then + write(lnum,"(I0.2)")rank ! + outfile = 'intx_ar_'//trim(lnum)// '.h5m' // C_NULL_CHAR + ierr = iMOAB_WriteMesh(mbintxar, outfile, wopts) ! write local intx file + if (ierr .ne. 0) then + write(logunit,*) subname,' error in writing intx ar file ' + call shr_sys_abort(subname//' ERROR in writing intx ar file ') + endif + endif +#endif + end if ! if ((mbrxid .ge. 0) .and. (mbaxid .ge. 0)) +! endif HAVE_MOAB +#endif ! We'll map irrigation specially, so exclude this from the list of l2r fields ! that are mapped "normally". ! @@ -266,7 +364,7 @@ subroutine prep_rof_init(infodata, lnd_c2_rof, atm_c2_rof) string='mapper_Fa2r initialization', esmf_map=esmf_map_flag) ! similar to a2o, prep_ocn #ifdef HAVE_MOAB - ! Call moab intx only if atm and ocn are init in moab + ! Call moab intx only if atm and river are init in moab if ((mbrxid .ge. 0) .and. (mbaxid .ge. 0)) then appname = "ATM_ROF_COU"//C_NULL_CHAR ! idintx is a unique number of MOAB app that takes care of intx between rof and atm mesh @@ -284,8 +382,8 @@ subroutine prep_rof_init(infodata, lnd_c2_rof, atm_c2_rof) if (iamroot_CPLID) then write(logunit,*) 'iMOAB intersection between atm and rof with id:', idintx end if - ! we also need to compute the comm graph for the second hop, from the rof on coupler to the - ! atm for the intx rof-atm context (coverage) + ! we also need to compute the comm graph for the second hop, from the atm on coupler to the + ! atm for the intx atm-rof context (coverage) ! call seq_comm_getData(CPLID ,mpigrp=mpigrp_CPLID) if (atm_pg_active) then @@ -294,8 +392,7 @@ subroutine prep_rof_init(infodata, lnd_c2_rof, atm_c2_rof) type1 = 1 ! this does not work anyway in this direction endif type2 = 3; - ! ierr = iMOAB_ComputeCommGraph( mboxid, mbintxoa, &mpicom_CPLID, &mpigrp_CPLID, &mpigrp_CPLID, &type1, &type2, - ! &ocn_id, &idintx) + ierr = iMOAB_ComputeCommGraph( mbaxid, mbintxar, mpicom_CPLID, mpigrp_CPLID, mpigrp_CPLID, type1, type2, & atm(1)%cplcompid, idintx) if (ierr .ne. 0) then diff --git a/driver-moab/shr/seq_comm_mct.F90 b/driver-moab/shr/seq_comm_mct.F90 index 6715e75001e1..e88ac0f17a23 100644 --- a/driver-moab/shr/seq_comm_mct.F90 +++ b/driver-moab/shr/seq_comm_mct.F90 @@ -237,6 +237,7 @@ module seq_comm_mct ! similar to intx id, oa, la; integer, public :: mbrxoid ! iMOAB id for rof migrated to coupler for ocean context (r2o mapping) 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 :: num_moab_exports ! iMOAB id for atm phys grid, on atm pes @@ -647,6 +648,8 @@ subroutine seq_comm_init(global_comm_in, driver_comm_in, nmlfile, drv_comm_id) mbrxid = -1 ! iMOAB id of moab rof migrated to coupler mbrmapro = -1 ! iMOAB id of moab instance of map read from rof2ocn map file mbrxoid = -1 ! iMOAB id of moab instance rof to coupler in ocean context + mbintxar = -1 ! iMOAB id for intx mesh between atm and river + mbintxlr = -1 ! iMOAB id for intx mesh between land and river num_moab_exports = 0 ! mostly used in debugging deallocate(comps,comms) From d836b438a45ac4f3a13f2627c12663ed6b6c516a Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Fri, 13 Jan 2023 12:29:50 -0600 Subject: [PATCH 287/467] do not validate land to river map and fractions on river land has gaps in global ids, we can't validate yet anyway, most validates should be off river is now FV, we need to be careful with fractions on river now --- driver-moab/main/prep_rof_mod.F90 | 10 +++++----- driver-moab/main/seq_frac_mct.F90 | 4 ++-- 2 files changed, 7 insertions(+), 7 deletions(-) diff --git a/driver-moab/main/prep_rof_mod.F90 b/driver-moab/main/prep_rof_mod.F90 index 7e286a1b8569..2c3117f5bc8d 100644 --- a/driver-moab/main/prep_rof_mod.F90 +++ b/driver-moab/main/prep_rof_mod.F90 @@ -280,7 +280,7 @@ subroutine prep_rof_init(infodata, lnd_c2_rof, atm_c2_rof) fNoBubble = 1 monotonicity = 0 ! noConserve = 0 - validate = 1 + validate = 0 fInverseDistanceMap = 0 if (iamroot_CPLID) then write(logunit,*) subname, 'launch iMOAB weights with args ', 'mbintxlr=', mbintxlr, ' wgtIdef=', wgtIdef, & @@ -304,11 +304,11 @@ subroutine prep_rof_init(infodata, lnd_c2_rof, atm_c2_rof) call shr_mpi_commrank( mpicom_CPLID, rank ) if (rank .lt. 5) then write(lnum,"(I0.2)")rank ! - outfile = 'intx_ar_'//trim(lnum)// '.h5m' // C_NULL_CHAR - ierr = iMOAB_WriteMesh(mbintxar, outfile, wopts) ! write local intx file + outfile = 'intx_lr_'//trim(lnum)// '.h5m' // C_NULL_CHAR + ierr = iMOAB_WriteMesh(mbintxlr, outfile, wopts) ! write local intx file if (ierr .ne. 0) then - write(logunit,*) subname,' error in writing intx ar file ' - call shr_sys_abort(subname//' ERROR in writing intx ar file ') + write(logunit,*) subname,' error in writing intx lr file ' + call shr_sys_abort(subname//' ERROR in writing intx lr file ') endif endif #endif diff --git a/driver-moab/main/seq_frac_mct.F90 b/driver-moab/main/seq_frac_mct.F90 index 7a6026d0accd..e58b30b3dfeb 100644 --- a/driver-moab/main/seq_frac_mct.F90 +++ b/driver-moab/main/seq_frac_mct.F90 @@ -507,9 +507,9 @@ subroutine seq_frac_init( infodata, & call shr_sys_abort(subname//' ERROR in defining tags on rof phys mesh on cpl') endif ierr = iMOAB_GetMeshInfo ( mbrxid, nvert, nvise, nbl, nsurf, nvisBC ); - arrSize = 3 * nVert(1) ! there are 3 tags + arrSize = 3 * nvise(1) ! there are 3 tags allocate(tagValues(arrSize) ) - ent_type = 0 ! vertex type, rof is point cloud + ent_type = 1 ! vertex type, rof is now FV tagValues = 0. ierr = iMOAB_SetDoubleTagStorage ( mbrxid, tagname, arrSize , ent_type, tagValues) deallocate(tagValues) From 614d3617f965c5b34583375fe279e99f376488e0 Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Fri, 13 Jan 2023 12:46:37 -0600 Subject: [PATCH 288/467] typo, need to use lnd not river --- driver-moab/main/prep_rof_mod.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/driver-moab/main/prep_rof_mod.F90 b/driver-moab/main/prep_rof_mod.F90 index 2c3117f5bc8d..ee6d12f3d983 100644 --- a/driver-moab/main/prep_rof_mod.F90 +++ b/driver-moab/main/prep_rof_mod.F90 @@ -252,7 +252,7 @@ subroutine prep_rof_init(infodata, lnd_c2_rof, atm_c2_rof) mapper_Fl2r%src_mbid = mblxid mapper_Fl2r%tgt_mbid = mbintxlr mapper_Fl2r%intx_mbid = mbintxlr - mapper_Fl2r%src_context = rof(1)%cplcompid + mapper_Fl2r%src_context = lnd(1)%cplcompid mapper_Fl2r%intx_context = idintx wgtIdef = 'scalar'//C_NULL_CHAR mapper_Fl2r%weight_identifier = wgtIdef @@ -312,7 +312,7 @@ subroutine prep_rof_init(infodata, lnd_c2_rof, atm_c2_rof) endif endif #endif - end if ! if ((mbrxid .ge. 0) .and. (mbaxid .ge. 0)) + end if ! if ((mblxid .ge. 0) .and. (mbrxid .ge. 0)) ! endif HAVE_MOAB #endif ! We'll map irrigation specially, so exclude this from the list of l2r fields From d202459120fcffbec24382051c7c3d2c7e882804 Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Fri, 13 Jan 2023 12:58:34 -0600 Subject: [PATCH 289/467] river to land map in prep_lnd --- driver-moab/main/prep_lnd_mod.F90 | 105 +++++++++++++++++++++++++++++- driver-moab/shr/seq_comm_mct.F90 | 2 + 2 files changed, 106 insertions(+), 1 deletion(-) diff --git a/driver-moab/main/prep_lnd_mod.F90 b/driver-moab/main/prep_lnd_mod.F90 index d5acae0e3540..51340d3f71ad 100644 --- a/driver-moab/main/prep_lnd_mod.F90 +++ b/driver-moab/main/prep_lnd_mod.F90 @@ -15,7 +15,10 @@ module prep_lnd_mod use seq_comm_mct, only: mphaid ! iMOAB id for phys atm on atm pes use seq_comm_mct, only: mhpgid ! iMOAB id for atm pgx grid, on atm pes; created with se and gll grids use seq_comm_mct, only: mblxid ! iMOAB id for mpas ocean migrated mesh to coupler pes - use seq_comm_mct, only: mbintxal ! iMOAB id for intx mesh between land and atmosphere + use seq_comm_mct, only: mbrxid ! iMOAB id of moab rof on coupler pes (FV now) + use seq_comm_mct, only: mbintxal ! iMOAB id for intx mesh between atm and lnd + use seq_comm_mct, only: mbintxrl ! iMOAB id for intx mesh between river and land + use seq_comm_mct, only: mbaxid ! iMOAB id for atm migrated mesh to coupler pes use seq_comm_mct, only: atm_pg_active ! whether the atm uses FV mesh or not ; made true if fv_nphys > 0 use dimensions_mod, only: np ! for atmosphere @@ -205,6 +208,106 @@ subroutine prep_lnd_init(infodata, atm_c2_lnd, rof_c2_lnd, glc_c2_lnd, iac_c2_ln 'seq_maps.rc','rof2lnd_fmapname:','rof2lnd_fmaptype:',samegrid_lr, & string='mapper_Fr2l initialization',esmf_map=esmf_map_flag) end if +! symmetric of l2r, from prep_rof +#ifdef HAVE_MOAB + ! Call moab intx only if land and river are init in moab + if ((mbrxid .ge. 0) .and. (mblxid .ge. 0)) then + appname = "ROF_LND_COU"//C_NULL_CHAR + ! idintx is a unique number of MOAB app that takes care of intx between rof and lnd mesh + idintx = 100*rof(1)%cplcompid + lnd(1)%cplcompid ! something different, to differentiate it + ierr = iMOAB_RegisterApplication(trim(appname), mpicom_CPLID, idintx, mbintxrl) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in registering rof lnd intx' + call shr_sys_abort(subname//' ERROR in registering rof lnd intx') + endif + ierr = iMOAB_ComputeMeshIntersectionOnSphere (mbrxid, mblxid, mbintxrl) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in computing rof lnd intx' + call shr_sys_abort(subname//' ERROR in computing rof lnd intx') + endif + if (iamroot_CPLID) then + write(logunit,*) 'iMOAB intersection between rof and lnd with id:', idintx + end if + ! we also need to compute the comm graph for the second hop, from the rof on coupler to the + ! rof for the intx rof-lnd context (coverage) + ! + call seq_comm_getData(CPLID ,mpigrp=mpigrp_CPLID) + type1 = 3 ! land is FV now on coupler side + type2 = 3; + + ierr = iMOAB_ComputeCommGraph( mbrxid, mbintxrl, mpicom_CPLID, mpigrp_CPLID, mpigrp_CPLID, type1, type2, & + rof(1)%cplcompid, idintx) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in computing comm graph for second hop, lnd-rof' + call shr_sys_abort(subname//' ERROR in computing comm graph for second hop, lnd-rof') + endif + ! now take care of the mapper + mapper_Fr2l%src_mbid = mbrxid + mapper_Fr2l%tgt_mbid = mbintxrl + mapper_Fr2l%intx_mbid = mbintxrl + mapper_Fr2l%src_context = rof(1)%cplcompid + mapper_Fr2l%intx_context = idintx + wgtIdef = 'scalar'//C_NULL_CHAR + mapper_Fr2l%weight_identifier = wgtIdef + mapper_Fr2l%mbname = 'mapper_Fr2l' + ! because we will project fields from rof to lnd grid, we need to define + ! the r2x fields to lnd grid on coupler side + + tagname = trim(seq_flds_r2x_fields)//C_NULL_CHAR + tagtype = 1 ! dense + numco = 1 ! + ierr = iMOAB_DefineTagStorage(mblxid, tagname, tagtype, numco, tagindex ) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in defining tags for seq_flds_r2x_fields on lnd cpl' + call shr_sys_abort(subname//' ERROR in defining tags for seq_flds_r2x_fields on lnd cpl') + endif + volumetric = 0 ! can be 1 only for FV->DGLL or FV->CGLL; + + dm1 = "fv"//C_NULL_CHAR + dofnameS="GLOBAL_ID"//C_NULL_CHAR + orderS = 1 ! fv-fv + + dm2 = "fv"//C_NULL_CHAR + dofnameT="GLOBAL_ID"//C_NULL_CHAR + orderS = 1 ! not much arguing + fNoBubble = 1 + monotonicity = 0 ! + noConserve = 0 + validate = 0 !! important + fInverseDistanceMap = 0 + if (iamroot_CPLID) then + write(logunit,*) subname, 'launch iMOAB weights with args ', 'mbintxrl=', mbintxrl, ' wgtIdef=', wgtIdef, & + 'dm1=', trim(dm1), ' orderS=', orderS, 'dm2=', trim(dm2), ' orderT=', orderT, & + fNoBubble, monotonicity, volumetric, fInverseDistanceMap, & + noConserve, validate, & + trim(dofnameS), trim(dofnameT) + endif + ierr = iMOAB_ComputeScalarProjectionWeights ( mbintxrl, wgtIdef, & + trim(dm1), orderS, trim(dm2), orderT, & + fNoBubble, monotonicity, volumetric, fInverseDistanceMap, & + noConserve, validate, & + trim(dofnameS), trim(dofnameT) ) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in computing rl weights ' + call shr_sys_abort(subname//' ERROR in computing rl weights ') + endif + +#ifdef MOABDEBUG + wopts = C_NULL_CHAR + call shr_mpi_commrank( mpicom_CPLID, rank ) + if (rank .lt. 5) then + write(lnum,"(I0.2)")rank ! + outfile = 'intx_rl_'//trim(lnum)// '.h5m' // C_NULL_CHAR + ierr = iMOAB_WriteMesh(mbintxrl, outfile, wopts) ! write local intx file + if (ierr .ne. 0) then + write(logunit,*) subname,' error in writing intx rl file ' + call shr_sys_abort(subname//' ERROR in writing intx rl file ') + endif + endif +#endif + end if ! if ((mbrxid .ge. 0) .and. (mblxid .ge. 0)) +! endif HAVE_MOAB +#endif call shr_sys_flush(logunit) if (atm_c2_lnd) then diff --git a/driver-moab/shr/seq_comm_mct.F90 b/driver-moab/shr/seq_comm_mct.F90 index e88ac0f17a23..ea480b958e0f 100644 --- a/driver-moab/shr/seq_comm_mct.F90 +++ b/driver-moab/shr/seq_comm_mct.F90 @@ -238,6 +238,7 @@ module seq_comm_mct integer, public :: mbrxoid ! iMOAB id for rof migrated to coupler for ocean context (r2o mapping) 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 integer, public :: num_moab_exports ! iMOAB id for atm phys grid, on atm pes @@ -650,6 +651,7 @@ subroutine seq_comm_init(global_comm_in, driver_comm_in, nmlfile, drv_comm_id) mbrxoid = -1 ! iMOAB id of moab instance rof to coupler in ocean context mbintxar = -1 ! iMOAB id for intx mesh between atm and river mbintxlr = -1 ! iMOAB id for intx mesh between land and river + mbintxrl = -1 ! iMOAB id for intx mesh between river and land num_moab_exports = 0 ! mostly used in debugging deallocate(comps,comms) From f263934effcc82f8ceac69b000d82e8f64cff949 Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Fri, 13 Jan 2023 14:40:59 -0600 Subject: [PATCH 290/467] land merge in moab does just documentation all fields are projected not much merging --- driver-moab/main/cime_comp_mod.F90 | 1 + driver-moab/main/prep_lnd_mod.F90 | 90 ++++++++++++++++++++++++++++++ driver-moab/main/prep_ocn_mod.F90 | 2 +- 3 files changed, 92 insertions(+), 1 deletion(-) diff --git a/driver-moab/main/cime_comp_mod.F90 b/driver-moab/main/cime_comp_mod.F90 index 1176d8ec73aa..bfc7d48edc49 100644 --- a/driver-moab/main/cime_comp_mod.F90 +++ b/driver-moab/main/cime_comp_mod.F90 @@ -4462,6 +4462,7 @@ subroutine cime_run_lnd_setup_send() if (lnd_prognostic) then call prep_lnd_mrg(infodata, timer_mrg='CPL:lndprep_mrgx2l') + call prep_lnd_mrg_moab(infodata) call component_diag(infodata, lnd, flow='x2c', comment= 'send lnd', & info_debug=info_debug, timer_diag='CPL:lndprep_diagav') diff --git a/driver-moab/main/prep_lnd_mod.F90 b/driver-moab/main/prep_lnd_mod.F90 index 51340d3f71ad..1d4de66445f3 100644 --- a/driver-moab/main/prep_lnd_mod.F90 +++ b/driver-moab/main/prep_lnd_mod.F90 @@ -48,6 +48,8 @@ module prep_lnd_mod public :: prep_lnd_init public :: prep_lnd_mrg + ! moab version + public :: prep_lnd_mrg_moab public :: prep_lnd_calc_a2x_lx public :: prep_lnd_calc_r2x_lx @@ -572,6 +574,94 @@ subroutine prep_lnd_mrg(infodata, timer_mrg) end subroutine prep_lnd_mrg +! this does almost nothing now, except documenting + subroutine prep_lnd_mrg_moab (infodata) + type(seq_infodata_type) , intent(in) :: infodata + + + type(mct_avect) , pointer :: a2x_l ! used just for indexing + type(mct_avect) , pointer :: r2x_l + type(mct_avect) , pointer :: g2x_l + type(mct_avect) , pointer :: x2l_l + + !-------------------------------------------------- + + character(*), parameter :: subname = '(prep_lnd_mrg_moab)' + + ! this routine does mostly nothing for moab, no fields are actually combined + ! keep it here for documentation mostly + ! Description + ! Create input land state directly from atm, runoff and glc outputs + ! + !----------------------------------------------------------------------- + integer :: nflds,i,i1,o1 + logical :: iamroot + logical, save :: first_time = .true. + character(CL),allocatable :: mrgstr(:) ! temporary string + character(CL) :: field ! string converted to char + type(mct_aVect_sharedindices),save :: a2x_sharedindices + type(mct_aVect_sharedindices),save :: r2x_sharedindices + type(mct_aVect_sharedindices),save :: g2x_sharedindices + + !----------------------------------------------------------------------- + + call seq_comm_getdata(CPLID, iamroot=iamroot) + + if (first_time) then + a2x_l => a2x_lx(1) + r2x_l => r2x_lx(1) + g2x_l => g2x_lx(1) + x2l_l => component_get_x2c_cx(lnd(1)) + nflds = mct_aVect_nRattr(x2l_l) + + allocate(mrgstr(nflds)) + do i = 1,nflds + field = mct_aVect_getRList2c(i, x2l_l) + mrgstr(i) = subname//'x2l%'//trim(field)//' =' + enddo + + call mct_aVect_setSharedIndices(a2x_l, x2l_l, a2x_SharedIndices) + call mct_aVect_setSharedIndices(r2x_l, x2l_l, r2x_SharedIndices) + call mct_aVect_setSharedIndices(g2x_l, x2l_l, g2x_SharedIndices) + + !--- document copy operations --- + do i=1,a2x_SharedIndices%shared_real%num_indices + i1=a2x_SharedIndices%shared_real%aVindices1(i) + o1=a2x_SharedIndices%shared_real%aVindices2(i) + field = mct_aVect_getRList2c(i1, a2x_l) + mrgstr(o1) = trim(mrgstr(o1))//' = a2x%'//trim(field) + enddo + do i=1,r2x_SharedIndices%shared_real%num_indices + i1=r2x_SharedIndices%shared_real%aVindices1(i) + o1=r2x_SharedIndices%shared_real%aVindices2(i) + field = mct_aVect_getRList2c(i1, r2x_l) + mrgstr(o1) = trim(mrgstr(o1))//' = r2x%'//trim(field) + enddo + do i=1,g2x_SharedIndices%shared_real%num_indices + i1=g2x_SharedIndices%shared_real%aVindices1(i) + o1=g2x_SharedIndices%shared_real%aVindices2(i) + field = mct_aVect_getRList2c(i1, g2x_l) + mrgstr(o1) = trim(mrgstr(o1))//' = g2x%'//trim(field) + enddo + endif + + ! call mct_aVect_copy(aVin=a2x_l, aVout=x2l_l, vector=mct_usevector, sharedIndices=a2x_SharedIndices) + ! call mct_aVect_copy(aVin=r2x_l, aVout=x2l_l, vector=mct_usevector, sharedIndices=r2x_SharedIndices) + ! call mct_aVect_copy(aVin=g2x_l, aVout=x2l_l, vector=mct_usevector, sharedIndices=g2x_SharedIndices) + + if (first_time) then + if (iamroot) then + write(logunit,'(A)') subname//' Summary:' + do i = 1,nflds + write(logunit,'(A)') trim(mrgstr(i)) + enddo + endif + deallocate(mrgstr) + endif + + first_time = .false. + + end subroutine prep_lnd_mrg_moab !================================================================================================ subroutine prep_lnd_merge( a2x_l, r2x_l, g2x_l, x2l_l ) diff --git a/driver-moab/main/prep_ocn_mod.F90 b/driver-moab/main/prep_ocn_mod.F90 index 08634e99b378..87b5132e17dc 100644 --- a/driver-moab/main/prep_ocn_mod.F90 +++ b/driver-moab/main/prep_ocn_mod.F90 @@ -1524,7 +1524,7 @@ subroutine prep_ocn_mrg_moab(infodata, xao_ox) x2o_om(n,index_x2o_Faxa_snow ) x2o_om(n,index_x2o_Foxx_rofl) = (r2x_om(n,index_r2x_Forr_rofl ) + & - r2x_om(n,index_r2x_Flrr_flood) ) * flux_epbalfact + r2x_om(n,index_r2x_Flrr_flood) ) ! g2x_om(n,index_g2x_Fogg_rofl )) * flux_epbalfact x2o_om(n,index_x2o_Foxx_rofi) = (r2x_om(n,index_r2x_Forr_rofi ) ) * flux_epbalfact ! g2x_om(n,index_g2x_Fogg_rofi )) * flux_epbalfact From 58b98dbd39b857dc42a5d9394bea7f9e2b17a0d3 Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Fri, 13 Jan 2023 19:29:08 -0600 Subject: [PATCH 291/467] land import first pass --- components/elm/src/cpl/lnd_comp_mct.F90 | 1331 ++++++++++++++++++++++- driver-moab/main/prep_ocn_mod.F90 | 8 +- 2 files changed, 1334 insertions(+), 5 deletions(-) diff --git a/components/elm/src/cpl/lnd_comp_mct.F90 b/components/elm/src/cpl/lnd_comp_mct.F90 index 93b97f97afd2..27c266afbf45 100644 --- a/components/elm/src/cpl/lnd_comp_mct.F90 +++ b/components/elm/src/cpl/lnd_comp_mct.F90 @@ -13,6 +13,7 @@ module lnd_comp_mct use decompmod , only : bounds_type, ldecomp use lnd_import_export use iso_c_binding + use elm_cpl_indices #ifdef HAVE_MOAB use seq_comm_mct, only: mlnid! id of moab land app @@ -34,9 +35,13 @@ module lnd_comp_mct #ifdef HAVE_MOAB private :: init_land_moab ! create moab mesh (cloud of points) - private :: lnd_export_moab ! it should be part of lnd_import_export, but we will keep it here + private :: lnd_export_moab ! it could be part of lnd_import_export, but we will keep it here + private :: lnd_import_moab ! it could be part of lnd_import_export, but we will keep it here integer , private :: mblsize, totalmbls - real (r8) , allocatable, private :: l2x_lm(:,:) ! for tags in MOAB + real (r8) , allocatable, private :: l2x_lm(:,:) ! for tags to be set in MOAB + + integer :: nrecv, totalmblsimp + real (r8) , allocatable, private :: x2l_lm(:,:) ! for tags from MOAB logical :: sameg_al ! save it for export :) #endif !--------------------------------------------------------------------------- @@ -336,6 +341,13 @@ subroutine lnd_init_mct( EClock, cdata_l, x2l_l, l2x_l, NLFilename ) nsend = mct_avect_nRattr(l2x_l) totalmbls = mblsize * nsend ! size of the double array allocate (l2x_lm(lsz, nsend) ) + + nrecv = mct_avect_nRattr(x2l_l) ! number of fields retrived from MOAB tags, based on names from seq_flds_x2l_fields + totalmblsimp = mblsize * nrecv ! size of the double array to fill with data from MOAB + allocate (x2l_lm(lsz, nrecv) ) + if (masterproc) then + write(iulog,*) sub, 'mblsize= ',mblsize,' nsend, nrecv for moab:', nsend, nrecv + end if #endif ! Finish initializing elm @@ -519,6 +531,11 @@ subroutine lnd_run_mct(EClock, cdata_l, x2l_l, l2x_l) ! Map to elm (only when state and/or fluxes need to be updated) call t_startf ('lc_lnd_import') + ! first call moab import +#ifdef HAVE_MOAB + call lnd_import_moab( bounds, atm2lnd_vars, glc2lnd_vars) +#endif + call lnd_import( bounds, x2l_l%rattr, atm2lnd_vars, glc2lnd_vars) call t_stopf ('lc_lnd_import') @@ -646,6 +663,7 @@ subroutine lnd_final_mct( EClock, cdata_l, x2l_l, l2x_l) #ifdef HAVE_MOAB ! deallocate moab fields array deallocate (l2x_lm) + deallocate (x2l_lm) #endif call final() @@ -1219,6 +1237,1315 @@ subroutine lnd_export_moab( bounds, lnd2atm_vars, lnd2glc_vars) #endif end subroutine lnd_export_moab + + ! lnd_import_moab will be a copy of lnd_import + ! data will come from moab tags, from mlnid iMOAB app + ! the role of x2l_l AV is taken by the local array x2l_lm, allocated at init stage, with + ! the order of tags given by seq_flds_x2l_fields + + !=============================================================================== + subroutine lnd_import_moab( bounds, atm2lnd_vars, glc2lnd_vars) + + !--------------------------------------------------------------------------- + ! !DESCRIPTION: + ! Convert the input data from the moab coupler to the land model + use seq_flds_mod , only : seq_flds_l2x_fields, seq_flds_x2l_fields + use iMOAB, only : iMOAB_GetDoubleTagStorage + ! !USES: + use elm_varctl , only: co2_type, co2_ppmv, iulog, use_c13, create_glacier_mec_landunit, & + metdata_type, metdata_bypass, metdata_biases, co2_file, aero_file + use elm_varctl , only: const_climate_hist, add_temperature, add_co2, use_cn, use_fates + use elm_varctl , only: startdate_add_temperature, startdate_add_co2 + use elm_varcon , only: rair, o2_molar_const, c13ratio + use clm_time_manager , only: get_nstep, get_step_size, get_curr_calday, get_curr_date + use controlMod , only: NLFilename + use shr_const_mod , only: SHR_CONST_TKFRZ, SHR_CONST_STEBOL + use domainMod , only: ldomain + use shr_kind_mod , only: r8 => shr_kind_r8, CL => shr_kind_CL + use fileutils , only: getavu, relavu + use spmdmod , only: masterproc, mpicom, iam, npes, MPI_REAL8, MPI_INTEGER, MPI_STATUS_SIZE + use elm_nlUtilsMod , only : find_nlgroup_name + use netcdf + ! + ! !ARGUMENTS: + type(bounds_type) , intent(in) :: bounds ! bounds + ! real(r8) , intent(in) :: x2l(:,:) ! driver import state to land model + ! this is moab version, will be replaced with x2l_lm from mlnid + type(atm2lnd_type) , intent(inout) :: atm2lnd_vars ! clm internal input data type + type(glc2lnd_type) , intent(inout) :: glc2lnd_vars ! clm internal input data type + ! + ! !LOCAL VARIABLES: + integer :: g,topo,i,m,thism,nstep,ier ! indices, number of steps, and error code + integer status(MPI_STATUS_SIZE) + real(r8) :: forc_rainc ! rainxy Atm flux mm/s + real(r8) :: e, ea ! vapor pressure (Pa) + real(r8) :: qsat ! saturation specific humidity (kg/kg) + real(r8) :: forc_t ! atmospheric temperature (Kelvin) + real(r8) :: forc_q ! atmospheric specific humidity (kg/kg) + real(r8) :: forc_pbot ! atmospheric pressure (Pa) + real(r8) :: forc_rainl ! rainxy Atm flux mm/s + real(r8) :: forc_snowc ! snowfxy Atm flux mm/s + real(r8) :: forc_snowl ! snowfxl Atm flux mm/s + real(r8) :: co2_ppmv_diag ! temporary + real(r8) :: co2_ppmv_prog ! temporary + real(r8) :: co2_ppmv_val ! temporary + integer :: co2_type_idx ! integer flag for co2_type options + real(r8) :: esatw ! saturation vapor pressure over water (Pa) + real(r8) :: esati ! saturation vapor pressure over ice (Pa) + real(r8) :: a0,a1,a2,a3,a4,a5,a6 ! coefficients for esat over water + real(r8) :: b0,b1,b2,b3,b4,b5,b6 ! coefficients for esat over ice + real(r8) :: tdc, t ! Kelvins to Celcius function and its input + real(r8) :: vp ! water vapor pressure (Pa) + integer :: thisng, np, num, nu_nml, nml_error + integer :: ng_all(100000) + real(r8) :: swndf, swndr, swvdf, swvdr, ratio_rvrf, frac, q + real(r8) :: thiscosz, avgcosz, szenith + integer :: swrad_period_len, swrad_period_start, thishr, thismin + real(r8) :: timetemp(2) + real(r8) :: latixy(500000), longxy(500000) + integer :: ierr, varid, dimid, yr, mon, day, tod, nindex(2), caldaym(13) + integer :: ncid, met_ncids(14), mask_ncid, thisncid, ng, tm + integer :: aindex(2), tindex(14,2), starti(3), counti(3) + integer :: grid_map(500000), zone_map(500000) + integer :: met_nvars, nyears_spinup, nyears_trans, starti_site, endi_site + real(r8) :: smap05_lat(360), smap05_lon(720) + real(r8) :: smapt62_lat(94), smapt62_lon(192) + real(r8) :: smap2_lat(96), smap2_lon(144) + real(r8) :: thisdist, mindist, thislon + real(r8) :: tbot, tempndep(1,1,158), thiscalday, wt1(14), wt2(14), thisdoy + real(r8) :: site_metdata(14,12) + real(r8) :: var_month_mean(12) + !real(r8) :: hdm1(720,360,1), hdm2(720,360,1) + !real(r8) :: lnfm1(192,94,2920) + !real(r8) :: ndep1(144,96,1), ndep2(144,96,1) + !real(r8) :: aerodata(14,144,96,14) + integer :: lnfmind(2) + integer :: var_month_count(12) + integer*2 :: temp(1,500000) + integer :: xtoget, ytoget, thisx, thisy, calday_start + integer :: sdate_addt, sy_addt, sm_addt, sd_addt + integer :: sdate_addco2, sy_addco2, sm_addco2, sd_addco2 + character(len=200) metsource_str, thisline + character(len=*), parameter :: sub = 'lnd_import_moab' + integer :: av, v, n, nummetdims, g3, gtoget, ztoget, line, mystart, tod_start, thistimelen + character(len=20) aerovars(14), metvars(14) + character(len=3) zst + integer :: stream_year_first_lightng, stream_year_last_lightng, model_year_align_lightng + integer :: stream_year_first_popdens, stream_year_last_popdens, model_year_align_popdens + integer :: stream_year_first_ndep, stream_year_last_ndep, model_year_align_ndep + character(len=CL) :: metdata_fname + character(len=CL) :: lightngmapalgo = 'bilinear'! Mapping alogrithm + character(len=CL) :: popdensmapalgo = 'bilinear' + character(len=CL) :: ndepmapalgo = 'bilinear' + character(len=CL) :: stream_fldFileName_lightng ! lightning stream filename to read + character(len=CL) :: stream_fldFileName_popdens ! poplulation density stream filename + character(len=CL) :: stream_fldFileName_ndep ! nitrogen deposition stream filename + logical :: use_sitedata, has_zonefile, use_daymet, use_livneh + +! moab extra stuff + character(400) :: tagname ! hold all fields names + integer :: ent_type ! for setting data + + data caldaym / 1, 32, 60, 91, 121, 152, 182, 213, 244, 274, 305, 335, 366 / + + ! Constants to compute vapor pressure + parameter (a0=6.107799961_r8 , a1=4.436518521e-01_r8, & + a2=1.428945805e-02_r8, a3=2.650648471e-04_r8, & + a4=3.031240396e-06_r8, a5=2.034080948e-08_r8, & + a6=6.136820929e-11_r8) + + parameter (b0=6.109177956_r8 , b1=5.034698970e-01_r8, & + b2=1.886013408e-02_r8, b3=4.176223716e-04_r8, & + b4=5.824720280e-06_r8, b5=4.838803174e-08_r8, & + b6=1.838826904e-10_r8) + ! + ! function declarations + ! + tdc(t) = min( 50._r8, max(-50._r8,(t-SHR_CONST_TKFRZ)) ) + esatw(t) = 100._r8*(a0+t*(a1+t*(a2+t*(a3+t*(a4+t*(a5+t*a6)))))) + esati(t) = 100._r8*(b0+t*(b1+t*(b2+t*(b3+t*(b4+t*(b5+t*b6)))))) + !--------------------------------------------------------------------------- + + namelist /light_streams/ & + stream_year_first_lightng, & + stream_year_last_lightng, & + model_year_align_lightng, & + lightngmapalgo, & + stream_fldFileName_lightng + + namelist /popd_streams/ & + stream_year_first_popdens, & + stream_year_last_popdens, & + model_year_align_popdens, & + popdensmapalgo, & + stream_fldFileName_popdens + + namelist /ndepdyn_nml/ & + stream_year_first_ndep, & + stream_year_last_ndep, & + model_year_align_ndep, & + ndepmapalgo, & + stream_fldFileName_ndep + + stream_fldFileName_lightng = ' ' + stream_fldFileName_popdens = ' ' + + co2_type_idx = 0 + if (co2_type == 'prognostic') then + co2_type_idx = 1 + else if (co2_type == 'diagnostic') then + co2_type_idx = 2 + end if + if (co2_type == 'prognostic' .and. index_x2l_Sa_co2prog == 0) then + call endrun( sub//' ERROR: must have nonzero index_x2l_Sa_co2prog for co2_type equal to prognostic' ) + else if (co2_type == 'diagnostic' .and. index_x2l_Sa_co2diag == 0) then + call endrun( sub//' ERROR: must have nonzero index_x2l_Sa_co2diag for co2_type equal to diagnostic' ) + end if + + tagname=trim(seq_flds_x2l_fields)//C_NULL_CHAR + if (sameg_al) then + ent_type = 0 ! vertices, cells only if sameg_al false + else + ent_type = 1 + endif + ierr = iMOAB_GetDoubleTagStorage ( mlnid, tagname, totalmblsimp , ent_type, x2l_lm(1,1) ) + if ( ierr > 0) then + call endrun('Error: fail to get seq_flds_x2l_fields for land moab instance on component') + endif + + ! Note that the precipitation fluxes received from the coupler + ! are in units of kg/s/m^2. To convert these precipitation rates + ! in units of mm/sec, one must divide by 1000 kg/m^3 and multiply + ! by 1000 mm/m resulting in an overall factor of unity. + ! Below the units are therefore given in mm/s. + + thisng = bounds%endg - bounds%begg + 1 + do g = bounds%begg,bounds%endg + i = 1 + (g - bounds%begg) + + ! Determine flooding input, sign convention is positive downward and + ! hierarchy is atm/glc/lnd/rof/ice/ocn. so water sent from rof to land is negative, + ! change the sign to indicate addition of water to system. + + atm2lnd_vars%forc_flood_grc(g) = -x2l_lm(i,index_x2l_Flrr_flood) + + atm2lnd_vars%volr_grc(g) = x2l_lm(i,index_x2l_Flrr_volr) * (ldomain%area(g) * 1.e6_r8) + atm2lnd_vars%volrmch_grc(g)= x2l_lm(i,index_x2l_Flrr_volrmch) * (ldomain%area(g) * 1.e6_r8) + atm2lnd_vars%supply_grc(g) = x2l_lm(i,index_x2l_Flrr_supply) + atm2lnd_vars%deficit_grc(g) = x2l_lm(i,index_x2l_Flrr_deficit) + + ! Determine required receive fields + +#ifdef CPL_BYPASS + !read forcing data directly, bypass coupler + atm2lnd_vars%forc_flood_grc(g) = 0._r8 + atm2lnd_vars%volr_grc(g) = 0._r8 + + !Get meteorological data, concatenated to include whole record + !Note we only do this at the first timestep and keep the whole forcing dataset in the memory + + !-----------------------------------Meteorological forcing ----------------------------------- + + call get_curr_date( yr, mon, day, tod ) + thiscalday = get_curr_calday() + nstep = get_nstep() + + !on first timestep, read all the met data for relevant gridcell(s) and store in array. + ! Met data are held in short integer format to save memory. + ! Each node must have enough memory to hold these data. + met_nvars=7 + if (metdata_type(1:3) == 'cpl') met_nvars=14 + + if (atm2lnd_vars%loaded_bypassdata == 0) then + !meteorological forcing + if (index(metdata_type, 'qian') .gt. 0) then + atm2lnd_vars%metsource = 0 + else if (index(metdata_type,'cru') .gt. 0) then + atm2lnd_vars%metsource = 1 + else if (index(metdata_type,'site') .gt. 0) then + atm2lnd_vars%metsource = 2 + else if (index(metdata_type,'princeton') .gt. 0) then + atm2lnd_vars%metsource = 3 + else if (index(metdata_type,'gswp3') .gt. 0) then + atm2lnd_vars%metsource = 4 + else if (index(metdata_type,'cpl') .gt. 0) then + atm2lnd_vars%metsource = 5 + else + call endrun( sub//' ERROR: Invalid met data source for cpl_bypass' ) + end if + + use_livneh = .false. + use_daymet = .false. + if(index(metdata_type, 'livneh') .gt. 0) then + use_livneh = .true. + else if (index(metdata_type, 'daymet') .gt. 0) then + use_daymet = .true. + end if + + metvars(1) = 'TBOT' + metvars(2) = 'PSRF' + metvars(3) = 'QBOT' + if (atm2lnd_vars%metsource .eq. 2) metvars(3) = 'RH' + if (atm2lnd_vars%metsource .ne. 5) metvars(4) = 'FSDS' + if (atm2lnd_vars%metsource .ne. 5) metvars(5) = 'PRECTmms' + if (atm2lnd_vars%metsource .ne. 5) metvars(6) = 'WIND' + metvars(4) = 'FSDS' + metvars(5) = 'PRECTmms' + metvars(6) = 'WIND' + metvars(7) = 'FLDS' + if (atm2lnd_vars%metsource .eq. 5) then + metvars(4) = 'SWNDF' + metvars(5) = 'RAINC' + metvars(6) = 'U' + metvars(8) = 'SWNDR' + metvars(9) = 'SWVDF' + metvars(10) = 'SWVDR' + metvars(11) = 'RAINL' + metvars(12) = 'SNOWC' + metvars(13) = 'SNOWL' + metvars(14) = 'V' + else + metvars(4) = 'FSDS' + metvars(5) = 'PRECTmms' + metvars(6) = 'WIND' + end if + + !set defaults + atm2lnd_vars%startyear_met = 1901 + atm2lnd_vars%endyear_met_spinup = 1920 + if (atm2lnd_vars%metsource == 0) then + metsource_str = 'qian' + atm2lnd_vars%startyear_met = 1948 + atm2lnd_vars%endyear_met_spinup = 1972 + atm2lnd_vars%endyear_met_trans = 2004 + else if (atm2lnd_vars%metsource == 1) then + metsource_str = 'cruncep' + atm2lnd_vars%endyear_met_trans = 2016 + else if (atm2lnd_vars%metsource == 2) then + metsource_str = 'site' + !get year information from file + ierr = nf90_open(trim(metdata_bypass) // '/all_hourly.nc', nf90_nowrite, ncid) + ierr = nf90_inq_varid(ncid, 'start_year', varid) + ierr = nf90_get_var(ncid, varid, atm2lnd_vars%startyear_met) + ierr = nf90_inq_varid(ncid, 'end_year', varid) + ierr = nf90_get_var(ncid, varid, atm2lnd_vars%endyear_met_spinup) + ierr = nf90_close(ncid) + atm2lnd_vars%endyear_met_trans = atm2lnd_vars%endyear_met_spinup + else if (atm2lnd_vars%metsource == 3) then + metsource_str = 'princeton' + atm2lnd_vars%endyear_met_trans = 2012 + else if (atm2lnd_vars%metsource == 4) then + atm2lnd_vars%endyear_met_trans = 2014 + else if (atm2lnd_vars%metsource == 5) then + atm2lnd_vars%startyear_met = 566 !76 + atm2lnd_vars%endyear_met_spinup = 590 !100 + atm2lnd_vars%endyear_met_trans = 590 !100 + end if + + if (use_livneh) then + atm2lnd_vars%startyear_met = 1950 + atm2lnd_vars%endyear_met_spinup = 1969 + else if (use_daymet) then + atm2lnd_vars%startyear_met = 1980 + atm2lnd_vars%endyear_met_spinup = atm2lnd_vars%endyear_met_trans + end if + + nyears_spinup = atm2lnd_vars%endyear_met_spinup - & + atm2lnd_vars%startyear_met + 1 + nyears_trans = atm2lnd_vars%endyear_met_trans - & + atm2lnd_vars%startyear_met + 1 + + !check for site data in run directory (monthly mean T, precip) + inquire(file=trim(metdata_biases), exist=use_sitedata) + + !get grid lat/lon information, zone mappings + inquire(file=trim(metdata_bypass) // '/zone_mappings.txt', exist=has_zonefile) + if (has_zonefile) then + open(unit=13, file=trim(metdata_bypass) // '/zone_mappings.txt') + else if (atm2lnd_vars%metsource .ne. 2) then + call endrun( sub//' ERROR: Zone mapping file does not exist for cpl_bypass' ) + end if + + if (atm2lnd_vars%metsource .ne. 2) then + ng = 0 !number of points + do v=1,500000 + read(13,*, end=10), longxy(v), latixy(v), zone_map(v), grid_map(v) + ng = ng + 1 + end do +10 continue + close(unit=13) + + !Figure out the closest point and which zone file to open + mindist=99999 + do g3 = 1,ng + thisdist = 100*((latixy(g3) - ldomain%latc(g))**2 + & + (longxy(g3) - ldomain%lonc(g))**2)**0.5 + if (thisdist .lt. mindist) then + mindist = thisdist + ztoget = zone_map(g3) + gtoget = grid_map(g3) + end if + end do + else + gtoget = 1 + end if + + !get the site metdata for bias correction if they exist (lat/lons must match domain file) + if (use_sitedata) then + open(unit=9, file=trim(metdata_biases),status='old') + read(9,*) thisline + site_metdata(:,:)=-999._r8 + do while ((site_metdata(1,1) .lt. ldomain%lonc(g) - 0.01 .or. & + site_metdata(1,1) .gt. ldomain%lonc(g) + 0.01) .and. & + (site_metdata(2,1) .lt. ldomain%latc(g) - 0.01 .or. & + site_metdata(2,1) .gt. ldomain%latc(g) + 0.01)) + read(9,*) site_metdata(1:7,1) + if (site_metdata(1,1) .lt. 0) site_metdata(1,1) = site_metdata(1,1)+360._r8 + end do + do line=2,12 + read(9,*) site_metdata(1:7,line) + end do + close(unit=9) + end if + + do v=1,met_nvars + write(zst, '(I3)') 100+ztoget + if (atm2lnd_vars%metsource == 0) then + metdata_fname = trim(metsource_str) // '_' // trim(metvars(v)) // '_z' // zst(2:3) // '.nc' + else if (atm2lnd_vars%metsource == 1) then + metdata_fname = 'CRUNCEP.v5_' // trim(metvars(v)) // '_1901-2013_z' // zst(2:3) // '.nc' + if (use_livneh .and. ztoget .ge. 16 .and. ztoget .le. 20) then + metdata_fname = 'CRUNCEP5_Livneh_' // trim(metvars(v)) // '_1950-2013_z' // zst(2:3) // '.nc' + else if (use_daymet .and. ztoget .ge. 16 .and. ztoget .le. 20) then + metdata_fname = 'CRUNCEP5_Daymet3_' // trim(metvars(v)) // '_1980-2013_z' // zst(2:3) // '.nc' + end if + else if (atm2lnd_vars%metsource == 2) then + metdata_fname = 'all_hourly.nc' + else if (atm2lnd_vars%metsource == 3) then + metdata_fname = 'Princeton_' // trim(metvars(v)) // '_1901-2012_z' // zst(2:3) // '.nc' + if (use_livneh .and. ztoget .ge. 16 .and. ztoget .le. 20) then + metdata_fname = 'Princeton_Livneh_' // trim(metvars(v)) // '_1950-2012_z' // zst(2:3) // '.nc' + else if (use_daymet .and. ztoget .ge. 16 .and. ztoget .le. 20) then + metdata_fname = 'Princeton_Daymet3_' // trim(metvars(v)) // '_1980-2012_z' // zst(2:3) // '.nc' + end if + else if (atm2lnd_vars%metsource == 4) then + metdata_fname = 'GSWP3_' // trim(metvars(v)) // '_1901-2014_z' // zst(2:3) // '.nc' + if (use_livneh .and. ztoget .ge. 16 .and. ztoget .le. 20) then + metdata_fname = 'GSWP3_Livneh_' // trim(metvars(v)) // '_1950-2010_z' // zst(2:3) // '.nc' + else if (use_daymet .and. ztoget .ge. 16 .and. ztoget .le. 20) then + metdata_fname = 'GSWP3_Daymet3_' // trim(metvars(v)) // '_1980-2010_z' // zst(2:3) // '.nc' + end if + else if (atm2lnd_vars%metsource == 5) then + !metdata_fname = 'WCYCL1850S.ne30_' // trim(metvars(v)) // '_0076-0100_z' // zst(2:3) // '.nc' + metdata_fname = 'CBGC1850S.ne30_' // trim(metvars(v)) // '_0566-0590_z' // zst(2:3) // '.nc' + end if + + ierr = nf90_open(trim(metdata_bypass) // '/' // trim(metdata_fname), NF90_NOWRITE, met_ncids(v)) + if (ierr .ne. 0) call endrun(msg=' ERROR: Failed to open cpl_bypass input meteorology file' ) + + !get timestep information + ierr = nf90_inq_dimid(met_ncids(v), 'DTIME', dimid) + ierr = nf90_Inquire_Dimension(met_ncids(v), dimid, len = atm2lnd_vars%timelen(v)) + + starti(1) = 1 + counti(1) = 2 + ierr = nf90_inq_varid(met_ncids(v), 'DTIME', varid) + ierr = nf90_get_var(met_ncids(v), varid, timetemp, starti(1:1), counti(1:1)) + atm2lnd_vars%timeres(v) = (timetemp(2)-timetemp(1))*24._r8 + atm2lnd_vars%npf(v) = 86400d0*(timetemp(2)-timetemp(1))/get_step_size() + atm2lnd_vars%timelen_spinup(v) = nyears_spinup*(365*nint(24./atm2lnd_vars%timeres(v))) + + ierr = nf90_inq_varid(met_ncids(v), trim(metvars(v)), varid) + !get the conversion factors + ierr = nf90_get_att(met_ncids(v), varid, 'scale_factor', atm2lnd_vars%scale_factors(v)) + ierr = nf90_get_att(met_ncids(v), varid, 'add_offset', atm2lnd_vars%add_offsets(v)) + !get the met data + starti(1) = 1 + starti(2) = gtoget + counti(1) = atm2lnd_vars%timelen_spinup(v) + counti(2) = 1 + if (.not. const_climate_hist .and. (yr .ge. 1850 .or. use_sitedata)) counti(1) = atm2lnd_vars%timelen(v) + + if (i == 1 .and. v == 1) then + allocate(atm2lnd_vars%atm_input (met_nvars,bounds%begg:bounds%endg,1,1:counti(1))) + end if + + ierr = nf90_get_var(met_ncids(v), varid, atm2lnd_vars%atm_input(v,g:g,1,1:counti(1)), starti(1:2), counti(1:2)) + ierr = nf90_close(met_ncids(v)) + + if (use_sitedata .and. v == 1) then + starti_site = max((nint(site_metdata(4,1))-atm2lnd_vars%startyear_met) * & + 365*nint(24./atm2lnd_vars%timeres(v))+1,1) + endi_site = (min(atm2lnd_vars%endyear_met_trans,nint(site_metdata(5,1))) - & + atm2lnd_vars%startyear_met+1)*(365*nint(24./atm2lnd_vars%timeres(v))) + end if + + atm2lnd_vars%var_offset(v,g,:) = 0._r8 + atm2lnd_vars%var_mult(v,g,:) = 1._r8 + + if (use_sitedata) then + !Compute monthly biases for site vs. reanalysis + var_month_mean(:) = 0._r8 + var_month_count(:) = 0 + do i=starti_site, endi_site + thisdoy = mod(i,365*nint(24./atm2lnd_vars%timeres(v)))/(nint(24./atm2lnd_vars%timeres(v)))+1 + do m=1,12 + if (thisdoy .ge. caldaym(m) .and. thisdoy .lt. caldaym(m+1)) thism = m + enddo + var_month_mean(thism) = var_month_mean(thism) + (atm2lnd_vars%atm_input(v,g,1,i)* & + atm2lnd_vars%scale_factors(v) + atm2lnd_vars%add_offsets(v)) + var_month_count(thism) = var_month_count(thism)+1 + end do + + do m = 1,12 + var_month_mean(m) = var_month_mean(m)/var_month_count(m) + !calculate offset and linear bias factors for temperature and precipitation + if (v .eq. 1) atm2lnd_vars%var_offset(v,g,m) = (site_metdata(6,m)+SHR_CONST_TKFRZ) - var_month_mean(m) + if (v .eq. 5 .and. var_month_mean(m) .gt. 0) & + atm2lnd_vars%var_mult(v,g,m) = (site_metdata(7,m))/(caldaym(m+1)-caldaym(m))/24._r8/ & + 3600._r8 / var_month_mean(m) + end do + end if + + !Align spinups and transient simulations + !figure out which year to start with (assuming spinups always use integer multiple of met cycles) + mystart = atm2lnd_vars%startyear_met + do while (mystart > 1850) + mystart = mystart - nyears_spinup + end do + if (atm2lnd_vars%metsource == 5) mystart=1850 + + if (yr .lt. 1850) then + atm2lnd_vars%tindex(g,v,1) = (mod(yr-1,nyears_spinup) + (1850-mystart)) * 365 * nint(24./atm2lnd_vars%timeres(v)) + else if (yr .le. atm2lnd_vars%endyear_met_spinup) then + atm2lnd_vars%tindex(g,v,1) = (mod(yr-1850,nyears_spinup) + (1850-mystart)) * 365 * nint(24./atm2lnd_vars%timeres(v)) + else + atm2lnd_vars%tindex(g,v,1) = (yr - atm2lnd_vars%startyear_met) * 365 * nint(24./atm2lnd_vars%timeres(v)) + end if + !adjust for starts not at beginning of year (but currently MUST begin at hour 0) + atm2lnd_vars%tindex(g,v,1) = atm2lnd_vars%tindex(g,v,1) + (caldaym(mon)+day-2)* & + nint(24./atm2lnd_vars%timeres(v)) + + atm2lnd_vars%tindex(g,v,2) = atm2lnd_vars%tindex(g,v,1) + 1 + if (atm2lnd_vars%tindex(g,v,1) == 0) then + atm2lnd_vars%tindex(g,v,1) = atm2lnd_vars%timelen(v) + if (yr .le. atm2lnd_vars%endyear_met_spinup) atm2lnd_vars%tindex(g,v,1) = atm2lnd_vars%timelen_spinup(v) + end if + end do !end variable loop + else + do v=1,met_nvars + if (atm2lnd_vars%npf(v) - 1._r8 .gt. 1e-3) then + if (v .eq. 4 .or. v .eq. 5 .or. (v .ge. 8 .and. v .le. 13)) then !rad/Precipitation + if (mod(tod/get_step_size(),nint(atm2lnd_vars%npf(v))) == 1 .and. nstep .gt. 3) then + atm2lnd_vars%tindex(g,v,1) = atm2lnd_vars%tindex(g,v,1)+1 + atm2lnd_vars%tindex(g,v,2) = atm2lnd_vars%tindex(g,v,2)+1 + end if + else + if (mod(tod/get_step_size()-1,nint(atm2lnd_vars%npf(v))) <= atm2lnd_vars%npf(v)/2._r8 .and. & + mod(tod/get_step_size(),nint(atm2lnd_vars%npf(v))) > atm2lnd_vars%npf(v)/2._r8) then + atm2lnd_vars%tindex(g,v,1) = atm2lnd_vars%tindex(g,v,1)+1 + atm2lnd_vars%tindex(g,v,2) = atm2lnd_vars%tindex(g,v,2)+1 + end if + end if + else + atm2lnd_vars%tindex(g,v,1) = atm2lnd_vars%tindex(g,v,1)+nint(1/atm2lnd_vars%npf(v)) + atm2lnd_vars%tindex(g,v,2) = atm2lnd_vars%tindex(g,v,2)+nint(1/atm2lnd_vars%npf(v)) + end if + + if (const_climate_hist .or. yr .le. atm2lnd_vars%startyear_met) then + if (atm2lnd_vars%tindex(g,v,1) .gt. atm2lnd_vars%timelen_spinup(v)) atm2lnd_vars%tindex(g,v,1) = 1 + if (atm2lnd_vars%tindex(g,v,2) .gt. atm2lnd_vars%timelen_spinup(v)) atm2lnd_vars%tindex(g,v,2) = 1 + else if (yr .gt. atm2lnd_vars%endyear_met_trans) then + if (atm2lnd_vars%tindex(g,v,1) .gt. atm2lnd_vars%timelen(v)) then + atm2lnd_vars%tindex(g,v,1) = atm2lnd_vars%timelen(v)-atm2lnd_vars%timelen_spinup(v)+1 + end if + if (atm2lnd_vars%tindex(g,v,2) .gt. atm2lnd_vars%timelen(v)) then + atm2lnd_vars%tindex(g,v,2) = atm2lnd_vars%timelen(v)-atm2lnd_vars%timelen_spinup(v)+1 + end if + end if + + !if (yr .gt. atm2lnd_vars%startyear_met) then + ! if (atm2lnd_vars%tindex(g,v,1) .gt. atm2lnd_vars%timelen(v)) atm2lnd_vars%tindex(g,v,1) = 1 + ! if (atm2lnd_vars%tindex(g,v,2) .gt. atm2lnd_vars%timelen(v)) atm2lnd_vars%tindex(g,v,2) = 1 + !else + ! if (atm2lnd_vars%tindex(g,v,1) .gt. atm2lnd_vars%timelen_spinup(v)) atm2lnd_vars%tindex(g,v,1) = 1 + ! if (atm2lnd_vars%tindex(g,v,2) .gt. atm2lnd_vars%timelen_spinup(v)) atm2lnd_vars%tindex(g,v,2) = 1 + !end if + end do + end if + + tindex = atm2lnd_vars%tindex(g,:,:) + + !get weights for linear interpolation + do v=1,met_nvars + if (atm2lnd_vars%npf(v) - 1._r8 .gt. 1e-3) then + wt1(v) = 1._r8 - (mod((tod+86400)/get_step_size()-atm2lnd_vars%npf(v)/2._r8, & + atm2lnd_vars%npf(v))*1._r8)/atm2lnd_vars%npf(v) + wt2(v) = 1._r8 - wt1(v) + else + wt1(v) = 0._r8 + wt2(v) = 1._r8 + end if + end do + + !Air temperature + atm2lnd_vars%forc_t_not_downscaled_grc(g) = min(((atm2lnd_vars%atm_input(1,g,1,tindex(1,1))*atm2lnd_vars%scale_factors(1)+ & + atm2lnd_vars%add_offsets(1))*wt1(1) + (atm2lnd_vars%atm_input(1,g,1,tindex(1,2))* & + atm2lnd_vars%scale_factors(1)+atm2lnd_vars%add_offsets(1))*wt2(1)) * & + atm2lnd_vars%var_mult(1,g,mon) + atm2lnd_vars%var_offset(1,g,mon), 323._r8) + atm2lnd_vars%forc_th_not_downscaled_grc(g) = min(((atm2lnd_vars%atm_input(1,g,1,tindex(1,1))*atm2lnd_vars%scale_factors(1)+ & + atm2lnd_vars%add_offsets(1))*wt1(1) + (atm2lnd_vars%atm_input(1,g,1,tindex(1,2))* & + atm2lnd_vars%scale_factors(1)+atm2lnd_vars%add_offsets(1))*wt2(1)) * & + atm2lnd_vars%var_mult(1,g,mon) + atm2lnd_vars%var_offset(1,g,mon), 323._r8) + + tbot = atm2lnd_vars%forc_t_not_downscaled_grc(g) + + !Air pressure + atm2lnd_vars%forc_pbot_not_downscaled_grc(g) = max(((atm2lnd_vars%atm_input(2,g,1,tindex(2,1))*atm2lnd_vars%scale_factors(2)+ & + atm2lnd_vars%add_offsets(2))*wt1(2) + (atm2lnd_vars%atm_input(2,g,1,tindex(2,2)) & + *atm2lnd_vars%scale_factors(2)+atm2lnd_vars%add_offsets(2))*wt2(2)) * & + atm2lnd_vars%var_mult(2,g,mon) + atm2lnd_vars%var_offset(2,g,mon), 4e4_r8) + !Specific humidity + atm2lnd_vars%forc_q_not_downscaled_grc(g) = max(((atm2lnd_vars%atm_input(3,g,1,tindex(3,1))*atm2lnd_vars%scale_factors(3)+ & + atm2lnd_vars%add_offsets(3))*wt1(3) + (atm2lnd_vars%atm_input(3,g,1,tindex(3,2)) & + *atm2lnd_vars%scale_factors(3)+atm2lnd_vars%add_offsets(3))*wt2(3)) * & + atm2lnd_vars%var_mult(3,g,mon) + atm2lnd_vars%var_offset(3,g,mon), 1e-9_r8) + + if (atm2lnd_vars%metsource == 2) then !convert RH to qbot + if (tbot > SHR_CONST_TKFRZ) then + e = esatw(tdc(tbot)) + else + e = esati(tdc(tbot)) + end if + qsat = 0.622_r8*e / (atm2lnd_vars%forc_pbot_not_downscaled_grc(g) - 0.378_r8*e) + atm2lnd_vars%forc_q_not_downscaled_grc(g) = qsat * atm2lnd_vars%forc_q_not_downscaled_grc(g) / 100.0_r8 + end if + + !use longwave from file if provided + atm2lnd_vars%forc_lwrad_not_downscaled_grc(g) = ((atm2lnd_vars%atm_input(7,g,1,tindex(7,1))*atm2lnd_vars%scale_factors(7)+ & + atm2lnd_vars%add_offsets(7))*wt1(7) + (atm2lnd_vars%atm_input(7,g,1,tindex(7,2)) & + *atm2lnd_vars%scale_factors(7)+atm2lnd_vars%add_offsets(7))*wt2(7)) * & + atm2lnd_vars%var_mult(7,g,mon) + atm2lnd_vars%var_offset(7,g,mon) + if (atm2lnd_vars%forc_lwrad_not_downscaled_grc(g) .le. 50 .or. atm2lnd_vars%forc_lwrad_not_downscaled_grc(g) .ge. 600) then + !Longwave radiation (calculated from air temperature, humidity) + e = atm2lnd_vars%forc_pbot_not_downscaled_grc(g) * atm2lnd_vars%forc_q_not_downscaled_grc(g) / & + (0.622_R8 + 0.378_R8 * atm2lnd_vars%forc_q_not_downscaled_grc(g) ) + ea = 0.70_R8 + 5.95e-05_R8 * 0.01_R8 * e * exp(1500.0_R8/tbot) + atm2lnd_vars%forc_lwrad_not_downscaled_grc(g) = ea * SHR_CONST_STEBOL * tbot**4 + end if + + !Shortwave radiation (cosine zenith angle interpolation) + thishr = (tod-get_step_size()/2)/3600 + if (thishr < 0) thishr=thishr+24 + thismin = mod((tod-get_step_size()/2)/60, 60) + thiscosz = max(cos(szenith(ldomain%lonc(g),ldomain%latc(g),0,int(thiscalday),thishr,thismin,0)* & + 3.14159265358979/180.0d0), 0.001d0) + avgcosz = 0d0 + if (atm2lnd_vars%npf(4) - 1._r8 .gt. 1e-3) then + swrad_period_len = get_step_size()*nint(atm2lnd_vars%npf(4)) + swrad_period_start = ((tod-get_step_size()/2)/swrad_period_len) * swrad_period_len + !set to last period if first model timestep of the day + if (tod-get_step_size()/2 < 0) swrad_period_start = ((86400-get_step_size()/2)/swrad_period_len) * swrad_period_len + + do tm=1,nint(atm2lnd_vars%npf(4)) + !Get the average cosine zenith angle over the time resolution of the input data + thishr = (swrad_period_start+(tm-1)*get_step_size()+get_step_size()/2)/3600 + if (thishr > 23) thishr=thishr-24 + thismin = mod((swrad_period_start+(tm-1)*get_step_size()+get_step_size()/2)/60, 60) + avgcosz = avgcosz + max(cos(szenith(ldomain%lonc(g),ldomain%latc(g),0,int(thiscalday),thishr, thismin, 0) & + *3.14159265358979/180.0d0), 0.001d0)/atm2lnd_vars%npf(4) + end do + else + avgcosz = thiscosz + end if + if (thiscosz > 0.001d0) then + wt2(4) = min(thiscosz/avgcosz, 10.0_r8) + else + wt2(4) = 0d0 + end if + + if (atm2lnd_vars%metsource == 5) then + wt2(4)=1.0 !cosz interp not working + wt2(8:10)=1.0 + swndf = max(((atm2lnd_vars%atm_input(4,g,1,tindex(4,2))*atm2lnd_vars%scale_factors(4)+ & + atm2lnd_vars%add_offsets(4))*wt2(4)), 0.0_r8) + swndr = max(((atm2lnd_vars%atm_input(8,g,1,tindex(8,2))*atm2lnd_vars%scale_factors(8)+ & + atm2lnd_vars%add_offsets(8))*wt2(8)), 0.0_r8) + swvdf = max(((atm2lnd_vars%atm_input(9,g,1,tindex(9,2))*atm2lnd_vars%scale_factors(9)+ & + atm2lnd_vars%add_offsets(9))*wt2(9)), 0.0_r8) + swvdr = max(((atm2lnd_vars%atm_input(10,g,1,tindex(10,2))*atm2lnd_vars%scale_factors(10)+ & + atm2lnd_vars%add_offsets(10))*wt2(10)), 0.0_r8) + atm2lnd_vars%forc_solad_grc(g,2) = swndr + atm2lnd_vars%forc_solad_grc(g,1) = swvdr + atm2lnd_vars%forc_solai_grc(g,2) = swndf + atm2lnd_vars%forc_solai_grc(g,1) = swvdf + else + swndr = max(((atm2lnd_vars%atm_input(4,g,1,tindex(4,2))*atm2lnd_vars%scale_factors(4)+ & + atm2lnd_vars%add_offsets(4))*wt2(4)) * 0.50_R8, 0.0_r8) + swndf = max(((atm2lnd_vars%atm_input(4,g,1,tindex(4,2))*atm2lnd_vars%scale_factors(4)+ & + atm2lnd_vars%add_offsets(4))*wt2(4))*0.50_R8, 0.0_r8) + swvdr = max(((atm2lnd_vars%atm_input(4,g,1,tindex(4,2))*atm2lnd_vars%scale_factors(4)+ & + atm2lnd_vars%add_offsets(4))*wt2(4))*0.50_R8, 0.0_r8) + swvdf = max(((atm2lnd_vars%atm_input(4,g,1,tindex(4,2))*atm2lnd_vars%scale_factors(4)+ & + atm2lnd_vars%add_offsets(4))*wt2(4))*0.50_R8, 0.0_r8) + ratio_rvrf = min(0.99_R8,max(0.29548_R8 + 0.00504_R8*swndr & + -1.4957e-05_R8*swndr**2 + 1.4881e-08_R8*swndr**3,0.01_R8)) + atm2lnd_vars%forc_solad_grc(g,2) = ratio_rvrf*swndr + atm2lnd_vars%forc_solai_grc(g,2) = (1._R8 - ratio_rvrf)*swndf + ratio_rvrf = min(0.99_R8,max(0.17639_R8 + 0.00380_R8*swvdr & + -9.0039e-06_R8*swvdr**2 +8.1351e-09_R8*swvdr**3,0.01_R8)) + atm2lnd_vars%forc_solad_grc(g,1) = ratio_rvrf*swvdr + atm2lnd_vars%forc_solai_grc(g,1) = (1._R8 - ratio_rvrf)*swvdf + end if + !Rain and snow + if (atm2lnd_vars%metsource == 5) then + forc_rainc = max((((atm2lnd_vars%atm_input(5,g,1,tindex(5,2))*atm2lnd_vars%scale_factors(5)+ & + atm2lnd_vars%add_offsets(5)))*atm2lnd_vars%var_mult(5,g,mon) + & + atm2lnd_vars%var_offset(5,g,mon)), 0.0_r8) + forc_rainl = max((((atm2lnd_vars%atm_input(11,g,1,tindex(11,2))*atm2lnd_vars%scale_factors(11)+ & + atm2lnd_vars%add_offsets(11)))*atm2lnd_vars%var_mult(11,g,mon) + & + atm2lnd_vars%var_offset(11,g,mon)), 0.0_r8) + forc_snowc = max((((atm2lnd_vars%atm_input(12,g,1,tindex(12,2))*atm2lnd_vars%scale_factors(12)+ & + atm2lnd_vars%add_offsets(12)))*atm2lnd_vars%var_mult(12,g,mon) + & + atm2lnd_vars%var_offset(12,g,mon)), 0.0_r8) + forc_snowl = max((((atm2lnd_vars%atm_input(13,g,1,tindex(13,2))*atm2lnd_vars%scale_factors(13)+ & + atm2lnd_vars%add_offsets(13)))*atm2lnd_vars%var_mult(13,g,mon) + & + atm2lnd_vars%var_offset(13,g,mon)), 0.0_r8) + else + frac = (atm2lnd_vars%forc_t_not_downscaled_grc(g) - SHR_CONST_TKFRZ)*0.5_R8 ! ramp near freezing + frac = min(1.0_R8,max(0.0_R8,frac)) ! bound in [0,1] + !Don't interpolate rainfall data + forc_rainc = 0.1_R8 * frac * max((((atm2lnd_vars%atm_input(5,g,1,tindex(5,2))*atm2lnd_vars%scale_factors(5)+ & + atm2lnd_vars%add_offsets(5)))*atm2lnd_vars%var_mult(5,g,mon) + & + atm2lnd_vars%var_offset(5,g,mon)), 0.0_r8) + forc_rainl = 0.9_R8 * frac * max((((atm2lnd_vars%atm_input(5,g,1,tindex(5,2))*atm2lnd_vars%scale_factors(5)+ & + atm2lnd_vars%add_offsets(5)))*atm2lnd_vars%var_mult(5,g,mon) + & + atm2lnd_vars%var_offset(5,g,mon)), 0.0_r8) + forc_snowc = 0.1_R8 * (1.0_R8 - frac) * max((((atm2lnd_vars%atm_input(5,g,1,tindex(5,2))*atm2lnd_vars%scale_factors(5)+ & + atm2lnd_vars%add_offsets(5)))*atm2lnd_vars%var_mult(5,g,mon) + atm2lnd_vars%var_offset(5,g,mon)), 0.0_r8) + forc_snowl = 0.9_R8 * (1.0_R8 - frac) * max((((atm2lnd_vars%atm_input(5,g,1,tindex(5,2))*atm2lnd_vars%scale_factors(5)+ & + atm2lnd_vars%add_offsets(5))) * atm2lnd_vars%var_mult(5,g,mon) + atm2lnd_vars%var_offset(5,g,mon)), 0.0_r8) + end if + !Wind + atm2lnd_vars%forc_u_grc(g) = (atm2lnd_vars%atm_input(6,g,1,tindex(6,1))*atm2lnd_vars%scale_factors(6)+ & + atm2lnd_vars%add_offsets(6))*wt1(6) + (atm2lnd_vars%atm_input(6,g,1,tindex(6,2))* & + atm2lnd_vars%scale_factors(6)+atm2lnd_vars%add_offsets(6))*wt2(6) + if (atm2lnd_vars%metsource == 5) then + atm2lnd_vars%forc_v_grc(g) = (atm2lnd_vars%atm_input(14,g,1,tindex(14,1))*atm2lnd_vars%scale_factors(14)+ & + atm2lnd_vars%add_offsets(14))*wt1(14) + (atm2lnd_vars%atm_input(14,g,1,tindex(14,2))* & + atm2lnd_vars%scale_factors(14)+atm2lnd_vars%add_offsets(14))*wt2(14) + else + atm2lnd_vars%forc_v_grc(g) = 0.0_R8 + end if + atm2lnd_vars%forc_hgt_grc(g) = 30.0_R8 !(atm2lnd_vars%atm_input(8,g,1,tindex(1))*wt1 + & + !atm2lnd_vars%atm_input(8,g,1,tindex(2))*wt2) ! zgcmxy Atm state, default=30m + + !------------------------------------Fire data ------------------------------------------------------- + + nindex(1) = yr-1848 + nindex(2) = nindex(1)+1 + if (yr .lt. 1850 .or. const_climate_hist) nindex(1:2) = 2 + if (yr .ge. 2010 .and. .not. const_climate_hist) nindex(1:2) = 161 + + model_filter: if (use_cn .or. use_fates) then + if (atm2lnd_vars%loaded_bypassdata == 0 .or. (mon .eq. 1 .and. day .eq. 1 .and. tod .eq. 0)) then + if (masterproc .and. i .eq. 1) then + ! Read pop_dens streams namelist to get filename + nu_nml = getavu() + open(nu_nml, file=trim(NLFilename), status='old', iostat=nml_error ) + call find_nlgroup_name(nu_nml, 'popd_streams', status=nml_error) + if (nml_error == 0) then + read(nu_nml, nml=popd_streams,iostat=nml_error) + if (nml_error /= 0) then + call endrun(msg='ERROR reading popdens namelist') + end if + end if + close(nu_nml) + call relavu( nu_nml ) + + ierr = nf90_open(trim(stream_fldFileName_popdens), NF90_NOWRITE, ncid) + ierr = nf90_inq_varid(ncid, 'lat', varid) + ierr = nf90_get_var(ncid, varid, smap05_lat) + ierr = nf90_inq_varid(ncid, 'lon', varid) + ierr = nf90_get_var(ncid, varid, smap05_lon) + ierr = nf90_inq_varid(ncid, 'hdm', varid) + starti(1:2) = 1 + starti(3) = nindex(1) + counti(1) = 720 + counti(2) = 360 + counti(3) = 1 + ierr = nf90_get_var(ncid, varid, atm2lnd_vars%hdm1, starti, counti) + starti(3) = nindex(2) + if (nindex(1) .ne. nindex(2)) then + ierr = nf90_get_var(ncid, varid, atm2lnd_vars%hdm2, starti, counti) + else + atm2lnd_vars%hdm2 = atm2lnd_vars%hdm1 + end if + ierr = nf90_close(ncid) + end if + + if (i .eq. 1) then + call mpi_bcast (atm2lnd_vars%hdm1, 360*720, MPI_REAL8, 0, mpicom, ier) + call mpi_bcast (atm2lnd_vars%hdm2, 360*720, MPI_REAL8, 0, mpicom, ier) + call mpi_bcast (smap05_lon, 720, MPI_REAL8, 0, mpicom, ier) + call mpi_bcast (smap05_lat, 360, MPI_REAL8, 0, mpicom, ier) + end if + end if + + !figure out which point to get + if (atm2lnd_vars%loaded_bypassdata == 0) then + mindist=99999 + do thisx = 1,720 + do thisy = 1,360 + if (ldomain%lonc(g) .lt. 0) then + if (smap05_lon(thisx) >= 180) smap05_lon(thisx) = smap05_lon(thisx)-360._r8 + else if (ldomain%lonc(g) .ge. 180) then + if (smap05_lon(thisx) < 0) smap05_lon(thisx) = smap05_lon(thisx) + 360._r8 + end if + thisdist = 100*((smap05_lat(thisy) - ldomain%latc(g))**2 + & + (smap05_lon(thisx) - ldomain%lonc(g))**2)**0.5 + if (thisdist .lt. mindist) then + mindist = thisdist + atm2lnd_vars%hdmind(g,1) = thisx + atm2lnd_vars%hdmind(g,2) = thisy + end if + end do + end do + end if + !get weights for interpolation + wt1(1) = 1._r8 - (thiscalday -1._r8)/365._r8 + wt2(1) = 1._r8 - wt1(1) + atm2lnd_vars%forc_hdm(g) = atm2lnd_vars%hdm1(atm2lnd_vars%hdmind(g,1),atm2lnd_vars%hdmind(g,2),1)*wt1(1) + & + atm2lnd_vars%hdm2(atm2lnd_vars%hdmind(g,1),atm2lnd_vars%hdmind(g,2),1)*wt2(1) + + if (atm2lnd_vars%loaded_bypassdata .eq. 0 .and. masterproc .and. i .eq. 1) then + ! Read light_streams namelist to get filename + nu_nml = getavu() + open( nu_nml, file=trim(NLFilename), status='old', iostat=nml_error ) + call find_nlgroup_name(nu_nml, 'light_streams', status=nml_error) + if (nml_error == 0) then + read(nu_nml, nml=light_streams,iostat=nml_error) + if (nml_error /= 0) then + call endrun(msg='ERROR reading light_streams namelist') + end if + end if + close(nu_nml) + call relavu( nu_nml ) + + !Get all of the data (master processor only) + allocate(atm2lnd_vars%lnfm_all (192,94,2920)) + ierr = nf90_open(trim(stream_fldFileName_lightng), NF90_NOWRITE, ncid) + ierr = nf90_inq_varid(ncid, 'lat', varid) + ierr = nf90_get_var(ncid, varid, smapt62_lat) + ierr = nf90_inq_varid(ncid, 'lon', varid) + ierr = nf90_get_var(ncid, varid, smapt62_lon) + ierr = nf90_inq_varid(ncid, 'lnfm', varid) + ierr = nf90_get_var(ncid, varid, atm2lnd_vars%lnfm_all) + ierr = nf90_close(ncid) + end if + if (atm2lnd_vars%loaded_bypassdata .eq. 0 .and. i .eq. 1) then + call mpi_bcast (smapt62_lon, 192, MPI_REAL8, 0, mpicom, ier) + call mpi_bcast (smapt62_lat, 94, MPI_REAL8, 0, mpicom, ier) + end if + if (atm2lnd_vars%loaded_bypassdata .eq. 0) then + mindist=99999 + do thisx = 1,192 + do thisy = 1,94 + if (ldomain%lonc(g) .lt. 0) then + if (smapt62_lon(thisx) >= 180) smapt62_lon(thisx) = smapt62_lon(thisx)-360._r8 + else if (ldomain%lonc(g) .ge. 180) then + if (smapt62_lon(thisx) < 0) smapt62_lon(thisx) = smapt62_lon(thisx) + 360._r8 + end if + thisdist = 100*((smapt62_lat(thisy) - ldomain%latc(g))**2 + & + (smapt62_lon(thisx) - ldomain%lonc(g))**2)**0.5 + if (thisdist .lt. mindist) then + mindist = thisdist + lnfmind(1) = thisx + lnfmind(2) = thisy + end if + end do + end do + if (masterproc) then + atm2lnd_vars%lnfm(g,:) = atm2lnd_vars%lnfm_all(lnfmind(1),lnfmind(2),:) + do np = 1,npes-1 + if (i == 1) then + call mpi_recv(thisng, 1, MPI_INTEGER, np, 100000+np, mpicom, status, ier) + ng_all(np) = thisng + end if + if (i <= ng_all(np)) then + call mpi_recv(lnfmind, 2, MPI_INTEGER, np, 200000+np, mpicom, status, ier) + call mpi_send(atm2lnd_vars%lnfm_all(lnfmind(1),lnfmind(2),:), 2920, & + MPI_REAL8, np, 300000+np, mpicom, ier) + end if + end do + else + if (i == 1) call mpi_send(thisng, 1, MPI_INTEGER, 0, 100000+iam, mpicom, ier) + call mpi_send(lnfmind, 2, MPI_INTEGER, 0, 200000+iam, mpicom, ier) + call mpi_recv(atm2lnd_vars%lnfm(g,:), 2920, MPI_REAL8, 0, 300000+iam, mpicom, status, ier) + end if + end if + + !Lightning data is 3-hourly. Does not currently interpolate. + atm2lnd_vars%forc_lnfm(g) = atm2lnd_vars%lnfm(g, ((int(thiscalday)-1)*8+tod/(3600*3))+1) + + !------------------------------------Nitrogen deposition---------------------------------------------- + + !DMR note - ndep will NOT be correct if more than 1850 years of model + !spinup (model year > 1850) + nindex(1) = min(max(yr-1848,2), 168) + nindex(2) = min(nindex(1)+1, 168) + + if (atm2lnd_vars%loaded_bypassdata .eq. 0 .or. (mon .eq. 1 .and. day .eq. 1 .and. tod .eq. 0)) then + if (masterproc .and. i .eq. 1) then + nu_nml = getavu() + open( nu_nml, file=trim(NLFilename), status='old', iostat=nml_error ) + call find_nlgroup_name(nu_nml, 'ndepdyn_nml', status=nml_error) + if (nml_error == 0) then + read(nu_nml, nml=ndepdyn_nml,iostat=nml_error) + if (nml_error /= 0) then + call endrun(msg='ERROR reading ndep namelist') + end if + end if + close(nu_nml) + call relavu( nu_nml ) + + ierr = nf90_open(trim(stream_fldFileName_ndep), nf90_nowrite, ncid) + ierr = nf90_inq_varid(ncid, 'lat', varid) + ierr = nf90_get_var(ncid, varid, smap2_lat) + ierr = nf90_inq_varid(ncid, 'lon', varid) + ierr = nf90_get_var(ncid, varid, smap2_lon) + ierr = nf90_inq_varid(ncid, 'NDEP_year', varid) + starti(1:2) = 1 + starti(3) = nindex(1) + counti(1) = 144 + counti(2) = 96 + counti(3) = 1 + ierr = nf90_get_var(ncid, varid, atm2lnd_vars%ndep1, starti, counti) + if (nindex(1) .ne. nindex(2)) then + starti(3) = nindex(2) + ierr = nf90_get_var(ncid, varid, atm2lnd_vars%ndep2, starti, counti) + else + atm2lnd_vars%ndep2 = atm2lnd_vars%ndep1 + end if + ierr = nf90_close(ncid) + end if + if (i .eq. 1) then + call mpi_bcast (atm2lnd_vars%ndep1, 144*96, MPI_REAL8, 0, mpicom, ier) + call mpi_bcast (atm2lnd_vars%ndep2, 144*96, MPI_REAL8, 0, mpicom, ier) + call mpi_bcast (smap2_lon, 144, MPI_REAL8, 0, mpicom, ier) + call mpi_bcast (smap2_lat, 96, MPI_REAL8, 0, mpicom, ier) + end if + end if + + if (atm2lnd_vars%loaded_bypassdata .eq. 0) then + mindist=99999 + do thisx = 1,144 + do thisy = 1,96 + if (ldomain%lonc(g) .lt. 0) then + if (smap2_lon(thisx) >= 180) smap2_lon(thisx) = smap2_lon(thisx)-360._r8 + else if (ldomain%lonc(g) .ge. 180) then + if (smap2_lon(thisx) < 0) smap2_lon(thisx) = smap2_lon(thisx) + 360._r8 + end if + thislon = smap2_lon(thisx) + thisdist = 100*((smap2_lat(thisy) - ldomain%latc(g))**2 + & + (thislon - ldomain%lonc(g))**2)**0.5 + if (thisdist .lt. mindist) then + mindist = thisdist + atm2lnd_vars%ndepind(g,1) = thisx + atm2lnd_vars%ndepind(g,2) = thisy + end if + end do + end do + end if + + !get weights for interpolation + wt1(1) = 1._r8 - (thiscalday -1._r8)/365._r8 + wt2(1) = 1._r8 - wt1(1) + + atm2lnd_vars%forc_ndep_grc(g) = (atm2lnd_vars%ndep1(atm2lnd_vars%ndepind(g,1),atm2lnd_vars%ndepind(g,2),1)*wt1(1) + & + atm2lnd_vars%ndep2(atm2lnd_vars%ndepind(g,1),atm2lnd_vars%ndepind(g,2),1)*wt2(1)) / (365._r8 * 86400._r8) + end if model_filter + + !------------------------------------Aerosol forcing-------------------------------------------------- + if (atm2lnd_vars%loaded_bypassdata .eq. 0 .or. (mon .eq. 1 .and. day .eq. 1 .and. tod .eq. 0)) then + if (masterproc .and. i .eq. 1) then + aerovars(1) = 'BCDEPWET' + aerovars(2) = 'BCPHODRY' + aerovars(3) = 'BCPHIDRY' + aerovars(4) = 'OCDEPWET' + aerovars(5) = 'OCPHODRY' + aerovars(6) = 'OCPHIDRY' + aerovars(7) = 'DSTX01DD' + aerovars(8) = 'DSTX02DD' + aerovars(9) = 'DSTX03DD' + aerovars(10) = 'DSTX04DD' + aerovars(11) = 'DSTX01WD' + aerovars(12) = 'DSTX02WD' + aerovars(13) = 'DSTX03WD' + aerovars(14) = 'DSTX04WD' + ierr = nf90_open(trim(aero_file), nf90_nowrite, ncid) + ierr = nf90_inq_varid(ncid, 'lat', varid) + ierr = nf90_get_var(ncid, varid, smap2_lat) + ierr = nf90_inq_varid(ncid, 'lon', varid) + ierr = nf90_get_var(ncid, varid, smap2_lon) + starti(1:2) = 1 + starti(3) = max((min(yr,2100)-1849)*12+1, 13)-1 + counti(1) = 144 + counti(2) = 96 + counti(3) = 14 + do av=1,14 + ierr = nf90_inq_varid(ncid, trim(aerovars(av)), varid) + ierr = nf90_get_var(ncid, varid, atm2lnd_vars%aerodata(av,:,:,:), starti, counti) + end do + ierr = nf90_close(ncid) + end if + if (i .eq. 1) then + call mpi_bcast (atm2lnd_vars%aerodata, 14*144*96*14, MPI_REAL8, 0, mpicom, ier) + end if + end if + + !Use ndep grid indices since they're on the same grid + if (atm2lnd_vars%loaded_bypassdata .eq. 0 .and. (.not. (use_fates .or. use_cn) ) ) then + mindist=99999 + do thisx = 1,144 + do thisy = 1,96 + if (ldomain%lonc(g) .lt. 0) then + if (smap2_lon(thisx) >= 180) smap2_lon(thisx) = smap2_lon(thisx)-360._r8 + else if (ldomain%lonc(g) .ge. 180) then + if (smap2_lon(thisx) < 0) smap2_lon(thisx) = smap2_lon(thisx) + 360._r8 + end if + thislon = smap2_lon(thisx) + thisdist = 100*((smap2_lat(thisy) - ldomain%latc(g))**2 + & + (thislon - ldomain%lonc(g))**2)**0.5 + if (thisdist .lt. mindist) then + mindist = thisdist + atm2lnd_vars%ndepind(g,1) = thisx + atm2lnd_vars%ndepind(g,2) = thisy + end if + end do + end do + end if + + !get weights for interpolation (note this method doesn't get the month boundaries quite right..) + aindex(1) = mon+1 + if (thiscalday .le. (caldaym(mon+1)+caldaym(mon))/2._r8) then + wt1(1) = 0.5_r8 + (thiscalday-caldaym(mon))/(caldaym(mon+1)-caldaym(mon)) + aindex(2) = aindex(1)-1 + else + wt1(1) = 1.0_r8 - (thiscalday-(caldaym(mon+1)+caldaym(mon))/2._r8)/ & + (caldaym(mon+1)-caldaym(mon)) + aindex(2) = aindex(1)+1 + end if + wt2(1) = 1._r8 - wt1(1) + + do av = 1,14 + atm2lnd_vars%forc_aer_grc(g,av) = atm2lnd_vars%aerodata(av,atm2lnd_vars%ndepind(g,1), & + atm2lnd_vars%ndepind(g,2),aindex(1))*wt1(1)+atm2lnd_vars%aerodata(av,atm2lnd_vars%ndepind(g,1), & + atm2lnd_vars%ndepind(g,2),aindex(2))*wt2(1) + end do + + !Parse startdate for adding temperature + if (startdate_add_temperature .ne. '') then + call get_curr_date( yr, mon, day, tod ) + read(startdate_add_temperature,*) sdate_addt + sy_addt = sdate_addt/10000 + sm_addt = (sdate_addt-sy_addt*10000)/100 + sd_addt = sdate_addt-sy_addt*10000-sm_addt*100 + read(startdate_add_co2,*) sdate_addco2 + sy_addco2 = sdate_addco2/10000 + sm_addco2 = (sdate_addco2-sy_addco2*10000)/100 + sd_addco2 = sdate_addco2-sy_addco2*10000-sm_addt*100 + end if + if (startdate_add_temperature .ne. '') then + if ((yr == sy_addt .and. mon == sm_addt .and. day >= sd_addt) .or. & + (yr == sy_addt .and. mon > sm_addt) .or. (yr > sy_addt)) then + atm2lnd_vars%forc_t_not_downscaled_grc(g) = atm2lnd_vars%forc_t_not_downscaled_grc(g) + add_temperature + atm2lnd_vars%forc_th_not_downscaled_grc(g) = atm2lnd_vars%forc_th_not_downscaled_grc(g) + add_temperature + end if + end if + + !set the topounit-level atmospheric state and flux forcings (bypass mode) + do topo = grc_pp%topi(g), grc_pp%topf(g) + ! first, all the state forcings + top_as%tbot(topo) = atm2lnd_vars%forc_t_not_downscaled_grc(g) ! forc_txy Atm state K + top_as%thbot(topo) = atm2lnd_vars%forc_th_not_downscaled_grc(g) ! forc_thxy Atm state K + top_as%pbot(topo) = atm2lnd_vars%forc_pbot_not_downscaled_grc(g) ! ptcmxy Atm state Pa + top_as%qbot(topo) = atm2lnd_vars%forc_q_not_downscaled_grc(g) ! forc_qxy Atm state kg/kg + top_as%ubot(topo) = atm2lnd_vars%forc_u_grc(g) ! forc_uxy Atm state m/s + top_as%vbot(topo) = atm2lnd_vars%forc_v_grc(g) ! forc_vxy Atm state m/s + top_as%zbot(topo) = atm2lnd_vars%forc_hgt_grc(g) ! zgcmxy Atm state m + ! assign the state forcing fields derived from other inputs + ! Horizontal windspeed (m/s) + top_as%windbot(topo) = sqrt(top_as%ubot(topo)**2 + top_as%vbot(topo)**2) + ! Relative humidity (percent) + if (top_as%tbot(topo) > SHR_CONST_TKFRZ) then + e = esatw(tdc(top_as%tbot(topo))) + else + e = esati(tdc(top_as%tbot(topo))) + end if + qsat = 0.622_r8*e / (top_as%pbot(topo) - 0.378_r8*e) + top_as%rhbot(topo) = 100.0_r8*(top_as%qbot(topo) / qsat) + ! partial pressure of oxygen (Pa) + top_as%po2bot(topo) = o2_molar_const * top_as%pbot(topo) + ! air density (kg/m**3) - uses a temporary calculation of water vapor pressure (Pa) + vp = top_as%qbot(topo) * top_as%pbot(topo) / (0.622_r8 + 0.378_r8 * top_as%qbot(topo)) + top_as%rhobot(topo) = (top_as%pbot(topo) - 0.378_r8 * vp) / (rair * top_as%tbot(topo)) + + ! second, all the flux forcings + top_af%rain(topo) = forc_rainc + forc_rainl ! sum of convective and large-scale rain + top_af%snow(topo) = forc_snowc + forc_snowl ! sum of convective and large-scale snow + top_af%solad(topo,2) = atm2lnd_vars%forc_solad_grc(g,2) ! forc_sollxy Atm flux W/m^2 + top_af%solad(topo,1) = atm2lnd_vars%forc_solad_grc(g,1) ! forc_solsxy Atm flux W/m^2 + top_af%solai(topo,2) = atm2lnd_vars%forc_solai_grc(g,2) ! forc_solldxy Atm flux W/m^2 + top_af%solai(topo,1) = atm2lnd_vars%forc_solai_grc(g,1) ! forc_solsdxy Atm flux W/m^2 + top_af%lwrad(topo) = atm2lnd_vars%forc_lwrad_not_downscaled_grc(g) ! flwdsxy Atm flux W/m^2 + ! derived flux forcings + top_af%solar(topo) = top_af%solad(topo,2) + top_af%solad(topo,1) + & + top_af%solai(topo,2) + top_af%solai(topo,1) + end do + + !----------------------------------------------------------------------------------------------------- +#else + + atm2lnd_vars%forc_hgt_grc(g) = x2l_lm(i,index_x2l_Sa_z) ! zgcmxy Atm state m + atm2lnd_vars%forc_u_grc(g) = x2l_lm(i,index_x2l_Sa_u) ! forc_uxy Atm state m/s + atm2lnd_vars%forc_v_grc(g) = x2l_lm(i,index_x2l_Sa_v) ! forc_vxy Atm state m/s + atm2lnd_vars%forc_solad_grc(g,2) = x2l_lm(i,index_x2l_Faxa_swndr) ! forc_sollxy Atm flux W/m^2 + atm2lnd_vars%forc_solad_grc(g,1) = x2l_lm(i,index_x2l_Faxa_swvdr) ! forc_solsxy Atm flux W/m^2 + atm2lnd_vars%forc_solai_grc(g,2) = x2l_lm(i,index_x2l_Faxa_swndf) ! forc_solldxy Atm flux W/m^2 + atm2lnd_vars%forc_solai_grc(g,1) = x2l_lm(i,index_x2l_Faxa_swvdf) ! forc_solsdxy Atm flux W/m^2 + + atm2lnd_vars%forc_th_not_downscaled_grc(g) = x2l_lm(i,index_x2l_Sa_ptem) ! forc_thxy Atm state K + atm2lnd_vars%forc_q_not_downscaled_grc(g) = x2l_lm(i,index_x2l_Sa_shum) ! forc_qxy Atm state kg/kg + atm2lnd_vars%forc_pbot_not_downscaled_grc(g) = x2l_lm(i,index_x2l_Sa_pbot) ! ptcmxy Atm state Pa + atm2lnd_vars%forc_t_not_downscaled_grc(g) = x2l_lm(i,index_x2l_Sa_tbot) ! forc_txy Atm state K + atm2lnd_vars%forc_lwrad_not_downscaled_grc(g) = x2l_lm(i,index_x2l_Faxa_lwdn) ! flwdsxy Atm flux W/m^2 + + forc_rainc = x2l_lm(i,index_x2l_Faxa_rainc) ! mm/s + forc_rainl = x2l_lm(i,index_x2l_Faxa_rainl) ! mm/s + forc_snowc = x2l_lm(i,index_x2l_Faxa_snowc) ! mm/s + forc_snowl = x2l_lm(i,index_x2l_Faxa_snowl) ! mm/s + + ! atmosphere coupling, for prognostic/prescribed aerosols + atm2lnd_vars%forc_aer_grc(g,1) = x2l_lm(i,index_x2l_Faxa_bcphidry) + atm2lnd_vars%forc_aer_grc(g,2) = x2l_lm(i,index_x2l_Faxa_bcphodry) + atm2lnd_vars%forc_aer_grc(g,3) = x2l_lm(i,index_x2l_Faxa_bcphiwet) + atm2lnd_vars%forc_aer_grc(g,4) = x2l_lm(i,index_x2l_Faxa_ocphidry) + atm2lnd_vars%forc_aer_grc(g,5) = x2l_lm(i,index_x2l_Faxa_ocphodry) + atm2lnd_vars%forc_aer_grc(g,6) = x2l_lm(i,index_x2l_Faxa_ocphiwet) + atm2lnd_vars%forc_aer_grc(g,7) = x2l_lm(i,index_x2l_Faxa_dstwet1) + atm2lnd_vars%forc_aer_grc(g,8) = x2l_lm(i,index_x2l_Faxa_dstdry1) + atm2lnd_vars%forc_aer_grc(g,9) = x2l_lm(i,index_x2l_Faxa_dstwet2) + atm2lnd_vars%forc_aer_grc(g,10) = x2l_lm(i,index_x2l_Faxa_dstdry2) + atm2lnd_vars%forc_aer_grc(g,11) = x2l_lm(i,index_x2l_Faxa_dstwet3) + atm2lnd_vars%forc_aer_grc(g,12) = x2l_lm(i,index_x2l_Faxa_dstdry3) + atm2lnd_vars%forc_aer_grc(g,13) = x2l_lm(i,index_x2l_Faxa_dstwet4) + atm2lnd_vars%forc_aer_grc(g,14) = x2l_lm(i,index_x2l_Faxa_dstdry4) + + !set the topounit-level atmospheric state and flux forcings + do topo = grc_pp%topi(g), grc_pp%topf(g) + ! first, all the state forcings + top_as%tbot(topo) = x2l_lm(i,index_x2l_Sa_tbot) ! forc_txy Atm state K + top_as%thbot(topo) = x2l_lm(i,index_x2l_Sa_ptem) ! forc_thxy Atm state K + top_as%pbot(topo) = x2l_lm(i,index_x2l_Sa_pbot) ! ptcmxy Atm state Pa + top_as%qbot(topo) = x2l_lm(i,index_x2l_Sa_shum) ! forc_qxy Atm state kg/kg + top_as%ubot(topo) = x2l_lm(i,index_x2l_Sa_u) ! forc_uxy Atm state m/s + top_as%vbot(topo) = x2l_lm(i,index_x2l_Sa_v) ! forc_vxy Atm state m/s + top_as%zbot(topo) = x2l_lm(i,index_x2l_Sa_z) ! zgcmxy Atm state m + ! assign the state forcing fields derived from other inputs + ! Horizontal windspeed (m/s) + top_as%windbot(topo) = sqrt(top_as%ubot(topo)**2 + top_as%vbot(topo)**2) + ! Relative humidity (percent) + if (top_as%tbot(topo) > SHR_CONST_TKFRZ) then + e = esatw(tdc(top_as%tbot(topo))) + else + e = esati(tdc(top_as%tbot(topo))) + end if + qsat = 0.622_r8*e / (top_as%pbot(topo) - 0.378_r8*e) + top_as%rhbot(topo) = 100.0_r8*(top_as%qbot(topo) / qsat) + ! partial pressure of oxygen (Pa) + top_as%po2bot(topo) = o2_molar_const * top_as%pbot(topo) + ! air density (kg/m**3) - uses a temporary calculation of water vapor pressure (Pa) + vp = top_as%qbot(topo) * top_as%pbot(topo) / (0.622_r8 + 0.378_r8 * top_as%qbot(topo)) + top_as%rhobot(topo) = (top_as%pbot(topo) - 0.378_r8 * vp) / (rair * top_as%tbot(topo)) + + ! second, all the flux forcings + top_af%rain(topo) = forc_rainc + forc_rainl ! sum of convective and large-scale rain + top_af%snow(topo) = forc_snowc + forc_snowl ! sum of convective and large-scale snow + top_af%solad(topo,2) = x2l_lm(i,index_x2l_Faxa_swndr) ! forc_sollxy Atm flux W/m^2 + top_af%solad(topo,1) = x2l_lm(i,index_x2l_Faxa_swvdr) ! forc_solsxy Atm flux W/m^2 + top_af%solai(topo,2) = x2l_lm(i,index_x2l_Faxa_swndf) ! forc_solldxy Atm flux W/m^2 + top_af%solai(topo,1) = x2l_lm(i,index_x2l_Faxa_swvdf) ! forc_solsdxy Atm flux W/m^2 + top_af%lwrad(topo) = x2l_lm(i,index_x2l_Faxa_lwdn) ! flwdsxy Atm flux W/m^2 + ! derived flux forcings + top_af%solar(topo) = top_af%solad(topo,2) + top_af%solad(topo,1) + & + top_af%solai(topo,2) + top_af%solai(topo,1) + end do + +#endif + + ! Determine optional receive fields + ! CO2 (and C13O2) concentration: constant, prognostic, or diagnostic + if (co2_type_idx == 0) then ! CO2 constant, value from namelist + co2_ppmv_val = co2_ppmv + else if (co2_type_idx == 1) then ! CO2 prognostic, value from coupler field + co2_ppmv_val = x2l_lm(i,index_x2l_Sa_co2prog) + else if (co2_type_idx == 2) then ! CO2 diagnostic, value from coupler field + co2_ppmv_val = x2l_lm(i,index_x2l_Sa_co2diag) + else + call endrun( sub//' ERROR: Invalid co2_type_idx, must be 0, 1, or 2 (constant, prognostic, or diagnostic)' ) + end if + ! Assign to topounits, with conversion from ppmv to partial pressure (Pa) + ! If using C13, then get the c13ratio from elm_varcon (constant value for pre-industrial atmosphere) + + do topo = grc_pp%topi(g), grc_pp%topf(g) + top_as%pco2bot(topo) = co2_ppmv_val * 1.e-6_r8 * top_as%pbot(topo) + if (use_c13) then + top_as%pc13o2bot(topo) = top_as%pco2bot(topo) * c13ratio; + end if + end do + ! CH4 + if (index_x2l_Sa_methane /= 0) then + do topo = grc_pp%topi(g), grc_pp%topf(g) + top_as%pch4bot(topo) = x2l_lm(i,index_x2l_Sa_methane) + end do + endif + + if (index_x2l_Sa_co2prog /= 0) then + co2_ppmv_prog = x2l_lm(i,index_x2l_Sa_co2prog) ! co2 atm state prognostic + else + co2_ppmv_prog = co2_ppmv + end if + + if (index_x2l_Sa_co2diag /= 0) then + co2_ppmv_diag = x2l_lm(i,index_x2l_Sa_co2diag) ! co2 atm state diagnostic + else + co2_ppmv_diag = co2_ppmv + end if + + if (index_x2l_Sa_methane /= 0) then + atm2lnd_vars%forc_pch4_grc(g) = x2l_lm(i,index_x2l_Sa_methane) + endif + + ! Determine derived quantities for required fields + + forc_t = atm2lnd_vars%forc_t_not_downscaled_grc(g) + forc_q = atm2lnd_vars%forc_q_not_downscaled_grc(g) + forc_pbot = atm2lnd_vars%forc_pbot_not_downscaled_grc(g) + + atm2lnd_vars%forc_hgt_u_grc(g) = atm2lnd_vars%forc_hgt_grc(g) !observational height of wind [m] + atm2lnd_vars%forc_hgt_t_grc(g) = atm2lnd_vars%forc_hgt_grc(g) !observational height of temperature [m] + atm2lnd_vars%forc_hgt_q_grc(g) = atm2lnd_vars%forc_hgt_grc(g) !observational height of humidity [m] + atm2lnd_vars%forc_vp_grc(g) = forc_q * forc_pbot / (0.622_r8 + 0.378_r8 * forc_q) + atm2lnd_vars%forc_rho_not_downscaled_grc(g) = & + (forc_pbot - 0.378_r8 * atm2lnd_vars%forc_vp_grc(g)) / (rair * forc_t) + atm2lnd_vars%forc_po2_grc(g) = o2_molar_const * forc_pbot + atm2lnd_vars%forc_wind_grc(g) = sqrt(atm2lnd_vars%forc_u_grc(g)**2 + atm2lnd_vars%forc_v_grc(g)**2) + atm2lnd_vars%forc_solar_grc(g) = atm2lnd_vars%forc_solad_grc(g,1) + atm2lnd_vars%forc_solai_grc(g,1) + & + atm2lnd_vars%forc_solad_grc(g,2) + atm2lnd_vars%forc_solai_grc(g,2) + + atm2lnd_vars%forc_rain_not_downscaled_grc(g) = forc_rainc + forc_rainl + atm2lnd_vars%forc_snow_not_downscaled_grc(g) = forc_snowc + forc_snowl + if (forc_t > SHR_CONST_TKFRZ) then + e = esatw(tdc(forc_t)) + else + e = esati(tdc(forc_t)) + end if + qsat = 0.622_r8*e / (forc_pbot - 0.378_r8*e) + atm2lnd_vars%forc_rh_grc(g) = 100.0_r8*(forc_q / qsat) + ! Make sure relative humidity is properly bounded + ! atm2lnd_vars%forc_rh_grc(g) = min( 100.0_r8, atm2lnd_vars%forc_rh_grc(g) ) + ! atm2lnd_vars%forc_rh_grc(g) = max( 0.0_r8, atm2lnd_vars%forc_rh_grc(g) ) + + ! Determine derived quantities for optional fields + ! Note that the following does unit conversions from ppmv to partial pressures (Pa) + ! Note that forc_pbot is in Pa + +#ifdef CPL_BYPASS + co2_type_idx = 2 +#endif + + if (co2_type_idx == 1) then + co2_ppmv_val = co2_ppmv_prog + else if (co2_type_idx == 2) then +#ifdef CPL_BYPASS + !atmospheric CO2 (to be used for transient simulations only) + if (atm2lnd_vars%loaded_bypassdata .eq. 0) then + ierr = nf90_open(trim(co2_file), nf90_nowrite, ncid) + ierr = nf90_inq_dimid(ncid, 'time', dimid) + ierr = nf90_Inquire_Dimension(ncid, dimid, len = thistimelen) + ierr = nf90_inq_varid(ncid, 'CO2', varid) + ierr = nf90_get_var(ncid, varid, atm2lnd_vars%co2_input(:,:,1:thistimelen)) + ierr = nf90_inq_varid(ncid, 'C13O2', varid) + ierr = nf90_get_var(ncid, varid, atm2lnd_vars%c13o2_input(:,:,1:thistimelen)) + ierr = nf90_close(ncid) + end if + + !get weights/indices for interpolation (assume values represent annual averages) + nindex(1) = min(max(yr,1850),2100)-1764 + if (thiscalday .le. 182.5) then + nindex(2) = nindex(1)-1 + else + nindex(2) = nindex(1)+1 + end if + wt1(1) = 1._r8 - abs((182.5 - (thiscalday -1._r8))/365._r8) + wt2(1) = 1._r8 - wt1(1) + + co2_ppmv_val = atm2lnd_vars%co2_input(1,1,nindex(1))*wt1(1) + atm2lnd_vars%co2_input(1,1,nindex(2))*wt2(1) + if (startdate_add_co2 .ne. '') then + if ((yr == sy_addco2 .and. mon == sm_addco2 .and. day >= sd_addco2) .or. & + (yr == sy_addco2 .and. mon > sm_addco2) .or. (yr > sy_addco2)) then + co2_ppmv_val=co2_ppmv_val + add_co2 + end if + end if + + if (use_c13) then + atm2lnd_vars%forc_pc13o2_grc(g) = (atm2lnd_vars%c13o2_input(1,1,nindex(1))*wt1(1) + & + atm2lnd_vars%c13o2_input(1,1,nindex(2))*wt2(1)) * 1.e-6_r8 * forc_pbot + end if + co2_type_idx = 1 +#else + co2_ppmv_val = co2_ppmv_diag + if (use_c13) then + atm2lnd_vars%forc_pc13o2_grc(g) = co2_ppmv_val * c13ratio * 1.e-6_r8 * forc_pbot + end if +#endif + else + co2_ppmv_val = co2_ppmv + if (use_c13) then + atm2lnd_vars%forc_pc13o2_grc(g) = co2_ppmv_val * c13ratio * 1.e-6_r8 * forc_pbot + end if + end if + atm2lnd_vars%forc_pco2_grc(g) = co2_ppmv_val * 1.e-6_r8 * forc_pbot + +#ifdef CPL_BYPASS + do topo = grc_pp%topi(g), grc_pp%topf(g) + top_as%pco2bot(topo) = atm2lnd_vars%forc_pco2_grc(g) + if (use_c13) then + top_as%pc13o2bot(topo) = atm2lnd_vars%forc_pc13o2_grc(g) + end if + end do +#endif + + ! glc coupling + + if (create_glacier_mec_landunit) then + do num = 0,glc_nec + glc2lnd_vars%frac_grc(g,num) = x2l_lm(i,index_x2l_Sg_frac(num)) + glc2lnd_vars%topo_grc(g,num) = x2l_lm(i,index_x2l_Sg_topo(num)) + glc2lnd_vars%hflx_grc(g,num) = x2l_lm(i,index_x2l_Flgg_hflx(num)) + end do + glc2lnd_vars%icemask_grc(g) = x2l_lm(i,index_x2l_Sg_icemask) + glc2lnd_vars%icemask_coupled_fluxes_grc(g) = x2l_lm(i,index_x2l_Sg_icemask_coupled_fluxes) + end if + + end do +#ifdef CPL_BYPASS + atm2lnd_vars%loaded_bypassdata = 1 +#endif + + end subroutine lnd_import_moab + ! endif for ifdef HAVE_MOAB #endif diff --git a/driver-moab/main/prep_ocn_mod.F90 b/driver-moab/main/prep_ocn_mod.F90 index 87b5132e17dc..e0ed134eb14c 100644 --- a/driver-moab/main/prep_ocn_mod.F90 +++ b/driver-moab/main/prep_ocn_mod.F90 @@ -605,6 +605,8 @@ subroutine prep_ocn_init(infodata, atm_c2_ocn, atm_c2_ice, ice_c2_ocn, rof_c2_oc type1 = 3 ! fv mesh nowadays direction = 1 ! context_id = ocn(1)%cplcompid + ! this creates a par comm graph between mbrxid and mbrxoid, with ids rof(1)%cplcompid, context ocn(1)%cplcompid + ! this will be used in send/receive mappers ierr = iMOAB_MigrateMapMesh (mbrxid, mbrmapro, mbrxoid, mpicom_CPLID, mpigrp_CPLID, & mpigrp_CPLID, type1, rof(1)%cplcompid, context_id, direction) @@ -659,7 +661,7 @@ subroutine prep_ocn_init(infodata, atm_c2_ocn, atm_c2_ice, ice_c2_ocn, rof_c2_oc mapper_Rr2o_liq%tgt_mbid = mbrxoid ! this is special, it will really need this coverage type mesh mapper_Rr2o_liq%intx_mbid = mbrmapro mapper_Rr2o_liq%src_context = rof(1)%cplcompid - mapper_Rr2o_liq%intx_context = ocn(1)%cplcompid + mapper_Rr2o_liq%intx_context = ocn(1)%cplcompid ! this context was used in migrate mesh wgtIdef = 'map-from-file'//C_NULL_CHAR mapper_Rr2o_liq%weight_identifier = wgtIdef mapper_Rr2o_liq%mbname = 'mapper_Rr2o_liq' @@ -679,7 +681,7 @@ subroutine prep_ocn_init(infodata, atm_c2_ocn, atm_c2_ice, ice_c2_ocn, rof_c2_oc mapper_Rr2o_ice%tgt_mbid = mbrxoid ! special mapper_Rr2o_ice%intx_mbid = mbrmapro mapper_Rr2o_ice%src_context = rof(1)%cplcompid - mapper_Rr2o_ice%intx_context = ocn(1)%cplcompid + mapper_Rr2o_ice%intx_context = ocn(1)%cplcompid ! this context was used in migrate mesh wgtIdef = 'map-from-file'//C_NULL_CHAR mapper_Rr2o_ice%weight_identifier = wgtIdef mapper_Rr2o_ice%mbname = 'mapper_Rr2o_ice' @@ -698,7 +700,7 @@ subroutine prep_ocn_init(infodata, atm_c2_ocn, atm_c2_ice, ice_c2_ocn, rof_c2_oc mapper_Fr2o%tgt_mbid = mbrxoid ! special mapper_Fr2o%intx_mbid = mbrmapro mapper_Fr2o%src_context = rof(1)%cplcompid - mapper_Fr2o%intx_context = ocn(1)%cplcompid + mapper_Fr2o%intx_context = ocn(1)%cplcompid ! this context was used in migrate mesh wgtIdef = 'map-from-file'//C_NULL_CHAR mapper_Fr2o%weight_identifier = wgtIdef mapper_Fr2o%mbname = 'mapper_Fr2o' From 3356d40e0d278d53650d036cb5ed77f9ccdfe122 Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Fri, 13 Jan 2023 23:22:58 -0600 Subject: [PATCH 292/467] finish land import compare with mct AVs, with compare_to_moab_tag_lnd --- components/elm/src/cpl/lnd_comp_mct.F90 | 115 +++++++++++++++++++++++- 1 file changed, 113 insertions(+), 2 deletions(-) diff --git a/components/elm/src/cpl/lnd_comp_mct.F90 b/components/elm/src/cpl/lnd_comp_mct.F90 index 27c266afbf45..e51f148fc48a 100644 --- a/components/elm/src/cpl/lnd_comp_mct.F90 +++ b/components/elm/src/cpl/lnd_comp_mct.F90 @@ -17,6 +17,8 @@ module lnd_comp_mct #ifdef HAVE_MOAB use seq_comm_mct, only: mlnid! id of moab land app + use seq_comm_mct, only: num_moab_exports + use seq_flds_mod , only : seq_flds_x2l_fields, seq_flds_l2x_fields #endif ! ! !public member functions: @@ -43,6 +45,12 @@ module lnd_comp_mct integer :: nrecv, totalmblsimp real (r8) , allocatable, private :: x2l_lm(:,:) ! for tags from MOAB logical :: sameg_al ! save it for export :) + +#ifdef MOABDEBUG + integer :: mpicom_lnd_moab ! used just for mpi-reducing the difference betweebn moab tags and mct avs + integer :: rank2 +#endif + #endif !--------------------------------------------------------------------------- @@ -154,6 +162,10 @@ subroutine lnd_init_mct( EClock, cdata_l, x2l_l, l2x_l, NLFilename ) gsMap=GSMap_lnd, dom=dom_l, infodata=infodata) ! Determine attriute vector indices +#ifdef MOABDEBUG + mpicom_lnd_moab = mpicom_lnd ! just store it now, for later use + call shr_mpi_commrank( mpicom_lnd_moab, rank2 ) +#endif call elm_cpl_indices_set() @@ -483,6 +495,13 @@ subroutine lnd_run_mct(EClock, cdata_l, x2l_l, l2x_l) type(bounds_type) :: bounds ! bounds character(len=32) :: rdate ! date char string for restart file names character(len=32), parameter :: sub = "lnd_run_mct" +#ifdef MOABDEBUG + real(r8) :: difference + type(mct_list) :: temp_list + integer :: size_list, index_list, ent_type + type(mct_string) :: mctOStr ! + character(100) ::tagname, mct_field +#endif !--------------------------------------------------------------------------- ! Determine processor bounds @@ -532,6 +551,24 @@ subroutine lnd_run_mct(EClock, cdata_l, x2l_l, l2x_l) call t_startf ('lc_lnd_import') ! first call moab import +#ifdef MOABDEBUG + !compare_to_moab_tag_lnd(mpicom_moab, attrVect, field, imoabApp, tag_name, ent_type, difference) + !x2o_o => component_get_x2c_cx(ocn(1)) + ! loop over all fields in seq_flds_x2a_fields + call mct_list_init(temp_list ,seq_flds_x2l_fields) + size_list=mct_list_nitem (temp_list) + ent_type = 0 ! entity type is vertex for land, usually (bigrid case) + if (rank2 .eq. 0) print *, num_moab_exports, trim(seq_flds_x2l_fields), ' lnd import check' + 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 compare_to_moab_tag_lnd(mpicom_lnd_moab, x2l_l, mct_field, mlnid, tagname, ent_type, difference) + enddo + call mct_list_clean(temp_list) + +#endif + #ifdef HAVE_MOAB call lnd_import_moab( bounds, atm2lnd_vars, glc2lnd_vars) #endif @@ -1113,7 +1150,6 @@ subroutine lnd_export_moab( bounds, lnd2atm_vars, lnd2glc_vars) use shr_megan_mod , only : shr_megan_mechcomps_n use iMOAB, only : iMOAB_SetDoubleTagStorage, iMOAB_WriteMesh use seq_flds_mod, only : seq_flds_l2x_fields - use seq_comm_mct, only : num_moab_exports ! ! !ARGUMENTS: implicit none @@ -1251,6 +1287,7 @@ subroutine lnd_import_moab( bounds, atm2lnd_vars, glc2lnd_vars) ! Convert the input data from the moab coupler to the land model use seq_flds_mod , only : seq_flds_l2x_fields, seq_flds_x2l_fields use iMOAB, only : iMOAB_GetDoubleTagStorage + use shr_kind_mod , only : CXX => SHR_KIND_CXX ! !USES: use elm_varctl , only: co2_type, co2_ppmv, iulog, use_c13, create_glacier_mec_landunit, & metdata_type, metdata_bypass, metdata_biases, co2_file, aero_file @@ -1343,7 +1380,7 @@ subroutine lnd_import_moab( bounds, atm2lnd_vars, glc2lnd_vars) logical :: use_sitedata, has_zonefile, use_daymet, use_livneh ! moab extra stuff - character(400) :: tagname ! hold all fields names + character(CXX) :: tagname ! hold all fields names integer :: ent_type ! for setting data data caldaym / 1, 32, 60, 91, 121, 152, 182, 213, 244, 274, 305, 335, 366 / @@ -2546,6 +2583,80 @@ subroutine lnd_import_moab( bounds, atm2lnd_vars, glc2lnd_vars) end subroutine lnd_import_moab + +#ifdef MOABDEBUG + ! assumes everything is on component side, to compare before imports + subroutine compare_to_moab_tag_lnd(mpicom, attrVect, mct_field, appId, tagname, ent_type, difference) + + use shr_mpi_mod, only: shr_mpi_sum, shr_mpi_commrank + use shr_kind_mod, only: CXX => shr_kind_CXX + use seq_comm_mct , only : CPLID, seq_comm_iamroot + use seq_comm_mct, only: seq_comm_setptrs + use iMOAB, only : iMOAB_DefineTagStorage, iMOAB_GetDoubleTagStorage, & + iMOAB_SetDoubleTagStorageWithGid, iMOAB_GetMeshInfo + + use iso_c_binding + + integer, intent(in) :: mpicom + integer , intent(in) :: appId, ent_type + type(mct_aVect) , intent(in) :: attrVect + character(*) , intent(in) :: mct_field + character(*) , intent(in) :: tagname + + real(r8) , intent(out) :: difference + + real(r8) :: differenceg ! global, reduced diff + integer :: mbSize, nloc, index_avfield, rank2 + + ! moab + integer :: tagtype, numco, tagindex, ierr + character(CXX) :: tagname_mct + + real(r8) , allocatable :: values(:), mct_values(:) + integer nvert(3), nvise(3), nbl(3), nsurf(3), nvisBC(3) + logical :: iamroot + + + character(*),parameter :: subName = '(compare_to_moab_tag_lnd) ' + + nloc = mct_avect_lsize(attrVect) + allocate(mct_values(nloc)) + + index_avfield = mct_aVect_indexRA(attrVect,trim(mct_field)) + mct_values(:) = attrVect%rAttr(index_avfield,:) + + ! now get moab tag values; first get info + ierr = iMOAB_GetMeshInfo ( appId, nvert, nvise, nbl, nsurf, nvisBC ); + if (ierr > 0 ) & + call shr_sys_abort(subname//'Error: fail to get mesh info') + if (ent_type .eq. 0) then + mbSize = nvert(1) + else if (ent_type .eq. 1) then + mbSize = nvise(1) + endif + allocate(values(mbSize)) + + ierr = iMOAB_GetDoubleTagStorage ( appId, tagname, mbSize , ent_type, values) + if (ierr > 0 ) & + call shr_sys_abort(subname//'Error: fail to get moab tag values') + + values = mct_values - values + + difference = dot_product(values, values) + call shr_mpi_sum(difference,differenceg,mpicom,subname) + difference = sqrt(differenceg) + call shr_mpi_commrank( mpicom, rank2 ) + if ( rank2 .eq. 0 ) then + print * , subname, ' , difference on tag ', trim(tagname), ' = ', difference + !call shr_sys_abort(subname//'differences between mct and moab values') + endif + deallocate(values) + deallocate(mct_values) + + end subroutine compare_to_moab_tag_lnd + ! #endif for MOABDEBUG +#endif + ! endif for ifdef HAVE_MOAB #endif From 645d4b7681a821a23e661d1a2e879ac4aee52e50 Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Sat, 14 Jan 2023 22:25:06 -0600 Subject: [PATCH 293/467] rof merge and comparison with mct --- driver-moab/main/cime_comp_mod.F90 | 2 + driver-moab/main/prep_rof_mod.F90 | 410 ++++++++++++++++++++++++++++- 2 files changed, 407 insertions(+), 5 deletions(-) diff --git a/driver-moab/main/cime_comp_mod.F90 b/driver-moab/main/cime_comp_mod.F90 index bfc7d48edc49..7a07e2be6459 100644 --- a/driver-moab/main/cime_comp_mod.F90 +++ b/driver-moab/main/cime_comp_mod.F90 @@ -4668,6 +4668,8 @@ subroutine cime_run_rof_setup_send() if (atm_c2_rof) call prep_rof_calc_a2r_rx(timer='CPL:rofprep_atm2rof') call prep_rof_mrg(infodata, fractions_rx, timer_mrg='CPL:rofprep_mrgx2r', cime_model=cime_model) + !moab version + call prep_rof_mrg_moab(infodata, cime_model=cime_model) call component_diag(infodata, rof, flow='x2c', comment= 'send rof', & info_debug=info_debug, timer_diag='CPL:rofprep_diagav') diff --git a/driver-moab/main/prep_rof_mod.F90 b/driver-moab/main/prep_rof_mod.F90 index ee6d12f3d983..92cf67cd4cfd 100644 --- a/driver-moab/main/prep_rof_mod.F90 +++ b/driver-moab/main/prep_rof_mod.F90 @@ -8,7 +8,6 @@ module prep_rof_mod use shr_sys_mod, only: shr_sys_abort, shr_sys_flush use seq_comm_mct, only: num_inst_lnd, num_inst_rof, num_inst_frc, num_inst_atm use seq_comm_mct, only: CPLID, ROFID, logunit - use seq_comm_mct, only: mrofid ! id for rof comp use seq_comm_mct, only: mblxid ! iMOAB id for land on coupler (read now from h5m file) use seq_comm_mct, only: mbaxid ! iMOAB id for atm migrated mesh to coupler pes (migrate either mhid or mhpgx, depending on atm_pg_active) use seq_comm_mct, only: mbrxid ! iMOAB id of moab rof read on couple pes @@ -32,6 +31,9 @@ module prep_rof_mod use map_lnd2rof_irrig_mod, only: map_lnd2rof_irrig use iso_c_binding +#ifdef MOABDEBUG + use component_type_mod, only: compare_mct_av_moab_tag +#endif implicit none save @@ -44,6 +46,10 @@ module prep_rof_mod public :: prep_rof_init public :: prep_rof_mrg +#ifdef HAVE_MOAB + public :: prep_rof_mrg_moab +#endif + public :: prep_rof_accum_lnd public :: prep_rof_accum_atm public :: prep_rof_accum_avg @@ -95,6 +101,15 @@ module prep_rof_mod logical :: have_irrig_field ! samegrid atm and lnd logical :: samegrid_al ! samegrid atm and lnd + + ! moab stuff + real (kind=r8) , allocatable, private :: fractions_rm (:,:) ! will retrieve the fractions from rof, and use them + ! they were init with + ! character(*),parameter :: fraclist_r = 'lfrac:lfrin:rfrac' in moab, on the fractions + real (kind=r8) , allocatable, private :: x2r_rm (:,:) ! result of merge + real (kind=r8) , allocatable, private :: a2x_rm (:,:) + real (kind=r8) , allocatable, private :: l2x_rm (:,:) + !================================================================================================ contains @@ -260,7 +275,7 @@ subroutine prep_rof_init(infodata, lnd_c2_rof, atm_c2_rof) ! because we will project fields from lnd to rof grid, we need to define ! the l2x fields to rof grid on coupler side - tagname = trim(seq_flds_l2x_fields)//C_NULL_CHAR + tagname = trim(seq_flds_l2x_fluxes_to_rof)//C_NULL_CHAR tagtype = 1 ! dense numco = 1 ! ierr = iMOAB_DefineTagStorage(mbrxid, tagname, tagtype, numco, tagindex ) @@ -411,13 +426,13 @@ subroutine prep_rof_init(infodata, lnd_c2_rof, atm_c2_rof) ! because we will project fields from atm to rof grid, we need to define ! rof a2x fields to rof grid on coupler side - tagname = trim(seq_flds_a2x_fields)//C_NULL_CHAR + tagname = trim(seq_flds_a2x_fields_to_rof)//C_NULL_CHAR tagtype = 1 ! dense numco = 1 ! ierr = iMOAB_DefineTagStorage(mbrxid, tagname, tagtype, numco, tagindex ) if (ierr .ne. 0) then - write(logunit,*) subname,' error in defining tags for seq_flds_a2x_fields on rof cpl' - call shr_sys_abort(subname//' ERROR in defining tags for seq_flds_a2x_fields on rof cpl') + write(logunit,*) subname,' error in defining tags for seq_flds_a2x_fields_to_rof on rof cpl' + call shr_sys_abort(subname//' ERROR in defining tags for seq_flds_a2x_fields_to_rof on rof cpl') endif volumetric = 0 ! can be 1 only for FV->DGLL or FV->CGLL; @@ -906,7 +921,392 @@ subroutine prep_rof_merge(l2x_r, a2x_r, fractions_r, x2r_r, cime_model) first_time = .false. end subroutine prep_rof_merge +#ifdef HAVE_MOAB + subroutine prep_rof_mrg_moab (infodata, cime_model) + use iMOAB , only : iMOAB_GetMeshInfo, iMOAB_GetDoubleTagStorage, & + iMOAB_SetDoubleTagStorage, iMOAB_WriteMesh + use seq_comm_mct, only : num_moab_exports ! for debug + + type(seq_infodata_type) , intent(in) :: infodata + + ! type(mct_aVect) , intent(in) :: fractions_rx(:) they should have been saved as tags on rof coupler component + character(len=*) , intent(in) :: cime_model + !----------------------------------------------------------------------- + ! Description + ! Merge land rof and ice forcing for rof input + ! + ! used for indexing + type(mct_avect) , pointer :: l2x_r + type(mct_avect) , pointer :: a2x_r + type(mct_avect) , pointer :: fractions_r + type(mct_avect) , pointer :: x2r_r + ! + ! Local variables + integer :: i + integer, save :: index_l2x_Flrl_rofsur + integer, save :: index_l2x_Flrl_rofgwl + integer, save :: index_l2x_Flrl_rofsub + integer, save :: index_l2x_Flrl_rofdto + integer, save :: index_l2x_Flrl_rofi + integer, save :: index_l2x_Flrl_demand + integer, save :: index_l2x_Flrl_irrig + integer, save :: index_x2r_Flrl_rofsur + integer, save :: index_x2r_Flrl_rofgwl + integer, save :: index_x2r_Flrl_rofsub + integer, save :: index_x2r_Flrl_rofdto + integer, save :: index_x2r_Flrl_rofi + integer, save :: index_x2r_Flrl_demand + integer, save :: index_x2r_Flrl_irrig + integer, save :: index_l2x_Flrl_rofl_16O + integer, save :: index_l2x_Flrl_rofi_16O + integer, save :: index_x2r_Flrl_rofl_16O + integer, save :: index_x2r_Flrl_rofi_16O + integer, save :: index_l2x_Flrl_rofl_18O + integer, save :: index_l2x_Flrl_rofi_18O + integer, save :: index_x2r_Flrl_rofl_18O + integer, save :: index_x2r_Flrl_rofi_18O + integer, save :: index_l2x_Flrl_rofl_HDO + integer, save :: index_l2x_Flrl_rofi_HDO + integer, save :: index_x2r_Flrl_rofl_HDO + integer, save :: index_x2r_Flrl_rofi_HDO + + integer, save :: index_l2x_Flrl_Tqsur + integer, save :: index_l2x_Flrl_Tqsub + integer, save :: index_a2x_Sa_tbot + integer, save :: index_a2x_Sa_pbot + integer, save :: index_a2x_Sa_u + integer, save :: index_a2x_Sa_v + integer, save :: index_a2x_Sa_shum + integer, save :: index_a2x_Faxa_swndr + integer, save :: index_a2x_Faxa_swndf + integer, save :: index_a2x_Faxa_swvdr + integer, save :: index_a2x_Faxa_swvdf + integer, save :: index_a2x_Faxa_lwdn + integer, save :: index_x2r_Flrl_Tqsur + integer, save :: index_x2r_Flrl_Tqsub + integer, save :: index_x2r_Sa_tbot + integer, save :: index_x2r_Sa_pbot + integer, save :: index_x2r_Sa_u + integer, save :: index_x2r_Sa_v + integer, save :: index_x2r_Sa_shum + integer, save :: index_x2r_Faxa_swndr + integer, save :: index_x2r_Faxa_swndf + integer, save :: index_x2r_Faxa_swvdr + integer, save :: index_x2r_Faxa_swvdf + integer, save :: index_x2r_Faxa_lwdn + + integer, save :: index_l2x_coszen_str + integer, save :: index_x2r_coszen_str + + integer, save :: index_frac + real(r8) :: frac + character(CL) :: fracstr + logical, save :: first_time = .true. + logical, save :: flds_wiso_rof = .false. + integer, save :: nflds, lsize + logical :: iamroot + character(CL) :: field ! field string + character(CL),allocatable :: mrgstr(:) ! temporary string + character(*), parameter :: subname = '(prep_rof_mrg_moab) ' + + integer nvert(3), nvise(3), nbl(3), nsurf(3), nvisBC(3) ! for moab info + + character(CXX) ::tagname, mct_field + integer :: ent_type, ierr, arrsize + integer, save :: naflds, nlflds ! these are saved the first time +#ifdef MOABDEBUG + character*32 :: outfile, wopts, lnum + real(r8) :: difference + type(mct_list) :: temp_list + integer :: size_list, index_list + type(mct_string) :: mctOStr ! +#endif + !----------------------------------------------------------------------- + + call seq_comm_getdata(CPLID, iamroot=iamroot) + +! character(*),parameter :: fraclist_r = 'lfrac:lfrin:rfrac' + if (first_time) then + ! find out the number of local elements in moab mesh rof instance on coupler + ierr = iMOAB_GetMeshInfo ( mbrxid, nvert, nvise, nbl, nsurf, nvisBC ); + if (ierr .ne. 0) then + write(logunit,*) subname,' error in getting info ' + call shr_sys_abort(subname//' error in getting info ') + endif + lsize = nvise(1) ! number of active cells + ! mct avs are used just for their fields metadata, not the actual reals + ! (name of the fields) + ! need these always, not only the first time + l2x_r => l2r_rx(1) + a2x_r => a2r_rx(1) + + x2r_r => component_get_x2c_cx(rof(1)) + nflds = mct_aVect_nRattr(x2r_r) ! these are saved after first time + naflds = mct_aVect_nRattr(a2x_r) + nlflds = mct_aVect_nRattr(l2x_r) + + allocate(x2r_rm (lsize, nflds)) + allocate(a2x_rm (lsize, naflds)) + allocate(l2x_rm (lsize, nlflds)) + ! allocate fractions too + ! use the fraclist fraclist_r = 'lfrac:lfrin:rfrac' + allocate(fractions_rm(lsize,3)) ! there are 3 fields here + + allocate(mrgstr(nflds)) + do i = 1,nflds + field = mct_aVect_getRList2c(i, x2r_r) + mrgstr(i) = subname//'x2r%'//trim(field)//' =' + enddo + + index_l2x_Flrl_rofsur = mct_aVect_indexRA(l2x_r,'Flrl_rofsur' ) + index_l2x_Flrl_rofgwl = mct_aVect_indexRA(l2x_r,'Flrl_rofgwl' ) + index_l2x_Flrl_rofsub = mct_aVect_indexRA(l2x_r,'Flrl_rofsub' ) + index_l2x_Flrl_rofdto = mct_aVect_indexRA(l2x_r,'Flrl_rofdto' ) + if (have_irrig_field) then + index_l2x_Flrl_irrig = mct_aVect_indexRA(l2x_r,'Flrl_irrig' ) + end if + index_l2x_Flrl_rofi = mct_aVect_indexRA(l2x_r,'Flrl_rofi' ) + if(trim(cime_model) .eq. 'e3sm') then + index_l2x_Flrl_demand = mct_aVect_indexRA(l2x_r,'Flrl_demand' ) + index_x2r_Flrl_demand = mct_aVect_indexRA(x2r_r,'Flrl_demand' ) + endif + index_x2r_Flrl_rofsur = mct_aVect_indexRA(x2r_r,'Flrl_rofsur' ) + index_x2r_Flrl_rofgwl = mct_aVect_indexRA(x2r_r,'Flrl_rofgwl' ) + index_x2r_Flrl_rofsub = mct_aVect_indexRA(x2r_r,'Flrl_rofsub' ) + index_x2r_Flrl_rofdto = mct_aVect_indexRA(x2r_r,'Flrl_rofdto' ) + index_x2r_Flrl_rofi = mct_aVect_indexRA(x2r_r,'Flrl_rofi' ) + if (have_irrig_field) then + index_x2r_Flrl_irrig = mct_aVect_indexRA(x2r_r,'Flrl_irrig' ) + end if + if(trim(cime_model) .eq. 'e3sm') then + index_l2x_Flrl_Tqsur = mct_aVect_indexRA(l2x_r,'Flrl_Tqsur' ) + index_l2x_Flrl_Tqsub = mct_aVect_indexRA(l2x_r,'Flrl_Tqsub' ) + index_x2r_Flrl_Tqsur = mct_aVect_indexRA(x2r_r,'Flrl_Tqsur' ) + index_x2r_Flrl_Tqsub = mct_aVect_indexRA(x2r_r,'Flrl_Tqsub' ) + endif + + index_l2x_Flrl_rofl_16O = mct_aVect_indexRA(l2x_r,'Flrl_rofl_16O', perrWith='quiet' ) + if ( index_l2x_Flrl_rofl_16O /= 0 ) flds_wiso_rof = .true. + if ( flds_wiso_rof ) then + index_l2x_Flrl_rofi_16O = mct_aVect_indexRA(l2x_r,'Flrl_rofi_16O' ) + index_x2r_Flrl_rofl_16O = mct_aVect_indexRA(x2r_r,'Flrl_rofl_16O' ) + index_x2r_Flrl_rofi_16O = mct_aVect_indexRA(x2r_r,'Flrl_rofi_16O' ) + + index_l2x_Flrl_rofl_18O = mct_aVect_indexRA(l2x_r,'Flrl_rofl_18O' ) + index_l2x_Flrl_rofi_18O = mct_aVect_indexRA(l2x_r,'Flrl_rofi_18O' ) + index_x2r_Flrl_rofl_18O = mct_aVect_indexRA(x2r_r,'Flrl_rofl_18O' ) + index_x2r_Flrl_rofi_18O = mct_aVect_indexRA(x2r_r,'Flrl_rofi_18O' ) + + index_l2x_Flrl_rofl_HDO = mct_aVect_indexRA(l2x_r,'Flrl_rofl_HDO' ) + index_l2x_Flrl_rofi_HDO = mct_aVect_indexRA(l2x_r,'Flrl_rofi_HDO' ) + index_x2r_Flrl_rofl_HDO = mct_aVect_indexRA(x2r_r,'Flrl_rofl_HDO' ) + index_x2r_Flrl_rofi_HDO = mct_aVect_indexRA(x2r_r,'Flrl_rofi_HDO' ) + end if + + if (samegrid_al) then ! fraclist_r = 'lfrac:lfrin:rfrac' + ! check, in our case, is it always 1 ? + index_frac = 1 ! mct_aVect_indexRA(fractions_r,"lfrac") + fracstr = 'lfrac' + else + index_frac = 2 ! mct_aVect_indexRA(fractions_r,"lfrin") + fracstr = 'lfrin' + endif + + mrgstr(index_x2r_Flrl_rofsur) = trim(mrgstr(index_x2r_Flrl_rofsur))//' = '// & + trim(fracstr)//'*l2x%Flrl_rofsur' + mrgstr(index_x2r_Flrl_rofgwl) = trim(mrgstr(index_x2r_Flrl_rofgwl))//' = '// & + trim(fracstr)//'*l2x%Flrl_rofgwl' + mrgstr(index_x2r_Flrl_rofsub) = trim(mrgstr(index_x2r_Flrl_rofsub))//' = '// & + trim(fracstr)//'*l2x%Flrl_rofsub' + mrgstr(index_x2r_Flrl_rofdto) = trim(mrgstr(index_x2r_Flrl_rofdto))//' = '// & + trim(fracstr)//'*l2x%Flrl_rofdto' + mrgstr(index_x2r_Flrl_rofi) = trim(mrgstr(index_x2r_Flrl_rofi))//' = '// & + trim(fracstr)//'*l2x%Flrl_rofi' + if (trim(cime_model).eq.'e3sm') then + mrgstr(index_x2r_Flrl_demand) = trim(mrgstr(index_x2r_Flrl_demand))//' = '// & + trim(fracstr)//'*l2x%Flrl_demand' + endif + if (have_irrig_field) then + mrgstr(index_x2r_Flrl_irrig) = trim(mrgstr(index_x2r_Flrl_irrig))//' = '// & + trim(fracstr)//'*l2x%Flrl_irrig' + end if + if(trim(cime_model) .eq. 'e3sm') then + mrgstr(index_x2r_Flrl_Tqsur) = trim(mrgstr(index_x2r_Flrl_Tqsur))//' = '//'l2x%Flrl_Tqsur' + mrgstr(index_x2r_Flrl_Tqsur) = trim(mrgstr(index_x2r_Flrl_Tqsub))//' = '//'l2x%Flrl_Tqsub' + endif + if ( flds_wiso_rof ) then + mrgstr(index_x2r_Flrl_rofl_16O) = trim(mrgstr(index_x2r_Flrl_rofl_16O))//' = '// & + trim(fracstr)//'*l2x%Flrl_rofl_16O' + mrgstr(index_x2r_Flrl_rofi_16O) = trim(mrgstr(index_x2r_Flrl_rofi_16O))//' = '// & + trim(fracstr)//'*l2x%Flrl_rofi_16O' + mrgstr(index_x2r_Flrl_rofl_18O) = trim(mrgstr(index_x2r_Flrl_rofl_18O))//' = '// & + trim(fracstr)//'*l2x%Flrl_rofl_18O' + mrgstr(index_x2r_Flrl_rofi_18O) = trim(mrgstr(index_x2r_Flrl_rofi_18O))//' = '// & + trim(fracstr)//'*l2x%Flrl_rofi_18O' + mrgstr(index_x2r_Flrl_rofl_HDO) = trim(mrgstr(index_x2r_Flrl_rofl_HDO))//' = '// & + trim(fracstr)//'*l2x%Flrl_rofl_HDO' + mrgstr(index_x2r_Flrl_rofi_HDO) = trim(mrgstr(index_x2r_Flrl_rofi_HDO))//' = '// & + trim(fracstr)//'*l2x%Flrl_rofi_HDO' + end if + + if ( rof_heat ) then + index_a2x_Sa_tbot = mct_aVect_indexRA(a2x_r,'Sa_tbot') + index_a2x_Sa_pbot = mct_aVect_indexRA(a2x_r,'Sa_pbot') + index_a2x_Sa_u = mct_aVect_indexRA(a2x_r,'Sa_u') + index_a2x_Sa_v = mct_aVect_indexRA(a2x_r,'Sa_v') + index_a2x_Sa_shum = mct_aVect_indexRA(a2x_r,'Sa_shum') + index_a2x_Faxa_swndr = mct_aVect_indexRA(a2x_r,'Faxa_swndr') + index_a2x_Faxa_swndf = mct_aVect_indexRA(a2x_r,'Faxa_swndf') + index_a2x_Faxa_swvdr = mct_aVect_indexRA(a2x_r,'Faxa_swvdr') + index_a2x_Faxa_swvdf = mct_aVect_indexRA(a2x_r,'Faxa_swvdf') + index_a2x_Faxa_lwdn = mct_aVect_indexRA(a2x_r,'Faxa_lwdn') + + index_x2r_Sa_tbot = mct_aVect_indexRA(x2r_r,'Sa_tbot') + index_x2r_Sa_pbot = mct_aVect_indexRA(x2r_r,'Sa_pbot') + index_x2r_Sa_u = mct_aVect_indexRA(x2r_r,'Sa_u') + index_x2r_Sa_v = mct_aVect_indexRA(x2r_r,'Sa_v') + index_x2r_Sa_shum = mct_aVect_indexRA(x2r_r,'Sa_shum') + index_x2r_Faxa_swndr = mct_aVect_indexRA(x2r_r,'Faxa_swndr') + index_x2r_Faxa_swndf = mct_aVect_indexRA(x2r_r,'Faxa_swndf') + index_x2r_Faxa_swvdr = mct_aVect_indexRA(x2r_r,'Faxa_swvdr') + index_x2r_Faxa_swvdf = mct_aVect_indexRA(x2r_r,'Faxa_swvdf') + index_x2r_Faxa_lwdn = mct_aVect_indexRA(x2r_r,'Faxa_lwdn') + + mrgstr(index_x2r_Sa_tbot) = trim(mrgstr(index_x2r_Sa_tbot))//' = '//'a2x%Sa_tbot' + mrgstr(index_x2r_Sa_pbot) = trim(mrgstr(index_x2r_Sa_pbot))//' = '//'a2x%Sa_pbot' + mrgstr(index_x2r_Sa_u) = trim(mrgstr(index_x2r_Sa_u))//' = '//'a2x%Sa_u' + mrgstr(index_x2r_Sa_v) = trim(mrgstr(index_x2r_Sa_v))//' = '//'a2x%Sa_v' + mrgstr(index_x2r_Sa_shum) = trim(mrgstr(index_x2r_Sa_shum))//' = '//'a2x%Sa_shum' + mrgstr(index_x2r_Faxa_swndr) = trim(mrgstr(index_x2r_Faxa_swndr))//' = '//'a2x%Faxa_swndr' + mrgstr(index_x2r_Faxa_swndf) = trim(mrgstr(index_x2r_Faxa_swndf))//' = '//'a2x%Faxa_swndf' + mrgstr(index_x2r_Faxa_swvdr) = trim(mrgstr(index_x2r_Faxa_swvdr))//' = '//'a2x%Faxa_swvdr' + mrgstr(index_x2r_Faxa_swvdf) = trim(mrgstr(index_x2r_Faxa_swvdf))//' = '//'a2x%Faxa_swvdf' + mrgstr(index_x2r_Faxa_lwdn) = trim(mrgstr(index_x2r_Faxa_lwdn))//' = '//'a2x%Faxa_lwdn' + endif + + end if +! fill in with data from moab tags + +! fill with fractions from river instance +! fractions_rm, + ent_type = 1 ! cells + tagname = 'lfrac:lfrin:rfrac'//C_NULL_CHAR + arrsize = 3 * lsize + ierr = iMOAB_GetDoubleTagStorage ( mbrxid, tagname, arrsize , ent_type, fractions_rm(1,1)) + if (ierr .ne. 0) then + call shr_sys_abort(subname//' error in getting fractions_om from rof instance ') + endif + ! fill the r2x_rm, etc double array fields nflds + tagname = trim(seq_flds_x2r_fields)//C_NULL_CHAR + arrsize = nflds * lsize + ierr = iMOAB_GetDoubleTagStorage ( mbrxid, tagname, arrsize , ent_type, x2r_rm(1,1)) + if (ierr .ne. 0) then + call shr_sys_abort(subname//' error in getting x2r_rm array ') + endif + ! a2x_rm (lsize, naflds)) + + tagname = trim(seq_flds_a2x_fields_to_rof)//C_NULL_CHAR + arrsize = naflds * lsize ! allocate (a2x_rm (lsize, naflds)) + ierr = iMOAB_GetDoubleTagStorage ( mbrxid, tagname, arrsize , ent_type, a2x_rm(1,1)) + if (ierr .ne. 0) then + call shr_sys_abort(subname//' error in getting a2x_rm array ') + endif + ! l2x_rm + tagname = trim(seq_flds_l2x_fluxes_to_rof)//C_NULL_CHAR + arrsize = nlflds * lsize ! + ierr = iMOAB_GetDoubleTagStorage ( mbrxid, tagname, arrsize , ent_type, l2x_rm(1,1)) + if (ierr .ne. 0) then + call shr_sys_abort(subname//' error in getting l2x_rm array ') + endif + +! replace x2r_r%rAttr(index ,i) with x2r_rm(i,index), etc from formula in prep_rof_merge +! x2r_r%rAttr( -> x2r_rm(i, %rAttr( -> m(,i) ,i) -> ) + do i = 1,lsize + frac = fractions_rm(i,index_frac) + x2r_rm(i,index_x2r_Flrl_rofsur) = l2x_rm(i,index_l2x_Flrl_rofsur) * frac + x2r_rm(i,index_x2r_Flrl_rofgwl) = l2x_rm(i,index_l2x_Flrl_rofgwl) * frac + x2r_rm(i,index_x2r_Flrl_rofsub) = l2x_rm(i,index_l2x_Flrl_rofsub) * frac + x2r_rm(i,index_x2r_Flrl_rofdto) = l2x_rm(i,index_l2x_Flrl_rofdto) * frac + x2r_rm(i,index_x2r_Flrl_rofi) = l2x_rm(i,index_l2x_Flrl_rofi) * frac + if (trim(cime_model).eq.'e3sm') then + x2r_rm(i,index_x2r_Flrl_demand) = l2x_rm(i,index_l2x_Flrl_demand) * frac + endif + if (have_irrig_field) then + x2r_rm(i,index_x2r_Flrl_irrig) = l2x_rm(i,index_l2x_Flrl_irrig) * frac + end if + if(trim(cime_model) .eq. 'e3sm') then + x2r_rm(i,index_x2r_Flrl_Tqsur) = l2x_rm(i,index_l2x_Flrl_Tqsur) + x2r_rm(i,index_x2r_Flrl_Tqsub) = l2x_rm(i,index_l2x_Flrl_Tqsub) + endif + if ( flds_wiso_rof ) then + x2r_rm(i,index_x2r_Flrl_rofl_16O) = l2x_rm(i,index_l2x_Flrl_rofl_16O) * frac + x2r_rm(i,index_x2r_Flrl_rofi_16O) = l2x_rm(i,index_l2x_Flrl_rofi_16O) * frac + x2r_rm(i,index_x2r_Flrl_rofl_18O) = l2x_rm(i,index_l2x_Flrl_rofl_18O) * frac + x2r_rm(i,index_x2r_Flrl_rofi_18O) = l2x_rm(i,index_l2x_Flrl_rofi_18O) * frac + x2r_rm(i,index_x2r_Flrl_rofl_HDO) = l2x_rm(i,index_l2x_Flrl_rofl_HDO) * frac + x2r_rm(i,index_x2r_Flrl_rofi_HDO) = l2x_rm(i,index_l2x_Flrl_rofi_HDO) * frac + end if + + if ( rof_heat ) then + x2r_rm(i,index_x2r_Sa_tbot) = a2x_rm(i,index_a2x_Sa_tbot) + x2r_rm(i,index_x2r_Sa_pbot) = a2x_rm(i,index_a2x_Sa_pbot) + x2r_rm(i,index_x2r_Sa_u) = a2x_rm(i,index_a2x_Sa_u) + x2r_rm(i,index_x2r_Sa_v) = a2x_rm(i,index_a2x_Sa_v) + x2r_rm(i,index_x2r_Sa_shum) = a2x_rm(i,index_a2x_Sa_shum) + x2r_rm(i,index_x2r_Faxa_swndr) = a2x_rm(i,index_a2x_Faxa_swndr) + x2r_rm(i,index_x2r_Faxa_swndf) = a2x_rm(i,index_a2x_Faxa_swndf) + x2r_rm(i,index_x2r_Faxa_swvdr) = a2x_rm(i,index_a2x_Faxa_swvdr) + x2r_rm(i,index_x2r_Faxa_swvdf) = a2x_rm(i,index_a2x_Faxa_swvdf) + x2r_rm(i,index_x2r_Faxa_lwdn) = a2x_rm(i,index_a2x_Faxa_lwdn) + endif + + end do + ! after we are done, set x2r_rm to the mbrxid + + tagname = trim(seq_flds_x2r_fields)//C_NULL_CHAR + arrsize = nflds * lsize + ierr = iMOAB_SetDoubleTagStorage ( mbrxid, tagname, arrsize , ent_type, x2r_rm(1,1)) + if (ierr .ne. 0) then + call shr_sys_abort(subname//' error in setting x2r_rm array ') + endif + if (first_time) then + if (iamroot) then + write(logunit,'(A)') subname//' Summary:' + do i = 1,nflds + write(logunit,'(A)') trim(mrgstr(i)) + enddo + endif + deallocate(mrgstr) + endif + first_time = .false. + +#ifdef MOABDEBUG + !compare_mct_av_moab_tag(comp, attrVect, field, imoabApp, tag_name, ent_type, difference) + x2r_r => component_get_x2c_cx(rof(1)) + ! loop over all fields in seq_flds_x2r_fields + call mct_list_init(temp_list ,seq_flds_x2r_fields) + size_list=mct_list_nitem (temp_list) + ent_type = 1 ! cell for river + if (iamroot) print *, num_moab_exports, trim(seq_flds_x2r_fields) + 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 compare_mct_av_moab_tag(rof(1), x2r_r, mct_field, mbrxid, tagname, ent_type, difference) + enddo + call mct_list_clean(temp_list) + + + if (mbrxid .ge. 0 ) then ! we are on coupler pes, for sure + write(lnum,"(I0.2)")num_moab_exports + outfile = 'RofCplAftMm'//trim(lnum)//'.h5m'//C_NULL_CHAR + wopts = ';PARALLEL=WRITE_PART'//C_NULL_CHAR ! + ierr = iMOAB_WriteMesh(mbrxid, trim(outfile), trim(wopts)) + endif +#endif + end subroutine prep_rof_mrg_moab +#endif !================================================================================================ subroutine prep_rof_calc_l2r_rx(fractions_lx, timer) From 24253ce57774e49c7ac45cd347a59265d58cb6d3 Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Sat, 14 Jan 2023 23:51:30 -0600 Subject: [PATCH 294/467] rof import moab still need to verify if fields are OK --- components/mosart/src/cpl/rof_comp_mct.F90 | 194 ++++++++++++++++++++- 1 file changed, 191 insertions(+), 3 deletions(-) diff --git a/components/mosart/src/cpl/rof_comp_mct.F90 b/components/mosart/src/cpl/rof_comp_mct.F90 index 59c3cdcd8ab9..9cee965b2e80 100644 --- a/components/mosart/src/cpl/rof_comp_mct.F90 +++ b/components/mosart/src/cpl/rof_comp_mct.F90 @@ -78,8 +78,10 @@ module rof_comp_mct #ifdef HAVE_MOAB private :: init_rof_moab ! create moab mesh (cloud of points) private :: rof_export_moab ! Export the river runoff model data to the MOAB coupler - integer , private :: mblsize, totalmbls - real (r8) , allocatable, private :: r2x_rm(:,:) ! moab fields, similar to r2x_rx transpose + private :: rof_import_moab ! import the river runoff model data from the MOAB coupler + integer , private :: mblsize, totalmbls, totalmbls_r + real (r8) , allocatable, private :: r2x_rm(:,:) ! moab fields, similar to r2x_r transpose ! used in export to coupler + real (r8) , allocatable, private :: x2r_rm(:,:) ! moab fields, similar to x2r_r transpose ! used in import from coupler #endif ! PRIVATE DATA MEMBERS: @@ -102,6 +104,7 @@ subroutine rof_init_mct( EClock, cdata_r, x2r_r, r2x_r, NLFilename) #ifdef HAVE_MOAB use iMOAB , only : iMOAB_RegisterApplication integer :: nsend ! number of fields in seq_flds_r2x_fields + integer :: nrecv ! number of fields in seq_flds_x2r_fields #endif type(ESMF_Clock), intent(inout) :: EClock ! Input synchronization clock type(seq_cdata), intent(inout) :: cdata_r ! Input runoff-model driver data @@ -308,10 +311,22 @@ subroutine rof_init_mct( EClock, cdata_r, x2r_r, r2x_r, NLFilename) tagname = trim(seq_flds_r2x_fields)//C_NULL_CHAR ierr = iMOAB_DefineTagStorage(mrofid, tagname, tagtype, numco, tagindex ) if ( ierr == 1 ) then - call shr_sys_abort( sub//' ERROR: cannot define tags in moab' ) + call shr_sys_abort( sub//' ERROR: cannot define tags fro seq_flds_r2x_fields in moab' ) end if ! also load initial data to moab tags call rof_export_moab() + ! allocate now the import from coupler array + nrecv = mct_avect_nRattr(x2r_r) + totalmbls_r = mblsize * nrecv ! size of the double array + allocate (x2r_rm(lsize, nrecv) ) + ! define tags according to the seq_flds_r2x_fields + tagtype = 1 ! dense, double + numco = 1 ! one value per cell / entity + tagname = trim(seq_flds_x2r_fields)//C_NULL_CHAR + ierr = iMOAB_DefineTagStorage(mrofid, tagname, tagtype, numco, tagindex ) + if ( ierr == 1 ) then + call shr_sys_abort( sub//' ERROR: cannot define tags for seq_flds_x2r_fields in moab' ) + end if ! endif HAVE_MOAB #endif @@ -392,6 +407,9 @@ subroutine rof_run_mct( EClock, cdata_r, x2r_r, r2x_r) ! Map MCT to land data type (output is totrunin, subrunin) call t_startf ('lc_rof_import') +#ifdef HAVE_MOAB + call rof_import_moab( ) +#endif call rof_import_mct( x2r_r) call t_stopf ('lc_rof_import') @@ -1044,6 +1062,176 @@ subroutine rof_export_moab() ! end copy end subroutine rof_export_moab +!==================================================================================== + + subroutine rof_import_moab( ) + + use iMOAB, only : iMOAB_GetDoubleTagStorage + !--------------------------------------------------------------------------- + ! DESCRIPTION: + ! Obtain the runoff input from the moab coupler + ! convert from kg/m2s to m3/s + ! + ! ARGUMENTS: + implicit none + + ! + ! LOCAL VARIABLES + integer :: n2, n, nt, begr, endr, nliq, nfrz + real(R8) :: tmp1, tmp2 + real(R8) :: shum + character(CXX) :: tagname ! + integer :: ent_type, ierr + + character(len=32), parameter :: sub = 'rof_import_moab' + !--------------------------------------------------------------------------- + + ! populate the array x2r_rm with data from MOAB tags + tagname=trim(seq_flds_x2r_fields)//C_NULL_CHAR + ent_type = 0 ! vertices, point cloud + ierr = iMOAB_GetDoubleTagStorage ( mrofid, tagname, totalmbls_r , ent_type, x2r_rm(1,1) ) + if ( ierr > 0) then + call shr_sys_abort(sub//'Error: fail to get seq_flds_a2x_fields for atm physgrid moab mesh') + endif + + ! Note that ***runin are fluxes + nliq = 0 + nfrz = 0 + do nt = 1,nt_rtm + if (trim(rtm_tracers(nt)) == 'LIQ') then + nliq = nt + endif + if (trim(rtm_tracers(nt)) == 'ICE') then + nfrz = nt + endif + enddo + if (nliq == 0 .or. nfrz == 0) then + write(iulog,*) trim(sub),': ERROR in rtm_tracers LIQ ICE ',nliq,nfrz,rtm_tracers + call shr_sys_abort() + endif + + ! %rAttr( -> m(n2, ,n2) -> ) + begr = rtmCTL%begr + endr = rtmCTL%endr + do n = begr,endr + n2 = n - begr + 1 + + rtmCTL%qsur(n,nliq) = x2r_rm(n2,index_x2r_Flrl_rofsur) * (rtmCTL%area(n)*0.001_r8) + rtmCTL%qsub(n,nliq) = x2r_rm(n2,index_x2r_Flrl_rofsub) * (rtmCTL%area(n)*0.001_r8) + rtmCTL%qgwl(n,nliq) = x2r_rm(n2,index_x2r_Flrl_rofgwl) * (rtmCTL%area(n)*0.001_r8) + if (index_x2r_Flrl_rofdto > 0) then + rtmCTL%qdto(n,nliq) = x2r_rm(n2,index_x2r_Flrl_rofdto) * (rtmCTL%area(n)*0.001_r8) + else + rtmCTL%qdto(n,nliq) = 0.0_r8 + endif + if (wrmflag) then + rtmCTL%qdem(n,nliq) = x2r_rm(n2,index_x2r_Flrl_demand) / TUnit%domainfrac(n) * (rtmCTL%area(n)*0.001_r8) + else + rtmCTL%qdem(n,nliq) = 0.0_r8 + endif + rtmCTL%qsur(n,nfrz) = x2r_rm(n2,index_x2r_Flrl_rofi) * (rtmCTL%area(n)*0.001_r8) + rtmCTL%qsub(n,nfrz) = 0.0_r8 + rtmCTL%qgwl(n,nfrz) = 0.0_r8 + rtmCTL%qdto(n,nfrz) = 0.0_r8 + rtmCTL%qdem(n,nfrz) = 0.0_r8 + + if(heatflag) then + rtmCTL%Tqsur(n) = x2r_rm(n2,index_x2r_Flrl_Tqsur) + rtmCTL%Tqsub(n) = x2r_rm(n2,index_x2r_Flrl_Tqsub) + THeat%Tqsur(n) = rtmCTL%Tqsur(n) + THeat%Tqsub(n) = rtmCTL%Tqsub(n) + + THeat%forc_t(n) = x2r_rm(n2,index_x2r_Sa_tbot) + THeat%forc_pbot(n) = x2r_rm(n2,index_x2r_Sa_pbot) + tmp1 = x2r_rm(n2,index_x2r_Sa_u ) + tmp2 = x2r_rm(n2,index_x2r_Sa_v ) + THeat%forc_wind(n) = sqrt(tmp1*tmp1 + tmp2*tmp2) + THeat%forc_lwrad(n)= x2r_rm(n2,index_x2r_Faxa_lwdn ) + THeat%forc_solar(n)= x2r_rm(n2,index_x2r_Faxa_swvdr) + x2r_rm(n2,index_x2r_Faxa_swvdf) + & + x2r_rm(n2,index_x2r_Faxa_swndr) + x2r_rm(n2,index_x2r_Faxa_swndf) + shum = x2r_rm(n2,index_x2r_Sa_shum) + THeat%forc_vp(n) = shum * THeat%forc_pbot(n) / (0.622_r8 + 0.378_r8 * shum) + THeat%coszen(n) = x2r_rm(n2,index_x2r_coszen_str) + end if + enddo + + end subroutine rof_import_moab + + +#ifdef MOABDEBUG + ! assumes everything is on component side, to compare before imports + subroutine compare_to_moab_tag_rof(mpicom, attrVect, mct_field, appId, tagname, ent_type, difference) + + use shr_mpi_mod, only: shr_mpi_sum, shr_mpi_commrank + use shr_kind_mod, only: CXX => shr_kind_CXX + use seq_comm_mct , only : CPLID, seq_comm_iamroot + use seq_comm_mct, only: seq_comm_setptrs + use iMOAB, only : iMOAB_DefineTagStorage, iMOAB_GetDoubleTagStorage, & + iMOAB_SetDoubleTagStorageWithGid, iMOAB_GetMeshInfo + + use iso_c_binding + + integer, intent(in) :: mpicom + integer , intent(in) :: appId, ent_type + type(mct_aVect) , intent(in) :: attrVect + character(*) , intent(in) :: mct_field + character(*) , intent(in) :: tagname + + real(r8) , intent(out) :: difference + + real(r8) :: differenceg ! global, reduced diff + integer :: mbSize, nloc, index_avfield, rank2 + + ! moab + integer :: tagtype, numco, tagindex, ierr + character(CXX) :: tagname_mct + + real(r8) , allocatable :: values(:), mct_values(:) + integer nvert(3), nvise(3), nbl(3), nsurf(3), nvisBC(3) + logical :: iamroot + + + character(*),parameter :: subName = '(compare_to_moab_tag_rof) ' + + nloc = mct_avect_lsize(attrVect) + allocate(mct_values(nloc)) + + index_avfield = mct_aVect_indexRA(attrVect,trim(mct_field)) + mct_values(:) = attrVect%rAttr(index_avfield,:) + + ! now get moab tag values; first get info + ierr = iMOAB_GetMeshInfo ( appId, nvert, nvise, nbl, nsurf, nvisBC ); + if (ierr > 0 ) & + call shr_sys_abort(subname//'Error: fail to get mesh info') + if (ent_type .eq. 0) then + mbSize = nvert(1) + else if (ent_type .eq. 1) then + mbSize = nvise(1) + endif + allocate(values(mbSize)) + + ierr = iMOAB_GetDoubleTagStorage ( appId, tagname, mbSize , ent_type, values) + if (ierr > 0 ) & + call shr_sys_abort(subname//'Error: fail to get moab tag values') + + values = mct_values - values + + difference = dot_product(values, values) + call shr_mpi_sum(difference,differenceg,mpicom,subname) + difference = sqrt(differenceg) + call shr_mpi_commrank( mpicom, rank2 ) + if ( rank2 .eq. 0 ) then + print * , subname, ' , difference on tag ', trim(tagname), ' = ', difference + !call shr_sys_abort(subname//'differences between mct and moab values') + endif + deallocate(values) + deallocate(mct_values) + + end subroutine compare_to_moab_tag_rof + ! #endif for MOABDEBUG +#endif + + ! end #ifdef HAVE_MOAB #endif From 2654e47a026fe07befb1b764d0a63cdcf3ab0689 Mon Sep 17 00:00:00 2001 From: Robert Jacob Date: Sun, 15 Jan 2023 00:35:17 -0600 Subject: [PATCH 295/467] Add moab version of ice merge Add moab version of ice merge and call it. Not working yet. --- driver-moab/main/cime_comp_mod.F90 | 2 + driver-moab/main/prep_ice_mod.F90 | 326 ++++++++++++++++++++++++++++- 2 files changed, 327 insertions(+), 1 deletion(-) diff --git a/driver-moab/main/cime_comp_mod.F90 b/driver-moab/main/cime_comp_mod.F90 index bfc7d48edc49..834dae72829c 100644 --- a/driver-moab/main/cime_comp_mod.F90 +++ b/driver-moab/main/cime_comp_mod.F90 @@ -4767,6 +4767,8 @@ subroutine cime_run_ice_setup_send() call prep_ice_mrg(infodata, timer_mrg='CPL:iceprep_mrgx2i') + call prep_ice_mrg_moab(infodata) + call component_diag(infodata, ice, flow='x2c', comment= 'send ice', & info_debug=info_debug, timer_diag='CPL:iceprep_diagav') diff --git a/driver-moab/main/prep_ice_mod.F90 b/driver-moab/main/prep_ice_mod.F90 index ccb2e53835d4..9173e58351b0 100644 --- a/driver-moab/main/prep_ice_mod.F90 +++ b/driver-moab/main/prep_ice_mod.F90 @@ -10,6 +10,7 @@ module prep_ice_mod use seq_comm_mct , only: seq_comm_getData=>seq_comm_setptrs use seq_comm_mct, only: mboxid ! iMOAB id for mpas ocean migrated mesh to coupler pes use seq_comm_mct, only : mbixid ! iMOAB for sea-ice migrated to coupler + use seq_comm_mct, only : num_moab_exports use seq_comm_mct, only : seq_comm_getinfo => seq_comm_setptrs @@ -34,6 +35,7 @@ module prep_ice_mod public :: prep_ice_init public :: prep_ice_mrg + public :: prep_ice_mrg_moab public :: prep_ice_calc_a2x_ix public :: prep_ice_calc_o2x_ix @@ -74,6 +76,10 @@ module prep_ice_mod type(mct_aVect), pointer :: g2x_ix(:) ! Glc export, ice grid, cpl pes - allocated in driver type(mct_aVect), pointer :: r2x_ix(:) ! Rof export, ice grid, cpl pes - allocated in driver +! MOAB arrays + real (kind=r8) , allocatable, private :: x2i_im (:,:) + real (kind=r8) , allocatable, private :: a2x_im (:,:) + real (kind=r8) , allocatable, private :: r2x_im (:,:) ! seq_comm_getData variables integer :: mpicom_CPLID ! MPI cpl communicator !================================================================================================ @@ -528,9 +534,313 @@ subroutine prep_ice_merge(flux_epbalfact, a2x_i, o2x_i, r2x_i, g2x_i, x2i_i ) end subroutine prep_ice_merge - !================================================================================================ + subroutine prep_ice_mrg_moab(infodata) + use iMOAB , only : iMOAB_GetDoubleTagStorage, & + iMOAB_SetDoubleTagStorage, iMOAB_WriteMesh, iMOAB_GetMeshInfo + + !----------------------------------------------------------------------- + ! + ! Arguments + type(seq_infodata_type) , intent(in) :: infodata + ! + ! Local variables + real(r8) :: flux_epbalfact + integer :: i,i1,o1, arrsize + integer,save :: niflds,naflds,nrflds + integer :: lsize + integer, save :: index_a2x_Faxa_rainc + integer, save :: index_a2x_Faxa_rainl + integer, save :: index_a2x_Faxa_snowc + integer, save :: index_a2x_Faxa_snowl + integer, save :: index_g2x_Figg_rofi + integer, save :: index_r2x_Firr_rofi + integer, save :: index_x2i_Faxa_rain + integer, save :: index_x2i_Faxa_snow + integer, save :: index_x2i_Fixx_rofi + !wiso fields: + integer, save :: index_a2x_Faxa_rainc_16O + integer, save :: index_a2x_Faxa_rainl_16O + integer, save :: index_a2x_Faxa_snowc_16O + integer, save :: index_a2x_Faxa_snowl_16O + integer, save :: index_x2i_Faxa_rain_16O + integer, save :: index_x2i_Faxa_snow_16O + integer, save :: index_a2x_Faxa_rainc_18O + integer, save :: index_a2x_Faxa_rainl_18O + integer, save :: index_a2x_Faxa_snowc_18O + integer, save :: index_a2x_Faxa_snowl_18O + integer, save :: index_x2i_Faxa_rain_18O + integer, save :: index_x2i_Faxa_snow_18O + integer, save :: index_a2x_Faxa_rainc_HDO + integer, save :: index_a2x_Faxa_rainl_HDO + integer, save :: index_a2x_Faxa_snowc_HDO + integer, save :: index_a2x_Faxa_snowl_HDO + integer, save :: index_x2i_Faxa_rain_HDO + integer, save :: index_x2i_Faxa_snow_HDO + logical, save :: first_time = .true. + logical :: iamroot + + integer nvert(3), nvise(3), nbl(3), nsurf(3), nvisBC(3) ! for moab info + character(CXX) ::tagname, mct_field + character(CL),allocatable :: mrgstr(:) ! temporary string + + character(CL) :: field ! string converted to char + + type(mct_avect) , pointer, save :: a2x_i + type(mct_avect) , pointer, save :: x2i_i + type(mct_avect) , pointer, save :: r2x_i + type(mct_avect) , pointer, save :: o2x_i + type(mct_avect) , pointer, save :: g2x_i + type(mct_aVect_sharedindices),save :: o2x_SharedIndices + type(mct_aVect_sharedindices),save :: a2x_SharedIndices + type(mct_aVect_sharedindices),save :: g2x_SharedIndices + + integer ent_type, ierr,n +#ifdef MOABDEBUG + character*32 :: outfile, wopts, lnum + real(r8) :: difference + type(mct_list) :: temp_list + integer :: size_list, index_list + type(mct_string) :: mctOStr ! +#endif + + + character(*), parameter :: subname = '(prep_ice_merge) ' + !----------------------------------------------------------------------- + call seq_infodata_GetData(infodata, & + flux_epbalfact=flux_epbalfact) + + call seq_comm_getdata(CPLID, iamroot=iamroot) + + ! find out the number of local elements in moab mesh seaice instance on coupler + ierr = iMOAB_GetMeshInfo ( mbixid, nvert, nvise, nbl, nsurf, nvisBC ); + if (ierr .ne. 0) then + write(logunit,*) subname,' error in getting info ' + call shr_sys_abort(subname//' error in getting info ') + endif + lsize = nvise(1) ! number of active cells + + if (first_time) then + a2x_i => a2x_ix(1) + r2x_i => r2x_ix(1) + o2x_i => o2x_ix(1) + g2x_i => g2x_ix(1) + x2i_i => component_get_x2c_cx(ice(1)) + + niflds = mct_aVect_nRattr(x2i_i) + naflds = mct_aVect_nRattr(a2x_i) + nrflds = mct_aVect_nRattr(r2x_i) + + + allocate(x2i_im(lsize,niflds)) + allocate(a2x_im(lsize,naflds)) + allocate(r2x_im(lsize,nrflds)) + + allocate(mrgstr(niflds)) + index_a2x_Faxa_snowc = mct_aVect_indexRA(a2x_i,'Faxa_snowc') + index_a2x_Faxa_snowl = mct_aVect_indexRA(a2x_i,'Faxa_snowl') + index_a2x_Faxa_rainc = mct_aVect_indexRA(a2x_i,'Faxa_rainc') + index_a2x_Faxa_rainl = mct_aVect_indexRA(a2x_i,'Faxa_rainl') + index_g2x_Figg_rofi = mct_aVect_indexRA(g2x_i,'Figg_rofi') + index_r2x_Firr_rofi = mct_aVect_indexRA(r2x_i,'Firr_rofi') + index_x2i_Faxa_rain = mct_aVect_indexRA(x2i_i,'Faxa_rain' ) + index_x2i_Faxa_snow = mct_aVect_indexRA(x2i_i,'Faxa_snow' ) + index_x2i_Fixx_rofi = mct_aVect_indexRA(x2i_i,'Fixx_rofi') + + ! Water isotope fields + index_a2x_Faxa_snowc_16O = mct_aVect_indexRA(a2x_i,'Faxa_snowc_16O', perrWith='quiet') + index_a2x_Faxa_snowl_16O = mct_aVect_indexRA(a2x_i,'Faxa_snowl_16O', perrWith='quiet') + index_a2x_Faxa_rainc_16O = mct_aVect_indexRA(a2x_i,'Faxa_rainc_16O', perrWith='quiet') + index_a2x_Faxa_rainl_16O = mct_aVect_indexRA(a2x_i,'Faxa_rainl_16O', perrWith='quiet') + index_x2i_Faxa_rain_16O = mct_aVect_indexRA(x2i_i,'Faxa_rain_16O', perrWith='quiet' ) + index_x2i_Faxa_snow_16O = mct_aVect_indexRA(x2i_i,'Faxa_snow_16O', perrWith='quiet' ) + + index_a2x_Faxa_snowc_18O = mct_aVect_indexRA(a2x_i,'Faxa_snowc_18O', perrWith='quiet') + index_a2x_Faxa_snowl_18O = mct_aVect_indexRA(a2x_i,'Faxa_snowl_18O', perrWith='quiet') + index_a2x_Faxa_rainc_18O = mct_aVect_indexRA(a2x_i,'Faxa_rainc_18O', perrWith='quiet') + index_a2x_Faxa_rainl_18O = mct_aVect_indexRA(a2x_i,'Faxa_rainl_18O', perrWith='quiet') + index_x2i_Faxa_rain_18O = mct_aVect_indexRA(x2i_i,'Faxa_rain_18O', perrWith='quiet' ) + index_x2i_Faxa_snow_18O = mct_aVect_indexRA(x2i_i,'Faxa_snow_18O', perrWith='quiet' ) + + index_a2x_Faxa_snowc_HDO = mct_aVect_indexRA(a2x_i,'Faxa_snowc_HDO', perrWith='quiet') + index_a2x_Faxa_snowl_HDO = mct_aVect_indexRA(a2x_i,'Faxa_snowl_HDO', perrWith='quiet') + index_a2x_Faxa_rainc_HDO = mct_aVect_indexRA(a2x_i,'Faxa_rainc_HDO', perrWith='quiet') + index_a2x_Faxa_rainl_HDO = mct_aVect_indexRA(a2x_i,'Faxa_rainl_HDO', perrWith='quiet') + index_x2i_Faxa_rain_HDO = mct_aVect_indexRA(x2i_i,'Faxa_rain_HDO', perrWith='quiet' ) + index_x2i_Faxa_snow_HDO = mct_aVect_indexRA(x2i_i,'Faxa_snow_HDO', perrWith='quiet' ) + + do i = 1,niflds + field = mct_aVect_getRList2c(i, x2i_i) + mrgstr(i) = subname//'x2i%'//trim(field)//' =' + enddo + + call mct_aVect_setSharedIndices(o2x_i, x2i_i, o2x_SharedIndices) + call mct_aVect_setSharedIndices(a2x_i, x2i_i, a2x_SharedIndices) + call mct_aVect_setSharedIndices(g2x_i, x2i_i, g2x_SharedIndices) + + !--- document copy operations --- + do i=1,o2x_SharedIndices%shared_real%num_indices + i1=o2x_SharedIndices%shared_real%aVindices1(i) + o1=o2x_SharedIndices%shared_real%aVindices2(i) + field = mct_aVect_getRList2c(i1, o2x_i) + mrgstr(o1) = trim(mrgstr(o1))//' = o2x%'//trim(field) + enddo + do i=1,a2x_SharedIndices%shared_real%num_indices + i1=a2x_SharedIndices%shared_real%aVindices1(i) + o1=a2x_SharedIndices%shared_real%aVindices2(i) + field = mct_aVect_getRList2c(i1, a2x_i) + mrgstr(o1) = trim(mrgstr(o1))//' = a2x%'//trim(field) + enddo + do i=1,g2x_SharedIndices%shared_real%num_indices + i1=g2x_SharedIndices%shared_real%aVindices1(i) + o1=g2x_SharedIndices%shared_real%aVindices2(i) + field = mct_aVect_getRList2c(i1, g2x_i) + mrgstr(o1) = trim(mrgstr(o1))//' = g2x%'//trim(field) + enddo + + !--- document manual merges --- + mrgstr(index_x2i_Faxa_rain) = trim(mrgstr(index_x2i_Faxa_rain))//' = '// & + '(a2x%Faxa_rainc + a2x%Faxa_rainl)*flux_epbalfact' + mrgstr(index_x2i_Faxa_snow) = trim(mrgstr(index_x2i_Faxa_snow))//' = '// & + '(a2x%Faxa_snowc + a2x%Faxa_snowl)*flux_epbalfact' + mrgstr(index_x2i_Fixx_rofi) = trim(mrgstr(index_x2i_Fixx_rofi))//' = '// & + '(g2x%Figg_rofi + r2x%Firr_rofi)*flux_epbalfact' + + !--- water isotope document manual merges --- + if ( index_x2i_Faxa_rain_16O /= 0 ) then + mrgstr(index_x2i_Faxa_rain_16O) = trim(mrgstr(index_x2i_Faxa_rain_16O))//' = '// & + '(a2x%Faxa_rainc_16O + a2x%Faxa_rainl_16O)*flux_epbalfact' + mrgstr(index_x2i_Faxa_snow_16O) = trim(mrgstr(index_x2i_Faxa_snow_16O))//' = '// & + '(a2x%Faxa_snowc_16O + a2x%Faxa_snowl_16O)*flux_epbalfact' + end if + if ( index_x2i_Faxa_rain_18O /= 0 ) then + mrgstr(index_x2i_Faxa_rain_18O) = trim(mrgstr(index_x2i_Faxa_rain_18O))//' = '// & + '(a2x%Faxa_rainc_18O + a2x%Faxa_rainl_18O)*flux_epbalfact' + mrgstr(index_x2i_Faxa_snow_18O) = trim(mrgstr(index_x2i_Faxa_snow_18O))//' = '// & + '(a2x%Faxa_snowc_18O + a2x%Faxa_snowl_18O)*flux_epbalfact' + end if + if ( index_x2i_Faxa_rain_HDO /= 0 ) then + mrgstr(index_x2i_Faxa_rain_HDO) = trim(mrgstr(index_x2i_Faxa_rain_HDO))//' = '// & + '(a2x%Faxa_rainc_HDO + a2x%Faxa_rainl_HDO)*flux_epbalfact' + mrgstr(index_x2i_Faxa_snow_HDO) = trim(mrgstr(index_x2i_Faxa_snow_HDO))//' = '// & + '(a2x%Faxa_snowc_HDO + a2x%Faxa_snowl_HDO)*flux_epbalfact' + end if + + endif + + !call mct_aVect_copy(aVin=o2x_i, aVout=x2i_i, vector=mct_usevector, sharedIndices=o2x_SharedIndices) + !call mct_aVect_copy(aVin=a2x_i, aVout=x2i_i, vector=mct_usevector, sharedIndices=a2x_SharedIndices) + !call mct_aVect_copy(aVin=g2x_i, aVout=x2i_i, vector=mct_usevector, sharedIndices=g2x_SharedIndices) + + ! get data that needs custom merges + ent_type = 1 + + ! git the x2i_im field which has been mostly filled out by mapping calls. + tagname = trim(seq_flds_x2i_fields)//C_NULL_CHAR + arrsize = niflds * lsize + ierr = iMOAB_GetDoubleTagStorage ( mbixid, tagname, arrsize , ent_type, x2i_im(1,1)) + if (ierr .ne. 0) then + call shr_sys_abort(subname//' error in getting x2i_im array ') + endif + +! get the a2x data that was mapped to i + tagname = trim(seq_flds_a2x_fields)//C_NULL_CHAR + arrsize = naflds * lsize ! allocate (a2x_om (lsize, naflds)) +! LOOK at this line + write(logunit, *) 'MOAB ice merge ',mbixid, naflds,lsize, ent_type, tagname + ierr = iMOAB_GetDoubleTagStorage ( mbixid, tagname, arrsize , ent_type, a2x_im(1,1)) + if (ierr .ne. 0) then + write(logunit, *) 'MOAB error ', ierr + call shr_sys_abort(subname//' error in getting a2x_im array ') + endif + +! get the r2x data that was mapped to i + tagname = trim(seq_flds_r2x_fields)//C_NULL_CHAR + arrsize = nrflds * lsize ! allocate (a2x_om (lsize, naflds)) + ierr = iMOAB_GetDoubleTagStorage ( mbixid, tagname, arrsize , ent_type, r2x_im(1,1)) + if (ierr .ne. 0) then + call shr_sys_abort(subname//' error in getting r2x_im array ') + endif + + ! Merge total snow and precip for ice input + ! Scale total precip and runoff by flux_epbalfact + + + do n = 1,lsize + x2i_im(n,index_x2i_Faxa_rain) = a2x_im(n,index_a2x_Faxa_rainc) + a2x_im(n,index_a2x_Faxa_rainl) + x2i_im(n,index_x2i_Faxa_snow) = a2x_im(n,index_a2x_Faxa_snowc) + a2x_im(n,index_a2x_Faxa_snowl) + +! no glacier yet +! x2i_im(n,index_x2i_Fixx_rofi) = g2x_im(n,index_g2x_Figg_rofi) + & +! r2x_im(n,index_r2x_Firr_rofi) + x2i_im(n,index_x2i_Fixx_rofi) = r2x_im(n,index_r2x_Firr_rofi) + + x2i_im(n,index_x2i_Faxa_rain) = x2i_im(n,index_x2i_Faxa_rain) * flux_epbalfact + x2i_im(n,index_x2i_Faxa_snow) = x2i_im(n,index_x2i_Faxa_snow) * flux_epbalfact + x2i_im(n,index_x2i_Fixx_rofi) = x2i_im(n,index_x2i_Fixx_rofi) * flux_epbalfact + + ! For water isotopes + if ( index_x2i_Faxa_rain_16O /= 0 ) then + x2i_im(n,index_x2i_Faxa_rain_16O) = a2x_im(n,index_a2x_Faxa_rainc_16O) + & + a2x_im(n,index_a2x_Faxa_rainl_16O) + x2i_im(n,index_x2i_Faxa_snow_16O) = a2x_im(n,index_a2x_Faxa_snowc_16O) + & + a2x_im(n,index_a2x_Faxa_snowl_16O) + + x2i_im(n,index_x2i_Faxa_rain_16O) = x2i_im(n,index_x2i_Faxa_rain_16O) * flux_epbalfact + x2i_im(n,index_x2i_Faxa_snow_16O) = x2i_im(n,index_x2i_Faxa_snow_16O) * flux_epbalfact + end if + if ( index_x2i_Faxa_rain_18O /= 0 ) then + x2i_im(n,index_x2i_Faxa_rain_18O) = a2x_im(n,index_a2x_Faxa_rainc_18O) + & + a2x_im(n,index_a2x_Faxa_rainl_18O) + x2i_im(n,index_x2i_Faxa_snow_18O) = a2x_im(n,index_a2x_Faxa_snowc_18O) + & + a2x_im(n,index_a2x_Faxa_snowl_18O) + + x2i_im(n,index_x2i_Faxa_rain_18O) = x2i_im(n,index_x2i_Faxa_rain_18O) * flux_epbalfact + x2i_im(n,index_x2i_Faxa_snow_18O) = x2i_im(n,index_x2i_Faxa_snow_18O) * flux_epbalfact + end if + if ( index_x2i_Faxa_rain_HDO /= 0 ) then + x2i_im(n,index_x2i_Faxa_rain_HDO) = a2x_im(n,index_a2x_Faxa_rainc_HDO) + & + a2x_im(n,index_a2x_Faxa_rainl_HDO) + x2i_im(n,index_x2i_Faxa_snow_HDO) = a2x_im(n,index_a2x_Faxa_snowc_HDO) + & + a2x_im(n,index_a2x_Faxa_snowl_HDO) + + x2i_im(n,index_x2i_Faxa_rain_HDO) = x2i_im(n,index_x2i_Faxa_rain_HDO) * flux_epbalfact + x2i_im(n,index_x2i_Faxa_snow_HDO) = x2i_im(n,index_x2i_Faxa_snow_HDO) * flux_epbalfact + end if + + end do + tagname = trim(seq_flds_x2i_fields)//C_NULL_CHAR + arrsize = niflds * lsize + ierr = iMOAB_SetDoubleTagStorage ( mbixid, tagname, arrsize , ent_type, x2i_im(1,1)) + if (ierr .ne. 0) then + call shr_sys_abort(subname//' error in setting x2i_im array ') + endif + + if (first_time) then + if (iamroot) then + write(logunit,'(A)') subname//' Summary MOAB:' + do i = 1,niflds + write(logunit,'(A)') trim(mrgstr(i)) + enddo + endif + deallocate(mrgstr) + endif + + first_time = .false. + +#ifdef MOABDEBUG + if (mbixid .ge. 0 ) then ! we are on coupler pes, for sure + write(lnum,"(I0.2)")num_moab_exports + outfile = 'IceCplAftMm'//trim(lnum)//'.h5m'//C_NULL_CHAR + wopts = ';PARALLEL=WRITE_PART'//C_NULL_CHAR ! + ierr = iMOAB_WriteMesh(mbixid, trim(outfile), trim(wopts)) + endif +#endif + + + end subroutine prep_ice_mrg_moab subroutine prep_ice_calc_a2x_ix(a2x_ox, timer) + use iMOAB , only : iMOAB_WriteMesh !--------------------------------------------------------------- ! Description ! Create a2x_ix (note that a2x_ix is a local module variable) @@ -542,6 +852,11 @@ subroutine prep_ice_calc_a2x_ix(a2x_ox, timer) ! Local Variables integer :: eai character(*), parameter :: subname = '(prep_ice_calc_a2x_ix)' +#ifdef MOABDEBUG + character*32 :: outfile, wopts, lnum + integer :: ierr +#endif + !--------------------------------------------------------------- call t_drvstartf (trim(timer),barrier=mpicom_CPLID) @@ -550,6 +865,15 @@ subroutine prep_ice_calc_a2x_ix(a2x_ox, timer) enddo call t_drvstopf (trim(timer)) +#ifdef MOABDEBUG + if (mbixid .ge. 0 ) then ! we are on coupler pes, for sure + write(lnum,"(I0.2)")num_moab_exports + outfile = 'IceCplAfto2i'//trim(lnum)//'.h5m'//C_NULL_CHAR + wopts = ';PARALLEL=WRITE_PART'//C_NULL_CHAR ! + ierr = iMOAB_WriteMesh(mbixid, trim(outfile), trim(wopts)) + endif +#endif + end subroutine prep_ice_calc_a2x_ix !================================================================================================ From 95fe1c8dcf1ed11a1c9119b580200422931833f0 Mon Sep 17 00:00:00 2001 From: iulian07 Date: Sun, 15 Jan 2023 12:04:08 -0600 Subject: [PATCH 296/467] typo orderS -> orderT --- driver-moab/main/prep_lnd_mod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/driver-moab/main/prep_lnd_mod.F90 b/driver-moab/main/prep_lnd_mod.F90 index 1d4de66445f3..516b18e7eec0 100644 --- a/driver-moab/main/prep_lnd_mod.F90 +++ b/driver-moab/main/prep_lnd_mod.F90 @@ -271,7 +271,7 @@ subroutine prep_lnd_init(infodata, atm_c2_lnd, rof_c2_lnd, glc_c2_lnd, iac_c2_ln dm2 = "fv"//C_NULL_CHAR dofnameT="GLOBAL_ID"//C_NULL_CHAR - orderS = 1 ! not much arguing + orderT = 1 ! not much arguing fNoBubble = 1 monotonicity = 0 ! noConserve = 0 From 17bc74137f885dd045584479d86bbd695486e48b Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Sun, 15 Jan 2023 12:10:05 -0600 Subject: [PATCH 297/467] typo in orderS -> orderT --- driver-moab/main/prep_lnd_mod.F90 | 2 +- driver-moab/main/prep_rof_mod.F90 | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/driver-moab/main/prep_lnd_mod.F90 b/driver-moab/main/prep_lnd_mod.F90 index 1d4de66445f3..516b18e7eec0 100644 --- a/driver-moab/main/prep_lnd_mod.F90 +++ b/driver-moab/main/prep_lnd_mod.F90 @@ -271,7 +271,7 @@ subroutine prep_lnd_init(infodata, atm_c2_lnd, rof_c2_lnd, glc_c2_lnd, iac_c2_ln dm2 = "fv"//C_NULL_CHAR dofnameT="GLOBAL_ID"//C_NULL_CHAR - orderS = 1 ! not much arguing + orderT = 1 ! not much arguing fNoBubble = 1 monotonicity = 0 ! noConserve = 0 diff --git a/driver-moab/main/prep_rof_mod.F90 b/driver-moab/main/prep_rof_mod.F90 index 92cf67cd4cfd..5eb4b3f3e53e 100644 --- a/driver-moab/main/prep_rof_mod.F90 +++ b/driver-moab/main/prep_rof_mod.F90 @@ -291,7 +291,7 @@ subroutine prep_rof_init(infodata, lnd_c2_rof, atm_c2_rof) dm2 = "fv"//C_NULL_CHAR dofnameT="GLOBAL_ID"//C_NULL_CHAR - orderS = 1 ! not much arguing + orderT = 1 ! not much arguing fNoBubble = 1 monotonicity = 0 ! noConserve = 0 From edb421a0d5972636a97d69e2003fd70ae5e3b04a Mon Sep 17 00:00:00 2001 From: iulian07 Date: Sun, 15 Jan 2023 13:06:52 -0600 Subject: [PATCH 298/467] define seq_flds_a2x_fields and seq_flds_r2x_fields on ice it needs them for merging also add trim() for some output --- driver-moab/main/cplcomp_exchange_mod.F90 | 19 +++++++++++++++++++ driver-moab/main/prep_ice_mod.F90 | 2 +- 2 files changed, 20 insertions(+), 1 deletion(-) diff --git a/driver-moab/main/cplcomp_exchange_mod.F90 b/driver-moab/main/cplcomp_exchange_mod.F90 index fcdf99a973ae..12fd73fc61b9 100644 --- a/driver-moab/main/cplcomp_exchange_mod.F90 +++ b/driver-moab/main/cplcomp_exchange_mod.F90 @@ -1415,6 +1415,25 @@ subroutine cplcomp_moab_Init(comp) write(logunit,*) subname,' error in defining tags seq_flds_dom_fields on ice on coupler ' call shr_sys_abort(subname//' ERROR in defining tags ') endif + + tagname = trim(seq_flds_a2x_fields)//C_NULL_CHAR + tagtype = 1 ! dense + numco = 1 ! + ierr = iMOAB_DefineTagStorage(mbixid, tagname, tagtype, numco, tagindex ) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in defining tags for seq_flds_a2x_fields on ice cpl' + call shr_sys_abort(subname//' ERROR in coin defining tags for seq_flds_a2x_fields on ice cpl') + endif + + tagname = trim(seq_flds_r2x_fields)//C_NULL_CHAR + tagtype = 1 ! dense + numco = 1 ! + ierr = iMOAB_DefineTagStorage(mbixid, tagname, tagtype, numco, tagindex ) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in defining tags for seq_flds_r2x_fields on ice cpl' + call shr_sys_abort(subname//' ERROR in coin defining tags for seq_flds_a2x_fields on ice cpl') + endif + #ifdef MOABDEBUG ! debug test outfile = 'recSeaIce.h5m'//C_NULL_CHAR diff --git a/driver-moab/main/prep_ice_mod.F90 b/driver-moab/main/prep_ice_mod.F90 index 9173e58351b0..59b643b3746f 100644 --- a/driver-moab/main/prep_ice_mod.F90 +++ b/driver-moab/main/prep_ice_mod.F90 @@ -746,7 +746,7 @@ subroutine prep_ice_mrg_moab(infodata) tagname = trim(seq_flds_a2x_fields)//C_NULL_CHAR arrsize = naflds * lsize ! allocate (a2x_om (lsize, naflds)) ! LOOK at this line - write(logunit, *) 'MOAB ice merge ',mbixid, naflds,lsize, ent_type, tagname + write(logunit, *) 'MOAB ice merge ',mbixid, naflds,lsize, ent_type, trim(tagname) ierr = iMOAB_GetDoubleTagStorage ( mbixid, tagname, arrsize , ent_type, a2x_im(1,1)) if (ierr .ne. 0) then write(logunit, *) 'MOAB error ', ierr From 3cae677522cce6f01ebd8155bc5794515d9df083 Mon Sep 17 00:00:00 2001 From: Robert Jacob Date: Sun, 15 Jan 2023 16:32:07 -0600 Subject: [PATCH 299/467] Use rof_c2_ice in ice_mrg_moab Use rof_c2_ice in ice_mrg_moab. Make sure Fixx_rofi is 0 when it should be. Also comment out a MOABDEBUG write. --- driver-moab/main/cime_comp_mod.F90 | 2 +- driver-moab/main/prep_ice_mod.F90 | 21 +++++++++++++-------- 2 files changed, 14 insertions(+), 9 deletions(-) diff --git a/driver-moab/main/cime_comp_mod.F90 b/driver-moab/main/cime_comp_mod.F90 index 91a5b0287497..502dfcda894d 100644 --- a/driver-moab/main/cime_comp_mod.F90 +++ b/driver-moab/main/cime_comp_mod.F90 @@ -4769,7 +4769,7 @@ subroutine cime_run_ice_setup_send() call prep_ice_mrg(infodata, timer_mrg='CPL:iceprep_mrgx2i') - call prep_ice_mrg_moab(infodata) + call prep_ice_mrg_moab(infodata,rof_c2_ice) call component_diag(infodata, ice, flow='x2c', comment= 'send ice', & info_debug=info_debug, timer_diag='CPL:iceprep_diagav') diff --git a/driver-moab/main/prep_ice_mod.F90 b/driver-moab/main/prep_ice_mod.F90 index 59b643b3746f..016e24206eef 100644 --- a/driver-moab/main/prep_ice_mod.F90 +++ b/driver-moab/main/prep_ice_mod.F90 @@ -534,7 +534,7 @@ subroutine prep_ice_merge(flux_epbalfact, a2x_i, o2x_i, r2x_i, g2x_i, x2i_i ) end subroutine prep_ice_merge - subroutine prep_ice_mrg_moab(infodata) + subroutine prep_ice_mrg_moab(infodata, rof_c2_ice) use iMOAB , only : iMOAB_GetDoubleTagStorage, & iMOAB_SetDoubleTagStorage, iMOAB_WriteMesh, iMOAB_GetMeshInfo @@ -542,6 +542,7 @@ subroutine prep_ice_mrg_moab(infodata) ! ! Arguments type(seq_infodata_type) , intent(in) :: infodata + logical, intent(in) :: rof_c2_ice ! .true. => rof to ice coupling on ! ! Local variables real(r8) :: flux_epbalfact @@ -772,7 +773,11 @@ subroutine prep_ice_mrg_moab(infodata) ! no glacier yet ! x2i_im(n,index_x2i_Fixx_rofi) = g2x_im(n,index_g2x_Figg_rofi) + & ! r2x_im(n,index_r2x_Firr_rofi) - x2i_im(n,index_x2i_Fixx_rofi) = r2x_im(n,index_r2x_Firr_rofi) + if(rof_c2_ice) then + x2i_im(n,index_x2i_Fixx_rofi) = r2x_im(n,index_r2x_Firr_rofi) + else + x2i_im(n,index_x2i_Fixx_rofi) = 0._r8 + endif x2i_im(n,index_x2i_Faxa_rain) = x2i_im(n,index_x2i_Faxa_rain) * flux_epbalfact x2i_im(n,index_x2i_Faxa_snow) = x2i_im(n,index_x2i_Faxa_snow) * flux_epbalfact @@ -866,12 +871,12 @@ subroutine prep_ice_calc_a2x_ix(a2x_ox, timer) call t_drvstopf (trim(timer)) #ifdef MOABDEBUG - if (mbixid .ge. 0 ) then ! we are on coupler pes, for sure - write(lnum,"(I0.2)")num_moab_exports - outfile = 'IceCplAfto2i'//trim(lnum)//'.h5m'//C_NULL_CHAR - wopts = ';PARALLEL=WRITE_PART'//C_NULL_CHAR ! - ierr = iMOAB_WriteMesh(mbixid, trim(outfile), trim(wopts)) - endif +! if (mbixid .ge. 0 ) then ! we are on coupler pes, for sure +! write(lnum,"(I0.2)")num_moab_exports +! outfile = 'IceCplAfto2i'//trim(lnum)//'.h5m'//C_NULL_CHAR +! wopts = ';PARALLEL=WRITE_PART'//C_NULL_CHAR ! +! ierr = iMOAB_WriteMesh(mbixid, trim(outfile), trim(wopts)) +! endif #endif end subroutine prep_ice_calc_a2x_ix From aacd722fb9a4f5c33e49991a54d9a9d9411e0311 Mon Sep 17 00:00:00 2001 From: Robert Jacob Date: Sun, 15 Jan 2023 18:26:08 -0600 Subject: [PATCH 300/467] Fix coupler to river moab exchange Fix coupler to river moab exchange. Was a duplicate of the river to coupler. --- driver-moab/main/cime_comp_mod.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/driver-moab/main/cime_comp_mod.F90 b/driver-moab/main/cime_comp_mod.F90 index 502dfcda894d..a48e13ea7e51 100644 --- a/driver-moab/main/cime_comp_mod.F90 +++ b/driver-moab/main/cime_comp_mod.F90 @@ -4651,7 +4651,7 @@ end subroutine cime_run_glc_recv_post subroutine cime_run_rof_setup_send() - use seq_flds_mod , only : seq_flds_r2x_fields + use seq_flds_mod , only : seq_flds_x2r_fields use seq_comm_mct , only : mrofid, mbrxid ! !---------------------------------------------------- ! rof prep-merge @@ -4688,7 +4688,7 @@ subroutine cime_run_rof_setup_send() timer_barrier='CPL:C2R_BARRIER', timer_comp_exch='CPL:C2R', & timer_map_exch='CPL:c2r_rofx2rofr', timer_infodata_exch='CPL:c2r_infoexch') - call component_exch_moab(rof(1), mrofid, mbrxid, 0, seq_flds_r2x_fields) + call component_exch_moab(rof(1), mbrxid, mrofid, 1, seq_flds_x2r_fields) endif end subroutine cime_run_rof_setup_send From 9d9047420f49189238c7480914cbe83b0ff9f658 Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Mon, 16 Jan 2023 01:17:43 -0600 Subject: [PATCH 301/467] moab ocean import; not called yet there is an issue with x2o_om(n, index_x2o_Foxx_rofi) it is either wrong or not init correclty because of that, comment out the call to ocn_import_moab (for the time being ) --- components/mpas-ocean/driver/ocn_comp_mct.F | 820 +++++++++++++++++++- 1 file changed, 818 insertions(+), 2 deletions(-) diff --git a/components/mpas-ocean/driver/ocn_comp_mct.F b/components/mpas-ocean/driver/ocn_comp_mct.F index 9119033a5f3e..6aa4f78e1669 100644 --- a/components/mpas-ocean/driver/ocn_comp_mct.F +++ b/components/mpas-ocean/driver/ocn_comp_mct.F @@ -90,8 +90,11 @@ module ocn_comp_mct ! !PRIVATE MODULE VARIABLES #ifdef HAVE_MOAB private :: ocn_export_moab - integer , private :: mblsize, totalmbls + private :: ocn_import_moab + integer , private :: mblsize, totalmbls, totalmbls_r real (kind=RKIND) , allocatable, private :: o2x_om(:,:) + + real (kind=RKIND) , allocatable, private :: x2o_om(:,:) #endif @@ -638,7 +641,10 @@ end subroutine xml_stream_get_attributes mblsize = lsize totalmbls = mblsize * nsend ! size of the double array allocate (o2x_om(lsize, nsend) ) - ! define tags according to the seq_flds_i2x_fields + + totalmbls_r = mblsize * nrecv ! size of the double array for importing + allocate (x2o_om(lsize, nrecv) ) + ! define tags according to the seq_flds_o2x_fields tagtype = 1 ! dense, double numco = 1 ! one value per cell / entity tagname = trim(seq_flds_o2x_fields)//C_NULL_CHAR @@ -843,6 +849,12 @@ end subroutine xml_stream_get_attributes timeStep = mpas_get_clock_timestep(domain_ptr % clock, ierr=ierr) call mpas_get_timeInterval(timeStep, dt=dt) +#ifdef HAVE_MOAB + ! call ocn_import_moab(errorCode) + ! if (errorCode /= 0) then + ! call mpas_log_write('Error in ocn_import_moab', MPAS_LOG_CRIT) + ! endif +#endif call ocn_import_mct(x2o_o, errorCode) if (errorCode /= 0) then call mpas_log_write('Error in ocn_import_mct', MPAS_LOG_CRIT) @@ -955,6 +967,13 @@ subroutine ocn_run_mct( EClock, cdata_o, x2o_o, o2x_o)!{{{ call mpas_get_timeInterval(timeStep, dt=dt) call mpas_reset_clock_alarm(domain_ptr % clock, coupleAlarmID, ierr=ierr) + ! Import state from moab coupler +#ifdef HAVE_MOAB + ! call ocn_import_moab(ierr) + ! if (ierr /= 0) then + ! call mpas_log_write('Error in ocn_import_moab', MPAS_LOG_CRIT) + ! endif +#endif ! Import state from coupler call ocn_import_mct(x2o_o, ierr) @@ -2780,6 +2799,803 @@ end subroutine datetime!}}} #ifdef HAVE_MOAB +! import method from moab +! copied from ocn_import_mct, will replace x2o_o AV with x2o_om array read locally + subroutine ocn_import_moab( errorCode)!{{{ + +! !DESCRIPTION: +!----------------------------------------------------------------------- +! This routine receives message from cpl7 driver +! +! The following fields are always received from the coupler: +! +! o taux -- zonal wind stress (taux) (W/m2 ) +! o tauy -- meridonal wind stress (tauy) (W/m2 ) +! o snow -- water flux due to snow (kg/m2/s) +! o rain -- water flux due to rain (kg/m2/s) +! o evap -- evaporation flux (kg/m2/s) +! o meltw -- snow melt flux (kg/m2/s) +! o salt -- salt (kg(salt)/m2/s) +! o swnet -- net short-wave heat flux (W/m2 ) +! o sen -- sensible heat flux (W/m2 ) +! o lwup -- longwave radiation (up) (W/m2 ) +! o lwdn -- longwave radiation (down) (W/m2 ) +! o melth -- heat flux from snow&ice melt (W/m2 ) +! o ifrac -- ice fraction (%) +! o rofl -- river runoff flux (kg/m2/s) +! o rofi -- ice runoff flux (kg/m2/s) +! +! The following fields are sometimes received from the coupler, +! depending on model options: +! +! o pbot -- bottom atm pressure (Pa) +! o duu10n -- 10m wind speed squared (m^2/s^2) +! o co2prog-- bottom atm level prognostic co2 +! o co2diag-- bottom atm level diagnostic co2 +! +!----------------------------------------------------------------------- +! +! !REVISION HISTORY: +! same as module + +! !INPUT/OUTPUT PARAMETERS: + + ! type(mct_aVect) , intent(inout) :: x2o_o + ! instead, we will get x2o_om from MPOID + +! !OUTPUT PARAMETERS: + + use iMOAB, only : iMOAB_GetDoubleTagStorage + !EOP + !BOC + !----------------------------------------------------------------------- + ! + ! local variables + !----------------------------------------------------------------------- + ! + ! local variables + ! + !----------------------------------------------------------------------- + integer :: ent_type, ierr + character(CXX) :: tagname + + integer, intent(out) :: & + errorCode ! returned error code + +!EOP +!BOC +!----------------------------------------------------------------------- +! +! local variables +! +!----------------------------------------------------------------------- + + character (len=StrKIND) :: & + label, & + message + + integer :: & + i,n + + integer, pointer :: indexIT, indexIS + + logical, pointer :: config_use_ecosysTracers, & + config_use_ecosysTracers_sea_ice_coupling, & + config_use_DMSTracers, & + config_use_DMSTracers_sea_ice_coupling, & + config_use_MacroMoleculesTracers, & + config_use_MacroMoleculesTracers_sea_ice_coupling, & + config_remove_AIS_coupler_runoff, & + config_cvmix_kpp_use_theory_wave + + character(len=StrKIND), pointer :: config_ecosys_atm_co2_option, & + config_ecosys_atm_alt_co2_option + + real (kind=RKIND), pointer :: config_ecosys_atm_co2_constant_value + + real (kind=RKIND), pointer :: config_density0 + + real (kind=RKIND), pointer :: totalRemovedRiverRunoffFlux, totalRemovedIceRunoffFlux + + type (block_type), pointer :: block_ptr + + type (mpas_pool_type), pointer :: meshPool, & + forcingPool, & + ecosysAuxiliary, & + ecosysSeaIceCoupling, & + DMSSeaIceCoupling, & + MacroMoleculesSeaIceCoupling + + integer, pointer :: nCellsSolve + + type (field1DReal), pointer :: windStressZonalField, windStressMeridionalField, & + latentHeatFluxField, sensibleHeatFluxField, & + longWaveHeatFluxUpField, & + longWaveHeatFluxDownField, & + evaporationFluxField, seaIceHeatFluxField, icebergHeatFluxField, & + snowFluxField, seaIceFreshWaterFluxField, icebergFreshWaterFluxField, & + seaIceSalinityFluxField, & + riverRunoffFluxField, iceRunoffFluxField, & + removedRiverRunoffFluxField, removedIceRunoffFluxField, & + shortWaveHeatFluxField, rainFluxField, & + atmosphericPressureField, iceFractionField, & + seaIcePressureField, windSpeedSquared10mField, & + atmosphericCO2Field, atmosphericCO2_ALT_CO2Field, & + iceFluxDICField, & + iceFluxDONField, & + iceFluxNO3Field, & + iceFluxSiO3Field, & + iceFluxNH4Field, & + iceFluxDMSField, & + iceFluxDMSPField, & + iceFluxDOCrField, & + iceFluxFeParticulateField, & + iceFluxFeDissolvedField, & + iceFluxDustField, & + landIceFreshwaterFluxField, & + landIceHeatFluxField, & + landIceFractionField, & + windSpeed10mField + !landIcePressureField + + type (field2DReal), pointer :: iceFluxPhytoCField, & + iceFluxDOCField + + type (field2DReal), pointer :: landIceInterfaceTracersField + + real (kind=RKIND), dimension(:), pointer :: windStressZonal, windStressMeridional, & + latentHeatFlux, sensibleHeatFlux, & + longWaveHeatFluxUp, & + longWaveHeatFluxDown, & + evaporationFlux, seaIceHeatFlux, icebergHeatFlux, & + snowFlux, seaIceFreshWaterFlux, icebergFreshWaterFlux, & + seaIceSalinityFlux, & + riverRunoffFlux, iceRunoffFlux, & + removedRiverRunoffFlux, removedIceRunoffFlux, & + shortWaveHeatFlux, rainFlux, & + atmosphericPressure, iceFraction, & + seaIcePressure, windSpeedSquared10m, & + atmosphericCO2, atmosphericCO2_ALT_CO2, & + iceFluxDIC, & + iceFluxDON, & + iceFluxNO3, & + iceFluxSiO3, & + iceFluxNH4, & + iceFluxDMS, & + iceFluxDMSP, & + iceFluxDOCr, & + iceFluxFeParticulate, & + iceFluxFeDissolved, & + iceFluxDust, & + landIceFreshwaterFlux, & + landIceHeatFlux, & + landIceFraction, & + windSpeed10m + !landIcePressure + + real (kind=RKIND), dimension(:), pointer :: latCell + + real (kind=RKIND), dimension(:,:), pointer :: iceFluxPhytoC, & + iceFluxDOC + + real (kind=RKIND) :: removedRiverRunoffFluxThisProc, removedIceRunoffFluxThisProc + real (kind=RKIND) :: removedRiverRunoffFluxReduced, removedIceRunoffFluxReduced + + real (kind=RKIND), dimension(:,:), pointer :: landIceInterfaceTracers + +!----------------------------------------------------------------------- +! +! zero out padded cells +! +!----------------------------------------------------------------------- + + errorCode = 0 + +! get moab tags from MPOID + + + ent_type = 1 ! cells + ! get all tags in one method + tagname = trim(seq_flds_x2o_fields)//C_NULL_CHAR + ierr = iMOAB_GetDoubleTagStorage ( MPOID, tagname, totalmbls_r , ent_type, x2o_om(1, 1) ) + if ( ierr /= 0 ) then + write(ocnLogUnit,*) 'Fail to get MOAB fields ' + endif + +!----------------------------------------------------------------------- +! +! unpack and distribute wind stress, then convert to correct units +! and rotate components to local coordinates +! +!----------------------------------------------------------------------- + + ! get configure options + call mpas_pool_get_config(domain % configs, 'config_use_ecosysTracers', config_use_ecosysTracers) + call mpas_pool_get_config(domain % configs, 'config_use_DMSTracers', config_use_DMSTracers) + call mpas_pool_get_config(domain % configs, 'config_use_MacroMoleculesTracers', config_use_MacroMoleculesTracers) + call mpas_pool_get_config(domain % configs, 'config_density0', config_density0) + call mpas_pool_get_config(domain % configs, 'config_use_ecosysTracers_sea_ice_coupling', & + config_use_ecosysTracers_sea_ice_coupling) + call mpas_pool_get_config(domain % configs, 'config_use_DMSTracers_sea_ice_coupling', & + config_use_DMSTracers_sea_ice_coupling) + call mpas_pool_get_config(domain % configs, 'config_use_MacroMoleculesTracers_sea_ice_coupling', & + config_use_MacroMoleculesTracers_sea_ice_coupling) + call mpas_pool_get_config(domain % configs, 'config_remove_AIS_coupler_runoff', config_remove_AIS_coupler_runoff) + call mpas_pool_get_config(domain % configs, 'config_cvmix_kpp_use_theory_wave', config_cvmix_kpp_use_theory_wave) + + n = 0 + removedRiverRunoffFluxThisProc = 0.0_RKIND + removedIceRunoffFluxThisProc = 0.0_RKIND + + block_ptr => domain % blocklist + do while(associated(block_ptr)) + call mpas_pool_get_subpool(block_ptr % structs, 'mesh', meshPool) + call mpas_pool_get_subpool(block_ptr % structs, 'forcing', forcingPool) + + call mpas_pool_get_dimension(meshPool, 'nCellsSolve', nCellsSolve) + + call mpas_pool_get_field(forcingPool, 'windStressZonal', windStressZonalField) + call mpas_pool_get_field(forcingPool, 'windStressMeridional', windStressMeridionalField) + call mpas_pool_get_field(forcingPool, 'latentHeatFlux', latentHeatFluxField) + call mpas_pool_get_field(forcingPool, 'sensibleHeatFlux', sensibleHeatFluxField) + call mpas_pool_get_field(forcingPool, 'longWaveHeatFluxUp', longWaveHeatFluxUpField) + call mpas_pool_get_field(forcingPool, 'longWaveHeatFluxDown', longWaveHeatFluxDownField) + call mpas_pool_get_field(forcingPool, 'evaporationFlux', evaporationFluxField) + call mpas_pool_get_field(forcingPool, 'seaIceHeatFlux', seaIceHeatFluxField) + call mpas_pool_get_field(forcingPool, 'icebergHeatFlux', icebergHeatFluxField) + call mpas_pool_get_field(forcingPool, 'snowFlux', snowFluxField) + call mpas_pool_get_field(forcingPool, 'seaIceFreshWaterFlux', seaIceFreshWaterFluxField) + call mpas_pool_get_field(forcingPool, 'icebergFreshWaterFlux', icebergFreshWaterFluxField) + call mpas_pool_get_field(forcingPool, 'seaIceSalinityFlux', seaIceSalinityFluxField) + call mpas_pool_get_field(forcingPool, 'riverRunoffFlux', riverRunoffFluxField) + call mpas_pool_get_field(forcingPool, 'iceRunoffFlux', iceRunoffFluxField) + call mpas_pool_get_field(forcingPool, 'shortWaveHeatFlux', shortWaveHeatFluxField) + call mpas_pool_get_field(forcingPool, 'rainFlux', rainFluxField) + call mpas_pool_get_field(forcingPool, 'atmosphericPressure', atmosphericPressureField) + call mpas_pool_get_field(forcingPool, 'seaIcePressure', seaIcePressureField) + call mpas_pool_get_field(forcingPool, 'iceFraction', iceFractionField) + call mpas_pool_get_field(forcingPool, 'iceRunoffFlux', iceRunoffFluxField) + call mpas_pool_get_field(forcingPool, 'removedRiverRunoffFlux', removedRiverRunoffFluxField) + call mpas_pool_get_field(forcingPool, 'removedIceRunoffFlux', removedIceRunoffFluxField) + + call mpas_pool_get_field(forcingPool, 'landIceFreshwaterFlux', landIceFreshwaterFluxField) + call mpas_pool_get_field(forcingPool, 'landIceHeatFlux', landIceHeatFluxField) + call mpas_pool_get_field(forcingPool, 'landIceFraction', landIceFractionField) + call mpas_pool_get_field(forcingPool, 'landIceInterfaceTracers', landIceInterfaceTracersField) + + call mpas_pool_get_field(forcingPool, 'windSpeed10m', windSpeed10mField) + + call mpas_pool_get_dimension(forcingPool, 'index_landIceInterfaceTemperature', indexIT) + call mpas_pool_get_dimension(forcingPool, 'index_landIceInterfaceSalinity', indexIS) + + !call mpas_pool_get_field(forcingPool, 'landIcePressure', landIcePressureField) + + windStressZonal => windStressZonalField % array + windStressMeridional => windStressMeridionalField % array + latentHeatFlux => latentHeatFluxField % array + sensibleHeatFlux => sensibleHeatFluxField % array + longWaveHeatFluxUp => longWaveHeatFluxUpField % array + longWaveHeatFluxDown => longWaveHeatFluxDownField % array + evaporationFlux => evaporationFluxField % array + seaIceHeatFlux => seaIceHeatFluxField % array + icebergHeatFlux => icebergHeatFluxField % array + snowFlux => snowFluxField % array + seaIceFreshWaterFlux => seaIceFreshWaterFluxField % array + icebergFreshWaterFlux => icebergFreshWaterFluxField % array + seaIceSalinityFlux => seaIceSalinityFluxField % array + riverRunoffFlux => riverRunoffFluxField % array + iceRunoffFlux => iceRunoffFluxField % array + shortWaveHeatFlux => shortWaveHeatFluxField % array + rainFlux => rainFluxField % array + atmosphericPressure => atmosphericPressureField % array + seaIcePressure => seaIcePressureField % array + iceFraction => iceFractionField % array + iceRunoffFlux => iceRunoffFluxField % array + removedRiverRunoffFlux => removedRiverRunoffFluxField % array + removedIceRunoffFlux => removedIceRunoffFluxField % array + landIceFreshwaterFlux => landIceFreshwaterFluxField % array + landIceHeatFlux => landIceHeatFluxField % array + landIceInterfaceTracers => landIceInterfaceTracersField % array + landIceFraction => landIceFractionField % array + windSpeed10m => windSpeed10mField % array + !landIcePressure => landIcePressureField % array + + call mpas_pool_get_array(meshPool, 'latCell', latCell) + + ! BGC fields + if (config_use_ecosysTracers) then + call mpas_pool_get_subpool(forcingPool, 'ecosysAuxiliary', ecosysAuxiliary) + + call mpas_pool_get_field(ecosysAuxiliary, 'windSpeedSquared10m', windSpeedSquared10mField) + windSpeedSquared10m => windSpeedSquared10mField % array + call mpas_pool_get_field(ecosysAuxiliary, 'atmosphericCO2', atmosphericCO2Field) + atmosphericCO2 => atmosphericCO2Field % array + call mpas_pool_get_field(ecosysAuxiliary, 'atmosphericCO2_ALT_CO2', atmosphericCO2_ALT_CO2Field) + atmosphericCO2_ALT_CO2 => atmosphericCO2_ALT_CO2Field % array + + call mpas_pool_get_config(domain % configs, 'config_ecosys_atm_co2_option', & + config_ecosys_atm_co2_option) + call mpas_pool_get_config(domain % configs, 'config_ecosys_atm_alt_co2_option', & + config_ecosys_atm_alt_co2_option) + call mpas_pool_get_config(domain % configs, 'config_ecosys_atm_co2_constant_value', & + config_ecosys_atm_co2_constant_value) + + if (config_use_ecosysTracers_sea_ice_coupling) then + call mpas_pool_get_subpool(forcingPool, 'ecosysSeaIceCoupling', ecosysSeaIceCoupling) + + call mpas_pool_get_field(ecosysSeaIceCoupling, 'iceFluxPhytoC', iceFluxPhytoCField) + call mpas_pool_get_field(ecosysSeaIceCoupling, 'iceFluxDIC', iceFluxDICField) + call mpas_pool_get_field(ecosysSeaIceCoupling, 'iceFluxNO3', iceFluxNO3Field) + call mpas_pool_get_field(ecosysSeaIceCoupling, 'iceFluxSiO3', iceFluxSiO3Field) + call mpas_pool_get_field(ecosysSeaIceCoupling, 'iceFluxNH4', iceFluxNH4Field) + call mpas_pool_get_field(ecosysSeaIceCoupling, 'iceFluxDOCr', iceFluxDOCrField) + call mpas_pool_get_field(ecosysSeaIceCoupling, 'iceFluxFeParticulate', iceFluxFeParticulateField) + call mpas_pool_get_field(ecosysSeaIceCoupling, 'iceFluxFeDissolved', iceFluxFeDissolvedField) + call mpas_pool_get_field(ecosysSeaIceCoupling, 'iceFluxDust', iceFluxDustField) + call mpas_pool_get_field(ecosysSeaIceCoupling, 'iceFluxDOC', iceFluxDOCField) + call mpas_pool_get_field(ecosysSeaIceCoupling, 'iceFluxDON', iceFluxDONField) + + iceFluxPhytoC => iceFluxPhytoCField % array + iceFluxDIC => iceFluxDICField % array + iceFluxNO3 => iceFluxNO3Field % array + iceFluxSiO3 => iceFluxSiO3Field % array + iceFluxNH4 => iceFluxNH4Field % array + iceFluxDOCr => iceFluxDOCrField % array + iceFluxFeParticulate => iceFluxFeParticulateField % array + iceFluxFeDissolved => iceFluxFeDissolvedField % array + iceFluxDust => iceFluxDustField % array + iceFluxDOC => iceFluxDOCField % array + iceFluxDON => iceFluxDONField % array + endif + endif + if (config_use_DMSTracers .and. config_use_DMSTracers_sea_ice_coupling) then + call mpas_pool_get_subpool(forcingPool, 'DMSSeaIceCoupling', DMSSeaIceCoupling) + + call mpas_pool_get_field(DMSSeaIceCoupling, 'iceFluxDMS', iceFluxDMSField) + call mpas_pool_get_field(DMSSeaIceCoupling, 'iceFluxDMSP', iceFluxDMSPField) + + iceFluxDMS => iceFluxDMSField % array + iceFluxDMSP => iceFluxDMSPField % array + endif + + if (config_remove_AIS_coupler_runoff) then + ! Initialize these fields + removedRiverRunoffFlux(:) = 0.0_RKIND + removedIceRunoffFlux(:) = 0.0_RKIND + endif + + if (config_cvmix_kpp_use_theory_wave) then + ! Initialize these fields + windSpeed10m(:) = 0.0_RKIND + endif + +! replace 'x2o_o % rAttr(' to 'x2o_om(n, ' and ', n)' with ')' + do i = 1, nCellsSolve + n = n + 1 + if ( windStressZonalField % isActive ) then + windStressZonal(i) = x2o_om(n, index_x2o_Foxx_taux) + end if + if ( windStressMeridionalField % isActive ) then + windStressMeridional(i) = x2o_om(n, index_x2o_Foxx_tauy) + end if + + if ( latentHeatFluxField % isActive ) then + latentHeatFlux(i) = x2o_om(n, index_x2o_Foxx_lat) + end if + if ( sensibleHeatFluxField % isActive ) then + sensibleHeatFlux(i) = x2o_om(n, index_x2o_Foxx_sen) + end if + if ( longWaveHeatFluxUpField % isActive ) then + longWaveHeatFluxUp(i) = x2o_om(n, index_x2o_Foxx_lwup) + end if + if ( longWaveHeatFluxDownField % isActive ) then + longWaveHeatFluxDown(i) = x2o_om(n, index_x2o_Faxa_lwdn) + end if + if ( evaporationFluxField % isActive ) then + evaporationFlux(i) = x2o_om(n, index_x2o_Foxx_evap) + end if + if ( seaIceHeatFluxField % isActive ) then + seaIceHeatFlux(i) = x2o_om(n, index_x2o_Fioi_melth) + end if + if ( icebergHeatFluxField % isActive ) then + icebergHeatFlux(i) = x2o_om(n, index_x2o_Fioi_bergh) + end if + if ( snowFluxField % isActive ) then + snowFlux(i) = x2o_om(n, index_x2o_Faxa_snow) + end if + if ( seaIceFreshWaterFluxField % isActive ) then + seaIceFreshWaterFlux(i) = x2o_om(n, index_x2o_Fioi_meltw) + end if + if ( icebergFreshWaterFluxField % isActive ) then + icebergFreshWaterFlux(i) = x2o_om(n, index_x2o_Fioi_bergw) + end if + if ( seaIceSalinityFluxField % isActive ) then + seaIceSalinityFlux(i) = x2o_om(n, index_x2o_Fioi_salt) + end if + if ( riverRunoffFluxField % isActive ) then + riverRunoffFlux(i) = x2o_om(n, index_x2o_Foxx_rofl) + if (config_remove_AIS_coupler_runoff) then + if (latCell(i) < -1.04719666667_RKIND) then ! 60S in radians + removedRiverRunoffFlux(i) = riverRunoffFlux(i) + riverRunoffFlux(i) = 0.0_RKIND + removedRiverRunoffFluxThisProc = removedRiverRunoffFluxThisProc + removedRiverRunoffFlux(i) + endif + endif + end if + if ( iceRunoffFluxField % isActive ) then + iceRunoffFlux(i) = x2o_om(n, index_x2o_Foxx_rofi) + if(iceRunoffFlux(n) < 0.0_RKIND) then + call shr_sys_abort ('Error: incoming rofi_F is negative') + end if + if (config_remove_AIS_coupler_runoff) then + if (latCell(i) < -1.04719666667_RKIND) then ! 60S in radians + removedIceRunoffFlux(i) = iceRunoffFlux(i) + iceRunoffFlux(i) = 0.0_RKIND + removedIceRunoffFluxThisProc = removedIceRunoffFluxThisProc + removedIceRunoffFlux(i) + endif + endif + end if + if ( shortWaveHeatFluxField % isActive ) then + shortWaveHeatFlux(i) = max(x2o_om(n, index_x2o_Foxx_swnet), 0.0_RKIND) + end if + + if ( rainFluxField % isActive ) then + rainFlux(i) = x2o_om(n, index_x2o_Faxa_rain) + end if + if ( atmosphericPressureField % isActive ) then + atmosphericPressure(i) = x2o_om(n, index_x2o_Sa_pbot) + end if + if ( seaIcePressureField % isActive ) then + ! Set seaIcePressure to be limited to 5m of pressure + seaIcePressure(i) = min( x2o_om(n, index_x2o_Si_bpress), config_density0 * gravity * 5.0_RKIND ) + end if + if ( iceFractionField % isActive ) then + iceFraction(i) = x2o_om(n, index_x2o_Si_ifrac) + end if + + if (config_cvmix_kpp_use_theory_wave) then + if ( windSpeed10mField% isActive ) then + windSpeed10m(i) = sqrt( x2o_om(n, index_x2o_So_duu10n)) + end if + endif + + if ( landIceFreshwaterFluxField % isActive ) then + !landIceFreshwaterFlux(i) = x2o_om(n, index_x2o_Fogx_qicelo) + end if + if ( landIceHeatFluxField % isActive ) then + !landIceHeatFlux(i) = x2o_om(n, index_x2o_Fogx_qiceho) + end if + if ( landIceInterfaceTracersField % isActive ) then + !landIceInterfaceTracers(indexIT, i) = x2o_om(n, index_x2o_Sg_blit) + !landIceInterfaceTracers(indexIS, i) = x2o_om(n, index_x2o_Sg_blis) + end if + if ( landIceFractionField % isActive ) then + !landIceFraction(i) = x2o_om(n, index_x2o_Sg_icemask) + end if + !if ( landIcePressureField % isActive ) then + !landIcePressure(i) = x2o_om(n, index_x2o_Sg_lithop) + !end if + + ! BGC fields + if (config_use_ecosysTracers) then + if ( windSpeedSquared10mField % isActive ) then + windSpeedSquared10m(i) = x2o_om(n, index_x2o_So_duu10n) + end if + if ( atmosphericCO2Field % isActive ) then + if ( config_ecosys_atm_co2_option == 'prognostic') then + atmosphericCO2(i) = x2o_om(n, index_x2o_Sa_co2prog) + else if ( config_ecosys_atm_co2_option == 'diagnostic') then + atmosphericCO2(i) = x2o_om(n, index_x2o_Sa_co2diag) + else if ( config_ecosys_atm_co2_option == 'bcrc') then + atmosphericCO2(i) = config_ecosys_atm_co2_constant_value + else if ( config_ecosys_atm_co2_option == 'bcrd') then + atmosphericCO2(i) = config_ecosys_atm_co2_constant_value + else if ( config_ecosys_atm_co2_option == 'bdrc') then + atmosphericCO2(i) = x2o_om(n, index_x2o_Sa_co2diag) + else if ( config_ecosys_atm_co2_option == 'bdrd') then + atmosphericCO2(i) = x2o_om(n, index_x2o_Sa_co2diag) + else + atmosphericCO2(i) = config_ecosys_atm_co2_constant_value + end if + end if + if ( atmosphericCO2_ALT_CO2Field % isActive ) then + if ( config_ecosys_atm_alt_co2_option == 'prognostic') then + atmosphericCO2_ALT_CO2(i) = x2o_om(n, index_x2o_Sa_co2prog) + else if ( config_ecosys_atm_alt_co2_option == 'diagnostic') then + atmosphericCO2_ALT_CO2(i) = x2o_om(n, index_x2o_Sa_co2diag) + else if ( config_ecosys_atm_alt_co2_option == 'bcrc') then + atmosphericCO2_ALT_CO2(i) = config_ecosys_atm_co2_constant_value + else if ( config_ecosys_atm_alt_co2_option == 'bcrd') then + atmosphericCO2_ALT_CO2(i) = x2o_om(n, index_x2o_Sa_co2diag) + else if ( config_ecosys_atm_alt_co2_option == 'bdrc') then + atmosphericCO2_ALT_CO2(i) = config_ecosys_atm_co2_constant_value + else if ( config_ecosys_atm_alt_co2_option == 'bdrd') then + atmosphericCO2_ALT_CO2(i) = x2o_om(n, index_x2o_Sa_co2diag) + else + atmosphericCO2_ALT_CO2(i) = config_ecosys_atm_co2_constant_value + end if + end if + + if (config_use_ecosysTracers_sea_ice_coupling) then + if ( iceFluxPhytoCField % isActive ) then + iceFluxPhytoC(1,i) = x2o_om(n, index_x2o_Fioi_algae1) + iceFluxPhytoC(2,i) = x2o_om(n, index_x2o_Fioi_algae2) + iceFluxPhytoC(3,i) = x2o_om(n, index_x2o_Fioi_algae3) + endif + if ( iceFluxDICField % isActive ) then + iceFluxDIC(i) = x2o_om(n, index_x2o_Fioi_dic1) + endif + if ( iceFluxNO3Field % isActive ) then + iceFluxNO3(i) = x2o_om(n, index_x2o_Fioi_no3) + endif + if ( iceFluxSiO3Field % isActive ) then + iceFluxSiO3(i) = x2o_om(n, index_x2o_Fioi_sio3) + endif + if ( iceFluxNH4Field % isActive ) then + iceFluxNH4(i) = x2o_om(n, index_x2o_Fioi_nh4) + endif + if ( iceFluxDOCrField % isActive ) then + iceFluxDOCr(i) = x2o_om(n, index_x2o_Fioi_docr) + endif + if ( iceFluxFeParticulateField % isActive ) then + iceFluxFeParticulate(i) = x2o_om(n, index_x2o_Fioi_fep1) + endif + if ( iceFluxFeDissolvedField % isActive ) then + iceFluxFeDissolved(i) = x2o_om(n, index_x2o_Fioi_fed1) + endif + if ( iceFluxDustField % isActive ) then + iceFluxDust(i) = x2o_om(n, index_x2o_Fioi_dust1) + endif + if ( iceFluxDOCField % isActive ) then + iceFluxDOC(1,i) = x2o_om(n, index_x2o_Fioi_doc1) + iceFluxDOC(2,i) = x2o_om(n, index_x2o_Fioi_doc2) + endif + if ( iceFluxDONField % isActive ) then + iceFluxDON(i) = x2o_om(n, index_x2o_Fioi_don1) + endif + endif + endif + if (config_use_DMSTracers .and. config_use_DMSTracers_sea_ice_coupling) then + if ( iceFluxDMSField % isActive ) then + iceFluxDMS(i) = x2o_om(n, index_x2o_Fioi_dms) + endif + if ( iceFluxDMSPField % isActive ) then + !JW TODO: dmspp? dmspd? the sum? + iceFluxDMSP(i) = x2o_om(n, index_x2o_Fioi_dmspp) + endif + endif + + end do + + block_ptr => block_ptr % next + end do + + call mpas_pool_get_subpool(domain % blocklist % structs, 'forcing', forcingPool) + + call mpas_pool_get_field(forcingPool, 'windStressZonal', windStressZonalField) + call mpas_pool_get_field(forcingPool, 'windStressMeridional', windStressMeridionalField) + call mpas_pool_get_field(forcingPool, 'latentHeatFlux', latentHeatFluxField) + call mpas_pool_get_field(forcingPool, 'sensibleHeatFlux', sensibleHeatFluxField) + call mpas_pool_get_field(forcingPool, 'longWaveHeatFluxUp', longWaveHeatFluxUpField) + call mpas_pool_get_field(forcingPool, 'longWaveHeatFluxDown', longWaveHeatFluxDownField) + call mpas_pool_get_field(forcingPool, 'evaporationFlux', evaporationFluxField) + call mpas_pool_get_field(forcingPool, 'seaIceHeatFlux', seaIceHeatFluxField) + call mpas_pool_get_field(forcingPool, 'icebergHeatFlux', icebergHeatFluxField) + call mpas_pool_get_field(forcingPool, 'snowFlux', snowFluxField) + call mpas_pool_get_field(forcingPool, 'seaIceFreshWaterFlux', seaIceFreshWaterFluxField) + call mpas_pool_get_field(forcingPool, 'icebergFreshWaterFlux', icebergFreshWaterFluxField) + call mpas_pool_get_field(forcingPool, 'seaIceSalinityFlux', seaIceSalinityFluxField) + call mpas_pool_get_field(forcingPool, 'riverRunoffFlux', riverRunoffFluxField) + call mpas_pool_get_field(forcingPool, 'iceRunoffFlux', iceRunoffFluxField) + call mpas_pool_get_field(forcingPool, 'shortWaveHeatFlux', shortWaveHeatFluxField) + call mpas_pool_get_field(forcingPool, 'rainFlux', rainFluxField) + call mpas_pool_get_field(forcingPool, 'atmosphericPressure', atmosphericPressureField) + call mpas_pool_get_field(forcingPool, 'seaIcePressure', seaIcePressureField) + call mpas_pool_get_field(forcingPool, 'iceFraction', iceFractionField) + + call mpas_pool_get_field(forcingPool, 'landIceFreshwaterFlux', landIceFreshwaterFluxField) + call mpas_pool_get_field(forcingPool, 'landIceHeatFlux', landIceHeatFluxField) + call mpas_pool_get_field(forcingPool, 'landIceFraction', landIceFractionField) + call mpas_pool_get_field(forcingPool, 'landIceInterfaceTracers', landIceInterfaceTracersField) + + call mpas_pool_get_field(forcingPool, 'windSpeed10m', windSpeed10mField) + + call mpas_pool_get_dimension(forcingPool, 'index_landIceInterfaceTemperature', indexIT) + call mpas_pool_get_dimension(forcingPool, 'index_landIceInterfaceSalinity', indexIS) + !call mpas_pool_get_field(forcingPool, 'landIcePressure', landIcePressureField) + + ! BGC fields + if (config_use_ecosysTracers) then + call mpas_pool_get_subpool(forcingPool, 'ecosysAuxiliary', ecosysAuxiliary) + + call mpas_pool_get_field(ecosysAuxiliary, 'windSpeedSquared10m', windSpeedSquared10mField) + call mpas_pool_get_field(ecosysAuxiliary, 'atmosphericCO2', atmosphericCO2Field) + call mpas_pool_get_field(ecosysAuxiliary, 'atmosphericCO2_ALT_CO2', atmosphericCO2_ALT_CO2Field) + + if (config_use_ecosysTracers_sea_ice_coupling) then + call mpas_pool_get_subpool(forcingPool, 'ecosysSeaIceCoupling', ecosysSeaIceCoupling) + + call mpas_pool_get_field(ecosysSeaIceCoupling, 'iceFluxPhytoC', iceFluxPhytoCField) + call mpas_pool_get_field(ecosysSeaIceCoupling, 'iceFluxDIC', iceFluxDICField) + call mpas_pool_get_field(ecosysSeaIceCoupling, 'iceFluxNO3', iceFluxNO3Field) + call mpas_pool_get_field(ecosysSeaIceCoupling, 'iceFluxSiO3', iceFluxSiO3Field) + call mpas_pool_get_field(ecosysSeaIceCoupling, 'iceFluxNH4', iceFluxNH4Field) + call mpas_pool_get_field(ecosysSeaIceCoupling, 'iceFluxDOCr', iceFluxDOCrField) + call mpas_pool_get_field(ecosysSeaIceCoupling, 'iceFluxFeParticulate', iceFluxFeParticulateField) + call mpas_pool_get_field(ecosysSeaIceCoupling, 'iceFluxFeDissolved', iceFluxFeDissolvedField) + call mpas_pool_get_field(ecosysSeaIceCoupling, 'iceFluxDust', iceFluxDustField) + call mpas_pool_get_field(ecosysSeaIceCoupling, 'iceFluxDOC', iceFluxDOCField) + call mpas_pool_get_field(ecosysSeaIceCoupling, 'iceFluxDON', iceFluxDONField) + endif + endif + if (config_use_DMSTracers .and. config_use_DMSTracers_sea_ice_coupling) then + call mpas_pool_get_subpool(forcingPool, 'DMSSeaIceCoupling', DMSSeaIceCoupling) + + call mpas_pool_get_field(DMSSeaIceCoupling, 'iceFluxDMS', iceFluxDMSField) + call mpas_pool_get_field(DMSSeaIceCoupling, 'iceFluxDMSP', iceFluxDMSPField) + endif + + if ( windStressMeridionalField % isActive ) then + call mpas_dmpar_exch_halo_field(windStressMeridionalField) + end if + if ( windStressZonalField % isActive ) then + call mpas_dmpar_exch_halo_field(windStressZonalField) + end if + if ( latentHeatFluxField % isActive ) then + call mpas_dmpar_exch_halo_field(latentHeatFluxField) + end if + if ( sensibleHeatFluxField % isActive ) then + call mpas_dmpar_exch_halo_field(sensibleHeatFluxField) + end if + if ( longWaveHeatFluxUpField % isActive ) then + call mpas_dmpar_exch_halo_field(longWaveHeatFluxUpField) + end if + if ( longWaveHeatFluxDownField % isActive ) then + call mpas_dmpar_exch_halo_field(longWaveHeatFluxDownField) + end if + if ( evaporationFluxField % isActive ) then + call mpas_dmpar_exch_halo_field(evaporationFluxField) + end if + if ( seaIceHeatFluxField % isActive ) then + call mpas_dmpar_exch_halo_field(seaIceHeatFluxField) + end if + if ( icebergHeatFluxField % isActive ) then + call mpas_dmpar_exch_halo_field(icebergHeatFluxField) + end if + if ( snowFluxField % isActive ) then + call mpas_dmpar_exch_halo_field(snowFluxField) + end if + if ( seaIceFreshWaterFluxField % isActive ) then + call mpas_dmpar_exch_halo_field(seaIceFreshWaterFluxField) + end if + if ( icebergFreshWaterFluxField % isActive ) then + call mpas_dmpar_exch_halo_field(icebergFreshWaterFluxField) + end if + if ( seaIceSalinityFluxField % isActive ) then + call mpas_dmpar_exch_halo_field(seaIceSalinityFluxField) + end if + if ( riverRunoffFluxField % isActive ) then + call mpas_dmpar_exch_halo_field(riverRunoffFluxField) + end if + if ( iceRunoffFluxField % isActive ) then + call mpas_dmpar_exch_halo_field(iceRunoffFluxField) + end if + if ( shortWaveHeatFluxField % isActive ) then + call mpas_dmpar_exch_halo_field(shortWaveHeatFluxField) + end if + if ( rainFluxField % isActive ) then + call mpas_dmpar_exch_halo_field(rainFluxField) + end if + if ( atmosphericPressureField % isActive ) then + call mpas_dmpar_exch_halo_field(atmosphericPressureField) + end if + if ( seaIcePressureField % isActive ) then + call mpas_dmpar_exch_halo_field(seaIcePressureField) + end if + if ( iceFractionField % isActive ) then + call mpas_dmpar_exch_halo_field(iceFractionField) + end if + + if ( landIceFreshwaterFluxField % isActive ) then + call mpas_dmpar_exch_halo_field(landIceFreshwaterFluxField) + end if + if ( landIceHeatFluxField % isActive ) then + call mpas_dmpar_exch_halo_field(landIceHeatFluxField) + end if + if ( landIceInterfaceTracersField % isActive ) then + call mpas_dmpar_exch_halo_field(landIceInterfaceTracersField) + end if + if ( landIceFractionField % isActive ) then + call mpas_dmpar_exch_halo_field(landIceFractionField) + end if +! if ( landIcePressureField % isActive ) then +! call mpas_dmpar_exch_halo_field(landIcePressureField) +! end if + + if ( windSpeed10mField % isActive ) then + call mpas_dmpar_exch_halo_field(windSpeed10mField) + end if + + ! BGC fields + if (config_use_ecosysTracers) then + + if ( windSpeedSquared10mField % isActive ) then + call mpas_dmpar_exch_halo_field(windSpeedSquared10mField) + end if + if ( atmosphericCO2Field % isActive ) then + call mpas_dmpar_exch_halo_field(atmosphericCO2Field) + end if + if ( atmosphericCO2_ALT_CO2Field % isActive ) then + call mpas_dmpar_exch_halo_field(atmosphericCO2_ALT_CO2Field) + end if + + if (config_use_ecosysTracers_sea_ice_coupling) then + if ( iceFluxPhytoCField % isActive ) then + call mpas_dmpar_exch_halo_field(iceFluxPhytoCField) + endif + if ( iceFluxDICField % isActive ) then + call mpas_dmpar_exch_halo_field(iceFluxDICField) + endif + if ( iceFluxNO3Field % isActive ) then + call mpas_dmpar_exch_halo_field(iceFluxNO3Field) + endif + if ( iceFluxSiO3Field % isActive ) then + call mpas_dmpar_exch_halo_field(iceFluxSiO3Field) + endif + if ( iceFluxNH4Field % isActive ) then + call mpas_dmpar_exch_halo_field(iceFluxNH4Field) + endif + if ( iceFluxDOCrField % isActive ) then + call mpas_dmpar_exch_halo_field(iceFluxDOCrField) + endif + if ( iceFluxFeParticulateField % isActive ) then + call mpas_dmpar_exch_halo_field(iceFluxFeParticulateField) + endif + if ( iceFluxFeDissolvedField % isActive ) then + call mpas_dmpar_exch_halo_field(iceFluxFeDissolvedField) + endif + if ( iceFluxDustField % isActive ) then + call mpas_dmpar_exch_halo_field(iceFluxDustField) + endif + if ( iceFluxDOCField % isActive ) then + call mpas_dmpar_exch_halo_field(iceFluxDOCField) + endif + if ( iceFluxDONField % isActive ) then + call mpas_dmpar_exch_halo_field(iceFluxDONField) + endif + endif + endif + if (config_use_DMSTracers .and. config_use_DMSTracers_sea_ice_coupling) then + if ( iceFluxDMSField % isActive ) then + call mpas_dmpar_exch_halo_field(iceFluxDMSField) + endif + if ( iceFluxDMSPField % isActive ) then + call mpas_dmpar_exch_halo_field(iceFluxDMSPField) + endif + endif + + ! global sum of removed runoff + if (config_remove_AIS_coupler_runoff) then + call MPAS_dmpar_sum_real(domain % dminfo, removedRiverRunoffFluxThisProc, removedRiverRunoffFluxReduced) + call MPAS_dmpar_sum_real(domain % dminfo, removedIceRunoffFluxThisProc, removedIceRunoffFluxReduced) + block_ptr => domain % blocklist + do while(associated(block_ptr)) + call mpas_pool_get_subpool(block_ptr % structs, 'forcing', forcingPool) + + call mpas_pool_get_array(forcingPool, 'totalRemovedRiverRunoffFlux', totalRemovedRiverRunoffFlux) + call mpas_pool_get_array(forcingPool, 'totalRemovedIceRunoffFlux', totalRemovedIceRunoffFlux) + totalRemovedRiverRunoffFlux = removedRiverRunoffFluxReduced + totalRemovedIceRunoffFlux = removedIceRunoffFluxReduced + + block_ptr => block_ptr % next + end do + endif + +!----------------------------------------------------------------------- +!EOC + + end subroutine ocn_import_moab!}}} + subroutine ocn_export_moab() !{{{ ! !DESCRIPTION: From 6aaccbe8e99fdd818c0699cabe7d96f24b7722f6 Mon Sep 17 00:00:00 2001 From: Robert Jacob Date: Mon, 16 Jan 2023 01:47:37 -0600 Subject: [PATCH 302/467] Add moab version of ice_import Add first moab version of ice_import. Still need to test. --- components/mpas-seaice/driver/ice_comp_mct.F | 604 ++++++++++++++++++- 1 file changed, 600 insertions(+), 4 deletions(-) diff --git a/components/mpas-seaice/driver/ice_comp_mct.F b/components/mpas-seaice/driver/ice_comp_mct.F index a5bc97422767..bd21ac4e1699 100644 --- a/components/mpas-seaice/driver/ice_comp_mct.F +++ b/components/mpas-seaice/driver/ice_comp_mct.F @@ -91,8 +91,10 @@ module ice_comp_mct ! #ifdef HAVE_MOAB private :: ice_export_moab - integer , private :: mblsize, totalmbls - real (kind=RKIND) , allocatable, private :: i2x_im(:,:) + private :: ice_import_moab + integer , private :: mblsize, totalmbls,totalmblr + real (kind=RKIND) , allocatable, private :: i2x_im(:,:) + real (kind=RKIND) , allocatable, private :: x2i_im(:,:) #endif ! !PRIVATE MODULE VARIABLES @@ -695,7 +697,9 @@ end subroutine xml_stream_get_attributes ! initialize moab tag fields array mblsize = lsize totalmbls = mblsize * nsend ! size of the double array + totalmblr = mblsize * nrecv ! size of the double array allocate (i2x_im(lsize, nsend) ) + allocate (x2i_im(lsize, nrecv) ) ! define tags according to the seq_flds_i2x_fields tagtype = 1 ! dense, double numco = 1 ! one value per cell / entity @@ -1434,6 +1438,7 @@ subroutine ice_final_mct( EClock, cdata_i, x2i_i, i2x_i)!{{{ #ifdef HAVE_MOAB ! deallocate moab fields array deallocate (i2x_im) + deallocate (x2i_im) #endif ! Reset I/O logs call shr_file_setLogUnit (shrlogunit) @@ -3249,13 +3254,604 @@ subroutine ice_export_moab() endif -!#ifdef MOABDEBUG +#ifdef MOABDEBUG write(lnum,"(I0.2)")num_moab_exports outfile = 'ice_export_'//trim(lnum)//'.h5m'//C_NULL_CHAR wopts = 'PARALLEL=WRITE_PART'//C_NULL_CHAR ierr = iMOAB_WriteMesh(MPSIID, outfile, wopts) -!#endif +#endif end subroutine ice_export_moab +!*********************************************************************** +!BOP +! !IROUTINE: ice_import_moab +! !INTERFACE: + + subroutine ice_import_moab()!{{{ + +! !DESCRIPTION: +!----------------------------------------------------------------------- +! This routine receives message from cpl7 driver +! +! The following fields are always received from the coupler: +! +! o t -- ocn layer temperature +! o s -- ocn salinity +! o u -- ocn u velocity +! o v -- ocn v velocity +! o z -- bottom atm level height +! o u -- bottom atm level zon wind +! o v -- bottom atm level mer wind +! o tbot -- bottom atm level temp +! o pbot -- bottom atm level pressure +! o ptem -- bottom atm level pot temp +! o shum -- bottom atm level spec hum +! o dens -- bottom atm level air den +! o dhdx -- ocn surface slope, zonal +! o dhdy -- ocn surface slope, meridional +! o lwdn -- downward lw heat flux +! o rain -- prec: liquid +! o snow -- prec: frozen +! o swndr -- sw: nir direct downward +! o swvdr -- sw: vis direct downward +! o swndf -- sw: nir diffuse downward +! o swvdf -- sw: vis diffuse downward +! o swnet -- sw: net +! o q -- ocn frazil heat flux(+) / melt potential(-) +! o frazil -- ocn frazil mass flux +! o bcphidry -- Black Carbon hydrophilic dry deposition flux +! o bcphodry -- Black Carbon hydrophobic dry deposition flux +! o bcphiwet -- Black Carbon hydrophilic wet deposition flux +! o ocphidry -- Organic Carbon hydrophilic dry deposition flux +! o ocphodry -- Organic Carbon hydrophobic dry deposition flux +! o ocphiwet -- Organic Carbon hydrophilic dry deposition flux +! o dstwet1 -- Size 1 dust -- wet deposition flux +! o dstwet2 -- Size 2 dust -- wet deposition flux +! o dstwet3 -- Size 3 dust -- wet deposition flux +! o dstwet4 -- Size 4 dust -- wet deposition flux +! o dstdry1 -- Size 1 dust -- dry deposition flux +! o dstdry2 -- Size 2 dust -- dry deposition flux +! o dstdry3 -- Size 3 dust -- dry deposition flux +! o dstdry4 -- Size 4 dust -- dry deposition flux +! +! The following fields are sometimes received from the coupler, +! depending on model options: +! +! o algae1 -- +! o algae2 -- +! o algae3 -- +! o doc1 -- +! o doc2 -- +! o doc3 -- +! o dic1 -- +! o don1 -- +! o no3 -- +! o sio3 -- +! o nh4 -- +! o dms -- +! o dmsp -- +! o docr -- +! o fep1 -- +! o fep2 -- +! o fed1 -- +! o fed2 -- +! o zaer1 -- +! o zaer2 -- +! o zaer3 -- +! o zaer4 -- +! o zaer5 -- +! o zaer6 -- +! +!----------------------------------------------------------------------- +! +! !REVISION HISTORY: +! same as module + use iMOAB, only : iMOAB_GetDoubleTagStorage, iMOAB_WriteMesh + use seq_comm_mct, only: num_moab_exports + +!EOP +!BOC +!----------------------------------------------------------------------- +! +! local variables +! +!----------------------------------------------------------------------- + + character (len=StrKIND) :: & + label, & + message + + integer :: & + i,n + + real (kind=RKIND) :: & + frazilMassFlux, & + frazilMassFluxRev + + type (block_type), pointer :: block_ptr + + type (mpas_pool_type), pointer :: & + configs, & + meshPool, & + aerosols, & + atmosCoupling, & + oceanCoupling, & + biogeochemistry + + integer, pointer :: nCellsSolve + + logical, pointer :: & + config_use_aerosols, & + config_use_modal_aerosols, & + config_use_zaerosols, & + config_use_column_biogeochemistry + + character(len=strKIND), pointer :: & + config_thermodynamics_type, & + config_ocean_surface_type + + type (field1DReal), pointer :: & + seaSurfaceTemperatureField, & + seaSurfaceSalinityField, & + seaFreezingTemperatureField, & + freezingMeltingPotentialField, & + frazilMassAdjustField, & + uOceanVelocityField, & + vOceanVelocityField, & + seaSurfaceTiltUField, & + seaSurfaceTiltVField, & + airLevelHeightField, & + airPotentialTemperatureField, & + airTemperatureField, & + airSpecificHumidityField, & + airDensityField, & + shortwaveVisibleDirectDownField, & + shortwaveVisibleDiffuseDownField, & + shortwaveIRDirectDownField, & + shortwaveIRDiffuseDownField, & + longwaveDownField, & + rainfallRateField, & + snowfallRateField, & + uAirVelocityField, & + vAirVelocityField, & + oceanNitrateConcField, & + oceanSilicateConcField, & + oceanAmmoniumConcField, & + oceanDMSConcField, & + oceanDMSPConcField, & + oceanHumicsConcField + + type (field2DReal), pointer :: & + oceanAlgaeConcField, & + oceanDOCConcField, & + oceanDICConcField, & + oceanDONConcField, & + oceanParticulateIronConcField, & + oceanDissolvedIronConcField, & + oceanZAerosolConcField, & + atmosAerosolFluxField, & + atmosBlackCarbonFluxField, & + atmosDustFluxField + + real (kind=RKIND), dimension(:), pointer :: & + seaSurfaceTemperature, & + seaSurfaceSalinity, & + seaFreezingTemperature, & + freezingMeltingPotential, & + frazilMassAdjust, & + uOceanVelocity, & + vOceanVelocity, & + seaSurfaceTiltU, & + seaSurfaceTiltV, & + airLevelHeight, & + airPotentialTemperature, & + airTemperature, & + airSpecificHumidity, & + airDensity, & + shortwaveVisibleDirectDown, & + shortwaveVisibleDiffuseDown, & + shortwaveIRDirectDown, & + shortwaveIRDiffuseDown, & + longwaveDown, & + rainfallRate, & + snowfallRate, & + uAirVelocity, & + vAirVelocity, & + oceanNitrateConc, & + oceanSilicateConc, & + oceanAmmoniumConc, & + oceanDMSConc, & + oceanDMSPConc, & + oceanHumicsConc, & + carbonToNitrogenRatioAlgae, & + carbonToNitrogenRatioDON + + real (kind=RKIND), dimension(:,:), pointer :: & + oceanAlgaeConc, & + oceanDOCConc, & + oceanDICConc, & + oceanDONConc, & + oceanParticulateIronConc, & + oceanDissolvedIronConc, & + oceanZAerosolConc, & + atmosAerosolFlux, & + atmosBlackCarbonFlux, & + atmosDustFlux + character(CXX) :: tagname + integer :: ierr, ent_type +!----------------------------------------------------------------------- +! +! zero out padded cells +! +!----------------------------------------------------------------------- + + +!----------------------------------------------------------------------- +! +! +!----------------------------------------------------------------------- + + n = 0 + x2i_im(: ,:) = 0.0_RKIND + + ent_type = 1 ! cells + ! set all tags in one method + tagname = trim(seq_flds_x2i_fields)//C_NULL_CHAR + ierr = iMOAB_GetDoubleTagStorage ( MPSIID, tagname, totalmblr , ent_type, x2i_im(1, 1) ) + if ( ierr /= 0 ) then + write(iceLogUnit,*) 'Fail to get seq_flds_x2i_fields ' + endif + block_ptr => domain % blocklist + do while(associated(block_ptr)) + + configs => block_ptr % configs + call mpas_pool_get_config(configs, "config_thermodynamics_type", config_thermodynamics_type) + call mpas_pool_get_config(configs, "config_ocean_surface_type", config_ocean_surface_type) + call mpas_pool_get_config(configs, "config_use_aerosols", config_use_aerosols) + call mpas_pool_get_config(configs, "config_use_modal_aerosols", config_use_modal_aerosols) + call mpas_pool_get_config(configs, "config_use_column_biogeochemistry", config_use_column_biogeochemistry) + + call mpas_pool_get_subpool(block_ptr % structs, 'mesh', meshPool) + call mpas_pool_get_subpool(block_ptr % structs, 'ocean_coupling', oceanCoupling) + call mpas_pool_get_subpool(block_ptr % structs, 'atmos_coupling', atmosCoupling) + + call mpas_pool_get_dimension(meshPool, 'nCellsSolve', nCellsSolve) + + call mpas_pool_get_array(oceanCoupling, 'seaSurfaceTemperature', seaSurfaceTemperature) + call mpas_pool_get_array(oceanCoupling, 'seaSurfaceSalinity', seaSurfaceSalinity) + call mpas_pool_get_array(oceanCoupling, 'seaFreezingTemperature', seaFreezingTemperature) + call mpas_pool_get_array(oceanCoupling, 'freezingMeltingPotential', freezingMeltingPotential) + call mpas_pool_get_array(oceanCoupling, 'frazilMassAdjust', frazilMassAdjust) + call mpas_pool_get_array(oceanCoupling, 'uOceanVelocity', uOceanVelocity) + call mpas_pool_get_array(oceanCoupling, 'vOceanVelocity', vOceanVelocity) + call mpas_pool_get_array(oceanCoupling, 'seaSurfaceTiltU', seaSurfaceTiltU) + call mpas_pool_get_array(oceanCoupling, 'seaSurfaceTiltV', seaSurfaceTiltV) + + call mpas_pool_get_array(atmosCoupling, 'airLevelHeight', airLevelHeight) + call mpas_pool_get_array(atmosCoupling, 'airPotentialTemperature', airPotentialTemperature) + call mpas_pool_get_array(atmosCoupling, 'airTemperature', airTemperature) + call mpas_pool_get_array(atmosCoupling, 'airSpecificHumidity', airSpecificHumidity) + call mpas_pool_get_array(atmosCoupling, 'airDensity', airDensity) + call mpas_pool_get_array(atmosCoupling, 'shortwaveVisibleDirectDown', shortwaveVisibleDirectDown) + call mpas_pool_get_array(atmosCoupling, 'shortwaveVisibleDiffuseDown', shortwaveVisibleDiffuseDown) + call mpas_pool_get_array(atmosCoupling, 'shortwaveIRDirectDown', shortwaveIRDirectDown) + call mpas_pool_get_array(atmosCoupling, 'shortwaveIRDiffuseDown', shortwaveIRDiffuseDown) + call mpas_pool_get_array(atmosCoupling, 'longwaveDown', longwaveDown) + call mpas_pool_get_array(atmosCoupling, 'rainfallRate', rainfallRate) + call mpas_pool_get_array(atmosCoupling, 'snowfallRate', snowfallRate) + call mpas_pool_get_array(atmosCoupling, 'uAirVelocity', uAirVelocity) + call mpas_pool_get_array(atmosCoupling, 'vAirVelocity', vAirVelocity) + + if (config_use_aerosols) then + call mpas_pool_get_subpool(block_ptr % structs, 'aerosols', aerosols) + + call mpas_pool_get_array(aerosols, "atmosAerosolFlux", atmosAerosolFlux) + endif + + if (config_use_column_biogeochemistry) then + call mpas_pool_get_config(configs, "config_use_zaerosols", config_use_zaerosols) + call mpas_pool_get_subpool(block_ptr % structs, 'biogeochemistry', biogeochemistry) + + call mpas_pool_get_array(biogeochemistry, 'oceanAlgaeConc', oceanAlgaeConc) + call mpas_pool_get_array(biogeochemistry, 'oceanDOCConc', oceanDOCConc) + call mpas_pool_get_array(biogeochemistry, 'oceanDICConc', oceanDICConc) + call mpas_pool_get_array(biogeochemistry, 'oceanDONConc', oceanDONConc) + call mpas_pool_get_array(biogeochemistry, 'oceanNitrateConc', oceanNitrateConc) + call mpas_pool_get_array(biogeochemistry, 'oceanSilicateConc', oceanSilicateConc) + call mpas_pool_get_array(biogeochemistry, 'oceanAmmoniumConc', oceanAmmoniumConc) + call mpas_pool_get_array(biogeochemistry, 'oceanDMSConc', oceanDMSConc) + call mpas_pool_get_array(biogeochemistry, 'oceanDMSPConc', oceanDMSPConc) + call mpas_pool_get_array(biogeochemistry, 'oceanHumicsConc', oceanHumicsConc) + call mpas_pool_get_array(biogeochemistry, 'oceanParticulateIronConc', oceanParticulateIronConc) + call mpas_pool_get_array(biogeochemistry, 'oceanDissolvedIronConc', oceanDissolvedIronConc) + call mpas_pool_get_array(biogeochemistry, 'oceanZAerosolConc', oceanZAerosolConc) + call mpas_pool_get_array(biogeochemistry, 'carbonToNitrogenRatioAlgae', carbonToNitrogenRatioAlgae) + call mpas_pool_get_array(biogeochemistry, 'carbonToNitrogenRatioDON', carbonToNitrogenRatioDON) + if (config_use_zaerosols) then + call mpas_pool_get_array(biogeochemistry, "atmosBlackCarbonFlux", atmosBlackCarbonFlux) + call mpas_pool_get_array(biogeochemistry, "atmosDustFlux", atmosDustFlux) + endif + endif + + do i = 1, nCellsSolve + n = n + 1 + seaSurfaceTemperature(i) = x2i_im(n,index_x2i_So_t) + seaSurfaceSalinity(i) = x2i_im(n,index_x2i_So_s) + + seaFreezingTemperature(i) = colpkg_sea_freezing_temperature(seaSurfaceSalinity(i)) + + uOceanVelocity(i) = x2i_im(n,index_x2i_So_u) + vOceanVelocity(i) = x2i_im(n,index_x2i_So_v) + seaSurfaceTiltU(i) = x2i_im(n,index_x2i_So_dhdx) + seaSurfaceTiltV(i) = x2i_im(n,index_x2i_So_dhdy) + + if (trim(config_ocean_surface_type) == "free") then ! free surface (MPAS-O) + + ! freezingMeltingPotential(i) is the ocean energy associated with frazil formation + ! when it is positive and frazilMassFlux is positive. Conversely, freezingMeltingPotential(i) + ! is negative when there is the melting potential in which case frazilMassFlux is zero. + + freezingMeltingPotential(i) = x2i_im(n,index_x2i_Fioo_q) + + frazilMassFlux = x2i_im(n,index_x2i_Fioo_frazil) + + ! Now determine the sea ice mass associated with the frazil heat flux given when + ! freezingMeltingPotential(i) is positive. This produces a revised mass flux, given + ! in frazilMassFluxRev for the given sea surface salinity. The resulting difference + ! is assigned to frazilMassAdjust(i) which is exported to the ocean in the subsequent + ! coupling step as a freshwater and salt flux. This step is required to balance mass + ! and heat with the ocean. + + call frazil_mass(freezingMeltingPotential(i), frazilMassFluxRev, seaSurfaceSalinity(i), & + config_thermodynamics_type) + + frazilMassAdjust(i) = frazilMassFlux-frazilMassFluxRev + + else ! non-free surface (SOM) + + freezingMeltingPotential(i) = x2i_im(n,index_x2i_Fioo_q) + + endif + + airLevelHeight(i) = x2i_im(n,index_x2i_Sa_z) + airPotentialTemperature(i) = x2i_im(n,index_x2i_Sa_ptem) + airTemperature(i) = x2i_im(n,index_x2i_Sa_tbot) + airSpecificHumidity(i) = x2i_im(n,index_x2i_Sa_shum) + airDensity(i) = x2i_im(n,index_x2i_Sa_dens) + shortwaveVisibleDirectDown(i) = x2i_im(n,index_x2i_Faxa_swvdr) + shortwaveVisibleDiffuseDown(i) = x2i_im(n,index_x2i_Faxa_swvdf) + shortwaveIRDirectDown(i) = x2i_im(n,index_x2i_Faxa_swndr) + shortwaveIRDiffuseDown(i) = x2i_im(n,index_x2i_Faxa_swndf) + longwaveDown(i) = x2i_im(n,index_x2i_Faxa_lwdn) + rainfallRate(i) = x2i_im(n,index_x2i_Faxa_rain) + snowfallRate(i) = x2i_im(n,index_x2i_Faxa_snow) + uAirVelocity(i) = x2i_im(n,index_x2i_Sa_u) + vAirVelocity(i) = x2i_im(n,index_x2i_Sa_v) + + ! set aerosols, if configured + if (config_use_aerosols) then + if (config_use_modal_aerosols) then + atmosAerosolFlux(1,i) = x2i_im(n,index_x2i_Faxa_bcphodry) & + + x2i_im(n,index_x2i_Faxa_bcphidry) + atmosAerosolFlux(2,i) = x2i_im(n,index_x2i_Faxa_bcphiwet) + ! combine all the dust into one category + atmosAerosolFlux(3,i) = x2i_im(n,index_x2i_Faxa_dstwet1) & + + x2i_im(n,index_x2i_Faxa_dstwet2) & + + x2i_im(n,index_x2i_Faxa_dstwet3) & + + x2i_im(n,index_x2i_Faxa_dstwet4) & + + x2i_im(n,index_x2i_Faxa_dstdry1) & + + x2i_im(n,index_x2i_Faxa_dstdry2) & + + x2i_im(n,index_x2i_Faxa_dstdry3) & + + x2i_im(n,index_x2i_Faxa_dstdry4) + else + atmosAerosolFlux(1,i) = x2i_im(n,index_x2i_Faxa_bcphodry) + atmosAerosolFlux(2,i) = x2i_im(n,index_x2i_Faxa_bcphidry) & + + x2i_im(n,index_x2i_Faxa_bcphiwet) + ! combine all the dust into one category + atmosAerosolFlux(3,i) = x2i_im(n,index_x2i_Faxa_dstwet1) & + + x2i_im(n,index_x2i_Faxa_dstwet2) & + + x2i_im(n,index_x2i_Faxa_dstwet3) & + + x2i_im(n,index_x2i_Faxa_dstwet4) & + + x2i_im(n,index_x2i_Faxa_dstdry1) & + + x2i_im(n,index_x2i_Faxa_dstdry2) & + + x2i_im(n,index_x2i_Faxa_dstdry3) & + + x2i_im(n,index_x2i_Faxa_dstdry4) + endif + endif + + ! import biogeochemistry fields, if configured + if (config_use_column_biogeochemistry) then + oceanAlgaeConc(1,i) = x2i_im(n,index_x2i_So_algae1) + oceanAlgaeConc(2,i) = x2i_im(n,index_x2i_So_algae2) + oceanAlgaeConc(3,i) = x2i_im(n,index_x2i_So_algae3) + oceanDOCConc(1,i) = x2i_im(n,index_x2i_So_doc1) + oceanDOCConc(2,i) = x2i_im(n,index_x2i_So_doc2) + oceanDOCConc(3,i) = 0.0_RKIND + oceanDICConc(1,i) = x2i_im(n,index_x2i_So_dic1) !JW not used, set to 0? + oceanDONConc(1,i) = x2i_im(n,index_x2i_So_don1) + oceanNitrateConc(i) = x2i_im(n,index_x2i_So_no3) + oceanSilicateConc(i) = x2i_im(n,index_x2i_So_sio3) + oceanAmmoniumConc(i) = x2i_im(n,index_x2i_So_nh4) + oceanDMSConc(i) = x2i_im(n,index_x2i_So_dms) + oceanDMSPConc(i) = x2i_im(n,index_x2i_So_dmsp) + oceanHumicsConc(i) = x2i_im(n,index_x2i_So_docr) + oceanParticulateIronConc(1,i) = x2i_im(n,index_x2i_So_fep1) + oceanParticulateIronConc(2,i) = x2i_im(n,index_x2i_So_fep2) + oceanDissolvedIronConc(1,i) = x2i_im(n,index_x2i_So_fed1) + oceanDissolvedIronConc(2,i) = x2i_im(n,index_x2i_So_fed2) + oceanZAerosolConc(1,i) = 0.0_RKIND + oceanZAerosolConc(2,i) = 0.0_RKIND + oceanZAerosolConc(3,i) = 0.0_RKIND + oceanZAerosolConc(4,i) = 0.0_RKIND + oceanZAerosolConc(5,i) = 0.0_RKIND + oceanZAerosolConc(6,i) = 0.0_RKIND + ! set aerosols, if configured + if (config_use_zaerosols) then + if (config_use_modal_aerosols) then + atmosBlackCarbonFlux(1,i) = x2i_im(n,index_x2i_Faxa_bcphodry) & + + x2i_im(n,index_x2i_Faxa_bcphidry) + atmosBlackCarbonFlux(2,i) = x2i_im(n,index_x2i_Faxa_bcphiwet) + ! combine wet and dry dust + atmosDustFlux(1,i) = x2i_im(n,index_x2i_Faxa_dstwet1) & + + x2i_im(n,index_x2i_Faxa_dstdry1) + atmosDustFlux(2,i) = x2i_im(n,index_x2i_Faxa_dstwet2) & + + x2i_im(n,index_x2i_Faxa_dstdry2) + atmosDustFlux(3,i) = x2i_im(n,index_x2i_Faxa_dstwet3) & + + x2i_im(n,index_x2i_Faxa_dstdry3) + atmosDustFlux(4,i) = x2i_im(n,index_x2i_Faxa_dstwet4) & + + x2i_im(n,index_x2i_Faxa_dstdry4) + else + atmosBlackCarbonFlux(1,i) = x2i_im(n,index_x2i_Faxa_bcphodry) + atmosBlackCarbonFlux(2,i) = x2i_im(n,index_x2i_Faxa_bcphidry) & + + x2i_im(n,index_x2i_Faxa_bcphiwet) + ! combine wet and dry dust + atmosDustFlux(1,i) = x2i_im(n,index_x2i_Faxa_dstwet1) & + + x2i_im(n,index_x2i_Faxa_dstdry1) + atmosDustFlux(2,i) = x2i_im(n,index_x2i_Faxa_dstwet2) & + + x2i_im(n,index_x2i_Faxa_dstdry2) + atmosDustFlux(3,i) = x2i_im(n,index_x2i_Faxa_dstwet3) & + + x2i_im(n,index_x2i_Faxa_dstdry3) + atmosDustFlux(4,i) = x2i_im(n,index_x2i_Faxa_dstwet4) & + + x2i_im(n,index_x2i_Faxa_dstdry4) + endif + endif + endif + end do + +!----------------------------------------------------------------------- +! +! unit conversions and any manipulation of coupled fields +! +!----------------------------------------------------------------------- + do i = 1, nCellsSolve + + seaSurfaceTemperature(i) = seaSurfaceTemperature(i) - seaiceFreshWaterFreezingPoint + + if (config_use_column_biogeochemistry) then + ! convert from mmol C/m^3 to mmol N/m^3 + oceanAlgaeConc(1,i) = oceanAlgaeConc(1,i) / carbonToNitrogenRatioAlgae(1) + oceanAlgaeConc(2,i) = oceanAlgaeConc(2,i) / carbonToNitrogenRatioAlgae(2) + oceanAlgaeConc(3,i) = oceanAlgaeConc(3,i) / carbonToNitrogenRatioAlgae(3) + ! convert from mmol Fe/m^3 to umol Fe/m^3 + oceanParticulateIronConc(1,i) = oceanParticulateIronConc(1,i) * 1000._RKIND + oceanParticulateIronConc(2,i) = oceanParticulateIronConc(2,i) * 1000._RKIND + oceanDissolvedIronConc(1,i) = oceanDissolvedIronConc(1,i) * 1000._RKIND + oceanDissolvedIronConc(2,i) = oceanDissolvedIronConc(2,i) * 1000._RKIND + endif + end do + + block_ptr => block_ptr % next + end do + + call mpas_pool_get_subpool(domain % blocklist % structs, 'ocean_coupling', oceanCoupling) + call mpas_pool_get_subpool(domain % blocklist % structs, 'atmos_coupling', atmosCoupling) + + call mpas_pool_get_field(oceanCoupling, 'seaSurfaceTemperature', seaSurfaceTemperatureField) + call mpas_pool_get_field(oceanCoupling, 'seaSurfaceSalinity', seaSurfaceSalinityField) + call mpas_pool_get_field(oceanCoupling, 'seaFreezingTemperature', seaFreezingTemperatureField) + call mpas_pool_get_field(oceanCoupling, 'freezingMeltingPotential', freezingMeltingPotentialField) + call mpas_pool_get_field(oceanCoupling, 'frazilMassAdjust', frazilMassAdjustField) + call mpas_pool_get_field(oceanCoupling, 'uOceanVelocity', uOceanVelocityField) + call mpas_pool_get_field(oceanCoupling, 'vOceanVelocity', vOceanVelocityField) + call mpas_pool_get_field(oceanCoupling, 'seaSurfaceTiltU', seaSurfaceTiltUField) + call mpas_pool_get_field(oceanCoupling, 'seaSurfaceTiltV', seaSurfaceTiltVField) + + call mpas_pool_get_field(atmosCoupling, 'airLevelHeight', airLevelHeightField) + call mpas_pool_get_field(atmosCoupling, 'airPotentialTemperature', airPotentialTemperatureField) + call mpas_pool_get_field(atmosCoupling, 'airTemperature', airTemperatureField) + call mpas_pool_get_field(atmosCoupling, 'airSpecificHumidity', airSpecificHumidityField) + call mpas_pool_get_field(atmosCoupling, 'airDensity', airDensityField) + call mpas_pool_get_field(atmosCoupling, 'shortwaveVisibleDirectDown', shortwaveVisibleDirectDownField) + call mpas_pool_get_field(atmosCoupling, 'shortwaveVisibleDiffuseDown', shortwaveVisibleDiffuseDownField) + call mpas_pool_get_field(atmosCoupling, 'shortwaveIRDirectDown', shortwaveIRDirectDownField) + call mpas_pool_get_field(atmosCoupling, 'shortwaveIRDiffuseDown', shortwaveIRDiffuseDownField) + call mpas_pool_get_field(atmosCoupling, 'longwaveDown', longwaveDownField) + call mpas_pool_get_field(atmosCoupling, 'rainfallRate', rainfallRateField) + call mpas_pool_get_field(atmosCoupling, 'snowfallRate', snowfallRateField) + call mpas_pool_get_field(atmosCoupling, 'uAirVelocity', uAirVelocityField) + call mpas_pool_get_field(atmosCoupling, 'vAirVelocity', vAirVelocityField) + + if (config_use_aerosols) then + call mpas_pool_get_subpool(domain % blocklist % structs, 'aerosols', aerosols) + + call mpas_pool_get_field(aerosols, "atmosAerosolFlux", atmosAerosolFluxField) + endif + + if (config_use_column_biogeochemistry) then + call mpas_pool_get_subpool(domain % blocklist % structs, 'biogeochemistry', biogeochemistry) + + call mpas_pool_get_field(biogeochemistry, 'oceanAlgaeConc', oceanAlgaeConcField) + call mpas_pool_get_field(biogeochemistry, 'oceanDOCConc', oceanDOCConcField) + call mpas_pool_get_field(biogeochemistry, 'oceanDICConc', oceanDICConcField) + call mpas_pool_get_field(biogeochemistry, 'oceanDONConc', oceanDONConcField) + call mpas_pool_get_field(biogeochemistry, 'oceanNitrateConc', oceanNitrateConcField) + call mpas_pool_get_field(biogeochemistry, 'oceanSilicateConc', oceanSilicateConcField) + call mpas_pool_get_field(biogeochemistry, 'oceanAmmoniumConc', oceanAmmoniumConcField) + call mpas_pool_get_field(biogeochemistry, 'oceanDMSConc', oceanDMSConcField) + call mpas_pool_get_field(biogeochemistry, 'oceanDMSPConc', oceanDMSPConcField) + call mpas_pool_get_field(biogeochemistry, 'oceanHumicsConc', oceanHumicsConcField) + call mpas_pool_get_field(biogeochemistry, 'oceanParticulateIronConc', oceanParticulateIronConcField) + call mpas_pool_get_field(biogeochemistry, 'oceanDissolvedIronConc', oceanDissolvedIronConcField) + call mpas_pool_get_field(biogeochemistry, 'oceanZAerosolConc', oceanZAerosolConcField) + if (config_use_zaerosols) then + call mpas_pool_get_field(biogeochemistry, "atmosBlackCarbonFlux", atmosBlackCarbonFluxField) + call mpas_pool_get_field(biogeochemistry, "atmosDustFlux", atmosDustFluxField) + endif + endif + + call mpas_dmpar_exch_halo_field(seaSurfaceTemperatureField) + call mpas_dmpar_exch_halo_field(seaSurfaceSalinityField) + call mpas_dmpar_exch_halo_field(seaFreezingTemperatureField) + call mpas_dmpar_exch_halo_field(freezingMeltingPotentialField) + call mpas_dmpar_exch_halo_field(frazilMassAdjustField) + call mpas_dmpar_exch_halo_field(uOceanVelocityField) + call mpas_dmpar_exch_halo_field(vOceanVelocityField) + call mpas_dmpar_exch_halo_field(seaSurfaceTiltUField) + call mpas_dmpar_exch_halo_field(seaSurfaceTiltVField) + + call mpas_dmpar_exch_halo_field(airLevelHeightField) + call mpas_dmpar_exch_halo_field(airPotentialTemperatureField) + call mpas_dmpar_exch_halo_field(airTemperatureField) + call mpas_dmpar_exch_halo_field(airSpecificHumidityField) + call mpas_dmpar_exch_halo_field(airDensityField) + call mpas_dmpar_exch_halo_field(shortwaveVisibleDirectDownField) + call mpas_dmpar_exch_halo_field(shortwaveVisibleDiffuseDownField) + call mpas_dmpar_exch_halo_field(shortwaveIRDirectDownField) + call mpas_dmpar_exch_halo_field(shortwaveIRDiffuseDownField) + call mpas_dmpar_exch_halo_field(longwaveDownField) + call mpas_dmpar_exch_halo_field(rainfallRateField) + call mpas_dmpar_exch_halo_field(snowfallRateField) + call mpas_dmpar_exch_halo_field(uAirVelocityField) + call mpas_dmpar_exch_halo_field(vAirVelocityField) + + if (config_use_aerosols) then + call mpas_dmpar_exch_halo_field(atmosAerosolFluxField) + endif + + if (config_use_column_biogeochemistry) then + call mpas_dmpar_exch_halo_field(oceanAlgaeConcField) + call mpas_dmpar_exch_halo_field(oceanDOCConcField) + call mpas_dmpar_exch_halo_field(oceanDICConcField) + call mpas_dmpar_exch_halo_field(oceanDONConcField) + call mpas_dmpar_exch_halo_field(oceanNitrateConcField) + call mpas_dmpar_exch_halo_field(oceanSilicateConcField) + call mpas_dmpar_exch_halo_field(oceanAmmoniumConcField) + call mpas_dmpar_exch_halo_field(oceanDMSConcField) + call mpas_dmpar_exch_halo_field(oceanDMSPConcField) + call mpas_dmpar_exch_halo_field(oceanHumicsConcField) + call mpas_dmpar_exch_halo_field(oceanParticulateIronConcField) + call mpas_dmpar_exch_halo_field(oceanDissolvedIronConcField) + call mpas_dmpar_exch_halo_field(oceanZAerosolConcField) + if (config_use_zaerosols) then + call mpas_dmpar_exch_halo_field(atmosBlackCarbonFluxField) + call mpas_dmpar_exch_halo_field(atmosDustFluxField) + endif + endif + +! REVISION HISTORY: +!----------------------------------------------------------------------- +!EOC + + end subroutine ice_import_moab!}}} #endif end module ice_comp_mct From 1de71787a1220551f51a198e4ed035bba5354e8d Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Mon, 16 Jan 2023 15:04:42 -0600 Subject: [PATCH 303/467] zero out r2x fields e3sm zeroes out the AVs that are used in projection we will zero out now r2x fields, to see if ocean import will not give errors --- components/mosart/src/cpl/rof_comp_mct.F90 | 20 +++++++++--- driver-moab/main/prep_ice_mod.F90 | 1 + driver-moab/main/prep_lnd_mod.F90 | 33 ++++++++++++++++++- driver-moab/main/prep_ocn_mod.F90 | 38 +++++++++++++++++++--- 4 files changed, 82 insertions(+), 10 deletions(-) diff --git a/components/mosart/src/cpl/rof_comp_mct.F90 b/components/mosart/src/cpl/rof_comp_mct.F90 index 9cee965b2e80..3d495215a926 100644 --- a/components/mosart/src/cpl/rof_comp_mct.F90 +++ b/components/mosart/src/cpl/rof_comp_mct.F90 @@ -54,7 +54,7 @@ module rof_comp_mct #ifdef HAVE_MOAB use seq_comm_mct, only : mrofid ! id of moab rof app use iso_c_binding - use iMOAB, only: iMOAB_DefineTagStorage + use iMOAB, only: iMOAB_DefineTagStorage, iMOAB_SetDoubleTagStorage #endif ! ! PUBLIC MEMBER FUNCTIONS: @@ -150,6 +150,7 @@ subroutine rof_init_mct( EClock, cdata_r, x2r_r, r2x_r, NLFilename) integer :: ierr, tagtype, numco, tagindex character*32 appname character(CXX) :: tagname ! for fields + integer :: ent_type #endif !--------------------------------------------------------------------------- @@ -313,13 +314,17 @@ subroutine rof_init_mct( EClock, cdata_r, x2r_r, r2x_r, NLFilename) if ( ierr == 1 ) then call shr_sys_abort( sub//' ERROR: cannot define tags fro seq_flds_r2x_fields in moab' ) end if - ! also load initial data to moab tags - call rof_export_moab() + ! set those fields to 0 in moab + r2x_rm = 0._r8 + ent_type = 0 ! rof is point cloud on this side + ierr = iMOAB_SetDoubleTagStorage ( mrofid, tagname, totalmbls , ent_type, r2x_rm(1,1)) + if (ierr > 0 ) & + call shr_sys_abort( sub//' Error: fail to set to 0 seq_flds_x2r_fields ') ! allocate now the import from coupler array nrecv = mct_avect_nRattr(x2r_r) totalmbls_r = mblsize * nrecv ! size of the double array allocate (x2r_rm(lsize, nrecv) ) - ! define tags according to the seq_flds_r2x_fields + ! define tags according to the seq_flds_x2r_fields tagtype = 1 ! dense, double numco = 1 ! one value per cell / entity tagname = trim(seq_flds_x2r_fields)//C_NULL_CHAR @@ -327,6 +332,13 @@ subroutine rof_init_mct( EClock, cdata_r, x2r_r, r2x_r, NLFilename) if ( ierr == 1 ) then call shr_sys_abort( sub//' ERROR: cannot define tags for seq_flds_x2r_fields in moab' ) end if + ! set those fields to 0 in moab + x2r_rm = 0._r8 + ierr = iMOAB_SetDoubleTagStorage ( mrofid, tagname, totalmbls_r , ent_type, x2r_rm(1,1)) + if (ierr > 0 ) & + call shr_sys_abort( sub//' Error: fail to set to 0 seq_flds_x2r_fields ') + ! also load initial data to moab tags, fill with some initial data + call rof_export_moab() ! endif HAVE_MOAB #endif diff --git a/driver-moab/main/prep_ice_mod.F90 b/driver-moab/main/prep_ice_mod.F90 index 016e24206eef..995eaedc448a 100644 --- a/driver-moab/main/prep_ice_mod.F90 +++ b/driver-moab/main/prep_ice_mod.F90 @@ -635,6 +635,7 @@ subroutine prep_ice_mrg_moab(infodata, rof_c2_ice) allocate(x2i_im(lsize,niflds)) allocate(a2x_im(lsize,naflds)) allocate(r2x_im(lsize,nrflds)) + r2x_im = 0._r8 ! should we zero out all of them ? allocate(mrgstr(niflds)) index_a2x_Faxa_snowc = mct_aVect_indexRA(a2x_i,'Faxa_snowc') diff --git a/driver-moab/main/prep_lnd_mod.F90 b/driver-moab/main/prep_lnd_mod.F90 index 516b18e7eec0..040a6d328589 100644 --- a/driver-moab/main/prep_lnd_mod.F90 +++ b/driver-moab/main/prep_lnd_mod.F90 @@ -36,7 +36,7 @@ module prep_lnd_mod #ifdef HAVE_MOAB use iMOAB , only: iMOAB_ComputeCommGraph, iMOAB_ComputeMeshIntersectionOnSphere, & iMOAB_ComputeScalarProjectionWeights, iMOAB_DefineTagStorage, iMOAB_RegisterApplication, & - iMOAB_WriteMesh + iMOAB_WriteMesh, iMOAB_GetMeshInfo, iMOAB_SetDoubleTagStorage #endif implicit none save @@ -151,6 +151,13 @@ subroutine prep_lnd_init(infodata, atm_c2_lnd, rof_c2_lnd, glc_c2_lnd, iac_c2_ln integer :: tagtype, numco, tagindex character(CXX) :: tagName + integer nvert(3), nvise(3), nbl(3), nsurf(3), nvisBC(3) ! for moab info + integer mlsize ! moab land size + integer nrflds ! number of rof fields projected on land + integer arrsize ! for setting the r2x fields on land to 0 + integer ent_type ! for setting tags + real (kind=r8) , allocatable :: tmparray (:) ! used to set the r2x fields to 0 + #endif character(*), parameter :: subname = '(prep_lnd_init)' character(*), parameter :: F00 = "('"//subname//" : ', 4A )" @@ -252,6 +259,7 @@ subroutine prep_lnd_init(infodata, atm_c2_lnd, rof_c2_lnd, glc_c2_lnd, iac_c2_ln wgtIdef = 'scalar'//C_NULL_CHAR mapper_Fr2l%weight_identifier = wgtIdef mapper_Fr2l%mbname = 'mapper_Fr2l' + ! because we will project fields from rof to lnd grid, we need to define ! the r2x fields to lnd grid on coupler side @@ -263,6 +271,29 @@ subroutine prep_lnd_init(infodata, atm_c2_lnd, rof_c2_lnd, glc_c2_lnd, iac_c2_ln write(logunit,*) subname,' error in defining tags for seq_flds_r2x_fields on lnd cpl' call shr_sys_abort(subname//' ERROR in defining tags for seq_flds_r2x_fields on lnd cpl') endif + + ! find out the number of local elements in moab mesh land instance on coupler + ierr = iMOAB_GetMeshInfo ( mblxid, nvert, nvise, nbl, nsurf, nvisBC ) + if (ierr .ne. 0) then + write(logunit,*) subname,' cant get size of land mesh' + call shr_sys_abort(subname//' ERROR in getting size of land mesh') + endif + ! land is now cell mesh on coupler side + mlsize = nvise(1) + ent_type = 1 ! cell + ! set to 0 all fields that are projected from river + nrflds = mct_aVect_nRattr(r2x_lx(1)) ! these are the numbers of fields in seq_flds_r2x_fields + arrsize = nrflds*mlsize + allocate (tmparray(arrsize)) ! mlsize is the size of local land + ! do we need to zero out others or just river ? + tmparray = 0._r8 + ierr = iMOAB_SetDoubleTagStorage(mblxid, tagname, arrsize , ent_type, tmparray(1)) + if (ierr .ne. 0) then + write(logunit,*) subname,' cant zero out r2x tags on land' + call shr_sys_abort(subname//' cant zero out r2x tags on land') + endif + deallocate (tmparray) + volumetric = 0 ! can be 1 only for FV->DGLL or FV->CGLL; dm1 = "fv"//C_NULL_CHAR diff --git a/driver-moab/main/prep_ocn_mod.F90 b/driver-moab/main/prep_ocn_mod.F90 index e0ed134eb14c..fffbcb7a5511 100644 --- a/driver-moab/main/prep_ocn_mod.F90 +++ b/driver-moab/main/prep_ocn_mod.F90 @@ -171,7 +171,7 @@ subroutine prep_ocn_init(infodata, atm_c2_ocn, atm_c2_ice, ice_c2_ocn, rof_c2_oc use iMOAB, only: iMOAB_ComputeMeshIntersectionOnSphere, iMOAB_RegisterApplication, & iMOAB_WriteMesh, iMOAB_DefineTagStorage, iMOAB_ComputeCommGraph, iMOAB_ComputeScalarProjectionWeights, & - iMOAB_MigrateMapMesh, iMOAB_WriteLocalMesh + iMOAB_MigrateMapMesh, iMOAB_WriteLocalMesh, iMOAB_GetMeshInfo, iMOAB_SetDoubleTagStorage !--------------------------------------------------------------- ! Description ! Initialize module attribute vectors and all other non-mapping @@ -229,7 +229,13 @@ subroutine prep_ocn_init(infodata, atm_c2_ocn, atm_c2_ice, ice_c2_ocn, rof_c2_oc integer :: context_id, direction character*32 :: prefix_output ! for writing a coverage file for debugging integer :: rank_on_cpl ! just for debugging - +! these are just to zero out r2x fields on ocean + integer nvert(3), nvise(3), nbl(3), nsurf(3), nvisBC(3) ! for moab info + integer mlsize ! moab land size + integer nrflds ! number of rof fields projected on land + integer arrsize ! for setting the r2x fields on land to 0 + integer ent_type ! for setting tags + real (kind=r8) , allocatable :: tmparray (:) ! used to set the r2x fields to 0 !--------------------------------------------------------------- @@ -637,12 +643,34 @@ subroutine prep_ocn_init(infodata, atm_c2_ocn, atm_c2_ice, ice_c2_ocn, rof_c2_oc write(logunit,*) subname,' error in defining ' // trim(seq_flds_r2x_fields) // ' tags on coupler side in MOAB, for ocean app' call shr_sys_abort(subname//' ERROR in defining MOAB tags ') endif - endif - - + endif if (iamroot_CPLID) then write(logunit,*) subname,' created moab tags for seq_flds_r2x_fields ' endif + +! find out the number of local elements in moab mesh land instance on coupler + ierr = iMOAB_GetMeshInfo ( mboxid, nvert, nvise, nbl, nsurf, nvisBC ) + if (ierr .ne. 0) then + write(logunit,*) subname,' cant get size of ocn mesh' + call shr_sys_abort(subname//' ERROR in getting size of ocn mesh') + endif + ! ocn is cell mesh on coupler side + mlsize = nvise(1) + ent_type = 1 ! cell + ! zero out the values just for r2x fields, on ocean instance + nrflds = mct_aVect_nRattr(r2x_ox(1)) ! this is the size of r2x_fields + arrsize = nrflds*mlsize + allocate (tmparray(arrsize)) ! mlsize is the size of local land + ! do we need to zero out others or just river ? + tmparray = 0._r8 + ierr = iMOAB_SetDoubleTagStorage(mboxid, tagname, arrsize , ent_type, tmparray(1)) + if (ierr .ne. 0) then + write(logunit,*) subname,' cant zero out r2x tags on ocn' + call shr_sys_abort(subname//' cant zero out r2x tags on ocn') + endif + deallocate (tmparray) + + ! now we have to populate the map with the right moab attibutes, so that it does the right projection #ifdef MOABDEBUG if (mbrxoid.ge.0) then ! we are on coupler PEs From 4d6bb7d697fb226ce1b07be1859d632a7139b2f5 Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Mon, 16 Jan 2023 17:57:34 -0600 Subject: [PATCH 304/467] zero out the moab tags import from moab is called very early, even during init, when no values have been set yet --- components/mpas-ocean/driver/ocn_comp_mct.F | 49 ++++++++++++++------- driver-moab/main/prep_ocn_mod.F90 | 1 + 2 files changed, 35 insertions(+), 15 deletions(-) diff --git a/components/mpas-ocean/driver/ocn_comp_mct.F b/components/mpas-ocean/driver/ocn_comp_mct.F index 6aa4f78e1669..e3ffa94c5b77 100644 --- a/components/mpas-ocean/driver/ocn_comp_mct.F +++ b/components/mpas-ocean/driver/ocn_comp_mct.F @@ -42,7 +42,7 @@ module ocn_comp_mct use mpas_moabmesh use seq_comm_mct, only: MPOID use seq_comm_mct, only: num_moab_exports - use iMOAB, only: iMOAB_DefineTagStorage + use iMOAB, only: iMOAB_DefineTagStorage, iMOAB_SetDoubleTagStorage #endif use iso_c_binding, only : c_char, c_loc, c_ptr, c_int use mpas_c_interfacing, only : mpas_f_to_c_string, mpas_c_to_f_string @@ -228,7 +228,7 @@ subroutine ocn_init_mct( EClock, cdata_o, x2o_o, o2x_o, NLFilename )!{{{ #ifdef HAVE_MOAB character*100 outfile, wopts - integer :: ierrmb, numco, tagtype, tagindex + integer :: ierrmb, numco, tagtype, tagindex, ent_type character(CXX) :: tagname #endif interface @@ -639,12 +639,10 @@ end subroutine xml_stream_get_attributes #ifdef HAVE_MOAB ! initialize moab tag fields array mblsize = lsize - totalmbls = mblsize * nsend ! size of the double array + totalmbls = mblsize * nsend ! size of the double array for exporting to coupler allocate (o2x_om(lsize, nsend) ) - - totalmbls_r = mblsize * nrecv ! size of the double array for importing - allocate (x2o_om(lsize, nrecv) ) - ! define tags according to the seq_flds_o2x_fields + o2x_om = 0._r8 + ! define tags according to the seq_flds_o2x_fields tagtype = 1 ! dense, double numco = 1 ! one value per cell / entity tagname = trim(seq_flds_o2x_fields)//C_NULL_CHAR @@ -652,11 +650,32 @@ end subroutine xml_stream_get_attributes if ( ierrmb == 1 ) then call mpas_log_write('cannot define tags for MOAB o2x fields ' // trim(seq_flds_o2x_fields), MPAS_LOG_ERR) endif + ! set all tags to 0 in one method + ent_type = 1! cells + ierr = iMOAB_SetDoubleTagStorage ( MPOID, tagname, totalmbls , ent_type, o2x_om(1, 1) ) + if ( ierr /= 0 ) then + write(ocnLogUnit,*) 'Fail to set MOAB fields ' + endif + + totalmbls_r = mblsize * nrecv ! size of the double array for importing + allocate (x2o_om(lsize, nrecv) ) + x2o_om = 0._r8 + tagname = trim(seq_flds_x2o_fields)//C_NULL_CHAR ierrmb = iMOAB_DefineTagStorage(MPOID, tagname, tagtype, numco, tagindex ) if ( ierrmb == 1 ) then call mpas_log_write('cannot define tags for MOAB x2o fields ' // trim(seq_flds_x2o_fields), MPAS_LOG_ERR) endif + ! set all tags to 0 in one method + ierr = iMOAB_SetDoubleTagStorage ( MPOID, tagname, totalmbls_r , ent_type, x2o_om(1, 1) ) + if ( ierr /= 0 ) then + write(ocnLogUnit,*) 'Fail to set MOAB fields ' + endif + + + ent_type = 1 ! cells + + #endif !----------------------------------------------------------------------- ! @@ -850,10 +869,10 @@ end subroutine xml_stream_get_attributes call mpas_get_timeInterval(timeStep, dt=dt) #ifdef HAVE_MOAB - ! call ocn_import_moab(errorCode) - ! if (errorCode /= 0) then - ! call mpas_log_write('Error in ocn_import_moab', MPAS_LOG_CRIT) - ! endif + call ocn_import_moab(errorCode) + if (errorCode /= 0) then + call mpas_log_write('Error in ocn_import_moab', MPAS_LOG_CRIT) + endif #endif call ocn_import_mct(x2o_o, errorCode) if (errorCode /= 0) then @@ -969,10 +988,10 @@ subroutine ocn_run_mct( EClock, cdata_o, x2o_o, o2x_o)!{{{ ! Import state from moab coupler #ifdef HAVE_MOAB - ! call ocn_import_moab(ierr) - ! if (ierr /= 0) then - ! call mpas_log_write('Error in ocn_import_moab', MPAS_LOG_CRIT) - ! endif + call ocn_import_moab(ierr) + if (ierr /= 0) then + call mpas_log_write('Error in ocn_import_moab', MPAS_LOG_CRIT) + endif #endif ! Import state from coupler call ocn_import_mct(x2o_o, ierr) diff --git a/driver-moab/main/prep_ocn_mod.F90 b/driver-moab/main/prep_ocn_mod.F90 index fffbcb7a5511..ab037146ffec 100644 --- a/driver-moab/main/prep_ocn_mod.F90 +++ b/driver-moab/main/prep_ocn_mod.F90 @@ -1116,6 +1116,7 @@ subroutine prep_ocn_mrg_moab(infodata, xao_ox) allocate(a2x_om (lsize, naflds)) allocate(i2x_om (lsize, niflds)) allocate(r2x_om (lsize, nrflds)) + r2x_om = 0._r8 ! should we zero out all of them ? allocate(xao_om (lsize, nxflds)) ! allocate fractions too ! use the fraclist fraclist_o = 'afrac:ifrac:ofrac:ifrad:ofrad' From 4c530a17c05d92255a85df3513d39f18370861ae Mon Sep 17 00:00:00 2001 From: Robert Jacob Date: Mon, 16 Jan 2023 20:38:35 -0600 Subject: [PATCH 305/467] Make the call to import_moab in seaice Make the call to import_moab in seaice.runs. --- components/mpas-seaice/driver/ice_comp_mct.F | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/components/mpas-seaice/driver/ice_comp_mct.F b/components/mpas-seaice/driver/ice_comp_mct.F index bd21ac4e1699..008c772924c3 100644 --- a/components/mpas-seaice/driver/ice_comp_mct.F +++ b/components/mpas-seaice/driver/ice_comp_mct.F @@ -798,7 +798,7 @@ end subroutine xml_stream_get_attributes ! get intial state from driver ! !----------------------------------------------------------------------- - + call ice_import_moab() call ice_import_mct(x2i_i, errorCode) if (errorCode /= 0) then call mpas_log_write('Error in ice_import_mct', MPAS_LOG_CRIT) @@ -1109,6 +1109,7 @@ subroutine ice_run_mct( EClock, cdata_i, x2i_i, i2x_i)!{{{ call seaice_column_reinitialize_fluxes(domain) ! Import state from coupler + call ice_import_moab() call ice_import_mct(x2i_i, ierr) ! Post coupling calls From 4e4fe8df8e71230e54aef2e49b24fdedf4f9d7d8 Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Mon, 16 Jan 2023 22:21:51 -0600 Subject: [PATCH 306/467] add seq_comm_compare_mb_mct to seq_comm module it is used for debugging, to compare fields from moab and mct, one by one --- driver-moab/shr/seq_comm_mct.F90 | 72 ++++++++++++++++++++++++++++++++ 1 file changed, 72 insertions(+) diff --git a/driver-moab/shr/seq_comm_mct.F90 b/driver-moab/shr/seq_comm_mct.F90 index ea480b958e0f..db63f60a34bd 100644 --- a/driver-moab/shr/seq_comm_mct.F90 +++ b/driver-moab/shr/seq_comm_mct.F90 @@ -57,6 +57,8 @@ module seq_comm_mct public seq_comm_printcomms public seq_comm_get_ncomps + public seq_comm_compare_mb_mct + !-------------------------------------------------------------------------- ! Public data !-------------------------------------------------------------------------- @@ -1489,4 +1491,74 @@ subroutine seq_comm_mkname(oname,str1,num) end subroutine seq_comm_mkname !--------------------------------------------------------- + + subroutine seq_comm_compare_mb_mct( modelstr, mpicom, attrVect, mct_field, appId, tagname, ent_type, difference) + + use shr_mpi_mod, only: shr_mpi_sum, shr_mpi_commrank + use shr_kind_mod, only: CXX => shr_kind_CXX + use shr_kind_mod , only : r8 => shr_kind_r8 + use mct_mod + use iMOAB, only : iMOAB_DefineTagStorage, iMOAB_GetDoubleTagStorage, iMOAB_GetMeshInfo + + use iso_c_binding + character(*), intent (in) :: modelstr + integer, intent(in) :: mpicom + integer , intent(in) :: appId, ent_type + type(mct_aVect) , intent(in) :: attrVect + character(*) , intent(in) :: mct_field + character(*) , intent(in) :: tagname + + real(r8) , intent(out) :: difference + + real(r8) :: differenceg ! global, reduced diff + integer :: mbSize, nloc, index_avfield, rank2 + + ! moab + integer :: tagtype, numco, tagindex, ierr + character(CXX) :: tagname_mct + + real(r8) , allocatable :: values(:), mct_values(:) + integer nvert(3), nvise(3), nbl(3), nsurf(3), nvisBC(3) + logical :: iamroot + + + character(*),parameter :: subName = '(seq_comm_compare_mb_mct) ' + + nloc = mct_avect_lsize(attrVect) + allocate(mct_values(nloc)) + + index_avfield = mct_aVect_indexRA(attrVect,trim(mct_field)) + mct_values(:) = attrVect%rAttr(index_avfield,:) + + ! now get moab tag values; first get info + ierr = iMOAB_GetMeshInfo ( appId, nvert, nvise, nbl, nsurf, nvisBC ); + if (ierr > 0 ) & + call shr_sys_abort(subname//'Error: fail to get mesh info') + if (ent_type .eq. 0) then + mbSize = nvert(1) + else if (ent_type .eq. 1) then + mbSize = nvise(1) + endif + allocate(values(mbSize)) + + ierr = iMOAB_GetDoubleTagStorage ( appId, tagname, mbSize , ent_type, values) + if (ierr > 0 ) & + call shr_sys_abort(subname//'Error: fail to get moab tag values') + + values = mct_values - values + + difference = dot_product(values, values) + call shr_mpi_sum(difference,differenceg,mpicom,subname) + difference = sqrt(differenceg) + call shr_mpi_commrank( mpicom, rank2 ) + if ( rank2 .eq. 0 ) then + print * , trim(modelStr), subname, ' , difference on tag ', trim(tagname), ' = ', difference + !call shr_sys_abort(subname//'differences between mct and moab values') + endif + deallocate(values) + deallocate(mct_values) + + end subroutine seq_comm_compare_mb_mct + + end module seq_comm_mct From 27921a734ebf1f4c505c16c75e268b9e3eec1945 Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Mon, 16 Jan 2023 22:27:31 -0600 Subject: [PATCH 307/467] activate ice import too also, use seq_comm_compare_mb_mct to check all imports --- components/eam/src/cpl/atm_comp_mct.F90 | 92 ++-------------- components/elm/src/cpl/lnd_comp_mct.F90 | 84 ++------------- components/mosart/src/cpl/rof_comp_mct.F90 | 105 +++++-------------- components/mpas-ocean/driver/ocn_comp_mct.F | 56 ++++++++++ components/mpas-seaice/driver/ice_comp_mct.F | 62 ++++++++++- 5 files changed, 163 insertions(+), 236 deletions(-) diff --git a/components/eam/src/cpl/atm_comp_mct.F90 b/components/eam/src/cpl/atm_comp_mct.F90 index f3cb757544db..d76d2e4ec451 100644 --- a/components/eam/src/cpl/atm_comp_mct.F90 +++ b/components/eam/src/cpl/atm_comp_mct.F90 @@ -63,10 +63,11 @@ module atm_comp_mct use seq_comm_mct , only: mphaid ! atm physics grid id in MOAB, on atm pes use iso_c_binding use seq_comm_mct, only : num_moab_exports + use seq_comm_mct, only: seq_comm_compare_mb_mct #endif -#ifdef MOABDEBUG - !use seq_comm_mct, only: compare_to_moab_tag -#endif + + + ! ! !PUBLIC TYPES: implicit none @@ -188,7 +189,7 @@ subroutine atm_init_mct( EClock, cdata_a, x2a_a, a2x_a, NLFilename ) type(mct_list) :: temp_list integer :: size_list, index_list, ent_type type(mct_string) :: mctOStr ! - character(CXX) ::tagname, mct_field + character(CXX) ::tagname, mct_field, modelStr #endif !----------------------------------------------------------------------- @@ -453,11 +454,12 @@ subroutine atm_init_mct( EClock, cdata_a, x2a_a, a2x_a, NLFilename ) size_list=mct_list_nitem (temp_list) ent_type = 0 ! entity type is vertex for phys atm if (rank2 .eq. 0) print *, num_moab_exports, trim(seq_flds_x2a_fields), ' atm import check' + modelStr='atminit' 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 compare_to_moab_tag(mpicom_atm_moab, x2a_a, mct_field, mphaid, tagname, ent_type, difference) + call seq_comm_compare_mb_mct(modelStr, mpicom_atm_moab, x2a_a, mct_field, mphaid, tagname, ent_type, difference) enddo call mct_list_clean(temp_list) @@ -574,7 +576,7 @@ subroutine atm_run_mct( EClock, cdata_a, x2a_a, a2x_a) type(mct_list) :: temp_list integer :: size_list, index_list, ent_type type(mct_string) :: mctOStr ! - character(CXX) ::tagname, mct_field + character(CXX) ::tagname, mct_field, modelStr #endif #if (defined _MEMTRACE) @@ -608,21 +610,20 @@ subroutine atm_run_mct( EClock, cdata_a, x2a_a, a2x_a) call t_startf ('CAM_import') #ifdef MOABDEBUG - !compare_to_moab_tag(mpicom_atm_moab, attrVect, field, imoabApp, tag_name, ent_type, difference) !x2o_o => component_get_x2c_cx(ocn(1)) ! loop over all fields in seq_flds_a2x_fields call mct_list_init(temp_list ,seq_flds_x2a_fields) size_list=mct_list_nitem (temp_list) ent_type = 0 ! entity type is vertex for phys atm if (rank2 .eq. 0) print *, num_moab_exports, trim(seq_flds_x2a_fields) + modelStr ='atm' 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 compare_to_moab_tag(mpicom_atm_moab, x2a_a, mct_field, mphaid, tagname, ent_type, difference) + call seq_comm_compare_mb_mct(modelStr, mpicom_atm_moab, x2a_a, mct_field, mphaid, tagname, ent_type, difference) enddo call mct_list_clean(temp_list) - #endif #ifdef HAVE_MOAB @@ -1623,78 +1624,5 @@ end subroutine atm_import_moab #endif -#ifdef MOABDEBUG - ! assumes everything is on component side, to compare before imports - subroutine compare_to_moab_tag(mpicom, attrVect, mct_field, appId, tagname, ent_type, difference) - - use shr_mpi_mod, only: shr_mpi_sum, shr_mpi_commrank - use shr_kind_mod, only: CXX => shr_kind_CXX - use seq_comm_mct , only : CPLID, seq_comm_iamroot - use seq_comm_mct, only: seq_comm_setptrs - use iMOAB, only : iMOAB_DefineTagStorage, iMOAB_GetDoubleTagStorage, & - iMOAB_SetDoubleTagStorageWithGid, iMOAB_GetMeshInfo - - use iso_c_binding - - integer, intent(in) :: mpicom - integer , intent(in) :: appId, ent_type - type(mct_aVect) , intent(in) :: attrVect - character(*) , intent(in) :: mct_field - character(*) , intent(in) :: tagname - - real(r8) , intent(out) :: difference - - real(r8) :: differenceg ! global, reduced diff - integer :: mbSize, nloc, index_avfield, rank2 - - ! moab - integer :: tagtype, numco, tagindex, ierr - character(CXX) :: tagname_mct - - real(r8) , allocatable :: values(:), mct_values(:) - integer nvert(3), nvise(3), nbl(3), nsurf(3), nvisBC(3) - logical :: iamroot - - - character(*),parameter :: subName = '(compare_to_moab_tag) ' - - nloc = mct_avect_lsize(attrVect) - allocate(mct_values(nloc)) - - index_avfield = mct_aVect_indexRA(attrVect,trim(mct_field)) - mct_values(:) = attrVect%rAttr(index_avfield,:) - - ! now get moab tag values; first get info - ierr = iMOAB_GetMeshInfo ( appId, nvert, nvise, nbl, nsurf, nvisBC ); - if (ierr > 0 ) & - call shr_sys_abort(subname//'Error: fail to get mesh info') - if (ent_type .eq. 0) then - mbSize = nvert(1) - else if (ent_type .eq. 1) then - mbSize = nvise(1) - endif - allocate(values(mbSize)) - - ierr = iMOAB_GetDoubleTagStorage ( appId, tagname, mbSize , ent_type, values) - if (ierr > 0 ) & - call shr_sys_abort(subname//'Error: fail to get moab tag values') - - values = mct_values - values - - difference = dot_product(values, values) - call shr_mpi_sum(difference,differenceg,mpicom,subname) - difference = sqrt(differenceg) - call shr_mpi_commrank( mpicom, rank2 ) - if ( rank2 .eq. 0 ) then - print * , subname, ' , difference on tag ', trim(tagname), ' = ', difference - !call shr_sys_abort(subname//'differences between mct and moab values') - endif - deallocate(values) - deallocate(mct_values) - - end subroutine compare_to_moab_tag - ! #endif for MOABDEBUG -#endif - end module atm_comp_mct diff --git a/components/elm/src/cpl/lnd_comp_mct.F90 b/components/elm/src/cpl/lnd_comp_mct.F90 index e51f148fc48a..4d9ebc8cc45c 100644 --- a/components/elm/src/cpl/lnd_comp_mct.F90 +++ b/components/elm/src/cpl/lnd_comp_mct.F90 @@ -19,6 +19,10 @@ module lnd_comp_mct use seq_comm_mct, only: mlnid! id of moab land app use seq_comm_mct, only: num_moab_exports use seq_flds_mod , only : seq_flds_x2l_fields, seq_flds_l2x_fields + +#ifdef MOABDEBUG + use seq_comm_mct , only: seq_comm_compare_mb_mct +#endif #endif ! ! !public member functions: @@ -500,7 +504,7 @@ subroutine lnd_run_mct(EClock, cdata_l, x2l_l, l2x_l) type(mct_list) :: temp_list integer :: size_list, index_list, ent_type type(mct_string) :: mctOStr ! - character(100) ::tagname, mct_field + character(100) ::tagname, mct_field, modelStr #endif !--------------------------------------------------------------------------- @@ -563,7 +567,9 @@ subroutine lnd_run_mct(EClock, cdata_l, x2l_l, l2x_l) call mct_list_get(mctOStr,index_list,temp_list) mct_field = mct_string_toChar(mctOStr) tagname= trim(mct_field)//C_NULL_CHAR - call compare_to_moab_tag_lnd(mpicom_lnd_moab, x2l_l, mct_field, mlnid, tagname, ent_type, difference) + modelStr = 'lnd' + !call compare_to_moab_tag_lnd(mpicom_lnd_moab, x2l_l, mct_field, mlnid, tagname, ent_type, difference) + call seq_comm_compare_mb_mct(modelStr, mpicom_lnd_moab, x2l_l, mct_field, mlnid, tagname, ent_type, difference) enddo call mct_list_clean(temp_list) @@ -2583,80 +2589,6 @@ subroutine lnd_import_moab( bounds, atm2lnd_vars, glc2lnd_vars) end subroutine lnd_import_moab - -#ifdef MOABDEBUG - ! assumes everything is on component side, to compare before imports - subroutine compare_to_moab_tag_lnd(mpicom, attrVect, mct_field, appId, tagname, ent_type, difference) - - use shr_mpi_mod, only: shr_mpi_sum, shr_mpi_commrank - use shr_kind_mod, only: CXX => shr_kind_CXX - use seq_comm_mct , only : CPLID, seq_comm_iamroot - use seq_comm_mct, only: seq_comm_setptrs - use iMOAB, only : iMOAB_DefineTagStorage, iMOAB_GetDoubleTagStorage, & - iMOAB_SetDoubleTagStorageWithGid, iMOAB_GetMeshInfo - - use iso_c_binding - - integer, intent(in) :: mpicom - integer , intent(in) :: appId, ent_type - type(mct_aVect) , intent(in) :: attrVect - character(*) , intent(in) :: mct_field - character(*) , intent(in) :: tagname - - real(r8) , intent(out) :: difference - - real(r8) :: differenceg ! global, reduced diff - integer :: mbSize, nloc, index_avfield, rank2 - - ! moab - integer :: tagtype, numco, tagindex, ierr - character(CXX) :: tagname_mct - - real(r8) , allocatable :: values(:), mct_values(:) - integer nvert(3), nvise(3), nbl(3), nsurf(3), nvisBC(3) - logical :: iamroot - - - character(*),parameter :: subName = '(compare_to_moab_tag_lnd) ' - - nloc = mct_avect_lsize(attrVect) - allocate(mct_values(nloc)) - - index_avfield = mct_aVect_indexRA(attrVect,trim(mct_field)) - mct_values(:) = attrVect%rAttr(index_avfield,:) - - ! now get moab tag values; first get info - ierr = iMOAB_GetMeshInfo ( appId, nvert, nvise, nbl, nsurf, nvisBC ); - if (ierr > 0 ) & - call shr_sys_abort(subname//'Error: fail to get mesh info') - if (ent_type .eq. 0) then - mbSize = nvert(1) - else if (ent_type .eq. 1) then - mbSize = nvise(1) - endif - allocate(values(mbSize)) - - ierr = iMOAB_GetDoubleTagStorage ( appId, tagname, mbSize , ent_type, values) - if (ierr > 0 ) & - call shr_sys_abort(subname//'Error: fail to get moab tag values') - - values = mct_values - values - - difference = dot_product(values, values) - call shr_mpi_sum(difference,differenceg,mpicom,subname) - difference = sqrt(differenceg) - call shr_mpi_commrank( mpicom, rank2 ) - if ( rank2 .eq. 0 ) then - print * , subname, ' , difference on tag ', trim(tagname), ' = ', difference - !call shr_sys_abort(subname//'differences between mct and moab values') - endif - deallocate(values) - deallocate(mct_values) - - end subroutine compare_to_moab_tag_lnd - ! #endif for MOABDEBUG -#endif - ! endif for ifdef HAVE_MOAB #endif diff --git a/components/mosart/src/cpl/rof_comp_mct.F90 b/components/mosart/src/cpl/rof_comp_mct.F90 index 3d495215a926..cc41cf2d11ca 100644 --- a/components/mosart/src/cpl/rof_comp_mct.F90 +++ b/components/mosart/src/cpl/rof_comp_mct.F90 @@ -53,6 +53,8 @@ module rof_comp_mct use ESMF #ifdef HAVE_MOAB use seq_comm_mct, only : mrofid ! id of moab rof app + use seq_comm_mct, only : seq_comm_compare_mb_mct ! for debugging + use seq_comm_mct, only: num_moab_exports use iso_c_binding use iMOAB, only: iMOAB_DefineTagStorage, iMOAB_SetDoubleTagStorage #endif @@ -400,6 +402,14 @@ subroutine rof_run_mct( EClock, cdata_r, x2r_r, r2x_r) character(len=32), parameter :: sub = "rof_run_mct" !------------------------------------------------------- +#ifdef MOABDEBUG + real(r8) :: difference + type(mct_list) :: temp_list + integer :: size_list, index_list, ent_type + type(mct_string) :: mctOStr ! + character(CXX) ::tagname, mct_field, modelStr +#endif + #if (defined _MEMTRACE) if(masterproc) then lbnum=1 @@ -420,6 +430,24 @@ subroutine rof_run_mct( EClock, cdata_r, x2r_r, r2x_r) ! Map MCT to land data type (output is totrunin, subrunin) call t_startf ('lc_rof_import') #ifdef HAVE_MOAB + +#ifdef MOABDEBUG + ! loop over all fields in seq_flds_x2r_fields + call mct_list_init(temp_list ,seq_flds_x2r_fields) + size_list=mct_list_nitem (temp_list) + ent_type = 0 ! entity type is vertex for phys atm + if (masterproc) print *, num_moab_exports, trim(seq_flds_x2r_fields), ' rof import check' + modelStr='rof' + 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 seq_comm_compare_mb_mct(modelStr, mpicom_rof, x2r_r, mct_field, mrofid, tagname, ent_type, difference) + enddo + call mct_list_clean(temp_list) + +#endif + call rof_import_moab( ) #endif call rof_import_mct( x2r_r) @@ -891,7 +919,7 @@ subroutine init_rof_moab() call shr_sys_abort( sub//' Error: fail to resolve shared entities') !there are no shared entities, but we will set a special partition tag, in order to see the - ! partitions ; it will be visible with a Pseudocolor plot in VisIt + ! partitions ; it will be visible with a Pseudocolor plot in VisItinit_rof_moab tagname='partition'//C_NULL_CHAR ierr = iMOAB_DefineTagStorage(mrofid, tagname, tagtype, numco, tagindex ) if (ierr > 0 ) & @@ -963,7 +991,6 @@ subroutine rof_export_moab() ! ! ARGUMENTS: use seq_comm_mct, only: mrofid ! id of moab rof app - use seq_comm_mct, only: num_moab_exports use iMOAB, only : iMOAB_SetDoubleTagStorage, iMOAB_WriteMesh implicit none @@ -1170,80 +1197,6 @@ subroutine rof_import_moab( ) end subroutine rof_import_moab -#ifdef MOABDEBUG - ! assumes everything is on component side, to compare before imports - subroutine compare_to_moab_tag_rof(mpicom, attrVect, mct_field, appId, tagname, ent_type, difference) - - use shr_mpi_mod, only: shr_mpi_sum, shr_mpi_commrank - use shr_kind_mod, only: CXX => shr_kind_CXX - use seq_comm_mct , only : CPLID, seq_comm_iamroot - use seq_comm_mct, only: seq_comm_setptrs - use iMOAB, only : iMOAB_DefineTagStorage, iMOAB_GetDoubleTagStorage, & - iMOAB_SetDoubleTagStorageWithGid, iMOAB_GetMeshInfo - - use iso_c_binding - - integer, intent(in) :: mpicom - integer , intent(in) :: appId, ent_type - type(mct_aVect) , intent(in) :: attrVect - character(*) , intent(in) :: mct_field - character(*) , intent(in) :: tagname - - real(r8) , intent(out) :: difference - - real(r8) :: differenceg ! global, reduced diff - integer :: mbSize, nloc, index_avfield, rank2 - - ! moab - integer :: tagtype, numco, tagindex, ierr - character(CXX) :: tagname_mct - - real(r8) , allocatable :: values(:), mct_values(:) - integer nvert(3), nvise(3), nbl(3), nsurf(3), nvisBC(3) - logical :: iamroot - - - character(*),parameter :: subName = '(compare_to_moab_tag_rof) ' - - nloc = mct_avect_lsize(attrVect) - allocate(mct_values(nloc)) - - index_avfield = mct_aVect_indexRA(attrVect,trim(mct_field)) - mct_values(:) = attrVect%rAttr(index_avfield,:) - - ! now get moab tag values; first get info - ierr = iMOAB_GetMeshInfo ( appId, nvert, nvise, nbl, nsurf, nvisBC ); - if (ierr > 0 ) & - call shr_sys_abort(subname//'Error: fail to get mesh info') - if (ent_type .eq. 0) then - mbSize = nvert(1) - else if (ent_type .eq. 1) then - mbSize = nvise(1) - endif - allocate(values(mbSize)) - - ierr = iMOAB_GetDoubleTagStorage ( appId, tagname, mbSize , ent_type, values) - if (ierr > 0 ) & - call shr_sys_abort(subname//'Error: fail to get moab tag values') - - values = mct_values - values - - difference = dot_product(values, values) - call shr_mpi_sum(difference,differenceg,mpicom,subname) - difference = sqrt(differenceg) - call shr_mpi_commrank( mpicom, rank2 ) - if ( rank2 .eq. 0 ) then - print * , subname, ' , difference on tag ', trim(tagname), ' = ', difference - !call shr_sys_abort(subname//'differences between mct and moab values') - endif - deallocate(values) - deallocate(mct_values) - - end subroutine compare_to_moab_tag_rof - ! #endif for MOABDEBUG -#endif - - ! end #ifdef HAVE_MOAB #endif diff --git a/components/mpas-ocean/driver/ocn_comp_mct.F b/components/mpas-ocean/driver/ocn_comp_mct.F index e3ffa94c5b77..c7fcd8a2e596 100644 --- a/components/mpas-ocean/driver/ocn_comp_mct.F +++ b/components/mpas-ocean/driver/ocn_comp_mct.F @@ -43,6 +43,7 @@ module ocn_comp_mct use seq_comm_mct, only: MPOID use seq_comm_mct, only: num_moab_exports use iMOAB, only: iMOAB_DefineTagStorage, iMOAB_SetDoubleTagStorage + use seq_comm_mct, only: seq_comm_compare_mb_mct #endif use iso_c_binding, only : c_char, c_loc, c_ptr, c_int use mpas_c_interfacing, only : mpas_f_to_c_string, mpas_c_to_f_string @@ -95,6 +96,7 @@ module ocn_comp_mct real (kind=RKIND) , allocatable, private :: o2x_om(:,:) real (kind=RKIND) , allocatable, private :: x2o_om(:,:) + integer :: mpicom_moab #endif @@ -230,6 +232,14 @@ subroutine ocn_init_mct( EClock, cdata_o, x2o_o, o2x_o, NLFilename )!{{{ character*100 outfile, wopts integer :: ierrmb, numco, tagtype, tagindex, ent_type character(CXX) :: tagname +#ifdef MOABDEBUG + real(r8) :: difference + type(mct_list) :: temp_list + integer :: size_list, index_list + type(mct_string) :: mctOStr ! + character(CXX) :: mct_field, modelStr +#endif + #endif interface subroutine xml_stream_parser(xmlname, mgr_p, comm, ierr) bind(c) @@ -869,6 +879,24 @@ end subroutine xml_stream_get_attributes call mpas_get_timeInterval(timeStep, dt=dt) #ifdef HAVE_MOAB + +#ifdef MOABDEBUG + ! loop over all fields in seq_flds_x2o_fields + call mct_list_init(temp_list ,seq_flds_x2o_fields) + size_list=mct_list_nitem (temp_list) + ent_type = 1 ! entity type is cell for ocn + print *, num_moab_exports, trim(seq_flds_x2o_fields), ' ocn import check' + modelStr='ocn init' + mpicom_moab = mpicom_o ! save it for run method + 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 seq_comm_compare_mb_mct(modelStr, mpicom_moab, x2o_o, mct_field, MPOID, tagname, ent_type, difference) + enddo + call mct_list_clean(temp_list) +#endif + call ocn_import_moab(errorCode) if (errorCode /= 0) then call mpas_log_write('Error in ocn_import_moab', MPAS_LOG_CRIT) @@ -961,6 +989,16 @@ subroutine ocn_run_mct( EClock, cdata_o, x2o_o, o2x_o)!{{{ real (kind=RKIND), pointer :: config_ssh_grad_relax_timescale real (kind=RKIND) :: timeFilterFactor +#ifdef HAVE_MOAB +#ifdef MOABDEBUG + real(r8) :: difference + type(mct_list) :: temp_list + integer :: size_list, index_list, ent_type + type(mct_string) :: mctOStr ! + character(CXX) :: mct_field, modelStr, tagname +#endif +#endif + iam = domain % dminfo % my_proc_id debugOn = .false. @@ -988,6 +1026,24 @@ subroutine ocn_run_mct( EClock, cdata_o, x2o_o, o2x_o)!{{{ ! Import state from moab coupler #ifdef HAVE_MOAB + + +#ifdef MOABDEBUG + ! loop over all fields in seq_flds_x2o_fields + call mct_list_init(temp_list ,seq_flds_x2o_fields) + size_list=mct_list_nitem (temp_list) + ent_type = 1 ! entity type is cell for ocn + print *, num_moab_exports, trim(seq_flds_x2o_fields), ' ocn import check' + modelStr='ocn run' + 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 seq_comm_compare_mb_mct(modelStr, mpicom_moab, x2o_o, mct_field, MPOID, tagname, ent_type, difference) + enddo + call mct_list_clean(temp_list) +#endif + call ocn_import_moab(ierr) if (ierr /= 0) then call mpas_log_write('Error in ocn_import_moab', MPAS_LOG_CRIT) diff --git a/components/mpas-seaice/driver/ice_comp_mct.F b/components/mpas-seaice/driver/ice_comp_mct.F index bd21ac4e1699..c1a472fee5d4 100644 --- a/components/mpas-seaice/driver/ice_comp_mct.F +++ b/components/mpas-seaice/driver/ice_comp_mct.F @@ -45,6 +45,8 @@ module ice_comp_mct use seq_comm_mct, only: MPSIID use iMOAB, only: iMOAB_DefineTagStorage use shr_kind_mod , only: cxx => SHR_KIND_CXX + use seq_comm_mct, only: seq_comm_compare_mb_mct + use seq_comm_mct, only: num_moab_exports #endif use iso_c_binding, only : c_char, c_loc, c_ptr, c_int @@ -95,6 +97,7 @@ module ice_comp_mct integer , private :: mblsize, totalmbls,totalmblr real (kind=RKIND) , allocatable, private :: i2x_im(:,:) real (kind=RKIND) , allocatable, private :: x2i_im(:,:) + integer :: mpicom_moab ! save it for runtime debug #endif ! !PRIVATE MODULE VARIABLES @@ -220,6 +223,14 @@ subroutine ice_init_mct( EClock, cdata_i, x2i_i, i2x_i, NLFilename )!{{{ #ifdef HAVE_MOAB integer :: ierrmb, numco, tagtype, tagindex character(CXX) :: tagname +#ifdef MOABDEBUG + real(r8) :: difference + type(mct_list) :: temp_list + integer :: size_list, index_list, ent_type + type(mct_string) :: mctOStr ! + character(CXX) :: mct_field, modelStr +#endif + #endif logical, pointer :: tempLogicalConfig character(len=StrKIND), pointer :: tempCharConfig @@ -798,7 +809,28 @@ end subroutine xml_stream_get_attributes ! get intial state from driver ! !----------------------------------------------------------------------- +#ifdef HAVE_MOAB +#ifdef MOABDEBUG + mpicom_moab = mpicom_i ! save it for run method + ! loop over all fields in seq_flds_x2i_fields + call mct_list_init(temp_list ,seq_flds_x2i_fields) + size_list=mct_list_nitem (temp_list) + ent_type = 1 ! entity type is cell for ice + print *, num_moab_exports, trim(seq_flds_x2i_fields), ' ice import check' + modelStr='ice init' + + 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 seq_comm_compare_mb_mct(modelStr, mpicom_moab, x2i_i, mct_field, MPSIID, tagname, ent_type, difference) + enddo + call mct_list_clean(temp_list) +#endif + + call ice_import_moab() +#endif call ice_import_mct(x2i_i, errorCode) if (errorCode /= 0) then call mpas_log_write('Error in ice_import_mct', MPAS_LOG_CRIT) @@ -1087,6 +1119,15 @@ subroutine ice_run_mct( EClock, cdata_i, x2i_i, i2x_i)!{{{ real(kind=RKIND), pointer :: & dayOfNextShortwaveCalculation ! needed for CESM like coupled simulations +#ifdef MOABDEBUG + real(r8) :: difference + type(mct_list) :: temp_list + integer :: size_list, index_list, ent_type + type(mct_string) :: mctOStr ! + character(CXX) :: mct_field, modelStr, tagname +#endif + + iam = domain % dminfo % my_proc_id debugOn = .false. @@ -1107,7 +1148,26 @@ subroutine ice_run_mct( EClock, cdata_i, x2i_i, i2x_i)!{{{ ! reinitialize fluxes call seaice_column_reinitialize_fluxes(domain) +#ifdef HAVE_MOAB +#ifdef MOABDEBUG + ! loop over all fields in seq_flds_x2i_fields + call mct_list_init(temp_list ,seq_flds_x2i_fields) + size_list=mct_list_nitem (temp_list) + ent_type = 1 ! entity type is cell for ice + print *, num_moab_exports, trim(seq_flds_x2i_fields), ' ice import check' + modelStr='ice' + + 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 seq_comm_compare_mb_mct(modelStr, mpicom_moab, x2i_i, mct_field, MPSIID, tagname, ent_type, difference) + enddo + call mct_list_clean(temp_list) +#endif + call ice_import_moab() +#endif ! Import state from coupler call ice_import_mct(x2i_i, ierr) @@ -2915,7 +2975,6 @@ subroutine ice_export_moab() ! This routine calls the routines necessary to send MPASSI fields to MOAB coupler ! use iMOAB, only : iMOAB_SetDoubleTagStorage, iMOAB_WriteMesh - use seq_comm_mct, only: num_moab_exports !EOP !BOC !----------------------------------------------------------------------- @@ -3346,7 +3405,6 @@ subroutine ice_import_moab()!{{{ ! !REVISION HISTORY: ! same as module use iMOAB, only : iMOAB_GetDoubleTagStorage, iMOAB_WriteMesh - use seq_comm_mct, only: num_moab_exports !EOP !BOC From 5500e8ecc12a9206c965da303d42ab43517aaa85 Mon Sep 17 00:00:00 2001 From: Jason Sarich Date: Tue, 17 Jan 2023 14:48:21 -0600 Subject: [PATCH 308/467] fix lnd_import call in merge --- components/elm/src/cpl/lnd_comp_mct.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/components/elm/src/cpl/lnd_comp_mct.F90 b/components/elm/src/cpl/lnd_comp_mct.F90 index cfba2a790a30..1a9d6ab3d0ad 100644 --- a/components/elm/src/cpl/lnd_comp_mct.F90 +++ b/components/elm/src/cpl/lnd_comp_mct.F90 @@ -586,7 +586,7 @@ subroutine lnd_run_mct(EClock, cdata_l, x2l_l, l2x_l) call lnd_import_moab( bounds, atm2lnd_vars, glc2lnd_vars) #endif - call lnd_import( bounds, x2l_l%rattr, atm2lnd_vars, glc2lnd_vars) + call lnd_import( bounds, x2l_l%rattr, atm2lnd_vars, glc2lnd_vars, lnd2atm_vars) call t_stopf ('lc_lnd_import') ! Use infodata to set orbital values if updated mid-run From 0f68ca63e32be36fcf49e65eeeefb715213391d6 Mon Sep 17 00:00:00 2001 From: Jason Sarich Date: Tue, 17 Jan 2023 14:50:41 -0600 Subject: [PATCH 309/467] update chrysalis machine files --- cime_config/machines/cmake_macros/intel_chrysalis.cmake | 1 + 1 file changed, 1 insertion(+) diff --git a/cime_config/machines/cmake_macros/intel_chrysalis.cmake b/cime_config/machines/cmake_macros/intel_chrysalis.cmake index 0d9f3a32b8e5..36678acf02ad 100644 --- a/cime_config/machines/cmake_macros/intel_chrysalis.cmake +++ b/cime_config/machines/cmake_macros/intel_chrysalis.cmake @@ -23,6 +23,7 @@ string(APPEND SLIBS " ${SHELL_CMD_OUTPUT_BUILD_INTERNAL_IGNORE0} ${SHELL_CMD_OUT set(NETCDF_C_PATH "$ENV{NETCDF_C_PATH}") set(NETCDF_FORTRAN_PATH "$ENV{NETCDF_FORTRAN_PATH}") set(PNETCDF_PATH "$ENV{PNETCDF_PATH}") +set(MOAB_PATH "/lcrc/soft/climate/moab/chrysalis/intel") string(APPEND LDFLAGS " -static-intel") if (MPILIB STREQUAL impi) set(MPICC "mpiicc") From 4fe745f707e95fa7bb84247859741c0e09db7bc6 Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Tue, 7 Feb 2023 13:43:46 -0600 Subject: [PATCH 310/467] add serwal76spack cmake file this is for iulian's laptop --- .../machines/cmake_macros/serwal76spack.cmake | 17 +++++++++++++++++ 1 file changed, 17 insertions(+) create mode 100644 cime_config/machines/cmake_macros/serwal76spack.cmake diff --git a/cime_config/machines/cmake_macros/serwal76spack.cmake b/cime_config/machines/cmake_macros/serwal76spack.cmake new file mode 100644 index 000000000000..28f23dc8bba8 --- /dev/null +++ b/cime_config/machines/cmake_macros/serwal76spack.cmake @@ -0,0 +1,17 @@ +if (NOT DEBUG) + string(APPEND CFLAGS " -O2") +endif() +string(APPEND CXX_LIBS " -lstdc++") +if (NOT DEBUG) + string(APPEND FFLAGS " -O2") +endif() +# string(APPEND FFLAGS " -fallow-argument-mismatch -fallow-invalid-boz") +execute_process(COMMAND $ENV{NETCDF_FORTRAN_PATH}/bin/nf-config --flibs OUTPUT_VARIABLE SHELL_CMD_OUTPUT_BUILD_INTERNAL_IGNORE0 OUTPUT_STRIP_TRAILING_WHITESPACE) +execute_process(COMMAND $ENV{NETCDF_C_PATH}/bin/nc-config --libs OUTPUT_VARIABLE SHELL_CMD_OUTPUT_BUILD_INTERNAL_IGNORE1 OUTPUT_STRIP_TRAILING_WHITESPACE) +string(APPEND SLIBS " ${SHELL_CMD_OUTPUT_BUILD_INTERNAL_IGNORE0} ${SHELL_CMD_OUTPUT_BUILD_INTERNAL_IGNORE1} -lblas -llapack") +set(NETCDF_C_PATH "$ENV{NETCDF_C_PATH}") +set(NETCDF_FORTRAN_PATH "$ENV{NETCDF_FORTRAN_PATH}") +set(PNETCDF_PATH "$ENV{PNETCDF_PATH}") +set(HDF5_PATH "$ENV{HDF5_PATH}") +set(ZLIB_PATH "$ENV{ZLIB_PATH}") +set(MOAB_PATH "/home/iulian/lib/moab/spack") From 15ed4e5a5ea06e570d2ccc80c31bf692cc52d9af Mon Sep 17 00:00:00 2001 From: Jason Sarich Date: Tue, 7 Feb 2023 15:28:44 -0600 Subject: [PATCH 311/467] change chrysalis machine info to openmpi 4.1.1 software stack to match moab installation --- cime_config/machines/config_machines.xml | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/cime_config/machines/config_machines.xml b/cime_config/machines/config_machines.xml index ae4fb0120a9d..83e489e871b5 100644 --- a/cime_config/machines/config_machines.xml +++ b/cime_config/machines/config_machines.xml @@ -1965,12 +1965,12 @@ intel-mkl/2020.4.304-g2qaxzf - openmpi/4.1.3-pin4k7o - hdf5/1.10.7-eewgp6v - netcdf-c/4.4.1-ihoo4zq - netcdf-cxx/4.2-soitsxm - netcdf-fortran/4.4.4-tplolxh - parallel-netcdf/1.11.0-gvcfihh + openmpi/4.1.1-qiqkjbu + hdf5/1.8.16-35xugty + netcdf-c/4.4.1-2vngykq + netcdf-cxx/4.2-gzago6i + netcdf-fortran/4.4.4-2kddbib + parallel-netcdf/1.11.0-go65een intel-mpi/2019.9.304-tkzvizk From 69120aa9d7f623a654ed605b6a3ad66cccf01b85 Mon Sep 17 00:00:00 2001 From: Robert Jacob Date: Wed, 8 Feb 2023 23:16:56 -0600 Subject: [PATCH 312/467] Update submodules to match master Update several submodules to match upstream master. 3 that test merge said were a conflict: scorpio_classic, YAKL and rrtmpg Update 3 others to match latest E3SM master: cosp2, gotm, scorpio. --- components/eam/src/physics/cosp2/external | 2 +- components/eam/src/physics/rrtmgp/external | 2 +- components/mpas-ocean/src/gotm | 2 +- externals/YAKL | 2 +- externals/scorpio | 2 +- externals/scorpio_classic | 2 +- 6 files changed, 6 insertions(+), 6 deletions(-) diff --git a/components/eam/src/physics/cosp2/external b/components/eam/src/physics/cosp2/external index 34d8eef3d231..9d910acba3e3 160000 --- a/components/eam/src/physics/cosp2/external +++ b/components/eam/src/physics/cosp2/external @@ -1 +1 @@ -Subproject commit 34d8eef3d231a87c0f73e565f6b5d548876b294a +Subproject commit 9d910acba3e3a3151de231184d4b109f65e28aee diff --git a/components/eam/src/physics/rrtmgp/external b/components/eam/src/physics/rrtmgp/external index fdb714ea58e0..ddf82a25a3a5 160000 --- a/components/eam/src/physics/rrtmgp/external +++ b/components/eam/src/physics/rrtmgp/external @@ -1 +1 @@ -Subproject commit fdb714ea58e0fcbb23c81e0c6bf93840e5516c27 +Subproject commit ddf82a25a3a59a8f0fe904b69181cb7bd99881fb diff --git a/components/mpas-ocean/src/gotm b/components/mpas-ocean/src/gotm index 48104b944583..bb09c95f18ea 160000 --- a/components/mpas-ocean/src/gotm +++ b/components/mpas-ocean/src/gotm @@ -1 +1 @@ -Subproject commit 48104b94458398ba668fc381837202dfbe580dab +Subproject commit bb09c95f18ea0c816a298ed7a6cdb5abef4a8880 diff --git a/externals/YAKL b/externals/YAKL index 7a5777e5d0af..a032296858f9 160000 --- a/externals/YAKL +++ b/externals/YAKL @@ -1 +1 @@ -Subproject commit 7a5777e5d0afd3dae948462f2cb769043b06d073 +Subproject commit a032296858f9069b2ca61243802655b607fab0a0 diff --git a/externals/scorpio b/externals/scorpio index 7a1a1b3d6333..e9618b005f91 160000 --- a/externals/scorpio +++ b/externals/scorpio @@ -1 +1 @@ -Subproject commit 7a1a1b3d63338a3d0e8518aa2bf01d8f59d15be9 +Subproject commit e9618b005f91c8d469eae4749ea162da11aa07a9 diff --git a/externals/scorpio_classic b/externals/scorpio_classic index 154b0320ed99..09dab011e403 160000 --- a/externals/scorpio_classic +++ b/externals/scorpio_classic @@ -1 +1 @@ -Subproject commit 154b0320ed99395ee7e790ed1122ca8bfac3bbc0 +Subproject commit 09dab011e403763696b72e0a2f1bc4a6b3a94b00 From ddeaebe7f2e33d84538d1be0ea7a473293e3874a Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Wed, 15 Feb 2023 11:33:03 -0600 Subject: [PATCH 313/467] moab path for anlgce machine (ubuntu 20) --- cime_config/machines/config_machines.xml | 2 ++ 1 file changed, 2 insertions(+) diff --git a/cime_config/machines/config_machines.xml b/cime_config/machines/config_machines.xml index 83e489e871b5..6880033379a4 100644 --- a/cime_config/machines/config_machines.xml +++ b/cime_config/machines/config_machines.xml @@ -1618,6 +1618,7 @@ /nfs/gce/projects/climate/software/linux-ubuntu20.04-x86_64/hdf5/1.12.1/mpich-4.0/gcc-11.1.0 /nfs/gce/projects/climate/software/linux-ubuntu20.04-x86_64/netcdf/4.8.0c-4.3.1cxx-4.5.3f-parallel/mpich-4.0/gcc-11.1.0 /nfs/gce/projects/climate/software/linux-ubuntu20.04-x86_64/pnetcdf/1.12.2/mpich-4.0/gcc-11.1.0 + /nfs/gce/projects/climate/software/moab/devel/mpich-3.4.2/gcc-11.1.0 @@ -1627,6 +1628,7 @@ /nfs/gce/projects/climate/software/linux-ubuntu20.04-x86_64/hdf5/1.12.1/openmpi-4.1.3/gcc-11.1.0 /nfs/gce/projects/climate/software/linux-ubuntu20.04-x86_64/netcdf/4.8.0c-4.3.1cxx-4.5.3f-parallel/openmpi-4.1.3/gcc-11.1.0 /nfs/gce/projects/climate/software/linux-ubuntu20.04-x86_64/pnetcdf/1.12.2/openmpi-4.1.3/gcc-11.1.0 + /nfs/gce/projects/climate/software/moab/devel/openmpi-4.1.3/gcc-11.1.0 64M From 973ac32f8a3c9154269d7808fdcc564b9e0a5980 Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Wed, 15 Feb 2023 11:46:04 -0600 Subject: [PATCH 314/467] add anlgce.cmake still not clear why gnu_anlgce.cmake is not enough we are specifing gnu compilers so we cannot use this for intel compilers, probably --- cime_config/machines/cmake_macros/anlgce.cmake | 15 +++++++++++++++ 1 file changed, 15 insertions(+) create mode 100644 cime_config/machines/cmake_macros/anlgce.cmake diff --git a/cime_config/machines/cmake_macros/anlgce.cmake b/cime_config/machines/cmake_macros/anlgce.cmake new file mode 100644 index 000000000000..7615540fce99 --- /dev/null +++ b/cime_config/machines/cmake_macros/anlgce.cmake @@ -0,0 +1,15 @@ +if (NOT DEBUG) + string(APPEND CFLAGS " -O2") +endif() +string(APPEND CXX_LIBS " -lstdc++") +if (NOT DEBUG) + string(APPEND FFLAGS " -O2") +endif() +string(APPEND FFLAGS " -fallow-argument-mismatch -fallow-invalid-boz") +execute_process(COMMAND $ENV{NETCDF_PATH}/bin/nf-config --flibs OUTPUT_VARIABLE SHELL_CMD_OUTPUT_BUILD_INTERNAL_IGNORE0 OUTPUT_STRIP_TRAILING_WHITESPACE) +execute_process(COMMAND $ENV{NETCDF_PATH}/bin/nc-config --libs OUTPUT_VARIABLE SHELL_CMD_OUTPUT_BUILD_INTERNAL_IGNORE1 OUTPUT_STRIP_TRAILING_WHITESPACE) +string(APPEND SLIBS " ${SHELL_CMD_OUTPUT_BUILD_INTERNAL_IGNORE0} ${SHELL_CMD_OUTPUT_BUILD_INTERNAL_IGNORE1} -lblas -llapack") +set(NETCDF_PATH "$ENV{NETCDF_PATH}") +set(PNETCDF_PATH "$ENV{PNETCDF_PATH}") +set(HDF5_PATH "$ENV{HDF5_PATH}") +set(ZLIB_PATH "$ENV{ZLIB_PATH}") From 0f9b93186b0b146b81bf8531c2a2eeaf75d936d7 Mon Sep 17 00:00:00 2001 From: Robert Jacob Date: Wed, 15 Feb 2023 16:13:21 -0600 Subject: [PATCH 315/467] Add and fix a few comments Add and fix a few small comments. --- driver-moab/main/cplcomp_exchange_mod.F90 | 2 +- driver-moab/main/prep_aoflux_mod.F90 | 2 +- driver-moab/main/prep_lnd_mod.F90 | 2 +- driver-moab/main/seq_frac_mct.F90 | 8 ++++---- 4 files changed, 7 insertions(+), 7 deletions(-) diff --git a/driver-moab/main/cplcomp_exchange_mod.F90 b/driver-moab/main/cplcomp_exchange_mod.F90 index 12fd73fc61b9..350e6942ed98 100644 --- a/driver-moab/main/cplcomp_exchange_mod.F90 +++ b/driver-moab/main/cplcomp_exchange_mod.F90 @@ -1134,7 +1134,7 @@ subroutine cplcomp_moab_Init(comp) tagname = trim(seq_flds_a2x_fields)//C_NULL_CHAR numco = 1 ! usually 1 value per cell else ! this is not supported now, but leave it here - tagname = trim(seq_flds_a2x_ext_fields)//C_NULL_CHAR + tagname = trim(seq_flds_a2x_ext_fields)//C_NULL_CHAR ! MOAB versions of a2x for spectral numco = np*np ! usually 16 values per cell, GLL points; should be 4 x 4 = 16 endif ierr = iMOAB_DefineTagStorage(mbaxid, tagname, tagtype, numco, tagindex ) diff --git a/driver-moab/main/prep_aoflux_mod.F90 b/driver-moab/main/prep_aoflux_mod.F90 index 8c4504f2d016..aacbccffe912 100644 --- a/driver-moab/main/prep_aoflux_mod.F90 +++ b/driver-moab/main/prep_aoflux_mod.F90 @@ -149,7 +149,7 @@ subroutine prep_aoflux_init (infodata) call shr_sys_abort(subname//' ERROR in defining tags on ocn phys mesh on cpl') endif ! make it zero - ! first form a list + ! first form a list and get size. call mct_list_init(temp_list ,seq_flds_xao_fields) size_list=mct_list_nitem (temp_list) call mct_list_clean(temp_list) diff --git a/driver-moab/main/prep_lnd_mod.F90 b/driver-moab/main/prep_lnd_mod.F90 index 040a6d328589..f313485f0755 100644 --- a/driver-moab/main/prep_lnd_mod.F90 +++ b/driver-moab/main/prep_lnd_mod.F90 @@ -14,7 +14,7 @@ module prep_lnd_mod use seq_comm_mct, only: mhid ! iMOAB id for atm instance use seq_comm_mct, only: mphaid ! iMOAB id for phys atm on atm pes use seq_comm_mct, only: mhpgid ! iMOAB id for atm pgx grid, on atm pes; created with se and gll grids - use seq_comm_mct, only: mblxid ! iMOAB id for mpas ocean migrated mesh to coupler pes + use seq_comm_mct, only: mblxid ! iMOAB id for land migrated mesh to coupler pes use seq_comm_mct, only: mbrxid ! iMOAB id of moab rof on coupler pes (FV now) use seq_comm_mct, only: mbintxal ! iMOAB id for intx mesh between atm and lnd use seq_comm_mct, only: mbintxrl ! iMOAB id for intx mesh between river and land diff --git a/driver-moab/main/seq_frac_mct.F90 b/driver-moab/main/seq_frac_mct.F90 index e58b30b3dfeb..77c540de9398 100644 --- a/driver-moab/main/seq_frac_mct.F90 +++ b/driver-moab/main/seq_frac_mct.F90 @@ -482,7 +482,7 @@ subroutine seq_frac_init( infodata, & call seq_map_map(mapper_a2l, fractions_a, fractions_l, fldlist='afrac', norm=.false.) endif - end if + end if ! end of (if lnd_present) ! Initialize fractions on ice grid/decomp (initialize ice fraction to zero) @@ -514,7 +514,7 @@ subroutine seq_frac_init( infodata, & ierr = iMOAB_SetDoubleTagStorage ( mbrxid, tagname, arrSize , ent_type, tagValues) deallocate(tagValues) - tagname = 'rfrac'//C_NULL_CHAR ! 'lfrin' + tagname = 'rfrac'//C_NULL_CHAR ! 'rfrac' allocate(tagValues(lSize) ) tagValues = dom_r%data%rAttr(kf,:) kgg = mct_aVect_indexIA(dom_r%data ,"GlobGridNum" ,perrWith=subName) @@ -599,7 +599,7 @@ subroutine seq_frac_init( infodata, & call seq_map_map(mapper_i2a,fractions_i,fractions_a,fldlist='ofrac',norm=.false.) endif - end if + end if ! end of ice_present ! Initialize fractions on ocean grid/decomp (initialize ice fraction to zero) ! These are initialized the same as for ice @@ -658,7 +658,7 @@ subroutine seq_frac_init( infodata, & mapper_o2i => prep_ice_get_mapper_SFo2i() call seq_map_map(mapper_o2i,fractions_o,fractions_i,fldlist='afrac',norm=.false.) endif - end if + end if ! end of if ocn present ! --- Set ofrac and lfrac on atm grid. These should actually be mapo2a of ! ofrac and lfrac but we can't map lfrac from o2a due to masked mapping From 3fa89d42b32a86157b6951aa5036d71287c71fa1 Mon Sep 17 00:00:00 2001 From: Robert Jacob Date: Wed, 15 Feb 2023 16:14:20 -0600 Subject: [PATCH 316/467] Add many comments to explain workflow. Add many comments, mostly in cime_init, to explain what is happening. Highlight MOAB and MAP operations. --- driver-moab/main/cime_comp_mod.F90 | 131 ++++++++++++++++++++++++----- driver-moab/main/component_mod.F90 | 16 +++- 2 files changed, 124 insertions(+), 23 deletions(-) diff --git a/driver-moab/main/cime_comp_mod.F90 b/driver-moab/main/cime_comp_mod.F90 index d17c2aeb005b..4ffb4a3b5609 100644 --- a/driver-moab/main/cime_comp_mod.F90 +++ b/driver-moab/main/cime_comp_mod.F90 @@ -733,12 +733,9 @@ subroutine cime_pre_init1(esmf_log_option) call cime_cpl_init(global_comm, driver_comm, num_inst_driver, driver_id) call shr_pio_init1(num_inst_total,NLFileName, driver_comm) - ! - ! If pio_async_interface is true Global_comm is MPI_COMM_NULL on the servernodes - ! and server nodes do not return from shr_pio_init2 - ! - ! if (Global_comm /= MPI_COMM_NULL) then + !--- Initialize communicators, layouts, MCT + !--- Init MOAB if (num_inst_driver > 1) then call seq_comm_init(global_comm, driver_comm, NLFileName, drv_comm_ID=driver_id) write(cpl_inst_tag,'("_",i4.4)') driver_id @@ -1109,6 +1106,7 @@ subroutine cime_pre_init2() !| Initialize coupled fields (depends on infodata) !---------------------------------------------------------- + ! MOAB declare fldname_ext for moab extensions call seq_flds_set(nlfilename, GLOID, infodata) !---------------------------------------------------------- @@ -1289,6 +1287,10 @@ subroutine cime_pre_init2() call shr_frz_freezetemp_init(tfreeze_option, iamroot_GLOID) + !---------------------------------------------------------- + ! Initialize orbital params + !---------------------------------------------------------- + if (trim(orb_mode) == trim(seq_infodata_orb_variable_year)) then call seq_timemgr_EClockGetData( EClock_d, curr_ymd=ymd) @@ -1305,6 +1307,10 @@ subroutine cime_pre_init2() orb_mvelpp=orb_mvelpp) endif + !---------------------------------------------------------- + ! Initialize satvap table + !---------------------------------------------------------- + call seq_infodata_getData(infodata, & wv_sat_scheme=wv_sat_scheme, & wv_sat_transition_start=wv_sat_transition_start, & @@ -1447,6 +1453,11 @@ subroutine cime_init() call shr_sys_flush(logunit) endif + !--------------------------------------------------------------------------------------- + ! Initialie the comp data type for each model. Valid on all processors across driver. + ! includes allocation, but not definintion, of pointers for gsmap, domain and cdata_cc + !--------------------------------------------------------------------------------------- + call t_startf('CPL:comp_init_pre_all') call component_init_pre(atm, ATMID, CPLATMID, CPLALLATMID, infodata, ntype='atm') call component_init_pre(lnd, LNDID, CPLLNDID, CPLALLLNDID, infodata, ntype='lnd') @@ -1460,6 +1471,18 @@ subroutine cime_init() call t_stopf('CPL:comp_init_pre_all') + !--------------------------------------------------------------------------------------- + ! Initialize components including domain/grid info. + ! If processor has cpl or model: Do an infodata exchange + ! Initialize pointers to the main _cc attribute vectors in comp datatype + ! If the model is active on this processor + ! Call init method for each model + ! initialize GsMap, Avs (attributes and size) in comp struct + ! initialize comp%domain and fill it with GlobGridNum, lat, lon, area, mask, frac + ! MOAB component app registered, mesh created, tags defined (mesh and data), areas set + ! If processor has cpl or model: Do an infodata exchange + ! If processor has model: Copy area to aream for now. + !--------------------------------------------------------------------------------------- call t_startf('CPL:comp_init_cc_atm') call t_adj_detailf(+2) @@ -1515,6 +1538,20 @@ subroutine cime_init() call t_adj_detailf(-2) call t_stopf('CPL:comp_init_cc_iac') + !--------------------------------------------------------------------------------------- + ! Initialize coupler-component data + ! if processor has cpl or model + ! init the extended gsMap that describes comp on mpijoin + ! MOAB: on component, send mesh. on coupler, register coupler version + ! of app and receive mesh. + ! MOAB: on both, compute CommGraph between component and coupler versions. + ! MOAB: define c2x, x2c, domain tags + ! init the mappers that go between comp and coupler instances of mesh + ! these will be rearranger-type mappers since the meshs are the same + ! initialize extended Avs to match extended GsMaps + ! initialize extended domain + ! fill coupler domain with data using a map_exchange call (copy or rearrange only) + !--------------------------------------------------------------------------------------- call t_startf('CPL:comp_init_cx_all') call t_adj_detailf(+2) call component_init_cx(atm, infodata) @@ -1528,7 +1565,10 @@ subroutine cime_init() call t_adj_detailf(-2) call t_stopf('CPL:comp_init_cx_all') - ! Determine complist (list of comps for each id) + !--------------------------------------------------------------------------------------- + ! Determine complist (list of comps for each id) + ! Build complist string that will be output later. + !--------------------------------------------------------------------------------------- call t_startf('CPL:comp_list_all') call t_adj_detailf(+2) @@ -1978,8 +2018,13 @@ subroutine cime_init() call shr_sys_abort(subname//' ERROR: iac_prognostic but num_inst_iac not num_inst_max') !---------------------------------------------------------- - !| Initialize attribute vectors for prep_c2C_init_avs routines and fractions - !| Initialize mapping between components + ! Initialize all attribute vectors from other components that are mapped to each grid. + ! e.g. for atmosphere, init l2x_ax, o2x_ax, i2x_ax + ! MAP Initilize map for each transformaion. States and Fluxes, all sources. + ! Includes reading weights from file + ! MOAB: register coupler apps between components: e.g. OCN_ATM_COU + ! MOAB: compute intersection intx for each pair of grids on coupler but + ! not weights. !---------------------------------------------------------- if (iamin_CPLID) then @@ -1988,14 +2033,24 @@ subroutine cime_init() call t_adj_detailf(+2) if (drv_threading) call seq_comm_setnthreads(nthreads_CPLID) + ! init maps for So2a, Sl2a, Si2a, Fo2a, Fl2a, Fi2a + ! MOAB: calculate o2a intx, l2a intx for tri-grid call prep_atm_init(infodata, ocn_c2_atm, ice_c2_atm, lnd_c2_atm, iac_c2_lnd) + ! init maps for Sa2l, Fa2l, Fr2l, Sg2l, Fg2l + ! MOABTODO: a2l intx for tri-grid r2l intx for bi-grid intx call prep_lnd_init(infodata, atm_c2_lnd, rof_c2_lnd, glc_c2_lnd, iac_c2_lnd) + ! init maps for Sa2o, Va2o, Fa2o, Fr2o, Rr2o_liq, Rr2o_ice, SFi2o, Rg2o_liq, Rg2o_ice, Sg2o, Fg2o, Sw2o + ! MOAB: calc a2o intx, read file for r2o, call prep_ocn_init(infodata, atm_c2_ocn, atm_c2_ice, ice_c2_ocn, rof_c2_ocn, wav_c2_ocn, glc_c2_ocn, glcshelf_c2_ocn) + ! init maps for SFo2i, Rg2i, Sg2i, Fg2i, Rr2i + ! MOABTODO: ocn 2 ice intx, r2i intx ? call prep_ice_init(infodata, ocn_c2_ice, glc_c2_ice, glcshelf_c2_ice, rof_c2_ice ) + ! init maps for Sa2r, Fa2r, Fl2r + ! MOABTODO: l2r intx, a2r intx call prep_rof_init(infodata, lnd_c2_rof, atm_c2_rof, ocn_c2_rof) call prep_glc_init(infodata, lnd_c2_glc, ocn_c2_glcshelf) @@ -2010,11 +2065,10 @@ subroutine cime_init() endif - ! need to finish up the migration of mesh for rof 2 ocn map ( read from file) - ! if (iamin_CPLALLROFID .and. rof_c2_ocn) call prep_rof_ocn_moab(infodata) - !---------------------------------------------------------- !| Update aream in domains where appropriate + ! Read from mapping files and rearrange if necessary. + ! MAP: aream between some coupler meshes !---------------------------------------------------------- if (iamin_CPLID) then @@ -2069,7 +2123,8 @@ subroutine cime_init() !---------------------------------------------------------- !| Initialize area corrections based on aream (read in map_init) and area !| Area correct component initialization output fields - !| Map initial component AVs from component to coupler pes + !| SEND (Rearrange) initial component AVs from component to coupler pes + ! MOABTODO: add calls to send initial data. !---------------------------------------------------------- areafact_samegrid = .false. @@ -2131,7 +2186,7 @@ subroutine cime_init() call t_stopf ('CPL:init_areacor') !---------------------------------------------------------- - !| global sum diagnostics for IC data + !| global sum diagnostics for initial data sent to coupler. !---------------------------------------------------------- if (iamin_CPLID .and. info_debug > 1) then @@ -2179,6 +2234,29 @@ subroutine cime_init() !---------------------------------------------------------- !| Initialize fractions + ! doma: afrac=1 + ! MOAB: add fraclist_a tags to mesh for atm and set afrac=1 + ! domg: gfrac=frac from domain + ! doml: lfrin = frac from domain + ! MOAB add fraclist_l tags to mesh and set lfrin + ! map afrac to lnd, lfrin to atm + ! domr: rfrac = frac from domain + ! MOAB add fraclist_r tags to mesh set rface + ! domw: set all to 1 + ! domiac: set all to 1 + ! domseaice: ofrac = fraom from dom_i + ! map ofrac to atm + ! MOAB add fraclist_i tags to mesh, set ofrac + ! domocn: set all to 0 + ! MOAB add fraclist_o and set to 0 + ! map ofrac from i to o + ! MOAB set ofrac from dom_i to ocean + ! if no ice model: set ofrac from dom_o and map to a + ! if atm map afrac from a to o + ! MOAB do mapping with lots of code + ! domatm: + ! if i or o: lfrac = 1 - ofrac + ! if land: lfrac = lfrin, ofrac = 1 - lfrin !---------------------------------------------------------- if (iamin_CPLID) then @@ -2227,7 +2305,9 @@ subroutine cime_init() endif !---------------------------------------------------------- - !| Initialize prep_aoflux_mod module variables + !| Initialize prep_aoflux_mod module variables xao_*x and + ! set to zero. + ! MOAB: add xao_fields tags to second copy of ocean mesh. !---------------------------------------------------------- if (iamin_CPLID) then @@ -2235,7 +2315,8 @@ subroutine cime_init() endif !---------------------------------------------------------- - !| Initialize atm/ocn flux component and compute ocean albedos + !| Initialize atm/ocn flux component. Allocate arrays for flux + ! calculation and set to 0. Define a mask to use. !---------------------------------------------------------- if (iamin_CPLID) then @@ -2267,6 +2348,11 @@ subroutine cime_init() endif + !---------------------------------------------------------- + !| compute ocean albedos; update rad fractions + ! NOTE: a2x_ox and xao_ox are zero on input. + ! MOAB: update rad fractions + !---------------------------------------------------------- do exi = 1,num_inst_xao !tcx is this correct? relation between xao and frc for ifrad and ofrad efi = mod((exi-1),num_inst_frc) + 1 @@ -2297,25 +2383,25 @@ subroutine cime_init() if (iamin_CPLID) then if (lnd_present) then - ! Get lnd output on atm grid + ! MAP lnd output to atm grid call prep_atm_calc_l2x_ax(fractions_lx, timer='CPL:init_atminit') endif if (ice_present) then - ! Get ice output on atm grid + ! MAP ice output to atm grid call prep_atm_calc_i2x_ax(fractions_ix, timer='CPL:init_atminit') endif if (ocn_present) then - ! Get ocn output on atm grid + ! MAP ocn output to atm grid call prep_atm_calc_o2x_ax(fractions_ox, timer='CPL:init_atminit') endif if (ocn_present) then - ! Get albedos on atm grid + ! MAP albedos to atm grid call prep_aoflux_calc_xao_ax(fractions_ox, flds='albedos', timer='CPL:init_atminit') - ! Get atm/ocn fluxes on atm grid + ! MAP atm/ocn fluxes to atm grid if (trim(aoflux_grid) == 'ocn') then call prep_aoflux_calc_xao_ax(fractions_ox, flds='states_and_fluxes', & timer='CPL:init_atminit') @@ -2324,8 +2410,10 @@ subroutine cime_init() if (lnd_present .or. ocn_present) then ! Merge input to atmosphere on coupler pes + ! Set x2a_ax to zero then fill it. xao_ax => prep_aoflux_get_xao_ax() if (associated(xao_ax)) then + ! will call prep_atm_merge for each instance. call prep_atm_mrg(infodata, & fractions_ax=fractions_ax, xao_ax=xao_ax, timer_mrg='CPL:init_atminit') ! MOAB @@ -2376,7 +2464,7 @@ subroutine cime_init() seq_flds_x2c_fluxes=seq_flds_x2a_fluxes, & seq_flds_c2x_fluxes=seq_flds_a2x_fluxes) - ! Map atm output data from atm pes to cpl pes + ! Send atm output data from atm pes to cpl pes call component_exch(atm, flow='c2x', infodata=infodata, & infodata_string='atm2cpl_init') ! @@ -2400,6 +2488,7 @@ subroutine cime_init() !---------------------------------------------------------- !| Read driver restart file, overwrite anything previously sent or computed + ! MOABTODO: read restart !---------------------------------------------------------- call t_startf('CPL:init_readrestart') diff --git a/driver-moab/main/component_mod.F90 b/driver-moab/main/component_mod.F90 index ff972b803d1d..6958383a6007 100644 --- a/driver-moab/main/component_mod.F90 +++ b/driver-moab/main/component_mod.F90 @@ -120,6 +120,7 @@ subroutine component_init_pre(comp, compid, cplcompid, cplallcompid, & call seq_comm_getinfo(comp(eci)%compid , iamroot=comp(eci)%iamroot_compid) call seq_comm_getinfo(comp(eci)%compid , nthreads=comp(eci)%nthreads_compid) + ! a processor may have more then one component comp(eci)%iamin_compid = seq_comm_iamin (comp(eci)%compid) comp(eci)%iamin_cplcompid = seq_comm_iamin (comp(eci)%cplcompid) comp(eci)%iamin_cplallcompid = seq_comm_iamin (comp(eci)%cplallcompid) @@ -148,11 +149,15 @@ subroutine component_init_pre(comp, compid, cplcompid, cplallcompid, & allocate(comp(eci)%dom_cc) allocate(comp(eci)%gsmap_cc) allocate(comp(eci)%cdata_cc) + ! copy things like name, ID, mpicom, dom and GsMap pointers to cdata struct call seq_cdata_init(comp(eci)%cdata_cc, comp(eci)%compid, & 'cdata_'//ntype(1:1)//ntype(1:1), comp(eci)%dom_cc, & comp(eci)%gsmap_cc, infodata, seq_timemgr_data_assimilation_active(ntype(1:3))) - ! Determine initial value of comp_present in infodata - to do - add this to component + ! Determine initial value of comp_present in infodata and set it in + ! comp%present + ! +!workaround some weird bug in pgi compiler. #ifdef CPRPGI if (comp(1)%oneletterid == 'a') then call seq_infodata_getData(infodata, atm_present=comp(eci)%present) @@ -223,7 +228,7 @@ end subroutine comp_init character(*), parameter :: F00 = "('"//subname//" : ', 4A )" !--------------------------------------------------------------- - ! **** Initialize component - this initializes x2c_cc and c2x_cc *** + ! **** Initialize component - this initializes pointers to x2c_cc and c2x_cc *** ! the following will call the appropriate comp_init_mct routine call t_set_prefixf(comp(1)%oneletterid//"_i:") @@ -252,10 +257,13 @@ end subroutine comp_init if (drv_threading) call seq_comm_setnthreads(comp(eci)%nthreads_compid) call shr_sys_flush(logunit) + ! only done in second phase of atm init + ! multiple by area ratio if (present(seq_flds_x2c_fluxes)) then call mct_avect_vecmult(comp(eci)%x2c_cc, comp(eci)%drv2mdl, seq_flds_x2c_fluxes, mask_spval=.true.) end if + ! call the component's specific init phase call t_startf('comp_init') call comp_init( EClock, comp(eci)%cdata_cc, comp(eci)%x2c_cc, comp(eci)%c2x_cc, & NLFilename=NLFilename ) @@ -266,6 +274,7 @@ end subroutine comp_init call t_drvstopf ('check_fields') end If + ! only done in second phase of atm init if (present(seq_flds_c2x_fluxes)) then call mct_avect_vecmult(comp(eci)%c2x_cc, comp(eci)%mdl2drv, seq_flds_c2x_fluxes, mask_spval=.true.) end if @@ -604,6 +613,7 @@ subroutine component_init_areacor(comp, samegrid, seq_flds_c2x_fluxes) if (comp(eci)%iamin_cplcompid) then ! Map component domain from coupler to component processes + ! to send aream to components. if ( num_inst > 1) then mpi_tag = comp(eci)%cplcompid*100+eci*10+5 else @@ -981,6 +991,8 @@ subroutine component_diag(infodata, comp, flow, comment, info_debug, timer_diag end subroutine component_diag + ! can exchange data between mesh in component and mesh on coupler. Either way. + ! used in first hop of 2-hop subroutine component_exch_moab(comp, mbAPPid1, mbAppid2, direction, fields ) use iMOAB , only: iMOAB_SendElementTag, iMOAB_ReceiveElementTag, iMOAB_WriteMesh, iMOAB_FreeSenderBuffers From b18b9f1b455191147d81f6ad25e482a6af318b32 Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Wed, 18 Jan 2023 14:23:17 -0600 Subject: [PATCH 317/467] need to guard this file writing called during exposing the mct grid --- driver-moab/main/component_type_mod.F90 | 2 ++ 1 file changed, 2 insertions(+) diff --git a/driver-moab/main/component_type_mod.F90 b/driver-moab/main/component_type_mod.F90 index a65c02a84989..6a5c1611769f 100644 --- a/driver-moab/main/component_type_mod.F90 +++ b/driver-moab/main/component_type_mod.F90 @@ -397,12 +397,14 @@ subroutine expose_mct_grid_moab (comp, imoabAPI) deallocate(moab_vert_coords) deallocate(vgids) +#ifdef MOABDEBUG ! write out the mesh file to disk, in parallel outfile = 'WHOLE_cx_'//comp%ntype//'.h5m'//CHAR(0) wopts = 'PARALLEL=WRITE_PART'//CHAR(0) ierr = iMOAB_WriteMesh(imoabAPI, outfile, wopts) if (ierr > 0 ) & call shr_sys_abort(subname//'Error: fail to write the land mesh file') +#endif endif end subroutine expose_mct_grid_moab From 711556b8338a49b487e010a899bc92aaca7cd200 Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Thu, 16 Feb 2023 12:43:13 -0600 Subject: [PATCH 318/467] review comments no change to the code --- driver-moab/main/cime_comp_mod.F90 | 25 ++++++++++++++--------- driver-moab/main/cplcomp_exchange_mod.F90 | 20 +++--------------- 2 files changed, 18 insertions(+), 27 deletions(-) diff --git a/driver-moab/main/cime_comp_mod.F90 b/driver-moab/main/cime_comp_mod.F90 index 4ffb4a3b5609..26b8b3c80f6a 100644 --- a/driver-moab/main/cime_comp_mod.F90 +++ b/driver-moab/main/cime_comp_mod.F90 @@ -1454,8 +1454,8 @@ subroutine cime_init() endif !--------------------------------------------------------------------------------------- - ! Initialie the comp data type for each model. Valid on all processors across driver. - ! includes allocation, but not definintion, of pointers for gsmap, domain and cdata_cc + ! Initialize the comp data type for each model. Valid on all processors across driver. + ! includes allocation, but not definition, of pointers for gsmap, domain and cdata_cc !--------------------------------------------------------------------------------------- call t_startf('CPL:comp_init_pre_all') @@ -1542,12 +1542,16 @@ subroutine cime_init() ! Initialize coupler-component data ! if processor has cpl or model ! init the extended gsMap that describes comp on mpijoin - ! MOAB: on component, send mesh. on coupler, register coupler version - ! of app and receive mesh. - ! MOAB: on both, compute CommGraph between component and coupler versions. + ! MOAB: on component, send mesh (except lnd and rof). + ! on coupler, register coupler version + ! of app and receive mesh (except lnd and rof). The initial CommGraph is computed as part of + ! send/receive of the mesh. For atm compute an additional CommGraph between physgrid on comp atm side + ! and mesh on coupler side + ! MOAB: for lnd and rof, read the mesh on coupler side from file and + ! compute CommGraph between component (just a point cloud) and coupler version (full mesh) ! MOAB: define c2x, x2c, domain tags ! init the mappers that go between comp and coupler instances of mesh - ! these will be rearranger-type mappers since the meshs are the same + ! these will be rearranger-type mappers since the meshss are the same ! initialize extended Avs to match extended GsMaps ! initialize extended domain ! fill coupler domain with data using a map_exchange call (copy or rearrange only) @@ -2020,11 +2024,11 @@ subroutine cime_init() !---------------------------------------------------------- ! Initialize all attribute vectors from other components that are mapped to each grid. ! e.g. for atmosphere, init l2x_ax, o2x_ax, i2x_ax - ! MAP Initilize map for each transformaion. States and Fluxes, all sources. + ! MAP Initialize map for each transformation. States and Fluxes, all sources. ! Includes reading weights from file ! MOAB: register coupler apps between components: e.g. OCN_ATM_COU - ! MOAB: compute intersection intx for each pair of grids on coupler but - ! not weights. + ! MOAB: compute intersection intx for each pair of grids on coupler and weights + ! MOAB: augment seq_map_type object with MOAB attributes to enable seq_map_map to do MOAB-based projections !---------------------------------------------------------- if (iamin_CPLID) then @@ -2253,7 +2257,8 @@ subroutine cime_init() ! MOAB set ofrac from dom_i to ocean ! if no ice model: set ofrac from dom_o and map to a ! if atm map afrac from a to o - ! MOAB do mapping with lots of code + ! MOAB do mapping with lots of code ! + ! !!! iulian: if maps are augmented for MOAB, we do not need additional MOAB code; MOABTODO: check ! domatm: ! if i or o: lfrac = 1 - ofrac ! if land: lfrac = lfrin, ofrac = 1 - lfrin diff --git a/driver-moab/main/cplcomp_exchange_mod.F90 b/driver-moab/main/cplcomp_exchange_mod.F90 index 350e6942ed98..734e82390232 100644 --- a/driver-moab/main/cplcomp_exchange_mod.F90 +++ b/driver-moab/main/cplcomp_exchange_mod.F90 @@ -1104,15 +1104,6 @@ subroutine cplcomp_moab_Init(comp) endif endif - - - ! comment out now; we will not send directly to atm spectral on coupler; we need to send in the - ! context of ocean intx;; or directly to land on coupler, for projection to land - ! now we have the spectral atm on coupler pes, and we want to send some data from - ! atm physics mesh to atm spectral on coupler side; compute a par comm graph between - ! atm phys and spectral atm mesh on coupler PEs - ! ierr = iMOAB_ComputeCommGraph(cmpAtmPID, physAtmPID, &joinComm, &atmPEGroup, &atmPhysGroup, - ! &typeA, &typeB, &cmpatm, &physatm); ! graph between atm phys, mphaid, and atm dyn on coupler, mbaxid ! phys atm group is mpigrp_old, coupler group is mpigrp_cplid typeA = 2 ! point cloud for mphaid @@ -1124,7 +1115,6 @@ subroutine cplcomp_moab_Init(comp) ! components/cam/src/cpl/atm_comp_mct.F90 ierr = iMOAB_ComputeCommGraph( mphaid, mbaxid, mpicom_join, mpigrp_old, mpigrp_cplid, & typeA, typeB, ATM_PHYS_CID, id_join) ! ID_JOIN is now 6 - ! comment out this above part ! we can receive those tags only on coupler pes, when mbaxid exists ! we have to check that before we can define the tag @@ -1158,12 +1148,6 @@ subroutine cplcomp_moab_Init(comp) endif - ! send aream values from component to coupler - ! tagname = 'aream' - ! if (MPI_COMM_NULL /= mpicom_join ) then ! we are on the joint pes - ! call component_exch_moab(comp, mphaid, mbaxid, 0, tagname) - ! endif - #ifdef MOABDEBUG if (MPI_COMM_NULL /= mpicom_new ) then ! we are on the coupler pes ! debug test @@ -1191,8 +1175,10 @@ subroutine cplcomp_moab_Init(comp) call seq_comm_getinfo(id_old,mpigrp=mpigrp_old) ! component group pes if (MPI_COMM_NULL /= mpicom_old ) then ! it means we are on the component pes (ocean) - ! write out the mesh file to disk, in parallel #ifdef MOABDEBUG + ! write out the mesh file to disk, in parallel + ! we did it here because MOABDEBUG was not propagating with FFLAGS; we should move it + ! now to component code, because MOABDEBUG can be propagated now with CPPDEFS outfile = 'wholeOcn.h5m'//C_NULL_CHAR wopts = 'PARALLEL=WRITE_PART'//C_NULL_CHAR ierr = iMOAB_WriteMesh(MPOID, outfile, wopts) From c01220b1f2f0572294af583272c315379d05692d Mon Sep 17 00:00:00 2001 From: Jason Sarich Date: Mon, 20 Feb 2023 11:40:50 -0600 Subject: [PATCH 319/467] fix machine files for anlgce (ubuntu 20) --- .../machines/cmake_macros/anlgce.cmake | 15 - .../machines/cmake_macros/gnu_anlgce.cmake | 1 + cime_config/machines/config_machines.xml | 2 +- cime_config/machines/config_machines.xml.moab | 3167 ----------------- 4 files changed, 2 insertions(+), 3183 deletions(-) delete mode 100644 cime_config/machines/cmake_macros/anlgce.cmake delete mode 100644 cime_config/machines/config_machines.xml.moab diff --git a/cime_config/machines/cmake_macros/anlgce.cmake b/cime_config/machines/cmake_macros/anlgce.cmake deleted file mode 100644 index 7615540fce99..000000000000 --- a/cime_config/machines/cmake_macros/anlgce.cmake +++ /dev/null @@ -1,15 +0,0 @@ -if (NOT DEBUG) - string(APPEND CFLAGS " -O2") -endif() -string(APPEND CXX_LIBS " -lstdc++") -if (NOT DEBUG) - string(APPEND FFLAGS " -O2") -endif() -string(APPEND FFLAGS " -fallow-argument-mismatch -fallow-invalid-boz") -execute_process(COMMAND $ENV{NETCDF_PATH}/bin/nf-config --flibs OUTPUT_VARIABLE SHELL_CMD_OUTPUT_BUILD_INTERNAL_IGNORE0 OUTPUT_STRIP_TRAILING_WHITESPACE) -execute_process(COMMAND $ENV{NETCDF_PATH}/bin/nc-config --libs OUTPUT_VARIABLE SHELL_CMD_OUTPUT_BUILD_INTERNAL_IGNORE1 OUTPUT_STRIP_TRAILING_WHITESPACE) -string(APPEND SLIBS " ${SHELL_CMD_OUTPUT_BUILD_INTERNAL_IGNORE0} ${SHELL_CMD_OUTPUT_BUILD_INTERNAL_IGNORE1} -lblas -llapack") -set(NETCDF_PATH "$ENV{NETCDF_PATH}") -set(PNETCDF_PATH "$ENV{PNETCDF_PATH}") -set(HDF5_PATH "$ENV{HDF5_PATH}") -set(ZLIB_PATH "$ENV{ZLIB_PATH}") diff --git a/cime_config/machines/cmake_macros/gnu_anlgce.cmake b/cime_config/machines/cmake_macros/gnu_anlgce.cmake index 7615540fce99..f6ac55f0ce61 100644 --- a/cime_config/machines/cmake_macros/gnu_anlgce.cmake +++ b/cime_config/machines/cmake_macros/gnu_anlgce.cmake @@ -13,3 +13,4 @@ set(NETCDF_PATH "$ENV{NETCDF_PATH}") set(PNETCDF_PATH "$ENV{PNETCDF_PATH}") set(HDF5_PATH "$ENV{HDF5_PATH}") set(ZLIB_PATH "$ENV{ZLIB_PATH}") +set(MOAB_PATH "$ENV{MOAB_PATH}") diff --git a/cime_config/machines/config_machines.xml b/cime_config/machines/config_machines.xml index 6880033379a4..1cbc6be2e2a0 100644 --- a/cime_config/machines/config_machines.xml +++ b/cime_config/machines/config_machines.xml @@ -1618,7 +1618,7 @@ /nfs/gce/projects/climate/software/linux-ubuntu20.04-x86_64/hdf5/1.12.1/mpich-4.0/gcc-11.1.0 /nfs/gce/projects/climate/software/linux-ubuntu20.04-x86_64/netcdf/4.8.0c-4.3.1cxx-4.5.3f-parallel/mpich-4.0/gcc-11.1.0 /nfs/gce/projects/climate/software/linux-ubuntu20.04-x86_64/pnetcdf/1.12.2/mpich-4.0/gcc-11.1.0 - /nfs/gce/projects/climate/software/moab/devel/mpich-3.4.2/gcc-11.1.0 + /nfs/gce/projects/climate/software/moab/devel/mpich-4.0/gcc-11.1.0 diff --git a/cime_config/machines/config_machines.xml.moab b/cime_config/machines/config_machines.xml.moab deleted file mode 100644 index 4b09a4d6a4dd..000000000000 --- a/cime_config/machines/config_machines.xml.moab +++ /dev/null @@ -1,3167 +0,0 @@ - - - - - - - NERSC XC30, os is CNL, 24 pes/node, batch system is SLURM - edison - CNL - intel,intel18,gnu,gnu7 - mpt - acme - /project/projectdirs/acme - acme,m2830,m2833 - $ENV{CSCRATCH}/acme_scratch/edison - /project/projectdirs/acme/inputdata - /project/projectdirs/acme/inputdata/atm/datm7 - $CIME_OUTPUT_ROOT/archive/$CASE - /project/projectdirs/acme/baselines/$COMPILER - /project/projectdirs/acme/tools/cprnc.edison/cprnc - 8 - e3sm_developer - nersc_slurm - e3sm - 24 - 24 - TRUE - - srun - - --label - -n {{ total_tasks }} - -c $SHELL{echo 48/`./xmlquery --value MAX_MPITASKS_PER_NODE`|bc} - $SHELL{if [ 24 -ge `./xmlquery --value MAX_MPITASKS_PER_NODE` ]; then echo "--cpu_bind=cores"; else echo "--cpu_bind=threads";fi;} - -m plane=$SHELL{echo `./xmlquery --value MAX_MPITASKS_PER_NODE`} - - - - /opt/modules/default/init/perl.pm - /opt/modules/default/init/python.py - /opt/modules/default/init/sh - /opt/modules/default/init/csh - /opt/modules/default/bin/modulecmd perl - /opt/modules/default/bin/modulecmd python - module - module - - PrgEnv-intel - PrgEnv-cray - PrgEnv-gnu - intel - cce - gcc - cray-parallel-netcdf - cray-parallel-hdf5 - pmi - cray-libsci - cray-mpich2 - cray-mpich - cray-netcdf - cray-hdf5 - cray-netcdf-hdf5parallel - craype-sandybridge - craype-ivybridge - craype - papi - cray-petsc - esmf - - - - craype - craype/2.5.14 - craype-ivybridge - pmi - pmi/5.0.13 - cray-mpich - cray-mpich/7.7.0 - - - - PrgEnv-intel/6.0.4 - intel - intel/18.0.1.163 - cray-libsci - - - - PrgEnv-intel/6.0.4 - intel - intel/18.0.2.199 - cray-libsci - - - - PrgEnv-intel - PrgEnv-gnu/6.0.4 - gcc - gcc/7.3.0 - cray-libsci - cray-libsci/18.03.1 - - - - PrgEnv-intel - PrgEnv-gnu/6.0.4 - gcc - gcc/7.3.0 - cray-libsci - cray-libsci/18.03.1 - - - - cray-netcdf-hdf5parallel - cray-hdf5-parallel - cray-parallel-netcdf - cray-netcdf/4.4.1.1.6 - cray-hdf5/1.10.1.1 - - - cray-netcdf-hdf5parallel - cray-netcdf-hdf5parallel/4.4.1.1.6 - cray-hdf5-parallel/1.10.1.1 - cray-parallel-netcdf/1.8.1.3 - - - - $CIME_OUTPUT_ROOT/$CASE/run - $CIME_OUTPUT_ROOT/$CASE/bld - 0.1 - - 1 - 1 - - - 64M - spread - threads - - - FALSE - - - yes - - - yes - - - - - - Cori. XC40 Cray system at NERSC. Haswell partition. os is CNL, 32 pes/node, batch system is SLURM - cori-knl-is-default - CNL - intel,gnu - mpt - acme - /project/projectdirs/acme - acme,m2830,m2833 - $ENV{SCRATCH}/acme_scratch/cori-haswell - /project/projectdirs/acme/inputdata - /project/projectdirs/acme/inputdata/atm/datm7 - $CIME_OUTPUT_ROOT/archive/$CASE - /project/projectdirs/acme/baselines/$COMPILER - /project/projectdirs/acme/tools/cprnc.cori/cprnc - 8 - e3sm_developer - nersc_slurm - e3sm - 32 - 32 - TRUE - - srun - - --label - -n {{ total_tasks }} - -c $SHELL{echo 64/`./xmlquery --value MAX_MPITASKS_PER_NODE`|bc} - $SHELL{if [ 32 -ge `./xmlquery --value MAX_MPITASKS_PER_NODE` ]; then echo "--cpu_bind=cores"; else echo "--cpu_bind=threads";fi;} - -m plane=$SHELL{echo `./xmlquery --value MAX_MPITASKS_PER_NODE`} - - - - /opt/modules/default/init/perl - /opt/modules/default/init/python - /opt/modules/default/init/sh - /opt/modules/default/init/csh - /opt/modules/default/bin/modulecmd perl - /opt/modules/default/bin/modulecmd python - module - module - - - PrgEnv-intel - PrgEnv-cray - PrgEnv-gnu - intel - cce - gcc - cray-parallel-netcdf - cray-parallel-hdf5 - pmi - cray-libsci - cray-mpich2 - cray-mpich - cray-netcdf - cray-hdf5 - cray-netcdf-hdf5parallel - craype-sandybridge - craype-ivybridge - craype - papi - cmake - cray-petsc - esmf - zlib - - - - craype - craype/2.5.14 - pmi/5.0.13 - - cray-mpich - cray-mpich/7.7.0 - - - - PrgEnv-intel/6.0.4 - intel - intel/18.0.1.163 - - - - PrgEnv-intel PrgEnv-gnu/6.0.4 - gcc - gcc/7.3.0 - cray-libsci - cray-libsci/18.03.1 - - - - craype-mic-knl - craype-haswell - - - - cray-netcdf-hdf5parallel - cray-hdf5-parallel - cray-parallel-netcdf - cray-netcdf/4.4.1.1.6 - cray-hdf5/1.10.1.1 - - - cray-netcdf-hdf5parallel - cray-netcdf-hdf5parallel/4.4.1.1.6 - cray-hdf5-parallel/1.10.1.1 - cray-parallel-netcdf/1.8.1.3 - - - - git - git - cmake - cmake/3.3.2 - - - - $CIME_OUTPUT_ROOT/$CASE/run - $CIME_OUTPUT_ROOT/$CASE/bld - 0.1 - - - 1 - 1 - - - 128M - spread - threads - FALSE - - - yes - - - - - - Cori. XC40 Cray system at NERSC. KNL partition. os is CNL, 68 pes/node (for now only use 64), batch system is SLURM - cori - CNL - intel,gnu,intel19 - mpt,impi - acme - /project/projectdirs/acme - acme,m2830,m2833 - $ENV{SCRATCH}/acme_scratch/cori-knl - /project/projectdirs/acme/inputdata - /project/projectdirs/acme/inputdata/atm/datm7 - $CIME_OUTPUT_ROOT/archive/$CASE - /project/projectdirs/acme/baselines/$COMPILER - /project/projectdirs/acme/tools/cprnc.cori/cprnc - 8 - e3sm_developer - nersc_slurm - e3sm - 128 - 64 - TRUE - - srun - - --label - -n {{ total_tasks }} - -c $SHELL{echo 272/`./xmlquery --value MAX_MPITASKS_PER_NODE`|bc} - $SHELL{if [ 68 -ge `./xmlquery --value MAX_MPITASKS_PER_NODE` ]; then echo "--cpu_bind=cores"; else echo "--cpu_bind=threads";fi;} - -m plane=$SHELL{echo `./xmlquery --value MAX_MPITASKS_PER_NODE`} - - - - /opt/modules/default/init/perl - /opt/modules/default/init/python - /opt/modules/default/init/sh - /opt/modules/default/init/csh - /opt/modules/default/bin/modulecmd perl - /opt/modules/default/bin/modulecmd python - module - module - - craype - craype-mic-knl - craype-haswell - PrgEnv-intel - PrgEnv-cray - PrgEnv-gnu - intel - cce - gcc - cray-parallel-netcdf - cray-parallel-hdf5 - pmi - cray-mpich2 - cray-mpich - cray-netcdf - cray-hdf5 - cray-netcdf-hdf5parallel - cray-libsci - papi - cmake - cray-petsc - esmf - zlib - - - craype - PrgEnv-intel - cray-mpich - craype-haswell - craype-mic-knl - - - - cray-mpich cray-mpich/7.7.0 - - - - cray-mpich impi/2018.up2 - - - - PrgEnv-intel/6.0.4 - intel - intel/18.0.1.163 - - - - PrgEnv-intel/6.0.4 - intel - intel/19.0.0.117 - - - - PrgEnv-intel PrgEnv-gnu/6.0.4 - gcc - gcc/7.3.0 - cray-libsci - cray-libsci/18.03.1 - - - - craype craype/2.5.14 - pmi - pmi/5.0.13 - craype-haswell - craype-mic-knl - - - - cray-netcdf-hdf5parallel - cray-hdf5-parallel - cray-parallel-netcdf - cray-netcdf/4.4.1.1.6 - cray-hdf5/1.10.1.1 - - - cray-netcdf-hdf5parallel - cray-netcdf-hdf5parallel/4.4.1.1.6 - cray-hdf5-parallel/1.10.1.1 - cray-parallel-netcdf/1.8.1.3 - - - - git - git - cmake - cmake/3.3.2 - - - - - - - $CIME_OUTPUT_ROOT/$CASE/run - $CIME_OUTPUT_ROOT/$CASE/bld - 0.1 - - 1 - 1 - - - 128M - spread - threads - FALSE - - - - disabled - - - ofi - gni - yes - /global/common/cori/software/libfabric/1.6.1/gnu/lib/libfabric.so - /usr/lib64/slurmpmi/libpmi.so - - - yes - 1 - - - 1 - - - - - - Stampede2. Intel skylake nodes at TACC. 48 cores per node, batch system is SLURM - .*stampede2.* - LINUX - intel,gnu - impi - $ENV{SCRATCH} - acme - $ENV{SCRATCH}/acme_scratch/stampede2 - $ENV{SCRATCH}/inputdata - $ENV{SCRATCH}/inputdata/atm/datm7 - $CIME_OUTPUT_ROOT/archive/$CASE - $ENV{SCRATCH}/baselines/$COMPILER - $ENV{SCRATCH}/tools/cprnc.cori/cprnc - 8 - e3sm_developer - slurm - e3sm - 96 - 48 - FALSE - - ibrun - - - /opt/apps/lmod/lmod/init/perl - /opt/apps/lmod/lmod/init/python - /opt/apps/lmod/lmod/init/sh - /opt/apps/lmod/lmod/init/csh - /opt/apps/lmod/lmod/libexec/lmod perl - /opt/apps/lmod/lmod/libexec/lmod python - module -q - module -q - - - - - - - intel/18.0.0 - - - - gcc/6.3.0 - - - - impi/18.0.0 - - - - hdf5/1.8.16 - netcdf/4.3.3.1 - - - phdf5/1.8.16 - parallel-netcdf/4.3.3.1 - pnetcdf/1.8.1 - - - git - cmake - autotools - xalt - - - - - - - $CIME_OUTPUT_ROOT/$CASE/run - $CIME_OUTPUT_ROOT/$CASE/bld - 0.1 - - 1 - 1 - - 128M - spread - threads - 1 - -l - - - - - Mac OS/X workstation or laptop - - Darwin - gnu - openmpi,mpich - $ENV{HOME}/projects/acme/scratch - $ENV{HOME}/projects/acme/cesm-inputdata - $ENV{HOME}/projects/acme/ptclm-data - $ENV{HOME}/projects/acme/scratch/archive/$CASE - $ENV{HOME}/projects/acme/baselines/$COMPILER - $CCSMROOT/tools/cprnc/build/cprnc - 4 - e3sm_developer - none - jnjohnson at lbl dot gov - 4 - 2 - - mpirun - - - - $ENV{HOME}/projects/acme/scratch/$CASE/run - $ENV{HOME}/projects/acme/scratch/$CASE/bld - - - - - - Linux workstation or laptop - none - LINUX - gnu - openmpi,mpich - $ENV{HOME}/projects/acme/scratch - $ENV{HOME}/projects/acme/cesm-inputdata - $ENV{HOME}/projects/acme/ptclm-data - $ENV{HOME}/projects/acme/scratch/archive/$CASE - $ENV{HOME}/projects/acme/baselines/$COMPILER - $CCSMROOT/tools/cprnc/build/cprnc - 4 - e3sm_developer - none - jayesh at mcs dot anl dot gov - 4 - 2 - - mpirun - - -np {{ total_tasks }} - - - - $ENV{HOME}/projects/acme/scratch/$CASE/run - $ENV{HOME}/projects/acme/scratch/$CASE/bld - - - - - - Linux workstation for Jenkins testing - (melvin|watson|s999964|climate|penn|sems) - LINUX - sonproxy.sandia.gov:80 - gnu,intel - openmpi - /sems-data-store/ACME/timings - .* - $ENV{HOME}/acme/scratch - /sems-data-store/ACME/inputdata - /sems-data-store/ACME/inputdata/atm/datm7 - $CIME_OUTPUT_ROOT/archive/$CASE - /sems-data-store/ACME/baselines/$COMPILER - /sems-data-store/ACME/cprnc/build.new/cprnc - 32 - e3sm_developer - none - jgfouca at sandia dot gov - 48 - 48 - - mpirun - - -np {{ total_tasks }} - --map-by ppr:{{ tasks_per_numa }}:socket:PE=$ENV{OMP_NUM_THREADS} --bind-to hwthread:overload-allowed - - - - /usr/share/Modules/init/python.py - /usr/share/Modules/init/perl.pm - /usr/share/Modules/init/sh - /usr/share/Modules/init/csh - /usr/bin/modulecmd python - /usr/bin/modulecmd perl - module - module - - - sems-env - acme-env - sems-git - acme-binutils - sems-python/2.7.9 - sems-cmake/2.8.12 - - - sems-gcc/7.3.0 - - - sems-intel/16.0.3 - - - sems-netcdf/4.4.1/exo - acme-pfunit/3.2.8/base - - - acme-openmpi/2.1.5/acme - acme-netcdf/4.4.1/acme - - - $CIME_OUTPUT_ROOT/$CASE/run - $CIME_OUTPUT_ROOT/$CASE/bld - 0.1 - 1000 - - - $ENV{SEMS_NETCDF_ROOT} - 64M - spread - threads - - - $ENV{SEMS_NETCDF_ROOT} - - - - - IBM Power 8 Testbed machine - white - LINUX - gnu - openmpi - $ENV{HOME}/projects/e3sm/scratch - $ENV{HOME}/projects/e3sm/cesm-inputdata - $ENV{HOME}/projects/e3sm/ptclm-data - $ENV{HOME}/projects/e3sm/scratch/archive/$CASE - $ENV{HOME}/projects/e3sm/baselines/$COMPILER - $CCSMROOT/tools/cprnc/build/cprnc - 32 - e3sm_developer - lsf - mdeakin at sandia dot gov - 4 - 1 - - mpirun - - - - /usr/share/Modules/init/sh - /usr/share/Modules/init/python.py - module - /usr/bin/modulecmd python - - devpack/20181011/openmpi/2.1.2/gcc/7.2.0/cuda/9.2.88 - - - $ENV{HOME}/projects/e3sm/scratch/$CASE/run - $ENV{HOME}/projects/e3sm/scratch/$CASE/bld - - $ENV{NETCDF_ROOT} - /ascldap/users/jgfouca/packages/netcdf-fortran-4.4.4-white - $SRCROOT - - - - - Skylake Testbed machine - blake - LINUX - intel18 - openmpi - $ENV{HOME}/projects/e3sm/scratch - $ENV{HOME}/projects/e3sm/cesm-inputdata - $ENV{HOME}/projects/e3sm/ptclm-data - $ENV{HOME}/projects/e3sm/scratch/archive/$CASE - $ENV{HOME}/projects/e3sm/baselines/$COMPILER - $CCSMROOT/tools/cprnc/build/cprnc - 48 - e3sm_developer - slurm - mdeakin at sandia dot gov - 48 - 48 - - mpirun - - - - /usr/share/Modules/init/sh - /usr/share/Modules/init/python.py - module - module - - zlib/1.2.11 - intel/compilers/18.1.163 - openmpi/2.1.2/intel/18.1.163 - hdf5/1.10.1/openmpi/2.1.2/intel/18.1.163 - netcdf-exo/4.4.1.1/openmpi/2.1.2/intel/18.1.163 - - - $ENV{HOME}/projects/e3sm/scratch/$CASE/run - $ENV{HOME}/projects/e3sm/scratch/$CASE/bld - - $ENV{NETCDF_ROOT} - $ENV{NETCDFF_ROOT} - - - - - Linux workstation for ANL - compute.*mcs.anl.gov - LINUX - gnu - mpich - $ENV{HOME}/acme/scratch - /home/climate1/acme/inputdata - /home/climate1/acme/inputdata/atm/datm7 - $CIME_OUTPUT_ROOT/archive/$CASE - /home/climate1/acme/baselines/$COMPILER - /home/climate1/acme/cprnc/build/cprnc - make - 32 - e3sm_developer - none - jgfouca at sandia dot gov - 32 - 32 - - mpirun - - -l -np {{ total_tasks }} - - - - /software/common/adm/packages/softenv-1.6.2/etc/softenv-load.csh - /software/common/adm/packages/softenv-1.6.2/etc/softenv-load.sh - source /software/common/adm/packages/softenv-1.6.2/etc/softenv-aliases.csh ; soft - source /software/common/adm/packages/softenv-1.6.2/etc/softenv-aliases.sh ; soft - - +gcc-6.2.0 - +szip-2.1-gcc-6.2.0 - +cmake-2.8.12 - - - +netcdf-4.4.1c-4.2cxx-4.4.4f-serial-gcc6.2.0 - - - +mpich-3.2-gcc-6.2.0 - +hdf5-1.8.16-gcc-6.2.0-mpich-3.2-parallel - +netcdf-4.4.1c-4.2cxx-4.4.4f-parallel-gcc6.2.0-mpich-3.2 - +pnetcdf-1.6.1-gcc-6.2.0-mpich-3.2 - - - $CIME_OUTPUT_ROOT/$CASE/run - $CIME_OUTPUT_ROOT/$CASE/bld - - $SHELL{dirname $(dirname $(which ncdump))} - - - - /soft/apps/packages/climate/hdf5/1.8.16-serial/gcc-6.2.0/lib:$ENV{LD_LIBRARY_PATH} - - - $SHELL{dirname $(dirname $(which h5dump))} - - $SHELL{dirname $(dirname $(which pnetcdf_version))} - - - 64M - - - - - SNL clust - (skybridge|chama) - LINUX - wwwproxy.sandia.gov:80 - intel - openmpi - fy150001 - /projects/ccsm/timings - .* - /gpfs1/$USER/acme_scratch/sandiatoss3 - /projects/ccsm/inputdata - /projects/ccsm/inputdata/atm/datm7 - $CIME_OUTPUT_ROOT/archive/$CASE - /projects/ccsm/ccsm_baselines/$COMPILER - /projects/ccsm/cprnc/build.toss3/cprnc_wrap - 8 - e3sm_integration - slurm - jgfouca at sandia dot gov - 16 - 16 - TRUE - - mpiexec - - --n {{ total_tasks }} - --map-by ppr:{{ tasks_per_numa }}:socket:PE=$ENV{OMP_NUM_THREADS} --bind-to core - - - - - - - /usr/share/lmod/lmod/init/python.py - /usr/share/lmod/lmod/init/perl.pm - /usr/share/lmod/lmod/init/sh - /usr/share/lmod/lmod/init/csh - /usr/share/lmod/lmod/libexec/lmod python - /usr/share/lmod/lmod/libexec/lmod perl - module - module - - - sems-env - sems-git - sems-python/2.7.9 - sems-cmake - gnu/4.9.2 - sems-intel/17.0.0 - - - sems-openmpi/1.10.5 - sems-netcdf/4.4.1/exo_parallel - - - sems-netcdf/4.4.1/exo - - - /gscratch/$USER/acme_scratch/sandiatoss3/$CASE/run - $CIME_OUTPUT_ROOT/$CASE/bld - - - 0.1 - - - $ENV{SEMS_NETCDF_ROOT} - $ENV{SEMS_NETCDF_ROOT}/include - $ENV{SEMS_NETCDF_ROOT}/lib - 64M - - - $ENV{SEMS_NETCDF_ROOT} - - - - - SNL clust - ghost-login - LINUX - wwwproxy.sandia.gov:80 - intel - openmpi - fy150001 - - /gscratch/$USER/acme_scratch/ghost - /projects/ccsm/inputdata - /projects/ccsm/inputdata/atm/datm7 - $CIME_OUTPUT_ROOT/archive/$CASE - /projects/ccsm/ccsm_baselines/$COMPILER - /projects/ccsm/cprnc/build.toss3/cprnc_wrap - 8 - e3sm_integration - slurm - jgfouca at sandia dot gov - 36 - 36 - TRUE - - mpiexec - - --n {{ total_tasks }} - --map-by ppr:{{ tasks_per_numa }}:socket:PE=$ENV{OMP_NUM_THREADS} --bind-to core - - - - - - - /usr/share/lmod/lmod/init/python.py - /usr/share/lmod/lmod/init/perl.pm - /usr/share/lmod/lmod/init/sh - /usr/share/lmod/lmod/init/csh - /usr/share/lmod/lmod/libexec/lmod python - /usr/share/lmod/lmod/libexec/lmod perl - module - module - - - sems-env - sems-git - sems-python/2.7.9 - sems-cmake - gnu/4.9.2 - sems-intel/16.0.2 - mkl/16.0 - sems-netcdf/4.4.1/exo_parallel - - - sems-openmpi/1.10.5 - - - $CIME_OUTPUT_ROOT/$CASE/run - $CIME_OUTPUT_ROOT/$CASE/bld - - - - $ENV{SEMS_NETCDF_ROOT} - $ENV{SEMS_NETCDF_ROOT}/include - $ENV{SEMS_NETCDF_ROOT}/lib - 64M - - - $ENV{SEMS_NETCDF_ROOT} - - - - - ANL/LCRC Linux Cluster - blogin.*.lcrc.anl.gov - LINUX - gnu,pgi,intel,nag - mvapich,mpich,openmpi - ACME - /lcrc/project/$PROJECT/$USER/acme_scratch - /home/ccsm-data/inputdata - /home/ccsm-data/inputdata/atm/datm7 - /lcrc/project/ACME/$USER/archive/$CASE - /lcrc/group/acme/acme_baselines/blues/$COMPILER - /home/ccsm-data/tools/cprnc - 4 - e3sm_integration - pbs - acme - 16 - 16 - TRUE - - mpiexec - - -n {{ total_tasks }} - - - - mpiexec - - -n {{ total_tasks }} - - - - - - - /etc/profile.d/a_softenv.csh - /etc/profile.d/a_softenv.sh - soft - soft - - +cmake-2.8.12 - +python-2.7 - - - +gcc-5.3.0 - +hdf5-1.10.0-gcc-5.3.0-serial - +netcdf-c-4.4.0-f77-4.4.3-gcc-5.3.0-serial - - - +gcc-5.2 - +netcdf-4.3.3.1-gnu5.2-serial - - - +mvapich2-2.2b-gcc-5.3.0 - +pnetcdf-1.6.1-gcc-5.3.0-mvapich2-2.2b - - - +mvapich2-2.2b-gcc-5.2 - - - +intel-15.0 - +mkl-11.2.1 - - - +mvapich2-2.2b-intel-15.0 - +pnetcdf-1.6.1-mvapich2-2.2a-intel-15.0 - - - +pgi-15.7 - +binutils-2.27 - +netcdf-c-4.4.1-f77-4.4.4-pgi-15.7-serial - - - +mvapich2-2.2-pgi-15.7 - +pnetcdf-1.7.0-pgi-15.7-mvapich2-2.2 - - - +nag-6.0 - +hdf5-1.8.12-serial-nag - +netcdf-4.3.1-serial-nag - - - +mpich3-3.1.4-nag-6.0 - +pnetcdf-1.6.1-mpich-3.1.4-nag-6.0 - - - $CIME_OUTPUT_ROOT/$CASE/run - $CIME_OUTPUT_ROOT/$CASE/bld - 0.1 - - $SHELL{dirname $(dirname $(which ncdump))} - - - $SHELL{dirname $(dirname $(which pnetcdf_version))} - - - 64M - - - - - ANL/LCRC Linux Cluster - blueslogin.*.lcrc.anl.gov - LINUX - intel,gnu - mvapich,openmpi - condo - /lcrc/group/acme - .* - /lcrc/group/acme/$USER/acme_scratch/anvil - /home/ccsm-data/inputdata - /home/ccsm-data/inputdata/atm/datm7 - /lcrc/group/acme/$USER/archive/$CASE - /lcrc/group/acme/acme_baselines/$COMPILER - /lcrc/group/acme/tools/cprnc/cprnc - 8 - e3sm_integration - slurm - E3SM - 36 - 36 - FALSE - - srun - - -l -n {{ total_tasks }} - - - - - - - /home/software/spack-0.10.1/opt/spack/linux-centos7-x86_64/gcc-4.8.5/lmod-7.4.9-ic63herzfgw5u3na5mdtvp3nwxy6oj2z/lmod/lmod/init/sh;export MODULEPATH=/blues/gpfs/software/centos7/spack-0.12.1/share/spack/lmod/linux-centos7-x86_64/Core - /home/software/spack-0.10.1/opt/spack/linux-centos7-x86_64/gcc-4.8.5/lmod-7.4.9-ic63herzfgw5u3na5mdtvp3nwxy6oj2z/lmod/lmod/init/csh;setenv MODULEPATH /blues/gpfs/software/centos7/spack-0.12.1/share/spack/lmod/linux-centos7-x86_64/Core - /home/software/spack-0.10.1/opt/spack/linux-centos7-x86_64/gcc-4.8.5/lmod-7.4.9-ic63herzfgw5u3na5mdtvp3nwxy6oj2z/lmod/lmod/init/env_modules_python.py - export MODULEPATH=/blues/gpfs/software/centos7/spack-0.12.1/share/spack/lmod/linux-centos7-x86_64/Core;/home/software/spack-0.10.1/opt/spack/linux-centos7-x86_64/gcc-4.8.5/lmod-7.4.9-ic63herzfgw5u3na5mdtvp3nwxy6oj2z/lmod/lmod/libexec/lmod python - module - module - - - - - intel/17.0.4-74uvhji - intel-mkl/2017.3.196-v7uuj6z - netcdf/4.4.1-magkugi - netcdf-fortran/4.4.4-7obsouy - mvapich2/2.2-verbs-lxc4y7i - cmake - - - intel/17.0.0-yil23id - intel-mkl/2017.0.098-gqttdpp - netcdf/4.4.1-qy35uvc - netcdf-fortran/4.4.4-2jrvsdv - openmpi/2.0.1-verbs-id2i464 - cmake/3.14.1-ymmizo4 - - - gcc/8.2.0-g7hppkz - intel-mkl/2018.4.274-2amycpi - hdf5/1.8.16-mz7lmxh - netcdf/4.4.1-xkjcghm - netcdf-cxx/4.2-kyva3os - netcdf-fortran/4.4.4-mpstomu - - - mvapich2/2.3.1-verbs-wcfqbl5 - - - openmpi/3.1.3-verbs-q4swt25 - - - $CIME_OUTPUT_ROOT/$CASE/run - $CIME_OUTPUT_ROOT/$CASE/bld - 0.1 - 1000 - - $SHELL{which nc-config | xargs dirname | xargs dirname} - $SHELL{which nf-config | xargs dirname | xargs dirname} - /lcrc/group/acme/soft/perl/5.26.0/bin:$ENV{PATH} - - - /blues/gpfs/home/software/climate/pnetcdf/1.6.1/intel-17.0.4/mvapich2-2.2-verbs - - - 1 - 1 - 2 - - - 64M - - - granularity=thread,scatter - 1 - - - spread - threads - - - - - ANL/LCRC Cluster, Cray CS400, 352-nodes Xeon Phi 7230 KNLs 64C/1.3GHz + 672-nodes Xeon E5-2695v4 Broadwells 36C/2.10GHz, Intel Omni-Path network, SLURM batch system, Lmod module environment. - beboplogin.* - LINUX - intel,gnu - impi,mpich,mvapich,openmpi - acme - /lcrc/group/acme/$USER/acme_scratch/bebop - /home/ccsm-data/inputdata - /home/ccsm-data/inputdata/atm/datm7 - $CIME_OUTPUT_ROOT/archive/$CASE - /lcrc/group/acme/acme_baselines/bebop/$COMPILER - /lcrc/group/acme/tools/cprnc/cprnc - 8 - e3sm_integration - slurm - E3SM - 36 - 36 - TRUE - - mpirun - - -l -n {{ total_tasks }} - - - - - - - /home/software/spack-0.10.1/opt/spack/linux-centos7-x86_64/gcc-4.8.5/lmod-7.4.9-ic63herzfgw5u3na5mdtvp3nwxy6oj2z/lmod/lmod/init/sh - /home/software/spack-0.10.1/opt/spack/linux-centos7-x86_64/gcc-4.8.5/lmod-7.4.9-ic63herzfgw5u3na5mdtvp3nwxy6oj2z/lmod/lmod/init/csh - /home/software/spack-0.10.1/opt/spack/linux-centos7-x86_64/gcc-4.8.5/lmod-7.4.9-ic63herzfgw5u3na5mdtvp3nwxy6oj2z/lmod/lmod/init/env_modules_python.py - /home/software/spack-0.10.1/opt/spack/linux-centos7-x86_64/gcc-4.8.5/lmod-7.4.9-ic63herzfgw5u3na5mdtvp3nwxy6oj2z/lmod/lmod/libexec/lmod python - module - module - - - - - intel/17.0.4-74uvhji - intel-mkl/2017.3.196-jyjmyut - - - gcc/7.1.0-4bgguyp - - - intel-mpi/2017.3-dfphq6k - parallel-netcdf/1.6.1 - - - mvapich2/2.2-n6lclff - parallel-netcdf/1.6.1-mvapich2.2 - - - cmake - netcdf/4.4.1.1-prsuusl - netcdf-fortran/4.4.4-ojwazvy - - - $CIME_OUTPUT_ROOT/$CASE/run - $CIME_OUTPUT_ROOT/$CASE/bld - 0.1 - - $SHELL{which nc-config | xargs dirname | xargs dirname} - $SHELL{which nf-config | xargs dirname | xargs dirname} - /lcrc/group/acme/soft/perl/5.26.0/bin:$ENV{PATH} - - - $SHELL{which pnetcdf_version | xargs dirname | xargs dirname} - - - 128M - spread - threads - - - shm:tmi - - - - - ANL IBM BG/Q, os is BGQ, 16 cores/node, batch system is cobalt - cetus - BGQ - ibm - ibm - ClimateEnergy_2 - ClimateEnergy - /projects/$PROJECT/$USER - /projects/ccsm/inputdata - /projects/ccsm/inputdata/atm/datm7 - /projects/$PROJECT/$USER/archive/$CASE - /projects/ccsm/ccsm_baselines//$COMPILER - /projects/ccsm/tools/cprnc/cprnc - 8 - e3sm_developer - cobalt - jayesh -at- mcs.anl.gov - 64 - 4 - TRUE - - /usr/bin/runjob - - --label short - --ranks-per-node $MAX_MPITASKS_PER_NODE - --np {{ total_tasks }} - --block $COBALT_PARTNAME $LOCARGS - $ENV{BGQ_SMP_VARS} - $ENV{BGQ_STACKSIZE} - - - - /etc/profile.d/00softenv.csh - /etc/profile.d/00softenv.sh - soft - soft - - +mpiwrapper-xl - @ibm-compilers-2016-05 - +cmake - +python - - - $CIME_OUTPUT_ROOT/$CASE/run - $CIME_OUTPUT_ROOT/$CASE/bld - 0.1 - - 10000 - - - - - --envs BG_THREADLAYOUT=1 XL_BG_SPREADLAYOUT=YES OMP_DYNAMIC=FALSE OMP_NUM_THREADS=$ENV{OMP_NUM_THREADS} - - - --envs OMP_STACKSIZE=64M - - - --envs OMP_STACKSIZE=16M - - - - - LLNL Linux Cluster, Linux (pgi), 16 pes/node, batch system is Slurm - LINUX - intel - mpich - /p/lscratchh/$USER - /usr/gdata/climdat/ccsm3data/inputdata - /usr/gdata/climdat/ccsm3data/inputdata/atm/datm7 - /p/lscratchh/$CCSMUSER/archive/$CASE - /p/lscratchh/$CCSMUSER/ccsm_baselines/$COMPILER - /p/lscratchd/ma21/ccsm3data/tools/cprnc/cprnc - 8 - lc_slurm - donahue5 -at- llnl.gov - 16 - 16 - - - - - srun - - - /usr/share/lmod/lmod/init/env_modules_python.py - /usr/share/lmod/lmod/init/perl - /usr/share/lmod/lmod/init/sh - /usr/share/lmod/lmod/init/csh - module - module - /usr/share/lmod/lmod/libexec/lmod python - /usr/share/lmod/lmod/libexec/lmod perl - - python - git - intel/18.0.1 - pnetcdf/1.9.0 - mvapich2 - mvapich2/2.2 - netcdf-fortran/4.4.4 - pnetcdf/1.9.0 - - - /p/lscratchh/$CCSMUSER/ACME/$CASE/run - /p/lscratchh/$CCSMUSER/$CASE/bld - - /usr/tce/packages/netcdf-fortran/netcdf-fortran-4.4.4-intel-18.0.1/ - /usr/tce/packages/netcdf-fortran/netcdf-fortran-4.4.4-intel-18.0.1/ - - - /usr/tce/packages/pnetcdf/pnetcdf-1.9.0-intel-18.0.1-mvapich2-2.2/ - - - - - LLNL Linux Cluster, Linux (pgi), 36 pes/node, batch system is Slurm - LINUX - intel - mpich - /p/lscratchh/$USER - /usr/gdata/climdat/ccsm3data/inputdata - /usr/gdata/climdat/ccsm3data/inputdata/atm/datm7 - /p/lscratchh/$CCSMUSER/archive/$CASE - /p/lscratchh/$CCSMUSER/ccsm_baselines/$COMPILER - /p/lscratchd/ma21/ccsm3data/tools/cprnc/cprnc - 8 - lc_slurm - donahue5 -at- llnl.gov - 36 - 36 - - - - - srun - - - /usr/share/lmod/lmod/init/env_modules_python.py - /usr/share/lmod/lmod/init/perl - /usr/share/lmod/lmod/init/sh - /usr/share/lmod/lmod/init/csh - module - module - /usr/share/lmod/lmod/libexec/lmod python - /usr/share/lmod/lmod/libexec/lmod perl - - python - git - intel/18.0.1 - pnetcdf/1.9.0 - mvapich2 - mvapich2/2.2 - netcdf-fortran/4.4.4 - pnetcdf/1.9.0 - - - /p/lscratchh/$CCSMUSER/ACME/$CASE/run - /p/lscratchh/$CCSMUSER/$CASE/bld - - /usr/tce/packages/netcdf-fortran/netcdf-fortran-4.4.4-intel-18.0.1/ - /usr/tce/packages/netcdf-fortran/netcdf-fortran-4.4.4-intel-18.0.1/ - - - /usr/tce/packages/pnetcdf/pnetcdf-1.9.0-intel-18.0.1-mvapich2-2.2/ - - - - - ANL IBM BG/Q, os is BGQ, 16 cores/node, batch system is cobalt - mira.* - BGQ - ibm - ibm - ClimateEnergy_2 - /projects/$PROJECT - ClimateEnergy_2 - /projects/$PROJECT/$USER - /projects/ccsm/inputdata - /projects/ccsm/inputdata/atm/datm7 - /projects/$PROJECT/$USER/archive/$CASE - /projects/ccsm/ccsm_baselines//$COMPILER - /projects/ccsm/tools/cprnc/cprnc - 8 - e3sm_developer - cobalt - mickelso -at- mcs.anl.gov - 64 - 4 - TRUE - - /usr/bin/runjob - - --label short - --ranks-per-node $MAX_MPITASKS_PER_NODE - --np {{ total_tasks }} - --block $COBALT_PARTNAME $LOCARGS - $ENV{BGQ_SMP_VARS} - $ENV{BGQ_STACKSIZE} - - - - /etc/profile.d/00softenv.csh - /etc/profile.d/00softenv.sh - soft - soft - - +mpiwrapper-xl - @ibm-compilers-2016-05 - +cmake - +python - - - $CIME_OUTPUT_ROOT/$CASE/run - $CIME_OUTPUT_ROOT/$CASE/bld - 0.1 - - 10000 - - - - - --envs BG_THREADLAYOUT=1 XL_BG_SPREADLAYOUT=YES OMP_DYNAMIC=FALSE OMP_NUM_THREADS=$ENV{OMP_NUM_THREADS} - - - --envs OMP_STACKSIZE=64M - - - --envs OMP_STACKSIZE=16M - - - - - ALCF Cray XC40 KNL, os is CNL, 64 pes/node, batch system is cobalt - theta.* - CNL - intel,gnu,cray - mpt - /projects/$PROJECT - ClimateEnergy_3,OceanClimate_2 - /projects/$PROJECT/$USER - /projects/ccsm/acme/inputdata - /projects/ccsm/acme/inputdata/atm/datm7 - $CIME_OUTPUT_ROOT/archive/$CASE - /projects/$PROJECT/acme/baselines/$COMPILER - /projects/ccsm/acme/tools/cprnc/cprnc - 8 - e3sm_developer - cobalt_theta - E3SM - 128 - 64 - TRUE - - aprun - - -n {{ total_tasks }} - -N $SHELL{if [ `./xmlquery --value MAX_MPITASKS_PER_NODE` -gt `./xmlquery --value TOTAL_TASKS` ];then echo `./xmlquery --value TOTAL_TASKS`;else echo `./xmlquery --value MAX_MPITASKS_PER_NODE`;fi;} - --cc depth -d $SHELL{echo `./xmlquery --value MAX_TASKS_PER_NODE`/`./xmlquery --value MAX_MPITASKS_PER_NODE`|bc} -j $SHELL{if [ 64 -ge `./xmlquery --value MAX_TASKS_PER_NODE` ];then echo 1;else echo `./xmlquery --value MAX_TASKS_PER_NODE`/64|bc;fi;} - $ENV{SMP_VARS} $ENV{labeling} - - - - /opt/modules/default/init/perl.pm - /opt/modules/default/init/python.py - /opt/modules/default/init/sh - /opt/modules/default/init/csh - /opt/modules/default/bin/modulecmd perl - /opt/modules/default/bin/modulecmd python - module - module - - craype-mic-knl - PrgEnv-intel - PrgEnv-cray - PrgEnv-gnu - intel - cce - cray-mpich - cray-parallel-netcdf - cray-hdf5-parallel - cray-hdf5 - cray-netcdf - cray-netcdf-hdf5parallel - cray-libsci - craype - - - craype/2.5.12 - - - intel/18.0.0.128 - PrgEnv-intel/6.0.4 - - - cce/8.6.2 - PrgEnv-cray/6.0.4 - - - gcc/7.3.0 - PrgEnv-gnu/6.0.4 - - - cray-libsci/17.09.1 - - - craype-mic-knl - cray-mpich/7.6.2 - - - cray-netcdf/4.4.1.1.3 - cray-parallel-netcdf/1.8.1.3 - - - cray-netcdf/4.4.1.1.3 - - - $CIME_OUTPUT_ROOT/$CASE/run - $CIME_OUTPUT_ROOT/$CASE/bld - 0.1 - - 1 - 1 - - /projects/ccsm/acme/tools/mpas - 2 - - - - - -e OMP_NUM_THREADS=$ENV{OMP_NUM_THREADS} -e OMP_STACKSIZE=128M -e KMP_AFFINITY=granularity=thread,scatter - - - -e OMP_NUM_THREADS=$ENV{OMP_NUM_THREADS} -e OMP_STACKSIZE=128M -e OMP_PROC_BIND=spread -e OMP_PLACES=threads - - - -e PMI_LABEL_ERROUT=1 - - - - - ANL experimental/evaluation cluster, batch system is cobalt - jlse.* - LINUX - intel,gnu - mpich - $ENV{HOME}/acme/scratch - /home/azamat/acme/inputdata - /home/azamat/acme/inputdata/atm/datm7 - $CIME_OUTPUT_ROOT/archive/$CASE - $ENV{HOME}/acme/baselines/$COMPILER - /home/azamat/acme/tools/cprnc - 8 - acme_developer - cobalt_theta - e3sm - 128 - 64 - FALSE - - mpirun - - -n $TOTALPES - - - - /etc/bashrc - source - - /soft/compilers/intel/compilers_and_libraries/linux/bin/compilervars.sh intel64 - - - $CIME_OUTPUT_ROOT/$CASE/run - $CIME_OUTPUT_ROOT/$CASE/bld - - 1 - 1 - 1 - 1 - /home/azamat/perl5/bin:$ENV{PATH} - /home/azamat/perl5/lib/perl5 - /home/azamat/perl5 - "--install_base \"/home/azamat/perl5\"" - "INSTALL_BASE=/home/azamat/perl5" - - - /home/azamat/soft/netcdf/4.3.3.1c-4.2cxx-4.4.2f/intel18 - /home/azamat/soft/pnetcdf/1.6.1/intel18 - 10 - core - - - /home/azamat/soft/netcdf/4.3.3.1c-4.2cxx-4.4.2f/gnu-arm - /home/azamat/soft/pnetcdf/1.6.1/gnu-arm - - - verbose,granularity=thread,scatter - 256M - - - spread - threads - 256M - - - - - PNL cluster, OS is Linux, batch system is SLURM - sooty - LINUX - intel,pgi - mvapich2 - /lustre/$USER/cime_output_root - /lustre/climate/csmdata/ - /lustre/climate/csmdata/atm/datm7 - /lustre/$USER/archive/$CASE - /lustre/climate/acme_baselines/$COMPILER - /lustre/climate/acme_baselines/cprnc/cprnc - 8 - slurm - balwinder.singh -at- pnnl.gov - 8 - 8 - FALSE - - - - - srun - - --mpi=none - --ntasks={{ total_tasks }} - --cpu_bind=sockets --cpu_bind=verbose - --kill-on-bad-exit - - - - /share/apps/modules/Modules/3.2.10/init/perl.pm - /share/apps/modules/Modules/3.2.10/init/python.py - /etc/profile.d/modules.csh - /etc/profile.d/modules.sh - /share/apps/modules/Modules/3.2.10/bin/modulecmd perl - /share/apps/modules/Modules/3.2.10/bin/modulecmd python - module - module - - - - - perl/5.20.0 - cmake/3.3.0 - python/2.7.8 - svn/1.8.13 - - - intel/15.0.1 - mkl/15.0.1 - - - pgi/14.10 - - - mvapich2/2.1 - - - netcdf/4.3.2 - - - /lustre/$USER/csmruns/$CASE/run - /lustre/$USER/csmruns/$CASE/bld - - $ENV{MKLROOT} - $ENV{NETCDF_LIB}/../ - 64M - - - - - PNNL Intel KNC cluster, OS is Linux, batch system is SLURM - glogin - LINUX - intel - impi,mvapich2 - /dtemp/$PROJECT/$USER - /dtemp/st49401/sing201/acme/inputdata/ - /dtemp/st49401/sing201/acme/inputdata/atm/datm7 - $CIME_OUTPUT_ROOT/archive/$CASE - $CIME_OUTPUT_ROOT/acme/acme_baselines - $CIME_OUTPUT_ROOT/acme/acme_baselines/cprnc/cprnc - 8 - slurm - balwinder.singh -at- pnnl.gov - 16 - 16 - TRUE - - - - - mpirun - - -np {{ total_tasks }} - - - - srun - - --mpi=none - --ntasks={{ total_tasks }} - --cpu_bind=sockets --cpu_bind=verbose - --kill-on-bad-exit - - - - /opt/lmod/7.8.4/init/env_modules_python.py - /etc/profile.d/modules.csh - /etc/profile.d/modules.sh - /opt/lmod/7.8.4/libexec/lmod python - module - module - - - - - python/2.7.9 - - - intel/ips_18 - mkl/14.0 - - - impi/4.1.2.040 - - - mvapich2/1.9 - - - netcdf/4.3.0 - - - $CIME_OUTPUT_ROOT/csmruns/$CASE/run - $CIME_OUTPUT_ROOT/csmruns/$CASE/bld - - 64M - $ENV{NETCDF_ROOT} - - - $ENV{MLIBHOME} - intel - - - - - PNL Haswell cluster, OS is Linux, batch system is SLURM - constance - LINUX - intel,pgi,nag - mvapich2,openmpi,intelmpi,mvapich - /pic/scratch/$USER - /pic/projects/climate/csmdata/ - /pic/projects/climate/csmdata/atm/datm7 - /pic/scratch/$USER/archive/$CASE - /pic/projects/climate/acme_baselines/$COMPILER - /pic/projects/climate/acme_baselines/cprnc/cprnc - 8 - slurm - balwinder.singh -at- pnnl.gov - 24 - 24 - FALSE - - - - - srun - - --mpi=none - --ntasks={{ total_tasks }} - --cpu_bind=sockets --cpu_bind=verbose - --kill-on-bad-exit - - - - srun - - --ntasks={{ total_tasks }} - --cpu_bind=sockets --cpu_bind=verbose - --kill-on-bad-exit - - - - mpirun - - -n {{ total_tasks }} - - - - mpirun - - -n {{ total_tasks }} - - - - /share/apps/modules/Modules/3.2.10/init/perl.pm - /share/apps/modules/Modules/3.2.10/init/python.py - /etc/profile.d/modules.csh - /etc/profile.d/modules.sh - /share/apps/modules/Modules/3.2.10/bin/modulecmd perl - /share/apps/modules/Modules/3.2.10/bin/modulecmd python - module - module - - - - - perl/5.20.0 - cmake/3.3.0 - python/2.7.8 - - - intel/15.0.1 - mkl/15.0.1 - - - pgi/14.10 - - - nag/6.0 - mkl/15.0.1 - - - mvapich2/2.1 - - - mvapich2/2.1 - - - mvapich2/2.1 - - - mvapich2/2.3b - - - intelmpi/5.0.1.035 - - - openmpi/1.8.3 - - - netcdf/4.3.2 - - - netcdf/4.3.2 - - - netcdf/4.4.1.1 - - - /pic/scratch/$USER/csmruns/$CASE/run - /pic/scratch/$USER/csmruns/$CASE/bld - - 64M - $ENV{NETCDF_LIB}/../ - - - $ENV{MLIB_LIB} - - - $ENV{MLIB_LIB} - - - - - PNL E3SM Intel Xeon Gold 6148(Skylake) nodes, OS is Linux, SLURM - compy - LINUX - intel,pgi - mvapich2 - /compyfs/$USER/e3sm_scratch - /compyfs/inputdata - /compyfs/inputdata/atm/datm7 - /compyfs/$USER/e3sm_scratch/archive/$CASE - /compyfs/e3sm_baselines/$COMPILER - /compyfs/e3sm_baselines/cprnc/cprnc - 8 - slurm - bibi.mathew -at- pnnl.gov - 40 - 40 - TRUE - - - - - srun - - --mpi=none - --ntasks={{ total_tasks }} - --cpu_bind=sockets --cpu_bind=verbose - --kill-on-bad-exit - - - - /share/apps/modules/init/perl.pm - /share/apps/modules/init/python.py - /etc/profile.d/modules.csh - /etc/profile.d/modules.sh - /share/apps/modules/bin/modulecmd perl - /share/apps/modules/bin/modulecmd python - module - module - - - - - intel/19.0.3 - - - pgi/18.10 - - - mvapich2/2.3.1 - - - netcdf/4.6.3 - pnetcdf/1.9.0 - mkl/2019u3 - - - $CIME_OUTPUT_ROOT/$CASE/run - $CIME_OUTPUT_ROOT/$CASE/bld - - 64M - $ENV{NETCDF_ROOT}/ - - - $ENV{MKLROOT} - - - - - ORNL XK6, os is Linux, 32 pes/node, batch system is PBS - oic5 - LINUX - gnu - mpich,openmpi - /home/$USER/models/ACME - /home/zdr/models/ccsm_inputdata - /home/zdr/models/ccsm_inputdata/atm/datm7 - /home/$USER/models/ACME/run/archive/$CASE - 32 - e3sm_developer - pbs - dmricciuto - 32 - 32 - - /projects/cesm/devtools/mpich-3.0.4-gcc4.8.1/bin/mpirun - - -np {{ total_tasks }} - --hostfile $ENV{PBS_NODEFILE} - - - - - - - /home/$USER/models/ACME/run/$CASE/run - /home/$USER/models/ACME/run/$CASE/bld - - - - OR-CONDO, CADES-CCSI, os is Linux, 16 pes/nodes, batch system is PBS - or-condo - LINUX - gnu,intel - openmpi - /lustre/or-hydra/cades-ccsi/scratch/$USER - /lustre/or-hydra/cades-ccsi/proj-shared/project_acme/ACME_inputdata - /lustre/or-hydra/cades-ccsi/proj-shared/project_acme/ACME_inputdata/atm/datm7 - $CIME_OUTPUT_ROOT/archive/$CASE - /lustre/or-hydra/cades-ccsi/proj-shared/project_acme/baselines/$COMPILER - /lustre/or-hydra/cades-ccsi/proj-shared/tools/cprnc.orcondo - 4 - e3sm_developer - pbs - yinj -at- ornl.gov - 32 - 32 - FALSE - - mpirun - - -np {{ total_tasks }} - --hostfile $ENV{PBS_NODEFILE} - - - - - - - /usr/share/Modules/init/sh - /usr/share/Modules/init/csh - /usr/share/Modules/init/perl.pm - /usr/share/Modules/init/python.py - module - module - /usr/bin/modulecmd perl - /usr/bin/modulecmd python - - - - - PE-gnu - - - mkl/2017 - /lustre/or-hydra/cades-ccsi/proj-shared/tools/cmake/3.6.1 - python/2.7.12 - /lustre/or-hydra/cades-ccsi/proj-shared/tools/nco/4.6.4 - hdf5-parallel/1.8.17 - netcdf-hdf5parallel/4.3.3.1 - pnetcdf/1.9.0 - - - - - $CIME_OUTPUT_ROOT/$CASE/run - $CIME_OUTPUT_ROOT/$CASE/bld - - - /software/user_tools/current/cades-ccsi/petsc4pf/openmpi-1.10-gcc-5.3 - - - - - ORNL XK6, os is CNL, 16 pes/node, batch system is PBS - titan - Received node event ec_node - CNL - pgi,pgiacc,intel,cray - mpich - cli115 - $ENV{PROJWORK}/$PROJECT - cli106,cli115,cli127,cli133,csc190 - $ENV{HOME}/acme_scratch/$PROJECT - /lustre/atlas1/cli900/world-shared/cesm/inputdata - /lustre/atlas1/cli900/world-shared/cesm/inputdata/atm/datm7 - $ENV{MEMBERWORK}/$PROJECT/archive/$CASE - /lustre/atlas1/cli115/world-shared/E3SM/baselines/$COMPILER - /lustre/atlas1/cli900/world-shared/cesm/tools/cprnc/cprnc.titan - 8 - e3sm_developer - pbs - TRUE - E3SM - 16 - 16 - TRUE - - aprun - - - - aprun - - - - - /opt/modules/default/init/sh - /opt/modules/default/init/csh - /opt/modules/default/init/python.py - /opt/modules/default/init/perl.pm - - /opt/modules/default/bin/modulecmd perl - /opt/modules/default/bin/modulecmd python - module - module - - - - python/2.7.9 - subversion - subversion/1.9.3 - cmake - cmake3/3.6.0 - - - - PrgEnv-cray - PrgEnv-gnu - PrgEnv-intel - PrgEnv-pathscale - PrgEnv-pgi - pgi pgi/17.5.0 - cray-mpich - cray-libsci - atp - esmf - cudatoolkit - cray-mpich/7.6.3 - cray-libsci/16.11.1 - atp/2.1.1 - esmf/5.2.0rp2 - cudatoolkit - - - PrgEnv-cray - PrgEnv-gnu - PrgEnv-intel - PrgEnv-pathscale - PrgEnv-pgi - pgi pgi/17.5.0 - cray-mpich - cray-libsci - atp - esmf - cray-mpich/7.6.3 - cray-libsci/16.11.1 - atp/2.1.1 - esmf/5.2.0rp2 - - - PrgEnv-pgi - PrgEnv-cray - PrgEnv-gnu - PrgEnv-pathscale - PrgEnv-intel - intel - cray-libsci - cray-mpich - atp - intel/18.0.1.163 - cray-mpich/7.6.3 - atp/2.1.1 - - - PrgEnv-pgi - PrgEnv-gnu - PrgEnv-intel - PrgEnv-pathscale - PrgEnv-cray - cce - cray-mpich - cce/8.6.4 - cray-mpich/7.6.3 - - - - cray-netcdf - cray-netcdf-hdf5parallel - cray-netcdf/4.4.1.1.3 - - - cray-netcdf - cray-netcdf-hdf5parallel - cray-netcdf/4.4.1.1.3 - cray-parallel-netcdf/1.8.1.3 - - - $ENV{PROJWORK}/$PROJECT/$USER/$CASE/run - $CIME_OUTPUT_ROOT/$CASE/bld - - 0.1 - - - - $COMPILER - $MPILIB - 1 - 1 - - 128M - 128M - - - - - - istanbul - 1 - - - dynamic - - - - - ORNL XC30, os is CNL, 16 pes/node, batch system is PBS - eos - CNL - intel - mpich - $ENV{PROJWORK}/$PROJECT - cli115,cli127,cli106,csc190 - $ENV{HOME}/acme_scratch/$PROJECT - /lustre/atlas1/cli900/world-shared/cesm/inputdata - /lustre/atlas1/cli900/world-shared/cesm/inputdata/atm/datm7 - $ENV{MEMBERWORK}/$PROJECT/archive/$CASE - /lustre/atlas1/cli900/world-shared/cesm/baselines/$COMPILER - /lustre/atlas1/cli900/world-shared/cesm/tools/cprnc/cprnc.eos - 8 - e3sm_developer - pbs - E3SM - 32 - 16 - TRUE - - aprun - - -j {{ hyperthreading }} - -S {{ tasks_per_numa }} - -n {{ total_tasks }} - -N $MAX_MPITASKS_PER_NODE - -d $ENV{OMP_NUM_THREADS} - -cc numa_node - - - - - - - $MODULESHOME/init/sh - $MODULESHOME/init/csh - $MODULESHOME/init/perl.pm - $MODULESHOME/init/python.py - module - module - $MODULESHOME/bin/modulecmd perl - $MODULESHOME/bin/modulecmd python - - intel - cray - cray-parallel-netcdf - cray-libsci - cray-netcdf - cray-netcdf-hdf5parallel - netcdf - - - intel/18.0.1.163 - papi - - - PrgEnv-cray - cce cce/8.1.9 - cray-libsci/12.1.00 - - - PrgEnv-gnu - gcc gcc/4.8.0 - cray-libsci/12.1.00 - - - cray-netcdf/4.3.2 - - - cray-netcdf-hdf5parallel/4.3.3.1 - cray-parallel-netcdf/1.6.1 - - - cmake3/3.2.3 - python/2.7.9 - - - $ENV{MEMBERWORK}/$PROJECT/$CASE/run - $CIME_OUTPUT_ROOT/$CASE/bld - - 1 - 1 - - 64M - - - - - - LANL Linux Cluster, 36 pes/node, batch system slurm - gr-fe.*.lanl.gov - LINUX - gnu,intel - mvapich,openmpi - climateacme - /lustre/scratch3/turquoise/$ENV{USER}/E3SM/scratch - /lustre/scratch3/turquoise/$ENV{USER}/E3SM/input_data - /lustre/scratch3/turquoise/$ENV{USER}/E3SM/input_data/atm/datm7 - /lustre/scratch3/turquoise/$ENV{USER}/E3SM/archive/$CASE - /lustre/scratch3/turquoise/$ENV{USER}/E3SM/input_data/ccsm_baselines/$COMPILER - /turquoise/usr/projects/climate/SHARED_CLIMATE/software/wolf/cprnc/v0.40/cprnc - 4 - e3sm_developer - slurm - luke.vanroekel @ gmail.com - 36 - 32 - TRUE - - mpirun - - -n {{ total_tasks }} - - - - srun - - -n {{ total_tasks }} - - - - mpirun - - -n {{ total_tasks }} - - - - - - - /usr/share/Modules/init/perl.pm - /usr/share/Modules/init/python.py - /etc/profile.d/z00_lmod.sh - /etc/profile.d/z00_lmod.csh - /usr/share/lmod/lmod/libexec/lmod perl - /usr/share/lmod/lmod/libexec/lmod python - module - module - - - /usr/projects/climate/SHARED_CLIMATE/modulefiles/all - python/anaconda-2.7-climate - - - gcc/5.3.0 - - - intel/17.0.1 - - - openmpi/1.10.5 - - - mvapich2/2.2 - - - netcdf/4.4.1 - - - parallel-netcdf/1.5.0 - - - mkl - - - /lustre/scratch3/turquoise/$ENV{USER}/E3SM/cases/$CASE/run - /lustre/scratch3/turquoise/$ENV{USER}/E3SM/cases/$CASE/bld - - romio_ds_write=disable;romio_ds_read=disable;romio_cb_write=enable;romio_cb_read=enable - - - /opt/intel/17.0/mkl - - - - - LANL Linux Cluster, 36 pes/node, batch system slurm - ba-fe.*.lanl.gov - LINUX - gnu,intel - mvapich,openmpi - climateacme - /lustre/scratch3/turquoise/$ENV{USER}/E3SM/scratch - /lustre/scratch3/turquoise/$ENV{USER}/E3SM/input_data - /lustre/scratch3/turquoise/$ENV{USER}/E3SM/input_data/atm/datm7 - /lustre/scratch3/turquoise/$ENV{USER}/E3SM/archive/$CASE - /lustre/scratch3/turquoise/$ENV{USER}/E3SM/input_data/ccsm_baselines/$COMPILER - /turquoise/usr/projects/climate/SHARED_CLIMATE/software/wolf/cprnc/v0.40/cprnc - 4 - e3sm_developer - slurm - e3sm - 36 - 32 - TRUE - - mpirun - - -n {{ total_tasks }} - - - - srun - - -n {{ total_tasks }} - - - - mpirun - - -n {{ total_tasks }} - - - - - - - /usr/share/Modules/init/perl.pm - /usr/share/Modules/init/python.py - /etc/profile.d/z00_lmod.sh - /etc/profile.d/z00_lmod.csh - /usr/share/lmod/lmod/libexec/lmod perl - /usr/share/lmod/lmod/libexec/lmod python - module - module - - - /usr/projects/climate/SHARED_CLIMATE/modulefiles/all - python/anaconda-2.7-climate - - - gcc/6.4.0 - - - intel/17.0.4 - - - openmpi/2.1.2 - - - mvapich2/2.2 - - - netcdf/4.4.1.1 - - - parallel-netcdf/1.8.1 - - - mkl - - - /lustre/scratch3/turquoise/$ENV{USER}/E3SM/cases/$CASE/run - /lustre/scratch3/turquoise/$ENV{USER}/E3SM/cases/$CASE/bld - - romio_ds_write=disable;romio_ds_read=disable;romio_cb_write=enable;romio_cb_read=enable - - - /opt/intel/17.0/mkl - - - - - Mesabi batch queue - LINUX - intel - openmpi - /home/reichpb/scratch - /home/reichpb/shared/cesm_inputdata - /home/reichpb/shared/cesm_inputdata/atm/datm7 - USERDEFINED_optional_run - USERDEFINED_optional_run/$COMPILER - USERDEFINED_optional_test - 2 - pbs - chen1718 at umn dot edu - 24 - 24 - TRUE - - aprun - - -n {{ total_tasks }} - -S {{ tasks_per_numa }} - -N $MAX_MPITASKS_PER_NODE - -d $ENV{OMP_NUM_THREADS} - - - - $CASEROOT/run - - $CASEROOT/exedir - - - - - - - - - - - - - - Itasca batch queue - LINUX - intel - openmpi - /home/reichpb/scratch - /home/reichpb/shared/cesm_inputdata - /home/reichpb/shared/cesm_inputdata/atm/datm7 - USERDEFINED_optional_run - USERDEFINED_optional_run/$COMPILER - USERDEFINED_optional_test - 2 - pbs - chen1718 at umn dot edu - 8 - 8 - - aprun - - -n {{ total_tasks }} - -S {{ tasks_per_numa }} - -N $MAX_MPITASKS_PER_NODE - -d $ENV{OMP_NUM_THREADS} - - - - $CASEROOT/run - - $CASEROOT/exedir - - - - - - - - - - - - - - Lawrencium LR6 cluster at LBL, OS is Linux (intel), batch system is SLURM - n000* - LINUX - intel,gnu - openmpi - ac_acme - /global/scratch/$ENV{USER} - /global/scratch/$ENV{USER}/cesm_input_datasets/ - /global/scratch/$ENV{USER}/cesm_input_datasets/atm/datm7 - $CIME_OUTPUT_ROOT/cesm_archive/$CASE - $CIME_OUTPUT_ROOT/cesm_baselines/$COMPILER - /$CIME_OUTPUT_ROOT/cesm_tools/cprnc/cprnc - 4 - slurm - gbisht at lbl dot gov - 12 - 12 - TRUE - - mpirun - - -np {{ total_tasks }} - -npernode $MAX_MPITASKS_PER_NODE - - - - mpirun - - -np {{ total_tasks }} - -npernode $MAX_MPITASKS_PER_NODE - - - - /etc/profile.d/modules.sh - /etc/profile.d/modules.csh - /usr/Modules/init/perl.pm - /usr/Modules/python.py - module - module - /usr/Modules/bin/modulecmd perl - /usr/Modules/bin/modulecmd python - - - cmake - perl xml-libxml switch python/2.7 - - - intel/2016.4.072 - mkl - - - netcdf/4.4.1.1-intel-s - - - openmpi - netcdf/4.4.1.1-intel-p - - - gcc/6.3.0 - lapack/3.8.0-gcc - - - netcdf/5.4.1.1-gcc-s - openmpi/2.0.2-gcc - - - openmpi/3.0.1-gcc - netcdf/4.4.1.1-gcc-p - openmpi/2.0.2-gcc - - - - $CIME_OUTPUT_ROOT/$CASE/run - $CIME_OUTPUT_ROOT/$CASE/bld - - - - Lawrencium LR6 cluster at LBL, OS is Linux (intel), batch system is SLURM - n000* - LINUX - intel,gnu - openmpi - ac_acme - /global/scratch/$ENV{USER} - /global/scratch/$ENV{USER}/cesm_input_datasets/ - /global/scratch/$ENV{USER}/cesm_input_datasets/atm/datm7 - $CIME_OUTPUT_ROOT/cesm_archive/$CASE - $CIME_OUTPUT_ROOT/cesm_baselines/$COMPILER - /$CIME_OUTPUT_ROOT/cesm_tools/cprnc/cprnc - 4 - slurm - gbisht at lbl dot gov - 12 - 12 - TRUE - - mpirun - - -np {{ total_tasks }} - -npernode $MAX_MPITASKS_PER_NODE - - - - mpirun - - -np {{ total_tasks }} - -npernode $MAX_MPITASKS_PER_NODE - - - - /etc/profile.d/modules.sh - /etc/profile.d/modules.csh - /usr/Modules/init/perl.pm - /usr/Modules/python.py - module - module - /usr/Modules/bin/modulecmd perl - /usr/Modules/bin/modulecmd python - - - cmake - perl xml-libxml switch python/2.7 - - - intel/2016.4.072 - mkl - - - netcdf/4.4.1.1-intel-s - - - openmpi - netcdf/4.4.1.1-intel-p - - - gcc/6.3.0 - lapack/3.8.0-gcc - - - netcdf/5.4.1.1-gcc-s - openmpi/2.0.2-gcc - - - openmpi/3.0.1-gcc - netcdf/4.4.1.1-gcc-p - openmpi/2.0.2-gcc - - - - $CIME_OUTPUT_ROOT/$CASE/run - $CIME_OUTPUT_ROOT/$CASE/bld - - - - Lawrencium LR6 cluster at LBL, OS is Linux (intel), batch system is SLURM - n000* - LINUX - intel,gnu - openmpi - ac_acme - /global/scratch/$ENV{USER} - /global/scratch/$ENV{USER}/cesm_input_datasets/ - /global/scratch/$ENV{USER}/cesm_input_datasets/atm/datm7 - $CIME_OUTPUT_ROOT/cesm_archive/$CASE - $CIME_OUTPUT_ROOT/cesm_baselines/$COMPILER - /$CIME_OUTPUT_ROOT/cesm_tools/cprnc/cprnc - 4 - slurm - gbisht at lbl dot gov - 12 - 12 - TRUE - - mpirun - - -np {{ total_tasks }} - -npernode $MAX_MPITASKS_PER_NODE - - - - mpirun - - -np {{ total_tasks }} - -npernode $MAX_MPITASKS_PER_NODE - - - - /etc/profile.d/modules.sh - /etc/profile.d/modules.csh - /usr/Modules/init/perl.pm - /usr/Modules/python.py - module - module - /usr/Modules/bin/modulecmd perl - /usr/Modules/bin/modulecmd python - - - cmake - perl xml-libxml switch python/2.7 - - - intel/2016.4.072 - mkl - - - netcdf/4.4.1.1-intel-s - - - openmpi - netcdf/4.4.1.1-intel-p - - - gcc/6.3.0 - lapack/3.8.0-gcc - - - netcdf/5.4.1.1-gcc-s - openmpi/2.0.2-gcc - - - openmpi/3.0.1-gcc - netcdf/4.4.1.1-gcc-p - openmpi/2.0.2-gcc - - - - $CIME_OUTPUT_ROOT/$CASE/run - $CIME_OUTPUT_ROOT/$CASE/bld - - - - small developer workhorse at lbl climate sciences - LINUX - gnu - openmpi - ngeet - /home/lbleco/acme/ - /home/lbleco/cesm/cesm_input_datasets/ - /home/lbleco/cesm/cesm_input_datasets/atm/datm7/ - /home/lbleco/acme/cesm_archive/$CASE - /home/lbleco/acme/cesm_baselines/$COMPILER - /home/lbleco/cesm/cesm_tools/cprnc/cprnc - 1 - none - rgknox at lbl gov - 4 - 4 - FALSE - - - - - mpirun - - -np {{ total_tasks }} - -npernode $MAX_MPITASKS_PER_NODE - - - - - - - ORNL pre-Summit testbed. Node: 2x POWER8 + 4x Tesla P100, 20 cores/node, 8 HW threads/core. - summitdev-* - LINUX - ibm,pgi,pgiacc - spectrum-mpi,mpi-serial - csc249 - CSC249ADSE15 - /lustre/atlas/proj-shared/$PROJECT - cli115,cli127,cli106,csc190 - $ENV{HOME}/acme_scratch/$PROJECT - /lustre/atlas1/cli900/world-shared/cesm/inputdata - /lustre/atlas1/cli900/world-shared/cesm/inputdata/atm/datm7 - /lustre/atlas/scratch/$ENV{USER}/$PROJECT/archive/$CASE - /lustre/atlas1/cli900/world-shared/cesm/baselines/$COMPILER - /lustre/atlas1/cli900/world-shared/cesm/tools/cprnc/cprnc - 32 - e3sm_developer - lsf - acme - 160 - 80 - TRUE - - /lustre/atlas/world-shared/cli900/helper_scripts/mpirun.summitdev - - - -n {{ total_tasks }} -N $MAX_MPITASKS_PER_NODE - - - - - - - /sw/summitdev/lmod/7.4.0/rhel7.2_gnu4.8.5/lmod/7.4/init/sh - /sw/summitdev/lmod/7.4.0/rhel7.2_gnu4.8.5/lmod/7.4/init/csh - /sw/summitdev/lmod/7.4.0/rhel7.2_gnu4.8.5/lmod/7.4/init/env_modules_python.py - /sw/summitdev/lmod/7.4.0/rhel7.2_gnu4.8.5/lmod/7.4/init/perl - - module - /sw/summitdev/lmod/7.4.0/rhel7.2_gnu4.8.5/lmod/lmod/libexec/lmod python - module - module - - - - - - - DefApps - python/3.5.2 - subversion/1.9.3 - git/2.13.0 - cmake/3.6.1 - essl/5.5.0-20161110 - netlib-lapack/3.6.1 - - - - xl - pgi/17.9 - spectrum-mpi/10.1.0.4-20170915 - - - - pgi - xl/20170914-beta - spectrum-mpi/10.1.0.4-20170915 - - - - - - netcdf/4.4.1 - netcdf-fortran/4.4.4 - - - - netcdf/4.4.1 - netcdf-fortran/4.4.4 - parallel-netcdf/1.7.0 - hdf5/1.10.0-patch1 - - - netcdf/4.4.1 - netcdf-fortran/4.4.4 - parallel-netcdf/1.7.0 - hdf5/1.10.0-patch1 - - - /lustre/atlas/scratch/$ENV{USER}/$PROJECT/$CASE/run - $CIME_OUTPUT_ROOT/$CASE/bld - - - - - - $COMPILER - $MPILIB - 128M - $ENV{OLCF_NETCDF_ROOT} - $ENV{OLCF_NETCDF_FORTRAN_ROOT} - $ENV{OLCF_HDF5_ROOT} - $ENV{OLCF_ESSL_ROOT} - $ENV{OLCF_NETLIB_LAPACK_ROOT} - - - - - - $ENV{OLCF_PARALLEL_NETCDF_ROOT} - - - - - ORNL Summit. Node: 2x POWER9 + 6x Volta V100, 22 cores/socket, 4 HW threads/core. - .*summit.* - LINUX - ibm,pgi,pgiacc,gnu - spectrum-mpi,mpi-serial - cli115 - cli115 - /gpfs/alpine/proj-shared/$PROJECT - cli115,cli127,csc190 - /gpfs/alpine/$PROJECT/proj-shared/$ENV{USER}/e3sm_scratch - /gpfs/alpine/cli115/world-shared/e3sm/inputdata - /gpfs/alpine/cli115/world-shared/e3sm/inputdata/atm/datm7 - /gpfs/alpine/$PROJECT/proj-shared/$ENV{USER}/archive/$CASE - /gpfs/alpine/cli115/world-shared/e3sm/baselines/$COMPILER - /gpfs/alpine/cli115/world-shared/e3sm/tools/cprnc.summit/cprnc - 32 - e3sm_developer - lsf - e3sm - 84 - 84 - TRUE - - - /gpfs/alpine/world-shared/csc190/e3sm/mpirun.summit - - - -n {{ total_tasks }} -N $MAX_MPITASKS_PER_NODE - - - - - /sw/summit/lmod/7.7.10/rhel7.3_gnu4.8.5/lmod/lmod/init/sh - /sw/summit/lmod/7.7.10/rhel7.3_gnu4.8.5/lmod/lmod/init/csh - /sw/summit/lmod/7.7.10/rhel7.3_gnu4.8.5/lmod/lmod/init/env_modules_python.py - /sw/summit/lmod/7.7.10/rhel7.3_gnu4.8.5/lmod/lmod/init/perl - - module - /sw/summit/lmod/7.7.10/rhel7.3_gnu4.8.5/lmod/7.7.10/libexec/lmod python - module - module - - - - - - DefApps - python/3.5.2 - subversion/1.9.3 - git/2.13.0 - cmake/3.13.4 - essl/6.1.0-2 - netlib-lapack/3.8.0 - - - - pgi/18.10 - - - xl/16.1.1-1 - - - gcc/6.4.0 - - - - netcdf/4.6.1 - netcdf-fortran/4.4.4 - - - - - spectrum-mpi/10.2.0.11-20190201 - - - spectrum-mpi/10.2.0.11-20190201 - - - spectrum-mpi/10.2.0.11-20190201 - - - - parallel-netcdf/1.8.0 - hdf5/1.10.3 - - - - - - $CIME_OUTPUT_ROOT/$CASE/run - $CIME_OUTPUT_ROOT/$CASE/bld - - - - - - - $COMPILER - $MPILIB - 128M - $ENV{OLCF_NETCDF_ROOT} - $ENV{OLCF_NETCDF_FORTRAN_ROOT} - $ENV{OLCF_NETCDF_FORTRAN_ROOT} - $ENV{OLCF_NETCDF_FORTRAN_ROOT} - $ENV{OLCF_ESSL_ROOT} - $ENV{OLCF_NETLIB_LAPACK_ROOT} - - - $ENV{OMP_NUM_THREADS} - - - $ENV{OLCF_HDF5_ROOT} - - romio314 - $ENV{OLCF_PARALLEL_NETCDF_ROOT} - - - - - ${EXEROOT}/e3sm.exe - >> e3sm.log.$LID 2>&1 - - - From a46fabdf409825a2c43849a4c0af8ef72b29e248 Mon Sep 17 00:00:00 2001 From: Robert Jacob Date: Fri, 17 Feb 2023 22:03:33 -0600 Subject: [PATCH 320/467] Add namelist variable for mesh to mosart Add new namelist variable for mesh to mosart and set its default values for the .125, .5 and 2 deg grids. --- components/mosart/bld/build-namelist | 1 + .../bld/namelist_files/namelist_defaults_mosart.xml | 5 +++++ .../bld/namelist_files/namelist_definition_mosart.xml | 11 ++++++++++- 3 files changed, 16 insertions(+), 1 deletion(-) diff --git a/components/mosart/bld/build-namelist b/components/mosart/bld/build-namelist index a2eb8adef509..6e3eafd40649 100755 --- a/components/mosart/bld/build-namelist +++ b/components/mosart/bld/build-namelist @@ -320,6 +320,7 @@ else { add_default($nl, 'ngeom'); add_default($nl, 'nlayers'); add_default($nl, 'frivinp_rtm' , 'rof_grid'=>$ROF_GRID ); + add_default($nl, 'frivinp_mesh' , 'rof_grid'=>$ROF_GRID ); add_default($nl, 'ice_runoff' , 'lnd_grid'=>$LND_GRID ); add_default($nl, 'rtmhist_mfilt'); add_default($nl, 'rtmhist_nhtfrq'); diff --git a/components/mosart/bld/namelist_files/namelist_defaults_mosart.xml b/components/mosart/bld/namelist_files/namelist_defaults_mosart.xml index 81af48f09b19..ef3648e22897 100644 --- a/components/mosart/bld/namelist_files/namelist_defaults_mosart.xml +++ b/components/mosart/bld/namelist_files/namelist_defaults_mosart.xml @@ -45,6 +45,11 @@ for the CLM data in the CESM distribution rof/mosart/MOSART_Global_2deg_antarctica_flowing_to_north_c09162020.nc rof/mosart/MOSART_NLDAS_8th_20160426.nc + +share/meshes/rof/MOSART_global_8th.scrip.20180211c.nc +share/meshes/rof/SCRIPgrid_0.5x0.5_nomask_c110308.nc +share/meshes/rof/SCRIPgrid_2x2_nomask_c210211.nc + rof/mosart/US_reservoir_8th_NLDAS3_c20161220_updated_20170314.nc diff --git a/components/mosart/bld/namelist_files/namelist_definition_mosart.xml b/components/mosart/bld/namelist_files/namelist_definition_mosart.xml index da16edd69479..978bb4defedd 100644 --- a/components/mosart/bld/namelist_files/namelist_definition_mosart.xml +++ b/components/mosart/bld/namelist_files/namelist_definition_mosart.xml @@ -225,7 +225,16 @@ Full pathname of master restart file for a branch run. (only used if RUN_TYPE=br input_pathname="abs" group="mosart_inparm" valid_values="" > -Full pathname of input datafile for MOSART. +Full pathname of input river routing file for MOSART. + + + +Full pathname of input mesh file for MOSART. Date: Fri, 17 Feb 2023 22:08:16 -0600 Subject: [PATCH 321/467] read new mesh variable in Mosart read new mesh filename variable in Mosart from namelist and pass the value through Rtmini --- components/mosart/src/riverroute/RtmMod.F90 | 10 +++++++--- components/mosart/src/riverroute/RtmVar.F90 | 1 + 2 files changed, 8 insertions(+), 3 deletions(-) diff --git a/components/mosart/src/riverroute/RtmMod.F90 b/components/mosart/src/riverroute/RtmMod.F90 index 4633281b3f26..4b243cbe18cb 100644 --- a/components/mosart/src/riverroute/RtmMod.F90 +++ b/components/mosart/src/riverroute/RtmMod.F90 @@ -16,7 +16,7 @@ module RtmMod use RtmSpmd , only : masterproc, npes, iam, mpicom_rof, ROFID, mastertask, & MPI_REAL8,MPI_INTEGER,MPI_CHARACTER,MPI_LOGICAL,MPI_MAX use RtmVar , only : re, spval, rtmlon, rtmlat, iulog, ice_runoff, & - frivinp_rtm, finidat_rtm, nrevsn_rtm,rstraflag,ngeom,nlayers,rinittemp, & + frivinp_rtm, frivinp_mesh, finidat_rtm, nrevsn_rtm,rstraflag,ngeom,nlayers,rinittemp, & nsrContinue, nsrBranch, nsrStartup, nsrest, & inst_index, inst_suffix, inst_name, wrmflag, inundflag, & smat_option, decomp_option, barrier_timers, heatflag, sediflag, & @@ -138,7 +138,7 @@ module RtmMod ! !IROUTINE: Rtmini ! ! !INTERFACE: - subroutine Rtmini(rtm_active,flood_active) + subroutine Rtmini(rtm_active,flood_active,rtm_mesh) ! ! !DESCRIPTION: ! Initialize MOSART grid, mask, decomp @@ -149,6 +149,7 @@ subroutine Rtmini(rtm_active,flood_active) implicit none logical, intent(out) :: rtm_active logical, intent(out) :: flood_active + character(len=256), intent(out) :: rtm_mesh ! ! !CALLED FROM: ! subroutine initialize in module initializeMod @@ -261,7 +262,7 @@ subroutine Rtmini(rtm_active,flood_active) !------------------------------------------------------- namelist /mosart_inparm / ice_runoff, do_rtm, do_rtmflood, & - frivinp_rtm, finidat_rtm, nrevsn_rtm, coupling_period, & + frivinp_rtm, frivinp_mesh, finidat_rtm, nrevsn_rtm, coupling_period, & rtmhist_ndens, rtmhist_mfilt, rtmhist_nhtfrq, & rtmhist_fincl1, rtmhist_fincl2, rtmhist_fincl3, & rtmhist_fexcl1, rtmhist_fexcl2, rtmhist_fexcl3, & @@ -360,6 +361,7 @@ subroutine Rtmini(rtm_active,flood_active) call mpi_bcast (finidat_rtm , len(finidat_rtm) , MPI_CHARACTER, 0, mpicom_rof, ier) call mpi_bcast (frivinp_rtm , len(frivinp_rtm) , MPI_CHARACTER, 0, mpicom_rof, ier) + call mpi_bcast (frivinp_mesh , len(frivinp_mesh) , MPI_CHARACTER, 0, mpicom_rof, ier) call mpi_bcast (nrevsn_rtm , len(nrevsn_rtm) , MPI_CHARACTER, 0, mpicom_rof, ier) call mpi_bcast (decomp_option, len(decomp_option), MPI_CHARACTER, 0, mpicom_rof, ier) call mpi_bcast (smat_option , len(smat_option) , MPI_CHARACTER, 0, mpicom_rof, ier) @@ -491,6 +493,7 @@ subroutine Rtmini(rtm_active,flood_active) rtm_active = do_rtm flood_active = do_rtmflood + rtm_mesh = frivinp_mesh if (do_rtm) then if (frivinp_rtm == ' ') then @@ -574,6 +577,7 @@ subroutine Rtmini(rtm_active,flood_active) call getfil(frivinp_rtm, locfn, 0 ) if (masterproc) then write(iulog,*) 'Read in MOSART file name: ',trim(frivinp_rtm) + write(iulog,*) 'MOSART mesh file name: ',trim(frivinp_mesh) call shr_sys_flush(iulog) endif diff --git a/components/mosart/src/riverroute/RtmVar.F90 b/components/mosart/src/riverroute/RtmVar.F90 index 1116dfc1c245..41f7398d6132 100644 --- a/components/mosart/src/riverroute/RtmVar.F90 +++ b/components/mosart/src/riverroute/RtmVar.F90 @@ -62,6 +62,7 @@ module RtmVar character(len=256), public :: nrevsn_rtm = ' ' ! restart data file name for branch run character(len=256), public :: finidat_rtm = ' ' ! initial conditions file name character(len=256), public :: frivinp_rtm = ' ' ! RTM input data file name + character(len=256), public :: frivinp_mesh = ' ' ! mesh input data file name logical, public :: ice_runoff = .true. ! true => runoff is split into liquid and ice, ! otherwise just liquid ! Rtm grid size From ccc4f5c57482e098779a6496b8f2c8c8ea577e0b Mon Sep 17 00:00:00 2001 From: Robert Jacob Date: Fri, 17 Feb 2023 22:10:05 -0600 Subject: [PATCH 322/467] Get new mesh variable from Rtmini and pass to infodata Get new mesh variable from Rtmini and pass to infodata if MOAB is being used. --- components/mosart/src/cpl/rof_comp_mct.F90 | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) diff --git a/components/mosart/src/cpl/rof_comp_mct.F90 b/components/mosart/src/cpl/rof_comp_mct.F90 index ed953f5dcbc4..fec03243550c 100644 --- a/components/mosart/src/cpl/rof_comp_mct.F90 +++ b/components/mosart/src/cpl/rof_comp_mct.F90 @@ -155,6 +155,7 @@ subroutine rof_init_mct( EClock, cdata_r, x2r_r, r2x_r, NLFilename) character(len=SHR_KIND_CL) :: hostname ! hostname of machine running on character(len=SHR_KIND_CL) :: version ! Model version character(len=SHR_KIND_CL) :: username ! user running the model + character(len=SHR_KIND_CL) :: rtm_mesh ! mesh file path character(len=8) :: c_inst_index ! instance number character(len=8) :: c_npes ! number of pes character(len=32), parameter :: sub = 'rof_init_mct' @@ -280,7 +281,7 @@ subroutine rof_init_mct( EClock, cdata_r, x2r_r, r2x_r, NLFilename) use_ocn_rof_two_way = ocn_rof_two_way ! Read namelist, grid and surface data - call Rtmini(rtm_active=rof_prognostic,flood_active=flood_present) + call Rtmini(rtm_active=rof_prognostic,flood_active=flood_present,rtm_mesh=rtm_mesh) if (rof_prognostic) then ! Initialize memory for input state @@ -367,6 +368,10 @@ subroutine rof_init_mct( EClock, cdata_r, x2r_r, r2x_r, NLFilename) call seq_infodata_PutData( infodata, rof_present=rof_prognostic, rof_nx = rtmlon, rof_ny = rtmlat, & rof_prognostic=rof_prognostic, rofocn_prognostic=use_ocn_rof_two_way) call seq_infodata_PutData( infodata, flood_present=flood_present) +#ifdef HAVE_MOAB + ! send path of river mesh to MOAB coupler. + call seq_infodata_PutData( infodata, rof_mesh=rtm_mesh) +#endif ! Reset shr logging to original values call shr_file_setLogUnit (shrlogunit) From b510ec4fe5c793971cc87712616669824a9b88cb Mon Sep 17 00:00:00 2001 From: Robert Jacob Date: Fri, 17 Feb 2023 22:11:57 -0600 Subject: [PATCH 323/467] Add variables for lnd domain and rtm mesh in infodata Add variables for lnd domain and rtm mesh in infodata, set to a default value, allow Get and Put operations. --- driver-moab/shr/seq_infodata_mod.F90 | 25 ++++++++++++++++++++----- 1 file changed, 20 insertions(+), 5 deletions(-) diff --git a/driver-moab/shr/seq_infodata_mod.F90 b/driver-moab/shr/seq_infodata_mod.F90 index 962fd4d25ca8..e71d77546400 100644 --- a/driver-moab/shr/seq_infodata_mod.F90 +++ b/driver-moab/shr/seq_infodata_mod.F90 @@ -229,6 +229,8 @@ MODULE seq_infodata_mod integer(SHR_KIND_IN) :: wav_ny ! nx, ny of "2d" grid integer(SHR_KIND_IN) :: iac_nx ! nx, ny of "2d" grid 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 !--- set via components and may be time varying --- real(SHR_KIND_R8) :: nextsw_cday ! calendar of next atm shortwave @@ -781,6 +783,8 @@ SUBROUTINE seq_infodata_Init( infodata, nmlfile, ID, pioid, cpl_tag) infodata%wav_ny = 0 infodata%iac_nx = 0 infodata%iac_ny = 0 + infodata%lnd_domain = 'none' + infodata%rof_mesh = 'none' infodata%nextsw_cday = -1.0_SHR_KIND_R8 infodata%precip_fact = 1.0_SHR_KIND_R8 @@ -1023,14 +1027,13 @@ 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, eps_frac, eps_amask, & - eps_agrid, eps_aarea, eps_omask, eps_ogrid, eps_oarea, & + iac_nx, iac_ny, glc_nx, glc_ny, lnd_domain, rof_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, & mct_usealltoall, mct_usevector, max_cplstep_time, model_doi_url, & glc_valid_input) - implicit none ! !INPUT/OUTPUT PARAMETERS: @@ -1195,6 +1198,8 @@ SUBROUTINE seq_infodata_GetData_explicit( infodata, cime_model, case_name, case_ integer(SHR_KIND_IN), optional, intent(OUT) :: wav_ny integer(SHR_KIND_IN), optional, intent(OUT) :: iac_nx 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 real(SHR_KIND_R8), optional, intent(OUT) :: nextsw_cday ! calendar of next atm shortwave real(SHR_KIND_R8), optional, intent(OUT) :: precip_fact ! precip factor @@ -1379,6 +1384,8 @@ SUBROUTINE seq_infodata_GetData_explicit( infodata, cime_model, case_name, case_ if ( present(wav_ny) ) wav_ny = infodata%wav_ny if ( present(iac_nx) ) iac_nx = infodata%iac_nx 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(nextsw_cday) ) nextsw_cday = infodata%nextsw_cday if ( present(precip_fact) ) precip_fact = infodata%precip_fact @@ -1573,8 +1580,8 @@ SUBROUTINE seq_infodata_PutData_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, eps_frac, eps_amask, & - eps_agrid, eps_aarea, eps_omask, eps_ogrid, eps_oarea, & + iac_nx, iac_ny, glc_nx, glc_ny, eps_frac, eps_amask, lnd_domain, & + rof_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) @@ -1743,6 +1750,8 @@ SUBROUTINE seq_infodata_PutData_explicit( infodata, cime_model, case_name, case_ integer(SHR_KIND_IN), optional, intent(IN) :: wav_ny integer(SHR_KIND_IN), optional, intent(IN) :: iac_nx 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 real(SHR_KIND_R8), optional, intent(IN) :: nextsw_cday ! calendar of next atm shortwave real(SHR_KIND_R8), optional, intent(IN) :: precip_fact ! precip factor @@ -1926,6 +1935,8 @@ SUBROUTINE seq_infodata_PutData_explicit( infodata, cime_model, case_name, case_ if ( present(wav_ny) ) infodata%wav_ny = wav_ny if ( present(iac_nx) ) infodata%iac_nx = iac_nx 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(nextsw_cday) ) infodata%nextsw_cday = nextsw_cday if ( present(precip_fact) ) infodata%precip_fact = precip_fact @@ -2233,6 +2244,8 @@ subroutine seq_infodata_bcast(infodata,mpicom) call shr_mpi_bcast(infodata%wav_ny, mpicom) call shr_mpi_bcast(infodata%iac_nx, 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%nextsw_cday, mpicom) call shr_mpi_bcast(infodata%precip_fact, mpicom) @@ -2943,6 +2956,8 @@ SUBROUTINE seq_infodata_print( infodata ) write(logunit,F0I) subname,'wav_ny = ', infodata%wav_ny write(logunit,F0I) subname,'iac_nx = ', infodata%iac_nx 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,F0R) subname,'nextsw_cday = ', infodata%nextsw_cday write(logunit,F0R) subname,'precip_fact = ', infodata%precip_fact From 28aded85c459508a8499b58f4fcea8793832907a Mon Sep 17 00:00:00 2001 From: Robert Jacob Date: Fri, 17 Feb 2023 22:13:48 -0600 Subject: [PATCH 324/467] Pass infodata to cplcomp_moab_Init, get rtm mesh Pass infodata to cplcomp_moab_Init and use it to get the value of the river mesh file path. Use it to read in the river mesh. --- driver-moab/main/component_mod.F90 | 2 +- driver-moab/main/cplcomp_exchange_mod.F90 | 17 ++++++++--------- 2 files changed, 9 insertions(+), 10 deletions(-) diff --git a/driver-moab/main/component_mod.F90 b/driver-moab/main/component_mod.F90 index 6958383a6007..48fafd970134 100644 --- a/driver-moab/main/component_mod.F90 +++ b/driver-moab/main/component_mod.F90 @@ -379,7 +379,7 @@ subroutine component_init_cx(comp, infodata) call shr_sys_flush(logunit) end if call seq_mctext_gsmapInit(comp(1)) - call cplcomp_moab_Init(comp(1)) + call cplcomp_moab_Init(infodata,comp(1)) endif ! Create mapper_Cc2x and mapper_Cx2c diff --git a/driver-moab/main/cplcomp_exchange_mod.F90 b/driver-moab/main/cplcomp_exchange_mod.F90 index 734e82390232..51bfb9567475 100644 --- a/driver-moab/main/cplcomp_exchange_mod.F90 +++ b/driver-moab/main/cplcomp_exchange_mod.F90 @@ -982,7 +982,7 @@ end function seq_mctext_gsmapIdentical !======================================================================= - subroutine cplcomp_moab_Init(comp) + subroutine cplcomp_moab_Init(infodata,comp) ! This routine initializes an iMOAB app on the coupler pes, ! corresponding to the component pes. It uses send/receive @@ -995,6 +995,9 @@ subroutine cplcomp_moab_Init(comp) iMOAB_SetIntTagStorage, iMOAB_FreeSenderBuffers, iMOAB_ComputeCommGraph, iMOAB_LoadMesh ! use component_mod, only: component_exch_moab ! + use seq_infodata_mod + ! + type(seq_infodata_type) , intent(in) :: infodata type(component_type), intent(inout) :: comp ! ! Local Variables @@ -1013,6 +1016,7 @@ subroutine cplcomp_moab_Init(comp) integer :: mpigrp_old ! component group pes integer :: ierr, context_id character*200 :: appname, outfile, wopts, ropts + character(CL) :: rtm_mesh integer :: maxMH, maxMPO, maxMLID, maxMSID, maxMRID ! max pids for moab apps atm, ocn, lnd, sea-ice, rof integer :: tagtype, numco, tagindex, partMethod, nghlay integer :: rank, ent_type @@ -1451,14 +1455,9 @@ subroutine cplcomp_moab_Init(comp) appname = "COUPLE_MROF"//C_NULL_CHAR ierr = iMOAB_RegisterApplication(trim(appname), mpicom_new, id_join, mbrxid) - ! load mesh from scrip file - ! on lcrc: - ! outfile = '/lcrc/group/e3sm/data/inputdata/share/meshes/rof/SCRIPgrid_2x2_nomask_c210211.nc'//C_NULL_CHAR - ! on gce: - ! /nfs/gce/projects/climate/inputdata/share/meshes/rof/SCRIPgrid_2x2_nomask_c210211.nc'//C_NULL_CHAR - ! iulian's laptop - !outfile = '/media/iulian/ExtraDrive1/inputdata/share/meshes/rof/SCRIPgrid_2x2_nomask_c210211.nc'//C_NULL_CHAR - outfile = '/home/iulian/rofscrip/SCRIPgrid_2x2_nomask_c210211.nc'//C_NULL_CHAR + ! 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 nghlay = 0 ! no ghost layers From 68f173aca86282ec1a95b29dab758e5044a9c906 Mon Sep 17 00:00:00 2001 From: Robert Jacob Date: Mon, 20 Feb 2023 16:21:51 -0600 Subject: [PATCH 325/467] Add bcast of rof_mesh in infodata Add bcast of rof_mesh in infodata_exchange during a rof2cpl_init --- driver-moab/shr/seq_infodata_mod.F90 | 1 + 1 file changed, 1 insertion(+) diff --git a/driver-moab/shr/seq_infodata_mod.F90 b/driver-moab/shr/seq_infodata_mod.F90 index e71d77546400..96bf0f9363ef 100644 --- a/driver-moab/shr/seq_infodata_mod.F90 +++ b/driver-moab/shr/seq_infodata_mod.F90 @@ -2489,6 +2489,7 @@ subroutine seq_infodata_Exchange(infodata,ID,type) call shr_mpi_bcast(infodata%rof_nx, mpicom, pebcast=cmppe) 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) ! dead_comps is true if it's ever set to true deads = infodata%dead_comps call shr_mpi_bcast(deads, mpicom, pebcast=cmppe) From 4b97780bab023d9c89fe081b18d3f335f0996c08 Mon Sep 17 00:00:00 2001 From: Robert Jacob Date: Mon, 20 Feb 2023 18:29:34 -0600 Subject: [PATCH 326/467] Add fatmlndfrc to infodata Add fatmlndfrc to infodata so the coupler can know the domain file name. For MOAB coupling. --- components/elm/src/cpl/lnd_comp_mct.F90 | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/components/elm/src/cpl/lnd_comp_mct.F90 b/components/elm/src/cpl/lnd_comp_mct.F90 index 1a9d6ab3d0ad..fb415168c642 100644 --- a/components/elm/src/cpl/lnd_comp_mct.F90 +++ b/components/elm/src/cpl/lnd_comp_mct.F90 @@ -75,7 +75,7 @@ subroutine lnd_init_mct( EClock, cdata_l, x2l_l, l2x_l, NLFilename ) use elm_initializeMod, only : initialize1, initialize2, initialize3 use elm_instMod , only : lnd2atm_vars, lnd2glc_vars use elm_instance , only : elm_instance_init - use elm_varctl , only : finidat,single_column, elm_varctl_set, iulog, noland + use elm_varctl , only : finidat,single_column, elm_varctl_set, iulog, noland, fatmlndfrc use elm_varctl , only : inst_index, inst_suffix, inst_name, precip_downscaling_method use elm_varorb , only : eccen, obliqr, lambm0, mvelpp use controlMod , only : control_setNL @@ -405,6 +405,10 @@ subroutine lnd_init_mct( EClock, cdata_l, x2l_l, l2x_l, NLFilename ) call seq_infodata_PutData(infodata, lnd_prognostic=.true.) call seq_infodata_PutData(infodata, lnd_nx=ldomain%ni, lnd_ny=ldomain%nj, precip_downscaling_method = precip_downscaling_method) +#ifdef HAVE_MOAB + call seq_infodata_PutData(infodata, lnd_domain= fatmlndfrc) +#endif + ! Get infodata info call seq_infodata_GetData(infodata, nextsw_cday=nextsw_cday ) From 148939051712bfc575b71dbc9da09941c64009ab Mon Sep 17 00:00:00 2001 From: Robert Jacob Date: Mon, 20 Feb 2023 18:32:22 -0600 Subject: [PATCH 327/467] Broadcast the land domain Broadcast the land domain variable --- driver-moab/main/cplcomp_exchange_mod.F90 | 4 ++++ driver-moab/shr/seq_infodata_mod.F90 | 1 + 2 files changed, 5 insertions(+) diff --git a/driver-moab/main/cplcomp_exchange_mod.F90 b/driver-moab/main/cplcomp_exchange_mod.F90 index 51bfb9567475..5c033f845a5e 100644 --- a/driver-moab/main/cplcomp_exchange_mod.F90 +++ b/driver-moab/main/cplcomp_exchange_mod.F90 @@ -1017,6 +1017,7 @@ subroutine cplcomp_moab_Init(infodata,comp) integer :: ierr, context_id character*200 :: appname, outfile, wopts, ropts character(CL) :: rtm_mesh + character(CL) :: lnd_domain integer :: maxMH, maxMPO, maxMLID, maxMSID, maxMRID ! max pids for moab apps atm, ocn, lnd, sea-ice, rof integer :: tagtype, numco, tagindex, partMethod, nghlay integer :: rank, ent_type @@ -1301,6 +1302,9 @@ subroutine cplcomp_moab_Init(infodata,comp) ! iulian's laptop !outfile = '/media/iulian/ExtraDrive1/inputdata/share/meshes/lnd/land_np4pg2_oQU480_230112.h5m'//C_NULL_CHAR ropts = 'PARALLEL=READ_PART;PARTITION=PARALLEL_PARTITION;PARALLEL_RESOLVE_SHARED_ENTS'//C_NULL_CHAR + call seq_infodata_GetData(infodata,lnd_domain=lnd_domain) + outfile = trim(lnd_domain)//C_NULL_CHAR + write(logunit,*) subname,' got land domain file ',trim(lnd_domain) outfile = '/home/iulian/rofscrip/land_np4pg2_oQU480_230112.h5m'//C_NULL_CHAR nghlay = 0 ! no ghost layers ierr = iMOAB_LoadMesh(mblxid, outfile, ropts, nghlay) diff --git a/driver-moab/shr/seq_infodata_mod.F90 b/driver-moab/shr/seq_infodata_mod.F90 index 96bf0f9363ef..983eca408e0e 100644 --- a/driver-moab/shr/seq_infodata_mod.F90 +++ b/driver-moab/shr/seq_infodata_mod.F90 @@ -2475,6 +2475,7 @@ subroutine seq_infodata_Exchange(infodata,ID,type) call shr_mpi_bcast(infodata%lnd_prognostic, mpicom, pebcast=cmppe) call shr_mpi_bcast(infodata%lnd_nx, mpicom, pebcast=cmppe) call shr_mpi_bcast(infodata%lnd_ny, mpicom, pebcast=cmppe) + call shr_mpi_bcast(infodata%lnd_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) From 376eeb66cc4b4119df26d191b268453ecf5379d6 Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Mon, 20 Feb 2023 20:06:33 -0600 Subject: [PATCH 328/467] use the domain reader branch fix --- driver-moab/main/cplcomp_exchange_mod.F90 | 9 +-------- driver-moab/shr/seq_infodata_mod.F90 | 2 +- 2 files changed, 2 insertions(+), 9 deletions(-) diff --git a/driver-moab/main/cplcomp_exchange_mod.F90 b/driver-moab/main/cplcomp_exchange_mod.F90 index 5c033f845a5e..e72a633364ab 100644 --- a/driver-moab/main/cplcomp_exchange_mod.F90 +++ b/driver-moab/main/cplcomp_exchange_mod.F90 @@ -1295,17 +1295,10 @@ subroutine cplcomp_moab_Init(infodata,comp) endif ! do not receive the mesh anymore, read it from file, then pair it with mlnid, component land PC mesh ! similar to rof mosart mesh - ! on lcrc: - ! outfile = '/lcrc/group/e3sm/data/inputdata/share/meshes/lnd/land_np4pg2_oQU480_230112.h5m'//C_NULL_CHAR - ! on gce: - ! /nfs/gce/projects/climate/inputdata/share/meshes/lnd/land_np4pg2_oQU480_230112.h5m'//C_NULL_CHAR - ! iulian's laptop - !outfile = '/media/iulian/ExtraDrive1/inputdata/share/meshes/lnd/land_np4pg2_oQU480_230112.h5m'//C_NULL_CHAR - ropts = 'PARALLEL=READ_PART;PARTITION=PARALLEL_PARTITION;PARALLEL_RESOLVE_SHARED_ENTS'//C_NULL_CHAR + ropts = 'PARALLEL=READ_PART;PARTITION_METHOD=SQIJ;VARIABLE='//C_NULL_CHAR call seq_infodata_GetData(infodata,lnd_domain=lnd_domain) outfile = trim(lnd_domain)//C_NULL_CHAR write(logunit,*) subname,' got land domain file ',trim(lnd_domain) - outfile = '/home/iulian/rofscrip/land_np4pg2_oQU480_230112.h5m'//C_NULL_CHAR nghlay = 0 ! no ghost layers ierr = iMOAB_LoadMesh(mblxid, outfile, ropts, nghlay) if (ierr .ne. 0) then diff --git a/driver-moab/shr/seq_infodata_mod.F90 b/driver-moab/shr/seq_infodata_mod.F90 index 983eca408e0e..8c7f797143b2 100644 --- a/driver-moab/shr/seq_infodata_mod.F90 +++ b/driver-moab/shr/seq_infodata_mod.F90 @@ -2475,7 +2475,7 @@ subroutine seq_infodata_Exchange(infodata,ID,type) call shr_mpi_bcast(infodata%lnd_prognostic, mpicom, pebcast=cmppe) call shr_mpi_bcast(infodata%lnd_nx, mpicom, pebcast=cmppe) call shr_mpi_bcast(infodata%lnd_ny, mpicom, pebcast=cmppe) - call shr_mpi_bcast(infodata%lnd_domain, mpicom, pebcast=cmppe) + call shr_mpi_bcast(infodata%lnd_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) From 754f43855b19bc883970797ccd5e194abad4c0af Mon Sep 17 00:00:00 2001 From: Robert Jacob Date: Tue, 21 Feb 2023 15:12:59 -0600 Subject: [PATCH 329/467] Add infodata commnets Add 3 comments pointing out infodata use --- driver-moab/main/cime_comp_mod.F90 | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/driver-moab/main/cime_comp_mod.F90 b/driver-moab/main/cime_comp_mod.F90 index 26b8b3c80f6a..f89b5887c0aa 100644 --- a/driver-moab/main/cime_comp_mod.F90 +++ b/driver-moab/main/cime_comp_mod.F90 @@ -1473,14 +1473,14 @@ subroutine cime_init() !--------------------------------------------------------------------------------------- ! Initialize components including domain/grid info. - ! If processor has cpl or model: Do an infodata exchange + ! If processor has cpl or model: Do a cpl2mod_init infodata exchange ! Initialize pointers to the main _cc attribute vectors in comp datatype ! If the model is active on this processor ! Call init method for each model ! initialize GsMap, Avs (attributes and size) in comp struct ! initialize comp%domain and fill it with GlobGridNum, lat, lon, area, mask, frac ! MOAB component app registered, mesh created, tags defined (mesh and data), areas set - ! If processor has cpl or model: Do an infodata exchange + ! If processor has cpl or model: Do an mod2cpl_init infodata exchange ! If processor has model: Copy area to aream for now. !--------------------------------------------------------------------------------------- call t_startf('CPL:comp_init_cc_atm') @@ -1542,6 +1542,7 @@ subroutine cime_init() ! Initialize coupler-component data ! if processor has cpl or model ! init the extended gsMap that describes comp on mpijoin + ! call call cplcomp_moab_Init and use infodata ! MOAB: on component, send mesh (except lnd and rof). ! on coupler, register coupler version ! of app and receive mesh (except lnd and rof). The initial CommGraph is computed as part of From 863d22eb1edad4d928514951c0cc62235499dd68 Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Wed, 22 Feb 2023 23:32:45 -0600 Subject: [PATCH 330/467] add debugging compare calls after ice and lnd merge land merge for moab does nothing, as all fields are directly projected from atm, river or glacier we write LndCplAftMm to be able to see differences between mct AVs and moab tags on land, after this " merging " --- driver-moab/main/prep_ice_mod.F90 | 20 +++++++++++++++- driver-moab/main/prep_lnd_mod.F90 | 39 ++++++++++++++++++++++++++++++- 2 files changed, 57 insertions(+), 2 deletions(-) diff --git a/driver-moab/main/prep_ice_mod.F90 b/driver-moab/main/prep_ice_mod.F90 index 995eaedc448a..a8b2c90244eb 100644 --- a/driver-moab/main/prep_ice_mod.F90 +++ b/driver-moab/main/prep_ice_mod.F90 @@ -24,6 +24,9 @@ module prep_ice_mod use component_type_mod, only: component_get_x2c_cx, component_get_c2x_cx use component_type_mod, only: ice, atm, ocn, glc, rof use iso_c_binding +#ifdef MOABDEBUG + use component_type_mod, only: compare_mct_av_moab_tag +#endif implicit none save @@ -605,7 +608,7 @@ subroutine prep_ice_mrg_moab(infodata, rof_c2_ice) #endif - character(*), parameter :: subname = '(prep_ice_merge) ' + character(*), parameter :: subname = '(prep_ice_mrg_moab) ' !----------------------------------------------------------------------- call seq_infodata_GetData(infodata, & flux_epbalfact=flux_epbalfact) @@ -834,6 +837,21 @@ subroutine prep_ice_mrg_moab(infodata, rof_c2_ice) first_time = .false. #ifdef MOABDEBUG + !compare_mct_av_moab_tag(comp, attrVect, field, imoabApp, tag_name, ent_type, difference) + x2i_i => component_get_x2c_cx(ice(1)) + ! loop over all fields in seq_flds_x2i_fields + call mct_list_init(temp_list ,seq_flds_x2i_fields) + size_list=mct_list_nitem (temp_list) + ent_type = 1 ! cell for ice/ocean + if (iamroot) print *, num_moab_exports, trim(seq_flds_x2i_fields) + 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 compare_mct_av_moab_tag(ice(1), x2i_i, mct_field, mbixid, tagname, ent_type, difference) + enddo + call mct_list_clean(temp_list) + if (mbixid .ge. 0 ) then ! we are on coupler pes, for sure write(lnum,"(I0.2)")num_moab_exports outfile = 'IceCplAftMm'//trim(lnum)//'.h5m'//C_NULL_CHAR diff --git a/driver-moab/main/prep_lnd_mod.F90 b/driver-moab/main/prep_lnd_mod.F90 index f313485f0755..6b5f81582059 100644 --- a/driver-moab/main/prep_lnd_mod.F90 +++ b/driver-moab/main/prep_lnd_mod.F90 @@ -38,6 +38,12 @@ module prep_lnd_mod iMOAB_ComputeScalarProjectionWeights, iMOAB_DefineTagStorage, iMOAB_RegisterApplication, & iMOAB_WriteMesh, iMOAB_GetMeshInfo, iMOAB_SetDoubleTagStorage #endif + +#ifdef MOABDEBUG + use seq_comm_mct, only : num_moab_exports + use component_type_mod, only: compare_mct_av_moab_tag +#endif + implicit none save private @@ -633,7 +639,14 @@ subroutine prep_lnd_mrg_moab (infodata) type(mct_aVect_sharedindices),save :: a2x_sharedindices type(mct_aVect_sharedindices),save :: r2x_sharedindices type(mct_aVect_sharedindices),save :: g2x_sharedindices - +#ifdef MOABDEBUG + character(CXX) :: tagname, mct_field + character*32 :: outfile, wopts, lnum + real(r8) :: difference + type(mct_list) :: temp_list + integer :: size_list, index_list, ent_type, ierr + type(mct_string) :: mctOStr ! +#endif !----------------------------------------------------------------------- call seq_comm_getdata(CPLID, iamroot=iamroot) @@ -691,6 +704,30 @@ subroutine prep_lnd_mrg_moab (infodata) endif first_time = .false. +#ifdef MOABDEBUG + ! land does not do any merge for moab, all fields are directly projected, from atm, river, glacier + ! compare_mct_av_moab_tag(comp, attrVect, field, imoabApp, tag_name, ent_type, difference) + x2l_l => component_get_x2c_cx(lnd(1)) + ! loop over all fields in seq_flds_x2l_fields + call mct_list_init(temp_list ,seq_flds_x2l_fields) + size_list=mct_list_nitem (temp_list) + ent_type = 1 ! cell for land now, it is a full mesh + if (iamroot) print *, num_moab_exports, trim(seq_flds_x2l_fields) + 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 compare_mct_av_moab_tag(lnd(1), x2l_l, mct_field, mblxid, tagname, ent_type, difference) + enddo + call mct_list_clean(temp_list) + if (mblxid .ge. 0 ) then ! we are on coupler pes, for sure + write(lnum,"(I0.2)")num_moab_exports + outfile = 'LndCplAftMm'//trim(lnum)//'.h5m'//C_NULL_CHAR + wopts = ';PARALLEL=WRITE_PART'//C_NULL_CHAR ! + ierr = iMOAB_WriteMesh(mblxid, trim(outfile), trim(wopts)) + endif + +#endif end subroutine prep_lnd_mrg_moab !================================================================================================ From 5068fb43e45a00458636a34cadcf4a7dff4d60b5 Mon Sep 17 00:00:00 2001 From: Robert Jacob Date: Thu, 23 Feb 2023 22:16:26 -0600 Subject: [PATCH 331/467] zero out moab tags in sea ice init zero out moab tags in sea ice init as is done for ocean. Improves match with mct. --- components/mpas-seaice/driver/ice_comp_mct.F | 20 ++++++++++++++++---- 1 file changed, 16 insertions(+), 4 deletions(-) diff --git a/components/mpas-seaice/driver/ice_comp_mct.F b/components/mpas-seaice/driver/ice_comp_mct.F index c944a66afece..20ec71cd2c0d 100644 --- a/components/mpas-seaice/driver/ice_comp_mct.F +++ b/components/mpas-seaice/driver/ice_comp_mct.F @@ -43,7 +43,7 @@ module ice_comp_mct #ifdef HAVE_MOAB use mpas_moabmesh use seq_comm_mct, only: MPSIID - use iMOAB, only: iMOAB_DefineTagStorage + use iMOAB, only: iMOAB_DefineTagStorage, iMOAB_SetDoubleTagStorage use shr_kind_mod , only: cxx => SHR_KIND_CXX use seq_comm_mct, only: seq_comm_compare_mb_mct use seq_comm_mct, only: num_moab_exports @@ -221,12 +221,12 @@ subroutine ice_init_mct( EClock, cdata_i, x2i_i, i2x_i, NLFilename )!{{{ character(len=strKIND) :: curtime character(len=strKIND) :: history #ifdef HAVE_MOAB - integer :: ierrmb, numco, tagtype, tagindex + integer :: ierrmb, numco, tagtype, tagindex, ent_type character(CXX) :: tagname #ifdef MOABDEBUG real(r8) :: difference type(mct_list) :: temp_list - integer :: size_list, index_list, ent_type + integer :: size_list, index_list type(mct_string) :: mctOStr ! character(CXX) :: mct_field, modelStr #endif @@ -716,19 +716,31 @@ end subroutine xml_stream_get_attributes totalmblr = mblsize * nrecv ! size of the double array allocate (i2x_im(lsize, nsend) ) allocate (x2i_im(lsize, nrecv) ) + i2x_im = 0._r8 + x2i_im = 0._r8 ! define tags according to the seq_flds_i2x_fields + ! also zero them out tagtype = 1 ! dense, double numco = 1 ! one value per cell / entity + ent_type = 1 ! cells tagname = trim(seq_flds_i2x_fields)//C_NULL_CHAR ierrmb = iMOAB_DefineTagStorage(MPSIID, tagname, tagtype, numco, tagindex ) if ( ierrmb == 1 ) then call mpas_log_write('cannot define tags for MOAB i2x fields ' // trim(seq_flds_i2x_fields), MPAS_LOG_ERR) endif + ierrmb = iMOAB_SetDoubleTagStorage ( MPSIID, tagname, totalmbls , ent_type, i2x_im(1, 1) ) + if ( ierrmb /= 0 ) then + call mpas_log_write('cannot set tags for MOAB i2x fields to zero' // trim(seq_flds_i2x_fields), MPAS_LOG_ERR) + endif tagname = trim(seq_flds_x2i_fields)//C_NULL_CHAR ierrmb = iMOAB_DefineTagStorage(MPSIID, tagname, tagtype, numco, tagindex ) if ( ierrmb == 1 ) then call mpas_log_write('cannot define tags for MOAB i2x fields ' // trim(seq_flds_x2i_fields), MPAS_LOG_ERR) endif + ierrmb = iMOAB_SetDoubleTagStorage ( MPSIID, tagname, totalmblr , ent_type, x2i_im(1, 1) ) + if ( ierrmb /= 0 ) then + call mpas_log_write('cannot set tags for MOAB x2i fields to zero' // trim(seq_flds_x2i_fields), MPAS_LOG_ERR) + endif #endif @@ -1160,7 +1172,7 @@ subroutine ice_run_mct( EClock, cdata_i, x2i_i, i2x_i)!{{{ size_list=mct_list_nitem (temp_list) ent_type = 1 ! entity type is cell for ice print *, num_moab_exports, trim(seq_flds_x2i_fields), ' ice import check' - modelStr='ice' + modelStr='ice run' do index_list = 1, size_list call mct_list_get(mctOStr,index_list,temp_list) From 387afefded4c5b4b2b1387facef957e14147fbe7 Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Fri, 24 Feb 2023 14:05:36 -0600 Subject: [PATCH 332/467] remove cam_moab_export and introduce MOABCOMP cam_moab_export is not used anymore, and start using MOABCOMP for comparing with mct AV --- components/eam/src/control/cam_comp.F90 | 12 +- components/eam/src/cpl/atm_comp_mct.F90 | 34 ++-- components/eam/src/dynamics/se/semoab_mod.F90 | 147 +----------------- 3 files changed, 20 insertions(+), 173 deletions(-) diff --git a/components/eam/src/control/cam_comp.F90 b/components/eam/src/control/cam_comp.F90 index 676ca9a53bea..0345898b8dc8 100644 --- a/components/eam/src/control/cam_comp.F90 +++ b/components/eam/src/control/cam_comp.F90 @@ -37,9 +37,7 @@ module cam_comp public cam_run3 ! CAM run method phase 3 public cam_run4 ! CAM run method phase 4 public cam_final ! CAM Finalization -#ifdef HAVE_MOAB - public cam_moab_export ! load data from cam dynamics to moab api -#endif + ! ! Private module data ! @@ -435,14 +433,6 @@ subroutine cam_run4( cam_out, cam_in, rstwr, nlend, & end subroutine cam_run4 -#ifdef HAVE_MOAB -subroutine cam_moab_export() ! load data from cam dynamics to moab api - ! - call moab_export_data(dyn_out%elem) -end subroutine cam_moab_export -#endif - - ! !----------------------------------------------------------------------- ! diff --git a/components/eam/src/cpl/atm_comp_mct.F90 b/components/eam/src/cpl/atm_comp_mct.F90 index 7dae74a07a68..55087b0e884d 100644 --- a/components/eam/src/cpl/atm_comp_mct.F90 +++ b/components/eam/src/cpl/atm_comp_mct.F90 @@ -27,7 +27,6 @@ module atm_comp_mct use atm_import_export ! atm_export_moab is private here, atm_import_moab too - ! we defined cam_moab_export in cam_comp; it has cam_init, cam_run1, 2, 3, 4, cam_final use cam_comp use cam_instance , only: cam_instance_init, inst_index, inst_suffix use cam_control_mod , only: nsrest, aqua_planet, eccen, obliqr, lambm0, mvelpp @@ -64,9 +63,10 @@ module atm_comp_mct use seq_comm_mct , only: mphaid ! atm physics grid id in MOAB, on atm pes use iso_c_binding use seq_comm_mct, only : num_moab_exports +#ifdef MOABCOMP use seq_comm_mct, only: seq_comm_compare_mb_mct #endif - +#endif ! @@ -118,12 +118,14 @@ module atm_comp_mct integer , private :: mblsize, totalmbls, nsend, totalmbls_r, nrecv real(r8) , allocatable, private :: a2x_am(:,:) ! atm to coupler, on atm mesh, on atm component pes real(r8) , allocatable, private :: x2a_am(:,:) ! coupler to atm, on atm mesh, on atm component pes -#endif -#ifdef MOABDEBUG - integer :: mpicom_atm_moab ! used just for mpi-reducing the difference betweebn moab tags and mct avs + +#ifdef MOABCOMP + integer :: mpicom_atm_moab ! used just for mpi-reducing the difference between moab tags and mct avs integer :: rank2 #endif -! + +#endif + !================================================================================ CONTAINS !================================================================================ @@ -185,7 +187,7 @@ subroutine atm_init_mct( EClock, cdata_a, x2a_a, a2x_a, NLFilename ) ! hdim2_d == 1. character(len=64) :: filein ! Input namelist filename -#ifdef MOABDEBUG +#ifdef MOABCOMP real(r8) :: difference type(mct_list) :: temp_list integer :: size_list, index_list, ent_type @@ -206,10 +208,12 @@ subroutine atm_init_mct( EClock, cdata_a, x2a_a, a2x_a, NLFilename ) call seq_cdata_setptrs(cdata_a, ID=ATMID, mpicom=mpicom_atm, & gsMap=gsMap_atm, dom=dom_a, infodata=infodata) -#ifdef MOABDEBUG + +#ifdef MOABCOMP mpicom_atm_moab = mpicom_atm ! just store it now, for later use call shr_mpi_commrank( mpicom_atm_moab, rank2 ) #endif + if (first_time) then call cam_instance_init(ATMID) @@ -456,7 +460,7 @@ subroutine atm_init_mct( EClock, cdata_a, x2a_a, a2x_a, NLFilename ) call seq_timemgr_EClockGetData(EClock,curr_ymd=CurrentYMD, StepNo=StepNo, dtime=DTime_Sync ) if (StepNo == 0) then -#ifdef MOABDEBUG +#ifdef MOABCOMP !compare_to_moab_tag(mpicom_atm_moab, attrVect, field, imoabApp, tag_name, ent_type, difference) !x2o_o => component_get_x2c_cx(ocn(1)) ! loop over all fields in seq_flds_x2a_fields @@ -592,7 +596,7 @@ subroutine atm_run_mct( EClock, cdata_a, x2a_a, a2x_a) integer :: lbnum character(len=*), parameter :: subname="atm_run_mct" !----------------------------------------------------------------------- -#ifdef MOABDEBUG +#ifdef MOABCOMP real(r8) :: difference type(mct_list) :: temp_list integer :: size_list, index_list, ent_type @@ -629,8 +633,10 @@ subroutine atm_run_mct( EClock, cdata_a, x2a_a, a2x_a) ! Map input from mct to cam data structure call t_startf ('CAM_import') - -#ifdef MOABDEBUG + +#ifdef HAVE_MOAB + +#ifdef MOABCOMP !x2o_o => component_get_x2c_cx(ocn(1)) ! loop over all fields in seq_flds_a2x_fields call mct_list_init(temp_list ,seq_flds_x2a_fields) @@ -647,7 +653,6 @@ subroutine atm_run_mct( EClock, cdata_a, x2a_a, a2x_a) call mct_list_clean(temp_list) #endif -#ifdef HAVE_MOAB call atm_import_moab(cam_in) #endif ! move moab import before regular atm import, so it would hopefully not be a problem @@ -713,9 +718,6 @@ subroutine atm_run_mct( EClock, cdata_a, x2a_a, a2x_a) call t_startf ('CAM_export') call atm_export( cam_out, a2x_a%rattr ) #ifdef HAVE_MOAB - ! move method out of the do while (.not. do send) loop; do not send yet - ! call cam_moab_export() - ! call method to set all seq_flds_a2x_fields on phys grid point cloud; ! it will be moved then to Atm Spectral mesh on coupler ; just to show how to move it to atm spectral ! on coupler diff --git a/components/eam/src/dynamics/se/semoab_mod.F90 b/components/eam/src/dynamics/se/semoab_mod.F90 index 792b9b394bed..bd053dfdcceb 100644 --- a/components/eam/src/dynamics/se/semoab_mod.F90 +++ b/components/eam/src/dynamics/se/semoab_mod.F90 @@ -313,17 +313,6 @@ subroutine create_moab_meshes(par, elem) ierr = iMOAB_GetIntTagStorage ( MHFID, newtagg, nverts , ent_type, vgids) if (ierr > 0 ) & call endrun('Error: fail to retrieve GLOBAL ID on each task') -#ifdef MOABDEBUG -! write in serial, on each task, before ghosting - if (par%rank .lt. 4) then - write(lnum,"(I0.2)")par%rank - localmeshfile = 'fineh_'//trim(lnum)// '.h5m' // C_NULL_CHAR - wopts = C_NULL_CHAR - ierr = iMOAB_WriteMesh(MHFID, localmeshfile, wopts) - if (ierr > 0 ) & - call endrun('Error: fail to write local mesh file') - endif -#endif ierr = iMOAB_UpdateMeshInfo(MHFID) if (ierr > 0 ) & call endrun('Error: fail to update mesh info') @@ -336,15 +325,6 @@ subroutine create_moab_meshes(par, elem) call endrun('Error: fail to write the mesh file') #endif - ! deallocate -! deallocate(moabvh) -! deallocate(moabconn) -! deallocate(vdone) -! deallocate(indx) -! deallocate(elemids) - - - ! now create the coarse mesh, but the global dofs will come from fine mesh, after solving ! nelemd2 = nelemd @@ -516,17 +496,6 @@ subroutine create_moab_meshes(par, elem) if (ierr > 0 ) & call endrun('Error: fail to create atm to ocean tag') -#ifdef MOABDEBUG -! write in serial, on each task, before ghosting - if (par%rank .lt. 5) then - write(lnum,"(I0.2)")par%rank - localmeshfile = 'owned_'//trim(lnum)// '.h5m' // C_NULL_CHAR - wopts = C_NULL_CHAR - ierr = iMOAB_WriteMesh(MHID, localmeshfile, wopts) - if (ierr > 0 ) & - call endrun('Error: fail to write local mesh file') - endif -#endif ierr = iMOAB_UpdateMeshInfo(MHID) if (ierr > 0 ) & call endrun('Error: fail to update mesh info') @@ -810,120 +779,6 @@ subroutine create_moab_meshes(par, elem) ! end copy end subroutine create_moab_meshes - - subroutine moab_export_data(elem) - - use iMOAB, only: iMOAB_GetMeshInfo, iMOAB_SetDoubleTagStorage, iMOAB_WriteMesh - type(element_t), pointer :: elem(:) - - integer num_elem, ierr - integer nvert(3), nvise(3), nbl(3), nsurf(3), nvisBC(3) - integer :: size_tag_array, nvalperelem, ie, i, j, je, ix, ent_type, idx - - real(kind=real_kind), allocatable :: valuesTag(:) - character*100 outfile, wopts, tagname, lnum - - if (atm_pg_active) return ! do nothing here, as we do not have to migrate from here; - ! count number of calls - num_calls_export = num_calls_export + 1 - - ierr = iMOAB_GetMeshInfo ( MHID, nvert, nvise, nbl, nsurf, nvisBC ); - ! find out the number of local elements in moab mesh - num_elem = nvise(1) - ! now print the temperature from the state, and set it - nvalperelem = np*np - size_tag_array = nvalperelem*num_elem - !print *, 'num_elem = ', num_elem - !print *, ((local_map(i,j), i=1,np), j=1,np) - !print *, (moabconn(i), i=1,np*np) - ! now load the values on both tags - allocate(valuesTag(size_tag_array)) ! will use the same array for vertex array - - do ie=1,num_elem - do j=1,np - do i=1,np - valuesTag ( (ie-1)*np*np+(j-1)*np + i ) = elem(ie)%state%vtheta_dp(i,j,nlev,1) ! time level 1? - enddo - enddo - enddo - ! set the tag - tagname='a2oTbot'//C_NULL_CHAR ! atm to ocean tag for temperature - ent_type = 1 ! element type - ierr = iMOAB_SetDoubleTagStorage ( MHID, tagname, size_tag_array, ent_type, valuesTag) - if (ierr > 0 ) & - call endrun('Error: fail to set a2oTbot tag for coarse elements') - - ! loop now for U velocity ( a2oUbot tag) - do ie=1,num_elem - do j=1,np - do i=1,np - valuesTag ( (ie-1)*np*np+(j-1)*np + i ) = elem(ie)%state%v(i,j,1,nlev,1) ! time level 1, U comp - enddo - enddo - enddo - ! set the tag - tagname='a2oUbot'//C_NULL_CHAR ! atm to ocean tag for U velocity - ent_type = 1 ! element type - ierr = iMOAB_SetDoubleTagStorage ( MHID, tagname, size_tag_array, ent_type, valuesTag) - if (ierr > 0 ) & - call endrun('Error: fail to set a2oUbot tag for coarse elements') - - ! loop now for V velocity ( a2oVbot tag) - do ie=1,num_elem - do j=1,np - do i=1,np - valuesTag ( (ie-1)*np*np+(j-1)*np + i ) = elem(ie)%state%v(i,j,2,nlev,1) ! time level 1, V comp - enddo - enddo - enddo - ! set the tag - tagname='a2oVbot'//C_NULL_CHAR ! atm to ocean tag for V velocity - ent_type = 1 ! element type - ierr = iMOAB_SetDoubleTagStorage ( MHID, tagname, size_tag_array, ent_type, valuesTag) - if (ierr > 0 ) & - call endrun('Error: fail to set a2oVbot tag for coarse elements') - - -#ifdef MOABDEBUG - ! write out the mesh file to disk, in parallel - write(lnum,"(I0.2)")num_calls_export - outfile = 'wholeATM_T_'//trim(lnum)// '.h5m' // C_NULL_CHAR - wopts = 'PARALLEL=WRITE_PART'//C_NULL_CHAR - ierr = iMOAB_WriteMesh(MHID, outfile, wopts) - if (ierr > 0 ) & - call endrun('Error: fail to write the mesh file') -#endif - - ! for debugging, set the tag on fine mesh too (for visu) - do ie=1,num_elem - je = (ie-1)*(np-1)*(np-1)*4 - do j=1,np - do i= 1,np - ix = local_map(i,j) - idx = moabconn( je + ix ) ! - valuesTag ( idx ) = elem(ie)%state%vtheta_dp(i,j,nlev,1) - end do - end do - end do - - tagname='a2o_T'//C_NULL_CHAR ! atm to ocean tag, on fine mesh - ierr = iMOAB_GetMeshInfo ( MHFID, nvert, nvise, nbl, nsurf, nvisBC ); - ent_type = 0 ! vertex type - ierr = iMOAB_SetDoubleTagStorage ( MHFID, tagname, nvert(1), ent_type, valuesTag) - if (ierr > 0 ) & - call endrun('Error: fail to set a2o_T tag for fine vertices') - -#ifdef MOABDEBUG - ! write out the mesh file to disk, in parallel - - outfile = 'wholeFineATM_T_'//trim(lnum)// '.h5m' // C_NULL_CHAR - - ierr = iMOAB_WriteMesh(MHFID, outfile, wopts) - if (ierr > 0 ) & - call endrun('Error: fail to write the fine mesh file, with a temperature on it') -#endif - - deallocate(valuesTag) - end subroutine moab_export_data + #endif end module semoab_mod From c7e9c2563efbfda3cf4059b7aeed1605ebe20f75 Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Fri, 24 Feb 2023 16:28:59 -0600 Subject: [PATCH 333/467] MOABCOMP instead of MOABDEBUG --- components/eam/src/control/cam_comp.F90 | 4 --- components/elm/src/cpl/lnd_comp_mct.F90 | 13 +++++----- components/mosart/src/cpl/rof_comp_mct.F90 | 4 +-- components/mpas-seaice/driver/ice_comp_mct.F | 8 +++--- driver-moab/main/cime_comp_mod.F90 | 12 +-------- driver-moab/main/component_type_mod.F90 | 5 ++-- driver-moab/main/cplcomp_exchange_mod.F90 | 4 --- driver-moab/main/prep_atm_mod.F90 | 11 ++++++--- driver-moab/main/prep_ice_mod.F90 | 8 ++++-- driver-moab/main/prep_lnd_mod.F90 | 15 +++++++---- driver-moab/main/prep_ocn_mod.F90 | 26 ++++++++------------ driver-moab/main/prep_rof_mod.F90 | 8 ++++-- 12 files changed, 55 insertions(+), 63 deletions(-) diff --git a/components/eam/src/control/cam_comp.F90 b/components/eam/src/control/cam_comp.F90 index 0345898b8dc8..062585c21b18 100644 --- a/components/eam/src/control/cam_comp.F90 +++ b/components/eam/src/control/cam_comp.F90 @@ -21,10 +21,6 @@ module cam_comp use cam_logfile, only: iulog use physics_buffer, only: physics_buffer_desc -#ifdef HAVE_MOAB - use semoab_mod, only: moab_export_data -#endif - implicit none private save diff --git a/components/elm/src/cpl/lnd_comp_mct.F90 b/components/elm/src/cpl/lnd_comp_mct.F90 index fb415168c642..bd9574c541d6 100644 --- a/components/elm/src/cpl/lnd_comp_mct.F90 +++ b/components/elm/src/cpl/lnd_comp_mct.F90 @@ -20,7 +20,7 @@ module lnd_comp_mct use seq_comm_mct, only: num_moab_exports use seq_flds_mod , only : seq_flds_x2l_fields, seq_flds_l2x_fields -#ifdef MOABDEBUG +#ifdef MOABCOMP use seq_comm_mct , only: seq_comm_compare_mb_mct #endif #endif @@ -50,7 +50,7 @@ module lnd_comp_mct real (r8) , allocatable, private :: x2l_lm(:,:) ! for tags from MOAB logical :: sameg_al ! save it for export :) -#ifdef MOABDEBUG +#ifdef MOABCOMP integer :: mpicom_lnd_moab ! used just for mpi-reducing the difference betweebn moab tags and mct avs integer :: rank2 #endif @@ -171,7 +171,7 @@ subroutine lnd_init_mct( EClock, cdata_l, x2l_l, l2x_l, NLFilename ) call elm_instance_init( LNDID ) ! Determine attriute vector indices -#ifdef MOABDEBUG +#ifdef MOABCOMP mpicom_lnd_moab = mpicom_lnd ! just store it now, for later use call shr_mpi_commrank( mpicom_lnd_moab, rank2 ) #endif @@ -510,7 +510,7 @@ subroutine lnd_run_mct(EClock, cdata_l, x2l_l, l2x_l) type(bounds_type) :: bounds ! bounds character(len=32) :: rdate ! date char string for restart file names character(len=32), parameter :: sub = "lnd_run_mct" -#ifdef MOABDEBUG +#ifdef MOABCOMP real(r8) :: difference type(mct_list) :: temp_list integer :: size_list, index_list, ent_type @@ -565,8 +565,9 @@ subroutine lnd_run_mct(EClock, cdata_l, x2l_l, l2x_l) ! Map to elm (only when state and/or fluxes need to be updated) call t_startf ('lc_lnd_import') +#ifdef HAVE_MOAB ! first call moab import -#ifdef MOABDEBUG +#ifdef MOABCOMP !compare_to_moab_tag_lnd(mpicom_moab, attrVect, field, imoabApp, tag_name, ent_type, difference) !x2o_o => component_get_x2c_cx(ocn(1)) ! loop over all fields in seq_flds_x2a_fields @@ -585,8 +586,6 @@ subroutine lnd_run_mct(EClock, cdata_l, x2l_l, l2x_l) call mct_list_clean(temp_list) #endif - -#ifdef HAVE_MOAB call lnd_import_moab( bounds, atm2lnd_vars, glc2lnd_vars) #endif diff --git a/components/mosart/src/cpl/rof_comp_mct.F90 b/components/mosart/src/cpl/rof_comp_mct.F90 index fec03243550c..766673eb42d3 100644 --- a/components/mosart/src/cpl/rof_comp_mct.F90 +++ b/components/mosart/src/cpl/rof_comp_mct.F90 @@ -422,7 +422,7 @@ subroutine rof_run_mct( EClock, cdata_r, x2r_r, r2x_r) character(len=32), parameter :: sub = "rof_run_mct" !------------------------------------------------------- -#ifdef MOABDEBUG +#ifdef MOABCOMP real(r8) :: difference type(mct_list) :: temp_list integer :: size_list, index_list, ent_type @@ -451,7 +451,7 @@ subroutine rof_run_mct( EClock, cdata_r, x2r_r, r2x_r) call t_startf ('lc_rof_import') #ifdef HAVE_MOAB -#ifdef MOABDEBUG +#ifdef MOABCOMP ! loop over all fields in seq_flds_x2r_fields call mct_list_init(temp_list ,seq_flds_x2r_fields) size_list=mct_list_nitem (temp_list) diff --git a/components/mpas-seaice/driver/ice_comp_mct.F b/components/mpas-seaice/driver/ice_comp_mct.F index 20ec71cd2c0d..ad4deae5c1db 100644 --- a/components/mpas-seaice/driver/ice_comp_mct.F +++ b/components/mpas-seaice/driver/ice_comp_mct.F @@ -223,7 +223,7 @@ subroutine ice_init_mct( EClock, cdata_i, x2i_i, i2x_i, NLFilename )!{{{ #ifdef HAVE_MOAB integer :: ierrmb, numco, tagtype, tagindex, ent_type character(CXX) :: tagname -#ifdef MOABDEBUG +#ifdef MOABCOMP real(r8) :: difference type(mct_list) :: temp_list integer :: size_list, index_list @@ -828,7 +828,7 @@ end subroutine xml_stream_get_attributes !----------------------------------------------------------------------- #ifdef HAVE_MOAB -#ifdef MOABDEBUG +#ifdef MOABCOMP mpicom_moab = mpicom_i ! save it for run method ! loop over all fields in seq_flds_x2i_fields call mct_list_init(temp_list ,seq_flds_x2i_fields) @@ -1136,7 +1136,7 @@ subroutine ice_run_mct( EClock, cdata_i, x2i_i, i2x_i)!{{{ real(kind=RKIND), pointer :: & dayOfNextShortwaveCalculation ! needed for CESM like coupled simulations -#ifdef MOABDEBUG +#ifdef MOABCOMP real(r8) :: difference type(mct_list) :: temp_list integer :: size_list, index_list, ent_type @@ -1166,7 +1166,7 @@ subroutine ice_run_mct( EClock, cdata_i, x2i_i, i2x_i)!{{{ ! reinitialize fluxes call seaice_column_reinitialize_fluxes(domain) #ifdef HAVE_MOAB -#ifdef MOABDEBUG +#ifdef MOABCOMP ! loop over all fields in seq_flds_x2i_fields call mct_list_init(temp_list ,seq_flds_x2i_fields) size_list=mct_list_nitem (temp_list) diff --git a/driver-moab/main/cime_comp_mod.F90 b/driver-moab/main/cime_comp_mod.F90 index f89b5887c0aa..63ed6ce52124 100644 --- a/driver-moab/main/cime_comp_mod.F90 +++ b/driver-moab/main/cime_comp_mod.F90 @@ -203,7 +203,7 @@ module cime_comp_mod use component_type_mod , only: expose_mct_grid_moab #endif -#ifdef MOABDEBUG +#ifdef MOABCOMP use iso_c_binding #endif @@ -1422,11 +1422,6 @@ subroutine cime_init() seq_flds_o2x_fields, seq_flds_r2x_fields, seq_flds_i2x_fields use seq_comm_mct , only : mphaid, mbaxid, mlnid, mblxid, mrofid, mbrxid, mpoid, mboxid, mpsiid, mbixid use seq_comm_mct, only: num_moab_exports ! used to count the steps for moab files -#ifdef MOABDEBUG - real(r8) :: difference - character(20) :: mct_field, tagname - integer :: ent_type -#endif 103 format( 5A ) @@ -4293,11 +4288,6 @@ end subroutine cime_run_iac_recv_post subroutine cime_run_atmocn_setup(hashint) integer, intent(inout) :: hashint(:) -#ifdef MOABDEBUG - real(r8) :: difference - character(20) :: mct_field, tagname - integer :: ent_type -#endif ! call prep_ocn_calc_i2x_ox_moab() ! this does projection from ice to ocean on coupler, by simply matching if (iamin_CPLID) then diff --git a/driver-moab/main/component_type_mod.F90 b/driver-moab/main/component_type_mod.F90 index 6a5c1611769f..202799fe1af5 100644 --- a/driver-moab/main/component_type_mod.F90 +++ b/driver-moab/main/component_type_mod.F90 @@ -51,7 +51,7 @@ module component_type_mod ! this is to replicate mct grid of a cx public :: expose_mct_grid_moab -#ifdef MOABDEBUG +#ifdef MOABCOMP public :: compare_mct_av_moab_tag #endif @@ -349,6 +349,7 @@ subroutine expose_mct_grid_moab (comp, imoabAPI) if (ierr > 0 ) & call shr_sys_abort(subname//'Error: fail to set GLOBAL_ID tag ') + ! MOAB TODO is this needed ? no vertices should be shared here, maybe just to set the part tag ? ierr = iMOAB_ResolveSharedEntities( imoabAPI, lsz, vgids ); if (ierr > 0 ) & call shr_sys_abort(subname//'Error: fail to resolve shared entities') @@ -409,7 +410,7 @@ subroutine expose_mct_grid_moab (comp, imoabAPI) end subroutine expose_mct_grid_moab -#ifdef MOABDEBUG +#ifdef MOABCOMP ! assumes everything is on coupler pes here, to make sense subroutine compare_mct_av_moab_tag(comp, attrVect, mct_field, appId, tagname, ent_type, difference) diff --git a/driver-moab/main/cplcomp_exchange_mod.F90 b/driver-moab/main/cplcomp_exchange_mod.F90 index e72a633364ab..71c36d0a9d9f 100644 --- a/driver-moab/main/cplcomp_exchange_mod.F90 +++ b/driver-moab/main/cplcomp_exchange_mod.F90 @@ -1024,10 +1024,6 @@ subroutine cplcomp_moab_Init(infodata,comp) integer :: typeA, typeB, ATM_PHYS_CID ! used to compute par graph between atm phys ! and atm spectral on coupler character(CXX) :: tagname -#ifdef MOABDEBUG - integer , dimension(1:3) :: nverts, nelem, nblocks, nsbc, ndbc - integer, dimension(:), allocatable :: vgids -#endif !----------------------------------------------------- diff --git a/driver-moab/main/prep_atm_mod.F90 b/driver-moab/main/prep_atm_mod.F90 index 085558670eff..fadc0218619c 100644 --- a/driver-moab/main/prep_atm_mod.F90 +++ b/driver-moab/main/prep_atm_mod.F90 @@ -36,7 +36,7 @@ module prep_atm_mod use seq_comm_mct, only : num_moab_exports use dimensions_mod, only : np ! for atmosphere -#ifdef MOABDEBUG +#ifdef MOABCOMP use component_type_mod, only: compare_mct_av_moab_tag #endif @@ -810,6 +810,8 @@ subroutine prep_atm_mrg_moab(infodata, xao_ax) integer :: ent_type, ierr, arrsize #ifdef MOABDEBUG character*32 :: outfile, wopts, lnum +#endif +#ifdef MOABCOMP real(r8) :: difference type(mct_list) :: temp_list integer :: size_list, index_list @@ -1211,7 +1213,7 @@ subroutine prep_atm_mrg_moab(infodata, xao_ax) if (ierr .ne. 0) then call shr_sys_abort(subname//' error in setting x2o_om array ') endif -#ifdef MOABDEBUG +#ifdef MOABCOMP !compare_mct_av_moab_tag(comp, attrVect, field, imoabApp, tag_name, ent_type, difference) x2a_a => component_get_x2c_cx(atm(1)) ! loop over all fields in seq_flds_x2a_fields @@ -1226,14 +1228,15 @@ subroutine prep_atm_mrg_moab(infodata, xao_ax) call compare_mct_av_moab_tag(atm(1), x2a_a, mct_field, mbaxid, tagname, ent_type, difference) enddo call mct_list_clean(temp_list) +#endif - +#ifdef MOABDEBUG if (mboxid .ge. 0 ) then ! we are on coupler pes, for sure write(lnum,"(I0.2)")num_moab_exports outfile = 'AtmCplAftMm'//trim(lnum)//'.h5m'//C_NULL_CHAR wopts = ';PARALLEL=WRITE_PART'//C_NULL_CHAR ! ierr = iMOAB_WriteMesh(mbaxid, trim(outfile), trim(wopts)) - endif + endif #endif if (first_time) then diff --git a/driver-moab/main/prep_ice_mod.F90 b/driver-moab/main/prep_ice_mod.F90 index a8b2c90244eb..dcdfd567493d 100644 --- a/driver-moab/main/prep_ice_mod.F90 +++ b/driver-moab/main/prep_ice_mod.F90 @@ -24,7 +24,7 @@ module prep_ice_mod use component_type_mod, only: component_get_x2c_cx, component_get_c2x_cx use component_type_mod, only: ice, atm, ocn, glc, rof use iso_c_binding -#ifdef MOABDEBUG +#ifdef MOABCOMP use component_type_mod, only: compare_mct_av_moab_tag #endif @@ -601,6 +601,8 @@ subroutine prep_ice_mrg_moab(infodata, rof_c2_ice) integer ent_type, ierr,n #ifdef MOABDEBUG character*32 :: outfile, wopts, lnum +#endif +#ifdef MOABCOMP real(r8) :: difference type(mct_list) :: temp_list integer :: size_list, index_list @@ -836,7 +838,7 @@ subroutine prep_ice_mrg_moab(infodata, rof_c2_ice) first_time = .false. -#ifdef MOABDEBUG +#ifdef MOABCOMP !compare_mct_av_moab_tag(comp, attrVect, field, imoabApp, tag_name, ent_type, difference) x2i_i => component_get_x2c_cx(ice(1)) ! loop over all fields in seq_flds_x2i_fields @@ -851,7 +853,9 @@ subroutine prep_ice_mrg_moab(infodata, rof_c2_ice) call compare_mct_av_moab_tag(ice(1), x2i_i, mct_field, mbixid, tagname, ent_type, difference) enddo call mct_list_clean(temp_list) +#endif +#ifdef MOABDEBUG if (mbixid .ge. 0 ) then ! we are on coupler pes, for sure write(lnum,"(I0.2)")num_moab_exports outfile = 'IceCplAftMm'//trim(lnum)//'.h5m'//C_NULL_CHAR diff --git a/driver-moab/main/prep_lnd_mod.F90 b/driver-moab/main/prep_lnd_mod.F90 index 6b5f81582059..4d4b7d66361f 100644 --- a/driver-moab/main/prep_lnd_mod.F90 +++ b/driver-moab/main/prep_lnd_mod.F90 @@ -37,10 +37,10 @@ module prep_lnd_mod use iMOAB , only: iMOAB_ComputeCommGraph, iMOAB_ComputeMeshIntersectionOnSphere, & iMOAB_ComputeScalarProjectionWeights, iMOAB_DefineTagStorage, iMOAB_RegisterApplication, & iMOAB_WriteMesh, iMOAB_GetMeshInfo, iMOAB_SetDoubleTagStorage + use seq_comm_mct, only : num_moab_exports #endif -#ifdef MOABDEBUG - use seq_comm_mct, only : num_moab_exports +#ifdef MOABCOMP use component_type_mod, only: compare_mct_av_moab_tag #endif @@ -640,11 +640,14 @@ subroutine prep_lnd_mrg_moab (infodata) type(mct_aVect_sharedindices),save :: r2x_sharedindices type(mct_aVect_sharedindices),save :: g2x_sharedindices #ifdef MOABDEBUG - character(CXX) :: tagname, mct_field + integer :: ierr character*32 :: outfile, wopts, lnum +#endif +#ifdef MOABCOMP + character(CXX) :: tagname, mct_field real(r8) :: difference type(mct_list) :: temp_list - integer :: size_list, index_list, ent_type, ierr + integer :: size_list, index_list, ent_type type(mct_string) :: mctOStr ! #endif !----------------------------------------------------------------------- @@ -704,7 +707,7 @@ subroutine prep_lnd_mrg_moab (infodata) endif first_time = .false. -#ifdef MOABDEBUG +#ifdef MOABCOMP ! land does not do any merge for moab, all fields are directly projected, from atm, river, glacier ! compare_mct_av_moab_tag(comp, attrVect, field, imoabApp, tag_name, ent_type, difference) x2l_l => component_get_x2c_cx(lnd(1)) @@ -720,6 +723,8 @@ subroutine prep_lnd_mrg_moab (infodata) call compare_mct_av_moab_tag(lnd(1), x2l_l, mct_field, mblxid, tagname, ent_type, difference) enddo call mct_list_clean(temp_list) +#endif +#ifdef MOABDEBUG if (mblxid .ge. 0 ) then ! we are on coupler pes, for sure write(lnum,"(I0.2)")num_moab_exports outfile = 'LndCplAftMm'//trim(lnum)//'.h5m'//C_NULL_CHAR diff --git a/driver-moab/main/prep_ocn_mod.F90 b/driver-moab/main/prep_ocn_mod.F90 index 9158939708af..b0aa2a5307cb 100644 --- a/driver-moab/main/prep_ocn_mod.F90 +++ b/driver-moab/main/prep_ocn_mod.F90 @@ -39,7 +39,7 @@ module prep_ocn_mod use mct_mod use perf_mod use component_type_mod, only: component_get_x2c_cx, component_get_c2x_cx -#ifdef MOABDEBUG +#ifdef MOABCOMP use component_type_mod, only: compare_mct_av_moab_tag #endif use component_type_mod, only: ocn, atm, ice, rof, wav, glc @@ -1056,10 +1056,13 @@ subroutine prep_ocn_mrg_moab(infodata, xao_ox) integer nvert(3), nvise(3), nbl(3), nsurf(3), nvisBC(3) ! for moab info - character(CXX) ::tagname, mct_field + character(CXX) ::tagname integer :: ent_type, ierr #ifdef MOABDEBUG character*32 :: outfile, wopts, lnum +#endif +#ifdef MOABCOMP + character(CXX) :: mct_field real(r8) :: difference type(mct_list) :: temp_list integer :: size_list, index_list @@ -1704,7 +1707,7 @@ subroutine prep_ocn_mrg_moab(infodata, xao_ox) -#ifdef MOABDEBUG +#ifdef MOABCOMP !compare_mct_av_moab_tag(comp, attrVect, field, imoabApp, tag_name, ent_type, difference) x2o_o => component_get_x2c_cx(ocn(1)) ! loop over all fields in seq_flds_x2o_fields @@ -1719,8 +1722,9 @@ subroutine prep_ocn_mrg_moab(infodata, xao_ox) call compare_mct_av_moab_tag(ocn(1), x2o_o, mct_field, mboxid, tagname, ent_type, difference) enddo call mct_list_clean(temp_list) +#endif - +#ifdef MOABDEBUG if (mboxid .ge. 0 ) then ! we are on coupler pes, for sure write(lnum,"(I0.2)")num_moab_exports outfile = 'OcnCplAftMm'//trim(lnum)//'.h5m'//C_NULL_CHAR @@ -1756,10 +1760,7 @@ subroutine prep_ocn_merge( flux_epbalfact, a2x_o, i2x_o, r2x_o, w2x_o, g2x_o, xa fractions_o, x2o_o ) use prep_glc_mod, only: prep_glc_calculate_subshelf_boundary_fluxes -#ifdef MOABDEBUG - use iMOAB, only : iMOAB_SetDoubleTagStorageWithGid, iMOAB_WriteMesh - use component_type_mod, only : component_get_dom_cx -#endif + !----------------------------------------------------------------------- ! ! Arguments @@ -1891,14 +1892,7 @@ subroutine prep_ocn_merge( flux_epbalfact, a2x_o, i2x_o, r2x_o, w2x_o, g2x_o, xa type(mct_aVect_sharedindices),save :: g2x_sharedindices logical, save :: first_time = .true. character(*),parameter :: subName = '(prep_ocn_merge) ' -#ifdef MOABDEBUG - real(r8) , allocatable :: values(:) - type(mct_ggrid), pointer :: dom - integer , allocatable :: GlobalIds(:) ! used for setting values associated with ids - character(CXX) ::tagname - integer :: kgg, ent_type, ierr - character*32 :: outfile, wopts, lnum -#endif + !----------------------------------------------------------------------- call seq_comm_setptrs(CPLID, iamroot=iamroot) diff --git a/driver-moab/main/prep_rof_mod.F90 b/driver-moab/main/prep_rof_mod.F90 index 9f0862f1c9af..50591541ef30 100644 --- a/driver-moab/main/prep_rof_mod.F90 +++ b/driver-moab/main/prep_rof_mod.F90 @@ -31,7 +31,7 @@ module prep_rof_mod use map_lnd2rof_irrig_mod, only: map_lnd2rof_irrig use iso_c_binding -#ifdef MOABDEBUG +#ifdef MOABCOMP use component_type_mod, only: compare_mct_av_moab_tag #endif @@ -1148,6 +1148,8 @@ subroutine prep_rof_mrg_moab (infodata, cime_model) integer, save :: naflds, nlflds ! these are saved the first time #ifdef MOABDEBUG character*32 :: outfile, wopts, lnum +#endif +#ifdef MOABCOMP real(r8) :: difference type(mct_list) :: temp_list integer :: size_list, index_list @@ -1412,7 +1414,7 @@ subroutine prep_rof_mrg_moab (infodata, cime_model) endif first_time = .false. -#ifdef MOABDEBUG +#ifdef MOABCOMP !compare_mct_av_moab_tag(comp, attrVect, field, imoabApp, tag_name, ent_type, difference) x2r_r => component_get_x2c_cx(rof(1)) ! loop over all fields in seq_flds_x2r_fields @@ -1427,7 +1429,9 @@ subroutine prep_rof_mrg_moab (infodata, cime_model) call compare_mct_av_moab_tag(rof(1), x2r_r, mct_field, mbrxid, tagname, ent_type, difference) enddo call mct_list_clean(temp_list) +#endif +#ifdef MOABDEBUG if (mbrxid .ge. 0 ) then ! we are on coupler pes, for sure write(lnum,"(I0.2)")num_moab_exports From 16956621cb9f7e16ab44d6ca78ad60622729996c Mon Sep 17 00:00:00 2001 From: Robert Jacob Date: Fri, 24 Feb 2023 17:35:40 -0600 Subject: [PATCH 334/467] Remove debugging prints Remove some debugging prints that were being made from every processor. --- components/mpas-ocean/driver/ocn_comp_mct.F | 2 -- components/mpas-seaice/driver/ice_comp_mct.F | 2 -- 2 files changed, 4 deletions(-) diff --git a/components/mpas-ocean/driver/ocn_comp_mct.F b/components/mpas-ocean/driver/ocn_comp_mct.F index 6d676ad744d7..60fb2c1a24ad 100644 --- a/components/mpas-ocean/driver/ocn_comp_mct.F +++ b/components/mpas-ocean/driver/ocn_comp_mct.F @@ -897,7 +897,6 @@ end subroutine xml_stream_get_attributes call mct_list_init(temp_list ,seq_flds_x2o_fields) size_list=mct_list_nitem (temp_list) ent_type = 1 ! entity type is cell for ocn - print *, num_moab_exports, trim(seq_flds_x2o_fields), ' ocn import check' modelStr='ocn init' mpicom_moab = mpicom_o ! save it for run method do index_list = 1, size_list @@ -1046,7 +1045,6 @@ subroutine ocn_run_mct( EClock, cdata_o, x2o_o, o2x_o)!{{{ call mct_list_init(temp_list ,seq_flds_x2o_fields) size_list=mct_list_nitem (temp_list) ent_type = 1 ! entity type is cell for ocn - print *, num_moab_exports, trim(seq_flds_x2o_fields), ' ocn import check' modelStr='ocn run' do index_list = 1, size_list call mct_list_get(mctOStr,index_list,temp_list) diff --git a/components/mpas-seaice/driver/ice_comp_mct.F b/components/mpas-seaice/driver/ice_comp_mct.F index ad4deae5c1db..24bc86e0b82c 100644 --- a/components/mpas-seaice/driver/ice_comp_mct.F +++ b/components/mpas-seaice/driver/ice_comp_mct.F @@ -834,7 +834,6 @@ end subroutine xml_stream_get_attributes call mct_list_init(temp_list ,seq_flds_x2i_fields) size_list=mct_list_nitem (temp_list) ent_type = 1 ! entity type is cell for ice - print *, num_moab_exports, trim(seq_flds_x2i_fields), ' ice import check' modelStr='ice init' do index_list = 1, size_list @@ -1171,7 +1170,6 @@ subroutine ice_run_mct( EClock, cdata_i, x2i_i, i2x_i)!{{{ call mct_list_init(temp_list ,seq_flds_x2i_fields) size_list=mct_list_nitem (temp_list) ent_type = 1 ! entity type is cell for ice - print *, num_moab_exports, trim(seq_flds_x2i_fields), ' ice import check' modelStr='ice run' do index_list = 1, size_list From 3a71503a7428065c4515a40e156034ab6ef9cfb8 Mon Sep 17 00:00:00 2001 From: Robert Jacob Date: Fri, 24 Feb 2023 17:41:24 -0600 Subject: [PATCH 335/467] Fix modStr and some comments Fix modStr in the compare output to be more informative. Fix/remove some comments --- components/eam/src/cpl/atm_comp_mct.F90 | 4 ++-- components/elm/src/cpl/lnd_comp_mct.F90 | 6 ++---- components/mosart/src/cpl/rof_comp_mct.F90 | 2 +- 3 files changed, 5 insertions(+), 7 deletions(-) diff --git a/components/eam/src/cpl/atm_comp_mct.F90 b/components/eam/src/cpl/atm_comp_mct.F90 index 55087b0e884d..66299c224038 100644 --- a/components/eam/src/cpl/atm_comp_mct.F90 +++ b/components/eam/src/cpl/atm_comp_mct.F90 @@ -468,7 +468,7 @@ subroutine atm_init_mct( EClock, cdata_a, x2a_a, a2x_a, NLFilename ) size_list=mct_list_nitem (temp_list) ent_type = 0 ! entity type is vertex for phys atm if (rank2 .eq. 0) print *, num_moab_exports, trim(seq_flds_x2a_fields), ' atm import check' - modelStr='atminit' + modelStr='atm init2' do index_list = 1, size_list call mct_list_get(mctOStr,index_list,temp_list) mct_field = mct_string_toChar(mctOStr) @@ -643,7 +643,7 @@ subroutine atm_run_mct( EClock, cdata_a, x2a_a, a2x_a) size_list=mct_list_nitem (temp_list) ent_type = 0 ! entity type is vertex for phys atm if (rank2 .eq. 0) print *, num_moab_exports, trim(seq_flds_x2a_fields) - modelStr ='atm' + modelStr ='atm run' do index_list = 1, size_list call mct_list_get(mctOStr,index_list,temp_list) mct_field = mct_string_toChar(mctOStr) diff --git a/components/elm/src/cpl/lnd_comp_mct.F90 b/components/elm/src/cpl/lnd_comp_mct.F90 index bd9574c541d6..8048968aeb8b 100644 --- a/components/elm/src/cpl/lnd_comp_mct.F90 +++ b/components/elm/src/cpl/lnd_comp_mct.F90 @@ -568,9 +568,7 @@ subroutine lnd_run_mct(EClock, cdata_l, x2l_l, l2x_l) #ifdef HAVE_MOAB ! first call moab import #ifdef MOABCOMP - !compare_to_moab_tag_lnd(mpicom_moab, attrVect, field, imoabApp, tag_name, ent_type, difference) - !x2o_o => component_get_x2c_cx(ocn(1)) - ! loop over all fields in seq_flds_x2a_fields + ! loop over all fields in seq_flds_x2l_fields call mct_list_init(temp_list ,seq_flds_x2l_fields) size_list=mct_list_nitem (temp_list) ent_type = 0 ! entity type is vertex for land, usually (bigrid case) @@ -579,7 +577,7 @@ subroutine lnd_run_mct(EClock, cdata_l, x2l_l, l2x_l) call mct_list_get(mctOStr,index_list,temp_list) mct_field = mct_string_toChar(mctOStr) tagname= trim(mct_field)//C_NULL_CHAR - modelStr = 'lnd' + modelStr = 'lnd run' !call compare_to_moab_tag_lnd(mpicom_lnd_moab, x2l_l, mct_field, mlnid, tagname, ent_type, difference) call seq_comm_compare_mb_mct(modelStr, mpicom_lnd_moab, x2l_l, mct_field, mlnid, tagname, ent_type, difference) enddo diff --git a/components/mosart/src/cpl/rof_comp_mct.F90 b/components/mosart/src/cpl/rof_comp_mct.F90 index 766673eb42d3..a2f02582b5e2 100644 --- a/components/mosart/src/cpl/rof_comp_mct.F90 +++ b/components/mosart/src/cpl/rof_comp_mct.F90 @@ -457,7 +457,7 @@ subroutine rof_run_mct( EClock, cdata_r, x2r_r, r2x_r) size_list=mct_list_nitem (temp_list) ent_type = 0 ! entity type is vertex for phys atm if (masterproc) print *, num_moab_exports, trim(seq_flds_x2r_fields), ' rof import check' - modelStr='rof' + modelStr='rof run' do index_list = 1, size_list call mct_list_get(mctOStr,index_list,temp_list) mct_field = mct_string_toChar(mctOStr) From 9c27b2d1b98642f6d5c527e53b8f085296791d5f Mon Sep 17 00:00:00 2001 From: Robert Jacob Date: Fri, 24 Feb 2023 17:43:44 -0600 Subject: [PATCH 336/467] Remove some debugging output from moab coupler Remove some debugging stdout messages that were filling up e3sm.log. Also fix some comments. Change some seq_map output to MOABDEBUG. --- driver-moab/main/cplcomp_exchange_mod.F90 | 3 +-- driver-moab/main/prep_ice_mod.F90 | 2 -- driver-moab/main/prep_ocn_mod.F90 | 1 - driver-moab/main/seq_map_mod.F90 | 19 +++---------------- 4 files changed, 4 insertions(+), 21 deletions(-) diff --git a/driver-moab/main/cplcomp_exchange_mod.F90 b/driver-moab/main/cplcomp_exchange_mod.F90 index 71c36d0a9d9f..6b57166573a1 100644 --- a/driver-moab/main/cplcomp_exchange_mod.F90 +++ b/driver-moab/main/cplcomp_exchange_mod.F90 @@ -1294,11 +1294,10 @@ subroutine cplcomp_moab_Init(infodata,comp) ropts = 'PARALLEL=READ_PART;PARTITION_METHOD=SQIJ;VARIABLE='//C_NULL_CHAR call seq_infodata_GetData(infodata,lnd_domain=lnd_domain) outfile = trim(lnd_domain)//C_NULL_CHAR - write(logunit,*) subname,' got land domain file ',trim(lnd_domain) nghlay = 0 ! no ghost layers ierr = iMOAB_LoadMesh(mblxid, outfile, ropts, nghlay) if (ierr .ne. 0) then - write(logunit,*) subname,' error in reading land coupler mesh' + 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 #ifdef MOABDEBUG diff --git a/driver-moab/main/prep_ice_mod.F90 b/driver-moab/main/prep_ice_mod.F90 index dcdfd567493d..13ceeeeae43d 100644 --- a/driver-moab/main/prep_ice_mod.F90 +++ b/driver-moab/main/prep_ice_mod.F90 @@ -752,8 +752,6 @@ subroutine prep_ice_mrg_moab(infodata, rof_c2_ice) ! get the a2x data that was mapped to i tagname = trim(seq_flds_a2x_fields)//C_NULL_CHAR arrsize = naflds * lsize ! allocate (a2x_om (lsize, naflds)) -! LOOK at this line - write(logunit, *) 'MOAB ice merge ',mbixid, naflds,lsize, ent_type, trim(tagname) ierr = iMOAB_GetDoubleTagStorage ( mbixid, tagname, arrsize , ent_type, a2x_im(1,1)) if (ierr .ne. 0) then write(logunit, *) 'MOAB error ', ierr diff --git a/driver-moab/main/prep_ocn_mod.F90 b/driver-moab/main/prep_ocn_mod.F90 index b0aa2a5307cb..67ef67d7b38c 100644 --- a/driver-moab/main/prep_ocn_mod.F90 +++ b/driver-moab/main/prep_ocn_mod.F90 @@ -1708,7 +1708,6 @@ subroutine prep_ocn_mrg_moab(infodata, xao_ox) #ifdef MOABCOMP - !compare_mct_av_moab_tag(comp, attrVect, field, imoabApp, tag_name, ent_type, difference) x2o_o => component_get_x2c_cx(ocn(1)) ! loop over all fields in seq_flds_x2o_fields call mct_list_init(temp_list ,seq_flds_x2o_fields) diff --git a/driver-moab/main/seq_map_mod.F90 b/driver-moab/main/seq_map_mod.F90 index ece6a14eaf85..39170df4ddc3 100644 --- a/driver-moab/main/seq_map_mod.F90 +++ b/driver-moab/main/seq_map_mod.F90 @@ -389,11 +389,13 @@ subroutine seq_map_map( mapper, av_s, av_d, fldlist, norm, avwts_s, avwtsfld_s, fldlist_moab = trim(mct_aVect_exportRList2c(av_s))//C_NULL_CHAR endif +#ifdef MOABDEBUG if (seq_comm_iamroot(CPLID)) then write(logunit,*) subname, 'iMOAB mapper ',trim(mapper%mbname), ' iMOAB_mapper nfields', & nfields, ' fldlist_moab=', trim(fldlist_moab) call shr_sys_flush(logunit) endif +#endif endif ! valid_moab_context #endif @@ -445,24 +447,14 @@ subroutine seq_map_map( mapper, av_s, av_d, fldlist, norm, avwts_s, avwtsfld_s, #ifdef HAVE_MOAB if ( valid_moab_context ) then - ! right now, this is used for ice-ocn projection, which involves just a send/recv, usually - if (seq_comm_iamroot(CPLID)) then - write(logunit, *) subname,' iMOAB mapper ', mapper%mbname, ' rearrange mapper before sending ', trim(fldlist_moab) - call shr_sys_flush(logunit) - endif ierr = iMOAB_SendElementTag( mapper%src_mbid, fldlist_moab, mapper%mpicom, mapper%intx_context ); if (ierr .ne. 0) then write(logunit, *) subname,' iMOAB mapper ', mapper%mbname, ' error in sending tags ', trim(fldlist_moab) call shr_sys_flush(logunit) call shr_sys_abort(subname//' ERROR in sending tags') - !valid_moab_context = .false. endif endif if ( valid_moab_context ) then - if (seq_comm_iamroot(CPLID)) then - write(logunit, *) subname,' iMOAB mapper before receiving ', trim(fldlist_moab) - call shr_sys_flush(logunit) - endif ! receive in the target app ierr = iMOAB_ReceiveElementTag( mapper%tgt_mbid, fldlist_moab, mapper%mpicom, mapper%src_context ); if (ierr .ne. 0) then @@ -483,17 +475,12 @@ subroutine seq_map_map( mapper, av_s, av_d, fldlist, norm, avwts_s, avwtsfld_s, #ifdef HAVE_MOAB if ( valid_moab_context ) then - ! first have to do the second hop, iMOAB_ComputeCommGraph( src_mbid, intx_mbid, - ! wgtIdef = 'scalar'//C_NULL_CHAR ! - write(logunit, *) subname,' iMOAB real mapper before sending ', trim(fldlist_moab) - call shr_sys_flush(logunit) ierr = iMOAB_SendElementTag( mapper%src_mbid, fldlist_moab, mapper%mpicom, mapper%intx_context ); if (ierr .ne. 0) then write(logunit, *) subname,' iMOAB mapper error in sending tags ', mapper%mbname, trim(fldlist_moab) call shr_sys_flush(logunit) call shr_sys_abort(subname//' ERROR in sending tags') - !valid_moab_context = .false. endif endif if ( valid_moab_context ) then @@ -517,7 +504,7 @@ subroutine seq_map_map( mapper, av_s, av_d, fldlist, norm, avwts_s, avwtsfld_s, if ( valid_moab_context ) then #ifdef MOABDEBUG if (seq_comm_iamroot(CPLID)) then - write(logunit, *) subname,' iMOAB mapper: between ', mapper%src_mbid, ' and ', mapper%tgt_mbid, trim(fldlist_moab) + write(logunit, *) subname,' iMOAB projection mapper: between ', mapper%src_mbid, ' and ', mapper%tgt_mbid, trim(fldlist_moab) call shr_sys_flush(logunit) endif #endif From 3c67dd114ee373d89bee30ea0f55240bcbf8dbe1 Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Fri, 24 Feb 2023 19:30:51 -0600 Subject: [PATCH 337/467] define mct_ debug tags only the first_time --- driver-moab/main/component_type_mod.F90 | 12 +++++++----- driver-moab/main/prep_atm_mod.F90 | 2 +- driver-moab/main/prep_ice_mod.F90 | 6 +++--- driver-moab/main/prep_lnd_mod.F90 | 6 ++++-- driver-moab/main/prep_ocn_mod.F90 | 2 +- driver-moab/main/prep_rof_mod.F90 | 6 +++--- 6 files changed, 19 insertions(+), 15 deletions(-) diff --git a/driver-moab/main/component_type_mod.F90 b/driver-moab/main/component_type_mod.F90 index 202799fe1af5..af3db296a34d 100644 --- a/driver-moab/main/component_type_mod.F90 +++ b/driver-moab/main/component_type_mod.F90 @@ -412,7 +412,7 @@ end subroutine expose_mct_grid_moab #ifdef MOABCOMP ! assumes everything is on coupler pes here, to make sense - subroutine compare_mct_av_moab_tag(comp, attrVect, mct_field, appId, tagname, ent_type, difference) + subroutine compare_mct_av_moab_tag(comp, attrVect, mct_field, appId, tagname, ent_type, difference, first_time) use shr_mpi_mod, only: shr_mpi_sum use shr_kind_mod, only: CXX => shr_kind_CXX @@ -430,6 +430,7 @@ subroutine compare_mct_av_moab_tag(comp, attrVect, mct_field, appId, tagname, en character(*) , intent(in) :: tagname real(r8) , intent(out) :: difference + logical , intent(in) :: first_time real(r8) :: differenceg ! global, reduced diff type(mct_ggrid), pointer :: dom @@ -465,10 +466,11 @@ subroutine compare_mct_av_moab_tag(comp, attrVect, mct_field, appId, tagname, en tagtype = 1 ! dense, double numco = 1 - ierr = iMOAB_DefineTagStorage(appId, tagname_mct, tagtype, numco, tagindex ) - if (ierr > 0 ) & - call shr_sys_abort(subname//'Error: fail to define new tag for mct') - + if (first_time) then + ierr = iMOAB_DefineTagStorage(appId, tagname_mct, tagtype, numco, tagindex ) + if (ierr > 0 ) & + call shr_sys_abort(subname//'Error: fail to define new tag for mct') + endif ierr = iMOAB_SetDoubleTagStorageWithGid ( appId, tagname_mct, nloc , ent_type, values, GlobalIds ) if (ierr > 0 ) & call shr_sys_abort(subname//'Error: fail to set new tags') diff --git a/driver-moab/main/prep_atm_mod.F90 b/driver-moab/main/prep_atm_mod.F90 index fadc0218619c..f92d7830f0e1 100644 --- a/driver-moab/main/prep_atm_mod.F90 +++ b/driver-moab/main/prep_atm_mod.F90 @@ -1225,7 +1225,7 @@ subroutine prep_atm_mrg_moab(infodata, xao_ax) call mct_list_get(mctOStr,index_list,temp_list) mct_field = mct_string_toChar(mctOStr) tagname= trim(mct_field)//C_NULL_CHAR - call compare_mct_av_moab_tag(atm(1), x2a_a, mct_field, mbaxid, tagname, ent_type, difference) + call compare_mct_av_moab_tag(atm(1), x2a_a, mct_field, mbaxid, tagname, ent_type, difference, first_time) enddo call mct_list_clean(temp_list) #endif diff --git a/driver-moab/main/prep_ice_mod.F90 b/driver-moab/main/prep_ice_mod.F90 index 13ceeeeae43d..aa4dadc0dc79 100644 --- a/driver-moab/main/prep_ice_mod.F90 +++ b/driver-moab/main/prep_ice_mod.F90 @@ -834,7 +834,7 @@ subroutine prep_ice_mrg_moab(infodata, rof_c2_ice) deallocate(mrgstr) endif - first_time = .false. + #ifdef MOABCOMP !compare_mct_av_moab_tag(comp, attrVect, field, imoabApp, tag_name, ent_type, difference) @@ -848,11 +848,11 @@ subroutine prep_ice_mrg_moab(infodata, rof_c2_ice) call mct_list_get(mctOStr,index_list,temp_list) mct_field = mct_string_toChar(mctOStr) tagname= trim(mct_field)//C_NULL_CHAR - call compare_mct_av_moab_tag(ice(1), x2i_i, mct_field, mbixid, tagname, ent_type, difference) + call compare_mct_av_moab_tag(ice(1), x2i_i, mct_field, mbixid, tagname, ent_type, difference, first_time) enddo call mct_list_clean(temp_list) #endif - + first_time = .false. #ifdef MOABDEBUG if (mbixid .ge. 0 ) then ! we are on coupler pes, for sure write(lnum,"(I0.2)")num_moab_exports diff --git a/driver-moab/main/prep_lnd_mod.F90 b/driver-moab/main/prep_lnd_mod.F90 index 4d4b7d66361f..c454c8a170d7 100644 --- a/driver-moab/main/prep_lnd_mod.F90 +++ b/driver-moab/main/prep_lnd_mod.F90 @@ -706,7 +706,6 @@ subroutine prep_lnd_mrg_moab (infodata) deallocate(mrgstr) endif - first_time = .false. #ifdef MOABCOMP ! land does not do any merge for moab, all fields are directly projected, from atm, river, glacier ! compare_mct_av_moab_tag(comp, attrVect, field, imoabApp, tag_name, ent_type, difference) @@ -720,10 +719,13 @@ subroutine prep_lnd_mrg_moab (infodata) call mct_list_get(mctOStr,index_list,temp_list) mct_field = mct_string_toChar(mctOStr) tagname= trim(mct_field)//C_NULL_CHAR - call compare_mct_av_moab_tag(lnd(1), x2l_l, mct_field, mblxid, tagname, ent_type, difference) + call compare_mct_av_moab_tag(lnd(1), x2l_l, mct_field, mblxid, tagname, ent_type, difference, first_time) enddo call mct_list_clean(temp_list) #endif + + first_time = .false. + #ifdef MOABDEBUG if (mblxid .ge. 0 ) then ! we are on coupler pes, for sure write(lnum,"(I0.2)")num_moab_exports diff --git a/driver-moab/main/prep_ocn_mod.F90 b/driver-moab/main/prep_ocn_mod.F90 index 67ef67d7b38c..770fb2c0d509 100644 --- a/driver-moab/main/prep_ocn_mod.F90 +++ b/driver-moab/main/prep_ocn_mod.F90 @@ -1718,7 +1718,7 @@ subroutine prep_ocn_mrg_moab(infodata, xao_ox) call mct_list_get(mctOStr,index_list,temp_list) mct_field = mct_string_toChar(mctOStr) tagname= trim(mct_field)//C_NULL_CHAR - call compare_mct_av_moab_tag(ocn(1), x2o_o, mct_field, mboxid, tagname, ent_type, difference) + call compare_mct_av_moab_tag(ocn(1), x2o_o, mct_field, mboxid, tagname, ent_type, difference, first_time) enddo call mct_list_clean(temp_list) #endif diff --git a/driver-moab/main/prep_rof_mod.F90 b/driver-moab/main/prep_rof_mod.F90 index 50591541ef30..330a1659edcf 100644 --- a/driver-moab/main/prep_rof_mod.F90 +++ b/driver-moab/main/prep_rof_mod.F90 @@ -1412,7 +1412,7 @@ subroutine prep_rof_mrg_moab (infodata, cime_model) endif deallocate(mrgstr) endif - first_time = .false. + #ifdef MOABCOMP !compare_mct_av_moab_tag(comp, attrVect, field, imoabApp, tag_name, ent_type, difference) @@ -1426,11 +1426,11 @@ subroutine prep_rof_mrg_moab (infodata, cime_model) call mct_list_get(mctOStr,index_list,temp_list) mct_field = mct_string_toChar(mctOStr) tagname= trim(mct_field)//C_NULL_CHAR - call compare_mct_av_moab_tag(rof(1), x2r_r, mct_field, mbrxid, tagname, ent_type, difference) + call compare_mct_av_moab_tag(rof(1), x2r_r, mct_field, mbrxid, tagname, ent_type, difference, first_time) enddo call mct_list_clean(temp_list) #endif - + first_time = .false. #ifdef MOABDEBUG if (mbrxid .ge. 0 ) then ! we are on coupler pes, for sure From a7d3a3c113cba5c67e217f0021844c0ad36c316d Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Sat, 25 Feb 2023 08:29:01 -0600 Subject: [PATCH 338/467] use validate=0 for compute weights less verbose messages --- driver-moab/main/prep_atm_mod.F90 | 4 ++-- driver-moab/main/prep_lnd_mod.F90 | 4 ++-- driver-moab/main/prep_ocn_mod.F90 | 2 +- driver-moab/main/prep_rof_mod.F90 | 2 +- 4 files changed, 6 insertions(+), 6 deletions(-) diff --git a/driver-moab/main/prep_atm_mod.F90 b/driver-moab/main/prep_atm_mod.F90 index f92d7830f0e1..be5152a5d4cf 100644 --- a/driver-moab/main/prep_atm_mod.F90 +++ b/driver-moab/main/prep_atm_mod.F90 @@ -316,7 +316,7 @@ subroutine prep_atm_init(infodata, ocn_c2_atm, ice_c2_atm, lnd_c2_atm, iac_c2_at fNoBubble = 1 monotonicity = 0 ! noConserve = 0 - validate = 1 + validate = 0 ! less verbose fInverseDistanceMap = 0 if (iamroot_CPLID) then write(logunit,*) subname, 'launch iMOAB weights with args ', 'mbintxoa=', mbintxoa, ' wgtIdef=', wgtIdef, & @@ -518,7 +518,7 @@ subroutine prep_atm_init(infodata, ocn_c2_atm, ice_c2_atm, lnd_c2_atm, iac_c2_at fNoBubble = 1 monotonicity = 0 ! noConserve = 0 - validate = 1 + validate = 0 ! less verbose fInverseDistanceMap = 0 if (iamroot_CPLID) then write(logunit,*) subname, 'launch iMOAB weights with args ', 'mbintxia=', mbintxia, ' wgtIdef=', wgtIdef, & diff --git a/driver-moab/main/prep_lnd_mod.F90 b/driver-moab/main/prep_lnd_mod.F90 index c454c8a170d7..f1029e7ba576 100644 --- a/driver-moab/main/prep_lnd_mod.F90 +++ b/driver-moab/main/prep_lnd_mod.F90 @@ -444,7 +444,7 @@ subroutine prep_lnd_init(infodata, atm_c2_lnd, rof_c2_lnd, glc_c2_lnd, iac_c2_ln fNoBubble = 1 monotonicity = 0 ! noConserve = 0 - validate = 1 + validate = 0 ! less verbose fInverseDistanceMap = 0 if (iamroot_CPLID) then write(logunit,*) subname, 'launch iMOAB weights with args ', 'mbintxal=', mbintxal, ' wgtIdef=', wgtIdef, & @@ -725,7 +725,7 @@ subroutine prep_lnd_mrg_moab (infodata) #endif first_time = .false. - + #ifdef MOABDEBUG if (mblxid .ge. 0 ) then ! we are on coupler pes, for sure write(lnum,"(I0.2)")num_moab_exports diff --git a/driver-moab/main/prep_ocn_mod.F90 b/driver-moab/main/prep_ocn_mod.F90 index 770fb2c0d509..9498332638f2 100644 --- a/driver-moab/main/prep_ocn_mod.F90 +++ b/driver-moab/main/prep_ocn_mod.F90 @@ -421,7 +421,7 @@ subroutine prep_ocn_init(infodata, atm_c2_ocn, atm_c2_ice, ice_c2_ocn, rof_c2_oc fNoBubble = 1 monotonicity = 0 ! noConserve = 0 - validate = 1 + validate = 0 ! less verbose fInverseDistanceMap = 0 if (iamroot_CPLID) then write(logunit,*) subname, 'launch iMOAB weights with args ', 'mbintxao=', mbintxao, ' wgtIdef=', wgtIdef, & diff --git a/driver-moab/main/prep_rof_mod.F90 b/driver-moab/main/prep_rof_mod.F90 index 330a1659edcf..50248ebe2c4a 100644 --- a/driver-moab/main/prep_rof_mod.F90 +++ b/driver-moab/main/prep_rof_mod.F90 @@ -467,7 +467,7 @@ subroutine prep_rof_init(infodata, lnd_c2_rof, atm_c2_rof, ocn_c2_rof) fNoBubble = 1 monotonicity = 0 ! noConserve = 0 - validate = 1 + validate = 0 ! less verbose fInverseDistanceMap = 0 if (iamroot_CPLID) then write(logunit,*) subname, 'launch iMOAB weights with args ', 'mbintxar=', mbintxar, ' wgtIdef=', wgtIdef, & From 8b4065930b8d4624e6a5161acd8168ee7bd2c03e Mon Sep 17 00:00:00 2001 From: Robert Jacob Date: Mon, 27 Feb 2023 13:05:12 -0600 Subject: [PATCH 339/467] add normalization weight to coupler meshes add normalization weight tag to all coupler meshes --- driver-moab/main/cplcomp_exchange_mod.F90 | 15 ++++++++++----- driver-moab/main/prep_aoflux_mod.F90 | 7 +++++-- 2 files changed, 15 insertions(+), 7 deletions(-) diff --git a/driver-moab/main/cplcomp_exchange_mod.F90 b/driver-moab/main/cplcomp_exchange_mod.F90 index 6b57166573a1..6258739db53f 100644 --- a/driver-moab/main/cplcomp_exchange_mod.F90 +++ b/driver-moab/main/cplcomp_exchange_mod.F90 @@ -1140,7 +1140,8 @@ subroutine cplcomp_moab_Init(infodata,comp) call shr_sys_abort(subname//' ERROR in defining tags ') endif - tagname = trim(seq_flds_dom_fields)//C_NULL_CHAR + !add the normalization tag + tagname = trim(seq_flds_dom_fields)//":norm8wt"//C_NULL_CHAR ierr = iMOAB_DefineTagStorage(mbaxid, tagname, tagtype, numco, tagindex ) if (ierr .ne. 0) then write(logunit,*) subname,' error in defining tags seq_flds_dom_fields on atm on coupler ' @@ -1219,7 +1220,8 @@ subroutine cplcomp_moab_Init(infodata,comp) call shr_sys_abort(subname//' ERROR in defining tags x2o on coupler ') endif - tagname = trim(seq_flds_dom_fields)//C_NULL_CHAR + !add the normalization tag + tagname = trim(seq_flds_dom_fields)//":norm8wt"//C_NULL_CHAR ierr = iMOAB_DefineTagStorage(mboxid, tagname, tagtype, numco, tagindex ) if (ierr .ne. 0) then write(logunit,*) subname,' error in defining tags seq_flds_dom_fields on ocn on coupler ' @@ -1327,7 +1329,8 @@ subroutine cplcomp_moab_Init(infodata,comp) call shr_sys_abort(subname//' ERROR in defining tags x2l on coupler land') endif - tagname = trim(seq_flds_dom_fields)//C_NULL_CHAR + !add the normalization tag + tagname = trim(seq_flds_dom_fields)//":norm8wt"//C_NULL_CHAR ierr = iMOAB_DefineTagStorage(mblxid, tagname, tagtype, numco, tagindex ) if (ierr .ne. 0) then write(logunit,*) subname,' error in defining tags seq_flds_dom_fields on lnd on coupler ' @@ -1391,7 +1394,8 @@ subroutine cplcomp_moab_Init(infodata,comp) call shr_sys_abort( subname//' ERROR: cannot define tags for ice on coupler' ) end if - tagname = trim(seq_flds_dom_fields)//C_NULL_CHAR + !add the normalization tag + tagname = trim(seq_flds_dom_fields)//":norm8wt"//C_NULL_CHAR ierr = iMOAB_DefineTagStorage(mbixid, tagname, tagtype, numco, tagindex ) if (ierr .ne. 0) then write(logunit,*) subname,' error in defining tags seq_flds_dom_fields on ice on coupler ' @@ -1481,7 +1485,8 @@ subroutine cplcomp_moab_Init(infodata,comp) call shr_sys_abort( subname//' ERROR: cannot define tags for rof on coupler' ) end if - tagname = trim(seq_flds_dom_fields)//C_NULL_CHAR + !add the normalization tag + tagname = trim(seq_flds_dom_fields)//":norm8wt"//C_NULL_CHAR ierr = iMOAB_DefineTagStorage(mbrxid, tagname, tagtype, numco, tagindex ) if (ierr .ne. 0) then write(logunit,*) subname,' error in defining tags seq_flds_dom_fields on rof on coupler ' diff --git a/driver-moab/main/prep_aoflux_mod.F90 b/driver-moab/main/prep_aoflux_mod.F90 index aacbccffe912..8c84b511f7e3 100644 --- a/driver-moab/main/prep_aoflux_mod.F90 +++ b/driver-moab/main/prep_aoflux_mod.F90 @@ -140,7 +140,8 @@ subroutine prep_aoflux_init (infodata) ! define flux tags on the moab ocean mesh, second copy of ocean mesh on coupler if (mbofxid .ge. 0 ) then ! // - tagname = trim(seq_flds_xao_fields)//C_NULL_CHAR + !add the normalization tag + tagname = trim(seq_flds_xao_fields)//":norm8wt"//C_NULL_CHAR tagtype = 1 ! dense, double numco = 1 ierr = iMOAB_DefineTagStorage(mbofxid, tagname, tagtype, numco, tagindex ) @@ -148,10 +149,11 @@ subroutine prep_aoflux_init (infodata) write(logunit,*) subname,' error in defining tags on ocn phys mesh on cpl ' call shr_sys_abort(subname//' ERROR in defining tags on ocn phys mesh on cpl') endif + ! make it zero ! first form a list and get size. call mct_list_init(temp_list ,seq_flds_xao_fields) - size_list=mct_list_nitem (temp_list) + size_list=mct_list_nitem (temp_list) + 1 ! 1 more for the normalization tag call mct_list_clean(temp_list) ! find out the number of local elements in moab mesh ierr = iMOAB_GetMeshInfo ( mbofxid, nvert, nvise, nbl, nsurf, nvisBC ); ! could be different of lsize_o @@ -166,6 +168,7 @@ subroutine prep_aoflux_init (infodata) write(logunit,*) subname,' error in zeroing out xao_fields ' call shr_sys_abort(subname//' ERROR in zeroing out xao_fields in init ') endif + allocate(xao_omct(lsize_o, size_list)) ! the transpose of xao_ox(size_list, lsize_o) ! create for debugging the tags on mbox2id (mct grid on coupler) ierr = iMOAB_DefineTagStorage(mbox2id, tagname, tagtype, numco, tagindex ) From 4b487c1198afce5defa662b9de19d56300ed15c7 Mon Sep 17 00:00:00 2001 From: Robert Jacob Date: Mon, 27 Feb 2023 13:09:03 -0600 Subject: [PATCH 340/467] Add normalization to MOAB mapping Add normalization to MOAB mapping similar to what MCT does. STATUS: compiles but runtime error --- driver-moab/main/seq_map_mod.F90 | 141 +++++++++++++++++++++++++++++-- 1 file changed, 134 insertions(+), 7 deletions(-) diff --git a/driver-moab/main/seq_map_mod.F90 b/driver-moab/main/seq_map_mod.F90 index 39170df4ddc3..265f28393fbb 100644 --- a/driver-moab/main/seq_map_mod.F90 +++ b/driver-moab/main/seq_map_mod.F90 @@ -325,17 +325,21 @@ subroutine seq_map_map( mapper, av_s, av_d, fldlist, norm, avwts_s, avwtsfld_s, integer(IN) ,intent(in),optional :: msgtag #ifdef HAVE_MOAB logical :: valid_moab_context - integer :: ierr, nfields, ntagdatalength + integer :: ierr, nfields, lsize, arrsize, j character(len=CXX) :: fldlist_moab + character(len=CXX) :: tagname integer :: nvert(3), nvise(3), nbl(3), nsurf(3), nvisBC(3) ! for moab info type(mct_list) :: temp_list integer, dimension(:), allocatable :: globalIds - real(r8), dimension(:), allocatable :: moab_tag_data + real(r8), dimension(:), allocatable :: wghts + real(kind=r8) , allocatable :: targtags(:,:) #endif ! ! Local Variables ! - logical :: lnorm + logical :: lnorm ! true if normalization is to be done + logical :: mbnorm ! moab copy of lnorm + logical :: mbpresent ! moab logical for presence of norm weight string integer(IN),save :: ltag ! message tag for rearrange character(len=*),parameter :: subname = "(seq_map_map) " !----------------------------------------------------- @@ -349,6 +353,17 @@ subroutine seq_map_map( mapper, av_s, av_d, fldlist, norm, avwts_s, avwtsfld_s, lnorm = norm endif + mbnorm = lnorm + + if (present(avwtsfld_s)) then + mbpresent = .true. + else + mbpresent = .false. + endif + + mbnorm = .false. ! uncomment to turn off normalization for all maps + mbpresent = .false. + if (present(msgtag)) then ltag = msgtag else @@ -382,13 +397,21 @@ subroutine seq_map_map( mapper, av_s, av_d, fldlist, norm, avwts_s, avwtsfld_s, call mct_list_init(temp_list, fldlist) nfields=mct_list_nitem (temp_list) call mct_list_clean(temp_list) - fldlist_moab= trim(fldlist)//C_NULL_CHAR + fldlist_moab= trim(fldlist) else ! Extract character strings from attribute vector nfields = mct_aVect_nRAttr(av_s) - fldlist_moab = trim(mct_aVect_exportRList2c(av_s))//C_NULL_CHAR + fldlist_moab = trim(mct_aVect_exportRList2c(av_s)) endif + if (mbnorm) then + fldlist_moab = fldlist_moab//":norm8wt"//C_NULL_CHAR + nfields=nfields + 1 + else + fldlist_moab = fldlist_moab//C_NULL_CHAR + endif + + #ifdef MOABDEBUG if (seq_comm_iamroot(CPLID)) then write(logunit,*) subname, 'iMOAB mapper ',trim(mapper%mbname), ' iMOAB_mapper nfields', & @@ -449,7 +472,7 @@ subroutine seq_map_map( mapper, av_s, av_d, fldlist, norm, avwts_s, avwtsfld_s, if ( valid_moab_context ) then ierr = iMOAB_SendElementTag( mapper%src_mbid, fldlist_moab, mapper%mpicom, mapper%intx_context ); if (ierr .ne. 0) then - write(logunit, *) subname,' iMOAB mapper ', mapper%mbname, ' error in sending tags ', trim(fldlist_moab) + write(logunit, *) subname,' iMOAB mapper ', mapper%mbname, ' error in sending tags ', trim(fldlist_moab), ierr call shr_sys_flush(logunit) call shr_sys_abort(subname//' ERROR in sending tags') endif @@ -475,6 +498,64 @@ subroutine seq_map_map( mapper, av_s, av_d, fldlist, norm, avwts_s, avwtsfld_s, #ifdef HAVE_MOAB if ( valid_moab_context ) then + ! NORMALIZATION + if (mbnorm .or. mbpresent) then + ! initialize the weight tag and multiply it by the input tags. + ! get target mesh info + ierr = iMOAB_GetMeshInfo ( mapper%src_mbid, nvert, nvise, nbl, nsurf, nvisBC ); + if (ierr .ne. 0) then + write(logunit,*) subname,' error getting mesh info for ', mapper%mbname + call shr_sys_abort(subname//' ERROR getting mesh info') ! serious enough + endif + lsize = nvise(1) ! number of active cells + + ! init normalization weight + allocate(wghts(lsize)) + wghts = 1.0_r8 + tagname = "norm8wt"//C_NULL_CHAR + ! set the normalization factor to 1 + ierr = iMOAB_SetDoubleTagStorage (mapper%src_mbid, tagname, lsize , mapper%tag_entity_type, wghts) + if (ierr .ne. 0) then + write(logunit,*) subname,' error setting init value for mapping norm factor ', tagname + call shr_sys_abort(subname//' ERROR setting norm init value') ! serious enough + endif + + ! if a normalization factor was specified, get it and multiply src tags by it + if(mbpresent) then + tagname = avwtsfld_s//C_NULL_CHAR + ierr = iMOAB_GetDoubleTagStorage (mapper%src_mbid, tagname, lsize , mapper%tag_entity_type, wghts) + if (ierr .ne. 0) then + write(logunit,*) subname,' error getting value for mapping norm factor ', tagname + call shr_sys_abort(subname//' ERROR getting norm factor') ! serious enough + endif + + ! get the fieldlist including weight + allocate(targtags(lsize,nfields)) + arrsize=lsize*(nfields) + + ! get the current values of all source tags including the norm8wt currently set to 1 + ierr = iMOAB_GetDoubleTagStorage (mapper%src_mbid, fldlist_moab, arrsize , mapper%tag_entity_type, targtags) + if (ierr .ne. 0) then + write(logunit,*) subname,' error getting source tag values ', mapper%mbname + call shr_sys_abort(subname//' ERROR getting source tag values') ! serious enough + endif + + ! multiply by the value of the avwtsfld_s field. + ! norm8wt is 1 so it will record the value of the weight. + do j = 1, lsize + targtags(j,:)= targtags(j,:)*wghts(j) + enddo + + ! put the new values on the mesh for later mapping + ierr = iMOAB_SetDoubleTagStorage (mapper%src_mbid, fldlist_moab, arrsize , mapper%tag_entity_type, targtags) + if (ierr .ne. 0) then + write(logunit,*) subname,' error setting normed source tag values ', mapper%mbname + call shr_sys_abort(subname//' ERROR setting normed source tag values') ! serious enough + endif + endif ! end multiplication by norm factor + deallocate(wghts, targtags) + endif ! end NORMALIZATION + ! ierr = iMOAB_SendElementTag( mapper%src_mbid, fldlist_moab, mapper%mpicom, mapper%intx_context ); if (ierr .ne. 0) then @@ -502,6 +583,7 @@ subroutine seq_map_map( mapper, av_s, av_d, fldlist, norm, avwts_s, avwtsfld_s, endif endif if ( valid_moab_context ) then + #ifdef MOABDEBUG if (seq_comm_iamroot(CPLID)) then write(logunit, *) subname,' iMOAB projection mapper: between ', mapper%src_mbid, ' and ', mapper%tgt_mbid, trim(fldlist_moab) @@ -513,10 +595,55 @@ subroutine seq_map_map( mapper, av_s, av_d, fldlist, norm, avwts_s, avwtsfld_s, write(logunit,*) subname,' error in applying weights ' call shr_sys_abort(subname//' ERROR in applying weights') endif + + ! complete the normalization process + if (mbnorm) then + ierr = iMOAB_GetMeshInfo ( mapper%tgt_mbid, nvert, nvise, nbl, nsurf, nvisBC ); + if (ierr .ne. 0) then + write(logunit,*) subname,' error getting mesh info for target ', mapper%mbname + call shr_sys_abort(subname//' ERROR getting mesh info') ! serious enough + endif + + lsize = nvise(1) ! number of active cells + tagname = "norm8wt"//C_NULL_CHAR + allocate(wghts(lsize)) + + ! get values of weights after mapping + ierr = iMOAB_GetDoubleTagStorage (mapper%tgt_mbid, tagname, lsize , mapper%tag_entity_type, wghts) + if (ierr .ne. 0) then + write(logunit,*) subname,' error getting value for mapping norm factor post-map ', tagname + call shr_sys_abort(subname//' ERROR getting norm factor') ! serious enough + endif + + ! get values of target tags after mapping + allocate(targtags(lsize,nfields)) + arrsize=lsize*(nfields) + ierr = iMOAB_GetDoubleTagStorage (mapper%tgt_mbid, fldlist_moab, arrsize , mapper%tag_entity_type, targtags) + if (ierr .ne. 0) then + write(logunit,*) subname,' error getting destination tag values ', mapper%mbname + call shr_sys_abort(subname//' ERROR getting source tag values') ! serious enough + endif + + ! do the post mapping normalization + ! TODO: add some check for wghts < puny + do j = 1, lsize + targtags(j,:)= targtags(j,:)*(1.0_r8/wghts(j)) + enddo + + ! put the values back on the mesh + ierr = iMOAB_SetDoubleTagStorage (mapper%tgt_mbid, fldlist_moab, arrsize , mapper%tag_entity_type, targtags) + if (ierr .ne. 0) then + write(logunit,*) subname,' error getting destination tag values ', mapper%mbname + call shr_sys_abort(subname//' ERROR getting source tag values') ! serious enough + endif + + deallocate(wghts, targtags) + endif ! end normalization + endif #endif - endif + endif ! end of mapping type if else end subroutine seq_map_map From f917cf163d7c5cc661769250c042862c9db890e5 Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Mon, 27 Feb 2023 14:37:41 -0600 Subject: [PATCH 341/467] ocean change MOABDEBUG -> MOABCOMP --- components/mpas-ocean/driver/ocn_comp_mct.F | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/components/mpas-ocean/driver/ocn_comp_mct.F b/components/mpas-ocean/driver/ocn_comp_mct.F index 60fb2c1a24ad..f076d233d75d 100644 --- a/components/mpas-ocean/driver/ocn_comp_mct.F +++ b/components/mpas-ocean/driver/ocn_comp_mct.F @@ -236,7 +236,7 @@ subroutine ocn_init_mct( EClock, cdata_o, x2o_o, o2x_o, NLFilename )!{{{ character*100 outfile, wopts integer :: ierrmb, numco, tagtype, tagindex, ent_type character(CXX) :: tagname -#ifdef MOABDEBUG +#ifdef MOABCOMP real(r8) :: difference type(mct_list) :: temp_list integer :: size_list, index_list @@ -892,7 +892,7 @@ end subroutine xml_stream_get_attributes #ifdef HAVE_MOAB -#ifdef MOABDEBUG +#ifdef MOABCOMP ! loop over all fields in seq_flds_x2o_fields call mct_list_init(temp_list ,seq_flds_x2o_fields) size_list=mct_list_nitem (temp_list) @@ -1002,7 +1002,7 @@ subroutine ocn_run_mct( EClock, cdata_o, x2o_o, o2x_o)!{{{ real (kind=RKIND) :: timeFilterFactor #ifdef HAVE_MOAB -#ifdef MOABDEBUG +#ifdef MOABCOMP real(r8) :: difference type(mct_list) :: temp_list integer :: size_list, index_list, ent_type @@ -1040,7 +1040,7 @@ subroutine ocn_run_mct( EClock, cdata_o, x2o_o, o2x_o)!{{{ #ifdef HAVE_MOAB -#ifdef MOABDEBUG +#ifdef MOABCOMP ! loop over all fields in seq_flds_x2o_fields call mct_list_init(temp_list ,seq_flds_x2o_fields) size_list=mct_list_nitem (temp_list) From 8ac09da4dda5af41a1090932b0c8fe232bf55096 Mon Sep 17 00:00:00 2001 From: Robert Jacob Date: Mon, 27 Feb 2023 15:27:21 -0600 Subject: [PATCH 342/467] Fix fldlist_moab setting and error messages. Turn on norm in moab Fix setting fldlist_moab to make sure it has the NULL CHAR. fix some erorr messages that did not trim(). Allow norm in MOAB mapping by default. --- driver-moab/main/seq_map_mod.F90 | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) diff --git a/driver-moab/main/seq_map_mod.F90 b/driver-moab/main/seq_map_mod.F90 index 265f28393fbb..7a76a59ed9ea 100644 --- a/driver-moab/main/seq_map_mod.F90 +++ b/driver-moab/main/seq_map_mod.F90 @@ -361,8 +361,8 @@ subroutine seq_map_map( mapper, av_s, av_d, fldlist, norm, avwts_s, avwtsfld_s, mbpresent = .false. endif - mbnorm = .false. ! uncomment to turn off normalization for all maps - mbpresent = .false. +! mbnorm = .false. ! uncomment both to turn off normalization for all maps +! mbpresent = .false. if (present(msgtag)) then ltag = msgtag @@ -405,10 +405,10 @@ subroutine seq_map_map( mapper, av_s, av_d, fldlist, norm, avwts_s, avwtsfld_s, endif if (mbnorm) then - fldlist_moab = fldlist_moab//":norm8wt"//C_NULL_CHAR + fldlist_moab = trim(fldlist_moab)//":norm8wt"//C_NULL_CHAR nfields=nfields + 1 else - fldlist_moab = fldlist_moab//C_NULL_CHAR + fldlist_moab = trim(fldlist_moab)//C_NULL_CHAR endif @@ -516,7 +516,7 @@ subroutine seq_map_map( mapper, av_s, av_d, fldlist, norm, avwts_s, avwtsfld_s, ! set the normalization factor to 1 ierr = iMOAB_SetDoubleTagStorage (mapper%src_mbid, tagname, lsize , mapper%tag_entity_type, wghts) if (ierr .ne. 0) then - write(logunit,*) subname,' error setting init value for mapping norm factor ', tagname + write(logunit,*) subname,' error setting init value for mapping norm factor ',ierr,trim(tagname) call shr_sys_abort(subname//' ERROR setting norm init value') ! serious enough endif @@ -525,7 +525,7 @@ subroutine seq_map_map( mapper, av_s, av_d, fldlist, norm, avwts_s, avwtsfld_s, tagname = avwtsfld_s//C_NULL_CHAR ierr = iMOAB_GetDoubleTagStorage (mapper%src_mbid, tagname, lsize , mapper%tag_entity_type, wghts) if (ierr .ne. 0) then - write(logunit,*) subname,' error getting value for mapping norm factor ', tagname + write(logunit,*) subname,' error getting value for mapping norm factor ', trim(tagname) call shr_sys_abort(subname//' ERROR getting norm factor') ! serious enough endif @@ -611,7 +611,7 @@ subroutine seq_map_map( mapper, av_s, av_d, fldlist, norm, avwts_s, avwtsfld_s, ! get values of weights after mapping ierr = iMOAB_GetDoubleTagStorage (mapper%tgt_mbid, tagname, lsize , mapper%tag_entity_type, wghts) if (ierr .ne. 0) then - write(logunit,*) subname,' error getting value for mapping norm factor post-map ', tagname + write(logunit,*) subname,' error getting value for mapping norm factor post-map ', ierr, trim(tagname) call shr_sys_abort(subname//' ERROR getting norm factor') ! serious enough endif From 2e1407170788eee6f86805f019bd704fd1ffea60 Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Tue, 28 Feb 2023 00:16:21 -0600 Subject: [PATCH 343/467] use actual target app for tgt_mbid leave intx app as we defined it receive tag will use intx app for true map (in copy only case will still be tgt_mbid) avoid dividing by 0 when normalizing projection --- driver-moab/main/prep_atm_mod.F90 | 20 ++++++++++---------- driver-moab/main/prep_lnd_mod.F90 | 6 +++--- driver-moab/main/prep_ocn_mod.F90 | 6 +++--- driver-moab/main/prep_rof_mod.F90 | 6 +++--- driver-moab/main/seq_map_mod.F90 | 7 +++++-- driver-moab/main/seq_map_type_mod.F90 | 1 + 6 files changed, 25 insertions(+), 21 deletions(-) diff --git a/driver-moab/main/prep_atm_mod.F90 b/driver-moab/main/prep_atm_mod.F90 index fadc0218619c..ef6bc3bef804 100644 --- a/driver-moab/main/prep_atm_mod.F90 +++ b/driver-moab/main/prep_atm_mod.F90 @@ -275,7 +275,7 @@ subroutine prep_atm_init(infodata, ocn_c2_atm, ice_c2_atm, lnd_c2_atm, iac_c2_at ! now take care of the mapper mapper_So2a%src_mbid = mboxid - mapper_So2a%tgt_mbid = mbintxoa ! + mapper_So2a%tgt_mbid = mbaxid ! mapper_So2a%intx_mbid = mbintxoa mapper_So2a%src_context = ocn(1)%cplcompid mapper_So2a%intx_context = idintx @@ -316,7 +316,7 @@ subroutine prep_atm_init(infodata, ocn_c2_atm, ice_c2_atm, lnd_c2_atm, iac_c2_at fNoBubble = 1 monotonicity = 0 ! noConserve = 0 - validate = 1 + validate = 0 ! less verbose fInverseDistanceMap = 0 if (iamroot_CPLID) then write(logunit,*) subname, 'launch iMOAB weights with args ', 'mbintxoa=', mbintxoa, ' wgtIdef=', wgtIdef, & @@ -371,7 +371,7 @@ subroutine prep_atm_init(infodata, ocn_c2_atm, ice_c2_atm, lnd_c2_atm, iac_c2_at endif mapper_Sof2a%src_mbid = mbofxid - mapper_Sof2a%tgt_mbid = mbintxoa + mapper_Sof2a%tgt_mbid = mbaxid mapper_Sof2a%intx_mbid = mbintxoa mapper_Sof2a%src_context = context_id mapper_Sof2a%intx_context = idintx @@ -408,7 +408,7 @@ subroutine prep_atm_init(infodata, ocn_c2_atm, ice_c2_atm, lnd_c2_atm, iac_c2_at if ((mbaxid .ge. 0) .and. (mboxid .ge. 0)) then ! now take care of the mapper mapper_Fo2a%src_mbid = mboxid - mapper_Fo2a%tgt_mbid = mbintxoa + mapper_Fo2a%tgt_mbid = mbaxid mapper_Fo2a%intx_mbid = mbintxoa mapper_Fo2a%src_context = ocn(1)%cplcompid mapper_Fo2a%intx_context = idintx @@ -418,7 +418,7 @@ subroutine prep_atm_init(infodata, ocn_c2_atm, ice_c2_atm, lnd_c2_atm, iac_c2_at endif if ((mbaxid .ge. 0) .and. (mbofxid .ge. 0)) then mapper_Fof2a%src_mbid = mbofxid - mapper_Fof2a%tgt_mbid = mbintxoa + mapper_Fof2a%tgt_mbid = mbaxid mapper_Fof2a%intx_mbid = mbintxoa mapper_Fof2a%src_context = ocn(1)%cplcompid mapper_Fof2a%intx_context = idintx @@ -479,7 +479,7 @@ subroutine prep_atm_init(infodata, ocn_c2_atm, ice_c2_atm, lnd_c2_atm, iac_c2_at endif ! now take care of the mapper mapper_Si2a%src_mbid = mbixid - mapper_Si2a%tgt_mbid = mbintxia + mapper_Si2a%tgt_mbid = mbaxid mapper_Si2a%intx_mbid = mbintxia mapper_Si2a%src_context = ice(1)%cplcompid mapper_Si2a%intx_context = idintx @@ -518,7 +518,7 @@ subroutine prep_atm_init(infodata, ocn_c2_atm, ice_c2_atm, lnd_c2_atm, iac_c2_at fNoBubble = 1 monotonicity = 0 ! noConserve = 0 - validate = 1 + validate = 0 ! less verbose fInverseDistanceMap = 0 if (iamroot_CPLID) then write(logunit,*) subname, 'launch iMOAB weights with args ', 'mbintxia=', mbintxia, ' wgtIdef=', wgtIdef, & @@ -571,7 +571,7 @@ subroutine prep_atm_init(infodata, ocn_c2_atm, ice_c2_atm, lnd_c2_atm, iac_c2_at #ifdef HAVE_MOAB ! now take care of the mapper for MOAB mapper_Fi2a%src_mbid = mbixid - mapper_Fi2a%tgt_mbid = mbintxia + mapper_Fi2a%tgt_mbid = mbaxid mapper_Fi2a%intx_mbid = mbintxia mapper_Fi2a%src_context = ice(1)%cplcompid mapper_Fi2a%intx_context = idintx @@ -606,7 +606,7 @@ subroutine prep_atm_init(infodata, ocn_c2_atm, ice_c2_atm, lnd_c2_atm, iac_c2_at call shr_sys_abort(subname//' ERROR in registering lnd atm intx ') endif mapper_Fl2a%src_mbid = mblxid - mapper_Fl2a%tgt_mbid = mbintxla ! + mapper_Fl2a%tgt_mbid = mbaxid ! mapper_Fl2a%intx_mbid = mbintxla mapper_Fl2a%src_context = lnd(1)%cplcompid mapper_Fl2a%intx_context = idintx @@ -698,7 +698,7 @@ subroutine prep_atm_init(infodata, ocn_c2_atm, ice_c2_atm, lnd_c2_atm, iac_c2_at #ifdef HAVE_MOAB if ((mbaxid .ge. 0) .and. (mblxid .ge. 0) ) then mapper_Sl2a%src_mbid = mblxid - mapper_Sl2a%tgt_mbid = mapper_Fl2a%tgt_mbid + mapper_Sl2a%tgt_mbid = mapper_Fl2a%tgt_mbid ! mapper_Sl2a%intx_mbid = mbintxla mapper_Sl2a%src_context = lnd(1)%cplcompid mapper_Sl2a%intx_context = mapper_Fl2a%intx_context diff --git a/driver-moab/main/prep_lnd_mod.F90 b/driver-moab/main/prep_lnd_mod.F90 index 4d4b7d66361f..0b4ba9b21662 100644 --- a/driver-moab/main/prep_lnd_mod.F90 +++ b/driver-moab/main/prep_lnd_mod.F90 @@ -258,7 +258,7 @@ subroutine prep_lnd_init(infodata, atm_c2_lnd, rof_c2_lnd, glc_c2_lnd, iac_c2_ln endif ! now take care of the mapper mapper_Fr2l%src_mbid = mbrxid - mapper_Fr2l%tgt_mbid = mbintxrl + mapper_Fr2l%tgt_mbid = mblxid mapper_Fr2l%intx_mbid = mbintxrl mapper_Fr2l%src_context = rof(1)%cplcompid mapper_Fr2l%intx_context = idintx @@ -379,7 +379,7 @@ subroutine prep_lnd_init(infodata, atm_c2_lnd, rof_c2_lnd, glc_c2_lnd, iac_c2_ln call shr_sys_abort(subname//' ERROR in registering atm lnd intx ') endif mapper_Sa2l%src_mbid = mbaxid - mapper_Sa2l%tgt_mbid = mbintxal + mapper_Sa2l%tgt_mbid = mblxid mapper_Sa2l%intx_mbid = mbintxal mapper_Sa2l%src_context = atm(1)%cplcompid mapper_Sa2l%intx_context = idintx @@ -487,7 +487,7 @@ subroutine prep_lnd_init(infodata, atm_c2_lnd, rof_c2_lnd, glc_c2_lnd, iac_c2_ln ! use the same map for fluxes too mapper_Fa2l%src_mbid = mbaxid - mapper_Fa2l%tgt_mbid = mapper_Sa2l%tgt_mbid + mapper_Fa2l%tgt_mbid = mapper_Sa2l%tgt_mbid ! mblxid mapper_Fa2l%intx_mbid = mbintxal mapper_Fa2l%src_context = atm(1)%cplcompid mapper_Fa2l%intx_context = mapper_Sa2l%intx_context diff --git a/driver-moab/main/prep_ocn_mod.F90 b/driver-moab/main/prep_ocn_mod.F90 index 67ef67d7b38c..aa41b735a041 100644 --- a/driver-moab/main/prep_ocn_mod.F90 +++ b/driver-moab/main/prep_ocn_mod.F90 @@ -386,7 +386,7 @@ subroutine prep_ocn_init(infodata, atm_c2_ocn, atm_c2_ice, ice_c2_ocn, rof_c2_oc endif ! now take care of the mapper mapper_Fa2o%src_mbid = mbaxid - mapper_Fa2o%tgt_mbid = mbintxao + mapper_Fa2o%tgt_mbid = mboxid mapper_Fa2o%intx_mbid = mbintxao mapper_Fa2o%src_context = atm(1)%cplcompid mapper_Fa2o%intx_context = idintx @@ -488,7 +488,7 @@ subroutine prep_ocn_init(infodata, atm_c2_ocn, atm_c2_ice, ice_c2_ocn, rof_c2_oc if ((mbaxid .ge. 0) .and. (mboxid .ge. 0)) then ! now take care of the 2 new mappers mapper_Sa2o%src_mbid = mbaxid - mapper_Sa2o%tgt_mbid = mbintxao + mapper_Sa2o%tgt_mbid = mboxid mapper_Sa2o%intx_mbid = mbintxao mapper_Sa2o%src_context = atm(1)%cplcompid mapper_Sa2o%intx_context = idintx @@ -497,7 +497,7 @@ subroutine prep_ocn_init(infodata, atm_c2_ocn, atm_c2_ice, ice_c2_ocn, rof_c2_oc mapper_Sa2o%mbname = 'mapper_Sa2o' mapper_Va2o%src_mbid = mbaxid - mapper_Va2o%tgt_mbid = mbintxao + mapper_Va2o%tgt_mbid = mboxid mapper_Va2o%intx_mbid = mbintxao mapper_Va2o%src_context = atm(1)%cplcompid mapper_Va2o%intx_context = idintx diff --git a/driver-moab/main/prep_rof_mod.F90 b/driver-moab/main/prep_rof_mod.F90 index 50591541ef30..54f7b4bb2eab 100644 --- a/driver-moab/main/prep_rof_mod.F90 +++ b/driver-moab/main/prep_rof_mod.F90 @@ -281,7 +281,7 @@ subroutine prep_rof_init(infodata, lnd_c2_rof, atm_c2_rof, ocn_c2_rof) endif ! now take care of the mapper mapper_Fl2r%src_mbid = mblxid - mapper_Fl2r%tgt_mbid = mbintxlr + mapper_Fl2r%tgt_mbid = mbrxid mapper_Fl2r%intx_mbid = mbintxlr mapper_Fl2r%src_context = lnd(1)%cplcompid mapper_Fl2r%intx_context = idintx @@ -432,7 +432,7 @@ subroutine prep_rof_init(infodata, lnd_c2_rof, atm_c2_rof, ocn_c2_rof) endif ! now take care of the mapper mapper_Fa2r%src_mbid = mbaxid - mapper_Fa2r%tgt_mbid = mbintxar + mapper_Fa2r%tgt_mbid = mbrxid mapper_Fa2r%intx_mbid = mbintxar mapper_Fa2r%src_context = rof(1)%cplcompid mapper_Fa2r%intx_context = idintx @@ -513,7 +513,7 @@ subroutine prep_rof_init(infodata, lnd_c2_rof, atm_c2_rof, ocn_c2_rof) #ifdef HAVE_MOAB ! now take care of the mapper, use the same one as before mapper_Sa2r%src_mbid = mbaxid - mapper_Sa2r%tgt_mbid = mbintxar + mapper_Sa2r%tgt_mbid = mbrxid mapper_Sa2r%intx_mbid = mbintxar mapper_Sa2r%src_context = atm(1)%cplcompid mapper_Sa2r%intx_context = idintx diff --git a/driver-moab/main/seq_map_mod.F90 b/driver-moab/main/seq_map_mod.F90 index 7a76a59ed9ea..c05b7b3ff6f0 100644 --- a/driver-moab/main/seq_map_mod.F90 +++ b/driver-moab/main/seq_map_mod.F90 @@ -333,6 +333,7 @@ subroutine seq_map_map( mapper, av_s, av_d, fldlist, norm, avwts_s, avwtsfld_s, integer, dimension(:), allocatable :: globalIds real(r8), dimension(:), allocatable :: wghts real(kind=r8) , allocatable :: targtags(:,:) + real(kind=r8) :: factor #endif ! ! Local Variables @@ -568,7 +569,7 @@ subroutine seq_map_map( mapper, av_s, av_d, fldlist, norm, avwts_s, avwtsfld_s, ! receive in the intx app, because it is redistributed according to coverage (trick) ! for true intx cases, tgt_mbid is set to be the same as intx_mbid ! just read map is special - ierr = iMOAB_ReceiveElementTag( mapper%tgt_mbid, fldlist_moab, mapper%mpicom, mapper%src_context ); + ierr = iMOAB_ReceiveElementTag( mapper%intx_mbid, fldlist_moab, mapper%mpicom, mapper%src_context ); if (ierr .ne. 0) then write(logunit,*) subname,' error in receiving tags ', mapper%mbname, trim(fldlist_moab) call shr_sys_flush(logunit) @@ -627,7 +628,9 @@ subroutine seq_map_map( mapper, av_s, av_d, fldlist, norm, avwts_s, avwtsfld_s, ! do the post mapping normalization ! TODO: add some check for wghts < puny do j = 1, lsize - targtags(j,:)= targtags(j,:)*(1.0_r8/wghts(j)) + factor = wghts(j) + if (wghts(j) .ne. 0) factor = 1.0_r8/wghts(j) ! should we compare to a small value instead ? + targtags(j,:)= targtags(j,:)*factor enddo ! put the values back on the mesh diff --git a/driver-moab/main/seq_map_type_mod.F90 b/driver-moab/main/seq_map_type_mod.F90 index 950528e9be83..6cd16928c719 100644 --- a/driver-moab/main/seq_map_type_mod.F90 +++ b/driver-moab/main/seq_map_type_mod.F90 @@ -157,6 +157,7 @@ subroutine seq_map_mapinit(mapper,mpicom) mapper%tgt_mbid = -1 mapper%intx_mbid = -1 mapper%nentities = 0 + mapper%tag_entity_type = 1 ! cells most of the time when we need it mapper%mbname = "undefined" #endif From 5522d8deeaa54895729ea5b0fba012cddc00d4e4 Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Tue, 28 Feb 2023 20:12:54 -0600 Subject: [PATCH 344/467] introduce an extra arg for map from file force duplication of the map by default it is false if rtue, it will generate a new mapper, skipping matches found needed for moab implementation, to avoid conflicts between mapper_So2a and mapper_Sof2a --- driver-moab/main/prep_aoflux_mod.F90 | 4 ++-- driver-moab/main/prep_atm_mod.F90 | 4 +++- driver-moab/main/seq_map_mod.F90 | 23 ++++++++++++++--------- 3 files changed, 19 insertions(+), 12 deletions(-) diff --git a/driver-moab/main/prep_aoflux_mod.F90 b/driver-moab/main/prep_aoflux_mod.F90 index 8c84b511f7e3..1fc56a79647f 100644 --- a/driver-moab/main/prep_aoflux_mod.F90 +++ b/driver-moab/main/prep_aoflux_mod.F90 @@ -163,7 +163,7 @@ subroutine prep_aoflux_init (infodata) allocate(tagValues(arrSize) ) ent_type = 1 ! cell type tagValues = 0._r8 - ierr = iMOAB_SetDoubleTagStorage ( mbofxid, tagname, arrSize , ent_type, tagValues) + ierr = iMOAB_SetDoubleTagStorage ( mbofxid, tagname, arrSize , ent_type, tagValues(1)) if (ierr .ne. 0) then write(logunit,*) subname,' error in zeroing out xao_fields ' call shr_sys_abort(subname//' ERROR in zeroing out xao_fields in init ') @@ -179,7 +179,7 @@ subroutine prep_aoflux_init (infodata) xao_omct = 0._r8 ent_type = 0 ! cell type, this is point cloud mct arrSize = lsize_o * size_list - ierr = iMOAB_SetDoubleTagStorage ( mbox2id, tagname, arrSize , ent_type, xao_omct) + ierr = iMOAB_SetDoubleTagStorage ( mbox2id, tagname, arrSize , ent_type, xao_omct ) if (ierr .ne. 0) then write(logunit,*) subname,' error in zeroing out xao_fields on mct instance ocn ' call shr_sys_abort(subname//' ERROR in zeroing out xao_fields on mct instance ocn ') diff --git a/driver-moab/main/prep_atm_mod.F90 b/driver-moab/main/prep_atm_mod.F90 index ef6bc3bef804..6cf611bc6eec 100644 --- a/driver-moab/main/prep_atm_mod.F90 +++ b/driver-moab/main/prep_atm_mod.F90 @@ -168,6 +168,7 @@ subroutine prep_atm_init(infodata, ocn_c2_atm, ice_c2_atm, lnd_c2_atm, iac_c2_at integer :: tagtype, numco, tagindex character(CXX) :: tagName integer :: context_id ! we will use a special context for the extra flux ocean instance + logical :: no_match ! used to force a new mapper !--------------------------------------------------------------- @@ -233,9 +234,10 @@ subroutine prep_atm_init(infodata, ocn_c2_atm, ice_c2_atm, lnd_c2_atm, iac_c2_at write(logunit,*) ' ' write(logunit,F00) 'Initializing mapper_Sof2a' endif + no_match = .true. ! force to cerate a new object call seq_map_init_rcfile(mapper_Sof2a, ocn(1), atm(1), & 'seq_maps.rc','ocn2atm_smapname:','ocn2atm_smaptype:',samegrid_ao, & - 'mapper_Sof2a initialization',esmf_map_flag) + 'mapper_Sof2a initialization',esmf_map_flag, no_match) #ifdef HAVE_MOAB ! Call moab intx only if atm and ocn are init in moab diff --git a/driver-moab/main/seq_map_mod.F90 b/driver-moab/main/seq_map_mod.F90 index c05b7b3ff6f0..9f249159587b 100644 --- a/driver-moab/main/seq_map_mod.F90 +++ b/driver-moab/main/seq_map_mod.F90 @@ -59,7 +59,7 @@ module seq_map_mod !======================================================================= subroutine seq_map_init_rcfile( mapper, comp_s, comp_d, & - maprcfile, maprcname, maprctype, samegrid, string, esmf_map) + maprcfile, maprcname, maprctype, samegrid, string, esmf_map, no_match) implicit none !----------------------------------------------------- @@ -75,6 +75,7 @@ subroutine seq_map_init_rcfile( mapper, comp_s, comp_d, & logical ,intent(in) :: samegrid character(len=*) ,intent(in),optional :: string logical ,intent(in),optional :: esmf_map + logical ,intent(in),optional :: no_match ! ! Local Variables ! @@ -84,6 +85,7 @@ subroutine seq_map_init_rcfile( mapper, comp_s, comp_d, & character(CX) :: mapfile character(CL) :: maptype integer(IN) :: mapid + logical :: skip_match = .false.; character(len=*),parameter :: subname = "(seq_map_init_rcfile) " !----------------------------------------------------- @@ -91,6 +93,9 @@ subroutine seq_map_init_rcfile( mapper, comp_s, comp_d, & write(logunit,'(A)') subname//' called for '//trim(string) endif + if (present(no_match)) then + if (no_match) skip_match = .true. + endif call seq_comm_setptrs(CPLID, mpicom=mpicom) gsmap_s => component_get_gsmap_cx(comp_s) @@ -99,7 +104,7 @@ subroutine seq_map_init_rcfile( mapper, comp_s, comp_d, & if (mct_gsmap_Identical(gsmap_s,gsmap_d)) then call seq_map_mapmatch(mapid,gsmap_s=gsmap_s,gsmap_d=gsmap_d,strategy="copy") - if (mapid > 0) then + if (mapid > 0 .and. .not. skip_match) then call seq_map_mappoint(mapid,mapper) else call seq_map_mapinit(mapper,mpicom) @@ -112,7 +117,7 @@ subroutine seq_map_init_rcfile( mapper, comp_s, comp_d, & elseif (samegrid) then call seq_map_mapmatch(mapid,gsmap_s=gsmap_s,gsmap_d=gsmap_d,strategy="rearrange") - if (mapid > 0) then + if (mapid > 0 .and. .not. skip_match) then call seq_map_mappoint(mapid,mapper) else ! --- Initialize rearranger @@ -132,7 +137,7 @@ subroutine seq_map_init_rcfile( mapper, comp_s, comp_d, & call seq_map_mapmatch(mapid,gsMap_s=gsMap_s,gsMap_d=gsMap_d,mapfile=mapfile,strategy=maptype) - if (mapid > 0) then + if (mapid > 0 .and. .not. skip_match) then call seq_map_mappoint(mapid,mapper) else call seq_map_mapinit(mapper,mpicom) @@ -535,9 +540,9 @@ subroutine seq_map_map( mapper, av_s, av_d, fldlist, norm, avwts_s, avwtsfld_s, arrsize=lsize*(nfields) ! get the current values of all source tags including the norm8wt currently set to 1 - ierr = iMOAB_GetDoubleTagStorage (mapper%src_mbid, fldlist_moab, arrsize , mapper%tag_entity_type, targtags) + ierr = iMOAB_GetDoubleTagStorage (mapper%src_mbid, fldlist_moab, arrsize , mapper%tag_entity_type, targtags(1,1)) if (ierr .ne. 0) then - write(logunit,*) subname,' error getting source tag values ', mapper%mbname + write(logunit,*) subname,' error getting source tag values ', mapper%mbname, mapper%src_mbid, trim(fldlist_moab), arrsize, mapper%tag_entity_type call shr_sys_abort(subname//' ERROR getting source tag values') ! serious enough endif @@ -548,7 +553,7 @@ subroutine seq_map_map( mapper, av_s, av_d, fldlist, norm, avwts_s, avwtsfld_s, enddo ! put the new values on the mesh for later mapping - ierr = iMOAB_SetDoubleTagStorage (mapper%src_mbid, fldlist_moab, arrsize , mapper%tag_entity_type, targtags) + ierr = iMOAB_SetDoubleTagStorage (mapper%src_mbid, fldlist_moab, arrsize , mapper%tag_entity_type, targtags(1,1)) if (ierr .ne. 0) then write(logunit,*) subname,' error setting normed source tag values ', mapper%mbname call shr_sys_abort(subname//' ERROR setting normed source tag values') ! serious enough @@ -619,7 +624,7 @@ subroutine seq_map_map( mapper, av_s, av_d, fldlist, norm, avwts_s, avwtsfld_s, ! get values of target tags after mapping allocate(targtags(lsize,nfields)) arrsize=lsize*(nfields) - ierr = iMOAB_GetDoubleTagStorage (mapper%tgt_mbid, fldlist_moab, arrsize , mapper%tag_entity_type, targtags) + ierr = iMOAB_GetDoubleTagStorage (mapper%tgt_mbid, fldlist_moab, arrsize , mapper%tag_entity_type, targtags(1,1)) if (ierr .ne. 0) then write(logunit,*) subname,' error getting destination tag values ', mapper%mbname call shr_sys_abort(subname//' ERROR getting source tag values') ! serious enough @@ -634,7 +639,7 @@ subroutine seq_map_map( mapper, av_s, av_d, fldlist, norm, avwts_s, avwtsfld_s, enddo ! put the values back on the mesh - ierr = iMOAB_SetDoubleTagStorage (mapper%tgt_mbid, fldlist_moab, arrsize , mapper%tag_entity_type, targtags) + ierr = iMOAB_SetDoubleTagStorage (mapper%tgt_mbid, fldlist_moab, arrsize , mapper%tag_entity_type, targtags(1,1)) if (ierr .ne. 0) then write(logunit,*) subname,' error getting destination tag values ', mapper%mbname call shr_sys_abort(subname//' ERROR getting source tag values') ! serious enough From 4fc0926bdf0276bacbe40e5932d3ad69101b689e Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Tue, 28 Feb 2023 22:59:03 -0600 Subject: [PATCH 345/467] need to add another attribute to map type if map is read, we will send to target, not to intx, in the second hop kind of confusing we should send always to target, whey do we need the trick with intx? --- driver-moab/main/prep_ocn_mod.F90 | 5 ++++- driver-moab/main/seq_map_mod.F90 | 11 ++++++++--- driver-moab/main/seq_map_type_mod.F90 | 2 ++ 3 files changed, 14 insertions(+), 4 deletions(-) diff --git a/driver-moab/main/prep_ocn_mod.F90 b/driver-moab/main/prep_ocn_mod.F90 index aa41b735a041..21abeb7761a3 100644 --- a/driver-moab/main/prep_ocn_mod.F90 +++ b/driver-moab/main/prep_ocn_mod.F90 @@ -671,7 +671,7 @@ subroutine prep_ocn_init(infodata, atm_c2_ocn, atm_c2_ice, ice_c2_ocn, rof_c2_oc deallocate (tmparray) - ! now we have to populate the map with the right moab attibutes, so that it does the right projection + ! now we have to populate the map with the right moab attributes, so that it does the right projection #ifdef MOABDEBUG if (mbrxoid.ge.0) then ! we are on coupler PEs call mpi_comm_rank(mpicom_CPLID, rank_on_cpl , ierr) @@ -693,12 +693,14 @@ subroutine prep_ocn_init(infodata, atm_c2_ocn, atm_c2_ice, ice_c2_ocn, rof_c2_oc wgtIdef = 'map-from-file'//C_NULL_CHAR mapper_Rr2o_liq%weight_identifier = wgtIdef mapper_Rr2o_liq%mbname = 'mapper_Rr2o_liq' + mapper_Rr2o_liq%read_map = .true. #endif if (iamroot_CPLID) then write(logunit,*) ' ' write(logunit,F00) 'Initializing mapper_Rr2o_ice' end if + ! is this the same map as above ? call seq_map_init_rcfile(mapper_Rr2o_ice, rof(1), ocn(1), & 'seq_maps.rc', 'rof2ocn_ice_rmapname:', 'rof2ocn_ice_rmaptype:',samegrid_ro, & 'mapper_Rr2o_ice initialization',esmf_map_flag) @@ -713,6 +715,7 @@ subroutine prep_ocn_init(infodata, atm_c2_ocn, atm_c2_ice, ice_c2_ocn, rof_c2_oc wgtIdef = 'map-from-file'//C_NULL_CHAR mapper_Rr2o_ice%weight_identifier = wgtIdef mapper_Rr2o_ice%mbname = 'mapper_Rr2o_ice' + mapper_Rr2o_ice%read_map = .true. #endif if (flood_present) then if (iamroot_CPLID) then diff --git a/driver-moab/main/seq_map_mod.F90 b/driver-moab/main/seq_map_mod.F90 index 9f249159587b..7aabf968ca02 100644 --- a/driver-moab/main/seq_map_mod.F90 +++ b/driver-moab/main/seq_map_mod.F90 @@ -558,8 +558,9 @@ subroutine seq_map_map( mapper, av_s, av_d, fldlist, norm, avwts_s, avwtsfld_s, write(logunit,*) subname,' error setting normed source tag values ', mapper%mbname call shr_sys_abort(subname//' ERROR setting normed source tag values') ! serious enough endif + deallocate(targtags) endif ! end multiplication by norm factor - deallocate(wghts, targtags) + deallocate(wghts) endif ! end NORMALIZATION ! @@ -574,9 +575,13 @@ subroutine seq_map_map( mapper, av_s, av_d, fldlist, norm, avwts_s, avwtsfld_s, ! receive in the intx app, because it is redistributed according to coverage (trick) ! for true intx cases, tgt_mbid is set to be the same as intx_mbid ! just read map is special - ierr = iMOAB_ReceiveElementTag( mapper%intx_mbid, fldlist_moab, mapper%mpicom, mapper%src_context ); + if (mapper%read_map) then ! receive indeed in target app + ierr = iMOAB_ReceiveElementTag( mapper%tgt_mbid, fldlist_moab, mapper%mpicom, mapper%src_context ) + else ! receive in the intx app, trick + ierr = iMOAB_ReceiveElementTag( mapper%intx_mbid, fldlist_moab, mapper%mpicom, mapper%src_context ) + endif if (ierr .ne. 0) then - write(logunit,*) subname,' error in receiving tags ', mapper%mbname, trim(fldlist_moab) + write(logunit,*) subname,' error in receiving tags ', mapper%mbname, 'recv:', mapper%intx_mbid, trim(fldlist_moab) call shr_sys_flush(logunit) call shr_sys_abort(subname//' ERROR in receiving tags') !valid_moab_context = .false. ! do not attempt to project diff --git a/driver-moab/main/seq_map_type_mod.F90 b/driver-moab/main/seq_map_type_mod.F90 index 6cd16928c719..65c49dd5e557 100644 --- a/driver-moab/main/seq_map_type_mod.F90 +++ b/driver-moab/main/seq_map_type_mod.F90 @@ -47,6 +47,7 @@ module seq_map_type_mod character*16 :: mbname integer :: tag_entity_type integer :: nentities ! this should be used only if copy_only is true + logical :: read_map ! #endif @@ -159,6 +160,7 @@ subroutine seq_map_mapinit(mapper,mpicom) mapper%nentities = 0 mapper%tag_entity_type = 1 ! cells most of the time when we need it mapper%mbname = "undefined" + mapper%read_map = .false. #endif end subroutine seq_map_mapinit From 4c08529ecf0e252f6eb90456b3d246cb563ab2cc Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Tue, 28 Feb 2023 23:00:57 -0600 Subject: [PATCH 346/467] add norm8wt field to moab rof coupler instance --- driver-moab/main/prep_rof_mod.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/driver-moab/main/prep_rof_mod.F90 b/driver-moab/main/prep_rof_mod.F90 index 54f7b4bb2eab..36b59061bc37 100644 --- a/driver-moab/main/prep_rof_mod.F90 +++ b/driver-moab/main/prep_rof_mod.F90 @@ -442,7 +442,7 @@ subroutine prep_rof_init(infodata, lnd_c2_rof, atm_c2_rof, ocn_c2_rof) ! because we will project fields from atm to rof grid, we need to define ! rof a2x fields to rof grid on coupler side - tagname = trim(seq_flds_a2x_fields_to_rof)//C_NULL_CHAR + tagname = trim(seq_flds_a2x_fields_to_rof)//'norm8wt'//C_NULL_CHAR tagtype = 1 ! dense numco = 1 ! ierr = iMOAB_DefineTagStorage(mbrxid, tagname, tagtype, numco, tagindex ) @@ -467,7 +467,7 @@ subroutine prep_rof_init(infodata, lnd_c2_rof, atm_c2_rof, ocn_c2_rof) fNoBubble = 1 monotonicity = 0 ! noConserve = 0 - validate = 1 + validate = 0 fInverseDistanceMap = 0 if (iamroot_CPLID) then write(logunit,*) subname, 'launch iMOAB weights with args ', 'mbintxar=', mbintxar, ' wgtIdef=', wgtIdef, & From 0e989d98b46acde79981672406e2f2b632dd9ccf Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Tue, 28 Feb 2023 23:47:18 -0600 Subject: [PATCH 347/467] source context for Fa2r should be atm(1)cplcompid --- driver-moab/main/prep_rof_mod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/driver-moab/main/prep_rof_mod.F90 b/driver-moab/main/prep_rof_mod.F90 index 36b59061bc37..ce1d514241d2 100644 --- a/driver-moab/main/prep_rof_mod.F90 +++ b/driver-moab/main/prep_rof_mod.F90 @@ -434,7 +434,7 @@ subroutine prep_rof_init(infodata, lnd_c2_rof, atm_c2_rof, ocn_c2_rof) mapper_Fa2r%src_mbid = mbaxid mapper_Fa2r%tgt_mbid = mbrxid mapper_Fa2r%intx_mbid = mbintxar - mapper_Fa2r%src_context = rof(1)%cplcompid + mapper_Fa2r%src_context = atm(1)%cplcompid mapper_Fa2r%intx_context = idintx wgtIdef = 'scalar'//C_NULL_CHAR mapper_Fa2r%weight_identifier = wgtIdef From 10e635c133d5a7466ea3b6e42a6e4fb0aeea24b7 Mon Sep 17 00:00:00 2001 From: Robert Jacob Date: Wed, 1 Mar 2023 17:21:40 -0600 Subject: [PATCH 348/467] Change init of skip_match, add output Change init of skip_match to be in the subroutine itself. Also add more output if skip_match is true. --- driver-moab/main/seq_map_mod.F90 | 12 +++++++++++- 1 file changed, 11 insertions(+), 1 deletion(-) diff --git a/driver-moab/main/seq_map_mod.F90 b/driver-moab/main/seq_map_mod.F90 index 7aabf968ca02..5392872c17ef 100644 --- a/driver-moab/main/seq_map_mod.F90 +++ b/driver-moab/main/seq_map_mod.F90 @@ -85,7 +85,7 @@ subroutine seq_map_init_rcfile( mapper, comp_s, comp_d, & character(CX) :: mapfile character(CL) :: maptype integer(IN) :: mapid - logical :: skip_match = .false.; + logical :: skip_match character(len=*),parameter :: subname = "(seq_map_init_rcfile) " !----------------------------------------------------- @@ -93,6 +93,7 @@ subroutine seq_map_init_rcfile( mapper, comp_s, comp_d, & write(logunit,'(A)') subname//' called for '//trim(string) endif + skip_match = .false. if (present(no_match)) then if (no_match) skip_match = .true. endif @@ -107,6 +108,9 @@ subroutine seq_map_init_rcfile( mapper, comp_s, comp_d, & if (mapid > 0 .and. .not. skip_match) then call seq_map_mappoint(mapid,mapper) else + if(skip_match) then + write(logunit,'(A)') subname, 'skip_match true, force new map' + endif call seq_map_mapinit(mapper,mpicom) mapper%copy_only = .true. mapper%strategy = "copy" @@ -120,6 +124,9 @@ subroutine seq_map_init_rcfile( mapper, comp_s, comp_d, & if (mapid > 0 .and. .not. skip_match) then call seq_map_mappoint(mapid,mapper) else + if(skip_match) then + write(logunit,'(A)') subname, 'skip_match true, force new map' + endif ! --- Initialize rearranger call seq_map_mapinit(mapper,mpicom) mapper%rearrange_only = .true. @@ -140,6 +147,9 @@ subroutine seq_map_init_rcfile( mapper, comp_s, comp_d, & if (mapid > 0 .and. .not. skip_match) then call seq_map_mappoint(mapid,mapper) else + if(skip_match) then + write(logunit,'(A)') subname, 'skip_match true, force new map' + endif call seq_map_mapinit(mapper,mpicom) mapper%mapfile = trim(mapfile) mapper%strategy= trim(maptype) From 91d5490659d4497662c4481c382d17ee5a289665 Mon Sep 17 00:00:00 2001 From: Robert Jacob Date: Wed, 1 Mar 2023 17:22:57 -0600 Subject: [PATCH 349/467] Force new map for Fof2a use skip_match to force a new map for Fof2a. --- driver-moab/main/prep_atm_mod.F90 | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/driver-moab/main/prep_atm_mod.F90 b/driver-moab/main/prep_atm_mod.F90 index 6cf611bc6eec..b91648587631 100644 --- a/driver-moab/main/prep_atm_mod.F90 +++ b/driver-moab/main/prep_atm_mod.F90 @@ -234,7 +234,7 @@ subroutine prep_atm_init(infodata, ocn_c2_atm, ice_c2_atm, lnd_c2_atm, iac_c2_at write(logunit,*) ' ' write(logunit,F00) 'Initializing mapper_Sof2a' endif - no_match = .true. ! force to cerate a new object + no_match = .true. ! force to create a new mapper object call seq_map_init_rcfile(mapper_Sof2a, ocn(1), atm(1), & 'seq_maps.rc','ocn2atm_smapname:','ocn2atm_smaptype:',samegrid_ao, & 'mapper_Sof2a initialization',esmf_map_flag, no_match) @@ -401,9 +401,10 @@ subroutine prep_atm_init(infodata, ocn_c2_atm, ice_c2_atm, lnd_c2_atm, iac_c2_at write(logunit,*) ' ' write(logunit,F00) 'Initializing mapper_Fof2a' endif + no_match = .true. ! force to create a new mapper object call seq_map_init_rcfile(mapper_Fof2a, ocn(1), atm(1), & 'seq_maps.rc','ocn2atm_fmapname:','ocn2atm_fmaptype:',samegrid_ao, & - 'mapper_Fof2a initialization',esmf_map_flag) + 'mapper_Fof2a initialization',esmf_map_flag, no_match) ! copy mapper_So2a , maybe change the matrix ? still based on intersection ? #ifdef HAVE_MOAB From ac20de738dd9d52b513ba957e2e1d6f5b666ea2b Mon Sep 17 00:00:00 2001 From: Robert Jacob Date: Thu, 2 Mar 2023 18:56:36 -0600 Subject: [PATCH 350/467] Reduce a log message in seq_map Reduce the force skip message to just task 0. Also turn norming on by default. --- driver-moab/main/seq_map_mod.F90 | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/driver-moab/main/seq_map_mod.F90 b/driver-moab/main/seq_map_mod.F90 index 5392872c17ef..91a338e56018 100644 --- a/driver-moab/main/seq_map_mod.F90 +++ b/driver-moab/main/seq_map_mod.F90 @@ -108,7 +108,7 @@ subroutine seq_map_init_rcfile( mapper, comp_s, comp_d, & if (mapid > 0 .and. .not. skip_match) then call seq_map_mappoint(mapid,mapper) else - if(skip_match) then + if(skip_match .and. seq_comm_iamroot(CPLID)) then write(logunit,'(A)') subname, 'skip_match true, force new map' endif call seq_map_mapinit(mapper,mpicom) @@ -124,7 +124,7 @@ subroutine seq_map_init_rcfile( mapper, comp_s, comp_d, & if (mapid > 0 .and. .not. skip_match) then call seq_map_mappoint(mapid,mapper) else - if(skip_match) then + if(skip_match .and. seq_comm_iamroot(CPLID)) then write(logunit,'(A)') subname, 'skip_match true, force new map' endif ! --- Initialize rearranger @@ -147,7 +147,7 @@ subroutine seq_map_init_rcfile( mapper, comp_s, comp_d, & if (mapid > 0 .and. .not. skip_match) then call seq_map_mappoint(mapid,mapper) else - if(skip_match) then + if(skip_match .and. seq_comm_iamroot(CPLID)) then write(logunit,'(A)') subname, 'skip_match true, force new map' endif call seq_map_mapinit(mapper,mpicom) @@ -377,8 +377,8 @@ subroutine seq_map_map( mapper, av_s, av_d, fldlist, norm, avwts_s, avwtsfld_s, mbpresent = .false. endif -! mbnorm = .false. ! uncomment both to turn off normalization for all maps -! mbpresent = .false. + !mbnorm = .false. ! uncomment both to turn off normalization for all maps + !mbpresent = .false. if (present(msgtag)) then ltag = msgtag From b381e2c1789842d03d929ea8290196cc16d06a5d Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Mon, 6 Mar 2023 18:42:49 -0600 Subject: [PATCH 351/467] add compute weights lnd-atm case needed for tri-grid case only it was missing somehow --- driver-moab/main/prep_atm_mod.F90 | 50 ++++++++++++++++++++++++++----- 1 file changed, 43 insertions(+), 7 deletions(-) diff --git a/driver-moab/main/prep_atm_mod.F90 b/driver-moab/main/prep_atm_mod.F90 index 16569abb542f..3a7e0a5ed8b3 100644 --- a/driver-moab/main/prep_atm_mod.F90 +++ b/driver-moab/main/prep_atm_mod.F90 @@ -333,8 +333,8 @@ subroutine prep_atm_init(infodata, ocn_c2_atm, ice_c2_atm, lnd_c2_atm, iac_c2_at noConserve, validate, & trim(dofnameS), trim(dofnameT) ) if (ierr .ne. 0) then - write(logunit,*) subname,' error in computing ' - call shr_sys_abort(subname//' ERROR in writing intx file ') + write(logunit,*) subname,' error in iMOAB_ComputeScalarProjectionWeights ocn atm ' + call shr_sys_abort(subname//' ERROR in iMOAB_ComputeScalarProjectionWeights ocn atm ') endif @@ -536,8 +536,8 @@ subroutine prep_atm_init(infodata, ocn_c2_atm, ice_c2_atm, lnd_c2_atm, iac_c2_at noConserve, validate, & trim(dofnameS), trim(dofnameT) ) if (ierr .ne. 0) then - write(logunit,*) subname,' error in computing ' - call shr_sys_abort(subname//' ERROR in writing intx file ') + write(logunit,*) subname,' error in iMOAB_ComputeScalarProjectionWeights ice atm ' + call shr_sys_abort(subname//' error in iMOAB_ComputeScalarProjectionWeights ice atm ') endif @@ -647,14 +647,50 @@ subroutine prep_atm_init(infodata, ocn_c2_atm, ice_c2_atm, lnd_c2_atm, iac_c2_at call seq_comm_getinfo(CPLID ,mpigrp=mpigrp_CPLID) type1 = 3; ! fv for lnd and atm; fv-cgll does not work anyway type2 = 3; - ! ierr = iMOAB_ComputeCommGraph( mboxid, mbintxoa, &mpicom_CPLID, &mpigrp_CPLID, &mpigrp_CPLID, &type1, &type2, - ! &ocn_id, &idintx) + ierr = iMOAB_ComputeCommGraph( mblxid, mbintxla, mpicom_CPLID, mpigrp_CPLID, mpigrp_CPLID, type1, type2, & lnd(1)%cplcompid, idintx) if (ierr .ne. 0) then write(logunit,*) subname,' error in computing comm graph for second hop, ice-atm' call shr_sys_abort(subname//' ERROR in computing comm graph for second hop, ice-atm') endif + ! need to compute weigths + volumetric = 0 ! can be 1 only for FV->DGLL or FV->CGLL; + + if (atm_pg_active) then + dm2 = "fv"//C_NULL_CHAR + dofnameT="GLOBAL_ID"//C_NULL_CHAR + orderT = 1 ! fv-fv + else + dm2 = "cgll"//C_NULL_CHAR + dofnameT="GLOBAL_DOFS"//C_NULL_CHAR + orderT = np ! it should be 4 + endif + dm1 = "fv"//C_NULL_CHAR + dofnameS="GLOBAL_ID"//C_NULL_CHAR + orderS = 1 ! not much arguing + fNoBubble = 1 + monotonicity = 0 ! + noConserve = 0 + validate = 0 ! less verbose + fInverseDistanceMap = 0 + if (iamroot_CPLID) then + write(logunit,*) subname, 'launch iMOAB weights with args ', 'mbintxla=', mbintxla, ' wgtIdef=', wgtIdef, & + 'dm1=', trim(dm1), ' orderS=', orderS, 'dm2=', trim(dm2), ' orderT=', orderT, & + fNoBubble, monotonicity, volumetric, fInverseDistanceMap, & + noConserve, validate, & + trim(dofnameS), trim(dofnameT) + endif + ierr = iMOAB_ComputeScalarProjectionWeights ( mbintxla, wgtIdef, & + trim(dm1), orderS, trim(dm2), orderT, & + fNoBubble, monotonicity, volumetric, fInverseDistanceMap, & + noConserve, validate, & + trim(dofnameS), trim(dofnameT) ) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in iMOAB_ComputeScalarProjectionWeights lnd atm ' + call shr_sys_abort(subname//' error in iMOAB_ComputeScalarProjectionWeights lnd atm ') + endif + else ! the same mesh , atm and lnd use the same dofs, but restricted ! we do not compute intersection, so we will have to just send data from atm to land and viceversa, by GLOBAL_ID matching ! so we compute just a comm graph, between lnd and atm dofs, on the coupler; target is atm @@ -672,7 +708,7 @@ subroutine prep_atm_init(infodata, ocn_c2_atm, ice_c2_atm, lnd_c2_atm, iac_c2_at mapper_Fl2a%intx_context = atm(1)%cplcompid endif ! if tri-grid - ! we still need to defne seq_flds_l2x_fields on atm cpl mesh + ! we still need to define seq_flds_l2x_fields on atm cpl mesh if (atm_pg_active) then tagname = trim(seq_flds_l2x_fields)//C_NULL_CHAR tagtype = 1 ! dense From 914b86241d415f30433d6484c341f7e5bdd22609 Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Mon, 6 Mar 2023 22:40:32 -0600 Subject: [PATCH 352/467] tri-grid case --- driver-moab/main/prep_lnd_mod.F90 | 11 ++++++----- 1 file changed, 6 insertions(+), 5 deletions(-) diff --git a/driver-moab/main/prep_lnd_mod.F90 b/driver-moab/main/prep_lnd_mod.F90 index b5d37348e1bc..f52684f72f86 100644 --- a/driver-moab/main/prep_lnd_mod.F90 +++ b/driver-moab/main/prep_lnd_mod.F90 @@ -411,15 +411,16 @@ subroutine prep_lnd_init(infodata, atm_c2_lnd, rof_c2_lnd, glc_c2_lnd, iac_c2_ln endif endif #endif - ! we also need to compute the comm graph for the second hop, from the atm on coupler to the ! lnd for the intx atm-lnd context (coverage) ! - - type1 = 1 ! this projection works (cgll to fv), but reverse does not ( fv - cgll) + if (atm_pg_active) then + type1 = 3; ! fv for atm; cgll does not work anyway + else + type1 = 1 ! this projection works (cgll to fv), but reverse does not ( fv - cgll) + endif type2 = 3; ! land is fv in this case (separate grid) - ! ierr = iMOAB_ComputeCommGraph( mboxid, mbintxoa, &mpicom_CPLID, &mpigrp_CPLID, &mpigrp_CPLID, &type1, &type2, - ! &ocn_id, &idintx) + ierr = iMOAB_ComputeCommGraph( mbaxid, mbintxal, mpicom_CPLID, mpigrp_CPLID, mpigrp_CPLID, type1, type2, & atm(1)%cplcompid, idintx) if (ierr .ne. 0) then From e81207378b7ecb54a530156d564f190043e7d9d3 Mon Sep 17 00:00:00 2001 From: Jason Sarich Date: Fri, 10 Mar 2023 12:35:59 -0600 Subject: [PATCH 353/467] whitespace change to check automated jenkins build --- cime_config/machines/config_machines.xml | 1 + 1 file changed, 1 insertion(+) diff --git a/cime_config/machines/config_machines.xml b/cime_config/machines/config_machines.xml index 1cbc6be2e2a0..6313b46cf579 100644 --- a/cime_config/machines/config_machines.xml +++ b/cime_config/machines/config_machines.xml @@ -1530,6 +1530,7 @@ /nfs/gce/projects/climate/software/netcdf/4.8.0c-4.3.1cxx-4.5.3f-parallel/mpich-3.4.2/gcc-11.1.0 /nfs/gce/projects/climate/software/pnetcdf/1.12.2/mpich-3.4.2/gcc-11.1.0 /nfs/gce/projects/climate/software/moab/devel/mpich-3.4.2/gcc-11.1.0 + From 3f0acf8c3a03c0e844d47b3e20cd7abfd252d20f Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Mon, 13 Mar 2023 15:00:18 -0500 Subject: [PATCH 354/467] samegrid land rof --- driver-moab/main/prep_lnd_mod.F90 | 179 +++++++++++++++++------------- driver-moab/main/prep_rof_mod.F90 | 174 ++++++++++++++++------------- 2 files changed, 197 insertions(+), 156 deletions(-) diff --git a/driver-moab/main/prep_lnd_mod.F90 b/driver-moab/main/prep_lnd_mod.F90 index f52684f72f86..8353c4363d5d 100644 --- a/driver-moab/main/prep_lnd_mod.F90 +++ b/driver-moab/main/prep_lnd_mod.F90 @@ -235,43 +235,108 @@ subroutine prep_lnd_init(infodata, atm_c2_lnd, rof_c2_lnd, glc_c2_lnd, iac_c2_ln write(logunit,*) subname,' error in registering rof lnd intx' call shr_sys_abort(subname//' ERROR in registering rof lnd intx') endif - ierr = iMOAB_ComputeMeshIntersectionOnSphere (mbrxid, mblxid, mbintxrl) - if (ierr .ne. 0) then - write(logunit,*) subname,' error in computing rof lnd intx' - call shr_sys_abort(subname//' ERROR in computing rof lnd intx') - endif - if (iamroot_CPLID) then - write(logunit,*) 'iMOAB intersection between rof and lnd with id:', idintx - end if - ! we also need to compute the comm graph for the second hop, from the rof on coupler to the - ! rof for the intx rof-lnd context (coverage) - ! - call seq_comm_getData(CPLID ,mpigrp=mpigrp_CPLID) - type1 = 3 ! land is FV now on coupler side - type2 = 3; - - ierr = iMOAB_ComputeCommGraph( mbrxid, mbintxrl, mpicom_CPLID, mpigrp_CPLID, mpigrp_CPLID, type1, type2, & - rof(1)%cplcompid, idintx) - if (ierr .ne. 0) then - write(logunit,*) subname,' error in computing comm graph for second hop, lnd-rof' - call shr_sys_abort(subname//' ERROR in computing comm graph for second hop, lnd-rof') - endif - ! now take care of the mapper - mapper_Fr2l%src_mbid = mbrxid - mapper_Fr2l%tgt_mbid = mblxid - mapper_Fr2l%intx_mbid = mbintxrl - mapper_Fr2l%src_context = rof(1)%cplcompid - mapper_Fr2l%intx_context = idintx - wgtIdef = 'scalar'//C_NULL_CHAR - mapper_Fr2l%weight_identifier = wgtIdef - mapper_Fr2l%mbname = 'mapper_Fr2l' + if (samegrid_lr)then +! the same mesh , lnd and rof use the same dofs, but restricted + ! we do not compute intersection, so we will have to just send data from lnd to rof and viceversa, by GLOBAL_ID matching + ! so we compute just a comm graph, between lnd and rof dofs, on the coupler; target is rof + ! land is full mesh + type1 = 3; ! full mesh for lrofarnd now + type2 = 3; ! fv for target land + ierr = iMOAB_ComputeCommGraph( mbrxid, mblxid, mpicom_CPLID, mpigrp_CPLID, mpigrp_CPLID, type1, type2, & + rof(1)%cplcompid, lnd(1)%cplcompid) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in computing comm graph , rof-lnd' + call shr_sys_abort(subname//' ERROR in computing comm graph , rof-lnd') + endif + ! context for rearrange is target in this case + mapper_Fr2l%src_mbid = mbrxid + mapper_Fr2l%tgt_mbid = mblxid + mapper_Fr2l%src_context = rof(1)%cplcompid + mapper_Fr2l%intx_context = lnd(1)%cplcompid + else + ierr = iMOAB_ComputeMeshIntersectionOnSphere (mbrxid, mblxid, mbintxrl) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in computing rof lnd intx' + call shr_sys_abort(subname//' ERROR in computing rof lnd intx') + endif + if (iamroot_CPLID) then + write(logunit,*) 'iMOAB intersection between rof and lnd with id:', idintx + end if + ! we also need to compute the comm graph for the second hop, from the rof on coupler to the + ! rof for the intx rof-lnd context (coverage) + ! + call seq_comm_getData(CPLID ,mpigrp=mpigrp_CPLID) + type1 = 3 ! land is FV now on coupler side + type2 = 3; - ! because we will project fields from rof to lnd grid, we need to define - ! the r2x fields to lnd grid on coupler side + ierr = iMOAB_ComputeCommGraph( mbrxid, mbintxrl, mpicom_CPLID, mpigrp_CPLID, mpigrp_CPLID, type1, type2, & + rof(1)%cplcompid, idintx) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in computing comm graph for second hop, lnd-rof' + call shr_sys_abort(subname//' ERROR in computing comm graph for second hop, lnd-rof') + endif + ! now take care of the mapper + mapper_Fr2l%src_mbid = mbrxid + mapper_Fr2l%tgt_mbid = mblxid + mapper_Fr2l%intx_mbid = mbintxrl + mapper_Fr2l%src_context = rof(1)%cplcompid + mapper_Fr2l%intx_context = idintx + wgtIdef = 'scalar'//C_NULL_CHAR + mapper_Fr2l%weight_identifier = wgtIdef + mapper_Fr2l%mbname = 'mapper_Fr2l' + + ! because we will project fields from rof to lnd grid, we need to define + ! the r2x fields to lnd grid on coupler side + + tagname = trim(seq_flds_r2x_fields)//C_NULL_CHAR + tagtype = 1 ! dense + numco = 1 ! + + volumetric = 0 ! can be 1 only for FV->DGLL or FV->CGLL; + + dm1 = "fv"//C_NULL_CHAR + dofnameS="GLOBAL_ID"//C_NULL_CHAR + orderS = 1 ! fv-fv - tagname = trim(seq_flds_r2x_fields)//C_NULL_CHAR - tagtype = 1 ! dense - numco = 1 ! + dm2 = "fv"//C_NULL_CHAR + dofnameT="GLOBAL_ID"//C_NULL_CHAR + orderT = 1 ! not much arguing + fNoBubble = 1 + monotonicity = 0 ! + noConserve = 0 + validate = 0 !! important + fInverseDistanceMap = 0 + if (iamroot_CPLID) then + write(logunit,*) subname, 'launch iMOAB weights with args ', 'mbintxrl=', mbintxrl, ' wgtIdef=', wgtIdef, & + 'dm1=', trim(dm1), ' orderS=', orderS, 'dm2=', trim(dm2), ' orderT=', orderT, & + fNoBubble, monotonicity, volumetric, fInverseDistanceMap, & + noConserve, validate, & + trim(dofnameS), trim(dofnameT) + endif + ierr = iMOAB_ComputeScalarProjectionWeights ( mbintxrl, wgtIdef, & + trim(dm1), orderS, trim(dm2), orderT, & + fNoBubble, monotonicity, volumetric, fInverseDistanceMap, & + noConserve, validate, & + trim(dofnameS), trim(dofnameT) ) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in computing rl weights ' + call shr_sys_abort(subname//' ERROR in computing rl weights ') + endif + +#ifdef MOABDEBUG + wopts = C_NULL_CHAR + call shr_mpi_commrank( mpicom_CPLID, rank ) + if (rank .lt. 5) then + write(lnum,"(I0.2)")rank ! + outfile = 'intx_rl_'//trim(lnum)// '.h5m' // C_NULL_CHAR + ierr = iMOAB_WriteMesh(mbintxrl, outfile, wopts) ! write local intx file + if (ierr .ne. 0) then + write(logunit,*) subname,' error in writing intx rl file ' + call shr_sys_abort(subname//' ERROR in writing intx rl file ') + endif + endif +#endif + endif ierr = iMOAB_DefineTagStorage(mblxid, tagname, tagtype, numco, tagindex ) if (ierr .ne. 0) then write(logunit,*) subname,' error in defining tags for seq_flds_r2x_fields on lnd cpl' @@ -300,50 +365,6 @@ subroutine prep_lnd_init(infodata, atm_c2_lnd, rof_c2_lnd, glc_c2_lnd, iac_c2_ln endif deallocate (tmparray) - volumetric = 0 ! can be 1 only for FV->DGLL or FV->CGLL; - - dm1 = "fv"//C_NULL_CHAR - dofnameS="GLOBAL_ID"//C_NULL_CHAR - orderS = 1 ! fv-fv - - dm2 = "fv"//C_NULL_CHAR - dofnameT="GLOBAL_ID"//C_NULL_CHAR - orderT = 1 ! not much arguing - fNoBubble = 1 - monotonicity = 0 ! - noConserve = 0 - validate = 0 !! important - fInverseDistanceMap = 0 - if (iamroot_CPLID) then - write(logunit,*) subname, 'launch iMOAB weights with args ', 'mbintxrl=', mbintxrl, ' wgtIdef=', wgtIdef, & - 'dm1=', trim(dm1), ' orderS=', orderS, 'dm2=', trim(dm2), ' orderT=', orderT, & - fNoBubble, monotonicity, volumetric, fInverseDistanceMap, & - noConserve, validate, & - trim(dofnameS), trim(dofnameT) - endif - ierr = iMOAB_ComputeScalarProjectionWeights ( mbintxrl, wgtIdef, & - trim(dm1), orderS, trim(dm2), orderT, & - fNoBubble, monotonicity, volumetric, fInverseDistanceMap, & - noConserve, validate, & - trim(dofnameS), trim(dofnameT) ) - if (ierr .ne. 0) then - write(logunit,*) subname,' error in computing rl weights ' - call shr_sys_abort(subname//' ERROR in computing rl weights ') - endif - -#ifdef MOABDEBUG - wopts = C_NULL_CHAR - call shr_mpi_commrank( mpicom_CPLID, rank ) - if (rank .lt. 5) then - write(lnum,"(I0.2)")rank ! - outfile = 'intx_rl_'//trim(lnum)// '.h5m' // C_NULL_CHAR - ierr = iMOAB_WriteMesh(mbintxrl, outfile, wopts) ! write local intx file - if (ierr .ne. 0) then - write(logunit,*) subname,' error in writing intx rl file ' - call shr_sys_abort(subname//' ERROR in writing intx rl file ') - endif - endif -#endif end if ! if ((mbrxid .ge. 0) .and. (mblxid .ge. 0)) ! endif HAVE_MOAB #endif diff --git a/driver-moab/main/prep_rof_mod.F90 b/driver-moab/main/prep_rof_mod.F90 index c4bfa3323333..3c9e740883d9 100644 --- a/driver-moab/main/prep_rof_mod.F90 +++ b/driver-moab/main/prep_rof_mod.F90 @@ -258,39 +258,6 @@ subroutine prep_rof_init(infodata, lnd_c2_rof, atm_c2_rof, ocn_c2_rof) write(logunit,*) subname,' error in registering lnd rof intx' call shr_sys_abort(subname//' ERROR in registering lnd rof intx') endif - ierr = iMOAB_ComputeMeshIntersectionOnSphere (mblxid, mbrxid, mbintxlr) - if (ierr .ne. 0) then - write(logunit,*) subname,' error in computing land rof intx' - call shr_sys_abort(subname//' ERROR in computing land rof intx') - endif - if (iamroot_CPLID) then - write(logunit,*) 'iMOAB intersection between land and rof with id:', idintx - end if - ! we also need to compute the comm graph for the second hop, from the lnd on coupler to the - ! lnd for the intx lnd-rof context (coverage) - ! - call seq_comm_getData(CPLID ,mpigrp=mpigrp_CPLID) - type1 = 3 ! land is FV now on coupler side - type2 = 3; - - ierr = iMOAB_ComputeCommGraph( mblxid, mbintxlr, mpicom_CPLID, mpigrp_CPLID, mpigrp_CPLID, type1, type2, & - lnd(1)%cplcompid, idintx) - if (ierr .ne. 0) then - write(logunit,*) subname,' error in computing comm graph for second hop, lnd-rof' - call shr_sys_abort(subname//' ERROR in computing comm graph for second hop, lnd-rof') - endif - ! now take care of the mapper - mapper_Fl2r%src_mbid = mblxid - mapper_Fl2r%tgt_mbid = mbrxid - mapper_Fl2r%intx_mbid = mbintxlr - mapper_Fl2r%src_context = lnd(1)%cplcompid - mapper_Fl2r%intx_context = idintx - wgtIdef = 'scalar'//C_NULL_CHAR - mapper_Fl2r%weight_identifier = wgtIdef - mapper_Fl2r%mbname = 'mapper_Fl2r' - ! because we will project fields from lnd to rof grid, we need to define - ! the l2x fields to rof grid on coupler side - tagname = trim(seq_flds_l2x_fluxes_to_rof)//C_NULL_CHAR tagtype = 1 ! dense numco = 1 ! @@ -299,52 +266,105 @@ subroutine prep_rof_init(infodata, lnd_c2_rof, atm_c2_rof, ocn_c2_rof) write(logunit,*) subname,' error in defining tags for seq_flds_a2x_fields on rof cpl' call shr_sys_abort(subname//' ERROR in defining tags for seq_flds_a2x_fields on rof cpl') endif - volumetric = 0 ! can be 1 only for FV->DGLL or FV->CGLL; + if (samegrid_lr) then + ! the same mesh , lnd and rof use the same dofs, but restricted + ! we do not compute intersection, so we will have to just send data from lnd to rof and viceversa, by GLOBAL_ID matching + ! so we compute just a comm graph, between lnd and rof dofs, on the coupler; target is rof + ! land is full mesh + type1 = 3; ! full mesh for land now + type2 = 3; ! fv for target rof + ierr = iMOAB_ComputeCommGraph( mblxid, mbrxid, mpicom_CPLID, mpigrp_CPLID, mpigrp_CPLID, type1, type2, & + lnd(1)%cplcompid, rof(1)%cplcompid) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in computing comm graph , lnd-rof' + call shr_sys_abort(subname//' ERROR in computing comm graph , lnd-rof') + endif + ! context for rearrange is target in this case + mapper_Fl2r%src_mbid = mblxid + mapper_Fl2r%tgt_mbid = mbrxid + mapper_Fl2r%src_context = lnd(1)%cplcompid + mapper_Fl2r%intx_context = rof(1)%cplcompid + else + ierr = iMOAB_ComputeMeshIntersectionOnSphere (mblxid, mbrxid, mbintxlr) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in computing land rof intx' + call shr_sys_abort(subname//' ERROR in computing land rof intx') + endif + if (iamroot_CPLID) then + write(logunit,*) 'iMOAB intersection between land and rof with id:', idintx + end if + ! we also need to compute the comm graph for the second hop, from the lnd on coupler to the + ! lnd for the intx lnd-rof context (coverage) + ! + call seq_comm_getData(CPLID ,mpigrp=mpigrp_CPLID) + type1 = 3 ! land is FV now on coupler side + type2 = 3; + + ierr = iMOAB_ComputeCommGraph( mblxid, mbintxlr, mpicom_CPLID, mpigrp_CPLID, mpigrp_CPLID, type1, type2, & + lnd(1)%cplcompid, idintx) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in computing comm graph for second hop, lnd-rof' + call shr_sys_abort(subname//' ERROR in computing comm graph for second hop, lnd-rof') + endif + ! now take care of the mapper + mapper_Fl2r%src_mbid = mblxid + mapper_Fl2r%tgt_mbid = mbrxid + mapper_Fl2r%intx_mbid = mbintxlr + mapper_Fl2r%src_context = lnd(1)%cplcompid + mapper_Fl2r%intx_context = idintx + wgtIdef = 'scalar'//C_NULL_CHAR + mapper_Fl2r%weight_identifier = wgtIdef + mapper_Fl2r%mbname = 'mapper_Fl2r' + ! because we will project fields from lnd to rof grid, we need to define + ! the l2x fields to rof grid on coupler side + + volumetric = 0 ! can be 1 only for FV->DGLL or FV->CGLL; + + dm1 = "fv"//C_NULL_CHAR + dofnameS="GLOBAL_ID"//C_NULL_CHAR + orderS = 1 ! fv-fv - dm1 = "fv"//C_NULL_CHAR - dofnameS="GLOBAL_ID"//C_NULL_CHAR - orderS = 1 ! fv-fv - - dm2 = "fv"//C_NULL_CHAR - dofnameT="GLOBAL_ID"//C_NULL_CHAR - orderT = 1 ! not much arguing - fNoBubble = 1 - monotonicity = 0 ! - noConserve = 0 - validate = 0 - fInverseDistanceMap = 0 - if (iamroot_CPLID) then - write(logunit,*) subname, 'launch iMOAB weights with args ', 'mbintxlr=', mbintxlr, ' wgtIdef=', wgtIdef, & - 'dm1=', trim(dm1), ' orderS=', orderS, 'dm2=', trim(dm2), ' orderT=', orderT, & - fNoBubble, monotonicity, volumetric, fInverseDistanceMap, & - noConserve, validate, & - trim(dofnameS), trim(dofnameT) - endif - ierr = iMOAB_ComputeScalarProjectionWeights ( mbintxlr, wgtIdef, & - trim(dm1), orderS, trim(dm2), orderT, & - fNoBubble, monotonicity, volumetric, fInverseDistanceMap, & - noConserve, validate, & - trim(dofnameS), trim(dofnameT) ) - if (ierr .ne. 0) then - write(logunit,*) subname,' error in computing lr weights ' - call shr_sys_abort(subname//' ERROR in computing lr weights ') - endif + dm2 = "fv"//C_NULL_CHAR + dofnameT="GLOBAL_ID"//C_NULL_CHAR + orderT = 1 ! not much arguing + fNoBubble = 1 + monotonicity = 0 ! + noConserve = 0 + validate = 0 + fInverseDistanceMap = 0 + if (iamroot_CPLID) then + write(logunit,*) subname, 'launch iMOAB weights with args ', 'mbintxlr=', mbintxlr, ' wgtIdef=', wgtIdef, & + 'dm1=', trim(dm1), ' orderS=', orderS, 'dm2=', trim(dm2), ' orderT=', orderT, & + fNoBubble, monotonicity, volumetric, fInverseDistanceMap, & + noConserve, validate, & + trim(dofnameS), trim(dofnameT) + endif + ierr = iMOAB_ComputeScalarProjectionWeights ( mbintxlr, wgtIdef, & + trim(dm1), orderS, trim(dm2), orderT, & + fNoBubble, monotonicity, volumetric, fInverseDistanceMap, & + noConserve, validate, & + trim(dofnameS), trim(dofnameT) ) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in computing lr weights ' + call shr_sys_abort(subname//' ERROR in computing lr weights ') + endif #ifdef MOABDEBUG - wopts = C_NULL_CHAR - call shr_mpi_commrank( mpicom_CPLID, rank ) - if (rank .lt. 5) then - write(lnum,"(I0.2)")rank ! - outfile = 'intx_lr_'//trim(lnum)// '.h5m' // C_NULL_CHAR - ierr = iMOAB_WriteMesh(mbintxlr, outfile, wopts) ! write local intx file - if (ierr .ne. 0) then - write(logunit,*) subname,' error in writing intx lr file ' - call shr_sys_abort(subname//' ERROR in writing intx lr file ') - endif - endif + wopts = C_NULL_CHAR + call shr_mpi_commrank( mpicom_CPLID, rank ) + if (rank .lt. 5) then + write(lnum,"(I0.2)")rank ! + outfile = 'intx_lr_'//trim(lnum)// '.h5m' // C_NULL_CHAR + ierr = iMOAB_WriteMesh(mbintxlr, outfile, wopts) ! write local intx file + if (ierr .ne. 0) then + write(logunit,*) subname,' error in writing intx lr file ' + call shr_sys_abort(subname//' ERROR in writing intx lr file ') + endif + endif #endif - end if ! if ((mblxid .ge. 0) .and. (mbrxid .ge. 0)) -! endif HAVE_MOAB + end if ! if ((mblxid .ge. 0) .and. (mbrxid .ge. 0)) + ! endif HAVE_MOAB + endif ! samegrid_lr #endif ! We'll map irrigation specially, so exclude this from the list of l2r fields ! that are mapped "normally". @@ -354,10 +374,10 @@ subroutine prep_rof_init(infodata, lnd_c2_rof, atm_c2_rof, ocn_c2_rof) list1 = seq_flds_l2x_fluxes_to_rof, & list2 = irrig_flux_field, & listout = lnd2rof_normal_fluxes) - endif + endif ! if (lnd_c2_rof) then call shr_sys_flush(logunit) - end if + end if ! if (rof_present .and. lnd_present) then if (rof_present .and. atm_present) then From 48950574c451cb0e74c1b64f752de9e958fda75c Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Mon, 13 Mar 2023 17:12:38 -0500 Subject: [PATCH 355/467] set numco and tagtype --- driver-moab/main/prep_lnd_mod.F90 | 7 +++---- 1 file changed, 3 insertions(+), 4 deletions(-) diff --git a/driver-moab/main/prep_lnd_mod.F90 b/driver-moab/main/prep_lnd_mod.F90 index 8353c4363d5d..e8c688f374e0 100644 --- a/driver-moab/main/prep_lnd_mod.F90 +++ b/driver-moab/main/prep_lnd_mod.F90 @@ -287,10 +287,6 @@ subroutine prep_lnd_init(infodata, atm_c2_lnd, rof_c2_lnd, glc_c2_lnd, iac_c2_ln ! because we will project fields from rof to lnd grid, we need to define ! the r2x fields to lnd grid on coupler side - - tagname = trim(seq_flds_r2x_fields)//C_NULL_CHAR - tagtype = 1 ! dense - numco = 1 ! volumetric = 0 ! can be 1 only for FV->DGLL or FV->CGLL; @@ -337,6 +333,9 @@ subroutine prep_lnd_init(infodata, atm_c2_lnd, rof_c2_lnd, glc_c2_lnd, iac_c2_ln endif #endif endif + tagname = trim(seq_flds_r2x_fields)//C_NULL_CHAR + tagtype = 1 ! dense + numco = 1 ! ierr = iMOAB_DefineTagStorage(mblxid, tagname, tagtype, numco, tagindex ) if (ierr .ne. 0) then write(logunit,*) subname,' error in defining tags for seq_flds_r2x_fields on lnd cpl' From 5a2167a2400235949df8377146e863b147f4ccb1 Mon Sep 17 00:00:00 2001 From: iulian07 Date: Mon, 13 Mar 2023 18:20:09 -0500 Subject: [PATCH 356/467] orderT needs to be set, not only orderS --- driver-moab/main/prep_rof_mod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/driver-moab/main/prep_rof_mod.F90 b/driver-moab/main/prep_rof_mod.F90 index 3c9e740883d9..2e5947dde43f 100644 --- a/driver-moab/main/prep_rof_mod.F90 +++ b/driver-moab/main/prep_rof_mod.F90 @@ -483,7 +483,7 @@ subroutine prep_rof_init(infodata, lnd_c2_rof, atm_c2_rof, ocn_c2_rof) endif dm2 = "fv"//C_NULL_CHAR dofnameT="GLOBAL_ID"//C_NULL_CHAR - orderS = 1 ! not much arguing + orderT = 1 ! not much arguing fNoBubble = 1 monotonicity = 0 ! noConserve = 0 From 92b17ec19d8bb00890a5781524f4cd20cdf31927 Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Tue, 21 Mar 2023 00:08:05 -0500 Subject: [PATCH 357/467] if tri-grid, compute graph for cells, not for vertices type of the component land mesh is either 2 (point cloud) or 3 (full cell) need to save that info, and use it for compute-commgraph --- components/elm/src/cpl/lnd_comp_mct.F90 | 2 ++ driver-moab/main/cplcomp_exchange_mod.F90 | 10 +++++++--- driver-moab/main/prep_ocn_mod.F90 | 2 +- driver-moab/shr/seq_comm_mct.F90 | 1 + 4 files changed, 11 insertions(+), 4 deletions(-) diff --git a/components/elm/src/cpl/lnd_comp_mct.F90 b/components/elm/src/cpl/lnd_comp_mct.F90 index 8048968aeb8b..06d61a6e8384 100644 --- a/components/elm/src/cpl/lnd_comp_mct.F90 +++ b/components/elm/src/cpl/lnd_comp_mct.F90 @@ -17,6 +17,7 @@ module lnd_comp_mct #ifdef HAVE_MOAB use seq_comm_mct, only: mlnid! id of moab land app + use seq_comm_mct, only: mb_land_mesh! true if land is full mesh use seq_comm_mct, only: num_moab_exports use seq_flds_mod , only : seq_flds_x2l_fields, seq_flds_l2x_fields @@ -350,6 +351,7 @@ subroutine lnd_init_mct( EClock, cdata_l, x2l_l, l2x_l, NLFilename ) atm_gnam=atm_gnam , & lnd_gnam=lnd_gnam ) if (trim(atm_gnam) /= trim(lnd_gnam)) samegrid_al = .false. + mb_land_mesh = .not. samegrid_al ! global variable, saved in seq_comm call init_land_moab(bounds, samegrid_al) sameg_al = samegrid_al ! will use it for export too #endif diff --git a/driver-moab/main/cplcomp_exchange_mod.F90 b/driver-moab/main/cplcomp_exchange_mod.F90 index 6258739db53f..ebfbe1a1efe5 100644 --- a/driver-moab/main/cplcomp_exchange_mod.F90 +++ b/driver-moab/main/cplcomp_exchange_mod.F90 @@ -24,6 +24,7 @@ module cplcomp_exchange_mod use seq_comm_mct, only : mhpgid ! iMOAB app id for atm pgx grid, on atm pes use seq_comm_mct, only : atm_pg_active ! flag if PG mesh instanced use seq_comm_mct, only : mlnid , mblxid ! iMOAB app id for land , on land pes and coupler pes + use seq_comm_mct, only : mb_land_mesh ! if true mesh for land use seq_comm_mct, only : mphaid ! iMOAB app id for phys atm; comp atm is 5, phys 5+200 use seq_comm_mct, only : MPSIID, mbixid ! sea-ice on comp pes and on coupler pes use seq_comm_mct, only : mrofid, mbrxid ! iMOAB id of moab rof app on comp pes and on coupler too @@ -991,7 +992,7 @@ subroutine cplcomp_moab_Init(infodata,comp) !----------------------------------------------------- ! use iMOAB, only: iMOAB_RegisterApplication, iMOAB_ReceiveMesh, iMOAB_SendMesh, & - iMOAB_WriteMesh, iMOAB_DefineTagStorage, iMOAB_GetMeshInfo, & + iMOAB_WriteMesh, iMOAB_DefineTagStorage, & iMOAB_SetIntTagStorage, iMOAB_FreeSenderBuffers, iMOAB_ComputeCommGraph, iMOAB_LoadMesh ! use component_mod, only: component_exch_moab ! @@ -1342,12 +1343,15 @@ subroutine cplcomp_moab_Init(infodata,comp) ! we are now on joint pes, compute comm graph between lnd and coupler model typeA = 2 ! point cloud on component PEs, land + if (mb_land_mesh) then + typeA = 3 + endif typeB = 3 ! full mesh on coupler pes, we just read it ierr = iMOAB_ComputeCommGraph( mlnid, mblxid, mpicom_join, mpigrp_old, mpigrp_cplid, & typeA, typeB, id_old, id_join) if (ierr .ne. 0) then - write(logunit,*) subname,' error in computing comm graph for rof model ' - call shr_sys_abort(subname//' ERROR in computing comm graph for rof model ') + write(logunit,*) subname,' error in computing comm graph for lnd model ' + call shr_sys_abort(subname//' ERROR in computing comm graph for lnd model ') endif endif diff --git a/driver-moab/main/prep_ocn_mod.F90 b/driver-moab/main/prep_ocn_mod.F90 index c39078bce344..d2c666086084 100644 --- a/driver-moab/main/prep_ocn_mod.F90 +++ b/driver-moab/main/prep_ocn_mod.F90 @@ -1092,7 +1092,7 @@ subroutine prep_ocn_mrg_moab(infodata, xao_ox) call seq_comm_setptrs(CPLID, iamroot=iamroot) ! find out the number of local elements in moab mesh ocean instance on coupler - ierr = iMOAB_GetMeshInfo ( mboxid, nvert, nvise, nbl, nsurf, nvisBC ); + ierr = iMOAB_GetMeshInfo ( mboxid, nvert, nvise, nbl, nsurf, nvisBC ) if (ierr .ne. 0) then write(logunit,*) subname,' error in getting info ' call shr_sys_abort(subname//' error in getting info ') diff --git a/driver-moab/shr/seq_comm_mct.F90 b/driver-moab/shr/seq_comm_mct.F90 index 90e4ea542a5f..5cddb78c1380 100644 --- a/driver-moab/shr/seq_comm_mct.F90 +++ b/driver-moab/shr/seq_comm_mct.F90 @@ -242,6 +242,7 @@ module seq_comm_mct 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 + logical, public :: mb_land_mesh = .false. ! whether the land uses full FV mesh or not ; made true if domain mesh is read on comp land integer, public :: num_moab_exports ! iMOAB id for atm phys grid, on atm pes From dd7523ff9c6e5f1b1e6df264317ba113385306a3 Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Tue, 21 Mar 2023 00:35:31 -0500 Subject: [PATCH 358/467] land mesh type --- components/elm/src/cpl/lnd_comp_mct.F90 | 1 + 1 file changed, 1 insertion(+) diff --git a/components/elm/src/cpl/lnd_comp_mct.F90 b/components/elm/src/cpl/lnd_comp_mct.F90 index 06d61a6e8384..61dd68b5e7ae 100644 --- a/components/elm/src/cpl/lnd_comp_mct.F90 +++ b/components/elm/src/cpl/lnd_comp_mct.F90 @@ -574,6 +574,7 @@ subroutine lnd_run_mct(EClock, cdata_l, x2l_l, l2x_l) call mct_list_init(temp_list ,seq_flds_x2l_fields) size_list=mct_list_nitem (temp_list) ent_type = 0 ! entity type is vertex for land, usually (bigrid case) + if (mb_land_mesh) ent_type = 1 if (rank2 .eq. 0) print *, num_moab_exports, trim(seq_flds_x2l_fields), ' lnd import check' do index_list = 1, size_list call mct_list_get(mctOStr,index_list,temp_list) From 3c332bef13735431dd238e58d7ed7686844d0982 Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Tue, 21 Mar 2023 08:58:58 -0500 Subject: [PATCH 359/467] need to initialize mpi group it gave an error only on bigmem, not on chrysalis --- driver-moab/main/prep_lnd_mod.F90 | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/driver-moab/main/prep_lnd_mod.F90 b/driver-moab/main/prep_lnd_mod.F90 index e8c688f374e0..8986e89a5277 100644 --- a/driver-moab/main/prep_lnd_mod.F90 +++ b/driver-moab/main/prep_lnd_mod.F90 @@ -151,7 +151,7 @@ subroutine prep_lnd_init(infodata, atm_c2_lnd, rof_c2_lnd, glc_c2_lnd, iac_c2_ln integer :: orderS, orderT, volumetric, noConserve, validate, fInverseDistanceMap integer :: fNoBubble, monotonicity ! will do comm graph over coupler PES, in 2-hop strategy - integer :: mpigrp_CPLID ! coupler pes group, used for comm graph phys <-> atm-ocn + integer :: mpigrp_CPLID ! coupler pes group, used for comm graph <-> atm-lnd, rof-lnd integer :: type1, type2 ! type for computing graph; should be the same type for ocean, 3 (FV) integer :: tagtype, numco, tagindex @@ -240,6 +240,7 @@ subroutine prep_lnd_init(infodata, atm_c2_lnd, rof_c2_lnd, glc_c2_lnd, iac_c2_ln ! we do not compute intersection, so we will have to just send data from lnd to rof and viceversa, by GLOBAL_ID matching ! so we compute just a comm graph, between lnd and rof dofs, on the coupler; target is rof ! land is full mesh + call seq_comm_getData(CPLID ,mpigrp=mpigrp_CPLID) type1 = 3; ! full mesh for lrofarnd now type2 = 3; ! fv for target land ierr = iMOAB_ComputeCommGraph( mbrxid, mblxid, mpicom_CPLID, mpigrp_CPLID, mpigrp_CPLID, type1, type2, & From 3df4de82675c9db2b3a0349ccfcd2b4dd7d0929e Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Wed, 22 Mar 2023 22:43:58 -0500 Subject: [PATCH 360/467] set ofrac on second ocean instance this is needed to calculate the fluxes projectionss from ocean to atm correctly --- driver-moab/main/seq_frac_mct.F90 | 24 ++++++++++++++++++++---- 1 file changed, 20 insertions(+), 4 deletions(-) diff --git a/driver-moab/main/seq_frac_mct.F90 b/driver-moab/main/seq_frac_mct.F90 index 77c540de9398..517f55e23e87 100644 --- a/driver-moab/main/seq_frac_mct.F90 +++ b/driver-moab/main/seq_frac_mct.F90 @@ -179,7 +179,7 @@ module seq_frac_mct use iMOAB, only : iMOAB_DefineTagStorage, iMOAB_SetDoubleTagStorage, & iMOAB_GetMeshInfo, iMOAB_SetDoubleTagStorageWithGid, iMOAB_WriteMesh, & iMOAB_ApplyScalarProjectionWeights, iMOAB_SendElementTag, iMOAB_ReceiveElementTag, & - iMOAB_FreeSenderBuffers + iMOAB_FreeSenderBuffers, iMOAB_GetDoubleTagStorage use shr_kind_mod, only: CL => SHR_KIND_CL, CX => SHR_KIND_CX, CXX => SHR_KIND_CXX use iso_c_binding ! C_NULL_CHAR @@ -206,6 +206,8 @@ module seq_frac_mct logical, private :: seq_frac_abort = .true. logical, private :: seq_frac_dead + integer :: local_size_mb_ocn ! use it to set/get ofrac from ocn to second ocean instance + !--- standard --- real(r8),parameter :: eps_fracsum = 1.0e-02 ! allowed error in sum of fracs real(r8),parameter :: eps_fracval = 1.0e-02 ! allowed error in any frac +- 0,1 @@ -326,6 +328,7 @@ subroutine seq_frac_init( infodata, & integer :: mpicom ! we are on coupler PES here character(30) :: outfile, wopts + !----- formats ----- character(*),parameter :: subName = '(seq_frac_init) ' @@ -626,6 +629,7 @@ subroutine seq_frac_init( infodata, & endif ierr = iMOAB_GetMeshInfo ( mboxid, nvert, nvise, nbl, nsurf, nvisBC ); arrSize = 5 * nvise(1) ! there are 5 tags 'afrac:ifrac:ofrac:ifrad:ofrad' + local_size_mb_ocn = nvise(1) allocate(tagValues(arrSize) ) ent_type = 1 ! cell type, ocn is FV tagValues = 0. @@ -638,6 +642,13 @@ subroutine seq_frac_init( infodata, & mapper_i2o => prep_ocn_get_mapper_SFi2o() call seq_map_map(mapper_i2o,fractions_i,fractions_o,fldlist='ofrac',norm=.false.) + tagname = 'ofrac'//C_NULL_CHAR + ent_type = 1! cells + allocate(tagValues(local_size_mb_ocn) ) + ierr = iMOAB_GetDoubleTagStorage ( mboxid, tagname, local_size_mb_ocn , ent_type, tagValues) + ierr = iMOAB_SetDoubleTagStorage ( mbofxid, tagname, local_size_mb_ocn , ent_type, tagValues) + deallocate(tagValues) + else ! still need to TODO moab case when no sea ice ko = mct_aVect_indexRa(fractions_o,"ofrac",perrWith=subName) @@ -807,7 +818,6 @@ end subroutine seq_frac_init subroutine seq_frac_set(infodata, ice, ocn, fractions_a, fractions_i, fractions_o) use seq_comm_mct, only : mboxid ! iMOAB app id for ocn on cpl pes - use iMOAB, only : iMOAB_SetDoubleTagStorageWithGid ! !INPUT/OUTPUT PARAMETERS: type(seq_infodata_type) , intent(in) :: infodata @@ -835,6 +845,7 @@ subroutine seq_frac_set(infodata, ice, ocn, fractions_a, fractions_i, fractions_ integer , save :: lSize, ent_type character(CXX) :: tagname real(r8), allocatable, save :: tagValues(:) ! used for setting some tags + real(r8), allocatable, save :: tagValuesOfrac(:) ! used for setting some tags integer , allocatable, save :: GlobalIds(:) ! used for setting values associated with ids !----- formats ----- @@ -879,7 +890,9 @@ subroutine seq_frac_set(infodata, ice, ocn, fractions_a, fractions_i, fractions_ allocate(GlobalIds(lSize) ) kgg = mct_aVect_indexIA(dom_o%data ,"GlobGridNum" ,perrWith=subName) GlobalIds = dom_i%data%iAttr(kgg,:) + allocate (tagValuesOfrac(local_size_mb_ocn)) ent_type = 1 ! cells for mpas sea ice + first_time = .false. endif ! something like this: @@ -902,8 +915,6 @@ subroutine seq_frac_set(infodata, ice, ocn, fractions_a, fractions_i, fractions_ write(logunit,*) subname,' error in setting ofrac on ice moab instance ' call shr_sys_abort(subname//' ERROR in setting ofrac on ice moab instance ') endif - - first_time = .false. endif if (ocn_present) then @@ -911,6 +922,11 @@ subroutine seq_frac_set(infodata, ice, ocn, fractions_a, fractions_i, fractions_ call seq_map_map(mapper_i2o, fractions_i, fractions_o, & fldlist='ofrac:ifrac',norm=.false.) call seq_frac_check(fractions_o, 'ocn set') + ! set the ofrac artificially on mbofxid instance, because it is needed for prep_aoxflux + tagname = 'ofrac'//C_NULL_CHAR + ent_type = 1! cells + ierr = iMOAB_GetDoubleTagStorage ( mboxid, tagname, local_size_mb_ocn , ent_type, tagValuesOfrac) + ierr = iMOAB_SetDoubleTagStorage ( mbofxid, tagname, local_size_mb_ocn , ent_type, tagValuesOfrac) endif From 33dcd43c2915b3619ae3500ccc317e4afd6a4bc3 Mon Sep 17 00:00:00 2001 From: Jason Sarich Date: Thu, 23 Mar 2023 11:58:07 -0500 Subject: [PATCH 361/467] add cime change for using existing kokkos build --- cime | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/cime b/cime index 48268c97b5df..7f1a08a6c254 160000 --- a/cime +++ b/cime @@ -1 +1 @@ -Subproject commit 48268c97b5df522b0c7c007cb79aa5b0be845bfe +Subproject commit 7f1a08a6c2546c6343962884461ee0b524e18e18 From 0dae013a0d0c90cb4c91b5f3a0a3ab9000872c5a Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Fri, 24 Mar 2023 15:25:43 -0500 Subject: [PATCH 362/467] project directly on unit sphere mpas mesh --- .../mpas-framework/src/framework/mpas_moabmesh.F | 16 +++++++++------- 1 file changed, 9 insertions(+), 7 deletions(-) diff --git a/components/mpas-framework/src/framework/mpas_moabmesh.F b/components/mpas-framework/src/framework/mpas_moabmesh.F index ac17c88f5cd8..9339004f1966 100644 --- a/components/mpas-framework/src/framework/mpas_moabmesh.F +++ b/components/mpas-framework/src/framework/mpas_moabmesh.F @@ -138,9 +138,9 @@ subroutine mpas_moab_instance(domain, ext_comp_id, pidmoab) enddo allocate(moab_vert_coords(3*currentVertex)) do i1 =1, currentVertex - moab_vert_coords(3*i1-2) = xVertex(invMap(i1)) - moab_vert_coords(3*i1-1) = yVertex(invMap(i1)) - moab_vert_coords(3*i1 ) = zVertex(invMap(i1)) + moab_vert_coords(3*i1-2) = xVertex(invMap(i1))/sphere_radius + moab_vert_coords(3*i1-1) = yVertex(invMap(i1))/sphere_radius + moab_vert_coords(3*i1 ) = zVertex(invMap(i1))/sphere_radius ! call mpas_log_write('i:: $i coords:: $r $r $r $r', intArgs=(/i1/), realArgs=(/moab_vert_coords(3*i1-2),moab_vert_coords(3*i1-1), moab_vert_coords(3*i1)/) ) enddo dimcoord = 3*currentVertex @@ -199,10 +199,12 @@ subroutine mpas_moab_instance(domain, ext_comp_id, pidmoab) if (ierr > 0 ) & call errorout(ierr,'Error: fail to set area tag ') - tagname='aream'//C_NULL_CHAR - ierr = iMOAB_SetDoubleTagStorage ( pid, tagname, nCellsSolve , ent_type, data) - if (ierr > 0 ) & - call errorout(ierr,'Error: fail to set aream tag ') + ! set it to the same area, but change it eventually with the area from mapping routing (tempestremap for MOAB) + ! comment it + ! tagname='aream'//C_NULL_CHAR + ! ierr = iMOAB_SetDoubleTagStorage ( pid, tagname, nCellsSolve , ent_type, data) + ! if (ierr > 0 ) & + ! call errorout(ierr,'Error: fail to set aream tag ') deallocate (moab_vert_coords) deallocate (data) From 208aea7f67ab46da5547117ff25301e6510e7293 Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Fri, 24 Mar 2023 17:13:21 -0500 Subject: [PATCH 363/467] comment out aream on comp side we will have to send it properly --- components/eam/src/cpl/atm_comp_mct.F90 | 9 +++++---- components/elm/src/cpl/lnd_comp_mct.F90 | 12 ++++++------ components/mosart/src/cpl/rof_comp_mct.F90 | 6 +++--- 3 files changed, 14 insertions(+), 13 deletions(-) diff --git a/components/eam/src/cpl/atm_comp_mct.F90 b/components/eam/src/cpl/atm_comp_mct.F90 index 66299c224038..30b1f4814946 100644 --- a/components/eam/src/cpl/atm_comp_mct.F90 +++ b/components/eam/src/cpl/atm_comp_mct.F90 @@ -1255,10 +1255,11 @@ subroutine initialize_moab_atm_phys( cdata_a ) if (ierr > 0 ) & call endrun('Error: fail to set area tag ') - tagname='aream'//C_NULL_CHAR - ierr = iMOAB_SetDoubleTagStorage ( mphaid, tagname, nlcols , ent_type, areavals) - if (ierr > 0 ) & - call endrun('Error: fail to set aream tag ') + ! comment this out now + ! tagname='aream'//C_NULL_CHAR + ! ierr = iMOAB_SetDoubleTagStorage ( mphaid, tagname, nlcols , ent_type, areavals) + ! if (ierr > 0 ) & + ! call endrun('Error: fail to set aream tag ') areavals = 1._r8 ! double tagname='mask'//C_NULL_CHAR diff --git a/components/elm/src/cpl/lnd_comp_mct.F90 b/components/elm/src/cpl/lnd_comp_mct.F90 index 61dd68b5e7ae..fff3ab348765 100644 --- a/components/elm/src/cpl/lnd_comp_mct.F90 +++ b/components/elm/src/cpl/lnd_comp_mct.F90 @@ -994,9 +994,9 @@ subroutine init_land_moab(bounds, samegrid_al) ierr = iMOAB_DefineTagStorage(mlnid, tagname, tagtype, numco, tagindex ) if (ierr > 0 ) & call endrun('Error: fail to create aream tag ') - ierr = iMOAB_SetDoubleTagStorage ( mlnid, tagname, lsz , ent_type, moab_vert_coords ) - if (ierr > 0 ) & - call endrun('Error: fail to set aream tag ') + ! ierr = iMOAB_SetDoubleTagStorage ( mlnid, tagname, lsz , ent_type, moab_vert_coords ) + ! if (ierr > 0 ) & + ! call endrun('Error: fail to set aream tag ') deallocate(moabconn) ! use merge vertices new imoab method to fix cells @@ -1095,9 +1095,9 @@ subroutine init_land_moab(bounds, samegrid_al) ierr = iMOAB_DefineTagStorage(mlnid, tagname, tagtype, numco, tagindex ) if (ierr > 0 ) & call endrun('Error: fail to create aream tag ') - ierr = iMOAB_SetDoubleTagStorage ( mlnid, tagname, lsz , ent_type, moab_vert_coords ) - if (ierr > 0 ) & - call endrun('Error: fail to set aream tag ') + ! ierr = iMOAB_SetDoubleTagStorage ( mlnid, tagname, lsz , ent_type, moab_vert_coords ) + ! if (ierr > 0 ) & + ! call endrun('Error: fail to set aream tag ') ierr = iMOAB_UpdateMeshInfo( mlnid ) if (ierr > 0 ) & call endrun('Error: fail to update mesh info ') diff --git a/components/mosart/src/cpl/rof_comp_mct.F90 b/components/mosart/src/cpl/rof_comp_mct.F90 index a2f02582b5e2..acf5481eb543 100644 --- a/components/mosart/src/cpl/rof_comp_mct.F90 +++ b/components/mosart/src/cpl/rof_comp_mct.F90 @@ -1031,9 +1031,9 @@ subroutine init_rof_moab() tagname='aream'//C_NULL_CHAR - ierr = iMOAB_SetDoubleTagStorage ( mrofid, tagname, lsz , ent_type, coords) - if (ierr > 0 ) & - call shr_sys_abort(sub//' Error: fail to set aream tag ') + ! ierr = iMOAB_SetDoubleTagStorage ( mrofid, tagname, lsz , ent_type, coords) + ! if (ierr > 0 ) & + ! call shr_sys_abort(sub//' Error: fail to set aream tag ') ierr = iMOAB_UpdateMeshInfo ( mrofid ) if (ierr > 0 ) & From 26538e687d49c3f1497ef08e3d6276a508cb8241 Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Fri, 31 Mar 2023 13:39:31 -0500 Subject: [PATCH 364/467] compute area correction factors, and store them --- driver-moab/main/cime_comp_mod.F90 | 19 +++- driver-moab/main/component_mod.F90 | 141 +++++++++++++++++++++++++++++ 2 files changed, 155 insertions(+), 5 deletions(-) diff --git a/driver-moab/main/cime_comp_mod.F90 b/driver-moab/main/cime_comp_mod.F90 index 63ed6ce52124..17e74b3141a3 100644 --- a/driver-moab/main/cime_comp_mod.F90 +++ b/driver-moab/main/cime_comp_mod.F90 @@ -171,6 +171,9 @@ module cime_comp_mod use component_mod, only: component_init_cc, component_init_cx use component_mod, only: component_run, component_final use component_mod, only: component_init_areacor, component_init_aream +#ifdef HAVE_MOAB + use component_mod, only: component_init_areacor_moab +#endif use component_mod, only: component_exch, component_diag use component_mod, only: component_exch_moab @@ -2155,23 +2158,29 @@ subroutine cime_init() call mpi_barrier(mpicom_GLOID,ierr) if (atm_present) call component_init_areacor(atm, areafact_samegrid, seq_flds_a2x_fluxes) ! send initial data to coupler - if (atm_present) call component_exch_moab(atm(1), mphaid, mbaxid, 0, seq_flds_a2x_fields) + if (atm_present) call component_init_areacor_moab(atm, mphaid, mbaxid, 0, seq_flds_a2x_fluxes, seq_flds_a2x_fields) + ! component_exch_moab(atm(1), mphaid, mbaxid, 0, seq_flds_a2x_fields) call mpi_barrier(mpicom_GLOID,ierr) if (lnd_present) call component_init_areacor(lnd, areafact_samegrid, seq_flds_l2x_fluxes) - if (lnd_present) call component_exch_moab(lnd(1), mlnid, mblxid, 0, seq_flds_l2x_fields) + ! MOABTODO : lnd is vertex or cell ? + if (lnd_present) call component_init_areacor_moab(lnd, mlnid, mblxid, 0, seq_flds_l2x_fluxes, seq_flds_l2x_fields) + !component_exch_moab(lnd(1), mlnid, mblxid, 0, seq_flds_l2x_fields) call mpi_barrier(mpicom_GLOID,ierr) if (rof_present) call component_init_areacor(rof, areafact_samegrid, seq_flds_r2x_fluxes) - if (rof_present) call component_exch_moab(rof(1), mrofid, mbrxid, 0, seq_flds_r2x_fields) + if (rof_present) call component_init_areacor_moab(rof, mrofid, mbrxid, 0, seq_flds_r2x_fluxes, seq_flds_r2x_fields) + !component_exch_moab(rof(1), mrofid, mbrxid, 0, seq_flds_r2x_fields) call mpi_barrier(mpicom_GLOID,ierr) if (ocn_present) call component_init_areacor(ocn, areafact_samegrid, seq_flds_o2x_fluxes) - if (ocn_present) call component_exch_moab(ocn(1), mpoid, mboxid, 0, seq_flds_o2x_fields) + if (ocn_present) call component_init_areacor_moab(ocn, mpoid, mboxid, 1, seq_flds_o2x_fluxes, seq_flds_o2x_fields) + ! component_exch_moab(ocn(1), mpoid, mboxid, 0, seq_flds_o2x_fields) call mpi_barrier(mpicom_GLOID,ierr) if (ice_present) call component_init_areacor(ice, areafact_samegrid, seq_flds_i2x_fluxes) - if (ice_present) call component_exch_moab(ice(1), mpsiid, mbixid, 0, seq_flds_i2x_fields) + if (ice_present) call component_init_areacor_moab(ice, mpsiid, mbixid,1, seq_flds_i2x_fluxes, seq_flds_i2x_fields) + !component_exch_moab(ice(1), mpsiid, mbixid, 0, seq_flds_i2x_fields) call mpi_barrier(mpicom_GLOID,ierr) if (glc_present) call component_init_areacor(glc, areafact_samegrid, seq_flds_g2x_fluxes) diff --git a/driver-moab/main/component_mod.F90 b/driver-moab/main/component_mod.F90 index 48fafd970134..e4af73178d6f 100644 --- a/driver-moab/main/component_mod.F90 +++ b/driver-moab/main/component_mod.F90 @@ -48,6 +48,9 @@ module component_mod public :: component_init_cx public :: component_init_aream public :: component_init_areacor +#ifdef HAVE_MOAB + public :: component_init_areacor_moab +#endif public :: component_run ! mct and esmf versions public :: component_final ! mct and esmf versions public :: component_exch @@ -649,6 +652,144 @@ subroutine component_init_areacor(comp, samegrid, seq_flds_c2x_fluxes) end subroutine component_init_areacor +subroutine component_init_areacor_moab (comp, mbccid, mbcxid, ent_type, seq_flds_c2x_fluxes, seq_flds_c2x_fields) + !--------------------------------------------------------------- + ! COMPONENT PES and CPL/COMPONENT (for exchange only) + ! + ! Uses + use seq_domain_mct, only : seq_domain_areafactinit + use ISO_C_BINDING, only : C_NULL_CHAR + use shr_kind_mod , only : CXX => shr_kind_CXX + use iMOAB, only: iMOAB_DefineTagStorage, iMOAB_GetMeshInfo, iMOAB_GetDoubleTagStorage, & + iMOAB_SetDoubleTagStorage + ! + ! Arguments + type(component_type) , intent(inout) :: comp(:) + integer , intent(in) :: mbccid ! comp side + integer , intent(in) :: mbcxid ! coupler side + ! point cloud or FV type, to use vertices or cells for setting/getting the area tags and corrections + integer , intent(in) :: ent_type ! 0 for vertex, 1 for cell + character(len=*) , intent(in) :: seq_flds_c2x_fluxes, seq_flds_c2x_fields + ! + ! Local Variables + integer :: eci, num_inst + integer :: mpi_tag + character(*), parameter :: subname = '(component_init_areacor_moab)' + character(CXX) :: tagname + integer :: tagtype, numco, tagindex, lsize, i, j, arrsize, ierr, nfields + real (kind=r8) , allocatable :: areas (:,:), factors(:,:), vals(:,:) ! 2 tags values, area, aream, + real (kind=r8) :: rarea, raream, rmask, fact + integer nvert(3), nvise(3), nbl(3), nsurf(3), nvisBC(3) + type(mct_list) :: temp_list ! used to count number of fields + !--------------------------------------------------------------- + + if (comp(1)%iamin_cplcompid) then + tagname='aream'//C_NULL_CHAR + ! bring on the comp side the aream from maps + ! (it is either computed by mapping routine or read from mapping files) + call component_exch_moab(comp(1), mbcxid, mbccid, 1, tagname) + + ! For only component pes + if (comp(1)%iamin_compid) then + + ! Allocate and initialize area correction factors on component processes + ! get areas, first allocate memory + ierr = iMOAB_GetMeshInfo ( mbccid, nvert, nvise, nbl, nsurf, nvisBC ) + if (ierr .ne. 0) then + call shr_sys_abort(subname//' cannot get mesh info ') + endif + if (ent_type .eq. 0) then + lsize = nvert(1) + else + lsize = nvise(1) ! cell type + endif + allocate(areas (lsize, 3)) ! lsize is along grid; read mask too + allocate(factors (lsize, 2)) + ! get areas + tagname='area:aream:mask'//C_NULL_CHAR + arrsize = 3 * lsize + ierr = iMOAB_GetDoubleTagStorage ( mbccid, tagname, arrsize , ent_type, areas(1,1) ) + if (ierr .ne. 0) then + call shr_sys_abort(subname//' cannot get areas ') + endif + ! now compute the factors + do i=1,lsize + rmask = areas(i,3) + + rarea = areas(i, 1) + raream = areas(i, 2) + if ( abs(rmask) >= 1.0e-06) then + if (rarea * raream /= 0.0_R8) then + factors(i,1) = rarea/raream + factors(i,2)= 1.0_R8/factors(i,1) + else + write(logunit,*) trim(subname),' ERROR area,aream= ', & + rarea,raream,' in ',i,lsize + call shr_sys_flush(logunit) + call shr_sys_abort() + endif + endif + enddo + ! set factors as tags + ! define the tags mdl2drv and drv2mdl on component sides, and compute them based on area and aream + tagname = 'mdl2drv:drv2mdl'//C_NULL_CHAR + tagtype = 1 + numco = 1 + ierr = iMOAB_DefineTagStorage(mbccid, tagname, tagtype, numco, tagindex ) + if (ierr .ne. 0) then + call shr_sys_abort(subname//' cannot define correction tags') + endif + arrsize = 2 * lsize + ierr = iMOAB_SetDoubleTagStorage( mbccid, tagname, arrsize , ent_type, factors(1,1)) + if (ierr .ne. 0) then + call shr_sys_abort(subname//' cannot set correction area factors ') + endif + + ! Area correct component initialization output fields + ! need to multiply fluxes (correct them) with mdl2drv (factors(i,1)) + ! so get all fluxes (tags) multiply with factor(i,1), according to mask + + call mct_list_init(temp_list, seq_flds_c2x_fluxes) + nfields=mct_list_nitem (temp_list) + call mct_list_clean(temp_list) + + + allocate(vals(lsize, nfields)) + tagname = trim(seq_flds_c2x_fluxes)//C_NULL_CHAR + arrsize = lsize * nfields + ierr = iMOAB_GetDoubleTagStorage( mbccid, tagname, arrsize , ent_type, vals(1,1)) + if (ierr .ne. 0) then + call shr_sys_abort(subname//' cannot get flux values ') + endif + ! multiply them with the factors(i,1) + do i=1,lsize + rmask = areas(i,3) + if ( abs(rmask) >= 1.0e-06) then + fact = factors(i,1) ! mdl2drv tag + do j=1,nfields + vals(i,j) = fact*vals(i,j) + enddo + endif + enddo + ierr = iMOAB_SetDoubleTagStorage( mbccid, tagname, arrsize , ent_type, vals(1,1)) + if (ierr .ne. 0) then + call shr_sys_abort(subname//' cannot set new flux values ') + endif + + ! call mct_avect_vecmult(comp(eci)%c2x_cc, comp(eci)%mdl2drv, seq_flds_c2x_fluxes, mask_spval=.true.) + ! send to coupler corrected values + + ! call seq_map_map(comp(eci)%mapper_cc2x, comp(eci)%c2x_cc, comp(eci)%c2x_cx, msgtag=mpi_tag) + deallocate(factors) + deallocate(areas) + deallocate(vals) + + endif + ! send data to coupler exchange ? everything, not only fluxes ? + call component_exch_moab(comp(1), mbccid, mbcxid, 0, seq_flds_c2x_fields) + endif + + end subroutine component_init_areacor_moab !=============================================================================== subroutine component_run(Eclock, comp, comp_run, infodata, & From ee617fc3cb44c119d815b683a79b41b8c7297463 Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Fri, 31 Mar 2023 17:44:51 -0500 Subject: [PATCH 365/467] add factor method for area corrections need to define on moab comp type the appID, lsize, and grid type the method has to be general, to factor with mdl2drv or drv2mdl the fluxes --- driver-moab/main/cime_comp_mod.F90 | 10 +- driver-moab/main/component_mod.F90 | 85 +++++++++++--- driver-moab/main/component_type_mod.F90 | 5 + driver-moab/main/cplcomp_exchange_mod.F90 | 134 ++++++++++++++-------- 4 files changed, 161 insertions(+), 73 deletions(-) diff --git a/driver-moab/main/cime_comp_mod.F90 b/driver-moab/main/cime_comp_mod.F90 index 17e74b3141a3..c111d681a0cf 100644 --- a/driver-moab/main/cime_comp_mod.F90 +++ b/driver-moab/main/cime_comp_mod.F90 @@ -2158,28 +2158,28 @@ subroutine cime_init() call mpi_barrier(mpicom_GLOID,ierr) if (atm_present) call component_init_areacor(atm, areafact_samegrid, seq_flds_a2x_fluxes) ! send initial data to coupler - if (atm_present) call component_init_areacor_moab(atm, mphaid, mbaxid, 0, seq_flds_a2x_fluxes, seq_flds_a2x_fields) + if (atm_present) call component_init_areacor_moab(atm, mphaid, mbaxid, seq_flds_a2x_fluxes, seq_flds_a2x_fields) ! component_exch_moab(atm(1), mphaid, mbaxid, 0, seq_flds_a2x_fields) call mpi_barrier(mpicom_GLOID,ierr) if (lnd_present) call component_init_areacor(lnd, areafact_samegrid, seq_flds_l2x_fluxes) ! MOABTODO : lnd is vertex or cell ? - if (lnd_present) call component_init_areacor_moab(lnd, mlnid, mblxid, 0, seq_flds_l2x_fluxes, seq_flds_l2x_fields) + if (lnd_present) call component_init_areacor_moab(lnd, mlnid, mblxid, seq_flds_l2x_fluxes, seq_flds_l2x_fields) !component_exch_moab(lnd(1), mlnid, mblxid, 0, seq_flds_l2x_fields) call mpi_barrier(mpicom_GLOID,ierr) if (rof_present) call component_init_areacor(rof, areafact_samegrid, seq_flds_r2x_fluxes) - if (rof_present) call component_init_areacor_moab(rof, mrofid, mbrxid, 0, seq_flds_r2x_fluxes, seq_flds_r2x_fields) + if (rof_present) call component_init_areacor_moab(rof, mrofid, mbrxid, seq_flds_r2x_fluxes, seq_flds_r2x_fields) !component_exch_moab(rof(1), mrofid, mbrxid, 0, seq_flds_r2x_fields) call mpi_barrier(mpicom_GLOID,ierr) if (ocn_present) call component_init_areacor(ocn, areafact_samegrid, seq_flds_o2x_fluxes) - if (ocn_present) call component_init_areacor_moab(ocn, mpoid, mboxid, 1, seq_flds_o2x_fluxes, seq_flds_o2x_fields) + if (ocn_present) call component_init_areacor_moab(ocn, mpoid, mboxid, seq_flds_o2x_fluxes, seq_flds_o2x_fields) ! component_exch_moab(ocn(1), mpoid, mboxid, 0, seq_flds_o2x_fields) call mpi_barrier(mpicom_GLOID,ierr) if (ice_present) call component_init_areacor(ice, areafact_samegrid, seq_flds_i2x_fluxes) - if (ice_present) call component_init_areacor_moab(ice, mpsiid, mbixid,1, seq_flds_i2x_fluxes, seq_flds_i2x_fields) + if (ice_present) call component_init_areacor_moab(ice, mpsiid, mbixid, seq_flds_i2x_fluxes, seq_flds_i2x_fields) !component_exch_moab(ice(1), mpsiid, mbixid, 0, seq_flds_i2x_fields) call mpi_barrier(mpicom_GLOID,ierr) diff --git a/driver-moab/main/component_mod.F90 b/driver-moab/main/component_mod.F90 index e4af73178d6f..203034b1bb98 100644 --- a/driver-moab/main/component_mod.F90 +++ b/driver-moab/main/component_mod.F90 @@ -652,7 +652,7 @@ subroutine component_init_areacor(comp, samegrid, seq_flds_c2x_fluxes) end subroutine component_init_areacor -subroutine component_init_areacor_moab (comp, mbccid, mbcxid, ent_type, seq_flds_c2x_fluxes, seq_flds_c2x_fields) +subroutine component_init_areacor_moab (comp, mbccid, mbcxid, seq_flds_c2x_fluxes, seq_flds_c2x_fields) !--------------------------------------------------------------- ! COMPONENT PES and CPL/COMPONENT (for exchange only) ! @@ -660,7 +660,7 @@ subroutine component_init_areacor_moab (comp, mbccid, mbcxid, ent_type, seq_flds use seq_domain_mct, only : seq_domain_areafactinit use ISO_C_BINDING, only : C_NULL_CHAR use shr_kind_mod , only : CXX => shr_kind_CXX - use iMOAB, only: iMOAB_DefineTagStorage, iMOAB_GetMeshInfo, iMOAB_GetDoubleTagStorage, & + use iMOAB, only: iMOAB_DefineTagStorage, iMOAB_GetDoubleTagStorage, & iMOAB_SetDoubleTagStorage ! ! Arguments @@ -668,7 +668,6 @@ subroutine component_init_areacor_moab (comp, mbccid, mbcxid, ent_type, seq_flds integer , intent(in) :: mbccid ! comp side integer , intent(in) :: mbcxid ! coupler side ! point cloud or FV type, to use vertices or cells for setting/getting the area tags and corrections - integer , intent(in) :: ent_type ! 0 for vertex, 1 for cell character(len=*) , intent(in) :: seq_flds_c2x_fluxes, seq_flds_c2x_fields ! ! Local Variables @@ -691,24 +690,15 @@ subroutine component_init_areacor_moab (comp, mbccid, mbcxid, ent_type, seq_flds ! For only component pes if (comp(1)%iamin_compid) then - ! Allocate and initialize area correction factors on component processes - ! get areas, first allocate memory - ierr = iMOAB_GetMeshInfo ( mbccid, nvert, nvise, nbl, nsurf, nvisBC ) - if (ierr .ne. 0) then - call shr_sys_abort(subname//' cannot get mesh info ') - endif - if (ent_type .eq. 0) then - lsize = nvert(1) - else - lsize = nvise(1) ! cell type - endif + ! get areas, first allocate memory + lsize = comp(1)%mblsize allocate(areas (lsize, 3)) ! lsize is along grid; read mask too allocate(factors (lsize, 2)) ! get areas tagname='area:aream:mask'//C_NULL_CHAR arrsize = 3 * lsize - ierr = iMOAB_GetDoubleTagStorage ( mbccid, tagname, arrsize , ent_type, areas(1,1) ) + ierr = iMOAB_GetDoubleTagStorage ( mbccid, tagname, arrsize , comp(1)%mbGridType, areas(1,1) ) if (ierr .ne. 0) then call shr_sys_abort(subname//' cannot get areas ') endif @@ -740,7 +730,7 @@ subroutine component_init_areacor_moab (comp, mbccid, mbcxid, ent_type, seq_flds call shr_sys_abort(subname//' cannot define correction tags') endif arrsize = 2 * lsize - ierr = iMOAB_SetDoubleTagStorage( mbccid, tagname, arrsize , ent_type, factors(1,1)) + ierr = iMOAB_SetDoubleTagStorage( mbccid, tagname, arrsize , comp(1)%mbGridType, factors(1,1)) if (ierr .ne. 0) then call shr_sys_abort(subname//' cannot set correction area factors ') endif @@ -757,7 +747,7 @@ subroutine component_init_areacor_moab (comp, mbccid, mbcxid, ent_type, seq_flds allocate(vals(lsize, nfields)) tagname = trim(seq_flds_c2x_fluxes)//C_NULL_CHAR arrsize = lsize * nfields - ierr = iMOAB_GetDoubleTagStorage( mbccid, tagname, arrsize , ent_type, vals(1,1)) + ierr = iMOAB_GetDoubleTagStorage( mbccid, tagname, arrsize , comp(1)%mbGridType, vals(1,1)) if (ierr .ne. 0) then call shr_sys_abort(subname//' cannot get flux values ') endif @@ -771,7 +761,7 @@ subroutine component_init_areacor_moab (comp, mbccid, mbcxid, ent_type, seq_flds enddo endif enddo - ierr = iMOAB_SetDoubleTagStorage( mbccid, tagname, arrsize , ent_type, vals(1,1)) + ierr = iMOAB_SetDoubleTagStorage( mbccid, tagname, arrsize , comp(1)%mbGridType, vals(1,1)) if (ierr .ne. 0) then call shr_sys_abort(subname//' cannot set new flux values ') endif @@ -901,6 +891,9 @@ end subroutine comp_run if (comp_prognostic .and. firstloop .and. present(seq_flds_x2c_fluxes)) then call mct_avect_vecmult(comp(eci)%x2c_cc, comp(eci)%drv2mdl, seq_flds_x2c_fluxes, mask_spval=.true.) +#ifdef HAVE_MOAB + call factor_moab_comp(comp(eci), 'drv2mdl', seq_flds_x2c_fluxes) +#endif end if call t_set_prefixf(comp(1)%oneletterid//":") @@ -914,6 +907,9 @@ end subroutine comp_run if ((phase == 1) .and. present(seq_flds_c2x_fluxes)) then call mct_avect_vecmult(comp(eci)%c2x_cc, comp(eci)%mdl2drv, seq_flds_c2x_fluxes, mask_spval=.true.) +#ifdef HAVE_MOAB + call factor_moab_comp(comp(eci), 'mdl2drv', seq_flds_c2x_fluxes) +#endif endif if (drv_threading) call seq_comm_setnthreads(nthreads_GLOID) @@ -1220,4 +1216,57 @@ subroutine component_exch_moab(comp, mbAPPid1, mbAppid2, direction, fields ) #endif end subroutine component_exch_moab + + subroutine factor_moab_comp(comp, type, seq_flds_fluxes) + use ISO_C_BINDING, only : C_NULL_CHAR + use shr_kind_mod , only : CXX => shr_kind_CXX + use iMOAB , only: iMOAB_GetDoubleTagStorage, iMOAB_SetDoubleTagStorage + + type(component_type) , intent(inout) :: comp + character(len=*) , intent(in) :: type + character(len=*) , intent(in) :: seq_flds_fluxes + + character(CXX) :: tagname + type(mct_list) :: temp_list ! used to count number of fields + integer :: nfields, arrsize, ierr, i, j + real (kind=r8) , allocatable :: vals(:,:) ! tags values to be multiplied + real (kind=r8) , allocatable :: factors(:) + character(*), parameter :: subname = '(factor_moab_comp)' + + + call mct_list_init(temp_list, seq_flds_fluxes) + nfields=mct_list_nitem (temp_list) + call mct_list_clean(temp_list) + + allocate(vals(comp%mblsize, nfields)) + allocate(factors(comp%mblsize)) + ! get factors + tagname = trim(type)//C_NULL_CHAR + arrsize = comp%mblsize + ierr = iMOAB_GetDoubleTagStorage( comp%mbApCCid, tagname, arrsize , comp%mbGridType, factors(1)) + if (ierr .ne. 0) then + call shr_sys_abort(subname//' cannot get factors ' //trim(type)) + endif + ! get vals, multiply, then reset them again + tagname = trim(seq_flds_fluxes)//C_NULL_CHAR + arrsize = comp%mblsize * nfields + ierr = iMOAB_GetDoubleTagStorage( comp%mbApCCid, tagname, arrsize , comp%mbGridType, vals(1,1)) + if (ierr .ne. 0) then + call shr_sys_abort(subname//' cannot get fluxes ' //trim(type)) + endif + do i=1,comp%mblsize + do j=1,nfields + vals(i,j) = factors(i) * vals(i,j) + enddo + enddo + + ierr = iMOAB_SetDoubleTagStorage( comp%mbApCCid, tagname, arrsize , comp%mbGridType, vals(1,1)) + if (ierr .ne. 0) then + call shr_sys_abort(subname//' cannot set fluxes back ' //trim(type)) + endif + + deallocate(vals) + deallocate(factors) + + end subroutine factor_moab_comp end module component_mod diff --git a/driver-moab/main/component_type_mod.F90 b/driver-moab/main/component_type_mod.F90 index af3db296a34d..8407ac2b05d8 100644 --- a/driver-moab/main/component_type_mod.F90 +++ b/driver-moab/main/component_type_mod.F90 @@ -78,6 +78,11 @@ module component_type_mod type(mct_aVect) , pointer :: c2x_cc => null() real(r8) , pointer :: drv2mdl(:) => null() ! area correction factors real(r8) , pointer :: mdl2drv(:) => null() ! area correction factors +#ifdef HAVE_MOAB + integer :: mbApCCid ! moab app id on component side + integer :: mbGridType ! 0 for PC, 1 for cell (ocean, ice) + integer :: mblsize ! size of local arrays +#endif ! ! Union of coupler/component pes - used by exchange routines ! diff --git a/driver-moab/main/cplcomp_exchange_mod.F90 b/driver-moab/main/cplcomp_exchange_mod.F90 index ebfbe1a1efe5..05f8856653a3 100644 --- a/driver-moab/main/cplcomp_exchange_mod.F90 +++ b/driver-moab/main/cplcomp_exchange_mod.F90 @@ -992,7 +992,7 @@ subroutine cplcomp_moab_Init(infodata,comp) !----------------------------------------------------- ! use iMOAB, only: iMOAB_RegisterApplication, iMOAB_ReceiveMesh, iMOAB_SendMesh, & - iMOAB_WriteMesh, iMOAB_DefineTagStorage, & + iMOAB_WriteMesh, iMOAB_DefineTagStorage, iMOAB_GetMeshInfo, & iMOAB_SetIntTagStorage, iMOAB_FreeSenderBuffers, iMOAB_ComputeCommGraph, iMOAB_LoadMesh ! use component_mod, only: component_exch_moab ! @@ -1025,6 +1025,8 @@ subroutine cplcomp_moab_Init(infodata,comp) integer :: typeA, typeB, ATM_PHYS_CID ! used to compute par graph between atm phys ! and atm spectral on coupler character(CXX) :: tagname + integer nvert(3), nvise(3), nbl(3), nsurf(3), nvisBC(3) + !----------------------------------------------------- @@ -1115,6 +1117,13 @@ subroutine cplcomp_moab_Init(infodata,comp) endif ATM_PHYS_CID = 200 + id_old ! 200 + 5 for atm, see line 969 ATM_PHYS = 200 + ATMID ! in ! components/cam/src/cpl/atm_comp_mct.F90 + if (mphaid >= 0) then + ierr = iMOAB_GetMeshInfo ( mphaid, nvert, nvise, nbl, nsurf, nvisBC ) + comp%mbApCCid = mphaid ! phys atm + comp%mbGridType = 0 ! point cloud + comp%mblsize = nvert(1) ! point cloud + endif + ierr = iMOAB_ComputeCommGraph( mphaid, mbaxid, mpicom_join, mpigrp_old, mpigrp_cplid, & typeA, typeB, ATM_PHYS_CID, id_join) ! ID_JOIN is now 6 @@ -1197,6 +1206,12 @@ subroutine cplcomp_moab_Init(infodata,comp) write(logunit,*) subname,' error in sending ocean mesh to coupler ' call shr_sys_abort(subname//' ERROR in sending ocean mesh to coupler ') endif + if (mpoid >= 0) then + ierr = iMOAB_GetMeshInfo ( mpoid, nvert, nvise, nbl, nsurf, nvisBC ) + comp%mbApCCid = mpoid ! phys atm + comp%mbGridType = 1 ! cells + comp%mblsize = nvise(1) ! cells + endif endif if (MPI_COMM_NULL /= mpicom_new ) then ! we are on the coupler pes @@ -1347,6 +1362,13 @@ subroutine cplcomp_moab_Init(infodata,comp) typeA = 3 endif typeB = 3 ! full mesh on coupler pes, we just read it + if (mlnid >= 0) then + ierr = iMOAB_GetMeshInfo ( mlnid, nvert, nvise, nbl, nsurf, nvisBC ) + comp%mbApCCid = mlnid ! phys atm + comp%mbGridType = typeA - 2 ! 0 or 1, pc or cells + comp%mblsize = nvert(1) ! vertices + if (mb_land_mesh) comp%mblsize = nvise(1) ! cells + endif ierr = iMOAB_ComputeCommGraph( mlnid, mblxid, mpicom_join, mpigrp_old, mpigrp_cplid, & typeA, typeB, id_old, id_join) if (ierr .ne. 0) then @@ -1378,62 +1400,68 @@ subroutine cplcomp_moab_Init(infodata,comp) write(logunit,*) subname,' error in sending sea ice mesh to coupler ' call shr_sys_abort(subname//' ERROR in sending sea ice mesh to coupler ') endif + if (MPSIID >= 0) then + ierr = iMOAB_GetMeshInfo ( MPSIID, nvert, nvise, nbl, nsurf, nvisBC ) + comp%mbApCCid = MPSIID ! phys atm + comp%mbGridType = 1 ! 0 or 1, pc or cells + comp%mblsize = nvise(1) ! vertices + endif endif if (MPI_COMM_NULL /= mpicom_new ) then ! we are on the coupler pes - appname = "COUPLE_MPASSI"//C_NULL_CHAR - ! migrated mesh gets another app id, moab moab sea ice to coupler (mbix) - ierr = iMOAB_RegisterApplication(trim(appname), mpicom_new, id_join, mbixid) - ierr = iMOAB_ReceiveMesh(mbixid, mpicom_join, mpigrp_old, id_old) - tagtype = 1 ! dense, double - numco = 1 ! one value per cell / entity - tagname = trim(seq_flds_i2x_fields)//C_NULL_CHAR - ierr = iMOAB_DefineTagStorage(mbixid, tagname, tagtype, numco, tagindex ) - if ( ierr == 1 ) then - call shr_sys_abort( subname//' ERROR: cannot define tags for ice on coupler' ) - end if - tagname = trim(seq_flds_x2i_fields)//C_NULL_CHAR - ierr = iMOAB_DefineTagStorage(mbixid, tagname, tagtype, numco, tagindex ) - if ( ierr == 1 ) then - call shr_sys_abort( subname//' ERROR: cannot define tags for ice on coupler' ) - end if - - !add the normalization tag - tagname = trim(seq_flds_dom_fields)//":norm8wt"//C_NULL_CHAR - ierr = iMOAB_DefineTagStorage(mbixid, tagname, tagtype, numco, tagindex ) - if (ierr .ne. 0) then - write(logunit,*) subname,' error in defining tags seq_flds_dom_fields on ice on coupler ' - call shr_sys_abort(subname//' ERROR in defining tags ') - endif + appname = "COUPLE_MPASSI"//C_NULL_CHAR + ! migrated mesh gets another app id, moab moab sea ice to coupler (mbix) + ierr = iMOAB_RegisterApplication(trim(appname), mpicom_new, id_join, mbixid) + ierr = iMOAB_ReceiveMesh(mbixid, mpicom_join, mpigrp_old, id_old) + tagtype = 1 ! dense, double + numco = 1 ! one value per cell / entity + tagname = trim(seq_flds_i2x_fields)//C_NULL_CHAR + ierr = iMOAB_DefineTagStorage(mbixid, tagname, tagtype, numco, tagindex ) + if ( ierr == 1 ) then + call shr_sys_abort( subname//' ERROR: cannot define tags for ice on coupler' ) + end if + tagname = trim(seq_flds_x2i_fields)//C_NULL_CHAR + ierr = iMOAB_DefineTagStorage(mbixid, tagname, tagtype, numco, tagindex ) + if ( ierr == 1 ) then + call shr_sys_abort( subname//' ERROR: cannot define tags for ice on coupler' ) + end if - tagname = trim(seq_flds_a2x_fields)//C_NULL_CHAR - tagtype = 1 ! dense - numco = 1 ! - ierr = iMOAB_DefineTagStorage(mbixid, tagname, tagtype, numco, tagindex ) - if (ierr .ne. 0) then - write(logunit,*) subname,' error in defining tags for seq_flds_a2x_fields on ice cpl' - call shr_sys_abort(subname//' ERROR in coin defining tags for seq_flds_a2x_fields on ice cpl') - endif + !add the normalization tag + tagname = trim(seq_flds_dom_fields)//":norm8wt"//C_NULL_CHAR + ierr = iMOAB_DefineTagStorage(mbixid, tagname, tagtype, numco, tagindex ) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in defining tags seq_flds_dom_fields on ice on coupler ' + call shr_sys_abort(subname//' ERROR in defining tags ') + endif - tagname = trim(seq_flds_r2x_fields)//C_NULL_CHAR - tagtype = 1 ! dense - numco = 1 ! - ierr = iMOAB_DefineTagStorage(mbixid, tagname, tagtype, numco, tagindex ) - if (ierr .ne. 0) then - write(logunit,*) subname,' error in defining tags for seq_flds_r2x_fields on ice cpl' - call shr_sys_abort(subname//' ERROR in coin defining tags for seq_flds_a2x_fields on ice cpl') - endif + tagname = trim(seq_flds_a2x_fields)//C_NULL_CHAR + tagtype = 1 ! dense + numco = 1 ! + ierr = iMOAB_DefineTagStorage(mbixid, tagname, tagtype, numco, tagindex ) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in defining tags for seq_flds_a2x_fields on ice cpl' + call shr_sys_abort(subname//' ERROR in coin defining tags for seq_flds_a2x_fields on ice cpl') + endif + + tagname = trim(seq_flds_r2x_fields)//C_NULL_CHAR + tagtype = 1 ! dense + numco = 1 ! + ierr = iMOAB_DefineTagStorage(mbixid, tagname, tagtype, numco, tagindex ) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in defining tags for seq_flds_r2x_fields on ice cpl' + call shr_sys_abort(subname//' ERROR in coin defining tags for seq_flds_a2x_fields on ice cpl') + endif #ifdef MOABDEBUG - ! debug test - outfile = 'recSeaIce.h5m'//C_NULL_CHAR - wopts = ';PARALLEL=WRITE_PART'//C_NULL_CHAR ! - ! write out the mesh file to disk - ierr = iMOAB_WriteMesh(mbixid, trim(outfile), trim(wopts)) - if (ierr .ne. 0) then - write(logunit,*) subname,' error in writing sea ice mesh on coupler ' - call shr_sys_abort(subname//' ERROR in writing sea ice mesh on coupler ') - endif + ! debug test + outfile = 'recSeaIce.h5m'//C_NULL_CHAR + wopts = ';PARALLEL=WRITE_PART'//C_NULL_CHAR ! + ! write out the mesh file to disk + ierr = iMOAB_WriteMesh(mbixid, trim(outfile), trim(wopts)) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in writing sea ice mesh on coupler ' + call shr_sys_abort(subname//' ERROR in writing sea ice mesh on coupler ') + endif #endif endif if (MPSIID .ge. 0) then ! we are on component sea ice pes @@ -1498,6 +1526,12 @@ subroutine cplcomp_moab_Init(infodata,comp) endif endif + if (mrofid >= 0) then + ierr = iMOAB_GetMeshInfo ( mrofid, nvert, nvise, nbl, nsurf, nvisBC ) + comp%mbApCCid = mrofid ! + comp%mbGridType = 0 ! 0 or 1, pc or cells + comp%mblsize = nvert(1) ! vertices + endif ! we are now on joint pes, compute comm graph between rof and coupler model typeA = 2 ! point cloud on component PEs typeB = 3 ! full mesh on coupler pes, we just read it From 922a16245cc0222a37ff6290921da05b397dac77 Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Tue, 18 Apr 2023 21:59:38 -0500 Subject: [PATCH 366/467] zero out the output matrix x2o_om equivalent to call mct_aVect_zero(x2o_o) --- driver-moab/main/prep_ocn_mod.F90 | 2 ++ 1 file changed, 2 insertions(+) diff --git a/driver-moab/main/prep_ocn_mod.F90 b/driver-moab/main/prep_ocn_mod.F90 index d2c666086084..7bd5df94f5f2 100644 --- a/driver-moab/main/prep_ocn_mod.F90 +++ b/driver-moab/main/prep_ocn_mod.F90 @@ -1481,6 +1481,8 @@ subroutine prep_ocn_mrg_moab(infodata, xao_ox) if (ierr .ne. 0) then call shr_sys_abort(subname//' error in getting x2o_om array ') endif + ! zero out the output first (see line 1358) + x2o_om(:,:)=0. tagname = trim(seq_flds_a2x_fields)//C_NULL_CHAR arrsize = naflds * lsize ! allocate (a2x_om (lsize, naflds)) ierr = iMOAB_GetDoubleTagStorage ( mboxid, tagname, arrsize , ent_type, a2x_om(1,1)) From 18c6a21434573235989098079db6e9ffb11918cb Mon Sep 17 00:00:00 2001 From: Jason Sarich Date: Tue, 25 Apr 2023 11:24:37 -0500 Subject: [PATCH 367/467] switch back to using cime master so we don't need to maintain our own cime submodule branch --- .gitmodules | 2 +- cime | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/.gitmodules b/.gitmodules index 7252cc96e46f..29720f199e02 100644 --- a/.gitmodules +++ b/.gitmodules @@ -31,7 +31,7 @@ [submodule "cime"] path = cime url = git@github.com:ESMCI/cime.git - branch = sarich/fix-moab-driver-checks + branch = master [submodule "externals/YAKL"] path = externals/YAKL url = git@github.com:mrnorman/YAKL.git diff --git a/cime b/cime index 7f1a08a6c254..c855888b58c8 160000 --- a/cime +++ b/cime @@ -1 +1 @@ -Subproject commit 7f1a08a6c2546c6343962884461ee0b524e18e18 +Subproject commit c855888b58c87241919852072a409f98dadada22 From 2a078e44137a972d2a380ed34ed79ac314a112c4 Mon Sep 17 00:00:00 2001 From: jayeshkrishna Date: Fri, 24 Mar 2023 11:52:44 -0500 Subject: [PATCH 368/467] Merge branch 'jayeshkrishna/cime_config/add_adios_conv_job' (PR #5530) Adding new build script for SCORPIO, buildlib.spio, to replace the build script used by PIO, buildlib.pio, in CIME. The new build script also includes support for ADIOS. This build script is not enabled in this PR. It will be enabled when ESMCI/cime#4372 (CIME PR) will be merged to E3SM. Also adding I/O post processing logic required to convert ADIOS BP output files to NetCDF files in a post processing job. [BFB] --- cime_config/config_files.xml | 1 + cime_config/customize/case_post_run_io.py | 112 +++++++++ cime_config/machines/config_workflow.xml | 19 +- cime_config/machines/template.post_run_io | 77 +++++++ share/build/buildlib.spio | 267 ++++++++++++++++++++++ 5 files changed, 475 insertions(+), 1 deletion(-) create mode 100755 cime_config/customize/case_post_run_io.py create mode 100755 cime_config/machines/template.post_run_io create mode 100755 share/build/buildlib.spio diff --git a/cime_config/config_files.xml b/cime_config/config_files.xml index 06c42557d06a..61097e8157fb 100644 --- a/cime_config/config_files.xml +++ b/cime_config/config_files.xml @@ -536,6 +536,7 @@ $SRCROOT/share/build/buildlib.kokkos $SRCROOT/share/build/buildlib.gptl $CIMEROOT/CIME/build_scripts/buildlib.pio + $SRCROOT/share/build/buildlib.spio $CIMEROOT/CIME/build_scripts/buildlib.mct $SRCROOT/share/build/buildlib.csm_share $CIMEROOT/CIME/build_scripts/buildlib.mpi-serial diff --git a/cime_config/customize/case_post_run_io.py b/cime_config/customize/case_post_run_io.py new file mode 100755 index 000000000000..bb44477ebb57 --- /dev/null +++ b/cime_config/customize/case_post_run_io.py @@ -0,0 +1,112 @@ +""" +Post run I/O processing +""" +import os +from CIME.XML.standard_module_setup import * +from CIME.utils import new_lid, run_and_log_case_status + +logger = logging.getLogger(__name__) + +############################################################################### +def _convert_adios_to_nc(case): +############################################################################### + """ + Converts all ADIOS output files for the case to NetCDF format + """ + env_mach_specific = case.get_env('mach_specific') + + # Create the ADIOS convertion tool command, + # "/adios2pio-nm.exe --idir=" + # The command converts all ADIOS BP files in to + # NetCDF files + + # The ADIOS conversion tool is installed in EXEROOT + exeroot = case.get_value("EXEROOT") + adios_conv_tool_name = "adios2pio-nm.exe" + adios_conv_tool_exe = os.path.join(exeroot, adios_conv_tool_name) + + # The ADIOS output files should be in RUNDIR + rundir = case.get_value("RUNDIR") + + adios_conv_tool_args = "--idir=" + rundir + adios_conv_tool_cmd = adios_conv_tool_exe + " " + adios_conv_tool_args + + # Replace logfile name, "e3sm.log.*" with "e3sm_adios_post_io.log.*" + # The logfile name is part of the run command suffix + adios_conv_tool_cmd_suffix = env_mach_specific.get_value("run_misc_suffix") + adios_conv_tool_cmd_suffix = adios_conv_tool_cmd_suffix.replace( + "e3sm.log", "e3sm_adios_post_io.log") + + is_batch = case.get_value("BATCH_SYSTEM") + + # Set up the LID (used as unique id for log names etc via $LID) + lid = new_lid(case=case) + + # For batch jobs the number of nodes/processes for post processing need + # to be determined before the post run job is launched + # (i.e., via config_workflow.xml) + if is_batch == "none": + # Reset the total number of tasks to 1/4th for the conversion job + CONV_JOB_SCALE_FACTOR = 1.0/4.0 + CONV_JOB_MIN_TOTAL_TASKS = 1 + CONV_JOB_MAX_TOTAL_TASKS = 1024 + env_mach_pes = case.get_env("mach_pes") + case.thread_count = 1 + case.total_tasks = max(min(int(case.total_tasks * CONV_JOB_SCALE_FACTOR), CONV_JOB_MAX_TOTAL_TASKS), CONV_JOB_MIN_TOTAL_TASKS) + case.cores_per_task = 1 + case.tasks_per_node = env_mach_pes.get_tasks_per_node(case.total_tasks, case.thread_count) + case.num_nodes, case.spare_nodes = env_mach_pes.get_total_nodes(case.total_tasks, case.thread_count) + case.num_nodes += case.spare_nodes + + # Get the current mpirun command (for e3sm.exe) + cmd = case.get_mpirun_cmd(allow_unresolved_envvars=False) + + # Create mpirun command for the ADIOS conversion tool + # Replace run_exe and run_misc_suffix in mpirun command + # with ADIOS convertion tool command and suffix + run_exe = env_mach_specific.get_value("run_exe", resolved=True) + run_exe = case.get_resolved_value(run_exe); + run_misc_suffix = env_mach_specific.get_value("run_misc_suffix") + cmd = cmd.replace(run_exe, adios_conv_tool_cmd) + cmd = cmd.replace(run_misc_suffix, adios_conv_tool_cmd_suffix) + logger.info("Run command for ADIOS post processing is : {}".format(cmd)) + + # Load the environment + case.load_env(reset=True) + + run_func = lambda: run_cmd(cmd, from_dir=rundir)[0] + + # Run the modified case + success = run_and_log_case_status(run_func, + "ADIOS to NetCDF conversion", + caseroot=case.get_value("CASEROOT"), + is_batch=(is_batch != "none")) + + return success + +############################################################################### +def case_post_run_io(self): +############################################################################### + """ + I/O Post processing : + 1. Convert ADIOS output files, if any, to NetCDF + """ + success = True + has_adios = False + self.load_env(job="case.post_run_io") + component_classes = self.get_values("COMP_CLASSES") + # Check if user chose "adios" as the iotype for any component + for compclass in component_classes: + key = "PIO_TYPENAME_{}".format(compclass) + pio_typename = self.get_value(key) + if pio_typename == "adios": + has_adios = True + break + if has_adios: + logger.info("I/O post processing for ADIOS starting") + success = _convert_adios_to_nc(self) + logger.info("I/O post processing for ADIOS completed") + else: + logger.info("No I/O post processing required") + + return success diff --git a/cime_config/machines/config_workflow.xml b/cime_config/machines/config_workflow.xml index 90a6d25256c8..6f56f7ea27e5 100644 --- a/cime_config/machines/config_workflow.xml +++ b/cime_config/machines/config_workflow.xml @@ -37,10 +37,27 @@ $BUILD_COMPLETE and $TEST + + + case.run + case.get_value("PIO_TYPENAME_ATM") == 'adios' or \ + case.get_value("PIO_TYPENAME_CPL") == 'adios' or \ + case.get_value("PIO_TYPENAME_OCN") == 'adios' or \ + case.get_value("PIO_TYPENAME_WAV") == 'adios' or \ + case.get_value("PIO_TYPENAME_GLC") == 'adios' or \ + case.get_value("PIO_TYPENAME_ICE") == 'adios' or \ + case.get_value("PIO_TYPENAME_ROF") == 'adios' or \ + case.get_value("PIO_TYPENAME_LND") == 'adios' or \ + case.get_value("PIO_TYPENAME_ESP") == 'adios' or \ + case.get_value("PIO_TYPENAME_IAC") == 'adios' + + 0:30:00 + + - case.run or case.test + (case.run and case.post_run_io) or case.test $DOUT_S 1 diff --git a/cime_config/machines/template.post_run_io b/cime_config/machines/template.post_run_io new file mode 100755 index 000000000000..82622085275c --- /dev/null +++ b/cime_config/machines/template.post_run_io @@ -0,0 +1,77 @@ +#!/usr/bin/env python3 +{{ batchdirectives }} + +""" +template to create a case post run script for I/O post processing. + +This should only ever be called by case.submit when on batch system. +This script only exists as a way of providing batch directives. +Use case.submit from the command line to run your case. + +DO NOT RUN THIS SCRIPT MANUALLY +""" + +import os, sys +os.chdir( '{{ caseroot }}') + +_LIBDIR = os.path.join("{{ cimeroot }}", "scripts", "Tools") +sys.path.append(_LIBDIR) + +from standard_script_setup import * + +from CIME.case import Case +from CIME.config import Config + +logger = logging.getLogger(__name__) + +import argparse + +############################################################################### +def parse_command_line(args, description): +############################################################################### + parser = argparse.ArgumentParser( + usage="""\n{0} [--verbose] +OR +{0} --help + +\033[1mEXAMPLES:\033[0m + \033[1;32m# case.post_run_io SMS\033[0m + > {0} +""".format(os.path.basename(args[0])), + description=description, + formatter_class=argparse.ArgumentDefaultsHelpFormatter + ) + + CIME.utils.setup_standard_logging_options(parser) + + parser.add_argument("--caseroot", + help="Case directory to build") + + args = CIME.utils.parse_args_and_handle_standard_logging_options(args, parser) + + if args.caseroot is not None: + os.chdir(args.caseroot) + + return args.caseroot + +############################################################################### +def _main_func(description): +############################################################################### + sys.argv.extend([] if "ARGS_FOR_SCRIPT" not in os.environ else os.environ["ARGS_FOR_SCRIPT"].split()) + + ret = 0 + caseroot = parse_command_line(sys.argv, description) + # Load the case_post_run_io.py script and run I/O post processing steps + with Case(caseroot, read_only=False) as case: + srcroot = case.get_value("SRCROOT") + + customize_path = os.path.join(srcroot, "cime_config", "customize") + + config = Config.load(customize_path) + + ret = config.case_post_run_io(case) + + sys.exit(ret) + +if __name__ == "__main__": + _main_func(__doc__) diff --git a/share/build/buildlib.spio b/share/build/buildlib.spio new file mode 100755 index 000000000000..d156182f1e1f --- /dev/null +++ b/share/build/buildlib.spio @@ -0,0 +1,267 @@ +#!/usr/bin/env python3 +import sys, os, logging, argparse + +cimeroot = os.getenv("CIMEROOT") +sys.path.append(os.path.join(cimeroot, "CIME", "Tools")) + +import glob, re +from standard_script_setup import * +from CIME import utils +from CIME.utils import expect, run_bld_cmd_ensure_logging, safe_copy +from CIME.build import get_standard_makefile_args +from CIME.case import Case + +logger = logging.getLogger(__name__) + + +def parse_command_line(args, description): + ############################################################################### + parser = argparse.ArgumentParser( + usage="""\n{0} [--debug] +OR +{0} --verbose +OR +{0} --help + +\033[1mEXAMPLES:\033[0m + \033[1;32m# Run \033[0m + > {0} +""".format( + os.path.basename(args[0]) + ), + description=description, + formatter_class=argparse.ArgumentDefaultsHelpFormatter, + ) + + utils.setup_standard_logging_options(parser) + + parser.add_argument("buildroot", help="build path root") + + parser.add_argument("installpath", help="install path ") + + parser.add_argument( + "caseroot", nargs="?", default=os.getcwd(), help="Case directory to build" + ) + + args = utils.parse_args_and_handle_standard_logging_options(args, parser) + + return args.buildroot, args.installpath, args.caseroot + + +############################################################################### +def buildlib(bldroot, installpath, case): + ############################################################################### + cime_model = case.get_value("MODEL") + caseroot = case.get_value("CASEROOT") + exeroot = case.get_value("EXEROOT") + pio_version = case.get_value("PIO_VERSION") + srcroot = case.get_value("SRCROOT") + scorpio_src_root_dir = None + if cime_model == "e3sm": + scorpio_src_root_dir = os.path.join(srcroot, "externals") + # Scorpio classic is derived from PIO1 + scorpio_classic_dir = "scorpio_classic" + # Scorpio is derived from PIO2 + scorpio_dir = "scorpio" + scorpio_classic_src_dir = os.path.join( + scorpio_src_root_dir, scorpio_classic_dir + ) + scorpio_src_dir = os.path.join(scorpio_src_root_dir, scorpio_dir) + if ( + not os.path.isdir(scorpio_src_root_dir) + or not os.path.isdir(scorpio_classic_src_dir) + or not os.path.isdir(scorpio_src_dir) + ): + scorpio_src_root_dir = None + + # If variable PIO_VERSION_MAJOR is defined in the environment then + # we assume that PIO is installed on the system + # and expect to find + # PIO_LIBDIR, PIO_INCDIR, PIO_TYPENAME_VALID_VALUES + # also defined in the environment. In this case we + # will use the installed pio and not build it here. + installed_pio_version = os.environ.get("PIO_VERSION_MAJOR") + logger.info( + "pio_version_major = {} pio_version = {}".format( + installed_pio_version, pio_version + ) + ) + if installed_pio_version is not None and int(installed_pio_version) == pio_version: + logger.info("Using installed PIO library") + _set_pio_valid_values(case, os.environ.get("PIO_TYPENAME_VALID_VALUES")) + return + + pio_model = "pio{}".format(pio_version) + pio_dir = os.path.join(bldroot, pio_model) + if not os.path.isdir(pio_dir): + os.makedirs(pio_dir) + casetools = case.get_value("CASETOOLS") + if scorpio_src_root_dir: + # Use old genf90 until "short" type is supported + cmake_opts = ( + '"-D GENF90_PATH=' + + os.path.join(scorpio_src_root_dir, scorpio_dir, "src/genf90") + + '" ' + ) + elif pio_version == 1: + cmake_opts = '"-D GENF90_PATH=$CIMEROOT/CIME/non_py/externals/genf90 "' + else: + cmake_opts = '"-D GENF90_PATH=' + srcroot + '/libraries/parallelio/scripts/ "' + + stdargs = get_standard_makefile_args(case, shared_lib=True) + + gmake_vars = ( + "CASEROOT={caseroot} COMP_NAME={pio_model} " + "USER_CMAKE_OPTS={cmake_opts} " + "PIO_LIBDIR={pio_dir} CASETOOLS={casetools} " + "USER_CPPDEFS=-DTIMING".format( + caseroot=caseroot, + pio_model=pio_model, + cmake_opts=cmake_opts, + pio_dir=pio_dir, + casetools=casetools, + ) + ) + + if scorpio_src_root_dir is not None: + gmake_vars += ( + " IO_LIB_SRCROOT={scorpio_src_root_dir} " + " IO_LIB_v1_SRCDIR={scorpio_classic_dir} " + " IO_LIB_v2_SRCDIR={scorpio_dir} ".format( + scorpio_src_root_dir=scorpio_src_root_dir, + scorpio_classic_dir=scorpio_classic_dir, + scorpio_dir=scorpio_dir, + ) + ) + + gmake_opts = ( + "{pio_dir}/Makefile -C {pio_dir} " + " {gmake_vars} {stdargs} -f {casetools}/Makefile".format( + pio_dir=pio_dir, gmake_vars=gmake_vars, casetools=casetools, stdargs=stdargs + ) + ) + + gmake_cmd = case.get_value("GMAKE") + + # This runs the pio cmake command from the cime case Makefile + logger.info("Configuring SCORPIO") + cmd = "{} {}".format(gmake_cmd, gmake_opts) + run_bld_cmd_ensure_logging(cmd, logger, from_dir=pio_dir) + + # This runs the pio make command from the cmake generated Makefile + logger.info("Building SCORPIO") + run_bld_cmd_ensure_logging( + "{} -j {}".format(gmake_cmd, case.get_value("GMAKE_J")), + logger, + from_dir=pio_dir, + ) + + if pio_version == 1: + expect_string = "D_NETCDF;" + pnetcdf_string = "D_PNETCDF" + netcdf4_string = "D_NETCDF4" + else: + expect_string = "NetCDF_C_LIBRARY-ADVANCED" + # pnetcdf_string = "PnetCDF_C_LIBRARY-ADVANCED" + pnetcdf_string = "WITH_PNETCDF:BOOL=ON" + netcdf4_string = "NetCDF_C_HAS_PARALLEL:BOOL=TRUE" + + adios_string = "WITH_ADIOS2:BOOL=ON" + expect_string_found = False + pnetcdf_found = False + netcdf4_parallel_found = False + adios_found = False + + cache_file = open(os.path.join(pio_dir,"CMakeCache.txt"), "r") + for line in cache_file: + if re.search(expect_string, line): + expect_string_found = True + if re.search(pnetcdf_string, line): + pnetcdf_found = True + if re.search(netcdf4_string, line): + netcdf4_parallel_found = True + if re.search(adios_string, line): + adios_found = True + + if pio_version == 1: + installed_lib = os.path.join(installpath, "lib", "libpio.a") + installed_lib_time = 0 + if os.path.isfile(installed_lib): + installed_lib_time = os.path.getmtime(installed_lib) + newlib = os.path.join(pio_dir, "pio", "libpio.a") + newlib_time = os.path.getmtime(newlib) + if newlib_time > installed_lib_time: + logger.info("Installing pio version 1") + safe_copy(newlib, installed_lib) + for glob_to_copy in ("*.h", "*.mod"): + for item in glob.glob(os.path.join(pio_dir, "pio", glob_to_copy)): + safe_copy(item, "{}/include".format(installpath)) + else: + globs_to_copy = [ + os.path.join("src", "clib", "libpioc.*"), + os.path.join("src", "flib", "libpiof.*"), + os.path.join("src", "clib", "*.h"), + os.path.join("src", "flib", "*.mod"), + ] + # ADIOS requires an ADIOS to NetCDF conversion library/exe + if adios_found: + globs_to_copy.append(os.path.join("tools","adios2pio-nm","libadios2pio-nm-lib.*")) + globs_to_copy.append(os.path.join("tools","adios2pio-nm","adios2pio-nm.exe")) + for glob_to_copy in globs_to_copy: + installed_file_time = 0 + for item in glob.glob(os.path.join(pio_dir, glob_to_copy)): + if item.endswith(".a") or item.endswith(".so"): + installdir = "lib" + else: + installdir = "include" + if item.endswith(".exe"): + # FIXME: Move executables into a bin/util dir + # Currently we are moving the SCORPIO util exes to the same + # dir as e3sm.exe (the EXEROOT) - ignoring installpath + installed_file = os.path.join(exeroot,os.path.basename(item)) + else: + installed_file = os.path.join(installpath,installdir,os.path.basename(item)) + item_time = os.path.getmtime(item) + if os.path.isfile(installed_file): + installed_file_time = os.path.getmtime(installed_file) + if item_time > installed_file_time: + safe_copy(item, installed_file) + + # make sure case pio_typename valid_values is set correctly + expect(expect_string_found, "CIME models require NETCDF in PIO build") + valid_values = "netcdf" + if pnetcdf_found: + valid_values += ",pnetcdf" + if netcdf4_parallel_found: + valid_values += ",netcdf4p,netcdf4c" + if adios_found: + valid_values += ",adios" + + _set_pio_valid_values(case, valid_values) + + +def _set_pio_valid_values(case, valid_values): + # nothing means use the general default + valid_values += ",nothing" + logger.warning("Updating valid_values for PIO_TYPENAME: {}".format(valid_values)) + env_run = case.get_env("run") + env_run.set_valid_values("PIO_TYPENAME", valid_values) + + for comp in case.get_values("COMP_CLASSES"): + comp_pio_typename = "{}_PIO_TYPENAME".format(comp) + current_value = case.get_value(comp_pio_typename) + if current_value not in valid_values: + logger.warning( + "Resetting PIO_TYPENAME=netcdf for component {}".format(comp) + ) + env_run.set_value(comp_pio_typename, "netcdf") + + +def _main(argv, documentation): + bldroot, installpath, caseroot = parse_command_line(argv, documentation) + with Case(caseroot, read_only=False) as case: + buildlib(bldroot, installpath, case) + + +if __name__ == "__main__": + _main(sys.argv, __doc__) From bb897672058c45b29e98c2a97f9c0863ec0787ed Mon Sep 17 00:00:00 2001 From: Jason Sarich Date: Thu, 27 Apr 2023 13:17:58 -0500 Subject: [PATCH 369/467] reset buildlib.kokkos to use the one from E3SM master --- share/build/buildlib.kokkos | 42 ++++++++++++++++++++++++++++++++++--- 1 file changed, 39 insertions(+), 3 deletions(-) diff --git a/share/build/buildlib.kokkos b/share/build/buildlib.kokkos index 6bf7ec306623..048536f4419e 100755 --- a/share/build/buildlib.kokkos +++ b/share/build/buildlib.kokkos @@ -1,6 +1,6 @@ #!/usr/bin/env python3 -import os, sys, argparse, logging +import os, sys, argparse, logging, shutil from standard_script_setup import * from CIME import utils @@ -47,7 +47,26 @@ OR ############################################################################### def buildlib(bldroot, installpath, case): - ############################################################################### +############################################################################### + installed_kokkos_dir = os.environ.get("KOKKOS_PATH") + if installed_kokkos_dir is not None: + # We are trying to use a pre-installed kokkos. Look for the relevant folders/libs, + # and if all looks good, return. Otherwise, crap out + kokkos_root = os.path.abspath(installed_kokkos_dir) + include_dir = os.path.join(kokkos_root,'include') + + expect (os.path.isdir(kokkos_root),f"Non-existent kokkos install dir '{kokkos_root}'") + expect (os.path.isdir(include_dir),f"Missing include subfolder in kokkos install dir '{kokkos_root}'") + expect (os.path.isfile(os.path.join(include_dir,'Kokkos_Core.hpp')),f"Missing kokkos headers in '{include_dir}'") + + # TODO: should I check for libs too? The problem is that the lib subfolder is + # often arch dependent (e.g., $prefix/lib or $prefix/lib64)... The best thing + # would be to run a small cmake script, that calls find_package. But E3SM's + # cmake build system will do that soon enough, so any error will be caught there. + return + else: + print ("no value foudn in env for KOKKOS_PATH. building from scratch") + srcroot = case.get_value("SRCROOT") kokkos_dir = os.path.join(srcroot, "externals", "kokkos") expect(os.path.isdir(kokkos_dir), "Missing kokkos submodule") @@ -75,7 +94,13 @@ def buildlib(bldroot, installpath, case): .split(":=")[-1] .strip() ) - cxx = "-DCMAKE_CXX_COMPILER={}".format(cxx) + + if "/" in cxx: + cxx = "-DCMAKE_CXX_COMPILER={}".format(cxx) + else: + cxx_path = shutil.which(cxx) + expect(cxx_path is not None, "{} is not in PATH?".format(cxx)) + cxx = "-DCMAKE_CXX_COMPILER={}".format(cxx_path) gmake_cmd = case.get_value("GMAKE") gmake_j = case.get_value("GMAKE_J") @@ -87,6 +112,17 @@ def buildlib(bldroot, installpath, case): installpath=installpath, ) + # When later we use find_package to get kokkos in CMake, the folder + # install_sharedpath/kokkos (which is bldroot here) gets picked over + # the actual install folders. Since a KokkosConfig.cmake file *is* present + # there, but the other cmake config files aren't, this causes config errors. + # To prevent find_package from picking up that folder, we actually use + # ${bldroot}/build as a binary dir, so that CMake won't consider it when + # executing find_package. + bldroot = f"{bldroot}/build" + if not os.path.isdir(bldroot): + os.makedirs(bldroot) + run_bld_cmd_ensure_logging(gen_makefile_cmd, logger, from_dir=bldroot) run_bld_cmd_ensure_logging( "{} VERBOSE=1 -j {}".format(gmake_cmd, gmake_j), logger, from_dir=bldroot From c99220d5b9a0010bd1d962eb496448c386ef83a4 Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Tue, 25 Apr 2023 23:23:02 -0500 Subject: [PATCH 370/467] ocean accumulation need to modify x2o_om tags after averaging dump a new file OcnCplAftAvg*.h5m --- driver-moab/main/cime_comp_mod.F90 | 6 ++ driver-moab/main/prep_ocn_mod.F90 | 91 +++++++++++++++++++++++++++++- 2 files changed, 96 insertions(+), 1 deletion(-) diff --git a/driver-moab/main/cime_comp_mod.F90 b/driver-moab/main/cime_comp_mod.F90 index c111d681a0cf..4511fe5e102b 100644 --- a/driver-moab/main/cime_comp_mod.F90 +++ b/driver-moab/main/cime_comp_mod.F90 @@ -4083,6 +4083,7 @@ subroutine cime_run_atm_recv_post() if (atm_c2_rof) then call prep_rof_accum_atm(timer='CPL:atmpost_acca2r') + !call prep_rof_accum_atm_moab() endif call component_diag(infodata, atm, flow='c2x', comment= 'recv atm', & @@ -4140,6 +4141,7 @@ subroutine cime_run_ocn_setup_send() ! finish accumulating ocean inputs ! reset the value of x2o_ox with the value in x2oacc_ox (module variable in prep_ocn_mod) call prep_ocn_accum_avg(timer_accum='CPL:ocnprep_avg') + call prep_ocn_accum_avg_moab() call component_diag(infodata, ocn, flow='x2c', comment= 'send ocn', & info_debug=info_debug, timer_diag='CPL:ocnprep_diagav') @@ -4197,6 +4199,7 @@ subroutine cime_run_ocn_recv_post() info_debug=info_debug, timer_diag='CPL:ocnpost_diagav') if (ocn_c2_rof) call prep_rof_accum_ocn(timer='CPL:ocnpost_acco2r') + !if (ocn_c2_rof) call prep_rof_accum_ocn_moab() call cime_run_ocnglc_coupling() @@ -4346,6 +4349,7 @@ subroutine cime_run_atmocn_setup(hashint) ! Accumulate ocn inputs - form partial sum of tavg ocn inputs (virtual "send" to ocn) call prep_ocn_accum(timer='CPL:atmocnp_accum') + call prep_ocn_accum_moab() #endif end if @@ -4493,6 +4497,7 @@ subroutine cime_run_lnd_recv_post() ! Accumulate rof and glc inputs (module variables in prep_rof_mod and prep_glc_mod) if (lnd_c2_rof) call prep_rof_accum_lnd(timer='CPL:lndpost_accl2r') + !if (lnd_c2_rof) call prep_rof_accum_lnd_moab() if (lnd_c2_glc .or. do_hist_l2x1yrg) call prep_glc_accum_lnd(timer='CPL:lndpost_accl2g' ) if (lnd_c2_iac) call prep_iac_accum(timer='CPL:lndpost_accl2z') @@ -4639,6 +4644,7 @@ subroutine cime_run_rof_setup_send() if (drv_threading) call seq_comm_setnthreads(nthreads_CPLID) call prep_rof_accum_avg(timer='CPL:rofprep_l2xavg') + !call prep_rof_accum_avg_moab() if (lnd_c2_rof) call prep_rof_calc_l2r_rx(fractions_lx, timer='CPL:rofprep_lnd2rof') diff --git a/driver-moab/main/prep_ocn_mod.F90 b/driver-moab/main/prep_ocn_mod.F90 index 7bd5df94f5f2..d8a8ec948bd4 100644 --- a/driver-moab/main/prep_ocn_mod.F90 +++ b/driver-moab/main/prep_ocn_mod.F90 @@ -59,7 +59,9 @@ module prep_ocn_mod public :: prep_ocn_mrg_moab public :: prep_ocn_accum + public :: prep_ocn_accum_moab public :: prep_ocn_accum_avg + public :: prep_ocn_accum_avg_moab public :: prep_ocn_calc_a2x_ox @@ -132,6 +134,11 @@ module prep_ocn_mod type(mct_aVect), pointer :: x2oacc_ox(:) ! Ocn import, ocn grid, cpl pes integer , target :: x2oacc_ox_cnt ! x2oacc_ox: number of time samples accumulated + ! accumulation variables for moab data + real (kind=r8) , allocatable, private :: x2oacc_om (:,:) ! Ocn import, ocn grid, cpl pes, moab array + integer , target :: x2oacc_om_cnt ! x2oacc_ox: number of time samples accumulated, in moab array + integer :: arrSize_x2o_om ! this will be a module variable, size moabLocal_size * nof + ! other module variables integer :: mpicom_CPLID ! MPI cpl communicator logical :: iamroot_CPLID ! .true. => CPLID masterproc @@ -327,6 +334,8 @@ subroutine prep_ocn_init(infodata, atm_c2_ocn, atm_c2_ice, ice_c2_ocn, rof_c2_oc end do x2oacc_ox_cnt = 0 + ! moab accumulation variable is allocated first time when we enter merge routine + samegrid_ao = .true. samegrid_ro = .true. samegrid_ow = .true. @@ -648,7 +657,7 @@ subroutine prep_ocn_init(infodata, atm_c2_ocn, atm_c2_ice, ice_c2_ocn, rof_c2_oc write(logunit,*) subname,' created moab tags for seq_flds_r2x_fields ' endif -! find out the number of local elements in moab mesh land instance on coupler +! find out the number of local elements in moab mesh ocean instance on coupler ierr = iMOAB_GetMeshInfo ( mboxid, nvert, nvise, nbl, nsurf, nvisBC ) if (ierr .ne. 0) then write(logunit,*) subname,' cant get size of ocn mesh' @@ -824,6 +833,34 @@ subroutine prep_ocn_accum(timer) end subroutine prep_ocn_accum + subroutine prep_ocn_accum_moab() + !--------------------------------------------------------------- + ! Description + ! Accumulate ocn inputs + ! Form partial sum of tavg ocn inputs (virtual "send" to ocn) + ! NOTE: this is done AFTER the call to the merge in prep_ocn_mrg + ! + ! Arguments + ! + ! Local Variables + + character(*) , parameter :: subname = '(prep_ocn_accum_moab)' + !--------------------------------------------------------------- + + + if (x2oacc_om_cnt == 0) then + x2oacc_om = x2o_om + ! call mct_avect_copy(x2o_ox, x2oacc_ox(eoi)) + else + ! call mct_avect_accum(x2o_ox, x2oacc_ox(eoi)) + x2oacc_om = x2oacc_om + x2o_om + endif + + x2oacc_om_cnt = x2oacc_om_cnt + 1 + + end subroutine prep_ocn_accum_moab + + !================================================================================================ subroutine prep_ocn_accum_avg(timer_accum) @@ -856,6 +893,51 @@ subroutine prep_ocn_accum_avg(timer_accum) end subroutine prep_ocn_accum_avg +subroutine prep_ocn_accum_avg_moab() + !--------------------------------------------------------------- + ! Description + ! Finish accumulation ocn inputs + ! + ! Arguments + use iMOAB, only : iMOAB_SetDoubleTagStorage, iMOAB_WriteMesh + ! Local Variables + integer :: ent_type, ierr + character(CXX) :: tagname + character(*), parameter :: subname = '(prep_ocn_accum_avg_moab)' +#ifdef MOABDEBUG + character*32 :: outfile, wopts, lnum +#endif + !--------------------------------------------------------------- + + ! temporary formation of average + if (x2oacc_om_cnt > 1) then + !call mct_avect_avg(x2oacc_ox(eoi), x2oacc_ox_cnt) + x2oacc_om = 1./x2oacc_om_cnt * x2oacc_om + end if + + ! ***NOTE***THE FOLLOWING ACTUALLY MODIFIES x2o_om + x2o_om = x2oacc_om + !call mct_avect_copy(x2oacc_ox(eoi), x2o_ox) + ! modify the tags + tagname = trim(seq_flds_x2o_fields)//C_NULL_CHAR + ent_type = 1 ! cell type + ierr = iMOAB_SetDoubleTagStorage ( mboxid, tagname, arrSize_x2o_om , ent_type, x2o_om(1,1)) + if (ierr .ne. 0) then + call shr_sys_abort(subname//' error in setting x2o_om array ') + endif +#ifdef MOABDEBUG + if (mboxid .ge. 0 ) then ! we are on coupler pes, for sure + write(lnum,"(I0.2)")num_moab_exports + outfile = 'OcnCplAftAvg'//trim(lnum)//'.h5m'//C_NULL_CHAR + wopts = ';PARALLEL=WRITE_PART'//C_NULL_CHAR + ierr = iMOAB_WriteMesh(mboxid, trim(outfile), trim(wopts)) + endif +#endif + + x2oacc_om_cnt = 0 + + end subroutine prep_ocn_accum_avg_moab + !================================================================================================ subroutine prep_ocn_mrg(infodata, fractions_ox, xao_ox, timer_mrg) @@ -1119,6 +1201,13 @@ subroutine prep_ocn_mrg_moab(infodata, xao_ox) !ngflds = mct_aVect_nRattr(g2x_o) allocate(x2o_om (lsize, noflds)) + ! allocate accumulation variable , parallel to x2o_om + allocate(x2oacc_om(lsize, noflds)) + arrSize_x2o_om = lsize * noflds ! this willbe used to set/get x2o_om tags + x2oacc_om_cnt = 0 + x2oacc_om(:,:)=0. + + ! moab accumulation variable allocate(a2x_om (lsize, naflds)) allocate(i2x_om (lsize, niflds)) allocate(r2x_om (lsize, nrflds)) From 2d3163793053a5ed05b80318aba768012418a67a Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Thu, 27 Apr 2023 22:42:36 -0500 Subject: [PATCH 371/467] be more selective when zeroing out merge fields --- driver-moab/main/prep_ocn_mod.F90 | 14 +++++++++++++- 1 file changed, 13 insertions(+), 1 deletion(-) diff --git a/driver-moab/main/prep_ocn_mod.F90 b/driver-moab/main/prep_ocn_mod.F90 index 7bd5df94f5f2..ae042db5b84c 100644 --- a/driver-moab/main/prep_ocn_mod.F90 +++ b/driver-moab/main/prep_ocn_mod.F90 @@ -1482,7 +1482,19 @@ subroutine prep_ocn_mrg_moab(infodata, xao_ox) call shr_sys_abort(subname//' error in getting x2o_om array ') endif ! zero out the output first (see line 1358) - x2o_om(:,:)=0. + !x2o_om(:,:)=0. + ! no, we should zero out only some indices, that accumulate + do ko = 1, noflds + if ( (aindx(ko) .gt. 0 ) .and. amerge(ko) ) then + x2o_om(:, ko) = 0. + endif + if ( (iindx(ko) .gt. 0 ) .and. imerge(ko) ) then + x2o_om(:, ko) = 0. + endif + if ( (xindx(ko) .gt. 0 ) .and. xmerge(ko) ) then + x2o_om(:, ko) = 0. + endif + enddo tagname = trim(seq_flds_a2x_fields)//C_NULL_CHAR arrsize = naflds * lsize ! allocate (a2x_om (lsize, naflds)) ierr = iMOAB_GetDoubleTagStorage ( mboxid, tagname, arrsize , ent_type, a2x_om(1,1)) From 9261250cb6c0dad001557528dc609a13d7685d43 Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Thu, 27 Apr 2023 22:42:36 -0500 Subject: [PATCH 372/467] be more selective when zeroing out merge fields --- driver-moab/main/prep_ocn_mod.F90 | 14 +++++++++++++- 1 file changed, 13 insertions(+), 1 deletion(-) diff --git a/driver-moab/main/prep_ocn_mod.F90 b/driver-moab/main/prep_ocn_mod.F90 index d8a8ec948bd4..63299ee93df3 100644 --- a/driver-moab/main/prep_ocn_mod.F90 +++ b/driver-moab/main/prep_ocn_mod.F90 @@ -1571,7 +1571,19 @@ subroutine prep_ocn_mrg_moab(infodata, xao_ox) call shr_sys_abort(subname//' error in getting x2o_om array ') endif ! zero out the output first (see line 1358) - x2o_om(:,:)=0. + !x2o_om(:,:)=0. + ! no, we should zero out only some indices, that accumulate + do ko = 1, noflds + if ( (aindx(ko) .gt. 0 ) .and. amerge(ko) ) then + x2o_om(:, ko) = 0. + endif + if ( (iindx(ko) .gt. 0 ) .and. imerge(ko) ) then + x2o_om(:, ko) = 0. + endif + if ( (xindx(ko) .gt. 0 ) .and. xmerge(ko) ) then + x2o_om(:, ko) = 0. + endif + enddo tagname = trim(seq_flds_a2x_fields)//C_NULL_CHAR arrsize = naflds * lsize ! allocate (a2x_om (lsize, naflds)) ierr = iMOAB_GetDoubleTagStorage ( mboxid, tagname, arrsize , ent_type, a2x_om(1,1)) From 8a3d0a1936bf29d866ceedf05c3e1c7ee45cdb5c Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Fri, 28 Apr 2023 17:53:36 -0500 Subject: [PATCH 373/467] rof accumulation --- driver-moab/main/cime_comp_mod.F90 | 22 +--- driver-moab/main/prep_rof_mod.F90 | 191 ++++++++++++++++++++++++++++- 2 files changed, 191 insertions(+), 22 deletions(-) diff --git a/driver-moab/main/cime_comp_mod.F90 b/driver-moab/main/cime_comp_mod.F90 index 4511fe5e102b..105602b31916 100644 --- a/driver-moab/main/cime_comp_mod.F90 +++ b/driver-moab/main/cime_comp_mod.F90 @@ -4083,7 +4083,7 @@ subroutine cime_run_atm_recv_post() if (atm_c2_rof) then call prep_rof_accum_atm(timer='CPL:atmpost_acca2r') - !call prep_rof_accum_atm_moab() + call prep_rof_accum_atm_moab() endif call component_diag(infodata, atm, flow='c2x', comment= 'recv atm', & @@ -4093,19 +4093,6 @@ subroutine cime_run_atm_recv_post() call t_drvstopf ('CPL:ATMPOST',cplrun=.true.) endif - ! ! send projected data from atm to ocean mesh, after projection in coupler - ! if (iamin_CPLALLOCNID .and. ocn_c2_atm) then - ! ! migrate that tag from coupler pes to ocean pes - ! call prep_ocn_migrate_moab(infodata) - ! endif - - ! ! send projected data from atm to land mesh, after projection in coupler - ! if (iamin_CPLALLLNDID .and. atm_c2_lnd) then - ! ! migrate that tag from coupler pes to ocean pes - ! call prep_lnd_migrate_moab(infodata) - ! endif - - end subroutine cime_run_atm_recv_post !---------------------------------------------------------------------------------- @@ -4181,9 +4168,6 @@ subroutine cime_run_ocn_recv_post() mpicom_barrier=mpicom_CPLALLOCNID, run_barriers=run_barriers, & timer_barrier='CPL:O2CT_BARRIER', timer_comp_exch='CPL:O2CT', & timer_map_exch='CPL:o2c_ocno2ocnx', timer_infodata_exch='CPL:o2c_infoexch') - ! send from ocn pes to coupler - ! call ocn_cpl_moab(ocn) - ! new way call component_exch_moab(ocn(1), mpoid, mboxid, 0, seq_flds_o2x_fields) endif @@ -4497,7 +4481,9 @@ subroutine cime_run_lnd_recv_post() ! Accumulate rof and glc inputs (module variables in prep_rof_mod and prep_glc_mod) if (lnd_c2_rof) call prep_rof_accum_lnd(timer='CPL:lndpost_accl2r') - !if (lnd_c2_rof) call prep_rof_accum_lnd_moab() +#ifdef HAVE_MOAB + if (lnd_c2_rof) call prep_rof_accum_lnd_moab() +#endif if (lnd_c2_glc .or. do_hist_l2x1yrg) call prep_glc_accum_lnd(timer='CPL:lndpost_accl2g' ) if (lnd_c2_iac) call prep_iac_accum(timer='CPL:lndpost_accl2z') diff --git a/driver-moab/main/prep_rof_mod.F90 b/driver-moab/main/prep_rof_mod.F90 index 2e5947dde43f..1c53b54e14db 100644 --- a/driver-moab/main/prep_rof_mod.F90 +++ b/driver-moab/main/prep_rof_mod.F90 @@ -12,6 +12,7 @@ module prep_rof_mod use seq_comm_mct, only: mbaxid ! iMOAB id for atm migrated mesh to coupler pes (migrate either mhid or mhpgx, depending on atm_pg_active) use seq_comm_mct, only: mbrxid ! iMOAB id of moab rof read on couple pes use seq_comm_mct, only: mbintxar ! iMOAB id for intx mesh between atm and river + use seq_comm_mct, only: mboxid use seq_comm_mct, only: mbintxlr ! iMOAB id for intx mesh between land and river use seq_comm_mct, only : atm_pg_active ! whether the atm uses FV mesh or not ; made true if fv_nphys > 0 use dimensions_mod, only : np ! for atmosphere degree @@ -51,7 +52,9 @@ module prep_rof_mod #endif public :: prep_rof_accum_lnd + public :: prep_rof_accum_lnd_moab public :: prep_rof_accum_atm + public :: prep_rof_accum_atm_moab public :: prep_rof_accum_ocn public :: prep_rof_accum_avg @@ -94,10 +97,32 @@ module prep_rof_mod type(mct_aVect), pointer :: l2racc_lx(:) ! lnd export, lnd grid, cpl pes integer , target :: l2racc_lx_cnt ! l2racc_lx: number of time samples accumulated type(mct_aVect), pointer :: a2racc_ax(:) ! atm export, atm grid, cpl pes - integer , target :: a2racc_ax_cnt ! a2racc_ax: number of time samples accumulated + integer , target :: a2racc_ax_cnt ! a2racc_ax: number of time samples accumulated type(mct_aVect), pointer :: o2racc_ox(:) ! ocn export, ocn grid, cpl pes integer , target :: o2racc_ox_cnt ! o2racc_ox: number of time samples accumulated + ! accumulation variables over moab fields + character(CXX) :: sharedFieldsLndRof ! used in moab to define l2racc_lm + real (kind=r8) , allocatable, private :: l2racc_lm(:,:) ! lnd export, lnd grid, cpl pes + real (kind=r8) , allocatable, private :: l2x_lm2(:,:) ! basically l2x_lm, but in another copy, on rof module + integer , target :: l2racc_lm_cnt ! l2racc_lm: number of time samples accumulated + integer :: nfields_sh_lr ! number of fields in sharedFieldsLndRof + integer :: lsize_lm ! size of land in moab, local + + character(CXX) :: sharedFieldsAtmRof ! used in moab to define a2racc_am + real (kind=r8) , allocatable, private :: a2racc_am(:,:) ! atm export, atm grid, cpl pes + real (kind=r8) , allocatable, private :: a2x_am2(:,:) ! basically a2x_am, but in another copy, on rof module + integer , target :: a2racc_am_cnt ! a2racc_am: number of time samples accumulated + integer :: nfields_sh_ar ! number of fields in sharedFieldsAtmRof + integer :: lsize_am ! size of atm in moab, local + + character(CXX) :: sharedFieldsOcnRof ! used in moab to define o2racc_om + real (kind=r8) , allocatable, private :: o2racc_om(:,:) ! ocn export, ocn grid, cpl pes + real (kind=r8) , allocatable, private :: o2r_rm2(:,:) ! basically o2x_om, but in another copy, on rof module + integer , target :: o2racc_om_cnt ! o2racc_om: number of time samples accumulated + integer :: nfields_sh_or ! number of fields in sharedFieldsOcnRof + integer :: lsize_om ! size of ocn in moab, local + ! other module variables integer :: mpicom_CPLID ! MPI cpl communicator @@ -127,7 +152,8 @@ module prep_rof_mod subroutine prep_rof_init(infodata, lnd_c2_rof, atm_c2_rof, ocn_c2_rof) use iMOAB, only: iMOAB_ComputeMeshIntersectionOnSphere, iMOAB_RegisterApplication, & - iMOAB_WriteMesh, iMOAB_DefineTagStorage, iMOAB_ComputeCommGraph, iMOAB_ComputeScalarProjectionWeights + iMOAB_WriteMesh, iMOAB_DefineTagStorage, iMOAB_ComputeCommGraph, & + iMOAB_ComputeScalarProjectionWeights, iMOAB_GetMeshInfo !--------------------------------------------------------------- ! Description ! Initialize module attribute vectors and all other non-mapping @@ -178,6 +204,7 @@ subroutine prep_rof_init(infodata, lnd_c2_rof, atm_c2_rof, ocn_c2_rof) integer :: type1, type2 ! type for computing graph; should be the same type for ocean, 3 (FV) integer :: tagtype, numco, tagindex character(CXX) :: tagName + integer nvert(3), nvise(3), nbl(3), nsurf(3), nvisBC(3) ! for moab info !--------------------------------------------------------------- @@ -226,7 +253,29 @@ subroutine prep_rof_init(infodata, lnd_c2_rof, atm_c2_rof, ocn_c2_rof) call mct_aVect_zero(l2racc_lx(eli)) end do l2racc_lx_cnt = 0 - +#ifdef HAVE_MOAB + ! this l2racc_lm will be over land size ? + sharedFieldsLndRof=trim( mct_aVect_exportRList2c(l2racc_lx(1)) ) + nfields_sh_lr = mct_aVect_nRAttr(l2racc_lx(1)) + tagname = trim(sharedFieldsLndRof)//C_NULL_CHAR + if(iamroot_CPLID) then + write(logunit,*) subname,' sharedFieldsLndRof=', trim(sharedFieldsLndRof), ' number of fields=', nfields_sh_lr + write(logunit,*) subname,' seq_flds_l2x_fluxes_to_rof=', trim(seq_flds_l2x_fluxes_to_rof) + endif + ! find the size of land mesh locally + ! find out the number of local elements in moab mesh lnd instance on coupler + ierr = iMOAB_GetMeshInfo ( mblxid, nvert, nvise, nbl, nsurf, nvisBC ) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in getting info ' + call shr_sys_abort(subname//' error in getting info ') + endif + ! land is fully cell now + lsize_lm = nvise(1) + allocate(l2racc_lm(lsize_lm, nfields_sh_lr)) + allocate(l2x_lm2(lsize_lm, nfields_sh_lr)) ! this will be obtained from land instance + l2racc_lm(:,:) = 0. + l2racc_lm_cnt = 0 +#endif allocate(l2r_rx(num_inst_rof)) do eri = 1,num_inst_rof call mct_avect_init(l2r_rx(eri), rList=seq_flds_l2x_fluxes_to_rof, lsize=lsize_r) @@ -395,7 +444,30 @@ subroutine prep_rof_init(infodata, lnd_c2_rof, atm_c2_rof, ocn_c2_rof) call mct_aVect_zero(a2racc_ax(eai)) end do a2racc_ax_cnt = 0 +#ifdef HAVE_MOAB + ! this a2racc_am will be over atm size + sharedFieldsAtmRof=trim( mct_aVect_exportRList2c(a2racc_ax(1)) ) + tagname = trim(sharedFieldsAtmRof)//C_NULL_CHAR + nfields_sh_ar = mct_aVect_nRAttr(a2racc_ax(1)) + if(iamroot_CPLID) then + write(logunit,*) subname,' sharedFieldsAtmRof=', trim(sharedFieldsAtmRof) + write(logunit,*) subname,' seq_flds_a2x_fields_to_rof=', trim(seq_flds_a2x_fields_to_rof) + endif + ! find the size of atm mesh locally + ! find out the number of local elements in moab mesh atm instance on coupler + ierr = iMOAB_GetMeshInfo ( mbaxid, nvert, nvise, nbl, nsurf, nvisBC ) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in getting info ' + call shr_sys_abort(subname//' error in getting info ') + endif + ! land is fully cell now + lsize_am = nvise(1) + allocate(a2racc_am(lsize_lm, nfields_sh_ar)) + allocate(a2x_am2(lsize_lm, nfields_sh_ar)) ! this will be obtained from land instance + a2racc_am(:,:) = 0. + a2racc_am_cnt = 0 +#endif allocate(a2r_rx(num_inst_rof)) do eri = 1,num_inst_rof call mct_avect_init(a2r_rx(eri), rList=seq_flds_a2x_fields_to_rof, lsize=lsize_r) @@ -563,7 +635,30 @@ subroutine prep_rof_init(infodata, lnd_c2_rof, atm_c2_rof, ocn_c2_rof) call mct_aVect_zero(o2racc_ox(eoi)) end do o2racc_ox_cnt = 0 +#ifdef HAVE_MOAB + ! this o2racc_om will be over ocn size + sharedFieldsOcnRof=trim( mct_aVect_exportRList2c(o2racc_ox(1)) ) + tagname = trim(sharedFieldsOcnRof)//C_NULL_CHAR + nfields_sh_or = mct_aVect_nRAttr(o2racc_ox(1)) + if(iamroot_CPLID) then + write(logunit,*) subname,' sharedFieldsOcnRof=', trim(sharedFieldsOcnRof) + write(logunit,*) subname,' seq_flds_o2x_fields_to_rof=', trim(seq_flds_o2x_fields_to_rof) + endif + ! find the size of ocn mesh locally + ! find out the number of local elements in moab mesh ocn instance on coupler + ierr = iMOAB_GetMeshInfo ( mboxid, nvert, nvise, nbl, nsurf, nvisBC ) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in getting info ' + call shr_sys_abort(subname//' error in getting info ') + endif + ! ocn is fully cell now + lsize_om = nvise(1) + allocate(o2racc_om(lsize_om, nfields_sh_or)) + allocate(o2r_rm2(lsize_om, nfields_sh_or)) ! this will be obtained from land instance + o2racc_om(:,:) = 0. + o2racc_om_cnt = 0 +#endif allocate(o2r_rx(num_inst_rof)) do eri = 1,num_inst_rof call mct_avect_init(o2r_rx(eri), rList=seq_flds_o2x_fields_to_rof, lsize=lsize_r) @@ -620,6 +715,47 @@ subroutine prep_rof_accum_lnd(timer) end subroutine prep_rof_accum_lnd +!================================================================================================ + subroutine prep_rof_accum_lnd_moab() + + use iMOAB , only : iMOAB_GetDoubleTagStorage + !--------------------------------------------------------------- + ! Description + ! Accumulate land input to river component + ! + ! + ! Local Variables + character(CXX) ::tagname + integer :: arrsize, ent_type, ierr + character(*), parameter :: subname = '(prep_rof_accum_lnd_moab)' + !--------------------------------------------------------------- + + ! do eli = 1,num_inst_lnd + ! l2x_lx => component_get_c2x_cx(lnd(eli)) + ! if (l2racc_lx_cnt == 0) then + ! call mct_avect_copy(l2x_lx, l2racc_lx(eli)) + ! else + ! call mct_avect_accum(l2x_lx, l2racc_lx(eli)) + ! endif + ! end do + ! first, get l2x_lm2 from land coupler instance + tagname = trim(sharedFieldsLndRof)//C_NULL_CHAR + arrsize = nfields_sh_lr * lsize_lm + ent_type = 1 ! cell type + ierr = iMOAB_GetDoubleTagStorage ( mblxid, tagname, arrsize , ent_type, l2x_lm2(1,1)) + if (ierr .ne. 0) then + call shr_sys_abort(subname//' error in getting shared fields from land instance ') + endif + ! big assumption is that l2x_lm2 is the same size as l2racc_lm + if (l2racc_lm_cnt == 0) then + l2racc_lm = l2x_lm2 + else + l2racc_lm = l2racc_lm + l2x_lm2 + endif + l2racc_lm_cnt = l2racc_lm_cnt + 1 + + end subroutine prep_rof_accum_lnd_moab + !================================================================================================ subroutine prep_rof_accum_atm(timer) @@ -653,6 +789,53 @@ subroutine prep_rof_accum_atm(timer) end subroutine prep_rof_accum_atm +!================================================================================================ + + subroutine prep_rof_accum_atm_moab() + + use iMOAB , only : iMOAB_GetDoubleTagStorage + !--------------------------------------------------------------- + ! Description + ! Accumulate atmosphere input to river component + ! + ! + ! Local Variables + character(CXX) ::tagname + integer :: arrsize, ent_type, ierr + character(*), parameter :: subname = '(prep_rof_accum_atm_moab)' + !--------------------------------------------------------------- + + tagname = trim(sharedFieldsAtmRof)//C_NULL_CHAR + arrsize = nfields_sh_ar * lsize_am + ent_type = 1 ! cell type + ierr = iMOAB_GetDoubleTagStorage ( mbaxid, tagname, arrsize , ent_type, a2x_am2(1,1)) + if (ierr .ne. 0) then + call shr_sys_abort(subname//' error in getting shared fields from atm instance ') + endif + ! big assumption is that a2x_am2 is the same size as a2racc_am + if (a2racc_am_cnt == 0) then + a2racc_am = a2x_am2 + else + a2racc_am = a2racc_am + a2x_am2 + endif + a2racc_am_cnt = a2racc_am_cnt + 1 + !--------------------------------------------------------------- + + ! call t_drvstartf (trim(timer),barrier=mpicom_CPLID) + + ! do eai = 1,num_inst_atm + ! a2x_ax => component_get_c2x_cx(atm(eai)) + ! if (a2racc_ax_cnt == 0) then + ! call mct_avect_copy(a2x_ax, a2racc_ax(eai)) + ! else + ! call mct_avect_accum(a2x_ax, a2racc_ax(eai)) + ! endif + ! end do + ! a2racc_ax_cnt = a2racc_ax_cnt + 1 + + + end subroutine prep_rof_accum_atm_moab + !================================================================================================ subroutine prep_rof_accum_ocn(timer) @@ -1182,7 +1365,7 @@ subroutine prep_rof_mrg_moab (infodata, cime_model) ! character(*),parameter :: fraclist_r = 'lfrac:lfrin:rfrac' if (first_time) then ! find out the number of local elements in moab mesh rof instance on coupler - ierr = iMOAB_GetMeshInfo ( mbrxid, nvert, nvise, nbl, nsurf, nvisBC ); + ierr = iMOAB_GetMeshInfo ( mbrxid, nvert, nvise, nbl, nsurf, nvisBC ) if (ierr .ne. 0) then write(logunit,*) subname,' error in getting info ' call shr_sys_abort(subname//' error in getting info ') From 1bae0c8ae15744d4bf05831ad99456687a3200a8 Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Sat, 29 Apr 2023 14:27:12 -0500 Subject: [PATCH 374/467] comment out --- driver-moab/main/cime_comp_mod.F90 | 20 ++++++++++++++++++-- 1 file changed, 18 insertions(+), 2 deletions(-) diff --git a/driver-moab/main/cime_comp_mod.F90 b/driver-moab/main/cime_comp_mod.F90 index 105602b31916..4bf14c69d7d6 100644 --- a/driver-moab/main/cime_comp_mod.F90 +++ b/driver-moab/main/cime_comp_mod.F90 @@ -4083,7 +4083,7 @@ subroutine cime_run_atm_recv_post() if (atm_c2_rof) then call prep_rof_accum_atm(timer='CPL:atmpost_acca2r') - call prep_rof_accum_atm_moab() + !call prep_rof_accum_atm_moab() endif call component_diag(infodata, atm, flow='c2x', comment= 'recv atm', & @@ -4093,6 +4093,19 @@ subroutine cime_run_atm_recv_post() call t_drvstopf ('CPL:ATMPOST',cplrun=.true.) endif + ! ! send projected data from atm to ocean mesh, after projection in coupler + ! if (iamin_CPLALLOCNID .and. ocn_c2_atm) then + ! ! migrate that tag from coupler pes to ocean pes + ! call prep_ocn_migrate_moab(infodata) + ! endif + + ! ! send projected data from atm to land mesh, after projection in coupler + ! if (iamin_CPLALLLNDID .and. atm_c2_lnd) then + ! ! migrate that tag from coupler pes to ocean pes + ! call prep_lnd_migrate_moab(infodata) + ! endif + + end subroutine cime_run_atm_recv_post !---------------------------------------------------------------------------------- @@ -4168,6 +4181,9 @@ subroutine cime_run_ocn_recv_post() mpicom_barrier=mpicom_CPLALLOCNID, run_barriers=run_barriers, & timer_barrier='CPL:O2CT_BARRIER', timer_comp_exch='CPL:O2CT', & timer_map_exch='CPL:o2c_ocno2ocnx', timer_infodata_exch='CPL:o2c_infoexch') + ! send from ocn pes to coupler + ! call ocn_cpl_moab(ocn) + ! new way call component_exch_moab(ocn(1), mpoid, mboxid, 0, seq_flds_o2x_fields) endif @@ -4483,7 +4499,7 @@ subroutine cime_run_lnd_recv_post() if (lnd_c2_rof) call prep_rof_accum_lnd(timer='CPL:lndpost_accl2r') #ifdef HAVE_MOAB if (lnd_c2_rof) call prep_rof_accum_lnd_moab() -#endif +#endif if (lnd_c2_glc .or. do_hist_l2x1yrg) call prep_glc_accum_lnd(timer='CPL:lndpost_accl2g' ) if (lnd_c2_iac) call prep_iac_accum(timer='CPL:lndpost_accl2z') From 7a8df6129b04d6d4891167f23050275a7df42a35 Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Sat, 29 Apr 2023 19:59:09 -0500 Subject: [PATCH 375/467] finish rof accumulating use matrix operations in fortran multiple arrays, local sizes stored --- driver-moab/main/cime_comp_mod.F90 | 11 +- driver-moab/main/prep_rof_mod.F90 | 157 +++++++++++++++++++++++++---- 2 files changed, 146 insertions(+), 22 deletions(-) diff --git a/driver-moab/main/cime_comp_mod.F90 b/driver-moab/main/cime_comp_mod.F90 index 4bf14c69d7d6..662be85ccc10 100644 --- a/driver-moab/main/cime_comp_mod.F90 +++ b/driver-moab/main/cime_comp_mod.F90 @@ -4083,7 +4083,9 @@ subroutine cime_run_atm_recv_post() if (atm_c2_rof) then call prep_rof_accum_atm(timer='CPL:atmpost_acca2r') - !call prep_rof_accum_atm_moab() +#ifdef HAVE_MOAB + call prep_rof_accum_atm_moab() +#endif endif call component_diag(infodata, atm, flow='c2x', comment= 'recv atm', & @@ -4199,7 +4201,7 @@ subroutine cime_run_ocn_recv_post() info_debug=info_debug, timer_diag='CPL:ocnpost_diagav') if (ocn_c2_rof) call prep_rof_accum_ocn(timer='CPL:ocnpost_acco2r') - !if (ocn_c2_rof) call prep_rof_accum_ocn_moab() + if (ocn_c2_rof) call prep_rof_accum_ocn_moab() call cime_run_ocnglc_coupling() @@ -4646,8 +4648,9 @@ subroutine cime_run_rof_setup_send() if (drv_threading) call seq_comm_setnthreads(nthreads_CPLID) call prep_rof_accum_avg(timer='CPL:rofprep_l2xavg') - !call prep_rof_accum_avg_moab() - +#ifdef HAVE_MOAB + call prep_rof_accum_avg_moab() +#endif if (lnd_c2_rof) call prep_rof_calc_l2r_rx(fractions_lx, timer='CPL:rofprep_lnd2rof') if (atm_c2_rof) call prep_rof_calc_a2r_rx(timer='CPL:rofprep_atm2rof') diff --git a/driver-moab/main/prep_rof_mod.F90 b/driver-moab/main/prep_rof_mod.F90 index 1c53b54e14db..06e0aafc2f21 100644 --- a/driver-moab/main/prep_rof_mod.F90 +++ b/driver-moab/main/prep_rof_mod.F90 @@ -49,12 +49,14 @@ module prep_rof_mod #ifdef HAVE_MOAB public :: prep_rof_mrg_moab + public :: prep_rof_accum_lnd_moab + public :: prep_rof_accum_atm_moab + public :: prep_rof_accum_ocn_moab + public :: prep_rof_accum_avg_moab #endif public :: prep_rof_accum_lnd - public :: prep_rof_accum_lnd_moab public :: prep_rof_accum_atm - public :: prep_rof_accum_atm_moab public :: prep_rof_accum_ocn public :: prep_rof_accum_avg @@ -118,7 +120,7 @@ module prep_rof_mod character(CXX) :: sharedFieldsOcnRof ! used in moab to define o2racc_om real (kind=r8) , allocatable, private :: o2racc_om(:,:) ! ocn export, ocn grid, cpl pes - real (kind=r8) , allocatable, private :: o2r_rm2(:,:) ! basically o2x_om, but in another copy, on rof module + real (kind=r8) , allocatable, private :: o2r_om2(:,:) ! basically o2x_om, but in another copy, on rof module, only shared with rof integer , target :: o2racc_om_cnt ! o2racc_om: number of time samples accumulated integer :: nfields_sh_or ! number of fields in sharedFieldsOcnRof integer :: lsize_om ! size of ocn in moab, local @@ -258,10 +260,6 @@ subroutine prep_rof_init(infodata, lnd_c2_rof, atm_c2_rof, ocn_c2_rof) sharedFieldsLndRof=trim( mct_aVect_exportRList2c(l2racc_lx(1)) ) nfields_sh_lr = mct_aVect_nRAttr(l2racc_lx(1)) tagname = trim(sharedFieldsLndRof)//C_NULL_CHAR - if(iamroot_CPLID) then - write(logunit,*) subname,' sharedFieldsLndRof=', trim(sharedFieldsLndRof), ' number of fields=', nfields_sh_lr - write(logunit,*) subname,' seq_flds_l2x_fluxes_to_rof=', trim(seq_flds_l2x_fluxes_to_rof) - endif ! find the size of land mesh locally ! find out the number of local elements in moab mesh lnd instance on coupler ierr = iMOAB_GetMeshInfo ( mblxid, nvert, nvise, nbl, nsurf, nvisBC ) @@ -271,6 +269,12 @@ subroutine prep_rof_init(infodata, lnd_c2_rof, atm_c2_rof, ocn_c2_rof) endif ! land is fully cell now lsize_lm = nvise(1) + if(iamroot_CPLID) then + write(logunit,*) subname,' number of fields=', nfields_sh_lr + write(logunit,*) subname,' sharedFieldsLndRof=', trim(sharedFieldsLndRof) + write(logunit,*) subname,' seq_flds_l2x_fluxes_to_rof=', trim(seq_flds_l2x_fluxes_to_rof) + write(logunit,*) subname,' lsize_lm=', lsize_lm + endif allocate(l2racc_lm(lsize_lm, nfields_sh_lr)) allocate(l2x_lm2(lsize_lm, nfields_sh_lr)) ! this will be obtained from land instance l2racc_lm(:,:) = 0. @@ -449,10 +453,6 @@ subroutine prep_rof_init(infodata, lnd_c2_rof, atm_c2_rof, ocn_c2_rof) sharedFieldsAtmRof=trim( mct_aVect_exportRList2c(a2racc_ax(1)) ) tagname = trim(sharedFieldsAtmRof)//C_NULL_CHAR nfields_sh_ar = mct_aVect_nRAttr(a2racc_ax(1)) - if(iamroot_CPLID) then - write(logunit,*) subname,' sharedFieldsAtmRof=', trim(sharedFieldsAtmRof) - write(logunit,*) subname,' seq_flds_a2x_fields_to_rof=', trim(seq_flds_a2x_fields_to_rof) - endif ! find the size of atm mesh locally ! find out the number of local elements in moab mesh atm instance on coupler ierr = iMOAB_GetMeshInfo ( mbaxid, nvert, nvise, nbl, nsurf, nvisBC ) @@ -462,8 +462,14 @@ subroutine prep_rof_init(infodata, lnd_c2_rof, atm_c2_rof, ocn_c2_rof) endif ! land is fully cell now lsize_am = nvise(1) - allocate(a2racc_am(lsize_lm, nfields_sh_ar)) - allocate(a2x_am2(lsize_lm, nfields_sh_ar)) ! this will be obtained from land instance + allocate(a2racc_am(lsize_am, nfields_sh_ar)) + allocate(a2x_am2(lsize_am, nfields_sh_ar)) ! this will be obtained from atm instance + if(iamroot_CPLID) then + write(logunit,*) subname,' sharedFieldsAtmRof=', trim(sharedFieldsAtmRof) + write(logunit,*) subname,' number of fields shared=', nfields_sh_ar + write(logunit,*) subname,' seq_flds_a2x_fields_to_rof=', trim(seq_flds_a2x_fields_to_rof) + write(logunit,*) subname,' lsize_am=', lsize_am + endif a2racc_am(:,:) = 0. a2racc_am_cnt = 0 @@ -641,10 +647,7 @@ subroutine prep_rof_init(infodata, lnd_c2_rof, atm_c2_rof, ocn_c2_rof) sharedFieldsOcnRof=trim( mct_aVect_exportRList2c(o2racc_ox(1)) ) tagname = trim(sharedFieldsOcnRof)//C_NULL_CHAR nfields_sh_or = mct_aVect_nRAttr(o2racc_ox(1)) - if(iamroot_CPLID) then - write(logunit,*) subname,' sharedFieldsOcnRof=', trim(sharedFieldsOcnRof) - write(logunit,*) subname,' seq_flds_o2x_fields_to_rof=', trim(seq_flds_o2x_fields_to_rof) - endif + ! find the size of ocn mesh locally ! find out the number of local elements in moab mesh ocn instance on coupler ierr = iMOAB_GetMeshInfo ( mboxid, nvert, nvise, nbl, nsurf, nvisBC ) @@ -655,7 +658,13 @@ subroutine prep_rof_init(infodata, lnd_c2_rof, atm_c2_rof, ocn_c2_rof) ! ocn is fully cell now lsize_om = nvise(1) allocate(o2racc_om(lsize_om, nfields_sh_or)) - allocate(o2r_rm2(lsize_om, nfields_sh_or)) ! this will be obtained from land instance + allocate(o2r_om2(lsize_om, nfields_sh_or)) ! this will be obtained from ocn instance + if(iamroot_CPLID) then + write(logunit,*) subname,' sharedFieldsOcnRof=', trim(sharedFieldsOcnRof) + write(logunit,*) subname,' number of field shared ocn rof=',nfields_sh_or + write(logunit,*) subname,' seq_flds_o2x_fields_to_rof=', trim(seq_flds_o2x_fields_to_rof) + write(logunit,*) subname,' lsize_om=', lsize_om + endif o2racc_om(:,:) = 0. o2racc_om_cnt = 0 #endif @@ -868,6 +877,59 @@ subroutine prep_rof_accum_ocn(timer) end subroutine prep_rof_accum_ocn +subroutine prep_rof_accum_ocn_moab() + + !--------------------------------------------------------------- + ! Description + ! Accumulate ocean input to river component + ! + ! + ! Local Variables + +use iMOAB , only : iMOAB_GetDoubleTagStorage + !--------------------------------------------------------------- + ! Description + ! Accumulate atmosphere input to river component + ! + ! + ! Local Variables + character(CXX) ::tagname + integer :: arrsize, ent_type, ierr + character(*), parameter :: subname = '(prep_rof_accum_ocn_moab)' + !--------------------------------------------------------------- + + tagname = trim(sharedFieldsOcnRof)//C_NULL_CHAR + arrsize = nfields_sh_or * lsize_om + ent_type = 1 ! cell type + ierr = iMOAB_GetDoubleTagStorage ( mboxid, tagname, arrsize , ent_type, o2r_om2(1,1)) + if (ierr .ne. 0) then + call shr_sys_abort(subname//' error in getting shared fields from ocn instance ') + endif + ! big assumption is that o2r_om2 is the same size as o2racc_om + if (o2racc_om_cnt == 0) then + o2racc_om = o2r_om2 + else + o2racc_om = o2racc_om + o2r_om2 + endif + o2racc_om_cnt = o2racc_om_cnt + 1 + + + !--------------------------------------------------------------- + + + ! do eoi = 1,num_inst_ocn + ! o2x_ox => component_get_c2x_cx(ocn(eoi)) + ! if (o2racc_ox_cnt == 0) then + ! call mct_avect_copy(o2x_ox, o2racc_ox(eoi)) + ! else + ! call mct_avect_accum(o2x_ox, o2racc_ox(eoi)) + ! endif + ! end do + ! o2racc_ox_cnt = o2racc_ox_cnt + 1 + + + end subroutine prep_rof_accum_ocn_moab + !================================================================================================ subroutine prep_rof_accum_avg(timer) @@ -913,6 +975,65 @@ subroutine prep_rof_accum_avg(timer) end subroutine prep_rof_accum_avg + !================================================================================================ + + subroutine prep_rof_accum_avg_moab() + + !--------------------------------------------------------------- + ! Description + ! Finalize accumulation of land, atm, ocn input to river component + use iMOAB, only : iMOAB_SetDoubleTagStorage + ! Arguments + ! + ! Local Variables + character(CXX) ::tagname + integer :: arrsize, ent_type, ierr + character(*), parameter :: subname = '(prep_rof_accum_avg_moab)' + !--------------------------------------------------------------- + if(l2racc_lm_cnt > 1) then + l2racc_lm = 1./l2racc_lm_cnt*l2racc_lm + endif + l2racc_lm_cnt = 0 + ! set now the accumulated fields on land instance + tagname = trim(sharedFieldsLndRof)//C_NULL_CHAR + arrsize = nfields_sh_lr * lsize_lm + ent_type = 1 ! cell type + ierr = iMOAB_SetDoubleTagStorage ( mblxid, tagname, arrsize , ent_type, l2racc_lm(1,1)) + if (ierr .ne. 0) then + call shr_sys_abort(subname//' error in setting accumulated shared fields on rof on land instance ') + endif + + + if((a2racc_am_cnt > 1) .and. rof_heat) then + a2racc_am = 1./a2racc_am_cnt * a2racc_am + endif + a2racc_am_cnt = 0 + ! set now the accumulated fields on atm instance + tagname = trim(sharedFieldsAtmRof)//C_NULL_CHAR + arrsize = nfields_sh_ar * lsize_am + ent_type = 1 ! cell type + ierr = iMOAB_SetDoubleTagStorage ( mbaxid, tagname, arrsize , ent_type, a2racc_am(1,1)) + if (ierr .ne. 0) then + call shr_sys_abort(subname//' error in setting accumulated shared fields on rof on atm instance ') + endif + + if(o2racc_om_cnt > 1) then + o2racc_om = 1./o2racc_om_cnt *o2racc_om + endif + o2racc_om_cnt = 0 + ! set now the accumulated fields on ocn instance + tagname = trim(sharedFieldsOcnRof)//C_NULL_CHAR + arrsize = nfields_sh_or * lsize_om + ent_type = 1 ! cell type + ierr = iMOAB_SetDoubleTagStorage ( mboxid, tagname, arrsize , ent_type, o2racc_om(1,1)) + if (ierr .ne. 0) then + call shr_sys_abort(subname//' error in setting accumulated shared fields on rof on ocn instance ') + endif + + + end subroutine prep_rof_accum_avg_moab + + !================================================================================================ subroutine prep_rof_mrg(infodata, fractions_rx, timer_mrg, cime_model) From e9e22d9483ccbcdacb2c2bcde29e276a1a719313 Mon Sep 17 00:00:00 2001 From: Vijay Mahadevan Date: Thu, 23 Mar 2023 11:07:55 -0500 Subject: [PATCH 376/467] Update MOAB drivers to use the new API that takes a FV method parameter; necessary for bilinear and variants --- driver-moab/main/prep_atm_mod.F90 | 6 +++--- driver-moab/main/prep_ice_mod.F90 | 4 ++-- driver-moab/main/prep_lnd_mod.F90 | 4 ++-- driver-moab/main/prep_ocn_mod.F90 | 2 +- driver-moab/main/prep_rof_mod.F90 | 4 ++-- 5 files changed, 10 insertions(+), 10 deletions(-) diff --git a/driver-moab/main/prep_atm_mod.F90 b/driver-moab/main/prep_atm_mod.F90 index 3a7e0a5ed8b3..c2c606edbbe3 100644 --- a/driver-moab/main/prep_atm_mod.F90 +++ b/driver-moab/main/prep_atm_mod.F90 @@ -328,7 +328,7 @@ subroutine prep_atm_init(infodata, ocn_c2_atm, ice_c2_atm, lnd_c2_atm, iac_c2_at trim(dofnameS), trim(dofnameT) endif ierr = iMOAB_ComputeScalarProjectionWeights ( mbintxoa, wgtIdef, & - trim(dm1), orderS, trim(dm2), orderT, & + trim(dm1), orderS, trim(dm2), orderT, ''//C_NULL_CHAR, & fNoBubble, monotonicity, volumetric, fInverseDistanceMap, & noConserve, validate, & trim(dofnameS), trim(dofnameT) ) @@ -531,7 +531,7 @@ subroutine prep_atm_init(infodata, ocn_c2_atm, ice_c2_atm, lnd_c2_atm, iac_c2_at trim(dofnameS), trim(dofnameT) endif ierr = iMOAB_ComputeScalarProjectionWeights ( mbintxia, wgtIdef, & - trim(dm1), orderS, trim(dm2), orderT, & + trim(dm1), orderS, trim(dm2), orderT, ''//C_NULL_CHAR, & fNoBubble, monotonicity, volumetric, fInverseDistanceMap, & noConserve, validate, & trim(dofnameS), trim(dofnameT) ) @@ -682,7 +682,7 @@ subroutine prep_atm_init(infodata, ocn_c2_atm, ice_c2_atm, lnd_c2_atm, iac_c2_at trim(dofnameS), trim(dofnameT) endif ierr = iMOAB_ComputeScalarProjectionWeights ( mbintxla, wgtIdef, & - trim(dm1), orderS, trim(dm2), orderT, & + trim(dm1), orderS, trim(dm2), orderT, ''//C_NULL_CHAR, & fNoBubble, monotonicity, volumetric, fInverseDistanceMap, & noConserve, validate, & trim(dofnameS), trim(dofnameT) ) diff --git a/driver-moab/main/prep_ice_mod.F90 b/driver-moab/main/prep_ice_mod.F90 index aa4dadc0dc79..666e91481115 100644 --- a/driver-moab/main/prep_ice_mod.F90 +++ b/driver-moab/main/prep_ice_mod.F90 @@ -93,8 +93,8 @@ module prep_ice_mod subroutine prep_ice_init(infodata, ocn_c2_ice, glc_c2_ice, glcshelf_c2_ice, rof_c2_ice) - use iMOAB, only: iMOAB_ComputeMeshIntersectionOnSphere, iMOAB_RegisterApplication, & - iMOAB_WriteMesh, iMOAB_DefineTagStorage, iMOAB_ComputeCommGraph, iMOAB_ComputeScalarProjectionWeights + use iMOAB, only: iMOAB_RegisterApplication, & + iMOAB_WriteMesh, iMOAB_DefineTagStorage, iMOAB_ComputeCommGraph !--------------------------------------------------------------- ! Description ! Initialize module attribute vectors and all other non-mapping diff --git a/driver-moab/main/prep_lnd_mod.F90 b/driver-moab/main/prep_lnd_mod.F90 index 8986e89a5277..c1de54e2570d 100644 --- a/driver-moab/main/prep_lnd_mod.F90 +++ b/driver-moab/main/prep_lnd_mod.F90 @@ -311,7 +311,7 @@ subroutine prep_lnd_init(infodata, atm_c2_lnd, rof_c2_lnd, glc_c2_lnd, iac_c2_ln trim(dofnameS), trim(dofnameT) endif ierr = iMOAB_ComputeScalarProjectionWeights ( mbintxrl, wgtIdef, & - trim(dm1), orderS, trim(dm2), orderT, & + trim(dm1), orderS, trim(dm2), orderT, ''//C_NULL_CHAR, & fNoBubble, monotonicity, volumetric, fInverseDistanceMap, & noConserve, validate, & trim(dofnameS), trim(dofnameT) ) @@ -476,7 +476,7 @@ subroutine prep_lnd_init(infodata, atm_c2_lnd, rof_c2_lnd, glc_c2_lnd, iac_c2_ln trim(dofnameS), trim(dofnameT) endif ierr = iMOAB_ComputeScalarProjectionWeights ( mbintxal, wgtIdef, & - trim(dm1), orderS, trim(dm2), orderT, & + trim(dm1), orderS, trim(dm2), orderT, ''//C_NULL_CHAR, & fNoBubble, monotonicity, volumetric, fInverseDistanceMap, & noConserve, validate, & trim(dofnameS), trim(dofnameT) ) diff --git a/driver-moab/main/prep_ocn_mod.F90 b/driver-moab/main/prep_ocn_mod.F90 index 63299ee93df3..76be27730eed 100644 --- a/driver-moab/main/prep_ocn_mod.F90 +++ b/driver-moab/main/prep_ocn_mod.F90 @@ -440,7 +440,7 @@ subroutine prep_ocn_init(infodata, atm_c2_ocn, atm_c2_ice, ice_c2_ocn, rof_c2_oc trim(dofnameS), trim(dofnameT) endif ierr = iMOAB_ComputeScalarProjectionWeights ( mbintxao, wgtIdef, & - trim(dm1), orderS, trim(dm2), orderT, & + trim(dm1), orderS, trim(dm2), orderT, ''//C_NULL_CHAR, & fNoBubble, monotonicity, volumetric, fInverseDistanceMap, & noConserve, validate, & trim(dofnameS), trim(dofnameT) ) diff --git a/driver-moab/main/prep_rof_mod.F90 b/driver-moab/main/prep_rof_mod.F90 index 06e0aafc2f21..41062b905349 100644 --- a/driver-moab/main/prep_rof_mod.F90 +++ b/driver-moab/main/prep_rof_mod.F90 @@ -393,7 +393,7 @@ subroutine prep_rof_init(infodata, lnd_c2_rof, atm_c2_rof, ocn_c2_rof) trim(dofnameS), trim(dofnameT) endif ierr = iMOAB_ComputeScalarProjectionWeights ( mbintxlr, wgtIdef, & - trim(dm1), orderS, trim(dm2), orderT, & + trim(dm1), orderS, trim(dm2), orderT, ''//C_NULL_CHAR, & fNoBubble, monotonicity, volumetric, fInverseDistanceMap, & noConserve, validate, & trim(dofnameS), trim(dofnameT) ) @@ -575,7 +575,7 @@ subroutine prep_rof_init(infodata, lnd_c2_rof, atm_c2_rof, ocn_c2_rof) trim(dofnameS), trim(dofnameT) endif ierr = iMOAB_ComputeScalarProjectionWeights ( mbintxar, wgtIdef, & - trim(dm1), orderS, trim(dm2), orderT, & + trim(dm1), orderS, trim(dm2), orderT, ''//C_NULL_CHAR, & fNoBubble, monotonicity, volumetric, fInverseDistanceMap, & noConserve, validate, & trim(dofnameS), trim(dofnameT) ) From 57695fe31a2392e35fcfa70e1132225266d4c0cd Mon Sep 17 00:00:00 2001 From: Vijay Mahadevan Date: Fri, 7 Apr 2023 13:36:34 -0500 Subject: [PATCH 377/467] Add bilinear mapping weights generation for some scalar fields --- driver-moab/main/prep_atm_mod.F90 | 148 ++++++++++---------- driver-moab/main/prep_ice_mod.F90 | 20 +-- driver-moab/main/prep_ocn_mod.F90 | 222 ++++++++++++++++++------------ driver-moab/main/seq_map_mod.F90 | 17 +-- 4 files changed, 228 insertions(+), 179 deletions(-) diff --git a/driver-moab/main/prep_atm_mod.F90 b/driver-moab/main/prep_atm_mod.F90 index c2c606edbbe3..4336a80d4ae8 100644 --- a/driver-moab/main/prep_atm_mod.F90 +++ b/driver-moab/main/prep_atm_mod.F90 @@ -104,11 +104,11 @@ module prep_atm_mod ! other module variables integer :: mpicom_CPLID ! MPI cpl communicator logical :: iamroot_CPLID ! .true. => CPLID masterproc - + #ifdef HAVE_MOAB real (kind=r8) , allocatable, private :: fractions_am (:,:) ! will retrieve the fractions from atm, and use them - ! they were init with - ! character(*),parameter :: fraclist_a = 'afrac:ifrac:ofrac:ifrad:ofrad' in moab, on the fractions + ! they were init with + ! character(*),parameter :: fraclist_a = 'afrac:ifrac:ofrac:ifrad:ofrad' in moab, on the fractions real (kind=r8) , allocatable, private :: x2a_am (:,:) real (kind=r8) , allocatable, private :: l2x_am (:,:) real (kind=r8) , allocatable, private :: i2x_am (:,:) @@ -260,10 +260,10 @@ subroutine prep_atm_init(infodata, ocn_c2_atm, ice_c2_atm, lnd_c2_atm, iac_c2_at endif - ! we also need to compute the comm graph for the second hop, from the ocn on coupler to the + ! we also need to compute the comm graph for the second hop, from the ocn on coupler to the ! ocean for the intx ocean-atm context (coverage) - ! - call seq_comm_getinfo(CPLID ,mpigrp=mpigrp_CPLID) + ! + call seq_comm_getinfo(CPLID ,mpigrp=mpigrp_CPLID) type1 = 3; ! fv for ocean and atm; fv-cgll does not work anyway type2 = 3; ! ierr = iMOAB_ComputeCommGraph( mboxid, mbintxoa, &mpicom_CPLID, &mpigrp_CPLID, &mpigrp_CPLID, &type1, &type2, @@ -275,34 +275,34 @@ subroutine prep_atm_init(infodata, ocn_c2_atm, ice_c2_atm, lnd_c2_atm, iac_c2_at call shr_sys_abort(subname//' ERROR in computing comm graph for second hop, ocn-atm') endif - ! now take care of the mapper + ! now take care of the mapper mapper_So2a%src_mbid = mboxid - mapper_So2a%tgt_mbid = mbaxid ! - mapper_So2a%intx_mbid = mbintxoa + mapper_So2a%tgt_mbid = mbaxid ! + mapper_So2a%intx_mbid = mbintxoa mapper_So2a%src_context = ocn(1)%cplcompid mapper_So2a%intx_context = idintx wgtIdef = 'scalar'//C_NULL_CHAR mapper_So2a%weight_identifier = wgtIdef mapper_So2a%mbname = 'mapper_So2a' - ! because we will project fields from ocean to atm phys grid, we need to define + ! because we will project fields from ocean to atm phys grid, we need to define ! ocean o2x fields to atm phys grid (or atm spectral ext ) on coupler side if (atm_pg_active) then tagname = trim(seq_flds_o2x_fields)//C_NULL_CHAR tagtype = 1 ! dense - numco = 1 ! + numco = 1 ! ierr = iMOAB_DefineTagStorage(mbaxid, tagname, tagtype, numco, tagindex ) if (ierr .ne. 0) then write(logunit,*) subname,' error in defining tags for seq_flds_o2x_fields' call shr_sys_abort(subname//' ERROR in coin defining tags for seq_flds_o2x_fields') endif else ! spectral case, fix later TODO - numco = np*np ! - endif ! + numco = np*np ! + endif ! + + volumetric = 0 ! can be 1 only for FV->DGLL or FV->CGLL; - volumetric = 0 ! can be 1 only for FV->DGLL or FV->CGLL; - if (atm_pg_active) then dm2 = "fv"//C_NULL_CHAR dofnameT="GLOBAL_ID"//C_NULL_CHAR @@ -350,7 +350,7 @@ subroutine prep_atm_init(infodata, ocn_c2_atm, ice_c2_atm, lnd_c2_atm, iac_c2_at call shr_sys_abort(subname//' ERROR in writing intx file ') endif endif -! endif for MOABDEBUG +! endif for MOABDEBUG #endif endif ! if ((mbaxid .ge. 0) .and. (mboxid .ge. 0)) then @@ -362,9 +362,9 @@ subroutine prep_atm_init(infodata, ocn_c2_atm, ice_c2_atm, lnd_c2_atm, iac_c2_at call seq_comm_getinfo(CPLID ,mpigrp=mpigrp_CPLID) type1 = 3; ! fv for ocean and atm; fv-cgll does not work anyway type2 = 3; - ! we ideintified the app mbofxid with !id_join = id_join + 1000! kind of random + ! we ideintified the app mbofxid with !id_join = id_join + 1000! kind of random ! line 1267 in cplcomp_exchange_mod.F90 - context_id = ocn(1)%cplcompid + 1000 + context_id = ocn(1)%cplcompid + 1000 ierr = iMOAB_ComputeCommGraph( mbofxid, mbintxoa, mpicom_CPLID, mpigrp_CPLID, mpigrp_CPLID, type1, type2, & context_id, idintx) if (ierr .ne. 0) then @@ -383,8 +383,8 @@ subroutine prep_atm_init(infodata, ocn_c2_atm, ice_c2_atm, lnd_c2_atm, iac_c2_at endif ! endif for HAVE_MOAB -#endif - +#endif + endif ! if (ocn_c2_atm) then ! needed for domain checking @@ -409,16 +409,16 @@ subroutine prep_atm_init(infodata, ocn_c2_atm, ice_c2_atm, lnd_c2_atm, iac_c2_at ! copy mapper_So2a , maybe change the matrix ? still based on intersection ? #ifdef HAVE_MOAB if ((mbaxid .ge. 0) .and. (mboxid .ge. 0)) then - ! now take care of the mapper + ! now take care of the mapper mapper_Fo2a%src_mbid = mboxid mapper_Fo2a%tgt_mbid = mbaxid - mapper_Fo2a%intx_mbid = mbintxoa + mapper_Fo2a%intx_mbid = mbintxoa mapper_Fo2a%src_context = ocn(1)%cplcompid mapper_Fo2a%intx_context = idintx wgtIdef = 'scalar'//C_NULL_CHAR mapper_Fo2a%weight_identifier = wgtIdef mapper_Fo2a%mbname = 'mapper_Fo2a' - endif + endif if ((mbaxid .ge. 0) .and. (mbofxid .ge. 0)) then mapper_Fof2a%src_mbid = mbofxid mapper_Fof2a%tgt_mbid = mbaxid @@ -430,7 +430,7 @@ subroutine prep_atm_init(infodata, ocn_c2_atm, ice_c2_atm, lnd_c2_atm, iac_c2_at mapper_Fof2a%mbname = 'mapper_Fof2a' endif ! endif for HAVE_MOAB -#endif +#endif endif ! endif (ocn_present) then call shr_sys_flush(logunit) @@ -466,10 +466,10 @@ subroutine prep_atm_init(infodata, ocn_c2_atm, ice_c2_atm, lnd_c2_atm, iac_c2_at endif - ! we also need to compute the comm graph for the second hop, from the ice on coupler to the + ! we also need to compute the comm graph for the second hop, from the ice on coupler to the ! ice for the intx ice-atm context (coverage) - ! - call seq_comm_getinfo(CPLID ,mpigrp=mpigrp_CPLID) + ! + call seq_comm_getinfo(CPLID ,mpigrp=mpigrp_CPLID) type1 = 3; ! fv for ice and atm; fv-cgll does not work anyway type2 = 3; ! ierr = iMOAB_ComputeCommGraph( mboxid, mbintxoa, &mpicom_CPLID, &mpigrp_CPLID, &mpigrp_CPLID, &type1, &type2, @@ -480,21 +480,21 @@ subroutine prep_atm_init(infodata, ocn_c2_atm, ice_c2_atm, lnd_c2_atm, iac_c2_at write(logunit,*) subname,' error in computing comm graph for second hop, ice-atm' call shr_sys_abort(subname//' ERROR in computing comm graph for second hop, ice-atm') endif - ! now take care of the mapper + ! now take care of the mapper mapper_Si2a%src_mbid = mbixid mapper_Si2a%tgt_mbid = mbaxid - mapper_Si2a%intx_mbid = mbintxia + mapper_Si2a%intx_mbid = mbintxia mapper_Si2a%src_context = ice(1)%cplcompid mapper_Si2a%intx_context = idintx wgtIdef = 'scalar'//C_NULL_CHAR mapper_Si2a%weight_identifier = wgtIdef mapper_Si2a%mbname = 'mapper_Si2a' - ! because we will project fields from ocean to atm phys grid, we need to define + ! because we will project fields from ocean to atm phys grid, we need to define ! ice i2x fields to atm phys grid (or atm spectral ext ) on coupler side if (atm_pg_active) then tagname = trim(seq_flds_i2x_fields)//C_NULL_CHAR tagtype = 1 ! dense - numco = 1 ! + numco = 1 ! ierr = iMOAB_DefineTagStorage(mbaxid, tagname, tagtype, numco, tagindex ) if (ierr .ne. 0) then write(logunit,*) subname,' error in defining tags for seq_flds_i2x_fields' @@ -504,8 +504,8 @@ subroutine prep_atm_init(infodata, ocn_c2_atm, ice_c2_atm, lnd_c2_atm, iac_c2_at tagtype = 1 ! dense endif - volumetric = 0 ! can be 1 only for FV->DGLL or FV->CGLL; - + volumetric = 0 ! can be 1 only for FV->DGLL or FV->CGLL; + if (atm_pg_active) then dm2 = "fv"//C_NULL_CHAR dofnameT="GLOBAL_ID"//C_NULL_CHAR @@ -553,11 +553,11 @@ subroutine prep_atm_init(infodata, ocn_c2_atm, ice_c2_atm, lnd_c2_atm, iac_c2_at call shr_sys_abort(subname//' ERROR in writing intx file ice-atm ') endif endif -! endif for MOABDEBUG +! endif for MOABDEBUG #endif endif ! if ((mbaxid .ge. 0) .and. (mbixid .ge. 0)) then ! endif for HAVE_MOAB -#endif +#endif endif ! if (ice_c2_atm) then @@ -570,16 +570,16 @@ subroutine prep_atm_init(infodata, ocn_c2_atm, ice_c2_atm, lnd_c2_atm, iac_c2_at call seq_map_init_rcfile(mapper_Fi2a, ice(1), atm(1), & 'seq_maps.rc','ice2atm_fmapname:','ice2atm_fmaptype:',samegrid_ao, & 'mapper_Fi2a initialization',esmf_map_flag) - + #ifdef HAVE_MOAB ! now take care of the mapper for MOAB mapper_Fi2a%src_mbid = mbixid mapper_Fi2a%tgt_mbid = mbaxid - mapper_Fi2a%intx_mbid = mbintxia + mapper_Fi2a%intx_mbid = mbintxia mapper_Fi2a%src_context = ice(1)%cplcompid mapper_Fi2a%intx_context = idintx wgtIdef = 'scalar'//C_NULL_CHAR - mapper_Fi2a%weight_identifier = wgtIdef + mapper_Fi2a%weight_identifier = wgtIdef mapper_Fi2a%mbname = 'mapper_Fi2a' #endif endif ! if (ice_present) then @@ -596,9 +596,9 @@ subroutine prep_atm_init(infodata, ocn_c2_atm, ice_c2_atm, lnd_c2_atm, iac_c2_at 'mapper_Fl2a initialization',esmf_map_flag) #ifdef HAVE_MOAB - ! important change: do not compute intx at all between atm and land when we have samegrid_al + ! important change: do not compute intx at all between atm and land when we have samegrid_al ! we will use just a comm graph to send data from phys grid to land on coupler - ! this is just a rearrange in a way + ! this is just a rearrange in a way if ((mbaxid .ge. 0) .and. (mblxid .ge. 0) ) then appname = "LND_ATM_COU"//C_NULL_CHAR ! idintx is a unique number of MOAB app that takes care of intx between lnd and atm mesh @@ -609,12 +609,12 @@ subroutine prep_atm_init(infodata, ocn_c2_atm, ice_c2_atm, lnd_c2_atm, iac_c2_at call shr_sys_abort(subname//' ERROR in registering lnd atm intx ') endif mapper_Fl2a%src_mbid = mblxid - mapper_Fl2a%tgt_mbid = mbaxid ! + mapper_Fl2a%tgt_mbid = mbaxid ! mapper_Fl2a%intx_mbid = mbintxla mapper_Fl2a%src_context = lnd(1)%cplcompid mapper_Fl2a%intx_context = idintx wgtIdef = 'scalar'//C_NULL_CHAR - mapper_Fl2a%weight_identifier = wgtIdef + mapper_Fl2a%weight_identifier = wgtIdef mapper_Fl2a%mbname = 'mapper_Fl2a' if (.not. samegrid_al) then ! tri grid case @@ -640,23 +640,23 @@ subroutine prep_atm_init(infodata, ocn_c2_atm, ice_c2_atm, lnd_c2_atm, iac_c2_at endif endif #endif - - ! we also need to compute the comm graph for the second hop, from the lnd on coupler to the + + ! we also need to compute the comm graph for the second hop, from the lnd on coupler to the ! lnd for the intx lnd-atm context (coverage) - ! - call seq_comm_getinfo(CPLID ,mpigrp=mpigrp_CPLID) + ! + call seq_comm_getinfo(CPLID ,mpigrp=mpigrp_CPLID) type1 = 3; ! fv for lnd and atm; fv-cgll does not work anyway type2 = 3; - + ierr = iMOAB_ComputeCommGraph( mblxid, mbintxla, mpicom_CPLID, mpigrp_CPLID, mpigrp_CPLID, type1, type2, & lnd(1)%cplcompid, idintx) if (ierr .ne. 0) then write(logunit,*) subname,' error in computing comm graph for second hop, ice-atm' call shr_sys_abort(subname//' ERROR in computing comm graph for second hop, ice-atm') endif - ! need to compute weigths - volumetric = 0 ! can be 1 only for FV->DGLL or FV->CGLL; - + ! need to compute weigths + volumetric = 0 ! can be 1 only for FV->DGLL or FV->CGLL; + if (atm_pg_active) then dm2 = "fv"//C_NULL_CHAR dofnameT="GLOBAL_ID"//C_NULL_CHAR @@ -691,9 +691,9 @@ subroutine prep_atm_init(infodata, ocn_c2_atm, ice_c2_atm, lnd_c2_atm, iac_c2_at call shr_sys_abort(subname//' error in iMOAB_ComputeScalarProjectionWeights lnd atm ') endif - else ! the same mesh , atm and lnd use the same dofs, but restricted + else ! the same mesh , atm and lnd use the same dofs, but restricted ! we do not compute intersection, so we will have to just send data from atm to land and viceversa, by GLOBAL_ID matching - ! so we compute just a comm graph, between lnd and atm dofs, on the coupler; target is atm + ! so we compute just a comm graph, between lnd and atm dofs, on the coupler; target is atm ! land is point cloud in this case, type1 = 2 type1 = 3; ! full mesh for land now type2 = 3; ! fv for target atm @@ -704,7 +704,7 @@ subroutine prep_atm_init(infodata, ocn_c2_atm, ice_c2_atm, lnd_c2_atm, iac_c2_at call shr_sys_abort(subname//' ERROR in computing comm graph for second hop, lnd-atm') endif ! context for rearrange is target in this case - mapper_Fl2a%tgt_mbid = mbaxid + mapper_Fl2a%tgt_mbid = mbaxid mapper_Fl2a%intx_context = atm(1)%cplcompid endif ! if tri-grid @@ -712,7 +712,7 @@ subroutine prep_atm_init(infodata, ocn_c2_atm, ice_c2_atm, lnd_c2_atm, iac_c2_at if (atm_pg_active) then tagname = trim(seq_flds_l2x_fields)//C_NULL_CHAR tagtype = 1 ! dense - numco = 1 ! + numco = 1 ! ierr = iMOAB_DefineTagStorage(mbaxid, tagname, tagtype, numco, tagindex ) if (ierr .ne. 0) then write(logunit,*) subname,' error in defining tags for seq_flds_l2x_fields' @@ -721,8 +721,8 @@ subroutine prep_atm_init(infodata, ocn_c2_atm, ice_c2_atm, lnd_c2_atm, iac_c2_at else ! spectral case, TODO tagtype = 1 ! dense endif - endif ! if ((mbaxid .ge. 0) .and. (mblxid .ge. 0) ) then -#endif + endif ! if ((mbaxid .ge. 0) .and. (mblxid .ge. 0) ) then +#endif endif ! if lnd_present call shr_sys_flush(logunit) @@ -737,12 +737,12 @@ subroutine prep_atm_init(infodata, ocn_c2_atm, ice_c2_atm, lnd_c2_atm, iac_c2_at #ifdef HAVE_MOAB if ((mbaxid .ge. 0) .and. (mblxid .ge. 0) ) then mapper_Sl2a%src_mbid = mblxid - mapper_Sl2a%tgt_mbid = mapper_Fl2a%tgt_mbid ! + mapper_Sl2a%tgt_mbid = mapper_Fl2a%tgt_mbid ! mapper_Sl2a%intx_mbid = mbintxla mapper_Sl2a%src_context = lnd(1)%cplcompid mapper_Sl2a%intx_context = mapper_Fl2a%intx_context wgtIdef = 'scalar'//C_NULL_CHAR - mapper_Sl2a%weight_identifier = wgtIdef + mapper_Sl2a%weight_identifier = wgtIdef mapper_Sl2a%mbname = 'mapper_Sl2a' endif #endif @@ -751,7 +751,7 @@ subroutine prep_atm_init(infodata, ocn_c2_atm, ice_c2_atm, lnd_c2_atm, iac_c2_at endif ! if atm_present end subroutine prep_atm_init - + !================================================================================================ subroutine prep_atm_mrg(infodata, fractions_ax, xao_ax, timer_mrg) @@ -804,10 +804,10 @@ subroutine prep_atm_mrg_moab(infodata, xao_ax) type(mct_aVect) , pointer , intent(in) :: xao_ax(:) ! Atm-ocn fluxes, atm grid, cpl pes; used here just for indexing ! Arguments - type(mct_aVect), pointer :: l2x_a ! needed just for indexing + type(mct_aVect), pointer :: l2x_a ! needed just for indexing type(mct_aVect), pointer :: o2x_a type(mct_aVect), pointer :: i2x_a - type(mct_aVect), pointer :: xao_a + type(mct_aVect), pointer :: xao_a type(mct_aVect), pointer :: x2a_a ! type(mct_aVect) :: fractions_a @@ -855,33 +855,33 @@ subroutine prep_atm_mrg_moab(infodata, xao_ax) type(mct_list) :: temp_list integer :: size_list, index_list type(mct_string) :: mctOStr ! -#endif +#endif character(*), parameter :: subname = '(prep_atm_mrg_moab) ' !----------------------------------------------------------------------- ! call seq_comm_getdata(CPLID, iamroot=iamroot) - + if (first_time) then ! find out the number of local elements in moab mesh atm instance on coupler ! right now, we work only on FV mesh, which is a cell mesh - ! eventually we will fix spectral case too + ! eventually we will fix spectral case too ierr = iMOAB_GetMeshInfo ( mbaxid, nvert, nvise, nbl, nsurf, nvisBC ); if (ierr .ne. 0) then write(logunit,*) subname,' error in getting info ' call shr_sys_abort(subname//' error in getting info ') endif lsize = nvise(1) ! number of active cells - ! mct avs are used just for their fields metadata, not the actual reals + ! mct avs are used just for their fields metadata, not the actual reals ! (name of the fields) ! need these always, not only the first time l2x_a => l2x_ax(1) i2x_a => i2x_ax(1) o2x_a => o2x_ax(1) - xao_a => xao_ax(1) + xao_a => xao_ax(1) x2a_a => component_get_x2c_cx(atm(1)) naflds = mct_aVect_nRattr(x2a_a) nlflds = mct_aVect_nRattr(l2x_a) @@ -891,7 +891,7 @@ subroutine prep_atm_mrg_moab(infodata, xao_ax) index_x2a_Sf_lfrac = mct_aVect_indexRA(x2a_a,'Sf_lfrac') index_x2a_Sf_ifrac = mct_aVect_indexRA(x2a_a,'Sf_ifrac') index_x2a_Sf_ofrac = mct_aVect_indexRA(x2a_a,'Sf_ofrac') - + !ngflds = mct_aVect_nRattr(g2x_o) allocate(fractions_am(lsize,5)) ! there are 5 fractions 'afrac:ifrac:ofrac:lfrac:lfrin' allocate(x2a_am (lsize, naflds)) @@ -901,7 +901,7 @@ subroutine prep_atm_mrg_moab(infodata, xao_ax) !allocate(r2x_om (lsize, nrflds)) allocate(xao_am (lsize, nxflds)) - + allocate(lindx(naflds), lmerge(naflds)) allocate(iindx(naflds), imerge(naflds)) @@ -1085,7 +1085,7 @@ subroutine prep_atm_mrg_moab(infodata, xao_ax) if (ierr .ne. 0) then call shr_sys_abort(subname//' error in getting fractions_am from atm instance ') endif - + tagname = trim(seq_flds_o2x_fields)//C_NULL_CHAR arrsize = noflds * lsize ! allocate (o2x_am (lsize, noflds)) ierr = iMOAB_GetDoubleTagStorage ( mbaxid, tagname, arrsize , ent_type, o2x_am(1,1)) @@ -1106,14 +1106,14 @@ subroutine prep_atm_mrg_moab(infodata, xao_ax) if (ierr .ne. 0) then call shr_sys_abort(subname//' error in getting l2x_am array ') endif - + tagname = trim(seq_flds_xao_fields)//C_NULL_CHAR arrsize = nxflds * lsize ! allocate (xao_am (lsize, nxflds)) ierr = iMOAB_GetDoubleTagStorage ( mbaxid, tagname, arrsize , ent_type, xao_am(1,1)) if (ierr .ne. 0) then call shr_sys_abort(subname//' error in getting xao_om array ') endif - + do n = 1,lsize x2a_am(n, index_x2a_Sf_lfrac) = fractions_am(n, klf) ! x2a_a%rAttr(index_x2a_Sf_lfrac,n) = fractions_a%Rattr(klf,n) @@ -1161,7 +1161,7 @@ subroutine prep_atm_mrg_moab(infodata, xao_ax) ! call mct_aVect_copy(aVin=o2x_a, aVout=x2a_a, vector=mct_usevector) ! call mct_aVect_copy(aVin=i2x_a, aVout=x2a_a, vector=mct_usevector) ! call mct_aVect_copy(aVin=xao_a, aVout=x2a_a, vector=mct_usevector) - ! we need to do something equivalent, to copy in a2x_am the tags from those shared indices + ! we need to do something equivalent, to copy in a2x_am the tags from those shared indices ! call mct_aVect_copy(aVin=l2x_a, aVout=x2a_a, vector=mct_usevector, sharedIndices=l2x_SharedIndices) !call mct_aVect_copy(aVin=o2x_a, aVout=x2a_a, vector=mct_usevector, sharedIndices=o2x_SharedIndices) !call mct_aVect_copy(aVin=i2x_a, aVout=x2a_a, vector=mct_usevector, sharedIndices=i2x_SharedIndices) @@ -1686,7 +1686,7 @@ subroutine prep_atm_calc_o2x_ax(fractions_ox, timer) #ifdef MOABDEBUG character*50 :: outfile, wopts, lnum integer :: ierr -#endif +#endif !--------------------------------------------------------------- call t_drvstartf (trim(timer),barrier=mpicom_CPLID) do emi = 1,num_inst_max @@ -1707,7 +1707,7 @@ subroutine prep_atm_calc_o2x_ax(fractions_ox, timer) enddo #ifdef MOABDEBUG - ! projections on atm + ! projections on atm write(lnum,"(I0.2)")num_moab_exports outfile = 'OIL2Atm'//trim(lnum)//'.h5m'//C_NULL_CHAR wopts = ';PARALLEL=WRITE_PART'//C_NULL_CHAR ! diff --git a/driver-moab/main/prep_ice_mod.F90 b/driver-moab/main/prep_ice_mod.F90 index 666e91481115..d7a669810237 100644 --- a/driver-moab/main/prep_ice_mod.F90 +++ b/driver-moab/main/prep_ice_mod.F90 @@ -201,9 +201,9 @@ subroutine prep_ice_init(infodata, ocn_c2_ice, glc_c2_ice, glcshelf_c2_ice, rof_ type1 = 3 type2 = 3 ! fv-fv graph - ! imoab compute comm graph ice-ocn, based on the same global id - ! it will be a simple migrate from ice mesh directly to ocean, using the comm graph computed here - ! TODO: find if CommGraph already exists. + ! iMOAB compute comm graph ice-ocn, based on the same global id + ! it will be a simple migrate from ice mesh directly to ocean, using the comm graph computed here + ! TODO: find if CommGraph already exists. ierr = iMOAB_ComputeCommGraph( mboxid, mbixid, mpicom_CPLID, mpigrp_CPLID, mpigrp_CPLID, & type1, type2, ocn(1)%cplcompid, ice(1)%cplcompid) @@ -212,7 +212,7 @@ subroutine prep_ice_init(infodata, ocn_c2_ice, glc_c2_ice, glcshelf_c2_ice, rof_ call shr_sys_abort(subname//' ERROR in computing graph ocn -ice x ') endif - ! define tags according to the seq_flds_i2x_fields + ! define tags according to the seq_flds_i2x_fields tagtype = 1 ! dense, double numco = 1 ! one value per cell / entity tagname = trim(seq_flds_o2x_fields)//C_NULL_CHAR @@ -222,7 +222,7 @@ subroutine prep_ice_init(infodata, ocn_c2_ice, glc_c2_ice, glcshelf_c2_ice, rof_ end if mapper_SFo2i%src_mbid = mboxid mapper_SFo2i%tgt_mbid = mbixid - ! no intersection, so willihave to do without it + ! no intersection, so will have to transform data without it mapper_SFo2i%src_context = ocn(1)%cplcompid mapper_SFo2i%intx_context = ice(1)%cplcompid mapper_SFo2i%mbname = 'mapper_SFo2i' @@ -619,7 +619,7 @@ subroutine prep_ice_mrg_moab(infodata, rof_c2_ice) ! find out the number of local elements in moab mesh seaice instance on coupler ierr = iMOAB_GetMeshInfo ( mbixid, nvert, nvise, nbl, nsurf, nvisBC ); - if (ierr .ne. 0) then + if (ierr .ne. 0) then write(logunit,*) subname,' error in getting info ' call shr_sys_abort(subname//' error in getting info ') endif @@ -753,7 +753,7 @@ subroutine prep_ice_mrg_moab(infodata, rof_c2_ice) tagname = trim(seq_flds_a2x_fields)//C_NULL_CHAR arrsize = naflds * lsize ! allocate (a2x_om (lsize, naflds)) ierr = iMOAB_GetDoubleTagStorage ( mbixid, tagname, arrsize , ent_type, a2x_im(1,1)) - if (ierr .ne. 0) then + if (ierr .ne. 0) then write(logunit, *) 'MOAB error ', ierr call shr_sys_abort(subname//' error in getting a2x_im array ') endif @@ -762,7 +762,7 @@ subroutine prep_ice_mrg_moab(infodata, rof_c2_ice) tagname = trim(seq_flds_r2x_fields)//C_NULL_CHAR arrsize = nrflds * lsize ! allocate (a2x_om (lsize, naflds)) ierr = iMOAB_GetDoubleTagStorage ( mbixid, tagname, arrsize , ent_type, r2x_im(1,1)) - if (ierr .ne. 0) then + if (ierr .ne. 0) then call shr_sys_abort(subname//' error in getting r2x_im array ') endif @@ -771,8 +771,8 @@ subroutine prep_ice_mrg_moab(infodata, rof_c2_ice) do n = 1,lsize - x2i_im(n,index_x2i_Faxa_rain) = a2x_im(n,index_a2x_Faxa_rainc) + a2x_im(n,index_a2x_Faxa_rainl) - x2i_im(n,index_x2i_Faxa_snow) = a2x_im(n,index_a2x_Faxa_snowc) + a2x_im(n,index_a2x_Faxa_snowl) + x2i_im(n,index_x2i_Faxa_rain) = a2x_im(n,index_a2x_Faxa_rainc) + a2x_im(n,index_a2x_Faxa_rainl) + x2i_im(n,index_x2i_Faxa_snow) = a2x_im(n,index_a2x_Faxa_snowc) + a2x_im(n,index_a2x_Faxa_snowl) ! no glacier yet ! x2i_im(n,index_x2i_Fixx_rofi) = g2x_im(n,index_g2x_Figg_rofi) + & diff --git a/driver-moab/main/prep_ocn_mod.F90 b/driver-moab/main/prep_ocn_mod.F90 index 76be27730eed..0345a266729b 100644 --- a/driver-moab/main/prep_ocn_mod.F90 +++ b/driver-moab/main/prep_ocn_mod.F90 @@ -15,7 +15,7 @@ module prep_ocn_mod use seq_comm_mct, only: mpoid ! iMOAB pid for ocean mesh on component pes use seq_comm_mct, only: mboxid ! iMOAB id for mpas ocean migrated mesh to coupler pes use seq_comm_mct, only: mbrmapro ! iMOAB id for map read from rof2ocn map file - use seq_comm_mct, only: mbrxoid ! iMOAB id for rof on coupler in ocean context; + use seq_comm_mct, only: mbrxoid ! iMOAB id for rof on coupler in ocean context; use seq_comm_mct, only: mbrxid ! iMOAB id of moab rof read on couple pes use seq_comm_mct, only : atm_pg_active ! whether the atm uses FV mesh or not ; made true if fv_nphys > 0 use seq_comm_mct, only : mbaxid ! iMOAB id for atm migrated mesh to coupler pes @@ -23,7 +23,7 @@ module prep_ocn_mod use seq_comm_mct, only : mbintxoa ! iMOAB id for intx mesh between ocean and atmosphere use seq_comm_mct, only : mhid ! iMOAB id for atm instance use seq_comm_mct, only : mhpgid ! iMOAB id for atm pgx grid, on atm pes; created with se and gll grids - use dimensions_mod, only : np ! for atmosphere degree + use dimensions_mod, only : np ! for atmosphere degree use seq_comm_mct, only : mbixid ! iMOAB for sea-ice migrated to coupler use seq_comm_mct, only : CPLALLICEID use seq_comm_mct, only : seq_comm_iamin @@ -33,7 +33,7 @@ module prep_ocn_mod use seq_infodata_mod, only: seq_infodata_type, seq_infodata_getdata use seq_map_type_mod - use seq_map_mod ! will have also moab_map_init_rcfile , seq_map_set_type + use seq_map_mod ! will have also moab_map_init_rcfile , seq_map_set_type use seq_flds_mod use t_drv_timers_mod use mct_mod @@ -153,8 +153,8 @@ module prep_ocn_mod real (kind=r8) , allocatable, private :: fractions_om (:,:) ! will retrieve the fractions from ocean, and use them - ! they were init with - ! character(*),parameter :: fraclist_o = 'afrac:ifrac:ofrac:ifrad:ofrad' in moab, on the fractions + ! they were init with + ! character(*),parameter :: fraclist_o = 'afrac:ifrac:ofrac:ifrad:ofrad' in moab, on the fractions real (kind=r8) , allocatable, private :: x2o_om (:,:) real (kind=r8) , allocatable, private :: a2x_om (:,:) real (kind=r8) , allocatable, private :: i2x_om (:,:) @@ -162,9 +162,9 @@ module prep_ocn_mod real (kind=r8) , allocatable, private :: xao_om (:,:) ! this will be constructed first time, and be used to copy fields for shared indices - ! between xao and x2o + ! between xao and x2o character(CXX) :: shared_fields_xao_x2o - ! will need some array to hold the data for copying + ! will need some array to hold the data for copying real(r8) , allocatable, save :: shared_values(:) ! will be the size of shared indices * lsize integer :: size_of_shared_values @@ -173,12 +173,35 @@ module prep_ocn_mod !================================================================================================ + + subroutine print_weight_map_details(subname, mbintxao, maptype, identifier, & + srcmethod, srcorder, srcdofname, tgtmethod, tgtorder, tgtdofname, fvmethod, nobubble, & + monotonicity, volumetric, inversemap, noconserve, validate) + + integer, intent(in) :: mbintxao, nobubble, volumetric, inversemap, noconserve, validate + integer, intent(in) :: srcorder, tgtorder, monotonicity + character(*), intent(in) :: subname, maptype, identifier, srcmethod, tgtmethod, & + srcdofname, tgtdofname, fvmethod + + write(logunit,*) subname, ': iMOAB computing remapping weights', maptype, & + ' and identifier ', identifier, ' with arguments: mbintxao=', mbintxao, & + ', source (method/order/doftag)=', trim(srcmethod), srcorder, trim(srcdofname), & + ', target (method/order/doftag)=', trim(tgtmethod), tgtorder, trim(tgtdofname), & + ', fvMethod=', trim(fvmethod), ', nobubble=', nobubble, & + ', monotonicity=', monotonicity, ', volumetric=', volumetric, & + ', fInverseDistanceMap=', inversemap, ', noConserve=', noconserve, & + ', validate=', validate + + end subroutine print_weight_map_details + + subroutine prep_ocn_init(infodata, atm_c2_ocn, atm_c2_ice, ice_c2_ocn, rof_c2_ocn, & wav_c2_ocn, glc_c2_ocn, glcshelf_c2_ocn) use iMOAB, only: iMOAB_ComputeMeshIntersectionOnSphere, iMOAB_RegisterApplication, & iMOAB_WriteMesh, iMOAB_DefineTagStorage, iMOAB_ComputeCommGraph, iMOAB_ComputeScalarProjectionWeights, & - iMOAB_MigrateMapMesh, iMOAB_WriteLocalMesh, iMOAB_GetMeshInfo, iMOAB_SetDoubleTagStorage + iMOAB_MigrateMapMesh, iMOAB_WriteLocalMesh, iMOAB_GetMeshInfo, iMOAB_SetDoubleTagStorage, & + iMOAB_WriteMappingWeightsToFile !--------------------------------------------------------------- ! Description ! Initialize module attribute vectors and all other non-mapping @@ -232,7 +255,7 @@ subroutine prep_ocn_init(infodata, atm_c2_ocn, atm_c2_ice, ice_c2_ocn, rof_c2_oc character(CXX) :: tagName integer :: rmapid, rmapid2 ! external id to identify the moab app ; 2 is for rof in ocean context (coverage) - integer :: type_grid ! + integer :: type_grid ! integer :: context_id, direction character*32 :: prefix_output ! for writing a coverage file for debugging integer :: rank_on_cpl ! just for debugging @@ -243,7 +266,7 @@ subroutine prep_ocn_init(infodata, atm_c2_ocn, atm_c2_ice, ice_c2_ocn, rof_c2_oc integer arrsize ! for setting the r2x fields on land to 0 integer ent_type ! for setting tags real (kind=r8) , allocatable :: tmparray (:) ! used to set the r2x fields to 0 - + !--------------------------------------------------------------- call seq_infodata_getData(infodata , & @@ -375,10 +398,10 @@ subroutine prep_ocn_init(infodata, atm_c2_ocn, atm_c2_ice, ice_c2_ocn, rof_c2_oc end if - ! we also need to compute the comm graph for the second hop, from the atm on coupler to the + ! we also need to compute the comm graph for the second hop, from the atm on coupler to the ! atm for the intx atm-ocn context (coverage) - ! - call seq_comm_getinfo(CPLID ,mpigrp=mpigrp_CPLID) + ! + call seq_comm_getinfo(CPLID ,mpigrp=mpigrp_CPLID) if (atm_pg_active) then type1 = 3; ! fv for both ocean and atm; fv-cgll does not work anyway else @@ -393,28 +416,28 @@ subroutine prep_ocn_init(infodata, atm_c2_ocn, atm_c2_ice, ice_c2_ocn, rof_c2_oc write(logunit,*) subname,' error in computing comm graph for second hop, atm-ocn' call shr_sys_abort(subname//' ERROR in computing comm graph for second hop, atm-ocn') endif - ! now take care of the mapper + ! now take care of the mapper mapper_Fa2o%src_mbid = mbaxid mapper_Fa2o%tgt_mbid = mboxid - mapper_Fa2o%intx_mbid = mbintxao + mapper_Fa2o%intx_mbid = mbintxao mapper_Fa2o%src_context = atm(1)%cplcompid mapper_Fa2o%intx_context = idintx wgtIdef = 'scalar'//C_NULL_CHAR mapper_Fa2o%weight_identifier = wgtIdef mapper_Fa2o%mbname = 'mapper_Fa2o' - ! because we will project fields from atm to ocn grid, we need to define + ! because we will project fields from atm to ocn grid, we need to define ! atm a2x fields to ocn grid on coupler side - + tagname = trim(seq_flds_a2x_fields)//C_NULL_CHAR tagtype = 1 ! dense - numco = 1 ! + numco = 1 ! ierr = iMOAB_DefineTagStorage(mboxid, tagname, tagtype, numco, tagindex ) if (ierr .ne. 0) then write(logunit,*) subname,' error in defining tags for seq_flds_a2x_fields on ocn cpl' call shr_sys_abort(subname//' ERROR in coin defining tags for seq_flds_a2x_fields on ocn cpl') endif - volumetric = 0 ! can be 1 only for FV->DGLL or FV->CGLL; - + volumetric = 0 ! can be 1 only for FV->DGLL or FV->CGLL; + if (atm_pg_active) then dm1 = "fv"//C_NULL_CHAR dofnameS="GLOBAL_ID"//C_NULL_CHAR @@ -432,12 +455,41 @@ subroutine prep_ocn_init(infodata, atm_c2_ocn, atm_c2_ice, ice_c2_ocn, rof_c2_oc noConserve = 0 validate = 0 ! less verbose fInverseDistanceMap = 0 + + ! First compute the non-conservative bilinear map for projection of scalar fields if (iamroot_CPLID) then - write(logunit,*) subname, 'launch iMOAB weights with args ', 'mbintxao=', mbintxao, ' wgtIdef=', wgtIdef, & - 'dm1=', trim(dm1), ' orderS=', orderS, 'dm2=', trim(dm2), ' orderT=', orderT, & + call print_weight_map_details(subname, mbintxao, "FV-FV", "bilinear", & + trim(dm1), orderS, trim(dofnameS), trim(dm2), orderT, trim(dofnameT), "bilinear", & + fNoBubble, monotonicity, volumetric, fInverseDistanceMap, noConserve, validate) + ! write(logunit,*) subname, 'launch iMOAB weights with args ', 'mbintxao=', mbintxao, ' wgtIdef=bilinear ', & + ! 'dm1=', trim(dm1), ' orderS=', orderS, 'dm2=', trim(dm2), ' orderT=', orderT, 'fvMethod=bilinear', & + ! fNoBubble, monotonicity, volumetric, fInverseDistanceMap, & + ! noConserve, validate, & + ! trim(dofnameS), trim(dofnameT) + endif + ierr = iMOAB_ComputeScalarProjectionWeights ( mbintxao, 'bilinear'//C_NULL_CHAR, & + trim(dm1), orderS, trim(dm2), orderT, 'bilin'//C_NULL_CHAR, & fNoBubble, monotonicity, volumetric, fInverseDistanceMap, & noConserve, validate, & - trim(dofnameS), trim(dofnameT) + trim(dofnameS), trim(dofnameT) ) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in computing ao weights ' + call shr_sys_abort(subname//' ERROR in computing ao weights ') + endif + + ierr = iMOAB_WriteMappingWeightsToFile(mbintxao, 'bilinear'//C_NULL_CHAR, 'bilinear_a2o.nc'//C_NULL_CHAR) + + ! Next compute the conservative map for projection of flux fields + if (iamroot_CPLID) then + call print_weight_map_details(subname, mbintxao, "FV-FV", wgtIdef, & + trim(dm1), orderS, trim(dofnameS), trim(dm2), orderT, trim(dofnameT), "bilinear", & + fNoBubble, monotonicity, volumetric, fInverseDistanceMap, noConserve, validate) + + ! write(logunit,*) subname, 'launch iMOAB weights with args ', 'mbintxao=', mbintxao, ' wgtIdef=', wgtIdef, & + ! 'dm1=', trim(dm1), ' orderS=', orderS, 'dm2=', trim(dm2), ' orderT=', orderT, & + ! fNoBubble, monotonicity, volumetric, fInverseDistanceMap, & + ! noConserve, validate, & + ! trim(dofnameS), trim(dofnameT) endif ierr = iMOAB_ComputeScalarProjectionWeights ( mbintxao, wgtIdef, & trim(dm1), orderS, trim(dm2), orderT, ''//C_NULL_CHAR, & @@ -463,7 +515,7 @@ subroutine prep_ocn_init(infodata, atm_c2_ocn, atm_c2_ice, ice_c2_ocn, rof_c2_oc endif #endif end if ! if ((mbaxid .ge. 0) .and. (mboxid .ge. 0)) -! endif HAVE_MOAB +! endif HAVE_MOAB #endif end if ! if (atm_present) @@ -492,28 +544,25 @@ subroutine prep_ocn_init(infodata, atm_c2_ocn, atm_c2_ice, ice_c2_ocn, rof_c2_oc end if call seq_map_initvect(mapper_Va2o, vect_map, atm(1), ocn(1), string='mapper_Va2o initvect') - ! will use the same map for mapper_Sa2o and Va2o, although it is using bilinear option - ! in seq_maps.rc + ! will use the same map for mapper_Sa2o and Va2o, using the bilinear map option if ((mbaxid .ge. 0) .and. (mboxid .ge. 0)) then - ! now take care of the 2 new mappers + ! now take care of the 2 new mappers mapper_Sa2o%src_mbid = mbaxid mapper_Sa2o%tgt_mbid = mboxid - mapper_Sa2o%intx_mbid = mbintxao + mapper_Sa2o%intx_mbid = mbintxao mapper_Sa2o%src_context = atm(1)%cplcompid mapper_Sa2o%intx_context = idintx - wgtIdef = 'scalar'//C_NULL_CHAR - mapper_Sa2o%weight_identifier = wgtIdef + mapper_Sa2o%weight_identifier = 'bilinear'//C_NULL_CHAR mapper_Sa2o%mbname = 'mapper_Sa2o' mapper_Va2o%src_mbid = mbaxid mapper_Va2o%tgt_mbid = mboxid - mapper_Va2o%intx_mbid = mbintxao + mapper_Va2o%intx_mbid = mbintxao mapper_Va2o%src_context = atm(1)%cplcompid mapper_Va2o%intx_context = idintx - wgtIdef = 'scalar'//C_NULL_CHAR - mapper_Va2o%weight_identifier = wgtIdef + mapper_Va2o%weight_identifier = 'bilinear'//C_NULL_CHAR mapper_Va2o%mbname = 'mapper_Va2o' - endif ! if ((mbaxid .ge. 0) .and. (mboxid .ge. 0)) + endif ! if ((mbaxid .ge. 0) .and. (mboxid .ge. 0)) endif ! if (atm_c2_ocn .or. atm_c2_ice) call shr_sys_flush(logunit) @@ -529,13 +578,12 @@ subroutine prep_ocn_init(infodata, atm_c2_ocn, atm_c2_ice, ice_c2_ocn, rof_c2_oc ! moab also will do just a rearrange, hopefully, in this case, based on the comm graph ! that is computed here call seq_comm_getinfo(CPLID ,mpigrp=mpigrp_CPLID) ! second group, the coupler group CPLID is global variable - - type1 = 3 - type2 = 3 ! fv-fv graph - ! imoab compute comm graph ice-ocn, based on the same global id - ! it will be a simple migrate from ice mesh directly to ocean, using the comm graph computed here + type1 = 3 + type2 = 3 ! fv-fv graph + ! iMOAB: compute the communication graph for ice-ocn, based on the same global id + ! it will be a simple permutation from ice mesh directly to ocean, using the comm graph computed here ierr = iMOAB_ComputeCommGraph( mbixid, mboxid, mpicom_CPLID, mpigrp_CPLID, mpigrp_CPLID, & type1, type2, ice(1)%cplcompid, ocn(1)%cplcompid) if (ierr .ne. 0) then @@ -543,8 +591,8 @@ subroutine prep_ocn_init(infodata, atm_c2_ocn, atm_c2_ice, ice_c2_ocn, rof_c2_oc call shr_sys_abort(subname//' ERROR in computing graph ice - ocn x ') endif - - ! define tags according to the seq_flds_i2x_fields + + ! define tags according to the seq_flds_i2x_fields tagtype = 1 ! dense, double numco = 1 ! one value per cell / entity tagname = trim(seq_flds_i2x_fields)//C_NULL_CHAR @@ -560,11 +608,11 @@ subroutine prep_ocn_init(infodata, atm_c2_ocn, atm_c2_ice, ice_c2_ocn, rof_c2_oc mapper_SFi2o%mbname = 'mapper_SFi2o' if(mapper_SFi2o%copy_only) then - call seq_map_set_type(mapper_SFi2o, mbixid, 1) ! type is cells + call seq_map_set_type(mapper_SFi2o, mbixid, 1) ! type is cells endif - endif - + endif + #endif endif ! if (ice_present) @@ -578,7 +626,7 @@ subroutine prep_ocn_init(infodata, atm_c2_ocn, atm_c2_ice, ice_c2_ocn, rof_c2_oc call seq_map_init_rcfile(mapper_Rr2o_liq, rof(1), ocn(1), & 'seq_maps.rc', 'rof2ocn_liq_rmapname:', 'rof2ocn_liq_rmaptype:',samegrid_ro, & 'mapper_Rr2o_liq initialization',esmf_map_flag) - + #ifdef HAVE_MOAB appname = "ROF_OCN_COU"//CHAR(0) ! rmapid is a unique external number of MOAB app that takes care of map between rof and ocn mesh @@ -589,13 +637,13 @@ subroutine prep_ocn_init(infodata, atm_c2_ocn, atm_c2_ice, ice_c2_ocn, rof_c2_oc call shr_sys_abort(subname//' ERROR in registering rof 2 ocn moab map ') endif ! integer, public :: mboxid ! iMOAB id for mpas ocean already migrated mesh to coupler pes - type_grid = 3 ! this is type of grid, maybe should be saved on imoab app ? + type_grid = 3 ! this is type of grid, maybe should be saved on imoab app ? call moab_map_init_rcfile(mbrmapro, mboxid, type_grid, rof(1), ocn(1), & 'seq_maps.rc', 'rof2ocn_liq_rmapname:', 'rof2ocn_liq_rmaptype:',samegrid_ro, & 'mapper_Rr2o_liq moab initialization',esmf_map_flag) ! this is a special rof mesh redistribution, for the ocean context ! it will be used to project from rof to ocean - ! the mesh will be migrated, to be able to do the second hop + ! the mesh will be migrated, to be able to do the second hop appname = "ROF_OCOU"//C_NULL_CHAR ! rmapid is a unique external number of MOAB app that identifies runoff on coupler side rmapid2 = 100*rof(1)%cplcompid ! this is a special case, because we also have a regular coupler instance mbrxid @@ -604,27 +652,27 @@ subroutine prep_ocn_init(infodata, atm_c2_ocn, atm_c2_ice, ice_c2_ocn, rof_c2_oc write(logunit,*) subname,' error in registering rof on coupler in ocean context ' call shr_sys_abort(subname//' ERROR in registering rof on coupler in ocean context ') endif - ! this code was moved from prep_rof_ocn_moab, because we will do everything on coupler side, not + ! this code was moved from prep_rof_ocn_moab, because we will do everything on coupler side, not ! needed to be on joint comm anymore for the second hop - ! it read on the coupler side, from file, the scrip mosart, that has a full mesh; - ! also migrate rof mesh on coupler pes, in ocean context, mbrxoid (this will be like coverage mesh, + ! it read on the coupler side, from file, the scrip mosart, that has a full mesh; + ! also migrate rof mesh on coupler pes, in ocean context, mbrxoid (this will be like coverage mesh, ! it will cover ocean target per process) - ! map between rof 2 ocn is in mbrmapro ; - ! after this, the sending of tags for second hop (ocn context) will use the new par comm graph, + ! map between rof 2 ocn is in mbrmapro ; + ! after this, the sending of tags for second hop (ocn context) will use the new par comm graph, ! that has more precise info, that got created call seq_comm_getData(CPLID, mpicom=mpicom_CPLID, iamroot=iamroot_CPLID) call seq_comm_getData(CPLID ,mpigrp=mpigrp_CPLID) ! second group, the coupler group CPLID is global variable type1 = 3 ! fv mesh nowadays - direction = 1 ! + direction = 1 ! context_id = ocn(1)%cplcompid ! this creates a par comm graph between mbrxid and mbrxoid, with ids rof(1)%cplcompid, context ocn(1)%cplcompid ! this will be used in send/receive mappers ierr = iMOAB_MigrateMapMesh (mbrxid, mbrmapro, mbrxoid, mpicom_CPLID, mpigrp_CPLID, & mpigrp_CPLID, type1, rof(1)%cplcompid, context_id, direction) - + if (ierr .ne. 0) then write(logunit,*) subname,' error in migrating rof mesh for map rof c2 ocn ' call shr_sys_abort(subname//' ERROR in migrating rof mesh for map rof c2 ocn ') @@ -652,7 +700,7 @@ subroutine prep_ocn_init(infodata, atm_c2_ocn, atm_c2_ice, ice_c2_ocn, rof_c2_oc write(logunit,*) subname,' error in defining ' // trim(seq_flds_r2x_fields) // ' tags on coupler side in MOAB, for ocean app' call shr_sys_abort(subname//' ERROR in defining MOAB tags ') endif - endif + endif if (iamroot_CPLID) then write(logunit,*) subname,' created moab tags for seq_flds_r2x_fields ' endif @@ -665,12 +713,12 @@ subroutine prep_ocn_init(infodata, atm_c2_ocn, atm_c2_ice, ice_c2_ocn, rof_c2_oc endif ! ocn is cell mesh on coupler side mlsize = nvise(1) - ent_type = 1 ! cell + ent_type = 1 ! cell ! zero out the values just for r2x fields, on ocean instance nrflds = mct_aVect_nRattr(r2x_ox(1)) ! this is the size of r2x_fields arrsize = nrflds*mlsize allocate (tmparray(arrsize)) ! mlsize is the size of local land - ! do we need to zero out others or just river ? + ! do we need to zero out others or just river ? tmparray = 0._r8 ierr = iMOAB_SetDoubleTagStorage(mboxid, tagname, arrsize , ent_type, tmparray(1)) if (ierr .ne. 0) then @@ -696,11 +744,11 @@ subroutine prep_ocn_init(infodata, atm_c2_ocn, atm_c2_ice, ice_c2_ocn, rof_c2_oc ! now take care of the mapper for MOAB mapper_Rr2o_liq mapper_Rr2o_liq%src_mbid = mbrxid mapper_Rr2o_liq%tgt_mbid = mbrxoid ! this is special, it will really need this coverage type mesh - mapper_Rr2o_liq%intx_mbid = mbrmapro + mapper_Rr2o_liq%intx_mbid = mbrmapro mapper_Rr2o_liq%src_context = rof(1)%cplcompid mapper_Rr2o_liq%intx_context = ocn(1)%cplcompid ! this context was used in migrate mesh wgtIdef = 'map-from-file'//C_NULL_CHAR - mapper_Rr2o_liq%weight_identifier = wgtIdef + mapper_Rr2o_liq%weight_identifier = wgtIdef mapper_Rr2o_liq%mbname = 'mapper_Rr2o_liq' mapper_Rr2o_liq%read_map = .true. #endif @@ -709,7 +757,7 @@ subroutine prep_ocn_init(infodata, atm_c2_ocn, atm_c2_ice, ice_c2_ocn, rof_c2_oc write(logunit,*) ' ' write(logunit,F00) 'Initializing mapper_Rr2o_ice' end if - ! is this the same map as above ? + ! is this the same map as above ? call seq_map_init_rcfile(mapper_Rr2o_ice, rof(1), ocn(1), & 'seq_maps.rc', 'rof2ocn_ice_rmapname:', 'rof2ocn_ice_rmaptype:',samegrid_ro, & 'mapper_Rr2o_ice initialization',esmf_map_flag) @@ -717,14 +765,14 @@ subroutine prep_ocn_init(infodata, atm_c2_ocn, atm_c2_ice, ice_c2_ocn, rof_c2_oc #ifdef HAVE_MOAB ! now take care of the mapper for MOAB mapper_Rr2o_ice mapper_Rr2o_ice%src_mbid = mbrxid - mapper_Rr2o_ice%tgt_mbid = mbrxoid ! special - mapper_Rr2o_ice%intx_mbid = mbrmapro + mapper_Rr2o_ice%tgt_mbid = mbrxoid ! special + mapper_Rr2o_ice%intx_mbid = mbrmapro mapper_Rr2o_ice%src_context = rof(1)%cplcompid mapper_Rr2o_ice%intx_context = ocn(1)%cplcompid ! this context was used in migrate mesh wgtIdef = 'map-from-file'//C_NULL_CHAR - mapper_Rr2o_ice%weight_identifier = wgtIdef + mapper_Rr2o_ice%weight_identifier = wgtIdef mapper_Rr2o_ice%mbname = 'mapper_Rr2o_ice' - mapper_Rr2o_ice%read_map = .true. + mapper_Rr2o_ice%read_map = .true. #endif if (flood_present) then if (iamroot_CPLID) then @@ -738,11 +786,11 @@ subroutine prep_ocn_init(infodata, atm_c2_ocn, atm_c2_ice, ice_c2_ocn, rof_c2_oc ! now take care of the mapper for MOAB mapper_Fr2o mapper_Fr2o%src_mbid = mbrxid mapper_Fr2o%tgt_mbid = mbrxoid ! special - mapper_Fr2o%intx_mbid = mbrmapro + mapper_Fr2o%intx_mbid = mbrmapro mapper_Fr2o%src_context = rof(1)%cplcompid mapper_Fr2o%intx_context = ocn(1)%cplcompid ! this context was used in migrate mesh wgtIdef = 'map-from-file'//C_NULL_CHAR - mapper_Fr2o%weight_identifier = wgtIdef + mapper_Fr2o%weight_identifier = wgtIdef mapper_Fr2o%mbname = 'mapper_Fr2o' #endif endif @@ -1024,18 +1072,18 @@ subroutine prep_ocn_mrg_moab(infodata, xao_ox) ! Arguments type(seq_infodata_type) , intent(in) :: infodata type(mct_aVect) , pointer , intent(in) :: xao_ox(:) ! Atm-ocn fluxes, ocn grid, cpl pes; used here just for indexing - + ! temporary, to compile ! type(mct_aVect) :: fractions_o - type(mct_avect) , pointer :: a2x_o ! used just for indexing + type(mct_avect) , pointer :: a2x_o ! used just for indexing type(mct_avect) , pointer :: i2x_o type(mct_avect) , pointer :: r2x_o type(mct_avect) , pointer :: x2o_o type(mct_aVect) , pointer :: xao_o !--------------------------------------------------------------- - + real(r8) :: flux_epbalfact ! adjusted precip factor ! will build x2o_om , similar to x2o_ox @@ -1044,7 +1092,7 @@ subroutine prep_ocn_mrg_moab(infodata, xao_ox) ! Local variables integer :: n,ka,ki,ko,kr,kw,kx,kir,kor,i,i1,o1 integer :: kof,kif - integer :: lsize, arrsize ! for double arrays + integer :: lsize, arrsize ! for double arrays integer , save :: noflds,naflds,niflds,nrflds,nxflds! ,ngflds,nwflds, no glacier or wave model real(r8) :: ifrac,ifracr real(r8) :: afrac,afracr @@ -1125,7 +1173,7 @@ subroutine prep_ocn_mrg_moab(infodata, xao_ox) integer, save :: index_x2o_Faxa_rain_HDO integer, save :: index_x2o_Faxa_snow_HDO integer, save :: index_x2o_Faxa_prec_HDO - + logical :: iamroot logical, save, pointer :: amerge(:),imerge(:),xmerge(:) @@ -1140,7 +1188,7 @@ subroutine prep_ocn_mrg_moab(infodata, xao_ox) logical, save :: first_time = .true. integer nvert(3), nvise(3), nbl(3), nsurf(3), nvisBC(3) ! for moab info - + character(CXX) ::tagname integer :: ent_type, ierr #ifdef MOABDEBUG @@ -1152,7 +1200,7 @@ subroutine prep_ocn_mrg_moab(infodata, xao_ox) type(mct_list) :: temp_list integer :: size_list, index_list type(mct_string) :: mctOStr ! -#endif +#endif ! for moab, local allocatable arrays for each field, size of local ocean mesh ! these are the fields that are merged, in general @@ -1172,7 +1220,7 @@ subroutine prep_ocn_mrg_moab(infodata, xao_ox) flux_epbalfact=flux_epbalfact) call seq_comm_setptrs(CPLID, iamroot=iamroot) - + ! find out the number of local elements in moab mesh ocean instance on coupler ierr = iMOAB_GetMeshInfo ( mboxid, nvert, nvise, nbl, nsurf, nvisBC ) if (ierr .ne. 0) then @@ -1180,17 +1228,17 @@ subroutine prep_ocn_mrg_moab(infodata, xao_ox) call shr_sys_abort(subname//' error in getting info ') endif lsize = nvise(1) ! number of active cells - + if (first_time) then - - ! mct avs are used just for their fields metadata, not the actual reals + + ! mct avs are used just for their fields metadata, not the actual reals ! (name of the fields) ! need these always, not only the first time a2x_o => a2x_ox(1) i2x_o => i2x_ox(1) r2x_o => r2x_ox(1) - xao_o => xao_ox(1) + xao_o => xao_ox(1) x2o_o => component_get_x2c_cx(ocn(1)) noflds = mct_aVect_nRattr(x2o_o) ! these are saved after first time naflds = mct_aVect_nRattr(a2x_o) @@ -1198,7 +1246,7 @@ subroutine prep_ocn_mrg_moab(infodata, xao_ox) nrflds = mct_aVect_nRattr(r2x_o) !nwflds = mct_aVect_nRattr(w2x_o) nxflds = mct_aVect_nRattr(xao_o) - + !ngflds = mct_aVect_nRattr(g2x_o) allocate(x2o_om (lsize, noflds)) ! allocate accumulation variable , parallel to x2o_om @@ -1604,16 +1652,16 @@ subroutine prep_ocn_mrg_moab(infodata, xao_ox) if (ierr .ne. 0) then call shr_sys_abort(subname//' error in getting r2x_om array ') endif - + tagname = trim(seq_flds_xao_fields)//C_NULL_CHAR arrsize = nxflds * lsize ! allocate (xao_om (lsize, nxflds)) ierr = iMOAB_GetDoubleTagStorage ( mbofxid, tagname, arrsize , ent_type, xao_om(1,1)) if (ierr .ne. 0) then call shr_sys_abort(subname//' error in getting xao_om array ') endif - + ! #ifdef NOTDEF - + do n = 1,lsize ifrac = fractions_om(n,kif) ! fo_kif_ifrac(n) ! fractions_o%rAttr(kif,n) @@ -1643,7 +1691,7 @@ subroutine prep_ocn_mrg_moab(infodata, xao_ox) + a2x_om(n,index_a2x_Faxa_swndf) * (1.0_R8 - anidf) !+ a2x_Faxa_swndf(n) * (1.0_R8 - anidf) ! + a2x_o%rAttr(index_a2x_Faxa_swndf,n) * (1.0_R8 - anidf) x2o_om(n,index_x2o_Foxx_swnet) = (fswabsv + fswabsi) * afracr + & !x2o_Foxx_swnet(n) = (fswabsv + fswabsi) * afracr + & !x2o_o%rAttr(index_x2o_Foxx_swnet,n) = (fswabsv + fswabsi) * afracr + & i2x_om(n,index_i2x_Fioi_swpen) * ifrac ! i2x_Fioi_swpen(n) * ifrac ! i2x_o%rAttr(index_i2x_Fioi_swpen,n) * ifrac - + if (seq_flds_i2o_per_cat) then x2o_om(n,index_x2o_Sf_afrac) = afrac x2o_om(n,index_x2o_Sf_afracr) = afracr @@ -1664,7 +1712,7 @@ subroutine prep_ocn_mrg_moab(infodata, xao_ox) x2o_om(n,index_x2o_Faxa_snow ) x2o_om(n,index_x2o_Foxx_rofl) = (r2x_om(n,index_r2x_Forr_rofl ) + & - r2x_om(n,index_r2x_Flrr_flood) ) + r2x_om(n,index_r2x_Flrr_flood) ) ! g2x_om(n,index_g2x_Fogg_rofl )) * flux_epbalfact x2o_om(n,index_x2o_Foxx_rofi) = (r2x_om(n,index_r2x_Forr_rofi ) ) * flux_epbalfact ! g2x_om(n,index_g2x_Fogg_rofi )) * flux_epbalfact @@ -1729,7 +1777,7 @@ subroutine prep_ocn_mrg_moab(infodata, xao_ox) x2o_om(n,index_x2o_Faxa_snow_HDO ) end if end do -! #endif +! #endif do ko = 1,noflds !--- document merge --- @@ -1856,7 +1904,7 @@ subroutine prep_ocn_mrg_moab(infodata, xao_ox) first_time = .false. - !end copy + !end copy end subroutine prep_ocn_mrg_moab !================================================================================================ @@ -2633,7 +2681,7 @@ subroutine prep_ocn_calc_a2x_ox(timer) #ifdef COMPARE_TO_NUOPC call seq_map_mapvect(mapper_Va2o, vect_map, a2x_ax, a2x_ox(eai), 'Sa_u', 'Sa_v', norm=.true.) -#else +#else !--- tcx the norm should be true below, it's false for bfb backwards compatability call seq_map_mapvect(mapper_Va2o, vect_map, a2x_ax, a2x_ox(eai), 'Sa_u', 'Sa_v', norm=.false.) #endif diff --git a/driver-moab/main/seq_map_mod.F90 b/driver-moab/main/seq_map_mod.F90 index 91a338e56018..ff2522b03ac1 100644 --- a/driver-moab/main/seq_map_mod.F90 +++ b/driver-moab/main/seq_map_mod.F90 @@ -348,7 +348,7 @@ subroutine seq_map_map( mapper, av_s, av_d, fldlist, norm, avwts_s, avwtsfld_s, integer, dimension(:), allocatable :: globalIds real(r8), dimension(:), allocatable :: wghts real(kind=r8) , allocatable :: targtags(:,:) - real(kind=r8) :: factor + real(kind=r8) :: factor #endif ! ! Local Variables @@ -430,8 +430,8 @@ subroutine seq_map_map( mapper, av_s, av_d, fldlist, norm, avwts_s, avwtsfld_s, #ifdef MOABDEBUG if (seq_comm_iamroot(CPLID)) then - write(logunit,*) subname, 'iMOAB mapper ',trim(mapper%mbname), ' iMOAB_mapper nfields', & - nfields, ' fldlist_moab=', trim(fldlist_moab) + write(logunit,*) subname, 'iMOAB mapper ', trim(mapper%mbname), ', nfields', & + nfields, ' and fields =', trim(fldlist_moab) call shr_sys_flush(logunit) endif #endif @@ -584,10 +584,10 @@ subroutine seq_map_map( mapper, av_s, av_d, fldlist, norm, avwts_s, avwtsfld_s, if ( valid_moab_context ) then ! receive in the intx app, because it is redistributed according to coverage (trick) ! for true intx cases, tgt_mbid is set to be the same as intx_mbid - ! just read map is special + ! just read map is special if (mapper%read_map) then ! receive indeed in target app ierr = iMOAB_ReceiveElementTag( mapper%tgt_mbid, fldlist_moab, mapper%mpicom, mapper%src_context ) - else ! receive in the intx app, trick + else ! receive in the intx app, trick ierr = iMOAB_ReceiveElementTag( mapper%intx_mbid, fldlist_moab, mapper%mpicom, mapper%src_context ) endif if (ierr .ne. 0) then @@ -607,13 +607,14 @@ subroutine seq_map_map( mapper, av_s, av_d, fldlist, norm, avwts_s, avwtsfld_s, #ifdef MOABDEBUG if (seq_comm_iamroot(CPLID)) then - write(logunit, *) subname,' iMOAB projection mapper: between ', mapper%src_mbid, ' and ', mapper%tgt_mbid, trim(fldlist_moab) + write(logunit, *) subname,' iMOAB projection mapper: ', trim(mapper%weight_identifier), ' between ', & + mapper%src_mbid, ' and ', mapper%tgt_mbid call shr_sys_flush(logunit) endif #endif ierr = iMOAB_ApplyScalarProjectionWeights ( mapper%intx_mbid, mapper%weight_identifier, fldlist_moab, fldlist_moab) if (ierr .ne. 0) then - write(logunit,*) subname,' error in applying weights ' + write(logunit,*) subname,' error in applying weights for ', trim(mapper%weight_identifier) call shr_sys_abort(subname//' ERROR in applying weights') endif @@ -659,7 +660,7 @@ subroutine seq_map_map( mapper, av_s, av_d, fldlist, norm, avwts_s, avwtsfld_s, write(logunit,*) subname,' error getting destination tag values ', mapper%mbname call shr_sys_abort(subname//' ERROR getting source tag values') ! serious enough endif - + deallocate(wghts, targtags) endif ! end normalization From bb2620c51ca8cf5389a1198f6329208e4e4ed765 Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Mon, 1 May 2023 14:32:45 -0500 Subject: [PATCH 378/467] retrieve x2o_om before using it for accumulation it is happening right after merging it is more clear what is happening, although x2o_om should be unchanged after prep_ocn_mrg_moab and before prep_ocn_accum_moab --- driver-moab/main/prep_ocn_mod.F90 | 26 +++++++++++++++++--------- 1 file changed, 17 insertions(+), 9 deletions(-) diff --git a/driver-moab/main/prep_ocn_mod.F90 b/driver-moab/main/prep_ocn_mod.F90 index 63299ee93df3..b60231d20c28 100644 --- a/driver-moab/main/prep_ocn_mod.F90 +++ b/driver-moab/main/prep_ocn_mod.F90 @@ -839,22 +839,30 @@ subroutine prep_ocn_accum_moab() ! Accumulate ocn inputs ! Form partial sum of tavg ocn inputs (virtual "send" to ocn) ! NOTE: this is done AFTER the call to the merge in prep_ocn_mrg - ! + use iMOAB, only : iMOAB_GetDoubleTagStorage ! Arguments ! ! Local Variables - + integer :: ent_type, ierr + character(CXX) :: tagname character(*) , parameter :: subname = '(prep_ocn_accum_moab)' !--------------------------------------------------------------- + ! this method is called after merge, so it is not really necessary, because + ! x2o_om should be saved between these calls + tagname = trim(seq_flds_x2o_fields)//C_NULL_CHAR + ent_type = 1 ! cell type + ierr = iMOAB_GetDoubleTagStorage ( mboxid, tagname, arrSize_x2o_om , ent_type, x2o_om(1,1)) + if (ierr .ne. 0) then + call shr_sys_abort(subname//' error in getting x2o_om array ') + endif + - if (x2oacc_om_cnt == 0) then - x2oacc_om = x2o_om - ! call mct_avect_copy(x2o_ox, x2oacc_ox(eoi)) - else - ! call mct_avect_accum(x2o_ox, x2oacc_ox(eoi)) - x2oacc_om = x2oacc_om + x2o_om - endif + if (x2oacc_om_cnt == 0) then + x2oacc_om = x2o_om + else + x2oacc_om = x2oacc_om + x2o_om + endif x2oacc_om_cnt = x2oacc_om_cnt + 1 From e2ba64b3b6075443f43b2756e2c3cd0bb79f782a Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Fri, 12 May 2023 09:38:18 -0500 Subject: [PATCH 379/467] for atm, zero out only non-shared fields also, get the x2a_am matrix from tags, before merging So_t on ice, ocn is still wrong So_t on atm looks better now Also, comment for moab the field indices --- driver-moab/main/prep_atm_mod.F90 | 57 +++++++++++++++++++++++++++---- driver-moab/main/prep_ice_mod.F90 | 24 +++++++++---- driver-moab/main/prep_ocn_mod.F90 | 16 +++++++++ 3 files changed, 84 insertions(+), 13 deletions(-) diff --git a/driver-moab/main/prep_atm_mod.F90 b/driver-moab/main/prep_atm_mod.F90 index 3a7e0a5ed8b3..245b9e44bc63 100644 --- a/driver-moab/main/prep_atm_mod.F90 +++ b/driver-moab/main/prep_atm_mod.F90 @@ -840,6 +840,8 @@ subroutine prep_atm_mrg_moab(infodata, xao_ax) type(mct_aVect_sharedindices),save :: i2x_sharedindices type(mct_aVect_sharedindices),save :: xao_sharedindices logical, pointer, save :: lmerge(:),imerge(:),xmerge(:),omerge(:) + ! special for moab + logical, pointer, save :: sharedIndex(:) integer, pointer, save :: lindx(:), iindx(:), oindx(:),xindx(:) integer, save :: naflds, nlflds,niflds,noflds,nxflds @@ -900,8 +902,8 @@ subroutine prep_atm_mrg_moab(infodata, xao_ax) allocate(l2x_am (lsize, nlflds)) !allocate(r2x_om (lsize, nrflds)) allocate(xao_am (lsize, nxflds)) - - + ! + allocate (sharedIndex(naflds)) allocate(lindx(naflds), lmerge(naflds)) allocate(iindx(naflds), imerge(naflds)) @@ -914,6 +916,8 @@ subroutine prep_atm_mrg_moab(infodata, xao_ax) allocate(field_xao(nxflds), itemc_xao(nxflds)) allocate(mrgstr(naflds)) + sharedIndex(:) = .false. ! shared indices will not be set to 0 after getting them + lindx(:) = 0 iindx(:) = 0 xindx(:) = 0 @@ -949,6 +953,23 @@ subroutine prep_atm_mrg_moab(infodata, xao_ax) call mct_aVect_setSharedIndices(i2x_a, x2a_a, i2x_SharedIndices) call mct_aVect_setSharedIndices(xao_a, x2a_a, xao_SharedIndices) + do i=1,l2x_SharedIndices%shared_real%num_indices + o1=l2x_SharedIndices%shared_real%aVindices2(i) + sharedIndex(o1) = .true. + enddo + do i=1,o2x_SharedIndices%shared_real%num_indices + o1=o2x_SharedIndices%shared_real%aVindices2(i) + sharedIndex(o1) = .true. + enddo + do i=1,i2x_SharedIndices%shared_real%num_indices + o1=i2x_SharedIndices%shared_real%aVindices2(i) + sharedIndex(o1) = .true. + enddo + do i=1,xao_SharedIndices%shared_real%num_indices + o1=xao_SharedIndices%shared_real%aVindices2(i) + sharedIndex(o1) = .true. + enddo + ! Field naming rules ! Only atm states that are Sx_... will be merged ! Only fluxes that are F??x_... will be merged @@ -1061,14 +1082,20 @@ subroutine prep_atm_mrg_moab(infodata, xao_ax) !call mct_avect_zero(x2a_a) ? - x2a_am = 0._r8 + !x2a_am = 0._r8 ent_type = 1 ! cells tagname = trim(seq_flds_x2a_fields)//C_NULL_CHAR arrsize = naflds * lsize - ! ierr = iMOAB_SetDoubleTagStorage ( mbaxid, tagname, arrsize , ent_type, x2a_am(1,1)) - ! if (ierr .ne. 0) then - ! call shr_sys_abort(subname//' error in setting moab tags with 0 ') - ! endif + ierr = iMOAB_GetDoubleTagStorage ( mbaxid, tagname, arrsize , ent_type, x2a_am(1,1)) + if (ierr .ne. 0) then + call shr_sys_abort(subname//' error in getting moab tags with 0 ') + endif + ! zero out only indices that are not shared + do ka = 1,naflds + if (.not. sharedIndex(ka)) then + x2a_am(:,ka) = 0 + endif + enddo ! Update surface fractions ! fraclist_a = 'afrac:ifrac:ofrac:lfrac:lfrin' kif = 2 ! kif=mct_aVect_indexRA(fractions_a,"ifrac") @@ -1139,21 +1166,37 @@ subroutine prep_atm_mrg_moab(infodata, xao_ax) i1=l2x_SharedIndices%shared_real%aVindices1(i) o1=l2x_SharedIndices%shared_real%aVindices2(i) mrgstr(o1) = trim(mrgstr(o1))//' = l2x%'//trim(field_lnd(i1)) +#ifdef MOABDEBUG + write(lnum, "(I3, A6, I3)" )i1, ' mb-> ', o1 + mrgstr(o1) = trim(mrgstr(o1))//trim(lnum) +#endif enddo do i=1,o2x_SharedIndices%shared_real%num_indices i1=o2x_SharedIndices%shared_real%aVindices1(i) o1=o2x_SharedIndices%shared_real%aVindices2(i) mrgstr(o1) = trim(mrgstr(o1))//' = o2x%'//trim(field_ocn(i1)) +#ifdef MOABDEBUG + write(lnum, "(I3, A6, I3)" )i1, ' mb-> ', o1 + mrgstr(o1) = trim(mrgstr(o1))//trim(lnum) +#endif enddo do i=1,i2x_SharedIndices%shared_real%num_indices i1=i2x_SharedIndices%shared_real%aVindices1(i) o1=i2x_SharedIndices%shared_real%aVindices2(i) mrgstr(o1) = trim(mrgstr(o1))//' = i2x%'//trim(field_ice(i1)) +#ifdef MOABDEBUG + write(lnum, "(I3, A6, I3)" )i1, ' mb-> ', o1 + mrgstr(o1) = trim(mrgstr(o1))//trim(lnum) +#endif enddo do i=1,xao_SharedIndices%shared_real%num_indices i1=xao_SharedIndices%shared_real%aVindices1(i) o1=xao_SharedIndices%shared_real%aVindices2(i) mrgstr(o1) = trim(mrgstr(o1))//' = xao%'//trim(field_xao(i1)) +#ifdef MOABDEBUG + write(lnum, "(I3, A6, I3)" )i1, ' mb-> ', o1 + mrgstr(o1) = trim(mrgstr(o1))//trim(lnum) +#endif enddo endif diff --git a/driver-moab/main/prep_ice_mod.F90 b/driver-moab/main/prep_ice_mod.F90 index aa4dadc0dc79..b45cda0dc993 100644 --- a/driver-moab/main/prep_ice_mod.F90 +++ b/driver-moab/main/prep_ice_mod.F90 @@ -690,18 +690,30 @@ subroutine prep_ice_mrg_moab(infodata, rof_c2_ice) o1=o2x_SharedIndices%shared_real%aVindices2(i) field = mct_aVect_getRList2c(i1, o2x_i) mrgstr(o1) = trim(mrgstr(o1))//' = o2x%'//trim(field) +#ifdef MOABDEBUG + write(lnum, "(I3, A6, I3)" )i1, ' mb-> ', o1 + mrgstr(o1) = trim(mrgstr(o1))//trim(lnum) +#endif enddo do i=1,a2x_SharedIndices%shared_real%num_indices i1=a2x_SharedIndices%shared_real%aVindices1(i) o1=a2x_SharedIndices%shared_real%aVindices2(i) field = mct_aVect_getRList2c(i1, a2x_i) mrgstr(o1) = trim(mrgstr(o1))//' = a2x%'//trim(field) +#ifdef MOABDEBUG + write(lnum, "(I3, A6, I3)" )i1, ' mb-> ', o1 + mrgstr(o1) = trim(mrgstr(o1))//trim(lnum) +#endif enddo do i=1,g2x_SharedIndices%shared_real%num_indices i1=g2x_SharedIndices%shared_real%aVindices1(i) o1=g2x_SharedIndices%shared_real%aVindices2(i) field = mct_aVect_getRList2c(i1, g2x_i) mrgstr(o1) = trim(mrgstr(o1))//' = g2x%'//trim(field) +#ifdef MOABDEBUG + write(lnum, "(I3, A6, I3)" )i1, ' mb-> ', o1 + mrgstr(o1) = trim(mrgstr(o1))//trim(lnum) +#endif enddo !--- document manual merges --- @@ -892,12 +904,12 @@ subroutine prep_ice_calc_a2x_ix(a2x_ox, timer) call t_drvstopf (trim(timer)) #ifdef MOABDEBUG -! if (mbixid .ge. 0 ) then ! we are on coupler pes, for sure -! write(lnum,"(I0.2)")num_moab_exports -! outfile = 'IceCplAfto2i'//trim(lnum)//'.h5m'//C_NULL_CHAR -! wopts = ';PARALLEL=WRITE_PART'//C_NULL_CHAR ! -! ierr = iMOAB_WriteMesh(mbixid, trim(outfile), trim(wopts)) -! endif + if (mbixid .ge. 0 ) then ! we are on coupler pes, for sure + write(lnum,"(I0.2)")num_moab_exports + outfile = 'IceCplAfto2i'//trim(lnum)//'.h5m'//C_NULL_CHAR + wopts = ';PARALLEL=WRITE_PART'//C_NULL_CHAR ! + ierr = iMOAB_WriteMesh(mbixid, trim(outfile), trim(wopts)) + endif #endif end subroutine prep_ice_calc_a2x_ix diff --git a/driver-moab/main/prep_ocn_mod.F90 b/driver-moab/main/prep_ocn_mod.F90 index b60231d20c28..3e50ef179f0d 100644 --- a/driver-moab/main/prep_ocn_mod.F90 +++ b/driver-moab/main/prep_ocn_mod.F90 @@ -1463,16 +1463,28 @@ subroutine prep_ocn_mrg_moab(infodata, xao_ox) i1=a2x_SharedIndices%shared_real%aVindices1(i) o1=a2x_SharedIndices%shared_real%aVindices2(i) mrgstr(o1) = trim(mrgstr(o1))//' = a2x%'//trim(field_atm(i1)) +#ifdef MOABDEBUG + write(lnum, "(I3, A6, I3)" )i1, ' mb-> ', o1 + mrgstr(o1) = trim(mrgstr(o1))//trim(lnum) +#endif enddo do i=1,i2x_SharedIndices%shared_real%num_indices i1=i2x_SharedIndices%shared_real%aVindices1(i) o1=i2x_SharedIndices%shared_real%aVindices2(i) mrgstr(o1) = trim(mrgstr(o1))//' = i2x%'//trim(field_ice(i1)) +#ifdef MOABDEBUG + write(lnum, "(I3, A6, I3)" )i1, ' mb-> ', o1 + mrgstr(o1) = trim(mrgstr(o1))//trim(lnum) +#endif enddo do i=1,r2x_SharedIndices%shared_real%num_indices i1=r2x_SharedIndices%shared_real%aVindices1(i) o1=r2x_SharedIndices%shared_real%aVindices2(i) mrgstr(o1) = trim(mrgstr(o1))//' = r2x%'//trim(field_rof(i1)) +#ifdef MOABDEBUG + write(lnum, "(I3, A6, I3)" )i1, ' mb-> ', o1 + mrgstr(o1) = trim(mrgstr(o1))//trim(lnum) +#endif enddo ! do i=1,w2x_SharedIndices%shared_real%num_indices ! i1=w2x_SharedIndices%shared_real%aVindices1(i) @@ -1486,6 +1498,10 @@ subroutine prep_ocn_mrg_moab(infodata, xao_ox) ! will build tagname for moab set/get tag values shared_fields_xao_x2o = trim(shared_fields_xao_x2o)//trim(field_xao(i1))//':' size_of_shared_values = size_of_shared_values + lSize +#ifdef MOABDEBUG + write(lnum, "(I3, A6, I3)" )i1, ' mb-> ', o1 + mrgstr(o1) = trim(mrgstr(o1))//trim(lnum) +#endif enddo ! first time, allocate data for values_holder allocate(shared_values (size_of_shared_values)) From 31eb427c79bddb3416494f105a82229d18ff0564 Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Mon, 15 May 2023 01:17:04 -0500 Subject: [PATCH 380/467] reset the initial source tags after normalization needed only when we change the source tags, when mbpresent is true --- driver-moab/main/seq_map_mod.F90 | 83 ++++++++++++++++++++------------ 1 file changed, 53 insertions(+), 30 deletions(-) diff --git a/driver-moab/main/seq_map_mod.F90 b/driver-moab/main/seq_map_mod.F90 index ff2522b03ac1..80f2e96821c2 100644 --- a/driver-moab/main/seq_map_mod.F90 +++ b/driver-moab/main/seq_map_mod.F90 @@ -340,15 +340,15 @@ subroutine seq_map_map( mapper, av_s, av_d, fldlist, norm, avwts_s, avwtsfld_s, integer(IN) ,intent(in),optional :: msgtag #ifdef HAVE_MOAB logical :: valid_moab_context - integer :: ierr, nfields, lsize, arrsize, j + integer :: ierr, nfields, lsize_src, lsize_tgt, arrsize_tgt, j, arrsize_src character(len=CXX) :: fldlist_moab character(len=CXX) :: tagname integer :: nvert(3), nvise(3), nbl(3), nsurf(3), nvisBC(3) ! for moab info type(mct_list) :: temp_list integer, dimension(:), allocatable :: globalIds real(r8), dimension(:), allocatable :: wghts - real(kind=r8) , allocatable :: targtags(:,:) - real(kind=r8) :: factor + real(kind=r8) , allocatable :: targtags(:,:), targtags_ini(:,:) + real(kind=r8) :: factor #endif ! ! Local Variables @@ -430,8 +430,8 @@ subroutine seq_map_map( mapper, av_s, av_d, fldlist, norm, avwts_s, avwtsfld_s, #ifdef MOABDEBUG if (seq_comm_iamroot(CPLID)) then - write(logunit,*) subname, 'iMOAB mapper ', trim(mapper%mbname), ', nfields', & - nfields, ' and fields =', trim(fldlist_moab) + write(logunit,*) subname, 'iMOAB mapper ',trim(mapper%mbname), ' iMOAB_mapper nfields', & + nfields, ' fldlist_moab=', trim(fldlist_moab) call shr_sys_flush(logunit) endif #endif @@ -523,14 +523,14 @@ subroutine seq_map_map( mapper, av_s, av_d, fldlist, norm, avwts_s, avwtsfld_s, write(logunit,*) subname,' error getting mesh info for ', mapper%mbname call shr_sys_abort(subname//' ERROR getting mesh info') ! serious enough endif - lsize = nvise(1) ! number of active cells + lsize_src = nvise(1) ! number of active cells ! init normalization weight - allocate(wghts(lsize)) + allocate(wghts(lsize_src)) wghts = 1.0_r8 tagname = "norm8wt"//C_NULL_CHAR ! set the normalization factor to 1 - ierr = iMOAB_SetDoubleTagStorage (mapper%src_mbid, tagname, lsize , mapper%tag_entity_type, wghts) + ierr = iMOAB_SetDoubleTagStorage (mapper%src_mbid, tagname, lsize_src , mapper%tag_entity_type, wghts) if (ierr .ne. 0) then write(logunit,*) subname,' error setting init value for mapping norm factor ',ierr,trim(tagname) call shr_sys_abort(subname//' ERROR setting norm init value') ! serious enough @@ -539,31 +539,39 @@ subroutine seq_map_map( mapper, av_s, av_d, fldlist, norm, avwts_s, avwtsfld_s, ! if a normalization factor was specified, get it and multiply src tags by it if(mbpresent) then tagname = avwtsfld_s//C_NULL_CHAR - ierr = iMOAB_GetDoubleTagStorage (mapper%src_mbid, tagname, lsize , mapper%tag_entity_type, wghts) + ierr = iMOAB_GetDoubleTagStorage (mapper%src_mbid, tagname, lsize_src , mapper%tag_entity_type, wghts) if (ierr .ne. 0) then write(logunit,*) subname,' error getting value for mapping norm factor ', trim(tagname) call shr_sys_abort(subname//' ERROR getting norm factor') ! serious enough endif ! get the fieldlist including weight - allocate(targtags(lsize,nfields)) - arrsize=lsize*(nfields) + allocate(targtags(lsize_src,nfields)) + allocate(targtags_ini(lsize_src,nfields)) + arrsize_src=lsize_src*(nfields) ! get the current values of all source tags including the norm8wt currently set to 1 - ierr = iMOAB_GetDoubleTagStorage (mapper%src_mbid, fldlist_moab, arrsize , mapper%tag_entity_type, targtags(1,1)) + ierr = iMOAB_GetDoubleTagStorage (mapper%src_mbid, fldlist_moab, arrsize_src , mapper%tag_entity_type, targtags(1,1)) if (ierr .ne. 0) then - write(logunit,*) subname,' error getting source tag values ', mapper%mbname, mapper%src_mbid, trim(fldlist_moab), arrsize, mapper%tag_entity_type + write(logunit,*) subname,' error getting source tag values ', mapper%mbname, mapper%src_mbid, trim(fldlist_moab), arrsize_src, mapper%tag_entity_type call shr_sys_abort(subname//' ERROR getting source tag values') ! serious enough endif + targtags_ini = targtags ! multiply by the value of the avwtsfld_s field. ! norm8wt is 1 so it will record the value of the weight. - do j = 1, lsize + do j = 1, lsize_src targtags(j,:)= targtags(j,:)*wghts(j) enddo - +#ifdef MOABDEBUG + if (seq_comm_iamroot(CPLID)) then + write(logunit, *) subname,' iMOAB projection mapper: ', mapper%mbname, ' normalize nfields=', & + nfields, ' arrsize_src on root:', arrsize_src, ' shape(targtags_ini)=', shape(targtags_ini) + call shr_sys_flush(logunit) + endif +#endif ! put the new values on the mesh for later mapping - ierr = iMOAB_SetDoubleTagStorage (mapper%src_mbid, fldlist_moab, arrsize , mapper%tag_entity_type, targtags(1,1)) + ierr = iMOAB_SetDoubleTagStorage (mapper%src_mbid, fldlist_moab, arrsize_src , mapper%tag_entity_type, targtags(1,1)) if (ierr .ne. 0) then write(logunit,*) subname,' error setting normed source tag values ', mapper%mbname call shr_sys_abort(subname//' ERROR setting normed source tag values') ! serious enough @@ -584,10 +592,10 @@ subroutine seq_map_map( mapper, av_s, av_d, fldlist, norm, avwts_s, avwtsfld_s, if ( valid_moab_context ) then ! receive in the intx app, because it is redistributed according to coverage (trick) ! for true intx cases, tgt_mbid is set to be the same as intx_mbid - ! just read map is special + ! just read map is special if (mapper%read_map) then ! receive indeed in target app ierr = iMOAB_ReceiveElementTag( mapper%tgt_mbid, fldlist_moab, mapper%mpicom, mapper%src_context ) - else ! receive in the intx app, trick + else ! receive in the intx app, trick ierr = iMOAB_ReceiveElementTag( mapper%intx_mbid, fldlist_moab, mapper%mpicom, mapper%src_context ) endif if (ierr .ne. 0) then @@ -607,14 +615,13 @@ subroutine seq_map_map( mapper, av_s, av_d, fldlist, norm, avwts_s, avwtsfld_s, #ifdef MOABDEBUG if (seq_comm_iamroot(CPLID)) then - write(logunit, *) subname,' iMOAB projection mapper: ', trim(mapper%weight_identifier), ' between ', & - mapper%src_mbid, ' and ', mapper%tgt_mbid + write(logunit, *) subname,' iMOAB projection mapper: between ', mapper%src_mbid, ' and ', mapper%tgt_mbid, trim(fldlist_moab) call shr_sys_flush(logunit) endif #endif ierr = iMOAB_ApplyScalarProjectionWeights ( mapper%intx_mbid, mapper%weight_identifier, fldlist_moab, fldlist_moab) if (ierr .ne. 0) then - write(logunit,*) subname,' error in applying weights for ', trim(mapper%weight_identifier) + write(logunit,*) subname,' error in applying weights ' call shr_sys_abort(subname//' ERROR in applying weights') endif @@ -626,21 +633,21 @@ subroutine seq_map_map( mapper, av_s, av_d, fldlist, norm, avwts_s, avwtsfld_s, call shr_sys_abort(subname//' ERROR getting mesh info') ! serious enough endif - lsize = nvise(1) ! number of active cells + lsize_tgt = nvise(1) ! number of active cells tagname = "norm8wt"//C_NULL_CHAR - allocate(wghts(lsize)) + allocate(wghts(lsize_tgt)) ! get values of weights after mapping - ierr = iMOAB_GetDoubleTagStorage (mapper%tgt_mbid, tagname, lsize , mapper%tag_entity_type, wghts) + ierr = iMOAB_GetDoubleTagStorage (mapper%tgt_mbid, tagname, lsize_tgt , mapper%tag_entity_type, wghts) if (ierr .ne. 0) then write(logunit,*) subname,' error getting value for mapping norm factor post-map ', ierr, trim(tagname) call shr_sys_abort(subname//' ERROR getting norm factor') ! serious enough endif ! get values of target tags after mapping - allocate(targtags(lsize,nfields)) - arrsize=lsize*(nfields) - ierr = iMOAB_GetDoubleTagStorage (mapper%tgt_mbid, fldlist_moab, arrsize , mapper%tag_entity_type, targtags(1,1)) + allocate(targtags(lsize_tgt,nfields)) + arrsize_tgt=lsize_tgt*(nfields) + ierr = iMOAB_GetDoubleTagStorage (mapper%tgt_mbid, fldlist_moab, arrsize_tgt , mapper%tag_entity_type, targtags(1,1)) if (ierr .ne. 0) then write(logunit,*) subname,' error getting destination tag values ', mapper%mbname call shr_sys_abort(subname//' ERROR getting source tag values') ! serious enough @@ -648,20 +655,36 @@ subroutine seq_map_map( mapper, av_s, av_d, fldlist, norm, avwts_s, avwtsfld_s, ! do the post mapping normalization ! TODO: add some check for wghts < puny - do j = 1, lsize + do j = 1, lsize_tgt factor = wghts(j) if (wghts(j) .ne. 0) factor = 1.0_r8/wghts(j) ! should we compare to a small value instead ? targtags(j,:)= targtags(j,:)*factor enddo ! put the values back on the mesh - ierr = iMOAB_SetDoubleTagStorage (mapper%tgt_mbid, fldlist_moab, arrsize , mapper%tag_entity_type, targtags(1,1)) + ierr = iMOAB_SetDoubleTagStorage (mapper%tgt_mbid, fldlist_moab, arrsize_tgt , mapper%tag_entity_type, targtags(1,1)) if (ierr .ne. 0) then write(logunit,*) subname,' error getting destination tag values ', mapper%mbname call shr_sys_abort(subname//' ERROR getting source tag values') ! serious enough endif - + deallocate(wghts, targtags) + if (mbpresent) then +#ifdef MOABDEBUG + if (seq_comm_iamroot(CPLID)) then + write(logunit, *) subname,' iMOAB projection mapper: ', mapper%mbname, ' shape(targtags_ini)=', shape(targtags_ini) + call shr_sys_flush(logunit) + endif +#endif + ! put the values back on the source mesh + ierr = iMOAB_SetDoubleTagStorage (mapper%src_mbid, fldlist_moab, arrsize_src , mapper%tag_entity_type, targtags_ini(1,1)) + if (ierr .ne. 0) then + write(logunit,*) subname,' error setting source tag values ', mapper%mbname + call shr_sys_abort(subname//' ERROR setting source tag values') ! serious enough + endif + deallocate(targtags_ini) + endif + endif ! end normalization endif From b998d20d28a323d9b88920dd2cf10ff0d528d878 Mon Sep 17 00:00:00 2001 From: iulian07 Date: Fri, 19 May 2023 23:23:15 -0500 Subject: [PATCH 381/467] bilinear maps generated with tr replace with map_ne4pg2_to_oQU480_bilin.tr.230519.nc this is for atm to ocn/ice map --- cime_config/config_grids.xml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/cime_config/config_grids.xml b/cime_config/config_grids.xml index 9cb110489254..6757996a229c 100755 --- a/cime_config/config_grids.xml +++ b/cime_config/config_grids.xml @@ -2990,8 +2990,8 @@ cpl/gridmaps/ne4pg2/map_ne4pg2_to_oQU480_mono.200527.nc - cpl/gridmaps/ne4pg2/map_ne4pg2_to_oQU480_bilin.200527.nc - cpl/gridmaps/ne4pg2/map_ne4pg2_to_oQU480_bilin.200527.nc + cpl/gridmaps/ne4pg2/map_ne4pg2_to_oQU480_bilin.tr.230519.nc + cpl/gridmaps/ne4pg2/map_ne4pg2_to_oQU480_bilin.tr.230519.nc cpl/gridmaps/oQU480/map_oQU480_to_ne4pg2_mono.200527.nc cpl/gridmaps/oQU480/map_oQU480_to_ne4pg2_mono.200527.nc From 4fe42da216fc28f1d346a92f4c20da243a3861d2 Mon Sep 17 00:00:00 2001 From: iulian07 Date: Mon, 22 May 2023 10:29:49 -0500 Subject: [PATCH 382/467] ne30 bilin new map replace map_ne30pg2_to_EC30to60E2r2_bilin.201005.nc with map_ne30pg2_to_EC30to60E2r2_bilin.tr.230522.nc --- cime_config/config_grids.xml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/cime_config/config_grids.xml b/cime_config/config_grids.xml index 6757996a229c..4c0dec8073de 100755 --- a/cime_config/config_grids.xml +++ b/cime_config/config_grids.xml @@ -3076,8 +3076,8 @@ cpl/gridmaps/ne30pg2/map_ne30pg2_to_EC30to60E2r2_mono.201005.nc - cpl/gridmaps/ne30pg2/map_ne30pg2_to_EC30to60E2r2_bilin.201005.nc - cpl/gridmaps/ne30pg2/map_ne30pg2_to_EC30to60E2r2_bilin.201005.nc + cpl/gridmaps/ne30pg2/map_ne30pg2_to_EC30to60E2r2_bilin.tr.230522.nc + cpl/gridmaps/ne30pg2/map_ne30pg2_to_EC30to60E2r2_bilin.tr.230522.nc cpl/gridmaps/EC30to60E2r2/map_EC30to60E2r2_to_ne30pg2_mono.201005.nc cpl/gridmaps/EC30to60E2r2/map_EC30to60E2r2_to_ne30pg2_mono.201005.nc From 0f6b2a9ec28fc54dc5863028f9a9fe501870aba7 Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Thu, 1 Jun 2023 07:33:18 -0500 Subject: [PATCH 383/467] more debug to track faxa_lwdn --- driver-moab/main/prep_ice_mod.F90 | 37 ++++++++++++++++++++++++++++++- driver-moab/main/prep_ocn_mod.F90 | 17 +++++++++++++- driver-moab/main/seq_map_mod.F90 | 19 ++++++++++++---- 3 files changed, 67 insertions(+), 6 deletions(-) diff --git a/driver-moab/main/prep_ice_mod.F90 b/driver-moab/main/prep_ice_mod.F90 index 2b8d34c9a892..6669579997a7 100644 --- a/driver-moab/main/prep_ice_mod.F90 +++ b/driver-moab/main/prep_ice_mod.F90 @@ -896,6 +896,14 @@ subroutine prep_ice_calc_a2x_ix(a2x_ox, timer) #endif !--------------------------------------------------------------- +#ifdef MOABDEBUG + if (mboxid .ge. 0 ) then ! we are on coupler pes, for sure + write(lnum,"(I0.2)")num_moab_exports + outfile = 'OcnCplBef_o2i_'//trim(lnum)//'.h5m'//C_NULL_CHAR + wopts = ';PARALLEL=WRITE_PART'//C_NULL_CHAR ! + ierr = iMOAB_WriteMesh(mboxid, trim(outfile), trim(wopts)) + endif +#endif call t_drvstartf (trim(timer),barrier=mpicom_CPLID) do eai = 1,num_inst_atm @@ -917,6 +925,10 @@ end subroutine prep_ice_calc_a2x_ix !================================================================================================ subroutine prep_ice_calc_o2x_ix(timer) + +#ifdef MOABDEBUG + use iMOAB , only : iMOAB_WriteMesh +#endif !--------------------------------------------------------------- ! Description ! Create o2x_ix (note that o2x_ix is a local module variable) @@ -928,6 +940,22 @@ subroutine prep_ice_calc_o2x_ix(timer) integer :: eoi type(mct_aVect) , pointer :: o2x_ox character(*), parameter :: subname = '(prep_ice_calc_o2x_ix)' + +#ifdef MOABDEBUG + character*32 :: outfile, wopts, lnum + integer :: ierr +#endif + + !--------------------------------------------------------------- +#ifdef MOABDEBUG + if (mboxid .ge. 0 ) then ! we are on coupler pes, for sure + write(lnum,"(I0.2)")num_moab_exports + outfile = 'OcnCplBef_o2x_ix_'//trim(lnum)//'.h5m'//C_NULL_CHAR + wopts = ';PARALLEL=WRITE_PART'//C_NULL_CHAR ! + ierr = iMOAB_WriteMesh(mboxid, trim(outfile), trim(wopts)) + endif +#endif + !--------------------------------------------------------------- call t_drvstartf (trim(timer),barrier=mpicom_CPLID) @@ -936,7 +964,14 @@ subroutine prep_ice_calc_o2x_ix(timer) call seq_map_map(mapper_SFo2i, o2x_ox, o2x_ix(eoi), norm=.true.) enddo call t_drvstopf (trim(timer)) - +#ifdef MOABDEBUG + if (mboxid .ge. 0 ) then ! we are on coupler pes, for sure + write(lnum,"(I0.2)")num_moab_exports + outfile = 'OcnCplAft_o2x_ix_'//trim(lnum)//'.h5m'//C_NULL_CHAR + wopts = ';PARALLEL=WRITE_PART'//C_NULL_CHAR ! + ierr = iMOAB_WriteMesh(mboxid, trim(outfile), trim(wopts)) + endif +#endif end subroutine prep_ice_calc_o2x_ix !================================================================================================ diff --git a/driver-moab/main/prep_ocn_mod.F90 b/driver-moab/main/prep_ocn_mod.F90 index 6ff8028f7462..7e32c4533b41 100644 --- a/driver-moab/main/prep_ocn_mod.F90 +++ b/driver-moab/main/prep_ocn_mod.F90 @@ -2685,7 +2685,9 @@ end subroutine prep_ocn_merge subroutine prep_ocn_calc_a2x_ox(timer) !--------------------------------------------------------------- - ! +#ifdef MOABDEBUG + use iMOAB, only : iMOAB_WriteMesh +#endif ! Arguments character(len=*) , intent(in) :: timer ! @@ -2693,6 +2695,10 @@ subroutine prep_ocn_calc_a2x_ox(timer) integer :: eai type(mct_avect), pointer :: a2x_ax character(*), parameter :: subname = '(prep_ocn_calc_a2x_ox)' +#ifdef MOABDEBUG + character*32 :: outfile, wopts, lnum + integer :: ierr +#endif !--------------------------------------------------------------- call t_drvstartf (trim(timer),barrier=mpicom_CPLID) @@ -2711,6 +2717,15 @@ subroutine prep_ocn_calc_a2x_ox(timer) #endif enddo +#ifdef MOABDEBUG + if (mboxid .ge. 0 ) then ! we are on coupler pes, for sure + write(lnum,"(I0.2)")num_moab_exports + outfile = 'OcnCplAftA2O'//trim(lnum)//'.h5m'//C_NULL_CHAR + wopts = ';PARALLEL=WRITE_PART'//C_NULL_CHAR + ierr = iMOAB_WriteMesh(mboxid, trim(outfile), trim(wopts)) + endif +#endif + call t_drvstopf (trim(timer)) end subroutine prep_ocn_calc_a2x_ox diff --git a/driver-moab/main/seq_map_mod.F90 b/driver-moab/main/seq_map_mod.F90 index 80f2e96821c2..57937c84729f 100644 --- a/driver-moab/main/seq_map_mod.F90 +++ b/driver-moab/main/seq_map_mod.F90 @@ -486,14 +486,19 @@ subroutine seq_map_map( mapper, av_s, av_d, fldlist, norm, avwts_s, avwtsfld_s, #ifdef HAVE_MOAB if ( valid_moab_context ) then +#ifdef MOABDEBUG + if (seq_comm_iamroot(CPLID)) then + write(logunit, *) subname,' iMOAB mapper rearrange or copy ', mapper%mbname, ' send/recv tags ', trim(fldlist_moab), & + ' mbpresent=', mbpresent, ' mbnorm=', mbnorm + call shr_sys_flush(logunit) + endif +#endif ierr = iMOAB_SendElementTag( mapper%src_mbid, fldlist_moab, mapper%mpicom, mapper%intx_context ); if (ierr .ne. 0) then write(logunit, *) subname,' iMOAB mapper ', mapper%mbname, ' error in sending tags ', trim(fldlist_moab), ierr call shr_sys_flush(logunit) call shr_sys_abort(subname//' ERROR in sending tags') endif - endif - if ( valid_moab_context ) then ! receive in the target app ierr = iMOAB_ReceiveElementTag( mapper%tgt_mbid, fldlist_moab, mapper%mpicom, mapper%src_context ); if (ierr .ne. 0) then @@ -507,7 +512,8 @@ subroutine seq_map_map( mapper, av_s, av_d, fldlist, norm, avwts_s, avwtsfld_s, write(logunit,*) subname,' error in freeing buffers ', trim(fldlist_moab) call shr_sys_abort(subname//' ERROR in freeing buffers') ! serious enough endif - endif + endif ! if (valid_moab_context) + #endif else @@ -535,7 +541,12 @@ subroutine seq_map_map( mapper, av_s, av_d, fldlist, norm, avwts_s, avwtsfld_s, write(logunit,*) subname,' error setting init value for mapping norm factor ',ierr,trim(tagname) call shr_sys_abort(subname//' ERROR setting norm init value') ! serious enough endif - +#ifdef MOABDEBUG + if (seq_comm_iamroot(CPLID)) then + write(logunit, *) subname,' iMOAB mapper ', mapper%mbname, ' set norm8wt 1 on source with app id: ', mapper%src_mbid + call shr_sys_flush(logunit) + endif +#endif ! if a normalization factor was specified, get it and multiply src tags by it if(mbpresent) then tagname = avwtsfld_s//C_NULL_CHAR From 3cd23896c8854b5082c75d52a83389ba50dfccb1 Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Thu, 1 Jun 2023 23:24:00 -0500 Subject: [PATCH 384/467] prove that ocn merging modifies Faxa_lwdn also, add more info about shared fields; need to figure out if more fields are affected in this basically, it seems that there is a multiplication with the ocean fraction (ocn fraction close to the pole is 0) the message in mct says this: x2o%Faxa_lwdn = = a2x%Faxa_lwdn = afrac*a2x%Faxa_lwdn but it seems that x2o%Faxa_lwdn = ofrac * a2x_ox%Faxa_lwdn why is this noticeable for Faxa_lwdn only? Are there more like it ? --- driver-moab/main/prep_ice_mod.F90 | 6 +++--- driver-moab/main/prep_ocn_mod.F90 | 17 +++++++++++++---- 2 files changed, 16 insertions(+), 7 deletions(-) diff --git a/driver-moab/main/prep_ice_mod.F90 b/driver-moab/main/prep_ice_mod.F90 index 6669579997a7..057b64cc6f93 100644 --- a/driver-moab/main/prep_ice_mod.F90 +++ b/driver-moab/main/prep_ice_mod.F90 @@ -691,7 +691,7 @@ subroutine prep_ice_mrg_moab(infodata, rof_c2_ice) field = mct_aVect_getRList2c(i1, o2x_i) mrgstr(o1) = trim(mrgstr(o1))//' = o2x%'//trim(field) #ifdef MOABDEBUG - write(lnum, "(I3, A6, I3)" )i1, ' mb-> ', o1 + write(lnum, "(I3, A18, I3)" )i1, ' in o2x_ix, x2i_ix ', o1 mrgstr(o1) = trim(mrgstr(o1))//trim(lnum) #endif enddo @@ -701,7 +701,7 @@ subroutine prep_ice_mrg_moab(infodata, rof_c2_ice) field = mct_aVect_getRList2c(i1, a2x_i) mrgstr(o1) = trim(mrgstr(o1))//' = a2x%'//trim(field) #ifdef MOABDEBUG - write(lnum, "(I3, A6, I3)" )i1, ' mb-> ', o1 + write(lnum, "(I3, A18, I3)" )i1, ' in a2x_ix, x2i_ix', o1 mrgstr(o1) = trim(mrgstr(o1))//trim(lnum) #endif enddo @@ -711,7 +711,7 @@ subroutine prep_ice_mrg_moab(infodata, rof_c2_ice) field = mct_aVect_getRList2c(i1, g2x_i) mrgstr(o1) = trim(mrgstr(o1))//' = g2x%'//trim(field) #ifdef MOABDEBUG - write(lnum, "(I3, A6, I3)" )i1, ' mb-> ', o1 + write(lnum, "(I3, A18, I3)" )i1, ' in g2x_ix, x2i_ix ', o1 mrgstr(o1) = trim(mrgstr(o1))//trim(lnum) #endif enddo diff --git a/driver-moab/main/prep_ocn_mod.F90 b/driver-moab/main/prep_ocn_mod.F90 index 7e32c4533b41..d942c773ac94 100644 --- a/driver-moab/main/prep_ocn_mod.F90 +++ b/driver-moab/main/prep_ocn_mod.F90 @@ -1237,6 +1237,15 @@ subroutine prep_ocn_mrg_moab(infodata, xao_ox) endif lsize = nvise(1) ! number of active cells +#ifdef MOABDEBUG + if (mboxid .ge. 0 ) then ! we are on coupler pes, for sure + write(lnum,"(I0.2)")num_moab_exports + outfile = 'OcnCplBefMm'//trim(lnum)//'.h5m'//C_NULL_CHAR + wopts = ';PARALLEL=WRITE_PART'//C_NULL_CHAR ! + ierr = iMOAB_WriteMesh(mboxid, trim(outfile), trim(wopts)) + endif +#endif + if (first_time) then @@ -1512,7 +1521,7 @@ subroutine prep_ocn_mrg_moab(infodata, xao_ox) o1=a2x_SharedIndices%shared_real%aVindices2(i) mrgstr(o1) = trim(mrgstr(o1))//' = a2x%'//trim(field_atm(i1)) #ifdef MOABDEBUG - write(lnum, "(I3, A6, I3)" )i1, ' mb-> ', o1 + write(lnum, "(I3, A18, I3)" )i1, ' in a2x_o and x2o_o ', o1 mrgstr(o1) = trim(mrgstr(o1))//trim(lnum) #endif enddo @@ -1521,7 +1530,7 @@ subroutine prep_ocn_mrg_moab(infodata, xao_ox) o1=i2x_SharedIndices%shared_real%aVindices2(i) mrgstr(o1) = trim(mrgstr(o1))//' = i2x%'//trim(field_ice(i1)) #ifdef MOABDEBUG - write(lnum, "(I3, A6, I3)" )i1, ' mb-> ', o1 + write(lnum, "(I3, A20, I3)" )i1, ' in i2x_o and x2o_o ', o1 mrgstr(o1) = trim(mrgstr(o1))//trim(lnum) #endif enddo @@ -1530,7 +1539,7 @@ subroutine prep_ocn_mrg_moab(infodata, xao_ox) o1=r2x_SharedIndices%shared_real%aVindices2(i) mrgstr(o1) = trim(mrgstr(o1))//' = r2x%'//trim(field_rof(i1)) #ifdef MOABDEBUG - write(lnum, "(I3, A6, I3)" )i1, ' mb-> ', o1 + write(lnum, "(I3, A20, I3)" )i1, ' in r2x_o and x2o_o ', o1 mrgstr(o1) = trim(mrgstr(o1))//trim(lnum) #endif enddo @@ -1547,7 +1556,7 @@ subroutine prep_ocn_mrg_moab(infodata, xao_ox) shared_fields_xao_x2o = trim(shared_fields_xao_x2o)//trim(field_xao(i1))//':' size_of_shared_values = size_of_shared_values + lSize #ifdef MOABDEBUG - write(lnum, "(I3, A6, I3)" )i1, ' mb-> ', o1 + write(lnum, "(I3, A20, I3)" )i1, ' in xao_o and x2o_o ',o1 mrgstr(o1) = trim(mrgstr(o1))//trim(lnum) #endif enddo From e28809c7b3ff92782cb525b04edad9496f38daf3 Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Fri, 2 Jun 2023 15:25:26 -0500 Subject: [PATCH 385/467] major reversion a2i_ix is computed now before ocn merge a2x_ix is actually done from a2x_ox, which would have some tags modified by ocn merge (we noticed this for Faxa_lwdn) There are other tags potentially modified by ocn merge (find them) is this the correct solution ? --- driver-moab/main/cime_comp_mod.F90 | 23 +++++++++++++---------- driver-moab/main/prep_ocn_mod.F90 | 26 +++++++++++++++++++++++++- 2 files changed, 38 insertions(+), 11 deletions(-) diff --git a/driver-moab/main/cime_comp_mod.F90 b/driver-moab/main/cime_comp_mod.F90 index 662be85ccc10..5ca4532a12d9 100644 --- a/driver-moab/main/cime_comp_mod.F90 +++ b/driver-moab/main/cime_comp_mod.F90 @@ -3005,14 +3005,17 @@ subroutine cime_run() if (drv_threading) call seq_comm_setnthreads(nthreads_CPLID) call prep_ocn_calc_a2x_ox(timer='CPL:ocnpre1_atm2ocn') + ! move the proj of atm to ice right after calc of a2x_ox + if (atm_c2_ice .and. ice_prognostic ) then + ! This is special to avoid remapping atm to ocn + ! Note it is constrained that different prep modules cannot use or call each other + a2x_ox => prep_ocn_get_a2x_ox() ! array + call prep_ice_calc_a2x_ix(a2x_ox, timer='CPL:iceprep_atm2ice') + endif if (drv_threading) call seq_comm_setnthreads(nthreads_GLOID) call t_drvstopf ('CPL:OCNPRE1',cplrun=.true.,hashint=hashint(3)) endif - ! is this really needed here ? - if ( atm_c2_ocn) then - !call prep_ocn_calc_a2x_ox_moab(timer='CPL:ocnpre1_atm2ocn_moab', infodata=infodata) - endif !---------------------------------------------------------- !| ATM/OCN SETUP (rasm_option1) @@ -4753,12 +4756,12 @@ subroutine cime_run_ice_setup_send() if (glc_c2_ice) call prep_ice_calc_g2x_ix(timer='CPL:glcpost_glc2ice') end if - if (atm_c2_ice) then - ! This is special to avoid remapping atm to ocn - ! Note it is constrained that different prep modules cannot use or call each other - a2x_ox => prep_ocn_get_a2x_ox() ! array - call prep_ice_calc_a2x_ix(a2x_ox, timer='CPL:iceprep_atm2ice') - endif + ! if (atm_c2_ice) then + ! ! This is special to avoid remapping atm to ocn + ! ! Note it is constrained that different prep modules cannot use or call each other + ! a2x_ox => prep_ocn_get_a2x_ox() ! array + ! call prep_ice_calc_a2x_ix(a2x_ox, timer='CPL:iceprep_atm2ice') + ! endif call prep_ice_mrg(infodata, timer_mrg='CPL:iceprep_mrgx2i') diff --git a/driver-moab/main/prep_ocn_mod.F90 b/driver-moab/main/prep_ocn_mod.F90 index d942c773ac94..7c3d9b109c54 100644 --- a/driver-moab/main/prep_ocn_mod.F90 +++ b/driver-moab/main/prep_ocn_mod.F90 @@ -1521,7 +1521,7 @@ subroutine prep_ocn_mrg_moab(infodata, xao_ox) o1=a2x_SharedIndices%shared_real%aVindices2(i) mrgstr(o1) = trim(mrgstr(o1))//' = a2x%'//trim(field_atm(i1)) #ifdef MOABDEBUG - write(lnum, "(I3, A18, I3)" )i1, ' in a2x_o and x2o_o ', o1 + write(lnum, "(I3, A20, I3)" )i1, ' in a2x_o and x2o_o ', o1 mrgstr(o1) = trim(mrgstr(o1))//trim(lnum) #endif enddo @@ -1925,8 +1925,32 @@ subroutine prep_ocn_mrg_moab(infodata, xao_ox) write(logunit,'(A)') trim(mrgstr(ko)) enddo write(logunit,'(A)') subname//' shared fields between xao and x2o '//trim(shared_fields_xao_x2o) +#ifdef MOABDEBUG + write(logunit, *) ' Ocean fields computed on coupler' + do ko=1,noflds + write(logunit, *) trim(field_ocn(ko)), aindx(ko), amerge(ko), iindx(ko), imerge(ko), xindx(ko), xmerge(ko) + enddo + write(logunit, *) ' Atm fields projected on coupler' + do ka = 1,naflds + write(logunit, *) trim(field_atm(ka)) + enddo + write(logunit, *) ' Ice fields projected on coupler' + do ki = 1,niflds + write(logunit, *) trim(field_ice(ki)) + enddo + write(logunit, *) ' Runoff fields projected on coupler' + do kr = 1,nrflds + write(logunit, *) trim(field_rof(kr)) + enddo + write(logunit, *) ' xao flux fields ' + do kx = 1,nxflds + write(logunit, *) trim(field_xao(kx)) + enddo +#endif + endif deallocate(mrgstr) + deallocate(field_atm,itemc_atm) deallocate(field_ocn,itemc_ocn) deallocate(field_ice,itemc_ice) From b59ff483a4b8a097928b8a57370a3081fe9285c2 Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Tue, 13 Jun 2023 08:56:10 -0500 Subject: [PATCH 386/467] better messages for coupling --- driver-moab/main/cplcomp_exchange_mod.F90 | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) diff --git a/driver-moab/main/cplcomp_exchange_mod.F90 b/driver-moab/main/cplcomp_exchange_mod.F90 index 05f8856653a3..2d2320884517 100644 --- a/driver-moab/main/cplcomp_exchange_mod.F90 +++ b/driver-moab/main/cplcomp_exchange_mod.F90 @@ -1057,8 +1057,7 @@ subroutine cplcomp_moab_Init(infodata,comp) call shr_mpi_max(MPSIID, maxMSID, mpicom_join, all=.true.) call shr_mpi_max(mrofid, maxMRID, mpicom_join, all=.true.) if (seq_comm_iamroot(CPLID) ) then - write(logunit, *) "MOAB coupling: maxMH: ", maxMH, " maxMPO: ", maxMPO, & - " maxMLID: ", maxMLID + write(logunit, *) "MOAB coupling for ", comp%ntype endif ! this works now for atmosphere; if ( comp%oneletterid == 'a' .and. maxMH /= -1) then @@ -1309,10 +1308,15 @@ subroutine cplcomp_moab_Init(infodata,comp) endif ! 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 call seq_infodata_GetData(infodata,lnd_domain=lnd_domain) outfile = trim(lnd_domain)//C_NULL_CHAR nghlay = 0 ! no ghost layers + if (seq_comm_iamroot(CPLID) ) then + write(logunit, *) "load land domain file from file: ", trim(lnd_domain), & + " with options: ", trim(ropts) + endif ierr = iMOAB_LoadMesh(mblxid, outfile, ropts, nghlay) if (ierr .ne. 0) then write(logunit,*) subname,' error in reading land coupler mesh from ', trim(lnd_domain) From 306a2e0dd3195ff8b3b7856d8b7e7b108a239fea Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Sat, 17 Jun 2023 19:26:35 -0500 Subject: [PATCH 387/467] cleanup starts remove some extra debug files, used for tracking Faxa_lwdn mostly --- driver-moab/main/prep_atm_mod.F90 | 11 ------- driver-moab/main/prep_ice_mod.F90 | 50 +------------------------------ driver-moab/main/prep_ocn_mod.F90 | 25 ---------------- 3 files changed, 1 insertion(+), 85 deletions(-) diff --git a/driver-moab/main/prep_atm_mod.F90 b/driver-moab/main/prep_atm_mod.F90 index 40774d98de7b..b9ac4dabd08c 100644 --- a/driver-moab/main/prep_atm_mod.F90 +++ b/driver-moab/main/prep_atm_mod.F90 @@ -1749,17 +1749,6 @@ subroutine prep_atm_calc_o2x_ax(fractions_ox, timer) fldlist=seq_flds_o2x_fluxes,norm=.true.) enddo -#ifdef MOABDEBUG - ! projections on atm - write(lnum,"(I0.2)")num_moab_exports - outfile = 'OIL2Atm'//trim(lnum)//'.h5m'//C_NULL_CHAR - wopts = ';PARALLEL=WRITE_PART'//C_NULL_CHAR ! - ierr = iMOAB_WriteMesh(mbaxid, trim(outfile), trim(wopts)) - if (ierr .ne. 0) then - write(logunit,*) subname,' error in writing ocean to atm projection' - call shr_sys_abort(subname//' ERROR in writing ocean to atm projection') - endif -#endif call t_drvstopf (trim(timer)) end subroutine prep_atm_calc_o2x_ax diff --git a/driver-moab/main/prep_ice_mod.F90 b/driver-moab/main/prep_ice_mod.F90 index 057b64cc6f93..e90fb6159541 100644 --- a/driver-moab/main/prep_ice_mod.F90 +++ b/driver-moab/main/prep_ice_mod.F90 @@ -890,20 +890,7 @@ subroutine prep_ice_calc_a2x_ix(a2x_ox, timer) ! Local Variables integer :: eai character(*), parameter :: subname = '(prep_ice_calc_a2x_ix)' -#ifdef MOABDEBUG - character*32 :: outfile, wopts, lnum - integer :: ierr -#endif - !--------------------------------------------------------------- -#ifdef MOABDEBUG - if (mboxid .ge. 0 ) then ! we are on coupler pes, for sure - write(lnum,"(I0.2)")num_moab_exports - outfile = 'OcnCplBef_o2i_'//trim(lnum)//'.h5m'//C_NULL_CHAR - wopts = ';PARALLEL=WRITE_PART'//C_NULL_CHAR ! - ierr = iMOAB_WriteMesh(mboxid, trim(outfile), trim(wopts)) - endif -#endif call t_drvstartf (trim(timer),barrier=mpicom_CPLID) do eai = 1,num_inst_atm @@ -911,24 +898,11 @@ subroutine prep_ice_calc_a2x_ix(a2x_ox, timer) enddo call t_drvstopf (trim(timer)) -#ifdef MOABDEBUG - if (mbixid .ge. 0 ) then ! we are on coupler pes, for sure - write(lnum,"(I0.2)")num_moab_exports - outfile = 'IceCplAfto2i'//trim(lnum)//'.h5m'//C_NULL_CHAR - wopts = ';PARALLEL=WRITE_PART'//C_NULL_CHAR ! - ierr = iMOAB_WriteMesh(mbixid, trim(outfile), trim(wopts)) - endif -#endif - end subroutine prep_ice_calc_a2x_ix !================================================================================================ subroutine prep_ice_calc_o2x_ix(timer) - -#ifdef MOABDEBUG - use iMOAB , only : iMOAB_WriteMesh -#endif !--------------------------------------------------------------- ! Description ! Create o2x_ix (note that o2x_ix is a local module variable) @@ -941,21 +915,6 @@ subroutine prep_ice_calc_o2x_ix(timer) type(mct_aVect) , pointer :: o2x_ox character(*), parameter :: subname = '(prep_ice_calc_o2x_ix)' -#ifdef MOABDEBUG - character*32 :: outfile, wopts, lnum - integer :: ierr -#endif - - !--------------------------------------------------------------- -#ifdef MOABDEBUG - if (mboxid .ge. 0 ) then ! we are on coupler pes, for sure - write(lnum,"(I0.2)")num_moab_exports - outfile = 'OcnCplBef_o2x_ix_'//trim(lnum)//'.h5m'//C_NULL_CHAR - wopts = ';PARALLEL=WRITE_PART'//C_NULL_CHAR ! - ierr = iMOAB_WriteMesh(mboxid, trim(outfile), trim(wopts)) - endif -#endif - !--------------------------------------------------------------- call t_drvstartf (trim(timer),barrier=mpicom_CPLID) @@ -964,14 +923,7 @@ subroutine prep_ice_calc_o2x_ix(timer) call seq_map_map(mapper_SFo2i, o2x_ox, o2x_ix(eoi), norm=.true.) enddo call t_drvstopf (trim(timer)) -#ifdef MOABDEBUG - if (mboxid .ge. 0 ) then ! we are on coupler pes, for sure - write(lnum,"(I0.2)")num_moab_exports - outfile = 'OcnCplAft_o2x_ix_'//trim(lnum)//'.h5m'//C_NULL_CHAR - wopts = ';PARALLEL=WRITE_PART'//C_NULL_CHAR ! - ierr = iMOAB_WriteMesh(mboxid, trim(outfile), trim(wopts)) - endif -#endif + end subroutine prep_ice_calc_o2x_ix !================================================================================================ diff --git a/driver-moab/main/prep_ocn_mod.F90 b/driver-moab/main/prep_ocn_mod.F90 index 7c3d9b109c54..4d3c31f2ee84 100644 --- a/driver-moab/main/prep_ocn_mod.F90 +++ b/driver-moab/main/prep_ocn_mod.F90 @@ -1237,16 +1237,6 @@ subroutine prep_ocn_mrg_moab(infodata, xao_ox) endif lsize = nvise(1) ! number of active cells -#ifdef MOABDEBUG - if (mboxid .ge. 0 ) then ! we are on coupler pes, for sure - write(lnum,"(I0.2)")num_moab_exports - outfile = 'OcnCplBefMm'//trim(lnum)//'.h5m'//C_NULL_CHAR - wopts = ';PARALLEL=WRITE_PART'//C_NULL_CHAR ! - ierr = iMOAB_WriteMesh(mboxid, trim(outfile), trim(wopts)) - endif -#endif - - if (first_time) then ! mct avs are used just for their fields metadata, not the actual reals @@ -2718,9 +2708,6 @@ end subroutine prep_ocn_merge subroutine prep_ocn_calc_a2x_ox(timer) !--------------------------------------------------------------- -#ifdef MOABDEBUG - use iMOAB, only : iMOAB_WriteMesh -#endif ! Arguments character(len=*) , intent(in) :: timer ! @@ -2728,10 +2715,6 @@ subroutine prep_ocn_calc_a2x_ox(timer) integer :: eai type(mct_avect), pointer :: a2x_ax character(*), parameter :: subname = '(prep_ocn_calc_a2x_ox)' -#ifdef MOABDEBUG - character*32 :: outfile, wopts, lnum - integer :: ierr -#endif !--------------------------------------------------------------- call t_drvstartf (trim(timer),barrier=mpicom_CPLID) @@ -2750,14 +2733,6 @@ subroutine prep_ocn_calc_a2x_ox(timer) #endif enddo -#ifdef MOABDEBUG - if (mboxid .ge. 0 ) then ! we are on coupler pes, for sure - write(lnum,"(I0.2)")num_moab_exports - outfile = 'OcnCplAftA2O'//trim(lnum)//'.h5m'//C_NULL_CHAR - wopts = ';PARALLEL=WRITE_PART'//C_NULL_CHAR - ierr = iMOAB_WriteMesh(mboxid, trim(outfile), trim(wopts)) - endif -#endif call t_drvstopf (trim(timer)) From 83466e3091059a21bf61869d02a1112a84f4fd4e Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Sat, 17 Jun 2023 21:45:00 -0500 Subject: [PATCH 388/467] clean atm component rename initialize_moab_atm_phys to init_moab_atm_phys remove prim_init_moab_mesh routine call directly create_moab_meshes from semoab_mod remove unused variable num_calls_export in semoab_mod.f90 --- components/eam/src/cpl/atm_comp_mct.F90 | 6 +++--- components/eam/src/dynamics/se/dyn_comp.F90 | 4 ++-- components/eam/src/dynamics/se/semoab_mod.F90 | 4 ---- .../homme/src/share/prim_driver_base.F90 | 19 ------------------- 4 files changed, 5 insertions(+), 28 deletions(-) diff --git a/components/eam/src/cpl/atm_comp_mct.F90 b/components/eam/src/cpl/atm_comp_mct.F90 index 30b1f4814946..0c718340a3e8 100644 --- a/components/eam/src/cpl/atm_comp_mct.F90 +++ b/components/eam/src/cpl/atm_comp_mct.F90 @@ -420,7 +420,7 @@ subroutine atm_init_mct( EClock, cdata_a, x2a_a, a2x_a, NLFilename ) ! when called first time, initialize MOAB atm phis grid, and create the mesh ! on the atm #ifdef HAVE_MOAB - call initialize_moab_atm_phys( cdata_a ) + call init_moab_atm_phys( cdata_a ) mblsize = lsize nsend = mct_avect_nRattr(a2x_a) totalmbls = mblsize * nsend ! size of the double array @@ -1111,7 +1111,7 @@ subroutine atm_write_srfrest_mct( x2a_a, a2x_a, & end subroutine atm_write_srfrest_mct #ifdef HAVE_MOAB - subroutine initialize_moab_atm_phys( cdata_a ) + subroutine init_moab_atm_phys( cdata_a ) use shr_mpi_mod, only: shr_mpi_commrank, shr_mpi_commsize use shr_const_mod, only: SHR_CONST_PI @@ -1320,7 +1320,7 @@ subroutine initialize_moab_atm_phys( cdata_a ) deallocate(areavals) deallocate(chunk_index) - end subroutine initialize_moab_atm_phys + end subroutine init_moab_atm_phys subroutine atm_export_moab(cam_out) !------------------------------------------------------------------- diff --git a/components/eam/src/dynamics/se/dyn_comp.F90 b/components/eam/src/dynamics/se/dyn_comp.F90 index 6cf284dee337..7ff2bba0e219 100644 --- a/components/eam/src/dynamics/se/dyn_comp.F90 +++ b/components/eam/src/dynamics/se/dyn_comp.F90 @@ -106,7 +106,7 @@ subroutine dyn_init1(fh, NLFileName, dyn_in, dyn_out) use seq_comm_mct, only: MHID, MHFID ! id of homme moab coarse and fine applications use seq_comm_mct, only: ATMID use seq_comm_mct, only: mhpgid ! id of pgx moab application - use prim_driver_base, only: prim_init_moab_mesh ! insertion point for MOAB; after phys grid init + use semoab_mod, only: create_moab_meshes use iMOAB, only : iMOAB_RegisterApplication use iso_c_binding #endif @@ -269,7 +269,7 @@ subroutine dyn_init1(fh, NLFileName, dyn_in, dyn_out) end if #ifdef HAVE_MOAB - call prim_init_moab_mesh(elem,par) + call create_moab_meshes(par, elem) #endif ! Define the CAM grids (this has to be after dycore spinup). ! Physics-grid will be defined later by phys_grid_init diff --git a/components/eam/src/dynamics/se/semoab_mod.F90 b/components/eam/src/dynamics/se/semoab_mod.F90 index bd053dfdcceb..556273b571ec 100644 --- a/components/eam/src/dynamics/se/semoab_mod.F90 +++ b/components/eam/src/dynamics/se/semoab_mod.F90 @@ -35,7 +35,6 @@ module semoab_mod integer local_map(np,np) ! what is the index of gll point (i,j) in a local moabconn(start: start+(np-1)*(np-1)*4-1) integer, allocatable :: moabconn(:) ! will have the connectivity in terms of local index in verts - integer :: num_calls_export contains @@ -762,9 +761,6 @@ subroutine create_moab_meshes(par, elem) endif - ! initialize - num_calls_export = 0 - ! deallocate deallocate(moabvh) ! deallocate(moabconn) keep it , it is useful to set the tag on fine mesh diff --git a/components/homme/src/share/prim_driver_base.F90 b/components/homme/src/share/prim_driver_base.F90 index 12b9bd920888..b4cee83c325c 100644 --- a/components/homme/src/share/prim_driver_base.F90 +++ b/components/homme/src/share/prim_driver_base.F90 @@ -42,9 +42,6 @@ module prim_driver_base public :: prim_init1_no_cam #endif -#ifdef HAVE_MOAB - public :: prim_init_moab_mesh -#endif public :: smooth_topo_datasets, deriv1 @@ -738,22 +735,6 @@ subroutine prim_init1_buffers (elem,par) end subroutine prim_init1_buffers -#ifdef HAVE_MOAB - subroutine prim_init_moab_mesh(elem,par) - - use parallel_mod, only : parallel_t - use semoab_mod, only : create_moab_meshes - - ! - ! Inputs - ! - type (element_t), pointer :: elem(:) - type (parallel_t), intent(in) :: par - - call create_moab_meshes(par, elem) - - end subroutine prim_init_moab_mesh -#endif !_____________________________________________________________________ subroutine prim_init2(elem, hybrid, nets, nete, tl, hvcoord) From cb8e1121667a329581b29d1b20a3b8809bcec05f Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Sat, 17 Jun 2023 22:15:36 -0500 Subject: [PATCH 389/467] cleanup land component rename to init_moab_land move iMOAB_Register inside init_moab_land --- components/elm/src/cpl/lnd_comp_mct.F90 | 70 ++++++++++--------------- 1 file changed, 27 insertions(+), 43 deletions(-) diff --git a/components/elm/src/cpl/lnd_comp_mct.F90 b/components/elm/src/cpl/lnd_comp_mct.F90 index fff3ab348765..ee206fc1fc4a 100644 --- a/components/elm/src/cpl/lnd_comp_mct.F90 +++ b/components/elm/src/cpl/lnd_comp_mct.F90 @@ -41,7 +41,7 @@ module lnd_comp_mct private :: lnd_domain_mct ! set the land model domain information #ifdef HAVE_MOAB - private :: init_land_moab ! create moab mesh (cloud of points) + private :: init_moab_land ! create moab mesh (cloud of points) private :: lnd_export_moab ! it could be part of lnd_import_export, but we will keep it here private :: lnd_import_moab ! it could be part of lnd_import_export, but we will keep it here integer , private :: mblsize, totalmbls @@ -51,8 +51,8 @@ module lnd_comp_mct real (r8) , allocatable, private :: x2l_lm(:,:) ! for tags from MOAB logical :: sameg_al ! save it for export :) -#ifdef MOABCOMP - integer :: mpicom_lnd_moab ! used just for mpi-reducing the difference betweebn moab tags and mct avs +#ifdef HAVE_MOAB + integer :: mpicom_lnd_moab ! used also for mpi-reducing the difference between moab tags and mct avs integer :: rank2 #endif @@ -100,9 +100,7 @@ subroutine lnd_init_mct( EClock, cdata_l, x2l_l, l2x_l, NLFilename ) use perf_mod , only : t_startf, t_stopf use mct_mod use ESMF -#ifdef HAVE_MOAB - use iMOAB , only : iMOAB_RegisterApplication -#endif + ! ! !ARGUMENTS: type(ESMF_Clock), intent(inout) :: EClock ! Input synchronization clock @@ -153,7 +151,6 @@ subroutine lnd_init_mct( EClock, cdata_l, x2l_l, l2x_l, NLFilename ) #ifdef HAVE_MOAB integer :: ierr, nsend - character*32 appname logical :: samegrid_al ! character(len=SHR_KIND_CL) :: atm_gnam ! atm grid character(len=SHR_KIND_CL) :: lnd_gnam ! lnd grid @@ -172,9 +169,9 @@ subroutine lnd_init_mct( EClock, cdata_l, x2l_l, l2x_l, NLFilename ) call elm_instance_init( LNDID ) ! Determine attriute vector indices -#ifdef MOABCOMP - mpicom_lnd_moab = mpicom_lnd ! just store it now, for later use - call shr_mpi_commrank( mpicom_lnd_moab, rank2 ) +#ifdef HAVE_MOAB + mpicom_lnd_moab = mpicom_lnd ! just store it now, for later use; maybe it is the same as mpicom from spmdMod (or a copy) + call shr_mpi_commrank( mpicom_lnd_moab, rank2 ) ! this will be used for differences between mct and moab tags #endif call elm_cpl_indices_set() @@ -314,34 +311,6 @@ subroutine lnd_init_mct( EClock, cdata_l, x2l_l, l2x_l, NLFilename ) call lnd_SetgsMap_mct( bounds, mpicom_lnd, LNDID, gsMap_lnd ) lsz = mct_gsMap_lsize(gsMap_lnd, mpicom_lnd) -#ifdef HAVE_MOAB - appname="LNDMB"//C_NULL_CHAR - ! first land instance, should be 9 - ierr = iMOAB_RegisterApplication(appname, mpicom_lnd, LNDID, mlnid) - if (ierr > 0 ) & - call endrun('Error: cannot register moab app') - if(masterproc) then - write(iulog,*) " " - write(iulog,*) "register MOAB app:", trim(appname), " mlnid=", mlnid - write(iulog,*) " " - endif - -#if 0 - if (masterproc) then - debugGSMapFile = shr_file_getUnit() - open( debugGSMapFile, file='LndGSmapC.txt') - write(debugGSMapFile,*) gsMap_lnd%comp_id - write(debugGSMapFile,*) gsMap_lnd%ngseg - write(debugGSMapFile,*) gsMap_lnd%gsize - do n=1,gsMap_lnd%ngseg - write(debugGSMapFile,*) gsMap_lnd%start(n),gsMap_lnd%length(n),gsMap_lnd%pe_loc(n) - end do - close(debugGSMapFile) - call shr_file_freeunit(debugGSMapFile) - endif -#endif -! endif HAVE_MOAB -#endif call lnd_domain_mct( bounds, lsz, gsMap_lnd, dom_l ) #ifdef HAVE_MOAB @@ -352,7 +321,7 @@ subroutine lnd_init_mct( EClock, cdata_l, x2l_l, l2x_l, NLFilename ) lnd_gnam=lnd_gnam ) if (trim(atm_gnam) /= trim(lnd_gnam)) samegrid_al = .false. mb_land_mesh = .not. samegrid_al ! global variable, saved in seq_comm - call init_land_moab(bounds, samegrid_al) + call init_moab_land(bounds, samegrid_al, LNDID) sameg_al = samegrid_al ! will use it for export too #endif call mct_aVect_init(x2l_l, rList=seq_flds_x2l_fields, lsize=lsz) @@ -862,19 +831,22 @@ subroutine lnd_domain_mct( bounds, lsz, gsMap_l, dom_l ) end subroutine lnd_domain_mct #ifdef HAVE_MOAB - subroutine init_land_moab(bounds, samegrid_al) + subroutine init_moab_land(bounds, samegrid_al, LNDID) use seq_flds_mod , only : seq_flds_l2x_fields, seq_flds_x2l_fields use shr_kind_mod , only : CXX => SHR_KIND_CXX use spmdMod , only: iam ! rank on the land communicator use domainMod , only: ldomain ! ldomain is coming from module, not even passed use elm_varcon , only: re use shr_const_mod, only: SHR_CONST_PI - use iMOAB , only: iMOAB_CreateVertices, iMOAB_WriteMesh, & + use elm_varctl , only : iulog ! for messages + 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 type(bounds_type) , intent(in) :: bounds - logical :: samegrid_al + logical , intent(in) :: samegrid_al + integer , intent(in) :: LNDID ! id of the land app integer,allocatable :: gindex(:) ! Number the local grid points; used for global ID integer lsz ! keep local size @@ -890,9 +862,21 @@ subroutine init_land_moab(bounds, samegrid_al) integer tagtype, numco, ent_type, mbtype, block_ID character*100 outfile, wopts, localmeshfile character(CXX) :: tagname ! hold all fields + character*32 appname integer, allocatable :: moabconn(:) ! will have the connectivity in terms of local index in verts + appname="LNDMB"//C_NULL_CHAR + ! first land instance, should be 9 + ierr = iMOAB_RegisterApplication(appname, mpicom_lnd_moab, LNDID, mlnid) + if (ierr > 0 ) & + call endrun('Error: cannot register moab app') + if(masterproc) then + write(iulog,*) " " + write(iulog,*) "register MOAB app:", trim(appname), " mlnid=", mlnid + write(iulog,*) " " + endif + dims =3 ! store as 3d mesh ! number the local grid lsz = bounds%endg - bounds%begg + 1 @@ -1150,7 +1134,7 @@ subroutine init_land_moab(bounds, samegrid_al) call endrun('Error: fail to define seq_flds_x2l_fields for land moab mesh') endif - end subroutine init_land_moab + end subroutine init_moab_land subroutine lnd_export_moab( bounds, lnd2atm_vars, lnd2glc_vars) From a3c54581046df76e50f2cba88ec8716f23c6733a Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Sat, 17 Jun 2023 22:38:37 -0500 Subject: [PATCH 390/467] clean rof comp rename init_rof_moab to init_moab_rof move iMOAB_RegisterApp inside init_moab_rof --- components/mosart/src/cpl/rof_comp_mct.F90 | 49 ++++++++++++---------- 1 file changed, 26 insertions(+), 23 deletions(-) diff --git a/components/mosart/src/cpl/rof_comp_mct.F90 b/components/mosart/src/cpl/rof_comp_mct.F90 index acf5481eb543..ab84ea84c9bf 100644 --- a/components/mosart/src/cpl/rof_comp_mct.F90 +++ b/components/mosart/src/cpl/rof_comp_mct.F90 @@ -64,8 +64,8 @@ module rof_comp_mct use ESMF #ifdef HAVE_MOAB use seq_comm_mct, only : mrofid ! id of moab rof app - use seq_comm_mct, only : seq_comm_compare_mb_mct ! for debugging - use seq_comm_mct, only: num_moab_exports + use seq_comm_mct, only : seq_comm_compare_mb_mct ! for debugging + use seq_comm_mct, only: num_moab_exports use iso_c_binding use iMOAB, only: iMOAB_DefineTagStorage, iMOAB_SetDoubleTagStorage #endif @@ -89,7 +89,7 @@ module rof_comp_mct private :: rof_export_mct ! Export the river runoff model data to the CESM coupler ! #ifdef HAVE_MOAB - private :: init_rof_moab ! create moab mesh (cloud of points) + private :: init_moab_rof ! create moab mesh (cloud of points) private :: rof_export_moab ! Export the river runoff model data to the MOAB coupler private :: rof_import_moab ! import the river runoff model data from the MOAB coupler integer , private :: mblsize, totalmbls, totalmbls_r @@ -115,7 +115,6 @@ subroutine rof_init_mct( EClock, cdata_r, x2r_r, r2x_r, NLFilename) ! ! !ARGUMENTS: #ifdef HAVE_MOAB - use iMOAB , only : iMOAB_RegisterApplication integer :: nsend ! number of fields in seq_flds_r2x_fields integer :: nrecv ! number of fields in seq_flds_x2r_fields #endif @@ -163,7 +162,6 @@ subroutine rof_init_mct( EClock, cdata_r, x2r_r, r2x_r, NLFilename) #ifdef HAVE_MOAB integer :: ierr, tagtype, numco, tagindex - character*32 appname character(CXX) :: tagname ! for fields integer :: ent_type #endif @@ -307,17 +305,7 @@ subroutine rof_init_mct( EClock, cdata_r, x2r_r, r2x_r, NLFilename) call rof_export_mct( r2x_r ) #ifdef HAVE_MOAB - appname="ROFMB"//C_NULL_CHAR ! only if rof_prognostic - ! first rof instance, should be - ierr = iMOAB_RegisterApplication(appname, mpicom_rof, ROFID, mrofid) - if (ierr > 0 ) & - call shr_sys_abort( sub//' Error: cannot register moab app') - if(masterproc) then - write(iulog,*) " " - write(iulog,*) "register MOAB ROF app:", trim(appname), " mrofid=", mrofid, " ROFID=", ROFID - write(iulog,*) " " - endif - call init_rof_moab() + call init_moab_rof(mpicom_rof, ROFID) ! initialize moab tag fields array mblsize = lsize @@ -920,14 +908,17 @@ subroutine rof_export_mct( r2x_r ) end subroutine rof_export_mct #ifdef HAVE_MOAB - subroutine init_rof_moab() + subroutine init_moab_rof(mpicom_rof, ROFID) ! use rtmCTL that has all we need use seq_comm_mct, only: mrofid ! id of moab rof app use shr_const_mod, only: SHR_CONST_PI - use iMOAB, only : iMOAB_CreateVertices, iMOAB_WriteMesh, & - iMOAB_DefineTagStorage, iMOAB_SetIntTagStorage, iMOAB_SetDoubleTagStorage, & + use iMOAB, only : iMOAB_RegisterApplication, iMOAB_CreateVertices, iMOAB_WriteMesh, & + iMOAB_SetIntTagStorage, & iMOAB_ResolveSharedEntities, iMOAB_CreateElements, iMOAB_MergeVertices, iMOAB_UpdateMeshInfo + integer, intent(in) :: mpicom_rof + integer, intent(in) :: ROFID ! passed along + integer,allocatable :: gindex(:) ! Number the local grid points; used for global ID integer lsz ! keep local size integer gsize ! global size, that we do not need, actually @@ -943,9 +934,21 @@ subroutine init_rof_moab() integer tagtype, numco, ent_type, mbtype, block_ID character*100 outfile, wopts, localmeshfile, tagname real(r8) :: re = SHR_CONST_REARTH*0.001_r8 ! radius of earth (km) - character(len=32), parameter :: sub = 'init_rof_moab' + character*32 appname + character(len=32), parameter :: sub = 'init_moab_rof' character(len=*), parameter :: format = "('("//trim(sub)//") :',A)" + appname="ROFMB"//C_NULL_CHAR ! only if rof_prognostic + ! first rof instance, should be + ierr = iMOAB_RegisterApplication(appname, mpicom_rof, ROFID, mrofid) + if (ierr > 0 ) & + call shr_sys_abort( sub//' Error: cannot register moab app') + if(masterproc) then + write(iulog,*) " " + write(iulog,*) "register MOAB ROF app:", trim(appname), " mrofid=", mrofid, " ROFID=", ROFID + write(iulog,*) " " + endif + dims =3 ! store as 3d mesh ! number the local grid @@ -989,7 +992,7 @@ subroutine init_rof_moab() call shr_sys_abort( sub//' Error: fail to resolve shared entities') !there are no shared entities, but we will set a special partition tag, in order to see the - ! partitions ; it will be visible with a Pseudocolor plot in VisItinit_rof_moab + ! partitions ; it will be visible with a Pseudocolor plot in VisIt init_moab_rof tagname='partition'//C_NULL_CHAR ierr = iMOAB_DefineTagStorage(mrofid, tagname, tagtype, numco, tagindex ) if (ierr > 0 ) & @@ -1049,7 +1052,7 @@ subroutine init_rof_moab() if (ierr > 0 ) & call shr_sys_abort( sub//' Error: fail to write the moab runoff mesh file') #endif - end subroutine init_rof_moab + end subroutine init_moab_rof subroutine rof_export_moab() @@ -1062,7 +1065,7 @@ subroutine rof_export_moab() ! ARGUMENTS: use seq_comm_mct, only: mrofid ! id of moab rof app - use iMOAB, only : iMOAB_SetDoubleTagStorage, iMOAB_WriteMesh + use iMOAB, only : iMOAB_WriteMesh implicit none ! ! LOCAL VARIABLES From 367b905c8411c8294a678fd6ef510fd393f1a2e3 Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Sun, 18 Jun 2023 07:55:29 -0500 Subject: [PATCH 391/467] rename mpas_moab_instance to init_moab_mpas --- components/mpas-framework/src/framework/mpas_moabmesh.F | 4 ++-- components/mpas-ocean/driver/ocn_comp_mct.F | 2 +- components/mpas-seaice/driver/ice_comp_mct.F | 2 +- 3 files changed, 4 insertions(+), 4 deletions(-) diff --git a/components/mpas-framework/src/framework/mpas_moabmesh.F b/components/mpas-framework/src/framework/mpas_moabmesh.F index 9339004f1966..5f1f2acbdc58 100644 --- a/components/mpas-framework/src/framework/mpas_moabmesh.F +++ b/components/mpas-framework/src/framework/mpas_moabmesh.F @@ -24,7 +24,7 @@ SUBROUTINE errorout(ierr, message) return end subroutine - subroutine mpas_moab_instance(domain, ext_comp_id, pidmoab) + subroutine init_moab_mpas(domain, ext_comp_id, pidmoab) use iMOAB, only : iMOAB_RegisterApplication, & iMOAB_CreateVertices, iMOAB_CreateElements, & iMOAB_ResolveSharedEntities, iMOAB_DetermineGhostEntities, & @@ -225,6 +225,6 @@ subroutine mpas_moab_instance(domain, ext_comp_id, pidmoab) - end subroutine mpas_moab_instance + end subroutine init_moab_mpas #endif end module mpas_moabmesh diff --git a/components/mpas-ocean/driver/ocn_comp_mct.F b/components/mpas-ocean/driver/ocn_comp_mct.F index f076d233d75d..7c1ce122a958 100644 --- a/components/mpas-ocean/driver/ocn_comp_mct.F +++ b/components/mpas-ocean/driver/ocn_comp_mct.F @@ -595,7 +595,7 @@ end subroutine xml_stream_get_attributes end if call t_stopf('mpaso_init2') #ifdef HAVE_MOAB - call mpas_moab_instance(domain_ptr, OCNID, MPOID) ! should return MPOID .. + call init_moab_mpas(domain_ptr, OCNID, MPOID) ! should return MPOID .. call mpas_log_write('initialized MOAB MPAS ocean instance... ') #endif diff --git a/components/mpas-seaice/driver/ice_comp_mct.F b/components/mpas-seaice/driver/ice_comp_mct.F index 24bc86e0b82c..412e83f53690 100644 --- a/components/mpas-seaice/driver/ice_comp_mct.F +++ b/components/mpas-seaice/driver/ice_comp_mct.F @@ -645,7 +645,7 @@ end subroutine xml_stream_get_attributes call mpas_log_write('Core init failed for core ' // trim(domain % core % coreName), MPAS_LOG_CRIT) end if #ifdef HAVE_MOAB - call mpas_moab_instance(domain, ICEID, MPSIID) ! should return MPSIID .. + call init_moab_mpas(domain, ICEID, MPSIID) ! should return MPSIID .. call mpas_log_write('initialized MOAB MPAS sea-ice instance... ') #endif !----------------------------------------------------------------------- From bd69f1c175c78aac28b08ee01ce5d6f4b9fa5658 Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Wed, 12 Jul 2023 16:20:38 -0500 Subject: [PATCH 392/467] more debug to track fractions on atm and ice --- driver-moab/main/seq_frac_mct.F90 | 24 +++++++++++++++++++++++- 1 file changed, 23 insertions(+), 1 deletion(-) diff --git a/driver-moab/main/seq_frac_mct.F90 b/driver-moab/main/seq_frac_mct.F90 index 517f55e23e87..944382c6732e 100644 --- a/driver-moab/main/seq_frac_mct.F90 +++ b/driver-moab/main/seq_frac_mct.F90 @@ -180,6 +180,9 @@ module seq_frac_mct iMOAB_GetMeshInfo, iMOAB_SetDoubleTagStorageWithGid, iMOAB_WriteMesh, & iMOAB_ApplyScalarProjectionWeights, iMOAB_SendElementTag, iMOAB_ReceiveElementTag, & iMOAB_FreeSenderBuffers, iMOAB_GetDoubleTagStorage +#ifdef MOABDEBUG + use seq_comm_mct, only : num_moab_exports +#endif use shr_kind_mod, only: CL => SHR_KIND_CL, CX => SHR_KIND_CX, CXX => SHR_KIND_CXX use iso_c_binding ! C_NULL_CHAR @@ -847,6 +850,9 @@ subroutine seq_frac_set(infodata, ice, ocn, fractions_a, fractions_i, fractions_ real(r8), allocatable, save :: tagValues(:) ! used for setting some tags real(r8), allocatable, save :: tagValuesOfrac(:) ! used for setting some tags integer , allocatable, save :: GlobalIds(:) ! used for setting values associated with ids +#ifdef MOABDEBUG + character(len=100) :: outfile, wopts, lnum +#endif !----- formats ----- character(*),parameter :: subName = '(seq_frac_set) ' @@ -915,6 +921,13 @@ subroutine seq_frac_set(infodata, ice, ocn, fractions_a, fractions_i, fractions_ write(logunit,*) subname,' error in setting ofrac on ice moab instance ' call shr_sys_abort(subname//' ERROR in setting ofrac on ice moab instance ') endif +#ifdef MOABDEBUG + write(lnum,"(I0.2)")num_moab_exports + outfile = 'iceCplFr_'//trim(lnum)//'.h5m'//C_NULL_CHAR + wopts = 'PARALLEL=WRITE_PART'//C_NULL_CHAR + ierr = iMOAB_WriteMesh(mbixid, outfile, wopts) +#endif + endif if (ocn_present) then @@ -927,6 +940,10 @@ subroutine seq_frac_set(infodata, ice, ocn, fractions_a, fractions_i, fractions_ ent_type = 1! cells ierr = iMOAB_GetDoubleTagStorage ( mboxid, tagname, local_size_mb_ocn , ent_type, tagValuesOfrac) ierr = iMOAB_SetDoubleTagStorage ( mbofxid, tagname, local_size_mb_ocn , ent_type, tagValuesOfrac) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in setting ofrac on mbofxid moab instance ' + call shr_sys_abort(subname//' ERROR in setting ofrac on mbofxid moab instance ') + endif endif @@ -934,7 +951,12 @@ subroutine seq_frac_set(infodata, ice, ocn, fractions_a, fractions_i, fractions_ mapper_i2a => prep_atm_get_mapper_Fi2a() call seq_map_map(mapper_i2a, fractions_i, fractions_a, & fldlist='ofrac:ifrac', norm=.false.) - +#ifdef MOABDEBUG + write(lnum,"(I0.2)")num_moab_exports + outfile = 'atmCplFr_'//trim(lnum)//'.h5m'//C_NULL_CHAR + wopts = 'PARALLEL=WRITE_PART'//C_NULL_CHAR + ierr = iMOAB_WriteMesh(mbaxid, outfile, wopts) +#endif !tcx--- fraction correction, this forces the fractions_a to sum to 1.0_r8. ! --- but it introduces a conservation error in mapping if (atm_frac_correct) then From 239ba89153aca16919ccfe97008de76d7a8cc388 Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Thu, 13 Jul 2023 23:32:01 -0500 Subject: [PATCH 393/467] expose mct only in debug mode --- driver-moab/main/cime_comp_mod.F90 | 16 +++++++++------- driver-moab/main/prep_aoflux_mod.F90 | 4 +++- driver-moab/main/seq_frac_mct.F90 | 7 ++++++- driver-moab/shr/seq_comm_mct.F90 | 5 +++++ 4 files changed, 23 insertions(+), 9 deletions(-) diff --git a/driver-moab/main/cime_comp_mod.F90 b/driver-moab/main/cime_comp_mod.F90 index 5ca4532a12d9..a6f4e108a63c 100644 --- a/driver-moab/main/cime_comp_mod.F90 +++ b/driver-moab/main/cime_comp_mod.F90 @@ -1425,7 +1425,9 @@ subroutine cime_init() seq_flds_o2x_fields, seq_flds_r2x_fields, seq_flds_i2x_fields use seq_comm_mct , only : mphaid, mbaxid, mlnid, mblxid, mrofid, mbrxid, mpoid, mboxid, mpsiid, mbixid use seq_comm_mct, only: num_moab_exports ! used to count the steps for moab files - +#ifdef MOABDEBUGMCT + integer :: dummy_iMOAB +#endif 103 format( 5A ) 104 format( A, i10.8, i8) @@ -2605,22 +2607,22 @@ subroutine cime_init() call shr_sys_flush(logunit) endif if (atm_present) then - call expose_mct_grid_moab(atm(1)) + call expose_mct_grid_moab(atm(1), dummy_iMOAB) endif if (lnd_present) then - call expose_mct_grid_moab(lnd(1)) + call expose_mct_grid_moab(lnd(1), dummy_iMOAB) endif if (ocn_present) then - call expose_mct_grid_moab(ocn(1)) + call expose_mct_grid_moab(ocn(1), dummy_iMOAB) endif if (ice_present) then - call expose_mct_grid_moab(ice(1)) + call expose_mct_grid_moab(ice(1), dummy_iMOAB) endif if (rof_present) then - call expose_mct_grid_moab(rof(1)) + call expose_mct_grid_moab(rof(1), dummy_iMOAB) endif if (glc_present) then - call expose_mct_grid_moab(glc(1)) + call expose_mct_grid_moab(glc(1), dummy_iMOAB) endif #endif diff --git a/driver-moab/main/prep_aoflux_mod.F90 b/driver-moab/main/prep_aoflux_mod.F90 index 1fc56a79647f..9c89b7d8b1b3 100644 --- a/driver-moab/main/prep_aoflux_mod.F90 +++ b/driver-moab/main/prep_aoflux_mod.F90 @@ -8,7 +8,9 @@ module prep_aoflux_mod use seq_comm_mct, only: num_inst_xao, num_inst_frc, num_inst_ocn use seq_comm_mct, only: CPLID, logunit use seq_comm_mct, only : mbofxid ! iMOAB id for mpas ocean migrated mesh to coupler pes, just for xao flux calculations - use seq_comm_mct, only : mbox2id ! +#ifdef MOABDEBUG + use seq_comm_mct, only : mbox2id ! used only for debugging ocn and mct +#endif use seq_comm_mct, only : mbaxid ! iMOAB app id for atm on cpl pes use seq_comm_mct, only: seq_comm_getData=>seq_comm_setptrs use seq_comm_mct, only : num_moab_exports diff --git a/driver-moab/main/seq_frac_mct.F90 b/driver-moab/main/seq_frac_mct.F90 index 944382c6732e..88622ff45e45 100644 --- a/driver-moab/main/seq_frac_mct.F90 +++ b/driver-moab/main/seq_frac_mct.F90 @@ -165,8 +165,10 @@ module seq_frac_mct use iMOAB, only: iMOAB_DefineTagStorage use seq_comm_mct, only : mbaxid ! iMOAB id for atm migrated mesh to coupler pes use seq_comm_mct, only : mblxid ! iMOAB app id for lnd on cpl pes +#ifdef MOABDEBUG use seq_comm_mct, only : mblx2id ! iMOAB id for land mesh instanced from MCT on coupler pes use seq_comm_mct, only : mbox2id ! iMOAB id for ocn mesh instanced from MCT on coupler pes +#endif use seq_comm_mct, only : mboxid ! iMOAB app id for ocn on cpl pes use seq_comm_mct, only : mbofxid ! iMOAB id for mpas ocean migrated mesh to coupler pes, just for xao flux calculations use seq_comm_mct, only : mbixid ! iMOAB for sea-ice migrated to coupler @@ -455,9 +457,10 @@ subroutine seq_frac_init( infodata, & endif deallocate(tagValues) endif +#ifdef MOABDEBUG ! mblx2id is the id for moab app exposing land cpl call expose_mct_grid_moab(lnd, mblx2id) - +#endif kk = mct_aVect_indexRA(fractions_l,"lfrin",perrWith=subName) kf = mct_aVect_indexRA(dom_l%data ,"frac" ,perrWith=subName) @@ -614,8 +617,10 @@ subroutine seq_frac_init( infodata, & lSize = mct_aVect_lSize(dom_o%data) call mct_aVect_init(fractions_o,rList=fraclist_o,lsize=lsize) call mct_aVect_zero(fractions_o) +#ifdef MOABDEBUG ! initialize ocn imoab app on mct grid call expose_mct_grid_moab(ocn, mbox2id) ! will use then to set the data on it , for debugging +#endif if (mboxid .ge. 0 ) then ! // tagname = trim(fraclist_o)//C_NULL_CHAR ! 'afrac:ifrac:ofrac:ifrad:ofrad' tagtype = 1 ! dense, double diff --git a/driver-moab/shr/seq_comm_mct.F90 b/driver-moab/shr/seq_comm_mct.F90 index 5cddb78c1380..c167824cf3b0 100644 --- a/driver-moab/shr/seq_comm_mct.F90 +++ b/driver-moab/shr/seq_comm_mct.F90 @@ -227,8 +227,10 @@ module seq_comm_mct integer, public :: mbintxao ! iMOAB id for intx mesh between ocean and atmosphere integer, public :: mbintxoa ! iMOAB id for intx mesh between atmosphere and ocean integer, public :: mblxid ! iMOAB id for land mesh migrated to coupler pes +!!#ifdef MOABDEBUG integer, public :: mblx2id ! iMOAB id for land mesh instanced from MCT on coupler pes integer, public :: mbox2id ! iMOAB id for ocn mesh instanced from MCT on coupler pes +!!#endif integer, public :: mbintxla ! iMOAB id for intx mesh between land and atmosphere integer, public :: mbintxal ! iMOAB id for intx mesh between atmosphere and land integer, public :: mpsiid ! iMOAB id for sea-ice, mpas model @@ -664,7 +666,10 @@ subroutine seq_comm_init(global_comm_in, driver_comm_in, nmlfile, drv_comm_id) mbintxao = -1 ! iMOAB id for atm intx with mpas ocean mbintxoa = -1 ! iMOAB id for mpas ocean intx with atm mblxid = -1 ! iMOAB id for land on coupler pes +!!#ifdef MOABDEBUG mbox2id = -1 ! iMOAB id for ocn from mct on coupler pes + mblx2id = -1 +!!#endif mbintxla = -1 ! iMOAB id for land intx with atm on coupler pes mbintxal = -1 ! iMOAB id for atm intx with lnd on coupler pes mpsiid = -1 ! iMOAB for sea-ice From 46998ba3f5e7f860bb158319eee0ebc45eb0a182 Mon Sep 17 00:00:00 2001 From: iulian07 Date: Mon, 17 Jul 2023 16:59:57 -0500 Subject: [PATCH 394/467] fix compile error when MOABDEBUG not defined --- driver-moab/main/prep_aoflux_mod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/driver-moab/main/prep_aoflux_mod.F90 b/driver-moab/main/prep_aoflux_mod.F90 index 9c89b7d8b1b3..c833c255344f 100644 --- a/driver-moab/main/prep_aoflux_mod.F90 +++ b/driver-moab/main/prep_aoflux_mod.F90 @@ -171,6 +171,7 @@ subroutine prep_aoflux_init (infodata) call shr_sys_abort(subname//' ERROR in zeroing out xao_fields in init ') endif +#ifdef MOABDEBUG allocate(xao_omct(lsize_o, size_list)) ! the transpose of xao_ox(size_list, lsize_o) ! create for debugging the tags on mbox2id (mct grid on coupler) ierr = iMOAB_DefineTagStorage(mbox2id, tagname, tagtype, numco, tagindex ) @@ -188,7 +189,6 @@ subroutine prep_aoflux_init (infodata) endif deallocate(tagValues) !deallocate(xao_omct) -#ifdef MOABDEBUG ! debug out file outfile = 'o_flux.h5m'//C_NULL_CHAR wopts = 'PARALLEL=WRITE_PART'//C_NULL_CHAR From 16900ebde2178bd927529b142fa1d62c16c6ec8b Mon Sep 17 00:00:00 2001 From: iulian07 Date: Mon, 17 Jul 2023 17:50:04 -0500 Subject: [PATCH 395/467] another more serious issue, found only by test case tagValues should have been deallocated because they have different sizes, some refer to atm, some to ocean mbox2id is used only for debugging to compare with fluxes computed by mct --- driver-moab/main/prep_aoflux_mod.F90 | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/driver-moab/main/prep_aoflux_mod.F90 b/driver-moab/main/prep_aoflux_mod.F90 index c833c255344f..21ce228e7ab3 100644 --- a/driver-moab/main/prep_aoflux_mod.F90 +++ b/driver-moab/main/prep_aoflux_mod.F90 @@ -166,20 +166,21 @@ subroutine prep_aoflux_init (infodata) ent_type = 1 ! cell type tagValues = 0._r8 ierr = iMOAB_SetDoubleTagStorage ( mbofxid, tagname, arrSize , ent_type, tagValues(1)) + deallocate(tagValues) if (ierr .ne. 0) then write(logunit,*) subname,' error in zeroing out xao_fields ' call shr_sys_abort(subname//' ERROR in zeroing out xao_fields in init ') endif -#ifdef MOABDEBUG allocate(xao_omct(lsize_o, size_list)) ! the transpose of xao_ox(size_list, lsize_o) + xao_omct = 0._r8 +#ifdef MOABDEBUG ! create for debugging the tags on mbox2id (mct grid on coupler) ierr = iMOAB_DefineTagStorage(mbox2id, tagname, tagtype, numco, tagindex ) if (ierr .ne. 0) then write(logunit,*) subname,' error in defining tags on ocn mct mesh on cpl ' call shr_sys_abort(subname//' ERROR in defining tags on ocn mct mesh on cpl') endif - xao_omct = 0._r8 ent_type = 0 ! cell type, this is point cloud mct arrSize = lsize_o * size_list ierr = iMOAB_SetDoubleTagStorage ( mbox2id, tagname, arrSize , ent_type, xao_omct ) @@ -187,7 +188,6 @@ subroutine prep_aoflux_init (infodata) write(logunit,*) subname,' error in zeroing out xao_fields on mct instance ocn ' call shr_sys_abort(subname//' ERROR in zeroing out xao_fields on mct instance ocn ') endif - deallocate(tagValues) !deallocate(xao_omct) ! debug out file outfile = 'o_flux.h5m'//C_NULL_CHAR @@ -206,7 +206,6 @@ subroutine prep_aoflux_init (infodata) write(logunit,*) subname,' error in writing ox_mct mesh with 0 values ' call shr_sys_abort(subname//' ERROR in writing ox_mct mesh ') endif - #endif endif @@ -233,6 +232,7 @@ subroutine prep_aoflux_init (infodata) ent_type = 1 ! cell type now, not a point cloud anymore tagValues = 0._r8 ierr = iMOAB_SetDoubleTagStorage ( mbaxid, tagname, arrSize , ent_type, tagValues) + deallocate(tagValues) if (ierr .ne. 0) then write(logunit,*) subname,' error in zeroing out xao_fields ' call shr_sys_abort(subname//' ERROR in zeroing out xao_fields in init ') From 2bdeb5a1aa68fb8e08627efb7801a02583440cde Mon Sep 17 00:00:00 2001 From: iulian07 Date: Sat, 22 Jul 2023 04:01:31 -0500 Subject: [PATCH 396/467] force new Si2a map we do not want to reuse ocn to atm map in this case also force Fi2a new map; this one is responsible for Sf_ifrac --- driver-moab/main/prep_atm_mod.F90 | 7 +++++-- driver-moab/main/seq_map_type_mod.F90 | 10 ++++++++++ 2 files changed, 15 insertions(+), 2 deletions(-) diff --git a/driver-moab/main/prep_atm_mod.F90 b/driver-moab/main/prep_atm_mod.F90 index b9ac4dabd08c..78dcf4230ea9 100644 --- a/driver-moab/main/prep_atm_mod.F90 +++ b/driver-moab/main/prep_atm_mod.F90 @@ -440,9 +440,11 @@ subroutine prep_atm_init(infodata, ocn_c2_atm, ice_c2_atm, lnd_c2_atm, iac_c2_at write(logunit,*) ' ' write(logunit,F00) 'Initializing mapper_Si2a' endif + no_match = .true. ! force to create a new mapper object + ! otherwise it may find ocean map, and this will not work on ice vars call seq_map_init_rcfile(mapper_Si2a, ice(1), atm(1), & 'seq_maps.rc','ice2atm_smapname:','ice2atm_smaptype:',samegrid_ao, & - 'mapper_Si2a initialization',esmf_map_flag) + 'mapper_Si2a initialization',esmf_map_flag, no_match) ! similar to ocn-atm mapping, do ice 2 atm mapping / set up #ifdef HAVE_MOAB @@ -567,9 +569,10 @@ subroutine prep_atm_init(infodata, ocn_c2_atm, ice_c2_atm, lnd_c2_atm, iac_c2_at write(logunit,*) ' ' write(logunit,F00) 'Initializing mapper_Fi2a' endif + no_match = .true. ! force a different map, we do not want to match to ocean call seq_map_init_rcfile(mapper_Fi2a, ice(1), atm(1), & 'seq_maps.rc','ice2atm_fmapname:','ice2atm_fmaptype:',samegrid_ao, & - 'mapper_Fi2a initialization',esmf_map_flag) + 'mapper_Fi2a initialization',esmf_map_flag, no_match) #ifdef HAVE_MOAB ! now take care of the mapper for MOAB diff --git a/driver-moab/main/seq_map_type_mod.F90 b/driver-moab/main/seq_map_type_mod.F90 index 65c49dd5e557..d9ae0875910c 100644 --- a/driver-moab/main/seq_map_type_mod.F90 +++ b/driver-moab/main/seq_map_type_mod.F90 @@ -117,6 +117,10 @@ subroutine seq_map_mapmatch(mapid,gsMap_s,gsMap_d,mapfile,strategy) mapid = m if (seq_comm_iamroot(CPLID)) then write(logunit,'(A,i6)') subname//' found match ',mapid +#ifdef MOABCOMP + write(logunit,'(A,i6)') subname//' strategy '//trim(seq_maps(mapid)%strategy)//& + ' mapfile '//trim(seq_maps(mapid)%mapfile) +#endif call shr_sys_flush(logunit) endif return @@ -161,6 +165,12 @@ subroutine seq_map_mapinit(mapper,mpicom) mapper%tag_entity_type = 1 ! cells most of the time when we need it mapper%mbname = "undefined" mapper%read_map = .false. +#ifdef MOABCOMP + if (seq_comm_iamroot(CPLID)) then + write(logunit,'(A,i6)') subname//' call init map for mapper with id ',mapper%counter + call shr_sys_flush(logunit) + endif +#endif #endif end subroutine seq_map_mapinit From 5122e5b511f56617413251d1f815ca278319c3f7 Mon Sep 17 00:00:00 2001 From: iulian07 Date: Sun, 23 Jul 2023 15:53:00 -0500 Subject: [PATCH 397/467] force new map for ice-ocn an ice - ocn map can be matched by MCT to the ocn-ice map, and that is not compatible with moab logic we cannot reverse that force a new object which will force a new map in moab too still need to find out why it took me more than 4 weeks to find this this is a solution, maybe it s not the best --- driver-moab/main/prep_atm_mod.F90 | 49 +++++++++++++++++++++++++++++++ driver-moab/main/prep_ice_mod.F90 | 11 ++++++- driver-moab/main/prep_lnd_mod.F90 | 25 ++++++++++++++++ driver-moab/main/prep_ocn_mod.F90 | 42 ++++++++++++++++++++++++++ driver-moab/main/prep_rof_mod.F90 | 24 +++++++++++++++ driver-moab/main/seq_map_mod.F90 | 22 +++++++++----- 6 files changed, 164 insertions(+), 9 deletions(-) diff --git a/driver-moab/main/prep_atm_mod.F90 b/driver-moab/main/prep_atm_mod.F90 index 78dcf4230ea9..6ecd7aa12c57 100644 --- a/driver-moab/main/prep_atm_mod.F90 +++ b/driver-moab/main/prep_atm_mod.F90 @@ -276,6 +276,12 @@ subroutine prep_atm_init(infodata, ocn_c2_atm, ice_c2_atm, lnd_c2_atm, iac_c2_at endif ! now take care of the mapper + if ( mapper_So2a%src_mbid .gt. -1 ) then + if (iamroot_CPLID) then + write(logunit,F00) 'overwriting '//trim(mapper_So2a%mbname) & + //' mapper_So2a' + endif + endif mapper_So2a%src_mbid = mboxid mapper_So2a%tgt_mbid = mbaxid ! mapper_So2a%intx_mbid = mbintxoa @@ -372,6 +378,12 @@ subroutine prep_atm_init(infodata, ocn_c2_atm, ice_c2_atm, lnd_c2_atm, iac_c2_at call shr_sys_abort(subname//' ERROR in computing comm graph for second hop, ocnf-atm') endif + if ( mapper_Sof2a%src_mbid .gt. -1 ) then + if (iamroot_CPLID) then + write(logunit,F00) 'overwriting '//trim(mapper_Sof2a%mbname) & + //' mapper_Sof2a' + endif + endif mapper_Sof2a%src_mbid = mbofxid mapper_Sof2a%tgt_mbid = mbaxid mapper_Sof2a%intx_mbid = mbintxoa @@ -410,6 +422,12 @@ subroutine prep_atm_init(infodata, ocn_c2_atm, ice_c2_atm, lnd_c2_atm, iac_c2_at #ifdef HAVE_MOAB if ((mbaxid .ge. 0) .and. (mboxid .ge. 0)) then ! now take care of the mapper + if ( mapper_Fo2a%src_mbid .gt. -1 ) then + if (iamroot_CPLID) then + write(logunit,F00) 'overwriting '//trim(mapper_Fo2a%mbname) & + //' mapper_Fo2a' + endif + endif mapper_Fo2a%src_mbid = mboxid mapper_Fo2a%tgt_mbid = mbaxid mapper_Fo2a%intx_mbid = mbintxoa @@ -420,6 +438,12 @@ subroutine prep_atm_init(infodata, ocn_c2_atm, ice_c2_atm, lnd_c2_atm, iac_c2_at mapper_Fo2a%mbname = 'mapper_Fo2a' endif if ((mbaxid .ge. 0) .and. (mbofxid .ge. 0)) then + if ( mapper_Fof2a%src_mbid .gt. -1 ) then + if (iamroot_CPLID) then + write(logunit,F00) 'overwriting '//trim(mapper_Fof2a%mbname) & + //' mapper_Fof2a' + endif + endif mapper_Fof2a%src_mbid = mbofxid mapper_Fof2a%tgt_mbid = mbaxid mapper_Fof2a%intx_mbid = mbintxoa @@ -483,6 +507,12 @@ subroutine prep_atm_init(infodata, ocn_c2_atm, ice_c2_atm, lnd_c2_atm, iac_c2_at call shr_sys_abort(subname//' ERROR in computing comm graph for second hop, ice-atm') endif ! now take care of the mapper + if ( mapper_Si2a%src_mbid .gt. -1 ) then + if (iamroot_CPLID) then + write(logunit,F00) 'overwriting '//trim(mapper_Si2a%mbname) & + //' mapper_Si2a' + endif + endif mapper_Si2a%src_mbid = mbixid mapper_Si2a%tgt_mbid = mbaxid mapper_Si2a%intx_mbid = mbintxia @@ -576,6 +606,13 @@ subroutine prep_atm_init(infodata, ocn_c2_atm, ice_c2_atm, lnd_c2_atm, iac_c2_at #ifdef HAVE_MOAB ! now take care of the mapper for MOAB + if ( mapper_Fi2a%src_mbid .gt. -1 ) then + if (iamroot_CPLID) then + write(logunit,F00) 'overwriting '//trim(mapper_Fi2a%mbname) & + //' mapper_Fi2a' + endif + endif + mapper_Fi2a%src_mbid = mbixid mapper_Fi2a%tgt_mbid = mbaxid mapper_Fi2a%intx_mbid = mbintxia @@ -611,6 +648,12 @@ subroutine prep_atm_init(infodata, ocn_c2_atm, ice_c2_atm, lnd_c2_atm, iac_c2_at write(logunit,*) subname,' error in registering lnd atm intx ' call shr_sys_abort(subname//' ERROR in registering lnd atm intx ') endif + if ( mapper_Fl2a%src_mbid .gt. -1 ) then + if (iamroot_CPLID) then + write(logunit,F00) 'overwriting '//trim(mapper_Fl2a%mbname) & + //' mapper_Fl2a' + endif + endif mapper_Fl2a%src_mbid = mblxid mapper_Fl2a%tgt_mbid = mbaxid ! mapper_Fl2a%intx_mbid = mbintxla @@ -739,6 +782,12 @@ subroutine prep_atm_init(infodata, ocn_c2_atm, ice_c2_atm, lnd_c2_atm, iac_c2_at 'mapper_Sl2a initialization',esmf_map_flag) #ifdef HAVE_MOAB if ((mbaxid .ge. 0) .and. (mblxid .ge. 0) ) then + if ( mapper_Sl2a%src_mbid .gt. -1 ) then + if (iamroot_CPLID) then + write(logunit,F00) 'overwriting '//trim(mapper_Sl2a%mbname) & + //' mapper_Sl2a' + endif + endif mapper_Sl2a%src_mbid = mblxid mapper_Sl2a%tgt_mbid = mapper_Fl2a%tgt_mbid ! mapper_Sl2a%intx_mbid = mbintxla diff --git a/driver-moab/main/prep_ice_mod.F90 b/driver-moab/main/prep_ice_mod.F90 index e90fb6159541..eb7fa30f5b97 100644 --- a/driver-moab/main/prep_ice_mod.F90 +++ b/driver-moab/main/prep_ice_mod.F90 @@ -121,6 +121,7 @@ subroutine prep_ice_init(infodata, ocn_c2_ice, glc_c2_ice, glcshelf_c2_ice, rof_ character(CL) :: rof_gnam ! rof grid type(mct_avect), pointer :: i2x_ix character(*), parameter :: subname = '(prep_ice_init)' + logical :: no_match ! to force a new map between ocean and ice, always character(*), parameter :: F00 = "('"//subname//" : ', 4A )" !MOAB stuff ! MOAB stuff @@ -191,7 +192,8 @@ subroutine prep_ice_init(infodata, ocn_c2_ice, glc_c2_ice, glcshelf_c2_ice, rof_ write(logunit,*) ' ' write(logunit,F00) 'Initializing mapper_SFo2i' end if - call seq_map_init_rearrolap(mapper_SFo2i, ocn(1), ice(1), 'mapper_SFo2i') + no_match = .true. + call seq_map_init_rearrolap(mapper_SFo2i, ocn(1), ice(1), 'mapper_SFo2i', no_match) ! force a new map always #ifdef HAVE_MOAB if ( (mbixid .ge. 0) .and. (mboxid .ge. 0)) then @@ -220,6 +222,13 @@ subroutine prep_ice_init(infodata, ocn_c2_ice, glc_c2_ice, glcshelf_c2_ice, rof_ if ( ierr == 1 ) then call shr_sys_abort( subname//' ERROR: cannot define tags for ice proj to ocn' ) end if + if ( mapper_SFo2i%src_mbid .gt. -1 ) then + if (iamroot_CPLID) then + write(logunit,F00) 'overwriting '//trim(mapper_SFo2i%mbname) & + //' mapper_SFo2i' + endif + endif + mapper_SFo2i%src_mbid = mboxid mapper_SFo2i%tgt_mbid = mbixid ! no intersection, so will have to transform data without it diff --git a/driver-moab/main/prep_lnd_mod.F90 b/driver-moab/main/prep_lnd_mod.F90 index c1de54e2570d..610671d932e3 100644 --- a/driver-moab/main/prep_lnd_mod.F90 +++ b/driver-moab/main/prep_lnd_mod.F90 @@ -250,6 +250,13 @@ subroutine prep_lnd_init(infodata, atm_c2_lnd, rof_c2_lnd, glc_c2_lnd, iac_c2_ln call shr_sys_abort(subname//' ERROR in computing comm graph , rof-lnd') endif ! context for rearrange is target in this case + if ( mapper_Fr2l%src_mbid .gt. -1 ) then + if (iamroot_CPLID) then + write(logunit,F00) 'overwriting '//trim(mapper_Fr2l%mbname) & + //' mapper_Fr2l' + endif + endif + mapper_Fr2l%src_mbid = mbrxid mapper_Fr2l%tgt_mbid = mblxid mapper_Fr2l%src_context = rof(1)%cplcompid @@ -277,6 +284,12 @@ subroutine prep_lnd_init(infodata, atm_c2_lnd, rof_c2_lnd, glc_c2_lnd, iac_c2_ln call shr_sys_abort(subname//' ERROR in computing comm graph for second hop, lnd-rof') endif ! now take care of the mapper + if ( mapper_Fr2l%src_mbid .gt. -1 ) then + if (iamroot_CPLID) then + write(logunit,F00) 'overwriting '//trim(mapper_Fr2l%mbname) & + //' mapper_Fr2l' + endif + endif mapper_Fr2l%src_mbid = mbrxid mapper_Fr2l%tgt_mbid = mblxid mapper_Fr2l%intx_mbid = mbintxrl @@ -399,6 +412,12 @@ subroutine prep_lnd_init(infodata, atm_c2_lnd, rof_c2_lnd, glc_c2_lnd, iac_c2_ln write(logunit,*) subname,' error in registering atm lnd intx ' call shr_sys_abort(subname//' ERROR in registering atm lnd intx ') endif + if ( mapper_Sa2l%src_mbid .gt. -1 ) then + if (iamroot_CPLID) then + write(logunit,F00) 'overwriting '//trim(mapper_Sa2l%mbname) & + //' mapper_Sa2l' + endif + endif mapper_Sa2l%src_mbid = mbaxid mapper_Sa2l%tgt_mbid = mblxid mapper_Sa2l%intx_mbid = mbintxal @@ -508,6 +527,12 @@ subroutine prep_lnd_init(infodata, atm_c2_lnd, rof_c2_lnd, glc_c2_lnd, iac_c2_ln endif ! if tri-grid ! use the same map for fluxes too + if ( mapper_Fa2l%src_mbid .gt. -1 ) then + if (iamroot_CPLID) then + write(logunit,F00) 'overwriting '//trim(mapper_Fa2l%mbname) & + //' mapper_Fa2l' + endif + endif mapper_Fa2l%src_mbid = mbaxid mapper_Fa2l%tgt_mbid = mapper_Sa2l%tgt_mbid ! mblxid mapper_Fa2l%intx_mbid = mbintxal diff --git a/driver-moab/main/prep_ocn_mod.F90 b/driver-moab/main/prep_ocn_mod.F90 index 4d3c31f2ee84..eb967d4dac12 100644 --- a/driver-moab/main/prep_ocn_mod.F90 +++ b/driver-moab/main/prep_ocn_mod.F90 @@ -417,6 +417,12 @@ subroutine prep_ocn_init(infodata, atm_c2_ocn, atm_c2_ice, ice_c2_ocn, rof_c2_oc call shr_sys_abort(subname//' ERROR in computing comm graph for second hop, atm-ocn') endif ! now take care of the mapper + if ( mapper_Fa2o%src_mbid .gt. -1 ) then + if (iamroot_CPLID) then + write(logunit,F00) 'overwriting '//trim(mapper_Fa2o%mbname) & + //' mapper_Fa2o' + endif + endif mapper_Fa2o%src_mbid = mbaxid mapper_Fa2o%tgt_mbid = mboxid mapper_Fa2o%intx_mbid = mbintxao @@ -547,6 +553,12 @@ subroutine prep_ocn_init(infodata, atm_c2_ocn, atm_c2_ice, ice_c2_ocn, rof_c2_oc ! will use the same map for mapper_Sa2o and Va2o, using the bilinear map option if ((mbaxid .ge. 0) .and. (mboxid .ge. 0)) then ! now take care of the 2 new mappers + if ( mapper_Sa2o%src_mbid .gt. -1 ) then + if (iamroot_CPLID) then + write(logunit,F00) 'overwriting '//trim(mapper_Sa2o%mbname) & + //' mapper_Sa2o' + endif + endif mapper_Sa2o%src_mbid = mbaxid mapper_Sa2o%tgt_mbid = mboxid mapper_Sa2o%intx_mbid = mbintxao @@ -555,6 +567,12 @@ subroutine prep_ocn_init(infodata, atm_c2_ocn, atm_c2_ice, ice_c2_ocn, rof_c2_oc mapper_Sa2o%weight_identifier = 'bilinear'//C_NULL_CHAR mapper_Sa2o%mbname = 'mapper_Sa2o' + if ( mapper_Va2o%src_mbid .gt. -1 ) then + if (iamroot_CPLID) then + write(logunit,F00) 'overwriting '//trim(mapper_Va2o%mbname) & + //' mapper_Va2o' + endif + endif mapper_Va2o%src_mbid = mbaxid mapper_Va2o%tgt_mbid = mboxid mapper_Va2o%intx_mbid = mbintxao @@ -600,6 +618,12 @@ subroutine prep_ocn_init(infodata, atm_c2_ocn, atm_c2_ice, ice_c2_ocn, rof_c2_oc if ( ierr == 1 ) then call shr_sys_abort( subname//' ERROR: cannot define tags for ice proj to ocn' ) end if + if ( mapper_SFi2o%src_mbid .gt. -1 ) then + if (iamroot_CPLID) then + write(logunit,F00) 'overwriting '//trim(mapper_SFi2o%mbname) & + //' mapper_SFi2o' + endif + endif mapper_SFi2o%src_mbid = mbixid mapper_SFi2o%tgt_mbid = mboxid ! no intersection, so will have to do without it @@ -742,6 +766,12 @@ subroutine prep_ocn_init(infodata, atm_c2_ocn, atm_c2_ice, ice_c2_ocn, rof_c2_oc endif #endif ! now take care of the mapper for MOAB mapper_Rr2o_liq + if ( mapper_Rr2o_liq%src_mbid .gt. -1 ) then + if (iamroot_CPLID) then + write(logunit,F00) 'overwriting '//trim(mapper_Rr2o_liq%mbname) & + //' mapper_Rr2o_liq' + endif + endif mapper_Rr2o_liq%src_mbid = mbrxid mapper_Rr2o_liq%tgt_mbid = mbrxoid ! this is special, it will really need this coverage type mesh mapper_Rr2o_liq%intx_mbid = mbrmapro @@ -764,6 +794,12 @@ subroutine prep_ocn_init(infodata, atm_c2_ocn, atm_c2_ice, ice_c2_ocn, rof_c2_oc ! us the same one for mapper_Rr2o_ice and mapper_Fr2o #ifdef HAVE_MOAB ! now take care of the mapper for MOAB mapper_Rr2o_ice + if ( mapper_Rr2o_ice%src_mbid .gt. -1 ) then + if (iamroot_CPLID) then + write(logunit,F00) 'overwriting '//trim(mapper_Rr2o_ice%mbname) & + //' mapper_Rr2o_ice' + endif + endif mapper_Rr2o_ice%src_mbid = mbrxid mapper_Rr2o_ice%tgt_mbid = mbrxoid ! special mapper_Rr2o_ice%intx_mbid = mbrmapro @@ -784,6 +820,12 @@ subroutine prep_ocn_init(infodata, atm_c2_ocn, atm_c2_ice, ice_c2_ocn, rof_c2_oc string='mapper_Fr2o initialization', esmf_map=esmf_map_flag) #ifdef HAVE_MOAB ! now take care of the mapper for MOAB mapper_Fr2o + if ( mapper_Fr2o%src_mbid .gt. -1 ) then + if (iamroot_CPLID) then + write(logunit,F00) 'overwriting '//trim(mapper_Fr2o%mbname) & + //' mapper_Fr2o' + endif + endif mapper_Fr2o%src_mbid = mbrxid mapper_Fr2o%tgt_mbid = mbrxoid ! special mapper_Fr2o%intx_mbid = mbrmapro diff --git a/driver-moab/main/prep_rof_mod.F90 b/driver-moab/main/prep_rof_mod.F90 index 41062b905349..3ad5146bcd56 100644 --- a/driver-moab/main/prep_rof_mod.F90 +++ b/driver-moab/main/prep_rof_mod.F90 @@ -333,6 +333,12 @@ subroutine prep_rof_init(infodata, lnd_c2_rof, atm_c2_rof, ocn_c2_rof) call shr_sys_abort(subname//' ERROR in computing comm graph , lnd-rof') endif ! context for rearrange is target in this case + if ( mapper_Fl2r%src_mbid .gt. -1 ) then + if (iamroot_CPLID) then + write(logunit,F00) 'overwriting '//trim(mapper_Fl2r%mbname) & + //' mapper_Fl2r' + endif + endif mapper_Fl2r%src_mbid = mblxid mapper_Fl2r%tgt_mbid = mbrxid mapper_Fl2r%src_context = lnd(1)%cplcompid @@ -360,6 +366,12 @@ subroutine prep_rof_init(infodata, lnd_c2_rof, atm_c2_rof, ocn_c2_rof) call shr_sys_abort(subname//' ERROR in computing comm graph for second hop, lnd-rof') endif ! now take care of the mapper + if ( mapper_Fl2r%src_mbid .gt. -1 ) then + if (iamroot_CPLID) then + write(logunit,F00) 'overwriting '//trim(mapper_Fl2r%mbname) & + //' mapper_Fl2r' + endif + endif mapper_Fl2r%src_mbid = mblxid mapper_Fl2r%tgt_mbid = mbrxid mapper_Fl2r%intx_mbid = mbintxlr @@ -529,6 +541,12 @@ subroutine prep_rof_init(infodata, lnd_c2_rof, atm_c2_rof, ocn_c2_rof) call shr_sys_abort(subname//' ERROR in computing comm graph for second hop, rof-atm') endif ! now take care of the mapper + if ( mapper_Fa2r%src_mbid .gt. -1 ) then + if (iamroot_CPLID) then + write(logunit,F00) 'overwriting '//trim(mapper_Fa2r%mbname) & + //' mapper_Fa2r' + endif + endif mapper_Fa2r%src_mbid = mbaxid mapper_Fa2r%tgt_mbid = mbrxid mapper_Fa2r%intx_mbid = mbintxar @@ -610,6 +628,12 @@ subroutine prep_rof_init(infodata, lnd_c2_rof, atm_c2_rof, ocn_c2_rof) string='mapper_Sa2r initialization', esmf_map=esmf_map_flag) #ifdef HAVE_MOAB ! now take care of the mapper, use the same one as before + if ( mapper_Sa2r%src_mbid .gt. -1 ) then + if (iamroot_CPLID) then + write(logunit,F00) 'overwriting '//trim(mapper_Sa2r%mbname) & + //' mapper_Sa2r' + endif + endif mapper_Sa2r%src_mbid = mbaxid mapper_Sa2r%tgt_mbid = mbrxid mapper_Sa2r%intx_mbid = mbintxar diff --git a/driver-moab/main/seq_map_mod.F90 b/driver-moab/main/seq_map_mod.F90 index 57937c84729f..476b7a3d6d6a 100644 --- a/driver-moab/main/seq_map_mod.F90 +++ b/driver-moab/main/seq_map_mod.F90 @@ -245,7 +245,7 @@ end subroutine moab_map_init_rcfile !======================================================================= - subroutine seq_map_init_rearrolap(mapper, comp_s, comp_d, string) + subroutine seq_map_init_rearrolap(mapper, comp_s, comp_d, string, no_match) implicit none !----------------------------------------------------- @@ -256,6 +256,7 @@ subroutine seq_map_init_rearrolap(mapper, comp_s, comp_d, string) type(component_type) ,intent(inout) :: comp_s type(component_type) ,intent(inout) :: comp_d character(len=*) ,intent(in),optional :: string + logical ,intent(in),optional :: no_match ! ! Local Variables ! @@ -263,6 +264,7 @@ subroutine seq_map_init_rearrolap(mapper, comp_s, comp_d, string) type(mct_gsmap), pointer :: gsmap_s type(mct_gsmap), pointer :: gsmap_d integer(IN) :: mpicom + logical :: skip_match character(len=*),parameter :: subname = "(seq_map_init_rearrolap) " !----------------------------------------------------- @@ -275,7 +277,11 @@ subroutine seq_map_init_rearrolap(mapper, comp_s, comp_d, string) gsmap_s => component_get_gsmap_cx(comp_s) gsmap_d => component_get_gsmap_cx(comp_d) - if (mct_gsmap_Identical(gsmap_s,gsmap_d)) then + skip_match = .false. + if (present(no_match)) then + if (no_match) skip_match = .true. + endif + if (mct_gsmap_Identical(gsmap_s,gsmap_d) .and. .not.skip_match ) then call seq_map_mapmatch(mapid,gsmap_s=gsmap_s,gsmap_d=gsmap_d,strategy="copy") if (mapid > 0) then @@ -428,7 +434,7 @@ subroutine seq_map_map( mapper, av_s, av_d, fldlist, norm, avwts_s, avwtsfld_s, endif -#ifdef MOABDEBUG +#ifdef MOABCOMP if (seq_comm_iamroot(CPLID)) then write(logunit,*) subname, 'iMOAB mapper ',trim(mapper%mbname), ' iMOAB_mapper nfields', & nfields, ' fldlist_moab=', trim(fldlist_moab) @@ -486,7 +492,7 @@ subroutine seq_map_map( mapper, av_s, av_d, fldlist, norm, avwts_s, avwtsfld_s, #ifdef HAVE_MOAB if ( valid_moab_context ) then -#ifdef MOABDEBUG +#ifdef MOABCOMP if (seq_comm_iamroot(CPLID)) then write(logunit, *) subname,' iMOAB mapper rearrange or copy ', mapper%mbname, ' send/recv tags ', trim(fldlist_moab), & ' mbpresent=', mbpresent, ' mbnorm=', mbnorm @@ -541,7 +547,7 @@ subroutine seq_map_map( mapper, av_s, av_d, fldlist, norm, avwts_s, avwtsfld_s, write(logunit,*) subname,' error setting init value for mapping norm factor ',ierr,trim(tagname) call shr_sys_abort(subname//' ERROR setting norm init value') ! serious enough endif -#ifdef MOABDEBUG +#ifdef MOABCOMP if (seq_comm_iamroot(CPLID)) then write(logunit, *) subname,' iMOAB mapper ', mapper%mbname, ' set norm8wt 1 on source with app id: ', mapper%src_mbid call shr_sys_flush(logunit) @@ -574,7 +580,7 @@ subroutine seq_map_map( mapper, av_s, av_d, fldlist, norm, avwts_s, avwtsfld_s, do j = 1, lsize_src targtags(j,:)= targtags(j,:)*wghts(j) enddo -#ifdef MOABDEBUG +#ifdef MOABCOMP if (seq_comm_iamroot(CPLID)) then write(logunit, *) subname,' iMOAB projection mapper: ', mapper%mbname, ' normalize nfields=', & nfields, ' arrsize_src on root:', arrsize_src, ' shape(targtags_ini)=', shape(targtags_ini) @@ -624,9 +630,9 @@ subroutine seq_map_map( mapper, av_s, av_d, fldlist, norm, avwts_s, avwtsfld_s, endif if ( valid_moab_context ) then -#ifdef MOABDEBUG +#ifdef MOABCOMP if (seq_comm_iamroot(CPLID)) then - write(logunit, *) subname,' iMOAB projection mapper: between ', mapper%src_mbid, ' and ', mapper%tgt_mbid, trim(fldlist_moab) + write(logunit, *) subname,' iMOAB projection mapper: ',trim(mapper%mbname), ' between ', mapper%src_mbid, ' and ', mapper%tgt_mbid, trim(fldlist_moab) call shr_sys_flush(logunit) endif #endif From ce7a5a27ac5a0327d17b255c93af438c1ea0928e Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Tue, 22 Aug 2023 15:56:45 -0500 Subject: [PATCH 398/467] add serwal for ubuntu 20 --- .../machines/cmake_macros/serwal76spack20.cmake | 17 +++++++++++++++++ 1 file changed, 17 insertions(+) create mode 100644 cime_config/machines/cmake_macros/serwal76spack20.cmake diff --git a/cime_config/machines/cmake_macros/serwal76spack20.cmake b/cime_config/machines/cmake_macros/serwal76spack20.cmake new file mode 100644 index 000000000000..fa132ee19941 --- /dev/null +++ b/cime_config/machines/cmake_macros/serwal76spack20.cmake @@ -0,0 +1,17 @@ +if (NOT DEBUG) + string(APPEND CFLAGS " -O2") +endif() +string(APPEND CXX_LIBS " -lstdc++") +if (NOT DEBUG) + string(APPEND FFLAGS " -O2") +endif() +# string(APPEND FFLAGS " -fallow-argument-mismatch -fallow-invalid-boz") +execute_process(COMMAND $ENV{NETCDF_FORTRAN_PATH}/bin/nf-config --flibs OUTPUT_VARIABLE SHELL_CMD_OUTPUT_BUILD_INTERNAL_IGNORE0 OUTPUT_STRIP_TRAILING_WHITESPACE) +execute_process(COMMAND $ENV{NETCDF_C_PATH}/bin/nc-config --libs OUTPUT_VARIABLE SHELL_CMD_OUTPUT_BUILD_INTERNAL_IGNORE1 OUTPUT_STRIP_TRAILING_WHITESPACE) +string(APPEND SLIBS " ${SHELL_CMD_OUTPUT_BUILD_INTERNAL_IGNORE0} ${SHELL_CMD_OUTPUT_BUILD_INTERNAL_IGNORE1} -lblas -llapack") +set(NETCDF_C_PATH "$ENV{NETCDF_C_PATH}") +set(NETCDF_FORTRAN_PATH "$ENV{NETCDF_FORTRAN_PATH}") +set(PNETCDF_PATH "$ENV{PNETCDF_PATH}") +set(HDF5_PATH "$ENV{HDF5_PATH}") +set(ZLIB_PATH "$ENV{ZLIB_PATH}") +set(MOAB_PATH "/home/iulian/lib/moab/spack20") From dd9b1f6218be7f1b9ad4483102f38e885bcaefe1 Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Sat, 26 Aug 2023 11:26:16 -0500 Subject: [PATCH 399/467] write restart with moab driver framework for restart write with moab add a new implementation to the seq_io_write interface seq_io_write_moab_tags (filename, mbxid, dname, tag_list, whead,wdata, file_ind ) the filename is the original prepended with 'moab_' it needs a branch in moab, that has fixes for global id and total number of global cells and vertices --- components/eam/src/dynamics/se/semoab_mod.F90 | 29 +- driver-moab/main/cime_comp_mod.F90 | 8 +- driver-moab/main/seq_io_mod.F90 | 143 ++++++++ driver-moab/main/seq_rest_mod.F90 | 321 ++++++++++++++++++ 4 files changed, 472 insertions(+), 29 deletions(-) diff --git a/components/eam/src/dynamics/se/semoab_mod.F90 b/components/eam/src/dynamics/se/semoab_mod.F90 index 556273b571ec..e95ae9ea67be 100644 --- a/components/eam/src/dynamics/se/semoab_mod.F90 +++ b/components/eam/src/dynamics/se/semoab_mod.F90 @@ -465,35 +465,8 @@ subroutine create_moab_meshes(par, elem) ! set the global ids for coarse vertices the same as corresponding fine vertices ent_type = 0 ! vertex type ierr = iMOAB_SetIntTagStorage ( MHID, newtagg, nverts_c , ent_type, vdone_c) - - ! create a new tag, for transfer example ; will use it now for temperature on the surface - ! (bottom atm to surface of ocean) - tagname='a2oTbot'//C_NULL_CHAR ! atm to ocean temp bottom tag - tagtype = 1 ! dense, double - numco = np*np ! usually, it is 16; each element will have the same order as dofs - ierr = iMOAB_DefineTagStorage(MHID, tagname, tagtype, numco, tagindex ) - if (ierr > 0 ) & - call endrun('Error: fail to create atm to ocean temp bottom tag') - - tagname='a2oUbot'//C_NULL_CHAR ! atm to ocean U bottom tag - ierr = iMOAB_DefineTagStorage(MHID, tagname, tagtype, numco, tagindex ) - if (ierr > 0 ) & - call endrun('Error: fail to create atm to ocean U velocity bottom tag') - - tagname='a2oVbot'//C_NULL_CHAR ! atm to ocean V bottom tag - ierr = iMOAB_DefineTagStorage(MHID, tagname, tagtype, numco, tagindex ) - if (ierr > 0 ) & - call endrun('Error: fail to create atm to ocean V velocity bottom tag') - - - ! create a new tag, for transfer example ; will use it now for temperature on the surface - ! (bottom atm to surface of ocean); for debugging, use it on fine mesh - tagname='a2o_T'//C_NULL_CHAR ! atm to ocean tag - tagtype = 1 ! dense, double - numco = 1 ! usually, it is 1; one value per gdof - ierr = iMOAB_DefineTagStorage(MHFID, tagname, tagtype, numco, tagindex ) if (ierr > 0 ) & - call endrun('Error: fail to create atm to ocean tag') + call endrun('Error: fail to set GLOBAL_DOFS tag values') ierr = iMOAB_UpdateMeshInfo(MHID) if (ierr > 0 ) & diff --git a/driver-moab/main/cime_comp_mod.F90 b/driver-moab/main/cime_comp_mod.F90 index a6f4e108a63c..77dcf838ace0 100644 --- a/driver-moab/main/cime_comp_mod.F90 +++ b/driver-moab/main/cime_comp_mod.F90 @@ -126,7 +126,7 @@ module cime_comp_mod use seq_hist_mod, only : seq_hist_write, seq_hist_writeavg, seq_hist_writeaux ! restart file routines - use seq_rest_mod, only : seq_rest_read, seq_rest_write + use seq_rest_mod, only : seq_rest_read, seq_rest_write, seq_rest_mb_write ! flux calc routines use seq_flux_mct, only: seq_flux_init_mct, seq_flux_initexch_mct, seq_flux_ocnalb_mct @@ -5345,6 +5345,12 @@ subroutine cime_run_write_restart(drv_pause, write_restart, drv_resume_file) trim(cpl_inst_tag), drv_resume_file) call t_stopf('CPL:seq_rest_write') + call t_startf('CPL:seq_rest_mb_write') + call seq_rest_mb_write(EClock_d, seq_SyncClock, infodata, & + atm, lnd, ice, ocn, rof, glc, wav, esp, iac, & + trim(cpl_inst_tag), drv_resume_file) + call t_stopf('CPL:seq_rest_mb_write') + if (iamroot_CPLID) then write(logunit,103) ' Restart filename: ',trim(drv_resume_file) call shr_sys_flush(logunit) diff --git a/driver-moab/main/seq_io_mod.F90 b/driver-moab/main/seq_io_mod.F90 index 9739fbf256a6..9f450e4824f0 100644 --- a/driver-moab/main/seq_io_mod.F90 +++ b/driver-moab/main/seq_io_mod.F90 @@ -84,6 +84,7 @@ module seq_io_mod module procedure seq_io_write_r81d module procedure seq_io_write_char module procedure seq_io_write_time + module procedure seq_io_write_moab_tags end interface seq_io_write !------------------------------------------------------------------------------- @@ -1562,6 +1563,148 @@ subroutine seq_io_write_time(filename,time_units,time_cal,time_val,nt,whead,wdat end subroutine seq_io_write_time + subroutine seq_io_write_moab_tags(filename, mbxid, dname, tag_list, whead,wdata, file_ind ) + + use shr_kind_mod, only: CX => shr_kind_CX, CXX => shr_kind_CXX + + use iMOAB, only: iMOAB_GetGlobalInfo, iMOAB_GetMeshInfo, iMOAB_GetDoubleTagStorage, & + iMOAB_GetIntTagStorage + + ! !INPUT/OUTPUT PARAMETERS: + implicit none + character(len=*),intent(in) :: filename ! file + integer(in), intent(in) :: mbxid ! imoab app id, on coupler + character(len=*),intent(in) :: dname ! name of data (prefix) + character(len=*),intent(in) :: tag_list ! fields, separated by colon + logical,optional,intent(in) :: whead ! write header + logical,optional,intent(in) :: wdata ! write data + integer,optional,intent(in) :: file_ind + + logical :: lwhead, lwdata + !integer :: start(2),count(2) + character(*),parameter :: subName = '(seq_io_write_moab_tags) ' + integer :: ndims, lfile_ind, iam, rcode + integer(in) :: ns, ng, lnx, lny + integer nvert(3), nvise(3), nbl(3), nsurf(3), nvisBC(3) ! for moab info + + type(var_desc_t) :: varid + type(io_desc_t) :: iodesc + character(CL) :: name1 ! var name + character(CL) :: cunit ! var units + character(CL) :: lname ! long name + character(CL) :: sname ! standard name + + character(CL) :: lpre + + type(mct_list) :: temp_list + integer :: size_list, index_list + type(mct_string) :: mctOStr ! + character(CXX) ::tagname, field + + integer(in) :: dimid2(2) + integer(in) :: dummy, ent_type, ierr + real(r8) :: lfillvalue ! or just use fillvalue ? + integer, allocatable :: Dof(:) ! will be filled with global ids from cells + real(r8), allocatable :: data1(:) + + !------------------------------------------------------------------------------- + ! + !------------------------------------------------------------------------------- + + lwhead = .true. + lwdata = .true. + lfillvalue = fillvalue + if (present(whead)) lwhead = whead + if (present(wdata)) lwdata = wdata + + if (.not.lwhead .and. .not.lwdata) then + ! should we write a warning? + return + endif + ent_type = 1 ! cells type + + lfile_ind = 0 + if (present(file_ind)) lfile_ind=file_ind + + call seq_comm_setptrs(CPLID,iam=iam) + + call mct_list_init(temp_list ,trim(tag_list)) + size_list=mct_list_nitem (temp_list) ! role of nf, number fields + ent_type = 1 ! cell for atm, atm_pg_active + + if (size_list < 1) then + write(logunit,*) subname,' ERROR: size_list = ',size_list,trim(dname) + call shr_sys_abort(subname//'size_list error') + endif + + lpre = trim(dname) + ! find out the number of global cells, needed for defining the variables length + ierr = iMOAB_GetGlobalInfo( mbxid, dummy, ng) + lnx = ng + lny = 1 ! do we need 2 var, or just 1 + ierr = iMOAB_GetMeshInfo ( mbxid, nvert, nvise, nbl, nsurf, nvisBC ) + ns = nvise(1) ! local cells + + if (lwhead) then + rcode = pio_def_dim(cpl_io_file(lfile_ind),trim(lpre)//'_nx',lnx,dimid2(1)) + rcode = pio_def_dim(cpl_io_file(lfile_ind),trim(lpre)//'_ny',lny,dimid2(2)) + do index_list = 1, size_list + call mct_list_get(mctOStr,index_list,temp_list) + field = mct_string_toChar(mctOStr) + !-------tcraig, this is a temporary mod to NOT write hgt + if (trim(field) /= "hgt") then + name1 = trim(lpre)//'_'//trim(field) + call seq_flds_lookup(field,longname=lname,stdname=sname,units=cunit) + ! if (luse_float) then + ! rcode = pio_def_var(cpl_io_file(lfile_ind),trim(name1),PIO_REAL,dimid1,varid) + ! rcode = pio_put_att(cpl_io_file(lfile_ind),varid,"_FillValue",real(lfillvalue,r4)) + ! else + rcode = pio_def_var(cpl_io_file(lfile_ind),trim(name1),PIO_DOUBLE,dimid2,varid) + rcode = pio_put_att(cpl_io_file(lfile_ind),varid,"_FillValue",lfillvalue) + !end if + rcode = pio_put_att(cpl_io_file(lfile_ind),varid,"units",trim(cunit)) + rcode = pio_put_att(cpl_io_file(lfile_ind),varid,"long_name",trim(lname)) + rcode = pio_put_att(cpl_io_file(lfile_ind),varid,"standard_name",trim(sname)) + rcode = pio_put_att(cpl_io_file(lfile_ind),varid,"internal_dname",trim(dname)) + !-------tcraig + endif + enddo + if (lwdata) call seq_io_enddef(filename, file_ind=lfile_ind) + end if + + if (lwdata) then + allocate(data1(ns)) + allocate(dof(ns)) + + ! note: size of dof is ns + tagname = 'GLOBAL_ID'//C_NULL_CHAR + ierr = iMOAB_GetIntTagStorage ( mbxid, tagname, ns , ent_type, dof(1)) + + call pio_initdecomp(cpl_io_subsystem, pio_double, (/lnx,lny/), dof, iodesc) + + deallocate(dof) + + do index_list = 1, size_list + call mct_list_get(mctOStr,index_list,temp_list) + field = mct_string_toChar(mctOStr) + !-------tcraig, this is a temporary mod to NOT write hgt + if (trim(field) /= "hgt") then + name1 = trim(lpre)//'_'//trim(field) + rcode = pio_inq_varid(cpl_io_file(lfile_ind),trim(name1),varid) + !call pio_setframe(cpl_io_file(lfile_ind),varid,frame) + tagname = trim(field)//C_NULL_CHAR + ierr = iMOAB_GetDoubleTagStorage (mbxid, tagname, ns , ent_type, data1(1)) + call pio_write_darray(cpl_io_file(lfile_ind), varid, iodesc, data1, rcode, fillval=lfillvalue) + endif + enddo + + call pio_freedecomp(cpl_io_file(lfile_ind), iodesc) + deallocate(data1) + + end if + + + end subroutine seq_io_write_moab_tags !=============================================================================== !BOP =========================================================================== ! diff --git a/driver-moab/main/seq_rest_mod.F90 b/driver-moab/main/seq_rest_mod.F90 index 0ad62de966f4..c87f5cef865b 100644 --- a/driver-moab/main/seq_rest_mod.F90 +++ b/driver-moab/main/seq_rest_mod.F90 @@ -68,6 +68,7 @@ module seq_rest_mod use prep_aoflux_mod, only: prep_aoflux_get_xao_ox use prep_aoflux_mod, only: prep_aoflux_get_xao_ax + use seq_flds_mod, only: seq_flds_a2x_fields, seq_flds_xao_fields implicit none private @@ -80,6 +81,7 @@ module seq_rest_mod public :: seq_rest_read ! read cpl7 restart data public :: seq_rest_write ! write cpl7 restart data + public :: seq_rest_mb_write ! read cpl7_moab restart data ! !PUBLIC DATA MEMBERS: @@ -657,6 +659,325 @@ subroutine seq_rest_write(EClock_d, seq_SyncClock, infodata, & endif end subroutine seq_rest_write + + subroutine seq_rest_mb_write(EClock_d, seq_SyncClock, infodata, & + atm, lnd, ice, ocn, rof, glc, wav, esp, iac, & + tag, rest_file) + + use seq_comm_mct, only: mbaxid, mbixid, mboxid, mblxid, mbrxid ! coupler side instances + + implicit none + + type(ESMF_Clock) , intent(in) :: EClock_d ! driver clock + type(seq_timemgr_type) , intent(inout) :: seq_SyncClock ! contains ptr to driver clock + type(seq_infodata_type), intent(in) :: infodata + type (component_type) , intent(inout) :: atm(:) + type (component_type) , intent(inout) :: lnd(:) + type (component_type) , intent(inout) :: ice(:) + type (component_type) , intent(inout) :: ocn(:) + type (component_type) , intent(inout) :: rof(:) + type (component_type) , intent(inout) :: glc(:) + type (component_type) , intent(inout) :: wav(:) + type (component_type) , intent(inout) :: esp(:) + type (component_type) , intent(inout) :: iac(:) + + character(len=*) , intent(in) :: tag + character(len=CL) , intent(out) :: rest_file ! Restart filename + + integer(IN) :: n,n1,n2,n3,fk + integer(IN) :: curr_ymd ! Current date YYYYMMDD + integer(IN) :: curr_tod ! Current time-of-day (s) + integer(IN) :: yy,mm,dd ! year, month, day + character(CL) :: case_name ! case name + character(CL) :: cvar ! char variable + integer(IN) :: ivar ! integer variable + real(r8) :: rvar ! real variable + logical :: whead,wdata ! flags header/data writing + logical :: cplroot ! root pe on cpl id + integer(IN) :: iun ! unit number + !type(mct_gsMap),pointer :: gsmap + character(len=6) :: year_char + + real(r8),allocatable :: ds(:) ! for reshaping diag data for restart file + real(r8),allocatable :: ns(:) ! for reshaping diag data for restart file + real(r8),allocatable :: dsBGC(:) ! for reshaping diag data for restart file + real(r8),allocatable :: nsBGC(:) ! for reshaping diag data for restart file + character(CL) :: model_doi_url + character(len=*),parameter :: subname = "(seq_rest_mb_write) " + + !------------------------------------------------------------------------------- + ! + !------------------------------------------------------------------------------- + + !---------------------------------------------------------------------------- + ! get required infodata + !---------------------------------------------------------------------------- + iamin_CPLID = seq_comm_iamin(CPLID) + + call seq_comm_getdata(GLOID,& + mpicom=mpicom_GLOID, nthreads=nthreads_GLOID) + + call seq_comm_getdata(CPLID,& + mpicom=mpicom_CPLID, nthreads=nthreads_CPLID, iamroot=cplroot) + + call seq_infodata_getData(infodata, & + drv_threading=drv_threading, & + atm_present=atm_present, & + lnd_present=lnd_present, & + rof_present=rof_present, & + ice_present=ice_present, & + ocn_present=ocn_present, & + glc_present=glc_present, & + wav_present=wav_present, & + esp_present=esp_present, & + iac_present=iac_present, & + atm_prognostic=atm_prognostic, & + lnd_prognostic=lnd_prognostic, & + ice_prognostic=ice_prognostic, & + rof_prognostic=rof_prognostic, & + rofocn_prognostic=rofocn_prognostic, & + ocn_prognostic=ocn_prognostic, & + ocnrof_prognostic=ocnrof_prognostic, & + glc_prognostic=glc_prognostic, & + wav_prognostic=wav_prognostic, & + esp_prognostic=esp_prognostic, & + iac_prognostic=iac_prognostic, & + ocn_c2_glcshelf=ocn_c2_glcshelf, & + do_bgc_budgets=do_bgc_budgets, & + case_name=case_name, & + model_doi_url=model_doi_url) + + ! Write out infodata and time manager data to restart file + + call seq_timemgr_EClockGetData( EClock_d, curr_ymd=curr_ymd, curr_tod=curr_tod) + call shr_cal_date2ymd(curr_ymd,yy,mm,dd) + write(year_char,'(i6.4)') yy + write(rest_file,"(4a,i2.2,a,i2.2,a,i5.5,a)") & + 'moab_'//trim(case_name), '.cpl'//trim(tag)//'.r.',trim(adjustl(year_char)),'-',mm,'-',dd,'-',curr_tod,'.nc' + + ! Write driver data to restart file + + if (iamin_CPLID) then + + if (drv_threading) call seq_comm_setnthreads(nthreads_CPLID) + + ! copy budg_dataG into 1d array + n = size(budg_dataG) + allocate(ds(n),ns(n)) + call shr_mpi_bcast(budg_dataG,mpicom_CPLID) ! pio requires data on all pe's? + + n = 0 + do n1 = 1,size(budg_dataG,dim=1) + do n2 = 1,size(budg_dataG,dim=2) + do n3 = 1,size(budg_dataG,dim=3) + n = n + 1 + ds(n) = budg_dataG(n1,n2,n3) + ns(n) = budg_ns(n1,n2,n3) + enddo + enddo + enddo + + ! copy budg_dataGBGC into 1d array if BGC budgets are on + if (do_bgc_budgets) then + n = size(budg_dataGBGC) + allocate(dsBGC(n),nsBGC(n)) + call shr_mpi_bcast(budg_dataGBGC,mpicom_CPLID) ! pio requires data on all pe's? + + n = 0 + do n1 = 1,size(budg_dataGBGC,dim=1) + do n2 = 1,size(budg_dataGBGC,dim=2) + do n3 = 1,size(budg_dataGBGC,dim=3) + n = n + 1 + dsBGC(n) = budg_dataGBGC(n1,n2,n3) + nsBGC(n) = budg_nsBGC(n1,n2,n3) + enddo + enddo + enddo + endif + + if (cplroot) then + iun = shr_file_getUnit() + call seq_infodata_GetData(infodata,restart_pfile=cvar) + if (loglevel > 0) write(logunit,"(3A)") subname," write rpointer file ", & + trim(cvar) + open(iun, file=cvar, form='FORMATTED') + write(iun,'(a)') rest_file + close(iun) + call shr_file_freeUnit( iun ) + endif + + call shr_mpi_bcast(rest_file,mpicom_CPLID) + call seq_io_wopen(rest_file,clobber=.true., model_doi_url=model_doi_url) + + ! loop twice (for perf), first time write header, second time write data + do fk = 1,2 + if (fk == 1) then + whead = .true. + wdata = .false. + elseif (fk == 2) then + whead = .false. + wdata = .true. + call seq_io_enddef(rest_file) + else + call shr_sys_abort('driver_write_rstart fk illegal') + end if + call seq_infodata_GetData(infodata,nextsw_cday=rvar) + call seq_io_write(rest_file,rvar,'seq_infodata_nextsw_cday',whead=whead,wdata=wdata) + call seq_infodata_GetData(infodata,precip_fact=rvar) + call seq_io_write(rest_file,rvar,'seq_infodata_precip_fact',whead=whead,wdata=wdata) + call seq_infodata_GetData(infodata,case_name=cvar) + call seq_io_write(rest_file,trim(cvar),'seq_infodata_case_name',whead=whead,wdata=wdata) + + call seq_timemgr_EClockGetData( EClock_d, start_ymd=ivar) + call seq_io_write(rest_file,ivar,'seq_timemgr_start_ymd',whead=whead,wdata=wdata) + call seq_timemgr_EClockGetData( EClock_d, start_tod=ivar) + call seq_io_write(rest_file,ivar,'seq_timemgr_start_tod',whead=whead,wdata=wdata) + call seq_timemgr_EClockGetData( EClock_d, ref_ymd=ivar) + call seq_io_write(rest_file,ivar,'seq_timemgr_ref_ymd' ,whead=whead,wdata=wdata) + call seq_timemgr_EClockGetData( EClock_d, ref_tod=ivar) + call seq_io_write(rest_file,ivar,'seq_timemgr_ref_tod' ,whead=whead,wdata=wdata) + call seq_timemgr_EClockGetData( EClock_d, curr_ymd=ivar) + call seq_io_write(rest_file,ivar,'seq_timemgr_curr_ymd' ,whead=whead,wdata=wdata) + call seq_timemgr_EClockGetData( EClock_d, curr_tod=ivar) + call seq_io_write(rest_file,ivar,'seq_timemgr_curr_tod' ,whead=whead,wdata=wdata) + + call seq_io_write(rest_file,ds,'budg_dataG',whead=whead,wdata=wdata) + call seq_io_write(rest_file,ns,'budg_ns',whead=whead,wdata=wdata) + + if (do_bgc_budgets) then + call seq_io_write(rest_file,dsBGC,'budg_dataGBGC',whead=whead,wdata=wdata) + call seq_io_write(rest_file,nsBGC,'budg_nsBGC',whead=whead,wdata=wdata) + endif + + if (atm_present) then +! gsmap => component_get_gsmap_cx(atm(1)) +! xao_ax => prep_aoflux_get_xao_ax() + call seq_io_write(rest_file, mbaxid, 'fractions_ax', & + 'afrac:ifrac:ofrac:lfrac:lfrin', & + whead=whead, wdata=wdata) + call seq_io_write(rest_file, mbaxid, 'a2x_ax', & + trim(seq_flds_a2x_fields), & + whead=whead, wdata=wdata) + call seq_io_write(rest_file, mbaxid, 'xao_ax', & + trim(seq_flds_xao_fields), & + whead=whead, wdata=wdata) +! call seq_io_write(rest_file, gsmap, fractions_ax, 'fractions_ax', & +! whead=whead, wdata=wdata) +! call seq_io_write(rest_file, atm, 'c2x', 'a2x_ax', & +! whead=whead, wdata=wdata) +! call seq_io_write(rest_file, gsmap, xao_ax, 'xao_ax', & +! whead=whead, wdata=wdata) + endif + if (lnd_present) then + call seq_io_write(rest_file, mblxid, 'fractions_lx', & + 'afrac:lfrac:lfrin', & ! seq_frac_mod: character(*),parameter :: fraclist_l = 'afrac:lfrac:lfrin' + whead=whead, wdata=wdata) +! whead=whead, wdata=wdata) +! gsmap => component_get_gsmap_cx(lnd(1)) +! call seq_io_write(rest_file, gsmap, fractions_lx, 'fractions_lx', & +! whead=whead, wdata=wdata) + endif +! if (lnd_present .and. rof_prognostic) then +! gsmap => component_get_gsmap_cx(lnd(1)) +! l2racc_lx => prep_rof_get_l2racc_lx() +! l2racc_lx_cnt => prep_rof_get_l2racc_lx_cnt() +! call seq_io_write(rest_file, gsmap, l2racc_lx, 'l2racc_lx', & +! whead=whead, wdata=wdata) +! call seq_io_write(rest_file, l2racc_lx_cnt, 'l2racc_lx_cnt', & +! whead=whead, wdata=wdata) +! end if +! if (ocn_present .and. rofocn_prognostic) then +! gsmap => component_get_gsmap_cx(ocn(1)) +! o2racc_ox => prep_rof_get_o2racc_ox() +! o2racc_ox_cnt => prep_rof_get_o2racc_ox_cnt() +! call seq_io_write(rest_file, gsmap, o2racc_ox, 'o2racc_ox', & +! whead=whead, wdata=wdata) +! call seq_io_write(rest_file, o2racc_ox_cnt, 'o2racc_ox_cnt', & +! whead=whead, wdata=wdata) +! end if +! if (lnd_present .and. glc_prognostic) then +! gsmap => component_get_gsmap_cx(lnd(1)) +! l2gacc_lx => prep_glc_get_l2gacc_lx() +! l2gacc_lx_cnt => prep_glc_get_l2gacc_lx_cnt() +! call seq_io_write(rest_file, gsmap, l2gacc_lx, 'l2gacc_lx', & +! whead=whead, wdata=wdata) +! call seq_io_write(rest_file, l2gacc_lx_cnt, 'l2gacc_lx_cnt', & +! whead=whead, wdata=wdata) +! end if +! if (ocn_c2_glcshelf) then +! gsmap => component_get_gsmap_cx(glc(1)) +! x2gacc_gx => prep_glc_get_x2gacc_gx() +! x2gacc_gx_cnt => prep_glc_get_x2gacc_gx_cnt() +! call seq_io_write(rest_file, gsmap, x2gacc_gx , 'x2gacc_gx', & +! whead=whead, wdata=wdata) +! call seq_io_write(rest_file, x2gacc_gx_cnt, 'x2gacc_gx_cnt', & +! whead=whead, wdata=wdata) +! end if +! if (ocn_present) then +! gsmap => component_get_gsmap_cx(ocn(1)) +! x2oacc_ox => prep_ocn_get_x2oacc_ox() +! #ifdef SUMMITDEV_PGI +! dummy_pgibugfix = associated(x2oacc_ox) +! #endif +! x2oacc_ox_cnt => prep_ocn_get_x2oacc_ox_cnt() +! xao_ox => prep_aoflux_get_xao_ox() +! call seq_io_write(rest_file, gsmap, fractions_ox, 'fractions_ox', & +! whead=whead, wdata=wdata) +! call seq_io_write(rest_file, ocn, 'c2x', 'o2x_ox', & +! whead=whead, wdata=wdata) +! call seq_io_write(rest_file, gsmap, x2oacc_ox, 'x2oacc_ox', & +! whead=whead, wdata=wdata) +! call seq_io_write(rest_file, x2oacc_ox_cnt, 'x2oacc_ox_cnt', & +! whead=whead, wdata=wdata) +! call seq_io_write(rest_file, gsmap, xao_ox, 'xao_ox', & +! whead=whead, wdata=wdata) +! endif +! if (ice_present) then +! gsmap => component_get_gsmap_cx(ice(1)) +! call seq_io_write(rest_file, gsmap, fractions_ix, 'fractions_ix', & +! whead=whead, wdata=wdata) +! call seq_io_write(rest_file, ice, 'c2x', 'i2x_ix', & +! whead=whead, wdata=wdata) +! endif +! if (rof_present) then +! gsmap => component_get_gsmap_cx(rof(1)) +! call seq_io_write(rest_file, gsmap, fractions_rx, 'fractions_rx', & +! whead=whead, wdata=wdata) +! call seq_io_write(rest_file, rof, 'c2x', 'r2x_rx', & +! whead=whead, wdata=wdata) +! endif +! if (glc_present) then +! gsmap => component_get_gsmap_cx(glc(1)) +! call seq_io_write(rest_file, gsmap, fractions_gx, 'fractions_gx', & +! whead=whead, wdata=wdata) +! call seq_io_write(rest_file, glc, 'c2x', 'g2x_gx', & +! whead=whead, wdata=wdata) +! endif +! if (wav_present) then +! gsmap => component_get_gsmap_cx(wav(1)) +! call seq_io_write(rest_file, gsmap, fractions_wx, 'fractions_wx', & +! whead=whead, wdata=wdata) +! call seq_io_write(rest_file, wav, 'c2x', 'w2x_wx', & +! whead=whead, wdata=wdata) +! endif +! if (iac_present) then +! gsmap => component_get_gsmap_cx(iac(1)) +! call seq_io_write(rest_file, gsmap, fractions_zx, 'fractions_zx', & +! whead=whead, wdata=wdata) +! call seq_io_write(rest_file, iac, 'c2x', 'z2x_zx', & +! whead=whead, wdata=wdata) +! endif + ! Write ESP restart data here + enddo + + call seq_io_close(rest_file) + deallocate(ds,ns) + if (do_bgc_budgets) deallocate(dsBGC,nsBGC) + + if (drv_threading) call seq_comm_setnthreads(nthreads_GLOID) + endif + + end subroutine seq_rest_mb_write !=============================================================================== end module seq_rest_mod From 86ac35320d7254b2260e450d10344c3d7be9eafd Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Sun, 27 Aug 2023 12:27:56 -0500 Subject: [PATCH 400/467] comment out land and write accumulated rof ocn land is writing is on hold, until we figure out how to compress the gaps (in mct, size is full atm, while for moab, land is masked/ domain already) we will need to pass instead of dofs an array order of dofs can we do that efficiently? or should we get the max size, and write empty stuff ? also, return the string that has sharedFieldsOcnRof --- driver-moab/main/prep_rof_mod.F90 | 13 +++++++++++++ driver-moab/main/seq_rest_mod.F90 | 30 +++++++++++++++++++++++------- 2 files changed, 36 insertions(+), 7 deletions(-) diff --git a/driver-moab/main/prep_rof_mod.F90 b/driver-moab/main/prep_rof_mod.F90 index 3ad5146bcd56..ca574a4627ec 100644 --- a/driver-moab/main/prep_rof_mod.F90 +++ b/driver-moab/main/prep_rof_mod.F90 @@ -74,6 +74,8 @@ module prep_rof_mod public :: prep_rof_get_mapper_Sa2r public :: prep_rof_get_mapper_Fa2r + public :: prep_rof_get_sharedFieldsOcnRof + public :: prep_rof_get_o2racc_om_cnt !-------------------------------------------------------------------------- ! Private interfaces !-------------------------------------------------------------------------- @@ -1937,4 +1939,15 @@ function prep_rof_get_mapper_Sa2r() prep_rof_get_mapper_Sa2r => mapper_Sa2r end function prep_rof_get_mapper_Sa2r + ! moab + function prep_rof_get_o2racc_om_cnt() + integer, pointer :: prep_rof_get_o2racc_om_cnt + prep_rof_get_o2racc_om_cnt => o2racc_om_cnt + end function prep_rof_get_o2racc_om_cnt + + function prep_rof_get_sharedFieldsOcnRof() + character(CXX) :: prep_rof_get_sharedFieldsOcnRof + prep_rof_get_sharedFieldsOcnRof = sharedFieldsOcnRof + end function prep_rof_get_sharedFieldsOcnRof + end module prep_rof_mod diff --git a/driver-moab/main/seq_rest_mod.F90 b/driver-moab/main/seq_rest_mod.F90 index c87f5cef865b..1fe82407d3ad 100644 --- a/driver-moab/main/seq_rest_mod.F90 +++ b/driver-moab/main/seq_rest_mod.F90 @@ -23,7 +23,7 @@ module seq_rest_mod ! !USES: use shr_kind_mod, only: R8 => SHR_KIND_R8, IN => SHR_KIND_IN - use shr_kind_mod, only: CL => SHR_KIND_CL, CS => SHR_KIND_CS + use shr_kind_mod, only: CL => SHR_KIND_CL, CS => SHR_KIND_CS, CXX => SHR_KIND_CXX use shr_sys_mod, only: shr_sys_abort, shr_sys_flush use shr_mpi_mod, only: shr_mpi_bcast use shr_cal_mod, only: shr_cal_date2ymd @@ -60,6 +60,8 @@ module seq_rest_mod use prep_rof_mod, only: prep_rof_get_l2racc_lx_cnt use prep_rof_mod, only: prep_rof_get_o2racc_ox use prep_rof_mod, only: prep_rof_get_o2racc_ox_cnt + use prep_rof_mod, only: prep_rof_get_sharedFieldsOcnRof + use prep_rof_mod, only: prep_rof_get_o2racc_om_cnt use prep_glc_mod, only: prep_glc_get_l2gacc_lx use prep_glc_mod, only: prep_glc_get_l2gacc_lx_cnt use prep_glc_mod, only: prep_glc_get_x2gacc_gx @@ -703,6 +705,8 @@ subroutine seq_rest_mb_write(EClock_d, seq_SyncClock, infodata, & real(r8),allocatable :: dsBGC(:) ! for reshaping diag data for restart file real(r8),allocatable :: nsBGC(:) ! for reshaping diag data for restart file character(CL) :: model_doi_url + character(CXX) :: tagname + integer (in) :: o2racc_om_cnt ! replacement, moab version for o2racc_ox_cnt character(len=*),parameter :: subname = "(seq_rest_mb_write) " !------------------------------------------------------------------------------- @@ -869,10 +873,9 @@ subroutine seq_rest_mb_write(EClock_d, seq_SyncClock, infodata, & ! whead=whead, wdata=wdata) endif if (lnd_present) then - call seq_io_write(rest_file, mblxid, 'fractions_lx', & - 'afrac:lfrac:lfrin', & ! seq_frac_mod: character(*),parameter :: fraclist_l = 'afrac:lfrac:lfrin' - whead=whead, wdata=wdata) -! whead=whead, wdata=wdata) + ! call seq_io_write(rest_file, mblxid, 'fractions_lx', & + ! 'afrac:lfrac:lfrin', & ! seq_frac_mod: character(*),parameter :: fraclist_l = 'afrac:lfrac:lfrin' + ! whead=whead, wdata=wdata) ! gsmap => component_get_gsmap_cx(lnd(1)) ! call seq_io_write(rest_file, gsmap, fractions_lx, 'fractions_lx', & ! whead=whead, wdata=wdata) @@ -886,7 +889,20 @@ subroutine seq_rest_mb_write(EClock_d, seq_SyncClock, infodata, & ! call seq_io_write(rest_file, l2racc_lx_cnt, 'l2racc_lx_cnt', & ! whead=whead, wdata=wdata) ! end if -! if (ocn_present .and. rofocn_prognostic) then + if (ocn_present .and. rofocn_prognostic) then + tagname = prep_rof_get_sharedFieldsOcnRof() + o2racc_om_cnt = prep_rof_get_o2racc_om_cnt() + call seq_io_write(rest_file, mboxid, 'o2racc_om', & + trim(tagname), & + whead=whead, wdata=wdata) + call seq_io_write(rest_file, o2racc_om_cnt, 'o2racc_om_cnt', & + whead=whead, wdata=wdata) +! o2racc_ox => prep_rof_get_o2racc_ox() +! o2racc_ox_cnt => prep_rof_get_o2racc_ox_cnt() +! call seq_io_write(rest_file, gsmap, o2racc_ox, 'o2racc_ox', & +! whead=whead, wdata=wdata) +! call seq_io_write(rest_file, o2racc_ox_cnt, 'o2racc_ox_cnt', & +! whead=whead, wdata=wdata) ! gsmap => component_get_gsmap_cx(ocn(1)) ! o2racc_ox => prep_rof_get_o2racc_ox() ! o2racc_ox_cnt => prep_rof_get_o2racc_ox_cnt() @@ -894,7 +910,7 @@ subroutine seq_rest_mb_write(EClock_d, seq_SyncClock, infodata, & ! whead=whead, wdata=wdata) ! call seq_io_write(rest_file, o2racc_ox_cnt, 'o2racc_ox_cnt', & ! whead=whead, wdata=wdata) -! end if + end if ! if (lnd_present .and. glc_prognostic) then ! gsmap => component_get_gsmap_cx(lnd(1)) ! l2gacc_lx => prep_glc_get_l2gacc_lx() From ab603b3d82d152450507bc6c4c545e8b11f46c12 Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Mon, 28 Aug 2023 10:48:00 -0500 Subject: [PATCH 401/467] add ocean and land writing land uses the max ng from atm, when samegrid_al is true it seems that the order is important, we may have to reorder the arrays based on ordering degrees of freedom --- driver-moab/main/cime_comp_mod.F90 | 2 +- driver-moab/main/prep_ocn_mod.F90 | 7 ++++ driver-moab/main/seq_io_mod.F90 | 6 +++- driver-moab/main/seq_rest_mod.F90 | 56 ++++++++++++++++++++++++++---- 4 files changed, 62 insertions(+), 9 deletions(-) diff --git a/driver-moab/main/cime_comp_mod.F90 b/driver-moab/main/cime_comp_mod.F90 index 77dcf838ace0..c26e738c1fdb 100644 --- a/driver-moab/main/cime_comp_mod.F90 +++ b/driver-moab/main/cime_comp_mod.F90 @@ -5348,7 +5348,7 @@ subroutine cime_run_write_restart(drv_pause, write_restart, drv_resume_file) call t_startf('CPL:seq_rest_mb_write') call seq_rest_mb_write(EClock_d, seq_SyncClock, infodata, & atm, lnd, ice, ocn, rof, glc, wav, esp, iac, & - trim(cpl_inst_tag), drv_resume_file) + trim(cpl_inst_tag), samegrid_al, drv_resume_file) call t_stopf('CPL:seq_rest_mb_write') if (iamroot_CPLID) then diff --git a/driver-moab/main/prep_ocn_mod.F90 b/driver-moab/main/prep_ocn_mod.F90 index eb967d4dac12..25f32df70e86 100644 --- a/driver-moab/main/prep_ocn_mod.F90 +++ b/driver-moab/main/prep_ocn_mod.F90 @@ -79,6 +79,8 @@ module prep_ocn_mod public :: prep_ocn_get_x2oacc_ox public :: prep_ocn_get_x2oacc_ox_cnt + + public :: prep_ocn_get_x2oacc_om_cnt #ifdef SUMMITDEV_PGI ! Sarat: Dummy variable added to workaround PGI compiler bug (PGI 17.9) as of Oct 23, 2017 public :: dummy_pgibugfix @@ -3015,4 +3017,9 @@ function prep_ocn_get_mapper_Sw2o() prep_ocn_get_mapper_Sw2o => mapper_Sw2o end function prep_ocn_get_mapper_Sw2o + function prep_ocn_get_x2oacc_om_cnt() + integer, pointer :: prep_ocn_get_x2oacc_om_cnt + prep_ocn_get_x2oacc_om_cnt => x2oacc_om_cnt + end function prep_ocn_get_x2oacc_om_cnt + end module prep_ocn_mod diff --git a/driver-moab/main/seq_io_mod.F90 b/driver-moab/main/seq_io_mod.F90 index 9f450e4824f0..8273f9fc3105 100644 --- a/driver-moab/main/seq_io_mod.F90 +++ b/driver-moab/main/seq_io_mod.F90 @@ -1563,7 +1563,7 @@ subroutine seq_io_write_time(filename,time_units,time_cal,time_val,nt,whead,wdat end subroutine seq_io_write_time - subroutine seq_io_write_moab_tags(filename, mbxid, dname, tag_list, whead,wdata, file_ind ) + subroutine seq_io_write_moab_tags(filename, mbxid, dname, tag_list, whead,wdata, nx, file_ind ) use shr_kind_mod, only: CX => shr_kind_CX, CXX => shr_kind_CXX @@ -1578,6 +1578,7 @@ subroutine seq_io_write_moab_tags(filename, mbxid, dname, tag_list, whead,wdata, character(len=*),intent(in) :: tag_list ! fields, separated by colon logical,optional,intent(in) :: whead ! write header logical,optional,intent(in) :: wdata ! write data + integer, optional,intent(in):: nx integer,optional,intent(in) :: file_ind logical :: lwhead, lwdata @@ -1641,6 +1642,9 @@ subroutine seq_io_write_moab_tags(filename, mbxid, dname, tag_list, whead,wdata, ! find out the number of global cells, needed for defining the variables length ierr = iMOAB_GetGlobalInfo( mbxid, dummy, ng) lnx = ng + ! it is needed to overwrite that for land, ng is too small + ! ( for ne4pg2 it is 201 instead of 384) + if (present(nx)) lnx = nx lny = 1 ! do we need 2 var, or just 1 ierr = iMOAB_GetMeshInfo ( mbxid, nvert, nvise, nbl, nsurf, nvisBC ) ns = nvise(1) ! local cells diff --git a/driver-moab/main/seq_rest_mod.F90 b/driver-moab/main/seq_rest_mod.F90 index 1fe82407d3ad..1ae64890215a 100644 --- a/driver-moab/main/seq_rest_mod.F90 +++ b/driver-moab/main/seq_rest_mod.F90 @@ -53,6 +53,8 @@ module seq_rest_mod ! prep modules - coupler communication between different components use prep_ocn_mod, only: prep_ocn_get_x2oacc_ox use prep_ocn_mod, only: prep_ocn_get_x2oacc_ox_cnt + ! moab version + use prep_ocn_mod, only: prep_ocn_get_x2oacc_om_cnt #ifdef SUMMITDEV_PGI use prep_ocn_mod, only: dummy_pgibugfix #endif @@ -70,7 +72,7 @@ module seq_rest_mod use prep_aoflux_mod, only: prep_aoflux_get_xao_ox use prep_aoflux_mod, only: prep_aoflux_get_xao_ax - use seq_flds_mod, only: seq_flds_a2x_fields, seq_flds_xao_fields + use seq_flds_mod, only: seq_flds_a2x_fields, seq_flds_xao_fields, seq_flds_o2x_fields, seq_flds_x2o_fields implicit none private @@ -664,9 +666,10 @@ end subroutine seq_rest_write subroutine seq_rest_mb_write(EClock_d, seq_SyncClock, infodata, & atm, lnd, ice, ocn, rof, glc, wav, esp, iac, & - tag, rest_file) + tag, samegrid_al, rest_file) - use seq_comm_mct, only: mbaxid, mbixid, mboxid, mblxid, mbrxid ! coupler side instances + use seq_comm_mct, only: mbaxid, mbixid, mboxid, mblxid, mbrxid, mbofxid ! coupler side instances + use iMOAB, only: iMOAB_GetGlobalInfo implicit none @@ -684,8 +687,10 @@ subroutine seq_rest_mb_write(EClock_d, seq_SyncClock, infodata, & type (component_type) , intent(inout) :: iac(:) character(len=*) , intent(in) :: tag + logical , intent(in) :: samegrid_al ! needed for character(len=CL) , intent(out) :: rest_file ! Restart filename + integer(IN) :: n,n1,n2,n3,fk integer(IN) :: curr_ymd ! Current date YYYYMMDD integer(IN) :: curr_tod ! Current time-of-day (s) @@ -706,7 +711,10 @@ subroutine seq_rest_mb_write(EClock_d, seq_SyncClock, infodata, & real(r8),allocatable :: nsBGC(:) ! for reshaping diag data for restart file character(CL) :: model_doi_url character(CXX) :: tagname - integer (in) :: o2racc_om_cnt ! replacement, moab version for o2racc_ox_cnt + integer (in), pointer :: o2racc_om_cnt ! replacement, moab version for o2racc_ox_cnt + integer (in), pointer :: x2oacc_om_cnt ! replacement, moab version for x2oacc_ox_cnt + integer (in) :: nx_lnd ! will be used if land and atm are on same grid + integer (in) :: ierr, dummy character(len=*),parameter :: subname = "(seq_rest_mb_write) " !------------------------------------------------------------------------------- @@ -873,6 +881,17 @@ subroutine seq_rest_mb_write(EClock_d, seq_SyncClock, infodata, & ! whead=whead, wdata=wdata) endif if (lnd_present) then + if(samegrid_al) then + ! nx for land will be from global nb atmosphere + ierr = iMOAB_GetGlobalInfo(mbaxid, dummy, nx_lnd) ! max id for land will come from atm + call seq_io_write(rest_file, mblxid, 'fractions_lx', & + 'afrac:lfrac:lfrin', & ! seq_frac_mod: character(*),parameter :: fraclist_l = 'afrac:lfrac:lfrin' + whead=whead, wdata=wdata, nx=nx_lnd) + else + call seq_io_write(rest_file, mblxid, 'fractions_lx', & + 'afrac:lfrac:lfrin', & ! seq_frac_mod: character(*),parameter :: fraclist_l = 'afrac:lfrac:lfrin' + whead=whead, wdata=wdata) + endif ! call seq_io_write(rest_file, mblxid, 'fractions_lx', & ! 'afrac:lfrac:lfrin', & ! seq_frac_mod: character(*),parameter :: fraclist_l = 'afrac:lfrac:lfrin' ! whead=whead, wdata=wdata) @@ -891,7 +910,7 @@ subroutine seq_rest_mb_write(EClock_d, seq_SyncClock, infodata, & ! end if if (ocn_present .and. rofocn_prognostic) then tagname = prep_rof_get_sharedFieldsOcnRof() - o2racc_om_cnt = prep_rof_get_o2racc_om_cnt() + o2racc_om_cnt => prep_rof_get_o2racc_om_cnt() call seq_io_write(rest_file, mboxid, 'o2racc_om', & trim(tagname), & whead=whead, wdata=wdata) @@ -929,9 +948,32 @@ subroutine seq_rest_mb_write(EClock_d, seq_SyncClock, infodata, & ! call seq_io_write(rest_file, x2gacc_gx_cnt, 'x2gacc_gx_cnt', & ! whead=whead, wdata=wdata) ! end if -! if (ocn_present) then + + if (ocn_present) then ! gsmap => component_get_gsmap_cx(ocn(1)) ! x2oacc_ox => prep_ocn_get_x2oacc_ox() + + call seq_io_write(rest_file, mboxid, 'fractions_ox', & + 'afrac:ifrac:ofrac:ifrad:ofrad', & ! fraclist_o = 'afrac:ifrac:ofrac:ifrad:ofrad' + whead=whead, wdata=wdata) + + call seq_io_write(rest_file, mboxid, 'o2x_ox', & + trim(seq_flds_o2x_fields), & + whead=whead, wdata=wdata) + tagname = trim(seq_flds_x2o_fields) + x2oacc_om_cnt => prep_ocn_get_x2oacc_om_cnt() + call seq_io_write(rest_file, mboxid, 'x2oacc_ox', & + trim(tagname), & + whead=whead, wdata=wdata) + call seq_io_write(rest_file, x2oacc_om_cnt, 'x2oacc_om_cnt', & + whead=whead, wdata=wdata) + ! tagname = trim(seq_flds_xao_fields)//C_NULL_CHAR + ! arrsize = nxflds * lsize ! allocate (xao_om (lsize, nxflds)) + ! ierr = iMOAB_GetDoubleTagStorage ( mbofxid, tagname, arrsize , ent_type, xao_om(1,1)) + call seq_io_write(rest_file, mbofxid, 'xao_om', & + trim(seq_flds_xao_fields), & + whead=whead, wdata=wdata) +! whead=whead, wdata=wdata) ! #ifdef SUMMITDEV_PGI ! dummy_pgibugfix = associated(x2oacc_ox) ! #endif @@ -947,7 +989,7 @@ subroutine seq_rest_mb_write(EClock_d, seq_SyncClock, infodata, & ! whead=whead, wdata=wdata) ! call seq_io_write(rest_file, gsmap, xao_ox, 'xao_ox', & ! whead=whead, wdata=wdata) -! endif + endif ! if (ice_present) then ! gsmap => component_get_gsmap_cx(ice(1)) ! call seq_io_write(rest_file, gsmap, fractions_ix, 'fractions_ix', & From 23a841f2d2344635c84e6eefdf49ea767c2a221a Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Mon, 28 Aug 2023 17:30:58 -0500 Subject: [PATCH 402/467] add ice and river --- driver-moab/main/seq_rest_mod.F90 | 111 ++++++++++++++++-------------- 1 file changed, 59 insertions(+), 52 deletions(-) diff --git a/driver-moab/main/seq_rest_mod.F90 b/driver-moab/main/seq_rest_mod.F90 index 1ae64890215a..393a5b9faa87 100644 --- a/driver-moab/main/seq_rest_mod.F90 +++ b/driver-moab/main/seq_rest_mod.F90 @@ -73,6 +73,7 @@ module seq_rest_mod use prep_aoflux_mod, only: prep_aoflux_get_xao_ax use seq_flds_mod, only: seq_flds_a2x_fields, seq_flds_xao_fields, seq_flds_o2x_fields, seq_flds_x2o_fields + use seq_flds_mod, only: seq_flds_i2x_fields, seq_flds_r2x_fields implicit none private @@ -923,12 +924,6 @@ subroutine seq_rest_mb_write(EClock_d, seq_SyncClock, infodata, & ! call seq_io_write(rest_file, o2racc_ox_cnt, 'o2racc_ox_cnt', & ! whead=whead, wdata=wdata) ! gsmap => component_get_gsmap_cx(ocn(1)) -! o2racc_ox => prep_rof_get_o2racc_ox() -! o2racc_ox_cnt => prep_rof_get_o2racc_ox_cnt() -! call seq_io_write(rest_file, gsmap, o2racc_ox, 'o2racc_ox', & -! whead=whead, wdata=wdata) -! call seq_io_write(rest_file, o2racc_ox_cnt, 'o2racc_ox_cnt', & -! whead=whead, wdata=wdata) end if ! if (lnd_present .and. glc_prognostic) then ! gsmap => component_get_gsmap_cx(lnd(1)) @@ -949,61 +944,73 @@ subroutine seq_rest_mb_write(EClock_d, seq_SyncClock, infodata, & ! whead=whead, wdata=wdata) ! end if - if (ocn_present) then -! gsmap => component_get_gsmap_cx(ocn(1)) -! x2oacc_ox => prep_ocn_get_x2oacc_ox() - - call seq_io_write(rest_file, mboxid, 'fractions_ox', & - 'afrac:ifrac:ofrac:ifrad:ofrad', & ! fraclist_o = 'afrac:ifrac:ofrac:ifrad:ofrad' + if (ocn_present) then + ! gsmap => component_get_gsmap_cx(ocn(1)) + ! x2oacc_ox => prep_ocn_get_x2oacc_ox() + + call seq_io_write(rest_file, mboxid, 'fractions_ox', & + 'afrac:ifrac:ofrac:ifrad:ofrad', & ! fraclist_o = 'afrac:ifrac:ofrac:ifrad:ofrad' + whead=whead, wdata=wdata) + + call seq_io_write(rest_file, mboxid, 'o2x_ox', & + trim(seq_flds_o2x_fields), & + whead=whead, wdata=wdata) + tagname = trim(seq_flds_x2o_fields) + x2oacc_om_cnt => prep_ocn_get_x2oacc_om_cnt() + call seq_io_write(rest_file, mboxid, 'x2oacc_ox', & + trim(tagname), & + whead=whead, wdata=wdata) + call seq_io_write(rest_file, x2oacc_om_cnt, 'x2oacc_om_cnt', & whead=whead, wdata=wdata) - - call seq_io_write(rest_file, mboxid, 'o2x_ox', & - trim(seq_flds_o2x_fields), & + ! tagname = trim(seq_flds_xao_fields)//C_NULL_CHAR + ! arrsize = nxflds * lsize ! allocate (xao_om (lsize, nxflds)) + ! ierr = iMOAB_GetDoubleTagStorage ( mbofxid, tagname, arrsize , ent_type, xao_om(1,1)) + call seq_io_write(rest_file, mbofxid, 'xao_om', & + trim(seq_flds_xao_fields), & + whead=whead, wdata=wdata) + ! whead=whead, wdata=wdata) + ! #ifdef SUMMITDEV_PGI + ! dummy_pgibugfix = associated(x2oacc_ox) + ! #endif + ! x2oacc_ox_cnt => prep_ocn_get_x2oacc_ox_cnt() + ! xao_ox => prep_aoflux_get_xao_ox() + ! call seq_io_write(rest_file, gsmap, fractions_ox, 'fractions_ox', & + ! whead=whead, wdata=wdata) + ! call seq_io_write(rest_file, ocn, 'c2x', 'o2x_ox', & + ! whead=whead, wdata=wdata) + ! call seq_io_write(rest_file, gsmap, x2oacc_ox, 'x2oacc_ox', & + ! whead=whead, wdata=wdata) + ! call seq_io_write(rest_file, x2oacc_ox_cnt, 'x2oacc_ox_cnt', & + ! whead=whead, wdata=wdata) + ! call seq_io_write(rest_file, gsmap, xao_ox, 'xao_ox', & + ! whead=whead, wdata=wdata) + endif + if (ice_present) then + call seq_io_write(rest_file, mbixid, 'fractions_ix', & + 'afrac:ifrac:ofrac', & ! fraclist_i = 'afrac:ifrac:ofrac' whead=whead, wdata=wdata) - tagname = trim(seq_flds_x2o_fields) - x2oacc_om_cnt => prep_ocn_get_x2oacc_om_cnt() - call seq_io_write(rest_file, mboxid, 'x2oacc_ox', & - trim(tagname), & + call seq_io_write(rest_file, mbixid, 'i2x_ix', & + trim(seq_flds_i2x_fields), & + whead=whead, wdata=wdata) + ! gsmap => component_get_gsmap_cx(ice(1)) + ! call seq_io_write(rest_file, gsmap, fractions_ix, 'fractions_ix', & + ! whead=whead, wdata=wdata) + ! call seq_io_write(rest_file, ice, 'c2x', 'i2x_ix', & + ! whead=whead, wdata=wdata) + endif + if (rof_present) then + call seq_io_write(rest_file, mbrxid, 'fractions_rx', & + 'lfrac:lfrin:rfrac', & ! fraclist_r = 'lfrac:lfrin:rfrac' whead=whead, wdata=wdata) - call seq_io_write(rest_file, x2oacc_om_cnt, 'x2oacc_om_cnt', & - whead=whead, wdata=wdata) - ! tagname = trim(seq_flds_xao_fields)//C_NULL_CHAR - ! arrsize = nxflds * lsize ! allocate (xao_om (lsize, nxflds)) - ! ierr = iMOAB_GetDoubleTagStorage ( mbofxid, tagname, arrsize , ent_type, xao_om(1,1)) - call seq_io_write(rest_file, mbofxid, 'xao_om', & - trim(seq_flds_xao_fields), & + call seq_io_write(rest_file, mbrxid, 'r2x_rx', & + trim(seq_flds_r2x_fields), & whead=whead, wdata=wdata) -! whead=whead, wdata=wdata) -! #ifdef SUMMITDEV_PGI -! dummy_pgibugfix = associated(x2oacc_ox) -! #endif -! x2oacc_ox_cnt => prep_ocn_get_x2oacc_ox_cnt() -! xao_ox => prep_aoflux_get_xao_ox() -! call seq_io_write(rest_file, gsmap, fractions_ox, 'fractions_ox', & -! whead=whead, wdata=wdata) -! call seq_io_write(rest_file, ocn, 'c2x', 'o2x_ox', & -! whead=whead, wdata=wdata) -! call seq_io_write(rest_file, gsmap, x2oacc_ox, 'x2oacc_ox', & -! whead=whead, wdata=wdata) -! call seq_io_write(rest_file, x2oacc_ox_cnt, 'x2oacc_ox_cnt', & -! whead=whead, wdata=wdata) -! call seq_io_write(rest_file, gsmap, xao_ox, 'xao_ox', & -! whead=whead, wdata=wdata) - endif -! if (ice_present) then -! gsmap => component_get_gsmap_cx(ice(1)) -! call seq_io_write(rest_file, gsmap, fractions_ix, 'fractions_ix', & -! whead=whead, wdata=wdata) -! call seq_io_write(rest_file, ice, 'c2x', 'i2x_ix', & -! whead=whead, wdata=wdata) -! endif -! if (rof_present) then ! gsmap => component_get_gsmap_cx(rof(1)) ! call seq_io_write(rest_file, gsmap, fractions_rx, 'fractions_rx', & ! whead=whead, wdata=wdata) ! call seq_io_write(rest_file, rof, 'c2x', 'r2x_rx', & ! whead=whead, wdata=wdata) -! endif + endif ! if (glc_present) then ! gsmap => component_get_gsmap_cx(glc(1)) ! call seq_io_write(rest_file, gsmap, fractions_gx, 'fractions_gx', & From 11bf4a501f6bdac2b088893926ccffb303dd36b4 Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Tue, 29 Aug 2023 07:43:23 -0500 Subject: [PATCH 403/467] reorder based on dofs use m_MergeSorts, reorder data1 according to dofs --- driver-moab/main/seq_io_mod.F90 | 33 +++++++++++++++++++++++++++------ 1 file changed, 27 insertions(+), 6 deletions(-) diff --git a/driver-moab/main/seq_io_mod.F90 b/driver-moab/main/seq_io_mod.F90 index 8273f9fc3105..cca2907db4a5 100644 --- a/driver-moab/main/seq_io_mod.F90 +++ b/driver-moab/main/seq_io_mod.F90 @@ -1570,6 +1570,8 @@ subroutine seq_io_write_moab_tags(filename, mbxid, dname, tag_list, whead,wdata, use iMOAB, only: iMOAB_GetGlobalInfo, iMOAB_GetMeshInfo, iMOAB_GetDoubleTagStorage, & iMOAB_GetIntTagStorage + use m_MergeSorts, only: IndexSet, IndexSort + ! !INPUT/OUTPUT PARAMETERS: implicit none character(len=*),intent(in) :: filename ! file @@ -1585,7 +1587,7 @@ subroutine seq_io_write_moab_tags(filename, mbxid, dname, tag_list, whead,wdata, !integer :: start(2),count(2) character(*),parameter :: subName = '(seq_io_write_moab_tags) ' integer :: ndims, lfile_ind, iam, rcode - integer(in) :: ns, ng, lnx, lny + integer(in) :: ns, ng, lnx, lny, ix integer nvert(3), nvise(3), nbl(3), nsurf(3), nvisBC(3) ! for moab info type(var_desc_t) :: varid @@ -1605,8 +1607,10 @@ subroutine seq_io_write_moab_tags(filename, mbxid, dname, tag_list, whead,wdata, integer(in) :: dimid2(2) integer(in) :: dummy, ent_type, ierr real(r8) :: lfillvalue ! or just use fillvalue ? + integer, allocatable :: indx(:) ! this will be ordered integer, allocatable :: Dof(:) ! will be filled with global ids from cells - real(r8), allocatable :: data1(:) + integer, allocatable :: Dof_reorder(:) ! + real(r8), allocatable :: data1(:), data_reorder(:) !------------------------------------------------------------------------------- ! @@ -1678,16 +1682,27 @@ subroutine seq_io_write_moab_tags(filename, mbxid, dname, tag_list, whead,wdata, if (lwdata) then allocate(data1(ns)) + allocate(data_reorder(ns)) allocate(dof(ns)) + allocate(dof_reorder(ns)) ! note: size of dof is ns tagname = 'GLOBAL_ID'//C_NULL_CHAR ierr = iMOAB_GetIntTagStorage ( mbxid, tagname, ns , ent_type, dof(1)) - - call pio_initdecomp(cpl_io_subsystem, pio_double, (/lnx,lny/), dof, iodesc) - deallocate(dof) + allocate(indx(ns)) + call IndexSet(ns, indx) + call IndexSort(ns, indx, dof, descend=.false.) + ! after sort, dof( indx(i)) < dof( indx(i+1) ) + do ix=1,ns + dof_reorder(ix) = dof(indx(ix)) ! + enddo + ! so we know that dof_reorder(ix) < dof_reorder(ix+1) + call pio_initdecomp(cpl_io_subsystem, pio_double, (/lnx,lny/), dof_reorder, iodesc) + + deallocate(dof) + deallocate(dof_reorder) do index_list = 1, size_list call mct_list_get(mctOStr,index_list,temp_list) field = mct_string_toChar(mctOStr) @@ -1698,12 +1713,18 @@ subroutine seq_io_write_moab_tags(filename, mbxid, dname, tag_list, whead,wdata, !call pio_setframe(cpl_io_file(lfile_ind),varid,frame) tagname = trim(field)//C_NULL_CHAR ierr = iMOAB_GetDoubleTagStorage (mbxid, tagname, ns , ent_type, data1(1)) - call pio_write_darray(cpl_io_file(lfile_ind), varid, iodesc, data1, rcode, fillval=lfillvalue) + do ix=1,ns + data_reorder(ix) = data1(indx(ix)) ! + enddo + + call pio_write_darray(cpl_io_file(lfile_ind), varid, iodesc, data_reorder, rcode, fillval=lfillvalue) endif enddo call pio_freedecomp(cpl_io_file(lfile_ind), iodesc) deallocate(data1) + deallocate(data_reorder) + deallocate(indx) end if From 2ad08cf98e302ad1a7541c7a9ab60ce31feefc48 Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Tue, 29 Aug 2023 10:41:23 -0500 Subject: [PATCH 404/467] global id tag need to be added explicitly to rof and lnd on coupler side, because we read it directly from file --- driver-moab/main/cplcomp_exchange_mod.F90 | 19 +++++++++++++++++++ driver-moab/main/seq_rest_mod.F90 | 1 + 2 files changed, 20 insertions(+) diff --git a/driver-moab/main/cplcomp_exchange_mod.F90 b/driver-moab/main/cplcomp_exchange_mod.F90 index 2d2320884517..8f06ff714891 100644 --- a/driver-moab/main/cplcomp_exchange_mod.F90 +++ b/driver-moab/main/cplcomp_exchange_mod.F90 @@ -1322,6 +1322,15 @@ 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 + ! need to add global id tag to the app, it will be used in restart + tagtype = 0 ! dense, integer + numco = 1 + tagname='GLOBAL_ID'//C_NULL_CHAR + ierr = iMOAB_DefineTagStorage(mblxid, tagname, tagtype, numco, tagindex ) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in adding global id tag to lndx' + call shr_sys_abort(subname//' ERROR in adding global id tag to lndx ') + endif #ifdef MOABDEBUG outfile = 'recLand.h5m'//C_NULL_CHAR wopts = ';PARALLEL=WRITE_PART'//C_NULL_CHAR ! @@ -1497,6 +1506,16 @@ subroutine cplcomp_moab_Init(infodata,comp) 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 + tagname='GLOBAL_ID'//C_NULL_CHAR + ierr = iMOAB_DefineTagStorage(mbrxid, tagname, tagtype, numco, tagindex ) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in adding global id tag to rof' + call shr_sys_abort(subname//' ERROR in adding global id tag to rof ') + endif + #ifdef MOABDEBUG ! debug test outfile = 'recRof.h5m'//C_NULL_CHAR diff --git a/driver-moab/main/seq_rest_mod.F90 b/driver-moab/main/seq_rest_mod.F90 index 393a5b9faa87..f34ff00d9714 100644 --- a/driver-moab/main/seq_rest_mod.F90 +++ b/driver-moab/main/seq_rest_mod.F90 @@ -881,6 +881,7 @@ subroutine seq_rest_mb_write(EClock_d, seq_SyncClock, infodata, & ! call seq_io_write(rest_file, gsmap, xao_ax, 'xao_ax', & ! whead=whead, wdata=wdata) endif + if (lnd_present) then if(samegrid_al) then ! nx for land will be from global nb atmosphere From 343c2e36c18550fc617e488b4631f5cfe43dde21 Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Tue, 29 Aug 2023 20:40:57 -0500 Subject: [PATCH 405/467] add matrix optional argument basically, pass an optional moab matrix (2d array) to the moab write method it will be used for accumulated variables, that do not have a separate tag defined; they are parallel to other variables if matrix is passed, then values are from the matrix and not from the actual tag so far, it is tested for x2oacc_om (x2oacc_ox) variable return also a pointer to private data : play with fire --- driver-moab/main/prep_ocn_mod.F90 | 9 +++++++-- driver-moab/main/seq_io_mod.F90 | 20 +++++++++++++++++--- driver-moab/main/seq_rest_mod.F90 | 8 +++++++- 3 files changed, 31 insertions(+), 6 deletions(-) diff --git a/driver-moab/main/prep_ocn_mod.F90 b/driver-moab/main/prep_ocn_mod.F90 index 25f32df70e86..5e661a4babd0 100644 --- a/driver-moab/main/prep_ocn_mod.F90 +++ b/driver-moab/main/prep_ocn_mod.F90 @@ -99,6 +99,8 @@ module prep_ocn_mod public :: prep_ocn_get_mapper_Fg2o public :: prep_ocn_get_mapper_Sw2o + public :: prep_ocn_get_x2oacc_om ! will return a pointer to the local private matrix ? is that correct ? + !-------------------------------------------------------------------------- ! Private interfaces !-------------------------------------------------------------------------- @@ -137,7 +139,7 @@ module prep_ocn_mod integer , target :: x2oacc_ox_cnt ! x2oacc_ox: number of time samples accumulated ! accumulation variables for moab data - real (kind=r8) , allocatable, private :: x2oacc_om (:,:) ! Ocn import, ocn grid, cpl pes, moab array + real (kind=r8) , allocatable, private, target :: x2oacc_om (:,:) ! Ocn import, ocn grid, cpl pes, moab array integer , target :: x2oacc_om_cnt ! x2oacc_ox: number of time samples accumulated, in moab array integer :: arrSize_x2o_om ! this will be a module variable, size moabLocal_size * nof @@ -3016,7 +3018,10 @@ function prep_ocn_get_mapper_Sw2o() type(seq_map), pointer :: prep_ocn_get_mapper_Sw2o prep_ocn_get_mapper_Sw2o => mapper_Sw2o end function prep_ocn_get_mapper_Sw2o - + function prep_ocn_get_x2oacc_om() + real(r8), DIMENSION(:, :), pointer :: prep_ocn_get_x2oacc_om + prep_ocn_get_x2oacc_om => x2oacc_om + end function prep_ocn_get_x2oacc_om function prep_ocn_get_x2oacc_om_cnt() integer, pointer :: prep_ocn_get_x2oacc_om_cnt prep_ocn_get_x2oacc_om_cnt => x2oacc_om_cnt diff --git a/driver-moab/main/seq_io_mod.F90 b/driver-moab/main/seq_io_mod.F90 index cca2907db4a5..7cdb1ca8360e 100644 --- a/driver-moab/main/seq_io_mod.F90 +++ b/driver-moab/main/seq_io_mod.F90 @@ -1563,7 +1563,7 @@ subroutine seq_io_write_time(filename,time_units,time_cal,time_val,nt,whead,wdat end subroutine seq_io_write_time - subroutine seq_io_write_moab_tags(filename, mbxid, dname, tag_list, whead,wdata, nx, file_ind ) + subroutine seq_io_write_moab_tags(filename, mbxid, dname, tag_list, whead,wdata, matrix, nx, file_ind ) use shr_kind_mod, only: CX => shr_kind_CX, CXX => shr_kind_CXX @@ -1580,6 +1580,7 @@ subroutine seq_io_write_moab_tags(filename, mbxid, dname, tag_list, whead,wdata, character(len=*),intent(in) :: tag_list ! fields, separated by colon logical,optional,intent(in) :: whead ! write header logical,optional,intent(in) :: wdata ! write data + real(r8), dimension(:,:), pointer, optional :: matrix ! this may or may not be passed integer, optional,intent(in):: nx integer,optional,intent(in) :: file_ind @@ -1689,6 +1690,10 @@ subroutine seq_io_write_moab_tags(filename, mbxid, dname, tag_list, whead,wdata, ! note: size of dof is ns tagname = 'GLOBAL_ID'//C_NULL_CHAR ierr = iMOAB_GetIntTagStorage ( mbxid, tagname, ns , ent_type, dof(1)) + if (ierr .ne. 0) then + write(logunit,*) subname,' ERROR: cannot get dofs ' + call shr_sys_abort(subname//'cannot get dofs ') + endif allocate(indx(ns)) call IndexSet(ns, indx) @@ -1711,8 +1716,16 @@ subroutine seq_io_write_moab_tags(filename, mbxid, dname, tag_list, whead,wdata, name1 = trim(lpre)//'_'//trim(field) rcode = pio_inq_varid(cpl_io_file(lfile_ind),trim(name1),varid) !call pio_setframe(cpl_io_file(lfile_ind),varid,frame) - tagname = trim(field)//C_NULL_CHAR - ierr = iMOAB_GetDoubleTagStorage (mbxid, tagname, ns , ent_type, data1(1)) + if (present(matrix)) then + data1(:) = matrix(:, index_list) ! + else + tagname = trim(field)//C_NULL_CHAR + ierr = iMOAB_GetDoubleTagStorage (mbxid, tagname, ns , ent_type, data1(1)) + if (ierr .ne. 0) then + write(logunit,*) subname,' ERROR: cannot get tag data ', trim(tagname) + call shr_sys_abort(subname//'cannot get tag data ') + endif + endif do ix=1,ns data_reorder(ix) = data1(indx(ix)) ! enddo @@ -1730,6 +1743,7 @@ subroutine seq_io_write_moab_tags(filename, mbxid, dname, tag_list, whead,wdata, end subroutine seq_io_write_moab_tags + !=============================================================================== !BOP =========================================================================== ! diff --git a/driver-moab/main/seq_rest_mod.F90 b/driver-moab/main/seq_rest_mod.F90 index f34ff00d9714..265a4ee8dc66 100644 --- a/driver-moab/main/seq_rest_mod.F90 +++ b/driver-moab/main/seq_rest_mod.F90 @@ -74,6 +74,8 @@ module seq_rest_mod use seq_flds_mod, only: seq_flds_a2x_fields, seq_flds_xao_fields, seq_flds_o2x_fields, seq_flds_x2o_fields use seq_flds_mod, only: seq_flds_i2x_fields, seq_flds_r2x_fields + + use prep_ocn_mod, only: prep_ocn_get_x2oacc_om implicit none private @@ -716,6 +718,8 @@ subroutine seq_rest_mb_write(EClock_d, seq_SyncClock, infodata, & integer (in), pointer :: x2oacc_om_cnt ! replacement, moab version for x2oacc_ox_cnt integer (in) :: nx_lnd ! will be used if land and atm are on same grid integer (in) :: ierr, dummy + + real(r8), dimension(:,:), pointer :: p_x2oacc_om character(len=*),parameter :: subname = "(seq_rest_mb_write) " !------------------------------------------------------------------------------- @@ -958,9 +962,11 @@ subroutine seq_rest_mb_write(EClock_d, seq_SyncClock, infodata, & whead=whead, wdata=wdata) tagname = trim(seq_flds_x2o_fields) x2oacc_om_cnt => prep_ocn_get_x2oacc_om_cnt() + p_x2oacc_om => prep_ocn_get_x2oacc_om() + call seq_io_write(rest_file, mboxid, 'x2oacc_ox', & trim(tagname), & - whead=whead, wdata=wdata) + whead=whead, wdata=wdata, matrix=p_x2oacc_om) call seq_io_write(rest_file, x2oacc_om_cnt, 'x2oacc_om_cnt', & whead=whead, wdata=wdata) ! tagname = trim(seq_flds_xao_fields)//C_NULL_CHAR From ecf981d70348ad7c0a12e0adf599701d49bc8d9b Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Tue, 29 Aug 2023 22:00:27 -0500 Subject: [PATCH 406/467] add rof l2racc_lm l2racc_lx use samegrid_al logic for land --- driver-moab/main/prep_rof_mod.F90 | 32 +++++++++++++++++++++++++++++-- driver-moab/main/seq_rest_mod.F90 | 32 +++++++++++++++++++++++++++---- 2 files changed, 58 insertions(+), 6 deletions(-) diff --git a/driver-moab/main/prep_rof_mod.F90 b/driver-moab/main/prep_rof_mod.F90 index ca574a4627ec..dab66ce10680 100644 --- a/driver-moab/main/prep_rof_mod.F90 +++ b/driver-moab/main/prep_rof_mod.F90 @@ -75,7 +75,12 @@ module prep_rof_mod public :: prep_rof_get_mapper_Fa2r public :: prep_rof_get_sharedFieldsOcnRof + public :: prep_rof_get_o2racc_om ! return a pointer to private array !!! public :: prep_rof_get_o2racc_om_cnt + + public :: prep_rof_get_l2racc_lm_cnt + public :: prep_rof_get_l2racc_lm + public :: prep_rof_get_sharedFieldsLndRof !-------------------------------------------------------------------------- ! Private interfaces !-------------------------------------------------------------------------- @@ -107,7 +112,7 @@ module prep_rof_mod ! accumulation variables over moab fields character(CXX) :: sharedFieldsLndRof ! used in moab to define l2racc_lm - real (kind=r8) , allocatable, private :: l2racc_lm(:,:) ! lnd export, lnd grid, cpl pes + real (kind=r8) , allocatable, private, target :: l2racc_lm(:,:) ! lnd export, lnd grid, cpl pes real (kind=r8) , allocatable, private :: l2x_lm2(:,:) ! basically l2x_lm, but in another copy, on rof module integer , target :: l2racc_lm_cnt ! l2racc_lm: number of time samples accumulated integer :: nfields_sh_lr ! number of fields in sharedFieldsLndRof @@ -121,7 +126,7 @@ module prep_rof_mod integer :: lsize_am ! size of atm in moab, local character(CXX) :: sharedFieldsOcnRof ! used in moab to define o2racc_om - real (kind=r8) , allocatable, private :: o2racc_om(:,:) ! ocn export, ocn grid, cpl pes + real (kind=r8) , allocatable, private, target :: o2racc_om(:,:) ! ocn export, ocn grid, cpl pes real (kind=r8) , allocatable, private :: o2r_om2(:,:) ! basically o2x_om, but in another copy, on rof module, only shared with rof integer , target :: o2racc_om_cnt ! o2racc_om: number of time samples accumulated integer :: nfields_sh_or ! number of fields in sharedFieldsOcnRof @@ -1940,14 +1945,37 @@ function prep_rof_get_mapper_Sa2r() end function prep_rof_get_mapper_Sa2r ! moab + ! for ocean function prep_rof_get_o2racc_om_cnt() integer, pointer :: prep_rof_get_o2racc_om_cnt prep_rof_get_o2racc_om_cnt => o2racc_om_cnt end function prep_rof_get_o2racc_om_cnt + function prep_rof_get_o2racc_om() + real(r8), DIMENSION(:, :), pointer :: prep_rof_get_o2racc_om + prep_rof_get_o2racc_om => o2racc_om + end function prep_rof_get_o2racc_om + function prep_rof_get_sharedFieldsOcnRof() character(CXX) :: prep_rof_get_sharedFieldsOcnRof prep_rof_get_sharedFieldsOcnRof = sharedFieldsOcnRof end function prep_rof_get_sharedFieldsOcnRof + + ! for land + function prep_rof_get_l2racc_lm_cnt() + integer, pointer :: prep_rof_get_l2racc_lm_cnt + prep_rof_get_l2racc_lm_cnt => l2racc_lm_cnt + end function prep_rof_get_l2racc_lm_cnt + + function prep_rof_get_l2racc_lm() + real(r8), DIMENSION(:, :), pointer :: prep_rof_get_l2racc_lm + prep_rof_get_l2racc_lm => l2racc_lm + end function prep_rof_get_l2racc_lm + + function prep_rof_get_sharedFieldsLndRof() + character(CXX) :: prep_rof_get_sharedFieldsLndRof + prep_rof_get_sharedFieldsLndRof = sharedFieldsLndRof + end function prep_rof_get_sharedFieldsLndRof + end module prep_rof_mod diff --git a/driver-moab/main/seq_rest_mod.F90 b/driver-moab/main/seq_rest_mod.F90 index 265a4ee8dc66..1aefefaac89f 100644 --- a/driver-moab/main/seq_rest_mod.F90 +++ b/driver-moab/main/seq_rest_mod.F90 @@ -76,6 +76,11 @@ module seq_rest_mod use seq_flds_mod, only: seq_flds_i2x_fields, seq_flds_r2x_fields use prep_ocn_mod, only: prep_ocn_get_x2oacc_om + use prep_rof_mod, only: prep_rof_get_o2racc_om ! return a pointer to a moab matrix + + use prep_rof_mod, only: prep_rof_get_l2racc_lm_cnt + use prep_rof_mod, only: prep_rof_get_l2racc_lm + use prep_rof_mod, only: prep_rof_get_sharedFieldsLndRof implicit none private @@ -690,7 +695,7 @@ subroutine seq_rest_mb_write(EClock_d, seq_SyncClock, infodata, & type (component_type) , intent(inout) :: iac(:) character(len=*) , intent(in) :: tag - logical , intent(in) :: samegrid_al ! needed for + logical , intent(in) :: samegrid_al ! needed for land nx character(len=CL) , intent(out) :: rest_file ! Restart filename @@ -716,10 +721,14 @@ subroutine seq_rest_mb_write(EClock_d, seq_SyncClock, infodata, & character(CXX) :: tagname integer (in), pointer :: o2racc_om_cnt ! replacement, moab version for o2racc_ox_cnt integer (in), pointer :: x2oacc_om_cnt ! replacement, moab version for x2oacc_ox_cnt + + integer (in), pointer :: l2racc_lm_cnt integer (in) :: nx_lnd ! will be used if land and atm are on same grid integer (in) :: ierr, dummy real(r8), dimension(:,:), pointer :: p_x2oacc_om + real(r8), dimension(:,:), pointer :: p_o2racc_om + real(r8), dimension(:,:), pointer :: p_l2racc_lm character(len=*),parameter :: subname = "(seq_rest_mb_write) " !------------------------------------------------------------------------------- @@ -905,7 +914,21 @@ subroutine seq_rest_mb_write(EClock_d, seq_SyncClock, infodata, & ! call seq_io_write(rest_file, gsmap, fractions_lx, 'fractions_lx', & ! whead=whead, wdata=wdata) endif -! if (lnd_present .and. rof_prognostic) then + if (lnd_present .and. rof_prognostic) then + tagname = prep_rof_get_sharedFieldsLndRof() + l2racc_lm_cnt => prep_rof_get_l2racc_lm_cnt() + p_l2racc_lm => prep_rof_get_l2racc_lm() + if(samegrid_al) then + ! nx for land will be from global nb atmosphere + ierr = iMOAB_GetGlobalInfo(mbaxid, dummy, nx_lnd) ! max id for land will come from atm + call seq_io_write(rest_file, mblxid, 'l2racc_lx', & + trim(tagname), & + whead=whead, wdata=wdata, matrix = p_l2racc_lm, nx=nx_lnd) + else + call seq_io_write(rest_file, mblxid, 'l2racc_lx', & + trim(tagname), & + whead=whead, wdata=wdata, matrix = p_l2racc_lm ) + endif ! gsmap => component_get_gsmap_cx(lnd(1)) ! l2racc_lx => prep_rof_get_l2racc_lx() ! l2racc_lx_cnt => prep_rof_get_l2racc_lx_cnt() @@ -913,13 +936,14 @@ subroutine seq_rest_mb_write(EClock_d, seq_SyncClock, infodata, & ! whead=whead, wdata=wdata) ! call seq_io_write(rest_file, l2racc_lx_cnt, 'l2racc_lx_cnt', & ! whead=whead, wdata=wdata) -! end if + end if if (ocn_present .and. rofocn_prognostic) then tagname = prep_rof_get_sharedFieldsOcnRof() o2racc_om_cnt => prep_rof_get_o2racc_om_cnt() + p_o2racc_om => prep_rof_get_o2racc_om() call seq_io_write(rest_file, mboxid, 'o2racc_om', & trim(tagname), & - whead=whead, wdata=wdata) + whead=whead, wdata=wdata, matrix = p_o2racc_om ) call seq_io_write(rest_file, o2racc_om_cnt, 'o2racc_om_cnt', & whead=whead, wdata=wdata) ! o2racc_ox => prep_rof_get_o2racc_ox() From f42c65345bc6d9af3bc3ef5693e6998064c36a27 Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Wed, 30 Aug 2023 17:29:06 -0500 Subject: [PATCH 407/467] add prototype for read moab tags not tested yet --- driver-moab/main/cime_comp_mod.F90 | 7 +- driver-moab/main/seq_io_mod.F90 | 200 +++++++++++++++++++++++++++++ driver-moab/main/seq_rest_mod.F90 | 185 ++++++++++++++++++++++++++ 3 files changed, 391 insertions(+), 1 deletion(-) diff --git a/driver-moab/main/cime_comp_mod.F90 b/driver-moab/main/cime_comp_mod.F90 index c26e738c1fdb..cb3b7a22a4a9 100644 --- a/driver-moab/main/cime_comp_mod.F90 +++ b/driver-moab/main/cime_comp_mod.F90 @@ -126,7 +126,7 @@ module cime_comp_mod use seq_hist_mod, only : seq_hist_write, seq_hist_writeavg, seq_hist_writeaux ! restart file routines - use seq_rest_mod, only : seq_rest_read, seq_rest_write, seq_rest_mb_write + use seq_rest_mod, only : seq_rest_read, seq_rest_mb_read, seq_rest_write, seq_rest_mb_write ! flux calc routines use seq_flux_mct, only: seq_flux_init_mct, seq_flux_initexch_mct, seq_flux_ocnalb_mct @@ -2522,6 +2522,11 @@ subroutine cime_init() fractions_rx, fractions_gx, fractions_wx, fractions_zx) call t_stopf('CPL:seq_rest_read-init') + call t_startf('CPL:seq_rest_read-moab') + call seq_rest_mb_read(rest_file, infodata) + call t_stopf('CPL:seq_rest_read-moab') + + endif call t_adj_detailf(-2) diff --git a/driver-moab/main/seq_io_mod.F90 b/driver-moab/main/seq_io_mod.F90 index 7cdb1ca8360e..72f675906c0d 100644 --- a/driver-moab/main/seq_io_mod.F90 +++ b/driver-moab/main/seq_io_mod.F90 @@ -73,6 +73,7 @@ module seq_io_mod module procedure seq_io_read_r8 module procedure seq_io_read_r81d module procedure seq_io_read_char + module procedure seq_io_read_moab_tags end interface seq_io_read interface seq_io_write module procedure seq_io_write_av @@ -2484,6 +2485,205 @@ subroutine seq_io_read_char(filename,rdata,dname) end subroutine seq_io_read_char + subroutine seq_io_read_moab_tags(filename, mbxid, dname, tag_list, matrix, nx) + + use shr_kind_mod, only: CX => shr_kind_CX, CXX => shr_kind_CXX + use iMOAB, only: iMOAB_GetGlobalInfo, iMOAB_GetMeshInfo, iMOAB_SetDoubleTagStorage, & + iMOAB_GetIntTagStorage + use m_MergeSorts, only: IndexSet, IndexSort + ! !INPUT/OUTPUT PARAMETERS: + implicit none + character(len=*),intent(in) :: filename ! file + integer(in), intent(in) :: mbxid ! imoab app id, on coupler + character(len=*),intent(in) :: dname ! name of data (prefix) + character(len=*),intent(in) :: tag_list ! fields, separated by colon + real(r8), dimension(:,:), pointer, optional :: matrix ! this may or may not be passed + integer, optional,intent(in):: nx + + integer(in) :: ns, ng, ix + integer nvert(3), nvise(3), nbl(3), nsurf(3), nvisBC(3) ! for moab info + + integer(in) :: rcode + integer(in) :: iam,mpicom + integer(in) :: k,n,n1,n2,ndims + type(file_desc_t) :: pioid + integer(in) :: dimid(4) + type(var_desc_t) :: varid + integer(in) :: lnx,lny,lni + type(mct_string) :: mstring ! mct char type + character(CL) :: itemc ! string converted to char + logical :: exists + type(io_desc_t) :: iodesc + + integer, allocatable :: indx(:) ! this will be ordered + integer, allocatable :: Dof(:) ! will be filled with global ids from cells + integer, allocatable :: Dof_reorder(:) ! + real(r8), allocatable :: data1(:), data_reorder(:) + + character(CL) :: lversion + character(CL) :: name1 + character(CL) :: lpre + + type(mct_list) :: temp_list + integer :: size_list, index_list + type(mct_string) :: mctOStr ! + character(CXX) ::tagname, field + + integer(in) :: dummy, ent_type, ierr + character(*),parameter :: subName = '(seq_io_read_moab_tags) ' + + + lpre = trim(dname) + + call seq_comm_setptrs(CPLID,iam=iam,mpicom=mpicom) + + call mct_list_init(temp_list ,trim(tag_list)) + size_list=mct_list_nitem (temp_list) ! role of nf, number fields + ent_type = 1 ! cell for atm, atm_pg_active + + if (size_list < 1) then + write(logunit,*) subname,' ERROR: size_list = ',size_list,trim(dname) + call shr_sys_abort(subname//'size_list error') + endif + + + !call mct_gsmap_OrderedPoints(gsmap, iam, Dof) + + if (iam==0) inquire(file=trim(filename),exist=exists) + call shr_mpi_bcast(exists,mpicom,'seq_io_read_avs exists') + if (exists) then + rcode = pio_openfile(cpl_io_subsystem, pioid, cpl_pio_iotype, trim(filename),pio_nowrite) + if(iam==0) write(logunit,*) subname,' open file ',trim(filename),' for ',trim(dname) + call pio_seterrorhandling(pioid,PIO_BCAST_ERROR) + rcode = pio_get_att(pioid,pio_global,"file_version",lversion) + call pio_seterrorhandling(pioid,PIO_INTERNAL_ERROR) + else + if(iam==0) write(logunit,*) subname,' ERROR: file invalid ',trim(filename),' ',trim(dname) + call shr_sys_abort(subname//'ERROR: file invalid '//trim(filename)//' '//trim(dname)) + endif + + ! find out the number of global cells, needed for defining the variables length + ierr = iMOAB_GetGlobalInfo( mbxid, dummy, ng) + lnx = ng + ! it is needed to overwrite that for land, ng is too small + ! ( for ne4pg2 it is 201 instead of 384) + if (present(nx)) lnx = nx + lny = 1 ! do we need 2 var, or just 1 + ierr = iMOAB_GetMeshInfo ( mbxid, nvert, nvise, nbl, nsurf, nvisBC ) + ns = nvise(1) ! local cells + allocate(data1(ns)) + allocate(data_reorder(ns)) + allocate(dof(ns)) + allocate(dof_reorder(ns)) + + ! note: size of dof is ns + tagname = 'GLOBAL_ID'//C_NULL_CHAR + ierr = iMOAB_GetIntTagStorage ( mbxid, tagname, ns , ent_type, dof(1)) + if (ierr .ne. 0) then + write(logunit,*) subname,' ERROR: cannot get dofs ' + call shr_sys_abort(subname//'cannot get dofs ') + endif + + allocate(indx(ns)) + call IndexSet(ns, indx) + call IndexSort(ns, indx, dof, descend=.false.) + ! after sort, dof( indx(i)) < dof( indx(i+1) ) + do ix=1,ns + dof_reorder(ix) = dof(indx(ix)) ! + enddo + deallocate(dof) + + do k = 1, size_list + call mct_list_get(mctOStr,index_list,temp_list) + field = mct_string_toChar(mctOStr) + name1 = trim(lpre)//'_'//trim(field) + + call pio_seterrorhandling(pioid, PIO_BCAST_ERROR) + rcode = pio_inq_varid(pioid,trim(name1),varid) + if (rcode == pio_noerr) then + if (k==1) then + rcode = pio_inq_varndims(pioid, varid, ndims) + rcode = pio_inq_vardimid(pioid, varid, dimid(1:ndims)) + rcode = pio_inq_dimlen(pioid, dimid(1), lnx) + if (ndims>=2) then + rcode = pio_inq_dimlen(pioid, dimid(2), lny) + else + lny = 1 + end if + if (lnx*lny /= ng) then + write(logunit,*) subname,' ERROR: dimensions do not match',& + lnx,lny, ng + call shr_sys_abort(subname//'ERROR: dimensions do not match') + end if + + call pio_initdecomp(cpl_io_subsystem, pio_double, (/lnx,lny/), dof_reorder, iodesc) + + deallocate(dof_reorder) + end if + + call pio_read_darray(pioid,varid,iodesc, data1, rcode) + do ix=1,ns + data_reorder(indx(ix)) = data1(ix) ! or is it data_reorder(ix) = data1(indx(ix)) ? + enddo + if (present(matrix)) then + matrix(:, index_list) = data_reorder(:) ! + else + tagname = trim(field)//C_NULL_CHAR + ierr = iMOAB_SetDoubleTagStorage (mbxid, tagname, ns , ent_type, data_reorder(1)) + if (ierr .ne. 0) then + write(logunit,*) subname,' ERROR: cannot set tag data ', trim(tagname) + call shr_sys_abort(subname//'cannot set tag data ') + endif + endif + ! n = 0 + ! do n1 = 1,ni + ! do n2 = 1,ns + ! n = n + 1 + ! avs(n1)%rAttr(k,n2) = data(n) + ! enddo + ! enddo + else + write(logunit,*)'seq_io_readav warning: field ',trim(field),' is not on restart file' + write(logunit,*)'for backwards compatibility will set it to 0' + ! do n1 = 1,ni + ! avs(n1)%rattr(k,:) = 0.0_r8 + ! enddo + data_reorder = 0. + if (present(matrix)) then + matrix(:, index_list) = data_reorder(:) ! + else + tagname = trim(field)//C_NULL_CHAR + ierr = iMOAB_SetDoubleTagStorage (mbxid, tagname, ns , ent_type, data_reorder(1)) + if (ierr .ne. 0) then + write(logunit,*) subname,' ERROR: cannot set tag data ', trim(tagname) + call shr_sys_abort(subname//'cannot set tag data ') + endif + endif + + end if + call pio_seterrorhandling(pioid,PIO_INTERNAL_ERROR) + enddo + + deallocate(data1) + deallocate(data_reorder) + deallocate(dof_reorder) + + ! !--- zero out fill value, this is somewhat arbitrary + ! do n1 = 1,ni + ! do n2 = 1,ns + ! do k = 1,nf + ! if (AVS(n1)%rAttr(k,n2) == fillvalue) then + ! AVS(n1)%rAttr(k,n2) = 0.0_r8 + ! endif + ! enddo + ! enddo + ! enddo + + call pio_freedecomp(pioid, iodesc) + call pio_closefile(pioid) + + end subroutine seq_io_read_moab_tags + !=============================================================================== !=============================================================================== end module seq_io_mod diff --git a/driver-moab/main/seq_rest_mod.F90 b/driver-moab/main/seq_rest_mod.F90 index 1aefefaac89f..b02e0be6e19b 100644 --- a/driver-moab/main/seq_rest_mod.F90 +++ b/driver-moab/main/seq_rest_mod.F90 @@ -92,6 +92,7 @@ module seq_rest_mod ! !PUBLIC MEMBER FUNCTIONS public :: seq_rest_read ! read cpl7 restart data + public :: seq_rest_mb_read ! read cpl7 restart data public :: seq_rest_write ! write cpl7 restart data public :: seq_rest_mb_write ! read cpl7_moab restart data @@ -357,6 +358,190 @@ subroutine seq_rest_read(rest_file, infodata, & end subroutine seq_rest_read +subroutine seq_rest_mb_read(rest_file, infodata) + + use seq_comm_mct, only: mbaxid, mbixid, mboxid, mblxid, mbrxid, mbofxid ! coupler side instances + + implicit none + + character(*) , intent(in) :: rest_file ! restart file path/name + type(seq_infodata_type), intent(in) :: infodata + + integer(IN) :: n,n1,n2,n3 + real(r8),allocatable :: ds(:) ! for reshaping diag data for restart file + real(r8),allocatable :: ns(:) ! for reshaping diag data for restart file + character(len=*), parameter :: subname = "(seq_rest_mb_read) " + + character(CXX) :: moab_rest_file + !------------------------------------------------------------------------------- + ! + !------------------------------------------------------------------------------- + ! actual moab name is + moab_rest_file = 'moab_'//trim(rest_file) + !---------------------------------------------------------------------------- + ! get required infodata + !---------------------------------------------------------------------------- + iamin_CPLID = seq_comm_iamin(CPLID) + + call seq_comm_getdata(GLOID,& + mpicom=mpicom_GLOID, nthreads=nthreads_GLOID) + call seq_comm_getdata(CPLID, & + mpicom=mpicom_CPLID, nthreads=nthreads_CPLID) + + call seq_infodata_getData(infodata, & + drv_threading=drv_threading, & + atm_present=atm_present, & + lnd_present=lnd_present, & + rof_present=rof_present, & + ice_present=ice_present, & + ocn_present=ocn_present, & + glc_present=glc_present, & + wav_present=wav_present, & + esp_present=esp_present, & + iac_present=iac_present, & + atm_prognostic=atm_prognostic, & + lnd_prognostic=lnd_prognostic, & + ice_prognostic=ice_prognostic, & + ocn_prognostic=ocn_prognostic, & + rofocn_prognostic=rofocn_prognostic, & + rof_prognostic=rof_prognostic, & + ocnrof_prognostic=ocnrof_prognostic, & + glc_prognostic=glc_prognostic, & + wav_prognostic=wav_prognostic, & + iac_prognostic=iac_prognostic, & + esp_prognostic=esp_prognostic, & + ocn_c2_glcshelf=ocn_c2_glcshelf, & + do_bgc_budgets=do_bgc_budgets) + + if (iamin_CPLID) then +! if (drv_threading) call seq_comm_setnthreads(nthreads_CPLID) + if (atm_present) then + call seq_io_read(moab_rest_file, mbaxid, 'fractions_ax', 'afrac:ifrac:ofrac:lfrac:lfrin') +! gsmap => component_get_gsmap_cx(atm(1)) +! xao_ax => prep_aoflux_get_xao_ax() +! call seq_io_read(rest_file, gsmap, fractions_ax, 'fractions_ax') +! call seq_io_read(rest_file, atm, 'c2x', 'a2x_ax') +! call seq_io_read(rest_file, gsmap, xao_ax, 'xao_ax') + endif +! if (lnd_present) then +! gsmap => component_get_gsmap_cx(lnd(1)) +! call seq_io_read(rest_file, gsmap, fractions_lx, 'fractions_lx') +! endif +! if (lnd_present .and. rof_prognostic) then +! gsmap => component_get_gsmap_cx(lnd(1)) +! l2racc_lx => prep_rof_get_l2racc_lx() +! l2racc_lx_cnt => prep_rof_get_l2racc_lx_cnt() +! call seq_io_read(rest_file, gsmap, l2racc_lx, 'l2racc_lx') +! call seq_io_read(rest_file, l2racc_lx_cnt ,'l2racc_lx_cnt') +! end if +! if (ocn_present .and. rofocn_prognostic) then +! gsmap => component_get_gsmap_cx(ocn(1)) +! o2racc_ox => prep_rof_get_o2racc_ox() +! o2racc_ox_cnt => prep_rof_get_o2racc_ox_cnt() +! call seq_io_read(rest_file, gsmap, o2racc_ox, 'o2racc_ox') +! call seq_io_read(rest_file, o2racc_ox_cnt ,'o2racc_ox_cnt') +! end if +! if (lnd_present .and. glc_prognostic) then +! gsmap => component_get_gsmap_cx(lnd(1)) +! l2gacc_lx => prep_glc_get_l2gacc_lx() +! l2gacc_lx_cnt => prep_glc_get_l2gacc_lx_cnt() +! call seq_io_read(rest_file, gsmap, l2gacc_lx, 'l2gacc_lx') +! call seq_io_read(rest_file, l2gacc_lx_cnt ,'l2gacc_lx_cnt') +! end if + +! if (ocn_c2_glcshelf) then +! gsmap => component_get_gsmap_cx(glc(1)) +! x2gacc_gx => prep_glc_get_x2gacc_gx() +! x2gacc_gx_cnt => prep_glc_get_x2gacc_gx_cnt() +! call seq_io_read(rest_file, gsmap, x2gacc_gx, 'x2gacc_gx') +! call seq_io_read(rest_file, x2gacc_gx_cnt ,'x2gacc_gx_cnt') +! end if + +! if (ocn_present) then +! gsmap => component_get_gsmap_cx(ocn(1)) +! x2oacc_ox => prep_ocn_get_x2oacc_ox() +! #ifdef SUMMITDEV_PGI +! dummy_pgibugfix = associated(x2oacc_ox) +! #endif +! x2oacc_ox_cnt => prep_ocn_get_x2oacc_ox_cnt() +! xao_ox => prep_aoflux_get_xao_ox() +! call seq_io_read(rest_file, gsmap, fractions_ox, 'fractions_ox') +! call seq_io_read(rest_file, ocn, 'c2x', 'o2x_ox') ! get o2x_ox +! call seq_io_read(rest_file, gsmap, x2oacc_ox, 'x2oacc_ox') +! call seq_io_read(rest_file, x2oacc_ox_cnt, 'x2oacc_ox_cnt') +! call seq_io_read(rest_file, gsmap, xao_ox, 'xao_ox') +! endif +! if (ice_present) then +! gsmap => component_get_gsmap_cx(ice(1)) +! call seq_io_read(rest_file, gsmap, fractions_ix, 'fractions_ix') +! call seq_io_read(rest_file, ice, 'c2x', 'i2x_ix') +! endif +! if (rof_present) then +! gsmap => component_get_gsmap_cx(rof(1)) +! call seq_io_read(rest_file, gsmap, fractions_rx, 'fractions_rx') +! call seq_io_read(rest_file, rof, 'c2x', 'r2x_rx') +! endif +! if (glc_present) then +! gsmap => component_get_gsmap_cx(glc(1)) +! call seq_io_read(rest_file, gsmap, fractions_gx, 'fractions_gx') +! call seq_io_read(rest_file, glc, 'c2x', 'g2x_gx') +! endif +! if (wav_present) then +! gsmap => component_get_gsmap_cx(wav(1)) +! call seq_io_read(rest_file, gsmap, fractions_wx, 'fractions_wx') +! call seq_io_read(rest_file, wav, 'c2x', 'w2x_wx') +! endif +! if (iac_present) then +! gsmap => component_get_gsmap_cx(iac(1)) +! call seq_io_read(rest_file, gsmap, fractions_zx, 'fractions_zx') +! call seq_io_read(rest_file, iac, 'c2x', 'z2x_zx') +! endif +! ! Add ESP restart read here + + n = size(budg_dataG) + allocate(ds(n),ns(n)) + call seq_io_read(rest_file, ds, 'budg_dataG') + call seq_io_read(rest_file, ns, 'budg_ns') + + n = 0 + do n1 = 1,size(budg_dataG,dim=1) + do n2 = 1,size(budg_dataG,dim=2) + do n3 = 1,size(budg_dataG,dim=3) + n = n + 1 + budg_dataG(n1,n2,n3) = ds(n) + budg_ns (n1,n2,n3) = ns(n) + enddo + enddo + enddo + ! call shr_mpi_bcast(budg_dataG,cpl_io_root) ! not necessary, io lib does bcast + deallocate(ds,ns) + + if (do_bgc_budgets) then + n = size(budg_dataGBGC) + allocate(ds(n),ns(n)) + call seq_io_read(rest_file, ds, 'budg_dataGBGC') + call seq_io_read(rest_file, ns, 'budg_nsBGC') + + n = 0 + do n1 = 1,size(budg_dataGBGC,dim=1) + do n2 = 1,size(budg_dataGBGC,dim=2) + do n3 = 1,size(budg_dataGBGC,dim=3) + n = n + 1 + budg_dataGBGC(n1,n2,n3) = ds(n) + budg_nsBGC (n1,n2,n3) = ns(n) + enddo + enddo + enddo + ! call shr_mpi_bcast(budg_dataG,cpl_io_root) ! not necessary, io lib does bcast + deallocate(ds,ns) + endif + + if (drv_threading) call seq_comm_setnthreads(nthreads_GLOID) + + endif + + end subroutine seq_rest_mb_read + !=============================================================================== subroutine seq_rest_write(EClock_d, seq_SyncClock, infodata, & From a2ea147672825dff248adc8d099d09caca10ad29 Mon Sep 17 00:00:00 2001 From: iulian07 Date: Thu, 31 Aug 2023 15:08:18 -0500 Subject: [PATCH 408/467] do not overwrite the name of the restart file use a different file for moab --- driver-moab/main/cime_comp_mod.F90 | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/driver-moab/main/cime_comp_mod.F90 b/driver-moab/main/cime_comp_mod.F90 index cb3b7a22a4a9..1ae1d3e6f9a1 100644 --- a/driver-moab/main/cime_comp_mod.F90 +++ b/driver-moab/main/cime_comp_mod.F90 @@ -5326,6 +5326,7 @@ subroutine cime_run_write_restart(drv_pause, write_restart, drv_resume_file) logical , intent(in) :: drv_pause logical , intent(in) :: write_restart character(len=*), intent(inout) :: drv_resume_file ! Driver resets state from restart file + character(len=CL) :: drv_moab_resume_file ! use a different file for moab; do not overwrite the regular name 103 format( 5A ) 104 format( A, i10.8, i8) @@ -5353,7 +5354,7 @@ subroutine cime_run_write_restart(drv_pause, write_restart, drv_resume_file) call t_startf('CPL:seq_rest_mb_write') call seq_rest_mb_write(EClock_d, seq_SyncClock, infodata, & atm, lnd, ice, ocn, rof, glc, wav, esp, iac, & - trim(cpl_inst_tag), samegrid_al, drv_resume_file) + trim(cpl_inst_tag), samegrid_al, drv_moab_resume_file) call t_stopf('CPL:seq_rest_mb_write') if (iamroot_CPLID) then From 00a105d9a4bb874f5e346804fc14d7de699d2e52 Mon Sep 17 00:00:00 2001 From: iulian07 Date: Fri, 1 Sep 2023 11:18:42 -0500 Subject: [PATCH 409/467] avoid rewriting rpointer.drv file that file should contain just the original name, not the moab file --- driver-moab/main/seq_rest_mod.F90 | 20 ++++++++++---------- 1 file changed, 10 insertions(+), 10 deletions(-) diff --git a/driver-moab/main/seq_rest_mod.F90 b/driver-moab/main/seq_rest_mod.F90 index b02e0be6e19b..38dc61592f12 100644 --- a/driver-moab/main/seq_rest_mod.F90 +++ b/driver-moab/main/seq_rest_mod.F90 @@ -1006,16 +1006,16 @@ subroutine seq_rest_mb_write(EClock_d, seq_SyncClock, infodata, & enddo endif - if (cplroot) then - iun = shr_file_getUnit() - call seq_infodata_GetData(infodata,restart_pfile=cvar) - if (loglevel > 0) write(logunit,"(3A)") subname," write rpointer file ", & - trim(cvar) - open(iun, file=cvar, form='FORMATTED') - write(iun,'(a)') rest_file - close(iun) - call shr_file_freeUnit( iun ) - endif +! if (cplroot) then +! iun = shr_file_getUnit() +! call seq_infodata_GetData(infodata,restart_pfile=cvar) +! if (loglevel > 0) write(logunit,"(3A)") subname," write rpointer file ", & +! trim(cvar) +! open(iun, file=cvar, form='FORMATTED') +! write(iun,'(a)') rest_file +! close(iun) +! call shr_file_freeUnit( iun ) +! endif call shr_mpi_bcast(rest_file,mpicom_CPLID) call seq_io_wopen(rest_file,clobber=.true., model_doi_url=model_doi_url) From 37ded93ccdfb13c3949abefa38a9ef0c66d6f5c0 Mon Sep 17 00:00:00 2001 From: iulian07 Date: Fri, 1 Sep 2023 13:44:37 -0500 Subject: [PATCH 410/467] finish off reading restart moab driver rename everything as in mct, without m_cnt it would be better for comparing files read in the same order as writing use the main moab read_tags method it does not need head or data args, compared to write method reading is one shot for any variable (simple or multidimensional) --- driver-moab/main/cime_comp_mod.F90 | 2 +- driver-moab/main/seq_rest_mod.F90 | 112 ++++++++++++++++++++++++----- 2 files changed, 95 insertions(+), 19 deletions(-) diff --git a/driver-moab/main/cime_comp_mod.F90 b/driver-moab/main/cime_comp_mod.F90 index 1ae1d3e6f9a1..6813042b4f23 100644 --- a/driver-moab/main/cime_comp_mod.F90 +++ b/driver-moab/main/cime_comp_mod.F90 @@ -2523,7 +2523,7 @@ subroutine cime_init() call t_stopf('CPL:seq_rest_read-init') call t_startf('CPL:seq_rest_read-moab') - call seq_rest_mb_read(rest_file, infodata) + call seq_rest_mb_read(rest_file, infodata, samegrid_al) call t_stopf('CPL:seq_rest_read-moab') diff --git a/driver-moab/main/seq_rest_mod.F90 b/driver-moab/main/seq_rest_mod.F90 index 38dc61592f12..fe4a9b5cdfab 100644 --- a/driver-moab/main/seq_rest_mod.F90 +++ b/driver-moab/main/seq_rest_mod.F90 @@ -358,21 +358,36 @@ subroutine seq_rest_read(rest_file, infodata, & end subroutine seq_rest_read -subroutine seq_rest_mb_read(rest_file, infodata) +subroutine seq_rest_mb_read(rest_file, infodata, samegrid_al) use seq_comm_mct, only: mbaxid, mbixid, mboxid, mblxid, mbrxid, mbofxid ! coupler side instances + use iMOAB, only: iMOAB_GetGlobalInfo implicit none character(*) , intent(in) :: rest_file ! restart file path/name type(seq_infodata_type), intent(in) :: infodata + logical , intent(in) :: samegrid_al ! needed for land nx integer(IN) :: n,n1,n2,n3 real(r8),allocatable :: ds(:) ! for reshaping diag data for restart file real(r8),allocatable :: ns(:) ! for reshaping diag data for restart file + + character(CXX) :: moab_rest_file + character(CXX) :: tagname + integer (in), pointer :: o2racc_om_cnt ! replacement, moab version for o2racc_ox_cnt + integer (in), pointer :: x2oacc_om_cnt ! replacement, moab version for x2oacc_ox_cnt + + integer (in), pointer :: l2racc_lm_cnt + integer (in) :: nx_lnd ! will be used if land and atm are on same grid + integer (in) :: ierr, dummy + + real(r8), dimension(:,:), pointer :: p_x2oacc_om + real(r8), dimension(:,:), pointer :: p_o2racc_om + real(r8), dimension(:,:), pointer :: p_l2racc_lm + character(len=*), parameter :: subname = "(seq_rest_mb_read) " - character(CXX) :: moab_rest_file !------------------------------------------------------------------------------- ! !------------------------------------------------------------------------------- @@ -417,30 +432,64 @@ subroutine seq_rest_mb_read(rest_file, infodata) ! if (drv_threading) call seq_comm_setnthreads(nthreads_CPLID) if (atm_present) then call seq_io_read(moab_rest_file, mbaxid, 'fractions_ax', 'afrac:ifrac:ofrac:lfrac:lfrin') + call seq_io_read(moab_rest_file, mbaxid, 'a2x_ax', & + trim(seq_flds_a2x_fields) ) + call seq_io_read(moab_rest_file, mbaxid, 'xao_ax', & + trim(seq_flds_xao_fields) ) ! gsmap => component_get_gsmap_cx(atm(1)) ! xao_ax => prep_aoflux_get_xao_ax() ! call seq_io_read(rest_file, gsmap, fractions_ax, 'fractions_ax') ! call seq_io_read(rest_file, atm, 'c2x', 'a2x_ax') ! call seq_io_read(rest_file, gsmap, xao_ax, 'xao_ax') endif -! if (lnd_present) then + if (lnd_present) then + if(samegrid_al) then + ! nx for land will be from global nb atmosphere + ierr = iMOAB_GetGlobalInfo(mbaxid, dummy, nx_lnd) ! max id for land will come from atm + call seq_io_read(moab_rest_file, mblxid, 'fractions_lx', & + 'afrac:lfrac:lfrin', nx=nx_lnd) + else + call seq_io_read(moab_rest_file, mblxid, 'fractions_lx', & + 'afrac:lfrac:lfrin') + endif ! gsmap => component_get_gsmap_cx(lnd(1)) ! call seq_io_read(rest_file, gsmap, fractions_lx, 'fractions_lx') -! endif -! if (lnd_present .and. rof_prognostic) then + endif + if (lnd_present .and. rof_prognostic) then + tagname = prep_rof_get_sharedFieldsLndRof() + l2racc_lm_cnt => prep_rof_get_l2racc_lm_cnt() + p_l2racc_lm => prep_rof_get_l2racc_lm() + if(samegrid_al) then + ! nx for land will be from global nb atmosphere + ierr = iMOAB_GetGlobalInfo(mbaxid, dummy, nx_lnd) ! max id for land will come from atm + call seq_io_read(rest_file, mblxid, 'l2racc_lx', & + trim(tagname), & + matrix = p_l2racc_lm, nx=nx_lnd) + else + call seq_io_read(rest_file, mblxid, 'l2racc_lx', & + trim(tagname), & + matrix = p_l2racc_lm ) + endif ! gsmap => component_get_gsmap_cx(lnd(1)) ! l2racc_lx => prep_rof_get_l2racc_lx() ! l2racc_lx_cnt => prep_rof_get_l2racc_lx_cnt() ! call seq_io_read(rest_file, gsmap, l2racc_lx, 'l2racc_lx') ! call seq_io_read(rest_file, l2racc_lx_cnt ,'l2racc_lx_cnt') -! end if -! if (ocn_present .and. rofocn_prognostic) then + end if + if (ocn_present .and. rofocn_prognostic) then + tagname = prep_rof_get_sharedFieldsOcnRof() + o2racc_om_cnt => prep_rof_get_o2racc_om_cnt() + p_o2racc_om => prep_rof_get_o2racc_om() + call seq_io_read(rest_file, mboxid, 'o2racc_om', & + trim(tagname), & + matrix = p_o2racc_om ) + call seq_io_read(rest_file, o2racc_om_cnt, 'o2racc_ox_cnt') ! gsmap => component_get_gsmap_cx(ocn(1)) ! o2racc_ox => prep_rof_get_o2racc_ox() ! o2racc_ox_cnt => prep_rof_get_o2racc_ox_cnt() ! call seq_io_read(rest_file, gsmap, o2racc_ox, 'o2racc_ox') ! call seq_io_read(rest_file, o2racc_ox_cnt ,'o2racc_ox_cnt') -! end if + end if ! if (lnd_present .and. glc_prognostic) then ! gsmap => component_get_gsmap_cx(lnd(1)) ! l2gacc_lx => prep_glc_get_l2gacc_lx() @@ -457,7 +506,24 @@ subroutine seq_rest_mb_read(rest_file, infodata) ! call seq_io_read(rest_file, x2gacc_gx_cnt ,'x2gacc_gx_cnt') ! end if -! if (ocn_present) then + if (ocn_present) then + call seq_io_read(rest_file, mboxid, 'fractions_ox', & + 'afrac:ifrac:ofrac:ifrad:ofrad') ! fraclist_o = 'afrac:ifrac:ofrac:ifrad:ofrad' + call seq_io_read(rest_file, mboxid, 'o2x_ox', & + trim(seq_flds_o2x_fields)) + tagname = trim(seq_flds_x2o_fields) + x2oacc_om_cnt => prep_ocn_get_x2oacc_om_cnt() + p_x2oacc_om => prep_ocn_get_x2oacc_om() + + call seq_io_read (rest_file, mboxid, 'x2oacc_ox', & + trim(tagname), & + matrix=p_x2oacc_om) + call seq_io_read(rest_file, x2oacc_om_cnt, 'x2oacc_ox_cnt') + ! tagname = trim(seq_flds_xao_fields)//C_NULL_CHAR + ! arrsize = nxflds * lsize ! allocate (xao_om (lsize, nxflds)) + ! ierr = iMOAB_GetDoubleTagStorage ( mbofxid, tagname, arrsize , ent_type, xao_om(1,1)) + call seq_io_read(rest_file, mbofxid, 'xao_om', & + trim(seq_flds_xao_fields) ) ! gsmap => component_get_gsmap_cx(ocn(1)) ! x2oacc_ox => prep_ocn_get_x2oacc_ox() ! #ifdef SUMMITDEV_PGI @@ -470,17 +536,25 @@ subroutine seq_rest_mb_read(rest_file, infodata) ! call seq_io_read(rest_file, gsmap, x2oacc_ox, 'x2oacc_ox') ! call seq_io_read(rest_file, x2oacc_ox_cnt, 'x2oacc_ox_cnt') ! call seq_io_read(rest_file, gsmap, xao_ox, 'xao_ox') -! endif -! if (ice_present) then + endif + if (ice_present) then + call seq_io_read(rest_file, mbixid, 'fractions_ix', & + 'afrac:ifrac:ofrac') ! fraclist_i = 'afrac:ifrac:ofrac' + call seq_io_read(rest_file, mbixid, 'i2x_ix', & + trim(seq_flds_i2x_fields) ) ! gsmap => component_get_gsmap_cx(ice(1)) ! call seq_io_read(rest_file, gsmap, fractions_ix, 'fractions_ix') ! call seq_io_read(rest_file, ice, 'c2x', 'i2x_ix') -! endif -! if (rof_present) then + endif + if (rof_present) then + call seq_io_read(rest_file, mbrxid, 'fractions_rx', & + 'lfrac:lfrin:rfrac') ! fraclist_r = 'lfrac:lfrin:rfrac' + call seq_io_read(rest_file, mbrxid, 'r2x_rx', & + trim(seq_flds_r2x_fields) ) ! gsmap => component_get_gsmap_cx(rof(1)) ! call seq_io_read(rest_file, gsmap, fractions_rx, 'fractions_rx') ! call seq_io_read(rest_file, rof, 'c2x', 'r2x_rx') -! endif + endif ! if (glc_present) then ! gsmap => component_get_gsmap_cx(glc(1)) ! call seq_io_read(rest_file, gsmap, fractions_gx, 'fractions_gx') @@ -1114,6 +1188,8 @@ subroutine seq_rest_mb_write(EClock_d, seq_SyncClock, infodata, & trim(tagname), & whead=whead, wdata=wdata, matrix = p_l2racc_lm ) endif + call seq_io_write(rest_file, l2racc_lm_cnt, 'l2racc_lx_cnt', & + whead=whead, wdata=wdata) ! gsmap => component_get_gsmap_cx(lnd(1)) ! l2racc_lx => prep_rof_get_l2racc_lx() ! l2racc_lx_cnt => prep_rof_get_l2racc_lx_cnt() @@ -1125,11 +1201,11 @@ subroutine seq_rest_mb_write(EClock_d, seq_SyncClock, infodata, & if (ocn_present .and. rofocn_prognostic) then tagname = prep_rof_get_sharedFieldsOcnRof() o2racc_om_cnt => prep_rof_get_o2racc_om_cnt() - p_o2racc_om => prep_rof_get_o2racc_om() - call seq_io_write(rest_file, mboxid, 'o2racc_om', & + p_o2racc_om => prep_rof_get_o2racc_om() ! still write o2racc_ox and o2racc_ox_cnt + call seq_io_write(rest_file, mboxid, 'o2racc_ox', & trim(tagname), & whead=whead, wdata=wdata, matrix = p_o2racc_om ) - call seq_io_write(rest_file, o2racc_om_cnt, 'o2racc_om_cnt', & + call seq_io_write(rest_file, o2racc_om_cnt, 'o2racc_ox_cnt', & whead=whead, wdata=wdata) ! o2racc_ox => prep_rof_get_o2racc_ox() ! o2racc_ox_cnt => prep_rof_get_o2racc_ox_cnt() @@ -1176,7 +1252,7 @@ subroutine seq_rest_mb_write(EClock_d, seq_SyncClock, infodata, & call seq_io_write(rest_file, mboxid, 'x2oacc_ox', & trim(tagname), & whead=whead, wdata=wdata, matrix=p_x2oacc_om) - call seq_io_write(rest_file, x2oacc_om_cnt, 'x2oacc_om_cnt', & + call seq_io_write(rest_file, x2oacc_om_cnt, 'x2oacc_ox_cnt', & whead=whead, wdata=wdata) ! tagname = trim(seq_flds_xao_fields)//C_NULL_CHAR ! arrsize = nxflds * lsize ! allocate (xao_om (lsize, nxflds)) From 5412552f58cffc948f9682365824631cbb8ad561 Mon Sep 17 00:00:00 2001 From: iulian07 Date: Fri, 8 Sep 2023 14:45:38 -0500 Subject: [PATCH 411/467] more fixes do not use 'm' instead of 'x' we need to be able to compare files use moab_rest_file for reading use index_list instead of k --- driver-moab/main/seq_io_mod.F90 | 41 ++++++++++++++++++++++--------- driver-moab/main/seq_rest_mod.F90 | 36 +++++++++++++-------------- 2 files changed, 48 insertions(+), 29 deletions(-) diff --git a/driver-moab/main/seq_io_mod.F90 b/driver-moab/main/seq_io_mod.F90 index 72f675906c0d..8f3b565eca38 100644 --- a/driver-moab/main/seq_io_mod.F90 +++ b/driver-moab/main/seq_io_mod.F90 @@ -2567,7 +2567,12 @@ subroutine seq_io_read_moab_tags(filename, mbxid, dname, tag_list, matrix, nx) lnx = ng ! it is needed to overwrite that for land, ng is too small ! ( for ne4pg2 it is 201 instead of 384) - if (present(nx)) lnx = nx + if (present(nx)) then +#ifdef MOABCOMP + if (iam==0) write(logunit,*) subname, ' nx present: ', nx +#endif + lnx = nx + endif lny = 1 ! do we need 2 var, or just 1 ierr = iMOAB_GetMeshInfo ( mbxid, nvert, nvise, nbl, nsurf, nvisBC ) ns = nvise(1) ! local cells @@ -2575,6 +2580,9 @@ subroutine seq_io_read_moab_tags(filename, mbxid, dname, tag_list, matrix, nx) allocate(data_reorder(ns)) allocate(dof(ns)) allocate(dof_reorder(ns)) +#ifdef MOABCOMP + if (iam==0) write(logunit,*) subname, ' ns, lnx ', ns, lnx, ' dname ', trim(dname) +#endif ! note: size of dof is ns tagname = 'GLOBAL_ID'//C_NULL_CHAR @@ -2584,6 +2592,9 @@ subroutine seq_io_read_moab_tags(filename, mbxid, dname, tag_list, matrix, nx) call shr_sys_abort(subname//'cannot get dofs ') endif +#ifdef MOABCOMP + if (iam==0) write(logunit,*) subname, ' dofs on iam=0: ', dof +#endif allocate(indx(ns)) call IndexSet(ns, indx) call IndexSort(ns, indx, dof, descend=.false.) @@ -2591,9 +2602,12 @@ subroutine seq_io_read_moab_tags(filename, mbxid, dname, tag_list, matrix, nx) do ix=1,ns dof_reorder(ix) = dof(indx(ix)) ! enddo +#ifdef MOABCOMP + if (iam==0) write(logunit,*) subname, ' dof_reorder on iam=0: ', dof_reorder +#endif deallocate(dof) - do k = 1, size_list + do index_list = 1, size_list call mct_list_get(mctOStr,index_list,temp_list) field = mct_string_toChar(mctOStr) name1 = trim(lpre)//'_'//trim(field) @@ -2601,7 +2615,7 @@ subroutine seq_io_read_moab_tags(filename, mbxid, dname, tag_list, matrix, nx) call pio_seterrorhandling(pioid, PIO_BCAST_ERROR) rcode = pio_inq_varid(pioid,trim(name1),varid) if (rcode == pio_noerr) then - if (k==1) then + if (index_list==1) then rcode = pio_inq_varndims(pioid, varid, ndims) rcode = pio_inq_vardimid(pioid, varid, dimid(1:ndims)) rcode = pio_inq_dimlen(pioid, dimid(1), lnx) @@ -2610,11 +2624,11 @@ subroutine seq_io_read_moab_tags(filename, mbxid, dname, tag_list, matrix, nx) else lny = 1 end if - if (lnx*lny /= ng) then - write(logunit,*) subname,' ERROR: dimensions do not match',& - lnx,lny, ng - call shr_sys_abort(subname//'ERROR: dimensions do not match') - end if +! if (lnx*lny /= ng) then +! write(logunit,*) subname,' ERROR: dimensions do not match',& +! lnx,lny, ng +! call shr_sys_abort(subname//'ERROR: dimensions do not match') +! end if call pio_initdecomp(cpl_io_subsystem, pio_double, (/lnx,lny/), dof_reorder, iodesc) @@ -2625,6 +2639,12 @@ subroutine seq_io_read_moab_tags(filename, mbxid, dname, tag_list, matrix, nx) do ix=1,ns data_reorder(indx(ix)) = data1(ix) ! or is it data_reorder(ix) = data1(indx(ix)) ? enddo +#ifdef MOABCOMP + if (iam==0 .and. index_list==1) then + write(logunit,*) subname, 'data1 ', data1 + write(logunit,*) subname, 'data_reorder ', data_reorder + endif +#endif if (present(matrix)) then matrix(:, index_list) = data_reorder(:) ! else @@ -2639,11 +2659,11 @@ subroutine seq_io_read_moab_tags(filename, mbxid, dname, tag_list, matrix, nx) ! do n1 = 1,ni ! do n2 = 1,ns ! n = n + 1 - ! avs(n1)%rAttr(k,n2) = data(n) + ! avs(:n1)%rAttr(k,n2) = data(n) ! enddo ! enddo else - write(logunit,*)'seq_io_readav warning: field ',trim(field),' is not on restart file' + write(logunit,*)'seq_io_read_moab_tags warning: field ',trim(field),' is not on restart file' write(logunit,*)'for backwards compatibility will set it to 0' ! do n1 = 1,ni ! avs(n1)%rattr(k,:) = 0.0_r8 @@ -2666,7 +2686,6 @@ subroutine seq_io_read_moab_tags(filename, mbxid, dname, tag_list, matrix, nx) deallocate(data1) deallocate(data_reorder) - deallocate(dof_reorder) ! !--- zero out fill value, this is somewhat arbitrary ! do n1 = 1,ni diff --git a/driver-moab/main/seq_rest_mod.F90 b/driver-moab/main/seq_rest_mod.F90 index fe4a9b5cdfab..680795e842b5 100644 --- a/driver-moab/main/seq_rest_mod.F90 +++ b/driver-moab/main/seq_rest_mod.F90 @@ -462,11 +462,11 @@ subroutine seq_rest_mb_read(rest_file, infodata, samegrid_al) if(samegrid_al) then ! nx for land will be from global nb atmosphere ierr = iMOAB_GetGlobalInfo(mbaxid, dummy, nx_lnd) ! max id for land will come from atm - call seq_io_read(rest_file, mblxid, 'l2racc_lx', & + call seq_io_read(moab_rest_file, mblxid, 'l2racc_lx', & trim(tagname), & matrix = p_l2racc_lm, nx=nx_lnd) else - call seq_io_read(rest_file, mblxid, 'l2racc_lx', & + call seq_io_read(moab_rest_file, mblxid, 'l2racc_lx', & trim(tagname), & matrix = p_l2racc_lm ) endif @@ -480,10 +480,10 @@ subroutine seq_rest_mb_read(rest_file, infodata, samegrid_al) tagname = prep_rof_get_sharedFieldsOcnRof() o2racc_om_cnt => prep_rof_get_o2racc_om_cnt() p_o2racc_om => prep_rof_get_o2racc_om() - call seq_io_read(rest_file, mboxid, 'o2racc_om', & + call seq_io_read(moab_rest_file, mboxid, 'o2racc_ox', & trim(tagname), & matrix = p_o2racc_om ) - call seq_io_read(rest_file, o2racc_om_cnt, 'o2racc_ox_cnt') + call seq_io_read(moab_rest_file, o2racc_om_cnt, 'o2racc_ox_cnt') ! gsmap => component_get_gsmap_cx(ocn(1)) ! o2racc_ox => prep_rof_get_o2racc_ox() ! o2racc_ox_cnt => prep_rof_get_o2racc_ox_cnt() @@ -507,22 +507,22 @@ subroutine seq_rest_mb_read(rest_file, infodata, samegrid_al) ! end if if (ocn_present) then - call seq_io_read(rest_file, mboxid, 'fractions_ox', & + call seq_io_read(moab_rest_file, mboxid, 'fractions_ox', & 'afrac:ifrac:ofrac:ifrad:ofrad') ! fraclist_o = 'afrac:ifrac:ofrac:ifrad:ofrad' - call seq_io_read(rest_file, mboxid, 'o2x_ox', & + call seq_io_read(moab_rest_file, mboxid, 'o2x_ox', & trim(seq_flds_o2x_fields)) tagname = trim(seq_flds_x2o_fields) x2oacc_om_cnt => prep_ocn_get_x2oacc_om_cnt() p_x2oacc_om => prep_ocn_get_x2oacc_om() - call seq_io_read (rest_file, mboxid, 'x2oacc_ox', & + call seq_io_read (moab_rest_file, mboxid, 'x2oacc_ox', & trim(tagname), & matrix=p_x2oacc_om) - call seq_io_read(rest_file, x2oacc_om_cnt, 'x2oacc_ox_cnt') + call seq_io_read(moab_rest_file, x2oacc_om_cnt, 'x2oacc_ox_cnt') ! tagname = trim(seq_flds_xao_fields)//C_NULL_CHAR ! arrsize = nxflds * lsize ! allocate (xao_om (lsize, nxflds)) ! ierr = iMOAB_GetDoubleTagStorage ( mbofxid, tagname, arrsize , ent_type, xao_om(1,1)) - call seq_io_read(rest_file, mbofxid, 'xao_om', & + call seq_io_read(moab_rest_file, mbofxid, 'xao_om', & trim(seq_flds_xao_fields) ) ! gsmap => component_get_gsmap_cx(ocn(1)) ! x2oacc_ox => prep_ocn_get_x2oacc_ox() @@ -538,18 +538,18 @@ subroutine seq_rest_mb_read(rest_file, infodata, samegrid_al) ! call seq_io_read(rest_file, gsmap, xao_ox, 'xao_ox') endif if (ice_present) then - call seq_io_read(rest_file, mbixid, 'fractions_ix', & + call seq_io_read(moab_rest_file, mbixid, 'fractions_ix', & 'afrac:ifrac:ofrac') ! fraclist_i = 'afrac:ifrac:ofrac' - call seq_io_read(rest_file, mbixid, 'i2x_ix', & + call seq_io_read(moab_rest_file, mbixid, 'i2x_ix', & trim(seq_flds_i2x_fields) ) ! gsmap => component_get_gsmap_cx(ice(1)) ! call seq_io_read(rest_file, gsmap, fractions_ix, 'fractions_ix') ! call seq_io_read(rest_file, ice, 'c2x', 'i2x_ix') endif if (rof_present) then - call seq_io_read(rest_file, mbrxid, 'fractions_rx', & + call seq_io_read(moab_rest_file, mbrxid, 'fractions_rx', & 'lfrac:lfrin:rfrac') ! fraclist_r = 'lfrac:lfrin:rfrac' - call seq_io_read(rest_file, mbrxid, 'r2x_rx', & + call seq_io_read(moab_rest_file, mbrxid, 'r2x_rx', & trim(seq_flds_r2x_fields) ) ! gsmap => component_get_gsmap_cx(rof(1)) ! call seq_io_read(rest_file, gsmap, fractions_rx, 'fractions_rx') @@ -574,8 +574,8 @@ subroutine seq_rest_mb_read(rest_file, infodata, samegrid_al) n = size(budg_dataG) allocate(ds(n),ns(n)) - call seq_io_read(rest_file, ds, 'budg_dataG') - call seq_io_read(rest_file, ns, 'budg_ns') + call seq_io_read(moab_rest_file, ds, 'budg_dataG') + call seq_io_read(moab_rest_file, ns, 'budg_ns') n = 0 do n1 = 1,size(budg_dataG,dim=1) @@ -593,8 +593,8 @@ subroutine seq_rest_mb_read(rest_file, infodata, samegrid_al) if (do_bgc_budgets) then n = size(budg_dataGBGC) allocate(ds(n),ns(n)) - call seq_io_read(rest_file, ds, 'budg_dataGBGC') - call seq_io_read(rest_file, ns, 'budg_nsBGC') + call seq_io_read(moab_rest_file, ds, 'budg_dataGBGC') + call seq_io_read(moab_rest_file, ns, 'budg_nsBGC') n = 0 do n1 = 1,size(budg_dataGBGC,dim=1) @@ -1257,7 +1257,7 @@ subroutine seq_rest_mb_write(EClock_d, seq_SyncClock, infodata, & ! tagname = trim(seq_flds_xao_fields)//C_NULL_CHAR ! arrsize = nxflds * lsize ! allocate (xao_om (lsize, nxflds)) ! ierr = iMOAB_GetDoubleTagStorage ( mbofxid, tagname, arrsize , ent_type, xao_om(1,1)) - call seq_io_write(rest_file, mbofxid, 'xao_om', & + call seq_io_write(rest_file, mbofxid, 'xao_ox', & trim(seq_flds_xao_fields), & whead=whead, wdata=wdata) ! whead=whead, wdata=wdata) From c6e2e0b394d2234e4ea3c200bf3ca1aa05f41aa9 Mon Sep 17 00:00:00 2001 From: iulian07 Date: Fri, 8 Sep 2023 15:44:56 -0500 Subject: [PATCH 412/467] replace om with ox in reading too --- driver-moab/main/seq_io_mod.F90 | 2 +- driver-moab/main/seq_rest_mod.F90 | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/driver-moab/main/seq_io_mod.F90 b/driver-moab/main/seq_io_mod.F90 index 8f3b565eca38..c551e118578a 100644 --- a/driver-moab/main/seq_io_mod.F90 +++ b/driver-moab/main/seq_io_mod.F90 @@ -2663,7 +2663,7 @@ subroutine seq_io_read_moab_tags(filename, mbxid, dname, tag_list, matrix, nx) ! enddo ! enddo else - write(logunit,*)'seq_io_read_moab_tags warning: field ',trim(field),' is not on restart file' + write(logunit,*)subname, ' warning: field ',trim(field), ' name1:', trim(name1), ' is not on restart file' write(logunit,*)'for backwards compatibility will set it to 0' ! do n1 = 1,ni ! avs(n1)%rattr(k,:) = 0.0_r8 diff --git a/driver-moab/main/seq_rest_mod.F90 b/driver-moab/main/seq_rest_mod.F90 index 680795e842b5..2961d7747f5c 100644 --- a/driver-moab/main/seq_rest_mod.F90 +++ b/driver-moab/main/seq_rest_mod.F90 @@ -522,7 +522,7 @@ subroutine seq_rest_mb_read(rest_file, infodata, samegrid_al) ! tagname = trim(seq_flds_xao_fields)//C_NULL_CHAR ! arrsize = nxflds * lsize ! allocate (xao_om (lsize, nxflds)) ! ierr = iMOAB_GetDoubleTagStorage ( mbofxid, tagname, arrsize , ent_type, xao_om(1,1)) - call seq_io_read(moab_rest_file, mbofxid, 'xao_om', & + call seq_io_read(moab_rest_file, mbofxid, 'xao_ox', & trim(seq_flds_xao_fields) ) ! gsmap => component_get_gsmap_cx(ocn(1)) ! x2oacc_ox => prep_ocn_get_x2oacc_ox() From 7c3c8a9b191111ced883f7f958b42fd9479f493a Mon Sep 17 00:00:00 2001 From: iulian Date: Thu, 21 Sep 2023 15:16:32 -0700 Subject: [PATCH 413/467] add pm-cpu on gnu compiler --- .../machines/cmake_macros/gnu_pm-cpu.cmake | 1 + cime_config/machines/config_machines.xml | 40 +++++++++++++------ 2 files changed, 29 insertions(+), 12 deletions(-) diff --git a/cime_config/machines/cmake_macros/gnu_pm-cpu.cmake b/cime_config/machines/cmake_macros/gnu_pm-cpu.cmake index 89ba5a77c315..a19bc1e8e6db 100644 --- a/cime_config/machines/cmake_macros/gnu_pm-cpu.cmake +++ b/cime_config/machines/cmake_macros/gnu_pm-cpu.cmake @@ -10,6 +10,7 @@ set(NETCDF_C_PATH "$ENV{CRAY_NETCDF_HDF5PARALLEL_PREFIX}") set(NETCDF_FORTRAN_PATH "$ENV{CRAY_NETCDF_HDF5PARALLEL_PREFIX}") set(HDF5_PATH "$ENV{CRAY_HDF5_PARALLEL_PREFIX}") set(PNETCDF_PATH "$ENV{CRAY_PARALLEL_NETCDF_PREFIX}") +set(MOAB_PATH "$ENV{MOAB_PATH}") if (NOT DEBUG) string(APPEND CFLAGS " -O2 -g") endif() diff --git a/cime_config/machines/config_machines.xml b/cime_config/machines/config_machines.xml index 6313b46cf579..d4abddb3137c 100644 --- a/cime_config/machines/config_machines.xml +++ b/cime_config/machines/config_machines.xml @@ -159,11 +159,11 @@ - + Perlmutter CPU-only nodes at NERSC. Phase2 only: Each node has 2 AMD EPYC 7713 64-Core (Milan) 512GB $ENV{NERSC_HOST}:perlmutter Linux - gnu,nvidia,amdclang + intel,gnu,nvidia,amdclang mpich e3sm /global/cfs/cdirs/e3sm @@ -182,7 +182,7 @@ nersc_slurm e3sm 256 - 64 + 128 TRUE srun @@ -203,13 +203,17 @@ /usr/share/lmod/lmod/libexec/lmod python module module - cray-hdf5-parallel cray-netcdf-hdf5parallel cray-parallel-netcdf PrgEnv-gnu + PrgEnv-intel PrgEnv-nvidia + PrgEnv-cray + PrgEnv-aocc + intel + intel-oneapi cudatoolkit craype-accel-nvidia80 craype-accel-host @@ -221,33 +225,41 @@ PrgEnv-gnu/8.3.3 gcc/11.2.0 + cray-libsci/23.02.1.1 + + + + PrgEnv-intel/8.3.3 + intel/2023.1.0 PrgEnv-nvidia - nvidia/21.11 + nvidia/22.7 + cray-libsci/23.02.1.1 PrgEnv-aocc aocc/3.2.0 + cray-libsci/23.02.1.1 craype-accel-host - cray-libsci - craype - cray-mpich/8.1.15 - cray-hdf5-parallel/1.12.1.1 - cray-netcdf-hdf5parallel/4.8.1.1 - cray-parallel-netcdf/1.12.2.1 - cmake/3.22.0 + craype/2.7.20 + cray-mpich/8.1.25 + cray-hdf5-parallel/1.12.2.3 + cray-netcdf-hdf5parallel/4.9.0.3 + cray-parallel-netcdf/1.12.3.3 + cmake/3.24.3 $CIME_OUTPUT_ROOT/$CASE/run $CIME_OUTPUT_ROOT/$CASE/bld 0.1 + 0.20 1 @@ -258,6 +270,10 @@ FALSE /global/cfs/cdirs/e3sm/perl/lib/perl5-only-switch software + MPI_Bcast + + + /global/homes/i/iulian/software/pm-cpu/moab-master -1 From 8b08bc5770ef9bc805f79d100e1612a70fb4f71c Mon Sep 17 00:00:00 2001 From: iulian Date: Fri, 22 Sep 2023 13:25:03 -0700 Subject: [PATCH 414/467] initialize moab atm meshes always also, do not create vertices if nelemd == 0 --- components/eam/src/dynamics/se/dyn_comp.F90 | 2 +- components/eam/src/dynamics/se/semoab_mod.F90 | 659 ++++++++++-------- 2 files changed, 363 insertions(+), 298 deletions(-) diff --git a/components/eam/src/dynamics/se/dyn_comp.F90 b/components/eam/src/dynamics/se/dyn_comp.F90 index 7ff2bba0e219..13911343d961 100644 --- a/components/eam/src/dynamics/se/dyn_comp.F90 +++ b/components/eam/src/dynamics/se/dyn_comp.F90 @@ -168,7 +168,6 @@ subroutine dyn_init1(fh, NLFileName, dyn_in, dyn_out) nthreads = omp_get_max_threads() #endif - if(par%dynproc) then #ifdef HAVE_MOAB appname="HM_COARSE"//C_NULL_CHAR @@ -213,6 +212,7 @@ subroutine dyn_init1(fh, NLFileName, dyn_in, dyn_out) #endif + if(par%dynproc) then call t_startf('prim_init1') call prim_init1(elem,par,dom_mt,TimeLevel) call t_stopf('prim_init1') diff --git a/components/eam/src/dynamics/se/semoab_mod.F90 b/components/eam/src/dynamics/se/semoab_mod.F90 index e95ae9ea67be..984b9793df40 100644 --- a/components/eam/src/dynamics/se/semoab_mod.F90 +++ b/components/eam/src/dynamics/se/semoab_mod.F90 @@ -135,201 +135,226 @@ subroutine create_moab_meshes(par, elem) ! character*100 outfile, wopts, localmeshfile, lnum, tagname ! integer tagtype, numco, tag_sto_len, ent_type, tagindex - do j=1,np-1 - do i =1, np-1 - ix = (j-1)*(np-1)+i-1 - local_map(i,j) = ix*4 + 1 - enddo - enddo - do j=1, np-1 - i = j - local_map(np, j) = ((np-1)*j-1)*4 + 2 - local_map(i, np) = ( (np-1)*(np-2)+i-1)*4 + 4 - enddo - local_map(np, np) = ((np-1)*(np-1)-1)*4 + 3 - - nelemd2 = (nelemd)*(np-1)*(np-1) - moab_dim_cquads = (nelemd)*4*(np-1)*(np-1) - - if(par%masterproc) then - write (iulog, *) " MOAB: semoab_mod module: create_moab_mesh_fine; on processor " , par%rank ," elements: " , 1, nelemd - endif - - allocate(gdofv(moab_dim_cquads)) - allocate(elemids(nelemd2)) - - k=0 ! will be the index for element global dofs - do ie=1,nelemd - do j=1,np-1 - do i=1,np-1 - ix = (ie-1)*(np-1)*(np-1)+(j-1)*(np-1)+i-1 - gdofv(ix*4+1) = elem(ie)%gdofP(i,j) - gdofv(ix*4+2) = elem(ie)%gdofP(i+1,j) - gdofv(ix*4+3) = elem(ie)%gdofP(i+1,j+1) - gdofv(ix*4+4) = elem(ie)%gdofP(i,j+1) - elemids(ix+1) = (elem(ie)%GlobalId-1)*(np-1)*(np-1)+(j-1)*(np-1)+i - enddo - enddo - enddo + do j=1,np-1 + do i =1, np-1 + ix = (j-1)*(np-1)+i-1 + local_map(i,j) = ix*4 + 1 + enddo + enddo + do j=1, np-1 + i = j + local_map(np, j) = ((np-1)*j-1)*4 + 2 + local_map(i, np) = ( (np-1)*(np-2)+i-1)*4 + 4 + enddo + local_map(np, np) = ((np-1)*(np-1)-1)*4 + 3 + + nelemd2 = (nelemd)*(np-1)*(np-1) + moab_dim_cquads = (nelemd)*4*(np-1)*(np-1) + + if(par%masterproc) then + write (iulog, *) " MOAB: semoab_mod module: create_moab_mesh_fine; on processor " , par%rank ," nelemd: " , nelemd + endif + + if ( nelemd > 0 ) then + allocate(gdofv(moab_dim_cquads)) + allocate(elemids(nelemd2)) + endif + + k=0 ! will be the index for element global dofs + do ie=1,nelemd + do j=1,np-1 + do i=1,np-1 + ix = (ie-1)*(np-1)*(np-1)+(j-1)*(np-1)+i-1 + gdofv(ix*4+1) = elem(ie)%gdofP(i,j) + gdofv(ix*4+2) = elem(ie)%gdofP(i+1,j) + gdofv(ix*4+3) = elem(ie)%gdofP(i+1,j+1) + gdofv(ix*4+4) = elem(ie)%gdofP(i,j+1) + elemids(ix+1) = (elem(ie)%GlobalId-1)*(np-1)*(np-1)+(j-1)*(np-1)+i + enddo + enddo + enddo ! order according to global dofs - allocate(moabvh(moab_dim_cquads)) - allocate(indx(moab_dim_cquads)) - - allocate(moabconn(moab_dim_cquads)) - call IndexSet(moab_dim_cquads, indx) - call IndexSort(moab_dim_cquads, indx, gdofv, descend=.false.) -! after sort, gdofv( indx(i)) < gdofv( indx(i+1) ) + if ( nelemd > 0 ) then + allocate(moabvh(moab_dim_cquads)) + allocate(indx(moab_dim_cquads)) + + allocate(moabconn(moab_dim_cquads)) + call IndexSet(moab_dim_cquads, indx) + call IndexSort(moab_dim_cquads, indx, gdofv, descend=.false.) +! after sort, gdofv( indx(i)) < gdofv( indx(i+1) ) + endif + idx=0 + currentval = 0 + if ( nelemd > 0 ) then + currentval = gdofv( indx(1)) + idx = 1 + endif + + do ix=1,moab_dim_cquads + if (gdofv(indx(ix)) .ne. currentval ) then + idx=idx+1 + currentval = gdofv(indx(ix)) + endif + moabvh(ix) = idx ! the vertex in connectivity array will be at this local index + ! this will be the moab connectivity + moabconn(indx(ix)) = idx + enddo + + nverts = idx + if(par%masterproc) then + write (iulog, *) " MOAB: there are ", nverts, " local vertices on master task ", currentval, " is the max local gdof" + endif + if ( nelemd > 0 ) then + allocate(moab_vert_coords(3*nverts) ) + allocate(vdone(nverts)) + vdone = 0; + endif + if ( nelemd > 0 ) currentval = gdofv( indx(1)) ! start over to identify coordinates of the vertices + + do ix=1,moab_dim_cquads + idx = indx(ix) ! index in initial array, vertices in all fine quads + k = (idx-1)/(4*(np-1)*(np-1)) ! index of coarse quad, locally, starts at 0 + ie = 1 + k ! this is the element number; starts at nets=1 + je = ( idx -1 -k*(np-1)*(np-1)*4 ) / 4 + 1 ! local fine quad in coarse, 1 to (np-1) ^ 2 + irow = (je-1)/(np-1)+1 + icol = je - (np-1)*(irow-1) + linx = idx - k*(np-1)*(np-1)*4 -(je-1)*4 ! this should be 1, 2, 3, 4 + if( linx == 1) then + j = irow + i = icol + else if (linx == 2) then + j = irow + i = icol + 1 + else if (linx == 3) then + j = irow + 1 + i = icol + 1 + else ! linx == 4 + j = irow + 1 + i = icol + endif + + iv = moabvh(ix) + if (vdone(iv) .eq. 0) then + cart = spherical_to_cart (elem(ie)%spherep(i,j) ) + moab_vert_coords ( 3*(iv-1)+1 ) = cart%x + moab_vert_coords ( 3*(iv-1)+2 ) = cart%y + moab_vert_coords ( 3*(iv-1)+3 ) = cart%z + vdone(iv) = gdofv(indx(ix)) ! this will be now our tag used for resolving shared entities ! convert to int, from long int + endif - idx=1 - currentval = gdofv( indx(1)) - do ix=1,moab_dim_cquads - if (gdofv(indx(ix)) .ne. currentval ) then - idx=idx+1 - currentval = gdofv(indx(ix)) - endif - moabvh(ix) = idx ! the vertex in connectivity array will be at this local index - ! this will be the moab connectivity - moabconn(indx(ix)) = idx enddo - nverts = idx - if(par%masterproc) then - write (iulog, *) " MOAB: there are ", nverts, " local vertices on master task ", currentval, " is the max local gdof" + dimcoord = nverts*3 + dimen = 3 + if ( nelemd > 0 ) then + ierr = iMOAB_CreateVertices(MHFID, dimcoord, dimen, moab_vert_coords) + if (ierr > 0 ) & + call endrun('Error: fail to create MOAB vertices ') + endif + !!num_el = nelemd2 + mbtype = 3 ! quadrilateral + nve = 4; + block_ID = 200 ! this will be for coarse mesh + + if ( nelemd > 0 ) then + ierr = iMOAB_CreateElements( MHFID, nelemd2, mbtype, nve, moabconn, block_ID ); + if (ierr > 0 ) & + call endrun('Error: fail to create MOAB elements') endif - allocate(moab_vert_coords(3*nverts) ) - allocate(vdone(nverts)) - vdone = 0; - currentval = gdofv( indx(1)) ! start over to identify coordinates of the vertices - - do ix=1,moab_dim_cquads - idx = indx(ix) ! index in initial array, vertices in all fine quads - k = (idx-1)/(4*(np-1)*(np-1)) ! index of coarse quad, locally, starts at 0 - ie = 1 + k ! this is the element number; starts at nets=1 - je = ( idx -1 -k*(np-1)*(np-1)*4 ) / 4 + 1 ! local fine quad in coarse, 1 to (np-1) ^ 2 - irow = (je-1)/(np-1)+1 - icol = je - (np-1)*(irow-1) - linx = idx - k*(np-1)*(np-1)*4 -(je-1)*4 ! this should be 1, 2, 3, 4 - if( linx == 1) then - j = irow - i = icol - else if (linx == 2) then - j = irow - i = icol + 1 - else if (linx == 3) then - j = irow + 1 - i = icol + 1 - else ! linx == 4 - j = irow + 1 - i = icol - endif - - iv = moabvh(ix) - if (vdone(iv) .eq. 0) then - cart = spherical_to_cart (elem(ie)%spherep(i,j) ) - moab_vert_coords ( 3*(iv-1)+1 ) = cart%x - moab_vert_coords ( 3*(iv-1)+2 ) = cart%y - moab_vert_coords ( 3*(iv-1)+3 ) = cart%z - vdone(iv) = gdofv(indx(ix)) ! this will be now our tag used for resolving shared entities ! convert to int, from long int - endif - - enddo - - dimcoord = nverts*3 - dimen = 3 - ierr = iMOAB_CreateVertices(MHFID, dimcoord, dimen, moab_vert_coords) - if (ierr > 0 ) & - call endrun('Error: fail to create MOAB vertices ') - - !!num_el = nelemd2 - mbtype = 3 ! quadrilateral - nve = 4; - block_ID = 200 ! this will be for coarse mesh - - ierr = iMOAB_CreateElements( MHFID, nelemd2, mbtype, nve, moabconn, block_ID ); - if (ierr > 0 ) & - call endrun('Error: fail to create MOAB elements') ! nverts: num vertices; vdone will store now the markers used in global resolve ! for this particular problem, markers are the global dofs at corner nodes ! set the global id for vertices ! first, retrieve the tag - tagname='GDOF'//C_NULL_CHAR - tagtype = 0 ! dense, integer - numco = 1 - ierr = iMOAB_DefineTagStorage(MHFID, tagname, tagtype, numco, tagindex ) - if (ierr > 0 ) & - call endrun('Error: fail to retrieve global id tag') - ! now set the values - ent_type = 0 ! vertex type - ierr = iMOAB_SetIntTagStorage ( MHFID, tagname, nverts , ent_type, vdone) - if (ierr > 0 ) & - call endrun('Error: fail to set marker id tag for vertices') - - ierr = iMOAB_ResolveSharedEntities( MHFID, nverts, vdone ); - if (ierr > 0 ) & - call endrun('Error: fail to resolve shared entities') - - vdone = -1 ! reuse vdone for the new tag, GLOBAL_ID (actual tag that we want to store global dof ) + tagname='GDOF'//C_NULL_CHAR + tagtype = 0 ! dense, integer + numco = 1 + ierr = iMOAB_DefineTagStorage(MHFID, tagname, tagtype, numco, tagindex ) + if (ierr > 0 ) & + call endrun('Error: fail to retrieve global id tag') + ! now set the values + ent_type = 0 ! vertex type + if ( nverts > 0 ) then + ierr = iMOAB_SetIntTagStorage ( MHFID, tagname, nverts , ent_type, vdone) + if (ierr > 0 ) & + call endrun('Error: fail to set marker id tag for vertices') + endif + + ierr = iMOAB_ResolveSharedEntities( MHFID, nverts, vdone ); + if (ierr > 0 ) & + call endrun('Error: fail to resolve shared entities') + + if ( nelemd > 0) then + vdone = -1 ! reuse vdone for the new tag, GLOBAL_ID (actual tag that we want to store global dof ) + endif ! use element offset for actual global dofs - ! tagtype = 0 ! dense, integer - ! numco = 1 - newtagg='GLOBAL_ID'//C_NULL_CHAR - ierr = iMOAB_DefineTagStorage(MHFID, newtagg, tagtype, numco, tagindex ) - if (ierr > 0 ) & - call endrun('Error: fail to create new GDOF tag') - do ie=1,nelemd - do ii=1,elem(ie)%idxp%NumUniquePts - i=elem(ie)%idxp%ia(ii) - j=elem(ie)%idxp%ja(ii) - igcol = elem(ie)%idxp%UniquePtoffset+ii-1 - ix = local_map(i,j) - idx = moabconn((ie-1)*(np-1)*(np-1)*4 + ix) ! should - vdone ( idx ) = igcol - end do - end do - ! now set the values - ent_type = 0 ! vertex type - ierr = iMOAB_SetIntTagStorage ( MHFID, newtagg, nverts , ent_type, vdone) - if (ierr > 0 ) & - call endrun('Error: fail to set global dof tag for vertices') - - ierr = iMOAB_ReduceTagsMax ( MHFID, tagindex, ent_type) - if (ierr > 0 ) & - call endrun('Error: fail to reduce max tag') - - ! set global id tag for elements - ent_type = 1 ! now set the global id tag on elements - ierr = iMOAB_SetIntTagStorage ( MHFID, newtagg, nelemd2 , ent_type, elemids) - if (ierr > 0 ) & - call endrun('Error: fail to set global id tag for elements') + ! tagtype = 0 ! dense, integer + ! numco = 1 + newtagg='GLOBAL_ID'//C_NULL_CHAR + ierr = iMOAB_DefineTagStorage(MHFID, newtagg, tagtype, numco, tagindex ) + if (ierr > 0 ) & + call endrun('Error: fail to create new GDOF tag') + do ie=1,nelemd + do ii=1,elem(ie)%idxp%NumUniquePts + i=elem(ie)%idxp%ia(ii) + j=elem(ie)%idxp%ja(ii) + igcol = elem(ie)%idxp%UniquePtoffset+ii-1 + ix = local_map(i,j) + idx = moabconn((ie-1)*(np-1)*(np-1)*4 + ix) ! should + vdone ( idx ) = igcol + end do + end do + ! now set the values + ent_type = 0 ! vertex type + if ( nverts > 0 ) then + ierr = iMOAB_SetIntTagStorage ( MHFID, newtagg, nverts , ent_type, vdone) + if (ierr > 0 ) & + call endrun('Error: fail to set global dof tag for vertices') + endif + + ierr = iMOAB_ReduceTagsMax ( MHFID, tagindex, ent_type) + if (ierr > 0 ) & + call endrun('Error: fail to reduce max tag') + + ! set global id tag for elements + ent_type = 1 ! now set the global id tag on elements + if ( nelemd2 > 0 ) then + ierr = iMOAB_SetIntTagStorage ( MHFID, newtagg, nelemd2 , ent_type, elemids) + if (ierr > 0 ) & + call endrun('Error: fail to set global id tag for elements') + endif ! now, after reduction, we can get the actual global ids for each vertex in the fine mesh ! before, some vertices that were owned in MOAB but not owned in CAM did not have the right global ID tag ! so vdone will be now correct on every task (no -1 anymore ) - ent_type = 0 ! vertex type - allocate(vgids(nverts)) - ierr = iMOAB_GetIntTagStorage ( MHFID, newtagg, nverts , ent_type, vgids) - if (ierr > 0 ) & - call endrun('Error: fail to retrieve GLOBAL ID on each task') - ierr = iMOAB_UpdateMeshInfo(MHFID) - if (ierr > 0 ) & - call endrun('Error: fail to update mesh info') + ent_type = 0 ! vertex type + if ( nverts > 0 ) then + allocate(vgids(nverts)) + ierr = iMOAB_GetIntTagStorage ( MHFID, newtagg, nverts , ent_type, vgids) + if (ierr > 0 ) & + call endrun('Error: fail to retrieve GLOBAL ID on each task') + endif + ierr = iMOAB_UpdateMeshInfo(MHFID) + if (ierr > 0 ) & + call endrun('Error: fail to update mesh info') #ifdef MOABDEBUG ! write out the mesh file to disk, in parallel - outfile = 'wholeFineATM.h5m'//C_NULL_CHAR - wopts = 'PARALLEL=WRITE_PART'//C_NULL_CHAR - ierr = iMOAB_WriteMesh(MHFID, outfile, wopts) - if (ierr > 0 ) & - call endrun('Error: fail to write the mesh file') + outfile = 'wholeFineATM.h5m'//C_NULL_CHAR + wopts = 'PARALLEL=WRITE_PART'//C_NULL_CHAR + ierr = iMOAB_WriteMesh(MHFID, outfile, wopts) + if (ierr > 0 ) & + call endrun('Error: fail to write the mesh file') #endif ! now create the coarse mesh, but the global dofs will come from fine mesh, after solving - ! nelemd2 = nelemd - moab_dim_cquads = (nelemd)*4 + ! nelemd2 = nelemd + moab_dim_cquads = (nelemd)*4 - allocate(gdofel(nelemd*np*np)) + if ( nelemd > 0 ) then + allocate(gdofel(nelemd*np*np)) + endif k=0 ! will be the index for element global dofs do ie=1,nelemd ix = ie-1 @@ -344,15 +369,20 @@ subroutine create_moab_meshes(par, elem) ! order according to global dofs ! allocate(indx(moab_dim_cquads)) - call IndexSet(moab_dim_cquads, indx) - call IndexSort(moab_dim_cquads, indx, gdofv, descend=.false.) + if ( nelemd > 0 ) then + call IndexSet(moab_dim_cquads, indx) + call IndexSort(moab_dim_cquads, indx, gdofv, descend=.false.) ! after sort, gdofv( indx(i)) < gdofv( indx(i+1) ) - allocate(moabvh_c(moab_dim_cquads)) + allocate(moabvh_c(moab_dim_cquads)) - allocate(moabconn_c(moab_dim_cquads)) - idx=1 - currentval = gdofv( indx(1)) + allocate(moabconn_c(moab_dim_cquads)) + endif + idx = 0 + if ( nelemd > 0 ) then + idx=1 + currentval = gdofv( indx(1)) + endif do ix=1,moab_dim_cquads if (gdofv(indx(ix)) .ne. currentval ) then idx=idx+1 @@ -367,9 +397,11 @@ subroutine create_moab_meshes(par, elem) write (iulog, *) " MOAB: there are ", nverts_c, " local vertices on master task, coarse mesh" endif ! allocate(moab_vert_coords(3*idx) ) - allocate(vdone_c(nverts_c)) - vdone_c = 0; - currentval = gdofv( indx(1)) ! start over to identify coordinates of the vertices + if ( nelemd > 0 ) then + allocate(vdone_c(nverts_c)) + vdone_c = 0; + currentval = gdofv( indx(1)) ! start over to identify coordinates of the vertices + endif do ix=1,moab_dim_cquads i = indx(ix) ! index in initial array @@ -385,99 +417,109 @@ subroutine create_moab_meshes(par, elem) enddo - dimcoord = nverts_c*3 - dimen = 3 - ierr = iMOAB_CreateVertices(MHID, dimcoord, dimen, moab_vert_coords) - if (ierr > 0 ) & - call endrun('Error: fail to create MOAB vertices ') - - ! num_el = nelemd - mbtype = 3 ! quadrilateral - nve = 4; - block_ID = 100 ! this will be for coarse mesh - - ierr = iMOAB_CreateElements( MHID, nelemd, mbtype, nve, moabconn_c, block_ID ); - if (ierr > 0 ) & - call endrun('Error: fail to create MOAB elements') + dimcoord = nverts_c*3 + dimen = 3 + if ( nverts_c > 0 ) then + ierr = iMOAB_CreateVertices(MHID, dimcoord, dimen, moab_vert_coords) + if (ierr > 0 ) & + call endrun('Error: fail to create MOAB vertices ') + endif + ! num_el = nelemd + mbtype = 3 ! quadrilateral + nve = 4; + block_ID = 100 ! this will be for coarse mesh + + if ( nelemd > 0 ) then + ierr = iMOAB_CreateElements( MHID, nelemd, mbtype, nve, moabconn_c, block_ID ); + if (ierr > 0 ) & + call endrun('Error: fail to create MOAB elements') + endif ! idx: num vertices; vdone will store now the markers used in global resolve ! for this particular problem, markers are the global dofs at corner nodes ! set the global id for vertices ! first, retrieve the tag - tagname='GDOFV'//C_NULL_CHAR - tagtype = 0 ! dense, integer - numco = 1 - ierr = iMOAB_DefineTagStorage(MHID, tagname, tagtype, numco, tagindex ) - if (ierr > 0 ) & - call endrun('Error: fail to retrieve GDOFV id tag') - ierr = iMOAB_DefineTagStorage(MHID, newtagg, tagtype, numco, tagindex ) - if (ierr > 0 ) & - call endrun('Error: fail to retrieve GLOBAL_ID tag on coarse mesh') - ! now set the values - ent_type = 0 ! vertex type - ierr = iMOAB_SetIntTagStorage ( MHID, tagname, nverts_c , ent_type, vdone_c) - if (ierr > 0 ) & - call endrun('Error: fail to set GDOFV tag for vertices') + tagname='GDOFV'//C_NULL_CHAR + tagtype = 0 ! dense, integer + numco = 1 + ierr = iMOAB_DefineTagStorage(MHID, tagname, tagtype, numco, tagindex ) + if (ierr > 0 ) & + call endrun('Error: fail to retrieve GDOFV id tag') + ierr = iMOAB_DefineTagStorage(MHID, newtagg, tagtype, numco, tagindex ) + if (ierr > 0 ) & + call endrun('Error: fail to retrieve GLOBAL_ID tag on coarse mesh') + ! now set the values + ent_type = 0 ! vertex type + if ( nverts_c > 0 ) then + ierr = iMOAB_SetIntTagStorage ( MHID, tagname, nverts_c , ent_type, vdone_c) + if (ierr > 0 ) & + call endrun('Error: fail to set GDOFV tag for vertices') + endif ! set global id tag for coarse elements, too; they will start at nets=1, end at nete=nelemd - ent_type = 1 ! now set the global id tag on elements - ierr = iMOAB_SetIntTagStorage ( MHID, newtagg, nelemd , ent_type, elemids) - if (ierr > 0 ) & - call endrun('Error: fail to set global id tag for vertices') + ent_type = 1 ! now set the global id tag on elements + if ( nelemd > 0 ) then + ierr = iMOAB_SetIntTagStorage ( MHID, newtagg, nelemd , ent_type, elemids) + if (ierr > 0 ) & + call endrun('Error: fail to set global id tag for vertices') + endif - ierr = iMOAB_ResolveSharedEntities( MHID, idx, vdone_c ); - if (ierr > 0 ) & - call endrun('Error: fail to resolve shared entities') + ierr = iMOAB_ResolveSharedEntities( MHID, idx, vdone_c ); + if (ierr > 0 ) & + call endrun('Error: fail to resolve shared entities') ! global dofs are the GLL points are set for each element - tagname='GLOBAL_DOFS'//C_NULL_CHAR - tagtype = 0 ! dense, integer - numco = np*np ! usually, it is 16; each element will have the dofs in order - ierr = iMOAB_DefineTagStorage(MHID, tagname, tagtype, numco, tagindex ) - if (ierr > 0 ) & - call endrun('Error: fail to create global DOFS tag') - ! now set the values - ! set global dofs tag for coarse elements, too; they will start at nets=1, end at nete=nelemd - ent_type = 1 ! now set the global id tag on elements - numvals = nelemd*np*np ! input is the total number of values - ! form gdofel from vgids - do ie=1, nelemd - ix = (ie-1)*np*np ! ie: index in coarse element - je = (ie-1) * 4 * (np-1) * (np -1) ! index in moabconn array - ! vgids are global ids for fine vertices (1,nverts) - iv = 1 - do j=1,np - do i=1,np - k = local_map(i,j) - gdofel(ix+iv) = vgids( moabconn( je + k ) ) - iv = iv + 1 - enddo - enddo - ! extract global ids - vdone_c( moabconn_c( (ie-1)*4+1) ) = vgids ( moabconn(je+1 )) - vdone_c( moabconn_c( (ie-1)*4+2) ) = vgids ( moabconn(je+ 4*(np-2)+2 )) ! valid for np = 4, 10 - vdone_c( moabconn_c( (ie-1)*4+3) ) = vgids ( moabconn(je+ 4*((np-1)*(np-1)-1) + 3 )) ! for np = 4, 35 - vdone_c( moabconn_c( (ie-1)*4+4) ) = vgids ( moabconn(je+ 4*(np-2)*(np-1) + 4 )) ! 28 for np = 4 - enddo - ierr = iMOAB_SetIntTagStorage ( MHID, tagname, numvals, ent_type, gdofel) - if (ierr > 0 ) & - call endrun('Error: fail to set globalDOFs tag for coarse elements') - + tagname='GLOBAL_DOFS'//C_NULL_CHAR + tagtype = 0 ! dense, integer + numco = np*np ! usually, it is 16; each element will have the dofs in order + ierr = iMOAB_DefineTagStorage(MHID, tagname, tagtype, numco, tagindex ) + if (ierr > 0 ) & + call endrun('Error: fail to create global DOFS tag') + ! now set the values + ! set global dofs tag for coarse elements, too; they will start at nets=1, end at nete=nelemd + ent_type = 1 ! now set the global id tag on elements + numvals = nelemd*np*np ! input is the total number of values + ! form gdofel from vgids + do ie=1, nelemd + ix = (ie-1)*np*np ! ie: index in coarse element + je = (ie-1) * 4 * (np-1) * (np -1) ! index in moabconn array + ! vgids are global ids for fine vertices (1,nverts) + iv = 1 + do j=1,np + do i=1,np + k = local_map(i,j) + gdofel(ix+iv) = vgids( moabconn( je + k ) ) + iv = iv + 1 + enddo + enddo + ! extract global ids + vdone_c( moabconn_c( (ie-1)*4+1) ) = vgids ( moabconn(je+1 )) + vdone_c( moabconn_c( (ie-1)*4+2) ) = vgids ( moabconn(je+ 4*(np-2)+2 )) ! valid for np = 4, 10 + vdone_c( moabconn_c( (ie-1)*4+3) ) = vgids ( moabconn(je+ 4*((np-1)*(np-1)-1) + 3 )) ! for np = 4, 35 + vdone_c( moabconn_c( (ie-1)*4+4) ) = vgids ( moabconn(je+ 4*(np-2)*(np-1) + 4 )) ! 28 for np = 4 + enddo + if ( nelemd > 0 ) then + ierr = iMOAB_SetIntTagStorage ( MHID, tagname, numvals, ent_type, gdofel) + if (ierr > 0 ) & + call endrun('Error: fail to set globalDOFs tag for coarse elements') + endif ! set the global ids for coarse vertices the same as corresponding fine vertices - ent_type = 0 ! vertex type - ierr = iMOAB_SetIntTagStorage ( MHID, newtagg, nverts_c , ent_type, vdone_c) - if (ierr > 0 ) & - call endrun('Error: fail to set GLOBAL_DOFS tag values') - - ierr = iMOAB_UpdateMeshInfo(MHID) - if (ierr > 0 ) & - call endrun('Error: fail to update mesh info') + ent_type = 0 ! vertex type + if ( nverts_c > 0 ) then + ierr = iMOAB_SetIntTagStorage ( MHID, newtagg, nverts_c , ent_type, vdone_c) + if (ierr > 0 ) & + call endrun('Error: fail to set GLOBAL_DOFS tag values') + endif + + ierr = iMOAB_UpdateMeshInfo(MHID) + if (ierr > 0 ) & + call endrun('Error: fail to update mesh info') #ifdef MOABDEBUG -! write out the mesh file to disk, in parallel - outfile = 'wholeATM.h5m'//C_NULL_CHAR - wopts = 'PARALLEL=WRITE_PART'//C_NULL_CHAR - ierr = iMOAB_WriteMesh(MHID, outfile, wopts) - if (ierr > 0 ) & - call endrun('Error: fail to write the mesh file') +! write out the mesh file to disk, in parallel + outfile = 'wholeATM.h5m'//C_NULL_CHAR + wopts = 'PARALLEL=WRITE_PART'//C_NULL_CHAR + ierr = iMOAB_WriteMesh(MHID, outfile, wopts) + if (ierr > 0 ) & + call endrun('Error: fail to write the mesh file') #endif if (fv_nphys > 0 ) then @@ -486,6 +528,7 @@ subroutine create_moab_meshes(par, elem) ! first count the number of edges in the coarse mesh; ! use euler: v-m+f = 2 => m = v + f - 2 nedges_c = nverts_c + nelemd - 1 ! could be more, if unconnected regions ? + if ( nedges_c < 0 ) nedges_c = 0 ! it cannot be negative internal_edges = 0 boundary_edges = 0 reverse_edges = 0 @@ -493,20 +536,23 @@ subroutine create_moab_meshes(par, elem) ! ! there are new vertices on each coarse edge (fv_phys - 1) , and (fv_nphys - 1) * (fv_nphys - 1) ! new vertices on each coarse cell - - allocate (local_cell_gids(nelemd)) - allocate (indx_cell(nelemd)) - allocate (edge(2,nedges_c)) ! + if ( nelemd > 0 ) then + allocate (local_cell_gids(nelemd)) + allocate (indx_cell(nelemd)) + allocate (edge(2,nedges_c)) ! + endif do ie=1, nelemd ! - local_cell_gids(ie) = elem(ie)%GlobalID + local_cell_gids(ie) = elem(ie)%GlobalID enddo - call IndexSet(nelemd, indx_cell) - call IndexSort(nelemd, indx_cell, local_cell_gids, descend=.false.) + if ( nelemd > 0 ) then + call IndexSet(nelemd, indx_cell) + call IndexSort(nelemd, indx_cell, local_cell_gids, descend=.false.) ! print *, ' local_cell_gids ', local_cell_gids ! print *, ' indx_cell ', indx_cell - allocate( elem_edge (4, nelemd) ) + allocate( elem_edge (4, nelemd) ) ! print *, '------------------------------- ' ! print *, "RANK:", par%rank + endif edge_index = 0 do ie=1, nelemd ! ! we need to check if neighbor is with id smaller; that means it was already created ? @@ -578,10 +624,12 @@ subroutine create_moab_meshes(par, elem) ! now generate phys grid, uniform FV type mesh; ! 2 cases: fv_nphys is 1 or 2; when 2, we need new nodes; will use the same id as ! the gdof on edge is used, with the smaller id chosen, among - allocate(moabconn_pg(4*nelem_pg)) ! connectivity - ! reuse moab_vert_coords for coordinates of pg mesh - ! the first nverts_c coords are the same as coarse mesh; but we do create new - allocate(vdone_pg(nverts_pg)) + if ( nelemd > 0 ) then + allocate(moabconn_pg(4*nelem_pg)) ! connectivity + ! reuse moab_vert_coords for coordinates of pg mesh + ! the first nverts_c coords are the same as coarse mesh; but we do create new + allocate(vdone_pg(nverts_pg)) + endif do iv = 1, nverts_c vdone_pg(iv) = vdone_c(iv) ! also the coordinates will be the same !! enddo @@ -686,19 +734,21 @@ subroutine create_moab_meshes(par, elem) dimcoord = nverts_pg*3 dimen = 3 - ierr = iMOAB_CreateVertices(MHPGID, dimcoord, dimen, moab_vert_coords) - if (ierr > 0 ) & + if ( nverts_pg > 0 ) then + ierr = iMOAB_CreateVertices(MHPGID, dimcoord, dimen, moab_vert_coords) + if (ierr > 0 ) & call endrun('Error: fail to create MOAB vertices ') - + endif ! num_el = nelem_pg * mbtype = 3 ! quadrilateral nve = 4; block_ID = 300 ! this will be for pg mesh - ierr = iMOAB_CreateElements( MHPGID, nelem_pg, mbtype, nve, moabconn_pg, block_ID ); - if (ierr > 0 ) & - call endrun('Error: fail to create MOAB elements') - + if ( nelem_pg > 0 ) then + ierr = iMOAB_CreateElements( MHPGID, nelem_pg, mbtype, nve, moabconn_pg, block_ID ); + if (ierr > 0 ) & + call endrun('Error: fail to create MOAB elements') + endif tagname='GLOBAL_ID'//C_NULL_CHAR tagtype = 0 ! dense, integer numco = 1 @@ -708,16 +758,22 @@ subroutine create_moab_meshes(par, elem) ! now set the values ent_type = 0 ! vertex type - ierr = iMOAB_SetIntTagStorage ( MHPGID, tagname, nverts_pg , ent_type, vdone_pg) - if (ierr > 0 ) & + if ( nverts_pg > 0 ) then + ierr = iMOAB_SetIntTagStorage ( MHPGID, tagname, nverts_pg , ent_type, vdone_pg) + if (ierr > 0 ) & call endrun('Error: fail to set global id tag for vertices') + endif ! set global id tag for pg2 elements, too; they will start at nets=1, end at nete=nelemd*4 ent_type = 1 ! now set the global id tag on elements - ierr = iMOAB_SetIntTagStorage ( MHPGID, tagname, nelem_pg , ent_type, elemids) - if (ierr > 0 ) & - call endrun('Error: fail to set global id tag for edges') + if ( nelem_pg > 0 ) then + ierr = iMOAB_SetIntTagStorage ( MHPGID, tagname, nelem_pg , ent_type, elemids) + if (ierr > 0 ) & + call endrun('Error: fail to set global id tag for edges') + endif ierr = iMOAB_ResolveSharedEntities( MHPGID, nverts_pg, vdone_pg ); + if (ierr > 0 ) & + call endrun('Error: fail to resolve shared ents for pg2 mesh') ierr = iMOAB_UpdateMeshInfo(MHPGID) if (ierr > 0 ) & @@ -731,20 +787,29 @@ subroutine create_moab_meshes(par, elem) call endrun('Error: fail to write the mesh file') #endif endif ! only valid for pg == 2 + if ( nelemd > 0 ) then + deallocate (local_cell_gids) + deallocate (indx_cell) + deallocate (edge) ! + deallocate(moabconn_pg) ! connectivity + deallocate(vdone_pg) + endif endif ! deallocate - deallocate(moabvh) -! deallocate(moabconn) keep it , it is useful to set the tag on fine mesh - deallocate(vdone) - deallocate(gdofel) - deallocate(indx) - deallocate(elemids) - deallocate(gdofv) - deallocate(moabvh_c) - deallocate(moabconn_c) - deallocate(vdone_c) + if ( nelemd > 0 ) then + deallocate(moabvh) + deallocate(moabconn) ! do not keep it anymore, we are not setting another tag on fine mesh + deallocate(vdone) + deallocate(gdofel) + deallocate(indx) + deallocate(elemids) + deallocate(gdofv) + deallocate(moabvh_c) + deallocate(moabconn_c) + deallocate(vdone_c) + endif ! end copy end subroutine create_moab_meshes From 9fa94e0c6bc452d107e0a51d704135e97af2f355 Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Sun, 25 Jun 2023 14:32:42 -0500 Subject: [PATCH 415/467] import moab last so moab import now takes precedence over --- components/eam/src/cpl/atm_comp_mct.F90 | 15 ++++++++------- components/elm/src/cpl/lnd_comp_mct.F90 | 3 ++- components/mosart/src/cpl/rof_comp_mct.F90 | 5 +++-- components/mpas-ocean/driver/ocn_comp_mct.F | 17 ++++++++++------- components/mpas-seaice/driver/ice_comp_mct.F | 14 ++++++++------ 5 files changed, 31 insertions(+), 23 deletions(-) diff --git a/components/eam/src/cpl/atm_comp_mct.F90 b/components/eam/src/cpl/atm_comp_mct.F90 index 0c718340a3e8..286df43db874 100644 --- a/components/eam/src/cpl/atm_comp_mct.F90 +++ b/components/eam/src/cpl/atm_comp_mct.F90 @@ -478,13 +478,14 @@ subroutine atm_init_mct( EClock, cdata_a, x2a_a, a2x_a, NLFilename ) call mct_list_clean(temp_list) #endif - + ! so the cam import is before moab + call atm_import( x2a_a%rattr, cam_in ) #ifdef HAVE_MOAB + ! move moab import after cam import, so moab takes precedence call atm_import_moab(cam_in) #endif - ! move moab import before cam import - ! so the cam import takes precedence, and fixes eventual problems in moab import - call atm_import( x2a_a%rattr, cam_in ) + + call t_startf('CAM_run1') call cam_run1 ( cam_in, cam_out ) @@ -633,7 +634,8 @@ subroutine atm_run_mct( EClock, cdata_a, x2a_a, a2x_a) ! Map input from mct to cam data structure call t_startf ('CAM_import') - +! move moab import after regular atm import, so it would be in charge + call atm_import( x2a_a%rattr, cam_in ) #ifdef HAVE_MOAB #ifdef MOABCOMP @@ -655,8 +657,7 @@ subroutine atm_run_mct( EClock, cdata_a, x2a_a, a2x_a) call atm_import_moab(cam_in) #endif - ! move moab import before regular atm import, so it would hopefully not be a problem - call atm_import( x2a_a%rattr, cam_in ) + call t_stopf ('CAM_import') ! Cycle over all time steps in the atm coupling interval diff --git a/components/elm/src/cpl/lnd_comp_mct.F90 b/components/elm/src/cpl/lnd_comp_mct.F90 index ee206fc1fc4a..ea261531bcec 100644 --- a/components/elm/src/cpl/lnd_comp_mct.F90 +++ b/components/elm/src/cpl/lnd_comp_mct.F90 @@ -536,6 +536,8 @@ subroutine lnd_run_mct(EClock, cdata_l, x2l_l, l2x_l) ! Map to elm (only when state and/or fluxes need to be updated) call t_startf ('lc_lnd_import') + call lnd_import( bounds, x2l_l%rattr, atm2lnd_vars, glc2lnd_vars, lnd2atm_vars) + #ifdef HAVE_MOAB ! first call moab import #ifdef MOABCOMP @@ -559,7 +561,6 @@ subroutine lnd_run_mct(EClock, cdata_l, x2l_l, l2x_l) call lnd_import_moab( bounds, atm2lnd_vars, glc2lnd_vars) #endif - call lnd_import( bounds, x2l_l%rattr, atm2lnd_vars, glc2lnd_vars, lnd2atm_vars) call t_stopf ('lc_lnd_import') ! Use infodata to set orbital values if updated mid-run diff --git a/components/mosart/src/cpl/rof_comp_mct.F90 b/components/mosart/src/cpl/rof_comp_mct.F90 index ab84ea84c9bf..fa21a9c0aaa3 100644 --- a/components/mosart/src/cpl/rof_comp_mct.F90 +++ b/components/mosart/src/cpl/rof_comp_mct.F90 @@ -437,6 +437,8 @@ subroutine rof_run_mct( EClock, cdata_r, x2r_r, r2x_r) ! Map MCT to land data type (output is totrunin, subrunin) call t_startf ('lc_rof_import') + call rof_import_mct( x2r_r) + call t_stopf ('lc_rof_import') #ifdef HAVE_MOAB #ifdef MOABCOMP @@ -458,8 +460,7 @@ subroutine rof_run_mct( EClock, cdata_r, x2r_r, r2x_r) call rof_import_moab( ) #endif - call rof_import_mct( x2r_r) - call t_stopf ('lc_rof_import') + ! Run mosart (input is *runin, output is rtmCTL%runoff) ! First advance mosart time step diff --git a/components/mpas-ocean/driver/ocn_comp_mct.F b/components/mpas-ocean/driver/ocn_comp_mct.F index 7c1ce122a958..be1864b395a4 100644 --- a/components/mpas-ocean/driver/ocn_comp_mct.F +++ b/components/mpas-ocean/driver/ocn_comp_mct.F @@ -890,6 +890,11 @@ end subroutine xml_stream_get_attributes timeStep = mpas_get_clock_timestep(domain_ptr % clock, ierr=ierr) call mpas_get_timeInterval(timeStep, dt=dt) + call ocn_import_mct(x2o_o, errorCode) + if (errorCode /= 0) then + call mpas_log_write('Error in ocn_import_mct', MPAS_LOG_CRIT) + endif + #ifdef HAVE_MOAB #ifdef MOABCOMP @@ -913,10 +918,7 @@ end subroutine xml_stream_get_attributes call mpas_log_write('Error in ocn_import_moab', MPAS_LOG_CRIT) endif #endif - call ocn_import_mct(x2o_o, errorCode) - if (errorCode /= 0) then - call mpas_log_write('Error in ocn_import_mct', MPAS_LOG_CRIT) - endif + itimestep = 0 @@ -1036,7 +1038,9 @@ subroutine ocn_run_mct( EClock, cdata_o, x2o_o, o2x_o)!{{{ call mpas_get_timeInterval(timeStep, dt=dt) call mpas_reset_clock_alarm(domain_ptr % clock, coupleAlarmID, ierr=ierr) - ! Import state from moab coupler + ! Import state from coupler + call ocn_import_mct(x2o_o, ierr) + ! Import state from moab coupler #ifdef HAVE_MOAB @@ -1060,8 +1064,7 @@ subroutine ocn_run_mct( EClock, cdata_o, x2o_o, o2x_o)!{{{ call mpas_log_write('Error in ocn_import_moab', MPAS_LOG_CRIT) endif #endif - ! Import state from coupler - call ocn_import_mct(x2o_o, ierr) + ! Ensures MPAS AM write/compute startup steps are performed call ocn_analysis_compute_startup(domain_ptr, ierr) diff --git a/components/mpas-seaice/driver/ice_comp_mct.F b/components/mpas-seaice/driver/ice_comp_mct.F index 412e83f53690..ec12b2bf00ad 100644 --- a/components/mpas-seaice/driver/ice_comp_mct.F +++ b/components/mpas-seaice/driver/ice_comp_mct.F @@ -825,6 +825,10 @@ end subroutine xml_stream_get_attributes ! ! get intial state from driver ! + call ice_import_mct(x2i_i, errorCode) + if (errorCode /= 0) then + call mpas_log_write('Error in ice_import_mct', MPAS_LOG_CRIT) + endif !----------------------------------------------------------------------- #ifdef HAVE_MOAB @@ -847,10 +851,7 @@ end subroutine xml_stream_get_attributes call ice_import_moab() #endif - call ice_import_mct(x2i_i, errorCode) - if (errorCode /= 0) then - call mpas_log_write('Error in ice_import_mct', MPAS_LOG_CRIT) - endif + currTime = mpas_get_clock_time(domain % clock, MPAS_NOW, ierr) call mpas_get_time(curr_time=currTime, dateTimeString=timeStamp, ierr=ierr) @@ -1164,6 +1165,8 @@ subroutine ice_run_mct( EClock, cdata_i, x2i_i, i2x_i)!{{{ ! reinitialize fluxes call seaice_column_reinitialize_fluxes(domain) + ! Import state from coupler + call ice_import_mct(x2i_i, ierr) #ifdef HAVE_MOAB #ifdef MOABCOMP ! loop over all fields in seq_flds_x2i_fields @@ -1182,8 +1185,7 @@ subroutine ice_run_mct( EClock, cdata_i, x2i_i, i2x_i)!{{{ #endif call ice_import_moab() #endif - ! Import state from coupler - call ice_import_mct(x2i_i, ierr) + ! Post coupling calls block => domain % blocklist From 4392296fb1e3c969663a3ddb4bc128ec651ac8ac Mon Sep 17 00:00:00 2001 From: Robert Jacob Date: Mon, 2 Oct 2023 14:46:10 -0500 Subject: [PATCH 416/467] Remove whitespace only Remove whitespace only changes that were the only diffs in these files. --- components/eam/src/control/cam_comp.F90 | 1 - components/homme/src/share/prim_driver_base.F90 | 3 --- components/homme/src/tool/CMakeLists.txt | 1 - 3 files changed, 5 deletions(-) diff --git a/components/eam/src/control/cam_comp.F90 b/components/eam/src/control/cam_comp.F90 index 062585c21b18..9ea50abd0119 100644 --- a/components/eam/src/control/cam_comp.F90 +++ b/components/eam/src/control/cam_comp.F90 @@ -33,7 +33,6 @@ module cam_comp public cam_run3 ! CAM run method phase 3 public cam_run4 ! CAM run method phase 4 public cam_final ! CAM Finalization - ! ! Private module data ! diff --git a/components/homme/src/share/prim_driver_base.F90 b/components/homme/src/share/prim_driver_base.F90 index b4cee83c325c..27df23dba4d4 100644 --- a/components/homme/src/share/prim_driver_base.F90 +++ b/components/homme/src/share/prim_driver_base.F90 @@ -42,7 +42,6 @@ module prim_driver_base public :: prim_init1_no_cam #endif - public :: smooth_topo_datasets, deriv1 public :: applyCAMforcing_tracers @@ -693,8 +692,6 @@ subroutine prim_init1_buffers (elem,par) use dimensions_mod, only : max_corner_elem use compose_mod, only : compose_query_bufsz, compose_set_bufs #endif - - ! ! Inputs ! diff --git a/components/homme/src/tool/CMakeLists.txt b/components/homme/src/tool/CMakeLists.txt index 2e97803243b4..577930feceea 100644 --- a/components/homme/src/tool/CMakeLists.txt +++ b/components/homme/src/tool/CMakeLists.txt @@ -34,7 +34,6 @@ SET(TOOL_SRCS_F90 ${SRC_DIR}/test_mod.F90 ) - # Make SRCS global so the tests can access it SET(EXEC_SOURCES ${TOOL_SRCS_F90}) From a1a2f946ce0054705950bc5845b32a091b4b4d55 Mon Sep 17 00:00:00 2001 From: Robert Jacob Date: Mon, 2 Oct 2023 16:21:17 -0500 Subject: [PATCH 417/467] Remove some commented out code Remove some commented out code and unused code from component model MOAB interfaces. --- components/eam/src/cpl/atm_comp_mct.F90 | 13 ++------- components/eam/src/physics/cam/phys_grid.F90 | 2 -- components/elm/src/cpl/lnd_comp_mct.F90 | 28 -------------------- components/elm/src/main/surfrdMod.F90 | 10 ------- 4 files changed, 2 insertions(+), 51 deletions(-) diff --git a/components/eam/src/cpl/atm_comp_mct.F90 b/components/eam/src/cpl/atm_comp_mct.F90 index 286df43db874..a6933f167e7a 100644 --- a/components/eam/src/cpl/atm_comp_mct.F90 +++ b/components/eam/src/cpl/atm_comp_mct.F90 @@ -461,8 +461,6 @@ subroutine atm_init_mct( EClock, cdata_a, x2a_a, a2x_a, NLFilename ) call seq_timemgr_EClockGetData(EClock,curr_ymd=CurrentYMD, StepNo=StepNo, dtime=DTime_Sync ) if (StepNo == 0) then #ifdef MOABCOMP - !compare_to_moab_tag(mpicom_atm_moab, attrVect, field, imoabApp, tag_name, ent_type, difference) - !x2o_o => component_get_x2c_cx(ocn(1)) ! loop over all fields in seq_flds_x2a_fields call mct_list_init(temp_list ,seq_flds_x2a_fields) size_list=mct_list_nitem (temp_list) @@ -639,8 +637,7 @@ subroutine atm_run_mct( EClock, cdata_a, x2a_a, a2x_a) #ifdef HAVE_MOAB #ifdef MOABCOMP - !x2o_o => component_get_x2c_cx(ocn(1)) - ! loop over all fields in seq_flds_a2x_fields + ! loop over all fields in seq_flds_x2a_fields call mct_list_init(temp_list ,seq_flds_x2a_fields) size_list=mct_list_nitem (temp_list) ent_type = 0 ! entity type is vertex for phys atm @@ -942,7 +939,7 @@ subroutine atm_domain_mct( lsize, gsMap_a, dom_a ) do c = begchunk, endchunk ncols = get_ncols_p(c) do i=1,ncols - n = n+1 + n e n+1 data(n) = 1._r8 ! mask end do end do @@ -1256,12 +1253,6 @@ subroutine init_moab_atm_phys( cdata_a ) if (ierr > 0 ) & call endrun('Error: fail to set area tag ') - ! comment this out now - ! tagname='aream'//C_NULL_CHAR - ! ierr = iMOAB_SetDoubleTagStorage ( mphaid, tagname, nlcols , ent_type, areavals) - ! if (ierr > 0 ) & - ! call endrun('Error: fail to set aream tag ') - areavals = 1._r8 ! double tagname='mask'//C_NULL_CHAR ierr = iMOAB_SetDoubleTagStorage ( mphaid, tagname, nlcols , ent_type, areavals) diff --git a/components/eam/src/physics/cam/phys_grid.F90 b/components/eam/src/physics/cam/phys_grid.F90 index 0e7e5ae80068..80efcd650f7f 100644 --- a/components/eam/src/physics/cam/phys_grid.F90 +++ b/components/eam/src/physics/cam/phys_grid.F90 @@ -103,8 +103,6 @@ module phys_grid use cam_abortutils, only: endrun use perf_mod use cam_logfile, only: iulog - ! debug chunks - use shr_file_mod, only: shr_file_getUnit, shr_file_freeUnit use scamMod, only: single_column, scmlat, scmlon use shr_const_mod, only: SHR_CONST_PI use dycore, only: dycore_is diff --git a/components/elm/src/cpl/lnd_comp_mct.F90 b/components/elm/src/cpl/lnd_comp_mct.F90 index ea261531bcec..c419ba93a026 100644 --- a/components/elm/src/cpl/lnd_comp_mct.F90 +++ b/components/elm/src/cpl/lnd_comp_mct.F90 @@ -929,22 +929,6 @@ subroutine init_moab_land(bounds, samegrid_al, LNDID) if (ierr > 0 ) & call endrun('Error: fail to set GLOBAL_ID tag ') -! ierr = iMOAB_ResolveSharedEntities( mlnid, lsz, vgids ); -! if (ierr > 0 ) & -! call endrun('Error: fail to resolve shared entities') - -! !there are no shared entities, but we will set a special partition tag, in order to see the -! ! partitions ; it will be visible with a Pseudocolor plot in VisIt -! tagname='partition'//C_NULL_CHAR -! ierr = iMOAB_DefineTagStorage(mlnid, tagname, tagtype, numco, tagindex ) -! if (ierr > 0 ) & -! call endrun('Error: fail to create new partition tag ') -! -! vgids = iam -! ierr = iMOAB_SetIntTagStorage ( mlnid, tagname, lsz , ent_type, vgids) -! if (ierr > 0 ) & -! call endrun('Error: fail to set partition tag ') - ! use moab_vert_coords as a data holder for a frac tag and area tag that we will create ! on the vertices; do not allocate other data array tagname='frac'//C_NULL_CHAR @@ -979,9 +963,6 @@ subroutine init_moab_land(bounds, samegrid_al, LNDID) ierr = iMOAB_DefineTagStorage(mlnid, tagname, tagtype, numco, tagindex ) if (ierr > 0 ) & call endrun('Error: fail to create aream tag ') - ! ierr = iMOAB_SetDoubleTagStorage ( mlnid, tagname, lsz , ent_type, moab_vert_coords ) - ! if (ierr > 0 ) & - ! call endrun('Error: fail to set aream tag ') deallocate(moabconn) ! use merge vertices new imoab method to fix cells @@ -1000,9 +981,6 @@ subroutine init_moab_land(bounds, samegrid_al, LNDID) ierr = iMOAB_UpdateMeshInfo( mlnid ) if (ierr > 0 ) & call endrun('Error: fail to update mesh info ') - !ierr = iMOAB_MergeVertices(mlnid) - !if (ierr > 0 ) & - ! call endrun('Error: fail to fix vertices in land mesh ') else ! old point cloud mesh allocate(moab_vert_coords(lsz*dims)) @@ -1308,8 +1286,6 @@ subroutine lnd_import_moab( bounds, atm2lnd_vars, glc2lnd_vars) ! ! !ARGUMENTS: type(bounds_type) , intent(in) :: bounds ! bounds - ! real(r8) , intent(in) :: x2l(:,:) ! driver import state to land model - ! this is moab version, will be replaced with x2l_lm from mlnid type(atm2lnd_type) , intent(inout) :: atm2lnd_vars ! clm internal input data type type(glc2lnd_type) , intent(inout) :: glc2lnd_vars ! clm internal input data type ! @@ -1354,10 +1330,6 @@ subroutine lnd_import_moab( bounds, atm2lnd_vars, glc2lnd_vars) real(r8) :: tbot, tempndep(1,1,158), thiscalday, wt1(14), wt2(14), thisdoy real(r8) :: site_metdata(14,12) real(r8) :: var_month_mean(12) - !real(r8) :: hdm1(720,360,1), hdm2(720,360,1) - !real(r8) :: lnfm1(192,94,2920) - !real(r8) :: ndep1(144,96,1), ndep2(144,96,1) - !real(r8) :: aerodata(14,144,96,14) integer :: lnfmind(2) integer :: var_month_count(12) integer*2 :: temp(1,500000) diff --git a/components/elm/src/main/surfrdMod.F90 b/components/elm/src/main/surfrdMod.F90 index f38095e3c440..4fbe2f1b7536 100755 --- a/components/elm/src/main/surfrdMod.F90 +++ b/components/elm/src/main/surfrdMod.F90 @@ -270,11 +270,9 @@ subroutine surfrd_get_grid(begg, endg, ldomain, filename, glcfilename) local = begg do iseg = 1, gsMap%ngseg if (gsMap%pe_loc(iseg) .eq. iam) then - !write(iulog,*), iseg, gsMap%pe_loc(iseg), gsMap%start(iseg), gsMap%length(iseg) do ig = gsMap%start(iseg), gsMap%start(iseg) + gsMap%length(iseg) - 1 j = (ig-1)/ni + 1 i = ig - ni*(j-1) - ! print *, iam, ig, j, i, rdata3d(1, i, j), rdata3d(2, i, j), rdata3d(3, i, j) do iv = 1, nv if (local .le. endg) then ldomain%lonv(local, iv ) = rdata3d(iv, i, j) @@ -308,14 +306,6 @@ subroutine surfrd_get_grid(begg, endg, ldomain, filename, glcfilename) enddo ! deallocate what is not needed anymore (for half degree land model, ~8Mb) deallocate(rdata3d) - ! fill ldomain%lonv data , in a loop -! call ncd_io(ncid=ncid, varname='xv', flag='read', data=ldomain%lonv, & -! dim1name=grlnd, readvar=readvar) -! if (.not. readvar) call endrun( msg=trim(subname)//' ERROR: xv NOT on file'//errMsg(__FILE__, __LINE__)) -! -! call ncd_io(ncid=ncid, varname='yv', flag='read', data=ldomain%latv, & -! dim1name=grlnd, readvar=readvar) -! if (.not. readvar) call endrun( msg=trim(subname)//' ERROR: yv NOT on file'//errMsg(__FILE__, __LINE__)) end if #endif From 0ded494165323c9bc2cdafe02c158e216e997d77 Mon Sep 17 00:00:00 2001 From: Robert Jacob Date: Mon, 2 Oct 2023 23:18:27 -0500 Subject: [PATCH 418/467] Update driver-moab with cime_config developments Add the nonlinear maps definitions and also definitions for rof_sed, dust_scheme and eps values for high-res grids --- driver-moab/cime_config/config_component.xml | 58 +++++- .../cime_config/namelist_definition_drv.xml | 177 ++++++++++++++++++ 2 files changed, 234 insertions(+), 1 deletion(-) diff --git a/driver-moab/cime_config/config_component.xml b/driver-moab/cime_config/config_component.xml index 4b98187c43ea..6a443eac57dd 100644 --- a/driver-moab/cime_config/config_component.xml +++ b/driver-moab/cime_config/config_component.xml @@ -1367,6 +1367,14 @@ atm2ocn flux mapping file decomp type + + char + idmap_ignore + run_domain + env_run.xml + atm2ocn flux mapping file + + char idmap @@ -1418,6 +1426,14 @@ atm2lnd flux mapping file decomp type + + char + idmap_ignore + run_domain + env_run.xml + atm2lnd flux mapping file + + char idmap @@ -1452,6 +1468,14 @@ atm2rof flux mapping file decomp type + + char + idmap_ignore + run_domain + env_run.xml + atm2rof flux mapping file + + char idmap_ignore @@ -1503,6 +1527,14 @@ ocn2atm flux mapping file decomp type + + char + idmap_ignore + run_domain + env_run.xml + ocn2atm flux mapping file + + char idmap @@ -1520,6 +1552,14 @@ ocn2atm state mapping file decomp type + + char + idmap_ignore + run_domain + env_run.xml + ocn2atm state mapping file + + char idmap @@ -1537,6 +1577,14 @@ lnd2atm flux mapping file decomp type + + char + idmap_ignore + run_domain + env_run.xml + lnd2atm flux mapping file + + char idmap @@ -1554,6 +1602,14 @@ lnd2atm state mapping file decomp type + + char + idmap_ignore + run_domain + env_run.xml + lnd2atm state mapping file + + char idmap @@ -2009,7 +2065,7 @@ char none,npfix,cart3d,cart3d_diag,cart3d_uvw,cart3d_uvw_diag - none + cart3d run_domain env_run.xml vector mapping option diff --git a/driver-moab/cime_config/namelist_definition_drv.xml b/driver-moab/cime_config/namelist_definition_drv.xml index 686afa60dd8f..8f46db1092a4 100644 --- a/driver-moab/cime_config/namelist_definition_drv.xml +++ b/driver-moab/cime_config/namelist_definition_drv.xml @@ -268,6 +268,18 @@ + + logical + seq_flds + seq_cplflds_inparm + + If set to .true., adds fields needed to calculate sediment in the river model + + + .false. + + + @@ -1501,6 +1513,9 @@ $EPS_AGRID 3.e-10 + 1.e-10 + 1.e-10 + 1.e-10 @@ -1692,6 +1707,20 @@ + + integer + nlmaps + seq_infodata_inparm + + Measure and print information about nonlinearly mapped fields. 0 means no + analysis is done or printed. >= 1 triggers analysis written to cpl.log. + default: 0 + + + 0 + + + @@ -3684,6 +3713,19 @@ + + char + mapping + abs + seq_maps + + atm to ocn flux mapping file for fluxes + + + $ATM2OCN_FMAPNAME_NONLINEAR + + + char mapping @@ -3774,6 +3816,19 @@ + + char + mapping + abs + seq_maps + + ocn to atm mapping file for fluxes + + + $OCN2ATM_FMAPNAME_NONLINEAR + + + char mapping @@ -3804,6 +3859,19 @@ + + char + mapping + abs + seq_maps + + ocn to atm mapping file for states + + + $OCN2ATM_SMAPNAME_NONLINEAR + + + char mapping @@ -3834,6 +3902,19 @@ + + char + mapping + abs + seq_maps + + atm to ice flux mapping file for fluxes + + + $ATM2OCN_FMAPNAME_NONLINEAR + + + char mapping @@ -3924,6 +4005,19 @@ + + char + mapping + abs + seq_maps + + ice to atm mapping file for fluxes + + + $OCN2ATM_FMAPNAME_NONLINEAR + + + char mapping @@ -3954,6 +4048,19 @@ + + char + mapping + abs + seq_maps + + ice to atm mapping file for states + + + $OCN2ATM_SMAPNAME_NONLINEAR + + + char mapping @@ -3984,6 +4091,19 @@ + + char + mapping + abs + seq_maps + + atm to land mapping file for fluxes + + + $ATM2LND_FMAPNAME_NONLINEAR + + + char mapping @@ -4044,6 +4164,19 @@ + + char + mapping + abs + seq_maps + + land to atm mapping file for fluxes + + + $LND2ATM_FMAPNAME_NONLINEAR + + + char mapping @@ -4074,6 +4207,19 @@ + + char + mapping + abs + seq_maps + + land to atm mapping file for states + + + $LND2ATM_SMAPNAME_NONLINEAR + + + char mapping @@ -4164,6 +4310,19 @@ + + char + mapping + abs + seq_maps + + atm to runoff flux mapping file + + + $ATM2ROF_FMAPNAME_NONLINEAR + + + char mapping @@ -5107,4 +5266,22 @@ + + + + + + integer + shr_dust + shr_dust_nl + + Dust emission scheme. + 1 = Zender et al. (2003) as in E3SMv1 and v2. + 2 = Kok et al. (2014) for E3SMv3 + + + 1 + + + From 4366d53771bd4f8ae111da176ba4aa1070e112da Mon Sep 17 00:00:00 2001 From: Robert Jacob Date: Tue, 3 Oct 2023 17:22:23 -0500 Subject: [PATCH 419/467] Add more rof_sed and dust mods to driver-moab Add new shr_dust_mod.F90 and changes for dust and rof_sed in seq_flds_mod.F90 from MCT driver. --- driver-moab/shr/seq_flds_mod.F90 | 22 ++++++++- driver-moab/shr/shr_dust_mod.F90 | 84 ++++++++++++++++++++++++++++++++ 2 files changed, 105 insertions(+), 1 deletion(-) create mode 100644 driver-moab/shr/shr_dust_mod.F90 diff --git a/driver-moab/shr/seq_flds_mod.F90 b/driver-moab/shr/seq_flds_mod.F90 index ed888e280e65..4c7a76626b4f 100644 --- a/driver-moab/shr/seq_flds_mod.F90 +++ b/driver-moab/shr/seq_flds_mod.F90 @@ -129,6 +129,7 @@ module seq_flds_mod use shr_fire_emis_mod , only : shr_fire_emis_readnl, shr_fire_emis_mechcomps_n, shr_fire_emis_ztop_token use shr_carma_mod , only : shr_carma_readnl use shr_ndep_mod , only : shr_ndep_readnl + use shr_dust_mod , only : shr_dust_readnl use shr_flds_mod , only : seq_flds_dom_coord=>shr_flds_dom_coord, seq_flds_dom_other=>shr_flds_dom_other @@ -167,6 +168,7 @@ module seq_flds_mod logical :: rof2ocn_nutrients ! .true. if the runoff model passes nutrient fields to the ocn logical :: lnd_rof_two_way ! .true. if land-river two-way coupling turned on logical :: ocn_rof_two_way ! .true. if river-ocean two-way coupling turned on + logical :: rof_sed ! .true. if river model includes sediment !---------------------------------------------------------------------------- ! metadata @@ -396,7 +398,7 @@ subroutine seq_flds_set(nmlfile, ID, infodata) flds_co2a, flds_co2b, flds_co2c, flds_co2_dmsa, flds_wiso, glc_nec, & ice_ncat, seq_flds_i2o_per_cat, flds_bgc_oi, & nan_check_component_fields, rof_heat, atm_flux_method, atm_gustiness, & - rof2ocn_nutrients, lnd_rof_two_way, ocn_rof_two_way + rof2ocn_nutrients, lnd_rof_two_way, ocn_rof_two_way, rof_sed ! user specified new fields integer, parameter :: nfldmax = 200 @@ -440,6 +442,7 @@ subroutine seq_flds_set(nmlfile, ID, infodata) rof2ocn_nutrients = .false. lnd_rof_two_way = .false. ocn_rof_two_way = .false. + rof_sed = .false. unitn = shr_file_getUnit() write(logunit,"(A)") subname//': read seq_cplflds_inparm namelist from: '& @@ -472,6 +475,7 @@ subroutine seq_flds_set(nmlfile, ID, infodata) call shr_mpi_bcast(rof2ocn_nutrients, mpicom) call shr_mpi_bcast(lnd_rof_two_way, mpicom) call shr_mpi_bcast(ocn_rof_two_way, mpicom) + call shr_mpi_bcast(rof_sed, mpicom) call glc_elevclass_init(glc_nec) @@ -2202,6 +2206,17 @@ subroutine seq_flds_set(nmlfile, ID, infodata) units = ' ' attname = 'coszen_str' call metadata_set(attname, longname, stdname, units) + + if (rof_sed) then + call seq_flds_add(l2x_fluxes,'Flrl_rofmud') + call seq_flds_add(l2x_fluxes_to_rof,'Flrl_rofmud') + call seq_flds_add(x2r_fluxes,'Flrl_rofmud') + longname = 'Sediment flux from land (mud)' + stdname = 'mud_flux_into_runoff_surface' + units = 'kg m-2 s-1' + attname = 'Flrl_rofmud' + call metadata_set(attname, longname, stdname, units) + end if endif !----------------------------- @@ -3817,6 +3832,11 @@ subroutine seq_flds_set(nmlfile, ID, infodata) call metadata_set(ndep_fields, longname, stdname, units) end if + !---------------------------------------------------------------------------- + ! Dust-related info + !---------------------------------------------------------------------------- + call shr_dust_readnl(nlfilename='drv_in', ID=ID) + !---------------------------------------------------------------------------- ! state + flux fields !---------------------------------------------------------------------------- diff --git a/driver-moab/shr/shr_dust_mod.F90 b/driver-moab/shr/shr_dust_mod.F90 new file mode 100644 index 000000000000..df7ead938689 --- /dev/null +++ b/driver-moab/shr/shr_dust_mod.F90 @@ -0,0 +1,84 @@ +!===================================================================================== +! Module for handling dust-related information shared by different components models. +! +! History: +! - Hui Wan, Jan 2023, following examples in driver-mct/shr/shr_*_mod.F90 +!===================================================================================== +module shr_dust_mod + + use shr_sys_mod, only : shr_sys_abort + use shr_log_mod, only : s_loglev => shr_log_Level + + implicit none + save + private + + public :: shr_dust_readnl ! subroutine that reads namelist shr_dust_nl + public :: dust_emis_scheme ! module parameter + + integer :: dust_emis_scheme = 1 + +CONTAINS + + !------------------------------------------------------------------------- + ! Reads namelist shr_dust_nl + !------------------------------------------------------------------------- + subroutine shr_dust_readnl(NLFilename, ID) + + use shr_file_mod , only : shr_file_getUnit, shr_file_freeUnit + use shr_log_mod , only : s_logunit => shr_log_Unit + use seq_comm_mct , only : seq_comm_iamroot, seq_comm_setptrs + use shr_mpi_mod , only : shr_mpi_bcast + use shr_nl_mod , only : shr_nl_find_group_name + + implicit none + + character(len=*), intent(in) :: NLFilename ! Namelist filename + integer , intent(in) :: ID ! seq_comm ID + + !----- local ----- + integer :: unitn ! namelist unit number + integer :: ierr ! error code + logical :: exists ! if file exists or not + integer :: mpicom ! MPI communicator + + !----- formats ----- + character(*),parameter :: subName = '(shr_dust_readnl) ' + character(*),parameter :: F00 = "('(shr_dust_readnl) ',8a)" + + namelist /shr_dust_nl/ dust_emis_scheme + + !--- Open and read namelist --- + if ( len_trim(NLFilename) == 0 ) then + call shr_sys_abort( subName//'ERROR: nlfilename not set' ) + end if + call seq_comm_setptrs(ID,mpicom=mpicom) + if (seq_comm_iamroot(ID)) then + inquire( file=trim(NLFileName), exist=exists) + if ( exists ) then + unitn = shr_file_getUnit() + open( unitn, file=trim(NLFilename), status='old' ) + if ( s_loglev > 0 ) then + write(s_logunit,F00) 'Read in shr_dust_nl namelist from: ', trim(NLFilename) + end if + call shr_nl_find_group_name(unitn, 'shr_dust_nl', ierr) + if (ierr == 0) then + ierr = 1 + do while ( ierr /= 0 ) + read(unitn, shr_dust_nl, iostat=ierr) + if (ierr < 0) then + call shr_sys_abort( subName//'ERROR: encountered end-of-file on namelist read' ) + endif + end do + else + write(s_logunit,*) 'shr_dust_readnl: no shr_dust_nl namelist found in ',NLFilename + endif + close( unitn ) + call shr_file_freeUnit( unitn ) + end if + end if + call shr_mpi_bcast( dust_emis_scheme, mpicom ) + + end subroutine shr_dust_readnl + +end module shr_dust_mod From e9191e80e692812f1596311fbd402cc9ac377d55 Mon Sep 17 00:00:00 2001 From: Robert Jacob Date: Thu, 5 Oct 2023 11:04:37 -0500 Subject: [PATCH 420/467] Add MOAB_ROOT for chrysalis Add setting of MOAB_ROOT for chrysalis. --- cime_config/machines/config_machines.xml | 1 + 1 file changed, 1 insertion(+) diff --git a/cime_config/machines/config_machines.xml b/cime_config/machines/config_machines.xml index 129e25ee05e7..0dc593eacd78 100644 --- a/cime_config/machines/config_machines.xml +++ b/cime_config/machines/config_machines.xml @@ -2207,6 +2207,7 @@ $SHELL{dirname $(dirname $(which nc-config))} $SHELL{dirname $(dirname $(which nf-config))} $SHELL{dirname $(dirname $(which pnetcdf_version))} + $SHELL{if [ -z "$MOAB_ROOT" ]; then echo /lcrc/soft/climate/moab/chrysalis/intelSep22; else echo "$MOAB_ROOT"; fi} 128M From 612f02e6dd733f86c78be786d5be1881dbd93d54 Mon Sep 17 00:00:00 2001 From: Robert Jacob Date: Thu, 5 Oct 2023 11:06:15 -0500 Subject: [PATCH 421/467] Add find_package for MOAB and cpp Add find_package call for MOAB and the CPP def needed --- components/CMakeLists.txt | 4 ++++ components/cmake/find_dep_packages.cmake | 4 ++++ 2 files changed, 8 insertions(+) diff --git a/components/CMakeLists.txt b/components/CMakeLists.txt index 4fe3811b619f..2c7ea4e09eb9 100644 --- a/components/CMakeLists.txt +++ b/components/CMakeLists.txt @@ -91,6 +91,10 @@ endif() project(E3SM C CXX Fortran) +if (COMP_INTERFACE STREQUAL "moab") + set(CPPDEFS "${CPPDEFS} -DHAVE_MOAB") +endif() + if(USE_CUDA) enable_language(CUDA) elseif(USE_HIP) diff --git a/components/cmake/find_dep_packages.cmake b/components/cmake/find_dep_packages.cmake index 4f0594ddb6a0..c0478cfacf5d 100644 --- a/components/cmake/find_dep_packages.cmake +++ b/components/cmake/find_dep_packages.cmake @@ -30,6 +30,10 @@ if (USE_ALBANY OR USE_TRILINOS) find_package(Trilinos REQUIRED) endif() +if (USE_MOAB) + find_package(MOAB REQUIRED) +endif() + if (USE_ALBANY) find_package(Albany REQUIRED) endif() From 4b8c02635e4770a1529639a2a079e628579c76f9 Mon Sep 17 00:00:00 2001 From: Robert Jacob Date: Thu, 5 Oct 2023 11:07:46 -0500 Subject: [PATCH 422/467] Change MOAB_PATH for chrysalis Change MOAB_PATH for chrysalis to one built with latest compilers --- cime_config/machines/cmake_macros/intel_chrysalis.cmake | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/cime_config/machines/cmake_macros/intel_chrysalis.cmake b/cime_config/machines/cmake_macros/intel_chrysalis.cmake index 11b27a5c9865..5b51f9b1e814 100644 --- a/cime_config/machines/cmake_macros/intel_chrysalis.cmake +++ b/cime_config/machines/cmake_macros/intel_chrysalis.cmake @@ -26,7 +26,7 @@ endif() set(NETCDF_C_PATH "$ENV{NETCDF_C_PATH}") set(NETCDF_FORTRAN_PATH "$ENV{NETCDF_FORTRAN_PATH}") set(PNETCDF_PATH "$ENV{PNETCDF_PATH}") -set(MOAB_PATH "/lcrc/soft/climate/moab/chrysalis/intel") +set(MOAB_PATH "/lcrc/soft/climate/moab/chrysalis/intelSep22") string(APPEND LDFLAGS " -static-intel") if (MPILIB STREQUAL impi) set(MPICC "mpiicc") From 12dd046cead140524a0349551af3265784c52e9d Mon Sep 17 00:00:00 2001 From: James Foucar Date: Thu, 5 Oct 2023 16:25:27 -0500 Subject: [PATCH 423/467] Fixes for moab --- components/CMakeLists.txt | 1 + components/cmake/build_model.cmake | 5 +++++ 2 files changed, 6 insertions(+) diff --git a/components/CMakeLists.txt b/components/CMakeLists.txt index f67ff1cfd56b..1efb014c069c 100644 --- a/components/CMakeLists.txt +++ b/components/CMakeLists.txt @@ -93,6 +93,7 @@ endif() project(E3SM C CXX Fortran) if (COMP_INTERFACE STREQUAL "moab") + set(USE_MOAB True) set(CPPDEFS "${CPPDEFS} -DHAVE_MOAB") endif() diff --git a/components/cmake/build_model.cmake b/components/cmake/build_model.cmake index 17624ab86905..e9a369a9d4bf 100644 --- a/components/cmake/build_model.cmake +++ b/components/cmake/build_model.cmake @@ -243,6 +243,11 @@ function(build_model COMP_CLASS COMP_NAME) add_library(${TARGET_NAME}) target_sources(${TARGET_NAME} PRIVATE ${REAL_SOURCES}) target_link_libraries(${TARGET_NAME} PRIVATE csm_share) + if (USE_MOAB) + target_link_libraries(${TARGET_NAME} PRIVATE ${MOAB_LIBRARIES}) + target_include_directories(${TARGET_NAME} PRIVATE ${MOAB_INCLUDE_DIRS}) + message("JGF adding include directorries ${MOAB_INCLUDE_DIRS}") + endif() if (COMP_NAME STREQUAL "eam") if (USE_YAKL) target_link_libraries(${TARGET_NAME} PRIVATE yakl) From 23d0efc28b678dd456c4a9d59d8ba3c66fe527f8 Mon Sep 17 00:00:00 2001 From: Robert Jacob Date: Mon, 9 Oct 2023 17:40:33 -0500 Subject: [PATCH 424/467] Update module name in moab subroutines Update module name from clm to elm in moab subroutines. --- components/elm/src/cpl/lnd_comp_mct.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/components/elm/src/cpl/lnd_comp_mct.F90 b/components/elm/src/cpl/lnd_comp_mct.F90 index c1aed8503ac8..cca8478f1f62 100644 --- a/components/elm/src/cpl/lnd_comp_mct.F90 +++ b/components/elm/src/cpl/lnd_comp_mct.F90 @@ -1130,7 +1130,7 @@ subroutine lnd_export_moab( bounds, lnd2atm_vars, lnd2glc_vars) ! !USES: use shr_kind_mod , only : r8 => shr_kind_r8 use elm_varctl , only : iulog, create_glacier_mec_landunit - use clm_time_manager , only : get_nstep, get_step_size + use elm_time_manager , only : get_nstep, get_step_size use domainMod , only : ldomain use seq_drydep_mod , only : n_drydep use shr_megan_mod , only : shr_megan_mechcomps_n @@ -1280,7 +1280,7 @@ subroutine lnd_import_moab( bounds, atm2lnd_vars, glc2lnd_vars) use elm_varctl , only: const_climate_hist, add_temperature, add_co2, use_cn, use_fates use elm_varctl , only: startdate_add_temperature, startdate_add_co2 use elm_varcon , only: rair, o2_molar_const, c13ratio - use clm_time_manager , only: get_nstep, get_step_size, get_curr_calday, get_curr_date + use elm_time_manager , only: get_nstep, get_step_size, get_curr_calday, get_curr_date use controlMod , only: NLFilename use shr_const_mod , only: SHR_CONST_TKFRZ, SHR_CONST_STEBOL use domainMod , only: ldomain From a4fa6257ea8b6ebb5fbad23349038fa491dfd409 Mon Sep 17 00:00:00 2001 From: Robert Jacob Date: Tue, 10 Oct 2023 13:36:17 -0500 Subject: [PATCH 425/467] Add MOAB include dirs to coupler target For the cpl target, add the MOAB include dirs if USE_MOAB is defined. --- components/cmake/build_model.cmake | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/components/cmake/build_model.cmake b/components/cmake/build_model.cmake index e9a369a9d4bf..37e7cd074328 100644 --- a/components/cmake/build_model.cmake +++ b/components/cmake/build_model.cmake @@ -233,6 +233,10 @@ function(build_model COMP_CLASS COMP_NAME) target_link_libraries(${TARGET_NAME} ${ITEM}) endif() endforeach() + if (USE_MOAB) + target_include_directories(${TARGET_NAME} PRIVATE ${MOAB_INCLUDE_DIRS}) + message("JGF adding include directories ${MOAB_INCLUDE_DIRS}") + endif() foreach(ITEM IN LISTS ALL_LIBS_LIST) target_link_libraries(${TARGET_NAME} ${ITEM}) @@ -246,7 +250,7 @@ function(build_model COMP_CLASS COMP_NAME) if (USE_MOAB) target_link_libraries(${TARGET_NAME} PRIVATE ${MOAB_LIBRARIES}) target_include_directories(${TARGET_NAME} PRIVATE ${MOAB_INCLUDE_DIRS}) - message("JGF adding include directorries ${MOAB_INCLUDE_DIRS}") + message("JGF adding include directories ${MOAB_INCLUDE_DIRS}") endif() if (COMP_NAME STREQUAL "eam") if (USE_YAKL) From 2caaa6e3dfb24218128cdd0c09ed2fd9c4f8f6d0 Mon Sep 17 00:00:00 2001 From: Robert Jacob Date: Tue, 10 Oct 2023 13:37:57 -0500 Subject: [PATCH 426/467] Add nlmaps_verbosity to moab infodata Add nlmaps_verbosity namelist var to the moab version of seq_infodata. Will get a namelist read error otherwise. --- driver-moab/shr/seq_infodata_mod.F90 | 20 ++++++++++++++++---- 1 file changed, 16 insertions(+), 4 deletions(-) diff --git a/driver-moab/shr/seq_infodata_mod.F90 b/driver-moab/shr/seq_infodata_mod.F90 index 8c7f797143b2..29ba2c89d983 100644 --- a/driver-moab/shr/seq_infodata_mod.F90 +++ b/driver-moab/shr/seq_infodata_mod.F90 @@ -171,6 +171,7 @@ MODULE seq_infodata_mod real(SHR_KIND_R8) :: eps_oarea ! ocn area error tolerance logical :: mct_usealltoall ! flag for mct alltoall logical :: mct_usevector ! flag for mct vector + integer :: nlmaps_verbosity ! see seq_nlmap_mod logical :: reprosum_use_ddpdd ! use ddpdd algorithm logical :: reprosum_allow_infnan ! allow INF and NaN summands @@ -433,6 +434,7 @@ SUBROUTINE seq_infodata_Init( infodata, nmlfile, ID, pioid, cpl_tag) logical :: mct_usevector ! flag for mct vector real(shr_kind_r8) :: max_cplstep_time ! abort if cplstep time exceeds this value character(SHR_KIND_CL) :: model_doi_url + integer(SHR_KIND_IN) :: nlmaps_verbosity ! see seq_nlmap_mod namelist /seq_infodata_inparm/ & cime_model, case_desc, case_name, start_type, tchkpt_dir, & @@ -472,7 +474,8 @@ SUBROUTINE seq_infodata_Init( infodata, nmlfile, ID, pioid, cpl_tag) eps_oarea, esmf_map_flag, & reprosum_use_ddpdd, reprosum_allow_infnan, & reprosum_diffmax, reprosum_recompute, & - mct_usealltoall, mct_usevector, max_cplstep_time, model_doi_url + mct_usealltoall, mct_usevector, max_cplstep_time, model_doi_url, & + nlmaps_verbosity !------------------------------------------------------------------------------- @@ -593,6 +596,7 @@ SUBROUTINE seq_infodata_Init( infodata, nmlfile, ID, pioid, cpl_tag) mct_usevector = .false. max_cplstep_time = 0.0 model_doi_url = 'unset' + nlmaps_verbosity = 0 !--------------------------------------------------------------------------- ! Read in namelist @@ -605,7 +609,7 @@ SUBROUTINE seq_infodata_Init( infodata, nmlfile, ID, pioid, cpl_tag) read(unitn,nml=seq_infodata_inparm,iostat=ierr) if (ierr < 0) then call shr_sys_abort( subname//':: namelist read returns an'// & - ' end of file or end of record condition' ) + ' end of file or end of record condition',rc=ierr ) end if end do close(unitn) @@ -727,6 +731,7 @@ SUBROUTINE seq_infodata_Init( infodata, nmlfile, ID, pioid, cpl_tag) infodata%reprosum_recompute = reprosum_recompute infodata%mct_usealltoall = mct_usealltoall infodata%mct_usevector = mct_usevector + infodata%nlmaps_verbosity = nlmaps_verbosity infodata%info_debug = info_debug infodata%bfbflag = bfbflag @@ -1032,7 +1037,7 @@ SUBROUTINE seq_infodata_GetData_explicit( infodata, cime_model, case_name, case_ reprosum_use_ddpdd, reprosum_allow_infnan, & reprosum_diffmax, reprosum_recompute, & mct_usealltoall, mct_usevector, max_cplstep_time, model_doi_url, & - glc_valid_input) + glc_valid_input, nlmaps_verbosity) implicit none @@ -1148,6 +1153,7 @@ SUBROUTINE seq_infodata_GetData_explicit( infodata, cime_model, case_name, case_ logical, optional, intent(OUT) :: reprosum_recompute ! recompute if tolerance exceeded logical, optional, intent(OUT) :: mct_usealltoall ! flag for mct alltoall logical, optional, intent(OUT) :: mct_usevector ! flag for mct vector + integer(SHR_KIND_IN), optional, intent(OUT) :: nlmaps_verbosity integer(SHR_KIND_IN), optional, intent(OUT) :: info_debug logical, optional, intent(OUT) :: bfbflag @@ -1334,6 +1340,7 @@ SUBROUTINE seq_infodata_GetData_explicit( infodata, cime_model, case_name, case_ if ( present(reprosum_recompute)) reprosum_recompute = infodata%reprosum_recompute if ( present(mct_usealltoall)) mct_usealltoall = infodata%mct_usealltoall if ( present(mct_usevector) ) mct_usevector = infodata%mct_usevector + if ( present(nlmaps_verbosity)) nlmaps_verbosity = infodata%nlmaps_verbosity if ( present(info_debug) ) info_debug = infodata%info_debug if ( present(bfbflag) ) bfbflag = infodata%bfbflag @@ -1584,7 +1591,7 @@ SUBROUTINE seq_infodata_PutData_explicit( infodata, cime_model, case_name, case_ rof_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) + mct_usealltoall, mct_usevector, glc_valid_input, nlmaps_verbosity) implicit none @@ -1700,6 +1707,7 @@ SUBROUTINE seq_infodata_PutData_explicit( infodata, cime_model, case_name, case_ logical, optional, intent(IN) :: reprosum_recompute ! recompute if tolerance exceeded logical, optional, intent(IN) :: mct_usealltoall ! flag for mct alltoall logical, optional, intent(IN) :: mct_usevector ! flag for mct vector + integer(SHR_KIND_IN), optional, intent(IN) :: nlmaps_verbosity integer(SHR_KIND_IN), optional, intent(IN) :: info_debug logical, optional, intent(IN) :: bfbflag @@ -1885,6 +1893,7 @@ SUBROUTINE seq_infodata_PutData_explicit( infodata, cime_model, case_name, case_ if ( present(reprosum_recompute)) infodata%reprosum_recompute = reprosum_recompute if ( present(mct_usealltoall)) infodata%mct_usealltoall = mct_usealltoall if ( present(mct_usevector) ) infodata%mct_usevector = mct_usevector + if ( present(nlmaps_verbosity)) infodata%nlmaps_verbosity = nlmaps_verbosity if ( present(info_debug) ) infodata%info_debug = info_debug if ( present(bfbflag) ) infodata%bfbflag = bfbflag @@ -2193,6 +2202,7 @@ subroutine seq_infodata_bcast(infodata,mpicom) call shr_mpi_bcast(infodata%reprosum_recompute, mpicom) call shr_mpi_bcast(infodata%mct_usealltoall, mpicom) call shr_mpi_bcast(infodata%mct_usevector, mpicom) + call shr_mpi_bcast(infodata%nlmaps_verbosity, mpicom) call shr_mpi_bcast(infodata%info_debug, mpicom) call shr_mpi_bcast(infodata%bfbflag, mpicom) @@ -2907,6 +2917,8 @@ SUBROUTINE seq_infodata_print( infodata ) write(logunit,F0L) subname,'mct_usealltoall = ', infodata%mct_usealltoall write(logunit,F0L) subname,'mct_usevector = ', infodata%mct_usevector + write(logunit,F0I) subname,'nlmaps_verbosity = ', infodata%nlmaps_verbosity + write(logunit,F0S) subname,'info_debug = ', infodata%info_debug write(logunit,F0L) subname,'bfbflag = ', infodata%bfbflag write(logunit,F0L) subname,'esmf_map_flag = ', infodata%esmf_map_flag From 7280a6b6eb764d2ae0fcede0e44d71f81a4611d7 Mon Sep 17 00:00:00 2001 From: Robert Jacob Date: Tue, 10 Oct 2023 13:39:43 -0500 Subject: [PATCH 427/467] increase tagname size increase tagname size in the moab export routine. --- components/elm/src/cpl/lnd_comp_mct.F90 | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/components/elm/src/cpl/lnd_comp_mct.F90 b/components/elm/src/cpl/lnd_comp_mct.F90 index cca8478f1f62..bf21d6e36bea 100644 --- a/components/elm/src/cpl/lnd_comp_mct.F90 +++ b/components/elm/src/cpl/lnd_comp_mct.F90 @@ -1129,6 +1129,7 @@ subroutine lnd_export_moab( bounds, lnd2atm_vars, lnd2glc_vars) ! ! !USES: use shr_kind_mod , only : r8 => shr_kind_r8 + use shr_kind_mod , only : CXX => SHR_KIND_CXX use elm_varctl , only : iulog, create_glacier_mec_landunit use elm_time_manager , only : get_nstep, get_step_size use domainMod , only : ldomain @@ -1153,7 +1154,7 @@ subroutine lnd_export_moab( bounds, lnd2atm_vars, lnd2glc_vars) integer :: ent_type, ierr character(len=100) :: outfile, wopts, lnum - character(len=400) :: tagname + character(CXX) :: tagname !--------------------------------------------------------------------------- ! cesm sign convention is that fluxes are positive downward @@ -1247,7 +1248,7 @@ subroutine lnd_export_moab( bounds, lnd2atm_vars, lnd2glc_vars) endif ierr = iMOAB_SetDoubleTagStorage ( mlnid, tagname, totalmbls , ent_type, l2x_lm(1,1) ) if (ierr > 0 ) & - call shr_sys_abort( sub//' Error: fail to set moab '// trim(seq_flds_l2x_fields) ) + call shr_sys_abort( sub//' Error: fail to set moab l2x '// trim(seq_flds_l2x_fields) ) #ifdef MOABDEBUG write(lnum,"(I0.2)")num_moab_exports From 717a22c1415148b872c1c6136b68cb097f9c3a49 Mon Sep 17 00:00:00 2001 From: Robert Jacob Date: Tue, 10 Oct 2023 16:27:40 -0500 Subject: [PATCH 428/467] Add fields to export moab Add ssh and avgOceanSurfaceDOCSemiLabile to moab export routine. Catching up to development in the mct coupler. --- components/mpas-ocean/driver/ocn_comp_mct.F | 21 +++++++++++++++------ 1 file changed, 15 insertions(+), 6 deletions(-) diff --git a/components/mpas-ocean/driver/ocn_comp_mct.F b/components/mpas-ocean/driver/ocn_comp_mct.F index e1149c7e41e3..ad3ee82b77fa 100644 --- a/components/mpas-ocean/driver/ocn_comp_mct.F +++ b/components/mpas-ocean/driver/ocn_comp_mct.F @@ -2738,7 +2738,6 @@ subroutine ocn_export_mct(o2x_o, errorCode) !{{{ logical :: keepFrazil - errorcode = 0 ! get configure options call mpas_pool_get_package(domain % packages, 'frazilIceActive', frazilIceActive) @@ -3988,8 +3987,10 @@ subroutine ocn_export_moab() !{{{ avgOceanSurfaceDMS, & avgOceanSurfaceDMSP, & avgOceanSurfaceDOCr, & + avgOceanSurfaceDOCSemiLabile, & avgOceanSurfaceFeParticulate, & - avgOceanSurfaceFeDissolved + avgOceanSurfaceFeDissolved, & + ssh real (kind=RKIND), dimension(:,:), pointer :: avgTracersSurfaceValue, avgSurfaceVelocity, & avgOceanSurfacePhytoC, & @@ -4008,6 +4009,7 @@ subroutine ocn_export_moab() !{{{ character (len=StrKIND), pointer :: config_land_ice_flux_mode logical :: keepFrazil + ! get configure options call mpas_pool_get_package(domain % packages, 'frazilIceActive', frazilIceActive) @@ -4038,6 +4040,7 @@ subroutine ocn_export_moab() !{{{ call mpas_pool_get_dimension(forcingPool, 'index_avgSurfaceVelocityZonal', index_avgZonalSurfaceVelocity) call mpas_pool_get_dimension(forcingPool, 'index_avgSurfaceVelocityMeridional', index_avgMeridionalSurfaceVelocity) + call mpas_pool_get_array(statePool, 'ssh', ssh, 1) call mpas_pool_get_array(statePool, 'layerThickness', layerThickness, 1) call mpas_pool_get_array(forcingPool, 'landIceMask', landIceMask) @@ -4069,6 +4072,7 @@ subroutine ocn_export_moab() !{{{ call mpas_pool_get_array(ecosysSeaIceCoupling, 'avgOceanSurfaceSiO3', avgOceanSurfaceSiO3) call mpas_pool_get_array(ecosysSeaIceCoupling, 'avgOceanSurfaceNH4', avgOceanSurfaceNH4) call mpas_pool_get_array(ecosysSeaIceCoupling, 'avgOceanSurfaceDOCr', avgOceanSurfaceDOCr) + call mpas_pool_get_array(ecosysSeaIceCoupling, 'avgOceanSurfaceDOCSemiLabile', avgOceanSurfaceDOCSemiLabile) call mpas_pool_get_array(ecosysSeaIceCoupling, 'avgOceanSurfaceFeParticulate', avgOceanSurfaceFeParticulate) call mpas_pool_get_array(ecosysSeaIceCoupling, 'avgOceanSurfaceFeDissolved', avgOceanSurfaceFeDissolved) endif @@ -4096,6 +4100,7 @@ subroutine ocn_export_moab() !{{{ o2x_om(n, index_o2x_So_u) = avgSurfaceVelocity(index_avgZonalSurfaceVelocity, i) o2x_om(n, index_o2x_So_v) = avgSurfaceVelocity(index_avgMeridionalSurfaceVelocity, i) + o2x_om(n, index_o2x_So_ssh) = ssh(i) o2x_om(n, index_o2x_So_dhdx) = filteredSSHGradientZonal(i) o2x_om(n, index_o2x_So_dhdy) = filteredSSHGradientMeridional(i) @@ -4155,6 +4160,10 @@ subroutine ocn_export_moab() !{{{ o2x_om(n, index_o2x_So_algae2) = max(0.0_RKIND,avgOceanSurfacePhytoC(2,i)) o2x_om(n, index_o2x_So_algae3) = max(0.0_RKIND,avgOceanSurfacePhytoC(3,i)) o2x_om(n, index_o2x_So_dic1) = max(0.0_RKIND,avgOceanSurfaceDIC(i)) + o2x_om(n, index_o2x_So_doc1) = max(0.0_RKIND,avgOceanSurfaceDOCSemiLabile(i)) + o2x_om(n, index_o2x_So_doc2) = max(0.0_RKIND,avgOceanSurfaceDOCSemiLabile(i)) + o2x_om(n, index_o2x_So_doc3) = max(0.0_RKIND,avgOceanSurfaceDOCSemiLabile(i)) + o2x_om(n, index_o2x_So_don1) = 0.0_RKIND o2x_om(n, index_o2x_So_no3) = max(0.0_RKIND,avgOceanSurfaceNO3(i)) o2x_om(n, index_o2x_So_sio3) = max(0.0_RKIND,avgOceanSurfaceSiO3(i)) o2x_om(n, index_o2x_So_nh4) = max(0.0_RKIND,avgOceanSurfaceNH4(i)) @@ -4172,14 +4181,14 @@ subroutine ocn_export_moab() !{{{ o2x_om(n, index_o2x_So_don1) = max(0.0_RKIND,avgOceanSurfaceDON(i)) endif - if ( trim(config_land_ice_flux_mode) .ne. 'pressure_only' ) then + if ( trim(config_land_ice_flux_mode) .eq. 'standalone' .or. & + trim(config_land_ice_flux_mode) .eq. 'coupled' ) then o2x_om(n, index_o2x_So_blt) = landIceBoundaryLayerTracers(indexBLT,i) o2x_om(n, index_o2x_So_bls) = landIceBoundaryLayerTracers(indexBLS,i) o2x_om(n, index_o2x_So_htv) = landIceTracerTransferVelocities(indexHeatTrans,i) o2x_om(n, index_o2x_So_stv) = landIceTracerTransferVelocities(indexSaltTrans,i) o2x_om(n, index_o2x_So_rhoeff) = 0.0_RKIND - endif - + endif end do block_ptr => block_ptr % next @@ -4190,7 +4199,7 @@ subroutine ocn_export_moab() !{{{ tagname = trim(seq_flds_o2x_fields)//C_NULL_CHAR ierr = iMOAB_SetDoubleTagStorage ( MPOID, tagname, totalmbls , ent_type, o2x_om(1, 1) ) if ( ierr /= 0 ) then - write(ocnLogUnit,*) 'Fail to set MOAB fields ' + write(ocnLogUnit,*) 'Fail to set o2x MOAB fields ' endif !----------------------------------------------------------------------- !EOC From a048199769d96664e29885898acc5a9cc8bb3ba9 Mon Sep 17 00:00:00 2001 From: Robert Jacob Date: Tue, 10 Oct 2023 23:53:02 -0500 Subject: [PATCH 429/467] Change vect_map default to none in moab driver Change vect_map default to none in moab driver since it doesn't yet support cart3d. --- driver-moab/cime_config/config_component.xml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/driver-moab/cime_config/config_component.xml b/driver-moab/cime_config/config_component.xml index 6a443eac57dd..5336a1860005 100644 --- a/driver-moab/cime_config/config_component.xml +++ b/driver-moab/cime_config/config_component.xml @@ -2065,7 +2065,7 @@ char none,npfix,cart3d,cart3d_diag,cart3d_uvw,cart3d_uvw_diag - cart3d + none run_domain env_run.xml vector mapping option From 84fde9023fe6a484efe2c7b8abcc380dc5815230 Mon Sep 17 00:00:00 2001 From: iulian07 Date: Wed, 11 Oct 2023 00:48:43 -0500 Subject: [PATCH 430/467] cherry-pick branch compare_restart_states commit d7a00bb4412238964564530b3c481764050e3549 moab arrays need moab local sizes commit 387a5aafab84a4296b72cffacb4cb92b7666d03b allocate accumulated x2o during init the matrix has to be allocated for restart to work correctly commit 7cf98dd58cb6018f94e84d7df6d206c555e09979 size of the arrays can be 0 gnu does not like 0 sized arrays intel is more forgiving also, maybe we need to redistribute lnd domain, to not allow empty partitions commit 10df494851b9836dee076c56b69c4d95dcafd74b commit b6dd082ad82e8ac3 write before and after states for debugging --- driver-moab/main/cime_comp_mod.F90 | 25 +++++++-- driver-moab/main/prep_ocn_mod.F90 | 35 ++++++++---- driver-moab/main/seq_io_mod.F90 | 86 ++++++++++++++++++------------ driver-moab/main/seq_rest_mod.F90 | 74 ++++++++++++++++++++++++- 4 files changed, 169 insertions(+), 51 deletions(-) diff --git a/driver-moab/main/cime_comp_mod.F90 b/driver-moab/main/cime_comp_mod.F90 index 6813042b4f23..3b6690e44842 100644 --- a/driver-moab/main/cime_comp_mod.F90 +++ b/driver-moab/main/cime_comp_mod.F90 @@ -127,6 +127,9 @@ module cime_comp_mod ! restart file routines use seq_rest_mod, only : seq_rest_read, seq_rest_mb_read, seq_rest_write, seq_rest_mb_write +#ifdef MOABDEBUG + use seq_rest_mod, only : write_moab_state +#endif ! flux calc routines use seq_flux_mct, only: seq_flux_init_mct, seq_flux_initexch_mct, seq_flux_ocnalb_mct @@ -2521,10 +2524,16 @@ subroutine cime_init() fractions_ax, fractions_lx, fractions_ix, fractions_ox, & fractions_rx, fractions_gx, fractions_wx, fractions_zx) call t_stopf('CPL:seq_rest_read-init') - + if (iamroot_CPLID) then + write(logunit,103) subname,' Reading moab restart file ','moab_'//trim(rest_file) + call shr_sys_flush(logunit) + end if call t_startf('CPL:seq_rest_read-moab') - call seq_rest_mb_read(rest_file, infodata, samegrid_al) + call seq_rest_mb_read(rest_file, infodata, samegrid_al) call t_stopf('CPL:seq_rest_read-moab') +#ifdef MOABDEBUG + call write_moab_state(.false.) +#endif endif @@ -3487,10 +3496,8 @@ subroutine cime_run() call shr_sys_flush(logunit) end if if (iamin_CPLID) then - call cime_comp_barriers(mpicom=mpicom_CPLID, timer='CPL:RESTART_READ_BARRIER') call t_drvstartf ('CPL:RESTART_READ',cplrun=.true.,barrier=mpicom_CPLID) - call t_startf('CPL:seq_rest_read') call seq_rest_read(drv_resume_file, infodata, & atm, lnd, ice, ocn, rof, glc, wav, esp, iac, & @@ -3500,6 +3507,13 @@ subroutine cime_run() call t_drvstopf ('CPL:RESTART_READ',cplrun=.true.) + if (iamroot_CPLID) then + write(logunit,103) subname,' resume by moab restart file ','moab_'//trim(drv_resume_file) + call shr_sys_flush(logunit) + end if + call t_startf('CPL:seq_rest_read-moab') + call seq_rest_mb_read(drv_resume_file, infodata, samegrid_al) + call t_stopf('CPL:seq_rest_read-moab') end if ! Clear the resume file so we don't try to read it again drv_resume = .FALSE. @@ -5351,6 +5365,9 @@ subroutine cime_run_write_restart(drv_pause, write_restart, drv_resume_file) trim(cpl_inst_tag), drv_resume_file) call t_stopf('CPL:seq_rest_write') +#ifdef MOABDEBUG + call write_moab_state( .true. ) +#endif call t_startf('CPL:seq_rest_mb_write') call seq_rest_mb_write(EClock_d, seq_SyncClock, infodata, & atm, lnd, ice, ocn, rof, glc, wav, esp, iac, & diff --git a/driver-moab/main/prep_ocn_mod.F90 b/driver-moab/main/prep_ocn_mod.F90 index 5e661a4babd0..ff3beeca4bae 100644 --- a/driver-moab/main/prep_ocn_mod.F90 +++ b/driver-moab/main/prep_ocn_mod.F90 @@ -80,6 +80,7 @@ module prep_ocn_mod public :: prep_ocn_get_x2oacc_ox public :: prep_ocn_get_x2oacc_ox_cnt + public :: prep_ocn_get_x2oacc_om ! will return a pointer to the local private matrix public :: prep_ocn_get_x2oacc_om_cnt #ifdef SUMMITDEV_PGI ! Sarat: Dummy variable added to workaround PGI compiler bug (PGI 17.9) as of Oct 23, 2017 @@ -99,8 +100,6 @@ module prep_ocn_mod public :: prep_ocn_get_mapper_Fg2o public :: prep_ocn_get_mapper_Sw2o - public :: prep_ocn_get_x2oacc_om ! will return a pointer to the local private matrix ? is that correct ? - !-------------------------------------------------------------------------- ! Private interfaces !-------------------------------------------------------------------------- @@ -265,10 +264,11 @@ subroutine prep_ocn_init(infodata, atm_c2_ocn, atm_c2_ice, ice_c2_ocn, rof_c2_oc integer :: rank_on_cpl ! just for debugging ! these are just to zero out r2x fields on ocean integer nvert(3), nvise(3), nbl(3), nsurf(3), nvisBC(3) ! for moab info - integer mlsize ! moab land size + integer mlsize ! moab local ocean size integer nrflds ! number of rof fields projected on land integer arrsize ! for setting the r2x fields on land to 0 integer ent_type ! for setting tags + integer noflds ! used for number of fields in allocating moab accumulated array x2oacc_om real (kind=r8) , allocatable :: tmparray (:) ! used to set the r2x fields to 0 !--------------------------------------------------------------- @@ -361,7 +361,26 @@ subroutine prep_ocn_init(infodata, atm_c2_ocn, atm_c2_ice, ice_c2_ocn, rof_c2_oc end do x2oacc_ox_cnt = 0 - ! moab accumulation variable is allocated first time when we enter merge routine + ! moab accumulation variable has to be allocated here too, because restart needs it + ! it resulted in unexpected crashes, because we were allocating it only + ! during "first_time" entering merge routine; this was wrong + ! allocate accumulation variable , parallel to x2o_om + noflds = mct_aVect_nRattr(x2o_ox) ! these are saved after first time + ! size of the x2oacc_om depends on the size of the ocean mesh locally + + ! find out the number of local elements in moab mesh ocean instance on coupler + ierr = iMOAB_GetMeshInfo ( mboxid, nvert, nvise, nbl, nsurf, nvisBC ) + if (ierr .ne. 0) then + write(logunit,*) subname,' cant get size of ocn mesh' + call shr_sys_abort(subname//' ERROR in getting size of ocn mesh') + endif + ! ocn is cell mesh on coupler side + mlsize = nvise(1) + allocate(x2oacc_om(mlsize, noflds)) + x2oacc_om_cnt = 0 + x2oacc_om(:,:)=0. + + ! moab accumulation variable samegrid_ao = .true. samegrid_ro = .true. @@ -1302,13 +1321,7 @@ subroutine prep_ocn_mrg_moab(infodata, xao_ox) !ngflds = mct_aVect_nRattr(g2x_o) allocate(x2o_om (lsize, noflds)) - ! allocate accumulation variable , parallel to x2o_om - allocate(x2oacc_om(lsize, noflds)) - arrSize_x2o_om = lsize * noflds ! this willbe used to set/get x2o_om tags - x2oacc_om_cnt = 0 - x2oacc_om(:,:)=0. - - ! moab accumulation variable + arrSize_x2o_om = lsize * noflds ! this willbe used to set/get x2o_om tags allocate(a2x_om (lsize, naflds)) allocate(i2x_om (lsize, niflds)) allocate(r2x_om (lsize, nrflds)) diff --git a/driver-moab/main/seq_io_mod.F90 b/driver-moab/main/seq_io_mod.F90 index c551e118578a..824d5e3c980b 100644 --- a/driver-moab/main/seq_io_mod.F90 +++ b/driver-moab/main/seq_io_mod.F90 @@ -1687,24 +1687,25 @@ subroutine seq_io_write_moab_tags(filename, mbxid, dname, tag_list, whead,wdata, allocate(data_reorder(ns)) allocate(dof(ns)) allocate(dof_reorder(ns)) + allocate(indx(ns)) ! note: size of dof is ns - tagname = 'GLOBAL_ID'//C_NULL_CHAR - ierr = iMOAB_GetIntTagStorage ( mbxid, tagname, ns , ent_type, dof(1)) - if (ierr .ne. 0) then - write(logunit,*) subname,' ERROR: cannot get dofs ' - call shr_sys_abort(subname//'cannot get dofs ') - endif - - allocate(indx(ns)) - call IndexSet(ns, indx) - call IndexSort(ns, indx, dof, descend=.false.) - ! after sort, dof( indx(i)) < dof( indx(i+1) ) - do ix=1,ns - dof_reorder(ix) = dof(indx(ix)) ! - enddo - ! so we know that dof_reorder(ix) < dof_reorder(ix+1) + if (ns > 0) then + tagname = 'GLOBAL_ID'//C_NULL_CHAR + ierr = iMOAB_GetIntTagStorage ( mbxid, tagname, ns , ent_type, dof(1)) + if (ierr .ne. 0) then + write(logunit,*) subname,' ERROR: cannot get dofs ' + call shr_sys_abort(subname//'cannot get dofs ') + endif + call IndexSet(ns, indx) + call IndexSort(ns, indx, dof, descend=.false.) + ! after sort, dof( indx(i)) < dof( indx(i+1) ) + do ix=1,ns + dof_reorder(ix) = dof(indx(ix)) ! + enddo + ! so we know that dof_reorder(ix) < dof_reorder(ix+1) + endif call pio_initdecomp(cpl_io_subsystem, pio_double, (/lnx,lny/), dof_reorder, iodesc) deallocate(dof) @@ -1718,13 +1719,17 @@ subroutine seq_io_write_moab_tags(filename, mbxid, dname, tag_list, whead,wdata, rcode = pio_inq_varid(cpl_io_file(lfile_ind),trim(name1),varid) !call pio_setframe(cpl_io_file(lfile_ind),varid,frame) if (present(matrix)) then - data1(:) = matrix(:, index_list) ! + do ix = 1, ns + data1(ix) = matrix(ix, index_list) ! + enddo else tagname = trim(field)//C_NULL_CHAR - ierr = iMOAB_GetDoubleTagStorage (mbxid, tagname, ns , ent_type, data1(1)) - if (ierr .ne. 0) then - write(logunit,*) subname,' ERROR: cannot get tag data ', trim(tagname) - call shr_sys_abort(subname//'cannot get tag data ') + if (ns > 0 ) then + ierr = iMOAB_GetDoubleTagStorage (mbxid, tagname, ns , ent_type, data1(1)) + if (ierr .ne. 0) then + write(logunit,*) subname,' ERROR: cannot get tag data ', trim(tagname) + call shr_sys_abort(subname//'cannot get tag data ') + endif endif endif do ix=1,ns @@ -2586,12 +2591,13 @@ subroutine seq_io_read_moab_tags(filename, mbxid, dname, tag_list, matrix, nx) ! note: size of dof is ns tagname = 'GLOBAL_ID'//C_NULL_CHAR - ierr = iMOAB_GetIntTagStorage ( mbxid, tagname, ns , ent_type, dof(1)) - if (ierr .ne. 0) then - write(logunit,*) subname,' ERROR: cannot get dofs ' - call shr_sys_abort(subname//'cannot get dofs ') + if (ns > 0 ) then + ierr = iMOAB_GetIntTagStorage ( mbxid, tagname, ns , ent_type, dof(1)) + if (ierr .ne. 0) then + write(logunit,*) subname,' ERROR: cannot get dofs ' + call shr_sys_abort(subname//'cannot get dofs ') + endif endif - #ifdef MOABCOMP if (iam==0) write(logunit,*) subname, ' dofs on iam=0: ', dof #endif @@ -2646,13 +2652,18 @@ subroutine seq_io_read_moab_tags(filename, mbxid, dname, tag_list, matrix, nx) endif #endif if (present(matrix)) then - matrix(:, index_list) = data_reorder(:) ! + !matrix(:, index_list) = data_reorder(:) ! + do ix = 1,ns + matrix(ix, index_list) = data_reorder(ix) ! + enddo else tagname = trim(field)//C_NULL_CHAR - ierr = iMOAB_SetDoubleTagStorage (mbxid, tagname, ns , ent_type, data_reorder(1)) - if (ierr .ne. 0) then - write(logunit,*) subname,' ERROR: cannot set tag data ', trim(tagname) - call shr_sys_abort(subname//'cannot set tag data ') + if (ns > 0) then + ierr = iMOAB_SetDoubleTagStorage (mbxid, tagname, ns , ent_type, data_reorder(1)) + if (ierr .ne. 0) then + write(logunit,*) subname,' ERROR: cannot set tag data ', trim(tagname) + call shr_sys_abort(subname//'cannot set tag data ') + endif endif endif ! n = 0 @@ -2670,13 +2681,18 @@ subroutine seq_io_read_moab_tags(filename, mbxid, dname, tag_list, matrix, nx) ! enddo data_reorder = 0. if (present(matrix)) then - matrix(:, index_list) = data_reorder(:) ! + ! matrix(:, index_list) = data_reorder(:) ! + do ix = 1,ns + matrix(ix, index_list) = data_reorder(ix) ! + enddo else tagname = trim(field)//C_NULL_CHAR - ierr = iMOAB_SetDoubleTagStorage (mbxid, tagname, ns , ent_type, data_reorder(1)) - if (ierr .ne. 0) then - write(logunit,*) subname,' ERROR: cannot set tag data ', trim(tagname) - call shr_sys_abort(subname//'cannot set tag data ') + if ( ns > 0 ) then + ierr = iMOAB_SetDoubleTagStorage (mbxid, tagname, ns , ent_type, data_reorder(1)) + if (ierr .ne. 0) then + write(logunit,*) subname,' ERROR: cannot set tag data ', trim(tagname) + call shr_sys_abort(subname//'cannot set tag data ') + endif endif endif diff --git a/driver-moab/main/seq_rest_mod.F90 b/driver-moab/main/seq_rest_mod.F90 index 2961d7747f5c..0e38ade4b645 100644 --- a/driver-moab/main/seq_rest_mod.F90 +++ b/driver-moab/main/seq_rest_mod.F90 @@ -54,6 +54,7 @@ module seq_rest_mod use prep_ocn_mod, only: prep_ocn_get_x2oacc_ox use prep_ocn_mod, only: prep_ocn_get_x2oacc_ox_cnt ! moab version + use prep_ocn_mod, only: prep_ocn_get_x2oacc_om use prep_ocn_mod, only: prep_ocn_get_x2oacc_om_cnt #ifdef SUMMITDEV_PGI use prep_ocn_mod, only: dummy_pgibugfix @@ -75,7 +76,6 @@ module seq_rest_mod use seq_flds_mod, only: seq_flds_a2x_fields, seq_flds_xao_fields, seq_flds_o2x_fields, seq_flds_x2o_fields use seq_flds_mod, only: seq_flds_i2x_fields, seq_flds_r2x_fields - use prep_ocn_mod, only: prep_ocn_get_x2oacc_om use prep_rof_mod, only: prep_rof_get_o2racc_om ! return a pointer to a moab matrix use prep_rof_mod, only: prep_rof_get_l2racc_lm_cnt @@ -96,6 +96,10 @@ module seq_rest_mod public :: seq_rest_write ! write cpl7 restart data public :: seq_rest_mb_write ! read cpl7_moab restart data +#ifdef MOABDEBUG + public :: write_moab_state ! debug, write files +#endif + ! !PUBLIC DATA MEMBERS: ! no public data @@ -1337,4 +1341,72 @@ subroutine seq_rest_mb_write(EClock_d, seq_SyncClock, infodata, & end subroutine seq_rest_mb_write !=============================================================================== +#ifdef MOABDEBUG + subroutine write_moab_state ( before_reading ) ! debug, write files + use seq_comm_mct, only: mbaxid, mbixid, mboxid, mblxid, mbrxid, mbofxid ! coupler side instances + use iso_c_binding + use iMOAB, only: iMOAB_WriteMesh + + implicit none + + type(logical) , intent(in) :: before_reading ! driver clock + character*32 :: outfile, wopts, prefx + integer ierr; + character(len=*),parameter :: subname = "(write_moab_state) " + + prefx = 'After_' + wopts = ';PARALLEL=WRITE_PART'//C_NULL_CHAR ! + if ( before_reading ) prefx = 'Before_' + if (mbrxid .ge. 0 ) then ! we are on coupler pes, for sure + outfile = trim(prefx)//'RofCpl.h5m'//C_NULL_CHAR + ierr = iMOAB_WriteMesh(mbrxid, trim(outfile), trim(wopts)) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in writing rofx file ' + call shr_sys_abort(subname//' ERROR in writing rofx file ') + endif + endif + if (mbaxid .ge. 0 ) then ! we are on coupler pes, for sure + outfile = trim(prefx)//'AtmCpl.h5m'//C_NULL_CHAR + ierr = iMOAB_WriteMesh(mbaxid, trim(outfile), trim(wopts)) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in writing atmx file ' + call shr_sys_abort(subname//' ERROR in writing atmx file ') + endif + endif + if (mbixid .ge. 0 ) then ! we are on coupler pes, for sure + outfile = trim(prefx)//'IceCpl.h5m'//C_NULL_CHAR + ierr = iMOAB_WriteMesh(mbixid, trim(outfile), trim(wopts)) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in writing icex file ' + call shr_sys_abort(subname//' ERROR in writing icex file ') + endif + endif + if (mboxid .ge. 0 ) then ! we are on coupler pes, for sure + outfile = trim(prefx)//'OcnCpl.h5m'//C_NULL_CHAR + ierr = iMOAB_WriteMesh(mboxid, trim(outfile), trim(wopts)) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in writing ocnx file ' + call shr_sys_abort(subname//' ERROR in writing ocnx file ') + endif + endif + if (mblxid .ge. 0 ) then ! we are on coupler pes, for sure + outfile = trim(prefx)//'LndCpl.h5m'//C_NULL_CHAR + ierr = iMOAB_WriteMesh(mblxid, trim(outfile), trim(wopts)) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in writing lndx file ' + call shr_sys_abort(subname//' ERROR in writing lndx file ') + endif + endif + if (mbofxid .ge. 0 ) then ! we are on coupler pes, for sure + outfile = trim(prefx)//'OcnExCpl.h5m'//C_NULL_CHAR + ierr = iMOAB_WriteMesh(mbofxid, trim(outfile), trim(wopts)) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in writing ocnextra file ' + call shr_sys_abort(subname//' ERROR in writing ocnextra file ') + endif + endif + + end subroutine write_moab_state +#endif + end module seq_rest_mod From 26139d17e755e252311e570d9809e92dc08edaac Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Thu, 12 Oct 2023 13:04:53 -0500 Subject: [PATCH 431/467] add MOAB_ROOT on anlgce machine --- cime_config/machines/config_machines.xml | 1 + 1 file changed, 1 insertion(+) diff --git a/cime_config/machines/config_machines.xml b/cime_config/machines/config_machines.xml index cbd76983245d..e682cae3105b 100644 --- a/cime_config/machines/config_machines.xml +++ b/cime_config/machines/config_machines.xml @@ -1804,6 +1804,7 @@ /nfs/gce/projects/climate/software/linux-ubuntu20.04-x86_64/hdf5/1.12.1/mpich-4.0/gcc-11.1.0 /nfs/gce/projects/climate/software/linux-ubuntu20.04-x86_64/netcdf/4.8.0c-4.3.1cxx-4.5.3f-parallel/mpich-4.0/gcc-11.1.0 /nfs/gce/projects/climate/software/linux-ubuntu20.04-x86_64/pnetcdf/1.12.2/mpich-4.0/gcc-11.1.0 + $SHELL{if [ -z "$MOAB_ROOT" ]; then echo /nfs/gce/projects/climate/software/moab/devel/mpich-4.0/gcc-11.1.0; else echo "$MOAB_ROOT"; fi} From a62b55386e4b29b0a4681b348c0b7f08f234cb36 Mon Sep 17 00:00:00 2001 From: Robert Jacob Date: Sat, 14 Oct 2023 15:22:21 -0500 Subject: [PATCH 432/467] Update MOAB locations on chrysalis Update MOAB locations on chrysalis for gnu and intel. --- cime_config/machines/cmake_macros/gnu_chrysalis.cmake | 1 + cime_config/machines/cmake_macros/intel_chrysalis.cmake | 2 +- cime_config/machines/config_machines.xml | 3 ++- 3 files changed, 4 insertions(+), 2 deletions(-) diff --git a/cime_config/machines/cmake_macros/gnu_chrysalis.cmake b/cime_config/machines/cmake_macros/gnu_chrysalis.cmake index 4480fcf50692..f6b22fb9d209 100644 --- a/cime_config/machines/cmake_macros/gnu_chrysalis.cmake +++ b/cime_config/machines/cmake_macros/gnu_chrysalis.cmake @@ -2,5 +2,6 @@ if (COMP_NAME STREQUAL gptl) string(APPEND CPPDEFS " -DHAVE_NANOTIME -DBIT64 -DHAVE_SLASHPROC -DHAVE_GETTIMEOFDAY") endif() set(PIO_FILESYSTEM_HINTS "gpfs") +set(MOAB_PATH "/lcrc/soft/climate/moab/chrysalis/gnu") string(APPEND SLIBS " -Wl,--start-group $ENV{MKLROOT}/lib/intel64/libmkl_gf_lp64.a $ENV{MKLROOT}/lib/intel64/libmkl_sequential.a $ENV{MKLROOT}/lib/intel64/libmkl_core.a -Wl,--end-group -lpthread -lm -ldl") string(APPEND CXX_LIBS " -lstdc++") diff --git a/cime_config/machines/cmake_macros/intel_chrysalis.cmake b/cime_config/machines/cmake_macros/intel_chrysalis.cmake index 9c3fec021f21..b27bec3edc9e 100644 --- a/cime_config/machines/cmake_macros/intel_chrysalis.cmake +++ b/cime_config/machines/cmake_macros/intel_chrysalis.cmake @@ -17,7 +17,7 @@ if (NOT DEBUG) string(APPEND FFLAGS " -O3 -qno-opt-dynamic-align") endif() set(PIO_FILESYSTEM_HINTS "gpfs") -set(MOAB_PATH "/lcrc/soft/climate/moab/chrysalis/intelSep22") +set(MOAB_PATH "/lcrc/soft/climate/moab/chrysalis/intel") string(APPEND SLIBS " -mkl") string(APPEND LDFLAGS " -static-intel") if (MPILIB STREQUAL impi) diff --git a/cime_config/machines/config_machines.xml b/cime_config/machines/config_machines.xml index e682cae3105b..35ff880c8ccb 100644 --- a/cime_config/machines/config_machines.xml +++ b/cime_config/machines/config_machines.xml @@ -2226,7 +2226,6 @@ $SHELL{dirname $(dirname $(which nc-config))} $SHELL{dirname $(dirname $(which nf-config))} $SHELL{dirname $(dirname $(which pnetcdf_version))} - $SHELL{if [ -z "$MOAB_ROOT" ]; then echo /lcrc/soft/climate/moab/chrysalis/intelSep22; else echo "$MOAB_ROOT"; fi} 128M @@ -2242,9 +2241,11 @@ $SHELL{if [ -z "$ADIOS2_ROOT" ]; then echo /lcrc/group/e3sm/3rdparty/chrysalis/adios2/2.8.3.patch/openmpi-4.1.3/intel-20.0.4; else echo "$ADIOS2_ROOT"; fi} + $SHELL{if [ -z "$MOAB_ROOT" ]; then echo /lcrc/soft/climate/moab/chrysalis/intel; else echo "$MOAB_ROOT"; fi} $SHELL{if [ -z "$ADIOS2_ROOT" ]; then echo /lcrc/group/e3sm/3rdparty/chrysalis/adios2/2.8.3.patch/openmpi-4.1.3/gcc-9.2.0; else echo "$ADIOS2_ROOT"; fi} + $SHELL{if [ -z "$MOAB_ROOT" ]; then echo /lcrc/soft/climate/moab/chrysalis/gnu; else echo "$MOAB_ROOT"; fi} $SHELL{if [ -z "$ADIOS2_ROOT" ]; then echo /lcrc/group/e3sm/3rdparty/chrysalis/adios2/2.8.3.patch/intel-mpi-2019.9.304/intel-20.0.4; else echo "$ADIOS2_ROOT"; fi} From 68bf4ff5f08382677371162483d5448e43c9e947 Mon Sep 17 00:00:00 2001 From: Robert Jacob Date: Tue, 17 Oct 2023 13:39:31 -0500 Subject: [PATCH 433/467] Remove Sa_topo from MOAB coupler Remove Sa_topo from field list in moab coupler. Was not initialized by EAM or used by ELM. init=snan debugging caught this. --- driver-moab/main/cime_comp_mod.F90 | 2 +- driver-moab/shr/seq_flds_mod.F90 | 9 --------- 2 files changed, 1 insertion(+), 10 deletions(-) diff --git a/driver-moab/main/cime_comp_mod.F90 b/driver-moab/main/cime_comp_mod.F90 index 3b6690e44842..523ff8bf6666 100644 --- a/driver-moab/main/cime_comp_mod.F90 +++ b/driver-moab/main/cime_comp_mod.F90 @@ -568,7 +568,7 @@ module cime_comp_mod 'Sa_u:Sa_v' character(CL) :: hist_a2x3hr_flds = & - 'Sa_z:Sa_topo:Sa_u:Sa_v:Sa_tbot:Sa_ptem:Sa_shum:Sa_dens:Sa_pbot:Sa_pslv:Faxa_lwdn:& + 'Sa_z:Sa_u:Sa_v:Sa_tbot:Sa_ptem:Sa_shum:Sa_dens:Sa_pbot:Sa_pslv:Faxa_lwdn:& &Faxa_rainc:Faxa_rainl:Faxa_snowc:Faxa_snowl:& &Faxa_swndr:Faxa_swvdr:Faxa_swndf:Faxa_swvdf:& &Sa_co2diag:Sa_co2prog' diff --git a/driver-moab/shr/seq_flds_mod.F90 b/driver-moab/shr/seq_flds_mod.F90 index 4c7a76626b4f..15a53b0f7f76 100644 --- a/driver-moab/shr/seq_flds_mod.F90 +++ b/driver-moab/shr/seq_flds_mod.F90 @@ -644,15 +644,6 @@ subroutine seq_flds_set(nmlfile, ID, infodata) attname = 'Sa_z' call metadata_set(attname, longname, stdname, units) - ! topographic height (m) - call seq_flds_add(a2x_states,"Sa_topo") - call seq_flds_add(x2l_states,"Sa_topo") - longname = 'Surface height' - stdname = 'height' - units = 'm' - attname = 'Sa_topo' - call metadata_set(attname, longname, stdname, units) - ! zonal wind at the lowest model level (m/s) call seq_flds_add(a2x_states,"Sa_u") call seq_flds_add(x2l_states,"Sa_u") From 8622d5d429c7ece92050f9a2fd2a1fd0fb9f3aca Mon Sep 17 00:00:00 2001 From: Robert Jacob Date: Tue, 17 Oct 2023 13:51:40 -0500 Subject: [PATCH 434/467] Set Sa_uovern in moab export routine Set Sa_uovern in moab export routine. Make sure it always has a value. --- components/eam/src/cpl/atm_comp_mct.F90 | 9 ++++++++- 1 file changed, 8 insertions(+), 1 deletion(-) diff --git a/components/eam/src/cpl/atm_comp_mct.F90 b/components/eam/src/cpl/atm_comp_mct.F90 index e5141869d473..2c739dab169b 100644 --- a/components/eam/src/cpl/atm_comp_mct.F90 +++ b/components/eam/src/cpl/atm_comp_mct.F90 @@ -1355,7 +1355,14 @@ subroutine atm_export_moab(cam_out) a2x_am(ig, index_a2x_Sa_ptem ) = cam_out(c)%thbot(i) a2x_am(ig, index_a2x_Sa_pbot ) = cam_out(c)%pbot(i) a2x_am(ig, index_a2x_Sa_shum ) = cam_out(c)%qbot(i,1) - a2x_am(ig, index_a2x_Sa_dens ) = cam_out(c)%rho(i) + a2x_am(ig, index_a2x_Sa_dens ) = cam_out(c)%rho(i) + if (trim(adjustl(precip_downscaling_method)) == "FNM") then + !if the land model's precip downscaling method is FNM, export uovern to the coupler + a2x_am(ig, index_a2x_Sa_uovern) = cam_out(c)%uovern(i) + else + a2x_am(ig, index_a2x_Sa_uovern) = 0._R8 + endif + a2x_am(ig, index_a2x_Faxa_swnet) = cam_out(c)%netsw(i) a2x_am(ig, index_a2x_Faxa_lwdn ) = cam_out(c)%flwds(i) a2x_am(ig, index_a2x_Faxa_rainc) = (cam_out(c)%precc(i)-cam_out(c)%precsc(i))*1000._r8 From ce9b5cc9222a66662810d24b1c4c904bd0b7347c Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Tue, 17 Oct 2023 18:33:59 -0500 Subject: [PATCH 435/467] remove serwal cmake files --- .../machines/cmake_macros/serwal76spack.cmake | 17 ----------------- .../machines/cmake_macros/serwal76spack20.cmake | 17 ----------------- 2 files changed, 34 deletions(-) delete mode 100644 cime_config/machines/cmake_macros/serwal76spack.cmake delete mode 100644 cime_config/machines/cmake_macros/serwal76spack20.cmake diff --git a/cime_config/machines/cmake_macros/serwal76spack.cmake b/cime_config/machines/cmake_macros/serwal76spack.cmake deleted file mode 100644 index 28f23dc8bba8..000000000000 --- a/cime_config/machines/cmake_macros/serwal76spack.cmake +++ /dev/null @@ -1,17 +0,0 @@ -if (NOT DEBUG) - string(APPEND CFLAGS " -O2") -endif() -string(APPEND CXX_LIBS " -lstdc++") -if (NOT DEBUG) - string(APPEND FFLAGS " -O2") -endif() -# string(APPEND FFLAGS " -fallow-argument-mismatch -fallow-invalid-boz") -execute_process(COMMAND $ENV{NETCDF_FORTRAN_PATH}/bin/nf-config --flibs OUTPUT_VARIABLE SHELL_CMD_OUTPUT_BUILD_INTERNAL_IGNORE0 OUTPUT_STRIP_TRAILING_WHITESPACE) -execute_process(COMMAND $ENV{NETCDF_C_PATH}/bin/nc-config --libs OUTPUT_VARIABLE SHELL_CMD_OUTPUT_BUILD_INTERNAL_IGNORE1 OUTPUT_STRIP_TRAILING_WHITESPACE) -string(APPEND SLIBS " ${SHELL_CMD_OUTPUT_BUILD_INTERNAL_IGNORE0} ${SHELL_CMD_OUTPUT_BUILD_INTERNAL_IGNORE1} -lblas -llapack") -set(NETCDF_C_PATH "$ENV{NETCDF_C_PATH}") -set(NETCDF_FORTRAN_PATH "$ENV{NETCDF_FORTRAN_PATH}") -set(PNETCDF_PATH "$ENV{PNETCDF_PATH}") -set(HDF5_PATH "$ENV{HDF5_PATH}") -set(ZLIB_PATH "$ENV{ZLIB_PATH}") -set(MOAB_PATH "/home/iulian/lib/moab/spack") diff --git a/cime_config/machines/cmake_macros/serwal76spack20.cmake b/cime_config/machines/cmake_macros/serwal76spack20.cmake deleted file mode 100644 index fa132ee19941..000000000000 --- a/cime_config/machines/cmake_macros/serwal76spack20.cmake +++ /dev/null @@ -1,17 +0,0 @@ -if (NOT DEBUG) - string(APPEND CFLAGS " -O2") -endif() -string(APPEND CXX_LIBS " -lstdc++") -if (NOT DEBUG) - string(APPEND FFLAGS " -O2") -endif() -# string(APPEND FFLAGS " -fallow-argument-mismatch -fallow-invalid-boz") -execute_process(COMMAND $ENV{NETCDF_FORTRAN_PATH}/bin/nf-config --flibs OUTPUT_VARIABLE SHELL_CMD_OUTPUT_BUILD_INTERNAL_IGNORE0 OUTPUT_STRIP_TRAILING_WHITESPACE) -execute_process(COMMAND $ENV{NETCDF_C_PATH}/bin/nc-config --libs OUTPUT_VARIABLE SHELL_CMD_OUTPUT_BUILD_INTERNAL_IGNORE1 OUTPUT_STRIP_TRAILING_WHITESPACE) -string(APPEND SLIBS " ${SHELL_CMD_OUTPUT_BUILD_INTERNAL_IGNORE0} ${SHELL_CMD_OUTPUT_BUILD_INTERNAL_IGNORE1} -lblas -llapack") -set(NETCDF_C_PATH "$ENV{NETCDF_C_PATH}") -set(NETCDF_FORTRAN_PATH "$ENV{NETCDF_FORTRAN_PATH}") -set(PNETCDF_PATH "$ENV{PNETCDF_PATH}") -set(HDF5_PATH "$ENV{HDF5_PATH}") -set(ZLIB_PATH "$ENV{ZLIB_PATH}") -set(MOAB_PATH "/home/iulian/lib/moab/spack20") From cb830212c119d585d786ff0036ed5ef7b015df95 Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Thu, 19 Oct 2023 10:36:21 -0500 Subject: [PATCH 436/467] replace array references instaead of tmparray(1) it is enough to pass tmparray --- driver-moab/main/component_mod.F90 | 14 +++++++------- driver-moab/main/prep_atm_mod.F90 | 14 +++++++------- driver-moab/main/prep_ice_mod.F90 | 8 ++++---- driver-moab/main/prep_lnd_mod.F90 | 2 +- driver-moab/main/prep_ocn_mod.F90 | 20 ++++++++++---------- driver-moab/main/prep_rof_mod.F90 | 22 +++++++++++----------- driver-moab/main/seq_io_mod.F90 | 10 +++++----- driver-moab/main/seq_map_mod.F90 | 10 +++++----- driver-moab/main/seq_rest_mod.F90 | 4 ++-- 9 files changed, 52 insertions(+), 52 deletions(-) diff --git a/driver-moab/main/component_mod.F90 b/driver-moab/main/component_mod.F90 index 203034b1bb98..eaff95f2ae13 100644 --- a/driver-moab/main/component_mod.F90 +++ b/driver-moab/main/component_mod.F90 @@ -698,7 +698,7 @@ subroutine component_init_areacor_moab (comp, mbccid, mbcxid, seq_flds_c2x_fluxe ! get areas tagname='area:aream:mask'//C_NULL_CHAR arrsize = 3 * lsize - ierr = iMOAB_GetDoubleTagStorage ( mbccid, tagname, arrsize , comp(1)%mbGridType, areas(1,1) ) + ierr = iMOAB_GetDoubleTagStorage ( mbccid, tagname, arrsize , comp(1)%mbGridType, areas ) if (ierr .ne. 0) then call shr_sys_abort(subname//' cannot get areas ') endif @@ -730,7 +730,7 @@ subroutine component_init_areacor_moab (comp, mbccid, mbcxid, seq_flds_c2x_fluxe call shr_sys_abort(subname//' cannot define correction tags') endif arrsize = 2 * lsize - ierr = iMOAB_SetDoubleTagStorage( mbccid, tagname, arrsize , comp(1)%mbGridType, factors(1,1)) + ierr = iMOAB_SetDoubleTagStorage( mbccid, tagname, arrsize , comp(1)%mbGridType, factors) if (ierr .ne. 0) then call shr_sys_abort(subname//' cannot set correction area factors ') endif @@ -747,7 +747,7 @@ subroutine component_init_areacor_moab (comp, mbccid, mbcxid, seq_flds_c2x_fluxe allocate(vals(lsize, nfields)) tagname = trim(seq_flds_c2x_fluxes)//C_NULL_CHAR arrsize = lsize * nfields - ierr = iMOAB_GetDoubleTagStorage( mbccid, tagname, arrsize , comp(1)%mbGridType, vals(1,1)) + ierr = iMOAB_GetDoubleTagStorage( mbccid, tagname, arrsize , comp(1)%mbGridType, vals) if (ierr .ne. 0) then call shr_sys_abort(subname//' cannot get flux values ') endif @@ -761,7 +761,7 @@ subroutine component_init_areacor_moab (comp, mbccid, mbcxid, seq_flds_c2x_fluxe enddo endif enddo - ierr = iMOAB_SetDoubleTagStorage( mbccid, tagname, arrsize , comp(1)%mbGridType, vals(1,1)) + ierr = iMOAB_SetDoubleTagStorage( mbccid, tagname, arrsize , comp(1)%mbGridType, vals) if (ierr .ne. 0) then call shr_sys_abort(subname//' cannot set new flux values ') endif @@ -1243,14 +1243,14 @@ subroutine factor_moab_comp(comp, type, seq_flds_fluxes) ! get factors tagname = trim(type)//C_NULL_CHAR arrsize = comp%mblsize - ierr = iMOAB_GetDoubleTagStorage( comp%mbApCCid, tagname, arrsize , comp%mbGridType, factors(1)) + ierr = iMOAB_GetDoubleTagStorage( comp%mbApCCid, tagname, arrsize , comp%mbGridType, factors) if (ierr .ne. 0) then call shr_sys_abort(subname//' cannot get factors ' //trim(type)) endif ! get vals, multiply, then reset them again tagname = trim(seq_flds_fluxes)//C_NULL_CHAR arrsize = comp%mblsize * nfields - ierr = iMOAB_GetDoubleTagStorage( comp%mbApCCid, tagname, arrsize , comp%mbGridType, vals(1,1)) + ierr = iMOAB_GetDoubleTagStorage( comp%mbApCCid, tagname, arrsize , comp%mbGridType, vals) if (ierr .ne. 0) then call shr_sys_abort(subname//' cannot get fluxes ' //trim(type)) endif @@ -1260,7 +1260,7 @@ subroutine factor_moab_comp(comp, type, seq_flds_fluxes) enddo enddo - ierr = iMOAB_SetDoubleTagStorage( comp%mbApCCid, tagname, arrsize , comp%mbGridType, vals(1,1)) + ierr = iMOAB_SetDoubleTagStorage( comp%mbApCCid, tagname, arrsize , comp%mbGridType, vals) if (ierr .ne. 0) then call shr_sys_abort(subname//' cannot set fluxes back ' //trim(type)) endif diff --git a/driver-moab/main/prep_atm_mod.F90 b/driver-moab/main/prep_atm_mod.F90 index 6ecd7aa12c57..040c617fe7c2 100644 --- a/driver-moab/main/prep_atm_mod.F90 +++ b/driver-moab/main/prep_atm_mod.F90 @@ -1138,7 +1138,7 @@ subroutine prep_atm_mrg_moab(infodata, xao_ax) ent_type = 1 ! cells tagname = trim(seq_flds_x2a_fields)//C_NULL_CHAR arrsize = naflds * lsize - ierr = iMOAB_GetDoubleTagStorage ( mbaxid, tagname, arrsize , ent_type, x2a_am(1,1)) + ierr = iMOAB_GetDoubleTagStorage ( mbaxid, tagname, arrsize , ent_type, x2a_am) if (ierr .ne. 0) then call shr_sys_abort(subname//' error in getting moab tags with 0 ') endif @@ -1160,35 +1160,35 @@ subroutine prep_atm_mrg_moab(infodata, xao_ax) tagname = 'afrac:ifrac:ofrac:lfrac:lfrin'//C_NULL_CHAR arrsize = 5 * lsize - ierr = iMOAB_GetDoubleTagStorage ( mbaxid, tagname, arrsize , ent_type, fractions_am(1,1)) + ierr = iMOAB_GetDoubleTagStorage ( mbaxid, tagname, arrsize , ent_type, fractions_am) if (ierr .ne. 0) then call shr_sys_abort(subname//' error in getting fractions_am from atm instance ') endif tagname = trim(seq_flds_o2x_fields)//C_NULL_CHAR arrsize = noflds * lsize ! allocate (o2x_am (lsize, noflds)) - ierr = iMOAB_GetDoubleTagStorage ( mbaxid, tagname, arrsize , ent_type, o2x_am(1,1)) + ierr = iMOAB_GetDoubleTagStorage ( mbaxid, tagname, arrsize , ent_type, o2x_am) if (ierr .ne. 0) then call shr_sys_abort(subname//' error in getting o2x_am array ') endif tagname = trim(seq_flds_i2x_fields)//C_NULL_CHAR arrsize = niflds * lsize ! allocate (i2x_am (lsize, niflds)) - ierr = iMOAB_GetDoubleTagStorage ( mbaxid, tagname, arrsize , ent_type, i2x_am(1,1)) + ierr = iMOAB_GetDoubleTagStorage ( mbaxid, tagname, arrsize , ent_type, i2x_am) if (ierr .ne. 0) then call shr_sys_abort(subname//' error in getting i2x_am array ') endif tagname = trim(seq_flds_l2x_fields)//C_NULL_CHAR arrsize = nlflds * lsize ! allocate (l2x_am (lsize, nlflds)) - ierr = iMOAB_GetDoubleTagStorage ( mbaxid, tagname, arrsize , ent_type, l2x_am(1,1)) + ierr = iMOAB_GetDoubleTagStorage ( mbaxid, tagname, arrsize , ent_type, l2x_am) if (ierr .ne. 0) then call shr_sys_abort(subname//' error in getting l2x_am array ') endif tagname = trim(seq_flds_xao_fields)//C_NULL_CHAR arrsize = nxflds * lsize ! allocate (xao_am (lsize, nxflds)) - ierr = iMOAB_GetDoubleTagStorage ( mbaxid, tagname, arrsize , ent_type, xao_am(1,1)) + ierr = iMOAB_GetDoubleTagStorage ( mbaxid, tagname, arrsize , ent_type, xao_am) if (ierr .ne. 0) then call shr_sys_abort(subname//' error in getting xao_om array ') endif @@ -1343,7 +1343,7 @@ subroutine prep_atm_mrg_moab(infodata, xao_ax) tagname = trim(seq_flds_x2a_fields)//C_NULL_CHAR arrsize = naflds * lsize - ierr = iMOAB_SetDoubleTagStorage ( mbaxid, tagname, arrsize , ent_type, x2a_am(1,1)) + ierr = iMOAB_SetDoubleTagStorage ( mbaxid, tagname, arrsize , ent_type, x2a_am) if (ierr .ne. 0) then call shr_sys_abort(subname//' error in setting x2o_om array ') endif diff --git a/driver-moab/main/prep_ice_mod.F90 b/driver-moab/main/prep_ice_mod.F90 index eb7fa30f5b97..f215ed5004bd 100644 --- a/driver-moab/main/prep_ice_mod.F90 +++ b/driver-moab/main/prep_ice_mod.F90 @@ -765,7 +765,7 @@ subroutine prep_ice_mrg_moab(infodata, rof_c2_ice) ! git the x2i_im field which has been mostly filled out by mapping calls. tagname = trim(seq_flds_x2i_fields)//C_NULL_CHAR arrsize = niflds * lsize - ierr = iMOAB_GetDoubleTagStorage ( mbixid, tagname, arrsize , ent_type, x2i_im(1,1)) + ierr = iMOAB_GetDoubleTagStorage ( mbixid, tagname, arrsize , ent_type, x2i_im) if (ierr .ne. 0) then call shr_sys_abort(subname//' error in getting x2i_im array ') endif @@ -773,7 +773,7 @@ subroutine prep_ice_mrg_moab(infodata, rof_c2_ice) ! get the a2x data that was mapped to i tagname = trim(seq_flds_a2x_fields)//C_NULL_CHAR arrsize = naflds * lsize ! allocate (a2x_om (lsize, naflds)) - ierr = iMOAB_GetDoubleTagStorage ( mbixid, tagname, arrsize , ent_type, a2x_im(1,1)) + ierr = iMOAB_GetDoubleTagStorage ( mbixid, tagname, arrsize , ent_type, a2x_im) if (ierr .ne. 0) then write(logunit, *) 'MOAB error ', ierr call shr_sys_abort(subname//' error in getting a2x_im array ') @@ -782,7 +782,7 @@ subroutine prep_ice_mrg_moab(infodata, rof_c2_ice) ! get the r2x data that was mapped to i tagname = trim(seq_flds_r2x_fields)//C_NULL_CHAR arrsize = nrflds * lsize ! allocate (a2x_om (lsize, naflds)) - ierr = iMOAB_GetDoubleTagStorage ( mbixid, tagname, arrsize , ent_type, r2x_im(1,1)) + ierr = iMOAB_GetDoubleTagStorage ( mbixid, tagname, arrsize , ent_type, r2x_im) if (ierr .ne. 0) then call shr_sys_abort(subname//' error in getting r2x_im array ') endif @@ -840,7 +840,7 @@ subroutine prep_ice_mrg_moab(infodata, rof_c2_ice) end do tagname = trim(seq_flds_x2i_fields)//C_NULL_CHAR arrsize = niflds * lsize - ierr = iMOAB_SetDoubleTagStorage ( mbixid, tagname, arrsize , ent_type, x2i_im(1,1)) + ierr = iMOAB_SetDoubleTagStorage ( mbixid, tagname, arrsize , ent_type, x2i_im) if (ierr .ne. 0) then call shr_sys_abort(subname//' error in setting x2i_im array ') endif diff --git a/driver-moab/main/prep_lnd_mod.F90 b/driver-moab/main/prep_lnd_mod.F90 index 610671d932e3..f1d2f169ee2d 100644 --- a/driver-moab/main/prep_lnd_mod.F90 +++ b/driver-moab/main/prep_lnd_mod.F90 @@ -371,7 +371,7 @@ subroutine prep_lnd_init(infodata, atm_c2_lnd, rof_c2_lnd, glc_c2_lnd, iac_c2_ln allocate (tmparray(arrsize)) ! mlsize is the size of local land ! do we need to zero out others or just river ? tmparray = 0._r8 - ierr = iMOAB_SetDoubleTagStorage(mblxid, tagname, arrsize , ent_type, tmparray(1)) + ierr = iMOAB_SetDoubleTagStorage(mblxid, tagname, arrsize , ent_type, tmparray) if (ierr .ne. 0) then write(logunit,*) subname,' cant zero out r2x tags on land' call shr_sys_abort(subname//' cant zero out r2x tags on land') diff --git a/driver-moab/main/prep_ocn_mod.F90 b/driver-moab/main/prep_ocn_mod.F90 index ff3beeca4bae..de4a89e235f5 100644 --- a/driver-moab/main/prep_ocn_mod.F90 +++ b/driver-moab/main/prep_ocn_mod.F90 @@ -767,7 +767,7 @@ subroutine prep_ocn_init(infodata, atm_c2_ocn, atm_c2_ice, ice_c2_ocn, rof_c2_oc allocate (tmparray(arrsize)) ! mlsize is the size of local land ! do we need to zero out others or just river ? tmparray = 0._r8 - ierr = iMOAB_SetDoubleTagStorage(mboxid, tagname, arrsize , ent_type, tmparray(1)) + ierr = iMOAB_SetDoubleTagStorage(mboxid, tagname, arrsize , ent_type, tmparray) if (ierr .ne. 0) then write(logunit,*) subname,' cant zero out r2x tags on ocn' call shr_sys_abort(subname//' cant zero out r2x tags on ocn') @@ -965,7 +965,7 @@ subroutine prep_ocn_accum_moab() ! x2o_om should be saved between these calls tagname = trim(seq_flds_x2o_fields)//C_NULL_CHAR ent_type = 1 ! cell type - ierr = iMOAB_GetDoubleTagStorage ( mboxid, tagname, arrSize_x2o_om , ent_type, x2o_om(1,1)) + ierr = iMOAB_GetDoubleTagStorage ( mboxid, tagname, arrSize_x2o_om , ent_type, x2o_om) if (ierr .ne. 0) then call shr_sys_abort(subname//' error in getting x2o_om array ') endif @@ -1042,7 +1042,7 @@ subroutine prep_ocn_accum_avg_moab() ! modify the tags tagname = trim(seq_flds_x2o_fields)//C_NULL_CHAR ent_type = 1 ! cell type - ierr = iMOAB_SetDoubleTagStorage ( mboxid, tagname, arrSize_x2o_om , ent_type, x2o_om(1,1)) + ierr = iMOAB_SetDoubleTagStorage ( mboxid, tagname, arrSize_x2o_om , ent_type, x2o_om) if (ierr .ne. 0) then call shr_sys_abort(subname//' error in setting x2o_om array ') endif @@ -1689,14 +1689,14 @@ subroutine prep_ocn_mrg_moab(infodata, xao_ox) ent_type = 1 ! cells tagname = 'afrac:ifrac:ofrac:ifrad:ofrad'//C_NULL_CHAR arrsize = 5 * lsize - ierr = iMOAB_GetDoubleTagStorage ( mboxid, tagname, arrsize , ent_type, fractions_om(1,1)) + ierr = iMOAB_GetDoubleTagStorage ( mboxid, tagname, arrsize , ent_type, fractions_om) if (ierr .ne. 0) then call shr_sys_abort(subname//' error in getting fractions_om from ocean instance ') endif ! fill the o2x_om, etc double array fields noflds tagname = trim(seq_flds_x2o_fields)//C_NULL_CHAR arrsize = noflds * lsize - ierr = iMOAB_GetDoubleTagStorage ( mboxid, tagname, arrsize , ent_type, x2o_om(1,1)) + ierr = iMOAB_GetDoubleTagStorage ( mboxid, tagname, arrsize , ent_type, x2o_om) if (ierr .ne. 0) then call shr_sys_abort(subname//' error in getting x2o_om array ') endif @@ -1716,28 +1716,28 @@ subroutine prep_ocn_mrg_moab(infodata, xao_ox) enddo tagname = trim(seq_flds_a2x_fields)//C_NULL_CHAR arrsize = naflds * lsize ! allocate (a2x_om (lsize, naflds)) - ierr = iMOAB_GetDoubleTagStorage ( mboxid, tagname, arrsize , ent_type, a2x_om(1,1)) + ierr = iMOAB_GetDoubleTagStorage ( mboxid, tagname, arrsize , ent_type, a2x_om) if (ierr .ne. 0) then call shr_sys_abort(subname//' error in getting a2x_om array ') endif tagname = trim(seq_flds_i2x_fields)//C_NULL_CHAR arrsize = niflds * lsize ! allocate (i2x_om (lsize, niflds)) - ierr = iMOAB_GetDoubleTagStorage ( mboxid, tagname, arrsize , ent_type, i2x_om(1,1)) + ierr = iMOAB_GetDoubleTagStorage ( mboxid, tagname, arrsize , ent_type, i2x_om) if (ierr .ne. 0) then call shr_sys_abort(subname//' error in getting i2x_om array ') endif tagname = trim(seq_flds_r2x_fields)//C_NULL_CHAR arrsize = nrflds * lsize ! allocate (r2x_om (lsize, nrflds)) - ierr = iMOAB_GetDoubleTagStorage ( mboxid, tagname, arrsize , ent_type, r2x_om(1,1)) + ierr = iMOAB_GetDoubleTagStorage ( mboxid, tagname, arrsize , ent_type, r2x_om) if (ierr .ne. 0) then call shr_sys_abort(subname//' error in getting r2x_om array ') endif tagname = trim(seq_flds_xao_fields)//C_NULL_CHAR arrsize = nxflds * lsize ! allocate (xao_om (lsize, nxflds)) - ierr = iMOAB_GetDoubleTagStorage ( mbofxid, tagname, arrsize , ent_type, xao_om(1,1)) + ierr = iMOAB_GetDoubleTagStorage ( mbofxid, tagname, arrsize , ent_type, xao_om) if (ierr .ne. 0) then call shr_sys_abort(subname//' error in getting xao_om array ') endif @@ -1925,7 +1925,7 @@ subroutine prep_ocn_mrg_moab(infodata, xao_ox) tagname = trim(seq_flds_x2o_fields)//C_NULL_CHAR arrsize = noflds * lsize - ierr = iMOAB_SetDoubleTagStorage ( mboxid, tagname, arrsize , ent_type, x2o_om(1,1)) + ierr = iMOAB_SetDoubleTagStorage ( mboxid, tagname, arrsize , ent_type, x2o_om) if (ierr .ne. 0) then call shr_sys_abort(subname//' error in setting x2o_om array ') endif diff --git a/driver-moab/main/prep_rof_mod.F90 b/driver-moab/main/prep_rof_mod.F90 index dab66ce10680..124891a28a23 100644 --- a/driver-moab/main/prep_rof_mod.F90 +++ b/driver-moab/main/prep_rof_mod.F90 @@ -782,7 +782,7 @@ subroutine prep_rof_accum_lnd_moab() tagname = trim(sharedFieldsLndRof)//C_NULL_CHAR arrsize = nfields_sh_lr * lsize_lm ent_type = 1 ! cell type - ierr = iMOAB_GetDoubleTagStorage ( mblxid, tagname, arrsize , ent_type, l2x_lm2(1,1)) + ierr = iMOAB_GetDoubleTagStorage ( mblxid, tagname, arrsize , ent_type, l2x_lm2) if (ierr .ne. 0) then call shr_sys_abort(subname//' error in getting shared fields from land instance ') endif @@ -848,7 +848,7 @@ subroutine prep_rof_accum_atm_moab() tagname = trim(sharedFieldsAtmRof)//C_NULL_CHAR arrsize = nfields_sh_ar * lsize_am ent_type = 1 ! cell type - ierr = iMOAB_GetDoubleTagStorage ( mbaxid, tagname, arrsize , ent_type, a2x_am2(1,1)) + ierr = iMOAB_GetDoubleTagStorage ( mbaxid, tagname, arrsize , ent_type, a2x_am2) if (ierr .ne. 0) then call shr_sys_abort(subname//' error in getting shared fields from atm instance ') endif @@ -932,7 +932,7 @@ subroutine prep_rof_accum_ocn_moab() tagname = trim(sharedFieldsOcnRof)//C_NULL_CHAR arrsize = nfields_sh_or * lsize_om ent_type = 1 ! cell type - ierr = iMOAB_GetDoubleTagStorage ( mboxid, tagname, arrsize , ent_type, o2r_om2(1,1)) + ierr = iMOAB_GetDoubleTagStorage ( mboxid, tagname, arrsize , ent_type, o2r_om2) if (ierr .ne. 0) then call shr_sys_abort(subname//' error in getting shared fields from ocn instance ') endif @@ -1029,7 +1029,7 @@ subroutine prep_rof_accum_avg_moab() tagname = trim(sharedFieldsLndRof)//C_NULL_CHAR arrsize = nfields_sh_lr * lsize_lm ent_type = 1 ! cell type - ierr = iMOAB_SetDoubleTagStorage ( mblxid, tagname, arrsize , ent_type, l2racc_lm(1,1)) + ierr = iMOAB_SetDoubleTagStorage ( mblxid, tagname, arrsize , ent_type, l2racc_lm) if (ierr .ne. 0) then call shr_sys_abort(subname//' error in setting accumulated shared fields on rof on land instance ') endif @@ -1043,7 +1043,7 @@ subroutine prep_rof_accum_avg_moab() tagname = trim(sharedFieldsAtmRof)//C_NULL_CHAR arrsize = nfields_sh_ar * lsize_am ent_type = 1 ! cell type - ierr = iMOAB_SetDoubleTagStorage ( mbaxid, tagname, arrsize , ent_type, a2racc_am(1,1)) + ierr = iMOAB_SetDoubleTagStorage ( mbaxid, tagname, arrsize , ent_type, a2racc_am) if (ierr .ne. 0) then call shr_sys_abort(subname//' error in setting accumulated shared fields on rof on atm instance ') endif @@ -1056,7 +1056,7 @@ subroutine prep_rof_accum_avg_moab() tagname = trim(sharedFieldsOcnRof)//C_NULL_CHAR arrsize = nfields_sh_or * lsize_om ent_type = 1 ! cell type - ierr = iMOAB_SetDoubleTagStorage ( mboxid, tagname, arrsize , ent_type, o2racc_om(1,1)) + ierr = iMOAB_SetDoubleTagStorage ( mboxid, tagname, arrsize , ent_type, o2racc_om) if (ierr .ne. 0) then call shr_sys_abort(subname//' error in setting accumulated shared fields on rof on ocn instance ') endif @@ -1681,14 +1681,14 @@ subroutine prep_rof_mrg_moab (infodata, cime_model) ent_type = 1 ! cells tagname = 'lfrac:lfrin:rfrac'//C_NULL_CHAR arrsize = 3 * lsize - ierr = iMOAB_GetDoubleTagStorage ( mbrxid, tagname, arrsize , ent_type, fractions_rm(1,1)) + ierr = iMOAB_GetDoubleTagStorage ( mbrxid, tagname, arrsize , ent_type, fractions_rm) if (ierr .ne. 0) then call shr_sys_abort(subname//' error in getting fractions_om from rof instance ') endif ! fill the r2x_rm, etc double array fields nflds tagname = trim(seq_flds_x2r_fields)//C_NULL_CHAR arrsize = nflds * lsize - ierr = iMOAB_GetDoubleTagStorage ( mbrxid, tagname, arrsize , ent_type, x2r_rm(1,1)) + ierr = iMOAB_GetDoubleTagStorage ( mbrxid, tagname, arrsize , ent_type, x2r_rm) if (ierr .ne. 0) then call shr_sys_abort(subname//' error in getting x2r_rm array ') endif @@ -1696,14 +1696,14 @@ subroutine prep_rof_mrg_moab (infodata, cime_model) tagname = trim(seq_flds_a2x_fields_to_rof)//C_NULL_CHAR arrsize = naflds * lsize ! allocate (a2x_rm (lsize, naflds)) - ierr = iMOAB_GetDoubleTagStorage ( mbrxid, tagname, arrsize , ent_type, a2x_rm(1,1)) + ierr = iMOAB_GetDoubleTagStorage ( mbrxid, tagname, arrsize , ent_type, a2x_rm) if (ierr .ne. 0) then call shr_sys_abort(subname//' error in getting a2x_rm array ') endif ! l2x_rm tagname = trim(seq_flds_l2x_fluxes_to_rof)//C_NULL_CHAR arrsize = nlflds * lsize ! - ierr = iMOAB_GetDoubleTagStorage ( mbrxid, tagname, arrsize , ent_type, l2x_rm(1,1)) + ierr = iMOAB_GetDoubleTagStorage ( mbrxid, tagname, arrsize , ent_type, l2x_rm) if (ierr .ne. 0) then call shr_sys_abort(subname//' error in getting l2x_rm array ') endif @@ -1754,7 +1754,7 @@ subroutine prep_rof_mrg_moab (infodata, cime_model) tagname = trim(seq_flds_x2r_fields)//C_NULL_CHAR arrsize = nflds * lsize - ierr = iMOAB_SetDoubleTagStorage ( mbrxid, tagname, arrsize , ent_type, x2r_rm(1,1)) + ierr = iMOAB_SetDoubleTagStorage ( mbrxid, tagname, arrsize , ent_type, x2r_rm) if (ierr .ne. 0) then call shr_sys_abort(subname//' error in setting x2r_rm array ') endif diff --git a/driver-moab/main/seq_io_mod.F90 b/driver-moab/main/seq_io_mod.F90 index 824d5e3c980b..062e2750bcef 100644 --- a/driver-moab/main/seq_io_mod.F90 +++ b/driver-moab/main/seq_io_mod.F90 @@ -1692,7 +1692,7 @@ subroutine seq_io_write_moab_tags(filename, mbxid, dname, tag_list, whead,wdata, ! note: size of dof is ns if (ns > 0) then tagname = 'GLOBAL_ID'//C_NULL_CHAR - ierr = iMOAB_GetIntTagStorage ( mbxid, tagname, ns , ent_type, dof(1)) + ierr = iMOAB_GetIntTagStorage ( mbxid, tagname, ns , ent_type, dof) if (ierr .ne. 0) then write(logunit,*) subname,' ERROR: cannot get dofs ' call shr_sys_abort(subname//'cannot get dofs ') @@ -1725,7 +1725,7 @@ subroutine seq_io_write_moab_tags(filename, mbxid, dname, tag_list, whead,wdata, else tagname = trim(field)//C_NULL_CHAR if (ns > 0 ) then - ierr = iMOAB_GetDoubleTagStorage (mbxid, tagname, ns , ent_type, data1(1)) + ierr = iMOAB_GetDoubleTagStorage (mbxid, tagname, ns , ent_type, data1) if (ierr .ne. 0) then write(logunit,*) subname,' ERROR: cannot get tag data ', trim(tagname) call shr_sys_abort(subname//'cannot get tag data ') @@ -2592,7 +2592,7 @@ subroutine seq_io_read_moab_tags(filename, mbxid, dname, tag_list, matrix, nx) ! note: size of dof is ns tagname = 'GLOBAL_ID'//C_NULL_CHAR if (ns > 0 ) then - ierr = iMOAB_GetIntTagStorage ( mbxid, tagname, ns , ent_type, dof(1)) + ierr = iMOAB_GetIntTagStorage ( mbxid, tagname, ns , ent_type, dof) if (ierr .ne. 0) then write(logunit,*) subname,' ERROR: cannot get dofs ' call shr_sys_abort(subname//'cannot get dofs ') @@ -2659,7 +2659,7 @@ subroutine seq_io_read_moab_tags(filename, mbxid, dname, tag_list, matrix, nx) else tagname = trim(field)//C_NULL_CHAR if (ns > 0) then - ierr = iMOAB_SetDoubleTagStorage (mbxid, tagname, ns , ent_type, data_reorder(1)) + ierr = iMOAB_SetDoubleTagStorage (mbxid, tagname, ns , ent_type, data_reorder) if (ierr .ne. 0) then write(logunit,*) subname,' ERROR: cannot set tag data ', trim(tagname) call shr_sys_abort(subname//'cannot set tag data ') @@ -2688,7 +2688,7 @@ subroutine seq_io_read_moab_tags(filename, mbxid, dname, tag_list, matrix, nx) else tagname = trim(field)//C_NULL_CHAR if ( ns > 0 ) then - ierr = iMOAB_SetDoubleTagStorage (mbxid, tagname, ns , ent_type, data_reorder(1)) + ierr = iMOAB_SetDoubleTagStorage (mbxid, tagname, ns , ent_type, data_reorder) if (ierr .ne. 0) then write(logunit,*) subname,' ERROR: cannot set tag data ', trim(tagname) call shr_sys_abort(subname//'cannot set tag data ') diff --git a/driver-moab/main/seq_map_mod.F90 b/driver-moab/main/seq_map_mod.F90 index 476b7a3d6d6a..3ed8ae600b7c 100644 --- a/driver-moab/main/seq_map_mod.F90 +++ b/driver-moab/main/seq_map_mod.F90 @@ -568,7 +568,7 @@ subroutine seq_map_map( mapper, av_s, av_d, fldlist, norm, avwts_s, avwtsfld_s, arrsize_src=lsize_src*(nfields) ! get the current values of all source tags including the norm8wt currently set to 1 - ierr = iMOAB_GetDoubleTagStorage (mapper%src_mbid, fldlist_moab, arrsize_src , mapper%tag_entity_type, targtags(1,1)) + ierr = iMOAB_GetDoubleTagStorage (mapper%src_mbid, fldlist_moab, arrsize_src , mapper%tag_entity_type, targtags) if (ierr .ne. 0) then write(logunit,*) subname,' error getting source tag values ', mapper%mbname, mapper%src_mbid, trim(fldlist_moab), arrsize_src, mapper%tag_entity_type call shr_sys_abort(subname//' ERROR getting source tag values') ! serious enough @@ -588,7 +588,7 @@ subroutine seq_map_map( mapper, av_s, av_d, fldlist, norm, avwts_s, avwtsfld_s, endif #endif ! put the new values on the mesh for later mapping - ierr = iMOAB_SetDoubleTagStorage (mapper%src_mbid, fldlist_moab, arrsize_src , mapper%tag_entity_type, targtags(1,1)) + ierr = iMOAB_SetDoubleTagStorage (mapper%src_mbid, fldlist_moab, arrsize_src , mapper%tag_entity_type, targtags) if (ierr .ne. 0) then write(logunit,*) subname,' error setting normed source tag values ', mapper%mbname call shr_sys_abort(subname//' ERROR setting normed source tag values') ! serious enough @@ -664,7 +664,7 @@ subroutine seq_map_map( mapper, av_s, av_d, fldlist, norm, avwts_s, avwtsfld_s, ! get values of target tags after mapping allocate(targtags(lsize_tgt,nfields)) arrsize_tgt=lsize_tgt*(nfields) - ierr = iMOAB_GetDoubleTagStorage (mapper%tgt_mbid, fldlist_moab, arrsize_tgt , mapper%tag_entity_type, targtags(1,1)) + ierr = iMOAB_GetDoubleTagStorage (mapper%tgt_mbid, fldlist_moab, arrsize_tgt , mapper%tag_entity_type, targtags) if (ierr .ne. 0) then write(logunit,*) subname,' error getting destination tag values ', mapper%mbname call shr_sys_abort(subname//' ERROR getting source tag values') ! serious enough @@ -679,7 +679,7 @@ subroutine seq_map_map( mapper, av_s, av_d, fldlist, norm, avwts_s, avwtsfld_s, enddo ! put the values back on the mesh - ierr = iMOAB_SetDoubleTagStorage (mapper%tgt_mbid, fldlist_moab, arrsize_tgt , mapper%tag_entity_type, targtags(1,1)) + ierr = iMOAB_SetDoubleTagStorage (mapper%tgt_mbid, fldlist_moab, arrsize_tgt , mapper%tag_entity_type, targtags) if (ierr .ne. 0) then write(logunit,*) subname,' error getting destination tag values ', mapper%mbname call shr_sys_abort(subname//' ERROR getting source tag values') ! serious enough @@ -694,7 +694,7 @@ subroutine seq_map_map( mapper, av_s, av_d, fldlist, norm, avwts_s, avwtsfld_s, endif #endif ! put the values back on the source mesh - ierr = iMOAB_SetDoubleTagStorage (mapper%src_mbid, fldlist_moab, arrsize_src , mapper%tag_entity_type, targtags_ini(1,1)) + ierr = iMOAB_SetDoubleTagStorage (mapper%src_mbid, fldlist_moab, arrsize_src , mapper%tag_entity_type, targtags_ini) if (ierr .ne. 0) then write(logunit,*) subname,' error setting source tag values ', mapper%mbname call shr_sys_abort(subname//' ERROR setting source tag values') ! serious enough diff --git a/driver-moab/main/seq_rest_mod.F90 b/driver-moab/main/seq_rest_mod.F90 index 0e38ade4b645..105605f3e615 100644 --- a/driver-moab/main/seq_rest_mod.F90 +++ b/driver-moab/main/seq_rest_mod.F90 @@ -525,7 +525,7 @@ subroutine seq_rest_mb_read(rest_file, infodata, samegrid_al) call seq_io_read(moab_rest_file, x2oacc_om_cnt, 'x2oacc_ox_cnt') ! tagname = trim(seq_flds_xao_fields)//C_NULL_CHAR ! arrsize = nxflds * lsize ! allocate (xao_om (lsize, nxflds)) - ! ierr = iMOAB_GetDoubleTagStorage ( mbofxid, tagname, arrsize , ent_type, xao_om(1,1)) + ! ierr = iMOAB_GetDoubleTagStorage ( mbofxid, tagname, arrsize , ent_type, xao_om) call seq_io_read(moab_rest_file, mbofxid, 'xao_ox', & trim(seq_flds_xao_fields) ) ! gsmap => component_get_gsmap_cx(ocn(1)) @@ -1260,7 +1260,7 @@ subroutine seq_rest_mb_write(EClock_d, seq_SyncClock, infodata, & whead=whead, wdata=wdata) ! tagname = trim(seq_flds_xao_fields)//C_NULL_CHAR ! arrsize = nxflds * lsize ! allocate (xao_om (lsize, nxflds)) - ! ierr = iMOAB_GetDoubleTagStorage ( mbofxid, tagname, arrsize , ent_type, xao_om(1,1)) + ! ierr = iMOAB_GetDoubleTagStorage ( mbofxid, tagname, arrsize , ent_type, xao_om) call seq_io_write(rest_file, mbofxid, 'xao_ox', & trim(seq_flds_xao_fields), & whead=whead, wdata=wdata) From 6a8d6fb92b3abff0d52e4e3f2fff8bb07de91507 Mon Sep 17 00:00:00 2001 From: Robert Jacob Date: Fri, 20 Oct 2023 15:24:14 -0500 Subject: [PATCH 437/467] Introduce new variables for moab latv,lonv Introduce new variables for moab latv,lonv coordinates. Were using ones for pflotran which only worked because use_pflotran is false in all our cases. --- components/elm/src/main/surfrdMod.F90 | 11 ++++---- components/elm/src/utils/domainMod.F90 | 37 ++++++++++++++++++++++++++ 2 files changed, 43 insertions(+), 5 deletions(-) diff --git a/components/elm/src/main/surfrdMod.F90 b/components/elm/src/main/surfrdMod.F90 index 4fbe2f1b7536..ef1e4537501d 100755 --- a/components/elm/src/main/surfrdMod.F90 +++ b/components/elm/src/main/surfrdMod.F90 @@ -257,8 +257,9 @@ subroutine surfrd_get_grid(begg, endg, ldomain, filename, glcfilename) end if ! pflotran:end----------------------------------------------- + #ifdef HAVE_MOAB - ! read xv and yv anyway + ! read xv and yv for MOAB to learn mesh verticies if (ldomain%nv>=3 ) then call get_elmlevel_gsmap (grlnd, gsMap) allocate(rdata3d(nv,ni,nj)) ! transpose from c, as this is fortran @@ -266,7 +267,7 @@ subroutine surfrd_get_grid(begg, endg, ldomain, filename, glcfilename) ! this should be improved in a distributed read, that does not use full grid ni * nj * nv 720*360*4*8 ~ 8Mb call ncd_io(ncid=ncid, varname=trim(vname), data=rdata3d, flag='read', readvar=readvar) if (.not. readvar) call endrun( msg=trim(subname)//' ERROR: xv NOT on file'//errMsg(__FILE__, __LINE__)) - ! fill up the ldomain%lonv(begg:endg, 1:nv) array + ! fill up the ldomain%mblonv(begg:endg, 1:nv) array local = begg do iseg = 1, gsMap%ngseg if (gsMap%pe_loc(iseg) .eq. iam) then @@ -275,7 +276,7 @@ subroutine surfrd_get_grid(begg, endg, ldomain, filename, glcfilename) i = ig - ni*(j-1) do iv = 1, nv if (local .le. endg) then - ldomain%lonv(local, iv ) = rdata3d(iv, i, j) + ldomain%mblonv(local, iv ) = rdata3d(iv, i, j) else write (iulog, *), 'OVERFLOW', iseg, gsMap%pe_loc(iseg), gsMap%start(iseg), gsMap%length(iseg), local endif @@ -284,7 +285,7 @@ subroutine surfrd_get_grid(begg, endg, ldomain, filename, glcfilename) enddo endif enddo - ! repeat for latv + ! repeat for mblatv vname = 'yv' call ncd_io(ncid=ncid, varname=trim(vname), data=rdata3d, flag='read', readvar=readvar) if (.not. readvar) call endrun( msg=trim(subname)//' ERROR: yv NOT on file'//errMsg(__FILE__, __LINE__)) @@ -297,7 +298,7 @@ subroutine surfrd_get_grid(begg, endg, ldomain, filename, glcfilename) i = ig - ni*(j-1) do iv = 1, nv if (local .le. endg) then - ldomain%latv(local, iv ) = rdata3d(iv, i, j) + ldomain%mblatv(local, iv ) = rdata3d(iv, i, j) endif enddo local = local + 1 diff --git a/components/elm/src/utils/domainMod.F90 b/components/elm/src/utils/domainMod.F90 index 2c7771179d21..5ef3ae611cf6 100755 --- a/components/elm/src/utils/domainMod.F90 +++ b/components/elm/src/utils/domainMod.F90 @@ -52,6 +52,10 @@ module domainMod integer :: nv ! number of vertices real(r8),pointer :: latv(:,:) ! latitude of grid cell's vertices (deg) real(r8),pointer :: lonv(:,:) ! longitude of grid cell's vertices (deg) +#ifdef HAVE_MOAB + real(r8),pointer :: mblatv(:,:) ! latitude of grid cell's vertices (deg) for MOAB + real(r8),pointer :: mblonv(:,:) ! longitude of grid cell's vertices (deg) for MOAB +#endif real(r8) :: lon0 ! the origin lon/lat (Most western/southern corner, if not globally covered grids; OR -180W(360E)/-90N) real(r8) :: lat0 ! the origin lon/lat (Most western/southern corner, if not globally covered grids; OR -180W(360E)/-90N) @@ -150,6 +154,22 @@ subroutine domain_init(domain,isgrid2d,ni,nj,nbeg,nend,elmlevel) endif end if ! pflotran:end----------------------------------------------------- +#ifdef HAVE_MOAB + if (domain%nv > 0 .and. domain%nv /= huge(1)) then + if(.not.associated(domain%mblonv)) then + allocate(domain%mblonv(nb:ne, 1:domain%nv), stat=ier) + if (ier /= 0) & + call shr_sys_abort('domain_init ERROR: allocate mblonv ') + domain%mblonv = nan + endif + if(.not.associated(domain%mblatv)) then + allocate(domain%mblatv(nb:ne, 1:domain%nv)) + if (ier /= 0) & + call shr_sys_abort('domain_init ERROR: allocate mblatv ') + domain%mblatv = nan + endif + end if +#endif if (present(elmlevel)) then domain%elmlevel = elmlevel @@ -245,6 +265,23 @@ subroutine domain_clean(domain) endif endif ! pflotran:beg----------------------------------------------------- +#ifdef HAVE_MOAB + if (domain%nv > 0 .and. domain%nv /= huge(1)) then + if (associated(domain%mblonv)) then + deallocate(domain%mblonv, stat=ier) + if (ier /= 0) & + call shr_sys_abort('domain_clean ERROR: deallocate mblonv ') + nullify(domain%mblonv) + endif + + if (associated(domain%mblatv)) then + deallocate(domain%mblatv, stat=ier) + if (ier /= 0) & + call shr_sys_abort('domain_clean ERROR: deallocate mblatv ') + nullify(domain%mblatv) + endif + endif +#endif else if (masterproc) then From 7679680500c82fa0f248347dac2be1ffe8d27d92 Mon Sep 17 00:00:00 2001 From: Robert Jacob Date: Fri, 20 Oct 2023 15:25:27 -0500 Subject: [PATCH 438/467] Remove CPL_BYPASS from moab import. Use moab latv,lonv Remove CPL_BYPASS from moab import because its to much code duplication. Also use the new moab versions of latv and lonv --- components/elm/src/cpl/lnd_comp_mct.F90 | 996 +----------------------- 1 file changed, 38 insertions(+), 958 deletions(-) diff --git a/components/elm/src/cpl/lnd_comp_mct.F90 b/components/elm/src/cpl/lnd_comp_mct.F90 index bf21d6e36bea..ad19f6ac3e9d 100644 --- a/components/elm/src/cpl/lnd_comp_mct.F90 +++ b/components/elm/src/cpl/lnd_comp_mct.F90 @@ -17,10 +17,8 @@ module lnd_comp_mct #ifdef HAVE_MOAB use seq_comm_mct, only: mlnid! id of moab land app - use seq_comm_mct, only: mb_land_mesh! true if land is full mesh + use seq_comm_mct, only: mb_land_mesh! true if land is full mesh (on the river mesh) use seq_comm_mct, only: num_moab_exports - use seq_flds_mod , only : seq_flds_x2l_fields, seq_flds_l2x_fields - #ifdef MOABCOMP use seq_comm_mct , only: seq_comm_compare_mb_mct #endif @@ -49,12 +47,10 @@ module lnd_comp_mct integer :: nrecv, totalmblsimp real (r8) , allocatable, private :: x2l_lm(:,:) ! for tags from MOAB - logical :: sameg_al ! save it for export :) -#ifdef HAVE_MOAB integer :: mpicom_lnd_moab ! used also for mpi-reducing the difference between moab tags and mct avs integer :: rank2 -#endif + logical :: samegrid_al ! #endif !--------------------------------------------------------------------------- @@ -151,12 +147,9 @@ subroutine lnd_init_mct( EClock, cdata_l, x2l_l, l2x_l, NLFilename ) character(len=*), parameter :: format = "('("//trim(sub)//") :',A)" #ifdef HAVE_MOAB - integer :: ierr, nsend - logical :: samegrid_al ! + integer :: ierr, nsend,n character(len=SHR_KIND_CL) :: atm_gnam ! atm grid character(len=SHR_KIND_CL) :: lnd_gnam ! lnd grid - ! debugIuli - integer :: debugGSMapFile, n #endif !----------------------------------------------------------------------- @@ -171,7 +164,7 @@ subroutine lnd_init_mct( EClock, cdata_l, x2l_l, l2x_l, NLFilename ) ! Determine attriute vector indices #ifdef HAVE_MOAB - mpicom_lnd_moab = mpicom_lnd ! just store it now, for later use; maybe it is the same as mpicom from spmdMod (or a copy) + mpicom_lnd_moab = mpicom_lnd ! just store it now, for later use call shr_mpi_commrank( mpicom_lnd_moab, rank2 ) ! this will be used for differences between mct and moab tags #endif @@ -327,8 +320,7 @@ subroutine lnd_init_mct( EClock, cdata_l, x2l_l, l2x_l, NLFilename ) lnd_gnam=lnd_gnam ) if (trim(atm_gnam) /= trim(lnd_gnam)) samegrid_al = .false. mb_land_mesh = .not. samegrid_al ! global variable, saved in seq_comm - call init_moab_land(bounds, samegrid_al, LNDID) - sameg_al = samegrid_al ! will use it for export too + call init_moab_land(bounds, LNDID) #endif call mct_aVect_init(x2l_l, rList=seq_flds_x2l_fields, lsize=lsz) call mct_aVect_zero(x2l_l) @@ -373,6 +365,7 @@ subroutine lnd_init_mct( EClock, cdata_l, x2l_l, l2x_l, NLFilename ) if (atm_present) then call lnd_export(bounds, lnd2atm_vars, lnd2glc_vars, l2x_l%rattr) #ifdef HAVE_MOAB +! Also send data through the MOAB path in driver-moab call lnd_export_moab(bounds, lnd2atm_vars, lnd2glc_vars) ! it is private here #endif endif @@ -558,12 +551,12 @@ subroutine lnd_run_mct(EClock, cdata_l, x2l_l, l2x_l) mct_field = mct_string_toChar(mctOStr) tagname= trim(mct_field)//C_NULL_CHAR modelStr = 'lnd run' - !call compare_to_moab_tag_lnd(mpicom_lnd_moab, x2l_l, mct_field, mlnid, tagname, ent_type, difference) call seq_comm_compare_mb_mct(modelStr, mpicom_lnd_moab, x2l_l, mct_field, mlnid, tagname, ent_type, difference) enddo call mct_list_clean(temp_list) #endif +! calling MOAB's import last means this is what the model will use. call lnd_import_moab( bounds, atm2lnd_vars, glc2lnd_vars) #endif @@ -838,7 +831,7 @@ subroutine lnd_domain_mct( bounds, lsz, gsMap_l, dom_l ) end subroutine lnd_domain_mct #ifdef HAVE_MOAB - subroutine init_moab_land(bounds, samegrid_al, LNDID) + subroutine init_moab_land(bounds, LNDID) use seq_flds_mod , only : seq_flds_l2x_fields, seq_flds_x2l_fields use shr_kind_mod , only : CXX => SHR_KIND_CXX use spmdMod , only: iam ! rank on the land communicator @@ -852,7 +845,6 @@ subroutine init_moab_land(bounds, samegrid_al, LNDID) iMOAB_ResolveSharedEntities, iMOAB_CreateElements, iMOAB_MergeVertices, iMOAB_UpdateMeshInfo type(bounds_type) , intent(in) :: bounds - logical , intent(in) :: samegrid_al integer , intent(in) :: LNDID ! id of the land app integer,allocatable :: gindex(:) ! Number the local grid points; used for global ID @@ -873,6 +865,7 @@ subroutine init_moab_land(bounds, samegrid_al, LNDID) integer, allocatable :: moabconn(:) ! will have the connectivity in terms of local index in verts + ! define a MOAB app for ELM appname="LNDMB"//C_NULL_CHAR ! first land instance, should be 9 ierr = iMOAB_RegisterApplication(appname, mpicom_lnd_moab, LNDID, mlnid) @@ -884,6 +877,8 @@ subroutine init_moab_land(bounds, samegrid_al, LNDID) write(iulog,*) " " endif + ! start describing the mesh to MOAB + dims =3 ! store as 3d mesh ! number the local grid lsz = bounds%endg - bounds%begg + 1 @@ -895,6 +890,8 @@ subroutine init_moab_land(bounds, samegrid_al, LNDID) end do gsize = ldomain%ni * ldomain%nj ! size of the total grid ! if ldomain%nv > 3 , create mesh + + ! Case where land and river share mesh (tri-grid) if (ldomain%nv .ge. 3 .and. .not.samegrid_al) then ! number of vertices is nv * lsz ! allocate(moab_vert_coords(lsz*dims*ldomain%nv)) @@ -903,14 +900,14 @@ subroutine init_moab_land(bounds, samegrid_al, LNDID) do n = bounds%begg, bounds%endg i = (n - bounds%begg) * ldomain%nv do iv = 1, ldomain%nv - lonv = ldomain%lonv(n, iv) * SHR_CONST_PI/180. - latv = ldomain%latv(n, iv) * SHR_CONST_PI/180. - i = i + 1 ! iv-th vertex of cell n; i starts at 1 ! should we repeat previous if nan - ! print *, i, n, ldomain%lonv(n, iv) , ldomain%latv(n, iv) + lonv = ldomain%mblonv(n, iv) * SHR_CONST_PI/180. + latv = ldomain%mblatv(n, iv) * SHR_CONST_PI/180. + + i = i + 1 ! iv-th vertex of cell n; i starts at 1 moab_vert_coords(3*i-2)=COS(latv)*COS(lonv) moab_vert_coords(3*i-1)=COS(latv)*SIN(lonv) moab_vert_coords(3*i )=SIN(latv) - moabconn(i) = i! + moabconn(i) = i enddo enddo ierr = iMOAB_CreateVertices(mlnid, lsz * 3 * ldomain%nv, dims, moab_vert_coords) @@ -922,7 +919,9 @@ subroutine init_moab_land(bounds, samegrid_al, LNDID) if (ldomain%nv .gt. 4) mbtype = 4 ! polygon block_ID = 100 !some value ierr = iMOAB_CreateElements( mlnid, lsz, mbtype, ldomain%nv, moabconn, block_ID ); - ! define some tags on cells now, not on vertices + + + ! define some useful tags on cells tagtype = 0 ! dense, integer numco = 1 tagname='GLOBAL_ID'//C_NULL_CHAR @@ -937,6 +936,7 @@ subroutine init_moab_land(bounds, samegrid_al, LNDID) ! use moab_vert_coords as a data holder for a frac tag and area tag that we will create ! on the vertices; do not allocate other data array + ! Define and Set Fraction tagname='frac'//C_NULL_CHAR tagtype = 1 ! dense, double ierr = iMOAB_DefineTagStorage(mlnid, tagname, tagtype, numco, tagindex ) @@ -951,6 +951,7 @@ subroutine init_moab_land(bounds, samegrid_al, LNDID) if (ierr > 0 ) & call endrun('Error: fail to set frac tag ') + ! Define and Set area tagname='area'//C_NULL_CHAR ierr = iMOAB_DefineTagStorage(mlnid, tagname, tagtype, numco, tagindex ) if (ierr > 0 ) & @@ -964,15 +965,17 @@ subroutine init_moab_land(bounds, samegrid_al, LNDID) if (ierr > 0 ) & call endrun('Error: fail to set area tag ') - ! aream needed in cime_init for now. + ! Define aream tagname='aream'//C_NULL_CHAR ierr = iMOAB_DefineTagStorage(mlnid, tagname, tagtype, numco, tagindex ) if (ierr > 0 ) & call endrun('Error: fail to create aream tag ') deallocate(moabconn) - ! use merge vertices new imoab method to fix cells - deallocate(vgids) ! use it for global ids, for elements in full mesh or vertices in point cloud + deallocate(vgids) + + + ! Now do the verticies allocate(vgids(lsz*ldomain%nv)) ! do n = 1, lsz do i=1,ldomain%nv @@ -988,6 +991,7 @@ subroutine init_moab_land(bounds, samegrid_al, LNDID) if (ierr > 0 ) & call endrun('Error: fail to update mesh info ') + ! Case where land and atmosphere share mesh else ! old point cloud mesh allocate(moab_vert_coords(lsz*dims)) do i = 1, lsz @@ -1071,6 +1075,7 @@ subroutine init_moab_land(bounds, samegrid_al, LNDID) if (ierr > 0 ) & call endrun('Error: fail to update mesh info ') endif + ! add more domain fields that are missing from domain fields: lat, lon, mask, hgt tagname = 'lat:lon:mask:hgt'//C_NULL_CHAR tagtype = 1 ! dense, double @@ -1078,6 +1083,7 @@ subroutine init_moab_land(bounds, samegrid_al, LNDID) ierr = iMOAB_DefineTagStorage(mlnid, tagname, tagtype, numco, tagindex ) if (ierr > 0 ) & call endrun('Error: fail to create lat:lon:mask:hgt tags ') + ! moab_vert_coords is big enough in both case to hold enough data for us: lat, lon, mask do i = 1, lsz n = i-1 + bounds%begg @@ -1108,11 +1114,13 @@ subroutine init_moab_land(bounds, samegrid_al, LNDID) ! define tags according to the seq_flds_l2x_fields tagtype = 1 ! dense, double numco = 1 ! one value per cell / entity + tagname = trim(seq_flds_l2x_fields)//C_NULL_CHAR ierr = iMOAB_DefineTagStorage(mlnid, tagname, tagtype, numco, tagindex ) if ( ierr > 0) then call endrun('Error: fail to define seq_flds_l2x_fields for land moab mesh') endif + tagname = trim(seq_flds_x2l_fields)//C_NULL_CHAR ierr = iMOAB_DefineTagStorage(mlnid, tagname, tagtype, numco, tagindex ) if ( ierr > 0) then @@ -1241,8 +1249,8 @@ subroutine lnd_export_moab( bounds, lnd2atm_vars, lnd2glc_vars) end do tagname=trim(seq_flds_l2x_fields)//C_NULL_CHAR - if (sameg_al) then - ent_type = 0 ! vertices, cells only if sameg_al false + if (samegrid_al) then + ent_type = 0 ! vertices, cells only if samegrid_al false else ent_type = 1 endif @@ -1421,8 +1429,8 @@ subroutine lnd_import_moab( bounds, atm2lnd_vars, glc2lnd_vars) end if tagname=trim(seq_flds_x2l_fields)//C_NULL_CHAR - if (sameg_al) then - ent_type = 0 ! vertices, cells only if sameg_al false + if (samegrid_al) then + ent_type = 0 ! vertices, cells only if samegrid_al false else ent_type = 1 endif @@ -1452,879 +1460,6 @@ subroutine lnd_import_moab( bounds, atm2lnd_vars, glc2lnd_vars) atm2lnd_vars%supply_grc(g) = x2l_lm(i,index_x2l_Flrr_supply) atm2lnd_vars%deficit_grc(g) = x2l_lm(i,index_x2l_Flrr_deficit) - ! Determine required receive fields - -#ifdef CPL_BYPASS - !read forcing data directly, bypass coupler - atm2lnd_vars%forc_flood_grc(g) = 0._r8 - atm2lnd_vars%volr_grc(g) = 0._r8 - - !Get meteorological data, concatenated to include whole record - !Note we only do this at the first timestep and keep the whole forcing dataset in the memory - - !-----------------------------------Meteorological forcing ----------------------------------- - - call get_curr_date( yr, mon, day, tod ) - thiscalday = get_curr_calday() - nstep = get_nstep() - - !on first timestep, read all the met data for relevant gridcell(s) and store in array. - ! Met data are held in short integer format to save memory. - ! Each node must have enough memory to hold these data. - met_nvars=7 - if (metdata_type(1:3) == 'cpl') met_nvars=14 - - if (atm2lnd_vars%loaded_bypassdata == 0) then - !meteorological forcing - if (index(metdata_type, 'qian') .gt. 0) then - atm2lnd_vars%metsource = 0 - else if (index(metdata_type,'cru') .gt. 0) then - atm2lnd_vars%metsource = 1 - else if (index(metdata_type,'site') .gt. 0) then - atm2lnd_vars%metsource = 2 - else if (index(metdata_type,'princeton') .gt. 0) then - atm2lnd_vars%metsource = 3 - else if (index(metdata_type,'gswp3') .gt. 0) then - atm2lnd_vars%metsource = 4 - else if (index(metdata_type,'cpl') .gt. 0) then - atm2lnd_vars%metsource = 5 - else - call endrun( sub//' ERROR: Invalid met data source for cpl_bypass' ) - end if - - use_livneh = .false. - use_daymet = .false. - if(index(metdata_type, 'livneh') .gt. 0) then - use_livneh = .true. - else if (index(metdata_type, 'daymet') .gt. 0) then - use_daymet = .true. - end if - - metvars(1) = 'TBOT' - metvars(2) = 'PSRF' - metvars(3) = 'QBOT' - if (atm2lnd_vars%metsource .eq. 2) metvars(3) = 'RH' - if (atm2lnd_vars%metsource .ne. 5) metvars(4) = 'FSDS' - if (atm2lnd_vars%metsource .ne. 5) metvars(5) = 'PRECTmms' - if (atm2lnd_vars%metsource .ne. 5) metvars(6) = 'WIND' - metvars(4) = 'FSDS' - metvars(5) = 'PRECTmms' - metvars(6) = 'WIND' - metvars(7) = 'FLDS' - if (atm2lnd_vars%metsource .eq. 5) then - metvars(4) = 'SWNDF' - metvars(5) = 'RAINC' - metvars(6) = 'U' - metvars(8) = 'SWNDR' - metvars(9) = 'SWVDF' - metvars(10) = 'SWVDR' - metvars(11) = 'RAINL' - metvars(12) = 'SNOWC' - metvars(13) = 'SNOWL' - metvars(14) = 'V' - else - metvars(4) = 'FSDS' - metvars(5) = 'PRECTmms' - metvars(6) = 'WIND' - end if - - !set defaults - atm2lnd_vars%startyear_met = 1901 - atm2lnd_vars%endyear_met_spinup = 1920 - if (atm2lnd_vars%metsource == 0) then - metsource_str = 'qian' - atm2lnd_vars%startyear_met = 1948 - atm2lnd_vars%endyear_met_spinup = 1972 - atm2lnd_vars%endyear_met_trans = 2004 - else if (atm2lnd_vars%metsource == 1) then - metsource_str = 'cruncep' - atm2lnd_vars%endyear_met_trans = 2016 - else if (atm2lnd_vars%metsource == 2) then - metsource_str = 'site' - !get year information from file - ierr = nf90_open(trim(metdata_bypass) // '/all_hourly.nc', nf90_nowrite, ncid) - ierr = nf90_inq_varid(ncid, 'start_year', varid) - ierr = nf90_get_var(ncid, varid, atm2lnd_vars%startyear_met) - ierr = nf90_inq_varid(ncid, 'end_year', varid) - ierr = nf90_get_var(ncid, varid, atm2lnd_vars%endyear_met_spinup) - ierr = nf90_close(ncid) - atm2lnd_vars%endyear_met_trans = atm2lnd_vars%endyear_met_spinup - else if (atm2lnd_vars%metsource == 3) then - metsource_str = 'princeton' - atm2lnd_vars%endyear_met_trans = 2012 - else if (atm2lnd_vars%metsource == 4) then - atm2lnd_vars%endyear_met_trans = 2014 - else if (atm2lnd_vars%metsource == 5) then - atm2lnd_vars%startyear_met = 566 !76 - atm2lnd_vars%endyear_met_spinup = 590 !100 - atm2lnd_vars%endyear_met_trans = 590 !100 - end if - - if (use_livneh) then - atm2lnd_vars%startyear_met = 1950 - atm2lnd_vars%endyear_met_spinup = 1969 - else if (use_daymet) then - atm2lnd_vars%startyear_met = 1980 - atm2lnd_vars%endyear_met_spinup = atm2lnd_vars%endyear_met_trans - end if - - nyears_spinup = atm2lnd_vars%endyear_met_spinup - & - atm2lnd_vars%startyear_met + 1 - nyears_trans = atm2lnd_vars%endyear_met_trans - & - atm2lnd_vars%startyear_met + 1 - - !check for site data in run directory (monthly mean T, precip) - inquire(file=trim(metdata_biases), exist=use_sitedata) - - !get grid lat/lon information, zone mappings - inquire(file=trim(metdata_bypass) // '/zone_mappings.txt', exist=has_zonefile) - if (has_zonefile) then - open(unit=13, file=trim(metdata_bypass) // '/zone_mappings.txt') - else if (atm2lnd_vars%metsource .ne. 2) then - call endrun( sub//' ERROR: Zone mapping file does not exist for cpl_bypass' ) - end if - - if (atm2lnd_vars%metsource .ne. 2) then - ng = 0 !number of points - do v=1,500000 - read(13,*, end=10), longxy(v), latixy(v), zone_map(v), grid_map(v) - ng = ng + 1 - end do -10 continue - close(unit=13) - - !Figure out the closest point and which zone file to open - mindist=99999 - do g3 = 1,ng - thisdist = 100*((latixy(g3) - ldomain%latc(g))**2 + & - (longxy(g3) - ldomain%lonc(g))**2)**0.5 - if (thisdist .lt. mindist) then - mindist = thisdist - ztoget = zone_map(g3) - gtoget = grid_map(g3) - end if - end do - else - gtoget = 1 - end if - - !get the site metdata for bias correction if they exist (lat/lons must match domain file) - if (use_sitedata) then - open(unit=9, file=trim(metdata_biases),status='old') - read(9,*) thisline - site_metdata(:,:)=-999._r8 - do while ((site_metdata(1,1) .lt. ldomain%lonc(g) - 0.01 .or. & - site_metdata(1,1) .gt. ldomain%lonc(g) + 0.01) .and. & - (site_metdata(2,1) .lt. ldomain%latc(g) - 0.01 .or. & - site_metdata(2,1) .gt. ldomain%latc(g) + 0.01)) - read(9,*) site_metdata(1:7,1) - if (site_metdata(1,1) .lt. 0) site_metdata(1,1) = site_metdata(1,1)+360._r8 - end do - do line=2,12 - read(9,*) site_metdata(1:7,line) - end do - close(unit=9) - end if - - do v=1,met_nvars - write(zst, '(I3)') 100+ztoget - if (atm2lnd_vars%metsource == 0) then - metdata_fname = trim(metsource_str) // '_' // trim(metvars(v)) // '_z' // zst(2:3) // '.nc' - else if (atm2lnd_vars%metsource == 1) then - metdata_fname = 'CRUNCEP.v5_' // trim(metvars(v)) // '_1901-2013_z' // zst(2:3) // '.nc' - if (use_livneh .and. ztoget .ge. 16 .and. ztoget .le. 20) then - metdata_fname = 'CRUNCEP5_Livneh_' // trim(metvars(v)) // '_1950-2013_z' // zst(2:3) // '.nc' - else if (use_daymet .and. ztoget .ge. 16 .and. ztoget .le. 20) then - metdata_fname = 'CRUNCEP5_Daymet3_' // trim(metvars(v)) // '_1980-2013_z' // zst(2:3) // '.nc' - end if - else if (atm2lnd_vars%metsource == 2) then - metdata_fname = 'all_hourly.nc' - else if (atm2lnd_vars%metsource == 3) then - metdata_fname = 'Princeton_' // trim(metvars(v)) // '_1901-2012_z' // zst(2:3) // '.nc' - if (use_livneh .and. ztoget .ge. 16 .and. ztoget .le. 20) then - metdata_fname = 'Princeton_Livneh_' // trim(metvars(v)) // '_1950-2012_z' // zst(2:3) // '.nc' - else if (use_daymet .and. ztoget .ge. 16 .and. ztoget .le. 20) then - metdata_fname = 'Princeton_Daymet3_' // trim(metvars(v)) // '_1980-2012_z' // zst(2:3) // '.nc' - end if - else if (atm2lnd_vars%metsource == 4) then - metdata_fname = 'GSWP3_' // trim(metvars(v)) // '_1901-2014_z' // zst(2:3) // '.nc' - if (use_livneh .and. ztoget .ge. 16 .and. ztoget .le. 20) then - metdata_fname = 'GSWP3_Livneh_' // trim(metvars(v)) // '_1950-2010_z' // zst(2:3) // '.nc' - else if (use_daymet .and. ztoget .ge. 16 .and. ztoget .le. 20) then - metdata_fname = 'GSWP3_Daymet3_' // trim(metvars(v)) // '_1980-2010_z' // zst(2:3) // '.nc' - end if - else if (atm2lnd_vars%metsource == 5) then - !metdata_fname = 'WCYCL1850S.ne30_' // trim(metvars(v)) // '_0076-0100_z' // zst(2:3) // '.nc' - metdata_fname = 'CBGC1850S.ne30_' // trim(metvars(v)) // '_0566-0590_z' // zst(2:3) // '.nc' - end if - - ierr = nf90_open(trim(metdata_bypass) // '/' // trim(metdata_fname), NF90_NOWRITE, met_ncids(v)) - if (ierr .ne. 0) call endrun(msg=' ERROR: Failed to open cpl_bypass input meteorology file' ) - - !get timestep information - ierr = nf90_inq_dimid(met_ncids(v), 'DTIME', dimid) - ierr = nf90_Inquire_Dimension(met_ncids(v), dimid, len = atm2lnd_vars%timelen(v)) - - starti(1) = 1 - counti(1) = 2 - ierr = nf90_inq_varid(met_ncids(v), 'DTIME', varid) - ierr = nf90_get_var(met_ncids(v), varid, timetemp, starti(1:1), counti(1:1)) - atm2lnd_vars%timeres(v) = (timetemp(2)-timetemp(1))*24._r8 - atm2lnd_vars%npf(v) = 86400d0*(timetemp(2)-timetemp(1))/get_step_size() - atm2lnd_vars%timelen_spinup(v) = nyears_spinup*(365*nint(24./atm2lnd_vars%timeres(v))) - - ierr = nf90_inq_varid(met_ncids(v), trim(metvars(v)), varid) - !get the conversion factors - ierr = nf90_get_att(met_ncids(v), varid, 'scale_factor', atm2lnd_vars%scale_factors(v)) - ierr = nf90_get_att(met_ncids(v), varid, 'add_offset', atm2lnd_vars%add_offsets(v)) - !get the met data - starti(1) = 1 - starti(2) = gtoget - counti(1) = atm2lnd_vars%timelen_spinup(v) - counti(2) = 1 - if (.not. const_climate_hist .and. (yr .ge. 1850 .or. use_sitedata)) counti(1) = atm2lnd_vars%timelen(v) - - if (i == 1 .and. v == 1) then - allocate(atm2lnd_vars%atm_input (met_nvars,bounds%begg:bounds%endg,1,1:counti(1))) - end if - - ierr = nf90_get_var(met_ncids(v), varid, atm2lnd_vars%atm_input(v,g:g,1,1:counti(1)), starti(1:2), counti(1:2)) - ierr = nf90_close(met_ncids(v)) - - if (use_sitedata .and. v == 1) then - starti_site = max((nint(site_metdata(4,1))-atm2lnd_vars%startyear_met) * & - 365*nint(24./atm2lnd_vars%timeres(v))+1,1) - endi_site = (min(atm2lnd_vars%endyear_met_trans,nint(site_metdata(5,1))) - & - atm2lnd_vars%startyear_met+1)*(365*nint(24./atm2lnd_vars%timeres(v))) - end if - - atm2lnd_vars%var_offset(v,g,:) = 0._r8 - atm2lnd_vars%var_mult(v,g,:) = 1._r8 - - if (use_sitedata) then - !Compute monthly biases for site vs. reanalysis - var_month_mean(:) = 0._r8 - var_month_count(:) = 0 - do i=starti_site, endi_site - thisdoy = mod(i,365*nint(24./atm2lnd_vars%timeres(v)))/(nint(24./atm2lnd_vars%timeres(v)))+1 - do m=1,12 - if (thisdoy .ge. caldaym(m) .and. thisdoy .lt. caldaym(m+1)) thism = m - enddo - var_month_mean(thism) = var_month_mean(thism) + (atm2lnd_vars%atm_input(v,g,1,i)* & - atm2lnd_vars%scale_factors(v) + atm2lnd_vars%add_offsets(v)) - var_month_count(thism) = var_month_count(thism)+1 - end do - - do m = 1,12 - var_month_mean(m) = var_month_mean(m)/var_month_count(m) - !calculate offset and linear bias factors for temperature and precipitation - if (v .eq. 1) atm2lnd_vars%var_offset(v,g,m) = (site_metdata(6,m)+SHR_CONST_TKFRZ) - var_month_mean(m) - if (v .eq. 5 .and. var_month_mean(m) .gt. 0) & - atm2lnd_vars%var_mult(v,g,m) = (site_metdata(7,m))/(caldaym(m+1)-caldaym(m))/24._r8/ & - 3600._r8 / var_month_mean(m) - end do - end if - - !Align spinups and transient simulations - !figure out which year to start with (assuming spinups always use integer multiple of met cycles) - mystart = atm2lnd_vars%startyear_met - do while (mystart > 1850) - mystart = mystart - nyears_spinup - end do - if (atm2lnd_vars%metsource == 5) mystart=1850 - - if (yr .lt. 1850) then - atm2lnd_vars%tindex(g,v,1) = (mod(yr-1,nyears_spinup) + (1850-mystart)) * 365 * nint(24./atm2lnd_vars%timeres(v)) - else if (yr .le. atm2lnd_vars%endyear_met_spinup) then - atm2lnd_vars%tindex(g,v,1) = (mod(yr-1850,nyears_spinup) + (1850-mystart)) * 365 * nint(24./atm2lnd_vars%timeres(v)) - else - atm2lnd_vars%tindex(g,v,1) = (yr - atm2lnd_vars%startyear_met) * 365 * nint(24./atm2lnd_vars%timeres(v)) - end if - !adjust for starts not at beginning of year (but currently MUST begin at hour 0) - atm2lnd_vars%tindex(g,v,1) = atm2lnd_vars%tindex(g,v,1) + (caldaym(mon)+day-2)* & - nint(24./atm2lnd_vars%timeres(v)) - - atm2lnd_vars%tindex(g,v,2) = atm2lnd_vars%tindex(g,v,1) + 1 - if (atm2lnd_vars%tindex(g,v,1) == 0) then - atm2lnd_vars%tindex(g,v,1) = atm2lnd_vars%timelen(v) - if (yr .le. atm2lnd_vars%endyear_met_spinup) atm2lnd_vars%tindex(g,v,1) = atm2lnd_vars%timelen_spinup(v) - end if - end do !end variable loop - else - do v=1,met_nvars - if (atm2lnd_vars%npf(v) - 1._r8 .gt. 1e-3) then - if (v .eq. 4 .or. v .eq. 5 .or. (v .ge. 8 .and. v .le. 13)) then !rad/Precipitation - if (mod(tod/get_step_size(),nint(atm2lnd_vars%npf(v))) == 1 .and. nstep .gt. 3) then - atm2lnd_vars%tindex(g,v,1) = atm2lnd_vars%tindex(g,v,1)+1 - atm2lnd_vars%tindex(g,v,2) = atm2lnd_vars%tindex(g,v,2)+1 - end if - else - if (mod(tod/get_step_size()-1,nint(atm2lnd_vars%npf(v))) <= atm2lnd_vars%npf(v)/2._r8 .and. & - mod(tod/get_step_size(),nint(atm2lnd_vars%npf(v))) > atm2lnd_vars%npf(v)/2._r8) then - atm2lnd_vars%tindex(g,v,1) = atm2lnd_vars%tindex(g,v,1)+1 - atm2lnd_vars%tindex(g,v,2) = atm2lnd_vars%tindex(g,v,2)+1 - end if - end if - else - atm2lnd_vars%tindex(g,v,1) = atm2lnd_vars%tindex(g,v,1)+nint(1/atm2lnd_vars%npf(v)) - atm2lnd_vars%tindex(g,v,2) = atm2lnd_vars%tindex(g,v,2)+nint(1/atm2lnd_vars%npf(v)) - end if - - if (const_climate_hist .or. yr .le. atm2lnd_vars%startyear_met) then - if (atm2lnd_vars%tindex(g,v,1) .gt. atm2lnd_vars%timelen_spinup(v)) atm2lnd_vars%tindex(g,v,1) = 1 - if (atm2lnd_vars%tindex(g,v,2) .gt. atm2lnd_vars%timelen_spinup(v)) atm2lnd_vars%tindex(g,v,2) = 1 - else if (yr .gt. atm2lnd_vars%endyear_met_trans) then - if (atm2lnd_vars%tindex(g,v,1) .gt. atm2lnd_vars%timelen(v)) then - atm2lnd_vars%tindex(g,v,1) = atm2lnd_vars%timelen(v)-atm2lnd_vars%timelen_spinup(v)+1 - end if - if (atm2lnd_vars%tindex(g,v,2) .gt. atm2lnd_vars%timelen(v)) then - atm2lnd_vars%tindex(g,v,2) = atm2lnd_vars%timelen(v)-atm2lnd_vars%timelen_spinup(v)+1 - end if - end if - - !if (yr .gt. atm2lnd_vars%startyear_met) then - ! if (atm2lnd_vars%tindex(g,v,1) .gt. atm2lnd_vars%timelen(v)) atm2lnd_vars%tindex(g,v,1) = 1 - ! if (atm2lnd_vars%tindex(g,v,2) .gt. atm2lnd_vars%timelen(v)) atm2lnd_vars%tindex(g,v,2) = 1 - !else - ! if (atm2lnd_vars%tindex(g,v,1) .gt. atm2lnd_vars%timelen_spinup(v)) atm2lnd_vars%tindex(g,v,1) = 1 - ! if (atm2lnd_vars%tindex(g,v,2) .gt. atm2lnd_vars%timelen_spinup(v)) atm2lnd_vars%tindex(g,v,2) = 1 - !end if - end do - end if - - tindex = atm2lnd_vars%tindex(g,:,:) - - !get weights for linear interpolation - do v=1,met_nvars - if (atm2lnd_vars%npf(v) - 1._r8 .gt. 1e-3) then - wt1(v) = 1._r8 - (mod((tod+86400)/get_step_size()-atm2lnd_vars%npf(v)/2._r8, & - atm2lnd_vars%npf(v))*1._r8)/atm2lnd_vars%npf(v) - wt2(v) = 1._r8 - wt1(v) - else - wt1(v) = 0._r8 - wt2(v) = 1._r8 - end if - end do - - !Air temperature - atm2lnd_vars%forc_t_not_downscaled_grc(g) = min(((atm2lnd_vars%atm_input(1,g,1,tindex(1,1))*atm2lnd_vars%scale_factors(1)+ & - atm2lnd_vars%add_offsets(1))*wt1(1) + (atm2lnd_vars%atm_input(1,g,1,tindex(1,2))* & - atm2lnd_vars%scale_factors(1)+atm2lnd_vars%add_offsets(1))*wt2(1)) * & - atm2lnd_vars%var_mult(1,g,mon) + atm2lnd_vars%var_offset(1,g,mon), 323._r8) - atm2lnd_vars%forc_th_not_downscaled_grc(g) = min(((atm2lnd_vars%atm_input(1,g,1,tindex(1,1))*atm2lnd_vars%scale_factors(1)+ & - atm2lnd_vars%add_offsets(1))*wt1(1) + (atm2lnd_vars%atm_input(1,g,1,tindex(1,2))* & - atm2lnd_vars%scale_factors(1)+atm2lnd_vars%add_offsets(1))*wt2(1)) * & - atm2lnd_vars%var_mult(1,g,mon) + atm2lnd_vars%var_offset(1,g,mon), 323._r8) - - tbot = atm2lnd_vars%forc_t_not_downscaled_grc(g) - - !Air pressure - atm2lnd_vars%forc_pbot_not_downscaled_grc(g) = max(((atm2lnd_vars%atm_input(2,g,1,tindex(2,1))*atm2lnd_vars%scale_factors(2)+ & - atm2lnd_vars%add_offsets(2))*wt1(2) + (atm2lnd_vars%atm_input(2,g,1,tindex(2,2)) & - *atm2lnd_vars%scale_factors(2)+atm2lnd_vars%add_offsets(2))*wt2(2)) * & - atm2lnd_vars%var_mult(2,g,mon) + atm2lnd_vars%var_offset(2,g,mon), 4e4_r8) - !Specific humidity - atm2lnd_vars%forc_q_not_downscaled_grc(g) = max(((atm2lnd_vars%atm_input(3,g,1,tindex(3,1))*atm2lnd_vars%scale_factors(3)+ & - atm2lnd_vars%add_offsets(3))*wt1(3) + (atm2lnd_vars%atm_input(3,g,1,tindex(3,2)) & - *atm2lnd_vars%scale_factors(3)+atm2lnd_vars%add_offsets(3))*wt2(3)) * & - atm2lnd_vars%var_mult(3,g,mon) + atm2lnd_vars%var_offset(3,g,mon), 1e-9_r8) - - if (atm2lnd_vars%metsource == 2) then !convert RH to qbot - if (tbot > SHR_CONST_TKFRZ) then - e = esatw(tdc(tbot)) - else - e = esati(tdc(tbot)) - end if - qsat = 0.622_r8*e / (atm2lnd_vars%forc_pbot_not_downscaled_grc(g) - 0.378_r8*e) - atm2lnd_vars%forc_q_not_downscaled_grc(g) = qsat * atm2lnd_vars%forc_q_not_downscaled_grc(g) / 100.0_r8 - end if - - !use longwave from file if provided - atm2lnd_vars%forc_lwrad_not_downscaled_grc(g) = ((atm2lnd_vars%atm_input(7,g,1,tindex(7,1))*atm2lnd_vars%scale_factors(7)+ & - atm2lnd_vars%add_offsets(7))*wt1(7) + (atm2lnd_vars%atm_input(7,g,1,tindex(7,2)) & - *atm2lnd_vars%scale_factors(7)+atm2lnd_vars%add_offsets(7))*wt2(7)) * & - atm2lnd_vars%var_mult(7,g,mon) + atm2lnd_vars%var_offset(7,g,mon) - if (atm2lnd_vars%forc_lwrad_not_downscaled_grc(g) .le. 50 .or. atm2lnd_vars%forc_lwrad_not_downscaled_grc(g) .ge. 600) then - !Longwave radiation (calculated from air temperature, humidity) - e = atm2lnd_vars%forc_pbot_not_downscaled_grc(g) * atm2lnd_vars%forc_q_not_downscaled_grc(g) / & - (0.622_R8 + 0.378_R8 * atm2lnd_vars%forc_q_not_downscaled_grc(g) ) - ea = 0.70_R8 + 5.95e-05_R8 * 0.01_R8 * e * exp(1500.0_R8/tbot) - atm2lnd_vars%forc_lwrad_not_downscaled_grc(g) = ea * SHR_CONST_STEBOL * tbot**4 - end if - - !Shortwave radiation (cosine zenith angle interpolation) - thishr = (tod-get_step_size()/2)/3600 - if (thishr < 0) thishr=thishr+24 - thismin = mod((tod-get_step_size()/2)/60, 60) - thiscosz = max(cos(szenith(ldomain%lonc(g),ldomain%latc(g),0,int(thiscalday),thishr,thismin,0)* & - 3.14159265358979/180.0d0), 0.001d0) - avgcosz = 0d0 - if (atm2lnd_vars%npf(4) - 1._r8 .gt. 1e-3) then - swrad_period_len = get_step_size()*nint(atm2lnd_vars%npf(4)) - swrad_period_start = ((tod-get_step_size()/2)/swrad_period_len) * swrad_period_len - !set to last period if first model timestep of the day - if (tod-get_step_size()/2 < 0) swrad_period_start = ((86400-get_step_size()/2)/swrad_period_len) * swrad_period_len - - do tm=1,nint(atm2lnd_vars%npf(4)) - !Get the average cosine zenith angle over the time resolution of the input data - thishr = (swrad_period_start+(tm-1)*get_step_size()+get_step_size()/2)/3600 - if (thishr > 23) thishr=thishr-24 - thismin = mod((swrad_period_start+(tm-1)*get_step_size()+get_step_size()/2)/60, 60) - avgcosz = avgcosz + max(cos(szenith(ldomain%lonc(g),ldomain%latc(g),0,int(thiscalday),thishr, thismin, 0) & - *3.14159265358979/180.0d0), 0.001d0)/atm2lnd_vars%npf(4) - end do - else - avgcosz = thiscosz - end if - if (thiscosz > 0.001d0) then - wt2(4) = min(thiscosz/avgcosz, 10.0_r8) - else - wt2(4) = 0d0 - end if - - if (atm2lnd_vars%metsource == 5) then - wt2(4)=1.0 !cosz interp not working - wt2(8:10)=1.0 - swndf = max(((atm2lnd_vars%atm_input(4,g,1,tindex(4,2))*atm2lnd_vars%scale_factors(4)+ & - atm2lnd_vars%add_offsets(4))*wt2(4)), 0.0_r8) - swndr = max(((atm2lnd_vars%atm_input(8,g,1,tindex(8,2))*atm2lnd_vars%scale_factors(8)+ & - atm2lnd_vars%add_offsets(8))*wt2(8)), 0.0_r8) - swvdf = max(((atm2lnd_vars%atm_input(9,g,1,tindex(9,2))*atm2lnd_vars%scale_factors(9)+ & - atm2lnd_vars%add_offsets(9))*wt2(9)), 0.0_r8) - swvdr = max(((atm2lnd_vars%atm_input(10,g,1,tindex(10,2))*atm2lnd_vars%scale_factors(10)+ & - atm2lnd_vars%add_offsets(10))*wt2(10)), 0.0_r8) - atm2lnd_vars%forc_solad_grc(g,2) = swndr - atm2lnd_vars%forc_solad_grc(g,1) = swvdr - atm2lnd_vars%forc_solai_grc(g,2) = swndf - atm2lnd_vars%forc_solai_grc(g,1) = swvdf - else - swndr = max(((atm2lnd_vars%atm_input(4,g,1,tindex(4,2))*atm2lnd_vars%scale_factors(4)+ & - atm2lnd_vars%add_offsets(4))*wt2(4)) * 0.50_R8, 0.0_r8) - swndf = max(((atm2lnd_vars%atm_input(4,g,1,tindex(4,2))*atm2lnd_vars%scale_factors(4)+ & - atm2lnd_vars%add_offsets(4))*wt2(4))*0.50_R8, 0.0_r8) - swvdr = max(((atm2lnd_vars%atm_input(4,g,1,tindex(4,2))*atm2lnd_vars%scale_factors(4)+ & - atm2lnd_vars%add_offsets(4))*wt2(4))*0.50_R8, 0.0_r8) - swvdf = max(((atm2lnd_vars%atm_input(4,g,1,tindex(4,2))*atm2lnd_vars%scale_factors(4)+ & - atm2lnd_vars%add_offsets(4))*wt2(4))*0.50_R8, 0.0_r8) - ratio_rvrf = min(0.99_R8,max(0.29548_R8 + 0.00504_R8*swndr & - -1.4957e-05_R8*swndr**2 + 1.4881e-08_R8*swndr**3,0.01_R8)) - atm2lnd_vars%forc_solad_grc(g,2) = ratio_rvrf*swndr - atm2lnd_vars%forc_solai_grc(g,2) = (1._R8 - ratio_rvrf)*swndf - ratio_rvrf = min(0.99_R8,max(0.17639_R8 + 0.00380_R8*swvdr & - -9.0039e-06_R8*swvdr**2 +8.1351e-09_R8*swvdr**3,0.01_R8)) - atm2lnd_vars%forc_solad_grc(g,1) = ratio_rvrf*swvdr - atm2lnd_vars%forc_solai_grc(g,1) = (1._R8 - ratio_rvrf)*swvdf - end if - !Rain and snow - if (atm2lnd_vars%metsource == 5) then - forc_rainc = max((((atm2lnd_vars%atm_input(5,g,1,tindex(5,2))*atm2lnd_vars%scale_factors(5)+ & - atm2lnd_vars%add_offsets(5)))*atm2lnd_vars%var_mult(5,g,mon) + & - atm2lnd_vars%var_offset(5,g,mon)), 0.0_r8) - forc_rainl = max((((atm2lnd_vars%atm_input(11,g,1,tindex(11,2))*atm2lnd_vars%scale_factors(11)+ & - atm2lnd_vars%add_offsets(11)))*atm2lnd_vars%var_mult(11,g,mon) + & - atm2lnd_vars%var_offset(11,g,mon)), 0.0_r8) - forc_snowc = max((((atm2lnd_vars%atm_input(12,g,1,tindex(12,2))*atm2lnd_vars%scale_factors(12)+ & - atm2lnd_vars%add_offsets(12)))*atm2lnd_vars%var_mult(12,g,mon) + & - atm2lnd_vars%var_offset(12,g,mon)), 0.0_r8) - forc_snowl = max((((atm2lnd_vars%atm_input(13,g,1,tindex(13,2))*atm2lnd_vars%scale_factors(13)+ & - atm2lnd_vars%add_offsets(13)))*atm2lnd_vars%var_mult(13,g,mon) + & - atm2lnd_vars%var_offset(13,g,mon)), 0.0_r8) - else - frac = (atm2lnd_vars%forc_t_not_downscaled_grc(g) - SHR_CONST_TKFRZ)*0.5_R8 ! ramp near freezing - frac = min(1.0_R8,max(0.0_R8,frac)) ! bound in [0,1] - !Don't interpolate rainfall data - forc_rainc = 0.1_R8 * frac * max((((atm2lnd_vars%atm_input(5,g,1,tindex(5,2))*atm2lnd_vars%scale_factors(5)+ & - atm2lnd_vars%add_offsets(5)))*atm2lnd_vars%var_mult(5,g,mon) + & - atm2lnd_vars%var_offset(5,g,mon)), 0.0_r8) - forc_rainl = 0.9_R8 * frac * max((((atm2lnd_vars%atm_input(5,g,1,tindex(5,2))*atm2lnd_vars%scale_factors(5)+ & - atm2lnd_vars%add_offsets(5)))*atm2lnd_vars%var_mult(5,g,mon) + & - atm2lnd_vars%var_offset(5,g,mon)), 0.0_r8) - forc_snowc = 0.1_R8 * (1.0_R8 - frac) * max((((atm2lnd_vars%atm_input(5,g,1,tindex(5,2))*atm2lnd_vars%scale_factors(5)+ & - atm2lnd_vars%add_offsets(5)))*atm2lnd_vars%var_mult(5,g,mon) + atm2lnd_vars%var_offset(5,g,mon)), 0.0_r8) - forc_snowl = 0.9_R8 * (1.0_R8 - frac) * max((((atm2lnd_vars%atm_input(5,g,1,tindex(5,2))*atm2lnd_vars%scale_factors(5)+ & - atm2lnd_vars%add_offsets(5))) * atm2lnd_vars%var_mult(5,g,mon) + atm2lnd_vars%var_offset(5,g,mon)), 0.0_r8) - end if - !Wind - atm2lnd_vars%forc_u_grc(g) = (atm2lnd_vars%atm_input(6,g,1,tindex(6,1))*atm2lnd_vars%scale_factors(6)+ & - atm2lnd_vars%add_offsets(6))*wt1(6) + (atm2lnd_vars%atm_input(6,g,1,tindex(6,2))* & - atm2lnd_vars%scale_factors(6)+atm2lnd_vars%add_offsets(6))*wt2(6) - if (atm2lnd_vars%metsource == 5) then - atm2lnd_vars%forc_v_grc(g) = (atm2lnd_vars%atm_input(14,g,1,tindex(14,1))*atm2lnd_vars%scale_factors(14)+ & - atm2lnd_vars%add_offsets(14))*wt1(14) + (atm2lnd_vars%atm_input(14,g,1,tindex(14,2))* & - atm2lnd_vars%scale_factors(14)+atm2lnd_vars%add_offsets(14))*wt2(14) - else - atm2lnd_vars%forc_v_grc(g) = 0.0_R8 - end if - atm2lnd_vars%forc_hgt_grc(g) = 30.0_R8 !(atm2lnd_vars%atm_input(8,g,1,tindex(1))*wt1 + & - !atm2lnd_vars%atm_input(8,g,1,tindex(2))*wt2) ! zgcmxy Atm state, default=30m - - !------------------------------------Fire data ------------------------------------------------------- - - nindex(1) = yr-1848 - nindex(2) = nindex(1)+1 - if (yr .lt. 1850 .or. const_climate_hist) nindex(1:2) = 2 - if (yr .ge. 2010 .and. .not. const_climate_hist) nindex(1:2) = 161 - - model_filter: if (use_cn .or. use_fates) then - if (atm2lnd_vars%loaded_bypassdata == 0 .or. (mon .eq. 1 .and. day .eq. 1 .and. tod .eq. 0)) then - if (masterproc .and. i .eq. 1) then - ! Read pop_dens streams namelist to get filename - nu_nml = getavu() - open(nu_nml, file=trim(NLFilename), status='old', iostat=nml_error ) - call find_nlgroup_name(nu_nml, 'popd_streams', status=nml_error) - if (nml_error == 0) then - read(nu_nml, nml=popd_streams,iostat=nml_error) - if (nml_error /= 0) then - call endrun(msg='ERROR reading popdens namelist') - end if - end if - close(nu_nml) - call relavu( nu_nml ) - - ierr = nf90_open(trim(stream_fldFileName_popdens), NF90_NOWRITE, ncid) - ierr = nf90_inq_varid(ncid, 'lat', varid) - ierr = nf90_get_var(ncid, varid, smap05_lat) - ierr = nf90_inq_varid(ncid, 'lon', varid) - ierr = nf90_get_var(ncid, varid, smap05_lon) - ierr = nf90_inq_varid(ncid, 'hdm', varid) - starti(1:2) = 1 - starti(3) = nindex(1) - counti(1) = 720 - counti(2) = 360 - counti(3) = 1 - ierr = nf90_get_var(ncid, varid, atm2lnd_vars%hdm1, starti, counti) - starti(3) = nindex(2) - if (nindex(1) .ne. nindex(2)) then - ierr = nf90_get_var(ncid, varid, atm2lnd_vars%hdm2, starti, counti) - else - atm2lnd_vars%hdm2 = atm2lnd_vars%hdm1 - end if - ierr = nf90_close(ncid) - end if - - if (i .eq. 1) then - call mpi_bcast (atm2lnd_vars%hdm1, 360*720, MPI_REAL8, 0, mpicom, ier) - call mpi_bcast (atm2lnd_vars%hdm2, 360*720, MPI_REAL8, 0, mpicom, ier) - call mpi_bcast (smap05_lon, 720, MPI_REAL8, 0, mpicom, ier) - call mpi_bcast (smap05_lat, 360, MPI_REAL8, 0, mpicom, ier) - end if - end if - - !figure out which point to get - if (atm2lnd_vars%loaded_bypassdata == 0) then - mindist=99999 - do thisx = 1,720 - do thisy = 1,360 - if (ldomain%lonc(g) .lt. 0) then - if (smap05_lon(thisx) >= 180) smap05_lon(thisx) = smap05_lon(thisx)-360._r8 - else if (ldomain%lonc(g) .ge. 180) then - if (smap05_lon(thisx) < 0) smap05_lon(thisx) = smap05_lon(thisx) + 360._r8 - end if - thisdist = 100*((smap05_lat(thisy) - ldomain%latc(g))**2 + & - (smap05_lon(thisx) - ldomain%lonc(g))**2)**0.5 - if (thisdist .lt. mindist) then - mindist = thisdist - atm2lnd_vars%hdmind(g,1) = thisx - atm2lnd_vars%hdmind(g,2) = thisy - end if - end do - end do - end if - !get weights for interpolation - wt1(1) = 1._r8 - (thiscalday -1._r8)/365._r8 - wt2(1) = 1._r8 - wt1(1) - atm2lnd_vars%forc_hdm(g) = atm2lnd_vars%hdm1(atm2lnd_vars%hdmind(g,1),atm2lnd_vars%hdmind(g,2),1)*wt1(1) + & - atm2lnd_vars%hdm2(atm2lnd_vars%hdmind(g,1),atm2lnd_vars%hdmind(g,2),1)*wt2(1) - - if (atm2lnd_vars%loaded_bypassdata .eq. 0 .and. masterproc .and. i .eq. 1) then - ! Read light_streams namelist to get filename - nu_nml = getavu() - open( nu_nml, file=trim(NLFilename), status='old', iostat=nml_error ) - call find_nlgroup_name(nu_nml, 'light_streams', status=nml_error) - if (nml_error == 0) then - read(nu_nml, nml=light_streams,iostat=nml_error) - if (nml_error /= 0) then - call endrun(msg='ERROR reading light_streams namelist') - end if - end if - close(nu_nml) - call relavu( nu_nml ) - - !Get all of the data (master processor only) - allocate(atm2lnd_vars%lnfm_all (192,94,2920)) - ierr = nf90_open(trim(stream_fldFileName_lightng), NF90_NOWRITE, ncid) - ierr = nf90_inq_varid(ncid, 'lat', varid) - ierr = nf90_get_var(ncid, varid, smapt62_lat) - ierr = nf90_inq_varid(ncid, 'lon', varid) - ierr = nf90_get_var(ncid, varid, smapt62_lon) - ierr = nf90_inq_varid(ncid, 'lnfm', varid) - ierr = nf90_get_var(ncid, varid, atm2lnd_vars%lnfm_all) - ierr = nf90_close(ncid) - end if - if (atm2lnd_vars%loaded_bypassdata .eq. 0 .and. i .eq. 1) then - call mpi_bcast (smapt62_lon, 192, MPI_REAL8, 0, mpicom, ier) - call mpi_bcast (smapt62_lat, 94, MPI_REAL8, 0, mpicom, ier) - end if - if (atm2lnd_vars%loaded_bypassdata .eq. 0) then - mindist=99999 - do thisx = 1,192 - do thisy = 1,94 - if (ldomain%lonc(g) .lt. 0) then - if (smapt62_lon(thisx) >= 180) smapt62_lon(thisx) = smapt62_lon(thisx)-360._r8 - else if (ldomain%lonc(g) .ge. 180) then - if (smapt62_lon(thisx) < 0) smapt62_lon(thisx) = smapt62_lon(thisx) + 360._r8 - end if - thisdist = 100*((smapt62_lat(thisy) - ldomain%latc(g))**2 + & - (smapt62_lon(thisx) - ldomain%lonc(g))**2)**0.5 - if (thisdist .lt. mindist) then - mindist = thisdist - lnfmind(1) = thisx - lnfmind(2) = thisy - end if - end do - end do - if (masterproc) then - atm2lnd_vars%lnfm(g,:) = atm2lnd_vars%lnfm_all(lnfmind(1),lnfmind(2),:) - do np = 1,npes-1 - if (i == 1) then - call mpi_recv(thisng, 1, MPI_INTEGER, np, 100000+np, mpicom, status, ier) - ng_all(np) = thisng - end if - if (i <= ng_all(np)) then - call mpi_recv(lnfmind, 2, MPI_INTEGER, np, 200000+np, mpicom, status, ier) - call mpi_send(atm2lnd_vars%lnfm_all(lnfmind(1),lnfmind(2),:), 2920, & - MPI_REAL8, np, 300000+np, mpicom, ier) - end if - end do - else - if (i == 1) call mpi_send(thisng, 1, MPI_INTEGER, 0, 100000+iam, mpicom, ier) - call mpi_send(lnfmind, 2, MPI_INTEGER, 0, 200000+iam, mpicom, ier) - call mpi_recv(atm2lnd_vars%lnfm(g,:), 2920, MPI_REAL8, 0, 300000+iam, mpicom, status, ier) - end if - end if - - !Lightning data is 3-hourly. Does not currently interpolate. - atm2lnd_vars%forc_lnfm(g) = atm2lnd_vars%lnfm(g, ((int(thiscalday)-1)*8+tod/(3600*3))+1) - - !------------------------------------Nitrogen deposition---------------------------------------------- - - !DMR note - ndep will NOT be correct if more than 1850 years of model - !spinup (model year > 1850) - nindex(1) = min(max(yr-1848,2), 168) - nindex(2) = min(nindex(1)+1, 168) - - if (atm2lnd_vars%loaded_bypassdata .eq. 0 .or. (mon .eq. 1 .and. day .eq. 1 .and. tod .eq. 0)) then - if (masterproc .and. i .eq. 1) then - nu_nml = getavu() - open( nu_nml, file=trim(NLFilename), status='old', iostat=nml_error ) - call find_nlgroup_name(nu_nml, 'ndepdyn_nml', status=nml_error) - if (nml_error == 0) then - read(nu_nml, nml=ndepdyn_nml,iostat=nml_error) - if (nml_error /= 0) then - call endrun(msg='ERROR reading ndep namelist') - end if - end if - close(nu_nml) - call relavu( nu_nml ) - - ierr = nf90_open(trim(stream_fldFileName_ndep), nf90_nowrite, ncid) - ierr = nf90_inq_varid(ncid, 'lat', varid) - ierr = nf90_get_var(ncid, varid, smap2_lat) - ierr = nf90_inq_varid(ncid, 'lon', varid) - ierr = nf90_get_var(ncid, varid, smap2_lon) - ierr = nf90_inq_varid(ncid, 'NDEP_year', varid) - starti(1:2) = 1 - starti(3) = nindex(1) - counti(1) = 144 - counti(2) = 96 - counti(3) = 1 - ierr = nf90_get_var(ncid, varid, atm2lnd_vars%ndep1, starti, counti) - if (nindex(1) .ne. nindex(2)) then - starti(3) = nindex(2) - ierr = nf90_get_var(ncid, varid, atm2lnd_vars%ndep2, starti, counti) - else - atm2lnd_vars%ndep2 = atm2lnd_vars%ndep1 - end if - ierr = nf90_close(ncid) - end if - if (i .eq. 1) then - call mpi_bcast (atm2lnd_vars%ndep1, 144*96, MPI_REAL8, 0, mpicom, ier) - call mpi_bcast (atm2lnd_vars%ndep2, 144*96, MPI_REAL8, 0, mpicom, ier) - call mpi_bcast (smap2_lon, 144, MPI_REAL8, 0, mpicom, ier) - call mpi_bcast (smap2_lat, 96, MPI_REAL8, 0, mpicom, ier) - end if - end if - - if (atm2lnd_vars%loaded_bypassdata .eq. 0) then - mindist=99999 - do thisx = 1,144 - do thisy = 1,96 - if (ldomain%lonc(g) .lt. 0) then - if (smap2_lon(thisx) >= 180) smap2_lon(thisx) = smap2_lon(thisx)-360._r8 - else if (ldomain%lonc(g) .ge. 180) then - if (smap2_lon(thisx) < 0) smap2_lon(thisx) = smap2_lon(thisx) + 360._r8 - end if - thislon = smap2_lon(thisx) - thisdist = 100*((smap2_lat(thisy) - ldomain%latc(g))**2 + & - (thislon - ldomain%lonc(g))**2)**0.5 - if (thisdist .lt. mindist) then - mindist = thisdist - atm2lnd_vars%ndepind(g,1) = thisx - atm2lnd_vars%ndepind(g,2) = thisy - end if - end do - end do - end if - - !get weights for interpolation - wt1(1) = 1._r8 - (thiscalday -1._r8)/365._r8 - wt2(1) = 1._r8 - wt1(1) - - atm2lnd_vars%forc_ndep_grc(g) = (atm2lnd_vars%ndep1(atm2lnd_vars%ndepind(g,1),atm2lnd_vars%ndepind(g,2),1)*wt1(1) + & - atm2lnd_vars%ndep2(atm2lnd_vars%ndepind(g,1),atm2lnd_vars%ndepind(g,2),1)*wt2(1)) / (365._r8 * 86400._r8) - end if model_filter - - !------------------------------------Aerosol forcing-------------------------------------------------- - if (atm2lnd_vars%loaded_bypassdata .eq. 0 .or. (mon .eq. 1 .and. day .eq. 1 .and. tod .eq. 0)) then - if (masterproc .and. i .eq. 1) then - aerovars(1) = 'BCDEPWET' - aerovars(2) = 'BCPHODRY' - aerovars(3) = 'BCPHIDRY' - aerovars(4) = 'OCDEPWET' - aerovars(5) = 'OCPHODRY' - aerovars(6) = 'OCPHIDRY' - aerovars(7) = 'DSTX01DD' - aerovars(8) = 'DSTX02DD' - aerovars(9) = 'DSTX03DD' - aerovars(10) = 'DSTX04DD' - aerovars(11) = 'DSTX01WD' - aerovars(12) = 'DSTX02WD' - aerovars(13) = 'DSTX03WD' - aerovars(14) = 'DSTX04WD' - ierr = nf90_open(trim(aero_file), nf90_nowrite, ncid) - ierr = nf90_inq_varid(ncid, 'lat', varid) - ierr = nf90_get_var(ncid, varid, smap2_lat) - ierr = nf90_inq_varid(ncid, 'lon', varid) - ierr = nf90_get_var(ncid, varid, smap2_lon) - starti(1:2) = 1 - starti(3) = max((min(yr,2100)-1849)*12+1, 13)-1 - counti(1) = 144 - counti(2) = 96 - counti(3) = 14 - do av=1,14 - ierr = nf90_inq_varid(ncid, trim(aerovars(av)), varid) - ierr = nf90_get_var(ncid, varid, atm2lnd_vars%aerodata(av,:,:,:), starti, counti) - end do - ierr = nf90_close(ncid) - end if - if (i .eq. 1) then - call mpi_bcast (atm2lnd_vars%aerodata, 14*144*96*14, MPI_REAL8, 0, mpicom, ier) - end if - end if - - !Use ndep grid indices since they're on the same grid - if (atm2lnd_vars%loaded_bypassdata .eq. 0 .and. (.not. (use_fates .or. use_cn) ) ) then - mindist=99999 - do thisx = 1,144 - do thisy = 1,96 - if (ldomain%lonc(g) .lt. 0) then - if (smap2_lon(thisx) >= 180) smap2_lon(thisx) = smap2_lon(thisx)-360._r8 - else if (ldomain%lonc(g) .ge. 180) then - if (smap2_lon(thisx) < 0) smap2_lon(thisx) = smap2_lon(thisx) + 360._r8 - end if - thislon = smap2_lon(thisx) - thisdist = 100*((smap2_lat(thisy) - ldomain%latc(g))**2 + & - (thislon - ldomain%lonc(g))**2)**0.5 - if (thisdist .lt. mindist) then - mindist = thisdist - atm2lnd_vars%ndepind(g,1) = thisx - atm2lnd_vars%ndepind(g,2) = thisy - end if - end do - end do - end if - - !get weights for interpolation (note this method doesn't get the month boundaries quite right..) - aindex(1) = mon+1 - if (thiscalday .le. (caldaym(mon+1)+caldaym(mon))/2._r8) then - wt1(1) = 0.5_r8 + (thiscalday-caldaym(mon))/(caldaym(mon+1)-caldaym(mon)) - aindex(2) = aindex(1)-1 - else - wt1(1) = 1.0_r8 - (thiscalday-(caldaym(mon+1)+caldaym(mon))/2._r8)/ & - (caldaym(mon+1)-caldaym(mon)) - aindex(2) = aindex(1)+1 - end if - wt2(1) = 1._r8 - wt1(1) - - do av = 1,14 - atm2lnd_vars%forc_aer_grc(g,av) = atm2lnd_vars%aerodata(av,atm2lnd_vars%ndepind(g,1), & - atm2lnd_vars%ndepind(g,2),aindex(1))*wt1(1)+atm2lnd_vars%aerodata(av,atm2lnd_vars%ndepind(g,1), & - atm2lnd_vars%ndepind(g,2),aindex(2))*wt2(1) - end do - - !Parse startdate for adding temperature - if (startdate_add_temperature .ne. '') then - call get_curr_date( yr, mon, day, tod ) - read(startdate_add_temperature,*) sdate_addt - sy_addt = sdate_addt/10000 - sm_addt = (sdate_addt-sy_addt*10000)/100 - sd_addt = sdate_addt-sy_addt*10000-sm_addt*100 - read(startdate_add_co2,*) sdate_addco2 - sy_addco2 = sdate_addco2/10000 - sm_addco2 = (sdate_addco2-sy_addco2*10000)/100 - sd_addco2 = sdate_addco2-sy_addco2*10000-sm_addt*100 - end if - if (startdate_add_temperature .ne. '') then - if ((yr == sy_addt .and. mon == sm_addt .and. day >= sd_addt) .or. & - (yr == sy_addt .and. mon > sm_addt) .or. (yr > sy_addt)) then - atm2lnd_vars%forc_t_not_downscaled_grc(g) = atm2lnd_vars%forc_t_not_downscaled_grc(g) + add_temperature - atm2lnd_vars%forc_th_not_downscaled_grc(g) = atm2lnd_vars%forc_th_not_downscaled_grc(g) + add_temperature - end if - end if - - !set the topounit-level atmospheric state and flux forcings (bypass mode) - do topo = grc_pp%topi(g), grc_pp%topf(g) - ! first, all the state forcings - top_as%tbot(topo) = atm2lnd_vars%forc_t_not_downscaled_grc(g) ! forc_txy Atm state K - top_as%thbot(topo) = atm2lnd_vars%forc_th_not_downscaled_grc(g) ! forc_thxy Atm state K - top_as%pbot(topo) = atm2lnd_vars%forc_pbot_not_downscaled_grc(g) ! ptcmxy Atm state Pa - top_as%qbot(topo) = atm2lnd_vars%forc_q_not_downscaled_grc(g) ! forc_qxy Atm state kg/kg - top_as%ubot(topo) = atm2lnd_vars%forc_u_grc(g) ! forc_uxy Atm state m/s - top_as%vbot(topo) = atm2lnd_vars%forc_v_grc(g) ! forc_vxy Atm state m/s - top_as%zbot(topo) = atm2lnd_vars%forc_hgt_grc(g) ! zgcmxy Atm state m - ! assign the state forcing fields derived from other inputs - ! Horizontal windspeed (m/s) - top_as%windbot(topo) = sqrt(top_as%ubot(topo)**2 + top_as%vbot(topo)**2) - ! Relative humidity (percent) - if (top_as%tbot(topo) > SHR_CONST_TKFRZ) then - e = esatw(tdc(top_as%tbot(topo))) - else - e = esati(tdc(top_as%tbot(topo))) - end if - qsat = 0.622_r8*e / (top_as%pbot(topo) - 0.378_r8*e) - top_as%rhbot(topo) = 100.0_r8*(top_as%qbot(topo) / qsat) - ! partial pressure of oxygen (Pa) - top_as%po2bot(topo) = o2_molar_const * top_as%pbot(topo) - ! air density (kg/m**3) - uses a temporary calculation of water vapor pressure (Pa) - vp = top_as%qbot(topo) * top_as%pbot(topo) / (0.622_r8 + 0.378_r8 * top_as%qbot(topo)) - top_as%rhobot(topo) = (top_as%pbot(topo) - 0.378_r8 * vp) / (rair * top_as%tbot(topo)) - - ! second, all the flux forcings - top_af%rain(topo) = forc_rainc + forc_rainl ! sum of convective and large-scale rain - top_af%snow(topo) = forc_snowc + forc_snowl ! sum of convective and large-scale snow - top_af%solad(topo,2) = atm2lnd_vars%forc_solad_grc(g,2) ! forc_sollxy Atm flux W/m^2 - top_af%solad(topo,1) = atm2lnd_vars%forc_solad_grc(g,1) ! forc_solsxy Atm flux W/m^2 - top_af%solai(topo,2) = atm2lnd_vars%forc_solai_grc(g,2) ! forc_solldxy Atm flux W/m^2 - top_af%solai(topo,1) = atm2lnd_vars%forc_solai_grc(g,1) ! forc_solsdxy Atm flux W/m^2 - top_af%lwrad(topo) = atm2lnd_vars%forc_lwrad_not_downscaled_grc(g) ! flwdsxy Atm flux W/m^2 - ! derived flux forcings - top_af%solar(topo) = top_af%solad(topo,2) + top_af%solad(topo,1) + & - top_af%solai(topo,2) + top_af%solai(topo,1) - end do - - !----------------------------------------------------------------------------------------------------- -#else - atm2lnd_vars%forc_hgt_grc(g) = x2l_lm(i,index_x2l_Sa_z) ! zgcmxy Atm state m atm2lnd_vars%forc_u_grc(g) = x2l_lm(i,index_x2l_Sa_u) ! forc_uxy Atm state m/s atm2lnd_vars%forc_v_grc(g) = x2l_lm(i,index_x2l_Sa_v) ! forc_vxy Atm state m/s @@ -2400,7 +1535,6 @@ subroutine lnd_import_moab( bounds, atm2lnd_vars, glc2lnd_vars) top_af%solai(topo,2) + top_af%solai(topo,1) end do -#endif ! Determine optional receive fields ! CO2 (and C13O2) concentration: constant, prognostic, or diagnostic @@ -2479,55 +1613,14 @@ subroutine lnd_import_moab( bounds, atm2lnd_vars, glc2lnd_vars) ! Note that the following does unit conversions from ppmv to partial pressures (Pa) ! Note that forc_pbot is in Pa -#ifdef CPL_BYPASS - co2_type_idx = 2 -#endif - if (co2_type_idx == 1) then co2_ppmv_val = co2_ppmv_prog else if (co2_type_idx == 2) then -#ifdef CPL_BYPASS - !atmospheric CO2 (to be used for transient simulations only) - if (atm2lnd_vars%loaded_bypassdata .eq. 0) then - ierr = nf90_open(trim(co2_file), nf90_nowrite, ncid) - ierr = nf90_inq_dimid(ncid, 'time', dimid) - ierr = nf90_Inquire_Dimension(ncid, dimid, len = thistimelen) - ierr = nf90_inq_varid(ncid, 'CO2', varid) - ierr = nf90_get_var(ncid, varid, atm2lnd_vars%co2_input(:,:,1:thistimelen)) - ierr = nf90_inq_varid(ncid, 'C13O2', varid) - ierr = nf90_get_var(ncid, varid, atm2lnd_vars%c13o2_input(:,:,1:thistimelen)) - ierr = nf90_close(ncid) - end if - - !get weights/indices for interpolation (assume values represent annual averages) - nindex(1) = min(max(yr,1850),2100)-1764 - if (thiscalday .le. 182.5) then - nindex(2) = nindex(1)-1 - else - nindex(2) = nindex(1)+1 - end if - wt1(1) = 1._r8 - abs((182.5 - (thiscalday -1._r8))/365._r8) - wt2(1) = 1._r8 - wt1(1) - - co2_ppmv_val = atm2lnd_vars%co2_input(1,1,nindex(1))*wt1(1) + atm2lnd_vars%co2_input(1,1,nindex(2))*wt2(1) - if (startdate_add_co2 .ne. '') then - if ((yr == sy_addco2 .and. mon == sm_addco2 .and. day >= sd_addco2) .or. & - (yr == sy_addco2 .and. mon > sm_addco2) .or. (yr > sy_addco2)) then - co2_ppmv_val=co2_ppmv_val + add_co2 - end if - end if - - if (use_c13) then - atm2lnd_vars%forc_pc13o2_grc(g) = (atm2lnd_vars%c13o2_input(1,1,nindex(1))*wt1(1) + & - atm2lnd_vars%c13o2_input(1,1,nindex(2))*wt2(1)) * 1.e-6_r8 * forc_pbot - end if - co2_type_idx = 1 -#else + co2_ppmv_val = co2_ppmv_diag if (use_c13) then atm2lnd_vars%forc_pc13o2_grc(g) = co2_ppmv_val * c13ratio * 1.e-6_r8 * forc_pbot end if -#endif else co2_ppmv_val = co2_ppmv if (use_c13) then @@ -2536,15 +1629,6 @@ subroutine lnd_import_moab( bounds, atm2lnd_vars, glc2lnd_vars) end if atm2lnd_vars%forc_pco2_grc(g) = co2_ppmv_val * 1.e-6_r8 * forc_pbot -#ifdef CPL_BYPASS - do topo = grc_pp%topi(g), grc_pp%topf(g) - top_as%pco2bot(topo) = atm2lnd_vars%forc_pco2_grc(g) - if (use_c13) then - top_as%pc13o2bot(topo) = atm2lnd_vars%forc_pc13o2_grc(g) - end if - end do -#endif - ! glc coupling if (create_glacier_mec_landunit) then @@ -2558,10 +1642,6 @@ subroutine lnd_import_moab( bounds, atm2lnd_vars, glc2lnd_vars) end if end do -#ifdef CPL_BYPASS - atm2lnd_vars%loaded_bypassdata = 1 -#endif - end subroutine lnd_import_moab ! endif for ifdef HAVE_MOAB From f878e7819c6d3c35270b098e9453689d1095d069 Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Mon, 23 Oct 2023 00:05:02 -0500 Subject: [PATCH 439/467] fix compile error when MOABCOMP defined --- components/elm/src/cpl/lnd_comp_mct.F90 | 3 +++ 1 file changed, 3 insertions(+) diff --git a/components/elm/src/cpl/lnd_comp_mct.F90 b/components/elm/src/cpl/lnd_comp_mct.F90 index ad19f6ac3e9d..75e6ef05e565 100644 --- a/components/elm/src/cpl/lnd_comp_mct.F90 +++ b/components/elm/src/cpl/lnd_comp_mct.F90 @@ -437,6 +437,9 @@ subroutine lnd_run_mct(EClock, cdata_l, x2l_l, l2x_l) use shr_orb_mod , only : shr_orb_decl use mct_mod use ESMF +#ifdef MOABCOMP + use seq_flds_mod , only : seq_flds_x2l_fields +#endif ! ! !ARGUMENTS: type(ESMF_Clock) , intent(inout) :: EClock ! Input synchronization clock from driver From 7528057af091f66c0107f389a6f3d9b3aa495e5b Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Thu, 26 Oct 2023 16:10:28 -0500 Subject: [PATCH 440/467] define stack rlimit for anlgce machine also, need to have MOAB_PATH defined too both MOAB_ROOT and MOAB_PATH are needed the build should work with only one of them defined --- cime_config/machines/config_machines.xml | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/cime_config/machines/config_machines.xml b/cime_config/machines/config_machines.xml index 35ff880c8ccb..bad879751d61 100644 --- a/cime_config/machines/config_machines.xml +++ b/cime_config/machines/config_machines.xml @@ -1805,6 +1805,7 @@ /nfs/gce/projects/climate/software/linux-ubuntu20.04-x86_64/netcdf/4.8.0c-4.3.1cxx-4.5.3f-parallel/mpich-4.0/gcc-11.1.0 /nfs/gce/projects/climate/software/linux-ubuntu20.04-x86_64/pnetcdf/1.12.2/mpich-4.0/gcc-11.1.0 $SHELL{if [ -z "$MOAB_ROOT" ]; then echo /nfs/gce/projects/climate/software/moab/devel/mpich-4.0/gcc-11.1.0; else echo "$MOAB_ROOT"; fi} + /nfs/gce/projects/climate/software/moab/devel/mpich-4.0/gcc-11.1.0 @@ -1824,6 +1825,9 @@ $SHELL{if [ -z "$ADIOS2_ROOT" ]; then echo /nfs/gce/projects/climate/software/linux-ubuntu20.04-x86_64/adios2/2.8.3.patch/mpich-4.0/gcc-11.1.0; else echo "$ADIOS2_ROOT"; fi} + + -1 + From 48808a4e7620d05e3dd0d9881f57cd3c4d637a1c Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Fri, 27 Oct 2023 22:01:43 -0500 Subject: [PATCH 441/467] atm moab import needed during restart big oversight --- components/eam/src/cpl/atm_comp_mct.F90 | 3 +++ 1 file changed, 3 insertions(+) diff --git a/components/eam/src/cpl/atm_comp_mct.F90 b/components/eam/src/cpl/atm_comp_mct.F90 index 2c739dab169b..1856cc062e29 100644 --- a/components/eam/src/cpl/atm_comp_mct.F90 +++ b/components/eam/src/cpl/atm_comp_mct.F90 @@ -504,6 +504,9 @@ subroutine atm_init_mct( EClock, cdata_a, x2a_a, a2x_a, NLFilename ) ! Sent .true. as an optional argument so that restart_init is set to .true. in atm_import ! This will ensure BFB restarts whenever qneg4 updates fluxes on the restart time step call atm_import( x2a_a%rattr, cam_in, .true. ) +#ifdef HAVE_MOAB + call atm_import_moab(cam_in, .true. ) +#endif call t_startf('cam_run1') call cam_run1 ( cam_in, cam_out ) From 059bddb96cfaa9c1330c7ea75d95da00c2b7703b Mon Sep 17 00:00:00 2001 From: Robert Jacob Date: Mon, 30 Oct 2023 15:58:50 -0500 Subject: [PATCH 442/467] Remove debugging prints from cmake Remove debugging prints from build_model.cmake --- components/cmake/build_model.cmake | 2 -- 1 file changed, 2 deletions(-) diff --git a/components/cmake/build_model.cmake b/components/cmake/build_model.cmake index 37e7cd074328..8bb5ba0d98e4 100644 --- a/components/cmake/build_model.cmake +++ b/components/cmake/build_model.cmake @@ -235,7 +235,6 @@ function(build_model COMP_CLASS COMP_NAME) endforeach() if (USE_MOAB) target_include_directories(${TARGET_NAME} PRIVATE ${MOAB_INCLUDE_DIRS}) - message("JGF adding include directories ${MOAB_INCLUDE_DIRS}") endif() foreach(ITEM IN LISTS ALL_LIBS_LIST) @@ -250,7 +249,6 @@ function(build_model COMP_CLASS COMP_NAME) if (USE_MOAB) target_link_libraries(${TARGET_NAME} PRIVATE ${MOAB_LIBRARIES}) target_include_directories(${TARGET_NAME} PRIVATE ${MOAB_INCLUDE_DIRS}) - message("JGF adding include directories ${MOAB_INCLUDE_DIRS}") endif() if (COMP_NAME STREQUAL "eam") if (USE_YAKL) From 09c347cae612e92842f89da728c82a2c5eadfddc Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Tue, 31 Oct 2023 16:52:10 -0500 Subject: [PATCH 443/467] add surface atm restart file for moab --- components/eam/src/cpl/atm_comp_mct.F90 | 260 +++++++++++++++++++++++- 1 file changed, 254 insertions(+), 6 deletions(-) diff --git a/components/eam/src/cpl/atm_comp_mct.F90 b/components/eam/src/cpl/atm_comp_mct.F90 index 1856cc062e29..5b0879451f1f 100644 --- a/components/eam/src/cpl/atm_comp_mct.F90 +++ b/components/eam/src/cpl/atm_comp_mct.F90 @@ -103,7 +103,10 @@ module atm_comp_mct integer, parameter :: nlen = 256 ! Length of character strings character(len=nlen) :: fname_srf_cam ! surface restart filename character(len=nlen) :: pname_srf_cam ! surface restart full pathname - +#ifdef HAVE_MOAB + character(len=nlen) :: moab_fname_srf_cam ! surface restart filename + character(len=nlen) :: moab_pname_srf_cam ! surface restart full pathname +#endif ! Filename specifier for restart surface file character(len=cl) :: rsfilename_spec_cam @@ -119,6 +122,7 @@ module atm_comp_mct integer , private :: mblsize, totalmbls, nsend, totalmbls_r, nrecv real(r8) , allocatable, private :: a2x_am(:,:) ! atm to coupler, on atm mesh, on atm component pes real(r8) , allocatable, private :: x2a_am(:,:) ! coupler to atm, on atm mesh, on atm component pes + integer, pointer :: global_ids(:) ! they could be dof(), but better maintain our own list #ifdef MOABCOMP integer :: mpicom_atm_moab ! used just for mpi-reducing the difference between moab tags and mct avs @@ -500,6 +504,9 @@ subroutine atm_init_mct( EClock, cdata_a, x2a_a, a2x_a, NLFilename ) call t_startf('atm_read_srfrest_mct') call atm_read_srfrest_mct( EClock, x2a_a, a2x_a ) call t_stopf('atm_read_srfrest_mct') +#ifdef HAVE_MOAB + call atm_read_srfrest_moab ( EClock ) +#endif ! Sent .true. as an optional argument so that restart_init is set to .true. in atm_import ! This will ensure BFB restarts whenever qneg4 updates fluxes on the restart time step @@ -757,6 +764,10 @@ subroutine atm_run_mct( EClock, cdata_a, x2a_a, a2x_a) call atm_write_srfrest_mct( x2a_a, a2x_a, & yr_spec=yr_sync, mon_spec=mon_sync, day_spec=day_sync, sec_spec=tod_sync) call t_stopf('atm_write_srfrest_mct') +#ifdef HAVE_MOAB + call atm_write_srfrest_moab(yr_spec=yr_sync, & + mon_spec=mon_sync, day_spec=day_sync, sec_spec=tod_sync) +#endif end if ! Check for consistency of internal cam clock with master sync clock @@ -953,6 +964,241 @@ subroutine atm_domain_mct( lsize, gsMap_a, dom_a ) end subroutine atm_domain_mct +#ifdef HAVE_MOAB + !=========================================================================================== + + subroutine atm_read_srfrest_moab( EClock ) + + !----------------------------------------------------------------------- + use cam_pio_utils, only: cam_pio_openfile, cam_pio_closefile, pio_subsystem + use iMOAB, only: iMOAB_SetDoubleTagStorage + ! + ! Arguments + ! + type(ESMF_Clock),intent(inout) :: EClock + ! + ! Local variables + ! + integer :: rcode ! return error code + integer :: yr_spec ! Current year + integer :: mon_spec ! Current month + integer :: day_spec ! Current day + integer :: sec_spec ! Current time of day (sec) + integer :: k + real(r8), allocatable :: tmp(:) + type(file_desc_t) :: file + type(io_desc_t) :: iodesc + type(var_desc_t) :: varid + character(CL) :: itemc ! string converted to char + type(mct_string) :: mstring ! mct char type + character(CXX) :: tagname + + type(mct_list) :: temp_list + integer :: size_list, index_list, ent_type, ierr + !----------------------------------------------------------------------- + + ! Determine and open surface restart dataset + + call seq_timemgr_EClockGetData( EClock, curr_yr=yr_spec,curr_mon=mon_spec, & + curr_day=day_spec, curr_tod=sec_spec ) + fname_srf_cam = interpret_filename_spec( rsfilename_spec_cam, case=get_restcase(), & + yr_spec=yr_spec, mon_spec=mon_spec, day_spec=day_spec, sec_spec= sec_spec ) + moab_fname_srf_cam = 'moab_'//trim(fname_srf_cam) + moab_pname_srf_cam = trim(get_restartdir() )//trim(moab_fname_srf_cam) + call getfil(moab_pname_srf_cam, moab_fname_srf_cam) + + call cam_pio_openfile(File, moab_fname_srf_cam, 0) + + call pio_initdecomp(pio_subsystem, pio_double, (/ngcols/), global_ids, iodesc) + + allocate(tmp(size(global_ids))) + + call mct_list_init(temp_list, seq_flds_x2a_fields) + size_list=mct_list_nitem (temp_list) ! it should be the same as nsend + + do k=1,nsend + call mct_list_get(mstring, k, temp_list) + itemc = mct_string_toChar(mstring) + call mct_string_clean(mstring) + + + call pio_seterrorhandling(File, pio_bcast_error) + rcode = pio_inq_varid(File,'x2a_'//trim(itemc) ,varid) + if (rcode == pio_noerr) then + call pio_read_darray(File, varid, iodesc, tmp, rcode) + x2a_am(:,k) = tmp(:) + else + if (masterproc) then + write(iulog,*)'srfrest warning: field ',trim(itemc),' is not on restart file' + write(iulog,*)'for backwards compatibility will set it to 0' + end if + x2a_am(:,k) = 0._r8 + end if + call pio_seterrorhandling(File, pio_internal_error) + end do + + tagname=trim(seq_flds_x2a_fields)//C_NULL_CHAR + ent_type = 0 ! vertices, point cloud + ierr = iMOAB_SetDoubleTagStorage ( mphaid, tagname, totalmbls_r , ent_type, x2a_am ) + if ( ierr > 0) then + call endrun('Error: fail to set seq_flds_a2x_fields for atm physgrid moab mesh in restart') + endif + + + call mct_list_clean(temp_list) + + call mct_list_init(temp_list, seq_flds_a2x_fields) + + do k=1,nrecv + call mct_list_get(mstring, k, temp_list) + itemc = mct_string_toChar(mstring) + call mct_string_clean(mstring) + rcode = pio_inq_varid(File,'a2x_'//trim(itemc) ,varid) + + if (rcode == pio_noerr) then + call pio_read_darray(File, varid, iodesc, tmp, rcode) + a2x_am(:,k) = tmp(:) + else + if (masterproc) then + write(iulog,*)'srfrest warning: field ',trim(itemc),' is not on restart file' + write(iulog,*)'for backwards compatibility will set it to 0' + end if + a2x_am(:,k) = 0._r8 + endif + end do + call mct_list_clean(temp_list) + tagname=trim(seq_flds_a2x_fields)//C_NULL_CHAR + ent_type = 0 ! vertices, point cloud + ierr = iMOAB_SetDoubleTagStorage ( mphaid, tagname, totalmbls , ent_type, a2x_am ) + if ( ierr > 0) then + call endrun('Error: fail to set seq_flds_a2x_fields for atm physgrid moab mesh in restart') + endif + + tagname=trim(seq_flds_x2a_fields)//C_NULL_CHAR + ent_type = 0 ! vertices, point cloud + ierr = iMOAB_SetDoubleTagStorage ( mphaid, tagname, totalmbls_r , ent_type, x2a_am ) + if ( ierr > 0) then + call endrun('Error: fail to set seq_flds_x2a_fields for atm physgrid moab mesh in restart') + endif + + call pio_freedecomp(File,iodesc) + call cam_pio_closefile(File) + deallocate(tmp) + + end subroutine atm_read_srfrest_moab + + !=========================================================================================== + + subroutine atm_write_srfrest_moab( yr_spec, mon_spec, day_spec, sec_spec ) + + !----------------------------------------------------------------------- + use cam_pio_utils, only: cam_pio_createfile, cam_pio_closefile, pio_subsystem + use cam_pio_utils, only: cam_pio_openfile + use cam_history_support, only: fillvalue + use iMOAB, only: iMOAB_GetDoubleTagStorage + ! + ! Arguments + ! + integer , intent(in) :: yr_spec ! Simulation year + integer , intent(in) :: mon_spec ! Simulation month + integer , intent(in) :: day_spec ! Simulation day + integer , intent(in) :: sec_spec ! Seconds into current simulation day + ! + ! Local variables + ! + integer :: rcode ! return error code + integer :: dimid(1), k + type(file_desc_t) :: file + real(r8), allocatable :: tmp(:) + type(var_desc_t), pointer :: varid_x2a(:), varid_a2x(:) + type(io_desc_t) :: iodesc + character(CL) :: itemc ! string converted to char + + type(mct_string) :: mstring ! mct char type + character(CXX) :: tagname + + type(mct_list) :: temp_list + integer :: size_list, index_list, ent_type, ierr + + !----------------------------------------------------------------------- + + ! Determine and open surface restart dataset + + ! Determine and open surface restart dataset + + fname_srf_cam = interpret_filename_spec( rsfilename_spec_cam, case=get_restcase(), & + yr_spec=yr_spec, mon_spec=mon_spec, day_spec=day_spec, sec_spec= sec_spec ) + moab_fname_srf_cam = 'moab_'//trim(fname_srf_cam) + moab_pname_srf_cam = trim(get_restartdir() )//trim(moab_fname_srf_cam) + call getfil(moab_pname_srf_cam, moab_fname_srf_cam) + + call cam_pio_openfile(File, moab_fname_srf_cam, 0) + + call pio_initdecomp(pio_subsystem, pio_double, (/ngcols/), global_ids, iodesc) + allocate(tmp(size(global_ids))) + + rcode = pio_def_dim(File,'x2a_nx',ngcols,dimid(1)) + call mct_list_init(temp_list ,seq_flds_x2a_fields) + size_list=mct_list_nitem (temp_list) ! it should be the same as nsend + allocate(varid_x2a(size_list)) + + do index_list = 1, size_list + call mct_list_get(mstring,index_list,temp_list) + itemc = mct_string_toChar(mstring) + call mct_string_clean(mstring) + rcode = pio_def_var(File,'x2a_'//trim(itemc),PIO_DOUBLE,dimid,varid_x2a(k)) + rcode = pio_put_att(File,varid_x2a(k),"_fillvalue",fillvalue) + enddo + call mct_list_clean(temp_list) + + call mct_list_init(temp_list ,seq_flds_a2x_fields) + size_list=mct_list_nitem (temp_list) ! it should be the same as nrecv + allocate(varid_a2x(size_list)) + + rcode = pio_def_dim(File,'a2x_nx',ngcols,dimid(1)) + do k = 1,size_list + call mct_list_get(mstring,index_list,temp_list) + itemc = mct_string_toChar(mstring) + call mct_string_clean(mstring) + rcode = PIO_def_var(File,'a2x_'//trim(itemc),PIO_DOUBLE,dimid,varid_a2x(k)) + rcode = PIO_put_att(File,varid_a2x(k),"_fillvalue",fillvalue) + enddo + + rcode = pio_enddef(File) ! don't check return code, might be enddef already + +! do we need to fill it up with values? + ! ccsm sign convention is that fluxes are positive downward + tagname=trim(seq_flds_x2a_fields)//C_NULL_CHAR + ent_type = 0 ! vertices, point cloud + ierr = iMOAB_GetDoubleTagStorage ( mphaid, tagname, totalmbls_r , ent_type, x2a_am ) + if ( ierr > 0) then + call endrun('Error: fail to get seq_flds_x2a_fields for atm physgrid moab mesh for writing restart surface') + endif + + tagname=trim(seq_flds_a2x_fields)//C_NULL_CHAR + ent_type = 0 ! vertices, point cloud + ierr = iMOAB_GetDoubleTagStorage ( mphaid, tagname, totalmbls , ent_type, a2x_am ) + if ( ierr > 0) then + call endrun('Error: fail to get seq_flds_a2x_fields for atm physgrid moab mesh for writing restart surface') + endif + + do k=1,nsend + call pio_write_darray(File, varid_x2a(k), iodesc, x2a_am(:,k), rcode) + end do + + do k=1,nrecv + call pio_write_darray(File, varid_a2x(k), iodesc, a2x_am(:,k), rcode) + end do + + deallocate(varid_x2a, varid_a2x) + + call pio_freedecomp(File,iodesc) + call cam_pio_closefile(file) + + + end subroutine atm_write_srfrest_moab +#endif + !=========================================================================================== subroutine atm_read_srfrest_mct( EClock, x2a_a, a2x_a) @@ -1007,9 +1253,9 @@ subroutine atm_read_srfrest_mct( EClock, x2a_a, a2x_a) call pio_read_darray(File, varid, iodesc, tmp, rcode) x2a_a%rattr(k,:) = tmp(:) else - if (masterproc) then - write(iulog,*)'srfrest warning: field ',trim(itemc),' is not on restart file' - write(iulog,*)'for backwards compatibility will set it to 0' + if (masterproc) then + write(iulog,*)'srfrest warning: field ',trim(itemc),' is not on restart file' + write(iulog,*)'for backwards compatibility will set it to 0' end if x2a_a%rattr(k,:) = 0._r8 end if @@ -1175,6 +1421,7 @@ subroutine init_moab_atm_phys( cdata_a ) nlcols = get_nlcols_p() dims = 3 ! allocate(vgids(nlcols)) + allocate(global_ids(nlcols)) allocate(moab_vert_coords(nlcols*dims)) allocate(areavals(nlcols)) allocate(chunk_index(nlcols)) @@ -1187,6 +1434,7 @@ subroutine init_moab_atm_phys( cdata_a ) do i = 1,ncols n=n+1 vgids(n) = get_gcol_p(c,i) + global_ids(n) = vgids(n) latv = lats(i) ! these are in rads ? lonv = lons(i) moab_vert_coords(3*n-2)=COS(latv)*COS(lonv) @@ -1405,7 +1653,7 @@ subroutine atm_export_moab(cam_out) end do tagname=trim(seq_flds_a2x_fields)//C_NULL_CHAR ent_type = 0 ! vertices, point cloud - ierr = iMOAB_SetDoubleTagStorage ( mphaid, tagname, totalmbls , ent_type, a2x_am(1,1) ) + ierr = iMOAB_SetDoubleTagStorage ( mphaid, tagname, totalmbls , ent_type, a2x_am ) if ( ierr > 0) then call endrun('Error: fail to set seq_flds_a2x_fields for atm physgrid moab mesh') endif @@ -1468,7 +1716,7 @@ subroutine atm_import_moab(cam_in, restart_init ) ! ccsm sign convention is that fluxes are positive downward tagname=trim(seq_flds_x2a_fields)//C_NULL_CHAR ent_type = 0 ! vertices, point cloud - ierr = iMOAB_GetDoubleTagStorage ( mphaid, tagname, totalmbls_r , ent_type, x2a_am(1,1) ) + ierr = iMOAB_GetDoubleTagStorage ( mphaid, tagname, totalmbls_r , ent_type, x2a_am ) if ( ierr > 0) then call endrun('Error: fail to get seq_flds_a2x_fields for atm physgrid moab mesh') endif From 593f56d642b824a03cf275a040ddf08bd1976935 Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Wed, 1 Nov 2023 11:33:37 -0500 Subject: [PATCH 444/467] mixup in send/receive also, rlimit gave some errors --- cime_config/machines/config_machines.xml | 3 -- components/eam/src/cpl/atm_comp_mct.F90 | 42 ++++++++++++------------ 2 files changed, 21 insertions(+), 24 deletions(-) diff --git a/cime_config/machines/config_machines.xml b/cime_config/machines/config_machines.xml index bad879751d61..136c14d01bb4 100644 --- a/cime_config/machines/config_machines.xml +++ b/cime_config/machines/config_machines.xml @@ -1825,9 +1825,6 @@ $SHELL{if [ -z "$ADIOS2_ROOT" ]; then echo /nfs/gce/projects/climate/software/linux-ubuntu20.04-x86_64/adios2/2.8.3.patch/mpich-4.0/gcc-11.1.0; else echo "$ADIOS2_ROOT"; fi} - - -1 - diff --git a/components/eam/src/cpl/atm_comp_mct.F90 b/components/eam/src/cpl/atm_comp_mct.F90 index 5b0879451f1f..d8e415447e84 100644 --- a/components/eam/src/cpl/atm_comp_mct.F90 +++ b/components/eam/src/cpl/atm_comp_mct.F90 @@ -1014,16 +1014,14 @@ subroutine atm_read_srfrest_moab( EClock ) allocate(tmp(size(global_ids))) call mct_list_init(temp_list, seq_flds_x2a_fields) - size_list=mct_list_nitem (temp_list) ! it should be the same as nsend + size_list=mct_list_nitem (temp_list) ! it should be the same as nrecv - do k=1,nsend + do k=1,nrecv call mct_list_get(mstring, k, temp_list) itemc = mct_string_toChar(mstring) - call mct_string_clean(mstring) - - call pio_seterrorhandling(File, pio_bcast_error) rcode = pio_inq_varid(File,'x2a_'//trim(itemc) ,varid) + call mct_string_clean(mstring) if (rcode == pio_noerr) then call pio_read_darray(File, varid, iodesc, tmp, rcode) x2a_am(:,k) = tmp(:) @@ -1049,11 +1047,11 @@ subroutine atm_read_srfrest_moab( EClock ) call mct_list_init(temp_list, seq_flds_a2x_fields) - do k=1,nrecv + do k=1,nsend call mct_list_get(mstring, k, temp_list) itemc = mct_string_toChar(mstring) - call mct_string_clean(mstring) rcode = pio_inq_varid(File,'a2x_'//trim(itemc) ,varid) + call mct_string_clean(mstring) if (rcode == pio_noerr) then call pio_read_darray(File, varid, iodesc, tmp, rcode) @@ -1126,41 +1124,43 @@ subroutine atm_write_srfrest_moab( yr_spec, mon_spec, day_spec, sec_spec ) ! Determine and open surface restart dataset - fname_srf_cam = interpret_filename_spec( rsfilename_spec_cam, case=get_restcase(), & - yr_spec=yr_spec, mon_spec=mon_spec, day_spec=day_spec, sec_spec= sec_spec ) moab_fname_srf_cam = 'moab_'//trim(fname_srf_cam) - moab_pname_srf_cam = trim(get_restartdir() )//trim(moab_fname_srf_cam) - call getfil(moab_pname_srf_cam, moab_fname_srf_cam) - call cam_pio_openfile(File, moab_fname_srf_cam, 0) + call cam_pio_createfile(File, trim(moab_fname_srf_cam)) + if (masterproc) then + write(iulog,*)'create file :', trim(moab_fname_srf_cam) + end if call pio_initdecomp(pio_subsystem, pio_double, (/ngcols/), global_ids, iodesc) allocate(tmp(size(global_ids))) rcode = pio_def_dim(File,'x2a_nx',ngcols,dimid(1)) call mct_list_init(temp_list ,seq_flds_x2a_fields) - size_list=mct_list_nitem (temp_list) ! it should be the same as nsend + size_list=mct_list_nitem (temp_list) ! it should be the same as nrecv allocate(varid_x2a(size_list)) + if (masterproc) then + write(iulog,*)'size list:', size_list, seq_flds_x2a_fields + end if - do index_list = 1, size_list - call mct_list_get(mstring,index_list,temp_list) + do k = 1, size_list + call mct_list_get(mstring, k, temp_list) itemc = mct_string_toChar(mstring) - call mct_string_clean(mstring) rcode = pio_def_var(File,'x2a_'//trim(itemc),PIO_DOUBLE,dimid,varid_x2a(k)) + call mct_string_clean(mstring) rcode = pio_put_att(File,varid_x2a(k),"_fillvalue",fillvalue) enddo call mct_list_clean(temp_list) call mct_list_init(temp_list ,seq_flds_a2x_fields) - size_list=mct_list_nitem (temp_list) ! it should be the same as nrecv + size_list=mct_list_nitem (temp_list) ! it should be the same as nsend allocate(varid_a2x(size_list)) rcode = pio_def_dim(File,'a2x_nx',ngcols,dimid(1)) do k = 1,size_list - call mct_list_get(mstring,index_list,temp_list) + call mct_list_get(mstring,k,temp_list) itemc = mct_string_toChar(mstring) - call mct_string_clean(mstring) rcode = PIO_def_var(File,'a2x_'//trim(itemc),PIO_DOUBLE,dimid,varid_a2x(k)) + call mct_string_clean(mstring) rcode = PIO_put_att(File,varid_a2x(k),"_fillvalue",fillvalue) enddo @@ -1182,11 +1182,11 @@ subroutine atm_write_srfrest_moab( yr_spec, mon_spec, day_spec, sec_spec ) call endrun('Error: fail to get seq_flds_a2x_fields for atm physgrid moab mesh for writing restart surface') endif - do k=1,nsend + do k=1,nrecv call pio_write_darray(File, varid_x2a(k), iodesc, x2a_am(:,k), rcode) end do - do k=1,nrecv + do k=1,nsend call pio_write_darray(File, varid_a2x(k), iodesc, a2x_am(:,k), rcode) end do From cb2f6d14ced55f9cdf79eb59944098b59739720d Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Thu, 2 Nov 2023 15:44:57 -0500 Subject: [PATCH 445/467] write to the moab restart file the moab counter it is used only in debugging, for numbering h5m output files makes easier to compare when restart happens --- driver-moab/main/cime_comp_mod.F90 | 4 +--- driver-moab/main/seq_rest_mod.F90 | 5 +++++ 2 files changed, 6 insertions(+), 3 deletions(-) diff --git a/driver-moab/main/cime_comp_mod.F90 b/driver-moab/main/cime_comp_mod.F90 index 523ff8bf6666..35d021cfdd81 100644 --- a/driver-moab/main/cime_comp_mod.F90 +++ b/driver-moab/main/cime_comp_mod.F90 @@ -2472,7 +2472,6 @@ subroutine cime_init() endif enddo - num_moab_exports = num_moab_exports + 1 ! Run atm_init_mct with init phase of 2 call component_init_cc(Eclock_a, atm, atm_init, & infodata, NLFilename, & @@ -2876,7 +2875,6 @@ subroutine cime_run() Time_bstep = mpi_wtime() do while ( .not. stop_alarm) - num_moab_exports = num_moab_exports + 1 call t_startf('CPL:RUN_LOOP', hashint(1)) call t_startf('CPL:CLOCK_ADVANCE') @@ -2885,7 +2883,7 @@ subroutine cime_run() ! (this is time that models should have before they return ! to the driver). Write timestamp and run alarm status !---------------------------------------------------------- - + num_moab_exports = num_moab_exports + 1! this is moab clock used for debugging call seq_timemgr_clockAdvance( seq_SyncClock, force_stop, force_stop_ymd, force_stop_tod) call seq_timemgr_EClockGetData( EClock_d, curr_ymd=ymd, curr_tod=tod) call shr_cal_date2ymd(ymd,year,month,day) diff --git a/driver-moab/main/seq_rest_mod.F90 b/driver-moab/main/seq_rest_mod.F90 index 105605f3e615..f9521627d55c 100644 --- a/driver-moab/main/seq_rest_mod.F90 +++ b/driver-moab/main/seq_rest_mod.F90 @@ -366,6 +366,7 @@ subroutine seq_rest_mb_read(rest_file, infodata, samegrid_al) use seq_comm_mct, only: mbaxid, mbixid, mboxid, mblxid, mbrxid, mbofxid ! coupler side instances use iMOAB, only: iMOAB_GetGlobalInfo + use seq_comm_mct , only: num_moab_exports ! it is used only as a counter for moab h5m files implicit none @@ -433,6 +434,7 @@ subroutine seq_rest_mb_read(rest_file, infodata, samegrid_al) do_bgc_budgets=do_bgc_budgets) if (iamin_CPLID) then + call seq_io_read(moab_rest_file, num_moab_exports, 'seq_num_moab_exports') ! if (drv_threading) call seq_comm_setnthreads(nthreads_CPLID) if (atm_present) then call seq_io_read(moab_rest_file, mbaxid, 'fractions_ax', 'afrac:ifrac:ofrac:lfrac:lfrin') @@ -941,6 +943,7 @@ subroutine seq_rest_mb_write(EClock_d, seq_SyncClock, infodata, & use seq_comm_mct, only: mbaxid, mbixid, mboxid, mblxid, mbrxid, mbofxid ! coupler side instances use iMOAB, only: iMOAB_GetGlobalInfo + use seq_comm_mct , only: num_moab_exports ! it is used only as a counter for moab h5m files implicit none @@ -1130,6 +1133,8 @@ subroutine seq_rest_mb_write(EClock_d, seq_SyncClock, infodata, & call seq_timemgr_EClockGetData( EClock_d, curr_tod=ivar) call seq_io_write(rest_file,ivar,'seq_timemgr_curr_tod' ,whead=whead,wdata=wdata) + call seq_io_write(rest_file, num_moab_exports,'seq_num_moab_exports', whead=whead, wdata=wdata ) + call seq_io_write(rest_file,ds,'budg_dataG',whead=whead,wdata=wdata) call seq_io_write(rest_file,ns,'budg_ns',whead=whead,wdata=wdata) From 9ef740a0d047067ae1b6905743fe57ea14646a64 Mon Sep 17 00:00:00 2001 From: iulian07 Date: Fri, 19 May 2023 23:23:15 -0500 Subject: [PATCH 446/467] bilinear maps generated with tr replace with map_ne4pg2_to_oQU480_bilin.tr.230519.nc this is for atm to ocn/ice map --- cime_config/config_grids.xml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/cime_config/config_grids.xml b/cime_config/config_grids.xml index d246a624b2a6..31f8bfb74684 100755 --- a/cime_config/config_grids.xml +++ b/cime_config/config_grids.xml @@ -3065,8 +3065,8 @@ cpl/gridmaps/ne4pg2/map_ne4pg2_to_oQU480_mono.200527.nc - cpl/gridmaps/ne4pg2/map_ne4pg2_to_oQU480_bilin.200527.nc - cpl/gridmaps/ne4pg2/map_ne4pg2_to_oQU480_bilin.200527.nc + cpl/gridmaps/ne4pg2/map_ne4pg2_to_oQU480_bilin.tr.230519.nc + cpl/gridmaps/ne4pg2/map_ne4pg2_to_oQU480_bilin.tr.230519.nc cpl/gridmaps/oQU480/map_oQU480_to_ne4pg2_mono.200527.nc cpl/gridmaps/oQU480/map_oQU480_to_ne4pg2_mono.200527.nc From a0d1b6705f6836e50c102d9e352063ebd063aa4e Mon Sep 17 00:00:00 2001 From: iulian07 Date: Mon, 22 May 2023 10:29:49 -0500 Subject: [PATCH 447/467] ne30 bilin new map replace map_ne30pg2_to_EC30to60E2r2_bilin.201005.nc with map_ne30pg2_to_EC30to60E2r2_bilin.tr.230522.nc --- cime_config/config_grids.xml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/cime_config/config_grids.xml b/cime_config/config_grids.xml index 31f8bfb74684..4d0563085c3b 100755 --- a/cime_config/config_grids.xml +++ b/cime_config/config_grids.xml @@ -3151,8 +3151,8 @@ cpl/gridmaps/ne30pg2/map_ne30pg2_to_EC30to60E2r2_mono.201005.nc - cpl/gridmaps/ne30pg2/map_ne30pg2_to_EC30to60E2r2_bilin.201005.nc - cpl/gridmaps/ne30pg2/map_ne30pg2_to_EC30to60E2r2_bilin.201005.nc + cpl/gridmaps/ne30pg2/map_ne30pg2_to_EC30to60E2r2_bilin.tr.230522.nc + cpl/gridmaps/ne30pg2/map_ne30pg2_to_EC30to60E2r2_bilin.tr.230522.nc cpl/gridmaps/EC30to60E2r2/map_EC30to60E2r2_to_ne30pg2_mono.201005.nc cpl/gridmaps/EC30to60E2r2/map_EC30to60E2r2_to_ne30pg2_mono.201005.nc From 1ae8338a1cc1fd8f56554059e5d8ba4edeecbf1b Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Tue, 14 Nov 2023 23:58:03 -0600 Subject: [PATCH 448/467] mark the After and Before files with step counter --- driver-moab/main/seq_rest_mod.F90 | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) diff --git a/driver-moab/main/seq_rest_mod.F90 b/driver-moab/main/seq_rest_mod.F90 index f9521627d55c..d304cd7e6e4c 100644 --- a/driver-moab/main/seq_rest_mod.F90 +++ b/driver-moab/main/seq_rest_mod.F90 @@ -1349,19 +1349,21 @@ end subroutine seq_rest_mb_write #ifdef MOABDEBUG subroutine write_moab_state ( before_reading ) ! debug, write files use seq_comm_mct, only: mbaxid, mbixid, mboxid, mblxid, mbrxid, mbofxid ! coupler side instances + use seq_comm_mct, only: num_moab_exports use iso_c_binding use iMOAB, only: iMOAB_WriteMesh implicit none type(logical) , intent(in) :: before_reading ! driver clock - character*32 :: outfile, wopts, prefx + character*32 :: outfile, wopts, prefx, lnum integer ierr; character(len=*),parameter :: subname = "(write_moab_state) " - prefx = 'After_' + write(lnum,"(I0.2)")num_moab_exports ! smaller than 99 + prefx = 'AfterR'//trim(lnum) wopts = ';PARALLEL=WRITE_PART'//C_NULL_CHAR ! - if ( before_reading ) prefx = 'Before_' + if ( before_reading ) prefx = 'BeforeR'//trim(lnum) if (mbrxid .ge. 0 ) then ! we are on coupler pes, for sure outfile = trim(prefx)//'RofCpl.h5m'//C_NULL_CHAR ierr = iMOAB_WriteMesh(mbrxid, trim(outfile), trim(wopts)) From f159df1cd515730994454c63fd55ee65fa942df9 Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Wed, 22 Nov 2023 00:14:02 -0600 Subject: [PATCH 449/467] write moab state after surface restart and before atm import also, retrieve step number from driver clock and atmosphere clock compare to our counter (num_moab_exports) --- components/eam/src/cpl/atm_comp_mct.F90 | 89 ++++++++++++++++--------- driver-moab/main/cime_comp_mod.F90 | 6 ++ 2 files changed, 65 insertions(+), 30 deletions(-) diff --git a/components/eam/src/cpl/atm_comp_mct.F90 b/components/eam/src/cpl/atm_comp_mct.F90 index d8e415447e84..cd4eb2d73603 100644 --- a/components/eam/src/cpl/atm_comp_mct.F90 +++ b/components/eam/src/cpl/atm_comp_mct.F90 @@ -92,6 +92,10 @@ module atm_comp_mct private :: atm_domain_mct private :: atm_read_srfrest_mct private :: atm_write_srfrest_mct +#ifdef HAVE_MOAB + private :: atm_read_srfrest_moab + private :: atm_write_srfrest_moab +#endif !-------------------------------------------------------------------------- ! Private data @@ -444,7 +448,7 @@ subroutine atm_init_mct( EClock, cdata_a, x2a_a, a2x_a, NLFilename ) first_time = .false. - else + else ! so here first_time == .false. ! For initial run, run cam radiation/clouds and return ! For restart run, read restart x2a_a @@ -467,26 +471,26 @@ subroutine atm_init_mct( EClock, cdata_a, x2a_a, a2x_a, NLFilename ) call seq_timemgr_EClockGetData(EClock,curr_ymd=CurrentYMD, StepNo=StepNo, dtime=DTime_Sync ) if (StepNo == 0) then #ifdef MOABCOMP - ! loop over all fields in seq_flds_x2a_fields - call mct_list_init(temp_list ,seq_flds_x2a_fields) - size_list=mct_list_nitem (temp_list) - ent_type = 0 ! entity type is vertex for phys atm - if (rank2 .eq. 0) print *, num_moab_exports, trim(seq_flds_x2a_fields), ' atm import check' - modelStr='atm init2' - 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 seq_comm_compare_mb_mct(modelStr, mpicom_atm_moab, x2a_a, mct_field, mphaid, tagname, ent_type, difference) - enddo - call mct_list_clean(temp_list) + ! loop over all fields in seq_flds_x2a_fields + call mct_list_init(temp_list ,seq_flds_x2a_fields) + size_list=mct_list_nitem (temp_list) + ent_type = 0 ! entity type is vertex for phys atm + if (rank2 .eq. 0) print *, num_moab_exports, trim(seq_flds_x2a_fields), ' atm import check' + modelStr='atm init2' + 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 seq_comm_compare_mb_mct(modelStr, mpicom_atm_moab, x2a_a, mct_field, mphaid, tagname, ent_type, difference) + enddo + call mct_list_clean(temp_list) #endif - ! so the cam import is before moab + ! so the cam import is before moab call atm_import( x2a_a%rattr, cam_in ) #ifdef HAVE_MOAB - ! move moab import after cam import, so moab takes precedence - call atm_import_moab(cam_in) + ! move moab import after cam import, so moab takes precedence + call atm_import_moab(Eclock, cam_in) #endif @@ -494,12 +498,12 @@ subroutine atm_init_mct( EClock, cdata_a, x2a_a, a2x_a, NLFilename ) call t_startf('CAM_run1') call cam_run1 ( cam_in, cam_out ) call t_stopf('CAM_run1') - + call atm_export( cam_out, a2x_a%rattr ) #ifdef HAVE_MOAB call atm_export_moab(cam_out) #endif - else + else ! if (StepNo != 0) then call t_startf('atm_read_srfrest_mct') call atm_read_srfrest_mct( EClock, x2a_a, a2x_a ) @@ -512,7 +516,7 @@ subroutine atm_init_mct( EClock, cdata_a, x2a_a, a2x_a, NLFilename ) ! This will ensure BFB restarts whenever qneg4 updates fluxes on the restart time step call atm_import( x2a_a%rattr, cam_in, .true. ) #ifdef HAVE_MOAB - call atm_import_moab(cam_in, .true. ) + call atm_import_moab(Eclock, cam_in, .true. ) #endif call t_startf('cam_run1') @@ -664,7 +668,7 @@ subroutine atm_run_mct( EClock, cdata_a, x2a_a, a2x_a) call mct_list_clean(temp_list) #endif - call atm_import_moab(cam_in) + call atm_import_moab(Eclock, cam_in) #endif call t_stopf ('CAM_import') @@ -971,7 +975,7 @@ subroutine atm_read_srfrest_moab( EClock ) !----------------------------------------------------------------------- use cam_pio_utils, only: cam_pio_openfile, cam_pio_closefile, pio_subsystem - use iMOAB, only: iMOAB_SetDoubleTagStorage + use iMOAB, only: iMOAB_SetDoubleTagStorage, iMOAB_WriteMesh ! ! Arguments ! @@ -995,6 +999,11 @@ subroutine atm_read_srfrest_moab( EClock ) type(mct_list) :: temp_list integer :: size_list, index_list, ent_type, ierr +#ifdef MOABDEBUG + character*100 outfile, wopts, lnum + integer :: atm_step_no +#endif + !----------------------------------------------------------------------- ! Determine and open surface restart dataset @@ -1071,17 +1080,21 @@ subroutine atm_read_srfrest_moab( EClock ) if ( ierr > 0) then call endrun('Error: fail to set seq_flds_a2x_fields for atm physgrid moab mesh in restart') endif - - tagname=trim(seq_flds_x2a_fields)//C_NULL_CHAR - ent_type = 0 ! vertices, point cloud - ierr = iMOAB_SetDoubleTagStorage ( mphaid, tagname, totalmbls_r , ent_type, x2a_am ) - if ( ierr > 0) then - call endrun('Error: fail to set seq_flds_x2a_fields for atm physgrid moab mesh in restart') - endif + + ! write moab phys atm after reading restart surface file call pio_freedecomp(File,iodesc) call cam_pio_closefile(File) deallocate(tmp) +#ifdef MOABDEBUG + call seq_timemgr_EClockGetData( EClock, stepno=atm_step_no) + write(lnum,"(I0.2)")atm_step_no + outfile = 'AtmPhys_R'//trim(lnum)//'.h5m'//C_NULL_CHAR + wopts = 'PARALLEL=WRITE_PART'//C_NULL_CHAR + ierr = iMOAB_WriteMesh(mphaid, outfile, wopts) + if (ierr > 0 ) & + call endrun('Error: fail to write the atm phys mesh file after restart') +#endif end subroutine atm_read_srfrest_moab @@ -1671,7 +1684,7 @@ subroutine atm_export_moab(cam_out) end subroutine atm_export_moab -subroutine atm_import_moab(cam_in, restart_init ) +subroutine atm_import_moab(Eclock, cam_in, restart_init ) !----------------------------------------------------------------------- use cam_cpl_indices @@ -1691,6 +1704,7 @@ subroutine atm_import_moab(cam_in, restart_init ) ! Arguments ! ! real(r8) , intent(in) :: x2a_am(:,:) will be retrieved from moab tags, and used to set cam_in + type(ESMF_Clock),intent(inout) :: EClock type(cam_in_t), intent(inout) :: cam_in(begchunk:endchunk) logical, optional, intent(in) :: restart_init ! @@ -1707,11 +1721,26 @@ subroutine atm_import_moab(cam_in, restart_init ) character(CXX) :: tagname ! integer :: ent_type, ierr + integer :: cur_atm_stepno +#ifdef MOABDEBUG + character*100 outfile, wopts, lnum +#endif + + call seq_timemgr_EClockGetData( EClock, stepno=cur_atm_stepno ) +#ifdef MOABDEBUG + write(lnum,"(I0.2)")cur_atm_stepno + outfile = 'AtmPhysImp_'//trim(lnum)//'.h5m'//C_NULL_CHAR + wopts = 'PARALLEL=WRITE_PART'//C_NULL_CHAR + ierr = iMOAB_WriteMesh(mphaid, outfile, wopts) + if (ierr > 0 ) & + call endrun('Error: fail to write the moab atm phys mesh before import ') +#endif !----------------------------------------------------------------------- overwrite_flds = .true. ! don't overwrite fields if invoked during the initialization phase ! of a 'continue' or 'branch' run type with data from .rs file if (present(restart_init)) overwrite_flds = .not. restart_init + ! ccsm sign convention is that fluxes are positive downward tagname=trim(seq_flds_x2a_fields)//C_NULL_CHAR diff --git a/driver-moab/main/cime_comp_mod.F90 b/driver-moab/main/cime_comp_mod.F90 index 35d021cfdd81..0f9eb4d01bdb 100644 --- a/driver-moab/main/cime_comp_mod.F90 +++ b/driver-moab/main/cime_comp_mod.F90 @@ -2673,6 +2673,7 @@ subroutine cime_run() integer :: i, nodeId character(len=15) :: c_ymdtod character(len=18) :: c_mprof_file + integer :: cur_step_no ! step number 101 format( A, i10.8, i8, 12A, A, F8.2, A, F8.2 ) 102 format( A, i10.8, i8, A, 8L3 ) @@ -2885,6 +2886,11 @@ subroutine cime_run() !---------------------------------------------------------- num_moab_exports = num_moab_exports + 1! this is moab clock used for debugging call seq_timemgr_clockAdvance( seq_SyncClock, force_stop, force_stop_ymd, force_stop_tod) + call seq_timemgr_EClockGetData(EClock_d, stepno=cur_step_no) + if (iamroot_CPLID) then + write(logunit,*) ' num_moab_exports , cur_step_no ',num_moab_exports, cur_step_no + call shr_sys_flush(logunit) + endif call seq_timemgr_EClockGetData( EClock_d, curr_ymd=ymd, curr_tod=tod) call shr_cal_date2ymd(ymd,year,month,day) stop_alarm = seq_timemgr_alarmIsOn(EClock_d,seq_timemgr_alarm_stop) From 55c4a00de47418ec8c0b40d906668a0e8176c3e8 Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Wed, 22 Nov 2023 07:46:57 -0600 Subject: [PATCH 450/467] write moab state before importing use the local clock --- components/mosart/src/cpl/rof_comp_mct.F90 | 24 +++++++++++++++--- components/mpas-ocean/driver/ocn_comp_mct.F | 26 +++++++++++++++----- components/mpas-seaice/driver/ice_comp_mct.F | 23 ++++++++++++++--- 3 files changed, 60 insertions(+), 13 deletions(-) diff --git a/components/mosart/src/cpl/rof_comp_mct.F90 b/components/mosart/src/cpl/rof_comp_mct.F90 index 3ae3e7a7f0a8..b8582ce2b539 100644 --- a/components/mosart/src/cpl/rof_comp_mct.F90 +++ b/components/mosart/src/cpl/rof_comp_mct.F90 @@ -460,7 +460,7 @@ subroutine rof_run_mct( EClock, cdata_r, x2r_r, r2x_r) #endif - call rof_import_moab( ) + call rof_import_moab(EClock ) #endif @@ -1210,9 +1210,9 @@ end subroutine rof_export_moab !==================================================================================== - subroutine rof_import_moab( ) + subroutine rof_import_moab( EClock ) - use iMOAB, only : iMOAB_GetDoubleTagStorage + use iMOAB, only : iMOAB_GetDoubleTagStorage, iMOAB_WriteMesh !--------------------------------------------------------------------------- ! DESCRIPTION: ! Obtain the runoff input from the moab coupler @@ -1220,6 +1220,7 @@ subroutine rof_import_moab( ) ! ! ARGUMENTS: implicit none + type(ESMF_Clock) , intent(inout) :: EClock ! Input synchronization clock from driver ! ! LOCAL VARIABLES @@ -1228,10 +1229,25 @@ subroutine rof_import_moab( ) real(R8) :: shum character(CXX) :: tagname ! integer :: ent_type, ierr + integer :: cur_rof_stepno character(len=32), parameter :: sub = 'rof_import_moab' !--------------------------------------------------------------------------- - +#ifdef MOABDEBUG + character*100 outfile, wopts, lnum +#endif + + call seq_timemgr_EClockGetData( EClock, stepno=cur_rof_stepno ) +#ifdef MOABDEBUG + write(lnum,"(I0.2)")cur_rof_stepno + outfile = 'RofImp_'//trim(lnum)//'.h5m'//C_NULL_CHAR + wopts = 'PARALLEL=WRITE_PART'//C_NULL_CHAR + ierr = iMOAB_WriteMesh(mrofid, outfile, wopts) + if (ierr > 0 ) then + call shr_sys_abort(sub//'Error: fail to write rof state') + endif +#endif + ! populate the array x2r_rm with data from MOAB tags tagname=trim(seq_flds_x2r_fields)//C_NULL_CHAR ent_type = 0 ! vertices, point cloud diff --git a/components/mpas-ocean/driver/ocn_comp_mct.F b/components/mpas-ocean/driver/ocn_comp_mct.F index ad3ee82b77fa..f6940270d762 100644 --- a/components/mpas-ocean/driver/ocn_comp_mct.F +++ b/components/mpas-ocean/driver/ocn_comp_mct.F @@ -141,7 +141,7 @@ subroutine ocn_init_mct( EClock, cdata_o, x2o_o, o2x_o, NLFilename )!{{{ type(seq_cdata), intent(inout) :: cdata_o type(mct_aVect), intent(inout) :: x2o_o, o2x_o character(len=*), optional, intent(in) :: NLFilename ! Namelist filename -! + ! !REVISION HISTORY: ! Author: Doug Jacobsen !EOP @@ -907,7 +907,7 @@ end subroutine xml_stream_get_attributes call mct_list_clean(temp_list) #endif - call ocn_import_moab(errorCode) + call ocn_import_moab(Eclock, errorCode) if (errorCode /= 0) then call mpas_log_write('Error in ocn_import_moab', MPAS_LOG_CRIT) endif @@ -1053,7 +1053,7 @@ subroutine ocn_run_mct( EClock, cdata_o, x2o_o, o2x_o)!{{{ call mct_list_clean(temp_list) #endif - call ocn_import_moab(ierr) + call ocn_import_moab(Eclock, ierr) if (ierr /= 0) then call mpas_log_write('Error in ocn_import_moab', MPAS_LOG_CRIT) endif @@ -3143,7 +3143,7 @@ end subroutine datetime!}}} ! import method from moab ! copied from ocn_import_mct, will replace x2o_o AV with x2o_om array read locally - subroutine ocn_import_moab( errorCode)!{{{ + subroutine ocn_import_moab( Eclock, errorCode)!{{{ ! !DESCRIPTION: !----------------------------------------------------------------------- @@ -3187,7 +3187,7 @@ subroutine ocn_import_moab( errorCode)!{{{ ! !OUTPUT PARAMETERS: - use iMOAB, only : iMOAB_GetDoubleTagStorage + use iMOAB, only : iMOAB_GetDoubleTagStorage, iMOAB_WriteMesh !EOP !BOC !----------------------------------------------------------------------- @@ -3200,7 +3200,7 @@ subroutine ocn_import_moab( errorCode)!{{{ !----------------------------------------------------------------------- integer :: ent_type, ierr character(CXX) :: tagname - + type(ESMF_Clock), intent(inout) :: EClock integer, intent(out) :: & errorCode ! returned error code @@ -3330,7 +3330,21 @@ subroutine ocn_import_moab( errorCode)!{{{ ! zero out padded cells ! !----------------------------------------------------------------------- + integer :: cur_ocn_stepno +#ifdef MOABDEBUG + character*100 outfile, wopts, lnum +#endif + call seq_timemgr_EClockGetData( EClock, stepno=cur_ocn_stepno ) +#ifdef MOABDEBUG + write(lnum,"(I0.2)")cur_ocn_stepno + outfile = 'OcnImp_'//trim(lnum)//'.h5m'//C_NULL_CHAR + wopts = 'PARALLEL=WRITE_PART'//C_NULL_CHAR + ierr = iMOAB_WriteMesh(MPOID, outfile, wopts) + if (ierr > 0 ) then + write(ocnLogUnit,*) 'Fail to write ocean state ' + endif +#endif errorCode = 0 ! get moab tags from MPOID diff --git a/components/mpas-seaice/driver/ice_comp_mct.F b/components/mpas-seaice/driver/ice_comp_mct.F index a122644d9cf7..d3222f65ce73 100644 --- a/components/mpas-seaice/driver/ice_comp_mct.F +++ b/components/mpas-seaice/driver/ice_comp_mct.F @@ -849,7 +849,7 @@ end subroutine xml_stream_get_attributes call mct_list_clean(temp_list) #endif - call ice_import_moab() + call ice_import_moab(Eclock) #endif @@ -1183,7 +1183,7 @@ subroutine ice_run_mct( EClock, cdata_i, x2i_i, i2x_i)!{{{ enddo call mct_list_clean(temp_list) #endif - call ice_import_moab() + call ice_import_moab(Eclock) #endif @@ -3346,7 +3346,7 @@ end subroutine ice_export_moab ! !IROUTINE: ice_import_moab ! !INTERFACE: - subroutine ice_import_moab()!{{{ + subroutine ice_import_moab(Eclock)!{{{ ! !DESCRIPTION: !----------------------------------------------------------------------- @@ -3427,6 +3427,8 @@ subroutine ice_import_moab()!{{{ ! same as module use iMOAB, only : iMOAB_GetDoubleTagStorage, iMOAB_WriteMesh + type(ESMF_Clock) , intent(inout) :: EClock + !EOP !BOC !----------------------------------------------------------------------- @@ -3557,6 +3559,21 @@ subroutine ice_import_moab()!{{{ atmosDustFlux character(CXX) :: tagname integer :: ierr, ent_type + integer :: cur_ice_stepno +#ifdef MOABDEBUG + character*100 outfile, wopts, lnum +#endif + + call seq_timemgr_EClockGetData( EClock, stepno=cur_ice_stepno ) +#ifdef MOABDEBUG + write(lnum,"(I0.2)")cur_ice_stepno + outfile = 'IceImp_'//trim(lnum)//'.h5m'//C_NULL_CHAR + wopts = 'PARALLEL=WRITE_PART'//C_NULL_CHAR + ierr = iMOAB_WriteMesh(MPSIID, outfile, wopts) + if (ierr > 0 ) then + write(iceLogUnit,*) 'Fail to write ice state ' + endif +#endif !----------------------------------------------------------------------- ! ! zero out padded cells From bf3e23ac420d90f43d7f45cfa8ee4b945309fc18 Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Tue, 28 Nov 2023 10:06:03 -0600 Subject: [PATCH 451/467] write atm comp moab instance before creating the surface restart for debugging only, to be sure that we are writing/reading the same data --- components/eam/src/cpl/atm_comp_mct.F90 | 17 +++++++++++++++-- 1 file changed, 15 insertions(+), 2 deletions(-) diff --git a/components/eam/src/cpl/atm_comp_mct.F90 b/components/eam/src/cpl/atm_comp_mct.F90 index cd4eb2d73603..d119de97026c 100644 --- a/components/eam/src/cpl/atm_comp_mct.F90 +++ b/components/eam/src/cpl/atm_comp_mct.F90 @@ -1106,7 +1106,7 @@ subroutine atm_write_srfrest_moab( yr_spec, mon_spec, day_spec, sec_spec ) use cam_pio_utils, only: cam_pio_createfile, cam_pio_closefile, pio_subsystem use cam_pio_utils, only: cam_pio_openfile use cam_history_support, only: fillvalue - use iMOAB, only: iMOAB_GetDoubleTagStorage + use iMOAB, only: iMOAB_GetDoubleTagStorage, iMOAB_WriteMesh ! ! Arguments ! @@ -1130,6 +1130,9 @@ subroutine atm_write_srfrest_moab( yr_spec, mon_spec, day_spec, sec_spec ) type(mct_list) :: temp_list integer :: size_list, index_list, ent_type, ierr +#ifdef MOABDEBUG + character*100 outfile, wopts, lnum +#endif !----------------------------------------------------------------------- @@ -1143,7 +1146,17 @@ subroutine atm_write_srfrest_moab( yr_spec, mon_spec, day_spec, sec_spec ) if (masterproc) then write(iulog,*)'create file :', trim(moab_fname_srf_cam) end if - + +#ifdef MOABDEBUG + ! before writing the atm surf restart file from moab, write the moab state to be compared after reading the surface file in the restart run + ! it should be the same as AtmPhys_24_27.h5m file in one day restart run, but just to be sure + write(lnum,"(I0.2)")num_moab_exports + outfile = 'AtmPhys'//trim(lnum)//'.h5m'//C_NULL_CHAR + wopts = 'PARALLEL=WRITE_PART'//C_NULL_CHAR + ierr = iMOAB_WriteMesh(mphaid, outfile, wopts) + if (ierr > 0 ) & + call endrun('Error: fail to write the atm phys mesh file after restart') +#endif call pio_initdecomp(pio_subsystem, pio_double, (/ngcols/), global_ids, iodesc) allocate(tmp(size(global_ids))) From be0f6f0389853c9d4ca2b3850e85c7b1718892c7 Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Tue, 28 Nov 2023 23:13:34 -0600 Subject: [PATCH 452/467] export uses the component clock step number easier to track restart this way --- components/eam/src/cpl/atm_comp_mct.F90 | 16 +++++--- components/elm/src/cpl/lnd_comp_mct.F90 | 40 +++++++++++++++----- components/mosart/src/cpl/rof_comp_mct.F90 | 12 +++--- components/mpas-ocean/driver/ocn_comp_mct.F | 16 ++++---- components/mpas-seaice/driver/ice_comp_mct.F | 13 ++++--- 5 files changed, 61 insertions(+), 36 deletions(-) diff --git a/components/eam/src/cpl/atm_comp_mct.F90 b/components/eam/src/cpl/atm_comp_mct.F90 index d119de97026c..b7cfe51c4f18 100644 --- a/components/eam/src/cpl/atm_comp_mct.F90 +++ b/components/eam/src/cpl/atm_comp_mct.F90 @@ -442,7 +442,7 @@ subroutine atm_init_mct( EClock, cdata_a, x2a_a, a2x_a, NLFilename ) ! ! Create initial atm export state inside moab ! - call atm_export_moab( cam_out ) + call atm_export_moab(Eclock, cam_out ) #endif @@ -501,7 +501,7 @@ subroutine atm_init_mct( EClock, cdata_a, x2a_a, a2x_a, NLFilename ) call atm_export( cam_out, a2x_a%rattr ) #ifdef HAVE_MOAB - call atm_export_moab(cam_out) + call atm_export_moab(Eclock, cam_out) #endif else ! if (StepNo != 0) then @@ -735,7 +735,7 @@ subroutine atm_run_mct( EClock, cdata_a, x2a_a, a2x_a) ! call method to set all seq_flds_a2x_fields on phys grid point cloud; ! it will be moved then to Atm Spectral mesh on coupler ; just to show how to move it to atm spectral ! on coupler - call atm_export_moab(cam_out) + call atm_export_moab(Eclock, cam_out) #endif call t_stopf ('CAM_export') @@ -1593,7 +1593,7 @@ subroutine init_moab_atm_phys( cdata_a ) end subroutine init_moab_atm_phys - subroutine atm_export_moab(cam_out) + subroutine atm_export_moab(Eclock, cam_out) !------------------------------------------------------------------- use camsrfexch, only: cam_out_t use phys_grid , only: get_ncols_p, get_nlcols_p @@ -1605,14 +1605,17 @@ subroutine atm_export_moab(cam_out) ! ! Arguments ! + type(ESMF_Clock),intent(inout) :: EClock type(cam_out_t), intent(in) :: cam_out(begchunk:endchunk) integer tagtype, numco, ent_type - character*100 outfile, wopts, lnum character(CXX) :: tagname ! integer ierr, c, nlcols, ig, i, ncols + integer :: cur_atm_stepno + #ifdef MOABDEBUG + character*100 outfile, wopts, lnum integer, save :: local_count = 0 character*100 lnum2 #endif @@ -1683,8 +1686,9 @@ subroutine atm_export_moab(cam_out) if ( ierr > 0) then call endrun('Error: fail to set seq_flds_a2x_fields for atm physgrid moab mesh') endif + call seq_timemgr_EClockGetData( EClock, stepno=cur_atm_stepno ) #ifdef MOABDEBUG - write(lnum,"(I0.2)")num_moab_exports + write(lnum,"(I0.2)")cur_atm_stepno local_count = local_count + 1 write(lnum2,"(I0.2)")local_count outfile = 'AtmPhys_'//trim(lnum)//'_'//trim(lnum2)//'.h5m'//C_NULL_CHAR diff --git a/components/elm/src/cpl/lnd_comp_mct.F90 b/components/elm/src/cpl/lnd_comp_mct.F90 index 75e6ef05e565..6b006b5d9188 100644 --- a/components/elm/src/cpl/lnd_comp_mct.F90 +++ b/components/elm/src/cpl/lnd_comp_mct.F90 @@ -14,6 +14,7 @@ module lnd_comp_mct use lnd_import_export use iso_c_binding use elm_cpl_indices + use esmf, only: ESMF_clock #ifdef HAVE_MOAB use seq_comm_mct, only: mlnid! id of moab land app @@ -366,7 +367,7 @@ subroutine lnd_init_mct( EClock, cdata_l, x2l_l, l2x_l, NLFilename ) call lnd_export(bounds, lnd2atm_vars, lnd2glc_vars, l2x_l%rattr) #ifdef HAVE_MOAB ! Also send data through the MOAB path in driver-moab - call lnd_export_moab(bounds, lnd2atm_vars, lnd2glc_vars) ! it is private here + call lnd_export_moab(EClock, bounds, lnd2atm_vars, lnd2glc_vars) ! it is private here #endif endif @@ -560,7 +561,7 @@ subroutine lnd_run_mct(EClock, cdata_l, x2l_l, l2x_l) #endif ! calling MOAB's import last means this is what the model will use. - call lnd_import_moab( bounds, atm2lnd_vars, glc2lnd_vars) + call lnd_import_moab( EClock, bounds, atm2lnd_vars, glc2lnd_vars) #endif call t_stopf ('lc_lnd_import') @@ -622,7 +623,7 @@ subroutine lnd_run_mct(EClock, cdata_l, x2l_l, l2x_l) call t_startf ('lc_lnd_export') call lnd_export(bounds, lnd2atm_vars, lnd2glc_vars, l2x_l%rattr) #ifdef HAVE_MOAB - call lnd_export_moab(bounds, lnd2atm_vars, lnd2glc_vars) ! it is private here + call lnd_export_moab(EClock, bounds, lnd2atm_vars, lnd2glc_vars) ! it is private here #endif call t_stopf ('lc_lnd_export') #endif @@ -1132,7 +1133,7 @@ subroutine init_moab_land(bounds, LNDID) end subroutine init_moab_land - subroutine lnd_export_moab( bounds, lnd2atm_vars, lnd2glc_vars) + subroutine lnd_export_moab(EClock, bounds, lnd2atm_vars, lnd2glc_vars) !--------------------------------------------------------------------------- ! !DESCRIPTION: @@ -1148,9 +1149,11 @@ subroutine lnd_export_moab( bounds, lnd2atm_vars, lnd2glc_vars) use shr_megan_mod , only : shr_megan_mechcomps_n use iMOAB, only : iMOAB_SetDoubleTagStorage, iMOAB_WriteMesh use seq_flds_mod, only : seq_flds_l2x_fields + use seq_timemgr_mod, only : seq_timemgr_eclockgetdata ! ! !ARGUMENTS: - implicit none + !implicit none + type(ESMF_Clock), intent(inout) :: EClock type(bounds_type) , intent(in) :: bounds ! bounds type(lnd2atm_type), intent(inout) :: lnd2atm_vars ! clm land to atmosphere exchange data type type(lnd2glc_type), intent(inout) :: lnd2glc_vars ! clm land to atmosphere exchange data type @@ -1163,7 +1166,7 @@ subroutine lnd_export_moab( bounds, lnd2atm_vars, lnd2glc_vars) integer :: num ! counter character(len=*), parameter :: sub = 'lnd_export_moab' - integer :: ent_type, ierr + integer :: ent_type, ierr, cur_lnd_stepno character(len=100) :: outfile, wopts, lnum character(CXX) :: tagname !--------------------------------------------------------------------------- @@ -1260,9 +1263,10 @@ subroutine lnd_export_moab( bounds, lnd2atm_vars, lnd2glc_vars) ierr = iMOAB_SetDoubleTagStorage ( mlnid, tagname, totalmbls , ent_type, l2x_lm(1,1) ) if (ierr > 0 ) & call shr_sys_abort( sub//' Error: fail to set moab l2x '// trim(seq_flds_l2x_fields) ) - + + call seq_timemgr_EClockGetData( EClock, stepno=cur_lnd_stepno ) #ifdef MOABDEBUG - write(lnum,"(I0.2)")num_moab_exports + write(lnum,"(I0.2)")cur_lnd_stepno outfile = 'lnd_export_'//trim(lnum)//'.h5m'//C_NULL_CHAR wopts = 'PARALLEL=WRITE_PART'//C_NULL_CHAR ierr = iMOAB_WriteMesh(mlnid, outfile, wopts) @@ -1278,13 +1282,13 @@ end subroutine lnd_export_moab ! the order of tags given by seq_flds_x2l_fields !=============================================================================== - subroutine lnd_import_moab( bounds, atm2lnd_vars, glc2lnd_vars) + subroutine lnd_import_moab(EClock, bounds, atm2lnd_vars, glc2lnd_vars) !--------------------------------------------------------------------------- ! !DESCRIPTION: ! Convert the input data from the moab coupler to the land model use seq_flds_mod , only : seq_flds_l2x_fields, seq_flds_x2l_fields - use iMOAB, only : iMOAB_GetDoubleTagStorage + use iMOAB, only : iMOAB_GetDoubleTagStorage, iMOAB_WriteMesh use shr_kind_mod , only : CXX => SHR_KIND_CXX ! !USES: use elm_varctl , only: co2_type, co2_ppmv, iulog, use_c13, create_glacier_mec_landunit, & @@ -1300,9 +1304,11 @@ subroutine lnd_import_moab( bounds, atm2lnd_vars, glc2lnd_vars) use fileutils , only: getavu, relavu use spmdmod , only: masterproc, mpicom, iam, npes, MPI_REAL8, MPI_INTEGER, MPI_STATUS_SIZE use elm_nlUtilsMod , only : find_nlgroup_name + use seq_timemgr_mod, only : seq_timemgr_eclockgetdata use netcdf ! ! !ARGUMENTS: + type(ESMF_Clock), intent(inout) :: EClock type(bounds_type) , intent(in) :: bounds ! bounds type(atm2lnd_type) , intent(inout) :: atm2lnd_vars ! clm internal input data type type(glc2lnd_type) , intent(inout) :: glc2lnd_vars ! clm internal input data type @@ -1374,6 +1380,10 @@ subroutine lnd_import_moab( bounds, atm2lnd_vars, glc2lnd_vars) ! moab extra stuff character(CXX) :: tagname ! hold all fields names integer :: ent_type ! for setting data + integer :: cur_lnd_stepno +#ifdef MOABDEBUG + character*100 outfile, wopts, lnum +#endif data caldaym / 1, 32, 60, 91, 121, 152, 182, 213, 244, 274, 305, 335, 366 / @@ -1431,6 +1441,16 @@ subroutine lnd_import_moab( bounds, atm2lnd_vars, glc2lnd_vars) call endrun( sub//' ERROR: must have nonzero index_x2l_Sa_co2diag for co2_type equal to diagnostic' ) end if + + call seq_timemgr_EClockGetData( EClock, stepno=cur_lnd_stepno ) +#ifdef MOABDEBUG + write(lnum,"(I0.2)")cur_lnd_stepno + outfile = 'LndImp_'//trim(lnum)//'.h5m'//C_NULL_CHAR + wopts = 'PARALLEL=WRITE_PART'//C_NULL_CHAR + ierr = iMOAB_WriteMesh(mlnid, outfile, wopts) + if (ierr > 0 ) & + call endrun('Error: fail to write the moab lnd mesh before import ') +#endif tagname=trim(seq_flds_x2l_fields)//C_NULL_CHAR if (samegrid_al) then ent_type = 0 ! vertices, cells only if samegrid_al false diff --git a/components/mosart/src/cpl/rof_comp_mct.F90 b/components/mosart/src/cpl/rof_comp_mct.F90 index b8582ce2b539..71342205d440 100644 --- a/components/mosart/src/cpl/rof_comp_mct.F90 +++ b/components/mosart/src/cpl/rof_comp_mct.F90 @@ -346,7 +346,7 @@ subroutine rof_init_mct( EClock, cdata_r, x2r_r, r2x_r, NLFilename) if (ierr > 0 ) & call shr_sys_abort( sub//' Error: fail to set to 0 seq_flds_x2r_fields ') ! also load initial data to moab tags, fill with some initial data - call rof_export_moab() + call rof_export_moab(EClock) ! endif HAVE_MOAB #endif @@ -476,7 +476,7 @@ subroutine rof_run_mct( EClock, cdata_r, x2r_r, r2x_r) call rof_export_mct( r2x_r ) #ifdef HAVE_MOAB ! Map roff data to MOAB datatype ; load fields/tags in MOAB from rtmCTL%runoff - call rof_export_moab() + call rof_export_moab(EClock) #endif call t_stopf ('lc_rof_export') @@ -1089,7 +1089,7 @@ subroutine init_moab_rof(mpicom_rof, ROFID) end subroutine init_moab_rof -subroutine rof_export_moab() +subroutine rof_export_moab(EClock) ! copy !--------------------------------------------------------------------------- ! DESCRIPTION: @@ -1102,6 +1102,7 @@ subroutine rof_export_moab() use iMOAB, only : iMOAB_WriteMesh implicit none ! + type(ESMF_Clock) , intent(inout) :: EClock ! Input synchronization clock from driver ! LOCAL VARIABLES integer :: ni, n, nt, nliq, nfrz, lsz, ierr, ent_type logical,save :: first_time = .true. @@ -1109,6 +1110,7 @@ subroutine rof_export_moab() character*100 outfile, wopts, localmeshfile, lnum character(CXX) :: tagname + integer :: cur_rof_stepno !--------------------------------------------------------------------------- nliq = 0 nfrz = 0 @@ -1195,9 +1197,9 @@ subroutine rof_export_moab() ierr = iMOAB_SetDoubleTagStorage ( mrofid, tagname, totalmbls , ent_type, r2x_rm(1,1) ) if (ierr > 0 ) & call shr_sys_abort( sub//' Error: fail to set moab '// trim(seq_flds_r2x_fields) ) - + call seq_timemgr_EClockGetData( EClock, stepno=cur_rof_stepno ) #ifdef MOABDEBUG - write(lnum,"(I0.2)")num_moab_exports + write(lnum,"(I0.2)")cur_rof_stepno outfile = 'wholeRof_'//trim(lnum)//'.h5m'//C_NULL_CHAR wopts = 'PARALLEL=WRITE_PART'//C_NULL_CHAR ierr = iMOAB_WriteMesh(mrofid, outfile, wopts) diff --git a/components/mpas-ocean/driver/ocn_comp_mct.F b/components/mpas-ocean/driver/ocn_comp_mct.F index f6940270d762..c8f345052ec5 100644 --- a/components/mpas-ocean/driver/ocn_comp_mct.F +++ b/components/mpas-ocean/driver/ocn_comp_mct.F @@ -847,7 +847,7 @@ end subroutine xml_stream_get_attributes endif #ifdef HAVE_MOAB ! initial state has to be exported to moab too - call ocn_export_moab() + call ocn_export_moab(EClock) #endif ! Setup clock for initial runs if (runtype == "continue" .or. runtype == "branch" ) then @@ -1307,7 +1307,7 @@ subroutine ocn_run_mct( EClock, cdata_o, x2o_o, o2x_o)!{{{ call ocn_export_mct(o2x_o, ierr) if (debugOn) call mpas_log_write('Finished exporting ocean state') #ifdef HAVE_MOAB - call ocn_export_moab() + call ocn_export_moab(EClock) #endif call check_clocks_sync(domain % clock, Eclock, ierr) @@ -3952,7 +3952,7 @@ subroutine ocn_import_moab( Eclock, errorCode)!{{{ end subroutine ocn_import_moab!}}} - subroutine ocn_export_moab() !{{{ + subroutine ocn_export_moab(EClock) !{{{ ! !DESCRIPTION: ! This routine calls the routines necessary to send mpas ocean fields to MOAB coupler @@ -3960,15 +3960,12 @@ subroutine ocn_export_moab() !{{{ use iMOAB, only : iMOAB_SetDoubleTagStorage, iMOAB_WriteMesh !EOP !BOC - !----------------------------------------------------------------------- - ! - ! local variables - !----------------------------------------------------------------------- + type(ESMF_Clock) , intent(inout) :: EClock ! Input synchronization clock from driver ! ! local variables ! !----------------------------------------------------------------------- - integer :: ent_type, ierr + integer :: ent_type, ierr, cur_ocn_stepno character(len=100) :: outfile, wopts, localmeshfile, lnum character(CXX) :: tagname @@ -4217,8 +4214,9 @@ subroutine ocn_export_moab() !{{{ endif !----------------------------------------------------------------------- !EOC + call seq_timemgr_EClockGetData( EClock, stepno=cur_ocn_stepno ) #ifdef MOABDEBUG - write(lnum,"(I0.2)")num_moab_exports + write(lnum,"(I0.2)")cur_ocn_stepno outfile = 'ocn_export_'//trim(lnum)//'.h5m'//C_NULL_CHAR wopts = 'PARALLEL=WRITE_PART'//C_NULL_CHAR ierr = iMOAB_WriteMesh(MPOID, outfile, wopts) diff --git a/components/mpas-seaice/driver/ice_comp_mct.F b/components/mpas-seaice/driver/ice_comp_mct.F index d3222f65ce73..6ae92d4731ab 100644 --- a/components/mpas-seaice/driver/ice_comp_mct.F +++ b/components/mpas-seaice/driver/ice_comp_mct.F @@ -814,7 +814,7 @@ end subroutine xml_stream_get_attributes call mpas_log_write('Error in ice_export_mct', MPAS_LOG_CRIT) endif #ifdef HAVE_MOAB - call ice_export_moab() + call ice_export_moab(EClock) #endif call t_stopf ('mpassi_mct_init') @@ -1315,7 +1315,7 @@ subroutine ice_run_mct( EClock, cdata_i, x2i_i, i2x_i)!{{{ if (debugOn) call mpas_log_write('Exporting state', masterOnly=.true.) call ice_export_mct(i2x_i, ierr) #ifdef HAVE_MOAB - call ice_export_moab() + call ice_export_moab(EClock) #endif if (debugOn) call mpas_log_write('Finished exporting state', masterOnly=.true.) @@ -2989,7 +2989,7 @@ subroutine datetime(cdate, ctime) end subroutine datetime!}}} #ifdef HAVE_MOAB - subroutine ice_export_moab() + subroutine ice_export_moab(EClock) !BOP ! !DESCRIPTION: @@ -2998,6 +2998,7 @@ subroutine ice_export_moab() use iMOAB, only : iMOAB_SetDoubleTagStorage, iMOAB_WriteMesh !EOP !BOC + type(ESMF_Clock) , intent(inout) :: EClock ! Input synchronization clock from driver !----------------------------------------------------------------------- ! ! local variables @@ -3099,7 +3100,7 @@ subroutine ice_export_moab() oceanParticulateIronFlux, & oceanDissolvedIronFlux - integer :: ent_type, ierr + integer :: ent_type, ierr, cur_ice_stepno character(len=32), parameter :: sub = 'ice_export_moab' character(len=100) :: outfile, wopts, localmeshfile, lnum @@ -3333,9 +3334,9 @@ subroutine ice_export_moab() write(iceLogUnit,*) 'Fail to set MOAB fields ' endif - + call seq_timemgr_EClockGetData( EClock, stepno=cur_ice_stepno ) #ifdef MOABDEBUG - write(lnum,"(I0.2)")num_moab_exports + write(lnum,"(I0.2)")cur_ice_stepno outfile = 'ice_export_'//trim(lnum)//'.h5m'//C_NULL_CHAR wopts = 'PARALLEL=WRITE_PART'//C_NULL_CHAR ierr = iMOAB_WriteMesh(MPSIID, outfile, wopts) From 370f8b2909ba4e1443b2aaa2da33bac3d91958dd Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Thu, 30 Nov 2023 15:28:23 -0600 Subject: [PATCH 453/467] more debugging during flux albedo calc --- driver-moab/main/seq_flux_mct.F90 | 31 ++++++++++++++++++++++++++++++- 1 file changed, 30 insertions(+), 1 deletion(-) diff --git a/driver-moab/main/seq_flux_mct.F90 b/driver-moab/main/seq_flux_mct.F90 index 1f4458580020..1bb08e10ed94 100644 --- a/driver-moab/main/seq_flux_mct.F90 +++ b/driver-moab/main/seq_flux_mct.F90 @@ -834,7 +834,10 @@ subroutine seq_flux_ocnalb_mct( infodata, ocn, a2x_o, fractions_o, xao_o ) logical,save :: first_call = .true. integer, save :: lSize - ! + +#ifdef MOABDEBUG + character*100 outfile, wopts, lnum +#endif character(*),parameter :: subName = '(seq_flux_ocnalb_mct) ' ! !----------------------------------------------------------------------- @@ -1043,6 +1046,32 @@ subroutine seq_flux_ocnalb_mct( infodata, ocn, a2x_o, fractions_o, xao_o ) endif endif +#ifdef MOABDEBUG + if (mbofxid > 0) then + ! debug out file + write(lnum,"(I0.2)")num_moab_exports + outfile = 'OcnCpl2Albedo_'//trim(lnum)//'.h5m'//C_NULL_CHAR + wopts = 'PARALLEL=WRITE_PART'//C_NULL_CHAR + ierr = iMOAB_WriteMesh(mbofxid, outfile, wopts) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in writing second ocean inst (for flux comp) ' + call shr_sys_abort(subname//' ERROR in writing second ocean inst (for flux comp) ') + endif + endif + if (mboxid > 0) then + ! debug out file + write(lnum,"(I0.2)")num_moab_exports + outfile = 'OcnCplAlbedo_'//trim(lnum)//'.h5m'//C_NULL_CHAR + wopts = 'PARALLEL=WRITE_PART'//C_NULL_CHAR + ierr = iMOAB_WriteMesh(mboxid, outfile, wopts) + + if (ierr .ne. 0) then + write(logunit,*) subname,' error in writing ocean inst (for flux comp) ' + call shr_sys_abort(subname//' ERROR in writing ocean inst (for flux comp) ') + endif + endif +#endif + end subroutine seq_flux_ocnalb_mct From 8f64651ddb1f3da75be43d5284eef03027737ae3 Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Sat, 2 Dec 2023 10:30:28 -0600 Subject: [PATCH 454/467] more debug in prep rof averages also, replace MOABCOMP with MOABDEBUG in seq_map_map --- driver-moab/main/prep_rof_mod.F90 | 41 ++++++++++++++++++++++++++++--- driver-moab/main/seq_map_mod.F90 | 10 ++++---- 2 files changed, 43 insertions(+), 8 deletions(-) diff --git a/driver-moab/main/prep_rof_mod.F90 b/driver-moab/main/prep_rof_mod.F90 index 124891a28a23..7bf2c1ce45e2 100644 --- a/driver-moab/main/prep_rof_mod.F90 +++ b/driver-moab/main/prep_rof_mod.F90 @@ -1013,12 +1013,16 @@ subroutine prep_rof_accum_avg_moab() !--------------------------------------------------------------- ! Description ! Finalize accumulation of land, atm, ocn input to river component - use iMOAB, only : iMOAB_SetDoubleTagStorage + use iMOAB, only : iMOAB_SetDoubleTagStorage, iMOAB_WriteMesh + use seq_comm_mct, only : num_moab_exports ! for debug ! Arguments ! ! Local Variables character(CXX) ::tagname integer :: arrsize, ent_type, ierr +#ifdef MOABDEBUG + character*32 :: outfile, wopts, lnum +#endif character(*), parameter :: subname = '(prep_rof_accum_avg_moab)' !--------------------------------------------------------------- if(l2racc_lm_cnt > 1) then @@ -1034,6 +1038,17 @@ subroutine prep_rof_accum_avg_moab() call shr_sys_abort(subname//' error in setting accumulated shared fields on rof on land instance ') endif +#ifdef MOABDEBUG + if (mblxid .ge. 0 ) then ! we are on coupler pes, for sure + write(lnum,"(I0.2)")num_moab_exports + outfile = 'LndCplRofAvg'//trim(lnum)//'.h5m'//C_NULL_CHAR + wopts = ';PARALLEL=WRITE_PART'//C_NULL_CHAR ! + ierr = iMOAB_WriteMesh(mblxid, trim(outfile), trim(wopts)) + if (ierr .ne. 0) then + call shr_sys_abort(subname//' error in writing land at rof accum ') + endif + endif +#endif if((a2racc_am_cnt > 1) .and. rof_heat) then a2racc_am = 1./a2racc_am_cnt * a2racc_am @@ -1047,7 +1062,17 @@ subroutine prep_rof_accum_avg_moab() if (ierr .ne. 0) then call shr_sys_abort(subname//' error in setting accumulated shared fields on rof on atm instance ') endif - +#ifdef MOABDEBUG + if (mbaxid .ge. 0 ) then ! we are on coupler pes, for sure + write(lnum,"(I0.2)")num_moab_exports + outfile = 'AtmCplRofAvg'//trim(lnum)//'.h5m'//C_NULL_CHAR + wopts = ';PARALLEL=WRITE_PART'//C_NULL_CHAR ! + ierr = iMOAB_WriteMesh(mbaxid, trim(outfile), trim(wopts)) + if (ierr .ne. 0) then + call shr_sys_abort(subname//' error in writing atm at rof accum ') + endif + endif +#endif if(o2racc_om_cnt > 1) then o2racc_om = 1./o2racc_om_cnt *o2racc_om endif @@ -1060,7 +1085,17 @@ subroutine prep_rof_accum_avg_moab() if (ierr .ne. 0) then call shr_sys_abort(subname//' error in setting accumulated shared fields on rof on ocn instance ') endif - +#ifdef MOABDEBUG + if (mboxid .ge. 0 ) then ! we are on coupler pes, for sure + write(lnum,"(I0.2)")num_moab_exports + outfile = 'OcnCplRofAvg'//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 ocn at rof accum ') + endif + endif +#endif end subroutine prep_rof_accum_avg_moab diff --git a/driver-moab/main/seq_map_mod.F90 b/driver-moab/main/seq_map_mod.F90 index 3ed8ae600b7c..b893bf53ac73 100644 --- a/driver-moab/main/seq_map_mod.F90 +++ b/driver-moab/main/seq_map_mod.F90 @@ -434,7 +434,7 @@ subroutine seq_map_map( mapper, av_s, av_d, fldlist, norm, avwts_s, avwtsfld_s, endif -#ifdef MOABCOMP +#ifdef MOABDEBUG if (seq_comm_iamroot(CPLID)) then write(logunit,*) subname, 'iMOAB mapper ',trim(mapper%mbname), ' iMOAB_mapper nfields', & nfields, ' fldlist_moab=', trim(fldlist_moab) @@ -492,7 +492,7 @@ subroutine seq_map_map( mapper, av_s, av_d, fldlist, norm, avwts_s, avwtsfld_s, #ifdef HAVE_MOAB if ( valid_moab_context ) then -#ifdef MOABCOMP +#ifdef MOABDEBUG if (seq_comm_iamroot(CPLID)) then write(logunit, *) subname,' iMOAB mapper rearrange or copy ', mapper%mbname, ' send/recv tags ', trim(fldlist_moab), & ' mbpresent=', mbpresent, ' mbnorm=', mbnorm @@ -547,7 +547,7 @@ subroutine seq_map_map( mapper, av_s, av_d, fldlist, norm, avwts_s, avwtsfld_s, write(logunit,*) subname,' error setting init value for mapping norm factor ',ierr,trim(tagname) call shr_sys_abort(subname//' ERROR setting norm init value') ! serious enough endif -#ifdef MOABCOMP +#ifdef MOABDEBUG if (seq_comm_iamroot(CPLID)) then write(logunit, *) subname,' iMOAB mapper ', mapper%mbname, ' set norm8wt 1 on source with app id: ', mapper%src_mbid call shr_sys_flush(logunit) @@ -580,7 +580,7 @@ subroutine seq_map_map( mapper, av_s, av_d, fldlist, norm, avwts_s, avwtsfld_s, do j = 1, lsize_src targtags(j,:)= targtags(j,:)*wghts(j) enddo -#ifdef MOABCOMP +#ifdef MOABDEBUG if (seq_comm_iamroot(CPLID)) then write(logunit, *) subname,' iMOAB projection mapper: ', mapper%mbname, ' normalize nfields=', & nfields, ' arrsize_src on root:', arrsize_src, ' shape(targtags_ini)=', shape(targtags_ini) @@ -630,7 +630,7 @@ subroutine seq_map_map( mapper, av_s, av_d, fldlist, norm, avwts_s, avwtsfld_s, endif if ( valid_moab_context ) then -#ifdef MOABCOMP +#ifdef MOABDEBUG if (seq_comm_iamroot(CPLID)) then write(logunit, *) subname,' iMOAB projection mapper: ',trim(mapper%mbname), ' between ', mapper%src_mbid, ' and ', mapper%tgt_mbid, trim(fldlist_moab) call shr_sys_flush(logunit) From 2e983e8ca6708b6fe0bbbd95027bcde477ec799a Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Sat, 2 Dec 2023 10:31:19 -0600 Subject: [PATCH 455/467] big error in not reading accumulation counter for lnd to rof l2racc_lm_cnt should have been read from file --- driver-moab/main/seq_rest_mod.F90 | 1 + 1 file changed, 1 insertion(+) diff --git a/driver-moab/main/seq_rest_mod.F90 b/driver-moab/main/seq_rest_mod.F90 index d304cd7e6e4c..ab40eab408a5 100644 --- a/driver-moab/main/seq_rest_mod.F90 +++ b/driver-moab/main/seq_rest_mod.F90 @@ -476,6 +476,7 @@ subroutine seq_rest_mb_read(rest_file, infodata, samegrid_al) trim(tagname), & matrix = p_l2racc_lm ) endif + call seq_io_read(rest_file, l2racc_lm_cnt ,'l2racc_lx_cnt') ! gsmap => component_get_gsmap_cx(lnd(1)) ! l2racc_lx => prep_rof_get_l2racc_lx() ! l2racc_lx_cnt => prep_rof_get_l2racc_lx_cnt() From 3b7f6d0fb0bcbdc6897f93a33f6deb9e359fa537 Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Mon, 4 Dec 2023 14:51:37 -0600 Subject: [PATCH 456/467] fix restart!!!! two major issues: 1) atm import moab had to comment a line, it was commented in mct import after we did moab import 2) factoring during atm second init call that was always missing --- components/eam/src/cpl/atm_comp_mct.F90 | 2 +- driver-moab/main/component_mod.F90 | 6 ++++++ 2 files changed, 7 insertions(+), 1 deletion(-) diff --git a/components/eam/src/cpl/atm_comp_mct.F90 b/components/eam/src/cpl/atm_comp_mct.F90 index b7cfe51c4f18..076530daab95 100644 --- a/components/eam/src/cpl/atm_comp_mct.F90 +++ b/components/eam/src/cpl/atm_comp_mct.F90 @@ -1775,7 +1775,7 @@ subroutine atm_import_moab(Eclock, cam_in, restart_init ) ! NOTE:overwrite_flds is .FALSE. for the first restart ! time step making cflx(:,1)=0.0 for the first restart time step. ! cflx(:,1) should not be zeroed out, start the second index of cflx from 2. - cam_in(c)%cflx(:,2:) = 0._r8 + ! cam_in(c)%cflx(:,2:) = 0._r8 do i =1,ncols if (overwrite_flds) then diff --git a/driver-moab/main/component_mod.F90 b/driver-moab/main/component_mod.F90 index eaff95f2ae13..a08f229ca152 100644 --- a/driver-moab/main/component_mod.F90 +++ b/driver-moab/main/component_mod.F90 @@ -264,6 +264,9 @@ end subroutine comp_init ! multiple by area ratio if (present(seq_flds_x2c_fluxes)) then call mct_avect_vecmult(comp(eci)%x2c_cc, comp(eci)%drv2mdl, seq_flds_x2c_fluxes, mask_spval=.true.) +#ifdef HAVE_MOAB + call factor_moab_comp(comp(eci), 'drv2mdl', seq_flds_x2c_fluxes) +#endif end if ! call the component's specific init phase @@ -280,6 +283,9 @@ end subroutine comp_init ! only done in second phase of atm init if (present(seq_flds_c2x_fluxes)) then call mct_avect_vecmult(comp(eci)%c2x_cc, comp(eci)%mdl2drv, seq_flds_c2x_fluxes, mask_spval=.true.) +#ifdef HAVE_MOAB + call factor_moab_comp(comp(eci), 'mdl2drv', seq_flds_c2x_fluxes) +#endif end if if (drv_threading) call seq_comm_setnthreads(nthreads_GLOID) From e7b6ea17dd98c9cf369efd7622f206bcf5d4b614 Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Mon, 4 Dec 2023 15:33:43 -0600 Subject: [PATCH 457/467] Revert "bilinear maps generated with tr" This reverts commit 9ef740a0d047067ae1b6905743fe57ea14646a64. --- cime_config/config_grids.xml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/cime_config/config_grids.xml b/cime_config/config_grids.xml index 4d0563085c3b..4b1ad2f9f800 100755 --- a/cime_config/config_grids.xml +++ b/cime_config/config_grids.xml @@ -3065,8 +3065,8 @@ cpl/gridmaps/ne4pg2/map_ne4pg2_to_oQU480_mono.200527.nc - cpl/gridmaps/ne4pg2/map_ne4pg2_to_oQU480_bilin.tr.230519.nc - cpl/gridmaps/ne4pg2/map_ne4pg2_to_oQU480_bilin.tr.230519.nc + cpl/gridmaps/ne4pg2/map_ne4pg2_to_oQU480_bilin.200527.nc + cpl/gridmaps/ne4pg2/map_ne4pg2_to_oQU480_bilin.200527.nc cpl/gridmaps/oQU480/map_oQU480_to_ne4pg2_mono.200527.nc cpl/gridmaps/oQU480/map_oQU480_to_ne4pg2_mono.200527.nc From 5ae8398fc97b6e7b99d759ba657a12e424ca1362 Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Mon, 4 Dec 2023 15:34:46 -0600 Subject: [PATCH 458/467] Revert "ne30 bilin new map" This reverts commit a0d1b6705f6836e50c102d9e352063ebd063aa4e. --- cime_config/config_grids.xml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/cime_config/config_grids.xml b/cime_config/config_grids.xml index 4b1ad2f9f800..d246a624b2a6 100755 --- a/cime_config/config_grids.xml +++ b/cime_config/config_grids.xml @@ -3151,8 +3151,8 @@ cpl/gridmaps/ne30pg2/map_ne30pg2_to_EC30to60E2r2_mono.201005.nc - cpl/gridmaps/ne30pg2/map_ne30pg2_to_EC30to60E2r2_bilin.tr.230522.nc - cpl/gridmaps/ne30pg2/map_ne30pg2_to_EC30to60E2r2_bilin.tr.230522.nc + cpl/gridmaps/ne30pg2/map_ne30pg2_to_EC30to60E2r2_bilin.201005.nc + cpl/gridmaps/ne30pg2/map_ne30pg2_to_EC30to60E2r2_bilin.201005.nc cpl/gridmaps/EC30to60E2r2/map_EC30to60E2r2_to_ne30pg2_mono.201005.nc cpl/gridmaps/EC30to60E2r2/map_EC30to60E2r2_to_ne30pg2_mono.201005.nc From 0483ee9ced2557d6a28aaee07cbb12df6ddd472e Mon Sep 17 00:00:00 2001 From: Robert Jacob Date: Fri, 8 Dec 2023 20:06:54 -0600 Subject: [PATCH 459/467] Update moab driver config settings Update moab driver config settings with latest from mct driver. --- .../cime_config/config_component_e3sm.xml | 24 ++++++++++++++++++- 1 file changed, 23 insertions(+), 1 deletion(-) diff --git a/driver-moab/cime_config/config_component_e3sm.xml b/driver-moab/cime_config/config_component_e3sm.xml index 3405face4b31..dd7a5ddb6c15 100644 --- a/driver-moab/cime_config/config_component_e3sm.xml +++ b/driver-moab/cime_config/config_component_e3sm.xml @@ -204,6 +204,10 @@ logical TRUE,FALSE FALSE + + TRUE + FALSE + run_flags env_run.xml @@ -379,7 +383,9 @@ 96 12 24 + 24 12 + 24 72 96 96 @@ -407,7 +413,8 @@ 4 - 72 + 72 + 96 run_coupling env_run.xml @@ -484,6 +491,7 @@ 96 48 48 + $ATM_NCPL run_coupling @@ -721,7 +729,9 @@ 368.865 284.317 1137.268 + 312.821 312.821 + 388.717 388.717 0.000001 0.000001 @@ -821,6 +831,18 @@ 2**n relative cost of machine (DO NOT EDIT) + + integer + 1,2 + 1 + + 2 + + shr_dust_nl + env_run.xml + Dust Emission Scheme + + BGC CO2=prog, rad CO2=prog: BGC CO2=diag, rad CO2=diag: From 6ae2db230cd044e3221275c461c49d506fb2a47c Mon Sep 17 00:00:00 2001 From: Robert Jacob Date: Fri, 8 Dec 2023 21:01:47 -0600 Subject: [PATCH 460/467] Remove extra MOABDEBUG blocks Remove extra MOABDEBUG blocks used for restart debugging. --- components/eam/src/cpl/atm_comp_mct.F90 | 37 ------------------------- 1 file changed, 37 deletions(-) diff --git a/components/eam/src/cpl/atm_comp_mct.F90 b/components/eam/src/cpl/atm_comp_mct.F90 index 076530daab95..ca16ec46bee3 100644 --- a/components/eam/src/cpl/atm_comp_mct.F90 +++ b/components/eam/src/cpl/atm_comp_mct.F90 @@ -999,10 +999,6 @@ subroutine atm_read_srfrest_moab( EClock ) type(mct_list) :: temp_list integer :: size_list, index_list, ent_type, ierr -#ifdef MOABDEBUG - character*100 outfile, wopts, lnum - integer :: atm_step_no -#endif !----------------------------------------------------------------------- @@ -1086,15 +1082,6 @@ subroutine atm_read_srfrest_moab( EClock ) call pio_freedecomp(File,iodesc) call cam_pio_closefile(File) deallocate(tmp) -#ifdef MOABDEBUG - call seq_timemgr_EClockGetData( EClock, stepno=atm_step_no) - write(lnum,"(I0.2)")atm_step_no - outfile = 'AtmPhys_R'//trim(lnum)//'.h5m'//C_NULL_CHAR - wopts = 'PARALLEL=WRITE_PART'//C_NULL_CHAR - ierr = iMOAB_WriteMesh(mphaid, outfile, wopts) - if (ierr > 0 ) & - call endrun('Error: fail to write the atm phys mesh file after restart') -#endif end subroutine atm_read_srfrest_moab @@ -1130,9 +1117,6 @@ subroutine atm_write_srfrest_moab( yr_spec, mon_spec, day_spec, sec_spec ) type(mct_list) :: temp_list integer :: size_list, index_list, ent_type, ierr -#ifdef MOABDEBUG - character*100 outfile, wopts, lnum -#endif !----------------------------------------------------------------------- @@ -1147,16 +1131,6 @@ subroutine atm_write_srfrest_moab( yr_spec, mon_spec, day_spec, sec_spec ) write(iulog,*)'create file :', trim(moab_fname_srf_cam) end if -#ifdef MOABDEBUG - ! before writing the atm surf restart file from moab, write the moab state to be compared after reading the surface file in the restart run - ! it should be the same as AtmPhys_24_27.h5m file in one day restart run, but just to be sure - write(lnum,"(I0.2)")num_moab_exports - outfile = 'AtmPhys'//trim(lnum)//'.h5m'//C_NULL_CHAR - wopts = 'PARALLEL=WRITE_PART'//C_NULL_CHAR - ierr = iMOAB_WriteMesh(mphaid, outfile, wopts) - if (ierr > 0 ) & - call endrun('Error: fail to write the atm phys mesh file after restart') -#endif call pio_initdecomp(pio_subsystem, pio_double, (/ngcols/), global_ids, iodesc) allocate(tmp(size(global_ids))) @@ -1739,19 +1713,8 @@ subroutine atm_import_moab(Eclock, cam_in, restart_init ) character(CXX) :: tagname ! integer :: ent_type, ierr integer :: cur_atm_stepno -#ifdef MOABDEBUG - character*100 outfile, wopts, lnum -#endif call seq_timemgr_EClockGetData( EClock, stepno=cur_atm_stepno ) -#ifdef MOABDEBUG - write(lnum,"(I0.2)")cur_atm_stepno - outfile = 'AtmPhysImp_'//trim(lnum)//'.h5m'//C_NULL_CHAR - wopts = 'PARALLEL=WRITE_PART'//C_NULL_CHAR - ierr = iMOAB_WriteMesh(mphaid, outfile, wopts) - if (ierr > 0 ) & - call endrun('Error: fail to write the moab atm phys mesh before import ') -#endif !----------------------------------------------------------------------- overwrite_flds = .true. ! don't overwrite fields if invoked during the initialization phase From 0c2ea1511ad929bc07515c984163d9845a5705c4 Mon Sep 17 00:00:00 2001 From: Robert Jacob Date: Fri, 8 Dec 2023 23:42:26 -0600 Subject: [PATCH 461/467] Add FAN coupler pieces Add FAN coupler pieces to moab-coupler since ELM now expects it. --- .../namelist_definition_drv_flds.xml | 10 +++ driver-moab/shr/seq_flds_mod.F90 | 17 +++++ driver-moab/shr/shr_fan_mod.F90 | 73 +++++++++++++++++++ 3 files changed, 100 insertions(+) create mode 100644 driver-moab/shr/shr_fan_mod.F90 diff --git a/driver-moab/cime_config/namelist_definition_drv_flds.xml b/driver-moab/cime_config/namelist_definition_drv_flds.xml index 08847103afde..64d2d099f1c1 100644 --- a/driver-moab/cime_config/namelist_definition_drv_flds.xml +++ b/driver-moab/cime_config/namelist_definition_drv_flds.xml @@ -145,4 +145,14 @@ + + + + + logical + fan + fan_inparm + Switch on/off the coupling of NH3 emissions from FAN/CLM to CAM + + diff --git a/driver-moab/shr/seq_flds_mod.F90 b/driver-moab/shr/seq_flds_mod.F90 index 15a53b0f7f76..41f4316d4f19 100644 --- a/driver-moab/shr/seq_flds_mod.F90 +++ b/driver-moab/shr/seq_flds_mod.F90 @@ -131,6 +131,7 @@ module seq_flds_mod use shr_ndep_mod , only : shr_ndep_readnl use shr_dust_mod , only : shr_dust_readnl use shr_flds_mod , only : seq_flds_dom_coord=>shr_flds_dom_coord, seq_flds_dom_other=>shr_flds_dom_other + use shr_fan_mod , only : shr_fan_readnl use mct_mod @@ -156,11 +157,13 @@ module seq_flds_mod character(len=CXX) :: fire_emis_fields ! List of fire emission fields character(len=CX) :: carma_fields ! List of CARMA fields from lnd->atm character(len=CX) :: ndep_fields ! List of nitrogen deposition fields from atm->lnd/ocn + character(len=CX) :: fan_fields ! List of NH3 emission fields from lnd->atm integer :: ice_ncat ! number of sea ice thickness categories logical :: seq_flds_i2o_per_cat! .true. if select per ice thickness category fields are passed from ice to ocean logical :: rof_heat ! .true. if river model includes temperature logical :: add_ndep_fields ! .true. => add ndep fields + logical :: fan_have_fields ! .true. if FAN coupled to atmosphere character(len=CS) :: atm_flux_method ! explicit => no extra fields needed ! implicit_stress => atm provides wsresp and tau_est @@ -3780,6 +3783,20 @@ subroutine seq_flds_set(nmlfile, ID, infodata) call metadata_set(shr_fire_emis_ztop_token, longname, stdname, units) endif + !----------------------------------------------------------------------------- + ! Read namelist for FAN NH3 emissions + ! If specified, the NH3 surface emission is sent to CAM. + !----------------------------------------------------------------------------- + + call shr_fan_readnl(nlfilename='drv_flds_in', ID=ID, fan_fields=fan_fields, have_fields=fan_have_fields) + if (fan_have_fields) then + call seq_flds_add(l2x_fluxes, trim(fan_fields)) + call seq_flds_add(x2a_fluxes, trim(fan_fields)) + longname = 'NH3 emission flux' + stdname = 'nh3_emis' + units = 'gN/m2/sec' + call metadata_set(fan_fields, longname, stdname, units) + end if !----------------------------------------------------------------------------- ! Dry Deposition fields diff --git a/driver-moab/shr/shr_fan_mod.F90 b/driver-moab/shr/shr_fan_mod.F90 new file mode 100644 index 000000000000..7f4247c6be02 --- /dev/null +++ b/driver-moab/shr/shr_fan_mod.F90 @@ -0,0 +1,73 @@ +!================================================================================ +module shr_fan_mod + + use shr_kind_mod,only : r8 => shr_kind_r8 + use shr_kind_mod,only : CL => SHR_KIND_CL, CX => SHR_KIND_CX, CS => SHR_KIND_CS + use shr_sys_mod, only : shr_sys_abort + use shr_log_mod, only : loglev => shr_log_Level + use shr_log_mod, only : logunit => shr_log_Unit + use shr_file_mod, only : shr_file_getUnit, shr_file_freeUnit + use seq_comm_mct, only : seq_comm_iamroot, seq_comm_setptrs + use shr_mpi_mod, only : shr_mpi_bcast + + implicit none + private + + public shr_fan_readnl + + logical, save, public :: shr_fan_to_atm = .false. + character(len=CS), save, public :: shr_fan_fields_token = '' + +contains + + subroutine shr_fan_readnl(nlfilename, id, fan_fields, have_fields) + use shr_mpi_mod, only : shr_mpi_bcast + use shr_nl_mod , only : shr_nl_find_group_name + + character(len=*), intent(in) :: nlfilename + integer, intent(in) :: id ! seq_comm ID + character(len=*), intent(out) :: fan_fields + logical, intent(out) :: have_fields + + integer :: mpicomm, iostat, fileunit + logical :: exists, fan_nh3_to_atm + character(*),parameter :: subname = '(shr_fan_reanl) ' + + namelist /fan_inparm/ fan_nh3_to_atm + + call seq_comm_setptrs(id, mpicom=mpicomm) + ! Need to initilize to default value in case drv_flds_in doesn't exist + fan_nh3_to_atm = .false. + if (seq_comm_iamroot(id)) then + inquire(file=trim(nlfilename), exist=exists) + if (exists) then + fileunit = shr_file_getUnit() + open(fileunit, file=trim(nlfilename), status='old' ) + call shr_nl_find_group_name(fileunit, 'fan_inparm', iostat) + if (iostat /= 0) then + write(logunit, *) subname, 'FAN/CAM coupling not specified' + fan_nh3_to_atm = .false. + !call shr_sys_abort(subName//'Error reading namelist') + else + read(fileunit, fan_inparm, iostat=iostat) + if (iostat /= 0) then + call shr_sys_abort(subName//'Error reading namelist') + end if + end if + close(fileunit) + call shr_file_freeunit(fileunit) + end if + end if ! root + call shr_mpi_bcast(fan_nh3_to_atm, mpicomm) + have_fields = fan_nh3_to_atm + if (fan_nh3_to_atm) then + fan_fields = 'Fall_FANNH3' + else + fan_fields = '' + end if + shr_fan_to_atm = have_fields + shr_fan_fields_token = fan_fields + + end subroutine shr_fan_readnl + +endmodule shr_fan_mod From 690f9ed78db79d41ce5477e6dcab2f2dbd80cb80 Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Thu, 14 Dec 2023 12:08:37 -0600 Subject: [PATCH 462/467] bug in defining norm8wt tag it is used for normalization in mapping routines how we did not get affected ? It was missing Also, it made the tag Faxa_swvdf non-existent on river model or not? --- driver-moab/main/prep_rof_mod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/driver-moab/main/prep_rof_mod.F90 b/driver-moab/main/prep_rof_mod.F90 index 7bf2c1ce45e2..a8cce9455a44 100644 --- a/driver-moab/main/prep_rof_mod.F90 +++ b/driver-moab/main/prep_rof_mod.F90 @@ -565,7 +565,7 @@ subroutine prep_rof_init(infodata, lnd_c2_rof, atm_c2_rof, ocn_c2_rof) ! because we will project fields from atm to rof grid, we need to define ! rof a2x fields to rof grid on coupler side - tagname = trim(seq_flds_a2x_fields_to_rof)//'norm8wt'//C_NULL_CHAR + tagname = trim(seq_flds_a2x_fields_to_rof)//':norm8wt'//C_NULL_CHAR tagtype = 1 ! dense numco = 1 ! ierr = iMOAB_DefineTagStorage(mbrxid, tagname, tagtype, numco, tagindex ) From 0482d03301bd167dfb7bad2dbc7b0f4fd19b4396 Mon Sep 17 00:00:00 2001 From: Robert Jacob Date: Mon, 18 Dec 2023 11:44:59 -0600 Subject: [PATCH 463/467] Add fix to surface pressure coupling in moab Add fix to surface pressure coupling in the moab import. This will be needed for the model to build after merging. --- components/mpas-ocean/driver/mpaso_cpl_indices.F | 2 ++ components/mpas-ocean/driver/ocn_comp_mct.F | 2 +- 2 files changed, 3 insertions(+), 1 deletion(-) diff --git a/components/mpas-ocean/driver/mpaso_cpl_indices.F b/components/mpas-ocean/driver/mpaso_cpl_indices.F index 715db7ff64b9..190fc0fdc259 100644 --- a/components/mpas-ocean/driver/mpaso_cpl_indices.F +++ b/components/mpas-ocean/driver/mpaso_cpl_indices.F @@ -66,6 +66,7 @@ module mpaso_cpl_indices integer :: index_x2o_Si_bpress ! ice basal pressure integer :: index_x2o_So_duu10n ! 10m wind speed squared (m^2/s^2) integer :: index_x2o_Sa_pbot ! atm bottom pressure (Pa) + integer :: index_x2o_Sa_pslv ! atm bottom pressure (Pa) integer :: index_x2o_Sa_co2prog ! bottom atm level prognostic CO2 integer :: index_x2o_Sa_co2diag ! bottom atm level diagnostic CO2 integer :: index_x2o_Foxx_taux ! zonal wind stress (taux) (W/m2 ) @@ -222,6 +223,7 @@ subroutine mpaso_cpl_indices_set( ) index_x2o_Si_ifrac = mct_avect_indexra(x2o,'Si_ifrac') index_x2o_Si_bpress = mct_avect_indexra(x2o,'Si_bpress') index_x2o_Sa_pbot = mct_avect_indexra(x2o,'Sa_pbot') + index_x2o_Sa_pslv = mct_avect_indexra(x2o,'Sa_pslv') index_x2o_So_duu10n = mct_avect_indexra(x2o,'So_duu10n') index_x2o_Foxx_tauy = mct_avect_indexra(x2o,'Foxx_tauy') index_x2o_Foxx_taux = mct_avect_indexra(x2o,'Foxx_taux') diff --git a/components/mpas-ocean/driver/ocn_comp_mct.F b/components/mpas-ocean/driver/ocn_comp_mct.F index c8f345052ec5..579b61966b80 100644 --- a/components/mpas-ocean/driver/ocn_comp_mct.F +++ b/components/mpas-ocean/driver/ocn_comp_mct.F @@ -3599,7 +3599,7 @@ subroutine ocn_import_moab( Eclock, errorCode)!{{{ rainFlux(i) = x2o_om(n, index_x2o_Faxa_rain) end if if ( atmosphericPressureField % isActive ) then - atmosphericPressure(i) = x2o_om(n, index_x2o_Sa_pbot) + atmosphericPressure(i) = x2o_om(n, index_x2o_Sa_pslv) end if if ( seaIcePressureField % isActive ) then ! Set seaIcePressure to be limited to 5m of pressure From 5f624a5b15fd43f96d3aaac534d8e85b640fe8af Mon Sep 17 00:00:00 2001 From: Robert Jacob Date: Mon, 18 Dec 2023 13:39:36 -0600 Subject: [PATCH 464/467] Update salt flux in moab sea-ice export Update salt flux in moab sea-ice export which is necessary for model to build moab-cases after merge. --- components/mpas-seaice/driver/ice_comp_mct.F | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/components/mpas-seaice/driver/ice_comp_mct.F b/components/mpas-seaice/driver/ice_comp_mct.F index 6ae92d4731ab..8fe3b1319a1f 100644 --- a/components/mpas-seaice/driver/ice_comp_mct.F +++ b/components/mpas-seaice/driver/ice_comp_mct.F @@ -3292,7 +3292,7 @@ subroutine ice_export_moab(EClock) i2x_im(n, index_i2x_Fioi_melth) = oceanHeatFlux(i) i2x_im(n, index_i2x_Fioi_swpen) = oceanShortwaveFlux(i) i2x_im(n, index_i2x_Fioi_meltw) = oceanFreshWaterFlux(i) + frazilMassAdjust(i)/ailohi - i2x_im(n, index_i2x_Fioi_salt ) = oceanSaltFlux(i) + ice_ref_salinity*p001*frazilMassAdjust(i)/ailohi + i2x_im(n, index_i2x_Fioi_salt ) = oceanSaltFlux(i) + seaiceReferenceSalinity*0.001_RKIND*frazilMassAdjust(i)/ailohi i2x_im(n, index_i2x_Fioi_taux ) = tauxo i2x_im(n, index_i2x_Fioi_tauy ) = tauyo From b26a1a584b38382375f667ed33e96b2cd3d60645 Mon Sep 17 00:00:00 2001 From: Robert Jacob Date: Mon, 18 Dec 2023 22:46:46 -0600 Subject: [PATCH 465/467] Update driver-moab with main developments Update driver moab with developments from the mct coupler that will be needed when merged. --- driver-moab/cime_config/buildnml | 7 ++++- driver-moab/cime_config/config_component.xml | 4 +-- .../cime_config/namelist_definition_drv.xml | 14 --------- driver-moab/shr/seq_drydep_mod.F90 | 30 +++++++++++++++++-- driver-moab/shr/seq_flds_mod.F90 | 20 +++++++++++++ 5 files changed, 56 insertions(+), 19 deletions(-) diff --git a/driver-moab/cime_config/buildnml b/driver-moab/cime_config/buildnml index 6c1595ec021d..0d282d402159 100755 --- a/driver-moab/cime_config/buildnml +++ b/driver-moab/cime_config/buildnml @@ -51,6 +51,7 @@ def _create_drv_namelists(case, infile, confdir, nmlgen, files): config['bfbflag'] = 'on' if case.get_value('BFBFLAG') else 'off' config['continue_run'] = '.true.' if case.get_value('CONTINUE_RUN') else '.false.' config['atm_grid'] = case.get_value('ATM_GRID') + config['lnd_grid'] = case.get_value('LND_GRID') config['compocn'] = case.get_value('COMP_OCN') docn_mode = case.get_value("DOCN_MODE") @@ -382,7 +383,7 @@ def buildnml(case, caseroot, component): expect (os.path.isdir(user_xml_dir), "user_xml_dir {} does not exist ".format(user_xml_dir)) - files = Files(comp_interface="mct") + files = Files(comp_interface="moab") definition_file = [files.get_value("NAMELIST_DEFINITION_FILE", {"component": "drv"})] user_definition = os.path.join(user_xml_dir, "namelist_definition_drv.xml") @@ -400,6 +401,10 @@ def buildnml(case, caseroot, component): if "aquaplanet" in cam_config_opts: infile_text = "aqua_planet = .true. \n aqua_planet_sst = 1" + # add dust_emis_scheme + dust_emis_scheme = case.get_value('dust_emis_scheme') + infile_text += " dust_emis_scheme = {}".format(dust_emis_scheme) + user_nl_file = os.path.join(caseroot, "user_nl_cpl") namelist_infile = os.path.join(confdir, "namelist_infile") create_namelist_infile(case, user_nl_file, namelist_infile, infile_text) diff --git a/driver-moab/cime_config/config_component.xml b/driver-moab/cime_config/config_component.xml index 5336a1860005..4fd6e9d6d462 100644 --- a/driver-moab/cime_config/config_component.xml +++ b/driver-moab/cime_config/config_component.xml @@ -676,7 +676,7 @@ char mct,nuopc,moab - mct + moab build_def env_build.xml use MCT component interface @@ -2620,7 +2620,7 @@ char - netcdf,pnetcdf,netcdf4p,netcdf4c,adios,default + netcdf,pnetcdf,netcdf4p,netcdf4c,adios,hdf5,default run_pio env_run.xml pio io type diff --git a/driver-moab/cime_config/namelist_definition_drv.xml b/driver-moab/cime_config/namelist_definition_drv.xml index 8f46db1092a4..8a10291f69fc 100644 --- a/driver-moab/cime_config/namelist_definition_drv.xml +++ b/driver-moab/cime_config/namelist_definition_drv.xml @@ -1707,20 +1707,6 @@ - - integer - nlmaps - seq_infodata_inparm - - Measure and print information about nonlinearly mapped fields. 0 means no - analysis is done or printed. >= 1 triggers analysis written to cpl.log. - default: 0 - - - 0 - - - diff --git a/driver-moab/shr/seq_drydep_mod.F90 b/driver-moab/shr/seq_drydep_mod.F90 index 147509d2839f..eae7906c1136 100644 --- a/driver-moab/shr/seq_drydep_mod.F90 +++ b/driver-moab/shr/seq_drydep_mod.F90 @@ -36,7 +36,7 @@ module seq_drydep_mod ! !PRIVATE ARRAY SIZES integer, private, parameter :: maxspc = 210 ! Maximum number of species - integer, public, parameter :: n_species_table = 192 ! Number of species to work with + integer, public, parameter :: n_species_table = 200 ! Number of species to work with integer, private, parameter :: NSeas = 5 ! Number of seasons integer, private, parameter :: NLUse = 11 ! Number of land-use types @@ -280,6 +280,14 @@ module seq_drydep_mod ,1.e-36_r8 & ! HCN ,1.e-36_r8 & ! CH3CN ,1.e-36_r8 & ! SO2 + ,0.1_r8 & ! SOAG0 + ,0.1_r8 & ! SOAG15 + ,0.1_r8 & ! SOAG24 + ,0.1_r8 & ! SOAG35 + ,0.1_r8 & ! SOAG34 + ,0.1_r8 & ! SOAG33 + ,0.1_r8 & ! SOAG32 + ,0.1_r8 & ! SOAG31 ,0.1_r8 & ! SOAGff0 ,0.1_r8 & ! SOAGff1 ,0.1_r8 & ! SOAGff2 @@ -489,6 +497,14 @@ module seq_drydep_mod ,'HCN ' & ,'CH3CN ' & ,'SO2 ' & + ,'SOAG0 ' & + ,'SOAG15 ' & + ,'SOAG24 ' & + ,'SOAG35 ' & + ,'SOAG34 ' & + ,'SOAG33 ' & + ,'SOAG32 ' & + ,'SOAG31 ' & ,'SOAGff0 ' & ,'SOAGff1 ' & ,'SOAGff2 ' & @@ -685,6 +701,14 @@ module seq_drydep_mod ,9.02e+00_r8, 8258._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! HCN ,5.28e+01_r8, 3970._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! CH3CN ,1.36e+00_r8, 3100._r8,1.30e-02_r8,1960._r8,6.6e-08_r8, 1500._r8 & ! SO2 + ,7.59e+03_r8, 6013.95_r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! SOAG0 + ,7.94e+04_r8, 6013.95_r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! SOAG15 + ,2.57e+05_r8, 6013.95_r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! SOAG24 + ,7.94e+04_r8, 6013.95_r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! SOAG35 + ,2.57e+05_r8, 6013.95_r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! SOAG34 + ,8.32e+05_r8, 6013.95_r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! SOAG33 + ,2.69e+06_r8, 6013.95_r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! SOAG32 + ,8.71e+06_r8, 6013.95_r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! SOAG31 ,1.3e+07_r8, 0._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! SOAGff0 ,3.2e+05_r8, 0._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! SOAGff1 ,4.0e+05_r8, 0._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! SOAGff2 @@ -836,7 +860,9 @@ module seq_drydep_mod 58.0768013_r8, 76.0910034_r8, 89.070126_r8, 90.078067_r8, 222.000000_r8, & 68.1141968_r8, 70.0877991_r8, 70.0877991_r8, 46.0657997_r8, 147.125946_r8, & 119.074341_r8, 162.117935_r8, 100.112999_r8, 27.0256_r8 , 41.0524_r8 , & - 64.064800_r8, 250._r8, 250._r8, 250._r8, 250._r8, & + 64.064800_r8, 250.445_r8, 250.445_r8, 250.445_r8, 250.445_r8, & + 250.445_r8, 250.445_r8, 250.445_r8, 250.445_r8, & + 250._r8, 250._r8, 250._r8, 250._r8, & 250._r8, 250._r8, 250._r8, 250._r8, 250._r8, & 250._r8, 250._r8, 250._r8, 250._r8, 250._r8, & 250._r8, 170.3_r8, 170.3_r8, 170.3_r8, 170.3_r8, & diff --git a/driver-moab/shr/seq_flds_mod.F90 b/driver-moab/shr/seq_flds_mod.F90 index 41f4316d4f19..e03771a7a9c6 100644 --- a/driver-moab/shr/seq_flds_mod.F90 +++ b/driver-moab/shr/seq_flds_mod.F90 @@ -647,6 +647,15 @@ subroutine seq_flds_set(nmlfile, ID, infodata) attname = 'Sa_z' call metadata_set(attname, longname, stdname, units) + ! topographic height (m) + call seq_flds_add(a2x_states,"Sa_topo") + call seq_flds_add(x2l_states,"Sa_topo") + longname = 'Surface height' + stdname = 'height' + units = 'm' + attname = 'Sa_topo' + call metadata_set(attname, longname, stdname, units) + ! zonal wind at the lowest model level (m/s) call seq_flds_add(a2x_states,"Sa_u") call seq_flds_add(x2l_states,"Sa_u") @@ -1294,6 +1303,17 @@ subroutine seq_flds_set(nmlfile, ID, infodata) attname = 'u10' call metadata_set(attname, longname, stdname, units) + ! 10 meter wind with gustiness + call seq_flds_add(i2x_states,"Si_u10withgusts") + call seq_flds_add(xao_states,"So_u10withgusts") + call seq_flds_add(l2x_states,"Sl_u10withgusts") + call seq_flds_add(x2a_states,"Sx_u10withgusts") + longname = '10m wind with gustiness' + stdname = '' + units = 'm s-1' + attname = 'u10withgusts' + call metadata_set(attname, longname, stdname, units) + ! Zonal surface stress" call seq_flds_add(l2x_fluxes,"Fall_taux") call seq_flds_add(xao_fluxes,"Faox_taux") From b98b6d2ea9a3eec9f7a8f6121a046f81474cb052 Mon Sep 17 00:00:00 2001 From: Robert Jacob Date: Tue, 19 Dec 2023 17:31:57 -0600 Subject: [PATCH 466/467] Update ocn_export_moab with removal of ssh filtering Commit d080e69326d changed the values exported out of the ocean for dhdx and dhdy of ssh. Make those changes in the moab export routine. Needed for merge to work. --- components/mpas-ocean/driver/ocn_comp_mct.F | 16 +++++++++------- 1 file changed, 9 insertions(+), 7 deletions(-) diff --git a/components/mpas-ocean/driver/ocn_comp_mct.F b/components/mpas-ocean/driver/ocn_comp_mct.F index 579b61966b80..6f8f120f25fe 100644 --- a/components/mpas-ocean/driver/ocn_comp_mct.F +++ b/components/mpas-ocean/driver/ocn_comp_mct.F @@ -3971,7 +3971,8 @@ subroutine ocn_export_moab(EClock) !{{{ integer :: i, n integer, pointer :: nCellsSolve, index_temperatureSurfaceValue, index_salinitySurfaceValue, & - index_avgZonalSurfaceVelocity, index_avgMeridionalSurfaceVelocity + index_avgZonalSurfaceVelocity, index_avgMeridionalSurfaceVelocity, & + index_avgZonalSSHGradient, index_avgMeridionalSSHGradient type (block_type), pointer :: block_ptr @@ -3987,7 +3988,6 @@ subroutine ocn_export_moab(EClock) !{{{ integer, dimension(:), pointer :: landIceMask real (kind=RKIND), dimension(:), pointer :: seaIceEnergy, accumulatedFrazilIceMass, frazilSurfacePressure, & - filteredSSHGradientZonal, filteredSSHGradientMeridional, & avgTotalFreshWaterTemperatureFlux, & avgCO2_gas_flux, DMSFlux, surfaceUpwardCO2Flux, & avgOceanSurfaceDIC, & @@ -4004,7 +4004,7 @@ subroutine ocn_export_moab(EClock) !{{{ ssh real (kind=RKIND), dimension(:,:), pointer :: avgTracersSurfaceValue, avgSurfaceVelocity, & - avgOceanSurfacePhytoC, & + avgSSHGradient, avgOceanSurfacePhytoC, & avgOceanSurfaceDOC, layerThickness real (kind=RKIND) :: surfaceFreezingTemp @@ -4050,6 +4050,9 @@ subroutine ocn_export_moab(EClock) !{{{ call mpas_pool_get_dimension(forcingPool, 'index_avgSalinitySurfaceValue', index_salinitySurfaceValue) call mpas_pool_get_dimension(forcingPool, 'index_avgSurfaceVelocityZonal', index_avgZonalSurfaceVelocity) call mpas_pool_get_dimension(forcingPool, 'index_avgSurfaceVelocityMeridional', index_avgMeridionalSurfaceVelocity) + call mpas_pool_get_dimension(forcingPool, 'index_avgSSHGradientZonal', index_avgZonalSSHGradient) + call mpas_pool_get_dimension(forcingPool, 'index_avgSSHGradientMeridional', index_avgMeridionalSSHGradient) + call mpas_pool_get_array(statePool, 'ssh', ssh, 1) call mpas_pool_get_array(statePool, 'layerThickness', layerThickness, 1) @@ -4057,8 +4060,7 @@ subroutine ocn_export_moab(EClock) !{{{ call mpas_pool_get_array(forcingPool, 'landIceMask', landIceMask) call mpas_pool_get_array(forcingPool, 'avgTracersSurfaceValue', avgTracersSurfaceValue) call mpas_pool_get_array(forcingPool, 'avgSurfaceVelocity', avgSurfaceVelocity) - call mpas_pool_get_array(forcingPool, 'filteredSSHGradientZonal', filteredSSHGradientZonal) - call mpas_pool_get_array(forcingPool, 'filteredSSHGradientMeridional', filteredSSHGradientMeridional) + call mpas_pool_get_array(forcingPool, 'avgSSHGradient', avgSSHGradient) call mpas_pool_get_array(forcingPool, 'avgTotalFreshWaterTemperatureFlux', avgTotalFreshWaterTemperatureFlux) if ( frazilIceActive ) then call mpas_pool_get_array(forcingPool, 'seaIceEnergy', seaIceEnergy) @@ -4112,8 +4114,8 @@ subroutine ocn_export_moab(EClock) !{{{ o2x_om(n, index_o2x_So_v) = avgSurfaceVelocity(index_avgMeridionalSurfaceVelocity, i) o2x_om(n, index_o2x_So_ssh) = ssh(i) - o2x_om(n, index_o2x_So_dhdx) = filteredSSHGradientZonal(i) - o2x_om(n, index_o2x_So_dhdy) = filteredSSHGradientMeridional(i) + o2x_om(n, index_o2x_So_dhdx) = avgSSHGradient(index_avgZonalSSHGradient, i) + o2x_om(n, index_o2x_So_dhdy) = avgSSHGradient(index_avgMeridionalSSHGradient, i) o2x_om(n, index_o2x_Faoo_h2otemp) = avgTotalFreshWaterTemperatureFlux(i) * rho_sw * cp_sw From 277225087d864cdf1ca4131d12b47bff3f48ed83 Mon Sep 17 00:00:00 2001 From: Robert Jacob Date: Wed, 20 Dec 2023 14:34:30 -0600 Subject: [PATCH 467/467] Define frivinp_mesh for USRDAT Mosart tests Mosart tests that use the USRDAT grid rely on testmods to actually define the grid/domain. Add definitions of frivinp_mesh. Also fix some old-style xmlchange commands. --- .../testmods_dirs/mosart/mos_usrdat/user_nl_mosart | 1 + .../testdefs/testmods_dirs/mosart/sediment/shell_commands | 8 ++++---- .../testdefs/testmods_dirs/mosart/sediment/user_nl_mosart | 3 ++- .../testmods_dirs/mosart/unstructure/user_nl_mosart | 1 + 4 files changed, 8 insertions(+), 5 deletions(-) diff --git a/components/mosart/cime_config/testdefs/testmods_dirs/mosart/mos_usrdat/user_nl_mosart b/components/mosart/cime_config/testdefs/testmods_dirs/mosart/mos_usrdat/user_nl_mosart index 35f223992acd..fc060e0e5967 100644 --- a/components/mosart/cime_config/testdefs/testmods_dirs/mosart/mos_usrdat/user_nl_mosart +++ b/components/mosart/cime_config/testdefs/testmods_dirs/mosart/mos_usrdat/user_nl_mosart @@ -1,2 +1,3 @@ frivinp_rtm = '$DIN_LOC_ROOT/rof/mosart/MOSART_global_half_20180721a.nc' +frivinp_mesh = '$DIN_LOC_ROOT/share/meshes/rof/SCRIPgrid_0.5x0.5_nomask_c110308.nc' diff --git a/components/mosart/cime_config/testdefs/testmods_dirs/mosart/sediment/shell_commands b/components/mosart/cime_config/testdefs/testmods_dirs/mosart/sediment/shell_commands index 3880db754527..bde99bd1acb1 100644 --- a/components/mosart/cime_config/testdefs/testmods_dirs/mosart/sediment/shell_commands +++ b/components/mosart/cime_config/testdefs/testmods_dirs/mosart/sediment/shell_commands @@ -6,9 +6,9 @@ input_data_dir=`./xmlquery DIN_LOC_ROOT --value` ./xmlchange DLND_MODE=CLMNLDAS ./xmlchange DLND_CPLHIST_CASE=NLDAS -./xmlchange -file env_run.xml -id DLND_CPLHIST_YR_END -val 1979 -./xmlchange -file env_run.xml -id DLND_CPLHIST_YR_START -val 1979 -./xmlchange -file env_run.xml -id DLND_CPLHIST_YR_ALIGN -val 1 +./xmlchange DLND_CPLHIST_YR_END=1979 +./xmlchange DLND_CPLHIST_YR_START=1979 +./xmlchange DLND_CPLHIST_YR_ALIGN=1 cat >> user_dlnd.streams.txt.clm.nldas << EOF @@ -48,4 +48,4 @@ cat >> user_dlnd.streams.txt.clm.nldas << EOF -EOF \ No newline at end of file +EOF diff --git a/components/mosart/cime_config/testdefs/testmods_dirs/mosart/sediment/user_nl_mosart b/components/mosart/cime_config/testdefs/testmods_dirs/mosart/sediment/user_nl_mosart index c470aab3ac50..7b8c64d43b60 100644 --- a/components/mosart/cime_config/testdefs/testmods_dirs/mosart/sediment/user_nl_mosart +++ b/components/mosart/cime_config/testdefs/testmods_dirs/mosart/sediment/user_nl_mosart @@ -1,5 +1,6 @@ frivinp_rtm = '$DIN_LOC_ROOT/rof/mosart/MOSART_NLDAS_8th_20160426_20210609d_rslp.nc' +frivinp_mesh = '$DIN_LOC_ROOT/share/meshes/rof/MOSART_global_8th.scrip.20180211c.nc' sediflag = .true. parafile = '$DIN_LOC_ROOT/rof/mosart/US_reservoir_8th_NLDAS3_updated.nc' routingmethod = 2 -dlevelh2r = 100 \ No newline at end of file +dlevelh2r = 100 diff --git a/components/mosart/cime_config/testdefs/testmods_dirs/mosart/unstructure/user_nl_mosart b/components/mosart/cime_config/testdefs/testmods_dirs/mosart/unstructure/user_nl_mosart index 1ad0820fe44b..4faee27ec4c1 100644 --- a/components/mosart/cime_config/testdefs/testmods_dirs/mosart/unstructure/user_nl_mosart +++ b/components/mosart/cime_config/testdefs/testmods_dirs/mosart/unstructure/user_nl_mosart @@ -1,3 +1,4 @@ frivinp_rtm = '$DIN_LOC_ROOT/rof/mosart/MOSART_Global_half_unstructured_c200728.nc' +frivinp_mesh = 'UNDEFINED' inundflag = .true. opt_elevprof = 1