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