SCALE-RM
Functions/Subroutines
scale_atmos_phy_mp_convert Module Reference

module ATMOSPHERE / Physics Cloud Microphysics - Convert More...

Functions/Subroutines

subroutine, public atmos_phy_mp_bulk2bin (xs, xe, ys, ye, dims, it, rank, handle, basename_org, dens_org, qtrc_org)
 Bulk to Bin. More...
 
subroutine, public atmos_phy_mp_bin2bulk
 Bin to Bulk. More...
 

Detailed Description

module ATMOSPHERE / Physics Cloud Microphysics - Convert

Description
Convert module for Cloud Microphysics Bulk to Bin, and Bin to Bulk
Author
Team SCALE
History
  • 2015-01-20 (Y.Sato) [new]
NAMELIST
  • PARAM_ATMOS_PHY_MP_BIN2BULK
    nametypedefault valuecomment
    SIGMA_SDF real(RP), dimension(4)
    R0_SDF real(RP), dimension(4)
    N0_SDF real(RP), dimension(4)
    RHO_SDF real(RP), dimension(4)
    MP_TYPE_OUTER character(len=H_SHORT) "NONE"
    MP_TYPE_INNER character(len=H_SHORT) "NONE"

History Output
No history output

Function/Subroutine Documentation

◆ atmos_phy_mp_bulk2bin()

subroutine, public scale_atmos_phy_mp_convert::atmos_phy_mp_bulk2bin ( integer, intent(in)  xs,
integer, intent(in)  xe,
integer, intent(in)  ys,
integer, intent(in)  ye,
integer, dimension(:), intent(in)  dims,
integer, intent(in)  it,
integer, intent(in)  rank,
integer, intent(in)  handle,
character(len=*), intent(in)  basename_org,
real(rp), dimension(:,:,:), intent(in)  dens_org,
real(rp), dimension(:,:,:,:), intent(inout)  qtrc_org 
)

Bulk to Bin.

Definition at line 88 of file scale_atmos_phy_mp_convert.F90.

References scale_atmos_phy_mp::atmos_phy_mp_name, scale_atmos_hydrometeor::i_qv, 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_atmos_phy_mp_suzuki10::nbin, scale_atmos_phy_mp_suzuki10::nspc, scale_grid_nest::parent_imax, scale_grid_nest::parent_jmax, scale_process::prc_mpistop(), scale_atmos_phy_mp::qa_mp, scale_atmos_phy_mp::qs_mp, and scale_specfunc::sf_gamma().

Referenced by mod_realinput_scale::parentatominputscale().

88  use scale_grid_nest, only: &
89  parent_imax, &
90  parent_jmax
91  use scale_specfunc, only: &
92  sf_gamma
93  use gtool_file, only: &
94  fileread
95  use scale_atmos_phy_mp, only: &
96  atmos_phy_mp_name, &
97  qa_mp, &
98  qs_mp
99  use scale_atmos_hydrometeor, only: &
100  i_qv
101  implicit none
102 
103  integer, intent(in) :: xs, xe
104  integer, intent(in) :: ys, ye
105  integer, intent(in) :: dims(:)
106  integer, intent(in) :: it
107  integer, intent(in) :: rank
108  integer, intent(in) :: handle
109  character(len=*), intent(in) :: basename_org
110  real(RP), intent(in) :: dens_org(:,:,:)
111  real(RP), intent(inout) :: qtrc_org(:,:,:,:)
112 ! real(RP), intent(in) :: dens_org(dims(1)+2,dims(2),dims(3))
113 ! real(RP), intent(inout) :: qtrc_org(dims(1)+2,dims(2),dims(3),11)
114 
115  real(RP) :: sigma_sdf(4)
116  real(RP) :: r0_sdf(4)
117  real(RP) :: n0_sdf(4)
118  real(RP) :: rho_sdf(4)
119  character(len=11), parameter :: fname_micpara="micpara.dat"
120  character(len=H_SHORT) :: MP_TYPE_OUTER = "NONE"
121  character(len=H_SHORT) :: MP_TYPE_INNER = "NONE"
122 
123  namelist / param_atmos_phy_mp_bin2bulk / &
124  sigma_sdf, &
125  r0_sdf, &
126  n0_sdf, &
127  rho_sdf, &
128  mp_type_outer, &
129  mp_type_inner
130 
131  real(RP), allocatable :: read3Di(:,:,:)
132  real(RP), allocatable :: qc_tmp(:,:,:)
133  real(RP), allocatable :: qr_tmp(:,:,:)
134  real(RP), allocatable :: qi_tmp(:,:,:)
135  real(RP), allocatable :: qs_tmp(:,:,:)
136  real(RP), allocatable :: qg_tmp(:,:,:)
137 
138  integer :: fid_micpara
139  real(RP) :: coef0, coef1, coef2
140  real(RP) :: tmp_hyd, n_hyd, lambda_hyd
141  real(RP) :: dummy( nbin ), radc( nbin )
142  integer :: k, i, j, iq, iqa, ierr
143  integer :: nnbin, nnspc, nn
144  !---------------------------------------------------------------------------
145 
146  !--- define coefficients
147  coef0 = 4.0_rp/3.0_rp*pi
148  coef1 = 4.0_rp/3.0_rp*sqrt(pi/2.0_rp)
149 
150  !--- determine the parameters for interpolating SDF from qxx, Nxx of parent domain
151  sigma_sdf(1) = 0.2_rp
152  sigma_sdf(2) = 0.35_rp
153  sigma_sdf(3) = 0.35_rp
154  sigma_sdf(4) = 0.35_rp
155  r0_sdf(1) = 5.e-6_rp
156  r0_sdf(2) = 2.61e-6_rp
157  r0_sdf(3) = 5.e-6_rp
158  r0_sdf(4) = 2.61e-6_rp
159  n0_sdf(1) = 8.0e+6_rp
160  n0_sdf(2) = 0.0_rp
161  n0_sdf(3) = 3.0e+6_rp
162  n0_sdf(4) = 4.0e+6_rp
163  rho_sdf(1) = dwatr
164  rho_sdf(2) = dice
165  rho_sdf(3) = 100.0_rp
166  rho_sdf(4) = 400.0_rp
167 
168  !---- initiate
169  allocate( read3di( parent_imax(handle), parent_jmax(handle), dims(1) ) )
170  allocate( qc_tmp(dims(1)+2,dims(2),dims(3)) )
171  allocate( qr_tmp(dims(1)+2,dims(2),dims(3)) )
172  allocate( qi_tmp(dims(1)+2,dims(2),dims(3)) )
173  allocate( qs_tmp(dims(1)+2,dims(2),dims(3)) )
174  allocate( qg_tmp(dims(1)+2,dims(2),dims(3)) )
175 
176  rewind(io_fid_conf)
177  read(io_fid_conf,nml=param_atmos_phy_mp_bin2bulk,iostat=ierr)
178  if( ierr < 0 ) then !--- missing
179  write(*,*) 'xxx Not found namelist PARAM_ATMOS_PHY_MP_BIN2BULK. Check!'
180  call prc_mpistop
181  elseif( ierr > 0 ) then !--- fatal error
182  write(*,*) 'xxx Not appropriate names in namelist PARAM_ATMOS_PHY_MP_BIN2BULK. Check!'
183  call prc_mpistop
184  endif
185  if( io_nml ) write(io_fid_nml,nml=param_atmos_phy_mp_bin2bulk)
186 
187  if( trim(mp_type_inner) /= "SUZUKI10" ) then
188  write(*,*) 'xxx MP_TYPE_INNER should be SUZUKI10 Check!'
189  write(*,*) 'Now MP_TYPE_INNER set as ', mp_type_inner
190  call prc_mpistop
191  endif
192 
193  !--- read micpara.dat (microphysical parameter) and broad cast
194  fid_micpara = io_get_available_fid()
195  !--- open parameter of cloud microphysics
196  open ( fid_micpara, file = fname_micpara, form = 'formatted', status = 'old', iostat=ierr )
197 
198  !--- micpara.dat does not exist
199  if( ierr == 0 ) then
200 
201  read( fid_micpara,* ) nnspc, nnbin
202 
203  if( nnbin /= nbin ) then
204  write(*,*) 'xxx nbin in inc_tracer and nbin in micpara.dat is different check!'
205  call prc_mpistop
206  end if
207 
208  ! grid parameter
209  if( io_l ) write(io_fid_log,*) '*** Radius of cloud ****'
210  do iq = 1, nbin
211  read( fid_micpara,* ) nn, dummy( iq ), radc( iq )
212  if( io_l ) write(io_fid_log,'(a,1x,i3,1x,a,1x,e15.7,1x,a)') &
213  "Radius of ", iq, "th cloud bin (bin center)= ", radc( iq ) , "[m]"
214  end do
215 
216  close ( fid_micpara )
217 
218  else
219 
220  write(*,*) 'xxx micpara.dat does not exist. check!'
221  call prc_mpistop
222 
223  endif
224 
225  call fileread( read3di(:,:,:), basename_org, "QV", it, rank )
226  do k = 1, dims(1)
227  qtrc_org(k+2,xs:xe,ys:ye,i_qv) = read3di(:,:,k)
228  end do
229 
230  if( trim(mp_type_outer) == "KESSLER" ) then
231 
232  if( io_l ) write(io_fid_log,*)
233  if( io_l ) write(io_fid_log,*) '+++ SDF of Bin model is created from'
234  if( io_l ) write(io_fid_log,*) '+++ Kessler type Bulk microphysical model'
235 
236  call fileread( read3di(:,:,:), basename_org, "QC", it, rank )
237  do k = 1, dims(1)
238  qc_tmp(k+2,xs:xe,ys:ye) = read3di(:,:,k)
239  end do
240 
241  call fileread( read3di(:,:,:), basename_org, "QR", it, rank )
242  do k = 1, dims(1)
243  qr_tmp(k+2,xs:xe,ys:ye) = read3di(:,:,k)
244  end do
245 
246  do k = 1, dims(1)
247  do i = xs, xe
248  do j = ys, ye
249 
250  do iq = 1, nbin
251  dummy(iq) = coef1 / sigma_sdf(1) * dwatr * radc( iq )**3 &
252  * exp( &
253  - ( log( radc(iq) )-log( r0_sdf(1) ) )**2*0.5_rp &
254  / sigma_sdf(1) / sigma_sdf(1) &
255  )
256  enddo
257 
258  tmp_hyd = 0.0_rp
259  do iq = 1, nbin
260  tmp_hyd = tmp_hyd + dummy(iq)
261  enddo
262 
263  coef2 = ( qc_tmp(k+2,i,j)+qr_tmp(k+2,i,j) ) &
264  / ( tmp_hyd + ( 0.50_rp - sign(0.50_rp,tmp_hyd-eps) ) )
265  do iq = 1, nbin
266  qtrc_org(k+2,i,j,qs_mp+iq) = coef2 * dummy(iq)
267  enddo
268 
269  enddo
270  enddo
271  enddo
272 
273  elseif( trim(mp_type_outer) == "TOMITA08" ) then
274 
275  if( io_l ) write(io_fid_log,*)
276  if( io_l ) write(io_fid_log,*) '+++ SDF of Bin model is created from'
277  if( io_l ) write(io_fid_log,*) '+++ TOMITA08 Bulk microphysical model'
278 
279  call fileread( read3di(:,:,:), basename_org, "QC", it, rank )
280  do k = 1, dims(1)
281  qc_tmp(k+2,xs:xe,ys:ye) = read3di(:,:,k)
282  end do
283 ! do k = 1, dims(1)
284 ! do i = xs, xe
285 ! do j = ys, ye
286 ! qtrc_tmp(k+2,i,j,I_QC) = qtrc_tmp(k+2,i,j,I_QC)*dens_org(k+2,i,j)
287 ! enddo
288 ! enddo
289 ! enddo
290 
291  call fileread( read3di(:,:,:), basename_org, "QR", it, rank )
292  do k = 1, dims(1)
293  qr_tmp(k+2,xs:xe,ys:ye) = read3di(:,:,k)
294  end do
295 
296  call fileread( read3di(:,:,:), basename_org, "QI", it, rank )
297  do k = 1, dims(1)
298  qi_tmp(k+2,xs:xe,ys:ye) = read3di(:,:,k)
299  end do
300 
301  call fileread( read3di(:,:,:), basename_org, "QS", it, rank )
302  do k = 1, dims(1)
303  qs_tmp(k+2,xs:xe,ys:ye) = read3di(:,:,k)
304  end do
305 
306  call fileread( read3di(:,:,:), basename_org, "QG", it, rank )
307  do k = 1, dims(1)
308  qg_tmp(k+2,xs:xe,ys:ye) = read3di(:,:,k)
309  end do
310 
311  if( nspc == 1 ) then !--- put all hydrometeors to liquid (warm bin)
312 
313  do k = 1, dims(1)
314  do i = xs, xe
315  do j = ys, ye
316 
317  do iq = 1, nbin
318  dummy(iq) = coef1 / sigma_sdf(1) * rho_sdf(1) * radc( iq )**3 &
319  * exp( &
320  - ( log( radc(iq) )-log( r0_sdf(1) ) )**2*0.5_rp &
321  / sigma_sdf(1) / sigma_sdf(1) &
322  )
323  enddo
324 
325  tmp_hyd = 0.0_rp
326  do iq = 1, nbin
327  tmp_hyd = tmp_hyd + dummy(iq)
328  enddo
329 
330  coef2 = ( &
331  qc_tmp(k+2,i,j)+qr_tmp(k+2,i,j) &
332  + qs_tmp(k+2,i,j)+qi_tmp(k+2,i,j) &
333  + qg_tmp(k+2,i,j) &
334  ) &
335  / ( tmp_hyd + ( 0.50_rp - sign(0.50_rp,tmp_hyd-eps) ) )
336  do iq = 1, nbin
337  qtrc_org(k+2,i,j,qs_mp+(il-1)*nbin+iq) = coef2 * dummy(iq)
338  enddo
339 
340  enddo
341  enddo
342  enddo
343 
344  elseif( nspc == 7 ) then !--- put each hydrometeor to each category (ice bin)
345 
346  do k = 1, dims(1)
347  do i = xs, xe
348  do j = ys, ye
349 
350  !--- Rain and Cloud put into liquid bin (log-normal)
351  do iq = 1, nbin
352  dummy(iq) = coef1 / sigma_sdf(1) * rho_sdf(1) * radc( iq )**3 &
353  * exp( &
354  - ( log( radc(iq) )-log( r0_sdf(1) ) )**2*0.5_rp &
355  / sigma_sdf(1) / sigma_sdf(1) &
356  )
357  enddo
358 
359  tmp_hyd = 0.0_rp
360  do iq = 1, nbin
361  tmp_hyd = tmp_hyd + dummy(iq)
362  enddo
363 
364  coef2 = ( qc_tmp(k+2,i,j)+qr_tmp(k+2,i,j) ) &
365  / ( tmp_hyd + ( 0.50_rp - sign(0.50_rp,tmp_hyd-eps) ) )
366  do iq = 1, nbin
367  qtrc_org(k+2,i,j,qs_mp+(il-1)*nbin+iq) = coef2 * dummy(iq)
368  enddo
369 
370  !--- Ice put into plate bin (log-normal)
371  do iq = 1, nbin
372  dummy(iq) = coef1 / sigma_sdf(2) * rho_sdf(2) * radc( iq )**3 &
373  * exp( &
374  - ( log( radc(iq) )-log( r0_sdf(2) ) )**2*0.5_rp &
375  / sigma_sdf(2) / sigma_sdf(2) &
376  )
377  enddo
378 
379  tmp_hyd = 0.0_rp
380  do iq = 1, nbin
381  tmp_hyd = tmp_hyd + dummy(iq)
382  enddo
383 
384  coef2 = qi_tmp(k+2,i,j) &
385  / ( tmp_hyd + ( 0.50_rp - sign(0.50_rp,tmp_hyd-eps) ) )
386  do iq = 1, nbin
387  qtrc_org(k+2,i,j,qs_mp+(ip-1)*nbin+iq) = coef2 * dummy(iq)
388  enddo
389 
390  !--- Snow put into snow bin (gamma)
391  n_hyd = coef0 * n0_sdf(3) * rho_sdf(3)
392  lambda_hyd = ( pi * rho_sdf(3) / 6.0_rp *n0_sdf(3) * sf_gamma(4.0_rp) &
393  / ( qs_tmp(k+2,i,j) &
394  + (0.50_rp-sign(0.50_rp,qs_tmp(k+2,i,j)-eps)) &
395  ) )**(0.25_rp)
396  do iq = 1, nbin
397  dummy(iq) = n_hyd * radc( iq )**3 &
398  * exp( -lambda_hyd * 0.5_rp * radc( iq ) )
399  enddo
400  tmp_hyd = 0.0_rp
401  do iq = 1, nbin
402  tmp_hyd = tmp_hyd + dummy(iq)
403  enddo
404 
405  coef2 = qs_tmp(k+2,i,j) &
406  / ( tmp_hyd + ( 0.50_rp - sign(0.50_rp,tmp_hyd-eps) ) )
407  do iq = 1, nbin
408  qtrc_org(k+2,i,j,qs_mp+(iss-1)*nbin+iq) = coef2 * dummy(iq)
409  enddo
410 
411  !--- Graupel put into Graupel bin (gamma)
412  n_hyd = coef0 * n0_sdf(4) * rho_sdf(4)
413  lambda_hyd = ( pi * rho_sdf(4) / 6.0_rp *n0_sdf(4) * sf_gamma(4.0_rp) &
414  / ( qg_tmp(k+2,i,j) &
415  + (0.50_rp-sign(0.50_rp,qg_tmp(k+2,i,j)-eps)) &
416  ) )**(0.25_rp)
417  do iq = 1, nbin
418  dummy(iq) = n_hyd * radc( iq )**3 &
419  * exp( -lambda_hyd * 0.5_rp * radc( iq ) )
420  enddo
421  tmp_hyd = 0.0_rp
422  do iq = 1, nbin
423  tmp_hyd = tmp_hyd + dummy(iq)
424  enddo
425 
426  coef2 = qg_tmp(k+2,i,j) &
427  / ( tmp_hyd + ( 0.50_rp - sign(0.50_rp,tmp_hyd-eps) ) )
428  do iq = 1, nbin
429  qtrc_org(k+2,i,j,qs_mp+(ig-1)*nbin+iq) = coef2 * dummy(iq)
430  enddo
431 
432  enddo
433  enddo
434  enddo
435 
436  endif
437 
438  elseif( trim(mp_type_outer) == "SN14" ) then
439 
440  write(*,*) 'SN14 is not supported for MP_TYPE_OUTER now'
441  write(*,*) 'Please wait'
442  call prc_mpistop
443 
444  elseif( trim(mp_type_outer) == "SUZUKI10" ) then
445 
446  if( io_l ) write(io_fid_log,*)
447  if( io_l ) write(io_fid_log,*) '+++ SDF of Bin model is created directory'
448  if( io_l ) write(io_fid_log,*) '+++ from Bin microphysical model'
449  do iq = 1, qa_mp
450  iqa = qs_mp + iq - 1
451  call fileread( read3di(:,:,:), basename_org, atmos_phy_mp_name(iq), it, rank )
452  do k = 1, dims(1)
453  qtrc_org(k+2,xs:xe,ys:ye,iqa) = read3di(:,:,k)
454  end do
455  end do
456 
457  else
458 
459  write(*,*) 'MP_TYPE_OUTER should be KESSLER, TOMITA08, or SUZUKI10'
460  write(*,*) 'Please check! Now MP_TYPE_OUTER set as ', mp_type_outer
461  call prc_mpistop
462 
463  endif
464 
465  deallocate( read3di )
466  deallocate( qc_tmp )
467  deallocate( qr_tmp )
468  deallocate( qi_tmp )
469  deallocate( qs_tmp )
470  deallocate( qg_tmp )
471 
472  return
gtool_file
module GTOOL_FILE
Definition: gtool_file.f90:17
scale_process::prc_mpistop
subroutine, public prc_mpistop
Abort MPI.
Definition: scale_process.F90:267
scale_grid_nest::parent_jmax
integer, dimension(2), public parent_jmax
parent max number in y-direction
Definition: scale_grid_nest.F90:66
scale_grid_nest
module GRID (nesting system)
Definition: scale_grid_nest.F90:15
scale_specfunc::sf_gamma
real(rp) function, public sf_gamma(x)
Gamma function.
Definition: scale_specfunc.F90:48
scale_atmos_phy_mp
module ATMOSPHERE / Physics Cloud Microphysics
Definition: scale_atmos_phy_mp.F90:17
scale_atmos_hydrometeor
module Hydrometeor
Definition: scale_atmos_sub_hydrometeor.F90:14
scale_specfunc
module SPECFUNC
Definition: scale_specfunc.F90:13
scale_grid_nest::parent_imax
integer, dimension(2), public parent_imax
parent max number in x-direction
Definition: scale_grid_nest.F90:65
Here is the call graph for this function:
Here is the caller graph for this function:

◆ atmos_phy_mp_bin2bulk()

subroutine, public scale_atmos_phy_mp_convert::atmos_phy_mp_bin2bulk ( )

Bin to Bulk.

Definition at line 478 of file scale_atmos_phy_mp_convert.F90.

478  !---------------------------------------------------------------------------
479 
480  return
Generated by   doxygen 1.8.14