Context Navigation

physiq.F @ 364

Last change on this file since 364 was 364, checked in by lmdzadmin, 22 years ago
Differentes modifs d'ajustement et de reglages du calendrier LF
Property svn:eol-style set to `native` Property svn:executable set to ``* Property svn:keywords set to `Author Date Id Revision`
File size: 120.2 KB

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

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

Download in other formats:

Original Format