Context Navigation

ajsec.F @ 3884

Last change on this file since 3884 was 3884, checked in by ikovalenko, 4 months ago

File size: 6.1 KB

Line
1	!
2	! $Header: /home/cvsroot/LMDZ4/libf/phylmd/ajsec.F,v 1.1.1.1 2004/05/19 12:53:08 lmdzadmin Exp $
3	!
4	! ADAPTATION GCM POUR CP(T)
5	SUBROUTINE ajsec(paprs, pplay, ppk, tfi, ufi, vfi, nq, qfi,
6	. d_tfi, d_ufi, d_vfi, d_qfi)
7
8	use dimphy
9	use mod_grid_phy_lmdz, only: nbp_lev
10	use cpdet_phy_mod, only: t2tpot, tpot2t
11	use YOMCST_mod
12	IMPLICIT none
13	c======================================================================
14	c Auteur(s): Z.X. Li (LMD/CNRS) date: 19930818
15	c Objet: ajustement sec (adaptation du GCM du LMD)
16	c S. Lebonnois, 10/2007:
17	c melange u et v comme dans convadj (MARS)
18	c======================================================================
19	c Arguments:
20	c tfi-------input-R- Temperature
21	c ufi-------input-R- vent zonal
22	c vfi-------input-R- vent meridien
23	c nq--------input-R- nombre de traceurs
24	c qfi-------input-R- traceurs
25	c
26	c d_tfi-----output-R-Incrementation de la temperature
27	c d_ufi-----output-R-Incrementation du vent zonal
28	c d_vfi-----output-R-Incrementation du vent meridien
29	c d_qfi-----output-R-Incrementation des traceurs
30	c======================================================================
31	C#include "YOMCST.h"
32	REAL paprs(klon,klev+1), pplay(klon,klev)
33	REAL ppk(klon,klev)
34	INTEGER nq
35	REAL tfi(klon,klev), d_tfi(klon,klev)
36	REAL ufi(klon,klev), d_ufi(klon,klev)
37	REAL vfi(klon,klev), d_vfi(klon,klev)
38	REAL qfi(klon,klev,nq), d_qfi(klon,klev,nq)
39	c
40	INTEGER,save :: limbas, limhau ! les couches a ajuster
41	c
42	REAL zh(klon,klev)
43	REAL zu(klon,klev),zv(klon,klev)
44	REAL zt(klon,klev),zq(klon,klev,nq)
45	REAL zdp(klon,klev)
46	REAL zpkdp(klon,klev)
47	REAL hm,sm,zum,zvm,zalpha,zqm(nq)
48	LOGICAL modif(klon), down
49	INTEGER i, k, k1, k2, iq
50	c
51	c Initialisation:
52	c
53	limbas=1
54	limhau=klev
55
56	DO k = 1, klev
57	DO i = 1, klon
58	d_tfi(i,k) = 0.0
59	d_ufi(i,k) = 0.0
60	d_vfi(i,k) = 0.0
61	d_qfi(i,k,:) = 0.0
62	zu(i,k) = ufi(i,k)
63	zv(i,k) = vfi(i,k)
64	zq(i,k,:) = qfi(i,k,:)
65	ENDDO
66	ENDDO
67	c------------------------------------- passage en temperature potentielle
68	! ADAPTATION GCM POUR CP(T)
69	call t2tpot(klon*nbp_lev,tfi,zh,ppk)
70	c
71	DO k = limbas, limhau
72	DO i = 1, klon
73	zdp(i,k) = paprs(i,k)-paprs(i,k+1)
74	zpkdp(i,k) = ppk(i,k) * zdp(i,k)
75	ENDDO
76	ENDDO
77	c
78	c------------------------------------- detection des profils a modifier
79	DO i = 1, klon
80	modif(i) = .FALSE.
81	ENDDO
82	DO k = limbas+1, limhau
83	DO i = 1, klon
84	IF (.NOT.modif(i)) THEN
85	IF ( zh(i,k).LT.zh(i,k-1) ) modif(i) = .TRUE.
86	ENDIF
87	ENDDO
88	ENDDO
89	c------------------------------------- correction des profils instables
90	DO 1080 i = 1, klon
91	IF (modif(i)) THEN
92	k2 = limbas
93	8000 CONTINUE
94	k2 = k2 + 1
95	IF (k2 .GT. limhau) goto 8001
96	IF (zh(i,k2) .LT. zh(i,k2-1)) THEN
97	k1 = k2 - 1
98	k = k1
99	sm = zpkdp(i,k2)
100	hm = zh(i,k2)
101	8020 CONTINUE
102	sm = sm +zpkdp(i,k)
103	hm = hm +zpkdp(i,k) * (zh(i,k)-hm) / sm
104	down = .FALSE.
105	IF (k1 .ne. limbas) THEN
106	IF (hm .LT. zh(i,k1-1)) down = .TRUE.
107	ENDIF
108	IF (down) THEN
109	k1 = k1 - 1
110	k = k1
111	ELSE
112	IF ((k2 .EQ. limhau)) GOTO 8021
113	IF ((zh(i,k2+1).GE.hm)) GOTO 8021
114	k2 = k2 + 1
115	k = k2
116	ENDIF
117	GOTO 8020
118	8021 CONTINUE
119	c------------ nouveau profil : constant (valeur moyenne)
120	c------------ et melange partiel des vents
121	zalpha=0.
122	zum=0.
123	zvm=0.
124	zqm=0.
125	DO k = k1, k2
126	zalpha=zalpha+ABS(zh(i,k)-hm)*zdp(i,k)
127	zh(i,k) = hm
128	zum=zum+ufi(i,k)*zdp(i,k)
129	zvm=zvm+vfi(i,k)*zdp(i,k)
130	do iq=1,nq
131	zqm(iq)=zqm(iq)+qfi(i,k,iq)*zdp(i,k)
132	enddo
133	ENDDO
134	zalpha=zalpha/(hm*(paprs(i,k1)-paprs(i,k2+1)))
135	zum=zum/(paprs(i,k1)-paprs(i,k2+1))
136	zvm=zvm/(paprs(i,k1)-paprs(i,k2+1))
137	do iq=1,nq
138	zqm(iq)=zqm(iq)/(paprs(i,k1)-paprs(i,k2+1))
139	enddo
140
141	IF(zalpha.GT.1.) THEN
142	PRINT*,'WARNING dans ajsec zalpha=',zalpha
143	c STOP
144	zalpha=1.
145	ELSE
146	c IF(zalpha.LT.0.) STOP
147	IF(zalpha.LT.1.e-5) zalpha=1.e-4
148	ENDIF
149	c ----------------------------
150	c TEST --- PAS DE MELANGE DE U ni Q
151	c zalpha=0.
152	c ----------------------------
153
154	DO k=k1,k2
155	zu(i,k)=ufi(i,k)+zalpha*(zum-ufi(i,k))
156	zv(i,k)=vfi(i,k)+zalpha*(zvm-vfi(i,k))
157	do iq=1,nq
158	zq(i,k,iq)=qfi(i,k,iq)+zalpha*(zqm(iq)-qfi(i,k,iq))
159	enddo
160	ENDDO
161	k2 = k2 + 1
162	ENDIF
163	GOTO 8000
164	8001 CONTINUE
165	ENDIF
166	1080 CONTINUE
167	c
168	c------------------------------------- passage en temperature
169	c------------------------------------- et calcul du d_t
170	! ADAPTATION GCM POUR CP(T)
171	call tpot2t(klon*nbp_lev,zh,zt,ppk)
172
173	DO k = limbas, limhau
174	DO i = 1, klon
175	d_tfi(i,k) = zt(i,k) - tfi(i,k)
176	d_ufi(i,k) = zu(i,k) - ufi(i,k)
177	d_vfi(i,k) = zv(i,k) - vfi(i,k)
178	do iq=1,nq
179	d_qfi(i,k,iq) = zq(i,k,iq) - qfi(i,k,iq)
180	enddo
181	ENDDO
182	ENDDO
183	c
184	IF (limbas.GT.1) THEN
185	DO k = 1, limbas-1
186	DO i = 1, klon
187	d_tfi(i,k) = 0.0
188	d_ufi(i,k) = 0.0
189	d_vfi(i,k) = 0.0
190	do iq=1,nq
191	d_qfi(i,k,iq) = 0.0
192	enddo
193	ENDDO
194	ENDDO
195	ENDIF
196	c
197	IF (limhau.LT.klev) THEN
198	DO k = limhau+1, klev
199	DO i = 1, klon
200	d_tfi(i,k) = 0.0
201	d_ufi(i,k) = 0.0
202	d_vfi(i,k) = 0.0
203	do iq=1,nq
204	d_qfi(i,k,iq) = 0.0
205	enddo
206	ENDDO
207	ENDDO
208	ENDIF
209	c
210	RETURN
211	END
212

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

Download in other formats:

Original Format