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

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

Parent Directory Parent Directory | Revision Log Revision Log

Revision 7 - (hide annotations)
Mon Mar 31 12:24:17 2008 UTC (16 years, 1 month ago) by guez
File size: 13561 byte(s) 
This revision is not in working order. Pending some moving of files.

Important changes. In the program "etat0_lim": ozone coefficients from
Mobidic are regridded in time instead of pressure ; consequences in
"etat0". In the program "gcm", ozone coefficients from Mobidic are
read once per day only for the current day and regridded in pressure ;
consequences in "o3_chem_m", "regr_pr_coefoz", "phytrac" and
"regr_pr_comb_coefoz_m".

NetCDF95 is a library and does not export NetCDF.

New variables "nag_gl_options", "nag_fcalls_options" and
"nag_cross_options" in "nag_tools.mk".

"check_coefoz.jnl" rewritten entirely for new version of
"coefoz_LMDZ.nc".

Target "obj_etat0_lim" moved from "GNUmakefile" to "nag_rules.mk".

Added some "intent" attributes in "calfis", "clmain", "clqh",
"cltrac", "cltracrn", "cvltr", "ini_undefSTD", "moy_undefSTD",
"nflxtr", "phystokenc", "phytrac", "readsulfate", "readsulfate_preind"
and "undefSTD".

In "dynetat0", "dynredem0" and "gcm", "phis" has rank 2 instead of
1. "phis" has assumed shape in "dynredem0".

Added module containing "dynredem0". Changed some calls with NetCDF
Fortran 77 interface to calls with NetCDF95 interface.

Replaced calls to "ssum" by calls to "sum" in "inigeom".

In "make.sh", new option "-c" to change compiler.

In "aaam_bud", argument "rjour" deleted.

In "physiq": renamed some variables; deleted variable "xjour".

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