!= Matthews のデータに基づく惑星表面アルベド設定
!
!= set surface albedo based on data by Matthews
!
! Authors::   Yoshiyuki O. Takahashi
! Version::   $Id: set_albedo_Matthews.f90,v 1.1 2009-04-15 22:47:06 yot Exp $
! Tag Name::  $Name:  $
! Copyright:: Copyright (C) GFD Dennou Club, 2008-2009. All rights reserved.
! License::   See COPYRIGHT[link:../../../COPYRIGHT]
!

module set_albedo_Matthews

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

  ! 種別型パラメタ
  ! Kind type parameter
  !
  use dc_types, only: DP, &      ! 倍精度実数型. Double precision.
    &                 STRING     ! 文字列.       Strings.


  ! 格子点設定
  ! Grid points settings

  ! 宣言文 ; Declaration statements
  !
  implicit none
  private

  ! 公開手続き
  ! Public procedure
  !
  public:: SetAlbedoMathews

  ! 公開変数
  ! Public variables
  !
  logical, save, public:: set_albedo_mathews_inited = .false.
                              ! 初期設定フラグ.
                              ! Initialization flag

  ! 非公開変数
  ! Private variables
  !
  integer(4), parameter :: NAlbType = 32
  integer(4), parameter :: NSeason = 4
  real(DP)  , save      :: xy_Data_Albedo( NSeason, 0:NAlbType )

  !
  ! Matthews, 1985, NASA Technical memorandum #86199
  ! http://ntrs.nasa.gov/search.jsp?R=60233&id=1&qs=Ntt%3DMatthews%26Ntk%3Dall%26Ntx%3Dmode%2520matchall%26N%3D31%2B235%26Ns%3DHarvestDate%257c1
  !
  !    win.  spr.  sum.  fall
  !    Jan.  Apr.  Jul.  Oct.   for nothern hemisphere
  !    Jul.  Oct.  Jan.  Apr.   for southern hemisphere
  data xy_Data_Albedo / &
    30,   30,   30,   30, & !  0  The values for 0 are not included in Matthes compilation.
    11,   11,   11,   11, & !  1
    11,   11,   11,   11, & !  2
    11,   11,   11,   11, & !  3
    12,   12,   12,   12, & !  4
    12,   13,   14,   13, & !  5
    17,   14,   13,   14, & !  6
    13,   14,   16,   13, & !  7
    11,   12,   15,   12, & !  8
    18,   16,   15,   16, & !  9
    12,   15,   18,   13, & ! 10
    12,   15,   18,   13, & ! 11
    28,   32,   28,   28, & ! 12
    15,   13,   12,   13, & ! 13
    14,   14,   16,   14, & ! 14
    20,   18,   17,   18, & ! 15
    14,   14,   17,   14, & ! 16
    15,   15,   18,   15, & ! 17
    15,   15,   18,   15, & ! 18
    17,   20,   20,   17, & ! 19
    17,   20,   20,   17, & ! 20
    28,   32,   28,   28, & ! 21
    12,   12,   17,   15, & ! 22
    14,   15,   17,   15, & ! 23
    14,   15,   16,   14, & ! 24
    16,   18,   25,   20, & ! 25
    17,   17,   20,   17, & ! 26
    16,   20,   20,   18, & ! 27
    16,   20,   20,   18, & ! 28
    16,   20,   20,   18, & ! 29
    30,   30,   30,   30, & ! 30
    75,   75,   75,   75, & ! 31
    16,   18,   20,   18  & ! 32
    /


  character(*), parameter:: module_name = 'set_albedo_Matthews'
                              ! モジュールの名称.
                              ! Module name
  character(*), parameter:: version = &
    & '$Name:  $' // &
    & '$Id: set_albedo_Matthews.f90,v 1.1 2009-04-15 22:47:06 yot Exp $'
                              ! モジュールのバージョン
                              ! Module version

  ! INTERFACE 文 ; INTERFACE statements
  !

contains

  subroutine SetAlbedoMathews( xy_SurfCond, xy_SurfAlbedo )

    ! モジュール引用 ; 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
    !
    integer(4), intent(in ) :: xy_SurfCond  ( 0:imax-1, 1:jmax )
                              ! 地表状態 (0: 固定, 1: 可変).
                              ! Surface condition (0: fixed, 1: variable)
    real(DP)  , intent(out) :: xy_SurfAlbedo( 0:imax-1, 1:jmax )
                              ! 地表アルベド.
                              ! Surface albedo

    ! 作業変数
    ! Work variables
    !
    integer:: i               ! 経度方向に回る DO ループ用作業変数
                              ! Work variables for DO loop in longitude
    integer:: j               ! 緯度方向に回る DO ループ用作業変数
                              ! Work variables for DO loop in latitude
    integer:: l


    if ( .not. set_albedo_mathews_inited ) call SetAlbedoInit


    !
    ! Now, annual mean value is used, temporarily.
    !
    xy_SurfAlbedo = 0.0d0

    do l = 1, nseason
      do j = 1, jmax
        do i = 0, imax-1
          xy_SurfAlbedo(i,j) = xy_SurfAlbedo(i,j) + xy_Data_Albedo( l, xy_SurfCond(i,j) )
        end do
      end do
    end do

    xy_SurfAlbedo = xy_SurfAlbedo / dble( nseason )


  end subroutine SetAlbedoMathews

  !**************************************************************************************

  subroutine SetAlbedoInit

    ! 作業変数
    ! Work variables
    !
    integer:: l
    integer:: m


    do m = 0, NAlbType
      do l = 1, NSeason
        xy_Data_Albedo( l, m ) = xy_Data_Albedo( l, m ) * 1.0d-2
      end do
    end do


    set_albedo_mathews_inited = .true.

  end subroutine SetAlbedoInit

  !**************************************************************************************

end module set_albedo_Matthews
