source: LMDZ6/trunk/libf/phylmd/cv3a_compress.f90 @ 5840

Last change on this file since 5840 was 5840, checked in by jyg, 2 months ago

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