Context Navigation

physiq.F @ 295

Last change on this file since 295 was 295, checked in by lmdzadmin, 23 years ago
Tag version 0 qui marche en couple/force LF
Property svn:eol-style set to `native` Property svn:executable set to ``* Property svn:keywords set to `Author Date Id Revision`
File size: 120.1 KB

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

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

Download in other formats:

Original Format