ERF
Energy Research and Forecasting: An Atmospheric Modeling Code
Functions/Subroutines | Variables
wdm6_isohelper Module Reference

Functions/Subroutines

real(kind=kind_phys) function, public wdm6_rgmma (x)
 
subroutine, public mp_wdm6_init_c (den0, denr, dens, cl, cpv, ccn0, hail_opt)
 
subroutine, public mp_wdm6_run_c (t, qv, qc, qi, qr, qs, qg, nn, nc, nr, den, p, delz, delt, g, cpd, cpv, rd, rv, t0c, ep1, ep2, qmin, xls, xlv0, xlf0, den0, denr, cliq, cice, psat, ccn0, xland, rain, rainncv, sr, snow, snowncv, graupel, graupelncv, rainonly, snowonly, ims, ime, jms, jme, kms, kme, its, ite, jts, jte, kts, kte, microphysics_debug, diag_i_dbg, diag_j_dbg)
 

Variables

integer, parameter kind_phys = c_double
 

Function/Subroutine Documentation

◆ mp_wdm6_init_c()

subroutine, public wdm6_isohelper::mp_wdm6_init_c ( real(c_double), intent(in), value  den0,
real(c_double), intent(in), value  denr,
real(c_double), intent(in), value  dens,
real(c_double), intent(in), value  cl,
real(c_double), intent(in), value  cpv,
real(c_double), intent(in), value  ccn0,
integer(c_int), intent(in), value  hail_opt 
)
49  real(c_double), value, intent(in) :: den0, denr, dens, cl, cpv, ccn0
50  integer(c_int), value, intent(in) :: hail_opt
51  character(len=256) :: errmsg
52  integer :: errflg
53 
54  call mp_wdm6_init(den0, denr, dens, cl, cpv, ccn0, int(hail_opt, kind(0)), errmsg, errflg)
55  if (errflg /= 0) then
56  write(*,'(A,1X,A)') 'mp_wdm6_init_c error:', trim(errmsg)
57  stop 1
58  end if
Here is the call graph for this function:

◆ mp_wdm6_run_c()

subroutine, public wdm6_isohelper::mp_wdm6_run_c ( real(c_double), dimension(ims:ime, jms:jme, kms:kme), intent(inout)  t,
real(c_double), dimension(ims:ime, jms:jme, kms:kme), intent(inout)  qv,
real(c_double), dimension(ims:ime, jms:jme, kms:kme), intent(inout)  qc,
real(c_double), dimension(ims:ime, jms:jme, kms:kme), intent(inout)  qi,
real(c_double), dimension(ims:ime, jms:jme, kms:kme), intent(inout)  qr,
real(c_double), dimension(ims:ime, jms:jme, kms:kme), intent(inout)  qs,
real(c_double), dimension(ims:ime, jms:jme, kms:kme), intent(inout)  qg,
real(c_double), dimension(ims:ime, jms:jme, kms:kme), intent(inout)  nn,
real(c_double), dimension(ims:ime, jms:jme, kms:kme), intent(inout)  nc,
real(c_double), dimension(ims:ime, jms:jme, kms:kme), intent(inout)  nr,
real(c_double), dimension(ims:ime, jms:jme, kms:kme), intent(in)  den,
real(c_double), dimension(ims:ime, jms:jme, kms:kme), intent(in)  p,
real(c_double), dimension(ims:ime, jms:jme, kms:kme), intent(in)  delz,
real(c_double), intent(in), value  delt,
real(c_double), intent(in), value  g,
real(c_double), intent(in), value  cpd,
real(c_double), intent(in), value  cpv,
real(c_double), intent(in), value  rd,
real(c_double), intent(in), value  rv,
real(c_double), intent(in), value  t0c,
real(c_double), intent(in), value  ep1,
real(c_double), intent(in), value  ep2,
real(c_double), intent(in), value  qmin,
real(c_double), intent(in), value  xls,
real(c_double), intent(in), value  xlv0,
real(c_double), intent(in), value  xlf0,
real(c_double), intent(in), value  den0,
real(c_double), intent(in), value  denr,
real(c_double), intent(in), value  cliq,
real(c_double), intent(in), value  cice,
real(c_double), intent(in), value  psat,
real(c_double), intent(in), value  ccn0,
real(c_double), dimension(ims:ime, jms:jme), intent(in)  xland,
real(c_double), dimension(ims:ime, jms:jme), intent(inout)  rain,
real(c_double), dimension(ims:ime, jms:jme), intent(inout)  rainncv,
real(c_double), dimension(ims:ime, jms:jme), intent(inout)  sr,
real(c_double), dimension(ims:ime, jms:jme), intent(inout)  snow,
real(c_double), dimension(ims:ime, jms:jme), intent(inout)  snowncv,
real(c_double), dimension(ims:ime, jms:jme), intent(inout)  graupel,
real(c_double), dimension(ims:ime, jms:jme), intent(inout)  graupelncv,
real(c_double), dimension(ims:ime, jms:jme), intent(inout)  rainonly,
real(c_double), dimension(ims:ime, jms:jme), intent(inout)  snowonly,
integer(c_int), intent(in), value  ims,
integer(c_int), intent(in), value  ime,
integer(c_int), intent(in), value  jms,
integer(c_int), intent(in), value  jme,
integer(c_int), intent(in), value  kms,
integer(c_int), intent(in), value  kme,
integer(c_int), intent(in), value  its,
integer(c_int), intent(in), value  ite,
integer(c_int), intent(in), value  jts,
integer(c_int), intent(in), value  jte,
integer(c_int), intent(in), value  kts,
integer(c_int), intent(in), value  kte,
integer(c_int), intent(in), value  microphysics_debug,
integer(c_int), intent(in), value  diag_i_dbg,
integer(c_int), intent(in), value  diag_j_dbg 
)
71  integer(c_int), value, intent(in) :: ims, ime, jms, jme, kms, kme
72  integer(c_int), value, intent(in) :: its, ite, jts, jte, kts, kte
73  integer(c_int), value, intent(in) :: microphysics_debug
74  integer(c_int), value, intent(in) :: diag_i_dbg, diag_j_dbg
75  real(c_double), intent(inout), dimension(ims:ime, jms:jme, kms:kme) :: t, qv, qc, qi, qr, qs, qg
76  real(c_double), intent(inout), dimension(ims:ime, jms:jme, kms:kme) :: nn, nc, nr
77  real(c_double), intent(in), dimension(ims:ime, jms:jme, kms:kme) :: den, p, delz
78  real(c_double), value, intent(in) :: delt, g, cpd, cpv, rd, rv, t0c, ep1, ep2, qmin, xls
79  real(c_double), value, intent(in) :: xlv0, xlf0, den0, denr, cliq, cice, psat, ccn0
80  real(c_double), intent(in), dimension(ims:ime, jms:jme) :: xland
81  real(c_double), intent(inout), dimension(ims:ime, jms:jme) :: rain, rainncv, sr
82  real(c_double), intent(inout), dimension(ims:ime, jms:jme) :: snow, snowncv, graupel, graupelncv
83  real(c_double), intent(inout), dimension(ims:ime, jms:jme) :: rainonly, snowonly
84 
85  integer :: i, j, k, kk, kdim, debug_local, i_dbg_local, j_dbg_target
86  integer :: i_max, k_max, max_loc(2) ! For storm cell diagnostic
87  logical :: i_dbg_in_tile
88  integer :: errflg
89  character(len=256) :: errmsg
90 
91  real(c_double), allocatable :: t_col(:,:), q_col(:,:), qc_col(:,:), qi_col(:,:), qr_col(:,:), qs_col(:,:), qg_col(:,:)
92  real(c_double), allocatable :: nn_col(:,:), nc_col(:,:), nr_col(:,:)
93  real(c_double), allocatable :: den_col(:,:), p_col(:,:), delz_col(:,:)
94  real(c_double), allocatable :: xland_col(:)
95  real(c_double), allocatable :: rain_col(:), rainncv_col(:), sr_col(:)
96  real(c_double), allocatable :: snow_col(:), snowncv_col(:), graupel_col(:), graupelncv_col(:)
97  real(c_double), allocatable :: rainonly_col(:), snowonly_col(:)
98 
99  if (its < ims .or. ite > ime .or. jts < jms .or. jte > jme .or. kts < kms .or. kte > kme) then
100  write(*,'(A)') 'mp_wdm6_run_c bounds error: run-window outside storage bounds'
101  write(*,'(A,6(1X,I0))') ' storage ims ime jms jme kms kme =', ims, ime, jms, jme, kms, kme
102  write(*,'(A,6(1X,I0))') ' active its ite jts jte kts kte =', its, ite, jts, jte, kts, kte
103  stop 1
104  end if
105  if (its > ite .or. jts > jte .or. kts > kte) then
106  write(*,'(A)') 'mp_wdm6_run_c bounds error: invalid active index ordering'
107  write(*,'(A,6(1X,I0))') ' active its ite jts jte kts kte =', its, ite, jts, jte, kts, kte
108  stop 1
109  end if
110 
111  i_dbg_local = diag_i_dbg
112  i_dbg_in_tile = (i_dbg_local >= its .and. i_dbg_local <= ite)
113  if (.not. i_dbg_in_tile) i_dbg_local = its
114  j_dbg_target = diag_j_dbg
115  if (j_dbg_target < jts .or. j_dbg_target > jte) j_dbg_target = jts - 1
116 
117  kdim = kte - kts + 1
118 
119  allocate(t_col(its:ite,1:kdim), q_col(its:ite,1:kdim), qc_col(its:ite,1:kdim), qi_col(its:ite,1:kdim))
120  allocate(qr_col(its:ite,1:kdim), qs_col(its:ite,1:kdim), qg_col(its:ite,1:kdim))
121  allocate(nn_col(its:ite,1:kdim), nc_col(its:ite,1:kdim), nr_col(its:ite,1:kdim))
122  allocate(den_col(its:ite,1:kdim), p_col(its:ite,1:kdim), delz_col(its:ite,1:kdim))
123  allocate(xland_col(its:ite))
124  allocate(rain_col(its:ite), rainncv_col(its:ite), sr_col(its:ite))
125  allocate(snow_col(its:ite), snowncv_col(its:ite), graupel_col(its:ite), graupelncv_col(its:ite))
126  allocate(rainonly_col(its:ite), snowonly_col(its:ite))
127 
128  do j = jts, jte
129  do k = kts, kte
130  kk = k - kts + 1
131  do i = its, ite
132  t_col(i,kk) = t(i,j,k)
133  q_col(i,kk) = qv(i,j,k)
134  qc_col(i,kk) = qc(i,j,k)
135  qi_col(i,kk) = qi(i,j,k)
136  qr_col(i,kk) = qr(i,j,k)
137  qs_col(i,kk) = qs(i,j,k)
138  qg_col(i,kk) = qg(i,j,k)
139  nn_col(i,kk) = nn(i,j,k)
140  nc_col(i,kk) = nc(i,j,k)
141  nr_col(i,kk) = nr(i,j,k)
142  den_col(i,kk) = den(i,j,k)
143  p_col(i,kk) = p(i,j,k)
144  delz_col(i,kk) = delz(i,j,k)
145  end do
146  end do
147 
148  do i = its, ite
149  xland_col(i) = xland(i,j)
150  rain_col(i) = rain(i,j)
151  rainncv_col(i) = rainncv(i,j)
152  sr_col(i) = sr(i,j)
153  snow_col(i) = snow(i,j)
154  snowncv_col(i) = snowncv(i,j)
155  graupel_col(i) = graupel(i,j)
156  graupelncv_col(i)= graupelncv(i,j)
157  rainonly_col(i) = rainonly(i,j)
158  snowonly_col(i) = snowonly(i,j)
159  end do
160 
161  debug_local = int(microphysics_debug, kind(0))
162  if (microphysics_debug >= 1_c_int .and. (j /= j_dbg_target .or. .not. i_dbg_in_tile)) debug_local = 0
163 
164  call mp_wdm6_run(t_col, q_col, qc_col, qi_col, qr_col, qs_col, qg_col, &
165  nn_col, nc_col, nr_col, &
166  den_col, p_col, delz_col, &
167  delt, g, cpd, cpv, rd, rv, t0c, ep1, ep2, qmin, xls, xlv0, xlf0, den0, denr, &
168  cliq, cice, psat, ccn0, xland_col, &
169  rain_col, rainncv_col, sr_col, snow_col, snowncv_col, &
170  graupel_col, graupelncv_col, rainonly=rainonly_col, snowonly=snowonly_col, &
171  its=its, ite=ite, kts=1, kte=kdim, &
172  microphysics_debug=debug_local, diag_i_dbg=i_dbg_local, diag_j_dbg=j, diag_k_raw_base=kts, &
173  errmsg=errmsg, errflg=errflg)
174 
175  if (errflg /= 0) then
176  write(*,'(A,1X,I0,2A)') 'mp_wdm6_run_c error at j=', j, ': ', trim(errmsg)
177  write(*,'(A,6(1X,I0))') ' storage ims ime jms jme kms kme =', ims, ime, jms, jme, kms, kme
178  write(*,'(A,6(1X,I0))') ' active its ite jts jte kts kte =', its, ite, jts, jte, kts, kte
179  stop 1
180  end if
181 
182  do k = kts, kte
183  kk = k - kts + 1
184  do i = its, ite
185  t(i,j,k) = t_col(i,kk)
186  qv(i,j,k) = q_col(i,kk)
187  qc(i,j,k) = qc_col(i,kk)
188  qi(i,j,k) = qi_col(i,kk)
189  qr(i,j,k) = qr_col(i,kk)
190  qs(i,j,k) = qs_col(i,kk)
191  qg(i,j,k) = qg_col(i,kk)
192  nn(i,j,k) = nn_col(i,kk)
193  nc(i,j,k) = nc_col(i,kk)
194  nr(i,j,k) = nr_col(i,kk)
195  end do
196  end do
197 
198  do i = its, ite
199  rain(i,j) = rain_col(i)
200  rainncv(i,j) = rainncv_col(i)
201  sr(i,j) = sr_col(i)
202  snow(i,j) = snow_col(i)
203  snowncv(i,j) = snowncv_col(i)
204  graupel(i,j) = graupel_col(i)
205  graupelncv(i,j) = graupelncv_col(i)
206  rainonly(i,j) = rainonly_col(i)
207  snowonly(i,j) = snowonly_col(i)
208  end do
209  end do
210 
211  deallocate(t_col, q_col, qc_col, qi_col, qr_col, qs_col, qg_col)
212  deallocate(nn_col, nc_col, nr_col)
213  deallocate(den_col, p_col, delz_col, xland_col)
214  deallocate(rain_col, rainncv_col, sr_col, snow_col, snowncv_col, graupel_col, graupelncv_col)
215  deallocate(rainonly_col, snowonly_col)
Here is the call graph for this function:

◆ wdm6_rgmma()

real(kind=kind_phys) function, public wdm6_isohelper::wdm6_rgmma ( real(kind=kind_phys), intent(in)  x)
24  implicit none
25  real(kind=kind_phys), intent(in) :: x
26  real(kind=kind_phys) :: rgmma_result
27  real(kind=kind_phys), parameter :: euler = 0.577215664901532_kind_phys
28  real(kind=kind_phys) :: y
29  integer :: i
30 
31  if (x == 1.0_kind_phys) then
32  rgmma_result = 0.0_kind_phys
33  return
34  endif
35 
36  rgmma_result = x * exp(euler * x)
37  do i = 1, 10000
38  y = real(i, kind=kind_phys)
39  rgmma_result = rgmma_result * (1.0_kind_phys + x/y) * exp(-x/y)
40  enddo
41  rgmma_result = 1.0_kind_phys / rgmma_result
42 

Variable Documentation

◆ kind_phys

integer, parameter wdm6_isohelper::kind_phys = c_double
private
15  integer, parameter :: kind_phys = c_double

Referenced by wdm6_rgmma().