Context Navigation

physiq.F @ 32

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

Rev	Line
[2]	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"
[23]	278	PARAMETER (offline=.FALSE.)
[2]	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)
[23]	434	REAL prfl(klon,klev+1), psfl(klon,klev+1)
[2]	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
[29]	508	INTEGER ndex2d(iim(jjm+1)),ndex3d(iim(jjm+1)*klev)
[2]	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
[29]	812	ndex2d = 0
	813	ndex3d = 0
[2]	814	c
[29]	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)
[2]	818	c
[29]	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)
[2]	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
[29]	1160	ndex2d = 0
	1161	ndex3d = 0
[2]	1162	c
[29]	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)
[2]	1166	C
[29]	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)
[2]	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
[29]	1242	ndex2d = 0
	1243	ndex3d = 0
[2]	1244	c
[29]	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)
[2]	1248	c
[29]	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)
[2]	1252	c
	1253	ENDIF
	1254	c
	1255	c
	1256	c
	1257	c Prescrire l'ozone dans l'atmosphere
	1258	c
	1259	c
	1260	cc DO i = 1, klon
	1261	cc DO k = 1, klev
	1262	cc CALL o3cm (paprs(i,k)/100.,paprs(i,k+1)/100., wo(i,k),20)
	1263	cc ENDDO
	1264	cc ENDDO
	1265	c
	1266	IF (ok_oasis) THEN
	1267	DO i = 1, klon
	1268	oas_sols(i) = 0.0
	1269	oas_nsol(i) = 0.0
	1270	oas_rain(i) = 0.0
	1271	oas_snow(i) = 0.0
	1272	oas_evap(i) = 0.0
	1273	oas_ruis(i) = 0.0
	1274	oas_tsol(i) = 0.0
	1275	oas_fder(i) = 0.0
	1276	oas_albe(i) = 0.0
	1277	oas_taux(i) = 0.0
	1278	oas_tauy(i) = 0.0
	1279	ENDDO
	1280	ENDIF
	1281	c
	1282	ENDIF
	1283	c
	1284	c ************** Fin de IF ( debut ) *************
	1285	c
	1286	c
	1287	c Mettre a zero des variables de sortie (pour securite)
	1288	c
	1289	DO i = 1, klon
	1290	d_ps(i) = 0.0
	1291	ENDDO
	1292	DO k = 1, klev
	1293	DO i = 1, klon
	1294	d_t(i,k) = 0.0
	1295	d_u(i,k) = 0.0
	1296	d_v(i,k) = 0.0
	1297	ENDDO
	1298	ENDDO
	1299	DO iq = 1, nqmax
	1300	DO k = 1, klev
	1301	DO i = 1, klon
	1302	d_qx(i,k,iq) = 0.0
	1303	ENDDO
	1304	ENDDO
	1305	ENDDO
	1306	c
	1307	c Ne pas affecter les valeurs entrees de u, v, h, et q
	1308	c
	1309	DO k = 1, klev
	1310	DO i = 1, klon
	1311	t_seri(i,k) = t(i,k)
	1312	u_seri(i,k) = u(i,k)
	1313	v_seri(i,k) = v(i,k)
	1314	q_seri(i,k) = qx(i,k,ivap)
	1315	ql_seri(i,k) = qx(i,k,iliq)
	1316	ENDDO
	1317	ENDDO
	1318	IF (nqmax.GE.3) THEN
	1319	DO iq = 3, nqmax
	1320	DO k = 1, klev
	1321	DO i = 1, klon
	1322	tr_seri(i,k,iq-2) = qx(i,k,iq)
	1323	ENDDO
	1324	ENDDO
	1325	ENDDO
	1326	ELSE
	1327	DO k = 1, klev
	1328	DO i = 1, klon
	1329	tr_seri(i,k,1) = 0.0
	1330	ENDDO
	1331	ENDDO
	1332	ENDIF
	1333	c
	1334	c Ajouter le geopotentiel du sol:
	1335	c
	1336	DO k = 1, klev
	1337	DO i = 1, klon
	1338	zphi(i,k) = pphi(i,k) + pphis(i)
	1339	ENDDO
	1340	ENDDO
	1341	c
	1342	c Verifier les temperatures
	1343	c
	1344
	1345	CALL hgardfou(t_seri,ftsol,'debutphy')
	1346	c
	1347	c Incrementer le compteur de la physique
	1348	c
	1349	itap = itap + 1
	1350	julien = MOD(NINT(xjour),360)
	1351	c
	1352	c Mettre en action les conditions aux limites (albedo, sst, etc.).
	1353	c Prescrire l'ozone et calculer l'albedo sur l'ocean.
	1354	c
	1355	IF (MOD(itap-1,lmt_pas) .EQ. 0) THEN
	1356	idayvrai = NINT(xjour)
	1357	PRINT *,' PHYS cond julien ',julien,idayvrai
	1358	CALL condsurf(julien,idayvrai, pctsrf ,
	1359	. lmt_sst,lmt_alb,lmt_rug,lmt_bils )
	1360	CALL ozonecm( FLOAT(julien), rlat, paprs, wo)
	1361	ENDIF
	1362	c
	1363
	1364	IF (ok_ocean) THEN
	1365	DO i = 1, klon
	1366	ftsol(i,is_oce) = lmt_sst(i) + deltat(i)
	1367	ENDDO
	1368
	1369	ELSE
	1370	DO i = 1, klon
	1371	ftsol(i,is_oce) = lmt_sst(i)
	1372	ENDDO
	1373
	1374	ENDIF
	1375	c
	1376	c Re-evaporer l'eau liquide nuageuse
	1377	c
	1378	DO k = 1, klev ! re-evaporation de l'eau liquide nuageuse
	1379	DO i = 1, klon
	1380	zlvdcp=RLVTT/RCPD/(1.0+RVTMP2*q_seri(i,k))
	1381	zlsdcp=RLSTT/RCPD/(1.0+RVTMP2*q_seri(i,k))
	1382	zdelta = MAX(0.,SIGN(1.,RTT-t_seri(i,k)))
	1383	zb = MAX(0.0,ql_seri(i,k))
	1384	za = - MAX(0.0,ql_seri(i,k))
	1385	. * (zlvdcp(1.-zdelta)+zlsdcpzdelta)
	1386	t_seri(i,k) = t_seri(i,k) + za
	1387	q_seri(i,k) = q_seri(i,k) + zb
	1388	ql_seri(i,k) = 0.0
	1389	d_t_eva(i,k) = za
	1390	d_q_eva(i,k) = zb
	1391	ENDDO
	1392	ENDDO
	1393	c
	1394	c Appeler la diffusion verticale (programme de couche limite)
	1395	c
	1396	DO i = 1, klon
	1397	frugs(i,is_ter) = SQRT(lmt_rug(i)2+rugoro(i)2)
	1398	frugs(i,is_lic) = rugoro(i)
	1399	frugs(i,is_oce) = rugmer(i)
	1400	frugs(i,is_sic) = 0.001
	1401	zxrugs(i) = 0.0
	1402	ENDDO
	1403	DO nsrf = 1, nbsrf
	1404	DO i = 1, klon
	1405	frugs(i,nsrf) = MAX(frugs(i,nsrf),0.001)
	1406	ENDDO
	1407	ENDDO
	1408	DO nsrf = 1, nbsrf
	1409	DO i = 1, klon
	1410	zxrugs(i) = zxrugs(i) + frugs(i,nsrf)*pctsrf(i,nsrf)
	1411	ENDDO
	1412	ENDDO
	1413	c
	1414	CALL clmain(dtime,pctsrf,
	1415	e t_seri,q_seri,u_seri,v_seri,soil_model,
	1416	e ftsol,soilcap,soilflux,paprs,pplay,radsol,
	1417	e fsnow,fqsol,
	1418	e rlat, frugs,
	1419	s d_t_vdf,d_q_vdf,d_u_vdf,d_v_vdf,d_ts,
	1420	s fluxt,fluxq,fluxu,fluxv,cdragh,cdragm,rugmer,
	1421	s dsens, devap,
	1422	s ycoefh,yu1,yv1)
	1423	c
	1424	DO i = 1, klon
	1425	sens(i) = - fluxt(i,1) ! flux de chaleur sensible au sol
	1426	evap(i) = - fluxq(i,1) ! flux d'evaporation au sol
	1427	fder(i) = dsens(i) + devap(i)
	1428	ENDDO
	1429	DO k = 1, klev
	1430	DO i = 1, klon
	1431	t_seri(i,k) = t_seri(i,k) + d_t_vdf(i,k)
	1432	q_seri(i,k) = q_seri(i,k) + d_q_vdf(i,k)
	1433	u_seri(i,k) = u_seri(i,k) + d_u_vdf(i,k)
	1434	v_seri(i,k) = v_seri(i,k) + d_v_vdf(i,k)
	1435	ENDDO
	1436	ENDDO
	1437	c
	1438	c Incrementer la temperature du sol
	1439	c
	1440	DO i = 1, klon
	1441	zxtsol(i) = 0.0
	1442	ENDDO
	1443	DO nsrf = 1, nbsrf
	1444	DO i = 1, klon
	1445	ftsol(i,nsrf) = ftsol(i,nsrf) + d_ts(i,nsrf)
	1446	zxtsol(i) = zxtsol(i) + ftsol(i,nsrf)*pctsrf(i,nsrf)
	1447	ENDDO
	1448	ENDDO
	1449
	1450	c
	1451	c Si une sous-fraction n'existe pas, elle prend la temp. moyenne
	1452	c
	1453	DO nsrf = 1, nbsrf
	1454	DO i = 1, klon
	1455	IF (pctsrf(i,nsrf).LT.epsfra) ftsol(i,nsrf) = zxtsol(i)
	1456	ENDDO
	1457	ENDDO
	1458
	1459	c
	1460	c Appeler le modele du sol
	1461	c
	1462	IF (soil_model) THEN
	1463	DO nsrf = 1, nbsrf
	1464	CALL soil(dtime, nsrf, fsnow(1,nsrf),
	1465	. ftsol(1,nsrf), ftsoil(1,1,nsrf),
	1466	. soilcap(1,nsrf), soilflux(1,nsrf))
	1467	ENDDO
	1468	ENDIF
	1469	c
	1470	c Calculer la derive du flux infrarouge
	1471	c
	1472	DO nsrf = 1, nbsrf
	1473	DO i = 1, klon
	1474	fder(i) = fder(i) - 4.0RSIGMAzxtsol(i)*3
	1475	. (ftsol(i,nsrf)-zxtsol(i))
	1476	. *pctsrf(i,nsrf)
	1477	ENDDO
	1478	ENDDO
	1479	c
	1480	c Appeler la convection (au choix)
	1481	c
	1482	DO k = 1, klev
	1483	DO i = 1, klon
	1484	conv_q(i,k) = d_qx_dyn(i,k,ivap)
	1485	. + d_q_vdf(i,k)/dtime
	1486	conv_t(i,k) = d_t_dyn(i,k)
	1487	. + d_t_vdf(i,k)/dtime
	1488	ENDDO
	1489	ENDDO
	1490	IF (check) THEN
	1491	CALL qcheck(klon,klev,paprs,q_seri,ql_seri,"avantcon=")
	1492	ENDIF
	1493	IF (iflag_con.EQ.1) THEN
	1494	stop'reactiver le call conlmd dans physiq.F'
	1495	c CALL conlmd (dtime, paprs, pplay, t_seri, q_seri, conv_q,
	1496	c . d_t_con, d_q_con,
	1497	c . rain_con, snow_con, ibas_con, itop_con)
	1498	ELSE IF (iflag_con.EQ.2) THEN
	1499	CALL conflx(dtime, paprs, pplay, t_seri, q_seri,
	1500	e conv_t, conv_q, fluxq(1,1), omega,
	1501	s d_t_con, d_q_con, rain_con, snow_con,
	1502	s pmfu, pmfd, pen_u, pde_u, pen_d, pde_d,
	1503	s kcbot, kctop, kdtop, pmflxr, pmflxs)
	1504	DO i = 1, klon
	1505	ibas_con(i) = klev+1 - kcbot(i)
	1506	itop_con(i) = klev+1 - kctop(i)
	1507	ENDDO
	1508	ELSE IF (iflag_con.EQ.3) THEN
	1509	stop'reactiver le call conlmd dans physiq.F'
	1510	c CALL conccm (dtime,paprs,pplay,t_seri,q_seri,conv_q,
	1511	c s d_t_con, d_q_con,
	1512	c s rain_con, snow_con, ibas_con, itop_con)
	1513	ELSE
	1514	PRINT*, "iflag_con non-prevu", iflag_con
	1515	CALL abort
	1516	ENDIF
	1517	CALL homogene(paprs, q_seri, d_q_con, u_seri,v_seri,
	1518	. d_u_con, d_v_con)
	1519	DO k = 1, klev
	1520	DO i = 1, klon
	1521	t_seri(i,k) = t_seri(i,k) + d_t_con(i,k)
	1522	q_seri(i,k) = q_seri(i,k) + d_q_con(i,k)
	1523	u_seri(i,k) = u_seri(i,k) + d_u_con(i,k)
	1524	v_seri(i,k) = v_seri(i,k) + d_v_con(i,k)
	1525	ENDDO
	1526	ENDDO
	1527	IF (check) THEN
	1528	CALL qcheck(klon,klev,paprs,q_seri,ql_seri,"aprescon=")
	1529	zx_t = 0.0
	1530	DO i = 1, klon
	1531	zx_t = zx_t + rain_con(i)+snow_con(i)
	1532	ENDDO
	1533	zx_t = zx_t/FLOAT(klon)*dtime
	1534	PRINT*, "Precip=", zx_t
	1535	ENDIF
	1536	c
	1537	IF (nqmax.GT.2) THEN !--melange convectif de traceurs
	1538	c
	1539	IF (iflag_con.NE.2) THEN
	1540	PRINT*, "Pour l instant, seul conflx fonctionne avec traceurs"
	1541	PRINT*,' Mettre iflag_con = 2 dans run.def et repasser !'
	1542	CALL abort
	1543	ENDIF
	1544	c
	1545	ENDIF !--nqmax.GT.2
	1546	c
	1547	c Appeler l'ajustement sec
	1548	c
	1549	C appel supprime pour le moment
	1550	c
	1551	c Appeler le processus de condensation a grande echelle
	1552	c et le processus de precipitation
	1553	c
	1554	CALL fisrtilp_tr(dtime,paprs,pplay,
	1555	. t_seri, q_seri,
	1556	. d_t_lsc, d_q_lsc, d_ql_lsc, rneb, cldliq,
	1557	. rain_lsc, snow_lsc,
	1558	. pfrac_impa, pfrac_nucl, pfrac_1nucl,
[23]	1559	. frac_impa, frac_nucl,
	1560	. prfl, psfl)
[2]	1561	DO k = 1, klev
	1562	DO i = 1, klon
	1563	t_seri(i,k) = t_seri(i,k) + d_t_lsc(i,k)
	1564	q_seri(i,k) = q_seri(i,k) + d_q_lsc(i,k)
	1565	ql_seri(i,k) = ql_seri(i,k) + d_ql_lsc(i,k)
	1566	cldfra(i,k) = rneb(i,k)
	1567	IF (.NOT.new_oliq) cldliq(i,k) = ql_seri(i,k)
	1568	ENDDO
	1569	ENDDO
	1570	IF (check) THEN
	1571	CALL qcheck(klon,klev,paprs,q_seri,ql_seri,"apresilp=")
	1572	zx_t = 0.0
	1573	DO i = 1, klon
	1574	zx_t = zx_t + rain_lsc(i)+snow_lsc(i)
	1575	ENDDO
	1576	zx_t = zx_t/FLOAT(klon)*dtime
	1577	PRINT*, "Precip=", zx_t
	1578	ENDIF
	1579	c
	1580	c Nuages diagnostiques:
	1581	c
	1582	IF (iflag_con.EQ.2) THEN ! seulement pour Tiedtke
	1583	CALL diagcld(paprs,pplay,t_seri,q_seri,
	1584	. rain_con,snow_con,ibas_con,itop_con,
	1585	. diafra,dialiq)
	1586	DO k = 1, klev
	1587	DO i = 1, klon
	1588	IF (diafra(i,k).GT.cldfra(i,k)) THEN
	1589	cldliq(i,k) = dialiq(i,k)
	1590	cldfra(i,k) = diafra(i,k)
	1591	ENDIF
	1592	ENDDO
	1593	ENDDO
	1594	ENDIF
	1595	c
	1596	c Precipitation totale
	1597	c
	1598	DO i = 1, klon
	1599	rain_fall(i) = rain_con(i) + rain_lsc(i)
	1600	snow_fall(i) = snow_con(i) + snow_lsc(i)
	1601	ENDDO
	1602	c
	1603	c Calculer l'humidite relative pour diagnostique
	1604	c
	1605	DO k = 1, klev
	1606	DO i = 1, klon
	1607	zx_t = t_seri(i,k)
	1608	IF (thermcep) THEN
	1609	zdelta = MAX(0.,SIGN(1.,rtt-zx_t))
	1610	zx_qs = r2es * FOEEW(zx_t,zdelta)/pplay(i,k)
	1611	zx_qs = MIN(0.5,zx_qs)
	1612	zcor = 1./(1.-retv*zx_qs)
	1613	zx_qs = zx_qs*zcor
	1614	ELSE
	1615	IF (zx_t.LT.t_coup) THEN
	1616	zx_qs = qsats(zx_t)/pplay(i,k)
	1617	ELSE
	1618	zx_qs = qsatl(zx_t)/pplay(i,k)
	1619	ENDIF
	1620	ENDIF
	1621	zx_rh(i,k) = q_seri(i,k)/zx_qs
	1622	ENDDO
	1623	ENDDO
	1624	c
	1625	c Calculer les parametres optiques des nuages et quelques
	1626	c parametres pour diagnostiques:
	1627	c
	1628	CALL nuage (paprs, pplay,
	1629	. t_seri, cldliq, cldfra, cldtau, cldemi,
	1630	. cldh, cldl, cldm, cldt, cldq)
	1631	c
	1632	c Appeler le rayonnement mais calculer tout d'abord l'albedo du sol.
	1633	c
	1634	IF (MOD(itaprad,radpas).EQ.0) THEN
	1635	CALL orbite(FLOAT(julien),zlongi,dist)
	1636	IF (cycle_diurne) THEN
	1637	zdtime=dtime*FLOAT(radpas) ! pas de temps du rayonnement (s)
	1638	CALL zenang(zlongi,gmtime,zdtime,rlat,rlon,rmu0,fract)
	1639	c CALL zenith(zlongi,gmtime,rlat,rlon,rmu0,fract) !va disparaitre
	1640	CALL alboc_cd(rmu0,alb_eau)
	1641	ELSE
	1642	CALL angle(zlongi,rlat,fract,rmu0)
	1643	CALL alboc(FLOAT(julien),rlat,alb_eau)
	1644	ENDIF
	1645	CALL albsno(veget,agesno,alb_neig)
	1646	DO i = 1, klon
	1647	zx_alb_oce = alb_eau(i)
	1648	IF (pctsrf(i,is_oce).GT.epsfra .AND. ftsol(i,is_oce).LT.271.35)
	1649	. zx_alb_oce = 0.6 ! pour slab_ocean
	1650	zfra = MAX(0.0,MIN(1.0,fsnow(i,is_lic)/(fsnow(i,is_lic)+10.0)))
	1651	zx_alb_lic = alb_neig(i)zfra + 0.6(1.0-zfra)
	1652	zfra = MAX(0.0,MIN(1.0,fsnow(i,is_ter)/(fsnow(i,is_ter)+10.0)))
	1653	zx_alb_ter = alb_neig(i)zfra + lmt_alb(i)(1.0-zfra)
	1654	zfra = MAX(0.0,MIN(1.0,fsnow(i,is_sic)/(fsnow(i,is_sic)+10.0)))
	1655	zx_alb_sic = alb_neig(i)zfra + 0.6(1.0-zfra)
	1656	albsol(i) = zx_alb_oce * pctsrf(i,is_oce)
	1657	. + zx_alb_lic * pctsrf(i,is_lic)
	1658	. + zx_alb_ter * pctsrf(i,is_ter)
	1659	. + zx_alb_sic * pctsrf(i,is_sic)
	1660	ENDDO
	1661	CALL radlwsw ! nouveau rayonnement (compatible Arpege-IFS)
	1662	e (dist, rmu0, fract, co2_ppm, solaire,
	1663	e paprs, pplay,zxtsol,albsol, t_seri,q_seri,wo,
	1664	e cldfra, cldemi, cldtau,
	1665	s heat,heat0,cool,cool0,radsol,albpla,
	1666	s topsw,toplw,solsw,sollw,
	1667	s topsw0,toplw0,solsw0,sollw0)
	1668	itaprad = 0
	1669	ENDIF
	1670	itaprad = itaprad + 1
	1671	c
	1672	c Ajouter la tendance des rayonnements (tous les pas)
	1673	c
	1674	DO k = 1, klev
	1675	DO i = 1, klon
	1676	t_seri(i,k) = t_seri(i,k)
	1677	. + (heat(i,k)-cool(i,k)) * dtime/86400.
	1678	ENDDO
	1679	ENDDO
	1680	c
	1681	c Calculer l'hydrologie de la surface
	1682	c
	1683	CALL hydrol(dtime,pctsrf,rain_fall, snow_fall, evap,
	1684	. agesno, ftsol,fqsol,fsnow, ruis)
	1685	c
	1686	DO i = 1, klon
	1687	zxqsol(i) = 0.0
	1688	zxsnow(i) = 0.0
	1689	ENDDO
	1690	DO nsrf = 1, nbsrf
	1691	DO i = 1, klon
	1692	zxqsol(i) = zxqsol(i) + fqsol(i,nsrf)*pctsrf(i,nsrf)
	1693	zxsnow(i) = zxsnow(i) + fsnow(i,nsrf)*pctsrf(i,nsrf)
	1694	ENDDO
	1695	ENDDO
	1696	c
	1697	c Si une sous-fraction n'existe pas, elle prend la valeur moyenne
	1698	c
	1699	DO nsrf = 1, nbsrf
	1700	DO i = 1, klon
	1701	IF (pctsrf(i,nsrf).LT.epsfra) THEN
	1702	fqsol(i,nsrf) = zxqsol(i)
	1703	fsnow(i,nsrf) = zxsnow(i)
	1704	ENDIF
	1705	ENDDO
	1706	ENDDO
	1707	c
	1708	c Calculer le bilan du sol et la derive de temperature (couplage)
	1709	c
	1710	DO i = 1, klon
	1711	bils(i) = radsol(i) - sens(i) - evap(i)*RLVTT
	1712	ENDDO
	1713	IF (ok_ocean) THEN
	1714	DO i = 1, klon
	1715	cthermiq = cyang
	1716	IF (ftsol(i,is_oce).LT. 271.35) cthermiq = cbing
	1717	IF (pctsrf(i,is_oce).GT.epsfra) deltat(i) = deltat(i) +
	1718	. (bils(i)-lmt_bils(i))/cthermiq * dtime
	1719	IF (deltat(i).GT.15.0 ) deltat(i) = 15.0
	1720	IF (deltat(i).LT.-15.0) deltat(i) = -15.0
	1721	ENDDO
	1722	ENDIF
	1723	c
	1724	cmoddeblott(jan95)
	1725	c Appeler le programme de parametrisation de l'orographie
	1726	c a l'echelle sous-maille:
	1727	c
	1728	IF (ok_orodr) THEN
	1729	c
	1730	c selection des points pour lesquels le shema est actif:
	1731	igwd=0
	1732	DO i=1,klon
	1733	itest(i)=0
	1734	c IF ((zstd(i).gt.10.0)) THEN
	1735	IF (((zpic(i)-zmea(i)).GT.100.).AND.(zstd(i).GT.10.0)) THEN
	1736	itest(i)=1
	1737	igwd=igwd+1
	1738	idx(igwd)=i
	1739	ENDIF
	1740	ENDDO
	1741	igwdim=MAX(1,igwd)
	1742	c
	1743	CALL drag_noro(klon,klev,dtime,paprs,pplay,
	1744	e zmea,zstd, zsig, zgam, zthe,zpic,zval,
	1745	e igwd,igwdim,idx,itest,
	1746	e t_seri, u_seri, v_seri,
	1747	s zulow, zvlow, zustr, zvstr,
	1748	s d_t_oro, d_u_oro, d_v_oro)
	1749	c
	1750	c ajout des tendances
	1751	DO k = 1, klev
	1752	DO i = 1, klon
	1753	t_seri(i,k) = t_seri(i,k) + d_t_oro(i,k)
	1754	u_seri(i,k) = u_seri(i,k) + d_u_oro(i,k)
	1755	v_seri(i,k) = v_seri(i,k) + d_v_oro(i,k)
	1756	ENDDO
	1757	ENDDO
	1758	c
	1759	ENDIF ! fin de test sur ok_orodr
	1760	c
	1761	IF (ok_orolf) THEN
	1762	c
	1763	c selection des points pour lesquels le shema est actif:
	1764	igwd=0
	1765	DO i=1,klon
	1766	itest(i)=0
	1767	IF ((zpic(i)-zmea(i)).GT.100.) THEN
	1768	itest(i)=1
	1769	igwd=igwd+1
	1770	idx(igwd)=i
	1771	ENDIF
	1772	ENDDO
	1773	igwdim=MAX(1,igwd)
	1774	c
	1775	CALL lift_noro(klon,klev,dtime,paprs,pplay,
	1776	e rlat,zmea,zstd, zsig, zgam, zthe,zpic,zval,
	1777	e igwd,igwdim,idx,itest,
	1778	e t_seri, u_seri, v_seri,
	1779	s zulow, zvlow, zustr, zvstr,
	1780	s d_t_lif, d_u_lif, d_v_lif)
	1781	c
	1782	c ajout des tendances
	1783	DO k = 1, klev
	1784	DO i = 1, klon
	1785	t_seri(i,k) = t_seri(i,k) + d_t_lif(i,k)
	1786	u_seri(i,k) = u_seri(i,k) + d_u_lif(i,k)
	1787	v_seri(i,k) = v_seri(i,k) + d_v_lif(i,k)
	1788	ENDDO
	1789	ENDDO
	1790	c
	1791	ENDIF ! fin de test sur ok_orolf
	1792	c
	1793	cAA
	1794	cAA Installation de l'interface online-offline pour traceurs
	1795	cAA
	1796	c====================================================================
	1797	c Calcul des tendances traceurs
	1798	c====================================================================
	1799	CMAF modif pour garder info du nombre de traceurs auxquels
	1800	C la physique s'applique
	1801	C
[29]	1802	write(,) 'Phytrac= '
[2]	1803	call phytrac (rnpb,
	1804	I debut,
	1805	I nqmax-2,
	1806	I nlon,nlev,dtime,
	1807	I t,paprs,pplay,
	1808	I pmfu, pmfd, pen_u, pde_u, pen_d, pde_d,
	1809	I ycoefh,yu1,yv1,ftsol,pctsrf,rlat,
	1810	I frac_impa, frac_nucl,
	1811	I rlon,presnivs,paire,pphis,
	1812	O tr_seri)
	1813
[29]	1814	write(,) 'OFFLINE= ', offline
[2]	1815	IF (offline) THEN
[29]	1816	write(,) 'OFFLINE= ', offline
[2]	1817	call phystoke (
	1818	I nlon,nlev,pdtphys,
	1819	I pmfu, pmfd, pen_u, pde_u, pen_d, pde_d,
	1820	I ycoefh,yu1,yv1,ftsol,pctsrf,
	1821	I frac_impa, frac_nucl)
	1822
	1823	ENDIF
	1824
	1825	c
	1826	c Calculer le transport de l'eau et de l'energie (diagnostique)
	1827	c
	1828	CALL transp (paprs,zxtsol,
	1829	e t_seri, q_seri, u_seri, v_seri, zphi,
	1830	s ve, vq, ue, uq)
	1831	c
	1832	c Accumuler les variables a stocker dans les fichiers histoire:
	1833	c
	1834	IF (ok_oasis) THEN ! couplage oasis
	1835	DO i = 1, klon
	1836	oas_sols(i) = oas_sols(i) + solsw(i) / FLOAT(nexca)
	1837	oas_nsol(i) = oas_nsol(i) + (bils(i)-solsw(i))/ FLOAT(nexca)
	1838	oas_rain(i) = oas_rain(i) + rain_fall(i) / FLOAT(nexca)
	1839	oas_snow(i) = oas_snow(i) + snow_fall(i) / FLOAT(nexca)
	1840	oas_evap(i) = oas_evap(i) + evap(i) / FLOAT(nexca)
	1841	oas_tsol(i) = oas_tsol(i) + zxtsol(i) / FLOAT(nexca)
	1842	oas_fder(i) = oas_fder(i) + fder(i) / FLOAT(nexca)
	1843	oas_albe(i) = oas_albe(i) + albsol(i) / FLOAT(nexca)
	1844	oas_taux(i) = oas_taux(i) + fluxu(i,1) / FLOAT(nexca)
	1845	oas_tauy(i) = oas_tauy(i) + fluxv(i,1) / FLOAT(nexca)
	1846	oas_ruis(i) = oas_ruis(i) + ruis(i) /FLOAT(nexca)/dtime
	1847	ENDDO
	1848	ENDIF
	1849	c
	1850	c
	1851	IF (ok_journe) THEN
	1852	c
[29]	1853	ndex2d = 0
	1854	ndex3d = 0
[2]	1855	c
	1856	c Champs 2D:
	1857	c
[29]	1858	i = NINT(zout/zsto)
	1859	CALL gr_fi_ecrit(1,klon,iim,jjm+1,pphis,zx_tmp_2d)
	1860	CALL histwrite(nid_day,"phis",i,zx_tmp_2d,iim*(jjm+1),ndex2d)
	1861	c
	1862	i = NINT(zout/zsto)
	1863	CALL gr_fi_ecrit(1,klon,iim,jjm+1,paire,zx_tmp_2d)
	1864	CALL histwrite(nid_day,"aire",i,zx_tmp_2d,iim*(jjm+1),ndex2d)
	1865	C
[2]	1866	CALL gr_fi_ecrit(1, klon,iim,jjm+1, zxtsol,zx_tmp_2d)
[29]	1867	CALL histwrite(nid_day,"tsol",itap,zx_tmp_2d,iim*(jjm+1),ndex2d)
[2]	1868	c
	1869	DO i = 1, klon
	1870	zx_tmp_fi2d(i) = paprs(i,1)
	1871	ENDDO
	1872	CALL gr_fi_ecrit(1, klon,iim,jjm+1, zx_tmp_fi2d,zx_tmp_2d)
[29]	1873	CALL histwrite(nid_day,"psol",itap,zx_tmp_2d,iim*(jjm+1),ndex2d)
[2]	1874	c
	1875	DO i = 1, klon
	1876	zx_tmp_fi2d(i) = rain_fall(i) + snow_fall(i)
	1877	ENDDO
	1878	CALL gr_fi_ecrit(1, klon,iim,jjm+1, zx_tmp_fi2d,zx_tmp_2d)
[29]	1879	CALL histwrite(nid_day,"rain",itap,zx_tmp_2d,iim*(jjm+1),ndex2d)
[2]	1880	c
	1881	CALL gr_fi_ecrit(1, klon,iim,jjm+1, snow_fall,zx_tmp_2d)
[29]	1882	CALL histwrite(nid_day,"snow",itap,zx_tmp_2d,iim*(jjm+1),ndex2d)
[2]	1883	c
	1884	CALL gr_fi_ecrit(1, klon,iim,jjm+1, evap,zx_tmp_2d)
[29]	1885	CALL histwrite(nid_day,"evap",itap,zx_tmp_2d,iim*(jjm+1),ndex2d)
[2]	1886	c
	1887	CALL gr_fi_ecrit(1, klon,iim,jjm+1, topsw,zx_tmp_2d)
[29]	1888	CALL histwrite(nid_day,"tops",itap,zx_tmp_2d,iim*(jjm+1),ndex2d)
[2]	1889	c
	1890	CALL gr_fi_ecrit(1, klon,iim,jjm+1, toplw,zx_tmp_2d)
[29]	1891	CALL histwrite(nid_day,"topl",itap,zx_tmp_2d,iim*(jjm+1),ndex2d)
[2]	1892	c
	1893	CALL gr_fi_ecrit(1, klon,iim,jjm+1, solsw,zx_tmp_2d)
[29]	1894	CALL histwrite(nid_day,"sols",itap,zx_tmp_2d,iim*(jjm+1),ndex2d)
[2]	1895	c
	1896	CALL gr_fi_ecrit(1, klon,iim,jjm+1, sollw,zx_tmp_2d)
[29]	1897	CALL histwrite(nid_day,"soll",itap,zx_tmp_2d,iim*(jjm+1),ndex2d)
[2]	1898	c
	1899	CALL gr_fi_ecrit(1, klon,iim,jjm+1, bils,zx_tmp_2d)
[29]	1900	CALL histwrite(nid_day,"bils",itap,zx_tmp_2d,iim*(jjm+1),ndex2d)
[2]	1901	c
	1902	CALL gr_fi_ecrit(1, klon,iim,jjm+1, sens,zx_tmp_2d)
[29]	1903	CALL histwrite(nid_day,"sens",itap,zx_tmp_2d,iim*(jjm+1),ndex2d)
[2]	1904	c
	1905	CALL gr_fi_ecrit(1, klon,iim,jjm+1, fder,zx_tmp_2d)
[29]	1906	CALL histwrite(nid_day,"fder",itap,zx_tmp_2d,iim*(jjm+1),ndex2d)
[2]	1907	c
	1908	CALL gr_fi_ecrit(1, klon,iim,jjm+1, ruis,zx_tmp_2d)
[29]	1909	CALL histwrite(nid_day,"ruis",itap,zx_tmp_2d,iim*(jjm+1),ndex2d)
[2]	1910	c
	1911	DO i = 1, klon
	1912	zx_tmp_fi2d(i) = fluxu(i,1)
	1913	ENDDO
	1914	CALL gr_fi_ecrit(1, klon,iim,jjm+1, zx_tmp_fi2d,zx_tmp_2d)
[29]	1915	CALL histwrite(nid_day,"frtu",itap,zx_tmp_2d,iim*(jjm+1),ndex2d)
[2]	1916	c
	1917	DO i = 1, klon
	1918	zx_tmp_fi2d(i) = fluxv(i,1)
	1919	ENDDO
	1920	CALL gr_fi_ecrit(1, klon,iim,jjm+1, zx_tmp_fi2d,zx_tmp_2d)
[29]	1921	CALL histwrite(nid_day,"frtv",itap,zx_tmp_2d,iim*(jjm+1),ndex2d)
[2]	1922	c
	1923	DO i = 1, klon
	1924	zx_tmp_fi2d(i) = pctsrf(i,is_sic)
	1925	ENDDO
	1926	CALL gr_fi_ecrit(1, klon,iim,jjm+1, zx_tmp_fi2d,zx_tmp_2d)
[29]	1927	CALL histwrite(nid_day,"sicf",itap,zx_tmp_2d,iim*(jjm+1),ndex2d)
[2]	1928	c
	1929	CALL gr_fi_ecrit(1, klon,iim,jjm+1, cldl,zx_tmp_2d)
[29]	1930	CALL histwrite(nid_day,"cldl",itap,zx_tmp_2d,iim*(jjm+1),ndex2d)
[2]	1931	c
	1932	CALL gr_fi_ecrit(1, klon,iim,jjm+1, cldm,zx_tmp_2d)
[29]	1933	CALL histwrite(nid_day,"cldm",itap,zx_tmp_2d,iim*(jjm+1),ndex2d)
[2]	1934	c
	1935	CALL gr_fi_ecrit(1, klon,iim,jjm+1, cldh,zx_tmp_2d)
[29]	1936	CALL histwrite(nid_day,"cldh",itap,zx_tmp_2d,iim*(jjm+1),ndex2d)
[2]	1937	c
	1938	CALL gr_fi_ecrit(1, klon,iim,jjm+1, cldt,zx_tmp_2d)
[29]	1939	CALL histwrite(nid_day,"cldt",itap,zx_tmp_2d,iim*(jjm+1),ndex2d)
[2]	1940	c
	1941	CALL gr_fi_ecrit(1, klon,iim,jjm+1, cldq,zx_tmp_2d)
[29]	1942	CALL histwrite(nid_day,"cldq",itap,zx_tmp_2d,iim*(jjm+1),ndex2d)
[2]	1943	c
	1944	c Champs 3D:
	1945	c
	1946	CALL gr_fi_ecrit(klev,klon,iim,jjm+1, t_seri, zx_tmp_3d)
	1947	CALL histwrite(nid_day,"temp",itap,zx_tmp_3d,
[29]	1948	. iim(jjm+1)klev,ndex3d)
[2]	1949	c
	1950	CALL gr_fi_ecrit(klev,klon,iim,jjm+1, qx(1,1,ivap), zx_tmp_3d)
	1951	CALL histwrite(nid_day,"ovap",itap,zx_tmp_3d,
[29]	1952	. iim(jjm+1)klev,ndex3d)
[2]	1953	c
	1954	CALL gr_fi_ecrit(klev,klon,iim,jjm+1, zphi, zx_tmp_3d)
	1955	CALL histwrite(nid_day,"geop",itap,zx_tmp_3d,
[29]	1956	. iim(jjm+1)klev,ndex3d)
[2]	1957	c
	1958	CALL gr_fi_ecrit(klev,klon,iim,jjm+1, u_seri, zx_tmp_3d)
	1959	CALL histwrite(nid_day,"vitu",itap,zx_tmp_3d,
[29]	1960	. iim(jjm+1)klev,ndex3d)
[2]	1961	c
	1962	CALL gr_fi_ecrit(klev,klon,iim,jjm+1, v_seri, zx_tmp_3d)
	1963	CALL histwrite(nid_day,"vitv",itap,zx_tmp_3d,
[29]	1964	. iim(jjm+1)klev,ndex3d)
[2]	1965	c
	1966	CALL gr_fi_ecrit(klev,klon,iim,jjm+1, omega, zx_tmp_3d)
	1967	CALL histwrite(nid_day,"vitw",itap,zx_tmp_3d,
[29]	1968	. iim(jjm+1)klev,ndex3d)
[2]	1969	c
	1970	CALL gr_fi_ecrit(klev,klon,iim,jjm+1, pplay, zx_tmp_3d)
	1971	CALL histwrite(nid_day,"pres",itap,zx_tmp_3d,
[29]	1972	. iim(jjm+1)klev,ndex3d)
[2]	1973	c
[29]	1974	if (ok_sync) then
	1975	call histsync(nid_day)
	1976	endif
[2]	1977	ENDIF
	1978	C
	1979	IF (ok_mensuel) THEN
	1980	c
[29]	1981	ndex2d = 0
	1982	ndex3d = 0
[2]	1983	c
	1984	c Champs 2D:
	1985	c
[29]	1986	i = NINT(zout/zsto)
	1987	CALL gr_fi_ecrit(1,klon,iim,jjm+1,pphis,zx_tmp_2d)
	1988	CALL histwrite(nid_mth,"phis",i,zx_tmp_2d,iim*(jjm+1),ndex2d)
	1989	C
	1990	i = NINT(zout/zsto)
	1991	CALL gr_fi_ecrit(1,klon,iim,jjm+1,paire,zx_tmp_2d)
	1992	CALL histwrite(nid_mth,"aire",i,zx_tmp_2d,iim*(jjm+1),ndex2d)
	1993
[2]	1994	CALL gr_fi_ecrit(1, klon,iim,jjm+1, zxtsol,zx_tmp_2d)
[29]	1995	CALL histwrite(nid_mth,"tsol",itap,zx_tmp_2d,iim*(jjm+1),ndex2d)
[2]	1996	c
	1997	DO i = 1, klon
	1998	zx_tmp_fi2d(i) = paprs(i,1)
	1999	ENDDO
	2000	CALL gr_fi_ecrit(1, klon,iim,jjm+1, zx_tmp_fi2d,zx_tmp_2d)
[29]	2001	CALL histwrite(nid_mth,"psol",itap,zx_tmp_2d,iim*(jjm+1),ndex2d)
[2]	2002	c
	2003	CALL gr_fi_ecrit(1, klon,iim,jjm+1, zxqsol,zx_tmp_2d)
[29]	2004	CALL histwrite(nid_mth,"qsol",itap,zx_tmp_2d,iim*(jjm+1),ndex2d)
[2]	2005	c
	2006	DO i = 1, klon
	2007	zx_tmp_fi2d(i) = rain_fall(i) + snow_fall(i)
	2008	ENDDO
	2009	CALL gr_fi_ecrit(1, klon,iim,jjm+1, zx_tmp_fi2d,zx_tmp_2d)
[29]	2010	CALL histwrite(nid_mth,"rain",itap,zx_tmp_2d,iim*(jjm+1),ndex2d)
[2]	2011	c
	2012	DO i = 1, klon
	2013	zx_tmp_fi2d(i) = rain_lsc(i) + snow_lsc(i)
	2014	ENDDO
	2015	CALL gr_fi_ecrit(1, klon,iim,jjm+1, zx_tmp_fi2d,zx_tmp_2d)
[29]	2016	CALL histwrite(nid_mth,"plul",itap,zx_tmp_2d,iim*(jjm+1),ndex2d)
[2]	2017	c
	2018	DO i = 1, klon
	2019	zx_tmp_fi2d(i) = rain_con(i) + snow_con(i)
	2020	ENDDO
	2021	CALL gr_fi_ecrit(1, klon,iim,jjm+1, zx_tmp_fi2d,zx_tmp_2d)
[29]	2022	CALL histwrite(nid_mth,"pluc",itap,zx_tmp_2d,iim*(jjm+1),ndex2d)
[2]	2023	c
	2024	CALL gr_fi_ecrit(1, klon,iim,jjm+1, snow_fall,zx_tmp_2d)
[29]	2025	CALL histwrite(nid_mth,"snow",itap,zx_tmp_2d,iim*(jjm+1),ndex2d)
[2]	2026	c
	2027	CALL gr_fi_ecrit(1, klon,iim,jjm+1, agesno,zx_tmp_2d)
[29]	2028	CALL histwrite(nid_mth,"ages",itap,zx_tmp_2d,iim*(jjm+1),ndex2d)
[2]	2029	c
	2030	CALL gr_fi_ecrit(1, klon,iim,jjm+1, evap,zx_tmp_2d)
[29]	2031	CALL histwrite(nid_mth,"evap",itap,zx_tmp_2d,iim*(jjm+1),ndex2d)
[2]	2032	c
	2033	CALL gr_fi_ecrit(1, klon,iim,jjm+1, topsw,zx_tmp_2d)
[29]	2034	CALL histwrite(nid_mth,"tops",itap,zx_tmp_2d,iim*(jjm+1),ndex2d)
[2]	2035	c
	2036	CALL gr_fi_ecrit(1, klon,iim,jjm+1, toplw,zx_tmp_2d)
[29]	2037	CALL histwrite(nid_mth,"topl",itap,zx_tmp_2d,iim*(jjm+1),ndex2d)
[2]	2038	c
	2039	CALL gr_fi_ecrit(1, klon,iim,jjm+1, solsw,zx_tmp_2d)
[29]	2040	CALL histwrite(nid_mth,"sols",itap,zx_tmp_2d,iim*(jjm+1),ndex2d)
[2]	2041	c
	2042	CALL gr_fi_ecrit(1, klon,iim,jjm+1, sollw,zx_tmp_2d)
[29]	2043	CALL histwrite(nid_mth,"soll",itap,zx_tmp_2d,iim*(jjm+1),ndex2d)
[2]	2044	c
	2045	CALL gr_fi_ecrit(1, klon,iim,jjm+1, topsw0,zx_tmp_2d)
[29]	2046	CALL histwrite(nid_mth,"tops0",itap,zx_tmp_2d,iim*(jjm+1),ndex2d)
[2]	2047	c
	2048	CALL gr_fi_ecrit(1, klon,iim,jjm+1, toplw0,zx_tmp_2d)
[29]	2049	CALL histwrite(nid_mth,"topl0",itap,zx_tmp_2d,iim*(jjm+1),ndex2d)
[2]	2050	c
	2051	CALL gr_fi_ecrit(1, klon,iim,jjm+1, solsw0,zx_tmp_2d)
[29]	2052	CALL histwrite(nid_mth,"sols0",itap,zx_tmp_2d,iim*(jjm+1),ndex2d)
[2]	2053	c
	2054	CALL gr_fi_ecrit(1, klon,iim,jjm+1, sollw0,zx_tmp_2d)
[29]	2055	CALL histwrite(nid_mth,"soll0",itap,zx_tmp_2d,iim*(jjm+1),ndex2d)
[2]	2056	c
	2057	CALL gr_fi_ecrit(1, klon,iim,jjm+1, bils,zx_tmp_2d)
[29]	2058	CALL histwrite(nid_mth,"bils",itap,zx_tmp_2d,iim*(jjm+1),ndex2d)
[2]	2059	c
	2060	CALL gr_fi_ecrit(1, klon,iim,jjm+1, sens,zx_tmp_2d)
[29]	2061	CALL histwrite(nid_mth,"sens",itap,zx_tmp_2d,iim*(jjm+1),ndex2d)
[2]	2062	c
	2063	CALL gr_fi_ecrit(1, klon,iim,jjm+1, fder,zx_tmp_2d)
[29]	2064	CALL histwrite(nid_mth,"fder",itap,zx_tmp_2d,iim*(jjm+1),ndex2d)
[2]	2065	c
	2066	CALL gr_fi_ecrit(1, klon,iim,jjm+1, ruis,zx_tmp_2d)
[29]	2067	CALL histwrite(nid_mth,"ruis",itap,zx_tmp_2d,iim*(jjm+1),ndex2d)
[2]	2068	c
	2069	DO i = 1, klon
	2070	zx_tmp_fi2d(i) = fluxu(i,1)
	2071	ENDDO
	2072	CALL gr_fi_ecrit(1, klon,iim,jjm+1, zx_tmp_fi2d,zx_tmp_2d)
[29]	2073	CALL histwrite(nid_mth,"frtu",itap,zx_tmp_2d,iim*(jjm+1),ndex2d)
[2]	2074	c
	2075	DO i = 1, klon
	2076	zx_tmp_fi2d(i) = fluxv(i,1)
	2077	ENDDO
	2078	CALL gr_fi_ecrit(1, klon,iim,jjm+1, zx_tmp_fi2d,zx_tmp_2d)
[29]	2079	CALL histwrite(nid_mth,"frtv",itap,zx_tmp_2d,iim*(jjm+1),ndex2d)
[2]	2080	c
	2081	DO i = 1, klon
	2082	zx_tmp_fi2d(i) = pctsrf(i,is_sic)
	2083	ENDDO
	2084	CALL gr_fi_ecrit(1, klon,iim,jjm+1, zx_tmp_fi2d,zx_tmp_2d)
[29]	2085	CALL histwrite(nid_mth,"sicf",itap,zx_tmp_2d,iim*(jjm+1),ndex2d)
[2]	2086	c
	2087	CALL gr_fi_ecrit(1, klon,iim,jjm+1, albsol,zx_tmp_2d)
[29]	2088	CALL histwrite(nid_mth,"albs",itap,zx_tmp_2d,iim*(jjm+1),ndex2d)
[2]	2089	c
	2090	CALL gr_fi_ecrit(1, klon,iim,jjm+1, cdragm,zx_tmp_2d)
[29]	2091	CALL histwrite(nid_mth,"cdrm",itap,zx_tmp_2d,iim*(jjm+1),ndex2d)
[2]	2092	c
	2093	CALL gr_fi_ecrit(1, klon,iim,jjm+1, cdragh,zx_tmp_2d)
[29]	2094	CALL histwrite(nid_mth,"cdrh",itap,zx_tmp_2d,iim*(jjm+1),ndex2d)
[2]	2095	c
	2096	CALL gr_fi_ecrit(1, klon,iim,jjm+1, cldl,zx_tmp_2d)
[29]	2097	CALL histwrite(nid_mth,"cldl",itap,zx_tmp_2d,iim*(jjm+1),ndex2d)
[2]	2098	c
	2099	CALL gr_fi_ecrit(1, klon,iim,jjm+1, cldm,zx_tmp_2d)
[29]	2100	CALL histwrite(nid_mth,"cldm",itap,zx_tmp_2d,iim*(jjm+1),ndex2d)
[2]	2101	c
	2102	CALL gr_fi_ecrit(1, klon,iim,jjm+1, cldh,zx_tmp_2d)
[29]	2103	CALL histwrite(nid_mth,"cldh",itap,zx_tmp_2d,iim*(jjm+1),ndex2d)
[2]	2104	c
	2105	CALL gr_fi_ecrit(1, klon,iim,jjm+1, cldt,zx_tmp_2d)
[29]	2106	CALL histwrite(nid_mth,"cldt",itap,zx_tmp_2d,iim*(jjm+1),ndex2d)
[2]	2107	c
	2108	CALL gr_fi_ecrit(1, klon,iim,jjm+1, cldq,zx_tmp_2d)
[29]	2109	CALL histwrite(nid_mth,"cldq",itap,zx_tmp_2d,iim*(jjm+1),ndex2d)
[2]	2110	c
	2111	CALL gr_fi_ecrit(1, klon,iim,jjm+1, ue,zx_tmp_2d)
[29]	2112	CALL histwrite(nid_mth,"ue",itap,zx_tmp_2d,iim*(jjm+1),ndex2d)
[2]	2113	c
	2114	CALL gr_fi_ecrit(1, klon,iim,jjm+1, ve,zx_tmp_2d)
[29]	2115	CALL histwrite(nid_mth,"ve",itap,zx_tmp_2d,iim*(jjm+1),ndex2d)
[2]	2116	c
	2117	CALL gr_fi_ecrit(1, klon,iim,jjm+1, uq,zx_tmp_2d)
[29]	2118	CALL histwrite(nid_mth,"uq",itap,zx_tmp_2d,iim*(jjm+1),ndex2d)
[2]	2119	c
	2120	CALL gr_fi_ecrit(1, klon,iim,jjm+1, vq,zx_tmp_2d)
[29]	2121	CALL histwrite(nid_mth,"vq",itap,zx_tmp_2d,iim*(jjm+1),ndex2d)
[2]	2122	c
	2123	c Champs 3D:
	2124	C
	2125	CALL gr_fi_ecrit(klev,klon,iim,jjm+1, t_seri, zx_tmp_3d)
	2126	CALL histwrite(nid_mth,"temp",itap,zx_tmp_3d,
[29]	2127	. iim(jjm+1)klev,ndex3d)
[2]	2128	c
	2129	CALL gr_fi_ecrit(klev,klon,iim,jjm+1, qx(1,1,ivap), zx_tmp_3d)
	2130	CALL histwrite(nid_mth,"ovap",itap,zx_tmp_3d,
[29]	2131	. iim(jjm+1)klev,ndex3d)
[2]	2132	c
	2133	CALL gr_fi_ecrit(klev,klon,iim,jjm+1, zphi, zx_tmp_3d)
	2134	CALL histwrite(nid_mth,"geop",itap,zx_tmp_3d,
[29]	2135	. iim(jjm+1)klev,ndex3d)
[2]	2136	c
	2137	CALL gr_fi_ecrit(klev,klon,iim,jjm+1, u_seri, zx_tmp_3d)
	2138	CALL histwrite(nid_mth,"vitu",itap,zx_tmp_3d,
[29]	2139	. iim(jjm+1)klev,ndex3d)
[2]	2140	c
	2141	CALL gr_fi_ecrit(klev,klon,iim,jjm+1, v_seri, zx_tmp_3d)
	2142	CALL histwrite(nid_mth,"vitv",itap,zx_tmp_3d,
[29]	2143	. iim(jjm+1)klev,ndex3d)
[2]	2144	c
	2145	CALL gr_fi_ecrit(klev,klon,iim,jjm+1, omega, zx_tmp_3d)
	2146	CALL histwrite(nid_mth,"vitw",itap,zx_tmp_3d,
[29]	2147	. iim(jjm+1)klev,ndex3d)
[2]	2148	c
	2149	CALL gr_fi_ecrit(klev,klon,iim,jjm+1, pplay, zx_tmp_3d)
	2150	CALL histwrite(nid_mth,"pres",itap,zx_tmp_3d,
[29]	2151	. iim(jjm+1)klev,ndex3d)
[2]	2152	c
	2153	CALL gr_fi_ecrit(klev,klon,iim,jjm+1, cldfra, zx_tmp_3d)
	2154	CALL histwrite(nid_mth,"rneb",itap,zx_tmp_3d,
[29]	2155	. iim(jjm+1)klev,ndex3d)
[2]	2156	c
	2157	CALL gr_fi_ecrit(klev,klon,iim,jjm+1, zx_rh, zx_tmp_3d)
	2158	CALL histwrite(nid_mth,"rhum",itap,zx_tmp_3d,
[29]	2159	. iim(jjm+1)klev,ndex3d)
[2]	2160	c
	2161	CALL gr_fi_ecrit(klev,klon,iim,jjm+1, cldliq, zx_tmp_3d)
	2162	CALL histwrite(nid_mth,"oliq",itap,zx_tmp_3d,
[29]	2163	. iim(jjm+1)klev,ndex3d)
[2]	2164	c
	2165	CALL gr_fi_ecrit(klev,klon,iim,jjm+1, d_t_dyn, zx_tmp_3d)
	2166	CALL histwrite(nid_mth,"dtdyn",itap,zx_tmp_3d,
[29]	2167	. iim(jjm+1)klev,ndex3d)
[2]	2168	c
	2169	CALL gr_fi_ecrit(klev,klon,iim,jjm+1, d_qx_dyn(1,1,ivap),
	2170	. zx_tmp_3d)
	2171	CALL histwrite(nid_mth,"dqdyn",itap,zx_tmp_3d,
[29]	2172	. iim(jjm+1)klev,ndex3d)
[2]	2173	c
	2174	CALL gr_fi_ecrit(klev,klon,iim,jjm+1, d_t_con, zx_tmp_3d)
	2175	CALL histwrite(nid_mth,"dtcon",itap,zx_tmp_3d,
[29]	2176	. iim(jjm+1)klev,ndex3d)
[2]	2177	c
	2178	CALL gr_fi_ecrit(klev,klon,iim,jjm+1, d_q_con, zx_tmp_3d)
	2179	CALL histwrite(nid_mth,"dqcon",itap,zx_tmp_3d,
[29]	2180	. iim(jjm+1)klev,ndex3d)
[2]	2181	c
	2182	CALL gr_fi_ecrit(klev,klon,iim,jjm+1, d_t_lsc, zx_tmp_3d)
	2183	CALL histwrite(nid_mth,"dtlsc",itap,zx_tmp_3d,
[29]	2184	. iim(jjm+1)klev,ndex3d)
[2]	2185	c
	2186	CALL gr_fi_ecrit(klev,klon,iim,jjm+1, d_q_lsc, zx_tmp_3d)
	2187	CALL histwrite(nid_mth,"dqlsc",itap,zx_tmp_3d,
[29]	2188	. iim(jjm+1)klev,ndex3d)
[2]	2189	c
	2190	CALL gr_fi_ecrit(klev,klon,iim,jjm+1, d_t_vdf, zx_tmp_3d)
	2191	CALL histwrite(nid_mth,"dtvdf",itap,zx_tmp_3d,
[29]	2192	. iim(jjm+1)klev,ndex3d)
[2]	2193	c
	2194	CALL gr_fi_ecrit(klev,klon,iim,jjm+1, d_q_vdf, zx_tmp_3d)
	2195	CALL histwrite(nid_mth,"dqvdf",itap,zx_tmp_3d,
[29]	2196	. iim(jjm+1)klev,ndex3d)
[2]	2197	c
	2198	CALL gr_fi_ecrit(klev,klon,iim,jjm+1, d_t_eva, zx_tmp_3d)
	2199	CALL histwrite(nid_mth,"dteva",itap,zx_tmp_3d,
[29]	2200	. iim(jjm+1)klev,ndex3d)
[2]	2201	c
	2202	CALL gr_fi_ecrit(klev,klon,iim,jjm+1, d_q_eva, zx_tmp_3d)
	2203	CALL histwrite(nid_mth,"dqeva",itap,zx_tmp_3d,
[29]	2204	. iim(jjm+1)klev,ndex3d)
[2]	2205	c
	2206	C CALL gr_fi_ecrit(klev,klon,iim,jjm+1, d_t_ajs, zx_tmp_3d)
	2207	C CALL histwrite(nid_mth,"dtajs",itap,zx_tmp_3d,
[29]	2208	C . iim(jjm+1)klev,ndex3d)
[2]	2209	c
	2210	C CALL gr_fi_ecrit(klev,klon,iim,jjm+1, d_q_ajs, zx_tmp_3d)
	2211	C CALL histwrite(nid_mth,"dqajs",itap,zx_tmp_3d,
[29]	2212	C . iim(jjm+1)klev,ndex3d)
[2]	2213	c
	2214	CALL gr_fi_ecrit(klev,klon,iim,jjm+1, heat, zx_tmp_3d)
	2215	CALL histwrite(nid_mth,"dtswr",itap,zx_tmp_3d,
[29]	2216	. iim(jjm+1)klev,ndex3d)
[2]	2217	c
	2218	CALL gr_fi_ecrit(klev,klon,iim,jjm+1, heat0, zx_tmp_3d)
	2219	CALL histwrite(nid_mth,"dtsw0",itap,zx_tmp_3d,
[29]	2220	. iim(jjm+1)klev,ndex3d)
[2]	2221	c
	2222	CALL gr_fi_ecrit(klev,klon,iim,jjm+1, cool, zx_tmp_3d)
	2223	CALL histwrite(nid_mth,"dtlwr",itap,zx_tmp_3d,
[29]	2224	. iim(jjm+1)klev,ndex3d)
[2]	2225	c
	2226	CALL gr_fi_ecrit(klev,klon,iim,jjm+1, cool0, zx_tmp_3d)
	2227	CALL histwrite(nid_mth,"dtlw0",itap,zx_tmp_3d,
[29]	2228	. iim(jjm+1)klev,ndex3d)
[2]	2229	c
	2230	CALL gr_fi_ecrit(klev,klon,iim,jjm+1, d_u_vdf, zx_tmp_3d)
	2231	CALL histwrite(nid_mth,"duvdf",itap,zx_tmp_3d,
[29]	2232	. iim(jjm+1)klev,ndex3d)
[2]	2233	c
	2234	CALL gr_fi_ecrit(klev,klon,iim,jjm+1, d_v_vdf, zx_tmp_3d)
	2235	CALL histwrite(nid_mth,"dvvdf",itap,zx_tmp_3d,
[29]	2236	. iim(jjm+1)klev,ndex3d)
[2]	2237	c
	2238	IF (ok_orodr) THEN
	2239	CALL gr_fi_ecrit(klev,klon,iim,jjm+1, d_u_oro, zx_tmp_3d)
	2240	CALL histwrite(nid_mth,"duoro",itap,zx_tmp_3d,
[29]	2241	. iim(jjm+1)klev,ndex3d)
[2]	2242	c
	2243	CALL gr_fi_ecrit(klev,klon,iim,jjm+1, d_v_oro, zx_tmp_3d)
	2244	CALL histwrite(nid_mth,"dvoro",itap,zx_tmp_3d,
[29]	2245	. iim(jjm+1)klev,ndex3d)
[2]	2246	c
	2247	ENDIF
	2248	C
	2249	IF (ok_orolf) THEN
	2250	CALL gr_fi_ecrit(klev,klon,iim,jjm+1, d_u_lif, zx_tmp_3d)
	2251	CALL histwrite(nid_mth,"dulif",itap,zx_tmp_3d,
[29]	2252	. iim(jjm+1)klev,ndex3d)
[2]	2253	c
	2254	CALL gr_fi_ecrit(klev,klon,iim,jjm+1, d_v_lif, zx_tmp_3d)
	2255	CALL histwrite(nid_mth,"dvlif",itap,zx_tmp_3d,
[29]	2256	. iim(jjm+1)klev,ndex3d)
[2]	2257	ENDIF
	2258	C
	2259	CALL gr_fi_ecrit(klev,klon,iim,jjm+1, wo, zx_tmp_3d)
	2260	CALL histwrite(nid_mth,"ozone",itap,zx_tmp_3d,
[29]	2261	. iim(jjm+1)klev,ndex3d)
[2]	2262	c
	2263	IF (nqmax.GE.3) THEN
	2264	DO iq=1,nqmax-2
	2265	IF (iq.LE.99) THEN
	2266	CALL gr_fi_ecrit(klev,klon,iim,jjm+1, qx(1,1,iq+2), zx_tmp_3d)
	2267	WRITE(str2,'(i2.2)') iq
	2268	CALL histwrite(nid_mth,"trac"//str2,itap,zx_tmp_3d,
[29]	2269	. iim(jjm+1)klev,ndex3d)
[2]	2270	ELSE
	2271	PRINT*, "Trop de traceurs"
	2272	CALL abort
	2273	ENDIF
	2274	ENDDO
	2275	ENDIF
	2276	c
[29]	2277	if (ok_sync) then
	2278	call histsync(nid_mth)
	2279	endif
[2]	2280	ENDIF
	2281	c
	2282	IF (ok_instan) THEN
	2283	c
[29]	2284	ndex2d = 0
	2285	ndex3d = 0
[2]	2286	c
	2287	c Champs 2D:
	2288	c
[29]	2289	i = NINT(zout/zsto)
	2290	CALL gr_fi_ecrit(1,klon,iim,jjm+1,pphis,zx_tmp_2d)
	2291	CALL histwrite(nid_ins,"phis",i,zx_tmp_2d,iim*(jjm+1),ndex2d)
	2292	c
	2293	i = NINT(zout/zsto)
	2294	CALL gr_fi_ecrit(1,klon,iim,jjm+1,paire,zx_tmp_2d)
	2295	CALL histwrite(nid_ins,"aire",i,zx_tmp_2d,iim*(jjm+1),ndex2d)
	2296
[2]	2297	DO i = 1, klon
	2298	zx_tmp_fi2d(i) = paprs(i,1)
	2299	ENDDO
	2300	CALL gr_fi_ecrit(1, klon,iim,jjm+1, zx_tmp_fi2d,zx_tmp_2d)
[29]	2301	CALL histwrite(nid_ins,"psol",itap,zx_tmp_2d,iim*(jjm+1),ndex2d)
[2]	2302	c
	2303	CALL gr_fi_ecrit(1, klon,iim,jjm+1, toplw,zx_tmp_2d)
[29]	2304	CALL histwrite(nid_ins,"topl",itap,zx_tmp_2d,iim*(jjm+1),ndex2d)
[2]	2305	c
	2306	c Champs 3D:
	2307	c
	2308	CALL gr_fi_ecrit(klev,klon,iim,jjm+1, t_seri, zx_tmp_3d)
	2309	CALL histwrite(nid_ins,"temp",itap,zx_tmp_3d,
[29]	2310	. iim(jjm+1)klev,ndex3d)
[2]	2311	c
	2312	CALL gr_fi_ecrit(klev,klon,iim,jjm+1, u_seri, zx_tmp_3d)
	2313	CALL histwrite(nid_ins,"vitu",itap,zx_tmp_3d,
[29]	2314	. iim(jjm+1)klev,ndex3d)
[2]	2315	c
	2316	CALL gr_fi_ecrit(klev,klon,iim,jjm+1, v_seri, zx_tmp_3d)
	2317	CALL histwrite(nid_ins,"vitv",itap,zx_tmp_3d,
[29]	2318	. iim(jjm+1)klev,ndex3d)
[2]	2319	c
	2320	CALL gr_fi_ecrit(klev,klon,iim,jjm+1, zphi, zx_tmp_3d)
	2321	CALL histwrite(nid_ins,"geop",itap,zx_tmp_3d,
[29]	2322	. iim(jjm+1)klev,ndex3d)
[2]	2323	c
	2324	CALL gr_fi_ecrit(klev,klon,iim,jjm+1, pplay, zx_tmp_3d)
	2325	CALL histwrite(nid_ins,"pres",itap,zx_tmp_3d,
[29]	2326	. iim(jjm+1)klev,ndex3d)
[2]	2327	c
[29]	2328	if (ok_sync) then
	2329	call histsync(nid_ins)
	2330	endif
[2]	2331	ENDIF
	2332	c
	2333	IF (ok_oasis .AND. mod(itap,nexca).EQ.0) THEN
	2334	c
	2335	c Je ne traite pas le ruissellement, pour l'instant (qui m'aidera ?)
	2336	DO i = 1, klon
	2337	oas_ruisoce(i) = 0.0
	2338	oas_ruisriv(i) = 0.0
	2339	ENDDO
	2340	c
	2341	ig = 1
	2342	DO i = 1, iim
	2343	z_sols(i,1) = oas_sols(ig)
	2344	z_nsol(i,1) = oas_nsol(ig)
	2345	z_rain(i,1) = oas_rain(ig)
	2346	z_snow(i,1) = oas_snow(ig)
	2347	z_evap(i,1) = oas_evap(ig)
	2348	z_ruisoce(i,1) = oas_ruisoce(ig)
	2349	z_ruisriv(i,1) = oas_ruisriv(ig)
	2350	z_tsol(i,1) = oas_tsol(ig)
	2351	z_fder(i,1) = oas_fder(ig)
	2352	z_albe(i,1) = oas_albe(ig)
	2353	z_taux(i,1) = oas_taux(ig)
	2354	z_tauy(i,1) = oas_tauy(ig)
	2355	ENDDO
	2356	DO j = 2, jjm
	2357	DO i = 1, iim
	2358	ig = ig + 1
	2359	z_sols(i,j) = oas_sols(ig)
	2360	z_nsol(i,j) = oas_nsol(ig)
	2361	z_rain(i,j) = oas_rain(ig)
	2362	z_snow(i,j) = oas_snow(ig)
	2363	z_evap(i,j) = oas_evap(ig)
	2364	z_ruisoce(i,j) = oas_ruisoce(ig)
	2365	z_ruisriv(i,j) = oas_ruisriv(ig)
	2366	z_tsol(i,j) = oas_tsol(ig)
	2367	z_fder(i,j) = oas_fder(ig)
	2368	z_albe(i,j) = oas_albe(ig)
	2369	z_taux(i,j) = oas_taux(ig)
	2370	z_tauy(i,j) = oas_tauy(ig)
	2371	ENDDO
	2372	ENDDO
	2373	ig = ig + 1
	2374	DO i = 1, iim
	2375	z_sols(i,jjm+1) = oas_sols(ig)
	2376	z_nsol(i,jjm+1) = oas_nsol(ig)
	2377	z_rain(i,jjm+1) = oas_rain(ig)
	2378	z_snow(i,jjm+1) = oas_snow(ig)
	2379	z_evap(i,jjm+1) = oas_evap(ig)
	2380	z_ruisoce(i,jjm+1) = oas_ruisoce(ig)
	2381	z_ruisriv(i,jjm+1) = oas_ruisriv(ig)
	2382	z_tsol(i,jjm+1) = oas_tsol(ig)
	2383	z_fder(i,jjm+1) = oas_fder(ig)
	2384	z_albe(i,jjm+1) = oas_albe(ig)
	2385	z_taux(i,jjm+1) = oas_taux(ig)
	2386	z_tauy(i,jjm+1) = oas_tauy(ig)
	2387	ENDDO
	2388	c
	2389	c Passer les champs au coupleur:
	2390	c
	2391	CALL intocpl(itap,(jjm+1)*iim,
	2392	. z_sols, z_nsol,
	2393	. z_rain, z_snow, z_evap,
	2394	. z_ruisoce, z_ruisriv,
	2395	. z_tsol, z_fder, z_albe,
	2396	. z_taux, z_tauy)
	2397	DO i = 1, klon
	2398	oas_sols(i) = 0.0
	2399	oas_nsol(i) = 0.0
	2400	oas_rain(i) = 0.0
	2401	oas_snow(i) = 0.0
	2402	oas_evap(i) = 0.0
	2403	oas_ruis(i) = 0.0
	2404	oas_tsol(i) = 0.0
	2405	oas_fder(i) = 0.0
	2406	oas_albe(i) = 0.0
	2407	oas_taux(i) = 0.0
	2408	oas_tauy(i) = 0.0
	2409	ENDDO
	2410	ENDIF
	2411	c
	2412	c Ecrire la bande regionale (binaire grads)
	2413	IF (ok_region .AND. mod(itap,ecrit_reg).eq.0) THEN
	2414	CALL ecriregs(84,zxtsol)
	2415	CALL ecriregs(84,paprs(1,1))
	2416	CALL ecriregs(84,topsw)
	2417	CALL ecriregs(84,toplw)
	2418	CALL ecriregs(84,solsw)
	2419	CALL ecriregs(84,sollw)
	2420	CALL ecriregs(84,rain_fall)
	2421	CALL ecriregs(84,snow_fall)
	2422	CALL ecriregs(84,evap)
	2423	CALL ecriregs(84,sens)
	2424	CALL ecriregs(84,bils)
	2425	CALL ecriregs(84,pctsrf(1,is_sic))
	2426	CALL ecriregs(84,fluxu(1,1))
	2427	CALL ecriregs(84,fluxv(1,1))
	2428	CALL ecriregs(84,ue)
	2429	CALL ecriregs(84,ve)
	2430	CALL ecriregs(84,uq)
	2431	CALL ecriregs(84,vq)
	2432	c
	2433	CALL ecrirega(84,u_seri)
	2434	CALL ecrirega(84,v_seri)
	2435	CALL ecrirega(84,omega)
	2436	CALL ecrirega(84,t_seri)
	2437	CALL ecrirega(84,zphi)
	2438	CALL ecrirega(84,q_seri)
	2439	CALL ecrirega(84,cldfra)
	2440	CALL ecrirega(84,cldliq)
	2441	CALL ecrirega(84,pplay)
	2442
	2443
	2444	cc CALL ecrirega(84,d_t_dyn)
	2445	cc CALL ecrirega(84,d_q_dyn)
	2446	cc CALL ecrirega(84,heat)
	2447	cc CALL ecrirega(84,cool)
	2448	cc CALL ecrirega(84,d_t_con)
	2449	cc CALL ecrirega(84,d_q_con)
	2450	cc CALL ecrirega(84,d_t_lsc)
	2451	cc CALL ecrirega(84,d_q_lsc)
	2452	ENDIF
	2453	c
	2454	c Convertir les incrementations en tendances
	2455	c
	2456	DO k = 1, klev
	2457	DO i = 1, klon
	2458	d_u(i,k) = ( u_seri(i,k) - u(i,k) ) / dtime
	2459	d_v(i,k) = ( v_seri(i,k) - v(i,k) ) / dtime
	2460	d_t(i,k) = ( t_seri(i,k)-t(i,k) ) / dtime
	2461	d_qx(i,k,ivap) = ( q_seri(i,k) - qx(i,k,ivap) ) / dtime
	2462	d_qx(i,k,iliq) = ( ql_seri(i,k) - qx(i,k,iliq) ) / dtime
	2463	ENDDO
	2464	ENDDO
	2465	c
	2466	IF (nqmax.GE.3) THEN
	2467	DO iq = 3, nqmax
	2468	DO k = 1, klev
	2469	DO i = 1, klon
	2470	d_qx(i,k,iq) = ( tr_seri(i,k,iq-2) - qx(i,k,iq) ) / dtime
	2471	ENDDO
	2472	ENDDO
	2473	ENDDO
	2474	ENDIF
	2475	c
	2476	c====================================================================
	2477	c Si c'est la fin, il faut conserver l'etat de redemarrage
	2478	c====================================================================
	2479	c
	2480	IF (lafin) THEN
	2481	IF (ok_oasis) CALL quitcpl
	2482	CALL phyredem ("restartphy.nc",dtime,radpas,co2_ppm,solaire,
	2483	. rlat,rlon,ftsol,ftsoil,deltat,fqsol,fsnow,
	2484	. radsol,rugmer,agesno,
	2485	. zmea,zstd,zsig,zgam,zthe,zpic,zval,rugoro)
	2486	ENDIF
	2487
	2488	RETURN
	2489	END
	2490	SUBROUTINE qcheck(klon,klev,paprs,q,ql,marque)
	2491	IMPLICIT none
	2492	c
	2493	c Calculer et imprimer l'eau totale. A utiliser pour verifier
	2494	c la conservation de l'eau
	2495	c
	2496	#include "YOMCST.h"
	2497	INTEGER klon,klev
	2498	REAL paprs(klon,klev+1), q(klon,klev), ql(klon,klev)
	2499	CHARACTER () marque
	2500	REAL qtotal
	2501	INTEGER i, k
	2502	c
	2503	qtotal = 0.0
	2504	DO k = 1, klev
	2505	DO i = 1, klon
	2506	qtotal = qtotal + (q(i,k)+ql(i,k))
	2507	. *(paprs(i,k)-paprs(i,k+1))/RG
	2508	ENDDO
	2509	ENDDO
	2510	c
	2511	PRINT*, "Eau totale ",marque, qtotal/FLOAT(klon)
	2512	c
	2513	END
	2514	SUBROUTINE gr_fi_ecrit(nfield,nlon,iim,jjmp1,fi,ecrit)
	2515	IMPLICIT none
	2516	c
	2517	c Tranformer une variable de la grille physique a
	2518	c la grille d'ecriture
	2519	c
	2520	INTEGER nfield,nlon,iim,jjmp1, jjm
[15]	2521	REAL fi(nlon,nfield), ecrit(iim*jjmp1,nfield)
[2]	2522	c
	2523	INTEGER i, j, n, ig
	2524	c
	2525	jjm = jjmp1 - 1
	2526	DO n = 1, nfield
	2527	DO i=1,iim
[15]	2528	ecrit(i,n) = fi(1,n)
	2529	ecrit(i+jjm*iim,n) = fi(nlon,n)
[2]	2530	ENDDO
[15]	2531	DO ig = 1, nlon - 2
	2532	ecrit(iim+ig,n) = fi(1+ig,n)
[2]	2533	ENDDO
	2534	ENDDO
	2535	RETURN
	2536	END
[15]	2537

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

Download in other formats:

Original Format