| Class | modify_albedo_snowseaice |
| In: |
surface_properties/modify_albedo_snowseaice.f90
|
| Subroutine : | |
| xy_SurfType( 0:imax-1, 1:jmax ) : | integer , intent(in ) |
| xy_SurfMajCompIce( 0:imax-1, 1:jmax ) : | real(DP), intent(in ), optional |
| xy_SurfSnow( 0:imax-1, 1:jmax ) : | real(DP), intent(in ), optional |
| xy_SeaIceConc( 0:imax-1, 1:jmax ) : | real(DP), intent(in ), optional |
| xy_SOSeaIceMass( 0:imax-1, 1:jmax ) : | real(DP), intent(in ), optional |
| xy_SurfTemp( 0:imax-1, 1:jmax ) : | real(DP), intent(in ), optional |
| xy_SurfAlbedo( 0:imax-1, 1:jmax ) : | real(DP), intent(inout) |
subroutine ModAlbedoDueToSnowSeaIce( xy_SurfType, xy_SurfMajCompIce, xy_SurfSnow, xy_SeaIceConc, xy_SOSeaIceMass, xy_SurfTemp, xy_SurfAlbedo )
! モジュール引用 ; USE statements
!
! 格子点設定
! Grid points settings
!
use gridset, only: imax, jmax, kmax ! 鉛直層数.
! Number of vertical level
! 座標データ設定
! Axes data settings
!
use axesset, only: y_Lat
! 雪と海氷の定数の設定
! Setting constants of snow and sea ice
!
use constants_snowseaice, only: SnowAlbedo, SeaIceAlbedo, SOSeaIceThresholdMass, CO2IceThreshold, CO2IceAlbedoS, CO2IceAlbedoN, TempBelowSeaIce
! 雪, 氷の割合
! snow/ice fraction
!
use snowice_frac, only : CalcSnowFrac
! 雪, 氷の割合
! snow/ice fraction
!
use snowice_frac, only : SeaIceAboveThreshold
integer , intent(in ) :: xy_SurfType ( 0:imax-1, 1:jmax )
real(DP), intent(in ), optional :: xy_SurfMajCompIce( 0:imax-1, 1:jmax )
real(DP), intent(in ), optional :: xy_SurfSnow ( 0:imax-1, 1:jmax )
real(DP), intent(in ), optional :: xy_SeaIceConc ( 0:imax-1, 1:jmax )
real(DP), intent(in ), optional :: xy_SOSeaIceMass ( 0:imax-1, 1:jmax )
real(DP), intent(in ), optional :: xy_SurfTemp ( 0:imax-1, 1:jmax )
real(DP), intent(inout) :: xy_SurfAlbedo ( 0:imax-1, 1:jmax )
! 作業変数
! Work variables
!
real(DP):: xy_SnowFrac(0:imax-1, 1:jmax)
real(DP):: MajCompIceThreshold
real(DP):: MajCompIceAlbedo
integer:: i ! 経度方向に回る DO ループ用作業変数
! Work variables for DO loop in longitude
integer:: j ! 緯度方向に回る DO ループ用作業変数
! Work variables for DO loop in latitude
! 初期化確認
! Initialization check
!
if ( .not. modify_albedo_snowseaice_inited ) then
call MessageNotify( 'E', module_name, 'This module has not been initialized.' )
end if
if ( present( xy_SeaIceConc ) ) then
! modify surface albedo on the sea ice
!
do j = 1, jmax
do i = 0, imax-1
if ( ( xy_SurfType(i,j) == 0 ) .and. SeaIceAboveThreshold( xy_SeaIceConc(i,j) ) ) then
xy_SurfAlbedo(i,j) = SeaIceAlbedo
end if
!!$ if ( xy_SurfType(i,j) == 0 ) then
!!$ if ( xy_SeaIceConc(i,j) > 1.0_DP ) then
!!$! call MessageNotify( 'E', module_name, &
!!$! & 'The value of SeaIceConc is inappropriate, %f.', &
!!$! & d = (/ xy_SeaIceConc(i,j) / ) )
!!$ xy_SurfAlbedo(i,j) = SeaIceAlbedo
!!$ else if ( xy_SeaIceConc(i,j) < 0.0_DP ) then
!!$! call MessageNotify( 'E', module_name, &
!!$! & 'The value of SeaIceConc is inappropriate, %f.', &
!!$! & d = (/ xy_SeaIceConc(i,j) / ) )
!!$ xy_SurfAlbedo(i,j) = xy_SurfAlbedo(i,j)
!!$ else
!!$ xy_SurfAlbedo(i,j) = &
!!$ & ( SeaIceAlbedo - xy_SurfAlbedo(i,j) ) / ( 1.0_DP - 0.0_DP ) &
!!$ & * ( xy_SeaIceConc(i,j) - 0.0_DP ) &
!!$ & + xy_SurfAlbedo(i,j)
!!$ end if
!!$ end if
end do
end do
end if
if ( present( xy_SOSeaIceMass ) ) then
! modify surface albedo on slab sea ice
!
do j = 1, jmax
do i = 0, imax-1
if ( xy_SurfType(i,j) == 0 ) then
if ( xy_SOSeaIceMass(i,j) >= SOSeaIceThresholdMass ) then
xy_SurfAlbedo(i,j) = SeaIceAlbedo
end if
end if
end do
end do
end if
if ( FlagModAlbedoBasedOnTemp ) then
! modify surface albedo on slab sea ice dependent on temperature
!
if ( .not. present( xy_SurfTemp ) ) then
call MessageNotify( 'E', module_name, ' xy_SurfTemp has to be included arguments when FlagModAlbedoBaseOnTemp is true.' )
end if
do j = 1, jmax
do i = 0, imax-1
if ( xy_SurfType(i,j) == 0 ) then
if ( xy_SurfTemp(i,j) <= TempBelowSeaIce ) then
xy_SurfAlbedo(i,j) = SeaIceAlbedo
end if
end if
end do
end do
end if
if ( present( xy_SurfSnow ) ) then
! 雪, 氷の割合
! snow/ice fraction
!
call CalcSnowFrac( xy_SurfSnow, xy_SnowFrac )
! modify surface albedo on the snow covered ground
!
do j = 1, jmax
do i = 0, imax-1
!!$ if ( xy_SurfType(i,j) > 0 .and. xy_SurfSnow(i,j) > SnowThreshold ) then
!!$ xy_SurfAlbedo(i,j) = SnowAlbedo
!!$ end if
!!$
if ( xy_SurfType(i,j) > 0 ) then
!!$ if ( xy_SurfSnow(i,j) > SnowThreshold ) then
!!$ xy_SurfAlbedo(i,j) = SnowAlbedo
!!$ else if ( xy_SurfSnow(i,j) < 0.0_DP ) then
!!$ xy_SurfAlbedo(i,j) = xy_SurfAlbedo(i,j)
!!$ else
!!$ xy_SurfAlbedo(i,j) = &
!!$ & ( SnowAlbedo - xy_SurfAlbedo(i,j) ) / ( SnowThreshold - 0.0_DP ) &
!!$ & * ( xy_SurfSnow(i,j) - 0.0_DP ) &
!!$ & + xy_SurfAlbedo(i,j)
!!$ end if
xy_SurfAlbedo(i,j) = ( 1.0_DP - xy_SnowFrac(i,j) ) * xy_SurfAlbedo(i,j) + xy_SnowFrac(i,j) * SnowAlbedo
end if
end do
end do
end if
if ( present( xy_SurfMajCompIce ) ) then
! modify surface albedo on the major component ice covered ground
!
MajCompIceThreshold = CO2IceThreshold
do j = 1, jmax
if ( y_Lat(j) < 0.0_DP ) then
MajCompIceAlbedo = CO2IceAlbedoS
else
MajCompIceAlbedo = CO2IceAlbedoN
end if
do i = 0, imax-1
!!$ if ( xy_SurfCond(i,j) > 0 .and. xy_SurfMajCompIce(i,j) > MajCompIceThreshold ) then
!!$ xy_SurfAlbedo(i,j) = MajCompIceAlbedo
!!$ end if
if ( xy_SurfType(i,j) > 0 ) then
if ( xy_SurfMajCompIce(i,j) > MajCompIceThreshold ) then
xy_SurfAlbedo(i,j) = MajCompIceAlbedo
else if ( xy_SurfMajCompIce(i,j) < 0.0_DP ) then
xy_SurfAlbedo(i,j) = xy_SurfAlbedo(i,j)
else
xy_SurfAlbedo(i,j) = ( MajCompIceAlbedo - xy_SurfAlbedo(i,j) ) / ( MajCompIceThreshold - 0.0_DP ) * ( xy_SurfMajCompIce(i,j) - 0.0_DP ) + xy_SurfAlbedo(i,j)
end if
end if
end do
end do
end if
end subroutine ModAlbedoDueToSnowSeaIce
| Subroutine : |
This procedure input/output NAMELIST#modify_albedo_snowseaice_nml .
subroutine ModAlbedoSnowSeaIceInit
! モジュール引用 ; USE statements
!
! NAMELIST ファイル入力に関するユーティリティ
! Utilities for NAMELIST file input
!
use namelist_util, only: namelist_filename, NmlutilMsg
! ファイル入出力補助
! File I/O support
!
use dc_iounit, only: FileOpen
! 種別型パラメタ
! Kind type parameter
!
use dc_types, only: STDOUT ! 標準出力の装置番号. Unit number of standard output
! メッセージ出力
! Message output
!
use dc_message, only: MessageNotify
! 雪, 氷の割合
! snow/ice fraction
!
use snowice_frac, only : SnowIceFracInit
! 宣言文 ; 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 /modify_albedo_snowseaice_nml/ FlagModAlbedoBasedOnTemp
!
! デフォルト値については初期化手続 "modify_albedo_snowseaice#ModAlbedoSnowSeaIceInit"
! のソースコードを参照のこと.
!
! Refer to source codes in the initialization procedure
! "modify_albedo_snowseaice#ModAlbedoSnowSeaIceInit" for the default values.
!
! 実行文 ; Executable statement
!
if ( modify_albedo_snowseaice_inited ) return
! デフォルト値の設定
! Default values settings
!
FlagModAlbedoBasedOnTemp = .false.
! NAMELIST からの入力
! Input from NAMELIST
!
if ( trim(namelist_filename) /= '' ) then
call FileOpen( unit_nml, namelist_filename, mode = 'r' ) ! (in)
rewind( unit_nml )
read( unit_nml, nml = modify_albedo_snowseaice_nml, iostat = iostat_nml ) ! (out)
close( unit_nml )
call NmlutilMsg( iostat_nml, module_name ) ! (in)
if ( iostat_nml == 0 ) write( STDOUT, nml = modify_albedo_snowseaice_nml )
end if
! 雪, 氷の割合
! snow/ice fraction
!
call SnowIceFracInit
! 印字 ; Print
!
call MessageNotify( 'M', module_name, '----- Initialization Messages -----' )
call MessageNotify( 'M', module_name, ' FlagModAlbedoBaseOnTemp = %b', l = (/ FlagModAlbedoBasedOnTemp /) )
call MessageNotify( 'M', module_name, '-- version = %c', c1 = trim(version) )
modify_albedo_snowseaice_inited = .true.
end subroutine ModAlbedoSnowSeaIceInit
| Variable : | |||
| modify_albedo_snowseaice_inited = .false. : | logical, save
|
| Constant : | |||
| module_name = ‘modify_albedo_snowseaice‘ : | character(*), parameter
|
| Constant : | |||
| version = ’$Name: $’ // ’$Id: modify_albedo_snowseaice.f90,v 1.6 2015/01/29 12:08:40 yot Exp $’ : | character(*), parameter
|