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

Last change on this file since 5757 was 5712, checked in by yann meurdesoif, 5 weeks ago

Convection GPU porting : Compression of active convection point is now optional (default remain to true). For GPU runs, convection is not compressed and is computed on each column. The update is done only for column where convection is active

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