Context Navigation

physiq.F @ 80

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

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

Download in other formats:

Original Format