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

Last change on this file since 5356 was 5346, checked in by fhourdin, 12 months ago

Debut de replaysation de la convection profonde.

Regroupement de cvparam, cv3param et cvthermo (récemment
passés de statut de .h à module, dans un unique module
lmdz_cv_ini.f90
  • 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
RevLine 
[2253]1SUBROUTINE 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)
[1992]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  ! **************************************************************
[879]30
[5346]31   USE lmdz_cv_ini, ONLY : nl
[5299]32    IMPLICIT NONE
[879]33
34
[1992]35  ! inputs:
[2253]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!
[1992]66  ! outputs:
67  ! en fait, on a nloc=len pour l'instant (cf cv_driver)
[2253]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
[879]90
[1992]91  ! local variables:
92  INTEGER i, k, nn, j
[879]93
[1992]94  CHARACTER (LEN=20) :: modname = 'cv3a_compress'
95  CHARACTER (LEN=80) :: abort_message
[1403]96
[2253]97!jyg<
98  IF (compress) THEN
99!>jyg
[879]100
[1992]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)
[2201]135        omega(nn, k) = omega1(i, k)
[1992]136      END IF
137    END DO
138  END DO
[2253]139!
[1992]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
[879]152
[1992]153  IF (nn/=ncum) THEN
154    PRINT *, 'WARNING nn not equal to ncum: ', nn, ncum
155    abort_message = ''
[2311]156    CALL abort_physic(modname, abort_message, 1)
[1992]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)
[2259]177      sig(nn, nd) = sig1(i, nd)
[1992]178      ptop2(nn) = ptop2(i)
[2253]179      Ale(nn) = Ale1(i)
180      Alp(nn) = Alp1(i)
[1992]181    END IF
182  END DO
[879]183
[1992]184  IF (nn/=ncum) THEN
185    PRINT *, 'WARNING nn not equal to ncum: ', nn, ncum
186    abort_message = ''
[2311]187    CALL abort_physic(modname, abort_message, 1)
[1992]188  END IF
[2253]189!
190!jyg<
191  ELSE  !(compress)
192!
193      ncum = len
194!
[2259]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)
[2253]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(:)
[2259]240      sig(:, nd) = sig1(:, nd)
[2253]241      ptop2(:) = ptop2(:)
242      Ale(:) = Ale1(:)
243      Alp(:) = Alp1(:)
244!
245  ENDIF !(compress)
246!>jyg
[972]247
[1992]248  RETURN
249END SUBROUTINE cv3a_compress
Note: See TracBrowser for help on using the repository browser.