Context Navigation

physiq.F @ 271

Last change on this file since 271 was 271, checked in by lmdzadmin, 23 years ago
Passage progressif a writephys LF
Property svn:eol-style set to `native` Property svn:executable set to ``* Property svn:keywords set to `Author Date Id Revision`
File size: 118.1 KB

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

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

Download in other formats:

Original Format