ERF
Energy Research and Forecasting: An Atmospheric Modeling Code
Functions/Subroutines
mp_wsm6_isohelper Module Reference

Functions/Subroutines

subroutine mp_wsm6_init_c (den0, denr, dens, cl, cpv, hail_opt)
 
subroutine mp_wsm6_run_c (t, qv, qc, qi, qr, qs, qg, den, p, delz, delt, g, cpd, cpv, rd, rv, t0c, ep1, ep2, qmin, xls, xlv0, xlf0, den0, denr, cliq, cice, psat, rain, rainncv, sr, snow, snowncv, graupel, graupelncv, ims, ime, jms, jme, kms, kme, its, ite, jts, jte, kts, kte)
 

Function/Subroutine Documentation

◆ mp_wsm6_init_c()

subroutine mp_wsm6_isohelper::mp_wsm6_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,
integer(c_int), intent(in), value  hail_opt 
)
9  real(c_double), value, intent(in) :: den0, denr, dens, cl, cpv
10  integer(c_int), value, intent(in) :: hail_opt
11  character(len=256) :: errmsg
12  integer :: errflg
13 
14  call mp_wsm6_init(den0, denr, dens, cl, cpv, int(hail_opt, kind(0)), errmsg, errflg)
15  if (errflg /= 0) then
16  write(*,'(A,1X,A)') 'mp_wsm6_init_c error:', trim(errmsg)
17  stop 1
18  end if
Here is the call graph for this function:

◆ mp_wsm6_run_c()

subroutine mp_wsm6_isohelper::mp_wsm6_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(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), 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 
)
27  integer(c_int), value, intent(in) :: ims, ime, jms, jme, kms, kme
28  integer(c_int), value, intent(in) :: its, ite, jts, jte, kts, kte
29  real(c_double), intent(inout), dimension(ims:ime, jms:jme, kms:kme) :: t, qv, qc, qi, qr, qs, qg
30  real(c_double), intent(in), dimension(ims:ime, jms:jme, kms:kme) :: den, p, delz
31  real(c_double), value, intent(in) :: delt, g, cpd, cpv, rd, rv, t0c, ep1, ep2, qmin, xls
32  real(c_double), value, intent(in) :: xlv0, xlf0, den0, denr, cliq, cice, psat
33  real(c_double), intent(inout), dimension(ims:ime, jms:jme) :: rain, rainncv, sr
34  real(c_double), intent(inout), dimension(ims:ime, jms:jme) :: snow, snowncv, graupel, graupelncv
35 
36  integer :: i, j, k, kk, kdim
37  integer :: errflg
38  character(len=256) :: errmsg
39 
40  real(c_double), allocatable :: t_col(:,:), q_col(:,:), qc_col(:,:), qi_col(:,:), qr_col(:,:), qs_col(:,:), qg_col(:,:)
41  real(c_double), allocatable :: den_col(:,:), p_col(:,:), delz_col(:,:)
42  real(c_double), allocatable :: rain_col(:), rainncv_col(:), sr_col(:)
43  real(c_double), allocatable :: snow_col(:), snowncv_col(:), graupel_col(:), graupelncv_col(:)
44 
45  if (its < ims .or. ite > ime .or. jts < jms .or. jte > jme .or. kts < kms .or. kte > kme) then
46  write(*,'(A)') 'mp_wsm6_run_c bounds error: run-window outside storage bounds'
47  write(*,'(A,6(1X,I0))') ' storage ims ime jms jme kms kme =', ims, ime, jms, jme, kms, kme
48  write(*,'(A,6(1X,I0))') ' active its ite jts jte kts kte =', its, ite, jts, jte, kts, kte
49  stop 1
50  end if
51  if (its > ite .or. jts > jte .or. kts > kte) then
52  write(*,'(A)') 'mp_wsm6_run_c bounds error: invalid active index ordering'
53  write(*,'(A,6(1X,I0))') ' active its ite jts jte kts kte =', its, ite, jts, jte, kts, kte
54  stop 1
55  end if
56 
57  kdim = kte - kts + 1
58 
59  allocate(t_col(ims:ime,1:kdim), q_col(ims:ime,1:kdim), qc_col(ims:ime,1:kdim), qi_col(ims:ime,1:kdim))
60  allocate(qr_col(ims:ime,1:kdim), qs_col(ims:ime,1:kdim), qg_col(ims:ime,1:kdim))
61  allocate(den_col(ims:ime,1:kdim), p_col(ims:ime,1:kdim), delz_col(ims:ime,1:kdim))
62  allocate(rain_col(ims:ime), rainncv_col(ims:ime), sr_col(ims:ime))
63  allocate(snow_col(ims:ime), snowncv_col(ims:ime), graupel_col(ims:ime), graupelncv_col(ims:ime))
64 
65  do j = jts, jte
66  do k = kts, kte
67  kk = k - kts + 1
68  do i = ims, ime
69  t_col(i,kk) = t(i,j,k)
70  q_col(i,kk) = qv(i,j,k)
71  qc_col(i,kk) = qc(i,j,k)
72  qi_col(i,kk) = qi(i,j,k)
73  qr_col(i,kk) = qr(i,j,k)
74  qs_col(i,kk) = qs(i,j,k)
75  qg_col(i,kk) = qg(i,j,k)
76  den_col(i,kk) = den(i,j,k)
77  p_col(i,kk) = p(i,j,k)
78  delz_col(i,kk) = delz(i,j,k)
79  end do
80  end do
81 
82  do i = ims, ime
83  rain_col(i) = rain(i,j)
84  rainncv_col(i) = rainncv(i,j)
85  sr_col(i) = sr(i,j)
86  snow_col(i) = snow(i,j)
87  snowncv_col(i) = snowncv(i,j)
88  graupel_col(i) = graupel(i,j)
89  graupelncv_col(i)= graupelncv(i,j)
90  end do
91 
92  call mp_wsm6_run(t_col, q_col, qc_col, qi_col, qr_col, qs_col, qg_col, den_col, p_col, delz_col, &
93  delt, g, cpd, cpv, rd, rv, t0c, ep1, ep2, qmin, xls, xlv0, xlf0, den0, denr, &
94  cliq, cice, psat, rain_col, rainncv_col, sr_col, snow_col, snowncv_col, &
95  graupel_col, graupelncv_col, its=its, ite=ite, kts=1, kte=kdim, errmsg=errmsg, errflg=errflg)
96 
97  if (errflg /= 0) then
98  write(*,'(A,1X,I0,2A)') 'mp_wsm6_run_c error at j=', j, ': ', trim(errmsg)
99  write(*,'(A,6(1X,I0))') ' storage ims ime jms jme kms kme =', ims, ime, jms, jme, kms, kme
100  write(*,'(A,6(1X,I0))') ' active its ite jts jte kts kte =', its, ite, jts, jte, kts, kte
101  stop 1
102  end if
103 
104  do k = kts, kte
105  kk = k - kts + 1
106  do i = its, ite
107  t(i,j,k) = t_col(i,kk)
108  qv(i,j,k) = q_col(i,kk)
109  qc(i,j,k) = qc_col(i,kk)
110  qi(i,j,k) = qi_col(i,kk)
111  qr(i,j,k) = qr_col(i,kk)
112  qs(i,j,k) = qs_col(i,kk)
113  qg(i,j,k) = qg_col(i,kk)
114  end do
115  end do
116 
117  do i = its, ite
118  rain(i,j) = rain_col(i)
119  rainncv(i,j) = rainncv_col(i)
120  sr(i,j) = sr_col(i)
121  snow(i,j) = snow_col(i)
122  snowncv(i,j) = snowncv_col(i)
123  graupel(i,j) = graupel_col(i)
124  graupelncv(i,j) = graupelncv_col(i)
125  end do
126  end do
127 
128  deallocate(t_col, q_col, qc_col, qi_col, qr_col, qs_col, qg_col)
129  deallocate(den_col, p_col, delz_col)
130  deallocate(rain_col, rainncv_col, sr_col, snow_col, snowncv_col, graupel_col, graupelncv_col)
Here is the call graph for this function: