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