From 8321ad6eaec1787f2bd9773e666040cd5a525882 Mon Sep 17 00:00:00 2001
From: oawile <oawile@7c7fe9aa-52eb-4d9e-b0a8-ba7d787348e9>
Date: Thu, 20 May 2010 21:02:41 +0000
Subject: [PATCH] - updated ODE routines to use the new topology data
structures (UNTESTED)
git-svn-id: https://ppm.inf.ethz.ch/svn/ppmnumerics/branches/ngtopo/libppmnumerics@626 7c7fe9aa-52eb-4d9e-b0a8-ba7d787348e9
---
src/ppm_module_data_ode.f | 5 +++++
src/ppm_ode_init.f | 12 +++++++++---
src/ppm_ode_map_pop.f | 7 +++----
src/ppm_ode_map_push.f | 5 +----
src/ppm_ode_rhsfunc_macro.h | 16 ++++++++--------
src/ppm_ode_step.f | 27 ++++++++++++++++++++-------
6 files changed, 46 insertions(+), 26 deletions(-)
diff --git a/src/ppm_module_data_ode.f b/src/ppm_module_data_ode.f
index e9bf118..c0ba9a6 100644
--- a/src/ppm_module_data_ode.f
+++ b/src/ppm_module_data_ode.f
@@ -124,6 +124,11 @@
INTEGER :: ppm_max_mid
INTEGER :: ppm_max_mid_allocd
+ !-----------------------------------------------------------------------
+ ! topology ID to work on
+ !-----------------------------------------------------------------------
+ INTEGER :: ppm_ode_topoid
+
CONTAINS
SUBROUTINE ppm_module_data_ode_activate
diff --git a/src/ppm_ode_init.f b/src/ppm_ode_init.f
index f06a7f7..4687941 100644
--- a/src/ppm_ode_init.f
+++ b/src/ppm_ode_init.f
@@ -50,7 +50,7 @@
! ETH Zentrum, Hirschengraben 84
! CH-8092 Zurich, Switzerland
!-------------------------------------------------------------------------
- SUBROUTINE ppm_ode_init(info)
+ SUBROUTINE ppm_ode_init(topoid,info)
!-----------------------------------------------------------------------
! Includes
!-----------------------------------------------------------------------
@@ -67,7 +67,8 @@
!-----------------------------------------------------------------------
! Arguments
!-----------------------------------------------------------------------
- INTEGER, INTENT( out) :: info
+ INTEGER, INTENT(IN ) :: topoid
+ INTEGER, INTENT( OUT) :: info
!-----------------------------------------------------------------------
! Local Variables
!-----------------------------------------------------------------------
@@ -94,7 +95,7 @@
END IF
mid = -1
!-----------------------------------------------------------------------
- ! nullify some guys
+ ! nullify some module variables
!-----------------------------------------------------------------------
NULLIFY(ppm_ode_ischeme); NULLIFY(ppm_ode_adaptive)
NULLIFY(ppm_ode_stages); NULLIFY(ppm_ode_state)
@@ -103,6 +104,11 @@
NULLIFY(ppm_ode_kscheme)
ppm_max_mid = 0
ppm_max_mid_allocd = 0
+
+ !-----------------------------------------------------------------------
+ ! register the ID of the topology to be used for the ODE solver
+ !-----------------------------------------------------------------------
+ ppm_ode_topoid = topoid
9999 CONTINUE
!-----------------------------------------------------------------------
! substop
diff --git a/src/ppm_ode_map_pop.f b/src/ppm_ode_map_pop.f
index 6d9fb4e..0c4e94f 100644
--- a/src/ppm_ode_map_pop.f
+++ b/src/ppm_ode_map_pop.f
@@ -110,7 +110,7 @@
INTEGER :: ldasend
INTEGER :: throwaway
INTEGER :: mid, iopt
- INTEGER :: to_topo, umidmin, umidmax
+ INTEGER :: umidmin, umidmax
INTEGER, DIMENSION(2) :: dime
!-----------------------------------------------------------------------
! call substart
@@ -181,12 +181,11 @@
mid = ppm_internal_mid(odeid)
ldasend = lda*ppm_ode_sent(mid)
IF(ldasend.EQ.0) GOTO 9999
- to_topo = -1
+
!-----------------------------------------------------------------------
! get the stuff
!-----------------------------------------------------------------------
- CALL ppm_map_part(bfr,ldasend,Npart,mpart,to_topo,&
- & ppm_param_map_pop, info)
+ CALL ppm_map_part_pop(bfr,ldasend,Npart,mpart,info)
IF(info.NE.0) THEN
GOTO 9999
END IF
diff --git a/src/ppm_ode_map_push.f b/src/ppm_ode_map_push.f
index 0aa85cb..2b89001 100644
--- a/src/ppm_ode_map_push.f
+++ b/src/ppm_ode_map_push.f
@@ -91,7 +91,6 @@
INTEGER :: ldasend
INTEGER :: throwaway
INTEGER :: mid, umidmax, umidmin
- INTEGER :: to_topo
!-----------------------------------------------------------------------
! call substart
!-----------------------------------------------------------------------
@@ -175,9 +174,7 @@
ldasend = lda*ppm_ode_sent(mid)
IF(ldasend.EQ.0) GOTO 9999
- to_topo = -1
- CALL ppm_map_part(bfr,ldasend,Npart,mpart,to_topo,&
- & ppm_param_map_push, info)
+ CALL ppm_map_part_push(bfr,ldasend,Npart,info)
IF(info.NE.0) THEN
GOTO 9999
END IF
diff --git a/src/ppm_ode_rhsfunc_macro.h b/src/ppm_ode_rhsfunc_macro.h
index 45ac55b..5244620 100644
--- a/src/ppm_ode_rhsfunc_macro.h
+++ b/src/ppm_ode_rhsfunc_macro.h
@@ -11,37 +11,37 @@
IF(PRESENT(ipackdata)) THEN
IF(PRESENT(lpackdata)) THEN
IF(PRESENT(rpackdata)) THEN
- throwaway = rhsfunc(xp,up,dup,lda,Npart,&
+ throwaway = rhsfunc(topoid,xp,up,dup,lda,Npart,&
& ipack=ipackdata,lpack=lpackdata,rpack=rpackdata,&
& info=info)
ELSE
- throwaway = rhsfunc(xp,up,dup,lda,Npart,&
+ throwaway = rhsfunc(topoid,xp,up,dup,lda,Npart,&
& ipack=ipackdata,lpack=lpackdata,info=info)
END IF
ELSE
IF(PRESENT(rpackdata)) THEN
- throwaway = rhsfunc(xp,up,dup,lda,Npart,&
+ throwaway = rhsfunc(topoid,xp,up,dup,lda,Npart,&
& ipack=ipackdata,rpack=rpackdata,info=info)
ELSE
- throwaway = rhsfunc(xp,up,dup,lda,Npart,&
+ throwaway = rhsfunc(topoid,xp,up,dup,lda,Npart,&
& ipack=ipackdata,info=info)
END IF
END IF
ELSE
IF(PRESENT(lpackdata)) THEN
IF(PRESENT(rpackdata)) THEN
- throwaway = rhsfunc(xp,up,dup,lda,Npart,&
+ throwaway = rhsfunc(topoid,xp,up,dup,lda,Npart,&
& lpack=lpackdata,rpack=rpackdata,info=info)
ELSE
- throwaway = rhsfunc(xp,up,dup,lda,Npart,&
+ throwaway = rhsfunc(topoid,xp,up,dup,lda,Npart,&
& lpack=lpackdata,info=info)
END IF
ELSE
IF(PRESENT(rpackdata)) THEN
- throwaway = rhsfunc(xp,up,dup,lda,Npart,&
+ throwaway = rhsfunc(topoid,xp,up,dup,lda,Npart,&
& rpack=rpackdata,info=info)
ELSE
- throwaway = rhsfunc(xp,up,dup,lda,Npart,&
+ throwaway = rhsfunc(topoid,xp,up,dup,lda,Npart,&
& info=info)
END IF
END IF
diff --git a/src/ppm_ode_step.f b/src/ppm_ode_step.f
index 242cadd..ae93ebb 100644
--- a/src/ppm_ode_step.f
+++ b/src/ppm_ode_step.f
@@ -133,6 +133,7 @@
!-----------------------------------------------------------------------
USE ppm_module_data_ode
USE ppm_module_data
+ USE ppm_module_check_topoid
USE ppm_module_substart
USE ppm_module_substop
USE ppm_module_error
@@ -146,8 +147,9 @@
#endif
#if __KIND == __SINGLE_PRECISION
INTERFACE
- FUNCTION rhsfunc(xp,up,dup,lda,npart,ipack,&
+ 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
@@ -166,8 +168,9 @@
END INTERFACE
#else
INTERFACE
- FUNCTION rhsfunc(xp,up,dup,lda,npart,ipack,&
+ 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
@@ -214,6 +217,8 @@
INTEGER :: stsn
REAL(mk), DIMENSION(20) :: stsnu
REAL(mk) :: tau
+ INTEGER :: topoid
+ LOGICAL :: topo_valid
!-----------------------------------------------------------------------
! fill the nu parameters for the sts scheme
!-----------------------------------------------------------------------
@@ -334,7 +339,15 @@
& '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
@@ -620,13 +633,13 @@
!-----------------------------------------------------------------
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)+ dup(i))
+ 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))
+ 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
--
GitLab