Context Navigation

largescale.F90 @ 1477

Last change on this file since 1477 was 1397, checked in by milmd, 10 years ago
In LMDZ.GENERIC replacement of all phystd .h files by module files.
File size: 6.1 KB

Line
1	subroutine largescale(ngrid,nlayer,nq,ptimestep, pplev, pplay, &
2	pt, pq, pdt, pdq, pdtlsc, pdqvaplsc, pdqliqlsc, rneb)
3
4
5	! to use 'getin'
6	! use ioipsl_getincom
7	use ioipsl_getincom_p
8	use watercommon_h, only : RLVTT, RCPD, RVTMP2, &
9	T_h2O_ice_clouds,T_h2O_ice_liq,Psat_waterDP,Lcpdqsat_waterDP
10	USE tracer_h
11	IMPLICIT none
12
13	!==================================================================
14	!
15	! Purpose
16	! -------
17	! Calculates large-scale (stratiform) H2O condensation.
18	!
19	! Authors
20	! -------
21	! Adapted from the LMDTERRE code by R. Wordsworth (2009)
22	! Original author Z. X. Li (1993)
23	!
24	!==================================================================
25
26	INTEGER ngrid,nlayer,nq
27
28	! Arguments
29	REAL ptimestep ! intervalle du temps (s)
30	REAL pplev(ngrid,nlayer+1) ! pression a inter-couche
31	REAL pplay(ngrid,nlayer) ! pression au milieu de couche
32	REAL pt(ngrid,nlayer) ! temperature (K)
33	REAL pq(ngrid,nlayer,nq) ! tracer mixing ratio (kg/kg)
34	REAL pdt(ngrid,nlayer) ! physical temperature tenedency (K/s)
35	REAL pdq(ngrid,nlayer,nq)! physical tracer tenedency (K/s)
36	REAL pdtlsc(ngrid,nlayer) ! incrementation de la temperature (K)
37	REAL pdqvaplsc(ngrid,nlayer) ! incrementation de la vapeur d'eau
38	REAL pdqliqlsc(ngrid,nlayer) ! incrementation de l'eau liquide
39	REAL rneb(ngrid,nlayer) ! fraction nuageuse
40
41
42	! Options du programme
43	REAL, SAVE :: ratqs ! determine largeur de la distribution de vapeur
44	!$OMP THREADPRIVATE(ratqs)
45
46	! Variables locales
47	REAL CBRT
48	EXTERNAL CBRT
49	INTEGER i, k , nn
50	INTEGER,PARAMETER :: nitermax=5000
51	DOUBLE PRECISION,PARAMETER :: alpha=.1,qthreshold=1.d-8
52	! JL13: if "careful, T<Tmin in psat water" appears often, you may want to stabilise the model by
53	! decreasing alpha and increasing nitermax accordingly
54	DOUBLE PRECISION zt(ngrid), zq(ngrid)
55	DOUBLE PRECISION zcond(ngrid),zcond_iter
56	DOUBLE PRECISION zdelq(ngrid)
57	DOUBLE PRECISION zqs(ngrid), zdqs(ngrid)
58	DOUBLE PRECISION local_p,psat_tmp,dlnpsat_tmp,Lcp
59
60	! evaporation calculations
61	REAL dqevap(ngrid,nlayer),dtevap(ngrid,nlayer)
62	REAL qevap(ngrid,nlayer,nq)
63	REAL tevap(ngrid,nlayer)
64
65	DOUBLE PRECISION zx_q(ngrid)
66	LOGICAL,SAVE :: firstcall=.true.
67	!$OMP THREADPRIVATE(firstcall)
68
69
70	IF (firstcall) THEN
71
72	write(,) "value for ratqs? "
73	ratqs=0.2 ! default value
74	call getin_p("ratqs",ratqs)
75	write(,) " ratqs = ",ratqs
76
77	firstcall = .false.
78	ENDIF
79
80	! GCM -----> subroutine variables, initialisation of outputs
81
82	pdtlsc(1:ngrid,1:nlayer) = 0.0
83	pdqvaplsc(1:ngrid,1:nlayer) = 0.0
84	pdqliqlsc(1:ngrid,1:nlayer) = 0.0
85	rneb(1:ngrid,1:nlayer) = 0.0
86	Lcp=RLVTT/RCPD
87
88
89	! Evaporate cloud water/ice
90	call evap(ngrid,nlayer,nq,ptimestep,pt,pq,pdq,pdt,dqevap,dtevap,qevap,tevap)
91	! note: we use qevap but not tevap in largescale/moistadj
92	! otherwise is a big mess
93
94
95	! Boucle verticale (du haut vers le bas)
96	DO k = nlayer, 1, -1
97
98	zt(1:ngrid)=pt(1:ngrid,k)+(pdt(1:ngrid,k)+dtevap(1:ngrid,k))*ptimestep
99	zq(1:ngrid)=qevap(1:ngrid,k,igcm_h2o_vap) !liquid water is included in qevap
100
101	! Calculer la vapeur d'eau saturante et
102	! determiner la condensation partielle
103	DO i = 1, ngrid
104
105	local_p=pplay(i,k)
106	if(zt(i).le.15.) then
107	print*,'in lsc',i,k,zt(i)
108	! zt(i)=15. ! check too low temperatures
109	endif
110	call Psat_waterDP(zt(i),local_p,psat_tmp,zqs(i))
111
112	zdelq(i) = MAX(MIN(ratqs * zq(i),1.-zq(i)),1.d-12)
113	rneb(i,k) = (zq(i)+zdelq(i)-zqs(i)) / (2.0*zdelq(i))
114	if (rneb(i,k).lt.0.) then !no clouds
115
116	rneb(i,k)=0.
117	zcond(i)=0.
118
119	else if ((rneb(i,k).gt.0.99).or.(ratqs.lt.1.e-6)) then !complete cloud cover, we start without evaporating
120	rneb(i,k)=1.
121	zt(i)=pt(i,k)+pdt(i,k)*ptimestep
122	zx_q(i) = pq(i,k,igcm_h2o_vap)+pdq(i,k,igcm_h2o_vap)*ptimestep
123	dqevap(i,k)=0.
124	! iterative process to stabilize the scheme when large water amounts JL12
125	zcond(i) = 0.0d0
126	Do nn=1,nitermax
127	call Psat_waterDP(zt(i),local_p,psat_tmp,zqs(i))
128	call Lcpdqsat_waterDP(zt(i),local_p,psat_tmp,zqs(i),zdqs(i),dlnpsat_tmp)
129	zcond_iter = alpha*(zx_q(i)-zqs(i))/(1.d0+zdqs(i))
130	!zcond can be negative here
131	zx_q(i) = zx_q(i) - zcond_iter
132	zcond(i) = zcond(i) + zcond_iter
133	zt(i) = zt(i) + zcond_iter*Lcp
134	if (ABS(zcond_iter/alpha/zqs(i)).lt.qthreshold) exit
135	! if (ABS(zcond_iter/alpha).lt.qthreshold) exit
136	if (nn.eq.nitermax) print*,'itermax in largescale'
137	End do ! niter
138	zcond(i)=MAX(zcond(i),-(pq(i,k,igcm_h2o_ice)+pdq(i,k,igcm_h2o_ice)*ptimestep))
139
140	else !standard case
141
142	zx_q(i) = (zq(i)+zdelq(i)+zqs(i))/2.0d0 !water vapor in cloudy sky
143	! iterative process to stabilize the scheme when large water amounts JL12
144	zcond(i) = 0.0d0
145	Do nn=1,nitermax
146	call Lcpdqsat_waterDP(zt(i),local_p,psat_tmp,zqs(i),zdqs(i),dlnpsat_tmp)
147	zcond_iter = MAX(0.0d0,alpha*(zx_q(i)-zqs(i))/(1.d0+zdqs(i)))
148	!zcond always postive! cannot evaporate clouds!
149	!this is why we must reevaporate before largescale
150	zx_q(i) = zx_q(i) - zcond_iter
151	zcond(i) = zcond(i) + zcond_iter
152	if (ABS(zcond_iter/alpha/zqs(i)).lt.qthreshold) exit
153	! if (ABS(zcond_iter/alpha).lt.qthreshold) exit
154	zt(i) = zt(i) + zcond_iterLcprneb(i,k)
155	call Psat_waterDP(zt(i),local_p,psat_tmp,zqs(i))
156	if (nn.eq.nitermax) print*,'itermax in largescale'
157	End do ! niter
158
159	Endif
160
161	zcond(i) = zcond(i)*rneb(i,k)/ptimestep ! JL12
162
163	ENDDO
164
165	! Tendances de t et q
166	pdqvaplsc(1:ngrid,k) = dqevap(1:ngrid,k) - zcond(1:ngrid)
167	pdqliqlsc(1:ngrid,k) = - pdqvaplsc(1:ngrid,k)
168	pdtlsc(1:ngrid,k) = pdqliqlsc(1:ngrid,k)*real(Lcp)
169
170	Enddo ! k= nlayer, 1, -1
171
172
173	end

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

Download in other formats:

Original Format