wmesmfmd Module Reference

National Unified Prediction Capability (NUOPC) based Earth System Modeling Framework (ESMF) interface module for multi-grid wave model. More...

Functions/Subroutines
subroutine, public	setservices (gcomp, rc)
	Wave model ESMF set services. More...
subroutine	setexport (gcomp, rc)
	Set export fields from internal data structures. More...
subroutine	createexpmesh (gcomp, rc)
	Create ESMF mesh (unstructured) for export fields. More...
subroutine	setupimpbmsk (bmskField, impField, missingVal, rc)
	Setup background blending mask field for an import field. More...
integer function	fieldindex (fnameList, fname, rc)
	Return index associated with field name. More...
subroutine	calcstokes3d (a, usxField, usyField, rc)
	Calculate 3D Stokes drift current for export. More...
subroutine	readfromfile (idfld, fldwx, fldwy, time0, timen, rc)
	Read input file to fill unmapped point for regional applications. More...

Detailed Description

National Unified Prediction Capability (NUOPC) based Earth System Modeling Framework (ESMF) interface module for multi-grid wave model.

All module variables and types are scoped private by default. The private module variables and types are not listed in this section.

Author

T. J. Campell

J. Meixner

A. J. van der Westhuysen

Date

09-Aug-2017

Copyright

Copyright 2009-2022 National Weather Service (NWS), National Oceanic and Atmospheric Administration. All rights reserved. WAVEWATCH III is a trademark of the NWS. No unauthorized use without permission.

Function/Subroutine Documentation

calcstokes3d()

subroutine wmesmfmd::calcstokes3d	(	real, dimension(nth,nk,0:nseal)	a,
		type(esmf_field)	usxField,
		type(esmf_field)	usyField,
		integer	rc
	)

Calculate 3D Stokes drift current for export.

Parameters

a	Input spectra (in par list to change shape)
usxField	3D SDC eastward-component export field
usyField	3D SDC northward-component export field
rc	Return code

Author

T. J. Campbell

Date

09-Aug-2017

Definition at line 7232 of file wmesmfmd.F90.

    !/
    !/                  +-----------------------------------+
    !/                  | WAVEWATCH III           NOAA/NCEP |
    !/                  |        T. J. Campbell, NRL        |
    !/                  |                        FORTRAN 90 |
    !/                  | Last update :         09-Aug-2017 |
    !/                  +-----------------------------------+
    !/
    !/    09-Aug-2017 : Origination.                        ( version 6.03 )
    !/
    !  1. Purpose :
    !
    !     Calculate 3D Stokes drift current for export
    !
    !  2. Method :
    !
    !    Kenyon, K. E. (1969), J. Geophys. R., Vol 74, No 28, p 6991
    !
    !    U_vec(z)
    !             //
    !      = 2 g || ( F(f,theta) k_vec/C cosh(2k(D+z))/sinh(2kD) ) dsig dtheta
    !           //
    !
    !          //
    !      =  || (Ac(k,theta) sig^2 k_vec/Cg cosh(2k(D+z))/sinh^2(kD) ) dsig dtheta
    !        //
    !
    ! Where:
    !   Ac(k,theta) = wave action density
    !   k_vec = k*[cos(theta),sin(theta)]
    !   D = depth
    !   z = height (0 = mean sea level)
    !
    ! In deep water (kD large):  cosh(2k(D+z))/sinh^2(kD) --> 2*exp(2kz)
    !
    !  3. Parameters :
    !
    !     Parameter list
    !     ----------------------------------------------------------------
    !       a         Real   I   Input spectra (in par list to change shape)
    !       usxField  Type   I/O 3D SDC eastward-component export field
    !       usyField  Type   I/O 3D SDC northward-component export field
    !       rc        Int    O   Return code
    !     ----------------------------------------------------------------
    !
    !  4. Subroutines used :
    !
    !      Name      Type  Module   Description
    !     ----------------------------------------------------------------
    !      NONE
    !     ----------------------------------------------------------------
    !
    !  5. Called by :
    !
    !  6. Error messages :
    !
    !  7. Remarks :
    !
    !  8. Structure :
    !
    !  9. Switches :
    !
    ! 10. Source code :
    !
    !/ ------------------------------------------------------------------- /
    !/
    !/ ------------------------------------------------------------------- /
    !/ Parameter list
    !/
    implicit none
    real             :: a(nth,nk,0:nseal)
    type(ESMF_Field) :: usxField
    type(ESMF_Field) :: usyField
    integer          :: rc
    !/
    !/ ------------------------------------------------------------------- /
    !/ Local parameters
    !/
    real(8), parameter :: zero  = 0.0
    real(8), parameter :: half  = 0.5
    real(8), parameter ::  one  = 1.0
    real(8), parameter ::  two  = 2.0
    ! kdmin = 1e-7: sinh(kdmin)**2 ~ 1e-14
    real(8), parameter :: kdmin = 1e-7
    ! kdmax = 18.0:  cosh(2*(kdmax+kz))/sinh(kdmax)**2 - 2*exp(2*kz) < 1e-14
    real(8), parameter :: kdmax = 18.0
    ! kdmin & kdmax settings used in w3iogomd
    real(8), parameter :: kdmin_us3d = 1e-3
    real(8), parameter :: kdmax_us3d = 6.0
    integer :: isea, jsea, ik, ith, iz
    real(8) :: depth
    real(8) :: akx, aky, kd, kz, fac1, fac2, fac3
    real(8) :: uzx(nz), uzy(nz)
    real(8), allocatable :: fack(:)
    type(ESMF_Field) :: usxnField, usynField
    real(ESMF_KIND_RX), pointer :: usxn(:,:), usyn(:,:)
    integer, save :: timeSlice = 1
    ! Need this workaround to deal with ESMF_FieldCreate not setting up the
    ! Fortran arrays with the ungridded dimension as the first array dimension
#define ESMF_ARBSEQ_WORKAROUND
#ifdef ESMF_ARBSEQ_WORKAROUND
    type(ESMF_DistGrid) :: natDistGrid
    type(ESMF_Array) :: usxnArray, usynArray
#endif
    !
    ! -------------------------------------------------------------------- /
    !
    rc = esmf_success
 
#ifdef ESMF_ARBSEQ_WORKAROUND
    call esmf_gridget( natgrid, distgrid=natdistgrid, rc=rc )
    if (esmf_logfounderror(rc, passthru)) return
    usxnarray = esmf_arraycreate( natdistgrid, esmf_typekind_rx, &
         distgridtoarraymap=(/2/), undistlbound=(/1/), undistubound=(/nz/), rc=rc )
    if (esmf_logfounderror(rc, passthru)) return
    usxnfield = esmf_fieldcreate( natgrid, usxnarray, &
         gridtofieldmap=(/2,3/), ungriddedlbound=(/1/), ungriddedubound=(/nz/), &
         staggerloc=natstaggerloc, rc=rc )
    if (esmf_logfounderror(rc, passthru)) return
    usynarray = esmf_arraycreate( natdistgrid, esmf_typekind_rx, &
         distgridtoarraymap=(/2/), undistlbound=(/1/), undistubound=(/nz/), rc=rc )
    if (esmf_logfounderror(rc, passthru)) return
    usynfield = esmf_fieldcreate( natgrid, usynarray, &
         gridtofieldmap=(/2,3/), ungriddedlbound=(/1/), ungriddedubound=(/nz/), &
         staggerloc=natstaggerloc, rc=rc )
    if (esmf_logfounderror(rc, passthru)) return
#else
    usxnfield = esmf_fieldcreate( natgrid, natarrayspec3d, &
         gridtofieldmap=(/2,3/), ungriddedlbound=(/1/), ungriddedubound=(/nz/), &
         staggerloc=natstaggerloc, rc=rc )
    if (esmf_logfounderror(rc, passthru)) return
    usynfield = esmf_fieldcreate( natgrid, natarrayspec3d, &
         gridtofieldmap=(/2,3/), ungriddedlbound=(/1/), ungriddedubound=(/nz/), &
         staggerloc=natstaggerloc, rc=rc )
    if (esmf_logfounderror(rc, passthru)) return
#endif
 
    call fieldfill( usxnfield, zerovalue, rc=rc )
    if (esmf_logfounderror(rc, passthru)) return
    call fieldfill( usynfield, zerovalue, rc=rc )
    if (esmf_logfounderror(rc, passthru)) return
 
    if ( natgridislocal ) then
 
      call esmf_fieldget( usxnfield, farrayptr=usxn, rc=rc )
      if (esmf_logfounderror(rc, passthru)) return
      call esmf_fieldget( usynfield, farrayptr=usyn, rc=rc )
      if (esmf_logfounderror(rc, passthru)) return
 
      allocate( fack(1:nk) )
      fack(1:nk) = dden(1:nk) * sig(1:nk)
 
      jsea_loop: do jsea = 1,nseal
#ifdef W3_DIST
        isea = iaproc + (jsea-1)*naproc
#endif
#ifdef W3_SHRD
        isea = jsea
#endif
        if ( dw(isea).le.zero ) cycle jsea_loop
        depth = max(dmin,dw(isea))
        uzx(:) = zero
        uzy(:) = zero
#ifdef USE_W3OUTG_FOR_EXPORT
        ik_loop: do ik = us3df(2),us3df(3)
          fac1 = tpiinv*dsii(ik)
          kd = max(kdmin_us3d,wn(ik,isea)*dw(isea))
          iz_loop: do iz = 1,nz
            if ( dw(isea)+zl(iz).le.zero ) cycle iz_loop
            kz = wn(ik,isea)*zl(iz)
            if ( kd .lt. kdmax_us3d ) then
              fac2 = fac1*cosh(two*max(zero,kd+kz))/cosh(two*kd)
            else
              fac2 = fac1*exp(two*kz)
            endif
            uzx(iz) = uzx(iz) + us3d(jsea,ik   )*fac2
            uzy(iz) = uzy(iz) + us3d(jsea,nk+ik)*fac2
          enddo iz_loop
        enddo ik_loop
#else
        ik_loop: do ik = 1,nk
          akx = zero
          aky = zero
          ith_loop: do ith = 1,nth
            akx = akx + a(ith,ik,jsea)*ecos(ith)
            aky = aky + a(ith,ik,jsea)*esin(ith)
          enddo ith_loop
          fac1 = fack(ik)*wn(ik,isea)/cg(ik,isea)
          kd = max(kdmin,wn(ik,isea)*depth)
          if ( kd .lt. kdmax ) then
            fac2 = fac1/sinh(kd)**2
          else
            fac2 = fac1*two
          endif
          akx = akx*fac2
          aky = aky*fac2
          iz_loop: do iz = 1,nz
            if ( depth+zl(iz).le.zero ) cycle iz_loop
            kz = wn(ik,isea)*zl(iz)
            if ( kd .lt. kdmax ) then
              fac3 = cosh(two*max(zero,kd+kz))
            else
              fac3 = exp(two*kz)
            endif
            uzx(iz) = uzx(iz) + akx*fac3
            uzy(iz) = uzy(iz) + aky*fac3
          enddo iz_loop
        enddo ik_loop
#endif
        usxn(:,jsea) = uzx(:)
        usyn(:,jsea) = uzy(:)
      enddo jsea_loop
 
      deallocate( fack )
 
    endif !natGridIsLocal
 
    call esmf_fieldredist( usxnfield, usxfield, n2erh, rc=rc )
    if (esmf_logfounderror(rc, passthru)) return
    call esmf_fieldredist( usynfield, usyfield, n2erh, rc=rc )
    if (esmf_logfounderror(rc, passthru)) return
 
#ifdef ESMF_ARBSEQ_WORKAROUND
    call esmf_arraydestroy( usxnarray, rc=rc )
    if (esmf_logfounderror(rc, passthru)) return
    call esmf_arraydestroy( usynarray, rc=rc )
    if (esmf_logfounderror(rc, passthru)) return
#endif
    call esmf_fielddestroy( usxnfield, rc=rc )
    if (esmf_logfounderror(rc, passthru)) return
    call esmf_fielddestroy( usynfield, rc=rc )
    if (esmf_logfounderror(rc, passthru)) return
 
#ifdef TEST_WMESMFMD_STOKES3D
    call esmf_fieldwrite( usxfield, "wmesmfmd_stokes3d_usx.nc", &
         overwrite=.true., timeslice=timeslice, rc=rc )
    if (esmf_logfounderror(rc, passthru)) return
    call esmf_fieldwrite( usyfield, "wmesmfmd_stokes3d_usy.nc", &
         overwrite=.true., timeslice=timeslice, rc=rc )
    if (esmf_logfounderror(rc, passthru)) return
    timeslice = timeslice + 1
#endif
    !/
    !/ End of CalcStokes3D ----------------------------------------------- /
    !/

References w3iogomd::calc_u3stokes(), w3adatmd::cg, w3gdatmd::dden, w3gdatmd::dmin, w3gdatmd::dsii, w3adatmd::dw, w3gdatmd::ecos, w3gdatmd::esin, w3odatmd::iaproc, w3odatmd::naproc, w3gdatmd::sig, constants::tpiinv, w3adatmd::us3d, w3gdatmd::us3df, w3adatmd::ussp, and w3adatmd::wn.

createexpmesh()

subroutine wmesmfmd::createexpmesh	(	type(esmf_gridcomp)	gcomp,
		integer, intent(out)	rc
	)

Create ESMF mesh (unstructured) for export fields.

Create an ESMF Mesh for export using the unstructured mesh description in W3GDATMD. At present, this export mesh is not domain decomposed, but instead is defined on PET 0 only. (In future, when the unstructured mesh will run on domain decomposition, we will use that decomposition.)

Since the internal parallel data is currently stored accross grid points in a "card deck" fashion, we will define an intermediate native grid, as is done for regular/curvilinear grids, and perform an ESMF regrid to the export mesh. This code segment is taken from T. J. Campbell, and modified to 1D, because the internal data structure for unstructred meshes is an array with dimensions [NX,NY=1].

Parameters

	gcomp	Gridded component
[out]	rc	Return code

Author

A. J. van der Westhuysen

Date

28-Feb-2018

Definition at line 4554 of file wmesmfmd.F90.

    !/
    !/                  +-----------------------------------+
    !/                  | WAVEWATCH III           NOAA/NCEP |
    !/                  |     A. J. van der Westhuysen      |
    !/                  |                        FORTRAN 90 |
    !/                  | Last update :         28-FEB-2018 |
    !/                  +-----------------------------------+
    !/
    !/    28-Feb-2018 : Origination.                        ( version 6.06 )
    !/
    !  1. Purpose :
    !
    !     Create ESMF mesh (unstructured) for export fields
    !
    !  2. Method :
    !
    !     Create an ESMF Mesh for export using the unstructured mesh description
    !     in W3GDATMD. At present, this export mesh is not domain decomposed,
    !     but instead is defined on PET 0 only. (In future, when the unstructured
    !     mesh will run on domain decomposition, we will use that decomposition.)
    !
    !     Since the internal parallel data is currently stored accross grid points
    !     in a "card deck" fashion, we will define an intermediate native grid, as
    !     is done for regular/curvilinear grids, and perform an ESMF regrid to the
    !     export mesh. This code segment is taken from T. J. Campbell, and
    !     modified to 1D, because the internal data structure for unstructred
    !     meshes is an array with dimensions [NX,NY=1].
    !
    !  3. Parameters :
    !
    !     Parameter list
    !     ----------------------------------------------------------------
    !       gcomp     Type   I/O Gridded component
    !       rc        Int.   O   Return code
    !     ----------------------------------------------------------------
    !
    !  4. Subroutines used :
    !
    !      Name      Type  Module   Description
    !     ----------------------------------------------------------------
    !      NONE
    !     ----------------------------------------------------------------
    !
    !  5. Called by :
    !
    !  6. Error messages :
    !
    !  7. Remarks :
    !
    !  8. Structure :
    !
    !  9. Switches :
    !
    !       !/SHRD  Switch for shared / distributed memory architecture.
    !       !/DIST  Id.
    !
    ! 10. Source code :
    !
    !/ ------------------------------------------------------------------- /
    !/
#ifdef W3_PDLIB
    use yownodepool, only: npa, iplg, nodes_global
    use yowelementpool, only: ne, ielg, ine
#endif
    !/
    !/ ------------------------------------------------------------------- /
    !/ Parameter list
    !/
    implicit none
    type(ESMF_GridComp) :: gcomp
    integer,intent(out) :: rc
    !/
    !/ ------------------------------------------------------------------- /
    !/ Local parameters
    !/
    character(ESMF_MAXSTR) :: cname
    character(128) :: msg
    integer :: nproc, nxproc, nyproc, n, nfac, irp
    real    :: gr, rp, pr, diff
    integer, parameter :: lde = 0
    integer :: ldecnt
    integer :: i, j, pos, ix, iy, isea, jsea, iproc
    integer :: elb(2), eub(2)
    integer(ESMF_KIND_I4), pointer :: iptr(:,:)
    real(ESMF_KIND_RX), pointer :: rptrx(:,:), rptry(:,:)
    real(ESMF_KIND_RX), pointer :: rptr(:,:)
    integer :: arbIndexCount
    integer, allocatable :: arbIndexList(:,:)
    type(ESMF_Field) :: nField, eField
    type(ESMF_Field) :: tmpField
    integer(ESMF_KIND_I4), allocatable :: nodeIds(:)
    real(ESMF_KIND_R8), allocatable    :: nodeCoords(:)
    integer(ESMF_KIND_I4), allocatable :: nodeOwners(:)
    integer(ESMF_KIND_I4), allocatable :: elemIds(:)
    integer(ESMF_KIND_I4), allocatable :: elemTypes(:)
    integer(ESMF_KIND_I4), allocatable :: elemConn(:)
    !
    ! -------------------------------------------------------------------- /
    ! Prep
    !
    rc = esmf_success
    if ( noactiveexpfields ) return
    call esmf_gridcompget(gcomp, name=cname, rc=rc)
    if (esmf_logfounderror(rc, passthru)) return
    if (verbosity.gt.0) call esmf_logwrite(trim(cname)// &
         ': entered CreateExpMesh', esmf_logmsg_info)
    !
    ! -------------------------------------------------------------------- /
    !     Set flag to indicate that this processor has local native grid storage
    !
    natgridislocal = iaproc .gt. 0 .and. iaproc .le. naproc
 
    ! 1.  Setup
    !
    ! 1.a Set grid pointers
    !
    expgridid = 1 !TODO: only export from grid 1
    call w3setg ( expgridid, mdse, mdst )
    call w3setw ( expgridid, mdse, mdst )
    call w3seta ( expgridid, mdse, mdst )
    call w3seti ( expgridid, mdse, mdst )
    call w3seto ( expgridid, mdse, mdst )
    call wmsetm ( expgridid, mdse, mdst )
    natgridid = expgridid
    nproc = naproc
    !
    ! 1.b Set arraySpec, staggerLoc, and indexFlag for native fields.
    !     NOTE: For unstructured meshes the native grid is a 1D array (NY=1)
    !
    call esmf_arrayspecset( natarrayspec1d, rank=1, &
         typekind=esmf_typekind_rx, rc=rc )
    if (esmf_logfounderror(rc, passthru)) return
    natstaggerloc = esmf_staggerloc_center
    natindexflag = esmf_index_delocal
    !
    ! -------------------------------------------------------------------- /
    ! 2.  Create ESMF mesh for export
    !
    ! 2.a Create ESMF export mesh
    !
    ! Allocate and fill the node id array.
#ifdef W3_PDLIB
    if ( lpdlib .EQV. .false. ) then
#endif
      allocate(nodeids(nx))
      do i = 1,nx
        nodeids(i)=i
      enddo
#ifdef W3_PDLIB
    else
      !        -------------------------------------------------------------------
      !        ESMF Definition: The global id's of the nodes resident on this processor
      !        -------------------------------------------------------------------
      !        Allocate global node ids, including ghost nodes (npa=np+ng)
      allocate(nodeids(npa))
      do i = 1,npa
        nodeids(i)=iplg(i)
      enddo
    endif
    !
    !      call ESMF_LogWrite(trim(cname)//': In CreateExpMesh, nodeIds=', &
    !          ESMF_LOGMSG_INFO)
    !         do i = 1,npa
    !         write(msg,*) trim(cname)//': nodeIds(i)',i, &
    !          ' ',nodeIds(i)
    !        call ESMF_LogWrite(trim(msg), ESMF_LOGMSG_INFO)
    !      enddo
#endif
 
    !      call ESMF_LogWrite(trim(cname)//': In CreateExpMesh, nodeIds=', &
    !          ESMF_LOGMSG_INFO)
    !      do i = 1,NX
    !        write(msg,*) trim(cname)//': ',i, &
    !          ' ',nodeIds(i)
    !        call ESMF_LogWrite(trim(msg), ESMF_LOGMSG_INFO)
    !      enddo
 
    ! Allocate and fill node coordinate array.
    ! Since this is a 2D Mesh the size is 2x the
    ! number of nodes.
#ifdef W3_PDLIB
    if ( lpdlib .EQV. .false. ) then
#endif
      allocate(nodecoords(2*nx))
      do i = 1,nx
        do j = 1,2
          pos=2*(i-1)+j
          if (j == 1) then
            nodecoords(pos) = xgrd(1,i)
          else
            nodecoords(pos) = ygrd(1,i)
          endif
        enddo
      enddo
#ifdef W3_PDLIB
    else
      !        -------------------------------------------------------------------
      !        ESMF Definition: Physical coordinates of the nodes
      !        -------------------------------------------------------------------
      allocate(nodecoords(2*npa))
      do i = 1,npa
        do j = 1,2
          pos=2*(i-1)+j
          if ( j == 1) then
            nodecoords(pos) = xgrd(1,iplg(i))
          else
            nodecoords(pos) = ygrd(1,iplg(i))
          endif
        enddo
      enddo
    endif
    !
    !      call ESMF_LogWrite(trim(cname)//': In CreateExpMesh, nodeCoords=', &
    !          ESMF_LOGMSG_INFO)
    !      do i = 1,(2*npa)
    !        write(msg,*) trim(cname)//': nodeCoords(i)',i, &
    !          ' ',nodeCoords(i)
    !        call ESMF_LogWrite(trim(msg), ESMF_LOGMSG_INFO)
    !      enddo
#endif
 
    !      call ESMF_LogWrite(trim(cname)//': In CreateExpMesh, nodeCoords=', &
    !          ESMF_LOGMSG_INFO)
    !      do i = 1,(2*NX)
    !        write(msg,*) trim(cname)//': ',i, &
    !          ' ',nodeCoords(i)
    !        call ESMF_LogWrite(trim(msg), ESMF_LOGMSG_INFO)
    !      enddo
 
    ! Allocate and fill the node owner array.
#ifdef W3_PDLIB
    if ( lpdlib .EQV. .false. ) then
#endif
      allocate(nodeowners(nx))
      nodeowners=0 ! TODO: For now, export everything via PET 0
#ifdef W3_PDLIB
    else
      !        -------------------------------------------------------------------
      !        ESMF Definition: Processor that owns the node
      !        -------------------------------------------------------------------
      allocate(nodeowners(npa))
      nodeowners=nodes_global(iplg(1:npa))%domainID-1
    endif
    !
    !      call ESMF_LogWrite(trim(cname)//': In CreateExpMesh, nodeOwners=', &
    !          ESMF_LOGMSG_INFO)
    !      do i = 1,npa
    !        write(msg,*) trim(cname)//': nodeOwners(i)',i, &
    !          ' ',nodeOwners(i)
    !        call ESMF_LogWrite(trim(msg), ESMF_LOGMSG_INFO)
    !      enddo
#endif
 
    !      call ESMF_LogWrite(trim(cname)//': In CreateExpMesh, nodeOwners=', &
    !          ESMF_LOGMSG_INFO)
    !      do i = 1,NX
    !        write(msg,*) trim(cname)//': ',i, &
    !          ' ',nodeOwners(i)
    !        call ESMF_LogWrite(trim(msg), ESMF_LOGMSG_INFO)
    !      enddo
 
    ! Allocate and fill the element id array.
#ifdef W3_PDLIB
    if ( lpdlib .EQV. .false. ) then
#endif
      allocate(elemids(ntri))
      do i = 1,ntri
        elemids(i)=i
      enddo
#ifdef W3_PDLIB
    else
      !        -------------------------------------------------------------------
      !        ESMF Definition: The global id's of the elements resident on this processor
      !        -------------------------------------------------------------------
      allocate(elemids(ne))
      do i = 1,ne
        elemids(i)=ielg(i)
      enddo
    endif
    !
    !      call ESMF_LogWrite(trim(cname)//': In CreateExpMesh, elemIds=', &
    !          ESMF_LOGMSG_INFO)
    !      do i = 1,ne
    !        write(msg,*) trim(cname)//': elemIds(i)',i, &
    !          ' ',elemIds(i)
    !        call ESMF_LogWrite(trim(msg), ESMF_LOGMSG_INFO)
    !      enddo
#endif
 
    !      call ESMF_LogWrite(trim(cname)//': In CreateExpMesh, elemIds=', &
    !          ESMF_LOGMSG_INFO)
    !      do i = 1,NTRI
    !        write(msg,*) trim(cname)//': ',i, &
    !          ' ',elemIds(i)
    !        call ESMF_LogWrite(trim(msg), ESMF_LOGMSG_INFO)
    !      enddo
 
    ! Allocate and fill the element topology type array.
#ifdef W3_PDLIB
    if ( lpdlib .EQV. .false. ) then
#endif
      allocate(elemtypes(ntri))
      do i = 1,ntri
        elemtypes(i)=esmf_meshelemtype_tri
      enddo
#ifdef W3_PDLIB
    else
      !        -------------------------------------------------------------------
      !        ESMF Definition: Topology of the given element (one of ESMF_MeshElement)
      !        -------------------------------------------------------------------
      allocate(elemtypes(ne))
      do i = 1,ne
        elemtypes(i)=esmf_meshelemtype_tri
      enddo
    endif
    !
    !      call ESMF_LogWrite(trim(cname)//': In CreateExpMesh, elemTypes=', &
    !          ESMF_LOGMSG_INFO)
    !      do i = 1,ne
    !        write(msg,*) trim(cname)//': elemTypes(i)',i, &
    !          ' ',elemTypes(i)
    !        call ESMF_LogWrite(trim(msg), ESMF_LOGMSG_INFO)
    !      enddo
#endif
 
    !      call ESMF_LogWrite(trim(cname)//': In CreateExpMesh, elemTypes=', &
    !          ESMF_LOGMSG_INFO)
    !      do i = 1,NTRI
    !        write(msg,*) trim(cname)//': ',i, &
    !          ' ',elemTypes(i)
    !        call ESMF_LogWrite(trim(msg), ESMF_LOGMSG_INFO)
    !      enddo
 
    ! Allocate and fill the element connection type array.
#ifdef W3_PDLIB
    if ( lpdlib .EQV. .false. ) then
#endif
      allocate(elemconn(3*ntri))
      do i = 1,ntri
        do j = 1,3
          pos=3*(i-1)+j
          elemconn(pos)=trigp(j,i)
        enddo
      enddo
#ifdef W3_PDLIB
    else
      !        -------------------------------------------------------------------
      !        ESMF Definition: Connectivity table. The number of entries should
      !        be equal to the number of nodes in the given topology. The indices
      !        should be the local index (1 based) into the array of nodes that
      !        was declared with MeshAddNodes.
      !        -------------------------------------------------------------------
      !        > INE is local element array. it stores the local node IDs
      !        > first index from 1 to 3.
      !        > second index from 1 to ne.
      allocate(elemconn(3*ne))
      do i = 1,ne
        do j = 1,3
          pos=3*(i-1)+j
          elemconn(pos)=ine(j,i)
        enddo
      enddo
    endif
    !
    !      call ESMF_LogWrite(trim(cname)//': In CreateExpMesh, elemConn=', &
    !          ESMF_LOGMSG_INFO)
    !      do i = 1,(3*ne)
    !        write(msg,*) trim(cname)//': elemConn(i)',i, &
    !          ' ',elemConn(i)
    !        call ESMF_LogWrite(trim(msg), ESMF_LOGMSG_INFO)
    !      enddo
#endif
 
    !      call ESMF_LogWrite(trim(cname)//': In CreateExpMesh, elemConn=', &
    !          ESMF_LOGMSG_INFO)
    !      do i = 1,(3*NTRI)
    !        write(msg,*) trim(cname)//': ',i, &
    !          ' ',elemConn(i)
    !        call ESMF_LogWrite(trim(msg), ESMF_LOGMSG_INFO)
    !      enddo
 
    expmesh = esmf_meshcreate( parametricdim=2,spatialdim=2, &
         nodeids=nodeids, nodecoords=nodecoords, &
         nodeowners=nodeowners, elementids=elemids,&
         elementtypes=elemtypes, elementconn=elemconn, &
         rc=rc )
    if (esmf_logfounderror(rc, passthru)) return
 
    deallocate(nodeids)
    deallocate(nodecoords)
    deallocate(nodeowners)
    deallocate(elemids)
    deallocate(elemtypes)
    deallocate(elemconn)
    !
    !     Set flag to indicate that this processor has local export grid storage
    !
    !AW      if (lpet == 0) then
    !AW         call ESMF_GridGet( expMesh, localDECount=ldecnt, rc=rc )
    !AW         if (ESMF_LogFoundError(rc, PASSTHRU)) return
    !AW         expGridIsLocal = ldecnt.gt.0
    !AW      endif
 
    !
    ! -------------------------------------------------------------------- /
    ! 3.  Create ESMF grid with arbitrary domain decomposition to match
    !     the native domain decomposition of the non-excluded points
    !     Note that the native grid layout is dim1=Y, dim2=X
    !     Note that coordinates and mask are not needed since this
    !     grid is only used to define fields for a redist operation
    !
    ! 3.a Set flag to indicate that this processor has local native grid storage
    !
    natgridislocal = iaproc .gt. 0 .and. iaproc .le. naproc
 
#ifdef W3_PDLIB
    if ( lpdlib .EQV. .false. ) then
#endif
      !
      ! 3.b Setup arbitrary sequence index list
      !
      do ipass = 1,2
        if (ipass.eq.2) then
          allocate (arbindexlist(arbindexcount,2), stat=rc)
          if (esmf_logfoundallocerror(rc, passthru)) return
        endif
        arbindexcount = 0
        ! list local native grid non-excluded points
        if ( natgridislocal ) then
          do jsea = 1,nseal
#ifdef W3_DIST
            isea = iaproc + (jsea-1)*naproc
#endif
#ifdef W3_SHRD
            isea = jsea
#endif
            arbindexcount = arbindexcount+1
            if (ipass.eq.2) then
              ix = mapsf(isea,1)
              iy = mapsf(isea,2)
              ! native grid layout: dim1=Y, dim2=X
              arbindexlist(arbindexcount,1) = iy
              arbindexlist(arbindexcount,2) = ix
            endif
          enddo
        endif
      enddo !ipass
      !
      ! 3.c Create ESMF native grid
      !
      natgrid = esmf_gridcreatenoperidim( &
           minindex=(/ 1, 1/), &
           maxindex=(/ny,nx/), &
           coorddep1=(/esmf_dim_arb,esmf_dim_arb/), &
           coorddep2=(/esmf_dim_arb,esmf_dim_arb/), &
           arbindexcount=arbindexcount, &
           arbindexlist=arbindexlist, &
           coordtypekind=esmf_typekind_rx, &
           coordsys=esmf_coordsys_sph_deg, &
           name=trim(cname)//"_native_grid", rc=rc )
      if (esmf_logfounderror(rc, passthru)) return
      !
      ! 3.d Deallocate arbitrary sequence index list
      !
      deallocate (arbindexlist, stat=rc)
      if (esmf_logfounddeallocerror(rc, passthru)) return
      !
      ! -------------------------------------------------------------------- /
      ! 4.  Create route handle for redist between native grid domain
      !     decomposition and the export grid domain decomposition
      !
      ! 4.a Create temporary fields
      !
      nfield = esmf_fieldcreate( natgrid, natarrayspec1d, &
           staggerloc=natstaggerloc, rc=rc )
      if (esmf_logfounderror(rc, passthru)) return
      efield = esmf_fieldcreate(expmesh, typekind=esmf_typekind_rx, rc=rc)
      if (esmf_logfounderror(rc, passthru)) return
      !
      ! 4.b Store route handle
      !
      call esmf_fieldrediststore( nfield, efield, n2erh, rc=rc )
      if (esmf_logfounderror(rc, passthru)) return
      !
      ! 4.c Clean up
      !
      call esmf_fielddestroy( nfield, rc=rc )
      if (esmf_logfounderror(rc, passthru)) return
      call esmf_fielddestroy( efield, rc=rc )
      if (esmf_logfounderror(rc, passthru)) return
 
#ifdef W3_PDLIB
    endif
#endif
 
    call esmf_logwrite(trim(cname)//': In CreateExpMesh, created expMesh', &
         esmf_logmsg_info)
 
    rc = esmf_success
    if (verbosity.gt.0) call esmf_logwrite(trim(cname)// &
         ': leaving CreateExpMesh', esmf_logmsg_info)
    !/
    !/ End of CreateExpMesh ---------------------------------------------- /
    !/

References w3odatmd::iaproc, yowelementpool::ielg, yowelementpool::ine, w3adatmd::ipass, yownodepool::iplg, constants::lpdlib, w3gdatmd::mapsf, wmmdatmd::mdse, wmmdatmd::mdst, w3odatmd::naproc, yowelementpool::ne, yownodepool::nodes_global, yownodepool::npa, w3gdatmd::nseal, w3gdatmd::ntri, w3gdatmd::nx, w3gdatmd::ny, w3gdatmd::trigp, w3adatmd::w3seta(), w3gdatmd::w3setg(), w3idatmd::w3seti(), w3odatmd::w3seto(), w3wdatmd::w3setw(), wmmdatmd::wmsetm(), w3gdatmd::xgrd, and w3gdatmd::ygrd.

fieldindex()

integer function wmesmfmd::fieldindex	(	character (len=*), dimension(:)	fnameList,
		character (len=*)	fname,
		integer	rc
	)

Return index associated with field name.

Parameters

fnameList	Array of field names
fname	Field name
rc	Return code

Returns

indx Returned index of fname

Author

T. J. Campbell

Date

20-Jan-2017

Definition at line 5857 of file wmesmfmd.F90.

    !/
    !/                  +-----------------------------------+
    !/                  | WAVEWATCH III           NOAA/NCEP |
    !/                  |        T. J. Campbell, NRL        |
    !/                  |                        FORTRAN 90 |
    !/                  | Last update :         20-Jan-2017 |
    !/                  +-----------------------------------+
    !/
    !/    20-Jan-2017 : Origination.                        ( version 6.02 )
    !/
    !  1. Purpose :
    !
    !     Return index associated with field name
    !
    !  2. Method :
    !
    !  3. Parameters :
    !
    !     Parameter list
    !     ----------------------------------------------------------------
    !       fnameList StrA   I   Array of field names
    !       fname     Str    I   Field name
    !       rc        Int.   O   Return code
    !       indx      Int    I   Returned index of fname
    !     ----------------------------------------------------------------
    !
    !  4. Subroutines used :
    !
    !      Name      Type  Module   Description
    !     ----------------------------------------------------------------
    !      NONE
    !     ----------------------------------------------------------------
    !
    !  5. Called by :
    !
    !  6. Error messages :
    !
    !  7. Remarks :
    !
    !  8. Structure :
    !
    !  9. Switches :
    !
    ! 10. Source code :
    !
    !/ ------------------------------------------------------------------- /
    !/
    !/ ------------------------------------------------------------------- /
    !/ Parameter list
    !/
    implicit none
    character (len=*) :: fnameList(:)
    character (len=*) :: fname
    integer           :: rc
    integer           :: indx
    !/
    !/ ------------------------------------------------------------------- /
    !/ Local parameters
    !/
    integer       :: i, check
    !
    ! -------------------------------------------------------------------- /
    ! Find name in fnameList that matches fname
    !
    check = lbound(fnamelist,1) - 1
    indx = check
    do i = lbound(fnamelist,1),ubound(fnamelist,1)
      if ( trim(fnamelist(i)).eq.trim(fname) ) then
        indx = i
        exit
      endif
    enddo
    if ( indx.eq.check ) then
      call esmf_logseterror(esmf_failure, rctoreturn=rc, &
           msg='FieldIndex: input name ('//fname//') not in list')
    endif
    !/
    !/ End of FieldIndex ------------------------------------------------- /
    !/

References w3adatmd::aba, w3adatmd::cg, w3adatmd::charn, check(), w3gdatmd::clgtype, w3gdatmd::dden, w3gdatmd::dmin, w3adatmd::dw, constants::dwat, w3gdatmd::ec2, w3gdatmd::ecos, w3gdatmd::es2, w3gdatmd::esc, w3gdatmd::esin, file(), w3gdatmd::fte, constants::grav, w3gdatmd::gtype, w3odatmd::iaproc, yownodepool::iplg, constants::lpdlib, w3gdatmd::mapsf, w3gdatmd::mapsta, w3odatmd::naproc, w3gdatmd::nk, yownodepool::np, w3gdatmd::nseal, w3gdatmd::nth, w3gdatmd::nx, w3gdatmd::ny, w3gdatmd::rlgtype, w3gdatmd::sig, w3gdatmd::sig2, w3adatmd::sxx, w3adatmd::sxy, w3adatmd::syy, constants::tpi, w3adatmd::u10, w3adatmd::u10d, w3adatmd::uba, w3adatmd::ubd, w3gdatmd::ungtype, w3wdatmd::ust, w3wdatmd::va, w3src3md::w3spr3(), w3src4md::w3spr4(), w3adatmd::wn, and w3adatmd::wnmean.

readfromfile()

subroutine wmesmfmd::readfromfile	(	character(len=3), intent(inout)	idfld,
		type(esmf_field), intent(inout)	fldwx,
		type(esmf_field), intent(inout)	fldwy,
		integer, dimension(2), intent(in)	time0,
		integer, dimension(2), intent(in)	timen,
		integer, intent(inout), optional	rc
	)

Read input file to fill unmapped point for regional applications.

Parameters

[in,out]	idfld	Field name
[in,out]	fldwx	2D eastward-component of field
[in,out]	fldwy	2D northward-component of field
[in]	time0	Time stamp for current time
[in]	timen	Time stamp for end time
[in,out]	rc	Return code

Author

U. Turuncoglu

Date

18-May-2021

Definition at line 7709 of file wmesmfmd.F90.

    !/
    !/                  +-----------------------------------+
    !/                  | WAVEWATCH III           NOAA/NCEP |
    !/                  |           U. Turuncoglu           |
    !/                  |                        FORTRAN 90 |
    !/                  | Last update :         18-May-2021 |
    !/                  +-----------------------------------+
    !/
    !/    18-May-2021 : Origination.                        ( version 7.13 )
    !/
    !  1. Purpose :
    !
    !     Read input file to fill unmapped point for regional applications
    !
    !  2. Method :
    !
    !  3. Parameters :
    !
    !     Parameter list
    !     ----------------------------------------------------------------
    !       idfld     Str    I/O Field name
    !       fldwx     Type   I/O 2D eastward-component of field
    !       fldwy     Type   I/O 2D northward-component of field
    !       time0     Int    I   Time stamp for current time
    !       timen     Int    I   Time stamp for end time
    !       rc        Int    I/O Return code
    !     ----------------------------------------------------------------
    !
    !  4. Subroutines used :
    !
    !      Name      Type  Module   Description
    !     ----------------------------------------------------------------
    !      NONE
    !     ----------------------------------------------------------------
    !
    !  5. Called by :
    !
    !  6. Error messages :
    !
    !  7. Remarks :
    !
    !  8. Structure :
    !
    !  9. Switches :
    !
    ! 10. Source code :
    !
    !/ ------------------------------------------------------------------- /
    !/
    USE w3fldsmd, ONLY: w3fldo, w3fldg
    USE wmunitmd, ONLY: wmuget, wmuset
    IMPLICIT NONE
    !/ ------------------------------------------------------------------- /
    !/ Parameter list
    !/
    character(len=3), intent(inout)  :: idfld
    type(ESMF_Field), intent(inout)  :: fldwx
    type(ESMF_Field), intent(inout)  :: fldwy
    integer, intent(in)              :: time0(2)
    integer, intent(in)              :: timen(2)
    integer, intent(inout), optional :: rc
    !/
    !/ ------------------------------------------------------------------- /
    !/ Local parameters
    !/
    integer :: ierr, tw0l(2), twnl(2), lb(2), ub(2)
    real :: wx0l(nx,ny), wy0l(nx,ny)
    real :: wxnl(nx,ny), wynl(nx,ny)
    real :: dt0l(nx,ny), dtnl(nx,ny)
    real(ESMF_KIND_RX), pointer :: dptr(:,:)
    integer :: mdse = 6
    integer :: mdst = 10
    integer, save :: mdsf
    character(256) :: logmsg
    logical :: flagsc = .false.
    integer, parameter :: lde = 0
    logical, save :: firstCall = .true.
    character(len=13) :: tsstr
    character(len=3) :: tsfld
    integer :: nxt, nyt, gtypet, filler(3), tideflag
#if defined(TEST_WMESMFMD) || defined(TEST_WMESMFMD_READFROMFILE)
    integer, save :: timeSlice = 1
#endif
    !
    ! -------------------------------------------------------------------- /
    !
    rc = esmf_success
 
    if (firstcall) then
      ! assign unit number for input file
      call wmuget(mdse, mdst, mdsf, 'INP')
      call wmuset(mdse, mdst, mdsf, .true., desc='Input data file')
 
      ! open file
      call w3fldo('READ', idfld, mdsf, mdst, mdse, nx, ny, gtype, ierr)
      if (ierr.ne.0) then
        write(logmsg,*) "Error in opening "//idfld//", iostat = ", ierr
        call esmf_logwrite(trim(logmsg), esmf_logmsg_error)
        rc = esmf_failure
        return
      endif
 
      firstcall = .false.
    end if
 
    ! init variables
    wx0l = 0.0
    wy0l = 0.0
    dt0l = 0.0
    wxnl = 0.0
    wynl = 0.0
    dtnl = 0.0
 
    ! need to rewind to the begining of the file to access
    ! data of requested date correctly
    rewind(mdsf)
 
    ! read header information
    ! this was inside of w3fldo call but since we are opening file
    ! once and rewinding, the header need to be read
    read(mdsf, iostat=ierr) tsstr, tsfld, nxt, nyt, &
         gtypet, filler(1:2), tideflag
 
    ! read input
    call w3fldg('READ', idfld, mdsf, mdst, mdse, nx, ny, &
         nx, ny, time0, timen, tw0l, wx0l, wy0l, dt0l, twnl, &
         wxnl, wynl, dtnl, ierr, flagsc)
 
    ! fill fields with data belong to current time
    if ( impgridislocal ) then
      call esmf_fieldget(fldwx, localde=lde, farrayptr=dptr, &
           exclusivelbound=lb, exclusiveubound=ub, rc=rc)
      if (esmf_logfounderror(rc, passthru)) return
      dptr(lb(1):ub(1),lb(2):ub(2)) = wx0l(lb(1):ub(1),lb(2):ub(2))
      if (associated(dptr)) nullify(dptr)
      call esmf_fieldget(fldwy, localde=lde, farrayptr=dptr, &
           exclusivelbound=lb, exclusiveubound=ub, rc=rc)
      if (esmf_logfounderror(rc, passthru)) return
      dptr(lb(1):ub(1),lb(2):ub(2)) = wy0l(lb(1):ub(1),lb(2):ub(2))
      if (associated(dptr)) nullify(dptr)
    end if
 
#if defined(TEST_WMESMFMD) || defined(TEST_WMESMFMD_READFROMFILE)
    write(logmsg,*) 'time0 = ', time0(1), time0(2)
    call esmf_logwrite(trim(logmsg), esmf_logmsg_info, rc=rc)
    if (esmf_logfounderror(rc, passthru)) return
    write(logmsg,*) 'timen = ', timen(1), timen(2)
    call esmf_logwrite(trim(logmsg), esmf_logmsg_info, rc=rc)
    if (esmf_logfounderror(rc, passthru)) return
    write(logmsg,*) 'tw0 = ', tw0l(1), tw0l(2)
    call esmf_logwrite(trim(logmsg), esmf_logmsg_info, rc=rc)
    if (esmf_logfounderror(rc, passthru)) return
    write(logmsg,*) 'twn = ', twnl(1), twnl(2)
    call esmf_logwrite(trim(logmsg), esmf_logmsg_info, rc=rc)
    if (esmf_logfounderror(rc, passthru)) return
    write(logmsg,*) 'wx0 min, max = ', minval(wx0l), maxval(wx0l)
    call esmf_logwrite(trim(logmsg), esmf_logmsg_info, rc=rc)
    if (esmf_logfounderror(rc, passthru)) return
    write(logmsg,*) 'wy0 min, max = ', minval(wy0l), maxval(wy0l)
    call esmf_logwrite(trim(logmsg), esmf_logmsg_info, rc=rc)
    if (esmf_logfounderror(rc, passthru)) return
    write(logmsg,*) 'wxn min, max = ', minval(wxnl), maxval(wxnl)
    call esmf_logwrite(trim(logmsg), esmf_logmsg_info, rc=rc)
    if (esmf_logfounderror(rc, passthru)) return
    write(logmsg,*) 'wyn min, max = ', minval(wynl), maxval(wynl)
    call esmf_logwrite(trim(logmsg), esmf_logmsg_info, rc=rc)
    if (esmf_logfounderror(rc, passthru)) return
    call esmf_fieldwrite( fldwx, &
         "wmesmfmd_read_wx0.nc", &
         overwrite=.true., timeslice=timeslice, rc=rc )
    if (esmf_logfounderror(rc, passthru)) return
    call esmf_fieldwrite( fldwy, &
         "wmesmfmd_read_wy0.nc", &
         overwrite=.true., timeslice=timeslice, rc=rc )
    if (esmf_logfounderror(rc, passthru)) return
    timeslice = timeslice + 1
#endif
    !/
    !/ End of ReadFromFile ------------------------------------------- /
    !/

References w3gdatmd::gtype, w3fldsmd::w3fldg(), w3fldsmd::w3fldo(), wmunitmd::wmuget(), and wmunitmd::wmuset().

setexport()

subroutine wmesmfmd::setexport	(	type(esmf_gridcomp)	gcomp,
		integer, intent(out)	rc
	)

Set export fields from internal data structures.

Parameters

	gcomp	Gridded component
[out]	rc	Return code

Author

T. J. Campbell

Date

09-Aug-2017

Definition at line 2821 of file wmesmfmd.F90.

    !/
    !/                  +-----------------------------------+
    !/                  | WAVEWATCH III           NOAA/NCEP |
    !/                  |        T. J. Campbell, NRL        |
    !/                  |                        FORTRAN 90 |
    !/                  | Last update :         09-Aug-2017 |
    !/                  +-----------------------------------+
    !/
    !/    20-Jan-2017 : Origination.                        ( version 6.02 )
    !/    09-Aug-2017 : Add ocean forcing export fields     ( version 6.03 )
    !/
    !  1. Purpose :
    !
    !     Set export fields from internal data structures
    !
    !  2. Method :
    !
    !  3. Parameters :
    !
    !     Parameter list
    !     ----------------------------------------------------------------
    !       gcomp     Type   I/O Gridded component
    !       rc        Int.   O   Return code
    !     ----------------------------------------------------------------
    !
    !  4. Subroutines used :
    !
    !      Name      Type  Module   Description
    !     ----------------------------------------------------------------
    !      NONE
    !     ----------------------------------------------------------------
    !
    !  5. Called by :
    !
    !  6. Error messages :
    !
    !  7. Remarks :
    !
    !  8. Structure :
    !
    !  9. Switches :
    !
    ! 10. Source code :
    !
    !/ ------------------------------------------------------------------- /
    !/
    !/ ------------------------------------------------------------------- /
    !/ Parameter list
    !/
    implicit none
    type(ESMF_GridComp) :: gcomp
    integer,intent(out) :: rc
    !/
    !/ ------------------------------------------------------------------- /
    !/ Local parameters
    !/
    character(ESMF_MAXSTR) :: cname
    integer, parameter :: iwt=8
    real(8) :: wstime, wftime
    integer :: i1, i2, i3, i4, i5, i6
    logical :: flpart = .false., floutg = .false., floutg2 = .true.
#if defined(TEST_WMESMFMD) || defined(TEST_WMESMFMD_SETEXPORT)
    type(ESMF_State) :: dumpState
    integer, save :: timeSlice = 1
#endif
    real(ESMF_KIND_R8), pointer :: farrayptr(:,:)
    !
    ! -------------------------------------------------------------------- /
    ! Prep
    !
    rc = esmf_success
    if ( noactiveexpfields ) return
    call esmf_vmwtime(wstime)
    call esmf_gridcompget(gcomp, name=cname, rc=rc)
    if (esmf_logfounderror(rc, passthru)) return
    if (verbosity.gt.0) call esmf_logwrite(trim(cname)// &
         ': entered SetExport', esmf_logmsg_info)
    !
    ! -------------------------------------------------------------------- /
    ! Setup
    !
    call w3setg ( expgridid, mdse, mdst )
    call w3setw ( expgridid, mdse, mdst )
    call w3seta ( expgridid, mdse, mdst )
    call w3seti ( expgridid, mdse, mdst )
    call w3seto ( expgridid, mdse, mdst )
    call wmsetm ( expgridid, mdse, mdst )
#ifdef USE_W3OUTG_FOR_EXPORT
    if ( natgridislocal ) call w3outg( va, flpart, floutg, floutg2 )
#endif
    !
    ! -------------------------------------------------------------------- /
    ! Charnock
    !
    i1 = fieldindex( expfieldname, 'charno', rc )
    if (esmf_logfounderror(rc, passthru)) return
    if ( expfieldactive(i1) ) then
      call calccharnk( expfield(i1), rc )
      if (esmf_logfounderror(rc, passthru)) return
    endif
    !
    ! -------------------------------------------------------------------- /
    ! Surface Roughness
    !
    i1 = fieldindex( expfieldname, 'z0rlen', rc )
    if (esmf_logfounderror(rc, passthru)) return
    if ( expfieldactive(i1) ) then
      call calcroughl( expfield(i1), rc )
      if (esmf_logfounderror(rc, passthru)) return
    endif
    !
    ! -------------------------------------------------------------------- /
    ! Stokes Drift 3D
    !
    i1 = fieldindex( expfieldname, 'uscurr', rc )
    if (esmf_logfounderror(rc, passthru)) return
    i2 = fieldindex( expfieldname, 'vscurr', rc )
    if (esmf_logfounderror(rc, passthru)) return
    if ( expfieldactive(i1) .and. &
         expfieldactive(i2) ) then
      call calcstokes3d( va, expfield(i1), expfield(i2), rc )
      if (esmf_logfounderror(rc, passthru)) return
    endif
    !
    ! -------------------------------------------------------------------- /
    ! Partitioned Stokes Drift 3 2D fields
    !
    i1 = fieldindex( expfieldname, 'x1pstk', rc )
    if (esmf_logfounderror(rc, passthru)) return
    i2 = fieldindex( expfieldname, 'y1pstk', rc )
    if (esmf_logfounderror(rc, passthru)) return
    i3 = fieldindex( expfieldname, 'x2pstk', rc )
    if (esmf_logfounderror(rc, passthru)) return
    i4 = fieldindex( expfieldname, 'y2pstk', rc )
    if (esmf_logfounderror(rc, passthru)) return
    i5 = fieldindex( expfieldname, 'x3pstk', rc )
    if (esmf_logfounderror(rc, passthru)) return
    i6 = fieldindex( expfieldname, 'y3pstk', rc )
    if (esmf_logfounderror(rc, passthru)) return
    if ( expfieldactive(i1) .and. &
         expfieldactive(i2) .and. &
         expfieldactive(i3) .and. &
         expfieldactive(i4) .and. &
         expfieldactive(i5) .and. &
         expfieldactive(i6)  ) then
      call calcpstokes( va, expfield(i1), expfield(i2), expfield(i3), &
           expfield(i4), expfield(i5), expfield(i6), rc )
      if (esmf_logfounderror(rc, passthru)) return
    endif
    !
    ! -------------------------------------------------------------------- /
    ! Bottom Currents
    !
    i1 = fieldindex( expfieldname, 'wbcuru', rc )
    if (esmf_logfounderror(rc, passthru)) return
    i2 = fieldindex( expfieldname, 'wbcurv', rc )
    if (esmf_logfounderror(rc, passthru)) return
    i3 = fieldindex( expfieldname, 'wbcurp', rc )
    if (esmf_logfounderror(rc, passthru)) return
    if ( expfieldactive(i1) .and. &
         expfieldactive(i2) .and. &
         expfieldactive(i3) ) then
      call calcbotcur( va, expfield(i1), expfield(i2), expfield(i3), rc )
      if (esmf_logfounderror(rc, passthru)) return
    endif
    !
    ! -------------------------------------------------------------------- /
    ! Radiation stresses 2D
    !
    i1 = fieldindex( expfieldname, 'wavsuu', rc )
    if (esmf_logfounderror(rc, passthru)) return
    i2 = fieldindex( expfieldname, 'wavsuv', rc )
    if (esmf_logfounderror(rc, passthru)) return
    i3 = fieldindex( expfieldname, 'wavsvv', rc )
    if (esmf_logfounderror(rc, passthru)) return
    if ( expfieldactive(i1) .and. &
         expfieldactive(i2) .and. &
         expfieldactive(i3) ) then
      call calcradstr2d( va, expfield(i1), expfield(i2), expfield(i3), rc )
      if (esmf_logfounderror(rc, passthru)) return
    endif
    !
    ! -------------------------------------------------------------------- /
    ! cpl_scalars - grid sizes
    !
    if (med_present) then
      i1 = fieldindex( expfieldname, trim(flds_scalar_name), rc=rc )
      if (esmf_logfounderror(rc, passthru)) return
      if ( expfieldactive(i1) ) then
        call esmf_fieldget(expfield(i1), farrayptr=farrayptr, rc=rc)
        if (esmf_logfounderror(rc, passthru)) return
        if (flds_scalar_index_nx > 0 .and. flds_scalar_index_nx < flds_scalar_num) then
          farrayptr(flds_scalar_index_nx,1) = dble(nx)
        endif
        if (flds_scalar_index_ny > 0 .and. flds_scalar_index_ny < flds_scalar_num) then
          farrayptr(flds_scalar_index_ny,1) = dble(ny)
        endif
      endif
    endif
    !
    ! -------------------------------------------------------------------- /
    ! Post
    !
#if defined(TEST_WMESMFMD) || defined(TEST_WMESMFMD_SETEXPORT)
    call nuopc_modelget(gcomp, exportstate=dumpstate, rc=rc)
    if (esmf_logfounderror(rc, passthru)) return
    call nuopc_write(dumpstate, overwrite=.true., &
         filenameprefix="field_"//trim(cname)//"_export_", &
         timeslice=timeslice, relaxedflag=.true., rc=rc)
    if (esmf_logfounderror(rc, passthru)) return
    timeslice = timeslice + 1
#endif
    rc = esmf_success
    call esmf_vmwtime(wftime)
    wtime(iwt) = wtime(iwt) + wftime - wstime
    wtcnt(iwt) = wtcnt(iwt) + 1
    if (verbosity.gt.0) call esmf_logwrite(trim(cname)// &
         ': leaving SetExport', esmf_logmsg_info)
    !/
    !/ End of SetExport -------------------------------------------------- /
    !/

References file(), constants::lpdlib, w3odatmd::naproc, wmmdatmd::nmproc, w3gdatmd::ntri, w3gdatmd::nx, w3gdatmd::ny, and w3gdatmd::trigp.

setservices()

subroutine, public wmesmfmd::setservices	(	type(esmf_gridcomp)	gcomp,
		integer, intent(out)	rc
	)

Wave model ESMF set services.

Parameters

	gcomp	Gridded component.
[out]	rc	Return code.

Author

T. J. Campbell

Date

20-Jan-2017

Definition at line 352 of file wmesmfmd.F90.

    !/
    !/                  +-----------------------------------+
    !/                  | WAVEWATCH III           NOAA/NCEP |
    !/                  |        T. J. Campbell, NRL        |
    !/                  |                        FORTRAN 90 |
    !/                  | Last update :         20-Jan-2017 |
    !/                  +-----------------------------------+
    !/
    !/    20-Jan-2017 : Origination.                        ( version 6.02 )
    !/
    !  1. Purpose :
    !
    !     Wave model ESMF set services.
    !
    !  2. Method :
    !
    !  3. Parameters :
    !
    !     Parameter list
    !     ----------------------------------------------------------------
    !       gcomp   Type   I/O Gridded component
    !       rc      Int.   O   Return code
    !     ----------------------------------------------------------------
    !
    !  4. Subroutines used :
    !
    !      Name            Type   Module    Description
    !     ----------------------------------------------------------------
    !      InitializeP0    Subr.  WMESMFMD  Wave model NUOPC/ESMF Initialize phase 0
    !      InitializeP1    Subr.  WMESMFMD  Wave model NUOPC/ESMF Initialize phase 1
    !      InitializeP3    Subr.  WMESMFMD  Wave model NUOPC/ESMF Initialize phase 3
    !      Finalize        Subr.  WMESMFMD  Wave model NUOPC/ESMF Finalize
    !      DataInitialize  Subr.  WMESMFMD  Wave model NUOPC/ESMF Data Initialize
    !      ModelAdvance    Subr.  WMESMFMD  Wave model NUOPC/ESMF Model Advance
    !     ----------------------------------------------------------------
    !
    !  5. Called by :
    !
    !  6. Error messages :
    !
    !  7. Remarks :
    !
    !  8. Structure :
    !
    !  9. Switches :
    !
    ! 10. Source code :
    !
    !/ ------------------------------------------------------------------- /
    !/
    !/ ------------------------------------------------------------------- /
    !/ Parameter list
    !/
    implicit none
    type(ESMF_GridComp) :: gcomp
    integer,intent(out) :: rc
    !/
    !/ ------------------------------------------------------------------- /
    !/ Local parameters
    !/
    !NONE
    !
    ! -------------------------------------------------------------------- /
    ! Prep
    !
    rc = esmf_success
 
    ! --- Initialize wallclock timers
 
    wtnam( 1) = 'InitializeP0'
    wtnam( 2) = 'InitializeP1'
    wtnam( 3) = 'InitializeP3'
    wtnam( 4) = 'DataInitialize'
    wtnam( 5) = 'ModelAdvance'
    wtnam( 6) = 'Finalize'
    wtnam( 7) = 'GetImport'
    wtnam( 8) = 'SetExport'
    wtnam( 9) = 'FieldGather'
    wtnam(10) = 'FieldFill'
    wtcnt( :) = 0
    wtime( :) = 0d0
    !
    ! -------------------------------------------------------------------- /
    ! 1.  NUOPC model component will register the generic methods
    !
    call nuopc_compderive(gcomp, parent_setservices, rc=rc)
    if (esmf_logfounderror(rc, passthru)) return
    !
    ! -------------------------------------------------------------------- /
    ! 2.  Set model entry points
    !
    ! --- Initialize - phase 0 (requires use of ESMF method)
 
    call esmf_gridcompsetentrypoint(gcomp, esmf_method_initialize, &
         userroutine=initializep0, phase=0, rc=rc)
    if (esmf_logfounderror(rc, passthru)) return
 
    ! --- Set entry points for initialize methods
 
    ! >= IPDv03 supports satisfying inter-model data dependencies and
    ! the transfer of ESMF Grid & Mesh objects between Model and/or
    ! Mediator components during initialization
    ! IPDv03p1: advertise import & export fields
    call nuopc_compsetentrypoint(gcomp, esmf_method_initialize, &
         phaselabellist=(/"IPDv03p1"/), userroutine=initializep1, rc=rc)
    if (esmf_logfounderror(rc, passthru)) return
    ! IPDv03p2: unspecified by NUOPC -- not required
    ! IPDv03p3: realize import & export fields
    call nuopc_compsetentrypoint(gcomp, esmf_method_initialize, &
         phaselabellist=(/"IPDv03p3"/), userroutine=initializep3, rc=rc)
    if (esmf_logfounderror(rc, passthru)) return
    ! IPDv03p4: relevant for TransferActionGeomObject=="accept"
    ! IPDv03p5: relevant for TransferActionGeomObject=="accept"
    ! IPDv03p6: check compatibility of fields connected status
    ! IPDv03p7: handle field data initialization
 
    !
    ! -------------------------------------------------------------------- /
    ! 3.  Register specializing methods
    !
    ! --- Model initialize export data method
 
    call nuopc_compspecialize(gcomp, speclabel=label_datainitialize, &
         specroutine=datainitialize, rc=rc)
    if (esmf_logfounderror(rc, passthru)) return
 
    ! --- Model checkImport method (overriding default)
 
    call esmf_methodremove(gcomp, label_checkimport, rc=rc)
    if (esmf_logfounderror(rc, passthru)) return
    call nuopc_compspecialize(gcomp, speclabel=label_checkimport, &
         specroutine=nuopc_noop, rc=rc)
    if (esmf_logfounderror(rc, passthru)) return
 
    ! --- Model advance method
 
    call nuopc_compspecialize(gcomp, speclabel=label_advance, &
         specroutine=modeladvance, rc=rc)
    if (esmf_logfounderror(rc, passthru)) return
 
    ! --- Model finalize method
 
    call nuopc_compspecialize(gcomp, speclabel=label_finalize, &
         specroutine=finalize, rc=rc)
    if (esmf_logfounderror(rc, passthru)) return
    !
    ! -------------------------------------------------------------------- /
    ! Post
    !
    rc = esmf_success
    !/
    !/ End of SetServices ------------------------------------------------ /
    !/

References wmmdatmd::etime, w3gdatmd::grids, wmmdatmd::improc, constants::is_esmf_component, wmmdatmd::nmproc, wmmdatmd::nmpscr, wmmdatmd::stime, w3wdatmd::time, w3adatmd::us3d, and w3iogomd::w3outg().

setupimpbmsk()

subroutine wmesmfmd::setupimpbmsk	(	type(esmf_field)	bmskField,
		type(esmf_field)	impField,
		real(esmf_kind_rx)	missingVal,
		integer, optional	rc
	)

Setup background blending mask field for an import field.

Parameters

bmskField	Blending mask field
impField	Import field
missingVal	Missing value
rc	Return code

Author

T. J. Campbell

Date

09-Aug-2017

Definition at line 5074 of file wmesmfmd.F90.

    !/
    !/                  +-----------------------------------+
    !/                  | WAVEWATCH III           NOAA/NCEP |
    !/                  |        T. J. Campbell, NRL        |
    !/                  |                        FORTRAN 90 |
    !/                  | Last update :         09-Aug-2017 |
    !/                  +-----------------------------------+
    !/
    !/    09-Aug-2017 : Origination.                        ( version 6.03 )
    !/
    !  1. Purpose :
    !
    !     Setup background blending mask field for an import field
    !
    !  2. Method :
    !
    !  3. Parameters :
    !
    !     Parameter list
    !     ----------------------------------------------------------------
    !       bmskField  Type   I/O blending mask field
    !       impField   Type   I   import field
    !       missingVal Real   I   missing value
    !       rc         Int    O   Return code
    !     ----------------------------------------------------------------
    !
    !  4. Subroutines used :
    !
    !      Name      Type  Module   Description
    !     ----------------------------------------------------------------
    !      NONE
    !     ----------------------------------------------------------------
    !
    !  5. Called by :
    !
    !  6. Error messages :
    !
    !  7. Remarks :
    !
    !  8. Structure :
    !
    !  9. Switches :
    !
    ! 10. Source code :
    !
    !/ ------------------------------------------------------------------- /
    !/
    !/ ------------------------------------------------------------------- /
    !/ Parameter list
    !/
    implicit none
    type(ESMF_Field)      :: bmskField
    type(ESMF_Field)      :: impField
    real(ESMF_KIND_RX)    :: missingVal
    integer, optional     :: rc
    !/
    !/ ------------------------------------------------------------------- /
    !/ Local parameters
    !/
    real(ESMF_KIND_RX), parameter :: zero = 0.0
    real(ESMF_KIND_RX), parameter :: half = 0.5
    real(ESMF_KIND_RX), parameter ::  one = 1.0
    integer, parameter :: nsig = imphalowidth-1
    integer, parameter :: niter = 10
    integer, parameter :: iter0 = 1-niter
    integer, parameter :: lde = 0
    integer :: iter, i, j, ii, jj, k, l
    integer :: elb(2), eub(2)
    integer :: tlb(2), tub(2)
    real(ESMF_KIND_RX), pointer :: mptr(:,:), dptr(:,:)
    type(ESMF_Field) :: cmskField
    real(ESMF_KIND_RX), pointer :: bmsk(:,:), cmsk(:,:)
    real(ESMF_KIND_RX) :: bsum, wsum
    real(ESMF_KIND_RX) :: wflt(-nsig:nsig,-nsig:nsig)
    character(ESMF_MAXSTR) :: fnm
#if defined(TEST_WMESMFMD) || defined(TEST_WMESMFMD_SETUPIMPBMSK)
    integer :: timeSlice
#endif
    !
    ! -------------------------------------------------------------------- /
    ! Initialize filter
    !
    if (present(rc)) rc = esmf_success
 
    do l = -nsig,nsig
      do k = -nsig,nsig
        wflt(k,l) = exp( -half*( real(k,esmf_kind_rx)**2 &
             + real(l,esmf_kind_rx)**2 ) )
      enddo
    enddo
    !
    ! -------------------------------------------------------------------- /
    ! Set up fields and pointers
    !
    call esmf_fieldget( impfield, name=fnm, rc=rc )
    if (esmf_logfounderror(rc, passthru)) return
 
    cmskfield = esmf_fieldcreate( impgrid, imparrayspec2d, &
         totallwidth=imphalolwidth, totaluwidth=imphalouwidth, &
         staggerloc=impstaggerloc, indexflag=impindexflag, rc=rc )
    if (esmf_logfounderror(rc, passthru)) return
 
    if ( impgridislocal ) then
      call esmf_fieldget( impmask, localde=lde, farrayptr=mptr, &
           exclusivelbound=elb, exclusiveubound=eub, &
           totallbound=tlb, totalubound=tub, rc=rc )
      if (esmf_logfounderror(rc, passthru)) return
      call esmf_fieldget( impfield,  localde=lde, farrayptr=dptr, rc=rc )
      if (esmf_logfounderror(rc, passthru)) return
      call esmf_fieldget( bmskfield, localde=lde, farrayptr=bmsk, rc=rc )
      if (esmf_logfounderror(rc, passthru)) return
      call esmf_fieldget( cmskfield, localde=lde, farrayptr=cmsk, rc=rc )
      if (esmf_logfounderror(rc, passthru)) return
    endif
    !
    ! -------------------------------------------------------------------- /
    ! Create blending mask
    !
    if ( impgridislocal ) then
      do j = elb(2),eub(2)
        do i = elb(1),eub(1)
          if ( nint(dptr(i,j)).eq.nint(missingval) ) then
            bmsk(i,j) = zero
          else
            bmsk(i,j) = one
          endif
          cmsk(i,j) = bmsk(i,j)
        enddo
      enddo
    endif
#if defined(TEST_WMESMFMD) || defined(TEST_WMESMFMD_SETUPIMPBMSK)
    timeslice = 1
    call esmf_fieldwrite( bmskfield, &
         "wmesmfmd_setupimpbmsk_"//trim(fnm)//".nc", &
         overwrite=.true., timeslice=timeslice, rc=rc )
    if (esmf_logfounderror(rc, passthru)) return
#endif
 
    iter_loop: do iter = iter0,niter
 
      call esmf_fieldhalo( bmskfield, imphalorh, rc=rc )
      if (esmf_logfounderror(rc, passthru)) return
 
      if ( impgridislocal ) then
 
        j_loop: do j = elb(2),eub(2)
          i_loop: do i = elb(1),eub(1)
            if ( nint(mptr(i,j)).eq.maskvalueland ) cycle i_loop
            if ( nint(dptr(i,j)).eq.nint(missingval) ) cycle i_loop
 
            if (iter.le.0) then
 
              ! initialize blending zone to zero
              l_loop0: do l = -1,1
                jj = j + l
                if ( jj.lt.tlb(2).or.jj.gt.tub(2) ) cycle l_loop0
                k_loop0: do k = -1,1
                  ii = i + k
                  if ( ii.lt.tlb(1).or.ii.gt.tub(1) ) cycle k_loop0
                  if ( nint(mptr(ii,jj)).eq.maskvalueland ) cycle k_loop0
                  if ( bmsk(ii,jj).eq.zero ) cmsk(i,j) = zero
                enddo k_loop0
              enddo l_loop0
 
            else
 
              ! iterate filter over blending zone
              bsum = zero
              wsum = zero
              l_loop: do l = -nsig,nsig
                jj = j + l
                if ( jj.lt.tlb(2).or.jj.gt.tub(2) ) cycle l_loop
                k_loop: do k = -nsig,nsig
                  ii = i + k
                  if ( ii.lt.tlb(1).or.ii.gt.tub(1) ) cycle k_loop
                  if ( nint(mptr(ii,jj)).eq.maskvalueland ) cycle k_loop
                  bsum = bsum + wflt(k,l)*bmsk(ii,jj)
                  wsum = wsum + wflt(k,l)
                enddo k_loop
              enddo l_loop
              if ( wsum.gt.zero ) cmsk(i,j) = bsum/wsum
 
            endif
 
          enddo i_loop
        enddo j_loop
 
        do j = elb(2),eub(2)
          do i = elb(1),eub(1)
            if ( nint(mptr(i,j)).eq.maskvalueland ) cycle
            bmsk(i,j) = cmsk(i,j)
          enddo
        enddo
 
      endif
#if defined(TEST_WMESMFMD) || defined(TEST_WMESMFMD_SETUPIMPBMSK)
      timeslice = timeslice + 1
      call esmf_fieldwrite( bmskfield, &
           "wmesmfmd_setupimpbmsk_"//trim(fnm)//".nc", &
           overwrite=.true., timeslice=timeslice, rc=rc )
      if (esmf_logfounderror(rc, passthru)) return
#endif
 
    enddo iter_loop
    !
    ! -------------------------------------------------------------------- /
    ! Clean up
    !
    call esmf_fielddestroy( cmskfield, rc=rc )
    if (esmf_logfounderror(rc, passthru)) return
    !/
    !/ End of SetupImpBmsk ----------------------------------------------- /
    !/

References w3gdatmd::clgtype, w3gdatmd::gtype, yownodepool::iplg, constants::lpdlib, yownodepool::np, yowrankmodule::rank, w3gdatmd::rlgtype, and w3gdatmd::ungtype.