Context Navigation

physiq.F @ 258

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

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

Download in other formats:

Original Format