1 | SUBROUTINE cv3a_compress(len, nloc, ncum, nd, ntra, compress, & |
---|
2 | iflag1, nk1, icb1, icbs1, & |
---|
3 | plcl1, tnk1, qnk1, gznk1, hnk1, unk1, vnk1, & |
---|
4 | wghti1, pbase1, buoybase1, & |
---|
5 | t1, q1, qs1, t1_wake, q1_wake, qs1_wake, s1_wake, & |
---|
6 | u1, v1, gz1, th1, th1_wake, & |
---|
7 | tra1, & |
---|
8 | h1, lv1, lf1, cpn1, p1, ph1, tv1, tp1, tvp1, clw1, & |
---|
9 | h1_wake, lv1_wake, lf1_wake, cpn1_wake, tv1_wake, & |
---|
10 | sig1, w01, ptop21, & |
---|
11 | Ale1, Alp1, omega1, & |
---|
12 | iflag, nk, icb, icbs, & |
---|
13 | plcl, tnk, qnk, gznk, hnk, unk, vnk, & |
---|
14 | wghti, pbase, buoybase, & |
---|
15 | t, q, qs, t_wake, q_wake, qs_wake, s_wake, & |
---|
16 | u, v, gz, th, th_wake, & |
---|
17 | tra, & |
---|
18 | h, lv, lf, cpn, p, ph, tv, tp, tvp, clw, & |
---|
19 | h_wake, lv_wake, lf_wake, cpn_wake, tv_wake, & |
---|
20 | sig, w0, ptop2, & |
---|
21 | Ale, Alp, omega & |
---|
22 | #ifdef ISO |
---|
23 | ,xtnk1,xt1,xt1_wake,xtclw1 & |
---|
24 | ,xtnk,xt,xt_wake,xtclw & |
---|
25 | #endif |
---|
26 | ) |
---|
27 | ! ************************************************************** |
---|
28 | ! * |
---|
29 | ! CV3A_COMPRESS * |
---|
30 | ! * |
---|
31 | ! * |
---|
32 | ! written by : Sandrine Bony-Lena , 17/05/2003, 11.22.15 * |
---|
33 | ! modified by : Jean-Yves Grandpeix, 23/06/2003, 10.28.09 * |
---|
34 | ! ************************************************************** |
---|
35 | #ifdef ISO |
---|
36 | USE infotrac_phy, ONLY: ntraciso=>ntiso |
---|
37 | USE isotopes_mod, ONLY: essai_convergence, iso_eau,iso_HDO |
---|
38 | #ifdef ISOVERIF |
---|
39 | USE isotopes_verif_mod |
---|
40 | #endif |
---|
41 | #endif |
---|
42 | |
---|
43 | IMPLICIT NONE |
---|
44 | |
---|
45 | include "cv3param.h" |
---|
46 | |
---|
47 | ! inputs: |
---|
48 | INTEGER, INTENT (IN) :: len, nloc, nd, ntra |
---|
49 | !jyg< |
---|
50 | LOGICAL, INTENT (IN) :: compress ! compression is performed if compress is true |
---|
51 | !>jyg |
---|
52 | INTEGER, DIMENSION (len), INTENT (IN) :: iflag1, nk1, icb1, icbs1 |
---|
53 | REAL, DIMENSION (len), INTENT (IN) :: plcl1, tnk1, qnk1, gznk1 |
---|
54 | REAL, DIMENSION (len), INTENT (IN) :: hnk1, unk1, vnk1 |
---|
55 | REAL, DIMENSION (len, nd), INTENT (IN) :: wghti1(len, nd) |
---|
56 | REAL, DIMENSION (len), INTENT (IN) :: pbase1, buoybase1 |
---|
57 | REAL, DIMENSION (len, nd), INTENT (IN) :: t1, q1, qs1 |
---|
58 | REAL, DIMENSION (len, nd), INTENT (IN) :: t1_wake, q1_wake, qs1_wake |
---|
59 | REAL, DIMENSION (len), INTENT (IN) :: s1_wake |
---|
60 | REAL, DIMENSION (len, nd), INTENT (IN) :: u1, v1 |
---|
61 | REAL, DIMENSION (len, nd), INTENT (IN) :: gz1, th1, th1_wake |
---|
62 | REAL, DIMENSION (len, nd,ntra), INTENT (IN) :: tra1 |
---|
63 | REAL, DIMENSION (len, nd), INTENT (IN) :: h1, lv1, lf1, cpn1 |
---|
64 | REAL, DIMENSION (len, nd), INTENT (IN) :: p1 |
---|
65 | REAL, DIMENSION (len, nd+1), INTENT (IN) :: ph1(len, nd+1) |
---|
66 | REAL, DIMENSION (len, nd), INTENT (IN) :: tv1, tp1 |
---|
67 | REAL, DIMENSION (len, nd), INTENT (IN) :: tvp1, clw1 |
---|
68 | REAL, DIMENSION (len, nd), INTENT (IN) :: h1_wake, lv1_wake, cpn1_wake |
---|
69 | REAL, DIMENSION (len, nd), INTENT (IN) :: tv1_wake, lf1_wake |
---|
70 | REAL, DIMENSION (len, nd), INTENT (IN) :: sig1, w01 |
---|
71 | REAL, DIMENSION (len), INTENT (IN) :: ptop21 |
---|
72 | REAL, DIMENSION (len), INTENT (IN) :: Ale1, Alp1 |
---|
73 | REAL, DIMENSION (len, nd), INTENT (IN) :: omega1 |
---|
74 | #ifdef ISO |
---|
75 | REAL, DIMENSION (ntraciso,len,nd), INTENT (IN) :: xtclw1 |
---|
76 | REAL, DIMENSION (ntraciso,len), INTENT (IN) :: xtnk1 |
---|
77 | REAL, DIMENSION (ntraciso,len,nd), INTENT (IN) :: xt1 |
---|
78 | REAL, DIMENSION (ntraciso,len,nd), INTENT (IN) :: xt1_wake |
---|
79 | #endif |
---|
80 | |
---|
81 | ! in/out |
---|
82 | INTEGER, INTENT (INOUT) :: ncum |
---|
83 | |
---|
84 | ! outputs: |
---|
85 | ! en fait, on a nloc=len pour l'instant (cf cv_driver) |
---|
86 | INTEGER, DIMENSION (nloc), INTENT (OUT) :: iflag, nk, icb, icbs |
---|
87 | REAL, DIMENSION (nloc), INTENT (OUT) :: plcl, tnk, qnk, gznk |
---|
88 | REAL, DIMENSION (nloc), INTENT (OUT) :: hnk, unk, vnk |
---|
89 | REAL, DIMENSION (nloc, nd), INTENT (OUT) :: wghti |
---|
90 | REAL, DIMENSION (nloc), INTENT (OUT) :: pbase, buoybase |
---|
91 | REAL, DIMENSION (nloc, nd), INTENT (OUT) :: t, q, qs |
---|
92 | REAL, DIMENSION (nloc, nd), INTENT (OUT) :: t_wake, q_wake, qs_wake |
---|
93 | REAL, DIMENSION (nloc), INTENT (OUT) :: s_wake |
---|
94 | REAL, DIMENSION (nloc, nd), INTENT (OUT) :: u, v |
---|
95 | REAL, DIMENSION (nloc, nd), INTENT (OUT) :: gz, th, th_wake |
---|
96 | REAL, DIMENSION (nloc, nd,ntra), INTENT (OUT) :: tra |
---|
97 | REAL, DIMENSION (nloc, nd), INTENT (OUT) :: h, lv, lf, cpn |
---|
98 | REAL, DIMENSION (nloc, nd), INTENT (OUT) :: p |
---|
99 | REAL, DIMENSION (nloc, nd+1), INTENT (OUT) :: ph |
---|
100 | REAL, DIMENSION (nloc, nd), INTENT (OUT) :: tv, tp |
---|
101 | REAL, DIMENSION (nloc, nd), INTENT (OUT) :: tvp, clw |
---|
102 | REAL, DIMENSION (nloc, nd), INTENT (OUT) :: h_wake, lv_wake, cpn_wake |
---|
103 | REAL, DIMENSION (nloc, nd), INTENT (OUT) :: tv_wake, lf_wake |
---|
104 | REAL, DIMENSION (nloc, nd), INTENT (OUT) :: sig, w0 |
---|
105 | REAL, DIMENSION (nloc), INTENT (OUT) :: ptop2 |
---|
106 | REAL, DIMENSION (nloc), INTENT (OUT) :: Ale, Alp |
---|
107 | REAL, DIMENSION (nloc, nd), INTENT (OUT) :: omega |
---|
108 | #ifdef ISO |
---|
109 | REAL, DIMENSION (ntraciso,nloc), INTENT (OUT) :: xtnk |
---|
110 | REAL, DIMENSION (ntraciso,nloc, nd), INTENT (OUT) :: xtclw |
---|
111 | REAL, DIMENSION (ntraciso,nloc, nd), INTENT (OUT) :: xt |
---|
112 | REAL, DIMENSION (ntraciso,nloc, nd), INTENT (OUT) :: xt_wake |
---|
113 | #endif |
---|
114 | |
---|
115 | ! local variables: |
---|
116 | INTEGER i, k, nn, j |
---|
117 | #ifdef ISO |
---|
118 | INTEGER ixt |
---|
119 | #endif |
---|
120 | |
---|
121 | CHARACTER (LEN=20) :: modname = 'cv3a_compress' |
---|
122 | CHARACTER (LEN=80) :: abort_message |
---|
123 | |
---|
124 | #ifdef ISOVERIF |
---|
125 | WRITE(*,*) 'compress=', compress |
---|
126 | WRITE(*,*) 'nl=',nl |
---|
127 | #endif |
---|
128 | !jyg< |
---|
129 | IF (compress) THEN |
---|
130 | !>jyg |
---|
131 | |
---|
132 | DO k = 1, nl + 1 |
---|
133 | nn = 0 |
---|
134 | DO i = 1, len |
---|
135 | IF (iflag1(i)==0) THEN |
---|
136 | nn = nn + 1 |
---|
137 | wghti(nn, k) = wghti1(i, k) |
---|
138 | t(nn, k) = t1(i, k) |
---|
139 | q(nn, k) = q1(i, k) |
---|
140 | qs(nn, k) = qs1(i, k) |
---|
141 | t_wake(nn, k) = t1_wake(i, k) |
---|
142 | q_wake(nn, k) = q1_wake(i, k) |
---|
143 | qs_wake(nn, k) = qs1_wake(i, k) |
---|
144 | u(nn, k) = u1(i, k) |
---|
145 | v(nn, k) = v1(i, k) |
---|
146 | gz(nn, k) = gz1(i, k) |
---|
147 | th(nn, k) = th1(i, k) |
---|
148 | th_wake(nn, k) = th1_wake(i, k) |
---|
149 | h(nn, k) = h1(i, k) |
---|
150 | lv(nn, k) = lv1(i, k) |
---|
151 | lf(nn, k) = lf1(i, k) |
---|
152 | cpn(nn, k) = cpn1(i, k) |
---|
153 | p(nn, k) = p1(i, k) |
---|
154 | ph(nn, k) = ph1(i, k) |
---|
155 | tv(nn, k) = tv1(i, k) |
---|
156 | tp(nn, k) = tp1(i, k) |
---|
157 | tvp(nn, k) = tvp1(i, k) |
---|
158 | clw(nn, k) = clw1(i, k) |
---|
159 | h_wake(nn, k) = h1_wake(i, k) |
---|
160 | lv_wake(nn, k) = lv1_wake(i, k) |
---|
161 | lf_wake(nn, k) = lf1_wake(i, k) |
---|
162 | cpn_wake(nn, k) = cpn1_wake(i, k) |
---|
163 | tv_wake(nn, k) = tv1_wake(i, k) |
---|
164 | sig(nn, k) = sig1(i, k) |
---|
165 | w0(nn, k) = w01(i, k) |
---|
166 | omega(nn, k) = omega1(i, k) |
---|
167 | #ifdef ISO |
---|
168 | do ixt=1,ntraciso |
---|
169 | xt(ixt,nn,k)=xt1(ixt,i,k) |
---|
170 | xt_wake(ixt,nn,k)=xt1_wake(ixt,i,k) |
---|
171 | xtclw(ixt,nn,k)=xtclw1(ixt,i,k) |
---|
172 | enddo |
---|
173 | #endif |
---|
174 | END IF |
---|
175 | END DO |
---|
176 | END DO |
---|
177 | |
---|
178 | ! AC! do 121 j=1,ntra |
---|
179 | ! AC!ccccc do 111 k=1,nl+1 |
---|
180 | ! AC! do 111 k=1,nd |
---|
181 | ! AC! nn=0 |
---|
182 | ! AC! do 101 i=1,len |
---|
183 | ! AC! IF(iflag1(i).EQ.0)THEN |
---|
184 | ! AC! nn=nn+1 |
---|
185 | ! AC! tra(nn,k,j)=tra1(i,k,j) |
---|
186 | ! AC! endif |
---|
187 | ! AC! 101 continue |
---|
188 | ! AC! 111 continue |
---|
189 | ! AC! 121 continue |
---|
190 | |
---|
191 | IF (nn/=ncum) THEN |
---|
192 | PRINT *, 'WARNING nn not equal to ncum: ', nn, ncum |
---|
193 | abort_message = '' |
---|
194 | CALL abort_physic(modname, abort_message, 1) |
---|
195 | END IF |
---|
196 | |
---|
197 | nn = 0 |
---|
198 | DO i = 1, len |
---|
199 | IF (iflag1(i)==0) THEN |
---|
200 | nn = nn + 1 |
---|
201 | s_wake(nn) = s1_wake(i) |
---|
202 | iflag(nn) = iflag1(i) |
---|
203 | nk(nn) = nk1(i) |
---|
204 | icb(nn) = icb1(i) |
---|
205 | icbs(nn) = icbs1(i) |
---|
206 | plcl(nn) = plcl1(i) |
---|
207 | tnk(nn) = tnk1(i) |
---|
208 | qnk(nn) = qnk1(i) |
---|
209 | gznk(nn) = gznk1(i) |
---|
210 | hnk(nn) = hnk1(i) |
---|
211 | unk(nn) = unk1(i) |
---|
212 | vnk(nn) = vnk1(i) |
---|
213 | pbase(nn) = pbase1(i) |
---|
214 | buoybase(nn) = buoybase1(i) |
---|
215 | sig(nn, nd) = sig1(i, nd) |
---|
216 | ptop2(nn) = ptop2(i) |
---|
217 | Ale(nn) = Ale1(i) |
---|
218 | Alp(nn) = Alp1(i) |
---|
219 | #ifdef ISO |
---|
220 | do ixt=1,ntraciso |
---|
221 | xtnk(ixt,nn)=xtnk1(ixt,i) |
---|
222 | enddo |
---|
223 | #endif |
---|
224 | END IF |
---|
225 | END DO |
---|
226 | |
---|
227 | IF (nn/=ncum) THEN |
---|
228 | PRINT *, 'WARNING nn not equal to ncum: ', nn, ncum |
---|
229 | abort_message = '' |
---|
230 | CALL abort_physic(modname, abort_message, 1) |
---|
231 | END IF |
---|
232 | |
---|
233 | !jyg< |
---|
234 | ELSE !(compress) |
---|
235 | |
---|
236 | ncum = len |
---|
237 | |
---|
238 | wghti(:,1:nl+1) = wghti1(:,1:nl+1) |
---|
239 | t(:,1:nl+1) = t1(:,1:nl+1) |
---|
240 | q(:,1:nl+1) = q1(:,1:nl+1) |
---|
241 | qs(:,1:nl+1) = qs1(:,1:nl+1) |
---|
242 | t_wake(:,1:nl+1) = t1_wake(:,1:nl+1) |
---|
243 | q_wake(:,1:nl+1) = q1_wake(:,1:nl+1) |
---|
244 | qs_wake(:,1:nl+1) = qs1_wake(:,1:nl+1) |
---|
245 | u(:,1:nl+1) = u1(:,1:nl+1) |
---|
246 | v(:,1:nl+1) = v1(:,1:nl+1) |
---|
247 | gz(:,1:nl+1) = gz1(:,1:nl+1) |
---|
248 | th(:,1:nl+1) = th1(:,1:nl+1) |
---|
249 | th_wake(:,1:nl+1) = th1_wake(:,1:nl+1) |
---|
250 | h(:,1:nl+1) = h1(:,1:nl+1) |
---|
251 | lv(:,1:nl+1) = lv1(:,1:nl+1) |
---|
252 | lf(:,1:nl+1) = lf1(:,1:nl+1) |
---|
253 | cpn(:,1:nl+1) = cpn1(:,1:nl+1) |
---|
254 | p(:,1:nl+1) = p1(:,1:nl+1) |
---|
255 | ph(:,1:nl+1) = ph1(:,1:nl+1) |
---|
256 | tv(:,1:nl+1) = tv1(:,1:nl+1) |
---|
257 | tp(:,1:nl+1) = tp1(:,1:nl+1) |
---|
258 | tvp(:,1:nl+1) = tvp1(:,1:nl+1) |
---|
259 | clw(:,1:nl+1) = clw1(:,1:nl+1) |
---|
260 | h_wake(:,1:nl+1) = h1_wake(:,1:nl+1) |
---|
261 | lv_wake(:,1:nl+1) = lv1_wake(:,1:nl+1) |
---|
262 | lf_wake(:,1:nl+1) = lf1_wake(:,1:nl+1) |
---|
263 | cpn_wake(:,1:nl+1) = cpn1_wake(:,1:nl+1) |
---|
264 | tv_wake(:,1:nl+1) = tv1_wake(:,1:nl+1) |
---|
265 | sig(:,1:nl+1) = sig1(:,1:nl+1) |
---|
266 | w0(:,1:nl+1) = w01(:,1:nl+1) |
---|
267 | omega(:,1:nl+1) = omega1(:,1:nl+1) |
---|
268 | #ifdef ISO |
---|
269 | xt(:,:,1:nl+1) = xt1(:,:,1:nl+1) |
---|
270 | xtclw(:,:,1:nl+1) = xtclw1(:,:,1:nl+1) |
---|
271 | xt_wake(:,:,1:nl+1) = xt1_wake(:,:,1:nl+1) |
---|
272 | #endif |
---|
273 | |
---|
274 | s_wake(:) = s1_wake(:) |
---|
275 | iflag(:) = iflag1(:) |
---|
276 | nk(:) = nk1(:) |
---|
277 | icb(:) = icb1(:) |
---|
278 | icbs(:) = icbs1(:) |
---|
279 | plcl(:) = plcl1(:) |
---|
280 | tnk(:) = tnk1(:) |
---|
281 | qnk(:) = qnk1(:) |
---|
282 | gznk(:) = gznk1(:) |
---|
283 | hnk(:) = hnk1(:) |
---|
284 | unk(:) = unk1(:) |
---|
285 | vnk(:) = vnk1(:) |
---|
286 | pbase(:) = pbase1(:) |
---|
287 | buoybase(:) = buoybase1(:) |
---|
288 | sig(:, nd) = sig1(:, nd) |
---|
289 | ptop2(:) = ptop2(:) |
---|
290 | Ale(:) = Ale1(:) |
---|
291 | Alp(:) = Alp1(:) |
---|
292 | #ifdef ISO |
---|
293 | xtnk(:,:) = xtnk1(:,:) |
---|
294 | #endif |
---|
295 | |
---|
296 | ENDIF !(compress) |
---|
297 | !>jyg |
---|
298 | |
---|
299 | |
---|
300 | END SUBROUTINE cv3a_compress |
---|