Context Navigation

phyredem.F @ 522

Last change on this file since 522 was 522, checked in by lmdzadmin, 20 years ago
Modifications pour la fermeture en eau (fonte des glaciers) JLD, OM LF
Property svn:eol-style set to `native` Property svn:executable set to ``* Property svn:keywords set to `Author Date Id Revision`
File size: 22.7 KB

Rev	Line
[179]	1	c $Header$
	2	c
[443]	3	cIM SUBROUTINE phyredem (fichnom,dtime,radpas,co2_ppm,solaire,
[433]	4	SUBROUTINE phyredem (fichnom,dtime,radpas,
[443]	5	. rlat,rlon, pctsrf,tsol,tsoil,deltat,qsurf,qsol,snow,
[467]	6	. albedo, alblw, evap, rain_fall, snow_fall,
[151]	7	. solsw, sollw,fder,
[112]	8	. radsol,frugs,agesno,
[45]	9	. zmea,zstd,zsig,zgam,zthe,zpic,zval,rugsrel,
[522]	10	. t_ancien, q_ancien, rnebcon, ratqs, clwcon,
	11	. run_off_lic_0)
[2]	12	IMPLICIT none
	13	c======================================================================
	14	c Auteur(s) Z.X. Li (LMD/CNRS) date: 19930818
	15	c Objet: Ecriture de l'etat de redemarrage pour la physique
	16	c======================================================================
	17	#include "dimensions.h"
	18	#include "dimphy.h"
	19	#include "netcdf.inc"
	20	#include "indicesol.h"
	21	#include "dimsoil.h"
	22	#include "clesphys.h"
	23	#include "control.h"
[51]	24	#include "temps.h"
[2]	25	c======================================================================
	26	CHARACTER() fichnom
	27	REAL dtime
	28	INTEGER radpas
	29	REAL rlat(klon), rlon(klon)
[443]	30	cIM REAL co2_ppm
	31	cIM REAL solaire
[2]	32	REAL tsol(klon,nbsrf)
	33	REAL tsoil(klon,nsoilmx,nbsrf)
	34	REAL deltat(klon)
[443]	35	REAL qsurf(klon,nbsrf)
	36	REAL qsol(klon)
[2]	37	REAL snow(klon,nbsrf)
[98]	38	REAL albedo(klon,nbsrf)
[467]	39	cIM BEG
	40	REAL alblw(klon,nbsrf)
	41	cIM END
[98]	42	REAL evap(klon,nbsrf)
	43	REAL rain_fall(klon)
	44	REAL snow_fall(klon)
	45	real solsw(klon)
	46	real sollw(klon)
[151]	47	real fder(klon)
[2]	48	REAL radsol(klon)
[112]	49	REAL frugs(klon,nbsrf)
[258]	50	REAL agesno(klon,nbsrf)
[2]	51	REAL zmea(klon)
	52	REAL zstd(klon)
	53	REAL zsig(klon)
	54	REAL zgam(klon)
	55	REAL zthe(klon)
	56	REAL zpic(klon)
	57	REAL zval(klon)
	58	REAL rugsrel(klon)
[98]	59	REAL pctsrf(klon, nbsrf)
[45]	60	REAL t_ancien(klon,klev), q_ancien(klon,klev)
[373]	61	real clwcon(klon,klev),rnebcon(klon,klev),ratqs(klon,klev)
[522]	62	REAL run_off_lic_0(klon)
[2]	63	c
[45]	64	INTEGER nid, nvarid, idim1, idim2, idim3
[2]	65	INTEGER ierr
	66	INTEGER length
	67	PARAMETER (length=100)
	68	REAL tab_cntrl(length)
	69	c
	70	INTEGER isoil, nsrf
	71	CHARACTER*7 str7
	72	CHARACTER*2 str2
	73	c
	74	ierr = NF_CREATE(fichnom, NF_CLOBBER, nid)
	75	IF (ierr.NE.NF_NOERR) THEN
	76	write(6,*)' Pb d''ouverture du fichier '//fichnom
	77	write(6,*)' ierr = ', ierr
	78	CALL ABORT
	79	ENDIF
	80	c
	81	ierr = NF_PUT_ATT_TEXT (nid, NF_GLOBAL, "title", 28,
	82	. "Fichier redemmarage physique")
	83	c
	84	ierr = NF_DEF_DIM (nid, "index", length, idim1)
	85	ierr = NF_DEF_DIM (nid, "points_physiques", klon, idim2)
[45]	86	ierr = NF_DEF_DIM (nid, "horizon_vertical", klon*klev, idim3)
[2]	87	c
	88	ierr = NF_ENDDEF(nid)
	89	c
	90	DO ierr = 1, length
	91	tab_cntrl(ierr) = 0.0
	92	ENDDO
	93	tab_cntrl(1) = dtime
	94	tab_cntrl(2) = radpas
	95	tab_cntrl(3) = co2_ppm
	96	tab_cntrl(4) = solaire
	97	tab_cntrl(5) = iflag_con
	98	tab_cntrl(6) = nbapp_rad
	99
	100	IF( cycle_diurne ) tab_cntrl( 7 ) = 1.
	101	IF( soil_model ) tab_cntrl( 8 ) = 1.
	102	IF( new_oliq ) tab_cntrl( 9 ) = 1.
	103	IF( ok_orodr ) tab_cntrl(10 ) = 1.
	104	IF( ok_orolf ) tab_cntrl(11 ) = 1.
	105
[51]	106	tab_cntrl(13) = day_end
[352]	107	tab_cntrl(14) = annee_ref
	108	tab_cntrl(15) = itau_phy
[2]	109	c
	110	ierr = NF_REDEF (nid)
[352]	111	#ifdef NC_DOUBLE
	112	ierr = NF_DEF_VAR (nid, "controle", NF_DOUBLE, 1, idim1,nvarid)
	113	#else
[2]	114	ierr = NF_DEF_VAR (nid, "controle", NF_FLOAT, 1, idim1,nvarid)
[352]	115	#endif
[2]	116	ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 22,
	117	. "Parametres de controle")
	118	ierr = NF_ENDDEF(nid)
	119	#ifdef NC_DOUBLE
	120	ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,tab_cntrl)
	121	#else
	122	ierr = NF_PUT_VAR_REAL (nid,nvarid,tab_cntrl)
	123	#endif
	124	c
	125	ierr = NF_REDEF (nid)
[352]	126	#ifdef NC_DOUBLE
	127	ierr = NF_DEF_VAR (nid, "longitude", NF_DOUBLE, 1, idim2,nvarid)
	128	#else
[2]	129	ierr = NF_DEF_VAR (nid, "longitude", NF_FLOAT, 1, idim2,nvarid)
[352]	130	#endif
[2]	131	ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 32,
	132	. "Longitudes de la grille physique")
	133	ierr = NF_ENDDEF(nid)
	134	#ifdef NC_DOUBLE
	135	ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,rlon)
	136	#else
	137	ierr = NF_PUT_VAR_REAL (nid,nvarid,rlon)
	138	#endif
	139	c
	140	ierr = NF_REDEF (nid)
[352]	141	#ifdef NC_DOUBLE
	142	ierr = NF_DEF_VAR (nid, "latitude", NF_DOUBLE, 1, idim2,nvarid)
	143	#else
[2]	144	ierr = NF_DEF_VAR (nid, "latitude", NF_FLOAT, 1, idim2,nvarid)
[352]	145	#endif
[2]	146	ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 31,
	147	. "Latitudes de la grille physique")
	148	ierr = NF_ENDDEF(nid)
	149	#ifdef NC_DOUBLE
	150	ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,rlat)
	151	#else
	152	ierr = NF_PUT_VAR_REAL (nid,nvarid,rlat)
	153	#endif
	154	c
[98]	155	C PB ajout du masque terre/mer
	156	C
	157	ierr = NF_REDEF (nid)
[352]	158	#ifdef NC_DOUBLE
	159	ierr = NF_DEF_VAR (nid, "masque", NF_DOUBLE, 1, idim2,nvarid)
	160	#else
[98]	161	ierr = NF_DEF_VAR (nid, "masque", NF_FLOAT, 1, idim2,nvarid)
[352]	162	#endif
[98]	163	ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 16,
	164	. "masque terre mer")
	165	ierr = NF_ENDDEF(nid)
	166	#ifdef NC_DOUBLE
	167	ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,zmasq)
	168	#else
	169	ierr = NF_PUT_VAR_REAL (nid,nvarid,zmasq)
	170	#endif
	171	c BP ajout des fraction de chaque sous-surface
	172	C
	173	C 1. fraction de terre
	174	C
	175	ierr = NF_REDEF (nid)
[352]	176	#ifdef NC_DOUBLE
	177	ierr = NF_DEF_VAR (nid, "FTER", NF_DOUBLE, 1, idim2,nvarid)
	178	#else
[98]	179	ierr = NF_DEF_VAR (nid, "FTER", NF_FLOAT, 1, idim2,nvarid)
[352]	180	#endif
[98]	181	ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 21,
	182	. "fraction de continent")
	183	ierr = NF_ENDDEF(nid)
	184	#ifdef NC_DOUBLE
	185	ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,pctsrf(1 : klon, is_ter))
	186	#else
	187	ierr = NF_PUT_VAR_REAL (nid,nvarid,pctsrf(1 : klon, is_ter))
	188	#endif
	189	C
	190	C 2. Fraction de glace de terre
	191	C
	192	ierr = NF_REDEF (nid)
[352]	193	#ifdef NC_DOUBLE
	194	ierr = NF_DEF_VAR (nid, "FLIC", NF_DOUBLE, 1, idim2,nvarid)
	195	#else
[98]	196	ierr = NF_DEF_VAR (nid, "FLIC", NF_FLOAT, 1, idim2,nvarid)
[352]	197	#endif
[98]	198	ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 24,
	199	. "fraction glace de terre")
	200	ierr = NF_ENDDEF(nid)
	201	#ifdef NC_DOUBLE
	202	ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,pctsrf(1 : klon,is_lic))
	203	#else
	204	ierr = NF_PUT_VAR_REAL (nid,nvarid,pctsrf(1 : klon, is_lic))
	205	#endif
	206	C
	207	C 3. fraction ocean
	208	C
	209	ierr = NF_REDEF (nid)
[352]	210	#ifdef NC_DOUBLE
	211	ierr = NF_DEF_VAR (nid, "FOCE", NF_DOUBLE, 1, idim2,nvarid)
	212	#else
[98]	213	ierr = NF_DEF_VAR (nid, "FOCE", NF_FLOAT, 1, idim2,nvarid)
[352]	214	#endif
[98]	215	ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 14,
	216	. "fraction ocean")
	217	ierr = NF_ENDDEF(nid)
	218	#ifdef NC_DOUBLE
	219	ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,pctsrf(1 : klon, is_oce))
	220	#else
	221	ierr = NF_PUT_VAR_REAL (nid,nvarid,pctsrf(1 : klon, is_oce))
	222	#endif
	223	C
	224	C 4. Fraction glace de mer
	225	C
	226	ierr = NF_REDEF (nid)
[352]	227	#ifdef NC_DOUBLE
	228	ierr = NF_DEF_VAR (nid, "FSIC", NF_DOUBLE, 1, idim2,nvarid)
	229	#else
[98]	230	ierr = NF_DEF_VAR (nid, "FSIC", NF_FLOAT, 1, idim2,nvarid)
[352]	231	#endif
[98]	232	ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 18,
	233	. "fraction glace mer")
	234	ierr = NF_ENDDEF(nid)
	235	#ifdef NC_DOUBLE
	236	ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,pctsrf(1 : klon, is_sic))
	237	#else
	238	ierr = NF_PUT_VAR_REAL (nid,nvarid,pctsrf(1 : klon, is_sic))
	239	#endif
	240	C
	241	C
[2]	242	c
	243	DO nsrf = 1, nbsrf
	244	IF (nsrf.LE.99) THEN
	245	WRITE(str2,'(i2.2)') nsrf
	246	ierr = NF_REDEF (nid)
[352]	247	#ifdef NC_DOUBLE
	248	ierr = NF_DEF_VAR (nid, "TS"//str2, NF_DOUBLE, 1, idim2,nvarid)
	249	#else
[2]	250	ierr = NF_DEF_VAR (nid, "TS"//str2, NF_FLOAT, 1, idim2,nvarid)
[352]	251	#endif
[2]	252	ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 28,
	253	. "Temperature de surface No."//str2)
	254	ierr = NF_ENDDEF(nid)
	255	ELSE
	256	PRINT*, "Trop de sous-mailles"
	257	CALL abort
	258	ENDIF
	259	#ifdef NC_DOUBLE
	260	ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,tsol(1,nsrf))
	261	#else
	262	ierr = NF_PUT_VAR_REAL (nid,nvarid,tsol(1,nsrf))
	263	#endif
	264	ENDDO
	265	c
	266	DO nsrf = 1, nbsrf
	267	DO isoil=1, nsoilmx
	268	IF (isoil.LE.99 .AND. nsrf.LE.99) THEN
	269	WRITE(str7,'(i2.2,"srf",i2.2)') isoil,nsrf
	270	ierr = NF_REDEF (nid)
[352]	271	#ifdef NC_DOUBLE
	272	ierr = NF_DEF_VAR (nid, "Tsoil"//str7,NF_DOUBLE,1,idim2,nvarid)
	273	#else
[2]	274	ierr = NF_DEF_VAR (nid, "Tsoil"//str7,NF_FLOAT,1,idim2,nvarid)
[352]	275	#endif
[2]	276	ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 29,
	277	. "Temperature du sol No."//str7)
	278	ierr = NF_ENDDEF(nid)
	279	ELSE
	280	PRINT*, "Trop de couches"
	281	CALL abort
	282	ENDIF
	283	#ifdef NC_DOUBLE
	284	ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,tsoil(1,isoil,nsrf))
	285	#else
	286	ierr = NF_PUT_VAR_REAL (nid,nvarid,tsoil(1,isoil,nsrf))
	287	#endif
	288	ENDDO
	289	ENDDO
	290	c
	291	c
	292	ierr = NF_REDEF (nid)
[352]	293	#ifdef NC_DOUBLE
	294	ierr = NF_DEF_VAR (nid, "DELTAT", NF_DOUBLE, 1, idim2,nvarid)
	295	#else
[2]	296	ierr = NF_DEF_VAR (nid, "DELTAT", NF_FLOAT, 1, idim2,nvarid)
[352]	297	#endif
[2]	298	ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 33,
	299	. "Ecart de la SST (pour slab-ocean)")
	300	ierr = NF_ENDDEF(nid)
	301	#ifdef NC_DOUBLE
	302	ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,deltat)
	303	#else
	304	ierr = NF_PUT_VAR_REAL (nid,nvarid,deltat)
	305	#endif
	306	c
	307	DO nsrf = 1, nbsrf
	308	IF (nsrf.LE.99) THEN
	309	WRITE(str2,'(i2.2)') nsrf
	310	ierr = NF_REDEF (nid)
[352]	311	#ifdef NC_DOUBLE
	312	ierr = NF_DEF_VAR (nid,"QS"//str2,NF_DOUBLE,1,idim2,nvarid)
	313	#else
[2]	314	ierr = NF_DEF_VAR (nid,"QS"//str2,NF_FLOAT,1,idim2,nvarid)
[352]	315	#endif
[2]	316	ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 25,
	317	. "Humidite de surface No."//str2)
	318	ierr = NF_ENDDEF(nid)
	319	ELSE
	320	PRINT*, "Trop de sous-mailles"
	321	CALL abort
	322	ENDIF
	323	#ifdef NC_DOUBLE
[443]	324	ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,qsurf(1,nsrf))
[2]	325	#else
[443]	326	ierr = NF_PUT_VAR_REAL (nid,nvarid,qsurf(1,nsrf))
[2]	327	#endif
[443]	328	END DO
	329	C
	330	ierr = NF_REDEF (nid)
	331	#ifdef NC_DOUBLE
	332	ierr = NF_DEF_VAR (nid,"QSOL",NF_DOUBLE,1,idim2,nvarid)
	333	#else
	334	ierr = NF_DEF_VAR (nid,"QSOL",NF_FLOAT,1,idim2,nvarid)
	335	#endif
	336	ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 20,
	337	. "Eau dans le sol (mm)")
	338	ierr = NF_ENDDEF(nid)
	339	#ifdef NC_DOUBLE
	340	ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,qsol)
	341	#else
	342	ierr = NF_PUT_VAR_REAL (nid,nvarid,qsol)
	343	#endif
[2]	344	c
	345	DO nsrf = 1, nbsrf
	346	IF (nsrf.LE.99) THEN
	347	WRITE(str2,'(i2.2)') nsrf
	348	ierr = NF_REDEF (nid)
[352]	349	#ifdef NC_DOUBLE
	350	ierr = NF_DEF_VAR (nid,"ALBE"//str2,NF_DOUBLE,1,idim2,nvarid)
	351	#else
[98]	352	ierr = NF_DEF_VAR (nid,"ALBE"//str2,NF_FLOAT,1,idim2,nvarid)
[352]	353	#endif
[98]	354	ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 23,
	355	. "albedo de surface No."//str2)
	356	ierr = NF_ENDDEF(nid)
	357	ELSE
	358	PRINT*, "Trop de sous-mailles"
	359	CALL abort
	360	ENDIF
	361	#ifdef NC_DOUBLE
	362	ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,albedo(1,nsrf))
	363	#else
	364	ierr = NF_PUT_VAR_REAL (nid,nvarid,albedo(1,nsrf))
	365	#endif
	366	ENDDO
[467]	367
	368	cIM BEG albedo LW
	369	DO nsrf = 1, nbsrf
	370	IF (nsrf.LE.99) THEN
	371	WRITE(str2,'(i2.2)') nsrf
	372	ierr = NF_REDEF (nid)
	373	#ifdef NC_DOUBLE
	374	ierr = NF_DEF_VAR (nid,"ALBLW"//str2,NF_DOUBLE,1,idim2,nvarid)
	375	#else
	376	ierr = NF_DEF_VAR (nid,"ALBLW"//str2,NF_FLOAT,1,idim2,nvarid)
	377	#endif
	378	ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 23,
	379	. "albedo LW de surface No."//str2)
	380	ierr = NF_ENDDEF(nid)
	381	ELSE
	382	PRINT*, "Trop de sous-mailles"
	383	CALL abort
	384	ENDIF
	385	#ifdef NC_DOUBLE
	386	ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,alblw(1,nsrf))
	387	#else
	388	ierr = NF_PUT_VAR_REAL (nid,nvarid,alblw(1,nsrf))
	389	#endif
	390	ENDDO
	391	cIM END albedo LW
[98]	392	c
	393	DO nsrf = 1, nbsrf
	394	IF (nsrf.LE.99) THEN
	395	WRITE(str2,'(i2.2)') nsrf
	396	ierr = NF_REDEF (nid)
[352]	397	#ifdef NC_DOUBLE
	398	ierr = NF_DEF_VAR (nid,"EVAP"//str2,NF_DOUBLE,1,idim2,nvarid)
	399	#else
[98]	400	ierr = NF_DEF_VAR (nid,"EVAP"//str2,NF_FLOAT,1,idim2,nvarid)
[352]	401	#endif
[98]	402	ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 28,
	403	. "Evaporation de surface No."//str2)
	404	ierr = NF_ENDDEF(nid)
	405	ELSE
	406	PRINT*, "Trop de sous-mailles"
	407	CALL abort
	408	ENDIF
	409	#ifdef NC_DOUBLE
	410	ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,evap(1,nsrf))
	411	#else
	412	ierr = NF_PUT_VAR_REAL (nid,nvarid,evap(1,nsrf))
	413	#endif
	414	ENDDO
	415
	416	c
	417	DO nsrf = 1, nbsrf
	418	IF (nsrf.LE.99) THEN
	419	WRITE(str2,'(i2.2)') nsrf
	420	ierr = NF_REDEF (nid)
[352]	421	#ifdef NC_DOUBLE
	422	ierr = NF_DEF_VAR (nid,"SNOW"//str2,NF_DOUBLE,1,idim2,nvarid)
	423	#else
[2]	424	ierr = NF_DEF_VAR (nid,"SNOW"//str2,NF_FLOAT,1,idim2,nvarid)
[352]	425	#endif
[2]	426	ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 22,
	427	. "Neige de surface No."//str2)
	428	ierr = NF_ENDDEF(nid)
	429	ELSE
	430	PRINT*, "Trop de sous-mailles"
	431	CALL abort
	432	ENDIF
	433	#ifdef NC_DOUBLE
	434	ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,snow(1,nsrf))
	435	#else
	436	ierr = NF_PUT_VAR_REAL (nid,nvarid,snow(1,nsrf))
	437	#endif
	438	ENDDO
[98]	439
[2]	440	c
	441	ierr = NF_REDEF (nid)
[352]	442	#ifdef NC_DOUBLE
	443	ierr = NF_DEF_VAR (nid, "RADS", NF_DOUBLE, 1, idim2,nvarid)
	444	#else
[2]	445	ierr = NF_DEF_VAR (nid, "RADS", NF_FLOAT, 1, idim2,nvarid)
[352]	446	#endif
[2]	447	ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 28,
	448	. "Rayonnement net a la surface")
	449	ierr = NF_ENDDEF(nid)
	450	#ifdef NC_DOUBLE
	451	ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,radsol)
	452	#else
	453	ierr = NF_PUT_VAR_REAL (nid,nvarid,radsol)
	454	#endif
	455	c
	456	ierr = NF_REDEF (nid)
[352]	457	#ifdef NC_DOUBLE
	458	ierr = NF_DEF_VAR (nid, "solsw", NF_DOUBLE, 1, idim2,nvarid)
	459	#else
[98]	460	ierr = NF_DEF_VAR (nid, "solsw", NF_FLOAT, 1, idim2,nvarid)
[352]	461	#endif
[98]	462	ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 32,
	463	. "Rayonnement solaire a la surface")
	464	ierr = NF_ENDDEF(nid)
	465	#ifdef NC_DOUBLE
	466	ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,solsw)
	467	#else
	468	ierr = NF_PUT_VAR_REAL (nid,nvarid,solsw)
	469	#endif
	470	c
	471	ierr = NF_REDEF (nid)
[352]	472	#ifdef NC_DOUBLE
	473	ierr = NF_DEF_VAR (nid, "sollw", NF_DOUBLE, 1, idim2,nvarid)
	474	#else
[98]	475	ierr = NF_DEF_VAR (nid, "sollw", NF_FLOAT, 1, idim2,nvarid)
[352]	476	#endif
[98]	477	ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 27,
	478	. "Rayonnement IF a la surface")
	479	ierr = NF_ENDDEF(nid)
	480	#ifdef NC_DOUBLE
	481	ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,sollw)
	482	#else
	483	ierr = NF_PUT_VAR_REAL (nid,nvarid,sollw)
	484	#endif
	485	c
	486	ierr = NF_REDEF (nid)
[352]	487	#ifdef NC_DOUBLE
	488	ierr = NF_DEF_VAR (nid, "fder", NF_DOUBLE, 1, idim2,nvarid)
	489	#else
[151]	490	ierr = NF_DEF_VAR (nid, "fder", NF_FLOAT, 1, idim2,nvarid)
[352]	491	#endif
[151]	492	ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 14,
	493	. "Derive de flux")
	494	ierr = NF_ENDDEF(nid)
	495	#ifdef NC_DOUBLE
	496	ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,fder)
	497	#else
	498	ierr = NF_PUT_VAR_REAL (nid,nvarid,fder)
	499	#endif
	500	c
	501	ierr = NF_REDEF (nid)
[352]	502	#ifdef NC_DOUBLE
	503	ierr = NF_DEF_VAR (nid, "rain_f", NF_DOUBLE, 1, idim2,nvarid)
	504	#else
[98]	505	ierr = NF_DEF_VAR (nid, "rain_f", NF_FLOAT, 1, idim2,nvarid)
[352]	506	#endif
[98]	507	ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 21,
	508	. "precipitation liquide")
	509	ierr = NF_ENDDEF(nid)
	510	#ifdef NC_DOUBLE
	511	ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,rain_fall)
	512	#else
	513	ierr = NF_PUT_VAR_REAL (nid,nvarid,rain_fall)
	514	#endif
	515	c
	516	ierr = NF_REDEF (nid)
[352]	517	#ifdef NC_DOUBLE
	518	ierr = NF_DEF_VAR (nid, "snow_f", NF_DOUBLE, 1, idim2,nvarid)
	519	#else
[98]	520	ierr = NF_DEF_VAR (nid, "snow_f", NF_FLOAT, 1, idim2,nvarid)
[352]	521	#endif
[98]	522	ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 20,
	523	. "precipitation solide")
	524	ierr = NF_ENDDEF(nid)
	525	#ifdef NC_DOUBLE
	526	ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,snow_fall)
	527	#else
	528	ierr = NF_PUT_VAR_REAL (nid,nvarid,snow_fall)
	529	#endif
	530	c
[112]	531	DO nsrf = 1, nbsrf
	532	IF (nsrf.LE.99) THEN
	533	WRITE(str2,'(i2.2)') nsrf
	534	ierr = NF_REDEF (nid)
[352]	535	#ifdef NC_DOUBLE
	536	ierr = NF_DEF_VAR (nid,"RUG"//str2,NF_DOUBLE,1,idim2,nvarid)
	537	#else
[112]	538	ierr = NF_DEF_VAR (nid,"RUG"//str2,NF_FLOAT,1,idim2,nvarid)
[352]	539	#endif
[112]	540	ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 23,
	541	. "rugosite de surface No."//str2)
	542	ierr = NF_ENDDEF(nid)
	543	ELSE
	544	PRINT*, "Trop de sous-mailles"
	545	CALL abort
	546	ENDIF
[2]	547	#ifdef NC_DOUBLE
[112]	548	ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,frugs(1,nsrf))
[2]	549	#else
[112]	550	ierr = NF_PUT_VAR_REAL (nid,nvarid,frugs(1,nsrf))
[2]	551	#endif
[112]	552	ENDDO
[2]	553	c
[258]	554	DO nsrf = 1, nbsrf
	555	IF (nsrf.LE.99) THEN
	556	WRITE(str2,'(i2.2)') nsrf
	557	ierr = NF_REDEF (nid)
[352]	558	#ifdef NC_DOUBLE
	559	ierr = NF_DEF_VAR (nid,"AGESNO"//str2,NF_DOUBLE,1,idim2
	560	$ ,nvarid)
	561	#else
[258]	562	ierr = NF_DEF_VAR (nid,"AGESNO"//str2,NF_FLOAT,1,idim2
	563	$ ,nvarid)
[352]	564	#endif
[258]	565	ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 15,
	566	. "Age de la neige surface No."//str2)
	567	ierr = NF_ENDDEF(nid)
	568	ELSE
	569	PRINT*, "Trop de sous-mailles"
	570	CALL abort
	571	ENDIF
[2]	572	#ifdef NC_DOUBLE
[258]	573	ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,agesno(1,nsrf))
[2]	574	#else
[258]	575	ierr = NF_PUT_VAR_REAL (nid,nvarid,agesno(1,nsrf))
[2]	576	#endif
[258]	577	ENDDO
[2]	578	c
	579	ierr = NF_REDEF (nid)
[352]	580	#ifdef NC_DOUBLE
	581	ierr = NF_DEF_VAR (nid, "ZMEA", NF_DOUBLE, 1, idim2,nvarid)
	582	#else
[2]	583	ierr = NF_DEF_VAR (nid, "ZMEA", NF_FLOAT, 1, idim2,nvarid)
[352]	584	#endif
[2]	585	ierr = NF_ENDDEF(nid)
	586	#ifdef NC_DOUBLE
	587	ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,zmea)
	588	#else
	589	ierr = NF_PUT_VAR_REAL (nid,nvarid,zmea)
	590	#endif
	591	c
	592	ierr = NF_REDEF (nid)
[352]	593	#ifdef NC_DOUBLE
	594	ierr = NF_DEF_VAR (nid, "ZSTD", NF_DOUBLE, 1, idim2,nvarid)
	595	#else
[2]	596	ierr = NF_DEF_VAR (nid, "ZSTD", NF_FLOAT, 1, idim2,nvarid)
[352]	597	#endif
[2]	598	ierr = NF_ENDDEF(nid)
	599	#ifdef NC_DOUBLE
	600	ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,zstd)
	601	#else
	602	ierr = NF_PUT_VAR_REAL (nid,nvarid,zstd)
	603	#endif
	604	ierr = NF_REDEF (nid)
[352]	605	#ifdef NC_DOUBLE
	606	ierr = NF_DEF_VAR (nid, "ZSIG", NF_DOUBLE, 1, idim2,nvarid)
	607	#else
[2]	608	ierr = NF_DEF_VAR (nid, "ZSIG", NF_FLOAT, 1, idim2,nvarid)
[352]	609	#endif
[2]	610	ierr = NF_ENDDEF(nid)
	611	#ifdef NC_DOUBLE
	612	ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,zsig)
	613	#else
	614	ierr = NF_PUT_VAR_REAL (nid,nvarid,zsig)
	615	#endif
	616	ierr = NF_REDEF (nid)
[352]	617	#ifdef NC_DOUBLE
	618	ierr = NF_DEF_VAR (nid, "ZGAM", NF_DOUBLE, 1, idim2,nvarid)
	619	#else
[2]	620	ierr = NF_DEF_VAR (nid, "ZGAM", NF_FLOAT, 1, idim2,nvarid)
[352]	621	#endif
[2]	622	ierr = NF_ENDDEF(nid)
	623	#ifdef NC_DOUBLE
	624	ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,zgam)
	625	#else
	626	ierr = NF_PUT_VAR_REAL (nid,nvarid,zgam)
	627	#endif
	628	ierr = NF_REDEF (nid)
[352]	629	#ifdef NC_DOUBLE
	630	ierr = NF_DEF_VAR (nid, "ZTHE", NF_DOUBLE, 1, idim2,nvarid)
	631	#else
[2]	632	ierr = NF_DEF_VAR (nid, "ZTHE", NF_FLOAT, 1, idim2,nvarid)
[352]	633	#endif
[2]	634	ierr = NF_ENDDEF(nid)
	635	#ifdef NC_DOUBLE
	636	ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,zthe)
	637	#else
	638	ierr = NF_PUT_VAR_REAL (nid,nvarid,zthe)
	639	#endif
	640	ierr = NF_REDEF (nid)
[352]	641	#ifdef NC_DOUBLE
	642	ierr = NF_DEF_VAR (nid, "ZPIC", NF_DOUBLE, 1, idim2,nvarid)
	643	#else
[2]	644	ierr = NF_DEF_VAR (nid, "ZPIC", NF_FLOAT, 1, idim2,nvarid)
[352]	645	#endif
[2]	646	ierr = NF_ENDDEF(nid)
	647	#ifdef NC_DOUBLE
	648	ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,zpic)
	649	#else
	650	ierr = NF_PUT_VAR_REAL (nid,nvarid,zpic)
	651	#endif
	652	ierr = NF_REDEF (nid)
[352]	653	#ifdef NC_DOUBLE
	654	ierr = NF_DEF_VAR (nid, "ZVAL", NF_DOUBLE, 1, idim2,nvarid)
	655	#else
[2]	656	ierr = NF_DEF_VAR (nid, "ZVAL", NF_FLOAT, 1, idim2,nvarid)
[352]	657	#endif
[2]	658	ierr = NF_ENDDEF(nid)
	659	#ifdef NC_DOUBLE
	660	ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,zval)
	661	#else
	662	ierr = NF_PUT_VAR_REAL (nid,nvarid,zval)
	663	#endif
	664	ierr = NF_REDEF (nid)
[352]	665	#ifdef NC_DOUBLE
	666	ierr = NF_DEF_VAR (nid, "RUGSREL", NF_DOUBLE, 1, idim2,nvarid)
	667	#else
[2]	668	ierr = NF_DEF_VAR (nid, "RUGSREL", NF_FLOAT, 1, idim2,nvarid)
[352]	669	#endif
[2]	670	ierr = NF_ENDDEF(nid)
	671	#ifdef NC_DOUBLE
	672	ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,rugsrel)
	673	#else
	674	ierr = NF_PUT_VAR_REAL (nid,nvarid,rugsrel)
	675	#endif
	676	c
[45]	677	ierr = NF_REDEF (nid)
[352]	678	#ifdef NC_DOUBLE
	679	ierr = NF_DEF_VAR (nid, "TANCIEN", NF_DOUBLE, 1, idim3,nvarid)
	680	#else
[45]	681	ierr = NF_DEF_VAR (nid, "TANCIEN", NF_FLOAT, 1, idim3,nvarid)
[352]	682	#endif
[45]	683	ierr = NF_ENDDEF(nid)
	684	#ifdef NC_DOUBLE
	685	ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,t_ancien)
	686	#else
	687	ierr = NF_PUT_VAR_REAL (nid,nvarid,t_ancien)
	688	#endif
	689	c
	690	ierr = NF_REDEF (nid)
[352]	691	#ifdef NC_DOUBLE
	692	ierr = NF_DEF_VAR (nid, "QANCIEN", NF_DOUBLE, 1, idim3,nvarid)
	693	#else
[45]	694	ierr = NF_DEF_VAR (nid, "QANCIEN", NF_FLOAT, 1, idim3,nvarid)
[352]	695	#endif
[45]	696	ierr = NF_ENDDEF(nid)
	697	#ifdef NC_DOUBLE
	698	ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,q_ancien)
	699	#else
	700	ierr = NF_PUT_VAR_REAL (nid,nvarid,q_ancien)
	701	#endif
	702	c
[177]	703	ierr = NF_REDEF (nid)
[352]	704	#ifdef NC_DOUBLE
	705	ierr = NF_DEF_VAR (nid, "RUGMER", NF_DOUBLE, 1, idim2,nvarid)
	706	#else
[177]	707	ierr = NF_DEF_VAR (nid, "RUGMER", NF_FLOAT, 1, idim2,nvarid)
[352]	708	#endif
[177]	709	ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 28,
	710	. "Longueur de rugosite sur mer")
	711	ierr = NF_ENDDEF(nid)
	712	#ifdef NC_DOUBLE
	713	ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,frugs(1,is_oce))
	714	#else
	715	ierr = NF_PUT_VAR_REAL (nid,nvarid,frugs(1,is_oce))
	716	#endif
	717	c
[373]	718	ierr = NF_REDEF (nid)
	719	#ifdef NC_DOUBLE
	720	ierr = NF_DEF_VAR (nid, "CLWCON", NF_DOUBLE, 1, idim2,nvarid)
	721	#else
	722	ierr = NF_DEF_VAR (nid, "CLWCON", NF_FLOAT, 1, idim2,nvarid)
	723	#endif
	724	ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 28,
	725	. "Eau liquide convective")
	726	ierr = NF_ENDDEF(nid)
	727	#ifdef NC_DOUBLE
	728	ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,clwcon)
	729	#else
	730	ierr = NF_PUT_VAR_REAL (nid,nvarid,clwcon)
	731	#endif
[177]	732	c
[373]	733	ierr = NF_REDEF (nid)
	734	#ifdef NC_DOUBLE
	735	ierr = NF_DEF_VAR (nid, "RNEBCON", NF_DOUBLE, 1, idim2,nvarid)
	736	#else
	737	ierr = NF_DEF_VAR (nid, "RNEBCON", NF_FLOAT, 1, idim2,nvarid)
	738	#endif
	739	ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 28,
	740	. "Nebulosite convective")
	741	ierr = NF_ENDDEF(nid)
	742	#ifdef NC_DOUBLE
	743	ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,rnebcon)
	744	#else
	745	ierr = NF_PUT_VAR_REAL (nid,nvarid,rnebcon)
	746	#endif
	747	c
	748	ierr = NF_REDEF (nid)
	749	#ifdef NC_DOUBLE
	750	ierr = NF_DEF_VAR (nid, "RATQS", NF_DOUBLE, 1, idim2,nvarid)
	751	#else
	752	ierr = NF_DEF_VAR (nid, "RATQS", NF_FLOAT, 1, idim2,nvarid)
	753	#endif
	754	ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 28,
	755	. "Ratqs")
	756	ierr = NF_ENDDEF(nid)
	757	#ifdef NC_DOUBLE
	758	ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,ratqs)
	759	#else
	760	ierr = NF_PUT_VAR_REAL (nid,nvarid,ratqs)
	761	#endif
	762	c
[522]	763	c run_off_lic_0
[373]	764	c
[522]	765	ierr = NF_REDEF (nid)
	766	#ifdef NC_DOUBLE
	767	ierr=NF_DEF_VAR(nid,"RUNOFFLIC0",NF_DOUBLE,1,idim2,nvarid)
	768	#else
	769	ierr=NF_DEF_VAR(nid,"RUNOFFLIC0",NF_FLOAT, 1,idim2,nvarid)
	770	#endif
	771	ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 28,
	772	. "Runofflic0")
	773	ierr = NF_ENDDEF(nid)
	774	#ifdef NC_DOUBLE
	775	ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,run_off_lic_0)
	776	#else
	777	ierr = NF_PUT_VAR_REAL (nid,nvarid,run_off_lic_0)
	778	#endif
	779	c
	780	c
[2]	781	ierr = NF_CLOSE(nid)
	782	c
	783	RETURN
	784	END

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

Download in other formats:

Original Format