!-------------------------------------------------------------------------
! Subroutine : ppm_ode_step
!-------------------------------------------------------------------------
!
! Purpose : integrates one stage of a mode
!
! Input : odeid (I) id of mode to advance
! xp(:,:) (F) xp (trad. coords)
! up(:,:) (F) function to integrate
! dup(:,:) (F) derivative of up (in time)
! lda (I) leading dimension of up
! Npart (I) numper of particles
! bfr(:,:) (F) buffer
! istage (I) which stage were in
! time(4) (F) time data: time(1) is the
! start time, time(2) the end
! time, time(3) the current
! time and time (4) the
! time step
! rhsfunc (I) function pointer to the rhs
! ipackdata(:,:) (I) optional storage array
! lpackdata(:,:) (L) optional storage array
! rpackdata(:,:) (F) optional storage array
!
! Output : info (I) return status
!
! Remarks :
!
! References :
!
! Revisions :
!-------------------------------------------------------------------------
! $Log: ppm_ode_step.f,v $
! Revision 1.1.1.1 2007/07/13 10:19:01 ivos
! CBL version of the PPM library
!
! Revision 1.20 2006/09/04 18:34:54 pchatela
! Fixes and cleanups to make it compile for
! release-1-0
!
! Revision 1.19 2006/02/03 09:37:06 ivos
! Changed input arguments from INOUT to POINTER to allow for ghost_put.
!
! Revision 1.18 2005/08/05 09:30:06 ivos
! Added the flabbergsting STS of Michael.
!
! Revision 1.17 2005/07/22 08:03:43 pchatela
! Used a DO loop rather than a vector notation for the 1st step inside RK4.
! 2 reasons:
! 1) DO loops are used everywhere else in the file...
! 2) It apparently causes a seg fault for a system with moderate memory (like my personal laptop)
!
! Revision 1.16 2005/01/05 16:27:18 ivos
! fixed INTENT and POINTER attributes of the arguments.
!
! Revision 1.15 2004/10/11 06:53:14 hiebers
! cosmetics
!
! Revision 1.14 2004/10/01 15:15:11 hiebers
! added Runge Kutta 4th order
!
! Revision 1.13 2004/08/26 15:21:00 michaebe
! inserted 1:npart to be able to handle ghosts. ghosts?
!
! Revision 1.12 2004/08/13 15:30:45 michaebe
! added mid point runge kutta
!
! Revision 1.11 2004/08/12 13:45:23 michaebe
! modified ppm_ode_sent() = ..
!
! Revision 1.10 2004/07/27 10:29:20 michaebe
! renamed the scheme parameters from ppm_ode_scheme.. to
! ppm_param_ode_scheme..
!
! Revision 1.9 2004/07/26 14:57:18 michaebe
! renamed the vector and scalar defines
!
! Revision 1.8 2004/07/26 13:49:19 ivos
! Removed Routines sections from the header comment.
!
! Revision 1.7 2004/07/26 11:49:01 michaebe
! added overloaded end subroutine
!
! Revision 1.6 2004/07/26 11:33:04 michaebe
! inserted the use of the ppm ode data module.
!
! Revision 1.5 2004/07/26 08:13:51 michaebe
! Added scalar code for lda=1.
!
! Revision 1.4 2004/07/26 07:59:51 michaebe
! Cosmetics. Lines partially too long.
!
! Revision 1.3 2004/07/26 07:54:57 michaebe
! Atomized. Furthermore added carrier arrays to transport auxillary data
! to the user-given right hand side function.
!
! Revision 1.2 2004/06/10 16:20:04 ivos
! Moved all xpp directtives to column 1. The NEC xpp did not recognize
! them otherwise!!!
!
! Revision 1.1 2004/02/19 08:33:57 michaebe
! initial implementation.
!
!-------------------------------------------------------------------------
! Parallel Particle Mesh Library (PPM)
! Institute of Computational Science
! ETH Zentrum, Hirschengraben 84
! CH-8092 Zurich, Switzerland
!-------------------------------------------------------------------------
#if __MODE == __SCA
#if __KIND == __SINGLE_PRECISION
SUBROUTINE ppm_ode_step_ss(odeid,xp,up,dup,lda,Npart,bfr,istage,time,&
& rhsfunc, ipackdata, rpackdata, lpackdata, info)
#elif __KIND == __DOUBLE_PRECISION
SUBROUTINE ppm_ode_step_ds(odeid,xp,up,dup,lda,Npart,bfr,istage,time,&
& rhsfunc, ipackdata, rpackdata, lpackdata, info)
#endif
#elif __MODE == __VEC
#if __KIND == __SINGLE_PRECISION
SUBROUTINE ppm_ode_step_sv(odeid,xp,up,dup,lda,Npart,bfr,istage,time,&
& rhsfunc, ipackdata, rpackdata, lpackdata, info)
#elif __KIND == __DOUBLE_PRECISION
SUBROUTINE ppm_ode_step_dv(odeid,xp,up,dup,lda,Npart,bfr,istage,time,&
& rhsfunc, ipackdata, rpackdata, lpackdata, info)
#endif
#endif
!-----------------------------------------------------------------------
! Includes
!-----------------------------------------------------------------------
#include "ppm_define.h"
!-----------------------------------------------------------------------
! Modules
!-----------------------------------------------------------------------
USE ppm_module_data_ode
USE ppm_module_data
USE ppm_module_check_id
USE ppm_module_substart
USE ppm_module_substop
USE ppm_module_error
USE ppm_module_alloc
USE ppm_module_numerics_data
IMPLICIT NONE
#if __KIND == __SINGLE_PRECISION
INTEGER, PARAMETER :: mk = ppm_kind_single
#else
INTEGER, PARAMETER :: mk = ppm_kind_double
#endif
#if __KIND == __SINGLE_PRECISION
INTERFACE
FUNCTION rhsfunc(topoid,xp,up,dup,lda,npart,ipack,&
&lpack,rpack,info)
INTEGER , INTENT(IN) :: topoid
INTEGER , INTENT(IN) :: lda,npart
INTEGER , INTENT(OUT) :: info
#if __MODE == __SCA
REAL(KIND(1.0E0)), DIMENSION(:,:), POINTER :: xp
REAL(KIND(1.0E0)), DIMENSION(:), POINTER :: up
REAL(KIND(1.0E0)), DIMENSION(:), POINTER :: dup
#elif __MODE == __VEC
REAL(KIND(1.0E0)), DIMENSION(:,:), POINTER :: xp,up
REAL(KIND(1.0E0)), DIMENSION(:,:), POINTER :: dup
#endif
INTEGER, DIMENSION(:,:), INTENT(IN), OPTIONAL :: ipack
LOGICAL, DIMENSION(:,:), INTENT(IN), OPTIONAL :: lpack
REAL(kind(1.0E0)), DIMENSION(:,:), INTENT(IN), OPTIONAL :: rpack
INTEGER :: rhsfunc
END FUNCTION rhsfunc
END INTERFACE
#else
INTERFACE
FUNCTION rhsfunc(topoid,xp,up,dup,lda,npart,ipack,&
&lpack,rpack,info)
INTEGER , INTENT(IN) :: topoid
INTEGER , INTENT(IN) :: lda,npart
INTEGER , INTENT(OUT) :: info
#if __MODE == __SCA
REAL(KIND(1.0D0)), DIMENSION(:,:), POINTER :: xp
REAL(KIND(1.0D0)), DIMENSION(:), POINTER :: up
REAL(KIND(1.0D0)), DIMENSION(:), POINTER :: dup
#elif __MODE == __VEC
REAL(KIND(1.0D0)), DIMENSION(:,:), POINTER :: xp,up
REAL(KIND(1.0D0)), DIMENSION(:,:), POINTER :: dup
#endif
INTEGER, DIMENSION(:,:), INTENT(IN), OPTIONAL :: ipack
LOGICAL, DIMENSION(:,:), INTENT(IN), OPTIONAL :: lpack
REAL(kind(1.0D0)), DIMENSION(:,:), INTENT(IN), OPTIONAL :: rpack
INTEGER :: rhsfunc
END FUNCTION rhsfunc
END INTERFACE
#endif
!-----------------------------------------------------------------------
! Arguments
!-----------------------------------------------------------------------
INTEGER, INTENT( out) :: info
INTEGER, INTENT(in ) :: odeid
#if __MODE == __SCA
REAL(mk), DIMENSION(: ), POINTER :: up,dup
#elif __MODE == __VEC
REAL(mk), DIMENSION(:,:), POINTER :: up,dup
#endif
REAL(mk), DIMENSION(:,:), POINTER :: xp
REAL(mk), DIMENSION(:,:), POINTER :: bfr
INTEGER, INTENT(in ) :: istage
REAL(mk), DIMENSION(4), INTENT(inout) :: time
INTEGER, INTENT(in ) :: lda, Npart
INTEGER, DIMENSION(:,:), INTENT(IN), OPTIONAL :: ipackdata
REAL(mk), DIMENSION(:,:), INTENT(IN), OPTIONAL :: rpackdata
LOGICAL, DIMENSION(:,:), INTENT(IN), OPTIONAL :: lpackdata
!-----------------------------------------------------------------------
! Local Variables
!-----------------------------------------------------------------------
REAL(mk) :: t, dt
INTEGER :: scheme, throwaway, i, j
INTEGER :: umidmin, umidmax
INTEGER :: mid, ilda
REAL(mk) :: M_PI
INTEGER :: stsn
REAL(mk), DIMENSION(20) :: stsnu
REAL(mk) :: tau
INTEGER :: topoid
LOGICAL :: topo_valid
!-----------------------------------------------------------------------
! fill the nu parameters for the sts scheme
!-----------------------------------------------------------------------
M_PI = ACOS(-1.0_MK)
stsnu(1) = 0.0_mk
stsnu(5) = 0.04_mk
stsnu(7) = 0.0015_mk
stsnu(9) = 0.04_mk
stsnu(20) = 0.006_mk
!-----------------------------------------------------------------------
! call substart
!-----------------------------------------------------------------------
CALL substart('ppm_ode_step',t0,info)
!-----------------------------------------------------------------------
! check input arguments
!-----------------------------------------------------------------------
IF(Npart.EQ.0) THEN
!--------------------------------------------------------------------
! best case: nothing to do
!--------------------------------------------------------------------
time(3) = time(3) + time(4)
GOTO 9999
END IF
IF(ppm_debug.GT.0) THEN
IF(.NOT.ppm_initialized) THEN
info = ppm_error_error
CALL ppm_error(ppm_err_ppm_noinit,'ppm_ode_step',&
& 'Please call ppm_init first!',__LINE__,info)
GOTO 9999
END IF
!--------------------------------------------------------------------
! check odeid
!--------------------------------------------------------------------
umidmin = LBOUND(ppm_internal_mid,1)
umidmax = UBOUND(ppm_internal_mid,1)
IF(odeid.LT.umidmin.OR.odeid.GT.umidmax) THEN
!-----------------------------------------------------------------
! user mid does not exist
!-----------------------------------------------------------------
info = ppm_error_error
CALL ppm_error(ppm_err_argument,'ppm_ode_step', &
& 'ODEID does not exist',__LINE__,info)
GOTO 9999
ELSE
IF(ppm_internal_mid(odeid).EQ.-HUGE(odeid)) THEN
!--------------------------------------------------------------
! user mid does not exist
!--------------------------------------------------------------
info = ppm_error_error
CALL ppm_error(ppm_err_argument,'ppm_ode_step',&
& 'ODEID does not exist',__LINE__,info)
GOTO 9999
END IF
END IF
!--------------------------------------------------------------------
! check dimension
!--------------------------------------------------------------------
IF(Npart.LT.0) THEN
info = ppm_error_error
CALL ppm_error(ppm_err_argument,'ppm_ode_step', &
& 'Npart cannot be <0',__LINE__,info)
GOTO 9999
END IF
IF(lda.LE.0) THEN
info = ppm_error_error
CALL ppm_error(ppm_err_argument,'ppm_ode_step', &
& 'LDA must be >00',__LINE__,info)
GOTO 9999
END IF
IF(time(4).LE.0.0_mk) THEN
info = ppm_error_error
CALL ppm_error(ppm_err_argument,'ppm_ode_step', &
& 'dt must be >=0',__LINE__,info)
GOTO 9999
END IF
IF(time(3).LT.time(1)) THEN
info = ppm_error_error
CALL ppm_error(ppm_err_argument,'ppm_ode_step', &
& 'time must be >= tstart',__LINE__,info)
GOTO 9999
END IF
IF(scheme.EQ.ppm_param_ode_scheme_sts) THEN
IF(.NOT.PRESENT(ipackdata)) THEN
info = ppm_error_error
CALL ppm_error(ppm_err_argument,'ppm_ode_step', &
& 'for STS you need to specify N in ipackdata(1,1)',&
& __LINE__,info)
GOTO 9999
ELSE
IF(ipackdata(1,1).NE.1.AND.ipackdata(1,1).NE.7.AND. &
& ipackdata(1,1).NE.9.AND.ipackdata(1,1).NE.20) THEN
info = ppm_error_error
CALL ppm_error(ppm_err_argument,'ppm_ode_step', &
& 'ipackdata(1,1) must be element of {1,7,9,20}',&
& __LINE__,info)
GOTO 9999
END IF
END IF
END IF
!--------------------------------------------------------------------
! check association of up, dup, bfr
!--------------------------------------------------------------------
IF(.NOT.ASSOCIATED(up)) THEN
info = ppm_error_error
CALL ppm_error(ppm_err_argument,'ppm_ode_step', &
& 'UP is empty',__LINE__,info)
GOTO 9999
END IF
IF(.NOT.ASSOCIATED(dup)) THEN
info = ppm_error_error
CALL ppm_error(ppm_err_argument,'ppm_ode_step', &
& 'DUP is empty',__LINE__,info)
GOTO 9999
END IF
IF(.NOT.ASSOCIATED(bfr)) THEN
info = ppm_error_error
CALL ppm_error(ppm_err_argument,'ppm_ode_step', &
& 'BFR is empty',__LINE__,info)
GOTO 9999
END IF
CALL ppm_check_topoid(ppm_ode_topoid,topo_valid,info)
IF (.NOT. topo_valid) THEN
info = ppm_error_error
CALL ppm_error(ppm_err_argument,'ppm_ode_step', &
& 'topoid not valid',__LINE__,info)
GOTO 9999
ENDIF
END IF ! (ppm_debug.GT.0)
topoid = ppm_ode_topoid
mid = ppm_internal_mid(odeid)
!-----------------------------------------------------------------------
! check state if finished, bail out
!-----------------------------------------------------------------------
IF(ppm_ode_state(mid).EQ.ppm_ode_state_finished) GOTO 9999
!-----------------------------------------------------------------------
! check istage, if greater that ppm_ode_stages, then
! bail out
!-----------------------------------------------------------------------
IF(ppm_ode_stages(mid).LT.istage) GOTO 9999
!-----------------------------------------------------------------------
! get times and scheme
!-----------------------------------------------------------------------
t = time(3)
dt = time(4)
IF(ppm_ode_state(mid).EQ.ppm_ode_state_kickoff) THEN
scheme = ppm_ode_kscheme(mid)
ELSE
scheme = ppm_ode_ischeme(mid)
END IF
IF(ppm_ode_adaptive(mid)) THEN
!--------------------------------------------------------------------
! compute adaptive timestep [TODO]
!--------------------------------------------------------------------
CALL ppm_error(ppm_err_argument,'ppm_ode_step',&
& 'adaptivity not yet implemented',__LINE__,info)
GOTO 9999
END IF
SELECT CASE(scheme)
CASE(ppm_param_ode_scheme_eulerf)
!--------------------------------------------------------------------
!=======
! euler:
!=======
!--------------------------------------------------------------------
!--------------------------------------------------------------------
! call right hand side and do an euler step
!--------------------------------------------------------------------
#include "ppm_ode_rhsfunc_macro.h"
#if __MODE == __SCA
DO j=1,npart
up(j) = up(j) + dt * dup(j)
END DO
#elif __MODE == __VEC
DO i=1,lda
DO j=1,npart
up(i,j) = up(i,j) + dt * dup(i,j)
END DO
END DO
#endif
t = t + dt
IF(ppm_ode_state(mid).EQ.ppm_ode_state_kickoff) THEN
ppm_ode_state(mid) = ppm_ode_state_running
END IF
! how much to save of this
ppm_ode_sent(mid) = 0
CASE(ppm_param_ode_scheme_sts)
!-----------------------------------------------------
! compute the new dt
!-----------------------------------------------------
stsn = ipackdata(1,1)
if(present(rpackdata)) stsnu(stsn) = rpackdata(1,1)
tau = dt/((stsnu(stsn)-1.0_mk)*&
& COS((2.0_mk*REAL(istage,mk)-1.0_mk)/REAL(stsn,mk)*M_PI*0.5_mk)&
& +1.0_mk+stsnu(stsn))
!-----------------------------------------------------------------
!=======
! euler:
!=======
!-----------------------------------------------------------------
! call right hand side and do an euler step
!-----------------------------------------------------------------
#include "ppm_ode_rhsfunc_macro.h"
#if __MODE == __SCA
DO j=1,npart
up(j) = up(j) + tau * dup(j)
END DO
#elif __MODE == __VEC
DO i=1,lda
DO j=1,npart
up(i,j) = up(i,j) + tau * dup(i,j)
END DO
END DO
#endif
t = t + tau
IF(ppm_ode_state(mid).EQ.ppm_ode_state_kickoff) THEN
ppm_ode_state(mid) = ppm_ode_state_running
END IF
! how much to save of this
ppm_ode_sent(mid) = 0
CASE(ppm_param_ode_scheme_tvdrk2)
!--------------------------------------------------------------------
!============
! 2nd tvd rk:
!============
!--------------------------------------------------------------------
SELECT CASE(istage)
CASE(1)
!-----------------------------------------------------------------
! call rhs, save the old up and do an euler step
!-----------------------------------------------------------------
#include "ppm_ode_rhsfunc_macro.h"
#if __MODE == __SCA
DO i=1,Npart
bfr(1,i) = up(i)
up(i) = up(i) + dt*dup(i)
END DO
#elif __MODE == __VEC
DO i=1,Npart
DO j=1,lda
bfr(j,i) = up(j,i)
up(j,i) = up(j,i) + dt*dup(j,i)
END DO
END DO
#endif
ppm_ode_sent(mid) = 1
CASE(2)
!-----------------------------------------------------------------
! call rhs, and do another euler step
!-----------------------------------------------------------------
#include "ppm_ode_rhsfunc_macro.h"
#if __MODE == __SCA
DO i=1,Npart
up(i) = up(i) + dt*dup(i)
END DO
#elif __MODE == __VEC
DO i=1,Npart
DO j=1,lda
up(j,i) = up(j,i) + dt*dup(j,i)
END DO
END DO
#endif
!-----------------------------------------------------------------
! interpolate
!-----------------------------------------------------------------
#if __MODE == __SCA
DO i=1,Npart
up(i) = 0.5_mk * (up(i) + bfr(1,i) )
END DO
#elif __MODE == __VEC
DO i=1,Npart
DO j=1,lda
up(j,i) = 0.5_mk * (up(j,i) + bfr(j,i))
END DO
END DO
#endif
t = t + dt
ppm_ode_sent(mid) = 0
IF(ppm_ode_state(mid).EQ.ppm_ode_state_kickoff) THEN
ppm_ode_state(mid) = ppm_ode_state_running
END IF
END SELECT
CASE(ppm_param_ode_scheme_midrk2)
!--------------------------------------------------------------------
!=============
! mid point rk
!=============
!--------------------------------------------------------------------
SELECT CASE(istage)
CASE(1)
!-----------------------------------------------------------------
!
!-----------------------------------------------------------------
#include "ppm_ode_rhsfunc_macro.h"
#if __MODE == __SCA
DO i=1,Npart
bfr(1,i) = up(i)
up(i) = up(i) + 0.5_mk* dt * dup(i)
END DO
#elif __MODE == __VEC
DO j=1,lda
DO i=1,Npart
bfr(j,i) = up(j,i)
up(j,i) = up(j,i) + 0.5_mk*dt*dup(j,i)
END DO
END DO
#endif
ppm_ode_sent(mid) = 1
CASE(2)
#include "ppm_ode_rhsfunc_macro.h"
#if __MODE == __SCA
DO i=1,Npart
up(i) = bfr(1,i) + dt * dup(i)
END DO
#elif __MODE == __VEC
DO i=1,Npart
DO j=1,lda
up(j,i) = bfr(j,i) + dt * dup(j,i)
END DO
END DO
#endif
t = t + dt
ppm_ode_sent(mid) = 0
IF(ppm_ode_state(mid).EQ.ppm_ode_state_kickoff) THEN
ppm_ode_state(mid) = ppm_ode_state_running
END IF
END SELECT
CASE(ppm_param_ode_scheme_rk4)
!=============
! Runge Kutta 4
!=============
SELECT CASE(istage)
CASE(1)
!-----------------------------------------------------------------
! x_n + 1/2 dt k1
!-----------------------------------------------------------------
#include "ppm_ode_rhsfunc_macro.h"
DO i=1,Npart
#if __MODE == __SCA
bfr(1,i) = up(i)
bfr(2,i) = dup(i) ! k1
#elif __MODE == __VEC
bfr(1:lda,i) = up(:,i)
bfr((lda+1):2*lda,i) = dup(:,i) !k1
#endif
END DO
DO i=1,Npart
#if __MODE == __SCA
up(i) = up(i) + 0.5_mk* dt * dup(i)
#elif __MODE == __VEC
DO ilda=1,lda
up(ilda,i) = up(ilda,i) + 0.5_mk*dt*dup(ilda,i)
END DO
#endif
END DO
ppm_ode_sent(mid) = 2
CASE(2)
!-----------------------------------------------------------------
#include "ppm_ode_rhsfunc_macro.h"
!-----------------------------------------------------------------
! x_n + 1/2 dt k2
!-----------------------------------------------------------------
DO i=1,Npart
#if __MODE == __SCA
bfr(3,i) = dup(i) !k2
#elif __MODE == __VEC
DO ilda=1,lda
bfr((2*lda+ilda),i) = dup(ilda,i) !k2
END DO
#endif
#if __MODE == __SCA
up(i) = bfr(1,i) + 0.5_mk* dt * dup(i)
#elif __MODE == __VEC
DO ilda=1,lda
up(ilda,i) = bfr(ilda,i) + 0.5_mk*dt * dup(ilda,i)
END DO
#endif
END DO
ppm_ode_sent(mid) = 3
CASE(3)
!-----------------------------------------------------------------
!
!-----------------------------------------------------------------
#include "ppm_ode_rhsfunc_macro.h"
!-----------------------------------------------------------------
! x_n + dt k3
!-----------------------------------------------------------------
DO i=1,Npart
#if __MODE == __SCA
bfr(4,i) = dup(i) !k3
#elif __MODE == __VEC
DO ilda=1,lda
bfr((3*lda+ilda),i) = dup(ilda,i) !k3
END DO
#endif
#if __MODE == __SCA
up(i) = bfr(1,i) + dt * dup(i)
#elif __MODE == __VEC
DO ilda=1,lda
up(ilda,i) = bfr(ilda,i) + dt * dup(ilda,i)
END DO
#endif
END DO
ppm_ode_sent(mid) = 4
CASE(4)
!-----------------------------------------------------------------
#include "ppm_ode_rhsfunc_macro.h"
!-----------------------------------------------------------------
! x_n + 1/6 dt (k1 + 2 k2 + 2k3 +k4)
!-----------------------------------------------------------------
DO i=1,Npart
#if __MODE == __SCA
up(i) = bfr(1,i) + 1.0_MK/6.0_MK*dt* &
& (bfr(2,i) + 2.0_MK*bfr(3,i) + 2.0_MK*bfr(4,i) + up(i))
#elif __MODE == __VEC
DO ilda=1,lda
up(ilda,i) = bfr(ilda,i) + 1.0_MK/6.0_MK*dt* &
& (bfr((lda+ilda),i) + 2.0_MK*bfr((2*lda+ilda),i) + &
& 2.0_MK*bfr((3*lda+ilda),i)+ dup(ilda,i))
END DO
#endif
END DO
t = t + dt
ppm_ode_sent(mid) = 0
IF(ppm_ode_state(mid).EQ.ppm_ode_state_kickoff) THEN
ppm_ode_state(mid) = ppm_ode_state_running
END IF
END SELECT
END SELECT
!-----------------------------------------------------------------------
! pass back dt and time
!-----------------------------------------------------------------------
time(3) = t
time(4) = dt
!-----------------------------------------------------------------------
! stop ode if were ready
!-----------------------------------------------------------------------
IF(time(3).GE.time(2)) THEN
ppm_ode_state(mid) = ppm_ode_state_finished
END IF
9999 CONTINUE
!-----------------------------------------------------------------------
! substop
!-----------------------------------------------------------------------
CALL substop('ppm_ode_step',t0,info)
RETURN
#if __MODE == __SCA
#if __KIND == __SINGLE_PRECISION
END SUBROUTINE ppm_ode_step_ss
#elif __KIND == __DOUBLE_PRECISION
END SUBROUTINE ppm_ode_step_ds
#endif
#elif __MODE == __VEC
#if __KIND == __SINGLE_PRECISION
END SUBROUTINE ppm_ode_step_sv
#elif __KIND == __DOUBLE_PRECISION
END SUBROUTINE ppm_ode_step_dv
#endif
#endif