Context Navigation

physiq.F @ 340

Last change on this file since 340 was 340, checked in by lmdzadmin, 22 years ago
Coordonnees rectilineaires dans ioipsl LF
Property svn:eol-style set to `native` Property svn:executable set to ``* Property svn:keywords set to `Author Date Id Revision`
File size: 119.4 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	INTEGER idayvrai
363	SAVE idayvrai
364	c
365	INTEGER lmt_pas
366	SAVE lmt_pas ! frequence de mise a jour
367	REAL pctsrf(klon,nbsrf)
368	SAVE pctsrf ! sous-fraction du sol
369	REAL albsol(klon)
370	SAVE albsol ! albedo du sol total
371	REAL albsollw(klon)
372	SAVE albsollw ! albedo du sol total
373	REAL albsol1(klon)
374	SAVE albsol1 ! albedo du sol total
375	REAL albsollw1(klon)
376	SAVE albsollw1 ! albedo du sol total
377
378	REAL wo(klon,klev)
379	SAVE wo ! ozone
380	c======================================================================
381	c
382	c Declaration des procedures appelees
383	c
384	EXTERNAL angle ! calculer angle zenithal du soleil
385	EXTERNAL alboc ! calculer l'albedo sur ocean
386	EXTERNAL albsno ! calculer albedo sur neige
387	EXTERNAL ajsec ! ajustement sec
388	EXTERNAL clmain ! couche limite
389	EXTERNAL condsurf ! lire les conditions aux limites
390	EXTERNAL conlmd ! convection (schema LMD)
391	cKE43
392	EXTERNAL conema ! convect4.3
393	EXTERNAL fisrtilp ! schema de condensation a grande echelle (pluie)
394	cAA
395	EXTERNAL fisrtilp_tr ! schema de condensation a grande echelle (pluie)
396	c ! stockage des coefficients necessaires au
397	c ! lessivage OFF-LINE et ON-LINE
398	cAA
399	EXTERNAL hgardfou ! verifier les temperatures
400	EXTERNAL nuage ! calculer les proprietes radiatives
401	EXTERNAL o3cm ! initialiser l'ozone
402	EXTERNAL orbite ! calculer l'orbite terrestre
403	EXTERNAL ozonecm ! prescrire l'ozone
404	EXTERNAL phyetat0 ! lire l'etat initial de la physique
405	EXTERNAL phyredem ! ecrire l'etat de redemarrage de la physique
406	EXTERNAL radlwsw ! rayonnements solaire et infrarouge
407	EXTERNAL suphec ! initialiser certaines constantes
408	EXTERNAL transp ! transport total de l'eau et de l'energie
409	EXTERNAL ecribina ! ecrire le fichier binaire global
410	EXTERNAL ecribins ! ecrire le fichier binaire global
411	EXTERNAL ecrirega ! ecrire le fichier binaire regional
412	EXTERNAL ecriregs ! ecrire le fichier binaire regional
413	c
414	c Variables locales
415	c
416	REAL dialiq(klon,klev) ! eau liquide nuageuse
417	REAL diafra(klon,klev) ! fraction nuageuse
418	REAL cldliq(klon,klev) ! eau liquide nuageuse
419	REAL cldfra(klon,klev) ! fraction nuageuse
420	REAL cldtau(klon,klev) ! epaisseur optique
421	REAL cldemi(klon,klev) ! emissivite infrarouge
422	c
423	C§§§ PB
424	REAL fluxq(klon,klev, nbsrf) ! flux turbulent d'humidite
425	REAL fluxt(klon,klev, nbsrf) ! flux turbulent de chaleur
426	REAL fluxu(klon,klev, nbsrf) ! flux turbulent de vitesse u
427	REAL fluxv(klon,klev, nbsrf) ! flux turbulent de vitesse v
428	c
429	REAL zxfluxt(klon, klev)
430	REAL zxfluxq(klon, klev)
431	REAL zxfluxu(klon, klev)
432	REAL zxfluxv(klon, klev)
433	C§§§
434	REAL heat(klon,klev) ! chauffage solaire
435	REAL heat0(klon,klev) ! chauffage solaire ciel clair
436	REAL cool(klon,klev) ! refroidissement infrarouge
437	REAL cool0(klon,klev) ! refroidissement infrarouge ciel clair
438	REAL topsw(klon), toplw(klon), solsw(klon), sollw(klon)
439	real sollwdown(klon) ! downward LW flux at surface
440	REAL topsw0(klon), toplw0(klon), solsw0(klon), sollw0(klon)
441	REAL albpla(klon)
442	c Le rayonnement n'est pas calcule tous les pas, il faut donc
443	c sauvegarder les sorties du rayonnement
444	SAVE heat,cool,albpla,topsw,toplw,solsw,sollw,sollwdown
445	SAVE topsw0,toplw0,solsw0,sollw0, heat0, cool0
446	INTEGER itaprad
447	SAVE itaprad
448	c
449	REAL conv_q(klon,klev) ! convergence de l'humidite (kg/kg/s)
450	REAL conv_t(klon,klev) ! convergence de la temperature(K/s)
451	c
452	REAL cldl(klon),cldm(klon),cldh(klon) !nuages bas, moyen et haut
453	REAL cldt(klon),cldq(klon) !nuage total, eau liquide integree
454	c
455	REAL zxtsol(klon), zxqsol(klon), zxsnow(klon)
456	c
457	REAL dist, rmu0(klon), fract(klon)
458	REAL zdtime, zlongi
459	c
460	CHARACTER*2 str2
461	CHARACTER*2 iqn
462	c
463	REAL qcheck
464	REAL z_avant(klon), z_apres(klon), z_factor(klon)
465	LOGICAL zx_ajustq
466	c
467	REAL za, zb
468	REAL zx_t, zx_qs, zdelta, zcor, zlvdcp, zlsdcp
469	INTEGER i, k, iq, nsrf, ll
470	REAL t_coup
471	PARAMETER (t_coup=234.0)
472	c
473	REAL zphi(klon,klev)
474	REAL zx_tmp_x(iim), zx_tmp_yjjmp1
475	REAL zx_relief(iim,jjmp1)
476	REAL zx_aire(iim,jjmp1)
477	cKE43
478	c Variables locales pour la convection de K. Emanuel (sb):
479	c
480	REAL upwd(klon,klev) ! saturated updraft mass flux
481	REAL dnwd(klon,klev) ! saturated downdraft mass flux
482	REAL dnwd0(klon,klev) ! unsaturated downdraft mass flux
483	REAL tvp(klon,klev) ! virtual temp of lifted parcel
484	REAL cape(klon) ! CAPE
485	SAVE cape
486	REAL pbase(klon) ! cloud base pressure
487	SAVE pbase
488	REAL bbase(klon) ! cloud base buoyancy
489	SAVE bbase
490	REAL rflag(klon) ! flag fonctionnement de convect
491	INTEGER iflagctrl(klon) ! flag fonctionnement de convect
492	c -- convect43:
493	INTEGER ntra ! nb traceurs pour convect4.3
494	REAL pori_con(klon) ! pressure at the origin level of lifted parcel
495	REAL plcl_con(klon),dtma_con(klon),dtlcl_con(klon)
496	REAL dtvpdt1(klon,klev), dtvpdq1(klon,klev)
497	REAL dplcldt(klon), dplcldr(klon)
498	c? . condm_con(klon,klev),conda_con(klon,klev),
499	c? . mr_con(klon,klev),ep_con(klon,klev)
500	c? . ,sadiab(klon,klev),wadiab(klon,klev)
501	c --
502	c34EK
503	c
504	c Variables du changement
505	c
506	c con: convection
507	c lsc: condensation a grande echelle (Large-Scale-Condensation)
508	c ajs: ajustement sec
509	c eva: evaporation de l'eau liquide nuageuse
510	c vdf: couche limite (Vertical DiFfusion)
511	REAL d_t_con(klon,klev),d_q_con(klon,klev)
512	REAL d_u_con(klon,klev),d_v_con(klon,klev)
513	REAL d_t_lsc(klon,klev),d_q_lsc(klon,klev),d_ql_lsc(klon,klev)
514	REAL d_t_ajs(klon,klev), d_q_ajs(klon,klev)
515	REAL d_t_eva(klon,klev),d_q_eva(klon,klev)
516	REAL rneb(klon,klev)
517	c
518	REAL pmfu(klon,klev), pmfd(klon,klev)
519	REAL pen_u(klon,klev), pen_d(klon,klev)
520	REAL pde_u(klon,klev), pde_d(klon,klev)
521	INTEGER kcbot(klon), kctop(klon), kdtop(klon)
522	REAL pmflxr(klon,klev+1), pmflxs(klon,klev+1)
523	REAL prfl(klon,klev+1), psfl(klon,klev+1)
524	c
525	INTEGER ibas_con(klon), itop_con(klon)
526	REAL rain_con(klon), rain_lsc(klon)
527	REAL snow_con(klon), snow_lsc(klon)
528	REAL d_ts(klon,nbsrf)
529	c
530	REAL d_u_vdf(klon,klev), d_v_vdf(klon,klev)
531	REAL d_t_vdf(klon,klev), d_q_vdf(klon,klev)
532	c
533	REAL d_u_oro(klon,klev), d_v_oro(klon,klev)
534	REAL d_t_oro(klon,klev)
535	REAL d_u_lif(klon,klev), d_v_lif(klon,klev)
536	REAL d_t_lif(klon,klev)
537
538	REAL ratqs(klon,klev)
539	integer flag_ratqs
540	real zpt_conv(klon,klev)
541
542	c
543	c Variables liees a l'ecriture de la bande histoire physique
544	c
545	INTEGER ecrit_mth
546	SAVE ecrit_mth ! frequence d'ecriture (fichier mensuel)
547	c
548	INTEGER ecrit_day
549	SAVE ecrit_day ! frequence d'ecriture (fichier journalier)
550	c
551	INTEGER ecrit_ins
552	SAVE ecrit_ins ! frequence d'ecriture (fichier instantane)
553	c
554	INTEGER ecrit_reg
555	SAVE ecrit_reg ! frequence d'ecriture
556	c
557	c
558	c
559	c Variables locales pour effectuer les appels en serie
560	c
561	REAL t_seri(klon,klev), q_seri(klon,klev)
562	REAL ql_seri(klon,klev)
563	REAL u_seri(klon,klev), v_seri(klon,klev)
564	c
565	REAL tr_seri(klon,klev,nbtr)
566	REAL d_tr(klon,klev,nbtr)
567
568	REAL zx_rh(klon,klev)
569
570	INTEGER length
571	PARAMETER ( length = 100 )
572	REAL tabcntr0( length )
573	c
574	INTEGER ndex2d(iimjjmp1),ndex3d(iimjjmp1*klev)
575	REAL zx_tmp_fi2d(klon)
576	REAL zx_tmp_2d(iim,jjmp1), zx_tmp_3d(iim,jjmp1,klev)
577	REAL zx_lon(iim,jjmp1), zx_lat(iim,jjmp1)
578	c
579	INTEGER nid_day, nid_mth, nid_ins
580	SAVE nid_day, nid_mth, nid_ins
581	c
582	INTEGER nhori, nvert
583	REAL zsto, zout
584	real zjulian
585	save zjulian
586
587	character*20 modname
588	character*80 abort_message
589	logical ok_sync
590	real date0
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/48.) ! a chaque pas de temps
737	ecrit_ins = NINT(86400./dtime/12.) ! toutes les deux heures
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	CALL ymds2ju(anne_ini, 1, 1, 0.0, zjulian)
764	zjulian = zjulian + day_ini
765
766	c
767	IF (ok_journe) THEN
768	c
769	CALL ymds2ju(anne_ini, 1, 1, 0.0, zjulian)
770	zjulian = zjulian + day_ini
771	c
772	CALL gr_fi_ecrit(1,klon,iim,jjmp1,rlon,zx_lon)
773	DO i = 1, iim
774	zx_lon(i,1) = rlon(i+1)
775	zx_lon(i,jjmp1) = rlon(i+1)
776	ENDDO
777	DO ll=1,klev
778	znivsig(ll)=float(ll)
779	ENDDO
780	CALL gr_fi_ecrit(1,klon,iim,jjmp1,rlat,zx_lat)
781	CALL histbeg("histday", iim,zx_lon(:,1), jjmp1,zx_lat(1,:),
782	. 1,iim,1,jjmp1, 0, zjulian, dtime,
783	. nhori, nid_day)
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	CALL ymds2ju(anne_ini, 1, 1, 0.0, zjulian)
1005	zjulian = zjulian + day_ini
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, 0, zjulian, dtime,
1018	. nhori, nid_mth)
1019	CALL histvert(nid_mth, "presnivs", "Vertical levels", "mb",
1020	. klev, presnivs, nvert)
1021	c call histvert(nid_mth, 'sig_s', 'Niveaux sigma','-',
1022	c . klev, znivsig, nvert)
1023	c
1024	zsto = dtime
1025	zout = dtime * ecrit_mth
1026	c
1027	CALL histdef(nid_mth, "phis", "Surface geop. height", "-",
1028	. iim,jjmp1,nhori, 1,1,1, -99, 32,
1029	. "once", zsto,zout)
1030	c
1031	CALL histdef(nid_mth, "aire", "Grid area", "-",
1032	. iim,jjmp1,nhori, 1,1,1, -99, 32,
1033	. "once", zsto,zout)
1034	c
1035	c Champs 2D:
1036	c
1037	CALL histdef(nid_mth, "tsol", "Surface Temperature", "K",
1038	. iim,jjmp1,nhori, 1,1,1, -99, 32,
1039	. "ave(X)", zsto,zout)
1040	c
1041	CALL histdef(nid_mth, "psol", "Surface Pressure", "Pa",
1042	. iim,jjmp1,nhori, 1,1,1, -99, 32,
1043	. "ave(X)", zsto,zout)
1044	c
1045	CALL histdef(nid_mth, "qsol", "Surface humidity", "mm",
1046	. iim,jjmp1,nhori, 1,1,1, -99, 32,
1047	. "ave(X)", zsto,zout)
1048	c
1049	CALL histdef(nid_mth, "rain", "Precipitation", "mm/day",
1050	. iim,jjmp1,nhori, 1,1,1, -99, 32,
1051	. "ave(X)", zsto,zout)
1052	c
1053	CALL histdef(nid_mth, "plul", "Large-scale Precip.", "mm/day",
1054	. iim,jjmp1,nhori, 1,1,1, -99, 32,
1055	. "ave(X)", zsto,zout)
1056	c
1057	CALL histdef(nid_mth, "pluc", "Convective Precip.", "mm/day",
1058	. iim,jjmp1,nhori, 1,1,1, -99, 32,
1059	. "ave(X)", zsto,zout)
1060	c
1061	CALL histdef(nid_mth, "snow", "Snow fall", "mm/day",
1062	. iim,jjmp1,nhori, 1,1,1, -99, 32,
1063	. "ave(X)", zsto,zout)
1064	c
1065	CALL histdef(nid_mth, "snow_cov", "Snow cover", "mm",
1066	. iim,jjmp1,nhori, 1,1,1, -99, 32,
1067	. "ave(X)", zsto,zout)
1068	c
1069	CALL histdef(nid_mth, "evap", "Evaporation", "mm/day",
1070	. iim,jjmp1,nhori, 1,1,1, -99, 32,
1071	. "ave(X)", zsto,zout)
1072	c
1073	CALL histdef(nid_mth, "tops", "Solar rad. at TOA", "W/m2",
1074	. iim,jjmp1,nhori, 1,1,1, -99, 32,
1075	. "ave(X)", zsto,zout)
1076	c
1077	CALL histdef(nid_mth, "topl", "IR rad. at TOA", "W/m2",
1078	. iim,jjmp1,nhori, 1,1,1, -99, 32,
1079	. "ave(X)", zsto,zout)
1080	c
1081	CALL histdef(nid_mth, "sols", "Solar rad. at surf.", "W/m2",
1082	. iim,jjmp1,nhori, 1,1,1, -99, 32,
1083	. "ave(X)", zsto,zout)
1084	c
1085	CALL histdef(nid_mth, "soll", "IR rad. at surface", "W/m2",
1086	. iim,jjmp1,nhori, 1,1,1, -99, 32,
1087	. "ave(X)", zsto,zout)
1088	c
1089	CALL histdef(nid_mth, "solldown", "Down. IR rad. at surface",
1090	. "W/m2", iim,jjmp1,nhori, 1,1,1, -99, 32,
1091	. "ave(X)", zsto,zout)
1092	c
1093	CALL histdef(nid_mth, "tops0", "Solar rad. at TOA", "W/m2",
1094	. iim,jjmp1,nhori, 1,1,1, -99, 32,
1095	. "ave(X)", zsto,zout)
1096	c
1097	CALL histdef(nid_mth, "topl0", "IR rad. at TOA", "W/m2",
1098	. iim,jjmp1,nhori, 1,1,1, -99, 32,
1099	. "ave(X)", zsto,zout)
1100	c
1101	CALL histdef(nid_mth, "sols0", "Solar rad. at surf.", "W/m2",
1102	. iim,jjmp1,nhori, 1,1,1, -99, 32,
1103	. "ave(X)", zsto,zout)
1104	c
1105	CALL histdef(nid_mth, "soll0", "IR rad. at surface", "W/m2",
1106	. iim,jjmp1,nhori, 1,1,1, -99, 32,
1107	. "ave(X)", zsto,zout)
1108	c
1109	CALL histdef(nid_mth, "bils", "Surf. total heat flux", "W/m2",
1110	. iim,jjmp1,nhori, 1,1,1, -99, 32,
1111	. "ave(X)", zsto,zout)
1112	c
1113	CALL histdef(nid_mth, "sens", "Sensible heat flux", "W/m2",
1114	. iim,jjmp1,nhori, 1,1,1, -99, 32,
1115	. "ave(X)", zsto,zout)
1116	c
1117	CALL histdef(nid_mth, "fder", "Heat flux derivation", "W/m2",
1118	. iim,jjmp1,nhori, 1,1,1, -99, 32,
1119	. "ave(X)", zsto,zout)
1120	c
1121	CALL histdef(nid_mth, "frtu", "Zonal wind stress", "Pa",
1122	. iim,jjmp1,nhori, 1,1,1, -99, 32,
1123	. "ave(X)", zsto,zout)
1124	c
1125	CALL histdef(nid_mth, "frtv", "Meridional wind stress", "Pa",
1126	. iim,jjmp1,nhori, 1,1,1, -99, 32,
1127	. "ave(X)", zsto,zout)
1128	c
1129	DO nsrf = 1, nbsrf
1130	C
1131	call histdef(nid_mth, "pourc_"//clnsurf(nsrf),
1132	$ "Fraction "//clnsurf(nsrf), "W/m2",
1133	$ iim,jjmp1,nhori, 1,1,1, -99, 32,
1134	$ "ave(X)", zsto,zout)
1135	C
1136	call histdef(nid_mth, "tsol_"//clnsurf(nsrf),
1137	$ "Fraction "//clnsurf(nsrf), "W/m2",
1138	$ iim,jjmp1,nhori, 1,1,1, -99, 32,
1139	$ "ave(X)", zsto,zout)
1140	C
1141	call histdef(nid_mth, "sens_"//clnsurf(nsrf),
1142	$ "Sensible heat flux "//clnsurf(nsrf), "W/m2",
1143	$ iim,jjmp1,nhori, 1,1,1, -99, 32,
1144	$ "ave(X)", zsto,zout)
1145	c
1146	call histdef(nid_mth, "lat_"//clnsurf(nsrf),
1147	$ "Latent heat flux "//clnsurf(nsrf), "W/m2",
1148	$ iim,jjmp1,nhori, 1,1,1, -99, 32,
1149	$ "ave(X)", zsto,zout)
1150	C
1151	call histdef(nid_mth, "taux_"//clnsurf(nsrf),
1152	$ "Zonal wind stress"//clnsurf(nsrf), "Pa",
1153	$ iim,jjmp1,nhori, 1,1,1, -99, 32,
1154	$ "ave(X)", zsto,zout)
1155
1156	call histdef(nid_mth, "tauy_"//clnsurf(nsrf),
1157	$ "Meridional xind stress "//clnsurf(nsrf), "Pa",
1158	$ iim,jjmp1,nhori, 1,1,1, -99, 32,
1159	$ "ave(X)", zsto,zout)
1160	c
1161	call histdef(nid_mth, "albe_"//clnsurf(nsrf),
1162	$ "Albedo surf. "//clnsurf(nsrf), "W/m2",
1163	$ iim,jjmp1,nhori, 1,1,1, -99, 32,
1164	$ "ave(X)", zsto,zout)
1165	c
1166	call histdef(nid_mth, "rugs_"//clnsurf(nsrf),
1167	$ "Latent heat flux "//clnsurf(nsrf), "W/m2",
1168	$ iim,jjmp1,nhori, 1,1,1, -99, 32,
1169	$ "ave(X)", zsto,zout)
1170	c
1171	CALL histdef(nid_mth, "ages_"//clnsurf(nsrf), "Snow age","day",
1172	. iim,jjmp1,nhori, 1,1,1, -99, 32,
1173	. "ave(X)", zsto,zout)
1174
1175	END DO
1176	C
1177	CALL histdef(nid_mth, "sicf", "Sea-ice fraction", "-",
1178	. iim,jjmp1,nhori, 1,1,1, -99, 32,
1179	. "ave(X)", zsto,zout)
1180	c
1181	CALL histdef(nid_mth, "albs", "Surface albedo", "-",
1182	. iim,jjmp1,nhori, 1,1,1, -99, 32,
1183	. "ave(X)", zsto,zout)
1184	CALL histdef(nid_mth, "albslw", "Surface albedo LW", "-",
1185	. iim,jjmp1,nhori, 1,1,1, -99, 32,
1186	. "ave(X)", zsto,zout)
1187	c
1188	CALL histdef(nid_mth, "cdrm", "Momentum drag coef.", "-",
1189	. iim,jjmp1,nhori, 1,1,1, -99, 32,
1190	. "ave(X)", zsto,zout)
1191	c
1192	CALL histdef(nid_mth, "cdrh", "Heat drag coef.", "-",
1193	. iim,jjmp1,nhori, 1,1,1, -99, 32,
1194	. "ave(X)", zsto,zout)
1195	c
1196	CALL histdef(nid_mth, "cldl", "Low-level cloudiness", "-",
1197	. iim,jjmp1,nhori, 1,1,1, -99, 32,
1198	. "ave(X)", zsto,zout)
1199	c
1200	CALL histdef(nid_mth, "cldm", "Mid-level cloudiness", "-",
1201	. iim,jjmp1,nhori, 1,1,1, -99, 32,
1202	. "ave(X)", zsto,zout)
1203	c
1204	CALL histdef(nid_mth, "cldh", "High-level cloudiness", "-",
1205	. iim,jjmp1,nhori, 1,1,1, -99, 32,
1206	. "ave(X)", zsto,zout)
1207	c
1208	CALL histdef(nid_mth, "cldt", "Total cloudiness", "-",
1209	. iim,jjmp1,nhori, 1,1,1, -99, 32,
1210	. "ave(X)", zsto,zout)
1211	c
1212	CALL histdef(nid_mth, "cldq", "Cloud liquid water path", "-",
1213	. iim,jjmp1,nhori, 1,1,1, -99, 32,
1214	. "ave(X)", zsto,zout)
1215	c
1216	CALL histdef(nid_mth, "ue", "Zonal energy transport", "-",
1217	. iim,jjmp1,nhori, 1,1,1, -99, 32,
1218	. "ave(X)", zsto,zout)
1219	c
1220	CALL histdef(nid_mth, "ve", "Merid energy transport", "-",
1221	. iim,jjmp1,nhori, 1,1,1, -99, 32,
1222	. "ave(X)", zsto,zout)
1223	c
1224	CALL histdef(nid_mth, "uq", "Zonal humidity transport", "-",
1225	. iim,jjmp1,nhori, 1,1,1, -99, 32,
1226	. "ave(X)", zsto,zout)
1227	c
1228	CALL histdef(nid_mth, "vq", "Merid humidity transport", "-",
1229	. iim,jjmp1,nhori, 1,1,1, -99, 32,
1230	. "ave(X)", zsto,zout)
1231	cKE43
1232	IF (iflag_con .GE. 3) THEN ! sb
1233	c
1234	CALL histdef(nid_mth, "cape", "Conv avlbl pot ener", "J/Kg",
1235	. iim,jjmp1,nhori, 1,1,1, -99, 32,
1236	. "ave(X)", zsto,zout)
1237	c
1238	CALL histdef(nid_mth, "pbase", "Cld base pressure", "hPa",
1239	. iim,jjmp1,nhori, 1,1,1, -99, 32,
1240	. "ave(X)", zsto,zout)
1241	c
1242	CALL histdef(nid_mth, "ptop", "Cld top pressure", "hPa",
1243	. iim,jjmp1,nhori, 1,1,1, -99, 32,
1244	. "ave(X)", zsto,zout)
1245	c
1246	CALL histdef(nid_mth, "fbase", "Cld base mass flux", "Kg/m2/s",
1247	. iim,jjmp1,nhori, 1,1,1, -99, 32,
1248	. "ave(X)", zsto,zout)
1249	c
1250	c
1251	ENDIF
1252	c34EK
1253	c
1254	c Champs 3D:
1255	c
1256	CALL histdef(nid_mth, "temp", "Air temperature", "K",
1257	. iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1258	. "ave(X)", zsto,zout)
1259	c
1260	CALL histdef(nid_mth, "ovap", "Specific humidity", "Kg/Kg",
1261	. iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1262	. "ave(X)", zsto,zout)
1263	c
1264	CALL histdef(nid_mth, "geop", "Geopotential height", "m",
1265	. iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1266	. "ave(X)", zsto,zout)
1267	c
1268	CALL histdef(nid_mth, "vitu", "Zonal wind", "m/s",
1269	. iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1270	. "ave(X)", zsto,zout)
1271	c
1272	CALL histdef(nid_mth, "vitv", "Meridional wind", "m/s",
1273	. iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1274	. "ave(X)", zsto,zout)
1275	c
1276	CALL histdef(nid_mth, "vitw", "Vertical wind", "m/s",
1277	. iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1278	. "ave(X)", zsto,zout)
1279	c
1280	CALL histdef(nid_mth, "pres", "Air pressure", "Pa",
1281	. iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1282	. "ave(X)", zsto,zout)
1283	c
1284	CALL histdef(nid_mth, "rneb", "Cloud fraction", "-",
1285	. iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1286	. "ave(X)", zsto,zout)
1287	c
1288	CALL histdef(nid_mth, "rhum", "Relative humidity", "-",
1289	. iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1290	. "ave(X)", zsto,zout)
1291	c
1292	CALL histdef(nid_mth, "oliq", "Liquid water content", "kg/kg",
1293	. iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1294	. "ave(X)", zsto,zout)
1295	c
1296	CALL histdef(nid_mth, "dtdyn", "Dynamics dT", "K/s",
1297	. iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1298	. "ave(X)", zsto,zout)
1299	c
1300	CALL histdef(nid_mth, "dqdyn", "Dynamics dQ", "Kg/Kg/s",
1301	. iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1302	. "ave(X)", zsto,zout)
1303	c
1304	CALL histdef(nid_mth, "dtcon", "Convection dT", "K/s",
1305	. iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1306	. "ave(X)", zsto,zout)
1307	c
1308	CALL histdef(nid_mth, "dqcon", "Convection dQ", "Kg/Kg/s",
1309	. iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1310	. "ave(X)", zsto,zout)
1311	c
1312	CALL histdef(nid_mth, "dtlsc", "Condensation dT", "K/s",
1313	. iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1314	. "ave(X)", zsto,zout)
1315	c
1316	CALL histdef(nid_mth, "dqlsc", "Condensation dQ", "Kg/Kg/s",
1317	. iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1318	. "ave(X)", zsto,zout)
1319	c
1320	CALL histdef(nid_mth, "dtvdf", "Boundary-layer dT", "K/s",
1321	. iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1322	. "ave(X)", zsto,zout)
1323	c
1324	CALL histdef(nid_mth, "dqvdf", "Boundary-layer dQ", "Kg/Kg/s",
1325	. iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1326	. "ave(X)", zsto,zout)
1327	c
1328	CALL histdef(nid_mth, "dteva", "Reevaporation dT", "K/s",
1329	. iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1330	. "ave(X)", zsto,zout)
1331	c
1332	CALL histdef(nid_mth, "dqeva", "Reevaporation dQ", "Kg/Kg/s",
1333	. iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1334	. "ave(X)", zsto,zout)
1335
1336	CALL histdef(nid_mth, "ptconv", "POINTS CONVECTIFS"," ",
1337	. iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1338	. "ave(X)", zsto,zout)
1339
1340	CALL histdef(nid_mth, "ratqs", "RATQS"," ",
1341	. iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1342	. "ave(X)", zsto,zout)
1343
1344	c
1345	CALL histdef(nid_mth, "dtajs", "Dry adjust. dT", "K/s",
1346	. iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1347	. "ave(X)", zsto,zout)
1348
1349	CALL histdef(nid_mth, "dqajs", "Dry adjust. dQ", "Kg/Kg/s",
1350	. iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1351	. "ave(X)", zsto,zout)
1352	c
1353	CALL histdef(nid_mth, "dtswr", "SW radiation dT", "K/s",
1354	. iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1355	. "ave(X)", zsto,zout)
1356	c
1357	CALL histdef(nid_mth, "dtsw0", "SW radiation dT", "K/s",
1358	. iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1359	. "ave(X)", zsto,zout)
1360	c
1361	CALL histdef(nid_mth, "dtlwr", "LW radiation dT", "K/s",
1362	. iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1363	. "ave(X)", zsto,zout)
1364	c
1365	CALL histdef(nid_mth, "dtlw0", "LW radiation dT", "K/s",
1366	. iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1367	. "ave(X)", zsto,zout)
1368	c
1369	CALL histdef(nid_mth, "duvdf", "Boundary-layer dU", "m/s2",
1370	. iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1371	. "ave(X)", zsto,zout)
1372	c
1373	CALL histdef(nid_mth, "dvvdf", "Boundary-layer dV", "m/s2",
1374	. iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1375	. "ave(X)", zsto,zout)
1376	c
1377	IF (ok_orodr) THEN
1378	CALL histdef(nid_mth, "duoro", "Orography dU", "m/s2",
1379	. iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1380	. "ave(X)", zsto,zout)
1381	c
1382	CALL histdef(nid_mth, "dvoro", "Orography dV", "m/s2",
1383	. iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1384	. "ave(X)", zsto,zout)
1385	c
1386	ENDIF
1387	C
1388	IF (ok_orolf) THEN
1389	CALL histdef(nid_mth, "dulif", "Orography dU", "m/s2",
1390	. iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1391	. "ave(X)", zsto,zout)
1392	c
1393	CALL histdef(nid_mth, "dvlif", "Orography dV", "m/s2",
1394	. iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1395	. "ave(X)", zsto,zout)
1396	ENDIF
1397	C
1398	CALL histdef(nid_mth, "ozone", "Ozone concentration", "-",
1399	. iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1400	. "ave(X)", zsto,zout)
1401	c
1402	if (nqmax.GE.3) THEN
1403	DO iq=1,nqmax-2
1404	IF (iq.LE.99) THEN
1405	WRITE(str2,'(i2.2)') iq
1406	CALL histdef(nid_mth, "trac"//str2, "Tracer No."//str2, "-",
1407	. iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1408	. "ave(X)", zsto,zout)
1409	ELSE
1410	PRINT*, "Trop de traceurs"
1411	CALL abort
1412	ENDIF
1413	ENDDO
1414	ENDIF
1415	c
1416	cKE43
1417	IF (iflag_con.GE.3) THEN ! (sb)
1418	c
1419	CALL histdef(nid_mth, "upwd", "saturated updraft", "Kg/m2/s",
1420	. iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1421	. "ave(X)", zsto,zout)
1422	c
1423	CALL histdef(nid_mth, "dnwd", "saturated downdraft","Kg/m2/s",
1424	. iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1425	. "ave(X)", zsto,zout)
1426	c
1427	CALL histdef(nid_mth, "dnwd0", "unsat. downdraft", "Kg/m2/s",
1428	. iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1429	. "ave(X)", zsto,zout)
1430	c
1431	CALL histdef(nid_mth,"Ma","undilute adiab updraft","Kg/m2/s",
1432	. iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1433	. "ave(X)", zsto,zout)
1434	c
1435	c
1436	ENDIF
1437	c34EK
1438	CALL histend(nid_mth)
1439	c
1440	ndex2d = 0
1441	ndex3d = 0
1442	c
1443	ENDIF ! fin de test sur ok_mensuel
1444	c
1445	c
1446	IF (ok_instan) THEN
1447	c
1448	CALL ymds2ju(anne_ini, 1, 1, 0.0, zjulian)
1449	zjulian = zjulian + day_ini
1450	c
1451	CALL gr_fi_ecrit(1,klon,iim,jjmp1,rlon,zx_lon)
1452	DO i = 1, iim
1453	zx_lon(i,1) = rlon(i+1)
1454	zx_lon(i,jjmp1) = rlon(i+1)
1455	ENDDO
1456	DO ll=1,klev
1457	znivsig(ll)=float(ll)
1458	ENDDO
1459	CALL gr_fi_ecrit(1,klon,iim,jjmp1,rlat,zx_lat)
1460	CALL histbeg("histins", iim,zx_lon, jjmp1,zx_lat,
1461	. 1,iim,1,jjmp1, 0, zjulian, dtime,
1462	. nhori, nid_ins)
1463	CALL histvert(nid_ins, "presnivs", "Vertical levels", "mb",
1464	. klev, presnivs, nvert)
1465	c call histvert(nid_ins, 'sig_s', 'Niveaux sigma','-',
1466	c . klev, znivsig, nvert)
1467	c
1468	c
1469	zsto = dtime * ecrit_ins
1470	zout = dtime * ecrit_ins
1471	C
1472	CALL histdef(nid_ins, "phis", "Surface geop. height", "-",
1473	. iim,jjmp1,nhori, 1,1,1, -99, 32,
1474	. "once", zsto,zout)
1475	c
1476	CALL histdef(nid_ins, "aire", "Grid area", "-",
1477	. iim,jjmp1,nhori, 1,1,1, -99, 32,
1478	. "once", zsto,zout)
1479	c
1480	c Champs 2D:
1481	c
1482	CALL histdef(nid_ins, "tsol", "Surface Temperature", "K",
1483	. iim,jjmp1,nhori, 1,1,1, -99, 32,
1484	. "inst(X)", zsto,zout)
1485	c
1486	CALL histdef(nid_ins, "psol", "Surface Pressure", "Pa",
1487	. iim,jjmp1,nhori, 1,1,1, -99, 32,
1488	. "inst(X)", zsto,zout)
1489	c
1490	CALL histdef(nid_ins, "plul", "Large-scale Precip.", "mm/day",
1491	. iim,jjmp1,nhori, 1,1,1, -99, 32,
1492	. "inst(X)", zsto,zout)
1493	c
1494	CALL histdef(nid_ins, "pluc", "Convective Precip.", "mm/day",
1495	. iim,jjmp1,nhori, 1,1,1, -99, 32,
1496	. "inst(X)", zsto,zout)
1497
1498	CALL histdef(nid_ins, "qsol", "Surface humidity", "mm",
1499	. iim,jjmp1,nhori, 1,1,1, -99, 32,
1500	. "inst(X)", zsto,zout)
1501	c
1502	CALL histdef(nid_ins, "rain", "Precipitation", "mm/day",
1503	. iim,jjmp1,nhori, 1,1,1, -99, 32,
1504	. "inst(X)", zsto,zout)
1505	c
1506	CALL histdef(nid_ins, "snow", "Snow fall", "mm/day",
1507	. iim,jjmp1,nhori, 1,1,1, -99, 32,
1508	. "inst(X)", zsto,zout)
1509	c
1510	CALL histdef(nid_ins, "snow_cov", "Snow cover", "mm",
1511	. iim,jjmp1,nhori, 1,1,1, -99, 32,
1512	. "inst(X)", zsto,zout)
1513	c
1514	CALL histdef(nid_ins, "topl", "OLR", "W/m2",
1515	. iim,jjmp1,nhori, 1,1,1, -99, 32,
1516	. "inst(X)", zsto,zout)
1517	c
1518	CALL histdef(nid_ins, "evap", "Evaporation", "mm/day",
1519	. iim,jjmp1,nhori, 1,1,1, -99, 32,
1520	. "inst(X)", zsto,zout)
1521	c
1522	CALL histdef(nid_ins, "sols", "Solar rad. at surf.", "W/m2",
1523	. iim,jjmp1,nhori, 1,1,1, -99, 32,
1524	. "inst(X)", zsto,zout)
1525	c
1526	CALL histdef(nid_ins, "soll", "IR rad. at surface", "W/m2",
1527	. iim,jjmp1,nhori, 1,1,1, -99, 32,
1528	. "inst(X)", zsto,zout)
1529	c
1530	CALL histdef(nid_ins, "solldown", "Down. IR rad. at surface",
1531	. "W/m2", iim,jjmp1,nhori, 1,1,1, -99, 32,
1532	. "inst(X)", zsto,zout)
1533	c
1534	CALL histdef(nid_ins, "bils", "Surf. total heat flux", "W/m2",
1535	. iim,jjmp1,nhori, 1,1,1, -99, 32,
1536	. "inst(X)", zsto,zout)
1537	c
1538	CALL histdef(nid_ins, "sens", "Sensible heat flux", "W/m2",
1539	. iim,jjmp1,nhori, 1,1,1, -99, 32,
1540	. "inst(X)", zsto,zout)
1541	c
1542	CALL histdef(nid_ins, "fder", "Heat flux derivation", "W/m2",
1543	. iim,jjmp1,nhori, 1,1,1, -99, 32,
1544	. "inst(X)", zsto,zout)
1545	c
1546	CALL histdef(nid_ins, "dtsvdfo", "Boundary-layer dTs(o)", "K/s",
1547	. iim,jjmp1,nhori, 1,1,1, -99, 32,
1548	. "inst(X)", zsto,zout)
1549	c
1550	CALL histdef(nid_ins, "dtsvdft", "Boundary-layer dTs(t)", "K/s",
1551	. iim,jjmp1,nhori, 1,1,1, -99, 32,
1552	. "inst(X)", zsto,zout)
1553	c
1554	CALL histdef(nid_ins, "dtsvdfg", "Boundary-layer dTs(g)", "K/s",
1555	. iim,jjmp1,nhori, 1,1,1, -99, 32,
1556	. "inst(X)", zsto,zout)
1557	c
1558	CALL histdef(nid_ins, "dtsvdfi", "Boundary-layer dTs(g)", "K/s",
1559	. iim,jjmp1,nhori, 1,1,1, -99, 32,
1560	. "inst(X)", zsto,zout)
1561
1562	DO nsrf = 1, nbsrf
1563	C
1564	call histdef(nid_ins, "pourc_"//clnsurf(nsrf),
1565	$ "Fraction"//clnsurf(nsrf), "W/m2",
1566	$ iim,jjmp1,nhori, 1,1,1, -99, 32,
1567	$ "inst(X)", zsto,zout)
1568
1569	call histdef(nid_ins, "sens_"//clnsurf(nsrf),
1570	$ "Sensible heat flux "//clnsurf(nsrf), "W/m2",
1571	$ iim,jjmp1,nhori, 1,1,1, -99, 32,
1572	$ "inst(X)", zsto,zout)
1573	c
1574	call histdef(nid_ins, "tsol_"//clnsurf(nsrf),
1575	$ "Surface Temperature"//clnsurf(nsrf), "W/m2",
1576	$ iim,jjmp1,nhori, 1,1,1, -99, 32,
1577	$ "inst(X)", zsto,zout)
1578	c
1579	call histdef(nid_ins, "lat_"//clnsurf(nsrf),
1580	$ "Latent heat flux "//clnsurf(nsrf), "W/m2",
1581	$ iim,jjmp1,nhori, 1,1,1, -99, 32,
1582	$ "inst(X)", zsto,zout)
1583	C
1584	call histdef(nid_ins, "taux_"//clnsurf(nsrf),
1585	$ "Zonal wind stress"//clnsurf(nsrf),"Pa",
1586	$ iim,jjmp1,nhori, 1,1,1, -99, 32,
1587	$ "inst(X)", zsto,zout)
1588
1589	call histdef(nid_ins, "tauy_"//clnsurf(nsrf),
1590	$ "Meridional xind stress "//clnsurf(nsrf), "Pa",
1591	$ iim,jjmp1,nhori, 1,1,1, -99, 32,
1592	$ "inst(X)", zsto,zout)
1593	c
1594	call histdef(nid_ins, "albe_"//clnsurf(nsrf),
1595	$ "Albedo "//clnsurf(nsrf), "-",
1596	$ iim,jjmp1,nhori, 1,1,1, -99, 32,
1597	$ "inst(X)", zsto,zout)
1598	c
1599	call histdef(nid_ins, "rugs_"//clnsurf(nsrf),
1600	$ "rugosite "//clnsurf(nsrf), "-",
1601	$ iim,jjmp1,nhori, 1,1,1, -99, 32,
1602	$ "inst(X)", zsto,zout)
1603	C§§§
1604	END DO
1605	CALL histdef(nid_ins, "rugs", "rugosity", "-",
1606	. iim,jjmp1,nhori, 1,1,1, -99, 32,
1607	. "inst(X)", zsto,zout)
1608
1609	c
1610	CALL histdef(nid_ins, "albs", "Surface albedo", "-",
1611	. iim,jjmp1,nhori, 1,1,1, -99, 32,
1612	. "inst(X)", zsto,zout)
1613	CALL histdef(nid_ins, "albslw", "Surface albedo LW", "-",
1614	. iim,jjmp1,nhori, 1,1,1, -99, 32,
1615	. "inst(X)", zsto,zout)
1616	c
1617	c
1618	c Champs 3D:
1619	c
1620	CALL histdef(nid_ins, "temp", "Temperature", "K",
1621	. iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1622	. "inst(X)", zsto,zout)
1623	c
1624	CALL histdef(nid_ins, "vitu", "Zonal wind", "m/s",
1625	. iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1626	. "inst(X)", zsto,zout)
1627	c
1628	CALL histdef(nid_ins, "vitv", "Merid wind", "m/s",
1629	. iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1630	. "inst(X)", zsto,zout)
1631	c
1632	CALL histdef(nid_ins, "geop", "Geopotential height", "m",
1633	. iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1634	. "inst(X)", zsto,zout)
1635	c
1636	CALL histdef(nid_ins, "pres", "Air pressure", "Pa",
1637	. iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1638	. "inst(X)", zsto,zout)
1639	c
1640	CALL histdef(nid_ins, "dtvdf", "Boundary-layer dT", "K/s",
1641	. iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1642	. "inst(X)", zsto,zout)
1643	c
1644	CALL histdef(nid_ins, "dqvdf", "Boundary-layer dQ", "Kg/Kg/s",
1645	. iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1646	. "inst(X)", zsto,zout)
1647	c
1648
1649	CALL histend(nid_ins)
1650	c
1651	ndex2d = 0
1652	ndex3d = 0
1653	c
1654	ENDIF
1655
1656	c$$$PB Positionner date0 pour initialisation de ORCHIDEE
1657	c$$$ date0 = zjulian
1658	date0 = day_ini
1659	WRITE(,) 'physiq date0 : ',date0
1660	c
1661	c
1662	c
1663	c Prescrire l'ozone dans l'atmosphere
1664	c
1665	c
1666	cc DO i = 1, klon
1667	cc DO k = 1, klev
1668	cc CALL o3cm (paprs(i,k)/100.,paprs(i,k+1)/100., wo(i,k),20)
1669	cc ENDDO
1670	cc ENDDO
1671	c
1672	c
1673	ENDIF
1674	c
1675	c ************** Fin de IF ( debut ) *************
1676	c
1677	c
1678	c Mettre a zero des variables de sortie (pour securite)
1679	c
1680	DO i = 1, klon
1681	d_ps(i) = 0.0
1682	ENDDO
1683	DO k = 1, klev
1684	DO i = 1, klon
1685	d_t(i,k) = 0.0
1686	d_u(i,k) = 0.0
1687	d_v(i,k) = 0.0
1688	ENDDO
1689	ENDDO
1690	DO iq = 1, nqmax
1691	DO k = 1, klev
1692	DO i = 1, klon
1693	d_qx(i,k,iq) = 0.0
1694	ENDDO
1695	ENDDO
1696	ENDDO
1697	c
1698	c Ne pas affecter les valeurs entrees de u, v, h, et q
1699	c
1700	DO k = 1, klev
1701	DO i = 1, klon
1702	t_seri(i,k) = t(i,k)
1703	u_seri(i,k) = u(i,k)
1704	v_seri(i,k) = v(i,k)
1705	q_seri(i,k) = qx(i,k,ivap)
1706	ql_seri(i,k) = qx(i,k,iliq)
1707	ENDDO
1708	ENDDO
1709	IF (nqmax.GE.3) THEN
1710	DO iq = 3, nqmax
1711	DO k = 1, klev
1712	DO i = 1, klon
1713	tr_seri(i,k,iq-2) = qx(i,k,iq)
1714	ENDDO
1715	ENDDO
1716	ENDDO
1717	ELSE
1718	DO k = 1, klev
1719	DO i = 1, klon
1720	tr_seri(i,k,1) = 0.0
1721	ENDDO
1722	ENDDO
1723	ENDIF
1724	c
1725	c Diagnostiquer la tendance dynamique
1726	c
1727	IF (ancien_ok) THEN
1728	DO k = 1, klev
1729	DO i = 1, klon
1730	d_t_dyn(i,k) = (t_seri(i,k)-t_ancien(i,k))/dtime
1731	d_q_dyn(i,k) = (q_seri(i,k)-q_ancien(i,k))/dtime
1732	ENDDO
1733	ENDDO
1734	ELSE
1735	DO k = 1, klev
1736	DO i = 1, klon
1737	d_t_dyn(i,k) = 0.0
1738	d_q_dyn(i,k) = 0.0
1739	ENDDO
1740	ENDDO
1741	ancien_ok = .TRUE.
1742	ENDIF
1743	c
1744	c Ajouter le geopotentiel du sol:
1745	c
1746	DO k = 1, klev
1747	DO i = 1, klon
1748	zphi(i,k) = pphi(i,k) + pphis(i)
1749	ENDDO
1750	ENDDO
1751	c
1752	c Verifier les temperatures
1753	c
1754	CALL hgardfou(t_seri,ftsol,'debutphy')
1755	c
1756	c Incrementer le compteur de la physique
1757	c
1758	itap = itap + 1
1759	julien = MOD(NINT(xjour),360)
1760	c
1761	c Mettre en action les conditions aux limites (albedo, sst, etc.).
1762	c Prescrire l'ozone et calculer l'albedo sur l'ocean.
1763	c
1764	IF (MOD(itap-1,lmt_pas) .EQ. 0) THEN
1765	idayvrai = NINT(xjour)
1766	PRINT *,' PHYS cond julien ',julien,idayvrai
1767	CALL ozonecm( FLOAT(julien), rlat, paprs, wo)
1768	ENDIF
1769	c
1770	c Re-evaporer l'eau liquide nuageuse
1771	c
1772	DO k = 1, klev ! re-evaporation de l'eau liquide nuageuse
1773	DO i = 1, klon
1774	zlvdcp=RLVTT/RCPD/(1.0+RVTMP2*q_seri(i,k))
1775	zlsdcp=RLSTT/RCPD/(1.0+RVTMP2*q_seri(i,k))
1776	zdelta = MAX(0.,SIGN(1.,RTT-t_seri(i,k)))
1777	zb = MAX(0.0,ql_seri(i,k))
1778	za = - MAX(0.0,ql_seri(i,k))
1779	. * (zlvdcp(1.-zdelta)+zlsdcpzdelta)
1780	t_seri(i,k) = t_seri(i,k) + za
1781	q_seri(i,k) = q_seri(i,k) + zb
1782	ql_seri(i,k) = 0.0
1783	d_t_eva(i,k) = za
1784	d_q_eva(i,k) = zb
1785	ENDDO
1786	ENDDO
1787	c
1788	c Appeler la diffusion verticale (programme de couche limite)
1789	c
1790	DO i = 1, klon
1791	c if (.not. ok_veget) then
1792	c frugs(i,is_ter) = SQRT(frugs(i,is_ter)2+rugoro(i)2)
1793	c endif
1794	c frugs(i,is_lic) = rugoro(i)
1795	c frugs(i,is_oce) = rugmer(i)
1796	c frugs(i,is_sic) = 0.001
1797	zxrugs(i) = 0.0
1798	ENDDO
1799	DO nsrf = 1, nbsrf
1800	DO i = 1, klon
1801	frugs(i,nsrf) = MAX(frugs(i,nsrf),0.001)
1802	ENDDO
1803	ENDDO
1804	DO nsrf = 1, nbsrf
1805	DO i = 1, klon
1806	zxrugs(i) = zxrugs(i) + frugs(i,nsrf)*pctsrf(i,nsrf)
1807	ENDDO
1808	ENDDO
1809	c
1810	C calculs necessaires au calcul de l'albedo dans l'interface
1811	c
1812	CALL orbite(FLOAT(julien),zlongi,dist)
1813	IF (cycle_diurne) THEN
1814	zdtime=dtime*FLOAT(radpas) ! pas de temps du rayonnement (s)
1815	CALL zenang(zlongi,gmtime,zdtime,rlat,rlon,rmu0,fract)
1816	ELSE
1817	rmu0 = -999.999
1818	ENDIF
1819
1820	fder = dlw
1821
1822	CALL clmain(dtime,itap,zjulian,pctsrf,
1823	e t_seri,q_seri,u_seri,v_seri,
1824	e julien, rmu0,
1825	e ok_veget, ocean, npas, nexca, ftsol,
1826	$ soil_model,ftsoil,
1827	$ paprs,pplay,radsol, fsnow,fqsol,fevap,falbe,falblw,
1828	$ fluxlat,
1829	e rain_fall, snow_fall, solsw, sollw, sollwdown, fder,
1830	e rlon, rlat, cufi, cvfi, frugs,
1831	e debut, lafin, agesno,rugoro ,
1832	s d_t_vdf,d_q_vdf,d_u_vdf,d_v_vdf,d_ts,
1833	s fluxt,fluxq,fluxu,fluxv,cdragh,cdragm,
1834	s dsens, devap,
1835	s ycoefh,yu1,yv1)
1836
1837	c
1838	C§§§ PB
1839	C§§§ Incrementation des flux
1840	C§§
1841	zxfluxt=0.
1842	zxfluxq=0.
1843	zxfluxu=0.
1844	zxfluxv=0.
1845	DO nsrf = 1, nbsrf
1846	DO k = 1, klev
1847	DO i = 1, klon
1848	zxfluxt(i,k) = zxfluxt(i,k) +
1849	$ fluxt(i,k,nsrf) * pctsrf( i, nsrf)
1850	zxfluxq(i,k) = zxfluxq(i,k) +
1851	$ fluxq(i,k,nsrf) * pctsrf( i, nsrf)
1852	zxfluxu(i,k) = zxfluxu(i,k) +
1853	$ fluxu(i,k,nsrf) * pctsrf( i, nsrf)
1854	zxfluxv(i,k) = zxfluxv(i,k) +
1855	$ fluxv(i,k,nsrf) * pctsrf( i, nsrf)
1856	END DO
1857	END DO
1858	END DO
1859	DO i = 1, klon
1860	sens(i) = - zxfluxt(i,1) ! flux de chaleur sensible au sol
1861	c evap(i) = - fluxq(i,1) ! flux d'evaporation au sol
1862	evap(i) = - zxfluxq(i,1) ! flux d'evaporation au sol
1863	fder(i) = dlw(i) + dsens(i) + devap(i)
1864	ENDDO
1865
1866
1867	DO k = 1, klev
1868	DO i = 1, klon
1869	t_seri(i,k) = t_seri(i,k) + d_t_vdf(i,k)
1870	q_seri(i,k) = q_seri(i,k) + d_q_vdf(i,k)
1871	u_seri(i,k) = u_seri(i,k) + d_u_vdf(i,k)
1872	v_seri(i,k) = v_seri(i,k) + d_v_vdf(i,k)
1873	ENDDO
1874	ENDDO
1875	c
1876	c Incrementer la temperature du sol
1877	c
1878	DO i = 1, klon
1879	zxtsol(i) = 0.0
1880	IF ( abs( pctsrf(i, is_ter) + pctsrf(i, is_lic) +
1881	$ pctsrf(i, is_oce) + pctsrf(i, is_sic) - 1.) .GT. EPSFRA)
1882	$ THEN
1883	WRITE(,) 'physiq : pb sous surface au point ', i,
1884	$ pctsrf(i, 1 : nbsrf)
1885	ENDIF
1886	ENDDO
1887	DO nsrf = 1, nbsrf
1888	DO i = 1, klon
1889	c$$$ IF (pctsrf(i,nsrf) .GE. EPSFRA) THEN
1890	ftsol(i,nsrf) = ftsol(i,nsrf) + d_ts(i,nsrf)
1891	zxtsol(i) = zxtsol(i) + ftsol(i,nsrf)*pctsrf(i,nsrf)
1892	c$$$ ENDIF
1893	ENDDO
1894	ENDDO
1895
1896	c
1897	c Si une sous-fraction n'existe pas, elle prend la temp. moyenne
1898	c
1899	DO nsrf = 1, nbsrf
1900	DO i = 1, klon
1901	IF (pctsrf(i,nsrf) .LT. epsfra) ftsol(i,nsrf) = zxtsol(i)
1902	ENDDO
1903	ENDDO
1904
1905	c
1906	c Calculer la derive du flux infrarouge
1907	c
1908	c$$$ DO nsrf = 1, nbsrf
1909	DO i = 1, klon
1910	c$$$ IF (pctsrf(i,nsrf) .GE. EPSFRA) THEN
1911	dlw(i) = - 4.0RSIGMAzxtsol(i)**3
1912	c$$$ . *(ftsol(i,nsrf)-zxtsol(i))
1913	c$$$ . *pctsrf(i,nsrf)
1914	c$$$ ENDIF
1915	c$$$ ENDDO
1916	ENDDO
1917	c
1918	c Appeler la convection (au choix)
1919	c
1920	DO k = 1, klev
1921	DO i = 1, klon
1922	conv_q(i,k) = d_q_dyn(i,k)
1923	. + d_q_vdf(i,k)/dtime
1924	conv_t(i,k) = d_t_dyn(i,k)
1925	. + d_t_vdf(i,k)/dtime
1926	ENDDO
1927	ENDDO
1928	IF (check) THEN
1929	za = qcheck(klon,klev,paprs,q_seri,ql_seri,paire)
1930	PRINT*, "avantcon=", za
1931	ENDIF
1932	zx_ajustq = .FALSE.
1933	IF (iflag_con.EQ.2) zx_ajustq=.TRUE.
1934	IF (zx_ajustq) THEN
1935	DO i = 1, klon
1936	z_avant(i) = 0.0
1937	ENDDO
1938	DO k = 1, klev
1939	DO i = 1, klon
1940	z_avant(i) = z_avant(i) + (q_seri(i,k)+ql_seri(i,k))
1941	. *(paprs(i,k)-paprs(i,k+1))/RG
1942	ENDDO
1943	ENDDO
1944	ENDIF
1945	IF (iflag_con.EQ.1) THEN
1946	stop'reactiver le call conlmd dans physiq.F'
1947	c CALL conlmd (dtime, paprs, pplay, t_seri, q_seri, conv_q,
1948	c . d_t_con, d_q_con,
1949	c . rain_con, snow_con, ibas_con, itop_con)
1950	ELSE IF (iflag_con.EQ.2) THEN
1951	CALL conflx(dtime, paprs, pplay, t_seri, q_seri,
1952	e conv_t, conv_q, zxfluxq(1,1), omega,
1953	s d_t_con, d_q_con, rain_con, snow_con,
1954	s pmfu, pmfd, pen_u, pde_u, pen_d, pde_d,
1955	s kcbot, kctop, kdtop, pmflxr, pmflxs)
1956	WHERE (rain_con < 0.) rain_con = 0.
1957	WHERE (snow_con < 0.) snow_con = 0.
1958	DO i = 1, klon
1959	ibas_con(i) = klev+1 - kcbot(i)
1960	itop_con(i) = klev+1 - kctop(i)
1961	ENDDO
1962	ELSE IF (iflag_con.GE.3) THEN
1963	c nb of tracers for the KE convection:
1964	if (nqmax .GE. 4) then
1965	ntra = nbtr
1966	else
1967	ntra = 1
1968	endif
1969	if (iflag_con.eq.4) then ! vectorise
1970	CALL conemav (dtime,paprs,pplay,t_seri,q_seri,
1971	. u_seri,v_seri,tr_seri,nbtr,
1972	. ema_work1,ema_work2,
1973	. d_t_con,d_q_con,d_u_con,d_v_con,d_tr,
1974	. rain_con, snow_con, ibas_con, itop_con,
1975	. upwd,dnwd,dnwd0,
1976	c . Ma,cape,tvp,(/(nint(rflag(i)),i=1,size(rflag))/),
1977	. Ma,cape,tvp,iflagctrl,
1978	. pbase,bbase,dtvpdt1,dtvpdq1,dplcldt,dplcldr)
1979
1980	else
1981
1982	CALL conema (dtime,paprs,pplay,t_seri,q_seri,
1983	. u_seri,v_seri,tr_seri,nbtr,
1984	. ema_work1,ema_work2,
1985	. d_t_con,d_q_con,d_u_con,d_v_con,d_tr,
1986	. rain_con, snow_con, ibas_con, itop_con,
1987	. upwd,dnwd,dnwd0,bas,top,
1988	. Ma,cape,tvp,rflag,
1989	. pbase
1990	. ,bbase,dtvpdt1,dtvpdq1,dplcldt,dplcldr)
1991	endif
1992	DO i = 1, klon
1993	ema_pcb(i) = pbase(i)
1994	ENDDO
1995	DO i = 1, klon
1996	ema_pct(i) = paprs(i,itop_con(i))
1997	ENDDO
1998	DO i = 1, klon
1999	ema_cbmf(i) = ema_workcbmf(i)
2000	ENDDO
2001	ELSE
2002	PRINT*, "iflag_con non-prevu", iflag_con
2003	CALL abort
2004	ENDIF
2005
2006	CALL homogene(paprs, q_seri, d_q_con, u_seri,v_seri,
2007	. d_u_con, d_v_con)
2008	DO k = 1, klev
2009	DO i = 1, klon
2010	t_seri(i,k) = t_seri(i,k) + d_t_con(i,k)
2011	q_seri(i,k) = q_seri(i,k) + d_q_con(i,k)
2012	u_seri(i,k) = u_seri(i,k) + d_u_con(i,k)
2013	v_seri(i,k) = v_seri(i,k) + d_v_con(i,k)
2014	ENDDO
2015	ENDDO
2016	IF (check) THEN
2017	za = qcheck(klon,klev,paprs,q_seri,ql_seri,paire)
2018	PRINT*, "aprescon=", za
2019	zx_t = 0.0
2020	za = 0.0
2021	DO i = 1, klon
2022	za = za + paire(i)/FLOAT(klon)
2023	zx_t = zx_t + (rain_con(i)+snow_con(i))*paire(i)/FLOAT(klon)
2024	ENDDO
2025	zx_t = zx_t/za*dtime
2026	PRINT*, "Precip=", zx_t
2027	ENDIF
2028	IF (zx_ajustq) THEN
2029	DO i = 1, klon
2030	z_apres(i) = 0.0
2031	ENDDO
2032	DO k = 1, klev
2033	DO i = 1, klon
2034	z_apres(i) = z_apres(i) + (q_seri(i,k)+ql_seri(i,k))
2035	. *(paprs(i,k)-paprs(i,k+1))/RG
2036	ENDDO
2037	ENDDO
2038	DO i = 1, klon
2039	z_factor(i) = (z_avant(i)-(rain_con(i)+snow_con(i))*dtime)
2040	. /z_apres(i)
2041	ENDDO
2042	DO k = 1, klev
2043	DO i = 1, klon
2044	IF (z_factor(i).GT.(1.0+1.0E-08) .OR.
2045	. z_factor(i).LT.(1.0-1.0E-08)) THEN
2046	q_seri(i,k) = q_seri(i,k) * z_factor(i)
2047	ENDIF
2048	ENDDO
2049	ENDDO
2050	ENDIF
2051	zx_ajustq=.FALSE.
2052	c
2053	IF (nqmax.GT.2) THEN !--melange convectif de traceurs
2054	c
2055	IF (iflag_con .LT. 2 .AND. iflag_con .GT. 4 ) THEN
2056	PRINT*, 'Pour l instant, seul conflx fonctionne ',
2057	$ 'avec traceurs', iflag_con
2058	PRINT*,' Mettre iflag_con',
2059	$ ' = 2, 3 ou 4 dans run.def et repasser'
2060	CALL abort
2061	ENDIF
2062	c
2063	ENDIF !--nqmax.GT.2
2064	c
2065	c Appeler l'ajustement sec
2066	c
2067	CALL ajsec(paprs, pplay, t_seri, q_seri, d_t_ajs, d_q_ajs)
2068	DO k = 1, klev
2069	DO i = 1, klon
2070	t_seri(i,k) = t_seri(i,k) + d_t_ajs(i,k)
2071	q_seri(i,k) = q_seri(i,k) + d_q_ajs(i,k)
2072	ENDDO
2073	ENDDO
2074
2075	c RATQS
2076	if (iflag_con.eq.2) then
2077	flag_ratqs=0
2078	else
2079	flag_ratqs=1
2080	endif
2081	call calcratqs (flag_ratqs,
2082	I paprs,pplay,q_seri,d_t_con,d_t_ajs
2083	O ,ratqs,zpt_conv)
2084	c
2085	c Appeler le processus de condensation a grande echelle
2086	c et le processus de precipitation
2087	c
2088	CALL fisrtilp_tr(dtime,paprs,pplay,
2089	. t_seri, q_seri,ratqs,
2090	. d_t_lsc, d_q_lsc, d_ql_lsc, rneb, cldliq,
2091	. rain_lsc, snow_lsc,
2092	. pfrac_impa, pfrac_nucl, pfrac_1nucl,
2093	. frac_impa, frac_nucl,
2094	. prfl, psfl)
2095	WHERE (rain_lsc < 0) rain_lsc = 0.
2096	WHERE (snow_lsc < 0) snow_lsc = 0.
2097	DO k = 1, klev
2098	DO i = 1, klon
2099	t_seri(i,k) = t_seri(i,k) + d_t_lsc(i,k)
2100	q_seri(i,k) = q_seri(i,k) + d_q_lsc(i,k)
2101	ql_seri(i,k) = ql_seri(i,k) + d_ql_lsc(i,k)
2102	cldfra(i,k) = rneb(i,k)
2103	IF (.NOT.new_oliq) cldliq(i,k) = ql_seri(i,k)
2104	ENDDO
2105	ENDDO
2106	IF (check) THEN
2107	za = qcheck(klon,klev,paprs,q_seri,ql_seri,paire)
2108	PRINT*, "apresilp=", za
2109	zx_t = 0.0
2110	za = 0.0
2111	DO i = 1, klon
2112	za = za + paire(i)/FLOAT(klon)
2113	zx_t = zx_t + (rain_lsc(i)+snow_lsc(i))*paire(i)/FLOAT(klon)
2114	ENDDO
2115	zx_t = zx_t/za*dtime
2116	PRINT*, "Precip=", zx_t
2117	ENDIF
2118	c
2119	c Nuages diagnostiques:
2120	c
2121	IF (iflag_con.EQ.2) THEN ! seulement pour Tiedtke
2122	CALL diagcld1(paprs,pplay,
2123	. rain_con,snow_con,ibas_con,itop_con,
2124	. diafra,dialiq)
2125	DO k = 1, klev
2126	DO i = 1, klon
2127	IF (diafra(i,k).GT.cldfra(i,k)) THEN
2128	cldliq(i,k) = dialiq(i,k)
2129	cldfra(i,k) = diafra(i,k)
2130	ENDIF
2131	ENDDO
2132	ENDDO
2133	ENDIF
2134	c
2135	c Nuages stratus artificiels:
2136	c
2137	IF (ok_stratus) THEN
2138	CALL diagcld2(paprs,pplay,t_seri,q_seri, diafra,dialiq)
2139	DO k = 1, klev
2140	DO i = 1, klon
2141	IF (diafra(i,k).GT.cldfra(i,k)) THEN
2142	cldliq(i,k) = dialiq(i,k)
2143	cldfra(i,k) = diafra(i,k)
2144	ENDIF
2145	ENDDO
2146	ENDDO
2147	ENDIF
2148	c
2149	c Precipitation totale
2150	c
2151	DO i = 1, klon
2152	rain_fall(i) = rain_con(i) + rain_lsc(i)
2153	snow_fall(i) = snow_con(i) + snow_lsc(i)
2154	ENDDO
2155	c
2156	c Calculer l'humidite relative pour diagnostique
2157	c
2158	DO k = 1, klev
2159	DO i = 1, klon
2160	zx_t = t_seri(i,k)
2161	IF (thermcep) THEN
2162	zdelta = MAX(0.,SIGN(1.,rtt-zx_t))
2163	zx_qs = r2es * FOEEW(zx_t,zdelta)/pplay(i,k)
2164	zx_qs = MIN(0.5,zx_qs)
2165	zcor = 1./(1.-retv*zx_qs)
2166	zx_qs = zx_qs*zcor
2167	ELSE
2168	IF (zx_t.LT.t_coup) THEN
2169	zx_qs = qsats(zx_t)/pplay(i,k)
2170	ELSE
2171	zx_qs = qsatl(zx_t)/pplay(i,k)
2172	ENDIF
2173	ENDIF
2174	zx_rh(i,k) = q_seri(i,k)/zx_qs
2175	ENDDO
2176	ENDDO
2177	c
2178	c Calculer les parametres optiques des nuages et quelques
2179	c parametres pour diagnostiques:
2180	c
2181	CALL nuage (paprs, pplay,
2182	. t_seri, cldliq, cldfra, cldtau, cldemi,
2183	. cldh, cldl, cldm, cldt, cldq)
2184	c
2185	c Appeler le rayonnement mais calculer tout d'abord l'albedo du sol.
2186	c
2187	IF (MOD(itaprad,radpas).EQ.0) THEN
2188	DO i = 1, klon
2189	albsol(i) = falbe(i,is_oce) * pctsrf(i,is_oce)
2190	. + falbe(i,is_lic) * pctsrf(i,is_lic)
2191	. + falbe(i,is_ter) * pctsrf(i,is_ter)
2192	. + falbe(i,is_sic) * pctsrf(i,is_sic)
2193	albsollw(i) = falblw(i,is_oce) * pctsrf(i,is_oce)
2194	. + falblw(i,is_lic) * pctsrf(i,is_lic)
2195	. + falblw(i,is_ter) * pctsrf(i,is_ter)
2196	. + falblw(i,is_sic) * pctsrf(i,is_sic)
2197	ENDDO
2198	! if (debut) then
2199	! albsol1 = albsol
2200	! albsollw1 = albsollw
2201	! endif
2202	! albsol = albsol1
2203	! albsollw = albsollw1
2204	CALL radlwsw ! nouveau rayonnement (compatible Arpege-IFS)
2205	e (dist, rmu0, fract, co2_ppm, solaire,
2206	e paprs, pplay,zxtsol,albsol, albsollw, t_seri,q_seri,
2207	e wo,
2208	e cldfra, cldemi, cldtau,
2209	s heat,heat0,cool,cool0,radsol,albpla,
2210	s topsw,toplw,solsw,sollw,
2211	s sollwdown,
2212	s topsw0,toplw0,solsw0,sollw0)
2213	itaprad = 0
2214	ENDIF
2215	itaprad = itaprad + 1
2216	c
2217	c Ajouter la tendance des rayonnements (tous les pas)
2218	c
2219	DO k = 1, klev
2220	DO i = 1, klon
2221	t_seri(i,k) = t_seri(i,k)
2222	. + (heat(i,k)-cool(i,k)) * dtime/86400.
2223	ENDDO
2224	ENDDO
2225	c
2226	c Calculer l'hydrologie de la surface
2227	c
2228	c CALL hydrol(dtime,pctsrf,rain_fall, snow_fall, zxevap,
2229	c . agesno, ftsol,fqsol,fsnow, ruis)
2230	c
2231	DO i = 1, klon
2232	zxqsol(i) = 0.0
2233	zxsnow(i) = 0.0
2234	ENDDO
2235	DO nsrf = 1, nbsrf
2236	DO i = 1, klon
2237	zxqsol(i) = zxqsol(i) + fqsol(i,nsrf)*pctsrf(i,nsrf)
2238	zxsnow(i) = zxsnow(i) + fsnow(i,nsrf)*pctsrf(i,nsrf)
2239	ENDDO
2240	ENDDO
2241	c
2242	c Si une sous-fraction n'existe pas, elle prend la valeur moyenne
2243	c
2244	c$$$ DO nsrf = 1, nbsrf
2245	c$$$ DO i = 1, klon
2246	c$$$ IF (pctsrf(i,nsrf).LT.epsfra) THEN
2247	c$$$ fqsol(i,nsrf) = zxqsol(i)
2248	c$$$ fsnow(i,nsrf) = zxsnow(i)
2249	c$$$ ENDIF
2250	c$$$ ENDDO
2251	c$$$ ENDDO
2252	c
2253	c Calculer le bilan du sol et la derive de temperature (couplage)
2254	c
2255	DO i = 1, klon
2256	bils(i) = radsol(i) - sens(i) - evap(i)*RLVTT
2257	ENDDO
2258	c
2259	cmoddeblott(jan95)
2260	c Appeler le programme de parametrisation de l'orographie
2261	c a l'echelle sous-maille:
2262	c
2263	IF (ok_orodr) THEN
2264	c
2265	c selection des points pour lesquels le shema est actif:
2266	igwd=0
2267	DO i=1,klon
2268	itest(i)=0
2269	c IF ((zstd(i).gt.10.0)) THEN
2270	IF (((zpic(i)-zmea(i)).GT.100.).AND.(zstd(i).GT.10.0)) THEN
2271	itest(i)=1
2272	igwd=igwd+1
2273	idx(igwd)=i
2274	ENDIF
2275	ENDDO
2276	c igwdim=MAX(1,igwd)
2277	c
2278	CALL drag_noro(klon,klev,dtime,paprs,pplay,
2279	e zmea,zstd, zsig, zgam, zthe,zpic,zval,
2280	e igwd,idx,itest,
2281	e t_seri, u_seri, v_seri,
2282	s zulow, zvlow, zustr, zvstr,
2283	s d_t_oro, d_u_oro, d_v_oro)
2284	c
2285	c ajout des tendances
2286	DO k = 1, klev
2287	DO i = 1, klon
2288	t_seri(i,k) = t_seri(i,k) + d_t_oro(i,k)
2289	u_seri(i,k) = u_seri(i,k) + d_u_oro(i,k)
2290	v_seri(i,k) = v_seri(i,k) + d_v_oro(i,k)
2291	ENDDO
2292	ENDDO
2293	c
2294	ENDIF ! fin de test sur ok_orodr
2295	c
2296	IF (ok_orolf) THEN
2297	c
2298	c selection des points pour lesquels le shema est actif:
2299	igwd=0
2300	DO i=1,klon
2301	itest(i)=0
2302	IF ((zpic(i)-zmea(i)).GT.100.) THEN
2303	itest(i)=1
2304	igwd=igwd+1
2305	idx(igwd)=i
2306	ENDIF
2307	ENDDO
2308	c igwdim=MAX(1,igwd)
2309	c
2310	CALL lift_noro(klon,klev,dtime,paprs,pplay,
2311	e rlat,zmea,zstd,zpic,
2312	e itest,
2313	e t_seri, u_seri, v_seri,
2314	s zulow, zvlow, zustr, zvstr,
2315	s d_t_lif, d_u_lif, d_v_lif)
2316	c
2317	c ajout des tendances
2318	DO k = 1, klev
2319	DO i = 1, klon
2320	t_seri(i,k) = t_seri(i,k) + d_t_lif(i,k)
2321	u_seri(i,k) = u_seri(i,k) + d_u_lif(i,k)
2322	v_seri(i,k) = v_seri(i,k) + d_v_lif(i,k)
2323	ENDDO
2324	ENDDO
2325	c
2326	ENDIF ! fin de test sur ok_orolf
2327	c
2328	cAA
2329	cAA Installation de l'interface online-offline pour traceurs
2330	cAA
2331	c====================================================================
2332	c Calcul des tendances traceurs
2333	c====================================================================
2334	C Pascale : il faut quand meme apeller phytrac car il gere les sorties
2335	cKE43 des traceurs => il faut donc mettre des flags a .false.
2336	IF (iflag_con.GE.3) THEN
2337	c on ajoute les tendances calculees par KE43
2338	c$$$ OM on onhibe la convection sur les traceurs
2339	DO iq=1, nqmax-2 ! Sandrine a -3 ???
2340	c$$$ OM on inhibe la convection sur les traceur
2341	c$$$ DO k = 1, nlev
2342	c$$$ DO i = 1, klon
2343	c$$$ tr_seri(i,k,iq) = tr_seri(i,k,iq) + d_tr(i,k,iq)
2344	c$$$ ENDDO
2345	c$$$ ENDDO
2346	WRITE(iqn,'(i2.2)') iq
2347	CALL minmaxqfi(tr_seri(1,1,iq),0.,1.e33,'couche lim iq='//iqn)
2348	ENDDO
2349	CMAF modif pour garder info du nombre de traceurs auxquels
2350	C la physique s'applique
2351	ELSE
2352	CMAF modif pour garder info du nombre de traceurs auxquels
2353	C la physique s'applique
2354	C
2355	call phytrac (rnpb,
2356	I debut,lafin,
2357	I nqmax-2,
2358	I nlon,nlev,dtime,
2359	I t,paprs,pplay,
2360	I pmfu, pmfd, pen_u, pde_u, pen_d, pde_d,
2361	I ycoefh,yu1,yv1,ftsol,pctsrf,rlat,
2362	I frac_impa, frac_nucl,
2363	I rlon,presnivs,paire,pphis,
2364	O tr_seri)
2365	ENDIF
2366
2367	IF (offline) THEN
2368
2369	call phystokenc (
2370	I nlon,nlev,pdtphys,rlon,rlat,
2371	I t,pmfu, pmfd, pen_u, pde_u, pen_d, pde_d,
2372	I ycoefh,yu1,yv1,ftsol,pctsrf,
2373	I frac_impa, frac_nucl,
2374	I pphis,paire,dtime,itap)
2375
2376
2377	ENDIF
2378
2379	c
2380	c Calculer le transport de l'eau et de l'energie (diagnostique)
2381	c
2382	CALL transp (paprs,zxtsol,
2383	e t_seri, q_seri, u_seri, v_seri, zphi,
2384	s ve, vq, ue, uq)
2385	c
2386	c Accumuler les variables a stocker dans les fichiers histoire:
2387	c
2388	c
2389	c
2390
2391	IF (ok_journe) THEN
2392	c
2393	ndex2d = 0
2394	ndex3d = 0
2395	c
2396	c Champs 2D:
2397	c
2398	zsto = dtime
2399	zout = dtime * FLOAT(ecrit_day)
2400
2401	i = NINT(zout/zsto)
2402	CALL gr_fi_ecrit(1,klon,iim,jjmp1,pphis,zx_tmp_2d)
2403	CALL histwrite(nid_day,"phis",i,zx_tmp_2d,iim*jjmp1,ndex2d)
2404	varname = 'phis'
2405	vartitle= 'Surface geop. height'
2406	varunits= '-'
2407	c call writephy(fid_day,prof2d_on,varname,pphis,vartitle,
2408	c . varunits)
2409	c
2410	i = NINT(zout/zsto)
2411	CALL gr_fi_ecrit(1,klon,iim,jjmp1,paire,zx_tmp_2d)
2412	CALL histwrite(nid_day,"aire",i,zx_tmp_2d,iim*jjmp1,ndex2d)
2413	varname = 'aire'
2414	vartitle= 'Grid area'
2415	varunits= '-'
2416	c call writephy(fid_day,prof2d_on,varname,paire,vartitle,
2417	c . varunits)
2418	C
2419	CALL gr_fi_ecrit(1, klon,iim,jjmp1, zxtsol,zx_tmp_2d)
2420	CALL histwrite(nid_day,"tsol",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2421	c call writephy(fid_day,prof2d_av,'tsol',zxtsol,
2422	c . 'Surface Temperature','K')
2423	c
2424	C
2425	zx_tmp_fi2d(1 : klon) = ftsol(1 : klon, is_ter)
2426	CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d ,zx_tmp_2d)
2427	CALL histwrite(nid_day,"tter",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2428	c call writephy(fid_day,prof2d_av,'tter',ftsol(1 : klon, is_ter),
2429	c . 'Surface Temperature','K')
2430	C
2431	zx_tmp_fi2d(1 : klon) = ftsol(1 : klon, is_lic)
2432	CALL gr_fi_ecrit(1, klon,iim,jjmp1, zxtsol,zx_tmp_2d)
2433	CALL histwrite(nid_day,"tlic",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2434	c call writephy(fid_day,prof2d_av,'tlic',ftsol(1 : klon, is_lic),
2435	c . 'Surface Temperature','K')
2436	C
2437	zx_tmp_fi2d(1 : klon) = ftsol(1 : klon, is_oce)
2438	CALL gr_fi_ecrit(1, klon,iim,jjmp1, zxtsol,zx_tmp_2d)
2439	CALL histwrite(nid_day,"toce",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2440	c call writephy(fid_day,prof2d_av,'toce',ftsol(1 : klon, is_oce),
2441	c . 'Surface Temperature','K')
2442	C
2443	zx_tmp_fi2d(1 : klon) = ftsol(1 : klon, is_sic)
2444	CALL gr_fi_ecrit(1, klon,iim,jjmp1, zxtsol,zx_tmp_2d)
2445	CALL histwrite(nid_day,"tsic",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2446	c call writephy(fid_day,prof2d_av,'tsic',ftsol(1 : klon, is_sic),
2447	c . 'Surface Temperature','K')
2448	C
2449	DO i = 1, klon
2450	zx_tmp_fi2d(i) = paprs(i,1)
2451	ENDDO
2452	CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d,zx_tmp_2d)
2453	CALL histwrite(nid_day,"psol",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2454	c Essai writephys
2455	varname = 'psol'
2456	vartitle= 'pression au sol'
2457	varunits= 'hPa'
2458	c call writephy(fid_day,prof2d_av,varname,zx_tmp_fi2d,vartitle,
2459	c . varunits)
2460	c
2461	DO i = 1, klon
2462	zx_tmp_fi2d(i) = (rain_fall(i) + snow_fall(i))* 86400.
2463	ENDDO
2464	CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d,zx_tmp_2d)
2465	CALL histwrite(nid_day,"rain",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2466	c call writephy(fid_day,prof2d_av,'rain',zx_tmp_fi2d,
2467	c . 'Precipitation','mm/day')
2468
2469
2470	c
2471	CALL gr_fi_ecrit(1, klon,iim,jjmp1, snow_fall,zx_tmp_2d)
2472	CALL histwrite(nid_day,"snow",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2473	c call writephy(fid_day,prof2d_av,'snow',snow_fall,
2474	c . 'Snow','mm/day')
2475	c
2476	CALL gr_fi_ecrit(1, klon,iim,jjmp1, zxsnow,zx_tmp_2d)
2477	CALL histwrite(nid_day,"snow_cov",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2478	c call writephy(fid_day,prof2d_av,'snow_cov',zxsnow,
2479	c . 'Snow cover','mm')
2480	c
2481	CALL gr_fi_ecrit(1, klon,iim,jjmp1, evap,zx_tmp_2d)
2482	CALL histwrite(nid_day,"evap",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2483	c call writephy(fid_day,prof2d_av,'evap',evap,
2484	c . 'Evaporation','mm/day')
2485	c
2486	CALL gr_fi_ecrit(1, klon,iim,jjmp1, topsw,zx_tmp_2d)
2487	CALL histwrite(nid_day,"tops",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2488	c call writephy(fid_day,prof2d_av,'tops',topsw,
2489	c . 'Solar rad. at TOA','W/m2')
2490	c
2491	CALL gr_fi_ecrit(1, klon,iim,jjmp1, toplw,zx_tmp_2d)
2492	CALL histwrite(nid_day,"topl",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2493	c call writephy(fid_day,prof2d_av,'topl',toplw,
2494	c . 'IR rad. at TOA','W/m2')
2495	c
2496	CALL gr_fi_ecrit(1, klon,iim,jjmp1, solsw,zx_tmp_2d)
2497	CALL histwrite(nid_day,"sols",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2498	c call writephy(fid_day,prof2d_av,'sols',solsw,
2499	c . 'Solar rad. at surf.','W/m2')
2500	c
2501	CALL gr_fi_ecrit(1, klon,iim,jjmp1, sollw,zx_tmp_2d)
2502	CALL histwrite(nid_day,"soll",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2503	c call writephy(fid_day,prof2d_av,'soll',sollw,
2504	c . 'IR rad. at surface','W/m2')
2505	c
2506	CALL gr_fi_ecrit(1, klon,iim,jjmp1, sollwdown,zx_tmp_2d)
2507	CALL histwrite(nid_day,"solldown",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2508	c call writephy(fid_day,prof2d_av,'solldown',sollwdown,
2509	c . 'Down. IR rad. at surface','W/m2')
2510	c
2511	CALL gr_fi_ecrit(1, klon,iim,jjmp1, bils,zx_tmp_2d)
2512	CALL histwrite(nid_day,"bils",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2513	c call writephy(fid_day,prof2d_av,'bils',bils,
2514	c . 'Surf. total heat flux','W/m2')
2515	c
2516	CALL gr_fi_ecrit(1, klon,iim,jjmp1, sens,zx_tmp_2d)
2517	CALL histwrite(nid_day,"sens",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2518	c call writephy(fid_day,prof2d_av,'sens',sens,
2519	c . 'Sensible heat flux','W/m2')
2520	c
2521	CALL gr_fi_ecrit(1, klon,iim,jjmp1, fder,zx_tmp_2d)
2522	CALL histwrite(nid_day,"fder",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2523	c call writephy(fid_day,prof2d_av,'fder',fder,
2524	c . 'Heat flux derivation','W/m2')
2525	c
2526	c
2527	DO nsrf = 1, nbsrf
2528	C§§§
2529	zx_tmp_fi2d(1 : klon) = pctsrf( 1 : klon, nsrf)
2530	CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d , zx_tmp_2d)
2531	CALL histwrite(nid_day,"pourc_"//clnsurf(nsrf),itap,
2532	$ zx_tmp_2d,iim*jjmp1,ndex2d)
2533	c call writephy(fid_day,prof2d_av,'pourc_'//clnsurf(nsrf),
2534	c . pctsrf( 1 : klon, nsrf),
2535	c . 'Fraction'//clnsurf(nsrf),'-')
2536	C
2537	zx_tmp_fi2d(1 : klon) = ftsol( 1 : klon, nsrf)
2538	CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d , zx_tmp_2d)
2539	CALL histwrite(nid_day,"tsol_"//clnsurf(nsrf),itap,
2540	$ zx_tmp_2d,iim*jjmp1,ndex2d)
2541	c call writephy(fid_day,prof2d_av,'tsol_'//clnsurf(nsrf),
2542	c . ftsol( 1 : klon, nsrf),
2543	c . 'Surf. Temp'//clnsurf(nsrf),'K')
2544	C
2545	zx_tmp_fi2d(1 : klon) = fluxt( 1 : klon, 1, nsrf)
2546	CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d , zx_tmp_2d)
2547	CALL histwrite(nid_day,"sens_"//clnsurf(nsrf),itap,
2548	$ zx_tmp_2d,iim*jjmp1,ndex2d)
2549	c call writephy(fid_day,prof2d_av,'sens_'//clnsurf(nsrf),
2550	c . fluxt( 1 : klon, 1, nsrf),
2551	c . 'Sensible heat flux '//clnsurf(nsrf),'W/m2')
2552	C
2553	zx_tmp_fi2d(1 : klon) = fluxlat( 1 : klon, nsrf)
2554	CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d , zx_tmp_2d)
2555	CALL histwrite(nid_day,"lat_"//clnsurf(nsrf),itap,
2556	$ zx_tmp_2d,iim*jjmp1,ndex2d)
2557	c call writephy(fid_day,prof2d_av,'lat_'//clnsurf(nsrf),
2558	c . fluxlat( 1 : klon, nsrf),
2559	c . 'Latent heat flux '//clnsurf(nsrf),'W/m2')
2560	C
2561	zx_tmp_fi2d(1 : klon) = fluxu( 1 : klon, 1, nsrf)
2562	CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d , zx_tmp_2d)
2563	CALL histwrite(nid_day,"taux_"//clnsurf(nsrf),itap,
2564	$ zx_tmp_2d,iim*jjmp1,ndex2d)
2565	c call writephy(fid_day,prof2d_av,'taux_'//clnsurf(nsrf),
2566	c . fluxu( 1 : klon, 1, nsrf),
2567	c . 'Zonal wind stress '//clnsurf(nsrf),'Pa')
2568	C
2569	zx_tmp_fi2d(1 : klon) = fluxv( 1 : klon, 1, nsrf)
2570	CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d , zx_tmp_2d)
2571	CALL histwrite(nid_day,"tauy_"//clnsurf(nsrf),itap,
2572	$ zx_tmp_2d,iim*jjmp1,ndex2d)
2573	c call writephy(fid_day,prof2d_av,'tauy_'//clnsurf(nsrf),
2574	c . fluxv( 1 : klon, 1, nsrf),
2575	c . 'Meridional wind stress '//clnsurf(nsrf),'Pa')
2576	C
2577	zx_tmp_fi2d(1 : klon) = falbe( 1 : klon, nsrf)
2578	CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d , zx_tmp_2d)
2579	CALL histwrite(nid_day,"albe_"//clnsurf(nsrf),itap,
2580	$ zx_tmp_2d,iim*jjmp1,ndex2d)
2581	c call writephy(fid_day,prof2d_av,'albe_'//clnsurf(nsrf),
2582	c . falbe( 1 : klon, nsrf),
2583	c . 'Albedo surf. SW'//clnsurf(nsrf),'-')
2584	c call writephy(fid_day,prof2d_av,'alblw_'//clnsurf(nsrf),
2585	c . falblw( 1 : klon, nsrf),
2586	c . 'Albedo surf. LW'//clnsurf(nsrf),'-')
2587	C
2588	zx_tmp_fi2d(1 : klon) = frugs( 1 : klon, nsrf)
2589	CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d , zx_tmp_2d)
2590	CALL histwrite(nid_day,"rugs_"//clnsurf(nsrf),itap,
2591	$ zx_tmp_2d,iim*jjmp1,ndex2d)
2592	c call writephy(fid_day,prof2d_av,'rugs_'//clnsurf(nsrf),
2593	c . frugs( 1 : klon, nsrf),
2594	c . 'Rugosity '//clnsurf(nsrf),' - ')
2595	C
2596	END DO
2597	C
2598	c$$$ DO i = 1, klon
2599	c$$$ zx_tmp_fi2d(i) = pctsrf(i,is_sic)
2600	c$$$ ENDDO
2601	c$$$ CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d,zx_tmp_2d)
2602	c$$$ CALL histwrite(nid_day,"sicf",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2603	c
2604	CALL gr_fi_ecrit(1, klon,iim,jjmp1, cldl,zx_tmp_2d)
2605	CALL histwrite(nid_day,"cldl",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2606	c call writephy(fid_day,prof2d_av,'cldl',cldl,
2607	c . 'Low-level cloudiness','-')
2608	c
2609	CALL gr_fi_ecrit(1, klon,iim,jjmp1, cldm,zx_tmp_2d)
2610	CALL histwrite(nid_day,"cldm",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2611	c call writephy(fid_day,prof2d_av,'cldm',cldm,
2612	c . 'Mid-level cloudiness','-')
2613	c
2614	CALL gr_fi_ecrit(1, klon,iim,jjmp1, cldh,zx_tmp_2d)
2615	CALL histwrite(nid_day,"cldh",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2616	c call writephy(fid_day,prof2d_av,'cldh',cldh,
2617	c . 'High-level cloudiness','-')
2618	c
2619	CALL gr_fi_ecrit(1, klon,iim,jjmp1, cldt,zx_tmp_2d)
2620	CALL histwrite(nid_day,"cldt",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2621	c call writephy(fid_day,prof2d_av,'cldt',cldt,
2622	c . 'Total cloudiness','-')
2623	c
2624	CALL gr_fi_ecrit(1, klon,iim,jjmp1, cldq,zx_tmp_2d)
2625	CALL histwrite(nid_day,"cldq",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2626	c call writephy(fid_day,prof2d_av,'cldq',cldq,
2627	c . 'Cloud liquid water path','-')
2628	c
2629	c Champs 3D:
2630	c
2631	CALL gr_fi_ecrit(klev,klon,iim,jjmp1, t_seri, zx_tmp_3d)
2632	CALL histwrite(nid_day,"temp",itap,zx_tmp_3d,
2633	. iimjjmp1klev,ndex3d)
2634	c Essai writephys
2635	varname = 'temp'
2636	vartitle= 'temperature 3D'
2637	varunits= 'K'
2638	c call writephy(fid_day,prof3d_av,varname,t_seri,vartitle,varunits)
2639	c
2640	CALL gr_fi_ecrit(klev,klon,iim,jjmp1, qx(1,1,ivap), zx_tmp_3d)
2641	CALL histwrite(nid_day,"ovap",itap,zx_tmp_3d,
2642	. iimjjmp1klev,ndex3d)
2643	c call writephy(fid_day,prof3d_av,'ovap',qx(1,1,ivap),
2644	c . 'Specific humidity','Kg/Kg')
2645	c
2646	CALL gr_fi_ecrit(klev,klon,iim,jjmp1, zphi, zx_tmp_3d)
2647	CALL histwrite(nid_day,"geop",itap,zx_tmp_3d,
2648	. iimjjmp1klev,ndex3d)
2649	c call writephy(fid_day,prof3d_av,'geop',zphi,
2650	c . 'Geopotential height','m')
2651	c
2652	CALL gr_fi_ecrit(klev,klon,iim,jjmp1, u_seri, zx_tmp_3d)
2653	CALL histwrite(nid_day,"vitu",itap,zx_tmp_3d,
2654	. iimjjmp1klev,ndex3d)
2655	c call writephy(fid_day,prof3d_av,'vitu',u_seri,
2656	c . 'Zonal wind','m/s')
2657	c
2658	CALL gr_fi_ecrit(klev,klon,iim,jjmp1, v_seri, zx_tmp_3d)
2659	CALL histwrite(nid_day,"vitv",itap,zx_tmp_3d,
2660	. iimjjmp1klev,ndex3d)
2661	c call writephy(fid_day,prof3d_av,'vitv',v_seri,
2662	c . 'Meridional wind','m/s')
2663	c
2664	CALL gr_fi_ecrit(klev,klon,iim,jjmp1, omega, zx_tmp_3d)
2665	CALL histwrite(nid_day,"vitw",itap,zx_tmp_3d,
2666	. iimjjmp1klev,ndex3d)
2667	c call writephy(fid_day,prof3d_av,'vitw',omega,
2668	c . 'Vertical wind','m/s')
2669	c
2670	CALL gr_fi_ecrit(klev,klon,iim,jjmp1, pplay, zx_tmp_3d)
2671	CALL histwrite(nid_day,"pres",itap,zx_tmp_3d,
2672	. iimjjmp1klev,ndex3d)
2673	c call writephy(fid_day,prof3d_av,'pres',pplay,
2674	c . 'Air pressure','Pa')
2675
2676	c
2677	if (ok_sync) then
2678	c call writephy_sync(fid_day)
2679	call histsync(nid_day)
2680	endif
2681	ENDIF
2682	C
2683	IF (ok_mensuel) THEN
2684	c
2685	ndex2d = 0
2686	ndex3d = 0
2687	c
2688	c Champs 2D:
2689	c
2690	zsto = dtime
2691	zout = dtime * ecrit_mth
2692
2693	i = NINT(zout/zsto)
2694	CALL gr_fi_ecrit(1,klon,iim,jjmp1,pphis,zx_tmp_2d)
2695	CALL histwrite(nid_mth,"phis",i,zx_tmp_2d,iim*jjmp1,ndex2d)
2696	C
2697	i = NINT(zout/zsto)
2698	CALL gr_fi_ecrit(1,klon,iim,jjmp1,paire,zx_tmp_2d)
2699	CALL histwrite(nid_mth,"aire",i,zx_tmp_2d,iim*jjmp1,ndex2d)
2700
2701	CALL gr_fi_ecrit(1, klon,iim,jjmp1, zxtsol,zx_tmp_2d)
2702	CALL histwrite(nid_mth,"tsol",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2703	c
2704	DO i = 1, klon
2705	zx_tmp_fi2d(i) = paprs(i,1)
2706	ENDDO
2707	CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d,zx_tmp_2d)
2708	CALL histwrite(nid_mth,"psol",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2709	c
2710	CALL gr_fi_ecrit(1, klon,iim,jjmp1, zxqsol,zx_tmp_2d)
2711	CALL histwrite(nid_mth,"qsol",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2712	c
2713	DO i = 1, klon
2714	zx_tmp_fi2d(i) = rain_fall(i) + snow_fall(i)
2715	ENDDO
2716	CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d,zx_tmp_2d)
2717	CALL histwrite(nid_mth,"rain",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2718	c
2719	DO i = 1, klon
2720	zx_tmp_fi2d(i) = rain_lsc(i) + snow_lsc(i)
2721	ENDDO
2722	CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d,zx_tmp_2d)
2723	CALL histwrite(nid_mth,"plul",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2724	c
2725	DO i = 1, klon
2726	zx_tmp_fi2d(i) = rain_con(i) + snow_con(i)
2727	ENDDO
2728	CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d,zx_tmp_2d)
2729	CALL histwrite(nid_mth,"pluc",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2730	c
2731	CALL gr_fi_ecrit(1, klon,iim,jjmp1, snow_fall,zx_tmp_2d)
2732	CALL histwrite(nid_mth,"snow",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2733	c
2734	CALL gr_fi_ecrit(1, klon,iim,jjmp1, zxsnow,zx_tmp_2d)
2735	CALL histwrite(nid_mth,"snow_cov",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2736	c
2737	CALL gr_fi_ecrit(1, klon,iim,jjmp1, evap,zx_tmp_2d)
2738	CALL histwrite(nid_mth,"evap",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2739	c
2740	CALL gr_fi_ecrit(1, klon,iim,jjmp1, topsw,zx_tmp_2d)
2741	CALL histwrite(nid_mth,"tops",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2742	c
2743	CALL gr_fi_ecrit(1, klon,iim,jjmp1, toplw,zx_tmp_2d)
2744	CALL histwrite(nid_mth,"topl",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2745	c
2746	CALL gr_fi_ecrit(1, klon,iim,jjmp1, solsw,zx_tmp_2d)
2747	CALL histwrite(nid_mth,"sols",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2748	c
2749	CALL gr_fi_ecrit(1, klon,iim,jjmp1, sollw,zx_tmp_2d)
2750	CALL histwrite(nid_mth,"soll",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2751	c
2752	CALL gr_fi_ecrit(1, klon,iim,jjmp1, sollwdown,zx_tmp_2d)
2753	CALL histwrite(nid_mth,"solldown",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2754	c
2755	CALL gr_fi_ecrit(1, klon,iim,jjmp1, topsw0,zx_tmp_2d)
2756	CALL histwrite(nid_mth,"tops0",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2757	c
2758	CALL gr_fi_ecrit(1, klon,iim,jjmp1, toplw0,zx_tmp_2d)
2759	CALL histwrite(nid_mth,"topl0",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2760	c
2761	CALL gr_fi_ecrit(1, klon,iim,jjmp1, solsw0,zx_tmp_2d)
2762	CALL histwrite(nid_mth,"sols0",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2763	c
2764	CALL gr_fi_ecrit(1, klon,iim,jjmp1, sollw0,zx_tmp_2d)
2765	CALL histwrite(nid_mth,"soll0",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2766	c
2767	CALL gr_fi_ecrit(1, klon,iim,jjmp1, bils,zx_tmp_2d)
2768	CALL histwrite(nid_mth,"bils",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2769	c
2770	CALL gr_fi_ecrit(1, klon,iim,jjmp1, sens,zx_tmp_2d)
2771	CALL histwrite(nid_mth,"sens",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2772	c
2773	CALL gr_fi_ecrit(1, klon,iim,jjmp1, fder,zx_tmp_2d)
2774	CALL histwrite(nid_mth,"fder",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2775	c
2776	c
2777	c DO i = 1, klon
2778	c zx_tmp_fi2d(i) = fluxu(i,1)
2779	c ENDDO
2780	c CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d,zx_tmp_2d)
2781	c CALL histwrite(nid_mth,"frtu",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2782	c
2783	c DO i = 1, klon
2784	c zx_tmp_fi2d(i) = fluxv(i,1)
2785	c ENDDO
2786	c CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d,zx_tmp_2d)
2787	c CALL histwrite(nid_mth,"frtv",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2788	c
2789	DO nsrf = 1, nbsrf
2790	C§§§
2791	zx_tmp_fi2d(1 : klon) = pctsrf( 1 : klon, nsrf)
2792	CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d , zx_tmp_2d)
2793	CALL histwrite(nid_mth,"pourc_"//clnsurf(nsrf),itap,
2794	$ zx_tmp_2d,iim*jjmp1,ndex2d)
2795	C
2796	zx_tmp_fi2d(1 : klon) = ftsol( 1 : klon, nsrf)
2797	CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d , zx_tmp_2d)
2798	CALL histwrite(nid_mth,"tsol_"//clnsurf(nsrf),itap,
2799	$ zx_tmp_2d,iim*jjmp1,ndex2d)
2800	C
2801	zx_tmp_fi2d(1 : klon) = fluxt( 1 : klon, 1, nsrf)
2802	CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d , zx_tmp_2d)
2803	CALL histwrite(nid_mth,"sens_"//clnsurf(nsrf),itap,
2804	$ zx_tmp_2d,iim*jjmp1,ndex2d)
2805	C
2806	zx_tmp_fi2d(1 : klon) = fluxlat( 1 : klon, nsrf)
2807	CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d , zx_tmp_2d)
2808	CALL histwrite(nid_mth,"lat_"//clnsurf(nsrf),itap,
2809	$ zx_tmp_2d,iim*jjmp1,ndex2d)
2810	C
2811	zx_tmp_fi2d(1 : klon) = fluxu( 1 : klon, 1, nsrf)
2812	CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d , zx_tmp_2d)
2813	CALL histwrite(nid_mth,"taux_"//clnsurf(nsrf),itap,
2814	$ zx_tmp_2d,iim*jjmp1,ndex2d)
2815	C
2816	zx_tmp_fi2d(1 : klon) = fluxv( 1 : klon, 1, nsrf)
2817	CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d , zx_tmp_2d)
2818	CALL histwrite(nid_mth,"tauy_"//clnsurf(nsrf),itap,
2819	$ zx_tmp_2d,iim*jjmp1,ndex2d)
2820	C
2821	zx_tmp_fi2d(1 : klon) = falbe( 1 : klon, nsrf)
2822	CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d , zx_tmp_2d)
2823	CALL histwrite(nid_mth,"albe_"//clnsurf(nsrf),itap,
2824	$ zx_tmp_2d,iim*jjmp1,ndex2d)
2825	C
2826	zx_tmp_fi2d(1 : klon) = frugs( 1 : klon, nsrf)
2827	CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d , zx_tmp_2d)
2828	CALL histwrite(nid_mth,"rugs_"//clnsurf(nsrf),itap,
2829	$ zx_tmp_2d,iim*jjmp1,ndex2d)
2830	c
2831	zx_tmp_fi2d(1 : klon) = agesno( 1 : klon, nsrf)
2832	CALL gr_fi_ecrit(1, klon,iim,jjmp1, agesno,zx_tmp_2d)
2833	CALL histwrite(nid_mth,"ages_"//clnsurf(nsrf),itap
2834	$ ,zx_tmp_2d,iim*jjmp1,ndex2d)
2835
2836	END DO
2837	c$$$ DO i = 1, klon
2838	c$$$ zx_tmp_fi2d(i) = pctsrf(i,is_sic)
2839	c$$$ ENDDO
2840	c$$$ CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d,zx_tmp_2d)
2841	c$$$ CALL histwrite(nid_mth,"sicf",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2842	c
2843	CALL gr_fi_ecrit(1, klon,iim,jjmp1, albsol,zx_tmp_2d)
2844	CALL histwrite(nid_mth,"albs",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2845	CALL gr_fi_ecrit(1, klon,iim,jjmp1, albsollw,zx_tmp_2d)
2846	CALL histwrite(nid_mth,"albslw",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2847	c
2848	CALL gr_fi_ecrit(1, klon,iim,jjmp1, cdragm,zx_tmp_2d)
2849	CALL histwrite(nid_mth,"cdrm",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2850	c
2851	CALL gr_fi_ecrit(1, klon,iim,jjmp1, cdragh,zx_tmp_2d)
2852	CALL histwrite(nid_mth,"cdrh",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2853	c
2854	CALL gr_fi_ecrit(1, klon,iim,jjmp1, cldl,zx_tmp_2d)
2855	CALL histwrite(nid_mth,"cldl",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2856	c
2857	CALL gr_fi_ecrit(1, klon,iim,jjmp1, cldm,zx_tmp_2d)
2858	CALL histwrite(nid_mth,"cldm",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2859	c
2860	CALL gr_fi_ecrit(1, klon,iim,jjmp1, cldh,zx_tmp_2d)
2861	CALL histwrite(nid_mth,"cldh",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2862	c
2863	CALL gr_fi_ecrit(1, klon,iim,jjmp1, cldt,zx_tmp_2d)
2864	CALL histwrite(nid_mth,"cldt",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2865	c
2866	CALL gr_fi_ecrit(1, klon,iim,jjmp1, cldq,zx_tmp_2d)
2867	CALL histwrite(nid_mth,"cldq",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2868	c
2869	CALL gr_fi_ecrit(1, klon,iim,jjmp1, ue,zx_tmp_2d)
2870	CALL histwrite(nid_mth,"ue",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2871	c
2872	CALL gr_fi_ecrit(1, klon,iim,jjmp1, ve,zx_tmp_2d)
2873	CALL histwrite(nid_mth,"ve",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2874	c
2875	CALL gr_fi_ecrit(1, klon,iim,jjmp1, uq,zx_tmp_2d)
2876	CALL histwrite(nid_mth,"uq",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2877	c
2878	CALL gr_fi_ecrit(1, klon,iim,jjmp1, vq,zx_tmp_2d)
2879	CALL histwrite(nid_mth,"vq",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2880	cKE43
2881	IF (iflag_con .GE. 3) THEN ! sb
2882	c
2883	CALL gr_fi_ecrit(1, klon,iim,jjmp1, cape,zx_tmp_2d)
2884	CALL histwrite(nid_mth,"cape",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2885	c
2886	CALL gr_fi_ecrit(1, klon,iim,jjmp1,pbase,zx_tmp_2d)
2887	CALL histwrite(nid_mth,"pbase",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2888	c
2889	CALL gr_fi_ecrit(1, klon,iim,jjmp1,ema_pct,zx_tmp_2d)
2890	CALL histwrite(nid_mth,"ptop",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2891	c
2892	CALL gr_fi_ecrit(1, klon,iim,jjmp1,ema_cbmf,zx_tmp_2d)
2893	CALL histwrite(nid_mth,"fbase",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2894	c
2895	c
2896	ENDIF
2897	c34EK
2898	c
2899	c Champs 3D:
2900	C
2901	CALL gr_fi_ecrit(klev,klon,iim,jjmp1, t_seri, zx_tmp_3d)
2902	CALL histwrite(nid_mth,"temp",itap,zx_tmp_3d,
2903	. iimjjmp1klev,ndex3d)
2904	c
2905	CALL gr_fi_ecrit(klev,klon,iim,jjmp1, qx(1,1,ivap), zx_tmp_3d)
2906	CALL histwrite(nid_mth,"ovap",itap,zx_tmp_3d,
2907	. iimjjmp1klev,ndex3d)
2908	c
2909	CALL gr_fi_ecrit(klev,klon,iim,jjmp1, zphi, zx_tmp_3d)
2910	CALL histwrite(nid_mth,"geop",itap,zx_tmp_3d,
2911	. iimjjmp1klev,ndex3d)
2912	c
2913	CALL gr_fi_ecrit(klev,klon,iim,jjmp1, u_seri, zx_tmp_3d)
2914	CALL histwrite(nid_mth,"vitu",itap,zx_tmp_3d,
2915	. iimjjmp1klev,ndex3d)
2916	c
2917	CALL gr_fi_ecrit(klev,klon,iim,jjmp1, v_seri, zx_tmp_3d)
2918	CALL histwrite(nid_mth,"vitv",itap,zx_tmp_3d,
2919	. iimjjmp1klev,ndex3d)
2920	c
2921	CALL gr_fi_ecrit(klev,klon,iim,jjmp1, omega, zx_tmp_3d)
2922	CALL histwrite(nid_mth,"vitw",itap,zx_tmp_3d,
2923	. iimjjmp1klev,ndex3d)
2924	c
2925	CALL gr_fi_ecrit(klev,klon,iim,jjmp1, pplay, zx_tmp_3d)
2926	CALL histwrite(nid_mth,"pres",itap,zx_tmp_3d,
2927	. iimjjmp1klev,ndex3d)
2928	c
2929	CALL gr_fi_ecrit(klev,klon,iim,jjmp1, cldfra, zx_tmp_3d)
2930	CALL histwrite(nid_mth,"rneb",itap,zx_tmp_3d,
2931	. iimjjmp1klev,ndex3d)
2932	c
2933	CALL gr_fi_ecrit(klev,klon,iim,jjmp1, zx_rh, zx_tmp_3d)
2934	CALL histwrite(nid_mth,"rhum",itap,zx_tmp_3d,
2935	. iimjjmp1klev,ndex3d)
2936	c
2937	CALL gr_fi_ecrit(klev,klon,iim,jjmp1, cldliq, zx_tmp_3d)
2938	CALL histwrite(nid_mth,"oliq",itap,zx_tmp_3d,
2939	. iimjjmp1klev,ndex3d)
2940	c
2941	CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_t_dyn, zx_tmp_3d)
2942	CALL histwrite(nid_mth,"dtdyn",itap,zx_tmp_3d,
2943	. iimjjmp1klev,ndex3d)
2944	c
2945	CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_q_dyn, zx_tmp_3d)
2946	CALL histwrite(nid_mth,"dqdyn",itap,zx_tmp_3d,
2947	. iimjjmp1klev,ndex3d)
2948	c
2949	CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_t_con, zx_tmp_3d)
2950	CALL histwrite(nid_mth,"dtcon",itap,zx_tmp_3d,
2951	. iimjjmp1klev,ndex3d)
2952	c
2953	CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_q_con, zx_tmp_3d)
2954	CALL histwrite(nid_mth,"dqcon",itap,zx_tmp_3d,
2955	. iimjjmp1klev,ndex3d)
2956	c
2957	CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_t_lsc, zx_tmp_3d)
2958	CALL histwrite(nid_mth,"dtlsc",itap,zx_tmp_3d,
2959	. iimjjmp1klev,ndex3d)
2960	c
2961	CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_q_lsc, zx_tmp_3d)
2962	CALL histwrite(nid_mth,"dqlsc",itap,zx_tmp_3d,
2963	. iimjjmp1klev,ndex3d)
2964	c
2965	CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_t_vdf, zx_tmp_3d)
2966	CALL histwrite(nid_mth,"dtvdf",itap,zx_tmp_3d,
2967	. iimjjmp1klev,ndex3d)
2968	c
2969	CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_q_vdf, zx_tmp_3d)
2970	CALL histwrite(nid_mth,"dqvdf",itap,zx_tmp_3d,
2971	. iimjjmp1klev,ndex3d)
2972	c
2973	CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_t_eva, zx_tmp_3d)
2974	CALL histwrite(nid_mth,"dteva",itap,zx_tmp_3d,
2975	. iimjjmp1klev,ndex3d)
2976	c
2977	CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_q_eva, zx_tmp_3d)
2978	CALL histwrite(nid_mth,"dqeva",itap,zx_tmp_3d,
2979	. iimjjmp1klev,ndex3d)
2980	c
2981	CALL gr_fi_ecrit(klev,klon,iim,jjmp1, zpt_conv, zx_tmp_3d)
2982	CALL histwrite(nid_mth,"ptconv",itap,zx_tmp_3d,
2983	. iim(jjmp1)klev,ndex3d)
2984	c
2985	CALL gr_fi_ecrit(klev,klon,iim,jjmp1, ratqs, zx_tmp_3d)
2986	CALL histwrite(nid_mth,"ratqs",itap,zx_tmp_3d,
2987	. iim(jjmp1)klev,ndex3d)
2988	c
2989	CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_t_ajs, zx_tmp_3d)
2990	CALL histwrite(nid_mth,"dtajs",itap,zx_tmp_3d,
2991	. iimjjmp1klev,ndex3d)
2992	c
2993	CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_q_ajs, zx_tmp_3d)
2994	CALL histwrite(nid_mth,"dqajs",itap,zx_tmp_3d,
2995	. iimjjmp1klev,ndex3d)
2996	c
2997	CALL gr_fi_ecrit(klev,klon,iim,jjmp1, heat, zx_tmp_3d)
2998	CALL histwrite(nid_mth,"dtswr",itap,zx_tmp_3d,
2999	. iimjjmp1klev,ndex3d)
3000	c
3001	CALL gr_fi_ecrit(klev,klon,iim,jjmp1, heat0, zx_tmp_3d)
3002	CALL histwrite(nid_mth,"dtsw0",itap,zx_tmp_3d,
3003	. iimjjmp1klev,ndex3d)
3004	c
3005	CALL gr_fi_ecrit(klev,klon,iim,jjmp1, cool, zx_tmp_3d)
3006	CALL histwrite(nid_mth,"dtlwr",itap,zx_tmp_3d,
3007	. iimjjmp1klev,ndex3d)
3008	c
3009	CALL gr_fi_ecrit(klev,klon,iim,jjmp1, cool0, zx_tmp_3d)
3010	CALL histwrite(nid_mth,"dtlw0",itap,zx_tmp_3d,
3011	. iimjjmp1klev,ndex3d)
3012	c
3013	CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_u_vdf, zx_tmp_3d)
3014	CALL histwrite(nid_mth,"duvdf",itap,zx_tmp_3d,
3015	. iimjjmp1klev,ndex3d)
3016	c
3017	CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_v_vdf, zx_tmp_3d)
3018	CALL histwrite(nid_mth,"dvvdf",itap,zx_tmp_3d,
3019	. iimjjmp1klev,ndex3d)
3020	c
3021	IF (ok_orodr) THEN
3022	CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_u_oro, zx_tmp_3d)
3023	CALL histwrite(nid_mth,"duoro",itap,zx_tmp_3d,
3024	. iimjjmp1klev,ndex3d)
3025	c
3026	CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_v_oro, zx_tmp_3d)
3027	CALL histwrite(nid_mth,"dvoro",itap,zx_tmp_3d,
3028	. iimjjmp1klev,ndex3d)
3029	c
3030	ENDIF
3031	C
3032	IF (ok_orolf) THEN
3033	CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_u_lif, zx_tmp_3d)
3034	CALL histwrite(nid_mth,"dulif",itap,zx_tmp_3d,
3035	. iimjjmp1klev,ndex3d)
3036	c
3037	CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_v_lif, zx_tmp_3d)
3038	CALL histwrite(nid_mth,"dvlif",itap,zx_tmp_3d,
3039	. iimjjmp1klev,ndex3d)
3040	ENDIF
3041	C
3042	CALL gr_fi_ecrit(klev,klon,iim,jjmp1, wo, zx_tmp_3d)
3043	CALL histwrite(nid_mth,"ozone",itap,zx_tmp_3d,
3044	. iimjjmp1klev,ndex3d)
3045	c
3046	IF (nqmax.GE.3) THEN
3047	DO iq=1,nqmax-2
3048	IF (iq.LE.99) THEN
3049	CALL gr_fi_ecrit(klev,klon,iim,jjmp1, qx(1,1,iq+2), zx_tmp_3d)
3050	WRITE(str2,'(i2.2)') iq
3051	CALL histwrite(nid_mth,"trac"//str2,itap,zx_tmp_3d,
3052	. iimjjmp1klev,ndex3d)
3053	ELSE
3054	PRINT*, "Trop de traceurs"
3055	CALL abort
3056	ENDIF
3057	ENDDO
3058	ENDIF
3059	cKE43
3060	IF (iflag_con.GE.3) THEN ! (sb)
3061	c
3062	CALL gr_fi_ecrit(klev,klon,iim,jjmp1, upwd, zx_tmp_3d)
3063	CALL histwrite(nid_mth,"upwd",itap,zx_tmp_3d,
3064	. iimjjmp1klev,ndex3d)
3065	c
3066	CALL gr_fi_ecrit(klev,klon,iim,jjmp1, dnwd, zx_tmp_3d)
3067	CALL histwrite(nid_mth,"dnwd",itap,zx_tmp_3d,
3068	. iimjjmp1klev,ndex3d)
3069	c
3070	CALL gr_fi_ecrit(klev,klon,iim,jjmp1, dnwd0, zx_tmp_3d)
3071	CALL histwrite(nid_mth,"dnwd0",itap,zx_tmp_3d,
3072	. iimjjmp1klev,ndex3d)
3073	c
3074	CALL gr_fi_ecrit(klev,klon,iim,jjmp1, Ma, zx_tmp_3d)
3075	CALL histwrite(nid_mth,"Ma",itap,zx_tmp_3d,
3076	. iimjjmp1klev,ndex3d)
3077	c
3078	c
3079	ENDIF
3080	c34EK
3081	c
3082	if (ok_sync) then
3083	call histsync(nid_mth)
3084	endif
3085	ENDIF
3086	c
3087	IF (ok_instan) THEN
3088	c
3089	ndex2d = 0
3090	ndex3d = 0
3091	c
3092	c Champs 2D:
3093	c
3094	zsto = dtime * ecrit_ins
3095	zout = dtime * ecrit_ins
3096
3097	i = NINT(zout/zsto)
3098	CALL gr_fi_ecrit(1,klon,iim,jjmp1,pphis,zx_tmp_2d)
3099	CALL histwrite(nid_ins,"phis",i,zx_tmp_2d,iim*jjmp1,ndex2d)
3100	c
3101	i = NINT(zout/zsto)
3102	CALL gr_fi_ecrit(1,klon,iim,jjmp1,paire,zx_tmp_2d)
3103	CALL histwrite(nid_ins,"aire",i,zx_tmp_2d,iim*jjmp1,ndex2d)
3104
3105	DO i = 1, klon
3106	zx_tmp_fi2d(i) = paprs(i,1)
3107	ENDDO
3108	CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d,zx_tmp_2d)
3109	CALL histwrite(nid_ins,"psol",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
3110	c
3111	DO i = 1, klon
3112	zx_tmp_fi2d(i) = rain_fall(i) + snow_fall(i)
3113	ENDDO
3114	CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d,zx_tmp_2d)
3115	CALL histwrite(nid_ins,"rain",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
3116	c
3117	DO i = 1, klon
3118	zx_tmp_fi2d(i) = rain_lsc(i) + snow_lsc(i)
3119	ENDDO
3120	CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d,zx_tmp_2d)
3121	CALL histwrite(nid_ins,"plul",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
3122	c
3123	DO i = 1, klon
3124	zx_tmp_fi2d(i) = rain_con(i) + snow_con(i)
3125	ENDDO
3126	CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d,zx_tmp_2d)
3127	CALL histwrite(nid_ins,"pluc",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
3128
3129	CALL gr_fi_ecrit(1, klon,iim,jjmp1, zxtsol,zx_tmp_2d)
3130	CALL histwrite(nid_ins,"tsol",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
3131	c
3132	CALL gr_fi_ecrit(1, klon,iim,jjmp1, snow_fall,zx_tmp_2d)
3133	CALL histwrite(nid_ins,"snow",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
3134
3135	c
3136	CALL gr_fi_ecrit(1, klon,iim,jjmp1, toplw,zx_tmp_2d)
3137	CALL histwrite(nid_ins,"topl",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
3138	c
3139	CALL gr_fi_ecrit(1, klon,iim,jjmp1, evap,zx_tmp_2d)
3140	CALL histwrite(nid_ins,"evap",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
3141	c
3142	CALL gr_fi_ecrit(1, klon,iim,jjmp1, solsw,zx_tmp_2d)
3143	CALL histwrite(nid_ins,"sols",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
3144	c
3145	CALL gr_fi_ecrit(1, klon,iim,jjmp1, sollw,zx_tmp_2d)
3146	CALL histwrite(nid_ins,"soll",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
3147	c
3148	CALL gr_fi_ecrit(1, klon,iim,jjmp1, sollwdown,zx_tmp_2d)
3149	CALL histwrite(nid_ins,"solldown",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
3150	c
3151	CALL gr_fi_ecrit(1, klon,iim,jjmp1, bils,zx_tmp_2d)
3152	CALL histwrite(nid_ins,"bils",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
3153	c
3154	CALL gr_fi_ecrit(1, klon,iim,jjmp1, sens,zx_tmp_2d)
3155	CALL histwrite(nid_ins,"sens",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
3156	c
3157	CALL gr_fi_ecrit(1, klon,iim,jjmp1, fder,zx_tmp_2d)
3158	CALL histwrite(nid_ins,"fder",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
3159	c
3160	CALL gr_fi_ecrit(1, klon,iim,jjmp1, d_ts(1,is_oce),zx_tmp_2d)
3161	CALL histwrite(nid_ins,"dtsvdfo",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
3162	c
3163	CALL gr_fi_ecrit(1, klon,iim,jjmp1, d_ts(1,is_ter),zx_tmp_2d)
3164	CALL histwrite(nid_ins,"dtsvdft",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
3165	c
3166	CALL gr_fi_ecrit(1, klon,iim,jjmp1, d_ts(1,is_lic),zx_tmp_2d)
3167	CALL histwrite(nid_ins,"dtsvdfg",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
3168	c
3169	CALL gr_fi_ecrit(1, klon,iim,jjmp1, d_ts(1,is_sic),zx_tmp_2d)
3170	CALL histwrite(nid_ins,"dtsvdfi",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
3171
3172	DO nsrf = 1, nbsrf
3173	C§§§
3174	zx_tmp_fi2d(1 : klon) = pctsrf( 1 : klon, nsrf)
3175	CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d , zx_tmp_2d)
3176	CALL histwrite(nid_ins,"pourc_"//clnsurf(nsrf),itap,
3177	$ zx_tmp_2d,iim*jjmp1,ndex2d)
3178	C
3179	zx_tmp_fi2d(1 : klon) = fluxt( 1 : klon, 1, nsrf)
3180	CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d , zx_tmp_2d)
3181	CALL histwrite(nid_ins,"sens_"//clnsurf(nsrf),itap,
3182	$ zx_tmp_2d,iim*jjmp1,ndex2d)
3183	C
3184	zx_tmp_fi2d(1 : klon) = fluxlat( 1 : klon, nsrf)
3185	CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d , zx_tmp_2d)
3186	CALL histwrite(nid_ins,"lat_"//clnsurf(nsrf),itap,
3187	$ zx_tmp_2d,iim*jjmp1,ndex2d)
3188	C
3189	zx_tmp_fi2d(1 : klon) = ftsol( 1 : klon, nsrf)
3190	CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d , zx_tmp_2d)
3191	CALL histwrite(nid_ins,"tsol_"//clnsurf(nsrf),itap,
3192	$ zx_tmp_2d,iim*jjmp1,ndex2d)
3193	C
3194	zx_tmp_fi2d(1 : klon) = fluxu( 1 : klon, 1, nsrf)
3195	CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d , zx_tmp_2d)
3196	CALL histwrite(nid_ins,"taux_"//clnsurf(nsrf),itap,
3197	$ zx_tmp_2d,iim*jjmp1,ndex2d)
3198	C
3199	zx_tmp_fi2d(1 : klon) = fluxv( 1 : klon, 1, nsrf)
3200	CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d , zx_tmp_2d)
3201	CALL histwrite(nid_ins,"tauy_"//clnsurf(nsrf),itap,
3202	$ zx_tmp_2d,iim*jjmp1,ndex2d)
3203	C
3204	zx_tmp_fi2d(1 : klon) = frugs( 1 : klon, nsrf)
3205	CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d , zx_tmp_2d)
3206	CALL histwrite(nid_ins,"rugs_"//clnsurf(nsrf),itap,
3207	$ zx_tmp_2d,iim*jjmp1,ndex2d)
3208	C
3209	zx_tmp_fi2d(1 : klon) = falbe( 1 : klon, nsrf)
3210	CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d , zx_tmp_2d)
3211	CALL histwrite(nid_ins,"albe_"//clnsurf(nsrf),itap,
3212	$ zx_tmp_2d,iim*jjmp1,ndex2d)
3213	C
3214	END DO
3215	CALL gr_fi_ecrit(1, klon,iim,jjmp1, albsol,zx_tmp_2d)
3216	CALL histwrite(nid_ins,"albs",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
3217	CALL gr_fi_ecrit(1, klon,iim,jjmp1, albsollw,zx_tmp_2d)
3218	CALL histwrite(nid_ins,"albslw",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
3219	c
3220	CALL gr_fi_ecrit(1, klon,iim,jjmp1, zxsnow,zx_tmp_2d)
3221	CALL histwrite(nid_ins,"snow_cov",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
3222	c
3223	CALL gr_fi_ecrit(1, klon,iim,jjmp1, zxrugs,zx_tmp_2d)
3224	CALL histwrite(nid_ins,"rugs",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
3225	c
3226	c Champs 3D:
3227	c
3228	CALL gr_fi_ecrit(klev,klon,iim,jjmp1, t_seri, zx_tmp_3d)
3229	CALL histwrite(nid_ins,"temp",itap,zx_tmp_3d,
3230	. iimjjmp1klev,ndex3d)
3231	c
3232	CALL gr_fi_ecrit(klev,klon,iim,jjmp1, u_seri, zx_tmp_3d)
3233	CALL histwrite(nid_ins,"vitu",itap,zx_tmp_3d,
3234	. iimjjmp1klev,ndex3d)
3235	c
3236	CALL gr_fi_ecrit(klev,klon,iim,jjmp1, v_seri, zx_tmp_3d)
3237	CALL histwrite(nid_ins,"vitv",itap,zx_tmp_3d,
3238	. iimjjmp1klev,ndex3d)
3239	c
3240	CALL gr_fi_ecrit(klev,klon,iim,jjmp1, zphi, zx_tmp_3d)
3241	CALL histwrite(nid_ins,"geop",itap,zx_tmp_3d,
3242	. iimjjmp1klev,ndex3d)
3243	c
3244	CALL gr_fi_ecrit(klev,klon,iim,jjmp1, pplay, zx_tmp_3d)
3245	CALL histwrite(nid_ins,"pres",itap,zx_tmp_3d,
3246	. iimjjmp1klev,ndex3d)
3247	c
3248	CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_t_vdf, zx_tmp_3d)
3249	CALL histwrite(nid_ins,"dtvdf",itap,zx_tmp_3d,
3250	. iimjjmp1klev,ndex3d)
3251	c
3252	CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_q_vdf, zx_tmp_3d)
3253	CALL histwrite(nid_ins,"dqvdf",itap,zx_tmp_3d,
3254	. iimjjmp1klev,ndex3d)
3255
3256	c
3257	if (ok_sync) then
3258	call histsync(nid_ins)
3259	endif
3260	ENDIF
3261	c
3262	c
3263	c Ecrire la bande regionale (binaire grads)
3264	IF (ok_region .AND. mod(itap,ecrit_reg).eq.0) THEN
3265	CALL ecriregs(84,zxtsol)
3266	CALL ecriregs(84,paprs(1,1))
3267	CALL ecriregs(84,topsw)
3268	CALL ecriregs(84,toplw)
3269	CALL ecriregs(84,solsw)
3270	CALL ecriregs(84,sollw)
3271	CALL ecriregs(84,rain_fall)
3272	CALL ecriregs(84,snow_fall)
3273	CALL ecriregs(84,evap)
3274	CALL ecriregs(84,sens)
3275	CALL ecriregs(84,bils)
3276	CALL ecriregs(84,pctsrf(1,is_sic))
3277	CALL ecriregs(84,zxfluxu(1,1))
3278	CALL ecriregs(84,zxfluxv(1,1))
3279	CALL ecriregs(84,ue)
3280	CALL ecriregs(84,ve)
3281	CALL ecriregs(84,uq)
3282	CALL ecriregs(84,vq)
3283	c
3284	CALL ecrirega(84,u_seri)
3285	CALL ecrirega(84,v_seri)
3286	CALL ecrirega(84,omega)
3287	CALL ecrirega(84,t_seri)
3288	CALL ecrirega(84,zphi)
3289	CALL ecrirega(84,q_seri)
3290	CALL ecrirega(84,cldfra)
3291	CALL ecrirega(84,cldliq)
3292	CALL ecrirega(84,pplay)
3293
3294
3295	cc CALL ecrirega(84,d_t_dyn)
3296	cc CALL ecrirega(84,d_q_dyn)
3297	cc CALL ecrirega(84,heat)
3298	cc CALL ecrirega(84,cool)
3299	cc CALL ecrirega(84,d_t_con)
3300	cc CALL ecrirega(84,d_q_con)
3301	cc CALL ecrirega(84,d_t_lsc)
3302	cc CALL ecrirega(84,d_q_lsc)
3303	ENDIF
3304	c
3305	c Convertir les incrementations en tendances
3306	c
3307	DO k = 1, klev
3308	DO i = 1, klon
3309	d_u(i,k) = ( u_seri(i,k) - u(i,k) ) / dtime
3310	d_v(i,k) = ( v_seri(i,k) - v(i,k) ) / dtime
3311	d_t(i,k) = ( t_seri(i,k)-t(i,k) ) / dtime
3312	d_qx(i,k,ivap) = ( q_seri(i,k) - qx(i,k,ivap) ) / dtime
3313	d_qx(i,k,iliq) = ( ql_seri(i,k) - qx(i,k,iliq) ) / dtime
3314	ENDDO
3315	ENDDO
3316	c
3317	IF (nqmax.GE.3) THEN
3318	DO iq = 3, nqmax
3319	DO k = 1, klev
3320	DO i = 1, klon
3321	d_qx(i,k,iq) = ( tr_seri(i,k,iq-2) - qx(i,k,iq) ) / dtime
3322	ENDDO
3323	ENDDO
3324	ENDDO
3325	ENDIF
3326	c
3327	c Sauvegarder les valeurs de t et q a la fin de la physique:
3328	c
3329	DO k = 1, klev
3330	DO i = 1, klon
3331	t_ancien(i,k) = t_seri(i,k)
3332	q_ancien(i,k) = q_seri(i,k)
3333	ENDDO
3334	ENDDO
3335	c
3336	c====================================================================
3337	c Si c'est la fin, il faut conserver l'etat de redemarrage
3338	c====================================================================
3339	c
3340	IF (lafin) THEN
3341	ccc IF (ok_oasis) CALL quitcpl
3342	CALL phyredem ("restartphy.nc",dtime,radpas,co2_ppm,solaire,
3343	. rlat, rlon, pctsrf, ftsol, ftsoil, deltat, fqsol, fsnow,
3344	. falbe, fevap, rain_fall, snow_fall,
3345	. solsw, sollwdown,dlw,
3346	. radsol,frugs,agesno,
3347	. zmea,zstd,zsig,zgam,zthe,zpic,zval,rugoro,
3348	. t_ancien, q_ancien)
3349	ENDIF
3350
3351	RETURN
3352	END
3353	FUNCTION qcheck(klon,klev,paprs,q,ql,aire)
3354	IMPLICIT none
3355	c
3356	c Calculer et imprimer l'eau totale. A utiliser pour verifier
3357	c la conservation de l'eau
3358	c
3359	#include "YOMCST.h"
3360	INTEGER klon,klev
3361	REAL paprs(klon,klev+1), q(klon,klev), ql(klon,klev)
3362	REAL aire(klon)
3363	REAL qtotal, zx, qcheck
3364	INTEGER i, k
3365	c
3366	zx = 0.0
3367	DO i = 1, klon
3368	zx = zx + aire(i)
3369	ENDDO
3370	qtotal = 0.0
3371	DO k = 1, klev
3372	DO i = 1, klon
3373	qtotal = qtotal + (q(i,k)+ql(i,k)) * aire(i)
3374	. *(paprs(i,k)-paprs(i,k+1))/RG
3375	ENDDO
3376	ENDDO
3377	c
3378	qcheck = qtotal/zx
3379	c
3380	RETURN
3381	END
3382	SUBROUTINE gr_fi_ecrit(nfield,nlon,iim,jjmp1,fi,ecrit)
3383	IMPLICIT none
3384	c
3385	c Tranformer une variable de la grille physique a
3386	c la grille d'ecriture
3387	c
3388	INTEGER nfield,nlon,iim,jjmp1, jjm
3389	REAL fi(nlon,nfield), ecrit(iim*jjmp1,nfield)
3390	c
3391	INTEGER i, n, ig
3392	c
3393	jjm = jjmp1 - 1
3394	DO n = 1, nfield
3395	DO i=1,iim
3396	ecrit(i,n) = fi(1,n)
3397	ecrit(i+jjm*iim,n) = fi(nlon,n)
3398	ENDDO
3399	DO ig = 1, nlon - 2
3400	ecrit(iim+ig,n) = fi(1+ig,n)
3401	ENDDO
3402	ENDDO
3403	RETURN
3404	END
3405

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

Download in other formats:

Original Format