!= Matthews のデータに基づく地面粗度の設定 ! != set roughness length on land surface based on data by Matthews ! ! Authors:: Yoshiyuki O. Takahashi, Shin-ichi Takehiro ! Version:: $Id: roughlen_Matthews.f90,v 1.9 2025/09/17 22:00:00 takepiro Exp $ ! Tag Name:: $Name: $ ! Copyright:: Copyright (C) GFD Dennou Club, 2008-2025. All rights reserved. ! License:: See COPYRIGHT[link:../../../COPYRIGHT] ! module roughlen_Matthews !== References ! ! Matthews, E., ! Global vegetation and land use: New high-resolution data bases for climate ! studies, ! J. Clim. Appl. Meteor., 22, 474, 1983. ! ! Matthews, E., ! Prescription of land-surface boundary conditions in GISS GCM II: ! A simple method based on fine-resolution data bases, ! NASA Technical memorandum #86096, 1984. ! モジュール引用 ; USE statements ! ! 種別型パラメタ ! Kind type parameter ! use dc_types, only: DP, & ! 倍精度実数型. Double precision. & STRING ! 文字列. Strings. ! メッセージ出力 ! Message output ! use dc_message, only: MessageNotify ! 宣言文 ; Declaration statements ! implicit none private ! 公開手続き ! Public procedure ! public:: SetRoughLenLandMatthews public:: ModRoughLenMatthewsCultivation public:: RoughLenMatthewsInit ! 公開変数 ! Public variables ! ! 非公開変数 ! Private variables ! logical, save :: roughlen_matthews_inited = .false. ! 初期設定フラグ. ! Initialization flag integer, parameter :: NLandUseType = 32 integer, parameter :: NM84Element = 9 integer, parameter :: NM84Type = 22 integer, parameter :: IndexCultivation = 32 integer , save :: DataSurfType2M84Type( 0:NLandUseType ) real(DP) , save :: DataM84Weight( NM84Element, 0:NM84Type ) real(DP) , save :: DataM84RL( NM84Element ) real(DP) , save :: DataM84RLRatioMomToHeat( NM84Element ) real(DP) , save :: RoughLenOcean real(DP) , save :: RoughLenIce logical , save :: FlagRoughLenHeatSameAsMom ! ! Matthews (1984) grouped UNESCO land use type into 22 groups, whose properties ! can be constructed by conbining properties of those of 9 land use 'elemental ! groups'. Note that a word 'elemental group' is not used by Matthews (1984). ! ! ! Table 2B of Matthews (1984), NASA Technical memorandum #86096 ! ! 9 'elemental group' is as follows. ! #1 desert ! #2 tundra ! #3 grassland ! #4 grassland with shrub cover ! #5 grassland with tree cover ! #6 deciduous forest ! #7 evergreen forest ! #8 rainforest ! #9 ice ! ! %1 %2 %3 %4 %5 %6 %7 %8 %9 data DataM84Weight / & 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! 0, This is not included in Matthews papers. 0, 0, 0, 0, 0, 0, 0, 100, 0, & ! 1 0, 0, 25, 0, 0, 0, 75, 0, 0, & ! 2 40, 0, 0, 0, 0, 0, 60, 0, 0, & ! 3 0, 0, 0, 0, 0, 0, 100, 0, 0, & ! 4 0, 0, 25, 0, 0, 75, 0, 0, 0, & ! 5 0, 0, 0, 0, 0, 100, 0, 0, 0, & ! 6 15, 0, 0, 0, 0, 85, 0, 0, 0, & ! 7 85, 0, 0, 0, 0, 15, 0, 0, 0, & ! 8 35, 0, 0, 0, 0, 0, 65, 0, 0, & ! 9 25, 0, 25, 0, 0, 0, 50, 0, 0, & ! 10 35, 0, 0, 0, 0, 65, 0, 0, 0, & ! 11 30, 0, 0, 0, 0, 70, 0, 0, 0, & ! 12 0, 0, 50, 0, 0, 50, 0, 0, 0, & ! 13 10, 0, 80, 0, 0, 0, 10, 0, 0, & ! 14 10, 0, 80, 0, 0, 10, 0, 0, 0, & ! 15 0, 100, 0, 0, 0, 0, 0, 0, 0, & ! 16 0, 0, 0, 0, 100, 0, 0, 0, 0, & ! 17 0, 0, 0, 100, 0, 0, 0, 0, 0, & ! 18 0, 0, 100, 0, 0, 0, 0, 0, 0, & ! 19 100, 0, 0, 0, 0, 0, 0, 0, 0, & ! 20 0, 0, 0, 0, 0, 0, 0, 0, 100, & ! 21 ice 30, 0, 0, 0, 0, 0, 70, 0, 0 & ! 22 / ! ! roughness length ! Table 3 of Matthews (1984). unit is cm. ! A value of roughness length for ice is not included in Matthews (1984). ! ! %1 %2 %3 %4 %5 %6 %7 %8 %9 data DataM84RL / & 0.5_DP, 0.5_DP, 1.0_DP, 1.0_DP, 1.8_DP, 32.0_DP, 100.0_DP, 200.0_DP, 0.0_DP & / ! ! ratio of roughness length for momentum to that for heat ! Our strategy is that roughness length for heat on ocean, ice, and trees ! are the same as those for momentum. Roughness length for heat on other ! lands are 1/100 of those for momentum. The factor, 1/100, is based on ! ECMWF IFS (p.164, IFSPart4.pdf). ! ! %1 %2 %3 %4 %5 %6 %7 %8 %9 data DataM84RLRatioMomToHeat / & 0.01_DP, 0.01_DP, 0.01_DP, 0.01_DP, 1.0_DP, 1.0_DP, 1.0_DP, 1.0_DP, 1.0_DP & / character(*), parameter:: module_name = 'roughlen_Matthews' ! モジュールの名称. ! Module name character(*), parameter:: version = & & '$Name: $' // & & '$Id: roughlen_Matthews.f90,v 1.9 2025/09/17 22:00:00 takepiro Exp $' ! モジュールのバージョン ! Module version contains !-------------------------------------------------------------------------------------- subroutine SetRoughLenLandMatthews( & & RoughLenType, xy_SurfType, & & xy_SurfRoughLen & & ) ! モジュール引用 ; USE statements ! ! 格子点設定 ! Grid points settings ! use gridset, only: imax, & ! 経度格子点数. ! Number of grid points in longitude & jmax, & ! 緯度格子点数. ! Number of grid points in latitude & 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 !-------------------------------------------------------------------------------------- subroutine ModRoughLenMatthewsCultivation( & & RoughLenType, xy_SurfType, xy_SurfCulInt, & & xy_SurfRoughLen & & ) ! モジュール引用 ; USE statements ! ! 格子点設定 ! Grid points settings ! use gridset, only: imax, & ! 経度格子点数. ! Number of grid points in longitude & jmax, & ! 緯度格子点数. ! Number of grid points in latitude & 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 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 ! メッセージ制御 ! Message control ! use mpi_messagecntl, only : DoesOutputMPIMessage ! 作業変数 ! 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, & ! (out) & namelist_filename, mode = 'r' ) ! (in) rewind( unit_nml ) read( unit_nml, & ! (in) & nml = roughlen_Matthews_nml, & ! (out) & iostat = iostat_nml & ! (out) & ) close( unit_nml ) call NmlutilMsg( iostat_nml, module_name ) ! (in) if ( iostat_nml == 0 .AND. DoesOutputMPIMessage() ) 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 setroughnesslength_ocean( im, jm, km, gzs, gsfcindex, & !!$ gu, gv, gt, galt, gpt, gpth, gz0_out ) !!$ !!$ use vtype_module !!$ use const_module, only : grav !!$ use vdiff_module !!$ !!$ implicit none !!$ !!$ integer(i4b), intent(in ) :: im, jm, km !!$ real(dp) , intent(in ) :: gzs( im, jm ) !!$ integer(i4b), intent(in ) :: gsfcindex( im, jm ) !!$ real(dp) , intent(in ) :: gu( im, jm, km ), gv( im, jm, km ), gt( im, jm, km ), galt( im, jm, km ), gpt( im, jm, km ), gpth( im, jm, km+1 ) !!$ real(dp) , intent(inout) :: gz0_out( im, jm ) !!$ !!$ ! !!$ ! local variables !!$ ! !!$ real(dp) , parameter :: gz0_init = 0.01d0 !!$ !!$ real(dp) :: c_charnock !!$ !!$ integer(i4b) :: iitr, nitr !!$ real(dp) :: cd( im, jm ), ch( im, jm ), fvsq( im, jm ) !!$ !!$ real(dp) :: gz0( im, jm ) !!$ !!$ integer(i4b) :: i, j !!$ !!$ !!$ ! !!$ ! initial value for interation !!$ ! !!$ do j = 1, jm !!$ do i = 1, im !!$ gz0( i, j ) = gz0_init !!$ end do !!$ end do !!$ !!$ nitr = 10 !!$ do iitr = 1, nitr !!$ !!$ call vdiff_dragcoef_core( im, jm, km, gzs, & !!$ gz0, & !!$ gu, gv, gt, galt, gpt, gpth, cd, ch ) !!$ !!$ write( 6, * ) gsfcindex( 1, jm/2 ), iitr, gz0( 1, jm/2 ), cd( 1, jm/2 ) !!$ !!$ !!$ do j = 1, jm !!$ do i = 1, im !!$ fvsq( i, j ) = ( cd( i, j ) + 1.0d-6 )& !!$ * ( gu( i, j, km )**2 + gv( i, j, km )**2 + 1.0d-3 ) !!$ end do !!$ end do !!$ !!$ ! !!$ ! Krishnamurti? !!$! c_charnock = 0.04d0 !!$ ! !!$ ! Wu (1967), technical report !!$ ! http://oai.dtic.mil/oai/oai?&verb=getRecord&metadataPrefix=html&identifier=AD0672750 !!$! c_charnock = 0.0156d0 !!$ ! Wu (1980), JPO !!$ c_charnock = 0.0185d0 !!$ do j = 1, jm !!$ do i = 1, im !!$ if( gsfcindex( i, j ) .le. 0 ) then !!$ ! Ocean !!$ ! Charnock, 1955 !!$ gz0( i, j ) = c_charnock * fvsq( i, j ) / grav !!$ end if !!$ end do !!$ end do !!$ !!$ end do !!$ !!$ !!$ do j = 1, jm !!$ do i = 1, im !!$ !!$ if( gsfcindex( i, j ) .le. 0 ) then !!$ gz0_out( i, j ) = gz0( i, j ) !!$ end if !!$ !!$ end do !!$ end do !!$ !!$ !!$ end subroutine setroughnesslength_ocean end module roughlen_Matthews