/[lmdze]/trunk/libf/dyn3d/calfis.f90
ViewVC logotype

Diff of /trunk/libf/dyn3d/calfis.f90

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 10 by guez, Fri Apr 18 14:45:53 2008 UTC revision 34 by guez, Wed Jun 2 11:01:12 2010 UTC
# Line 6  module calfis_m Line 6  module calfis_m
6    
7  contains  contains
8    
9    SUBROUTINE calfis(nq, lafin, rdayvrai, heure, pucov, pvcov, pteta, pq, &    SUBROUTINE calfis(lafin, rdayvrai, heure, pucov, pvcov, pteta, q, &
10         pmasse, pps, ppk, pphis, pphi, pducov, pdvcov, pdteta, pdq, pw, &         pmasse, pps, ppk, pphis, pphi, pducov, pdvcov, pdteta, pdq, pw, &
11         clesphy0, pdufi, pdvfi, pdhfi, pdqfi, pdpsfi)         pdufi, pdvfi, pdhfi, pdqfi, pdpsfi)
12    
13      ! From dyn3d/calfis.F,v 1.3 2005/05/25 13:10:09      ! From dyn3d/calfis.F, v 1.3 2005/05/25 13:10:09
14    
15      ! Auteurs : P. Le Van, F. Hourdin      ! Auteurs : P. Le Van, F. Hourdin
16    
# Line 55  contains Line 55  contains
55      use dimens_m, only: iim, jjm, llm, nqmx      use dimens_m, only: iim, jjm, llm, nqmx
56      use dimphy, only: klon      use dimphy, only: klon
57      use comconst, only: kappa, cpp, dtphys, g, pi      use comconst, only: kappa, cpp, dtphys, g, pi
58      use comvert, only: preff, presnivs      use comvert, only: preff
59      use comgeom, only: apoln, cu_2d, cv_2d, unsaire_2d, apols, rlonu, rlonv      use comgeom, only: apoln, cu_2d, cv_2d, unsaire_2d, apols, rlonu, rlonv
60      use advtrac_m, only: niadv      use iniadvtrac_m, only: niadv
61      use grid_change, only: dyn_phy, gr_fi_dyn      use grid_change, only: dyn_phy, gr_fi_dyn
62      use physiq_m, only: physiq      use physiq_m, only: physiq
63      use pressure_var, only: p3d, pls      use pressure_var, only: p3d, pls
64    
     !    0.  Declarations :  
   
     INTEGER nq  
   
65      !    Arguments :      !    Arguments :
66    
67      LOGICAL, intent(in):: lafin      LOGICAL, intent(in):: lafin
68      REAL, intent(in):: heure ! heure de la journée en fraction de jour      REAL, intent(in):: heure ! heure de la journée en fraction de jour
69    
70      REAL pvcov(iim + 1,jjm,llm)      REAL pvcov(iim + 1, jjm, llm)
71      REAL pucov(iim + 1,jjm + 1,llm)      REAL pucov(iim + 1, jjm + 1, llm)
72      REAL pteta(iim + 1,jjm + 1,llm)      REAL pteta(iim + 1, jjm + 1, llm)
73      REAL pmasse(iim + 1,jjm + 1,llm)      REAL pmasse(iim + 1, jjm + 1, llm)
74    
75      REAL, intent(in):: pq(iim + 1,jjm + 1,llm,nqmx)      REAL, intent(in):: q(iim + 1, jjm + 1, llm, nqmx)
76      ! (mass fractions of advected fields)      ! (mass fractions of advected fields)
77    
78      REAL pphis(iim + 1,jjm + 1)      REAL pphis(iim + 1, jjm + 1)
79      REAL pphi(iim + 1,jjm + 1,llm)      REAL pphi(iim + 1, jjm + 1, llm)
80    
81      REAL pdvcov(iim + 1,jjm,llm)      REAL pdvcov(iim + 1, jjm, llm)
82      REAL pducov(iim + 1,jjm + 1,llm)      REAL pducov(iim + 1, jjm + 1, llm)
83      REAL pdteta(iim + 1,jjm + 1,llm)      REAL pdteta(iim + 1, jjm + 1, llm)
84      REAL pdq(iim + 1,jjm + 1,llm,nqmx)      REAL pdq(iim + 1, jjm + 1, llm, nqmx)
85    
86      REAL pw(iim + 1,jjm + 1,llm)      REAL pw(iim + 1, jjm + 1, llm)
87    
88      REAL pps(iim + 1,jjm + 1)      REAL pps(iim + 1, jjm + 1)
89      REAL, intent(in):: ppk(iim + 1,jjm + 1,llm)      REAL, intent(in):: ppk(iim + 1, jjm + 1, llm)
90    
91      REAL pdvfi(iim + 1,jjm,llm)      REAL pdvfi(iim + 1, jjm, llm)
92      REAL pdufi(iim + 1,jjm + 1,llm)      REAL pdufi(iim + 1, jjm + 1, llm)
93      REAL pdhfi(iim + 1,jjm + 1,llm)      REAL pdhfi(iim + 1, jjm + 1, llm)
94      REAL pdqfi(iim + 1,jjm + 1,llm,nqmx)      REAL pdqfi(iim + 1, jjm + 1, llm, nqmx)
95      REAL pdpsfi(iim + 1,jjm + 1)      REAL pdpsfi(iim + 1, jjm + 1)
96    
97      INTEGER, PARAMETER:: longcles = 20      INTEGER, PARAMETER:: longcles = 20
     REAL clesphy0(longcles)  
98    
99      !    Local variables :      !    Local variables :
100    
101      INTEGER i,j,l,ig0,ig,iq,iiq      INTEGER i, j, l, ig0, ig, iq, iiq
102      REAL zpsrf(klon)      REAL zpsrf(klon)
103      REAL zplev(klon,llm+1),zplay(klon,llm)      REAL zplev(klon, llm+1), zplay(klon, llm)
104      REAL zphi(klon,llm),zphis(klon)      REAL zphi(klon, llm), zphis(klon)
105    
106      REAL zufi(klon,llm), zvfi(klon,llm)      REAL zufi(klon, llm), zvfi(klon, llm)
107      REAL ztfi(klon,llm) ! temperature      REAL ztfi(klon, llm) ! temperature
108      real zqfi(klon,llm,nqmx) ! mass fractions of advected fields      real qx(klon, llm, nqmx) ! mass fractions of advected fields
109    
110      REAL pcvgu(klon,llm), pcvgv(klon,llm)      REAL pcvgu(klon, llm), pcvgv(klon, llm)
111      REAL pcvgt(klon,llm), pcvgq(klon,llm,2)      REAL pcvgt(klon, llm), pcvgq(klon, llm, 2)
112    
113      REAL pvervel(klon,llm)      REAL pvervel(klon, llm)
114    
115      REAL zdufi(klon,llm),zdvfi(klon,llm)      REAL zdufi(klon, llm), zdvfi(klon, llm)
116      REAL zdtfi(klon,llm),zdqfi(klon,llm,nqmx)      REAL zdtfi(klon, llm), zdqfi(klon, llm, nqmx)
117      REAL zdpsrf(klon)      REAL zdpsrf(klon)
118    
119      REAL zsin(iim),zcos(iim),z1(iim)      REAL zsin(iim), zcos(iim), z1(iim)
120      REAL zsinbis(iim),zcosbis(iim),z1bis(iim)      REAL zsinbis(iim), zcosbis(iim), z1bis(iim)
121      REAL pksurcp(iim + 1,jjm + 1)      REAL pksurcp(iim + 1, jjm + 1)
122    
123      ! I. Musat: diagnostic PVteta, Amip2      ! I. Musat: diagnostic PVteta, Amip2
124      INTEGER, PARAMETER:: ntetaSTD=3      INTEGER, PARAMETER:: ntetaSTD=3
125      REAL:: rtetaSTD(ntetaSTD) = (/350., 380., 405./)      REAL:: rtetaSTD(ntetaSTD) = (/350., 380., 405./)
126      REAL PVteta(klon,ntetaSTD)      REAL PVteta(klon, ntetaSTD)
127    
128      REAL SSUM      REAL SSUM
129    
# Line 145  contains Line 140  contains
140      !   40. transformation des variables dynamiques en variables physiques:      !   40. transformation des variables dynamiques en variables physiques:
141      !   41. pressions au sol (en Pascals)      !   41. pressions au sol (en Pascals)
142    
143      zpsrf(1) = pps(1,1)      zpsrf(1) = pps(1, 1)
144    
145      ig0  = 2      ig0  = 2
146      DO j = 2,jjm      DO j = 2, jjm
147         CALL SCOPY(iim,pps(1,j),1,zpsrf(ig0), 1)         CALL SCOPY(iim, pps(1, j), 1, zpsrf(ig0), 1)
148         ig0 = ig0+iim         ig0 = ig0+iim
149      ENDDO      ENDDO
150    
151      zpsrf(klon) = pps(1,jjm + 1)      zpsrf(klon) = pps(1, jjm + 1)
152    
153      !   42. pression intercouches :      !   42. pression intercouches :
154    
# Line 165  contains Line 160  contains
160      forall (l = 1: llm+1) zplev(:, l) = pack(p3d(:, :, l), dyn_phy)      forall (l = 1: llm+1) zplev(:, l) = pack(p3d(:, :, l), dyn_phy)
161    
162      !   43. temperature naturelle (en K) et pressions milieux couches .      !   43. temperature naturelle (en K) et pressions milieux couches .
163      DO l=1,llm      DO l=1, llm
164         pksurcp     =  ppk(:, :, l) / cpp         pksurcp     =  ppk(:, :, l) / cpp
165         pls(:, :, l) = preff * pksurcp**(1./ kappa)         pls(:, :, l) = preff * pksurcp**(1./ kappa)
166         zplay(:, l) = pack(pls(:, :, l), dyn_phy)         zplay(:, l) = pack(pls(:, :, l), dyn_phy)
# Line 175  contains Line 170  contains
170    
171      !   43.bis traceurs      !   43.bis traceurs
172    
173      DO iq=1,nq      DO iq=1, nqmx
174         iiq=niadv(iq)         iiq=niadv(iq)
175         DO l=1,llm         DO l=1, llm
176            zqfi(1,l,iq) = pq(1,1,l,iiq)            qx(1, l, iq) = q(1, 1, l, iiq)
177            ig0          = 2            ig0          = 2
178            DO j=2,jjm            DO j=2, jjm
179               DO i = 1, iim               DO i = 1, iim
180                  zqfi(ig0,l,iq)  = pq(i,j,l,iiq)                  qx(ig0, l, iq)  = q(i, j, l, iiq)
181                  ig0             = ig0 + 1                  ig0             = ig0 + 1
182               ENDDO               ENDDO
183            ENDDO            ENDDO
184            zqfi(ig0,l,iq) = pq(1,jjm + 1,l,iiq)            qx(ig0, l, iq) = q(1, jjm + 1, l, iiq)
185         ENDDO         ENDDO
186      ENDDO      ENDDO
187    
188      !   convergence dynamique pour les traceurs "EAU"      !   convergence dynamique pour les traceurs "EAU"
189    
190      DO iq=1,2      DO iq=1, 2
191         DO l=1,llm         DO l=1, llm
192            pcvgq(1,l,iq)= pdq(1,1,l,iq) / pmasse(1,1,l)            pcvgq(1, l, iq)= pdq(1, 1, l, iq) / pmasse(1, 1, l)
193            ig0          = 2            ig0          = 2
194            DO j=2,jjm            DO j=2, jjm
195               DO i = 1, iim               DO i = 1, iim
196                  pcvgq(ig0,l,iq) = pdq(i,j,l,iq) / pmasse(i,j,l)                  pcvgq(ig0, l, iq) = pdq(i, j, l, iq) / pmasse(i, j, l)
197                  ig0             = ig0 + 1                  ig0             = ig0 + 1
198               ENDDO               ENDDO
199            ENDDO            ENDDO
200            pcvgq(ig0,l,iq)= pdq(1,jjm + 1,l,iq) / pmasse(1,jjm + 1,l)            pcvgq(ig0, l, iq)= pdq(1, jjm + 1, l, iq) / pmasse(1, jjm + 1, l)
201         ENDDO         ENDDO
202      ENDDO      ENDDO
203    
# Line 210  contains Line 205  contains
205    
206      forall (l = 1:llm) zphi(:, l) = pack(pphi(:, :, l), dyn_phy)      forall (l = 1:llm) zphi(:, l) = pack(pphi(:, :, l), dyn_phy)
207      zphis = pack(pphis, dyn_phy)      zphis = pack(pphis, dyn_phy)
208      DO l=1,llm      DO l=1, llm
209         DO ig=1,klon         DO ig=1, klon
210            zphi(ig,l)=zphi(ig,l)-zphis(ig)            zphi(ig, l)=zphi(ig, l)-zphis(ig)
211         ENDDO         ENDDO
212      ENDDO      ENDDO
213    
214      !   ....  Calcul de la vitesse  verticale  (en Pa*m*s  ou Kg/s)  ....      !   ....  Calcul de la vitesse  verticale  (en Pa*m*s  ou Kg/s)  ....
215    
216      DO l=1,llm      DO l=1, llm
217         pvervel(1,l)=pw(1,1,l) * g /apoln         pvervel(1, l)=pw(1, 1, l) * g /apoln
218         ig0=2         ig0=2
219         DO j=2,jjm         DO j=2, jjm
220            DO i = 1, iim            DO i = 1, iim
221               pvervel(ig0,l) = pw(i,j,l) * g * unsaire_2d(i,j)               pvervel(ig0, l) = pw(i, j, l) * g * unsaire_2d(i, j)
222               ig0 = ig0 + 1               ig0 = ig0 + 1
223            ENDDO            ENDDO
224         ENDDO         ENDDO
225         pvervel(ig0,l)=pw(1,jjm + 1,l) * g /apols         pvervel(ig0, l)=pw(1, jjm + 1, l) * g /apols
226      ENDDO      ENDDO
227    
228      !   45. champ u:      !   45. champ u:
229    
230      DO  l=1,llm      DO  l=1, llm
231    
232         DO  j=2,jjm         DO  j=2, jjm
233            ig0 = 1+(j-2)*iim            ig0 = 1+(j-2)*iim
234            zufi(ig0+1,l)= 0.5 *  &            zufi(ig0+1, l)= 0.5 *  &
235                 (pucov(iim,j,l)/cu_2d(iim,j) + pucov(1,j,l)/cu_2d(1,j))                 (pucov(iim, j, l)/cu_2d(iim, j) + pucov(1, j, l)/cu_2d(1, j))
236            pcvgu(ig0+1,l)= 0.5 *  &            pcvgu(ig0+1, l)= 0.5 *  &
237                 (pducov(iim,j,l)/cu_2d(iim,j) + pducov(1,j,l)/cu_2d(1,j))                 (pducov(iim, j, l)/cu_2d(iim, j) + pducov(1, j, l)/cu_2d(1, j))
238            DO i=2,iim            DO i=2, iim
239               zufi(ig0+i,l)= 0.5 * &               zufi(ig0+i, l)= 0.5 * &
240                    (pucov(i-1,j,l)/cu_2d(i-1,j) &                    (pucov(i-1, j, l)/cu_2d(i-1, j) &
241                    + pucov(i,j,l)/cu_2d(i,j))                    + pucov(i, j, l)/cu_2d(i, j))
242               pcvgu(ig0+i,l)= 0.5 * &               pcvgu(ig0+i, l)= 0.5 * &
243                    (pducov(i-1,j,l)/cu_2d(i-1,j) &                    (pducov(i-1, j, l)/cu_2d(i-1, j) &
244                    + pducov(i,j,l)/cu_2d(i,j))                    + pducov(i, j, l)/cu_2d(i, j))
245            end DO            end DO
246         end DO         end DO
247    
# Line 254  contains Line 249  contains
249    
250      !   46.champ v:      !   46.champ v:
251    
252      DO l=1,llm      DO l = 1, llm
253         DO j=2,jjm         DO j = 2, jjm
254            ig0=1+(j-2)*iim            ig0 = 1 + (j - 2) * iim
255            DO i=1,iim            DO i = 1, iim
256               zvfi(ig0+i,l)= 0.5 * &               zvfi(ig0+i, l)= 0.5 * (pvcov(i, j-1, l) / cv_2d(i, j-1) &
257                    (pvcov(i,j-1,l)/cv_2d(i,j-1) &                    + pvcov(i, j, l) / cv_2d(i, j))
258                    + pvcov(i,j,l)/cv_2d(i,j))               pcvgv(ig0+i, l)= 0.5 * &
259               pcvgv(ig0+i,l)= 0.5 * &                    (pdvcov(i, j-1, l)/cv_2d(i, j-1) &
260                    (pdvcov(i,j-1,l)/cv_2d(i,j-1) &                    + pdvcov(i, j, l)/cv_2d(i, j))
                   + pdvcov(i,j,l)/cv_2d(i,j))  
261            ENDDO            ENDDO
262         ENDDO         ENDDO
263      ENDDO      ENDDO
264    
265      !   47. champs de vents aux pole nord        !   47. champs de vents au pôle nord  
266      !        U = 1 / pi  *  integrale [ v * cos(long) * d long ]      !        U = 1 / pi  *  integrale [ v * cos(long) * d long ]
267      !        V = 1 / pi  *  integrale [ v * sin(long) * d long ]      !        V = 1 / pi  *  integrale [ v * sin(long) * d long ]
268    
269      DO l=1,llm      DO l=1, llm
270    
271         z1(1)   =(rlonu(1)-rlonu(iim)+2.*pi)*pvcov(1,1,l)/cv_2d(1,1)         z1(1)   =(rlonu(1)-rlonu(iim)+2.*pi)*pvcov(1, 1, l)/cv_2d(1, 1)
272         z1bis(1)=(rlonu(1)-rlonu(iim)+2.*pi)*pdvcov(1,1,l)/cv_2d(1,1)         z1bis(1)=(rlonu(1)-rlonu(iim)+2.*pi)*pdvcov(1, 1, l)/cv_2d(1, 1)
273         DO i=2,iim         DO i=2, iim
274            z1(i)   =(rlonu(i)-rlonu(i-1))*pvcov(i,1,l)/cv_2d(i,1)            z1(i)   =(rlonu(i)-rlonu(i-1))*pvcov(i, 1, l)/cv_2d(i, 1)
275            z1bis(i)=(rlonu(i)-rlonu(i-1))*pdvcov(i,1,l)/cv_2d(i,1)            z1bis(i)=(rlonu(i)-rlonu(i-1))*pdvcov(i, 1, l)/cv_2d(i, 1)
276         ENDDO         ENDDO
277    
278         DO i=1,iim         DO i=1, iim
279            zcos(i)   = COS(rlonv(i))*z1(i)            zcos(i)   = COS(rlonv(i))*z1(i)
280            zcosbis(i)= COS(rlonv(i))*z1bis(i)            zcosbis(i)= COS(rlonv(i))*z1bis(i)
281            zsin(i)   = SIN(rlonv(i))*z1(i)            zsin(i)   = SIN(rlonv(i))*z1(i)
282            zsinbis(i)= SIN(rlonv(i))*z1bis(i)            zsinbis(i)= SIN(rlonv(i))*z1bis(i)
283         ENDDO         ENDDO
284    
285         zufi(1,l)  = SSUM(iim,zcos,1)/pi         zufi(1, l)  = SSUM(iim, zcos, 1)/pi
286         pcvgu(1,l) = SSUM(iim,zcosbis,1)/pi         pcvgu(1, l) = SSUM(iim, zcosbis, 1)/pi
287         zvfi(1,l)  = SSUM(iim,zsin,1)/pi         zvfi(1, l)  = SSUM(iim, zsin, 1)/pi
288         pcvgv(1,l) = SSUM(iim,zsinbis,1)/pi         pcvgv(1, l) = SSUM(iim, zsinbis, 1)/pi
289    
290      ENDDO      ENDDO
291    
292      !   48. champs de vents aux pole sud:      !   48. champs de vents au pôle sud:
293      !        U = 1 / pi  *  integrale [ v * cos(long) * d long ]      !        U = 1 / pi  *  integrale [ v * cos(long) * d long ]
294      !        V = 1 / pi  *  integrale [ v * sin(long) * d long ]      !        V = 1 / pi  *  integrale [ v * sin(long) * d long ]
295    
296      DO l=1,llm      DO l=1, llm
297    
298         z1(1)   =(rlonu(1)-rlonu(iim)+2.*pi)*pvcov(1,jjm,l) &         z1(1)   =(rlonu(1)-rlonu(iim)+2.*pi)*pvcov(1, jjm, l) &
299              /cv_2d(1,jjm)              /cv_2d(1, jjm)
300         z1bis(1)=(rlonu(1)-rlonu(iim)+2.*pi)*pdvcov(1,jjm,l) &         z1bis(1)=(rlonu(1)-rlonu(iim)+2.*pi)*pdvcov(1, jjm, l) &
301              /cv_2d(1,jjm)              /cv_2d(1, jjm)
302         DO i=2,iim         DO i=2, iim
303            z1(i)   =(rlonu(i)-rlonu(i-1))*pvcov(i,jjm,l)/cv_2d(i,jjm)            z1(i)   =(rlonu(i)-rlonu(i-1))*pvcov(i, jjm, l)/cv_2d(i, jjm)
304            z1bis(i)=(rlonu(i)-rlonu(i-1))*pdvcov(i,jjm,l)/cv_2d(i,jjm)            z1bis(i)=(rlonu(i)-rlonu(i-1))*pdvcov(i, jjm, l)/cv_2d(i, jjm)
305         ENDDO         ENDDO
306    
307         DO i=1,iim         DO i=1, iim
308            zcos(i)    = COS(rlonv(i))*z1(i)            zcos(i)    = COS(rlonv(i))*z1(i)
309            zcosbis(i) = COS(rlonv(i))*z1bis(i)            zcosbis(i) = COS(rlonv(i))*z1bis(i)
310            zsin(i)    = SIN(rlonv(i))*z1(i)            zsin(i)    = SIN(rlonv(i))*z1(i)
311            zsinbis(i) = SIN(rlonv(i))*z1bis(i)            zsinbis(i) = SIN(rlonv(i))*z1bis(i)
312         ENDDO         ENDDO
313    
314         zufi(klon,l)  = SSUM(iim,zcos,1)/pi         zufi(klon, l)  = SSUM(iim, zcos, 1)/pi
315         pcvgu(klon,l) = SSUM(iim,zcosbis,1)/pi         pcvgu(klon, l) = SSUM(iim, zcosbis, 1)/pi
316         zvfi(klon,l)  = SSUM(iim,zsin,1)/pi         zvfi(klon, l)  = SSUM(iim, zsin, 1)/pi
317         pcvgv(klon,l) = SSUM(iim,zsinbis,1)/pi         pcvgv(klon, l) = SSUM(iim, zsinbis, 1)/pi
318    
319      ENDDO      ENDDO
320    
321      !IM calcul PV a teta=350, 380, 405K      !IM calcul PV a teta=350, 380, 405K
322      CALL PVtheta(klon,llm,pucov,pvcov,pteta, &      CALL PVtheta(klon, llm, pucov, pvcov, pteta, &
323           ztfi,zplay,zplev, &           ztfi, zplay, zplev, &
324           ntetaSTD,rtetaSTD,PVteta)           ntetaSTD, rtetaSTD, PVteta)
325    
326      !   Appel de la physique:      !   Appel de la physique:
327    
328      CALL physiq(nq, firstcal, lafin, rdayvrai, heure, dtphys, &      CALL physiq(firstcal, lafin, rdayvrai, heure, dtphys, zplev, zplay, zphi, &
329           zplev, zplay, zphi, zphis, presnivs, clesphy0, zufi, zvfi, &           zphis, zufi, zvfi, ztfi, qx, pvervel, zdufi, zdvfi, zdtfi, zdqfi, &
330           ztfi, zqfi, pvervel, zdufi, zdvfi, zdtfi, zdqfi, zdpsrf, pducov, &           zdpsrf, pducov, PVteta) ! IM diagnostique PVteta, Amip2
          PVteta) ! IM diagnostique PVteta, Amip2  
331    
332      !   transformation des tendances physiques en tendances dynamiques:      !   transformation des tendances physiques en tendances dynamiques:
333    
# Line 344  contains Line 337  contains
337    
338      !   62. enthalpie potentielle      !   62. enthalpie potentielle
339    
340      DO l=1,llm      DO l=1, llm
341    
342         DO i=1,iim + 1         DO i=1, iim + 1
343            pdhfi(i,1,l)    = cpp *  zdtfi(1,l)      / ppk(i, 1  ,l)            pdhfi(i, 1, l)    = cpp *  zdtfi(1, l)      / ppk(i, 1  , l)
344            pdhfi(i,jjm + 1,l) = cpp *  zdtfi(klon,l)/ ppk(i,jjm + 1,l)            pdhfi(i, jjm + 1, l) = cpp *  zdtfi(klon, l)/ ppk(i, jjm + 1, l)
345         ENDDO         ENDDO
346    
347         DO j=2,jjm         DO j=2, jjm
348            ig0=1+(j-2)*iim            ig0=1+(j-2)*iim
349            DO i=1,iim            DO i=1, iim
350               pdhfi(i,j,l) = cpp * zdtfi(ig0+i,l) / ppk(i,j,l)               pdhfi(i, j, l) = cpp * zdtfi(ig0+i, l) / ppk(i, j, l)
351            ENDDO            ENDDO
352            pdhfi(iim + 1,j,l) =  pdhfi(1,j,l)            pdhfi(iim + 1, j, l) =  pdhfi(1, j, l)
353         ENDDO         ENDDO
354    
355      ENDDO      ENDDO
356    
357      !   62. humidite specifique      !   62. humidite specifique
358    
359      DO iq=1,nqmx      DO iq=1, nqmx
360         DO l=1,llm         DO l=1, llm
361            DO i=1,iim + 1            DO i=1, iim + 1
362               pdqfi(i,1,l,iq)    = zdqfi(1,l,iq)               pdqfi(i, 1, l, iq)    = zdqfi(1, l, iq)
363               pdqfi(i,jjm + 1,l,iq) = zdqfi(klon,l,iq)               pdqfi(i, jjm + 1, l, iq) = zdqfi(klon, l, iq)
364            ENDDO            ENDDO
365            DO j=2,jjm            DO j=2, jjm
366               ig0=1+(j-2)*iim               ig0=1+(j-2)*iim
367               DO i=1,iim               DO i=1, iim
368                  pdqfi(i,j,l,iq) = zdqfi(ig0+i,l,iq)                  pdqfi(i, j, l, iq) = zdqfi(ig0+i, l, iq)
369               ENDDO               ENDDO
370               pdqfi(iim + 1,j,l,iq) = pdqfi(1,j,l,iq)               pdqfi(iim + 1, j, l, iq) = pdqfi(1, j, l, iq)
371            ENDDO            ENDDO
372         ENDDO         ENDDO
373      ENDDO      ENDDO
# Line 384  contains Line 377  contains
377      !     initialisation des tendances      !     initialisation des tendances
378      pdqfi=0.      pdqfi=0.
379    
380      DO iq=1,nq      DO iq=1, nqmx
381         iiq=niadv(iq)         iiq=niadv(iq)
382         DO l=1,llm         DO l=1, llm
383            DO i=1,iim + 1            DO i=1, iim + 1
384               pdqfi(i,1,l,iiq)    = zdqfi(1,l,iq)               pdqfi(i, 1, l, iiq)    = zdqfi(1, l, iq)
385               pdqfi(i,jjm + 1,l,iiq) = zdqfi(klon,l,iq)               pdqfi(i, jjm + 1, l, iiq) = zdqfi(klon, l, iq)
386            ENDDO            ENDDO
387            DO j=2,jjm            DO j=2, jjm
388               ig0=1+(j-2)*iim               ig0=1+(j-2)*iim
389               DO i=1,iim               DO i=1, iim
390                  pdqfi(i,j,l,iiq) = zdqfi(ig0+i,l,iq)                  pdqfi(i, j, l, iiq) = zdqfi(ig0+i, l, iq)
391               ENDDO               ENDDO
392               pdqfi(iim + 1,j,l,iiq) = pdqfi(1,j,l,iq)               pdqfi(iim + 1, j, l, iiq) = pdqfi(1, j, l, iq)
393            ENDDO            ENDDO
394         ENDDO         ENDDO
395      ENDDO      ENDDO
396    
397      !   65. champ u:      !   65. champ u:
398    
399      DO l=1,llm      DO l=1, llm
400    
401         DO i=1,iim + 1         DO i=1, iim + 1
402            pdufi(i,1,l)    = 0.            pdufi(i, 1, l)    = 0.
403            pdufi(i,jjm + 1,l) = 0.            pdufi(i, jjm + 1, l) = 0.
404         ENDDO         ENDDO
405    
406         DO j=2,jjm         DO j=2, jjm
407            ig0=1+(j-2)*iim            ig0=1+(j-2)*iim
408            DO i=1,iim-1            DO i=1, iim-1
409               pdufi(i,j,l)= &               pdufi(i, j, l)= &
410                    0.5*(zdufi(ig0+i,l)+zdufi(ig0+i+1,l))*cu_2d(i,j)                    0.5*(zdufi(ig0+i, l)+zdufi(ig0+i+1, l))*cu_2d(i, j)
411            ENDDO            ENDDO
412            pdufi(iim,j,l)= &            pdufi(iim, j, l)= &
413                 0.5*(zdufi(ig0+1,l)+zdufi(ig0+iim,l))*cu_2d(iim,j)                 0.5*(zdufi(ig0+1, l)+zdufi(ig0+iim, l))*cu_2d(iim, j)
414            pdufi(iim + 1,j,l)=pdufi(1,j,l)            pdufi(iim + 1, j, l)=pdufi(1, j, l)
415         ENDDO         ENDDO
416    
417      ENDDO      ENDDO
418    
419      !   67. champ v:      !   67. champ v:
420    
421      DO l=1,llm      DO l=1, llm
422    
423         DO j=2,jjm-1         DO j=2, jjm-1
424            ig0=1+(j-2)*iim            ig0=1+(j-2)*iim
425            DO i=1,iim            DO i=1, iim
426               pdvfi(i,j,l)= &               pdvfi(i, j, l)= &
427                    0.5*(zdvfi(ig0+i,l)+zdvfi(ig0+i+iim,l))*cv_2d(i,j)                    0.5*(zdvfi(ig0+i, l)+zdvfi(ig0+i+iim, l))*cv_2d(i, j)
428            ENDDO            ENDDO
429            pdvfi(iim + 1,j,l) = pdvfi(1,j,l)            pdvfi(iim + 1, j, l) = pdvfi(1, j, l)
430         ENDDO         ENDDO
431      ENDDO      ENDDO
432    
433      !   68. champ v pres des poles:      !   68. champ v pres des poles:
434      !      v = U * cos(long) + V * SIN(long)      !      v = U * cos(long) + V * SIN(long)
435    
436      DO l=1,llm      DO l=1, llm
437    
438         DO i=1,iim         DO i=1, iim
439            pdvfi(i,1,l)= &            pdvfi(i, 1, l)= &
440                 zdufi(1,l)*COS(rlonv(i))+zdvfi(1,l)*SIN(rlonv(i))                 zdufi(1, l)*COS(rlonv(i))+zdvfi(1, l)*SIN(rlonv(i))
441            pdvfi(i,jjm,l)=zdufi(klon,l)*COS(rlonv(i)) &            pdvfi(i, jjm, l)=zdufi(klon, l)*COS(rlonv(i)) &
442                 +zdvfi(klon,l)*SIN(rlonv(i))                 +zdvfi(klon, l)*SIN(rlonv(i))
443            pdvfi(i,1,l)= &            pdvfi(i, 1, l)= &
444                 0.5*(pdvfi(i,1,l)+zdvfi(i+1,l))*cv_2d(i,1)                 0.5*(pdvfi(i, 1, l)+zdvfi(i+1, l))*cv_2d(i, 1)
445            pdvfi(i,jjm,l)= &            pdvfi(i, jjm, l)= &
446                 0.5*(pdvfi(i,jjm,l)+zdvfi(klon-iim-1+i,l))*cv_2d(i,jjm)                 0.5*(pdvfi(i, jjm, l)+zdvfi(klon-iim-1+i, l))*cv_2d(i, jjm)
447         ENDDO         ENDDO
448    
449         pdvfi(iim + 1,1,l)  = pdvfi(1,1,l)         pdvfi(iim + 1, 1, l)  = pdvfi(1, 1, l)
450         pdvfi(iim + 1,jjm,l)= pdvfi(1,jjm,l)         pdvfi(iim + 1, jjm, l)= pdvfi(1, jjm, l)
451    
452      ENDDO      ENDDO
453    
Legend:
Removed from v.10  
changed lines
  Added in v.34
  ViewVC Help
Powered by ViewVC 1.1.21