Context Navigation

physiq.F @ 282

Last change on this file since 282 was 282, checked in by lmdzadmin, 23 years ago
Passage des 2 albedos de surface vis et nir mise en commentaire de la nouvelle surcouche IOIPSL LF
Property svn:eol-style set to `native` Property svn:executable set to ``* Property svn:keywords set to `Author Date Id Revision`
File size: 119.3 KB

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

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

Download in other formats:

Original Format