Context Navigation

physiq.F @ 109

Last change on this file since 109 was 109, checked in by lmdzadmin, 24 years ago
Deplacement des dernieres lignes concernant le sol hors de la physique LF
Property svn:eol-style set to `native` Property svn:executable set to ``* Property svn:keywords set to `Author Date Id Revision`
File size: 99.2 KB

Line
1	SUBROUTINE physiq (nlon,nlev,nqmax ,
2	. debut,lafin,rjourvrai,rjour_ecri,gmtime,pdtphys,
3	. paprs,pplay,pphi,pphis,paire,presnivs,clesphy0,
4	. u,v,t,qx,
5	. omega,
6	. d_u, d_v, d_t, d_qx, d_ps)
7	USE ioipsl
8	IMPLICIT none
9	c======================================================================
10	c
11	c Auteur(s) Z.X. Li (LMD/CNRS) date: 19930818
12	c
13	c Objet: Moniteur general de la physique du modele
14	cAA Modifications quant aux traceurs :
15	cAA - uniformisation des parametrisations ds phytrac
16	cAA - stockage des moyennes des champs necessaires
17	cAA en mode traceur off-line
18	c======================================================================
19	c modif ( P. Le Van , 12/10/98 )
20	c
21	c Arguments:
22	c
23	c nlon----input-I-nombre de points horizontaux
24	c nlev----input-I-nombre de couches verticales
25	c nqmax---input-I-nombre de traceurs (y compris vapeur d'eau) = 1
26	c debut---input-L-variable logique indiquant le premier passage
27	c lafin---input-L-variable logique indiquant le dernier passage
28	c rjour---input-R-numero du jour de l'experience
29	c gmtime--input-R-temps universel dans la journee (0 a 86400 s)
30	c pdtphys-input-R-pas d'integration pour la physique (seconde)
31	c paprs---input-R-pression pour chaque inter-couche (en Pa)
32	c pplay---input-R-pression pour le mileu de chaque couche (en Pa)
33	c pphi----input-R-geopotentiel de chaque couche (g z) (reference sol)
34	c pphis---input-R-geopotentiel du sol
35	c paire---input-R-aire de chaque maille
36	c presnivs-input_R_pressions approximat. des milieux couches ( en PA)
37	c u-------input-R-vitesse dans la direction X (de O a E) en m/s
38	c v-------input-R-vitesse Y (de S a N) en m/s
39	c t-------input-R-temperature (K)
40	c qx------input-R-humidite specifique (kg/kg) et d'autres traceurs
41	c d_t_dyn-input-R-tendance dynamique pour "t" (K/s)
42	c d_q_dyn-input-R-tendance dynamique pour "q" (kg/kg/s)
43	c omega---input-R-vitesse verticale en Pa/s
44	c
45	c d_u-----output-R-tendance physique de "u" (m/s/s)
46	c d_v-----output-R-tendance physique de "v" (m/s/s)
47	c d_t-----output-R-tendance physique de "t" (K/s)
48	c d_qx----output-R-tendance physique de "qx" (kg/kg/s)
49	c d_ps----output-R-tendance physique de la pression au sol
50	c======================================================================
51	#include "dimensions.h"
52	integer jjmp1
53	parameter (jjmp1=jjm+1-1/jjm)
54	#include "dimphy.h"
55	#include "regdim.h"
56	#include "indicesol.h"
57	#include "dimsoil.h"
58	#include "clesphys.h"
59	#include "control.h"
60	#include "temps.h"
61	c======================================================================
62	LOGICAL check ! Verifier la conservation du modele en eau
63	PARAMETER (check=.FALSE.)
64	LOGICAL ok_stratus ! Ajouter artificiellement les stratus
65	PARAMETER (ok_stratus=.FALSE.)
66	c======================================================================
67	c Parametres lies au coupleur OASIS:
68	#include "oasis.h"
69	INTEGER npas, nexca, itimestep
70	logical rnpb
71	parameter(rnpb=.true.)
72	PARAMETER (npas=1440)
73	PARAMETER (nexca=48)
74	PARAMETER (itimestep=1800)
75	EXTERNAL fromcpl, intocpl, inicma
76	REAL cpl_sst(iim,jjmp1), cpl_sic(iim,jjmp1)
77	REAL cpl_alb_sst(iim,jjmp1), cpl_alb_sic(iim,jjmp1)
78	c======================================================================
79	c ok_ocean indique l'utilisation du modele oceanique "slab ocean",
80	c il faut bien sur s'assurer que le bilan energetique de reference
81	c a la surface de l'ocean est bien present dans le fichier des
82	c conditions aux limites, ainsi que l'indicateur du sol ne contient
83	c pas de glace oceanique (pas de valeur 3).
84	c
85	LOGICAL ok_ocean
86	PARAMETER (ok_ocean=.FALSE.)
87	REAL cyang ! capacite thermique de l'ocean superficiel
88	PARAMETER (cyang=30.0 * 4.228e+06)
89	REAL cbing ! capacite thermique de la glace oceanique
90	PARAMETER (cbing=1.0 * 4.228e+06)
91	REAL cthermiq
92	c======================================================================
93	c Clef controlant l'activation du cycle diurne:
94	ccc LOGICAL cycle_diurne
95	ccc PARAMETER (cycle_diurne=.FALSE.)
96	c======================================================================
97	c Modele thermique du sol, a activer pour le cycle diurne:
98	ccc LOGICAL soil_model
99	ccc PARAMETER (soil_model=.FALSE.)
100	REAL soilcap(klon,nbsrf), soilflux(klon,nbsrf)
101	SAVE soilcap, soilflux
102	logical ok_veget
103	parameter (ok_veget = .false.)
104	c======================================================================
105	c Dans les versions precedentes, l'eau liquide nuageuse utilisee dans
106	c le calcul du rayonnement est celle apres la precipitation des nuages.
107	c Si cette cle new_oliq est activee, ce sera une valeur moyenne entre
108	c la condensation et la precipitation. Cette cle augmente les impacts
109	c radiatifs des nuages.
110	ccc LOGICAL new_oliq
111	ccc PARAMETER (new_oliq=.FALSE.)
112	c======================================================================
113	c Clefs controlant deux parametrisations de l'orographie:
114	cc LOGICAL ok_orodr
115	ccc PARAMETER (ok_orodr=.FALSE.)
116	ccc LOGICAL ok_orolf
117	ccc PARAMETER (ok_orolf=.FALSE.)
118	c======================================================================
119	LOGICAL ok_journe ! sortir le fichier journalier
120	PARAMETER (ok_journe=.FALSE.)
121	c
122	LOGICAL ok_mensuel ! sortir le fichier mensuel
123	PARAMETER (ok_mensuel=.TRUE.)
124	c
125	LOGICAL ok_instan ! sortir le fichier instantane
126	PARAMETER (ok_instan=.TRUE.)
127	c
128	LOGICAL ok_region ! sortir le fichier regional
129	PARAMETER (ok_region=.FALSE.)
130	c======================================================================
131	c
132	INTEGER ivap ! indice de traceurs pour vapeur d'eau
133	PARAMETER (ivap=1)
134	INTEGER iliq ! indice de traceurs pour eau liquide
135	PARAMETER (iliq=2)
136
137	INTEGER nvm ! nombre de vegetations
138	PARAMETER (nvm=8)
139	REAL veget(klon,nvm) ! couverture vegetale
140	SAVE veget
141
142	c
143	c
144	c Variables argument:
145	c
146	INTEGER nlon
147	INTEGER nlev
148	INTEGER nqmax
149	REAL rjourvrai, rjour_ecri
150	REAL gmtime
151	REAL pdtphys
152	LOGICAL debut, lafin
153	REAL paprs(klon,klev+1)
154	REAL pplay(klon,klev)
155	REAL pphi(klon,klev)
156	REAL pphis(klon)
157	REAL paire(klon)
158	REAL presnivs(klev)
159	REAL znivsig(klev)
160	REAL zsurf(nbsrf)
161
162	REAL u(klon,klev)
163	REAL v(klon,klev)
164	REAL t(klon,klev)
165	REAL qx(klon,klev,nqmax)
166
167	REAL t_ancien(klon,klev), q_ancien(klon,klev)
168	SAVE t_ancien, q_ancien
169	LOGICAL ancien_ok
170	SAVE ancien_ok
171
172	REAL d_u_dyn(klon,klev)
173	REAL d_v_dyn(klon,klev)
174	REAL d_t_dyn(klon,klev)
175	REAL d_q_dyn(klon,klev)
176
177	REAL omega(klon,klev)
178
179	REAL d_u(klon,klev)
180	REAL d_v(klon,klev)
181	REAL d_t(klon,klev)
182	REAL d_qx(klon,klev,nqmax)
183	REAL d_ps(klon)
184
185	INTEGER longcles
186	PARAMETER ( longcles = 20 )
187	REAL clesphy0( longcles )
188	c
189	c Variables quasi-arguments
190	c
191	REAL xjour
192	SAVE xjour
193	c
194	c
195	c Variables propres a la physique
196	c
197	REAL dtime
198	SAVE dtime ! pas temporel de la physique
199	c
200	INTEGER radpas
201	SAVE radpas ! frequence d'appel rayonnement
202	c
203	REAL radsol(klon)
204	SAVE radsol ! bilan radiatif au sol
205	c
206	REAL rlat(klon)
207	SAVE rlat ! latitude pour chaque point
208	c
209	REAL rlon(klon)
210	SAVE rlon ! longitude pour chaque point
211	c
212	cc INTEGER iflag_con
213	cc SAVE iflag_con ! indicateur de la convection
214	c
215	INTEGER itap
216	SAVE itap ! compteur pour la physique
217	c
218	REAL co2_ppm
219	SAVE co2_ppm ! concentration du CO2
220	c
221	REAL solaire
222	SAVE solaire ! constante solaire
223	c
224	REAL ftsol(klon,nbsrf)
225	SAVE ftsol ! temperature du sol
226	c
227	REAL ftsoil(klon,nsoilmx,nbsrf)
228	SAVE ftsoil ! temperature dans le sol
229	c
230	REAL fevap(klon,nbsrf)
231	SAVE fevap ! evaporation
232	c
233	REAL deltat(klon)
234	SAVE deltat ! ecart avec la SST de reference
235	c
236	REAL fqsol(klon,nbsrf)
237	SAVE fqsol ! humidite du sol
238	c
239	REAL fsnow(klon,nbsrf)
240	SAVE fsnow ! epaisseur neigeuse
241	c
242	REAL falbe(klon,nbsrf)
243	SAVE falbe ! albedo par type de surface
244	c
245	REAL rugmer(klon)
246	SAVE rugmer ! longeur de rugosite sur mer (m)
247	c
248	c Parametres de l'Orographie a l'Echelle Sous-Maille (OESM):
249	c
250	REAL zmea(klon)
251	SAVE zmea ! orographie moyenne
252	c
253	REAL zstd(klon)
254	SAVE zstd ! deviation standard de l'OESM
255	c
256	REAL zsig(klon)
257	SAVE zsig ! pente de l'OESM
258	c
259	REAL zgam(klon)
260	save zgam ! anisotropie de l'OESM
261	c
262	REAL zthe(klon)
263	SAVE zthe ! orientation de l'OESM
264	c
265	REAL zpic(klon)
266	SAVE zpic ! Maximum de l'OESM
267	c
268	REAL zval(klon)
269	SAVE zval ! Minimum de l'OESM
270	c
271	REAL rugoro(klon)
272	SAVE rugoro ! longueur de rugosite de l'OESM
273	c
274	REAL zulow(klon),zvlow(klon),zustr(klon), zvstr(klon)
275	c
276	REAL zuthe(klon),zvthe(klon)
277	SAVE zuthe
278	SAVE zvthe
279	INTEGER igwd,igwdim,idx(klon),itest(klon)
280	c
281	REAL agesno(klon)
282	SAVE agesno ! age de la neige
283	c
284	REAL alb_neig(klon)
285	SAVE alb_neig ! albedo de la neige
286	c
287	c Variables locales:
288	c
289	REAL cdragh(klon) ! drag coefficient pour T and Q
290	REAL cdragm(klon) ! drag coefficient pour vent
291	cAA
292	cAA Pour phytrac
293	cAA
294	REAL ycoefh(klon,klev) ! coef d'echange pour phytrac
295	REAL yu1(klon) ! vents dans la premiere couche U
296	REAL yv1(klon) ! vents dans la premiere couche V
297	LOGICAL offline ! Controle du stockage ds "physique"
298	PARAMETER (offline=.false.)
299	INTEGER physid
300	REAL pfrac_impa(klon,klev)! Produits des coefs lessivage impaction
301	save pfrac_impa
302	REAL pfrac_nucl(klon,klev)! Produits des coefs lessivage nucleation
303	save pfrac_nucl
304	REAL pfrac_1nucl(klon,klev)! Produits des coefs lessi nucl (alpha = 1)
305	save pfrac_1nucl
306	REAL frac_impa(klon,klev) ! fractions d'aerosols lessivees (impaction)
307	REAL frac_nucl(klon,klev) ! idem (nucleation)
308	cAA
309	REAL rain_fall(klon) ! pluie
310	REAL snow_fall(klon) ! neige
311	REAL evap(klon), devap(klon) ! evaporation et sa derivee
312	REAL sens(klon), dsens(klon) ! chaleur sensible et sa derivee
313	REAL bils(klon) ! bilan de chaleur au sol
314	REAL fder(klon) ! Derive de flux (sensible et latente)
315	REAL ruis(klon) ! ruissellement
316	REAL ve(klon) ! integr. verticale du transport meri. de l'energie
317	REAL vq(klon) ! integr. verticale du transport meri. de l'eau
318	REAL ue(klon) ! integr. verticale du transport zonal de l'energie
319	REAL uq(klon) ! integr. verticale du transport zonal de l'eau
320	c
321	REAL frugs(klon,nbsrf) ! longueur de rugosite
322	REAL zxrugs(klon) ! longueur de rugosite
323	c
324	c Conditions aux limites
325	c
326	INTEGER julien
327	INTEGER idayvrai
328	SAVE idayvrai
329	c
330	INTEGER lmt_pas
331	SAVE lmt_pas ! frequence de mise a jour
332	REAL pctsrf(klon,nbsrf)
333	SAVE pctsrf ! sous-fraction du sol
334	REAL lmt_sst(klon)
335	SAVE lmt_sst ! temperature de la surface ocean
336	REAL lmt_bils(klon)
337	SAVE lmt_bils ! bilan de chaleur au sol
338	REAL lmt_alb(klon)
339	SAVE lmt_alb ! temperature de la surface ocean
340	REAL lmt_rug(klon)
341	SAVE lmt_rug ! longueur de rugosite
342	REAL alb_eau(klon)
343	SAVE alb_eau ! albedo sur l'ocean
344	REAL albsol(klon)
345	SAVE albsol ! albedo du sol total
346	REAL wo(klon,klev)
347	SAVE wo ! ozone
348	c======================================================================
349	c
350	c Declaration des procedures appelees
351	c
352	EXTERNAL angle ! calculer angle zenithal du soleil
353	EXTERNAL alboc ! calculer l'albedo sur ocean
354	EXTERNAL albsno ! calculer albedo sur neige
355	EXTERNAL ajsec ! ajustement sec
356	EXTERNAL clmain ! couche limite
357	EXTERNAL condsurf ! lire les conditions aux limites
358	EXTERNAL conlmd ! convection (schema LMD)
359	EXTERNAL diagcld ! nuages diagnostiques
360	EXTERNAL fisrtilp ! schema de condensation a grande echelle (pluie)
361	cAA
362	EXTERNAL fisrtilp_tr ! schema de condensation a grande echelle (pluie)
363	c ! stockage des coefficients necessaires au
364	c ! lessivage OFF-LINE et ON-LINE
365	cAA
366	EXTERNAL hgardfou ! verifier les temperatures
367	EXTERNAL hydrol ! hydrologie du sol
368	EXTERNAL nuage ! calculer les proprietes radiatives
369	EXTERNAL o3cm ! initialiser l'ozone
370	EXTERNAL orbite ! calculer l'orbite terrestre
371	EXTERNAL ozonecm ! prescrire l'ozone
372	EXTERNAL phyetat0 ! lire l'etat initial de la physique
373	EXTERNAL phyredem ! ecrire l'etat de redemarrage de la physique
374	EXTERNAL radlwsw ! rayonnements solaire et infrarouge
375	EXTERNAL suphec ! initialiser certaines constantes
376	EXTERNAL transp ! transport total de l'eau et de l'energie
377	EXTERNAL ecribina ! ecrire le fichier binaire global
378	EXTERNAL ecribins ! ecrire le fichier binaire global
379	EXTERNAL ecrirega ! ecrire le fichier binaire regional
380	EXTERNAL ecriregs ! ecrire le fichier binaire regional
381	c
382	c Variables locales
383	c
384	REAL dialiq(klon,klev) ! eau liquide nuageuse
385	REAL diafra(klon,klev) ! fraction nuageuse
386	REAL cldliq(klon,klev) ! eau liquide nuageuse
387	REAL cldfra(klon,klev) ! fraction nuageuse
388	REAL cldtau(klon,klev) ! epaisseur optique
389	REAL cldemi(klon,klev) ! emissivite infrarouge
390	c
391	C§§§ PB
392	REAL fluxq(klon,klev, nbsrf) ! flux turbulent d'humidite
393	REAL fluxt(klon,klev, nbsrf) ! flux turbulent de chaleur
394	REAL fluxu(klon,klev, nbsrf) ! flux turbulent de vitesse u
395	REAL fluxv(klon,klev, nbsrf) ! flux turbulent de vitesse v
396	c
397	REAL zxfluxt(klon, klev)
398	REAL zxfluxq(klon, klev)
399	REAL zxfluxu(klon, klev)
400	REAL zxfluxv(klon, klev)
401	C§§§
402	REAL heat(klon,klev) ! chauffage solaire
403	REAL heat0(klon,klev) ! chauffage solaire ciel clair
404	REAL cool(klon,klev) ! refroidissement infrarouge
405	REAL cool0(klon,klev) ! refroidissement infrarouge ciel clair
406	REAL topsw(klon), toplw(klon), solsw(klon), sollw(klon)
407	REAL topsw0(klon), toplw0(klon), solsw0(klon), sollw0(klon)
408	REAL albpla(klon)
409	c Le rayonnement n'est pas calcule tous les pas, il faut donc
410	c sauvegarder les sorties du rayonnement
411	SAVE heat,cool,albpla,topsw,toplw,solsw,sollw
412	SAVE topsw0,toplw0,solsw0,sollw0, heat0, cool0
413	INTEGER itaprad
414	SAVE itaprad
415	c
416	REAL conv_q(klon,klev) ! convergence de l'humidite (kg/kg/s)
417	REAL conv_t(klon,klev) ! convergence de la temperature(K/s)
418	c
419	REAL cldl(klon),cldm(klon),cldh(klon) !nuages bas, moyen et haut
420	REAL cldt(klon),cldq(klon) !nuage total, eau liquide integree
421	c
422	REAL zx_alb_lic, zx_alb_oce, zx_alb_ter, zx_alb_sic
423	REAL zxtsol(klon), zxqsol(klon), zxsnow(klon)
424	c
425	REAL dist, rmu0(klon), fract(klon)
426	REAL zdtime, zlongi
427	c
428	CHARACTER*2 str2
429	CHARACTER*2 iqn
430	c
431	REAL qcheck
432	REAL z_avant(klon), z_apres(klon), z_factor(klon)
433	LOGICAL zx_ajustq
434	c
435	REAL za, zb
436	REAL zx_t, zx_qs, zdelta, zcor, zfra, zlvdcp, zlsdcp
437	INTEGER i, k, iq, ig, j, nsrf, ll
438	REAL t_coup
439	PARAMETER (t_coup=234.0)
440	c
441	REAL zphi(klon,klev)
442	REAL zx_relief(iim,jjmp1)
443	REAL zx_aire(iim,jjmp1)
444	c
445	c Variables du changement
446	c
447	c con: convection
448	c lsc: condensation a grande echelle (Large-Scale-Condensation)
449	c ajs: ajustement sec
450	c eva: evaporation de l'eau liquide nuageuse
451	c vdf: couche limite (Vertical DiFfusion)
452	REAL d_t_con(klon,klev),d_q_con(klon,klev)
453	REAL d_u_con(klon,klev),d_v_con(klon,klev)
454	REAL d_t_lsc(klon,klev),d_q_lsc(klon,klev),d_ql_lsc(klon,klev)
455	REAL d_t_ajs(klon,klev), d_q_ajs(klon,klev)
456	REAL d_t_eva(klon,klev),d_q_eva(klon,klev)
457	REAL rneb(klon,klev)
458	c
459	REAL pmfu(klon,klev), pmfd(klon,klev)
460	REAL pen_u(klon,klev), pen_d(klon,klev)
461	REAL pde_u(klon,klev), pde_d(klon,klev)
462	INTEGER kcbot(klon), kctop(klon), kdtop(klon)
463	REAL pmflxr(klon,klev+1), pmflxs(klon,klev+1)
464	REAL prfl(klon,klev+1), psfl(klon,klev+1)
465	c
466	INTEGER ibas_con(klon), itop_con(klon)
467	REAL rain_con(klon), rain_lsc(klon)
468	REAL snow_con(klon), snow_lsc(klon)
469	REAL d_ts(klon,nbsrf)
470	c
471	REAL d_u_vdf(klon,klev), d_v_vdf(klon,klev)
472	REAL d_t_vdf(klon,klev), d_q_vdf(klon,klev)
473	c
474	REAL d_u_oro(klon,klev), d_v_oro(klon,klev)
475	REAL d_t_oro(klon,klev)
476	REAL d_u_lif(klon,klev), d_v_lif(klon,klev)
477	REAL d_t_lif(klon,klev)
478	c
479	c Variables liees a l'ecriture de la bande histoire physique
480	c
481	INTEGER ecrit_mth
482	SAVE ecrit_mth ! frequence d'ecriture (fichier mensuel)
483	c
484	INTEGER ecrit_day
485	SAVE ecrit_day ! frequence d'ecriture (fichier journalier)
486	c
487	INTEGER ecrit_ins
488	SAVE ecrit_ins ! frequence d'ecriture (fichier instantane)
489	c
490	INTEGER ecrit_reg
491	SAVE ecrit_reg ! frequence d'ecriture
492	c
493	REAL oas_sols(klon), z_sols(iim,jjmp1)
494	SAVE oas_sols
495	REAL oas_nsol(klon), z_nsol(iim,jjmp1)
496	SAVE oas_nsol
497	REAL oas_rain(klon), z_rain(iim,jjmp1)
498	SAVE oas_rain
499	REAL oas_snow(klon), z_snow(iim,jjmp1)
500	SAVE oas_snow
501	REAL oas_evap(klon), z_evap(iim,jjmp1)
502	SAVE oas_evap
503	REAL oas_ruis(klon), z_ruis(iim,jjmp1)
504	SAVE oas_ruis
505	REAL oas_tsol(klon), z_tsol(iim,jjmp1)
506	SAVE oas_tsol
507	REAL oas_fder(klon), z_fder(iim,jjmp1)
508	SAVE oas_fder
509	REAL oas_albe(klon), z_albe(iim,jjmp1)
510	SAVE oas_albe
511	REAL oas_taux(klon), z_taux(iim,jjmp1)
512	SAVE oas_taux
513	REAL oas_tauy(klon), z_tauy(iim,jjmp1)
514	SAVE oas_tauy
515	REAL oas_ruisoce(klon), z_ruisoce(iim,jjmp1)
516	SAVE oas_ruisoce
517	REAL oas_ruisriv(klon), z_ruisriv(iim,jjmp1)
518	SAVE oas_ruisriv
519	c
520	c
521	c Variables locales pour effectuer les appels en serie
522	c
523	REAL t_seri(klon,klev), q_seri(klon,klev)
524	REAL ql_seri(klon,klev)
525	REAL u_seri(klon,klev), v_seri(klon,klev)
526	c
527	REAL tr_seri(klon,klev,nbtr)
528	REAL d_tr(klon,klev,nbtr)
529	REAL source_tr(klon,nbtr)
530
531	REAL zx_rh(klon,klev)
532	REAL dtimeday,dtimecri,dtimexp9,fecri_pas,fecri86400,fecritday
533
534	INTEGER length
535	PARAMETER ( length = 100 )
536	REAL tabcntr0( length )
537	c
538	INTEGER ndex2d(iimjjmp1),ndex3d(iimjjmp1*klev)
539	REAL zx_tmp_fi2d(klon)
540	REAL zx_tmp_2d(iim,jjmp1), zx_tmp_3d(iim,jjmp1,klev)
541	REAL zx_lon(iim,jjmp1), zx_lat(iim,jjmp1)
542	c
543	INTEGER nid_day, nid_mth, nid_ins
544	SAVE nid_day, nid_mth, nid_ins
545	c
546	INTEGER nhori, nvert,nvertsf
547	REAL zsto, zout, zjulian
548
549	character*20 modname
550	character*80 abort_message
551	logical ok_sync
552
553	c
554	c Declaration des constantes et des fonctions thermodynamiques
555	c
556	#include "YOMCST.h"
557	#include "YOETHF.h"
558	#include "FCTTRE.h"
559	c======================================================================
560	modname = 'physiq'
561	ok_sync=.TRUE.
562	IF (nqmax .LT. 2) THEN
563	PRINT*, 'eaux vapeur et liquide sont indispensables'
564	CALL ABORT
565	ENDIF
566	IF (debut) THEN
567	CALL suphec ! initialiser constantes et parametres phys.
568	ENDIF
569
570
571	c======================================================================
572	xjour = rjourvrai
573	c
574	c Si c'est le debut, il faut initialiser plusieurs choses
575	c ********
576	c
577	IF (debut) THEN
578
579	DO k = 2, nvm ! pas de vegetation
580	DO i = 1, klon
581	veget(i,k) = 0.0
582	ENDDO
583	ENDDO
584	DO i = 1, klon
585	veget(i,1) = 1.0 ! il n'y a que du desert
586	ENDDO
587	PRINT*, 'Pas de vegetation; desert partout'
588	c
589	c
590	c Initialiser les compteurs:
591	c
592
593	itap = 0
594	itaprad = 0
595	c
596	CALL phyetat0 ("startphy.nc",dtime,co2_ppm,solaire,
597	. rlat,rlon,pctsrf, ftsol,ftsoil,deltat,fqsol,fsnow,
598	. falbe, fevap, rain_fall,snow_fall,sollw, solsw,
599	. radsol,rugmer,agesno,clesphy0,
600	. zmea,zstd,zsig,zgam,zthe,zpic,zval,rugoro,tabcntr0,
601	. t_ancien, q_ancien, ancien_ok )
602
603	c
604	radpas = NINT( 86400./dtime/nbapp_rad)
605
606	c
607	CALL printflag( tabcntr0,radpas,ok_ocean,ok_oasis ,ok_journe,
608	, ok_instan, ok_region )
609	c
610	IF (ABS(dtime-pdtphys).GT.0.001) THEN
611	PRINT*, 'Pas physique n est pas correcte',dtime,pdtphys
612	abort_message=' See above '
613	call abort_gcm(modname,abort_message,1)
614	ENDIF
615	IF (nlon .NE. klon) THEN
616	PRINT*, 'nlon et klon ne sont pas coherents', nlon, klon
617	abort_message=' See above '
618	call abort_gcm(modname,abort_message,1)
619	ENDIF
620	IF (nlev .NE. klev) THEN
621	PRINT*, 'nlev et klev ne sont pas coherents', nlev, klev
622	abort_message=' See above '
623	call abort_gcm(modname,abort_message,1)
624	ENDIF
625	c
626	IF (dtime*FLOAT(radpas).GT.21600..AND.cycle_diurne) THEN
627	PRINT*, 'Nbre d appels au rayonnement insuffisant'
628	PRINT*, "Au minimum 4 appels par jour si cycle diurne"
629	abort_message=' See above '
630	call abort_gcm(modname,abort_message,1)
631	ENDIF
632	PRINT*, "Clef pour la convection, iflag_con=", iflag_con
633	c
634	IF (ok_orodr) THEN
635	DO i=1,klon
636	rugoro(i) = MAX(1.0e-05, zstd(i)*zsig(i)/2.0)
637	ENDDO
638	CALL SUGWD(klon,klev,paprs,pplay)
639	DO i=1,klon
640	zuthe(i)=0.
641	zvthe(i)=0.
642	if(zstd(i).gt.10.)then
643	zuthe(i)=(1.-zgam(i))*cos(zthe(i))
644	zvthe(i)=(1.-zgam(i))*sin(zthe(i))
645	endif
646	ENDDO
647	ENDIF
648	c
649	c
650	lmt_pas = NINT(86400./dtime * 1.0) ! tous les jours
651	PRINT*,'La frequence de lecture surface est de ', lmt_pas
652	c
653	ecrit_mth = NINT(86400./dtime *ecritphy) ! tous les ecritphy jours
654	IF (ok_mensuel) THEN
655	PRINT*, 'La frequence de sortie mensuelle est de ', ecrit_mth
656	ENDIF
657	ecrit_day = NINT(86400./dtime *1.0) ! tous les jours
658	IF (ok_journe) THEN
659	PRINT*, 'La frequence de sortie journaliere est de ',ecrit_day
660	ENDIF
661	ccc ecrit_ins = NINT(86400./dtime *0.5) ! 2 fois par jour
662	ccc ecrit_ins = NINT(86400./dtime *0.25) ! 4 fois par jour
663	ecrit_ins = NINT(86400./dtime/48.) ! a chaque pas de temps
664	IF (ok_instan) THEN
665	PRINT*, 'La frequence de sortie instant. est de ', ecrit_ins
666	ENDIF
667	ecrit_reg = NINT(86400./dtime *0.25) ! 4 fois par jour
668	IF (ok_region) THEN
669	PRINT*, 'La frequence de sortie region est de ', ecrit_reg
670	ENDIF
671	c
672	c
673	IF (ok_journe) THEN
674	c
675	CALL ymds2ju(anne_ini, 1, 1, 0.0, zjulian)
676	zjulian = zjulian + day_ini
677	c
678	CALL gr_fi_ecrit(1,klon,iim,jjmp1,rlon,zx_lon)
679	DO i = 1, iim
680	zx_lon(i,1) = rlon(i+1)
681	zx_lon(i,jjmp1) = rlon(i+1)
682	ENDDO
683	DO ll=1,klev
684	znivsig(ll)=float(ll)
685	ENDDO
686	CALL gr_fi_ecrit(1,klon,iim,jjmp1,rlat,zx_lat)
687	CALL histbeg("histday", iim,zx_lon, jjmp1,zx_lat,
688	. 1,iim,1,jjmp1, 0, zjulian, dtime,
689	. nhori, nid_day)
690	c CALL histvert(nid_day, "presnivs", "Vertical levels", "mb",
691	c . klev, presnivs, nvert)
692	call histvert(nid_day, 'sig_s', 'Niveaux sigma','-',
693	. klev, znivsig, nvert)
694	c
695	zsto = dtime
696	zout = dtime * FLOAT(ecrit_day)
697	c
698	CALL histdef(nid_day, "phis", "Surface geop. height", "-",
699	. iim,jjmp1,nhori, 1,1,1, -99, 32,
700	. "once", zsto,zout)
701	c
702	CALL histdef(nid_day, "aire", "Grid area", "-",
703	. iim,jjmp1,nhori, 1,1,1, -99, 32,
704	. "once", zsto,zout)
705	c
706	c Champs 2D:
707	c
708	CALL histdef(nid_day, "tsol", "Surface Temperature", "K",
709	. iim,jjmp1,nhori, 1,1,1, -99, 32,
710	. "ave(X)", zsto,zout)
711	c
712	CALL histdef(nid_day, "tter", "Surface Temperature", "K",
713	. iim,jjmp1,nhori, 1,1,1, -99, 32,
714	. "ave(X)", zsto,zout)
715	c
716	CALL histdef(nid_day, "tlic", "Surface Temperature", "K",
717	. iim,jjmp1,nhori, 1,1,1, -99, 32,
718	. "ave(X)", zsto,zout)
719	c
720	CALL histdef(nid_day, "toce", "Surface Temperature", "K",
721	. iim,jjmp1,nhori, 1,1,1, -99, 32,
722	. "ave(X)", zsto,zout)
723	c
724	CALL histdef(nid_day, "tsic", "Surface Temperature", "K",
725	. iim,jjmp1,nhori, 1,1,1, -99, 32,
726	. "ave(X)", zsto,zout)
727	c
728	CALL histdef(nid_day, "psol", "Surface Pressure", "Pa",
729	. iim,jjmp1,nhori, 1,1,1, -99, 32,
730	. "ave(X)", zsto,zout)
731	c
732	CALL histdef(nid_day, "rain", "Precipitation", "mm/day",
733	. iim,jjmp1,nhori, 1,1,1, -99, 32,
734	. "ave(X)", zsto,zout)
735	c
736	CALL histdef(nid_day, "snow", "Snow fall", "mm/day",
737	. iim,jjmp1,nhori, 1,1,1, -99, 32,
738	. "ave(X)", zsto,zout)
739	c
740	CALL histdef(nid_day, "evap", "Evaporation", "mm/day",
741	. iim,jjmp1,nhori, 1,1,1, -99, 32,
742	. "ave(X)", zsto,zout)
743	c
744	CALL histdef(nid_day, "tops", "Solar rad. at TOA", "W/m2",
745	. iim,jjmp1,nhori, 1,1,1, -99, 32,
746	. "ave(X)", zsto,zout)
747	c
748	CALL histdef(nid_day, "topl", "IR rad. at TOA", "W/m2",
749	. iim,jjmp1,nhori, 1,1,1, -99, 32,
750	. "ave(X)", zsto,zout)
751	c
752	CALL histdef(nid_day, "sols", "Solar rad. at surf.", "W/m2",
753	. iim,jjmp1,nhori, 1,1,1, -99, 32,
754	. "ave(X)", zsto,zout)
755	c
756	CALL histdef(nid_day, "soll", "IR rad. at surface", "W/m2",
757	. iim,jjmp1,nhori, 1,1,1, -99, 32,
758	. "ave(X)", zsto,zout)
759	c
760	CALL histdef(nid_day, "bils", "Surf. total heat flux", "W/m2",
761	. iim,jjmp1,nhori, 1,1,1, -99, 32,
762	. "ave(X)", zsto,zout)
763	c
764	CALL histdef(nid_day, "sens", "Sensible heat flux", "W/m2",
765	. iim,jjmp1,nhori, 1,1,1, -99, 32,
766	. "ave(X)", zsto,zout)
767	c
768	CALL histdef(nid_day, "fder", "Heat flux derivation", "W/m2",
769	. iim,jjmp1,nhori, 1,1,1, -99, 32,
770	. "ave(X)", zsto,zout)
771	c
772	CALL histdef(nid_day, "frtu", "Zonal wind stress", "Pa",
773	. iim,jjmp1,nhori, 1,1,1, -99, 32,
774	. "ave(X)", zsto,zout)
775	c
776	CALL histdef(nid_day, "frtv", "Meridional wind stress", "Pa",
777	. iim,jjmp1,nhori, 1,1,1, -99, 32,
778	. "ave(X)", zsto,zout)
779	c
780	C §§§ PB flux pour chauqe sous surface
781	C
782	DO nsrf = 1, nbsrf
783	C
784	call histdef(nid_day, "pourc_"//clnsurf(nsrf),
785	$ "Fraction"//clnsurf(nsrf), "W/m2",
786	$ iim,jjmp1,nhori, 1,1,1, -99, 32,
787	$ "ave(X)", zsto,zout)
788
789	call histdef(nid_day, "sens_"//clnsurf(nsrf),
790	$ "Sensible heat flux "//clnsurf(nsrf), "W/m2",
791	$ iim,jjmp1,nhori, 1,1,1, -99, 32,
792	$ "ave(X)", zsto,zout)
793	c
794	call histdef(nid_day, "lat_"//clnsurf(nsrf),
795	$ "Latent heat flux "//clnsurf(nsrf), "W/m2",
796	$ iim,jjmp1,nhori, 1,1,1, -99, 32,
797	$ "ave(X)", zsto,zout)
798	C
799	call histdef(nid_day, "taux_"//clnsurf(nsrf),
800	$ "Zonal wind stress"//clnsurf(nsrf),"Pa",
801	$ iim,jjmp1,nhori, 1,1,1, -99, 32,
802	$ "ave(X)", zsto,zout)
803
804	call histdef(nid_day, "tauy_"//clnsurf(nsrf),
805	$ "Meridional xind stress "//clnsurf(nsrf), "Pa",
806	$ iim,jjmp1,nhori, 1,1,1, -99, 32,
807	$ "ave(X)", zsto,zout)
808	C§§§
809	END DO
810
811	CALL histdef(nid_day, "ruis", "Runoff", "mm/day",
812	. iim,jjmp1,nhori, 1,1,1, -99, 32,
813	. "ave(X)", zsto,zout)
814	c
815	CALL histdef(nid_day, "sicf", "Sea-ice fraction", "-",
816	. iim,jjmp1,nhori, 1,1,1, -99, 32,
817	. "ave(X)", zsto,zout)
818	c
819	CALL histdef(nid_day, "cldl", "Low-level cloudiness", "-",
820	. iim,jjmp1,nhori, 1,1,1, -99, 32,
821	. "ave(X)", zsto,zout)
822	c
823	CALL histdef(nid_day, "cldm", "Mid-level cloudiness", "-",
824	. iim,jjmp1,nhori, 1,1,1, -99, 32,
825	. "ave(X)", zsto,zout)
826	c
827	CALL histdef(nid_day, "cldh", "High-level cloudiness", "-",
828	. iim,jjmp1,nhori, 1,1,1, -99, 32,
829	. "ave(X)", zsto,zout)
830	c
831	CALL histdef(nid_day, "cldt", "Total cloudiness", "-",
832	. iim,jjmp1,nhori, 1,1,1, -99, 32,
833	. "ave(X)", zsto,zout)
834	c
835	CALL histdef(nid_day, "cldq", "Cloud liquid water path", "-",
836	. iim,jjmp1,nhori, 1,1,1, -99, 32,
837	. "ave(X)", zsto,zout)
838	c
839	c Champs 3D:
840	c
841	CALL histdef(nid_day, "temp", "Air temperature", "K",
842	. iim,jjmp1,nhori, klev,1,klev,nvert, 32,
843	. "ave(X)", zsto,zout)
844	c
845	CALL histdef(nid_day, "ovap", "Specific humidity", "Kg/Kg",
846	. iim,jjmp1,nhori, klev,1,klev,nvert, 32,
847	. "ave(X)", zsto,zout)
848	c
849	CALL histdef(nid_day, "geop", "Geopotential height", "m",
850	. iim,jjmp1,nhori, klev,1,klev,nvert, 32,
851	. "ave(X)", zsto,zout)
852	c
853	CALL histdef(nid_day, "vitu", "Zonal wind", "m/s",
854	. iim,jjmp1,nhori, klev,1,klev,nvert, 32,
855	. "ave(X)", zsto,zout)
856	c
857	CALL histdef(nid_day, "vitv", "Meridional wind", "m/s",
858	. iim,jjmp1,nhori, klev,1,klev,nvert, 32,
859	. "ave(X)", zsto,zout)
860	c
861	CALL histdef(nid_day, "vitw", "Vertical wind", "m/s",
862	. iim,jjmp1,nhori, klev,1,klev,nvert, 32,
863	. "ave(X)", zsto,zout)
864	c
865	CALL histdef(nid_day, "pres", "Air pressure", "Pa",
866	. iim,jjmp1,nhori, klev,1,klev,nvert, 32,
867	. "ave(X)", zsto,zout)
868	c
869	CALL histend(nid_day)
870	c
871	ndex2d = 0
872	ndex3d = 0
873	c
874	ENDIF ! fin de test sur ok_journe
875	c
876	IF (ok_mensuel) THEN
877	c
878	CALL ymds2ju(anne_ini, 1, 1, 0.0, zjulian)
879	zjulian = zjulian + day_ini
880	c
881	CALL gr_fi_ecrit(1,klon,iim,jjmp1,rlon,zx_lon)
882	DO i = 1, iim
883	zx_lon(i,1) = rlon(i+1)
884	zx_lon(i,jjmp1) = rlon(i+1)
885	ENDDO
886	DO ll=1,klev
887	znivsig(ll)=float(ll)
888	ENDDO
889	CALL gr_fi_ecrit(1,klon,iim,jjmp1,rlat,zx_lat)
890	CALL histbeg("histmth", iim,zx_lon, jjmp1,zx_lat,
891	. 1,iim,1,jjmp1, 0, zjulian, dtime,
892	. nhori, nid_mth)
893	c CALL histvert(nid_mth, "presnivs", "Vertical levels", "mb",
894	c . klev, presnivs, nvert)
895	call histvert(nid_mth, 'sig_s', 'Niveaux sigma','-',
896	. klev, znivsig, nvert)
897	c
898	zsto = dtime
899	zout = dtime * ecrit_mth
900	c
901	CALL histdef(nid_mth, "phis", "Surface geop. height", "-",
902	. iim,jjmp1,nhori, 1,1,1, -99, 32,
903	. "once", zsto,zout)
904	c
905	CALL histdef(nid_mth, "aire", "Grid area", "-",
906	. iim,jjmp1,nhori, 1,1,1, -99, 32,
907	. "once", zsto,zout)
908	c
909	c Champs 2D:
910	c
911	CALL histdef(nid_mth, "tsol", "Surface Temperature", "K",
912	. iim,jjmp1,nhori, 1,1,1, -99, 32,
913	. "ave(X)", zsto,zout)
914	c
915	CALL histdef(nid_mth, "psol", "Surface Pressure", "Pa",
916	. iim,jjmp1,nhori, 1,1,1, -99, 32,
917	. "ave(X)", zsto,zout)
918	c
919	CALL histdef(nid_mth, "qsol", "Surface humidity", "mm",
920	. iim,jjmp1,nhori, 1,1,1, -99, 32,
921	. "ave(X)", zsto,zout)
922	c
923	CALL histdef(nid_mth, "rain", "Precipitation", "mm/day",
924	. iim,jjmp1,nhori, 1,1,1, -99, 32,
925	. "ave(X)", zsto,zout)
926	c
927	CALL histdef(nid_mth, "plul", "Large-scale Precip.", "mm/day",
928	. iim,jjmp1,nhori, 1,1,1, -99, 32,
929	. "ave(X)", zsto,zout)
930	c
931	CALL histdef(nid_mth, "pluc", "Convective Precip.", "mm/day",
932	. iim,jjmp1,nhori, 1,1,1, -99, 32,
933	. "ave(X)", zsto,zout)
934	c
935	CALL histdef(nid_mth, "snow", "Snow fall", "mm/day",
936	. iim,jjmp1,nhori, 1,1,1, -99, 32,
937	. "ave(X)", zsto,zout)
938	c
939	CALL histdef(nid_mth, "ages", "Snow age", "day",
940	. iim,jjmp1,nhori, 1,1,1, -99, 32,
941	. "ave(X)", zsto,zout)
942	c
943	CALL histdef(nid_mth, "evap", "Evaporation", "mm/day",
944	. iim,jjmp1,nhori, 1,1,1, -99, 32,
945	. "ave(X)", zsto,zout)
946	c
947	CALL histdef(nid_mth, "tops", "Solar rad. at TOA", "W/m2",
948	. iim,jjmp1,nhori, 1,1,1, -99, 32,
949	. "ave(X)", zsto,zout)
950	c
951	CALL histdef(nid_mth, "topl", "IR rad. at TOA", "W/m2",
952	. iim,jjmp1,nhori, 1,1,1, -99, 32,
953	. "ave(X)", zsto,zout)
954	c
955	CALL histdef(nid_mth, "sols", "Solar rad. at surf.", "W/m2",
956	. iim,jjmp1,nhori, 1,1,1, -99, 32,
957	. "ave(X)", zsto,zout)
958	c
959	CALL histdef(nid_mth, "soll", "IR rad. at surface", "W/m2",
960	. iim,jjmp1,nhori, 1,1,1, -99, 32,
961	. "ave(X)", zsto,zout)
962	c
963	CALL histdef(nid_mth, "tops0", "Solar rad. at TOA", "W/m2",
964	. iim,jjmp1,nhori, 1,1,1, -99, 32,
965	. "ave(X)", zsto,zout)
966	c
967	CALL histdef(nid_mth, "topl0", "IR rad. at TOA", "W/m2",
968	. iim,jjmp1,nhori, 1,1,1, -99, 32,
969	. "ave(X)", zsto,zout)
970	c
971	CALL histdef(nid_mth, "sols0", "Solar rad. at surf.", "W/m2",
972	. iim,jjmp1,nhori, 1,1,1, -99, 32,
973	. "ave(X)", zsto,zout)
974	c
975	CALL histdef(nid_mth, "soll0", "IR rad. at surface", "W/m2",
976	. iim,jjmp1,nhori, 1,1,1, -99, 32,
977	. "ave(X)", zsto,zout)
978	c
979	CALL histdef(nid_mth, "bils", "Surf. total heat flux", "W/m2",
980	. iim,jjmp1,nhori, 1,1,1, -99, 32,
981	. "ave(X)", zsto,zout)
982	c
983	CALL histdef(nid_mth, "sens", "Sensible heat flux", "W/m2",
984	. iim,jjmp1,nhori, 1,1,1, -99, 32,
985	. "ave(X)", zsto,zout)
986	c
987	CALL histdef(nid_mth, "fder", "Heat flux derivation", "W/m2",
988	. iim,jjmp1,nhori, 1,1,1, -99, 32,
989	. "ave(X)", zsto,zout)
990	c
991	CALL histdef(nid_mth, "frtu", "Zonal wind stress", "Pa",
992	. iim,jjmp1,nhori, 1,1,1, -99, 32,
993	. "ave(X)", zsto,zout)
994	c
995	CALL histdef(nid_mth, "frtv", "Meridional wind stress", "Pa",
996	. iim,jjmp1,nhori, 1,1,1, -99, 32,
997	. "ave(X)", zsto,zout)
998	c
999	DO nsrf = 1, nbsrf
1000	C
1001	call histdef(nid_mth, "pourc_"//clnsurf(nsrf),
1002	$ "Fraction "//clnsurf(nsrf), "W/m2",
1003	$ iim,jjmp1,nhori, 1,1,1, -99, 32,
1004	$ "ave(X)", zsto,zout)
1005	C
1006	call histdef(nid_mth, "sens_"//clnsurf(nsrf),
1007	$ "Sensible heat flux "//clnsurf(nsrf), "W/m2",
1008	$ iim,jjmp1,nhori, 1,1,1, -99, 32,
1009	$ "ave(X)", zsto,zout)
1010	c
1011	call histdef(nid_mth, "lat_"//clnsurf(nsrf),
1012	$ "Latent heat flux "//clnsurf(nsrf), "W/m2",
1013	$ iim,jjmp1,nhori, 1,1,1, -99, 32,
1014	$ "ave(X)", zsto,zout)
1015	C
1016	call histdef(nid_mth, "taux_"//clnsurf(nsrf),
1017	$ "Zonal wind stress"//clnsurf(nsrf), "Pa",
1018	$ iim,jjmp1,nhori, 1,1,1, -99, 32,
1019	$ "ave(X)", zsto,zout)
1020
1021	call histdef(nid_mth, "tauy_"//clnsurf(nsrf),
1022	$ "Meridional xind stress "//clnsurf(nsrf), "Pa",
1023	$ iim,jjmp1,nhori, 1,1,1, -99, 32,
1024	$ "ave(X)", zsto,zout)
1025	END DO
1026	C
1027	CALL histdef(nid_mth, "ruis", "Runoff", "mm/day",
1028	. iim,jjmp1,nhori, 1,1,1, -99, 32,
1029	. "ave(X)", zsto,zout)
1030	c
1031	CALL histdef(nid_mth, "sicf", "Sea-ice fraction", "-",
1032	. iim,jjmp1,nhori, 1,1,1, -99, 32,
1033	. "ave(X)", zsto,zout)
1034	c
1035	CALL histdef(nid_mth, "albs", "Surface albedo", "-",
1036	. iim,jjmp1,nhori, 1,1,1, -99, 32,
1037	. "ave(X)", zsto,zout)
1038	c
1039	CALL histdef(nid_mth, "cdrm", "Momentum drag coef.", "-",
1040	. iim,jjmp1,nhori, 1,1,1, -99, 32,
1041	. "ave(X)", zsto,zout)
1042	c
1043	CALL histdef(nid_mth, "cdrh", "Heat drag coef.", "-",
1044	. iim,jjmp1,nhori, 1,1,1, -99, 32,
1045	. "ave(X)", zsto,zout)
1046	c
1047	CALL histdef(nid_mth, "cldl", "Low-level cloudiness", "-",
1048	. iim,jjmp1,nhori, 1,1,1, -99, 32,
1049	. "ave(X)", zsto,zout)
1050	c
1051	CALL histdef(nid_mth, "cldm", "Mid-level cloudiness", "-",
1052	. iim,jjmp1,nhori, 1,1,1, -99, 32,
1053	. "ave(X)", zsto,zout)
1054	c
1055	CALL histdef(nid_mth, "cldh", "High-level cloudiness", "-",
1056	. iim,jjmp1,nhori, 1,1,1, -99, 32,
1057	. "ave(X)", zsto,zout)
1058	c
1059	CALL histdef(nid_mth, "cldt", "Total cloudiness", "-",
1060	. iim,jjmp1,nhori, 1,1,1, -99, 32,
1061	. "ave(X)", zsto,zout)
1062	c
1063	CALL histdef(nid_mth, "cldq", "Cloud liquid water path", "-",
1064	. iim,jjmp1,nhori, 1,1,1, -99, 32,
1065	. "ave(X)", zsto,zout)
1066	c
1067	CALL histdef(nid_mth, "ue", "Zonal energy transport", "-",
1068	. iim,jjmp1,nhori, 1,1,1, -99, 32,
1069	. "ave(X)", zsto,zout)
1070	c
1071	CALL histdef(nid_mth, "ve", "Merid energy transport", "-",
1072	. iim,jjmp1,nhori, 1,1,1, -99, 32,
1073	. "ave(X)", zsto,zout)
1074	c
1075	CALL histdef(nid_mth, "uq", "Zonal humidity transport", "-",
1076	. iim,jjmp1,nhori, 1,1,1, -99, 32,
1077	. "ave(X)", zsto,zout)
1078	c
1079	CALL histdef(nid_mth, "vq", "Merid humidity transport", "-",
1080	. iim,jjmp1,nhori, 1,1,1, -99, 32,
1081	. "ave(X)", zsto,zout)
1082	c
1083	c Champs 3D:
1084	c
1085	CALL histdef(nid_mth, "temp", "Air temperature", "K",
1086	. iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1087	. "ave(X)", zsto,zout)
1088	c
1089	CALL histdef(nid_mth, "ovap", "Specific humidity", "Kg/Kg",
1090	. iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1091	. "ave(X)", zsto,zout)
1092	c
1093	CALL histdef(nid_mth, "geop", "Geopotential height", "m",
1094	. iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1095	. "ave(X)", zsto,zout)
1096	c
1097	CALL histdef(nid_mth, "vitu", "Zonal wind", "m/s",
1098	. iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1099	. "ave(X)", zsto,zout)
1100	c
1101	CALL histdef(nid_mth, "vitv", "Meridional wind", "m/s",
1102	. iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1103	. "ave(X)", zsto,zout)
1104	c
1105	CALL histdef(nid_mth, "vitw", "Vertical wind", "m/s",
1106	. iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1107	. "ave(X)", zsto,zout)
1108	c
1109	CALL histdef(nid_mth, "pres", "Air pressure", "Pa",
1110	. iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1111	. "ave(X)", zsto,zout)
1112	c
1113	CALL histdef(nid_mth, "rneb", "Cloud fraction", "-",
1114	. iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1115	. "ave(X)", zsto,zout)
1116	c
1117	CALL histdef(nid_mth, "rhum", "Relative humidity", "-",
1118	. iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1119	. "ave(X)", zsto,zout)
1120	c
1121	CALL histdef(nid_mth, "oliq", "Liquid water content", "kg/kg",
1122	. iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1123	. "ave(X)", zsto,zout)
1124	c
1125	CALL histdef(nid_mth, "dtdyn", "Dynamics dT", "K/s",
1126	. iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1127	. "ave(X)", zsto,zout)
1128	c
1129	CALL histdef(nid_mth, "dqdyn", "Dynamics dQ", "Kg/Kg/s",
1130	. iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1131	. "ave(X)", zsto,zout)
1132	c
1133	CALL histdef(nid_mth, "dtcon", "Convection dT", "K/s",
1134	. iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1135	. "ave(X)", zsto,zout)
1136	c
1137	CALL histdef(nid_mth, "dqcon", "Convection dQ", "Kg/Kg/s",
1138	. iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1139	. "ave(X)", zsto,zout)
1140	c
1141	CALL histdef(nid_mth, "dtlsc", "Condensation dT", "K/s",
1142	. iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1143	. "ave(X)", zsto,zout)
1144	c
1145	CALL histdef(nid_mth, "dqlsc", "Condensation dQ", "Kg/Kg/s",
1146	. iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1147	. "ave(X)", zsto,zout)
1148	c
1149	CALL histdef(nid_mth, "dtvdf", "Boundary-layer dT", "K/s",
1150	. iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1151	. "ave(X)", zsto,zout)
1152	c
1153	CALL histdef(nid_mth, "dqvdf", "Boundary-layer dQ", "Kg/Kg/s",
1154	. iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1155	. "ave(X)", zsto,zout)
1156	c
1157	CALL histdef(nid_mth, "dteva", "Reevaporation dT", "K/s",
1158	. iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1159	. "ave(X)", zsto,zout)
1160	c
1161	CALL histdef(nid_mth, "dqeva", "Reevaporation dQ", "Kg/Kg/s",
1162	. iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1163	. "ave(X)", zsto,zout)
1164	c
1165	CALL histdef(nid_mth, "dtajs", "Dry adjust. dT", "K/s",
1166	. iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1167	. "ave(X)", zsto,zout)
1168
1169	CALL histdef(nid_mth, "dqajs", "Dry adjust. dQ", "Kg/Kg/s",
1170	. iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1171	. "ave(X)", zsto,zout)
1172	c
1173	CALL histdef(nid_mth, "dtswr", "SW radiation dT", "K/s",
1174	. iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1175	. "ave(X)", zsto,zout)
1176	c
1177	CALL histdef(nid_mth, "dtsw0", "SW radiation dT", "K/s",
1178	. iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1179	. "ave(X)", zsto,zout)
1180	c
1181	CALL histdef(nid_mth, "dtlwr", "LW radiation dT", "K/s",
1182	. iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1183	. "ave(X)", zsto,zout)
1184	c
1185	CALL histdef(nid_mth, "dtlw0", "LW radiation dT", "K/s",
1186	. iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1187	. "ave(X)", zsto,zout)
1188	c
1189	CALL histdef(nid_mth, "duvdf", "Boundary-layer dU", "m/s2",
1190	. iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1191	. "ave(X)", zsto,zout)
1192	c
1193	CALL histdef(nid_mth, "dvvdf", "Boundary-layer dV", "m/s2",
1194	. iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1195	. "ave(X)", zsto,zout)
1196	c
1197	IF (ok_orodr) THEN
1198	CALL histdef(nid_mth, "duoro", "Orography dU", "m/s2",
1199	. iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1200	. "ave(X)", zsto,zout)
1201	c
1202	CALL histdef(nid_mth, "dvoro", "Orography dV", "m/s2",
1203	. iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1204	. "ave(X)", zsto,zout)
1205	c
1206	ENDIF
1207	C
1208	IF (ok_orolf) THEN
1209	CALL histdef(nid_mth, "dulif", "Orography dU", "m/s2",
1210	. iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1211	. "ave(X)", zsto,zout)
1212	c
1213	CALL histdef(nid_mth, "dvlif", "Orography dV", "m/s2",
1214	. iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1215	. "ave(X)", zsto,zout)
1216	ENDIF
1217	C
1218	CALL histdef(nid_mth, "ozone", "Ozone concentration", "-",
1219	. iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1220	. "ave(X)", zsto,zout)
1221	c
1222	if (nqmax.GE.3) THEN
1223	DO iq=1,nqmax-2
1224	IF (iq.LE.99) THEN
1225	WRITE(str2,'(i2.2)') iq
1226	CALL histdef(nid_mth, "trac"//str2, "Tracer No."//str2, "-",
1227	. iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1228	. "ave(X)", zsto,zout)
1229	ELSE
1230	PRINT*, "Trop de traceurs"
1231	CALL abort
1232	ENDIF
1233	ENDDO
1234	ENDIF
1235	c
1236	CALL histend(nid_mth)
1237	c
1238	ndex2d = 0
1239	ndex3d = 0
1240	c
1241	ENDIF ! fin de test sur ok_mensuel
1242	c
1243	c
1244	IF (ok_instan) THEN
1245	c
1246	CALL ymds2ju(anne_ini, 1, 1, 0.0, zjulian)
1247	zjulian = zjulian + day_ini
1248	c
1249	CALL gr_fi_ecrit(1,klon,iim,jjmp1,rlon,zx_lon)
1250	DO i = 1, iim
1251	zx_lon(i,1) = rlon(i+1)
1252	zx_lon(i,jjmp1) = rlon(i+1)
1253	ENDDO
1254	DO ll=1,klev
1255	znivsig(ll)=float(ll)
1256	ENDDO
1257	CALL gr_fi_ecrit(1,klon,iim,jjmp1,rlat,zx_lat)
1258	CALL histbeg("histins", iim,zx_lon, jjmp1,zx_lat,
1259	. 1,iim,1,jjmp1, 0, zjulian, dtime,
1260	. nhori, nid_ins)
1261	c CALL histvert(nid_ins, "presnivs", "Vertical levels", "mb",
1262	c . klev, presnivs, nvert)
1263	call histvert(nid_ins, 'sig_s', 'Niveaux sigma','-',
1264	. klev, znivsig, nvert)
1265	c
1266	c
1267	zsto = dtime * ecrit_ins
1268	zout = dtime * ecrit_ins
1269	C
1270	CALL histdef(nid_ins, "phis", "Surface geop. height", "-",
1271	. iim,jjmp1,nhori, 1,1,1, -99, 32,
1272	. "once", zsto,zout)
1273	c
1274	CALL histdef(nid_ins, "aire", "Grid area", "-",
1275	. iim,jjmp1,nhori, 1,1,1, -99, 32,
1276	. "once", zsto,zout)
1277	c
1278	c Champs 2D:
1279	c
1280	CALL histdef(nid_ins, "tsol", "Surface Temperature", "K",
1281	. iim,jjmp1,nhori, 1,1,1, -99, 32,
1282	. "inst(X)", zsto,zout)
1283	c
1284	CALL histdef(nid_ins, "psol", "Surface Pressure", "Pa",
1285	. iim,jjmp1,nhori, 1,1,1, -99, 32,
1286	. "inst(X)", zsto,zout)
1287	c
1288	CALL histdef(nid_ins, "topl", "OLR", "W/m2",
1289	. iim,jjmp1,nhori, 1,1,1, -99, 32,
1290	. "inst(X)", zsto,zout)
1291	c
1292	CALL histdef(nid_ins, "evap", "Evaporation", "mm/day",
1293	. iim,jjmp1,nhori, 1,1,1, -99, 32,
1294	. "inst(X)", zsto,zout)
1295	c
1296	CALL histdef(nid_ins, "sols", "Solar rad. at surf.", "W/m2",
1297	. iim,jjmp1,nhori, 1,1,1, -99, 32,
1298	. "inst(X)", zsto,zout)
1299	c
1300	CALL histdef(nid_ins, "soll", "IR rad. at surface", "W/m2",
1301	. iim,jjmp1,nhori, 1,1,1, -99, 32,
1302	. "inst(X)", zsto,zout)
1303	c
1304	CALL histdef(nid_ins, "bils", "Surf. total heat flux", "W/m2",
1305	. iim,jjmp1,nhori, 1,1,1, -99, 32,
1306	. "inst(X)", zsto,zout)
1307	c
1308	CALL histdef(nid_ins, "sens", "Sensible heat flux", "W/m2",
1309	. iim,jjmp1,nhori, 1,1,1, -99, 32,
1310	. "inst(X)", zsto,zout)
1311	c
1312	CALL histdef(nid_ins, "fder", "Heat flux derivation", "W/m2",
1313	. iim,jjmp1,nhori, 1,1,1, -99, 32,
1314	. "inst(X)", zsto,zout)
1315	c
1316	CALL histdef(nid_ins, "dtsvdfo", "Boundary-layer dTs(o)", "K/s",
1317	. iim,jjmp1,nhori, 1,1,1, -99, 32,
1318	. "inst(X)", zsto,zout)
1319	c
1320	CALL histdef(nid_ins, "dtsvdft", "Boundary-layer dTs(t)", "K/s",
1321	. iim,jjmp1,nhori, 1,1,1, -99, 32,
1322	. "inst(X)", zsto,zout)
1323	c
1324	CALL histdef(nid_ins, "dtsvdfg", "Boundary-layer dTs(g)", "K/s",
1325	. iim,jjmp1,nhori, 1,1,1, -99, 32,
1326	. "inst(X)", zsto,zout)
1327	c
1328	CALL histdef(nid_ins, "dtsvdfi", "Boundary-layer dTs(g)", "K/s",
1329	. iim,jjmp1,nhori, 1,1,1, -99, 32,
1330	. "inst(X)", zsto,zout)
1331
1332	DO nsrf = 1, nbsrf
1333	C
1334	call histdef(nid_ins, "pourc_"//clnsurf(nsrf),
1335	$ "Fraction"//clnsurf(nsrf), "W/m2",
1336	$ iim,jjmp1,nhori, 1,1,1, -99, 32,
1337	$ "inst(X)", zsto,zout)
1338
1339	call histdef(nid_ins, "sens_"//clnsurf(nsrf),
1340	$ "Sensible heat flux "//clnsurf(nsrf), "W/m2",
1341	$ iim,jjmp1,nhori, 1,1,1, -99, 32,
1342	$ "inst(X)", zsto,zout)
1343	c
1344	call histdef(nid_ins, "tsol_"//clnsurf(nsrf),
1345	$ "Surface Temperature"//clnsurf(nsrf), "W/m2",
1346	$ iim,jjmp1,nhori, 1,1,1, -99, 32,
1347	$ "inst(X)", zsto,zout)
1348	c
1349	call histdef(nid_ins, "lat_"//clnsurf(nsrf),
1350	$ "Latent heat flux "//clnsurf(nsrf), "W/m2",
1351	$ iim,jjmp1,nhori, 1,1,1, -99, 32,
1352	$ "inst(X)", zsto,zout)
1353	C
1354	call histdef(nid_ins, "taux_"//clnsurf(nsrf),
1355	$ "Zonal wind stress"//clnsurf(nsrf),"Pa",
1356	$ iim,jjmp1,nhori, 1,1,1, -99, 32,
1357	$ "inst(X)", zsto,zout)
1358
1359	call histdef(nid_ins, "tauy_"//clnsurf(nsrf),
1360	$ "Meridional xind stress "//clnsurf(nsrf), "Pa",
1361	$ iim,jjmp1,nhori, 1,1,1, -99, 32,
1362	$ "inst(X)", zsto,zout)
1363	C§§§
1364	END DO
1365	c
1366	c Champs 3D:
1367	c
1368	CALL histdef(nid_ins, "temp", "Temperature", "K",
1369	. iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1370	. "inst(X)", zsto,zout)
1371	c
1372	CALL histdef(nid_ins, "vitu", "Zonal wind", "m/s",
1373	. iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1374	. "inst(X)", zsto,zout)
1375	c
1376	CALL histdef(nid_ins, "vitv", "Merid wind", "m/s",
1377	. iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1378	. "inst(X)", zsto,zout)
1379	c
1380	CALL histdef(nid_ins, "geop", "Geopotential height", "m",
1381	. iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1382	. "inst(X)", zsto,zout)
1383	c
1384	CALL histdef(nid_ins, "pres", "Air pressure", "Pa",
1385	. iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1386	. "inst(X)", zsto,zout)
1387	c
1388	CALL histdef(nid_ins, "dtvdf", "Boundary-layer dT", "K/s",
1389	. iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1390	. "inst(X)", zsto,zout)
1391	c
1392	CALL histdef(nid_ins, "dqvdf", "Boundary-layer dQ", "Kg/Kg/s",
1393	. iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1394	. "inst(X)", zsto,zout)
1395	c
1396
1397	CALL histend(nid_ins)
1398	c
1399	ndex2d = 0
1400	ndex3d = 0
1401	c
1402	ENDIF
1403	c
1404	c
1405	c
1406	c Prescrire l'ozone dans l'atmosphere
1407	c
1408	c
1409	cc DO i = 1, klon
1410	cc DO k = 1, klev
1411	cc CALL o3cm (paprs(i,k)/100.,paprs(i,k+1)/100., wo(i,k),20)
1412	cc ENDDO
1413	cc ENDDO
1414	c
1415	c
1416	ENDIF
1417	c
1418	c ************** Fin de IF ( debut ) *************
1419	c
1420	c
1421	c Mettre a zero des variables de sortie (pour securite)
1422	c
1423	DO i = 1, klon
1424	d_ps(i) = 0.0
1425	ENDDO
1426	DO k = 1, klev
1427	DO i = 1, klon
1428	d_t(i,k) = 0.0
1429	d_u(i,k) = 0.0
1430	d_v(i,k) = 0.0
1431	ENDDO
1432	ENDDO
1433	DO iq = 1, nqmax
1434	DO k = 1, klev
1435	DO i = 1, klon
1436	d_qx(i,k,iq) = 0.0
1437	ENDDO
1438	ENDDO
1439	ENDDO
1440	c
1441	c Ne pas affecter les valeurs entrees de u, v, h, et q
1442	c
1443	DO k = 1, klev
1444	DO i = 1, klon
1445	t_seri(i,k) = t(i,k)
1446	u_seri(i,k) = u(i,k)
1447	v_seri(i,k) = v(i,k)
1448	q_seri(i,k) = qx(i,k,ivap)
1449	ql_seri(i,k) = qx(i,k,iliq)
1450	ENDDO
1451	ENDDO
1452	IF (nqmax.GE.3) THEN
1453	DO iq = 3, nqmax
1454	DO k = 1, klev
1455	DO i = 1, klon
1456	tr_seri(i,k,iq-2) = qx(i,k,iq)
1457	ENDDO
1458	ENDDO
1459	ENDDO
1460	ELSE
1461	DO k = 1, klev
1462	DO i = 1, klon
1463	tr_seri(i,k,1) = 0.0
1464	ENDDO
1465	ENDDO
1466	ENDIF
1467	c
1468	c Diagnostiquer la tendance dynamique
1469	c
1470	IF (ancien_ok) THEN
1471	DO k = 1, klev
1472	DO i = 1, klon
1473	d_t_dyn(i,k) = (t_seri(i,k)-t_ancien(i,k))/dtime
1474	d_q_dyn(i,k) = (q_seri(i,k)-q_ancien(i,k))/dtime
1475	ENDDO
1476	ENDDO
1477	ELSE
1478	DO k = 1, klev
1479	DO i = 1, klon
1480	d_t_dyn(i,k) = 0.0
1481	d_q_dyn(i,k) = 0.0
1482	ENDDO
1483	ENDDO
1484	ancien_ok = .TRUE.
1485	ENDIF
1486	c
1487	c Ajouter le geopotentiel du sol:
1488	c
1489	DO k = 1, klev
1490	DO i = 1, klon
1491	zphi(i,k) = pphi(i,k) + pphis(i)
1492	ENDDO
1493	ENDDO
1494	c
1495	c Verifier les temperatures
1496	c
1497
1498	CALL hgardfou(t_seri,ftsol,'debutphy')
1499	c
1500	c Incrementer le compteur de la physique
1501	c
1502	itap = itap + 1
1503	julien = MOD(NINT(xjour),360)
1504	c
1505	c Mettre en action les conditions aux limites (albedo, sst, etc.).
1506	c Prescrire l'ozone et calculer l'albedo sur l'ocean.
1507	c
1508	IF (MOD(itap-1,lmt_pas) .EQ. 0) THEN
1509	idayvrai = NINT(xjour)
1510	PRINT *,' PHYS cond julien ',julien,idayvrai
1511	c CALL condsurf(julien,idayvrai, pctsrf ,
1512	c . lmt_sst,lmt_alb,lmt_rug,lmt_bils )
1513	CALL ozonecm( FLOAT(julien), rlat, paprs, wo)
1514	ENDIF
1515	c
1516	c Re-evaporer l'eau liquide nuageuse
1517	c
1518	DO k = 1, klev ! re-evaporation de l'eau liquide nuageuse
1519	DO i = 1, klon
1520	zlvdcp=RLVTT/RCPD/(1.0+RVTMP2*q_seri(i,k))
1521	zlsdcp=RLSTT/RCPD/(1.0+RVTMP2*q_seri(i,k))
1522	zdelta = MAX(0.,SIGN(1.,RTT-t_seri(i,k)))
1523	zb = MAX(0.0,ql_seri(i,k))
1524	za = - MAX(0.0,ql_seri(i,k))
1525	. * (zlvdcp(1.-zdelta)+zlsdcpzdelta)
1526	t_seri(i,k) = t_seri(i,k) + za
1527	q_seri(i,k) = q_seri(i,k) + zb
1528	ql_seri(i,k) = 0.0
1529	d_t_eva(i,k) = za
1530	d_q_eva(i,k) = zb
1531	ENDDO
1532	ENDDO
1533	c
1534	c Appeler la diffusion verticale (programme de couche limite)
1535	c
1536	DO i = 1, klon
1537	if (.not. ok_veget) then
1538	frugs(i,is_ter) = SQRT(frugs(i,is_ter)2+rugoro(i)2)
1539	frugs(i,is_lic) = rugoro(i)
1540	frugs(i,is_oce) = rugmer(i)
1541	frugs(i,is_sic) = 0.001
1542	zxrugs(i) = 0.0
1543	ENDDO
1544	DO nsrf = 1, nbsrf
1545	DO i = 1, klon
1546	frugs(i,nsrf) = MAX(frugs(i,nsrf),0.001)
1547	ENDDO
1548	ENDDO
1549	DO nsrf = 1, nbsrf
1550	DO i = 1, klon
1551	zxrugs(i) = zxrugs(i) + frugs(i,nsrf)*pctsrf(i,nsrf)
1552	ENDDO
1553	ENDDO
1554	c
1555	C calculs necessaires au calcul de l'albedo dans l'interface
1556	c
1557	CALL orbite(FLOAT(julien),zlongi,dist)
1558	IF (cycle_diurne) THEN
1559	zdtime=dtime*FLOAT(radpas) ! pas de temps du rayonnement (s)
1560	CALL zenang(zlongi,gmtime,zdtime,rlat,rlon,rmu0,fract)
1561	ELSE
1562	rmu0 = -999.999
1563	ENDIF
1564
1565	CALL clmain(dtime,pctsrf,
1566	e t_seri,q_seri,u_seri,v_seri,
1567	e julien, rmu0,
1568	e ok_veget, ftsol,
1569	e paprs,pplay,radsol, fsnow,fqsol,fevap,falbe,
1570	e rain_fall, snow_fall, solsw, sollw, fder,
1571	e rlon, rlat, frugs,
1572	e debut, lafin,
1573	s d_t_vdf,d_q_vdf,d_u_vdf,d_v_vdf,d_ts,
1574	s fluxt,fluxq,fluxu,fluxv,cdragh,cdragm,rugmer,
1575	s dsens, devap,
1576	s ycoefh,yu1,yv1)
1577	c
1578	C§§§ PB
1579	C§§§ Incrementation des flux
1580	C§§
1581	zxfluxt=0.
1582	zxfluxq=0.
1583	zxfluxu=0.
1584	zxfluxv=0.
1585	DO nsrf = 1, nbsrf
1586	DO k = 1, klev
1587	DO i = 1, klon
1588	zxfluxt(i,k) = zxfluxt(i,k) +
1589	$ fluxt(i,k,nsrf) * pctsrf( i, nsrf)
1590	zxfluxq(i,k) = zxfluxq(i,k) +
1591	$ fluxq(i,k,nsrf) * pctsrf( i, nsrf)
1592	zxfluxu(i,k) = zxfluxu(i,k) +
1593	$ fluxu(i,k,nsrf) * pctsrf( i, nsrf)
1594	zxfluxv(i,k) = zxfluxv(i,k) +
1595	$ fluxv(i,k,nsrf) * pctsrf( i, nsrf)
1596	END DO
1597	END DO
1598	END DO
1599	DO i = 1, klon
1600	sens(i) = - zxfluxt(i,1) ! flux de chaleur sensible au sol
1601	c evap(i) = - fluxq(i,1) ! flux d'evaporation au sol
1602	evap(i) = - zxfluxq(i,1) ! flux d'evaporation au sol
1603	fder(i) = dsens(i) + devap(i)
1604	ENDDO
1605
1606	DO k = 1, klev
1607	DO i = 1, klon
1608	t_seri(i,k) = t_seri(i,k) + d_t_vdf(i,k)
1609	q_seri(i,k) = q_seri(i,k) + d_q_vdf(i,k)
1610	u_seri(i,k) = u_seri(i,k) + d_u_vdf(i,k)
1611	v_seri(i,k) = v_seri(i,k) + d_v_vdf(i,k)
1612	ENDDO
1613	ENDDO
1614	c
1615	c Incrementer la temperature du sol
1616	c
1617	DO i = 1, klon
1618	zxtsol(i) = 0.0
1619	IF ( abs( pctsrf(i, is_ter) + pctsrf(i, is_lic) +
1620	$ pctsrf(i, is_oce) + pctsrf(i, is_sic) - 1.) .GT. EPSFRA)
1621	$ THEN
1622	WRITE(,) 'physiq : pb sous surface au point ', i,
1623	$ pctsrf(i, 1 : nbsrf)
1624	ENDIF
1625	ENDDO
1626	DO nsrf = 1, nbsrf
1627	DO i = 1, klon
1628	ftsol(i,nsrf) = ftsol(i,nsrf) + d_ts(i,nsrf)
1629	zxtsol(i) = zxtsol(i) + ftsol(i,nsrf)*pctsrf(i,nsrf)
1630	ENDDO
1631	ENDDO
1632
1633	c
1634	c Si une sous-fraction n'existe pas, elle prend la temp. moyenne
1635	c
1636	DO nsrf = 1, nbsrf
1637	DO i = 1, klon
1638	IF (pctsrf(i,nsrf).LT.epsfra) ftsol(i,nsrf) = zxtsol(i)
1639	ENDDO
1640	ENDDO
1641
1642	c
1643	c Calculer la derive du flux infrarouge
1644	c
1645	DO nsrf = 1, nbsrf
1646	DO i = 1, klon
1647	fder(i) = fder(i) - 4.0RSIGMAzxtsol(i)*3
1648	. (ftsol(i,nsrf)-zxtsol(i))
1649	. *pctsrf(i,nsrf)
1650	ENDDO
1651	ENDDO
1652	c
1653	c Appeler la convection (au choix)
1654	c
1655	DO k = 1, klev
1656	DO i = 1, klon
1657	conv_q(i,k) = d_q_dyn(i,k)
1658	. + d_q_vdf(i,k)/dtime
1659	conv_t(i,k) = d_t_dyn(i,k)
1660	. + d_t_vdf(i,k)/dtime
1661	ENDDO
1662	ENDDO
1663	IF (check) THEN
1664	za = qcheck(klon,klev,paprs,q_seri,ql_seri,paire)
1665	PRINT*, "avantcon=", za
1666	ENDIF
1667	zx_ajustq = .FALSE.
1668	IF (iflag_con.EQ.2) zx_ajustq=.TRUE.
1669	IF (zx_ajustq) THEN
1670	DO i = 1, klon
1671	z_avant(i) = 0.0
1672	ENDDO
1673	DO k = 1, klev
1674	DO i = 1, klon
1675	z_avant(i) = z_avant(i) + (q_seri(i,k)+ql_seri(i,k))
1676	. *(paprs(i,k)-paprs(i,k+1))/RG
1677	ENDDO
1678	ENDDO
1679	ENDIF
1680	IF (iflag_con.EQ.1) THEN
1681	stop'reactiver le call conlmd dans physiq.F'
1682	c CALL conlmd (dtime, paprs, pplay, t_seri, q_seri, conv_q,
1683	c . d_t_con, d_q_con,
1684	c . rain_con, snow_con, ibas_con, itop_con)
1685	ELSE IF (iflag_con.EQ.2) THEN
1686	CALL conflx(dtime, paprs, pplay, t_seri, q_seri,
1687	e conv_t, conv_q, zxfluxq(1,1), omega,
1688	s d_t_con, d_q_con, rain_con, snow_con,
1689	s pmfu, pmfd, pen_u, pde_u, pen_d, pde_d,
1690	s kcbot, kctop, kdtop, pmflxr, pmflxs)
1691	DO i = 1, klon
1692	ibas_con(i) = klev+1 - kcbot(i)
1693	itop_con(i) = klev+1 - kctop(i)
1694	ENDDO
1695	ELSE IF (iflag_con.EQ.3) THEN
1696	stop'reactiver le call conlmd dans physiq.F'
1697	c CALL conccm (dtime,paprs,pplay,t_seri,q_seri,conv_q,
1698	c s d_t_con, d_q_con,
1699	c s rain_con, snow_con, ibas_con, itop_con)
1700	ELSE
1701	PRINT*, "iflag_con non-prevu", iflag_con
1702	CALL abort
1703	ENDIF
1704	CALL homogene(paprs, q_seri, d_q_con, u_seri,v_seri,
1705	. d_u_con, d_v_con)
1706	DO k = 1, klev
1707	DO i = 1, klon
1708	t_seri(i,k) = t_seri(i,k) + d_t_con(i,k)
1709	q_seri(i,k) = q_seri(i,k) + d_q_con(i,k)
1710	u_seri(i,k) = u_seri(i,k) + d_u_con(i,k)
1711	v_seri(i,k) = v_seri(i,k) + d_v_con(i,k)
1712	ENDDO
1713	ENDDO
1714	IF (check) THEN
1715	za = qcheck(klon,klev,paprs,q_seri,ql_seri,paire)
1716	PRINT*, "aprescon=", za
1717	zx_t = 0.0
1718	za = 0.0
1719	DO i = 1, klon
1720	za = za + paire(i)/FLOAT(klon)
1721	zx_t = zx_t + (rain_con(i)+snow_con(i))*paire(i)/FLOAT(klon)
1722	ENDDO
1723	zx_t = zx_t/za*dtime
1724	PRINT*, "Precip=", zx_t
1725	ENDIF
1726	IF (zx_ajustq) THEN
1727	DO i = 1, klon
1728	z_apres(i) = 0.0
1729	ENDDO
1730	DO k = 1, klev
1731	DO i = 1, klon
1732	z_apres(i) = z_apres(i) + (q_seri(i,k)+ql_seri(i,k))
1733	. *(paprs(i,k)-paprs(i,k+1))/RG
1734	ENDDO
1735	ENDDO
1736	DO i = 1, klon
1737	z_factor(i) = (z_avant(i)-(rain_con(i)+snow_con(i))*dtime)
1738	. /z_apres(i)
1739	ENDDO
1740	DO k = 1, klev
1741	DO i = 1, klon
1742	IF (z_factor(i).GT.(1.0+1.0E-08) .OR.
1743	. z_factor(i).LT.(1.0-1.0E-08)) THEN
1744	q_seri(i,k) = q_seri(i,k) * z_factor(i)
1745	ENDIF
1746	ENDDO
1747	ENDDO
1748	ENDIF
1749	zx_ajustq=.FALSE.
1750	c
1751	IF (nqmax.GT.2) THEN !--melange convectif de traceurs
1752	c
1753	IF (iflag_con.NE.2) THEN
1754	PRINT*, "Pour l instant, seul conflx fonctionne avec traceurs"
1755	PRINT*,' Mettre iflag_con = 2 dans run.def et repasser !'
1756	CALL abort
1757	ENDIF
1758	c
1759	ENDIF !--nqmax.GT.2
1760	c
1761	c Appeler l'ajustement sec
1762	c
1763	CALL ajsec(paprs, pplay, t_seri, q_seri, d_t_ajs, d_q_ajs)
1764	DO k = 1, klev
1765	DO i = 1, klon
1766	t_seri(i,k) = t_seri(i,k) + d_t_ajs(i,k)
1767	q_seri(i,k) = q_seri(i,k) + d_q_ajs(i,k)
1768	ENDDO
1769	ENDDO
1770	c
1771	c Appeler le processus de condensation a grande echelle
1772	c et le processus de precipitation
1773	c
1774	CALL fisrtilp_tr(dtime,paprs,pplay,
1775	. t_seri, q_seri,
1776	. d_t_lsc, d_q_lsc, d_ql_lsc, rneb, cldliq,
1777	. rain_lsc, snow_lsc,
1778	. pfrac_impa, pfrac_nucl, pfrac_1nucl,
1779	. frac_impa, frac_nucl,
1780	. prfl, psfl)
1781	DO k = 1, klev
1782	DO i = 1, klon
1783	t_seri(i,k) = t_seri(i,k) + d_t_lsc(i,k)
1784	q_seri(i,k) = q_seri(i,k) + d_q_lsc(i,k)
1785	ql_seri(i,k) = ql_seri(i,k) + d_ql_lsc(i,k)
1786	cldfra(i,k) = rneb(i,k)
1787	IF (.NOT.new_oliq) cldliq(i,k) = ql_seri(i,k)
1788	ENDDO
1789	ENDDO
1790	IF (check) THEN
1791	za = qcheck(klon,klev,paprs,q_seri,ql_seri,paire)
1792	PRINT*, "apresilp=", za
1793	zx_t = 0.0
1794	za = 0.0
1795	DO i = 1, klon
1796	za = za + paire(i)/FLOAT(klon)
1797	zx_t = zx_t + (rain_lsc(i)+snow_lsc(i))*paire(i)/FLOAT(klon)
1798	ENDDO
1799	zx_t = zx_t/za*dtime
1800	PRINT*, "Precip=", zx_t
1801	ENDIF
1802	c
1803	c Nuages diagnostiques:
1804	c
1805	IF (iflag_con.EQ.2) THEN ! seulement pour Tiedtke
1806	CALL diagcld1(paprs,pplay,
1807	. rain_con,snow_con,ibas_con,itop_con,
1808	. diafra,dialiq)
1809	DO k = 1, klev
1810	DO i = 1, klon
1811	IF (diafra(i,k).GT.cldfra(i,k)) THEN
1812	cldliq(i,k) = dialiq(i,k)
1813	cldfra(i,k) = diafra(i,k)
1814	ENDIF
1815	ENDDO
1816	ENDDO
1817	ENDIF
1818	c
1819	c Nuages stratus artificiels:
1820	c
1821	IF (ok_stratus) THEN
1822	CALL diagcld2(paprs,pplay,t_seri,q_seri, diafra,dialiq)
1823	DO k = 1, klev
1824	DO i = 1, klon
1825	IF (diafra(i,k).GT.cldfra(i,k)) THEN
1826	cldliq(i,k) = dialiq(i,k)
1827	cldfra(i,k) = diafra(i,k)
1828	ENDIF
1829	ENDDO
1830	ENDDO
1831	ENDIF
1832	c
1833	c Precipitation totale
1834	c
1835	DO i = 1, klon
1836	rain_fall(i) = rain_con(i) + rain_lsc(i)
1837	snow_fall(i) = snow_con(i) + snow_lsc(i)
1838	ENDDO
1839	c
1840	c Calculer l'humidite relative pour diagnostique
1841	c
1842	DO k = 1, klev
1843	DO i = 1, klon
1844	zx_t = t_seri(i,k)
1845	IF (thermcep) THEN
1846	zdelta = MAX(0.,SIGN(1.,rtt-zx_t))
1847	zx_qs = r2es * FOEEW(zx_t,zdelta)/pplay(i,k)
1848	zx_qs = MIN(0.5,zx_qs)
1849	zcor = 1./(1.-retv*zx_qs)
1850	zx_qs = zx_qs*zcor
1851	ELSE
1852	IF (zx_t.LT.t_coup) THEN
1853	zx_qs = qsats(zx_t)/pplay(i,k)
1854	ELSE
1855	zx_qs = qsatl(zx_t)/pplay(i,k)
1856	ENDIF
1857	ENDIF
1858	zx_rh(i,k) = q_seri(i,k)/zx_qs
1859	ENDDO
1860	ENDDO
1861	c
1862	c Calculer les parametres optiques des nuages et quelques
1863	c parametres pour diagnostiques:
1864	c
1865	CALL nuage (paprs, pplay,
1866	. t_seri, cldliq, cldfra, cldtau, cldemi,
1867	. cldh, cldl, cldm, cldt, cldq)
1868	c
1869	c Appeler le rayonnement mais calculer tout d'abord l'albedo du sol.
1870	c
1871	IF (MOD(itaprad,radpas).EQ.0) THEN
1872	c CALL orbite(FLOAT(julien),zlongi,dist)
1873	c IF (cycle_diurne) THEN
1874	c zdtime=dtime*FLOAT(radpas) ! pas de temps du rayonnement (s)
1875	c CALL zenang(zlongi,gmtime,zdtime,rlat,rlon,rmu0,fract)
1876	c CALL zenith(zlongi,gmtime,rlat,rlon,rmu0,fract) !va disparaitre
1877	c CALL alboc_cd(rmu0,alb_eau)
1878	c ELSE
1879	c CALL angle(zlongi,rlat,fract,rmu0)
1880	c CALL alboc(FLOAT(julien),rlat,alb_eau)
1881	c ENDIF
1882	c CALL albsno(veget,agesno,alb_neig)
1883	DO i = 1, klon
1884	c falbe(i,is_oce) = alb_eau(i)
1885	c IF (pctsrf(i,is_oce).GT.epsfra .AND. ftsol(i,is_oce).LT.271.35)
1886	c . falbe(i,is_oce) = 0.6 ! pour slab_ocean
1887	c zfra = MAX(0.0,MIN(1.0,fsnow(i,is_lic)/(fsnow(i,is_lic)+10.0)))
1888	c falbe(i,is_lic) = alb_neig(i)zfra + 0.6(1.0-zfra)
1889	c zfra = MAX(0.0,MIN(1.0,fsnow(i,is_ter)/(fsnow(i,is_ter)+10.0)))
1890	c falbe(i,is_ter) = alb_neig(i)zfra + lmt_alb(i)(1.0-zfra)
1891	c zfra = MAX(0.0,MIN(1.0,fsnow(i,is_sic)/(fsnow(i,is_sic)+10.0)))
1892	falbe(i,is_sic) = alb_neig(i)zfra + 0.6(1.0-zfra)
1893	albsol(i) = falbe(i,is_oce) * pctsrf(i,is_oce)
1894	. + falbe(i,is_lic) * pctsrf(i,is_lic)
1895	. + falbe(i,is_ter) * pctsrf(i,is_ter)
1896	. + falbe(i,is_sic) * pctsrf(i,is_sic)
1897	ENDDO
1898	c DO nsrf = 1, nbsrf
1899	c DO i = 1, klon
1900	c albsol(i) = albsol(i) + falbe(i,nsrf)*pctsrf(i,nsrf)
1901	c ENDDO
1902	c ENDDO
1903	CALL radlwsw ! nouveau rayonnement (compatible Arpege-IFS)
1904	e (dist, rmu0, fract, co2_ppm, solaire,
1905	e paprs, pplay,zxtsol,albsol, t_seri,q_seri,wo,
1906	e cldfra, cldemi, cldtau,
1907	s heat,heat0,cool,cool0,radsol,albpla,
1908	s topsw,toplw,solsw,sollw,
1909	s topsw0,toplw0,solsw0,sollw0)
1910	itaprad = 0
1911	ENDIF
1912	itaprad = itaprad + 1
1913	c
1914	c Ajouter la tendance des rayonnements (tous les pas)
1915	c
1916	DO k = 1, klev
1917	DO i = 1, klon
1918	t_seri(i,k) = t_seri(i,k)
1919	. + (heat(i,k)-cool(i,k)) * dtime/86400.
1920	ENDDO
1921	ENDDO
1922	c
1923	c Calculer l'hydrologie de la surface
1924	c
1925	c CALL hydrol(dtime,pctsrf,rain_fall, snow_fall, zxevap,
1926	c . agesno, ftsol,fqsol,fsnow, ruis)
1927	c
1928	DO i = 1, klon
1929	zxqsol(i) = 0.0
1930	zxsnow(i) = 0.0
1931	ENDDO
1932	DO nsrf = 1, nbsrf
1933	DO i = 1, klon
1934	zxqsol(i) = zxqsol(i) + fqsol(i,nsrf)*pctsrf(i,nsrf)
1935	zxsnow(i) = zxsnow(i) + fsnow(i,nsrf)*pctsrf(i,nsrf)
1936	ENDDO
1937	ENDDO
1938	c
1939	c Si une sous-fraction n'existe pas, elle prend la valeur moyenne
1940	c
1941	DO nsrf = 1, nbsrf
1942	DO i = 1, klon
1943	IF (pctsrf(i,nsrf).LT.epsfra) THEN
1944	fqsol(i,nsrf) = zxqsol(i)
1945	fsnow(i,nsrf) = zxsnow(i)
1946	ENDIF
1947	ENDDO
1948	ENDDO
1949	c
1950	c Calculer le bilan du sol et la derive de temperature (couplage)
1951	c
1952	DO i = 1, klon
1953	bils(i) = radsol(i) - sens(i) - evap(i)*RLVTT
1954	ENDDO
1955	IF (ok_ocean) THEN
1956	DO i = 1, klon
1957	cthermiq = cyang
1958	IF (ftsol(i,is_oce).LT. 271.35) cthermiq = cbing
1959	IF (pctsrf(i,is_oce).GT.epsfra) deltat(i) = deltat(i) +
1960	. (bils(i)-lmt_bils(i))/cthermiq * dtime
1961	IF (deltat(i).GT.15.0 ) deltat(i) = 15.0
1962	IF (deltat(i).LT.-15.0) deltat(i) = -15.0
1963	ENDDO
1964	ENDIF
1965	c
1966	cmoddeblott(jan95)
1967	c Appeler le programme de parametrisation de l'orographie
1968	c a l'echelle sous-maille:
1969	c
1970	IF (ok_orodr) THEN
1971	c
1972	c selection des points pour lesquels le shema est actif:
1973	igwd=0
1974	DO i=1,klon
1975	itest(i)=0
1976	c IF ((zstd(i).gt.10.0)) THEN
1977	IF (((zpic(i)-zmea(i)).GT.100.).AND.(zstd(i).GT.10.0)) THEN
1978	itest(i)=1
1979	igwd=igwd+1
1980	idx(igwd)=i
1981	ENDIF
1982	ENDDO
1983	igwdim=MAX(1,igwd)
1984	c
1985	CALL drag_noro(klon,klev,dtime,paprs,pplay,
1986	e zmea,zstd, zsig, zgam, zthe,zpic,zval,
1987	e igwd,igwdim,idx,itest,
1988	e t_seri, u_seri, v_seri,
1989	s zulow, zvlow, zustr, zvstr,
1990	s d_t_oro, d_u_oro, d_v_oro)
1991	c
1992	c ajout des tendances
1993	DO k = 1, klev
1994	DO i = 1, klon
1995	t_seri(i,k) = t_seri(i,k) + d_t_oro(i,k)
1996	u_seri(i,k) = u_seri(i,k) + d_u_oro(i,k)
1997	v_seri(i,k) = v_seri(i,k) + d_v_oro(i,k)
1998	ENDDO
1999	ENDDO
2000	c
2001	ENDIF ! fin de test sur ok_orodr
2002	c
2003	IF (ok_orolf) THEN
2004	c
2005	c selection des points pour lesquels le shema est actif:
2006	igwd=0
2007	DO i=1,klon
2008	itest(i)=0
2009	IF ((zpic(i)-zmea(i)).GT.100.) THEN
2010	itest(i)=1
2011	igwd=igwd+1
2012	idx(igwd)=i
2013	ENDIF
2014	ENDDO
2015	igwdim=MAX(1,igwd)
2016	c
2017	CALL lift_noro(klon,klev,dtime,paprs,pplay,
2018	e rlat,zmea,zstd, zsig, zgam, zthe,zpic,zval,
2019	e igwd,igwdim,idx,itest,
2020	e t_seri, u_seri, v_seri,
2021	s zulow, zvlow, zustr, zvstr,
2022	s d_t_lif, d_u_lif, d_v_lif)
2023	c
2024	c ajout des tendances
2025	DO k = 1, klev
2026	DO i = 1, klon
2027	t_seri(i,k) = t_seri(i,k) + d_t_lif(i,k)
2028	u_seri(i,k) = u_seri(i,k) + d_u_lif(i,k)
2029	v_seri(i,k) = v_seri(i,k) + d_v_lif(i,k)
2030	ENDDO
2031	ENDDO
2032	c
2033	ENDIF ! fin de test sur ok_orolf
2034	c
2035	cAA
2036	cAA Installation de l'interface online-offline pour traceurs
2037	cAA
2038	c====================================================================
2039	c Calcul des tendances traceurs
2040	c====================================================================
2041	CMAF modif pour garder info du nombre de traceurs auxquels
2042	C la physique s'applique
2043	C
2044	call phytrac (rnpb,
2045	I debut,
2046	I nqmax-2,
2047	I nlon,nlev,dtime,
2048	I t,paprs,pplay,
2049	I pmfu, pmfd, pen_u, pde_u, pen_d, pde_d,
2050	I ycoefh,yu1,yv1,ftsol,pctsrf,rlat,
2051	I frac_impa, frac_nucl,
2052	I rlon,presnivs,paire,pphis,
2053	O tr_seri)
2054
2055	IF (offline) THEN
2056
2057	call phystokenc (
2058	I nlon,nlev,pdtphys,rlon,rlat,
2059	I pmfu, pmfd, pen_u, pde_u, pen_d, pde_d,
2060	I ycoefh,yu1,yv1,ftsol,pctsrf,
2061	I frac_impa, frac_nucl,
2062	I pphis,paire,dtime,itap,
2063	O physid)
2064
2065	ENDIF
2066
2067	c
2068	c Calculer le transport de l'eau et de l'energie (diagnostique)
2069	c
2070	CALL transp (paprs,zxtsol,
2071	e t_seri, q_seri, u_seri, v_seri, zphi,
2072	s ve, vq, ue, uq)
2073	c
2074	c Accumuler les variables a stocker dans les fichiers histoire:
2075	c
2076	c
2077	c
2078
2079	IF (ok_journe) THEN
2080	c
2081	ndex2d = 0
2082	ndex3d = 0
2083	c
2084	c Champs 2D:
2085	c
2086	i = NINT(zout/zsto)
2087	CALL gr_fi_ecrit(1,klon,iim,jjmp1,pphis,zx_tmp_2d)
2088	CALL histwrite(nid_day,"phis",i,zx_tmp_2d,iim*jjmp1,ndex2d)
2089	c
2090	i = NINT(zout/zsto)
2091	CALL gr_fi_ecrit(1,klon,iim,jjmp1,paire,zx_tmp_2d)
2092	CALL histwrite(nid_day,"aire",i,zx_tmp_2d,iim*jjmp1,ndex2d)
2093	C
2094	CALL gr_fi_ecrit(1, klon,iim,jjmp1, zxtsol,zx_tmp_2d)
2095	CALL histwrite(nid_day,"tsol",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2096	c
2097	C
2098	zx_tmp_fi2d(1 : klon) = ftsol(1 : klon, is_ter)
2099	CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d ,zx_tmp_2d)
2100	CALL histwrite(nid_day,"tter",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2101	C
2102	zx_tmp_fi2d(1 : klon) = ftsol(1 : klon, is_lic)
2103	CALL gr_fi_ecrit(1, klon,iim,jjmp1, zxtsol,zx_tmp_2d)
2104	CALL histwrite(nid_day,"tlic",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2105	C
2106	zx_tmp_fi2d(1 : klon) = ftsol(1 : klon, is_oce)
2107	CALL gr_fi_ecrit(1, klon,iim,jjmp1, zxtsol,zx_tmp_2d)
2108	CALL histwrite(nid_day,"toce",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2109	C
2110	zx_tmp_fi2d(1 : klon) = ftsol(1 : klon, is_sic)
2111	CALL gr_fi_ecrit(1, klon,iim,jjmp1, zxtsol,zx_tmp_2d)
2112	CALL histwrite(nid_day,"tsic",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2113	C
2114	DO i = 1, klon
2115	zx_tmp_fi2d(i) = paprs(i,1)
2116	ENDDO
2117	CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d,zx_tmp_2d)
2118	CALL histwrite(nid_day,"psol",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2119	c
2120	DO i = 1, klon
2121	zx_tmp_fi2d(i) = rain_fall(i) + snow_fall(i)
2122	ENDDO
2123	CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d,zx_tmp_2d)
2124	CALL histwrite(nid_day,"rain",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2125	c
2126	CALL gr_fi_ecrit(1, klon,iim,jjmp1, snow_fall,zx_tmp_2d)
2127	CALL histwrite(nid_day,"snow",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2128	c
2129	CALL gr_fi_ecrit(1, klon,iim,jjmp1, evap,zx_tmp_2d)
2130	CALL histwrite(nid_day,"evap",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2131	c
2132	CALL gr_fi_ecrit(1, klon,iim,jjmp1, topsw,zx_tmp_2d)
2133	CALL histwrite(nid_day,"tops",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2134	c
2135	CALL gr_fi_ecrit(1, klon,iim,jjmp1, toplw,zx_tmp_2d)
2136	CALL histwrite(nid_day,"topl",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2137	c
2138	CALL gr_fi_ecrit(1, klon,iim,jjmp1, solsw,zx_tmp_2d)
2139	CALL histwrite(nid_day,"sols",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2140	c
2141	CALL gr_fi_ecrit(1, klon,iim,jjmp1, sollw,zx_tmp_2d)
2142	CALL histwrite(nid_day,"soll",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2143	c
2144	CALL gr_fi_ecrit(1, klon,iim,jjmp1, bils,zx_tmp_2d)
2145	CALL histwrite(nid_day,"bils",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2146	c
2147	CALL gr_fi_ecrit(1, klon,iim,jjmp1, sens,zx_tmp_2d)
2148	CALL histwrite(nid_day,"sens",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2149	c
2150	CALL gr_fi_ecrit(1, klon,iim,jjmp1, fder,zx_tmp_2d)
2151	CALL histwrite(nid_day,"fder",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2152	c
2153	CALL gr_fi_ecrit(1, klon,iim,jjmp1, ruis,zx_tmp_2d)
2154	CALL histwrite(nid_day,"ruis",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2155	c
2156	c DO i = 1, klon
2157	c zx_tmp_fi2d(i) = fluxu(i,1)
2158	c ENDDO
2159	c CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d,zx_tmp_2d)
2160	c CALL histwrite(nid_day,"frtu",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2161	c
2162	c DO i = 1, klon
2163	c zx_tmp_fi2d(i) = fluxv(i,1)
2164	c ENDDO
2165	c CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d,zx_tmp_2d)
2166	c CALL histwrite(nid_day,"frtv",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2167	c
2168	DO nsrf = 1, nbsrf
2169	C§§§
2170	zx_tmp_fi2d(1 : klon) = pctsrf( 1 : klon, nsrf)
2171	CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d , zx_tmp_2d)
2172	CALL histwrite(nid_day,"pourc_"//clnsurf(nsrf),itap,
2173	$ zx_tmp_2d,iim*jjmp1,ndex2d)
2174	C
2175	zx_tmp_fi2d(1 : klon) = - fluxt( 1 : klon, 1, nsrf)
2176	CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d , zx_tmp_2d)
2177	CALL histwrite(nid_day,"sens_"//clnsurf(nsrf),itap,
2178	$ zx_tmp_2d,iim*jjmp1,ndex2d)
2179	C
2180	zx_tmp_fi2d(1 : klon) = - fluxq( 1 : klon, 1, nsrf)
2181	CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d , zx_tmp_2d)
2182	CALL histwrite(nid_day,"lat_"//clnsurf(nsrf),itap,
2183	$ zx_tmp_2d,iim*jjmp1,ndex2d)
2184	C
2185	zx_tmp_fi2d(1 : klon) = - fluxu( 1 : klon, 1, nsrf)
2186	CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d , zx_tmp_2d)
2187	CALL histwrite(nid_day,"taux_"//clnsurf(nsrf),itap,
2188	$ zx_tmp_2d,iim*jjmp1,ndex2d)
2189	C
2190	zx_tmp_fi2d(1 : klon) = - fluxv( 1 : klon, 1, nsrf)
2191	CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d , zx_tmp_2d)
2192	CALL histwrite(nid_day,"tauy_"//clnsurf(nsrf),itap,
2193	$ zx_tmp_2d,iim*jjmp1,ndex2d)
2194	C
2195	END DO
2196	C
2197	c$$$ DO i = 1, klon
2198	c$$$ zx_tmp_fi2d(i) = pctsrf(i,is_sic)
2199	c$$$ ENDDO
2200	c$$$ CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d,zx_tmp_2d)
2201	c$$$ CALL histwrite(nid_day,"sicf",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2202	c
2203	CALL gr_fi_ecrit(1, klon,iim,jjmp1, cldl,zx_tmp_2d)
2204	CALL histwrite(nid_day,"cldl",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2205	c
2206	CALL gr_fi_ecrit(1, klon,iim,jjmp1, cldm,zx_tmp_2d)
2207	CALL histwrite(nid_day,"cldm",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2208	c
2209	CALL gr_fi_ecrit(1, klon,iim,jjmp1, cldh,zx_tmp_2d)
2210	CALL histwrite(nid_day,"cldh",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2211	c
2212	CALL gr_fi_ecrit(1, klon,iim,jjmp1, cldt,zx_tmp_2d)
2213	CALL histwrite(nid_day,"cldt",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2214	c
2215	CALL gr_fi_ecrit(1, klon,iim,jjmp1, cldq,zx_tmp_2d)
2216	CALL histwrite(nid_day,"cldq",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2217	c
2218	c Champs 3D:
2219	c
2220	CALL gr_fi_ecrit(klev,klon,iim,jjmp1, t_seri, zx_tmp_3d)
2221	CALL histwrite(nid_day,"temp",itap,zx_tmp_3d,
2222	. iimjjmp1klev,ndex3d)
2223	c
2224	CALL gr_fi_ecrit(klev,klon,iim,jjmp1, qx(1,1,ivap), zx_tmp_3d)
2225	CALL histwrite(nid_day,"ovap",itap,zx_tmp_3d,
2226	. iimjjmp1klev,ndex3d)
2227	c
2228	CALL gr_fi_ecrit(klev,klon,iim,jjmp1, zphi, zx_tmp_3d)
2229	CALL histwrite(nid_day,"geop",itap,zx_tmp_3d,
2230	. iimjjmp1klev,ndex3d)
2231	c
2232	CALL gr_fi_ecrit(klev,klon,iim,jjmp1, u_seri, zx_tmp_3d)
2233	CALL histwrite(nid_day,"vitu",itap,zx_tmp_3d,
2234	. iimjjmp1klev,ndex3d)
2235	c
2236	CALL gr_fi_ecrit(klev,klon,iim,jjmp1, v_seri, zx_tmp_3d)
2237	CALL histwrite(nid_day,"vitv",itap,zx_tmp_3d,
2238	. iimjjmp1klev,ndex3d)
2239	c
2240	CALL gr_fi_ecrit(klev,klon,iim,jjmp1, omega, zx_tmp_3d)
2241	CALL histwrite(nid_day,"vitw",itap,zx_tmp_3d,
2242	. iimjjmp1klev,ndex3d)
2243	c
2244	CALL gr_fi_ecrit(klev,klon,iim,jjmp1, pplay, zx_tmp_3d)
2245	CALL histwrite(nid_day,"pres",itap,zx_tmp_3d,
2246	. iimjjmp1klev,ndex3d)
2247	c
2248	if (ok_sync) then
2249	call histsync(nid_day)
2250	endif
2251	ENDIF
2252	C
2253	IF (ok_mensuel) THEN
2254	c
2255	ndex2d = 0
2256	ndex3d = 0
2257	c
2258	c Champs 2D:
2259	c
2260	i = NINT(zout/zsto)
2261	CALL gr_fi_ecrit(1,klon,iim,jjmp1,pphis,zx_tmp_2d)
2262	CALL histwrite(nid_mth,"phis",i,zx_tmp_2d,iim*jjmp1,ndex2d)
2263	C
2264	i = NINT(zout/zsto)
2265	CALL gr_fi_ecrit(1,klon,iim,jjmp1,paire,zx_tmp_2d)
2266	CALL histwrite(nid_mth,"aire",i,zx_tmp_2d,iim*jjmp1,ndex2d)
2267
2268	CALL gr_fi_ecrit(1, klon,iim,jjmp1, zxtsol,zx_tmp_2d)
2269	CALL histwrite(nid_mth,"tsol",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2270	c
2271	DO i = 1, klon
2272	zx_tmp_fi2d(i) = paprs(i,1)
2273	ENDDO
2274	CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d,zx_tmp_2d)
2275	CALL histwrite(nid_mth,"psol",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2276	c
2277	CALL gr_fi_ecrit(1, klon,iim,jjmp1, zxqsol,zx_tmp_2d)
2278	CALL histwrite(nid_mth,"qsol",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2279	c
2280	DO i = 1, klon
2281	zx_tmp_fi2d(i) = rain_fall(i) + snow_fall(i)
2282	ENDDO
2283	CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d,zx_tmp_2d)
2284	CALL histwrite(nid_mth,"rain",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2285	c
2286	DO i = 1, klon
2287	zx_tmp_fi2d(i) = rain_lsc(i) + snow_lsc(i)
2288	ENDDO
2289	CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d,zx_tmp_2d)
2290	CALL histwrite(nid_mth,"plul",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2291	c
2292	DO i = 1, klon
2293	zx_tmp_fi2d(i) = rain_con(i) + snow_con(i)
2294	ENDDO
2295	CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d,zx_tmp_2d)
2296	CALL histwrite(nid_mth,"pluc",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2297	c
2298	CALL gr_fi_ecrit(1, klon,iim,jjmp1, snow_fall,zx_tmp_2d)
2299	CALL histwrite(nid_mth,"snow",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2300	c
2301	CALL gr_fi_ecrit(1, klon,iim,jjmp1, agesno,zx_tmp_2d)
2302	CALL histwrite(nid_mth,"ages",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2303	c
2304	CALL gr_fi_ecrit(1, klon,iim,jjmp1, evap,zx_tmp_2d)
2305	CALL histwrite(nid_mth,"evap",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2306	c
2307	CALL gr_fi_ecrit(1, klon,iim,jjmp1, topsw,zx_tmp_2d)
2308	CALL histwrite(nid_mth,"tops",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2309	c
2310	CALL gr_fi_ecrit(1, klon,iim,jjmp1, toplw,zx_tmp_2d)
2311	CALL histwrite(nid_mth,"topl",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2312	c
2313	CALL gr_fi_ecrit(1, klon,iim,jjmp1, solsw,zx_tmp_2d)
2314	CALL histwrite(nid_mth,"sols",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2315	c
2316	CALL gr_fi_ecrit(1, klon,iim,jjmp1, sollw,zx_tmp_2d)
2317	CALL histwrite(nid_mth,"soll",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2318	c
2319	CALL gr_fi_ecrit(1, klon,iim,jjmp1, topsw0,zx_tmp_2d)
2320	CALL histwrite(nid_mth,"tops0",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2321	c
2322	CALL gr_fi_ecrit(1, klon,iim,jjmp1, toplw0,zx_tmp_2d)
2323	CALL histwrite(nid_mth,"topl0",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2324	c
2325	CALL gr_fi_ecrit(1, klon,iim,jjmp1, solsw0,zx_tmp_2d)
2326	CALL histwrite(nid_mth,"sols0",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2327	c
2328	CALL gr_fi_ecrit(1, klon,iim,jjmp1, sollw0,zx_tmp_2d)
2329	CALL histwrite(nid_mth,"soll0",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2330	c
2331	CALL gr_fi_ecrit(1, klon,iim,jjmp1, bils,zx_tmp_2d)
2332	CALL histwrite(nid_mth,"bils",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2333	c
2334	CALL gr_fi_ecrit(1, klon,iim,jjmp1, sens,zx_tmp_2d)
2335	CALL histwrite(nid_mth,"sens",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2336	c
2337	CALL gr_fi_ecrit(1, klon,iim,jjmp1, fder,zx_tmp_2d)
2338	CALL histwrite(nid_mth,"fder",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2339	c
2340	CALL gr_fi_ecrit(1, klon,iim,jjmp1, ruis,zx_tmp_2d)
2341	CALL histwrite(nid_mth,"ruis",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2342	c
2343	c DO i = 1, klon
2344	c zx_tmp_fi2d(i) = fluxu(i,1)
2345	c ENDDO
2346	c CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d,zx_tmp_2d)
2347	c CALL histwrite(nid_mth,"frtu",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2348	c
2349	c DO i = 1, klon
2350	c zx_tmp_fi2d(i) = fluxv(i,1)
2351	c ENDDO
2352	c CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d,zx_tmp_2d)
2353	c CALL histwrite(nid_mth,"frtv",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2354	c
2355	DO nsrf = 1, nbsrf
2356	C§§§
2357	zx_tmp_fi2d(1 : klon) = pctsrf( 1 : klon, nsrf)
2358	CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d , zx_tmp_2d)
2359	CALL histwrite(nid_mth,"pourc_"//clnsurf(nsrf),itap,
2360	$ zx_tmp_2d,iim*jjmp1,ndex2d)
2361	C
2362	zx_tmp_fi2d(1 : klon) = - fluxt( 1 : klon, 1, nsrf)
2363	CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d , zx_tmp_2d)
2364	CALL histwrite(nid_mth,"sens_"//clnsurf(nsrf),itap,
2365	$ zx_tmp_2d,iim*jjmp1,ndex2d)
2366	C
2367	zx_tmp_fi2d(1 : klon) = - fluxq( 1 : klon, 1, nsrf)
2368	CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d , zx_tmp_2d)
2369	CALL histwrite(nid_mth,"lat_"//clnsurf(nsrf),itap,
2370	$ zx_tmp_2d,iim*jjmp1,ndex2d)
2371	C
2372	zx_tmp_fi2d(1 : klon) = - fluxu( 1 : klon, 1, nsrf)
2373	CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d , zx_tmp_2d)
2374	CALL histwrite(nid_mth,"taux_"//clnsurf(nsrf),itap,
2375	$ zx_tmp_2d,iim*jjmp1,ndex2d)
2376	C
2377	zx_tmp_fi2d(1 : klon) = - fluxv( 1 : klon, 1, nsrf)
2378	CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d , zx_tmp_2d)
2379	CALL histwrite(nid_mth,"tauy_"//clnsurf(nsrf),itap,
2380	$ zx_tmp_2d,iim*jjmp1,ndex2d)
2381	C
2382	END DO
2383	c$$$ DO i = 1, klon
2384	c$$$ zx_tmp_fi2d(i) = pctsrf(i,is_sic)
2385	c$$$ ENDDO
2386	c$$$ CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d,zx_tmp_2d)
2387	c$$$ CALL histwrite(nid_mth,"sicf",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2388	c
2389	CALL gr_fi_ecrit(1, klon,iim,jjmp1, albsol,zx_tmp_2d)
2390	CALL histwrite(nid_mth,"albs",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2391	c
2392	CALL gr_fi_ecrit(1, klon,iim,jjmp1, cdragm,zx_tmp_2d)
2393	CALL histwrite(nid_mth,"cdrm",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2394	c
2395	CALL gr_fi_ecrit(1, klon,iim,jjmp1, cdragh,zx_tmp_2d)
2396	CALL histwrite(nid_mth,"cdrh",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2397	c
2398	CALL gr_fi_ecrit(1, klon,iim,jjmp1, cldl,zx_tmp_2d)
2399	CALL histwrite(nid_mth,"cldl",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2400	c
2401	CALL gr_fi_ecrit(1, klon,iim,jjmp1, cldm,zx_tmp_2d)
2402	CALL histwrite(nid_mth,"cldm",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2403	c
2404	CALL gr_fi_ecrit(1, klon,iim,jjmp1, cldh,zx_tmp_2d)
2405	CALL histwrite(nid_mth,"cldh",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2406	c
2407	CALL gr_fi_ecrit(1, klon,iim,jjmp1, cldt,zx_tmp_2d)
2408	CALL histwrite(nid_mth,"cldt",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2409	c
2410	CALL gr_fi_ecrit(1, klon,iim,jjmp1, cldq,zx_tmp_2d)
2411	CALL histwrite(nid_mth,"cldq",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2412	c
2413	CALL gr_fi_ecrit(1, klon,iim,jjmp1, ue,zx_tmp_2d)
2414	CALL histwrite(nid_mth,"ue",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2415	c
2416	CALL gr_fi_ecrit(1, klon,iim,jjmp1, ve,zx_tmp_2d)
2417	CALL histwrite(nid_mth,"ve",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2418	c
2419	CALL gr_fi_ecrit(1, klon,iim,jjmp1, uq,zx_tmp_2d)
2420	CALL histwrite(nid_mth,"uq",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2421	c
2422	CALL gr_fi_ecrit(1, klon,iim,jjmp1, vq,zx_tmp_2d)
2423	CALL histwrite(nid_mth,"vq",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2424	c
2425	c Champs 3D:
2426	C
2427	CALL gr_fi_ecrit(klev,klon,iim,jjmp1, t_seri, zx_tmp_3d)
2428	CALL histwrite(nid_mth,"temp",itap,zx_tmp_3d,
2429	. iimjjmp1klev,ndex3d)
2430	c
2431	CALL gr_fi_ecrit(klev,klon,iim,jjmp1, qx(1,1,ivap), zx_tmp_3d)
2432	CALL histwrite(nid_mth,"ovap",itap,zx_tmp_3d,
2433	. iimjjmp1klev,ndex3d)
2434	c
2435	CALL gr_fi_ecrit(klev,klon,iim,jjmp1, zphi, zx_tmp_3d)
2436	CALL histwrite(nid_mth,"geop",itap,zx_tmp_3d,
2437	. iimjjmp1klev,ndex3d)
2438	c
2439	CALL gr_fi_ecrit(klev,klon,iim,jjmp1, u_seri, zx_tmp_3d)
2440	CALL histwrite(nid_mth,"vitu",itap,zx_tmp_3d,
2441	. iimjjmp1klev,ndex3d)
2442	c
2443	CALL gr_fi_ecrit(klev,klon,iim,jjmp1, v_seri, zx_tmp_3d)
2444	CALL histwrite(nid_mth,"vitv",itap,zx_tmp_3d,
2445	. iimjjmp1klev,ndex3d)
2446	c
2447	CALL gr_fi_ecrit(klev,klon,iim,jjmp1, omega, zx_tmp_3d)
2448	CALL histwrite(nid_mth,"vitw",itap,zx_tmp_3d,
2449	. iimjjmp1klev,ndex3d)
2450	c
2451	CALL gr_fi_ecrit(klev,klon,iim,jjmp1, pplay, zx_tmp_3d)
2452	CALL histwrite(nid_mth,"pres",itap,zx_tmp_3d,
2453	. iimjjmp1klev,ndex3d)
2454	c
2455	CALL gr_fi_ecrit(klev,klon,iim,jjmp1, cldfra, zx_tmp_3d)
2456	CALL histwrite(nid_mth,"rneb",itap,zx_tmp_3d,
2457	. iimjjmp1klev,ndex3d)
2458	c
2459	CALL gr_fi_ecrit(klev,klon,iim,jjmp1, zx_rh, zx_tmp_3d)
2460	CALL histwrite(nid_mth,"rhum",itap,zx_tmp_3d,
2461	. iimjjmp1klev,ndex3d)
2462	c
2463	CALL gr_fi_ecrit(klev,klon,iim,jjmp1, cldliq, zx_tmp_3d)
2464	CALL histwrite(nid_mth,"oliq",itap,zx_tmp_3d,
2465	. iimjjmp1klev,ndex3d)
2466	c
2467	CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_t_dyn, zx_tmp_3d)
2468	CALL histwrite(nid_mth,"dtdyn",itap,zx_tmp_3d,
2469	. iimjjmp1klev,ndex3d)
2470	c
2471	CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_q_dyn, zx_tmp_3d)
2472	CALL histwrite(nid_mth,"dqdyn",itap,zx_tmp_3d,
2473	. iimjjmp1klev,ndex3d)
2474	c
2475	CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_t_con, zx_tmp_3d)
2476	CALL histwrite(nid_mth,"dtcon",itap,zx_tmp_3d,
2477	. iimjjmp1klev,ndex3d)
2478	c
2479	CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_q_con, zx_tmp_3d)
2480	CALL histwrite(nid_mth,"dqcon",itap,zx_tmp_3d,
2481	. iimjjmp1klev,ndex3d)
2482	c
2483	CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_t_lsc, zx_tmp_3d)
2484	CALL histwrite(nid_mth,"dtlsc",itap,zx_tmp_3d,
2485	. iimjjmp1klev,ndex3d)
2486	c
2487	CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_q_lsc, zx_tmp_3d)
2488	CALL histwrite(nid_mth,"dqlsc",itap,zx_tmp_3d,
2489	. iimjjmp1klev,ndex3d)
2490	c
2491	CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_t_vdf, zx_tmp_3d)
2492	CALL histwrite(nid_mth,"dtvdf",itap,zx_tmp_3d,
2493	. iimjjmp1klev,ndex3d)
2494	c
2495	CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_q_vdf, zx_tmp_3d)
2496	CALL histwrite(nid_mth,"dqvdf",itap,zx_tmp_3d,
2497	. iimjjmp1klev,ndex3d)
2498	c
2499	CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_t_eva, zx_tmp_3d)
2500	CALL histwrite(nid_mth,"dteva",itap,zx_tmp_3d,
2501	. iimjjmp1klev,ndex3d)
2502	c
2503	CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_q_eva, zx_tmp_3d)
2504	CALL histwrite(nid_mth,"dqeva",itap,zx_tmp_3d,
2505	. iimjjmp1klev,ndex3d)
2506	c
2507	CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_t_ajs, zx_tmp_3d)
2508	CALL histwrite(nid_mth,"dtajs",itap,zx_tmp_3d,
2509	. iimjjmp1klev,ndex3d)
2510	c
2511	CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_q_ajs, zx_tmp_3d)
2512	CALL histwrite(nid_mth,"dqajs",itap,zx_tmp_3d,
2513	. iimjjmp1klev,ndex3d)
2514	c
2515	CALL gr_fi_ecrit(klev,klon,iim,jjmp1, heat, zx_tmp_3d)
2516	CALL histwrite(nid_mth,"dtswr",itap,zx_tmp_3d,
2517	. iimjjmp1klev,ndex3d)
2518	c
2519	CALL gr_fi_ecrit(klev,klon,iim,jjmp1, heat0, zx_tmp_3d)
2520	CALL histwrite(nid_mth,"dtsw0",itap,zx_tmp_3d,
2521	. iimjjmp1klev,ndex3d)
2522	c
2523	CALL gr_fi_ecrit(klev,klon,iim,jjmp1, cool, zx_tmp_3d)
2524	CALL histwrite(nid_mth,"dtlwr",itap,zx_tmp_3d,
2525	. iimjjmp1klev,ndex3d)
2526	c
2527	CALL gr_fi_ecrit(klev,klon,iim,jjmp1, cool0, zx_tmp_3d)
2528	CALL histwrite(nid_mth,"dtlw0",itap,zx_tmp_3d,
2529	. iimjjmp1klev,ndex3d)
2530	c
2531	CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_u_vdf, zx_tmp_3d)
2532	CALL histwrite(nid_mth,"duvdf",itap,zx_tmp_3d,
2533	. iimjjmp1klev,ndex3d)
2534	c
2535	CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_v_vdf, zx_tmp_3d)
2536	CALL histwrite(nid_mth,"dvvdf",itap,zx_tmp_3d,
2537	. iimjjmp1klev,ndex3d)
2538	c
2539	IF (ok_orodr) THEN
2540	CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_u_oro, zx_tmp_3d)
2541	CALL histwrite(nid_mth,"duoro",itap,zx_tmp_3d,
2542	. iimjjmp1klev,ndex3d)
2543	c
2544	CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_v_oro, zx_tmp_3d)
2545	CALL histwrite(nid_mth,"dvoro",itap,zx_tmp_3d,
2546	. iimjjmp1klev,ndex3d)
2547	c
2548	ENDIF
2549	C
2550	IF (ok_orolf) THEN
2551	CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_u_lif, zx_tmp_3d)
2552	CALL histwrite(nid_mth,"dulif",itap,zx_tmp_3d,
2553	. iimjjmp1klev,ndex3d)
2554	c
2555	CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_v_lif, zx_tmp_3d)
2556	CALL histwrite(nid_mth,"dvlif",itap,zx_tmp_3d,
2557	. iimjjmp1klev,ndex3d)
2558	ENDIF
2559	C
2560	CALL gr_fi_ecrit(klev,klon,iim,jjmp1, wo, zx_tmp_3d)
2561	CALL histwrite(nid_mth,"ozone",itap,zx_tmp_3d,
2562	. iimjjmp1klev,ndex3d)
2563	c
2564	IF (nqmax.GE.3) THEN
2565	DO iq=1,nqmax-2
2566	IF (iq.LE.99) THEN
2567	CALL gr_fi_ecrit(klev,klon,iim,jjmp1, qx(1,1,iq+2), zx_tmp_3d)
2568	WRITE(str2,'(i2.2)') iq
2569	CALL histwrite(nid_mth,"trac"//str2,itap,zx_tmp_3d,
2570	. iimjjmp1klev,ndex3d)
2571	ELSE
2572	PRINT*, "Trop de traceurs"
2573	CALL abort
2574	ENDIF
2575	ENDDO
2576	ENDIF
2577	c
2578	if (ok_sync) then
2579	call histsync(nid_mth)
2580	endif
2581	ENDIF
2582	c
2583	IF (ok_instan) THEN
2584	c
2585	ndex2d = 0
2586	ndex3d = 0
2587	c
2588	c Champs 2D:
2589	c
2590	i = NINT(zout/zsto)
2591	CALL gr_fi_ecrit(1,klon,iim,jjmp1,pphis,zx_tmp_2d)
2592	CALL histwrite(nid_ins,"phis",i,zx_tmp_2d,iim*jjmp1,ndex2d)
2593	c
2594	i = NINT(zout/zsto)
2595	CALL gr_fi_ecrit(1,klon,iim,jjmp1,paire,zx_tmp_2d)
2596	CALL histwrite(nid_ins,"aire",i,zx_tmp_2d,iim*jjmp1,ndex2d)
2597
2598	DO i = 1, klon
2599	zx_tmp_fi2d(i) = paprs(i,1)
2600	ENDDO
2601	CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d,zx_tmp_2d)
2602	CALL histwrite(nid_ins,"psol",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2603	c
2604	CALL gr_fi_ecrit(1, klon,iim,jjmp1, zxtsol,zx_tmp_2d)
2605	CALL histwrite(nid_ins,"tsol",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2606	c
2607	CALL gr_fi_ecrit(1, klon,iim,jjmp1, toplw,zx_tmp_2d)
2608	CALL histwrite(nid_ins,"topl",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2609	c
2610	CALL gr_fi_ecrit(1, klon,iim,jjmp1, evap,zx_tmp_2d)
2611	CALL histwrite(nid_ins,"evap",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2612	c
2613	CALL gr_fi_ecrit(1, klon,iim,jjmp1, solsw,zx_tmp_2d)
2614	CALL histwrite(nid_ins,"sols",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2615	c
2616	CALL gr_fi_ecrit(1, klon,iim,jjmp1, sollw,zx_tmp_2d)
2617	CALL histwrite(nid_ins,"soll",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2618	c
2619	CALL gr_fi_ecrit(1, klon,iim,jjmp1, bils,zx_tmp_2d)
2620	CALL histwrite(nid_ins,"bils",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2621	c
2622	CALL gr_fi_ecrit(1, klon,iim,jjmp1, sens,zx_tmp_2d)
2623	CALL histwrite(nid_ins,"sens",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2624	c
2625	CALL gr_fi_ecrit(1, klon,iim,jjmp1, fder,zx_tmp_2d)
2626	CALL histwrite(nid_ins,"fder",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2627	c
2628	CALL gr_fi_ecrit(1, klon,iim,jjmp1, d_ts(1,is_oce),zx_tmp_2d)
2629	CALL histwrite(nid_ins,"dtsvdfo",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2630	c
2631	CALL gr_fi_ecrit(1, klon,iim,jjmp1, d_ts(1,is_ter),zx_tmp_2d)
2632	CALL histwrite(nid_ins,"dtsvdft",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2633	c
2634	CALL gr_fi_ecrit(1, klon,iim,jjmp1, d_ts(1,is_lic),zx_tmp_2d)
2635	CALL histwrite(nid_ins,"dtsvdfg",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2636	c
2637	CALL gr_fi_ecrit(1, klon,iim,jjmp1, d_ts(1,is_sic),zx_tmp_2d)
2638	CALL histwrite(nid_ins,"dtsvdfi",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2639
2640	DO nsrf = 1, nbsrf
2641	C§§§
2642	zx_tmp_fi2d(1 : klon) = pctsrf( 1 : klon, nsrf)
2643	CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d , zx_tmp_2d)
2644	CALL histwrite(nid_ins,"pourc_"//clnsurf(nsrf),itap,
2645	$ zx_tmp_2d,iim*jjmp1,ndex2d)
2646	C
2647	zx_tmp_fi2d(1 : klon) = - fluxt( 1 : klon, 1, nsrf)
2648	CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d , zx_tmp_2d)
2649	CALL histwrite(nid_ins,"sens_"//clnsurf(nsrf),itap,
2650	$ zx_tmp_2d,iim*jjmp1,ndex2d)
2651	C
2652	zx_tmp_fi2d(1 : klon) = - fluxq( 1 : klon, 1, nsrf)
2653	CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d , zx_tmp_2d)
2654	CALL histwrite(nid_ins,"lat_"//clnsurf(nsrf),itap,
2655	$ zx_tmp_2d,iim*jjmp1,ndex2d)
2656	C
2657	zx_tmp_fi2d(1 : klon) = ftsol( 1 : klon, nsrf)
2658	CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d , zx_tmp_2d)
2659	CALL histwrite(nid_ins,"tsol_"//clnsurf(nsrf),itap,
2660	$ zx_tmp_2d,iim*jjmp1,ndex2d)
2661	C
2662	zx_tmp_fi2d(1 : klon) = - fluxu( 1 : klon, 1, nsrf)
2663	CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d , zx_tmp_2d)
2664	CALL histwrite(nid_ins,"taux_"//clnsurf(nsrf),itap,
2665	$ zx_tmp_2d,iim*jjmp1,ndex2d)
2666	C
2667	zx_tmp_fi2d(1 : klon) = - fluxv( 1 : klon, 1, nsrf)
2668	CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d , zx_tmp_2d)
2669	CALL histwrite(nid_ins,"tauy_"//clnsurf(nsrf),itap,
2670	$ zx_tmp_2d,iim*jjmp1,ndex2d)
2671	C
2672	END DO
2673
2674	c
2675	c Champs 3D:
2676	c
2677	CALL gr_fi_ecrit(klev,klon,iim,jjmp1, t_seri, zx_tmp_3d)
2678	CALL histwrite(nid_ins,"temp",itap,zx_tmp_3d,
2679	. iimjjmp1klev,ndex3d)
2680	c
2681	CALL gr_fi_ecrit(klev,klon,iim,jjmp1, u_seri, zx_tmp_3d)
2682	CALL histwrite(nid_ins,"vitu",itap,zx_tmp_3d,
2683	. iimjjmp1klev,ndex3d)
2684	c
2685	CALL gr_fi_ecrit(klev,klon,iim,jjmp1, v_seri, zx_tmp_3d)
2686	CALL histwrite(nid_ins,"vitv",itap,zx_tmp_3d,
2687	. iimjjmp1klev,ndex3d)
2688	c
2689	CALL gr_fi_ecrit(klev,klon,iim,jjmp1, zphi, zx_tmp_3d)
2690	CALL histwrite(nid_ins,"geop",itap,zx_tmp_3d,
2691	. iimjjmp1klev,ndex3d)
2692	c
2693	CALL gr_fi_ecrit(klev,klon,iim,jjmp1, pplay, zx_tmp_3d)
2694	CALL histwrite(nid_ins,"pres",itap,zx_tmp_3d,
2695	. iimjjmp1klev,ndex3d)
2696	c
2697	CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_t_vdf, zx_tmp_3d)
2698	CALL histwrite(nid_ins,"dtvdf",itap,zx_tmp_3d,
2699	. iimjjmp1klev,ndex3d)
2700	c
2701	CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_q_vdf, zx_tmp_3d)
2702	CALL histwrite(nid_ins,"dqvdf",itap,zx_tmp_3d,
2703	. iimjjmp1klev,ndex3d)
2704
2705	c
2706	if (ok_sync) then
2707	call histsync(nid_ins)
2708	endif
2709	ENDIF
2710	c
2711	c
2712	c Ecrire la bande regionale (binaire grads)
2713	IF (ok_region .AND. mod(itap,ecrit_reg).eq.0) THEN
2714	CALL ecriregs(84,zxtsol)
2715	CALL ecriregs(84,paprs(1,1))
2716	CALL ecriregs(84,topsw)
2717	CALL ecriregs(84,toplw)
2718	CALL ecriregs(84,solsw)
2719	CALL ecriregs(84,sollw)
2720	CALL ecriregs(84,rain_fall)
2721	CALL ecriregs(84,snow_fall)
2722	CALL ecriregs(84,evap)
2723	CALL ecriregs(84,sens)
2724	CALL ecriregs(84,bils)
2725	CALL ecriregs(84,pctsrf(1,is_sic))
2726	CALL ecriregs(84,zxfluxu(1,1))
2727	CALL ecriregs(84,zxfluxv(1,1))
2728	CALL ecriregs(84,ue)
2729	CALL ecriregs(84,ve)
2730	CALL ecriregs(84,uq)
2731	CALL ecriregs(84,vq)
2732	c
2733	CALL ecrirega(84,u_seri)
2734	CALL ecrirega(84,v_seri)
2735	CALL ecrirega(84,omega)
2736	CALL ecrirega(84,t_seri)
2737	CALL ecrirega(84,zphi)
2738	CALL ecrirega(84,q_seri)
2739	CALL ecrirega(84,cldfra)
2740	CALL ecrirega(84,cldliq)
2741	CALL ecrirega(84,pplay)
2742
2743
2744	cc CALL ecrirega(84,d_t_dyn)
2745	cc CALL ecrirega(84,d_q_dyn)
2746	cc CALL ecrirega(84,heat)
2747	cc CALL ecrirega(84,cool)
2748	cc CALL ecrirega(84,d_t_con)
2749	cc CALL ecrirega(84,d_q_con)
2750	cc CALL ecrirega(84,d_t_lsc)
2751	cc CALL ecrirega(84,d_q_lsc)
2752	ENDIF
2753	c
2754	c Convertir les incrementations en tendances
2755	c
2756	DO k = 1, klev
2757	DO i = 1, klon
2758	d_u(i,k) = ( u_seri(i,k) - u(i,k) ) / dtime
2759	d_v(i,k) = ( v_seri(i,k) - v(i,k) ) / dtime
2760	d_t(i,k) = ( t_seri(i,k)-t(i,k) ) / dtime
2761	d_qx(i,k,ivap) = ( q_seri(i,k) - qx(i,k,ivap) ) / dtime
2762	d_qx(i,k,iliq) = ( ql_seri(i,k) - qx(i,k,iliq) ) / dtime
2763	ENDDO
2764	ENDDO
2765	c
2766	IF (nqmax.GE.3) THEN
2767	DO iq = 3, nqmax
2768	DO k = 1, klev
2769	DO i = 1, klon
2770	d_qx(i,k,iq) = ( tr_seri(i,k,iq-2) - qx(i,k,iq) ) / dtime
2771	ENDDO
2772	ENDDO
2773	ENDDO
2774	ENDIF
2775	c
2776	c Sauvegarder les valeurs de t et q a la fin de la physique:
2777	c
2778	DO k = 1, klev
2779	DO i = 1, klon
2780	t_ancien(i,k) = t_seri(i,k)
2781	q_ancien(i,k) = q_seri(i,k)
2782	ENDDO
2783	ENDDO
2784	c
2785	c====================================================================
2786	c Si c'est la fin, il faut conserver l'etat de redemarrage
2787	c====================================================================
2788	c
2789	IF (lafin) THEN
2790	ccc IF (ok_oasis) CALL quitcpl
2791	CALL phyredem ("restartphy.nc",dtime,radpas,co2_ppm,solaire,
2792	. rlat, rlon, pctsrf, ftsol, ftsoil, deltat, fqsol, fsnow,
2793	. falbe, fevap, rain_fall, snow_fall,
2794	. solsw, sollw,
2795	. radsol,rugmer,agesno,
2796	. zmea,zstd,zsig,zgam,zthe,zpic,zval,rugoro,
2797	. t_ancien, q_ancien)
2798	ENDIF
2799
2800	RETURN
2801	END
2802	FUNCTION qcheck(klon,klev,paprs,q,ql,aire)
2803	IMPLICIT none
2804	c
2805	c Calculer et imprimer l'eau totale. A utiliser pour verifier
2806	c la conservation de l'eau
2807	c
2808	#include "YOMCST.h"
2809	INTEGER klon,klev
2810	REAL paprs(klon,klev+1), q(klon,klev), ql(klon,klev)
2811	REAL aire(klon)
2812	REAL qtotal, zx, qcheck
2813	INTEGER i, k
2814	c
2815	zx = 0.0
2816	DO i = 1, klon
2817	zx = zx + aire(i)
2818	ENDDO
2819	qtotal = 0.0
2820	DO k = 1, klev
2821	DO i = 1, klon
2822	qtotal = qtotal + (q(i,k)+ql(i,k)) * aire(i)
2823	. *(paprs(i,k)-paprs(i,k+1))/RG
2824	ENDDO
2825	ENDDO
2826	c
2827	qcheck = qtotal/zx
2828	c
2829	RETURN
2830	END
2831	SUBROUTINE gr_fi_ecrit(nfield,nlon,iim,jjmp1,fi,ecrit)
2832	IMPLICIT none
2833	c
2834	c Tranformer une variable de la grille physique a
2835	c la grille d'ecriture
2836	c
2837	INTEGER nfield,nlon,iim,jjmp1, jjm
2838	REAL fi(nlon,nfield), ecrit(iim*jjmp1,nfield)
2839	c
2840	INTEGER i, j, n, ig
2841	c
2842	jjm = jjmp1 - 1
2843	DO n = 1, nfield
2844	DO i=1,iim
2845	ecrit(i,n) = fi(1,n)
2846	ecrit(i+jjm*iim,n) = fi(nlon,n)
2847	ENDDO
2848	DO ig = 1, nlon - 2
2849	ecrit(iim+ig,n) = fi(1+ig,n)
2850	ENDDO
2851	ENDDO
2852	RETURN
2853	END
2854

Note: See TracBrowser for help on using the repository browser.

Download in other formats:

Original Format