| Class | roughlen_Matthews |
| In: |
surface_properties/roughlen_Matthews.f90
|
| Subroutine : | |
| RoughLenType : | character(*), intent(in ) |
| xy_SurfType( 0:imax-1, 1:jmax ) : | integer , intent(in ) |
| xy_SurfCulInt( 0:imax-1, 1:jmax ) : | real(DP), intent(in ) |
| xy_SurfRoughLen( 0:imax-1, 1:jmax ) : | real(DP), intent(inout) |
subroutine ModRoughLenMatthewsCultivation( RoughLenType, xy_SurfType, xy_SurfCulInt, xy_SurfRoughLen )
! モジュール引用 ; USE statements
!
! 格子点設定
! Grid points settings
!
use gridset, only: imax, jmax, kmax ! 鉛直層数.
! Number of vertical level
! 宣言文 ; Declaration statements
!
character(*), intent(in ) :: RoughLenType
integer , intent(in ) :: xy_SurfType ( 0:imax-1, 1:jmax )
real(DP), intent(in ) :: xy_SurfCulInt ( 0:imax-1, 1:jmax )
real(DP), intent(inout) :: xy_SurfRoughLen( 0:imax-1, 1:jmax )
! 作業変数
! Work variables
!
real(DP) :: a_RatioMomToHeat( NM84Element )
real(DP) :: SurfRoughLenCul
integer:: i ! 経度方向に回る DO ループ用作業変数
! Work variables for DO loop in longitude
integer:: j ! 緯度方向に回る DO ループ用作業変数
! Work variables for DO loop in latitude
integer:: l
! 初期化確認
! Initialization check
!
if ( .not. roughlen_matthews_inited ) then
call MessageNotify( 'E', module_name, 'This module has not been initialized.' )
end if
select case ( RoughLenType )
case ( 'Mom' )
a_RatioMomToHeat = 1.0_DP
case ( 'Heat')
if ( FlagRoughLenHeatSameAsMom ) then
a_RatioMomToHeat = 1.0_DP
else
a_RatioMomToHeat = DataM84RLRatioMomToHeat( : )
end if
case default
call MessageNotify( 'E', module_name, 'Unexpected value of RoughLenType = %c.', c1 = trim( RoughLenType ) )
end select
!
! land
!
SurfRoughLenCul = 0.0_DP
do l = 1, NM84Element
SurfRoughLenCul = SurfRoughLenCul + DataM84RL(l) * a_RatioMomToHeat(l) * DataM84Weight( l, DataSurfType2M84Type( IndexCultivation ) )
end do
do j = 1, jmax
do i = 0, imax-1
if( xy_SurfType(i,j) >= 1 ) then
xy_SurfRoughLen(i,j) = ( 1.0_DP - xy_SurfCulInt(i,j) ) * xy_SurfRoughLen(i,j) + xy_SurfCulInt(i,j) * SurfRoughLenCul
end if
end do
end do
end subroutine ModRoughLenMatthewsCultivation
| Subroutine : |
This procedure input/output NAMELIST#roughlen_Matthews_nml .
subroutine RoughLenMatthewsInit
! モジュール引用 ; USE statements
!
! 種別型パラメタ
! Kind type parameter
!
use dc_types, only: STDOUT ! 標準出力の装置番号. Unit number of standard output
! ファイル入出力補助
! File I/O support
!
use dc_iounit, only: FileOpen
! NAMELIST ファイル入力に関するユーティリティ
! Utilities for NAMELIST file input
!
use namelist_util, only: namelist_filename, NmlutilMsg
! 作業変数
! Work variables
!
integer:: unit_nml ! NAMELIST ファイルオープン用装置番号.
! Unit number for NAMELIST file open
integer:: iostat_nml ! NAMELIST 読み込み時の IOSTAT.
! IOSTAT of NAMELIST read
integer:: l
integer:: m
! NAMELIST 変数群
! NAMELIST group name
!
namelist /roughlen_Matthews_nml/ RoughLenOcean, RoughLenIce, FlagRoughLenHeatSameAsMom
! 実行文 ; Executable statement
!
if ( roughlen_matthews_inited ) return
! デフォルト値の設定
! Default values settings
!
RoughLenOcean = 1.0e-4_DP
RoughLenIce = 1.0e-2_DP
FlagRoughLenHeatSameAsMom = .true.
! 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 = roughlen_Matthews_nml, iostat = iostat_nml )
close( unit_nml )
call NmlutilMsg( iostat_nml, module_name ) ! (in)
if ( iostat_nml == 0 ) write( STDOUT, nml = roughlen_Matthews_nml )
end if
!
! This table/list is created by using Table 4 of Matthews (1983) and Table 1 of
! Matthews (1984).
!
DataSurfType2M84Type( 0 ) = 0 ! ocean, This is not included in Matthews papers.
DataSurfType2M84Type( 1 ) = 1
DataSurfType2M84Type( 2 ) = 1
DataSurfType2M84Type( 3 ) = 1
DataSurfType2M84Type( 4 ) = 1
DataSurfType2M84Type( 5 ) = 2
DataSurfType2M84Type( 6 ) = 3
DataSurfType2M84Type( 7 ) = 4
DataSurfType2M84Type( 8 ) = 4
DataSurfType2M84Type( 9 ) = 5
DataSurfType2M84Type( 10 ) = 6 ! A
DataSurfType2M84Type( 11 ) = 6 ! B, This may be 7. I cannot identify.
DataSurfType2M84Type( 12 ) = 8 ! C
DataSurfType2M84Type( 13 ) = 9 ! D
DataSurfType2M84Type( 14 ) = 10 ! E
DataSurfType2M84Type( 15 ) = 11 ! F
DataSurfType2M84Type( 16 ) = 12 ! G
DataSurfType2M84Type( 17 ) = 14 ! H
DataSurfType2M84Type( 18 ) = 14 ! I
DataSurfType2M84Type( 19 ) = 15 ! J
DataSurfType2M84Type( 20 ) = 15 ! K
DataSurfType2M84Type( 21 ) = 8 ! L
DataSurfType2M84Type( 22 ) = 16 ! M
DataSurfType2M84Type( 23 ) = 17 ! N
DataSurfType2M84Type( 24 ) = 17 ! O
DataSurfType2M84Type( 25 ) = 17 ! P
DataSurfType2M84Type( 26 ) = 19 ! Q
DataSurfType2M84Type( 27 ) = 19 ! R
DataSurfType2M84Type( 28 ) = 19 ! S
DataSurfType2M84Type( 29 ) = 19 ! T
DataSurfType2M84Type( 30 ) = 20 ! U
DataSurfType2M84Type( 31 ) = 21 ! V ice
DataSurfType2M84Type( 32 ) = 19 ! W cultivation
do m = 0, NM84Type
do l = 1, NM84Element
DataM84Weight( l, m ) = DataM84Weight( l, m ) * 1.0e-2_DP
end do
end do
do l = 1, NM84Element
DataM84RL( l ) = DataM84RL( l ) * 1.0e-2_DP
end do
! 印字 ; Print
!
call MessageNotify( 'M', module_name, '----- Initialization Messages -----' )
call MessageNotify( 'M', module_name, 'RoughLenOcean = %f', d = (/RoughLenOcean/) )
call MessageNotify( 'M', module_name, 'RoughLenIce = %f', d = (/RoughLenIce/) )
call MessageNotify( 'M', module_name, 'FlagRoughLenHeatSameAsMom = %b', l = (/FlagRoughLenHeatSameAsMom/) )
call MessageNotify( 'M', module_name, '-- version = %c', c1 = trim(version) )
roughlen_matthews_inited = .true.
end subroutine RoughLenMatthewsInit
| Subroutine : | |
| RoughLenType : | character(*), intent(in ) |
| xy_SurfType( 0:imax-1, 1:jmax ) : | integer , intent(in ) |
| xy_SurfRoughLen( 0:imax-1, 1:jmax ) : | real(DP), intent(inout) |
subroutine SetRoughLenLandMatthews( RoughLenType, xy_SurfType, xy_SurfRoughLen )
! モジュール引用 ; USE statements
!
! 格子点設定
! Grid points settings
!
use gridset, only: imax, jmax, kmax ! 鉛直層数.
! Number of vertical level
! 宣言文 ; Declaration statements
!
character(*), intent(in ) :: RoughLenType
integer , intent(in ) :: xy_SurfType ( 0:imax-1, 1:jmax )
real(DP), intent(inout) :: xy_SurfRoughLen( 0:imax-1, 1:jmax )
! 作業変数
! Work variables
!
real(DP) :: a_RatioMomToHeat( NM84Element )
integer:: i ! 経度方向に回る DO ループ用作業変数
! Work variables for DO loop in longitude
integer:: j ! 緯度方向に回る DO ループ用作業変数
! Work variables for DO loop in latitude
integer:: l
! 初期化確認
! Initialization check
!
if ( .not. roughlen_matthews_inited ) then
call MessageNotify( 'E', module_name, 'This module has not been initialized.' )
end if
select case ( RoughLenType )
case ( 'Mom' )
a_RatioMomToHeat = 1.0_DP
case ( 'Heat')
if ( FlagRoughLenHeatSameAsMom ) then
a_RatioMomToHeat = 1.0_DP
else
a_RatioMomToHeat = DataM84RLRatioMomToHeat( : )
end if
case default
call MessageNotify( 'E', module_name, 'Unexpected value of RoughLenType = %c.', c1 = trim( RoughLenType ) )
end select
!
! land
!
do j = 1, jmax
do i = 0, imax-1
if( xy_SurfType( i, j ) >= 1 ) then
xy_SurfRoughLen( i, j ) = 0.0_DP
end if
end do
end do
do l = 1, NM84Element
do j = 1, jmax
do i = 0, imax-1
if( xy_SurfType( i, j ) >= 1 ) then
xy_SurfRoughLen( i, j ) = xy_SurfRoughLen( i, j ) + DataM84RL( l ) * a_RatioMomToHeat( l ) * DataM84Weight( l, DataSurfType2M84Type( xy_SurfType( i, j ) ) )
end if
end do
end do
end do
!
! ocean
!
do j = 1, jmax
do i = 0, imax-1
if( xy_SurfType( i, j ) == 0 ) then
xy_SurfRoughLen( i, j ) = RoughLenOcean
end if
end do
end do
!
! ice
!
do j = 1, jmax
do i = 0, imax-1
if( xy_SurfType( i, j ) == 31 ) then
xy_SurfRoughLen( i, j ) = RoughLenIce
end if
end do
end do
end subroutine SetRoughLenLandMatthews
| Constant : | |||
| module_name = ‘roughlen_Matthews‘ : | character(*), parameter
|
| Variable : | |||
| roughlen_matthews_inited = .false. : | logical, save
|
| Constant : | |||
| version = ’$Name: dcpam5-20150211 $’ // ’$Id: roughlen_Matthews.f90,v 1.9 2015/01/29 12:08:40 yot Exp $’ : | character(*), parameter
|