Context Navigation

physiq.F @ 205

Last change on this file since 205 was 205, checked in by lmdzadmin, 23 years ago
Rajout date0 dans physiq pour interface avec ORCHIDEE Fermeture des fichiers restart par restclo dans abort_gcm LF
Property svn:eol-style set to `native` Property svn:executable set to ``* Property svn:keywords set to `Author Date Id Revision`
File size: 101.1 KB

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

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

Download in other formats:

Original Format