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]

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 221 of file scale_atmos_phy_rd_mstrnx.F90.

References scale_tracer::ae_qa, 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_tracer::i_ae2rd, scale_tracer::i_mp2rd, scale_stdio::io_fid_conf, scale_stdio::io_fid_log, scale_stdio::io_l, scale_stdio::io_lnml, scale_grid_index::kmax, scale_tracer::mp_qa, 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
    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

    integer :: ngas, ncfc
    integer :: ihydro, iaero
    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,*) '+++ 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_lnml ) write(io_fid_log,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
    rd_naero     = mp_qa + ae_qa
    rd_hydro_str = 1
    rd_hydro_end = mp_qa
    rd_aero_str  = mp_qa + 1
    rd_aero_end  = mp_qa + ae_qa

    !--- 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         ) )

    allocate( i_mpae2rd(rd_naero) )

    ! make look-up table between hydrometeor tracer and mstrn particle type
    do ihydro = 1, mp_qa
       i_mpae2rd(ihydro) = i_mp2rd(ihydro)
    enddo
    ! make look-up table between aerosol     tracer and mstrn particle type
    do iaero = 1, ae_qa
       i_mpae2rd(mp_qa+iaero) = i_ae2rd(iaero)
    enddo

    !--- 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 380 of file scale_atmos_phy_rd_mstrnx.F90.

References scale_atmos_phy_ae::ae_dens, scale_tracer::ae_qa, 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_huge, 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_tracer::i_ae2all, scale_atmos_phy_rd_common::i_dn, scale_atmos_phy_rd_common::i_lw, scale_tracer::i_mp2all, scale_tracer::i_qc, scale_tracer::i_qi, scale_tracer::i_qv, scale_atmos_phy_rd_common::i_sw, scale_atmos_phy_rd_common::i_up, scale_grid_index::ie, scale_grid_index::imax, 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::jmax, scale_grid_index::js, scale_grid_index::ke, scale_grid_index::ks, scale_tracer::mp_qa, scale_process::prc_mpistop(), scale_prof::prof_rapend(), scale_prof::prof_rapstart(), scale_grid_real::real_basepoint_lat, and scale_time::time_nowdate.

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
    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,mp_qa)
    real(RP) :: mp_qe  (ka,ia,ja,mp_qa)
    real(RP) :: ae_re  (ka,ia,ja,ae_qa)

    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, iq
    integer :: rd_k, k, i, j, v, ic
    !---------------------------------------------------------------------------

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

    call prof_rapstart('RD_Profile', 3)

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

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

!OCL XFILL
    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

    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]

    if ( atmos_phy_rd_mstrn_only_qci ) then
       do ihydro = 1, mp_qa
          iq = i_mp2all(ihydro)
          if ( iq /= i_qc .AND. iq /= i_qi ) then
!OCL XFILL
             mp_qe(:,:,:,ihydro) = 0.0_rp
          end if
       end do
    end if

    ! 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
    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) = 0.5_rp * ( temp(k,i,j) + temp(k+1,i,j) )
       enddo
       temph_merge(rd_kmax+1,i,j) = temp(ks,i,j)
    enddo
    enddo

!OCL XFILL
    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
    do v = 1,  mstrn_ngas
    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

    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

!OCL XFILL
    do v = 1,  mstrn_ncfc
    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
    do v = 1,  rd_naero
    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

    do ihydro = 1, mp_qa
    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

    do iaero = 1, ae_qa
       if ( i_ae2all(iaero) > 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

             aerosol_conc_merge(rd_k,i,j,mp_qa+iaero) = max( qtrc(k,i,j,i_ae2all(iaero)), 0.0_rp ) &
                                                      / ae_dens(iaero) * rho_std / ppm ! [PPM to standard air]
             aerosol_radi_merge(rd_k,i,j,mp_qa+iaero) = ae_re(k,i,j,iaero)
          enddo
          enddo
          enddo
       else
!OCL XFILL
          do j = js, je
          do i = is, ie
          do rd_k = rd_kadd+1, rd_kmax
             aerosol_conc_merge(rd_k,i,j,mp_qa+iaero) = rd_aerosol_conc(rd_k,mp_qa+iaero)
             aerosol_radi_merge(rd_k,i,j,mp_qa+iaero) = rd_aerosol_radi(rd_k,mp_qa+iaero)
          enddo
          enddo
          enddo
       endif
    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
    do ic = 1, 2
    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
    do ic = 1, 2
    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: