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

Variable Documentation

◆ kind_phys

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

Referenced by wdm6_rgmma().