Context Navigation

physiq.F @ 290

Last change on this file since 290 was 290, checked in by lmdzadmin, 23 years ago
Initialisations de variables Pasb LF
Property svn:eol-style set to `native` Property svn:executable set to ``* Property svn:keywords set to `Author Date Id Revision`
File size: 119.4 KB

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

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

Download in other formats:

Original Format