!= 地球大気向け短波放射モデル Ver. 2.4 ! != short wave radiation model for the Earth's atmosphere Ver. 2.4 ! ! Authors:: Yoshiyuki O. Takahashi ! Version:: $Id: rad_Earth_SW_V2_4.f90,v 1.1 2014/02/04 10:27:17 yot Exp $ ! Tag Name:: $Name: $ ! Copyright:: Copyright (C) GFD Dennou Club, 2008. All rights reserved. ! License:: See COPYRIGHT[link:../../../COPYRIGHT] ! module rad_Earth_SW_V2_4 ! != 地球大気向け短波放射モデル Ver. 2.4 ! != short wave radiation model for the Earth's atmosphere Ver. 2.4 ! ! Note that Japanese and English are described in parallel. ! ! 地球大気向け短波放射モデル. ! ! This is a short wave radiation model for the Earth's atmospehre. ! ! The wavenumber range of shortwave radiation treated by this routine is ! from 1000 to 57143 cm-1 (0.175 to 10 micron). ! ! From 1000 to 57143 cm-1, the following effects are considered. ! * 1000 to 14286 cm-1 (0.70-10 micron): ! * absorption by H2O, ! * absorption by H2O is considered by using k-distribution method ! following Chou and Lee (1996), ! * absorption and scattering by cloud droplets. ! * optical properties of cloud is obtained from Chou et al. (1998) ! * 14286 to 57143 cm-1 (0.175 to 0.70 micron): ! * Rayleigh scattering, ! * scattering coefficient is obtained from Chou and Lee (1996), ! * scattering by cloud droplets. ! * optical properties of cloud is obtained from Chou et al. (1998) ! ! !== References ! ! Chou, M.-D., and K.-T. Lee, ! Parameterizations for the absorption of solar radiation by water vapor and ozone, ! J. Atmos. Sci., 53, 1203-1208, 1996. ! ! Chou, M.-D., M. J. Suarez, C.-H. Ho, M. M.-H. Yan, and K.-T. Lee, ! Parameterizations for cloud overlapping and shortwave single-scattering ! properties for use in general circulation and cloud ensemble models, ! J. Climate, 11, 202-214, 1998. ! !== Procedures List ! ! RadEarthSWV24Flux :: 放射フラックスの計算 ! ------------ :: ------------ ! RadEarthSWV24Flux :: Calculate radiation flux ! !== NAMELIST ! ! NAMELIST#rad_Earth_SW_V2_4_nml ! ! USE statements ! ! ! Kind type parameter ! use dc_types, only: DP, & ! Double precision. & STRING, & ! Strings. & TOKEN ! Keywords. ! メッセージ出力 ! Message output ! use dc_message, only: MessageNotify ! 格子点設定 ! 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 ! 時刻管理 ! Time control ! use timeset, only: & & TimesetClockStart, TimesetClockStop implicit none private logical , save :: FlagRayleighScattering real(DP), save :: CloudWatREff real(DP), save :: CloudIceREff real(DP), save :: PressCloudGroupBoundary ! 公開変数 ! Public variables ! logical, save :: rad_Earth_SW_V2_4_inited = .false. ! 初期設定フラグ. ! Initialization flag public :: RadEarthSWV24Flux public :: RadEarthSWV24Init character(*), parameter:: module_name = 'rad_Earth_SW_V2_4' ! モジュールの名称. ! Module name character(*), parameter:: version = & & '$Name: $' // & & '$Id: rad_Earth_SW_V2_4.f90,v 1.1 2014/02/04 10:27:17 yot Exp $' ! モジュールのバージョン ! Module version !-------------------------------------------------------------------------------------- contains !-------------------------------------------------------------------------------------- subroutine RadEarthSWV24Flux( & & xy_SurfAlbedo, & & xyz_DelAtmMass, & & xyz_DelH2OVapMass, xyz_DelH2OLiqMass, xyz_DelH2OSolMass, & & xyz_DelO3Mass, & & xyz_Press, xyz_Temp, & & xyz_CloudCover, & & xyr_RadSUwFlux, xyr_RadSDwFlux & & ) ! USE statements ! ! 太陽放射フラックスの設定 ! Set solar constant ! use set_solarconst, only : SetSolarConst ! 短波入射 (太陽入射) ! Short wave (insolation) incoming ! use rad_short_income, only : RadShortIncome ! ! Solve radiative transfer equation in two stream approximation ! use rad_rte_two_stream_app, only: RadRTETwoStreamAppSW ! Chou and Lee (1996) による短波放射モデル ! Short wave radiation model described by Chou and Lee (1996) ! use rad_CL1996, only : & & RadCL1996NumBands , & & RadCL1996UVVISParams , & & RadCL1996IRH2ONumKDFBin, & & RadCL1996IRH2OKDFParams, & & RadCL1996ScaleH2OVapMass ! Chou et al (1998) による短波放射用雲モデル ! Cloud model for short wave radiation model described by Chou et al (1998) ! use rad_C1998, only : RadC1998CalcCloudOptProp ! 雲関系ルーチン ! Cloud-related routines ! use cloud_utils, only : CloudUtilsLocalizeCloud real(DP), intent(in ) :: xy_SurfAlbedo (0:imax-1, 1:jmax ) real(DP), intent(in ) :: xyz_DelAtmMass (0:imax-1, 1:jmax, 1:kmax) real(DP), intent(in ) :: xyz_DelH2OVapMass(0:imax-1, 1:jmax, 1:kmax) real(DP), intent(in ) :: xyz_DelH2OLiqMass(0:imax-1, 1:jmax, 1:kmax) real(DP), intent(in ) :: xyz_DelH2OSolMass(0:imax-1, 1:jmax, 1:kmax) real(DP), intent(in ) :: xyz_DelO3Mass (0:imax-1, 1:jmax, 1:kmax) real(DP), intent(in ) :: xyz_Press (0:imax-1, 1:jmax, 1:kmax) real(DP), intent(in ) :: xyz_Temp (0:imax-1, 1:jmax, 1:kmax) real(DP), intent(in ) :: xyz_CloudCover (0:imax-1, 1:jmax, 1:kmax) real(DP), intent(out) :: xyr_RadSUwFlux (0:imax-1, 1:jmax, 0:kmax) real(DP), intent(out) :: xyr_RadSDwFlux (0:imax-1, 1:jmax, 0:kmax) real(DP) :: SolarConst real(DP) :: xy_InAngle (0:imax-1, 1:jmax) ! sec (入射角). ! sec (angle of incidence) real(DP) :: DistFromStarScld ! Distance between the central star and the planet real(DP) :: DiurnalMeanFactor integer :: nbands1 integer :: nbands2 real(DP) :: UVVISFracSolarFlux real(DP) :: UVVISO3AbsCoef real(DP) :: UVVISRayScatCoef real(DP) :: SolarFluxTOA real(DP) :: xyz_SSA (0:imax-1, 1:jmax, 1:kmax) real(DP) :: xyz_AF (0:imax-1, 1:jmax, 1:kmax) real(DP), parameter :: RayScatSinScatAlb = 1.0d0 - 1.0d-10 real(DP), parameter :: RayScatAsymFact = 0.0d0 real(DP) :: xyz_DelH2OVapMassScaled( 0:imax-1, 1:jmax, 1:kmax ) real(DP) :: xyz_DelCloudWatOptDep( 0:imax-1, 1:jmax, 1:kmax ) real(DP) :: xyz_DelCloudIceOptDep( 0:imax-1, 1:jmax, 1:kmax ) real(DP) :: xyz_RayScatDelOptDep( 0:imax-1, 1:jmax, 1:kmax ) real(DP) :: xyz_O3AbsDelOptDep ( 0:imax-1, 1:jmax, 1:kmax ) real(DP) :: xyz_DelTotOptDep( 0:imax-1, 1:jmax, 1:kmax ) real(DP) :: xyr_TotOptDep ( 0:imax-1, 1:jmax, 0:kmax ) real(DP) :: xyr_RadFlux ( 0:imax-1, 1:jmax, 0:kmax ) real(DP) :: xyr_RadUwFlux ( 0:imax-1, 1:jmax, 0:kmax ) real(DP) :: xyr_RadDwFlux ( 0:imax-1, 1:jmax, 0:kmax ) integer :: nkdf integer :: ikdfbin real(DP) :: KDFAbsCoef real(DP) :: KDFWeight real(DP) :: xyz_H2ODelOptDep( 0:imax-1, 1:jmax, 1:kmax ) real(DP) :: xyz_CloudREff (0:imax-1, 1:jmax, 1:kmax) real(DP) :: xyz_CloudExtCoef(0:imax-1, 1:jmax, 1:kmax) real(DP) :: xyz_CloudCoAlb (0:imax-1, 1:jmax, 1:kmax) real(DP) :: xyz_CloudWatSSA (0:imax-1, 1:jmax, 1:kmax) real(DP) :: xyz_CloudWatAF (0:imax-1, 1:jmax, 1:kmax) real(DP) :: xyz_CloudIceSSA (0:imax-1, 1:jmax, 1:kmax) real(DP) :: xyz_CloudIceAF (0:imax-1, 1:jmax, 1:kmax) ! NCloudGroups has to be 2, now. integer, parameter :: NCloudGroup = 2 real(DP) :: a_PressCloudGroupBoundary (0:NCloudGroup) integer :: xyz_IndexCloudGroup (0:imax-1, 1:jmax, 1:kmax) real(DP) :: xya_CloudCoverMaxEachGroup(0:imax-1, 1:jmax, 1:NCloudGroup) real(DP) :: xyz_CloudCoverMax (0:imax-1, 1:jmax, 1:kmax) real(DP) :: xy_Probability (0:imax-1, 1:jmax) real(DP) :: xyz_DelH2OLiqMassLocal(0:imax-1, 1:jmax, 1:kmax) real(DP) :: xyz_DelH2OSolMassLocal(0:imax-1, 1:jmax, 1:kmax) integer :: i integer :: j integer :: k integer :: l integer :: m integer :: n ! 初期化確認 ! Initialization check ! if ( .not. rad_Earth_SW_V2_4_inited ) then call MessageNotify( 'E', module_name, 'This module has not been initialized.' ) end if ! 計算時間計測開始 ! Start measurement of computation time ! call TimesetClockStart( module_name ) ! 太陽放射フラックスの設定 ! Set solar constant ! call SetSolarConst( & & SolarConst & ! (out) & ) ! 短波入射の計算 ! Calculate short wave (insolation) incoming radiation ! call RadShortIncome( & & xy_InAngle = xy_InAngle, & ! (out) optional & DistFromStarScld = DistFromStarScld, & ! (out) optional & DiurnalMeanFactor = DiurnalMeanFactor & & ) call RadCL1996NumBands( & & nbands1, nbands2 & ! (out) & ) ! Find maximum cloud cover in a column ! a_PressCloudGroupBoundary(0 ) = 1.0d100 do m = 1, NCloudGroup-1 a_PressCloudGroupBoundary(m) = PressCloudGroupBoundary end do a_PressCloudGroupBoundary(NCloudGroup) = 0.0_DP ! do k = 1, kmax do j = 1, jmax do i = 0, imax-1 search_cloud_group : do m = 1, NCloudGroup if ( ( a_PressCloudGroupBoundary(m) <= xyz_Press(i,j,k) ) .and. & & ( xyz_Press(i,j,k) < a_PressCloudGroupBoundary(m-1) ) ) then exit search_cloud_group end if end do search_cloud_group xyz_IndexCloudGroup(i,j,k) = m end do end do end do xya_CloudCoverMaxEachGroup = 0.0_DP do k = 1, kmax do j = 1, jmax do i = 0, imax-1 m = xyz_IndexCloudGroup(i,j,k) if ( xyz_CloudCover(i,j,k) > xya_CloudCoverMaxEachGroup(i,j,m) ) then xya_CloudCoverMaxEachGroup(i,j,m) = xyz_CloudCover(i,j,k) end if end do end do end do ! !!$ do k = 1, kmax !!$ xyz_CloudCoverMax(:,:,k) = xy_CloudCoverMax !!$ end do do k = 1, kmax do j = 1, jmax do i = 0, imax-1 m = xyz_IndexCloudGroup(i,j,k) xyz_CloudCoverMax(i,j,k) = xya_CloudCoverMaxEachGroup(i,j,m) end do end do end do xyz_DelH2OLiqMassLocal = xyz_DelH2OLiqMass call CloudUtilsLocalizeCloud( & & xyz_CloudCoverMax, & ! (in ) & xyz_DelH2OLiqMassLocal & ! (inout) & ) xyz_DelH2OSolMassLocal = xyz_DelH2OSolMass call CloudUtilsLocalizeCloud( & & xyz_CloudCoverMax, & ! (in ) & xyz_DelH2OSolMassLocal & ! (inout) & ) ! Initialization ! xyr_RadSUwFlux = 0.0_DP xyr_RadSDwFlux = 0.0_DP ! Loop for cloud effect ! n = 1 : clear sky ! n = 2 : cloudy sky cloud_loop : do n = 1, NCloudGroup+2 ! * 14286 to 57143 cm-1 (0.175 to 0.70 micron): ! * Rayleigh scattering, ! * scattering by cloud droplets. ! * O3 absorption ! do l = 1, nbands1 ! Water cloud optical properties ! xyz_CloudREff = CloudWatREff call RadC1998CalcCloudOptProp( & & 'Liquid', l, xyz_CloudREff, & ! (in ) & xyz_CloudExtCoef, xyz_CloudCoAlb, xyz_CloudWatAF & ! (out) & ) xyz_DelCloudWatOptDep = xyz_CloudExtCoef * xyz_DelH2OLiqMass xyz_CloudWatSSA = 1.0_DP - xyz_CloudCoAlb ! ! Ice cloud optical properties ! xyz_CloudREff = CloudIceREff call RadC1998CalcCloudOptProp( & & 'Ice', l, xyz_CloudREff, & ! (in ) & xyz_CloudExtCoef, xyz_CloudCoAlb, xyz_CloudIceAF & ! (out) & ) xyz_DelCloudIceOptDep = xyz_CloudExtCoef * xyz_DelH2OSolMass xyz_CloudIceSSA = 1.0_DP - xyz_CloudCoAlb select case ( n ) case ( 1:NCloudGroup ) ! 1 layer cloudy sky do k = 1, kmax do j = 1, jmax do i = 0, imax-1 m = xyz_IndexCloudGroup(i,j,k) if ( m /= n ) then xyz_DelCloudWatOptDep(i,j,k) = 0.0_DP xyz_CloudWatSSA (i,j,k) = 0.0_DP xyz_CloudWatAF (i,j,k) = 0.0_DP ! xyz_DelCloudIceOptDep(i,j,k) = 0.0_DP xyz_CloudIceSSA (i,j,k) = 0.0_DP xyz_CloudIceAF (i,j,k) = 0.0_DP end if end do end do end do case ( NCloudGroup+1 ) ! cloudy sky ! Do nothing case ( NCloudGroup+2 ) ! clear sky xyz_DelCloudWatOptDep = 0.0_DP xyz_CloudWatSSA = 0.0_DP xyz_CloudWatAF = 0.0_DP ! xyz_DelCloudIceOptDep = 0.0_DP xyz_CloudIceSSA = 0.0_DP xyz_CloudIceAF = 0.0_DP case default call MessageNotify( 'E', module_name, & & 'Unexected number of n' ) end select ! UV and Visible optical properties and solar flux ! call RadCL1996UVVISParams( & & l, & ! (in ) & UVVISFracSolarFlux, UVVISO3AbsCoef, UVVISRayScatCoef & ! (out) & ) SolarFluxTOA = UVVISFracSolarFlux * SolarConst / DistFromStarScld**2 * DiurnalMeanFactor ! Rayleigh scattering ! if ( FlagRayleighScattering ) then xyz_RayScatDelOptDep = UVVISRayScatCoef * xyz_DelAtmMass else xyz_RayScatDelOptDep = 0.0d0 end if ! O3 absorption ! xyz_O3AbsDelOptDep = UVVISO3AbsCoef * xyz_DelO3Mass ! Total optical parameter ! xyz_DelTotOptDep = & & xyz_DelCloudWatOptDep & & + xyz_DelCloudIceOptDep & & + xyz_RayScatDelOptDep & & + xyz_O3AbsDelOptDep ! xyr_TotOptDep(:,:,kmax) = 0.0d0 do k = kmax-1, 0, -1 xyr_TotOptDep(:,:,k) = xyr_TotOptDep(:,:,k+1) + xyz_DelTotOptDep(:,:,k+1) end do ! xyz_SSA = & & ( xyz_CloudWatSSA * xyz_DelCloudWatOptDep & & + xyz_CloudIceSSA * xyz_DelCloudIceOptDep & & + RayScatSinScatAlb * xyz_RayScatDelOptDep & & + 0.0d0 * xyz_O3AbsDelOptDep ) & & / ( xyz_DelTotOptDep + 1.0d-100 ) do k = 1, kmax do j = 1, jmax do i = 0, imax-1 if ( xyz_SSA(i,j,k) >= 1.0d0 ) then xyz_SSA(i,j,k) = 1.0d0 - 1.0d-10 end if end do end do end do xyz_AF = & & ( xyz_CloudWatAF * xyz_CloudWatSSA * xyz_DelCloudWatOptDep & & + xyz_CloudIceAF * xyz_CloudIceSSA * xyz_DelCloudIceOptDep & & + RayScatAsymFact * RayScatSinScatAlb * xyz_RayScatDelOptDep & & + 0.0d0 * 0.0d0 * xyz_O3AbsDelOptDep )& & / ( xyz_SSA * xyz_DelTotOptDep + 1.0d-100 ) call RadRTETwoStreamAppSW( & & xyz_SSA, xyz_AF, & ! (in) & xyr_TotOptDep, & ! (in) & xy_SurfAlbedo, & ! (in) & SolarFluxTOA, xy_InAngle, & ! (in) & xyr_RadUwFlux, xyr_RadDwFlux & ! (out) & ) !!$ select case ( n ) !!$ case ( 1 ) ! clear sky !!$ do k = 0, kmax !!$ xyr_RadSUwFlux(:,:,k) = xyr_RadSUwFlux(:,:,k) & !!$ & + xyr_RadUwFlux(:,:,k) * ( 1.0_DP - xy_CloudCoverMax ) !!$ xyr_RadSDwFlux(:,:,k) = xyr_RadSDwFlux(:,:,k) & !!$ & + xyr_RadDwFlux(:,:,k) * ( 1.0_DP - xy_CloudCoverMax ) !!$ end do !!$ case ( 2 ) ! cloudy sky !!$ do k = 0, kmax !!$ xyr_RadSUwFlux(:,:,k) = xyr_RadSUwFlux(:,:,k) & !!$ & + xyr_RadUwFlux(:,:,k) * xy_CloudCoverMax !!$ xyr_RadSDwFlux(:,:,k) = xyr_RadSDwFlux(:,:,k) & !!$ & + xyr_RadDwFlux(:,:,k) * xy_CloudCoverMax !!$ end do !!$ case default !!$ call MessageNotify( 'E', module_name, & !!$ & 'Unexected number of n' ) !!$ end select select case ( n ) case ( 1:NCloudGroup ) ! 1 layer cloudy sky xy_Probability = 1.0_DP do m = 1, n-1 xy_Probability = xy_Probability & & * ( 1.0_DP - xya_CloudCoverMaxEachGroup(:,:,m) ) end do m = n xy_Probability = xy_Probability & & * xya_CloudCoverMaxEachGroup(:,:,m) do m = n+1, NCloudGroup xy_Probability = xy_Probability & & * ( 1.0_DP - xya_CloudCoverMaxEachGroup(:,:,m) ) end do case ( NCloudGroup+1 ) ! cloudy sky xy_Probability = 1.0_DP do m = 1, NCloudGroup xy_Probability = xy_Probability & & * xya_CloudCoverMaxEachGroup(:,:,m) end do case ( NCloudGroup+2 ) ! clear sky xy_Probability = 1.0_DP do m = 1, NCloudGroup xy_Probability = xy_Probability & & * ( 1.0_DP - xya_CloudCoverMaxEachGroup(:,:,m) ) end do case default call MessageNotify( 'E', module_name, & & 'Unexected number of n' ) end select do k = 0, kmax xyr_RadSUwFlux(:,:,k) = xyr_RadSUwFlux(:,:,k) & & + xyr_RadUwFlux(:,:,k) * xy_Probability xyr_RadSDwFlux(:,:,k) = xyr_RadSDwFlux(:,:,k) & & + xyr_RadDwFlux(:,:,k) * xy_Probability end do end do ! * 1000 to 14286 cm-1 (0.70-10 micron): ! * absorption by H2O, ! * scattering by cloud droplets. ! call RadCL1996ScaleH2OVapMass( & & xyz_Temp, xyz_DelH2OVapMass, xyz_Press, & ! (in ) & xyz_DelH2OVapMassScaled & ! (out) & ) call RadCL1996IRH2ONumKDFBin( & & nkdf & ! (out) & ) SolarFluxTOA = SolarConst / DistFromStarScld**2 * DiurnalMeanFactor do l = nbands1+1, nbands1+nbands2 !!$ select case ( n ) !!$ case ( 1 ) ! clear sky !!$ xyz_DelCloudWatOptDep = 0.0_DP !!$ xyz_CloudWatSSA = 0.0_DP !!$ xyz_CloudWatAF = 0.0_DP !!$ ! !!$ xyz_DelCloudIceOptDep = 0.0_DP !!$ xyz_CloudIceSSA = 0.0_DP !!$ xyz_CloudIceAF = 0.0_DP !!$ case ( 2 ) ! cloudy sky !!$ ! Water cloud optical properties !!$ ! !!$ xyz_CloudREff = CloudWatREff !!$ call RadC1998CalcCloudOptProp( & !!$ & 'Liquid', l, xyz_CloudREff, & ! (in ) !!$ & xyz_CloudExtCoef, xyz_CloudCoAlb, xyz_CloudWatAF & ! (out) !!$ & ) !!$ xyz_DelCloudWatOptDep = xyz_CloudExtCoef * xyz_DelH2OLiqMass !!$ xyz_CloudWatSSA = 1.0_DP - xyz_CloudCoAlb !!$ ! !!$ ! Ice cloud optical properties !!$ ! !!$ xyz_CloudREff = CloudIceREff !!$ call RadC1998CalcCloudOptProp( & !!$ & 'Ice', l, xyz_CloudREff, & ! (in ) !!$ & xyz_CloudExtCoef, xyz_CloudCoAlb, xyz_CloudIceAF & ! (out) !!$ & ) !!$ xyz_DelCloudIceOptDep = xyz_CloudExtCoef * xyz_DelH2OSolMass !!$ xyz_CloudIceSSA = 1.0_DP - xyz_CloudCoAlb !!$ case default !!$ call MessageNotify( 'E', module_name, & !!$ & 'Unexected number of n' ) !!$ end select ! Water cloud optical properties ! xyz_CloudREff = CloudWatREff call RadC1998CalcCloudOptProp( & & 'Liquid', l, xyz_CloudREff, & ! (in ) & xyz_CloudExtCoef, xyz_CloudCoAlb, xyz_CloudWatAF & ! (out) & ) xyz_DelCloudWatOptDep = xyz_CloudExtCoef * xyz_DelH2OLiqMass xyz_CloudWatSSA = 1.0_DP - xyz_CloudCoAlb ! ! Ice cloud optical properties ! xyz_CloudREff = CloudIceREff call RadC1998CalcCloudOptProp( & & 'Ice', l, xyz_CloudREff, & ! (in ) & xyz_CloudExtCoef, xyz_CloudCoAlb, xyz_CloudIceAF & ! (out) & ) xyz_DelCloudIceOptDep = xyz_CloudExtCoef * xyz_DelH2OSolMass xyz_CloudIceSSA = 1.0_DP - xyz_CloudCoAlb select case ( n ) case ( 1:NCloudGroup ) ! 1 layer cloudy sky do k = 1, kmax do j = 1, jmax do i = 0, imax-1 m = xyz_IndexCloudGroup(i,j,k) if ( m /= n ) then xyz_DelCloudWatOptDep(i,j,k) = 0.0_DP xyz_CloudWatSSA (i,j,k) = 0.0_DP xyz_CloudWatAF (i,j,k) = 0.0_DP ! xyz_DelCloudIceOptDep(i,j,k) = 0.0_DP xyz_CloudIceSSA (i,j,k) = 0.0_DP xyz_CloudIceAF (i,j,k) = 0.0_DP end if end do end do end do case ( NCloudGroup+1 ) ! cloudy sky ! Do nothing case ( NCloudGroup+2 ) ! clear sky xyz_DelCloudWatOptDep = 0.0_DP xyz_CloudWatSSA = 0.0_DP xyz_CloudWatAF = 0.0_DP ! xyz_DelCloudIceOptDep = 0.0_DP xyz_CloudIceSSA = 0.0_DP xyz_CloudIceAF = 0.0_DP case default call MessageNotify( 'E', module_name, & & 'Unexected number of n' ) end select do ikdfbin = 1, nkdf call RadCL1996IRH2OKDFParams( & & l, ikdfbin, & ! (in ) & KDFAbsCoef, KDFWeight & ! (out) & ) xyz_H2ODelOptDep = KDFAbsCoef * xyz_DelH2OVapMassScaled ! Total optical parameter ! xyz_DelTotOptDep = & & xyz_DelCloudWatOptDep & & + xyz_DelCloudIceOptDep & & + xyz_H2ODelOptDep xyr_TotOptDep(:,:,kmax) = 0.0d0 do k = kmax-1, 0, -1 xyr_TotOptDep(:,:,k) = xyr_TotOptDep(:,:,k+1) + xyz_DelTotOptDep(:,:,k+1) end do xyz_SSA = & & ( xyz_CloudWatSSA * xyz_DelCloudWatOptDep & & + xyz_CloudIceSSA * xyz_DelCloudIceOptDep & & + 0.0d0 * xyz_H2ODelOptDep ) & & / ( xyz_DelTotOptDep + 1.0d-100 ) do k = 1, kmax do j = 1, jmax do i = 0, imax-1 if ( xyz_SSA(i,j,k) >= 1.0d0 ) then xyz_SSA(i,j,k) = 1.0d0 - 1.0d-10 end if end do end do end do xyz_AF = & & ( xyz_CloudWatAF * xyz_CloudWatSSA * xyz_DelCloudWatOptDep & & + xyz_CloudIceAF * xyz_CloudIceSSA * xyz_DelCloudIceOptDep & & + 0.0d0 * 0.0d0 * xyz_H2ODelOptDep ) & & / ( xyz_ssa * xyz_DelTotOptDep + 1.0d-100 ) call RadRTETwoStreamAppSW( & & xyz_SSA, xyz_AF, & ! (in) & xyr_TotOptDep, & ! (in) & xy_SurfAlbedo, & ! (in) & SolarFluxTOA, xy_InAngle, & ! (in) & xyr_RadUwFlux, xyr_RadDwFlux & ! (out) & ) xyr_RadUwFlux = xyr_RadUwFlux * KDFWeight xyr_RadDwFlux = xyr_RadDwFlux * KDFWeight !!$ xyr_RadSUwFlux = xyr_RadSUwFlux + xyr_RadUwFlux !!$ xyr_RadSDwFlux = xyr_RadSDwFlux + xyr_RadDwFlux !!$ select case ( n ) !!$ case ( 1 ) ! clear sky !!$ do k = 0, kmax !!$ xyr_RadSUwFlux(:,:,k) = xyr_RadSUwFlux(:,:,k) & !!$ & + xyr_RadUwFlux(:,:,k) * ( 1.0_DP - xy_CloudCoverMax ) !!$ xyr_RadSDwFlux(:,:,k) = xyr_RadSDwFlux(:,:,k) & !!$ & + xyr_RadDwFlux(:,:,k) * ( 1.0_DP - xy_CloudCoverMax ) !!$ end do !!$ case ( 2 ) ! cloudy sky !!$ do k = 0, kmax !!$ xyr_RadSUwFlux(:,:,k) = xyr_RadSUwFlux(:,:,k) & !!$ & + xyr_RadUwFlux(:,:,k) * xy_CloudCoverMax !!$ xyr_RadSDwFlux(:,:,k) = xyr_RadSDwFlux(:,:,k) & !!$ & + xyr_RadDwFlux(:,:,k) * xy_CloudCoverMax !!$ end do !!$ case default !!$ call MessageNotify( 'E', module_name, & !!$ & 'Unexected number of n' ) !!$ end select select case ( n ) case ( 1:NCloudGroup ) ! 1 layer cloudy sky xy_Probability = 1.0_DP do m = 1, n-1 xy_Probability = xy_Probability & & * ( 1.0_DP - xya_CloudCoverMaxEachGroup(:,:,m) ) end do m = n xy_Probability = xy_Probability & & * xya_CloudCoverMaxEachGroup(:,:,m) do m = n+1, NCloudGroup xy_Probability = xy_Probability & & * ( 1.0_DP - xya_CloudCoverMaxEachGroup(:,:,m) ) end do case ( NCloudGroup+1 ) ! cloudy sky xy_Probability = 1.0_DP do m = 1, NCloudGroup xy_Probability = xy_Probability & & * xya_CloudCoverMaxEachGroup(:,:,m) end do case ( NCloudGroup+2 ) ! clear sky xy_Probability = 1.0_DP do m = 1, NCloudGroup xy_Probability = xy_Probability & & * ( 1.0_DP - xya_CloudCoverMaxEachGroup(:,:,m) ) end do case default call MessageNotify( 'E', module_name, & & 'Unexected number of n' ) end select do k = 0, kmax xyr_RadSUwFlux(:,:,k) = xyr_RadSUwFlux(:,:,k) & & + xyr_RadUwFlux(:,:,k) * xy_Probability xyr_RadSDwFlux(:,:,k) = xyr_RadSDwFlux(:,:,k) & & + xyr_RadDwFlux(:,:,k) * xy_Probability end do end do end do end do cloud_loop !!$ i = 0 !!$ j = jmax / 2 + 1 !!$ do k = 1, kmax !!$ write( 73, * ) xyz_Temp(i,j,k), xyz_QH2OVap(i,j,k), & !!$ & xyz_Press(i,j,k) !!$ end do !!$ call flush( 73 ) !!$ !!$ i = 0 !!$ j = jmax / 2 + 1 !!$ do k = 1, kmax !!$ write( 83, * ) & !!$ & + ( xyr_RadSFlux(i,j,k-1) - xyr_RadSFlux(i,j,k) ) & !!$ & / ( xyr_Press(i,j,k-1) - xyr_Press(i,j,k) ) & !!$ & / 1004.6 * Grav, & !!$ & xyz_Press(i,j,k) !!$ end do !!$ call flush( 83 ) !!$ !!$! write( 6, * ) '########## ', acos( 1.0d0 / xy_InAngle(i,j) ) * 180.0d0 / 3.141592d0 !!$ !!$ !!$ i = 0 !!$ j = jmax / 2 + 1 !!$ write( 93, * ) '# ', xy_SurfAlbedo(i,j) !!$ write( 93, * ) '# ', 1.0_DP / xy_InAngle(i,j) !!$ do k = 0, kmax !!$ write( 93, * ) xyr_RadSFlux(i,j,k), xyr_Press(i,j,k) !!$ end do !!$ call flush( 93 ) !!$ stop ! 計算時間計測一時停止 ! Pause measurement of computation time ! call TimesetClockStop( module_name ) end subroutine RadEarthSWV24Flux !-------------------------------------------------------------------------------------- subroutine RadEarthSWV24Init( & & FlagSnow & & ) ! ファイル入出力補助 ! File I/O support ! use dc_iounit, only: FileOpen ! NAMELIST ファイル入力に関するユーティリティ ! Utilities for NAMELIST file input ! use namelist_util, only: namelist_filename, NmlutilMsg, NmlutilAryValid ! 太陽放射フラックスの設定 ! Set solar constant ! use set_solarconst, only : SetSolarConstInit ! 短波入射 (太陽入射) ! Short wave (insolation) incoming ! use rad_short_income, only : RadShortIncomeInit ! ! Solve radiative transfer equation in two stream approximation ! use rad_rte_two_stream_app, only: RadRTETwoStreamAppInit ! Chou and Lee (1996) による短波放射モデル ! Short wave radiation model described by Chou and Lee (1996) ! use rad_CL1996, only : RadCL1996Init ! Chou et al (1998) による短波放射用雲モデル ! Cloud model for short wave radiation model described by Chou et al (1998) ! use rad_C1998, only : RadC1998Init ! 雲関系ルーチン ! Cloud-related routines ! use cloud_utils, only : CloudUtilsInit ! 宣言文 ; Declaration statements ! logical, intent(in) :: FlagSnow integer:: unit_nml ! NAMELIST ファイルオープン用装置番号. ! Unit number for NAMELIST file open integer:: iostat_nml ! NAMELIST 読み込み時の IOSTAT. ! IOSTAT of NAMELIST read ! NAMELIST 変数群 ! NAMELIST group name ! namelist /rad_Earth_SW_V2_4_nml/ & & FlagRayleighScattering, & & CloudWatREff, CloudIceREff, & & PressCloudGroupBoundary ! ! デフォルト値については初期化手続 "rad_Earth_SW_V2_4#RadEarthSWV24Init" ! のソースコードを参照のこと. ! ! Refer to source codes in the initialization procedure ! "rad_Earth_SW_V2_4#RadEarthSWEV24Init" for the default values. ! if ( rad_Earth_SW_V2_4_inited ) return ! デフォルト値の設定 ! Default values settings ! FlagRayleighScattering = .true. CloudWatREff = 10.0d-6 CloudIceREff = 50.0d-6 PressCloudGroupBoundary = 700.0e2_DP ! NAMELIST の読み込み ! NAMELIST is input ! if ( trim(namelist_filename) /= '' ) then call FileOpen( unit_nml, & ! (out) & namelist_filename, mode = 'r' ) ! (in) rewind( unit_nml ) read( unit_nml, & ! (in) & nml = rad_Earth_SW_V2_4_nml, & ! (out) & iostat = iostat_nml ) ! (out) close( unit_nml ) call NmlutilMsg( iostat_nml, module_name ) ! (in) end if ! Initialization of modules used in this module ! ! 太陽放射フラックスの設定 ! Set solar constant ! call SetSolarConstInit ! 短波入射 (太陽入射) ! Short wave (insolation) incoming ! call RadShortIncomeInit ! ! Solve radiative transfer equation in two stream approximation ! call RadRTETwoStreamAppInit ! Chou and Lee (1996) による短波放射モデル ! Short wave radiation model described by Chou and Lee (1996) ! call RadCL1996Init ! Chou et al (1998) による短波放射用雲モデル ! Cloud model for short wave radiation model described by Chou et al (1998) ! call RadC1998Init ! 雲関系ルーチン ! Cloud-related routines ! call CloudUtilsInit( & & FlagSnow & & ) ! 印字 ; Print ! call MessageNotify( 'M', module_name, '----- Initialization Messages -----' ) call MessageNotify( 'M', module_name, 'FlagRayleighScattering = %b', l = (/ FlagRayleighScattering /) ) call MessageNotify( 'M', module_name, 'CloudWatREff = %f', & & d = (/ CloudWatREff /) ) call MessageNotify( 'M', module_name, 'CloudIceREff = %f', & & d = (/ CloudIceREff /) ) call MessageNotify( 'M', module_name, 'PressCloudGroupBoundary = %f', & & d = (/ PressCloudGroupBoundary /) ) call MessageNotify( 'M', module_name, '-- version = %c', c1 = trim(version) ) rad_Earth_SW_V2_4_inited = .true. end subroutine RadEarthSWV24Init !-------------------------------------------------------------------------------------- end module rad_Earth_SW_V2_4