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

Functions/Subroutines

subroutine morr_two_moment_init (morr_rimed_ice, morr_noice)
 
subroutine, public set_morrison_ndcnst (ndcnst_in)
 
subroutine, public mp_morr_two_moment (ITIMESTEP, TH, QV, QC, QR, QI, QS, QG, NI, NS, NR, NG, RHO, PII, P, DT_IN, DZ, W, RAINNC, RAINNCV, SR, SNOWNC, SNOWNCV, GRAUPELNC, GRAUPELNCV, refl_10cm, diagflag, do_radar_ref, qrcuten, qscuten, qicuten, F_QNDROP, qndrop, IDS, IDE, JDS, JDE, KDS, KDE, IMS, IME, JMS, JME, KMS, KME, ITS, ITE, JTS, JTE, KTS, KTE, wetscav_on, rainprod, evapprod, QLSINK, PRECR, PRECI, PRECS, PRECG)
 
subroutine, private morr_two_moment_micro (i, j, istep, kts, kte, QC3DTEN, QI3DTEN, QNI3DTEN, QR3DTEN, NI3DTEN, NS3DTEN, NR3DTEN, QC3D, QI3D, QNI3D, QR3D, NI3D, NS3D, NR3D, T3DTEN, QV3DTEN, T3D, QV3D, PRES, DZQ, W3D, RHO_ERF, PRECRT, SNOWRT, SNOWPRT, GRPLPRT, EFFC, EFFI, EFFS, EFFR, DT, QG3DTEN, NG3DTEN, QG3D, NG3D, EFFG, qrcu1d, qscu1d, qicu1d, QGSTEN, QRSTEN, QISTEN, QNISTEN, QCSTEN, nc3d, nc3dten, iinum, c2prec, CSED, ISED, SSED, GSED, RSED)
 
real(c_double) function, public polysvp (T, TYPE)
 
real(c_double) function, private gamma (X)
 

Variables

real(c_double), parameter, private pi = 3.1415926535897932384626434D0
 
real(c_double), parameter, private xxx = 0.9189385332046727417803297D0
 
integer, private iact
 
integer, private inum
 
real(c_double), private ndcnst
 
integer, private iliq
 
integer, private inuc
 
integer, private ibase
 
integer, private isub
 
integer, private igraup
 
integer, private ihail
 
real(c_double), private ai
 
real(c_double), private ac
 
real(c_double), private as
 
real(c_double), private ar
 
real(c_double), private ag
 
real(c_double), private bi
 
real(c_double), private bc
 
real(c_double), private bs
 
real(c_double), private br
 
real(c_double), private bg
 
real(c_double), private rhosu
 
real(c_double), private rhow
 
real(c_double), private rhoi
 
real(c_double), private rhosn
 
real(c_double), private rhog
 
real(c_double), private aimm
 
real(c_double), private bimm
 
real(c_double), private ecr
 
real(c_double), private dcs
 
real(c_double), private mi0
 
real(c_double), private mg0
 
real(c_double), private f1s
 
real(c_double), private f2s
 
real(c_double), private f1r
 
real(c_double), private f2r
 
real(c_double), private qsmall
 
real(c_double), private ci
 
real(c_double), private di
 
real(c_double), private cs
 
real(c_double), private ds
 
real(c_double), private cg
 
real(c_double), private dg
 
real(c_double), private eii
 
real(c_double), private eci
 
real(c_double), private rin
 
real(c_double), private cpw
 
real(c_double), private c1
 
real(c_double), private k1
 
real(c_double), private mw
 
real(c_double), private osm
 
real(c_double), private vi
 
real(c_double), private epsm
 
real(c_double), private rhoa
 
real(c_double), private map
 
real(c_double), private ma
 
real(c_double), private rr
 
real(c_double), private bact
 
real(c_double), private rm1
 
real(c_double), private rm2
 
real(c_double), private nanew1
 
real(c_double), private nanew2
 
real(c_double), private sig1
 
real(c_double), private sig2
 
real(c_double), private f11
 
real(c_double), private f12
 
real(c_double), private f21
 
real(c_double), private f22
 
real(c_double), private mmult
 
real(c_double), private lammaxi
 
real(c_double), private lammini
 
real(c_double), private lammaxr
 
real(c_double), private lamminr
 
real(c_double), private lammaxs
 
real(c_double), private lammins
 
real(c_double), private lammaxg
 
real(c_double), private lamming
 
real(c_double), private cons1
 
real(c_double), private cons2
 
real(c_double), private cons3
 
real(c_double), private cons4
 
real(c_double), private cons5
 
real(c_double), private cons6
 
real(c_double), private cons7
 
real(c_double), private cons8
 
real(c_double), private cons9
 
real(c_double), private cons10
 
real(c_double), private cons11
 
real(c_double), private cons12
 
real(c_double), private cons13
 
real(c_double), private cons14
 
real(c_double), private cons15
 
real(c_double), private cons16
 
real(c_double), private cons17
 
real(c_double), private cons18
 
real(c_double), private cons19
 
real(c_double), private cons20
 
real(c_double), private cons21
 
real(c_double), private cons22
 
real(c_double), private cons23
 
real(c_double), private cons24
 
real(c_double), private cons25
 
real(c_double), private cons26
 
real(c_double), private cons27
 
real(c_double), private cons28
 
real(c_double), private cons29
 
real(c_double), private cons30
 
real(c_double), private cons31
 
real(c_double), private cons32
 
real(c_double), private cons33
 
real(c_double), private cons34
 
real(c_double), private cons35
 
real(c_double), private cons36
 
real(c_double), private cons37
 
real(c_double), private cons38
 
real(c_double), private cons39
 
real(c_double), private cons40
 
real(c_double), private cons41
 

Function/Subroutine Documentation

◆ gamma()

real(c_double) function, private module_mp_morr_two_moment::gamma ( real(c_double)  X)
private
4110 !----------------------------------------------------------------------
4111 !
4112 ! THIS ROUTINE CALCULATES THE GAMMA FUNCTION FOR A REAL(C_DOUBLE) ARGUMENT X.
4113 ! COMPUTATION IS BASED ON AN ALGORITHM OUTLINED IN REFERENCE 1.
4114 ! THE PROGRAM USES RATIONAL FUNCTIONS THAT APPROXIMATE THE GAMMA
4115 ! FUNCTION TO AT LEAST 20 SIGNIFICANT DECIMAL DIGITS. COEFFICIENTS
4116 ! FOR THE APPROXIMATION OVER THE INTERVAL (1,2) ARE UNPUBLISHED.
4117 ! THOSE FOR THE APPROXIMATION FOR X .GE. 12 ARE FROM REFERENCE 2.
4118 ! THE ACCURACY ACHIEVED DEPENDS ON THE ARITHMETIC SYSTEM, THE
4119 ! COMPILER, THE INTRINSIC FUNCTIONS, AND PROPER SELECTION OF THE
4120 ! MACHINE-DEPENDENT CONSTANTS.
4121 !
4122 !
4123 !*******************************************************************
4124 !*******************************************************************
4125 !
4126 ! EXPLANATION OF MACHINE-DEPENDENT CONSTANTS
4127 !
4128 ! BETA - RADIX FOR THE FLOATING-POINT REPRESENTATION
4129 ! MAXEXP - THE SMALLEST POSITIVE POWER OF BETA THAT OVERFLOWS
4130 ! XBIG - THE LARGEST ARGUMENT FOR WHICH GAMMA(X) IS REPRESENTABLE
4131 ! IN THE MACHINE, I.E., THE SOLUTION TO THE EQUATION
4132 ! GAMMA(XBIG) = BETA**MAXEXP
4133 ! XINF - THE LARGEST MACHINE REPRESENTABLE FLOATING-POINT NUMBER;
4134 ! APPROXIMATELY BETA**MAXEXP
4135 ! EPS - THE SMALLEST POSITIVE FLOATING-POINT NUMBER SUCH THAT
4136 ! 1.0+EPS .GT. 1.0
4137 ! XMININ - THE SMALLEST POSITIVE FLOATING-POINT NUMBER SUCH THAT
4138 ! 1/XMININ IS MACHINE REPRESENTABLE
4139 !
4140 ! APPROXIMATE VALUES FOR SOME IMPORTANT MACHINES ARE:
4141 !
4142 ! BETA MAXEXP XBIG
4143 !
4144 ! CRAY-1 (S.P.) 2 8191 966.961
4145 ! CYBER 180/855
4146 ! UNDER NOS (S.P.) 2 1070 177.803
4147 ! IEEE (IBM/XT,
4148 ! SUN, ETC.) (S.P.) 2 128 35.040
4149 ! IEEE (IBM/XT,
4150 ! SUN, ETC.) (D.P.) 2 1024 171.624
4151 ! IBM 3033 (D.P.) 16 63 57.574
4152 ! VAX D-FORMAT (D.P.) 2 127 34.844
4153 ! VAX G-FORMAT (D.P.) 2 1023 171.489
4154 !
4155 ! XINF EPS XMININ
4156 !
4157 ! CRAY-1 (S.P.) 5.45E+2465 7.11E-15 1.84E-2466
4158 ! CYBER 180/855
4159 ! UNDER NOS (S.P.) 1.26E+322 3.55E-15 3.14E-294
4160 ! IEEE (IBM/XT,
4161 ! SUN, ETC.) (S.P.) 3.40E+38 1.19E-7 1.18E-38
4162 ! IEEE (IBM/XT,
4163 ! SUN, ETC.) (D.P.) 1.79D+308 2.22D-16 2.23D-308
4164 ! IBM 3033 (D.P.) 7.23D+75 2.22D-16 1.39D-76
4165 ! VAX D-FORMAT (D.P.) 1.70D+38 1.39D-17 5.88D-39
4166 ! VAX G-FORMAT (D.P.) 8.98D+307 1.11D-16 1.12D-308
4167 !
4168 !*******************************************************************
4169 !*******************************************************************
4170 !
4171 ! ERROR RETURNS
4172 !
4173 ! THE PROGRAM RETURNS THE VALUE XINF FOR SINGULARITIES OR
4174 ! WHEN OVERFLOW WOULD OCCUR. THE COMPUTATION IS BELIEVED
4175 ! TO BE FREE OF UNDERFLOW AND OVERFLOW.
4176 !
4177 !
4178 ! INTRINSIC FUNCTIONS REQUIRED ARE:
4179 !
4180 ! INT, DBLE, EXP, LOG, REAL(C_DOUBLE), SIN
4181 !
4182 !
4183 ! REFERENCES: AN OVERVIEW OF SOFTWARE DEVELOPMENT FOR SPECIAL
4184 ! FUNCTIONS W. J. CODY, LECTURE NOTES IN MATHEMATICS,
4185 ! 506, NUMERICAL ANALYSIS DUNDEE, 1975, G. A. WATSON
4186 ! (ED.), SPRINGER VERLAG, BERLIN, 1976.
4187 !
4188 ! COMPUTER APPROXIMATIONS, HART, ET. AL., WILEY AND
4189 ! SONS, NEW YORK, 1968.
4190 !
4191 ! LATEST MODIFICATION: OCTOBER 12, 1989
4192 !
4193 ! AUTHORS: W. J. CODY AND L. STOLTZ
4194 ! APPLIED MATHEMATICS DIVISION
4195 ! ARGONNE NATIONAL LABORATORY
4196 ! ARGONNE, IL 60439
4197 !
4198 !----------------------------------------------------------------------
4199  implicit none
4200  INTEGER I,N
4201  LOGICAL PARITY
4202  REAL(C_DOUBLE) &
4203  conv,eps,fact,half,one,res,sum,twelve, &
4204  two,x,xbig,xden,xinf,xminin,xnum,y,y1,ysq,z,zero
4205  REAL(C_DOUBLE), DIMENSION(7) :: C
4206  REAL(C_DOUBLE), DIMENSION(8) :: P
4207  REAL(C_DOUBLE), DIMENSION(8) :: Q
4208 !----------------------------------------------------------------------
4209 ! MATHEMATICAL CONSTANTS
4210 !----------------------------------------------------------------------
4211  DATA one,half,twelve,two,zero/1.0d0,0.5d0,12.0d0,2.0d0,0.0d0/
4212 
4213 
4214 !----------------------------------------------------------------------
4215 ! MACHINE DEPENDENT PARAMETERS
4216 !----------------------------------------------------------------------
4217  DATA xbig,xminin,eps/35.040d0,1.18d-38,1.19d-7/,xinf/3.4d38/
4218 !----------------------------------------------------------------------
4219 ! NUMERATOR AND DENOMINATOR COEFFICIENTS FOR RATIONAL MINIMAX
4220 ! APPROXIMATION OVER (1,2).
4221 !----------------------------------------------------------------------
4222  DATA p/-1.71618513886549492533811d+0,2.47656508055759199108314d+1, &
4223  -3.79804256470945635097577d+2,6.29331155312818442661052d+2, &
4224  8.66966202790413211295064d+2,-3.14512729688483675254357d+4, &
4225  -3.61444134186911729807069d+4,6.64561438202405440627855d+4/
4226  DATA q/-3.08402300119738975254353d+1,3.15350626979604161529144d+2, &
4227  -1.01515636749021914166146d+3,-3.10777167157231109440444d+3, &
4228  2.25381184209801510330112d+4,4.75584627752788110767815d+3, &
4229  -1.34659959864969306392456d+5,-1.15132259675553483497211d+5/
4230 !----------------------------------------------------------------------
4231 ! COEFFICIENTS FOR MINIMAX APPROXIMATION OVER (12, INF).
4232 !----------------------------------------------------------------------
4233  DATA c/-1.910444077728d-03,8.4171387781295d-04, &
4234  -5.952379913043012d-04,7.93650793500350248d-04, &
4235  -2.777777777777681622553d-03,8.333333333333333331554247d-02, &
4236  5.7083835261d-03/
4237 !----------------------------------------------------------------------
4238 ! STATEMENT FUNCTIONS FOR CONVERSION BETWEEN INTEGER AND FLOAT
4239 !----------------------------------------------------------------------
4240  conv(i) = real(i)
4241  parity=.false.
4242  fact=one
4243  n=0
4244  y=x
4245  IF(y.LE.zero)THEN
4246 !----------------------------------------------------------------------
4247 ! ARGUMENT IS NEGATIVE
4248 !----------------------------------------------------------------------
4249  y=-x
4250  y1=aint(y)
4251  res=y-y1
4252  IF(res.NE.zero)THEN
4253  IF(y1.NE.aint(y1*half)*two)parity=.true.
4254  fact=-pi/sin(pi*res)
4255  y=y+one
4256  ELSE
4257  res=xinf
4258  GOTO 900
4259  ENDIF
4260  ENDIF
4261 !----------------------------------------------------------------------
4262 ! ARGUMENT IS POSITIVE
4263 !----------------------------------------------------------------------
4264  IF(y.LT.eps)THEN
4265 !----------------------------------------------------------------------
4266 ! ARGUMENT .LT. EPS
4267 !----------------------------------------------------------------------
4268  IF(y.GE.xminin)THEN
4269  res=one/y
4270  ELSE
4271  res=xinf
4272  GOTO 900
4273  ENDIF
4274  ELSEIF(y.LT.twelve)THEN
4275  y1=y
4276  IF(y.LT.one)THEN
4277 !----------------------------------------------------------------------
4278 ! 0.0 .LT. ARGUMENT .LT. 1.0
4279 !----------------------------------------------------------------------
4280  z=y
4281  y=y+one
4282  ELSE
4283 !----------------------------------------------------------------------
4284 ! 1.0 .LT. ARGUMENT .LT. 12.0, REDUCE ARGUMENT IF NECESSARY
4285 !----------------------------------------------------------------------
4286  n=int(y)-1
4287  y=y-conv(n)
4288  z=y-one
4289  ENDIF
4290 !----------------------------------------------------------------------
4291 ! EVALUATE APPROXIMATION FOR 1.0 .LT. ARGUMENT .LT. 2.0
4292 !----------------------------------------------------------------------
4293  xnum=zero
4294  xden=one
4295  DO i=1,8
4296  xnum=(xnum+p(i))*z
4297  xden=xden*z+q(i)
4298  END DO
4299  res=xnum/xden+one
4300  IF(y1.LT.y)THEN
4301 !----------------------------------------------------------------------
4302 ! ADJUST RESULT FOR CASE 0.0 .LT. ARGUMENT .LT. 1.0
4303 !----------------------------------------------------------------------
4304  res=res/y1
4305  ELSEIF(y1.GT.y)THEN
4306 !----------------------------------------------------------------------
4307 ! ADJUST RESULT FOR CASE 2.0 .LT. ARGUMENT .LT. 12.0
4308 !----------------------------------------------------------------------
4309  DO i=1,n
4310  res=res*y
4311  y=y+one
4312  END DO
4313  ENDIF
4314  ELSE
4315 !----------------------------------------------------------------------
4316 ! EVALUATE FOR ARGUMENT .GE. 12.0,
4317 !----------------------------------------------------------------------
4318  IF(y.LE.xbig)THEN
4319  ysq=y*y
4320  sum=c(7)
4321  DO i=1,6
4322  sum=sum/ysq+c(i)
4323  END DO
4324  sum=sum/y-y+xxx
4325  sum=sum+(y-half)*log(y)
4326  res=exp(sum)
4327  ELSE
4328  res=xinf
4329  GOTO 900
4330  ENDIF
4331  ENDIF
4332 !----------------------------------------------------------------------
4333 ! FINAL ADJUSTMENTS AND RETURN
4334 !----------------------------------------------------------------------
4335  IF(parity)res=-res
4336  IF(fact.NE.one)res=fact/res
4337  900 gamma=res
4338  RETURN
4339 ! ---------- LAST LINE OF GAMMA ----------
real
double real
Definition: ERF_OrbCosZenith.H:9

◆ morr_two_moment_init()

subroutine module_mp_morr_two_moment::morr_two_moment_init ( integer, intent(in)  morr_rimed_ice,
integer, intent(in)  morr_noice 
)
252 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
253 ! THIS SUBROUTINE INITIALIZES ALL PHYSICAL CONSTANTS AMND PARAMETERS
254 ! NEEDED BY THE MICROPHYSICS SCHEME.
255 ! NEEDS TO BE CALLED AT FIRST TIME STEP, PRIOR TO CALL TO MAIN MICROPHYSICS INTERFACE
256 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
257 
258  IMPLICIT NONE
259 
260  INTEGER, INTENT(IN):: morr_rimed_ice ! RAS
261  INTEGER, INTENT(IN):: morr_noice
262 
263  integer n,i
264 
265  print *,'IN MORR_TWO_MOMENT_INIT ',"with noice = ",morr_noice
266 
267 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
268 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
269 
270 ! THE FOLLOWING PARAMETERS ARE USER-DEFINED SWITCHES AND NEED TO BE
271 ! SET PRIOR TO CODE COMPILATION
272 
273 ! INUM IS AUTOMATICALLY SET TO 0 FOR WRF-CHEM BELOW,
274 ! ALLOWING PREDICTION OF DROPLET CONCENTRATION
275 ! THUS, THIS PARAMETER SHOULD NOT BE CHANGED HERE
276 ! AND SHOULD BE LEFT TO 1
277 
278  inum = 1
279 
280 ! SET CONSTANT DROPLET CONCENTRATION (UNITS OF CM-3)
281 ! IF NO COUPLING WITH WRF-CHEM
282 
283  ndcnst = 250.
284 
285 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
286 ! NOTE, THE FOLLOWING OPTIONS RELATED TO DROPLET ACTIVATION
287 ! (IACT, IBASE, ISUB) ARE NOT AVAILABLE IN CURRENT VERSION
288 ! FOR WRF-CHEM, DROPLET ACTIVATION IS PERFORMED
289 ! IN 'MIX_ACTIVATE', NOT IN MICROPHYSICS SCHEME
290 
291 
292 ! IACT = 1, USE POWER-LAW CCN SPECTRA, NCCN = CS^K
293 ! IACT = 2, USE LOGNORMAL AEROSOL SIZE DIST TO DERIVE CCN SPECTRA
294 
295  iact = 2
296 
297 ! IBASE = 1, NEGLECT DROPLET ACTIVATION AT LATERAL CLOUD EDGES DUE TO
298 ! UNRESOLVED ENTRAINMENT AND MIXING, ACTIVATE
299 ! AT CLOUD BASE OR IN REGION WITH LITTLE CLOUD WATER USING
300 ! NON-EQULIBRIUM SUPERSATURATION ASSUMING NO INITIAL CLOUD WATER,
301 ! IN CLOUD INTERIOR ACTIVATE USING EQUILIBRIUM SUPERSATURATION
302 ! IBASE = 2, ASSUME DROPLET ACTIVATION AT LATERAL CLOUD EDGES DUE TO
303 ! UNRESOLVED ENTRAINMENT AND MIXING DOMINATES,
304 ! ACTIVATE DROPLETS EVERYWHERE IN THE CLOUD USING NON-EQUILIBRIUM
305 ! SUPERSATURATION ASSUMING NO INITIAL CLOUD WATER, BASED ON THE
306 ! LOCAL SUB-GRID AND/OR GRID-SCALE VERTICAL VELOCITY
307 ! AT THE GRID POINT
308 
309 ! NOTE: ONLY USED FOR PREDICTED DROPLET CONCENTRATION (INUM = 0)
310 
311  ibase = 2
312 
313 ! INCLUDE SUB-GRID VERTICAL VELOCITY (standard deviation of w) IN DROPLET ACTIVATION
314 ! ISUB = 0, INCLUDE SUB-GRID W (RECOMMENDED FOR LOWER RESOLUTION)
315 ! currently, sub-grid w is constant of 0.5 m/s (not coupled with PBL/turbulence scheme)
316 ! ISUB = 1, EXCLUDE SUB-GRID W, ONLY USE GRID-SCALE W
317 
318 ! NOTE: ONLY USED FOR PREDICTED DROPLET CONCENTRATION (INUM = 0)
319 
320  isub = 0
321 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
322  if(morr_noice .eq. 1) then
323 
324 ! SWITCH FOR LIQUID-ONLY RUN
325 ! ILIQ = 0, INCLUDE ICE
326 ! ILIQ = 1, LIQUID ONLY, NO ICE
327 
328  iliq = 1
329 
330 ! SWITCH FOR ICE NUCLEATION
331 ! INUC = 0, USE FORMULA FROM RASMUSSEN ET AL. 2002 (MID-LATITUDE)
332 ! = 1, USE MPACE OBSERVATIONS (ARCTIC ONLY)
333 
334  inuc = 0
335 
336 ! SWITCH FOR GRAUPEL/HAIL NO GRAUPEL/HAIL
337 ! IGRAUP = 0, INCLUDE GRAUPEL/HAIL
338 ! IGRAUP = 1, NO GRAUPEL/HAIL
339 
340  igraup = 1
341 
342 ! HM ADDED 11/7/07
343 ! SWITCH FOR HAIL/GRAUPEL
344 ! IHAIL = 0, DENSE PRECIPITATING ICE IS GRAUPEL
345 ! IHAIL = 1, DENSE PRECIPITATING ICE IS HAIL
346 ! NOTE ---> RECOMMEND IHAIL = 1 FOR CONTINENTAL DEEP CONVECTION
347 
348  !IHAIL = 0 !changed to namelist option (morr_rimed_ice) by RAS
349  ! Check if namelist option is feasible, otherwise default to graupel - RAS
350  IF (morr_rimed_ice .eq. 1) THEN
351  ihail = 1
352  ELSE
353  ihail = 0
354  ENDIF
355 else
356 
357 ! SWITCH FOR LIQUID-ONLY RUN
358 ! ILIQ = 0, INCLUDE ICE
359 ! ILIQ = 1, LIQUID ONLY, NO ICE
360 
361  iliq = 0
362 
363 ! SWITCH FOR ICE NUCLEATION
364 ! INUC = 0, USE FORMULA FROM RASMUSSEN ET AL. 2002 (MID-LATITUDE)
365 ! = 1, USE MPACE OBSERVATIONS (ARCTIC ONLY)
366 
367  inuc = 0
368 
369 ! SWITCH FOR GRAUPEL/HAIL NO GRAUPEL/HAIL
370 ! IGRAUP = 0, INCLUDE GRAUPEL/HAIL
371 ! IGRAUP = 1, NO GRAUPEL/HAIL
372 
373  igraup = 0
374 
375 ! HM ADDED 11/7/07
376 ! SWITCH FOR HAIL/GRAUPEL
377 ! IHAIL = 0, DENSE PRECIPITATING ICE IS GRAUPEL
378 ! IHAIL = 1, DENSE PRECIPITATING ICE IS HAIL
379 ! NOTE ---> RECOMMEND IHAIL = 1 FOR CONTINENTAL DEEP CONVECTION
380 
381  !IHAIL = 0 !changed to namelist option (morr_rimed_ice) by RAS
382  ! Check if namelist option is feasible, otherwise default to graupel - RAS
383  IF (morr_rimed_ice .eq. 1) THEN
384  ihail = 1
385  ELSE
386  ihail = 0
387  ENDIF
388 endif
389 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
390 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
391 ! SET PHYSICAL CONSTANTS
392 
393 ! FALLSPEED PARAMETERS (V=AD^B)
394  ai = 700.
395  ac = 3.e7
396  as = 11.72
397  ar = 841.99667
398  bi = 1.
399  bc = 2.
400  bs = 0.41
401  br = 0.8
402  IF (ihail.EQ.0) THEN
403  ag = 19.3
404  bg = 0.37
405  ELSE ! (MATSUN AND HUGGINS 1980)
406  ag = 114.5
407  bg = 0.5
408  END IF
409 
410 ! CONSTANTS AND PARAMETERS
411 ! R = 287.15
412 ! RV = 461.5
413 ! CP = 1005.
414  rhosu = 85000./(287.15*273.15)
415  rhow = 997.
416  rhoi = 500.
417  rhosn = 100.
418  IF (ihail.EQ.0) THEN
419  rhog = 400.
420  ELSE
421  rhog = 900.
422  END IF
423  aimm = 0.66
424  bimm = 100.
425  ecr = 1.
426  dcs = 125.e-6
427  mi0 = 4./3.*pi*rhoi*(10.e-6)**3
428  mg0 = 1.6e-10
429  f1s = 0.86
430  f2s = 0.28
431  f1r = 0.78
432 ! F2R = 0.32
433 ! fix 053011
434  f2r = 0.308
435 ! G = 9.806
436 
437  qsmall = 1.d-14
438  print *,'SETTING SMALL TO ',qsmall
439 
440  eii = 0.1
441  eci = 0.7
442 ! HM, ADD FOR V3.2
443 ! hm, 7/23/13
444 ! CPW = 4218.
445  cpw = 4187.
446 
447 ! SIZE DISTRIBUTION PARAMETERS
448 
449  ci = rhoi*pi/6.
450  di = 3.
451  cs = rhosn*pi/6.
452  ds = 3.
453  cg = rhog*pi/6.
454  dg = 3.
455 
456 ! RADIUS OF CONTACT NUCLEI
457  rin = 0.1e-6
458 
459  mmult = 4./3.*pi*rhoi*(5.e-6)**3
460 
461 ! SIZE LIMITS FOR LAMBDA
462 
463  lammaxi = 1./1.e-6
464  lammini = 1./(2.*dcs+100.e-6)
465  lammaxr = 1./20.e-6
466 ! LAMMINR = 1./500.E-6
467  lamminr = 1./2800.e-6
468 
469  lammaxs = 1./10.e-6
470  lammins = 1./2000.e-6
471  lammaxg = 1./20.e-6
472  lamming = 1./2000.e-6
473 
474 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
475 ! note: these parameters only used by the non-wrf-chem version of the
476 ! scheme with predicted droplet number
477 
478 ! CCN SPECTRA FOR IACT = 1
479 
480 ! MARITIME
481 ! MODIFIED FROM RASMUSSEN ET AL. 2002
482 ! NCCN = C*S^K, NCCN IS IN CM-3, S IS SUPERSATURATION RATIO IN %
483 
484  k1 = 0.4
485  c1 = 120.
486 
487 ! CONTINENTAL
488 
489 ! K1 = 0.5
490 ! C1 = 1000.
491 
492 ! AEROSOL ACTIVATION PARAMETERS FOR IACT = 2
493 ! PARAMETERS CURRENTLY SET FOR AMMONIUM SULFATE
494 
495  mw = 0.018
496  osm = 1.
497  vi = 3.
498  epsm = 0.7
499  rhoa = 1777.
500  map = 0.132
501  ma = 0.0284
502 ! hm fix 6/23/16
503 ! RR = 8.3187
504  rr = 8.3145
505  bact = vi*osm*epsm*mw*rhoa/(map*rhow)
506 
507 ! AEROSOL SIZE DISTRIBUTION PARAMETERS CURRENTLY SET FOR MPACE
508 ! (see morrison et al. 2007, JGR)
509 ! MODE 1
510 
511  rm1 = 0.052e-6
512  sig1 = 2.04
513  nanew1 = 72.2e6
514  f11 = 0.5*exp(2.5*(log(sig1))**2)
515  f21 = 1.+0.25*log(sig1)
516 
517 ! MODE 2
518 
519  rm2 = 1.3e-6
520  sig2 = 2.5
521  nanew2 = 1.8e6
522  f12 = 0.5*exp(2.5*(log(sig2))**2)
523  f22 = 1.+0.25*log(sig2)
524 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
525 
526 ! CONSTANTS FOR EFFICIENCY
527 
528  cons1=gamma(1.+ds)*cs
529  cons2=gamma(1.+dg)*cg
530  cons3=gamma(4.+bs)/6.
531  cons4=gamma(4.+br)/6.
532  cons5=gamma(1.+bs)
533  cons6=gamma(1.+br)
534  cons7=gamma(4.+bg)/6.
535  cons8=gamma(1.+bg)
536  cons9=gamma(5./2.+br/2.)
537  cons10=gamma(5./2.+bs/2.)
538  cons11=gamma(5./2.+bg/2.)
539  cons12=gamma(1.+di)*ci
540  cons13=gamma(bs+3.)*pi/4.*eci
541  cons14=gamma(bg+3.)*pi/4.*eci
542  cons15=-1108.*eii*pi**((1.-bs)/3.)*rhosn**((-2.-bs)/3.)/(4.*720.)
543  cons16=gamma(bi+3.)*pi/4.*eci
544  cons17=4.*2.*3.*rhosu*pi*eci*eci*gamma(2.*bs+2.)/(8.*(rhog-rhosn))
545  cons18=rhosn*rhosn
546  cons19=rhow*rhow
547  cons20=20.*pi*pi*rhow*bimm
548  cons21=4./(dcs*rhoi)
549  cons22=pi*rhoi*dcs**3/6.
550  cons23=pi/4.*eii*gamma(bs+3.)
551  cons24=pi/4.*ecr*gamma(br+3.)
552  cons25=pi*pi/24.*rhow*ecr*gamma(br+6.)
553  cons26=pi/6.*rhow
554  cons27=gamma(1.+bi)
555  cons28=gamma(4.+bi)/6.
556  cons29=4./3.*pi*rhow*(25.e-6)**3
557  cons30=4./3.*pi*rhow
558  cons31=pi*pi*ecr*rhosn
559  cons32=pi/2.*ecr
560  cons33=pi*pi*ecr*rhog
561  cons34=5./2.+br/2.
562  cons35=5./2.+bs/2.
563  cons36=5./2.+bg/2.
564  cons37=4.*pi*1.38e-23/(6.*pi*rin)
565  cons38=pi*pi/3.*rhow
566  cons39=pi*pi/36.*rhow*bimm
567  cons40=pi/6.*bimm
568  cons41=pi*pi*ecr*rhow
569 

Referenced by mp_morr_two_moment_isohelper::morr_two_moment_init_c().

Here is the caller graph for this function:

◆ morr_two_moment_micro()

subroutine, private module_mp_morr_two_moment::morr_two_moment_micro ( integer, intent(in)  i,
integer, intent(in)  j,
integer, intent(in)  istep,
integer, intent(in)  kts,
integer, intent(in)  kte,
real(c_double), dimension(kts:kte)  QC3DTEN,
real(c_double), dimension(kts:kte)  QI3DTEN,
real(c_double), dimension(kts:kte)  QNI3DTEN,
real(c_double), dimension(kts:kte)  QR3DTEN,
real(c_double), dimension(kts:kte)  NI3DTEN,
real(c_double), dimension(kts:kte)  NS3DTEN,
real(c_double), dimension(kts:kte)  NR3DTEN,
real(c_double), dimension(kts:kte)  QC3D,
real(c_double), dimension(kts:kte)  QI3D,
real(c_double), dimension(kts:kte)  QNI3D,
real(c_double), dimension(kts:kte)  QR3D,
real(c_double), dimension(kts:kte)  NI3D,
real(c_double), dimension(kts:kte)  NS3D,
real(c_double), dimension(kts:kte)  NR3D,
real(c_double), dimension(kts:kte)  T3DTEN,
real(c_double), dimension(kts:kte)  QV3DTEN,
real(c_double), dimension(kts:kte)  T3D,
real(c_double), dimension(kts:kte)  QV3D,
real(c_double), dimension(kts:kte)  PRES,
real(c_double), dimension(kts:kte)  DZQ,
real(c_double), dimension(kts:kte)  W3D,
real(c_double), dimension(kts:kte)  RHO_ERF,
real(c_double)  PRECRT,
real(c_double)  SNOWRT,
real(c_double)  SNOWPRT,
real(c_double)  GRPLPRT,
real(c_double), dimension(kts:kte)  EFFC,
real(c_double), dimension(kts:kte)  EFFI,
real(c_double), dimension(kts:kte)  EFFS,
real(c_double), dimension(kts:kte)  EFFR,
real(c_double)  DT,
real(c_double), dimension(kts:kte)  QG3DTEN,
real(c_double), dimension(kts:kte)  NG3DTEN,
real(c_double), dimension(kts:kte)  QG3D,
real(c_double), dimension(kts:kte)  NG3D,
real(c_double), dimension(kts:kte)  EFFG,
real(c_double), dimension(kts:kte)  qrcu1d,
real(c_double), dimension(kts:kte)  qscu1d,
real(c_double), dimension(kts:kte)  qicu1d,
real(c_double), dimension(kts:kte)  QGSTEN,
real(c_double), dimension(kts:kte)  QRSTEN,
real(c_double), dimension(kts:kte)  QISTEN,
real(c_double), dimension(kts:kte)  QNISTEN,
real(c_double), dimension(kts:kte)  QCSTEN,
real(c_double), dimension(kts:kte)  nc3d,
real(c_double), dimension(kts:kte)  nc3dten,
integer, intent(in)  iinum,
real(c_double), dimension(kts:kte)  c2prec,
real(c_double), dimension(kts:kte)  CSED,
real(c_double), dimension(kts:kte)  ISED,
real(c_double), dimension(kts:kte)  SSED,
real(c_double), dimension(kts:kte)  GSED,
real(c_double), dimension(kts:kte)  RSED 
)
private
934 
935 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
936 ! THIS PROGRAM IS THE MAIN TWO-MOMENT MICROPHYSICS SUBROUTINE DESCRIBED BY
937 ! MORRISON ET AL. 2005 JAS AND MORRISON ET AL. 2009 MWR
938 
939 ! THIS SCHEME IS A BULK DOUBLE-MOMENT SCHEME THAT PREDICTS MIXING
940 ! RATIOS AND NUMBER CONCENTRATIONS OF FIVE HYDROMETEOR SPECIES:
941 ! CLOUD DROPLETS, CLOUD (SMALL) ICE, RAIN, SNOW, AND GRAUPEL/HAIL.
942 
943 ! CODE STRUCTURE: MAIN SUBROUTINE IS 'MORR_TWO_MOMENT'. ALSO INCLUDED IN THIS FILE IS
944 ! 'FUNCTION POLYSVP', 'FUNCTION DERF1', AND
945 ! 'FUNCTION GAMMA'.
946 
947 ! NOTE: THIS SUBROUTINE USES 1D ARRAY IN VERTICAL (COLUMN), EVEN THOUGH VARIABLES ARE CALLED '3D'......
948 
949 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
950 
951 ! DECLARATIONS
952 
953  IMPLICIT NONE
954 
955 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
956 ! THESE VARIABLES BELOW MUST BE LINKED WITH THE MAIN MODEL.
957 ! DEFINE ARRAY SIZES
958 
959 ! INPUT NUMBER OF GRID CELLS
960 
961 ! INPUT/OUTPUT PARAMETERS ! DESCRIPTION (UNITS)
962  INTEGER, INTENT( IN) :: i,j,istep,kts,kte
963 
964  REAL(C_DOUBLE), DIMENSION(KTS:KTE) :: QC3DTEN ! CLOUD WATER MIXING RATIO TENDENCY (KG/KG/S)
965  REAL(C_DOUBLE), DIMENSION(KTS:KTE) :: QI3DTEN ! CLOUD ICE MIXING RATIO TENDENCY (KG/KG/S)
966  REAL(C_DOUBLE), DIMENSION(KTS:KTE) :: QNI3DTEN ! SNOW MIXING RATIO TENDENCY (KG/KG/S)
967  REAL(C_DOUBLE), DIMENSION(KTS:KTE) :: QR3DTEN ! RAIN MIXING RATIO TENDENCY (KG/KG/S)
968  REAL(C_DOUBLE), DIMENSION(KTS:KTE) :: NI3DTEN ! CLOUD ICE NUMBER CONCENTRATION (1/KG/S)
969  REAL(C_DOUBLE), DIMENSION(KTS:KTE) :: NS3DTEN ! SNOW NUMBER CONCENTRATION (1/KG/S)
970  REAL(C_DOUBLE), DIMENSION(KTS:KTE) :: NR3DTEN ! RAIN NUMBER CONCENTRATION (1/KG/S)
971  REAL(C_DOUBLE), DIMENSION(KTS:KTE) :: QC3D ! CLOUD WATER MIXING RATIO (KG/KG)
972  REAL(C_DOUBLE), DIMENSION(KTS:KTE) :: QI3D ! CLOUD ICE MIXING RATIO (KG/KG)
973  REAL(C_DOUBLE), DIMENSION(KTS:KTE) :: QNI3D ! SNOW MIXING RATIO (KG/KG)
974  REAL(C_DOUBLE), DIMENSION(KTS:KTE) :: QR3D ! RAIN MIXING RATIO (KG/KG)
975  REAL(C_DOUBLE), DIMENSION(KTS:KTE) :: NI3D ! CLOUD ICE NUMBER CONCENTRATION (1/KG)
976  REAL(C_DOUBLE), DIMENSION(KTS:KTE) :: NS3D ! SNOW NUMBER CONCENTRATION (1/KG)
977  REAL(C_DOUBLE), DIMENSION(KTS:KTE) :: NR3D ! RAIN NUMBER CONCENTRATION (1/KG)
978  REAL(C_DOUBLE), DIMENSION(KTS:KTE) :: T3DTEN ! TEMPERATURE TENDENCY (K/S)
979  REAL(C_DOUBLE), DIMENSION(KTS:KTE) :: QV3DTEN ! WATER VAPOR MIXING RATIO TENDENCY (KG/KG/S)
980  REAL(C_DOUBLE), DIMENSION(KTS:KTE) :: T3D ! TEMPERATURE (K)
981  REAL(C_DOUBLE), DIMENSION(KTS:KTE) :: QV3D ! WATER VAPOR MIXING RATIO (KG/KG)
982  REAL(C_DOUBLE), DIMENSION(KTS:KTE) :: PRES ! ATMOSPHERIC PRESSURE (PA)
983  REAL(C_DOUBLE), DIMENSION(KTS:KTE) :: DZQ ! DIFFERENCE IN HEIGHT ACROSS LEVEL (m)
984  REAL(C_DOUBLE), DIMENSION(KTS:KTE) :: W3D ! GRID-SCALE VERTICAL VELOCITY (M/S)
985  REAL(C_DOUBLE), DIMENSION(KTS:KTE) :: RHO_ERF ! ERF DRY-AIR DENSITY (KG_DRY/M^3)
986 ! below for wrf-chem
987  REAL(C_DOUBLE), DIMENSION(KTS:KTE) :: nc3d
988  REAL(C_DOUBLE), DIMENSION(KTS:KTE) :: nc3dten
989  integer, intent(in) :: iinum
990 
991 ! HM ADDED GRAUPEL VARIABLES
992  REAL(C_DOUBLE), DIMENSION(KTS:KTE) :: QG3DTEN ! GRAUPEL MIX RATIO TENDENCY (KG/KG/S)
993  REAL(C_DOUBLE), DIMENSION(KTS:KTE) :: NG3DTEN ! GRAUPEL NUMB CONC TENDENCY (1/KG/S)
994  REAL(C_DOUBLE), DIMENSION(KTS:KTE) :: QG3D ! GRAUPEL MIX RATIO (KG/KG)
995  REAL(C_DOUBLE), DIMENSION(KTS:KTE) :: NG3D ! GRAUPEL NUMBER CONC (1/KG)
996 
997 ! HM, ADD 1/16/07, SEDIMENTATION TENDENCIES FOR MIXING RATIO
998 
999  REAL(C_DOUBLE), DIMENSION(KTS:KTE) :: QGSTEN ! GRAUPEL SED TEND (KG/KG/S)
1000  REAL(C_DOUBLE), DIMENSION(KTS:KTE) :: QRSTEN ! RAIN SED TEND (KG/KG/S)
1001  REAL(C_DOUBLE), DIMENSION(KTS:KTE) :: QISTEN ! CLOUD ICE SED TEND (KG/KG/S)
1002  REAL(C_DOUBLE), DIMENSION(KTS:KTE) :: QNISTEN ! SNOW SED TEND (KG/KG/S)
1003  REAL(C_DOUBLE), DIMENSION(KTS:KTE) :: QCSTEN ! CLOUD WAT SED TEND (KG/KG/S)
1004 
1005 ! hm add cumulus tendencies for precip
1006  REAL(C_DOUBLE), DIMENSION(KTS:KTE) :: qrcu1d
1007  REAL(C_DOUBLE), DIMENSION(KTS:KTE) :: qscu1d
1008  REAL(C_DOUBLE), DIMENSION(KTS:KTE) :: qicu1d
1009 
1010 ! OUTPUT VARIABLES
1011 
1012  REAL(C_DOUBLE) PRECRT ! TOTAL PRECIP PER TIME STEP (mm)
1013  REAL(C_DOUBLE) SNOWRT ! SNOW PER TIME STEP (mm)
1014 ! hm added 7/13/13
1015  REAL(C_DOUBLE) SNOWPRT ! TOTAL CLOUD ICE PLUS SNOW PER TIME STEP (mm)
1016  REAL(C_DOUBLE) GRPLPRT ! TOTAL GRAUPEL PER TIME STEP (mm)
1017 
1018  REAL(C_DOUBLE), DIMENSION(KTS:KTE) :: EFFC ! DROPLET EFFECTIVE RADIUS (MICRON)
1019  REAL(C_DOUBLE), DIMENSION(KTS:KTE) :: EFFI ! CLOUD ICE EFFECTIVE RADIUS (MICRON)
1020  REAL(C_DOUBLE), DIMENSION(KTS:KTE) :: EFFS ! SNOW EFFECTIVE RADIUS (MICRON)
1021  REAL(C_DOUBLE), DIMENSION(KTS:KTE) :: EFFR ! RAIN EFFECTIVE RADIUS (MICRON)
1022  REAL(C_DOUBLE), DIMENSION(KTS:KTE) :: EFFG ! GRAUPEL EFFECTIVE RADIUS (MICRON)
1023 
1024 ! MODEL INPUT PARAMETERS (FORMERLY IN COMMON BLOCKS)
1025 
1026  REAL(C_DOUBLE) DT ! MODEL TIME STEP (SEC)
1027 
1028 
1029 !.....................................................................................................
1030 ! LOCAL VARIABLES: ALL PARAMETERS BELOW ARE LOCAL TO SCHEME AND DON'T NEED TO COMMUNICATE WITH THE
1031 ! REST OF THE MODEL.
1032 
1033 ! SIZE PARAMETER VARIABLES
1034 
1035  REAL(C_DOUBLE), DIMENSION(KTS:KTE) :: LAMC ! SLOPE PARAMETER FOR DROPLETS (M-1)
1036  REAL(C_DOUBLE), DIMENSION(KTS:KTE) :: LAMI ! SLOPE PARAMETER FOR CLOUD ICE (M-1)
1037  REAL(C_DOUBLE), DIMENSION(KTS:KTE) :: LAMS ! SLOPE PARAMETER FOR SNOW (M-1)
1038  REAL(C_DOUBLE), DIMENSION(KTS:KTE) :: LAMR ! SLOPE PARAMETER FOR RAIN (M-1)
1039  REAL(C_DOUBLE), DIMENSION(KTS:KTE) :: LAMG ! SLOPE PARAMETER FOR GRAUPEL (M-1)
1040  REAL(C_DOUBLE), DIMENSION(KTS:KTE) :: CDIST1 ! PSD PARAMETER FOR DROPLETS
1041  REAL(C_DOUBLE), DIMENSION(KTS:KTE) :: N0I ! INTERCEPT PARAMETER FOR CLOUD ICE (KG-1 M-1)
1042  REAL(C_DOUBLE), DIMENSION(KTS:KTE) :: N0S ! INTERCEPT PARAMETER FOR SNOW (KG-1 M-1)
1043  REAL(C_DOUBLE), DIMENSION(KTS:KTE) :: N0RR ! INTERCEPT PARAMETER FOR RAIN (KG-1 M-1)
1044  REAL(C_DOUBLE), DIMENSION(KTS:KTE) :: N0G ! INTERCEPT PARAMETER FOR GRAUPEL (KG-1 M-1)
1045  REAL(C_DOUBLE), DIMENSION(KTS:KTE) :: PGAM ! SPECTRAL SHAPE PARAMETER FOR DROPLETS
1046 
1047 ! MICROPHYSICAL PROCESSES
1048 
1049  REAL(C_DOUBLE), DIMENSION(KTS:KTE) :: NSUBC ! LOSS OF NC DURING EVAP
1050  REAL(C_DOUBLE), DIMENSION(KTS:KTE) :: NSUBI ! LOSS OF NI DURING SUB.
1051  REAL(C_DOUBLE), DIMENSION(KTS:KTE) :: NSUBS ! LOSS OF NS DURING SUB.
1052  REAL(C_DOUBLE), DIMENSION(KTS:KTE) :: NSUBR ! LOSS OF NR DURING EVAP
1053  REAL(C_DOUBLE), DIMENSION(KTS:KTE) :: PRD ! DEP CLOUD ICE
1054  REAL(C_DOUBLE), DIMENSION(KTS:KTE) :: PRE ! EVAP OF RAIN
1055  REAL(C_DOUBLE), DIMENSION(KTS:KTE) :: PRDS ! DEP SNOW
1056  REAL(C_DOUBLE), DIMENSION(KTS:KTE) :: NNUCCC ! CHANGE N DUE TO CONTACT FREEZ DROPLETS
1057  REAL(C_DOUBLE), DIMENSION(KTS:KTE) :: MNUCCC ! CHANGE Q DUE TO CONTACT FREEZ DROPLETS
1058  REAL(C_DOUBLE), DIMENSION(KTS:KTE) :: PRA ! ACCRETION DROPLETS BY RAIN
1059  REAL(C_DOUBLE), DIMENSION(KTS:KTE) :: PRC ! AUTOCONVERSION DROPLETS
1060  REAL(C_DOUBLE), DIMENSION(KTS:KTE) :: PCC ! COND/EVAP DROPLETS
1061  REAL(C_DOUBLE), DIMENSION(KTS:KTE) :: NNUCCD ! CHANGE N FREEZING AEROSOL (PRIM ICE NUCLEATION)
1062  REAL(C_DOUBLE), DIMENSION(KTS:KTE) :: MNUCCD ! CHANGE Q FREEZING AEROSOL (PRIM ICE NUCLEATION)
1063  REAL(C_DOUBLE), DIMENSION(KTS:KTE) :: MNUCCR ! CHANGE Q DUE TO CONTACT FREEZ RAIN
1064  REAL(C_DOUBLE), DIMENSION(KTS:KTE) :: NNUCCR ! CHANGE N DUE TO CONTACT FREEZ RAIN
1065  REAL(C_DOUBLE), DIMENSION(KTS:KTE) :: NPRA ! CHANGE IN N DUE TO DROPLET ACC BY RAIN
1066  REAL(C_DOUBLE), DIMENSION(KTS:KTE) :: NRAGG ! SELF-COLLECTION/BREAKUP OF RAIN
1067  REAL(C_DOUBLE), DIMENSION(KTS:KTE) :: NSAGG ! SELF-COLLECTION OF SNOW
1068  REAL(C_DOUBLE), DIMENSION(KTS:KTE) :: NPRC ! CHANGE NC AUTOCONVERSION DROPLETS
1069  REAL(C_DOUBLE), DIMENSION(KTS:KTE) :: NPRC1 ! CHANGE NR AUTOCONVERSION DROPLETS
1070  REAL(C_DOUBLE), DIMENSION(KTS:KTE) :: PRAI ! CHANGE Q ACCRETION CLOUD ICE BY SNOW
1071  REAL(C_DOUBLE), DIMENSION(KTS:KTE) :: PRCI ! CHANGE Q AUTOCONVERSIN CLOUD ICE TO SNOW
1072  REAL(C_DOUBLE), DIMENSION(KTS:KTE) :: PSACWS ! CHANGE Q DROPLET ACCRETION BY SNOW
1073  REAL(C_DOUBLE), DIMENSION(KTS:KTE) :: NPSACWS ! CHANGE N DROPLET ACCRETION BY SNOW
1074  REAL(C_DOUBLE), DIMENSION(KTS:KTE) :: PSACWI ! CHANGE Q DROPLET ACCRETION BY CLOUD ICE
1075  REAL(C_DOUBLE), DIMENSION(KTS:KTE) :: NPSACWI ! CHANGE N DROPLET ACCRETION BY CLOUD ICE
1076  REAL(C_DOUBLE), DIMENSION(KTS:KTE) :: NPRCI ! CHANGE N AUTOCONVERSION CLOUD ICE BY SNOW
1077  REAL(C_DOUBLE), DIMENSION(KTS:KTE) :: NPRAI ! CHANGE N ACCRETION CLOUD ICE
1078  REAL(C_DOUBLE), DIMENSION(KTS:KTE) :: NMULTS ! ICE MULT DUE TO RIMING DROPLETS BY SNOW
1079  REAL(C_DOUBLE), DIMENSION(KTS:KTE) :: NMULTR ! ICE MULT DUE TO RIMING RAIN BY SNOW
1080  REAL(C_DOUBLE), DIMENSION(KTS:KTE) :: QMULTS ! CHANGE Q DUE TO ICE MULT DROPLETS/SNOW
1081  REAL(C_DOUBLE), DIMENSION(KTS:KTE) :: QMULTR ! CHANGE Q DUE TO ICE RAIN/SNOW
1082  REAL(C_DOUBLE), DIMENSION(KTS:KTE) :: PRACS ! CHANGE Q RAIN-SNOW COLLECTION
1083  REAL(C_DOUBLE), DIMENSION(KTS:KTE) :: NPRACS ! CHANGE N RAIN-SNOW COLLECTION
1084  REAL(C_DOUBLE), DIMENSION(KTS:KTE) :: PCCN ! CHANGE Q DROPLET ACTIVATION
1085  REAL(C_DOUBLE), DIMENSION(KTS:KTE) :: PSMLT ! CHANGE Q MELTING SNOW TO RAIN
1086  REAL(C_DOUBLE), DIMENSION(KTS:KTE) :: EVPMS ! CHNAGE Q MELTING SNOW EVAPORATING
1087  REAL(C_DOUBLE), DIMENSION(KTS:KTE) :: NSMLTS ! CHANGE N MELTING SNOW
1088  REAL(C_DOUBLE), DIMENSION(KTS:KTE) :: NSMLTR ! CHANGE N MELTING SNOW TO RAIN
1089 ! HM ADDED 12/13/06
1090  REAL(C_DOUBLE), DIMENSION(KTS:KTE) :: PIACR ! CHANGE QR, ICE-RAIN COLLECTION
1091  REAL(C_DOUBLE), DIMENSION(KTS:KTE) :: NIACR ! CHANGE N, ICE-RAIN COLLECTION
1092  REAL(C_DOUBLE), DIMENSION(KTS:KTE) :: PRACI ! CHANGE QI, ICE-RAIN COLLECTION
1093  REAL(C_DOUBLE), DIMENSION(KTS:KTE) :: PIACRS ! CHANGE QR, ICE RAIN COLLISION, ADDED TO SNOW
1094  REAL(C_DOUBLE), DIMENSION(KTS:KTE) :: NIACRS ! CHANGE N, ICE RAIN COLLISION, ADDED TO SNOW
1095  REAL(C_DOUBLE), DIMENSION(KTS:KTE) :: PRACIS ! CHANGE QI, ICE RAIN COLLISION, ADDED TO SNOW
1096  REAL(C_DOUBLE), DIMENSION(KTS:KTE) :: EPRD ! SUBLIMATION CLOUD ICE
1097  REAL(C_DOUBLE), DIMENSION(KTS:KTE) :: EPRDS ! SUBLIMATION SNOW
1098 ! HM ADDED GRAUPEL PROCESSES
1099  REAL(C_DOUBLE), DIMENSION(KTS:KTE) :: PRACG ! CHANGE IN Q COLLECTION RAIN BY GRAUPEL
1100  REAL(C_DOUBLE), DIMENSION(KTS:KTE) :: PSACWG ! CHANGE IN Q COLLECTION DROPLETS BY GRAUPEL
1101  REAL(C_DOUBLE), DIMENSION(KTS:KTE) :: PGSACW ! CONVERSION Q TO GRAUPEL DUE TO COLLECTION DROPLETS BY SNOW
1102  REAL(C_DOUBLE), DIMENSION(KTS:KTE) :: PGRACS ! CONVERSION Q TO GRAUPEL DUE TO COLLECTION RAIN BY SNOW
1103  REAL(C_DOUBLE), DIMENSION(KTS:KTE) :: PRDG ! DEP OF GRAUPEL
1104  REAL(C_DOUBLE), DIMENSION(KTS:KTE) :: EPRDG ! SUB OF GRAUPEL
1105  REAL(C_DOUBLE), DIMENSION(KTS:KTE) :: EVPMG ! CHANGE Q MELTING OF GRAUPEL AND EVAPORATION
1106  REAL(C_DOUBLE), DIMENSION(KTS:KTE) :: PGMLT ! CHANGE Q MELTING OF GRAUPEL
1107  REAL(C_DOUBLE), DIMENSION(KTS:KTE) :: NPRACG ! CHANGE N COLLECTION RAIN BY GRAUPEL
1108  REAL(C_DOUBLE), DIMENSION(KTS:KTE) :: NPSACWG ! CHANGE N COLLECTION DROPLETS BY GRAUPEL
1109  REAL(C_DOUBLE), DIMENSION(KTS:KTE) :: NSCNG ! CHANGE N CONVERSION TO GRAUPEL DUE TO COLLECTION DROPLETS BY SNOW
1110  REAL(C_DOUBLE), DIMENSION(KTS:KTE) :: NGRACS ! CHANGE N CONVERSION TO GRAUPEL DUE TO COLLECTION RAIN BY SNOW
1111  REAL(C_DOUBLE), DIMENSION(KTS:KTE) :: NGMLTG ! CHANGE N MELTING GRAUPEL
1112  REAL(C_DOUBLE), DIMENSION(KTS:KTE) :: NGMLTR ! CHANGE N MELTING GRAUPEL TO RAIN
1113  REAL(C_DOUBLE), DIMENSION(KTS:KTE) :: NSUBG ! CHANGE N SUB/DEP OF GRAUPEL
1114  REAL(C_DOUBLE), DIMENSION(KTS:KTE) :: PSACR ! CONVERSION DUE TO COLL OF SNOW BY RAIN
1115  REAL(C_DOUBLE), DIMENSION(KTS:KTE) :: NMULTG ! ICE MULT DUE TO ACC DROPLETS BY GRAUPEL
1116  REAL(C_DOUBLE), DIMENSION(KTS:KTE) :: NMULTRG ! ICE MULT DUE TO ACC RAIN BY GRAUPEL
1117  REAL(C_DOUBLE), DIMENSION(KTS:KTE) :: QMULTG ! CHANGE Q DUE TO ICE MULT DROPLETS/GRAUPEL
1118  REAL(C_DOUBLE), DIMENSION(KTS:KTE) :: QMULTRG ! CHANGE Q DUE TO ICE MULT RAIN/GRAUPEL
1119 
1120 ! TIME-VARYING ATMOSPHERIC PARAMETERS
1121 
1122  REAL(C_DOUBLE), DIMENSION(KTS:KTE) :: KAP ! THERMAL CONDUCTIVITY OF AIR
1123  REAL(C_DOUBLE), DIMENSION(KTS:KTE) :: EVS ! SATURATION VAPOR PRESSURE
1124  REAL(C_DOUBLE), DIMENSION(KTS:KTE) :: EIS ! ICE SATURATION VAPOR PRESSURE
1125  REAL(C_DOUBLE), DIMENSION(KTS:KTE) :: QVS ! SATURATION MIXING RATIO
1126  REAL(C_DOUBLE), DIMENSION(KTS:KTE) :: QVI ! ICE SATURATION MIXING RATIO
1127  REAL(C_DOUBLE), DIMENSION(KTS:KTE) :: QVQVS ! SAUTRATION RATIO
1128  REAL(C_DOUBLE), DIMENSION(KTS:KTE) :: QVQVSI! ICE SATURAION RATIO
1129  REAL(C_DOUBLE), DIMENSION(KTS:KTE) :: DV ! DIFFUSIVITY OF WATER VAPOR IN AIR
1130  REAL(C_DOUBLE), DIMENSION(KTS:KTE) :: XXLS ! LATENT HEAT OF SUBLIMATION
1131  REAL(C_DOUBLE), DIMENSION(KTS:KTE) :: XXLV ! LATENT HEAT OF VAPORIZATION
1132  REAL(C_DOUBLE), DIMENSION(KTS:KTE) :: CPM ! SPECIFIC HEAT AT CONST PRESSURE FOR MOIST AIR
1133  REAL(C_DOUBLE), DIMENSION(KTS:KTE) :: MU ! VISCOCITY OF AIR
1134  REAL(C_DOUBLE), DIMENSION(KTS:KTE) :: SC ! SCHMIDT NUMBER
1135  REAL(C_DOUBLE), DIMENSION(KTS:KTE) :: XLF ! LATENT HEAT OF FREEZING
1136  REAL(C_DOUBLE), DIMENSION(KTS:KTE) :: RHO ! AIR DENSITY
1137  REAL(C_DOUBLE), DIMENSION(KTS:KTE) :: AB ! CORRECTION TO CONDENSATION RATE DUE TO LATENT HEATING
1138  REAL(C_DOUBLE), DIMENSION(KTS:KTE) :: ABI ! CORRECTION TO DEPOSITION RATE DUE TO LATENT HEATING
1139 
1140 ! TIME-VARYING MICROPHYSICS PARAMETERS
1141 
1142  REAL(C_DOUBLE), DIMENSION(KTS:KTE) :: DAP ! DIFFUSIVITY OF AEROSOL
1143  REAL(C_DOUBLE) NACNT ! NUMBER OF CONTACT IN
1144  REAL(C_DOUBLE) FMULT ! TEMP.-DEP. PARAMETER FOR RIME-SPLINTERING
1145  REAL(C_DOUBLE) COFFI ! ICE AUTOCONVERSION PARAMETER
1146 
1147 ! FALL SPEED WORKING VARIABLES (DEFINED IN CODE)
1148 
1149  REAL(C_DOUBLE), DIMENSION(KTS:KTE) :: DUMI,DUMR,DUMFNI,DUMG,DUMFNG
1150  REAL(C_DOUBLE) UNI, UMI,UMR
1151  REAL(C_DOUBLE), DIMENSION(KTS:KTE) :: FR, FI, FNI,FG,FNG
1152  REAL(C_DOUBLE) RGVM
1153  REAL(C_DOUBLE), DIMENSION(KTS:KTE) :: FALOUTR,FALOUTI,FALOUTNI
1154  REAL(C_DOUBLE) FALTNDR,FALTNDI,FALTNDNI,RHO2
1155  REAL(C_DOUBLE), DIMENSION(KTS:KTE) :: DUMQS,DUMFNS
1156  REAL(C_DOUBLE) UMS,UNS
1157  REAL(C_DOUBLE), DIMENSION(KTS:KTE) :: FS,FNS, FALOUTS,FALOUTNS,FALOUTG,FALOUTNG
1158  REAL(C_DOUBLE) FALTNDS,FALTNDNS,UNR,FALTNDG,FALTNDNG
1159  REAL(C_DOUBLE), DIMENSION(KTS:KTE) :: DUMC,DUMFNC
1160  REAL(C_DOUBLE) UNC,UMC,UNG,UMG
1161  REAL(C_DOUBLE), DIMENSION(KTS:KTE) :: FC,FALOUTC,FALOUTNC
1162  REAL(C_DOUBLE) FALTNDC,FALTNDNC
1163  REAL(C_DOUBLE), DIMENSION(KTS:KTE) :: FNC,DUMFNR,FALOUTNR
1164  REAL(C_DOUBLE) FALTNDNR
1165  REAL(C_DOUBLE), DIMENSION(KTS:KTE) :: FNR
1166 
1167 ! FALL-SPEED PARAMETER 'A' WITH AIR DENSITY CORRECTION
1168 
1169  REAL(C_DOUBLE), DIMENSION(KTS:KTE) :: AIN,ARN,ASN,ACN,AGN
1170 
1171 ! EXTERNAL FUNCTION CALL RETURN VARIABLES
1172 
1173 ! REAL(C_DOUBLE) GAMMA, ! EULER GAMMA FUNCTION
1174 ! REAL(C_DOUBLE) POLYSVP, ! SAT. PRESSURE FUNCTION
1175 ! REAL(C_DOUBLE) DERF1 ! ERROR FUNCTION
1176 
1177 ! DUMMY VARIABLES
1178 
1179  REAL(C_DOUBLE) DUM,DUM1,DUM2,DUMT,DUMQV,DUMQSS,DUMQSI,DUMS
1180 
1181 ! PROGNOSTIC SUPERSATURATION
1182 
1183  REAL(C_DOUBLE) DQSDT ! CHANGE OF SAT. MIX. RAT. WITH TEMPERATURE
1184  REAL(C_DOUBLE) DQSIDT ! CHANGE IN ICE SAT. MIXING RAT. WITH T
1185  REAL(C_DOUBLE) EPSI ! 1/PHASE REL. TIME (SEE M2005), ICE
1186  REAL(C_DOUBLE) EPSS ! 1/PHASE REL. TIME (SEE M2005), SNOW
1187  REAL(C_DOUBLE) EPSR ! 1/PHASE REL. TIME (SEE M2005), RAIN
1188  REAL(C_DOUBLE) EPSG ! 1/PHASE REL. TIME (SEE M2005), GRAUPEL
1189 
1190 ! NEW DROPLET ACTIVATION VARIABLES
1191  REAL(C_DOUBLE) TAUC ! PHASE REL. TIME (SEE M2005), DROPLETS
1192  REAL(C_DOUBLE) TAUR ! PHASE REL. TIME (SEE M2005), RAIN
1193  REAL(C_DOUBLE) TAUI ! PHASE REL. TIME (SEE M2005), CLOUD ICE
1194  REAL(C_DOUBLE) TAUS ! PHASE REL. TIME (SEE M2005), SNOW
1195  REAL(C_DOUBLE) TAUG ! PHASE REL. TIME (SEE M2005), GRAUPEL
1196  REAL(C_DOUBLE) DUMACT,DUM3
1197 
1198 ! COUNTING/INDEX VARIABLES
1199 
1200  INTEGER K,NSTEP,N ! ,I
1201 
1202 ! LTRUE IS ONLY USED TO SPEED UP THE CODE !!
1203 ! LTRUE, SWITCH = 0, NO HYDROMETEORS IN COLUMN,
1204 ! = 1, HYDROMETEORS IN COLUMN
1205 
1206  INTEGER LTRUE
1207 
1208 ! DROPLET ACTIVATION/FREEZING AEROSOL
1209 
1210 
1211  REAL(C_DOUBLE) CT ! DROPLET ACTIVATION PARAMETER
1212  REAL(C_DOUBLE) TEMP1 ! DUMMY TEMPERATURE
1213  REAL(C_DOUBLE) SAT1 ! DUMMY SATURATION
1214  REAL(C_DOUBLE) SIGVL ! SURFACE TENSION LIQ/VAPOR
1215  REAL(C_DOUBLE) KEL ! KELVIN PARAMETER
1216  REAL(C_DOUBLE) KC2 ! TOTAL ICE NUCLEATION RATE
1217 
1218  REAL(C_DOUBLE) CRY,KRY ! AEROSOL ACTIVATION PARAMETERS
1219 
1220 ! MORE WORKING/DUMMY VARIABLES
1221 
1222  REAL(C_DOUBLE) DUMQI,DUMNI,DC0,DS0,DG0
1223  REAL(C_DOUBLE) DUMQC,DUMQR,RATIO,SUM_DEP,FUDGEF
1224 
1225 ! EFFECTIVE VERTICAL VELOCITY (M/S)
1226  REAL(C_DOUBLE) WEF
1227 
1228 ! WORKING PARAMETERS FOR ICE NUCLEATION
1229 
1230  REAL(C_DOUBLE) ANUC,BNUC
1231 
1232 ! WORKING PARAMETERS FOR AEROSOL ACTIVATION
1233 
1234  REAL(C_DOUBLE) AACT,GAMM,GG,PSI,ETA1,ETA2,SM1,SM2,SMAX,UU1,UU2,ALPHA
1235 
1236 ! DUMMY SIZE DISTRIBUTION PARAMETERS
1237 
1238  REAL(C_DOUBLE) DLAMS,DLAMR,DLAMI,DLAMC,DLAMG,LAMMAX,LAMMIN
1239 
1240  INTEGER IDROP
1241 
1242 ! FOR WRF-CHEM
1243  REAL(C_DOUBLE), DIMENSION(KTS:KTE)::C2PREC,CSED,ISED,SSED,GSED,RSED
1244  REAL(C_DOUBLE), DIMENSION(KTS:KTE) :: tqimelt ! melting of cloud ice (tendency)
1245 
1246 ! comment lines for wrf-chem since these are intent(in) in that case
1247 ! REAL(C_DOUBLE), DIMENSION(KTS:KTE) :: NC3DTEN ! CLOUD DROPLET NUMBER CONCENTRATION (1/KG/S)
1248 ! REAL(C_DOUBLE), DIMENSION(KTS:KTE) :: NC3D ! CLOUD DROPLET NUMBER CONCENTRATION (1/KG)
1249 
1250 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
1251 
1252  ! print *,'IN MICRO KTS:KTE ', i,j,kts, kte
1253 
1254 ! SET LTRUE INITIALLY TO 0
1255 
1256  ltrue = 0
1257 
1258 ! ATMOSPHERIC PARAMETERS THAT VARY IN TIME AND HEIGHT
1259  DO k = kts,kte
1260 
1261 ! NC3DTEN LOCAL ARRAY INITIALIZED
1262  nc3dten(k) = 0.
1263 ! INITIALIZE VARIABLES FOR WRF-CHEM OUTPUT TO ZERO
1264 
1265  c2prec(k)=0.
1266  csed(k)=0.
1267  ised(k)=0.
1268  ssed(k)=0.
1269  gsed(k)=0.
1270  rsed(k)=0.
1271 
1272 ! LATENT HEAT OF VAPORATION
1273 
1274  xxlv(k) = 3.1484e6-2370.*t3d(k)
1275 
1276 ! LATENT HEAT OF SUBLIMATION
1277 
1278  xxls(k) = 3.15e6-2370.*t3d(k)+0.3337e6
1279 
1280  cpm(k) = cp*(1.+0.887*qv3d(k))
1281 
1282 ! SATURATION VAPOR PRESSURE AND MIXING RATIO
1283 
1284 ! hm, add fix for low pressure, 5/12/10
1285 
1286  evs(k) = min(0.99*pres(k),polysvp(t3d(k),0)) ! PA
1287  eis(k) = min(0.99*pres(k),polysvp(t3d(k),1)) ! PA
1288 ! Fortran version
1289 ! MAKE SURE ICE SATURATION DOESN'T EXCEED WATER SAT. NEAR FREEZING
1290 
1291  IF (eis(k).GT.evs(k)) eis(k) = evs(k)
1292 
1293  qvs(k) = ep_2*evs(k)/(pres(k)-evs(k))
1294  qvi(k) = ep_2*eis(k)/(pres(k)-eis(k))
1295 
1296  qvqvs(k) = qv3d(k)/qvs(k)
1297  qvqvsi(k) = qv3d(k)/qvi(k)
1298 
1299 ! AIR DENSITY
1300 
1301  rho(k) = pres(k)/(r*t3d(k))
1302 
1303 ! ADD NUMBER CONCENTRATION DUE TO CUMULUS TENDENCY
1304 ! ASSUME N0 ASSOCIATED WITH CUMULUS PARAM RAIN IS 10^7 M^-4
1305 ! ASSUME N0 ASSOCIATED WITH CUMULUS PARAM SNOW IS 2 X 10^7 M^-4
1306 ! FOR DETRAINED CLOUD ICE, ASSUME MEAN VOLUME DIAM OF 80 MICRON
1307 
1308  IF (qrcu1d(k).GE.1.e-10) THEN
1309  dum=1.8e5*(qrcu1d(k)*dt/(pi*rhow*rho(k)**3))**0.25
1310  nr3d(k)=nr3d(k)+dum
1311  END IF
1312  IF (qscu1d(k).GE.1.e-10) THEN
1313  dum=3.e5*(qscu1d(k)*dt/(cons1*rho(k)**3))**(1./(ds+1.))
1314  ns3d(k)=ns3d(k)+dum
1315  END IF
1316  IF (qicu1d(k).GE.1.e-10) THEN
1317  dum=qicu1d(k)*dt/(ci*(80.e-6)**di)
1318  ni3d(k)=ni3d(k)+dum
1319  END IF
1320 
1321 ! AT SUBSATURATION, REMOVE SMALL AMOUNTS OF CLOUD/PRECIP WATER
1322 ! hm modify 7/0/09 change limit to 1.e-8
1323 
1324  IF (qvqvs(k).LT.0.9) THEN
1325  IF (qr3d(k).LT.1.e-8) THEN
1326  qv3d(k)=qv3d(k)+qr3d(k)
1327  t3d(k)=t3d(k)-qr3d(k)*xxlv(k)/cpm(k)
1328  qr3d(k)=0.
1329  END IF
1330  IF (qc3d(k).LT.1.e-8) THEN
1331  qv3d(k)=qv3d(k)+qc3d(k)
1332  t3d(k)=t3d(k)-qc3d(k)*xxlv(k)/cpm(k)
1333  qc3d(k)=0.
1334  END IF
1335  END IF
1336 ! Fortran version
1337  IF (qvqvsi(k).LT.0.9) THEN
1338  IF (qi3d(k).LT.1.e-8) THEN
1339  qv3d(k)=qv3d(k)+qi3d(k)
1340  t3d(k)=t3d(k)-qi3d(k)*xxls(k)/cpm(k)
1341  qi3d(k)=0.
1342  END IF
1343  IF (qni3d(k).LT.1.e-8) THEN
1344  qv3d(k)=qv3d(k)+qni3d(k)
1345  t3d(k)=t3d(k)-qni3d(k)*xxls(k)/cpm(k)
1346  qni3d(k)=0.
1347  END IF
1348  IF (qg3d(k).LT.1.e-8) THEN
1349  qv3d(k)=qv3d(k)+qg3d(k)
1350  t3d(k)=t3d(k)-qg3d(k)*xxls(k)/cpm(k)
1351  qg3d(k)=0.
1352  END IF
1353  END IF
1354  ! Fortran version
1355 ! HEAT OF FUSION
1356 
1357  xlf(k) = xxls(k)-xxlv(k)
1358 
1359 !..................................................................
1360 ! IF MIXING RATIO < QSMALL SET MIXING RATIO AND NUMBER CONC TO ZERO
1361 
1362  IF (qc3d(k).LT.qsmall) THEN
1363  qc3d(k) = 0.
1364  nc3d(k) = 0.
1365  effc(k) = 0.
1366  END IF
1367  IF (qr3d(k).LT.qsmall) THEN
1368  qr3d(k) = 0.
1369  nr3d(k) = 0.
1370  effr(k) = 0.
1371  END IF
1372  IF (qi3d(k).LT.qsmall) THEN
1373  qi3d(k) = 0.
1374  ni3d(k) = 0.
1375  effi(k) = 0.
1376  END IF
1377  IF (qni3d(k).LT.qsmall) THEN
1378  qni3d(k) = 0.
1379  ns3d(k) = 0.
1380  effs(k) = 0.
1381  END IF
1382  IF (qg3d(k).LT.qsmall) THEN
1383  qg3d(k) = 0.
1384  ng3d(k) = 0.
1385  effg(k) = 0.
1386  END IF
1387 ! Fortran version
1388 ! INITIALIZE SEDIMENTATION TENDENCIES FOR MIXING RATIO
1389 
1390  qrsten(k) = 0.
1391  qisten(k) = 0.
1392  qnisten(k) = 0.
1393  qcsten(k) = 0.
1394  qgsten(k) = 0.
1395 
1396 !..................................................................
1397 ! MICROPHYSICS PARAMETERS VARYING IN TIME/HEIGHT
1398 
1399 ! fix 053011
1400  mu(k) = 1.496e-6*t3d(k)**1.5/(t3d(k)+120.)
1401 
1402 ! FALL SPEED WITH DENSITY CORRECTION (HEYMSFIELD AND BENSSEMER 2006)
1403 
1404  dum = (rhosu/rho(k))**0.54
1405 
1406 ! fix 053011
1407 ! AIN(K) = DUM*AI
1408 ! AA revision 4/1/11: Ikawa and Saito 1991 air-density correction
1409  ain(k) = (rhosu/rho(k))**0.35*ai
1410  arn(k) = dum*ar
1411  asn(k) = dum*as
1412 ! ACN(K) = DUM*AC
1413 ! AA revision 4/1/11: temperature-dependent Stokes fall speed
1414  acn(k) = g*rhow/(18.*mu(k))
1415 ! HM ADD GRAUPEL 8/28/06
1416  agn(k) = dum*ag
1417 !hm 4/7/09 bug fix, initialize lami to prevent later division by zero
1418  lami(k)=0.
1419 
1420 !..................................
1421 ! IF THERE IS NO CLOUD/PRECIP WATER, AND IF SUBSATURATED, THEN SKIP MICROPHYSICS
1422 ! FOR THIS LEVEL
1423 
1424  IF ( qc3d(k).LT.qsmall.AND. &
1425  qi3d(k).LT.qsmall.AND. &
1426  qni3d(k).LT.qsmall.AND. &
1427  qr3d(k).LT.qsmall.AND. &
1428  qg3d(k).LT.qsmall) THEN
1429  IF (t3d(k).LT.273.15.AND.qvqvsi(k).LT.0.999) then
1430  GOTO 200
1431  endif
1432  IF (t3d(k).GE.273.15.AND.qvqvs(k).LT.0.999) then
1433  GOTO 200
1434  endif
1435  END IF
1436 
1437 ! THERMAL CONDUCTIVITY FOR AIR
1438 
1439 ! fix 053011
1440  kap(k) = 1.414e3*mu(k)
1441 
1442 ! DIFFUSIVITY OF WATER VAPOR
1443 
1444  dv(k) = 8.794e-5*t3d(k)**1.81/pres(k)
1445 
1446 ! SCHMIT NUMBER
1447 
1448 ! fix 053011
1449  sc(k) = mu(k)/(rho(k)*dv(k))
1450 
1451 ! PSYCHOMETIC CORRECTIONS
1452 
1453 ! RATE OF CHANGE SAT. MIX. RATIO WITH TEMPERATURE
1454 
1455  dum = (rv*t3d(k)**2)
1456 
1457  dqsdt = xxlv(k)*qvs(k)/dum
1458  dqsidt = xxls(k)*qvi(k)/dum
1459 
1460  abi(k) = 1.+dqsidt*xxls(k)/cpm(k)
1461  ab(k) = 1.+dqsdt*xxlv(k)/cpm(k)
1462 !
1463 !.....................................................................
1464 !.....................................................................
1465 ! CASE FOR TEMPERATURE ABOVE FREEZING
1466 
1467  IF (t3d(k).GE.273.15) THEN
1468 
1469 !......................................................................
1470 !HM ADD, ALLOW FOR CONSTANT DROPLET NUMBER
1471 ! INUM = 0, PREDICT DROPLET NUMBER
1472 ! INUM = 1, SET CONSTANT DROPLET NUMBER
1473 
1474  IF (iinum.EQ.1) THEN
1475 ! NDCNST: #/CM^3 -> #/M^3; RHO_ERF: KG_DRY/M^3; NC3D: #/KG_DRY
1476  nc3d(k)=ndcnst*1.e6/rho_erf(k)
1477  END IF
1478 
1479 ! GET SIZE DISTRIBUTION PARAMETERS
1480 
1481 ! MELT VERY SMALL SNOW AND GRAUPEL MIXING RATIOS, ADD TO RAIN
1482  IF (qni3d(k).LT.1.e-6) THEN
1483  qr3d(k)=qr3d(k)+qni3d(k)
1484  nr3d(k)=nr3d(k)+ns3d(k)
1485  t3d(k)=t3d(k)-qni3d(k)*xlf(k)/cpm(k)
1486  qni3d(k) = 0.
1487  ns3d(k) = 0.
1488  END IF
1489  IF (qg3d(k).LT.1.e-6) THEN
1490  qr3d(k)=qr3d(k)+qg3d(k)
1491  nr3d(k)=nr3d(k)+ng3d(k)
1492  t3d(k)=t3d(k)-qg3d(k)*xlf(k)/cpm(k)
1493  qg3d(k) = 0.
1494  ng3d(k) = 0.
1495  END IF
1496  IF (qc3d(k).LT.qsmall.AND.qni3d(k).LT.1.e-8.AND.qr3d(k).LT.qsmall.AND.qg3d(k).LT.1.e-8) THEN
1497  GOTO 300
1498  ENDIF
1499 
1500 ! MAKE SURE NUMBER CONCENTRATIONS AREN'T NEGATIVE
1501 
1502  ns3d(k) = max(0.,ns3d(k))
1503  nc3d(k) = max(0.,nc3d(k))
1504  nr3d(k) = max(0.,nr3d(k))
1505  ng3d(k) = max(0.,ng3d(k))
1506 
1507 !......................................................................
1508 ! RAIN
1509 
1510  IF (qr3d(k).GE.qsmall) THEN
1511  lamr(k) = (pi*rhow*nr3d(k)/qr3d(k))**(1./3.)
1512  n0rr(k) = nr3d(k)*lamr(k)
1513 
1514 ! CHECK FOR SLOPE
1515 
1516 ! ADJUST VARS
1517 
1518  IF (lamr(k).LT.lamminr) THEN
1519 
1520  lamr(k) = lamminr
1521 
1522  n0rr(k) = lamr(k)**4*qr3d(k)/(pi*rhow)
1523 
1524  nr3d(k) = n0rr(k)/lamr(k)
1525  ELSE IF (lamr(k).GT.lammaxr) THEN
1526  lamr(k) = lammaxr
1527  n0rr(k) = lamr(k)**4*qr3d(k)/(pi*rhow)
1528 
1529  nr3d(k) = n0rr(k)/lamr(k)
1530  END IF
1531  END IF
1532 
1533 !......................................................................
1534 ! CLOUD DROPLETS
1535 
1536 ! MARTIN ET AL. (1994) FORMULA FOR PGAM
1537 
1538  IF (qc3d(k).GE.qsmall) THEN
1539 
1540  dum = pres(k)/(287.15*t3d(k))
1541  pgam(k)=0.0005714*(nc3d(k)/1.e6*dum)+0.2714
1542  pgam(k)=1./(pgam(k)**2)-1.
1543  pgam(k)=max(pgam(k),2.)
1544  pgam(k)=min(pgam(k),10.)
1545 
1546 ! CALCULATE LAMC
1547 
1548  lamc(k) = (cons26*nc3d(k)*gamma(pgam(k)+4.)/ &
1549  (qc3d(k)*gamma(pgam(k)+1.)))**(1./3.)
1550 
1551 ! LAMMIN, 60 MICRON DIAMETER
1552 ! LAMMAX, 1 MICRON
1553 
1554  lammin = (pgam(k)+1.)/60.e-6
1555  lammax = (pgam(k)+1.)/1.e-6
1556 
1557  IF (lamc(k).LT.lammin) THEN
1558  lamc(k) = lammin
1559 
1560  nc3d(k) = exp(3.*log(lamc(k))+log(qc3d(k))+ &
1561  log(gamma(pgam(k)+1.))-log(gamma(pgam(k)+4.)))/cons26
1562  ELSE IF (lamc(k).GT.lammax) THEN
1563  lamc(k) = lammax
1564 
1565  nc3d(k) = exp(3.*log(lamc(k))+log(qc3d(k))+ &
1566  log(gamma(pgam(k)+1.))-log(gamma(pgam(k)+4.)))/cons26
1567 
1568  END IF
1569 
1570  END IF
1571 
1572 !......................................................................
1573 ! SNOW
1574 
1575  IF (qni3d(k).GE.qsmall) THEN
1576  lams(k) = (cons1*ns3d(k)/qni3d(k))**(1./ds)
1577  n0s(k) = ns3d(k)*lams(k)
1578 
1579 ! CHECK FOR SLOPE
1580 
1581 ! ADJUST VARS
1582 
1583  IF (lams(k).LT.lammins) THEN
1584  lams(k) = lammins
1585  n0s(k) = lams(k)**4*qni3d(k)/cons1
1586 
1587  ns3d(k) = n0s(k)/lams(k)
1588 
1589  ELSE IF (lams(k).GT.lammaxs) THEN
1590 
1591  lams(k) = lammaxs
1592  n0s(k) = lams(k)**4*qni3d(k)/cons1
1593 
1594  ns3d(k) = n0s(k)/lams(k)
1595  END IF
1596  END IF
1597 
1598 !......................................................................
1599 ! GRAUPEL
1600 
1601  IF (qg3d(k).GE.qsmall) THEN
1602  lamg(k) = (cons2*ng3d(k)/qg3d(k))**(1./dg)
1603  n0g(k) = ng3d(k)*lamg(k)
1604 
1605 ! ADJUST VARS
1606 
1607  IF (lamg(k).LT.lamming) THEN
1608  lamg(k) = lamming
1609  n0g(k) = lamg(k)**4*qg3d(k)/cons2
1610 
1611  ng3d(k) = n0g(k)/lamg(k)
1612 
1613  ELSE IF (lamg(k).GT.lammaxg) THEN
1614 
1615  lamg(k) = lammaxg
1616  n0g(k) = lamg(k)**4*qg3d(k)/cons2
1617 
1618  ng3d(k) = n0g(k)/lamg(k)
1619  END IF
1620  END IF
1621 !.....................................................................
1622 ! ZERO OUT PROCESS RATES
1623 
1624  prc(k) = 0.
1625  nprc(k) = 0.
1626  nprc1(k) = 0.
1627  pra(k) = 0.
1628  npra(k) = 0.
1629  nragg(k) = 0.
1630  nsmlts(k) = 0.
1631  nsmltr(k) = 0.
1632  evpms(k) = 0.
1633  pcc(k) = 0.
1634  pre(k) = 0.
1635  nsubc(k) = 0.
1636  nsubr(k) = 0.
1637  pracg(k) = 0.
1638  npracg(k) = 0.
1639  psmlt(k) = 0.
1640  pgmlt(k) = 0.
1641  evpmg(k) = 0.
1642  pracs(k) = 0.
1643  npracs(k) = 0.
1644  ngmltg(k) = 0.
1645  ngmltr(k) = 0.
1646 
1647 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
1648 ! CALCULATION OF MICROPHYSICAL PROCESS RATES, T > 273.15 K
1649 
1650 !.................................................................
1651 !.......................................................................
1652 ! AUTOCONVERSION OF CLOUD LIQUID WATER TO RAIN
1653 ! FORMULA FROM BEHENG (1994)
1654 ! USING NUMERICAL SIMULATION OF STOCHASTIC COLLECTION EQUATION
1655 ! AND INITIAL CLOUD DROPLET SIZE DISTRIBUTION SPECIFIED
1656 ! AS A GAMMA DISTRIBUTION
1657 
1658 ! USE MINIMUM VALUE OF 1.E-6 TO PREVENT FLOATING POINT ERROR
1659 
1660  IF (qc3d(k).GE.1.e-6) THEN
1661 
1662 ! HM ADD 12/13/06, REPLACE WITH NEWER FORMULA
1663 ! FROM KHAIROUTDINOV AND KOGAN 2000, MWR
1664 
1665  prc(k)=1350.*qc3d(k)**2.47* &
1666  (nc3d(k)/1.e6*rho(k))**(-1.79)
1667 
1668 ! note: nprc1 is change in Nr,
1669 ! nprc is change in Nc
1670 
1671  nprc1(k) = prc(k)/cons29
1672  nprc(k) = prc(k)/(qc3d(k)/nc3d(k))
1673 
1674 ! hm bug fix 3/20/12
1675  nprc(k) = min(nprc(k),nc3d(k)/dt)
1676  nprc1(k) = min(nprc1(k),nprc(k))
1677 
1678  END IF
1679 
1680 !.......................................................................
1681 ! HM ADD 12/13/06, COLLECTION OF SNOW BY RAIN ABOVE FREEZING
1682 ! FORMULA FROM IKAWA AND SAITO (1991)
1683 
1684  IF (qr3d(k).GE.1.e-8.AND.qni3d(k).GE.1.e-8) THEN
1685 
1686  ums = asn(k)*cons3/(lams(k)**bs)
1687  umr = arn(k)*cons4/(lamr(k)**br)
1688  uns = asn(k)*cons5/lams(k)**bs
1689  unr = arn(k)*cons6/lamr(k)**br
1690 
1691 ! SET REASLISTIC LIMITS ON FALLSPEEDS
1692 
1693 ! bug fix, 10/08/09
1694  dum=(rhosu/rho(k))**0.54
1695  ums=min(ums,1.2*dum)
1696  uns=min(uns,1.2*dum)
1697  umr=min(umr,9.1*dum)
1698  unr=min(unr,9.1*dum)
1699 
1700 ! hm fix, 2/12/13
1701 ! for above freezing conditions to get accelerated melting of snow,
1702 ! we need collection of rain by snow (following Lin et al. 1983)
1703 ! PRACS(K) = CONS31*(((1.2*UMR-0.95*UMS)**2+ &
1704 ! 0.08*UMS*UMR)**0.5*RHO(K)* &
1705 ! N0RR(K)*N0S(K)/LAMS(K)**3* &
1706 ! (5./(LAMS(K)**3*LAMR(K))+ &
1707 ! 2./(LAMS(K)**2*LAMR(K)**2)+ &
1708 ! 0.5/(LAMS(K)*LAMR(K)**3)))
1709 
1710  pracs(k) = cons41*(((1.2*umr-0.95*ums)**2+ &
1711  0.08*ums*umr)**0.5*rho(k)* &
1712  n0rr(k)*n0s(k)/lamr(k)**3* &
1713  (5./(lamr(k)**3*lams(k))+ &
1714  2./(lamr(k)**2*lams(k)**2)+ &
1715  0.5/(lamr(k)*lams(k)**3)))
1716 
1717 ! fix 053011, npracs no longer subtracted from snow
1718 ! NPRACS(K) = CONS32*RHO(K)*(1.7*(UNR-UNS)**2+ &
1719 ! 0.3*UNR*UNS)**0.5*N0RR(K)*N0S(K)* &
1720 ! (1./(LAMR(K)**3*LAMS(K))+ &
1721 ! 1./(LAMR(K)**2*LAMS(K)**2)+ &
1722 ! 1./(LAMR(K)*LAMS(K)**3))
1723 
1724  END IF
1725 
1726 ! ADD COLLECTION OF GRAUPEL BY RAIN ABOVE FREEZING
1727 ! ASSUME ALL RAIN COLLECTION BY GRAUPEL ABOVE FREEZING IS SHED
1728 ! ASSUME SHED DROPS ARE 1 MM IN SIZE
1729 
1730  IF (qr3d(k).GE.1.e-8.AND.qg3d(k).GE.1.e-8) THEN
1731 
1732  umg = agn(k)*cons7/(lamg(k)**bg)
1733  umr = arn(k)*cons4/(lamr(k)**br)
1734  ung = agn(k)*cons8/lamg(k)**bg
1735  unr = arn(k)*cons6/lamr(k)**br
1736 
1737 ! SET REASLISTIC LIMITS ON FALLSPEEDS
1738 ! bug fix, 10/08/09
1739  dum=(rhosu/rho(k))**0.54
1740  umg=min(umg,20.*dum)
1741  ung=min(ung,20.*dum)
1742  umr=min(umr,9.1*dum)
1743  unr=min(unr,9.1*dum)
1744 
1745 ! PRACG IS MIXING RATIO OF RAIN PER SEC COLLECTED BY GRAUPEL/HAIL
1746  pracg(k) = cons41*(((1.2*umr-0.95*umg)**2+ &
1747  0.08*umg*umr)**0.5*rho(k)* &
1748  n0rr(k)*n0g(k)/lamr(k)**3* &
1749  (5./(lamr(k)**3*lamg(k))+ &
1750  2./(lamr(k)**2*lamg(k)**2)+ &
1751  0.5/(lamr(k)*lamg(k)**3)))
1752 
1753 ! ASSUME 1 MM DROPS ARE SHED, GET NUMBER SHED PER SEC
1754 
1755  dum = pracg(k)/5.2e-7
1756 
1757  npracg(k) = cons32*rho(k)*(1.7*(unr-ung)**2+ &
1758  0.3*unr*ung)**0.5*n0rr(k)*n0g(k)* &
1759  (1./(lamr(k)**3*lamg(k))+ &
1760  1./(lamr(k)**2*lamg(k)**2)+ &
1761  1./(lamr(k)*lamg(k)**3))
1762 
1763 ! hm 7/15/13, remove limit so that the number of collected drops can smaller than
1764 ! number of shed drops
1765 ! NPRACG(K)=MAX(NPRACG(K)-DUM,0.)
1766  npracg(k)=npracg(k)-dum
1767 
1768  END IF
1769 
1770 !.......................................................................
1771 ! ACCRETION OF CLOUD LIQUID WATER BY RAIN
1772 ! CONTINUOUS COLLECTION EQUATION WITH
1773 ! GRAVITATIONAL COLLECTION KERNEL, DROPLET FALL SPEED NEGLECTED
1774 
1775  IF (qr3d(k).GE.1.e-8 .AND. qc3d(k).GE.1.e-8) THEN
1776 
1777 ! 12/13/06 HM ADD, REPLACE WITH NEWER FORMULA FROM
1778 ! KHAIROUTDINOV AND KOGAN 2000, MWR
1779 
1780  dum=(qc3d(k)*qr3d(k))
1781  pra(k) = 67.*(dum)**1.15
1782  npra(k) = pra(k)/(qc3d(k)/nc3d(k))
1783 
1784  END IF
1785 !.......................................................................
1786 ! SELF-COLLECTION OF RAIN DROPS
1787 ! FROM BEHENG(1994)
1788 ! FROM NUMERICAL SIMULATION OF THE STOCHASTIC COLLECTION EQUATION
1789 ! AS DESCRINED ABOVE FOR AUTOCONVERSION
1790 
1791  IF (qr3d(k).GE.1.e-8) THEN
1792 ! include breakup add 10/09/09
1793  dum1=300.e-6
1794  if (1./lamr(k).lt.dum1) then
1795  dum=1.
1796  else if (1./lamr(k).ge.dum1) then
1797  dum=2.-exp(2300.*(1./lamr(k)-dum1))
1798  end if
1799 ! NRAGG(K) = -8.*NR3D(K)*QR3D(K)*RHO(K)
1800  nragg(k) = -5.78*dum*nr3d(k)*qr3d(k)*rho(k)
1801  END IF
1802 
1803 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
1804 ! CALCULATE EVAP OF RAIN (RUTLEDGE AND HOBBS 1983)
1805 
1806  IF (qr3d(k).GE.qsmall) THEN
1807  epsr = 2.*pi*n0rr(k)*rho(k)*dv(k)* &
1808  (f1r/(lamr(k)*lamr(k))+ &
1809  f2r*(arn(k)*rho(k)/mu(k))**0.5* &
1810  sc(k)**(1./3.)*cons9/ &
1811  (lamr(k)**cons34))
1812  ELSE
1813  epsr = 0.
1814  END IF
1815 ! NO CONDENSATION ONTO RAIN, ONLY EVAP ALLOWED
1816 
1817  IF (qv3d(k).LT.qvs(k)) THEN
1818  pre(k) = epsr*(qv3d(k)-qvs(k))/ab(k)
1819  pre(k) = min(pre(k),0.)
1820  ELSE
1821  pre(k) = 0.
1822  END IF
1823 !.......................................................................
1824 ! MELTING OF SNOW
1825 
1826 ! SNOW MAY PERSITS ABOVE FREEZING, FORMULA FROM RUTLEDGE AND HOBBS, 1984
1827 ! IF WATER SUPERSATURATION, SNOW MELTS TO FORM RAIN
1828 
1829  IF (qni3d(k).GE.1.e-8) THEN
1830 
1831 ! fix 053011
1832 ! HM, MODIFY FOR V3.2, ADD ACCELERATED MELTING DUE TO COLLISION WITH RAIN
1833 ! DUM = -CPW/XLF(K)*T3D(K)*PRACS(K)
1834  dum = -cpw/xlf(k)*(t3d(k)-273.15)*pracs(k)
1835 
1836 ! hm fix 1/20/15
1837 ! PSMLT(K)=2.*PI*N0S(K)*KAP(K)*(273.15-T3D(K))/ &
1838 ! XLF(K)*RHO(K)*(F1S/(LAMS(K)*LAMS(K))+ &
1839 ! F2S*(ASN(K)*RHO(K)/MU(K))**0.5* &
1840 ! SC(K)**(1./3.)*CONS10/ &
1841 ! (LAMS(K)**CONS35))+DUM
1842  psmlt(k)=2.*pi*n0s(k)*kap(k)*(273.15-t3d(k))/ &
1843  xlf(k)*(f1s/(lams(k)*lams(k))+ &
1844  f2s*(asn(k)*rho(k)/mu(k))**0.5* &
1845  sc(k)**(1./3.)*cons10/ &
1846  (lams(k)**cons35))+dum
1847 
1848 ! IN WATER SUBSATURATION, SNOW MELTS AND EVAPORATES
1849 
1850  IF (qvqvs(k).LT.1.) THEN
1851  epss = 2.*pi*n0s(k)*rho(k)*dv(k)* &
1852  (f1s/(lams(k)*lams(k))+ &
1853  f2s*(asn(k)*rho(k)/mu(k))**0.5* &
1854  sc(k)**(1./3.)*cons10/ &
1855  (lams(k)**cons35))
1856 ! hm fix 8/4/08
1857  evpms(k) = (qv3d(k)-qvs(k))*epss/ab(k)
1858  evpms(k) = max(evpms(k),psmlt(k))
1859  psmlt(k) = psmlt(k)-evpms(k)
1860  END IF
1861  END IF
1862 
1863 !.......................................................................
1864 ! MELTING OF GRAUPEL
1865 
1866 ! GRAUPEL MAY PERSITS ABOVE FREEZING, FORMULA FROM RUTLEDGE AND HOBBS, 1984
1867 ! IF WATER SUPERSATURATION, GRAUPEL MELTS TO FORM RAIN
1868 
1869  IF (qg3d(k).GE.1.e-8) THEN
1870 
1871 ! fix 053011
1872 ! HM, MODIFY FOR V3.2, ADD ACCELERATED MELTING DUE TO COLLISION WITH RAIN
1873 ! DUM = -CPW/XLF(K)*T3D(K)*PRACG(K)
1874  dum = -cpw/xlf(k)*(t3d(k)-273.15)*pracg(k)
1875 
1876 ! hm fix 1/20/15
1877 ! PGMLT(K)=2.*PI*N0G(K)*KAP(K)*(273.15-T3D(K))/ &
1878 ! XLF(K)*RHO(K)*(F1S/(LAMG(K)*LAMG(K))+ &
1879 ! F2S*(AGN(K)*RHO(K)/MU(K))**0.5* &
1880 ! SC(K)**(1./3.)*CONS11/ &
1881 ! (LAMG(K)**CONS36))+DUM
1882  pgmlt(k)=2.*pi*n0g(k)*kap(k)*(273.15-t3d(k))/ &
1883  xlf(k)*(f1s/(lamg(k)*lamg(k))+ &
1884  f2s*(agn(k)*rho(k)/mu(k))**0.5* &
1885  sc(k)**(1./3.)*cons11/ &
1886  (lamg(k)**cons36))+dum
1887 
1888 ! IN WATER SUBSATURATION, GRAUPEL MELTS AND EVAPORATES
1889 
1890  IF (qvqvs(k).LT.1.) THEN
1891  epsg = 2.*pi*n0g(k)*rho(k)*dv(k)* &
1892  (f1s/(lamg(k)*lamg(k))+ &
1893  f2s*(agn(k)*rho(k)/mu(k))**0.5* &
1894  sc(k)**(1./3.)*cons11/ &
1895  (lamg(k)**cons36))
1896 ! hm fix 8/4/08
1897  evpmg(k) = (qv3d(k)-qvs(k))*epsg/ab(k)
1898  evpmg(k) = max(evpmg(k),pgmlt(k))
1899  pgmlt(k) = pgmlt(k)-evpmg(k)
1900  END IF
1901  END IF
1902 
1903 ! HM, V3.2
1904 ! RESET PRACG AND PRACS TO ZERO, THIS IS DONE BECAUSE THERE IS NO
1905 ! TRANSFER OF MASS FROM SNOW AND GRAUPEL TO RAIN DIRECTLY FROM COLLECTION
1906 ! ABOVE FREEZING, IT IS ONLY USED FOR ENHANCEMENT OF MELTING AND SHEDDING
1907 
1908  pracg(k) = 0.
1909  pracs(k) = 0.
1910 
1911 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
1912 
1913 ! FOR CLOUD ICE, ONLY PROCESSES OPERATING AT T > 273.15 IS
1914 ! MELTING, WHICH IS ALREADY CONSERVED DURING PROCESS
1915 ! CALCULATION
1916 
1917 ! CONSERVATION OF QC
1918 
1919  dum = (prc(k)+pra(k))*dt
1920 
1921  IF (dum.GT.qc3d(k).AND.qc3d(k).GE.qsmall) THEN
1922 
1923  ratio = qc3d(k)/dum
1924 
1925  prc(k) = prc(k)*ratio
1926  pra(k) = pra(k)*ratio
1927 
1928  END IF
1929 
1930 ! CONSERVATION OF SNOW
1931 
1932  dum = (-psmlt(k)-evpms(k)+pracs(k))*dt
1933 
1934  IF (dum.GT.qni3d(k).AND.qni3d(k).GE.qsmall) THEN
1935 
1936 ! NO SOURCE TERMS FOR SNOW AT T > FREEZING
1937  ratio = qni3d(k)/dum
1938 
1939  psmlt(k) = psmlt(k)*ratio
1940  evpms(k) = evpms(k)*ratio
1941  pracs(k) = pracs(k)*ratio
1942 
1943  END IF
1944 
1945 ! CONSERVATION OF GRAUPEL
1946 
1947  dum = (-pgmlt(k)-evpmg(k)+pracg(k))*dt
1948 
1949  IF (dum.GT.qg3d(k).AND.qg3d(k).GE.qsmall) THEN
1950 
1951 ! NO SOURCE TERM FOR GRAUPEL ABOVE FREEZING
1952  ratio = qg3d(k)/dum
1953 
1954  pgmlt(k) = pgmlt(k)*ratio
1955  evpmg(k) = evpmg(k)*ratio
1956  pracg(k) = pracg(k)*ratio
1957 
1958  END IF
1959 
1960 ! CONSERVATION OF QR
1961 ! HM 12/13/06, ADDED CONSERVATION OF RAIN SINCE PRE IS NEGATIVE
1962 
1963  dum = (-pracs(k)-pracg(k)-pre(k)-pra(k)-prc(k)+psmlt(k)+pgmlt(k))*dt
1964 
1965  IF (dum.GT.qr3d(k).AND.qr3d(k).GE.qsmall) THEN
1966 
1967  ratio = (qr3d(k)/dt+pracs(k)+pracg(k)+pra(k)+prc(k)-psmlt(k)-pgmlt(k))/ &
1968  (-pre(k))
1969  pre(k) = pre(k)*ratio
1970  END IF
1971 
1972 !....................................
1973 
1974  qv3dten(k) = qv3dten(k)+(-pre(k)-evpms(k)-evpmg(k))
1975 
1976  t3dten(k) = t3dten(k)+(pre(k)*xxlv(k)+(evpms(k)+evpmg(k))*xxls(k)+&
1977  (psmlt(k)+pgmlt(k)-pracs(k)-pracg(k))*xlf(k))/cpm(k)
1978 
1979  qc3dten(k) = qc3dten(k)+(-pra(k)-prc(k))
1980  qr3dten(k) = qr3dten(k)+(pre(k)+pra(k)+prc(k)-psmlt(k)-pgmlt(k)+pracs(k)+pracg(k))
1981  qni3dten(k) = qni3dten(k)+(psmlt(k)+evpms(k)-pracs(k))
1982  qg3dten(k) = qg3dten(k)+(pgmlt(k)+evpmg(k)-pracg(k))
1983 ! fix 053011
1984 ! NS3DTEN(K) = NS3DTEN(K)-NPRACS(K)
1985 ! HM, bug fix 5/12/08, npracg is subtracted from nr not ng
1986 ! NG3DTEN(K) = NG3DTEN(K)
1987  nc3dten(k) = nc3dten(k)+ (-npra(k)-nprc(k))
1988  nr3dten(k) = nr3dten(k)+ (nprc1(k)+nragg(k)-npracg(k))
1989 ! Fortran version
1990 ! HM ADD, WRF-CHEM, ADD TENDENCIES FOR C2PREC
1991 
1992  c2prec(k) = pra(k)+prc(k)
1993  IF (pre(k).LT.0.) THEN
1994  dum = pre(k)*dt/qr3d(k)
1995  dum = max(-1.,dum)
1996  nsubr(k) = dum*nr3d(k)/dt
1997  END IF
1998 
1999  IF (evpms(k)+psmlt(k).LT.0.) THEN
2000  dum = (evpms(k)+psmlt(k))*dt/qni3d(k)
2001  dum = max(-1.,dum)
2002  nsmlts(k) = dum*ns3d(k)/dt
2003  END IF
2004  IF (psmlt(k).LT.0.) THEN
2005  dum = psmlt(k)*dt/qni3d(k)
2006  dum = max(-1.0,dum)
2007  nsmltr(k) = dum*ns3d(k)/dt
2008  END IF
2009  IF (evpmg(k)+pgmlt(k).LT.0.) THEN
2010  dum = (evpmg(k)+pgmlt(k))*dt/qg3d(k)
2011  dum = max(-1.,dum)
2012  ngmltg(k) = dum*ng3d(k)/dt
2013  END IF
2014  IF (pgmlt(k).LT.0.) THEN
2015  dum = pgmlt(k)*dt/qg3d(k)
2016  dum = max(-1.0,dum)
2017  ngmltr(k) = dum*ng3d(k)/dt
2018  END IF
2019 
2020  ns3dten(k) = ns3dten(k)+(nsmlts(k))
2021  ng3dten(k) = ng3dten(k)+(ngmltg(k))
2022  nr3dten(k) = nr3dten(k)+(nsubr(k)-nsmltr(k)-ngmltr(k))
2023 
2024  300 CONTINUE
2025 
2026 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
2027 ! NOW CALCULATE SATURATION ADJUSTMENT TO CONDENSE EXTRA VAPOR ABOVE
2028 ! WATER SATURATION
2029 
2030  dumt = t3d(k)+dt*t3dten(k)
2031  dumqv = qv3d(k)+dt*qv3dten(k)
2032 ! hm, add fix for low pressure, 5/12/10
2033  dum=min(0.99*pres(k),polysvp(dumt,0))
2034  dumqss = ep_2*dum/(pres(k)-dum)
2035  dumqc = qc3d(k)+dt*qc3dten(k)
2036  dumqc = max(dumqc,0.)
2037 
2038 ! SATURATION ADJUSTMENT FOR LIQUID
2039 
2040  dums = dumqv-dumqss
2041  pcc(k) = dums/(1.+xxlv(k)**2*dumqss/(cpm(k)*rv*dumt**2))/dt
2042  IF (pcc(k)*dt+dumqc.LT.0.) THEN
2043  pcc(k) = -dumqc/dt
2044  END IF
2045 
2046  qv3dten(k) = qv3dten(k)-pcc(k)
2047  t3dten(k) = t3dten(k)+pcc(k)*xxlv(k)/cpm(k)
2048  qc3dten(k) = qc3dten(k)+pcc(k)
2049 !.......................................................................
2050 ! ACTIVATION OF CLOUD DROPLETS
2051 ! ACTIVATION OF DROPLET CURRENTLY NOT CALCULATED
2052 ! DROPLET CONCENTRATION IS SPECIFIED !!!!!
2053 
2054 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
2055 ! SUBLIMATE, MELT, OR EVAPORATE NUMBER CONCENTRATION
2056 ! THIS FORMULATION ASSUMES 1:1 RATIO BETWEEN MASS LOSS AND
2057 ! LOSS OF NUMBER CONCENTRATION
2058 
2059 ! IF (PCC(K).LT.0.) THEN
2060 ! DUM = PCC(K)*DT/QC3D(K)
2061 ! DUM = MAX(-1.,DUM)
2062 ! NSUBC(K) = DUM*NC3D(K)/DT
2063 ! END IF
2064 
2065 ! UPDATE TENDENCIES
2066 
2067 ! NC3DTEN(K) = NC3DTEN(K)+NSUBC(K)
2068 
2069 !.....................................................................
2070 !.....................................................................
2071  ELSE ! TEMPERATURE < 273.15
2072 
2073 !......................................................................
2074 !HM ADD, ALLOW FOR CONSTANT DROPLET NUMBER
2075 ! INUM = 0, PREDICT DROPLET NUMBER
2076 ! INUM = 1, SET CONSTANT DROPLET NUMBER
2077 
2078  IF (iinum.EQ.1) THEN
2079 ! NDCNST: #/CM^3 -> #/M^3; RHO_ERF: KG_DRY/M^3; NC3D: #/KG_DRY
2080  nc3d(k)=ndcnst*1.e6/rho_erf(k)
2081  END IF
2082 
2083 ! CALCULATE SIZE DISTRIBUTION PARAMETERS
2084 ! MAKE SURE NUMBER CONCENTRATIONS AREN'T NEGATIVE
2085 
2086  ni3d(k) = max(0.,ni3d(k))
2087  ns3d(k) = max(0.,ns3d(k))
2088  nc3d(k) = max(0.,nc3d(k))
2089  nr3d(k) = max(0.,nr3d(k))
2090  ng3d(k) = max(0.,ng3d(k))
2091 
2092 !......................................................................
2093 ! CLOUD ICE
2094 
2095  IF (qi3d(k).GE.qsmall) THEN
2096  lami(k) = (cons12* &
2097  ni3d(k)/qi3d(k))**(1./di)
2098  n0i(k) = ni3d(k)*lami(k)
2099 
2100 ! CHECK FOR SLOPE
2101 
2102 ! ADJUST VARS
2103 
2104  IF (lami(k).LT.lammini) THEN
2105 
2106  lami(k) = lammini
2107 
2108  n0i(k) = lami(k)**4*qi3d(k)/cons12
2109 
2110  ni3d(k) = n0i(k)/lami(k)
2111  ELSE IF (lami(k).GT.lammaxi) THEN
2112  lami(k) = lammaxi
2113  n0i(k) = lami(k)**4*qi3d(k)/cons12
2114 
2115  ni3d(k) = n0i(k)/lami(k)
2116  END IF
2117  END IF
2118 
2119 !......................................................................
2120 ! RAIN
2121 
2122  IF (qr3d(k).GE.qsmall) THEN
2123  lamr(k) = (pi*rhow*nr3d(k)/qr3d(k))**(1./3.)
2124  n0rr(k) = nr3d(k)*lamr(k)
2125 
2126 ! CHECK FOR SLOPE
2127 
2128 ! ADJUST VARS
2129 
2130  IF (lamr(k).LT.lamminr) THEN
2131 
2132  lamr(k) = lamminr
2133 
2134  n0rr(k) = lamr(k)**4*qr3d(k)/(pi*rhow)
2135 
2136  nr3d(k) = n0rr(k)/lamr(k)
2137  ELSE IF (lamr(k).GT.lammaxr) THEN
2138  lamr(k) = lammaxr
2139  n0rr(k) = lamr(k)**4*qr3d(k)/(pi*rhow)
2140 
2141  nr3d(k) = n0rr(k)/lamr(k)
2142  END IF
2143  END IF
2144 !......................................................................
2145 ! CLOUD DROPLETS
2146 
2147 ! MARTIN ET AL. (1994) FORMULA FOR PGAM
2148 
2149  IF (qc3d(k).GE.qsmall) THEN
2150 
2151  dum = pres(k)/(287.15*t3d(k))
2152  pgam(k)=0.0005714*(nc3d(k)/1.e6*dum)+0.2714
2153  pgam(k)=1./(pgam(k)**2)-1.
2154  pgam(k)=max(pgam(k),2.)
2155  pgam(k)=min(pgam(k),10.)
2156 
2157 ! CALCULATE LAMC
2158 
2159  lamc(k) = (cons26*nc3d(k)*gamma(pgam(k)+4.)/ &
2160  (qc3d(k)*gamma(pgam(k)+1.)))**(1./3.)
2161 
2162 ! LAMMIN, 60 MICRON DIAMETER
2163 ! LAMMAX, 1 MICRON
2164 
2165  lammin = (pgam(k)+1.)/60.e-6
2166  lammax = (pgam(k)+1.)/1.e-6
2167 
2168  IF (lamc(k).LT.lammin) THEN
2169  lamc(k) = lammin
2170 
2171  nc3d(k) = exp(3.*log(lamc(k))+log(qc3d(k))+ &
2172  log(gamma(pgam(k)+1.))-log(gamma(pgam(k)+4.)))/cons26
2173  ELSE IF (lamc(k).GT.lammax) THEN
2174  lamc(k) = lammax
2175  nc3d(k) = exp(3.*log(lamc(k))+log(qc3d(k))+ &
2176  log(gamma(pgam(k)+1.))-log(gamma(pgam(k)+4.)))/cons26
2177 
2178  END IF
2179 
2180 ! TO CALCULATE DROPLET FREEZING
2181 
2182  cdist1(k) = nc3d(k)/gamma(pgam(k)+1.)
2183 
2184  END IF
2185 
2186 !......................................................................
2187 ! SNOW
2188 
2189  IF (qni3d(k).GE.qsmall) THEN
2190  lams(k) = (cons1*ns3d(k)/qni3d(k))**(1./ds)
2191  n0s(k) = ns3d(k)*lams(k)
2192 
2193 ! CHECK FOR SLOPE
2194 
2195 ! ADJUST VARS
2196 
2197  IF (lams(k).LT.lammins) THEN
2198  lams(k) = lammins
2199  n0s(k) = lams(k)**4*qni3d(k)/cons1
2200 
2201  ns3d(k) = n0s(k)/lams(k)
2202 
2203  ELSE IF (lams(k).GT.lammaxs) THEN
2204 
2205  lams(k) = lammaxs
2206  n0s(k) = lams(k)**4*qni3d(k)/cons1
2207 
2208  ns3d(k) = n0s(k)/lams(k)
2209  END IF
2210  END IF
2211 
2212 !......................................................................
2213 ! GRAUPEL
2214 
2215  IF (qg3d(k).GE.qsmall) THEN
2216  lamg(k) = (cons2*ng3d(k)/qg3d(k))**(1./dg)
2217  n0g(k) = ng3d(k)*lamg(k)
2218 
2219 ! CHECK FOR SLOPE
2220 
2221 ! ADJUST VARS
2222 
2223  IF (lamg(k).LT.lamming) THEN
2224  lamg(k) = lamming
2225  n0g(k) = lamg(k)**4*qg3d(k)/cons2
2226 
2227  ng3d(k) = n0g(k)/lamg(k)
2228 
2229  ELSE IF (lamg(k).GT.lammaxg) THEN
2230 
2231  lamg(k) = lammaxg
2232  n0g(k) = lamg(k)**4*qg3d(k)/cons2
2233 
2234  ng3d(k) = n0g(k)/lamg(k)
2235  END IF
2236  END IF
2237 !.....................................................................
2238 ! ZERO OUT PROCESS RATES
2239 
2240  mnuccc(k) = 0.
2241  nnuccc(k) = 0.
2242  prc(k) = 0.
2243  nprc(k) = 0.
2244  nprc1(k) = 0.
2245  nsagg(k) = 0.
2246  psacws(k) = 0.
2247  npsacws(k) = 0.
2248  psacwi(k) = 0.
2249  npsacwi(k) = 0.
2250  pracs(k) = 0.
2251  npracs(k) = 0.
2252  nmults(k) = 0.
2253  qmults(k) = 0.
2254  nmultr(k) = 0.
2255  qmultr(k) = 0.
2256  nmultg(k) = 0.
2257  qmultg(k) = 0.
2258  nmultrg(k) = 0.
2259  qmultrg(k) = 0.
2260  mnuccr(k) = 0.
2261  nnuccr(k) = 0.
2262  pra(k) = 0.
2263  npra(k) = 0.
2264  nragg(k) = 0.
2265  prci(k) = 0.
2266  nprci(k) = 0.
2267  prai(k) = 0.
2268  nprai(k) = 0.
2269  nnuccd(k) = 0.
2270  mnuccd(k) = 0.
2271  pcc(k) = 0.
2272  pre(k) = 0.
2273  prd(k) = 0.
2274  prds(k) = 0.
2275  eprd(k) = 0.
2276  eprds(k) = 0.
2277  nsubc(k) = 0.
2278  nsubi(k) = 0.
2279  nsubs(k) = 0.
2280  nsubr(k) = 0.
2281  piacr(k) = 0.
2282  niacr(k) = 0.
2283  praci(k) = 0.
2284  piacrs(k) = 0.
2285  niacrs(k) = 0.
2286  pracis(k) = 0.
2287 ! HM: ADD GRAUPEL PROCESSES
2288  pracg(k) = 0.
2289  psacr(k) = 0.
2290  psacwg(k) = 0.
2291  pgsacw(k) = 0.
2292  pgracs(k) = 0.
2293  prdg(k) = 0.
2294  eprdg(k) = 0.
2295  npracg(k) = 0.
2296  npsacwg(k) = 0.
2297  nscng(k) = 0.
2298  ngracs(k) = 0.
2299  nsubg(k) = 0.
2300 
2301 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
2302 ! CALCULATION OF MICROPHYSICAL PROCESS RATES
2303 ! ACCRETION/AUTOCONVERSION/FREEZING/MELTING/COAG.
2304 !.......................................................................
2305 ! FREEZING OF CLOUD DROPLETS
2306 ! ONLY ALLOWED BELOW -4 C
2307  IF (qc3d(k).GE.qsmall .AND. t3d(k).LT.269.15) THEN
2308 
2309 ! NUMBER OF CONTACT NUCLEI (M^-3) FROM MEYERS ET AL., 1992
2310 ! FACTOR OF 1000 IS TO CONVERT FROM L^-1 TO M^-3
2311 
2312 ! MEYERS CURVE
2313 
2314  nacnt = exp(-2.80+0.262*(273.15-t3d(k)))*1000.
2315 
2316 ! COOPER CURVE
2317 ! NACNT = 5.*EXP(0.304*(273.15-T3D(K)))
2318 
2319 ! FLECTHER
2320 ! NACNT = 0.01*EXP(0.6*(273.15-T3D(K)))
2321 
2322 ! CONTACT FREEZING
2323 
2324 ! MEAN FREE PATH
2325 
2326  dum = 7.37*t3d(k)/(288.*10.*pres(k))/100.
2327 
2328 ! EFFECTIVE DIFFUSIVITY OF CONTACT NUCLEI
2329 ! BASED ON BROWNIAN DIFFUSION
2330 
2331  dap(k) = cons37*t3d(k)*(1.+dum/rin)/mu(k)
2332 
2333  mnuccc(k) = cons38*dap(k)*nacnt*exp(log(cdist1(k))+ &
2334  log(gamma(pgam(k)+5.))-4.*log(lamc(k)))
2335  nnuccc(k) = 2.*pi*dap(k)*nacnt*cdist1(k)* &
2336  gamma(pgam(k)+2.)/ &
2337  lamc(k)
2338 
2339 ! IMMERSION FREEZING (BIGG 1953)
2340 
2341 ! MNUCCC(K) = MNUCCC(K)+CONS39* &
2342 ! EXP(LOG(CDIST1(K))+LOG(GAMMA(7.+PGAM(K)))-6.*LOG(LAMC(K)))* &
2343 ! EXP(AIMM*(273.15-T3D(K)))
2344 
2345 ! NNUCCC(K) = NNUCCC(K)+ &
2346 ! CONS40*EXP(LOG(CDIST1(K))+LOG(GAMMA(PGAM(K)+4.))-3.*LOG(LAMC(K))) &
2347 ! *EXP(AIMM*(273.15-T3D(K)))
2348 
2349 ! hm 7/15/13 fix for consistency w/ original formula
2350  mnuccc(k) = mnuccc(k)+cons39* &
2351  exp(log(cdist1(k))+log(gamma(7.+pgam(k)))-6.*log(lamc(k)))* &
2352  (exp(aimm*(273.15-t3d(k)))-1.)
2353 
2354  nnuccc(k) = nnuccc(k)+ &
2355  cons40*exp(log(cdist1(k))+log(gamma(pgam(k)+4.))-3.*log(lamc(k))) &
2356  *(exp(aimm*(273.15-t3d(k)))-1.)
2357 
2358 ! PUT IN A CATCH HERE TO PREVENT DIVERGENCE BETWEEN NUMBER CONC. AND
2359 ! MIXING RATIO, SINCE STRICT CONSERVATION NOT CHECKED FOR NUMBER CONC
2360 
2361  nnuccc(k) = min(nnuccc(k),nc3d(k)/dt)
2362 
2363  END IF
2364 
2365 !.................................................................
2366 !.......................................................................
2367 ! AUTOCONVERSION OF CLOUD LIQUID WATER TO RAIN
2368 ! FORMULA FROM BEHENG (1994)
2369 ! USING NUMERICAL SIMULATION OF STOCHASTIC COLLECTION EQUATION
2370 ! AND INITIAL CLOUD DROPLET SIZE DISTRIBUTION SPECIFIED
2371 ! AS A GAMMA DISTRIBUTION
2372 
2373 ! USE MINIMUM VALUE OF 1.E-6 TO PREVENT FLOATING POINT ERROR
2374 
2375  IF (qc3d(k).GE.1.e-6) THEN
2376 
2377 ! HM ADD 12/13/06, REPLACE WITH NEWER FORMULA
2378 ! FROM KHAIROUTDINOV AND KOGAN 2000, MWR
2379 
2380  prc(k)=1350.*qc3d(k)**2.47* &
2381  (nc3d(k)/1.e6*rho(k))**(-1.79)
2382 
2383 ! note: nprc1 is change in Nr,
2384 ! nprc is change in Nc
2385 
2386  nprc1(k) = prc(k)/cons29
2387  nprc(k) = prc(k)/(qc3d(k)/nc3d(k))
2388 
2389 ! hm bug fix 3/20/12
2390  nprc(k) = min(nprc(k),nc3d(k)/dt)
2391  nprc1(k) = min(nprc1(k),nprc(k))
2392 
2393  END IF
2394 !.......................................................................
2395 ! SELF-COLLECTION OF DROPLET NOT INCLUDED IN KK2000 SCHEME
2396 
2397 ! SNOW AGGREGATION FROM PASSARELLI, 1978, USED BY REISNER, 1998
2398 ! THIS IS HARD-WIRED FOR BS = 0.4 FOR NOW
2399 
2400  IF (qni3d(k).GE.1.e-8) THEN
2401  nsagg(k) = cons15*asn(k)*rho(k)** &
2402  ((2.+bs)/3.)*qni3d(k)**((2.+bs)/3.)* &
2403  (ns3d(k)*rho(k))**((4.-bs)/3.)/ &
2404  (rho(k))
2405  END IF
2406 
2407 !.......................................................................
2408 ! ACCRETION OF CLOUD DROPLETS ONTO SNOW/GRAUPEL
2409 ! HERE USE CONTINUOUS COLLECTION EQUATION WITH
2410 ! SIMPLE GRAVITATIONAL COLLECTION KERNEL IGNORING
2411 
2412 ! SNOW
2413 
2414  IF (qni3d(k).GE.1.e-8 .AND. qc3d(k).GE.qsmall) THEN
2415 
2416  psacws(k) = cons13*asn(k)*qc3d(k)*rho(k)* &
2417  n0s(k)/ &
2418  lams(k)**(bs+3.)
2419  npsacws(k) = cons13*asn(k)*nc3d(k)*rho(k)* &
2420  n0s(k)/ &
2421  lams(k)**(bs+3.)
2422 
2423  END IF
2424 
2425 !............................................................................
2426 ! COLLECTION OF CLOUD WATER BY GRAUPEL
2427 
2428  IF (qg3d(k).GE.1.e-8 .AND. qc3d(k).GE.qsmall) THEN
2429 
2430  psacwg(k) = cons14*agn(k)*qc3d(k)*rho(k)* &
2431  n0g(k)/ &
2432  lamg(k)**(bg+3.)
2433  npsacwg(k) = cons14*agn(k)*nc3d(k)*rho(k)* &
2434  n0g(k)/ &
2435  lamg(k)**(bg+3.)
2436  END IF
2437 !.......................................................................
2438 ! HM, ADD 12/13/06
2439 ! CLOUD ICE COLLECTING DROPLETS, ASSUME THAT CLOUD ICE MEAN DIAM > 100 MICRON
2440 ! BEFORE RIMING CAN OCCUR
2441 ! ASSUME THAT RIME COLLECTED ON CLOUD ICE DOES NOT LEAD
2442 ! TO HALLET-MOSSOP SPLINTERING
2443 
2444  IF (qi3d(k).GE.1.e-8 .AND. qc3d(k).GE.qsmall) THEN
2445 
2446 ! PUT IN SIZE DEPENDENT COLLECTION EFFICIENCY BASED ON STOKES LAW
2447 ! FROM THOMPSON ET AL. 2004, MWR
2448 
2449  IF (1./lami(k).GE.100.e-6) THEN
2450 
2451  psacwi(k) = cons16*ain(k)*qc3d(k)*rho(k)* &
2452  n0i(k)/ &
2453  lami(k)**(bi+3.)
2454  npsacwi(k) = cons16*ain(k)*nc3d(k)*rho(k)* &
2455  n0i(k)/ &
2456  lami(k)**(bi+3.)
2457  END IF
2458  END IF
2459 
2460 !.......................................................................
2461 ! ACCRETION OF RAIN WATER BY SNOW
2462 ! FORMULA FROM IKAWA AND SAITO, 1991, USED BY REISNER ET AL, 1998
2463 
2464  IF (qr3d(k).GE.1.e-8.AND.qni3d(k).GE.1.e-8) THEN
2465 
2466  ums = asn(k)*cons3/(lams(k)**bs)
2467  umr = arn(k)*cons4/(lamr(k)**br)
2468  uns = asn(k)*cons5/lams(k)**bs
2469  unr = arn(k)*cons6/lamr(k)**br
2470 
2471 ! SET REASLISTIC LIMITS ON FALLSPEEDS
2472 
2473 ! bug fix, 10/08/09
2474  dum=(rhosu/rho(k))**0.54
2475  ums=min(ums,1.2*dum)
2476  uns=min(uns,1.2*dum)
2477  umr=min(umr,9.1*dum)
2478  unr=min(unr,9.1*dum)
2479 
2480  pracs(k) = cons41*(((1.2*umr-0.95*ums)**2+ &
2481  0.08*ums*umr)**0.5*rho(k)* &
2482  n0rr(k)*n0s(k)/lamr(k)**3* &
2483  (5./(lamr(k)**3*lams(k))+ &
2484  2./(lamr(k)**2*lams(k)**2)+ &
2485  0.5/(lamr(k)*lams(k)**3)))
2486 
2487  npracs(k) = cons32*rho(k)*(1.7*(unr-uns)**2+ &
2488  0.3*unr*uns)**0.5*n0rr(k)*n0s(k)* &
2489  (1./(lamr(k)**3*lams(k))+ &
2490  1./(lamr(k)**2*lams(k)**2)+ &
2491  1./(lamr(k)*lams(k)**3))
2492 
2493 ! MAKE SURE PRACS DOESN'T EXCEED TOTAL RAIN MIXING RATIO
2494 ! AS THIS MAY OTHERWISE RESULT IN TOO MUCH TRANSFER OF WATER DURING
2495 ! RIME-SPLINTERING
2496 
2497  pracs(k) = min(pracs(k),qr3d(k)/dt)
2498 
2499 ! COLLECTION OF SNOW BY RAIN - NEEDED FOR GRAUPEL CONVERSION CALCULATIONS
2500 ! ONLY CALCULATE IF SNOW AND RAIN MIXING RATIOS EXCEED 0.1 G/KG
2501 
2502 ! HM MODIFY FOR WRFV3.1
2503 ! IF (IHAIL.EQ.0) THEN
2504  IF (qni3d(k).GE.0.1e-3.AND.qr3d(k).GE.0.1e-3) THEN
2505  psacr(k) = cons31*(((1.2*umr-0.95*ums)**2+ &
2506  0.08*ums*umr)**0.5*rho(k)* &
2507  n0rr(k)*n0s(k)/lams(k)**3* &
2508  (5./(lams(k)**3*lamr(k))+ &
2509  2./(lams(k)**2*lamr(k)**2)+ &
2510  0.5/(lams(k)*lamr(k)**3)))
2511  END IF
2512 ! END IF
2513 
2514  END IF
2515 
2516 !.......................................................................
2517 
2518 ! COLLECTION OF RAINWATER BY GRAUPEL, FROM IKAWA AND SAITO 1990,
2519 ! USED BY REISNER ET AL 1998
2520  IF (qr3d(k).GE.1.e-8.AND.qg3d(k).GE.1.e-8) THEN
2521 
2522  umg = agn(k)*cons7/(lamg(k)**bg)
2523  umr = arn(k)*cons4/(lamr(k)**br)
2524  ung = agn(k)*cons8/lamg(k)**bg
2525  unr = arn(k)*cons6/lamr(k)**br
2526 
2527 ! SET REASLISTIC LIMITS ON FALLSPEEDS
2528 ! bug fix, 10/08/09
2529  dum=(rhosu/rho(k))**0.54
2530  umg=min(umg,20.*dum)
2531  ung=min(ung,20.*dum)
2532  umr=min(umr,9.1*dum)
2533  unr=min(unr,9.1*dum)
2534 
2535  pracg(k) = cons41*(((1.2*umr-0.95*umg)**2+ &
2536  0.08*umg*umr)**0.5*rho(k)* &
2537  n0rr(k)*n0g(k)/lamr(k)**3* &
2538  (5./(lamr(k)**3*lamg(k))+ &
2539  2./(lamr(k)**2*lamg(k)**2)+ &
2540  0.5/(lamr(k)*lamg(k)**3)))
2541 
2542  npracg(k) = cons32*rho(k)*(1.7*(unr-ung)**2+ &
2543  0.3*unr*ung)**0.5*n0rr(k)*n0g(k)* &
2544  (1./(lamr(k)**3*lamg(k))+ &
2545  1./(lamr(k)**2*lamg(k)**2)+ &
2546  1./(lamr(k)*lamg(k)**3))
2547 
2548 ! MAKE SURE PRACG DOESN'T EXCEED TOTAL RAIN MIXING RATIO
2549 ! AS THIS MAY OTHERWISE RESULT IN TOO MUCH TRANSFER OF WATER DURING
2550 ! RIME-SPLINTERING
2551 
2552  pracg(k) = min(pracg(k),qr3d(k)/dt)
2553 
2554  END IF
2555 
2556 !.......................................................................
2557 ! RIME-SPLINTERING - SNOW
2558 ! HALLET-MOSSOP (1974)
2559 ! NUMBER OF SPLINTERS FORMED IS BASED ON MASS OF RIMED WATER
2560 
2561 ! DUM1 = MASS OF INDIVIDUAL SPLINTERS
2562 
2563 ! HM ADD THRESHOLD SNOW AND DROPLET MIXING RATIO FOR RIME-SPLINTERING
2564 ! TO LIMIT RIME-SPLINTERING IN STRATIFORM CLOUDS
2565 ! THESE THRESHOLDS CORRESPOND WITH GRAUPEL THRESHOLDS IN RH 1984
2566 
2567 !v1.4
2568  IF (qni3d(k).GE.0.1e-3) THEN
2569  IF (qc3d(k).GE.0.5e-3.OR.qr3d(k).GE.0.1e-3) THEN
2570  IF (psacws(k).GT.0..OR.pracs(k).GT.0.) THEN
2571  IF (t3d(k).LT.270.16 .AND. t3d(k).GT.265.16) THEN
2572 
2573  IF (t3d(k).GT.270.16) THEN
2574  fmult = 0.
2575  ELSE IF (t3d(k).LE.270.16.AND.t3d(k).GT.268.16) THEN
2576  fmult = (270.16-t3d(k))/2.
2577  ELSE IF (t3d(k).GE.265.16.AND.t3d(k).LE.268.16) THEN
2578  fmult = (t3d(k)-265.16)/3.
2579  ELSE IF (t3d(k).LT.265.16) THEN
2580  fmult = 0.
2581  END IF
2582 
2583 ! 1000 IS TO CONVERT FROM KG TO G
2584 
2585 ! SPLINTERING FROM DROPLETS ACCRETED ONTO SNOW
2586 
2587  IF (psacws(k).GT.0.) THEN
2588  nmults(k) = 35.e4*psacws(k)*fmult*1000.
2589  qmults(k) = nmults(k)*mmult
2590 
2591 ! CONSTRAIN SO THAT TRANSFER OF MASS FROM SNOW TO ICE CANNOT BE MORE MASS
2592 ! THAN WAS RIMED ONTO SNOW
2593 
2594  qmults(k) = min(qmults(k),psacws(k))
2595  psacws(k) = psacws(k)-qmults(k)
2596 
2597  END IF
2598 
2599 ! RIMING AND SPLINTERING FROM ACCRETED RAINDROPS
2600 
2601  IF (pracs(k).GT.0.) THEN
2602  nmultr(k) = 35.e4*pracs(k)*fmult*1000.
2603  qmultr(k) = nmultr(k)*mmult
2604 
2605 ! CONSTRAIN SO THAT TRANSFER OF MASS FROM SNOW TO ICE CANNOT BE MORE MASS
2606 ! THAN WAS RIMED ONTO SNOW
2607 
2608  qmultr(k) = min(qmultr(k),pracs(k))
2609 
2610  pracs(k) = pracs(k)-qmultr(k)
2611 
2612  END IF
2613 
2614  END IF
2615  END IF
2616  END IF
2617  END IF
2618 
2619 !.......................................................................
2620 ! RIME-SPLINTERING - GRAUPEL
2621 ! HALLET-MOSSOP (1974)
2622 ! NUMBER OF SPLINTERS FORMED IS BASED ON MASS OF RIMED WATER
2623 
2624 ! DUM1 = MASS OF INDIVIDUAL SPLINTERS
2625 
2626 ! HM ADD THRESHOLD SNOW MIXING RATIO FOR RIME-SPLINTERING
2627 ! TO LIMIT RIME-SPLINTERING IN STRATIFORM CLOUDS
2628 
2629 ! IF (IHAIL.EQ.0) THEN
2630 ! v1.4
2631  IF (qg3d(k).GE.0.1e-3) THEN
2632  IF (qc3d(k).GE.0.5e-3.OR.qr3d(k).GE.0.1e-3) THEN
2633  IF (psacwg(k).GT.0..OR.pracg(k).GT.0.) THEN
2634  IF (t3d(k).LT.270.16 .AND. t3d(k).GT.265.16) THEN
2635 
2636  IF (t3d(k).GT.270.16) THEN
2637  fmult = 0.
2638  ELSE IF (t3d(k).LE.270.16.AND.t3d(k).GT.268.16) THEN
2639  fmult = (270.16-t3d(k))/2.
2640  ELSE IF (t3d(k).GE.265.16.AND.t3d(k).LE.268.16) THEN
2641  fmult = (t3d(k)-265.16)/3.
2642  ELSE IF (t3d(k).LT.265.16) THEN
2643  fmult = 0.
2644  END IF
2645 
2646 ! 1000 IS TO CONVERT FROM KG TO G
2647 
2648 ! SPLINTERING FROM DROPLETS ACCRETED ONTO GRAUPEL
2649 
2650  IF (psacwg(k).GT.0.) THEN
2651  nmultg(k) = 35.e4*psacwg(k)*fmult*1000.
2652  qmultg(k) = nmultg(k)*mmult
2653 
2654 ! CONSTRAIN SO THAT TRANSFER OF MASS FROM GRAUPEL TO ICE CANNOT BE MORE MASS
2655 ! THAN WAS RIMED ONTO GRAUPEL
2656 
2657  qmultg(k) = min(qmultg(k),psacwg(k))
2658  psacwg(k) = psacwg(k)-qmultg(k)
2659 
2660  END IF
2661 
2662 ! RIMING AND SPLINTERING FROM ACCRETED RAINDROPS
2663 
2664  IF (pracg(k).GT.0.) THEN
2665  nmultrg(k) = 35.e4*pracg(k)*fmult*1000.
2666  qmultrg(k) = nmultrg(k)*mmult
2667 
2668 ! CONSTRAIN SO THAT TRANSFER OF MASS FROM GRAUPEL TO ICE CANNOT BE MORE MASS
2669 ! THAN WAS RIMED ONTO GRAUPEL
2670 
2671  qmultrg(k) = min(qmultrg(k),pracg(k))
2672  pracg(k) = pracg(k)-qmultrg(k)
2673 
2674  END IF
2675  END IF
2676  END IF
2677  END IF
2678  END IF
2679 ! END IF
2680 
2681 !........................................................................
2682 ! CONVERSION OF RIMED CLOUD WATER ONTO SNOW TO GRAUPEL/HAIL
2683 
2684 ! IF (IHAIL.EQ.0) THEN
2685  IF (psacws(k).GT.0.) THEN
2686 ! ONLY ALLOW CONVERSION IF QNI > 0.1 AND QC > 0.5 G/KG FOLLOWING RUTLEDGE AND HOBBS (1984)
2687  IF (qni3d(k).GE.0.1e-3.AND.qc3d(k).GE.0.5e-3) THEN
2688 
2689 ! PORTION OF RIMING CONVERTED TO GRAUPEL (REISNER ET AL. 1998, ORIGINALLY IS1991)
2690  pgsacw(k) = min(psacws(k),cons17*dt*n0s(k)*qc3d(k)*qc3d(k)* &
2691  asn(k)*asn(k)/ &
2692  (rho(k)*lams(k)**(2.*bs+2.)))
2693 
2694 ! MIX RAT CONVERTED INTO GRAUPEL AS EMBRYO (REISNER ET AL. 1998, ORIG M1990)
2695  dum = max(rhosn/(rhog-rhosn)*pgsacw(k),0.)
2696 
2697 ! NUMBER CONCENTRAITON OF EMBRYO GRAUPEL FROM RIMING OF SNOW
2698  nscng(k) = dum/mg0*rho(k)
2699 ! LIMIT MAX NUMBER CONVERTED TO SNOW NUMBER
2700  nscng(k) = min(nscng(k),ns3d(k)/dt)
2701 
2702 ! PORTION OF RIMING LEFT FOR SNOW
2703  psacws(k) = psacws(k) - pgsacw(k)
2704  END IF
2705  END IF
2706 
2707 ! CONVERSION OF RIMED RAINWATER ONTO SNOW CONVERTED TO GRAUPEL
2708 
2709  IF (pracs(k).GT.0.) THEN
2710 ! ONLY ALLOW CONVERSION IF QNI > 0.1 AND QR > 0.1 G/KG FOLLOWING RUTLEDGE AND HOBBS (1984)
2711  IF (qni3d(k).GE.0.1e-3.AND.qr3d(k).GE.0.1e-3) THEN
2712 ! PORTION OF COLLECTED RAINWATER CONVERTED TO GRAUPEL (REISNER ET AL. 1998)
2713  dum = cons18*(4./lams(k))**3*(4./lams(k))**3 &
2714  /(cons18*(4./lams(k))**3*(4./lams(k))**3+ &
2715  cons19*(4./lamr(k))**3*(4./lamr(k))**3)
2716  dum=min(dum,1.)
2717  dum=max(dum,0.)
2718  pgracs(k) = (1.-dum)*pracs(k)
2719  ngracs(k) = (1.-dum)*npracs(k)
2720 ! LIMIT MAX NUMBER CONVERTED TO MIN OF EITHER RAIN OR SNOW NUMBER CONCENTRATION
2721  ngracs(k) = min(ngracs(k),nr3d(k)/dt)
2722  ngracs(k) = min(ngracs(k),ns3d(k)/dt)
2723 
2724 ! AMOUNT LEFT FOR SNOW PRODUCTION
2725  pracs(k) = pracs(k) - pgracs(k)
2726  npracs(k) = npracs(k) - ngracs(k)
2727 ! CONVERSION TO GRAUPEL DUE TO COLLECTION OF SNOW BY RAIN
2728  psacr(k)=psacr(k)*(1.-dum)
2729  END IF
2730  END IF
2731 ! END IF
2732 
2733 !.......................................................................
2734 ! FREEZING OF RAIN DROPS
2735 ! FREEZING ALLOWED BELOW -4 C
2736 
2737  IF (t3d(k).LT.269.15.AND.qr3d(k).GE.qsmall) THEN
2738 
2739 ! IMMERSION FREEZING (BIGG 1953)
2740 ! MNUCCR(K) = CONS20*NR3D(K)*EXP(AIMM*(273.15-T3D(K)))/LAMR(K)**3 &
2741 ! /LAMR(K)**3
2742 
2743 ! NNUCCR(K) = PI*NR3D(K)*BIMM*EXP(AIMM*(273.15-T3D(K)))/LAMR(K)**3
2744 
2745 ! hm fix 7/15/13 for consistency w/ original formula
2746  mnuccr(k) = cons20*nr3d(k)*(exp(aimm*(273.15-t3d(k)))-1.)/lamr(k)**3 &
2747  /lamr(k)**3
2748 
2749  nnuccr(k) = pi*nr3d(k)*bimm*(exp(aimm*(273.15-t3d(k)))-1.)/lamr(k)**3
2750 
2751 ! PREVENT DIVERGENCE BETWEEN MIXING RATIO AND NUMBER CONC
2752  nnuccr(k) = min(nnuccr(k),nr3d(k)/dt)
2753 
2754  END IF
2755 
2756 !.......................................................................
2757 ! ACCRETION OF CLOUD LIQUID WATER BY RAIN
2758 ! CONTINUOUS COLLECTION EQUATION WITH
2759 ! GRAVITATIONAL COLLECTION KERNEL, DROPLET FALL SPEED NEGLECTED
2760 
2761  IF (qr3d(k).GE.1.e-8 .AND. qc3d(k).GE.1.e-8) THEN
2762 
2763 ! 12/13/06 HM ADD, REPLACE WITH NEWER FORMULA FROM
2764 ! KHAIROUTDINOV AND KOGAN 2000, MWR
2765 
2766  dum=(qc3d(k)*qr3d(k))
2767  pra(k) = 67.*(dum)**1.15
2768  npra(k) = pra(k)/(qc3d(k)/nc3d(k))
2769 
2770  END IF
2771 !.......................................................................
2772 ! SELF-COLLECTION OF RAIN DROPS
2773 ! FROM BEHENG(1994)
2774 ! FROM NUMERICAL SIMULATION OF THE STOCHASTIC COLLECTION EQUATION
2775 ! AS DESCRINED ABOVE FOR AUTOCONVERSION
2776 
2777  IF (qr3d(k).GE.1.e-8) THEN
2778 ! include breakup add 10/09/09
2779  dum1=300.e-6
2780  if (1./lamr(k).lt.dum1) then
2781  dum=1.
2782  else if (1./lamr(k).ge.dum1) then
2783  dum=2.-exp(2300.*(1./lamr(k)-dum1))
2784  end if
2785 ! NRAGG(K) = -8.*NR3D(K)*QR3D(K)*RHO(K)
2786  nragg(k) = -5.78*dum*nr3d(k)*qr3d(k)*rho(k)
2787  END IF
2788 
2789 !.......................................................................
2790 ! AUTOCONVERSION OF CLOUD ICE TO SNOW
2791 ! FOLLOWING HARRINGTON ET AL. (1995) WITH MODIFICATION
2792 ! HERE IT IS ASSUMED THAT AUTOCONVERSION CAN ONLY OCCUR WHEN THE
2793 ! ICE IS GROWING, I.E. IN CONDITIONS OF ICE SUPERSATURATION
2794 
2795  IF (qi3d(k).GE.1.e-8 .AND.qvqvsi(k).GE.1.) THEN
2796 
2797 ! COFFI = 2./LAMI(K)
2798 ! IF (COFFI.GE.DCS) THEN
2799  nprci(k) = cons21*(qv3d(k)-qvi(k))*rho(k) &
2800  *n0i(k)*exp(-lami(k)*dcs)*dv(k)/abi(k)
2801  prci(k) = cons22*nprci(k)
2802  nprci(k) = min(nprci(k),ni3d(k)/dt)
2803 
2804 ! END IF
2805  END IF
2806 
2807 !.......................................................................
2808 ! ACCRETION OF CLOUD ICE BY SNOW
2809 ! FOR THIS CALCULATION, IT IS ASSUMED THAT THE VS >> VI
2810 ! AND DS >> DI FOR CONTINUOUS COLLECTION
2811 
2812  IF (qni3d(k).GE.1.e-8 .AND. qi3d(k).GE.qsmall) THEN
2813  prai(k) = cons23*asn(k)*qi3d(k)*rho(k)*n0s(k)/ &
2814  lams(k)**(bs+3.)
2815  nprai(k) = cons23*asn(k)*ni3d(k)* &
2816  rho(k)*n0s(k)/ &
2817  lams(k)**(bs+3.)
2818  nprai(k)=min(nprai(k),ni3d(k)/dt)
2819  END IF
2820 
2821 !.......................................................................
2822 ! HM, ADD 12/13/06, COLLISION OF RAIN AND ICE TO PRODUCE SNOW OR GRAUPEL
2823 ! FOLLOWS REISNER ET AL. 1998
2824 ! ASSUMED FALLSPEED AND SIZE OF ICE CRYSTAL << THAN FOR RAIN
2825 
2826  IF (qr3d(k).GE.1.e-8.AND.qi3d(k).GE.1.e-8.AND.t3d(k).LE.273.15) THEN
2827 
2828 ! ALLOW GRAUPEL FORMATION FROM RAIN-ICE COLLISIONS ONLY IF RAIN MIXING RATIO > 0.1 G/KG,
2829 ! OTHERWISE ADD TO SNOW
2830 
2831  IF (qr3d(k).GE.0.1e-3) THEN
2832  niacr(k)=cons24*ni3d(k)*n0rr(k)*arn(k) &
2833  /lamr(k)**(br+3.)*rho(k)
2834  piacr(k)=cons25*ni3d(k)*n0rr(k)*arn(k) &
2835  /lamr(k)**(br+3.)/lamr(k)**3*rho(k)
2836  praci(k)=cons24*qi3d(k)*n0rr(k)*arn(k)/ &
2837  lamr(k)**(br+3.)*rho(k)
2838  niacr(k)=min(niacr(k),nr3d(k)/dt)
2839  niacr(k)=min(niacr(k),ni3d(k)/dt)
2840  ELSE
2841  niacrs(k)=cons24*ni3d(k)*n0rr(k)*arn(k) &
2842  /lamr(k)**(br+3.)*rho(k)
2843  piacrs(k)=cons25*ni3d(k)*n0rr(k)*arn(k) &
2844  /lamr(k)**(br+3.)/lamr(k)**3*rho(k)
2845  pracis(k)=cons24*qi3d(k)*n0rr(k)*arn(k)/ &
2846  lamr(k)**(br+3.)*rho(k)
2847  niacrs(k)=min(niacrs(k),nr3d(k)/dt)
2848  niacrs(k)=min(niacrs(k),ni3d(k)/dt)
2849  END IF
2850  END IF
2851 
2852 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
2853 ! NUCLEATION OF CLOUD ICE FROM HOMOGENEOUS AND HETEROGENEOUS FREEZING ON AEROSOL
2854 
2855  IF (inuc.EQ.0) THEN
2856 
2857 ! add threshold according to Greg Thomspon
2858 
2859  if ((qvqvs(k).GE.0.999.and.t3d(k).le.265.15).or. &
2860  qvqvsi(k).ge.1.08) then
2861 
2862 ! hm, modify dec. 5, 2006, replace with cooper curve
2863  kc2 = 0.005*exp(0.304*(273.15-t3d(k)))*1000. ! convert from L-1 to m-3
2864 ! limit to 500 L-1
2865  kc2 = min(kc2,500.e3)
2866  kc2=max(kc2/rho(k),0.) ! convert to kg-1
2867 
2868  IF (kc2.GT.ni3d(k)+ns3d(k)+ng3d(k)) THEN
2869  nnuccd(k) = (kc2-ni3d(k)-ns3d(k)-ng3d(k))/dt
2870  mnuccd(k) = nnuccd(k)*mi0
2871  END IF
2872 
2873  END IF
2874 
2875  ELSE IF (inuc.EQ.1) THEN
2876 
2877  IF (t3d(k).LT.273.15.AND.qvqvsi(k).GT.1.) THEN
2878 
2879  kc2 = 0.16*1000./rho(k) ! CONVERT FROM L-1 TO KG-1
2880  IF (kc2.GT.ni3d(k)+ns3d(k)+ng3d(k)) THEN
2881  nnuccd(k) = (kc2-ni3d(k)-ns3d(k)-ng3d(k))/dt
2882  mnuccd(k) = nnuccd(k)*mi0
2883  END IF
2884  END IF
2885 
2886  END IF
2887 
2888 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
2889 
2890  101 CONTINUE
2891 
2892 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
2893 ! CALCULATE EVAP/SUB/DEP TERMS FOR QI,QNI,QR
2894 
2895 ! NO VENTILATION FOR CLOUD ICE
2896 
2897  IF (qi3d(k).GE.qsmall) THEN
2898 
2899  epsi = 2.*pi*n0i(k)*rho(k)*dv(k)/(lami(k)*lami(k))
2900 
2901  ELSE
2902  epsi = 0.
2903  END IF
2904 
2905  IF (qni3d(k).GE.qsmall) THEN
2906  epss = 2.*pi*n0s(k)*rho(k)*dv(k)* &
2907  (f1s/(lams(k)*lams(k))+ &
2908  f2s*(asn(k)*rho(k)/mu(k))**0.5* &
2909  sc(k)**(1./3.)*cons10/ &
2910  (lams(k)**cons35))
2911  ELSE
2912  epss = 0.
2913  END IF
2914 
2915  IF (qg3d(k).GE.qsmall) THEN
2916  epsg = 2.*pi*n0g(k)*rho(k)*dv(k)* &
2917  (f1s/(lamg(k)*lamg(k))+ &
2918  f2s*(agn(k)*rho(k)/mu(k))**0.5* &
2919  sc(k)**(1./3.)*cons11/ &
2920  (lamg(k)**cons36))
2921 
2922 
2923  ELSE
2924  epsg = 0.
2925  END IF
2926 
2927  IF (qr3d(k).GE.qsmall) THEN
2928  epsr = 2.*pi*n0rr(k)*rho(k)*dv(k)* &
2929  (f1r/(lamr(k)*lamr(k))+ &
2930  f2r*(arn(k)*rho(k)/mu(k))**0.5* &
2931  sc(k)**(1./3.)*cons9/ &
2932  (lamr(k)**cons34))
2933  ELSE
2934  epsr = 0.
2935  END IF
2936 
2937 ! ONLY INCLUDE REGION OF ICE SIZE DIST < DCS
2938 ! DUM IS FRACTION OF D*N(D) < DCS
2939 
2940 ! LOGIC BELOW FOLLOWS THAT OF HARRINGTON ET AL. 1995 (JAS)
2941  IF (qi3d(k).GE.qsmall) THEN
2942  dum=(1.-exp(-lami(k)*dcs)*(1.+lami(k)*dcs))
2943  prd(k) = epsi*(qv3d(k)-qvi(k))/abi(k)*dum
2944  ELSE
2945  dum=0.
2946  END IF
2947 ! ADD DEPOSITION IN TAIL OF ICE SIZE DIST TO SNOW IF SNOW IS PRESENT
2948  IF (qni3d(k).GE.qsmall) THEN
2949  prds(k) = epss*(qv3d(k)-qvi(k))/abi(k)+ &
2950  epsi*(qv3d(k)-qvi(k))/abi(k)*(1.-dum)
2951 ! OTHERWISE ADD TO CLOUD ICE
2952  ELSE
2953  prd(k) = prd(k)+epsi*(qv3d(k)-qvi(k))/abi(k)*(1.-dum)
2954  END IF
2955 ! VAPOR DPEOSITION ON GRAUPEL
2956  prdg(k) = epsg*(qv3d(k)-qvi(k))/abi(k)
2957 
2958 ! NO CONDENSATION ONTO RAIN, ONLY EVAP
2959 
2960  IF (qv3d(k).LT.qvs(k)) THEN
2961  pre(k) = epsr*(qv3d(k)-qvs(k))/ab(k)
2962  pre(k) = min(pre(k),0.)
2963  ELSE
2964  pre(k) = 0.
2965  END IF
2966 
2967 ! MAKE SURE NOT PUSHED INTO ICE SUPERSAT/SUBSAT
2968 ! FORMULA FROM REISNER 2 SCHEME
2969 
2970  dum = (qv3d(k)-qvi(k))/dt
2971 
2972  fudgef = 0.9999
2973  sum_dep = prd(k)+prds(k)+mnuccd(k)+prdg(k)
2974 
2975  IF( (dum.GT.0. .AND. sum_dep.GT.dum*fudgef) .OR. &
2976  (dum.LT.0. .AND. sum_dep.LT.dum*fudgef) ) THEN
2977  mnuccd(k) = fudgef*mnuccd(k)*dum/sum_dep
2978  prd(k) = fudgef*prd(k)*dum/sum_dep
2979  prds(k) = fudgef*prds(k)*dum/sum_dep
2980  prdg(k) = fudgef*prdg(k)*dum/sum_dep
2981  ENDIF
2982 
2983 ! IF CLOUD ICE/SNOW/GRAUPEL VAP DEPOSITION IS NEG, THEN ASSIGN TO SUBLIMATION PROCESSES
2984 
2985  IF (prd(k).LT.0.) THEN
2986  eprd(k)=prd(k)
2987  prd(k)=0.
2988  END IF
2989  IF (prds(k).LT.0.) THEN
2990  eprds(k)=prds(k)
2991  prds(k)=0.
2992  END IF
2993  IF (prdg(k).LT.0.) THEN
2994  eprdg(k)=prdg(k)
2995  prdg(k)=0.
2996  END IF
2997 !.......................................................................
2998 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
2999 
3000 ! CONSERVATION OF WATER
3001 ! THIS IS ADOPTED LOOSELY FROM RESINER CODE. HOWEVER, HERE WE
3002 ! ONLY ADJUST PROCESSES THAT ARE NEGATIVE, RATHER THAN ALL PROCESSES.
3003 
3004 ! IF MIXING RATIOS LESS THAN QSMALL, THEN NO DEPLETION OF WATER
3005 ! THROUGH MICROPHYSICAL PROCESSES, SKIP CONSERVATION
3006 
3007 ! NOTE: CONSERVATION CHECK NOT APPLIED TO NUMBER CONCENTRATION SPECIES. ADDITIONAL CATCH
3008 ! BELOW WILL PREVENT NEGATIVE NUMBER CONCENTRATION
3009 ! FOR EACH MICROPHYSICAL PROCESS WHICH PROVIDES A SOURCE FOR NUMBER, THERE IS A CHECK
3010 ! TO MAKE SURE THAT CAN'T EXCEED TOTAL NUMBER OF DEPLETED SPECIES WITH THE TIME
3011 ! STEP
3012 
3013 !****SENSITIVITY - NO ICE
3014 
3015  IF (iliq.EQ.1) THEN
3016  mnuccc(k)=0.
3017  nnuccc(k)=0.
3018  mnuccr(k)=0.
3019  nnuccr(k)=0.
3020  mnuccd(k)=0.
3021  nnuccd(k)=0.
3022  END IF
3023 
3024 ! ****SENSITIVITY - NO GRAUPEL
3025  IF (igraup.EQ.1) THEN
3026  pracg(k) = 0.
3027  psacr(k) = 0.
3028  psacwg(k) = 0.
3029  prdg(k) = 0.
3030  eprdg(k) = 0.
3031  evpmg(k) = 0.
3032  pgmlt(k) = 0.
3033  npracg(k) = 0.
3034  npsacwg(k) = 0.
3035  nscng(k) = 0.
3036  ngracs(k) = 0.
3037  nsubg(k) = 0.
3038  ngmltg(k) = 0.
3039  ngmltr(k) = 0.
3040 ! fix 053011
3041  piacrs(k)=piacrs(k)+piacr(k)
3042  piacr(k) = 0.
3043 ! fix 070713
3044  pracis(k)=pracis(k)+praci(k)
3045  praci(k) = 0.
3046  psacws(k)=psacws(k)+pgsacw(k)
3047  pgsacw(k) = 0.
3048  pracs(k)=pracs(k)+pgracs(k)
3049  pgracs(k) = 0.
3050  END IF
3051 
3052 ! CONSERVATION OF QC
3053 
3054  dum = (prc(k)+pra(k)+mnuccc(k)+psacws(k)+psacwi(k)+qmults(k)+psacwg(k)+pgsacw(k)+qmultg(k))*dt
3055 
3056  IF (dum.GT.qc3d(k).AND.qc3d(k).GE.qsmall) THEN
3057  ratio = qc3d(k)/dum
3058 
3059  prc(k) = prc(k)*ratio
3060  pra(k) = pra(k)*ratio
3061  mnuccc(k) = mnuccc(k)*ratio
3062  psacws(k) = psacws(k)*ratio
3063  psacwi(k) = psacwi(k)*ratio
3064  qmults(k) = qmults(k)*ratio
3065  qmultg(k) = qmultg(k)*ratio
3066  psacwg(k) = psacwg(k)*ratio
3067  pgsacw(k) = pgsacw(k)*ratio
3068  END IF
3069 
3070 ! CONSERVATION OF QI
3071 
3072  dum = (-prd(k)-mnuccc(k)+prci(k)+prai(k)-qmults(k)-qmultg(k)-qmultr(k)-qmultrg(k) &
3073  -mnuccd(k)+praci(k)+pracis(k)-eprd(k)-psacwi(k))*dt
3074 
3075  IF (dum.GT.qi3d(k).AND.qi3d(k).GE.qsmall) THEN
3076 
3077  ratio = (qi3d(k)/dt+prd(k)+mnuccc(k)+qmults(k)+qmultg(k)+qmultr(k)+qmultrg(k)+ &
3078  mnuccd(k)+psacwi(k))/ &
3079  (prci(k)+prai(k)+praci(k)+pracis(k)-eprd(k))
3080 
3081  prci(k) = prci(k)*ratio
3082  prai(k) = prai(k)*ratio
3083  praci(k) = praci(k)*ratio
3084  pracis(k) = pracis(k)*ratio
3085  eprd(k) = eprd(k)*ratio
3086 
3087  END IF
3088 
3089 ! CONSERVATION OF QR
3090 
3091  dum=((pracs(k)-pre(k))+(qmultr(k)+qmultrg(k)-prc(k))+(mnuccr(k)-pra(k))+ &
3092  piacr(k)+piacrs(k)+pgracs(k)+pracg(k))*dt
3093 
3094  IF (dum.GT.qr3d(k).AND.qr3d(k).GE.qsmall) THEN
3095 
3096  ratio = (qr3d(k)/dt+prc(k)+pra(k))/ &
3097  (-pre(k)+qmultr(k)+qmultrg(k)+pracs(k)+mnuccr(k)+piacr(k)+piacrs(k)+pgracs(k)+pracg(k))
3098 
3099  pre(k) = pre(k)*ratio
3100  pracs(k) = pracs(k)*ratio
3101  qmultr(k) = qmultr(k)*ratio
3102  qmultrg(k) = qmultrg(k)*ratio
3103  mnuccr(k) = mnuccr(k)*ratio
3104  piacr(k) = piacr(k)*ratio
3105  piacrs(k) = piacrs(k)*ratio
3106  pgracs(k) = pgracs(k)*ratio
3107  pracg(k) = pracg(k)*ratio
3108 
3109  END IF
3110 
3111 ! CONSERVATION OF QNI
3112 ! CONSERVATION FOR GRAUPEL SCHEME
3113 
3114  IF (igraup.EQ.0) THEN
3115 
3116  dum = (-prds(k)-psacws(k)-prai(k)-prci(k)-pracs(k)-eprds(k)+psacr(k)-piacrs(k)-pracis(k))*dt
3117 
3118  IF (dum.GT.qni3d(k).AND.qni3d(k).GE.qsmall) THEN
3119 
3120  ratio = (qni3d(k)/dt+prds(k)+psacws(k)+prai(k)+prci(k)+pracs(k)+piacrs(k)+pracis(k))/(-eprds(k)+psacr(k))
3121 
3122  eprds(k) = eprds(k)*ratio
3123  psacr(k) = psacr(k)*ratio
3124 
3125  END IF
3126 
3127 ! FOR NO GRAUPEL, NEED TO INCLUDE FREEZING OF RAIN FOR SNOW
3128  ELSE IF (igraup.EQ.1) THEN
3129 
3130  dum = (-prds(k)-psacws(k)-prai(k)-prci(k)-pracs(k)-eprds(k)+psacr(k)-piacrs(k)-pracis(k)-mnuccr(k))*dt
3131 
3132  IF (dum.GT.qni3d(k).AND.qni3d(k).GE.qsmall) THEN
3133 
3134  ratio = (qni3d(k)/dt+prds(k)+psacws(k)+prai(k)+prci(k)+pracs(k)+piacrs(k)+pracis(k)+mnuccr(k))/(-eprds(k)+psacr(k))
3135 
3136  eprds(k) = eprds(k)*ratio
3137  psacr(k) = psacr(k)*ratio
3138 
3139  END IF
3140 
3141  END IF
3142 
3143 ! CONSERVATION OF QG
3144 
3145  dum = (-psacwg(k)-pracg(k)-pgsacw(k)-pgracs(k)-prdg(k)-mnuccr(k)-eprdg(k)-piacr(k)-praci(k)-psacr(k))*dt
3146 
3147  IF (dum.GT.qg3d(k).AND.qg3d(k).GE.qsmall) THEN
3148 
3149  ratio = (qg3d(k)/dt+psacwg(k)+pracg(k)+pgsacw(k)+pgracs(k)+prdg(k)+mnuccr(k)+psacr(k)+&
3150  piacr(k)+praci(k))/(-eprdg(k))
3151 
3152  eprdg(k) = eprdg(k)*ratio
3153 
3154  END IF
3155 
3156 ! TENDENCIES
3157 
3158  qv3dten(k) = qv3dten(k)+(-pre(k)-prd(k)-prds(k)-mnuccd(k)-eprd(k)-eprds(k)-prdg(k)-eprdg(k))
3159 
3160 ! BUG FIX HM, 3/1/11, INCLUDE PIACR AND PIACRS
3161  t3dten(k) = t3dten(k)+(pre(k) &
3162  *xxlv(k)+(prd(k)+prds(k)+ &
3163  mnuccd(k)+eprd(k)+eprds(k)+prdg(k)+eprdg(k))*xxls(k)+ &
3164  (psacws(k)+psacwi(k)+mnuccc(k)+mnuccr(k)+ &
3165  qmults(k)+qmultg(k)+qmultr(k)+qmultrg(k)+pracs(k) &
3166  +psacwg(k)+pracg(k)+pgsacw(k)+pgracs(k)+piacr(k)+piacrs(k))*xlf(k))/cpm(k)
3167 
3168  qc3dten(k) = qc3dten(k)+ &
3169  (-pra(k)-prc(k)-mnuccc(k)+pcc(k)- &
3170  psacws(k)-psacwi(k)-qmults(k)-qmultg(k)-psacwg(k)-pgsacw(k))
3171  qi3dten(k) = qi3dten(k)+ &
3172  (prd(k)+eprd(k)+psacwi(k)+mnuccc(k)-prci(k)- &
3173  prai(k)+qmults(k)+qmultg(k)+qmultr(k)+qmultrg(k)+mnuccd(k)-praci(k)-pracis(k))
3174  qr3dten(k) = qr3dten(k)+ &
3175  (pre(k)+pra(k)+prc(k)-pracs(k)-mnuccr(k)-qmultr(k)-qmultrg(k) &
3176  -piacr(k)-piacrs(k)-pracg(k)-pgracs(k))
3177  IF (igraup.EQ.0) THEN
3178 
3179  qni3dten(k) = qni3dten(k)+ &
3180  (prai(k)+psacws(k)+prds(k)+pracs(k)+prci(k)+eprds(k)-psacr(k)+piacrs(k)+pracis(k))
3181  ns3dten(k) = ns3dten(k)+(nsagg(k)+nprci(k)-nscng(k)-ngracs(k)+niacrs(k))
3182  qg3dten(k) = qg3dten(k)+(pracg(k)+psacwg(k)+pgsacw(k)+pgracs(k)+ &
3183  prdg(k)+eprdg(k)+mnuccr(k)+piacr(k)+praci(k)+psacr(k))
3184  ng3dten(k) = ng3dten(k)+(nscng(k)+ngracs(k)+nnuccr(k)+niacr(k))
3185 
3186 ! FOR NO GRAUPEL, NEED TO INCLUDE FREEZING OF RAIN FOR SNOW
3187  ELSE IF (igraup.EQ.1) THEN
3188 
3189  qni3dten(k) = qni3dten(k)+ &
3190  (prai(k)+psacws(k)+prds(k)+pracs(k)+prci(k)+eprds(k)-psacr(k)+piacrs(k)+pracis(k)+mnuccr(k))
3191  ns3dten(k) = ns3dten(k)+(nsagg(k)+nprci(k)-nscng(k)-ngracs(k)+niacrs(k)+nnuccr(k))
3192 
3193  END IF
3194 
3195  nc3dten(k) = nc3dten(k)+(-nnuccc(k)-npsacws(k) &
3196  -npra(k)-nprc(k)-npsacwi(k)-npsacwg(k))
3197 
3198  ni3dten(k) = ni3dten(k)+ &
3199  (nnuccc(k)-nprci(k)-nprai(k)+nmults(k)+nmultg(k)+nmultr(k)+nmultrg(k)+ &
3200  nnuccd(k)-niacr(k)-niacrs(k))
3201 
3202  nr3dten(k) = nr3dten(k)+(nprc1(k)-npracs(k)-nnuccr(k) &
3203  +nragg(k)-niacr(k)-niacrs(k)-npracg(k)-ngracs(k))
3204 
3205 ! HM ADD, WRF-CHEM, ADD TENDENCIES FOR C2PREC
3206 
3207  c2prec(k) = pra(k)+prc(k)+psacws(k)+qmults(k)+qmultg(k)+psacwg(k)+ &
3208  pgsacw(k)+mnuccc(k)+psacwi(k)
3209 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3210 ! NOW CALCULATE SATURATION ADJUSTMENT TO CONDENSE EXTRA VAPOR ABOVE
3211 ! WATER SATURATION
3212 
3213  dumt = t3d(k)+dt*t3dten(k)
3214  dumqv = qv3d(k) + dt * qv3dten(k)
3215 
3216  ! hm, add fix for low pressure, 5/12/10
3217  dum=min(0.99*pres(k),polysvp(dumt,0))
3218  dumqss = ep_2*dum/(pres(k)-dum)
3219 
3220  dumqc = qc3d(k) + dt * qc3dten(k)
3221 
3222  dumqc = max(dumqc,0.)
3223 
3224 ! SATURATION ADJUSTMENT FOR LIQUID
3225 
3226  dums = dumqv-dumqss
3227 
3228  pcc(k) = dums/(1.+xxlv(k)**2*dumqss/(cpm(k)*rv*dumt**2))/dt
3229 
3230  IF (pcc(k)*dt+dumqc.LT.0.) THEN
3231  pcc(k) = -dumqc/dt
3232  END IF
3233 
3234  qv3dten(k) = qv3dten(k)-pcc(k)
3235  t3dten(k) = t3dten(k)+pcc(k)*xxlv(k)/cpm(k)
3236  qc3dten(k) = qc3dten(k)+pcc(k)
3237 ! Fortran version
3238 !.......................................................................
3239 ! ACTIVATION OF CLOUD DROPLETS
3240 ! ACTIVATION OF DROPLET CURRENTLY NOT CALCULATED
3241 ! DROPLET CONCENTRATION IS SPECIFIED !!!!!
3242 
3243 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3244 ! SUBLIMATE, MELT, OR EVAPORATE NUMBER CONCENTRATION
3245 ! THIS FORMULATION ASSUMES 1:1 RATIO BETWEEN MASS LOSS AND
3246 ! LOSS OF NUMBER CONCENTRATION
3247 
3248 ! IF (PCC(K).LT.0.) THEN
3249 ! DUM = PCC(K)*DT/QC3D(K)
3250 ! DUM = MAX(-1.,DUM)
3251 ! NSUBC(K) = DUM*NC3D(K)/DT
3252 ! END IF
3253 
3254  IF (eprd(k).LT.0.) THEN
3255  dum = eprd(k)*dt/qi3d(k)
3256  dum = max(-1.,dum)
3257  nsubi(k) = dum*ni3d(k)/dt
3258  END IF
3259  IF (eprds(k).LT.0.) THEN
3260  dum = eprds(k)*dt/qni3d(k)
3261  dum = max(-1.,dum)
3262  nsubs(k) = dum*ns3d(k)/dt
3263  END IF
3264  IF (pre(k).LT.0.) THEN
3265  dum = pre(k)*dt/qr3d(k)
3266  dum = max(-1.,dum)
3267  nsubr(k) = dum*nr3d(k)/dt
3268  END IF
3269  IF (eprdg(k).LT.0.) THEN
3270  dum = eprdg(k)*dt/qg3d(k)
3271  dum = max(-1.,dum)
3272  nsubg(k) = dum*ng3d(k)/dt
3273  END IF
3274 
3275 ! nsubr(k)=0.
3276 ! nsubs(k)=0.
3277 ! nsubg(k)=0.
3278 
3279 ! UPDATE TENDENCIES
3280 
3281 ! NC3DTEN(K) = NC3DTEN(K)+NSUBC(K)
3282  ni3dten(k) = ni3dten(k)+nsubi(k)
3283  ns3dten(k) = ns3dten(k)+nsubs(k)
3284  ng3dten(k) = ng3dten(k)+nsubg(k)
3285  nr3dten(k) = nr3dten(k)+nsubr(k)
3286 
3287  END IF !!!!!! TEMPERATURE
3288 
3289 ! SWITCH LTRUE TO 1, SINCE HYDROMETEORS ARE PRESENT
3290  ltrue = 1
3291 
3292  200 CONTINUE
3293 
3294  END DO
3295 
3296 ! INITIALIZE PRECIP AND SNOW RATES
3297  precrt = 0.
3298  snowrt = 0.
3299 ! hm added 7/13/13
3300  snowprt = 0.
3301  grplprt = 0.
3302 
3303 ! IF THERE ARE NO HYDROMETEORS, THEN SKIP TO END OF SUBROUTINE
3304  DO k = kts,kte
3305 ! Fortran version
3306  END DO
3307  IF (ltrue.EQ.0) GOTO 400
3308 
3309 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3310 !.......................................................................
3311 ! CALCULATE SEDIMENATION
3312 ! THE NUMERICS HERE FOLLOW FROM REISNER ET AL. (1998)
3313 ! FALLOUT TERMS ARE CALCULATED ON SPLIT TIME STEPS TO ENSURE NUMERICAL
3314 ! STABILITY, I.E. COURANT# < 1
3315 
3316 !.......................................................................
3317 
3318  nstep = 1
3319 
3320  DO k = kte,kts,-1
3321 
3322  dumi(k) = qi3d(k)+qi3dten(k)*dt
3323  dumqs(k) = qni3d(k)+qni3dten(k)*dt
3324  dumr(k) = qr3d(k)+qr3dten(k)*dt
3325  dumfni(k) = ni3d(k)+ni3dten(k)*dt
3326  dumfns(k) = ns3d(k)+ns3dten(k)*dt
3327  dumfnr(k) = nr3d(k)+nr3dten(k)*dt
3328  dumc(k) = qc3d(k)+qc3dten(k)*dt
3329  dumfnc(k) = nc3d(k)+nc3dten(k)*dt
3330  dumg(k) = qg3d(k)+qg3dten(k)*dt
3331  dumfng(k) = ng3d(k)+ng3dten(k)*dt
3332 
3333 ! SWITCH FOR CONSTANT DROPLET NUMBER
3334  IF (iinum.EQ.1) THEN
3335  dumfnc(k) = nc3d(k)
3336  END IF
3337 
3338 ! GET DUMMY LAMDA FOR SEDIMENTATION CALCULATIONS
3339 
3340 ! MAKE SURE NUMBER CONCENTRATIONS ARE POSITIVE
3341  dumfni(k) = max(0.,dumfni(k))
3342  dumfns(k) = max(0.,dumfns(k))
3343  dumfnc(k) = max(0.,dumfnc(k))
3344  dumfnr(k) = max(0.,dumfnr(k))
3345  dumfng(k) = max(0.,dumfng(k))
3346 
3347 !......................................................................
3348 ! CLOUD ICE
3349 
3350  IF (dumi(k).GE.qsmall) THEN
3351  dlami = (cons12*dumfni(k)/dumi(k))**(1./di)
3352  dlami=max(dlami,lammini)
3353  dlami=min(dlami,lammaxi)
3354  END IF
3355 !......................................................................
3356 ! RAIN
3357 
3358  IF (dumr(k).GE.qsmall) THEN
3359  dlamr = (pi*rhow*dumfnr(k)/dumr(k))**(1./3.)
3360  dlamr=max(dlamr,lamminr)
3361  dlamr=min(dlamr,lammaxr)
3362  END IF
3363 !......................................................................
3364 ! CLOUD DROPLETS
3365 
3366  IF (dumc(k).GE.qsmall) THEN
3367  dum = pres(k)/(287.15*t3d(k))
3368  pgam(k)=0.0005714*(nc3d(k)/1.e6*dum)+0.2714
3369  pgam(k)=1./(pgam(k)**2)-1.
3370  pgam(k)=max(pgam(k),2.)
3371  pgam(k)=min(pgam(k),10.)
3372 
3373  dlamc = (cons26*dumfnc(k)*gamma(pgam(k)+4.)/(dumc(k)*gamma(pgam(k)+1.)))**(1./3.)
3374  lammin = (pgam(k)+1.)/60.e-6
3375  lammax = (pgam(k)+1.)/1.e-6
3376  dlamc=max(dlamc,lammin)
3377  dlamc=min(dlamc,lammax)
3378  END IF
3379 !......................................................................
3380 ! SNOW
3381 
3382  IF (dumqs(k).GE.qsmall) THEN
3383  dlams = (cons1*dumfns(k)/ dumqs(k))**(1./ds)
3384  dlams=max(dlams,lammins)
3385  dlams=min(dlams,lammaxs)
3386  END IF
3387 !......................................................................
3388 ! GRAUPEL
3389 
3390  IF (dumg(k).GE.qsmall) THEN
3391  dlamg = (cons2*dumfng(k)/ dumg(k))**(1./dg)
3392  dlamg=max(dlamg,lamming)
3393  dlamg=min(dlamg,lammaxg)
3394  END IF
3395 !......................................................................
3396 ! CALCULATE NUMBER-WEIGHTED AND MASS-WEIGHTED TERMINAL FALL SPEEDS
3397 
3398 ! CLOUD WATER
3399 
3400  IF (dumc(k).GE.qsmall) THEN
3401  unc = acn(k)*gamma(1.+bc+pgam(k))/ (dlamc**bc*gamma(pgam(k)+1.))
3402  umc = acn(k)*gamma(4.+bc+pgam(k))/ (dlamc**bc*gamma(pgam(k)+4.))
3403  ELSE
3404  umc = 0.
3405  unc = 0.
3406  END IF
3407 
3408  IF (dumi(k).GE.qsmall) THEN
3409  uni = ain(k)*cons27/dlami**bi
3410  umi = ain(k)*cons28/(dlami**bi)
3411  ELSE
3412  umi = 0.
3413  uni = 0.
3414  END IF
3415 
3416  IF (dumr(k).GE.qsmall) THEN
3417  unr = arn(k)*cons6/dlamr**br
3418  umr = arn(k)*cons4/(dlamr**br)
3419  ELSE
3420  umr = 0.
3421  unr = 0.
3422  END IF
3423 
3424  IF (dumqs(k).GE.qsmall) THEN
3425  ums = asn(k)*cons3/(dlams**bs)
3426  uns = asn(k)*cons5/dlams**bs
3427  ELSE
3428  ums = 0.
3429  uns = 0.
3430  END IF
3431 
3432  IF (dumg(k).GE.qsmall) THEN
3433  umg = agn(k)*cons7/(dlamg**bg)
3434  ung = agn(k)*cons8/dlamg**bg
3435  ELSE
3436  umg = 0.
3437  ung = 0.
3438  END IF
3439 
3440 ! SET REALISTIC LIMITS ON FALLSPEED
3441 
3442 ! bug fix, 10/08/09
3443  dum=(rhosu/rho(k))**0.54
3444  ums=min(ums,1.2*dum)
3445  uns=min(uns,1.2*dum)
3446 ! fix 053011
3447 ! fix for correction by AA 4/6/11
3448  umi=min(umi,1.2*(rhosu/rho(k))**0.35)
3449  uni=min(uni,1.2*(rhosu/rho(k))**0.35)
3450  umr=min(umr,9.1*dum)
3451  unr=min(unr,9.1*dum)
3452  umg=min(umg,20.*dum)
3453  ung=min(ung,20.*dum)
3454 
3455  fr(k) = umr
3456  fi(k) = umi
3457  fni(k) = uni
3458  fs(k) = ums
3459  fns(k) = uns
3460  fnr(k) = unr
3461  fc(k) = umc
3462  fnc(k) = unc
3463  fg(k) = umg
3464  fng(k) = ung
3465 
3466 ! V3.3 MODIFY FALLSPEED BELOW LEVEL OF PRECIP
3467 
3468  IF (k.LE.kte-1) THEN
3469  IF (fr(k).LT.1.e-10) THEN
3470  fr(k)=fr(k+1)
3471  END IF
3472  IF (fi(k).LT.1.e-10) THEN
3473  fi(k)=fi(k+1)
3474  END IF
3475  IF (fni(k).LT.1.e-10) THEN
3476  fni(k)=fni(k+1)
3477  END IF
3478  IF (fs(k).LT.1.e-10) THEN
3479  fs(k)=fs(k+1)
3480  END IF
3481  IF (fns(k).LT.1.e-10) THEN
3482  fns(k)=fns(k+1)
3483  END IF
3484  IF (fnr(k).LT.1.e-10) THEN
3485  fnr(k)=fnr(k+1)
3486  END IF
3487  IF (fc(k).LT.1.e-10) THEN
3488  fc(k)=fc(k+1)
3489  END IF
3490  IF (fnc(k).LT.1.e-10) THEN
3491  fnc(k)=fnc(k+1)
3492  END IF
3493  IF (fg(k).LT.1.e-10) THEN
3494  fg(k)=fg(k+1)
3495  END IF
3496  IF (fng(k).LT.1.e-10) THEN
3497  fng(k)=fng(k+1)
3498  END IF
3499  END IF ! K LE KTE-1
3500 
3501 ! CALCULATE NUMBER OF SPLIT TIME STEPS
3502 
3503  rgvm = max(fr(k),fi(k),fs(k),fc(k),fni(k),fnr(k),fns(k),fnc(k),fg(k),fng(k))
3504 ! VVT CHANGED IFIX -> INT (GENERIC FUNCTION)
3505  nstep = max(int(rgvm*dt/dzq(k)+1.),nstep)
3506 ! Fortran version
3507 ! MULTIPLY VARIABLES BY RHO
3508  dumr(k) = dumr(k)*rho(k)
3509  dumi(k) = dumi(k)*rho(k)
3510  dumfni(k) = dumfni(k)*rho(k)
3511  dumqs(k) = dumqs(k)*rho(k)
3512  dumfns(k) = dumfns(k)*rho(k)
3513  dumfnr(k) = dumfnr(k)*rho(k)
3514  dumc(k) = dumc(k)*rho(k)
3515  dumfnc(k) = dumfnc(k)*rho(k)
3516  dumg(k) = dumg(k)*rho(k)
3517  dumfng(k) = dumfng(k)*rho(k)
3518 
3519  END DO
3520 
3521  DO n = 1,nstep
3522 
3523  DO k = kts,kte
3524  faloutr(k) = fr(k)*dumr(k)
3525  falouti(k) = fi(k)*dumi(k)
3526  faloutni(k) = fni(k)*dumfni(k)
3527  falouts(k) = fs(k)*dumqs(k)
3528  faloutns(k) = fns(k)*dumfns(k)
3529  faloutnr(k) = fnr(k)*dumfnr(k)
3530  faloutc(k) = fc(k)*dumc(k)
3531  faloutnc(k) = fnc(k)*dumfnc(k)
3532  faloutg(k) = fg(k)*dumg(k)
3533  faloutng(k) = fng(k)*dumfng(k)
3534  END DO
3535 
3536 ! TOP OF MODEL
3537 
3538  k = kte
3539  faltndr = faloutr(k)/dzq(k)
3540  faltndi = falouti(k)/dzq(k)
3541  faltndni = faloutni(k)/dzq(k)
3542  faltnds = falouts(k)/dzq(k)
3543  faltndns = faloutns(k)/dzq(k)
3544  faltndnr = faloutnr(k)/dzq(k)
3545  faltndc = faloutc(k)/dzq(k)
3546  faltndnc = faloutnc(k)/dzq(k)
3547  faltndg = faloutg(k)/dzq(k)
3548  faltndng = faloutng(k)/dzq(k)
3549 ! ADD FALLOUT TERMS TO EULERIAN TENDENCIES
3550 
3551  qrsten(k) = qrsten(k)-faltndr/nstep/rho(k)
3552  qisten(k) = qisten(k)-faltndi/nstep/rho(k)
3553  ni3dten(k) = ni3dten(k)-faltndni/nstep/rho(k)
3554  qnisten(k) = qnisten(k)-faltnds/nstep/rho(k)
3555  ns3dten(k) = ns3dten(k)-faltndns/nstep/rho(k)
3556  nr3dten(k) = nr3dten(k)-faltndnr/nstep/rho(k)
3557  qcsten(k) = qcsten(k)-faltndc/nstep/rho(k)
3558  nc3dten(k) = nc3dten(k)-faltndnc/nstep/rho(k)
3559  qgsten(k) = qgsten(k)-faltndg/nstep/rho(k)
3560  ng3dten(k) = ng3dten(k)-faltndng/nstep/rho(k)
3561 
3562  dumr(k) = dumr(k)-faltndr*dt/nstep
3563  dumi(k) = dumi(k)-faltndi*dt/nstep
3564  dumfni(k) = dumfni(k)-faltndni*dt/nstep
3565  dumqs(k) = dumqs(k)-faltnds*dt/nstep
3566  dumfns(k) = dumfns(k)-faltndns*dt/nstep
3567  dumfnr(k) = dumfnr(k)-faltndnr*dt/nstep
3568  dumc(k) = dumc(k)-faltndc*dt/nstep
3569  dumfnc(k) = dumfnc(k)-faltndnc*dt/nstep
3570  dumg(k) = dumg(k)-faltndg*dt/nstep
3571  dumfng(k) = dumfng(k)-faltndng*dt/nstep
3572 
3573  DO k = kte-1,kts,-1
3574  faltndr = (faloutr(k+1)-faloutr(k))/dzq(k)
3575  faltndi = (falouti(k+1)-falouti(k))/dzq(k)
3576  faltndni = (faloutni(k+1)-faloutni(k))/dzq(k)
3577  faltnds = (falouts(k+1)-falouts(k))/dzq(k)
3578  faltndns = (faloutns(k+1)-faloutns(k))/dzq(k)
3579  faltndnr = (faloutnr(k+1)-faloutnr(k))/dzq(k)
3580  faltndc = (faloutc(k+1)-faloutc(k))/dzq(k)
3581  faltndnc = (faloutnc(k+1)-faloutnc(k))/dzq(k)
3582  faltndg = (faloutg(k+1)-faloutg(k))/dzq(k)
3583  faltndng = (faloutng(k+1)-faloutng(k))/dzq(k)
3584 
3585 ! ADD FALLOUT TERMS TO EULERIAN TENDENCIES
3586 
3587  qrsten(k) = qrsten(k)+faltndr/nstep/rho(k)
3588  qisten(k) = qisten(k)+faltndi/nstep/rho(k)
3589  ni3dten(k) = ni3dten(k)+faltndni/nstep/rho(k)
3590  qnisten(k) = qnisten(k)+faltnds/nstep/rho(k)
3591  ns3dten(k) = ns3dten(k)+faltndns/nstep/rho(k)
3592  nr3dten(k) = nr3dten(k)+faltndnr/nstep/rho(k)
3593  qcsten(k) = qcsten(k)+faltndc/nstep/rho(k)
3594  nc3dten(k) = nc3dten(k)+faltndnc/nstep/rho(k)
3595  qgsten(k) = qgsten(k)+faltndg/nstep/rho(k)
3596  ng3dten(k) = ng3dten(k)+faltndng/nstep/rho(k)
3597 ! Fortran version
3598  dumr(k) = dumr(k)+faltndr*dt/nstep
3599  dumi(k) = dumi(k)+faltndi*dt/nstep
3600  dumfni(k) = dumfni(k)+faltndni*dt/nstep
3601  dumqs(k) = dumqs(k)+faltnds*dt/nstep
3602  dumfns(k) = dumfns(k)+faltndns*dt/nstep
3603  dumfnr(k) = dumfnr(k)+faltndnr*dt/nstep
3604  dumc(k) = dumc(k)+faltndc*dt/nstep
3605  dumfnc(k) = dumfnc(k)+faltndnc*dt/nstep
3606  dumg(k) = dumg(k)+faltndg*dt/nstep
3607  dumfng(k) = dumfng(k)+faltndng*dt/nstep
3608 
3609 ! FOR WRF-CHEM, NEED PRECIP RATES (UNITS OF KG/M^2/S)
3610  csed(k)=csed(k)+faloutc(k)/nstep
3611  ised(k)=ised(k)+falouti(k)/nstep
3612  ssed(k)=ssed(k)+falouts(k)/nstep
3613  gsed(k)=gsed(k)+faloutg(k)/nstep
3614  rsed(k)=rsed(k)+faloutr(k)/nstep
3615  END DO
3616 
3617 ! GET PRECIPITATION AND SNOWFALL ACCUMULATION DURING THE TIME STEP
3618 ! FACTOR OF 1000 CONVERTS FROM M TO MM, BUT DIVISION BY DENSITY
3619 ! OF LIQUID WATER CANCELS THIS FACTOR OF 1000
3620 
3621  precrt = precrt+(faloutr(kts)+faloutc(kts)+falouts(kts)+falouti(kts)+faloutg(kts)) &
3622  *dt/nstep
3623  snowrt = snowrt+(falouts(kts)+falouti(kts)+faloutg(kts))*dt/nstep
3624 ! hm added 7/13/13
3625  snowprt = snowprt+(falouti(kts)+falouts(kts))*dt/nstep
3626  grplprt = grplprt+(faloutg(kts))*dt/nstep
3627  END DO
3628 
3629  DO k=kts,kte
3630 ! Fortran version
3631 ! ADD ON SEDIMENTATION TENDENCIES FOR MIXING RATIO TO REST OF TENDENCIES
3632 
3633  qr3dten(k)=qr3dten(k)+qrsten(k)
3634  qi3dten(k)=qi3dten(k)+qisten(k)
3635  qc3dten(k)=qc3dten(k)+qcsten(k)
3636  qg3dten(k)=qg3dten(k)+qgsten(k)
3637  qni3dten(k)=qni3dten(k)+qnisten(k)
3638 ! Fortran version
3639 ! PUT ALL CLOUD ICE IN SNOW CATEGORY IF MEAN DIAMETER EXCEEDS 2 * dcs
3640 
3641 !hm 4/7/09 bug fix
3642 ! IF (QI3D(K).GE.QSMALL.AND.T3D(K).LT.273.15) THEN
3643  IF (qi3d(k).GE.qsmall.AND.t3d(k).LT.273.15.AND.lami(k).GE.1.e-10) THEN
3644  IF (1./lami(k).GE.2.*dcs) THEN
3645  qni3dten(k) = qni3dten(k)+qi3d(k)/dt+ qi3dten(k)
3646  ns3dten(k) = ns3dten(k)+ni3d(k)/dt+ ni3dten(k)
3647  qi3dten(k) = -qi3d(k)/dt
3648  ni3dten(k) = -ni3d(k)/dt
3649  END IF
3650  END IF
3651 
3652 ! hm add tendencies here, then call sizeparameter
3653 ! to ensure consisitency between mixing ratio and number concentration
3654 
3655  qc3d(k) = qc3d(k)+qc3dten(k)*dt
3656  qi3d(k) = qi3d(k)+qi3dten(k)*dt
3657  qni3d(k) = qni3d(k)+qni3dten(k)*dt
3658  qr3d(k) = qr3d(k)+qr3dten(k)*dt
3659  nc3d(k) = nc3d(k)+nc3dten(k)*dt
3660  ni3d(k) = ni3d(k)+ni3dten(k)*dt
3661  ns3d(k) = ns3d(k)+ns3dten(k)*dt
3662  nr3d(k) = nr3d(k)+nr3dten(k)*dt
3663 ! Fortran version
3664  IF (igraup.EQ.0) THEN
3665  qg3d(k) = qg3d(k)+qg3dten(k)*dt
3666  ng3d(k) = ng3d(k)+ng3dten(k)*dt
3667  END IF
3668 
3669 ! ADD TEMPERATURE AND WATER VAPOR TENDENCIES FROM MICROPHYSICS
3670  t3d(k) = t3d(k)+t3dten(k)*dt
3671  qv3d(k) = qv3d(k)+qv3dten(k)*dt
3672 ! Fortran version
3673 ! SATURATION VAPOR PRESSURE AND MIXING RATIO
3674 
3675 ! hm, add fix for low pressure, 5/12/10
3676  evs(k) = min(0.99*pres(k),polysvp(t3d(k),0)) ! PA
3677  eis(k) = min(0.99*pres(k),polysvp(t3d(k),1)) ! PA
3678 
3679 ! MAKE SURE ICE SATURATION DOESN'T EXCEED WATER SAT. NEAR FREEZING
3680 
3681  IF (eis(k).GT.evs(k)) eis(k) = evs(k)
3682 
3683  qvs(k) = ep_2*evs(k)/(pres(k)-evs(k))
3684  qvi(k) = ep_2*eis(k)/(pres(k)-eis(k))
3685 
3686  qvqvs(k) = qv3d(k)/qvs(k)
3687  qvqvsi(k) = qv3d(k)/qvi(k)
3688 ! Fortran version
3689 ! AT SUBSATURATION, REMOVE SMALL AMOUNTS OF CLOUD/PRECIP WATER
3690 ! hm 7/9/09 change limit to 1.e-8
3691 
3692  IF (qvqvs(k).LT.0.9) THEN
3693  IF (qr3d(k).LT.1.e-8) THEN
3694  qv3d(k)=qv3d(k)+qr3d(k)
3695  t3d(k)=t3d(k)-qr3d(k)*xxlv(k)/cpm(k)
3696  qr3d(k)=0.
3697  END IF
3698  IF (qc3d(k).LT.1.e-8) THEN
3699  qv3d(k)=qv3d(k)+qc3d(k)
3700  t3d(k)=t3d(k)-qc3d(k)*xxlv(k)/cpm(k)
3701  qc3d(k)=0.
3702  END IF
3703  END IF
3704  IF (qvqvsi(k).LT.0.9) THEN
3705  IF (qi3d(k).LT.1.e-8) THEN
3706  qv3d(k)=qv3d(k)+qi3d(k)
3707  t3d(k)=t3d(k)-qi3d(k)*xxls(k)/cpm(k)
3708  qi3d(k)=0.
3709  END IF
3710  IF (qni3d(k).LT.1.e-8) THEN
3711  qv3d(k)=qv3d(k)+qni3d(k)
3712  t3d(k)=t3d(k)-qni3d(k)*xxls(k)/cpm(k)
3713  qni3d(k)=0.
3714  END IF
3715  IF (qg3d(k).LT.1.e-8) THEN
3716  qv3d(k)=qv3d(k)+qg3d(k)
3717  t3d(k)=t3d(k)-qg3d(k)*xxls(k)/cpm(k)
3718  qg3d(k)=0.
3719  END IF
3720  END IF
3721 ! Fortran version
3722 !..................................................................
3723 ! IF MIXING RATIO < QSMALL SET MIXING RATIO AND NUMBER CONC TO ZERO
3724 
3725  IF (qc3d(k).LT.qsmall) THEN
3726  qc3d(k) = 0.
3727  nc3d(k) = 0.
3728  effc(k) = 0.
3729  END IF
3730  IF (qr3d(k).LT.qsmall) THEN
3731  qr3d(k) = 0.
3732  nr3d(k) = 0.
3733  effr(k) = 0.
3734  END IF
3735  IF (qi3d(k).LT.qsmall) THEN
3736  qi3d(k) = 0.
3737  ni3d(k) = 0.
3738  effi(k) = 0.
3739  END IF
3740  IF (qni3d(k).LT.qsmall) THEN
3741  qni3d(k) = 0.
3742  ns3d(k) = 0.
3743  effs(k) = 0.
3744  END IF
3745  IF (qg3d(k).LT.qsmall) THEN
3746  qg3d(k) = 0.
3747  ng3d(k) = 0.
3748  effg(k) = 0.
3749  END IF
3750 ! Fortran version
3751 !..................................
3752 ! IF THERE IS NO CLOUD/PRECIP WATER, THEN SKIP CALCULATIONS
3753 
3754  IF (qc3d(k).LT.qsmall.AND.qi3d(k).LT.qsmall.AND.qni3d(k).LT.qsmall &
3755  .AND.qr3d(k).LT.qsmall.AND.qg3d(k).LT.qsmall) GOTO 500
3756 
3757 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3758 ! CALCULATE INSTANTANEOUS PROCESSES
3759 
3760 ! ADD MELTING OF CLOUD ICE TO FORM RAIN
3761 
3762  IF (qi3d(k).GE.qsmall.AND.t3d(k).GE.273.15) THEN
3763  qr3d(k) = qr3d(k)+qi3d(k)
3764  t3d(k) = t3d(k)-qi3d(k)*xlf(k)/cpm(k)
3765  qi3d(k) = 0.
3766  nr3d(k) = nr3d(k)+ni3d(k)
3767  ni3d(k) = 0.
3768  END IF
3769 ! Fortran version
3770 ! ****SENSITIVITY - NO ICE
3771  IF (iliq.EQ.1) GOTO 778
3772 
3773 ! HOMOGENEOUS FREEZING OF CLOUD WATER
3774 
3775  IF (t3d(k).LE.233.15.AND.qc3d(k).GE.qsmall) THEN
3776  qi3d(k)=qi3d(k)+qc3d(k)
3777  t3d(k)=t3d(k)+qc3d(k)*xlf(k)/cpm(k)
3778  qc3d(k)=0.
3779  ni3d(k)=ni3d(k)+nc3d(k)
3780  nc3d(k)=0.
3781  END IF
3782 ! Fortran version
3783 ! HOMOGENEOUS FREEZING OF RAIN
3784 
3785  IF (igraup.EQ.0) THEN
3786 
3787  IF (t3d(k).LE.233.15.AND.qr3d(k).GE.qsmall) THEN
3788  qg3d(k) = qg3d(k)+qr3d(k)
3789  t3d(k) = t3d(k)+qr3d(k)*xlf(k)/cpm(k)
3790  qr3d(k) = 0.
3791  ng3d(k) = ng3d(k)+ nr3d(k)
3792  nr3d(k) = 0.
3793  END IF
3794 
3795  ELSE IF (igraup.EQ.1) THEN
3796 
3797  IF (t3d(k).LE.233.15.AND.qr3d(k).GE.qsmall) THEN
3798  qni3d(k) = qni3d(k)+qr3d(k)
3799  t3d(k) = t3d(k)+qr3d(k)*xlf(k)/cpm(k)
3800  qr3d(k) = 0.
3801  ns3d(k) = ns3d(k)+nr3d(k)
3802  nr3d(k) = 0.
3803  END IF
3804 
3805  END IF
3806 ! Fortran version
3807  778 CONTINUE
3808 
3809 ! MAKE SURE NUMBER CONCENTRATIONS AREN'T NEGATIVE
3810 
3811  ni3d(k) = max(0.,ni3d(k))
3812  ns3d(k) = max(0.,ns3d(k))
3813  nc3d(k) = max(0.,nc3d(k))
3814  nr3d(k) = max(0.,nr3d(k))
3815  ng3d(k) = max(0.,ng3d(k))
3816 
3817 !......................................................................
3818 ! CLOUD ICE
3819 
3820  IF (qi3d(k).GE.qsmall) THEN
3821  lami(k) = (cons12* &
3822  ni3d(k)/qi3d(k))**(1./di)
3823 
3824 ! CHECK FOR SLOPE
3825 
3826 ! ADJUST VARS
3827 
3828  IF (lami(k).LT.lammini) THEN
3829 
3830  lami(k) = lammini
3831 
3832  n0i(k) = lami(k)**4*qi3d(k)/cons12
3833 
3834  ni3d(k) = n0i(k)/lami(k)
3835  ELSE IF (lami(k).GT.lammaxi) THEN
3836  lami(k) = lammaxi
3837  n0i(k) = lami(k)**4*qi3d(k)/cons12
3838 
3839  ni3d(k) = n0i(k)/lami(k)
3840  END IF
3841  END IF
3842 
3843 !......................................................................
3844 ! RAIN
3845 
3846  IF (qr3d(k).GE.qsmall) THEN
3847  lamr(k) = (pi*rhow*nr3d(k)/qr3d(k))**(1./3.)
3848 
3849 ! CHECK FOR SLOPE
3850 
3851 ! ADJUST VARS
3852 
3853  IF (lamr(k).LT.lamminr) THEN
3854 
3855  lamr(k) = lamminr
3856 
3857  n0rr(k) = lamr(k)**4*qr3d(k)/(pi*rhow)
3858 
3859  nr3d(k) = n0rr(k)/lamr(k)
3860  ELSE IF (lamr(k).GT.lammaxr) THEN
3861  lamr(k) = lammaxr
3862  n0rr(k) = lamr(k)**4*qr3d(k)/(pi*rhow)
3863 
3864  nr3d(k) = n0rr(k)/lamr(k)
3865  END IF
3866 
3867  END IF
3868 
3869 !......................................................................
3870 ! CLOUD DROPLETS
3871 
3872 ! MARTIN ET AL. (1994) FORMULA FOR PGAM
3873 
3874  IF (qc3d(k).GE.qsmall) THEN
3875 
3876  dum = pres(k)/(287.15*t3d(k))
3877  pgam(k)=0.0005714*(nc3d(k)/1.e6*dum)+0.2714
3878  pgam(k)=1./(pgam(k)**2)-1.
3879  pgam(k)=max(pgam(k),2.)
3880  pgam(k)=min(pgam(k),10.)
3881 
3882 ! CALCULATE LAMC
3883 
3884  lamc(k) = (cons26*nc3d(k)*gamma(pgam(k)+4.)/ &
3885  (qc3d(k)*gamma(pgam(k)+1.)))**(1./3.)
3886 
3887 ! LAMMIN, 60 MICRON DIAMETER
3888 ! LAMMAX, 1 MICRON
3889 
3890  lammin = (pgam(k)+1.)/60.e-6
3891  lammax = (pgam(k)+1.)/1.e-6
3892 
3893  IF (lamc(k).LT.lammin) THEN
3894  lamc(k) = lammin
3895  nc3d(k) = exp(3.*log(lamc(k))+log(qc3d(k))+ &
3896  log(gamma(pgam(k)+1.))-log(gamma(pgam(k)+4.)))/cons26
3897 
3898  ELSE IF (lamc(k).GT.lammax) THEN
3899  lamc(k) = lammax
3900  nc3d(k) = exp(3.*log(lamc(k))+log(qc3d(k))+ &
3901  log(gamma(pgam(k)+1.))-log(gamma(pgam(k)+4.)))/cons26
3902 
3903  END IF
3904 
3905  END IF
3906 
3907 !......................................................................
3908 ! SNOW
3909 
3910  IF (qni3d(k).GE.qsmall) THEN
3911  lams(k) = (cons1*ns3d(k)/qni3d(k))**(1./ds)
3912 
3913 ! CHECK FOR SLOPE
3914 
3915 ! ADJUST VARS
3916 
3917  IF (lams(k).LT.lammins) THEN
3918  lams(k) = lammins
3919  n0s(k) = lams(k)**4*qni3d(k)/cons1
3920 
3921  ns3d(k) = n0s(k)/lams(k)
3922 
3923  ELSE IF (lams(k).GT.lammaxs) THEN
3924 
3925  lams(k) = lammaxs
3926  n0s(k) = lams(k)**4*qni3d(k)/cons1
3927  ns3d(k) = n0s(k)/lams(k)
3928  END IF
3929 
3930  END IF
3931 
3932 !......................................................................
3933 ! GRAUPEL
3934 
3935  IF (qg3d(k).GE.qsmall) THEN
3936  lamg(k) = (cons2*ng3d(k)/qg3d(k))**(1./dg)
3937 
3938 ! CHECK FOR SLOPE
3939 
3940 ! ADJUST VARS
3941 
3942  IF (lamg(k).LT.lamming) THEN
3943  lamg(k) = lamming
3944  n0g(k) = lamg(k)**4*qg3d(k)/cons2
3945 
3946  ng3d(k) = n0g(k)/lamg(k)
3947 
3948  ELSE IF (lamg(k).GT.lammaxg) THEN
3949 
3950  lamg(k) = lammaxg
3951  n0g(k) = lamg(k)**4*qg3d(k)/cons2
3952 
3953  ng3d(k) = n0g(k)/lamg(k)
3954  END IF
3955 
3956  END IF
3957 
3958  500 CONTINUE
3959 
3960 ! CALCULATE EFFECTIVE RADIUS
3961 
3962  IF (qi3d(k).GE.qsmall) THEN
3963  effi(k) = 3./lami(k)/2.*1.e6
3964  ELSE
3965  effi(k) = 25.
3966  END IF
3967 
3968  IF (qni3d(k).GE.qsmall) THEN
3969  effs(k) = 3./lams(k)/2.*1.e6
3970  ELSE
3971  effs(k) = 25.
3972  END IF
3973 
3974  IF (qr3d(k).GE.qsmall) THEN
3975  effr(k) = 3./lamr(k)/2.*1.e6
3976  ELSE
3977  effr(k) = 25.
3978  END IF
3979 
3980  IF (qc3d(k).GE.qsmall) THEN
3981  effc(k) = gamma(pgam(k)+4.)/ &
3982  gamma(pgam(k)+3.)/lamc(k)/2.*1.e6
3983  ELSE
3984  effc(k) = 25.
3985  END IF
3986 
3987  IF (qg3d(k).GE.qsmall) THEN
3988  effg(k) = 3./lamg(k)/2.*1.e6
3989  ELSE
3990  effg(k) = 25.
3991  END IF
3992 
3993 ! HM ADD 1/10/06, ADD UPPER BOUND ON ICE NUMBER, THIS IS NEEDED
3994 ! TO PREVENT VERY LARGE ICE NUMBER DUE TO HOMOGENEOUS FREEZING
3995 ! OF DROPLETS, ESPECIALLY WHEN INUM = 1, SET MAX AT 10 CM-3
3996 ! NI3D(K) = MIN(NI3D(K),10.E6/RHO(K))
3997 ! HM, 12/28/12, LOWER MAXIMUM ICE CONCENTRATION TO ADDRESS PROBLEM
3998 ! OF EXCESSIVE AND PERSISTENT ANVIL
3999 ! NOTE: THIS MAY CHANGE/REDUCE SENSITIVITY TO AEROSOL/CCN CONCENTRATION
4000  ni3d(k) = min(ni3d(k),0.3e6/rho(k))
4001 
4002 ! ADD BOUND ON DROPLET NUMBER - CANNOT EXCEED AEROSOL CONCENTRATION
4003  IF (iinum.EQ.0.AND.iact.EQ.2) THEN
4004  nc3d(k) = min(nc3d(k),(nanew1+nanew2)/rho(k))
4005  END IF
4006 ! SWITCH FOR CONSTANT DROPLET NUMBER
4007  IF (iinum.EQ.1) THEN
4008 ! NDCNST: #/CM^3 -> #/M^3; RHO_ERF: KG_DRY/M^3; NC3D: #/KG_DRY
4009  nc3d(k) = ndcnst*1.e6/rho_erf(k)
4010  END IF
4011 
4012  END DO !!! K LOOP
4013 
4014  400 CONTINUE
4015 
4016 ! ALL DONE !!!!!!!!!!!
4017  RETURN

Referenced by mp_morr_two_moment().

Here is the call graph for this function:
Here is the caller graph for this function:

◆ mp_morr_two_moment()

subroutine, public module_mp_morr_two_moment::mp_morr_two_moment ( integer, intent(in)  ITIMESTEP,
real(c_double), dimension(ims:ime, jms:jme, kms:kme), intent(inout)  TH,
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)  QR,
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)  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)  NI,
real(c_double), dimension(ims:ime, jms:jme, kms:kme), intent(inout)  NS,
real(c_double), dimension(ims:ime, jms:jme, kms:kme), intent(inout)  NR,
real(c_double), dimension(ims:ime, jms:jme, kms:kme), intent(inout)  NG,
real(c_double), dimension(ims:ime, jms:jme, kms:kme), intent(in)  RHO,
real(c_double), dimension(ims:ime, jms:jme, kms:kme), intent(in)  PII,
real(c_double), dimension(ims:ime, jms:jme, kms:kme), intent(in)  P,
real(c_double), intent(in)  DT_IN,
real(c_double), dimension(ims:ime, jms:jme, kms:kme), intent(in)  DZ,
real(c_double), dimension(ims:ime, jms:jme, kms:kme), intent(in)  W,
real(c_double), dimension(ims:ime, jms:jme, kms:kme), intent(inout)  RAINNC,
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, kms:kme), intent(inout)  SNOWNC,
real(c_double), dimension(ims:ime, jms:jme), intent(inout)  SNOWNCV,
real(c_double), dimension(ims:ime, jms:jme, kms:kme), intent(inout)  GRAUPELNC,
real(c_double), dimension(ims:ime, jms:jme), intent(inout)  GRAUPELNCV,
real(c_double), dimension(ims:ime, jms:kme, kms:jme), intent(inout)  refl_10cm,
logical, intent(in), optional  diagflag,
integer, intent(in), optional  do_radar_ref,
real(c_double), dimension(ims:ime, jms:jme, kms:kme), intent(in)  qrcuten,
real(c_double), dimension(ims:ime, jms:jme, kms:kme), intent(in)  qscuten,
real(c_double), dimension(ims:ime, jms:jme, kms:kme), intent(in)  qicuten,
logical, intent(in), optional  F_QNDROP,
real(c_double), dimension(ims:ime, jms:jme, kms:kme), intent(inout), optional  qndrop,
integer, intent(in)  IDS,
integer, intent(in)  IDE,
integer, intent(in)  JDS,
integer, intent(in)  JDE,
integer, intent(in)  KDS,
integer, intent(in)  KDE,
integer, intent(in)  IMS,
integer, intent(in)  IME,
integer, intent(in)  JMS,
integer, intent(in)  JME,
integer, intent(in)  KMS,
integer, intent(in)  KME,
integer, intent(in)  ITS,
integer, intent(in)  ITE,
integer, intent(in)  JTS,
integer, intent(in)  JTE,
integer, intent(in)  KTS,
integer, intent(in)  KTE,
logical, intent(in), optional  wetscav_on,
real(c_double), dimension(ims:ime, jms:jme, kms:kme), intent(inout), optional  rainprod,
real(c_double), dimension(ims:ime, jms:jme, kms:kme), intent(inout), optional  evapprod,
real(c_double), dimension(ims:ime, jms:jme, kms:kme), intent(inout), optional  QLSINK,
real(c_double), dimension(ims:ime, jms:jme, kms:kme), intent(inout), optional  PRECR,
real(c_double), dimension(ims:ime, jms:jme, kms:kme), intent(inout), optional  PRECI,
real(c_double), dimension(ims:ime, jms:jme, kms:kme), intent(inout), optional  PRECS,
real(c_double), dimension(ims:ime, jms:jme, kms:kme), intent(inout), optional  PRECG 
)
614 
615 ! QV - water vapor mixing ratio (kg/kg)
616 ! QC - cloud water mixing ratio (kg/kg)
617 ! QR - rain water mixing ratio (kg/kg)
618 ! QI - cloud ice mixing ratio (kg/kg)
619 ! QS - snow mixing ratio (kg/kg)
620 ! QG - graupel mixing ratio (KG/KG)
621 ! NI - cloud ice number concentration (1/kg)
622 ! NS - Snow Number concentration (1/kg)
623 ! NR - Rain Number concentration (1/kg)
624 ! NG - Graupel number concentration (1/kg)
625 ! NOTE: RHO AND HT NOT USED BY THIS SCHEME AND DO NOT NEED TO BE PASSED INTO SCHEME!!!!
626 ! P - AIR PRESSURE (PA)
627 ! W - VERTICAL AIR VELOCITY (M/S)
628 ! TH - POTENTIAL TEMPERATURE (K)
629 ! PII - exner function - used to convert potential temp to temp
630 ! DZ - difference in height over interface (m)
631 ! DT_IN - model time step (sec)
632 ! ITIMESTEP - time step counter
633 ! RAINNC - accumulated grid-scale precipitation (mm)
634 ! RAINNCV - one time step grid scale precipitation (mm/time step)
635 ! SNOWNC - accumulated grid-scale snow plus cloud ice (mm)
636 ! SNOWNCV - one time step grid scale snow plus cloud ice (mm/time step)
637 ! GRAUPELNC - accumulated grid-scale graupel (mm)
638 ! GRAUPELNCV - one time step grid scale graupel (mm/time step)
639 ! SR - one time step mass ratio of snow to total precip
640 ! qrcuten, rain tendency from parameterized cumulus convection
641 ! qscuten, snow tendency from parameterized cumulus convection
642 ! qicuten, cloud ice tendency from parameterized cumulus convection
643 
644 ! variables below currently not in use, not coupled to PBL or radiation codes
645 ! TKE - turbulence kinetic energy (m^2 s-2), NEEDED FOR DROPLET ACTIVATION (SEE CODE BELOW)
646 ! NCTEND - droplet concentration tendency from pbl (kg-1 s-1)
647 ! NCTEND - CLOUD ICE concentration tendency from pbl (kg-1 s-1)
648 ! KZH - heat eddy diffusion coefficient from YSU scheme (M^2 S-1), NEEDED FOR DROPLET ACTIVATION (SEE CODE BELOW)
649 ! EFFCS - CLOUD DROPLET EFFECTIVE RADIUS OUTPUT TO RADIATION CODE (micron)
650 ! EFFIS - CLOUD DROPLET EFFECTIVE RADIUS OUTPUT TO RADIATION CODE (micron)
651 ! HM, ADDED FOR WRF-CHEM COUPLING
652 ! QLSINK - TENDENCY OF CLOUD WATER TO RAIN, SNOW, GRAUPEL (KG/KG/S)
653 ! CSED,ISED,SSED,GSED,RSED - SEDIMENTATION FLUXES (KG/M^2/S) FOR CLOUD WATER, ICE, SNOW, GRAUPEL, RAIN
654 ! PRECI,PRECS,PRECG,PRECR - SEDIMENTATION FLUXES (KG/M^2/S) FOR ICE, SNOW, GRAUPEL, RAIN
655 
656 ! rainprod - total tendency of conversion of cloud water/ice and graupel to rain (kg kg-1 s-1)
657 ! evapprod - tendency of evaporation of rain (kg kg-1 s-1)
658 
659 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
660 
661 ! reflectivity currently not included!!!!
662 ! REFL_10CM - CALCULATED RADAR REFLECTIVITY AT 10 CM (DBZ)
663 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
664 
665 ! EFFC - DROPLET EFFECTIVE RADIUS (MICRON)
666 ! EFFR - RAIN EFFECTIVE RADIUS (MICRON)
667 ! EFFS - SNOW EFFECTIVE RADIUS (MICRON)
668 ! EFFI - CLOUD ICE EFFECTIVE RADIUS (MICRON)
669 
670 ! ADDITIONAL OUTPUT FROM MICRO - SEDIMENTATION TENDENCIES, NEEDED FOR LIQUID-ICE STATIC ENERGY
671 
672 ! QGSTEN - GRAUPEL SEDIMENTATION TEND (KG/KG/S)
673 ! QRSTEN - RAIN SEDIMENTATION TEND (KG/KG/S)
674 ! QISTEN - CLOUD ICE SEDIMENTATION TEND (KG/KG/S)
675 ! QNISTEN - SNOW SEDIMENTATION TEND (KG/KG/S)
676 ! QCSTEN - CLOUD WATER SEDIMENTATION TEND (KG/KG/S)
677 
678  IMPLICIT NONE
679 
680  INTEGER, INTENT(IN ) :: ids, ide, jds, jde, kds, kde , &
681  ims, ime, jms, jme, kms, kme , &
682  its, ite, jts, jte, kts, kte
683 
684  REAL(C_DOUBLE), DIMENSION(ims:ime, jms:jme, kms:kme), INTENT(INOUT) :: qv, qc, qr, qi, qs, qg, ni, ns, nr, TH, NG
685  REAL(C_DOUBLE), DIMENSION(ims:ime, jms:jme, kms:kme), optional,INTENT(INOUT) :: qndrop
686  REAL(C_DOUBLE), DIMENSION(ims:ime, jms:jme, kms:kme), optional,INTENT(INOUT) :: QLSINK, rainprod, evapprod, PRECI,PRECS,PRECG, &
687  & PRECR
688  REAL(C_DOUBLE), DIMENSION(ims:ime, jms:jme, kms:kme), INTENT(IN ) :: pii, p, dz, rho, w
689 
690  REAL(C_DOUBLE), INTENT(IN):: dt_in
691  INTEGER, INTENT(IN):: ITIMESTEP
692  REAL(C_DOUBLE), INTENT(INOUT), DIMENSION(ims:ime, jms:jme, kms:kme) :: rainnc, snownc, graupelnc
693  REAL(C_DOUBLE), INTENT(INOUT), DIMENSION(ims:ime, jms:jme) :: rainncv, sr, snowncv, graupelncv
694 ! REAL(C_DOUBLE), DIMENSION(ims:ime, jms:jme ), INTENT(INOUT) :: RAINNC, RAINNCV, SR, SNOWNC,SNOWNCV,GRAUPELNC,GRAUPELNCV
695  REAL(C_DOUBLE), DIMENSION(ims:ime, jms:kme, kms:jme), INTENT(INOUT) :: refl_10cm
696 ! REAL(C_DOUBLE), DIMENSION(ims:ime ,jms:jme ), INTENT(IN ) :: ht
697 
698  LOGICAL, optional, INTENT(IN) :: wetscav_on
699 
700  ! LOCAL VARIABLES
701 
702  REAL(C_DOUBLE), DIMENSION(its:ite, jts:jte, kts:kte) :: effi, effs, effr, EFFG
703  REAL(C_DOUBLE), DIMENSION(its:ite, jts:jte, kts:kte) :: T, EFFC
704 
705  REAL(C_DOUBLE), DIMENSION(kts:kte) :: &
706  QC_TEND1D, QI_TEND1D, QNI_TEND1D, QR_TEND1D, &
707  NI_TEND1D, NS_TEND1D, NR_TEND1D, &
708  QC1D, QI1D, QR1D,NI1D, NS1D, NR1D, QS1D, &
709  T_TEND1D,QV_TEND1D, T1D, QV1D, P1D, W1D, RHO_ERF1D, &
710  EFFC1D, EFFI1D, EFFS1D, EFFR1D,DZ1D, &
711  QG_TEND1D, NG_TEND1D, QG1D, NG1D, EFFG1D, &
712 ! ADD SEDIMENTATION TENDENCIES (UNITS OF KG/KG/S)
713  qgsten,qrsten, qisten, qnisten, qcsten, &
714 ! ADD CUMULUS TENDENCIES
715  qrcu1d, qscu1d, qicu1d
716 ! add cumulus tendencies
717 
718  REAL(C_DOUBLE), DIMENSION(ims:ime, jms:jme, kms:kme), INTENT(IN):: qrcuten, qscuten, qicuten
719 
720  LOGICAL, INTENT(IN), OPTIONAL :: F_QNDROP
721  LOGICAL :: flag_qndrop ! wrf-chem
722  integer :: iinum ! wrf-chem
723 
724 ! wrf-chem
725  REAL(C_DOUBLE), DIMENSION(kts:kte) :: nc1d, nc_tend1d,C2PREC,CSED,ISED,SSED,GSED,RSED
726  REAL(C_DOUBLE), DIMENSION(kts:kte) :: rainprod1d, evapprod1d
727 ! HM add reflectivity
728  REAL(C_DOUBLE), DIMENSION(kts:kte) :: dBZ
729 
730  REAL(C_DOUBLE) PRECPRT1D, SNOWRT1D, SNOWPRT1D, GRPLPRT1D ! hm added 7/13/13
731 
732  INTEGER I,J,K
733 
734  REAL(C_DOUBLE) DT
735 
736  LOGICAL, OPTIONAL, INTENT(IN) :: diagflag
737  INTEGER, OPTIONAL, INTENT(IN) :: do_radar_ref
738 
739  LOGICAL :: has_wetscav
740 
741  ! return
742  print *,'IN MORR_TWO_MOMENT MAIN ROUTINE '
743 
744 ! below for wrf-chem
745  flag_qndrop = .false.
746  IF ( PRESENT ( f_qndrop ) ) flag_qndrop = f_qndrop
747 !!!!!!!!!!!!!!!!!!!!!!
748 
749  IF( PRESENT( wetscav_on ) ) THEN
750  has_wetscav = wetscav_on
751  ELSE
752  has_wetscav = .false.
753  ENDIF
754 
755  ! Initialize tendencies (all set to 0) and transfer
756  ! array to local variables
757  dt = dt_in
758 
759  ! Currently mixing of number concentrations also is neglected (not coupled with PBL schemes)
760 
761  ! print *,'IMS IME ',ims,ime
762  ! print *,'JMS JME ',jms,jme
763  ! print *,'KMS KME ',kms,kme
764 
765  ! print *,'ITS ITE ',its,ite
766  ! print *,'JTS JTE ',jts,jte
767  ! print *,'KTS KTE ',kts,kte
768 
769  DO i=its,ite
770  DO j=jts,jte
771  DO k=kts,kte
772  t(i,j,k) = th(i,j,k) * pii(i,j,k)
773  END DO
774  END DO
775  END DO
776 
777  do i=its,ite ! i loop (east-west)
778  do j=jts,jte ! j loop (north-south)
779  !
780  ! Transfer 3D arrays into 1D for microphysical calculations
781  !
782 
783 ! hm , initialize 1d tendency arrays to zero
784 
785  do k=kts,kte ! k loop (vertical)
786 
787  qc_tend1d(k) = 0.
788  qi_tend1d(k) = 0.
789  qni_tend1d(k) = 0.
790  qr_tend1d(k) = 0.
791  ni_tend1d(k) = 0.
792  ns_tend1d(k) = 0.
793  nr_tend1d(k) = 0.
794  t_tend1d(k) = 0.
795  qv_tend1d(k) = 0.
796  nc_tend1d(k) = 0. ! wrf-chem
797 
798  qc1d(k) = qc(i,j,k)
799  qi1d(k) = qi(i,j,k)
800  qs1d(k) = qs(i,j,k)
801  qr1d(k) = qr(i,j,k)
802 
803  ni1d(k) = ni(i,j,k)
804 
805  ns1d(k) = ns(i,j,k)
806  nr1d(k) = nr(i,j,k)
807 ! HM ADD GRAUPEL
808  qg1d(k) = qg(i,j,k)
809  ng1d(k) = ng(i,j,k)
810  qg_tend1d(k) = 0.
811  ng_tend1d(k) = 0.
812 
813  t1d(k) = t(i,j,k)
814  qv1d(k) = qv(i,j,k)
815  p1d(k) = p(i,j,k)
816  dz1d(k) = dz(i,j,k)
817  w1d(k) = w(i,j,k)
818  rho_erf1d(k) = rho(i,j,k)
819 ! add cumulus tendencies, already decoupled
820  qrcu1d(k) = qrcuten(i,j,k)
821  qscu1d(k) = qscuten(i,j,k)
822  qicu1d(k) = qicuten(i,j,k)
823  end do !jdf added this
824 
825 ! below for wrf-chem
826  IF (flag_qndrop .AND. PRESENT( qndrop )) THEN
827  iact = 3
828  DO k = kts, kte
829  nc1d(k)=qndrop(i,j,k)
830  iinum=0
831  ENDDO
832  ELSE
833  DO k = kts, kte
834  nc1d(k)=0. ! temporary placeholder, set to constant in microphysics subroutine
835  iinum=1
836  ENDDO
837  ENDIF
838 
839 !jdf end do
840 
841  call morr_two_moment_micro(i,j,itimestep,kts,kte,qc_tend1d, qi_tend1d, qni_tend1d, qr_tend1d, &
842  ni_tend1d, ns_tend1d, nr_tend1d, &
843  qc1d, qi1d, qs1d, qr1d,ni1d, ns1d, nr1d, &
844  t_tend1d,qv_tend1d, t1d, qv1d, p1d, dz1d, w1d, rho_erf1d, &
845  precprt1d,snowrt1d, &
846  snowprt1d,grplprt1d, & ! hm added 7/13/13
847  effc1d,effi1d,effs1d,effr1d,dt, &
848  qg_tend1d,ng_tend1d,qg1d,ng1d,effg1d, &
849  qrcu1d, qscu1d, qicu1d, &
850 ! ADD SEDIMENTATION TENDENCIES
851  qgsten,qrsten,qisten,qnisten,qcsten, &
852  nc1d, nc_tend1d, iinum, c2prec,csed,ised,ssed,gsed,rsed)
853 
854  !
855  ! Transfer 1D arrays back into 3D arrays
856  !
857  do k=kts,kte
858 
859  ! hm, add tendencies to update global variables
860  ! HM, TENDENCIES FOR Q AND N NOW ADDED IN M2005MICRO, SO WE
861  ! ONLY NEED TO TRANSFER 1D VARIABLES BACK TO 3D
862 
863  qc(i,j,k) = qc1d(k)
864  qi(i,j,k) = qi1d(k)
865  qs(i,j,k) = qs1d(k)
866  qr(i,j,k) = qr1d(k)
867  ni(i,j,k) = ni1d(k)
868  ns(i,j,k) = ns1d(k)
869  nr(i,j,k) = nr1d(k)
870  qg(i,j,k) = qg1d(k)
871  ng(i,j,k) = ng1d(k)
872 
873  t(i,j,k) = t1d(k)
874  th(i,j,k) = t(i,j,k)/pii(i,j,k) ! CONVERT TEMP BACK TO POTENTIAL TEMP
875  qv(i,j,k) = qv1d(k)
876 
877  effc(i,j,k) = effc1d(k)
878  effi(i,j,k) = effi1d(k)
879  effs(i,j,k) = effs1d(k)
880  effr(i,j,k) = effr1d(k)
881  effg(i,j,k) = effg1d(k)
882 
883 ! wrf-chem
884  IF (PRESENT( qndrop )) THEN
885  qndrop(i,j,k) = nc1d(k)
886 !jdf CSED3D(i,j,k) = CSED(k)
887  END IF
888  IF ( PRESENT( qlsink ) ) THEN
889  if(qc(i,j,k)>1.e-10) then
890  qlsink(i,j,k) = c2prec(k)/qc(i,j,k)
891  else
892  qlsink(i,j,k) = 0.0
893  endif
894  END IF
895  IF ( PRESENT( precr ) ) precr(i,j,k) = rsed(k)
896  IF ( PRESENT( preci ) ) preci(i,j,k) = ised(k)
897  IF ( PRESENT( precs ) ) precs(i,j,k) = ssed(k)
898  IF ( PRESENT( precg ) ) precg(i,j,k) = gsed(k)
899 ! EFFECTIVE RADIUS FOR RADIATION CODE (currently not coupled)
900 ! HM, ADD LIMIT TO PREVENT BLOWING UP OPTICAL PROPERTIES, 8/18/07
901 ! EFFCS(I,J,K) = MIN(EFFC(I,J,K),50.)
902 ! EFFCS(I,J,K) = MAX(EFFCS(I,J,K),1.)
903 ! EFFIS(I,J,K) = MIN(EFFI(I,J,K),130.)
904 ! EFFIS(I,J,K) = MAX(EFFIS(I,J,K),13.)
905 
906  end do
907 
908 ! hm modified so that m2005 precip variables correctly match wrf precip variables
909  rainnc(i,j,kts) = rainnc(i,j,kts)+precprt1d
910  rainncv(i,j) = precprt1d
911  snownc(i,j,kts) = snownc(i,j,kts)+snowprt1d
912  snowncv(i,j) = snowprt1d
913  graupelnc(i,j,kts) = graupelnc(i,j,kts)+grplprt1d
914  graupelncv(i,j) = grplprt1d
915  sr(i,j) = snowrt1d/(precprt1d+1.e-12)
916 
917  end do
918  end do
919 

Referenced by mp_morr_two_moment_isohelper::mp_morr_two_moment_c().

Here is the call graph for this function:
Here is the caller graph for this function:

◆ polysvp()

real(c_double) function, public module_mp_morr_two_moment::polysvp ( real(c_double)  T,
integer  TYPE 
)
4023 
4024 !-------------------------------------------
4025 
4026 ! COMPUTE SATURATION VAPOR PRESSURE
4027 
4028 ! POLYSVP RETURNED IN UNITS OF PA.
4029 ! T IS INPUT IN UNITS OF K.
4030 ! TYPE REFERS TO SATURATION WITH RESPECT TO LIQUID (0) OR ICE (1)
4031 
4032 ! REPLACE GOFF-GRATCH WITH FASTER FORMULATION FROM FLATAU ET AL. 1992, TABLE 4 (RIGHT-HAND COLUMN)
4033 
4034  IMPLICIT NONE
4035 
4036  REAL(C_DOUBLE) DUM
4037  REAL(C_DOUBLE) T
4038  INTEGER TYPE
4039 ! ice
4040  real a0i,a1i,a2i,a3i,a4i,a5i,a6i,a7i,a8i
4041  data a0i,a1i,a2i,a3i,a4i,a5i,a6i,a7i,a8i /&
4042  6.11147274, 0.503160820, 0.188439774e-1, &
4043  0.420895665e-3, 0.615021634e-5,0.602588177e-7, &
4044  0.385852041e-9, 0.146898966e-11, 0.252751365e-14/
4045 
4046 ! liquid
4047  real a0,a1,a2,a3,a4,a5,a6,a7,a8
4048 
4049 ! V1.7
4050  data a0,a1,a2,a3,a4,a5,a6,a7,a8 /&
4051  6.11239921, 0.443987641, 0.142986287e-1, &
4052  0.264847430e-3, 0.302950461e-5, 0.206739458e-7, &
4053  0.640689451e-10,-0.952447341e-13,-0.976195544e-15/
4054  real dt
4055 
4056 ! ICE
4057 
4058  IF (type.EQ.1) THEN
4059 
4060 ! POLYSVP = 10.**(-9.09718*(273.16/T-1.)-3.56654* &
4061 ! LOG10(273.16/T)+0.876793*(1.-T/273.16)+ &
4062 ! LOG10(6.1071))*100.
4063 ! hm 11/16/20, use Goff-Gratch for T < 195.8 K and Flatau et al. equal or above 195.8 K
4064  if (t.ge.195.8) then
4065  dt=t-273.15
4066  polysvp = a0i + dt*(a1i+dt*(a2i+dt*(a3i+dt*(a4i+dt*(a5i+dt*(a6i+dt*(a7i+a8i*dt)))))))
4067  polysvp = polysvp*100.
4068  else
4069 
4070  polysvp = 10.**(-9.09718*(273.16/t-1.)-3.56654* &
4071  dlog10(273.16d0/t)+0.876793*(1.-t/273.16)+ &
4072  dlog10(6.1071d0))*100.
4073 
4074  end if
4075 
4076  END IF
4077 
4078 ! LIQUID
4079 
4080  IF (type.EQ.0) THEN
4081 
4082 ! POLYSVP = 10.**(-7.90298*(373.16/T-1.)+ &
4083 ! 5.02808*LOG10(373.16/T)- &
4084 ! 1.3816E-7*(10**(11.344*(1.-T/373.16))-1.)+ &
4085 ! 8.1328E-3*(10**(-3.49149*(373.16/T-1.))-1.)+ &
4086 ! LOG10(1013.246))*100.
4087 ! hm 11/16/20, use Goff-Gratch for T < 202.0 K and Flatau et al. equal or above 202.0 K
4088  if (t.ge.202.0) then
4089  dt = t-273.15
4090  polysvp = a0 + dt*(a1+dt*(a2+dt*(a3+dt*(a4+dt*(a5+dt*(a6+dt*(a7+a8*dt)))))))
4091  polysvp = polysvp*100.
4092  else
4093 
4094 ! note: uncertain below -70 C, but produces physical values (non-negative) unlike flatau
4095  polysvp = 10.**(-7.90298*(373.16/t-1.)+ &
4096  5.02808*dlog10(373.16d0/t)- &
4097  1.3816e-7*(10**(11.344*(1.-t/373.16))-1.)+ &
4098  8.1328e-3*(10**(-3.49149*(373.16/t-1.))-1.)+ &
4099  dlog10(1013.246d0))*100.
4100  end if
4101 
4102  END IF
4103 
4104 

Referenced by calc_saturation_vapor_pressure(), and morr_two_moment_micro().

Here is the caller graph for this function:

◆ set_morrison_ndcnst()

subroutine, public module_mp_morr_two_moment::set_morrison_ndcnst ( real(c_double), intent(in), value  ndcnst_in)
574 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
575 ! THIS SUBROUTINE SETS THE CONSTANT DROPLET CONCENTRATION (NDCNST)
576 ! ALLOWS RUNTIME CONFIGURATION FROM INPUT FILE
577 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
578  IMPLICIT NONE
579  REAL(C_DOUBLE), INTENT(IN), VALUE :: ndcnst_in
580 
581  ndcnst = ndcnst_in
582 

Variable Documentation

◆ ac

real(c_double), private module_mp_morr_two_moment::ac
private

Referenced by erf_slow_rhs_post(), and morr_two_moment_init().

◆ ag

real(c_double), private module_mp_morr_two_moment::ag
private

Referenced by morr_two_moment_init(), and morr_two_moment_micro().

◆ ai

real(c_double), private module_mp_morr_two_moment::ai
private
181  REAL(C_DOUBLE), PRIVATE :: AI,AC,AS,AR,AG ! 'A' PARAMETER IN FALLSPEED-DIAM RELATIONSHIP

Referenced by morr_two_moment_init(), and morr_two_moment_micro().

◆ aimm

real(c_double), private module_mp_morr_two_moment::aimm
private
191  REAL(C_DOUBLE), PRIVATE :: AIMM ! PARAMETER IN BIGG IMMERSION FREEZING

Referenced by morr_two_moment_init(), and morr_two_moment_micro().

◆ ar

real(c_double), private module_mp_morr_two_moment::ar
private

Referenced by morr_two_moment_init(), and morr_two_moment_micro().

◆ as

real(c_double), private module_mp_morr_two_moment::as
private

Referenced by morr_two_moment_init(), and morr_two_moment_micro().

◆ bact

real(c_double), private module_mp_morr_two_moment::bact
private
225  REAL(C_DOUBLE), PRIVATE :: BACT ! ACTIVATION PARAMETER

Referenced by morr_two_moment_init().

◆ bc

real(c_double), private module_mp_morr_two_moment::bc
private

Referenced by morr_two_moment_init(), morr_two_moment_micro(), and redistribute_term().

◆ bg

real(c_double), private module_mp_morr_two_moment::bg
private

Referenced by AddPertToBckgnd(), morr_two_moment_init(), and morr_two_moment_micro().

◆ bi

real(c_double), private module_mp_morr_two_moment::bi
private
182  REAL(C_DOUBLE), PRIVATE :: BI,BC,BS,BR,BG ! 'B' PARAMETER IN FALLSPEED-DIAM RELATIONSHIP

Referenced by ERF::make_subdomains(), morr_two_moment_init(), and morr_two_moment_micro().

◆ bimm

real(c_double), private module_mp_morr_two_moment::bimm
private
192  REAL(C_DOUBLE), PRIVATE :: BIMM ! PARAMETER IN BIGG IMMERSION FREEZING

Referenced by morr_two_moment_init(), and morr_two_moment_micro().

◆ br

real(c_double), private module_mp_morr_two_moment::br
private

Referenced by morr_two_moment_init(), and morr_two_moment_micro().

◆ bs

real(c_double), private module_mp_morr_two_moment::bs
private

Referenced by morr_two_moment_init(), and morr_two_moment_micro().

◆ c1

real(c_double), private module_mp_morr_two_moment::c1
private
212  REAL(C_DOUBLE), PRIVATE :: C1 ! 'C' IN NCCN = CS^K (CM-3)

Referenced by SatMethods::Bolton_svp_water(), TerminalVelocity< RT >::CloudRainShima(), ComputeStrain_S(), ComputeStrain_T(), ShocPDF::diagnose_pdf(), DiffusionSrcForState_S(), DiffusionSrcForState_T(), interp_trilinear(), morr_two_moment_init(), and plotfile2d::sampled_target_is_bracketed().

◆ cg

real(c_double), private module_mp_morr_two_moment::cg
private

Referenced by morr_two_moment_init().

◆ ci

real(c_double), private module_mp_morr_two_moment::ci
private
203  REAL(C_DOUBLE), PRIVATE :: CI,DI,CS,DS,CG,DG ! SIZE DISTRIBUTION PARAMETERS FOR CLOUD ICE, SNOW, GRAUPEL

Referenced by morr_two_moment_init(), and morr_two_moment_micro().

◆ cons1

real(c_double), private module_mp_morr_two_moment::cons1
private
241  REAL(C_DOUBLE), PRIVATE :: CONS1,CONS2,CONS3,CONS4,CONS5,CONS6,CONS7,CONS8,CONS9,CONS10

Referenced by morr_two_moment_init(), and morr_two_moment_micro().

◆ cons10

real(c_double), private module_mp_morr_two_moment::cons10
private

Referenced by morr_two_moment_init(), and morr_two_moment_micro().

◆ cons11

real(c_double), private module_mp_morr_two_moment::cons11
private
242  REAL(C_DOUBLE), PRIVATE :: CONS11,CONS12,CONS13,CONS14,CONS15,CONS16,CONS17,CONS18,CONS19,CONS20

Referenced by morr_two_moment_init(), and morr_two_moment_micro().

◆ cons12

real(c_double), private module_mp_morr_two_moment::cons12
private

Referenced by morr_two_moment_init(), and morr_two_moment_micro().

◆ cons13

real(c_double), private module_mp_morr_two_moment::cons13
private

Referenced by morr_two_moment_init(), and morr_two_moment_micro().

◆ cons14

real(c_double), private module_mp_morr_two_moment::cons14
private

Referenced by morr_two_moment_init(), and morr_two_moment_micro().

◆ cons15

real(c_double), private module_mp_morr_two_moment::cons15
private

Referenced by morr_two_moment_init(), and morr_two_moment_micro().

◆ cons16

real(c_double), private module_mp_morr_two_moment::cons16
private

Referenced by morr_two_moment_init(), and morr_two_moment_micro().

◆ cons17

real(c_double), private module_mp_morr_two_moment::cons17
private

Referenced by morr_two_moment_init(), and morr_two_moment_micro().

◆ cons18

real(c_double), private module_mp_morr_two_moment::cons18
private

Referenced by morr_two_moment_init(), and morr_two_moment_micro().

◆ cons19

real(c_double), private module_mp_morr_two_moment::cons19
private

Referenced by morr_two_moment_init(), and morr_two_moment_micro().

◆ cons2

real(c_double), private module_mp_morr_two_moment::cons2
private

Referenced by morr_two_moment_init(), and morr_two_moment_micro().

◆ cons20

real(c_double), private module_mp_morr_two_moment::cons20
private

Referenced by morr_two_moment_init(), and morr_two_moment_micro().

◆ cons21

real(c_double), private module_mp_morr_two_moment::cons21
private
243  REAL(C_DOUBLE), PRIVATE :: CONS21,CONS22,CONS23,CONS24,CONS25,CONS26,CONS27,CONS28,CONS29,CONS30

Referenced by morr_two_moment_init(), and morr_two_moment_micro().

◆ cons22

real(c_double), private module_mp_morr_two_moment::cons22
private

Referenced by morr_two_moment_init(), and morr_two_moment_micro().

◆ cons23

real(c_double), private module_mp_morr_two_moment::cons23
private

Referenced by morr_two_moment_init(), and morr_two_moment_micro().

◆ cons24

real(c_double), private module_mp_morr_two_moment::cons24
private

Referenced by morr_two_moment_init(), and morr_two_moment_micro().

◆ cons25

real(c_double), private module_mp_morr_two_moment::cons25
private

Referenced by morr_two_moment_init(), and morr_two_moment_micro().

◆ cons26

real(c_double), private module_mp_morr_two_moment::cons26
private

Referenced by morr_two_moment_init(), and morr_two_moment_micro().

◆ cons27

real(c_double), private module_mp_morr_two_moment::cons27
private

Referenced by morr_two_moment_init(), and morr_two_moment_micro().

◆ cons28

real(c_double), private module_mp_morr_two_moment::cons28
private

Referenced by morr_two_moment_init(), and morr_two_moment_micro().

◆ cons29

real(c_double), private module_mp_morr_two_moment::cons29
private

Referenced by morr_two_moment_init(), and morr_two_moment_micro().

◆ cons3

real(c_double), private module_mp_morr_two_moment::cons3
private

Referenced by morr_two_moment_init(), and morr_two_moment_micro().

◆ cons30

real(c_double), private module_mp_morr_two_moment::cons30
private

Referenced by morr_two_moment_init().

◆ cons31

real(c_double), private module_mp_morr_two_moment::cons31
private
244  REAL(C_DOUBLE), PRIVATE :: CONS31,CONS32,CONS33,CONS34,CONS35,CONS36,CONS37,CONS38,CONS39,CONS40

Referenced by morr_two_moment_init(), and morr_two_moment_micro().

◆ cons32

real(c_double), private module_mp_morr_two_moment::cons32
private

Referenced by morr_two_moment_init(), and morr_two_moment_micro().

◆ cons33

real(c_double), private module_mp_morr_two_moment::cons33
private

Referenced by morr_two_moment_init().

◆ cons34

real(c_double), private module_mp_morr_two_moment::cons34
private

Referenced by morr_two_moment_init(), and morr_two_moment_micro().

◆ cons35

real(c_double), private module_mp_morr_two_moment::cons35
private

Referenced by morr_two_moment_init(), and morr_two_moment_micro().

◆ cons36

real(c_double), private module_mp_morr_two_moment::cons36
private

Referenced by morr_two_moment_init(), and morr_two_moment_micro().

◆ cons37

real(c_double), private module_mp_morr_two_moment::cons37
private

Referenced by morr_two_moment_init(), and morr_two_moment_micro().

◆ cons38

real(c_double), private module_mp_morr_two_moment::cons38
private

Referenced by morr_two_moment_init(), and morr_two_moment_micro().

◆ cons39

real(c_double), private module_mp_morr_two_moment::cons39
private

Referenced by morr_two_moment_init(), and morr_two_moment_micro().

◆ cons4

real(c_double), private module_mp_morr_two_moment::cons4
private

Referenced by morr_two_moment_init(), and morr_two_moment_micro().

◆ cons40

real(c_double), private module_mp_morr_two_moment::cons40
private

Referenced by morr_two_moment_init(), and morr_two_moment_micro().

◆ cons41

real(c_double), private module_mp_morr_two_moment::cons41
private
245  REAL(C_DOUBLE), PRIVATE :: CONS41

Referenced by morr_two_moment_init(), and morr_two_moment_micro().

◆ cons5

real(c_double), private module_mp_morr_two_moment::cons5
private

Referenced by morr_two_moment_init(), and morr_two_moment_micro().

◆ cons6

real(c_double), private module_mp_morr_two_moment::cons6
private

Referenced by morr_two_moment_init(), and morr_two_moment_micro().

◆ cons7

real(c_double), private module_mp_morr_two_moment::cons7
private

Referenced by morr_two_moment_init(), and morr_two_moment_micro().

◆ cons8

real(c_double), private module_mp_morr_two_moment::cons8
private

Referenced by morr_two_moment_init(), and morr_two_moment_micro().

◆ cons9

real(c_double), private module_mp_morr_two_moment::cons9
private

Referenced by morr_two_moment_init(), and morr_two_moment_micro().

◆ cpw

real(c_double), private module_mp_morr_two_moment::cpw
private
208  REAL(C_DOUBLE), PRIVATE :: CPW ! SPECIFIC HEAT OF LIQUID WATER

Referenced by morr_two_moment_init(), and morr_two_moment_micro().

◆ cs

real(c_double), private module_mp_morr_two_moment::cs
private

Referenced by morr_two_moment_init(), Radiation::run_impl(), and ERF::WriteSubvolume().

◆ dcs

real(c_double), private module_mp_morr_two_moment::dcs
private
194  REAL(C_DOUBLE), PRIVATE :: DCS ! THRESHOLD SIZE FOR CLOUD ICE AUTOCONVERSION

Referenced by morr_two_moment_init(), and morr_two_moment_micro().

◆ dg

real(c_double), private module_mp_morr_two_moment::dg
private

Referenced by morr_two_moment_init(), and morr_two_moment_micro().

◆ di

real(c_double), private module_mp_morr_two_moment::di
private

Referenced by morr_two_moment_init(), and morr_two_moment_micro().

◆ ds

real(c_double), private module_mp_morr_two_moment::ds
private

Referenced by morr_two_moment_init(), and morr_two_moment_micro().

◆ eci

real(c_double), private module_mp_morr_two_moment::eci
private
205  REAL(C_DOUBLE), PRIVATE :: ECI ! COLLECTION EFFICIENCY, ICE-DROPLET COLLISIONS

Referenced by morr_two_moment_init().

◆ ecr

real(c_double), private module_mp_morr_two_moment::ecr
private
193  REAL(C_DOUBLE), PRIVATE :: ECR ! COLLECTION EFFICIENCY BETWEEN DROPLETS/RAIN AND SNOW/RAIN

Referenced by morr_two_moment_init().

◆ eii

real(c_double), private module_mp_morr_two_moment::eii
private
204  REAL(C_DOUBLE), PRIVATE :: EII ! COLLECTION EFFICIENCY, ICE-ICE COLLISIONS

Referenced by morr_two_moment_init().

◆ epsm

real(c_double), private module_mp_morr_two_moment::epsm
private
220  REAL(C_DOUBLE), PRIVATE :: EPSM ! AEROSOL SOLUBLE FRACTION

Referenced by morr_two_moment_init().

◆ f11

real(c_double), private module_mp_morr_two_moment::f11
private
232  REAL(C_DOUBLE), PRIVATE :: F11 ! CORRECTION FACTOR FOR ACTIVATION, MODE 1

Referenced by morr_two_moment_init().

◆ f12

real(c_double), private module_mp_morr_two_moment::f12
private
233  REAL(C_DOUBLE), PRIVATE :: F12 ! CORRECTION FACTOR FOR ACTIVATION, MODE 1

Referenced by morr_two_moment_init().

◆ f1r

real(c_double), private module_mp_morr_two_moment::f1r
private
199  REAL(C_DOUBLE), PRIVATE :: F1R ! VENTILATION PARAMETER FOR RAIN

Referenced by morr_two_moment_init(), and morr_two_moment_micro().

◆ f1s

real(c_double), private module_mp_morr_two_moment::f1s
private
197  REAL(C_DOUBLE), PRIVATE :: F1S ! VENTILATION PARAMETER FOR SNOW

Referenced by morr_two_moment_init(), and morr_two_moment_micro().

◆ f21

real(c_double), private module_mp_morr_two_moment::f21
private
234  REAL(C_DOUBLE), PRIVATE :: F21 ! CORRECTION FACTOR FOR ACTIVATION, MODE 2

Referenced by morr_two_moment_init().

◆ f22

real(c_double), private module_mp_morr_two_moment::f22
private
235  REAL(C_DOUBLE), PRIVATE :: F22 ! CORRECTION FACTOR FOR ACTIVATION, MODE 2

Referenced by morr_two_moment_init().

◆ f2r

real(c_double), private module_mp_morr_two_moment::f2r
private
200  REAL(C_DOUBLE), PRIVATE :: F2R ! VENTILATION PARAMETER FOR RAIN

Referenced by morr_two_moment_init(), and morr_two_moment_micro().

◆ f2s

real(c_double), private module_mp_morr_two_moment::f2s
private
198  REAL(C_DOUBLE), PRIVATE :: F2S ! VENTILATION PARAMETER FOR SNOW

Referenced by morr_two_moment_init(), and morr_two_moment_micro().

◆ iact

integer, private module_mp_morr_two_moment::iact
private
118  INTEGER, PRIVATE :: IACT

Referenced by morr_two_moment_init(), morr_two_moment_micro(), and mp_morr_two_moment().

◆ ibase

integer, private module_mp_morr_two_moment::ibase
private
156  INTEGER, PRIVATE :: IBASE

Referenced by morr_two_moment_init().

◆ igraup

integer, private module_mp_morr_two_moment::igraup
private
170  INTEGER, PRIVATE :: IGRAUP

Referenced by morr_two_moment_init(), and morr_two_moment_micro().

◆ ihail

integer, private module_mp_morr_two_moment::ihail
private
177  INTEGER, PRIVATE :: IHAIL

Referenced by morr_two_moment_init().

◆ iliq

integer, private module_mp_morr_two_moment::iliq
private
134  INTEGER, PRIVATE :: ILIQ

Referenced by morr_two_moment_init(), and morr_two_moment_micro().

◆ inuc

integer, private module_mp_morr_two_moment::inuc
private
140  INTEGER, PRIVATE :: INUC

Referenced by morr_two_moment_init(), and morr_two_moment_micro().

◆ inum

integer, private module_mp_morr_two_moment::inum
private
125  INTEGER, PRIVATE :: INUM

Referenced by morr_two_moment_init().

◆ isub

integer, private module_mp_morr_two_moment::isub
private
164  INTEGER, PRIVATE :: ISUB

Referenced by ERF::ErrorEst(), TurbulentPerturbation::init_tpi(), morr_two_moment_init(), ERF::project_momenta(), and ERF::WriteSubvolume().

◆ k1

real(c_double), private module_mp_morr_two_moment::k1
private
213  REAL(C_DOUBLE), PRIVATE :: K1 ! 'K' IN NCCN = CS^K

Referenced by ERF::advance_dycore(), interp_trilinear(), make_mom_sources(), morr_two_moment_init(), TerrainIF::operator()(), TerminalVelocity< RT >::RogersYau(), and writeNCPlotFile().

◆ lammaxg

real(c_double), private module_mp_morr_two_moment::lammaxg
private

Referenced by morr_two_moment_init(), and morr_two_moment_micro().

◆ lammaxi

real(c_double), private module_mp_morr_two_moment::lammaxi
private
237  REAL(C_DOUBLE), PRIVATE :: LAMMAXI,LAMMINI,LAMMAXR,LAMMINR,LAMMAXS,LAMMINS,LAMMAXG,LAMMING

Referenced by morr_two_moment_init(), and morr_two_moment_micro().

◆ lammaxr

real(c_double), private module_mp_morr_two_moment::lammaxr
private

Referenced by morr_two_moment_init(), and morr_two_moment_micro().

◆ lammaxs

real(c_double), private module_mp_morr_two_moment::lammaxs
private

Referenced by morr_two_moment_init(), and morr_two_moment_micro().

◆ lamming

real(c_double), private module_mp_morr_two_moment::lamming
private

Referenced by morr_two_moment_init(), and morr_two_moment_micro().

◆ lammini

real(c_double), private module_mp_morr_two_moment::lammini
private

Referenced by morr_two_moment_init(), and morr_two_moment_micro().

◆ lamminr

real(c_double), private module_mp_morr_two_moment::lamminr
private

Referenced by morr_two_moment_init(), and morr_two_moment_micro().

◆ lammins

real(c_double), private module_mp_morr_two_moment::lammins
private

Referenced by morr_two_moment_init(), and morr_two_moment_micro().

◆ ma

real(c_double), private module_mp_morr_two_moment::ma
private
223  REAL(C_DOUBLE), PRIVATE :: MA ! MOLECULAR WEIGHT OF 'AIR' (KG/MOL)

Referenced by morr_two_moment_init(), and reduce_to_max_per_height().

◆ map

real(c_double), private module_mp_morr_two_moment::map
private
222  REAL(C_DOUBLE), PRIVATE :: MAP ! MOLECULAR WEIGHT AEROSOL (KG/MOL)

Referenced by morr_two_moment_init().

◆ mg0

real(c_double), private module_mp_morr_two_moment::mg0
private
196  REAL(C_DOUBLE), PRIVATE :: MG0 ! MASS OF EMBRYO GRAUPEL

Referenced by morr_two_moment_init(), and morr_two_moment_micro().

◆ mi0

real(c_double), private module_mp_morr_two_moment::mi0
private
195  REAL(C_DOUBLE), PRIVATE :: MI0 ! INITIAL SIZE OF NUCLEATED CRYSTAL

Referenced by morr_two_moment_init(), and morr_two_moment_micro().

◆ mmult

real(c_double), private module_mp_morr_two_moment::mmult
private
236  REAL(C_DOUBLE), PRIVATE :: MMULT ! MASS OF SPLINTERED ICE PARTICLE

Referenced by morr_two_moment_init(), and morr_two_moment_micro().

◆ mw

real(c_double), private module_mp_morr_two_moment::mw
private
217  REAL(C_DOUBLE), PRIVATE :: MW ! MOLECULAR WEIGHT WATER (KG/MOL)

Referenced by morr_two_moment_init().

◆ nanew1

real(c_double), private module_mp_morr_two_moment::nanew1
private
228  REAL(C_DOUBLE), PRIVATE :: NANEW1 ! TOTAL AEROSOL CONCENTRATION, MODE 1 (M^-3)

Referenced by morr_two_moment_init(), and morr_two_moment_micro().

◆ nanew2

real(c_double), private module_mp_morr_two_moment::nanew2
private
229  REAL(C_DOUBLE), PRIVATE :: NANEW2 ! TOTAL AEROSOL CONCENTRATION, MODE 2 (M^-3)

Referenced by morr_two_moment_init(), and morr_two_moment_micro().

◆ ndcnst

real(c_double), private module_mp_morr_two_moment::ndcnst
private
128  REAL(C_DOUBLE), PRIVATE :: NDCNST

Referenced by morr_two_moment_init(), morr_two_moment_micro(), and set_morrison_ndcnst().

◆ osm

real(c_double), private module_mp_morr_two_moment::osm
private
218  REAL(C_DOUBLE), PRIVATE :: OSM ! OSMOTIC COEFFICIENT

Referenced by morr_two_moment_init().

◆ pi

real(c_double), parameter, private module_mp_morr_two_moment::pi = 3.1415926535897932384626434D0
private
100  REAL(C_DOUBLE), PARAMETER :: PI = 3.1415926535897932384626434d0

Referenced by WSM6::Advance(), compute_max_reflectivity_dbz(), erf_cloud_chamber::deterministic_perturbation(), ERF::erf_enforce_hse(), gamma(), ERF::initHSE(), morr_two_moment_init(), morr_two_moment_micro(), wrf_gamma(), wsm6_nislfv_rain_plm6_scratch(), and wsm6_nislfv_rain_plm_scratch().

◆ qsmall

real(c_double), private module_mp_morr_two_moment::qsmall
private
202  REAL(C_DOUBLE), PRIVATE :: QSMALL ! SMALLEST ALLOWED HYDROMETEOR MIXING RATIO

Referenced by morr_two_moment_init(), and morr_two_moment_micro().

◆ rhoa

real(c_double), private module_mp_morr_two_moment::rhoa
private
221  REAL(C_DOUBLE), PRIVATE :: RHOA ! AEROSOL BULK DENSITY (KG/M3)

Referenced by morr_two_moment_init().

◆ rhog

real(c_double), private module_mp_morr_two_moment::rhog
private
190  REAL(C_DOUBLE), PRIVATE :: RHOG ! BULK DENSITY OF GRAUPEL

◆ rhoi

real(c_double), private module_mp_morr_two_moment::rhoi
private
188  REAL(C_DOUBLE), PRIVATE :: RHOI ! BULK DENSITY OF CLOUD ICE

Referenced by make_sources(), and morr_two_moment_init().

◆ rhosn

real(c_double), private module_mp_morr_two_moment::rhosn
private
189  REAL(C_DOUBLE), PRIVATE :: RHOSN ! BULK DENSITY OF SNOW

Referenced by morr_two_moment_init(), and morr_two_moment_micro().

◆ rhosu

real(c_double), private module_mp_morr_two_moment::rhosu
private
186  REAL(C_DOUBLE), PRIVATE :: RHOSU ! STANDARD AIR DENSITY AT 850 MB

Referenced by morr_two_moment_init(), and morr_two_moment_micro().

◆ rhow

real(c_double), private module_mp_morr_two_moment::rhow
private
187  REAL(C_DOUBLE), PRIVATE :: RHOW ! DENSITY OF LIQUID WATER

Referenced by morr_two_moment_init(), and morr_two_moment_micro().

◆ rin

real(c_double), private module_mp_morr_two_moment::rin
private
206  REAL(C_DOUBLE), PRIVATE :: RIN ! RADIUS OF CONTACT NUCLEI (M)

Referenced by morr_two_moment_init(), and morr_two_moment_micro().

◆ rm1

real(c_double), private module_mp_morr_two_moment::rm1
private
226  REAL(C_DOUBLE), PRIVATE :: RM1 ! GEOMETRIC MEAN RADIUS, MODE 1 (M)

Referenced by morr_two_moment_init().

◆ rm2

real(c_double), private module_mp_morr_two_moment::rm2
private
227  REAL(C_DOUBLE), PRIVATE :: RM2 ! GEOMETRIC MEAN RADIUS, MODE 2 (M)

Referenced by morr_two_moment_init().

◆ rr

real(c_double), private module_mp_morr_two_moment::rr
private
224  REAL(C_DOUBLE), PRIVATE :: RR ! UNIVERSAL GAS CONSTANT

Referenced by init_zlevels(), morr_two_moment_init(), ERF::read_box_for_refinement(), ERF::Write3DPlotFile(), and ERF::WriteMultiLevelPlotfileWithTerrain().

◆ sig1

real(c_double), private module_mp_morr_two_moment::sig1
private
230  REAL(C_DOUBLE), PRIVATE :: SIG1 ! STANDARD DEVIATION OF AEROSOL S.D., MODE 1

Referenced by morr_two_moment_init().

◆ sig2

real(c_double), private module_mp_morr_two_moment::sig2
private
231  REAL(C_DOUBLE), PRIVATE :: SIG2 ! STANDARD DEVIATION OF AEROSOL S.D., MODE 2

Referenced by morr_two_moment_init().

◆ vi

real(c_double), private module_mp_morr_two_moment::vi
private
219  REAL(C_DOUBLE), PRIVATE :: VI ! NUMBER OF ION DISSOCIATED IN SOLUTION

Referenced by polygon_::define(), and morr_two_moment_init().

◆ xxx

real(c_double), parameter, private module_mp_morr_two_moment::xxx = 0.9189385332046727417803297D0
private
101  REAL(C_DOUBLE), PARAMETER :: xxx = 0.9189385332046727417803297d0

Referenced by gamma().