Context Navigation

watercloud_mod.F @ 1775

Last change on this file since 1775 was 1774, checked in by aslmd, 8 years ago
LMDZ.MARS setting the stage for maybe fixing nesting in the LMD_MM_MARS 3. moving out domain-dependent computations from firstcalls. these are few lines with simple computations, no impact on runtime.
File size: 22.3 KB

Line
1	MODULE watercloud_mod
2
3	IMPLICIT NONE
4
5	CONTAINS
6
7	SUBROUTINE watercloud(ngrid,nlay,ptimestep,
8	& pplev,pplay,pdpsrf,pzlay,pt,pdt,
9	& pq,pdq,pdqcloud,pdtcloud,
10	& nq,tau,tauscaling,rdust,rice,nuice,
11	& rsedcloud,rhocloud,totcloudfrac)
12	! to use 'getin'
13	USE ioipsl_getincom
14	USE updaterad
15	USE comcstfi_h
16	use tracer_mod, only: nqmx, igcm_h2o_vap, igcm_h2o_ice,
17	& igcm_dust_mass, igcm_dust_number,
18	& igcm_ccn_mass, igcm_ccn_number,
19	& rho_dust, nuice_sed, nuice_ref
20	use dimradmars_mod, only: naerkind
21	IMPLICIT NONE
22
23
24	c=======================================================================
25	c Water-ice cloud formation
26	c
27	c Includes two different schemes:
28	c - A simplified scheme (see simpleclouds.F)
29	c - An improved microphysical scheme (see improvedclouds.F)
30	c
31	c There is a time loop specific to cloud formation
32	c due to timescales smaller than the GCM integration timestep.
33	c
34	c Authors: Franck Montmessin, Francois Forget, Ehouarn Millour,
35	c J.-B. Madeleine, Thomas Navarro
36	c
37	c 2004 - 2012
38	c=======================================================================
39
40	c-----------------------------------------------------------------------
41	c declarations:
42	c -------------
43
44	#include "callkeys.h"
45
46	c Inputs:
47	c ------
48
49	INTEGER ngrid,nlay
50	INTEGER nq ! nombre de traceurs
51	REAL ptimestep ! pas de temps physique (s)
52	REAL pplev(ngrid,nlay+1) ! pression aux inter-couches (Pa)
53	REAL pplay(ngrid,nlay) ! pression au milieu des couches (Pa)
54	REAL pdpsrf(ngrid) ! tendence surf pressure
55	REAL pzlay(ngrid,nlay) ! altitude at the middle of the layers
56	REAL pt(ngrid,nlay) ! temperature at the middle of the layers (K)
57	REAL pdt(ngrid,nlay) ! tendence temperature des autres param.
58
59	real pq(ngrid,nlay,nq) ! traceur (kg/kg)
60	real pdq(ngrid,nlay,nq) ! tendence avant condensation (kg/kg.s-1)
61
62	REAL tau(ngrid,naerkind) ! Column dust optical depth at each point
63	REAL tauscaling(ngrid) ! Convertion factor for dust amount
64	real rdust(ngrid,nlay) ! Dust geometric mean radius (m)
65
66	c Outputs:
67	c -------
68
69	real pdqcloud(ngrid,nlay,nq) ! tendence de la condensation H2O(kg/kg.s-1)
70	REAL pdtcloud(ngrid,nlay) ! tendence temperature due
71	! a la chaleur latente
72
73	REAL rice(ngrid,nlay) ! Ice mass mean radius (m)
74	! (r_c in montmessin_2004)
75	REAL nuice(ngrid,nlay) ! Estimated effective variance
76	! of the size distribution
77	real rsedcloud(ngrid,nlay) ! Cloud sedimentation radius
78	real rhocloud(ngrid,nlay) ! Cloud density (kg.m-3)
79
80	REAL, INTENT(INOUT):: totcloudfrac(ngrid) ! Cloud fraction (A. Pottier 2013)
81	c local:
82	c ------
83
84	! for ice radius computation
85	REAL Mo,No
86	REAl ccntyp
87
88	! for time loop
89	INTEGER microstep ! time subsampling step variable
90	INTEGER imicro ! time subsampling for coupled water microphysics & sedimentation
91	SAVE imicro
92	REAL microtimestep ! integration timestep for coupled water microphysics & sedimentation
93	SAVE microtimestep
94
95	! tendency given by clouds (inside the micro loop)
96	REAL subpdqcloud(ngrid,nlay,nq) ! cf. pdqcloud
97	REAL subpdtcloud(ngrid,nlay) ! cf. pdtcloud
98
99	! global tendency (clouds+physics)
100	REAL subpdq(ngrid,nlay,nq) ! cf. pdqcloud
101	REAL subpdt(ngrid,nlay) ! cf. pdtcloud
102
103	! no supersaturation when option supersat is false
104	REAL zt(ngrid,nlay) ! local value of temperature
105	REAL zqsat(ngrid,nlay) ! saturation
106
107	INTEGER iq,ig,l
108	LOGICAL,SAVE :: firstcall=.true.
109
110	! Representation of sub-grid water ice clouds A. Pottier 2013
111	! REAL :: zt(ngrid, nlay)
112	REAL :: zq(ngrid, nlay,nq)
113	REAL :: zdelt
114	REAL :: norm
115	REAL :: ponder
116	REAL :: tcond(ngrid,nlay)
117	REAL :: zqvap(ngrid,nlay)
118	REAL :: zqice(ngrid,nlay)
119	REAL :: spant ! delta T for the temperature distribution
120	! REAL :: zqsat(ngrid,nlay) ! saturation
121	REAL :: zteff(ngrid, nlay)! effective temperature in the cloud,neb
122	REAL :: pqeff(ngrid, nlay, nq)! effective tracers quantities in the cloud
123	REAL :: cloudfrac(ngrid,nlay) ! cloud fraction
124	REAL :: mincloud ! min cloud frac
125	LOGICAL, save :: flagcloud=.true.
126	c ** un petit test de coherence
127	c --------------------------
128
129	IF (firstcall) THEN
130
131	if (nq.gt.nqmx) then
132	write(,) 'stop in watercloud (nq.gt.nqmx)!'
133	write(,) 'nq=',nq,' nqmx=',nqmx
134	stop
135	endif
136
137	write(,) "watercloud: igcm_h2o_vap=",igcm_h2o_vap
138	write(,) " igcm_h2o_ice=",igcm_h2o_ice
139
140	write(,) "time subsampling for microphysic ?"
141	#ifdef MESOSCALE
142	imicro = 2
143	#else
144	imicro = 30
145	#endif
146	call getin("imicro",imicro)
147	write(,)"imicro = ",imicro
148
149	firstcall=.false.
150	ENDIF ! of IF (firstcall)
151
152	!! AS: moved out of firstcall to allow nesting+evoluting timestep
153	!! TBD: consider possible diff imicro with domains?
154	microtimestep = ptimestep/real(imicro)
155	write(,)"Physical timestep is",ptimestep
156	write(,)"Microphysics timestep is",microtimestep
157
158
159	c-----Initialization
160	subpdq(1:ngrid,1:nlay,1:nq) = 0
161	subpdt(1:ngrid,1:nlay) = 0
162
163	! default value if no ice
164	rhocloud(1:ngrid,1:nlay) = rho_dust
165
166	c-------------------------------------------------------------------
167	c 0. Representation of sub-grid water ice clouds
168	c------------------
169	c-----Tendencies
170	DO l=1,nlay
171	DO ig=1,ngrid
172	zt(ig,l)=pt(ig,l)+ pdt(ig,l)*ptimestep
173	ENDDO
174	ENDDO
175	DO l=1,nlay
176	DO ig=1,ngrid
177	DO iq=1,nq
178	zq(ig,l,iq)=pq(ig,l,iq)+pdq(ig,l,iq)*ptimestep
179	ENDDO
180	ENDDO
181	ENDDO
182	c-----Effective temperature calculation
183	IF (CLFvarying) THEN
184	spant=3.0 ! delta T for the temprature distribution
185	mincloud=0.1 ! min cloudfrac when there is ice
186	IF (flagcloud) THEN
187	write(,) "Delta T", spant
188	write(,) "mincloud", mincloud
189	flagcloud=.false.
190	END IF
191	CALL watersat(ngrid*nlay,zt,pplay,zqsat)
192	zqvap=zq(:,:,igcm_h2o_vap)
193	zqice=zq(:,:,igcm_h2o_ice)
194	CALL tcondwater(ngrid*nlay,pplay,zqvap+zqice,tcond)
195	DO l=1,nlay
196	DO ig=1,ngrid
197	zdelt=spant !MAX(spant*zt(ig,l),1.e-12), now totally in K. Fixed width
198	IF (tcond(ig,l) .ge. (zt(ig,l)+zdelt)) THEN
199	zteff(ig,l)=zt(ig,l)
200	cloudfrac(ig,l)=1.
201	ELSE IF (tcond(ig,l) .le. (zt(ig,l)-zdelt)) THEN
202	zteff(ig,l)=zt(ig,l)-zdelt
203	cloudfrac(ig,l)=mincloud
204	ELSE
205	cloudfrac(ig,l)=(tcond(ig,l)-zt(ig,l)+zdelt)/
206	& (2.0*zdelt)
207	zteff(ig,l)=(tcond(ig,l)+zt(ig,l)-zdelt)/2.
208	END IF
209	zteff(ig,l)=zteff(ig,l)-pdt(ig,l)*ptimestep
210	IF (cloudfrac(ig,l).le.0) THEN
211	cloudfrac(ig,l)=mincloud
212	ELSE IF (cloudfrac(ig,l).gt.1) THEN
213	cloudfrac(ig,l)=1.
214	END IF
215	ENDDO
216	ENDDO
217	c-----Calculation of the total cloud coverage of the column
218	DO ig=1,ngrid
219	totcloudfrac(ig) = 0.
220	norm=0.
221	DO l=1,nlay
222	ponder=zqice(ig,l)*(pplev(ig,l) - pplev(ig,l+1))
223	totcloudfrac(ig) = totcloudfrac(ig)
224	& + cloudfrac(ig,l)*ponder
225	norm=norm+ponder
226	ENDDO
227	totcloudfrac(ig)=MAX(totcloudfrac(ig)/norm,1.e-12) ! min value if NaNs
228	ENDDO
229	c-----No sub-grid cloud representation (CLFvarying=false)
230	ELSE
231	DO l=1,nlay
232	DO ig=1,ngrid
233	zteff(ig,l)=pt(ig,l)
234	END DO
235	END DO
236	END IF ! end if (CLFvarying)
237
238	c------------------------------------------------------------------
239	c Time subsampling for microphysics
240	rhocloud(1:ngrid,1:nlay) = rho_dust
241	DO microstep=1,imicro
242
243	c-------------------------------------------------------------------
244	c 1. Tendencies:
245	c------------------
246
247
248	c------ Temperature tendency subpdt
249	! Each microtimestep we give the cloud scheme a stepped entry subpdt instead of pdt
250	! If imicro=1 subpdt is the same as pdt
251	DO l=1,nlay
252	DO ig=1,ngrid
253	subpdt(ig,l) = subpdt(ig,l)
254	& + pdt(ig,l) ! At each micro timestep we add pdt in order to have a stepped entry
255	ENDDO
256	ENDDO
257	c------ Tracers tendencies subpdq
258	c------ At each micro timestep we add pdq in order to have a stepped entry
259	IF (microphys) THEN
260	DO l=1,nlay
261	DO ig=1,ngrid
262	subpdq(ig,l,igcm_dust_mass) =
263	& subpdq(ig,l,igcm_dust_mass)
264	& + pdq(ig,l,igcm_dust_mass)
265	subpdq(ig,l,igcm_dust_number) =
266	& subpdq(ig,l,igcm_dust_number)
267	& + pdq(ig,l,igcm_dust_number)
268	subpdq(ig,l,igcm_ccn_mass) =
269	& subpdq(ig,l,igcm_ccn_mass)
270	& + pdq(ig,l,igcm_ccn_mass)
271	subpdq(ig,l,igcm_ccn_number) =
272	& subpdq(ig,l,igcm_ccn_number)
273	& + pdq(ig,l,igcm_ccn_number)
274	ENDDO
275	ENDDO
276	ENDIF
277	DO l=1,nlay
278	DO ig=1,ngrid
279	subpdq(ig,l,igcm_h2o_ice) =
280	& subpdq(ig,l,igcm_h2o_ice)
281	& + pdq(ig,l,igcm_h2o_ice)
282	subpdq(ig,l,igcm_h2o_vap) =
283	& subpdq(ig,l,igcm_h2o_vap)
284	& + pdq(ig,l,igcm_h2o_vap)
285	ENDDO
286	ENDDO
287	c------ Effective tracers quantities in the cloud fraction
288	IF (CLFvarying) THEN
289	pqeff(:,:,:)=pq(:,:,:) ! prevent from buggs (A. Pottier)
290	pqeff(:,:,igcm_ccn_mass) =pq(:,:,igcm_ccn_mass)/
291	& cloudfrac(:,:)
292	pqeff(:,:,igcm_ccn_number)=
293	& pq(:,:,igcm_ccn_number)/cloudfrac(:,:)
294	pqeff(:,:,igcm_h2o_ice)= pq(:,:,igcm_h2o_ice)/
295	& cloudfrac(:,:)
296	ELSE
297	pqeff(:,:,:)=pq(:,:,:)
298	pqeff(:,:,igcm_ccn_mass)= pq(:,:,igcm_ccn_mass)
299	pqeff(:,:,igcm_ccn_number)= pq(:,:,igcm_ccn_number)
300	pqeff(:,:,igcm_h2o_ice)= pq(:,:,igcm_h2o_ice)
301	END IF
302
303	c-------------------------------------------------------------------
304	c 2. Main call to the different cloud schemes:
305	c------------------------------------------------
306	IF (microphys) THEN
307	CALL improvedclouds(ngrid,nlay,microtimestep,
308	& pplay,zteff,subpdt,
309	& pqeff,subpdq,subpdqcloud,subpdtcloud,
310	& nq,tauscaling)
311
312	ELSE
313	CALL simpleclouds(ngrid,nlay,microtimestep,
314	& pplay,pzlay,zteff,subpdt,
315	& pqeff,subpdq,subpdqcloud,subpdtcloud,
316	& nq,tau,rice)
317	ENDIF
318
319	c-------------------------------------------------------------------
320	c 3. Updating tendencies after cloud scheme:
321	c-----------------------------------------------
322
323	IF (microphys) THEN
324	DO l=1,nlay
325	DO ig=1,ngrid
326	subpdq(ig,l,igcm_dust_mass) =
327	& subpdq(ig,l,igcm_dust_mass)
328	& + subpdqcloud(ig,l,igcm_dust_mass)
329	subpdq(ig,l,igcm_dust_number) =
330	& subpdq(ig,l,igcm_dust_number)
331	& + subpdqcloud(ig,l,igcm_dust_number)
332	subpdq(ig,l,igcm_ccn_mass) =
333	& subpdq(ig,l,igcm_ccn_mass)
334	& + subpdqcloud(ig,l,igcm_ccn_mass)
335	subpdq(ig,l,igcm_ccn_number) =
336	& subpdq(ig,l,igcm_ccn_number)
337	& + subpdqcloud(ig,l,igcm_ccn_number)
338	ENDDO
339	ENDDO
340	ENDIF
341	DO l=1,nlay
342	DO ig=1,ngrid
343	subpdq(ig,l,igcm_h2o_ice) =
344	& subpdq(ig,l,igcm_h2o_ice)
345	& + subpdqcloud(ig,l,igcm_h2o_ice)
346	subpdq(ig,l,igcm_h2o_vap) =
347	& subpdq(ig,l,igcm_h2o_vap)
348	& + subpdqcloud(ig,l,igcm_h2o_vap)
349	ENDDO
350	ENDDO
351
352	IF (activice) THEN
353	DO l=1,nlay
354	DO ig=1,ngrid
355	subpdt(ig,l) =
356	& subpdt(ig,l) + subpdtcloud(ig,l)
357	ENDDO
358	ENDDO
359	ENDIF
360
361
362	ENDDO ! of DO microstep=1,imicro
363
364	c-------------------------------------------------------------------
365	c 6. Compute final tendencies after time loop:
366	c------------------------------------------------
367
368	c------ Temperature tendency pdtcloud
369	DO l=1,nlay
370	DO ig=1,ngrid
371	pdtcloud(ig,l) =
372	& subpdt(ig,l)/real(imicro)-pdt(ig,l)
373	ENDDO
374	ENDDO
375
376	c------ Tracers tendencies pdqcloud
377	DO l=1,nlay
378	DO ig=1,ngrid
379	pdqcloud(ig,l,igcm_h2o_ice) =
380	& subpdq(ig,l,igcm_h2o_ice)/real(imicro)
381	& - pdq(ig,l,igcm_h2o_ice)
382	pdqcloud(ig,l,igcm_h2o_vap) =
383	& subpdq(ig,l,igcm_h2o_vap)/real(imicro)
384	& - pdq(ig,l,igcm_h2o_vap)
385	ENDDO
386	ENDDO
387
388	IF(microphys) THEN
389	DO l=1,nlay
390	DO ig=1,ngrid
391	pdqcloud(ig,l,igcm_ccn_mass) =
392	& subpdq(ig,l,igcm_ccn_mass)/real(imicro)
393	& - pdq(ig,l,igcm_ccn_mass)
394	pdqcloud(ig,l,igcm_ccn_number) =
395	& subpdq(ig,l,igcm_ccn_number)/real(imicro)
396	& - pdq(ig,l,igcm_ccn_number)
397	ENDDO
398	ENDDO
399	ENDIF
400
401	IF(scavenging) THEN
402	DO l=1,nlay
403	DO ig=1,ngrid
404	pdqcloud(ig,l,igcm_dust_mass) =
405	& subpdq(ig,l,igcm_dust_mass)/real(imicro)
406	& - pdq(ig,l,igcm_dust_mass)
407	pdqcloud(ig,l,igcm_dust_number) =
408	& subpdq(ig,l,igcm_dust_number)/real(imicro)
409	& - pdq(ig,l,igcm_dust_number)
410	ENDDO
411	ENDDO
412	ENDIF
413
414	c------- Due to stepped entry, other processes tendencies can add up to negative values
415	c------- Therefore, enforce positive values and conserve mass
416	IF(microphys) THEN
417	DO l=1,nlay
418	DO ig=1,ngrid
419	IF ((pq(ig,l,igcm_ccn_number) +
420	& ptimestep* (pdq(ig,l,igcm_ccn_number) +
421	& pdqcloud(ig,l,igcm_ccn_number)) .le. 1.)
422	& .or. (pq(ig,l,igcm_ccn_mass) +
423	& ptimestep* (pdq(ig,l,igcm_ccn_mass) +
424	& pdqcloud(ig,l,igcm_ccn_mass)) .le. 1.e-20)) THEN
425	pdqcloud(ig,l,igcm_ccn_number) =
426	& - pq(ig,l,igcm_ccn_number)/ptimestep
427	& - pdq(ig,l,igcm_ccn_number) + 1.
428	pdqcloud(ig,l,igcm_dust_number) =
429	& -pdqcloud(ig,l,igcm_ccn_number)
430	pdqcloud(ig,l,igcm_ccn_mass) =
431	& - pq(ig,l,igcm_ccn_mass)/ptimestep
432	& - pdq(ig,l,igcm_ccn_mass) + 1.e-20
433	pdqcloud(ig,l,igcm_dust_mass) =
434	& -pdqcloud(ig,l,igcm_ccn_mass)
435	ENDIF
436	ENDDO
437	ENDDO
438	ENDIF
439
440	IF(scavenging) THEN
441	DO l=1,nlay
442	DO ig=1,ngrid
443	IF ((pq(ig,l,igcm_dust_number) +
444	& ptimestep* (pdq(ig,l,igcm_dust_number) +
445	& pdqcloud(ig,l,igcm_dust_number)) .le. 1.)
446	& .or. (pq(ig,l,igcm_dust_mass) +
447	& ptimestep* (pdq(ig,l,igcm_dust_mass) +
448	& pdqcloud(ig,l,igcm_dust_mass)) .le. 1.e-20)) THEN
449	pdqcloud(ig,l,igcm_dust_number) =
450	& - pq(ig,l,igcm_dust_number)/ptimestep
451	& - pdq(ig,l,igcm_dust_number) + 1.
452	pdqcloud(ig,l,igcm_ccn_number) =
453	& -pdqcloud(ig,l,igcm_dust_number)
454	pdqcloud(ig,l,igcm_dust_mass) =
455	& - pq(ig,l,igcm_dust_mass)/ptimestep
456	& - pdq(ig,l,igcm_dust_mass) + 1.e-20
457	pdqcloud(ig,l,igcm_ccn_mass) =
458	& -pdqcloud(ig,l,igcm_dust_mass)
459	ENDIF
460	ENDDO
461	ENDDO
462	ENDIF
463
464	DO l=1,nlay
465	DO ig=1,ngrid
466	IF (pq(ig,l,igcm_h2o_ice) + ptimestep*
467	& (pdq(ig,l,igcm_h2o_ice) + pdqcloud(ig,l,igcm_h2o_ice))
468	& .le. 1.e-8) THEN
469	pdqcloud(ig,l,igcm_h2o_ice) =
470	& - pq(ig,l,igcm_h2o_ice)/ptimestep - pdq(ig,l,igcm_h2o_ice)
471	pdqcloud(ig,l,igcm_h2o_vap) = -pdqcloud(ig,l,igcm_h2o_ice)
472	ENDIF
473	IF (pq(ig,l,igcm_h2o_vap) + ptimestep*
474	& (pdq(ig,l,igcm_h2o_vap) + pdqcloud(ig,l,igcm_h2o_vap))
475	& .le. 1.e-8) THEN
476	pdqcloud(ig,l,igcm_h2o_vap) =
477	& - pq(ig,l,igcm_h2o_vap)/ptimestep - pdq(ig,l,igcm_h2o_vap)
478	pdqcloud(ig,l,igcm_h2o_ice) = -pdqcloud(ig,l,igcm_h2o_vap)
479	ENDIF
480	ENDDO
481	ENDDO
482
483
484	c------Update the ice and dust particle size "rice" for output or photochemistry
485	c------Only rsedcloud is used for the water cycle
486
487	IF(scavenging) THEN
488	DO l=1, nlay
489	DO ig=1,ngrid
490
491	call updaterdust(
492	& pq(ig,l,igcm_dust_mass) + ! dust mass
493	& (pdq(ig,l,igcm_dust_mass) + ! dust mass
494	& pdqcloud(ig,l,igcm_dust_mass))*ptimestep, ! dust mass
495	& pq(ig,l,igcm_dust_number) + ! dust number
496	& (pdq(ig,l,igcm_dust_number) + ! dust number
497	& pdqcloud(ig,l,igcm_dust_number))*ptimestep, ! dust number
498	& rdust(ig,l))
499
500	ENDDO
501	ENDDO
502	ENDIF
503
504	IF(microphys) THEN
505
506	! In case one does not want to allow supersatured water when using microphysics.
507	! Not done by default.
508	IF(.not.supersat) THEN
509	zt = pt + (pdt+pdtcloud)*ptimestep
510	call watersat(ngrid*nlay,zt,pplay,zqsat)
511	DO l=1, nlay
512	DO ig=1,ngrid
513	IF (pq(ig,l,igcm_h2o_vap)
514	& + (pdq(ig,l,igcm_h2o_vap) + pdqcloud(ig,l,igcm_h2o_vap))
515	& * ptimestep .ge. zqsat(ig,l)) THEN
516	pdqcloud(ig,l,igcm_h2o_vap) =
517	& (zqsat(ig,l) - pq(ig,l,igcm_h2o_vap))/ptimestep
518	& - pdq(ig,l,igcm_h2o_vap)
519	pdqcloud(ig,l,igcm_h2o_ice) =
520	& -pdqcloud(ig,l,igcm_h2o_vap)
521	! no need to correct ccn_number, updaterad can handle this properly.
522	ENDIF
523	ENDDO
524	ENDDO
525	ENDIF
526
527	DO l=1, nlay
528	DO ig=1,ngrid
529
530	call updaterice_micro(
531	& pq(ig,l,igcm_h2o_ice) + ! ice mass
532	& (pdq(ig,l,igcm_h2o_ice) + ! ice mass
533	& pdqcloud(ig,l,igcm_h2o_ice))*ptimestep, ! ice mass
534	& pq(ig,l,igcm_ccn_mass) + ! ccn mass
535	& (pdq(ig,l,igcm_ccn_mass) + ! ccn mass
536	& pdqcloud(ig,l,igcm_ccn_mass))*ptimestep, ! ccn mass
537	& pq(ig,l,igcm_ccn_number) + ! ccn number
538	& (pdq(ig,l,igcm_ccn_number) + ! ccn number
539	& pdqcloud(ig,l,igcm_ccn_number))*ptimestep, ! ccn number
540	& tauscaling(ig),rice(ig,l),rhocloud(ig,l))
541
542	ENDDO
543	ENDDO
544
545	ELSE ! no microphys
546
547	DO l=1,nlay
548	DO ig=1,ngrid
549
550	call updaterice_typ(
551	& pq(ig,l,igcm_h2o_ice) + ! ice mass
552	& (pdq(ig,l,igcm_h2o_ice) + ! ice mass
553	& pdqcloud(ig,l,igcm_h2o_ice))*ptimestep, ! ice mass
554	& tau(ig,1),pzlay(ig,l),rice(ig,l))
555
556	ENDDO
557	ENDDO
558
559	ENDIF ! of IF(microphys)
560
561
562
563	c A correction if a lot of subliming CO2 fills the 1st layer FF04/2005
564	c ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
565	c Then that should not affect the ice particle radius
566	do ig=1,ngrid
567	if(pdpsrf(ig)ptimestep.gt.0.9(pplev(ig,1)-pplev(ig,2)))then
568	if(pdpsrf(ig)ptimestep.gt.0.9(pplev(ig,1)-pplev(ig,3)))
569	& rice(ig,2)=rice(ig,3)
570	rice(ig,1)=rice(ig,2)
571	end if
572	end do
573
574
575	DO l=1,nlay
576	DO ig=1,ngrid
577	rsedcloud(ig,l)=max(rice(ig,l)*
578	& (1.+nuice_sed)(1.+nuice_sed)(1.+nuice_sed),
579	& rdust(ig,l))
580	! rsedcloud(ig,l)=min(rsedcloud(ig,l),1.e-4)
581	ENDDO
582	ENDDO
583
584	! used for rad. transfer calculations
585	! nuice is constant because a lognormal distribution is prescribed
586	nuice(1:ngrid,1:nlay)=nuice_ref
587
588	c------Update tendencies for sub-grid water ice clouds
589	IF (CLFvarying) THEN
590	DO ig=1,ngrid
591	DO l=1,nlay
592	pdqcloud(ig,l,igcm_dust_mass)=pdqcloud(ig,l,igcm_dust_mass)
593	& *cloudfrac(ig,l)
594	pdqcloud(ig,l,igcm_ccn_mass)=pdqcloud(ig,l,igcm_ccn_mass)
595	& *cloudfrac(ig,l)
596	pdqcloud(ig,l,igcm_dust_number)=pdqcloud(ig,l,
597	& igcm_dust_number) *cloudfrac(ig,l)
598	pdqcloud(ig,l,igcm_ccn_number)=pdqcloud(ig,l,
599	& igcm_ccn_number) *cloudfrac(ig,l)
600	pdqcloud(ig,l,igcm_h2o_vap)=pdqcloud(ig,l,
601	& igcm_h2o_vap) *cloudfrac(ig,l)
602	pdqcloud(ig,l,igcm_h2o_ice)=pdqcloud(ig,l,
603	& igcm_h2o_ice) *cloudfrac(ig,l)
604	ENDDO
605	ENDDO
606	pdtcloud(:,:)=pdtcloud(:,:)*cloudfrac(:,:)
607	ENDIF
608	#ifndef MESOSCALE
609	c=======================================================================
610	call WRITEDIAGFI(ngrid,"pdqice2","pdqcloudice apres microphysique"
611	& ,"kg/kg.s-1",3,pdqcloud(1:ngrid,1:nlay,igcm_h2o_ice))
612	call WRITEDIAGFI(ngrid,"pdqvap2","pdqcloudvap apres microphysique"
613	& ,"kg/kg.s-1",3,pdqcloud(1:ngrid,1:nlay,
614	& igcm_h2o_vap))
615	call WRITEDIAGFI(ngrid,"pdqccn2","pdqcloudccn apres microphysique"
616	& ,"kg/kg.s-1",3,pdqcloud(1:ngrid,1:nlay,
617	& igcm_ccn_mass))
618	call WRITEDIAGFI(ngrid,"pdqccnN2","pdqcloudccnN apres
619	& microphysique","nb/kg.s-1",3,pdqcloud(1:ngrid,1:nlay,
620	& igcm_ccn_number))
621	call WRITEDIAGFI(ngrid,"pdqdust2", "pdqclouddust apres
622	& microphysique","kg/kg.s-1",3,pdqcloud(1:ngrid,1:nlay,
623	& igcm_dust_mass))
624	call WRITEDIAGFI(ngrid,"pdqdustN2", "pdqclouddustN apres
625	& microphysique","nb/kg.s-1",3,pdqcloud(1:ngrid,1:nlay,
626	& igcm_dust_number))
627	c=======================================================================
628	#endif
629
630	END SUBROUTINE watercloud
631
632	END MODULE watercloud_mod

Note: See TracBrowser for help on using the repository browser.

Download in other formats:

Original Format