subroutine ModAlbedoDueToSnowSeaIce( xy_SurfCond, xy_SurfMajCompIce, xy_SurfSnow, xy_SeaIceConc, xy_SurfAlbedo )
! 格子点設定
! 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: SnowThreshold => ThresholdSurfSnow, SnowAlbedo, SeaIceThreshold, SeaIceAlbedo, CO2IceThreshold, CO2IceAlbedoS, CO2IceAlbedoN
integer , intent(in ) :: xy_SurfCond ( 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(inout) :: xy_SurfAlbedo ( 0:imax-1, 1:jmax )
! 作業変数
! Work variables
!
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_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_SurfCond(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_SurfSnow ) ) then
! modify surface albedo on the snow covered ground
!
do j = 1, jmax
do i = 0, imax-1
!!$ if ( xy_SurfCond(i,j) > 0 .and. xy_SurfSnow(i,j) > SnowThreshold ) then
!!$ xy_SurfAlbedo(i,j) = SnowAlbedo
!!$ end if
!!$
if ( xy_SurfCond(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
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_SurfCond(i,j) == 0 .and. xy_SeaIceConc(i,j) > SeaIceThreshold ) then
xy_SurfAlbedo(i,j) = SeaIceAlbedo
end if
!!$ if ( xy_SurfCond(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
end subroutine ModAlbedoDueToSnowSeaIce