/[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 18 by guez, Thu Aug 7 12:29:13 2008 UTC revision 35 by guez, Tue Jun 8 15:37:21 2010 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(nq, lafin, rdayvrai, heure, pucov, pvcov, pteta, pq, &    SUBROUTINE calfis(lafin, rdayvrai, heure, pucov, pvcov, pteta, q, &
8         pmasse, pps, ppk, pphis, pphi, pducov, pdvcov, pdteta, pdq, pw, &         pmasse, pps, ppk, pphis, pphi, pducov, pdvcov, pdteta, pdq, pw, &
9         pdufi, pdvfi, pdhfi, pdqfi, pdpsfi)         pdufi, pdvfi, pdhfi, pdqfi, pdpsfi)
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
     ! Auteurs : P. Le Van, F. Hourdin  
13    
14      !   1. rearrangement des tableaux et transformation      !   1. rearrangement des tableaux et transformation
15      !      variables dynamiques  >  variables physiques      !      variables dynamiques  >  variables physiques
# Line 52  contains Line 49  contains
49      !        pdtrad         radiative tendencies  \  both input      !        pdtrad         radiative tendencies  \  both input
50      !        pfluxrad       radiative fluxes      /  and output      !        pfluxrad       radiative fluxes      /  and output
51    
     use dimens_m, only: iim, jjm, llm, nqmx  
     use dimphy, only: klon  
52      use comconst, only: kappa, cpp, dtphys, g, pi      use comconst, only: kappa, cpp, dtphys, g, pi
53      use comvert, only: preff, presnivs      use comvert, only: preff
54      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
55      use iniadvtrac_m, only: niadv      use dimens_m, only: iim, jjm, llm, nqmx
56        use dimphy, only: klon
57      use grid_change, only: dyn_phy, gr_fi_dyn      use grid_change, only: dyn_phy, gr_fi_dyn
58        use iniadvtrac_m, only: niadv
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    
     !    0.  Declarations :  
   
     INTEGER, intent(in):: nq  
   
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
66    
67      REAL pvcov(iim + 1,jjm,llm)      REAL pvcov(iim + 1, jjm, llm)
68      REAL pucov(iim + 1,jjm + 1,llm)      REAL pucov(iim + 1, jjm + 1, llm)
69      REAL pteta(iim + 1,jjm + 1,llm)      REAL pteta(iim + 1, jjm + 1, llm)
70      REAL pmasse(iim + 1,jjm + 1,llm)      REAL pmasse(iim + 1, jjm + 1, llm)
71    
72      REAL, intent(in):: pq(iim + 1,jjm + 1,llm,nqmx)      REAL, intent(in):: q(iim + 1, jjm + 1, llm, nqmx)
73      ! (mass fractions of advected fields)      ! (mass fractions of advected fields)
74    
75      REAL pphis(iim + 1,jjm + 1)      REAL pphis(iim + 1, jjm + 1)
76      REAL pphi(iim + 1,jjm + 1,llm)      REAL pphi(iim + 1, jjm + 1, llm)
   
     REAL pdvcov(iim + 1,jjm,llm)  
     REAL pducov(iim + 1,jjm + 1,llm)  
     REAL pdteta(iim + 1,jjm + 1,llm)  
     REAL pdq(iim + 1,jjm + 1,llm,nqmx)  
   
     REAL pw(iim + 1,jjm + 1,llm)  
   
     REAL pps(iim + 1,jjm + 1)  
     REAL, intent(in):: ppk(iim + 1,jjm + 1,llm)  
   
     REAL pdvfi(iim + 1,jjm,llm)  
     REAL pdufi(iim + 1,jjm + 1,llm)  
     REAL pdhfi(iim + 1,jjm + 1,llm)  
     REAL pdqfi(iim + 1,jjm + 1,llm,nqmx)  
     REAL pdpsfi(iim + 1,jjm + 1)  
77    
78      INTEGER, PARAMETER:: longcles = 20      REAL pdvcov(iim + 1, jjm, llm)
79        REAL pducov(iim + 1, jjm + 1, llm)
80        REAL pdteta(iim + 1, jjm + 1, llm)
81        REAL pdq(iim + 1, jjm + 1, llm, nqmx)
82    
83        REAL pw(iim + 1, jjm + 1, llm)
84    
85        REAL pps(iim + 1, jjm + 1)
86        REAL, intent(in):: ppk(iim + 1, jjm + 1, llm)
87    
88        REAL pdvfi(iim + 1, jjm, llm)
89        REAL pdufi(iim + 1, jjm + 1, llm)
90        REAL pdhfi(iim + 1, jjm + 1, llm)
91        REAL pdqfi(iim + 1, jjm + 1, llm, nqmx)
92        REAL pdpsfi(iim + 1, jjm + 1)
93    
94      !    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 ztfi(klon,llm) ! temperature      real zvfi(iim + 1, jjm + 1, llm)
103      real zqfi(klon,llm,nqmx) ! mass fractions of advected fields      REAL ztfi(klon, llm) ! temperature
104        real qx(klon, llm, nqmx) ! mass fractions of advected fields
105        REAL pvervel(klon, llm)
106    
107      REAL pcvgu(klon,llm), pcvgv(klon,llm)      REAL zdufi(klon, llm), zdvfi(klon, llm)
108      REAL pcvgt(klon,llm), pcvgq(klon,llm,2)      REAL zdtfi(klon, llm), zdqfi(klon, llm, nqmx)
   
     REAL pvervel(klon,llm)  
   
     REAL zdufi(klon,llm),zdvfi(klon,llm)  
     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)
112      REAL zsinbis(iim),zcosbis(iim),z1bis(iim)      REAL pksurcp(iim + 1, jjm + 1)
     REAL pksurcp(iim + 1,jjm + 1)  
113    
114      ! I. Musat: diagnostic PVteta, Amip2      ! I. Musat: diagnostic PVteta, Amip2
115      INTEGER, PARAMETER:: ntetaSTD=3      INTEGER, PARAMETER:: ntetaSTD=3
116      REAL:: rtetaSTD(ntetaSTD) = (/350., 380., 405./)      REAL:: rtetaSTD(ntetaSTD) = (/350., 380., 405./)
117      REAL PVteta(klon,ntetaSTD)      REAL PVteta(klon, ntetaSTD)
   
     REAL SSUM  
118    
     LOGICAL:: firstcal = .true.  
119      REAL, intent(in):: rdayvrai      REAL, intent(in):: rdayvrai
120    
121      !-----------------------------------------------------------------------      !-----------------------------------------------------------------------
# Line 144  contains Line 128  contains
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
137      ENDDO      ENDDO
138    
139      zpsrf(klon) = pps(1,jjm + 1)      zpsrf(klon) = pps(1, jjm + 1)
140    
141      !   42. pression intercouches :      !   42. pression intercouches :
142    
# Line 164  contains Line 148  contains
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,nq  
160         iiq=niadv(iq)         iiq=niadv(iq)
161         DO l=1,llm         DO l=1, llm
162            zqfi(1,l,iq) = pq(1,1,l,iiq)            qx(1, l, iq) = q(1, 1, l, iiq)
           ig0          = 2  
           DO j=2,jjm  
              DO i = 1, iim  
                 zqfi(ig0,l,iq)  = pq(i,j,l,iiq)  
                 ig0             = ig0 + 1  
              ENDDO  
           ENDDO  
           zqfi(ig0,l,iq) = pq(1,jjm + 1,l,iiq)  
        ENDDO  
     ENDDO  
   
     !   convergence dynamique pour les traceurs "EAU"  
   
     DO iq=1,2  
        DO l=1,llm  
           pcvgq(1,l,iq)= pdq(1,1,l,iq) / pmasse(1,1,l)  
163            ig0          = 2            ig0          = 2
164            DO j=2,jjm            DO j=2, jjm
165               DO i = 1, iim               DO i = 1, iim
166                  pcvgq(ig0,l,iq) = pdq(i,j,l,iq) / pmasse(i,j,l)                  qx(ig0, l, iq)  = q(i, j, l, iiq)
167                  ig0             = ig0 + 1                  ig0             = ig0 + 1
168               ENDDO               ENDDO
169            ENDDO            ENDDO
170            pcvgq(ig0,l,iq)= pdq(1,jjm + 1,l,iq) / pmasse(1,jjm + 1,l)            qx(ig0, l, iq) = q(1, jjm + 1, l, iiq)
171         ENDDO         ENDDO
172      ENDDO      ENDDO
173    
174      !   Geopotentiel calcule par rapport a la surface locale:      !   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
178         DO ig=1,klon         DO ig=1, klon
179            zphi(ig,l)=zphi(ig,l)-zphis(ig)            zphi(ig, l)=zphi(ig, l)-zphis(ig)
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
185      DO l=1,llm         pvervel(1, l)=pw(1, 1, l) * g /apoln
        pvervel(1,l)=pw(1,1,l) * g /apoln  
186         ig0=2         ig0=2
187         DO j=2,jjm         DO j=2, jjm
188            DO i = 1, iim            DO i = 1, iim
189               pvervel(ig0,l) = pw(i,j,l) * g * unsaire_2d(i,j)               pvervel(ig0, l) = pw(i, j, l) * g * unsaire_2d(i, j)
190               ig0 = ig0 + 1               ig0 = ig0 + 1
191            ENDDO            ENDDO
192         ENDDO         ENDDO
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:
197    
198      DO  l=1,llm      DO  l=1, llm
199           DO  j=2, jjm
        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))
203            pcvgu(ig0+1,l)= 0.5 *  &            DO i=2, iim
204                 (pducov(iim,j,l)/cu_2d(iim,j) + pducov(1,j,l)/cu_2d(1,j))               zufi(ig0+i, l)= 0.5 * &
205            DO i=2,iim                    (pucov(i-1, j, l)/cu_2d(i-1, j) &
206               zufi(ig0+i,l)= 0.5 * &                    + pucov(i, j, l)/cu_2d(i, j))
                   (pucov(i-1,j,l)/cu_2d(i-1,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:
212    
213      DO l=1,llm      forall (j = 2: jjm, l = 1: llm) zvfi(:iim, j, l)= 0.5 &
214         DO j=2,jjm           * (pvcov(:iim, j-1, l) / cv_2d(:iim, j-1) &
215            ig0=1+(j-2)*iim           + pvcov(:iim, j, l) / cv_2d(:iim, j))
216            DO i=1,iim      zvfi(iim + 1, 2:jjm, :) = zvfi(1, 2:jjm, :)
              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  
217    
218      !   47. champs de vents aux pole nord        !   47. champs de vents au pôle nord  
219      !        U = 1 / pi  *  integrale [ v * cos(long) * d long ]      !        U = 1 / pi  *  integrale [ v * cos(long) * d long ]
220      !        V = 1 / pi  *  integrale [ v * sin(long) * d long ]      !        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)
224         z1(1)   =(rlonu(1)-rlonu(iim)+2.*pi)*pvcov(1,1,l)/cv_2d(1,1)         DO i=2, iim
225         z1bis(1)=(rlonu(1)-rlonu(iim)+2.*pi)*pdvcov(1,1,l)/cv_2d(1,1)            z1(i)   =(rlonu(i)-rlonu(i-1))*pvcov(i, 1, l)/cv_2d(i, 1)
        DO i=2,iim  
           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)  
226         ENDDO         ENDDO
227    
228         DO i=1,iim         zufi(1, l)  = SUM(COS(rlonv(:iim)) * z1) / pi
229            zcos(i)   = COS(rlonv(i))*z1(i)         zvfi(:, 1, l)  = SUM(SIN(rlonv(:iim)) * z1) / pi
           zcosbis(i)= COS(rlonv(i))*z1bis(i)  
           zsin(i)   = SIN(rlonv(i))*z1(i)  
           zsinbis(i)= SIN(rlonv(i))*z1bis(i)  
        ENDDO  
   
        zufi(1,l)  = SSUM(iim,zcos,1)/pi  
        pcvgu(1,l) = SSUM(iim,zcosbis,1)/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 aux pole 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) &
238         z1(1)   =(rlonu(1)-rlonu(iim)+2.*pi)*pvcov(1,jjm,l) &              /cv_2d(1, jjm)
239              /cv_2d(1,jjm)         DO i=2, iim
240         z1bis(1)=(rlonu(1)-rlonu(iim)+2.*pi)*pdvcov(1,jjm,l) &            z1(i)   =(rlonu(i)-rlonu(i-1))*pvcov(i, jjm, l)/cv_2d(i, jjm)
241              /cv_2d(1,jjm)         ENDDO
        DO i=2,iim  
           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)  
        ENDDO  
   
        zufi(klon,l)  = SSUM(iim,zcos,1)/pi  
        pcvgu(klon,l) = SSUM(iim,zcosbis,1)/pi  
        zvfi(klon,l)  = SSUM(iim,zsin,1)/pi  
        pcvgv(klon,l) = SSUM(iim,zsinbis,1)/pi  
242    
243           zufi(klon, l)  = SUM(COS(rlonv(:iim)) * z1) / pi
244           zvfi(:, jjm + 1, l)  = SUM(SIN(rlonv(:iim)) * z1) / 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, &
251           ztfi,zplay,zplev, &           ntetaSTD, rtetaSTD, PVteta)
252           ntetaSTD,rtetaSTD,PVteta)  
253        ! Appel de la physique :
254      !   Appel de la physique:      CALL physiq(lafin, rdayvrai, heure, dtphys, zplev, zplay, zphi, &
255             zphis, zufi, v, ztfi, qx, pvervel, zdufi, zdvfi, &
256      CALL physiq(nq, firstcal, lafin, rdayvrai, heure, dtphys, &           zdtfi, zdqfi, zdpsrf, pducov, PVteta) ! diagnostic PVteta, Amip2
          zplev, zplay, zphi, zphis, presnivs, zufi, zvfi, &  
          ztfi, zqfi, pvervel, zdufi, zdvfi, zdtfi, zdqfi, zdpsrf, pducov, &  
          PVteta) ! IM diagnostique PVteta, Amip2  
257    
258      !   transformation des tendances physiques en tendances dynamiques:      !   transformation des tendances physiques en tendances dynamiques:
259    
# Line 343  contains Line 263  contains
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
274            ig0=1+(j-2)*iim            ig0=1+(j-2)*iim
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
292               ig0=1+(j-2)*iim               ig0=1+(j-2)*iim
293               DO i=1,iim               DO i=1, iim
294                  pdqfi(i,j,l,iq) = zdqfi(ig0+i,l,iq)                  pdqfi(i, j, l, iq) = zdqfi(ig0+i, l, iq)
295               ENDDO               ENDDO
296               pdqfi(iim + 1,j,l,iq) = pdqfi(1,j,l,iq)               pdqfi(iim + 1, j, l, iq) = pdqfi(1, j, l, iq)
297            ENDDO            ENDDO
298         ENDDO         ENDDO
299      ENDDO      ENDDO
# Line 383  contains Line 303  contains
303      !     initialisation des tendances      !     initialisation des tendances
304      pdqfi=0.      pdqfi=0.
305    
306      DO iq=1,nq      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
314               ig0=1+(j-2)*iim               ig0=1+(j-2)*iim
315               DO i=1,iim               DO i=1, iim
316                  pdqfi(i,j,l,iiq) = zdqfi(ig0+i,l,iq)                  pdqfi(i, j, l, iiq) = zdqfi(ig0+i, l, iq)
317               ENDDO               ENDDO
318               pdqfi(iim + 1,j,l,iiq) = pdqfi(1,j,l,iq)               pdqfi(iim + 1, j, l, iiq) = pdqfi(1, j, l, iq)
319            ENDDO            ENDDO
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    
332         DO j=2,jjm         DO j=2, jjm
333            ig0=1+(j-2)*iim            ig0=1+(j-2)*iim
334            DO i=1,iim-1            DO i=1, iim-1
335               pdufi(i,j,l)= &               pdufi(i, j, l)= &
336                    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)
337            ENDDO            ENDDO
338            pdufi(iim,j,l)= &            pdufi(iim, j, l)= &
339                 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)
340            pdufi(iim + 1,j,l)=pdufi(1,j,l)            pdufi(iim + 1, j, l)=pdufi(1, j, l)
341         ENDDO         ENDDO
342    
343      ENDDO      ENDDO
344    
345      !   67. champ v:      !   67. champ v:
346    
347      DO l=1,llm      DO l=1, llm
348    
349         DO j=2,jjm-1         DO j=2, jjm-1
350            ig0=1+(j-2)*iim            ig0=1+(j-2)*iim
351            DO i=1,iim            DO i=1, iim
352               pdvfi(i,j,l)= &               pdvfi(i, j, l)= &
353                    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)
354            ENDDO            ENDDO
355            pdvfi(iim + 1,j,l) = pdvfi(1,j,l)            pdvfi(iim + 1, j, l) = pdvfi(1, j, l)
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
364         DO i=1,iim            pdvfi(i, 1, l)= &
365            pdvfi(i,1,l)= &                 zdufi(1, l)*COS(rlonv(i))+zdvfi(1, l)*SIN(rlonv(i))
366                 zdufi(1,l)*COS(rlonv(i))+zdvfi(1,l)*SIN(rlonv(i))            pdvfi(i, jjm, l)=zdufi(klon, l)*COS(rlonv(i)) &
367            pdvfi(i,jjm,l)=zdufi(klon,l)*COS(rlonv(i)) &                 +zdvfi(klon, l)*SIN(rlonv(i))
368                 +zdvfi(klon,l)*SIN(rlonv(i))            pdvfi(i, 1, l)= &
369            pdvfi(i,1,l)= &                 0.5*(pdvfi(i, 1, l)+zdvfi(i+1, l))*cv_2d(i, 1)
370                 0.5*(pdvfi(i,1,l)+zdvfi(i+1,l))*cv_2d(i,1)            pdvfi(i, jjm, l)= &
371            pdvfi(i,jjm,l)= &                 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.18  
changed lines
  Added in v.35
  ViewVC Help
Powered by ViewVC 1.1.21