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_tracer_setup
 Config. More...
 
subroutine, public atmos_phy_mp_suzuki10_setup (KA, IA, JA, flg_lt)
 Setup. More...
 
subroutine, public atmos_phy_mp_suzuki10_tendency (KA, KS, KE, IA, IS, IE, JA, JS, JE, KIJMAX, dt, DENS, PRES, TEMP, QTRC, QDRY, CPtot, CVtot, CCN, RHOQ_t, RHOE_t, CPtot_t, CVtot_t, EVAPORATE, flg_lt, d0_crg, v0_crg, dqcrg, beta_crg, QTRC_crg, QSPLT_in, Sarea, RHOC_t_mp)
 Cloud Microphysics. More...
 
subroutine, public atmos_phy_mp_suzuki10_terminal_velocity (KA, vterm_o)
 get terminal velocity More...
 
subroutine, public atmos_phy_mp_suzuki10_cloud_fraction (KA, KS, KE, IA, IS, IE, JA, JS, JE, QTRC0, mask_criterion, cldfrac)
 Calculate Cloud Fraction. More...
 
subroutine, public atmos_phy_mp_suzuki10_effective_radius (KA, KS, KE, IA, IS, IE, JA, JS, JE, DENS0, TEMP0, QTRC0, Re)
 Calculate Effective Radius. More...
 
subroutine, public atmos_phy_mp_suzuki10_qtrc2qhyd (KA, KS, KE, IA, IS, IE, JA, JS, JE, QTRC0, Qe)
 Calculate mass ratio of each category. More...
 
subroutine, public atmos_phy_mp_suzuki10_qtrc2nhyd (KA, KS, KE, IA, IS, IE, JA, JS, JE, DENS, QTRC0, Ne)
 Calculate number concentration of each category. More...
 
subroutine, public atmos_phy_mp_suzuki10_qhyd2qtrc (KA, KS, KE, IA, IS, IE, JA, JS, JE, Qe, QTRC, QNUM)
 get mass ratio of each category More...
 
subroutine, public atmos_phy_mp_suzuki10_crg_qtrc2qhyd (KA, KS, KE, IA, IS, IE, JA, JS, JE, QTRC0, Qecrg)
 get charge density ratio of each category More...
 

Variables

integer, public atmos_phy_mp_suzuki10_ntracers
 
integer, public atmos_phy_mp_suzuki10_nwaters
 
integer, public atmos_phy_mp_suzuki10_nices
 
integer, public atmos_phy_mp_suzuki10_nccn
 
integer, public atmos_phy_mp_suzuki10_nbnd
 
character(len=h_short), dimension(:), allocatable, public atmos_phy_mp_suzuki10_tracer_names
 
character(len=h_mid), dimension(:), allocatable, public atmos_phy_mp_suzuki10_tracer_descriptions
 
character(len=h_short), dimension(:), allocatable, public atmos_phy_mp_suzuki10_tracer_units
 
integer, public nbin = 33
 
integer, public nccn = 0
 

Detailed Description

module Spectran Bin Microphysics

Description:
This module contains subroutines for the Spectral Bin Model
Author
: Team SCALE
NAMELIST
  • PARAM_ATMOS_PHY_MP_SUZUKI10_bin
    nametypedefault valuecomment
    NBIN integer 33 tentatively public
    NCCN integer 0 tentatively public
    ICEFLG integer 1
    KPHASE integer 0

  • PARAM_ATMOS_PHY_MP_SUZUKI10
    nametypedefault valuecomment
    MP_DOAUTOCONVERSION logical .true. apply collision process ?
    MP_COUPLE_AEROSOL logical .false. apply CCN effect?
    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 .false. — flag of regeneration
    S10_FLAG_NUCLEAT logical .false. — flag of regeneration
    S10_FLAG_ICENUCLEAT logical .false. — flag of ice nucleation
    S10_FLAG_SFAERO logical .false. — flag of surface flux of aeorol
    S10_FLAG_RNDM logical .false. — flag for sthastic integration for coll.-coag.
    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
    N0_ICENUCL real(RP) 1.E+3_RP N0 of Meyer et al. (1992)
    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))
    ECOAL_GSI real(RP) 0.0_RP

History Output
No history output

Function/Subroutine Documentation

◆ atmos_phy_mp_suzuki10_tracer_setup()

subroutine, public scale_atmos_phy_mp_suzuki10::atmos_phy_mp_suzuki10_tracer_setup

Config.

Definition at line 299 of file scale_atmos_phy_mp_suzuki10.F90.

299  use scale_prc, only: &
300  prc_abort
301  implicit none
302 
303  namelist / param_atmos_phy_mp_suzuki10_bin / &
304  nbin, &
305  nccn, &
306  iceflg, &
307  kphase
308 
309  integer :: m, n, ierr
310  !---------------------------------------------------------------------------
311 
312  log_newline
313  log_info("ATMOS_PHY_MP_suzuki10_tracer_setup",*) 'Setup'
314  log_info("ATMOS_PHY_MP_suzuki10_tracer_setup",*) 'Tracers setup for Suzuki (2010) Spectral BIN model'
315 
316  log_newline
317  log_info("ATMOS_PHY_MP_suzuki10_tracer_setup",*) 'READ BIN NUMBER'
318 
319  rewind(io_fid_conf)
320  read(io_fid_conf,nml=param_atmos_phy_mp_suzuki10_bin,iostat=ierr)
321 
322  if( ierr < 0 ) then !--- missing
323  log_info("ATMOS_PHY_MP_suzuki10_tracer_setup",*) 'Not found namelist. Default used.'
324  elseif( ierr > 0 ) then !--- fatal error
325  log_error("ATMOS_PHY_MP_suzuki10_tracer_setup",*) 'Not appropriate names in namelist PARAM_ATMOS_PHY_MP_SUZUKI10_bin, Check!'
326  call prc_abort
327  end if
328 
329  log_nml(param_atmos_phy_mp_suzuki10_bin)
330 
331  if( iceflg == 0 ) then
332  nspc = 1
333  elseif( iceflg == 1 ) then
334  nspc = 7
335  else
336  log_error("ATMOS_PHY_MP_suzuki10_tracer_setup",*) "ICEFLG should be 0 (warm rain) or 1 (mixed rain) check!!"
337  call prc_abort
338  endif
339 
340  atmos_phy_mp_suzuki10_ntracers = 1 + nbin*nspc + nccn ! number of total tracers
341  atmos_phy_mp_suzuki10_nwaters = nbin ! number of liquid water
342  atmos_phy_mp_suzuki10_nices = nbin * ( nspc - 1 ) ! number of ice water
343  atmos_phy_mp_suzuki10_nccn = nccn ! number of ccn
344 
345  num_hyd = nbin * nspc
346 
347  num_start_waters = i_qv + 1
348  num_end_waters = i_qv + atmos_phy_mp_suzuki10_nwaters
349  num_start_ices = num_end_waters + 1
350  num_end_ices = num_end_waters + atmos_phy_mp_suzuki10_nices
351 
352  qa = atmos_phy_mp_suzuki10_ntracers
353 
354  allocate( atmos_phy_mp_suzuki10_tracer_names(qa) )
355  allocate( atmos_phy_mp_suzuki10_tracer_descriptions(qa) )
356  allocate( atmos_phy_mp_suzuki10_tracer_units(qa) )
357 
358  !---------------------------------------------------------------------------
359  !
360  !++ calculate each category and aerosol
361  !
362  !---------------------------------------------------------------------------
363 
364  do n = 1, qa
365  write(atmos_phy_mp_suzuki10_tracer_units(n),'(a)') 'kg/kg'
366  enddo
367 
368  write(atmos_phy_mp_suzuki10_tracer_names(1),'(a)') 'QV'
369  write(atmos_phy_mp_suzuki10_tracer_descriptions(1),'(a)') 'Water Vapor mixing ratio'
370 
371  do m = 1, nspc
372  do n = 1, nbin
373  write(atmos_phy_mp_suzuki10_tracer_names(1+nbin*(m-1)+n),'(a,i0)') trim(namspc(m)), n
374  write(atmos_phy_mp_suzuki10_tracer_descriptions(1+nbin*(m-1)+n),'(a,i0)') trim(lnamspc(m)), n
375  enddo
376  enddo
377 
378  do n = 1, nccn
379  write(atmos_phy_mp_suzuki10_tracer_names(1+nbin*nspc+n),'(a,i0)') trim(namspc(8)), n
380  write(atmos_phy_mp_suzuki10_tracer_descriptions(1+nbin*nspc+n),'(a,i0)') trim(lnamspc(8)), n
381  enddo
382 
383  return

References atmos_phy_mp_suzuki10_nccn, atmos_phy_mp_suzuki10_nices, atmos_phy_mp_suzuki10_ntracers, atmos_phy_mp_suzuki10_nwaters, atmos_phy_mp_suzuki10_tracer_descriptions, atmos_phy_mp_suzuki10_tracer_names, atmos_phy_mp_suzuki10_tracer_units, scale_io::io_fid_conf, nbin, nccn, and scale_prc::prc_abort().

Referenced by mod_atmos_phy_mp_driver::atmos_phy_mp_driver_tracer_setup().

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 ( integer, intent(in)  KA,
integer, intent(in)  IA,
integer, intent(in)  JA,
logical, intent(in), optional  flg_lt 
)

Setup.

Definition at line 391 of file scale_atmos_phy_mp_suzuki10.F90.

391  use scale_prc, only: &
392  prc_abort, &
393  prc_masterrank, &
395  use scale_const, only: &
396  pi => const_pi, &
397  dwatr => const_dwatr, &
398  dice => const_dice
399  use scale_comm_cartesc, only: &
400  comm_bcast
401  use scale_atmos_hydrometeor, only: &
402  i_hc, &
403  i_hr, &
404  i_hi, &
405  i_hs, &
406  i_hg, &
407  i_hh
408  implicit none
409 
410  integer, intent(in) :: KA
411  integer, intent(in) :: IA
412  integer, intent(in) :: JA
413  logical, intent(in), optional :: flg_lt
414 
415  real(RP) :: RHO_AERO !--- density of aerosol
416  real(RP) :: R0_AERO !--- center radius of aerosol (um)
417  real(RP) :: R_MIN !--- minimum radius of aerosol (um)
418  real(RP) :: R_MAX !--- maximum radius of aerosol (um)
419  real(RP) :: S10_EMAER !--- moleculer weight of aerosol
420 
421  logical :: S10_FLAG_REGENE = .false. !--- flag of regeneration
422  logical :: S10_FLAG_NUCLEAT = .false. !--- flag of regeneration
423  logical :: S10_FLAG_ICENUCLEAT = .false. !--- flag of ice nucleation
424  logical :: S10_FLAG_SFAERO = .false. !--- flag of surface flux of aeorol
425  logical :: S10_FLAG_RNDM = .false. !--- flag for sthastic integration for coll.-coag.
426  integer :: S10_RNDM_MSPC
427  integer :: S10_RNDM_MBIN
428 
429  namelist / param_atmos_phy_mp_suzuki10 / &
430  mp_doautoconversion, &
431  mp_couple_aerosol, &
432  rho_aero, &
433  r_min, &
434  r_max, &
435  r0_aero, &
436  s10_emaer, &
437  s10_flag_regene, &
438  s10_flag_nucleat, &
439  s10_flag_icenucleat, &
440  s10_flag_sfaero, &
441  s10_flag_rndm, &
442  s10_rndm_mspc, &
443  s10_rndm_mbin, &
444  c_ccn, kappa, &
445  n0_icenucl, &
446  sigma, vhfct, &
447  ecoal_gsi
448 
449  real(RP), parameter :: max_term_vel = 10.0_rp !-- terminal velocity for calculate dt of sedimentation
450 
451  logical :: flg_lt_
452  integer :: nnspc, nnbin
453  integer :: nn, mm, mmyu, nnyu
454  integer :: myu, nyu, i, j, k, n, ierr
455  !---------------------------------------------------------------------------
456 
457  log_newline
458  log_info("ATMOS_PHY_MP_suzuki10_setup",*) 'Setup'
459  log_info("ATMOS_PHY_MP_suzuki10_setup",*) 'Suzuki (2010) Spectral BIN model'
460 
461  !--- allocation
462  allocate( xctr( nbin ) )
463  allocate( xbnd( nbin+1 ) )
464  allocate( radc( nbin ) )
465  allocate( cctr( nbin,nspc_mk ) )
466  allocate( cbnd( nbin+1,nspc_mk ) )
467  allocate( ck( nspc_mk,nspc_mk,nbin,nbin ) )
468  allocate( vt( nspc_mk,nbin ) )
469  allocate( br( nspc_mk,nbin ) )
470  allocate( ifrsl( 2,nspc_mk,nspc_mk ) )
471  allocate( expxctr( nbin ) )
472  allocate( expxbnd( nbin+1 ) )
473  allocate( rexpxctr( nbin ) )
474  allocate( rexpxbnd( nbin+1 ) )
475  if ( nccn /= 0 ) then
476  allocate( xactr( nccn ) )
477  allocate( xabnd( nccn+1 ) )
478  allocate( rada( nccn ) )
479  allocate( expxactr( nccn ) )
480  allocate( expxabnd( nccn+1 ) )
481  allocate( rexpxactr( nccn ) )
482  allocate( rexpxabnd( nccn+1 ) )
483  endif
484 
485  mbin = nbin/2
486  mspc = nspc_mk*nspc_mk
487 
488  rho_aero = rhoa
489  s10_emaer = emaer
490  r_min = rasta
491  r_max = raend
492  r0_aero = r0a
493  s10_rndm_mspc = mspc
494  s10_rndm_mbin = mbin
495 
496  rewind(io_fid_conf)
497  read(io_fid_conf,nml=param_atmos_phy_mp_suzuki10,iostat=ierr)
498 
499  if ( ierr < 0 ) then !--- missing
500  log_info("ATMOS_PHY_MP_suzuki10_setup",*) 'Not found namelist. Default used.'
501  elseif( ierr > 0 ) then !--- fatal error
502  log_error("ATMOS_PHY_MP_suzuki10_setup",*) 'Not appropriate names in namelist PARAM_ATMOS_PHY_MP_SUZUKI10, Check!'
503  call prc_abort
504  endif
505  log_nml(param_atmos_phy_mp_suzuki10)
506 
507  if ( nspc /= 1 .AND. nspc /= 7 ) then
508  log_error("ATMOS_PHY_MP_suzuki10_setup",*) 'nspc should be set as 1 (warm rain) or 7 (mixed phase) check!'
509  call prc_abort
510  endif
511 
512  rhoa = rho_aero
513  emaer = s10_emaer
514  rasta = r_min
515  raend = r_max
516  r0a = r0_aero
517  flg_regeneration = s10_flag_regene
518  flg_nucl = s10_flag_nucleat
519  flg_icenucl = s10_flag_icenucleat
520  flg_sf_aero = s10_flag_sfaero
521  flg_rndm = s10_flag_rndm
522  mspc = s10_rndm_mspc
523  mbin = s10_rndm_mbin
524 
525  !--- read micpara.dat (microphysical parameter) and broad cast
526  if ( prc_ismaster ) then
527 
528  fid_micpara = io_get_available_fid()
529  !--- open parameter of cloud microphysics
530  open ( fid_micpara, file = fname_micpara, form = 'formatted', status = 'old', iostat=ierr )
531 
532  !--- micpara.dat does not exist
533  if ( ierr == 0 ) then
534 
535  read( fid_micpara,* ) nnspc, nnbin
536 
537  if ( nnbin /= nbin ) then
538  log_error("ATMOS_PHY_MP_suzuki10_setup",*) 'nbin in namelist and nbin in micpara.dat is different check!'
539  call prc_abort
540  endif
541 
542  ! grid parameter
543  log_info("ATMOS_PHY_MP_suzuki10_setup",*) 'Radius of cloud *'
544  do n = 1, nbin
545  read( fid_micpara,* ) nn, xctr( n ), radc( n )
546  log_info("ATMOS_PHY_MP_suzuki10_setup",'(A,1x,I3,1x,A,1x,ES15.7,1x,A)') &
547  "Radius of ", n, "th cloud bin (bin center)= ", radc( n ) , "[m]"
548  enddo
549  do n = 1, nbin+1
550  read( fid_micpara,* ) nn, xbnd( n )
551  enddo
552  read( fid_micpara,* ) dxmic
553  log_info("ATMOS_PHY_MP_suzuki10_setup",*) 'Width of Cloud SDF= ', dxmic
554 
555  ! capacity
556  do myu = 1, nspc_mk
557  do n = 1, nbin
558 ! read( fid_micpara,* ) mmyu, nn, cctr( myu,n )
559  read( fid_micpara,* ) mmyu, nn, cctr( n,myu )
560  enddo
561  do n = 1, nbin+1
562 ! read( fid_micpara,* ) mmyu, nn, cbnd( myu,n )
563  read( fid_micpara,* ) mmyu, nn, cbnd( n,myu )
564  enddo
565  enddo
566 
567  ! collection kernel
568  do myu = 1, nspc_mk
569  do nyu = 1, nspc_mk
570  do i = 1, nbin
571  do j = 1, nbin
572  read( fid_micpara,* ) mmyu, nnyu, mm, nn, ck( myu,nyu,i,j )
573  enddo
574  enddo
575  enddo
576  enddo
577 
578  ! terminal velocity
579  do myu = 1, nspc_mk
580  do n = 1, nbin
581  read( fid_micpara,* ) mmyu, nn, vt( myu,n )
582  enddo
583  enddo
584 
585  ! bulk density
586  do myu = 1, nspc_mk
587  do n = 1, nbin
588  read( fid_micpara,* ) mmyu, nn, br( myu,n )
589  enddo
590  enddo
591 
592  close ( fid_micpara )
593 
594  !--- micpara.dat does not exist
595  else
596 
597  log_info("ATMOS_PHY_MP_suzuki10_setup",*) 'micpara.dat is created'
598  call mkpara
599 
600  fid_micpara = io_get_available_fid()
601  !--- open parameter of cloud microphysics
602  open ( fid_micpara, file = fname_micpara, form = 'formatted', status = 'old', iostat=ierr )
603 
604  read( fid_micpara,* ) nnspc, nnbin
605 
606  if ( nnbin /= nbin ) then
607  log_error("ATMOS_PHY_MP_suzuki10_setup",*) 'nbin in inc_tracer and nbin in micpara.dat is different check!'
608  call prc_abort
609  endif
610 
611  ! grid parameter
612  log_info("ATMOS_PHY_MP_suzuki10_setup",*) 'Radius of cloud *'
613  do n = 1, nbin
614  read( fid_micpara,* ) nn, xctr( n ), radc( n )
615  log_info("ATMOS_PHY_MP_suzuki10_setup",'(A,1x,I3,1x,A,1x,ES15.7,1x,A)') &
616  "Radius of ", n, "th cloud bin (bin center)= ", radc( n ) , "[m]"
617  enddo
618  do n = 1, nbin+1
619  read( fid_micpara,* ) nn, xbnd( n )
620  enddo
621  read( fid_micpara,* ) dxmic
622  log_info("ATMOS_PHY_MP_suzuki10_setup",*) 'Width of Cloud SDF= ', dxmic
623 
624  ! capacity
625  do myu = 1, nspc_mk
626  do n = 1, nbin
627 ! read( fid_micpara,* ) mmyu, nn, cctr( myu,n )
628  read( fid_micpara,* ) mmyu, nn, cctr( n,myu )
629  enddo
630  do n = 1, nbin+1
631 ! read( fid_micpara,* ) mmyu, nn, cbnd( myu,n )
632  read( fid_micpara,* ) mmyu, nn, cbnd( n,myu )
633  enddo
634  enddo
635 
636  ! collection kernel
637  do myu = 1, nspc_mk
638  do nyu = 1, nspc_mk
639  do i = 1, nbin
640  do j = 1, nbin
641  read( fid_micpara,* ) mmyu, nnyu, mm, nn, ck( myu,nyu,i,j )
642  enddo
643  enddo
644  enddo
645  enddo
646 
647  ! terminal velocity
648  do myu = 1, nspc_mk
649  do n = 1, nbin
650  read( fid_micpara,* ) mmyu, nn, vt( myu,n )
651  enddo
652  enddo
653 
654  ! bulk density
655  do myu = 1, nspc_mk
656  do n = 1, nbin
657  read( fid_micpara,* ) mmyu, nn, br( myu,n )
658  enddo
659  enddo
660 
661  close ( fid_micpara )
662 
663  endif
664 
665  endif
666 
667  call comm_bcast( radc(:), nbin )
668  call comm_bcast( xctr(:), nbin )
669  call comm_bcast( dxmic )
670  call comm_bcast( xbnd(:), nbin+1 )
671  call comm_bcast( cctr(:,:), nbin, nspc_mk )
672  call comm_bcast( cbnd(:,:), nbin+1, nspc_mk )
673  call comm_bcast( ck(:,:,:,:), nspc_mk, nspc_mk, nbin, nbin )
674  call comm_bcast( br(:,:), nspc_mk, nbin )
675  call comm_bcast( vt(:,:), nspc_mk, nbin )
676 
677  allocate( flg_noninduct( nspc,nspc ) )
678  allocate( ecoll( nspc,nspc,nbin,nbin ) )
679  allocate( rcoll( nspc,nspc,nbin,nbin ) )
680  flg_noninduct(:,:) = 0.0_rp
681  ecoll( :,:,:,: ) = 0.0_rp
682  rcoll( :,:,:,: ) = 0.0_rp
683 
684  if ( present(flg_lt) ) then
685  flg_lt_ = flg_lt
686  else
687  flg_lt_ = .false.
688  end if
689  if( flg_lt_ ) then
690 
691  do myu = 1, nspc
692  do nyu = 1, nspc
693  if( ( myu >= ic .and. myu <= iss ) .and. ( nyu == ig .or. nyu == ih ) ) then
694  flg_noninduct( myu,nyu ) = 1.0_rp
695  endif
696  enddo
697  enddo
698 
699  do myu = 1, nspc
700  do nyu = 1, nspc
701  do i = 1, nbin
702  do j = 1, nbin
703  if( vt( myu,i ) /= vt( nyu,j ) ) then
704  ecoll( myu,nyu,i,j ) = ck( myu,nyu,i,j ) &
705  / ( pi*( radc( i )+radc( j ) )**2 * abs( vt( myu,i )-vt( nyu,j ) ) )
706  ecoll( myu,nyu,i,j ) = max( min( 1.0_rp, ecoll( myu,nyu,i,j ) ),0.0_rp )
707  else
708  ecoll( myu,nyu,i,j ) = 0.0_rp
709  endif
710 
711  if( ecoal_gsi /= 0.0_rp ) then
712  ecoll( myu,nyu,i,j ) = ecoal_gsi
713  endif
714 
715  if( ecoll( myu,nyu,i,j ) /= 0.0_rp ) then
716  rcoll( myu,nyu,i,j ) = ( 1.0_rp-ecoll( myu,nyu,i,j ) ) / ecoll( myu,nyu,i,j )
717  elseif( ecoll( myu,nyu,i,j ) == 0.0_rp ) then
718  rcoll( myu,nyu,i,j ) = 1.0_rp
719  endif
720  enddo
721  enddo
722  enddo
723  enddo
724 
725  endif
726 
727  !--- aerosol ( CCN ) (not supported)
728  if ( nccn /= 0 ) then
729 
730  allocate ( ncld( 1:nccn ) )
731  xasta = log( rhoa*4.0_rp/3.0_rp*pi * ( rasta )**3 )
732  xaend = log( rhoa*4.0_rp/3.0_rp*pi * ( raend )**3 )
733 
734  dxaer = ( xaend-xasta )/nccn
735 
736  do n = 1, nccn+1
737  xabnd( n ) = xasta + dxaer*( n-1 )
738  enddo
739  do n = 1, nccn
740  xactr( n ) = ( xabnd( n )+xabnd( n+1 ) )*0.50_rp
741  rada( n ) = ( exp( xactr( n ) )*thirdovforth/pi/rhoa )**( oneovthird )
742  log_info("ATMOS_PHY_MP_suzuki10_setup",'(A,1x,I3,1x,A,1x,ES15.7,1x,A)') &
743  "Radius of ", n, "th aerosol bin (bin center)= ", rada( n ) , "[m]"
744  enddo
745 
746  if ( flg_sf_aero ) then
747  log_error("ATMOS_PHY_MP_suzuki10_setup",*) "flg_sf_aero=true is not supported stop!! "
748  call prc_abort
749 ! if ( CZ(KS) >= 10.0_RP ) then
750 ! R10M1 = 10.0_RP / CZ(KS) * 0.50_RP ! scale with height
751 ! R10M2 = 10.0_RP / CZ(KS) * 0.50_RP ! scale with height
752 ! R10H1 = 1.0_RP * 0.50_RP
753 ! R10H2 = 1.0_RP * 0.0_RP
754 ! R10E1 = 1.0_RP * 0.50_RP
755 ! R10E2 = 1.0_RP * 0.50_RP
756 ! K10_1 = KS
757 ! K10_2 = KS
758 ! else
759 ! k = 1
760 ! do while ( CZ(k) < 10.0_RP )
761 ! k = k + 1
762 ! K10_1 = k
763 ! K10_2 = k + 1
764 ! R10M1 = ( CZ(k+1) - 10.0_RP ) / CDZ(k)
765 ! R10M2 = ( 10.0_RP - CZ(k) ) / CDZ(k)
766 ! R10H1 = ( CZ(k+1) - 10.0_RP ) / CDZ(k)
767 ! R10H2 = ( 10.0_RP - CZ(k) ) / CDZ(k)
768 ! R10E1 = ( CZ(k+1) - 10.0_RP ) / CDZ(k)
769 ! R10E2 = ( 10.0_RP - CZ(k) ) / CDZ(k)
770 ! enddo
771 ! endif
772  endif
773 
774  endif
775 
776  !--- determine nbnd
777  do n = 1, nbin
778  if( radc( n ) > rbnd ) then
779  nbnd = n
780  exit
781  endif
782  enddo
783  log_info("ATMOS_PHY_MP_suzuki10_setup",'(A,ES15.7,A)') 'Radius between cloud and rain is ', radc(nbnd), '[m]'
784  atmos_phy_mp_suzuki10_nbnd = nbnd
785 
786  !--- random number setup for stochastic method
787  if ( flg_rndm ) then
788  call random_setup( ia*ja*ka )
789  endif
790 
791  if ( mp_couple_aerosol .AND. nccn /=0 ) then
792  log_error("ATMOS_PHY_MP_suzuki10_setup",*) 'nccn should be 0 when MP_couple_aerosol = .true. !! stop'
793  call prc_abort
794  endif
795 
796  if ( nccn /= 0 ) then
797  do n = 1, nccn
798  expxactr( n ) = exp( xactr( n ) )
799  rexpxactr( n ) = 1.0_rp / exp( xactr( n ) )
800  enddo
801  do n = 1, nccn+1
802  expxabnd( n ) = exp( xabnd( n ) )
803  rexpxabnd( n ) = 1.0_rp / exp( xabnd( n ) )
804  enddo
805  endif
806 
807  allocate( vterm(qa-1) )
808  vterm(:) = 0.0_rp
809  do myu = 1, nspc
810  do n = 1, nbin
811  vterm((myu-1)*nbin+n) = -vt( myu,n )
812  enddo
813  enddo
814  do n = 1, nbin
815  expxctr( n ) = exp( xctr( n ) )
816  rexpxctr( n ) = 1.0_rp / exp( xctr( n ) )
817  enddo
818  do n = 1, nbin+1
819  expxbnd( n ) = exp( xbnd( n ) )
820  rexpxbnd( n ) = 1.0_rp / exp( xbnd( n ) )
821  enddo
822 
823  allocate( kindx(nbin,nbin) )
824  call getrule( ifrsl,kindx )
825 
826  !--- determine the parameters for interpolating SDF from qxx, Nxx of parent domain
827  sigma_sdf(1) = 0.2_rp
828  sigma_sdf(2) = 0.35_rp
829  sigma_sdf(3) = 0.35_rp
830  sigma_sdf(4) = 0.35_rp
831  sigma_sdf(5) = 0.35_rp
832  r0_sdf(1) = 5.e-6_rp
833  r0_sdf(2) = 2.61e-6_rp
834  r0_sdf(3) = 5.e-6_rp
835  r0_sdf(4) = 2.61e-6_rp
836  r0_sdf(5) = 2.61e-6_rp ! to be corrected
837  n0_sdf(1) = 8.0e+6_rp
838  n0_sdf(2) = 0.0_rp
839  n0_sdf(3) = 3.0e+6_rp
840  n0_sdf(4) = 4.0e+6_rp
841  n0_sdf(5) = 4.0e+6_rp ! to be corrected
842  rho_sdf(1) = dwatr
843  rho_sdf(2) = dice
844  rho_sdf(3) = 100.0_rp
845  rho_sdf(4) = 400.0_rp
846  rho_sdf(5) = 400.0_rp ! to be corrected
847 
848  !--- determine the parameters for interpolating SDF from qxx, Nxx of parent domain
849  sigma_sdf(1) = 0.2_rp
850  sigma_sdf(2) = 0.35_rp
851  sigma_sdf(3) = 0.35_rp
852  sigma_sdf(4) = 0.35_rp
853  sigma_sdf(5) = 0.35_rp
854  r0_sdf(1) = 5.e-6_rp
855  r0_sdf(2) = 2.61e-6_rp
856  r0_sdf(3) = 5.e-6_rp
857  r0_sdf(4) = 2.61e-6_rp
858  r0_sdf(5) = 2.61e-6_rp ! to be corrected
859  n0_sdf(1) = 8.0e+6_rp
860  n0_sdf(2) = 0.0_rp
861  n0_sdf(3) = 3.0e+6_rp
862  n0_sdf(4) = 4.0e+6_rp
863  n0_sdf(5) = 4.0e+6_rp ! to be corrected
864  rho_sdf(1) = dwatr
865  rho_sdf(2) = dice
866  rho_sdf(3) = 100.0_rp
867  rho_sdf(4) = 400.0_rp
868  rho_sdf(5) = 400.0_rp ! to be corrected
869 
870  return

References atmos_phy_mp_suzuki10_nbnd, scale_const::const_dice, scale_const::const_dwatr, scale_const::const_pi, 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_io::io_fid_conf, scale_io::io_get_available_fid(), nbin, nccn, scale_prc::prc_abort(), scale_prc::prc_ismaster, and scale_prc::prc_masterrank.

Referenced by mod_atmos_phy_mp_driver::atmos_phy_mp_driver_setup().

Here is the call graph for this function:
Here is the caller graph for this function:

◆ atmos_phy_mp_suzuki10_tendency()

subroutine, public scale_atmos_phy_mp_suzuki10::atmos_phy_mp_suzuki10_tendency ( 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,
integer, intent(in)  KIJMAX,
real(dp), intent(in)  dt,
real(rp), dimension (ka,ia,ja), intent(in)  DENS,
real(rp), dimension (ka,ia,ja), intent(in)  PRES,
real(rp), dimension (ka,ia,ja), intent(in)  TEMP,
real(rp), dimension (ka,ia,ja,qa), intent(in)  QTRC,
real(rp), dimension (ka,ia,ja), intent(in)  QDRY,
real(rp), dimension(ka,ia,ja), intent(in)  CPtot,
real(rp), dimension(ka,ia,ja), intent(in)  CVtot,
real(rp), dimension (ka,ia,ja), intent(in)  CCN,
real(rp), dimension (ka,ia,ja,qa), intent(out)  RHOQ_t,
real(rp), dimension (ka,ia,ja), intent(out)  RHOE_t,
real(rp), dimension(ka,ia,ja), intent(out)  CPtot_t,
real(rp), dimension(ka,ia,ja), intent(out)  CVtot_t,
real(rp), dimension(ka,ia,ja), intent(out)  EVAPORATE,
logical, intent(in), optional  flg_lt,
real(rp), intent(in), optional  d0_crg,
real(rp), intent(in), optional  v0_crg,
real(rp), dimension(ka,ia,ja), intent(in), optional  dqcrg,
real(rp), dimension(ka,ia,ja), intent(in), optional  beta_crg,
real(rp), dimension(ka,ia,ja,num_hyd), intent(in), optional  QTRC_crg,
real(rp), dimension(ka,ia,ja,3), intent(out), optional  QSPLT_in,
real(rp), dimension(ka,ia,ja,num_hyd), intent(out), optional  Sarea,
real(rp), dimension(ka,ia,ja,num_hyd), intent(out), optional  RHOC_t_mp 
)

Cloud Microphysics.

Definition at line 893 of file scale_atmos_phy_mp_suzuki10.F90.

893  use scale_const, only: &
894  tem00 => const_tem00, &
895  pi => const_pi
896  use scale_atmos_saturation, only: &
897  atmos_saturation_pres2qsat_liq, &
898  atmos_saturation_pres2qsat_ice
899  implicit none
900 
901  integer, intent(in) :: KA, KS, KE
902  integer, intent(in) :: IA, IS, IE
903  integer, intent(in) :: JA, JS, JE
904  integer, intent(in) :: KIJMAX
905 
906  real(DP), intent(in) :: dt
907  real(RP), intent(in) :: DENS (KA,IA,JA)
908  real(RP), intent(in) :: PRES (KA,IA,JA)
909  real(RP), intent(in) :: TEMP (KA,IA,JA)
910  real(RP), intent(in) :: QTRC (KA,IA,JA,QA)
911  real(RP), intent(in) :: QDRY (KA,IA,JA)
912  real(RP), intent(in) :: CPtot(KA,IA,JA)
913  real(RP), intent(in) :: CVtot(KA,IA,JA)
914  real(RP), intent(in) :: CCN (KA,IA,JA)
915 
916  real(RP), intent(out) :: RHOQ_t (KA,IA,JA,QA)
917  real(RP), intent(out) :: RHOE_t (KA,IA,JA)
918  real(RP), intent(out) :: CPtot_t(KA,IA,JA)
919  real(RP), intent(out) :: CVtot_t(KA,IA,JA)
920  real(RP), intent(out) :: EVAPORATE(KA,IA,JA) !--- number of evaporated cloud [/m3]
921 
922  ! Optional for Lightning
923  logical, intent(in), optional :: flg_lt
924  real(RP), intent(in), optional :: d0_crg, v0_crg
925  real(RP), intent(in), optional :: dqcrg(KA,IA,JA)
926  real(RP), intent(in), optional :: beta_crg(KA,IA,JA)
927  real(RP), intent(in), optional :: QTRC_crg(KA,IA,JA,num_hyd)
928  real(RP), intent(out), optional :: QSPLT_in(KA,IA,JA,3)
929  real(RP), intent(out), optional :: Sarea(KA,IA,JA,num_hyd)
930  real(RP), intent(out), optional :: RHOC_t_mp(KA,IA,JA,num_hyd)
931 
932  real(RP) :: QSAT_L(KA,IA,JA)
933  real(RP) :: QSAT_I(KA,IA,JA)
934  real(RP) :: ssliq(KA,IA,JA)
935  real(RP) :: ssice(KA,IA,JA)
936 
937  integer :: ijk_index (KIJMAX,3)
938  integer :: index_cld (KIJMAX)
939  integer :: index_cold(KIJMAX)
940  integer :: index_warm(KIJMAX)
941  integer :: ijkcount, ijkcount_cold, ijkcount_warm
942  integer :: ijk, indirect
943 
944  real(RP) :: DENS_ijk(KIJMAX)
945  real(RP) :: PRES_ijk(KIJMAX)
946  real(RP) :: TEMP_ijk(KIJMAX)
947  real(RP) :: Qdry_ijk(KIJMAX)
948  real(RP) :: Qvap_ijk(KIJMAX)
949  real(RP) :: CCN_ijk(KIJMAX)
950  real(RP) :: CP_ijk(KIJMAX)
951  real(RP) :: CV_ijk(KIJMAX)
952  real(RP) :: Evaporate_ijk(KIJMAX)
953  real(RP) :: Ghyd_ijk(nbin,nspc,KIJMAX)
954  real(RP) :: Gaer_ijk(max(nccn,1),KIJMAX)
955  real(RP) :: cldsum
956  integer :: countbin
957  real(RP) :: rhoq_new
958 
959  !--- for lithgning
960  logical :: flg_lt_l
961  real(RP) :: Gcrg_ijk(nbin,nspc,KIJMAX)
962  real(RP) :: CRG_SEP_ijk(nspc,KIJMAX)
963  real(RP) :: dqcrg_ijk(KIJMAX)
964  real(RP) :: beta_crg_ijk(KIJMAX)
965 
966  integer :: step
967  integer :: k, i, j, m, n, iq
968  !---------------------------------------------------------------------------
969 
970  if ( nspc == 1 ) then
971  log_progress(*) 'atmosphere / physics / microphysics / SBM (Liquid water only)'
972  elseif( nspc > 1 ) then
973  log_progress(*) 'atmosphere / physics / microphysics / SBM (Mixed phase)'
974  endif
975 
976  if ( present(flg_lt) ) then
977  flg_lt_l = flg_lt
978  crg_sep_ijk(:,:) = 0.0_rp
979  qsplt_in(:,:,:,:) = 0.0_rp
980  else
981  flg_lt_l = .false.
982  end if
983 
984  call atmos_saturation_pres2qsat_liq( ka, ks, ke, & ! [IN]
985  ia, is, ie, & ! [IN]
986  ja, js, je, & ! [IN]
987  temp(:,:,:), pres(:,:,:), qdry(:,:,:), & ! [IN]
988  qsat_l(:,:,:) ) ! [OUT]
989 
990  call atmos_saturation_pres2qsat_ice( ka, ks, ke, & ! [IN]
991  ia, is, ie, & ! [IN]
992  ja, js, je, & ! [IN]
993  temp(:,:,:), pres(:,:,:), qdry(:,:,:), & ! [IN]
994  qsat_i(:,:,:) ) ! [OUT]
995 
996  do j = js, je
997  do i = is, ie
998  do k = ks, ke
999  ssliq(k,i,j) = qtrc(k,i,j,i_qv) / qsat_l(k,i,j) - 1.0_rp
1000  ssice(k,i,j) = qtrc(k,i,j,i_qv) / qsat_i(k,i,j) - 1.0_rp
1001  enddo
1002  enddo
1003  enddo
1004 
1005  if ( nspc == 1 ) then
1006  ssice(:,:,:) = 0.0_rp
1007  endif
1008 
1009 !--- store initial SDF of aerosol
1010 !--- this option is not supported
1011 ! if ( ofirst_sdfa ) then
1012 ! allocate( marate( nccn ) )
1013 ! do j = JS, JE
1014 ! do i = IS, IE
1015 ! do k = KS, KE
1016 ! sum2 = 0.0_RP
1017 ! do n = 1, nccn
1018 ! marate( n ) = gdga(k,i,j,n)*rexpxactr( n )
1019 ! sum2 = sum2 + gdga(k,i,j,n)*rexpxactr( n )
1020 ! enddo
1021 ! enddo
1022 ! enddo
1023 ! enddo
1024 ! if ( sum2 /= 0.0_RP ) then
1025 ! marate( 1:nccn ) = marate( 1:nccn )/sum2
1026 ! ofirst_sdfa = .false.
1027 ! endif
1028 ! endif
1029 
1030  !--- Arrange array for microphysics
1031 
1032  call prof_rapstart('MP_ijkconvert', 3)
1033 
1034  ijk = 0
1035  do j = js, je
1036  do i = is, ie
1037  do k = ks, ke
1038  ijk = ijk + 1
1039  ijk_index(ijk,1) = i
1040  ijk_index(ijk,2) = j
1041  ijk_index(ijk,3) = k
1042  enddo
1043  enddo
1044  enddo
1045  gcrg_ijk(:,:,:) = 0.0_rp
1046  ijkcount = 0
1047  ijkcount_cold = 0
1048  ijkcount_warm = 0
1049 
1050  ijk = 0
1051  do j = js, je
1052  do i = is, ie
1053  do k = ks, ke
1054  ijk = ijk + 1
1055 
1056  ! calc total hydrometeors
1057  cldsum = 0.0_rp
1058  countbin = i_qv + 1
1059  do m = 1, nspc
1060  do n = 1, nbin
1061  cldsum = cldsum + qtrc(k,i,j,countbin) * dens(k,i,j) / dxmic
1062  countbin = countbin + 1
1063  enddo
1064  enddo
1065 
1066  if ( cldsum > cldmin &
1067  .OR. ssliq(k,i,j) > 0.0_rp &
1068  .OR. ssice(k,i,j) > 0.0_rp ) then
1069 
1070  ijkcount = ijkcount + 1
1071 
1072  index_cld(ijkcount) = ijk
1073 
1074  dens_ijk(ijkcount) = dens(k,i,j)
1075  pres_ijk(ijkcount) = pres(k,i,j)
1076  temp_ijk(ijkcount) = temp(k,i,j)
1077  qdry_ijk(ijkcount) = qdry(k,i,j)
1078  cp_ijk(ijkcount) = cptot(k,i,j)
1079  cv_ijk(ijkcount) = cvtot(k,i,j)
1080  ccn_ijk(ijkcount) = ccn(k,i,j)
1081  qvap_ijk(ijkcount) = qtrc(k,i,j,i_qv)
1082 
1083  countbin = i_qv + 1
1084  do m = 1, nspc
1085  do n = 1, nbin
1086  ghyd_ijk(n,m,ijkcount) = qtrc(k,i,j,countbin) * dens(k,i,j) / dxmic
1087  countbin = countbin + 1
1088  enddo
1089  enddo
1090 
1091  do n = 1, nccn
1092  gaer_ijk(n,ijkcount) = qtrc(k,i,j,countbin) * dens(k,i,j) / dxaer
1093  countbin = countbin + 1
1094  enddo
1095 
1096  if ( temp(k,i,j) < tem00 .AND. nspc > 1 ) then ! cold
1097  ijkcount_cold = ijkcount_cold + 1
1098  index_cold(ijkcount_cold) = ijkcount
1099  else ! warm
1100  ijkcount_warm = ijkcount_warm + 1
1101  index_warm(ijkcount_warm) = ijkcount
1102  endif
1103 
1104  if ( flg_lt_l ) then
1105  countbin = 1
1106  do m = 1, nspc
1107  do n = 1, nbin
1108  gcrg_ijk(n,m,ijkcount) = qtrc_crg(k,i,j,countbin) * dens(k,i,j)
1109  countbin = countbin + 1
1110  enddo
1111  enddo
1112  beta_crg_ijk(ijkcount) = beta_crg(k,i,j)
1113  dqcrg_ijk(ijkcount) = dqcrg(k,i,j)
1114  endif
1115 
1116  else
1117 
1118  ! no hudrometeors and undersaturation (no microphysical process occcurs)
1119  do iq = 1, qa
1120  rhoq_t(k,i,j,iq) = 0.0_rp
1121  end do
1122  rhoe_t(k,i,j) = 0.0_rp
1123  cptot_t(k,i,j) = 0.0_rp
1124  cvtot_t(k,i,j) = 0.0_rp
1125  evaporate(k,i,j) = 0.0_rp
1126 
1127  endif
1128 
1129  enddo
1130  enddo
1131  enddo
1132 
1133  call prof_rapend ('MP_ijkconvert', 3)
1134 
1135  ! tentative timername registration
1136  call prof_rapstart('MP_suzuki10', 3)
1137  call prof_rapend ('MP_suzuki10', 3)
1138  call prof_rapstart('_SBM_Nucleat', 3)
1139  call prof_rapend ('_SBM_Nucleat', 3)
1140 ! call PROF_rapstart('_SBM_NucleatA', 3)
1141 ! call PROF_rapend ('_SBM_NucleatA', 3)
1142  call prof_rapstart('_SBM_Liqphase', 3)
1143  call prof_rapend ('_SBM_Liqphase', 3)
1144  call prof_rapstart('_SBM_Icephase', 3)
1145  call prof_rapend ('_SBM_Icephase', 3)
1146  call prof_rapstart('_SBM_Mixphase', 3)
1147  call prof_rapend ('_SBM_Mixphase', 3)
1148  call prof_rapstart('_SBM_AdvLiq', 3)
1149  call prof_rapend ('_SBM_AdvLiq', 3)
1150  call prof_rapstart('_SBM_AdvIce', 3)
1151  call prof_rapend ('_SBM_AdvIce', 3)
1152  call prof_rapstart('_SBM_AdvMix', 3)
1153  call prof_rapend ('_SBM_AdvMix', 3)
1154 ! call PROF_rapstart('_SBM_FAero', 3)
1155 ! call PROF_rapend ('_SBM_FAero', 3)
1156  call prof_rapstart('_SBM_Freezing', 3)
1157  call prof_rapend ('_SBM_Freezing', 3)
1158  call prof_rapstart('_SBM_IceNucleat', 3)
1159  call prof_rapend ('_SBM_IceNucleat', 3)
1160  call prof_rapstart('_SBM_Melting', 3)
1161  call prof_rapend ('_SBM_Melting', 3)
1162  call prof_rapstart('_SBM_CollCoag', 3)
1163  call prof_rapend ('_SBM_CollCoag', 3)
1164 ! call PROF_rapstart('_SBM_CollCoagR', 3)
1165 ! call PROF_rapend ('_SBM_CollCoagR', 3)
1166 
1167  if ( ijkcount > 0 ) then
1168 
1169  call prof_rapstart('MP_suzuki10', 3)
1170 
1171  if ( flg_lt_l ) then
1172  ! --- with lightning
1173  call mp_suzuki10( ka, ia, ja, & ! [IN]
1174  ijkcount, & ! [IN]
1175  ijkcount_cold, & ! [IN]
1176  ijkcount_warm, & ! [IN]
1177  index_cold( 1:ijkcount), & ! [IN]
1178  index_warm( 1:ijkcount), & ! [IN]
1179  dens_ijk( 1:ijkcount), & ! [IN]
1180  pres_ijk( 1:ijkcount), & ! [IN]
1181  qdry_ijk( 1:ijkcount), & ! [IN]
1182  ccn_ijk( 1:ijkcount), & ! [IN]
1183  temp_ijk( 1:ijkcount), & ! [INOUT]
1184  qvap_ijk( 1:ijkcount), & ! [INOUT]
1185  ghyd_ijk(:,:,1:ijkcount), & ! [INOUT]
1186  gaer_ijk(:, 1:ijkcount), & ! [INOUT]
1187  cp_ijk( 1:ijkcount), & ! [INOUT]
1188  cv_ijk( 1:ijkcount), & ! [INOUT]
1189  evaporate_ijk(1:ijkcount), & ! [OUT]
1190  dt, & ! [IN]
1191  flg_lt_l, d0_crg, v0_crg, & ! [IN:Optional]
1192  dqcrg_ijk( 1:ijkcount), & ! [IN:Optional]
1193  beta_crg_ijk( 1:ijkcount), & ! [IN:Optional]
1194  gcrg_ijk(:,:,1:ijkcount), & ! [INOUT:Optional]
1195  crg_sep_ijk(:,1:ijkcount) ) ! [OUT:Optional]
1196  else
1197  call mp_suzuki10( ka, ia, ja, & ! [IN]
1198  ijkcount, & ! [IN]
1199  ijkcount_cold, & ! [IN]
1200  ijkcount_warm, & ! [IN]
1201  index_cold( 1:ijkcount), & ! [IN]
1202  index_warm( 1:ijkcount), & ! [IN]
1203  dens_ijk( 1:ijkcount), & ! [IN]
1204  pres_ijk( 1:ijkcount), & ! [IN]
1205  qdry_ijk( 1:ijkcount), & ! [IN]
1206  ccn_ijk( 1:ijkcount), & ! [IN]
1207  temp_ijk( 1:ijkcount), & ! [INOUT]
1208  qvap_ijk( 1:ijkcount), & ! [INOUT]
1209  ghyd_ijk(:,:,1:ijkcount), & ! [INOUT]
1210  gaer_ijk(:, 1:ijkcount), & ! [INOUT]
1211  cp_ijk( 1:ijkcount), & ! [INOUT]
1212  cv_ijk( 1:ijkcount), & ! [INOUT]
1213  evaporate_ijk(1:ijkcount), & ! [OUT]
1214  dt ) ! [IN]
1215  endif
1216 
1217  call prof_rapend ('MP_suzuki10', 3)
1218 
1219 ! if ( flg_sf_aero ) then
1220 ! do j = JS-2, JE+2
1221 ! do i = IS-2, IE+1
1222 ! VELX(i,j) = MOMX(K10_1,i,j) / ( DENS(K10_1,i+1,j)+DENS(K10_1,i,j) ) * R10M1 &
1223 ! + MOMX(K10_2,i,j) / ( DENS(K10_2,i+1,j)+DENS(K10_2,i,j) ) * R10M2
1224 ! enddo
1225 ! enddo
1226 !
1227 ! do j = JS-2, JE+1
1228 ! do i = IS-2, IE+2
1229 ! VELY(i,j) = MOMY(K10_1,i,j) / ( DENS(K10_1,i,j+1)+DENS(K10_1,i,j) ) * R10M1 &
1230 ! + MOMY(K10_2,i,j) / ( DENS(K10_2,i,j+1)+DENS(K10_2,i,j) ) * R10M2
1231 ! enddo
1232 ! enddo
1233 ! endif
1234 !
1235 ! !--- SURFACE FLUX by Monahan et al. (1986)
1236 ! if ( flg_sf_aero .AND. nccn /= 0 ) then
1237 ! do j = JS, JE
1238 ! do i = IS, IE
1239 ! ijk = ( j - JS ) * KMAX * IMAX &
1240 ! + ( i - IS ) * KMAX &
1241 ! + ( KS - KS ) &
1242 ! + 1
1243 ! Uabs = sqrt( ( ( VELX(i,j) + VELX(i-1,j ) ) * 0.50_RP )**2 &
1244 ! + ( ( VELY(i,j) + VELY(i ,j-1) ) * 0.50_RP )**2 )
1245 ! do n = 1, nccn
1246 ! if ( rada( n ) <= 2.0E-5_RP .AND. rada( n ) >= 3.0E-7_RP ) then
1247 ! bparam = ( 0.38_RP - log( rada( n ) ) )/0.65_RP
1248 ! SFLX_AERO(i,j,n) = 1.373_RP * Uabs**( 3.41_RP ) * rada( n )**( -3.0_RP ) &
1249 ! * ( 1.0_RP + 0.057_RP * rada( n )**( 1.05_RP ) ) &
1250 ! * 10.0_RP**( 1.19_RP * exp( -bparam*bparam ) )
1251 ! ! convert from [#/m^2/um/s] -> [kg/m^3/unit log (m)]
1252 ! SFLX_AERO(i,j,n) = SFLX_AERO(i,j,n) / DENS(KS,i,j) &
1253 ! / CDZ(KS) * rada( n ) / 3.0_RP * dt * expxactr( n )
1254 ! Gaer_ijk(n,ijk) = Gaer_ijk(n,ijk) + SFLX_AERO(i,j,n)/dxaer
1255 ! endif
1256 ! enddo
1257 ! enddo
1258 ! enddo
1259 ! endif
1260 
1261  call prof_rapstart('MP_ijkconvert', 3)
1262 
1263  !---- return original array
1264  do ijk = 1, ijkcount
1265  indirect = index_cld(ijk)
1266  i = ijk_index(indirect,1)
1267  j = ijk_index(indirect,2)
1268  k = ijk_index(indirect,3)
1269 
1270  rhoe_t(k,i,j) = ( temp_ijk(ijk) * cv_ijk(ijk) - temp(k,i,j) * cvtot(k,i,j) ) * dens(k,i,j) / dt
1271  cptot_t(k,i,j) = ( cp_ijk(ijk) - cptot(k,i,j) ) / dt
1272  cvtot_t(k,i,j) = ( cv_ijk(ijk) - cvtot(k,i,j) ) / dt
1273  evaporate(k,i,j) = evaporate_ijk(ijk) / dt ! [#/m3/s]
1274 
1275  rhoq_t(k,i,j,i_qv) = ( qvap_ijk(ijk) - qtrc(k,i,j,i_qv) ) * dens(k,i,j) / dt
1276 
1277  countbin = i_qv + 1
1278  do m = 1, nspc
1279  do n = 1, nbin
1280  rhoq_new = ghyd_ijk(n,m,ijk) * dxmic
1281  rhoq_t(k,i,j,countbin) = ( rhoq_new - qtrc(k,i,j,countbin)*dens(k,i,j) ) / dt
1282  countbin = countbin + 1
1283  enddo
1284  enddo
1285 
1286  do n = 1, nccn
1287  rhoq_new = gaer_ijk(n,ijk) * dxaer
1288  rhoq_t(k,i,j,countbin) = ( rhoq_new - qtrc(k,i,j,countbin)*dens(k,i,j) ) / dt
1289  countbin = countbin + 1
1290  enddo
1291 
1292  if( flg_lt_l ) then
1293  countbin = 1
1294  do m = 1, nspc
1295  do n = 1, nbin
1296  rhoq_new = gcrg_ijk(n,m,ijk)
1297  rhoc_t_mp(k,i,j,countbin) = ( rhoq_new - qtrc_crg(k,i,j,countbin)*dens(k,i,j) ) / dt
1298  countbin = countbin + 1
1299  enddo
1300  enddo
1301 
1302  sarea(k,i,j,:) = 0.0_rp
1303  countbin = 1
1304  do m = 1, nspc
1305  do n = 1, nbin
1306  rhoq_new = ghyd_ijk(n,m,ijk) * dxmic
1307  sarea(k,i,j,countbin) = 4.0_rp*pi*radc(n)**2*rhoq_new*rexpxctr( n )
1308  countbin = countbin + 1
1309  enddo
1310  enddo
1311 
1312  qsplt_in(k,i,j,1) = crg_sep_ijk(ig,ijk) * dens(k,i,j) / dt
1313  qsplt_in(k,i,j,2) = ( crg_sep_ijk(ic,ijk) &
1314  + crg_sep_ijk(ip,ijk) &
1315  + crg_sep_ijk(id,ijk) ) * dens(k,i,j) / dt
1316  qsplt_in(k,i,j,3) = crg_sep_ijk(iss,ijk) * dens(k,i,j) / dt
1317 
1318  endif
1319 
1320  enddo
1321 
1322 
1323 ! if ( nccn /= 0 ) then
1324 ! AMR(:,:,:) = 0.0_RP
1325 ! do j = JS, JE
1326 ! do i = IS, IE
1327 ! do k = KS, KE
1328 ! do n = 1, nccn
1329 ! AMR(k,i,j) = AMR(k,i,j) + QTRC(k,i,j,QQE-1+n)
1330 ! enddo
1331 ! enddo
1332 ! enddo
1333 ! enddo
1334 ! endif
1335 
1336  call prof_rapend ('MP_ijkconvert', 3)
1337 
1338  endif
1339 
1340  return

References scale_const::const_pi, scale_const::const_tem00, nbin, nccn, scale_prof::prof_rapend(), and scale_prof::prof_rapstart().

Referenced by mod_atmos_phy_mp_driver::atmos_phy_mp_driver_calc_tendency().

Here is the call graph for this function:
Here is the caller graph for this function:

◆ atmos_phy_mp_suzuki10_terminal_velocity()

subroutine, public scale_atmos_phy_mp_suzuki10::atmos_phy_mp_suzuki10_terminal_velocity ( integer, intent(in)  KA,
real(rp), dimension(ka,qa-1), intent(out)  vterm_o 
)

get terminal velocity

Definition at line 1349 of file scale_atmos_phy_mp_suzuki10.F90.

1349  implicit none
1350 
1351  integer, intent(in) :: KA
1352 
1353  real(RP), intent(out) :: vterm_o(KA,QA-1)
1354 
1355  integer :: iq
1356  !---------------------------------------------------------------------------
1357 
1358  do iq = 1, qa-1
1359  vterm_o(:,iq) = vterm(iq)
1360  end do
1361 
1362  return

Referenced by mod_atmos_phy_mp_driver::atmos_phy_mp_driver_calc_tendency().

Here is the caller graph for this function:

◆ atmos_phy_mp_suzuki10_cloud_fraction()

subroutine, public scale_atmos_phy_mp_suzuki10::atmos_phy_mp_suzuki10_cloud_fraction ( 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,num_hyd), intent(in)  QTRC0,
real(rp), intent(in)  mask_criterion,
real(rp), dimension(ka,ia,ja), intent(out)  cldfrac 
)

Calculate Cloud Fraction.

Definition at line 1374 of file scale_atmos_phy_mp_suzuki10.F90.

1374  implicit none
1375 
1376  integer, intent(in) :: KA, KS, KE
1377  integer, intent(in) :: IA, IS, IE
1378  integer, intent(in) :: JA, JS, JE
1379 
1380  real(RP), intent(in) :: QTRC0 (KA,IA,JA,num_hyd)
1381  real(RP), intent(in) :: mask_criterion
1382  real(RP), intent(out) :: cldfrac(KA,IA,JA)
1383 
1384  real(RP) :: qhydro
1385  integer :: k, i, j, iq, ihydro
1386  !---------------------------------------------------------------------------
1387 
1388  if( nspc > 1 ) then
1389  do j = js, je
1390  do i = is, ie
1391  do k = ks, ke
1392  qhydro = 0.0_rp
1393  do ihydro = 1, nspc
1394  do iq = nbin*(ihydro-1)+1, nbin*ihydro
1395  qhydro = qhydro + qtrc0(k,i,j,iq)
1396  enddo
1397  enddo
1398  cldfrac(k,i,j) = 0.5_rp + sign(0.5_rp,qhydro-mask_criterion)
1399  enddo
1400  enddo
1401  enddo
1402  elseif( nspc == 1 ) then
1403  do j = js, je
1404  do i = is, ie
1405  do k = ks, ke
1406  qhydro = 0.0_rp
1407  do ihydro = 1, i_mp_qc
1408  do iq = nbin*(ihydro-1)+1, nbin*ihydro
1409  qhydro = qhydro + qtrc0(k,i,j,iq)
1410  enddo
1411  enddo
1412  cldfrac(k,i,j) = 0.5_rp + sign(0.5_rp,qhydro-mask_criterion)
1413  enddo
1414  enddo
1415  enddo
1416  endif
1417 
1418  return

References nbin.

Referenced by mod_atmos_phy_mp_vars::atmos_phy_mp_vars_get_diagnostic().

Here is the caller graph for this function:

◆ atmos_phy_mp_suzuki10_effective_radius()

subroutine, public scale_atmos_phy_mp_suzuki10::atmos_phy_mp_suzuki10_effective_radius ( 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)  DENS0,
real(rp), dimension(ka,ia,ja), intent(in)  TEMP0,
real(rp), dimension(ka,ia,ja,num_hyd), intent(in)  QTRC0,
real(rp), dimension (ka,ia,ja,n_hyd), intent(out)  Re 
)

Calculate Effective Radius.

Definition at line 1431 of file scale_atmos_phy_mp_suzuki10.F90.

1431  use scale_const, only: &
1432  eps => const_eps
1433  use scale_atmos_hydrometeor, only: &
1434  n_hyd, &
1435  i_qv, &
1436  i_hc, &
1437  i_hr, &
1438  i_hi, &
1439  i_hs, &
1440  i_hg, &
1441  i_hh
1442  implicit none
1443 
1444  integer, intent(in) :: KA, KS, KE
1445  integer, intent(in) :: IA, IS, IE
1446  integer, intent(in) :: JA, JS, JE
1447 
1448  real(RP), intent(in) :: DENS0(KA,IA,JA) ! density [kg/m3]
1449  real(RP), intent(in) :: TEMP0(KA,IA,JA) ! temperature [K]
1450  real(RP), intent(in) :: QTRC0(KA,IA,JA,num_hyd) ! tracer mass concentration [kg/kg]
1451  real(RP), intent(out) :: Re (KA,IA,JA,N_HYD) ! effective radius [cm]
1452 
1453  real(RP), parameter :: um2cm = 100.0_rp
1454 
1455  real(RP) :: sum0(nspc), sum2, sum3, re_tmp(nspc)
1456  integer :: i, j, k, iq, ihydro
1457  !---------------------------------------------------------------------------
1458 
1459  do k = ks, ke
1460  do j = js, je
1461  do i = is, ie
1462  re(k,i,j,:) = 0.0_rp
1463 
1464  ! HC
1465  sum3 = 0.0_rp
1466  sum2 = 0.0_rp
1467  ihydro = i_mp_qc
1468  do iq = 1, nbnd
1469  sum3 = sum3 &
1470  + ( ( qtrc0(k,i,j,iq) * dens0(k,i,j) ) & !--- [kg/kg] -> [kg/m3]
1471  * rexpxctr( iq-nbin*(ihydro-1) ) & !--- mass -> number
1472  * radc( iq-nbin*(ihydro-1) )**3.0_rp )
1473  sum2 = sum2 &
1474  + ( ( qtrc0(k,i,j,iq) * dens0(k,i,j) ) & !--- [kg/kg] -> [kg/m3]
1475  * rexpxctr( iq-nbin*(ihydro-1) ) & !--- mass -> number
1476  * radc( iq-nbin*(ihydro-1) )**2.0_rp )
1477  enddo
1478  sum3 = max( sum3, 0.0_rp )
1479  sum2 = max( sum2, 0.0_rp )
1480  if ( sum2 /= 0.0_rp ) then
1481  re(k,i,j,i_hc) = sum3 / sum2 * um2cm
1482  else
1483  re(k,i,j,i_hc) = 0.0_rp
1484  endif
1485 
1486  ! HR
1487  sum3 = 0.0_rp
1488  sum2 = 0.0_rp
1489  ihydro = i_mp_qc
1490  do iq = nbnd+1, nbin
1491  sum3 = sum3 &
1492  + ( ( qtrc0(k,i,j,iq) * dens0(k,i,j) ) & !--- [kg/kg] -> [kg/m3]
1493  * rexpxctr( iq-nbin*(ihydro-1) ) & !--- mass -> number
1494  * radc( iq-nbin*(ihydro-1) )**3.0_rp )
1495  sum2 = sum2 &
1496  + ( ( qtrc0(k,i,j,iq) * dens0(k,i,j) ) & !--- [kg/kg] -> [kg/m3]
1497  * rexpxctr( iq-nbin*(ihydro-1) ) & !--- mass -> number
1498  * radc( iq-nbin*(ihydro-1) )**2.0_rp )
1499  enddo
1500  sum3 = max( sum3, 0.0_rp )
1501  sum2 = max( sum2, 0.0_rp )
1502  if ( sum2 /= 0.0_rp ) then
1503  re(k,i,j,i_hr) = sum3 / sum2 * um2cm
1504  else
1505  re(k,i,j,i_hr) = 0.0_rp
1506  endif
1507 
1508  enddo
1509  enddo
1510  enddo
1511 
1512  ! other hydrometeors
1513  if ( nspc > 1 ) then
1514  do k = ks, ke
1515  do j = js, je
1516  do i = is, ie
1517  do ihydro = 2, nspc
1518  sum0(ihydro) = 0.0_rp
1519  sum2 = 0.0_rp
1520  sum3 = 0.0_rp
1521  do iq = nbin*(ihydro-1)+1, nbin*ihydro
1522  sum0(ihydro) = sum0(ihydro) &
1523  + ( qtrc0(k,i,j,iq) * dens0(k,i,j) ) !--- [kg/kg] -> [kg/m3]
1524  sum3 = sum3 &
1525  + ( ( qtrc0(k,i,j,iq) * dens0(k,i,j) ) & !--- [kg/kg] -> [kg/m3]
1526  * rexpxctr( iq-nbin*(ihydro-1) ) & !--- mass -> number
1527  * radc( iq-nbin*(ihydro-1) )**3.0_rp )
1528  sum2 = sum2 &
1529  + ( ( qtrc0(k,i,j,iq) * dens0(k,i,j) ) & !--- [kg/kg] -> [kg/m3]
1530  * rexpxctr( iq-nbin*(ihydro-1) ) & !--- mass -> number
1531  * radc( iq-nbin*(ihydro-1) )**2.0_rp )
1532  enddo
1533  sum3 = max( sum3, 0.0_rp )
1534  sum2 = max( sum2, 0.0_rp )
1535  if ( sum2 == 0.0_rp ) then
1536  re_tmp(ihydro) = 0.0_rp
1537  else
1538  re_tmp(ihydro) = sum3 / sum2 * um2cm
1539  end if
1540  end do
1541 
1542  re(k,i,j,i_hi) = ( re_tmp(i_mp_qcl) * sum0(i_mp_qcl) &
1543  + re_tmp(i_mp_qp ) * sum0(i_mp_qp ) &
1544  + re_tmp(i_mp_qd ) * sum0(i_mp_qd ) ) &
1545  / ( sum0(i_mp_qcl) + sum0(i_mp_qp) + sum0(i_mp_qd) + eps )
1546  re(k,i,j,i_hs) = re_tmp(i_mp_qs)
1547  re(k,i,j,i_hg) = re_tmp(i_mp_qg)
1548  re(k,i,j,i_hh) = re_tmp(i_mp_qh)
1549 
1550  enddo
1551  enddo
1552  enddo
1553 
1554  end if
1555 
1556  return

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_atmos_hydrometeor::i_qv, scale_atmos_hydrometeor::n_hyd, and nbin.

Referenced by mod_atmos_phy_mp_vars::atmos_phy_mp_vars_get_diagnostic().

Here is the caller graph for this function:

◆ atmos_phy_mp_suzuki10_qtrc2qhyd()

subroutine, public scale_atmos_phy_mp_suzuki10::atmos_phy_mp_suzuki10_qtrc2qhyd ( 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,num_hyd), intent(in)  QTRC0,
real(rp), dimension (ka,ia,ja,n_hyd), intent(out)  Qe 
)

Calculate mass ratio of each category.

Definition at line 1567 of file scale_atmos_phy_mp_suzuki10.F90.

1567  use scale_atmos_hydrometeor, only: &
1568  n_hyd, &
1569  i_hc, &
1570  i_hr, &
1571  i_hi, &
1572  i_hs, &
1573  i_hg, &
1574  i_hh
1575  implicit none
1576 
1577  integer, intent(in) :: KA, KS, KE
1578  integer, intent(in) :: IA, IS, IE
1579  integer, intent(in) :: JA, JS, JE
1580  real(RP), intent(in) :: QTRC0(KA,IA,JA,num_hyd) ! tracer mass concentration [kg/kg]
1581  real(RP), intent(out) :: Qe (KA,IA,JA,N_HYD) ! mixing ratio of each cateory [kg/kg]
1582 
1583  integer :: ihydro, ibin, iq, icateg
1584  integer :: k, i, j
1585  !---------------------------------------------------------------------------
1586 
1587 !OCL XFILL
1588  qe(:,:,:,:) = 0.0_rp
1589 
1590  do ihydro = 1, nspc
1591  do ibin = 1, nbin
1592  iq = nbin*(ihydro-1) + ibin
1593 
1594  if ( iq > 0 .AND. iq <= nbin*(i_mp_qc ) ) then ! liquid
1595  if ( iq > 0 .AND. iq <= nbnd ) then ! cloud
1596  icateg = i_hc
1597  elseif( iq > nbnd .AND. iq <= nbin ) then ! rain
1598  icateg = i_hr
1599  endif
1600  elseif( iq > nbin*(i_mp_qcl-1) .AND. iq <= nbin*(i_mp_qcl) ) then ! ice (column)
1601  icateg = i_hi
1602  elseif( iq > nbin*(i_mp_qp -1) .AND. iq <= nbin*(i_mp_qp ) ) then ! ice (plate)
1603  icateg = i_hi
1604  elseif( iq > nbin*(i_mp_qd -1) .AND. iq <= nbin*(i_mp_qd ) ) then ! ice (dendrite)
1605  icateg = i_hi
1606  elseif( iq > nbin*(i_mp_qs -1) .AND. iq <= nbin*(i_mp_qs ) ) then ! snow
1607  icateg = i_hs
1608  elseif( iq > nbin*(i_mp_qg -1) .AND. iq <= nbin*(i_mp_qg ) ) then ! graupel
1609  icateg = i_hg
1610  elseif( iq > nbin*(i_mp_qh -1) .AND. iq <= num_hyd ) then ! hail
1611  icateg = i_hh
1612  endif
1613 
1614  do j = js, je
1615  do i = is, ie
1616  do k = ks, ke
1617  qe(k,i,j,icateg) = qe(k,i,j,icateg) + qtrc0(k,i,j,iq)
1618  enddo
1619  enddo
1620  enddo
1621  enddo
1622  enddo
1623 
1624  return

References 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_atmos_hydrometeor::n_hyd, and nbin.

Referenced by mod_atmos_phy_mp_driver::atmos_phy_mp_driver_calc_tendency(), and mod_atmos_phy_mp_vars::atmos_phy_mp_vars_get_diagnostic().

Here is the caller graph for this function:

◆ atmos_phy_mp_suzuki10_qtrc2nhyd()

subroutine, public scale_atmos_phy_mp_suzuki10::atmos_phy_mp_suzuki10_qtrc2nhyd ( 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,num_hyd), intent(in)  QTRC0,
real(rp), dimension (ka,ia,ja,n_hyd), intent(out)  Ne 
)

Calculate number concentration of each category.

Definition at line 1635 of file scale_atmos_phy_mp_suzuki10.F90.

1635  use scale_atmos_hydrometeor, only: &
1636  n_hyd, &
1637  i_hc, &
1638  i_hr, &
1639  i_hi, &
1640  i_hs, &
1641  i_hg, &
1642  i_hh
1643  implicit none
1644 
1645  integer, intent(in) :: KA, KS, KE
1646  integer, intent(in) :: IA, IS, IE
1647  integer, intent(in) :: JA, JS, JE
1648  real(RP), intent(in) :: DENS (KA,IA,JA) ! density [kg/m3]
1649  real(RP), intent(in) :: QTRC0(KA,IA,JA,num_hyd) ! tracer mass concentration [kg/kg]
1650  real(RP), intent(out) :: Ne (KA,IA,JA,N_HYD) ! number concentration of each cateory [1/m3]
1651 
1652  integer :: ihydro, ibin, iq, icateg
1653  integer :: k, i, j
1654  !---------------------------------------------------------------------------
1655 
1656 !OCL XFILL
1657  ne(:,:,:,:) = 0.0_rp
1658 
1659  do ihydro = 1, nspc
1660  do ibin = 1, nbin
1661  iq = nbin*(ihydro-1) + ibin
1662 
1663  if ( iq > 0 .AND. iq <= nbin*(i_mp_qc ) ) then ! liquid
1664  if ( iq > 0 .AND. iq <= nbnd ) then ! cloud
1665  icateg = i_hc
1666  elseif( iq > nbnd .AND. iq <= nbin ) then ! rain
1667  icateg = i_hr
1668  endif
1669  elseif( iq > nbin*(i_mp_qcl-1) .AND. iq <= nbin*(i_mp_qcl) ) then ! ice (column)
1670  icateg = i_hi
1671  elseif( iq > nbin*(i_mp_qp -1) .AND. iq <= nbin*(i_mp_qp ) ) then ! ice (plate)
1672  icateg = i_hi
1673  elseif( iq > nbin*(i_mp_qd -1) .AND. iq <= nbin*(i_mp_qd ) ) then ! ice (dendrite)
1674  icateg = i_hi
1675  elseif( iq > nbin*(i_mp_qs -1) .AND. iq <= nbin*(i_mp_qs ) ) then ! snow
1676  icateg = i_hs
1677  elseif( iq > nbin*(i_mp_qg -1) .AND. iq <= nbin*(i_mp_qg ) ) then ! graupel
1678  icateg = i_hg
1679  elseif( iq > nbin*(i_mp_qh -1) .AND. iq <= num_hyd ) then ! hail
1680  icateg = i_hh
1681  endif
1682 
1683  do j = js, je
1684  do i = is, ie
1685  do k = ks, ke
1686  ne(k,i,j,icateg) = ne(k,i,j,icateg) + dens(k,i,j) * qtrc0(k,i,j,iq) * rexpxctr(ibin)
1687  enddo
1688  enddo
1689  enddo
1690  enddo
1691  enddo
1692 
1693  return

References 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_atmos_hydrometeor::n_hyd, and nbin.

Referenced by mod_atmos_phy_mp_vars::atmos_phy_mp_vars_get_diagnostic().

Here is the caller graph for this function:

◆ atmos_phy_mp_suzuki10_qhyd2qtrc()

subroutine, public scale_atmos_phy_mp_suzuki10::atmos_phy_mp_suzuki10_qhyd2qtrc ( 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,n_hyd), intent(in)  Qe,
real(rp), dimension(ka,ia,ja,qa-1), intent(out)  QTRC,
real(rp), dimension(ka,ia,ja,n_hyd), intent(in), optional  QNUM 
)

get mass ratio of each category

Definition at line 1703 of file scale_atmos_phy_mp_suzuki10.F90.

1703  use scale_const, only: &
1704  pi => const_pi, &
1705  eps => const_eps
1706  use scale_atmos_hydrometeor, only: &
1707  n_hyd, &
1708  i_hc, &
1709  i_hr, &
1710  i_hi, &
1711  i_hs, &
1712  i_hg, &
1713  i_hh
1714  use scale_specfunc, only: &
1715  sf_gamma
1716  implicit none
1717  integer, intent(in) :: KA, KS, KE
1718  integer, intent(in) :: IA, IS, IE
1719  integer, intent(in) :: JA, JS, JE
1720 
1721  real(RP), intent(in) :: Qe(KA,IA,JA,N_HYD) ! mass ratio of each cateory [kg/kg]
1722 
1723  real(RP), intent(out) :: QTRC(KA,IA,JA,QA-1)
1724 
1725  real(RP), intent(in), optional :: QNUM(KA,IA,JA,N_HYD) ! number concentratio
1726 
1727  real(RP) :: coef0, coef1, coef2
1728  real(RP) :: dummy(nbin)
1729  real(RP) :: tmp_hyd, num_hyd_l, lambda_hyd
1730 
1731  integer :: k, i, j, iq
1732 
1733  if ( present(qnum) ) then
1734  log_warn("ATMOS_PHY_MP_suzuki10_qhyd2qtrc",*) 'At this moment, number concentratio is ignored'
1735  end if
1736 
1737  !--- define coefficients
1738  coef0 = 4.0_rp/3.0_rp*pi
1739  coef1 = 4.0_rp/3.0_rp*sqrt(pi/2.0_rp)
1740 
1741  if( nspc == 1 ) then !--- put all hydrometeors to liquid (warm bin)
1742 
1743  do j = js, je
1744  do i = is, ie
1745  do k = ks, ke
1746 
1747  tmp_hyd = 0.0_rp
1748  do iq = 1, nbin
1749  dummy(iq) = coef1 / sigma_sdf(1) * rho_sdf(1) * radc( iq )**3 &
1750  * exp( &
1751  - ( log( radc(iq) )-log( r0_sdf(1) ) )**2*0.5_rp &
1752  / sigma_sdf(1) / sigma_sdf(1) &
1753  )
1754  tmp_hyd = tmp_hyd + dummy(iq)
1755  enddo
1756 
1757  coef2 = ( qe(k,i,j,i_hc) + qe(k,i,j,i_hr) &
1758  + qe(k,i,j,i_hi) + qe(k,i,j,i_hs) + qe(k,i,j,i_hg) ) &
1759  / ( tmp_hyd + ( 0.50_rp - sign(0.50_rp,tmp_hyd-eps) ) )
1760 
1761  do iq = 1, nbin
1762  qtrc(k+2,i,j,(il-1)*nbin+iq) = coef2 * dummy(iq)
1763  enddo
1764 
1765  enddo
1766  enddo
1767  enddo
1768 
1769  elseif( nspc > 1 ) then !--- put each hydrometeor to each category (ice bin)
1770 
1771  do j = js, je
1772  do i = is, ie
1773  do k = ks, ke
1774 
1775  !--- Rain and Cloud put into liquid bin (log-normal)
1776  tmp_hyd = 0.0_rp
1777  do iq = 1, nbin
1778  dummy(iq) = coef1 / sigma_sdf(1) * rho_sdf(1) * radc( iq )**3 &
1779  * exp( &
1780  - ( log( radc(iq) )-log( r0_sdf(1) ) )**2*0.5_rp &
1781  / sigma_sdf(1) / sigma_sdf(1) &
1782  )
1783  tmp_hyd = tmp_hyd + dummy(iq)
1784  enddo
1785 
1786  coef2 = ( qe(k,i,j,i_hc) + qe(k,i,j,i_hr) ) &
1787  / ( tmp_hyd + ( 0.50_rp - sign(0.50_rp,tmp_hyd-eps) ) )
1788 
1789  do iq = 1, nbin
1790  qtrc(k,i,j,(il-1)*nbin+iq) = coef2 * dummy(iq)
1791  enddo
1792 
1793  !--- Ice put into plate bin (log-normal)
1794  tmp_hyd = 0.0_rp
1795  do iq = 1, nbin
1796  dummy(iq) = coef1 / sigma_sdf(2) * rho_sdf(2) * radc( iq )**3 &
1797  * exp( &
1798  - ( log( radc(iq) )-log( r0_sdf(2) ) )**2*0.5_rp &
1799  / sigma_sdf(2) / sigma_sdf(2) &
1800  )
1801  tmp_hyd = tmp_hyd + dummy(iq)
1802  enddo
1803 
1804  coef2 = ( qe(k,i,j,i_hi) ) &
1805  / ( tmp_hyd + ( 0.50_rp - sign(0.50_rp,tmp_hyd-eps) ) )
1806 
1807  do iq = 1, nbin
1808  qtrc(k,i,j,(ip-1)*nbin+iq) = coef2 * dummy(iq)
1809  enddo
1810 
1811  !--- Snow put into snow bin (gamma)
1812  num_hyd_l = coef0 * n0_sdf(3) * rho_sdf(3)
1813  lambda_hyd = ( pi * rho_sdf(3) / 6.0_rp *n0_sdf(3) * sf_gamma(4.0_rp) &
1814  / ( qe(k,i,j,i_hs) &
1815  + (0.50_rp-sign(0.50_rp,qe(k,i,j,i_hs)-eps)) &
1816  ) )**(0.25_rp)
1817 
1818  tmp_hyd = 0.0_rp
1819  do iq = 1, nbin
1820  dummy(iq) = num_hyd_l * radc( iq )**3 &
1821  * exp( -lambda_hyd * 0.5_rp * radc( iq ) )
1822  tmp_hyd = tmp_hyd + dummy(iq)
1823  enddo
1824 
1825  coef2 = ( qe(k,i,j,i_hs) ) &
1826  / ( tmp_hyd + ( 0.50_rp - sign(0.50_rp,tmp_hyd-eps) ) )
1827 
1828  do iq = 1, nbin
1829  qtrc(k,i,j,(iss-1)*nbin+iq) = coef2 * dummy(iq)
1830  enddo
1831 
1832  !--- Graupel put into Graupel bin (gamma)
1833  num_hyd_l = coef0 * n0_sdf(4) * rho_sdf(4)
1834  lambda_hyd = ( pi * rho_sdf(4) / 6.0_rp *n0_sdf(4) * sf_gamma(4.0_rp) &
1835  / ( qe(k,i,j,i_hg) &
1836  + (0.50_rp-sign(0.50_rp,qe(k,i,j,i_hg)-eps)) &
1837  ) )**(0.25_rp)
1838 
1839  tmp_hyd = 0.0_rp
1840  do iq = 1, nbin
1841  dummy(iq) = num_hyd_l * radc( iq )**3 &
1842  * exp( -lambda_hyd * 0.5_rp * radc( iq ) )
1843  tmp_hyd = tmp_hyd + dummy(iq)
1844  enddo
1845 
1846  coef2 = ( qe(k,i,j,i_hg) ) &
1847  / ( tmp_hyd + ( 0.50_rp - sign(0.50_rp,tmp_hyd-eps) ) )
1848 
1849  do iq = 1, nbin
1850  qtrc(k,i,j,(ig-1)*nbin+iq) = coef2 * dummy(iq)
1851  enddo
1852 
1853  !--- Hail put into Hail bin (gamma)
1854  num_hyd_l = coef0 * n0_sdf(5) * rho_sdf(5)
1855  lambda_hyd = ( pi * rho_sdf(5) / 6.0_rp *n0_sdf(5) * sf_gamma(4.0_rp) &
1856  / ( qe(k,i,j,i_hh) &
1857  + (0.50_rp-sign(0.50_rp,qe(k,i,j,i_hh)-eps)) &
1858  ) )**(0.25_rp)
1859 
1860  tmp_hyd = 0.0_rp
1861  do iq = 1, nbin
1862  dummy(iq) = num_hyd_l * radc( iq )**3 &
1863  * exp( -lambda_hyd * 0.5_rp * radc( iq ) )
1864  tmp_hyd = tmp_hyd + dummy(iq)
1865  enddo
1866 
1867  coef2 = ( qe(k,i,j,i_hh) ) &
1868  / ( tmp_hyd + ( 0.50_rp - sign(0.50_rp,tmp_hyd-eps) ) )
1869 
1870  do iq = 1, nbin
1871  qtrc(k,i,j,(ih-1)*nbin+iq) = coef2 * dummy(iq)
1872  enddo
1873 
1874  enddo
1875  enddo
1876  enddo
1877 
1878  endif
1879 
1880  do iq = num_hyd+1, qa-1
1881  do j = js, je
1882  do i = is, ie
1883  do k = ks, ke
1884  qtrc(k,i,j,iq) = 0.0_rp
1885  end do
1886  end do
1887  end do
1888  end do
1889 
1890  return

References scale_const::const_eps, scale_const::const_pi, 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_atmos_hydrometeor::n_hyd, nbin, and scale_specfunc::sf_gamma().

Referenced by mod_atmos_phy_mp_driver::atmos_phy_mp_driver_qhyd2qtrc().

Here is the call graph for this function:
Here is the caller graph for this function:

◆ atmos_phy_mp_suzuki10_crg_qtrc2qhyd()

subroutine, public scale_atmos_phy_mp_suzuki10::atmos_phy_mp_suzuki10_crg_qtrc2qhyd ( 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,num_hyd), intent(in)  QTRC0,
real(rp), dimension(ka,ia,ja,n_hyd), intent(out)  Qecrg 
)

get charge density ratio of each category

Definition at line 1901 of file scale_atmos_phy_mp_suzuki10.F90.

1901  use scale_atmos_hydrometeor, only: &
1902  n_hyd, &
1903  i_hc, &
1904  i_hr, &
1905  i_hi, &
1906  i_hs, &
1907  i_hg, &
1908  i_hh
1909  implicit none
1910 
1911  integer, intent(in) :: KA, KS, KE
1912  integer, intent(in) :: IA, IS, IE
1913  integer, intent(in) :: JA, JS, JE
1914  real(RP), intent(in) :: QTRC0(KA,IA,JA,num_hyd) ! tracer charge density [fC/kg]
1915  real(RP), intent(out) :: Qecrg(KA,IA,JA,N_HYD) ! charge density ratio of each cateory [fC/kg]
1916 
1917  integer :: ihydro, ibin, iq, icateg
1918  integer :: k, i, j
1919  !---------------------------------------------------------------------------
1920 
1921 !OCL XFILL
1922  qecrg(:,:,:,:) = 0.0_rp
1923 
1924  do ihydro = 1, nspc
1925  do ibin = 1, nbin
1926  iq = nbin*(ihydro-1) + ibin
1927 
1928  if ( iq > 0 .AND. iq <= nbin*(i_mp_qc ) ) then ! liquid
1929  if ( iq > 0 .AND. iq <= nbnd ) then ! cloud
1930  icateg = i_hc
1931  elseif( iq > nbnd .AND. iq <= nbin ) then ! rain
1932  icateg = i_hr
1933  endif
1934  elseif( iq > nbin*(i_mp_qcl-1) .AND. iq <= nbin*(i_mp_qcl) ) then ! ice (column)
1935  icateg = i_hi
1936  elseif( iq > nbin*(i_mp_qp -1) .AND. iq <= nbin*(i_mp_qp ) ) then ! ice (plate)
1937  icateg = i_hi
1938  elseif( iq > nbin*(i_mp_qd -1) .AND. iq <= nbin*(i_mp_qd ) ) then ! ice (dendrite)
1939  icateg = i_hi
1940  elseif( iq > nbin*(i_mp_qs -1) .AND. iq <= nbin*(i_mp_qs ) ) then ! snow
1941  icateg = i_hs
1942  elseif( iq > nbin*(i_mp_qg -1) .AND. iq <= nbin*(i_mp_qg ) ) then ! graupel
1943  icateg = i_hg
1944  elseif( iq > nbin*(i_mp_qh -1) .AND. iq <= num_hyd ) then ! hail
1945  icateg = i_hh
1946  endif
1947 
1948  do j = js, je
1949  do i = is, ie
1950  do k = ks, ke
1951  qecrg(k,i,j,icateg) = qecrg(k,i,j,icateg) + qtrc0(k,i,j,iq)
1952  enddo
1953  enddo
1954  enddo
1955  enddo
1956  enddo
1957 
1958  return

References scale_const::const_dwatr, scale_const::const_emelt, scale_const::const_eps, scale_const::const_pi, scale_const::const_psat0, scale_const::const_rvap, scale_const::const_tem00, scale_const::const_tmelt, scale_atmos_hydrometeor::cp_ice, scale_atmos_hydrometeor::cp_vapor, scale_atmos_hydrometeor::cp_water, scale_atmos_hydrometeor::cv_ice, scale_atmos_hydrometeor::cv_vapor, scale_atmos_hydrometeor::cv_water, 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_atmos_hydrometeor::n_hyd, nbin, nccn, scale_prc::prc_abort(), scale_prof::prof_rapend(), and scale_prof::prof_rapstart().

Referenced by mod_atmos_phy_mp_driver::atmos_phy_mp_driver_calc_tendency().

Here is the call graph for this function:
Here is the caller graph for this function:

Variable Documentation

◆ atmos_phy_mp_suzuki10_ntracers

integer, public scale_atmos_phy_mp_suzuki10::atmos_phy_mp_suzuki10_ntracers

Definition at line 55 of file scale_atmos_phy_mp_suzuki10.F90.

55  integer, public :: ATMOS_PHY_MP_suzuki10_ntracers

Referenced by mod_atmos_phy_mp_driver::atmos_phy_mp_driver_tracer_setup(), and atmos_phy_mp_suzuki10_tracer_setup().

◆ atmos_phy_mp_suzuki10_nwaters

integer, public scale_atmos_phy_mp_suzuki10::atmos_phy_mp_suzuki10_nwaters

◆ atmos_phy_mp_suzuki10_nices

integer, public scale_atmos_phy_mp_suzuki10::atmos_phy_mp_suzuki10_nices

◆ atmos_phy_mp_suzuki10_nccn

integer, public scale_atmos_phy_mp_suzuki10::atmos_phy_mp_suzuki10_nccn

◆ atmos_phy_mp_suzuki10_nbnd

integer, public scale_atmos_phy_mp_suzuki10::atmos_phy_mp_suzuki10_nbnd

Definition at line 59 of file scale_atmos_phy_mp_suzuki10.F90.

59  integer, public :: ATMOS_PHY_MP_suzuki10_nbnd

Referenced by atmos_phy_mp_suzuki10_setup().

◆ atmos_phy_mp_suzuki10_tracer_names

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

Definition at line 62 of file scale_atmos_phy_mp_suzuki10.F90.

62  character(len=H_SHORT), public, allocatable :: ATMOS_PHY_MP_suzuki10_tracer_names(:)

Referenced by mod_atmos_phy_mp_driver::atmos_phy_mp_driver_tracer_setup(), and atmos_phy_mp_suzuki10_tracer_setup().

◆ atmos_phy_mp_suzuki10_tracer_descriptions

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

Definition at line 63 of file scale_atmos_phy_mp_suzuki10.F90.

63  character(len=H_MID) , public, allocatable :: ATMOS_PHY_MP_suzuki10_tracer_descriptions(:)

Referenced by mod_atmos_phy_mp_driver::atmos_phy_mp_driver_tracer_setup(), and atmos_phy_mp_suzuki10_tracer_setup().

◆ atmos_phy_mp_suzuki10_tracer_units

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

Definition at line 64 of file scale_atmos_phy_mp_suzuki10.F90.

64  character(len=H_SHORT), public, allocatable :: ATMOS_PHY_MP_suzuki10_tracer_units(:)

Referenced by mod_atmos_phy_mp_driver::atmos_phy_mp_driver_tracer_setup(), and atmos_phy_mp_suzuki10_tracer_setup().

◆ nbin

integer, public scale_atmos_phy_mp_suzuki10::nbin = 33

◆ nccn

integer, public scale_atmos_phy_mp_suzuki10::nccn = 0
scale_prc::prc_abort
subroutine, public prc_abort
Abort Process.
Definition: scale_prc.F90:342
scale_atmos_hydrometeor::i_hr
integer, parameter, public i_hr
liquid water rain
Definition: scale_atmos_hydrometeor.F90:82
scale_atmos_hydrometeor::i_hs
integer, parameter, public i_hs
snow
Definition: scale_atmos_hydrometeor.F90:84
scale_const::const_eps
real(rp), public const_eps
small number
Definition: scale_const.F90:33
scale_atmos_hydrometeor
module atmosphere / hydrometeor
Definition: scale_atmos_hydrometeor.F90:12
scale_atmos_hydrometeor::i_hh
integer, parameter, public i_hh
hail
Definition: scale_atmos_hydrometeor.F90:86
scale_prc
module PROCESS
Definition: scale_prc.F90:11
scale_const::const_pi
real(rp), public const_pi
pi
Definition: scale_const.F90:31
scale_atmos_hydrometeor::i_hi
integer, parameter, public i_hi
ice water cloud
Definition: scale_atmos_hydrometeor.F90:83
scale_prc::prc_masterrank
integer, parameter, public prc_masterrank
master process in each communicator
Definition: scale_prc.F90:66
scale_const
module CONSTANT
Definition: scale_const.F90:11
scale_specfunc
module SPECFUNC
Definition: scale_specfunc.F90:14
scale_atmos_hydrometeor::i_hc
integer, parameter, public i_hc
liquid water cloud
Definition: scale_atmos_hydrometeor.F90:81
scale_const::const_dwatr
real(rp), parameter, public const_dwatr
density of water [kg/m3]
Definition: scale_const.F90:82
scale_const::const_tem00
real(rp), parameter, public const_tem00
temperature reference (0C) [K]
Definition: scale_const.F90:90
scale_comm_cartesc
module COMMUNICATION
Definition: scale_comm_cartesC.F90:11
scale_const::const_dice
real(rp), parameter, public const_dice
density of ice [kg/m3]
Definition: scale_const.F90:83
scale_specfunc::sf_gamma
real(rp) function, public sf_gamma(x)
Gamma function.
Definition: scale_specfunc.F90:50
scale_atmos_saturation
module atmosphere / saturation
Definition: scale_atmos_saturation.F90:12
scale_prc::prc_ismaster
logical, public prc_ismaster
master process in local communicator?
Definition: scale_prc.F90:91
scale_atmos_hydrometeor::i_hg
integer, parameter, public i_hg
graupel
Definition: scale_atmos_hydrometeor.F90:85