/[lmdze]/trunk/libf/phylmd/phystokenc.f90
ViewVC logotype

Annotation of /trunk/libf/phylmd/phystokenc.f90

Parent Directory Parent Directory | Revision Log Revision Log


Revision 15 - (hide annotations)
Fri Aug 1 15:24:12 2008 UTC (15 years, 9 months ago) by guez
Original Path: trunk/libf/phylmd/phystokenc.f
File size: 12164 byte(s)
-- Minor modification of input/output:

Added variable "Sigma_O3_Royer" to "histday.nc". "ecrit_day" is not
modified in "physiq". Removed variables "pyu1", "pyv1", "ftsol1",
"ftsol2", "ftsol3", "ftsol4", "psrf1", "psrf2", "psrf3", "psrf4"
"mfu", "mfd", "en_u", "en_d", "de_d", "de_u", "coefh" from
"histrac.nc".

Variable "raz_date" of module "conf_gcm_m" has logical type instead of
integer type.

-- Should not change any result at run time:

Modified calls to "IOIPSL_Lionel" procedures because the interfaces of
these procedures have been simplified.

Changed name of variable in module "start_init_orog_m": "masque" to
"mask".

Created a module containing procedure "phyredem".

Removed arguments "punjours", "pdayref" and "ptimestep" of procedure
"iniphysiq".

Renamed procedure "gr_phy_write" to "gr_phy_write_2d". Created
procedure "gr_phy_write_3d".

Removed procedures "ini_undefstd", "moy_undefSTD", "calcul_STDlev",
"calcul_divers".

1 guez 3 !
2     ! $Header: /home/cvsroot/LMDZ4/libf/phylmd/phystokenc.F,v 1.2 2004/06/22 11:45:35 lmdzadmin Exp $
3     !
4     c
5     c
6     SUBROUTINE phystokenc (
7     I pdtphys,rlon,rlat,
8     I pt,pmfu, pmfd, pen_u, pde_u, pen_d, pde_d,
9     I pfm_therm,pentr_therm,
10     I pcoefh,yu1,yv1,ftsol,pctsrf,
11     I frac_impa,frac_nucl,
12     I pphis,paire,dtime,itap)
13     USE ioipsl
14     use dimens_m
15     use indicesol
16     use dimphy
17     use conf_gcm_m
18     use tracstoke
19     IMPLICIT none
20    
21     c======================================================================
22     c Auteur(s) FH
23     c Objet: Moniteur general des tendances traceurs
24     c
25    
26     c======================================================================
27     c======================================================================
28    
29     c Arguments:
30     c
31     c EN ENTREE:
32     c ==========
33     c
34     c divers:
35     c -------
36     c
37 guez 12 real, intent(in):: pdtphys ! pas d'integration pour la physique (seconde)
38 guez 3 c
39 guez 7 integer physid
40     integer, intent(in):: itap
41 guez 3 save physid
42     integer ndex2d(iim*(jjm+1)),ndex3d(iim*(jjm+1)*klev)
43    
44     c convection:
45     c -----------
46     c
47     REAL pmfu(klon,klev) ! flux de masse dans le panache montant
48     REAL pmfd(klon,klev) ! flux de masse dans le panache descendant
49     REAL pen_u(klon,klev) ! flux entraine dans le panache montant
50     REAL pde_u(klon,klev) ! flux detraine dans le panache montant
51     REAL pen_d(klon,klev) ! flux entraine dans le panache descendant
52     REAL pde_d(klon,klev) ! flux detraine dans le panache descendant
53     real pt(klon,klev),t(klon,klev)
54     c
55     REAL, intent(in):: rlon(klon), rlat(klon)
56 guez 12 real, intent(in):: dtime
57 guez 3 REAL zx_tmp_3d(iim,jjm+1,klev),zx_tmp_2d(iim,jjm+1)
58    
59     c Couche limite:
60     c --------------
61     c
62     REAL pcoefh(klon,klev) ! coeff melange CL
63     REAL yv1(klon)
64     REAL yu1(klon),pphis(klon),paire(klon)
65    
66     c Les Thermiques : (Abderr 25 11 02)
67     c ---------------
68     REAL pfm_therm(klon,klev+1)
69     real fm_therm1(klon,klev)
70     REAL pentr_therm(klon,klev)
71     REAL entr_therm(klon,klev)
72     REAL fm_therm(klon,klev)
73     c
74     c Lessivage:
75     c ----------
76     c
77     REAL frac_impa(klon,klev)
78     REAL frac_nucl(klon,klev)
79     c
80     c Arguments necessaires pour les sources et puits de traceur
81     C
82     real ftsol(klon,nbsrf) ! Temperature du sol (surf)(Kelvin)
83     real pctsrf(klon,nbsrf) ! Pourcentage de sol f(nature du sol)
84     c======================================================================
85     c
86     INTEGER i, k
87     c
88     REAL mfu(klon,klev) ! flux de masse dans le panache montant
89     REAL mfd(klon,klev) ! flux de masse dans le panache descendant
90     REAL en_u(klon,klev) ! flux entraine dans le panache montant
91     REAL de_u(klon,klev) ! flux detraine dans le panache montant
92     REAL en_d(klon,klev) ! flux entraine dans le panache descendant
93     REAL de_d(klon,klev) ! flux detraine dans le panache descendant
94     REAL coefh(klon,klev) ! flux detraine dans le panache descendant
95    
96     REAL pyu1(klon),pyv1(klon)
97     REAL pftsol(klon,nbsrf),ppsrf(klon,nbsrf)
98     real pftsol1(klon),pftsol2(klon),pftsol3(klon),pftsol4(klon)
99     real ppsrf1(klon),ppsrf2(klon),ppsrf3(klon),ppsrf4(klon)
100    
101     REAL dtcum
102    
103     integer iadvtr,irec
104     real zmin,zmax
105     logical ok_sync
106    
107     save t,mfu,mfd,en_u,de_u,en_d,de_d,coefh,dtcum
108     save fm_therm,entr_therm
109     save iadvtr,irec
110     save pyu1,pyv1,pftsol,ppsrf
111    
112     data iadvtr,irec/0,1/
113     c
114     c Couche limite:
115     c======================================================================
116    
117     ok_sync = .true.
118     print*,'Dans phystokenc.F'
119     print*,'iadvtr= ',iadvtr
120     print*,'istphy= ',istphy
121     print*,'istdyn= ',istdyn
122    
123     IF (iadvtr.eq.0) THEN
124    
125     CALL initphysto('phystoke',
126     . rlon,rlat,dtime, dtime*istphy,dtime*istphy,nqmx,physid)
127    
128     write(*,*) 'apres initphysto ds phystokenc'
129    
130    
131     ENDIF
132     c
133     ndex2d = 0
134     ndex3d = 0
135     i=itap
136     CALL gr_fi_ecrit(1,klon,iim,jjm+1,pphis,zx_tmp_2d)
137 guez 15 CALL histwrite(physid,"phis",i,zx_tmp_2d)
138 guez 3 c
139     i=itap
140     CALL gr_fi_ecrit(1,klon,iim,jjm+1,paire,zx_tmp_2d)
141 guez 15 CALL histwrite(physid,"aire",i,zx_tmp_2d)
142 guez 3
143     iadvtr=iadvtr+1
144     c
145     if (mod(iadvtr,istphy).eq.1.or.istphy.eq.1) then
146     print*,'reinitialisation des champs cumules
147     s a iadvtr=',iadvtr
148     do k=1,klev
149     do i=1,klon
150     mfu(i,k)=0.
151     mfd(i,k)=0.
152     en_u(i,k)=0.
153     de_u(i,k)=0.
154     en_d(i,k)=0.
155     de_d(i,k)=0.
156     coefh(i,k)=0.
157     t(i,k)=0.
158     fm_therm(i,k)=0.
159     entr_therm(i,k)=0.
160     enddo
161     enddo
162     do i=1,klon
163     pyv1(i)=0.
164     pyu1(i)=0.
165     end do
166     do k=1,nbsrf
167     do i=1,klon
168     pftsol(i,k)=0.
169     ppsrf(i,k)=0.
170     enddo
171     enddo
172    
173     dtcum=0.
174     endif
175    
176     do k=1,klev
177     do i=1,klon
178     mfu(i,k)=mfu(i,k)+pmfu(i,k)*pdtphys
179     mfd(i,k)=mfd(i,k)+pmfd(i,k)*pdtphys
180     en_u(i,k)=en_u(i,k)+pen_u(i,k)*pdtphys
181     de_u(i,k)=de_u(i,k)+pde_u(i,k)*pdtphys
182     en_d(i,k)=en_d(i,k)+pen_d(i,k)*pdtphys
183     de_d(i,k)=de_d(i,k)+pde_d(i,k)*pdtphys
184     coefh(i,k)=coefh(i,k)+pcoefh(i,k)*pdtphys
185     t(i,k)=t(i,k)+pt(i,k)*pdtphys
186     fm_therm(i,k)=fm_therm(i,k)+pfm_therm(i,k)*pdtphys
187     entr_therm(i,k)=entr_therm(i,k)+pentr_therm(i,k)*pdtphys
188     enddo
189     enddo
190     do i=1,klon
191     pyv1(i)=pyv1(i)+yv1(i)*pdtphys
192     pyu1(i)=pyu1(i)+yu1(i)*pdtphys
193     end do
194     do k=1,nbsrf
195     do i=1,klon
196     pftsol(i,k)=pftsol(i,k)+ftsol(i,k)*pdtphys
197     ppsrf(i,k)=ppsrf(i,k)+pctsrf(i,k)*pdtphys
198     enddo
199     enddo
200    
201     dtcum=dtcum+pdtphys
202    
203     IF(mod(iadvtr,istphy).eq.0) THEN
204     c
205     c normalisation par le temps cumule
206     do k=1,klev
207     do i=1,klon
208     mfu(i,k)=mfu(i,k)/dtcum
209     mfd(i,k)=mfd(i,k)/dtcum
210     en_u(i,k)=en_u(i,k)/dtcum
211     de_u(i,k)=de_u(i,k)/dtcum
212     en_d(i,k)=en_d(i,k)/dtcum
213     de_d(i,k)=de_d(i,k)/dtcum
214     coefh(i,k)=coefh(i,k)/dtcum
215     c Unitel a enlever
216     t(i,k)=t(i,k)/dtcum
217     fm_therm(i,k)=fm_therm(i,k)/dtcum
218     entr_therm(i,k)=entr_therm(i,k)/dtcum
219     enddo
220     enddo
221     do i=1,klon
222     pyv1(i)=pyv1(i)/dtcum
223     pyu1(i)=pyu1(i)/dtcum
224     end do
225     do k=1,nbsrf
226     do i=1,klon
227     pftsol(i,k)=pftsol(i,k)/dtcum
228     pftsol1(i) = pftsol(i,1)
229     pftsol2(i) = pftsol(i,2)
230     pftsol3(i) = pftsol(i,3)
231     pftsol4(i) = pftsol(i,4)
232    
233     ppsrf(i,k)=ppsrf(i,k)/dtcum
234     ppsrf1(i) = ppsrf(i,1)
235     ppsrf2(i) = ppsrf(i,2)
236     ppsrf3(i) = ppsrf(i,3)
237     ppsrf4(i) = ppsrf(i,4)
238    
239     enddo
240     enddo
241     c
242     c ecriture des champs
243     c
244     irec=irec+1
245    
246     ccccc
247     CALL gr_fi_ecrit(klev,klon,iim,jjm+1, t, zx_tmp_3d)
248 guez 15 CALL histwrite(physid,"t",itap,zx_tmp_3d)
249 guez 3
250     CALL gr_fi_ecrit(klev,klon,iim,jjm+1, mfu, zx_tmp_3d)
251 guez 15 CALL histwrite(physid,"mfu",itap,zx_tmp_3d)
252 guez 3 CALL gr_fi_ecrit(klev,klon,iim,jjm+1, mfd, zx_tmp_3d)
253 guez 15 CALL histwrite(physid,"mfd",itap,zx_tmp_3d)
254 guez 3 CALL gr_fi_ecrit(klev,klon,iim,jjm+1, en_u, zx_tmp_3d)
255 guez 15 CALL histwrite(physid,"en_u",itap,zx_tmp_3d)
256 guez 3 CALL gr_fi_ecrit(klev,klon,iim,jjm+1, de_u, zx_tmp_3d)
257 guez 15 CALL histwrite(physid,"de_u",itap,zx_tmp_3d)
258 guez 3 CALL gr_fi_ecrit(klev,klon,iim,jjm+1, en_d, zx_tmp_3d)
259 guez 15 CALL histwrite(physid,"en_d",itap,zx_tmp_3d)
260 guez 3 CALL gr_fi_ecrit(klev,klon,iim,jjm+1, de_d, zx_tmp_3d)
261 guez 15 CALL histwrite(physid,"de_d",itap,zx_tmp_3d)
262 guez 3 CALL gr_fi_ecrit(klev,klon,iim,jjm+1, coefh, zx_tmp_3d)
263 guez 15 CALL histwrite(physid,"coefh",itap,zx_tmp_3d)
264 guez 3
265     c ajou...
266     do k=1,klev
267     do i=1,klon
268     fm_therm1(i,k)=fm_therm(i,k)
269     enddo
270     enddo
271    
272     CALL gr_fi_ecrit(klev,klon,iim,jjm+1, fm_therm1, zx_tmp_3d)
273 guez 15 CALL histwrite(physid,"fm_th",itap,zx_tmp_3d)
274 guez 3 c
275     CALL gr_fi_ecrit(klev,klon,iim,jjm+1, entr_therm, zx_tmp_3d)
276 guez 15 CALL histwrite(physid,"en_th",itap,zx_tmp_3d)
277 guez 3 cccc
278     CALL gr_fi_ecrit(klev,klon,iim,jjm+1,frac_impa,zx_tmp_3d)
279 guez 15 CALL histwrite(physid,"frac_impa",itap,zx_tmp_3d)
280 guez 3
281     CALL gr_fi_ecrit(klev,klon,iim,jjm+1,frac_nucl,zx_tmp_3d)
282 guez 15 CALL histwrite(physid,"frac_nucl",itap,zx_tmp_3d)
283 guez 3
284     CALL gr_fi_ecrit(1, klon,iim,jjm+1, pyu1,zx_tmp_2d)
285 guez 15 CALL histwrite(physid,"pyu1",itap,zx_tmp_2d)
286 guez 3
287     CALL gr_fi_ecrit(1, klon,iim,jjm+1, pyv1,zx_tmp_2d)
288 guez 15 CALL histwrite(physid,"pyv1",itap,zx_tmp_2d)
289 guez 3
290     CALL gr_fi_ecrit(1,klon,iim,jjm+1, pftsol1, zx_tmp_2d)
291 guez 15 CALL histwrite(physid,"ftsol1",itap,zx_tmp_2d)
292 guez 3 CALL gr_fi_ecrit(1,klon,iim,jjm+1, pftsol2, zx_tmp_2d)
293 guez 15 CALL histwrite(physid,"ftsol2",itap,zx_tmp_2d)
294 guez 3 CALL gr_fi_ecrit(1,klon,iim,jjm+1, pftsol3, zx_tmp_2d)
295 guez 15 CALL histwrite(physid,"ftsol3",itap,zx_tmp_2d)
296 guez 3 CALL gr_fi_ecrit(1,klon,iim,jjm+1, pftsol4, zx_tmp_2d)
297 guez 15 CALL histwrite(physid,"ftsol4",itap,zx_tmp_2d)
298 guez 3
299     CALL gr_fi_ecrit(1,klon,iim,jjm+1, ppsrf1, zx_tmp_2d)
300 guez 15 CALL histwrite(physid,"psrf1",itap,zx_tmp_2d)
301 guez 3 CALL gr_fi_ecrit(1,klon,iim,jjm+1, ppsrf2, zx_tmp_2d)
302 guez 15 CALL histwrite(physid,"psrf2",itap,zx_tmp_2d)
303 guez 3 CALL gr_fi_ecrit(1,klon,iim,jjm+1, ppsrf3, zx_tmp_2d)
304 guez 15 CALL histwrite(physid,"psrf3",itap,zx_tmp_2d)
305 guez 3 CALL gr_fi_ecrit(1,klon,iim,jjm+1, ppsrf4, zx_tmp_2d)
306 guez 15 CALL histwrite(physid,"psrf4",itap,zx_tmp_2d)
307 guez 3
308     if (ok_sync) call histsync(physid)
309     c if (ok_sync) call histsync
310    
311     c
312     cAA Test sur la valeur des coefficients de lessivage
313     c
314     zmin=1e33
315     zmax=-1e33
316     do k=1,klev
317     do i=1,klon
318     zmax=max(zmax,frac_nucl(i,k))
319     zmin=min(zmin,frac_nucl(i,k))
320     enddo
321     enddo
322     Print*,'------ coefs de lessivage (min et max) --------'
323     Print*,'facteur de nucleation ',zmin,zmax
324     zmin=1e33
325     zmax=-1e33
326     do k=1,klev
327     do i=1,klon
328     zmax=max(zmax,frac_impa(i,k))
329     zmin=min(zmin,frac_impa(i,k))
330     enddo
331     enddo
332     Print*,'facteur d impaction ',zmin,zmax
333    
334     ENDIF
335    
336     c reinitialisation des champs cumules
337     go to 768
338     if (mod(iadvtr,istphy).eq.1) then
339     do k=1,klev
340     do i=1,klon
341     mfu(i,k)=0.
342     mfd(i,k)=0.
343     en_u(i,k)=0.
344     de_u(i,k)=0.
345     en_d(i,k)=0.
346     de_d(i,k)=0.
347     coefh(i,k)=0.
348     t(i,k)=0.
349     fm_therm(i,k)=0.
350     entr_therm(i,k)=0.
351     enddo
352     enddo
353     do i=1,klon
354     pyv1(i)=0.
355     pyu1(i)=0.
356     end do
357     do k=1,nbsrf
358     do i=1,klon
359     pftsol(i,k)=0.
360     ppsrf(i,k)=0.
361     enddo
362     enddo
363    
364     dtcum=0.
365     endif
366    
367     do k=1,klev
368     do i=1,klon
369     mfu(i,k)=mfu(i,k)+pmfu(i,k)*pdtphys
370     mfd(i,k)=mfd(i,k)+pmfd(i,k)*pdtphys
371     en_u(i,k)=en_u(i,k)+pen_u(i,k)*pdtphys
372     de_u(i,k)=de_u(i,k)+pde_u(i,k)*pdtphys
373     en_d(i,k)=en_d(i,k)+pen_d(i,k)*pdtphys
374     de_d(i,k)=de_d(i,k)+pde_d(i,k)*pdtphys
375     coefh(i,k)=coefh(i,k)+pcoefh(i,k)*pdtphys
376     t(i,k)=t(i,k)+pt(i,k)*pdtphys
377     fm_therm(i,k)=fm_therm(i,k)+pfm_therm(i,k)*pdtphys
378     entr_therm(i,k)=entr_therm(i,k)+pentr_therm(i,k)*pdtphys
379     enddo
380     enddo
381     do i=1,klon
382     pyv1(i)=pyv1(i)+yv1(i)*pdtphys
383     pyu1(i)=pyu1(i)+yu1(i)*pdtphys
384     end do
385     do k=1,nbsrf
386     do i=1,klon
387     pftsol(i,k)=pftsol(i,k)+ftsol(i,k)*pdtphys
388     ppsrf(i,k)=ppsrf(i,k)+pctsrf(i,k)*pdtphys
389     enddo
390     enddo
391    
392     dtcum=dtcum+pdtphys
393     768 continue
394    
395     RETURN
396     END

  ViewVC Help
Powered by ViewVC 1.1.21