#define ESMF_CHECK if (ESMF_LogFoundError(rcToCheck=rc, line=__LINE__, file=__FILE__)) call ESMF_Finalize(endflag=ESMF_END_ABORT) ! $Id: InjectorMod.F90,v 1.14 2011/06/30 05:58:24 theurich Exp $ ! !------------------------------------------------------------------------- !BOP ! \subsection{XBeach Component} ! ! !DESCRIPTION: ! This is a user-supplied xbeach component which interacts ! with the beach. It transform waves into morphological change ! near the coast. ! ! !EOP module XBeachMod ! ESMF module use ESMF use libxbeach_module use introspection_module implicit none private ! Private data block (This could be s and par) I'm now using pointers ! C pointers because I made a c compatible api for XBeach so I can use it in other languages ! F pointers because I need to convert c pointers to fortran pointers ! fortran arrays because sometimes we want to copy the value so we don't overwrite old values type beachdata ! Some local data here.... real(c_double), pointer :: zbfarray_f_ptr(:,:) real(c_double), pointer :: dzbdtfarray_f_ptr(:,:) real(c_double), pointer :: dzbfarray_f_ptr(:,:) real(c_double), pointer :: zsfarray_f_ptr(:,:) integer(c_int), pointer :: wetzfarray_f_ptr(:,:) real(c_double), allocatable :: zbfarray(:,:) real(c_double), allocatable :: dzbdtfarray(:,:) real(c_double), allocatable :: dzbfarray(:,:) real(c_double), allocatable :: zsfarray(:,:) integer(c_int), allocatable :: wetzfarray(:,:) type(c_ptr) :: zbfarray_c_ptr type(c_ptr) :: dzbdtfarray_c_ptr type(c_ptr) :: dzbfarray_c_ptr type(c_ptr) :: zsfarray_c_ptr type(c_ptr) :: wetzfarray_c_ptr end type beachdata type wrapper type(beachdata), pointer :: ptr end type wrapper ! External entry point which will register the Init, Run, and Finalize ! routines for this Component. public XBeach_register contains !------------------------------------------------------------------------------ !------------------------------------------------------------------------------ !BOPI ! !IROUTINE: xbeach_register - Set the Init, Run, Final routines ! !INTERFACE: subroutine XBeach_register(comp, rc) ! ! !ARGUMENTS: type(ESMF_GridComp) :: comp integer, intent(out) :: rc ! ! !DESCRIPTION: ! User-written registration routine. This is the ! only public entry point for this Component. When this is called by ! a higher level component it will register with the Framework the ! subroutines to be called when the Framework needs to Initialize, ! Run, or Finalize this Component. ! ! The arguments are: ! \begin{description} ! \item[comp] ! A Gridded Component. ! \item[rc] ! Return code; equals {\tt ESMF\_SUCCESS} if there are no errors, ! {\tt ESMF\_FAILURE} othewise. ! \end{description} ! !EOPI ! local variables type(beachdata), pointer :: data type(wrapper) :: wrap ! print *, "Registering XBeach" ! Register the callback routines. ! ! This Component has a 1 phase initialization, and a single ! phase run and finalize. call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_INITIALIZE, userRoutine=xbeach_init, rc=rc) if(rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT, rc=rc) call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_RUN, userRoutine=xbeach_run, rc=rc) if(rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT, rc=rc) call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_FINALIZE, userRoutine=xbeach_final, rc=rc) if(rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT, rc=rc) ! print *, "XBeach module: Registered Initialize, Run, and Finalize routines" ! Allocate private persistent space allocate(data) wrap%ptr => data call ESMF_GridCompSetInternalState(comp, wrap, rc) if(rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT, rc=rc) ! print *, "XBeach module: registered Private Data block for Internal State" end subroutine XBeach_register !------------------------------------------------------------------------------ !BOPI ! !IROUTINE: User Initialization routine ! !INTERFACE: subroutine xbeach_init(comp, importState, exportState, clock, rc) ! ! !ARGUMENTS: type(ESMF_GridComp) :: comp type(ESMF_State) :: importState, exportState type(ESMF_Clock) :: clock integer, intent(out) :: rc type(ESMF_Grid) :: grid type(ESMF_DistGrid) :: distgrid ! For mpi type(ESMF_Field) :: zbimportfield, zbexportfield, dzbimportfield,dzbexportfield, & zsexportfield, wetzexportfield type(ESMF_Array) :: zbarray, dzbarray integer :: nx, ny, index real(c_double) :: xori, yori, alfa type(c_ptr) :: xfarray_c_ptr type(c_ptr) :: yfarray_c_ptr real(c_double), pointer :: xfarray_f_ptr(:,:), yfarray_f_ptr(:,:), dzbfarray_f_ptr(:,:), & zbfarray_f_ptr(:,:), zsfarray_f_ptr(:,:) integer(c_int), pointer :: wetzfarray_f_ptr(:,:) real(c_double), allocatable :: xfarray(:,:), yfarray(:,:) real(ESMF_KIND_r8), pointer :: coordX(:,:), coordY(:,:) integer :: ubnd(2), lbnd(2) type(arraytype) :: array type(wrapper) :: wrap type(beachdata), pointer :: data ! ! !DESCRIPTION: ! User-supplied Initialization routine. Sets up data space, ! and marks which Fields in the export state can be produced ! by this Component. The Coupler will mark which Fields are ! needed by whatever other Component(s) are coupled with this ! Component. The second phase of the Init process will place ! the actual Field data in the export state. ! ! The arguments are: ! \begin{description} ! \item[comp] ! A Gridded Component. ! \item[importState] ! State containing the import list. ! \item[exportState] ! State containing the export list. ! \item[clock] ! Clock describing the external time. ! \item[rc] ! Return code; equals {\tt ESMF\_SUCCESS} if there are no errors. ! \end{description} ! !EOPI call ESMF_GridCompGetInternalState(comp, wrap, rc) if(rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT, rc=rc) data => wrap%ptr rc = init() ! print *, "XBeach module: initializing <--- we should have a grid now" rc = getintparameter('nx', nx) rc = getintparameter('ny', ny) ! Get the grid spacing.... rc = getdoubleparameter('xori', xori) rc = getdoubleparameter('yori', yori) rc = getdoubleparameter('alfa', alfa) ! Get the c_ptr to the x array allocate(xfarray(nx+1, ny+1)) rc = get2ddoublearray('x', xfarray) ! Calling this overwrites the old xfarray_c_ptr allocate(yfarray(nx+1, ny+1)) rc = get2ddoublearray('y', yfarray) ! XBeach grid grid=ESMF_GridCreateNoPeriDim(maxIndex=(/nx+1,ny+1/), & coordSys=ESMF_COORDSYS_CART, & ! Cartesian coordinates (x,y not lat,lon) coordDep1=(/1,2/), coordDep2=(/1,2/), & ! Use coordDep1=(/1,2/),coordDep2=(/1,2/) for curvilinear grids. indexflag=ESMF_INDEX_GLOBAL, & ! Needed for using XGrid name="Beach grid", rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & call ESMF_Finalize(endflag=ESMF_END_ABORT) ! Allocate coordinates (Assume center locations for staggering of bathymetry) call ESMF_GridAddCoord(grid, & staggerloc=ESMF_STAGGERLOC_CENTER, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & call ESMF_Finalize(endflag=ESMF_END_ABORT) ! Get the local grid coordinates for X call ESMF_GridGetCoord(grid, coordDim=1, localDE=0, & staggerloc=ESMF_STAGGERLOC_CENTER, & computationalLBound=lbnd, computationalUBound=ubnd, & farrayPtr=coordX, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & call ESMF_Finalize(endflag=ESMF_END_ABORT) ! Ignore rotation for now coordX = xfarray + xori ! Get the local grid coordinates for X call ESMF_GridGetCoord(grid, coordDim=2, localDE=0, & staggerloc=ESMF_STAGGERLOC_CENTER, & computationalLBound=lbnd, computationalUBound=ubnd, & farrayPtr=coordY, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & call ESMF_Finalize(endflag=ESMF_END_ABORT) coordY = yfarray + yori !BOE ! Set the Beach Grid in the Beach Component !BOC call ESMF_GridCompSet(comp, grid=grid, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & call ESMF_Finalize(endflag=ESMF_END_ABORT) allocate(data%zbfarray(nx+1, ny+1)) rc = get2ddoublearray('zb', data%zbfarray) ! Only allocate because we don't have a t yet allocate(data%dzbfarray(nx+1, ny+1)) data%dzbfarray = 0 allocate(data%zsfarray(nx+1, ny+1)) data%zsfarray = 0 allocate(data%wetzfarray(nx+1, ny+1)) data%wetzfarray = 0 rc = ESMF_SUCCESS ! call ESMF_GridCompPrint(comp, rc=rc) ! Get the distgrid, required to build the array call ESMF_GridGet(grid=grid, staggerloc=ESMF_STAGGERLOC_CENTER, distgrid=distgrid, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & call ESMF_Finalize(endflag=ESMF_END_ABORT) ! Create a field bundle with the zb array zbimportfield = ESMF_FieldCreate(grid=grid, & typekind=ESMF_TYPEKIND_r8, & staggerloc=ESMF_STAGGERLOC_CENTER, & indexflag=ESMF_INDEX_GLOBAL, & name="zbimport", rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & call ESMF_Finalize(endflag=ESMF_END_ABORT) call ESMF_FieldGet(zbimportfield, localDe=0, farrayPtr=zbfarray_f_ptr, & rc=rc) !totalLBound=ftlb, totalUBound=ftub, totalCount=ftc, zbfarray_f_ptr = 0.0d0 ESMF_CHECK ! Create a field bundle with the dzb array dzbimportfield = ESMF_FieldCreate(grid=grid, & typekind=ESMF_TYPEKIND_r8, & staggerloc=ESMF_STAGGERLOC_CENTER, & indexflag=ESMF_INDEX_GLOBAL, & name="dzbimport", rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & call ESMF_Finalize(endflag=ESMF_END_ABORT) call ESMF_FieldGet(zbimportfield, localDe=0, farrayPtr=dzbfarray_f_ptr, & rc=rc) !totalLBound=ftlb, totalUBound=ftub, totalCount=ftc, dzbfarray_f_ptr = 0.0d0 ESMF_CHECK ! Create a field bundle with the zb array zbexportfield = ESMF_FieldCreate(grid=grid, & typekind=ESMF_TYPEKIND_r8, & staggerloc=ESMF_STAGGERLOC_CENTER, & indexflag=ESMF_INDEX_GLOBAL, & name="zbexport", rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & call ESMF_Finalize(endflag=ESMF_END_ABORT) call ESMF_FieldGet(zbexportfield, farrayPtr=zbfarray_f_ptr, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & call ESMF_Finalize(endflag=ESMF_END_ABORT) rc = get2ddoublearray('zb', zbfarray_f_ptr) ! Create a field bundle with the dzb array dzbexportfield = ESMF_FieldCreate(grid=grid, & typekind=ESMF_TYPEKIND_r8, & staggerloc=ESMF_STAGGERLOC_CENTER, & indexflag=ESMF_INDEX_GLOBAL, & name="dzbexport", rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & call ESMF_Finalize(endflag=ESMF_END_ABORT) call ESMF_FieldGet(dzbexportfield, farrayPtr=dzbfarray_f_ptr, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & call ESMF_Finalize(endflag=ESMF_END_ABORT) dzbfarray_f_ptr = data%dzbfarray ! Create a field bundle with the zs array zsexportfield = ESMF_FieldCreate(grid=grid, & typekind=ESMF_TYPEKIND_r8, & staggerloc=ESMF_STAGGERLOC_CENTER, & indexflag=ESMF_INDEX_GLOBAL, & name="zsexport", rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & call ESMF_Finalize(endflag=ESMF_END_ABORT) call ESMF_FieldGet(zsexportfield, farrayPtr=zsfarray_f_ptr, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & call ESMF_Finalize(endflag=ESMF_END_ABORT) zsfarray_f_ptr = data%zsfarray ! Create a field bundle with the wetz array wetzexportfield = ESMF_FieldCreate(grid=grid, & typekind=ESMF_TYPEKIND_i4, & staggerloc=ESMF_STAGGERLOC_CENTER, & indexflag=ESMF_INDEX_GLOBAL, & name="wetzexport", rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & call ESMF_Finalize(endflag=ESMF_END_ABORT) call ESMF_FieldGet(wetzexportfield, farrayPtr=wetzfarray_f_ptr, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & call ESMF_Finalize(endflag=ESMF_END_ABORT) wetzfarray_f_ptr = data%wetzfarray ! Add the same field bundle to the import state (not sure if I should make new fields). call ESMF_StateAdd(importstate, (/dzbimportfield, zbimportfield/), rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & call ESMF_Finalize(endflag=ESMF_END_ABORT) ! Add the field bundle to the epxort state call ESMF_StateAdd(exportstate, (/dzbexportfield, zbexportfield,zsexportfield,wetzexportfield/), rc=rc)!, wetzexportfield if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & call ESMF_Finalize(endflag=ESMF_END_ABORT) ! Allocate private persistent space (store arrays that are passed to dune in data so they can persist through run and be cleaned in finalize) wrap%ptr => data call ESMF_GridCompSetInternalState(comp, wrap, rc) if(rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT, rc=rc) end subroutine xbeach_init !------------------------------------------------------------------------------ !BOPI ! !IROUTINE: xbeach_run - xbeach run routine ! !INTERFACE: subroutine xbeach_run(comp, importState, exportState, clock, rc) ! ! !ARGUMENTS: type(ESMF_GridComp) :: comp type(ESMF_State) :: importState, exportState integer, intent(out) :: rc type(ESMF_Field) :: zbimportfield, zbexportfield, dzbimportfield ,dzbexportfield, & zsexportfield, wetzexportfield real(c_double), pointer :: xfarray_f_ptr(:,:), yfarray_f_ptr(:,:), dzbfarray_f_ptr(:,:), & dzbdtfarray_f_ptr(:,:), zbfarray_f_ptr(:,:), zsfarray_f_ptr(:,:) integer, pointer :: wetzfarray_f_ptr(:,:) type(c_ptr) :: dzbdtfarray_c_ptr real(c_double), allocatable, target :: dzbfarray(:,:), dzbdtfarray(:,:), zbfarray(:,:), & zsfarray(:,:) integer(c_int), allocatable, target :: wetzfarray(:,:) type(ESMF_Clock) :: clock type(ESMF_TimeInterval) :: timeinterval real*8 :: step, tesmf, txbeach, t, tnext, told, morfac integer :: morfacopt type(wrapper) :: wrap type(beachdata), pointer :: data integer :: nx, ny, index ! ! !DESCRIPTION: ! User-supplied Run routine. Gets the new bathymetry from the import state ! Sets the computed bathymetry into the exportState ! ! The arguments are: ! \begin{description} ! \item[comp] ! A Gridded Component. ! \item[importState] ! State containing the import list. ! \item[exportState] ! State containing the export list. ! \item[clock] ! Clock describing the external time. ! \item[rc] ! Return code; equals {\tt ESMF\_SUCCESS} if there are no errors, ! otherwise {\tt ESMF\_FAILURE}. ! \end{description} ! !EOPI rc = ESMF_SUCCESS call ESMF_GridCompGetInternalState(comp, wrap, rc) if(rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT, rc=rc) data => wrap%ptr ! Get the simulation time (since tref) from esmf call ESMF_ClockGet(clock, currSimTime=timeinterval, rc=rc) call ESMF_TimeIntervalGet(timeinterval, s_r8=tesmf, rc=rc) ! Get the simulation time (tref=0) from XBeach rc = getdoubleparameter('t', txbeach) ! Get the timestep from esmf, the coupled timestep call ESMF_ClockGet(clock, timestep=timeinterval, rc=rc) call ESMF_TimeIntervalGet(timeinterval, s_r8=step, rc=rc) ! Compute zb0 rc = getintparameter('nx', nx) rc = getintparameter('ny', ny) ! Process imports call ESMF_StateGet(importstate, "dzbimport" , field=dzbimportfield, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & call ESMF_Finalize(endflag=ESMF_END_ABORT) call ESMF_FieldGet(dzbimportfield, farrayPtr=dzbfarray_f_ptr, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & call ESMF_Finalize(endflag=ESMF_END_ABORT) ! Average the last 3 cells at the lateral boundaries, to confirm to assumptions in XBeach do index = 1,(nx+1) dzbfarray_f_ptr(index,1:3) = SUM(dzbfarray_f_ptr(index,1:3))/3 dzbfarray_f_ptr(index,(ny-1):(ny+1)) = SUM(dzbfarray_f_ptr(index,(ny-1):(ny+1)))/3 end do ! test message, remove later write(*,*) 'printing last three lateral values below' write(*,*) '3 lateral values are', dzbfarray_f_ptr(1,1:3) write(*,*) 'another 3 lateral values are', dzbfarray_f_ptr(1,(ny-1):(ny+1)) write(*,*) 'Got import field getting zb array to combine' allocate(zbfarray(nx+1,ny+1)) rc = get2ddoublearray('zb', zbfarray) zbfarray = zbfarray + dzbfarray_f_ptr rc = set2ddoublearray('zb', zbfarray) ! Run until current t from xbeach == current t + timeinterval from esmf ! Set the end time in XBeach (I may have to do an updateoutput times here.... rc = getdoubleparameter('t', t) allocate(dzbfarray(nx+1,ny+1)) allocate(dzbdtfarray(nx+1,ny+1)) dzbfarray = 0 ! Retrieve morphology settings rc = getintparameter('morfacopt', morfacopt) rc = getdoubleparameter('morfac', morfac) ! Adjust tnext according to which morfacopt is used if (morfacopt==1) then tnext = (tesmf+step) ! time compressed elseif (morfacopt==0) then tnext = (tesmf+step)/morfac ! morphology accelerated end if do while (t < tnext) rc = setdoubleparameter('tnext', tnext) rc = executestep() rc = getdoubleparameter('t', t) rc = get2ddoublearray('dzbdt', dzbdtfarray) dzbfarray = dzbfarray + dzbdtfarray end do rc = outputext() ! Store exports call ESMF_StateGet(exportState, "zbexport" , field=zbexportfield, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & call ESMF_Finalize(endflag=ESMF_END_ABORT) call ESMF_FieldGet(zbexportfield, farrayPtr=zbfarray_f_ptr, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & call ESMF_Finalize(endflag=ESMF_END_ABORT) rc = get2ddoublearray('zb', zbfarray_f_ptr) call ESMF_StateGet(exportState, "dzbexport" , field=dzbexportfield, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & call ESMF_Finalize(endflag=ESMF_END_ABORT) call ESMF_FieldGet(dzbexportfield, farrayPtr=dzbfarray_f_ptr, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & call ESMF_Finalize(endflag=ESMF_END_ABORT) dzbfarray_f_ptr = dzbfarray call ESMF_StateGet(exportState, "zsexport" , field=zsexportfield, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & call ESMF_Finalize(endflag=ESMF_END_ABORT) call ESMF_FieldGet(zsexportfield, farrayPtr=zsfarray_f_ptr, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & call ESMF_Finalize(endflag=ESMF_END_ABORT) rc = get2ddoublearray('zs', zsfarray_f_ptr) call ESMF_StateGet(exportState, "wetzexport" , field=wetzexportfield, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & call ESMF_Finalize(endflag=ESMF_END_ABORT) call ESMF_FieldGet(wetzexportfield, farrayPtr=wetzfarray_f_ptr, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & call ESMF_Finalize(endflag=ESMF_END_ABORT) rc = get2dintarray('wetz', wetzfarray_f_ptr) write(*,*) 'XBeach ends at ', t deallocate(dzbfarray) end subroutine xbeach_run !------------------------------------------------------------------------------ !BOPI ! !IROUTINE: xbeach_final - finalize routine ! !INTERFACE: subroutine xbeach_final(comp, importState, exportState, clock, rc) ! ! !ARGUMENTS: type(ESMF_GridComp) :: comp type(ESMF_State) :: importState, exportState type(ESMF_Clock) :: clock integer, intent(out) :: rc ! ! !DESCRIPTION: ! User-supplied finalize routine. Release space allocated ! by this component. ! ! The arguments are: ! \begin{description} ! \item[comp] ! A Gridded Component. ! \item[importState] ! State containing the import list. ! \item[exportState] ! State containing the export list. ! \item[clock] ! Clock describing the external time. ! \item[rc] ! Return code; equals {\tt ESMF\_SUCCESS} if there are no errors, ! otherwise {\tt ESMF\_FAILURE}. ! \end{description} ! !EOPI rc = ESMF_SUCCESS end subroutine xbeach_final end module XBeachMod