From 3d6853a0ffd81389b9d07cfe8afb948809c55560 Mon Sep 17 00:00:00 2001
From: Antoine Cyril David Hoffmann <ahoffman@spcpc606.epfl.ch>
Date: Tue, 27 Oct 2020 10:49:35 +0100
Subject: [PATCH] Project of adaptative time step scheme
---
src/advance_field_adapt.F90 | 80 +++++++++++++++++++++++++++++++++++++
1 file changed, 80 insertions(+)
create mode 100644 src/advance_field_adapt.F90
diff --git a/src/advance_field_adapt.F90 b/src/advance_field_adapt.F90
new file mode 100644
index 00000000..d2d18f26
--- /dev/null
+++ b/src/advance_field_adapt.F90
@@ -0,0 +1,80 @@
+MODULE advance_field_routine
+
+USE prec_const
+implicit none
+
+CONTAINS
+
+ SUBROUTINE advance_time_level
+
+ USE basic
+ USE time_integration
+ use prec_const
+ IMPLICIT NONE
+
+ call set_updatetlevel(mod(updatetlevel,ntimelevel)+1)
+
+ END SUBROUTINE advance_time_level
+
+
+
+ SUBROUTINE advance_field( f, f_rhs )
+
+ USE basic
+ USE time_integration
+ USE array
+ USE grid
+ use prec_const
+ IMPLICIT NONE
+
+ COMPLEX(dp), DIMENSION ( ikrs:ikre, ikzs:ikze, ntimelevel ) :: f
+ COMPLEX(dp), DIMENSION ( ikrs:ikre, ikzs:ikze, ntimelevel ) :: f_rhs
+ REAL(dp) :: error
+ INTEGER :: istage
+
+ SELECT CASE (updatetlevel)
+
+ CASE(1)
+ SELECT CASE (numerical_scheme)
+
+ CASE ('DOPRI5_ADAPT')
+ error = 0._dp
+ DO ikz=ikzs,ikze
+ DO ikr=ikrs,ikre
+ fs = f(ikr,ikz,1)
+ DO istage=1,ntimelevel
+ f(ikr,ikz,1) = f(ikr,ikz,1) + dt*b_E(istage)*f_rhs(ikr,ikz,istage)
+ fs = fs + dt*b_Es(istage)*f_rhs(ikr,ikz,istage)
+ END DO
+ IF ( ABS(f(ikr,ikz,1) - fs) .GT. error ) THEN
+ error = ABS(f(ikr,ikz,1) - fs)
+ ENDIF
+ END DO
+ END DO
+ IF (error > TOL)
+ CASE DEFAULT
+ DO ikz=ikzs,ikze
+ DO ikr=ikrs,ikre
+ fs = f(ikr,ikz,1)
+ DO istage=1,ntimelevel
+ f(ikr,ikz,1) = f(ikr,ikz,1) + dt*b_E(istage)*f_rhs(ikr,ikz,istage)
+ END DO
+ END DO
+ END DO
+ END SELECT
+
+ CASE DEFAULT
+ DO ikz=ikzs,ikze
+ DO ikr=ikrs,ikre
+ f(ikr,ikz,updatetlevel) = f(ikr,ikz,1);
+ DO istage=1,updatetlevel-1
+ f(ikr,ikz,updatetlevel) = f(ikr,ikz,updatetlevel) + &
+ dt*A_E(updatetlevel,istage)*f_rhs(ikr,ikz,istage)
+ END DO
+ END DO
+ END DO
+ END SELECT
+
+ END SUBROUTINE advance_field
+
+END MODULE advance_field_routine
--
GitLab