LMDZ
cv3a_compress.F90
Go to the documentation of this file.
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
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
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)
247 
248  RETURN
249 END SUBROUTINE cv3a_compress
nl
!$Id!Parameters for nl
Definition: cv30param.h:5
cv3a_compress
subroutine cv3a_compress(len, nloc, ncum, nd, ntra, compress, iflag1, nk1, icb1, icbs1, plcl1, tnk1, qnk1, gznk1, hnk1, unk1, vnk1, wghti1, pbase1, buoybase1, t1, q1, qs1, t1_wake, q1_wake, qs1_wake, s1_wake, u1, v1, gz1, th1, th1_wake, tra1, h1, lv1, lf1, cpn1, p1, ph1, tv1, tp1, tvp1, clw1, h1_wake, lv1_wake, lf1_wake, cpn1_wake, tv1_wake, sig1, w01, ptop21, Ale1, Alp1, omega1, iflag, nk, icb, icbs, plcl, tnk, qnk, gznk, hnk, unk, vnk, wghti, pbase, buoybase, t, q, qs, t_wake, q_wake, qs_wake, s_wake, u, v, gz, th, th_wake, tra, h, lv, lf, cpn, p, ph, tv, tp, tvp, clw, h_wake, lv_wake, lf_wake, cpn_wake, tv_wake, sig, w0, ptop2, Ale, Alp, omega)
Definition: cv3a_compress.F90:22
u
!$Id Turb_fcg_gcssold get_uvd hqturb_gcssold endif!large scale llm day day1 day day1 *dt_toga endif!time annee_ref dt_toga u_toga vq_toga w_prof vq_prof llm u(l)
abort_physic
subroutine abort_physic(modname, message, ierr)
Definition: abort_physic.F90:3