Context Navigation

physiq.F @ 46

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

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

Download in other formats:

Original Format