asc26 amss-ncku initialized
This commit is contained in:
246
AMSS_NCKU_source/rungekutta4_rout.f90
Normal file
246
AMSS_NCKU_source/rungekutta4_rout.f90
Normal file
@@ -0,0 +1,246 @@
|
||||
!-----------------------------------------------------------------------------
|
||||
! $Id: rungekutta4_rout.f90,v 1.6 2012/12/26 11:47:43 zjcao Exp $
|
||||
! Carry out 4th-order Runge-Kutta method
|
||||
!-----------------------------------------------------------------------------
|
||||
! rk4 for scalar
|
||||
subroutine rungekutta4_scalar(dT,f0,f1,f_rhs,RK4)
|
||||
|
||||
implicit none
|
||||
|
||||
!~~~~~~% Input parameters:
|
||||
|
||||
integer ,intent(in):: RK4
|
||||
real*8 ,intent(in):: dT,f0
|
||||
real*8 ,intent(inout):: f1,f_rhs
|
||||
|
||||
!~~~~~~% Local parameter
|
||||
|
||||
real*8, parameter :: F1o6=1.d0/6.d0, HLF=5.d-1, TWO=2.d0
|
||||
|
||||
if( RK4 == 0 ) then
|
||||
|
||||
f1 = f0 + HLF * dT * f_rhs
|
||||
|
||||
elseif(RK4 == 1 ) then
|
||||
|
||||
f_rhs = f_rhs + TWO * f1
|
||||
f1 = f0 + HLF * dT * f1
|
||||
|
||||
elseif(RK4 == 2 ) then
|
||||
|
||||
f_rhs = f_rhs + TWO * f1
|
||||
f1 = f0 + dT * f1
|
||||
|
||||
elseif( RK4 == 3 ) then
|
||||
|
||||
f1 = f0 +F1o6 * dT *(f1 + f_rhs)
|
||||
|
||||
else
|
||||
|
||||
write(*,*) "rungekutta4_scalar: something is wrong in RK4 counting!!"
|
||||
stop
|
||||
|
||||
endif
|
||||
|
||||
return
|
||||
|
||||
end subroutine rungekutta4_scalar
|
||||
!~~~~~~~~~~~~~~~~~~
|
||||
! rk4 for complex scalar
|
||||
subroutine rungekutta4_cplxscalar(dT,f0,f1,f_rhs,RK4)
|
||||
|
||||
implicit none
|
||||
|
||||
!~~~~~~% Input parameters:
|
||||
|
||||
integer ,intent(in):: RK4
|
||||
real*8 ,intent(in):: dT
|
||||
double complex ,intent(in):: f0
|
||||
double complex ,intent(inout):: f1,f_rhs
|
||||
|
||||
!~~~~~~% Local parameter
|
||||
|
||||
real*8, parameter :: F1o6=1.d0/6.d0, HLF=5.d-1, TWO=2.d0
|
||||
|
||||
if( RK4 == 0 ) then
|
||||
|
||||
f1 = f0 + HLF * dT * f_rhs
|
||||
|
||||
elseif(RK4 == 1 ) then
|
||||
|
||||
f_rhs = f_rhs + TWO * f1
|
||||
f1 = f0 + HLF * dT * f1
|
||||
|
||||
elseif(RK4 == 2 ) then
|
||||
|
||||
f_rhs = f_rhs + TWO * f1
|
||||
f1 = f0 + dT * f1
|
||||
|
||||
elseif( RK4 == 3 ) then
|
||||
|
||||
f1 = f0 +F1o6 * dT *(f1 + f_rhs)
|
||||
|
||||
else
|
||||
|
||||
write(*,*) "rungekutta4_cplxscalar: something is wrong in RK4 counting!!"
|
||||
stop
|
||||
|
||||
endif
|
||||
|
||||
return
|
||||
|
||||
end subroutine rungekutta4_cplxscalar
|
||||
!~~~~~~~~~~~~~~~~~~
|
||||
subroutine rungekutta4_rout(ex,dT,f0,f1,f_rhs,RK4)
|
||||
|
||||
implicit none
|
||||
|
||||
!~~~~~~% Input parameters:
|
||||
|
||||
integer ,intent(in):: ex(1:3),RK4
|
||||
real*8 ,intent(in):: dT
|
||||
real*8, dimension(ex(1),ex(2),ex(3)),intent(in) ::f0
|
||||
real*8, dimension(ex(1),ex(2),ex(3)),intent(inout) ::f_rhs
|
||||
real*8, dimension(ex(1),ex(2),ex(3)),intent(inout) ::f1
|
||||
|
||||
!~~~~~~% Local parameter
|
||||
|
||||
real*8, parameter :: F1o6=1.d0/6.d0, HLF=5.d-1, TWO=2.d0
|
||||
|
||||
if( RK4 == 0 ) then
|
||||
|
||||
f1 = f0 + HLF * dT * f_rhs
|
||||
|
||||
elseif(RK4 == 1 ) then
|
||||
|
||||
f_rhs = f_rhs + TWO * f1
|
||||
|
||||
f1 = f0 + HLF * dT * f1
|
||||
|
||||
elseif(RK4 == 2 ) then
|
||||
|
||||
f_rhs = f_rhs + TWO * f1
|
||||
|
||||
f1 = f0 + dT * f1
|
||||
|
||||
elseif( RK4 == 3 ) then
|
||||
|
||||
f1 = f0 +F1o6 * dT *(f1 + f_rhs)
|
||||
|
||||
else
|
||||
|
||||
write(*,*) "rungekutta4_rout: something is wrong in RK4 counting!!"
|
||||
stop
|
||||
|
||||
endif
|
||||
|
||||
return
|
||||
|
||||
end subroutine rungekutta4_rout
|
||||
!-----------------------------------------------------------------------------
|
||||
! icn for scalar
|
||||
subroutine icn_scalar(dT,f0,f1,f_rhs,RK4)
|
||||
|
||||
implicit none
|
||||
|
||||
!~~~~~~% Input parameters:
|
||||
|
||||
integer ,intent(in):: RK4
|
||||
real*8 ,intent(in):: dT,f0
|
||||
real*8 ,intent(inout):: f1,f_rhs
|
||||
|
||||
!~~~~~~% Local parameter
|
||||
|
||||
real*8, parameter :: HLF=5.d-1
|
||||
|
||||
if( RK4 == 0 ) then
|
||||
|
||||
f1 = f0 + dT * f_rhs
|
||||
|
||||
else
|
||||
|
||||
f1 = f0 + HLF * dT * (f1+f_rhs)
|
||||
|
||||
endif
|
||||
|
||||
return
|
||||
|
||||
end subroutine icn_scalar
|
||||
!~~~~~~~~~~~~~~~~~~
|
||||
! icn for complex scalar
|
||||
subroutine icn_cplxscalar(dT,f0,f1,f_rhs,RK4)
|
||||
|
||||
implicit none
|
||||
|
||||
!~~~~~~% Input parameters:
|
||||
|
||||
integer ,intent(in):: RK4
|
||||
real*8 ,intent(in):: dT
|
||||
double complex ,intent(in):: f0
|
||||
double complex ,intent(inout):: f1,f_rhs
|
||||
|
||||
!~~~~~~% Local parameter
|
||||
|
||||
real*8, parameter :: HLF=5.d-1
|
||||
|
||||
if( RK4 == 0 ) then
|
||||
|
||||
f1 = f0 + dT * f_rhs
|
||||
|
||||
else
|
||||
|
||||
f1 = f0 + HLF * dT * (f1+f_rhs)
|
||||
|
||||
endif
|
||||
|
||||
return
|
||||
|
||||
end subroutine icn_cplxscalar
|
||||
!~~~~~~~~~~~~~~~~~~
|
||||
subroutine icn_rout(ex,dT,f0,f1,f_rhs,RK4)
|
||||
|
||||
implicit none
|
||||
|
||||
!~~~~~~% Input parameters:
|
||||
|
||||
integer ,intent(in):: ex(1:3),RK4
|
||||
real*8 ,intent(in):: dT
|
||||
real*8, dimension(ex(1),ex(2),ex(3)),intent(in) ::f0
|
||||
real*8, dimension(ex(1),ex(2),ex(3)),intent(inout) ::f_rhs
|
||||
real*8, dimension(ex(1),ex(2),ex(3)),intent(inout) ::f1
|
||||
|
||||
!~~~~~~% Local parameter
|
||||
|
||||
real*8, parameter :: HLF=5.d-1
|
||||
|
||||
if( RK4 == 0 ) then
|
||||
|
||||
f1 = f0 + dT * f_rhs
|
||||
|
||||
else
|
||||
|
||||
f1 = f0 + HLF * dT * (f1+f_rhs)
|
||||
|
||||
endif
|
||||
|
||||
return
|
||||
|
||||
end subroutine icn_rout
|
||||
!~~~~~~~~~~~~~~~~~~
|
||||
subroutine euler_rout(ex,dT,f0,f1,f_rhs)
|
||||
|
||||
implicit none
|
||||
|
||||
!~~~~~~% Input parameters:
|
||||
|
||||
integer ,intent(in):: ex(1:3)
|
||||
real*8 ,intent(in):: dT
|
||||
real*8, dimension(ex(1),ex(2),ex(3)),intent(in) ::f0
|
||||
real*8, dimension(ex(1),ex(2),ex(3)),intent(in) ::f_rhs
|
||||
real*8, dimension(ex(1),ex(2),ex(3)),intent(out) ::f1
|
||||
|
||||
f1 = f0 + dT * f_rhs
|
||||
|
||||
return
|
||||
|
||||
end subroutine euler_rout
|
||||
Reference in New Issue
Block a user