Class ground_file_io
In: io/ground_file_io.f90

地表面データファイルの入力

Ground data file input

Note that Japanese and English are described in parallel.

海面温度や地表面諸量に関するデータを NetCDF ファイルから入力します.

Data about sea surface temperature (SST) or various values on surface are input from a NetCDF file.

Procedures List

GroundFileGet :地表面データファイルの入力
———— :————
GroundFileGet :Input ground data file

NAMELIST

NAMELIST#ground_file_io_nml

Methods

Included Modules

gridset dc_types dc_message gt4_history surface_data dc_string timeset namelist_util dc_iounit fileset constants axesset

Public Instance methods

Subroutine :
xy_SurfTemp(0:imax-1, 1:jmax) :real(DP), intent(out), optional
: 地表面温度. Surface temperature
xy_SurfAlbedo(0:imax-1, 1:jmax) :real(DP), intent(out), optional
: 地表アルベド. Surface albedo
xy_SurfHumidCoeff(0:imax-1, 1:jmax) :real(DP), intent(out), optional
: 地表湿潤度. Surface humidity coefficient
xy_SurfRoughLength(0:imax-1, 1:jmax) :real(DP), intent(out), optional
: 地表粗度長. Surface rough length
xy_SurfHeatCapacity(0:imax-1, 1:jmax) :real(DP), intent(out), optional
: 地表熱容量. Surface heat capacity
xy_GroundTempFlux(0:imax-1, 1:jmax) :real(DP), intent(out), optional
: 地中熱フラックス. Ground temperature flux
xy_SurfCondition(0:imax-1, 1:jmax) :integer, intent(out), optional
: 地表状態. Surface condition

地表面データを取得します.

Get data on ground.

[Source]

  subroutine GroundFileGet( xy_SurfTemp, xy_SurfAlbedo, xy_SurfHumidCoeff, xy_SurfRoughLength, xy_SurfHeatCapacity, xy_GroundTempFlux, xy_SurfCondition )
    !
    ! 地表面データを取得します.
    !
    ! Get data on ground.
    !

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

    ! 地表面データ提供
    ! Prepare surface data
    !
    use surface_data, only: SurfDataGet

    ! gtool4 データ入力
    ! Gtool4 data input
    !
    use gt4_history, only: HistoryGet

    ! 文字列操作
    ! Character handling
    !
    use dc_string, only: toChar

    ! 宣言文 ; Declaration statements
    !
    implicit none
    real(DP), intent(out), optional:: xy_SurfTemp (0:imax-1, 1:jmax)
                              ! 地表面温度. 
                              ! Surface temperature
    real(DP), intent(out), optional:: xy_SurfAlbedo (0:imax-1, 1:jmax)
                              ! 地表アルベド. 
                              ! Surface albedo
    real(DP), intent(out), optional:: xy_SurfHumidCoeff (0:imax-1, 1:jmax)
                              ! 地表湿潤度. 
                              ! Surface humidity coefficient
    real(DP), intent(out), optional:: xy_SurfRoughLength (0:imax-1, 1:jmax)
                              ! 地表粗度長. 
                              ! Surface rough length
    real(DP), intent(out), optional:: xy_SurfHeatCapacity (0:imax-1, 1:jmax)
                              ! 地表熱容量. 
                              ! Surface heat capacity
    real(DP), intent(out), optional:: xy_GroundTempFlux (0:imax-1, 1:jmax)
                              ! 地中熱フラックス. 
                              ! Ground temperature flux
    integer, intent(out), optional:: xy_SurfCondition (0:imax-1, 1:jmax)
                              ! 地表状態. 
                              ! Surface condition

    ! 作業変数
    ! Work variables
    !

    ! 実行文 ; Executable statement
    !

    if ( .not. ground_file_io_inited ) call GroundFileInit

    ! データ (デフォルト値) を initial_data モジュールから取得
    ! Data (default values) is input from "initial_data" module
    ! 
    call SurfDataGet( xy_SurfTemp, xy_SurfAlbedo, xy_SurfHumidCoeff, xy_SurfRoughLength, xy_SurfHeatCapacity, xy_GroundTempFlux, xy_SurfCondition )            ! (out)

    ! データを InputFile から取得
    ! Data is input from InputFile
    ! 
    if ( trim(InputFile) /= '' ) then

      ! データ入力
      ! Data input
      ! 
      if ( trim(SurfTempVarname) /= '' ) then
        call HistoryGet( InputFile, SurfTempVarname, xy_SurfTemp )
      end if

      if ( trim(SurfAlbedoVarname) /= '' ) then
        call HistoryGet( InputFile, SurfAlbedoVarname, xy_SurfAlbedo )
      end if

      if ( trim(SurfHumidcoeffVarname) /= '' ) then
        call HistoryGet( InputFile, SurfHumidcoeffVarname, xy_SurfHumidcoeff )
      end if

      if ( trim(SurfRoughLengthVarname) /= '' ) then
        call HistoryGet( InputFile, SurfRoughLengthVarname, xy_SurfRoughLength )
      end if

      if ( trim(SurfHeatCapacityVarname) /= '' ) then
        call HistoryGet( InputFile, SurfHeatCapacityVarname, xy_SurfHeatCapacity )
      end if

      if ( trim(GroundTempFluxVarname) /= '' ) then
        call HistoryGet( InputFile, GroundTempFluxVarname, xy_GroundTempFlux )
      end if

      if ( trim(SurfConditionVarname) /= '' ) then
        call HistoryGet( InputFile, SurfConditionVarname, xy_SurfCondition )
      end if

    end if

  end subroutine GroundFileGet
ground_file_io_inited
Variable :
ground_file_io_inited = .false. :logical, save, public
: 初期設定フラグ. Initialization flag
ground_file_opened
Variable :
ground_file_opened = .false. :logical, save, public
: 地表面データファイルのオープンに関するフラグ. Flag of ground data file open

Private Instance methods

Subroutine :

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

"ground_file_io" module is initialized. "NAMELIST#ground_file_io_nml" is loaded in this procedure.

This procedure input/output NAMELIST#ground_file_io_nml .

[Source]

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

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

    ! 時刻管理
    ! Time control
    !
    use timeset, only: DelTime, TimesetGetDelTime

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

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

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

    ! 宣言文 ; Declaration statements
    !
    implicit none

    ! 作業変数
    ! 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 /ground_file_io_nml/ InputFile, SurfTempVarname, SurfAlbedoVarname, SurfHumidCoeffVarname, SurfRoughLengthVarname, SurfHeatCapacityVarname, GroundTempFluxVarname, SurfConditionVarname
          !
          ! デフォルト値については初期化手続 "ground_file_io#GroundFileInit" 
          ! のソースコードを参照のこと. 
          !
          ! Refer to source codes in the initialization procedure
          ! "ground_file_io#GroundFileInit" for the default values. 
          !

!!$      & OutputFile, &
!!$      & IntValue, IntUnit


    ! 実行文 ; Executable statement
    !

    if ( ground_file_io_inited ) return
    call InitCheck

    ! デフォルト値の設定
    ! Default values settings
    !
    InputFile  = ''
    SurfTempVarname         = ''
    SurfAlbedoVarname       = ''
    SurfHumidCoeffVarname   = ''
    SurfRoughLengthVarname  = ''
    SurfHeatCapacityVarname = ''
    GroundTempFluxVarname   = ''
    SurfConditionVarname    = ''

!!$    OutputFile = 'sst.nc'
!!$    IntValue   = 1.0_DP
!!$    IntUnit    = 'day'

    ! 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 = ground_file_io_nml, iostat = iostat_nml ) ! (out)
      close( unit_nml )

      call NmlutilMsg( iostat_nml, module_name ) ! (in)
      if ( iostat_nml == 0 ) write( STDOUT, nml = ground_file_io_nml )
    end if

    ! 印字 ; Print
    !
    call MessageNotify( 'M', module_name, '----- Initialization Messages -----' )
    call MessageNotify( 'M', module_name, 'Input:: ' )
    call MessageNotify( 'M', module_name, '  InputFile  = %c', c1 = trim(InputFile) )
    call MessageNotify( 'M', module_name, '  SurfTempVarname         = %c', c1 = trim(SurfTempVarname        ) )
    call MessageNotify( 'M', module_name, '  SurfAlbedoVarname       = %c', c1 = trim(SurfAlbedoVarname      ) )
    call MessageNotify( 'M', module_name, '  SurfHumidCoeffVarname   = %c', c1 = trim(SurfHumidCoeffVarname  ) )
    call MessageNotify( 'M', module_name, '  SurfRoughLengthVarname  = %c', c1 = trim(SurfRoughLengthVarname ) )
    call MessageNotify( 'M', module_name, '  SurfHeatCapacityVarname = %c', c1 = trim(SurfHeatCapacityVarname) )
    call MessageNotify( 'M', module_name, '  GroundTempFluxVarname   = %c', c1 = trim(GroundTempFluxVarname  ) )
    call MessageNotify( 'M', module_name, '  SurfConditionVarname    = %c', c1 = trim(SurfConditionVarname   ) )


!!$    call MessageNotify( 'M', module_name, 'Output:: ' )
!!$    call MessageNotify( 'M', module_name, '  OutputFile = %c', c1 = trim(OutputFile) )
!!$    call MessageNotify( 'M', module_name, '  IntTime    = %f [%c]', d = (/ IntValue /), c1 = trim(IntUnit) )
!!$    call MessageNotify( 'M', module_name, '  IntStep    = %d', i = (/ IntStep /) )
    call MessageNotify( 'M', module_name, '-- version = %c', c1 = trim(version) )

    ground_file_io_inited = .true.
  end subroutine GroundFileInit
GroundTempFluxVarname
Variable :
GroundTempFluxVarname :character(TOKEN), save
: 地中熱フラックスの変数名. Variable name of ground temperature flux
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

    ! 出力ファイルの基本情報管理
    ! Management basic information for output files
    !
    use fileset, only: fileset_inited

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

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

    ! 座標データ設定
    ! Axes data settings
    !
    use axesset, only: axesset_inited

    ! 時刻管理
    ! Time control
    !
    use timeset, only: timeset_inited


    ! 実行文 ; Executable statement
    !

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

    if ( .not. fileset_inited ) call MessageNotify( 'E', module_name, '"fileset" 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.' )

    if ( .not. axesset_inited ) call MessageNotify( 'E', module_name, '"axesset" module is not initialized.' )

    if ( .not. timeset_inited ) call MessageNotify( 'E', module_name, '"timeset" module is not initialized.' )


  end subroutine InitCheck
InputFile
Variable :
InputFile :character(STRING), save
: 入力する地表面データのファイル名 filename of input ground data
SurfAlbedoVarname
Variable :
SurfAlbedoVarname :character(TOKEN), save
: 地表アルベドの変数名. Variable name of surface albedo
SurfConditionVarname
Variable :
SurfConditionVarname :character(TOKEN), save
: 地表状態の変数名. Variable name of surface condition
SurfHeatCapacityVarname
Variable :
SurfHeatCapacityVarname :character(TOKEN), save
: 地表熱容量の変数名. Variable name of surface heat capacity
SurfHumidCoeffVarname
Variable :
SurfHumidCoeffVarname :character(TOKEN), save
: 地表湿潤度の変数名. Variable name of surface humidity coefficient
SurfRoughLengthVarname
Variable :
SurfRoughLengthVarname :character(TOKEN), save
: 地表粗度長の変数名. Variable name of surface rough length
SurfTempVarname
Variable :
SurfTempVarname :character(TOKEN), save
: 地表面温度の変数名. Variable name of surface temperature
module_name
Constant :
module_name = ‘ground_file_io :character(*), parameter
: モジュールの名称. Module name
version
Constant :
version = ’$Name: dcpam5-20080812 $’ // ’$Id: ground_file_io.f90,v 1.1 2008-08-11 21:58:50 morikawa Exp $’ :character(*), parameter
: モジュールのバージョン Module version

[Validate]