source: LMDZ5/branches/testing/libf/phylmd/cv3a_compress.F90 @ 2073

Last change on this file since 2073 was 1999, checked in by Laurent Fairhead, 11 years ago

Merged trunk changes r1920:1997 into testing branch
  • 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 
1SUBROUTINE 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
158END SUBROUTINE cv3a_compress
Note: See TracBrowser for help on using the repository browser.