| Class | Bucket_Model |
| In: |
surface_flux/bucket_model.f90
|
| Subroutine : | |
| xy_SurfCond( 0:imax-1, 1:jmax ) : | integer , intent(in ) |
| xy_SurfEvapFlux( 0:imax-1, 1:jmax ) : | real(DP), intent(in ) |
| xy_SoilMoistB( 0:imax-1, 1:jmax ) : | real(DP), intent(in ) |
| xy_SurfSnowB( 0:imax-1, 1:jmax ) : | real(DP), intent(in ) |
| xy_SoilMoistA( 0:imax-1, 1:jmax ) : | real(DP), intent(out) |
| xy_SurfSnowA( 0:imax-1, 1:jmax ) : | real(DP), intent(out) |
subroutine BucketEvap( xy_SurfCond, xy_SurfEvapFlux, xy_SoilMoistB, xy_SurfSnowB, xy_SoilMoistA, xy_SurfSnowA )
! 時刻管理
! Time control
!
use timeset, only: DelTime ! $ \Delta t $ [s]
! 格子点設定
! Grid points settings
!
use gridset, only: imax, jmax, kmax ! 鉛直層数.
! Number of vertical level
! 雪と海氷の定数の設定
! Setting constants of snow and sea ice
!
use constants_snowseaice, only: ThresholdSurfSnow, TempCondWater
integer , intent(in ) :: xy_SurfCond ( 0:imax-1, 1:jmax )
real(DP), intent(in ) :: xy_SurfEvapFlux( 0:imax-1, 1:jmax )
real(DP), intent(in ) :: xy_SoilMoistB ( 0:imax-1, 1:jmax )
real(DP), intent(in ) :: xy_SurfSnowB ( 0:imax-1, 1:jmax )
real(DP), intent(out) :: xy_SoilMoistA ( 0:imax-1, 1:jmax )
real(DP), intent(out) :: xy_SurfSnowA ( 0:imax-1, 1:jmax )
! 作業変数
! Work variables
!
integer:: i ! 経度方向に回る DO ループ用作業変数
! Work variables for DO loop in longitude
integer:: j ! 緯度方向に回る DO ループ用作業変数
! Work variables for DO loop in latitude
! 初期化
! Initialization
!
if ( .not. bucket_model_inited ) call BucketInit
if ( .not. FlagBucketModel ) then
xy_SoilMoistA = xy_SoilMoistB
xy_SurfSnowA = xy_SurfSnowB
return
end if
if ( FlagBucketModelSnow ) then
! Evaporation is subtracted from surface snow and soil moisture
!
xy_SurfSnowA = xy_SurfSnowB - xy_SurfEvapFlux * 2.0d0 * DelTime
do j = 1, jmax
do i = 0, imax-1
if ( xy_SurfSnowA(i,j) < 0.0d0 ) then
xy_SoilMoistA(i,j) = xy_SoilMoistB(i,j) + xy_SurfSnowA(i,j)
xy_SurfSnowA (i,j) = 0.0d0
else
xy_SoilMoistA(i,j) = xy_SoilMoistB(i,j)
end if
end do
end do
else
! Evaporation is subtracted from soil moisture
!
xy_SoilMoistA = xy_SoilMoistB - xy_SurfEvapFlux * 2.0d0 * DelTime
xy_SurfSnowA = xy_SurfSnowB
end if
! Remove negative values
!
do j = 1, jmax
do i = 0, imax-1
if( xy_SoilMoistA(i,j) < 0.0d0 ) xy_SoilMoistA(i,j) = 0.0d0
if( xy_SurfSnowA (i,j) < 0.0d0 ) xy_SurfSnowA (i,j) = 0.0d0
end do
end do
! Fill meaningless value in ocean grid
!
do j = 1, jmax
do i = 0, imax-1
if ( xy_SurfCond( i, j ) == 0 ) then
xy_SoilMoistA(i,j) = SoilMoistMeaningLess
xy_SurfSnowA(i,j) = SoilMoistMeaningLess
end if
end do
end do
end subroutine BucketEvap
| Subroutine : | |
| xy_SurfCond( 0:imax-1, 1:jmax ) : | integer , intent(in ) |
| xy_SurfEvapFlux( 0:imax-1, 1:jmax ) : | real(DP), intent(in ) |
| xy_SoilMoist( 0:imax-1, 1:jmax ) : | real(DP), intent(inout) |
| xy_SurfSnow( 0:imax-1, 1:jmax ) : | real(DP), intent(inout) |
subroutine BucketEvapAdjust( xy_SurfCond, xy_SurfEvapFlux, xy_SoilMoist, xy_SurfSnow )
! 格子点設定
! Grid points settings
!
use gridset, only: imax, jmax, kmax ! 鉛直層数.
! Number of vertical level
integer , intent(in ) :: xy_SurfCond ( 0:imax-1, 1:jmax )
real(DP), intent(in ) :: xy_SurfEvapFlux( 0:imax-1, 1:jmax )
real(DP), intent(inout) :: xy_SoilMoist ( 0:imax-1, 1:jmax )
real(DP), intent(inout) :: xy_SurfSnow ( 0:imax-1, 1:jmax )
! 作業変数
! Work variables
!
real(DP) :: xy_SoilMoistB( 0:imax-1, 1:jmax )
real(DP) :: xy_SurfSnowB ( 0:imax-1, 1:jmax )
real(DP) :: xy_SoilMoistA( 0:imax-1, 1:jmax )
real(DP) :: xy_SurfSnowA ( 0:imax-1, 1:jmax )
xy_SoilMoistB = xy_SoilMoist
xy_SurfSnowB = xy_SurfSnow
call BucketEvap( xy_SurfCond, xy_SurfEvapFlux, xy_SoilMoistB, xy_SurfSnowB, xy_SoilMoistA, xy_SurfSnowA )
xy_SoilMoist = xy_SoilMoistA
xy_SurfSnow = xy_SurfSnowA
end subroutine BucketEvapAdjust
| Subroutine : | |
| xy_SurfCond( 0:imax-1, 1:jmax ) : | integer , intent(in ) |
| xy_DSoilMoistDt( 0:imax-1, 1:jmax ) : | real(DP), intent(in ) |
| xy_DSurfSnowDt( 0:imax-1, 1:jmax ) : | real(DP), intent(in ) |
| xy_SoilMoistB( 0:imax-1, 1:jmax ) : | real(DP), intent(in ) |
| xy_SurfSnowB( 0:imax-1, 1:jmax ) : | real(DP), intent(in ) |
| xy_SoilMoistA( 0:imax-1, 1:jmax ) : | real(DP), intent(out) |
| xy_SurfSnowA( 0:imax-1, 1:jmax ) : | real(DP), intent(out) |
subroutine BucketIntegration( xy_SurfCond, xy_DSoilMoistDt, xy_DSurfSnowDt, xy_SoilMoistB, xy_SurfSnowB, xy_SoilMoistA, xy_SurfSnowA )
! 時刻管理
! Time control
!
use timeset, only: DelTime ! $ \Delta t $ [s]
! 格子点設定
! Grid points settings
!
use gridset, only: imax, jmax, kmax ! 鉛直層数.
! Number of vertical level
! 雪と海氷の定数の設定
! Setting constants of snow and sea ice
!
use constants_snowseaice, only: ThresholdSurfSnow, TempCondWater
integer , intent(in ) :: xy_SurfCond ( 0:imax-1, 1:jmax )
real(DP), intent(in ) :: xy_DSoilMoistDt( 0:imax-1, 1:jmax )
real(DP), intent(in ) :: xy_DSurfSnowDt ( 0:imax-1, 1:jmax )
real(DP), intent(in ) :: xy_SoilMoistB ( 0:imax-1, 1:jmax )
real(DP), intent(in ) :: xy_SurfSnowB ( 0:imax-1, 1:jmax )
real(DP), intent(out) :: xy_SoilMoistA ( 0:imax-1, 1:jmax )
real(DP), intent(out) :: xy_SurfSnowA ( 0:imax-1, 1:jmax )
! 作業変数
! Work variables
!
integer:: i ! 経度方向に回る DO ループ用作業変数
! Work variables for DO loop in longitude
integer:: j ! 緯度方向に回る DO ループ用作業変数
! Work variables for DO loop in latitude
! 初期化
! Initialization
!
if ( .not. bucket_model_inited ) call BucketInit
if ( .not. FlagBucketModel ) then
xy_SoilMoistA = xy_SoilMoistB
xy_SurfSnowA = xy_SurfSnowB
return
end if
xy_SoilMoistA = xy_SoilMoistB + xy_DSoilMoistDt * 2.0d0 * DelTime
! Remove negative values
!
do j = 1, jmax
do i = 0, imax-1
if( xy_SoilMoistA(i,j) < 0.0d0 ) xy_SoilMoistA(i,j) = 0.0d0
end do
end do
if ( FlagBucketModelSnow ) then
xy_SurfSnowA = xy_SurfSnowB + xy_DSurfSnowDt * 2.0d0 * DelTime
! Remove negative values
!
do j = 1, jmax
do i = 0, imax-1
if( xy_SurfSnowA (i,j) < 0.0d0 ) xy_SurfSnowA (i,j) = 0.0d0
end do
end do
else
xy_SurfSnowA = xy_SurfSnowB
end if
! Fill meaningless value in ocean grid
!
do j = 1, jmax
do i = 0, imax-1
if ( xy_SurfCond( i, j ) == 0 ) then
xy_SoilMoistA(i,j) = SoilMoistMeaningLess
xy_SurfSnowA(i,j) = SoilMoistMeaningLess
end if
end do
end do
end subroutine BucketIntegration
| Subroutine : | |
| xy_SurfCond( 0:imax-1, 1:jmax ) : | integer , intent(in ) |
| xy_SoilMoist( 0:imax-1, 1:jmax ) : | real(DP), intent(in ) |
| xy_SurfSnow( 0:imax-1, 1:jmax ) : | real(DP), intent(in ) |
| xy_SurfHumidCoef( 0:imax-1, 1:jmax ) : | real(DP), intent(inout) |
subroutine BucketModHumidCoef( xy_SurfCond, xy_SoilMoist, xy_SurfSnow, xy_SurfHumidCoef )
! 時刻管理
! Time control
!
use timeset, only: DelTime ! $ \Delta t $ [s]
! 格子点設定
! Grid points settings
!
use gridset, only: imax, jmax, kmax ! 鉛直層数.
! Number of vertical level
! 雪と海氷の定数の設定
! Setting constants of snow and sea ice
!
use constants_snowseaice, only: ThresholdSurfSnow
integer , intent(in ) :: xy_SurfCond ( 0:imax-1, 1:jmax )
real(DP), intent(in ) :: xy_SoilMoist ( 0:imax-1, 1:jmax )
real(DP), intent(in ) :: xy_SurfSnow ( 0:imax-1, 1:jmax )
real(DP), intent(inout) :: xy_SurfHumidCoef( 0:imax-1, 1:jmax )
! 作業変数
! Work variables
!
integer:: i ! 経度方向に回る DO ループ用作業変数
! Work variables for DO loop in longitude
integer:: j ! 緯度方向に回る DO ループ用作業変数
! Work variables for DO loop in latitude
! 初期化
! Initialization
!
if ( .not. bucket_model_inited ) call BucketInit
if ( .not. FlagBucketModel ) return
! Surface humidity coefficient is modified.
!
if ( FlagBucketModelSnow ) then
do j = 1, jmax
do i = 0, imax-1
if ( xy_SurfCond(i,j) == 0 ) then
xy_SurfHumidCoef(i,j) = xy_SurfHumidCoef(i,j)
else if ( xy_SurfSnow(i,j) > ThresholdSurfSnow ) then
xy_SurfHumidCoef(i,j) = 1.0d0
else
xy_SurfHumidCoef(i,j) = xy_SoilMoist(i,j) / SoilMoistCritAmntforEvapEff
if ( xy_SurfHumidCoef(i,j) > 1.0d0 ) xy_SurfHumidCoef(i,j) = 1.0d0
end if
end do
end do
else
do j = 1, jmax
do i = 0, imax-1
if ( xy_SurfCond(i,j) == 0 ) then
xy_SurfHumidCoef(i,j) = xy_SurfHumidCoef(i,j)
else
xy_SurfHumidCoef(i,j) = xy_SoilMoist(i,j) / SoilMoistCritAmntforEvapEff
if ( xy_SurfHumidCoef(i,j) > 1.0d0 ) xy_SurfHumidCoef(i,j) = 1.0d0
end if
end do
end do
end if
end subroutine BucketModHumidCoef
| Subroutine : | |
| xy_SurfCond( 0:imax-1, 1:jmax ) : | integer , intent(in ) |
| xy_SoilMoist( 0:imax-1, 1:jmax ) : | real(DP), intent(in ) |
| xy_SurfSnow( 0:imax-1, 1:jmax ) : | real(DP), intent(in ) |
| xy_SurfEvapFlux( 0:imax-1, 1:jmax ) : | real(DP), intent(inout) |
subroutine BucketModQvapFlux( xy_SurfCond, xy_SoilMoist, xy_SurfSnow, xy_SurfEvapFlux )
! 時刻管理
! Time control
!
use timeset, only: DelTime ! $ \Delta t $ [s]
! 格子点設定
! Grid points settings
!
use gridset, only: imax, jmax, kmax ! 鉛直層数.
! Number of vertical level
integer , intent(in ) :: xy_SurfCond ( 0:imax-1, 1:jmax )
real(DP), intent(in ) :: xy_SoilMoist ( 0:imax-1, 1:jmax )
real(DP), intent(in ) :: xy_SurfSnow ( 0:imax-1, 1:jmax )
real(DP), intent(inout) :: xy_SurfEvapFlux ( 0:imax-1, 1:jmax )
! 作業変数
! Work variables
!
integer:: i ! 経度方向に回る DO ループ用作業変数
! Work variables for DO loop in longitude
integer:: j ! 緯度方向に回る DO ループ用作業変数
! Work variables for DO loop in latitude
! 初期化
! Initialization
!
if ( .not. bucket_model_inited ) call BucketInit
if ( .not. FlagBucketModel ) return
if ( FlagBucketModelSnow ) then
! Surface water vapor flux is limited up to the water and snow amount on the land.
!
do j = 1, jmax
do i = 0, imax-1
if ( ( xy_SurfCond (i,j) >= 1 ) .and. ( xy_SurfEvapFlux(i,j) > 0.0d0 ) .and. ( xy_SurfEvapFlux(i,j) * 2.0d0 * DelTime > xy_SoilMoist(i,j) + xy_SurfSnow(i,j) ) ) then
xy_SurfEvapFlux(i,j) = ( xy_SoilMoist(i,j) + xy_SurfSnow(i,j) ) / ( 2.0d0 * DelTime )
end if
end do
end do
else
! Surface water vapor flux is limited up to the water amount on the land.
!
do j = 1, jmax
do i = 0, imax-1
if ( ( xy_SurfCond (i,j) >= 1 ) .and. ( xy_SurfEvapFlux(i,j) > 0.0d0 ) .and. ( xy_SurfEvapFlux(i,j) * 2.0d0 * DelTime > xy_SoilMoist(i,j) ) ) then
xy_SurfEvapFlux(i,j) = xy_SoilMoist(i,j) / ( 2.0d0 * DelTime )
end if
end do
end do
end if
end subroutine BucketModQvapFlux
| Subroutine : | |
| xy_SurfCond( 0:imax-1, 1:jmax ) : | integer , intent(in ) |
| xyz_Temp( 0:imax-1, 1:jmax, 1:kmax ) : | real(DP), intent(in ) |
| xy_SurfPrepFlux( 0:imax-1, 1:jmax ) : | real(DP), intent(in ) |
| xy_SoilMoist( 0:imax-1, 1:jmax ) : | real(DP), intent(inout) |
| xy_SurfSnow( 0:imax-1, 1:jmax ) : | real(DP), intent(inout) |
subroutine BucketPrepAdjust( xy_SurfCond, xyz_Temp, xy_SurfPrepFlux, xy_SoilMoist, xy_SurfSnow )
! 時刻管理
! Time control
!
use timeset, only: DelTime ! $ \Delta t $ [s]
! 格子点設定
! Grid points settings
!
use gridset, only: imax, jmax, kmax ! 鉛直層数.
! Number of vertical level
! 物理定数設定
! Physical constants settings
!
use constants, only: LatentHeat
! 雪と海氷の定数の設定
! Setting constants of snow and sea ice
!
use constants_snowseaice, only: TempCondWater
integer , intent(in ) :: xy_SurfCond ( 0:imax-1, 1:jmax )
real(DP), intent(in ) :: xyz_Temp ( 0:imax-1, 1:jmax, 1:kmax )
real(DP), intent(in ) :: xy_SurfPrepFlux( 0:imax-1, 1:jmax )
real(DP), intent(inout) :: xy_SoilMoist ( 0:imax-1, 1:jmax )
real(DP), intent(inout) :: xy_SurfSnow ( 0:imax-1, 1:jmax )
! 作業変数
! Work variables
!
integer:: i ! 経度方向に回る DO ループ用作業変数
! Work variables for DO loop in longitude
integer:: j ! 緯度方向に回る DO ループ用作業変数
! Work variables for DO loop in latitude
! 初期化
! Initialization
!
if ( .not. bucket_model_inited ) call BucketInit
if ( .not. FlagBucketModel ) return
if ( FlagBucketModelSnow ) then
! Precipitation is added to soil moisture or surface snow
!
do j = 1, jmax
do i = 0, imax-1
if ( xyz_Temp(i,j,1) > TempCondWater ) then
xy_SoilMoist(i,j) = xy_SoilMoist(i,j) + xy_SurfPrepFlux(i,j) * 2.0d0 * DelTime
else
xy_SurfSnow (i,j) = xy_SurfSnow (i,j) + xy_SurfPrepFlux(i,j) * 2.0d0 * DelTime
end if
end do
end do
else
! Precipitation is added to soil moisture
!
xy_SoilMoist = xy_SoilMoist + xy_SurfPrepFlux * 2.0d0 * DelTime
end if
! Calculation of Run-off
!
do j = 1, jmax
do i = 0, imax-1
if ( xy_SoilMoist(i,j) > SoilMoistCritAmnt ) xy_SoilMoist(i,j) = SoilMoistCritAmnt
end do
end do
! Fill meaningless value in ocean grid
!
do j = 1, jmax
do i = 0, imax-1
if ( xy_SurfCond(i,j) == 0 ) then
xy_SoilMoist(i,j) = SoilMoistMeaningLess
xy_SurfSnow (i,j) = SoilMoistMeaningLess
end if
end do
end do
end subroutine BucketPrepAdjust
| Variable : | |||
| FlagBucketModel : | logical, save, public
|
| Variable : | |||
| FlagBucketModelSnow : | logical, save, public
|
| Subroutine : |
bucket_model モジュールの初期化を行います. NAMELIST#bucket_model_nml の読み込みはこの手続きで行われます.
"bucket_model" module is initialized. "NAMELIST#bucket_model_nml" is loaded in this procedure.
This procedure input/output NAMELIST#bucket_model_nml .
subroutine BucketInit
!
! bucket_model モジュールの初期化を行います.
! NAMELIST#bucket_model_nml の読み込みはこの手続きで行われます.
!
! "bucket_model" module is initialized.
! "NAMELIST#bucket_model_nml" is loaded in this procedure.
!
! モジュール引用 ; USE statements
!
! NAMELIST ファイル入力に関するユーティリティ
! Utilities for NAMELIST file input
!
use namelist_util, only: namelist_filename, NmlutilMsg, NmlutilAryValid
! ファイル入出力補助
! File I/O support
!
use dc_iounit, only: FileOpen
! 種別型パラメタ
! Kind type parameter
!
use dc_types, only: STDOUT ! 標準出力の装置番号. Unit number of standard output
! 文字列操作
! Character handling
!
use dc_string, only: StoA
! メッセージ出力
! Message output
!
use dc_message, only: MessageNotify
! 宣言文 ; Declaration statements
!
implicit none
integer:: unit_nml ! NAMELIST ファイルオープン用装置番号.
! Unit number for NAMELIST file open
integer:: iostat_nml ! NAMELIST 読み込み時の IOSTAT.
! IOSTAT of NAMELIST read
! NAMELIST 変数群
! NAMELIST group name
!
namelist /bucket_model_nml/ FlagBucketModel, SoilMoistCritAmnt, SoilMoistCritAmntforEvapEff, FlagBucketModelSnow
! 実行文 ; Executable statement
!
if ( bucket_model_inited ) return
!!$ call InitCheck
! デフォルト値の設定
! Default values settings
!
FlagBucketModel = .false.
SoilMoistCritAmnt = 1.0d3 * 0.15d0
SoilMoistCritAmntforEvapEff = 1.0d3 * 0.15d0 * 0.75d0
FlagBucketModelSnow = .false.
! NAMELIST の読み込み
! NAMELIST is input
!
if ( trim(namelist_filename) /= '' ) then
call FileOpen( unit_nml, namelist_filename, mode = 'r' ) ! (in)
rewind( unit_nml )
read( unit_nml, nml = bucket_model_nml, iostat = iostat_nml ) ! (out)
close( unit_nml )
call NmlutilMsg( iostat_nml, module_name ) ! (in)
end if
if ( ( FlagBucketModelSnow ) .and. ( .not. FlagBucketModel ) ) then
call MessageNotify( 'E', module_name, 'FlagBucketModel has to be true, when FlagBucketModelSnow is true.' )
end if
! 印字 ; Print
!
call MessageNotify( 'M', module_name, '----- Initialization Messages -----' )
call MessageNotify( 'M', module_name, ' FlagBucketModel = %y', l = (/ FlagBucketModel /) )
call MessageNotify( 'M', module_name, ' SoilMoistCritAmnt = %f', d = (/ SoilMoistCritAmnt /) )
call MessageNotify( 'M', module_name, ' SoilMoistCritAmntforEvapEff = %f', d = (/ SoilMoistCritAmntforEvapEff /) )
call MessageNotify( 'M', module_name, ' FlagBucketModelSnow = %y', l = (/ FlagBucketModelSnow /) )
bucket_model_inited = .true.
end subroutine BucketInit
| Variable : | |||
| SoilMoistCritAmnt : | real(DP), save
|
| Variable : | |||
| SoilMoistCritAmntforEvapEff : | real(DP), save
|
| Variable : | |||
| SoilMoistMeaningLess = -1.0d0 : | real(DP), save
|
| Variable : | |||
| bucket_model_inited = .false. : | logical, save
|
| Constant : | |||
| module_name = ‘bucket_model‘ : | character(*), parameter
|
| Constant : | |||
| version = ’$Name: dcpam5-20100224 $’ // ’$Id: bucket_model.f90,v 1.3 2009-07-20 03:48:15 yot Exp $’ : | character(*), parameter
|