!---------------------------------------------------------------------
!     Copyright (C) GFD Dennou Club, 2005. All rights reserved.
!---------------------------------------------------------------------
                                                                 !=begin
!= Module constants_mod
!
!   * Developers: Morikawa Yasuhiro
!   * Version: $Id$
!   * Tag Name: $Name$
!   * Change History: 
!
!== Overview
!
!Provide information about axis X
!
!== Error Handling
!
!== Known Bugs
!
!== Note
!
!== Future Plans
!
!
                                                                 !=end
module axis_x_mod
                                                                 !=begin
  !== Dependency
  use type_mod,      only : INTKIND, STRING
  use axis_type_mod, only : AXISINFO
                                                                 !=end
  implicit none
                                                                 !=begin
  !== Public Interface
  private
  public :: axis_x_init, axis_x_weight, axis_x_spectral ! subroutines
  public :: axis_x_manual, axis_x_netcdf, axis_x_end    ! subroutines
                                                                 !=end

  type(AXISINFO)   ,save:: x_Dim        ! 次元情報を包括する変数
  type(AXISINFO)   ,save:: x_Dim_Weight ! 次元重み情報を包括する変数

  logical          ,save:: axis_x_data_from_spectral = .false.
  logical          ,save:: axis_x_data_from_manual   = .false.
  character(STRING),save:: axis_x_data_from_netcdf   = ''

  logical          ,save:: axis_x_initialized = .false.
  character(STRING),parameter:: version = &
       & '$Id$'
  character(STRING),parameter:: tagname = '$Name$'

contains
                                                                 !=begin
  !== Procedure Interface
  !
  !=== Initialize module and acquire NAMELIST
  !
  !モジュールを初期化し、NAMELIST から値を取得する。
  !NAMELIST から値が取得できないものに関しては上記のデフォルト値が
  !用いられる。
  !
  !NAMELIST ファイルは、メインプログラムにて ((< nmlfile_mod >)) の
  !((< nmlfile_init >)) で指定されることが想定されているが、
  !もしもこの初期化ルーチンより以前に指定されていなければ、
  !((< nmlfile_init >)) のデフォルトで指定される NAMELIST ファイルを
  !読む。
  !
  subroutine axis_x_init
  !==== Dependency
    use type_mod,  only: STRING, TOKEN, INTKIND, REKIND, DBKIND, NMLARRAY
    use grid_3d_mod,only: im, grid_3d_init
    use axis_type_mod, only : axis_attrs_copy, axis_attrs_init
    use gt4_history, only: GT_HISTORY_ATTR
    use dc_types,  only: GT_TOKEN => TOKEN, GT_STRING => STRING
    use dc_url,    only: GT_ATMARK, GT_QUESTION
    use dc_trace,  only: DbgMessage, BeginSub, EndSub
    use dc_error,  only: StoreError, USR_ECHAR
                                                                 !=end
    implicit none
    !-------------------------------------------------------------------
    !   変数定義
    !-------------------------------------------------------------------
                                                                 !=begin
    !
    !==== NAMELIST
    !
    character(TOKEN)  :: name        = '' ! 次元変数名
    integer(INTKIND)  :: length      = 0  ! 次元長 (配列サイズ)
    character(STRING) :: longname    = '' ! 次元変数の記述的名称
    character(STRING) :: units       = '' ! 次元変数の単位
    character(TOKEN)  :: xtype       = '' ! 次元変数の型
    character(STRING) :: decision    = '' ! 次元データの取得方法
    real(REKIND)      :: Data(NMLARRAY)  = 0.0 ! 次元データ入力用

    namelist /axis_x_nml/ &
         & name         , &  ! 次元変数名
         & length       , &  ! 次元長 (配列サイズ)
         & longname     , &  ! 次元変数の記述的名称
         & units        , &  ! 次元変数の単位
         & xtype        , &  ! 次元変数の型
         & decision     , &  ! 次元データの取得方法
         & Data              ! 次元データ
                                                                 !=end
                                                                 !=begin
    character(GT_TOKEN)  :: attrname = '' ! 属性名
    character(GT_TOKEN)  :: attrtype = '' ! 属性値の型
    character(GT_STRING) :: cvalue   = '' ! 属性の値 (文字)
    integer(INTKIND)     :: ivalue   = 0      ! 属性の値 (整数)
    real(REKIND)         :: rvalue   = 0.0    ! 属性の値 (単精度実数)
    real(DBKIND)         :: dvalue   = 0.0d0  ! 属性の値 (倍精度実数)
    logical              :: lvalue   = .false.! 属性の値 (論理)
    integer(INTKIND)     :: arraysize= 0      ! 配列のサイズ
    integer(INTKIND) :: iarray(NMLARRAY)  = 0    ! 属性の値 (整数)
    real(REKIND)     :: rarray(NMLARRAY)  = 0.0  ! 属性の値 (単精度実数)
    real(DBKIND)     :: darray(NMLARRAY)  = 0.0d0! 属性の値 (倍精度実数)

    namelist /axis_x_attr_nml/ &
         & attrname     , &  ! 属性名
         & attrtype     , &  ! 属性値の型
         & cvalue       , &  ! 属性の値 (文字)
         & ivalue       , &  ! 属性の値 (整数)
         & rvalue       , &  ! 属性の値 (単精度実数)
         & dvalue       , &  ! 属性の値 (倍精度実数)
         & lvalue       , &  ! 属性の値 (論理)
         & arraysize    , &  ! 配列のサイズ
         & iarray       , &  ! 属性の値 (整数)
         & rarray       , &  ! 属性の値 (単精度実数)
         & darray            ! 属性の値 (倍精度実数)
                                                                 !=end

    !-----------------------------------------------------------------
    !   変数情報の一時格納変数
    !-----------------------------------------------------------------
    type(GT_HISTORY_ATTR), allocatable :: attrs_tmp(:)

    !-----------------------------------------------------------------
    !   汎用変数
    !-----------------------------------------------------------------
    integer(INTKIND)            :: i, k, nmlstat

    integer(INTKIND)            :: nmlstat, nmlunit
    logical                     :: nmlreadable
    character(STRING), parameter:: subname = "axis_x_init"
  continue

    !----------------------------------------------------------------
    !   Check Initialization
    !----------------------------------------------------------------
    call BeginSub(subname)
    if (axis_x_initialized) then
       call EndSub( subname, '%c is already called', c1=trim(subname) )
       return
    else
       axis_x_initialized = .true.
    endif

    !----------------------------------------------------------------
    !   Version identifier
    !----------------------------------------------------------------
    call DbgMessage('%c :: %c', c1=trim(version), c2=trim(tagname))

    !----------------------------------------------------------------
    !   read axis_x_nml
    !----------------------------------------------------------------
    call nmlfile_init
    call nmlfile_open(nmlunit, nmlreadable)
    if (nmlreadable) then
       read(nmlunit, nml=axis_x_nml, iostat=nmlstat)
       call DbgMessage('Stat of NAMELIST axis_x_nml Input is <%d>', &
            &           i=(/nmlstat/))
       write(0, nml=axis_x_nml)
    else
       call DbgMessage('Not Read NAMELIST axis_x_nml')
       call MessageNotify('W', subname, &
            & 'Can not Read NAMELIST axis_x_nml. Force Use Default Value.')
    end if
    call nmlfile_close

    x_Dim%stored   = .false.
    !  次元変数の情報を構造型変数 x_Dim への代入
    x_Dim%axisinfo%name     = name
    x_Dim%axisinfo%length   = length
    x_Dim%axisinfo%longname = longname
    x_Dim%axisinfo%units    = units
    x_Dim%axisinfo%xtype    = xtype
    allocate( x_Dim%a_Dim(x_Dim%axisinfo%length) )

    !  次元変数の情報を構造型変数 x_Dim への代入
    select case(decision)

    ! manual: NAMELIST の Data で入力
    case('manual')
       x_Dim%a_Dim(:)                       = 0
       x_Dim%a_Dim(1:x_Dim%axisinfo%length) = Data(1:x_Dim%axisinfo%length)
       x_Dim%stored                         = .true.
       axis_x_data_from_manual              = .true.

    ! spectral: SPMODEL の wa_module により生成
    case('spectral')
       axis_x_data_from_spectral = .true.
       x_Dim%stored              = .false.

    ! foo.nc@lon: foo.nc ファイルの lon 変数から取得
    ! その他    : spectral と同じに
    case default
       ! 文字の中に '@' か '?' が含まれる場合は gtool4 変数として
       ! 認識し、その nc ファイルから変数情報をコピーする。
       if (   index(decision, GT_ATMARK)   > 0 .or.  &
            & index(decision, GT_QUESTION) > 0) then
          axis_x_data_from_netcdf  = decision
          x_Dim%stored             = .false.
       ! それ以外は 'spectral' と同じように処理
       else
          axis_x_data_from_spectral = .true.
          x_Dim%stored         = .false.
       endif
    end select

    !----------------------------------------------------------------
    !   read axis_x_attr_nml
    !----------------------------------------------------------------
    call nmlfile_init
    call nmlfile_open(nmlunit, nmlreadable)


    if (nmlreadable) then
       read(nmlunit, nml=axis_x_attr_nml, iostat=nmlstat)
       call DbgMessage('Stat of NAMELIST axis_x_attr_nml Input is <%d>', &
            &           i=(/nmlstat/))
       write(0, nml=axis_x_attr_nml)
    else
       call DbgMessage('Not Read NAMELIST axis_x_attr_nml')
       call MessageNotify('W', subname, &
            & 'Can not Read NAMELIST axis_x_attr_nml. Force Use Default Value.')
    end if


    call nmlfile_close

    !----------------------------------------------------------------
    !   axis_x_attr_nml  読み込み
    !----------------------------------------------------------------
    i = 0

    axis_x_attr_nml_input : do
       call DbgMessage('NAMELIST axis_x_attr_nml Input, <%d> time', i=(/i/))
       i = i + 1
       ! 初期化
       attrname  = ''     ! 属性名
       attrtype  = ''     ! 属性値の型
       cvalue    = ''     ! 属性の値 (文字)
       ivalue    = 0      ! 属性の値 (整数)
       rvalue    = 0.0    ! 属性の値 (単精度実数)
       dvalue    = 0.0d0  ! 属性の値 (倍精度実数)
       lvalue    = .false.! 属性の値 (論理)
       arraysize = 0      ! 配列のサイズ
       iarray(:) = 0      ! 属性の値 (整数)
       rarray(:) = 0.0    ! 属性の値 (単精度実数)
       darray(:) = 0.0d0  ! 属性の値 (倍精度実数)

       ! nml の読み込み
       read(5,nml=axis_x_attr_nml, iostat=nmlstat)
       call DbgMessage('Stat of NAMELIST axis_x_attr_nml Input is <%d>', & 
            &       i=(/nmlstat/))
       write(6,nml=axis_x_attr_nml)

       ! 有効でない値を含むものに関しては無視。
       if (attrname == '') then
          call DbgMessage('attrname is blank. so this axis_x_attr_nml is ignored.')
          if (next) cycle
          if (.not. next) exit
       elseif (attrtype == '') then
          call DbgMessage('attrtype is blank. so this axis_x_attr_nml is ignored.')
          if (next) cycle
          if (.not. next) exit
       endif

       !--------------------------------------------------------------
       ! x_Dim%attrs への格納
       !--------------------------------------------------------------
       ! attrs(:) の拡張
       if ( .not. allocated(x_Dim%attrs) ) then
          allocate( x_Dim%attrs(1) )
          k = 1
       else
          k = size( x_Dim%attrs ) + 1
          ! 配列データの領域確保
          allocate( attrs_tmp(k-1) )
          call axis_attrs_copy(from=x_Dim%attrs(1:k-1), to=attrs_tmp(1:k-1))
          deallocate( x_Dim%attrs )
          allocate( x_Dim%attrs(k) )
          call axis_attrs_copy(from=attrs_tmp(1:k-1), to=x_Dim%attrs(1:k-1))
          deallocate( attrs_tmp )
       endif

       if (arraysize > 0) then
          call axis_attrs_init(x_Dim%attrs(k))

          deallocate(  x_Dim%attrs(k)%iarray  )
          deallocate(  x_Dim%attrs(k)%rarray  )
          deallocate(  x_Dim%attrs(k)%darray  )

          allocate(  x_Dim%attrs(k)%iarray( arraysize )  )
          allocate(  x_Dim%attrs(k)%rarray( arraysize )  )
          allocate(  x_Dim%attrs(k)%darray( arraysize )  )

          x_Dim%attrs(k)%array = .true.

       else
          call axis_attrs_init(x_Dim%attrs(k))
       endif

       x_Dim%attrs(k)%attrname  = attrname
       x_Dim%attrs(k)%attrtype  = attrtype
       x_Dim%attrs(k)%cvalue    = cvalue
       x_Dim%attrs(k)%ivalue    = ivalue
       x_Dim%attrs(k)%rvalue    = rvalue
       x_Dim%attrs(k)%dvalue    = dvalue
       x_Dim%attrs(k)%lvalue    = lvalue
       x_Dim%attrs(k)%iarray(1:max(1,arraysize)) = iarray(1:max(1,arraysize))
       x_Dim%attrs(k)%rarray(1:max(1,arraysize)) = rarray(1:max(1,arraysize))
       x_Dim%attrs(k)%darray(1:max(1,arraysize)) = darray(1:max(1,arraysize))

       call DbgMessage('x_Dim-attrs(%d) [attrname=<%c> '            // &
            & 'attrtype=<%c> array=<%b> cvalue=<%c>  '         // &
            & 'ivalue=<%d> rvalue=<%r> dvalue=<%f> '           // &
            & 'iarray(1:%d)=<%d, ...> '                        // &
            & 'rarray(1:%d)=<%r, ...> darray(1:%d)=<%f, ...>'   , &
            & c1=trim( x_Dim%attrs(k)%attrname )                  , &
            & c2=trim( x_Dim%attrs(k)%attrtype )                  , &
            & c3=trim( x_Dim%attrs(k)%cvalue )                    , &
            & i=(/ k, x_Dim%attrs(k)%ivalue    ,                    &
            &      size(x_Dim%attrs(k)%iarray) ,                    &
            &      x_Dim%attrs(k)%iarray       ,                    &
            &      size(x_Dim%attrs(k)%rarray) ,                    &
            &      size(x_Dim%attrs(k)%darray)                      &
            &   /)                                                , &
            & r=(/x_Dim%attrs(k)%rvalue, x_Dim%attrs(k)%rarray/)    , &
            & d=(/x_Dim%attrs(k)%dvalue, x_Dim%attrs(k)%darray/)    , &
            & l=(/x_Dim%attrs(k)%lvalue/)                      )

       if (.not. next) exit
       next      = .false.  ! 次回のための初期化

    enddo axis_x_attr_nml_input

    !----------------------------------------------------------------
    !   grid_3d_mod との整合性をチェック
    !----------------------------------------------------------------
    call grid_3d_init
    if (x_Dim%axisinfo%length /= im) then
       call StoreError(USR_ECHAR, subname, &
            & cause_c='axis length is inconsistent with im in grid_3d_mod')
    endif

    !----------------------------------------------------------------
    !   例外処理
    !----------------------------------------------------------------
    if (length < 1) then
       call StoreError(USR_ECHAR, subname, cause_c='Invalid grid number.')
    endif


    call EndSub( subname )
  end subroutine axis_x_init


  subroutine axis_x_weight(Dim_Weight)
    use type_mod,   only: pi
    use axis_type_mod, only: axis_type_copy, axis_attrs_copy, axis_attrs_init
    use spml_mod,   only: spml_init, wa_module_x_Lon_Weight => x_Lon_Weight
    use grid_3d_mod,only: im
    use gt4_history,only: GT_HISTORY_ATTR
    use dc_trace,   only: DbgMessage, BeginSub, EndSub
    use dc_error,   only: StoreError, USR_ECHAR
    implicit none
    type(AXISINFO), intent(out) :: Dim_Weight ! 次元情報を包括する変数
    type(GT_HISTORY_ATTR), allocatable :: attrs_tmp(:) ! 次元情報を一時格納

    character(STRING), parameter:: subname = "axis_x_weight"
  continue
    !----------------------------------------------------------------
    !   Check Initialization
    !----------------------------------------------------------------
    call BeginSub( subname )
    if (.not. axis_x_initialized) then
       call EndSub( subname, 'Call axis_x_init before call %c', &
            &       c1=trim(subname) )
       return
    endif

    !----------------------------------------------------------------
    !   decision が 'spectral' でない場合は停止して返す。
    !----------------------------------------------------------------
    if (.not. axis_x_data_from_spectral) then
       call EndSub( subname, &
            & 'In axis_x_nml, configurated to not generate from spmodel')
       return
    endif

    !----------------------------------------------------------------
    !   x_Dim の情報から x_Dim_Weight の情報を生成。
    !----------------------------------------------------------------
    x_Dim_Weight%axisinfo%name     = trim(x_Dim%axisinfo%name) // '_weight'
    x_Dim_Weight%axisinfo%length   = x_Dim%axisinfo%length
    x_Dim_Weight%axisinfo%longname = trim(x_Dim%axisinfo%longname) // ' weight'
    x_Dim_Weight%axisinfo%units    = trim(x_Dim%axisinfo%units)
    x_Dim_Weight%axisinfo%xtype    = trim(x_Dim%axisinfo%xtype)
    if ( allocated(x_Dim_Weight%attrs) ) then
       deallocate( x_Dim_Weight%attrs )
    endif

    ! x_Dim にも情報付加
    if ( allocated(x_Dim%attrs) ) then
       allocate( attrs_tmp(size(x_Dim%attrs)) )
       call axis_attrs_copy(from=x_Dim%attrs(:), to=attrs_tmp(:))
       deallocate( x_Dim%attrs )
       allocate( x_Dim%attrs(size(attrs_tmp)+1) )
       call axis_attrs_copy(from=attrs_tmp(:), to=x_Dim%attrs(1:size(attrs_tmp)) )

       call axis_attrs_init( x_Dim%attrs(size(attrs_tmp)+1) )
       x_Dim%attrs(size(attrs_tmp)+1)%attrname = 'gt_calc_weight'
       x_Dim%attrs(size(attrs_tmp)+1)%attrtype = 'char'
       x_Dim%attrs(size(attrs_tmp)+1)%cvalue   = x_Dim_Weight%axisinfo%name
       x_Dim%attrs(size(attrs_tmp)+1)%array    = .false.
    else
       allocate( x_Dim%attrs(1) )
       call axis_attrs_init( x_Dim%attrs(1) )
       x_Dim%attrs(1)%attrname = 'gt_calc_weight'
       x_Dim%attrs(1)%attrtype = 'char'
       x_Dim%attrs(1)%cvalue   = x_Dim_Weight%axisinfo%name
       x_Dim%attrs(1)%array    = .false.
    endif

    !----------------------------------------------------------------
    !   wa_module からスペクトルデータを受け取る。
    !----------------------------------------------------------------
    call spml_init
    allocate( x_Dim_Weight%a_Dim(im) )
    ! ラジアンを度数に変換して代入
    x_Dim_Weight%a_Dim(:) = wa_module_x_Lon_Weight(:) * 180. / pi
    x_Dim_Weight%stored   = .true.

    !----------------------------------------------------------------
    !   intent(out) の引数にデータを渡す。
    !----------------------------------------------------------------
    call axis_type_copy(x_Dim_Weight, Dim_Weight)
    call EndSub( subname )
  end subroutine axis_x_weight




  subroutine axis_x_spectral(Dim)
    use axis_type_mod, only: axis_type_copy
    use type_mod,   only: pi
    use spml_mod,   only: spml_init, wa_module_x_Lon => x_Lon
    use dc_string,  only: toChar
    use dc_trace,   only: DbgMessage, BeginSub, EndSub
    use dc_error,   only: StoreError, USR_ECHAR
    implicit none
    type(AXISINFO), intent(inout) :: Dim        ! 次元情報を包括する変数

    character(STRING), parameter:: subname = "axis_x_spectral"
  continue
    !----------------------------------------------------------------
    !   Check Initialization
    !----------------------------------------------------------------
    call BeginSub( subname )
    if (.not. axis_x_initialized) then
       call EndSub( subname, 'Call axis_x_init before call %c', &
            &       c1=trim(subname) )
       return
    endif

    !----------------------------------------------------------------
    !   decision が 'spectral' でない場合は停止して返す。
    !----------------------------------------------------------------
    if (.not. axis_x_data_from_spectral) then
       call EndSub( subname, &
            & 'In axis_x_nml, configurated to not generate from spmodel')
       return
    endif

    !----------------------------------------------------------------
    !   wa_module からスペクトルデータを受け取る。
    !----------------------------------------------------------------
    call spml_init
    ! ラジアンを度数に変換して代入
    x_Dim%a_Dim(:) = wa_module_x_Lon(:) * 180. / pi
    x_Dim%stored   = .true.

    call DbgMessage('x_Lon=<%c>', c1=trim(toChar(x_Dim%a_Dim)) )

    !----------------------------------------------------------------
    !   intent(out) の引数にデータを渡す。
    !----------------------------------------------------------------
    call axis_type_copy(x_Dim, Dim)
    call EndSub( subname )
  end subroutine axis_x_spectral




  subroutine axis_x_manual(Dim)
    use axis_type_mod, only: axis_type_copy
    use spml_mod,   only: spml_init, wa_module_x_Lon => x_Lon
    use dc_trace,   only: DbgMessage, BeginSub, EndSub
    use dc_error,   only: StoreError, USR_ECHAR
    implicit none
    type(AXISINFO), intent(inout) :: Dim        ! 次元情報を包括する変数

    character(STRING), parameter:: subname = "axis_x_manual"
  continue
    !----------------------------------------------------------------
    !   Check Initialization
    !----------------------------------------------------------------
    call BeginSub( subname )
    if (.not. axis_x_initialized) then
       call EndSub( subname, 'Call axis_x_init before call %c', &
            &       c1=trim(subname) )
       return
    endif

    !----------------------------------------------------------------
    !   decision が 'manual' でない場合は停止して返す。
    !----------------------------------------------------------------
    if (.not. axis_x_data_from_manual) then
       call EndSub( subname, &
            & 'In axis_x_nml, configurated to not generate from manual')
       return
    endif

    !----------------------------------------------------------------
    !   intent(out) の引数にデータを渡す。
    !----------------------------------------------------------------
    call axis_type_copy(x_Dim, Dim)
    call EndSub( subname )
  end subroutine axis_x_manual


  subroutine axis_x_netcdf(Dim)
    use axis_type_mod, only: axis_type_copy
    use gt4_history,only: HistoryGet
    use dc_url  ,   only: UrlSplit
    use dc_trace,   only: DbgMessage, BeginSub, EndSub
    use dc_error,   only: StoreError, USR_ECHAR
    implicit none
    type(AXISINFO), intent(inout) :: Dim        ! 次元情報を包括する変数

    character(STRING)           :: file
    character(STRING)           :: varname

    character(STRING), parameter:: subname = "axis_x_netcdf"
  continue
    !----------------------------------------------------------------
    !   Check Initialization
    !----------------------------------------------------------------
    call BeginSub( subname )
    if (.not. axis_x_initialized) then
       call EndSub( subname, 'Call axis_x_init before call %c', &
            &       c1=trim(subname) )
       return
    endif

    !----------------------------------------------------------------
    !   decision が '***@lon' などでない場合は停止して返す。
    !----------------------------------------------------------------
    if (axis_x_data_from_netcdf == '') then
       call EndSub( subname, &
            & 'In axis_x_nml, configurated to not generate from netcdf data')
       return
    endif

    !----------------------------------------------------------------
    !   HistoryGet によるデータ入力
    !----------------------------------------------------------------
    call UrlSplit(axis_x_data_from_netcdf, file=file, var=varname)
    call HistoryGet(file, varname, x_Dim%a_Dim)
    x_Dim%stored   = .true.

    !----------------------------------------------------------------
    !   intent(out) の引数にデータを渡す。
    !----------------------------------------------------------------
    call axis_type_copy(x_Dim, Dim)
    call EndSub( subname )
  end subroutine axis_x_netcdf




  subroutine axis_x_end
    use dc_trace,  only: DbgMessage, BeginSub, EndSub
    implicit none
    character(STRING), parameter:: subname = "axis_x_end"
  continue
    !----------------------------------------------------------------
    !   Check Initialization
    !----------------------------------------------------------------
    call BeginSub(subname)
    if ( .not. axis_x_initialized) then
       call EndSub( subname, 'axis_x_init was not called', &
            &       c1=trim(subname) )
       return
    else
       axis_x_initialized = .false.
       axis_x_data_from_spectral = .false.
       axis_x_data_from_manual   = .false.
       axis_x_data_from_netcdf   = ''
    endif

    call EndSub( subname )
  end subroutine axis_x_end

end module axis_x_mod
