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

Last change on this file since 939 was 923, checked in by lmdzadmin, 17 years ago

Correction petit bug indice ibas_con
IM
  • 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.
[923]122cIM bug indice ibas_con: ibas = ibas_con(1)
123      ibas = ibas_con(i)
[879]124
125      ktopw = wake_k(i)
126
127      DO l=1,klev
128        dtw(l) = wake_deltat(i,l)
129        dqw(l) = wake_deltaq(i,l)
130      ENDDO
131
132      DO l=1,klev
133        dtls(l)=dt_wake(i,l)
134        dqls(l)=dq_wake(i,l)
135      ENDDO
136
137      hw = wake_h(i)
138      sigmaw = wake_s(i)
139
140cfkc les flux de masses sont evalues aux niveaux et valent 0 a la surface
141cfkc  on veut le flux de masse au milieu des couches
142
143      DO l=1,klev-1
144        amdwn(l)= 0.5*(M_dwn(i,l)+M_dwn(i,l+1))
145        amdwn(l)= (M_dwn(i,l+1))
146      ENDDO
147
148c au sommet le flux de masse est nul
149
150      amdwn(klev)=0.5*M_dwn(i,klev)
151c
152      DO l = 1,klev
153        amup(l)=M_up(i,l)
154      ENDDO
155
156      call WAKE(p,ph,pi,dtime,sigd0
157     $                ,te,qe,omgbe,ibas
158     $                ,dtdwn,dqdwn,amdwn,amup,dta,dqa
159     $                ,wdtPBL,wdqPBL,udtPBL,udqPBL
160     $                ,dtw,dqw,dth,hw,sigmaw,wape,fip,gfl
161     $                ,dtls,dqls,ktopw
162     $                ,omgbdth,dp_omgb,wdens
163     $                ,tu,qu
164     $                ,dtKE,dqKE
165     $                ,dtPBL,dqPBL
166     $                ,omg,dp_deltomg,spread
167     $                ,Cstar,d_deltat_gw
168     $                ,d_deltatw,d_deltaqw)
169
170       IF (ktopw .GT. 0) THEN
171         DO l=1,klev
172           wake_deltat(i,l)= dtw(l)
173           wake_deltaq(i,l)= dqw(l)
174           wake_d_deltat_gw(i,l)= d_deltat_gw(l)
175           wake_omgbdth(i,l) = omgbdth(l)
176           wake_dp_omgb(i,l) = dp_omgb(l)
177           wake_dtKE(i,l) = dtKE(l)
178           wake_dqKE(i,l) = dqKE(l)
179           wake_dtPBL(i,l) = dtPBL(l)
180           wake_dqPBL(i,l) = dqPBL(l)
181           wake_omg(i,l) = omg(l)
182           wake_dp_deltomg(i,l) = dp_deltomg(l)
183           wake_spread(i,l) = spread(l)
184           wake_dth(i,l) = dth(l)
185           dt_wake(i,l) = dtls(l)
186           dq_wake(i,l) = dqls(l)
187           undi_t(i,l) = tu(l)
188           undi_q(i,l) = qu(l)
189           wake_ddeltat(i,l) = d_deltatw(l)
190           wake_ddeltaq(i,l) = d_deltaqw(l)
191         ENDDO
192       ELSE
193         DO l = 1,klev
194           wake_deltat(i,l)= 0.
195           wake_deltaq(i,l)= 0.
196           wake_d_deltat_gw(i,l)= 0.
197           wake_omgbdth(i,l) = 0.
198           wake_dp_omgb(i,l) = 0.
199           wake_dtKE(i,l) = 0.
200           wake_dqKE(i,l) = 0.
201           wake_omg(i,l) = 0.
202           wake_dp_deltomg(i,l) = 0.
203           wake_spread(i,l) = 0.
204           wake_dth(i,l)=0.
205           dt_wake(i,l)=0.
206           dq_wake(i,l)=0.
207           undi_t(i,l)=te(l)
208           undi_q(i,l)=qe(l)
209         ENDDO
210       ENDIF
211
212       wake_h(i)= hw
213       wake_s(i)= sigmaw
214       wake_pe(i)= wape
215       wake_fip(i)= fip
216       wake_gfl(i) = gfl
217       wake_k(i) =ktopw
218       wake_Cstar(i) = Cstar
219       wake_dens(i) = wdens
220c
221 999  CONTINUE
222c
223      RETURN
224      END
Note: See TracBrowser for help on using the repository browser.