source: LMDZ5/branches/LMDZ6_rc0/libf/phylmd/calwake.F90 @ 3069

Last change on this file since 3069 was 2160, checked in by Laurent Fairhead, 10 years ago

Merged trunk changes -r2070:2158 into testing branch. Compilation problems introduced by revision r2155 have been corrected by hand

  • 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: 6.8 KB
Line 
1
2! $Id: calwake.F90 2160 2014-11-28 15:36:29Z dcugnet $
3
4SUBROUTINE calwake(paprs, pplay, dtime, t, q, omgb, dt_dwn, dq_dwn, m_dwn, &
5    m_up, dt_a, dq_a, sigd, wdt_pbl, wdq_pbl, udt_pbl, udq_pbl, wake_deltat, &
6    wake_deltaq, wake_dth, wake_h, wake_s, wake_dens, wake_pe, wake_fip, &
7    wake_gfl, dt_wake, dq_wake, wake_k, undi_t, undi_q, wake_omgbdth, &
8    wake_dp_omgb, wake_dtke, wake_dqke, wake_dtpbl, wake_dqpbl, wake_omg, &
9    wake_dp_deltomg, wake_spread, wake_cstar, wake_d_deltat_gw, wake_ddeltat, &
10    wake_ddeltaq)
11  ! **************************************************************
12  ! *
13  ! CALWAKE                                                     *
14  ! interface avec le schema de calcul de la poche    *
15  ! froide                                            *
16  ! *
17  ! written by   : CHERUY Frederique, 13/03/2000, 10.31.05      *
18  ! modified by :  ROEHRIG Romain,    01/30/2007                *
19  ! **************************************************************
20
21  USE dimphy
22  IMPLICIT NONE
23  ! ======================================================================
24  include "dimensions.h"
25  ! #include "dimphy.h"
26  include "YOMCST.h"
27
28  ! Arguments
29  ! ----------
30
31  INTEGER i, l, ktopw(klon)
32  REAL dtime
33
34  REAL paprs(klon, klev+1), pplay(klon, klev)
35  REAL t(klon, klev), q(klon, klev), omgb(klon, klev)
36  REAL dt_dwn(klon, klev), dq_dwn(klon, klev), m_dwn(klon, klev)
37  REAL m_up(klon, klev)
38  REAL dt_a(klon, klev), dq_a(klon, klev)
39  REAL wdt_pbl(klon, klev), wdq_pbl(klon, klev)
40  REAL udt_pbl(klon, klev), udq_pbl(klon, klev)
41  REAL wake_deltat(klon, klev), wake_deltaq(klon, klev)
42  REAL dt_wake(klon, klev), dq_wake(klon, klev)
43  REAL wake_d_deltat_gw(klon, klev)
44  REAL wake_h(klon), wake_s(klon)
45  REAL wake_dth(klon, klev)
46  REAL wake_pe(klon), wake_fip(klon), wake_gfl(klon)
47  REAL undi_t(klon, klev), undi_q(klon, klev)
48  REAL wake_omgbdth(klon, klev), wake_dp_omgb(klon, klev)
49  REAL wake_dtke(klon, klev), wake_dqke(klon, klev)
50  REAL wake_dtpbl(klon, klev), wake_dqpbl(klon, klev)
51  REAL wake_omg(klon, klev), wake_dp_deltomg(klon, klev)
52  REAL wake_spread(klon, klev), wake_cstar(klon)
53  REAL wake_ddeltat(klon, klev), wake_ddeltaq(klon, klev)
54  REAL d_deltatw(klon, klev), d_deltaqw(klon, klev)
55  INTEGER wake_k(klon)
56  REAL sigd(klon)
57  REAL wake_dens(klon)
58
59  ! Variable internes
60  ! -----------------
61
62  REAL aire
63  REAL p(klon, klev), ph(klon, klev+1), pi(klon, klev)
64  REAL te(klon, klev), qe(klon, klev), omgbe(klon, klev+1)
65  REAL dtdwn(klon, klev), dqdwn(klon, klev)
66  REAL dta(klon, klev), dqa(klon, klev)
67  REAL wdtpbl(klon, klev), wdqpbl(klon, klev)
68  REAL udtpbl(klon, klev), udqpbl(klon, klev)
69  REAL amdwn(klon, klev), amup(klon, klev)
70  REAL dtw(klon, klev), dqw(klon, klev), dth(klon, klev)
71  REAL d_deltat_gw(klon, klev)
72  REAL dtls(klon, klev), dqls(klon, klev)
73  REAL tu(klon, klev), qu(klon, klev)
74  REAL hw(klon), sigmaw(klon), wape(klon), fip(klon), gfl(klon)
75  REAL omgbdth(klon, klev+1), dp_omgb(klon, klev)
76  REAL dtke(klon, klev), dqke(klon, klev)
77  REAL dtpbl(klon, klev), dqpbl(klon, klev)
78  REAL omg(klon, klev+1), dp_deltomg(klon, klev), spread(klon, klev)
79  REAL cstar(klon)
80  REAL sigd0(klon), wdens(klon)
81
82  REAL rdcp
83
84  ! print *, '-> calwake, wake_s ', wake_s(1)
85
86  rdcp = 1./3.5
87
88
89  ! -----------------------------------------------------------
90  ! IM 290108     DO 999 i=1,klon   ! a vectoriser
91  ! ----------------------------------------------------------
92
93
94  DO l = 1, klev
95    DO i = 1, klon
96      p(i, l) = pplay(i, l)
97      ph(i, l) = paprs(i, l)
98      pi(i, l) = (pplay(i,l)/100000.)**rdcp
99
100      te(i, l) = t(i, l)
101      qe(i, l) = q(i, l)
102      omgbe(i, l) = omgb(i, l)
103
104      dtdwn(i, l) = dt_dwn(i, l)
105      dqdwn(i, l) = dq_dwn(i, l)
106      dta(i, l) = dt_a(i, l)
107      dqa(i, l) = dq_a(i, l)
108      wdtpbl(i, l) = wdt_pbl(i, l)
109      wdqpbl(i, l) = wdq_pbl(i, l)
110      udtpbl(i, l) = udt_pbl(i, l)
111      udqpbl(i, l) = udq_pbl(i, l)
112    END DO
113  END DO
114
115  omgbe(:, klev+1) = 0.
116
117  DO i = 1, klon
118    sigd0(i) = sigd(i)
119  END DO
120  ! print*, 'sigd0,sigd', sigd0, sigd(i)
121  DO i = 1, klon
122    ph(i, klev+1) = 0.
123  END DO
124
125  DO i = 1, klon
126    ktopw(i) = wake_k(i)
127  END DO
128
129  DO l = 1, klev
130    DO i = 1, klon
131      dtw(i, l) = wake_deltat(i, l)
132      dqw(i, l) = wake_deltaq(i, l)
133    END DO
134  END DO
135
136  DO l = 1, klev
137    DO i = 1, klon
138      dtls(i, l) = dt_wake(i, l)
139      dqls(i, l) = dq_wake(i, l)
140    END DO
141  END DO
142
143  DO i = 1, klon
144    hw(i) = wake_h(i)
145    sigmaw(i) = wake_s(i)
146  END DO
147
148  ! fkc les flux de masses sont evalues aux niveaux et valent 0 a la surface
149  ! fkc  on veut le flux de masse au milieu des couches
150
151  DO l = 1, klev - 1
152    DO i = 1, klon
153      amdwn(i, l) = 0.5*(m_dwn(i,l)+m_dwn(i,l+1))
154      amdwn(i, l) = (m_dwn(i,l+1))
155    END DO
156  END DO
157
158  ! au sommet le flux de masse est nul
159
160  DO i = 1, klon
161    amdwn(i, klev) = 0.5*m_dwn(i, klev)
162  END DO
163
164  DO l = 1, klev
165    DO i = 1, klon
166      amup(i, l) = m_up(i, l)
167    END DO
168  END DO
169
170  CALL wake(p, ph, pi, dtime, sigd0, te, qe, omgbe, dtdwn, dqdwn, amdwn, &
171    amup, dta, dqa, wdtpbl, wdqpbl, udtpbl, udqpbl, dtw, dqw, dth, hw, &
172    sigmaw, wape, fip, gfl, dtls, dqls, ktopw, omgbdth, dp_omgb, wdens, tu, &
173    qu, dtke, dqke, dtpbl, dqpbl, omg, dp_deltomg, spread, cstar, &
174    d_deltat_gw, d_deltatw, d_deltaqw)
175
176  DO l = 1, klev
177    DO i = 1, klon
178      IF (ktopw(i)>0) THEN
179        wake_deltat(i, l) = dtw(i, l)
180        wake_deltaq(i, l) = dqw(i, l)
181        wake_d_deltat_gw(i, l) = d_deltat_gw(i, l)
182        wake_omgbdth(i, l) = omgbdth(i, l)
183        wake_dp_omgb(i, l) = dp_omgb(i, l)
184        wake_dtke(i, l) = dtke(i, l)
185        wake_dqke(i, l) = dqke(i, l)
186        wake_dtpbl(i, l) = dtpbl(i, l)
187        wake_dqpbl(i, l) = dqpbl(i, l)
188        wake_omg(i, l) = omg(i, l)
189        wake_dp_deltomg(i, l) = dp_deltomg(i, l)
190        wake_spread(i, l) = spread(i, l)
191        wake_dth(i, l) = dth(i, l)
192        dt_wake(i, l) = dtls(i, l)
193        dq_wake(i, l) = dqls(i, l)
194        undi_t(i, l) = tu(i, l)
195        undi_q(i, l) = qu(i, l)
196        wake_ddeltat(i, l) = d_deltatw(i, l)
197        wake_ddeltaq(i, l) = d_deltaqw(i, l)
198      ELSE
199        wake_deltat(i, l) = 0.
200        wake_deltaq(i, l) = 0.
201        wake_d_deltat_gw(i, l) = 0.
202        wake_omgbdth(i, l) = 0.
203        wake_dp_omgb(i, l) = 0.
204        wake_dtke(i, l) = 0.
205        wake_dqke(i, l) = 0.
206        wake_dtpbl(i, l) = 0.
207        wake_dqpbl(i, l) = 0.
208        wake_omg(i, l) = 0.
209        wake_dp_deltomg(i, l) = 0.
210        wake_spread(i, l) = 0.
211        wake_dth(i, l) = 0.
212        dt_wake(i, l) = 0.
213        dq_wake(i, l) = 0.
214        undi_t(i, l) = te(i, l)
215        undi_q(i, l) = qe(i, l)
216        wake_ddeltat(i, l) = 0.
217        wake_ddeltaq(i, l) = 0.
218      END IF
219    END DO
220  END DO
221
222  DO i = 1, klon
223    wake_h(i) = hw(i)
224    wake_s(i) = sigmaw(i)
225    wake_pe(i) = wape(i)
226    wake_fip(i) = fip(i)
227    wake_gfl(i) = gfl(i)
228    wake_k(i) = ktopw(i)
229    wake_cstar(i) = cstar(i)
230    wake_dens(i) = wdens(i)
231  END DO
232
233  RETURN
234END SUBROUTINE calwake
Note: See TracBrowser for help on using the repository browser.