Context Navigation

physiq.F @ 39

Last change on this file since 39 was 34, checked in by lmdz, 26 years ago
Rajout de l'ajustement sec (qui avait mysterieusement disparu). 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.3 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	CALL ajsec(paprs, pplay, t_seri, q_seri, d_t_ajs, d_q_ajs)
1550	DO k = 1, klev
1551	DO i = 1, klon
1552	t_seri(i,k) = t_seri(i,k) + d_t_ajs(i,k)
1553	q_seri(i,k) = q_seri(i,k) + d_q_ajs(i,k)
1554	ENDDO
1555	ENDDO
1556	c
1557	c Appeler le processus de condensation a grande echelle
1558	c et le processus de precipitation
1559	c
1560	CALL fisrtilp_tr(dtime,paprs,pplay,
1561	. t_seri, q_seri,
1562	. d_t_lsc, d_q_lsc, d_ql_lsc, rneb, cldliq,
1563	. rain_lsc, snow_lsc,
1564	. pfrac_impa, pfrac_nucl, pfrac_1nucl,
1565	. frac_impa, frac_nucl,
1566	. prfl, psfl)
1567	DO k = 1, klev
1568	DO i = 1, klon
1569	t_seri(i,k) = t_seri(i,k) + d_t_lsc(i,k)
1570	q_seri(i,k) = q_seri(i,k) + d_q_lsc(i,k)
1571	ql_seri(i,k) = ql_seri(i,k) + d_ql_lsc(i,k)
1572	cldfra(i,k) = rneb(i,k)
1573	IF (.NOT.new_oliq) cldliq(i,k) = ql_seri(i,k)
1574	ENDDO
1575	ENDDO
1576	IF (check) THEN
1577	CALL qcheck(klon,klev,paprs,q_seri,ql_seri,"apresilp=")
1578	zx_t = 0.0
1579	DO i = 1, klon
1580	zx_t = zx_t + rain_lsc(i)+snow_lsc(i)
1581	ENDDO
1582	zx_t = zx_t/FLOAT(klon)*dtime
1583	PRINT*, "Precip=", zx_t
1584	ENDIF
1585	c
1586	c Nuages diagnostiques:
1587	c
1588	IF (iflag_con.EQ.2) THEN ! seulement pour Tiedtke
1589	CALL diagcld(paprs,pplay,t_seri,q_seri,
1590	. rain_con,snow_con,ibas_con,itop_con,
1591	. diafra,dialiq)
1592	DO k = 1, klev
1593	DO i = 1, klon
1594	IF (diafra(i,k).GT.cldfra(i,k)) THEN
1595	cldliq(i,k) = dialiq(i,k)
1596	cldfra(i,k) = diafra(i,k)
1597	ENDIF
1598	ENDDO
1599	ENDDO
1600	ENDIF
1601	c
1602	c Precipitation totale
1603	c
1604	DO i = 1, klon
1605	rain_fall(i) = rain_con(i) + rain_lsc(i)
1606	snow_fall(i) = snow_con(i) + snow_lsc(i)
1607	ENDDO
1608	c
1609	c Calculer l'humidite relative pour diagnostique
1610	c
1611	DO k = 1, klev
1612	DO i = 1, klon
1613	zx_t = t_seri(i,k)
1614	IF (thermcep) THEN
1615	zdelta = MAX(0.,SIGN(1.,rtt-zx_t))
1616	zx_qs = r2es * FOEEW(zx_t,zdelta)/pplay(i,k)
1617	zx_qs = MIN(0.5,zx_qs)
1618	zcor = 1./(1.-retv*zx_qs)
1619	zx_qs = zx_qs*zcor
1620	ELSE
1621	IF (zx_t.LT.t_coup) THEN
1622	zx_qs = qsats(zx_t)/pplay(i,k)
1623	ELSE
1624	zx_qs = qsatl(zx_t)/pplay(i,k)
1625	ENDIF
1626	ENDIF
1627	zx_rh(i,k) = q_seri(i,k)/zx_qs
1628	ENDDO
1629	ENDDO
1630	c
1631	c Calculer les parametres optiques des nuages et quelques
1632	c parametres pour diagnostiques:
1633	c
1634	CALL nuage (paprs, pplay,
1635	. t_seri, cldliq, cldfra, cldtau, cldemi,
1636	. cldh, cldl, cldm, cldt, cldq)
1637	c
1638	c Appeler le rayonnement mais calculer tout d'abord l'albedo du sol.
1639	c
1640	IF (MOD(itaprad,radpas).EQ.0) THEN
1641	CALL orbite(FLOAT(julien),zlongi,dist)
1642	IF (cycle_diurne) THEN
1643	zdtime=dtime*FLOAT(radpas) ! pas de temps du rayonnement (s)
1644	CALL zenang(zlongi,gmtime,zdtime,rlat,rlon,rmu0,fract)
1645	c CALL zenith(zlongi,gmtime,rlat,rlon,rmu0,fract) !va disparaitre
1646	CALL alboc_cd(rmu0,alb_eau)
1647	ELSE
1648	CALL angle(zlongi,rlat,fract,rmu0)
1649	CALL alboc(FLOAT(julien),rlat,alb_eau)
1650	ENDIF
1651	CALL albsno(veget,agesno,alb_neig)
1652	DO i = 1, klon
1653	zx_alb_oce = alb_eau(i)
1654	IF (pctsrf(i,is_oce).GT.epsfra .AND. ftsol(i,is_oce).LT.271.35)
1655	. zx_alb_oce = 0.6 ! pour slab_ocean
1656	zfra = MAX(0.0,MIN(1.0,fsnow(i,is_lic)/(fsnow(i,is_lic)+10.0)))
1657	zx_alb_lic = alb_neig(i)zfra + 0.6(1.0-zfra)
1658	zfra = MAX(0.0,MIN(1.0,fsnow(i,is_ter)/(fsnow(i,is_ter)+10.0)))
1659	zx_alb_ter = alb_neig(i)zfra + lmt_alb(i)(1.0-zfra)
1660	zfra = MAX(0.0,MIN(1.0,fsnow(i,is_sic)/(fsnow(i,is_sic)+10.0)))
1661	zx_alb_sic = alb_neig(i)zfra + 0.6(1.0-zfra)
1662	albsol(i) = zx_alb_oce * pctsrf(i,is_oce)
1663	. + zx_alb_lic * pctsrf(i,is_lic)
1664	. + zx_alb_ter * pctsrf(i,is_ter)
1665	. + zx_alb_sic * pctsrf(i,is_sic)
1666	ENDDO
1667	CALL radlwsw ! nouveau rayonnement (compatible Arpege-IFS)
1668	e (dist, rmu0, fract, co2_ppm, solaire,
1669	e paprs, pplay,zxtsol,albsol, t_seri,q_seri,wo,
1670	e cldfra, cldemi, cldtau,
1671	s heat,heat0,cool,cool0,radsol,albpla,
1672	s topsw,toplw,solsw,sollw,
1673	s topsw0,toplw0,solsw0,sollw0)
1674	itaprad = 0
1675	ENDIF
1676	itaprad = itaprad + 1
1677	c
1678	c Ajouter la tendance des rayonnements (tous les pas)
1679	c
1680	DO k = 1, klev
1681	DO i = 1, klon
1682	t_seri(i,k) = t_seri(i,k)
1683	. + (heat(i,k)-cool(i,k)) * dtime/86400.
1684	ENDDO
1685	ENDDO
1686	c
1687	c Calculer l'hydrologie de la surface
1688	c
1689	CALL hydrol(dtime,pctsrf,rain_fall, snow_fall, evap,
1690	. agesno, ftsol,fqsol,fsnow, ruis)
1691	c
1692	DO i = 1, klon
1693	zxqsol(i) = 0.0
1694	zxsnow(i) = 0.0
1695	ENDDO
1696	DO nsrf = 1, nbsrf
1697	DO i = 1, klon
1698	zxqsol(i) = zxqsol(i) + fqsol(i,nsrf)*pctsrf(i,nsrf)
1699	zxsnow(i) = zxsnow(i) + fsnow(i,nsrf)*pctsrf(i,nsrf)
1700	ENDDO
1701	ENDDO
1702	c
1703	c Si une sous-fraction n'existe pas, elle prend la valeur moyenne
1704	c
1705	DO nsrf = 1, nbsrf
1706	DO i = 1, klon
1707	IF (pctsrf(i,nsrf).LT.epsfra) THEN
1708	fqsol(i,nsrf) = zxqsol(i)
1709	fsnow(i,nsrf) = zxsnow(i)
1710	ENDIF
1711	ENDDO
1712	ENDDO
1713	c
1714	c Calculer le bilan du sol et la derive de temperature (couplage)
1715	c
1716	DO i = 1, klon
1717	bils(i) = radsol(i) - sens(i) - evap(i)*RLVTT
1718	ENDDO
1719	IF (ok_ocean) THEN
1720	DO i = 1, klon
1721	cthermiq = cyang
1722	IF (ftsol(i,is_oce).LT. 271.35) cthermiq = cbing
1723	IF (pctsrf(i,is_oce).GT.epsfra) deltat(i) = deltat(i) +
1724	. (bils(i)-lmt_bils(i))/cthermiq * dtime
1725	IF (deltat(i).GT.15.0 ) deltat(i) = 15.0
1726	IF (deltat(i).LT.-15.0) deltat(i) = -15.0
1727	ENDDO
1728	ENDIF
1729	c
1730	cmoddeblott(jan95)
1731	c Appeler le programme de parametrisation de l'orographie
1732	c a l'echelle sous-maille:
1733	c
1734	IF (ok_orodr) THEN
1735	c
1736	c selection des points pour lesquels le shema est actif:
1737	igwd=0
1738	DO i=1,klon
1739	itest(i)=0
1740	c IF ((zstd(i).gt.10.0)) THEN
1741	IF (((zpic(i)-zmea(i)).GT.100.).AND.(zstd(i).GT.10.0)) THEN
1742	itest(i)=1
1743	igwd=igwd+1
1744	idx(igwd)=i
1745	ENDIF
1746	ENDDO
1747	igwdim=MAX(1,igwd)
1748	c
1749	CALL drag_noro(klon,klev,dtime,paprs,pplay,
1750	e zmea,zstd, zsig, zgam, zthe,zpic,zval,
1751	e igwd,igwdim,idx,itest,
1752	e t_seri, u_seri, v_seri,
1753	s zulow, zvlow, zustr, zvstr,
1754	s d_t_oro, d_u_oro, d_v_oro)
1755	c
1756	c ajout des tendances
1757	DO k = 1, klev
1758	DO i = 1, klon
1759	t_seri(i,k) = t_seri(i,k) + d_t_oro(i,k)
1760	u_seri(i,k) = u_seri(i,k) + d_u_oro(i,k)
1761	v_seri(i,k) = v_seri(i,k) + d_v_oro(i,k)
1762	ENDDO
1763	ENDDO
1764	c
1765	ENDIF ! fin de test sur ok_orodr
1766	c
1767	IF (ok_orolf) THEN
1768	c
1769	c selection des points pour lesquels le shema est actif:
1770	igwd=0
1771	DO i=1,klon
1772	itest(i)=0
1773	IF ((zpic(i)-zmea(i)).GT.100.) THEN
1774	itest(i)=1
1775	igwd=igwd+1
1776	idx(igwd)=i
1777	ENDIF
1778	ENDDO
1779	igwdim=MAX(1,igwd)
1780	c
1781	CALL lift_noro(klon,klev,dtime,paprs,pplay,
1782	e rlat,zmea,zstd, zsig, zgam, zthe,zpic,zval,
1783	e igwd,igwdim,idx,itest,
1784	e t_seri, u_seri, v_seri,
1785	s zulow, zvlow, zustr, zvstr,
1786	s d_t_lif, d_u_lif, d_v_lif)
1787	c
1788	c ajout des tendances
1789	DO k = 1, klev
1790	DO i = 1, klon
1791	t_seri(i,k) = t_seri(i,k) + d_t_lif(i,k)
1792	u_seri(i,k) = u_seri(i,k) + d_u_lif(i,k)
1793	v_seri(i,k) = v_seri(i,k) + d_v_lif(i,k)
1794	ENDDO
1795	ENDDO
1796	c
1797	ENDIF ! fin de test sur ok_orolf
1798	c
1799	cAA
1800	cAA Installation de l'interface online-offline pour traceurs
1801	cAA
1802	c====================================================================
1803	c Calcul des tendances traceurs
1804	c====================================================================
1805	CMAF modif pour garder info du nombre de traceurs auxquels
1806	C la physique s'applique
1807	C
1808	write(,) 'Phytrac= '
1809	call phytrac (rnpb,
1810	I debut,
1811	I nqmax-2,
1812	I nlon,nlev,dtime,
1813	I t,paprs,pplay,
1814	I pmfu, pmfd, pen_u, pde_u, pen_d, pde_d,
1815	I ycoefh,yu1,yv1,ftsol,pctsrf,rlat,
1816	I frac_impa, frac_nucl,
1817	I rlon,presnivs,paire,pphis,
1818	O tr_seri)
1819
1820	write(,) 'OFFLINE= ', offline
1821	IF (offline) THEN
1822	write(,) 'OFFLINE= ', offline
1823	call phystoke (
1824	I nlon,nlev,pdtphys,
1825	I pmfu, pmfd, pen_u, pde_u, pen_d, pde_d,
1826	I ycoefh,yu1,yv1,ftsol,pctsrf,
1827	I frac_impa, frac_nucl)
1828
1829	ENDIF
1830
1831	c
1832	c Calculer le transport de l'eau et de l'energie (diagnostique)
1833	c
1834	CALL transp (paprs,zxtsol,
1835	e t_seri, q_seri, u_seri, v_seri, zphi,
1836	s ve, vq, ue, uq)
1837	c
1838	c Accumuler les variables a stocker dans les fichiers histoire:
1839	c
1840	IF (ok_oasis) THEN ! couplage oasis
1841	DO i = 1, klon
1842	oas_sols(i) = oas_sols(i) + solsw(i) / FLOAT(nexca)
1843	oas_nsol(i) = oas_nsol(i) + (bils(i)-solsw(i))/ FLOAT(nexca)
1844	oas_rain(i) = oas_rain(i) + rain_fall(i) / FLOAT(nexca)
1845	oas_snow(i) = oas_snow(i) + snow_fall(i) / FLOAT(nexca)
1846	oas_evap(i) = oas_evap(i) + evap(i) / FLOAT(nexca)
1847	oas_tsol(i) = oas_tsol(i) + zxtsol(i) / FLOAT(nexca)
1848	oas_fder(i) = oas_fder(i) + fder(i) / FLOAT(nexca)
1849	oas_albe(i) = oas_albe(i) + albsol(i) / FLOAT(nexca)
1850	oas_taux(i) = oas_taux(i) + fluxu(i,1) / FLOAT(nexca)
1851	oas_tauy(i) = oas_tauy(i) + fluxv(i,1) / FLOAT(nexca)
1852	oas_ruis(i) = oas_ruis(i) + ruis(i) /FLOAT(nexca)/dtime
1853	ENDDO
1854	ENDIF
1855	c
1856	c
1857	IF (ok_journe) THEN
1858	c
1859	ndex2d = 0
1860	ndex3d = 0
1861	c
1862	c Champs 2D:
1863	c
1864	i = NINT(zout/zsto)
1865	CALL gr_fi_ecrit(1,klon,iim,jjm+1,pphis,zx_tmp_2d)
1866	CALL histwrite(nid_day,"phis",i,zx_tmp_2d,iim*(jjm+1),ndex2d)
1867	c
1868	i = NINT(zout/zsto)
1869	CALL gr_fi_ecrit(1,klon,iim,jjm+1,paire,zx_tmp_2d)
1870	CALL histwrite(nid_day,"aire",i,zx_tmp_2d,iim*(jjm+1),ndex2d)
1871	C
1872	CALL gr_fi_ecrit(1, klon,iim,jjm+1, zxtsol,zx_tmp_2d)
1873	CALL histwrite(nid_day,"tsol",itap,zx_tmp_2d,iim*(jjm+1),ndex2d)
1874	c
1875	DO i = 1, klon
1876	zx_tmp_fi2d(i) = paprs(i,1)
1877	ENDDO
1878	CALL gr_fi_ecrit(1, klon,iim,jjm+1, zx_tmp_fi2d,zx_tmp_2d)
1879	CALL histwrite(nid_day,"psol",itap,zx_tmp_2d,iim*(jjm+1),ndex2d)
1880	c
1881	DO i = 1, klon
1882	zx_tmp_fi2d(i) = rain_fall(i) + snow_fall(i)
1883	ENDDO
1884	CALL gr_fi_ecrit(1, klon,iim,jjm+1, zx_tmp_fi2d,zx_tmp_2d)
1885	CALL histwrite(nid_day,"rain",itap,zx_tmp_2d,iim*(jjm+1),ndex2d)
1886	c
1887	CALL gr_fi_ecrit(1, klon,iim,jjm+1, snow_fall,zx_tmp_2d)
1888	CALL histwrite(nid_day,"snow",itap,zx_tmp_2d,iim*(jjm+1),ndex2d)
1889	c
1890	CALL gr_fi_ecrit(1, klon,iim,jjm+1, evap,zx_tmp_2d)
1891	CALL histwrite(nid_day,"evap",itap,zx_tmp_2d,iim*(jjm+1),ndex2d)
1892	c
1893	CALL gr_fi_ecrit(1, klon,iim,jjm+1, topsw,zx_tmp_2d)
1894	CALL histwrite(nid_day,"tops",itap,zx_tmp_2d,iim*(jjm+1),ndex2d)
1895	c
1896	CALL gr_fi_ecrit(1, klon,iim,jjm+1, toplw,zx_tmp_2d)
1897	CALL histwrite(nid_day,"topl",itap,zx_tmp_2d,iim*(jjm+1),ndex2d)
1898	c
1899	CALL gr_fi_ecrit(1, klon,iim,jjm+1, solsw,zx_tmp_2d)
1900	CALL histwrite(nid_day,"sols",itap,zx_tmp_2d,iim*(jjm+1),ndex2d)
1901	c
1902	CALL gr_fi_ecrit(1, klon,iim,jjm+1, sollw,zx_tmp_2d)
1903	CALL histwrite(nid_day,"soll",itap,zx_tmp_2d,iim*(jjm+1),ndex2d)
1904	c
1905	CALL gr_fi_ecrit(1, klon,iim,jjm+1, bils,zx_tmp_2d)
1906	CALL histwrite(nid_day,"bils",itap,zx_tmp_2d,iim*(jjm+1),ndex2d)
1907	c
1908	CALL gr_fi_ecrit(1, klon,iim,jjm+1, sens,zx_tmp_2d)
1909	CALL histwrite(nid_day,"sens",itap,zx_tmp_2d,iim*(jjm+1),ndex2d)
1910	c
1911	CALL gr_fi_ecrit(1, klon,iim,jjm+1, fder,zx_tmp_2d)
1912	CALL histwrite(nid_day,"fder",itap,zx_tmp_2d,iim*(jjm+1),ndex2d)
1913	c
1914	CALL gr_fi_ecrit(1, klon,iim,jjm+1, ruis,zx_tmp_2d)
1915	CALL histwrite(nid_day,"ruis",itap,zx_tmp_2d,iim*(jjm+1),ndex2d)
1916	c
1917	DO i = 1, klon
1918	zx_tmp_fi2d(i) = fluxu(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,"frtu",itap,zx_tmp_2d,iim*(jjm+1),ndex2d)
1922	c
1923	DO i = 1, klon
1924	zx_tmp_fi2d(i) = fluxv(i,1)
1925	ENDDO
1926	CALL gr_fi_ecrit(1, klon,iim,jjm+1, zx_tmp_fi2d,zx_tmp_2d)
1927	CALL histwrite(nid_day,"frtv",itap,zx_tmp_2d,iim*(jjm+1),ndex2d)
1928	c
1929	DO i = 1, klon
1930	zx_tmp_fi2d(i) = pctsrf(i,is_sic)
1931	ENDDO
1932	CALL gr_fi_ecrit(1, klon,iim,jjm+1, zx_tmp_fi2d,zx_tmp_2d)
1933	CALL histwrite(nid_day,"sicf",itap,zx_tmp_2d,iim*(jjm+1),ndex2d)
1934	c
1935	CALL gr_fi_ecrit(1, klon,iim,jjm+1, cldl,zx_tmp_2d)
1936	CALL histwrite(nid_day,"cldl",itap,zx_tmp_2d,iim*(jjm+1),ndex2d)
1937	c
1938	CALL gr_fi_ecrit(1, klon,iim,jjm+1, cldm,zx_tmp_2d)
1939	CALL histwrite(nid_day,"cldm",itap,zx_tmp_2d,iim*(jjm+1),ndex2d)
1940	c
1941	CALL gr_fi_ecrit(1, klon,iim,jjm+1, cldh,zx_tmp_2d)
1942	CALL histwrite(nid_day,"cldh",itap,zx_tmp_2d,iim*(jjm+1),ndex2d)
1943	c
1944	CALL gr_fi_ecrit(1, klon,iim,jjm+1, cldt,zx_tmp_2d)
1945	CALL histwrite(nid_day,"cldt",itap,zx_tmp_2d,iim*(jjm+1),ndex2d)
1946	c
1947	CALL gr_fi_ecrit(1, klon,iim,jjm+1, cldq,zx_tmp_2d)
1948	CALL histwrite(nid_day,"cldq",itap,zx_tmp_2d,iim*(jjm+1),ndex2d)
1949	c
1950	c Champs 3D:
1951	c
1952	CALL gr_fi_ecrit(klev,klon,iim,jjm+1, t_seri, zx_tmp_3d)
1953	CALL histwrite(nid_day,"temp",itap,zx_tmp_3d,
1954	. iim(jjm+1)klev,ndex3d)
1955	c
1956	CALL gr_fi_ecrit(klev,klon,iim,jjm+1, qx(1,1,ivap), zx_tmp_3d)
1957	CALL histwrite(nid_day,"ovap",itap,zx_tmp_3d,
1958	. iim(jjm+1)klev,ndex3d)
1959	c
1960	CALL gr_fi_ecrit(klev,klon,iim,jjm+1, zphi, zx_tmp_3d)
1961	CALL histwrite(nid_day,"geop",itap,zx_tmp_3d,
1962	. iim(jjm+1)klev,ndex3d)
1963	c
1964	CALL gr_fi_ecrit(klev,klon,iim,jjm+1, u_seri, zx_tmp_3d)
1965	CALL histwrite(nid_day,"vitu",itap,zx_tmp_3d,
1966	. iim(jjm+1)klev,ndex3d)
1967	c
1968	CALL gr_fi_ecrit(klev,klon,iim,jjm+1, v_seri, zx_tmp_3d)
1969	CALL histwrite(nid_day,"vitv",itap,zx_tmp_3d,
1970	. iim(jjm+1)klev,ndex3d)
1971	c
1972	CALL gr_fi_ecrit(klev,klon,iim,jjm+1, omega, zx_tmp_3d)
1973	CALL histwrite(nid_day,"vitw",itap,zx_tmp_3d,
1974	. iim(jjm+1)klev,ndex3d)
1975	c
1976	CALL gr_fi_ecrit(klev,klon,iim,jjm+1, pplay, zx_tmp_3d)
1977	CALL histwrite(nid_day,"pres",itap,zx_tmp_3d,
1978	. iim(jjm+1)klev,ndex3d)
1979	c
1980	if (ok_sync) then
1981	call histsync(nid_day)
1982	endif
1983	ENDIF
1984	C
1985	IF (ok_mensuel) THEN
1986	c
1987	ndex2d = 0
1988	ndex3d = 0
1989	c
1990	c Champs 2D:
1991	c
1992	i = NINT(zout/zsto)
1993	CALL gr_fi_ecrit(1,klon,iim,jjm+1,pphis,zx_tmp_2d)
1994	CALL histwrite(nid_mth,"phis",i,zx_tmp_2d,iim*(jjm+1),ndex2d)
1995	C
1996	i = NINT(zout/zsto)
1997	CALL gr_fi_ecrit(1,klon,iim,jjm+1,paire,zx_tmp_2d)
1998	CALL histwrite(nid_mth,"aire",i,zx_tmp_2d,iim*(jjm+1),ndex2d)
1999
2000	CALL gr_fi_ecrit(1, klon,iim,jjm+1, zxtsol,zx_tmp_2d)
2001	CALL histwrite(nid_mth,"tsol",itap,zx_tmp_2d,iim*(jjm+1),ndex2d)
2002	c
2003	DO i = 1, klon
2004	zx_tmp_fi2d(i) = paprs(i,1)
2005	ENDDO
2006	CALL gr_fi_ecrit(1, klon,iim,jjm+1, zx_tmp_fi2d,zx_tmp_2d)
2007	CALL histwrite(nid_mth,"psol",itap,zx_tmp_2d,iim*(jjm+1),ndex2d)
2008	c
2009	CALL gr_fi_ecrit(1, klon,iim,jjm+1, zxqsol,zx_tmp_2d)
2010	CALL histwrite(nid_mth,"qsol",itap,zx_tmp_2d,iim*(jjm+1),ndex2d)
2011	c
2012	DO i = 1, klon
2013	zx_tmp_fi2d(i) = rain_fall(i) + snow_fall(i)
2014	ENDDO
2015	CALL gr_fi_ecrit(1, klon,iim,jjm+1, zx_tmp_fi2d,zx_tmp_2d)
2016	CALL histwrite(nid_mth,"rain",itap,zx_tmp_2d,iim*(jjm+1),ndex2d)
2017	c
2018	DO i = 1, klon
2019	zx_tmp_fi2d(i) = rain_lsc(i) + snow_lsc(i)
2020	ENDDO
2021	CALL gr_fi_ecrit(1, klon,iim,jjm+1, zx_tmp_fi2d,zx_tmp_2d)
2022	CALL histwrite(nid_mth,"plul",itap,zx_tmp_2d,iim*(jjm+1),ndex2d)
2023	c
2024	DO i = 1, klon
2025	zx_tmp_fi2d(i) = rain_con(i) + snow_con(i)
2026	ENDDO
2027	CALL gr_fi_ecrit(1, klon,iim,jjm+1, zx_tmp_fi2d,zx_tmp_2d)
2028	CALL histwrite(nid_mth,"pluc",itap,zx_tmp_2d,iim*(jjm+1),ndex2d)
2029	c
2030	CALL gr_fi_ecrit(1, klon,iim,jjm+1, snow_fall,zx_tmp_2d)
2031	CALL histwrite(nid_mth,"snow",itap,zx_tmp_2d,iim*(jjm+1),ndex2d)
2032	c
2033	CALL gr_fi_ecrit(1, klon,iim,jjm+1, agesno,zx_tmp_2d)
2034	CALL histwrite(nid_mth,"ages",itap,zx_tmp_2d,iim*(jjm+1),ndex2d)
2035	c
2036	CALL gr_fi_ecrit(1, klon,iim,jjm+1, evap,zx_tmp_2d)
2037	CALL histwrite(nid_mth,"evap",itap,zx_tmp_2d,iim*(jjm+1),ndex2d)
2038	c
2039	CALL gr_fi_ecrit(1, klon,iim,jjm+1, topsw,zx_tmp_2d)
2040	CALL histwrite(nid_mth,"tops",itap,zx_tmp_2d,iim*(jjm+1),ndex2d)
2041	c
2042	CALL gr_fi_ecrit(1, klon,iim,jjm+1, toplw,zx_tmp_2d)
2043	CALL histwrite(nid_mth,"topl",itap,zx_tmp_2d,iim*(jjm+1),ndex2d)
2044	c
2045	CALL gr_fi_ecrit(1, klon,iim,jjm+1, solsw,zx_tmp_2d)
2046	CALL histwrite(nid_mth,"sols",itap,zx_tmp_2d,iim*(jjm+1),ndex2d)
2047	c
2048	CALL gr_fi_ecrit(1, klon,iim,jjm+1, sollw,zx_tmp_2d)
2049	CALL histwrite(nid_mth,"soll",itap,zx_tmp_2d,iim*(jjm+1),ndex2d)
2050	c
2051	CALL gr_fi_ecrit(1, klon,iim,jjm+1, topsw0,zx_tmp_2d)
2052	CALL histwrite(nid_mth,"tops0",itap,zx_tmp_2d,iim*(jjm+1),ndex2d)
2053	c
2054	CALL gr_fi_ecrit(1, klon,iim,jjm+1, toplw0,zx_tmp_2d)
2055	CALL histwrite(nid_mth,"topl0",itap,zx_tmp_2d,iim*(jjm+1),ndex2d)
2056	c
2057	CALL gr_fi_ecrit(1, klon,iim,jjm+1, solsw0,zx_tmp_2d)
2058	CALL histwrite(nid_mth,"sols0",itap,zx_tmp_2d,iim*(jjm+1),ndex2d)
2059	c
2060	CALL gr_fi_ecrit(1, klon,iim,jjm+1, sollw0,zx_tmp_2d)
2061	CALL histwrite(nid_mth,"soll0",itap,zx_tmp_2d,iim*(jjm+1),ndex2d)
2062	c
2063	CALL gr_fi_ecrit(1, klon,iim,jjm+1, bils,zx_tmp_2d)
2064	CALL histwrite(nid_mth,"bils",itap,zx_tmp_2d,iim*(jjm+1),ndex2d)
2065	c
2066	CALL gr_fi_ecrit(1, klon,iim,jjm+1, sens,zx_tmp_2d)
2067	CALL histwrite(nid_mth,"sens",itap,zx_tmp_2d,iim*(jjm+1),ndex2d)
2068	c
2069	CALL gr_fi_ecrit(1, klon,iim,jjm+1, fder,zx_tmp_2d)
2070	CALL histwrite(nid_mth,"fder",itap,zx_tmp_2d,iim*(jjm+1),ndex2d)
2071	c
2072	CALL gr_fi_ecrit(1, klon,iim,jjm+1, ruis,zx_tmp_2d)
2073	CALL histwrite(nid_mth,"ruis",itap,zx_tmp_2d,iim*(jjm+1),ndex2d)
2074	c
2075	DO i = 1, klon
2076	zx_tmp_fi2d(i) = fluxu(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,"frtu",itap,zx_tmp_2d,iim*(jjm+1),ndex2d)
2080	c
2081	DO i = 1, klon
2082	zx_tmp_fi2d(i) = fluxv(i,1)
2083	ENDDO
2084	CALL gr_fi_ecrit(1, klon,iim,jjm+1, zx_tmp_fi2d,zx_tmp_2d)
2085	CALL histwrite(nid_mth,"frtv",itap,zx_tmp_2d,iim*(jjm+1),ndex2d)
2086	c
2087	DO i = 1, klon
2088	zx_tmp_fi2d(i) = pctsrf(i,is_sic)
2089	ENDDO
2090	CALL gr_fi_ecrit(1, klon,iim,jjm+1, zx_tmp_fi2d,zx_tmp_2d)
2091	CALL histwrite(nid_mth,"sicf",itap,zx_tmp_2d,iim*(jjm+1),ndex2d)
2092	c
2093	CALL gr_fi_ecrit(1, klon,iim,jjm+1, albsol,zx_tmp_2d)
2094	CALL histwrite(nid_mth,"albs",itap,zx_tmp_2d,iim*(jjm+1),ndex2d)
2095	c
2096	CALL gr_fi_ecrit(1, klon,iim,jjm+1, cdragm,zx_tmp_2d)
2097	CALL histwrite(nid_mth,"cdrm",itap,zx_tmp_2d,iim*(jjm+1),ndex2d)
2098	c
2099	CALL gr_fi_ecrit(1, klon,iim,jjm+1, cdragh,zx_tmp_2d)
2100	CALL histwrite(nid_mth,"cdrh",itap,zx_tmp_2d,iim*(jjm+1),ndex2d)
2101	c
2102	CALL gr_fi_ecrit(1, klon,iim,jjm+1, cldl,zx_tmp_2d)
2103	CALL histwrite(nid_mth,"cldl",itap,zx_tmp_2d,iim*(jjm+1),ndex2d)
2104	c
2105	CALL gr_fi_ecrit(1, klon,iim,jjm+1, cldm,zx_tmp_2d)
2106	CALL histwrite(nid_mth,"cldm",itap,zx_tmp_2d,iim*(jjm+1),ndex2d)
2107	c
2108	CALL gr_fi_ecrit(1, klon,iim,jjm+1, cldh,zx_tmp_2d)
2109	CALL histwrite(nid_mth,"cldh",itap,zx_tmp_2d,iim*(jjm+1),ndex2d)
2110	c
2111	CALL gr_fi_ecrit(1, klon,iim,jjm+1, cldt,zx_tmp_2d)
2112	CALL histwrite(nid_mth,"cldt",itap,zx_tmp_2d,iim*(jjm+1),ndex2d)
2113	c
2114	CALL gr_fi_ecrit(1, klon,iim,jjm+1, cldq,zx_tmp_2d)
2115	CALL histwrite(nid_mth,"cldq",itap,zx_tmp_2d,iim*(jjm+1),ndex2d)
2116	c
2117	CALL gr_fi_ecrit(1, klon,iim,jjm+1, ue,zx_tmp_2d)
2118	CALL histwrite(nid_mth,"ue",itap,zx_tmp_2d,iim*(jjm+1),ndex2d)
2119	c
2120	CALL gr_fi_ecrit(1, klon,iim,jjm+1, ve,zx_tmp_2d)
2121	CALL histwrite(nid_mth,"ve",itap,zx_tmp_2d,iim*(jjm+1),ndex2d)
2122	c
2123	CALL gr_fi_ecrit(1, klon,iim,jjm+1, uq,zx_tmp_2d)
2124	CALL histwrite(nid_mth,"uq",itap,zx_tmp_2d,iim*(jjm+1),ndex2d)
2125	c
2126	CALL gr_fi_ecrit(1, klon,iim,jjm+1, vq,zx_tmp_2d)
2127	CALL histwrite(nid_mth,"vq",itap,zx_tmp_2d,iim*(jjm+1),ndex2d)
2128	c
2129	c Champs 3D:
2130	C
2131	CALL gr_fi_ecrit(klev,klon,iim,jjm+1, t_seri, zx_tmp_3d)
2132	CALL histwrite(nid_mth,"temp",itap,zx_tmp_3d,
2133	. iim(jjm+1)klev,ndex3d)
2134	c
2135	CALL gr_fi_ecrit(klev,klon,iim,jjm+1, qx(1,1,ivap), zx_tmp_3d)
2136	CALL histwrite(nid_mth,"ovap",itap,zx_tmp_3d,
2137	. iim(jjm+1)klev,ndex3d)
2138	c
2139	CALL gr_fi_ecrit(klev,klon,iim,jjm+1, zphi, zx_tmp_3d)
2140	CALL histwrite(nid_mth,"geop",itap,zx_tmp_3d,
2141	. iim(jjm+1)klev,ndex3d)
2142	c
2143	CALL gr_fi_ecrit(klev,klon,iim,jjm+1, u_seri, zx_tmp_3d)
2144	CALL histwrite(nid_mth,"vitu",itap,zx_tmp_3d,
2145	. iim(jjm+1)klev,ndex3d)
2146	c
2147	CALL gr_fi_ecrit(klev,klon,iim,jjm+1, v_seri, zx_tmp_3d)
2148	CALL histwrite(nid_mth,"vitv",itap,zx_tmp_3d,
2149	. iim(jjm+1)klev,ndex3d)
2150	c
2151	CALL gr_fi_ecrit(klev,klon,iim,jjm+1, omega, zx_tmp_3d)
2152	CALL histwrite(nid_mth,"vitw",itap,zx_tmp_3d,
2153	. iim(jjm+1)klev,ndex3d)
2154	c
2155	CALL gr_fi_ecrit(klev,klon,iim,jjm+1, pplay, zx_tmp_3d)
2156	CALL histwrite(nid_mth,"pres",itap,zx_tmp_3d,
2157	. iim(jjm+1)klev,ndex3d)
2158	c
2159	CALL gr_fi_ecrit(klev,klon,iim,jjm+1, cldfra, zx_tmp_3d)
2160	CALL histwrite(nid_mth,"rneb",itap,zx_tmp_3d,
2161	. iim(jjm+1)klev,ndex3d)
2162	c
2163	CALL gr_fi_ecrit(klev,klon,iim,jjm+1, zx_rh, zx_tmp_3d)
2164	CALL histwrite(nid_mth,"rhum",itap,zx_tmp_3d,
2165	. iim(jjm+1)klev,ndex3d)
2166	c
2167	CALL gr_fi_ecrit(klev,klon,iim,jjm+1, cldliq, zx_tmp_3d)
2168	CALL histwrite(nid_mth,"oliq",itap,zx_tmp_3d,
2169	. iim(jjm+1)klev,ndex3d)
2170	c
2171	CALL gr_fi_ecrit(klev,klon,iim,jjm+1, d_t_dyn, zx_tmp_3d)
2172	CALL histwrite(nid_mth,"dtdyn",itap,zx_tmp_3d,
2173	. iim(jjm+1)klev,ndex3d)
2174	c
2175	CALL gr_fi_ecrit(klev,klon,iim,jjm+1, d_qx_dyn(1,1,ivap),
2176	. zx_tmp_3d)
2177	CALL histwrite(nid_mth,"dqdyn",itap,zx_tmp_3d,
2178	. iim(jjm+1)klev,ndex3d)
2179	c
2180	CALL gr_fi_ecrit(klev,klon,iim,jjm+1, d_t_con, zx_tmp_3d)
2181	CALL histwrite(nid_mth,"dtcon",itap,zx_tmp_3d,
2182	. iim(jjm+1)klev,ndex3d)
2183	c
2184	CALL gr_fi_ecrit(klev,klon,iim,jjm+1, d_q_con, zx_tmp_3d)
2185	CALL histwrite(nid_mth,"dqcon",itap,zx_tmp_3d,
2186	. iim(jjm+1)klev,ndex3d)
2187	c
2188	CALL gr_fi_ecrit(klev,klon,iim,jjm+1, d_t_lsc, zx_tmp_3d)
2189	CALL histwrite(nid_mth,"dtlsc",itap,zx_tmp_3d,
2190	. iim(jjm+1)klev,ndex3d)
2191	c
2192	CALL gr_fi_ecrit(klev,klon,iim,jjm+1, d_q_lsc, zx_tmp_3d)
2193	CALL histwrite(nid_mth,"dqlsc",itap,zx_tmp_3d,
2194	. iim(jjm+1)klev,ndex3d)
2195	c
2196	CALL gr_fi_ecrit(klev,klon,iim,jjm+1, d_t_vdf, zx_tmp_3d)
2197	CALL histwrite(nid_mth,"dtvdf",itap,zx_tmp_3d,
2198	. iim(jjm+1)klev,ndex3d)
2199	c
2200	CALL gr_fi_ecrit(klev,klon,iim,jjm+1, d_q_vdf, zx_tmp_3d)
2201	CALL histwrite(nid_mth,"dqvdf",itap,zx_tmp_3d,
2202	. iim(jjm+1)klev,ndex3d)
2203	c
2204	CALL gr_fi_ecrit(klev,klon,iim,jjm+1, d_t_eva, zx_tmp_3d)
2205	CALL histwrite(nid_mth,"dteva",itap,zx_tmp_3d,
2206	. iim(jjm+1)klev,ndex3d)
2207	c
2208	CALL gr_fi_ecrit(klev,klon,iim,jjm+1, d_q_eva, zx_tmp_3d)
2209	CALL histwrite(nid_mth,"dqeva",itap,zx_tmp_3d,
2210	. iim(jjm+1)klev,ndex3d)
2211	c
2212	C CALL gr_fi_ecrit(klev,klon,iim,jjm+1, d_t_ajs, zx_tmp_3d)
2213	C CALL histwrite(nid_mth,"dtajs",itap,zx_tmp_3d,
2214	C . iim(jjm+1)klev,ndex3d)
2215	c
2216	C CALL gr_fi_ecrit(klev,klon,iim,jjm+1, d_q_ajs, zx_tmp_3d)
2217	C CALL histwrite(nid_mth,"dqajs",itap,zx_tmp_3d,
2218	C . iim(jjm+1)klev,ndex3d)
2219	c
2220	CALL gr_fi_ecrit(klev,klon,iim,jjm+1, heat, zx_tmp_3d)
2221	CALL histwrite(nid_mth,"dtswr",itap,zx_tmp_3d,
2222	. iim(jjm+1)klev,ndex3d)
2223	c
2224	CALL gr_fi_ecrit(klev,klon,iim,jjm+1, heat0, zx_tmp_3d)
2225	CALL histwrite(nid_mth,"dtsw0",itap,zx_tmp_3d,
2226	. iim(jjm+1)klev,ndex3d)
2227	c
2228	CALL gr_fi_ecrit(klev,klon,iim,jjm+1, cool, zx_tmp_3d)
2229	CALL histwrite(nid_mth,"dtlwr",itap,zx_tmp_3d,
2230	. iim(jjm+1)klev,ndex3d)
2231	c
2232	CALL gr_fi_ecrit(klev,klon,iim,jjm+1, cool0, zx_tmp_3d)
2233	CALL histwrite(nid_mth,"dtlw0",itap,zx_tmp_3d,
2234	. iim(jjm+1)klev,ndex3d)
2235	c
2236	CALL gr_fi_ecrit(klev,klon,iim,jjm+1, d_u_vdf, zx_tmp_3d)
2237	CALL histwrite(nid_mth,"duvdf",itap,zx_tmp_3d,
2238	. iim(jjm+1)klev,ndex3d)
2239	c
2240	CALL gr_fi_ecrit(klev,klon,iim,jjm+1, d_v_vdf, zx_tmp_3d)
2241	CALL histwrite(nid_mth,"dvvdf",itap,zx_tmp_3d,
2242	. iim(jjm+1)klev,ndex3d)
2243	c
2244	IF (ok_orodr) THEN
2245	CALL gr_fi_ecrit(klev,klon,iim,jjm+1, d_u_oro, zx_tmp_3d)
2246	CALL histwrite(nid_mth,"duoro",itap,zx_tmp_3d,
2247	. iim(jjm+1)klev,ndex3d)
2248	c
2249	CALL gr_fi_ecrit(klev,klon,iim,jjm+1, d_v_oro, zx_tmp_3d)
2250	CALL histwrite(nid_mth,"dvoro",itap,zx_tmp_3d,
2251	. iim(jjm+1)klev,ndex3d)
2252	c
2253	ENDIF
2254	C
2255	IF (ok_orolf) THEN
2256	CALL gr_fi_ecrit(klev,klon,iim,jjm+1, d_u_lif, zx_tmp_3d)
2257	CALL histwrite(nid_mth,"dulif",itap,zx_tmp_3d,
2258	. iim(jjm+1)klev,ndex3d)
2259	c
2260	CALL gr_fi_ecrit(klev,klon,iim,jjm+1, d_v_lif, zx_tmp_3d)
2261	CALL histwrite(nid_mth,"dvlif",itap,zx_tmp_3d,
2262	. iim(jjm+1)klev,ndex3d)
2263	ENDIF
2264	C
2265	CALL gr_fi_ecrit(klev,klon,iim,jjm+1, wo, zx_tmp_3d)
2266	CALL histwrite(nid_mth,"ozone",itap,zx_tmp_3d,
2267	. iim(jjm+1)klev,ndex3d)
2268	c
2269	IF (nqmax.GE.3) THEN
2270	DO iq=1,nqmax-2
2271	IF (iq.LE.99) THEN
2272	CALL gr_fi_ecrit(klev,klon,iim,jjm+1, qx(1,1,iq+2), zx_tmp_3d)
2273	WRITE(str2,'(i2.2)') iq
2274	CALL histwrite(nid_mth,"trac"//str2,itap,zx_tmp_3d,
2275	. iim(jjm+1)klev,ndex3d)
2276	ELSE
2277	PRINT*, "Trop de traceurs"
2278	CALL abort
2279	ENDIF
2280	ENDDO
2281	ENDIF
2282	c
2283	if (ok_sync) then
2284	call histsync(nid_mth)
2285	endif
2286	ENDIF
2287	c
2288	IF (ok_instan) THEN
2289	c
2290	ndex2d = 0
2291	ndex3d = 0
2292	c
2293	c Champs 2D:
2294	c
2295	i = NINT(zout/zsto)
2296	CALL gr_fi_ecrit(1,klon,iim,jjm+1,pphis,zx_tmp_2d)
2297	CALL histwrite(nid_ins,"phis",i,zx_tmp_2d,iim*(jjm+1),ndex2d)
2298	c
2299	i = NINT(zout/zsto)
2300	CALL gr_fi_ecrit(1,klon,iim,jjm+1,paire,zx_tmp_2d)
2301	CALL histwrite(nid_ins,"aire",i,zx_tmp_2d,iim*(jjm+1),ndex2d)
2302
2303	DO i = 1, klon
2304	zx_tmp_fi2d(i) = paprs(i,1)
2305	ENDDO
2306	CALL gr_fi_ecrit(1, klon,iim,jjm+1, zx_tmp_fi2d,zx_tmp_2d)
2307	CALL histwrite(nid_ins,"psol",itap,zx_tmp_2d,iim*(jjm+1),ndex2d)
2308	c
2309	CALL gr_fi_ecrit(1, klon,iim,jjm+1, toplw,zx_tmp_2d)
2310	CALL histwrite(nid_ins,"topl",itap,zx_tmp_2d,iim*(jjm+1),ndex2d)
2311	c
2312	c Champs 3D:
2313	c
2314	CALL gr_fi_ecrit(klev,klon,iim,jjm+1, t_seri, zx_tmp_3d)
2315	CALL histwrite(nid_ins,"temp",itap,zx_tmp_3d,
2316	. iim(jjm+1)klev,ndex3d)
2317	c
2318	CALL gr_fi_ecrit(klev,klon,iim,jjm+1, u_seri, zx_tmp_3d)
2319	CALL histwrite(nid_ins,"vitu",itap,zx_tmp_3d,
2320	. iim(jjm+1)klev,ndex3d)
2321	c
2322	CALL gr_fi_ecrit(klev,klon,iim,jjm+1, v_seri, zx_tmp_3d)
2323	CALL histwrite(nid_ins,"vitv",itap,zx_tmp_3d,
2324	. iim(jjm+1)klev,ndex3d)
2325	c
2326	CALL gr_fi_ecrit(klev,klon,iim,jjm+1, zphi, zx_tmp_3d)
2327	CALL histwrite(nid_ins,"geop",itap,zx_tmp_3d,
2328	. iim(jjm+1)klev,ndex3d)
2329	c
2330	CALL gr_fi_ecrit(klev,klon,iim,jjm+1, pplay, zx_tmp_3d)
2331	CALL histwrite(nid_ins,"pres",itap,zx_tmp_3d,
2332	. iim(jjm+1)klev,ndex3d)
2333	c
2334	if (ok_sync) then
2335	call histsync(nid_ins)
2336	endif
2337	ENDIF
2338	c
2339	IF (ok_oasis .AND. mod(itap,nexca).EQ.0) THEN
2340	c
2341	c Je ne traite pas le ruissellement, pour l'instant (qui m'aidera ?)
2342	DO i = 1, klon
2343	oas_ruisoce(i) = 0.0
2344	oas_ruisriv(i) = 0.0
2345	ENDDO
2346	c
2347	ig = 1
2348	DO i = 1, iim
2349	z_sols(i,1) = oas_sols(ig)
2350	z_nsol(i,1) = oas_nsol(ig)
2351	z_rain(i,1) = oas_rain(ig)
2352	z_snow(i,1) = oas_snow(ig)
2353	z_evap(i,1) = oas_evap(ig)
2354	z_ruisoce(i,1) = oas_ruisoce(ig)
2355	z_ruisriv(i,1) = oas_ruisriv(ig)
2356	z_tsol(i,1) = oas_tsol(ig)
2357	z_fder(i,1) = oas_fder(ig)
2358	z_albe(i,1) = oas_albe(ig)
2359	z_taux(i,1) = oas_taux(ig)
2360	z_tauy(i,1) = oas_tauy(ig)
2361	ENDDO
2362	DO j = 2, jjm
2363	DO i = 1, iim
2364	ig = ig + 1
2365	z_sols(i,j) = oas_sols(ig)
2366	z_nsol(i,j) = oas_nsol(ig)
2367	z_rain(i,j) = oas_rain(ig)
2368	z_snow(i,j) = oas_snow(ig)
2369	z_evap(i,j) = oas_evap(ig)
2370	z_ruisoce(i,j) = oas_ruisoce(ig)
2371	z_ruisriv(i,j) = oas_ruisriv(ig)
2372	z_tsol(i,j) = oas_tsol(ig)
2373	z_fder(i,j) = oas_fder(ig)
2374	z_albe(i,j) = oas_albe(ig)
2375	z_taux(i,j) = oas_taux(ig)
2376	z_tauy(i,j) = oas_tauy(ig)
2377	ENDDO
2378	ENDDO
2379	ig = ig + 1
2380	DO i = 1, iim
2381	z_sols(i,jjm+1) = oas_sols(ig)
2382	z_nsol(i,jjm+1) = oas_nsol(ig)
2383	z_rain(i,jjm+1) = oas_rain(ig)
2384	z_snow(i,jjm+1) = oas_snow(ig)
2385	z_evap(i,jjm+1) = oas_evap(ig)
2386	z_ruisoce(i,jjm+1) = oas_ruisoce(ig)
2387	z_ruisriv(i,jjm+1) = oas_ruisriv(ig)
2388	z_tsol(i,jjm+1) = oas_tsol(ig)
2389	z_fder(i,jjm+1) = oas_fder(ig)
2390	z_albe(i,jjm+1) = oas_albe(ig)
2391	z_taux(i,jjm+1) = oas_taux(ig)
2392	z_tauy(i,jjm+1) = oas_tauy(ig)
2393	ENDDO
2394	c
2395	c Passer les champs au coupleur:
2396	c
2397	CALL intocpl(itap,(jjm+1)*iim,
2398	. z_sols, z_nsol,
2399	. z_rain, z_snow, z_evap,
2400	. z_ruisoce, z_ruisriv,
2401	. z_tsol, z_fder, z_albe,
2402	. z_taux, z_tauy)
2403	DO i = 1, klon
2404	oas_sols(i) = 0.0
2405	oas_nsol(i) = 0.0
2406	oas_rain(i) = 0.0
2407	oas_snow(i) = 0.0
2408	oas_evap(i) = 0.0
2409	oas_ruis(i) = 0.0
2410	oas_tsol(i) = 0.0
2411	oas_fder(i) = 0.0
2412	oas_albe(i) = 0.0
2413	oas_taux(i) = 0.0
2414	oas_tauy(i) = 0.0
2415	ENDDO
2416	ENDIF
2417	c
2418	c Ecrire la bande regionale (binaire grads)
2419	IF (ok_region .AND. mod(itap,ecrit_reg).eq.0) THEN
2420	CALL ecriregs(84,zxtsol)
2421	CALL ecriregs(84,paprs(1,1))
2422	CALL ecriregs(84,topsw)
2423	CALL ecriregs(84,toplw)
2424	CALL ecriregs(84,solsw)
2425	CALL ecriregs(84,sollw)
2426	CALL ecriregs(84,rain_fall)
2427	CALL ecriregs(84,snow_fall)
2428	CALL ecriregs(84,evap)
2429	CALL ecriregs(84,sens)
2430	CALL ecriregs(84,bils)
2431	CALL ecriregs(84,pctsrf(1,is_sic))
2432	CALL ecriregs(84,fluxu(1,1))
2433	CALL ecriregs(84,fluxv(1,1))
2434	CALL ecriregs(84,ue)
2435	CALL ecriregs(84,ve)
2436	CALL ecriregs(84,uq)
2437	CALL ecriregs(84,vq)
2438	c
2439	CALL ecrirega(84,u_seri)
2440	CALL ecrirega(84,v_seri)
2441	CALL ecrirega(84,omega)
2442	CALL ecrirega(84,t_seri)
2443	CALL ecrirega(84,zphi)
2444	CALL ecrirega(84,q_seri)
2445	CALL ecrirega(84,cldfra)
2446	CALL ecrirega(84,cldliq)
2447	CALL ecrirega(84,pplay)
2448
2449
2450	cc CALL ecrirega(84,d_t_dyn)
2451	cc CALL ecrirega(84,d_q_dyn)
2452	cc CALL ecrirega(84,heat)
2453	cc CALL ecrirega(84,cool)
2454	cc CALL ecrirega(84,d_t_con)
2455	cc CALL ecrirega(84,d_q_con)
2456	cc CALL ecrirega(84,d_t_lsc)
2457	cc CALL ecrirega(84,d_q_lsc)
2458	ENDIF
2459	c
2460	c Convertir les incrementations en tendances
2461	c
2462	DO k = 1, klev
2463	DO i = 1, klon
2464	d_u(i,k) = ( u_seri(i,k) - u(i,k) ) / dtime
2465	d_v(i,k) = ( v_seri(i,k) - v(i,k) ) / dtime
2466	d_t(i,k) = ( t_seri(i,k)-t(i,k) ) / dtime
2467	d_qx(i,k,ivap) = ( q_seri(i,k) - qx(i,k,ivap) ) / dtime
2468	d_qx(i,k,iliq) = ( ql_seri(i,k) - qx(i,k,iliq) ) / dtime
2469	ENDDO
2470	ENDDO
2471	c
2472	IF (nqmax.GE.3) THEN
2473	DO iq = 3, nqmax
2474	DO k = 1, klev
2475	DO i = 1, klon
2476	d_qx(i,k,iq) = ( tr_seri(i,k,iq-2) - qx(i,k,iq) ) / dtime
2477	ENDDO
2478	ENDDO
2479	ENDDO
2480	ENDIF
2481	c
2482	c====================================================================
2483	c Si c'est la fin, il faut conserver l'etat de redemarrage
2484	c====================================================================
2485	c
2486	IF (lafin) THEN
2487	IF (ok_oasis) CALL quitcpl
2488	CALL phyredem ("restartphy.nc",dtime,radpas,co2_ppm,solaire,
2489	. rlat,rlon,ftsol,ftsoil,deltat,fqsol,fsnow,
2490	. radsol,rugmer,agesno,
2491	. zmea,zstd,zsig,zgam,zthe,zpic,zval,rugoro)
2492	ENDIF
2493
2494	RETURN
2495	END
2496	SUBROUTINE qcheck(klon,klev,paprs,q,ql,marque)
2497	IMPLICIT none
2498	c
2499	c Calculer et imprimer l'eau totale. A utiliser pour verifier
2500	c la conservation de l'eau
2501	c
2502	#include "YOMCST.h"
2503	INTEGER klon,klev
2504	REAL paprs(klon,klev+1), q(klon,klev), ql(klon,klev)
2505	CHARACTER () marque
2506	REAL qtotal
2507	INTEGER i, k
2508	c
2509	qtotal = 0.0
2510	DO k = 1, klev
2511	DO i = 1, klon
2512	qtotal = qtotal + (q(i,k)+ql(i,k))
2513	. *(paprs(i,k)-paprs(i,k+1))/RG
2514	ENDDO
2515	ENDDO
2516	c
2517	PRINT*, "Eau totale ",marque, qtotal/FLOAT(klon)
2518	c
2519	END
2520	SUBROUTINE gr_fi_ecrit(nfield,nlon,iim,jjmp1,fi,ecrit)
2521	IMPLICIT none
2522	c
2523	c Tranformer une variable de la grille physique a
2524	c la grille d'ecriture
2525	c
2526	INTEGER nfield,nlon,iim,jjmp1, jjm
2527	REAL fi(nlon,nfield), ecrit(iim*jjmp1,nfield)
2528	c
2529	INTEGER i, j, n, ig
2530	c
2531	jjm = jjmp1 - 1
2532	DO n = 1, nfield
2533	DO i=1,iim
2534	ecrit(i,n) = fi(1,n)
2535	ecrit(i+jjm*iim,n) = fi(nlon,n)
2536	ENDDO
2537	DO ig = 1, nlon - 2
2538	ecrit(iim+ig,n) = fi(1+ig,n)
2539	ENDDO
2540	ENDDO
2541	RETURN
2542	END
2543

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

Download in other formats:

Original Format