1 | SUBROUTINE CV3_CRIT (nloc,ncum,nd,icb,inb,p,ph,pzero |
---|
2 | $ ,v,threshold,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 | c 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 | c output: |
---|
23 | integer kcrit(nloc) |
---|
24 | real pcrit(nloc) |
---|
25 | |
---|
26 | c 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 | enddo |
---|
35 | c |
---|
36 | DO i = 1,nl |
---|
37 | DO il = 1,ncum |
---|
38 | IF (i .GT. icb(il) .AND. i .LE. inb(il)) THEN |
---|
39 | IF (P(il,i) .LE. Pzero(il) .AND. ok(il)) THEN |
---|
40 | IF ( (v(il,i)-threshold)*(v(il,i-1)-threshold) .LT. 0.) THEN |
---|
41 | pcrit(il) = |
---|
42 | $ ((threshold-v(il,i))*P(il,i-1)- |
---|
43 | $ (threshold-v(il,i-1))*P(il,i)) |
---|
44 | $ /(v(il,i-1)-v(il,i)) |
---|
45 | IF (pcrit(il) .gt. Pzero(il)) THEN |
---|
46 | pcrit(il) = -1. |
---|
47 | ELSE |
---|
48 | ok(il) = .false. |
---|
49 | kcrit(il) = i |
---|
50 | IF (pcrit(il) .LT. PH(il,i)) kcrit(il) = kcrit(il)+1 |
---|
51 | ENDIF |
---|
52 | ENDIF ! end IF (v(i) ... |
---|
53 | ENDIF ! end IF (P(i) ... |
---|
54 | ENDIF ! end IF (icb+1 le i le inb) |
---|
55 | ENDDO |
---|
56 | ENDDO |
---|
57 | 125 CONTINUE |
---|
58 | |
---|
59 | |
---|
60 | RETURN |
---|
61 | END |
---|