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

Last change on this file since 946 was 940, checked in by Laurent Fairhead, 16 years ago

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