惑星表面特性を設定します.
Set surface properties.
subroutine SetSurfaceProperties( xy_SurfMajCompIceB, xy_SoilMoistB, xy_SurfSnowB, xy_SurfTemp, xy_SurfAlbedo, xy_SurfHumidCoef, xy_SurfRoughLenMom, xy_SurfRoughLenHeat, xy_SurfHeatCapacity, xy_DeepSubSurfHeatFlux, xy_SurfCond, xy_SurfType, xy_SurfHeight, xy_SurfHeightStd, xy_SeaIceConc, xy_SoilHeatCap, xy_SoilHeatDiffCoef )
!
! 惑星表面特性を設定します.
!
! Set surface properties.
!
! モジュール引用 ; USE statements
!
! 文字列操作
! Character handling
!
use dc_string, only: toChar
! gtool4 データ入力
! Gtool4 data input
!
use gtool_history, only: HistoryGet
! ヒストリデータ出力
! History data output
!
use gtool_historyauto, only: HistoryAutoPut
! 時系列データの読み込み
! Reading time series
!
use read_time_series, only: SetValuesFromTimeSeriesWrapper
! 時刻管理
! Time control
!
use timeset, only: TimeN, EndTime, TimesetClockStart, TimesetClockStop
! 地表面データ提供
! Prepare surface data
!
use surface_data, only: SetSurfData
!
! Routines for GABLS tests
!
use gabls, only : SetGabls2SurfTemp
! Matthews のデータに基づく惑星表面アルベド設定
! set surface albedo based on data by Matthews
!
use albedo_Matthews, only: SetAlbedoMatthews, ModAlbedoMatthewsCultivation
! バケツモデル
! Bucket model
!
use Bucket_Model, only : BucketSetFlagOceanFromMatthews, BucketModHumidCoef
! 雪と海氷によるアルベド変化
! modification of surface albedo on the snow covered ground and on the sea ice
!
use modify_albedo_snowseaice, only: ModAlbedoDueToSnowSeaIce
! アルベド, 粗度長の設定, 陸面と海洋の差のみ考慮
! Set albedo and roughness length, only considering land-ocean contrast
!
use surface_properties_lo, only: SetAlbedoLO, SetRoughLenLO
! Matthews のデータに基づく地面粗度の設定
! set roughness length on land surface based on data by Matthews
!
use roughlen_Matthews, only: SetRoughLenLandMatthews, ModRoughLenMatthewsCultivation
! 土壌熱伝導係数の設定
! set soil thermal diffusion coefficient
!
use soil_thermdiffcoef, only : SetSoilThermDiffCoefSimple
! 雪, 氷の割合
! snow/ice fraction
!
use snowice_frac, only : SeaIceAboveThreshold
! 宣言文 ; Declaration statements
!
real(DP), intent(in ), optional:: xy_SurfMajCompIceB(0:imax-1, 1:jmax)
! $ M_mcs (t-\Delta t) $ .
! Surface major component ice amount (kg m-2)
real(DP), intent(in ), optional:: xy_SoilMoistB(0:imax-1, 1:jmax)
! $ M_ws (t-\Delta t) $ . 土壌水分 (kg m-2)
! Soil moisture (kg m-2)
real(DP), intent(in ), optional:: xy_SurfSnowB(0:imax-1, 1:jmax)
! $ M_ss (t-\Delta t) $ . 積雪量 (kg m-2)
! Surface snow amount (kg m-2)
real(DP), intent(inout), optional:: xy_SurfTemp (0:imax-1, 1:jmax)
! 地表面温度.
! Surface temperature
real(DP), intent(inout), optional:: xy_SurfAlbedo (0:imax-1, 1:jmax)
! 地表アルベド.
! Surface albedo
real(DP), intent(inout), optional:: xy_SurfHumidCoef (0:imax-1, 1:jmax)
! 地表湿潤度.
! Surface humidity coefficient
real(DP), intent(inout), optional:: xy_SurfRoughLenMom (0:imax-1, 1:jmax)
! 地表粗度長.
! Surface rough length for momentum
real(DP), intent(inout), optional:: xy_SurfRoughLenHeat(0:imax-1, 1:jmax)
! 地表粗度長.
! Surface rough length for heat
real(DP), intent(inout), optional:: xy_SurfHeatCapacity (0:imax-1, 1:jmax)
! 地表熱容量.
! Surface heat capacity
real(DP), intent(inout), optional:: xy_DeepSubSurfHeatFlux (0:imax-1, 1:jmax)
! 地中熱フラックス.
! "Deep subsurface heat flux"
! Heat flux at the bottom of surface/soil layer.
integer , intent(inout), optional:: xy_SurfCond (0:imax-1, 1:jmax)
! 惑星表面状態 (0: 固定, 1: 可変).
! Surface condition (0: fixed, 1: variable)
integer , intent(inout), optional:: xy_SurfType (0:imax-1, 1:jmax)
! 惑星表面タイプ (土地利用)
! Surface type (land use)
real(DP), intent(inout), optional:: xy_SurfHeight (0:imax-1, 1:jmax)
! $ z_s $ . 地表面高度.
! Surface height.
real(DP), intent(inout), optional:: xy_SurfHeightStd(0:imax-1, 1:jmax)
! $ z_s $ . 地表面高度.
! Surface height.
real(DP), intent(inout), optional:: xy_SeaIceConc(0:imax-1,1:jmax)
! 海氷密度 (0 <= xy_SeaIceConc <= 1)
! Sea ice concentration (0 <= xy_SeaIceConc <= 1)
real(DP), intent(inout), optional:: xy_SoilHeatCap(0:imax-1,1:jmax)
! 土壌熱容量 (J K-1 kg-1)
! Specific heat of soil (J K-1 kg-1)
real(DP), intent(inout), optional:: xy_SoilHeatDiffCoef(0:imax-1,1:jmax)
! 土壌熱伝導率 (W m-1 K-1)
! Heat conduction coefficient of soil (W m-1 K-1)
! 作業変数
! Work variables
!
real(DP), allocatable, save:: xy_SurfTempSave (:,:)
! 地表面温度の保存値 (K)
! Saved values of surface temperature (K)
real(DP), allocatable, save:: xy_SeaIceConcSave(:,:)
! 海氷面密度の保存値
! Saved values of sea ice concentration
real(DP), allocatable, save:: xy_SurfAlbedoSave(:,:)
! アルベドの保存値
! Saved values of albedo
logical :: xy_BucketFlagOceanGrid(0:imax-1,1:jmax)
!
! Flag for ocean grid point used in bucket model
real(DP), allocatable, save:: xy_SurfCulIntSave(:,:)
real(DP) :: xy_SurfCulInt (0:imax-1,1:jmax)
!
! Surface cultivation intensity
logical, save:: flag_first_SurfCond = .true.
! 初回を示すフラグ.
! Flag that indicates first loop
!
logical, save:: flag_first_SurfType = .true.
logical, save:: flag_first_SurfCulInt = .true.
logical, save:: flag_first_SeaIceConc = .true.
logical, save:: flag_first_SurfTemp = .true.
logical, save:: flag_first_SurfHeight = .true.
logical, save:: flag_first_SurfHeightStd = .true.
logical, save:: flag_first_SurfAlbedo = .true.
logical, save:: flag_first_SurfHumidCoef = .true.
logical, save:: flag_first_SurfRoughLen = .true.
logical, save:: flag_first_SurfHeatCapacity = .true.
logical, save:: flag_first_DeepSubSurfHeatFlux = .true.
logical, save:: flag_first_SoilHeatCap = .true.
logical, save:: flag_first_SoilHeatDiffCoef = .true.
logical :: FlagSetSurfType
logical :: FlagSetSeaIceConc
logical :: FlagSetSurfCond
logical :: FlagSetSurfCulInt
logical :: FlagSetSurfTemp
logical :: FlagSetSurfHeight
logical :: FlagSetSurfHeightStd
logical :: FlagSetSurfAlbedo
logical :: FlagSetSurfHumidCoef
logical :: FlagSetSurfRoughLenMom
logical :: FlagSetSurfRoughLenHeat
logical :: FlagSetSurfHeatCapacity
logical :: FlagSetDeepSubSurfHeatFlux
logical :: FlagSetSoilHeatCap
logical :: FlagSetSoilHeatDiffCoef
logical:: flag_mpi_init
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. surface_properties_inited ) then
call MessageNotify( 'E', module_name, 'This module has not been initialized.' )
end if
! 計算時間計測開始
! Start measurement of computation time
!
call TimesetClockStart( module_name )
flag_mpi_init = .true.
FlagSetSurfType = .false.
FlagSetSeaIceConc = .false.
FlagSetSurfCond = .false.
FlagSetSurfCulInt = .false.
FlagSetSurfTemp = .false.
FlagSetSurfHeight = .false.
FlagSetSurfHeightStd = .false.
FlagSetSurfAlbedo = .false.
FlagSetSurfHumidCoef = .false.
FlagSetSurfRoughLenMom = .false.
FlagSetSurfRoughLenHeat = .false.
FlagSetSurfHeatCapacity = .false.
FlagSetDeepSubSurfHeatFlux = .false.
FlagSetSoilHeatCap = .false.
FlagSetSoilHeatDiffCoef = .false.
! NOTICE:
! The surface condition has to be set, before other fields are set.
!
! 惑星表面タイプ (土地利用)
! Surface type (land use)
!
if ( present(xy_SurfType) ) then
if ( SurfTypeSetting == 'file' ) then
! データをファイルから取得
! Data is input from files
!
if ( flag_first_SurfType ) then
call HistoryGet( SurfTypeFile, SurfTypeName, xy_SurfType, flag_mpi_split = flag_mpi_init ) ! (in) optional
end if
if ( SurfCondSetting /= 'generate_from_SurfType' ) then
call MessageNotify( 'E', module_name, " SurfCond has to be 'generate_from_SurfType', if SurfTypeSetting = %c.", c1 = trim(SurfTypeSetting) )
end if
else if ( SurfTypeSetting == 'generate_internally' ) then
! データ (デフォルト値) を surface_data モジュールから取得
! Data (default values) is input from "surface_data" module
!
if ( flag_first_SurfType ) then
call SetSurfData( xy_SurfType = xy_SurfType )
end if
else
call MessageNotify( 'E', module_name, ' SurfTypeSetting = %c is not appropriate.', c1 = trim(SurfTypeSetting) )
end if
FlagSetSurfType = .true.
flag_first_SurfType = .false.
end if
! NOTICE:
! The sea ice distribution has to be set,
! before set SurfTemp (surface temperature) and SurfCond.
!
! 海氷面密度
! Sea ice concentration
!
if ( present(xy_SeaIceConc) ) then
if ( flag_first_SeaIceConc ) then
! 保存用変数の割付
! Allocate a variable for save
!
allocate( xy_SeaIceConcSave(0:imax-1, 1:jmax) )
end if
if ( SeaIceSetting == 'file' ) then
! データをファイルから取得
! Data is input from files
!
! This will be deleted near future (yot, 2010/10/11)
!!$ if ( flag_first_SeaIceConc ) then
!!$ call HistoryGet( &
!!$ & SeaIceFile, SeaIceName, & ! (in)
!!$ & xy_SeaIceConcSave, & ! (out)
!!$ & flag_mpi_split = flag_mpi_init ) ! (in) optional
!!$ end if
call SetValuesFromTimeSeriesWrapper( 'SIC', SeaIceFile, SeaIceName, xy_SeaIceConcSave )
else if ( SeaIceSetting == 'generate_internally' ) then
! データ (デフォルト値) を surface_data モジュールから取得
! Data (default values) is input from "surface_data" module
!
if ( flag_first_SeaIceConc ) then
call SetSurfData( xy_SeaIceConc = xy_SeaIceConcSave )
end if
else
call MessageNotify( 'E', module_name, ' SeaIceSetting = %c is not appropriate.', c1 = trim(SeaIceSetting) )
end if
! 海氷面密度の設定 ( xy_SurfCond == 0 の場所のみ )
! Setting of sea ice concentration ( where xy_SurfCond == 0 only )
!
xy_SeaIceConc = xy_SeaIceConcSave
FlagSetSeaIceConc = .true.
flag_first_SeaIceConc = .false.
end if
! 惑星表面状態
! Surface condition
! Flag whether surface temperature is calculated or not
! 0 : surface temperature is not calculated
! 1 : surface temperature is calculated
!
if ( present(xy_SurfCond) ) then
! NOTICE:
! Before set SurfCond, SeaIceConc has to be set.
if ( .not. FlagSetSeaIceConc ) then
call MessageNotify( 'E', module_name, " SeaIceConc has to be set before setting SurfCond is set." )
end if
if ( SurfCondSetting == 'generate_from_SurfType' ) then
if ( flag_first_SurfCond ) then
!!$ if ( ( SurfTypeSetting /= 'file' ) .and. ( SurfTypeSetting /= 'generate_internally' ) ) then
!!$ call MessageNotify( 'E', module_name, &
!!$ & " SurfCond has to be 'generate_from_SurfType' or 'generate_internally', if SurfTypeSetting = %c.", &
!!$ & c1 = trim(SurfTypeSetting) )
!!$ end if
call MessageNotify( 'M', module_name, ' xy_SurfCond is constructed by use of xy_SurfType values because SurfTypeSetting = %c.', c1 = trim(SurfTypeSetting) )
end if
do j = 1, jmax
do i = 0, imax-1
if ( xy_SurfType(i,j) == 0 ) then
if ( SeaIceAboveThreshold( xy_SeaIceConc(i,j) ) ) then
xy_SurfCond(i,j) = 1
else if ( FlagSlabOcean ) then
xy_SurfCond(i,j) = 1
else
xy_SurfCond(i,j) = 0
end if
else
xy_SurfCond(i,j) = 1
end if
end do
end do
else if ( SurfCondSetting == 'file' ) then
! データをファイルから取得
! Data is input from files
!
if ( flag_first_SurfCond ) then
call HistoryGet( SurfCondFile, SurfCondName, xy_SurfCond, flag_mpi_split = flag_mpi_init ) ! (in) optional
end if
else if ( SurfCondSetting == 'generate_internally' ) then
! データ (デフォルト値) を surface_data モジュールから取得
! Data (default values) is input from "surface_data" module
!
if ( flag_first_SurfCond ) then
call SetSurfData( xy_SurfCond = xy_SurfCond )
end if
else
call MessageNotify( 'E', module_name, ' SurfCondSetting = %c is not appropriate.', c1 = trim(SurfCondSetting) )
end if
! Check of SurfCond values
!
do j = 1, jmax
do i = 0, imax-1
if ( ( xy_SurfCond(i,j) < 0 ) .or. ( xy_SurfCond(i,j) > 1 ) ) then
call MessageNotify( 'E', module_name, ' SurfCond value of %d is not appropriate.', i = (/ xy_SurfCond(i,j) /) )
end if
end do
end do
FlagSetSurfCond = .true.
flag_first_SurfCond = .false.
end if
!
! Surface cultivation index
!
! Cultivation intensity is set only when xy_SurfType is present.
if ( present( xy_SurfType ) ) then
! NOTICE:
! Before set SurfCulInt, SurfType has to be set.
if ( .not. FlagSetSurfType ) then
call MessageNotify( 'E', module_name, " SurfType has to be set before setting SurfCulInt is set." )
end if
if ( flag_first_SurfCulInt ) then
! 保存用変数の割付
! Allocate a variable for save
!
allocate( xy_SurfCulIntSave(0:imax-1, 1:jmax) )
end if
if ( SurfCulIntSetting == 'file' ) then
! データをファイルから取得
! Data is input from files
!
if ( SurfTypeSetting /= 'file' ) then
call MessageNotify( 'E', module_name, " SurfType has to be 'file', when SurfCulIntSetting = %c.", c1 = trim(SurfCulIntSetting) )
end if
call SetValuesFromTimeSeriesWrapper( 'CI', SurfCulIntFile, SurfCulIntName, xy_SurfCulIntSave )
else if ( SurfCulIntSetting == 'generate_internally' ) then
xy_SurfCulIntSave = 0.0_DP
else
call MessageNotify( 'E', module_name, ' SurfCulIntSetting = %c is not appropriate.', c1 = trim(SurfCulIntSetting) )
end if
!
xy_SurfCulInt = xy_SurfCulIntSave
FlagSetSurfCulInt = .true.
flag_first_SurfCulInt = .false.
else
xy_SurfCulInt = 0.0_DP
FlagSetSurfCulInt = .true.
end if
! 地表面温度
! surface temperature
!
if ( present(xy_SurfTemp) ) then
! NOTICE:
! Before set surface temperature, sea ice distribution has to be set.
if ( .not. FlagSetSeaIceConc ) then
call MessageNotify( 'E', module_name, " SeaIceConc has to be set before setting SurfTemp is set." )
end if
if ( flag_first_SurfTemp ) then
! 保存用変数の割付
! Allocate a variable for save
!
allocate( xy_SurfTempSave (0:imax-1, 1:jmax) )
end if
if ( SurfTempSetting == 'file' ) then
! データをファイルから取得
! Data is input from files
!
! This will be deleted near future (yot, 2010/10/11)
!!$ if ( flag_first_SurfTemp ) then
!!$ call HistoryGet( &
!!$ & SurfTempFile, SurfTempName, & ! (in)
!!$ & xy_SurfTempSave, & ! (out)
!!$ & flag_mpi_split = flag_mpi_init ) ! (in) optional
!!$ end if
call SetValuesFromTimeSeriesWrapper( 'SST', SurfTempFile, SurfTempName, xy_SurfTempSave )
else if ( SurfTempSetting == 'GABLS2' ) then
!
! Routines for GABLS tests
!
call SetGabls2SurfTemp( xy_SurfTempSave )
else if ( SurfTempSetting == 'generate_internally' ) then
! データ (デフォルト値) を surface_data モジュールから取得
! Data (default values) is input from "surface_data" module
!
if ( flag_first_SurfTemp ) then
call SetSurfData( xy_SurfTemp = xy_SurfTempSave )
end if
else
call MessageNotify( 'E', module_name, ' SurfTempSetting = %c is not appropriate.', c1 = trim(SurfTempSetting) )
end if
! 地表面温度を SST で置き換え ( xy_SurfCond <=0 の場所のみ )
! Surface temperature is replaced with SST ( only xy_SurfCond <=0 )
!
if ( present(xy_SurfTemp) ) then
if ( .not. present( xy_SurfCond ) ) then
call MessageNotify( 'E', module_name, ' xy_SurfCond has to be present to set xy_SurfTemp.' )
end if
if ( .not. present( xy_SeaIceConc ) ) then
call MessageNotify( 'E', module_name, ' xy_SeaIceConc has to be present to set xy_SurfTemp.' )
end if
do j = 1, jmax
do i = 0, imax-1
if ( xy_SurfCond(i,j) == 0 ) then
xy_SurfTemp(i,j) = xy_SurfTempSave(i,j)
end if
end do
end do
end if
FlagSetSurfTemp = .true.
flag_first_SurfTemp = .false.
end if
! 地形
! Topography
!
if ( present(xy_SurfHeight) ) then
if ( SurfHeightSetting == 'file' ) then
! データをファイルから取得
! Data is input from files
!
if ( flag_first_SurfHeight ) then
call HistoryGet( SurfHeightFile, SurfHeightName, xy_SurfHeight, flag_mpi_split = flag_mpi_init ) ! (in) optional
end if
else if ( SurfHeightSetting == 'generate_internally' ) then
if ( flag_first_SurfHeight ) then
xy_SurfHeight = 0.0_DP
end if
else
call MessageNotify( 'E', module_name, ' SurfHeightSetting = %c is not appropriate.', c1 = trim(SurfHeightSetting) )
end if
FlagSetSurfHeight = .true.
flag_first_SurfHeight = .false.
end if
!
! Surface height standard deviation
!
if ( present(xy_SurfHeightStd) ) then
if ( SurfHeightStdSetting == 'file' ) then
! データをファイルから取得
! Data is input from files
!
if ( flag_first_SurfHeightStd ) then
call HistoryGet( SurfHeightStdFile, SurfHeightStdName, xy_SurfHeightStd, flag_mpi_split = flag_mpi_init ) ! (in) optional
end if
else if ( SurfHeightStdSetting == 'generate_internally' ) then
! データ (デフォルト値) を surface_data モジュールから取得
! Data (default values) is input from "surface_data" module
!
if ( flag_first_SurfHeightStd ) then
call SetSurfData( xy_SurfHeightStd = xy_SurfHeightStd )
end if
else
call MessageNotify( 'E', module_name, ' SurfHeightStdSetting = %c is not appropriate.', c1 = trim(SurfHeightStdSetting) )
end if
FlagSetSurfHeightStd = .true.
flag_first_SurfHeightStd = .false.
end if
! アルベド
! Albedo
!
if ( present(xy_SurfAlbedo) ) then
! NOTICE:
! The surface condition and sea ice concentration have to be set,
! before albedo is set.
if ( ( .not. FlagSetSurfCond ) .or. ( .not. FlagSetSeaIceConc ) ) then
call MessageNotify( 'E', module_name, " SurfCond and SeaIceConc have to be set before setting SurfAlbedo is set." )
end if
if ( flag_first_SurfAlbedo ) then
! 保存用変数の割付
! Allocate a variable for save
!
allocate( xy_SurfAlbedoSave(0:imax-1, 1:jmax) )
end if
if ( AlbedoSetting == 'file' ) then
! データをファイルから取得
! Data is input from files
!
if ( flag_first_SurfAlbedo ) then
call HistoryGet( AlbedoFile, AlbedoName, xy_SurfAlbedoSave, flag_mpi_split = flag_mpi_init ) ! (in) optional
end if
!!$ call SetValuesFromTimeSeriesWrapper( &
!!$ & 'surface_albedo', &
!!$ & AlbedoFile, AlbedoName, &
!!$ & xy_SurfAlbedoSave & ! (inout)
!!$ & )
else if ( AlbedoSetting == 'Matthews' ) then
! アルベドを Matthews のデータをもとに設定
! Surface albedo is set based on Matthews' data
!
if ( .not. present( xy_SurfType ) ) then
call MessageNotify( 'E', module_name, ' xy_SurfType has to be present to set xy_SurfAlbedo.' )
end if
if ( SurfTypeSetting /= 'file' ) then
call MessageNotify( 'E', module_name, " SurfType has to be 'file', when AlbedoSetting = %c.", c1 = trim(AlbedoSetting) )
end if
call SetAlbedoMatthews( xy_SurfType, xy_SurfAlbedoSave )
! Modify albedo due to cultivation
call ModAlbedoMatthewsCultivation( xy_SurfType, xy_SurfCulInt, xy_SurfAlbedoSave )
else if ( AlbedoSetting == 'LOContrast' ) then
! アルベドの設定, 陸面と海洋の差のみ考慮
! Set albedo, only considering land-ocean contrast
!
if ( .not. present( xy_SurfType ) ) then
call MessageNotify( 'E', module_name, ' xy_SurfType has to be present to set xy_SurfAlbedo.' )
end if
if ( SurfTypeSetting /= 'file' ) then
call MessageNotify( 'E', module_name, " SurfType has to be 'file', when AlbedoSetting = %c.", c1 = trim(AlbedoSetting) )
end if
call SetAlbedoLO( xy_SurfType, xy_SurfAlbedoSave )
else if ( AlbedoSetting == 'generate_internally' ) then
! データ (デフォルト値) を surface_data モジュールから取得
! Data (default values) is input from "surface_data" module
!
if ( flag_first_SurfAlbedo ) then
call SetSurfData( xy_SurfAlbedo = xy_SurfAlbedoSave )
end if
else
call MessageNotify( 'E', module_name, ' AlbedoSetting = %c is not appropriate.', c1 = trim(AlbedoSetting) )
end if
! アルベドの設定
! Setting of albedo
!
xy_SurfAlbedo = xy_SurfAlbedoSave
if ( present( xy_SurfType ) ) then
! 雪と海氷によるアルベド変化
! modification of surface albedo on the snow covered ground and on the sea ice
!
if ( .not. present( xy_SurfMajCompIceB ) ) then
call MessageNotify( 'E', module_name, ' xy_SurfMajCompIceB has to be present to set xy_SurfAlbedo.' )
end if
if ( .not. present( xy_SurfSnowB ) ) then
call MessageNotify( 'E', module_name, ' xy_SurfSnowB has to be present to set xy_SurfAlbedo.' )
end if
if ( .not. present( xy_SeaIceConc ) ) then
call MessageNotify( 'E', module_name, ' xy_SeaIceConc has to be present to set xy_SurfAlbedo.' )
end if
if ( .not. present( xy_SurfType ) ) then
call MessageNotify( 'E', module_name, ' xy_SurfType has to be present to set xy_SurfAlbedo.' )
end if
!!$ if ( SurfTypeSetting /= 'file' ) then
!!$ call MessageNotify( 'E', module_name, &
!!$ & " SurfType has to be 'file'." )
!!$ end if
call ModAlbedoDueToSnowSeaIce( xy_SurfType, xy_SurfMajCompIceB, xy_SurfSnowB, xy_SeaIceConc, xy_SurfAlbedo )
else
call MessageNotify( 'E', module_name, ' xy_SurfType has to be present to modify albedo due to snow and sea ice.' )
end if
FlagSetSurfAlbedo = .true.
flag_first_SurfAlbedo = .false.
end if
! 惑星表面湿潤度
! Surface humidity coefficient
!
if ( present(xy_SurfHumidCoef) ) then
! NOTICE:
! The surface condition has to be set, before humidity coefficient
! is set.
if ( .not. FlagSetSurfCond ) then
call MessageNotify( 'E', module_name, " SurfCond has to be set before setting SurfHumidCoef is set." )
end if
if ( HumidCoefSetting == 'file' ) then
! データをファイルから取得
! Data is input from files
!
if ( flag_first_SurfHumidCoef ) then
call HistoryGet( HumidcoefFile, HumidcoefName, xy_SurfHumidcoef, flag_mpi_split = flag_mpi_init ) ! (in) optional
end if
else if ( HumidCoefSetting == 'generate_internally' ) then
! データ (デフォルト値) を surface_data モジュールから取得
! Data (default values) is input from "surface_data" module
!
if ( flag_first_SurfHumidCoef ) then
call SetSurfData( xy_SurfHumidCoef = xy_SurfHumidCoef )
end if
else
call MessageNotify( 'E', module_name, ' HumidCoefSetting = %c is not appropriate.', c1 = trim(HumidCoefSetting) )
end if
if ( FlagUseBucket ) then
if ( ( present( xy_SurfType ) ) .and. ( present( xy_SoilMoistB ) ) .and. ( present( xy_SurfSnowB ) ) ) then
! バケツモデルに関わる地表面湿潤度の設定
! Setting of surface humidity coefficient
!
call BucketSetFlagOceanFromMatthews( xy_SurfType, xy_BucketFlagOceanGrid )
call BucketModHumidCoef( xy_BucketFlagOceanGrid, xy_SoilMoistB, xy_SurfSnowB, xy_SurfHumidCoef )
else
call MessageNotify( 'E', module_name, ' xy_SurfType, xy_SoilMoistB and xy_SurfSnowB have to be present to modify humidity coefficient with bucket model.' )
end if
end if
FlagSetSurfHumidCoef = .true.
flag_first_SurfHumidCoef = .false.
end if
! 粗度長
! Roughness length
!
if ( present(xy_SurfRoughLenMom) ) then
if ( .not. present(xy_SurfRoughLenHeat) ) then
call MessageNotify( 'E', module_name, ' xy_SurfRoughLenHeat has to be present if xy_SurfRoughLenMom is present.' )
end if
else
if ( present(xy_SurfRoughLenHeat) ) then
call MessageNotify( 'E', module_name, ' xy_SurfRoughLenMom has to be present if xy_SurfRoughLenHeat is present.' )
end if
end if
if ( present(xy_SurfRoughLenMom) .and. present(xy_SurfRoughLenHeat) ) then
if ( RoughLengthSetting == 'file' ) then
! データをファイルから取得
! Data is input from files
!
if ( flag_first_SurfRoughLen ) then
call HistoryGet( RoughLengthFile, RoughLengthName, xy_SurfRoughLenMom, flag_mpi_split = flag_mpi_init ) ! (in) optional
! set roughness length for heat
xy_SurfRoughLenHeat = xy_SurfRoughLenMom * RoughLenHeatFactor
end if
else if ( RoughLengthSetting == 'LOContrast' ) then
! 粗度長の設定, 陸面と海洋の差のみ考慮
! Set roughness length, only considering land-ocean contrast
!
if ( .not. present( xy_SurfType ) ) then
call MessageNotify( 'E', module_name, ' xy_SurfType has to be present to set xy_SurfAlbedo.' )
end if
if ( SurfTypeSetting /= 'file' ) then
call MessageNotify( 'E', module_name, " SurfType has to be 'file', when RoughLengthSetting = %c.", c1 = trim(RoughLengthSetting) )
end if
call SetRoughLenLO( xy_SurfType, xy_SurfRoughLenMom )
! set roughness length for heat
xy_SurfRoughLenHeat = xy_SurfRoughLenMom * RoughLenHeatFactor
else if ( RoughLengthSetting == 'Matthews' ) then
! 粗度長の設定, Matthews のデータに基づく
! Set roughness length based on Matthews dataset
!
if ( .not. FlagSetSurfType ) then
call MessageNotify( 'E', module_name, ' xy_SurfType has to be set to set xy_SurfRoughLenMom.' )
end if
if ( SurfTypeSetting /= 'file' ) then
call MessageNotify( 'E', module_name, " SurfType has to be 'file', when RoughLengthSetting = %c.", c1 = trim(RoughLengthSetting) )
end if
call SetRoughLenLandMatthews( "Mom", xy_SurfType, xy_SurfRoughLenMom )
! Modify albedo due to cultivation
call ModRoughLenMatthewsCultivation( "Mom", xy_SurfType, xy_SurfCulInt, xy_SurfRoughLenMom )
! set roughness length for heat
call SetRoughLenLandMatthews( "Heat", xy_SurfType, xy_SurfRoughLenHeat )
! Modify albedo due to cultivation
call ModRoughLenMatthewsCultivation( "Heat", xy_SurfType, xy_SurfCulInt, xy_SurfRoughLenHeat )
else if ( RoughLengthSetting == 'generate_internally' ) then
! データ (デフォルト値) を surface_data モジュールから取得
! Data (default values) is input from "surface_data" module
!
if ( flag_first_SurfRoughLen ) then
call SetSurfData( xy_SurfRoughLength = xy_SurfRoughLenMom )
! set roughness length for heat
xy_SurfRoughLenHeat = xy_SurfRoughLenMom * RoughLenHeatFactor
end if
else
call MessageNotify( 'E', module_name, ' RoughLengthSetting = %c is not appropriate.', c1 = trim(RoughLengthSetting) )
end if
FlagSetSurfRoughLenMom = .true.
FlagSetSurfRoughLenHeat = .true.
flag_first_SurfRoughLen = .false.
end if
! 地表熱容量
! Surface heat capacity
!
if ( present(xy_SurfHeatCapacity) ) then
if ( HeatCapacitySetting == 'file' ) then
! データをファイルから取得
! Data is input from files
!
if ( flag_first_SurfHeatCapacity ) then
call HistoryGet( HeatCapacityFile, HeatCapacityName, xy_SurfHeatCapacity, flag_mpi_split = flag_mpi_init ) ! (in) optional
end if
else if ( HeatCapacitySetting == 'generate_internally' ) then
! データ (デフォルト値) を surface_data モジュールから取得
! Data (default values) is input from "surface_data" module
!
if ( flag_first_SurfHeatCapacity ) then
call SetSurfData( xy_SurfHeatCapacity = xy_SurfHeatCapacity )
end if
else
call MessageNotify( 'E', module_name, ' HeatCapacitySetting = %c is not appropriate.', c1 = trim(HeatCapacitySetting) )
end if
FlagSetSurfHeatCapacity = .true.
flag_first_SurfHeatCapacity = .false.
end if
! 地中熱フラックス
! Ground temperature flux
!
if ( present(xy_DeepSubSurfHeatFlux) ) then
if ( TempFluxSetting == 'file' ) then
! データをファイルから取得
! Data is input from files
!
if ( flag_first_DeepSubSurfHeatFlux ) then
call HistoryGet( TempFluxFile, TempFluxName, xy_DeepSubSurfHeatFlux, flag_mpi_split = flag_mpi_init ) ! (in) optional
end if
else if ( TempFluxSetting == 'generate_internally' ) then
! データ (デフォルト値) を surface_data モジュールから取得
! Data (default values) is input from "surface_data" module
!
if ( flag_first_DeepSubSurfHeatFlux ) then
call SetSurfData( xy_DeepSubSurfHeatFlux = xy_DeepSubSurfHeatFlux )
end if
else
call MessageNotify( 'E', module_name, ' TempFluxSetting = %c is not appropriate.', c1 = trim(TempFluxSetting) )
end if
FlagSetDeepSubSurfHeatFlux = .true.
flag_first_DeepSubSurfHeatFlux = .false.
end if
! 土壌熱容量 (J K-1 kg-1)
! Specific heat of soil (J K-1 kg-1)
!
if ( present(xy_SoilHeatCap) ) then
if ( SoilHeatCapSetting == 'file' ) then
! データをファイルから取得
! Data is input from files
!
if ( flag_first_SoilHeatCap ) then
call HistoryGet( SoilHeatCapFile, SoilHeatCapName, xy_SoilHeatCap, flag_mpi_split = flag_mpi_init ) ! (in) optional
end if
else if ( SoilHeatCapSetting == 'generate_internally' ) then
! データ (デフォルト値) を surface_data モジュールから取得
! Data (default values) is input from "surface_data" module
!
if ( flag_first_SoilHeatCap ) then
call SetSurfData( xy_SoilHeatCap = xy_SoilHeatCap )
end if
else
call MessageNotify( 'E', module_name, ' SoilHeatCapSetting = %c is not appropriate.', c1 = trim(SoilHeatCapSetting) )
end if
FlagSetSoilHeatCap = .true.
flag_first_SoilHeatCap = .false.
end if
! 土壌熱伝導率 (W m-1 K-1)
! Heat conduction coefficient of soil (W m-1 K-1)
!
if ( present(xy_SoilHeatDiffCoef) ) then
if ( SoilHeatDiffCoefSetting == 'file' ) then
! データをファイルから取得
! Data is input from files
!
if ( flag_first_SoilHeatDiffCoef ) then
call HistoryGet( SoilHeatDiffCoefFile, SoilHeatDiffCoefName, xy_SoilHeatDiffCoef, flag_mpi_split = flag_mpi_init ) ! (in) optional
end if
else if ( SoilHeatDiffCoefSetting == 'file_thermal_inertia' ) then
! データをファイルから取得
! Data is input from files
!
if ( flag_first_SoilHeatDiffCoef ) then
call HistoryGet( SoilHeatDiffCoefFile, SoilHeatDiffCoefName, xy_SoilHeatDiffCoef, flag_mpi_split = flag_mpi_init ) ! (in) optional
if ( present( xy_SoilHeatCap ) ) then
xy_SoilHeatDiffCoef = xy_SoilHeatDiffCoef**2 / xy_SoilHeatCap
else
call MessageNotify( 'E', module_name, ' xy_SoilHeatCap has to be present to calculate heat diffusion coefficient of soil from thermal inertia.' )
end if
end if
else if ( SoilHeatDiffCoefSetting == 'generate_internally' ) then
! データ (デフォルト値) を surface_data モジュールから取得
! Data (default values) is input from "surface_data" module
!
if ( flag_first_SoilHeatDiffCoef ) then
call SetSurfData( xy_SoilHeatDiffCoef = xy_SoilHeatDiffCoef )
end if
else if ( SoilHeatDiffCoefSetting == 'simple' ) then
if ( .not. FlagUseBucket ) then
call MessageNotify( 'E', module_name, ' FlagUseBucket has to be .true. to set soil thermal diffusion coefficient.' )
end if
if ( ( FlagSetSurfType ) .and. ( present( xy_SoilMoistB ) ) ) then
! 土壌熱伝導係数の設定
! set soil thermal diffusion coefficient
!
call SetSoilThermDiffCoefSimple( xy_SurfType, xy_SoilMoistB, xy_SoilHeatDiffCoef )
else
call MessageNotify( 'E', module_name, ' xy_SurfType and xy_SoilMoistB have to be present to set soil thermal diffusion coefficient.' )
end if
else
call MessageNotify( 'E', module_name, ' SoilHeatDiffCoefSetting = %c is not appropriate.', c1 = trim(TempFluxSetting) )
end if
FlagSetSoilHeatDiffCoef = .true.
flag_first_SoilHeatDiffCoef = .false.
end if
! ヒストリデータ出力
! History data output
!
call HistoryAutoPut( TimeN, 'SurfCulInt', xy_SurfCulInt )
! 計算時間計測一時停止
! Pause measurement of computation time
!
call TimesetClockStop( module_name )
end subroutine SetSurfaceProperties