| Class | Bucket_Model |
| In: |
surface_flux/bucket_model.f90
|
| Function : | |
| OutSoilMoistCritAmnt : | real(DP) |
function BucketGetSoilMoistCritAmnt() result( OutSoilMoistCritAmnt )
real(DP) :: OutSoilMoistCritAmnt
! 作業変数
! Work variables
!
! 初期化確認
! Initialization check
!
if ( .not. bucket_model_inited ) then
call MessageNotify( 'E', module_name, 'This module has not been initialized.' )
end if
!!$ ! 計算時間計測開始
!!$ ! Start measurement of computation time
!!$ !
!!$ call TimesetClockStart( module_name )
OutSoilMoistCritAmnt = SoilMoistCritAmnt
!!$ ! 計算時間計測一時停止
!!$ ! Pause measurement of computation time
!!$ !
!!$ call TimesetClockStop( module_name )
end function BucketGetSoilMoistCritAmnt
| Subroutine : | |
| xy_FlagOceanGrid( 0:imax-1, 1:jmax ) : | logical , 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_FlagOceanGrid, xy_DSoilMoistDt, xy_DSurfSnowDt, xy_SoilMoistB, xy_SurfSnowB, xy_SoilMoistA, xy_SurfSnowA )
! 雪と海氷の定数の設定
! Setting constants of snow and sea ice
!
use constants_snowseaice, only: ThresholdSurfSnow, TempCondWater
! 時刻管理
! Time control
!
use timeset, only: DelTime, TimesetClockStart, TimesetClockStop
! 格子点設定
! Grid points settings
!
use gridset, only: imax, jmax, kmax ! 鉛直層数.
! Number of vertical level
logical , intent(in ) :: xy_FlagOceanGrid( 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 check
!
if ( .not. bucket_model_inited ) then
call MessageNotify( 'E', module_name, 'This module has not been initialized.' )
end if
! 計算時間計測開始
! Start measurement of computation time
!
call TimesetClockStart( module_name )
xy_SoilMoistA = xy_SoilMoistB + xy_DSoilMoistDt * 2.0_DP * DelTime
! Remove negative values
!
do j = 1, jmax
do i = 0, imax-1
if( xy_SoilMoistA(i,j) < 0.0_DP ) xy_SoilMoistA(i,j) = 0.0_DP
end do
end do
if ( FlagSnow ) then
xy_SurfSnowA = xy_SurfSnowB + xy_DSurfSnowDt * 2.0_DP * DelTime
! Remove negative values
!
do j = 1, jmax
do i = 0, imax-1
if( xy_SurfSnowA (i,j) < 0.0_DP ) xy_SurfSnowA (i,j) = 0.0_DP
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_FlagOceanGrid(i,j) ) then
xy_SoilMoistA(i,j) = SoilMoistMeaningLess
xy_SurfSnowA(i,j) = SoilMoistMeaningLess
end if
end do
end do
! 計算時間計測一時停止
! Pause measurement of computation time
!
call TimesetClockStop( module_name )
end subroutine BucketIntegration
| Subroutine : | |
| xy_FlagOceanGrid( 0:imax-1, 1:jmax ) : | logical , 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) |
| xy_SurfLatentHeatFlux( 0:imax-1, 1:jmax ) : | real(DP), intent(inout) |
subroutine BucketModEvapAndLatentHeatFlux( xy_FlagOceanGrid, xy_SoilMoist, xy_SurfSnow, xy_SurfEvapFlux, xy_SurfLatentHeatFlux )
! 時刻管理
! Time control
!
use timeset, only: DelTime, TimesetClockStart, TimesetClockStop
! 格子点設定
! Grid points settings
!
use gridset, only: imax, jmax, kmax ! 鉛直層数.
! Number of vertical level
! 物理定数設定
! Physical constants settings
!
use constants, only: LatentHeat, LatentHeatFusion
! $ L $ [J kg-1] .
! 融解の潜熱.
! Latent heat of fusion
logical , intent(in ) :: xy_FlagOceanGrid ( 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 )
real(DP), intent(inout) :: xy_SurfLatentHeatFlux( 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 check
!
if ( .not. bucket_model_inited ) then
call MessageNotify( 'E', module_name, 'This module has not been initialized.' )
end if
! 計算時間計測開始
! Start measurement of computation time
!
call TimesetClockStart( module_name )
if ( FlagSnow ) then
! Surface water vapor flux is limited up to the water and snow amount on land.
!
do j = 1, jmax
do i = 0, imax-1
if ( .not. xy_FlagOceanGrid(i,j) ) then
if ( xy_SurfEvapFlux(i,j) > 0.0_DP ) then
! Water vapor flux is positive (transported upward).
if ( xy_SurfEvapFlux(i,j) * 2.0_DP * DelTime > xy_SoilMoist(i,j) + xy_SurfSnow(i,j) ) then
! All snow and all water is evaporated.
xy_SurfEvapFlux(i,j) = ( xy_SoilMoist(i,j) + xy_SurfSnow(i,j) ) / ( 2.0_DP * DelTime )
xy_SurfLatentHeatFlux(i,j) = ( LatentHeat * xy_SoilMoist(i,j) + ( LatentHeat + LatentHeatFusion ) * xy_SurfSnow(i,j) ) / ( 2.0_DP * DelTime )
else if ( xy_SurfEvapFlux(i,j) * 2.0_DP * DelTime > xy_SurfSnow(i,j) ) then
! All snow and a part of water is evaporated.
xy_SurfLatentHeatFlux(i,j) = ( LatentHeat * ( xy_SurfEvapFlux(i,j) * 2.0_DP * DelTime - xy_SurfSnow(i,j) ) + ( LatentHeat + LatentHeatFusion ) * xy_SurfSnow(i,j) ) / ( 2.0_DP * DelTime )
else
! Only a part of snow is evaporated.
xy_SurfLatentHeatFlux(i,j) = ( LatentHeat + LatentHeatFusion ) * xy_SurfEvapFlux(i,j)
end if
else
! Water vapor flux is negative (transported downward).
if ( xy_SurfSnow(i,j) > 0.0_DP ) then
! Water vapor is converted to snow.
xy_SurfLatentHeatFlux(i,j) = ( LatentHeat + LatentHeatFusion ) * xy_SurfEvapFlux(i,j)
end if
end if
end if
end do
end do
else
! Surface water vapor flux is limited up to the water amount on land.
!
do j = 1, jmax
do i = 0, imax-1
if ( ( .not. xy_FlagOceanGrid(i,j) ) .and. ( xy_SurfEvapFlux(i,j) > 0.0_DP ) .and. ( xy_SurfEvapFlux(i,j) * 2.0_DP * DelTime > xy_SoilMoist(i,j) ) ) then
xy_SurfEvapFlux(i,j) = xy_SoilMoist(i,j) / ( 2.0_DP * DelTime )
xy_SurfLatentHeatFlux(i,j) = LatentHeat * xy_SoilMoist(i,j) / ( 2.0_DP * DelTime )
end if
end do
end do
end if
! 計算時間計測一時停止
! Pause measurement of computation time
!
call TimesetClockStop( module_name )
end subroutine BucketModEvapAndLatentHeatFlux
| Subroutine : | |
| xy_FlagOceanGrid( 0:imax-1, 1:jmax ) : | logical , 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_FlagOceanGrid, xy_SoilMoist, xy_SurfSnow, xy_SurfHumidCoef )
! 雪と海氷の定数の設定
! Setting constants of snow and sea ice
!
use constants_snowseaice, only: ThresholdSurfSnow
! 時刻管理
! Time control
!
use timeset, only: DelTime ! $ \Delta t $ [s]
! 格子点設定
! Grid points settings
!
use gridset, only: imax, jmax, kmax ! 鉛直層数.
! Number of vertical level
logical , intent(in ) :: xy_FlagOceanGrid( 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 check
!
if ( .not. bucket_model_inited ) then
call MessageNotify( 'E', module_name, 'This module has not been initialized.' )
end if
! Surface humidity coefficient is modified.
!
if ( FlagSnow ) then
do j = 1, jmax
do i = 0, imax-1
if ( xy_FlagOceanGrid(i,j) ) then
xy_SurfHumidCoef(i,j) = xy_SurfHumidCoef(i,j)
!!$ else if ( xy_SurfSnow(i,j) > ThresholdSurfSnow ) then
else if ( xy_SurfSnow(i,j) > HumidCoefSnowThreshold ) then
xy_SurfHumidCoef(i,j) = 1.0_DP
else
xy_SurfHumidCoef(i,j) = xy_SoilMoist(i,j) / SoilMoistCritAmntforEvapEff
if ( xy_SurfHumidCoef(i,j) > 1.0_DP ) xy_SurfHumidCoef(i,j) = 1.0_DP
end if
end do
end do
else
do j = 1, jmax
do i = 0, imax-1
if ( xy_FlagOceanGrid(i,j) ) 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.0_DP ) xy_SurfHumidCoef(i,j) = 1.0_DP
end if
end do
end do
end if
end subroutine BucketModHumidCoef
| Subroutine : | |
| ArgFlagSnow : | logical, intent(in) |
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 BucketModelInit( ArgFlagSnow )
!
! bucket_model モジュールの初期化を行います.
! NAMELIST#bucket_model_nml の読み込みはこの手続きで行われます.
!
! "bucket_model" module is initialized.
! "NAMELIST#bucket_model_nml" is loaded in this procedure.
!
! モジュール引用 ; USE statements
!
! 種別型パラメタ
! Kind type parameter
!
use dc_types, only: STDOUT ! 標準出力の装置番号. Unit number of standard output
! 文字列操作
! Character handling
!
use dc_string, only: StoA
! ファイル入出力補助
! File I/O support
!
use dc_iounit, only: FileOpen
! ヒストリデータ出力
! History data output
!
use gtool_historyauto, only: HistoryAutoAddVariable
! NAMELIST ファイル入力に関するユーティリティ
! Utilities for NAMELIST file input
!
use namelist_util, only: namelist_filename, NmlutilMsg, NmlutilAryValid
! 宣言文 ; Declaration statements
!
implicit none
logical, intent(in) :: ArgFlagSnow
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/ SoilMoistCritAmnt, SoilMoistCritAmntforEvapEff
! 実行文 ; Executable statement
!
if ( bucket_model_inited ) return
FlagSnow = ArgFlagSnow
! デフォルト値の設定
! Default values settings
!
! Values from Manabe (1969)
! Manabe, Climate and the ocean circulation I. The atmospheric circulation and
! the hydrology of the Earth's surface, Mon. Wea. Rev., 97, 739-774, 1969
!
SoilMoistCritAmnt = 1.0e3_DP * 0.15e0_DP
SoilMoistCritAmntforEvapEff = 1.0e3_DP * 0.15e0_DP * 0.75e0_DP
! 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
!!$ ! ヒストリデータ出力のためのへの変数登録
!!$ ! Register of variables for history data output
!!$ !
!!$ call HistoryAutoAddVariable( 'TempIncByFusion', &
!!$ & (/ 'lon ', 'lat ', 'time' /), &
!!$ & 'temperature increase by fusion', 'K' )
! 印字 ; Print
!
call MessageNotify( 'M', module_name, '----- Initialization Messages -----' )
call MessageNotify( 'M', module_name, ' SoilMoistCritAmnt = %f', d = (/ SoilMoistCritAmnt /) )
call MessageNotify( 'M', module_name, ' SoilMoistCritAmntforEvapEff = %f', d = (/ SoilMoistCritAmntforEvapEff /) )
call MessageNotify( 'M', module_name, ' FlagSnow = %y', l = (/ FlagSnow /) )
bucket_model_inited = .true.
end subroutine BucketModelInit
| Subroutine : | |
| xy_FlagOceanGrid( 0:imax-1, 1:jmax ) : | logical , intent(in ) |
| xy_SurfRainFlux( 0:imax-1, 1:jmax ) : | real(DP), intent(in ) |
| xy_SurfSnowFlux( 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 BucketPRCPAdjust( xy_FlagOceanGrid, xy_SurfRainFlux, xy_SurfSnowFlux, xy_SoilMoist, xy_SurfSnow )
! ヒストリデータ出力
! History data output
!
use gtool_historyauto, only: HistoryAutoPut
! 物理定数設定
! Physical constants settings
!
use constants, only: CpDry, Grav, LatentHeat, LatentHeatFusion
! $ L $ [J kg-1] .
! 融解の潜熱.
! Latent heat of fusion
! 時刻管理
! Time control
!
use timeset, only: TimeN, DelTime, TimesetClockStart, TimesetClockStop
! 格子点設定
! Grid points settings
!
use gridset, only: imax, jmax, kmax ! 鉛直層数.
! Number of vertical level
! 座標データ設定
! Axes data settings
!
use axesset, only: z_DelSigma
! $ \Delta \sigma $ (整数).
! $ \Delta \sigma $ (Full)
logical , intent(in ) :: xy_FlagOceanGrid( 0:imax-1, 1:jmax )
real(DP), intent(in ) :: xy_SurfRainFlux ( 0:imax-1, 1:jmax )
real(DP), intent(in ) :: xy_SurfSnowFlux ( 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_TempIncByFusion( 0:imax-1, 1:jmax )
!!$ ! Temperature increase by fusion
integer:: i ! 経度方向に回る DO ループ用作業変数
! Work variables for DO loop in longitude
integer:: j ! 緯度方向に回る DO ループ用作業変数
! Work variables for DO loop in latitude
! 初期化確認
! Initialization check
!
if ( .not. bucket_model_inited ) then
call MessageNotify( 'E', module_name, 'This module has not been initialized.' )
end if
! 計算時間計測開始
! Start measurement of computation time
!
call TimesetClockStart( module_name )
!!$ ! Initialize an array for temperature increase by fusion
!!$ !
!!$ xy_TempIncByFusion = 0.0d0
if ( FlagSnow ) then
! Precipitation is added to soil moisture or surface snow
!
do j = 1, jmax
do i = 0, imax-1
xy_SoilMoist(i,j) = xy_SoilMoist(i,j) + xy_SurfRainFlux(i,j) * 2.0_DP * DelTime
xy_SurfSnow (i,j) = xy_SurfSnow (i,j) + xy_SurfSnowFlux(i,j) * 2.0_DP * DelTime
end do
end do
else
! Precipitation is added to soil moisture
!
!!$ xy_SoilMoist = xy_SoilMoist + xy_SurfPRCPFlux * 2.0d0 * DelTime
xy_SoilMoist = xy_SoilMoist + ( xy_SurfRainFlux + xy_SurfSnowFlux ) * 2.0_DP * 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_FlagOceanGrid(i,j) ) then
xy_SoilMoist(i,j) = SoilMoistMeaningLess
xy_SurfSnow (i,j) = SoilMoistMeaningLess
end if
end do
end do
! ヒストリデータ出力
! History data output
!
!!$ call HistoryAutoPut( TimeN, 'TempIncByFusion' , xy_TempIncByFusion )
! 計算時間計測一時停止
! Pause measurement of computation time
!
call TimesetClockStop( module_name )
end subroutine BucketPRCPAdjust
| Subroutine : | |||
| xy_SurfType(0:imax-1, 1:jmax) : | integer , intent(in )
| ||
| xy_FlagOceanGrid(0:imax-1, 1:jmax) : | logical , intent(out)
|
Set flagx for ocean grid point from Matthews’ index
subroutine BucketSetFlagOceanFromMatthews( xy_SurfType, xy_FlagOceanGrid )
!
!
!
! Set flagx for ocean grid point from Matthews' index
!
! モジュール引用 ; USE statements
!
! 格子点設定
! Grid points settings
!
use gridset, only: imax, jmax, kmax ! 鉛直層数.
! Number of vertical level
! 宣言文 ; Declaration statements
!
implicit none
integer , intent(in ) :: xy_SurfType (0:imax-1, 1:jmax)
! 土地利用
! Surface index
logical , intent(out) :: xy_FlagOceanGrid(0:imax-1, 1:jmax)
!
! Flag for ocean grid
! 作業変数
! Work variables
!
integer:: i ! 経度方向に回る DO ループ用作業変数
! Work variables for DO loop in longitude
integer:: j ! 緯度方向に回る DO ループ用作業変数
! Work variables for DO loop in latitude
! 実行文 ; Executable statement
!
! 初期化確認
! Initialization check
!
if ( .not. bucket_model_inited ) then
call MessageNotify( 'E', module_name, 'This module has not been initialized.' )
end if
!
! Set index for calculation method
!
do j = 1, jmax
do i = 0, imax-1
if ( xy_SurfType(i,j) == 0 ) then
! ocean
xy_FlagOceanGrid(i,j) = .true.
else
! land
xy_FlagOceanGrid(i,j) = .false.
end if
end do
end do
end subroutine BucketSetFlagOceanFromMatthews
| Variable : | |||
| HumidCoefSnowThreshold = 1.0d-50 : | real(DP), save
|
| 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: $’ // ’$Id: bucket_model.f90,v 1.16 2015/01/29 12:07:59 yot Exp $’ : | character(*), parameter
|