UPP (develop)
Loading...
Searching...
No Matches
CALWXT_DOMINANT.f
1 SUBROUTINE calwxt_dominant_post(PREC,RAIN,FREEZR,SLEET,SNOW, &
2 & DOMR,DOMZR,DOMIP,DOMS)
3!
4! WRITTEN: 24 AUGUST 2005, G MANIKIN
5!
6! PROGRAM HISTORY LOG:
7! 21-10-31 JESSE MENG - 2D DECOMPOSITION
8!
9! THIS ROUTINE TAKES THE PRECIP TYPE SOLUTIONS FROM DIFFERENT
10! ALGORITHMS AND SUMS THEM UP TO GIVE A DOMINANT TYPE
11!
12! use params_mod
13 use ctlblk_mod, only: jsta, jend, pthresh, im, jsta_2l, jend_2u, &
14 ista, iend, ista_2l, iend_2u
15! use ctlblk_mod
16!- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
17 implicit none
18!
19 integer,PARAMETER :: NALG=5
20! INPUT:
21 REAL PREC(ista_2l:iend_2u,jsta_2l:jend_2u)
22 real,DIMENSION(ista:iend,jsta:jend), intent(inout) :: DOMS,DOMR,DOMZR,DOMIP
23 real,DIMENSION(ista:iend,jsta:jend,NALG),intent(in) :: RAIN,SNOW,SLEET,FREEZR
24 integer I,J,L
25 real TOTSN,TOTIP,TOTR,TOTZR
26!--------------------------------------------------------------------------
27!$omp parallel do private(i,j)
28 DO j=jsta,jend
29 DO i=ista,iend
30 domr(i,j) = 0.
31 doms(i,j) = 0.
32 domzr(i,j) = 0.
33 domip(i,j) = 0.
34 ENDDO
35 ENDDO
36!
37!$omp parallel do private(i,j,totsn,totip,totr,totzr)
38 DO j=jsta,jend
39 DO i=ista,iend
40! SKIP THIS POINT IF NO PRECIP THIS TIME STEP
41 IF (prec(i,j) <= pthresh) cycle
42 totsn = 0
43 totip = 0
44 totr = 0
45 totzr = 0
46! LOOP OVER THE NUMBER OF DIFFERENT ALGORITHMS THAT ARE USED
47 DO l = 1, nalg
48 IF (rain(i,j,l) > 0) THEN
49 totr = totr + 1
50 cycle
51 ENDIF
52
53 IF (snow(i,j,l) > 0) THEN
54 totsn = totsn + 1
55 cycle
56 ENDIF
57
58 IF (sleet(i,j,l) > 0) THEN
59 totip = totip + 1
60 cycle
61 ENDIF
62
63 IF (freezr(i,j,l) > 0) THEN
64 totzr = totzr + 1
65 ENDIF
66 enddo
67
68! TIES ARE BROKEN TO FAVOR THE MOST DANGEROUS FORM OF PRECIP
69! FREEZING RAIN > SNOW > SLEET > RAIN
70 IF (totsn > totip) THEN
71 IF (totsn > totzr) THEN
72 IF (totsn >= totr) THEN
73 doms(i,j) = 1
74 ELSE
75 domr(i,j) = 1
76 ENDIF
77 ELSE IF (totzr >= totr) THEN
78 domzr(i,j) = 1
79 ELSE
80 domr(i,j) = 1
81 ENDIF
82 ELSE IF (totip > totzr) THEN
83 IF (totip >= totr) THEN
84 domip(i,j) = 1
85 ELSE
86 domr(i,j) = 1
87 ENDIF
88 ELSE IF (totzr >= totr) THEN
89 domzr(i,j) = 1
90 ELSE
91 domr(i,j) = 1
92 ENDIF
93 enddo
94 enddo
95!
96 RETURN
97 END