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

Functions/Subroutines

subroutine wsm6_diag_value_string (val, sout)
 
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, microphysics_debug, diag_i_dbg, diag_j_dbg)
 

Variables

integer, parameter wsm6_diag_schema_v1 = 1
 

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 
)
21  real(c_double), value, intent(in) :: den0, denr, dens, cl, cpv
22  integer(c_int), value, intent(in) :: hail_opt
23  character(len=256) :: errmsg
24  integer :: errflg
25 
26  call mp_wsm6_init(den0, denr, dens, cl, cpv, int(hail_opt, kind(0)), errmsg, errflg)
27  if (errflg /= 0) then
28  write(*,'(A,1X,A)') 'mp_wsm6_init_c error:', trim(errmsg)
29  stop 1
30  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,
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 
)
39  integer(c_int), value, intent(in) :: ims, ime, jms, jme, kms, kme
40  integer(c_int), value, intent(in) :: its, ite, jts, jte, kts, kte
41  integer(c_int), value, intent(in) :: microphysics_debug
42  integer(c_int), value, intent(in) :: diag_i_dbg, diag_j_dbg
43  real(c_double), intent(inout), dimension(ims:ime, jms:jme, kms:kme) :: t, qv, qc, qi, qr, qs, qg
44  real(c_double), intent(in), dimension(ims:ime, jms:jme, kms:kme) :: den, p, delz
45  real(c_double), value, intent(in) :: delt, g, cpd, cpv, rd, rv, t0c, ep1, ep2, qmin, xls
46  real(c_double), value, intent(in) :: xlv0, xlf0, den0, denr, cliq, cice, psat
47  real(c_double), intent(inout), dimension(ims:ime, jms:jme) :: rain, rainncv, sr
48  real(c_double), intent(inout), dimension(ims:ime, jms:jme) :: snow, snowncv, graupel, graupelncv
49 
50  integer :: i, j, k, kk, kdim, debug_local, i_dbg_local, j_dbg_target
51  logical :: i_dbg_in_tile
52  integer :: errflg
53  character(len=256) :: errmsg
54  real(c_double) :: xlv1_bridge
55 
56  real(c_double), allocatable :: t_col(:,:), q_col(:,:), qc_col(:,:), qi_col(:,:), qr_col(:,:), qs_col(:,:), qg_col(:,:)
57  real(c_double), allocatable :: den_col(:,:), p_col(:,:), delz_col(:,:)
58  real(c_double), allocatable :: rain_col(:), rainncv_col(:), sr_col(:)
59  real(c_double), allocatable :: snow_col(:), snowncv_col(:), graupel_col(:), graupelncv_col(:)
60 
61  if (its < ims .or. ite > ime .or. jts < jms .or. jte > jme .or. kts < kms .or. kte > kme) then
62  write(*,'(A)') 'mp_wsm6_run_c bounds error: run-window outside storage bounds'
63  write(*,'(A,6(1X,I0))') ' storage ims ime jms jme kms kme =', ims, ime, jms, jme, kms, kme
64  write(*,'(A,6(1X,I0))') ' active its ite jts jte kts kte =', its, ite, jts, jte, kts, kte
65  stop 1
66  end if
67  if (its > ite .or. jts > jte .or. kts > kte) then
68  write(*,'(A)') 'mp_wsm6_run_c bounds error: invalid active index ordering'
69  write(*,'(A,6(1X,I0))') ' active its ite jts jte kts kte =', its, ite, jts, jte, kts, kte
70  stop 1
71  end if
72 
73  i_dbg_local = diag_i_dbg
74  i_dbg_in_tile = (i_dbg_local >= its .and. i_dbg_local <= ite)
75  if (.not. i_dbg_in_tile) i_dbg_local = its
76  j_dbg_target = diag_j_dbg
77  if (j_dbg_target < jts .or. j_dbg_target > jte) j_dbg_target = jts - 1
78 
79  kdim = kte - kts + 1
80  xlv1_bridge = cliq - cpv
81 
82  ! Scratch columns passed to mp_wsm6_run use active bounds its:ite
83  ! because the Fortran core dummy arrays are declared dimension(its:...).
84  ! Raw C-binding arrays remain storage-bounded ims:ime.
85  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))
86  allocate(qr_col(its:ite,1:kdim), qs_col(its:ite,1:kdim), qg_col(its:ite,1:kdim))
87  allocate(den_col(its:ite,1:kdim), p_col(its:ite,1:kdim), delz_col(its:ite,1:kdim))
88  allocate(rain_col(its:ite), rainncv_col(its:ite), sr_col(its:ite))
89  allocate(snow_col(its:ite), snowncv_col(its:ite), graupel_col(its:ite), graupelncv_col(its:ite))
90 
91  do j = jts, jte
92  do k = kts, kte
93  kk = k - kts + 1
94  do i = its, ite
95  t_col(i,kk) = t(i,j,k)
96  q_col(i,kk) = qv(i,j,k)
97  qc_col(i,kk) = qc(i,j,k)
98  qi_col(i,kk) = qi(i,j,k)
99  qr_col(i,kk) = qr(i,j,k)
100  qs_col(i,kk) = qs(i,j,k)
101  qg_col(i,kk) = qg(i,j,k)
102  den_col(i,kk) = den(i,j,k)
103  p_col(i,kk) = p(i,j,k)
104  delz_col(i,kk) = delz(i,j,k)
105  end do
106  end do
107 
108  do i = its, ite
109  rain_col(i) = rain(i,j)
110  rainncv_col(i) = rainncv(i,j)
111  sr_col(i) = sr(i,j)
112  snow_col(i) = snow(i,j)
113  snowncv_col(i) = snowncv(i,j)
114  graupel_col(i) = graupel(i,j)
115  graupelncv_col(i)= graupelncv(i,j)
116  end do
117 
118  debug_local = int(microphysics_debug, kind(0))
119  if (microphysics_debug >= 1_c_int .and. (j /= j_dbg_target .or. .not. i_dbg_in_tile)) debug_local = 0
120 
121  call mp_wsm6_run(t_col, q_col, qc_col, qi_col, qr_col, qs_col, qg_col, den_col, p_col, delz_col, &
122  delt, g, cpd, cpv, rd, rv, t0c, ep1, ep2, qmin, xls, xlv0, xlf0, den0, denr, &
123  cliq, cice, psat, rain_col, rainncv_col, sr_col, snow_col, snowncv_col, &
124  graupel_col, graupelncv_col, its=its, ite=ite, kts=1, kte=kdim, &
125  microphysics_debug=debug_local, diag_i_dbg=i_dbg_local, diag_j_dbg=j, diag_k_raw_base=kts, &
126  errmsg=errmsg, errflg=errflg)
127 
128  if (errflg /= 0) then
129  write(*,'(A,1X,I0,2A)') 'mp_wsm6_run_c error at j=', j, ': ', trim(errmsg)
130  write(*,'(A,6(1X,I0))') ' storage ims ime jms jme kms kme =', ims, ime, jms, jme, kms, kme
131  write(*,'(A,6(1X,I0))') ' active its ite jts jte kts kte =', its, ite, jts, jte, kts, kte
132  stop 1
133  end if
134 
135  do k = kts, kte
136  kk = k - kts + 1
137  do i = its, ite
138  t(i,j,k) = t_col(i,kk)
139  qv(i,j,k) = q_col(i,kk)
140  qc(i,j,k) = qc_col(i,kk)
141  qi(i,j,k) = qi_col(i,kk)
142  qr(i,j,k) = qr_col(i,kk)
143  qs(i,j,k) = qs_col(i,kk)
144  qg(i,j,k) = qg_col(i,kk)
145  end do
146  end do
147 
148  do i = its, ite
149  rain(i,j) = rain_col(i)
150  rainncv(i,j) = rainncv_col(i)
151  sr(i,j) = sr_col(i)
152  snow(i,j) = snow_col(i)
153  snowncv(i,j) = snowncv_col(i)
154  graupel(i,j) = graupel_col(i)
155  graupelncv(i,j) = graupelncv_col(i)
156  end do
157  end do
158 
159  deallocate(t_col, q_col, qc_col, qi_col, qr_col, qs_col, qg_col)
160  deallocate(den_col, p_col, delz_col)
161  deallocate(rain_col, rainncv_col, sr_col, snow_col, snowncv_col, graupel_col, graupelncv_col)
Here is the call graph for this function:

◆ wsm6_diag_value_string()

subroutine mp_wsm6_isohelper::wsm6_diag_value_string ( real(c_double), intent(in)  val,
character(len=*), intent(out)  sout 
)
10  real(c_double), intent(in) :: val
11  character(len=*), intent(out) :: sout
12  character(len=64) :: tmp
13 
14  write(tmp,'(SP,ES30.20E3)') val
15  sout = trim(adjustl(tmp))

Variable Documentation

◆ wsm6_diag_schema_v1

integer, parameter mp_wsm6_isohelper::wsm6_diag_schema_v1 = 1
5  integer, parameter :: WSM6_DIAG_SCHEMA_V1 = 1