Context Navigation

cocloud.F90 @ 3585

Last change on this file since 3585 was 3585, checked in by debatzbr, 9 hours ago
Connecting microphysics to radiative transfer + miscellaneous cleans
File size: 8.5 KB

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

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

Download in other formats:

Original Format