[1992] | 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 | ! ************************************************************** |
---|
[879] | 11 | |
---|
[3319] | 12 | IMPLICIT NONE |
---|
[879] | 13 | |
---|
[1992] | 14 | include "cv3param.h" |
---|
[879] | 15 | |
---|
[1992] | 16 | ! input: |
---|
| 17 | INTEGER ncum, nd, nloc |
---|
| 18 | INTEGER icb(nloc), inb(nloc) |
---|
| 19 | REAL p(nloc, nd), ph(nloc, nd+1) |
---|
| 20 | REAL pzero(nloc) |
---|
| 21 | REAL v(nloc, nd), threshold |
---|
[879] | 22 | |
---|
[1992] | 23 | ! output: |
---|
| 24 | INTEGER kcrit(nloc) |
---|
| 25 | REAL pcrit(nloc) |
---|
[879] | 26 | |
---|
[1992] | 27 | ! local variables |
---|
| 28 | INTEGER i, j, k, il |
---|
| 29 | LOGICAL ok(nloc) |
---|
[879] | 30 | |
---|
[1992] | 31 | DO il = 1, ncum |
---|
| 32 | ok(il) = .TRUE. |
---|
| 33 | pcrit(il) = -1. |
---|
| 34 | kcrit(il) = 0 |
---|
| 35 | END DO |
---|
[879] | 36 | |
---|
[1992] | 37 | DO i = 1, nl |
---|
| 38 | DO il = 1, ncum |
---|
| 39 | IF (i>icb(il) .AND. i<=inb(il)) THEN |
---|
| 40 | IF (p(il,i)<=pzero(il) .AND. ok(il)) THEN |
---|
| 41 | IF ((v(il,i)-threshold)*(v(il,i-1)-threshold)<0.) THEN |
---|
| 42 | pcrit(il) = ((threshold-v(il,i))*p(il,i-1)-(threshold-v(il, & |
---|
| 43 | i-1))*p(il,i))/(v(il,i-1)-v(il,i)) |
---|
| 44 | IF (pcrit(il)>pzero(il)) THEN |
---|
| 45 | pcrit(il) = -1. |
---|
| 46 | ELSE |
---|
| 47 | ok(il) = .FALSE. |
---|
| 48 | kcrit(il) = i |
---|
| 49 | IF (pcrit(il)<ph(il,i)) kcrit(il) = kcrit(il) + 1 |
---|
| 50 | END IF |
---|
| 51 | END IF ! end IF (v(i) ... |
---|
| 52 | END IF ! end IF (P(i) ... |
---|
| 53 | END IF ! end IF (icb+1 le i le inb) |
---|
| 54 | END DO |
---|
| 55 | END DO |
---|
| 56 | |
---|
| 57 | |
---|
| 58 | RETURN |
---|
| 59 | END SUBROUTINE cv3_crit |
---|