source: dynamico_lmdz/aquaplanet/LMDZ5/libf/phylmd/cv3a_compress.F90 @ 3814

Last change on this file since 3814 was 3814, checked in by ymipsl, 10 years ago

remove all dynamic dependency in LMDZ physics except for the include "dimensions.h"

YM
File size: 5.1 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, omega1, 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, omega)
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  REAL omega1(len,nd)
43
44  ! outputs:
45  ! en fait, on a nloc=len pour l'instant (cf cv_driver)
46  INTEGER iflag(len), nk(len), icb(len), icbs(len)
47  REAL plcl(len), tnk(len), qnk(len), gznk(len)
48  REAL hnk(len), unk(len), vnk(len)
49  REAL wghti(len, nd), pbase(len), buoybase(len)
50  REAL t(len, nd), q(len, nd), qs(len, nd)
51  REAL t_wake(len, nd), q_wake(len, nd), qs_wake(len, nd)
52  REAL s_wake(len)
53  REAL u(len, nd), v(len, nd)
54  REAL gz(len, nd), th(len, nd), th_wake(len, nd)
55  REAL tra(len, nd, ntra)
56  REAL h(len, nd), lv(len, nd), lf(len, nd), cpn(len, nd)
57  REAL p(len, nd), ph(len, nd+1), tv(len, nd), tp(len, nd)
58  REAL tvp(len, nd), clw(len, nd)
59  REAL h_wake(len, nd), lv_wake(len, nd), cpn_wake(len, nd)
60  REAL tv_wake(len, nd), lf_wake(len, nd)
61  REAL sig(len, nd), w0(len, nd), ptop2(len)
62  REAL ale(len), alp(len)
63  REAL omega(len,nd)
64
65  ! local variables:
66  INTEGER i, k, nn, j
67
68  CHARACTER (LEN=20) :: modname = 'cv3a_compress'
69  CHARACTER (LEN=80) :: abort_message
70
71
72  DO k = 1, nl + 1
73    nn = 0
74    DO i = 1, len
75      IF (iflag1(i)==0) THEN
76        nn = nn + 1
77        wghti(nn, k) = wghti1(i, k)
78        t(nn, k) = t1(i, k)
79        q(nn, k) = q1(i, k)
80        qs(nn, k) = qs1(i, k)
81        t_wake(nn, k) = t1_wake(i, k)
82        q_wake(nn, k) = q1_wake(i, k)
83        qs_wake(nn, k) = qs1_wake(i, k)
84        u(nn, k) = u1(i, k)
85        v(nn, k) = v1(i, k)
86        gz(nn, k) = gz1(i, k)
87        th(nn, k) = th1(i, k)
88        th_wake(nn, k) = th1_wake(i, k)
89        h(nn, k) = h1(i, k)
90        lv(nn, k) = lv1(i, k)
91        lf(nn, k) = lf1(i, k)
92        cpn(nn, k) = cpn1(i, k)
93        p(nn, k) = p1(i, k)
94        ph(nn, k) = ph1(i, k)
95        tv(nn, k) = tv1(i, k)
96        tp(nn, k) = tp1(i, k)
97        tvp(nn, k) = tvp1(i, k)
98        clw(nn, k) = clw1(i, k)
99        h_wake(nn, k) = h1_wake(i, k)
100        lv_wake(nn, k) = lv1_wake(i, k)
101        lf_wake(nn, k) = lf1_wake(i, k)
102        cpn_wake(nn, k) = cpn1_wake(i, k)
103        tv_wake(nn, k) = tv1_wake(i, k)
104        sig(nn, k) = sig1(i, k)
105        w0(nn, k) = w01(i, k)
106        omega(nn, k) = omega1(i, k)
107      END IF
108    END DO
109  END DO
110
111  ! AC!      do 121 j=1,ntra
112  ! AC!ccccc      do 111 k=1,nl+1
113  ! AC!      do 111 k=1,nd
114  ! AC!       nn=0
115  ! AC!      do 101 i=1,len
116  ! AC!      if(iflag1(i).eq.0)then
117  ! AC!       nn=nn+1
118  ! AC!       tra(nn,k,j)=tra1(i,k,j)
119  ! AC!      endif
120  ! AC! 101  continue
121  ! AC! 111  continue
122  ! AC! 121  continue
123
124  IF (nn/=ncum) THEN
125    PRINT *, 'WARNING nn not equal to ncum: ', nn, ncum
126    abort_message = ''
127    CALL abort_physic(modname, abort_message, 1)
128  END IF
129
130  nn = 0
131  DO i = 1, len
132    IF (iflag1(i)==0) THEN
133      nn = nn + 1
134      s_wake(nn) = s1_wake(i)
135      iflag(nn) = iflag1(i)
136      nk(nn) = nk1(i)
137      icb(nn) = icb1(i)
138      icbs(nn) = icbs1(i)
139      plcl(nn) = plcl1(i)
140      tnk(nn) = tnk1(i)
141      qnk(nn) = qnk1(i)
142      gznk(nn) = gznk1(i)
143      hnk(nn) = hnk1(i)
144      unk(nn) = unk1(i)
145      vnk(nn) = vnk1(i)
146      pbase(nn) = pbase1(i)
147      buoybase(nn) = buoybase1(i)
148      ptop2(nn) = ptop2(i)
149      ale(nn) = ale1(i)
150      alp(nn) = alp1(i)
151    END IF
152  END DO
153
154  IF (nn/=ncum) THEN
155    PRINT *, 'WARNING nn not equal to ncum: ', nn, ncum
156    abort_message = ''
157    CALL abort_physic(modname, abort_message, 1)
158  END IF
159
160  RETURN
161END SUBROUTINE cv3a_compress
Note: See TracBrowser for help on using the repository browser.