Context Navigation

cv3a_compress.F90 @ 3525

Last change on this file since 3525 was 2408, checked in by Laurent Fairhead, 9 years ago
Merged trunk changes r2298:2396 into testing branch
Property copyright set to Name of program: LMDZ Creation date: 1984 Version: LMDZ5 License: CeCILL version 2 Holder: Laboratoire de m\'et\'eorologie dynamique, CNRS, UMR 8539 See the license file in the root directory Property svn:eol-style set to `native` Property svn:keywords set to `Author Date Id Revision`
File size: 9.0 KB

Line
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_physic(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	sig(nn, nd) = sig1(i, nd)
178	ptop2(nn) = ptop2(i)
179	Ale(nn) = Ale1(i)
180	Alp(nn) = Alp1(i)
181	END IF
182	END DO
183
184	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	RETURN
249	END SUBROUTINE cv3a_compress

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

Download in other formats:

Original Format