source: LMDZ5/trunk/libf/phymar/col2box.F90 @ 3847

Last change on this file since 3847 was 2089, checked in by Laurent Fairhead, 10 years ago

Inclusion de la physique de MAR


Integration of MAR physics

File size: 3.8 KB
RevLine 
[2089]1SUBROUTINE COL2BOX &
2 & (KIDIA, KFDIA, KLON, KLEV, KBOX, KOVLP &
3 & , PCLFR, PCLBX &
4 & )
5!
6!* Subdivide a column of cloud parameters in a set of homogeneous boxes
7!
8!     from C.Jakob and S.A. Klein
9!
10!-----------------------------------------------------------------------
11
12#include "tsmbkind.h"
13
14INTEGER_M :: KIDIA
15INTEGER_M :: KFDIA
16INTEGER_M :: KLON
17INTEGER_M :: KLEV
18INTEGER_M :: KBOX
19INTEGER_M :: KOVLP
20
21REAL_B :: PCLFR(KLON,KLEV)
22REAL_B :: PCLBX(KLON,100,KLEV)
23           
24!-- local
25     
26INTEGER_M :: IABOX(KLON,KBOX), IABOXM1(KLON,KBOX), IABOXINT(KLON,KBOX)
27INTEGER_M :: IBOXTYPE1(KLON), IBOXTYPE2(KLON), IBOXTYPE3(KLON)
28INTEGER_M :: ISUMBOX(KBOX), ISUMBOXM1(KBOX)
29
30REAL_B :: ZTCC(KLON)     
31       
32                 
33ZBOXWIDTH=1./FLOAT(KBOX)
34ZAMIN =1.E-03
35ZEPSEC=1.E-06
36     
37DO JB=1,KBOX
38  DO JL=KIDIA,KFDIA
39    IABOXINT(JL,JB)=0
40    IABOXM1 (JL,JB)=0
41    IABOX   (JL,JB)=0
42  END DO
43END DO
44DO JL=KIDIA,KFDIA
45  ZTCC(JL)     =_ZERO_
46  ISUMBOX(JL)  =_ZERO_
47  ISUMBOXM1(JL)=_ZERO_
48END DO                             
49                                           
50                                                               
51DO JK=1,KLEV
52!
53  IF (JK.GT.1) THEN
54    DO JB=1,KBOX
55      DO JL=KIDIA,KFDIA
56        IABOXM1(JL,JB)=IABOX(JL,JB)
57        ISUMBOXM1(JL)=ISUMBOXM1(JL)+IABOX(JL,JB)
58        IABOX(JL,JB)=0
59      END DO
60    END DO
61  END IF
62     
63  DO JL=KIDIA,KFDIA
64    ITCCM1=NINT(REAL(KBOX)*ZTCC(JL))           
65    IF (ZTCC(JL).GT.ZAMIN .AND. ZTCC(JL).LT._HALF_*ZBOXWIDTH) THEN
66      ITCCM1=1
67    END IF
68!
69!-- various cloud overlap assumptions
70!
71    IF (JK.GT.1) THEN
72!
73!-- maximum-random
74!       
75      IF (KOVLP.EQ.1) THEN
76        ZTCC(JL) = _ONE_ - ( (_ONE_-ZTCC(JL)) &
77         &      *(_ONE_ -MAX( PCLFR(JL,JK)  , PCLFR(JL,JK-1))) &
78         &      /(_ONE_ -MIN( PCLFR(JL,JK-1), _ONE_-ZEPSEC))  )
79!
80!-- maximum
81!       
82      ELSE IF (KOVLP.EQ.2) THEN
83        ZTCC(JL)=MAX(ZTCC(JL),PCLFR(JL,JK))
84!
85!-- random
86!       
87      ELSE IF (KOVLP.EQ.3) THEN
88        ZTCC(JL)=_ONE_-(_ONE_-ZTCC(JL))*(_ONE_-PCLFR(JL,JK))
89      END IF
90!
91    ELSE
92      ZTCC(JL)=PCLFR(JL,JK)
93    END IF
94!
95    ITCC=NINT(REAL(KBOX)*ZTCC(JL))
96    IF (ZTCC(JL).GT.ZAMIN .AND. ZTCC(JL).LT. _HALF_*ZBOXWIDTH) THEN
97      ITCC=1
98    END IF
99    IAM1=ISUMBOXM1(JL)
100    IA=NINT(REAL(KBOX)*PCLFR(JL,JK))
101    IF (PCLFR(JL,JK).GT.ZAMIN &
102      &       .AND. PCLFR(JL,JK).LT. _HALF_*ZBOXWIDTH) THEN       
103      IA=1
104    END IF
105!     
106    IBOXTYPE1(JL)=ITCC-ITCCM1
107!     IF (KOVLP.NE.3) THEN
108    IBOXTYPE2(JL)=MIN( IAM1, IA-IBOXTYPE1(JL))
109!     ELSE
110!       IBOXTYPE2(JL)=NINT( FLOAT(IAM1)*FLOAT(IA-IBOXTYPE1(JL))
111!     &                    /MAX(FLOAT(ITCCM1), ZEPSEC) )
112!     END IF       
113    IBOXTYPE3(JL)=IA - IBOXTYPE1(JL)-IBOXTYPE2(JL)
114  END DO
115!
116  DO JB=1,KBOX
117    DO JL=KIDIA,KFDIA
118      IF (IABOXINT(JL,JB).EQ.0) THEN
119        IF (IBOXTYPE1(JL).GT.0) THEN
120          IABOX(JL,JB)=1
121          IABOXINT(JL,JB)=1
122          IBOXTYPE1(JL)=IBOXTYPE1(JL)-1
123        END IF
124      ELSE
125        IF (IABOXM1(JL,JB).EQ.1) THEN
126          IF (IBOXTYPE2(JL).GT.0) THEN
127            IABOX(JL,JB)=1
128            IBOXTYPE2(JL)=IBOXTYPE2(JL)-1
129          END IF
130        ELSE
131          IF (IBOXTYPE3(JL).GT.0) THEN
132            IABOX(JL,JB)=1
133            IBOXTYPE3(JL)=IBOXTYPE3(JL)-1
134          END IF
135        END IF
136      END IF
137    END DO
138  END DO
139!     
140  DO JB=1,KBOX
141    DO JL=KIDIA,KFDIA
142      IF (JB.EQ.1) THEN
143        IBOXTYPE1(JL)=IBOXTYPE1(JL)+IBOXTYPE2(JL)+IBOXTYPE3(JL)
144      END IF
145      IF (IABOX(JL,JB).EQ.0 .AND. IBOXTYPE1(JL).GT.0) THEN
146        IABOX(JL,JB)=1
147        IBOXTYPE1(JL)=IBOXTYPE1(JL)-1
148      END IF
149      ISUMBOX(JL)=ISUMBOX(JL)+IABOX(JL,JB)
150    END DO             
151  END DO
152  DO JL=KIDIA,KFDIA
153    if (JK.GE.21) THEN
154      PRINT 9001,(IABOX(JL,JB),JB=1,KBOX)
155    end if 
156    DO JB=1,KBOX
157      PCLBX(JL,JB,JK)=FLOAT(IABOX(JL,JB))
158    END DO 
1599001 FORMAT(1X,100I1)       
160  END DO
161     
162END DO
163     
164RETURN
165END SUBROUTINE COL2BOX
Note: See TracBrowser for help on using the repository browser.