/[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 10 by guez, Fri Apr 18 14:45:53 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)         clesphy0, 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
# Line 60  contains Line 60  contains
60      use advtrac_m, only: niadv      use advtrac_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    
# 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 123  contains Line 123  contains
123    
124      REAL zsin(iim),zcos(iim),z1(iim)      REAL zsin(iim),zcos(iim),z1(iim)
125      REAL zsinbis(iim),zcosbis(iim),z1bis(iim)      REAL zsinbis(iim),zcosbis(iim),z1bis(iim)
126      REAL unskap, pksurcp      REAL pksurcp(iim + 1,jjm + 1)
127    
128      ! I. Musat: diagnostic PVteta, Amip2      ! I. Musat: diagnostic PVteta, Amip2
129      INTEGER, PARAMETER:: ntetaSTD=3      INTEGER, PARAMETER:: ntetaSTD=3
# Line 133  contains Line 133  contains
133      REAL SSUM      REAL SSUM
134    
135      LOGICAL:: firstcal = .true.      LOGICAL:: firstcal = .true.
136      REAL rdayvrai      REAL, intent(in):: rdayvrai
137    
138      !-----------------------------------------------------------------------      !-----------------------------------------------------------------------
139    
# Line 162  contains Line 162  contains
162    
163      !    ...    Exner = cp * (p(l) / preff) ** kappa     ....      !    ...    Exner = cp * (p(l) / preff) ** kappa     ....
164    
165      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  
166    
167      !   43. temperature naturelle (en K) et pressions milieux couches .      !   43. temperature naturelle (en K) et pressions milieux couches .
   
168      DO l=1,llm      DO l=1,llm
169           pksurcp     =  ppk(:, :, l) / cpp
170         pksurcp     =  ppk(1,1,l) / cpp         pls(:, :, l) = preff * pksurcp**(1./ kappa)
171         zplay(1,l)  =  preff * pksurcp ** unskap         zplay(:, l) = pack(pls(:, :, l), dyn_phy)
172         ztfi(1,l)   =  pteta(1,1,l) *  pksurcp         ztfi(:, l) = pack(pteta(:, :, l) * pksurcp, dyn_phy)
173         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)  
   
174      ENDDO      ENDDO
175    
176      !   43.bis traceurs      !   43.bis traceurs
Legend:
Removed from v.3  
changed lines
  Added in v.10
  ViewVC Help
Powered by ViewVC 1.1.21