/[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 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
# Line 10  contains Line 8  contains
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      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    
# 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    
     INTEGER, PARAMETER:: longcles = 20  
   
94      !    Local variables :      !    Local variables :
95    
96      INTEGER i, j, l, ig0, ig, iq, iiq      INTEGER i, j, l, ig0, ig, iq, iiq
# Line 103  contains Line 98  contains
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      !-----------------------------------------------------------------------      !-----------------------------------------------------------------------
# Line 165  contains Line 153  contains
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
# Line 185  contains Line 171  contains
171         ENDDO         ENDDO
172      ENDDO      ENDDO
173    
     !   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)  
           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  
   
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
# 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 228  contains Line 196  contains
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))
           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:
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 au pôle 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)         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:
# Line 294  contains Line 234  contains
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) &
238              /cv_2d(1, jjm)              /cv_2d(1, jjm)
        z1bis(1)=(rlonu(1)-rlonu(iim)+2.*pi)*pdvcov(1, jjm, l) &  
             /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    
# Line 434  contains Line 360  contains
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 448  contains Line 373  contains
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.35
  ViewVC Help
Powered by ViewVC 1.1.21