/[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 178 by guez, Fri Mar 11 18:47:26 2016 UTC revision 222 by guez, Tue Apr 25 15:31:48 2017 UTC
# Line 4  module phystokenc_m Line 4  module phystokenc_m
4    
5  contains  contains
6    
7    SUBROUTINE phystokenc(pdtphys, rlon, rlat, pt, pmfu, pmfd, pen_u, pde_u, &    SUBROUTINE phystokenc(pdtphys, pt, pmfu, pmfd, pen_u, pde_u, pen_d, pde_d, &
8         pen_d, pde_d, pfm_therm, pentr_therm, pcoefh, yu1, yv1, ftsol, pctsrf, &         pfm_therm, pentr_therm, pcoefh, yu1, yv1, ftsol, pctsrf, frac_impa, &
9         frac_impa, frac_nucl, pphis, paire, dtime, itap)         frac_nucl, pphis, paire)
10    
11      ! From phylmd/phystokenc.F, version 1.2 2004/06/22 11:45:35      ! From phylmd/phystokenc.F, version 1.2, 2004/06/22 11:45:35
12      ! Author: Fr\'ed\'eric Hourdin      ! Author: Fr\'ed\'eric Hourdin
13      ! Objet : \'ecriture des variables pour transport offline      ! Objet : \'ecriture des variables pour transport offline
14    
15        use gr_phy_write_m, only: gr_phy_write
16      USE histwrite_m, ONLY: histwrite      USE histwrite_m, ONLY: histwrite
17      USE histsync_m, ONLY: histsync      USE histsync_m, ONLY: histsync
     USE dimens_m, ONLY: iim, jjm  
18      USE indicesol, ONLY: nbsrf      USE indicesol, ONLY: nbsrf
19      use initphysto_m, only: initphysto      use initphysto_m, only: initphysto
20      USE dimphy, ONLY: klev, klon      USE dimphy, ONLY: klev, klon
21        use time_phylmdz, only: itap
22      USE tracstoke, ONLY: istphy      USE tracstoke, ONLY: istphy
23    
24      REAL, INTENT (IN):: pdtphys ! pas d'integration pour la physique (seconde)      REAL, INTENT (IN):: pdtphys ! pas d'integration pour la physique (seconde)
     REAL, INTENT (IN):: rlon(klon), rlat(klon)  
25      REAL, intent(in):: pt(klon, klev)      REAL, intent(in):: pt(klon, klev)
26    
27      ! convection:      ! convection:
# Line 41  contains Line 41  contains
41      ! flux detraine dans le panache descendant      ! flux detraine dans le panache descendant
42    
43      ! Les Thermiques      ! Les Thermiques
44      REAL pfm_therm(klon, klev+1)      REAL, intent(in):: pfm_therm(klon, klev+1)
45      REAL pentr_therm(klon, klev)      REAL, intent(in):: pentr_therm(klon, klev)
46    
47      ! Couche limite:      ! Couche limite:
48        REAL, intent(in):: pcoefh(klon, klev) ! coeff melange Couche limite
49      REAL pcoefh(klon, klev) ! coeff melange Couche limite      REAL, intent(in):: yu1(klon)
50      REAL yu1(klon)      REAL, intent(in):: yv1(klon)
     REAL yv1(klon)  
51    
52      ! Arguments necessaires pour les sources et puits de traceur      ! Arguments necessaires pour les sources et puits de traceur
53    
54      REAL ftsol(klon, nbsrf) ! Temperature du sol (surf)(Kelvin)      REAL, intent(in):: ftsol(:, :) ! (klon, nbsrf) surface temperature (K)
55      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:  
56    
57      REAL frac_impa(klon, klev)      ! Coefficients de lessivage:
58      REAL frac_nucl(klon, klev)      REAL, intent(in):: frac_impa(klon, klev) ! facteur d'impaction
59        REAL, intent(in):: frac_nucl(klon, klev) ! facteur de nucleation
60    
61      REAL, INTENT(IN):: pphis(klon)      REAL, INTENT(IN):: pphis(klon)
62      real paire(klon)      real, intent(in):: paire(klon)
     REAL, INTENT (IN):: dtime  
     INTEGER, INTENT (IN):: itap  
63    
64      ! Variables local to the procedure:      ! Local:
65    
66      real t(klon, klev)      real t(klon, klev)
67      INTEGER, SAVE:: physid      INTEGER, SAVE:: physid
     REAL zx_tmp_3d(iim, jjm+1, klev), zx_tmp_2d(iim, jjm+1)  
68    
69      ! Les Thermiques      ! Les Thermiques
70    
# Line 95  contains Line 90  contains
90      REAL dtcum      REAL dtcum
91    
92      INTEGER:: iadvtr = 0, irec = 1      INTEGER:: iadvtr = 0, irec = 1
     REAL zmin, zmax  
     LOGICAL ok_sync  
93    
94      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
95      SAVE fm_therm, entr_therm      SAVE fm_therm, entr_therm
# Line 106  contains Line 99  contains
99    
100      ! Couche limite:      ! Couche limite:
101    
102      ok_sync = .TRUE.      IF (iadvtr==0) CALL initphysto('phystoke', pdtphys, pdtphys * istphy, &
103             pdtphys * istphy, physid)
     IF (iadvtr==0) THEN  
        CALL initphysto('phystoke', rlon, rlat, dtime, dtime*istphy, &  
             dtime*istphy, physid)  
     END IF  
   
     i = itap  
     CALL gr_fi_ecrit(1, klon, iim, jjm+1, pphis, zx_tmp_2d)  
     CALL histwrite(physid, 'phis', i, zx_tmp_2d)  
   
     i = itap  
     CALL gr_fi_ecrit(1, klon, iim, jjm+1, paire, zx_tmp_2d)  
     CALL histwrite(physid, 'aire', i, zx_tmp_2d)  
104    
105        CALL histwrite(physid, 'phis', itap, gr_phy_write(pphis))
106        CALL histwrite(physid, 'aire', itap, gr_phy_write(paire))
107      iadvtr = iadvtr + 1      iadvtr = iadvtr + 1
108    
109      IF (mod(iadvtr, istphy) == 1 .OR. istphy == 1) THEN      IF (mod(iadvtr, istphy) == 1 .OR. istphy == 1) THEN
# Line 155  contains Line 138  contains
138    
139      DO k = 1, klev      DO k = 1, klev
140         DO i = 1, klon         DO i = 1, klon
141            mfu(i, k) = mfu(i, k) + pmfu(i, k)*pdtphys            mfu(i, k) = mfu(i, k) + pmfu(i, k) * pdtphys
142            mfd(i, k) = mfd(i, k) + pmfd(i, k)*pdtphys            mfd(i, k) = mfd(i, k) + pmfd(i, k) * pdtphys
143            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
144            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
145            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
146            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
147            coefh(i, k) = coefh(i, k) + pcoefh(i, k)*pdtphys            coefh(i, k) = coefh(i, k) + pcoefh(i, k) * pdtphys
148            t(i, k) = t(i, k) + pt(i, k)*pdtphys            t(i, k) = t(i, k) + pt(i, k) * pdtphys
149            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
150            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
151         END DO         END DO
152      END DO      END DO
153      DO i = 1, klon      DO i = 1, klon
154         pyv1(i) = pyv1(i) + yv1(i)*pdtphys         pyv1(i) = pyv1(i) + yv1(i) * pdtphys
155         pyu1(i) = pyu1(i) + yu1(i)*pdtphys         pyu1(i) = pyu1(i) + yu1(i) * pdtphys
156      END DO      END DO
157      DO k = 1, nbsrf      DO k = 1, nbsrf
158         DO i = 1, klon         DO i = 1, klon
159            pftsol(i, k) = pftsol(i, k) + ftsol(i, k)*pdtphys            pftsol(i, k) = pftsol(i, k) + ftsol(i, k) * pdtphys
160            ppsrf(i, k) = ppsrf(i, k) + pctsrf(i, k)*pdtphys            ppsrf(i, k) = ppsrf(i, k) + pctsrf(i, k) * pdtphys
161         END DO         END DO
162      END DO      END DO
163    
# Line 191  contains Line 174  contains
174               en_d(i, k) = en_d(i, k)/dtcum               en_d(i, k) = en_d(i, k)/dtcum
175               de_d(i, k) = de_d(i, k)/dtcum               de_d(i, k) = de_d(i, k)/dtcum
176               coefh(i, k) = coefh(i, k)/dtcum               coefh(i, k) = coefh(i, k)/dtcum
              ! Unitel a enlever  
177               t(i, k) = t(i, k)/dtcum               t(i, k) = t(i, k)/dtcum
178               fm_therm(i, k) = fm_therm(i, k)/dtcum               fm_therm(i, k) = fm_therm(i, k)/dtcum
179               entr_therm(i, k) = entr_therm(i, k)/dtcum               entr_therm(i, k) = entr_therm(i, k)/dtcum
# Line 217  contains Line 199  contains
199            END DO            END DO
200         END DO         END DO
201    
202         ! ecriture des champs         ! \'Ecriture des champs
203    
204         irec = irec + 1         irec = irec + 1
205    
206         CALL gr_fi_ecrit(klev, klon, iim, jjm+1, t, zx_tmp_3d)         CALL histwrite(physid, 't', itap, gr_phy_write(t))
207         CALL histwrite(physid, 't', itap, zx_tmp_3d)         CALL histwrite(physid, 'mfu', itap, gr_phy_write(mfu))
208           CALL histwrite(physid, 'mfd', itap, gr_phy_write(mfd))
209         CALL gr_fi_ecrit(klev, klon, iim, jjm+1, mfu, zx_tmp_3d)         CALL histwrite(physid, 'en_u', itap, gr_phy_write(en_u))
210         CALL histwrite(physid, 'mfu', itap, zx_tmp_3d)         CALL histwrite(physid, 'de_u', itap, gr_phy_write(de_u))
211         CALL gr_fi_ecrit(klev, klon, iim, jjm+1, mfd, zx_tmp_3d)         CALL histwrite(physid, 'en_d', itap, gr_phy_write(en_d))
212         CALL histwrite(physid, 'mfd', itap, zx_tmp_3d)         CALL histwrite(physid, 'de_d', itap, gr_phy_write(de_d))
213         CALL gr_fi_ecrit(klev, klon, iim, jjm+1, en_u, zx_tmp_3d)         CALL histwrite(physid, 'coefh', itap, gr_phy_write(coefh))
        CALL histwrite(physid, 'en_u', itap, zx_tmp_3d)  
        CALL gr_fi_ecrit(klev, klon, iim, jjm+1, de_u, zx_tmp_3d)  
        CALL histwrite(physid, 'de_u', itap, zx_tmp_3d)  
        CALL gr_fi_ecrit(klev, klon, iim, jjm+1, en_d, zx_tmp_3d)  
        CALL histwrite(physid, 'en_d', itap, zx_tmp_3d)  
        CALL gr_fi_ecrit(klev, klon, iim, jjm+1, de_d, zx_tmp_3d)  
        CALL histwrite(physid, 'de_d', itap, zx_tmp_3d)  
        CALL gr_fi_ecrit(klev, klon, iim, jjm+1, coefh, zx_tmp_3d)  
        CALL histwrite(physid, 'coefh', itap, zx_tmp_3d)  
   
214         DO k = 1, klev         DO k = 1, klev
215            DO i = 1, klon            DO i = 1, klon
216               fm_therm1(i, k) = fm_therm(i, k)               fm_therm1(i, k) = fm_therm(i, k)
217            END DO            END DO
218         END DO         END DO
219    
220         CALL gr_fi_ecrit(klev, klon, iim, jjm+1, fm_therm1, zx_tmp_3d)         CALL histwrite(physid, 'fm_th', itap, gr_phy_write(fm_therm1))
221         CALL histwrite(physid, 'fm_th', itap, zx_tmp_3d)         CALL histwrite(physid, 'en_th', itap, gr_phy_write(entr_therm))
222           CALL histwrite(physid, 'frac_impa', itap, gr_phy_write(frac_impa))
223         CALL gr_fi_ecrit(klev, klon, iim, jjm+1, entr_therm, zx_tmp_3d)         CALL histwrite(physid, 'frac_nucl', itap, gr_phy_write(frac_nucl))
224         CALL histwrite(physid, 'en_th', itap, zx_tmp_3d)         CALL histwrite(physid, 'pyu1', itap, gr_phy_write(pyu1))
225         !ccc         CALL histwrite(physid, 'pyv1', itap, gr_phy_write(pyv1))
226         CALL gr_fi_ecrit(klev, klon, iim, jjm+1, frac_impa, zx_tmp_3d)         CALL histwrite(physid, 'ftsol1', itap, gr_phy_write(pftsol1))
227         CALL histwrite(physid, 'frac_impa', itap, zx_tmp_3d)         CALL histwrite(physid, 'ftsol2', itap, gr_phy_write(pftsol2))
228           CALL histwrite(physid, 'ftsol3', itap, gr_phy_write(pftsol3))
229         CALL gr_fi_ecrit(klev, klon, iim, jjm+1, frac_nucl, zx_tmp_3d)         CALL histwrite(physid, 'ftsol4', itap, gr_phy_write(pftsol4))
230         CALL histwrite(physid, 'frac_nucl', itap, zx_tmp_3d)         CALL histwrite(physid, 'psrf1', itap, gr_phy_write(ppsrf1))
231           CALL histwrite(physid, 'psrf2', itap, gr_phy_write(ppsrf2))
232         CALL gr_fi_ecrit(1, klon, iim, jjm+1, pyu1, zx_tmp_2d)         CALL histwrite(physid, 'psrf3', itap, gr_phy_write(ppsrf3))
233         CALL histwrite(physid, 'pyu1', itap, zx_tmp_2d)         CALL histwrite(physid, 'psrf4', itap, gr_phy_write(ppsrf4))
   
        CALL gr_fi_ecrit(1, klon, iim, jjm+1, pyv1, zx_tmp_2d)  
        CALL histwrite(physid, 'pyv1', itap, zx_tmp_2d)  
   
        CALL gr_fi_ecrit(1, klon, iim, jjm+1, pftsol1, zx_tmp_2d)  
        CALL histwrite(physid, 'ftsol1', itap, zx_tmp_2d)  
        CALL gr_fi_ecrit(1, klon, iim, jjm+1, pftsol2, zx_tmp_2d)  
        CALL histwrite(physid, 'ftsol2', itap, zx_tmp_2d)  
        CALL gr_fi_ecrit(1, klon, iim, jjm+1, pftsol3, zx_tmp_2d)  
        CALL histwrite(physid, 'ftsol3', itap, zx_tmp_2d)  
        CALL gr_fi_ecrit(1, klon, iim, jjm+1, pftsol4, zx_tmp_2d)  
        CALL histwrite(physid, 'ftsol4', itap, zx_tmp_2d)  
   
        CALL gr_fi_ecrit(1, klon, iim, jjm+1, ppsrf1, zx_tmp_2d)  
        CALL histwrite(physid, 'psrf1', itap, zx_tmp_2d)  
        CALL gr_fi_ecrit(1, klon, iim, jjm+1, ppsrf2, zx_tmp_2d)  
        CALL histwrite(physid, 'psrf2', itap, zx_tmp_2d)  
        CALL gr_fi_ecrit(1, klon, iim, jjm+1, ppsrf3, zx_tmp_2d)  
        CALL histwrite(physid, 'psrf3', itap, zx_tmp_2d)  
        CALL gr_fi_ecrit(1, klon, iim, jjm+1, ppsrf4, zx_tmp_2d)  
        CALL histwrite(physid, 'psrf4', itap, zx_tmp_2d)  
   
        IF (ok_sync) CALL histsync(physid)  
234    
235         ! 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  
236      END IF      END IF
237    
238    END SUBROUTINE phystokenc    END SUBROUTINE phystokenc
Legend:
Removed from v.178  
changed lines
  Added in v.222
  ViewVC Help
Powered by ViewVC 1.1.21