Context Navigation

physiq.F @ 301

Last change on this file since 301 was 301, checked in by lmdzadmin, 23 years ago
Correction bug pour KE vectorise FH, JYG LF
Property svn:eol-style set to `native` Property svn:executable set to ``* Property svn:keywords set to `Author Date Id Revision`
File size: 119.2 KB

Line
1	c
2	c $Header$
3	c
4	SUBROUTINE physiq (nlon,nlev,nqmax ,
5	. debut,lafin,rjourvrai,rjour_ecri,gmtime,pdtphys,
6	. paprs,pplay,pphi,pphis,paire,presnivs,clesphy0,
7	. u,v,t,qx,
8	. omega, cufi, cvfi,
9	. d_u, d_v, d_t, d_qx, d_ps)
10	USE ioipsl
11	USE histcom
12	USE writephys
13
14	IMPLICIT none
15	c======================================================================
16	c
17	c Auteur(s) Z.X. Li (LMD/CNRS) date: 19930818
18	c
19	c Objet: Moniteur general de la physique du modele
20	cAA Modifications quant aux traceurs :
21	cAA - uniformisation des parametrisations ds phytrac
22	cAA - stockage des moyennes des champs necessaires
23	cAA en mode traceur off-line
24	c======================================================================
25	c modif ( P. Le Van , 12/10/98 )
26	c
27	c Arguments:
28	c
29	c nlon----input-I-nombre de points horizontaux
30	c nlev----input-I-nombre de couches verticales
31	c nqmax---input-I-nombre de traceurs (y compris vapeur d'eau) = 1
32	c debut---input-L-variable logique indiquant le premier passage
33	c lafin---input-L-variable logique indiquant le dernier passage
34	c rjour---input-R-numero du jour de l'experience
35	c gmtime--input-R-temps universel dans la journee (0 a 86400 s)
36	c pdtphys-input-R-pas d'integration pour la physique (seconde)
37	c paprs---input-R-pression pour chaque inter-couche (en Pa)
38	c pplay---input-R-pression pour le mileu de chaque couche (en Pa)
39	c pphi----input-R-geopotentiel de chaque couche (g z) (reference sol)
40	c pphis---input-R-geopotentiel du sol
41	c paire---input-R-aire de chaque maille
42	c presnivs-input_R_pressions approximat. des milieux couches ( en PA)
43	c u-------input-R-vitesse dans la direction X (de O a E) en m/s
44	c v-------input-R-vitesse Y (de S a N) en m/s
45	c t-------input-R-temperature (K)
46	c qx------input-R-humidite specifique (kg/kg) et d'autres traceurs
47	c d_t_dyn-input-R-tendance dynamique pour "t" (K/s)
48	c d_q_dyn-input-R-tendance dynamique pour "q" (kg/kg/s)
49	c omega---input-R-vitesse verticale en Pa/s
50	c cufi----input-R-resolution des mailles en x (m)
51	c cvfi----input-R-resolution des mailles en y (m)
52	c
53	c d_u-----output-R-tendance physique de "u" (m/s/s)
54	c d_v-----output-R-tendance physique de "v" (m/s/s)
55	c d_t-----output-R-tendance physique de "t" (K/s)
56	c d_qx----output-R-tendance physique de "qx" (kg/kg/s)
57	c d_ps----output-R-tendance physique de la pression au sol
58	c======================================================================
59	#include "dimensions.h"
60	integer jjmp1
61	parameter (jjmp1=jjm+1-1/jjm)
62	#include "dimphy.h"
63	#include "regdim.h"
64	#include "indicesol.h"
65	#include "dimsoil.h"
66	#include "clesphys.h"
67	#include "control.h"
68	#include "temps.h"
69	c======================================================================
70	LOGICAL check ! Verifier la conservation du modele en eau
71	PARAMETER (check=.FALSE.)
72	LOGICAL ok_stratus ! Ajouter artificiellement les stratus
73	PARAMETER (ok_stratus=.FALSE.)
74	c======================================================================
75	c Parametres lies au coupleur OASIS:
76	#include "oasis.h"
77	INTEGER,SAVE :: npas, nexca
78	logical rnpb
79	parameter(rnpb=.true.)
80	c PARAMETER (npas=1440)
81	c PARAMETER (nexca=48)
82	EXTERNAL fromcpl, intocpl, inicma
83	c ocean = type de modele ocean a utiliser: force, slab, couple
84	character*6 ocean
85	SAVE ocean
86
87	c parameter (ocean = 'force ')
88	c parameter (ocean = 'couple')
89	logical ok_ocean
90	c======================================================================
91	c Clef controlant l'activation du cycle diurne:
92	ccc LOGICAL cycle_diurne
93	ccc PARAMETER (cycle_diurne=.FALSE.)
94	c======================================================================
95	c Modele thermique du sol, a activer pour le cycle diurne:
96	ccc LOGICAL soil_model
97	ccc PARAMETER (soil_model=.FALSE.)
98	logical ok_veget
99	save ok_veget
100	c parameter (ok_veget = .true.)
101	c parameter (ok_veget = .false.)
102	c======================================================================
103	c Dans les versions precedentes, l'eau liquide nuageuse utilisee dans
104	c le calcul du rayonnement est celle apres la precipitation des nuages.
105	c Si cette cle new_oliq est activee, ce sera une valeur moyenne entre
106	c la condensation et la precipitation. Cette cle augmente les impacts
107	c radiatifs des nuages.
108	ccc LOGICAL new_oliq
109	ccc PARAMETER (new_oliq=.FALSE.)
110	c======================================================================
111	c Clefs controlant deux parametrisations de l'orographie:
112	cc LOGICAL ok_orodr
113	ccc PARAMETER (ok_orodr=.FALSE.)
114	ccc LOGICAL ok_orolf
115	ccc PARAMETER (ok_orolf=.FALSE.)
116	c======================================================================
117	LOGICAL ok_journe ! sortir le fichier journalier
118	save ok_journe
119	c PARAMETER (ok_journe=.true.)
120	c
121	LOGICAL ok_mensuel ! sortir le fichier mensuel
122	save ok_mensuel
123	c PARAMETER (ok_mensuel=.true.)
124	c
125	LOGICAL ok_instan ! sortir le fichier instantane
126	save ok_instan
127	c PARAMETER (ok_instan=.true.)
128	c
129	LOGICAL ok_region ! sortir le fichier regional
130	PARAMETER (ok_region=.FALSE.)
131	c======================================================================
132	c
133	INTEGER ivap ! indice de traceurs pour vapeur d'eau
134	PARAMETER (ivap=1)
135	INTEGER iliq ! indice de traceurs pour eau liquide
136	PARAMETER (iliq=2)
137
138	INTEGER nvm ! nombre de vegetations
139	PARAMETER (nvm=8)
140	REAL veget(klon,nvm) ! couverture vegetale
141	SAVE veget
142
143	c
144	c
145	c Variables argument:
146	c
147	INTEGER nlon
148	INTEGER nlev
149	INTEGER nqmax
150	REAL rjourvrai, rjour_ecri
151	REAL gmtime
152	REAL pdtphys
153	LOGICAL debut, lafin
154	REAL paprs(klon,klev+1)
155	REAL pplay(klon,klev)
156	REAL pphi(klon,klev)
157	REAL pphis(klon)
158	REAL paire(klon)
159	REAL presnivs(klev)
160	REAL znivsig(klev)
161	REAL zsurf(nbsrf)
162	real cufi(klon), cvfi(klon)
163
164	REAL u(klon,klev)
165	REAL v(klon,klev)
166	REAL t(klon,klev)
167	REAL qx(klon,klev,nqmax)
168
169	REAL t_ancien(klon,klev), q_ancien(klon,klev)
170	SAVE t_ancien, q_ancien
171	LOGICAL ancien_ok
172	SAVE ancien_ok
173
174	REAL d_t_dyn(klon,klev)
175	REAL d_q_dyn(klon,klev)
176
177	REAL omega(klon,klev)
178
179	REAL d_u(klon,klev)
180	REAL d_v(klon,klev)
181	REAL d_t(klon,klev)
182	REAL d_qx(klon,klev,nqmax)
183	REAL d_ps(klon)
184
185	INTEGER longcles
186	PARAMETER ( longcles = 20 )
187	REAL clesphy0( longcles )
188	c
189	c Variables quasi-arguments
190	c
191	REAL xjour
192	SAVE xjour
193	c
194	c
195	c Variables propres a la physique
196	c
197	REAL dtime
198	SAVE dtime ! pas temporel de la physique
199	c
200	INTEGER radpas
201	SAVE radpas ! frequence d'appel rayonnement
202	c
203	REAL radsol(klon)
204	SAVE radsol ! bilan radiatif au sol
205	c
206	REAL rlat(klon)
207	SAVE rlat ! latitude pour chaque point
208	c
209	REAL rlon(klon)
210	SAVE rlon ! longitude pour chaque point
211	c
212	cc INTEGER iflag_con
213	cc SAVE iflag_con ! indicateur de la convection
214	c
215	INTEGER itap
216	SAVE itap ! compteur pour la physique
217	c
218	REAL co2_ppm
219	SAVE co2_ppm ! concentration du CO2
220	c
221	REAL solaire
222	SAVE solaire ! constante solaire
223	c
224	REAL ftsol(klon,nbsrf)
225	SAVE ftsol ! temperature du sol
226	c
227	REAL ftsoil(klon,nsoilmx,nbsrf)
228	SAVE ftsoil ! temperature dans le sol
229	c
230	REAL fevap(klon,nbsrf)
231	SAVE fevap ! evaporation
232	REAL fluxlat(klon,nbsrf)
233	SAVE fluxlat
234	c
235	REAL deltat(klon)
236	SAVE deltat ! ecart avec la SST de reference
237	c
238	REAL fqsol(klon,nbsrf)
239	SAVE fqsol ! humidite du sol
240	c
241	REAL fsnow(klon,nbsrf)
242	SAVE fsnow ! epaisseur neigeuse
243	c
244	REAL falbe(klon,nbsrf)
245	SAVE falbe ! albedo par type de surface
246	REAL falblw(klon,nbsrf)
247	SAVE falblw ! albedo par type de surface
248
249	c
250	c
251	c Parametres de l'Orographie a l'Echelle Sous-Maille (OESM):
252	c
253	REAL zmea(klon)
254	SAVE zmea ! orographie moyenne
255	c
256	REAL zstd(klon)
257	SAVE zstd ! deviation standard de l'OESM
258	c
259	REAL zsig(klon)
260	SAVE zsig ! pente de l'OESM
261	c
262	REAL zgam(klon)
263	save zgam ! anisotropie de l'OESM
264	c
265	REAL zthe(klon)
266	SAVE zthe ! orientation de l'OESM
267	c
268	REAL zpic(klon)
269	SAVE zpic ! Maximum de l'OESM
270	c
271	REAL zval(klon)
272	SAVE zval ! Minimum de l'OESM
273	c
274	REAL rugoro(klon)
275	SAVE rugoro ! longueur de rugosite de l'OESM
276	c
277	REAL zulow(klon),zvlow(klon),zustr(klon), zvstr(klon)
278	c
279	REAL zuthe(klon),zvthe(klon)
280	SAVE zuthe
281	SAVE zvthe
282	INTEGER igwd,idx(klon),itest(klon)
283	c
284	REAL agesno(klon,nbsrf)
285	SAVE agesno ! age de la neige
286	c
287	REAL alb_neig(klon)
288	SAVE alb_neig ! albedo de la neige
289	cKE43
290	c Variables liees a la convection de K. Emanuel (sb):
291	c
292	REAL ema_workcbmf(klon) ! cloud base mass flux
293	SAVE ema_workcbmf
294
295	REAL ema_cbmf(klon) ! cloud base mass flux
296	SAVE ema_cbmf
297
298	REAL ema_pcb(klon) ! cloud base pressure
299	SAVE ema_pcb
300
301	REAL ema_pct(klon) ! cloud top pressure
302	SAVE ema_pct
303
304	REAL bas, top ! cloud base and top levels
305	SAVE bas
306	SAVE top
307
308	REAL Ma(klon,klev) ! undilute upward mass flux
309	SAVE Ma
310	REAL ema_work1(klon, klev), ema_work2(klon, klev)
311	SAVE ema_work1, ema_work2
312	REAL wdn(klon), tdn(klon), qdn(klon)
313	c Variables locales pour la couche limite (al1):
314	c
315	cAl1 REAL pblh(klon) ! Hauteur de couche limite
316	cAl1 SAVE pblh
317	c34EK
318	c
319	c Variables locales:
320	c
321	REAL cdragh(klon) ! drag coefficient pour T and Q
322	REAL cdragm(klon) ! drag coefficient pour vent
323	cAA
324	cAA Pour phytrac
325	cAA
326	REAL ycoefh(klon,klev) ! coef d'echange pour phytrac
327	REAL yu1(klon) ! vents dans la premiere couche U
328	REAL yv1(klon) ! vents dans la premiere couche V
329	LOGICAL offline ! Controle du stockage ds "physique"
330	PARAMETER (offline=.false.)
331	INTEGER physid
332	REAL pfrac_impa(klon,klev)! Produits des coefs lessivage impaction
333	save pfrac_impa
334	REAL pfrac_nucl(klon,klev)! Produits des coefs lessivage nucleation
335	save pfrac_nucl
336	REAL pfrac_1nucl(klon,klev)! Produits des coefs lessi nucl (alpha = 1)
337	save pfrac_1nucl
338	REAL frac_impa(klon,klev) ! fractions d'aerosols lessivees (impaction)
339	REAL frac_nucl(klon,klev) ! idem (nucleation)
340	cAA
341	REAL rain_fall(klon) ! pluie
342	REAL snow_fall(klon) ! neige
343	save snow_fall, rain_fall
344	REAL evap(klon), devap(klon) ! evaporation et sa derivee
345	REAL sens(klon), dsens(klon) ! chaleur sensible et sa derivee
346	REAL dlw(klon) ! derivee infra rouge
347	REAL bils(klon) ! bilan de chaleur au sol
348	REAL fder(klon) ! Derive de flux (sensible et latente)
349	save fder
350	REAL ve(klon) ! integr. verticale du transport meri. de l'energie
351	REAL vq(klon) ! integr. verticale du transport meri. de l'eau
352	REAL ue(klon) ! integr. verticale du transport zonal de l'energie
353	REAL uq(klon) ! integr. verticale du transport zonal de l'eau
354	c
355	REAL frugs(klon,nbsrf) ! longueur de rugosite
356	save frugs
357	REAL zxrugs(klon) ! longueur de rugosite
358	c
359	c Conditions aux limites
360	c
361	INTEGER julien
362	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.GE.3) 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	cKE43
1231	IF (iflag_con .GE. 3) THEN ! sb
1232	c
1233	CALL histdef(nid_mth, "cape", "Conv avlbl pot ener", "J/Kg",
1234	. iim,jjmp1,nhori, 1,1,1, -99, 32,
1235	. "ave(X)", zsto,zout)
1236	c
1237	CALL histdef(nid_mth, "pbase", "Cld base pressure", "hPa",
1238	. iim,jjmp1,nhori, 1,1,1, -99, 32,
1239	. "ave(X)", zsto,zout)
1240	c
1241	CALL histdef(nid_mth, "ptop", "Cld top pressure", "hPa",
1242	. iim,jjmp1,nhori, 1,1,1, -99, 32,
1243	. "ave(X)", zsto,zout)
1244	c
1245	CALL histdef(nid_mth, "fbase", "Cld base mass flux", "Kg/m2/s",
1246	. iim,jjmp1,nhori, 1,1,1, -99, 32,
1247	. "ave(X)", zsto,zout)
1248	c
1249	c
1250	ENDIF
1251	c34EK
1252	c
1253	c Champs 3D:
1254	c
1255	CALL histdef(nid_mth, "temp", "Air temperature", "K",
1256	. iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1257	. "ave(X)", zsto,zout)
1258	c
1259	CALL histdef(nid_mth, "ovap", "Specific humidity", "Kg/Kg",
1260	. iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1261	. "ave(X)", zsto,zout)
1262	c
1263	CALL histdef(nid_mth, "geop", "Geopotential height", "m",
1264	. iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1265	. "ave(X)", zsto,zout)
1266	c
1267	CALL histdef(nid_mth, "vitu", "Zonal wind", "m/s",
1268	. iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1269	. "ave(X)", zsto,zout)
1270	c
1271	CALL histdef(nid_mth, "vitv", "Meridional wind", "m/s",
1272	. iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1273	. "ave(X)", zsto,zout)
1274	c
1275	CALL histdef(nid_mth, "vitw", "Vertical wind", "m/s",
1276	. iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1277	. "ave(X)", zsto,zout)
1278	c
1279	CALL histdef(nid_mth, "pres", "Air pressure", "Pa",
1280	. iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1281	. "ave(X)", zsto,zout)
1282	c
1283	CALL histdef(nid_mth, "rneb", "Cloud fraction", "-",
1284	. iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1285	. "ave(X)", zsto,zout)
1286	c
1287	CALL histdef(nid_mth, "rhum", "Relative humidity", "-",
1288	. iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1289	. "ave(X)", zsto,zout)
1290	c
1291	CALL histdef(nid_mth, "oliq", "Liquid water content", "kg/kg",
1292	. iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1293	. "ave(X)", zsto,zout)
1294	c
1295	CALL histdef(nid_mth, "dtdyn", "Dynamics dT", "K/s",
1296	. iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1297	. "ave(X)", zsto,zout)
1298	c
1299	CALL histdef(nid_mth, "dqdyn", "Dynamics dQ", "Kg/Kg/s",
1300	. iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1301	. "ave(X)", zsto,zout)
1302	c
1303	CALL histdef(nid_mth, "dtcon", "Convection dT", "K/s",
1304	. iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1305	. "ave(X)", zsto,zout)
1306	c
1307	CALL histdef(nid_mth, "dqcon", "Convection dQ", "Kg/Kg/s",
1308	. iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1309	. "ave(X)", zsto,zout)
1310	c
1311	CALL histdef(nid_mth, "dtlsc", "Condensation dT", "K/s",
1312	. iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1313	. "ave(X)", zsto,zout)
1314	c
1315	CALL histdef(nid_mth, "dqlsc", "Condensation dQ", "Kg/Kg/s",
1316	. iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1317	. "ave(X)", zsto,zout)
1318	c
1319	CALL histdef(nid_mth, "dtvdf", "Boundary-layer dT", "K/s",
1320	. iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1321	. "ave(X)", zsto,zout)
1322	c
1323	CALL histdef(nid_mth, "dqvdf", "Boundary-layer dQ", "Kg/Kg/s",
1324	. iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1325	. "ave(X)", zsto,zout)
1326	c
1327	CALL histdef(nid_mth, "dteva", "Reevaporation dT", "K/s",
1328	. iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1329	. "ave(X)", zsto,zout)
1330	c
1331	CALL histdef(nid_mth, "dqeva", "Reevaporation dQ", "Kg/Kg/s",
1332	. iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1333	. "ave(X)", zsto,zout)
1334
1335	CALL histdef(nid_mth, "ptconv", "POINTS CONVECTIFS"," ",
1336	. iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1337	. "ave(X)", zsto,zout)
1338
1339	CALL histdef(nid_mth, "ratqs", "RATQS"," ",
1340	. iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1341	. "ave(X)", zsto,zout)
1342
1343	c
1344	CALL histdef(nid_mth, "dtajs", "Dry adjust. dT", "K/s",
1345	. iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1346	. "ave(X)", zsto,zout)
1347
1348	CALL histdef(nid_mth, "dqajs", "Dry adjust. dQ", "Kg/Kg/s",
1349	. iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1350	. "ave(X)", zsto,zout)
1351	c
1352	CALL histdef(nid_mth, "dtswr", "SW radiation dT", "K/s",
1353	. iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1354	. "ave(X)", zsto,zout)
1355	c
1356	CALL histdef(nid_mth, "dtsw0", "SW radiation dT", "K/s",
1357	. iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1358	. "ave(X)", zsto,zout)
1359	c
1360	CALL histdef(nid_mth, "dtlwr", "LW radiation dT", "K/s",
1361	. iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1362	. "ave(X)", zsto,zout)
1363	c
1364	CALL histdef(nid_mth, "dtlw0", "LW radiation dT", "K/s",
1365	. iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1366	. "ave(X)", zsto,zout)
1367	c
1368	CALL histdef(nid_mth, "duvdf", "Boundary-layer dU", "m/s2",
1369	. iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1370	. "ave(X)", zsto,zout)
1371	c
1372	CALL histdef(nid_mth, "dvvdf", "Boundary-layer dV", "m/s2",
1373	. iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1374	. "ave(X)", zsto,zout)
1375	c
1376	IF (ok_orodr) THEN
1377	CALL histdef(nid_mth, "duoro", "Orography dU", "m/s2",
1378	. iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1379	. "ave(X)", zsto,zout)
1380	c
1381	CALL histdef(nid_mth, "dvoro", "Orography dV", "m/s2",
1382	. iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1383	. "ave(X)", zsto,zout)
1384	c
1385	ENDIF
1386	C
1387	IF (ok_orolf) THEN
1388	CALL histdef(nid_mth, "dulif", "Orography dU", "m/s2",
1389	. iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1390	. "ave(X)", zsto,zout)
1391	c
1392	CALL histdef(nid_mth, "dvlif", "Orography dV", "m/s2",
1393	. iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1394	. "ave(X)", zsto,zout)
1395	ENDIF
1396	C
1397	CALL histdef(nid_mth, "ozone", "Ozone concentration", "-",
1398	. iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1399	. "ave(X)", zsto,zout)
1400	c
1401	if (nqmax.GE.3) THEN
1402	DO iq=1,nqmax-2
1403	IF (iq.LE.99) THEN
1404	WRITE(str2,'(i2.2)') iq
1405	CALL histdef(nid_mth, "trac"//str2, "Tracer No."//str2, "-",
1406	. iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1407	. "ave(X)", zsto,zout)
1408	ELSE
1409	PRINT*, "Trop de traceurs"
1410	CALL abort
1411	ENDIF
1412	ENDDO
1413	ENDIF
1414	c
1415	cKE43
1416	IF (iflag_con.GE.3) THEN ! (sb)
1417	c
1418	CALL histdef(nid_mth, "upwd", "saturated updraft", "Kg/m2/s",
1419	. iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1420	. "ave(X)", zsto,zout)
1421	c
1422	CALL histdef(nid_mth, "dnwd", "saturated downdraft","Kg/m2/s",
1423	. iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1424	. "ave(X)", zsto,zout)
1425	c
1426	CALL histdef(nid_mth, "dnwd0", "unsat. downdraft", "Kg/m2/s",
1427	. iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1428	. "ave(X)", zsto,zout)
1429	c
1430	CALL histdef(nid_mth,"Ma","undilute adiab updraft","Kg/m2/s",
1431	. iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1432	. "ave(X)", zsto,zout)
1433	c
1434	c
1435	ENDIF
1436	c34EK
1437	CALL histend(nid_mth)
1438	c
1439	ndex2d = 0
1440	ndex3d = 0
1441	c
1442	ENDIF ! fin de test sur ok_mensuel
1443	c
1444	c
1445	IF (ok_instan) THEN
1446	c
1447	CALL ymds2ju(anne_ini, 1, 1, 0.0, zjulian)
1448	zjulian = zjulian + day_ini
1449	c
1450	CALL gr_fi_ecrit(1,klon,iim,jjmp1,rlon,zx_lon)
1451	DO i = 1, iim
1452	zx_lon(i,1) = rlon(i+1)
1453	zx_lon(i,jjmp1) = rlon(i+1)
1454	ENDDO
1455	DO ll=1,klev
1456	znivsig(ll)=float(ll)
1457	ENDDO
1458	CALL gr_fi_ecrit(1,klon,iim,jjmp1,rlat,zx_lat)
1459	CALL histbeg("histins", iim,zx_lon, jjmp1,zx_lat,
1460	. 1,iim,1,jjmp1, 0, zjulian, dtime,
1461	. nhori, nid_ins)
1462	CALL histvert(nid_ins, "presnivs", "Vertical levels", "mb",
1463	. klev, presnivs, nvert)
1464	c call histvert(nid_ins, 'sig_s', 'Niveaux sigma','-',
1465	c . klev, znivsig, nvert)
1466	c
1467	c
1468	zsto = dtime * ecrit_ins
1469	zout = dtime * ecrit_ins
1470	C
1471	CALL histdef(nid_ins, "phis", "Surface geop. height", "-",
1472	. iim,jjmp1,nhori, 1,1,1, -99, 32,
1473	. "once", zsto,zout)
1474	c
1475	CALL histdef(nid_ins, "aire", "Grid area", "-",
1476	. iim,jjmp1,nhori, 1,1,1, -99, 32,
1477	. "once", zsto,zout)
1478	c
1479	c Champs 2D:
1480	c
1481	CALL histdef(nid_ins, "tsol", "Surface Temperature", "K",
1482	. iim,jjmp1,nhori, 1,1,1, -99, 32,
1483	. "inst(X)", zsto,zout)
1484	c
1485	CALL histdef(nid_ins, "psol", "Surface Pressure", "Pa",
1486	. iim,jjmp1,nhori, 1,1,1, -99, 32,
1487	. "inst(X)", zsto,zout)
1488	c
1489	CALL histdef(nid_ins, "plul", "Large-scale Precip.", "mm/day",
1490	. iim,jjmp1,nhori, 1,1,1, -99, 32,
1491	. "inst(X)", zsto,zout)
1492	c
1493	CALL histdef(nid_ins, "pluc", "Convective Precip.", "mm/day",
1494	. iim,jjmp1,nhori, 1,1,1, -99, 32,
1495	. "inst(X)", zsto,zout)
1496
1497	CALL histdef(nid_ins, "qsol", "Surface humidity", "mm",
1498	. iim,jjmp1,nhori, 1,1,1, -99, 32,
1499	. "inst(X)", zsto,zout)
1500	c
1501	CALL histdef(nid_ins, "rain", "Precipitation", "mm/day",
1502	. iim,jjmp1,nhori, 1,1,1, -99, 32,
1503	. "inst(X)", zsto,zout)
1504	c
1505	CALL histdef(nid_ins, "snow", "Snow fall", "mm/day",
1506	. iim,jjmp1,nhori, 1,1,1, -99, 32,
1507	. "inst(X)", zsto,zout)
1508	c
1509	CALL histdef(nid_ins, "snow_cov", "Snow cover", "mm",
1510	. iim,jjmp1,nhori, 1,1,1, -99, 32,
1511	. "inst(X)", zsto,zout)
1512	c
1513	CALL histdef(nid_ins, "topl", "OLR", "W/m2",
1514	. iim,jjmp1,nhori, 1,1,1, -99, 32,
1515	. "inst(X)", zsto,zout)
1516	c
1517	CALL histdef(nid_ins, "evap", "Evaporation", "mm/day",
1518	. iim,jjmp1,nhori, 1,1,1, -99, 32,
1519	. "inst(X)", zsto,zout)
1520	c
1521	CALL histdef(nid_ins, "sols", "Solar rad. at surf.", "W/m2",
1522	. iim,jjmp1,nhori, 1,1,1, -99, 32,
1523	. "inst(X)", zsto,zout)
1524	c
1525	CALL histdef(nid_ins, "soll", "IR rad. at surface", "W/m2",
1526	. iim,jjmp1,nhori, 1,1,1, -99, 32,
1527	. "inst(X)", zsto,zout)
1528	c
1529	CALL histdef(nid_ins, "solldown", "Down. IR rad. at surface",
1530	. "W/m2", iim,jjmp1,nhori, 1,1,1, -99, 32,
1531	. "inst(X)", zsto,zout)
1532	c
1533	CALL histdef(nid_ins, "bils", "Surf. total heat flux", "W/m2",
1534	. iim,jjmp1,nhori, 1,1,1, -99, 32,
1535	. "inst(X)", zsto,zout)
1536	c
1537	CALL histdef(nid_ins, "sens", "Sensible heat flux", "W/m2",
1538	. iim,jjmp1,nhori, 1,1,1, -99, 32,
1539	. "inst(X)", zsto,zout)
1540	c
1541	CALL histdef(nid_ins, "fder", "Heat flux derivation", "W/m2",
1542	. iim,jjmp1,nhori, 1,1,1, -99, 32,
1543	. "inst(X)", zsto,zout)
1544	c
1545	CALL histdef(nid_ins, "dtsvdfo", "Boundary-layer dTs(o)", "K/s",
1546	. iim,jjmp1,nhori, 1,1,1, -99, 32,
1547	. "inst(X)", zsto,zout)
1548	c
1549	CALL histdef(nid_ins, "dtsvdft", "Boundary-layer dTs(t)", "K/s",
1550	. iim,jjmp1,nhori, 1,1,1, -99, 32,
1551	. "inst(X)", zsto,zout)
1552	c
1553	CALL histdef(nid_ins, "dtsvdfg", "Boundary-layer dTs(g)", "K/s",
1554	. iim,jjmp1,nhori, 1,1,1, -99, 32,
1555	. "inst(X)", zsto,zout)
1556	c
1557	CALL histdef(nid_ins, "dtsvdfi", "Boundary-layer dTs(g)", "K/s",
1558	. iim,jjmp1,nhori, 1,1,1, -99, 32,
1559	. "inst(X)", zsto,zout)
1560
1561	DO nsrf = 1, nbsrf
1562	C
1563	call histdef(nid_ins, "pourc_"//clnsurf(nsrf),
1564	$ "Fraction"//clnsurf(nsrf), "W/m2",
1565	$ iim,jjmp1,nhori, 1,1,1, -99, 32,
1566	$ "inst(X)", zsto,zout)
1567
1568	call histdef(nid_ins, "sens_"//clnsurf(nsrf),
1569	$ "Sensible heat flux "//clnsurf(nsrf), "W/m2",
1570	$ iim,jjmp1,nhori, 1,1,1, -99, 32,
1571	$ "inst(X)", zsto,zout)
1572	c
1573	call histdef(nid_ins, "tsol_"//clnsurf(nsrf),
1574	$ "Surface Temperature"//clnsurf(nsrf), "W/m2",
1575	$ iim,jjmp1,nhori, 1,1,1, -99, 32,
1576	$ "inst(X)", zsto,zout)
1577	c
1578	call histdef(nid_ins, "lat_"//clnsurf(nsrf),
1579	$ "Latent heat flux "//clnsurf(nsrf), "W/m2",
1580	$ iim,jjmp1,nhori, 1,1,1, -99, 32,
1581	$ "inst(X)", zsto,zout)
1582	C
1583	call histdef(nid_ins, "taux_"//clnsurf(nsrf),
1584	$ "Zonal wind stress"//clnsurf(nsrf),"Pa",
1585	$ iim,jjmp1,nhori, 1,1,1, -99, 32,
1586	$ "inst(X)", zsto,zout)
1587
1588	call histdef(nid_ins, "tauy_"//clnsurf(nsrf),
1589	$ "Meridional xind stress "//clnsurf(nsrf), "Pa",
1590	$ iim,jjmp1,nhori, 1,1,1, -99, 32,
1591	$ "inst(X)", zsto,zout)
1592	c
1593	call histdef(nid_ins, "albe_"//clnsurf(nsrf),
1594	$ "Albedo "//clnsurf(nsrf), "-",
1595	$ iim,jjmp1,nhori, 1,1,1, -99, 32,
1596	$ "inst(X)", zsto,zout)
1597	c
1598	call histdef(nid_ins, "rugs_"//clnsurf(nsrf),
1599	$ "rugosite "//clnsurf(nsrf), "-",
1600	$ iim,jjmp1,nhori, 1,1,1, -99, 32,
1601	$ "inst(X)", zsto,zout)
1602	C§§§
1603	END DO
1604	CALL histdef(nid_ins, "rugs", "rugosity", "-",
1605	. iim,jjmp1,nhori, 1,1,1, -99, 32,
1606	. "inst(X)", zsto,zout)
1607
1608	c
1609	CALL histdef(nid_ins, "albs", "Surface albedo", "-",
1610	. iim,jjmp1,nhori, 1,1,1, -99, 32,
1611	. "inst(X)", zsto,zout)
1612	CALL histdef(nid_ins, "albslw", "Surface albedo LW", "-",
1613	. iim,jjmp1,nhori, 1,1,1, -99, 32,
1614	. "inst(X)", zsto,zout)
1615	c
1616	c
1617	c Champs 3D:
1618	c
1619	CALL histdef(nid_ins, "temp", "Temperature", "K",
1620	. iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1621	. "inst(X)", zsto,zout)
1622	c
1623	CALL histdef(nid_ins, "vitu", "Zonal wind", "m/s",
1624	. iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1625	. "inst(X)", zsto,zout)
1626	c
1627	CALL histdef(nid_ins, "vitv", "Merid wind", "m/s",
1628	. iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1629	. "inst(X)", zsto,zout)
1630	c
1631	CALL histdef(nid_ins, "geop", "Geopotential height", "m",
1632	. iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1633	. "inst(X)", zsto,zout)
1634	c
1635	CALL histdef(nid_ins, "pres", "Air pressure", "Pa",
1636	. iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1637	. "inst(X)", zsto,zout)
1638	c
1639	CALL histdef(nid_ins, "dtvdf", "Boundary-layer dT", "K/s",
1640	. iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1641	. "inst(X)", zsto,zout)
1642	c
1643	CALL histdef(nid_ins, "dqvdf", "Boundary-layer dQ", "Kg/Kg/s",
1644	. iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1645	. "inst(X)", zsto,zout)
1646	c
1647
1648	CALL histend(nid_ins)
1649	c
1650	ndex2d = 0
1651	ndex3d = 0
1652	c
1653	ENDIF
1654
1655	c$$$PB Positionner date0 pour initialisation de ORCHIDEE
1656	c$$$ date0 = zjulian
1657	date0 = day_ini
1658	WRITE(,) 'physiq date0 : ',date0
1659	c
1660	c
1661	c
1662	c Prescrire l'ozone dans l'atmosphere
1663	c
1664	c
1665	cc DO i = 1, klon
1666	cc DO k = 1, klev
1667	cc CALL o3cm (paprs(i,k)/100.,paprs(i,k+1)/100., wo(i,k),20)
1668	cc ENDDO
1669	cc ENDDO
1670	c
1671	c
1672	ENDIF
1673	c
1674	c ************** Fin de IF ( debut ) *************
1675	c
1676	c
1677	c Mettre a zero des variables de sortie (pour securite)
1678	c
1679	DO i = 1, klon
1680	d_ps(i) = 0.0
1681	ENDDO
1682	DO k = 1, klev
1683	DO i = 1, klon
1684	d_t(i,k) = 0.0
1685	d_u(i,k) = 0.0
1686	d_v(i,k) = 0.0
1687	ENDDO
1688	ENDDO
1689	DO iq = 1, nqmax
1690	DO k = 1, klev
1691	DO i = 1, klon
1692	d_qx(i,k,iq) = 0.0
1693	ENDDO
1694	ENDDO
1695	ENDDO
1696	c
1697	c Ne pas affecter les valeurs entrees de u, v, h, et q
1698	c
1699	DO k = 1, klev
1700	DO i = 1, klon
1701	t_seri(i,k) = t(i,k)
1702	u_seri(i,k) = u(i,k)
1703	v_seri(i,k) = v(i,k)
1704	q_seri(i,k) = qx(i,k,ivap)
1705	ql_seri(i,k) = qx(i,k,iliq)
1706	ENDDO
1707	ENDDO
1708	IF (nqmax.GE.3) THEN
1709	DO iq = 3, nqmax
1710	DO k = 1, klev
1711	DO i = 1, klon
1712	tr_seri(i,k,iq-2) = qx(i,k,iq)
1713	ENDDO
1714	ENDDO
1715	ENDDO
1716	ELSE
1717	DO k = 1, klev
1718	DO i = 1, klon
1719	tr_seri(i,k,1) = 0.0
1720	ENDDO
1721	ENDDO
1722	ENDIF
1723	c
1724	c Diagnostiquer la tendance dynamique
1725	c
1726	IF (ancien_ok) THEN
1727	DO k = 1, klev
1728	DO i = 1, klon
1729	d_t_dyn(i,k) = (t_seri(i,k)-t_ancien(i,k))/dtime
1730	d_q_dyn(i,k) = (q_seri(i,k)-q_ancien(i,k))/dtime
1731	ENDDO
1732	ENDDO
1733	ELSE
1734	DO k = 1, klev
1735	DO i = 1, klon
1736	d_t_dyn(i,k) = 0.0
1737	d_q_dyn(i,k) = 0.0
1738	ENDDO
1739	ENDDO
1740	ancien_ok = .TRUE.
1741	ENDIF
1742	c
1743	c Ajouter le geopotentiel du sol:
1744	c
1745	DO k = 1, klev
1746	DO i = 1, klon
1747	zphi(i,k) = pphi(i,k) + pphis(i)
1748	ENDDO
1749	ENDDO
1750	c
1751	c Verifier les temperatures
1752	c
1753	CALL hgardfou(t_seri,ftsol,'debutphy')
1754	c
1755	c Incrementer le compteur de la physique
1756	c
1757	itap = itap + 1
1758	julien = MOD(NINT(xjour),360)
1759	c
1760	c Mettre en action les conditions aux limites (albedo, sst, etc.).
1761	c Prescrire l'ozone et calculer l'albedo sur l'ocean.
1762	c
1763	IF (MOD(itap-1,lmt_pas) .EQ. 0) THEN
1764	idayvrai = NINT(xjour)
1765	PRINT *,' PHYS cond julien ',julien,idayvrai
1766	CALL ozonecm( FLOAT(julien), rlat, paprs, wo)
1767	ENDIF
1768	c
1769	c Re-evaporer l'eau liquide nuageuse
1770	c
1771	DO k = 1, klev ! re-evaporation de l'eau liquide nuageuse
1772	DO i = 1, klon
1773	zlvdcp=RLVTT/RCPD/(1.0+RVTMP2*q_seri(i,k))
1774	zlsdcp=RLSTT/RCPD/(1.0+RVTMP2*q_seri(i,k))
1775	zdelta = MAX(0.,SIGN(1.,RTT-t_seri(i,k)))
1776	zb = MAX(0.0,ql_seri(i,k))
1777	za = - MAX(0.0,ql_seri(i,k))
1778	. * (zlvdcp(1.-zdelta)+zlsdcpzdelta)
1779	t_seri(i,k) = t_seri(i,k) + za
1780	q_seri(i,k) = q_seri(i,k) + zb
1781	ql_seri(i,k) = 0.0
1782	d_t_eva(i,k) = za
1783	d_q_eva(i,k) = zb
1784	ENDDO
1785	ENDDO
1786	c
1787	c Appeler la diffusion verticale (programme de couche limite)
1788	c
1789	DO i = 1, klon
1790	c if (.not. ok_veget) then
1791	c frugs(i,is_ter) = SQRT(frugs(i,is_ter)2+rugoro(i)2)
1792	c endif
1793	c frugs(i,is_lic) = rugoro(i)
1794	c frugs(i,is_oce) = rugmer(i)
1795	c frugs(i,is_sic) = 0.001
1796	zxrugs(i) = 0.0
1797	ENDDO
1798	DO nsrf = 1, nbsrf
1799	DO i = 1, klon
1800	frugs(i,nsrf) = MAX(frugs(i,nsrf),0.001)
1801	ENDDO
1802	ENDDO
1803	DO nsrf = 1, nbsrf
1804	DO i = 1, klon
1805	zxrugs(i) = zxrugs(i) + frugs(i,nsrf)*pctsrf(i,nsrf)
1806	ENDDO
1807	ENDDO
1808	c
1809	C calculs necessaires au calcul de l'albedo dans l'interface
1810	c
1811	CALL orbite(FLOAT(julien),zlongi,dist)
1812	IF (cycle_diurne) THEN
1813	zdtime=dtime*FLOAT(radpas) ! pas de temps du rayonnement (s)
1814	CALL zenang(zlongi,gmtime,zdtime,rlat,rlon,rmu0,fract)
1815	ELSE
1816	rmu0 = -999.999
1817	ENDIF
1818
1819	fder = dlw
1820
1821	CALL clmain(dtime,itap,zjulian,pctsrf,
1822	e t_seri,q_seri,u_seri,v_seri,
1823	e julien, rmu0,
1824	e ok_veget, ocean, npas, nexca, ftsol,
1825	$ soil_model,ftsoil,
1826	$ paprs,pplay,radsol, fsnow,fqsol,fevap,falbe,falblw,
1827	$ fluxlat,
1828	e rain_fall, snow_fall, solsw, sollw, sollwdown, fder,
1829	e rlon, rlat, cufi, cvfi, frugs,
1830	e debut, lafin, agesno,rugoro ,
1831	s d_t_vdf,d_q_vdf,d_u_vdf,d_v_vdf,d_ts,
1832	s fluxt,fluxq,fluxu,fluxv,cdragh,cdragm,
1833	s dsens, devap,
1834	s ycoefh,yu1,yv1)
1835
1836	c
1837	C§§§ PB
1838	C§§§ Incrementation des flux
1839	C§§
1840	zxfluxt=0.
1841	zxfluxq=0.
1842	zxfluxu=0.
1843	zxfluxv=0.
1844	DO nsrf = 1, nbsrf
1845	DO k = 1, klev
1846	DO i = 1, klon
1847	zxfluxt(i,k) = zxfluxt(i,k) +
1848	$ fluxt(i,k,nsrf) * pctsrf( i, nsrf)
1849	zxfluxq(i,k) = zxfluxq(i,k) +
1850	$ fluxq(i,k,nsrf) * pctsrf( i, nsrf)
1851	zxfluxu(i,k) = zxfluxu(i,k) +
1852	$ fluxu(i,k,nsrf) * pctsrf( i, nsrf)
1853	zxfluxv(i,k) = zxfluxv(i,k) +
1854	$ fluxv(i,k,nsrf) * pctsrf( i, nsrf)
1855	END DO
1856	END DO
1857	END DO
1858	DO i = 1, klon
1859	sens(i) = - zxfluxt(i,1) ! flux de chaleur sensible au sol
1860	c evap(i) = - fluxq(i,1) ! flux d'evaporation au sol
1861	evap(i) = - zxfluxq(i,1) ! flux d'evaporation au sol
1862	fder(i) = dlw(i) + dsens(i) + devap(i)
1863	ENDDO
1864
1865
1866	DO k = 1, klev
1867	DO i = 1, klon
1868	t_seri(i,k) = t_seri(i,k) + d_t_vdf(i,k)
1869	q_seri(i,k) = q_seri(i,k) + d_q_vdf(i,k)
1870	u_seri(i,k) = u_seri(i,k) + d_u_vdf(i,k)
1871	v_seri(i,k) = v_seri(i,k) + d_v_vdf(i,k)
1872	ENDDO
1873	ENDDO
1874	c
1875	c Incrementer la temperature du sol
1876	c
1877	DO i = 1, klon
1878	zxtsol(i) = 0.0
1879	IF ( abs( pctsrf(i, is_ter) + pctsrf(i, is_lic) +
1880	$ pctsrf(i, is_oce) + pctsrf(i, is_sic) - 1.) .GT. EPSFRA)
1881	$ THEN
1882	WRITE(,) 'physiq : pb sous surface au point ', i,
1883	$ pctsrf(i, 1 : nbsrf)
1884	ENDIF
1885	ENDDO
1886	DO nsrf = 1, nbsrf
1887	DO i = 1, klon
1888	c$$$ IF (pctsrf(i,nsrf) .GE. EPSFRA) THEN
1889	ftsol(i,nsrf) = ftsol(i,nsrf) + d_ts(i,nsrf)
1890	zxtsol(i) = zxtsol(i) + ftsol(i,nsrf)*pctsrf(i,nsrf)
1891	c$$$ ENDIF
1892	ENDDO
1893	ENDDO
1894
1895	c
1896	c Si une sous-fraction n'existe pas, elle prend la temp. moyenne
1897	c
1898	DO nsrf = 1, nbsrf
1899	DO i = 1, klon
1900	IF (pctsrf(i,nsrf) .LT. epsfra) ftsol(i,nsrf) = zxtsol(i)
1901	ENDDO
1902	ENDDO
1903
1904	c
1905	c Calculer la derive du flux infrarouge
1906	c
1907	c$$$ DO nsrf = 1, nbsrf
1908	DO i = 1, klon
1909	c$$$ IF (pctsrf(i,nsrf) .GE. EPSFRA) THEN
1910	dlw(i) = - 4.0RSIGMAzxtsol(i)**3
1911	c$$$ . *(ftsol(i,nsrf)-zxtsol(i))
1912	c$$$ . *pctsrf(i,nsrf)
1913	c$$$ ENDIF
1914	c$$$ ENDDO
1915	ENDDO
1916	c
1917	c Appeler la convection (au choix)
1918	c
1919	DO k = 1, klev
1920	DO i = 1, klon
1921	conv_q(i,k) = d_q_dyn(i,k)
1922	. + d_q_vdf(i,k)/dtime
1923	conv_t(i,k) = d_t_dyn(i,k)
1924	. + d_t_vdf(i,k)/dtime
1925	ENDDO
1926	ENDDO
1927	IF (check) THEN
1928	za = qcheck(klon,klev,paprs,q_seri,ql_seri,paire)
1929	PRINT*, "avantcon=", za
1930	ENDIF
1931	zx_ajustq = .FALSE.
1932	IF (iflag_con.EQ.2) zx_ajustq=.TRUE.
1933	IF (zx_ajustq) THEN
1934	DO i = 1, klon
1935	z_avant(i) = 0.0
1936	ENDDO
1937	DO k = 1, klev
1938	DO i = 1, klon
1939	z_avant(i) = z_avant(i) + (q_seri(i,k)+ql_seri(i,k))
1940	. *(paprs(i,k)-paprs(i,k+1))/RG
1941	ENDDO
1942	ENDDO
1943	ENDIF
1944	IF (iflag_con.EQ.1) THEN
1945	stop'reactiver le call conlmd dans physiq.F'
1946	c CALL conlmd (dtime, paprs, pplay, t_seri, q_seri, conv_q,
1947	c . d_t_con, d_q_con,
1948	c . rain_con, snow_con, ibas_con, itop_con)
1949	ELSE IF (iflag_con.EQ.2) THEN
1950	CALL conflx(dtime, paprs, pplay, t_seri, q_seri,
1951	e conv_t, conv_q, zxfluxq(1,1), omega,
1952	s d_t_con, d_q_con, rain_con, snow_con,
1953	s pmfu, pmfd, pen_u, pde_u, pen_d, pde_d,
1954	s kcbot, kctop, kdtop, pmflxr, pmflxs)
1955	WHERE (rain_con < 0.) rain_con = 0.
1956	WHERE (snow_con < 0.) snow_con = 0.
1957	DO i = 1, klon
1958	ibas_con(i) = klev+1 - kcbot(i)
1959	itop_con(i) = klev+1 - kctop(i)
1960	ENDDO
1961	ELSE IF (iflag_con.GE.3) THEN
1962	c nb of tracers for the KE convection:
1963	if (nqmax .GE. 4) then
1964	ntra = nbtr
1965	else
1966	ntra = 1
1967	endif
1968	if (iflag_con.eq.4) then ! vectorise
1969	CALL conemav (dtime,paprs,pplay,t_seri,q_seri,
1970	. u_seri,v_seri,tr_seri,nbtr,
1971	. ema_work1,ema_work2,
1972	. d_t_con,d_q_con,d_u_con,d_v_con,d_tr,
1973	. rain_con, snow_con, ibas_con, itop_con,
1974	. upwd,dnwd,dnwd0,
1975	c . Ma,cape,tvp,(/(nint(rflag(i)),i=1,size(rflag))/),
1976	. Ma,cape,tvp,iflagctrl,
1977	. pbase,bbase,dtvpdt1,dtvpdq1,dplcldt,dplcldr)
1978
1979	else
1980
1981	CALL conema (dtime,paprs,pplay,t_seri,q_seri,
1982	. u_seri,v_seri,tr_seri,nbtr,
1983	. ema_work1,ema_work2,
1984	. d_t_con,d_q_con,d_u_con,d_v_con,d_tr,
1985	. rain_con, snow_con, ibas_con, itop_con,
1986	. upwd,dnwd,dnwd0,bas,top,
1987	. Ma,cape,tvp,rflag,
1988	. pbase
1989	. ,bbase,dtvpdt1,dtvpdq1,dplcldt,dplcldr)
1990	endif
1991	DO i = 1, klon
1992	ema_pcb(i) = pbase(i)
1993	ENDDO
1994	DO i = 1, klon
1995	ema_pct(i) = paprs(i,itop_con(i))
1996	ENDDO
1997	DO i = 1, klon
1998	ema_cbmf(i) = ema_workcbmf(i)
1999	ENDDO
2000	ELSE
2001	PRINT*, "iflag_con non-prevu", iflag_con
2002	CALL abort
2003	ENDIF
2004
2005	CALL homogene(paprs, q_seri, d_q_con, u_seri,v_seri,
2006	. d_u_con, d_v_con)
2007	DO k = 1, klev
2008	DO i = 1, klon
2009	t_seri(i,k) = t_seri(i,k) + d_t_con(i,k)
2010	q_seri(i,k) = q_seri(i,k) + d_q_con(i,k)
2011	u_seri(i,k) = u_seri(i,k) + d_u_con(i,k)
2012	v_seri(i,k) = v_seri(i,k) + d_v_con(i,k)
2013	ENDDO
2014	ENDDO
2015	IF (check) THEN
2016	za = qcheck(klon,klev,paprs,q_seri,ql_seri,paire)
2017	PRINT*, "aprescon=", za
2018	zx_t = 0.0
2019	za = 0.0
2020	DO i = 1, klon
2021	za = za + paire(i)/FLOAT(klon)
2022	zx_t = zx_t + (rain_con(i)+snow_con(i))*paire(i)/FLOAT(klon)
2023	ENDDO
2024	zx_t = zx_t/za*dtime
2025	PRINT*, "Precip=", zx_t
2026	ENDIF
2027	IF (zx_ajustq) THEN
2028	DO i = 1, klon
2029	z_apres(i) = 0.0
2030	ENDDO
2031	DO k = 1, klev
2032	DO i = 1, klon
2033	z_apres(i) = z_apres(i) + (q_seri(i,k)+ql_seri(i,k))
2034	. *(paprs(i,k)-paprs(i,k+1))/RG
2035	ENDDO
2036	ENDDO
2037	DO i = 1, klon
2038	z_factor(i) = (z_avant(i)-(rain_con(i)+snow_con(i))*dtime)
2039	. /z_apres(i)
2040	ENDDO
2041	DO k = 1, klev
2042	DO i = 1, klon
2043	IF (z_factor(i).GT.(1.0+1.0E-08) .OR.
2044	. z_factor(i).LT.(1.0-1.0E-08)) THEN
2045	q_seri(i,k) = q_seri(i,k) * z_factor(i)
2046	ENDIF
2047	ENDDO
2048	ENDDO
2049	ENDIF
2050	zx_ajustq=.FALSE.
2051	c
2052	IF (nqmax.GT.2) THEN !--melange convectif de traceurs
2053	c
2054	IF (iflag_con .LT. 2 .AND. iflag_con .GT. 4 ) THEN
2055	PRINT*, 'Pour l instant, seul conflx fonctionne ',
2056	$ 'avec traceurs', iflag_con
2057	PRINT*,' Mettre iflag_con',
2058	$ ' = 2, 3 ou 4 dans run.def et repasser'
2059	CALL abort
2060	ENDIF
2061	c
2062	ENDIF !--nqmax.GT.2
2063	c
2064	c Appeler l'ajustement sec
2065	c
2066	CALL ajsec(paprs, pplay, t_seri, q_seri, d_t_ajs, d_q_ajs)
2067	DO k = 1, klev
2068	DO i = 1, klon
2069	t_seri(i,k) = t_seri(i,k) + d_t_ajs(i,k)
2070	q_seri(i,k) = q_seri(i,k) + d_q_ajs(i,k)
2071	ENDDO
2072	ENDDO
2073
2074	c RATQS
2075	call calcratqs (
2076	I paprs,pplay,q_seri,d_t_con,d_t_ajs
2077	O ,ratqs,zpt_conv)
2078	c
2079	c Appeler le processus de condensation a grande echelle
2080	c et le processus de precipitation
2081	c
2082	CALL fisrtilp_tr(dtime,paprs,pplay,
2083	. t_seri, q_seri,ratqs,
2084	. d_t_lsc, d_q_lsc, d_ql_lsc, rneb, cldliq,
2085	. rain_lsc, snow_lsc,
2086	. pfrac_impa, pfrac_nucl, pfrac_1nucl,
2087	. frac_impa, frac_nucl,
2088	. prfl, psfl)
2089	WHERE (rain_lsc < 0) rain_lsc = 0.
2090	WHERE (snow_lsc < 0) snow_lsc = 0.
2091	DO k = 1, klev
2092	DO i = 1, klon
2093	t_seri(i,k) = t_seri(i,k) + d_t_lsc(i,k)
2094	q_seri(i,k) = q_seri(i,k) + d_q_lsc(i,k)
2095	ql_seri(i,k) = ql_seri(i,k) + d_ql_lsc(i,k)
2096	cldfra(i,k) = rneb(i,k)
2097	IF (.NOT.new_oliq) cldliq(i,k) = ql_seri(i,k)
2098	ENDDO
2099	ENDDO
2100	IF (check) THEN
2101	za = qcheck(klon,klev,paprs,q_seri,ql_seri,paire)
2102	PRINT*, "apresilp=", za
2103	zx_t = 0.0
2104	za = 0.0
2105	DO i = 1, klon
2106	za = za + paire(i)/FLOAT(klon)
2107	zx_t = zx_t + (rain_lsc(i)+snow_lsc(i))*paire(i)/FLOAT(klon)
2108	ENDDO
2109	zx_t = zx_t/za*dtime
2110	PRINT*, "Precip=", zx_t
2111	ENDIF
2112	c
2113	c Nuages diagnostiques:
2114	c
2115	IF (iflag_con.EQ.2) THEN ! seulement pour Tiedtke
2116	CALL diagcld1(paprs,pplay,
2117	. rain_con,snow_con,ibas_con,itop_con,
2118	. diafra,dialiq)
2119	DO k = 1, klev
2120	DO i = 1, klon
2121	IF (diafra(i,k).GT.cldfra(i,k)) THEN
2122	cldliq(i,k) = dialiq(i,k)
2123	cldfra(i,k) = diafra(i,k)
2124	ENDIF
2125	ENDDO
2126	ENDDO
2127	ENDIF
2128	c
2129	c Nuages stratus artificiels:
2130	c
2131	IF (ok_stratus) THEN
2132	CALL diagcld2(paprs,pplay,t_seri,q_seri, diafra,dialiq)
2133	DO k = 1, klev
2134	DO i = 1, klon
2135	IF (diafra(i,k).GT.cldfra(i,k)) THEN
2136	cldliq(i,k) = dialiq(i,k)
2137	cldfra(i,k) = diafra(i,k)
2138	ENDIF
2139	ENDDO
2140	ENDDO
2141	ENDIF
2142	c
2143	c Precipitation totale
2144	c
2145	DO i = 1, klon
2146	rain_fall(i) = rain_con(i) + rain_lsc(i)
2147	snow_fall(i) = snow_con(i) + snow_lsc(i)
2148	ENDDO
2149	c
2150	c Calculer l'humidite relative pour diagnostique
2151	c
2152	DO k = 1, klev
2153	DO i = 1, klon
2154	zx_t = t_seri(i,k)
2155	IF (thermcep) THEN
2156	zdelta = MAX(0.,SIGN(1.,rtt-zx_t))
2157	zx_qs = r2es * FOEEW(zx_t,zdelta)/pplay(i,k)
2158	zx_qs = MIN(0.5,zx_qs)
2159	zcor = 1./(1.-retv*zx_qs)
2160	zx_qs = zx_qs*zcor
2161	ELSE
2162	IF (zx_t.LT.t_coup) THEN
2163	zx_qs = qsats(zx_t)/pplay(i,k)
2164	ELSE
2165	zx_qs = qsatl(zx_t)/pplay(i,k)
2166	ENDIF
2167	ENDIF
2168	zx_rh(i,k) = q_seri(i,k)/zx_qs
2169	ENDDO
2170	ENDDO
2171	c
2172	c Calculer les parametres optiques des nuages et quelques
2173	c parametres pour diagnostiques:
2174	c
2175	CALL nuage (paprs, pplay,
2176	. t_seri, cldliq, cldfra, cldtau, cldemi,
2177	. cldh, cldl, cldm, cldt, cldq)
2178	c
2179	c Appeler le rayonnement mais calculer tout d'abord l'albedo du sol.
2180	c
2181	IF (MOD(itaprad,radpas).EQ.0) THEN
2182	DO i = 1, klon
2183	albsol(i) = falbe(i,is_oce) * pctsrf(i,is_oce)
2184	. + falbe(i,is_lic) * pctsrf(i,is_lic)
2185	. + falbe(i,is_ter) * pctsrf(i,is_ter)
2186	. + falbe(i,is_sic) * pctsrf(i,is_sic)
2187	albsollw(i) = falblw(i,is_oce) * pctsrf(i,is_oce)
2188	. + falblw(i,is_lic) * pctsrf(i,is_lic)
2189	. + falblw(i,is_ter) * pctsrf(i,is_ter)
2190	. + falblw(i,is_sic) * pctsrf(i,is_sic)
2191	ENDDO
2192	! if (debut) then
2193	! albsol1 = albsol
2194	! albsollw1 = albsollw
2195	! endif
2196	! albsol = albsol1
2197	! albsollw = albsollw1
2198	CALL radlwsw ! nouveau rayonnement (compatible Arpege-IFS)
2199	e (dist, rmu0, fract, co2_ppm, solaire,
2200	e paprs, pplay,zxtsol,albsol, albsollw, t_seri,q_seri,
2201	e wo,
2202	e cldfra, cldemi, cldtau,
2203	s heat,heat0,cool,cool0,radsol,albpla,
2204	s topsw,toplw,solsw,sollw,
2205	s sollwdown,
2206	s topsw0,toplw0,solsw0,sollw0)
2207	itaprad = 0
2208	ENDIF
2209	itaprad = itaprad + 1
2210	c
2211	c Ajouter la tendance des rayonnements (tous les pas)
2212	c
2213	DO k = 1, klev
2214	DO i = 1, klon
2215	t_seri(i,k) = t_seri(i,k)
2216	. + (heat(i,k)-cool(i,k)) * dtime/86400.
2217	ENDDO
2218	ENDDO
2219	c
2220	c Calculer l'hydrologie de la surface
2221	c
2222	c CALL hydrol(dtime,pctsrf,rain_fall, snow_fall, zxevap,
2223	c . agesno, ftsol,fqsol,fsnow, ruis)
2224	c
2225	DO i = 1, klon
2226	zxqsol(i) = 0.0
2227	zxsnow(i) = 0.0
2228	ENDDO
2229	DO nsrf = 1, nbsrf
2230	DO i = 1, klon
2231	zxqsol(i) = zxqsol(i) + fqsol(i,nsrf)*pctsrf(i,nsrf)
2232	zxsnow(i) = zxsnow(i) + fsnow(i,nsrf)*pctsrf(i,nsrf)
2233	ENDDO
2234	ENDDO
2235	c
2236	c Si une sous-fraction n'existe pas, elle prend la valeur moyenne
2237	c
2238	c$$$ DO nsrf = 1, nbsrf
2239	c$$$ DO i = 1, klon
2240	c$$$ IF (pctsrf(i,nsrf).LT.epsfra) THEN
2241	c$$$ fqsol(i,nsrf) = zxqsol(i)
2242	c$$$ fsnow(i,nsrf) = zxsnow(i)
2243	c$$$ ENDIF
2244	c$$$ ENDDO
2245	c$$$ ENDDO
2246	c
2247	c Calculer le bilan du sol et la derive de temperature (couplage)
2248	c
2249	DO i = 1, klon
2250	bils(i) = radsol(i) - sens(i) - evap(i)*RLVTT
2251	ENDDO
2252	c
2253	cmoddeblott(jan95)
2254	c Appeler le programme de parametrisation de l'orographie
2255	c a l'echelle sous-maille:
2256	c
2257	IF (ok_orodr) THEN
2258	c
2259	c selection des points pour lesquels le shema est actif:
2260	igwd=0
2261	DO i=1,klon
2262	itest(i)=0
2263	c IF ((zstd(i).gt.10.0)) THEN
2264	IF (((zpic(i)-zmea(i)).GT.100.).AND.(zstd(i).GT.10.0)) THEN
2265	itest(i)=1
2266	igwd=igwd+1
2267	idx(igwd)=i
2268	ENDIF
2269	ENDDO
2270	c igwdim=MAX(1,igwd)
2271	c
2272	CALL drag_noro(klon,klev,dtime,paprs,pplay,
2273	e zmea,zstd, zsig, zgam, zthe,zpic,zval,
2274	e igwd,idx,itest,
2275	e t_seri, u_seri, v_seri,
2276	s zulow, zvlow, zustr, zvstr,
2277	s d_t_oro, d_u_oro, d_v_oro)
2278	c
2279	c ajout des tendances
2280	DO k = 1, klev
2281	DO i = 1, klon
2282	t_seri(i,k) = t_seri(i,k) + d_t_oro(i,k)
2283	u_seri(i,k) = u_seri(i,k) + d_u_oro(i,k)
2284	v_seri(i,k) = v_seri(i,k) + d_v_oro(i,k)
2285	ENDDO
2286	ENDDO
2287	c
2288	ENDIF ! fin de test sur ok_orodr
2289	c
2290	IF (ok_orolf) THEN
2291	c
2292	c selection des points pour lesquels le shema est actif:
2293	igwd=0
2294	DO i=1,klon
2295	itest(i)=0
2296	IF ((zpic(i)-zmea(i)).GT.100.) THEN
2297	itest(i)=1
2298	igwd=igwd+1
2299	idx(igwd)=i
2300	ENDIF
2301	ENDDO
2302	c igwdim=MAX(1,igwd)
2303	c
2304	CALL lift_noro(klon,klev,dtime,paprs,pplay,
2305	e rlat,zmea,zstd,zpic,
2306	e itest,
2307	e t_seri, u_seri, v_seri,
2308	s zulow, zvlow, zustr, zvstr,
2309	s d_t_lif, d_u_lif, d_v_lif)
2310	c
2311	c ajout des tendances
2312	DO k = 1, klev
2313	DO i = 1, klon
2314	t_seri(i,k) = t_seri(i,k) + d_t_lif(i,k)
2315	u_seri(i,k) = u_seri(i,k) + d_u_lif(i,k)
2316	v_seri(i,k) = v_seri(i,k) + d_v_lif(i,k)
2317	ENDDO
2318	ENDDO
2319	c
2320	ENDIF ! fin de test sur ok_orolf
2321	c
2322	cAA
2323	cAA Installation de l'interface online-offline pour traceurs
2324	cAA
2325	c====================================================================
2326	c Calcul des tendances traceurs
2327	c====================================================================
2328	C Pascale : il faut quand meme apeller phytrac car il gere les sorties
2329	cKE43 des traceurs => il faut donc mettre des flags a .false.
2330	IF (iflag_con.GE.3) THEN
2331	c on ajoute les tendances calculees par KE43
2332	c$$$ OM on onhibe la convection sur les traceurs
2333	DO iq=1, nqmax-2 ! Sandrine a -3 ???
2334	c$$$ OM on inhibe la convection sur les traceur
2335	c$$$ DO k = 1, nlev
2336	c$$$ DO i = 1, klon
2337	c$$$ tr_seri(i,k,iq) = tr_seri(i,k,iq) + d_tr(i,k,iq)
2338	c$$$ ENDDO
2339	c$$$ ENDDO
2340	WRITE(iqn,'(i2.2)') iq
2341	CALL minmaxqfi(tr_seri(1,1,iq),0.,1.e33,'couche lim iq='//iqn)
2342	ENDDO
2343	CMAF modif pour garder info du nombre de traceurs auxquels
2344	C la physique s'applique
2345	ELSE
2346	CMAF modif pour garder info du nombre de traceurs auxquels
2347	C la physique s'applique
2348	C
2349	call phytrac (rnpb,
2350	I debut,lafin,
2351	I nqmax-2,
2352	I nlon,nlev,dtime,
2353	I t,paprs,pplay,
2354	I pmfu, pmfd, pen_u, pde_u, pen_d, pde_d,
2355	I ycoefh,yu1,yv1,ftsol,pctsrf,rlat,
2356	I frac_impa, frac_nucl,
2357	I rlon,presnivs,paire,pphis,
2358	O tr_seri)
2359	ENDIF
2360
2361	IF (offline) THEN
2362
2363	call phystokenc (
2364	I nlon,nlev,pdtphys,rlon,rlat,
2365	I t,pmfu, pmfd, pen_u, pde_u, pen_d, pde_d,
2366	I ycoefh,yu1,yv1,ftsol,pctsrf,
2367	I frac_impa, frac_nucl,
2368	I pphis,paire,dtime,itap)
2369
2370
2371	ENDIF
2372
2373	c
2374	c Calculer le transport de l'eau et de l'energie (diagnostique)
2375	c
2376	CALL transp (paprs,zxtsol,
2377	e t_seri, q_seri, u_seri, v_seri, zphi,
2378	s ve, vq, ue, uq)
2379	c
2380	c Accumuler les variables a stocker dans les fichiers histoire:
2381	c
2382	c
2383	c
2384
2385	IF (ok_journe) THEN
2386	c
2387	ndex2d = 0
2388	ndex3d = 0
2389	c
2390	c Champs 2D:
2391	c
2392	zsto = dtime
2393	zout = dtime * FLOAT(ecrit_day)
2394
2395	i = NINT(zout/zsto)
2396	CALL gr_fi_ecrit(1,klon,iim,jjmp1,pphis,zx_tmp_2d)
2397	CALL histwrite(nid_day,"phis",i,zx_tmp_2d,iim*jjmp1,ndex2d)
2398	varname = 'phis'
2399	vartitle= 'Surface geop. height'
2400	varunits= '-'
2401	c call writephy(fid_day,prof2d_on,varname,pphis,vartitle,
2402	c . varunits)
2403	c
2404	i = NINT(zout/zsto)
2405	CALL gr_fi_ecrit(1,klon,iim,jjmp1,paire,zx_tmp_2d)
2406	CALL histwrite(nid_day,"aire",i,zx_tmp_2d,iim*jjmp1,ndex2d)
2407	varname = 'aire'
2408	vartitle= 'Grid area'
2409	varunits= '-'
2410	c call writephy(fid_day,prof2d_on,varname,paire,vartitle,
2411	c . varunits)
2412	C
2413	CALL gr_fi_ecrit(1, klon,iim,jjmp1, zxtsol,zx_tmp_2d)
2414	CALL histwrite(nid_day,"tsol",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2415	c call writephy(fid_day,prof2d_av,'tsol',zxtsol,
2416	c . 'Surface Temperature','K')
2417	c
2418	C
2419	zx_tmp_fi2d(1 : klon) = ftsol(1 : klon, is_ter)
2420	CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d ,zx_tmp_2d)
2421	CALL histwrite(nid_day,"tter",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2422	c call writephy(fid_day,prof2d_av,'tter',ftsol(1 : klon, is_ter),
2423	c . 'Surface Temperature','K')
2424	C
2425	zx_tmp_fi2d(1 : klon) = ftsol(1 : klon, is_lic)
2426	CALL gr_fi_ecrit(1, klon,iim,jjmp1, zxtsol,zx_tmp_2d)
2427	CALL histwrite(nid_day,"tlic",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2428	c call writephy(fid_day,prof2d_av,'tlic',ftsol(1 : klon, is_lic),
2429	c . 'Surface Temperature','K')
2430	C
2431	zx_tmp_fi2d(1 : klon) = ftsol(1 : klon, is_oce)
2432	CALL gr_fi_ecrit(1, klon,iim,jjmp1, zxtsol,zx_tmp_2d)
2433	CALL histwrite(nid_day,"toce",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2434	c call writephy(fid_day,prof2d_av,'toce',ftsol(1 : klon, is_oce),
2435	c . 'Surface Temperature','K')
2436	C
2437	zx_tmp_fi2d(1 : klon) = ftsol(1 : klon, is_sic)
2438	CALL gr_fi_ecrit(1, klon,iim,jjmp1, zxtsol,zx_tmp_2d)
2439	CALL histwrite(nid_day,"tsic",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2440	c call writephy(fid_day,prof2d_av,'tsic',ftsol(1 : klon, is_sic),
2441	c . 'Surface Temperature','K')
2442	C
2443	DO i = 1, klon
2444	zx_tmp_fi2d(i) = paprs(i,1)
2445	ENDDO
2446	CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d,zx_tmp_2d)
2447	CALL histwrite(nid_day,"psol",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2448	c Essai writephys
2449	varname = 'psol'
2450	vartitle= 'pression au sol'
2451	varunits= 'hPa'
2452	c call writephy(fid_day,prof2d_av,varname,zx_tmp_fi2d,vartitle,
2453	c . varunits)
2454	c
2455	DO i = 1, klon
2456	zx_tmp_fi2d(i) = (rain_fall(i) + snow_fall(i))* 86400.
2457	ENDDO
2458	CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d,zx_tmp_2d)
2459	CALL histwrite(nid_day,"rain",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2460	c call writephy(fid_day,prof2d_av,'rain',zx_tmp_fi2d,
2461	c . 'Precipitation','mm/day')
2462
2463
2464	c
2465	CALL gr_fi_ecrit(1, klon,iim,jjmp1, snow_fall,zx_tmp_2d)
2466	CALL histwrite(nid_day,"snow",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2467	c call writephy(fid_day,prof2d_av,'snow',snow_fall,
2468	c . 'Snow','mm/day')
2469	c
2470	CALL gr_fi_ecrit(1, klon,iim,jjmp1, zxsnow,zx_tmp_2d)
2471	CALL histwrite(nid_day,"snow_cov",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2472	c call writephy(fid_day,prof2d_av,'snow_cov',zxsnow,
2473	c . 'Snow cover','mm')
2474	c
2475	CALL gr_fi_ecrit(1, klon,iim,jjmp1, evap,zx_tmp_2d)
2476	CALL histwrite(nid_day,"evap",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2477	c call writephy(fid_day,prof2d_av,'evap',evap,
2478	c . 'Evaporation','mm/day')
2479	c
2480	CALL gr_fi_ecrit(1, klon,iim,jjmp1, topsw,zx_tmp_2d)
2481	CALL histwrite(nid_day,"tops",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2482	c call writephy(fid_day,prof2d_av,'tops',topsw,
2483	c . 'Solar rad. at TOA','W/m2')
2484	c
2485	CALL gr_fi_ecrit(1, klon,iim,jjmp1, toplw,zx_tmp_2d)
2486	CALL histwrite(nid_day,"topl",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2487	c call writephy(fid_day,prof2d_av,'topl',toplw,
2488	c . 'IR rad. at TOA','W/m2')
2489	c
2490	CALL gr_fi_ecrit(1, klon,iim,jjmp1, solsw,zx_tmp_2d)
2491	CALL histwrite(nid_day,"sols",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2492	c call writephy(fid_day,prof2d_av,'sols',solsw,
2493	c . 'Solar rad. at surf.','W/m2')
2494	c
2495	CALL gr_fi_ecrit(1, klon,iim,jjmp1, sollw,zx_tmp_2d)
2496	CALL histwrite(nid_day,"soll",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2497	c call writephy(fid_day,prof2d_av,'soll',sollw,
2498	c . 'IR rad. at surface','W/m2')
2499	c
2500	CALL gr_fi_ecrit(1, klon,iim,jjmp1, sollwdown,zx_tmp_2d)
2501	CALL histwrite(nid_day,"solldown",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2502	c call writephy(fid_day,prof2d_av,'solldown',sollwdown,
2503	c . 'Down. IR rad. at surface','W/m2')
2504	c
2505	CALL gr_fi_ecrit(1, klon,iim,jjmp1, bils,zx_tmp_2d)
2506	CALL histwrite(nid_day,"bils",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2507	c call writephy(fid_day,prof2d_av,'bils',bils,
2508	c . 'Surf. total heat flux','W/m2')
2509	c
2510	CALL gr_fi_ecrit(1, klon,iim,jjmp1, sens,zx_tmp_2d)
2511	CALL histwrite(nid_day,"sens",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2512	c call writephy(fid_day,prof2d_av,'sens',sens,
2513	c . 'Sensible heat flux','W/m2')
2514	c
2515	CALL gr_fi_ecrit(1, klon,iim,jjmp1, fder,zx_tmp_2d)
2516	CALL histwrite(nid_day,"fder",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2517	c call writephy(fid_day,prof2d_av,'fder',fder,
2518	c . 'Heat flux derivation','W/m2')
2519	c
2520	c
2521	DO nsrf = 1, nbsrf
2522	C§§§
2523	zx_tmp_fi2d(1 : klon) = pctsrf( 1 : klon, nsrf)
2524	CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d , zx_tmp_2d)
2525	CALL histwrite(nid_day,"pourc_"//clnsurf(nsrf),itap,
2526	$ zx_tmp_2d,iim*jjmp1,ndex2d)
2527	c call writephy(fid_day,prof2d_av,'pourc_'//clnsurf(nsrf),
2528	c . pctsrf( 1 : klon, nsrf),
2529	c . 'Fraction'//clnsurf(nsrf),'-')
2530	C
2531	zx_tmp_fi2d(1 : klon) = ftsol( 1 : klon, nsrf)
2532	CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d , zx_tmp_2d)
2533	CALL histwrite(nid_day,"tsol_"//clnsurf(nsrf),itap,
2534	$ zx_tmp_2d,iim*jjmp1,ndex2d)
2535	c call writephy(fid_day,prof2d_av,'tsol_'//clnsurf(nsrf),
2536	c . ftsol( 1 : klon, nsrf),
2537	c . 'Surf. Temp'//clnsurf(nsrf),'K')
2538	C
2539	zx_tmp_fi2d(1 : klon) = fluxt( 1 : klon, 1, nsrf)
2540	CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d , zx_tmp_2d)
2541	CALL histwrite(nid_day,"sens_"//clnsurf(nsrf),itap,
2542	$ zx_tmp_2d,iim*jjmp1,ndex2d)
2543	c call writephy(fid_day,prof2d_av,'sens_'//clnsurf(nsrf),
2544	c . fluxt( 1 : klon, 1, nsrf),
2545	c . 'Sensible heat flux '//clnsurf(nsrf),'W/m2')
2546	C
2547	zx_tmp_fi2d(1 : klon) = fluxlat( 1 : klon, nsrf)
2548	CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d , zx_tmp_2d)
2549	CALL histwrite(nid_day,"lat_"//clnsurf(nsrf),itap,
2550	$ zx_tmp_2d,iim*jjmp1,ndex2d)
2551	c call writephy(fid_day,prof2d_av,'lat_'//clnsurf(nsrf),
2552	c . fluxlat( 1 : klon, nsrf),
2553	c . 'Latent heat flux '//clnsurf(nsrf),'W/m2')
2554	C
2555	zx_tmp_fi2d(1 : klon) = fluxu( 1 : klon, 1, nsrf)
2556	CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d , zx_tmp_2d)
2557	CALL histwrite(nid_day,"taux_"//clnsurf(nsrf),itap,
2558	$ zx_tmp_2d,iim*jjmp1,ndex2d)
2559	c call writephy(fid_day,prof2d_av,'taux_'//clnsurf(nsrf),
2560	c . fluxu( 1 : klon, 1, nsrf),
2561	c . 'Zonal wind stress '//clnsurf(nsrf),'Pa')
2562	C
2563	zx_tmp_fi2d(1 : klon) = fluxv( 1 : klon, 1, nsrf)
2564	CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d , zx_tmp_2d)
2565	CALL histwrite(nid_day,"tauy_"//clnsurf(nsrf),itap,
2566	$ zx_tmp_2d,iim*jjmp1,ndex2d)
2567	c call writephy(fid_day,prof2d_av,'tauy_'//clnsurf(nsrf),
2568	c . fluxv( 1 : klon, 1, nsrf),
2569	c . 'Meridional wind stress '//clnsurf(nsrf),'Pa')
2570	C
2571	zx_tmp_fi2d(1 : klon) = falbe( 1 : klon, nsrf)
2572	CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d , zx_tmp_2d)
2573	CALL histwrite(nid_day,"albe_"//clnsurf(nsrf),itap,
2574	$ zx_tmp_2d,iim*jjmp1,ndex2d)
2575	c call writephy(fid_day,prof2d_av,'albe_'//clnsurf(nsrf),
2576	c . falbe( 1 : klon, nsrf),
2577	c . 'Albedo surf. SW'//clnsurf(nsrf),'-')
2578	c call writephy(fid_day,prof2d_av,'alblw_'//clnsurf(nsrf),
2579	c . falblw( 1 : klon, nsrf),
2580	c . 'Albedo surf. LW'//clnsurf(nsrf),'-')
2581	C
2582	zx_tmp_fi2d(1 : klon) = frugs( 1 : klon, nsrf)
2583	CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d , zx_tmp_2d)
2584	CALL histwrite(nid_day,"rugs_"//clnsurf(nsrf),itap,
2585	$ zx_tmp_2d,iim*jjmp1,ndex2d)
2586	c call writephy(fid_day,prof2d_av,'rugs_'//clnsurf(nsrf),
2587	c . frugs( 1 : klon, nsrf),
2588	c . 'Rugosity '//clnsurf(nsrf),' - ')
2589	C
2590	END DO
2591	C
2592	c$$$ DO i = 1, klon
2593	c$$$ zx_tmp_fi2d(i) = pctsrf(i,is_sic)
2594	c$$$ ENDDO
2595	c$$$ CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d,zx_tmp_2d)
2596	c$$$ CALL histwrite(nid_day,"sicf",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2597	c
2598	CALL gr_fi_ecrit(1, klon,iim,jjmp1, cldl,zx_tmp_2d)
2599	CALL histwrite(nid_day,"cldl",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2600	c call writephy(fid_day,prof2d_av,'cldl',cldl,
2601	c . 'Low-level cloudiness','-')
2602	c
2603	CALL gr_fi_ecrit(1, klon,iim,jjmp1, cldm,zx_tmp_2d)
2604	CALL histwrite(nid_day,"cldm",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2605	c call writephy(fid_day,prof2d_av,'cldm',cldm,
2606	c . 'Mid-level cloudiness','-')
2607	c
2608	CALL gr_fi_ecrit(1, klon,iim,jjmp1, cldh,zx_tmp_2d)
2609	CALL histwrite(nid_day,"cldh",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2610	c call writephy(fid_day,prof2d_av,'cldh',cldh,
2611	c . 'High-level cloudiness','-')
2612	c
2613	CALL gr_fi_ecrit(1, klon,iim,jjmp1, cldt,zx_tmp_2d)
2614	CALL histwrite(nid_day,"cldt",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2615	c call writephy(fid_day,prof2d_av,'cldt',cldt,
2616	c . 'Total cloudiness','-')
2617	c
2618	CALL gr_fi_ecrit(1, klon,iim,jjmp1, cldq,zx_tmp_2d)
2619	CALL histwrite(nid_day,"cldq",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2620	c call writephy(fid_day,prof2d_av,'cldq',cldq,
2621	c . 'Cloud liquid water path','-')
2622	c
2623	c Champs 3D:
2624	c
2625	CALL gr_fi_ecrit(klev,klon,iim,jjmp1, t_seri, zx_tmp_3d)
2626	CALL histwrite(nid_day,"temp",itap,zx_tmp_3d,
2627	. iimjjmp1klev,ndex3d)
2628	c Essai writephys
2629	varname = 'temp'
2630	vartitle= 'temperature 3D'
2631	varunits= 'K'
2632	c call writephy(fid_day,prof3d_av,varname,t_seri,vartitle,varunits)
2633	c
2634	CALL gr_fi_ecrit(klev,klon,iim,jjmp1, qx(1,1,ivap), zx_tmp_3d)
2635	CALL histwrite(nid_day,"ovap",itap,zx_tmp_3d,
2636	. iimjjmp1klev,ndex3d)
2637	c call writephy(fid_day,prof3d_av,'ovap',qx(1,1,ivap),
2638	c . 'Specific humidity','Kg/Kg')
2639	c
2640	CALL gr_fi_ecrit(klev,klon,iim,jjmp1, zphi, zx_tmp_3d)
2641	CALL histwrite(nid_day,"geop",itap,zx_tmp_3d,
2642	. iimjjmp1klev,ndex3d)
2643	c call writephy(fid_day,prof3d_av,'geop',zphi,
2644	c . 'Geopotential height','m')
2645	c
2646	CALL gr_fi_ecrit(klev,klon,iim,jjmp1, u_seri, zx_tmp_3d)
2647	CALL histwrite(nid_day,"vitu",itap,zx_tmp_3d,
2648	. iimjjmp1klev,ndex3d)
2649	c call writephy(fid_day,prof3d_av,'vitu',u_seri,
2650	c . 'Zonal wind','m/s')
2651	c
2652	CALL gr_fi_ecrit(klev,klon,iim,jjmp1, v_seri, zx_tmp_3d)
2653	CALL histwrite(nid_day,"vitv",itap,zx_tmp_3d,
2654	. iimjjmp1klev,ndex3d)
2655	c call writephy(fid_day,prof3d_av,'vitv',v_seri,
2656	c . 'Meridional wind','m/s')
2657	c
2658	CALL gr_fi_ecrit(klev,klon,iim,jjmp1, omega, zx_tmp_3d)
2659	CALL histwrite(nid_day,"vitw",itap,zx_tmp_3d,
2660	. iimjjmp1klev,ndex3d)
2661	c call writephy(fid_day,prof3d_av,'vitw',omega,
2662	c . 'Vertical wind','m/s')
2663	c
2664	CALL gr_fi_ecrit(klev,klon,iim,jjmp1, pplay, zx_tmp_3d)
2665	CALL histwrite(nid_day,"pres",itap,zx_tmp_3d,
2666	. iimjjmp1klev,ndex3d)
2667	c call writephy(fid_day,prof3d_av,'pres',pplay,
2668	c . 'Air pressure','Pa')
2669
2670	c
2671	if (ok_sync) then
2672	c call writephy_sync(fid_day)
2673	call histsync(nid_day)
2674	endif
2675	ENDIF
2676	C
2677	IF (ok_mensuel) THEN
2678	c
2679	ndex2d = 0
2680	ndex3d = 0
2681	c
2682	c Champs 2D:
2683	c
2684	zsto = dtime
2685	zout = dtime * ecrit_mth
2686
2687	i = NINT(zout/zsto)
2688	CALL gr_fi_ecrit(1,klon,iim,jjmp1,pphis,zx_tmp_2d)
2689	CALL histwrite(nid_mth,"phis",i,zx_tmp_2d,iim*jjmp1,ndex2d)
2690	C
2691	i = NINT(zout/zsto)
2692	CALL gr_fi_ecrit(1,klon,iim,jjmp1,paire,zx_tmp_2d)
2693	CALL histwrite(nid_mth,"aire",i,zx_tmp_2d,iim*jjmp1,ndex2d)
2694
2695	CALL gr_fi_ecrit(1, klon,iim,jjmp1, zxtsol,zx_tmp_2d)
2696	CALL histwrite(nid_mth,"tsol",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2697	c
2698	DO i = 1, klon
2699	zx_tmp_fi2d(i) = paprs(i,1)
2700	ENDDO
2701	CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d,zx_tmp_2d)
2702	CALL histwrite(nid_mth,"psol",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2703	c
2704	CALL gr_fi_ecrit(1, klon,iim,jjmp1, zxqsol,zx_tmp_2d)
2705	CALL histwrite(nid_mth,"qsol",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2706	c
2707	DO i = 1, klon
2708	zx_tmp_fi2d(i) = rain_fall(i) + snow_fall(i)
2709	ENDDO
2710	CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d,zx_tmp_2d)
2711	CALL histwrite(nid_mth,"rain",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2712	c
2713	DO i = 1, klon
2714	zx_tmp_fi2d(i) = rain_lsc(i) + snow_lsc(i)
2715	ENDDO
2716	CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d,zx_tmp_2d)
2717	CALL histwrite(nid_mth,"plul",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2718	c
2719	DO i = 1, klon
2720	zx_tmp_fi2d(i) = rain_con(i) + snow_con(i)
2721	ENDDO
2722	CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d,zx_tmp_2d)
2723	CALL histwrite(nid_mth,"pluc",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2724	c
2725	CALL gr_fi_ecrit(1, klon,iim,jjmp1, snow_fall,zx_tmp_2d)
2726	CALL histwrite(nid_mth,"snow",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2727	c
2728	CALL gr_fi_ecrit(1, klon,iim,jjmp1, zxsnow,zx_tmp_2d)
2729	CALL histwrite(nid_mth,"snow_cov",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2730	c
2731	CALL gr_fi_ecrit(1, klon,iim,jjmp1, evap,zx_tmp_2d)
2732	CALL histwrite(nid_mth,"evap",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2733	c
2734	CALL gr_fi_ecrit(1, klon,iim,jjmp1, topsw,zx_tmp_2d)
2735	CALL histwrite(nid_mth,"tops",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2736	c
2737	CALL gr_fi_ecrit(1, klon,iim,jjmp1, toplw,zx_tmp_2d)
2738	CALL histwrite(nid_mth,"topl",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2739	c
2740	CALL gr_fi_ecrit(1, klon,iim,jjmp1, solsw,zx_tmp_2d)
2741	CALL histwrite(nid_mth,"sols",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2742	c
2743	CALL gr_fi_ecrit(1, klon,iim,jjmp1, sollw,zx_tmp_2d)
2744	CALL histwrite(nid_mth,"soll",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2745	c
2746	CALL gr_fi_ecrit(1, klon,iim,jjmp1, sollwdown,zx_tmp_2d)
2747	CALL histwrite(nid_mth,"solldown",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2748	c
2749	CALL gr_fi_ecrit(1, klon,iim,jjmp1, topsw0,zx_tmp_2d)
2750	CALL histwrite(nid_mth,"tops0",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2751	c
2752	CALL gr_fi_ecrit(1, klon,iim,jjmp1, toplw0,zx_tmp_2d)
2753	CALL histwrite(nid_mth,"topl0",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2754	c
2755	CALL gr_fi_ecrit(1, klon,iim,jjmp1, solsw0,zx_tmp_2d)
2756	CALL histwrite(nid_mth,"sols0",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2757	c
2758	CALL gr_fi_ecrit(1, klon,iim,jjmp1, sollw0,zx_tmp_2d)
2759	CALL histwrite(nid_mth,"soll0",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2760	c
2761	CALL gr_fi_ecrit(1, klon,iim,jjmp1, bils,zx_tmp_2d)
2762	CALL histwrite(nid_mth,"bils",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2763	c
2764	CALL gr_fi_ecrit(1, klon,iim,jjmp1, sens,zx_tmp_2d)
2765	CALL histwrite(nid_mth,"sens",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2766	c
2767	CALL gr_fi_ecrit(1, klon,iim,jjmp1, fder,zx_tmp_2d)
2768	CALL histwrite(nid_mth,"fder",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2769	c
2770	c
2771	c DO i = 1, klon
2772	c zx_tmp_fi2d(i) = fluxu(i,1)
2773	c ENDDO
2774	c CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d,zx_tmp_2d)
2775	c CALL histwrite(nid_mth,"frtu",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2776	c
2777	c DO i = 1, klon
2778	c zx_tmp_fi2d(i) = fluxv(i,1)
2779	c ENDDO
2780	c CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d,zx_tmp_2d)
2781	c CALL histwrite(nid_mth,"frtv",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2782	c
2783	DO nsrf = 1, nbsrf
2784	C§§§
2785	zx_tmp_fi2d(1 : klon) = pctsrf( 1 : klon, nsrf)
2786	CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d , zx_tmp_2d)
2787	CALL histwrite(nid_mth,"pourc_"//clnsurf(nsrf),itap,
2788	$ zx_tmp_2d,iim*jjmp1,ndex2d)
2789	C
2790	zx_tmp_fi2d(1 : klon) = ftsol( 1 : klon, nsrf)
2791	CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d , zx_tmp_2d)
2792	CALL histwrite(nid_mth,"tsol_"//clnsurf(nsrf),itap,
2793	$ zx_tmp_2d,iim*jjmp1,ndex2d)
2794	C
2795	zx_tmp_fi2d(1 : klon) = fluxt( 1 : klon, 1, nsrf)
2796	CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d , zx_tmp_2d)
2797	CALL histwrite(nid_mth,"sens_"//clnsurf(nsrf),itap,
2798	$ zx_tmp_2d,iim*jjmp1,ndex2d)
2799	C
2800	zx_tmp_fi2d(1 : klon) = fluxlat( 1 : klon, nsrf)
2801	CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d , zx_tmp_2d)
2802	CALL histwrite(nid_mth,"lat_"//clnsurf(nsrf),itap,
2803	$ zx_tmp_2d,iim*jjmp1,ndex2d)
2804	C
2805	zx_tmp_fi2d(1 : klon) = fluxu( 1 : klon, 1, nsrf)
2806	CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d , zx_tmp_2d)
2807	CALL histwrite(nid_mth,"taux_"//clnsurf(nsrf),itap,
2808	$ zx_tmp_2d,iim*jjmp1,ndex2d)
2809	C
2810	zx_tmp_fi2d(1 : klon) = fluxv( 1 : klon, 1, nsrf)
2811	CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d , zx_tmp_2d)
2812	CALL histwrite(nid_mth,"tauy_"//clnsurf(nsrf),itap,
2813	$ zx_tmp_2d,iim*jjmp1,ndex2d)
2814	C
2815	zx_tmp_fi2d(1 : klon) = falbe( 1 : klon, nsrf)
2816	CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d , zx_tmp_2d)
2817	CALL histwrite(nid_mth,"albe_"//clnsurf(nsrf),itap,
2818	$ zx_tmp_2d,iim*jjmp1,ndex2d)
2819	C
2820	zx_tmp_fi2d(1 : klon) = frugs( 1 : klon, nsrf)
2821	CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d , zx_tmp_2d)
2822	CALL histwrite(nid_mth,"rugs_"//clnsurf(nsrf),itap,
2823	$ zx_tmp_2d,iim*jjmp1,ndex2d)
2824	c
2825	zx_tmp_fi2d(1 : klon) = agesno( 1 : klon, nsrf)
2826	CALL gr_fi_ecrit(1, klon,iim,jjmp1, agesno,zx_tmp_2d)
2827	CALL histwrite(nid_mth,"ages_"//clnsurf(nsrf),itap
2828	$ ,zx_tmp_2d,iim*jjmp1,ndex2d)
2829
2830	END DO
2831	c$$$ DO i = 1, klon
2832	c$$$ zx_tmp_fi2d(i) = pctsrf(i,is_sic)
2833	c$$$ ENDDO
2834	c$$$ CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d,zx_tmp_2d)
2835	c$$$ CALL histwrite(nid_mth,"sicf",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2836	c
2837	CALL gr_fi_ecrit(1, klon,iim,jjmp1, albsol,zx_tmp_2d)
2838	CALL histwrite(nid_mth,"albs",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2839	CALL gr_fi_ecrit(1, klon,iim,jjmp1, albsollw,zx_tmp_2d)
2840	CALL histwrite(nid_mth,"albslw",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2841	c
2842	CALL gr_fi_ecrit(1, klon,iim,jjmp1, cdragm,zx_tmp_2d)
2843	CALL histwrite(nid_mth,"cdrm",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2844	c
2845	CALL gr_fi_ecrit(1, klon,iim,jjmp1, cdragh,zx_tmp_2d)
2846	CALL histwrite(nid_mth,"cdrh",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2847	c
2848	CALL gr_fi_ecrit(1, klon,iim,jjmp1, cldl,zx_tmp_2d)
2849	CALL histwrite(nid_mth,"cldl",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2850	c
2851	CALL gr_fi_ecrit(1, klon,iim,jjmp1, cldm,zx_tmp_2d)
2852	CALL histwrite(nid_mth,"cldm",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2853	c
2854	CALL gr_fi_ecrit(1, klon,iim,jjmp1, cldh,zx_tmp_2d)
2855	CALL histwrite(nid_mth,"cldh",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2856	c
2857	CALL gr_fi_ecrit(1, klon,iim,jjmp1, cldt,zx_tmp_2d)
2858	CALL histwrite(nid_mth,"cldt",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2859	c
2860	CALL gr_fi_ecrit(1, klon,iim,jjmp1, cldq,zx_tmp_2d)
2861	CALL histwrite(nid_mth,"cldq",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2862	c
2863	CALL gr_fi_ecrit(1, klon,iim,jjmp1, ue,zx_tmp_2d)
2864	CALL histwrite(nid_mth,"ue",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2865	c
2866	CALL gr_fi_ecrit(1, klon,iim,jjmp1, ve,zx_tmp_2d)
2867	CALL histwrite(nid_mth,"ve",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2868	c
2869	CALL gr_fi_ecrit(1, klon,iim,jjmp1, uq,zx_tmp_2d)
2870	CALL histwrite(nid_mth,"uq",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2871	c
2872	CALL gr_fi_ecrit(1, klon,iim,jjmp1, vq,zx_tmp_2d)
2873	CALL histwrite(nid_mth,"vq",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2874	cKE43
2875	IF (iflag_con .GE. 3) THEN ! sb
2876	c
2877	CALL gr_fi_ecrit(1, klon,iim,jjmp1, cape,zx_tmp_2d)
2878	CALL histwrite(nid_mth,"cape",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2879	c
2880	CALL gr_fi_ecrit(1, klon,iim,jjmp1,pbase,zx_tmp_2d)
2881	CALL histwrite(nid_mth,"pbase",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2882	c
2883	CALL gr_fi_ecrit(1, klon,iim,jjmp1,ema_pct,zx_tmp_2d)
2884	CALL histwrite(nid_mth,"ptop",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2885	c
2886	CALL gr_fi_ecrit(1, klon,iim,jjmp1,ema_cbmf,zx_tmp_2d)
2887	CALL histwrite(nid_mth,"fbase",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2888	c
2889	c
2890	ENDIF
2891	c34EK
2892	c
2893	c Champs 3D:
2894	C
2895	CALL gr_fi_ecrit(klev,klon,iim,jjmp1, t_seri, zx_tmp_3d)
2896	CALL histwrite(nid_mth,"temp",itap,zx_tmp_3d,
2897	. iimjjmp1klev,ndex3d)
2898	c
2899	CALL gr_fi_ecrit(klev,klon,iim,jjmp1, qx(1,1,ivap), zx_tmp_3d)
2900	CALL histwrite(nid_mth,"ovap",itap,zx_tmp_3d,
2901	. iimjjmp1klev,ndex3d)
2902	c
2903	CALL gr_fi_ecrit(klev,klon,iim,jjmp1, zphi, zx_tmp_3d)
2904	CALL histwrite(nid_mth,"geop",itap,zx_tmp_3d,
2905	. iimjjmp1klev,ndex3d)
2906	c
2907	CALL gr_fi_ecrit(klev,klon,iim,jjmp1, u_seri, zx_tmp_3d)
2908	CALL histwrite(nid_mth,"vitu",itap,zx_tmp_3d,
2909	. iimjjmp1klev,ndex3d)
2910	c
2911	CALL gr_fi_ecrit(klev,klon,iim,jjmp1, v_seri, zx_tmp_3d)
2912	CALL histwrite(nid_mth,"vitv",itap,zx_tmp_3d,
2913	. iimjjmp1klev,ndex3d)
2914	c
2915	CALL gr_fi_ecrit(klev,klon,iim,jjmp1, omega, zx_tmp_3d)
2916	CALL histwrite(nid_mth,"vitw",itap,zx_tmp_3d,
2917	. iimjjmp1klev,ndex3d)
2918	c
2919	CALL gr_fi_ecrit(klev,klon,iim,jjmp1, pplay, zx_tmp_3d)
2920	CALL histwrite(nid_mth,"pres",itap,zx_tmp_3d,
2921	. iimjjmp1klev,ndex3d)
2922	c
2923	CALL gr_fi_ecrit(klev,klon,iim,jjmp1, cldfra, zx_tmp_3d)
2924	CALL histwrite(nid_mth,"rneb",itap,zx_tmp_3d,
2925	. iimjjmp1klev,ndex3d)
2926	c
2927	CALL gr_fi_ecrit(klev,klon,iim,jjmp1, zx_rh, zx_tmp_3d)
2928	CALL histwrite(nid_mth,"rhum",itap,zx_tmp_3d,
2929	. iimjjmp1klev,ndex3d)
2930	c
2931	CALL gr_fi_ecrit(klev,klon,iim,jjmp1, cldliq, zx_tmp_3d)
2932	CALL histwrite(nid_mth,"oliq",itap,zx_tmp_3d,
2933	. iimjjmp1klev,ndex3d)
2934	c
2935	CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_t_dyn, zx_tmp_3d)
2936	CALL histwrite(nid_mth,"dtdyn",itap,zx_tmp_3d,
2937	. iimjjmp1klev,ndex3d)
2938	c
2939	CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_q_dyn, zx_tmp_3d)
2940	CALL histwrite(nid_mth,"dqdyn",itap,zx_tmp_3d,
2941	. iimjjmp1klev,ndex3d)
2942	c
2943	CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_t_con, zx_tmp_3d)
2944	CALL histwrite(nid_mth,"dtcon",itap,zx_tmp_3d,
2945	. iimjjmp1klev,ndex3d)
2946	c
2947	CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_q_con, zx_tmp_3d)
2948	CALL histwrite(nid_mth,"dqcon",itap,zx_tmp_3d,
2949	. iimjjmp1klev,ndex3d)
2950	c
2951	CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_t_lsc, zx_tmp_3d)
2952	CALL histwrite(nid_mth,"dtlsc",itap,zx_tmp_3d,
2953	. iimjjmp1klev,ndex3d)
2954	c
2955	CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_q_lsc, zx_tmp_3d)
2956	CALL histwrite(nid_mth,"dqlsc",itap,zx_tmp_3d,
2957	. iimjjmp1klev,ndex3d)
2958	c
2959	CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_t_vdf, zx_tmp_3d)
2960	CALL histwrite(nid_mth,"dtvdf",itap,zx_tmp_3d,
2961	. iimjjmp1klev,ndex3d)
2962	c
2963	CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_q_vdf, zx_tmp_3d)
2964	CALL histwrite(nid_mth,"dqvdf",itap,zx_tmp_3d,
2965	. iimjjmp1klev,ndex3d)
2966	c
2967	CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_t_eva, zx_tmp_3d)
2968	CALL histwrite(nid_mth,"dteva",itap,zx_tmp_3d,
2969	. iimjjmp1klev,ndex3d)
2970	c
2971	CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_q_eva, zx_tmp_3d)
2972	CALL histwrite(nid_mth,"dqeva",itap,zx_tmp_3d,
2973	. iimjjmp1klev,ndex3d)
2974	c
2975	CALL gr_fi_ecrit(klev,klon,iim,jjmp1, zpt_conv, zx_tmp_3d)
2976	CALL histwrite(nid_mth,"ptconv",itap,zx_tmp_3d,
2977	. iim(jjmp1)klev,ndex3d)
2978	c
2979	CALL gr_fi_ecrit(klev,klon,iim,jjmp1, ratqs, zx_tmp_3d)
2980	CALL histwrite(nid_mth,"ratqs",itap,zx_tmp_3d,
2981	. iim(jjmp1)klev,ndex3d)
2982	c
2983	CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_t_ajs, zx_tmp_3d)
2984	CALL histwrite(nid_mth,"dtajs",itap,zx_tmp_3d,
2985	. iimjjmp1klev,ndex3d)
2986	c
2987	CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_q_ajs, zx_tmp_3d)
2988	CALL histwrite(nid_mth,"dqajs",itap,zx_tmp_3d,
2989	. iimjjmp1klev,ndex3d)
2990	c
2991	CALL gr_fi_ecrit(klev,klon,iim,jjmp1, heat, zx_tmp_3d)
2992	CALL histwrite(nid_mth,"dtswr",itap,zx_tmp_3d,
2993	. iimjjmp1klev,ndex3d)
2994	c
2995	CALL gr_fi_ecrit(klev,klon,iim,jjmp1, heat0, zx_tmp_3d)
2996	CALL histwrite(nid_mth,"dtsw0",itap,zx_tmp_3d,
2997	. iimjjmp1klev,ndex3d)
2998	c
2999	CALL gr_fi_ecrit(klev,klon,iim,jjmp1, cool, zx_tmp_3d)
3000	CALL histwrite(nid_mth,"dtlwr",itap,zx_tmp_3d,
3001	. iimjjmp1klev,ndex3d)
3002	c
3003	CALL gr_fi_ecrit(klev,klon,iim,jjmp1, cool0, zx_tmp_3d)
3004	CALL histwrite(nid_mth,"dtlw0",itap,zx_tmp_3d,
3005	. iimjjmp1klev,ndex3d)
3006	c
3007	CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_u_vdf, zx_tmp_3d)
3008	CALL histwrite(nid_mth,"duvdf",itap,zx_tmp_3d,
3009	. iimjjmp1klev,ndex3d)
3010	c
3011	CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_v_vdf, zx_tmp_3d)
3012	CALL histwrite(nid_mth,"dvvdf",itap,zx_tmp_3d,
3013	. iimjjmp1klev,ndex3d)
3014	c
3015	IF (ok_orodr) THEN
3016	CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_u_oro, zx_tmp_3d)
3017	CALL histwrite(nid_mth,"duoro",itap,zx_tmp_3d,
3018	. iimjjmp1klev,ndex3d)
3019	c
3020	CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_v_oro, zx_tmp_3d)
3021	CALL histwrite(nid_mth,"dvoro",itap,zx_tmp_3d,
3022	. iimjjmp1klev,ndex3d)
3023	c
3024	ENDIF
3025	C
3026	IF (ok_orolf) THEN
3027	CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_u_lif, zx_tmp_3d)
3028	CALL histwrite(nid_mth,"dulif",itap,zx_tmp_3d,
3029	. iimjjmp1klev,ndex3d)
3030	c
3031	CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_v_lif, zx_tmp_3d)
3032	CALL histwrite(nid_mth,"dvlif",itap,zx_tmp_3d,
3033	. iimjjmp1klev,ndex3d)
3034	ENDIF
3035	C
3036	CALL gr_fi_ecrit(klev,klon,iim,jjmp1, wo, zx_tmp_3d)
3037	CALL histwrite(nid_mth,"ozone",itap,zx_tmp_3d,
3038	. iimjjmp1klev,ndex3d)
3039	c
3040	IF (nqmax.GE.3) THEN
3041	DO iq=1,nqmax-2
3042	IF (iq.LE.99) THEN
3043	CALL gr_fi_ecrit(klev,klon,iim,jjmp1, qx(1,1,iq+2), zx_tmp_3d)
3044	WRITE(str2,'(i2.2)') iq
3045	CALL histwrite(nid_mth,"trac"//str2,itap,zx_tmp_3d,
3046	. iimjjmp1klev,ndex3d)
3047	ELSE
3048	PRINT*, "Trop de traceurs"
3049	CALL abort
3050	ENDIF
3051	ENDDO
3052	ENDIF
3053	cKE43
3054	IF (iflag_con.GE.3) THEN ! (sb)
3055	c
3056	CALL gr_fi_ecrit(klev,klon,iim,jjmp1, upwd, zx_tmp_3d)
3057	CALL histwrite(nid_mth,"upwd",itap,zx_tmp_3d,
3058	. iimjjmp1klev,ndex3d)
3059	c
3060	CALL gr_fi_ecrit(klev,klon,iim,jjmp1, dnwd, zx_tmp_3d)
3061	CALL histwrite(nid_mth,"dnwd",itap,zx_tmp_3d,
3062	. iimjjmp1klev,ndex3d)
3063	c
3064	CALL gr_fi_ecrit(klev,klon,iim,jjmp1, dnwd0, zx_tmp_3d)
3065	CALL histwrite(nid_mth,"dnwd0",itap,zx_tmp_3d,
3066	. iimjjmp1klev,ndex3d)
3067	c
3068	CALL gr_fi_ecrit(klev,klon,iim,jjmp1, Ma, zx_tmp_3d)
3069	CALL histwrite(nid_mth,"Ma",itap,zx_tmp_3d,
3070	. iimjjmp1klev,ndex3d)
3071	c
3072	c
3073	ENDIF
3074	c34EK
3075	c
3076	if (ok_sync) then
3077	call histsync(nid_mth)
3078	endif
3079	ENDIF
3080	c
3081	IF (ok_instan) THEN
3082	c
3083	ndex2d = 0
3084	ndex3d = 0
3085	c
3086	c Champs 2D:
3087	c
3088	zsto = dtime * ecrit_ins
3089	zout = dtime * ecrit_ins
3090
3091	i = NINT(zout/zsto)
3092	CALL gr_fi_ecrit(1,klon,iim,jjmp1,pphis,zx_tmp_2d)
3093	CALL histwrite(nid_ins,"phis",i,zx_tmp_2d,iim*jjmp1,ndex2d)
3094	c
3095	i = NINT(zout/zsto)
3096	CALL gr_fi_ecrit(1,klon,iim,jjmp1,paire,zx_tmp_2d)
3097	CALL histwrite(nid_ins,"aire",i,zx_tmp_2d,iim*jjmp1,ndex2d)
3098
3099	DO i = 1, klon
3100	zx_tmp_fi2d(i) = paprs(i,1)
3101	ENDDO
3102	CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d,zx_tmp_2d)
3103	CALL histwrite(nid_ins,"psol",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
3104	c
3105	DO i = 1, klon
3106	zx_tmp_fi2d(i) = rain_fall(i) + snow_fall(i)
3107	ENDDO
3108	CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d,zx_tmp_2d)
3109	CALL histwrite(nid_ins,"rain",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
3110	c
3111	DO i = 1, klon
3112	zx_tmp_fi2d(i) = rain_lsc(i) + snow_lsc(i)
3113	ENDDO
3114	CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d,zx_tmp_2d)
3115	CALL histwrite(nid_ins,"plul",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
3116	c
3117	DO i = 1, klon
3118	zx_tmp_fi2d(i) = rain_con(i) + snow_con(i)
3119	ENDDO
3120	CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d,zx_tmp_2d)
3121	CALL histwrite(nid_ins,"pluc",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
3122
3123	CALL gr_fi_ecrit(1, klon,iim,jjmp1, zxtsol,zx_tmp_2d)
3124	CALL histwrite(nid_ins,"tsol",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
3125	c
3126	CALL gr_fi_ecrit(1, klon,iim,jjmp1, snow_fall,zx_tmp_2d)
3127	CALL histwrite(nid_ins,"snow",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
3128
3129	c
3130	CALL gr_fi_ecrit(1, klon,iim,jjmp1, toplw,zx_tmp_2d)
3131	CALL histwrite(nid_ins,"topl",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
3132	c
3133	CALL gr_fi_ecrit(1, klon,iim,jjmp1, evap,zx_tmp_2d)
3134	CALL histwrite(nid_ins,"evap",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
3135	c
3136	CALL gr_fi_ecrit(1, klon,iim,jjmp1, solsw,zx_tmp_2d)
3137	CALL histwrite(nid_ins,"sols",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
3138	c
3139	CALL gr_fi_ecrit(1, klon,iim,jjmp1, sollw,zx_tmp_2d)
3140	CALL histwrite(nid_ins,"soll",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
3141	c
3142	CALL gr_fi_ecrit(1, klon,iim,jjmp1, sollwdown,zx_tmp_2d)
3143	CALL histwrite(nid_ins,"solldown",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
3144	c
3145	CALL gr_fi_ecrit(1, klon,iim,jjmp1, bils,zx_tmp_2d)
3146	CALL histwrite(nid_ins,"bils",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
3147	c
3148	CALL gr_fi_ecrit(1, klon,iim,jjmp1, sens,zx_tmp_2d)
3149	CALL histwrite(nid_ins,"sens",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
3150	c
3151	CALL gr_fi_ecrit(1, klon,iim,jjmp1, fder,zx_tmp_2d)
3152	CALL histwrite(nid_ins,"fder",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
3153	c
3154	CALL gr_fi_ecrit(1, klon,iim,jjmp1, d_ts(1,is_oce),zx_tmp_2d)
3155	CALL histwrite(nid_ins,"dtsvdfo",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
3156	c
3157	CALL gr_fi_ecrit(1, klon,iim,jjmp1, d_ts(1,is_ter),zx_tmp_2d)
3158	CALL histwrite(nid_ins,"dtsvdft",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
3159	c
3160	CALL gr_fi_ecrit(1, klon,iim,jjmp1, d_ts(1,is_lic),zx_tmp_2d)
3161	CALL histwrite(nid_ins,"dtsvdfg",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
3162	c
3163	CALL gr_fi_ecrit(1, klon,iim,jjmp1, d_ts(1,is_sic),zx_tmp_2d)
3164	CALL histwrite(nid_ins,"dtsvdfi",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
3165
3166	DO nsrf = 1, nbsrf
3167	C§§§
3168	zx_tmp_fi2d(1 : klon) = pctsrf( 1 : klon, nsrf)
3169	CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d , zx_tmp_2d)
3170	CALL histwrite(nid_ins,"pourc_"//clnsurf(nsrf),itap,
3171	$ zx_tmp_2d,iim*jjmp1,ndex2d)
3172	C
3173	zx_tmp_fi2d(1 : klon) = fluxt( 1 : klon, 1, nsrf)
3174	CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d , zx_tmp_2d)
3175	CALL histwrite(nid_ins,"sens_"//clnsurf(nsrf),itap,
3176	$ zx_tmp_2d,iim*jjmp1,ndex2d)
3177	C
3178	zx_tmp_fi2d(1 : klon) = fluxlat( 1 : klon, nsrf)
3179	CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d , zx_tmp_2d)
3180	CALL histwrite(nid_ins,"lat_"//clnsurf(nsrf),itap,
3181	$ zx_tmp_2d,iim*jjmp1,ndex2d)
3182	C
3183	zx_tmp_fi2d(1 : klon) = ftsol( 1 : klon, nsrf)
3184	CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d , zx_tmp_2d)
3185	CALL histwrite(nid_ins,"tsol_"//clnsurf(nsrf),itap,
3186	$ zx_tmp_2d,iim*jjmp1,ndex2d)
3187	C
3188	zx_tmp_fi2d(1 : klon) = fluxu( 1 : klon, 1, nsrf)
3189	CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d , zx_tmp_2d)
3190	CALL histwrite(nid_ins,"taux_"//clnsurf(nsrf),itap,
3191	$ zx_tmp_2d,iim*jjmp1,ndex2d)
3192	C
3193	zx_tmp_fi2d(1 : klon) = fluxv( 1 : klon, 1, nsrf)
3194	CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d , zx_tmp_2d)
3195	CALL histwrite(nid_ins,"tauy_"//clnsurf(nsrf),itap,
3196	$ zx_tmp_2d,iim*jjmp1,ndex2d)
3197	C
3198	zx_tmp_fi2d(1 : klon) = frugs( 1 : klon, nsrf)
3199	CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d , zx_tmp_2d)
3200	CALL histwrite(nid_ins,"rugs_"//clnsurf(nsrf),itap,
3201	$ zx_tmp_2d,iim*jjmp1,ndex2d)
3202	C
3203	zx_tmp_fi2d(1 : klon) = falbe( 1 : klon, nsrf)
3204	CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d , zx_tmp_2d)
3205	CALL histwrite(nid_ins,"albe_"//clnsurf(nsrf),itap,
3206	$ zx_tmp_2d,iim*jjmp1,ndex2d)
3207	C
3208	END DO
3209	CALL gr_fi_ecrit(1, klon,iim,jjmp1, albsol,zx_tmp_2d)
3210	CALL histwrite(nid_ins,"albs",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
3211	CALL gr_fi_ecrit(1, klon,iim,jjmp1, albsollw,zx_tmp_2d)
3212	CALL histwrite(nid_ins,"albslw",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
3213	c
3214	CALL gr_fi_ecrit(1, klon,iim,jjmp1, zxsnow,zx_tmp_2d)
3215	CALL histwrite(nid_ins,"snow_cov",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
3216	c
3217	CALL gr_fi_ecrit(1, klon,iim,jjmp1, zxrugs,zx_tmp_2d)
3218	CALL histwrite(nid_ins,"rugs",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
3219	c
3220	c Champs 3D:
3221	c
3222	CALL gr_fi_ecrit(klev,klon,iim,jjmp1, t_seri, zx_tmp_3d)
3223	CALL histwrite(nid_ins,"temp",itap,zx_tmp_3d,
3224	. iimjjmp1klev,ndex3d)
3225	c
3226	CALL gr_fi_ecrit(klev,klon,iim,jjmp1, u_seri, zx_tmp_3d)
3227	CALL histwrite(nid_ins,"vitu",itap,zx_tmp_3d,
3228	. iimjjmp1klev,ndex3d)
3229	c
3230	CALL gr_fi_ecrit(klev,klon,iim,jjmp1, v_seri, zx_tmp_3d)
3231	CALL histwrite(nid_ins,"vitv",itap,zx_tmp_3d,
3232	. iimjjmp1klev,ndex3d)
3233	c
3234	CALL gr_fi_ecrit(klev,klon,iim,jjmp1, zphi, zx_tmp_3d)
3235	CALL histwrite(nid_ins,"geop",itap,zx_tmp_3d,
3236	. iimjjmp1klev,ndex3d)
3237	c
3238	CALL gr_fi_ecrit(klev,klon,iim,jjmp1, pplay, zx_tmp_3d)
3239	CALL histwrite(nid_ins,"pres",itap,zx_tmp_3d,
3240	. iimjjmp1klev,ndex3d)
3241	c
3242	CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_t_vdf, zx_tmp_3d)
3243	CALL histwrite(nid_ins,"dtvdf",itap,zx_tmp_3d,
3244	. iimjjmp1klev,ndex3d)
3245	c
3246	CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_q_vdf, zx_tmp_3d)
3247	CALL histwrite(nid_ins,"dqvdf",itap,zx_tmp_3d,
3248	. iimjjmp1klev,ndex3d)
3249
3250	c
3251	if (ok_sync) then
3252	call histsync(nid_ins)
3253	endif
3254	ENDIF
3255	c
3256	c
3257	c Ecrire la bande regionale (binaire grads)
3258	IF (ok_region .AND. mod(itap,ecrit_reg).eq.0) THEN
3259	CALL ecriregs(84,zxtsol)
3260	CALL ecriregs(84,paprs(1,1))
3261	CALL ecriregs(84,topsw)
3262	CALL ecriregs(84,toplw)
3263	CALL ecriregs(84,solsw)
3264	CALL ecriregs(84,sollw)
3265	CALL ecriregs(84,rain_fall)
3266	CALL ecriregs(84,snow_fall)
3267	CALL ecriregs(84,evap)
3268	CALL ecriregs(84,sens)
3269	CALL ecriregs(84,bils)
3270	CALL ecriregs(84,pctsrf(1,is_sic))
3271	CALL ecriregs(84,zxfluxu(1,1))
3272	CALL ecriregs(84,zxfluxv(1,1))
3273	CALL ecriregs(84,ue)
3274	CALL ecriregs(84,ve)
3275	CALL ecriregs(84,uq)
3276	CALL ecriregs(84,vq)
3277	c
3278	CALL ecrirega(84,u_seri)
3279	CALL ecrirega(84,v_seri)
3280	CALL ecrirega(84,omega)
3281	CALL ecrirega(84,t_seri)
3282	CALL ecrirega(84,zphi)
3283	CALL ecrirega(84,q_seri)
3284	CALL ecrirega(84,cldfra)
3285	CALL ecrirega(84,cldliq)
3286	CALL ecrirega(84,pplay)
3287
3288
3289	cc CALL ecrirega(84,d_t_dyn)
3290	cc CALL ecrirega(84,d_q_dyn)
3291	cc CALL ecrirega(84,heat)
3292	cc CALL ecrirega(84,cool)
3293	cc CALL ecrirega(84,d_t_con)
3294	cc CALL ecrirega(84,d_q_con)
3295	cc CALL ecrirega(84,d_t_lsc)
3296	cc CALL ecrirega(84,d_q_lsc)
3297	ENDIF
3298	c
3299	c Convertir les incrementations en tendances
3300	c
3301	DO k = 1, klev
3302	DO i = 1, klon
3303	d_u(i,k) = ( u_seri(i,k) - u(i,k) ) / dtime
3304	d_v(i,k) = ( v_seri(i,k) - v(i,k) ) / dtime
3305	d_t(i,k) = ( t_seri(i,k)-t(i,k) ) / dtime
3306	d_qx(i,k,ivap) = ( q_seri(i,k) - qx(i,k,ivap) ) / dtime
3307	d_qx(i,k,iliq) = ( ql_seri(i,k) - qx(i,k,iliq) ) / dtime
3308	ENDDO
3309	ENDDO
3310	c
3311	IF (nqmax.GE.3) THEN
3312	DO iq = 3, nqmax
3313	DO k = 1, klev
3314	DO i = 1, klon
3315	d_qx(i,k,iq) = ( tr_seri(i,k,iq-2) - qx(i,k,iq) ) / dtime
3316	ENDDO
3317	ENDDO
3318	ENDDO
3319	ENDIF
3320	c
3321	c Sauvegarder les valeurs de t et q a la fin de la physique:
3322	c
3323	DO k = 1, klev
3324	DO i = 1, klon
3325	t_ancien(i,k) = t_seri(i,k)
3326	q_ancien(i,k) = q_seri(i,k)
3327	ENDDO
3328	ENDDO
3329	c
3330	c====================================================================
3331	c Si c'est la fin, il faut conserver l'etat de redemarrage
3332	c====================================================================
3333	c
3334	IF (lafin) THEN
3335	ccc IF (ok_oasis) CALL quitcpl
3336	CALL phyredem ("restartphy.nc",dtime,radpas,co2_ppm,solaire,
3337	. rlat, rlon, pctsrf, ftsol, ftsoil, deltat, fqsol, fsnow,
3338	. falbe, fevap, rain_fall, snow_fall,
3339	. solsw, sollwdown,dlw,
3340	. radsol,frugs,agesno,
3341	. zmea,zstd,zsig,zgam,zthe,zpic,zval,rugoro,
3342	. t_ancien, q_ancien)
3343	ENDIF
3344
3345	RETURN
3346	END
3347	FUNCTION qcheck(klon,klev,paprs,q,ql,aire)
3348	IMPLICIT none
3349	c
3350	c Calculer et imprimer l'eau totale. A utiliser pour verifier
3351	c la conservation de l'eau
3352	c
3353	#include "YOMCST.h"
3354	INTEGER klon,klev
3355	REAL paprs(klon,klev+1), q(klon,klev), ql(klon,klev)
3356	REAL aire(klon)
3357	REAL qtotal, zx, qcheck
3358	INTEGER i, k
3359	c
3360	zx = 0.0
3361	DO i = 1, klon
3362	zx = zx + aire(i)
3363	ENDDO
3364	qtotal = 0.0
3365	DO k = 1, klev
3366	DO i = 1, klon
3367	qtotal = qtotal + (q(i,k)+ql(i,k)) * aire(i)
3368	. *(paprs(i,k)-paprs(i,k+1))/RG
3369	ENDDO
3370	ENDDO
3371	c
3372	qcheck = qtotal/zx
3373	c
3374	RETURN
3375	END
3376	SUBROUTINE gr_fi_ecrit(nfield,nlon,iim,jjmp1,fi,ecrit)
3377	IMPLICIT none
3378	c
3379	c Tranformer une variable de la grille physique a
3380	c la grille d'ecriture
3381	c
3382	INTEGER nfield,nlon,iim,jjmp1, jjm
3383	REAL fi(nlon,nfield), ecrit(iim*jjmp1,nfield)
3384	c
3385	INTEGER i, n, ig
3386	c
3387	jjm = jjmp1 - 1
3388	DO n = 1, nfield
3389	DO i=1,iim
3390	ecrit(i,n) = fi(1,n)
3391	ecrit(i+jjm*iim,n) = fi(nlon,n)
3392	ENDDO
3393	DO ig = 1, nlon - 2
3394	ecrit(iim+ig,n) = fi(1+ig,n)
3395	ENDDO
3396	ENDDO
3397	RETURN
3398	END
3399

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

Download in other formats:

Original Format