Class axesset
In: setup/axesset.f90

座標データ設定

Axes data settings

Note that Japanese and English are described in parallel.

座標データの設定および保管を行います.

緯度 $ varphi $ および経度 $ lambda $ の格子点は, gridset モジュールで設定される格子点数から, SPMODEL ライブラリ を用いて決定されます. 緯度の格子点の位置はガウス緯度, 経度の格子点の位置は等間隔にとることになります.

鉛直σの格子点は, 半整数レベル (各層の端) について NAMELIST#Sigma に指定します. 整数レベル (各層の中心点) は, 半整数レベルと constants モジュールで設定される乾燥大気の定圧比熱 $ C_p $ および 乾燥大気の気体定数 $ R $ を用いて決定します. 鉛直σの格子点については, sigma_data モジュールで用意されている ものを使用することも可能です.

Axes data is set and stored.

Grid points of latitude $ varphi $ and longitude $ lambda $ are determined with number of grid points configured in "gridset" module by SPMODEL Library Grid points of latitude becomes Gaussian latitude, and grid points of latitude becomes equally spaced.

Variables List

x_Lon :経度座標
x_Lon_Weight :経度座標重み
y_Lat :緯度座標
y_Lat_Weight :緯度座標重み
z_Sigma :$ sigma $ レベル (整数)
r_Sigma :$ sigma $ レベル (半整数)
z_DelSigma :$ Delta sigma $ (整数)
r_DelSigma :$ Delta sigma $ (半整数)
w_Number :スペクトルデータの添字番号
spml_inited :SPML ライブラリの初期設定フラグ
———— :————
x_Lon :Longitude
x_Lon_Weight :Weight of longitude
y_Lat :Latitude
y_Lat_Weight :Weight of latitude
z_Sigma :Full $ sigma $ level
r_Sigma :Half $ sigma $ level
z_DelSigma :$ Delta sigma $ (Full)
r_DelSigma :$ Delta sigma $ (Half)
w_Number :Subscript of spectral data
spml_inited :Initialization flag of SPML library

Procedures List

AxessetInit :座標データの設定
———— :————
AxessetInit :Settings of axes data

Methods

Included Modules

gridset dc_types namelist_util constants wa_module sigma_data dc_iounit dc_message

Public Instance methods

Subroutine :

axesset モジュールの初期化を行います. NAMELIST#axesset_nml の読み込みはこの手続きで行われます.

"axesset" module is initialized. NAMELIST#axesset_nml is loaded in this procedure.

This procedure input/output NAMELIST#axesset_nml .

[Source]

  subroutine AxessetInit
    !
    ! axesset モジュールの初期化を行います. 
    ! NAMELIST#axesset_nml の読み込みはこの手続きで行われます. 
    !
    ! "axesset" module is initialized. 
    ! NAMELIST#axesset_nml is loaded in this procedure. 
    !

    ! モジュール引用 ; USE statements
    !

    ! 物理定数設定
    ! Physical constants settings
    !
    use constants, only: CpDry, GasRDry  ! $ R $ [J kg-1 K-1]. 
                                  ! 乾燥大気の気体定数. 
                                  ! Gas constant of air

    ! SPMODEL ライブラリ, 球面上の問題を球面調和函数変換により解く(多層対応) 
    ! SPMODEL library, problems on sphere are solved with spherical harmonics (multi layer is supported)
    !
    use wa_module, only: wa_Initial, spml_x_Lon        => x_Lon, spml_y_Lat        => y_Lat, spml_x_Lon_Weight => x_Lon_Weight, spml_y_Lat_Weight => y_Lat_Weight
                              ! $ \Delta \varphi $ [rad.] . 
                              ! 緯度座標重み. 
                              ! Weight of latitude

    ! 鉛直σレベルデータ準備
    ! Prepare vertical sigma level data
    !
    use sigma_data, only: SigmaDataGetHalf

    ! NAMELIST ファイル入力に関するユーティリティ
    ! Utilities for NAMELIST file input
    !
    use namelist_util, only: namelist_filename, NmlutilMsg, NmlutilAryValid

    ! ファイル入出力補助
    ! File I/O support
    !
    use dc_iounit, only: FileOpen

    ! 種別型パラメタ
    ! Kind type parameter
    !
    use dc_types, only: STDOUT ! 標準出力の装置番号. Unit number of standard output

    ! メッセージ出力
    ! Message output
    !
    use dc_message, only: MessageNotify

    ! 宣言文 ; Declaration statements
    !
    implicit none

    ! 作業変数
    ! Work variables
    !
    integer:: i               ! スペクトルの添字番号で回る DO ループ用作業変数
                              ! Work variables for DO loop in subscript of spectral data
    integer:: k               ! 鉛直方向に回る DO ループ用作業変数
                              ! Work variables for DO loop in vertical direction
    real(DP):: Kappa          ! $ \kappa = R / C_p $ .
                              ! 乾燥大気における, 気体定数の定圧比熱に対する比.
                              ! Ratio of gas constant to specific heat in dry air
    integer:: unit_nml        ! NAMELIST ファイルオープン用装置番号. 
                              ! Unit number for NAMELIST file open
    integer:: iostat_nml      ! NAMELIST 読み込み時の IOSTAT. 
                              ! IOSTAT of NAMELIST read

    ! NAMELIST 変数群
    ! NAMELIST group name
    !
    namelist /axesset_nml/ Sigma
          !
          ! デフォルト値については初期化手続 "axesset#AxessetInit" 
          ! のソースコードを参照のこと. 
          !
          ! Refer to source codes in the initialization procedure
          ! "axesset#AxessetInit" for the default values. 
          !

    ! 実行文 ; Executable statement
    !

    if ( axesset_inited ) return
    call InitCheck

    ! 割り付け
    ! Allocation
    !
    allocate( x_Lon        (0:imax-1) )
    allocate( x_Lon_Weight (0:imax-1) )
    allocate( y_Lat        (1:jmax)   )
    allocate( y_Lat_Weight (1:jmax)   )
    allocate( z_Sigma      (1:kmax)   )
    allocate( r_Sigma      (0:kmax)   )
    allocate( z_DelSigma   (1:kmax)   )
    allocate( r_DelSigma   (0:kmax)   )
    allocate( w_Number     (1:(nmax+1)**2) )

    ! Sigma (半整数レベルσ) の初期値 (無効な値) の設定
    ! Setting of initial value (invalid value) of "Sigma" (half level sigma)
    !
    Sigma = -999.0_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 = axesset_nml, iostat = iostat_nml ) ! (out)
      close( unit_nml )

      call NmlutilMsg( iostat_nml, module_name ) ! (in)
    end if

    ! Sigma (半整数レベルσ) の自動設定
    ! Automation setting of "Sigma" (half level sigma)
    !
    if ( all( Sigma < 0.0_DP ) ) then
      call SigmaDataGetHalf( Sigma(1:kmax+1) ) ! (out)
    end if

    ! Sigma (半整数レベルσ) チェック
    ! Check "Sigma" (half level sigma)
    !
    call NmlutilAryValid( module_name, Sigma,  'Sigma', kmax+1, 'kmax+1' )               ! (in)

    ! r_Sigma (半整数レベルσ) 設定
    ! Setting of "r_Sigma" (half level sigma)
    !
    r_Sigma(0:kmax) = Sigma(1:kmax+1)

    ! z_DelSigma (整数レベル $ \Delta \sigma $ ) 設定
    ! Setting of "z_DelSigma" (full level $ \Delta \sigma $ )
    !
    do k = 1, kmax
      z_DelSigma(k) = r_Sigma(k-1) - r_Sigma(k)
    enddo

    ! z_Sigma (整数レベルσ) 設定
    ! Setting of "z_Sigma" (full level sigma)
    !
    Kappa = GasRDry / CpDry
    do k = 1, kmax
      z_Sigma(k) = ( (   r_Sigma(k-1) ** ( 1.0_DP + Kappa ) - r_Sigma(k)   ** ( 1.0_DP + Kappa ) ) / ( z_DelSigma(k) * ( 1.0_DP + Kappa ) ) ) ** ( 1.0_DP / Kappa )
    enddo

    ! r_DelSigma (半整数レベル $ \Delta \sigma $ ) 設定
    ! Setting of "r_DelSigma" (half level $ \Delta \sigma $ )
    !
    r_DelSigma(0)    = r_Sigma(0)    - z_Sigma(1)
    r_DelSigma(kmax) = z_Sigma(kmax) - r_Sigma(kmax)
    do k = 1, kmax - 1
      r_DelSigma(k) = z_Sigma(k) - z_Sigma(k+1)
    end do

    ! 緯度経度の設定
    ! Settings of longitude and latitude
    !
    if ( .not. spml_inited ) then
      call wa_Initial( nmax, imax, jmax, kmax ) ! (in)
    end if
    x_Lon        = spml_x_Lon
    x_Lon_Weight = spml_x_Lon_Weight
    y_Lat        = spml_y_Lat
    y_Lat_Weight = spml_y_Lat_Weight


    ! スペクトルデータの添字番号の設定
    ! Settings of subscript of spectral data
    !
    do i = 1, size(w_Number)
      w_Number(i) = i
    end do

    ! 印字 ; Print
    !
    call MessageNotify( 'M', module_name, '----- Initialization Messages -----' )
    call MessageNotify( 'M', module_name, 'Axes:' )
    call MessageNotify( 'M', module_name, '  x_Lon(%d:%d) = %*r', i = (/ 0, imax - 1/), r = real(x_Lon), n =(/ imax /) )
    call MessageNotify( 'M', module_name, '  y_Lat(%d:%d) = %*r', i = (/ 1, jmax/), r = real(y_Lat), n =(/ jmax /) )
    call MessageNotify( 'M', module_name, '  z_Sigma(%d:%d) = %*r', i = (/ 1, kmax /), r = real(z_Sigma), n =(/ kmax /) )
    call MessageNotify( 'M', module_name, '  r_Sigma(%d:%d) = %*r', i = (/ 0, kmax /), r = real(r_Sigma), n =(/ kmax+1 /) )
    call MessageNotify( 'M', module_name, '  w_Number(%d:%d) = %d .. %d', i = (/ 1, size(w_Number), 1, size(w_Number) /) )
!
    call MessageNotify( 'M', module_name, 'Weight:' )
    call MessageNotify( 'M', module_name, '  x_Lon_Weight(%d:%d) = %*r', i = (/ 0, imax - 1/), r = real(x_Lon_Weight), n =(/ imax /) )
    call MessageNotify( 'M', module_name, '  y_Lat_Weight(%d:%d) = %*r', i = (/ 1, jmax/), r = real(y_Lat_Weight), n =(/ jmax /) )
    call MessageNotify( 'M', module_name, '  z_DelSigma(%d:%d) = %*r', i = (/ 1, kmax /), r = real(z_DelSigma), n =(/ kmax /) )
    call MessageNotify( 'M', module_name, '-- version = %c', c1 = trim(version) )

    axesset_inited = .true.
  end subroutine AxessetInit
axesset_inited
Variable :
axesset_inited = .false. :logical, save, public
: 初期設定フラグ. Initialization flag
r_DelSigma
Variable :
r_DelSigma(:) :real(DP), allocatable, save, public
: $ Delta sigma $ (半整数). $ Delta sigma $ (half)
r_Sigma
Variable :
r_Sigma(:) :real(DP), allocatable, save, public
: $ sigma $ レベル (半整数). Half $ sigma $ level
spml_inited
Variable :
spml_inited = .false. :logical, save, public
: SPML ライブラリの初期設定フラグ. Initialization flag of SPML library
w_Number
Variable :
w_Number(:) :integer, allocatable, save, public
: スペクトルデータの添字番号. Subscript of spectral data
x_Lon
Variable :
x_Lon(:) :real(DP), allocatable, save, public
: $ lambda $ [rad.] . 経度. Longitude
x_Lon_Weight
Variable :
x_Lon_Weight(:) :real(DP), allocatable, save, public
: $ Delta lambda $ [rad.] . 経度座標重み. Weight of longitude
y_Lat
Variable :
y_Lat(:) :real(DP), allocatable, save, public
: $ varphi $ [rad.] . 緯度. Latitude
y_Lat_Weight
Variable :
y_Lat_Weight(:) :real(DP), allocatable, save, public
: $ Delta varphi $ [rad.] . 緯度座標重み. Weight of latitude
z_DelSigma
Variable :
z_DelSigma(:) :real(DP), allocatable, save, public
: $ Delta sigma $ (整数). $ Delta sigma $ (Full)
z_Sigma
Variable :
z_Sigma(:) :real(DP), allocatable, save, public
: $ sigma $ レベル (整数). Full $ sigma $ level

Private Instance methods

Subroutine :

依存モジュールの初期化チェック

Check initialization of dependency modules

[Source]

  subroutine InitCheck
    !
    ! 依存モジュールの初期化チェック
    !
    ! Check initialization of dependency modules

    ! モジュール引用 ; USE statements
    !

    ! NAMELIST ファイル入力に関するユーティリティ
    ! Utilities for NAMELIST file input
    !
    use namelist_util, only: namelist_util_inited

    ! 格子点設定
    ! Grid points settings
    !
    use gridset, only: gridset_inited

    ! 物理定数設定
    ! Physical constants settings
    !
    use constants, only: constants_inited

    ! メッセージ出力
    ! Message output
    !
    use dc_message, only: MessageNotify

    ! 実行文 ; Executable statement
    !

    if ( .not. namelist_util_inited ) call MessageNotify( 'E', module_name, '"namelist_util" module is not initialized.' )

    if ( .not. gridset_inited ) call MessageNotify( 'E', module_name, '"gridset" module is not initialized.' )

    if ( .not. constants_inited ) call MessageNotify( 'E', module_name, '"constants" module is not initialized.' )

  end subroutine InitCheck
Sigma
Variable :
Sigma(1:MaxNmlArySize) :real(DP), save
: $ sigma $ レベル (半整数). Half $ sigma $ level
module_name
Constant :
module_name = ‘axesset :character(*), parameter
: モジュールの名称. Module name
version
Constant :
version = ’$Name: dcpam5-20080731 $’ // ’$Id: axesset.f90,v 1.1.1.1 2008-07-30 08:41:33 morikawa Exp $’ :character(*), parameter
: モジュールのバージョン Module version

[Validate]