| Class | albedo_Matthews |
| In: |
surface_properties/albedo_Matthews.f90
|
| Subroutine : |
This procedure input/output NAMELIST#albedo_Matthews_nml .
subroutine AlbedoMatthewsInit
! NAMELIST ���¡ã�¤ã���¥å�����¢ã�������¼ã���£ã������
! Utilities for NAMELIST file input
!
use namelist_util, only: namelist_filename, NmlutilMsg, NmlutilAryValid
! ���¡ã�¤ã���¥å�ºå��è£���
! File I/O support
!
use dc_iounit, only: FileOpen
! �¡ã���»ã�¼ã�¸å�ºå��
! Message output
!
use dc_message, only: MessageNotify
! ä½�æ¥å���
! Work variables
!
integer:: unit_nml ! NAMELIST ���¡ã�¤ã�����¼ã���³ç���ç½����.
! Unit number for NAMELIST file open
integer:: iostat_nml ! NAMELIST èªã�¿è¾¼�¿æ���� IOSTAT.
! IOSTAT of NAMELIST read
! NAMELIST å¤��°ç¾¤
! NAMELIST group name
!
namelist /albedo_Matthews_nml/ flag_annual_mean, OceanAlbedo
!
! �����������¤ã���¤ã��������������ç¶� "surface_flux_bulk#SurfFluxInit"
! ���½ã�¼ã�¹ã�³ã�¼ã�������§ã������.
!
! Refer to source codes in the initialization procedure
! "surface_flux_bulk#SurfFluxInit" for the default values.
!
if ( albedo_matthews_inited ) return
! �����������¤ã��¨å®�
! Default values settings
!
flag_annual_mean = .false.
OceanAlbedo = 0.1_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 = albedo_Matthews_nml, iostat = iostat_nml ) ! (out)
close( unit_nml )
call NmlutilMsg( iostat_nml, module_name ) ! (in)
end if
aa_Data_Albedo = aa_Data_Albedo * 1.0e-2_DP
aa_Data_Albedo(:,0) = OceanAlbedo
! �°å� ; Print
!
call MessageNotify( 'M', module_name, '----- Initialization Messages -----' )
call MessageNotify( 'M', module_name, ' flag_annual_mean = %b', l = (/ flag_annual_mean /) )
call MessageNotify( 'M', module_name, ' OceanAlbedo = %f', d = (/ OceanAlbedo /) )
call MessageNotify( 'M', module_name, '-- version = %c', c1 = trim(version) )
albedo_matthews_inited = .true.
end subroutine AlbedoMatthewsInit
| Subroutine : | |||
| xy_SurfType( 0:imax-1, 1:jmax ) : | integer , intent(in )
| ||
| xy_SurfCulInt( 0:imax-1, 1:jmax ) : | real(DP), intent(in )
| ||
| xy_SurfAlbedo( 0:imax-1, 1:jmax ) : | real(DP), intent(inout)
|
subroutine ModAlbedoMatthewsCultivation( xy_SurfType, xy_SurfCulInt, xy_SurfAlbedo )
! �¢ã�¸ã�¥ã�¼ã����� ; USE statements
!
! �¼å��¹è¨å®�
! Grid points settings
!
use gridset, only: imax, jmax, kmax ! ���´å±¤��.
! Number of vertical level
! �¥ä������³æ���»ã������±ã��
! Date and time handler
!
use dc_calendar, only: DCCalInquire, DCCalDateEvalSecOfYear
! ���»ç���
! Time control
!
use timeset, only: TimeN, InitialDate
! 宣�� ; Declaration statements
!
integer , intent(in ) :: xy_SurfType ( 0:imax-1, 1:jmax )
! æ¤������¤ã�³ã��������
! Index of vegetation
real(DP), intent(in ) :: xy_SurfCulInt( 0:imax-1, 1:jmax )
! ...
! Cultivation index
real(DP), intent(inout) :: xy_SurfAlbedo( 0:imax-1, 1:jmax )
! �°è¡¨�¢ã������.
! Surface albedo
! ä½�æ¥å���
! Work variables
!
real(DP):: SecOfYear
real(DP):: a_Data_SOY_Ex( 0:nseason+1 )
! ��å£ç�����å§����� (���¿ã���������¡å¼µ).
! Start time of each season (extended for interpolation).
real(DP):: SurfAlbedoCul
real(DP):: xy_SurfAlbedoCul ( 0:imax-1, 1:jmax )
real(DP):: xya_SurfAlbedoCul( 0:imax-1, 1:jmax, 1:2 )
integer :: i ! çµ�åº��¹å�������� DO ���¼ã�����æ¥å���
! Work variables for DO loop in longitude
integer :: j ! ç·�º¦�¹å�������� DO ���¼ã�����æ¥å���
! Work variables for DO loop in latitude
integer :: l ! å£ç��¹å�������� DO ���¼ã�����æ¥å���
! Work variables for DO loop in season
integer :: t
integer :: tindex
integer :: a_tindex(1:2)
integer:: hour_in_day, min_in_hour, day_in_year
integer, pointer:: day_in_month_ptr(:) => null()
real(DP):: sec_in_min, sec_in_day
! ���� ; Executable statement
!
! ������確è�
! Initialization check
!
if ( .not. albedo_matthews_inited ) then
call MessageNotify( 'E', module_name, 'This module has not been initialized.' )
end if
if ( flag_annual_mean ) then
!
! Now, annual mean value is used, temporarily.
!
SurfAlbedoCul = 0.0_DP
do l = 1, nseason
SurfAlbedoCul = SurfAlbedoCul + aa_Data_Albedo( l, IndexCultivation )
end do
SurfAlbedoCul = SurfAlbedoCul / dble( nseason )
do j = 1, jmax
do i = 0, imax-1
if ( xy_SurfType(i,j) > 0 ) then
xy_SurfAlbedo(i,j) = ( 1.0_DP - xy_SurfCulInt(i,j) ) * xy_SurfAlbedo(i,j) + xy_SurfCulInt(i,j) * SurfAlbedoCul
end if
end do
end do
else
SecOfYear = DCCalDateEvalSecOfYear( TimeN, date = InitialDate )
call DCCalInquire( day_in_month_ptr = day_in_month_ptr , hour_in_day = hour_in_day , min_in_hour = min_in_hour , sec_in_min = sec_in_min ) ! (out)
day_in_year = sum( day_in_month_ptr )
deallocate( day_in_month_ptr )
sec_in_day = hour_in_day * min_in_hour * sec_in_min
if ( SecOfYear > day_in_year * sec_in_day ) SecOfYear = day_in_year * sec_in_day
a_Data_SOY_Ex(0) = ( 0.0_DP - ( day_in_year - a_Data_DOY(nseason) ) ) * sec_in_day
do t = 1, nseason
a_Data_SOY_Ex(t) = a_Data_DOY(t) * sec_in_day
end do
a_Data_SOY_Ex(nseason+1) = ( day_in_year + a_Data_DOY(1) ) * sec_in_day
a_tindex(1) = 0
a_tindex(2) = 1
do t = 1, nseason
if ( a_Data_DOY(t) * sec_in_day <= SecOfYear ) then
a_tindex(1) = t
a_tindex(2) = t+1
end if
end do
do t = 1, 2
! for northern hemisphere
tindex = a_tindex(t)
if ( tindex == 0 ) then
tindex = nseason
else if ( tindex == nseason+1 ) then
tindex = 1
else
tindex = tindex
end if
do j = jmax/2+1, jmax
do i = 0, imax-1
xya_SurfAlbedoCul(i,j,t) = aa_Data_Albedo( tindex, IndexCultivation )
end do
end do
! for southern hemisphere
tindex = a_tindex(t) + nseason / 2
if ( tindex > nseason ) tindex = tindex - nseason
if ( tindex == 0 ) then
tindex = nseason
else if ( tindex == nseason+1 ) then
tindex = 1
else
tindex = tindex
end if
do j = 1, jmax/2
do i = 0, imax-1
xya_SurfAlbedoCul(i,j,t) = aa_Data_Albedo( tindex, IndexCultivation )
end do
end do
end do
xy_SurfAlbedoCul = ( xya_SurfAlbedoCul(:,:,2) - xya_SurfAlbedoCul(:,:,1) ) / ( a_Data_SOY_Ex(a_tindex(2)) - a_Data_SOY_Ex(a_tindex(1)) ) * ( SecOfYear - a_Data_SOY_Ex(a_tindex(1)) ) + xya_SurfAlbedoCul(:,:,1)
do j = 1, jmax
do i = 0, imax-1
if ( xy_SurfType(i,j) > 0 ) then
xy_SurfAlbedo(i,j) = ( 1.0_DP - xy_SurfCulInt(i,j) ) * xy_SurfAlbedo(i,j) + xy_SurfCulInt(i,j) * xy_SurfAlbedoCul(i,j)
end if
end do
end do
end if
end subroutine ModAlbedoMatthewsCultivation
| Subroutine : | |||
| xy_SurfType( 0:imax-1, 1:jmax ) : | integer , intent(in )
| ||
| xy_SurfAlbedo( 0:imax-1, 1:jmax ) : | real(DP), intent(out)
|
subroutine SetAlbedoMatthews( xy_SurfType, xy_SurfAlbedo )
! �¢ã�¸ã�¥ã�¼ã����� ; USE statements
!
! �¼å��¹è¨å®�
! Grid points settings
!
use gridset, only: imax, jmax, kmax ! ���´å±¤��.
! Number of vertical level
! �¥ä������³æ���»ã������±ã��
! Date and time handler
!
use dc_calendar, only: DCCalInquire, DCCalDateEvalSecOfYear
! ���»ç���
! Time control
!
use timeset, only: TimeN, InitialDate
! 宣�� ; Declaration statements
!
integer , intent(in ) :: xy_SurfType ( 0:imax-1, 1:jmax )
! æ¤������¤ã�³ã��������
! Index of vegetation
real(DP), intent(out) :: xy_SurfAlbedo( 0:imax-1, 1:jmax )
! �°è¡¨�¢ã������.
! Surface albedo
! ä½�æ¥å���
! Work variables
!
real(DP):: SecOfYear
real(DP):: a_Data_SOY_Ex( 0:nseason+1 )
! ��å£ç�����å§����� (���¿ã���������¡å¼µ).
! Start time of each season (extended for interpolation).
real(DP):: xya_SurfAlbedoLocal( 0:imax-1, 1:jmax, 1:2 )
integer :: i ! çµ�åº��¹å�������� DO ���¼ã�����æ¥å���
! Work variables for DO loop in longitude
integer :: j ! ç·�º¦�¹å�������� DO ���¼ã�����æ¥å���
! Work variables for DO loop in latitude
integer :: l ! å£ç��¹å�������� DO ���¼ã�����æ¥å���
! Work variables for DO loop in season
integer :: t
integer :: tindex
integer :: a_tindex(1:2)
integer:: hour_in_day, min_in_hour, day_in_year
integer, pointer:: day_in_month_ptr(:) => null()
real(DP):: sec_in_min, sec_in_day
! ���� ; Executable statement
!
! ������確è�
! Initialization check
!
if ( .not. albedo_matthews_inited ) then
call MessageNotify( 'E', module_name, 'This module has not been initialized.' )
end if
if ( flag_annual_mean ) then
!
! Now, annual mean value is used, temporarily.
!
xy_SurfAlbedo = 0.0_DP
do l = 1, nseason
do j = 1, jmax
do i = 0, imax-1
xy_SurfAlbedo(i,j) = xy_SurfAlbedo(i,j) + aa_Data_Albedo( l, xy_SurfType(i,j) )
end do
end do
end do
xy_SurfAlbedo = xy_SurfAlbedo / dble( nseason )
else
SecOfYear = DCCalDateEvalSecOfYear( TimeN, date = InitialDate )
call DCCalInquire( day_in_month_ptr = day_in_month_ptr , hour_in_day = hour_in_day , min_in_hour = min_in_hour , sec_in_min = sec_in_min ) ! (out)
day_in_year = sum( day_in_month_ptr )
deallocate( day_in_month_ptr )
sec_in_day = hour_in_day * min_in_hour * sec_in_min
if ( SecOfYear > day_in_year * sec_in_day ) SecOfYear = day_in_year * sec_in_day
a_Data_SOY_Ex(0) = ( 0.0_DP - ( day_in_year - a_Data_DOY(nseason) ) ) * sec_in_day
do t = 1, nseason
a_Data_SOY_Ex(t) = a_Data_DOY(t) * sec_in_day
end do
a_Data_SOY_Ex(nseason+1) = ( day_in_year + a_Data_DOY(1) ) * sec_in_day
a_tindex(1) = 0
a_tindex(2) = 1
do t = 1, nseason
if ( a_Data_DOY(t) * sec_in_day <= SecOfYear ) then
a_tindex(1) = t
a_tindex(2) = t+1
end if
end do
do t = 1, 2
! for northern hemisphere
tindex = a_tindex(t)
if ( tindex == 0 ) then
tindex = nseason
else if ( tindex == nseason+1 ) then
tindex = 1
else
tindex = tindex
end if
do j = jmax/2+1, jmax
do i = 0, imax-1
xya_SurfAlbedoLocal(i,j,t) = aa_Data_Albedo( tindex, xy_SurfType(i,j) )
end do
end do
! for southern hemisphere
tindex = a_tindex(t) + nseason / 2
if ( tindex > nseason ) tindex = tindex - nseason
if ( tindex == 0 ) then
tindex = nseason
else if ( tindex == nseason+1 ) then
tindex = 1
else
tindex = tindex
end if
do j = 1, jmax/2
do i = 0, imax-1
xya_SurfAlbedoLocal(i,j,t) = aa_Data_Albedo( tindex, xy_SurfType(i,j) )
end do
end do
end do
xy_SurfAlbedo = ( xya_SurfAlbedoLocal(:,:,2) - xya_SurfAlbedoLocal(:,:,1) ) / ( a_Data_SOY_Ex(a_tindex(2)) - a_Data_SOY_Ex(a_tindex(1)) ) * ( SecOfYear - a_Data_SOY_Ex(a_tindex(1)) ) + xya_SurfAlbedoLocal(:,:,1)
end if
end subroutine SetAlbedoMatthews
| Constant : | |||
| NAlbType = 32 : | integer , parameter
|
| Variable : | |||
| a_Data_DOY( NSeason ) : | real(DP), save
|
| Variable : | |||
| aa_Data_Albedo( NSeason, 0:NAlbType ) : | real(DP), save
|
| Variable : | |||
| albedo_matthews_inited = .false. : | logical, save
|
| Constant : | |||
| module_name = ‘albedo_Matthews‘ : | character(*), parameter
|
| Constant : | |||
| version = ’$Name: $’ // ’$Id: albedo_Matthews.f90,v 1.10 2014/05/07 09:39:23 murashin Exp $’ : | character(*), parameter
|