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 timeset constants0 constants axesset read_time_series dc_iounit namelist_util

Public Instance methods

SetMarsDustInit( )

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/ 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
    !
    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, '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

SetMarsDustSetDOD067( Ls, xyr_Press, xyz_Press, xyr_DOD067 )

Subroutine :

Ls :

real(DP), intent(in )

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 ) call SetMarsDustInit


    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( DODFileName, DODVarName, xy_DOD067, 'DOD' )

    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`

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`

SetMarsDustDODMGS( Ls, xy_DOD, xy_MaxHeight )

*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

SetMarsDustDODViking( Ls, DOD )

*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

SetMarsDustDODVikingNoDS( Ls, DOD )

*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

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

*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

module_name

Constant :

module_name = ‘set_Mars_dust‘ :

character(*), parameter

:	モジュールの名称. Module name

version

Constant :

version = ’$Name: dcpam5-20120813-2 $’ // ’$Id: set_Mars_dust.f90,v 1.8 2012-07-27 01:04:37 yot Exp $’ :

character(*), parameter

:	モジュールのバージョン Module version