/[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 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(lafin, rdayvrai, heure, pucov, pvcov, pteta, q, &    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 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  
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 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    
# Line 94  contains Line 92  contains
92      REAL pdqfi(iim + 1, jjm + 1, llm, nqmx)      REAL pdqfi(iim + 1, jjm + 1, llm, nqmx)
93      REAL pdpsfi(iim + 1, jjm + 1)      REAL pdpsfi(iim + 1, jjm + 1)
94    
     INTEGER, PARAMETER:: longcles = 20  
   
95      !    Local variables :      !    Local variables :
96    
97      INTEGER i, j, l, ig0, ig, iq, iiq      INTEGER i, j, l, ig0, ig, iq, iiq
# Line 103  contains Line 99  contains
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)
101    
102      REAL zufi(klon, llm), zvfi(klon, llm)      REAL zufi(klon, llm), v(klon, llm)
103        real zvfi(iim + 1, jjm + 1, llm)
104      REAL ztfi(klon, llm) ! temperature      REAL ztfi(klon, llm) ! temperature
105      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)  
   
106      REAL pvervel(klon, llm)      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)
     REAL zsinbis(iim), zcosbis(iim), z1bis(iim)  
113      REAL pksurcp(iim + 1, jjm + 1)      REAL pksurcp(iim + 1, jjm + 1)
114    
115      ! I. Musat: diagnostic PVteta, Amip2      ! I. Musat: diagnostic PVteta, Amip2
# Line 125  contains Line 117  contains
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 165  contains Line 154  contains
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, nqmx
161         iiq=niadv(iq)         iiq=niadv(iq)
162         DO l=1, llm         DO l=1, llm
# Line 185  contains Line 172  contains
172         ENDDO         ENDDO
173      ENDDO      ENDDO
174    
     !   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  
   
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
# Line 211  contains Line 181  contains
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      DO l=1, llm
186         pvervel(1, l)=pw(1, 1, l) * g /apoln         pvervel(1, l)=pw(1, 1, l) * g /apoln
187         ig0=2         ig0=2
# Line 228  contains Line 197  contains
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))
           pcvgu(ig0+1, l)= 0.5 *  &  
                (pducov(iim, j, l)/cu_2d(iim, j) + pducov(1, j, l)/cu_2d(1, j))  
204            DO i=2, iim            DO i=2, iim
205               zufi(ig0+i, l)= 0.5 * &               zufi(ig0+i, l)= 0.5 * &
206                    (pucov(i-1, j, l)/cu_2d(i-1, j) &                    (pucov(i-1, j, l)/cu_2d(i-1, j) &
207                    + 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))  
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 au pôle 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)         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)  
225         DO i=2, iim         DO i=2, iim
226            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)  
227         ENDDO         ENDDO
228    
229         zufi(1, l)  = SSUM(iim, zcos, 1)/pi         zufi(1, l)  = SUM(COS(rlonv(:iim)) * z1) / pi
230         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  
   
231      ENDDO      ENDDO
232    
233      !   48. champs de vents au pôle sud:      !   48. champs de vents au pôle sud:
# Line 294  contains Line 235  contains
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) &         z1(1)   =(rlonu(1)-rlonu(iim)+2.*pi)*pvcov(1, jjm, l) &
239              /cv_2d(1, jjm)              /cv_2d(1, jjm)
        z1bis(1)=(rlonu(1)-rlonu(iim)+2.*pi)*pdvcov(1, jjm, l) &  
             /cv_2d(1, jjm)  
240         DO i=2, iim         DO i=2, iim
241            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)  
242         ENDDO         ENDDO
243    
244         zufi(klon, l)  = SSUM(iim, zcos, 1)/pi         zufi(klon, l)  = SUM(COS(rlonv(:iim)) * z1) / pi
245         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  
   
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, &
          ztfi, zplay, zplev, &  
252           ntetaSTD, rtetaSTD, PVteta)           ntetaSTD, rtetaSTD, PVteta)
253    
254      !   Appel de la physique:      ! Appel de la physique :
255        CALL physiq(lafin, rdayvrai, heure, dtphys, zplev, zplay, zphi, &
256      CALL physiq(firstcal, lafin, rdayvrai, heure, dtphys, zplev, zplay, zphi, &           zphis, zufi, v, ztfi, qx, pvervel, zdufi, zdvfi, &
257           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  
258    
259      !   transformation des tendances physiques en tendances dynamiques:      !   transformation des tendances physiques en tendances dynamiques:
260    
# Line 434  contains Line 361  contains
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         DO i=1, iim
365            pdvfi(i, 1, l)= &            pdvfi(i, 1, l)= &
366                 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 374  contains
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.34  
changed lines
  Added in v.39
  ViewVC Help
Powered by ViewVC 1.1.21