scale_atmos_phy_rd_mstrnx Module Reference

module ATMOSPHERE / Physics Radiation More...

Functions/Subroutines
subroutine, public	atmos_phy_rd_mstrnx_setup (RD_TYPE)
	Setup. More...
subroutine, public	atmos_phy_rd_mstrnx (DENS, RHOT, QTRC, CZ, FZ, fact_ocean, fact_land, fact_urban, temp_sfc, albedo_land, solins, cosSZA, flux_rad, flux_rad_top, flux_rad_sfc_dn)
	Radiation main. More...

Detailed Description

module ATMOSPHERE / Physics Radiation

Description

Atmospheric radiation transfer process mstrnX Ref: Nakajima and Tanaka(1986) Nakajima et al.(2000) Sekiguchi and Nakajima(2008)

Author

Team SCALE

History

• 2013-02-06 (H.Yashiro) [new]

NAMELIST

• PARAM_ATMOS_PHY_RD_MSTRN

  name	type	default value	comment
  ATMOS_PHY_RD_MSTRN_TOA	real(RP)
  ATMOS_PHY_RD_MSTRN_KADD	integer
  ATMOS_PHY_RD_MSTRN_GASPARA_IN_FILENAME	character(len=H_LONG)
  ATMOS_PHY_RD_MSTRN_AEROPARA_IN_FILENAME	character(len=H_LONG)
  ATMOS_PHY_RD_MSTRN_HYGROPARA_IN_FILENAME	character(len=H_LONG)
  ATMOS_PHY_RD_MSTRN_NBAND	integer
  ATMOS_PHY_RD_MSTRN_NPTYPE	integer
  ATMOS_PHY_RD_MSTRN_NRADIUS	integer
  ATMOS_PHY_RD_MSTRN_ONLY_QCI	logical	.false.
  ATMOS_PHY_RD_MSTRN_ONLY_TROPOCLOUD	logical	.false.

  
  

History Output

No history output

Function/Subroutine Documentation

atmos_phy_rd_mstrnx_setup()

subroutine, public scale_atmos_phy_rd_mstrnx::atmos_phy_rd_mstrnx_setup

(

character(len=*), intent(in)

RD_TYPE

)

Setup.

Definition at line 230 of file scale_atmos_phy_rd_mstrnx.F90.

References scale_atmos_phy_rd_profile::atmos_phy_rd_profile_read(), scale_atmos_phy_rd_profile::atmos_phy_rd_profile_setup(), scale_atmos_phy_rd_profile::atmos_phy_rd_profile_setup_zgrid(), scale_stdio::io_fid_conf, scale_stdio::io_fid_log, scale_stdio::io_fid_nml, scale_stdio::io_l, scale_stdio::io_nml, scale_grid_index::kmax, scale_atmos_aerosol::n_ae, scale_atmos_hydrometeor::n_hyd, scale_process::prc_mpistop(), scale_grid_real::real_basepoint_lat, and scale_time::time_nowdate.

Referenced by scale_atmos_phy_rd::atmos_phy_rd_setup().

    use scale_process, only: &
       prc_mpistop
    use scale_time, only: &
       time_nowdate
    use scale_grid_real, only: &
       real_basepoint_lat
    use scale_atmos_phy_rd_profile, only: &
       rd_profile_setup       => atmos_phy_rd_profile_setup,       &
       rd_profile_setup_zgrid => atmos_phy_rd_profile_setup_zgrid, &
       rd_profile_read        => atmos_phy_rd_profile_read
    use scale_atmos_hydrometeor, only: &
       n_hyd
    use scale_atmos_aerosol, only: &
       n_ae
    implicit none

    character(len=*), intent(in) :: RD_TYPE

    real(RP)              :: ATMOS_PHY_RD_MSTRN_TOA
    integer               :: ATMOS_PHY_RD_MSTRN_KADD
    character(len=H_LONG) :: ATMOS_PHY_RD_MSTRN_GASPARA_IN_FILENAME
    character(len=H_LONG) :: ATMOS_PHY_RD_MSTRN_AEROPARA_IN_FILENAME
    character(len=H_LONG) :: ATMOS_PHY_RD_MSTRN_HYGROPARA_IN_FILENAME
    integer               :: ATMOS_PHY_RD_MSTRN_nband
    integer               :: ATMOS_PHY_RD_MSTRN_nptype
    integer               :: ATMOS_PHY_RD_MSTRN_nradius

    namelist / param_atmos_phy_rd_mstrn / &
       atmos_phy_rd_mstrn_toa,                   &
       atmos_phy_rd_mstrn_kadd,                  &
       atmos_phy_rd_mstrn_gaspara_in_filename,   &
       atmos_phy_rd_mstrn_aeropara_in_filename,  &
       atmos_phy_rd_mstrn_hygropara_in_filename, &
       atmos_phy_rd_mstrn_nband,                 &
       atmos_phy_rd_mstrn_nptype,                &
       atmos_phy_rd_mstrn_nradius,               &
       atmos_phy_rd_mstrn_only_qci,              &
       atmos_phy_rd_mstrn_only_tropocloud

    integer :: ngas, ncfc
    integer :: ierr
    !---------------------------------------------------------------------------

    if( io_l ) write(io_fid_log,*)
    if( io_l ) write(io_fid_log,*) '++++++ Module[RADIATION] / Categ[ATMOS PHYSICS] / Origin[SCALElib]'
    if( io_l ) write(io_fid_log,*) '*** Sekiguchi and Nakajima (2008) mstrnX radiation process'

    if ( rd_type /= 'MSTRNX' ) then
       write(*,*) 'xxx RD_TYPE is not MSTRNX. Check!'
       call prc_mpistop
    endif

    !--- read namelist
    atmos_phy_rd_mstrn_toa                   = rd_toa
    atmos_phy_rd_mstrn_kadd                  = rd_kadd
    atmos_phy_rd_mstrn_gaspara_in_filename   = mstrn_gaspara_inputfile
    atmos_phy_rd_mstrn_aeropara_in_filename  = mstrn_aeropara_inputfile
    atmos_phy_rd_mstrn_hygropara_in_filename = mstrn_hygropara_inputfile
    atmos_phy_rd_mstrn_nband                 = mstrn_nband
    atmos_phy_rd_mstrn_nptype                = mstrn_nptype
    atmos_phy_rd_mstrn_nradius               = mstrn_nradius

    rewind(io_fid_conf)
    read(io_fid_conf,nml=param_atmos_phy_rd_mstrn,iostat=ierr)
    if( ierr < 0 ) then !--- missing
       if( io_l ) write(io_fid_log,*) '*** Not found namelist. Default used.'
    elseif( ierr > 0 ) then !--- fatal error
       write(*,*) 'xxx Not appropriate names in namelist PARAM_ATMOS_PHY_RD_MSTRN. Check!'
       call prc_mpistop
    endif
    if( io_nml ) write(io_fid_nml,nml=param_atmos_phy_rd_mstrn)

    rd_toa                    = atmos_phy_rd_mstrn_toa
    rd_kadd                   = atmos_phy_rd_mstrn_kadd
    mstrn_gaspara_inputfile   = atmos_phy_rd_mstrn_gaspara_in_filename
    mstrn_aeropara_inputfile  = atmos_phy_rd_mstrn_aeropara_in_filename
    mstrn_hygropara_inputfile = atmos_phy_rd_mstrn_hygropara_in_filename
    mstrn_nband               = atmos_phy_rd_mstrn_nband
    mstrn_nptype              = atmos_phy_rd_mstrn_nptype
    mstrn_nradius             = atmos_phy_rd_mstrn_nradius

    !--- setup MSTRN parameter
    call rd_mstrn_setup( ngas, & ! [OUT]
                         ncfc  ) ! [OUT]

    !--- setup climatological profile
    call rd_profile_setup

    rd_kmax = kmax + rd_kadd

    !--- allocate arrays
    ! input
    allocate( rd_zh(rd_kmax+1) )
    allocate( rd_z(rd_kmax  ) )

    allocate( rd_rhodz(rd_kmax  ) )
    allocate( rd_pres(rd_kmax  ) )
    allocate( rd_presh(rd_kmax+1) )
    allocate( rd_temp(rd_kmax  ) )
    allocate( rd_temph(rd_kmax+1) )

    allocate( rd_gas(rd_kmax,ngas    ) )
    allocate( rd_cfc(rd_kmax,ncfc    ) )
    allocate( rd_aerosol_conc(rd_kmax,rd_naero) )
    allocate( rd_aerosol_radi(rd_kmax,rd_naero) )
    allocate( rd_cldfrac(rd_kmax         ) )

    !--- setup vartical grid for radiation (larger TOA than Model domain)
    call rd_profile_setup_zgrid( rd_toa, rd_kmax, rd_kadd, & ! [IN]
                                 rd_zh(:), rd_z(:)         ) ! [INOUT]

    !--- read climatological profile
    call rd_profile_read( rd_kmax,                & ! [IN]
                          ngas,                   & ! [IN]
                          ncfc,                   & ! [IN]
                          rd_naero,               & ! [IN]
                          real_basepoint_lat,     & ! [IN]
                          time_nowdate(:),     & ! [IN]
                          rd_zh(:),     & ! [IN]
                          rd_z(:),     & ! [IN]
                          rd_rhodz(:),     & ! [OUT]
                          rd_pres(:),     & ! [OUT]
                          rd_presh(:),     & ! [OUT]
                          rd_temp(:),     & ! [OUT]
                          rd_temph(:),     & ! [OUT]
                          rd_gas(:,:),   & ! [OUT]
                          rd_cfc(:,:),   & ! [OUT]
                          rd_aerosol_conc(:,:),   & ! [OUT]
                          rd_aerosol_radi(:,:),   & ! [OUT]
                          rd_cldfrac(:)      ) ! [OUT]

    return

Here is the call graph for this function:

Here is the caller graph for this function:

atmos_phy_rd_mstrnx()

subroutine, public scale_atmos_phy_rd_mstrnx::atmos_phy_rd_mstrnx	(	real(rp), dimension (ka,ia,ja), intent(in)	DENS,
		real(rp), dimension (ka,ia,ja), intent(in)	RHOT,
		real(rp), dimension (ka,ia,ja,qa), intent(in)	QTRC,
		real(rp), dimension ( ka,ia,ja), intent(in)	CZ,
		real(rp), dimension (0:ka,ia,ja), intent(in)	FZ,
		real(rp), dimension (ia,ja), intent(in)	fact_ocean,
		real(rp), dimension (ia,ja), intent(in)	fact_land,
		real(rp), dimension (ia,ja), intent(in)	fact_urban,
		real(rp), dimension (ia,ja), intent(in)	temp_sfc,
		real(rp), dimension (ia,ja,2), intent(in)	albedo_land,
		real(rp), dimension (ia,ja), intent(in)	solins,
		real(rp), dimension (ia,ja), intent(in)	cosSZA,
		real(rp), dimension (ka,ia,ja,2,2,2), intent(out)	flux_rad,
		real(rp), dimension (ia,ja,2,2,2), intent(out)	flux_rad_top,
		real(rp), dimension(ia,ja,2,2), intent(out)	flux_rad_sfc_dn
	)

Radiation main.

Definition at line 377 of file scale_atmos_phy_rd_mstrnx.F90.

References scale_atmos_phy_ae::atmos_phy_ae_dens, scale_atmos_phy_ae::atmos_phy_ae_effectiveradius, scale_atmos_phy_mp::atmos_phy_mp_cloudfraction, scale_atmos_phy_mp::atmos_phy_mp_dens, scale_atmos_phy_mp::atmos_phy_mp_effectiveradius, scale_atmos_phy_mp::atmos_phy_mp_mixingratio, scale_atmos_phy_rd_profile::atmos_phy_rd_profile_read(), scale_atmos_phy_rd_profile::atmos_phy_rd_profile_use_climatology, scale_const::const_eps, scale_const::const_eps1, scale_const::const_grav, scale_const::const_mdry, scale_const::const_mvap, scale_const::const_pi, scale_const::const_ppm, scale_const::const_pstd, scale_const::const_rdry, scale_const::const_tem00, scale_atmos_phy_rd_common::i_dn, scale_atmos_hydrometeor::i_hc, scale_atmos_hydrometeor::i_hi, scale_atmos_phy_rd_common::i_lw, scale_atmos_hydrometeor::i_qv, scale_atmos_phy_rd_common::i_sw, scale_atmos_phy_rd_common::i_up, scale_grid_index::ie, scale_stdio::io_fid_log, scale_stdio::io_get_available_fid(), scale_stdio::io_l, scale_grid_index::is, scale_grid_index::je, scale_grid_index::js, scale_grid_index::ke, scale_grid_index::ks, scale_atmos_aerosol::n_ae, scale_atmos_hydrometeor::n_hyd, scale_process::prc_mpistop(), scale_prof::prof_rapend(), scale_prof::prof_rapstart(), scale_atmos_phy_ae::qa_ae, scale_atmos_phy_ae::qs_ae, scale_grid_real::real_basepoint_lat, scale_time::time_nowdate, scale_tracer::tracer_cv, scale_tracer::tracer_mass, and scale_tracer::tracer_r.

Referenced by scale_atmos_phy_rd::atmos_phy_rd_setup().

!       Jval                            )
    use scale_grid_index
    use scale_tracer
    use scale_const, only: &
       eps  => const_eps, &
       mdry => const_mdry, &
       mvap => const_mvap, &
       ppm  => const_ppm
    use scale_time, only: &
       time_nowdate
    use scale_grid_real, only: &
       real_basepoint_lat
    use scale_atmos_thermodyn, only: &
       thermodyn_temp_pres => atmos_thermodyn_temp_pres
    use scale_atmos_saturation, only: &
       saturation_dens2qsat_liq => atmos_saturation_dens2qsat_liq
    use scale_atmos_phy_mp, only: &
       mp_effectiveradius => atmos_phy_mp_effectiveradius, &
       mp_cloudfraction   => atmos_phy_mp_cloudfraction,   &
       mp_mixingratio     => atmos_phy_mp_mixingratio,     &
       mp_dens            => atmos_phy_mp_dens
    use scale_atmos_phy_ae, only: &
       ae_effectiveradius => atmos_phy_ae_effectiveradius, &
       ae_dens            => atmos_phy_ae_dens, &
       qa_ae, &
       qs_ae
    use scale_atmos_hydrometeor, only: &
       n_hyd, &
       i_qv, &
       i_hc, &
       i_hi
    use scale_atmos_aerosol, only: &
       n_ae
    use scale_atmos_phy_rd_profile, only: &
       rd_profile_read            => atmos_phy_rd_profile_read, &
       rd_profile_use_climatology => atmos_phy_rd_profile_use_climatology
    implicit none

    real(RP), intent(in)  :: DENS           (KA,IA,JA)
    real(RP), intent(in)  :: RHOT           (KA,IA,JA)
    real(RP), intent(in)  :: QTRC           (KA,IA,JA,QA)
    real(RP), intent(in)  :: CZ             (  KA,IA,JA)    ! UNUSED
    real(RP), intent(in)  :: FZ             (0:KA,IA,JA)
    real(RP), intent(in)  :: fact_ocean     (IA,JA)
    real(RP), intent(in)  :: fact_land      (IA,JA)
    real(RP), intent(in)  :: fact_urban     (IA,JA)
    real(RP), intent(in)  :: temp_sfc       (IA,JA)
    real(RP), intent(in)  :: albedo_land    (IA,JA,2)
    real(RP), intent(in)  :: solins         (IA,JA)
    real(RP), intent(in)  :: cosSZA         (IA,JA)
    real(RP), intent(out) :: flux_rad       (KA,IA,JA,2,2,2)
    real(RP), intent(out) :: flux_rad_top   (IA,JA,2,2,2)
    real(RP), intent(out) :: flux_rad_sfc_dn(IA,JA,2,2)
!    real(RP), intent(out) :: Jval        (KA,IA,JA,CH_QA_photo)

    real(RP) :: temp   (KA,IA,JA)
    real(RP) :: pres   (KA,IA,JA)
    real(RP) :: qsat   (KA,IA,JA)
    real(RP) :: rh     (KA,IA,JA)
    real(RP) :: cldfrac(KA,IA,JA)
    real(RP) :: MP_Re  (KA,IA,JA,N_HYD)
    real(RP) :: MP_Qe  (KA,IA,JA,N_HYD)
    real(RP) :: AE_Re  (KA,IA,JA,N_AE)

    integer  :: tropopause(IA,JA)
    real(RP) :: gamma

    real(RP), parameter :: min_cldfrac = 1.e-8_rp

    real(RP) :: rhodz_merge       (RD_KMAX,IA,JA)
    real(RP) :: pres_merge        (RD_KMAX,IA,JA)
    real(RP) :: temp_merge        (RD_KMAX,IA,JA)
    real(RP) :: temph_merge       (RD_KMAX+1,IA,JA)

    real(RP) :: gas_merge         (RD_KMAX,IA,JA,MSTRN_ngas)
    real(RP) :: cfc_merge         (RD_KMAX,IA,JA,MSTRN_ncfc)
    real(RP) :: aerosol_conc_merge(RD_KMAX,IA,JA,RD_naero  )
    real(RP) :: aerosol_radi_merge(RD_KMAX,IA,JA,RD_naero  )
    real(RP) :: cldfrac_merge     (RD_KMAX,IA,JA)

    ! output
    real(RP) :: flux_rad_merge(RD_KMAX+1,IA,JA,2,2,MSTRN_ncloud)

    real(RP) :: zerosw

    integer :: ihydro, iaero
    integer :: RD_k, k, i, j, v, ic
    !---------------------------------------------------------------------------

    if( io_l ) write(io_fid_log,*) '*** Atmos physics  step: Radiation(mstrnX)'

    call prof_rapstart('RD_Profile', 3)

    call thermodyn_temp_pres( temp(:,:,:),   & ! [OUT]
                              pres(:,:,:),   & ! [OUT]
                              dens(:,:,:),   & ! [IN]
                              rhot(:,:,:),   & ! [IN]
                              qtrc(:,:,:,:), & ! [IN]
                              tracer_cv(:),  & ! [IN]
                              tracer_r(:),   & ! [IN]
                              tracer_mass(:) ) ! [IN]

    call saturation_dens2qsat_liq( qsat(:,:,:), & ! [OUT]
                                   temp(:,:,:), & ! [IN]
                                   dens(:,:,:)  ) ! [IN]

!OCL XFILL
    if ( i_qv > 0 ) then
       do j  = js, je
       do i  = is, ie
       do k  = ks, ke
          rh(k,i,j) = qtrc(k,i,j,i_qv) / qsat(k,i,j)
       enddo
       enddo
       enddo
    else
       do j  = js, je
       do i  = is, ie
       do k  = ks, ke
          rh(k,i,j) = 0.0_rp
       enddo
       enddo
       enddo
    endif

    call mp_cloudfraction( cldfrac(:,:,:), & ! [OUT]
                           qtrc(:,:,:,:),  & ! [IN]
                           eps             ) ! [IN]

    call mp_effectiveradius( mp_re(:,:,:,:), & ! [OUT]
                             qtrc(:,:,:,:), & ! [IN]
                             dens(:,:,:)  , & ! [IN]
                             temp(:,:,:)    ) ! [IN]

    call ae_effectiveradius( ae_re(:,:,:,:), & ! [OUT]
                             qtrc(:,:,:,:), & ! [IN]
                             rh(:,:,:)    ) ! [IN]

    call mp_mixingratio( mp_qe(:,:,:,:), & ! [OUT]
                         qtrc(:,:,:,:)  ) ! [IN]

!    call AE_Mixingratio( AE_Qe(:,:,:,:), & ! [OUT]
!                         QTRC (:,:,:,:)  ) ! [IN]

    if ( atmos_phy_rd_mstrn_only_qci ) then
       do ihydro = 1, n_hyd
          if ( ihydro /= i_hc .and. ihydro /= i_hi ) then
             mp_qe(:,:,:,ihydro) = 0.0_rp
          end if
       end do
    end if

    if ( atmos_phy_rd_mstrn_only_tropocloud ) then
       do j  = js, je
       do i  = is, ie
          tropopause(i,j) = ke+1
          do k  = ke, ks, -1
             if ( pres(k,i,j) >= 300.e+2_rp ) then
                exit
             elseif( pres(k,i,j) <  50.e+2_rp ) then
                tropopause(i,j) = k
             else
                gamma = ( temp(k+1,i,j) - temp(k,i,j) ) / ( cz(k+1,i,j) - cz(k,i,j) )
                if( gamma > 1.e-4 ) tropopause(i,j) = k
             endif
          enddo
       enddo
       enddo

       do ihydro = 1, n_hyd
       do j  = js, je
       do i  = is, ie
          do k  = tropopause(i,j), ke
             mp_qe(k,i,j,ihydro) = 0.0_rp
          enddo
       enddo
       enddo
       enddo
    endif

    ! marge basic profile and value in model domain

    if ( rd_profile_use_climatology ) then
       call rd_profile_read( rd_kmax,                & ! [IN]
                             mstrn_ngas,             & ! [IN]
                             mstrn_ncfc,             & ! [IN]
                             rd_naero,               & ! [IN]
                             real_basepoint_lat,     & ! [IN]
                             time_nowdate(:),     & ! [IN]
                             rd_zh(:),     & ! [IN]
                             rd_z(:),     & ! [IN]
                             rd_rhodz(:),     & ! [OUT]
                             rd_pres(:),     & ! [OUT]
                             rd_presh(:),     & ! [OUT]
                             rd_temp(:),     & ! [OUT]
                             rd_temph(:),     & ! [OUT]
                             rd_gas(:,:),   & ! [OUT]
                             rd_cfc(:,:),   & ! [OUT]
                             rd_aerosol_conc(:,:),   & ! [OUT]
                             rd_aerosol_radi(:,:),   & ! [OUT]
                             rd_cldfrac(:)      ) ! [OUT]
    endif

!OCL XFILL
    !$omp parallel do default(none)                                           &
    !$omp shared(JS,JE,IS,IE,RD_KADD,temph_merge,RD_temph,KE,RD_KMAX,KS,temp,CZ,FZ) &
    !$omp private(i,j,k,RD_k) OMP_SCHEDULE_ collapse(2)
    do j = js, je
    do i = is, ie
       do rd_k = 1, rd_kadd
          temph_merge(rd_k,i,j) = rd_temph(rd_k)
       enddo

       temp(ke+1,i,j) = temp(ke,i,j)
       do rd_k = rd_kadd+1, rd_kmax
          k = ks + rd_kmax - rd_k ! reverse axis

          temph_merge(rd_k,i,j) = ( temp(k  ,i,j) * (cz(k+1,i,j)-fz(k,i,j)) / (cz(k+1,i,j)-cz(k,i,j)) &
                                  + temp(k+1,i,j) * (fz(k  ,i,j)-cz(k,i,j)) / (cz(k+1,i,j)-cz(k,i,j)) )
       enddo
       temph_merge(rd_kmax+1,i,j) = temp(ks,i,j)
    enddo
    enddo

!OCL XFILL
    !$omp parallel do default(none) private(i,j,RD_k,k) OMP_SCHEDULE_ collapse(2) &
    !$omp shared(JS,JE,IS,IE,RD_KADD,rhodz_merge,RD_rhodz,pres_merge,RD_pres,temp_merge) &
    !$omp shared(RD_temp,RD_KMAX,KS,dens,FZ,pres,temp)
    do j = js, je
    do i = is, ie
       do rd_k = 1, rd_kadd
          rhodz_merge(rd_k,i,j) = rd_rhodz(rd_k)
          pres_merge(rd_k,i,j) = rd_pres(rd_k)
          temp_merge(rd_k,i,j) = rd_temp(rd_k)
       enddo

       do rd_k = rd_kadd+1, rd_kmax
          k = ks + rd_kmax - rd_k ! reverse axis

          rhodz_merge(rd_k,i,j) = dens(k,i,j) * ( fz(k,i,j)-fz(k-1,i,j) ) ! [kg/m2]
          pres_merge(rd_k,i,j) = pres(k,i,j) * 1.e-2_rp ! [hPa]
          temp_merge(rd_k,i,j) = temp(k,i,j)
       enddo
    enddo
    enddo

!OCL XFILL
!OCL SERIAL
    do v = 1,  mstrn_ngas
!OCL PARALLEL
    do j = js, je
    do i = is, ie
       do rd_k = 1, rd_kmax
          gas_merge(rd_k,i,j,v) = rd_gas(rd_k,v)
       enddo
    enddo
    enddo
    enddo

    if ( i_qv > 0 ) then
       do j = js, je
       do i = is, ie
          do rd_k = rd_kadd+1, rd_kmax
             k = ks + rd_kmax - rd_k ! reverse axis
             zerosw = sign(0.5_rp, qtrc(k,i,j,i_qv)-eps) + 0.5_rp
             gas_merge(rd_k,i,j,1) = qtrc(k,i,j,i_qv) / mvap * mdry / ppm * zerosw ! [PPM]
          enddo
       enddo
       enddo
    endif

!OCL XFILL
!OCL SERIAL
    do v = 1,  mstrn_ncfc
!OCL PARALLEL
    do j = js, je
    do i = is, ie
       do rd_k = 1, rd_kmax
          cfc_merge(rd_k,i,j,v) = rd_cfc(rd_k,v)
       enddo
    enddo
    enddo
    enddo

    do j = js, je
    do i = is, ie
       do rd_k = 1, rd_kadd
          cldfrac_merge(rd_k,i,j) = rd_cldfrac(rd_k)
       enddo

       do rd_k = rd_kadd+1, rd_kmax
          k = ks + rd_kmax - rd_k ! reverse axis

          cldfrac_merge(rd_k,i,j) = 0.5_rp + sign( 0.5_rp, cldfrac(k,i,j)-min_cldfrac )
       enddo
    enddo
    enddo

!OCL XFILL
!OCL SERIAL
    do v = 1,  rd_naero
!OCL PARALLEL
    do j = js, je
    do i = is, ie
    do rd_k = 1, rd_kadd
       aerosol_conc_merge(rd_k,i,j,v) = rd_aerosol_conc(rd_k,v)
       aerosol_radi_merge(rd_k,i,j,v) = rd_aerosol_radi(rd_k,v)
    enddo
    enddo
    enddo
    enddo

!OCL SERIAL
    do ihydro = 1, n_hyd
!OCL PARALLEL
    do j = js, je
    do i = is, ie
    do rd_k = rd_kadd+1, rd_kmax
       k = ks + rd_kmax - rd_k ! reverse axis

       aerosol_conc_merge(rd_k,i,j,ihydro) = max( mp_qe(k,i,j,ihydro), 0.0_rp ) &
                                           / mp_dens(ihydro) * rho_std / ppm ! [PPM to standard air]
       aerosol_radi_merge(rd_k,i,j,ihydro) = mp_re(k,i,j,ihydro)
    enddo
    enddo
    enddo
    enddo

!OCL SERIAL
    do iaero = 1, n_ae

!!$       do j = JS, JE
!!$       do i = IS, IE
!!$       do RD_k = RD_KADD+1, RD_KMAX
!!$          k = KS + RD_KMAX - RD_k ! reverse axis
!!$
!!$          aerosol_conc_merge(RD_k,i,j,N_HYD+iaero) = max( AE_Qe(k,i,j,iaero), 0.0_RP ) &
!!$                                                   / AE_DENS(iaero) * RHO_std / PPM ! [PPM to standard air]
!!$          aerosol_radi_merge(RD_k,i,j,N_HYD+iaero) = AE_Re(k,i,j,iaero)
!!$       enddo
!!$       enddo
!!$       enddo

!OCL PARALLEL
       do j = js, je
       do i = is, ie
       do rd_k = rd_kadd+1, rd_kmax
          aerosol_conc_merge(rd_k,i,j,n_hyd+iaero) = rd_aerosol_conc(rd_k,n_hyd+iaero)
          aerosol_radi_merge(rd_k,i,j,n_hyd+iaero) = rd_aerosol_radi(rd_k,n_hyd+iaero)
       enddo
       enddo
       enddo

    enddo

    call prof_rapend  ('RD_Profile', 3)
    call prof_rapstart('RD_MSTRN_DTRN3', 3)

    ! calc radiative transfer
    call rd_mstrn_dtrn3( rd_kmax,                         & ! [IN]
                         mstrn_ngas,                      & ! [IN]
                         mstrn_ncfc,                      & ! [IN]
                         rd_naero,                        & ! [IN]
                         rd_hydro_str,                    & ! [IN]
                         rd_hydro_end,                    & ! [IN]
                         rd_aero_str,                     & ! [IN]
                         rd_aero_end,                     & ! [IN]
                         solins(:,:),         & ! [IN]
                         cossza(:,:),         & ! [IN]
                         rhodz_merge(:,:,:),       & ! [IN]
                         pres_merge(:,:,:),       & ! [IN]
                         temp_merge(:,:,:),       & ! [IN]
                         temph_merge(:,:,:),       & ! [IN]
                         temp_sfc(:,:),         & ! [IN]
                         gas_merge(:,:,:,:),     & ! [IN]
                         cfc_merge(:,:,:,:),     & ! [IN]
                         aerosol_conc_merge(:,:,:,:),     & ! [IN]
                         aerosol_radi_merge(:,:,:,:),     & ! [IN]
                         i_mpae2rd(:),           & ! [IN]
                         cldfrac_merge(:,:,:),       & ! [IN]
                         albedo_land(:,:,:),       & ! [IN]
                         fact_ocean(:,:),         & ! [IN]
                         fact_land(:,:),         & ! [IN]
                         fact_urban(:,:),         & ! [IN]
                         flux_rad_merge(:,:,:,:,:,:), & ! [OUT]
                         flux_rad_sfc_dn(:,:,:,:)      ) ! [OUT]

    call prof_rapend  ('RD_MSTRN_DTRN3', 3)

    ! return to grid coordinate of model domain
!OCL SERIAL
    do ic = 1, 2
!OCL PARALLEL
    do j  = js, je
    do i  = is, ie
    do rd_k = rd_kadd+1, rd_kmax+1
       k = ks + rd_kmax - rd_k ! reverse axis

       flux_rad(k,i,j,i_lw,i_up,ic) = flux_rad_merge(rd_k,i,j,i_lw,i_up,ic)
       flux_rad(k,i,j,i_lw,i_dn,ic) = flux_rad_merge(rd_k,i,j,i_lw,i_dn,ic)
       flux_rad(k,i,j,i_sw,i_up,ic) = flux_rad_merge(rd_k,i,j,i_sw,i_up,ic)
       flux_rad(k,i,j,i_sw,i_dn,ic) = flux_rad_merge(rd_k,i,j,i_sw,i_dn,ic)
    enddo
    enddo
    enddo
    enddo

!OCL XFILL
!OCL SERIAL
    do ic = 1, 2
!OCL PARALLEL
    do j  = js, je
    do i  = is, ie
       flux_rad_top(i,j,i_lw,i_up,ic) = flux_rad_merge(1,i,j,i_lw,i_up,ic)
       flux_rad_top(i,j,i_lw,i_dn,ic) = flux_rad_merge(1,i,j,i_lw,i_dn,ic)
       flux_rad_top(i,j,i_sw,i_up,ic) = flux_rad_merge(1,i,j,i_sw,i_up,ic)
       flux_rad_top(i,j,i_sw,i_dn,ic) = flux_rad_merge(1,i,j,i_sw,i_dn,ic)
    enddo
    enddo
    enddo

    return

Here is the call graph for this function:

Here is the caller graph for this function: