Context Navigation

watercloud_mod.F @ 1884

Last change on this file since 1884 was 1880, checked in by mvals, 7 years ago

Mars GCM
-In the sub-grid scale cloud scheme zt is replaced is by ztclf and zq by zqclf ('clf' for 'cloud fraction') in order to avoid any confusion for the further schemes, which need initialization.
-zteff and pqeff are initialized in the first part of the CLFvarying scheme, section 0 of the code, instead of been initialized in section 1 (tendencies) with the sub-timesteps.
-The cloud fraction cannot be lower than the settled value mincloud.(MV)

File size: 22.8 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 :: ztclf(ngrid, nlay)
112	REAL :: zqclf(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-----Initialization
170	zteff(1:ngrid,1:nlay) = 0
171	pqeff(1:ngrid,1:nlay,1:nq) = 0
172	DO l=1,nlay
173	DO ig=1,ngrid
174	zteff(ig,l)=pt(ig,l)
175	END DO
176	END DO
177	DO l=1,nlay
178	DO ig=1,ngrid
179	DO iq=1,nq
180	pqeff(ig,l,iq)=pq(ig,l,iq)
181	ENDDO
182	ENDDO
183	ENDDO
184	c-----Tendencies
185	DO l=1,nlay
186	DO ig=1,ngrid
187	ztclf(ig,l)=pt(ig,l)+ pdt(ig,l)*ptimestep
188	ENDDO
189	ENDDO
190	DO l=1,nlay
191	DO ig=1,ngrid
192	DO iq=1,nq
193	zqclf(ig,l,iq)=pq(ig,l,iq)+pdq(ig,l,iq)*ptimestep
194	ENDDO
195	ENDDO
196	ENDDO
197	c-----Effective temperature calculation
198	IF (CLFvarying) THEN
199	spant=3.0 ! delta T for the temprature distribution
200	mincloud=0.1 ! min cloudfrac when there is ice
201	IF (flagcloud) THEN
202	write(,) "Delta T", spant
203	write(,) "mincloud", mincloud
204	flagcloud=.false.
205	END IF
206	!CALL watersat(ngrid*nlay,ztclf,pplay,zqsat) !MV17: we dont need zqsat in the CLFvarying scheme
207	zqvap=zqclf(:,:,igcm_h2o_vap)
208	zqice=zqclf(:,:,igcm_h2o_ice)
209	CALL tcondwater(ngrid*nlay,pplay,zqvap+zqice,tcond)
210	DO l=1,nlay
211	DO ig=1,ngrid
212	zdelt=spant !MAX(spant*ztclf(ig,l),1.e-12), now totally in K. Fixed width
213	IF (tcond(ig,l) .ge. (ztclf(ig,l)+zdelt)) THEN
214	zteff(ig,l)=ztclf(ig,l)
215	cloudfrac(ig,l)=1.
216	ELSE IF (tcond(ig,l) .le. (ztclf(ig,l)-zdelt)) THEN
217	zteff(ig,l)=ztclf(ig,l)-zdelt
218	cloudfrac(ig,l)=mincloud
219	ELSE
220	cloudfrac(ig,l)=(tcond(ig,l)-ztclf(ig,l)+zdelt)/
221	& (2.0*zdelt)
222	zteff(ig,l)=(tcond(ig,l)+ztclf(ig,l)-zdelt)/2.
223	END IF
224	zteff(ig,l)=zteff(ig,l)-pdt(ig,l)*ptimestep
225	IF (cloudfrac(ig,l).le.mincloud) THEN !MV17: replaced .le.0 by .le.mincloud
226	cloudfrac(ig,l)=mincloud
227	ELSE IF (cloudfrac(ig,l).gt.1) THEN
228	cloudfrac(ig,l)=1.
229	END IF
230	ENDDO
231	ENDDO
232	c-----Calculation of the total cloud coverage of the column
233	DO ig=1,ngrid
234	totcloudfrac(ig) = 0.
235	norm=0.
236	DO l=1,nlay
237	ponder=zqice(ig,l)*(pplev(ig,l) - pplev(ig,l+1))
238	totcloudfrac(ig) = totcloudfrac(ig)
239	& + cloudfrac(ig,l)*ponder
240	norm=norm+ponder
241	ENDDO
242	totcloudfrac(ig)=MAX(totcloudfrac(ig)/norm,1.e-12) ! min value if NaNs
243	ENDDO
244	c-----Effective tracers quantities in the cloud fraction
245	IF (microphys) THEN
246	pqeff(:,:,igcm_ccn_mass)=pq(:,:,igcm_ccn_mass)/
247	& cloudfrac(:,:)
248	pqeff(:,:,igcm_ccn_number)=pq(:,:,igcm_ccn_number)/
249	& cloudfrac(:,:)
250	END IF ! end if (microphys)
251	pqeff(:,:,igcm_h2o_ice)=pq(:,:,igcm_h2o_ice)/
252	& cloudfrac(:,:)
253	END IF ! end if (CLFvarying)
254	!! MV17: CLFvarying outputs
255	CALL WRITEDIAGFI(ngrid,'pqeffice','pqeffice',
256	& 'kg/kg',3,pqeff(:,:,igcm_h2o_ice))
257	CALL WRITEDIAGFI(ngrid,'zteff','zteff',
258	& 'K',3,zteff(:,:))
259	CALL WRITEDIAGFI(ngrid,'tcond','tcond',
260	& 'K',3,tcond(:,:))
261	CALL WRITEDIAGFI(ngrid,'cloudfrac','cloudfrac',
262	& 'K',3,cloudfrac(:,:))
263	c------------------------------------------------------------------
264	c Time subsampling for microphysics
265	c------------------------------------------------------------------
266	rhocloud(1:ngrid,1:nlay) = rho_dust
267	DO microstep=1,imicro
268
269	c-------------------------------------------------------------------
270	c 1. Tendencies:
271	c------------------
272
273
274	c------ Temperature tendency subpdt
275	! Each microtimestep we give the cloud scheme a stepped entry subpdt instead of pdt
276	! If imicro=1 subpdt is the same as pdt
277	DO l=1,nlay
278	DO ig=1,ngrid
279	subpdt(ig,l) = subpdt(ig,l)
280	& + pdt(ig,l) ! At each micro timestep we add pdt in order to have a stepped entry
281	ENDDO
282	ENDDO
283	c------ Tracers tendencies subpdq
284	c------ At each micro timestep we add pdq in order to have a stepped entry
285	IF (microphys) THEN
286	DO l=1,nlay
287	DO ig=1,ngrid
288	subpdq(ig,l,igcm_dust_mass) =
289	& subpdq(ig,l,igcm_dust_mass)
290	& + pdq(ig,l,igcm_dust_mass)
291	subpdq(ig,l,igcm_dust_number) =
292	& subpdq(ig,l,igcm_dust_number)
293	& + pdq(ig,l,igcm_dust_number)
294	subpdq(ig,l,igcm_ccn_mass) =
295	& subpdq(ig,l,igcm_ccn_mass)
296	& + pdq(ig,l,igcm_ccn_mass)
297	subpdq(ig,l,igcm_ccn_number) =
298	& subpdq(ig,l,igcm_ccn_number)
299	& + pdq(ig,l,igcm_ccn_number)
300	ENDDO
301	ENDDO
302	ENDIF
303	DO l=1,nlay
304	DO ig=1,ngrid
305	subpdq(ig,l,igcm_h2o_ice) =
306	& subpdq(ig,l,igcm_h2o_ice)
307	& + pdq(ig,l,igcm_h2o_ice)
308	subpdq(ig,l,igcm_h2o_vap) =
309	& subpdq(ig,l,igcm_h2o_vap)
310	& + pdq(ig,l,igcm_h2o_vap)
311	ENDDO
312	ENDDO
313
314	c-------------------------------------------------------------------
315	c 2. Main call to the different cloud schemes:
316	c------------------------------------------------
317	IF (microphys) THEN
318	CALL improvedclouds(ngrid,nlay,microtimestep,
319	& pplay,zteff,subpdt,
320	& pqeff,subpdq,subpdqcloud,subpdtcloud,
321	& nq,tauscaling)
322
323	ELSE
324	CALL simpleclouds(ngrid,nlay,microtimestep,
325	& pplay,pzlay,zteff,subpdt,
326	& pqeff,subpdq,subpdqcloud,subpdtcloud,
327	& nq,tau,rice)
328	ENDIF
329
330	c-------------------------------------------------------------------
331	c 3. Updating tendencies after cloud scheme:
332	c-----------------------------------------------
333
334	IF (microphys) THEN
335	DO l=1,nlay
336	DO ig=1,ngrid
337	subpdq(ig,l,igcm_dust_mass) =
338	& subpdq(ig,l,igcm_dust_mass)
339	& + subpdqcloud(ig,l,igcm_dust_mass)
340	subpdq(ig,l,igcm_dust_number) =
341	& subpdq(ig,l,igcm_dust_number)
342	& + subpdqcloud(ig,l,igcm_dust_number)
343	subpdq(ig,l,igcm_ccn_mass) =
344	& subpdq(ig,l,igcm_ccn_mass)
345	& + subpdqcloud(ig,l,igcm_ccn_mass)
346	subpdq(ig,l,igcm_ccn_number) =
347	& subpdq(ig,l,igcm_ccn_number)
348	& + subpdqcloud(ig,l,igcm_ccn_number)
349	ENDDO
350	ENDDO
351	ENDIF
352	DO l=1,nlay
353	DO ig=1,ngrid
354	subpdq(ig,l,igcm_h2o_ice) =
355	& subpdq(ig,l,igcm_h2o_ice)
356	& + subpdqcloud(ig,l,igcm_h2o_ice)
357	subpdq(ig,l,igcm_h2o_vap) =
358	& subpdq(ig,l,igcm_h2o_vap)
359	& + subpdqcloud(ig,l,igcm_h2o_vap)
360	ENDDO
361	ENDDO
362
363	IF (activice) THEN
364	DO l=1,nlay
365	DO ig=1,ngrid
366	subpdt(ig,l) =
367	& subpdt(ig,l) + subpdtcloud(ig,l)
368	ENDDO
369	ENDDO
370	ENDIF
371
372
373	ENDDO ! of DO microstep=1,imicro
374
375	c-------------------------------------------------------------------
376	c 6. Compute final tendencies after time loop:
377	c------------------------------------------------
378
379	c------ Temperature tendency pdtcloud
380	DO l=1,nlay
381	DO ig=1,ngrid
382	pdtcloud(ig,l) =
383	& subpdt(ig,l)/real(imicro)-pdt(ig,l)
384	ENDDO
385	ENDDO
386
387	c------ Tracers tendencies pdqcloud
388	DO l=1,nlay
389	DO ig=1,ngrid
390	pdqcloud(ig,l,igcm_h2o_ice) =
391	& subpdq(ig,l,igcm_h2o_ice)/real(imicro)
392	& - pdq(ig,l,igcm_h2o_ice)
393	pdqcloud(ig,l,igcm_h2o_vap) =
394	& subpdq(ig,l,igcm_h2o_vap)/real(imicro)
395	& - pdq(ig,l,igcm_h2o_vap)
396	ENDDO
397	ENDDO
398
399	IF(microphys) THEN
400	DO l=1,nlay
401	DO ig=1,ngrid
402	pdqcloud(ig,l,igcm_ccn_mass) =
403	& subpdq(ig,l,igcm_ccn_mass)/real(imicro)
404	& - pdq(ig,l,igcm_ccn_mass)
405	pdqcloud(ig,l,igcm_ccn_number) =
406	& subpdq(ig,l,igcm_ccn_number)/real(imicro)
407	& - pdq(ig,l,igcm_ccn_number)
408	ENDDO
409	ENDDO
410	ENDIF
411
412	IF(scavenging) THEN
413	DO l=1,nlay
414	DO ig=1,ngrid
415	pdqcloud(ig,l,igcm_dust_mass) =
416	& subpdq(ig,l,igcm_dust_mass)/real(imicro)
417	& - pdq(ig,l,igcm_dust_mass)
418	pdqcloud(ig,l,igcm_dust_number) =
419	& subpdq(ig,l,igcm_dust_number)/real(imicro)
420	& - pdq(ig,l,igcm_dust_number)
421	ENDDO
422	ENDDO
423	ENDIF
424
425	c------- Due to stepped entry, other processes tendencies can add up to negative values
426	c------- Therefore, enforce positive values and conserve mass
427	IF(microphys) THEN
428	DO l=1,nlay
429	DO ig=1,ngrid
430	IF ((pq(ig,l,igcm_ccn_number) +
431	& ptimestep* (pdq(ig,l,igcm_ccn_number) +
432	& pdqcloud(ig,l,igcm_ccn_number)) .le. 1.)
433	& .or. (pq(ig,l,igcm_ccn_mass) +
434	& ptimestep* (pdq(ig,l,igcm_ccn_mass) +
435	& pdqcloud(ig,l,igcm_ccn_mass)) .le. 1.e-20)) THEN
436	pdqcloud(ig,l,igcm_ccn_number) =
437	& - pq(ig,l,igcm_ccn_number)/ptimestep
438	& - pdq(ig,l,igcm_ccn_number) + 1.
439	pdqcloud(ig,l,igcm_dust_number) =
440	& -pdqcloud(ig,l,igcm_ccn_number)
441	pdqcloud(ig,l,igcm_ccn_mass) =
442	& - pq(ig,l,igcm_ccn_mass)/ptimestep
443	& - pdq(ig,l,igcm_ccn_mass) + 1.e-20
444	pdqcloud(ig,l,igcm_dust_mass) =
445	& -pdqcloud(ig,l,igcm_ccn_mass)
446	ENDIF
447	ENDDO
448	ENDDO
449	ENDIF
450
451	IF(scavenging) THEN
452	DO l=1,nlay
453	DO ig=1,ngrid
454	IF ((pq(ig,l,igcm_dust_number) +
455	& ptimestep* (pdq(ig,l,igcm_dust_number) +
456	& pdqcloud(ig,l,igcm_dust_number)) .le. 1.)
457	& .or. (pq(ig,l,igcm_dust_mass) +
458	& ptimestep* (pdq(ig,l,igcm_dust_mass) +
459	& pdqcloud(ig,l,igcm_dust_mass)) .le. 1.e-20)) THEN
460	pdqcloud(ig,l,igcm_dust_number) =
461	& - pq(ig,l,igcm_dust_number)/ptimestep
462	& - pdq(ig,l,igcm_dust_number) + 1.
463	pdqcloud(ig,l,igcm_ccn_number) =
464	& -pdqcloud(ig,l,igcm_dust_number)
465	pdqcloud(ig,l,igcm_dust_mass) =
466	& - pq(ig,l,igcm_dust_mass)/ptimestep
467	& - pdq(ig,l,igcm_dust_mass) + 1.e-20
468	pdqcloud(ig,l,igcm_ccn_mass) =
469	& -pdqcloud(ig,l,igcm_dust_mass)
470	ENDIF
471	ENDDO
472	ENDDO
473	ENDIF
474
475	DO l=1,nlay
476	DO ig=1,ngrid
477	IF (pq(ig,l,igcm_h2o_ice) + ptimestep*
478	& (pdq(ig,l,igcm_h2o_ice) + pdqcloud(ig,l,igcm_h2o_ice))
479	& .le. 1.e-8) THEN
480	pdqcloud(ig,l,igcm_h2o_ice) =
481	& - pq(ig,l,igcm_h2o_ice)/ptimestep - pdq(ig,l,igcm_h2o_ice)
482	pdqcloud(ig,l,igcm_h2o_vap) = -pdqcloud(ig,l,igcm_h2o_ice)
483	ENDIF
484	IF (pq(ig,l,igcm_h2o_vap) + ptimestep*
485	& (pdq(ig,l,igcm_h2o_vap) + pdqcloud(ig,l,igcm_h2o_vap))
486	& .le. 1.e-8) THEN
487	pdqcloud(ig,l,igcm_h2o_vap) =
488	& - pq(ig,l,igcm_h2o_vap)/ptimestep - pdq(ig,l,igcm_h2o_vap)
489	pdqcloud(ig,l,igcm_h2o_ice) = -pdqcloud(ig,l,igcm_h2o_vap)
490	ENDIF
491	ENDDO
492	ENDDO
493
494
495	c------Update the ice and dust particle size "rice" for output or photochemistry
496	c------Only rsedcloud is used for the water cycle
497
498	IF(scavenging) THEN
499	DO l=1, nlay
500	DO ig=1,ngrid
501
502	call updaterdust(
503	& pq(ig,l,igcm_dust_mass) + ! dust mass
504	& (pdq(ig,l,igcm_dust_mass) + ! dust mass
505	& pdqcloud(ig,l,igcm_dust_mass))*ptimestep, ! dust mass
506	& pq(ig,l,igcm_dust_number) + ! dust number
507	& (pdq(ig,l,igcm_dust_number) + ! dust number
508	& pdqcloud(ig,l,igcm_dust_number))*ptimestep, ! dust number
509	& rdust(ig,l))
510
511	ENDDO
512	ENDDO
513	ENDIF
514
515	IF(microphys) THEN
516
517	! In case one does not want to allow supersatured water when using microphysics.
518	! Not done by default.
519	IF(.not.supersat) THEN
520	zt = pt + (pdt+pdtcloud)*ptimestep
521	call watersat(ngrid*nlay,zt,pplay,zqsat)
522	DO l=1, nlay
523	DO ig=1,ngrid
524	IF (pq(ig,l,igcm_h2o_vap)
525	& + (pdq(ig,l,igcm_h2o_vap) + pdqcloud(ig,l,igcm_h2o_vap))
526	& * ptimestep .ge. zqsat(ig,l)) THEN
527	pdqcloud(ig,l,igcm_h2o_vap) =
528	& (zqsat(ig,l) - pq(ig,l,igcm_h2o_vap))/ptimestep
529	& - pdq(ig,l,igcm_h2o_vap)
530	pdqcloud(ig,l,igcm_h2o_ice) =
531	& -pdqcloud(ig,l,igcm_h2o_vap)
532	! no need to correct ccn_number, updaterad can handle this properly.
533	ENDIF
534	ENDDO
535	ENDDO
536	ENDIF
537
538	DO l=1, nlay
539	DO ig=1,ngrid
540
541	call updaterice_micro(
542	& pq(ig,l,igcm_h2o_ice) + ! ice mass
543	& (pdq(ig,l,igcm_h2o_ice) + ! ice mass
544	& pdqcloud(ig,l,igcm_h2o_ice))*ptimestep, ! ice mass
545	& pq(ig,l,igcm_ccn_mass) + ! ccn mass
546	& (pdq(ig,l,igcm_ccn_mass) + ! ccn mass
547	& pdqcloud(ig,l,igcm_ccn_mass))*ptimestep, ! ccn mass
548	& pq(ig,l,igcm_ccn_number) + ! ccn number
549	& (pdq(ig,l,igcm_ccn_number) + ! ccn number
550	& pdqcloud(ig,l,igcm_ccn_number))*ptimestep, ! ccn number
551	& tauscaling(ig),rice(ig,l),rhocloud(ig,l))
552
553	ENDDO
554	ENDDO
555
556	ELSE ! no microphys
557
558	DO l=1,nlay
559	DO ig=1,ngrid
560
561	call updaterice_typ(
562	& pq(ig,l,igcm_h2o_ice) + ! ice mass
563	& (pdq(ig,l,igcm_h2o_ice) + ! ice mass
564	& pdqcloud(ig,l,igcm_h2o_ice))*ptimestep, ! ice mass
565	& tau(ig,1),pzlay(ig,l),rice(ig,l))
566
567	ENDDO
568	ENDDO
569
570	ENDIF ! of IF(microphys)
571
572
573
574	c A correction if a lot of subliming CO2 fills the 1st layer FF04/2005
575	c ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
576	c Then that should not affect the ice particle radius
577	do ig=1,ngrid
578	if(pdpsrf(ig)ptimestep.gt.0.9(pplev(ig,1)-pplev(ig,2)))then
579	if(pdpsrf(ig)ptimestep.gt.0.9(pplev(ig,1)-pplev(ig,3)))
580	& rice(ig,2)=rice(ig,3)
581	rice(ig,1)=rice(ig,2)
582	end if
583	end do
584
585
586	DO l=1,nlay
587	DO ig=1,ngrid
588	rsedcloud(ig,l)=max(rice(ig,l)*
589	& (1.+nuice_sed)(1.+nuice_sed)(1.+nuice_sed),
590	& rdust(ig,l))
591	! rsedcloud(ig,l)=min(rsedcloud(ig,l),1.e-4)
592	ENDDO
593	ENDDO
594
595	! used for rad. transfer calculations
596	! nuice is constant because a lognormal distribution is prescribed
597	nuice(1:ngrid,1:nlay)=nuice_ref
598
599	c------Update tendencies for sub-grid water ice clouds
600	IF (CLFvarying) THEN
601	DO ig=1,ngrid
602	DO l=1,nlay
603	pdqcloud(ig,l,igcm_dust_mass)=pdqcloud(ig,l,igcm_dust_mass)
604	& *cloudfrac(ig,l)
605	pdqcloud(ig,l,igcm_ccn_mass)=pdqcloud(ig,l,igcm_ccn_mass)
606	& *cloudfrac(ig,l)
607	pdqcloud(ig,l,igcm_dust_number)=pdqcloud(ig,l,
608	& igcm_dust_number) *cloudfrac(ig,l)
609	pdqcloud(ig,l,igcm_ccn_number)=pdqcloud(ig,l,
610	& igcm_ccn_number) *cloudfrac(ig,l)
611	pdqcloud(ig,l,igcm_h2o_vap)=pdqcloud(ig,l,
612	& igcm_h2o_vap) *cloudfrac(ig,l)
613	pdqcloud(ig,l,igcm_h2o_ice)=pdqcloud(ig,l,
614	& igcm_h2o_ice) *cloudfrac(ig,l)
615	ENDDO
616	ENDDO
617	pdtcloud(:,:)=pdtcloud(:,:)*cloudfrac(:,:)
618	ENDIF
619	#ifndef MESOSCALE
620	c=======================================================================
621	call WRITEDIAGFI(ngrid,"pdqice2","pdqcloudice apres microphysique"
622	& ,"kg/kg.s-1",3,pdqcloud(1:ngrid,1:nlay,igcm_h2o_ice))
623	call WRITEDIAGFI(ngrid,"pdqvap2","pdqcloudvap apres microphysique"
624	& ,"kg/kg.s-1",3,pdqcloud(1:ngrid,1:nlay,
625	& igcm_h2o_vap))
626	call WRITEDIAGFI(ngrid,"pdqccn2","pdqcloudccn apres microphysique"
627	& ,"kg/kg.s-1",3,pdqcloud(1:ngrid,1:nlay,
628	& igcm_ccn_mass))
629	call WRITEDIAGFI(ngrid,"pdqccnN2","pdqcloudccnN apres
630	& microphysique","nb/kg.s-1",3,pdqcloud(1:ngrid,1:nlay,
631	& igcm_ccn_number))
632	call WRITEDIAGFI(ngrid,"pdqdust2", "pdqclouddust apres
633	& microphysique","kg/kg.s-1",3,pdqcloud(1:ngrid,1:nlay,
634	& igcm_dust_mass))
635	call WRITEDIAGFI(ngrid,"pdqdustN2", "pdqclouddustN apres
636	& microphysique","nb/kg.s-1",3,pdqcloud(1:ngrid,1:nlay,
637	& igcm_dust_number))
638	c=======================================================================
639	#endif
640
641	END SUBROUTINE watercloud
642
643	END MODULE watercloud_mod

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

Download in other formats:

Original Format