| Class | set_Mars_dust | 
| In: | 
                
                radiation/set_Mars_dust.f90
                
         | 
Note that Japanese and English are described in parallel.
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.
| !$ ! 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#radiation_DennouAGCM_nml
| Subroutine : | |||
| xyr_Press(0:imax-1, 1:jmax, 0:kmax) : | real(DP), intent(in )
  | ||
| xyz_QDust(0:imax-1, 1:jmax, 1:kmax) : | real(DP), intent(in )
  | ||
| xyr_DOD067(0:imax-1, 1:jmax, 0:kmax) : | real(DP), intent(out)
  | 
Calculate dust optical depth at 0.67 micron
  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 .
  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 )
  | ||
| xyr_Press(0:imax-1, 1:jmax, 0:kmax) : | real(DP), intent(in )
  | ||
| xyz_Press(0:imax-1, 1:jmax, 1:kmax) : | real(DP), intent(in )
  | ||
| xyr_DOD067(0:imax-1, 1:jmax, 0:kmax) : | real(DP), intent(out)
  | 
Set dust optical depth at 0.67 micron
  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
          | Variable : | |||
| set_Mars_dust_inited = .false. : | logical, save, public
  | 
| 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) | 
  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) | 
  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) | 
  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) | 
  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) | 
  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
          | Constant : | |||
| module_name = ‘set_Mars_dust‘ : | character(*), parameter
  | 
| Constant : | |||
| version = ’$Name: dcpam5-20140204-3 $’ // ’$Id: set_Mars_dust.f90,v 1.13 2013-09-21 14:40:52 yot Exp $’ : | character(*), parameter
  |