1 | SUBROUTINE cv3_crit(nloc, ncum, nd, icb, inb, p, ph, pzero, v, threshold, & |
---|
2 | kcrit, pcrit) |
---|
3 | ! ************************************************************** |
---|
4 | ! * |
---|
5 | ! CV3_CRIT Find pressure level where vertical profile of * |
---|
6 | ! variable 'v' intersects 'threshold' * |
---|
7 | ! * |
---|
8 | ! written by : FROHWIRTH Julie, 13/08/2003, 21.55.12 * |
---|
9 | ! modified by : * |
---|
10 | ! ************************************************************** |
---|
11 | |
---|
12 | |
---|
13 | include "cv3param.h" |
---|
14 | |
---|
15 | ! input: |
---|
16 | INTEGER ncum, nd, nloc |
---|
17 | INTEGER icb(nloc), inb(nloc) |
---|
18 | REAL p(nloc, nd), ph(nloc, nd+1) |
---|
19 | REAL pzero(nloc) |
---|
20 | REAL v(nloc, nd), threshold |
---|
21 | |
---|
22 | ! output: |
---|
23 | INTEGER kcrit(nloc) |
---|
24 | REAL pcrit(nloc) |
---|
25 | |
---|
26 | ! local variables |
---|
27 | INTEGER i, j, k, il |
---|
28 | LOGICAL ok(nloc) |
---|
29 | |
---|
30 | DO il = 1, ncum |
---|
31 | ok(il) = .TRUE. |
---|
32 | pcrit(il) = -1. |
---|
33 | kcrit(il) = 0 |
---|
34 | END DO |
---|
35 | |
---|
36 | DO i = 1, nl |
---|
37 | DO il = 1, ncum |
---|
38 | IF (i>icb(il) .AND. i<=inb(il)) THEN |
---|
39 | IF (p(il,i)<=pzero(il) .AND. ok(il)) THEN |
---|
40 | IF ((v(il,i)-threshold)*(v(il,i-1)-threshold)<0.) THEN |
---|
41 | pcrit(il) = ((threshold-v(il,i))*p(il,i-1)-(threshold-v(il, & |
---|
42 | i-1))*p(il,i))/(v(il,i-1)-v(il,i)) |
---|
43 | IF (pcrit(il)>pzero(il)) THEN |
---|
44 | pcrit(il) = -1. |
---|
45 | ELSE |
---|
46 | ok(il) = .FALSE. |
---|
47 | kcrit(il) = i |
---|
48 | IF (pcrit(il)<ph(il,i)) kcrit(il) = kcrit(il) + 1 |
---|
49 | END IF |
---|
50 | END IF ! end IF (v(i) ... |
---|
51 | END IF ! end IF (P(i) ... |
---|
52 | END IF ! end IF (icb+1 le i le inb) |
---|
53 | END DO |
---|
54 | END DO |
---|
55 | |
---|
56 | |
---|
57 | RETURN |
---|
58 | END SUBROUTINE cv3_crit |
---|