Context Navigation

watercloud_mod.F @ 1747

Last change on this file since 1747 was 1711, checked in by mvals, 8 years ago

Mars GCM

implementation of a sub-grid water cloud fraction scheme (by A. Pottier): If CLFvarying is set to true in callphys.def, then the sub-grid cloud fraction routine is applied in watercloud.F and aeropacity.F.
accordingly modified files are: watercloud.F, aeropacity.F, callradite.F, conf_phys.F, phyetat0.F, phyredem.F90, physiq_mod.F, testphys1d.F, callkeys.h, newtsart.F, start2archive.F, lect_start_archive.F
added file: tcondwater.F90, used by watercloud.F to calculate the condensation temperature of water
watercloud.F, aeropacity.F, callradite.F are converted to module files as watercloud_mod.F, aeropacity_mod.F, callradite_mod.F

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

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

Download in other formats:

Original Format