[3331] | 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 |
---|