SCALE-RM
Functions/Subroutines
scale_atmos_phy_rd_mstrnx Module Reference

module atmosphere / physics / radiation / mstrnX More...

Functions/Subroutines

subroutine, public atmos_phy_rd_mstrnx_setup (KA, KS, KE, CZ, FZ)
 Setup. More...
 
subroutine, public atmos_phy_rd_mstrnx_flux (KA, KS, KE, IA, IS, IE, JA, JS, JE, DENS, TEMP, PRES, QV, CZ, FZ, fact_ocean, fact_land, fact_urban, temp_sfc, albedo_sfc, solins, cosSZA, CLDFRAC, MP_Re, MP_Qe, AE_Re, flux_rad, flux_rad_top, flux_rad_sfc_dn, dtau_s, dem_s)
 Radiation main. More...
 

Detailed Description

module atmosphere / physics / radiation / mstrnX

Description
Atmospheric radiation transfer process mstrnX Ref: Nakajima and Tanaka(1986) Nakajima et al.(2000) Sekiguchi and Nakajima(2008)
Author
Team SCALE
NAMELIST
  • PARAM_ATMOS_PHY_RD_MSTRN
    nametypedefault valuecomment
    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 ( integer, intent(in)  KA,
integer, intent(in)  KS,
integer, intent(in)  KE,
real(rp), dimension(ka), intent(in)  CZ,
real(rp), dimension(0:ka), intent(in)  FZ 
)

Setup.

Definition at line 221 of file scale_atmos_phy_rd_mstrnx.F90.

References scale_atmos_grid_cartesc_real::atmos_grid_cartesc_real_basepoint_lat, 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_io::io_fid_conf, scale_atmos_aerosol::n_ae, scale_atmos_hydrometeor::n_hyd, scale_prc::prc_abort(), and scale_time::time_nowdate.

Referenced by mod_atmos_phy_rd_driver::atmos_phy_rd_driver_setup().

221  use scale_prc, only: &
222  prc_abort
223  use scale_time, only: &
225  use scale_atmos_grid_cartesc_real, only: &
227  use scale_atmos_phy_rd_profile, only: &
228  rd_profile_setup => atmos_phy_rd_profile_setup, &
229  rd_profile_setup_zgrid => atmos_phy_rd_profile_setup_zgrid, &
230  rd_profile_read => atmos_phy_rd_profile_read
231  use scale_atmos_hydrometeor, only: &
232  n_hyd
233  use scale_atmos_aerosol, only: &
234  n_ae
235  implicit none
236  integer, intent(in) :: ka, ks, ke
237 
238  real(RP), intent(in) :: cz(ka)
239  real(RP), intent(in) :: fz(0:ka)
240 
241  real(RP) :: atmos_phy_rd_mstrn_toa
242  integer :: atmos_phy_rd_mstrn_kadd
243  character(len=H_LONG) :: atmos_phy_rd_mstrn_gaspara_in_filename
244  character(len=H_LONG) :: atmos_phy_rd_mstrn_aeropara_in_filename
245  character(len=H_LONG) :: atmos_phy_rd_mstrn_hygropara_in_filename
246  integer :: atmos_phy_rd_mstrn_nband
247  integer :: atmos_phy_rd_mstrn_nptype
248  integer :: atmos_phy_rd_mstrn_nradius
249 
250  namelist / param_atmos_phy_rd_mstrn / &
251  atmos_phy_rd_mstrn_toa, &
252  atmos_phy_rd_mstrn_kadd, &
253  atmos_phy_rd_mstrn_gaspara_in_filename, &
254  atmos_phy_rd_mstrn_aeropara_in_filename, &
255  atmos_phy_rd_mstrn_hygropara_in_filename, &
256  atmos_phy_rd_mstrn_nband, &
257  atmos_phy_rd_mstrn_nptype, &
258  atmos_phy_rd_mstrn_nradius, &
259  atmos_phy_rd_mstrn_only_qci, &
260  atmos_phy_rd_mstrn_only_tropocloud
261 
262  integer :: kmax
263  integer :: ngas, ncfc
264  integer :: ierr
265  !---------------------------------------------------------------------------
266 
267  log_newline
268  log_info("ATMOS_PHY_RD_mstrnx_setup",*) 'Setup'
269  log_info("ATMOS_PHY_RD_mstrnx_setup",*) 'Sekiguchi and Nakajima (2008) mstrnX radiation process'
270 
271  !--- read namelist
272  atmos_phy_rd_mstrn_toa = rd_toa
273  atmos_phy_rd_mstrn_kadd = rd_kadd
274  atmos_phy_rd_mstrn_gaspara_in_filename = mstrn_gaspara_inputfile
275  atmos_phy_rd_mstrn_aeropara_in_filename = mstrn_aeropara_inputfile
276  atmos_phy_rd_mstrn_hygropara_in_filename = mstrn_hygropara_inputfile
277  atmos_phy_rd_mstrn_nband = mstrn_nband
278  atmos_phy_rd_mstrn_nptype = mstrn_nptype
279  atmos_phy_rd_mstrn_nradius = mstrn_nradius
280 
281  rewind(io_fid_conf)
282  read(io_fid_conf,nml=param_atmos_phy_rd_mstrn,iostat=ierr)
283  if( ierr < 0 ) then !--- missing
284  log_info("ATMOS_PHY_RD_mstrnx_setup",*) 'Not found namelist. Default used.'
285  elseif( ierr > 0 ) then !--- fatal error
286  log_error("ATMOS_PHY_RD_mstrnx_setup",*) 'Not appropriate names in namelist PARAM_ATMOS_PHY_RD_MSTRN. Check!'
287  call prc_abort
288  endif
289  log_nml(param_atmos_phy_rd_mstrn)
290 
291  rd_toa = atmos_phy_rd_mstrn_toa
292  rd_kadd = atmos_phy_rd_mstrn_kadd
293  mstrn_gaspara_inputfile = atmos_phy_rd_mstrn_gaspara_in_filename
294  mstrn_aeropara_inputfile = atmos_phy_rd_mstrn_aeropara_in_filename
295  mstrn_hygropara_inputfile = atmos_phy_rd_mstrn_hygropara_in_filename
296  mstrn_nband = atmos_phy_rd_mstrn_nband
297  mstrn_nptype = atmos_phy_rd_mstrn_nptype
298  mstrn_nradius = atmos_phy_rd_mstrn_nradius
299 
300  !--- setup MSTRN parameter
301  call rd_mstrn_setup( ngas, & ! [OUT]
302  ncfc ) ! [OUT]
303 
304  !--- setup climatological profile
305  call rd_profile_setup
306 
307  kmax = ke - ks + 1
308  rd_kmax = kmax + rd_kadd
309 
310  !--- allocate arrays
311  ! input
312  allocate( rd_zh(rd_kmax+1) )
313  allocate( rd_z(rd_kmax ) )
314 
315  allocate( rd_rhodz(rd_kmax ) )
316  allocate( rd_pres(rd_kmax ) )
317  allocate( rd_presh(rd_kmax+1) )
318  allocate( rd_temp(rd_kmax ) )
319  allocate( rd_temph(rd_kmax+1) )
320 
321  allocate( rd_gas(rd_kmax,ngas ) )
322  allocate( rd_cfc(rd_kmax,ncfc ) )
323  allocate( rd_aerosol_conc(rd_kmax,rd_naero) )
324  allocate( rd_aerosol_radi(rd_kmax,rd_naero) )
325  allocate( rd_cldfrac(rd_kmax ) )
326 
327  !--- setup vartical grid for radiation (larger TOA than Model domain)
328  call rd_profile_setup_zgrid( &
329  ka, ks, ke, &
330  rd_kmax, rd_kadd, & ! [IN]
331  rd_toa, cz(:), fz(:), & ! [IN]
332  rd_zh(:), rd_z(:) ) ! [OUT]
333 
334  !--- read climatological profile
335  call rd_profile_read( rd_kmax, & ! [IN]
336  ngas, & ! [IN]
337  ncfc, & ! [IN]
338  rd_naero, & ! [IN]
340  time_nowdate(:), & ! [IN]
341  rd_zh(:), & ! [IN]
342  rd_z(:), & ! [IN]
343  rd_rhodz(:), & ! [OUT]
344  rd_pres(:), & ! [OUT]
345  rd_presh(:), & ! [OUT]
346  rd_temp(:), & ! [OUT]
347  rd_temph(:), & ! [OUT]
348  rd_gas(:,:), & ! [OUT]
349  rd_cfc(:,:), & ! [OUT]
350  rd_aerosol_conc(:,:), & ! [OUT]
351  rd_aerosol_radi(:,:), & ! [OUT]
352  rd_cldfrac(:) ) ! [OUT]
353 
354  return
integer, parameter, public n_ae
subroutine, public atmos_phy_rd_profile_setup_zgrid(KA, KS, KE, KMAX, KADD, toa, CZ, FZ, zh, z)
Setup vertical grid for radiation.
integer, public io_fid_conf
Config file ID.
Definition: scale_io.F90:55
module atmosphere / physics/ radiation / profile
module atmosphere / aerosol
subroutine, public atmos_phy_rd_profile_setup
Setup.
module atmosphere / hydrometeor
integer, public ke
end point of inner domain: z, local
module PROCESS
Definition: scale_prc.F90:11
real(rp), public atmos_grid_cartesc_real_basepoint_lat
position of base point in real world [rad,-pi,pi]
module TIME
Definition: scale_time.F90:16
integer, public ks
start point of inner domain: z, local
integer, public kmax
of computational cells: z, local
subroutine, public prc_abort
Abort Process.
Definition: scale_prc.F90:338
module Atmosphere GRID CartesC Real(real space)
subroutine, public atmos_phy_rd_profile_read(kmax, ngas, ncfc, naero, real_lat, now_date, zh, z, rhodz, pres, presh, temp, temph, gas, cfc, aerosol_conc, aerosol_radi, cldfrac)
Read profile for radiation.
integer, public ka
of whole cells: z, local, with HALO
integer, dimension(6), public time_nowdate
current time [YYYY MM DD HH MM SS]
Definition: scale_time.F90:69
integer, parameter, public n_hyd
Here is the call graph for this function:
Here is the caller graph for this function:

◆ atmos_phy_rd_mstrnx_flux()

subroutine, public scale_atmos_phy_rd_mstrnx::atmos_phy_rd_mstrnx_flux ( integer, intent(in)  KA,
integer, intent(in)  KS,
integer, intent(in)  KE,
integer, intent(in)  IA,
integer, intent(in)  IS,
integer, intent(in)  IE,
integer, intent(in)  JA,
integer, intent(in)  JS,
integer, intent(in)  JE,
real(rp), dimension (ka,ia,ja), intent(in)  DENS,
real(rp), dimension (ka,ia,ja), intent(in)  TEMP,
real(rp), dimension (ka,ia,ja), intent(in)  PRES,
real(rp), dimension (ka,ia,ja), intent(in)  QV,
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,n_rad_dir,n_rad_rgn), intent(in)  albedo_sfc,
real(rp), dimension (ia,ja), intent(in)  solins,
real(rp), dimension (ia,ja), intent(in)  cosSZA,
real(rp), dimension (ka,ia,ja), intent(in)  CLDFRAC,
real(rp), dimension (ka,ia,ja,n_hyd), intent(in)  MP_Re,
real(rp), dimension (ka,ia,ja,n_hyd), intent(in)  MP_Qe,
real(rp), dimension (ka,ia,ja,n_ae), intent(in)  AE_Re,
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,n_rad_dir,n_rad_rgn), intent(out)  flux_rad_sfc_dn,
real(rp), dimension(ka,ia,ja), intent(out), optional  dtau_s,
real(rp), dimension (ka,ia,ja), intent(out), optional  dem_s 
)

Radiation main.

Definition at line 375 of file scale_atmos_phy_rd_mstrnx.F90.

References scale_atmos_grid_cartesc_real::atmos_grid_cartesc_real_basepoint_lat, 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_hydrometeor::hyd_dens, 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_cpl_sfc_index::i_r_diffuse, scale_cpl_sfc_index::i_r_direct, scale_cpl_sfc_index::i_r_ir, scale_cpl_sfc_index::i_r_nir, scale_cpl_sfc_index::i_r_vis, scale_atmos_phy_rd_common::i_sw, scale_atmos_phy_rd_common::i_up, scale_io::io_get_available_fid(), scale_atmos_aerosol::n_ae, scale_atmos_hydrometeor::n_hyd, scale_prc::prc_abort(), scale_prof::prof_rapend(), scale_prof::prof_rapstart(), and scale_time::time_nowdate.

Referenced by mod_atmos_phy_rd_driver::atmos_phy_rd_driver_calc_tendency().

375  !Jval )
376  use scale_const, only: &
377  eps => const_eps, &
378  mdry => const_mdry, &
379  mvap => const_mvap, &
380  ppm => const_ppm
381  use scale_time, only: &
383  use scale_atmos_grid_cartesc_real, only: &
385  use scale_atmos_hydrometeor, only: &
386  n_hyd, &
387  i_hc, &
388  i_hi, &
389  hyd_dens
390  use scale_atmos_aerosol, only: &
391  n_ae
392  use scale_atmos_phy_rd_profile, only: &
393  rd_profile_read => atmos_phy_rd_profile_read, &
394  rd_profile_use_climatology => atmos_phy_rd_profile_use_climatology
395  implicit none
396  integer, intent(in) :: ka, ks, ke
397  integer, intent(in) :: ia, is, ie
398  integer, intent(in) :: ja, js, je
399 
400  real(RP), intent(in) :: dens (ka,ia,ja)
401  real(RP), intent(in) :: temp (ka,ia,ja)
402  real(RP), intent(in) :: pres (ka,ia,ja)
403  real(RP), intent(in) :: qv (ka,ia,ja)
404  real(RP), intent(in) :: cz ( ka,ia,ja) ! UNUSED
405  real(RP), intent(in) :: fz (0:ka,ia,ja)
406  real(RP), intent(in) :: fact_ocean (ia,ja)
407  real(RP), intent(in) :: fact_land (ia,ja)
408  real(RP), intent(in) :: fact_urban (ia,ja)
409  real(RP), intent(in) :: temp_sfc (ia,ja)
410  real(RP), intent(in) :: albedo_sfc (ia,ja,n_rad_dir,n_rad_rgn)
411  real(RP), intent(in) :: solins (ia,ja)
412  real(RP), intent(in) :: cossza (ia,ja)
413  real(RP), intent(in) :: cldfrac (ka,ia,ja)
414  real(RP), intent(in) :: mp_re (ka,ia,ja,n_hyd)
415  real(RP), intent(in) :: mp_qe (ka,ia,ja,n_hyd)
416  real(RP), intent(in) :: ae_re (ka,ia,ja,n_ae)
417 ! real(RP), intent(in) :: AE_Qe (KA,IA,JA,N_AE)
418  real(RP), intent(out) :: flux_rad (ka,ia,ja,2,2,2)
419  real(RP), intent(out) :: flux_rad_top (ia,ja,2,2,2)
420  real(RP), intent(out) :: flux_rad_sfc_dn(ia,ja,n_rad_dir,n_rad_rgn)
421 
422  real(RP), intent(out), optional :: dtau_s(ka,ia,ja) ! 0.67 micron cloud optical depth
423  real(RP), intent(out), optional :: dem_s (ka,ia,ja) ! 10.5 micron cloud emissivity
424 ! real(RP), intent(out), optional :: Jval (KA,IA,JA,CH_QA_photo)
425 
426  integer :: tropopause(ia,ja)
427  real(RP) :: gamma
428 
429  real(RP), parameter :: min_cldfrac = 1.e-8_rp
430 
431  real(RP) :: rhodz_merge (rd_kmax,ia,ja)
432  real(RP) :: pres_merge (rd_kmax,ia,ja)
433  real(RP) :: temp_merge (rd_kmax,ia,ja)
434  real(RP) :: temph_merge (rd_kmax+1,ia,ja)
435 
436  real(RP) :: gas_merge (rd_kmax,ia,ja,mstrn_ngas)
437  real(RP) :: cfc_merge (rd_kmax,ia,ja,mstrn_ncfc)
438  real(RP) :: aerosol_conc_merge(rd_kmax,ia,ja,rd_naero )
439  real(RP) :: aerosol_radi_merge(rd_kmax,ia,ja,rd_naero )
440  real(RP) :: cldfrac_merge (rd_kmax,ia,ja)
441 
442  ! output
443  real(RP) :: flux_rad_merge(rd_kmax+1,ia,ja,2,2,mstrn_ncloud)
444  real(RP) :: taucld_067u (rd_kmax,ia,ja) ! 0.67 micron cloud optical depth
445  real(RP) :: emiscld_105u (rd_kmax,ia,ja) ! 10.5 micron cloud emissivity
446 
447  real(RP) :: zerosw
448 
449  integer :: ihydro, iaero
450  integer :: rd_k, k, i, j, v, ic
451  !---------------------------------------------------------------------------
452 
453  log_progress(*) 'atmosphere / physics / radiation / mstrnX'
454 
455  call prof_rapstart('RD_Profile', 3)
456 
457  if ( atmos_phy_rd_mstrn_only_tropocloud ) then
458  !$omp parallel do default(none) OMP_SCHEDULE_ collapse(2) &
459  !$omp private(k,i,j, &
460  !$omp gamma) &
461  !$omp shared (tropopause,pres,temp,CZ, &
462  !$omp KS,KE,IS,IE,JS,JE)
463  do j = js, je
464  do i = is, ie
465  tropopause(i,j) = ke+1
466  do k = ke, ks, -1
467  if ( pres(k,i,j) >= 300.e+2_rp ) then
468  exit
469  elseif( pres(k,i,j) < 50.e+2_rp ) then
470  tropopause(i,j) = k
471  else
472  gamma = ( temp(k+1,i,j) - temp(k,i,j) ) / ( cz(k+1,i,j) - cz(k,i,j) )
473  if( gamma > 1.e-4_rp ) tropopause(i,j) = k
474  endif
475  enddo
476  enddo
477  enddo
478  else
479  !$omp parallel do default(none) OMP_SCHEDULE_ collapse(2) &
480  !$omp private(i,j) &
481  !$omp shared (tropopause, &
482  !$omp KE,IS,IE,JS,JE)
483 !OCL XFILL
484  do j = js, je
485  do i = is, ie
486  tropopause(i,j) = ke+1
487  end do
488  end do
489  endif
490 
491  ! marge basic profile and value in model domain
492 
493  if ( rd_profile_use_climatology ) then
494  call rd_profile_read( rd_kmax, & ! [IN]
495  mstrn_ngas, & ! [IN]
496  mstrn_ncfc, & ! [IN]
497  rd_naero, & ! [IN]
499  time_nowdate(:), & ! [IN]
500  rd_zh(:), & ! [IN]
501  rd_z(:), & ! [IN]
502  rd_rhodz(:), & ! [OUT]
503  rd_pres(:), & ! [OUT]
504  rd_presh(:), & ! [OUT]
505  rd_temp(:), & ! [OUT]
506  rd_temph(:), & ! [OUT]
507  rd_gas(:,:), & ! [OUT]
508  rd_cfc(:,:), & ! [OUT]
509  rd_aerosol_conc(:,:), & ! [OUT]
510  rd_aerosol_radi(:,:), & ! [OUT]
511  rd_cldfrac(:) ) ! [OUT]
512  endif
513 
514 !OCL XFILL
515  !$omp parallel do default(none) &
516  !$omp shared(JS,JE,IS,IE,RD_KADD,temph_merge,RD_temph,KE,RD_KMAX,KS,temp,CZ,FZ) &
517  !$omp private(i,j,k,RD_k) OMP_SCHEDULE_ collapse(2)
518  do j = js, je
519  do i = is, ie
520  do rd_k = 1, rd_kadd
521  temph_merge(rd_k,i,j) = rd_temph(rd_k)
522  enddo
523 
524  temph_merge(rd_kadd+1,i,j) = temp(ke,i,j)
525  do rd_k = rd_kadd+2, rd_kmax
526  k = ks + rd_kmax - rd_k ! reverse axis
527 
528  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)) &
529  + temp(k+1,i,j) * (fz(k ,i,j)-cz(k,i,j)) / (cz(k+1,i,j)-cz(k,i,j)) )
530  enddo
531  temph_merge(rd_kmax+1,i,j) = temp(ks,i,j)
532  enddo
533  enddo
534 
535 !OCL XFILL
536  !$omp parallel do default(none) OMP_SCHEDULE_ collapse(2) &
537  !$omp private(k,i,j,RD_k) &
538  !$omp shared (RD_temp,dens,FZ,pres,temp, &
539  !$omp rhodz_merge,RD_rhodz,pres_merge,RD_pres,temp_merge, &
540  !$omp KS,JS,JE,IS,IE,RD_KMAX,RD_KADD)
541  do j = js, je
542  do i = is, ie
543  do rd_k = 1, rd_kadd
544  rhodz_merge(rd_k,i,j) = rd_rhodz(rd_k)
545  pres_merge(rd_k,i,j) = rd_pres(rd_k)
546  temp_merge(rd_k,i,j) = rd_temp(rd_k)
547  enddo
548 
549  do rd_k = rd_kadd+1, rd_kmax
550  k = ks + rd_kmax - rd_k ! reverse axis
551 
552  rhodz_merge(rd_k,i,j) = dens(k,i,j) * ( fz(k,i,j)-fz(k-1,i,j) ) ! [kg/m2]
553  pres_merge(rd_k,i,j) = pres(k,i,j) * 1.e-2_rp ! [hPa]
554  temp_merge(rd_k,i,j) = temp(k,i,j)
555  enddo
556  enddo
557  enddo
558 
559 !OCL XFILL
560 !OCL SERIAL
561  do v = 1, mstrn_ngas
562 !OCL PARALLEL
563  !$omp parallel do default(none) OMP_SCHEDULE_ collapse(2) &
564  !$omp private(i,j,RD_k) &
565  !$omp shared (gas_merge,RD_gas, &
566  !$omp IS,IE,JS,JE,RD_KMAX,v)
567  do j = js, je
568  do i = is, ie
569  do rd_k = 1, rd_kmax
570  gas_merge(rd_k,i,j,v) = rd_gas(rd_k,v)
571  enddo
572  enddo
573  enddo
574  enddo
575 
576  !$omp parallel do default(none) OMP_SCHEDULE_ collapse(2) &
577  !$omp private(k,i,j,RD_k, &
578  !$omp zerosw ) &
579  !$omp shared (gas_merge,QV,EPS,Mvap,Mdry, &
580  !$omp KS,IS,IE,JS,JE,RD_KADD,RD_KMAX)
581  do j = js, je
582  do i = is, ie
583  do rd_k = rd_kadd+1, rd_kmax
584  k = ks + rd_kmax - rd_k ! reverse axis
585  zerosw = sign(0.5_rp, qv(k,i,j)-eps) + 0.5_rp
586  gas_merge(rd_k,i,j,1) = qv(k,i,j) / mvap * mdry / ppm * zerosw ! [PPM]
587  enddo
588  enddo
589  enddo
590 
591 !OCL XFILL
592 !OCL SERIAL
593  do v = 1, mstrn_ncfc
594  !$omp parallel do default(none) OMP_SCHEDULE_ collapse(2) &
595  !$omp private(i,j,RD_k) &
596  !$omp shared (cfc_merge,RD_cfc, &
597  !$omp IS,IE,JS,JE,RD_KMAX,v)
598 !OCL PARALLEL
599  do j = js, je
600  do i = is, ie
601  do rd_k = 1, rd_kmax
602  cfc_merge(rd_k,i,j,v) = rd_cfc(rd_k,v)
603  enddo
604  enddo
605  enddo
606  enddo
607 
608  !$omp parallel do default(none) OMP_SCHEDULE_ collapse(2) &
609  !$omp private(k,i,j,RD_k) &
610  !$omp shared (cldfrac_merge,RD_cldfrac,cldfrac, &
611  !$omp KS,IS,IE,JS,JE,RD_KMAX,RD_KADD)
612  do j = js, je
613  do i = is, ie
614  do rd_k = 1, rd_kadd
615  cldfrac_merge(rd_k,i,j) = rd_cldfrac(rd_k)
616  enddo
617 
618  do rd_k = rd_kadd+1, rd_kmax
619  k = ks + rd_kmax - rd_k ! reverse axis
620 
621  cldfrac_merge(rd_k,i,j) = 0.5_rp + sign( 0.5_rp, cldfrac(k,i,j)-min_cldfrac )
622  enddo
623  enddo
624  enddo
625 
626 !OCL XFILL
627 !OCL SERIAL
628  do v = 1, rd_naero
629  !$omp parallel do default(none) OMP_SCHEDULE_ collapse(2) &
630  !$omp private(i,j,RD_k) &
631  !$omp shared (aerosol_conc_merge,RD_aerosol_conc,aerosol_radi_merge,RD_aerosol_radi, &
632  !$omp IS,IE,JS,JE,RD_KADD,v)
633 !OCL PARALLEL
634  do j = js, je
635  do i = is, ie
636  do rd_k = 1, rd_kadd
637  aerosol_conc_merge(rd_k,i,j,v) = rd_aerosol_conc(rd_k,v)
638  aerosol_radi_merge(rd_k,i,j,v) = rd_aerosol_radi(rd_k,v)
639  enddo
640  enddo
641  enddo
642  enddo
643 
644 !OCL SERIAL
645  do ihydro = 1, n_hyd
646  if ( atmos_phy_rd_mstrn_only_qci .and. &
647  ( ihydro /= i_hc .and. ihydro /= i_hi ) ) then
648 !OCL XFILL
649  aerosol_conc_merge(:,:,:,ihydro) = 0.0_rp
650  cycle
651  end if
652  !$omp parallel do default(none) OMP_SCHEDULE_ collapse(2) &
653  !$omp private(k,i,j,RD_k) &
654  !$omp shared (aerosol_conc_merge,tropopause,MP_Qe,HYD_DENS,RHO_std, &
655  !$omp KS,KE,IS,IE,JS,JE,RD_KMAX,RD_KADD,ihydro)
656 !OCL PARALLEL
657  do j = js, je
658  do i = is, ie
659  do rd_k = rd_kadd+1, rd_kadd+1 + ke - tropopause(i,j)
660  aerosol_conc_merge(rd_k,i,j,ihydro) = 0.0_rp
661  end do
662  do rd_k = rd_kadd+1 + ke - tropopause(i,j) + 1, rd_kmax
663  k = ks + rd_kmax - rd_k ! reverse axis
664  aerosol_conc_merge(rd_k,i,j,ihydro) = max( mp_qe(k,i,j,ihydro), 0.0_rp ) &
665  / hyd_dens(ihydro) * rho_std / ppm ! [PPM to standard air]
666  enddo
667  enddo
668  enddo
669  enddo
670 
671 !OCL SERIAL
672  do ihydro = 1, n_hyd
673  !$omp parallel do default(none) OMP_SCHEDULE_ collapse(2) &
674  !$omp private(k,i,j,RD_k) &
675  !$omp shared (aerosol_radi_merge,MP_Re, &
676  !$omp KS,IS,IE,JS,JE,RD_KMAX,RD_KADD,ihydro)
677 !OCL PARALLEL
678  do j = js, je
679  do i = is, ie
680  do rd_k = rd_kadd+1, rd_kmax
681  k = ks + rd_kmax - rd_k ! reverse axis
682  aerosol_radi_merge(rd_k,i,j,ihydro) = mp_re(k,i,j,ihydro)
683  enddo
684  enddo
685  enddo
686  enddo
687 
688 !OCL SERIAL
689  do iaero = 1, n_ae
690 
691 !!$ do j = JS, JE
692 !!$ do i = IS, IE
693 !!$ do RD_k = RD_KADD+1, RD_KMAX
694 !!$ k = KS + RD_KMAX - RD_k ! reverse axis
695 !!$
696 !!$ aerosol_conc_merge(RD_k,i,j,N_HYD+iaero) = max( AE_Qe(k,i,j,iaero), 0.0_RP ) &
697 !!$ / AE_DENS(iaero) * RHO_std / PPM ! [PPM to standard air]
698 !!$ aerosol_radi_merge(RD_k,i,j,N_HYD+iaero) = AE_Re(k,i,j,iaero)
699 !!$ enddo
700 !!$ enddo
701 !!$ enddo
702 
703  !$omp parallel do default(none) OMP_SCHEDULE_ collapse(2) &
704  !$omp private(i,j,RD_k) &
705  !$omp shared (aerosol_conc_merge,RD_aerosol_conc,aerosol_radi_merge,RD_aerosol_radi, &
706  !$omp IS,IE,JS,JE,RD_KMAX,RD_KADD,iaero)
707 !OCL PARALLEL
708  do j = js, je
709  do i = is, ie
710  do rd_k = rd_kadd+1, rd_kmax
711  aerosol_conc_merge(rd_k,i,j,n_hyd+iaero) = rd_aerosol_conc(rd_k,n_hyd+iaero)
712  aerosol_radi_merge(rd_k,i,j,n_hyd+iaero) = rd_aerosol_radi(rd_k,n_hyd+iaero)
713  enddo
714  enddo
715  enddo
716 
717  enddo
718 
719  call prof_rapend ('RD_Profile', 3)
720  call prof_rapstart('RD_MSTRN_DTRN3', 3)
721 
722  ! calc radiative transfer
723  call rd_mstrn_dtrn3( rd_kmax, ia, is, ie, ja, js, je, & ! [IN]
724  mstrn_ngas, mstrn_ncfc, rd_naero, & ! [IN]
725  rd_hydro_str, rd_hydro_end, rd_aero_str, rd_aero_end, & ! [IN]
726  solins(:,:), cossza(:,:), & ! [IN]
727  rhodz_merge(:,:,:), pres_merge(:,:,:), & ! [IN]
728  temp_merge(:,:,:), temph_merge(:,:,:), temp_sfc(:,:), & ! [IN]
729  gas_merge(:,:,:,:), cfc_merge(:,:,:,:), & ! [IN]
730  aerosol_conc_merge(:,:,:,:), aerosol_radi_merge(:,:,:,:), & ! [IN]
731  i_mpae2rd(:), & ! [IN]
732  cldfrac_merge(:,:,:), & ! [IN]
733  albedo_sfc(:,:,:,:), & ! [IN]
734  fact_ocean(:,:), fact_land(:,:), fact_urban(:,:), & ! [IN]
735  flux_rad_merge(:,:,:,:,:,:), flux_rad_sfc_dn(:,:,:,:), & ! [OUT]
736  taucld_067u(:,:,:), emiscld_105u(:,:,:) ) ! [OUT]
737 
738  call prof_rapend ('RD_MSTRN_DTRN3', 3)
739 
740  ! return to grid coordinate of model domain
741 !OCL SERIAL
742  do ic = 1, 2
743  !$omp parallel do default(none) OMP_SCHEDULE_ collapse(2) &
744  !$omp private(k,i,j,RD_k) &
745  !$omp shared (flux_rad,flux_rad_merge, &
746  !$omp KS,IS,IE,JS,JE,RD_KMAX,RD_KADD,ic)
747 !OCL PARALLEL
748  do j = js, je
749  do i = is, ie
750  do rd_k = rd_kadd+1, rd_kmax+1
751  k = ks + rd_kmax - rd_k ! reverse axis
752 
753  flux_rad(k,i,j,i_lw,i_up,ic) = flux_rad_merge(rd_k,i,j,i_lw,i_up,ic)
754  flux_rad(k,i,j,i_lw,i_dn,ic) = flux_rad_merge(rd_k,i,j,i_lw,i_dn,ic)
755  flux_rad(k,i,j,i_sw,i_up,ic) = flux_rad_merge(rd_k,i,j,i_sw,i_up,ic)
756  flux_rad(k,i,j,i_sw,i_dn,ic) = flux_rad_merge(rd_k,i,j,i_sw,i_dn,ic)
757  enddo
758  enddo
759  enddo
760  enddo
761 
762 !OCL XFILL
763 !OCL SERIAL
764  do ic = 1, 2
765  !$omp parallel do default(none) OMP_SCHEDULE_ collapse(2) &
766  !$omp private(i,j) &
767  !$omp shared (flux_rad_top,flux_rad_merge, &
768  !$omp IS,IE,JS,JE,ic)
769 !OCL PARALLEL
770  do j = js, je
771  do i = is, ie
772  flux_rad_top(i,j,i_lw,i_up,ic) = flux_rad_merge(1,i,j,i_lw,i_up,ic)
773  flux_rad_top(i,j,i_lw,i_dn,ic) = flux_rad_merge(1,i,j,i_lw,i_dn,ic)
774  flux_rad_top(i,j,i_sw,i_up,ic) = flux_rad_merge(1,i,j,i_sw,i_up,ic)
775  flux_rad_top(i,j,i_sw,i_dn,ic) = flux_rad_merge(1,i,j,i_sw,i_dn,ic)
776  enddo
777  enddo
778  enddo
779 
780  if ( present( dtau_s ) ) then
781  !$omp parallel do default(none) OMP_SCHEDULE_ collapse(2) &
782  !$omp private(k,i,j,RD_k) &
783  !$omp shared (dtau_s,tauCLD_067u, &
784  !$omp KS,IS,IE,JS,JE,RD_KMAX,RD_KADD)
785  do j = js, je
786  do i = is, ie
787  do rd_k = rd_kadd+1, rd_kmax
788  k = ks + rd_kmax - rd_k ! reverse axis
789  dtau_s(k,i,j) = taucld_067u(rd_k,i,j)
790  enddo
791  enddo
792  enddo
793  end if
794 
795  if ( present( dem_s ) ) then
796  !$omp parallel do default(none) OMP_SCHEDULE_ collapse(2) &
797  !$omp private(k,i,j,RD_k) &
798  !$omp shared (dem_s,emisCLD_105u, &
799  !$omp KS,IS,IE,JS,JE,RD_KMAX,RD_KADD)
800  do j = js, je
801  do i = is, ie
802  do rd_k = rd_kadd+1, rd_kmax
803  k = ks + rd_kmax - rd_k ! reverse axis
804  dem_s(k,i,j) = emiscld_105u(rd_k,i,j)
805  enddo
806  enddo
807  enddo
808  end if
809 
810  return
real(rp), parameter, public const_ppm
parts par million
Definition: scale_const.F90:91
integer, parameter, public n_ae
integer, public ia
of whole cells: x, local, with HALO
integer, parameter, public i_hi
ice water cloud
integer, public ja
of whole cells: y, local, with HALO
module atmosphere / physics/ radiation / profile
module atmosphere / aerosol
integer, parameter, public i_lw
integer, public is
start point of inner domain: x, local
integer, parameter, public i_sw
integer, public ie
end point of inner domain: x, local
real(rp), public const_mvap
mass weight (water vapor) [g/mol]
Definition: scale_const.F90:62
module atmosphere / hydrometeor
integer, parameter, public i_dn
integer, public ke
end point of inner domain: z, local
real(rp), public atmos_grid_cartesc_real_basepoint_lat
position of base point in real world [rad,-pi,pi]
integer, public je
end point of inner domain: y, local
module TIME
Definition: scale_time.F90:16
integer, public ks
start point of inner domain: z, local
module CONSTANT
Definition: scale_const.F90:11
integer, parameter, public i_hc
liquid water cloud
integer, public js
start point of inner domain: y, local
real(rp), public const_eps
small number
Definition: scale_const.F90:33
module Atmosphere GRID CartesC Real(real space)
subroutine, public atmos_phy_rd_profile_read(kmax, ngas, ncfc, naero, real_lat, now_date, zh, z, rhodz, pres, presh, temp, temph, gas, cfc, aerosol_conc, aerosol_radi, cldfrac)
Read profile for radiation.
real(rp), dimension(n_hyd), public hyd_dens
integer, public ka
of whole cells: z, local, with HALO
integer, dimension(6), public time_nowdate
current time [YYYY MM DD HH MM SS]
Definition: scale_time.F90:69
integer, parameter, public n_hyd
real(rp), public const_mdry
mass weight (dry air) [g/mol]
Definition: scale_const.F90:54
logical, public atmos_phy_rd_profile_use_climatology
use climatology?
integer, parameter, public i_up
Here is the call graph for this function:
Here is the caller graph for this function: