/[MITgcm]/MITgcm_contrib/jscott/igsm/src/drycnv.F
ViewVC logotype

Annotation of /MITgcm_contrib/jscott/igsm/src/drycnv.F

Parent Directory Parent Directory | Revision Log Revision Log | View Revision Graph Revision Graph


Revision 1.1 - (hide annotations) (download)
Fri Aug 11 19:35:30 2006 UTC (18 years, 11 months ago) by jscott
Branch: MAIN
CVS Tags: HEAD
atm2d package

1 jscott 1.1
2     #include "ctrparam.h"
3    
4     ! ==========================================================
5     !
6     ! DRYCNV.F: THIS SUBROUTINE MIXES AIR CAUSED BY DRY
7     ! CONVECTION. SINCE DRY CONVECTION IN THE
8     ! BOUNDARY LAYER IS DONE IN SUBROUTINE SURFCE,
9     ! THIS ROUTINE ONLY CHECKS LAYERS 2 TO LM.
10     !
11     ! ----------------------------------------------------------
12     !
13     ! Author of Chemistry Modules: Chien Wang
14     !
15     ! ----------------------------------------------------------
16     !
17     ! Revision History:
18     !
19     ! When Who What
20     ! ---- ---------- -------
21     ! 073100 Chien Wang repack based on CliChem3 and add cpp
22     ! 092301 Chien Wang add bc and oc
23     !
24     ! ==========================================================
25    
26    
27     SUBROUTINE DRYCNV 7501.
28    
29     C**** 7502.
30     C**** THIS SUBROUTINE MIXES AIR CAUSED BY DRY CONVECTION. SINCE DRY 7503.
31     C**** CONVECTION IN THE BOUNDARY LAYER IS DONE IN SUBROUTINE SURFCE, 7504.
32     C**** THIS ROUTINE ONLY CHECKS LAYERS 2 TO LM. 7505.
33     C**** 7506.
34    
35     #if ( defined CPL_CHEM )
36     !
37     #include "chem_para"
38     #include "chem_com"
39     !
40     #endif
41    
42     #include "BD2G04.COM" 7507.
43    
44     COMMON U,V,T,P,Q 7508.
45     COMMON/WORK1/CONV(IM0,JM0,LM0),PK(IM0,JM0,LM0) 7509.
46     COMMON/WORK2/UT(IM0,JM0,LM0),VT(IM0,JM0,LM0), 7510.
47     * RA(8),ID(8),UMS(8) 7511.
48     LOGICAL POLE 7512.
49     C DATA RVAP/461.5/ 7513.
50     RVX=0. 7514.
51     C**** LOAD U,V INTO UT,VT. UT,VT WILL BE FIXED DURING DRY CONVECTION 7515.
52     C**** WHILE U,V WILL BE UPDATED. 7516.
53     DO 50 L=1,LM 7517.
54     DO 50 J=2,JM 7518.
55     DO 50 I=1,IM 7519.
56     UT(I,J,L)=U(I,J,L) 7520.
57     50 VT(I,J,L)=V(I,J,L) 7521.
58     C**** OUTSIDE LOOPS OVER J AND I 7522.
59     DO 500 J=1,JM 7523.
60     POLE=.FALSE. 7524.
61     IF(J.EQ.1.OR.J.EQ.JM) POLE=.TRUE. 7525.
62     IMAX=IM 7526.
63     IF(POLE) IMAX=IM 7527.
64     DO 120 K=1,2 7528.
65     RA(K)=RAPVS(J) 7529.
66     120 RA(K+2)=RAPVN(J) 7530.
67     IM1=IM 7531.
68     DO 500 I=1,IMAX 7532.
69     LMAX=1 7533.
70     130 LMIN=LMAX+1 7534.
71     IF(LMIN.GE.LM) GO TO 500 7535.
72     LMAX=LMIN 7536.
73     IF(T(I,J,LMIN)*(1.+Q(I,J,LMIN)*RVX).LE. 7537.
74     * T(I,J,LMIN+1)*(1.+Q(I,J,LMIN+1)*RVX)) GO TO 130 7538.
75     C**** MIX HEAT AND MOISTURE THROUGHOUT THE UNSTABLE LAYERS 7539.
76     PKMS=PK(I,J,LMIN)*DSIG(LMIN)+PK(I,J,LMIN+1)*DSIG(LMIN+1) 7540.
77     THPKMS=T(I,J,LMIN)*(PK(I,J,LMIN)*DSIG(LMIN)) 7541.
78     * +T(I,J,LMIN+1)*(PK(I,J,LMIN+1)*DSIG(LMIN+1)) 7542.
79     QMS=Q(I,J,LMIN)*DSIG(LMIN)+Q(I,J,LMIN+1)*DSIG(LMIN+1) 7543.
80    
81     #if ( defined CPL_CHEM )
82     !
83     ! --- 032395
84     ! sigma of mixing ratios:
85     !
86     cfc11ms=cfc11(i,j,lmin) *dsig(lmin)
87     & +cfc11(i,j,lmin+1)*dsig(lmin+1)
88    
89     cfc12ms=cfc12(i,j,lmin) *dsig(lmin)
90     & +cfc12(i,j,lmin+1)*dsig(lmin+1)
91    
92     xn2oms =xn2o(i,j,lmin) *dsig(lmin)
93     & +xn2o(i,j,lmin+1)*dsig(lmin+1)
94    
95     o3ms =o3(i,j,lmin) *dsig(lmin)
96     & +o3(i,j,lmin+1)*dsig(lmin+1)
97    
98     coms =co(i,j,lmin) *dsig(lmin)
99     & +co(i,j,lmin+1)*dsig(lmin+1)
100    
101     zco2ms =zco2(i,j,lmin) *dsig(lmin)
102     & +zco2(i,j,lmin+1)*dsig(lmin+1)
103    
104     xnoms =xno(i,j,lmin) *dsig(lmin)
105     & +xno(i,j,lmin+1)*dsig(lmin+1)
106    
107     xno2ms =xno2(i,j,lmin) *dsig(lmin)
108     & +xno2(i,j,lmin+1)*dsig(lmin+1)
109    
110     xn2o5ms=xn2o5(i,j,lmin) *dsig(lmin)
111     & +xn2o5(i,j,lmin+1)*dsig(lmin+1)
112    
113     hno3ms =hno3(i,j,lmin) *dsig(lmin)
114     & +hno3(i,j,lmin+1)*dsig(lmin+1)
115    
116     ch4ms =ch4(i,j,lmin) *dsig(lmin)
117     & +ch4(i,j,lmin+1)*dsig(lmin+1)
118    
119     ch2oms =ch2o(i,j,lmin) *dsig(lmin)
120     & +ch2o(i,j,lmin+1)*dsig(lmin+1)
121    
122     so2ms =so2(i,j,lmin) *dsig(lmin)
123     & +so2(i,j,lmin+1)*dsig(lmin+1)
124    
125     h2so4ms=h2so4(i,j,lmin) *dsig(lmin)
126     & +h2so4(i,j,lmin+1)*dsig(lmin+1)
127    
128     ! === if hfc, pfc, and sf6 are included:
129     #ifdef INC_3GASES
130     ! === 032698
131     hfc134ams = hfc134a(i,j,lmin)*dsig(lmin)
132     & + hfc134a(i,j,lmin+1)*dsig(lmin+1)
133    
134     pfcms = pfc(i,j,lmin)*dsig(lmin)
135     & + pfc(i,j,lmin+1)*dsig(lmin+1)
136    
137     sf6ms = sf6(i,j,lmin)*dsig(lmin)
138     & + sf6(i,j,lmin+1)*dsig(lmin+1)
139     ! ===
140     #endif
141    
142     bcms = bcarbon(i,j,lmin) *dsig(lmin)
143     & + bcarbon(i,j,lmin+1)*dsig(lmin+1)
144     ocms = ocarbon(i,j,lmin) *dsig(lmin)
145     & + ocarbon(i,j,lmin+1)*dsig(lmin+1)
146    
147     c 062295
148     c h2o2ms =h2o2(i,j,lmin) *dsig(lmin)
149     c & +h2o2(i,j,lmin+1)*dsig(lmin+1)
150     !
151     #endif
152    
153     IF(LMIN+1.GE.LM) GO TO 150 7544.
154     TVMS=T(I,J,LMIN)*(1.+Q(I,J,LMIN)*RVX)*(PK(I,J,LMIN)*DSIG(LMIN)) 7545.
155     * +T(I,J,LMIN+1)*(1.+Q(I,J,LMIN+1)*RVX) 7546.
156     * *(PK(I,J,LMIN+1)*DSIG(LMIN+1)) 7547.
157     THETA=TVMS/PKMS 7548.
158     LMINP2=LMIN+2 7549.
159     DO 140 L=LMINP2,LM 7550.
160     IF(THETA.LT.T(I,J,L)*(1.+Q(I,J,L)*RVX)) GO TO 160 7551.
161     PKMS=PKMS+(PK(I,J,L)*DSIG(L)) 7552.
162     THPKMS=THPKMS+T(I,J,L)*(PK(I,J,L)*DSIG(L)) 7553.
163     QMS=QMS+Q(I,J,L)*DSIG(L) 7554.
164    
165     #if ( defined CPL_CHEM )
166     !
167     ! --- sigma of mixing ratios:
168     !
169     cfc11ms=cfc11ms+cfc11(i,j,l)*dsig(l)
170    
171     cfc12ms=cfc12ms+cfc12(i,j,l)*dsig(l)
172    
173     xn2oms =xn2oms+xn2o(i,j,l)*dsig(l)
174    
175     o3ms =o3ms+o3(i,j,l)*dsig(l)
176    
177     coms =coms+co(i,j,l)*dsig(l)
178    
179     zco2ms =zco2ms+zco2(i,j,l)*dsig(l)
180    
181     xnoms =xnoms+xno(i,j,l)*dsig(l)
182    
183     xno2ms =xno2ms+xno2(i,j,l)*dsig(l)
184    
185     xn2o5ms=xn2o5ms+xn2o5(i,j,l)*dsig(l)
186    
187     hno3ms =hno3ms+hno3(i,j,l)*dsig(l)
188    
189     ch4ms =ch4ms+ch4(i,j,l)*dsig(l)
190    
191     ch2oms =ch2oms+ch2o(i,j,l)*dsig(l)
192    
193     so2ms =so2ms+so2(i,j,l)*dsig(l)
194    
195     h2so4ms=h2so4ms+h2so4(i,j,l)*dsig(l)
196    
197     ! === if hfc, pfc, and sf6 are included:
198     #ifdef INC_3GASES
199     ! === 032698
200     hfc134ams = hfc134ams
201     & + hfc134a(i,j,l)*dsig(l)
202    
203     pfcms = pfcms
204     & + pfc(i,j,l)*dsig(l)
205    
206     sf6ms = sf6ms
207     & + sf6(i,j,l)*dsig(l)
208     ! ===
209     #endif
210    
211     bcms = bcms + bcarbon(i,j,l)*dsig(l)
212     ocms = ocms + ocarbon(i,j,l)*dsig(l)
213    
214     c 062295
215     c h2o2ms =h2o2ms+h2o2(i,j,l)*dsig(l)
216    
217     !
218     #endif
219    
220     TVMS=TVMS+T(I,J,L)*(1.+Q(I,J,L)*RVX)*(PK(I,J,L)*DSIG(L)) 7555.
221     140 THETA=TVMS/PKMS 7556.
222     150 L=LM+1 7557.
223     160 LMAX=L-1 7558.
224     RDSIGS=1./(SIGE(LMIN)-SIGE(LMAX+1)) 7559.
225     THM=THPKMS/PKMS 7560.
226     QMS=QMS*RDSIGS 7561.
227    
228     #if ( defined CPL_CHEM )
229     !
230     ! --- Get post-transport mixing ratios:
231     !
232     cfc11ms = cfc11ms*rdsigs
233    
234     cfc12ms = cfc12ms*rdsigs
235    
236     xn2oms = xn2oms *rdsigs
237    
238     o3ms = o3ms *rdsigs
239    
240     coms = coms *rdsigs
241    
242     zco2ms = zco2ms *rdsigs
243    
244     xnoms = xnoms *rdsigs
245    
246     xno2ms = xno2ms *rdsigs
247    
248     xn2o5ms = xn2o5ms*rdsigs
249    
250     hno3ms = hno3ms *rdsigs
251    
252     ch4ms = ch4ms *rdsigs
253    
254     ch2oms = ch2oms *rdsigs
255    
256     so2ms = so2ms *rdsigs
257    
258     h2so4ms = h2so4ms*rdsigs
259    
260     ! === if hfc, pfc, and sf6 are included:
261     #ifdef INC_3GASES
262     ! === 032698
263     hfc134ams = hfc134ams*rdsigs
264    
265     pfcms = pfcms*rdsigs
266    
267     sf6ms = sf6ms*rdsigs
268     ! ===
269     #endif
270    
271     bcms = bcms*rdsigs
272     ocms = ocms*rdsigs
273    
274     c 062295
275     c h2o2ms = h2o2ms*rdsigs
276    
277     !
278     #endif
279    
280     DO 180 L=LMIN,LMAX 7562.
281     AJL(J,L,12)=AJL(J,L,12)+(THM-T(I,J,L))*PK(I,J,L)*P(I,J) 7563.
282     T(I,J,L)=THM 7564.
283     Q(I,J,L)=QMS 7565.
284    
285     #if ( defined CPL_CHEM )
286     !
287     ! --- Remap mixing ratios:
288     !
289     cfc11(i,j,l)= cfc11ms
290    
291     cfc12(i,j,l)= cfc12ms
292    
293     xn2o (i,j,l)= xn2oms
294    
295     o3 (i,j,l)= o3ms
296    
297     co (i,j,l)= coms
298    
299     zco2 (i,j,l)= zco2ms
300    
301     xno (i,j,l)= xnoms
302    
303     xno2 (i,j,l)= xno2ms
304    
305     xn2o5(i,j,l)= xn2o5ms
306    
307     hno3 (i,j,l)= hno3ms
308    
309     ch4 (i,j,l)= ch4ms
310    
311     ch2o (i,j,l)= ch2oms
312    
313     so2 (i,j,l)= so2ms
314    
315     h2so4(i,j,l)= h2so4ms
316    
317     ! === if hfc, pfc, and sf6 are included:
318     #ifdef INC_3GASES
319     ! === 032698
320     hfc134a(i,j,l) = hfc134ams
321    
322     pfc(i,j,l) = pfcms
323    
324     sf6(i,j,l) = sf6ms
325     ! ===
326     #endif
327    
328     bcarbon(i,j,l) = bcms
329     ocarbon(i,j,l) = ocms
330    
331     c 062295
332     c h2o2(i,j,l) = h2o2ms
333     !
334     #endif
335    
336     180 continue
337    
338     IF(POLE) GO TO 300 7566.
339     C**** MIX MOMENTUM THROUGHOUT UNSTABLE LAYERS AT NON-POLAR GRID BOXES 7567.
340     ID(1)=I+(J-1)*IM 7570.
341     ID(2)=ID(1)+IM*JM*LM 7571.
342     ID(3)=I+J*IM 7574.
343     ID(4)=ID(3)+IM*JM*LM 7575.
344     DO 240 K=1,4 7576.
345     UMS(K)=0. 7577.
346     DO 220 L=LMIN,LMAX 7578.
347     220 UMS(K)=UMS(K)+UT(ID(K),1,L)*DSIG(L) 7579.
348     240 UMS(K)=UMS(K)*RDSIGS 7580.
349     DO 260 L=LMIN,LMAX 7581.
350     AJL(J,L,38)=AJL(J,L,38)+(UMS(1)-UT(I,J,L))*.5* 7582.
351     * P(I,J)*RA(1) 7583.
352     AJL(J+1,L,38)=AJL(J+1,L,38)+(UMS(3)- 7584.
353     * UT(I,J+1,L))*P(I,J)*RA(3)*.5 7585.
354     DO 260 K=1,4 7586.
355     260 U(ID(K),1,L)=U(ID(K),1,L)+(UMS(K)-UT(ID(K),1,L))*RA(K) 7587.
356     GO TO 130 7588.
357     C**** MIX MOMENTUM THROUGHOUT UNSTABLE LAYERS AT POLAR GRID BOXES 7589.
358     300 JVPO=2 7590.
359     IF(J.EQ.JM) JVPO=JM 7591.
360     RAPO=2.*RAPVN(1) 7592.
361     DO 360 IPO=1,IM 7593.
362     UMSPO=0. 7594.
363     VMSPO=0. 7595.
364     DO 320 L=LMIN,LMAX 7596.
365     UMSPO=UMSPO+UT(IPO,JVPO,L)*DSIG(L) 7597.
366     320 VMSPO=VMSPO+VT(IPO,JVPO,L)*DSIG(L) 7598.
367     UMSPO=UMSPO*RDSIGS 7599.
368     VMSPO=VMSPO*RDSIGS 7600.
369     DO 340 L=LMIN,LMAX 7601.
370     U(IPO,JVPO,L)=U(IPO,JVPO,L)+(UMSPO-UT(IPO,JVPO,L))*RAPO 7602.
371     V(IPO,JVPO,L)=V(IPO,JVPO,L)+(VMSPO-VT(IPO,JVPO,L))*RAPO 7603.
372     340 AJL(JVPO,L,38)=AJL(JVPO,L,38) 7604.
373     * +(UMSPO-UT(IPO,JVPO,L))*P(1,J)*RAPO 7605.
374     360 CONTINUE 7606.
375     GO TO 130 7607.
376     500 IM1=I 7608.
377     RETURN 7609.
378     END 7610.

  ViewVC Help
Powered by ViewVC 1.1.22