UPP  V11.0.0
 All Data Structures Files Functions Pages
CALWXT_EXPLICIT.f
1  SUBROUTINE calwxt_explicit_post(LMH,THS,PMID,PREC,SR,F_RIMEF,IWX)
2 !
3 ! FILE: CALWXT.f
4 ! WRITTEN: 24 AUGUST 2005, G MANIKIN and B FERRIER
5 !
6 ! ROUTINE TO COMPUTE PRECIPITATION TYPE USING EXPLICIT FIELDS
7 ! FROM THE MODEL MICROPHYSICS
8 !
9 ! PROGRAM HISTORY LOG:
10 ! 21-10-31 JESSE MENG - 2D DECOMPOSITION
11 
12  use params_mod, only: p1000, capa
13  use ctlblk_mod, only: jsta, jend, modelname, pthresh, im, jsta_2l, &
14  jend_2u, lm, ista, iend, ista_2l, iend_2u
15 !- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
16  implicit none
17 !
18 ! LIST OF VARIABLES NEEDED
19 ! PARAMETERS:
20 !
21 ! INPUT:
22  real,dimension(ista_2l:iend_2u,jsta_2l:jend_2u,lm),intent(in) :: f_rimef, pmid
23  REAL,dimension(ista_2l:iend_2u,jsta_2l:jend_2u), intent(in) :: lmh, prec, ths, sr
24  integer,dimension(ista:iend,jsta:jend), intent(inout) :: iwx
25  integer i,j,lmhk
26  real psfc,tskin,snow
27 !
28 ! ALLOCATE LOCAL STORAGE
29 !
30 !$omp parallel do private(i,j)
31  DO j=jsta,jend
32  DO i=ista,iend
33  iwx(i,j) = 0
34  ENDDO
35  ENDDO
36 
37 !
38 !$omp parallel do private(j,i,lmhk,psfc,tskin)
39  DO j=jsta,jend
40  DO i=ista,iend
41  lmhk=lmh(i,j)
42 !
43 ! SKIP THIS POINT IF NO PRECIP THIS TIME STEP
44 !
45  IF (prec(i,j) <= pthresh) cycle
46 !
47 ! A SNOW RATIO LESS THAN 0.5 ELIMINATES SNOW AND SLEET
48 ! USE THE SKIN TEMPERATURE TO DISTINGUISH RAIN FROM FREEZING RAIN
49 ! NOTE THAT 2-M TEMPERATURE MAY BE A BETTER CHOICE IF THE MODEL
50 ! HAS A COLD BIAS FOR SKIN TEMPERATURE
51 !
52  IF (sr(i,j) < 0.5) THEN
53 ! SURFACE (SKIN) POTENTIAL TEMPERATURE AND TEMPERATURE.
54  psfc = pmid(i,j,lmhk)
55  tskin = ths(i,j)*(psfc/p1000)**capa
56 
57  IF (tskin < 273.15) THEN
58 ! FREEZING RAIN = 4
59  iwx(i,j) = iwx(i,j)+4
60  ELSE
61 ! RAIN = 8
62  iwx(i,j) = iwx(i,j)+8
63  ENDIF
64  ELSE
65 !
66 ! DISTINGUISH SNOW FROM SLEET WITH THE RIME FACTOR
67 !
68  IF(f_rimef(i,j,lmhk) >= 10) THEN
69 ! SLEET = 2
70  iwx(i,j) = iwx(i,j)+2
71  ELSE
72 ! SNOW = 1
73  iwx(i,j) = iwx(i,j)+1
74  ENDIF
75  ENDIF
76  enddo
77  enddo
78 !
79  RETURN
80  END