Class set_Mars_dust
In: radiation/set_Mars_dust.f90

Dust distribution is set

Note that Japanese and English are described in parallel.

References

 Lewis, S. R., Collins, M., Forget, F.,
   Mars climate database v3.0 detailed design document,
   Technical Note. Contract 11369/95/NL/JG. Work Package 7, ESA, 2001.

Procedures List

!$ ! RadiationFluxDennouAGCM :放射フラックスの計算
!$ ! RadiationDTempDt :放射フラックスによる温度変化の計算
!$ ! RadiationFluxOutput :放射フラックスの出力
!$ ! RadiationFinalize :終了処理 (モジュール内部の変数の割り付け解除)
!$ ! ———— :————
!$ ! RadiationFluxDennouAGCM :Calculate radiation flux
!$ ! RadiationDTempDt :Calculate temperature tendency with radiation flux
!$ ! RadiationFluxOutput :Output radiation fluxes
!$ ! RadiationFinalize :Termination (deallocate variables in this module)

NAMELIST

!$ ! NAMELIST#radiation_DennouAGCM_nml

Methods

Included Modules

dc_types gridset dc_message gtool_historyauto constants timeset constants0 axesset read_time_series dc_iounit namelist_util

Public Instance methods

Subroutine :
xyr_Press(0:imax-1, 1:jmax, 0:kmax) :real(DP), intent(in )
: Pressure
xyz_QDust(0:imax-1, 1:jmax, 1:kmax) :real(DP), intent(in )
: Dust mixing ratio
xyr_DOD067(0:imax-1, 1:jmax, 0:kmax) :real(DP), intent(out)
: Optical depth

Calculate dust optical depth at 0.67 micron

[Source]

  subroutine SetMarsDustCalcDOD067( xyr_Press, xyz_QDust, xyr_DOD067 )
    !
    ! 
    !
    ! Calculate dust optical depth at 0.67 micron
    !

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

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

    ! ヒストリデータ出力
    ! History data output
    !
    use gtool_historyauto, only: HistoryAutoPut

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


    ! 宣言文 ; Declaration statements
    !

    real(DP), intent(in ):: xyr_Press (0:imax-1, 1:jmax, 0:kmax)
                              ! Pressure
    real(DP), intent(in ):: xyz_QDust (0:imax-1, 1:jmax, 1:kmax)
                              ! Dust mixing ratio
    real(DP), intent(out):: xyr_DOD067(0:imax-1, 1:jmax, 0:kmax)
                              ! Optical depth

    ! 作業変数
    ! Work variables
    !
    real(DP)            :: xyz_DelDOD(0:imax-1, 1:jmax, 1:kmax)

    integer :: k             ! 鉛直方向に回る DO ループ用作業変数
                             ! Work variables for DO loop in vertical direction

    ! 実行文 ; Executable statement
    !

    ! 初期化
    ! Initialization
    !
    if ( .not. set_Mars_dust_inited ) then
      call MessageNotify( 'E', module_name, 'This module has not been initialized.' )
    end if


    do k = 1, kmax
      xyz_DelDOD(:,:,k) = 3.0_DP / 4.0_DP * DustExtEff / ( REff * RhoDust * Grav ) * xyz_QDust(:,:,k) * ( xyr_Press(:,:,k-1) - xyr_Press(:,:,k) )
    end do

    k = kmax
    xyr_DOD067(:,:,k) = 0.0_DP
    do k = kmax-1, 0, -1
      xyr_DOD067(:,:,k) = xyr_DOD067(:,:,k+1) + xyz_DelDOD(:,:,k+1)
    end do


    ! ヒストリデータ出力
    ! History data output
    !


  end subroutine SetMarsDustCalcDOD067
Subroutine :

This procedure input/output NAMELIST#set_Mars_dust_nml .

[Source]

  subroutine SetMarsDustInit

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

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

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

    ! ヒストリデータ出力
    ! History data output
    !
    use gtool_historyauto, only: HistoryAutoAddVariable


    ! 宣言文 ; Declaration statements
    !

    integer:: unit_nml        ! NAMELIST ファイルオープン用装置番号.
                              ! Unit number for NAMELIST file open
    integer:: iostat_nml      ! NAMELIST 読み込み時の IOSTAT.
                              ! IOSTAT of NAMELIST read

    ! NAMELIST 変数群
    ! NAMELIST group name
    !
    namelist /set_Mars_dust_nml/ DustExtEff, REff, RhoDust, DustScenario, DODFileName, DODVarName, DOD067, DustVerDistCoef, DustOptDepRefPress, DustVerDistRefPress
          !
          ! デフォルト値については初期化手続 "rad_Mars_V1#RadMarsV1Init"
          ! のソースコードを参照のこと.
          !
          ! Refer to source codes in the initialization procedure
          ! "rad_Mars_V1#RadMarsV1Init" for the default values.
          !


    ! デフォルト値の設定
    ! Default values settings
    !

    DustExtEff = 3.04_DP   ! Ockert-Bell et al. (1997)
    REff       = 1.85d-6   ! Ockert-Bell et al. (1997)
    RhoDust    = 2500.0_DP ! Pettengill and Ford (2000)


    DustScenario    = 'Const'

    DODFileName     = ''
    DODVarName      = ''

    DOD067          = 0.2_DP
!!$    DustVerDistCoef = 0.01_DP
    DustVerDistCoef = 0.007_DP

!!$    DustOptDepRefPress  = 610.0_DP
!!$    DustVerDistRefPress = 610.0_DP
    DustOptDepRefPress  = 700.0_DP
    DustVerDistRefPress = 700.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 = set_Mars_dust_nml, iostat = iostat_nml )             ! (out)
      close( unit_nml )

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


    if ( DustScenario == 'Const' ) then
      IDDustScenario = IDDustScenarioConst
    else if ( DustScenario == 'VikingNoDS' ) then
      IDDustScenario = IDDustScenarioVikingNoDS
    else if ( DustScenario == 'Viking' ) then
      IDDustScenario = IDDustScenarioViking
    else if ( DustScenario == 'MGS' ) then
      IDDustScenario = IDDustScenarioMGS
    else if ( DustScenario == 'MGSDODFromFile' ) then
      IDDustScenario = IDDustScenarioMGSDODFromFile
    else
      call MessageNotify( 'E', module_name, 'DustScenario of %c is not supported.', c1 = trim( DustScenario ) )
    end if



    ! Initialization of modules used in this module
    !


    ! ヒストリデータ出力のためのへの変数登録
    ! Register of variables for history data output
    !
    call HistoryAutoAddVariable( 'DustPresc' , (/ 'lon ', 'lat ', 'sig ', 'time'/), 'DustPresc', '1' )

    call HistoryAutoAddVariable( 'DustMaxHeight' , (/ 'lon ', 'lat ', 'time'/), 'DustMaxHeight', 'm' )



    ! 印字 ; Print
    !
    call MessageNotify( 'M', module_name, '----- Initialization Messages -----' )
    call MessageNotify( 'M', module_name, 'DustExtEff          = %f', d  = (/ DustExtEff /) )
    call MessageNotify( 'M', module_name, 'REff                = %f', d  = (/ REff /) )
    call MessageNotify( 'M', module_name, 'RhoDust             = %f', d  = (/ RhoDust /) )
    call MessageNotify( 'M', module_name, 'DustScenario        = %c', c1 = trim( DustScenario ) )
    call MessageNotify( 'M', module_name, 'DODFileName         = %c', c1 = trim( DODFileName ) )
    call MessageNotify( 'M', module_name, 'DODVarName          = %c', c1 = trim( DODVarName ) )
    call MessageNotify( 'M', module_name, 'DOD067              = %f', d  = (/ DOD067      /) )
    call MessageNotify( 'M', module_name, 'DustVerDistCoef     = %f', d  = (/ DustVerDistCoef /) )
    call MessageNotify( 'M', module_name, 'DustOptDepRefPress  = %f', d  = (/ DustOptDepRefPress /) )
    call MessageNotify( 'M', module_name, 'DustVerDistRefPress = %f', d  = (/ DustVerDistRefPress /) )
    call MessageNotify( 'M', module_name, '-- version = %c', c1 = trim(version) )

    set_Mars_dust_inited = .true.

  end subroutine SetMarsDustInit
Subroutine :
Ls :real(DP), intent(in )
: Ls
xyr_Press(0:imax-1, 1:jmax, 0:kmax) :real(DP), intent(in )
: Pressure
xyz_Press(0:imax-1, 1:jmax, 1:kmax) :real(DP), intent(in )
: Pressure
xyr_DOD067(0:imax-1, 1:jmax, 0:kmax) :real(DP), intent(out)
: Optical depth

Set dust optical depth at 0.67 micron

[Source]

  subroutine SetMarsDustSetDOD067( Ls, xyr_Press, xyz_Press, xyr_DOD067 )
    !
    ! 
    !
    ! Set dust optical depth at 0.67 micron
    !

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

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

    ! ヒストリデータ出力
    ! History data output
    !
    use gtool_historyauto, only: HistoryAutoPut

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

    ! 物理・数学定数設定
    ! Physical and mathematical constants settings
    !
    use constants0, only: PI                    ! $ \pi $.
                              ! 円周率. Circular constant

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

    ! 座標データ設定
    ! Axes data settings
    !
    use axesset, only: y_Lat    ! $ \varphi $ [rad.] . 緯度. Latitude

    ! 時系列データの読み込み
    ! Reading time series
    !
    use read_time_series, only: SetValuesFromTimeSeriesWrapper


    ! 宣言文 ; Declaration statements
    !

    real(DP), intent(in ):: Ls
                              ! Ls
    real(DP), intent(in ):: xyr_Press    (0:imax-1, 1:jmax, 0:kmax)
                              ! Pressure
    real(DP), intent(in ):: xyz_Press    (0:imax-1, 1:jmax, 1:kmax)
                              ! Pressure
    real(DP), intent(out):: xyr_DOD067   (0:imax-1, 1:jmax, 0:kmax)
                              ! Optical depth

    ! 作業変数
    ! Work variables
    !
    real(DP)            :: DOD
    real(DP)            :: xy_DOD067       (0:imax-1, 1:jmax)
                              ! Dust optical depth at 0.67 micron
    real(DP)            :: xyz_MixRtDust   (0:imax-1, 1:jmax, 1:kmax)
    real(DP)            :: xy_DODFac       (0:imax-1, 1:jmax)
    real(DP)            :: xy_MaxHeightDust(0:imax-1, 1:jmax)

    real(DP)            :: MixRtDust0

    integer :: j
    integer :: k             ! 鉛直方向に回る DO ループ用作業変数
                             ! Work variables for DO loop in vertical direction

    ! 実行文 ; Executable statement
    !

    ! 初期化
    ! Initialization
    !
    if ( .not. set_Mars_dust_inited ) then
      call MessageNotify( 'E', module_name, 'This module has not been initialized.' )
    end if


    select case ( IDDustScenario )
    case ( IDDustScenarioConst )
      xy_DOD067 = DOD067

      ! Height of dust top
      xy_MaxHeightDust = 70.0d3

    case ( IDDustScenarioVikingNoDS )

      call SetMarsDustDODVikingNoDS( Ls, DOD )
      xy_DOD067 = DOD

      ! Height of dust top
!!$      xy_MaxHeightDust = 70.0d3
      !
      do j = 1, jmax
        xy_MaxHeightDust(:,j) = 60.0d3 + 18.0d3 * sin( ( Ls - 158.0_DP ) * PI / 180.0_DP ) - 22.0d3 * sin( y_Lat(j) )**2
      end do

    case ( IDDustScenarioViking )

      call SetMarsDustDODViking( Ls, DOD )
      xy_DOD067 = DOD

      ! Height of dust top
!!$      xy_MaxHeightDust = 70.0d3
      !
      do j = 1, jmax
        xy_MaxHeightDust(:,j) = 60.0d3 + 18.0d3 * sin( ( Ls - 158.0_DP ) * PI / 180.0_DP ) - 22.0d3 * sin( y_Lat(j) )**2
      end do

    case ( IDDustScenarioMGS )

      call SetMarsDustDODMGS( Ls, xy_DOD067, xy_MaxHeightDust )

    case ( IDDustScenarioMGSDODFromFile )

      call SetMarsDustDODMGS( Ls, xy_DOD067, xy_MaxHeightDust )

      call SetValuesFromTimeSeriesWrapper( 'DOD', DODFileName, DODVarName, xy_DOD067 )

    case default
      call MessageNotify( 'E', module_name, 'DustScenario of %c is not supported.', c1 = trim( DustScenario ) )
    end select


    MixRtDust0      =   1.0_DP

    do k = 1, kmax
      xyz_MixRtDust(:,:,k) = MixRtDust0 * exp( DustVerDistCoef * ( 1.0_DP - ( DustVerDistRefPress / xyz_Press(:,:,k) )**(70.0d3/xy_MaxHeightDust) ) )
    end do
    xyz_MixRtDust = min( xyz_MixRtDust, MixRtDust0 )


    k = kmax
    xyr_DOD067(:,:,k) = 0.0_DP
    do k = kmax-1, 0, -1
      xyr_DOD067(:,:,k) = xyr_DOD067(:,:,k+1) + xyz_MixRtDust(:,:,k+1) * ( xyr_Press(:,:,k) - xyr_Press(:,:,k+1) ) / Grav
    end do

    xy_DODFac = xy_DOD067 * xyr_Press(:,:,0) / DustOptDepRefPress / xyr_DOD067(:,:,0)
    do k = 0, kmax
      xyr_DOD067(:,:,k) = xyr_DOD067(:,:,k) * xy_DODFac
    end do


    ! ヒストリデータ出力
    ! History data output
    !
    call HistoryAutoPut( TimeN, 'DustPresc'    , xyz_MixRtDust    )
    call HistoryAutoPut( TimeN, 'DustMaxHeight', xy_MaxHeightDust )


  end subroutine SetMarsDustSetDOD067
set_Mars_dust_inited
Variable :
set_Mars_dust_inited = .false. :logical, save, public
: 初期設定フラグ. Initialization flag

Private Instance methods

DOD067
Variable :
DOD067 :real(DP) , save
: Dust optical depth at 0.67 micron.
DODFileName
Variable :
DODFileName :character(STRING), save
DODVarName
Variable :
DODVarName :character(STRING), save
DustExtEff
Variable :
DustExtEff :real(DP), save
DustOptDepRefPress
Variable :
DustOptDepRefPress :real(DP) , save
DustScenario
Variable :
DustScenario :character(STRING), save
DustVerDistCoef
Variable :
DustVerDistCoef :real(DP) , save
DustVerDistRefPress
Variable :
DustVerDistRefPress :real(DP) , save
IDDustScenario
Variable :
IDDustScenario :integer , save
IDDustScenarioConst
Constant :
IDDustScenarioConst = 1 :integer , parameter
IDDustScenarioMGS
Constant :
IDDustScenarioMGS = 4 :integer , parameter
IDDustScenarioMGSDODFromFile
Constant :
IDDustScenarioMGSDODFromFile = 5 :integer , parameter
IDDustScenarioViking
Constant :
IDDustScenarioViking = 3 :integer , parameter
IDDustScenarioVikingNoDS
Constant :
IDDustScenarioVikingNoDS = 2 :integer , parameter
REff
Variable :
REff :real(DP), save
RhoDust
Variable :
RhoDust :real(DP), save
Subroutine :
Ls :real(DP), intent(in )
xy_DOD(0:imax-1, 1:jmax) :real(DP), intent(out)
xy_MaxHeight(0:imax-1, 1:jmax) :real(DP), intent(out)

[Source]

  subroutine SetMarsDustDODMGS( Ls, xy_DOD, xy_MaxHeight )

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

    ! 座標データ設定
    ! Axes data settings
    !
    use axesset, only: y_Lat    ! $ \varphi $ [rad.] . 緯度. Latitude

    real(DP), intent(in ) :: Ls
    real(DP), intent(out) :: xy_DOD      (0:imax-1, 1:jmax)
    real(DP), intent(out) :: xy_MaxHeight(0:imax-1, 1:jmax)


    ! Local variables

    real(DP) :: DODEq
    real(DP) :: DODSouth
    real(DP) :: DODNorth
    real(DP) :: LsFactor

    integer  :: j


    DODEq    = 0.2_DP + ( 0.5_DP - 0.2_DP ) * cos( ( Ls - 250.0_DP ) / 2.0_DP * PI / 180.0_DP )**14
    DODSouth = 0.1_DP + ( 0.5_DP - 0.1_DP ) * cos( ( Ls - 250.0_DP ) / 2.0_DP * PI / 180.0_DP )**14
    DODNorth = 0.1_DP


    LsFactor = sin( ( Ls - 160.0_DP ) * PI / 180.0_DP )

    do j = 1, jmax

      if( y_Lat(j) > 0.0_DP ) then
        ! wrong
!!$        xy_DOD(:,j) = DODNorth              &
!!$          & + 0.5_DP * ( DODEq - DODNorth ) &
!!$          &   * ( 1.0_DP + tanh( ( 45.0_DP * PI / 180.0_DP - y_Lat(j) ) / 10.0_DP ) )
        xy_DOD(:,j) = DODNorth + 0.5_DP * ( DODEq - DODNorth ) * ( 1.0_DP + tanh( ( 45.0_DP * PI / 180.0_DP - y_Lat(j) ) * 10.0_DP ) )
      else
        ! wrong
!!$        xy_DOD(:,j) = DODSouth              &
!!$          & + 0.5_DP * ( DODEq - DODSouth ) &
!!$          &   * ( 1.0_DP + tanh( ( 45.0_DP * PI / 180.0_DP + y_Lat(j) ) / 10.0_DP ) )
        xy_DOD(:,j) = DODSouth + 0.5_DP * ( DODEq - DODSouth ) * ( 1.0_DP + tanh( ( 45.0_DP * PI / 180.0_DP + y_Lat(j) ) * 10.0_DP ) )
      end if

      xy_MaxHeight(:,j) = 60.0_DP + 18.0_DP * LsFactor - ( 32.0_DP + 18.0_DP * LsFactor ) * sin( y_Lat(j) )**4 - 8.0_DP * LsFactor * sin( y_Lat(j) )**5
      xy_MaxHeight(:,j) = xy_MaxHeight(:,j) * 1.0d3

    end do


  end subroutine SetMarsDustDODMGS
Subroutine :
Ls :real(DP), intent(in )
DOD :real(DP), intent(out)

[Source]

  subroutine SetMarsDustDODViking( Ls, DOD )

    real(DP), intent(in ) :: Ls
    real(DP), intent(out) :: DOD


    !
    ! Local variables
    !
    real(DP) :: DODDS1
    real(DP) :: DODDS2
    real(DP) :: DSLs
    real(DP) :: MaxDOD
    real(DP) :: DSDTC


    call SetMarsDustDODVikingNoDS( Ls, DOD )

    ! Add two dust storms
    !
    DSLs   = 210.0_DP
    MaxDOD = 2.7_DP
    DSDTC  = 50.0_DP
    call SetMarsDustDSExp( Ls, DSLs, MaxDOD, DSDTC, DODDS1 )

    DSLs   = 280.0_DP
    MaxDOD = 4.0_DP
    DSDTC  = 50.0_DP
    call SetMarsDustDSExp( Ls, DSLs, MaxDOD, DSDTC, DODDS2 )

    DOD = max( DOD, DODDS1, DODDS2 )


  end subroutine SetMarsDustDODViking
Subroutine :
Ls :real(DP), intent(in )
DOD :real(DP), intent(out)

[Source]

  subroutine SetMarsDustDODVikingNoDS( Ls, DOD )

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

    real(DP), intent(in ) :: Ls
    real(DP), intent(out) :: DOD


    ! This expression is obtained from Lewis et al. [1999].
    !
    DOD = 0.7_DP + 0.3_DP * cos( ( Ls + 80.0_DP ) * PI / 180.0_DP )


  end subroutine SetMarsDustDODVikingNoDS
Subroutine :
Ls :real(DP), intent(in )
DSLs :real(DP), intent(in )
MaxDOD :real(DP), intent(in )
DSDTC :real(DP), intent(in )
DOD :real(DP), intent(out)

[Source]

  subroutine SetMarsDustDSExp( Ls, DSLs, MaxDOD, DSDTC, DOD )

    real(DP), intent(in ) :: Ls
    real(DP), intent(in ) :: DSLs
    real(DP), intent(in ) :: MaxDOD
    real(DP), intent(in ) :: DSDTC
    real(DP), intent(out) :: DOD


    ! Local variables
    !
    real(DP) :: TMPLs

    if( Ls < DSLs ) then
      TMPLs = Ls + 360.0_DP
    else
      TMPLs = Ls
    endif

    DOD = MaxDod * exp( -( TMPLs - DSLs ) / DSDTC )


  end subroutine SetMarsDustDSExp
Subroutine :
Ls :real(DP), intent(in )
DSLs :real(DP), intent(in )
MaxDOD :real(DP), intent(in )
DSDTC :real(DP), intent(in )
xy_DOD(0:imax-1, 1:jmax) :real(DP), intent(out)

[Source]

  subroutine SetMarsDustRegDSExp( Ls, DSLs, MaxDOD, DSDTC, xy_DOD )

    ! 物理・数学定数設定
    ! Physical and mathematical constants settings
    !
    use constants0, only: PI                    ! $ \pi $.
                              ! 円周率. Circular constant

    ! 座標データ設定
    ! Axes data settings
    !
    use axesset, only: x_Lon, y_Lat    ! $ \varphi $ [rad.] . 緯度. Latitude

    real(DP), intent(in ) :: Ls
    real(DP), intent(in ) :: DSLs
    real(DP), intent(in ) :: MaxDOD
    real(DP), intent(in ) :: DSDTC
    real(DP), intent(out) :: xy_DOD(0:imax-1, 1:jmax)


    ! Local variables
    !
    real(DP) :: TMPLs
    integer  :: i
    integer  :: j


    if( Ls < DSLs ) then
      TMPLs = Ls + 360.0_DP
    else
      TMPLs = Ls
    end if

    do j = 1, jmax
      if ( ( -75.0_DP * PI / 180.0_DP <= y_Lat(j) ) .and. ( y_Lat(j) <= -15.0_DP * PI / 180.0_DP ) ) then
        do i = 0, imax-1
          if ( ( 300.0_DP * PI / 180.0_DP <= x_Lon(i) ) .or. ( x_Lon(i) <= 60.0_DP * PI / 180.0_DP  ) ) then
            xy_DOD(i,j) = 1.0_DP
          else
            xy_DOD(i,j) = 0.0_DP
          end if
        end do
      else
        xy_DOD(:,j) = 0.0_DP
      end if
    end do

    xy_DOD = xy_DOD * MaxDOD * exp( -( TMPLs - DSLs ) / DSDTC )


  end subroutine SetMarsDustRegDSExp
module_name
Constant :
module_name = ‘set_Mars_dust :character(*), parameter
: モジュールの名称. Module name
version
Constant :
version = ’$Name: dcpam5-20130930 $’ // ’$Id: set_Mars_dust.f90,v 1.13 2013-09-21 14:40:52 yot Exp $’ :character(*), parameter
: モジュールのバージョン Module version