1 |
|
288 |
SUBROUTINE cv3a_compress(len, nloc, ncum, nd, ntra, compress, & |
2 |
|
144 |
iflag1, nk1, icb1, icbs1, & |
3 |
|
|
plcl1, tnk1, qnk1, gznk1, hnk1, unk1, vnk1, & |
4 |
|
144 |
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 |
|
144 |
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 |
✓✗ |
144 |
IF (compress) THEN |
99 |
|
|
!>jyg |
100 |
|
|
|
101 |
✓✓ |
4176 |
DO k = 1, nl + 1 |
102 |
|
4032 |
nn = 0 |
103 |
✓✓ |
4011984 |
DO i = 1, len |
104 |
✓✓ |
4011840 |
IF (iflag1(i)==0) THEN |
105 |
|
1931048 |
nn = nn + 1 |
106 |
|
1931048 |
wghti(nn, k) = wghti1(i, k) |
107 |
|
1931048 |
t(nn, k) = t1(i, k) |
108 |
|
1931048 |
q(nn, k) = q1(i, k) |
109 |
|
1931048 |
qs(nn, k) = qs1(i, k) |
110 |
|
1931048 |
t_wake(nn, k) = t1_wake(i, k) |
111 |
|
1931048 |
q_wake(nn, k) = q1_wake(i, k) |
112 |
|
1931048 |
qs_wake(nn, k) = qs1_wake(i, k) |
113 |
|
1931048 |
u(nn, k) = u1(i, k) |
114 |
|
1931048 |
v(nn, k) = v1(i, k) |
115 |
|
1931048 |
gz(nn, k) = gz1(i, k) |
116 |
|
1931048 |
th(nn, k) = th1(i, k) |
117 |
|
1931048 |
th_wake(nn, k) = th1_wake(i, k) |
118 |
|
1931048 |
h(nn, k) = h1(i, k) |
119 |
|
1931048 |
lv(nn, k) = lv1(i, k) |
120 |
|
1931048 |
lf(nn, k) = lf1(i, k) |
121 |
|
1931048 |
cpn(nn, k) = cpn1(i, k) |
122 |
|
1931048 |
p(nn, k) = p1(i, k) |
123 |
|
1931048 |
ph(nn, k) = ph1(i, k) |
124 |
|
1931048 |
tv(nn, k) = tv1(i, k) |
125 |
|
1931048 |
tp(nn, k) = tp1(i, k) |
126 |
|
1931048 |
tvp(nn, k) = tvp1(i, k) |
127 |
|
1931048 |
clw(nn, k) = clw1(i, k) |
128 |
|
1931048 |
h_wake(nn, k) = h1_wake(i, k) |
129 |
|
1931048 |
lv_wake(nn, k) = lv1_wake(i, k) |
130 |
|
1931048 |
lf_wake(nn, k) = lf1_wake(i, k) |
131 |
|
1931048 |
cpn_wake(nn, k) = cpn1_wake(i, k) |
132 |
|
1931048 |
tv_wake(nn, k) = tv1_wake(i, k) |
133 |
|
1931048 |
sig(nn, k) = sig1(i, k) |
134 |
|
1931048 |
w0(nn, k) = w01(i, k) |
135 |
|
1931048 |
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 |
✗✓ |
144 |
IF (nn/=ncum) THEN |
154 |
|
|
PRINT *, 'WARNING nn not equal to ncum: ', nn, ncum |
155 |
|
|
abort_message = '' |
156 |
|
|
CALL abort_physic(modname, abort_message, 1) |
157 |
|
|
END IF |
158 |
|
|
|
159 |
|
144 |
nn = 0 |
160 |
✓✓ |
143280 |
DO i = 1, len |
161 |
✓✓ |
143280 |
IF (iflag1(i)==0) THEN |
162 |
|
68966 |
nn = nn + 1 |
163 |
|
68966 |
s_wake(nn) = s1_wake(i) |
164 |
|
68966 |
iflag(nn) = iflag1(i) |
165 |
|
68966 |
nk(nn) = nk1(i) |
166 |
|
68966 |
icb(nn) = icb1(i) |
167 |
|
68966 |
icbs(nn) = icbs1(i) |
168 |
|
68966 |
plcl(nn) = plcl1(i) |
169 |
|
68966 |
tnk(nn) = tnk1(i) |
170 |
|
68966 |
qnk(nn) = qnk1(i) |
171 |
|
68966 |
gznk(nn) = gznk1(i) |
172 |
|
68966 |
hnk(nn) = hnk1(i) |
173 |
|
68966 |
unk(nn) = unk1(i) |
174 |
|
68966 |
vnk(nn) = vnk1(i) |
175 |
|
68966 |
pbase(nn) = pbase1(i) |
176 |
|
68966 |
buoybase(nn) = buoybase1(i) |
177 |
|
68966 |
sig(nn, nd) = sig1(i, nd) |
178 |
|
68966 |
ptop2(nn) = ptop2(i) |
179 |
|
68966 |
Ale(nn) = Ale1(i) |
180 |
|
68966 |
Alp(nn) = Alp1(i) |
181 |
|
|
END IF |
182 |
|
|
END DO |
183 |
|
|
|
184 |
✗✓ |
144 |
IF (nn/=ncum) THEN |
185 |
|
|
PRINT *, 'WARNING nn not equal to ncum: ', nn, ncum |
186 |
|
|
abort_message = '' |
187 |
|
|
CALL abort_physic(modname, abort_message, 1) |
188 |
|
|
END IF |
189 |
|
|
! |
190 |
|
|
!jyg< |
191 |
|
|
ELSE !(compress) |
192 |
|
|
! |
193 |
|
|
ncum = len |
194 |
|
|
! |
195 |
|
|
wghti(:,1:nl+1) = wghti1(:,1:nl+1) |
196 |
|
|
t(:,1:nl+1) = t1(:,1:nl+1) |
197 |
|
|
q(:,1:nl+1) = q1(:,1:nl+1) |
198 |
|
|
qs(:,1:nl+1) = qs1(:,1:nl+1) |
199 |
|
|
t_wake(:,1:nl+1) = t1_wake(:,1:nl+1) |
200 |
|
|
q_wake(:,1:nl+1) = q1_wake(:,1:nl+1) |
201 |
|
|
qs_wake(:,1:nl+1) = qs1_wake(:,1:nl+1) |
202 |
|
|
u(:,1:nl+1) = u1(:,1:nl+1) |
203 |
|
|
v(:,1:nl+1) = v1(:,1:nl+1) |
204 |
|
|
gz(:,1:nl+1) = gz1(:,1:nl+1) |
205 |
|
|
th(:,1:nl+1) = th1(:,1:nl+1) |
206 |
|
|
th_wake(:,1:nl+1) = th1_wake(:,1:nl+1) |
207 |
|
|
h(:,1:nl+1) = h1(:,1:nl+1) |
208 |
|
|
lv(:,1:nl+1) = lv1(:,1:nl+1) |
209 |
|
|
lf(:,1:nl+1) = lf1(:,1:nl+1) |
210 |
|
|
cpn(:,1:nl+1) = cpn1(:,1:nl+1) |
211 |
|
|
p(:,1:nl+1) = p1(:,1:nl+1) |
212 |
|
|
ph(:,1:nl+1) = ph1(:,1:nl+1) |
213 |
|
|
tv(:,1:nl+1) = tv1(:,1:nl+1) |
214 |
|
|
tp(:,1:nl+1) = tp1(:,1:nl+1) |
215 |
|
|
tvp(:,1:nl+1) = tvp1(:,1:nl+1) |
216 |
|
|
clw(:,1:nl+1) = clw1(:,1:nl+1) |
217 |
|
|
h_wake(:,1:nl+1) = h1_wake(:,1:nl+1) |
218 |
|
|
lv_wake(:,1:nl+1) = lv1_wake(:,1:nl+1) |
219 |
|
|
lf_wake(:,1:nl+1) = lf1_wake(:,1:nl+1) |
220 |
|
|
cpn_wake(:,1:nl+1) = cpn1_wake(:,1:nl+1) |
221 |
|
|
tv_wake(:,1:nl+1) = tv1_wake(:,1:nl+1) |
222 |
|
|
sig(:,1:nl+1) = sig1(:,1:nl+1) |
223 |
|
|
w0(:,1:nl+1) = w01(:,1:nl+1) |
224 |
|
|
omega(:,1:nl+1) = omega1(:,1:nl+1) |
225 |
|
|
! |
226 |
|
|
s_wake(:) = s1_wake(:) |
227 |
|
|
iflag(:) = iflag1(:) |
228 |
|
|
nk(:) = nk1(:) |
229 |
|
|
icb(:) = icb1(:) |
230 |
|
|
icbs(:) = icbs1(:) |
231 |
|
|
plcl(:) = plcl1(:) |
232 |
|
|
tnk(:) = tnk1(:) |
233 |
|
|
qnk(:) = qnk1(:) |
234 |
|
|
gznk(:) = gznk1(:) |
235 |
|
|
hnk(:) = hnk1(:) |
236 |
|
|
unk(:) = unk1(:) |
237 |
|
|
vnk(:) = vnk1(:) |
238 |
|
|
pbase(:) = pbase1(:) |
239 |
|
|
buoybase(:) = buoybase1(:) |
240 |
|
|
sig(:, nd) = sig1(:, nd) |
241 |
|
|
ptop2(:) = ptop2(:) |
242 |
|
|
Ale(:) = Ale1(:) |
243 |
|
|
Alp(:) = Alp1(:) |
244 |
|
|
! |
245 |
|
|
ENDIF !(compress) |
246 |
|
|
!>jyg |
247 |
|
|
|
248 |
|
144 |
RETURN |
249 |
|
|
END SUBROUTINE cv3a_compress |