/[lmdze]/trunk/Sources/phylmd/phystokenc.f
ViewVC logotype

Diff of /trunk/Sources/phylmd/phystokenc.f

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 200 by guez, Mon May 9 19:56:28 2016 UTC revision 201 by guez, Mon Jun 6 17:42:15 2016 UTC
# Line 42  contains Line 42  contains
42      ! flux detraine dans le panache descendant      ! flux detraine dans le panache descendant
43    
44      ! Les Thermiques      ! Les Thermiques
45      REAL pfm_therm(klon, klev+1)      REAL, intent(in):: pfm_therm(klon, klev+1)
46      REAL pentr_therm(klon, klev)      REAL, intent(in):: pentr_therm(klon, klev)
47    
48      ! Couche limite:      ! Couche limite:
49        REAL, intent(in):: pcoefh(klon, klev) ! coeff melange Couche limite
50      REAL pcoefh(klon, klev) ! coeff melange Couche limite      REAL, intent(in):: yu1(klon)
51      REAL yu1(klon)      REAL, intent(in):: yv1(klon)
     REAL yv1(klon)  
52    
53      ! Arguments necessaires pour les sources et puits de traceur      ! Arguments necessaires pour les sources et puits de traceur
54    
55      REAL ftsol(klon, nbsrf) ! Temperature du sol (surf)(Kelvin)      REAL, intent(in):: ftsol(klon, nbsrf) ! Temperature du sol (surf)(Kelvin)
56      REAL pctsrf(klon, nbsrf) ! Pourcentage de sol f(nature du sol)      REAL, intent(in):: pctsrf(klon, nbsrf) ! Pourcentage de sol f(nature du sol)
   
     ! Lessivage:  
57    
58      REAL frac_impa(klon, klev)      ! Coefficients de lessivage:
59      REAL frac_nucl(klon, klev)      REAL, intent(in):: frac_impa(klon, klev) ! facteur d'impaction
60        REAL, intent(in):: frac_nucl(klon, klev) ! facteur de nucleation
61    
62      REAL, INTENT(IN):: pphis(klon)      REAL, INTENT(IN):: pphis(klon)
63      real paire(klon)      real, intent(in):: paire(klon)
64      REAL, INTENT (IN):: dtime      REAL, INTENT (IN):: dtime
65    
66      ! Variables local to the procedure:      ! Local:
67    
68      real t(klon, klev)      real t(klon, klev)
69      INTEGER, SAVE:: physid      INTEGER, SAVE:: physid
# Line 94  contains Line 92  contains
92      REAL dtcum      REAL dtcum
93    
94      INTEGER:: iadvtr = 0, irec = 1      INTEGER:: iadvtr = 0, irec = 1
     REAL zmin, zmax  
     LOGICAL ok_sync  
95    
96      SAVE t, mfd, en_u, de_u, en_d, de_d, coefh, dtcum      SAVE t, mfd, en_u, de_u, en_d, de_d, coefh, dtcum
97      SAVE fm_therm, entr_therm      SAVE fm_therm, entr_therm
# Line 105  contains Line 101  contains
101    
102      ! Couche limite:      ! Couche limite:
103    
104      ok_sync = .TRUE.      IF (iadvtr==0) CALL initphysto('phystoke', dtime, dtime * istphy, &
105             dtime * istphy, physid)
     IF (iadvtr==0) CALL initphysto('phystoke', dtime, dtime*istphy, dtime*istphy, physid)  
106    
107      CALL histwrite(physid, 'phis', itap, gr_phy_write(pphis))      CALL histwrite(physid, 'phis', itap, gr_phy_write(pphis))
108      CALL histwrite(physid, 'aire', itap, gr_phy_write(paire))      CALL histwrite(physid, 'aire', itap, gr_phy_write(paire))
# Line 145  contains Line 140  contains
140    
141      DO k = 1, klev      DO k = 1, klev
142         DO i = 1, klon         DO i = 1, klon
143            mfu(i, k) = mfu(i, k) + pmfu(i, k)*pdtphys            mfu(i, k) = mfu(i, k) + pmfu(i, k) * pdtphys
144            mfd(i, k) = mfd(i, k) + pmfd(i, k)*pdtphys            mfd(i, k) = mfd(i, k) + pmfd(i, k) * pdtphys
145            en_u(i, k) = en_u(i, k) + pen_u(i, k)*pdtphys            en_u(i, k) = en_u(i, k) + pen_u(i, k) * pdtphys
146            de_u(i, k) = de_u(i, k) + pde_u(i, k)*pdtphys            de_u(i, k) = de_u(i, k) + pde_u(i, k) * pdtphys
147            en_d(i, k) = en_d(i, k) + pen_d(i, k)*pdtphys            en_d(i, k) = en_d(i, k) + pen_d(i, k) * pdtphys
148            de_d(i, k) = de_d(i, k) + pde_d(i, k)*pdtphys            de_d(i, k) = de_d(i, k) + pde_d(i, k) * pdtphys
149            coefh(i, k) = coefh(i, k) + pcoefh(i, k)*pdtphys            coefh(i, k) = coefh(i, k) + pcoefh(i, k) * pdtphys
150            t(i, k) = t(i, k) + pt(i, k)*pdtphys            t(i, k) = t(i, k) + pt(i, k) * pdtphys
151            fm_therm(i, k) = fm_therm(i, k) + pfm_therm(i, k)*pdtphys            fm_therm(i, k) = fm_therm(i, k) + pfm_therm(i, k) * pdtphys
152            entr_therm(i, k) = entr_therm(i, k) + pentr_therm(i, k)*pdtphys            entr_therm(i, k) = entr_therm(i, k) + pentr_therm(i, k) * pdtphys
153         END DO         END DO
154      END DO      END DO
155      DO i = 1, klon      DO i = 1, klon
156         pyv1(i) = pyv1(i) + yv1(i)*pdtphys         pyv1(i) = pyv1(i) + yv1(i) * pdtphys
157         pyu1(i) = pyu1(i) + yu1(i)*pdtphys         pyu1(i) = pyu1(i) + yu1(i) * pdtphys
158      END DO      END DO
159      DO k = 1, nbsrf      DO k = 1, nbsrf
160         DO i = 1, klon         DO i = 1, klon
161            pftsol(i, k) = pftsol(i, k) + ftsol(i, k)*pdtphys            pftsol(i, k) = pftsol(i, k) + ftsol(i, k) * pdtphys
162            ppsrf(i, k) = ppsrf(i, k) + pctsrf(i, k)*pdtphys            ppsrf(i, k) = ppsrf(i, k) + pctsrf(i, k) * pdtphys
163         END DO         END DO
164      END DO      END DO
165    
# Line 181  contains Line 176  contains
176               en_d(i, k) = en_d(i, k)/dtcum               en_d(i, k) = en_d(i, k)/dtcum
177               de_d(i, k) = de_d(i, k)/dtcum               de_d(i, k) = de_d(i, k)/dtcum
178               coefh(i, k) = coefh(i, k)/dtcum               coefh(i, k) = coefh(i, k)/dtcum
              ! Unitel a enlever  
179               t(i, k) = t(i, k)/dtcum               t(i, k) = t(i, k)/dtcum
180               fm_therm(i, k) = fm_therm(i, k)/dtcum               fm_therm(i, k) = fm_therm(i, k)/dtcum
181               entr_therm(i, k) = entr_therm(i, k)/dtcum               entr_therm(i, k) = entr_therm(i, k)/dtcum
# Line 207  contains Line 201  contains
201            END DO            END DO
202         END DO         END DO
203    
204         ! ecriture des champs         ! \'Ecriture des champs
205    
206         irec = irec + 1         irec = irec + 1
207    
# Line 227  contains Line 221  contains
221    
222         CALL histwrite(physid, 'fm_th', itap, gr_phy_write(fm_therm1))         CALL histwrite(physid, 'fm_th', itap, gr_phy_write(fm_therm1))
223         CALL histwrite(physid, 'en_th', itap, gr_phy_write(entr_therm))         CALL histwrite(physid, 'en_th', itap, gr_phy_write(entr_therm))
        !ccc  
224         CALL histwrite(physid, 'frac_impa', itap, gr_phy_write(frac_impa))         CALL histwrite(physid, 'frac_impa', itap, gr_phy_write(frac_impa))
225         CALL histwrite(physid, 'frac_nucl', itap, gr_phy_write(frac_nucl))         CALL histwrite(physid, 'frac_nucl', itap, gr_phy_write(frac_nucl))
226         CALL histwrite(physid, 'pyu1', itap, gr_phy_write(pyu1))         CALL histwrite(physid, 'pyu1', itap, gr_phy_write(pyu1))
# Line 240  contains Line 233  contains
233         CALL histwrite(physid, 'psrf2', itap, gr_phy_write(ppsrf2))         CALL histwrite(physid, 'psrf2', itap, gr_phy_write(ppsrf2))
234         CALL histwrite(physid, 'psrf3', itap, gr_phy_write(ppsrf3))         CALL histwrite(physid, 'psrf3', itap, gr_phy_write(ppsrf3))
235         CALL histwrite(physid, 'psrf4', itap, gr_phy_write(ppsrf4))         CALL histwrite(physid, 'psrf4', itap, gr_phy_write(ppsrf4))
        IF (ok_sync) CALL histsync(physid)  
236    
237         ! Test sur la valeur des coefficients de lessivage         CALL histsync(physid)
   
        zmin = 1E33  
        zmax = -1E33  
        DO k = 1, klev  
           DO i = 1, klon  
              zmax = max(zmax, frac_nucl(i, k))  
              zmin = min(zmin, frac_nucl(i, k))  
           END DO  
        END DO  
        PRINT *, 'coefs de lessivage (min et max)'  
        PRINT *, 'facteur de nucleation ', zmin, zmax  
        zmin = 1E33  
        zmax = -1E33  
        DO k = 1, klev  
           DO i = 1, klon  
              zmax = max(zmax, frac_impa(i, k))  
              zmin = min(zmin, frac_impa(i, k))  
           END DO  
        END DO  
        PRINT *, 'facteur d impaction ', zmin, zmax  
238      END IF      END IF
239    
240    END SUBROUTINE phystokenc    END SUBROUTINE phystokenc
Legend:
Removed from v.200  
changed lines
  Added in v.201
  ViewVC Help
Powered by ViewVC 1.1.21