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

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

Parent Directory Parent Directory | Revision Log Revision Log

Revision 12 - (hide annotations)
Mon Jul 21 16:05:07 2008 UTC (15 years, 10 months ago) by guez
File size: 13570 byte(s) 
-- Minor modification of input/output:

Created procedure "read_logic". Variables of module "logic" are read
by "read_logic" instead of "conf_gcm". Variable "offline" of module
"conf_gcm" is read from namelist instead of "*.def".

Deleted arguments "dtime", "co2_ppm_etat0", "solaire_etat0",
"tabcntr0" and local variables "radpas", "tab_cntrl" of
"phyetat0". "phyetat0" does not read "controle" in "startphy.nc" any
longer. "phyetat0" now reads global attribute "itau_phy" from
"startphy.nc". "phyredem" does not create variable "controle" in
"startphy.nc" any longer. "phyredem" now writes global attribute
"itau_phy" of "startphy.nc". Deleted argument "tabcntr0" of
"printflag". Removed diagnostic messages written by "printflag" for
comparison of the variable "controle" of "startphy.nc" and the
variables read from "*.def" or namelist input.

-- Removing unwanted functionality:

Removed variable "lunout" from module "iniprint", replaced everywhere
by standard output.

Removed case "ocean == 'couple'" in "clmain", "interfsurf_hq" and
"physiq". Removed procedure "interfoce_cpl".

-- Should not change anything at run time:

Automated creation of graphs in documentation. More documentation on
input files.

Converted Fortran files to free format: "phyredem.f90", "printflag.f90".

Split module "clesphy" into "clesphys" and "clesphys2".

Removed variables "conser", "leapf", "forward", "apphys", "apdiss" and
"statcl" from module "logic". Added arguments "conser" to "advect",
"leapf" to "integrd". Added local variables "forward", "leapf",
"apphys", "conser", "apdiss" in "leapfrog".

Added intent attributes.

Deleted arguments "dtime" of "phyredem", "pdtime" of "flxdtdq", "sh"
of "phytrac", "dt" of "yamada".

Deleted local variables "dtime", "co2_ppm_etat0", "solaire_etat0",
"length", "tabcntr0" in "physiq". Replaced all references to "dtime"
by references to "pdtphys".
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     CALL histwrite(physid,"phis",i,zx_tmp_2d,iim*(jjm+1),ndex2d)
138     c
139     i=itap
140     CALL gr_fi_ecrit(1,klon,iim,jjm+1,paire,zx_tmp_2d)
141     CALL histwrite(physid,"aire",i,zx_tmp_2d,iim*(jjm+1),ndex2d)
142    
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     CALL histwrite(physid,"t",itap,zx_tmp_3d,
249     . iim*(jjm+1)*klev,ndex3d)
250    
251     CALL gr_fi_ecrit(klev,klon,iim,jjm+1, mfu, zx_tmp_3d)
252     CALL histwrite(physid,"mfu",itap,zx_tmp_3d,
253     . iim*(jjm+1)*klev,ndex3d)
254     CALL gr_fi_ecrit(klev,klon,iim,jjm+1, mfd, zx_tmp_3d)
255     CALL histwrite(physid,"mfd",itap,zx_tmp_3d,
256     . iim*(jjm+1)*klev,ndex3d)
257     CALL gr_fi_ecrit(klev,klon,iim,jjm+1, en_u, zx_tmp_3d)
258     CALL histwrite(physid,"en_u",itap,zx_tmp_3d,
259     . iim*(jjm+1)*klev,ndex3d)
260     CALL gr_fi_ecrit(klev,klon,iim,jjm+1, de_u, zx_tmp_3d)
261     CALL histwrite(physid,"de_u",itap,zx_tmp_3d,
262     . iim*(jjm+1)*klev,ndex3d)
263     CALL gr_fi_ecrit(klev,klon,iim,jjm+1, en_d, zx_tmp_3d)
264     CALL histwrite(physid,"en_d",itap,zx_tmp_3d,
265     . iim*(jjm+1)*klev,ndex3d)
266     CALL gr_fi_ecrit(klev,klon,iim,jjm+1, de_d, zx_tmp_3d)
267     CALL histwrite(physid,"de_d",itap,zx_tmp_3d,
268     . iim*(jjm+1)*klev,ndex3d)
269     CALL gr_fi_ecrit(klev,klon,iim,jjm+1, coefh, zx_tmp_3d)
270     CALL histwrite(physid,"coefh",itap,zx_tmp_3d,
271     . iim*(jjm+1)*klev,ndex3d)
272    
273     c ajou...
274     do k=1,klev
275     do i=1,klon
276     fm_therm1(i,k)=fm_therm(i,k)
277     enddo
278     enddo
279    
280     CALL gr_fi_ecrit(klev,klon,iim,jjm+1, fm_therm1, zx_tmp_3d)
281     CALL histwrite(physid,"fm_th",itap,zx_tmp_3d,
282     . iim*(jjm+1)*klev,ndex3d)
283     c
284     CALL gr_fi_ecrit(klev,klon,iim,jjm+1, entr_therm, zx_tmp_3d)
285     CALL histwrite(physid,"en_th",itap,zx_tmp_3d,
286     . iim*(jjm+1)*klev,ndex3d)
287     cccc
288     CALL gr_fi_ecrit(klev,klon,iim,jjm+1,frac_impa,zx_tmp_3d)
289     CALL histwrite(physid,"frac_impa",itap,zx_tmp_3d,
290     . iim*(jjm+1)*klev,ndex3d)
291    
292     CALL gr_fi_ecrit(klev,klon,iim,jjm+1,frac_nucl,zx_tmp_3d)
293     CALL histwrite(physid,"frac_nucl",itap,zx_tmp_3d,
294     . iim*(jjm+1)*klev,ndex3d)
295    
296     CALL gr_fi_ecrit(1, klon,iim,jjm+1, pyu1,zx_tmp_2d)
297     CALL histwrite(physid,"pyu1",itap,zx_tmp_2d,iim*(jjm+1),
298     . ndex2d)
299    
300     CALL gr_fi_ecrit(1, klon,iim,jjm+1, pyv1,zx_tmp_2d)
301     CALL histwrite(physid,"pyv1",itap,zx_tmp_2d,iim*(jjm+1)
302     . ,ndex2d)
303    
304     CALL gr_fi_ecrit(1,klon,iim,jjm+1, pftsol1, zx_tmp_2d)
305     CALL histwrite(physid,"ftsol1",itap,zx_tmp_2d,
306     . iim*(jjm+1),ndex2d)
307     CALL gr_fi_ecrit(1,klon,iim,jjm+1, pftsol2, zx_tmp_2d)
308     CALL histwrite(physid,"ftsol2",itap,zx_tmp_2d,
309     . iim*(jjm+1),ndex2d)
310     CALL gr_fi_ecrit(1,klon,iim,jjm+1, pftsol3, zx_tmp_2d)
311     CALL histwrite(physid,"ftsol3",itap,zx_tmp_2d,
312     . iim*(jjm+1),ndex2d)
313     CALL gr_fi_ecrit(1,klon,iim,jjm+1, pftsol4, zx_tmp_2d)
314     CALL histwrite(physid,"ftsol4",itap,zx_tmp_2d,
315     . iim*(jjm+1),ndex2d)
316    
317     CALL gr_fi_ecrit(1,klon,iim,jjm+1, ppsrf1, zx_tmp_2d)
318     CALL histwrite(physid,"psrf1",itap,zx_tmp_2d,
319     . iim*(jjm+1),ndex2d)
320     CALL gr_fi_ecrit(1,klon,iim,jjm+1, ppsrf2, zx_tmp_2d)
321     CALL histwrite(physid,"psrf2",itap,zx_tmp_2d,
322     . iim*(jjm+1),ndex2d)
323     CALL gr_fi_ecrit(1,klon,iim,jjm+1, ppsrf3, zx_tmp_2d)
324     CALL histwrite(physid,"psrf3",itap,zx_tmp_2d,
325     . iim*(jjm+1),ndex2d)
326     CALL gr_fi_ecrit(1,klon,iim,jjm+1, ppsrf4, zx_tmp_2d)
327     CALL histwrite(physid,"psrf4",itap,zx_tmp_2d,
328     . iim*(jjm+1),ndex2d)
329    
330     if (ok_sync) call histsync(physid)
331     c if (ok_sync) call histsync
332    
333     c
334     cAA Test sur la valeur des coefficients de lessivage
335     c
336     zmin=1e33
337     zmax=-1e33
338     do k=1,klev
339     do i=1,klon
340     zmax=max(zmax,frac_nucl(i,k))
341     zmin=min(zmin,frac_nucl(i,k))
342     enddo
343     enddo
344     Print*,'------ coefs de lessivage (min et max) --------'
345     Print*,'facteur de nucleation ',zmin,zmax
346     zmin=1e33
347     zmax=-1e33
348     do k=1,klev
349     do i=1,klon
350     zmax=max(zmax,frac_impa(i,k))
351     zmin=min(zmin,frac_impa(i,k))
352     enddo
353     enddo
354     Print*,'facteur d impaction ',zmin,zmax
355    
356     ENDIF
357    
358     c reinitialisation des champs cumules
359     go to 768
360     if (mod(iadvtr,istphy).eq.1) then
361     do k=1,klev
362     do i=1,klon
363     mfu(i,k)=0.
364     mfd(i,k)=0.
365     en_u(i,k)=0.
366     de_u(i,k)=0.
367     en_d(i,k)=0.
368     de_d(i,k)=0.
369     coefh(i,k)=0.
370     t(i,k)=0.
371     fm_therm(i,k)=0.
372     entr_therm(i,k)=0.
373     enddo
374     enddo
375     do i=1,klon
376     pyv1(i)=0.
377     pyu1(i)=0.
378     end do
379     do k=1,nbsrf
380     do i=1,klon
381     pftsol(i,k)=0.
382     ppsrf(i,k)=0.
383     enddo
384     enddo
385    
386     dtcum=0.
387     endif
388    
389     do k=1,klev
390     do i=1,klon
391     mfu(i,k)=mfu(i,k)+pmfu(i,k)*pdtphys
392     mfd(i,k)=mfd(i,k)+pmfd(i,k)*pdtphys
393     en_u(i,k)=en_u(i,k)+pen_u(i,k)*pdtphys
394     de_u(i,k)=de_u(i,k)+pde_u(i,k)*pdtphys
395     en_d(i,k)=en_d(i,k)+pen_d(i,k)*pdtphys
396     de_d(i,k)=de_d(i,k)+pde_d(i,k)*pdtphys
397     coefh(i,k)=coefh(i,k)+pcoefh(i,k)*pdtphys
398     t(i,k)=t(i,k)+pt(i,k)*pdtphys
399     fm_therm(i,k)=fm_therm(i,k)+pfm_therm(i,k)*pdtphys
400     entr_therm(i,k)=entr_therm(i,k)+pentr_therm(i,k)*pdtphys
401     enddo
402     enddo
403     do i=1,klon
404     pyv1(i)=pyv1(i)+yv1(i)*pdtphys
405     pyu1(i)=pyu1(i)+yu1(i)*pdtphys
406     end do
407     do k=1,nbsrf
408     do i=1,klon
409     pftsol(i,k)=pftsol(i,k)+ftsol(i,k)*pdtphys
410     ppsrf(i,k)=ppsrf(i,k)+pctsrf(i,k)*pdtphys
411     enddo
412     enddo
413    
414     dtcum=dtcum+pdtphys
415     768 continue
416    
417     RETURN
418     END
  ViewVC Help
Powered by ViewVC 1.1.21