/[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

trunk/libf/phylmd/phystokenc.f90 revision 51 by guez, Tue Sep 20 09:14:34 2011 UTC trunk/Sources/phylmd/phystokenc.f revision 189 by guez, Tue Mar 29 15:20:23 2016 UTC
# Line 9  contains Line 9  contains
9         frac_impa, frac_nucl, pphis, paire, dtime, itap)         frac_impa, frac_nucl, pphis, paire, dtime, itap)
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édéric Hourdin      ! Author: Fr\'ed\'eric Hourdin
13      ! Objet: moniteur général des tendances traceurs                              ! Objet : \'ecriture des variables pour transport offline
14    
15      USE histwrite_m, ONLY : histwrite      use gr_phy_write_m, only: gr_phy_write
16      USE histcom, ONLY : histsync      USE histwrite_m, ONLY: histwrite
17      USE dimens_m, ONLY : iim, jjm, nqmx      USE histsync_m, ONLY: histsync
18      USE indicesol, ONLY : nbsrf      USE dimens_m, ONLY: iim, jjm
19      USE dimphy, ONLY : klev, klon      USE indicesol, ONLY: nbsrf
20      USE tracstoke, ONLY : istphy      use initphysto_m, only: initphysto
21        USE dimphy, ONLY: klev, klon
22        USE tracstoke, ONLY: istphy
23    
24      ! Arguments:                                                                  REAL, INTENT (IN):: pdtphys ! pas d'integration pour la physique (seconde)
25        REAL, INTENT (IN):: rlon(klon), rlat(klon)
26        REAL, intent(in):: pt(klon, klev)
27    
28      !   EN ENTREE:                                                                ! convection:
29    
30      !   divers:                                                                  REAL, INTENT (IN):: pmfu(klon, klev) ! flux de masse dans le panache montant
31    
32      REAL, INTENT (IN) :: pdtphys ! pas d'integration pour la physique (seconde)      REAL, intent(in):: pmfd(klon, klev)
33      INTEGER, INTENT (IN) :: itap      ! flux de masse dans le panache descendant
34    
35      !   convection:                                                              REAL, intent(in):: pen_u(klon, klev) ! flux entraine dans le panache montant
36        REAL, intent(in):: pde_u(klon, klev) ! flux detraine dans le panache montant
37    
38      REAL pmfu(klon, klev) ! flux de masse dans le panache montant      REAL, intent(in):: pen_d(klon, klev)
39      REAL pmfd(klon, klev) ! flux de masse dans le panache descendant      ! flux entraine dans le panache descendant
     REAL pen_u(klon, klev) ! flux entraine dans le panache montant  
     REAL pde_u(klon, klev) ! flux detraine dans le panache montant  
     REAL pen_d(klon, klev) ! flux entraine dans le panache descendant  
     REAL pde_d(klon, klev) ! flux detraine dans le panache descendant  
     REAL, intent(in):: pt(klon, klev)  
40    
41      REAL, INTENT (IN) :: rlon(klon), rlat(klon)      REAL, intent(in):: pde_d(klon, klev)
42      REAL, INTENT (IN) :: dtime      ! flux detraine dans le panache descendant
43    
44      !   Les Thermiques      ! Les Thermiques
45      REAL pfm_therm(klon, klev+1)      REAL pfm_therm(klon, klev+1)
46      REAL pentr_therm(klon, klev)      REAL pentr_therm(klon, klev)
47    
48      !   Couche limite:                                                            ! Couche limite:
49    
     REAL yv1(klon)  
     REAL yu1(klon), paire(klon)  
     REAL, INTENT(IN):: pphis(klon)  
50      REAL pcoefh(klon, klev) ! coeff melange Couche limite      REAL pcoefh(klon, klev) ! coeff melange Couche limite
51        REAL yu1(klon)
52        REAL yv1(klon)
53    
54      ! Arguments necessaires pour les sources et puits de traceur                  ! Arguments necessaires pour les sources et puits de traceur
55    
56      REAL ftsol(klon, nbsrf) ! Temperature du sol (surf)(Kelvin)      REAL ftsol(klon, nbsrf) ! Temperature du sol (surf)(Kelvin)
57      REAL pctsrf(klon, nbsrf) ! Pourcentage de sol f(nature du sol)      REAL pctsrf(klon, nbsrf) ! Pourcentage de sol f(nature du sol)
58    
59      !   Lessivage:                                                                ! Lessivage:
60    
61      REAL frac_impa(klon, klev)      REAL frac_impa(klon, klev)
62      REAL frac_nucl(klon, klev)      REAL frac_nucl(klon, klev)
63    
64        REAL, INTENT(IN):: pphis(klon)
65        real paire(klon)
66        REAL, INTENT (IN):: dtime
67        INTEGER, INTENT (IN):: itap
68    
69      ! Variables local to the procedure:      ! Variables local to the procedure:
70    
71      real t(klon, klev)      real t(klon, klev)
72      INTEGER, SAVE:: physid      INTEGER, SAVE:: physid
73      REAL zx_tmp_3d(iim, jjm+1, klev), zx_tmp_2d(iim, jjm+1)      REAL zx_tmp_3d(iim, jjm+1, klev), zx_tmp_2d(iim, jjm+1)
74    
75      !   Les Thermiques      ! Les Thermiques
76    
77      REAL fm_therm1(klon, klev)      REAL fm_therm1(klon, klev)
78      REAL entr_therm(klon, klev)      REAL entr_therm(klon, klev)
# Line 76  contains Line 80  contains
80    
81      INTEGER i, k      INTEGER i, k
82    
83      REAL mfu(klon, klev) ! flux de masse dans le panache montant      REAL, save:: mfu(klon, klev) ! flux de masse dans le panache montant
84      REAL mfd(klon, klev) ! flux de masse dans le panache descendant      REAL mfd(klon, klev) ! flux de masse dans le panache descendant
85      REAL en_u(klon, klev) ! flux entraine dans le panache montant      REAL en_u(klon, klev) ! flux entraine dans le panache montant
86      REAL de_u(klon, klev) ! flux detraine dans le panache montant      REAL de_u(klon, klev) ! flux detraine dans le panache montant
# Line 91  contains Line 95  contains
95    
96      REAL dtcum      REAL dtcum
97    
98      INTEGER iadvtr, irec      INTEGER:: iadvtr = 0, irec = 1
99      REAL zmin, zmax      REAL zmin, zmax
100      LOGICAL ok_sync      LOGICAL ok_sync
101    
102      SAVE t, mfu, mfd, en_u, de_u, en_d, de_d, coefh, dtcum      SAVE t, mfd, en_u, de_u, en_d, de_d, coefh, dtcum
103      SAVE fm_therm, entr_therm      SAVE fm_therm, entr_therm
     SAVE iadvtr, irec  
104      SAVE pyu1, pyv1, pftsol, ppsrf      SAVE pyu1, pyv1, pftsol, ppsrf
105    
     DATA iadvtr, irec/0, 1/  
   
106      !------------------------------------------------------      !------------------------------------------------------
107    
108      !   Couche limite:                                                            ! Couche limite:
109    
110      ok_sync = .TRUE.      ok_sync = .TRUE.
111    
112      IF (iadvtr==0) THEN      IF (iadvtr==0) THEN
113         CALL initphysto('phystoke', rlon, rlat, dtime, dtime*istphy, &         CALL initphysto('phystoke', rlon, rlat, dtime, dtime*istphy, &
114              dtime*istphy, nqmx, physid)              dtime*istphy, physid)
115      END IF      END IF
116    
117      i = itap      i = itap
118      CALL gr_fi_ecrit(1, klon, iim, jjm+1, pphis, zx_tmp_2d)      zx_tmp_2d = gr_phy_write(pphis)
119      CALL histwrite(physid, 'phis', i, zx_tmp_2d)      CALL histwrite(physid, 'phis', i, zx_tmp_2d)
120    
121      i = itap      i = itap
122      CALL gr_fi_ecrit(1, klon, iim, jjm+1, paire, zx_tmp_2d)      zx_tmp_2d = gr_phy_write(paire)
123      CALL histwrite(physid, 'aire', i, zx_tmp_2d)      CALL histwrite(physid, 'aire', i, zx_tmp_2d)
124    
125      iadvtr = iadvtr + 1      iadvtr = iadvtr + 1
126    
127      IF (mod(iadvtr, istphy)==1 .OR. istphy==1) THEN      IF (mod(iadvtr, istphy) == 1 .OR. istphy == 1) THEN
128         PRINT *, 'reinitialisation des champs cumules a iadvtr=', iadvtr         PRINT *, 'reinitialisation des champs cumules a iadvtr =', iadvtr
129         DO k = 1, klev         DO k = 1, klev
130            DO i = 1, klon            DO i = 1, klon
131               mfu(i, k) = 0.               mfu(i, k) = 0.
# Line 180  contains Line 181  contains
181    
182      dtcum = dtcum + pdtphys      dtcum = dtcum + pdtphys
183    
184      IF (mod(iadvtr, istphy)==0) THEN      IF (mod(iadvtr, istphy) == 0) THEN
185         !   normalisation par le temps cumule                                           ! normalisation par le temps cumule
186         DO k = 1, klev         DO k = 1, klev
187            DO i = 1, klon            DO i = 1, klon
188               mfu(i, k) = mfu(i, k)/dtcum               mfu(i, k) = mfu(i, k)/dtcum
# Line 214  contains Line 215  contains
215               ppsrf2(i) = ppsrf(i, 2)               ppsrf2(i) = ppsrf(i, 2)
216               ppsrf3(i) = ppsrf(i, 3)               ppsrf3(i) = ppsrf(i, 3)
217               ppsrf4(i) = ppsrf(i, 4)               ppsrf4(i) = ppsrf(i, 4)
   
218            END DO            END DO
219         END DO         END DO
220    
221         !   ecriture des champs                                                         ! ecriture des champs
222    
223         irec = irec + 1         irec = irec + 1
224    
225         !cccc                                                                           zx_tmp_3d = gr_phy_write(t)
        CALL gr_fi_ecrit(klev, klon, iim, jjm+1, t, zx_tmp_3d)  
226         CALL histwrite(physid, 't', itap, zx_tmp_3d)         CALL histwrite(physid, 't', itap, zx_tmp_3d)
227    
228         CALL gr_fi_ecrit(klev, klon, iim, jjm+1, mfu, zx_tmp_3d)         zx_tmp_3d = gr_phy_write(mfu)
229         CALL histwrite(physid, 'mfu', itap, zx_tmp_3d)         CALL histwrite(physid, 'mfu', itap, zx_tmp_3d)
230         CALL gr_fi_ecrit(klev, klon, iim, jjm+1, mfd, zx_tmp_3d)         zx_tmp_3d = gr_phy_write(mfd)
231         CALL histwrite(physid, 'mfd', itap, zx_tmp_3d)         CALL histwrite(physid, 'mfd', itap, zx_tmp_3d)
232         CALL gr_fi_ecrit(klev, klon, iim, jjm+1, en_u, zx_tmp_3d)         zx_tmp_3d = gr_phy_write(en_u)
233         CALL histwrite(physid, 'en_u', itap, zx_tmp_3d)         CALL histwrite(physid, 'en_u', itap, zx_tmp_3d)
234         CALL gr_fi_ecrit(klev, klon, iim, jjm+1, de_u, zx_tmp_3d)         zx_tmp_3d = gr_phy_write(de_u)
235         CALL histwrite(physid, 'de_u', itap, zx_tmp_3d)         CALL histwrite(physid, 'de_u', itap, zx_tmp_3d)
236         CALL gr_fi_ecrit(klev, klon, iim, jjm+1, en_d, zx_tmp_3d)         zx_tmp_3d = gr_phy_write(en_d)
237         CALL histwrite(physid, 'en_d', itap, zx_tmp_3d)         CALL histwrite(physid, 'en_d', itap, zx_tmp_3d)
238         CALL gr_fi_ecrit(klev, klon, iim, jjm+1, de_d, zx_tmp_3d)         zx_tmp_3d = gr_phy_write(de_d)
239         CALL histwrite(physid, 'de_d', itap, zx_tmp_3d)         CALL histwrite(physid, 'de_d', itap, zx_tmp_3d)
240         CALL gr_fi_ecrit(klev, klon, iim, jjm+1, coefh, zx_tmp_3d)         zx_tmp_3d = gr_phy_write(coefh)
241         CALL histwrite(physid, 'coefh', itap, zx_tmp_3d)         CALL histwrite(physid, 'coefh', itap, zx_tmp_3d)
242    
        ! ajou...                                                                
243         DO k = 1, klev         DO k = 1, klev
244            DO i = 1, klon            DO i = 1, klon
245               fm_therm1(i, k) = fm_therm(i, k)               fm_therm1(i, k) = fm_therm(i, k)
246            END DO            END DO
247         END DO         END DO
248    
249         CALL gr_fi_ecrit(klev, klon, iim, jjm+1, fm_therm1, zx_tmp_3d)         zx_tmp_3d = gr_phy_write(fm_therm1)
250         CALL histwrite(physid, 'fm_th', itap, zx_tmp_3d)         CALL histwrite(physid, 'fm_th', itap, zx_tmp_3d)
251    
252         CALL gr_fi_ecrit(klev, klon, iim, jjm+1, entr_therm, zx_tmp_3d)         zx_tmp_3d = gr_phy_write(entr_therm)
253         CALL histwrite(physid, 'en_th', itap, zx_tmp_3d)         CALL histwrite(physid, 'en_th', itap, zx_tmp_3d)
254         !ccc                                                                             !ccc
255         CALL gr_fi_ecrit(klev, klon, iim, jjm+1, frac_impa, zx_tmp_3d)         zx_tmp_3d = gr_phy_write(frac_impa)
256         CALL histwrite(physid, 'frac_impa', itap, zx_tmp_3d)         CALL histwrite(physid, 'frac_impa', itap, zx_tmp_3d)
257    
258         CALL gr_fi_ecrit(klev, klon, iim, jjm+1, frac_nucl, zx_tmp_3d)         zx_tmp_3d = gr_phy_write(frac_nucl)
259         CALL histwrite(physid, 'frac_nucl', itap, zx_tmp_3d)         CALL histwrite(physid, 'frac_nucl', itap, zx_tmp_3d)
260    
261         CALL gr_fi_ecrit(1, klon, iim, jjm+1, pyu1, zx_tmp_2d)         zx_tmp_2d = gr_phy_write(pyu1)
262         CALL histwrite(physid, 'pyu1', itap, zx_tmp_2d)         CALL histwrite(physid, 'pyu1', itap, zx_tmp_2d)
263    
264         CALL gr_fi_ecrit(1, klon, iim, jjm+1, pyv1, zx_tmp_2d)         zx_tmp_2d = gr_phy_write(pyv1)
265         CALL histwrite(physid, 'pyv1', itap, zx_tmp_2d)         CALL histwrite(physid, 'pyv1', itap, zx_tmp_2d)
266    
267         CALL gr_fi_ecrit(1, klon, iim, jjm+1, pftsol1, zx_tmp_2d)         zx_tmp_2d = gr_phy_write(pftsol1)
268         CALL histwrite(physid, 'ftsol1', itap, zx_tmp_2d)         CALL histwrite(physid, 'ftsol1', itap, zx_tmp_2d)
269         CALL gr_fi_ecrit(1, klon, iim, jjm+1, pftsol2, zx_tmp_2d)         zx_tmp_2d = gr_phy_write(pftsol2)
270         CALL histwrite(physid, 'ftsol2', itap, zx_tmp_2d)         CALL histwrite(physid, 'ftsol2', itap, zx_tmp_2d)
271         CALL gr_fi_ecrit(1, klon, iim, jjm+1, pftsol3, zx_tmp_2d)         zx_tmp_2d = gr_phy_write(pftsol3)
272         CALL histwrite(physid, 'ftsol3', itap, zx_tmp_2d)         CALL histwrite(physid, 'ftsol3', itap, zx_tmp_2d)
273         CALL gr_fi_ecrit(1, klon, iim, jjm+1, pftsol4, zx_tmp_2d)         zx_tmp_2d = gr_phy_write(pftsol4)
274         CALL histwrite(physid, 'ftsol4', itap, zx_tmp_2d)         CALL histwrite(physid, 'ftsol4', itap, zx_tmp_2d)
275    
276         CALL gr_fi_ecrit(1, klon, iim, jjm+1, ppsrf1, zx_tmp_2d)         zx_tmp_2d = gr_phy_write(ppsrf1)
277         CALL histwrite(physid, 'psrf1', itap, zx_tmp_2d)         CALL histwrite(physid, 'psrf1', itap, zx_tmp_2d)
278         CALL gr_fi_ecrit(1, klon, iim, jjm+1, ppsrf2, zx_tmp_2d)         zx_tmp_2d = gr_phy_write(ppsrf2)
279         CALL histwrite(physid, 'psrf2', itap, zx_tmp_2d)         CALL histwrite(physid, 'psrf2', itap, zx_tmp_2d)
280         CALL gr_fi_ecrit(1, klon, iim, jjm+1, ppsrf3, zx_tmp_2d)         zx_tmp_2d = gr_phy_write(ppsrf3)
281         CALL histwrite(physid, 'psrf3', itap, zx_tmp_2d)         CALL histwrite(physid, 'psrf3', itap, zx_tmp_2d)
282         CALL gr_fi_ecrit(1, klon, iim, jjm+1, ppsrf4, zx_tmp_2d)         zx_tmp_2d = gr_phy_write(ppsrf4)
283         CALL histwrite(physid, 'psrf4', itap, zx_tmp_2d)         CALL histwrite(physid, 'psrf4', itap, zx_tmp_2d)
284    
285         IF (ok_sync) CALL histsync(physid)         IF (ok_sync) CALL histsync(physid)
        !     if (ok_sync) call histsync                                          
286    
287           ! Test sur la valeur des coefficients de lessivage
        !AA Test sur la valeur des coefficients de lessivage                      
288    
289         zmin = 1E33         zmin = 1E33
290         zmax = -1E33         zmax = -1E33
# Line 298  contains Line 294  contains
294               zmin = min(zmin, frac_nucl(i, k))               zmin = min(zmin, frac_nucl(i, k))
295            END DO            END DO
296         END DO         END DO
297         PRINT *, '------ coefs de lessivage (min et max) --------'         PRINT *, 'coefs de lessivage (min et max)'
298         PRINT *, 'facteur de nucleation ', zmin, zmax         PRINT *, 'facteur de nucleation ', zmin, zmax
299         zmin = 1E33         zmin = 1E33
300         zmax = -1E33         zmax = -1E33
# Line 309  contains Line 305  contains
305            END DO            END DO
306         END DO         END DO
307         PRINT *, 'facteur d impaction ', zmin, zmax         PRINT *, 'facteur d impaction ', zmin, zmax
   
308      END IF      END IF
309    
310    END SUBROUTINE phystokenc    END SUBROUTINE phystokenc
Legend:
Removed from v.51  
changed lines
  Added in v.189
  ViewVC Help
Powered by ViewVC 1.1.21