source: LMDZ5/trunk/libf/phylmd/cv3a_compress.F90 @ 2223

Last change on this file since 2223 was 2201, checked in by crio, 10 years ago

Expérience du tube de dentifrice: Ajout d'un terme de grande-échelle dans
la fermeture du schéma de convection. La fraction de la convergence
grande-échelle de masse au LFC ajoutée au flux de masse à la base calculé
par la fermeture en ALP est controlée par coef_clos_ls lu dans physiq.def
(valeur comprise entre 0 et 1, 0 par défaut).
Tube of toothpaste experiment: Additional large-scale term in the closure
formulation of the deep convection scheme. The fraction of the large-scale
convergence of mass at LFC additioned to the cloud-base mass-flux given by
the ALP closure is controlled by coef_clos_ls read in physiq.def (value
between 0 and 1, 0 by default).
  • 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.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_gcm(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_gcm(modname, abort_message, 1)
158  END IF
159
160  RETURN
161END SUBROUTINE cv3a_compress
Note: See TracBrowser for help on using the repository browser.