/[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 39 by guez, Tue Jan 25 15:11:05 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(nq, lafin, rdayvrai, heure, pucov, pvcov, pteta, pq, &    SUBROUTINE calfis(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, lafin)
   
     ! From dyn3d/calfis.F,v 1.3 2005/05/25 13:10:09  
10    
11      ! Auteurs : P. Le Van, F. Hourdin      ! From dyn3d/calfis.F, version 1.3 2005/05/25 13:10:09
12        ! Authors : 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    
52        use comconst, only: kappa, cpp, dtphys, g
53        use comvert, only: preff
54        use comgeom, only: apoln, cu_2d, cv_2d, unsaire_2d, apols, rlonu, rlonv
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
     use comconst, only: kappa, cpp, dtphys, g, pi  
     use comvert, only: preff, presnivs  
     use comgeom, only: apoln, cu_2d, cv_2d, unsaire_2d, apols, rlonu, rlonv  
     use iniadvtrac_m, only: niadv  
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 nr_util, only: pi
60      use physiq_m, only: physiq      use physiq_m, only: physiq
61      use pressure_var, only: p3d, pls      use pressure_var, only: p3d, pls
62    
     !    0.  Declarations :  
   
     INTEGER, intent(in):: nq  
   
63      !    Arguments :      !    Arguments :
64    
65      LOGICAL, intent(in):: lafin      LOGICAL, intent(in):: lafin
66      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
67    
68      REAL pvcov(iim + 1,jjm,llm)      REAL pvcov(iim + 1, jjm, llm)
69      REAL pucov(iim + 1,jjm + 1,llm)      REAL pucov(iim + 1, jjm + 1, llm)
70      REAL pteta(iim + 1,jjm + 1,llm)      REAL pteta(iim + 1, jjm + 1, llm)
71      REAL pmasse(iim + 1,jjm + 1,llm)      REAL pmasse(iim + 1, jjm + 1, llm)
72    
73      REAL, intent(in):: pq(iim + 1,jjm + 1,llm,nqmx)      REAL, intent(in):: q(iim + 1, jjm + 1, llm, nqmx)
74      ! (mass fractions of advected fields)      ! (mass fractions of advected fields)
75    
76      REAL pphis(iim + 1,jjm + 1)      REAL pphis(iim + 1, jjm + 1)
77      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)  
78    
79      INTEGER, PARAMETER:: longcles = 20      REAL pdvcov(iim + 1, jjm, llm)
80        REAL pducov(iim + 1, jjm + 1, llm)
81        REAL pdteta(iim + 1, jjm + 1, llm)
82        REAL pdq(iim + 1, jjm + 1, llm, nqmx)
83    
84        REAL pw(iim + 1, jjm + 1, llm)
85    
86        REAL pps(iim + 1, jjm + 1)
87        REAL, intent(in):: ppk(iim + 1, jjm + 1, llm)
88    
89        REAL pdvfi(iim + 1, jjm, llm)
90        REAL pdufi(iim + 1, jjm + 1, llm)
91        REAL pdhfi(iim + 1, jjm + 1, llm)
92        REAL pdqfi(iim + 1, jjm + 1, llm, nqmx)
93        REAL pdpsfi(iim + 1, jjm + 1)
94    
95      !    Local variables :      !    Local variables :
96    
97      INTEGER i,j,l,ig0,ig,iq,iiq      INTEGER i, j, l, ig0, ig, iq, iiq
98      REAL zpsrf(klon)      REAL zpsrf(klon)
99      REAL zplev(klon,llm+1),zplay(klon,llm)      REAL zplev(klon, llm+1), zplay(klon, llm)
100      REAL zphi(klon,llm),zphis(klon)      REAL zphi(klon, llm), zphis(klon)
   
     REAL zufi(klon,llm), zvfi(klon,llm)  
     REAL ztfi(klon,llm) ! temperature  
     real zqfi(klon,llm,nqmx) ! mass fractions of advected fields  
   
     REAL pcvgu(klon,llm), pcvgv(klon,llm)  
     REAL pcvgt(klon,llm), pcvgq(klon,llm,2)  
101    
102      REAL pvervel(klon,llm)      REAL zufi(klon, llm), v(klon, llm)
103        real zvfi(iim + 1, jjm + 1, llm)
104        REAL ztfi(klon, llm) ! temperature
105        real qx(klon, llm, nqmx) ! mass fractions of advected fields
106        REAL pvervel(klon, llm)
107    
108      REAL zdufi(klon,llm),zdvfi(klon,llm)      REAL zdufi(klon, llm), zdvfi(klon, llm)
109      REAL zdtfi(klon,llm),zdqfi(klon,llm,nqmx)      REAL zdtfi(klon, llm), zdqfi(klon, llm, nqmx)
110      REAL zdpsrf(klon)      REAL zdpsrf(klon)
111    
112      REAL zsin(iim),zcos(iim),z1(iim)      REAL z1(iim)
113      REAL zsinbis(iim),zcosbis(iim),z1bis(iim)      REAL pksurcp(iim + 1, jjm + 1)
     REAL pksurcp(iim + 1,jjm + 1)  
114    
115      ! I. Musat: diagnostic PVteta, Amip2      ! I. Musat: diagnostic PVteta, Amip2
116      INTEGER, PARAMETER:: ntetaSTD=3      INTEGER, PARAMETER:: ntetaSTD=3
117      REAL:: rtetaSTD(ntetaSTD) = (/350., 380., 405./)      REAL:: rtetaSTD(ntetaSTD) = (/350., 380., 405./)
118      REAL PVteta(klon,ntetaSTD)      REAL PVteta(klon, ntetaSTD)
119    
     REAL SSUM  
   
     LOGICAL:: firstcal = .true.  
120      REAL, intent(in):: rdayvrai      REAL, intent(in):: rdayvrai
121    
122      !-----------------------------------------------------------------------      !-----------------------------------------------------------------------
# Line 144  contains Line 129  contains
129      !   40. transformation des variables dynamiques en variables physiques:      !   40. transformation des variables dynamiques en variables physiques:
130      !   41. pressions au sol (en Pascals)      !   41. pressions au sol (en Pascals)
131    
132      zpsrf(1) = pps(1,1)      zpsrf(1) = pps(1, 1)
133    
134      ig0  = 2      ig0  = 2
135      DO j = 2,jjm      DO j = 2, jjm
136         CALL SCOPY(iim,pps(1,j),1,zpsrf(ig0), 1)         CALL SCOPY(iim, pps(1, j), 1, zpsrf(ig0), 1)
137         ig0 = ig0+iim         ig0 = ig0+iim
138      ENDDO      ENDDO
139    
140      zpsrf(klon) = pps(1,jjm + 1)      zpsrf(klon) = pps(1, jjm + 1)
141    
142      !   42. pression intercouches :      !   42. pression intercouches :
143    
# Line 164  contains Line 149  contains
149      forall (l = 1: llm+1) zplev(:, l) = pack(p3d(:, :, l), dyn_phy)      forall (l = 1: llm+1) zplev(:, l) = pack(p3d(:, :, l), dyn_phy)
150    
151      !   43. temperature naturelle (en K) et pressions milieux couches .      !   43. temperature naturelle (en K) et pressions milieux couches .
152      DO l=1,llm      DO l=1, llm
153         pksurcp     =  ppk(:, :, l) / cpp         pksurcp     =  ppk(:, :, l) / cpp
154         pls(:, :, l) = preff * pksurcp**(1./ kappa)         pls(:, :, l) = preff * pksurcp**(1./ kappa)
155         zplay(:, l) = pack(pls(:, :, l), dyn_phy)         zplay(:, l) = pack(pls(:, :, l), dyn_phy)
156         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)  
157      ENDDO      ENDDO
158    
159      !   43.bis traceurs      !   43.bis traceurs
160        DO iq=1, nqmx
     DO iq=1,nq  
161         iiq=niadv(iq)         iiq=niadv(iq)
162         DO l=1,llm         DO l=1, llm
163            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)  
164            ig0          = 2            ig0          = 2
165            DO j=2,jjm            DO j=2, jjm
166               DO i = 1, iim               DO i = 1, iim
167                  pcvgq(ig0,l,iq) = pdq(i,j,l,iq) / pmasse(i,j,l)                  qx(ig0, l, iq)  = q(i, j, l, iiq)
168                  ig0             = ig0 + 1                  ig0             = ig0 + 1
169               ENDDO               ENDDO
170            ENDDO            ENDDO
171            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)
172         ENDDO         ENDDO
173      ENDDO      ENDDO
174    
175      !   Geopotentiel calcule par rapport a la surface locale:      !   Geopotentiel calcule par rapport a la surface locale:
   
176      forall (l = 1:llm) zphi(:, l) = pack(pphi(:, :, l), dyn_phy)      forall (l = 1:llm) zphi(:, l) = pack(pphi(:, :, l), dyn_phy)
177      zphis = pack(pphis, dyn_phy)      zphis = pack(pphis, dyn_phy)
178      DO l=1,llm      DO l=1, llm
179         DO ig=1,klon         DO ig=1, klon
180            zphi(ig,l)=zphi(ig,l)-zphis(ig)            zphi(ig, l)=zphi(ig, l)-zphis(ig)
181         ENDDO         ENDDO
182      ENDDO      ENDDO
183    
184      !   ....  Calcul de la vitesse  verticale  (en Pa*m*s  ou Kg/s)  ....      ! Calcul de la vitesse  verticale  (en Pa*m*s  ou Kg/s)
185        DO l=1, llm
186      DO l=1,llm         pvervel(1, l)=pw(1, 1, l) * g /apoln
        pvervel(1,l)=pw(1,1,l) * g /apoln  
187         ig0=2         ig0=2
188         DO j=2,jjm         DO j=2, jjm
189            DO i = 1, iim            DO i = 1, iim
190               pvervel(ig0,l) = pw(i,j,l) * g * unsaire_2d(i,j)               pvervel(ig0, l) = pw(i, j, l) * g * unsaire_2d(i, j)
191               ig0 = ig0 + 1               ig0 = ig0 + 1
192            ENDDO            ENDDO
193         ENDDO         ENDDO
194         pvervel(ig0,l)=pw(1,jjm + 1,l) * g /apols         pvervel(ig0, l)=pw(1, jjm + 1, l) * g /apols
195      ENDDO      ENDDO
196    
197      !   45. champ u:      !   45. champ u:
198    
199      DO  l=1,llm      DO  l=1, llm
200           DO  j=2, jjm
        DO  j=2,jjm  
201            ig0 = 1+(j-2)*iim            ig0 = 1+(j-2)*iim
202            zufi(ig0+1,l)= 0.5 *  &            zufi(ig0+1, l)= 0.5 *  &
203                 (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))
204            pcvgu(ig0+1,l)= 0.5 *  &            DO i=2, iim
205                 (pducov(iim,j,l)/cu_2d(iim,j) + pducov(1,j,l)/cu_2d(1,j))               zufi(ig0+i, l)= 0.5 * &
206            DO i=2,iim                    (pucov(i-1, j, l)/cu_2d(i-1, j) &
207               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))  
208            end DO            end DO
209         end DO         end DO
   
210      end DO      end DO
211    
212      !   46.champ v:      !   46.champ v:
213    
214      DO l=1,llm      forall (j = 2: jjm, l = 1: llm) zvfi(:iim, j, l)= 0.5 &
215         DO j=2,jjm           * (pvcov(:iim, j-1, l) / cv_2d(:iim, j-1) &
216            ig0=1+(j-2)*iim           + pvcov(:iim, j, l) / cv_2d(:iim, j))
217            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  
218    
219      !   47. champs de vents aux pole nord        !   47. champs de vents au pôle nord  
220      !        U = 1 / pi  *  integrale [ v * cos(long) * d long ]      !        U = 1 / pi  *  integrale [ v * cos(long) * d long ]
221      !        V = 1 / pi  *  integrale [ v * sin(long) * d long ]      !        V = 1 / pi  *  integrale [ v * sin(long) * d long ]
222    
223      DO l=1,llm      DO l=1, llm
224           z1(1)   =(rlonu(1)-rlonu(iim)+2.*pi)*pvcov(1, 1, l)/cv_2d(1, 1)
225         z1(1)   =(rlonu(1)-rlonu(iim)+2.*pi)*pvcov(1,1,l)/cv_2d(1,1)         DO i=2, iim
226         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)  
227         ENDDO         ENDDO
228    
229         DO i=1,iim         zufi(1, l)  = SUM(COS(rlonv(:iim)) * z1) / pi
230            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  
   
231      ENDDO      ENDDO
232    
233      !   48. champs de vents aux pole sud:      !   48. champs de vents au pôle sud:
234      !        U = 1 / pi  *  integrale [ v * cos(long) * d long ]      !        U = 1 / pi  *  integrale [ v * cos(long) * d long ]
235      !        V = 1 / pi  *  integrale [ v * sin(long) * d long ]      !        V = 1 / pi  *  integrale [ v * sin(long) * d long ]
236    
237      DO l=1,llm      DO l=1, llm
238           z1(1)   =(rlonu(1)-rlonu(iim)+2.*pi)*pvcov(1, jjm, l) &
239         z1(1)   =(rlonu(1)-rlonu(iim)+2.*pi)*pvcov(1,jjm,l) &              /cv_2d(1, jjm)
240              /cv_2d(1,jjm)         DO i=2, iim
241         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)
242              /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  
243    
244           zufi(klon, l)  = SUM(COS(rlonv(:iim)) * z1) / pi
245           zvfi(:, jjm + 1, l)  = SUM(SIN(rlonv(:iim)) * z1) / pi
246      ENDDO      ENDDO
247    
248        forall(l= 1: llm) v(:, l) = pack(zvfi(:, :, l), dyn_phy)
249    
250      !IM calcul PV a teta=350, 380, 405K      !IM calcul PV a teta=350, 380, 405K
251      CALL PVtheta(klon,llm,pucov,pvcov,pteta, &      CALL PVtheta(klon, llm, pucov, pvcov, pteta, ztfi, zplay, zplev, &
252           ztfi,zplay,zplev, &           ntetaSTD, rtetaSTD, PVteta)
253           ntetaSTD,rtetaSTD,PVteta)  
254        ! Appel de la physique :
255      !   Appel de la physique:      CALL physiq(lafin, rdayvrai, heure, dtphys, zplev, zplay, zphi, &
256             zphis, zufi, v, ztfi, qx, pvervel, zdufi, zdvfi, &
257      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  
258    
259      !   transformation des tendances physiques en tendances dynamiques:      !   transformation des tendances physiques en tendances dynamiques:
260    
# Line 343  contains Line 264  contains
264    
265      !   62. enthalpie potentielle      !   62. enthalpie potentielle
266    
267      DO l=1,llm      DO l=1, llm
268    
269         DO i=1,iim + 1         DO i=1, iim + 1
270            pdhfi(i,1,l)    = cpp *  zdtfi(1,l)      / ppk(i, 1  ,l)            pdhfi(i, 1, l)    = cpp *  zdtfi(1, l)      / ppk(i, 1  , l)
271            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)
272         ENDDO         ENDDO
273    
274         DO j=2,jjm         DO j=2, jjm
275            ig0=1+(j-2)*iim            ig0=1+(j-2)*iim
276            DO i=1,iim            DO i=1, iim
277               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)
278            ENDDO            ENDDO
279            pdhfi(iim + 1,j,l) =  pdhfi(1,j,l)            pdhfi(iim + 1, j, l) =  pdhfi(1, j, l)
280         ENDDO         ENDDO
281    
282      ENDDO      ENDDO
283    
284      !   62. humidite specifique      !   62. humidite specifique
285    
286      DO iq=1,nqmx      DO iq=1, nqmx
287         DO l=1,llm         DO l=1, llm
288            DO i=1,iim + 1            DO i=1, iim + 1
289               pdqfi(i,1,l,iq)    = zdqfi(1,l,iq)               pdqfi(i, 1, l, iq)    = zdqfi(1, l, iq)
290               pdqfi(i,jjm + 1,l,iq) = zdqfi(klon,l,iq)               pdqfi(i, jjm + 1, l, iq) = zdqfi(klon, l, iq)
291            ENDDO            ENDDO
292            DO j=2,jjm            DO j=2, jjm
293               ig0=1+(j-2)*iim               ig0=1+(j-2)*iim
294               DO i=1,iim               DO i=1, iim
295                  pdqfi(i,j,l,iq) = zdqfi(ig0+i,l,iq)                  pdqfi(i, j, l, iq) = zdqfi(ig0+i, l, iq)
296               ENDDO               ENDDO
297               pdqfi(iim + 1,j,l,iq) = pdqfi(1,j,l,iq)               pdqfi(iim + 1, j, l, iq) = pdqfi(1, j, l, iq)
298            ENDDO            ENDDO
299         ENDDO         ENDDO
300      ENDDO      ENDDO
# Line 383  contains Line 304  contains
304      !     initialisation des tendances      !     initialisation des tendances
305      pdqfi=0.      pdqfi=0.
306    
307      DO iq=1,nq      DO iq=1, nqmx
308         iiq=niadv(iq)         iiq=niadv(iq)
309         DO l=1,llm         DO l=1, llm
310            DO i=1,iim + 1            DO i=1, iim + 1
311               pdqfi(i,1,l,iiq)    = zdqfi(1,l,iq)               pdqfi(i, 1, l, iiq)    = zdqfi(1, l, iq)
312               pdqfi(i,jjm + 1,l,iiq) = zdqfi(klon,l,iq)               pdqfi(i, jjm + 1, l, iiq) = zdqfi(klon, l, iq)
313            ENDDO            ENDDO
314            DO j=2,jjm            DO j=2, jjm
315               ig0=1+(j-2)*iim               ig0=1+(j-2)*iim
316               DO i=1,iim               DO i=1, iim
317                  pdqfi(i,j,l,iiq) = zdqfi(ig0+i,l,iq)                  pdqfi(i, j, l, iiq) = zdqfi(ig0+i, l, iq)
318               ENDDO               ENDDO
319               pdqfi(iim + 1,j,l,iiq) = pdqfi(1,j,l,iq)               pdqfi(iim + 1, j, l, iiq) = pdqfi(1, j, l, iq)
320            ENDDO            ENDDO
321         ENDDO         ENDDO
322      ENDDO      ENDDO
323    
324      !   65. champ u:      !   65. champ u:
325    
326      DO l=1,llm      DO l=1, llm
327    
328         DO i=1,iim + 1         DO i=1, iim + 1
329            pdufi(i,1,l)    = 0.            pdufi(i, 1, l)    = 0.
330            pdufi(i,jjm + 1,l) = 0.            pdufi(i, jjm + 1, l) = 0.
331         ENDDO         ENDDO
332    
333         DO j=2,jjm         DO j=2, jjm
334            ig0=1+(j-2)*iim            ig0=1+(j-2)*iim
335            DO i=1,iim-1            DO i=1, iim-1
336               pdufi(i,j,l)= &               pdufi(i, j, l)= &
337                    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)
338            ENDDO            ENDDO
339            pdufi(iim,j,l)= &            pdufi(iim, j, l)= &
340                 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)
341            pdufi(iim + 1,j,l)=pdufi(1,j,l)            pdufi(iim + 1, j, l)=pdufi(1, j, l)
342         ENDDO         ENDDO
343    
344      ENDDO      ENDDO
345    
346      !   67. champ v:      !   67. champ v:
347    
348      DO l=1,llm      DO l=1, llm
349    
350         DO j=2,jjm-1         DO j=2, jjm-1
351            ig0=1+(j-2)*iim            ig0=1+(j-2)*iim
352            DO i=1,iim            DO i=1, iim
353               pdvfi(i,j,l)= &               pdvfi(i, j, l)= &
354                    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)
355            ENDDO            ENDDO
356            pdvfi(iim + 1,j,l) = pdvfi(1,j,l)            pdvfi(iim + 1, j, l) = pdvfi(1, j, l)
357         ENDDO         ENDDO
358      ENDDO      ENDDO
359    
360      !   68. champ v pres des poles:      !   68. champ v pres des poles:
361      !      v = U * cos(long) + V * SIN(long)      !      v = U * cos(long) + V * SIN(long)
362    
363      DO l=1,llm      DO l=1, llm
364           DO i=1, iim
365         DO i=1,iim            pdvfi(i, 1, l)= &
366            pdvfi(i,1,l)= &                 zdufi(1, l)*COS(rlonv(i))+zdvfi(1, l)*SIN(rlonv(i))
367                 zdufi(1,l)*COS(rlonv(i))+zdvfi(1,l)*SIN(rlonv(i))            pdvfi(i, jjm, l)=zdufi(klon, l)*COS(rlonv(i)) &
368            pdvfi(i,jjm,l)=zdufi(klon,l)*COS(rlonv(i)) &                 +zdvfi(klon, l)*SIN(rlonv(i))
369                 +zdvfi(klon,l)*SIN(rlonv(i))            pdvfi(i, 1, l)= &
370            pdvfi(i,1,l)= &                 0.5*(pdvfi(i, 1, l)+zdvfi(i+1, l))*cv_2d(i, 1)
371                 0.5*(pdvfi(i,1,l)+zdvfi(i+1,l))*cv_2d(i,1)            pdvfi(i, jjm, l)= &
372            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)  
373         ENDDO         ENDDO
374    
375         pdvfi(iim + 1,1,l)  = pdvfi(1,1,l)         pdvfi(iim + 1, 1, l)  = pdvfi(1, 1, l)
376         pdvfi(iim + 1,jjm,l)= pdvfi(1,jjm,l)         pdvfi(iim + 1, jjm, l)= pdvfi(1, jjm, l)
   
377      ENDDO      ENDDO
378    
     firstcal = .FALSE.  
   
379    END SUBROUTINE calfis    END SUBROUTINE calfis
380    
381  end module calfis_m  end module calfis_m
Legend:
Removed from v.18  
changed lines
  Added in v.39
  ViewVC Help
Powered by ViewVC 1.1.21