Skip to content
Snippets Groups Projects
Commit 8321ad6e authored by oawile's avatar oawile
Browse files

- 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
parent 09fe202d
No related branches found
No related tags found
No related merge requests found
Hide whitespace changes
Inline Side-by-side
src/ppm_module_data_ode.f
+ 5
− 0
View file @ 8321ad6e
......@@ -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
......
src/ppm_ode_init.f
+ 9
− 3
View file @ 8321ad6e
......@@ -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
......
src/ppm_ode_map_pop.f
+ 3
− 4
View file @ 8321ad6e
......@@ -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
......
src/ppm_ode_map_push.f
+ 1
− 4
View file @ 8321ad6e
......@@ -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
......
src/ppm_ode_rhsfunc_macro.h
+ 8
− 8
View file @ 8321ad6e
......@@ -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
......
src/ppm_ode_step.f
+ 20
− 7
View file @ 8321ad6e
......@@ -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
......
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment