source: LMDZ4/trunk/libf/phylmd/calwake.F @ 887

Last change on this file since 887 was 879, checked in by Laurent Fairhead, 17 years ago

Suite de la bascule vers une physique avec thermiques, nouvelle convection, poche froide ...
LF
  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 6.8 KB
RevLine 
[879]1      SUBROUTINE CALWAKE(paprs,pplay,dtime
2     :             ,t,q,omgb,ibas_con
3     :             ,dt_dwn,dq_dwn,M_dwn,M_up
4     :             ,dt_a,dq_a,sigd
5     :             ,wdt_PBL,wdq_PBL
6     :             ,udt_PBL,udq_PBL
7     o             ,wake_deltat,wake_deltaq,wake_dth
8     o             ,wake_h,wake_s,wake_dens
9     o             ,wake_pe,wake_fip,wake_gfl
10     o             ,dt_wake,dq_wake
11     o             ,wake_k
12     o             ,undi_t,undi_q
13     o             ,wake_omgbdth,wake_dp_omgb
14     o             ,wake_dtKE,wake_dqKE
15     o             ,wake_dtPBL,wake_dqPBL
16     o             ,wake_omg,wake_dp_deltomg
17     o             ,wake_spread,wake_Cstar,wake_d_deltat_gw
18     o             ,wake_ddeltat,wake_ddeltaq)
19***************************************************************
20*                                                             *
21* CALWAKE                                                     *
22*           interface avec le schema de calcul de la poche    *
23*           froide                                            *
24*                                                             *
25* written by   : CHERUY Frederique, 13/03/2000, 10.31.05      *
26* modified by :  ROEHRIG Romain,    01/30/2007                *
27***************************************************************
28*
29      IMPLICIT none
30c======================================================================
31
32#include "dimensions.h"
33#include "dimphy.h"
34#include "YOMCST.h"
35
36c Arguments
37c----------
38
39      INTEGER  i,l,ktopw
40      REAL   dtime
41
42      REAL paprs(klon,klev+1),pplay(klon,klev)
43      REAL t(klon,klev), q(klon,klev), omgb(klon,klev)
44      INTEGER ibas_con(klon)
45      REAL dt_dwn(klon,klev), dq_dwn(klon,klev),M_dwn(klon,klev)
46      REAL M_up(klon,klev)
47      REAL dt_a(klon,klev), dq_a(klon,klev)
48      REAL wdt_PBL(klon,klev), wdq_PBL(klon,klev)
49      REAL udt_PBL(klon,klev), udq_PBL(klon,klev)
50      REAL wake_deltat(klon,klev),wake_deltaq(klon,klev)
51      REAL dt_wake(klon,klev),dq_wake(klon,klev)
52      REAL wake_d_deltat_gw(klon,klev)
53      REAL wake_h(klon),wake_s(klon)
54      REAL wake_dth(klon,klev)
55      REAL wake_pe(klon),wake_fip(klon),wake_gfl(klon)
56      REAL undi_t(klon,klev),undi_q(klon,klev)
57      REAL wake_omgbdth(klon,klev),wake_dp_omgb(klon,klev)
58      REAL wake_dtKE(klon,klev),wake_dqKE(klon,klev)
59      REAL wake_dtPBL(klon,klev),wake_dqPBL(klon,klev)
60      REAL wake_omg(klon,klev+1),wake_dp_deltomg(klon,klev)
61      REAL wake_spread(klon,klev),wake_Cstar(klon)
62      REAL wake_ddeltat(klon,klev),wake_ddeltaq(klon,klev)
63      REAL d_deltatw(klev), d_deltaqw(klev)
64      INTEGER wake_k(klon)
65      REAL sigd(klon)
66      REAL wake_dens(klon)
67
68C  Variable internes
69C  -----------------
70
71      REAL aire
72      REAL p(klev),ph(klev+1),pi(klev)
73      REAL te(klev),qe(klev),omgbe(klev),dtdwn(klev),dqdwn(klev)
74      INTEGER  ibas
75      REAL dta(klev),dqa(klev)
76      REAL wdtPBL(klev),wdqPBL(klev)
77      REAL udtPBL(klev),udqPBL(klev)
78      REAL amdwn(klev),amup(klev)
79      REAL dtw(klev),dqw(klev),dth(klev),d_deltat_gw(klev)
80      REAL dtls(klev),dqls(klev)
81      REAL tu(klev),qu(klev)
82      REAL hw,sigmaw,wape,fip,gfl
83      REAL omgbdth(klev),dp_omgb(klev)
84      REAL dtKE(klev),dqKE(klev)
85      REAL dtPBL(klev),dqPBL(klev)
86      REAL omg(klev+1),dp_deltomg(klev),spread(klev),Cstar
87      REAL sigd0,wdens
88
89      REAL RDCP
90
91c      print *, '-> calwake, wake_s ', wake_s(1)
92
93      RDCP=1./3.5
94
95c-----------------------------------------------------------
96      DO 999 i=1,klon   ! a vectoriser
97c----------------------------------------------------------
98
99
100      DO l=1,klev
101        p(l)= pplay(i,l)
102        ph(l)= paprs(i,l)
103        pi(l) = (pplay(i,l)/100000.)**RDCP
104
105        te(l) = t(i,l)
106        qe(l) = q(i,l)
107        omgbe(l) = omgb(i,l)
108
109        dtdwn(l)= dt_dwn(i,l)
110        dqdwn(l)= dq_dwn(i,l)
111        dta(l)= dt_a(i,l)
112        dqa(l)= dq_a(i,l)
113        wdtPBL(l)= wdt_PBL(i,l)
114        wdqPBL(l)= wdq_PBL(i,l)
115        udtPBL(l)= udt_PBL(i,l)
116        udqPBL(l)= udq_PBL(i,l)
117      ENDDO
118     
119      sigd0=sigd(i)
120c      print*, 'sigd0,sigd', sigd0, sigd(i)
121      ph(klev+1)=0.
122      ibas = ibas_con(1)
123
124      ktopw = wake_k(i)
125
126      DO l=1,klev
127        dtw(l) = wake_deltat(i,l)
128        dqw(l) = wake_deltaq(i,l)
129      ENDDO
130
131      DO l=1,klev
132        dtls(l)=dt_wake(i,l)
133        dqls(l)=dq_wake(i,l)
134      ENDDO
135
136      hw = wake_h(i)
137      sigmaw = wake_s(i)
138
139cfkc les flux de masses sont evalues aux niveaux et valent 0 a la surface
140cfkc  on veut le flux de masse au milieu des couches
141
142      DO l=1,klev-1
143        amdwn(l)= 0.5*(M_dwn(i,l)+M_dwn(i,l+1))
144        amdwn(l)= (M_dwn(i,l+1))
145      ENDDO
146
147c au sommet le flux de masse est nul
148
149      amdwn(klev)=0.5*M_dwn(i,klev)
150c
151      DO l = 1,klev
152        amup(l)=M_up(i,l)
153      ENDDO
154
155      call WAKE(p,ph,pi,dtime,sigd0
156     $                ,te,qe,omgbe,ibas
157     $                ,dtdwn,dqdwn,amdwn,amup,dta,dqa
158     $                ,wdtPBL,wdqPBL,udtPBL,udqPBL
159     $                ,dtw,dqw,dth,hw,sigmaw,wape,fip,gfl
160     $                ,dtls,dqls,ktopw
161     $                ,omgbdth,dp_omgb,wdens
162     $                ,tu,qu
163     $                ,dtKE,dqKE
164     $                ,dtPBL,dqPBL
165     $                ,omg,dp_deltomg,spread
166     $                ,Cstar,d_deltat_gw
167     $                ,d_deltatw,d_deltaqw)
168
169       IF (ktopw .GT. 0) THEN
170         DO l=1,klev
171           wake_deltat(i,l)= dtw(l)
172           wake_deltaq(i,l)= dqw(l)
173           wake_d_deltat_gw(i,l)= d_deltat_gw(l)
174           wake_omgbdth(i,l) = omgbdth(l)
175           wake_dp_omgb(i,l) = dp_omgb(l)
176           wake_dtKE(i,l) = dtKE(l)
177           wake_dqKE(i,l) = dqKE(l)
178           wake_dtPBL(i,l) = dtPBL(l)
179           wake_dqPBL(i,l) = dqPBL(l)
180           wake_omg(i,l) = omg(l)
181           wake_dp_deltomg(i,l) = dp_deltomg(l)
182           wake_spread(i,l) = spread(l)
183           wake_dth(i,l) = dth(l)
184           dt_wake(i,l) = dtls(l)
185           dq_wake(i,l) = dqls(l)
186           undi_t(i,l) = tu(l)
187           undi_q(i,l) = qu(l)
188           wake_ddeltat(i,l) = d_deltatw(l)
189           wake_ddeltaq(i,l) = d_deltaqw(l)
190         ENDDO
191       ELSE
192         DO l = 1,klev
193           wake_deltat(i,l)= 0.
194           wake_deltaq(i,l)= 0.
195           wake_d_deltat_gw(i,l)= 0.
196           wake_omgbdth(i,l) = 0.
197           wake_dp_omgb(i,l) = 0.
198           wake_dtKE(i,l) = 0.
199           wake_dqKE(i,l) = 0.
200           wake_omg(i,l) = 0.
201           wake_dp_deltomg(i,l) = 0.
202           wake_spread(i,l) = 0.
203           wake_dth(i,l)=0.
204           dt_wake(i,l)=0.
205           dq_wake(i,l)=0.
206           undi_t(i,l)=te(l)
207           undi_q(i,l)=qe(l)
208         ENDDO
209       ENDIF
210
211       wake_h(i)= hw
212       wake_s(i)= sigmaw
213       wake_pe(i)= wape
214       wake_fip(i)= fip
215       wake_gfl(i) = gfl
216       wake_k(i) =ktopw
217       wake_Cstar(i) = Cstar
218       wake_dens(i) = wdens
219c
220 999  CONTINUE
221c
222      RETURN
223      END
Note: See TracBrowser for help on using the repository browser.