/[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 34 by guez, Wed Jun 2 11:01:12 2010 UTC revision 40 by guez, Tue Feb 22 13:49:36 2011 UTC
# Line 1  Line 1 
1  module calfis_m  module calfis_m
2    
   ! Clean: no C preprocessor directive, no include line  
   
3    IMPLICIT NONE    IMPLICIT NONE
4    
5  contains  contains
6    
7    SUBROUTINE calfis(lafin, rdayvrai, heure, pucov, pvcov, pteta, q, &    SUBROUTINE calfis(rdayvrai, heure, pucov, pvcov, pteta, q, pmasse, pps, &
8         pmasse, pps, ppk, pphis, pphi, pducov, pdvcov, pdteta, pdq, pw, &         ppk, pphis, pphi, pducov, pdvcov, pdteta, pdq, pw, pdufi, pdvfi, &
9         pdufi, pdvfi, pdhfi, pdqfi, pdpsfi)         pdhfi, pdqfi, pdpsfi, lafin)
10    
11      ! From dyn3d/calfis.F, v 1.3 2005/05/25 13:10:09      ! From dyn3d/calfis.F, version 1.3 2005/05/25 13:10:09
12        ! Authors: P. Le Van, F. Hourdin
13      ! Auteurs : P. Le Van, F. Hourdin  
14        ! 1. Réarrangement des tableaux et transformation variables
15      !   1. rearrangement des tableaux et transformation      ! dynamiques en variables physiques
16      !      variables dynamiques  >  variables physiques      ! 2. Calcul des termes physiques
17      !   2. calcul des termes physiques      ! 3. Retransformation des tendances physiques en tendances dynamiques
18      !   3. retransformation des tendances physiques en tendances dynamiques  
19        ! Remarques:
20      !   remarques:  
21      !   ----------      ! - Les vents sont donnés dans la physique par leurs composantes
22        ! naturelles.
23      !    - les vents sont donnes dans la physique par leurs composantes  
24      !      naturelles.      ! - La variable thermodynamique de la physique est une variable
25      !    - la variable thermodynamique de la physique est une variable      ! intensive : T.
26      !      intensive :   T      ! Pour la dynamique on prend T * (preff / p(l)) **kappa
27      !      pour la dynamique on prend    T * (preff / p(l)) **kappa  
28      !    - les deux seules variables dependant de la geometrie necessaires      ! - Les deux seules variables dépendant de la géométrie
29      !      pour la physique sont la latitude pour le rayonnement et      ! nécessaires pour la physique sont la latitude pour le
30      !      l'aire de la maille quand on veut integrer une grandeur      ! rayonnement et l'aire de la maille quand on veut intégrer une
31      !      horizontalement.      ! grandeur horizontalement.
32    
33      !     Input :      ! Input :
34      !     -------      ! pucov covariant zonal velocity
35      !       pucov           covariant zonal velocity      ! pvcov covariant meridional velocity
36      !       pvcov           covariant meridional velocity      ! pteta potential temperature
37      !       pteta           potential temperature      ! pps surface pressure
38      !       pps             surface pressure      ! pmasse masse d'air dans chaque maille
39      !       pmasse          masse d'air dans chaque maille      ! pts surface temperature (K)
40      !       pts             surface temperature  (K)      ! callrad clef d'appel au rayonnement
41      !       callrad         clef d'appel au rayonnement  
42        ! Output :
43      !    Output :      ! pdufi tendency for the natural zonal velocity (ms-1)
44      !    --------      ! pdvfi tendency for the natural meridional velocity
45      !        pdufi          tendency for the natural zonal velocity (ms-1)      ! pdhfi tendency for the potential temperature
46      !        pdvfi          tendency for the natural meridional velocity      ! pdtsfi tendency for the surface temperature
     !        pdhfi          tendency for the potential temperature  
     !        pdtsfi         tendency for the surface temperature  
47    
48      !        pdtrad         radiative tendencies  \  both input      ! pdtrad radiative tendencies \ input and output
49      !        pfluxrad       radiative fluxes      /  and output      ! pfluxrad radiative fluxes / input and output
50    
51      use dimens_m, only: iim, jjm, llm, nqmx      use comconst, only: kappa, cpp, dtphys, g
     use dimphy, only: klon  
     use comconst, only: kappa, cpp, dtphys, g, pi  
52      use comvert, only: preff      use comvert, only: preff
53      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
54      use iniadvtrac_m, only: niadv      use dimens_m, only: iim, jjm, llm, nqmx
55        use dimphy, only: klon
56      use grid_change, only: dyn_phy, gr_fi_dyn      use grid_change, only: dyn_phy, gr_fi_dyn
57        use iniadvtrac_m, only: niadv
58        use nr_util, only: pi
59      use physiq_m, only: physiq      use physiq_m, only: physiq
60      use pressure_var, only: p3d, pls      use pressure_var, only: p3d, pls
61    
62      !    Arguments :      ! Arguments :
63    
64      LOGICAL, intent(in):: lafin      LOGICAL, intent(in):: lafin
65      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
# Line 94  contains Line 91  contains
91      REAL pdqfi(iim + 1, jjm + 1, llm, nqmx)      REAL pdqfi(iim + 1, jjm + 1, llm, nqmx)
92      REAL pdpsfi(iim + 1, jjm + 1)      REAL pdpsfi(iim + 1, jjm + 1)
93    
94      INTEGER, PARAMETER:: longcles = 20      ! Local variables :
   
     !    Local variables :  
95    
96      INTEGER i, j, l, ig0, ig, iq, iiq      INTEGER i, j, l, ig0, ig, iq, iiq
97      REAL zpsrf(klon)      REAL zpsrf(klon)
98      REAL zplev(klon, llm+1), zplay(klon, llm)      REAL zplev(klon, llm+1), zplay(klon, llm)
99      REAL zphi(klon, llm), zphis(klon)      REAL zphi(klon, llm), zphis(klon)
100    
101      REAL zufi(klon, llm), zvfi(klon, llm)      REAL zufi(klon, llm), v(klon, llm)
102        real zvfi(iim + 1, jjm + 1, llm)
103      REAL ztfi(klon, llm) ! temperature      REAL ztfi(klon, llm) ! temperature
104      real qx(klon, llm, nqmx) ! mass fractions of advected fields      real qx(klon, llm, nqmx) ! mass fractions of advected fields
   
     REAL pcvgu(klon, llm), pcvgv(klon, llm)  
     REAL pcvgt(klon, llm), pcvgq(klon, llm, 2)  
   
105      REAL pvervel(klon, llm)      REAL pvervel(klon, llm)
106    
107      REAL zdufi(klon, llm), zdvfi(klon, llm)      REAL zdufi(klon, llm), zdvfi(klon, llm)
108      REAL zdtfi(klon, llm), zdqfi(klon, llm, nqmx)      REAL zdtfi(klon, llm), zdqfi(klon, llm, nqmx)
109      REAL zdpsrf(klon)      REAL zdpsrf(klon)
110    
111      REAL zsin(iim), zcos(iim), z1(iim)      REAL z1(iim)
     REAL zsinbis(iim), zcosbis(iim), z1bis(iim)  
112      REAL pksurcp(iim + 1, jjm + 1)      REAL pksurcp(iim + 1, jjm + 1)
113    
114      ! I. Musat: diagnostic PVteta, Amip2      ! I. Musat: diagnostic PVteta, Amip2
# Line 125  contains Line 116  contains
116      REAL:: rtetaSTD(ntetaSTD) = (/350., 380., 405./)      REAL:: rtetaSTD(ntetaSTD) = (/350., 380., 405./)
117      REAL PVteta(klon, ntetaSTD)      REAL PVteta(klon, ntetaSTD)
118    
     REAL SSUM  
   
     LOGICAL:: firstcal = .true.  
119      REAL, intent(in):: rdayvrai      REAL, intent(in):: rdayvrai
120    
121      !-----------------------------------------------------------------------      !-----------------------------------------------------------------------
122    
123      !!print *, "Call sequence information: calfis"      !!print *, "Call sequence information: calfis"
124    
125      !    1. Initialisations :      ! 1. Initialisations :
126      !   latitude, longitude et aires des mailles pour la physique:      ! latitude, longitude et aires des mailles pour la physique:
127    
128      !   40. transformation des variables dynamiques en variables physiques:      ! 40. transformation des variables dynamiques en variables physiques:
129      !   41. pressions au sol (en Pascals)      ! 41. pressions au sol (en Pascals)
130    
131      zpsrf(1) = pps(1, 1)      zpsrf(1) = pps(1, 1)
132    
133      ig0  = 2      ig0 = 2
134      DO j = 2, jjm      DO j = 2, jjm
135         CALL SCOPY(iim, pps(1, j), 1, zpsrf(ig0), 1)         CALL SCOPY(iim, pps(1, j), 1, zpsrf(ig0), 1)
136         ig0 = ig0+iim         ig0 = ig0+iim
# Line 150  contains Line 138  contains
138    
139      zpsrf(klon) = pps(1, jjm + 1)      zpsrf(klon) = pps(1, jjm + 1)
140    
141      !   42. pression intercouches :      ! 42. pression intercouches :
142    
143      !     .... zplev  definis aux (llm +1) interfaces des couches  ....      ! zplev defini aux (llm +1) interfaces des couches
144      !     .... zplay  definis aux (llm)    milieux des couches  ....      ! zplay defini aux (llm) milieux des couches  
145    
146      !    ...    Exner = cp * (p(l) / preff) ** kappa     ....      ! Exner = cp * (p(l) / preff) ** kappa
147    
148      forall (l = 1: llm+1) zplev(:, l) = pack(p3d(:, :, l), dyn_phy)      forall (l = 1: llm+1) zplev(:, l) = pack(p3d(:, :, l), dyn_phy)
149    
150      !   43. temperature naturelle (en K) et pressions milieux couches .      ! 43. temperature naturelle (en K) et pressions milieux couches
151      DO l=1, llm      DO l=1, llm
152         pksurcp     =  ppk(:, :, l) / cpp         pksurcp = ppk(:, :, l) / cpp
153         pls(:, :, l) = preff * pksurcp**(1./ kappa)         pls(:, :, l) = preff * pksurcp**(1./ kappa)
154         zplay(:, l) = pack(pls(:, :, l), dyn_phy)         zplay(:, l) = pack(pls(:, :, l), dyn_phy)
155         ztfi(:, l) = pack(pteta(:, :, l) * pksurcp, dyn_phy)         ztfi(:, l) = pack(pteta(:, :, l) * pksurcp, dyn_phy)
        pcvgt(:, l) = pack(pdteta(:, :, l) * pksurcp / pmasse(:, :, l), dyn_phy)  
156      ENDDO      ENDDO
157    
158      !   43.bis traceurs      ! 43.bis traceurs
   
159      DO iq=1, nqmx      DO iq=1, nqmx
160         iiq=niadv(iq)         iiq=niadv(iq)
161         DO l=1, llm         DO l=1, llm
162            qx(1, l, iq) = q(1, 1, l, iiq)            qx(1, l, iq) = q(1, 1, l, iiq)
163            ig0          = 2            ig0 = 2
164            DO j=2, jjm            DO j=2, jjm
165               DO i = 1, iim               DO i = 1, iim
166                  qx(ig0, l, iq)  = q(i, j, l, iiq)                  qx(ig0, l, iq) = q(i, j, l, iiq)
167                  ig0             = ig0 + 1                  ig0 = ig0 + 1
168               ENDDO               ENDDO
169            ENDDO            ENDDO
170            qx(ig0, l, iq) = q(1, jjm + 1, l, iiq)            qx(ig0, l, iq) = q(1, jjm + 1, l, iiq)
171         ENDDO         ENDDO
172      ENDDO      ENDDO
173    
174      !   convergence dynamique pour les traceurs "EAU"      ! Geopotentiel calcule par rapport a la surface locale:
   
     DO iq=1, 2  
        DO l=1, llm  
           pcvgq(1, l, iq)= pdq(1, 1, l, iq) / pmasse(1, 1, l)  
           ig0          = 2  
           DO j=2, jjm  
              DO i = 1, iim  
                 pcvgq(ig0, l, iq) = pdq(i, j, l, iq) / pmasse(i, j, l)  
                 ig0             = ig0 + 1  
              ENDDO  
           ENDDO  
           pcvgq(ig0, l, iq)= pdq(1, jjm + 1, l, iq) / pmasse(1, jjm + 1, l)  
        ENDDO  
     ENDDO  
   
     !   Geopotentiel calcule par rapport a la surface locale:  
   
175      forall (l = 1:llm) zphi(:, l) = pack(pphi(:, :, l), dyn_phy)      forall (l = 1:llm) zphi(:, l) = pack(pphi(:, :, l), dyn_phy)
176      zphis = pack(pphis, dyn_phy)      zphis = pack(pphis, dyn_phy)
177      DO l=1, llm      DO l=1, llm
# Line 211  contains Line 180  contains
180         ENDDO         ENDDO
181      ENDDO      ENDDO
182    
183      !   ....  Calcul de la vitesse  verticale  (en Pa*m*s  ou Kg/s)  ....      ! Calcul de la vitesse verticale (en Pa*m*s ou Kg/s)
   
184      DO l=1, llm      DO l=1, llm
185         pvervel(1, l)=pw(1, 1, l) * g /apoln         pvervel(1, l)=pw(1, 1, l) * g /apoln
186         ig0=2         ig0=2
# Line 225  contains Line 193  contains
193         pvervel(ig0, l)=pw(1, jjm + 1, l) * g /apols         pvervel(ig0, l)=pw(1, jjm + 1, l) * g /apols
194      ENDDO      ENDDO
195    
196      !   45. champ u:      ! 45. champ u:
   
     DO  l=1, llm  
197    
198         DO  j=2, jjm      DO l=1, llm
199           DO j=2, jjm
200            ig0 = 1+(j-2)*iim            ig0 = 1+(j-2)*iim
201            zufi(ig0+1, l)= 0.5 *  &            zufi(ig0+1, l)= 0.5 * &
202                 (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))
           pcvgu(ig0+1, l)= 0.5 *  &  
                (pducov(iim, j, l)/cu_2d(iim, j) + pducov(1, j, l)/cu_2d(1, j))  
203            DO i=2, iim            DO i=2, iim
204               zufi(ig0+i, l)= 0.5 * &               zufi(ig0+i, l)= 0.5 * &
205                    (pucov(i-1, j, l)/cu_2d(i-1, j) &                    (pucov(i-1, j, l)/cu_2d(i-1, j) &
206                    + pucov(i, j, l)/cu_2d(i, j))                    + pucov(i, j, l)/cu_2d(i, j))
              pcvgu(ig0+i, l)= 0.5 * &  
                   (pducov(i-1, j, l)/cu_2d(i-1, j) &  
                   + pducov(i, j, l)/cu_2d(i, j))  
207            end DO            end DO
208         end DO         end DO
   
209      end DO      end DO
210    
211      !   46.champ v:      ! 46.champ v:
   
     DO l = 1, llm  
        DO j = 2, jjm  
           ig0 = 1 + (j - 2) * iim  
           DO i = 1, iim  
              zvfi(ig0+i, l)= 0.5 * (pvcov(i, j-1, l) / cv_2d(i, j-1) &  
                   + pvcov(i, j, l) / cv_2d(i, j))  
              pcvgv(ig0+i, l)= 0.5 * &  
                   (pdvcov(i, j-1, l)/cv_2d(i, j-1) &  
                   + pdvcov(i, j, l)/cv_2d(i, j))  
           ENDDO  
        ENDDO  
     ENDDO  
212    
213      !   47. champs de vents au pôle nord        forall (j = 2: jjm, l = 1: llm) zvfi(:iim, j, l)= 0.5 &
214      !        U = 1 / pi  *  integrale [ v * cos(long) * d long ]           * (pvcov(:iim, j-1, l) / cv_2d(:iim, j-1) &
215      !        V = 1 / pi  *  integrale [ v * sin(long) * d long ]           + pvcov(:iim, j, l) / cv_2d(:iim, j))
216        zvfi(iim + 1, 2:jjm, :) = zvfi(1, 2:jjm, :)
217    
218        ! 47. champs de vents au pôle nord
219        ! U = 1 / pi * integrale [ v * cos(long) * d long ]
220        ! V = 1 / pi * integrale [ v * sin(long) * d long ]
221    
222      DO l=1, llm      DO l=1, llm
223           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)  
        z1bis(1)=(rlonu(1)-rlonu(iim)+2.*pi)*pdvcov(1, 1, l)/cv_2d(1, 1)  
224         DO i=2, iim         DO i=2, iim
225            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)
           z1bis(i)=(rlonu(i)-rlonu(i-1))*pdvcov(i, 1, l)/cv_2d(i, 1)  
        ENDDO  
   
        DO i=1, iim  
           zcos(i)   = COS(rlonv(i))*z1(i)  
           zcosbis(i)= COS(rlonv(i))*z1bis(i)  
           zsin(i)   = SIN(rlonv(i))*z1(i)  
           zsinbis(i)= SIN(rlonv(i))*z1bis(i)  
226         ENDDO         ENDDO
227    
228         zufi(1, l)  = SSUM(iim, zcos, 1)/pi         zufi(1, l) = SUM(COS(rlonv(:iim)) * z1) / pi
229         pcvgu(1, l) = SSUM(iim, zcosbis, 1)/pi         zvfi(:, 1, l) = SUM(SIN(rlonv(:iim)) * z1) / pi
        zvfi(1, l)  = SSUM(iim, zsin, 1)/pi  
        pcvgv(1, l) = SSUM(iim, zsinbis, 1)/pi  
   
230      ENDDO      ENDDO
231    
232      !   48. champs de vents au pôle sud:      ! 48. champs de vents au pôle sud:
233      !        U = 1 / pi  *  integrale [ v * cos(long) * d long ]      ! U = 1 / pi * integrale [ v * cos(long) * d long ]
234      !        V = 1 / pi  *  integrale [ v * sin(long) * d long ]      ! V = 1 / pi * integrale [ v * sin(long) * d long ]
235    
236      DO l=1, llm      DO l=1, llm
237           z1(1) =(rlonu(1)-rlonu(iim)+2.*pi)*pvcov(1, jjm, l) &
        z1(1)   =(rlonu(1)-rlonu(iim)+2.*pi)*pvcov(1, jjm, l) &  
             /cv_2d(1, jjm)  
        z1bis(1)=(rlonu(1)-rlonu(iim)+2.*pi)*pdvcov(1, jjm, l) &  
238              /cv_2d(1, jjm)              /cv_2d(1, jjm)
239         DO i=2, iim         DO i=2, iim
240            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)
           z1bis(i)=(rlonu(i)-rlonu(i-1))*pdvcov(i, jjm, l)/cv_2d(i, jjm)  
        ENDDO  
   
        DO i=1, iim  
           zcos(i)    = COS(rlonv(i))*z1(i)  
           zcosbis(i) = COS(rlonv(i))*z1bis(i)  
           zsin(i)    = SIN(rlonv(i))*z1(i)  
           zsinbis(i) = SIN(rlonv(i))*z1bis(i)  
241         ENDDO         ENDDO
242    
243         zufi(klon, l)  = SSUM(iim, zcos, 1)/pi         zufi(klon, l) = SUM(COS(rlonv(:iim)) * z1) / pi
244         pcvgu(klon, l) = SSUM(iim, zcosbis, 1)/pi         zvfi(:, jjm + 1, l) = SUM(SIN(rlonv(:iim)) * z1) / pi
        zvfi(klon, l)  = SSUM(iim, zsin, 1)/pi  
        pcvgv(klon, l) = SSUM(iim, zsinbis, 1)/pi  
   
245      ENDDO      ENDDO
246    
247        forall(l= 1: llm) v(:, l) = pack(zvfi(:, :, l), dyn_phy)
248    
249      !IM calcul PV a teta=350, 380, 405K      !IM calcul PV a teta=350, 380, 405K
250      CALL PVtheta(klon, llm, pucov, pvcov, pteta, &      CALL PVtheta(klon, llm, pucov, pvcov, pteta, ztfi, zplay, zplev, &
          ztfi, zplay, zplev, &  
251           ntetaSTD, rtetaSTD, PVteta)           ntetaSTD, rtetaSTD, PVteta)
252    
253      !   Appel de la physique:      ! Appel de la physique :
254        CALL physiq(lafin, rdayvrai, heure, dtphys, zplev, zplay, zphi, &
255      CALL physiq(firstcal, lafin, rdayvrai, heure, dtphys, zplev, zplay, zphi, &           zphis, zufi, v, ztfi, qx, pvervel, zdufi, zdvfi, &
256           zphis, zufi, zvfi, ztfi, qx, pvervel, zdufi, zdvfi, zdtfi, zdqfi, &           zdtfi, zdqfi, zdpsrf, pducov, PVteta) ! diagnostic PVteta, Amip2
          zdpsrf, pducov, PVteta) ! IM diagnostique PVteta, Amip2  
257    
258      !   transformation des tendances physiques en tendances dynamiques:      ! transformation des tendances physiques en tendances dynamiques:
259    
260      !  tendance sur la pression :      ! tendance sur la pression :
261    
262      pdpsfi = gr_fi_dyn(zdpsrf)      pdpsfi = gr_fi_dyn(zdpsrf)
263    
264      !   62. enthalpie potentielle      ! 62. enthalpie potentielle
265    
266      DO l=1, llm      DO l=1, llm
267    
268         DO i=1, iim + 1         DO i=1, iim + 1
269            pdhfi(i, 1, l)    = cpp *  zdtfi(1, l)      / ppk(i, 1  , l)            pdhfi(i, 1, l) = cpp * zdtfi(1, l) / ppk(i, 1 , l)
270            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)
271         ENDDO         ENDDO
272    
273         DO j=2, jjm         DO j=2, jjm
# Line 349  contains Line 275  contains
275            DO i=1, iim            DO i=1, iim
276               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)
277            ENDDO            ENDDO
278            pdhfi(iim + 1, j, l) =  pdhfi(1, j, l)            pdhfi(iim + 1, j, l) = pdhfi(1, j, l)
279         ENDDO         ENDDO
280    
281      ENDDO      ENDDO
282    
283      !   62. humidite specifique      ! 62. humidite specifique
284    
285      DO iq=1, nqmx      DO iq=1, nqmx
286         DO l=1, llm         DO l=1, llm
287            DO i=1, iim + 1            DO i=1, iim + 1
288               pdqfi(i, 1, l, iq)    = zdqfi(1, l, iq)               pdqfi(i, 1, l, iq) = zdqfi(1, l, iq)
289               pdqfi(i, jjm + 1, l, iq) = zdqfi(klon, l, iq)               pdqfi(i, jjm + 1, l, iq) = zdqfi(klon, l, iq)
290            ENDDO            ENDDO
291            DO j=2, jjm            DO j=2, jjm
# Line 372  contains Line 298  contains
298         ENDDO         ENDDO
299      ENDDO      ENDDO
300    
301      !   63. traceurs      ! 63. traceurs
302    
303      !     initialisation des tendances      ! initialisation des tendances
304      pdqfi=0.      pdqfi=0.
305    
306      DO iq=1, nqmx      DO iq=1, nqmx
307         iiq=niadv(iq)         iiq=niadv(iq)
308         DO l=1, llm         DO l=1, llm
309            DO i=1, iim + 1            DO i=1, iim + 1
310               pdqfi(i, 1, l, iiq)    = zdqfi(1, l, iq)               pdqfi(i, 1, l, iiq) = zdqfi(1, l, iq)
311               pdqfi(i, jjm + 1, l, iiq) = zdqfi(klon, l, iq)               pdqfi(i, jjm + 1, l, iiq) = zdqfi(klon, l, iq)
312            ENDDO            ENDDO
313            DO j=2, jjm            DO j=2, jjm
# Line 394  contains Line 320  contains
320         ENDDO         ENDDO
321      ENDDO      ENDDO
322    
323      !   65. champ u:      ! 65. champ u:
324    
325      DO l=1, llm      DO l=1, llm
326    
327         DO i=1, iim + 1         DO i=1, iim + 1
328            pdufi(i, 1, l)    = 0.            pdufi(i, 1, l) = 0.
329            pdufi(i, jjm + 1, l) = 0.            pdufi(i, jjm + 1, l) = 0.
330         ENDDO         ENDDO
331    
# Line 416  contains Line 342  contains
342    
343      ENDDO      ENDDO
344    
345      !   67. champ v:      ! 67. champ v:
346    
347      DO l=1, llm      DO l=1, llm
348    
# Line 430  contains Line 356  contains
356         ENDDO         ENDDO
357      ENDDO      ENDDO
358    
359      !   68. champ v pres des poles:      ! 68. champ v pres des poles:
360      !      v = U * cos(long) + V * SIN(long)      ! v = U * cos(long) + V * SIN(long)
361    
362      DO l=1, llm      DO l=1, llm
   
363         DO i=1, iim         DO i=1, iim
364            pdvfi(i, 1, l)= &            pdvfi(i, 1, l)= &
365                 zdufi(1, l)*COS(rlonv(i))+zdvfi(1, l)*SIN(rlonv(i))                 zdufi(1, l)*COS(rlonv(i))+zdvfi(1, l)*SIN(rlonv(i))
# Line 446  contains Line 371  contains
371                 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)
372         ENDDO         ENDDO
373    
374         pdvfi(iim + 1, 1, l)  = pdvfi(1, 1, l)         pdvfi(iim + 1, 1, l) = pdvfi(1, 1, l)
375         pdvfi(iim + 1, jjm, l)= pdvfi(1, jjm, l)         pdvfi(iim + 1, jjm, l)= pdvfi(1, jjm, l)
   
376      ENDDO      ENDDO
377    
     firstcal = .FALSE.  
   
378    END SUBROUTINE calfis    END SUBROUTINE calfis
379    
380  end module calfis_m  end module calfis_m
Legend:
Removed from v.34  
changed lines
  Added in v.40
  ViewVC Help
Powered by ViewVC 1.1.21