/[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 3 by guez, Wed Feb 27 13:16:39 2008 UTC revision 18 by guez, Thu Aug 7 12:29:13 2008 UTC
# Line 7  module calfis_m Line 7  module calfis_m
7  contains  contains
8    
9    SUBROUTINE calfis(nq, lafin, rdayvrai, heure, pucov, pvcov, pteta, pq, &    SUBROUTINE calfis(nq, lafin, rdayvrai, heure, pucov, pvcov, pteta, pq, &
10         pmasse, pps, pp, ppk, pphis, pphi, pducov, pdvcov, pdteta, pdq, pw, &         pmasse, pps, ppk, pphis, pphi, pducov, pdvcov, pdteta, pdq, pw, &
11         clesphy0, pdufi, pdvfi, pdhfi, pdqfi, pdpsfi)         pdufi, pdvfi, pdhfi, pdqfi, pdpsfi)
12    
13      ! From dyn3d/calfis.F,v 1.3 2005/05/25 13:10:09      ! From dyn3d/calfis.F,v 1.3 2005/05/25 13:10:09
14    
# Line 57  contains Line 57  contains
57      use comconst, only: kappa, cpp, dtphys, g, pi      use comconst, only: kappa, cpp, dtphys, g, pi
58      use comvert, only: preff, presnivs      use comvert, only: preff, presnivs
59      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
60      use advtrac_m, only: niadv      use iniadvtrac_m, only: niadv
61      use grid_change, only: dyn_phy, gr_fi_dyn      use grid_change, only: dyn_phy, gr_fi_dyn
62      use physiq_m, only: physiq      use physiq_m, only: physiq
63        use pressure_var, only: p3d, pls
64    
65      !    0.  Declarations :      !    0.  Declarations :
66    
67      INTEGER nq      INTEGER, intent(in):: nq
68    
69      !    Arguments :      !    Arguments :
70    
# Line 89  contains Line 90  contains
90      REAL pw(iim + 1,jjm + 1,llm)      REAL pw(iim + 1,jjm + 1,llm)
91    
92      REAL pps(iim + 1,jjm + 1)      REAL pps(iim + 1,jjm + 1)
93      REAL pp(iim + 1,jjm + 1,llm + 1)      REAL, intent(in):: ppk(iim + 1,jjm + 1,llm)
     REAL ppk(iim + 1,jjm + 1,llm)  
94    
95      REAL pdvfi(iim + 1,jjm,llm)      REAL pdvfi(iim + 1,jjm,llm)
96      REAL pdufi(iim + 1,jjm + 1,llm)      REAL pdufi(iim + 1,jjm + 1,llm)
# Line 99  contains Line 99  contains
99      REAL pdpsfi(iim + 1,jjm + 1)      REAL pdpsfi(iim + 1,jjm + 1)
100    
101      INTEGER, PARAMETER:: longcles = 20      INTEGER, PARAMETER:: longcles = 20
     REAL clesphy0(longcles)  
102    
103      !    Local variables :      !    Local variables :
104    
# Line 123  contains Line 122  contains
122    
123      REAL zsin(iim),zcos(iim),z1(iim)      REAL zsin(iim),zcos(iim),z1(iim)
124      REAL zsinbis(iim),zcosbis(iim),z1bis(iim)      REAL zsinbis(iim),zcosbis(iim),z1bis(iim)
125      REAL unskap, pksurcp      REAL pksurcp(iim + 1,jjm + 1)
126    
127      ! I. Musat: diagnostic PVteta, Amip2      ! I. Musat: diagnostic PVteta, Amip2
128      INTEGER, PARAMETER:: ntetaSTD=3      INTEGER, PARAMETER:: ntetaSTD=3
# Line 133  contains Line 132  contains
132      REAL SSUM      REAL SSUM
133    
134      LOGICAL:: firstcal = .true.      LOGICAL:: firstcal = .true.
135      REAL rdayvrai      REAL, intent(in):: rdayvrai
136    
137      !-----------------------------------------------------------------------      !-----------------------------------------------------------------------
138    
# Line 162  contains Line 161  contains
161    
162      !    ...    Exner = cp * (p(l) / preff) ** kappa     ....      !    ...    Exner = cp * (p(l) / preff) ** kappa     ....
163    
164      unskap   = 1./ kappa      forall (l = 1: llm+1) zplev(:, l) = pack(p3d(:, :, l), dyn_phy)
   
     DO l = 1, llm + 1  
        zplev(1,l) = pp(1,1,l)  
        ig0 = 2  
        DO j = 2, jjm  
           DO i =1, iim  
              zplev(ig0,l) = pp(i,j,l)  
              ig0 = ig0 +1  
           ENDDO  
        ENDDO  
        zplev(klon,l) = pp(1,jjm + 1,l)  
     ENDDO  
165    
166      !   43. temperature naturelle (en K) et pressions milieux couches .      !   43. temperature naturelle (en K) et pressions milieux couches .
   
167      DO l=1,llm      DO l=1,llm
168           pksurcp     =  ppk(:, :, l) / cpp
169         pksurcp     =  ppk(1,1,l) / cpp         pls(:, :, l) = preff * pksurcp**(1./ kappa)
170         zplay(1,l)  =  preff * pksurcp ** unskap         zplay(:, l) = pack(pls(:, :, l), dyn_phy)
171         ztfi(1,l)   =  pteta(1,1,l) *  pksurcp         ztfi(:, l) = pack(pteta(:, :, l) * pksurcp, dyn_phy)
172         pcvgt(1,l)  =  pdteta(1,1,l) * pksurcp / pmasse(1,1,l)         pcvgt(:, l) = pack(pdteta(:, :, l) * pksurcp / pmasse(:, :, l), dyn_phy)
        ig0         = 2  
   
        DO j = 2, jjm  
           DO i = 1, iim  
              pksurcp        = ppk(i,j,l) / cpp  
              zplay(ig0,l)   = preff * pksurcp ** unskap  
              ztfi(ig0,l)    = pteta(i,j,l)  * pksurcp  
              pcvgt(ig0,l)   = pdteta(i,j,l) * pksurcp / pmasse(i,j,l)  
              ig0            = ig0 + 1  
           ENDDO  
        ENDDO  
   
        pksurcp       = ppk(1,jjm + 1,l) / cpp  
        zplay(ig0,l)  = preff * pksurcp ** unskap  
        ztfi (ig0,l)  = pteta(1,jjm + 1,l)  * pksurcp  
        pcvgt(ig0,l)  = pdteta(1,jjm + 1,l) * pksurcp/ pmasse(1,jjm + 1,l)  
   
173      ENDDO      ENDDO
174    
175      !   43.bis traceurs      !   43.bis traceurs
# Line 362  contains Line 331  contains
331      !   Appel de la physique:      !   Appel de la physique:
332    
333      CALL physiq(nq, firstcal, lafin, rdayvrai, heure, dtphys, &      CALL physiq(nq, firstcal, lafin, rdayvrai, heure, dtphys, &
334           zplev, zplay, zphi, zphis, presnivs, clesphy0, zufi, zvfi, &           zplev, zplay, zphi, zphis, presnivs, zufi, zvfi, &
335           ztfi, zqfi, pvervel, zdufi, zdvfi, zdtfi, zdqfi, zdpsrf, pducov, &           ztfi, zqfi, pvervel, zdufi, zdvfi, zdtfi, zdqfi, zdpsrf, pducov, &
336           PVteta) ! IM diagnostique PVteta, Amip2           PVteta) ! IM diagnostique PVteta, Amip2
337    
Legend:
Removed from v.3  
changed lines
  Added in v.18
  ViewVC Help
Powered by ViewVC 1.1.21