Context Navigation

physiq.F @ 287

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

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

Download in other formats:

Original Format