Context Navigation

← Previous Revision
Latest Revision
Next Revision →
Blame
Revision Log

cocloud.F @ 3436

Last change on this file since 3436 was 3175, checked in by emillour, 11 months ago
Pluto PCM: Add the old Pluto LMDZ for reference (required prior step to making an LMDZ.PLUTO using the same framework as the other physics packages). TB+EM
File size: 8.7 KB

Line
1	SUBROUTINE cocloud(ngrid,nlay,naersize, ptimestep,
2	& pplev,pplay,pdpsrf,pzlev,pzlay,pt,pdt,
3	& pq,pdq,pdqcloud,pdqscloud,pdtcloud,
4	& nq,rice_co)
5
6	use comgeomfi_h
7	IMPLICIT NONE
8
9	c=======================================================================
10	c Treatment of saturation of CARBON MONOXIDE
11	c
12	c
13	c Modif de zq si saturation dans l'atmosphere
14	c si zq(ig,l)> zqsat(ig,l) -> zq(ig,l)=zqsat(ig,l)
15	c Le test est effectue de bas en haut. CO condensee
16	c (si saturation) est remise dans la couche en dessous.
17	c CO condensee dans la couche du bas est deposee a la surface
18	c
19	c
20	c=======================================================================
21
22	c-----------------------------------------------------------------------
23	c declarations:
24	c -------------
25
26	#include "dimensions.h"
27	#include "dimphys.h"
28	#include "comcstfi.h"
29	#include "callkeys.h"
30	#include "tracer.h"
31
32	c Inputs:
33	c ------
34
35	INTEGER ngrid,nlay
36	REAL ptimestep ! pas de temps physique (s)
37	REAL pplev(ngrid,nlay+1) ! pression aux inter-couches (Pa)
38	REAL pplay(ngrid,nlay) ! pression au milieu des couches (Pa)
39	REAL pdpsrf(ngrid) ! tendance surf pressure
40	REAL pzlev(ngrid,nlay+1) ! altitude at layer boundaries
41	REAL pzlay(ngrid,nlay) ! altitude at the middle of the layers
42	REAL pt(ngrid,nlay) ! temperature at the middle of the layers (K)
43	REAL pdt(ngrid,nlay) ! tendance temperature des autres param.
44
45	real pq(ngrid,nlay,nq) ! traceur (kg/kg)
46	real pdq(ngrid,nlay,nq) ! tendance avant condensation (kg/kg.s-1)
47	integer naersize ! nombre de traceurs radiativement actifs (=naerkind)
48	integer nq ! nombre de traceurs
49
50	c Outputs:
51	c -------
52
53	real pdqcloud(ngrid,nlay,nq) ! tendance de la condensation CO(kg/kg.s-1)
54	real pdqscloud(ngrid,nq) ! flux en surface (kg.m-2.s-1)
55	REAL pdtcloud(ngrid,nlay) ! tendance temperature due
56	! a la chaleur latente
57
58	REAL rice_co(ngrid,nlay) ! Ice mass mean radius (m)
59	! (r_c in montmessin_2004)
60
61	c local:
62	c ------
63	c REAL Nmix ! Cloud condensation nuclei
64	c parameter (Nmix=1.E2) ! /kg
65	! parameter (Nmix=1) ! /kg
66	real rnuclei ! Nuclei geometric mean radius (m)
67	parameter (rnuclei=2.E-7) ! m
68
69	REAL CBRT
70	EXTERNAL CBRT
71	INTEGER ig,l
72
73
74	REAL zq(ngridmx,nlayermx,nqmx) ! local value of tracers
75	REAL zq0(ngridmx,nlayermx,nqmx) ! local initial value of tracers
76	REAL zqsat(ngridmx,nlayermx) ! saturation
77	REAL zt(ngridmx,nlayermx) ! local value of temperature
78
79	REAL vecnull(ngridmx*nlayermx)
80
81	REAL masse (ngridmx,nlayermx)
82	REAL epaisseur (ngridmx,nlayermx)
83	! REAL rfinal ! Ice crystal radius after condensation(m)
84	REAL*8 dzq ! masse de glace echangee (kg/kg)
85	REAL lw !Latent heat of sublimation (J.kg-1)
86
87
88	LOGICAL,SAVE :: firstcall=.true.
89
90	! indexes of co gas, co ice and dust tracers:
91	INTEGER,SAVE :: i_co=0 ! co gas
92	INTEGER,SAVE :: i_ice=0 ! co ice
93
94	c ** un petit test de coherence
95	c --------------------------
96
97	IF (firstcall) THEN
98	IF(ngrid.NE.ngridmx) THEN
99	PRINT*,'STOP dans cocloud'
100	PRINT*,'probleme de dimensions :'
101	PRINT*,'ngrid =',ngrid
102	PRINT*,'ngridmx =',ngridmx
103	STOP
104	ENDIF
105
106	if (nq.gt.nqmx) then
107	write(,) 'stop in cocloud (nq.gt.nqmx)!'
108	write(,) 'nq=',nq,' nqmx=',nqmx
109	stop
110	endif
111
112	c MELANIE : change these line
113	i_co=igcm_co_gas
114	i_ice=igcm_co_ice
115
116	write(,) "cocloud: i_co=",i_co
117	write(,) " i_ice=",i_ice
118
119	firstcall=.false.
120	ENDIF ! of IF (firstcall)
121
122
123	c-----------------------------------------------------------------------
124	c 1. initialisation
125	c -----------------
126
127	c On "update" la valeur de q(nqmx) (co vapor) et temperature.
128	c On effectue qqes calculs preliminaires sur les couches :
129	c masse (kg.m-2), epaisseur(m).
130
131	do l=1,nlay
132	do ig=1,ngrid
133	zq(ig,l,i_co)=pq(ig,l,i_co)+pdq(ig,l,i_co)*ptimestep
134	zq(ig,l,i_co)=max(zq(ig,l,i_co),1.E-30) ! FF 12/2004
135	zq0(ig,l,i_co)=zq(ig,l,i_co)
136	zt(ig,l)=pt(ig,l)+ pdt(ig,l)*ptimestep
137	masse(ig,l)=(pplev(ig,l) - pplev(ig,l+1)) /g
138	epaisseur(ig,l)= pzlev(ig,l+1) - pzlev(ig,l)
139
140	zq(ig,l,i_ice)=pq(ig,l,i_ice)+pdq(ig,l,i_ice)*ptimestep
141	zq(ig,l,i_ice)=max(zq(ig,l,i_ice),0.) ! FF 12/2004
142	zq0(ig,l,i_ice)=zq(ig,l,i_ice)
143
144	enddo
145	enddo
146	pdqscloud(1:ngrid,1:nq)=0
147	pdqcloud(1:ngrid,1:nlay,1:nq)=0
148	pdtcloud(1:ngrid,1:nlay)=0
149
150	c ----------------------------------------------
151	c
152	c
153	c Rapport de melange a saturation dans la couche l : -------
154	c ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
155	c do l=1,nlay
156	c do ig=1,ngrid
157	c call cosat(zt(ig,l),pplay(ig,l),zqsat(ig,l))
158	c write(101,*)'qsat',qsat(ig,l)
159	c enddo
160	c enddo
161
162	call cosat(ngridmx*nlayermx,zt,pplay,zqsat,vecnull,vecnull)
163	c TEMPORAIRE :
164	c test sans condensation atmospherique
165	c do l=1,nlay
166	c do ig=1,ngrid
167	c zqsat(ig,l) = zqsat(ig,l) *1000.
168	c end do
169	c end do
170	c call WRITEDIAGFI(ngrid,"qsat_co","qsat_co","unit",3,zqsat)
171	c do l=1,nlay
172	c do ig=1,ngrid
173	c zqsat(ig,l)=0.117exp((16568.7/8.314)*(1/90.7
174	c & -1/zt(ig,l)))*100000
175	c zqsat(ig,l)=(zqsat(ig,l)/pplay(ig,l))*(16/28)
176	c write(106,*)'zqsat',zqsat(ig,l)
177	c enddo ! of do ig=1,ngrid
178	c enddo ! of do l=1,nlay
179
180	c taux de condensation (kg/kg/s-1) dans les differentes couches
181	c ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
182
183	do l=1,nlay
184	do ig=1,ngrid
185	c call cosat(zt(ig,l),pplay(ig,l),zqsat(ig,l))
186	if (zq(ig,l,i_co).ge.zqsat(ig,l))then ! Condensation
187	dzq=zq(ig,l,i_co)-zqsat(ig,l)
188	elseif(zq(ig,l,i_co).lt.zqsat(ig,l))then ! Sublimation
189	dzq=-min(zqsat(ig,l)-zq(ig,l,i_co),zq(ig,l,i_ice))
190	endif
191
192	c CO Mass change
193	c ~~~~~~~~~~~~~~~~~
194	zq(ig,l,i_ice)=zq(ig,l,i_ice)+dzq
195	zq(ig,l,i_co)=zq(ig,l,i_co)-dzq
196	rice_co(ig,l)=max( CBRT ( (zq(ig,l,i_ice)/rho_co_ice
197	& +Nmix_co(4./3.)pirnuclei*3.)
198	& /(Nmix_co4./3.pi) ), rnuclei) ! CBRT=cube root
199	enddo ! of do ig=1,ngrid
200	enddo ! of do l=1,nlay
201
202	c Saturation couche nlay a 2 :
203	c ~~~~~~~~~~~~~~~~~~~~~~~~~~
204	c do l=nlay,2, -1
205	c do ig=1,ngrid
206	c if (zq(ig,l,i_co).gt.zqsat(ig,l))then
207	c zq(ig,l-1,i_co)= zq(ig,l-1,i_co)+
208	c & (zq(ig,l,i_co)-zqsat(ig,l))
209	c & *(pplev(ig,l)-pplev(ig,l+1))/(pplev(ig,l-1)-pplev(ig,l))
210	c zq(ig,l,i_co)=zqsat(ig,l)
211	c endif
212	c enddo
213	c enddo
214
215	c Saturation couche l=1 si pas iceparty
216	c ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
217	c do ig=1,ngridmx
218	c if (zq(ig,1,i_co).gt.zqsat(ig,1))then
219	c pdqscloud(ig,i_ice)=(zq(ig,1,i_co)-zqsat(ig,1))
220	c & (pplev(ig,1)-pplev(ig,2))/(gptimestep)
221	c zq(ig,1,i_co)=zqsat(ig,1)
222	c endif
223	c enddo
224
225	c Tendance finale
226	c ~~~~~~~~~~~~~~~
227	do l=1, nlay
228	do ig=1,ngridmx
229	pdqcloud(ig,l,i_co)=(zq(ig,l,i_co)
230	& -zq0(ig,l,i_co))/ptimestep
231	pdqcloud(ig,l,i_ice) =
232	& (zq(ig,l,i_ice) - zq0(ig,l,i_ice))/ptimestep
233
234	lw=lw_co
235	pdtcloud(ig,l)=-pdqcloud(ig,l,i_co)*lw/cpp
236	end do
237	end do
238
239	c A correction if a lot of subliming co fills the 1st layer FF04/2005
240	c ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
241	c Then that should not affect the ice particle radius
242	do ig=1,ngridmx
243	if(pdpsrf(ig)ptimestep.gt.0.9(pplev(ig,1)-pplev(ig,2)))then
244	if(pdpsrf(ig)ptimestep.gt.0.9(pplev(ig,1)-pplev(ig,3)))
245	& rice_co(ig,2)=rice_co(ig,3)
246	rice_co(ig,1)=rice_co(ig,2)
247	end if
248	end do
249
250	c**************************************************
251	c Output --- removed
252	c**************************************************
253	! NB: for diagnostics use zq(), the updated value of tracers
254	c Computing ext visible optical depth in each layer
255
256	RETURN
257	END
258

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

Download in other formats:

Original Format