SCALE-RM
Functions/Subroutines | Variables
scale_atmos_phy_mp_suzuki10 Module Reference

module Spectran Bin Microphysics More...

Functions/Subroutines

subroutine, public atmos_phy_mp_suzuki10_config (MP_TYPE, QA, QS)
 Config. More...
 
subroutine, public atmos_phy_mp_suzuki10_setup
 Setup. More...
 
subroutine, public atmos_phy_mp_suzuki10 (DENS, MOMZ, MOMX, MOMY, RHOT, QTRC, CCN, EVAPORATE, SFLX_rain, SFLX_snow)
 Cloud Microphysics. More...
 
subroutine mp_suzuki10 (ijkmax, ijkmax_cold, ijkmax_warm, index_cold, index_warm, dens, pres, ccn, temp, qvap, ghyd, gaer, evaporate, dt)
 
subroutine r_collcoag (ijkmax, swgt, temp, gc, dtime)
 
subroutine, public atmos_phy_mp_suzuki10_cloudfraction (cldfrac, QTRC, mask_criterion)
 Calculate Cloud Fraction. More...
 
subroutine, public atmos_phy_mp_suzuki10_effectiveradius (Re, QTRC0, DENS0, TEMP0)
 Calculate Effective Radius. More...
 
subroutine, public atmos_phy_mp_suzuki10_mixingratio (Qe, QTRC0)
 Calculate mixing ratio of each category. More...
 
subroutine mkpara
 

Variables

character(len=h_short), dimension(:), allocatable, target, public atmos_phy_mp_suzuki10_name
 
character(len=h_mid), dimension(:), allocatable, target, public atmos_phy_mp_suzuki10_desc
 
character(len=h_short), dimension(:), allocatable, target, public atmos_phy_mp_suzuki10_unit
 
real(rp), dimension(n_hyd), target, public atmos_phy_mp_suzuki10_dens
 
integer, public nbin = 33
 
integer, public nspc = 7
 
integer, public nccn = 0
 
integer, public nccn1 = 0
 
integer, public kphase = 0
 
integer, public iceflg = 1
 

Detailed Description

module Spectran Bin Microphysics

Description:
This module contains subroutines for the Spectral Bin Model
Author
: Team SCALE
History: scale_atmos_phy_mp_suzuki10
  • ver.0.00 2012-06-14 (Y.Sato) [new] Import from version 4.1 of original code
  • ver.0.01 2012-09-14 (Y.Sato) [mod] add a stochastic method (Sato et al. 2009)
  • ver.0.02 2013-02-12 (Y.Sato) [mod] modified for latest version
  • ver.0.03 2013-12-26 (Y.Sato) [mod] mearge all version of Bin scheme
  • ver.0.04 2015-09-02 (Y.Sato) [mod] Tuning for K and FX10
  • ver.0.05 2015-09-08 (Y.Sato) [mod] Add evaporated cloud number concentration
  • ver.0.06 2016-01-22 (Y.Sato) [mod] Modify several bugs for using with MSTRNX
NAMELIST
  • PARAM_BIN
    nametypedefault valuecomment
    NBIN integer 33
    NCCN integer 0
    ICEFLG integer 1
    KPHASE integer 0

  • PARAM_ATMOS_PHY_MP
    nametypedefault valuecomment
    MP_DOPRECIPITATION logical .true. apply sedimentation of hydrometeor ?
    MP_DONEGATIVE_FIXER logical .true. apply negative fixer?
    MP_LIMIT_NEGATIVE real(RP) 1.0_RP Abort if abs(fixed negative vaue) > abs(MP_limit_negative)
    MP_NTMAX_SEDIMENTATION integer 1 maxinum fractional step
    MP_DOAUTOCONVERSION logical .true. apply collision process ?
    MP_COUPLE_AEROSOL logical .false. apply CCN effect?

  • PARAM_ATMOS_PHY_MP_SUZUKI10
    nametypedefault valuecomment
    RHO_AERO real(RP) — density of aerosol
    R_MIN real(RP) — minimum radius of aerosol (um)
    R_MAX real(RP) — maximum radius of aerosol (um)
    R0_AERO real(RP) — center radius of aerosol (um)
    S10_EMAER real(RP) — moleculer weight of aerosol
    S10_FLAG_REGENE logical — flag of regeneration
    S10_FLAG_NUCLEAT logical — flag of regeneration
    S10_FLAG_ICENUCLEAT logical — flag of regeneration
    S10_FLAG_SFAERO logical — flag of surface flux of aeorol
    S10_RNDM_FLGP integer — flag of surface flux of aeorol
    S10_RNDM_MSPC integer
    S10_RNDM_MBIN integer
    C_CCN real(RP) 100.E+6_RP N0 of Nc = N0*s^kappa
    KAPPA real(RP) 0.462_RP kappa of Nc = N0*s^kappa
    SIGMA real(RP) 7.5E-02_RP water surface tension N/m2
    VHFCT real(RP) 2.0_RP van't hoff factor (i in eq.(A.11) of Suzuki (2004))

History Output
namedescriptionunitvariable
QC Mixing ratio of QC kg/kg QHYD_out
QG Mixing ratio of QG kg/kg QHYD_out
QH Mixing ratio of QH kg/kg QHYD_out
QI Mixing ratio of QI kg/kg QHYD_out
QR Mixing ratio of QR kg/kg QHYD_out
QS Mixing ratio of QS kg/kg QHYD_out

Function/Subroutine Documentation

◆ atmos_phy_mp_suzuki10_config()

subroutine, public scale_atmos_phy_mp_suzuki10::atmos_phy_mp_suzuki10_config ( character(len=*), intent(in)  MP_TYPE,
integer, intent(out)  QA,
integer, intent(out)  QS 
)

Config.

Definition at line 281 of file scale_atmos_phy_mp_suzuki10.F90.

References scale_atmos_hydrometeor::atmos_hydrometeor_regist(), atmos_phy_mp_suzuki10_desc, atmos_phy_mp_suzuki10_name, atmos_phy_mp_suzuki10_unit, iceflg, scale_stdio::io_fid_conf, scale_stdio::io_fid_log, scale_stdio::io_fid_nml, scale_stdio::io_l, scale_stdio::io_nml, kphase, nbin, nccn, nccn1, nspc, scale_process::prc_mpistop(), and scale_tracer::tracer_regist().

Referenced by scale_atmos_phy_mp::atmos_phy_mp_config().

281  use scale_process, only: &
282  prc_mpistop
283  use scale_tracer, only: &
284  tracer_regist
285  use scale_atmos_hydrometeor, only: &
286  atmos_hydrometeor_regist
287  implicit none
288 
289  character(len=*), intent(in) :: MP_TYPE
290  integer, intent(out) :: QA
291  integer, intent(out) :: QS
292 
293  namelist / param_bin / &
294  nbin, &
295  nccn, &
296  iceflg, &
297  kphase
298 
299  integer :: NL, NI
300  integer :: QS2
301  integer :: m, n, ierr
302  !---------------------------------------------------------------------------
303 
304  if( io_l ) write(io_fid_log,*)
305  if( io_l ) write(io_fid_log,*) '++++++ Module[Cloud Microphysics Tracer] / Categ[ATMOS PHYSICS] / Origin[SCALElib]'
306  if( io_l ) write(io_fid_log,*) '*** Tracers for Suzuki (2010) Spectral BIN model'
307 
308  if ( mp_type /= 'SUZUKI10' ) then
309  write(*,*) 'xxx ATMOS_PHY_MP_TYPE is not SUZUKI10. Check!'
310  call prc_mpistop
311  endif
312 
313 
314  if( io_l ) write(io_fid_log,*)
315  if( io_l ) write(io_fid_log,*) '+++ READ BIN NUMBER'
316 
317  rewind(io_fid_conf)
318  read(io_fid_conf,nml=param_bin,iostat=ierr)
319 
320  if( ierr < 0 ) then !--- missing
321  if( io_l ) write(io_fid_log,*) '*** Not found namelist. Default used.'
322  elseif( ierr > 0 ) then !--- fatal error
323  write(*,*) 'xxx Not appropriate names in namelist PARAM_BIN, Check!'
324  call prc_mpistop
325  end if
326 
327  if( io_nml ) write(io_fid_nml,nml=param_bin)
328 
329  if( iceflg == 0 ) then
330  nspc = 1
331  elseif( iceflg == 1 ) then
332  nspc = 7
333  else
334  write(*,*) "ICEFLG should be 0(warm rain) or 1(mixed rain) check!!"
335  call prc_mpistop
336  endif
337 
338  nccn1 = max(nccn,1)
339 
340  !-- setup QA_MP ...
341  qa_mp = 1 + nbin*nspc + nccn
342 
343  allocate( atmos_phy_mp_suzuki10_name(qa_mp) )
344  allocate( atmos_phy_mp_suzuki10_desc(qa_mp) )
345  allocate( atmos_phy_mp_suzuki10_unit(qa_mp) )
346 
347  !---------------------------------------------------------------------------
348  !
349  !++ calculate each category and aerosol
350  !
351  !---------------------------------------------------------------------------
352  do n = 1, qa_mp
353  write(atmos_phy_mp_suzuki10_unit(n),'(a)') 'kg/kg'
354  enddo
355 
356  write(atmos_phy_mp_suzuki10_name(1),'(a)') 'QV'
357 
358  do m = 1, nspc
359  do n = 1, nbin
360  write(atmos_phy_mp_suzuki10_name(1+nbin*(m-1)+n),'(a,i0)') trim(namspc(m)), n
361  enddo
362  enddo
363 
364  do n = 1, nccn
365  write(atmos_phy_mp_suzuki10_name(1+nbin*nspc+n),'(a,i0)') trim(namspc(8)), n
366  enddo
367 
368  write(atmos_phy_mp_suzuki10_desc(1),'(a)') 'Water Vapor mixing ratio'
369 
370  do m = 1, nspc
371  do n = 1, nbin
372  write(atmos_phy_mp_suzuki10_desc(1+nbin*(m-1)+n),'(a,i0)') trim(lnamspc(m)), n
373  enddo
374  enddo
375 
376  do n = 1, nccn
377  write(atmos_phy_mp_suzuki10_desc(1+nbin*nspc+n),'(a,i0)') trim(lnamspc(8)), n
378  enddo
379 
380  nl = nbin ! number of liquid water
381  ni = nbin * (nspc-1) ! number of ice water
382 
383  call atmos_hydrometeor_regist( qs, & ! [OUT]
384  1, nl, ni, & ! [IN]
385  atmos_phy_mp_suzuki10_name(1:nl+ni+1), & ! [IN]
386  atmos_phy_mp_suzuki10_desc(1:nl+ni+1), & ! [IN]
387  atmos_phy_mp_suzuki10_unit(1:nl+ni+1) ) ! [IN]
388 
389  if ( nccn > 0 ) then
390  call tracer_regist( qs2, & ! [OUT]
391  nccn, & ! [IN]
392  atmos_phy_mp_suzuki10_name(nl+ni+2:), & ! [IN]
393  atmos_phy_mp_suzuki10_desc(nl+ni+2:), & ! [IN]
394  atmos_phy_mp_suzuki10_unit(nl+ni+2:) ) ! [IN]
395  end if
396 
397  i_qv = qs
398  qa = qa_mp
399  qs_mp = qs
400  qe_mp = qs + qa_mp - 1
401 
402  return
scale_process::prc_mpistop
subroutine, public prc_mpistop
Abort MPI.
Definition: scale_process.F90:267
scale_atmos_phy_mp_suzuki10::atmos_phy_mp_suzuki10_unit
character(len=h_short), dimension(:), allocatable, target, public atmos_phy_mp_suzuki10_unit
Definition: scale_atmos_phy_mp_suzuki10.F90:105
scale_tracer
module TRACER
Definition: scale_tracer.F90:15
scale_atmos_hydrometeor
module Hydrometeor
Definition: scale_atmos_sub_hydrometeor.F90:14
scale_atmos_phy_mp_suzuki10::atmos_phy_mp_suzuki10_name
character(len=h_short), dimension(:), allocatable, target, public atmos_phy_mp_suzuki10_name
Definition: scale_atmos_phy_mp_suzuki10.F90:103
scale_process
module PROCESS
Definition: scale_process.F90:14
scale_atmos_hydrometeor::atmos_hydrometeor_regist
subroutine, public atmos_hydrometeor_regist(Q0, NV, NL, NI, NAME, DESC, UNIT, ADVC)
Regist tracer.
Definition: scale_atmos_sub_hydrometeor.F90:196
scale_atmos_phy_mp_suzuki10::atmos_phy_mp_suzuki10_desc
character(len=h_mid), dimension(:), allocatable, target, public atmos_phy_mp_suzuki10_desc
Definition: scale_atmos_phy_mp_suzuki10.F90:104
scale_tracer::tracer_regist
subroutine, public tracer_regist(QS, NQ, NAME, DESC, UNIT, CV, CP, R, ADVC, MASS)
Regist tracer.
Definition: scale_tracer.F90:64
Here is the call graph for this function:
Here is the caller graph for this function:

◆ atmos_phy_mp_suzuki10_setup()

subroutine, public scale_atmos_phy_mp_suzuki10::atmos_phy_mp_suzuki10_setup ( )

Setup.

Definition at line 408 of file scale_atmos_phy_mp_suzuki10.F90.

References atmos_phy_mp_suzuki10_dens, scale_comm::comm_datatype, scale_comm::comm_world, scale_const::const_dice, scale_const::const_dwatr, scale_grid::grid_cdz, scale_grid::grid_cz, scale_atmos_hydrometeor::i_hc, scale_atmos_hydrometeor::i_hg, scale_atmos_hydrometeor::i_hh, scale_atmos_hydrometeor::i_hi, scale_atmos_hydrometeor::i_hr, scale_atmos_hydrometeor::i_hs, scale_grid_index::ia, scale_stdio::io_fid_conf, scale_stdio::io_fid_log, scale_stdio::io_fid_nml, scale_stdio::io_get_available_fid(), scale_stdio::io_l, scale_stdio::io_nml, scale_grid_index::ja, scale_grid_index::ka, mkpara(), nbin, nccn, nspc, scale_process::prc_ismaster, scale_process::prc_masterrank, scale_process::prc_mpistop(), scale_tracer::qa, and scale_time::time_dtsec_atmos_phy_mp.

Referenced by scale_atmos_phy_mp::atmos_phy_mp_config().

408  use scale_process, only: &
409  prc_mpistop, &
410  prc_masterrank, &
411  prc_ismaster
412  use scale_const, only: &
413  const_dwatr, &
414  const_dice
415  use scale_comm, only: &
416  comm_world, &
417  comm_datatype
418  use scale_grid, only: &
419  cdz => grid_cdz, &
420  cz => grid_cz
421  use scale_time, only: &
422  time_dtsec_atmos_phy_mp
423  use scale_tracer, only: &
424  qa
425  use scale_atmos_hydrometeor, only: &
426  i_hc, &
427  i_hr, &
428  i_hi, &
429  i_hs, &
430  i_hg, &
431  i_hh
432  implicit none
433 
434  real(RP) :: RHO_AERO !--- density of aerosol
435  real(RP) :: R0_AERO !--- center radius of aerosol (um)
436  real(RP) :: R_MIN !--- minimum radius of aerosol (um)
437  real(RP) :: R_MAX !--- maximum radius of aerosol (um)
438  real(RP) :: S10_EMAER !--- moleculer weight of aerosol
439  logical :: S10_FLAG_REGENE !--- flag of regeneration
440  logical :: S10_FLAG_NUCLEAT !--- flag of regeneration
441  logical :: S10_FLAG_ICENUCLEAT !--- flag of regeneration
442  logical :: S10_FLAG_SFAERO !--- flag of surface flux of aeorol
443  integer :: S10_RNDM_FLGP !--- flag of surface flux of aeorol
444  integer :: S10_RNDM_MSPC
445  integer :: S10_RNDM_MBIN
446 
447  namelist / param_atmos_phy_mp / &
448  mp_doprecipitation, &
449  mp_donegative_fixer, &
450  mp_limit_negative, &
451  mp_ntmax_sedimentation, &
452  mp_doautoconversion, &
453  mp_couple_aerosol
454 
455  namelist / param_atmos_phy_mp_suzuki10 / &
456  rho_aero, &
457  r_min, &
458  r_max, &
459  r0_aero, &
460  s10_emaer, &
461  s10_flag_regene, &
462  s10_flag_nucleat, &
463  s10_flag_icenucleat, &
464  s10_flag_sfaero, &
465  s10_rndm_flgp, &
466  s10_rndm_mspc, &
467  s10_rndm_mbin, &
468  c_ccn, kappa, &
469  sigma, vhfct
470 
471  real(RP), parameter :: max_term_vel = 10.0_rp !-- terminal velocity for calculate dt of sedimentation
472  integer :: nstep_max
473  integer :: nnspc, nnbin
474  integer :: nn, mm, mmyu, nnyu
475  integer :: myu, nyu, i, j, k, n, ierr
476  !---------------------------------------------------------------------------
477 
478  if( io_l ) write(io_fid_log,*)
479  if( io_l ) write(io_fid_log,*) '++++++ Module[Cloud Microphysics] / Categ[ATMOS PHYSICS] / Origin[SCALElib]'
480  if( io_l ) write(io_fid_log,*) '*** Suzuki (2010) Spectral BIN model'
481 
482  !--- allocation
483  allocate( xctr( nbin ) )
484  allocate( xbnd( nbin+1 ) )
485  allocate( radc( nbin ) )
486  allocate( cctr( nbin,nspc_mk ) )
487  allocate( cbnd( nbin+1,nspc_mk ) )
488  allocate( ck( nspc_mk,nspc_mk,nbin,nbin ) )
489  allocate( vt( nspc_mk,nbin ) )
490  allocate( br( nspc_mk,nbin ) )
491  allocate( ifrsl( 2,nspc_mk,nspc_mk ) )
492  allocate( expxctr( nbin ) )
493  allocate( expxbnd( nbin+1 ) )
494  allocate( rexpxctr( nbin ) )
495  allocate( rexpxbnd( nbin+1 ) )
496  if ( nccn /= 0 ) then
497  allocate( xactr( nccn ) )
498  allocate( xabnd( nccn+1 ) )
499  allocate( rada( nccn ) )
500  allocate( expxactr( nccn ) )
501  allocate( expxabnd( nccn+1 ) )
502  allocate( rexpxactr( nccn ) )
503  allocate( rexpxabnd( nccn+1 ) )
504  endif
505 
506  mbin = nbin/2
507  mspc = nspc_mk*nspc_mk
508 
509  rho_aero = rhoa
510  s10_emaer = emaer
511  r_min = rasta
512  r_max = raend
513  r0_aero = r0a
514  s10_flag_regene = flg_regeneration
515  s10_flag_nucleat = flg_nucl
516  s10_flag_icenucleat = flg_icenucl
517  s10_flag_sfaero = flg_sf_aero
518  s10_rndm_flgp = rndm_flgp
519  s10_rndm_mspc = mspc
520  s10_rndm_mbin = mbin
521 
522  rewind(io_fid_conf)
523  read(io_fid_conf,nml=param_atmos_phy_mp,iostat=ierr)
524 
525  if ( ierr < 0 ) then !--- missing
526  if( io_l ) write(io_fid_log,*) '*** Not found namelist. Default used.'
527  elseif( ierr > 0 ) then !--- fatal error
528  write(*,*) 'xxx Not appropriate names in namelist PARAM_ATMOS_PHY_MP, Check!'
529  call prc_mpistop
530  endif
531  if( io_nml ) write(io_fid_nml,nml=param_atmos_phy_mp)
532 
533  rewind(io_fid_conf)
534  read(io_fid_conf,nml=param_atmos_phy_mp_suzuki10,iostat=ierr)
535 
536  if ( ierr < 0 ) then !--- missing
537  if( io_l ) write(io_fid_log,*) '*** Not found namelist. Default used.'
538  elseif( ierr > 0 ) then !--- fatal error
539  write(*,*) 'xxx Not appropriate names in namelist PARAM_ATMOS_PHY_MP_SUZUKI10, Check!'
540  call prc_mpistop
541  endif
542  if( io_nml ) write(io_fid_nml,nml=param_atmos_phy_mp_suzuki10)
543 
544  if ( nspc /= 1 .AND. nspc /= 7 ) then
545  write(*,*) 'xxx nspc should be set as 1(warm rain) or 7(mixed phase) check!'
546  call prc_mpistop
547  endif
548 
549  rhoa = rho_aero
550  emaer = s10_emaer
551  rasta = r_min
552  raend = r_max
553  r0a = r0_aero
554  flg_regeneration = s10_flag_regene
555  flg_nucl = s10_flag_nucleat
556  flg_icenucl = s10_flag_icenucleat
557  flg_sf_aero = s10_flag_sfaero
558  rndm_flgp = s10_rndm_flgp
559  mspc = s10_rndm_mspc
560  mbin = s10_rndm_mbin
561 
562  !--- read micpara.dat (microphysical parameter) and broad cast
563  if ( prc_ismaster ) then
564 
565  fid_micpara = io_get_available_fid()
566  !--- open parameter of cloud microphysics
567  open ( fid_micpara, file = fname_micpara, form = 'formatted', status = 'old', iostat=ierr )
568 
569  !--- micpara.dat does not exist
570  if ( ierr == 0 ) then
571 
572  read( fid_micpara,* ) nnspc, nnbin
573 
574  if ( nnbin /= nbin ) then
575  write(*,*) 'xxx nbin in inc_tracer and nbin in micpara.dat is different check!'
576  call prc_mpistop
577  endif
578 
579  ! grid parameter
580  if( io_l ) write(io_fid_log,*) '*** Radius of cloud ****'
581  do n = 1, nbin
582  read( fid_micpara,* ) nn, xctr( n ), radc( n )
583  if( io_l ) write(io_fid_log,'(A,1x,I3,1x,A,1x,ES15.7,1x,A)') &
584  "Radius of ", n, "th cloud bin (bin center)= ", radc( n ) , "[m]"
585  enddo
586  do n = 1, nbin+1
587  read( fid_micpara,* ) nn, xbnd( n )
588  enddo
589  read( fid_micpara,* ) dxmic
590  if( io_l ) write(io_fid_log,*) '*** Width of Cloud SDF= ', dxmic
591 
592  ! capacity
593  do myu = 1, nspc_mk
594  do n = 1, nbin
595 ! read( fid_micpara,* ) mmyu, nn, cctr( myu,n )
596  read( fid_micpara,* ) mmyu, nn, cctr( n,myu )
597  enddo
598  do n = 1, nbin+1
599 ! read( fid_micpara,* ) mmyu, nn, cbnd( myu,n )
600  read( fid_micpara,* ) mmyu, nn, cbnd( n,myu )
601  enddo
602  enddo
603 
604  ! collection kernel
605  do myu = 1, nspc_mk
606  do nyu = 1, nspc_mk
607  do i = 1, nbin
608  do j = 1, nbin
609  read( fid_micpara,* ) mmyu, nnyu, mm, nn, ck( myu,nyu,i,j )
610  enddo
611  enddo
612  enddo
613  enddo
614 
615  ! terminal velocity
616  do myu = 1, nspc_mk
617  do n = 1, nbin
618  read( fid_micpara,* ) mmyu, nn, vt( myu,n )
619  enddo
620  enddo
621 
622  ! bulk density
623  do myu = 1, nspc_mk
624  do n = 1, nbin
625  read( fid_micpara,* ) mmyu, nn, br( myu,n )
626  enddo
627  enddo
628 
629  close ( fid_micpara )
630 
631  !--- micpara.dat does not exist
632  else
633 
634  if( io_l ) write(io_fid_log,*) 'micpara.dat is created'
635  call mkpara
636 
637  fid_micpara = io_get_available_fid()
638  !--- open parameter of cloud microphysics
639  open ( fid_micpara, file = fname_micpara, form = 'formatted', status = 'old', iostat=ierr )
640 
641  read( fid_micpara,* ) nnspc, nnbin
642 
643  if ( nnbin /= nbin ) then
644  write(*,*) 'xxx nbin in inc_tracer and nbin in micpara.dat is different check!'
645  call prc_mpistop
646  endif
647 
648  ! grid parameter
649  if( io_l ) write(io_fid_log,*) '*** Radius of cloud ****'
650  do n = 1, nbin
651  read( fid_micpara,* ) nn, xctr( n ), radc( n )
652  if( io_l ) write(io_fid_log,'(A,1x,I3,1x,A,1x,ES15.7,1x,A)') &
653  "Radius of ", n, "th cloud bin (bin center)= ", radc( n ) , "[m]"
654  enddo
655  do n = 1, nbin+1
656  read( fid_micpara,* ) nn, xbnd( n )
657  enddo
658  read( fid_micpara,* ) dxmic
659  if( io_l ) write(io_fid_log,*) '*** Width of Cloud SDF= ', dxmic
660 
661  ! capacity
662  do myu = 1, nspc_mk
663  do n = 1, nbin
664 ! read( fid_micpara,* ) mmyu, nn, cctr( myu,n )
665  read( fid_micpara,* ) mmyu, nn, cctr( n,myu )
666  enddo
667  do n = 1, nbin+1
668 ! read( fid_micpara,* ) mmyu, nn, cbnd( myu,n )
669  read( fid_micpara,* ) mmyu, nn, cbnd( n,myu )
670  enddo
671  enddo
672 
673  ! collection kernel
674  do myu = 1, nspc_mk
675  do nyu = 1, nspc_mk
676  do i = 1, nbin
677  do j = 1, nbin
678  read( fid_micpara,* ) mmyu, nnyu, mm, nn, ck( myu,nyu,i,j )
679  enddo
680  enddo
681  enddo
682  enddo
683 
684  ! terminal velocity
685  do myu = 1, nspc_mk
686  do n = 1, nbin
687  read( fid_micpara,* ) mmyu, nn, vt( myu,n )
688  enddo
689  enddo
690 
691  ! bulk density
692  do myu = 1, nspc_mk
693  do n = 1, nbin
694  read( fid_micpara,* ) mmyu, nn, br( myu,n )
695  enddo
696  enddo
697 
698  close ( fid_micpara )
699 
700  endif
701 
702  endif
703 
704  call mpi_bcast( radc, nbin, comm_datatype, prc_masterrank, comm_world, ierr )
705  call mpi_bcast( xctr, nbin, comm_datatype, prc_masterrank, comm_world, ierr )
706  call mpi_bcast( dxmic,1, comm_datatype, prc_masterrank, comm_world, ierr )
707  call mpi_bcast( xbnd, nbin+1, comm_datatype, prc_masterrank, comm_world, ierr )
708  call mpi_bcast( cctr, nbin*nspc_mk, comm_datatype, prc_masterrank, comm_world, ierr )
709  call mpi_bcast( cbnd, (nbin+1)*nspc_mk, comm_datatype, prc_masterrank, comm_world, ierr )
710  call mpi_bcast( ck, nspc_mk*nspc_mk*nbin*nbin, comm_datatype, prc_masterrank, comm_world, ierr )
711  call mpi_bcast( br, nbin*nspc_mk, comm_datatype, prc_masterrank, comm_world, ierr )
712  call mpi_bcast( vt, nbin*nspc_mk, comm_datatype, prc_masterrank, comm_world, ierr )
713 
714  !--- aerosol ( CCN ) (not supported)
715  if ( nccn /= 0 ) then
716 
717  allocate ( ncld( 1:nccn ) )
718  xasta = log( rhoa*4.0_rp/3.0_rp*pi * ( rasta )**3 )
719  xaend = log( rhoa*4.0_rp/3.0_rp*pi * ( raend )**3 )
720 
721  dxaer = ( xaend-xasta )/nccn
722 
723  do n = 1, nccn+1
724  xabnd( n ) = xasta + dxaer*( n-1 )
725  enddo
726  do n = 1, nccn
727  xactr( n ) = ( xabnd( n )+xabnd( n+1 ) )*0.50_rp
728  rada( n ) = ( exp( xactr( n ) )*thirdovforth/pi/rhoa )**( oneovthird )
729  if( io_l ) write(io_fid_log,'(A,1x,I3,1x,A,1x,ES15.7,1x,A)') &
730  "Radius of ", n, "th aerosol bin (bin center)= ", rada( n ) , "[m]"
731  enddo
732 
733  if ( flg_sf_aero ) then
734  write(*,*) "flg_sf_aero=true is not supported stop!! "
735  call prc_mpistop
736 ! if ( CZ(KS) >= 10.0_RP ) then
737 ! R10M1 = 10.0_RP / CZ(KS) * 0.50_RP ! scale with height
738 ! R10M2 = 10.0_RP / CZ(KS) * 0.50_RP ! scale with height
739 ! R10H1 = 1.0_RP * 0.50_RP
740 ! R10H2 = 1.0_RP * 0.0_RP
741 ! R10E1 = 1.0_RP * 0.50_RP
742 ! R10E2 = 1.0_RP * 0.50_RP
743 ! K10_1 = KS
744 ! K10_2 = KS
745 ! else
746 ! k = 1
747 ! do while ( CZ(k) < 10.0_RP )
748 ! k = k + 1
749 ! K10_1 = k
750 ! K10_2 = k + 1
751 ! R10M1 = ( CZ(k+1) - 10.0_RP ) / CDZ(k)
752 ! R10M2 = ( 10.0_RP - CZ(k) ) / CDZ(k)
753 ! R10H1 = ( CZ(k+1) - 10.0_RP ) / CDZ(k)
754 ! R10H2 = ( 10.0_RP - CZ(k) ) / CDZ(k)
755 ! R10E1 = ( CZ(k+1) - 10.0_RP ) / CDZ(k)
756 ! R10E2 = ( 10.0_RP - CZ(k) ) / CDZ(k)
757 ! enddo
758 ! endif
759  endif
760 
761  endif
762 
763  atmos_phy_mp_suzuki10_dens(i_hc) = const_dwatr
764  atmos_phy_mp_suzuki10_dens(i_hr) = const_dice
765  atmos_phy_mp_suzuki10_dens(i_hi) = const_dice
766  atmos_phy_mp_suzuki10_dens(i_hs) = const_dice
767  atmos_phy_mp_suzuki10_dens(i_hg) = const_dice
768  atmos_phy_mp_suzuki10_dens(i_hh) = const_dice
769 
770  !--- determine nbnd
771  do n = 1, nbin
772  if( radc( n ) > rbnd ) then
773  nbnd = n
774  exit
775  endif
776  enddo
777  if( io_l ) write(io_fid_log,'(A,ES15.7,A)') '*** Radius between cloud and rain is ', radc(nbnd), '[m]'
778 
779  !--- random number setup for stochastic method
780  if ( rndm_flgp > 0 ) then
781  call random_setup( ia*ja*ka )
782  endif
783 
784  if ( mp_couple_aerosol .AND. nccn /=0 ) then
785  write(*,*) 'xxx nccn should be 0 when MP_couple_aerosol = .true. !! stop'
786  call prc_mpistop
787  endif
788 
789  if ( nccn /= 0 ) then
790  do n = 1, nccn
791  expxactr( n ) = exp( xactr( n ) )
792  rexpxactr( n ) = 1.0_rp / exp( xactr( n ) )
793  enddo
794  do n = 1, nccn+1
795  expxabnd( n ) = exp( xabnd( n ) )
796  rexpxabnd( n ) = 1.0_rp / exp( xabnd( n ) )
797  enddo
798  endif
799 
800  allocate( vterm(ka,ia,ja,qa_mp-1) )
801  vterm(:,:,:,:) = 0.0_rp
802  do myu = 1, nspc
803  do n = 1, nbin
804  vterm(:,:,:,(myu-1)*nbin+n) = -vt( myu,n )
805  enddo
806  enddo
807  do n = 1, nbin
808  expxctr( n ) = exp( xctr( n ) )
809  rexpxctr( n ) = 1.0_rp / exp( xctr( n ) )
810  enddo
811  do n = 1, nbin+1
812  expxbnd( n ) = exp( xbnd( n ) )
813  rexpxbnd( n ) = 1.0_rp / exp( xbnd( n ) )
814  enddo
815 
816  allocate( kindx(nbin,nbin) )
817  call getrule( ifrsl,kindx )
818 
819  if ( const_thermodyn_type == 'EXACT' ) then
820  flg_thermodyn = 1.0_rp
821  elseif( const_thermodyn_type == 'SIMPLE' ) then
822  flg_thermodyn = 0.0_rp
823  endif
824  rtem00 = 1.0_rp / const_tem00
825 
826  nstep_max = int( ( time_dtsec_atmos_phy_mp * max_term_vel ) / minval( cdz ) )
827  mp_ntmax_sedimentation = max( mp_ntmax_sedimentation, nstep_max )
828 
829  mp_nstep_sedimentation = mp_ntmax_sedimentation
830  mp_rnstep_sedimentation = 1.0_rp / real(MP_ntmax_sedimentation,kind=rp)
831  mp_dtsec_sedimentation = time_dtsec_atmos_phy_mp * mp_rnstep_sedimentation
832 
833  if( io_l ) write(io_fid_log,*)
834  if( io_l ) write(io_fid_log,*) '*** Timestep of sedimentation is divided into : ', mp_ntmax_sedimentation, ' step'
835  if( io_l ) write(io_fid_log,*) '*** DT of sedimentation is : ', mp_dtsec_sedimentation, '[s]'
836 
837  return
838 
scale_comm::comm_datatype
integer, public comm_datatype
datatype of variable
Definition: scale_comm.F90:117
scale_process::prc_ismaster
logical, public prc_ismaster
master process in local communicator?
Definition: scale_process.F90:80
scale_process::prc_mpistop
subroutine, public prc_mpistop
Abort MPI.
Definition: scale_process.F90:267
scale_const::const_dwatr
real(rp), parameter, public const_dwatr
density of water [kg/m3]
Definition: scale_const.F90:84
scale_time::time_dtsec_atmos_phy_mp
real(dp), public time_dtsec_atmos_phy_mp
time interval of physics(microphysics) [sec]
Definition: scale_time.F90:41
scale_grid::grid_cz
real(rp), dimension(:), allocatable, public grid_cz
center coordinate [m]: z, local=global
Definition: scale_grid_cartesian.F90:56
scale_random::random_setup
subroutine, public random_setup
Setup.
Definition: scale_random.F90:53
scale_const::const_dice
real(rp), parameter, public const_dice
density of ice [kg/m3]
Definition: scale_const.F90:85
scale_tracer
module TRACER
Definition: scale_tracer.F90:15
scale_atmos_hydrometeor
module Hydrometeor
Definition: scale_atmos_sub_hydrometeor.F90:14
scale_comm::comm_world
integer, public comm_world
communication world ID
Definition: scale_comm.F90:118
scale_comm
module COMMUNICATION
Definition: scale_comm.F90:23
scale_time
module TIME
Definition: scale_time.F90:15
scale_atmos_phy_mp_suzuki10::atmos_phy_mp_suzuki10_dens
real(rp), dimension(n_hyd), target, public atmos_phy_mp_suzuki10_dens
Definition: scale_atmos_phy_mp_suzuki10.F90:107
scale_process
module PROCESS
Definition: scale_process.F90:14
scale_const
module CONSTANT
Definition: scale_const.F90:14
scale_process::prc_masterrank
integer, parameter, public prc_masterrank
master process in each communicator
Definition: scale_process.F90:57
scale_grid
module GRID (cartesian)
Definition: scale_grid_cartesian.F90:17
scale_grid::grid_cdz
real(rp), dimension(:), allocatable, public grid_cdz
z-length of control volume [m]
Definition: scale_grid_cartesian.F90:59
Here is the call graph for this function:
Here is the caller graph for this function:

◆ atmos_phy_mp_suzuki10()

subroutine, public scale_atmos_phy_mp_suzuki10::atmos_phy_mp_suzuki10 ( real(rp), dimension (ka,ia,ja), intent(inout)  DENS,
real(rp), dimension (ka,ia,ja), intent(inout)  MOMZ,
real(rp), dimension (ka,ia,ja), intent(inout)  MOMX,
real(rp), dimension (ka,ia,ja), intent(inout)  MOMY,
real(rp), dimension (ka,ia,ja), intent(inout)  RHOT,
real(rp), dimension (ka,ia,ja,qa), intent(inout)  QTRC,
real(rp), dimension (ka,ia,ja), intent(in)  CCN,
real(rp), dimension(ka,ia,ja), intent(out)  EVAPORATE,
real(rp), dimension(ia,ja), intent(out)  SFLX_rain,
real(rp), dimension(ia,ja), intent(out)  SFLX_snow 
)

Cloud Microphysics.

Definition at line 854 of file scale_atmos_phy_mp_suzuki10.F90.

References scale_atmos_phy_mp_common::atmos_phy_mp_negative_fixer(), scale_atmos_phy_mp_common::atmos_phy_mp_precipitation(), scale_const::const_tem00, scale_grid_index::ie, scale_stdio::io_fid_log, scale_stdio::io_l, scale_grid_index::is, scale_grid_index::je, scale_grid_index::js, scale_grid_index::ke, scale_grid_index::ks, mp_suzuki10(), nbin, nccn, nspc, scale_prof::prof_rapend(), scale_prof::prof_rapstart(), scale_tracer::qa, scale_time::time_dtsec_atmos_phy_mp, scale_tracer::tracer_cv, scale_tracer::tracer_mass, and scale_tracer::tracer_r.

Referenced by scale_atmos_phy_mp::atmos_phy_mp_config().

854  use scale_grid_index
855  use scale_time, only: &
856  dt => time_dtsec_atmos_phy_mp
857  use scale_tracer, only: &
858  qa, &
859  tracer_r, &
860  tracer_cv, &
861  tracer_mass
862  use scale_atmos_thermodyn, only: &
863  thermodyn_rhoe => atmos_thermodyn_rhoe, &
864  thermodyn_rhot => atmos_thermodyn_rhot, &
865  thermodyn_temp_pres_e => atmos_thermodyn_temp_pres_e
866  use scale_atmos_phy_mp_common, only: &
867  mp_negative_fixer => atmos_phy_mp_negative_fixer, &
868  mp_precipitation => atmos_phy_mp_precipitation
869  use scale_history, only: &
870  hist_in
871  implicit none
872 
873  real(RP), intent(inout) :: DENS (KA,IA,JA)
874  real(RP), intent(inout) :: MOMZ (KA,IA,JA)
875  real(RP), intent(inout) :: MOMX (KA,IA,JA)
876  real(RP), intent(inout) :: MOMY (KA,IA,JA)
877  real(RP), intent(inout) :: RHOT (KA,IA,JA)
878  real(RP), intent(inout) :: QTRC (KA,IA,JA,QA)
879  real(RP), intent(in) :: CCN (KA,IA,JA)
880  real(RP), intent(out) :: EVAPORATE(KA,IA,JA) !--- number of evaporated cloud [/m3]
881  real(RP), intent(out) :: SFLX_rain(IA,JA)
882  real(RP), intent(out) :: SFLX_snow(IA,JA)
883 
884  real(RP) :: RHOE (KA,IA,JA)
885  real(RP) :: POTT (KA,IA,JA)
886  real(RP) :: TEMP (KA,IA,JA)
887  real(RP) :: PRES (KA,IA,JA)
888  real(RP) :: qsat (KA,IA,JA)
889  real(RP) :: ssliq(KA,IA,JA)
890  real(RP) :: ssice(KA,IA,JA)
891 
892  integer :: ijk_index (KIJMAX,3)
893  integer :: index_cld (KIJMAX)
894  integer :: index_cold(KIJMAX)
895  integer :: index_warm(KIJMAX)
896  integer :: ijkcount, ijkcount_cold, ijkcount_warm
897  integer :: ijk, indirect
898 
899  real(RP) :: DENS_ijk(KIJMAX)
900  real(RP) :: PRES_ijk(KIJMAX)
901  real(RP) :: TEMP_ijk(KIJMAX)
902  real(RP) :: Qvap_ijk(KIJMAX)
903  real(RP) :: CCN_ijk(KIJMAX)
904  real(RP) :: Evaporate_ijk(KIJMAX)
905  real(RP) :: Ghyd_ijk(nbin,nspc,KIJMAX)
906  real(RP) :: Gaer_ijk(nccn1 ,KIJMAX)
907  real(RP) :: cldsum
908  integer :: countbin
909 
910 ! logical, save :: ofirst_sdfa = .true.
911 ! real(RP) :: VELX (IA,JA)
912 ! real(RP) :: VELY (IA,JA)
913 ! real(RP) :: SFLX_AERO(IA,JA,nccn)
914 ! real(RP) :: Uabs, bparam
915 ! real(RP) :: AMR(KA,IA,JA)
916 
917  real(RP) :: pflux (KA,IA,JA,QA_MP-1) ! precipitation flux of each tracer [kg/m2/s]
918  real(RP) :: FLX_hydro(KA,IA,JA,QA_MP-1)
919  real(RP) :: QHYD_out (KA,IA,JA,6)
920 
921  integer :: step
922  integer :: k, i, j, m, n, iq
923  !---------------------------------------------------------------------------
924 
925  if ( nspc == 1 ) then
926  if( io_l ) write(io_fid_log,*) '*** Atmos physics step: Cloud microphysics(SBM Liquid water only)'
927  elseif( nspc > 1 ) then
928  if( io_l ) write(io_fid_log,*) '*** Atmos physics step: Cloud microphysics(SBM Mixed phase)'
929  endif
930 
931  if ( mp_donegative_fixer ) then
932  call mp_negative_fixer( dens(:,:,:), & ! [INOUT]
933  rhot(:,:,:), & ! [INOUT]
934  qtrc(:,:,:,:), & ! [INOUT]
935  i_qv, & ! [IN]
936  mp_limit_negative ) ! [IN]
937  endif
938 
939  call prof_rapstart('MP_ijkconvert', 3)
940 
941  ! Clear EVAPORATE
942  do j = js, je
943  do i = is, ie
944  do k = ks, ke
945  evaporate(k,i,j) = 0.0_rp
946  enddo
947  enddo
948  enddo
949 
950  ijk = 0
951  do j = js, je
952  do i = is, ie
953  do k = ks, ke
954  ijk = ijk + 1
955  ijk_index(ijk,1) = i
956  ijk_index(ijk,2) = j
957  ijk_index(ijk,3) = k
958  enddo
959  enddo
960  enddo
961 
962  call thermodyn_temp_pres( temp(:,:,:), & ! [OUT]
963  pres(:,:,:), & ! [OUT]
964  dens(:,:,:), & ! [IN]
965  rhot(:,:,:), & ! [IN]
966  qtrc(:,:,:,:), & ! [IN]
967  tracer_cv(:), & ! [IN]
968  tracer_r(:), & ! [IN]
969  tracer_mass(:) ) ! [IN]
970 
971  call saturation_pres2qsat_liq( qsat(:,:,:), & ! [OUT]
972  temp(:,:,:), & ! [IN]
973  pres(:,:,:) ) ! [IN]
974 
975  do j = js, je
976  do i = is, ie
977  do k = ks, ke
978  ssliq(k,i,j) = qtrc(k,i,j,i_qv) / qsat(k,i,j) - 1.0_rp
979  enddo
980  enddo
981  enddo
982 
983  if ( nspc == 1 ) then
984  ssice(:,:,:) = 0.0_rp
985  else
986  call saturation_pres2qsat_ice( qsat(:,:,:), & ! [OUT]
987  temp(:,:,:), & ! [IN]
988  pres(:,:,:) ) ! [IN]
989 
990  do j = js, je
991  do i = is, ie
992  do k = ks, ke
993  ssice(k,i,j) = qtrc(k,i,j,i_qv) / qsat(k,i,j) - 1.0_rp
994  enddo
995  enddo
996  enddo
997  endif
998 
999 !--- store initial SDF of aerosol
1000 !--- this option is not supported
1001 ! if ( ofirst_sdfa ) then
1002 ! allocate( marate( nccn ) )
1003 ! do j = JS, JE
1004 ! do i = IS, IE
1005 ! do k = KS, KE
1006 ! sum2 = 0.0_RP
1007 ! do n = 1, nccn
1008 ! marate( n ) = gdga(k,i,j,n)*rexpxactr( n )
1009 ! sum2 = sum2 + gdga(k,i,j,n)*rexpxactr( n )
1010 ! enddo
1011 ! enddo
1012 ! enddo
1013 ! enddo
1014 ! if ( sum2 /= 0.0_RP ) then
1015 ! marate( 1:nccn ) = marate( 1:nccn )/sum2
1016 ! ofirst_sdfa = .false.
1017 ! endif
1018 ! endif
1019 
1020  !--- Arrange array for microphysics
1021  ijkcount = 0
1022  ijkcount_cold = 0
1023  ijkcount_warm = 0
1024 
1025  ijk = 0
1026  do j = js, je
1027  do i = is, ie
1028  do k = ks, ke
1029  ijk = ijk + 1
1030 
1031  cldsum = 0.0_rp
1032  countbin = qs_mp + 1
1033  do m = 1, nspc
1034  do n = 1, nbin
1035  cldsum = cldsum + qtrc(k,i,j,countbin) * dens(k,i,j) / dxmic
1036  countbin = countbin + 1
1037  enddo
1038  enddo
1039 
1040  if ( cldsum > cldmin &
1041  .OR. ssliq(k,i,j) > 0.0_rp &
1042  .OR. ssice(k,i,j) > 0.0_rp ) then
1043 
1044  ijkcount = ijkcount + 1
1045 
1046  index_cld(ijkcount) = ijk
1047 
1048  dens_ijk(ijkcount) = dens(k,i,j)
1049  pres_ijk(ijkcount) = pres(k,i,j)
1050  temp_ijk(ijkcount) = temp(k,i,j)
1051  ccn_ijk(ijkcount) = ccn(k,i,j)
1052  qvap_ijk(ijkcount) = qtrc(k,i,j,i_qv)
1053 
1054  countbin = qs_mp + 1
1055  do m = 1, nspc
1056  do n = 1, nbin
1057  ghyd_ijk(n,m,ijkcount) = qtrc(k,i,j,countbin) * dens(k,i,j) / dxmic
1058  countbin = countbin + 1
1059  enddo
1060  enddo
1061 
1062  do n = 1, nccn
1063  gaer_ijk(n,ijkcount) = qtrc(k,i,j,countbin) * dens(k,i,j) / dxaer
1064  countbin = countbin + 1
1065  enddo
1066 
1067  if ( temp(k,i,j) < const_tem00 .AND. nspc > 1 ) then ! cold
1068  ijkcount_cold = ijkcount_cold + 1
1069  index_cold(ijkcount_cold) = ijkcount
1070  else ! warm
1071  ijkcount_warm = ijkcount_warm + 1
1072  index_warm(ijkcount_warm) = ijkcount
1073  endif
1074  endif
1075 
1076  enddo
1077  enddo
1078  enddo
1079 
1080  call prof_rapend ('MP_ijkconvert', 3)
1081 
1082  ! tentative timername registration
1083  call prof_rapstart('MP_suzuki10', 3)
1084  call prof_rapend ('MP_suzuki10', 3)
1085  call prof_rapstart('_SBM_Nucleat', 3)
1086  call prof_rapend ('_SBM_Nucleat', 3)
1087 ! call PROF_rapstart('_SBM_NucleatA', 3)
1088 ! call PROF_rapend ('_SBM_NucleatA', 3)
1089  call prof_rapstart('_SBM_Liqphase', 3)
1090  call prof_rapend ('_SBM_Liqphase', 3)
1091  call prof_rapstart('_SBM_Icephase', 3)
1092  call prof_rapend ('_SBM_Icephase', 3)
1093  call prof_rapstart('_SBM_Mixphase', 3)
1094  call prof_rapend ('_SBM_Mixphase', 3)
1095  call prof_rapstart('_SBM_AdvLiq', 3)
1096  call prof_rapend ('_SBM_AdvLiq', 3)
1097  call prof_rapstart('_SBM_AdvIce', 3)
1098  call prof_rapend ('_SBM_AdvIce', 3)
1099  call prof_rapstart('_SBM_AdvMix', 3)
1100  call prof_rapend ('_SBM_AdvMix', 3)
1101 ! call PROF_rapstart('_SBM_FAero', 3)
1102 ! call PROF_rapend ('_SBM_FAero', 3)
1103  call prof_rapstart('_SBM_Freezing', 3)
1104  call prof_rapend ('_SBM_Freezing', 3)
1105  call prof_rapstart('_SBM_IceNucleat', 3)
1106  call prof_rapend ('_SBM_IceNucleat', 3)
1107  call prof_rapstart('_SBM_Melting', 3)
1108  call prof_rapend ('_SBM_Melting', 3)
1109  call prof_rapstart('_SBM_CollCoag', 3)
1110  call prof_rapend ('_SBM_CollCoag', 3)
1111 ! call PROF_rapstart('_SBM_CollCoagR', 3)
1112 ! call PROF_rapend ('_SBM_CollCoagR', 3)
1113 
1114  if ( ijkcount > 0 ) then
1115 
1116  call prof_rapstart('MP_suzuki10', 3)
1117 
1118  call mp_suzuki10( ijkcount, & ! [IN]
1119  ijkcount_cold, & ! [IN]
1120  ijkcount_warm, & ! [IN]
1121  index_cold( 1:ijkcount), & ! [IN]
1122  index_warm( 1:ijkcount), & ! [IN]
1123  dens_ijk( 1:ijkcount), & ! [IN]
1124  pres_ijk( 1:ijkcount), & ! [IN]
1125  ccn_ijk( 1:ijkcount), & ! [IN]
1126  temp_ijk( 1:ijkcount), & ! [INOUT]
1127  qvap_ijk( 1:ijkcount), & ! [INOUT]
1128  ghyd_ijk(:,:,1:ijkcount), & ! [INOUT]
1129  gaer_ijk(:, 1:ijkcount), & ! [INOUT]
1130  evaporate_ijk( 1:ijkcount), & ! [OUT]
1131  dt ) ! [IN]
1132 
1133  call prof_rapend ('MP_suzuki10', 3)
1134 
1135 ! if ( flg_sf_aero ) then
1136 ! do j = JS-2, JE+2
1137 ! do i = IS-2, IE+1
1138 ! VELX(i,j) = MOMX(K10_1,i,j) / ( DENS(K10_1,i+1,j)+DENS(K10_1,i,j) ) * R10M1 &
1139 ! + MOMX(K10_2,i,j) / ( DENS(K10_2,i+1,j)+DENS(K10_2,i,j) ) * R10M2
1140 ! enddo
1141 ! enddo
1142 !
1143 ! do j = JS-2, JE+1
1144 ! do i = IS-2, IE+2
1145 ! VELY(i,j) = MOMY(K10_1,i,j) / ( DENS(K10_1,i,j+1)+DENS(K10_1,i,j) ) * R10M1 &
1146 ! + MOMY(K10_2,i,j) / ( DENS(K10_2,i,j+1)+DENS(K10_2,i,j) ) * R10M2
1147 ! enddo
1148 ! enddo
1149 ! endif
1150 !
1151 ! !--- SURFACE FLUX by Monahan et al. (1986)
1152 ! if ( flg_sf_aero .AND. nccn /= 0 ) then
1153 ! do j = JS, JE
1154 ! do i = IS, IE
1155 ! ijk = ( j - JS ) * KMAX * IMAX &
1156 ! + ( i - IS ) * KMAX &
1157 ! + ( KS - KS ) &
1158 ! + 1
1159 ! Uabs = sqrt( ( ( VELX(i,j) + VELX(i-1,j ) ) * 0.50_RP )**2 &
1160 ! + ( ( VELY(i,j) + VELY(i ,j-1) ) * 0.50_RP )**2 )
1161 ! do n = 1, nccn
1162 ! if ( rada( n ) <= 2.0E-5_RP .AND. rada( n ) >= 3.0E-7_RP ) then
1163 ! bparam = ( 0.38_RP - log( rada( n ) ) )/0.65_RP
1164 ! SFLX_AERO(i,j,n) = 1.373_RP * Uabs**( 3.41_RP ) * rada( n )**( -3.0_RP ) &
1165 ! * ( 1.0_RP + 0.057_RP * rada( n )**( 1.05_RP ) ) &
1166 ! * 10.0_RP**( 1.19_RP * exp( -bparam*bparam ) )
1167 ! ! convert from [#/m^2/um/s] -> [kg/m^3/unit log (m)]
1168 ! SFLX_AERO(i,j,n) = SFLX_AERO(i,j,n) / DENS(KS,i,j) &
1169 ! / GRID_CDZ(KS) * rada( n ) / 3.0_RP * dt * expxactr( n )
1170 ! Gaer_ijk(n,ijk) = Gaer_ijk(n,ijk) + SFLX_AERO(i,j,n)/dxaer
1171 ! endif
1172 ! enddo
1173 ! enddo
1174 ! enddo
1175 ! endif
1176 
1177  call prof_rapstart('MP_ijkconvert', 3)
1178 
1179  !---- return original array
1180  do ijk = 1, ijkcount
1181  indirect = index_cld(ijk)
1182  i = ijk_index(indirect,1)
1183  j = ijk_index(indirect,2)
1184  k = ijk_index(indirect,3)
1185 
1186  temp(k,i,j) = temp_ijk(ijk)
1187  qtrc(k,i,j,i_qv) = qvap_ijk(ijk)
1188  evaporate(k,i,j) = evaporate_ijk(ijk) / dt ! [#/m3/s]
1189 
1190  countbin = qs_mp + 1
1191  do m = 1, nspc
1192  do n = 1, nbin
1193  qtrc(k,i,j,countbin) = ghyd_ijk(n,m,ijk) / dens(k,i,j) * dxmic
1194  countbin = countbin + 1
1195  enddo
1196  enddo
1197 
1198  do n = 1, nccn
1199  qtrc(k,i,j,countbin) = gaer_ijk(n,ijk) / dens(k,i,j) * dxaer
1200  countbin = countbin + 1
1201  enddo
1202  enddo
1203 
1204  do j = js, je
1205  do i = is, ie
1206  do k = ks, ke
1207  countbin = qs_mp + 1
1208  do m = 1, nspc
1209  do n = 1, nbin
1210  if ( qtrc(k,i,j,countbin) < eps ) then
1211  qtrc(k,i,j,countbin) = 0.0_rp
1212  endif
1213  countbin = countbin + 1
1214  enddo
1215  enddo
1216  enddo
1217  enddo
1218  enddo
1219 
1220  call thermodyn_pott( pott(:,:,:), & ! [OUT]
1221  temp(:,:,:), & ! [IN]
1222  pres(:,:,:), & ! [IN]
1223  qtrc(:,:,:,:), & ! [IN]
1224  tracer_cv(:), & ! [IN]
1225  tracer_r(:), & ! [IN]
1226  tracer_mass(:) ) ! [IN]
1227 
1228  do j = js, je
1229  do i = is, ie
1230  do k = ks, ke
1231  rhot(k,i,j) = pott(k,i,j) * dens(k,i,j)
1232  enddo
1233  enddo
1234  enddo
1235 
1236 ! if ( nccn /= 0 ) then
1237 ! AMR(:,:,:) = 0.0_RP
1238 ! do j = JS, JE
1239 ! do i = IS, IE
1240 ! do k = KS, KE
1241 ! do n = 1, nccn
1242 ! AMR(k,i,j) = AMR(k,i,j) + QTRC(k,i,j,QQE-1+n)
1243 ! enddo
1244 ! enddo
1245 ! enddo
1246 ! enddo
1247 ! endif
1248 
1249  call prof_rapend ('MP_ijkconvert', 3)
1250 
1251  endif
1252 
1253  flx_hydro(:,:,:,:) = 0.0_rp
1254 
1255  if ( mp_doprecipitation ) then
1256 
1257  call thermodyn_rhoe( rhoe(:,:,:), & ! [OUT]
1258  rhot(:,:,:), & ! [IN]
1259  qtrc(:,:,:,:), & ! [IN]
1260  tracer_cv(:), & ! [IN]
1261  tracer_r(:), & ! [IN]
1262  tracer_mass(:) ) ! [IN]
1263 
1264  do step = 1, mp_nstep_sedimentation
1265 
1266  call thermodyn_temp_pres_e( temp(:,:,:), & ! [OUT]
1267  pres(:,:,:), & ! [OUT]
1268  dens(:,:,:), & ! [IN]
1269  rhoe(:,:,:), & ! [IN]
1270  qtrc(:,:,:,:), & ! [IN]
1271  tracer_cv(:), & ! [IN]
1272  tracer_r(:), & ! [IN]
1273  tracer_mass(:) ) ! [IN]
1274 
1275  call mp_precipitation( qa_mp, & ! [IN]
1276  qs_mp, & ! [IN]
1277  pflux(:,:,:,:), & ! [OUT]
1278  vterm(:,:,:,:), & ! [INOUT]
1279  dens(:,:,:), & ! [INOUT]
1280  momz(:,:,:), & ! [INOUT]
1281  momx(:,:,:), & ! [INOUT]
1282  momy(:,:,:), & ! [INOUT]
1283  rhoe(:,:,:), & ! [INOUT]
1284  qtrc(:,:,:,:), & ! [INOUT]
1285  temp(:,:,:), & ! [IN]
1286  tracer_cv(:), & ! [IN]
1287  mp_dtsec_sedimentation ) ! [IN]
1288 
1289  do iq = 1, qa_mp-1
1290  do j = js, je
1291  do i = is, ie
1292  do k = ks-1, ke-1
1293  flx_hydro(k,i,j,iq) = flx_hydro(k,i,j,iq) + pflux(k,i,j,iq) * mp_rnstep_sedimentation
1294  enddo
1295  enddo
1296  enddo
1297  enddo
1298 
1299  enddo
1300 
1301  call thermodyn_rhot( rhot(:,:,:), & ! [OUT]
1302  rhoe(:,:,:), & ! [IN]
1303  qtrc(:,:,:,:), & ! [IN]
1304  tracer_cv(:), & ! [IN]
1305  tracer_r(:), & ! [IN]
1306  tracer_mass(:) ) ! [IN]
1307  endif
1308 
1309  sflx_rain(:,:) = 0.0_rp
1310  sflx_snow(:,:) = 0.0_rp
1311 
1312  !--- lowermost flux is saved for land process
1313  do n = 1, nbin
1314  iq = n
1315 
1316  do j = js, je
1317  do i = is, ie
1318  sflx_rain(i,j) = sflx_rain(i,j) - flx_hydro(ks-1,i,j,iq)
1319  enddo
1320  enddo
1321  enddo
1322 
1323  if ( nspc > 1 ) then
1324  do m = ic, ih
1325  do n = 1, nbin
1326  iq = (m-1)*nbin + n
1327 
1328  do j = js, je
1329  do i = is, ie
1330  sflx_snow(i,j) = sflx_snow(i,j) - flx_hydro(ks-1,i,j,iq)
1331  enddo
1332  enddo
1333  enddo
1334  enddo
1335  endif
1336 
1337  !##### END MP Main #####
1338 
1339  if ( mp_donegative_fixer ) then
1340  call mp_negative_fixer( dens(:,:,:), & ! [INOUT]
1341  rhot(:,:,:), & ! [INOUT]
1342  qtrc(:,:,:,:), & ! [INOUT]
1343  i_qv, & ! [IN]
1344  mp_limit_negative ) ! [IN]
1345  endif
1346 
1347  qhyd_out(:,:,:,:) = 0.0_rp
1348 
1349  do n = 1, nbnd
1350  iq = qs_mp + n
1351 
1352  do j = js, je
1353  do i = is, ie
1354  do k = ks, ke
1355  qhyd_out(k,i,j,1) = qhyd_out(k,i,j,1) + qtrc(k,i,j,iq)
1356  enddo
1357  enddo
1358  enddo
1359  enddo
1360 
1361  do n = nbnd+1, nbin
1362  iq = qs_mp + n
1363 
1364  do j = js, je
1365  do i = is, ie
1366  do k = ks, ke
1367  qhyd_out(k,i,j,2) = qhyd_out(k,i,j,2) + qtrc(k,i,j,iq)
1368  enddo
1369  enddo
1370  enddo
1371  enddo
1372 
1373  call hist_in( qhyd_out(:,:,:,1), 'QC', 'Mixing ratio of QC', 'kg/kg' )
1374  call hist_in( qhyd_out(:,:,:,2), 'QR', 'Mixing ratio of QR', 'kg/kg' )
1375 
1376  if ( nspc > 1 ) then
1377  do m = ic, id ! columnar,plate,dendrite = ice
1378  do n = 1, nbin
1379  iq = qs_mp + (m-1)*nbin + n
1380 
1381  do j = js, je
1382  do i = is, ie
1383  do k = ks, ke
1384  qhyd_out(k,i,j,3) = qhyd_out(k,i,j,3) + qtrc(k,i,j,iq)
1385  enddo
1386  enddo
1387  enddo
1388  enddo
1389  enddo
1390 
1391  do n = 1, nbin
1392  iq = qs_mp + (iss-1)*nbin + n
1393 
1394  do j = js, je
1395  do i = is, ie
1396  do k = ks, ke
1397  qhyd_out(k,i,j,4) = qhyd_out(k,i,j,4) + qtrc(k,i,j,iq)
1398  enddo
1399  enddo
1400  enddo
1401  enddo
1402 
1403  do n = 1, nbin
1404  iq = qs_mp + (ig-1)*nbin + n
1405 
1406  do j = js, je
1407  do i = is, ie
1408  do k = ks, ke
1409  qhyd_out(k,i,j,5) = qhyd_out(k,i,j,5) + qtrc(k,i,j,iq)
1410  enddo
1411  enddo
1412  enddo
1413  enddo
1414 
1415  do n = 1, nbin
1416  iq = qs_mp + (ih-1)*nbin + n
1417 
1418  do j = js, je
1419  do i = is, ie
1420  do k = ks, ke
1421  qhyd_out(k,i,j,6) = qhyd_out(k,i,j,6) + qtrc(k,i,j,iq)
1422  enddo
1423  enddo
1424  enddo
1425  enddo
1426 
1427  call hist_in( qhyd_out(:,:,:,3), 'QI', 'Mixing ratio of QI', 'kg/kg' )
1428  call hist_in( qhyd_out(:,:,:,4), 'QS', 'Mixing ratio of QS', 'kg/kg' )
1429  call hist_in( qhyd_out(:,:,:,5), 'QG', 'Mixing ratio of QG', 'kg/kg' )
1430  call hist_in( qhyd_out(:,:,:,6), 'QH', 'Mixing ratio of QH', 'kg/kg' )
1431  endif
1432 
1433  return
scale_grid_index::is
integer, public is
start point of inner domain: x, local
Definition: scale_grid_index.F90:60
scale_grid_index::je
integer, public je
end point of inner domain: y, local
Definition: scale_grid_index.F90:63
scale_atmos_phy_mp_common::atmos_phy_mp_negative_fixer
subroutine, public atmos_phy_mp_negative_fixer(DENS, RHOT, QTRC, I_QV, limit_negative)
Negative fixer.
Definition: scale_atmos_phy_mp_common.F90:64
scale_tracer::tracer_r
real(rp), dimension(qa_max), public tracer_r
Definition: scale_tracer.F90:41
scale_time::time_dtsec_atmos_phy_mp
real(dp), public time_dtsec_atmos_phy_mp
time interval of physics(microphysics) [sec]
Definition: scale_time.F90:41
scale_grid_index::ke
integer, public ke
end point of inner domain: z, local
Definition: scale_grid_index.F90:59
scale_tracer::tracer_cv
real(rp), dimension(qa_max), public tracer_cv
Definition: scale_tracer.F90:40
scale_atmos_phy_mp_common
module ATMOSPHERE / Physics Cloud Microphysics - Common
Definition: scale_atmos_phy_mp_common.F90:16
scale_grid_index
module grid index
Definition: scale_grid_index.F90:14
scale_tracer
module TRACER
Definition: scale_tracer.F90:15
scale_grid_index::js
integer, public js
start point of inner domain: y, local
Definition: scale_grid_index.F90:62
scale_time
module TIME
Definition: scale_time.F90:15
scale_grid_index::ks
integer, public ks
start point of inner domain: z, local
Definition: scale_grid_index.F90:58
scale_grid_index::ie
integer, public ie
end point of inner domain: x, local
Definition: scale_grid_index.F90:61
scale_atmos_thermodyn
module ATMOSPHERE / Thermodynamics
Definition: scale_atmos_sub_thermodyn.F90:19
scale_history
module HISTORY
Definition: scale_history.F90:16
scale_atmos_phy_mp_common::atmos_phy_mp_precipitation
subroutine, public atmos_phy_mp_precipitation(QA_MP, QS_MP, qflx, vterm, DENS, MOMZ, MOMX, MOMY, RHOE, QTRC, temp, CVq, dt, vt_fixed)
precipitation transport
Definition: scale_atmos_phy_mp_common.F90:763
scale_tracer::tracer_mass
real(rp), dimension(qa_max), public tracer_mass
Definition: scale_tracer.F90:42
Here is the call graph for this function:
Here is the caller graph for this function:

◆ mp_suzuki10()

subroutine scale_atmos_phy_mp_suzuki10::mp_suzuki10 ( integer, intent(in)  ijkmax,
integer, intent(in)  ijkmax_cold,
integer, intent(in)  ijkmax_warm,
integer, dimension(ijkmax), intent(in)  index_cold,
integer, dimension(ijkmax), intent(in)  index_warm,
real(rp), dimension (ijkmax), intent(in)  dens,
real(rp), dimension (ijkmax), intent(in)  pres,
real(rp), dimension (ijkmax), intent(in)  ccn,
real(rp), dimension (ijkmax), intent(inout)  temp,
real(rp), dimension (ijkmax), intent(inout)  qvap,
real(rp), dimension (nbin,nspc,ijkmax), intent(inout)  ghyd,
real(rp), dimension (nccn1, ijkmax), intent(inout)  gaer,
real(rp), dimension (ijkmax), intent(out)  evaporate,
real(dp), intent(in)  dt 
)

Definition at line 1452 of file scale_atmos_phy_mp_suzuki10.F90.

References scale_const::const_psat0, scale_const::const_tem00, scale_atmos_saturation::cpovr_ice, scale_atmos_saturation::cpovr_liq, scale_atmos_saturation::lovr_ice, scale_atmos_saturation::lovr_liq, nbin, nccn, scale_process::prc_mpistop(), scale_prof::prof_rapend(), scale_prof::prof_rapstart(), r_collcoag(), and scale_random::random_get().

Referenced by atmos_phy_mp_suzuki10().

1452  implicit none
1453 
1454  integer, intent(in) :: ijkmax
1455  integer, intent(in) :: ijkmax_cold
1456  integer, intent(in) :: ijkmax_warm
1457  integer , intent(in) :: index_cold(ijkmax)
1458  integer , intent(in) :: index_warm(ijkmax)
1459  real(RP), intent(in) :: dens (ijkmax) ! Density [kg/m3]
1460  real(RP), intent(in) :: pres (ijkmax) ! Pressure [Pa]
1461  real(RP), intent(in) :: ccn (ijkmax) ! Number concentration of CCN [#/m3]
1462  real(RP), intent(inout) :: temp (ijkmax) ! Temperature [K]
1463  real(RP), intent(inout) :: qvap (ijkmax) ! Specific humidity [kg/kg]
1464  real(RP), intent(inout) :: ghyd (nbin,nspc,ijkmax) ! Mass size distribution function of hydrometeor
1465  real(RP), intent(inout) :: gaer (nccn1, ijkmax) ! Mass size distribution function of aerosol
1466  real(RP), intent(out) :: evaporate (ijkmax) ! Number concentration of evaporated cloud [/m3/s]
1467  real(DP), intent(in) :: dt ! Time step interval
1468  !---------------------------------------------------------------------------
1469 
1470  if ( nccn /= 0 ) then
1471  if ( nspc == 1 ) then
1472  !---< warm rain only with aerosol tracer >---
1473 
1474  ! nucleation from aerosol
1475  call nucleata( ijkmax, & ! [IN]
1476  dens(:), & ! [IN]
1477  pres(:), & ! [IN]
1478  temp(:), & ! [INOUT]
1479  qvap(:), & ! [INOUT]
1480  ghyd(:,:,:), & ! [INOUT]
1481  gaer(:,:), & ! [INOUT]
1482  dt ) ! [IN]
1483 
1484  ! condensation / evaporation
1485  call cndevpsbla( ijkmax, & ! [IN]
1486  dens(:), & ! [IN]
1487  pres(:), & ! [IN]
1488  temp(:), & ! [INOUT]
1489  qvap(:), & ! [INOUT]
1490  ghyd(:,:,:), & ! [INOUT]
1491  gaer(:,:), & ! [INOUT]
1492  evaporate(:),& ! [OUT]
1493  dt ) ! [IN]
1494 
1495  if ( mp_doautoconversion ) then
1496  ! collision-coagulation
1497  call collmain( ijkmax, & ! [IN]
1498  temp(:), & ! [IN]
1499  ghyd(:,:,:), & ! [INOUT]
1500  dt ) ! [IN]
1501  endif
1502 
1503  elseif( nspc > 1 ) then
1504  !---< mixed phase rain only with aerosol tracer >---
1505 
1506  ! nucleation from aerosol
1507  call nucleata( ijkmax, & ! [IN]
1508  dens(:), & ! [IN]
1509  pres(:), & ! [IN]
1510  temp(:), & ! [INOUT]
1511  qvap(:), & ! [INOUT]
1512  ghyd(:,:,:), & ! [INOUT]
1513  gaer(:,:), & ! [INOUT]
1514  dt ) ! [IN]
1515 
1516  ! freezing / melting
1517  call freezing( ijkmax, & ! [IN]
1518  ijkmax_cold, & ! [IN]
1519  index_cold(:), & ! [IN]
1520  dens(:), & ! [IN]
1521  temp(:), & ! [INOUT]
1522  ghyd(:,:,:), & ! [INOUT]
1523  dt ) ! [IN]
1524 
1525 ! call ice_nucleat( ijkmax, & ! [IN]
1526 ! ijkmax_cold, & ! [IN]
1527 ! index_cold(:), & ! [IN]
1528 ! dens(:), & ! [IN]
1529 ! pres(:), & ! [IN]
1530 ! temp(:), & ! [INOUT]
1531 ! qvap(:), & ! [INOUT]
1532 ! ghyd(:,:,:), & ! [INOUT]
1533 ! dt ) ! [IN]
1534 
1535  call melting( ijkmax, & ! [IN]
1536  ijkmax_warm, & ! [IN]
1537  index_warm(:), & ! [IN]
1538  dens(:), & ! [IN]
1539  temp(:), & ! [INOUT]
1540  ghyd(:,:,:), & ! [INOUT]
1541  dt ) ! [IN]
1542 
1543  ! condensation / evaporation
1544  call cndevpsbla( ijkmax, & ! [IN]
1545  dens(:), & ! [IN]
1546  pres(:), & ! [IN]
1547  temp(:), & ! [INOUT]
1548  qvap(:), & ! [INOUT]
1549  ghyd(:,:,:), & ! [INOUT]
1550  gaer(:,:), & ! [INOUT]
1551  evaporate(:),& ! [OUT]
1552  dt ) ! [IN]
1553 
1554  if ( mp_doautoconversion ) then
1555  ! collision-coagulation
1556  call collmainf( ijkmax, & ! [IN]
1557  temp(:), & ! [IN]
1558  ghyd(:,:,:), & ! [INOUT]
1559  dt ) ! [IN]
1560  endif
1561 
1562  endif
1563 
1564  elseif( nccn == 0 ) then
1565 
1566  if ( nspc == 1 ) then
1567  !---< warm rain only without aerosol tracer >---
1568 
1569  ! nucleation
1570  call nucleat( ijkmax, & ! [IN]
1571  dens(:), & ! [IN]
1572  pres(:), & ! [IN]
1573  ccn(:), & ! [IN]
1574  temp(:), & ! [INOUT]
1575  qvap(:), & ! [INOUT]
1576  ghyd(:,:,:), & ! [INOUT]
1577  dt ) ! [IN]
1578 
1579  ! condensation / evaporation
1580  call cndevpsbl( ijkmax, & ! [IN]
1581  dens(:), & ! [IN]
1582  pres(:), & ! [IN]
1583  temp(:), & ! [INOUT]
1584  qvap(:), & ! [INOUT]
1585  ghyd(:,:,:), & ! [INOUT]
1586  evaporate(:),& ! [OUT]
1587  dt ) ! [IN]
1588 
1589  if ( mp_doautoconversion ) then
1590  ! collision-coagulation
1591  call collmain( ijkmax, & ! [IN]
1592  temp(:), & ! [IN]
1593  ghyd(:,:,:), & ! [INOUT]
1594  dt ) ! [IN]
1595  endif
1596 
1597  elseif( nspc > 1 ) then
1598  !---< mixed phase rain only without aerosol tracer >---
1599 
1600  ! nucleation
1601  call nucleat( ijkmax, & ! [IN]
1602  dens(:), & ! [IN]
1603  pres(:), & ! [IN]
1604  ccn(:), & ! [IN]
1605  temp(:), & ! [INOUT]
1606  qvap(:), & ! [INOUT]
1607  ghyd(:,:,:), & ! [INOUT]
1608  dt ) ! [IN]
1609 
1610  ! freezing / melting
1611  call freezing( ijkmax, & ! [IN]
1612  ijkmax_cold, & ! [IN]
1613  index_cold(:), & ! [IN]
1614  dens(:), & ! [IN]
1615  temp(:), & ! [INOUT]
1616  ghyd(:,:,:), & ! [INOUT]
1617  dt ) ! [IN]
1618 
1619  call ice_nucleat( ijkmax, & ! [IN]
1620  ijkmax_cold, & ! [IN]
1621  index_cold(:), & ! [IN]
1622  dens(:), & ! [IN]
1623  pres(:), & ! [IN]
1624  temp(:), & ! [INOUT]
1625  qvap(:), & ! [INOUT]
1626  ghyd(:,:,:), & ! [INOUT]
1627  dt ) ! [IN]
1628 
1629  call melting( ijkmax, & ! [IN]
1630  ijkmax_warm, & ! [IN]
1631  index_warm(:), & ! [IN]
1632  dens(:), & ! [IN]
1633  temp(:), & ! [INOUT]
1634  ghyd(:,:,:), & ! [INOUT]
1635  dt ) ! [IN]
1636 
1637  ! condensation / evaporation
1638  call cndevpsbl( ijkmax, & ! [IN]
1639  dens(:), & ! [IN]
1640  pres(:), & ! [IN]
1641  temp(:), & ! [INOUT]
1642  qvap(:), & ! [INOUT]
1643  ghyd(:,:,:), & ! [INOUT]
1644  evaporate(:),& ! [OUT]
1645  dt ) ! [IN]
1646 
1647  if ( mp_doautoconversion ) then
1648  ! collision-coagulation
1649  call collmainf( ijkmax, & ! [IN]
1650  temp(:), & ! [IN]
1651  ghyd(:,:,:), & ! [INOUT]
1652  dt ) ! [IN]
1653  endif
1654 
1655  endif
1656 
1657  endif
1658 
1659  return
Here is the call graph for this function:
Here is the caller graph for this function:

◆ r_collcoag()

subroutine scale_atmos_phy_mp_suzuki10::r_collcoag ( integer, intent(in)  ijkmax,
real(rp), intent(in)  swgt,
real(rp), dimension(ijkmax), intent(in)  temp,
real(rp), dimension (nbin,nspc,ijkmax), intent(inout)  gc,
real(dp), intent(in)  dtime 
)

Definition at line 3855 of file scale_atmos_phy_mp_suzuki10.F90.

References scale_grid_index::ia, scale_grid_index::ja, scale_grid_index::ka, scale_prof::prof_rapend(), scale_prof::prof_rapstart(), and scale_random::random_get().

Referenced by mp_suzuki10().

3855  use scale_random, only: &
3856  random_get
3857  implicit none
3858 
3859  integer, intent(in) :: ijkmax
3860  real(RP), intent(in) :: swgt
3861  real(RP), intent(in) :: temp(ijkmax) ! Temperature [K]
3862  real(RP), intent(inout) :: gc (nbin,nspc,ijkmax) ! Mass size distribution function of hydrometeor
3863  real(DP), intent(in) :: dtime ! Time step interval
3864 
3865  integer :: i, j, k, l
3866  real(RP) :: xi, xj, xnew, dmpi, dmpj, frci, frcj
3867  real(RP) :: gprime, gprimk, wgt, crn, sum, flux
3868  integer, parameter :: ldeg = 2
3869  real(RP), parameter :: dmpmin = 1.e-01_rp, cmin = 1.e-10_rp
3870  real(RP) :: acoef( 0:ldeg )
3871  !
3872  !--- Y.sato added to use code6
3873  integer :: nums( mbin ), numl( mbin )
3874  real(RP), parameter :: gt = 1.0_rp
3875  integer :: s, det
3876  real(RP) :: nbinr, mbinr ! use to weight
3877 ! real(RP) :: beta
3878  real(RP) :: tmpi, tmpj
3879 
3880  integer :: ibnd( ijkmax )
3881  integer :: iflg( nspc,ijkmax )
3882  integer :: iexst( nbin,nspc,ijkmax )
3883  real(RP) :: csum( nspc,ijkmax )
3884  integer :: ijk, nn, mm, pp, qq, myu, n, isml, ilrg, irsl
3885  !---------------------------------------------------------------------------
3886 
3887  call prof_rapstart('_SBM_CollCoagR', 3)
3888 
3889  iflg( :,: ) = 0
3890  iexst( :,:,: ) = 0
3891  csum( :,: ) = 0.0_rp
3892  do ijk = 1, ijkmax
3893  !--- judgement of particle existence
3894  do n = 1, nbin
3895  csum( il,ijk ) = csum( il,ijk ) + gc( n,il,ijk )*dxmic
3896  csum( ic,ijk ) = csum( ic,ijk ) + gc( n,ic,ijk )*dxmic
3897  csum( ip,ijk ) = csum( ip,ijk ) + gc( n,ip,ijk )*dxmic
3898  csum( id,ijk ) = csum( id,ijk ) + gc( n,id,ijk )*dxmic
3899  csum( iss,ijk ) = csum( iss,ijk ) + gc( n,iss,ijk )*dxmic
3900  csum( ig,ijk ) = csum( ig,ijk ) + gc( n,ig,ijk )*dxmic
3901  csum( ih,ijk ) = csum( ih,ijk ) + gc( n,ih,ijk )*dxmic
3902  enddo
3903  if ( csum( il,ijk ) > cldmin ) iflg( il,ijk ) = 1
3904  if ( csum( ic,ijk ) > cldmin ) iflg( ic,ijk ) = 1
3905  if ( csum( ip,ijk ) > cldmin ) iflg( ip,ijk ) = 1
3906  if ( csum( id,ijk ) > cldmin ) iflg( id,ijk ) = 1
3907  if ( csum( iss,ijk ) > cldmin ) iflg( iss,ijk ) = 1
3908  if ( csum( ig,ijk ) > cldmin ) iflg( ig,ijk ) = 1
3909  if ( csum( ih,ijk ) > cldmin ) iflg( ih,ijk ) = 1
3910 
3911  if ( temp(ijk) < tcrit ) then
3912  ibnd(ijk) = 1
3913  else
3914  ibnd(ijk) = 2
3915  endif
3916 
3917  do myu = 1, nspc
3918  do n = 1, nbin
3919  if ( gc( n,myu,ijk ) > cldmin ) then
3920  iexst( n,myu,ijk ) = 1
3921  endif
3922  enddo
3923  enddo
3924 
3925  enddo
3926 
3927 !OCL PARALLEL
3928  do ijk = 1, ijkmax
3929  do isml = 1, nspc
3930  do nn = 1, iflg( isml,ijk )
3931 
3932  do ilrg = 1, nspc
3933  do mm = 1, iflg( ilrg,ijk )
3934  !--- rule of interaction
3935  irsl = ifrsl( ibnd(ijk),isml,ilrg )
3936 
3937  call random_get( rndm )
3938  det = int( rndm(1,1,1)*ia*ja*ka )
3939  nbinr = real( nbin )
3940  mbinr = real( mbin )
3941  nums( 1:mbin ) = bsml( det,1:mbin )
3942  numl( 1:mbin ) = blrg( det,1:mbin )
3943 
3944  do s = 1, mbin
3945  i = nums( s )
3946  j = numl( s )
3947 
3948  do pp = 1, iexst( i,isml,ijk )
3949  do qq = 1, iexst( j,ilrg,ijk )
3950 
3951  k = kindx( i,j )
3952  xi = expxctr( i )
3953  xj = expxctr( j )
3954  xnew = log( xi+xj )
3955 
3956  dmpi = ck( isml,ilrg,i,j )*gc( j,ilrg,ijk )/xj*dxmic*dtime
3957  dmpj = ck( ilrg,isml,i,j )*gc( i,isml,ijk )/xi*dxmic*dtime
3958 
3959  if ( dmpi <= dmpmin ) then
3960  frci = gc( i,isml,ijk )*dmpi
3961  else
3962  frci = gc( i,isml,ijk )*( 1.0_rp-exp( -dmpi ) )
3963  endif
3964 
3965  if ( dmpj <= dmpmin ) then
3966  frcj = gc( j,ilrg,ijk )*dmpj
3967  else
3968  frcj = gc( j,ilrg,ijk )*( 1.0_rp-exp( -dmpj ) )
3969  endif
3970  tmpi = gc( i,isml,ijk )
3971  tmpj = gc( j,ilrg,ijk )
3972 
3973  gc( i,isml,ijk ) = gc( i,isml,ijk )-frci*swgt
3974  gc( j,ilrg,ijk ) = gc( j,ilrg,ijk )-frcj*swgt
3975 
3976  if ( j /= k ) then
3977  gc( j,ilrg,ijk ) = max( gc( j,ilrg,ijk ), 0.0_rp )
3978  endif
3979  gc( i,isml,ijk ) = max( gc( i,isml,ijk ), 0.0_rp )
3980 
3981  frci = tmpi - gc( i,isml,ijk )
3982  frcj = tmpj - gc( j,ilrg,ijk )
3983 
3984  gprime = frci+frcj
3985 
3986  !-----------------------------------------------
3987  !--- Exponential Flux Method (Bott, 2000, JAS)
3988  !-----------------------------------------------
3989  ! if ( gprime <= 0.0_RP ) cycle !large
3990  ! if ( gprime > 0.0_RP .AND. k < nbin ) then
3991  ! gprimk = gc( (irsl-1)*nbin+k ) + gprime
3992  !
3993  ! beta = log( gc( (irsl-1)*nbin+k+1 )/gprimk+1.E-60_RP )
3994  ! crn = ( xnew-xctr( k ) )/( xctr( k+1 )-xctr( k ) )
3995  !
3996  ! flux = ( gprime/beta )*( exp( beta*0.50_RP ) -exp( beta*( 0.50_RP-crn ) ) )
3997  ! flux = min( gprimk ,gprime )
3998  !
3999  ! gc( (irsl-1)*nbin+k ) = gprimk - flux
4000  ! gc( (irsl-1)*nbin+k+1 ) = gc( (irsl-1)*nbin+k+1 ) + flux
4001  ! endif
4002 
4003  !-----------------------------------------------
4004  !--- Flux Method (Bott, 1998, JAS)
4005  !-----------------------------------------------
4006 ! if ( gprime <= 0.0_RP ) cycle !large
4007  if ( gprime > 0.0_rp .AND. k < nbin ) then
4008 
4009  gprimk = gc( k,irsl,ijk ) + gprime
4010  wgt = gprime / gprimk
4011  crn = ( xnew-xctr( k ) )/( xctr( k+1 )-xctr( k ) )
4012 
4013  acoef( 0 ) = -( gc( k+1,irsl,ijk )-26.0_rp*gprimk+gc( k-1,irsl,ijk ) )/24.0_rp
4014  acoef( 1 ) = ( gc( k+1,irsl,ijk )-gc( k-1,irsl,ijk ) ) *0.5_rp
4015  acoef( 2 ) = ( gc( k+1,irsl,ijk )-2.0_rp*gprimk+gc( k-1,irsl,ijk ) ) *0.50_rp
4016 
4017  sum = 0.0_rp
4018  do l = 0, ldeg
4019  sum = sum + acoef( l )/( l+1 )/2.0_rp**( l+1 ) &
4020  *( 1.0_rp-( 1.0_rp-2.0_rp*crn )**( l+1 ) )
4021  enddo
4022 
4023  flux = wgt*sum
4024  flux = min( max( flux,0.0_rp ),gprime )
4025 
4026  gc( k,irsl,ijk ) = gprimk - flux
4027  gc( k+1,irsl,ijk ) = gc( k+1,irsl,ijk ) + flux
4028  endif
4029 
4030  enddo
4031  enddo
4032 
4033  enddo ! bin
4034  !
4035  enddo
4036  enddo
4037 
4038  enddo
4039  enddo
4040 
4041  enddo
4042 
4043  call prof_rapend ('_SBM_CollCoagR', 3)
4044 
4045  return
scale_random::random_get
subroutine, public random_get(var)
Get random number.
Definition: scale_random.F90:136
scale_random
module RANDOM
Definition: scale_random.F90:13
Here is the call graph for this function:
Here is the caller graph for this function:

◆ atmos_phy_mp_suzuki10_cloudfraction()

subroutine, public scale_atmos_phy_mp_suzuki10::atmos_phy_mp_suzuki10_cloudfraction ( real(rp), dimension(ka,ia,ja), intent(out)  cldfrac,
real(rp), dimension (ka,ia,ja,qa), intent(in)  QTRC,
real(rp), intent(in)  mask_criterion 
)

Calculate Cloud Fraction.

Definition at line 4054 of file scale_atmos_phy_mp_suzuki10.F90.

References scale_grid_index::ie, scale_grid_index::is, scale_grid_index::je, scale_grid_index::js, scale_grid_index::ke, scale_grid_index::ks, nbin, nspc, and scale_tracer::qa.

Referenced by scale_atmos_phy_mp::atmos_phy_mp_config().

4054  use scale_grid_index
4055  use scale_tracer, only: &
4056  qa
4057  implicit none
4058 
4059  real(RP), intent(out) :: cldfrac(KA,IA,JA)
4060  real(RP), intent(in) :: QTRC (KA,IA,JA,QA)
4061  real(RP), intent(in) :: mask_criterion
4062 
4063  real(RP) :: qhydro
4064  integer :: k, i, j, iq, ihydro
4065  !---------------------------------------------------------------------------
4066 
4067  if( nspc > 1 ) then
4068  do j = js, je
4069  do i = is, ie
4070  do k = ks, ke
4071  qhydro = 0.0_rp
4072  do ihydro = 1, nspc
4073  do iq = qs_mp+nbin*(ihydro-1)+1, qs_mp+nbin*ihydro
4074  qhydro = qhydro + qtrc(k,i,j,iq)
4075  enddo
4076  enddo
4077  cldfrac(k,i,j) = 0.5_rp + sign(0.5_rp,qhydro-mask_criterion)
4078  enddo
4079  enddo
4080  enddo
4081  elseif( nspc == 1 ) then
4082  do j = js, je
4083  do i = is, ie
4084  do k = ks, ke
4085  qhydro = 0.0_rp
4086  do ihydro = 1, i_mp_qc
4087  do iq = qs_mp+nbin*(ihydro-1)+1, qs_mp+nbin*ihydro
4088  qhydro = qhydro + qtrc(k,i,j,iq)
4089  enddo
4090  enddo
4091  cldfrac(k,i,j) = 0.5_rp + sign(0.5_rp,qhydro-mask_criterion)
4092  enddo
4093  enddo
4094  enddo
4095  endif
4096 
4097  return
scale_grid_index::is
integer, public is
start point of inner domain: x, local
Definition: scale_grid_index.F90:60
scale_grid_index::je
integer, public je
end point of inner domain: y, local
Definition: scale_grid_index.F90:63
scale_grid_index::ke
integer, public ke
end point of inner domain: z, local
Definition: scale_grid_index.F90:59
scale_grid_index
module grid index
Definition: scale_grid_index.F90:14
scale_tracer
module TRACER
Definition: scale_tracer.F90:15
scale_grid_index::js
integer, public js
start point of inner domain: y, local
Definition: scale_grid_index.F90:62
scale_grid_index::ks
integer, public ks
start point of inner domain: z, local
Definition: scale_grid_index.F90:58
scale_grid_index::ie
integer, public ie
end point of inner domain: x, local
Definition: scale_grid_index.F90:61
Here is the caller graph for this function:

◆ atmos_phy_mp_suzuki10_effectiveradius()

subroutine, public scale_atmos_phy_mp_suzuki10::atmos_phy_mp_suzuki10_effectiveradius ( real(rp), dimension (ka,ia,ja,n_hyd), intent(out)  Re,
real(rp), dimension(ka,ia,ja,qa), intent(in)  QTRC0,
real(rp), dimension(ka,ia,ja), intent(in)  DENS0,
real(rp), dimension(ka,ia,ja), intent(in)  TEMP0 
)

Calculate Effective Radius.

Definition at line 4107 of file scale_atmos_phy_mp_suzuki10.F90.

References scale_const::const_eps, scale_atmos_hydrometeor::i_hc, scale_atmos_hydrometeor::i_hg, scale_atmos_hydrometeor::i_hh, scale_atmos_hydrometeor::i_hi, scale_atmos_hydrometeor::i_hr, scale_atmos_hydrometeor::i_hs, scale_grid_index::ie, scale_grid_index::is, scale_grid_index::je, scale_grid_index::js, scale_grid_index::ke, scale_grid_index::ks, scale_atmos_hydrometeor::n_hyd, nbin, nspc, and scale_tracer::qa.

Referenced by scale_atmos_phy_mp::atmos_phy_mp_config().

4107  use scale_grid_index
4108  use scale_const, only: &
4109  eps => const_eps
4110  use scale_tracer, only: &
4111  qa
4112  use scale_atmos_hydrometeor, only: &
4113  n_hyd, &
4114  i_hc, &
4115  i_hr, &
4116  i_hi, &
4117  i_hs, &
4118  i_hg, &
4119  i_hh
4120  implicit none
4121 
4122  real(RP), intent(out) :: Re (KA,IA,JA,N_HYD) ! effective radius [cm]
4123  real(RP), intent(in) :: QTRC0(KA,IA,JA,QA) ! tracer mass concentration [kg/kg]
4124  real(RP), intent(in) :: DENS0(KA,IA,JA) ! density [kg/m3]
4125  real(RP), intent(in) :: TEMP0(KA,IA,JA) ! temperature [K]
4126 
4127  real(RP), parameter :: um2cm = 100.0_rp
4128 
4129  real(RP) :: sum0(nspc), sum2, sum3, re_tmp(nspc)
4130  integer :: i, j, k, iq, ihydro
4131  !---------------------------------------------------------------------------
4132 
4133  do k = ks, ke
4134  do j = js, je
4135  do i = is, ie
4136  re(k,i,j,:) = 0.0_rp
4137 
4138  ! HC
4139  sum3 = 0.0_rp
4140  sum2 = 0.0_rp
4141  ihydro = i_mp_qc
4142  do iq = qs_mp+1, qs_mp+nbnd
4143  sum3 = sum3 &
4144  + ( ( qtrc0(k,i,j,iq) * dens0(k,i,j) ) & !--- [kg/kg] -> [kg/m3]
4145  * rexpxctr( iq-(i_qv+nbin*(ihydro-1)) ) & !--- mass -> number
4146  * radc( iq-(i_qv+nbin*(ihydro-1)) )**3.0_rp )
4147  sum2 = sum2 &
4148  + ( ( qtrc0(k,i,j,iq) * dens0(k,i,j) ) & !--- [kg/kg] -> [kg/m3]
4149  * rexpxctr( iq-(i_qv+nbin*(ihydro-1)) ) & !--- mass -> number
4150  * radc( iq-(i_qv+nbin*(ihydro-1)) )**2.0_rp )
4151  enddo
4152  sum3 = max( sum3, 0.0_rp )
4153  sum2 = max( sum2, 0.0_rp )
4154  if ( sum2 /= 0.0_rp ) then
4155  re(k,i,j,i_hc) = sum3 / sum2 * um2cm
4156  else
4157  re(k,i,j,i_hc) = 0.0_rp
4158  endif
4159 
4160  ! HR
4161  sum3 = 0.0_rp
4162  sum2 = 0.0_rp
4163  ihydro = i_mp_qc
4164  do iq = qs_mp+nbnd+1, qs_mp+nbin
4165  sum3 = sum3 &
4166  + ( ( qtrc0(k,i,j,iq) * dens0(k,i,j) ) & !--- [kg/kg] -> [kg/m3]
4167  * rexpxctr( iq-(i_qv+nbin*(ihydro-1)) ) & !--- mass -> number
4168  * radc( iq-(i_qv+nbin*(ihydro-1)) )**3.0_rp )
4169  sum2 = sum2 &
4170  + ( ( qtrc0(k,i,j,iq) * dens0(k,i,j) ) & !--- [kg/kg] -> [kg/m3]
4171  * rexpxctr( iq-(i_qv+nbin*(ihydro-1)) ) & !--- mass -> number
4172  * radc( iq-(i_qv+nbin*(ihydro-1)) )**2.0_rp )
4173  enddo
4174  sum3 = max( sum3, 0.0_rp )
4175  sum2 = max( sum2, 0.0_rp )
4176  if ( sum2 /= 0.0_rp ) then
4177  re(k,i,j,i_hr) = sum3 / sum2 * um2cm
4178  else
4179  re(k,i,j,i_hr) = 0.0_rp
4180  endif
4181 
4182  enddo
4183  enddo
4184  enddo
4185 
4186  ! other hydrometeors
4187  if ( nspc > 1 ) then
4188  do k = ks, ke
4189  do j = js, je
4190  do i = is, ie
4191  do ihydro = 2, nspc
4192  sum0(ihydro) = 0.0_rp
4193  sum2 = 0.0_rp
4194  sum3 = 0.0_rp
4195  do iq = qs_mp+nbin*(ihydro-1)+1, qs_mp+nbin*ihydro
4196  sum0(ihydro) = sum0(ihydro) &
4197  + ( qtrc0(k,i,j,iq) * dens0(k,i,j) ) !--- [kg/kg] -> [kg/m3]
4198  sum3 = sum3 &
4199  + ( ( qtrc0(k,i,j,iq) * dens0(k,i,j) ) & !--- [kg/kg] -> [kg/m3]
4200  * rexpxctr( iq-(i_qv+nbin*(ihydro-1)) ) & !--- mass -> number
4201  * radc( iq-(i_qv+nbin*(ihydro-1)) )**3.0_rp )
4202  sum2 = sum2 &
4203  + ( ( qtrc0(k,i,j,iq) * dens0(k,i,j) ) & !--- [kg/kg] -> [kg/m3]
4204  * rexpxctr( iq-(i_qv+nbin*(ihydro-1)) ) & !--- mass -> number
4205  * radc( iq-(i_qv+nbin*(ihydro-1)) )**2.0_rp )
4206  enddo
4207  sum3 = max( sum3, 0.0_rp )
4208  sum2 = max( sum2, 0.0_rp )
4209  if ( sum2 == 0.0_rp ) then
4210  re_tmp(ihydro) = 0.0_rp
4211  else
4212  re_tmp(ihydro) = sum3 / sum2 * um2cm
4213  end if
4214  end do
4215 
4216  re(k,i,j,i_hi) = ( re_tmp(i_mp_qp ) * sum0(i_mp_qp ) &
4217  + re_tmp(i_mp_qcl) * sum0(i_mp_qcl) &
4218  + re_tmp(i_mp_qd ) * sum0(i_mp_qd ) ) &
4219  / ( sum0(i_mp_qp) + sum0(i_mp_qcl) + sum0(i_mp_qd) + eps )
4220  re(k,i,j,i_hs) = re_tmp(i_mp_qs)
4221  re(k,i,j,i_hg) = re_tmp(i_mp_qg)
4222  re(k,i,j,i_hh) = re_tmp(i_mp_qh)
4223 
4224  enddo
4225  enddo
4226  enddo
4227 
4228  end if
4229 
4230  return
scale_grid_index::is
integer, public is
start point of inner domain: x, local
Definition: scale_grid_index.F90:60
scale_grid_index::je
integer, public je
end point of inner domain: y, local
Definition: scale_grid_index.F90:63
scale_grid_index::ke
integer, public ke
end point of inner domain: z, local
Definition: scale_grid_index.F90:59
scale_grid_index
module grid index
Definition: scale_grid_index.F90:14
scale_tracer
module TRACER
Definition: scale_tracer.F90:15
scale_atmos_hydrometeor
module Hydrometeor
Definition: scale_atmos_sub_hydrometeor.F90:14
scale_grid_index::js
integer, public js
start point of inner domain: y, local
Definition: scale_grid_index.F90:62
scale_const
module CONSTANT
Definition: scale_const.F90:14
scale_grid_index::ks
integer, public ks
start point of inner domain: z, local
Definition: scale_grid_index.F90:58
scale_grid_index::ie
integer, public ie
end point of inner domain: x, local
Definition: scale_grid_index.F90:61
scale_const::const_eps
real(rp), public const_eps
small number
Definition: scale_const.F90:36
Here is the caller graph for this function:

◆ atmos_phy_mp_suzuki10_mixingratio()

subroutine, public scale_atmos_phy_mp_suzuki10::atmos_phy_mp_suzuki10_mixingratio ( real(rp), dimension (ka,ia,ja,n_hyd), intent(out)  Qe,
real(rp), dimension(ka,ia,ja,qa), intent(in)  QTRC0 
)

Calculate mixing ratio of each category.

Definition at line 4238 of file scale_atmos_phy_mp_suzuki10.F90.

References scale_const::const_eps, scale_atmos_hydrometeor::i_hc, scale_atmos_hydrometeor::i_hg, scale_atmos_hydrometeor::i_hh, scale_atmos_hydrometeor::i_hi, scale_atmos_hydrometeor::i_hr, scale_atmos_hydrometeor::i_hs, scale_grid_index::ie, scale_grid_index::is, scale_grid_index::je, scale_grid_index::js, scale_grid_index::ke, scale_grid_index::ks, scale_atmos_hydrometeor::n_hyd, nbin, nspc, and scale_tracer::qa.

Referenced by scale_atmos_phy_mp::atmos_phy_mp_config().

4238  use scale_grid_index
4239  use scale_const, only: &
4240  eps => const_eps
4241  use scale_tracer, only: &
4242  qa
4243  use scale_atmos_hydrometeor, only: &
4244  n_hyd, &
4245  i_hc, &
4246  i_hr, &
4247  i_hi, &
4248  i_hs, &
4249  i_hg, &
4250  i_hh
4251  implicit none
4252 
4253  real(RP), intent(out) :: Qe (KA,IA,JA,N_HYD) ! mixing ratio of each cateory [kg/kg]
4254  real(RP), intent(in) :: QTRC0(KA,IA,JA,QA) ! tracer mass concentration [kg/kg]
4255 
4256  real(RP) :: sum2
4257  integer :: i, j, k, iq, ihydro
4258  !---------------------------------------------------------------------------
4259 
4260 
4261  do k = ks, ke
4262  do j = js, je
4263  do i = is, ie
4264 
4265  qe(k,i,j,:) = 0.0_rp
4266 
4267  ! HC
4268  sum2 = 0.0_rp
4269  do iq = qs_mp+1, qs_mp+nbnd
4270  sum2 = sum2 + qtrc0(k,i,j,iq)
4271  enddo
4272  qe(k,i,j,i_hc) = sum2
4273 
4274  ! HR
4275  sum2 = 0.0_rp
4276  do iq = qs_mp+nbnd+1, qs_mp+nbin
4277  sum2 = sum2 + qtrc0(k,i,j,iq)
4278  enddo
4279  qe(k,i,j,i_hr) = sum2
4280 
4281  enddo
4282  enddo
4283  enddo
4284 
4285  ! other hydrometeors
4286  if ( nspc > 1 ) then
4287 
4288  do k = ks, ke
4289  do j = js, je
4290  do i = is, ie
4291  ! HI
4292  sum2 = 0.0_rp
4293  do ihydro = i_mp_qp, i_mp_qd
4294  do iq = qs_mp+nbin*(ihydro-1)+1, qs_mp+nbin*ihydro
4295  sum2 = sum2 + qtrc0(k,i,j,iq)
4296  enddo
4297  enddo
4298  qe(k,i,j,i_hi) = sum2
4299 
4300  ! HS
4301  sum2 = 0.0_rp
4302  ihydro = i_mp_qs
4303  do iq = qs_mp+nbin*(ihydro-1)+1, qs_mp+nbin*ihydro
4304  sum2 = sum2 + qtrc0(k,i,j,iq)
4305  enddo
4306  qe(k,i,j,i_hs) = sum2
4307 
4308  ! HG
4309  sum2 = 0.0_rp
4310  ihydro = i_mp_qg
4311  do iq = qs_mp+nbin*(ihydro-1)+1, qs_mp+nbin*ihydro
4312  sum2 = sum2 + qtrc0(k,i,j,iq)
4313  enddo
4314  qe(k,i,j,i_hg) = sum2
4315 
4316  ! HS
4317  sum2 = 0.0_rp
4318  ihydro = i_mp_qh
4319  do iq = qs_mp+nbin*(ihydro-1)+1, qs_mp+nbin*ihydro
4320  sum2 = sum2 + qtrc0(k,i,j,iq)
4321  enddo
4322  qe(k,i,j,i_hh) = sum2
4323 
4324  enddo
4325  enddo
4326  enddo
4327  endif
4328 
4329  return
scale_grid_index::is
integer, public is
start point of inner domain: x, local
Definition: scale_grid_index.F90:60
scale_grid_index::je
integer, public je
end point of inner domain: y, local
Definition: scale_grid_index.F90:63
scale_grid_index::ke
integer, public ke
end point of inner domain: z, local
Definition: scale_grid_index.F90:59
scale_grid_index
module grid index
Definition: scale_grid_index.F90:14
scale_tracer
module TRACER
Definition: scale_tracer.F90:15
scale_atmos_hydrometeor
module Hydrometeor
Definition: scale_atmos_sub_hydrometeor.F90:14
scale_grid_index::js
integer, public js
start point of inner domain: y, local
Definition: scale_grid_index.F90:62
scale_const
module CONSTANT
Definition: scale_const.F90:14
scale_grid_index::ks
integer, public ks
start point of inner domain: z, local
Definition: scale_grid_index.F90:58
scale_grid_index::ie
integer, public ie
end point of inner domain: x, local
Definition: scale_grid_index.F90:61
scale_const::const_eps
real(rp), public const_eps
small number
Definition: scale_const.F90:36
Here is the caller graph for this function:

◆ mkpara()

subroutine scale_atmos_phy_mp_suzuki10::mkpara ( )

Definition at line 4337 of file scale_atmos_phy_mp_suzuki10.F90.

References scale_stdio::io_fid_log, scale_stdio::io_l, kphase, and nbin.

Referenced by atmos_phy_mp_suzuki10_setup().

4337 
4338  implicit none
4339 
4340  integer :: i, j
4341  !-----------------------------------------------------------------------------
4342 
4343  allocate( radc_mk( nbin ) )
4344  allocate( xctr_mk( nbin ) )
4345  allocate( xbnd_mk( nbin+1 ) )
4346  allocate( cctr_mk( nspc_mk,nbin ) )
4347  allocate( cbnd_mk( nspc_mk,nbin+1 ) )
4348  allocate( ck_mk( nspc_mk,nspc_mk,nbin,nbin ) )
4349  allocate( vt_mk( nspc_mk,nbin ) )
4350  allocate( br_mk( nspc_mk,nbin ) )
4351 
4352  !--- file reading
4353  call rdkdat
4354 
4355  !--- grid setting
4356  call sdfgrid
4357 
4358  !--- capacity
4359  call getcp
4360 
4361  !--- collection kernel
4362  call getck
4363 
4364  !--- terminal velocity
4365  call getvt
4366 
4367  !--- bulk radius
4368  call getbr
4369 
4370  !--- output
4371  call paraout
4372 
4373  deallocate( radc_mk )
4374  deallocate( xctr_mk )
4375  deallocate( xbnd_mk )
4376  deallocate( cctr_mk )
4377  deallocate( cbnd_mk )
4378  deallocate( ck_mk )
4379  deallocate( vt_mk )
4380  deallocate( br_mk )
4381 
Here is the caller graph for this function:

Variable Documentation

◆ atmos_phy_mp_suzuki10_name

character(len=h_short), dimension(:), allocatable, target, public scale_atmos_phy_mp_suzuki10::atmos_phy_mp_suzuki10_name

Definition at line 103 of file scale_atmos_phy_mp_suzuki10.F90.

Referenced by scale_atmos_phy_mp::atmos_phy_mp_config(), and atmos_phy_mp_suzuki10_config().

103  character(len=H_SHORT), public, target, allocatable :: ATMOS_PHY_MP_suzuki10_NAME(:)

◆ atmos_phy_mp_suzuki10_desc

character(len=h_mid), dimension(:), allocatable, target, public scale_atmos_phy_mp_suzuki10::atmos_phy_mp_suzuki10_desc

Definition at line 104 of file scale_atmos_phy_mp_suzuki10.F90.

Referenced by scale_atmos_phy_mp::atmos_phy_mp_config(), and atmos_phy_mp_suzuki10_config().

104  character(len=H_MID) , public, target, allocatable :: ATMOS_PHY_MP_suzuki10_DESC(:)

◆ atmos_phy_mp_suzuki10_unit

character(len=h_short), dimension(:), allocatable, target, public scale_atmos_phy_mp_suzuki10::atmos_phy_mp_suzuki10_unit

Definition at line 105 of file scale_atmos_phy_mp_suzuki10.F90.

Referenced by scale_atmos_phy_mp::atmos_phy_mp_config(), and atmos_phy_mp_suzuki10_config().

105  character(len=H_SHORT), public, target, allocatable :: ATMOS_PHY_MP_suzuki10_UNIT(:)

◆ atmos_phy_mp_suzuki10_dens

real(rp), dimension(n_hyd), target, public scale_atmos_phy_mp_suzuki10::atmos_phy_mp_suzuki10_dens

Definition at line 107 of file scale_atmos_phy_mp_suzuki10.F90.

Referenced by scale_atmos_phy_mp::atmos_phy_mp_config(), and atmos_phy_mp_suzuki10_setup().

107  real(RP), public, target :: ATMOS_PHY_MP_suzuki10_DENS(N_HYD) ! hydrometeor density [kg/m3]=[g/L]

◆ nbin

integer, public scale_atmos_phy_mp_suzuki10::nbin = 33

Definition at line 109 of file scale_atmos_phy_mp_suzuki10.F90.

Referenced by scale_atmos_phy_mp_convert::atmos_phy_mp_bulk2bin(), atmos_phy_mp_suzuki10(), atmos_phy_mp_suzuki10_cloudfraction(), atmos_phy_mp_suzuki10_config(), atmos_phy_mp_suzuki10_effectiveradius(), atmos_phy_mp_suzuki10_mixingratio(), atmos_phy_mp_suzuki10_setup(), mkpara(), mp_suzuki10(), and mod_mkinit::rect_setup().

109  integer, public :: nbin = 33

◆ nspc

integer, public scale_atmos_phy_mp_suzuki10::nspc = 7

Definition at line 110 of file scale_atmos_phy_mp_suzuki10.F90.

Referenced by scale_atmos_phy_mp_convert::atmos_phy_mp_bulk2bin(), atmos_phy_mp_suzuki10(), atmos_phy_mp_suzuki10_cloudfraction(), atmos_phy_mp_suzuki10_config(), atmos_phy_mp_suzuki10_effectiveradius(), atmos_phy_mp_suzuki10_mixingratio(), and atmos_phy_mp_suzuki10_setup().

110  integer, public :: nspc = 7

◆ nccn

integer, public scale_atmos_phy_mp_suzuki10::nccn = 0

Definition at line 111 of file scale_atmos_phy_mp_suzuki10.F90.

Referenced by atmos_phy_mp_suzuki10(), atmos_phy_mp_suzuki10_config(), atmos_phy_mp_suzuki10_setup(), mp_suzuki10(), mod_mkinit::read_sounding(), and mod_mkinit::rect_setup().

111  integer, public :: nccn = 0

◆ nccn1

integer, public scale_atmos_phy_mp_suzuki10::nccn1 = 0

Definition at line 112 of file scale_atmos_phy_mp_suzuki10.F90.

Referenced by atmos_phy_mp_suzuki10_config().

112  integer, public :: nccn1 = 0

◆ kphase

integer, public scale_atmos_phy_mp_suzuki10::kphase = 0

Definition at line 113 of file scale_atmos_phy_mp_suzuki10.F90.

Referenced by atmos_phy_mp_suzuki10_config(), and mkpara().

113  integer, public :: kphase = 0

◆ iceflg

integer, public scale_atmos_phy_mp_suzuki10::iceflg = 1

Definition at line 114 of file scale_atmos_phy_mp_suzuki10.F90.

Referenced by atmos_phy_mp_suzuki10_config().

114  integer, public :: ICEFLG = 1
Generated by   doxygen 1.8.14