source: LMDZ.3.3/trunk/libf/phylmd/phystokenc.F @ 178

Last change on this file since 178 was 52, checked in by lmdzadmin, 25 years ago

Ecriture des fluxs dans des fichiers Netcdf utilisant IOIPSL. M.Bonazzola
LF
  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 10.2 KB
RevLine 
[52]1      SUBROUTINE phystokenc (
2     I                   nlon,nlev,pdtphys,rlon,rlat,
3     I                   pmfu, pmfd, pen_u, pde_u, pen_d, pde_d,
4     I                   pcoefh,yu1,yv1,ftsol,pctsrf,
5     I                   frac_impa,frac_nucl,
6     I                   pphis,paire,dtime,itap,
7     O                   physid)
8      USE ioipsl
9
10      IMPLICIT none
11
12c======================================================================
13c Auteur(s) FH
14c Objet: Moniteur general des tendances traceurs
15c
16
17c======================================================================
18#include "dimensions.h"
19#include "dimphy.h"
20#include "tracstoke.h"
21#include "indicesol.h"
22#include "control.h"
23c======================================================================
24
25c Arguments:
26c
27c   EN ENTREE:
28c   ==========
29c
30c   divers:
31c   -------
32c
33      integer nlon ! nombre de points horizontaux
34      integer nlev ! nombre de couches verticales
35      real pdtphys ! pas d'integration pour la physique (seconde)
36c
37      integer physid, itap
38      integer ndex2d(iim*(jjm+1)),ndex3d(iim*(jjm+1)*klev)
39
40c   convection:
41c   -----------
42c
43      REAL pmfu(klon,klev)  ! flux de masse dans le panache montant
44      REAL pmfd(klon,klev)  ! flux de masse dans le panache descendant
45      REAL pen_u(klon,klev) ! flux entraine dans le panache montant
46      REAL pde_u(klon,klev) ! flux detraine dans le panache montant
47      REAL pen_d(klon,klev) ! flux entraine dans le panache descendant
48      REAL pde_d(klon,klev) ! flux detraine dans le panache descendant
49c
50      REAL rlon(klon), rlat(klon), dtime
51      REAL zx_tmp_3d(iim,jjm+1,klev),zx_tmp_2d(iim,jjm+1)
52
53c   Couche limite:
54c   --------------
55c
56      REAL pcoefh(klon,klev)    ! coeff melange CL
57      REAL yv1(klon)
58      REAL yu1(klon),pphis(klon),paire(klon)
59c
60c   Lessivage:
61c   ----------
62c
63      REAL frac_impa(klon,klev)
64      REAL frac_nucl(klon,klev)
65c
66c Arguments necessaires pour les sources et puits de traceur
67C
68      real ftsol(klon,nbsrf)  ! Temperature du sol (surf)(Kelvin)
69      real pctsrf(klon,nbsrf) ! Pourcentage de sol f(nature du sol)
70c======================================================================
71c
72      INTEGER i, k
73c
74      REAL mfu(klon,klev)  ! flux de masse dans le panache montant
75      REAL mfd(klon,klev)  ! flux de masse dans le panache descendant
76      REAL en_u(klon,klev) ! flux entraine dans le panache montant
77      REAL de_u(klon,klev) ! flux detraine dans le panache montant
78      REAL en_d(klon,klev) ! flux entraine dans le panache descendant
79      REAL de_d(klon,klev) ! flux detraine dans le panache descendant
80      REAL coefh(klon,klev) ! flux detraine dans le panache descendant
81
82      REAL pyu1(klon),pyv1(klon)
83      REAL pftsol(klon,nbsrf),ppsrf(klon,nbsrf)
84      real pftsol1(klon),pftsol2(klon),pftsol3(klon),pftsol4(klon)
85      real ppsrf1(klon),ppsrf2(klon),ppsrf3(klon),ppsrf4(klon)
86
87      REAL dtcum
88
89      integer iadvtr,irec
90      real zmin,zmax
91      logical ok_sync
92 
93      save mfu,mfd,en_u,de_u,en_d,de_d,coefh,dtcum
94      save iadvtr,irec
95      save pyu1,pyv1,pftsol,ppsrf
96
97      data iadvtr,irec/0,1/
98c
99c   Couche limite:
100c======================================================================
101
102      ok_sync = .true.
103
104c     print*,'iadvtr= ',iadvtr
105c     print*,'istphy= ',istphy
106c     print*,'istdyn= ',istdyn
107
108      IF (iadvtr.eq.0) THEN
109       
110        CALL initphysto('phystoke',
111     . rlon,rlat,dtime, dtime*istphy,dtime*istphy,nqmx,physid)
112       
113c       write(*,*) 'apres initphysto ds phystokenc'
114
115       
116      ENDIF
117c
118      ndex2d = 0
119      ndex3d = 0
120      i=itap
121      CALL gr_fi_ecrit(1,klon,iim,jjm+1,pphis,zx_tmp_2d)
122      CALL histwrite(physid,"phis",i,zx_tmp_2d,iim*(jjm+1),ndex2d)
123c
124      i=itap
125      CALL gr_fi_ecrit(1,klon,iim,jjm+1,paire,zx_tmp_2d)
126      CALL histwrite(physid,"aire",i,zx_tmp_2d,iim*(jjm+1),ndex2d)
127
128      iadvtr=iadvtr+1
129c
130      IF(mod(iadvtr,istphy).eq.0) THEN
131c
132c   normalisation par le temps cumule
133         do k=1,klev
134            do i=1,klon
135               mfu(i,k)=mfu(i,k)/dtcum
136               mfd(i,k)=mfd(i,k)/dtcum
137               en_u(i,k)=en_u(i,k)/dtcum
138               de_u(i,k)=de_u(i,k)/dtcum
139               en_d(i,k)=en_d(i,k)/dtcum
140               de_d(i,k)=de_d(i,k)/dtcum
141               coefh(i,k)=coefh(i,k)/dtcum
142            enddo
143         enddo
144         do i=1,klon
145            pyv1(i)=pyv1(i)/dtcum
146            pyu1(i)=pyu1(i)/dtcum
147         end do
148         do k=1,nbsrf
149             do i=1,klon
150               pftsol(i,k)=pftsol(i,k)/dtcum
151               pftsol1(i) = pftsol(i,1)
152               pftsol2(i) = pftsol(i,2)
153               pftsol3(i) = pftsol(i,3)
154               pftsol4(i) = pftsol(i,4)
155
156               ppsrf(i,k)=ppsrf(i,k)/dtcum
157               ppsrf1(i) = ppsrf(i,1)
158               ppsrf2(i) = ppsrf(i,2)
159               ppsrf3(i) = ppsrf(i,3)
160               ppsrf4(i) = ppsrf(i,4)
161
162            enddo
163         enddo
164c
165c   ecriture des champs
166c
167         irec=irec+1
168
169ccccc
170         CALL gr_fi_ecrit(klev,klon,iim,jjm+1, mfu, zx_tmp_3d)
171      CALL histwrite(physid,"mfu",itap,zx_tmp_3d,
172     .                                   iim*(jjm+1)*klev,ndex3d)
173        CALL gr_fi_ecrit(klev,klon,iim,jjm+1, mfd, zx_tmp_3d)
174      CALL histwrite(physid,"mfd",itap,zx_tmp_3d,
175     .                                   iim*(jjm+1)*klev,ndex3d)
176        CALL gr_fi_ecrit(klev,klon,iim,jjm+1, en_u, zx_tmp_3d)
177      CALL histwrite(physid,"en_u",itap,zx_tmp_3d,
178     .                                   iim*(jjm+1)*klev,ndex3d)
179        CALL gr_fi_ecrit(klev,klon,iim,jjm+1, de_u, zx_tmp_3d)
180      CALL histwrite(physid,"de_u",itap,zx_tmp_3d,
181     .                                   iim*(jjm+1)*klev,ndex3d)
182        CALL gr_fi_ecrit(klev,klon,iim,jjm+1, en_d, zx_tmp_3d)
183      CALL histwrite(physid,"en_d",itap,zx_tmp_3d,
184     .                                   iim*(jjm+1)*klev,ndex3d)
185        CALL gr_fi_ecrit(klev,klon,iim,jjm+1, de_d, zx_tmp_3d)       
186      CALL histwrite(physid,"de_d",itap,zx_tmp_3d,   
187     .                                   iim*(jjm+1)*klev,ndex3d)
188        CALL gr_fi_ecrit(klev,klon,iim,jjm+1, coefh, zx_tmp_3d)         
189      CALL histwrite(physid,"coefh",itap,zx_tmp_3d,   
190     .                                   iim*(jjm+1)*klev,ndex3d)       
191cccc
192       CALL gr_fi_ecrit(klev,klon,iim,jjm+1,frac_impa,zx_tmp_3d)
193        CALL histwrite(physid,"frac_impa",itap,zx_tmp_3d,
194     .  iim*(jjm+1)*klev,ndex3d)
195
196        CALL gr_fi_ecrit(klev,klon,iim,jjm+1,frac_nucl,zx_tmp_3d)
197        CALL histwrite(physid,"frac_nucl",itap,zx_tmp_3d,
198     .  iim*(jjm+1)*klev,ndex3d)
199 
200        CALL gr_fi_ecrit(1, klon,iim,jjm+1, pyu1,zx_tmp_2d)
201      CALL histwrite(physid,"pyu1",itap,zx_tmp_2d,iim*(jjm+1),
202     .                                                ndex2d)
203       
204        CALL gr_fi_ecrit(1, klon,iim,jjm+1, pyv1,zx_tmp_2d)
205      CALL histwrite(physid,"pyv1",itap,zx_tmp_2d,iim*(jjm+1)
206     .                                                ,ndex2d)
207       
208        CALL gr_fi_ecrit(1,klon,iim,jjm+1, pftsol1, zx_tmp_2d)
209      CALL histwrite(physid,"ftsol1",itap,zx_tmp_2d,
210     .                                   iim*(jjm+1),ndex2d)
211         CALL gr_fi_ecrit(1,klon,iim,jjm+1, pftsol2, zx_tmp_2d)
212      CALL histwrite(physid,"ftsol2",itap,zx_tmp_2d,
213     .                                   iim*(jjm+1),ndex2d)
214          CALL gr_fi_ecrit(1,klon,iim,jjm+1, pftsol3, zx_tmp_2d)
215      CALL histwrite(physid,"ftsol3",itap,zx_tmp_2d,
216     .                                   iim*(jjm+1),ndex2d)
217         CALL gr_fi_ecrit(1,klon,iim,jjm+1, pftsol4, zx_tmp_2d)
218      CALL histwrite(physid,"ftsol4",itap,zx_tmp_2d,
219     .                                   iim*(jjm+1),ndex2d)
220
221        CALL gr_fi_ecrit(1,klon,iim,jjm+1, ppsrf1, zx_tmp_2d)
222      CALL histwrite(physid,"psrf1",itap,zx_tmp_2d,   
223     .                                   iim*(jjm+1),ndex2d)
224        CALL gr_fi_ecrit(1,klon,iim,jjm+1, ppsrf2, zx_tmp_2d)
225      CALL histwrite(physid,"psrf2",itap,zx_tmp_2d,
226     .                                   iim*(jjm+1),ndex2d)
227        CALL gr_fi_ecrit(1,klon,iim,jjm+1, ppsrf3, zx_tmp_2d)
228      CALL histwrite(physid,"psrf3",itap,zx_tmp_2d,
229     .                                   iim*(jjm+1),ndex2d)
230        CALL gr_fi_ecrit(1,klon,iim,jjm+1, ppsrf4, zx_tmp_2d)
231      CALL histwrite(physid,"psrf4",itap,zx_tmp_2d,
232     .                                   iim*(jjm+1),ndex2d)
233
234      if (ok_sync) call histsync(physid)
235       
236c
237cAA Test sur la valeur des coefficients de lessivage
238c
239         zmin=1e33
240         zmax=-1e33
241         do k=1,klev
242            do i=1,klon
243                  zmax=max(zmax,frac_nucl(i,k))
244                  zmin=min(zmin,frac_nucl(i,k))
245            enddo
246         enddo
247         Print*,'------ coefs de lessivage (min et max) --------'
248         Print*,'facteur de nucleation ',zmin,zmax
249         zmin=1e33
250         zmax=-1e33
251         do k=1,klev
252            do i=1,klon
253                  zmax=max(zmax,frac_impa(i,k))
254                  zmin=min(zmin,frac_impa(i,k))
255            enddo
256         enddo
257         Print*,'facteur d impaction ',zmin,zmax
258
259      ENDIF
260
261c   reinitialisation des champs cumules
262      if (mod(iadvtr,istphy).eq.1) then
263         do k=1,klev
264            do i=1,klon
265               mfu(i,k)=0.
266               mfd(i,k)=0.
267               en_u(i,k)=0.
268               de_u(i,k)=0.
269               en_d(i,k)=0.
270               de_d(i,k)=0.
271               coefh(i,k)=0.
272            enddo
273         enddo
274         do i=1,klon
275            pyv1(i)=0.
276            pyu1(i)=0.
277         end do
278         do k=1,nbsrf
279             do i=1,klon
280               pftsol(i,k)=0.
281               ppsrf(i,k)=0.
282            enddo
283         enddo
284
285         dtcum=0.
286      endif
287
288      do k=1,klev
289         do i=1,klon
290            mfu(i,k)=mfu(i,k)+pmfu(i,k)*pdtphys
291            mfd(i,k)=mfd(i,k)+pmfd(i,k)*pdtphys
292            en_u(i,k)=en_u(i,k)+pen_u(i,k)*pdtphys
293            de_u(i,k)=de_u(i,k)+pde_u(i,k)*pdtphys
294            en_d(i,k)=en_d(i,k)+pen_d(i,k)*pdtphys
295            de_d(i,k)=de_d(i,k)+pde_d(i,k)*pdtphys
296            coefh(i,k)=coefh(i,k)+pcoefh(i,k)*pdtphys
297         enddo
298      enddo
299         do i=1,klon
300            pyv1(i)=pyv1(i)+yv1(i)*pdtphys
301            pyu1(i)=pyu1(i)+yu1(i)*pdtphys
302         end do
303         do k=1,nbsrf
304             do i=1,klon
305               pftsol(i,k)=pftsol(i,k)+ftsol(i,k)*pdtphys
306               ppsrf(i,k)=ppsrf(i,k)+pctsrf(i,k)*pdtphys
307            enddo
308         enddo
309
310      dtcum=dtcum+pdtphys
311
312      RETURN
313      END
Note: See TracBrowser for help on using the repository browser.