Context Navigation

limit_netcdf.F @ 354

Last change on this file since 354 was 353, checked in by lmdzadmin, 23 years ago

2 changements pour les fichiers histoire:

utilisation de l'entree "rectilineaire" de IOIPSL pour ne plus avoir

lancer ncregular a chaque fois

le calendrier des fichiers histoire est maintenant base sur la date d'initialisation de la simulation plutot que sur la date de depart du

job

en cours

Property svn:eol-style set to native
Property svn:executable set to *
Property svn:keywords set to Author Date Id Revision

File size: 34.0 KB

Rev	Line
[259]	1	C
	2	C $Header$
	3	C
[325]	4	SUBROUTINE limit_netcdf(interbar, extrap, oldice, masque, pctsrf)
[259]	5	c
	6	IMPLICIT none
	7	c
	8	c-------------------------------------------------------------
	9	C Author : L. Fairhead
	10	C Date : 27/01/94
	11	C Objet : Construction des fichiers de conditions aux limites
	12	C pour le nouveau
	13	C modele a partir de fichiers de climatologie. Les deux
	14	C grilles doivent etre regulieres
	15	c
	16	c Modifie par z.x.li (le23mars1994)
	17	c Modifie par L. Fairhead (fairhead@lmd.jussieu.fr) septembre 1999
	18	c pour lecture netcdf dans LMDZ.3.3
	19	c Modifie par P;Le Van , juillet 2001
	20	c-------------------------------------------------------------
	21	c
	22	#include "dimensions.h"
	23	#include "paramet.h"
	24	#include "control.h"
	25	#include "logic.h"
	26	#include "netcdf.inc"
	27	#include "comvert.h"
	28	#include "comgeom2.h"
	29	#include "comconst.h"
[320]	30	#include "dimphy.h"
[325]	31	#include "indicesol.h"
[259]	32	c
	33	c-----------------------------------------------------------------------
	34	LOGICAL interbar, extrap, oldice
	35
	36	REAL phy_nat(klon,360), phy_nat0(klon)
	37	REAL phy_alb(klon,360)
	38	REAL phy_sst(klon,360)
	39	REAL phy_bil(klon,360)
	40	REAL phy_rug(klon,360)
[327]	41	REAL phy_ice(klon)
[259]	42	c
[325]	43	real pctsrf_t(klon,nbsrf,360)
	44	real pctsrf(klon,nbsrf)
	45	REAL verif
	46
[259]	47	REAL masque(iip1,jjp1)
	48	REAL mask(iim,jjp1)
[325]	49	CPB
	50	C newlmt indique l'utilisation de la sous-maille fractionnelle
	51	C tandis que l'ancien codage utilise l'indicateur du sol (0,1,2,3)
	52	LOGICAL newlmt, fracterre
	53	PARAMETER(newlmt=.TRUE.)
	54	PARAMETER(fracterre = .TRUE.)
[259]	55
	56	C Declarations pour le champ de depart
	57	INTEGER imdep, jmdep,lmdep
	58	INTEGER tbid
	59	PARAMETER ( tbid = 60 ) ! >52 semaines
	60	REAL timecoord(tbid)
	61	c
	62	REAL , ALLOCATABLE :: dlon_msk(:), dlat_msk(:)
	63	REAL , ALLOCATABLE :: lonmsk_ini(:), latmsk_ini(:)
	64	REAL , ALLOCATABLE :: dlon(:), dlat(:)
	65	REAL , ALLOCATABLE :: dlon_ini(:), dlat_ini(:)
	66	REAL , ALLOCATABLE :: champ_msk(:), champ(:)
	67	REAL , ALLOCATABLE :: work(:,:)
	68
	69	CHARACTER*25 title
	70
	71	C Declarations pour le champ interpole 2D
	72	REAL champint(iim,jjp1)
	73	real chmin,chmax
	74
	75	C Declarations pour le champ interpole 3D
	76	REAL champtime(iim,jjp1,tbid)
	77	REAL timeyear(tbid)
	78	REAL champan(iip1,jjp1,366)
	79
	80	C Declarations pour l'inteprolation verticale
	81	REAL ax(tbid), ay(tbid)
	82	REAL by
	83	REAL yder(tbid)
	84
	85
	86	INTEGER ierr
	87	INTEGER dimfirst(3)
	88	INTEGER dimlast(3)
	89	c
	90	INTEGER nid, ndim, ntim
	91	INTEGER dims(2), debut(2), epais(2)
	92	INTEGER id_tim
	93	INTEGER id_NAT, id_SST, id_BILS, id_RUG, id_ALB
[325]	94	CPB
	95	INTEGER id_FOCE, id_FSIC, id_FTER, id_FLIC
[259]	96
[325]	97	INTEGER i, j, k, l, ji
	98	c declarations pour lecture glace de mer
	99	INTEGER :: iml_lic, jml_lic, llm_tmp, ttm_tmp, iret
	100	INTEGER :: itaul(1), fid
	101	REAL :: lev(1), date, dt
	102	REAL, ALLOCATABLE, DIMENSION(:,:) :: lon_lic, lat_lic
	103	REAL, ALLOCATABLE, DIMENSION(:) :: dlon_lic, dlat_lic
	104	REAL, ALLOCATABLE, DIMENSION (:,:) :: fraclic
	105	REAL :: flic_tmp(iip1, jjp1)
	106
[259]	107	c Diverses variables locales
	108	REAL time
[325]	109	! pour la lecture du fichier masque ocean
	110	integer :: nid_o2a
	111	logical :: couple = .false.
	112	INTEGER :: iml_omask, jml_omask
	113	REAL, ALLOCATABLE, DIMENSION(:,:) :: lon_omask, lat_omask
	114	REAL, ALLOCATABLE, DIMENSION(:) :: dlon_omask, dlat_omask
	115	REAL, ALLOCATABLE, DIMENSION (:,:) :: ocemask, ocetmp
	116	real, dimension(klon) :: ocemask_fi
[259]	117
	118	INTEGER longcles
	119	PARAMETER ( longcles = 20 )
	120	REAL clesphy0 ( longcles )
	121	#include "serre.h"
	122	INTEGER ncid,varid,ndimid(4),dimid
	123	character*30 namedim
[325]	124	CHARACTER*80 :: varname
[259]	125
[325]	126	c initialisations:
	127	CALL conf_gcm( 99, .TRUE. , clesphy0 )
	128
	129
[259]	130	pi = 4. * ATAN(1.)
	131	rad = 6 371 229.
	132	omeg = 4.* ASIN(1.)/(24.*3600.)
	133	g = 9.8
	134	daysec = 86400.
	135	kappa = 0.2857143
	136	cpp = 1004.70885
	137	dtvr = daysec/FLOAT(day_step)
[325]	138	CALL inigeom
[259]	139	c
	140	C Traitement du relief au sol
	141	c
	142	write(,) 'Traitement du relief au sol pour fabriquer masque'
	143	ierr = NF_OPEN('Relief.nc', NF_NOWRITE, ncid)
	144
	145	if (ierr.ne.0) then
	146	print *, NF_STRERROR(ierr)
	147	STOP
	148	ENDIF
	149
	150	ierr = NF_INQ_VARID(ncid,'RELIEF',varid)
	151	if (ierr.ne.0) then
	152	print *, NF_STRERROR(ierr)
	153	STOP
	154	ENDIF
	155	ierr = NF_INQ_VARDIMID (ncid,varid,ndimid)
	156	if (ierr.ne.0) then
	157	print *, NF_STRERROR(ierr)
	158	STOP
	159	ENDIF
	160	ierr = NF_INQ_DIM(ncid,ndimid(1), namedim, imdep)
	161	if (ierr.ne.0) then
	162	print *, NF_STRERROR(ierr)
	163	STOP
	164	ENDIF
	165	print*,'variable ', namedim, 'dimension ', imdep
	166	ierr = NF_INQ_VARID(ncid,namedim,dimid)
	167	if (ierr.ne.0) then
	168	print *, NF_STRERROR(ierr)
	169	STOP
	170	ENDIF
	171
	172	ALLOCATE( lonmsk_ini(imdep) )
	173	ALLOCATE( dlon_msk(imdep) )
	174
	175	#ifdef NC_DOUBLE
	176	ierr = NF_GET_VAR_DOUBLE(ncid,dimid,lonmsk_ini)
	177	#else
	178	ierr = NF_GET_VAR_REAL(ncid,dimid,lonmsk_ini)
	179	#endif
	180
	181	c
	182	if (ierr.ne.0) then
	183	print *, NF_STRERROR(ierr)
	184	STOP
	185	ENDIF
	186	ierr = NF_INQ_DIM(ncid,ndimid(2), namedim, jmdep)
	187	if (ierr.ne.0) then
	188	print *, NF_STRERROR(ierr)
	189	STOP
	190	ENDIF
	191	print*,'variable ', namedim, 'dimension ', jmdep
	192	ierr = NF_INQ_VARID(ncid,namedim,dimid)
	193	if (ierr.ne.0) then
	194	print *, NF_STRERROR(ierr)
	195	STOP
	196	ENDIF
	197
	198	ALLOCATE( latmsk_ini(jmdep) )
	199	ALLOCATE( dlat_msk(jmdep) )
	200	ALLOCATE( champ_msk(imdep*jmdep) )
	201
	202	#ifdef NC_DOUBLE
	203	ierr = NF_GET_VAR_DOUBLE(ncid,dimid,latmsk_ini)
	204	#else
	205	ierr = NF_GET_VAR_REAL(ncid,dimid,latmsk_ini)
	206	#endif
	207	c
	208	if (ierr.ne.0) then
	209	print *, NF_STRERROR(ierr)
	210	STOP
	211	ENDIF
	212	#ifdef NC_DOUBLE
	213	ierr = NF_GET_VAR_DOUBLE(ncid,varid,champ_msk)
	214	#else
	215	ierr = NF_GET_VAR_REAL(ncid,varid,champ_msk)
	216	#endif
	217	c
	218	if (ierr.ne.0) then
	219	print *, NF_STRERROR(ierr)
	220	STOP
	221	ENDIF
	222	c
	223	title='RELIEF'
	224
	225	CALL conf_dat2d(title,imdep, jmdep, lonmsk_ini, latmsk_ini,
	226	. dlon_msk, dlat_msk, champ_msk, interbar )
	227
	228	DO i = 1, iim
	229	DO j = 1, jjp1
[353]	230	mask(i,j) = masque(i,j)
[259]	231	ENDDO
	232	ENDDO
	233	ierr = NF_CLOSE(ncid)
	234	c
	235	c
	236	C Traitement de la rugosite
	237	c
	238	PRINT*, 'Traitement de la rugosite'
	239	ierr = NF_OPEN('Rugos.nc', NF_NOWRITE, ncid)
	240	if (ierr.ne.0) then
	241	print *, NF_STRERROR(ierr)
	242	STOP
	243	ENDIF
	244
	245	ierr = NF_INQ_VARID(ncid,'RUGOS',varid)
	246	if (ierr.ne.0) then
	247	print *, NF_STRERROR(ierr)
	248	STOP
	249	ENDIF
	250	ierr = NF_INQ_VARDIMID (ncid,varid,ndimid)
	251	if (ierr.ne.0) then
	252	print *, NF_STRERROR(ierr)
	253	STOP
	254	ENDIF
	255	ierr = NF_INQ_DIM(ncid,ndimid(1), namedim, imdep)
	256	if (ierr.ne.0) then
	257	print *, NF_STRERROR(ierr)
	258	STOP
	259	ENDIF
	260	print*,'variable ', namedim, 'dimension ', imdep
	261	ierr = NF_INQ_VARID(ncid,namedim,dimid)
	262	if (ierr.ne.0) then
	263	print *, NF_STRERROR(ierr)
	264	STOP
	265	ENDIF
	266
	267	ALLOCATE( dlon_ini(imdep) )
	268	ALLOCATE( dlon(imdep) )
	269
	270	#ifdef NC_DOUBLE
	271	ierr = NF_GET_VAR_DOUBLE(ncid,dimid,dlon_ini)
	272	#else
	273	ierr = NF_GET_VAR_REAL(ncid,dimid,dlon_ini)
	274	#endif
	275	if (ierr.ne.0) then
	276	print *, NF_STRERROR(ierr)
	277	STOP
	278	ENDIF
	279	ierr = NF_INQ_DIM(ncid,ndimid(2), namedim, jmdep)
	280	if (ierr.ne.0) then
	281	print *, NF_STRERROR(ierr)
	282	STOP
	283	ENDIF
	284	print*,'variable ', namedim, 'dimension ', jmdep
	285	ierr = NF_INQ_VARID(ncid,namedim,dimid)
	286	if (ierr.ne.0) then
	287	print *, NF_STRERROR(ierr)
	288	STOP
	289	ENDIF
	290
	291	ALLOCATE( dlat_ini(jmdep) )
	292	ALLOCATE( dlat(jmdep) )
	293
	294	#ifdef NC_DOUBLE
	295	ierr = NF_GET_VAR_DOUBLE(ncid,dimid,dlat_ini)
	296	#else
	297	ierr = NF_GET_VAR_REAL(ncid,dimid,dlat_ini)
	298	#endif
	299	if (ierr.ne.0) then
	300	print *, NF_STRERROR(ierr)
	301	STOP
	302	ENDIF
	303	ierr = NF_INQ_DIM(ncid,ndimid(3), namedim, lmdep)
	304	if (ierr.ne.0) then
	305	print *, NF_STRERROR(ierr)
	306	STOP
	307	ENDIF
	308	print*,'variable ', namedim, 'dimension ', lmdep
	309	ierr = NF_INQ_VARID(ncid,namedim,dimid)
	310	if (ierr.ne.0) then
	311	print *, NF_STRERROR(ierr)
	312	STOP
	313	ENDIF
	314	#ifdef NC_DOUBLE
	315	ierr = NF_GET_VAR_DOUBLE(ncid,dimid,timecoord)
	316	#else
	317	ierr = NF_GET_VAR_REAL(ncid,dimid,timecoord)
	318	#endif
	319	if (ierr.ne.0) then
	320	print *, NF_STRERROR(ierr)
	321	STOP
	322	ENDIF
	323	c
	324	ALLOCATE( champ(imdep*jmdep) )
	325
	326	DO 200 l = 1, lmdep
	327	dimfirst(1) = 1
	328	dimfirst(2) = 1
	329	dimfirst(3) = l
	330	c
	331	dimlast(1) = imdep
	332	dimlast(2) = jmdep
	333	dimlast(3) = 1
	334	c
	335	PRINT*,'Lecture temporelle et int. horizontale ',l,timecoord(l)
	336	print*,dimfirst,dimlast
	337	#ifdef NC_DOUBLE
	338	ierr = NF_GET_VARA_DOUBLE(ncid,varid,dimfirst,dimlast,champ)
	339	#else
	340	ierr = NF_GET_VARA_REAL(ncid,varid,dimfirst,dimlast,champ)
	341	#endif
	342	if (ierr.ne.0) then
	343	print *, NF_STRERROR(ierr)
	344	STOP
	345	ENDIF
	346
	347	title = 'Rugosite Amip '
	348	c
	349	CALL conf_dat2d(title,imdep, jmdep, dlon_ini, dlat_ini,
	350	. dlon, dlat, champ, interbar )
	351
	352	IF ( interbar ) THEN
	353	DO j = 1, imdep * jmdep
	354	champ(j) = LOG(champ(j))
	355	ENDDO
	356
	357	IF( l.EQ.1 ) THEN
	358	WRITE(6,*) '-------------------------------------------------',
	359	,'------------------------'
	360	WRITE(6,*) '$$$ Utilisation de l interpolation barycentrique ',
	361	, ' pour la rugosite $$$ '
	362	WRITE(6,*) '-------------------------------------------------',
	363	,'------------------------'
	364	ENDIF
	365	CALL inter_barxy ( imdep,jmdep -1,dlon,dlat,champ ,
	366	, iim,jjm,rlonu,rlatv, jjp1,champint )
	367	DO j=1,jjp1
	368	DO i=1,iim
	369	champint(i,j)=EXP(champint(i,j))
	370	ENDDO
	371	ENDDO
	372
	373	DO j = 1, jjp1
	374	DO i = 1, iim
	375	IF(NINT(mask(i,j)).NE.1) THEN
	376	champint( i,j ) = 0.001
	377	ENDIF
	378	ENDDO
	379	ENDDO
	380	ELSE
	381	CALL rugosite(imdep, jmdep, dlon, dlat, champ,
	382	. iim, jjp1, rlonv, rlatu, champint, mask)
	383	ENDIF
	384	DO j = 1,jjp1
	385	DO i = 1, iim
	386	champtime (i,j,l) = champint(i,j)
	387	ENDDO
	388	ENDDO
	389	200 CONTINUE
	390	c
	391	DO l = 1, lmdep
	392	timeyear(l) = timecoord(l)
	393	ENDDO
	394
	395	PRINT 222, timeyear
	396	222 FORMAT(2x,' Time year ',10f6.1)
	397	c
	398
	399	PRINT*, 'Interpolation temporelle dans l annee'
	400
	401	DO j = 1, jjp1
	402	DO i = 1, iim
	403	DO l = 1, lmdep
	404	ax(l) = timeyear(l)
	405	ay(l) = champtime (i,j,l)
	406	ENDDO
	407	CALL SPLINE(ax,ay,lmdep,1.e30,1.e30,yder)
	408	DO k = 1, 360
	409	time = FLOAT(k-1)
	410	CALL SPLINT(ax,ay,yder,lmdep,time,by)
	411	champan(i,j,k) = by
	412	ENDDO
	413	ENDDO
	414	ENDDO
	415	DO k = 1, 360
	416	DO j = 1, jjp1
	417	champan(iip1,j,k) = champan(1,j,k)
	418	ENDDO
	419	IF ( k.EQ.10 ) THEN
	420	DO j = 1, jjp1
	421	CALL minmax( iip1,champan(1,j,10),chmin,chmax )
	422	PRINT *,' Rugosite au temps 10 ', chmin,chmax,j
	423	ENDDO
	424	ENDIF
	425	ENDDO
	426	c
	427	DO k = 1, 360
	428	CALL gr_dyn_fi(1,iip1,jjp1,klon,champan(1,1,k), phy_rug(1,k))
	429	ENDDO
	430	c
	431	ierr = NF_CLOSE(ncid)
	432
	433	DEALLOCATE( dlon )
	434	DEALLOCATE( dlon_ini )
	435	DEALLOCATE( dlat )
	436	DEALLOCATE( dlat_ini )
	437	DEALLOCATE( champ )
	438	c
	439	c
	440	C Traitement de la glace oceanique
	441	c
	442	PRINT*, 'Traitement de la glace oceanique'
	443	ierr = NF_OPEN('AMIP.nc', NF_NOWRITE, ncid)
	444	if (ierr.ne.0) then
	445	print *, NF_STRERROR(ierr)
	446	STOP
	447	ENDIF
	448
	449	ierr = NF_INQ_VARID(ncid,'SEA_ICE',varid)
	450	if (ierr.ne.0) then
	451	print *, NF_STRERROR(ierr)
	452	STOP
	453	ENDIF
	454	ierr = NF_INQ_VARDIMID (ncid,varid,ndimid)
	455	if (ierr.ne.0) then
	456	print *, NF_STRERROR(ierr)
	457	STOP
	458	ENDIF
	459	ierr = NF_INQ_DIM(ncid,ndimid(1), namedim, imdep)
	460	if (ierr.ne.0) then
	461	print *, NF_STRERROR(ierr)
	462	STOP
	463	ENDIF
	464	print*,'variable ', namedim, 'dimension ', imdep
	465	ierr = NF_INQ_VARID(ncid,namedim,dimid)
	466	if (ierr.ne.0) then
	467	print *, NF_STRERROR(ierr)
	468	STOP
	469	ENDIF
	470
	471	ALLOCATE ( dlon_ini(imdep) )
	472	ALLOCATE ( dlon(imdep) )
	473
	474	#ifdef NC_DOUBLE
	475	ierr = NF_GET_VAR_DOUBLE(ncid,dimid,dlon_ini)
	476	#else
	477	ierr = NF_GET_VAR_REAL(ncid,dimid,dlon_ini)
	478	#endif
	479	if (ierr.ne.0) then
	480	print *, NF_STRERROR(ierr)
	481	STOP
	482	ENDIF
	483	ierr = NF_INQ_DIM(ncid,ndimid(2), namedim, jmdep)
	484	if (ierr.ne.0) then
	485	print *, NF_STRERROR(ierr)
	486	STOP
	487	ENDIF
	488	print*,'variable ', namedim, jmdep
	489	ierr = NF_INQ_VARID(ncid,namedim,dimid)
	490	if (ierr.ne.0) then
	491	print *, NF_STRERROR(ierr)
	492	STOP
	493	ENDIF
	494
	495	ALLOCATE ( dlat_ini(jmdep) )
	496	ALLOCATE ( dlat(jmdep) )
	497
	498	#ifdef NC_DOUBLE
	499	ierr = NF_GET_VAR_DOUBLE(ncid,dimid,dlat_ini)
	500	#else
	501	ierr = NF_GET_VAR_REAL(ncid,dimid,dlat_ini)
	502	#endif
	503	if (ierr.ne.0) then
	504	print *, NF_STRERROR(ierr)
	505	STOP
	506	ENDIF
	507	ierr = NF_INQ_DIM(ncid,ndimid(3), namedim, lmdep)
	508	if (ierr.ne.0) then
	509	print *, NF_STRERROR(ierr)
	510	STOP
	511	ENDIF
	512	print*,'variable ', namedim, lmdep
	513	ierr = NF_INQ_VARID(ncid,namedim,dimid)
	514	if (ierr.ne.0) then
	515	print *, NF_STRERROR(ierr)
	516	STOP
	517	ENDIF
	518	#ifdef NC_DOUBLE
	519	ierr = NF_GET_VAR_DOUBLE(ncid,dimid,timecoord)
	520	#else
	521	ierr = NF_GET_VAR_REAL(ncid,dimid,timecoord)
	522	#endif
	523	if (ierr.ne.0) then
	524	print *, NF_STRERROR(ierr)
	525	STOP
	526	ENDIF
	527	c
	528	ALLOCATE ( champ(imdep*jmdep) )
	529
	530	DO l = 1, lmdep
	531	dimfirst(1) = 1
	532	dimfirst(2) = 1
	533	dimfirst(3) = l
	534	c
	535	dimlast(1) = imdep
	536	dimlast(2) = jmdep
	537	dimlast(3) = 1
	538	c
	539	PRINT*,'Lecture temporelle et int. horizontale ',l,timecoord(l)
	540	#ifdef NC_DOUBLE
	541	ierr = NF_GET_VARA_DOUBLE(ncid,varid,dimfirst,dimlast,champ)
	542	#else
	543	ierr = NF_GET_VARA_REAL(ncid,varid,dimfirst,dimlast,champ)
	544	#endif
	545	if (ierr.ne.0) then
	546	print *, NF_STRERROR(ierr)
	547	STOP
	548	ENDIF
	549
	550	title = 'Sea-ice Amip '
	551	c
	552	CALL conf_dat2d(title,imdep, jmdep, dlon_ini, dlat_ini,
	553	. dlon, dlat, champ, interbar )
	554	c
	555	IF( oldice ) THEN
	556	CALL sea_ice(imdep, jmdep, dlon, dlat, champ,
	557	. iim, jjp1, rlonv, rlatu, champint )
	558	ELSEIF ( interbar ) THEN
	559	IF( l.EQ.1 ) THEN
	560	WRITE(6,*) '-------------------------------------------------',
	561	,'------------------------'
	562	WRITE(6,*) '$$$ Utilisation de l interpolation barycentrique ',
	563	, ' pour Sea-ice Amip $$$ '
	564	WRITE(6,*) '-------------------------------------------------',
	565	,'------------------------'
	566	ENDIF
	567
	568	CALL inter_barxy ( imdep,jmdep -1,dlon, dlat ,
	569	, champ, iim, jjm, rlonu, rlatv, jjp1, champint )
	570	ELSE
	571	CALL sea_ice(imdep, jmdep, dlon, dlat, champ,
	572	. iim, jjp1, rlonv, rlatu, champint )
	573	ENDIF
	574	DO j = 1,jjp1
	575	DO i = 1, iim
	576	champtime (i,j,l) = champint(i,j)
	577	ENDDO
	578	ENDDO
	579	ENDDO
	580	c
	581	DO l = 1, lmdep
	582	timeyear(l) = timecoord(l)
	583	ENDDO
	584	PRINT 222, timeyear
	585	c
	586	PRINT*, 'Interpolation temporelle'
	587	DO j = 1, jjp1
	588	DO i = 1, iim
	589	DO l = 1, lmdep
	590	ax(l) = timeyear(l)
	591	ay(l) = champtime (i,j,l)
	592	ENDDO
	593	CALL SPLINE(ax,ay,lmdep,1.e30,1.e30,yder)
	594	DO k = 1, 360
	595	time = FLOAT(k-1)
	596	CALL SPLINT(ax,ay,yder,lmdep,time,by)
	597	champan(i,j,k) = by
	598	ENDDO
	599	ENDDO
	600	ENDDO
	601	DO k = 1, 360
	602	DO j = 1, jjp1
	603	champan(iip1, j, k) = champan(1, j, k)
	604	ENDDO
	605	IF ( k.EQ.10 ) THEN
	606	DO j = 1, jjp1
	607	CALL minmax( iip1,champan(1,j,10),chmin,chmax )
	608	PRINT *,' Sea ice au temps 10 ', chmin,chmax,j
	609	ENDDO
	610	ENDIF
	611	ENDDO
	612	c
	613
	614	DO k = 1, 360
	615	CALL gr_dyn_fi(1, iip1, jjp1, klon,
[327]	616	. champan(1,1,k), phy_ice)
[325]	617	IF ( newlmt) THEN
	618
	619	CPB en attendant de mettre fraction de terre
	620	c
	621	WHERE(phy_ice(1:klon) .GE. 1.) phy_ice(1 : klon) = 1.
	622	WHERE(phy_ice(1:klon) .LT. EPSFRA) phy_ice(1 : klon) = 0.
	623	c
	624	IF (fracterre ) THEN
	625	c WRITE(,) 'passe dans cas fracterre'
	626	pctsrf_t(:,is_ter,k) = pctsrf(:,is_ter)
	627	pctsrf_t(:,is_lic,k) = pctsrf(:,is_lic)
	628	pctsrf_t(1:klon,is_sic,k) = phy_ice(1:klon)
	629	$ - pctsrf_t(1:klon,is_lic,k)
	630	c Il y a des cas ou il y a de la glace dans landiceref et pas dans AMIP
	631	WHERE (pctsrf_t(1:klon,is_sic,k) .LE. 0)
	632	pctsrf_t(1:klon,is_sic,k) = 0.
	633	END WHERE
	634	WHERE( 1. - zmasq(1:klon) .LT. EPSFRA)
	635	pctsrf_t(1:klon,is_sic,k) = 0.
	636	pctsrf_t(1:klon,is_oce,k) = 0.
	637	END WHERE
	638	DO i = 1, klon
	639	IF ( 1. - zmasq(i) .GT. EPSFRA) THEN
	640	IF ( pctsrf_t(i,is_sic,k) .GE. 1 - zmasq(i)) THEN
	641	pctsrf_t(i,is_sic,k) = 1 - zmasq(i)
	642	pctsrf_t(i,is_oce,k) = 0.
	643	ELSE
	644	pctsrf_t(i,is_oce,k) = 1 - zmasq(i)
	645	$ - pctsrf_t(i,is_sic,k)
	646	IF (pctsrf_t(i,is_oce,k) .LT. EPSFRA) THEN
	647	pctsrf_t(i,is_oce,k) = 0.
	648	pctsrf_t(i,is_sic,k) = 1 - zmasq(i)
	649	ENDIF
	650	ENDIF
	651	ENDIF
	652	if (pctsrf_t(i,is_oce,k) .lt. 0.) then
	653	WRITE(,) 'pb sous maille au point : i,k '
	654	$ , i,k,pctsrf_t(:,is_oce,k)
	655	ENDIF
	656	IF ( abs( pctsrf_t(i, is_ter,k) + pctsrf_t(i, is_lic,k) +
	657	$ pctsrf_t(i, is_oce,k) + pctsrf_t(i, is_sic,k) - 1.)
	658	$ .GT. EPSFRA) THEN
	659	WRITE(,) 'physiq : pb sous surface au point ', i,
	660	$ pctsrf_t(i, 1 : nbsrf,k), phy_ice(i)
	661	ENDIF
	662	END DO
	663	ELSE
	664	DO i = 1, klon
	665	pctsrf_t(i,is_ter,k) = pctsrf(i,is_ter)
	666	IF (NINT(pctsrf(i,is_ter)).EQ.1 ) THEN
	667	pctsrf_t(i,is_sic,k) = 0.
	668	pctsrf_t(i,is_oce,k) = 0.
	669	IF(phy_ice(i) .GE. 1.e-5) THEN
	670	pctsrf_t(i,is_lic,k) = phy_ice(i)
	671	pctsrf_t(i,is_ter,k) = pctsrf_t(i,is_ter,k)
	672	. - pctsrf_t(i,is_lic,k)
	673	ELSE
	674	pctsrf_t(i,is_lic,k) = 0.
	675	ENDIF
	676	ELSE
	677	pctsrf_t(i,is_lic,k) = 0.
	678	IF(phy_ice(i) .GE. 1.e-5) THEN
	679	pctsrf_t(i,is_ter,k) = 0.
	680	pctsrf_t(i,is_sic,k) = phy_ice(i)
	681	pctsrf_t(i,is_oce,k) = 1. - pctsrf_t(i,is_sic,k)
	682	ELSE
	683	pctsrf_t(i,is_sic,k) = 0.
	684	pctsrf_t(i,is_oce,k) = 1.
	685	ENDIF
	686	ENDIF
	687	verif = pctsrf_t(i,is_ter,k) +
	688	. pctsrf_t(i,is_oce,k) +
	689	. pctsrf_t(i,is_sic,k) +
	690	. pctsrf_t(i,is_lic,k)
	691	IF ( verif .LT. 1. - 1.e-5 .OR.
	692	$ verif .GT. 1 + 1.e-5) THEN
	693	WRITE(,) 'pb sous maille au point : i,k,verif '
	694	$ , i,k,verif
	695	ENDIF
	696	END DO
	697	ENDIF
	698	ELSE
	699	DO i = 1, klon
	700	phy_nat(i,k) = phy_nat0(i)
	701	IF ( (phy_ice(i) - 0.5).GE.1.e-5 ) THEN
	702	IF (NINT(phy_nat0(i)).EQ.0) THEN
	703	phy_nat(i,k) = 3.0
	704	ELSE
	705	phy_nat(i,k) = 2.0
	706	ENDIF
[259]	707	ENDIF
	708	IF( NINT(phy_nat(i,k)).EQ.0 ) THEN
	709	IF ( phy_rug(i,k).NE.0.001 ) phy_rug(i,k) = 0.001
	710	ENDIF
[325]	711	END DO
	712	ENDIF
[259]	713	ENDDO
	714	c
	715
	716	ierr = NF_CLOSE(ncid)
	717	c
	718	DEALLOCATE( dlon )
	719	DEALLOCATE( dlon_ini )
	720	DEALLOCATE( dlat )
	721	DEALLOCATE( dlat_ini )
	722	DEALLOCATE( champ )
	723
	724	477 continue
	725	c
	726	C Traitement de la sst
	727	c
	728	PRINT*, 'Traitement de la sst'
	729	ierr = NF_OPEN('AMIP.nc', NF_NOWRITE, ncid)
	730	if (ierr.ne.0) then
	731	print *, NF_STRERROR(ierr)
	732	STOP
	733	ENDIF
	734
	735	ierr = NF_INQ_VARID(ncid,'SST',varid)
	736	if (ierr.ne.0) then
	737	print *, NF_STRERROR(ierr)
	738	STOP
	739	ENDIF
	740	ierr = NF_INQ_VARDIMID (ncid,varid,ndimid)
	741	if (ierr.ne.0) then
	742	print *, NF_STRERROR(ierr)
	743	STOP
	744	ENDIF
	745	ierr = NF_INQ_DIM(ncid,ndimid(1), namedim, imdep)
	746	if (ierr.ne.0) then
	747	print *, NF_STRERROR(ierr)
	748	STOP
	749	ENDIF
	750	print*,'variable SST ', namedim,'dimension ', imdep
	751	ierr = NF_INQ_VARID(ncid,namedim,dimid)
	752	if (ierr.ne.0) then
	753	print *, NF_STRERROR(ierr)
	754	STOP
	755	ENDIF
	756
	757	ALLOCATE( dlon_ini(imdep) )
	758	ALLOCATE( dlon(imdep) )
	759
	760	#ifdef NC_DOUBLE
	761	ierr = NF_GET_VAR_DOUBLE(ncid,dimid,dlon_ini)
	762	#else
	763	ierr = NF_GET_VAR_REAL(ncid,dimid,dlon_ini)
	764	#endif
	765
	766	if (ierr.ne.0) then
	767	print *, NF_STRERROR(ierr)
	768	STOP
	769	ENDIF
	770	ierr = NF_INQ_DIM(ncid,ndimid(2), namedim, jmdep)
	771	if (ierr.ne.0) then
	772	print *, NF_STRERROR(ierr)
	773	STOP
	774	ENDIF
	775	print*,'variable SST ', namedim, 'dimension ', jmdep
	776	ierr = NF_INQ_VARID(ncid,namedim,dimid)
	777	if (ierr.ne.0) then
	778	print *, NF_STRERROR(ierr)
	779	STOP
	780	ENDIF
	781
	782	ALLOCATE( dlat_ini(jmdep) )
	783	ALLOCATE( dlat(jmdep) )
	784
	785	#ifdef NC_DOUBLE
	786	ierr = NF_GET_VAR_DOUBLE(ncid,dimid,dlat_ini)
	787	#else
	788	ierr = NF_GET_VAR_REAL(ncid,dimid,dlat_ini)
	789	#endif
	790	if (ierr.ne.0) then
	791	print *, NF_STRERROR(ierr)
	792	STOP
	793	ENDIF
	794	ierr = NF_INQ_DIM(ncid,ndimid(3), namedim, lmdep)
	795	if (ierr.ne.0) then
	796	print *, NF_STRERROR(ierr)
	797	STOP
	798	ENDIF
	799	print*,'variable ', namedim, 'dimension ', lmdep
	800	ierr = NF_INQ_VARID(ncid,namedim,dimid)
	801	if (ierr.ne.0) then
	802	print *, NF_STRERROR(ierr)
	803	STOP
	804	ENDIF
	805	#ifdef NC_DOUBLE
	806	ierr = NF_GET_VAR_DOUBLE(ncid,dimid,timecoord)
	807	#else
	808	ierr = NF_GET_VAR_REAL(ncid,dimid,timecoord)
	809	#endif
	810	if (ierr.ne.0) then
	811	print *, NF_STRERROR(ierr)
	812	STOP
	813	ENDIF
	814
	815	ALLOCATE( champ(imdep*jmdep) )
	816	IF( extrap ) THEN
	817	ALLOCATE ( work(imdep,jmdep) )
	818	ENDIF
	819	c
	820	DO l = 1, lmdep
	821	dimfirst(1) = 1
	822	dimfirst(2) = 1
	823	dimfirst(3) = l
	824	c
	825	dimlast(1) = imdep
	826	dimlast(2) = jmdep
	827	dimlast(3) = 1
	828	c
	829	PRINT*,'Lecture temporelle et int. horizontale ',l,timecoord(l)
	830	#ifdef NC_DOUBLE
	831	ierr = NF_GET_VARA_DOUBLE(ncid,varid,dimfirst,dimlast,champ)
	832	#else
	833	ierr = NF_GET_VARA_REAL(ncid,varid,dimfirst,dimlast,champ)
	834	#endif
	835	if (ierr.ne.0) then
	836	print *, NF_STRERROR(ierr)
	837	STOP
	838	ENDIF
	839
	840	title='Sst Amip'
	841	c
	842	CALL conf_dat2d(title,imdep, jmdep, dlon_ini, dlat_ini,
	843	. dlon, dlat, champ, interbar )
	844	IF ( extrap ) THEN
	845	CALL extrapol(champ, imdep, jmdep, 999999.,.TRUE.,.TRUE.,2,work)
	846	ENDIF
	847	c
	848
	849	IF ( interbar ) THEN
	850	IF( l.EQ.1 ) THEN
	851	WRITE(6,*) '-------------------------------------------------',
	852	,'------------------------'
	853	WRITE(6,*) '$$$ Utilisation de l interpolation barycentrique ',
	854	, ' pour la Sst Amip $$$ '
	855	WRITE(6,*) '-------------------------------------------------',
	856	,'------------------------'
	857	ENDIF
	858	CALL inter_barxy ( imdep,jmdep -1,dlon, dlat ,
	859	, champ, iim, jjm, rlonu, rlatv, jjp1, champint )
	860	ELSE
	861	CALL grille_m(imdep, jmdep, dlon, dlat, champ,
	862	. iim, jjp1, rlonv, rlatu, champint )
	863	ENDIF
	864
	865	DO j = 1,jjp1
	866	DO i = 1, iim
	867	champtime (i,j,l) = champint(i,j)
	868	ENDDO
	869	ENDDO
	870	ENDDO
	871	c
	872	DO l = 1, lmdep
	873	timeyear(l) = timecoord(l)
	874	ENDDO
	875	print 222, timeyear
	876	c
	877	C interpolation temporelle
	878	DO j = 1, jjp1
	879	DO i = 1, iim
	880	DO l = 1, lmdep
	881	ax(l) = timeyear(l)
	882	ay(l) = champtime (i,j,l)
	883	ENDDO
	884	CALL SPLINE(ax,ay,lmdep,1.e30,1.e30,yder)
	885	DO k = 1, 360
	886	time = FLOAT(k-1)
	887	CALL SPLINT(ax,ay,yder,lmdep,time,by)
	888	champan(i,j,k) = by
	889	ENDDO
	890	ENDDO
	891	ENDDO
	892	DO k = 1, 360
	893	DO j = 1, jjp1
	894	champan(iip1,j,k) = champan(1,j,k)
	895	ENDDO
	896	IF ( k.EQ.10 ) THEN
	897	DO j = 1, jjp1
	898	CALL minmax( iip1,champan(1,j,10),chmin,chmax )
	899	PRINT *,' SST au temps 10 ', chmin,chmax,j
	900	ENDDO
	901	ENDIF
	902	ENDDO
	903	c
	904	DO k = 1, 360
	905	CALL gr_dyn_fi(1, iip1, jjp1, klon,
	906	. champan(1,1,k), phy_sst(1,k))
	907	ENDDO
	908	c
	909	ierr = NF_CLOSE(ncid)
	910	c
	911	DEALLOCATE( dlon )
	912	DEALLOCATE( dlon_ini )
	913	DEALLOCATE( dlat )
	914	DEALLOCATE( dlat_ini )
	915	DEALLOCATE( champ )
	916	c
	917	C Traitement de l'albedo
	918	c
	919	PRINT*, 'Traitement de l albedo'
	920	ierr = NF_OPEN('Albedo.nc', NF_NOWRITE, ncid)
	921	if (ierr.ne.0) then
	922	print *, NF_STRERROR(ierr)
	923	STOP
	924	ENDIF
	925	ierr = NF_INQ_VARID(ncid,'ALBEDO',varid)
	926	if (ierr.ne.0) then
	927	print *, NF_STRERROR(ierr)
	928	STOP
	929	ENDIF
	930	ierr = NF_INQ_VARDIMID (ncid,varid,ndimid)
	931	if (ierr.ne.0) then
	932	print *, NF_STRERROR(ierr)
	933	STOP
	934	ENDIF
	935	ierr = NF_INQ_DIM(ncid,ndimid(1), namedim, imdep)
	936	if (ierr.ne.0) then
	937	print *, NF_STRERROR(ierr)
	938	STOP
	939	ENDIF
	940	print*,'variable ', namedim, 'dimension ', imdep
	941	ierr = NF_INQ_VARID(ncid,namedim,dimid)
	942	if (ierr.ne.0) then
	943	print *, NF_STRERROR(ierr)
	944	STOP
	945	ENDIF
	946
	947	ALLOCATE ( dlon_ini(imdep) )
	948	ALLOCATE ( dlon(imdep) )
	949
	950	#ifdef NC_DOUBLE
	951	ierr = NF_GET_VAR_DOUBLE(ncid,dimid,dlon_ini)
	952	#else
	953	ierr = NF_GET_VAR_REAL(ncid,dimid,dlon_ini)
	954	#endif
	955	if (ierr.ne.0) then
	956	print *, NF_STRERROR(ierr)
	957	STOP
	958	ENDIF
	959	ierr = NF_INQ_DIM(ncid,ndimid(2), namedim, jmdep)
	960	if (ierr.ne.0) then
	961	print *, NF_STRERROR(ierr)
	962	STOP
	963	ENDIF
	964	print*,'variable ', namedim, 'dimension ', jmdep
	965	ierr = NF_INQ_VARID(ncid,namedim,dimid)
	966	if (ierr.ne.0) then
	967	print *, NF_STRERROR(ierr)
	968	STOP
	969	ENDIF
	970
	971	ALLOCATE ( dlat_ini(jmdep) )
	972	ALLOCATE ( dlat(jmdep) )
	973
	974	#ifdef NC_DOUBLE
	975	ierr = NF_GET_VAR_DOUBLE(ncid,dimid,dlat_ini)
	976	#else
	977	ierr = NF_GET_VAR_REAL(ncid,dimid,dlat_ini)
	978	#endif
	979	if (ierr.ne.0) then
	980	print *, NF_STRERROR(ierr)
	981	STOP
	982	ENDIF
	983	ierr = NF_INQ_DIM(ncid,ndimid(3), namedim, lmdep)
	984	if (ierr.ne.0) then
	985	print *, NF_STRERROR(ierr)
	986	STOP
	987	ENDIF
	988	print*,'variable ', namedim, 'dimension ', lmdep
	989	ierr = NF_INQ_VARID(ncid,namedim,dimid)
	990	if (ierr.ne.0) then
	991	print *, NF_STRERROR(ierr)
	992	STOP
	993	ENDIF
	994	#ifdef NC_DOUBLE
	995	ierr = NF_GET_VAR_DOUBLE(ncid,dimid,timecoord)
	996	#else
	997	ierr = NF_GET_VAR_REAL(ncid,dimid,timecoord)
	998	#endif
	999	if (ierr.ne.0) then
	1000	print *, NF_STRERROR(ierr)
	1001	STOP
	1002	ENDIF
	1003	c
	1004	ALLOCATE ( champ(imdep*jmdep) )
	1005
	1006	DO l = 1, lmdep
	1007	dimfirst(1) = 1
	1008	dimfirst(2) = 1
	1009	dimfirst(3) = l
	1010	c
	1011	dimlast(1) = imdep
	1012	dimlast(2) = jmdep
	1013	dimlast(3) = 1
	1014	c
	1015	PRINT*,'Lecture temporelle et int. horizontale ',l,timecoord(l)
	1016	#ifdef NC_DOUBLE
	1017	ierr = NF_GET_VARA_DOUBLE(ncid,varid,dimfirst,dimlast,champ)
	1018	#else
	1019	ierr = NF_GET_VARA_REAL(ncid,varid,dimfirst,dimlast,champ)
	1020	#endif
	1021	if (ierr.ne.0) then
	1022	print *, NF_STRERROR(ierr)
	1023	STOP
	1024	ENDIF
	1025
	1026	title='Albedo Amip'
	1027	c
	1028	CALL conf_dat2d(title,imdep, jmdep, dlon_ini, dlat_ini,
	1029	. dlon, dlat, champ, interbar )
	1030	c
	1031	c
	1032	IF ( interbar ) THEN
	1033	IF( l.EQ.1 ) THEN
	1034	WRITE(6,*) '-------------------------------------------------',
	1035	,'------------------------'
	1036	WRITE(6,*) '$$$ Utilisation de l interpolation barycentrique ',
	1037	, ' pour l Albedo Amip $$$ '
	1038	WRITE(6,*) '-------------------------------------------------',
	1039	,'------------------------'
	1040	ENDIF
	1041
	1042	CALL inter_barxy ( imdep,jmdep -1,dlon, dlat ,
	1043	, champ, iim, jjm, rlonu, rlatv, jjp1, champint )
	1044	ELSE
	1045	CALL grille_m(imdep, jmdep, dlon, dlat, champ,
	1046	. iim, jjp1, rlonv, rlatu, champint )
	1047	ENDIF
	1048	c
	1049	DO j = 1,jjp1
	1050	DO i = 1, iim
	1051	champtime (i, j, l) = champint(i, j)
	1052	ENDDO
	1053	ENDDO
	1054	ENDDO
	1055	c
	1056	DO l = 1, lmdep
	1057	timeyear(l) = timecoord(l)
	1058	ENDDO
	1059	print 222, timeyear
	1060	c
	1061	C interpolation temporelle
	1062	DO j = 1, jjp1
	1063	DO i = 1, iim
	1064	DO l = 1, lmdep
	1065	ax(l) = timeyear(l)
	1066	ay(l) = champtime (i, j, l)
	1067	ENDDO
	1068	CALL SPLINE(ax,ay,lmdep,1.e30,1.e30,yder)
	1069	DO k = 1, 360
	1070	time = FLOAT(k-1)
	1071	CALL SPLINT(ax,ay,yder,lmdep,time,by)
	1072	champan(i,j,k) = by
	1073	ENDDO
	1074	ENDDO
	1075	ENDDO
	1076	DO k = 1, 360
	1077	DO j = 1, jjp1
	1078	champan(iip1, j, k) = champan(1, j, k)
	1079	ENDDO
	1080	IF ( k.EQ.10 ) THEN
	1081	DO j = 1, jjp1
	1082	CALL minmax( iip1,champan(1,j,10),chmin,chmax )
	1083	PRINT *,' Albedo au temps 10 ', chmin,chmax,j
	1084	ENDDO
	1085	ENDIF
	1086	ENDDO
	1087	c
	1088	DO k = 1, 360
	1089	CALL gr_dyn_fi(1, iip1, jjp1, klon,
	1090	. champan(1,1,k), phy_alb(1,k))
	1091	ENDDO
	1092	c
	1093	ierr = NF_CLOSE(ncid)
	1094	c
	1095	c
	1096	DO k = 1, 360
	1097	DO i = 1, klon
	1098	phy_bil(i,k) = 0.0
	1099	ENDDO
	1100	ENDDO
	1101	c
	1102	PRINT*, 'Ecriture du fichier limit'
	1103	c
	1104	ierr = NF_CREATE ("limit.nc", NF_CLOBBER, nid)
	1105	c
	1106	ierr = NF_PUT_ATT_TEXT (nid, NF_GLOBAL, "title", 30,
	1107	. "Fichier conditions aux limites")
	1108	ierr = NF_DEF_DIM (nid, "points_physiques", klon, ndim)
	1109	ierr = NF_DEF_DIM (nid, "time", NF_UNLIMITED, ntim)
	1110	c
	1111	dims(1) = ndim
	1112	dims(2) = ntim
	1113	c
	1114	ierr = NF_DEF_VAR (nid, "TEMPS", NF_FLOAT, 1,ntim, id_tim)
	1115	ierr = NF_PUT_ATT_TEXT (nid, id_tim, "title", 17,
	1116	. "Jour dans l annee")
[325]	1117	IF (newlmt) THEN
	1118	c
	1119	ierr = NF_DEF_VAR (nid, "FOCE", NF_FLOAT, 2,dims, id_FOCE)
	1120	ierr = NF_PUT_ATT_TEXT (nid, id_FOCE, "title", 14,
	1121	. "Fraction ocean")
	1122	c
	1123	ierr = NF_DEF_VAR (nid, "FSIC", NF_FLOAT, 2,dims, id_FSIC)
	1124	ierr = NF_PUT_ATT_TEXT (nid, id_FSIC, "title", 21,
	1125	. "Fraction glace de mer")
	1126	c
	1127	ierr = NF_DEF_VAR (nid, "FTER", NF_FLOAT, 2,dims, id_FTER)
	1128	ierr = NF_PUT_ATT_TEXT (nid, id_FTER, "title", 14,
	1129	. "Fraction terre")
	1130	c
	1131	ierr = NF_DEF_VAR (nid, "FLIC", NF_FLOAT, 2,dims, id_FLIC)
	1132	ierr = NF_PUT_ATT_TEXT (nid, id_FLIC, "title", 17,
	1133	. "Fraction land ice")
	1134	c
	1135	ELSE
	1136	ierr = NF_DEF_VAR (nid, "NAT", NF_FLOAT, 2,dims, id_NAT)
	1137	ierr = NF_PUT_ATT_TEXT (nid, id_NAT, "title", 23,
	1138	. "Nature du sol (0,1,2,3)")
	1139	ENDIF
[259]	1140	ierr = NF_DEF_VAR (nid, "SST", NF_FLOAT, 2,dims, id_SST)
	1141	ierr = NF_PUT_ATT_TEXT (nid, id_SST, "title", 35,
[325]	1142	. "Temperature superficielle de la mer")
[259]	1143	ierr = NF_DEF_VAR (nid, "BILS", NF_FLOAT, 2,dims, id_BILS)
	1144	ierr = NF_PUT_ATT_TEXT (nid, id_BILS, "title", 32,
	1145	. "Reference flux de chaleur au sol")
	1146	ierr = NF_DEF_VAR (nid, "ALB", NF_FLOAT, 2,dims, id_ALB)
	1147	ierr = NF_PUT_ATT_TEXT (nid, id_ALB, "title", 19,
	1148	. "Albedo a la surface")
	1149	ierr = NF_DEF_VAR (nid, "RUG", NF_FLOAT, 2,dims, id_RUG)
	1150	ierr = NF_PUT_ATT_TEXT (nid, id_RUG, "title", 8,
	1151	. "Rugosite")
	1152	c
	1153	ierr = NF_ENDDEF(nid)
	1154	c
	1155	DO k = 1, 360
	1156	c
	1157	debut(1) = 1
	1158	debut(2) = k
	1159	epais(1) = klon
	1160	epais(2) = 1
	1161	c
	1162	#ifdef NC_DOUBLE
	1163	ierr = NF_PUT_VAR1_DOUBLE (nid,id_tim,k,DBLE(k))
[325]	1164	c
	1165	IF (newlmt ) THEN
	1166	ierr = NF_PUT_VARA_DOUBLE (nid,id_FOCE,debut,epais
	1167	$ ,pctsrf_t(1,is_oce,k))
	1168	ierr = NF_PUT_VARA_DOUBLE (nid,id_FSIC,debut,epais
	1169	$ ,pctsrf_t(1,is_sic,k))
	1170	ierr = NF_PUT_VARA_DOUBLE (nid,id_FTER,debut,epais
	1171	$ ,pctsrf_t(1,is_ter,k))
	1172	ierr = NF_PUT_VARA_DOUBLE (nid,id_FLIC,debut,epais
	1173	$ ,pctsrf_t(1,is_lic,k))
	1174	ELSE
	1175	ierr = NF_PUT_VARA_DOUBLE (nid,id_NAT,debut,epais
	1176	$ ,phy_nat(1,k))
	1177	ENDIF
	1178	c
[259]	1179	ierr = NF_PUT_VARA_DOUBLE (nid,id_SST,debut,epais,phy_sst(1,k))
	1180	ierr = NF_PUT_VARA_DOUBLE (nid,id_BILS,debut,epais,phy_bil(1,k))
	1181	ierr = NF_PUT_VARA_DOUBLE (nid,id_ALB,debut,epais,phy_alb(1,k))
	1182	ierr = NF_PUT_VARA_DOUBLE (nid,id_RUG,debut,epais,phy_rug(1,k))
	1183	#else
	1184	ierr = NF_PUT_VAR1_REAL (nid,id_tim,k,FLOAT(k))
[325]	1185	IF (newlmt ) THEN
	1186	ierr = NF_PUT_VARA_REAL (nid,id_FOCE,debut,epais
	1187	$ ,pctsrf_t(1,is_oce,k))
	1188	ierr = NF_PUT_VARA_REAL (nid,id_FSIC,debut,epais
	1189	$ ,pctsrf_t(1,is_sic,k))
	1190	ierr = NF_PUT_VARA_REAL (nid,id_FTER,debut,epais
	1191	$ ,pctsrf_t(1,is_ter,k))
	1192	ierr = NF_PUT_VARA_REAL (nid,id_FLIC,debut,epais
	1193	$ ,pctsrf_t(1,is_lic,k))
	1194	ELSE
	1195	ierr = NF_PUT_VARA_REAL (nid,id_NAT,debut,epais
	1196	$ ,phy_nat(1,k))
	1197	ENDIF
[259]	1198	ierr = NF_PUT_VARA_REAL (nid,id_SST,debut,epais,phy_sst(1,k))
	1199	ierr = NF_PUT_VARA_REAL (nid,id_BILS,debut,epais,phy_bil(1,k))
	1200	ierr = NF_PUT_VARA_REAL (nid,id_ALB,debut,epais,phy_alb(1,k))
	1201	ierr = NF_PUT_VARA_REAL (nid,id_RUG,debut,epais,phy_rug(1,k))
	1202	#endif
	1203	c
	1204	ENDDO
	1205	c
	1206	ierr = NF_CLOSE(nid)
	1207	c
	1208	STOP
	1209	END

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

Download in other formats:

Original Format