| Class | dycore_time_mod |
| In: |
dynamics/dycore_time.f90
|
| Variable : | |||
| CurrentLoop = 1 : | integer(INTKIND) , save
|
Original external subprogram is time_mod#CurrentLoop
| Variable : | |||
| CurrentTime = 0.0 : | real(DBKIND) , save
|
Original external subprogram is time_mod#CurrentTime
| Variable : | |||
| DelTime = 300 : | real(DBKIND) , save
|
Original external subprogram is time_mod#DelTime
| Variable : | |||
| OutputStep = 1 : | integer(INTKIND) , save
|
Original external subprogram is time_mod#OutputStep
| Variable : | |||
| StepInterval = 1 : | integer(INTKIND) , save
|
Original external subprogram is time_mod#StepInterval
| Subroutine : |
subroutine dycore_time_end
!==== Dependency
use time_mod , only: time_end
use dycore_type_mod, only: STRING, REKIND, DBKIND, INTKIND
use dc_trace, only: BeginSub, EndSub, DbgMessage
!=end
implicit none
!-----------------------------------------------------------------
! 変数定義
!-----------------------------------------------------------------
!----- 作業用内部変数 -----
character(STRING), parameter:: subname = "dycore_time_end"
continue
!-----------------------------------------------------------------
! Check Initialization
!-----------------------------------------------------------------
call BeginSub(subname)
if ( .not. dycore_time_initialized) then
call EndSub( subname, 'dycore_time_init was not called', c1=trim(subname) )
return
else
dycore_time_initialized = .false.
endif
!!$ call time_end
call EndSub(subname)
end subroutine dycore_time_end
| Subroutine : | |||
| Vars_b : | type(DYCORE_VARS), intent(in)
| ||
| Vars_n : | type(DYCORE_VARS), intent(inout)
| ||
| Vars_a : | type(DYCORE_VARS), intent(in)
|
subroutine dycore_time_filter( Vars_b, Vars_n, Vars_a )
!==== Dependency
use dycore_type_mod, only: DYCORE_VARS, STRING, REKIND, DBKIND, INTKIND
use constants_mod , only: TimeFilter, TimeFilterStepInt
use dc_trace , only: BeginSub, EndSub, DbgMessage
!=end
implicit none
!=begin
!==== In/Out
!
type(DYCORE_VARS), intent(in) :: Vars_b ! 格子点データ全種(t-Δt)
type(DYCORE_VARS), intent(inout):: Vars_n ! 格子点データ全種(t)
type(DYCORE_VARS), intent(in) :: Vars_a ! 格子点データ全種(t+Δt)
!=end
!----- 作業用内部変数 -----
character(STRING), parameter:: subname = "dycore_time_filter"
continue
!----------------------------------------------------------------
! Check Initialization
!----------------------------------------------------------------
call BeginSub(subname)
if (.not. dycore_time_initialized) then
call EndSub( subname, 'Call dycore_time_init before call %c', c1=trim(subname) )
return
endif
!-----------------------------------------------------------------
! Check CurrentLoop in time_mod
!-----------------------------------------------------------------
if ( mod(CurrentLoop, TimeFilterStepInt) /= 0 ) then
call EndSub( subname, 'This is not TimeFilter Step. ' // '[CurrentLoop=<%d>, TimeFilterStepInt=<%d>]', c1=trim(subname), i=(/CurrentLoop, TimeFilterStepInt/) )
return
end if
!----------------------------------------------------------------
! Time Filter
!----------------------------------------------------------------
! 速度経度成分
Vars_n%xyz_VelLon = ( 1. - 2. * TimeFilter ) * Vars_n%xyz_VelLon + TimeFilter * ( Vars_b%xyz_VelLon + Vars_a%xyz_VelLon )
! 速度緯度成分
Vars_n%xyz_VelLat = ( 1. - 2. * TimeFilter ) * Vars_n%xyz_VelLat + TimeFilter * ( Vars_b%xyz_VelLat + Vars_a%xyz_VelLat )
! 渦度
Vars_n%xyz_Vor = ( 1. - 2. * TimeFilter ) * Vars_n%xyz_Vor + TimeFilter * ( Vars_b%xyz_Vor + Vars_a%xyz_Vor )
! 発散
Vars_n%xyz_Div = ( 1. - 2. * TimeFilter ) * Vars_n%xyz_Div + TimeFilter * ( Vars_b%xyz_Div + Vars_a%xyz_Div )
! 温度
Vars_n%xyz_Temp = ( 1. - 2. * TimeFilter ) * Vars_n%xyz_Temp + TimeFilter * ( Vars_b%xyz_Temp + Vars_a%xyz_Temp )
! 比湿
Vars_n%xyz_QVap = ( 1. - 2. * TimeFilter ) * Vars_n%xyz_QVap + TimeFilter * ( Vars_b%xyz_QVap + Vars_a%xyz_QVap )
! 地表面気圧
Vars_n%xy_Ps = ( 1. - 2. * TimeFilter ) * Vars_n%xy_Ps + TimeFilter * ( Vars_b%xy_Ps + Vars_a%xy_Ps )
call EndSub( subname, 'This is Just TimeFilter Step. ' // '[CurrentLoop=<%d>, TimeFilterStepInt=<%d>]', c1=trim(subname), i=(/CurrentLoop, TimeFilterStepInt/) )
end subroutine dycore_time_filter
| Subroutine : |
subroutine dycore_time_init
!==== Dependency
use time_mod, only: time_init
use dycore_type_mod, only: DYCORE_VARS, DYCORE_DIMS, STRING, DBKIND, INTKIND
use dc_trace, only: BeginSub, EndSub, DbgMessage
!=end
implicit none
!-------------------------------------------------------------------
! 変数定義
!-------------------------------------------------------------------
!----- 作業用内部変数 -----
character(STRING), parameter:: subname = "dycore_time_init"
continue
!----------------------------------------------------------------
! Check Initialization
!----------------------------------------------------------------
call BeginSub(subname)
if (dycore_time_initialized) then
call EndSub( subname, '%c is already called.', c1=trim(subname) )
return
else
dycore_time_initialized = .true.
endif
!----------------------------------------------------------------
! Version identifier
!----------------------------------------------------------------
call DbgMessage('%c :: %c', c1=trim(version), c2=trim(tagname))
!----------------------------------------------------------------
! time_init の呼び出し
!----------------------------------------------------------------
call time_init
call EndSub(subname)
end subroutine dycore_time_init
| Subroutine : | |||
| Vars_b : | type(DYCORE_VARS), intent(inout)
| ||
| Vars_n : | type(DYCORE_VARS), intent(inout)
| ||
| Vars_a : | type(DYCORE_VARS), intent(inout)
|
subroutine dycore_time_progress( Vars_b, Vars_n, Vars_a )
!==== Dependency
use dycore_type_mod, only: DYCORE_VARS, STRING, REKIND, DBKIND, INTKIND
use time_mod , only: time_progress
use dc_trace , only: BeginSub, EndSub, DbgMessage
!=end
implicit none
!=begin
!==== In/Out
!
type(DYCORE_VARS), intent(inout):: Vars_b ! 格子点データ全種(t-Δt)
type(DYCORE_VARS), intent(inout):: Vars_n ! 格子点データ全種(t)
type(DYCORE_VARS), intent(inout):: Vars_a ! 格子点データ全種(t+Δt)
!=end
!----- 作業用内部変数 -----
character(STRING), parameter:: subname = "dycore_time_progress"
continue
!----------------------------------------------------------------
! Check Initialization
!----------------------------------------------------------------
call BeginSub(subname)
if (.not. dycore_time_initialized) then
call EndSub( subname, 'Call dycore_time_init before call %c', c1=trim(subname) )
return
endif
!----------------------------------------------------------------
! t-Δt = t
!----------------------------------------------------------------
Vars_b%xyz_VelLon = Vars_n%xyz_VelLon ! 速度経度成分
Vars_b%xyz_VelLat = Vars_n%xyz_VelLat ! 速度緯度成分
Vars_b%xyz_Vor = Vars_n%xyz_Vor ! 渦度
Vars_b%xyz_Div = Vars_n%xyz_Div ! 発散
Vars_b%xyz_Temp = Vars_n%xyz_Temp ! 温度
Vars_b%xyz_QVap = Vars_n%xyz_QVap ! 比湿
Vars_b%xy_Ps = Vars_n%xy_Ps ! 地表面気圧
!----------------------------------------------------------------
! t = t+Δt
!----------------------------------------------------------------
Vars_n%xyz_VelLon = Vars_a%xyz_VelLon ! 速度経度成分
Vars_n%xyz_VelLat = Vars_a%xyz_VelLat ! 速度緯度成分
Vars_n%xyz_Vor = Vars_a%xyz_Vor ! 渦度
Vars_n%xyz_Div = Vars_a%xyz_Div ! 発散
Vars_n%xyz_Temp = Vars_a%xyz_Temp ! 温度
Vars_n%xyz_QVap = Vars_a%xyz_QVap ! 比湿
Vars_n%xy_Ps = Vars_a%xy_Ps ! 地表面気圧
!----------------------------------------------------------------
! Clear Vars_a
!----------------------------------------------------------------
Vars_a%xyz_VelLon = 0.0d0 ! 速度経度成分
Vars_a%xyz_VelLat = 0.0d0 ! 速度緯度成分
Vars_a%xyz_Vor = 0.0d0 ! 渦度
Vars_a%xyz_Div = 0.0d0 ! 発散
Vars_a%xyz_Temp = 0.0d0 ! 温度
Vars_a%xyz_QVap = 0.0d0 ! 比湿
Vars_a%xy_Ps = 0.0d0 ! 地表面気圧
!----------------------------------------------------------------
! Progress Time
!----------------------------------------------------------------
call time_progress()
call EndSub(subname)
end subroutine dycore_time_progress