Context Navigation

physiq.F @ 33

Last change on this file since 33 was 29, checked in by lmdz, 26 years ago
Le tableau ndex, qui permet de "flagger" les valeurs a sortir dans IOIPSL, est dimmensionne maniere correcte, sinon sur Nec les champs 3D physique ne sont pas correctement rempli. (probleme non visible avec les champs dynamiques mais pour faire propre ...) LF
Property svn:eol-style set to `native` Property svn:executable set to ``* Property svn:keywords set to `Author Date Id Revision`
File size: 88.1 KB

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

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

Download in other formats:

Original Format