subroutine ModAlbedoDueToSnowSeaIce( xy_SurfType, xy_SurfMajCompIce, xy_SurfSnow, xy_SeaIceConc, xy_SOSeaIceMass, 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
! 雪, 氷の割合
! 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(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_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
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
end subroutine ModAlbedoDueToSnowSeaIce