! $Id: InjectorMod.F90,v 1.14 2011/06/30 05:58:24 theurich Exp $ ! !------------------------------------------------------------------------- !BOP ! \subsection{D3D Component} ! ! !DESCRIPTION: ! This is a user-supplied D3D component which interacts ! with the beach. It transform waves into morphological change ! near the coast. ! ! !EOP module flow2d3dmod ! ESMF module use ESMF use iso_c_binding use gdp_entry 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 D3D 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 integer, external :: Initialize ! from flow2d3d.dll integer, external :: PerformTimeStep ! from flow2d3d.dll ! External entry point which will register the Init, Run, and Finalize ! routines for this Component. public D3D_register contains !------------------------------------------------------------------------------ !------------------------------------------------------------------------------ !BOPI ! !IROUTINE: D3D_register - Set the Init, Run, Final routines ! !INTERFACE: subroutine D3D_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 ! print *, "Registering D3D" ! 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=D3D_init, rc=rc) if(rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT, rc=rc) call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_RUN, userRoutine=D3D_run, rc=rc) if(rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT, rc=rc) call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_FINALIZE, userRoutine=D3D_final, rc=rc) if(rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT, rc=rc) ! print *, "D3D module: Registered Initialize, Run, and Finalize routines" ! print *, "D3D module: registered Private Data block for Internal State" end subroutine D3D_register !------------------------------------------------------------------------------ !BOPI ! !IROUTINE: User Initialization routine ! !INTERFACE: subroutine D3D_init(gcomp, importState, exportState, clock, rc) ! ! !ARGUMENTS: type(ESMF_GridComp) :: gcomp 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) :: dpimportfield, dpexportfield integer :: nx, ny, index real(c_double), allocatable :: xfarray(:,:), yfarray(:,:) real(ESMF_KIND_r8), pointer :: coordX(:,:), coordY(:,:) integer :: ubnd(2), lbnd(2) ! ! !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[gcomp] ! 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 rc = Initialize('D3D_FLOW', 'fijn1') !<-- find out later ! print *, "D3D module: initializing <--- we should have a grid now" ! rc = getintparameter('nx', nx, 2) ! rc = getintparameter('ny', ny, 2) nx = gdp%d%nmax ny = gdp%d%mmax ! Get the grid spacing.... allocate(xfarray(nx+1,ny+1)) xfarray = gdp%gdr_i_ch%xcor allocate(yfarray(nx+1,ny+1)) yfarray = gdp%gdr_i_ch%ycor ! D3D 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="D3D 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 ! 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 !BOE ! Set the D3D Grid in the D3D Component !BOC call ESMF_GridCompSet(gcomp, grid=grid, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & call ESMF_Finalize(endflag=ESMF_END_ABORT) rc = ESMF_SUCCESS ! Create a field bundle with the zb array dpimportfield = ESMF_FieldCreate(grid=grid, & typekind=ESMF_TYPEKIND_r8, & staggerloc=ESMF_STAGGERLOC_CENTER, & indexflag=ESMF_INDEX_GLOBAL, & name="dpimport", rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & call ESMF_Finalize(endflag=ESMF_END_ABORT) !dps = gdp%gdr_i_ch%dps ! Create a field bundle with the zb array dpexportfield = ESMF_FieldCreate(grid=grid, & typekind=ESMF_TYPEKIND_r8, & staggerloc=ESMF_STAGGERLOC_CENTER, & indexflag=ESMF_INDEX_GLOBAL, & name="dpexport", rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & call ESMF_Finalize(endflag=ESMF_END_ABORT) ! Is the state already there? It should have been set by the xduneD3D component ! call ESMF_StatePrint(exportstate, rc=rc) ! Add the same field bundle to the import state (not sure if I should make new fields). call ESMF_StateAdd(importstate, (/dpimportfield/), 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, (/dpexportfield/), rc=rc) 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(gcomp, wrap, rc) if(rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT, rc=rc) end subroutine D3D_init !------------------------------------------------------------------------------ !BOPI ! !IROUTINE: D3D_run - D3D run routine ! !INTERFACE: subroutine D3D_run(comp, importState, exportState, clock, rc) ! ! !ARGUMENTS: type(ESMF_GridComp) :: comp type(ESMF_State) :: importState, exportState type(ESMF_Clock) :: clock type(ESMF_Time) :: currtime type(ESMF_TimeInterval) :: timeinterval integer, intent(out) :: rc real*8 :: step, tesmf,deltaT character (LEN=ESMF_MAXSTR) :: s_second integer :: nst, i_nst ! ! !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 ! Get the simulation time (since tref) from esmf call ESMF_ClockGet(clock, timeStep=timeinterval, rc=rc) ! coupling timeinterval call ESMF_TimeIntervalGet(timeinterval, s_r8=tesmf, rc=rc) ! get the current coupling time step in seconds. ! check the current coupling time step in seconds. !call ESMF_ClockPrint(clock, rc=rc) write(*,*) tesmf ! Get the simulation time (tref=0) from D3D !itstrt = gdp%gdinttim%itstrt !itinit = gdp%gdinttim%itinit !itstop = gdp%gdinttim%itstop !itfinish = gdp%gdinttim%itfinish deltaT = gdp%gdexttim%dt ! time step in D3D in minutes. nst = tesmf/(deltaT*60.0) ! number of D3D steps in one coupling step. write(*,*) nst,deltaT do i_nst = 1, nst - 1, 1 rc = PerformTimeStep('D3D_FLOW', 'fijn1',i_nst) enddo ! Run until current t from D3D == current t + timeinterval from esmf ! Set the end time in D3D (I may have to do an updateoutput times here.... !do while (t < tesmf+step) ! rc = PerformTimeStep('D3D_FLOW', 'fijn1',step) !t = gdp%gdr_i_ch%nst ! end do call ESMF_ClockGet(clock, currTime=currtime, rc=rc) ! get current simulation time (relative to the starting point) call ESMF_TimeGet(currtime, timeString=s_second, rc=rc) ! get the current simulation time in seconds. write(*,*) 'D3D finished at ', s_second, 'successfully' end subroutine D3D_run !------------------------------------------------------------------------------ !BOPI ! !IROUTINE: D3D_final - finalize routine ! !INTERFACE: subroutine D3D_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 D3D_final end module flow2d3dmod