Context Navigation

cv3a_compress.F90 @ 2404

Last change on this file since 2404 was 1992, checked in by lguez, 11 years ago

Converted to free source form files in libf/phylmd which were still in
fixed source form. The conversion was done using the polish mode of
the NAG Fortran Compiler.

In addition to converting to free source form, the processing of the
files also:

-- indented the code (including comments);

-- set Fortran keywords to uppercase, and set all other identifiers
to lower case;

-- added qualifiers to end statements (for example "end subroutine
conflx", instead of "end");

-- changed the terminating statements of all DO loops so that each
loop ends with an ENDDO statement (instead of a labeled continue).

-- replaced #include by include.

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: 5.0 KB

Line
1	SUBROUTINE cv3a_compress(len, nloc, ncum, nd, ntra, iflag1, nk1, icb1, icbs1, &
2	plcl1, tnk1, qnk1, gznk1, hnk1, unk1, vnk1, wghti1, pbase1, buoybase1, &
3	t1, q1, qs1, t1_wake, q1_wake, qs1_wake, s1_wake, u1, v1, gz1, th1, &
4	th1_wake, tra1, h1, lv1, lf1, cpn1, p1, ph1, tv1, tp1, tvp1, clw1, &
5	h1_wake, lv1_wake, lf1_wake, cpn1_wake, tv1_wake, sig1, w01, ptop21, &
6	ale1, alp1, iflag, nk, icb, icbs, plcl, tnk, qnk, gznk, hnk, unk, vnk, &
7	wghti, pbase, buoybase, t, q, qs, t_wake, q_wake, qs_wake, s_wake, u, v, &
8	gz, th, th_wake, tra, h, lv, lf, cpn, p, ph, tv, tp, tvp, clw, h_wake, &
9	lv_wake, lf_wake, cpn_wake, tv_wake, sig, w0, ptop2, ale, alp)
10	! **************************************************************
11	! *
12	! CV3A_COMPRESS *
13	! *
14	! *
15	! written by : Sandrine Bony-Lena , 17/05/2003, 11.22.15 *
16	! modified by : Jean-Yves Grandpeix, 23/06/2003, 10.28.09 *
17	! **************************************************************
18
19	IMPLICIT NONE
20
21	include "cv3param.h"
22
23	! inputs:
24	INTEGER len, nloc, ncum, nd, ntra
25	INTEGER iflag1(len), nk1(len), icb1(len), icbs1(len)
26	REAL plcl1(len), tnk1(len), qnk1(len), gznk1(len)
27	REAL hnk1(len), unk1(len), vnk1(len)
28	REAL wghti1(len, nd), pbase1(len), buoybase1(len)
29	REAL t1(len, nd), q1(len, nd), qs1(len, nd)
30	REAL t1_wake(len, nd), q1_wake(len, nd), qs1_wake(len, nd)
31	REAL s1_wake(len)
32	REAL u1(len, nd), v1(len, nd)
33	REAL gz1(len, nd), th1(len, nd), th1_wake(len, nd)
34	REAL tra1(len, nd, ntra)
35	REAL h1(len, nd), lv1(len, nd), lf1(len, nd), cpn1(len, nd)
36	REAL p1(len, nd), ph1(len, nd+1), tv1(len, nd), tp1(len, nd)
37	REAL tvp1(len, nd), clw1(len, nd)
38	REAL h1_wake(len, nd), lv1_wake(len, nd), cpn1_wake(len, nd)
39	REAL tv1_wake(len, nd), lf1_wake(len, nd)
40	REAL sig1(len, nd), w01(len, nd), ptop21(len)
41	REAL ale1(len), alp1(len)
42
43	! outputs:
44	! en fait, on a nloc=len pour l'instant (cf cv_driver)
45	INTEGER iflag(len), nk(len), icb(len), icbs(len)
46	REAL plcl(len), tnk(len), qnk(len), gznk(len)
47	REAL hnk(len), unk(len), vnk(len)
48	REAL wghti(len, nd), pbase(len), buoybase(len)
49	REAL t(len, nd), q(len, nd), qs(len, nd)
50	REAL t_wake(len, nd), q_wake(len, nd), qs_wake(len, nd)
51	REAL s_wake(len)
52	REAL u(len, nd), v(len, nd)
53	REAL gz(len, nd), th(len, nd), th_wake(len, nd)
54	REAL tra(len, nd, ntra)
55	REAL h(len, nd), lv(len, nd), lf(len, nd), cpn(len, nd)
56	REAL p(len, nd), ph(len, nd+1), tv(len, nd), tp(len, nd)
57	REAL tvp(len, nd), clw(len, nd)
58	REAL h_wake(len, nd), lv_wake(len, nd), cpn_wake(len, nd)
59	REAL tv_wake(len, nd), lf_wake(len, nd)
60	REAL sig(len, nd), w0(len, nd), ptop2(len)
61	REAL ale(len), alp(len)
62
63	! local variables:
64	INTEGER i, k, nn, j
65
66	CHARACTER (LEN=20) :: modname = 'cv3a_compress'
67	CHARACTER (LEN=80) :: abort_message
68
69
70	DO k = 1, nl + 1
71	nn = 0
72	DO i = 1, len
73	IF (iflag1(i)==0) THEN
74	nn = nn + 1
75	wghti(nn, k) = wghti1(i, k)
76	t(nn, k) = t1(i, k)
77	q(nn, k) = q1(i, k)
78	qs(nn, k) = qs1(i, k)
79	t_wake(nn, k) = t1_wake(i, k)
80	q_wake(nn, k) = q1_wake(i, k)
81	qs_wake(nn, k) = qs1_wake(i, k)
82	u(nn, k) = u1(i, k)
83	v(nn, k) = v1(i, k)
84	gz(nn, k) = gz1(i, k)
85	th(nn, k) = th1(i, k)
86	th_wake(nn, k) = th1_wake(i, k)
87	h(nn, k) = h1(i, k)
88	lv(nn, k) = lv1(i, k)
89	lf(nn, k) = lf1(i, k)
90	cpn(nn, k) = cpn1(i, k)
91	p(nn, k) = p1(i, k)
92	ph(nn, k) = ph1(i, k)
93	tv(nn, k) = tv1(i, k)
94	tp(nn, k) = tp1(i, k)
95	tvp(nn, k) = tvp1(i, k)
96	clw(nn, k) = clw1(i, k)
97	h_wake(nn, k) = h1_wake(i, k)
98	lv_wake(nn, k) = lv1_wake(i, k)
99	lf_wake(nn, k) = lf1_wake(i, k)
100	cpn_wake(nn, k) = cpn1_wake(i, k)
101	tv_wake(nn, k) = tv1_wake(i, k)
102	sig(nn, k) = sig1(i, k)
103	w0(nn, k) = w01(i, k)
104	END IF
105	END DO
106	END DO
107
108	! AC! do 121 j=1,ntra
109	! AC!ccccc do 111 k=1,nl+1
110	! AC! do 111 k=1,nd
111	! AC! nn=0
112	! AC! do 101 i=1,len
113	! AC! if(iflag1(i).eq.0)then
114	! AC! nn=nn+1
115	! AC! tra(nn,k,j)=tra1(i,k,j)
116	! AC! endif
117	! AC! 101 continue
118	! AC! 111 continue
119	! AC! 121 continue
120
121	IF (nn/=ncum) THEN
122	PRINT *, 'WARNING nn not equal to ncum: ', nn, ncum
123	abort_message = ''
124	CALL abort_gcm(modname, abort_message, 1)
125	END IF
126
127	nn = 0
128	DO i = 1, len
129	IF (iflag1(i)==0) THEN
130	nn = nn + 1
131	s_wake(nn) = s1_wake(i)
132	iflag(nn) = iflag1(i)
133	nk(nn) = nk1(i)
134	icb(nn) = icb1(i)
135	icbs(nn) = icbs1(i)
136	plcl(nn) = plcl1(i)
137	tnk(nn) = tnk1(i)
138	qnk(nn) = qnk1(i)
139	gznk(nn) = gznk1(i)
140	hnk(nn) = hnk1(i)
141	unk(nn) = unk1(i)
142	vnk(nn) = vnk1(i)
143	pbase(nn) = pbase1(i)
144	buoybase(nn) = buoybase1(i)
145	ptop2(nn) = ptop2(i)
146	ale(nn) = ale1(i)
147	alp(nn) = alp1(i)
148	END IF
149	END DO
150
151	IF (nn/=ncum) THEN
152	PRINT *, 'WARNING nn not equal to ncum: ', nn, ncum
153	abort_message = ''
154	CALL abort_gcm(modname, abort_message, 1)
155	END IF
156
157	RETURN
158	END SUBROUTINE cv3a_compress

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

Download in other formats:

Original Format