Context Navigation

limit_netcdf.F @ 487

Last change on this file since 487 was 430, checked in by lmdzadmin, 22 years ago
Changement du nom des fichiers de donnees brutes sst/ice (plus de distinction climato/annuel) LF
Property svn:eol-style set to `native` Property svn:executable set to ``* Property svn:keywords set to `Author Date Id Revision`
File size: 36.6 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
[405]	126	cIM28/02/2002 <== PM
	127	REAL tmidmonth(12)
	128	SAVE tmidmonth
	129	DATA tmidmonth/15,45,75,105,135,165,195,225,255,285,315,345/
	130
[325]	131	c initialisations:
	132	CALL conf_gcm( 99, .TRUE. , clesphy0 )
	133
	134
[259]	135	pi = 4. * ATAN(1.)
	136	rad = 6 371 229.
	137	omeg = 4.* ASIN(1.)/(24.*3600.)
	138	g = 9.8
	139	daysec = 86400.
	140	kappa = 0.2857143
	141	cpp = 1004.70885
	142	dtvr = daysec/FLOAT(day_step)
[325]	143	CALL inigeom
[259]	144	c
	145	C Traitement du relief au sol
	146	c
	147	write(,) 'Traitement du relief au sol pour fabriquer masque'
	148	ierr = NF_OPEN('Relief.nc', NF_NOWRITE, ncid)
	149
	150	if (ierr.ne.0) then
	151	print *, NF_STRERROR(ierr)
	152	STOP
	153	ENDIF
	154
	155	ierr = NF_INQ_VARID(ncid,'RELIEF',varid)
	156	if (ierr.ne.0) then
	157	print *, NF_STRERROR(ierr)
	158	STOP
	159	ENDIF
	160	ierr = NF_INQ_VARDIMID (ncid,varid,ndimid)
	161	if (ierr.ne.0) then
	162	print *, NF_STRERROR(ierr)
	163	STOP
	164	ENDIF
	165	ierr = NF_INQ_DIM(ncid,ndimid(1), namedim, imdep)
	166	if (ierr.ne.0) then
	167	print *, NF_STRERROR(ierr)
	168	STOP
	169	ENDIF
	170	print*,'variable ', namedim, 'dimension ', imdep
	171	ierr = NF_INQ_VARID(ncid,namedim,dimid)
	172	if (ierr.ne.0) then
	173	print *, NF_STRERROR(ierr)
	174	STOP
	175	ENDIF
	176
	177	ALLOCATE( lonmsk_ini(imdep) )
	178	ALLOCATE( dlon_msk(imdep) )
	179
	180	#ifdef NC_DOUBLE
	181	ierr = NF_GET_VAR_DOUBLE(ncid,dimid,lonmsk_ini)
	182	#else
	183	ierr = NF_GET_VAR_REAL(ncid,dimid,lonmsk_ini)
	184	#endif
	185
	186	c
	187	if (ierr.ne.0) then
	188	print *, NF_STRERROR(ierr)
	189	STOP
	190	ENDIF
	191	ierr = NF_INQ_DIM(ncid,ndimid(2), namedim, jmdep)
	192	if (ierr.ne.0) then
	193	print *, NF_STRERROR(ierr)
	194	STOP
	195	ENDIF
	196	print*,'variable ', namedim, 'dimension ', jmdep
	197	ierr = NF_INQ_VARID(ncid,namedim,dimid)
	198	if (ierr.ne.0) then
	199	print *, NF_STRERROR(ierr)
	200	STOP
	201	ENDIF
	202
	203	ALLOCATE( latmsk_ini(jmdep) )
	204	ALLOCATE( dlat_msk(jmdep) )
	205	ALLOCATE( champ_msk(imdep*jmdep) )
	206
	207	#ifdef NC_DOUBLE
	208	ierr = NF_GET_VAR_DOUBLE(ncid,dimid,latmsk_ini)
	209	#else
	210	ierr = NF_GET_VAR_REAL(ncid,dimid,latmsk_ini)
	211	#endif
	212	c
	213	if (ierr.ne.0) then
	214	print *, NF_STRERROR(ierr)
	215	STOP
	216	ENDIF
	217	#ifdef NC_DOUBLE
	218	ierr = NF_GET_VAR_DOUBLE(ncid,varid,champ_msk)
	219	#else
	220	ierr = NF_GET_VAR_REAL(ncid,varid,champ_msk)
	221	#endif
	222	c
	223	if (ierr.ne.0) then
	224	print *, NF_STRERROR(ierr)
	225	STOP
	226	ENDIF
	227	c
	228	title='RELIEF'
	229
	230	CALL conf_dat2d(title,imdep, jmdep, lonmsk_ini, latmsk_ini,
	231	. dlon_msk, dlat_msk, champ_msk, interbar )
	232
	233	DO i = 1, iim
	234	DO j = 1, jjp1
[353]	235	mask(i,j) = masque(i,j)
[259]	236	ENDDO
	237	ENDDO
[359]	238	WRITE(,) 'MASK:'
	239	WRITE(*,'(96i1)')INT(mask)
[259]	240	ierr = NF_CLOSE(ncid)
	241	c
	242	c
	243	C Traitement de la rugosite
	244	c
	245	PRINT*, 'Traitement de la rugosite'
	246	ierr = NF_OPEN('Rugos.nc', NF_NOWRITE, ncid)
	247	if (ierr.ne.0) then
	248	print *, NF_STRERROR(ierr)
	249	STOP
	250	ENDIF
	251
	252	ierr = NF_INQ_VARID(ncid,'RUGOS',varid)
	253	if (ierr.ne.0) then
	254	print *, NF_STRERROR(ierr)
	255	STOP
	256	ENDIF
	257	ierr = NF_INQ_VARDIMID (ncid,varid,ndimid)
	258	if (ierr.ne.0) then
	259	print *, NF_STRERROR(ierr)
	260	STOP
	261	ENDIF
	262	ierr = NF_INQ_DIM(ncid,ndimid(1), namedim, imdep)
	263	if (ierr.ne.0) then
	264	print *, NF_STRERROR(ierr)
	265	STOP
	266	ENDIF
	267	print*,'variable ', namedim, 'dimension ', imdep
	268	ierr = NF_INQ_VARID(ncid,namedim,dimid)
	269	if (ierr.ne.0) then
	270	print *, NF_STRERROR(ierr)
	271	STOP
	272	ENDIF
	273
	274	ALLOCATE( dlon_ini(imdep) )
	275	ALLOCATE( dlon(imdep) )
	276
	277	#ifdef NC_DOUBLE
	278	ierr = NF_GET_VAR_DOUBLE(ncid,dimid,dlon_ini)
	279	#else
	280	ierr = NF_GET_VAR_REAL(ncid,dimid,dlon_ini)
	281	#endif
	282	if (ierr.ne.0) then
	283	print *, NF_STRERROR(ierr)
	284	STOP
	285	ENDIF
	286	ierr = NF_INQ_DIM(ncid,ndimid(2), namedim, jmdep)
	287	if (ierr.ne.0) then
	288	print *, NF_STRERROR(ierr)
	289	STOP
	290	ENDIF
	291	print*,'variable ', namedim, 'dimension ', jmdep
	292	ierr = NF_INQ_VARID(ncid,namedim,dimid)
	293	if (ierr.ne.0) then
	294	print *, NF_STRERROR(ierr)
	295	STOP
	296	ENDIF
	297
	298	ALLOCATE( dlat_ini(jmdep) )
	299	ALLOCATE( dlat(jmdep) )
	300
	301	#ifdef NC_DOUBLE
	302	ierr = NF_GET_VAR_DOUBLE(ncid,dimid,dlat_ini)
	303	#else
	304	ierr = NF_GET_VAR_REAL(ncid,dimid,dlat_ini)
	305	#endif
	306	if (ierr.ne.0) then
	307	print *, NF_STRERROR(ierr)
	308	STOP
	309	ENDIF
	310	ierr = NF_INQ_DIM(ncid,ndimid(3), namedim, lmdep)
	311	if (ierr.ne.0) then
	312	print *, NF_STRERROR(ierr)
	313	STOP
	314	ENDIF
	315	print*,'variable ', namedim, 'dimension ', lmdep
	316	ierr = NF_INQ_VARID(ncid,namedim,dimid)
	317	if (ierr.ne.0) then
	318	print *, NF_STRERROR(ierr)
	319	STOP
	320	ENDIF
	321	#ifdef NC_DOUBLE
	322	ierr = NF_GET_VAR_DOUBLE(ncid,dimid,timecoord)
	323	#else
	324	ierr = NF_GET_VAR_REAL(ncid,dimid,timecoord)
	325	#endif
	326	if (ierr.ne.0) then
	327	print *, NF_STRERROR(ierr)
	328	STOP
	329	ENDIF
	330	c
	331	ALLOCATE( champ(imdep*jmdep) )
	332
	333	DO 200 l = 1, lmdep
	334	dimfirst(1) = 1
	335	dimfirst(2) = 1
	336	dimfirst(3) = l
	337	c
	338	dimlast(1) = imdep
	339	dimlast(2) = jmdep
	340	dimlast(3) = 1
	341	c
	342	PRINT*,'Lecture temporelle et int. horizontale ',l,timecoord(l)
	343	print*,dimfirst,dimlast
	344	#ifdef NC_DOUBLE
	345	ierr = NF_GET_VARA_DOUBLE(ncid,varid,dimfirst,dimlast,champ)
	346	#else
	347	ierr = NF_GET_VARA_REAL(ncid,varid,dimfirst,dimlast,champ)
	348	#endif
	349	if (ierr.ne.0) then
	350	print *, NF_STRERROR(ierr)
	351	STOP
	352	ENDIF
	353
	354	title = 'Rugosite Amip '
	355	c
	356	CALL conf_dat2d(title,imdep, jmdep, dlon_ini, dlat_ini,
	357	. dlon, dlat, champ, interbar )
	358
	359	IF ( interbar ) THEN
	360	DO j = 1, imdep * jmdep
	361	champ(j) = LOG(champ(j))
	362	ENDDO
	363
	364	IF( l.EQ.1 ) THEN
	365	WRITE(6,*) '-------------------------------------------------',
	366	,'------------------------'
	367	WRITE(6,*) '$$$ Utilisation de l interpolation barycentrique ',
	368	, ' pour la rugosite $$$ '
	369	WRITE(6,*) '-------------------------------------------------',
	370	,'------------------------'
	371	ENDIF
	372	CALL inter_barxy ( imdep,jmdep -1,dlon,dlat,champ ,
	373	, iim,jjm,rlonu,rlatv, jjp1,champint )
	374	DO j=1,jjp1
	375	DO i=1,iim
	376	champint(i,j)=EXP(champint(i,j))
	377	ENDDO
	378	ENDDO
	379
	380	DO j = 1, jjp1
	381	DO i = 1, iim
	382	IF(NINT(mask(i,j)).NE.1) THEN
	383	champint( i,j ) = 0.001
	384	ENDIF
	385	ENDDO
	386	ENDDO
	387	ELSE
	388	CALL rugosite(imdep, jmdep, dlon, dlat, champ,
	389	. iim, jjp1, rlonv, rlatu, champint, mask)
	390	ENDIF
	391	DO j = 1,jjp1
	392	DO i = 1, iim
	393	champtime (i,j,l) = champint(i,j)
	394	ENDDO
	395	ENDDO
	396	200 CONTINUE
	397	c
	398	DO l = 1, lmdep
	399	timeyear(l) = timecoord(l)
	400	ENDDO
	401
	402	PRINT 222, timeyear
	403	222 FORMAT(2x,' Time year ',10f6.1)
	404	c
	405
	406	PRINT*, 'Interpolation temporelle dans l annee'
	407
	408	DO j = 1, jjp1
	409	DO i = 1, iim
	410	DO l = 1, lmdep
	411	ax(l) = timeyear(l)
	412	ay(l) = champtime (i,j,l)
	413	ENDDO
	414	CALL SPLINE(ax,ay,lmdep,1.e30,1.e30,yder)
	415	DO k = 1, 360
	416	time = FLOAT(k-1)
	417	CALL SPLINT(ax,ay,yder,lmdep,time,by)
	418	champan(i,j,k) = by
	419	ENDDO
	420	ENDDO
	421	ENDDO
	422	DO k = 1, 360
	423	DO j = 1, jjp1
	424	champan(iip1,j,k) = champan(1,j,k)
	425	ENDDO
	426	IF ( k.EQ.10 ) THEN
	427	DO j = 1, jjp1
	428	CALL minmax( iip1,champan(1,j,10),chmin,chmax )
	429	PRINT *,' Rugosite au temps 10 ', chmin,chmax,j
	430	ENDDO
	431	ENDIF
	432	ENDDO
	433	c
	434	DO k = 1, 360
	435	CALL gr_dyn_fi(1,iip1,jjp1,klon,champan(1,1,k), phy_rug(1,k))
	436	ENDDO
	437	c
	438	ierr = NF_CLOSE(ncid)
	439
	440	DEALLOCATE( dlon )
	441	DEALLOCATE( dlon_ini )
	442	DEALLOCATE( dlat )
	443	DEALLOCATE( dlat_ini )
	444	DEALLOCATE( champ )
	445	c
	446	c
	447	C Traitement de la glace oceanique
	448	c
	449	PRINT*, 'Traitement de la glace oceanique'
[405]	450	c
	451
	452	cIM22/02/2002
	453	cIM ierr = NF_OPEN('AMIP.nc', NF_NOWRITE, ncid)
	454	cIM ierr = NF_OPEN('amip79to95.nc', NF_NOWRITE, ncid)
[430]	455	cIM ierr = NF_OPEN('amipbc_sic_1x1_clim.nc', NF_NOWRITE, ncid)
	456
[405]	457	ierr = NF_OPEN('amipbc_sic_1x1.nc', NF_NOWRITE, ncid)
	458
	459	cIM22/02/2002
[259]	460	if (ierr.ne.0) then
	461	print *, NF_STRERROR(ierr)
	462	STOP
	463	ENDIF
	464
[405]	465	cIM22/02/2002
	466	cIM07/03/2002 AMIP.nc & amip79to95.nc
	467	cIM ierr = NF_INQ_VARID(ncid,'SEA_ICE',varid)
	468	cIM07/03/2002 amipbc_sic_1x1_clim.nc & amipbc_sic_1x1.nc
	469	ierr = NF_INQ_VARID(ncid,'sicbcs',varid)
	470	cIM22/02/2002
[259]	471	if (ierr.ne.0) then
	472	print *, NF_STRERROR(ierr)
	473	STOP
	474	ENDIF
	475	ierr = NF_INQ_VARDIMID (ncid,varid,ndimid)
	476	if (ierr.ne.0) then
	477	print *, NF_STRERROR(ierr)
	478	STOP
	479	ENDIF
	480	ierr = NF_INQ_DIM(ncid,ndimid(1), namedim, imdep)
	481	if (ierr.ne.0) then
	482	print *, NF_STRERROR(ierr)
	483	STOP
	484	ENDIF
	485	print*,'variable ', namedim, 'dimension ', imdep
	486	ierr = NF_INQ_VARID(ncid,namedim,dimid)
	487	if (ierr.ne.0) then
	488	print *, NF_STRERROR(ierr)
	489	STOP
	490	ENDIF
	491
	492	ALLOCATE ( dlon_ini(imdep) )
	493	ALLOCATE ( dlon(imdep) )
	494
	495	#ifdef NC_DOUBLE
	496	ierr = NF_GET_VAR_DOUBLE(ncid,dimid,dlon_ini)
	497	#else
	498	ierr = NF_GET_VAR_REAL(ncid,dimid,dlon_ini)
	499	#endif
	500	if (ierr.ne.0) then
	501	print *, NF_STRERROR(ierr)
	502	STOP
	503	ENDIF
	504	ierr = NF_INQ_DIM(ncid,ndimid(2), namedim, jmdep)
	505	if (ierr.ne.0) then
	506	print *, NF_STRERROR(ierr)
	507	STOP
	508	ENDIF
	509	print*,'variable ', namedim, jmdep
	510	ierr = NF_INQ_VARID(ncid,namedim,dimid)
	511	if (ierr.ne.0) then
	512	print *, NF_STRERROR(ierr)
	513	STOP
	514	ENDIF
	515
	516	ALLOCATE ( dlat_ini(jmdep) )
	517	ALLOCATE ( dlat(jmdep) )
	518
	519	#ifdef NC_DOUBLE
	520	ierr = NF_GET_VAR_DOUBLE(ncid,dimid,dlat_ini)
	521	#else
	522	ierr = NF_GET_VAR_REAL(ncid,dimid,dlat_ini)
	523	#endif
	524	if (ierr.ne.0) then
	525	print *, NF_STRERROR(ierr)
	526	STOP
	527	ENDIF
	528	ierr = NF_INQ_DIM(ncid,ndimid(3), namedim, lmdep)
	529	if (ierr.ne.0) then
	530	print *, NF_STRERROR(ierr)
	531	STOP
	532	ENDIF
	533	print*,'variable ', namedim, lmdep
[405]	534	cIM28/02/2002
	535	cPM28/02/2002 : nouvelle coord temporelle fichiers AMIP pas en jours
	536	c Ici on suppose qu'on a 12 mois (de 30 jours).
	537	IF (lmdep.NE.12) THEN
	538	print *, 'Unknown AMIP file: not 12 months ?'
	539	STOP
	540	ENDIF
	541	cIM28/02/2002
[259]	542	ierr = NF_INQ_VARID(ncid,namedim,dimid)
	543	if (ierr.ne.0) then
	544	print *, NF_STRERROR(ierr)
	545	STOP
	546	ENDIF
	547	#ifdef NC_DOUBLE
	548	ierr = NF_GET_VAR_DOUBLE(ncid,dimid,timecoord)
	549	#else
	550	ierr = NF_GET_VAR_REAL(ncid,dimid,timecoord)
	551	#endif
	552	if (ierr.ne.0) then
	553	print *, NF_STRERROR(ierr)
	554	STOP
	555	ENDIF
	556	c
	557	ALLOCATE ( champ(imdep*jmdep) )
	558
	559	DO l = 1, lmdep
	560	dimfirst(1) = 1
	561	dimfirst(2) = 1
	562	dimfirst(3) = l
	563	c
	564	dimlast(1) = imdep
	565	dimlast(2) = jmdep
	566	dimlast(3) = 1
	567	c
	568	PRINT*,'Lecture temporelle et int. horizontale ',l,timecoord(l)
	569	#ifdef NC_DOUBLE
	570	ierr = NF_GET_VARA_DOUBLE(ncid,varid,dimfirst,dimlast,champ)
	571	#else
	572	ierr = NF_GET_VARA_REAL(ncid,varid,dimfirst,dimlast,champ)
	573	#endif
	574	if (ierr.ne.0) then
	575	print *, NF_STRERROR(ierr)
	576	STOP
	577	ENDIF
	578
	579	title = 'Sea-ice Amip '
	580	c
	581	CALL conf_dat2d(title,imdep, jmdep, dlon_ini, dlat_ini,
	582	. dlon, dlat, champ, interbar )
	583	c
	584	IF( oldice ) THEN
	585	CALL sea_ice(imdep, jmdep, dlon, dlat, champ,
	586	. iim, jjp1, rlonv, rlatu, champint )
	587	ELSEIF ( interbar ) THEN
	588	IF( l.EQ.1 ) THEN
	589	WRITE(6,*) '-------------------------------------------------',
	590	,'------------------------'
	591	WRITE(6,*) '$$$ Utilisation de l interpolation barycentrique ',
	592	, ' pour Sea-ice Amip $$$ '
	593	WRITE(6,*) '-------------------------------------------------',
	594	,'------------------------'
	595	ENDIF
[405]	596	cIM07/03/2002
	597	cIM22/02/2002 : Sea-ice Amip entre 0. et 1.
	598	cIM PRINT*,'SUB. limit_netcdf.F IM : Sea-ice et SST Amip_new clim'
	599	cIM DO j = 1, imdep * jmdep
	600	cIM28/02/2002 <==PM champ(j) = champ(j)/100.
	601	cIM14/03/2002 champ(j) = max(0.0,(min(1.0, (champ(j)/100.) )))
	602	cIM champ(j) = amax1(0.0,(amin1(1.0, (champ(j)/100.) )))
	603	cIM ENDDO
	604	cIM22/02/2002
[259]	605	CALL inter_barxy ( imdep,jmdep -1,dlon, dlat ,
	606	, champ, iim, jjm, rlonu, rlatv, jjp1, champint )
	607	ELSE
	608	CALL sea_ice(imdep, jmdep, dlon, dlat, champ,
	609	. iim, jjp1, rlonv, rlatu, champint )
	610	ENDIF
	611	DO j = 1,jjp1
	612	DO i = 1, iim
	613	champtime (i,j,l) = champint(i,j)
	614	ENDDO
	615	ENDDO
	616	ENDDO
	617	c
	618	DO l = 1, lmdep
[405]	619	cIM28/02/2002 <== PM timeyear(l) = timecoord(l)
	620	cIM timeyear(l) = timecoord(l)
	621	cIM07/03/2002
	622	timeyear(l) = tmidmonth(l)
[259]	623	ENDDO
	624	PRINT 222, timeyear
	625	c
	626	PRINT*, 'Interpolation temporelle'
	627	DO j = 1, jjp1
	628	DO i = 1, iim
	629	DO l = 1, lmdep
	630	ax(l) = timeyear(l)
	631	ay(l) = champtime (i,j,l)
	632	ENDDO
	633	CALL SPLINE(ax,ay,lmdep,1.e30,1.e30,yder)
	634	DO k = 1, 360
	635	time = FLOAT(k-1)
	636	CALL SPLINT(ax,ay,yder,lmdep,time,by)
	637	champan(i,j,k) = by
	638	ENDDO
	639	ENDDO
	640	ENDDO
	641	DO k = 1, 360
	642	DO j = 1, jjp1
	643	champan(iip1, j, k) = champan(1, j, k)
	644	ENDDO
	645	IF ( k.EQ.10 ) THEN
	646	DO j = 1, jjp1
	647	CALL minmax( iip1,champan(1,j,10),chmin,chmax )
	648	PRINT *,' Sea ice au temps 10 ', chmin,chmax,j
	649	ENDDO
	650	ENDIF
	651	ENDDO
	652	c
[405]	653	cIM14/03/2002 : Sea-ice Amip entre 0. et 1.
	654	PRINT*,'SUB. limit_netcdf.F IM : Sea-ice Amipbc '
	655	DO k = 1, 360
	656	DO j = 1, jjp1
	657	DO i = 1, iim
	658	champan(i, j, k) =
	659	$ amax1(0.0,(amin1(1.0,(champan(i, j, k)/100.))))
	660	ENDDO
	661	champan(iip1, j, k) = champan(1, j, k)
	662	ENDDO
	663	ENDDO
	664	cIM14/03/2002
[259]	665
	666	DO k = 1, 360
	667	CALL gr_dyn_fi(1, iip1, jjp1, klon,
[327]	668	. champan(1,1,k), phy_ice)
[325]	669	IF ( newlmt) THEN
	670
	671	CPB en attendant de mettre fraction de terre
	672	c
	673	WHERE(phy_ice(1:klon) .GE. 1.) phy_ice(1 : klon) = 1.
	674	WHERE(phy_ice(1:klon) .LT. EPSFRA) phy_ice(1 : klon) = 0.
	675	c
	676	IF (fracterre ) THEN
	677	c WRITE(,) 'passe dans cas fracterre'
	678	pctsrf_t(:,is_ter,k) = pctsrf(:,is_ter)
	679	pctsrf_t(:,is_lic,k) = pctsrf(:,is_lic)
	680	pctsrf_t(1:klon,is_sic,k) = phy_ice(1:klon)
	681	$ - pctsrf_t(1:klon,is_lic,k)
	682	c Il y a des cas ou il y a de la glace dans landiceref et pas dans AMIP
	683	WHERE (pctsrf_t(1:klon,is_sic,k) .LE. 0)
	684	pctsrf_t(1:klon,is_sic,k) = 0.
	685	END WHERE
	686	WHERE( 1. - zmasq(1:klon) .LT. EPSFRA)
	687	pctsrf_t(1:klon,is_sic,k) = 0.
	688	pctsrf_t(1:klon,is_oce,k) = 0.
	689	END WHERE
	690	DO i = 1, klon
	691	IF ( 1. - zmasq(i) .GT. EPSFRA) THEN
	692	IF ( pctsrf_t(i,is_sic,k) .GE. 1 - zmasq(i)) THEN
	693	pctsrf_t(i,is_sic,k) = 1 - zmasq(i)
	694	pctsrf_t(i,is_oce,k) = 0.
	695	ELSE
	696	pctsrf_t(i,is_oce,k) = 1 - zmasq(i)
	697	$ - pctsrf_t(i,is_sic,k)
	698	IF (pctsrf_t(i,is_oce,k) .LT. EPSFRA) THEN
	699	pctsrf_t(i,is_oce,k) = 0.
	700	pctsrf_t(i,is_sic,k) = 1 - zmasq(i)
	701	ENDIF
	702	ENDIF
	703	ENDIF
	704	if (pctsrf_t(i,is_oce,k) .lt. 0.) then
	705	WRITE(,) 'pb sous maille au point : i,k '
	706	$ , i,k,pctsrf_t(:,is_oce,k)
	707	ENDIF
	708	IF ( abs( pctsrf_t(i, is_ter,k) + pctsrf_t(i, is_lic,k) +
	709	$ pctsrf_t(i, is_oce,k) + pctsrf_t(i, is_sic,k) - 1.)
	710	$ .GT. EPSFRA) THEN
	711	WRITE(,) 'physiq : pb sous surface au point ', i,
	712	$ pctsrf_t(i, 1 : nbsrf,k), phy_ice(i)
	713	ENDIF
	714	END DO
	715	ELSE
	716	DO i = 1, klon
	717	pctsrf_t(i,is_ter,k) = pctsrf(i,is_ter)
	718	IF (NINT(pctsrf(i,is_ter)).EQ.1 ) THEN
	719	pctsrf_t(i,is_sic,k) = 0.
	720	pctsrf_t(i,is_oce,k) = 0.
	721	IF(phy_ice(i) .GE. 1.e-5) THEN
	722	pctsrf_t(i,is_lic,k) = phy_ice(i)
	723	pctsrf_t(i,is_ter,k) = pctsrf_t(i,is_ter,k)
	724	. - pctsrf_t(i,is_lic,k)
	725	ELSE
	726	pctsrf_t(i,is_lic,k) = 0.
	727	ENDIF
	728	ELSE
	729	pctsrf_t(i,is_lic,k) = 0.
	730	IF(phy_ice(i) .GE. 1.e-5) THEN
	731	pctsrf_t(i,is_ter,k) = 0.
	732	pctsrf_t(i,is_sic,k) = phy_ice(i)
	733	pctsrf_t(i,is_oce,k) = 1. - pctsrf_t(i,is_sic,k)
	734	ELSE
	735	pctsrf_t(i,is_sic,k) = 0.
	736	pctsrf_t(i,is_oce,k) = 1.
	737	ENDIF
	738	ENDIF
	739	verif = pctsrf_t(i,is_ter,k) +
	740	. pctsrf_t(i,is_oce,k) +
	741	. pctsrf_t(i,is_sic,k) +
	742	. pctsrf_t(i,is_lic,k)
	743	IF ( verif .LT. 1. - 1.e-5 .OR.
	744	$ verif .GT. 1 + 1.e-5) THEN
	745	WRITE(,) 'pb sous maille au point : i,k,verif '
	746	$ , i,k,verif
	747	ENDIF
	748	END DO
	749	ENDIF
	750	ELSE
	751	DO i = 1, klon
	752	phy_nat(i,k) = phy_nat0(i)
	753	IF ( (phy_ice(i) - 0.5).GE.1.e-5 ) THEN
	754	IF (NINT(phy_nat0(i)).EQ.0) THEN
	755	phy_nat(i,k) = 3.0
	756	ELSE
	757	phy_nat(i,k) = 2.0
	758	ENDIF
[259]	759	ENDIF
	760	IF( NINT(phy_nat(i,k)).EQ.0 ) THEN
	761	IF ( phy_rug(i,k).NE.0.001 ) phy_rug(i,k) = 0.001
	762	ENDIF
[325]	763	END DO
	764	ENDIF
[259]	765	ENDDO
	766	c
	767
	768	ierr = NF_CLOSE(ncid)
	769	c
	770	DEALLOCATE( dlon )
	771	DEALLOCATE( dlon_ini )
	772	DEALLOCATE( dlat )
	773	DEALLOCATE( dlat_ini )
	774	DEALLOCATE( champ )
	775
	776	477 continue
	777	c
	778	C Traitement de la sst
	779	c
	780	PRINT*, 'Traitement de la sst'
[405]	781	cIM22/02/2002
	782	cIM ierr = NF_OPEN('AMIP.nc', NF_NOWRITE, ncid)
	783	cIM ierr = NF_OPEN('amip79to95.nc', NF_NOWRITE, ncid)
[430]	784	cIM ierr = NF_OPEN('amipbc_sst_1x1_clim.nc', NF_NOWRITE, ncid)
	785
[405]	786	ierr = NF_OPEN('amipbc_sst_1x1.nc', NF_NOWRITE, ncid)
	787	cIM22/02/2002
[259]	788	if (ierr.ne.0) then
	789	print *, NF_STRERROR(ierr)
	790	STOP
	791	ENDIF
	792
[405]	793	cIM22/02/2002
	794	cIM ierr = NF_INQ_VARID(ncid,'SST',varid)
	795	ierr = NF_INQ_VARID(ncid,'tosbcs',varid)
	796	cIM22/02/2002
[259]	797	if (ierr.ne.0) then
	798	print *, NF_STRERROR(ierr)
	799	STOP
	800	ENDIF
	801	ierr = NF_INQ_VARDIMID (ncid,varid,ndimid)
	802	if (ierr.ne.0) then
	803	print *, NF_STRERROR(ierr)
	804	STOP
	805	ENDIF
	806	ierr = NF_INQ_DIM(ncid,ndimid(1), namedim, imdep)
	807	if (ierr.ne.0) then
	808	print *, NF_STRERROR(ierr)
	809	STOP
	810	ENDIF
	811	print*,'variable SST ', namedim,'dimension ', imdep
	812	ierr = NF_INQ_VARID(ncid,namedim,dimid)
	813	if (ierr.ne.0) then
	814	print *, NF_STRERROR(ierr)
	815	STOP
	816	ENDIF
	817
	818	ALLOCATE( dlon_ini(imdep) )
	819	ALLOCATE( dlon(imdep) )
	820
	821	#ifdef NC_DOUBLE
	822	ierr = NF_GET_VAR_DOUBLE(ncid,dimid,dlon_ini)
	823	#else
	824	ierr = NF_GET_VAR_REAL(ncid,dimid,dlon_ini)
	825	#endif
	826
	827	if (ierr.ne.0) then
	828	print *, NF_STRERROR(ierr)
	829	STOP
	830	ENDIF
	831	ierr = NF_INQ_DIM(ncid,ndimid(2), namedim, jmdep)
	832	if (ierr.ne.0) then
	833	print *, NF_STRERROR(ierr)
	834	STOP
	835	ENDIF
	836	print*,'variable SST ', namedim, 'dimension ', jmdep
	837	ierr = NF_INQ_VARID(ncid,namedim,dimid)
	838	if (ierr.ne.0) then
	839	print *, NF_STRERROR(ierr)
	840	STOP
	841	ENDIF
	842
	843	ALLOCATE( dlat_ini(jmdep) )
	844	ALLOCATE( dlat(jmdep) )
	845
	846	#ifdef NC_DOUBLE
	847	ierr = NF_GET_VAR_DOUBLE(ncid,dimid,dlat_ini)
	848	#else
	849	ierr = NF_GET_VAR_REAL(ncid,dimid,dlat_ini)
	850	#endif
	851	if (ierr.ne.0) then
	852	print *, NF_STRERROR(ierr)
	853	STOP
	854	ENDIF
	855	ierr = NF_INQ_DIM(ncid,ndimid(3), namedim, lmdep)
	856	if (ierr.ne.0) then
	857	print *, NF_STRERROR(ierr)
	858	STOP
	859	ENDIF
	860	print*,'variable ', namedim, 'dimension ', lmdep
[405]	861	cIM28/02/2002
	862	cPM28/02/2002 : nouvelle coord temporelle fichiers AMIP pas en jours
	863	c Ici on suppose qu'on a 12 mois (de 30 jours).
	864	IF (lmdep.NE.12) THEN
	865	print *, 'Unknown AMIP file: not 12 months ?'
	866	STOP
	867	ENDIF
	868	cIM28/02/2002
[259]	869	ierr = NF_INQ_VARID(ncid,namedim,dimid)
	870	if (ierr.ne.0) then
	871	print *, NF_STRERROR(ierr)
	872	STOP
	873	ENDIF
	874	#ifdef NC_DOUBLE
	875	ierr = NF_GET_VAR_DOUBLE(ncid,dimid,timecoord)
	876	#else
	877	ierr = NF_GET_VAR_REAL(ncid,dimid,timecoord)
	878	#endif
	879	if (ierr.ne.0) then
	880	print *, NF_STRERROR(ierr)
	881	STOP
	882	ENDIF
	883
	884	ALLOCATE( champ(imdep*jmdep) )
	885	IF( extrap ) THEN
	886	ALLOCATE ( work(imdep,jmdep) )
	887	ENDIF
	888	c
	889	DO l = 1, lmdep
	890	dimfirst(1) = 1
	891	dimfirst(2) = 1
	892	dimfirst(3) = l
	893	c
	894	dimlast(1) = imdep
	895	dimlast(2) = jmdep
	896	dimlast(3) = 1
	897	c
	898	PRINT*,'Lecture temporelle et int. horizontale ',l,timecoord(l)
	899	#ifdef NC_DOUBLE
	900	ierr = NF_GET_VARA_DOUBLE(ncid,varid,dimfirst,dimlast,champ)
	901	#else
	902	ierr = NF_GET_VARA_REAL(ncid,varid,dimfirst,dimlast,champ)
	903	#endif
	904	if (ierr.ne.0) then
	905	print *, NF_STRERROR(ierr)
	906	STOP
	907	ENDIF
	908
	909	title='Sst Amip'
	910	c
	911	CALL conf_dat2d(title,imdep, jmdep, dlon_ini, dlat_ini,
	912	. dlon, dlat, champ, interbar )
	913	IF ( extrap ) THEN
	914	CALL extrapol(champ, imdep, jmdep, 999999.,.TRUE.,.TRUE.,2,work)
	915	ENDIF
	916	c
	917
	918	IF ( interbar ) THEN
	919	IF( l.EQ.1 ) THEN
	920	WRITE(6,*) '-------------------------------------------------',
	921	,'------------------------'
	922	WRITE(6,*) '$$$ Utilisation de l interpolation barycentrique ',
	923	, ' pour la Sst Amip $$$ '
	924	WRITE(6,*) '-------------------------------------------------',
	925	,'------------------------'
	926	ENDIF
	927	CALL inter_barxy ( imdep,jmdep -1,dlon, dlat ,
	928	, champ, iim, jjm, rlonu, rlatv, jjp1, champint )
	929	ELSE
	930	CALL grille_m(imdep, jmdep, dlon, dlat, champ,
	931	. iim, jjp1, rlonv, rlatu, champint )
	932	ENDIF
	933
	934	DO j = 1,jjp1
	935	DO i = 1, iim
	936	champtime (i,j,l) = champint(i,j)
	937	ENDDO
	938	ENDDO
	939	ENDDO
	940	c
	941	DO l = 1, lmdep
[405]	942	cIM28/02/2002 <==PM timeyear(l) = timecoord(l)
	943	timeyear(l) = tmidmonth(l)
[259]	944	ENDDO
	945	print 222, timeyear
	946	c
	947	C interpolation temporelle
	948	DO j = 1, jjp1
	949	DO i = 1, iim
	950	DO l = 1, lmdep
	951	ax(l) = timeyear(l)
	952	ay(l) = champtime (i,j,l)
	953	ENDDO
	954	CALL SPLINE(ax,ay,lmdep,1.e30,1.e30,yder)
	955	DO k = 1, 360
	956	time = FLOAT(k-1)
	957	CALL SPLINT(ax,ay,yder,lmdep,time,by)
	958	champan(i,j,k) = by
	959	ENDDO
	960	ENDDO
	961	ENDDO
	962	DO k = 1, 360
	963	DO j = 1, jjp1
	964	champan(iip1,j,k) = champan(1,j,k)
	965	ENDDO
	966	IF ( k.EQ.10 ) THEN
	967	DO j = 1, jjp1
	968	CALL minmax( iip1,champan(1,j,10),chmin,chmax )
	969	PRINT *,' SST au temps 10 ', chmin,chmax,j
	970	ENDDO
	971	ENDIF
	972	ENDDO
	973	c
[405]	974	cIM14/03/2002 : SST amipbc greater then 271.38
	975	PRINT*,'SUB. limit_netcdf.F IM : SST Amipbc >= 271.38 '
[259]	976	DO k = 1, 360
[405]	977	DO j = 1, jjp1
	978	DO i = 1, iim
	979	champan(i, j, k) = amax1(champan(i, j, k), 271.38)
	980	ENDDO
	981	champan(iip1, j, k) = champan(1, j, k)
	982	ENDDO
	983	ENDDO
	984	cIM14/03/2002
	985	DO k = 1, 360
[259]	986	CALL gr_dyn_fi(1, iip1, jjp1, klon,
	987	. champan(1,1,k), phy_sst(1,k))
	988	ENDDO
	989	c
	990	ierr = NF_CLOSE(ncid)
	991	c
	992	DEALLOCATE( dlon )
	993	DEALLOCATE( dlon_ini )
	994	DEALLOCATE( dlat )
	995	DEALLOCATE( dlat_ini )
	996	DEALLOCATE( champ )
	997	c
	998	C Traitement de l'albedo
	999	c
	1000	PRINT*, 'Traitement de l albedo'
	1001	ierr = NF_OPEN('Albedo.nc', NF_NOWRITE, ncid)
	1002	if (ierr.ne.0) then
	1003	print *, NF_STRERROR(ierr)
	1004	STOP
	1005	ENDIF
	1006	ierr = NF_INQ_VARID(ncid,'ALBEDO',varid)
	1007	if (ierr.ne.0) then
	1008	print *, NF_STRERROR(ierr)
	1009	STOP
	1010	ENDIF
	1011	ierr = NF_INQ_VARDIMID (ncid,varid,ndimid)
	1012	if (ierr.ne.0) then
	1013	print *, NF_STRERROR(ierr)
	1014	STOP
	1015	ENDIF
	1016	ierr = NF_INQ_DIM(ncid,ndimid(1), namedim, imdep)
	1017	if (ierr.ne.0) then
	1018	print *, NF_STRERROR(ierr)
	1019	STOP
	1020	ENDIF
	1021	print*,'variable ', namedim, 'dimension ', imdep
	1022	ierr = NF_INQ_VARID(ncid,namedim,dimid)
	1023	if (ierr.ne.0) then
	1024	print *, NF_STRERROR(ierr)
	1025	STOP
	1026	ENDIF
	1027
	1028	ALLOCATE ( dlon_ini(imdep) )
	1029	ALLOCATE ( dlon(imdep) )
	1030
	1031	#ifdef NC_DOUBLE
	1032	ierr = NF_GET_VAR_DOUBLE(ncid,dimid,dlon_ini)
	1033	#else
	1034	ierr = NF_GET_VAR_REAL(ncid,dimid,dlon_ini)
	1035	#endif
	1036	if (ierr.ne.0) then
	1037	print *, NF_STRERROR(ierr)
	1038	STOP
	1039	ENDIF
	1040	ierr = NF_INQ_DIM(ncid,ndimid(2), namedim, jmdep)
	1041	if (ierr.ne.0) then
	1042	print *, NF_STRERROR(ierr)
	1043	STOP
	1044	ENDIF
	1045	print*,'variable ', namedim, 'dimension ', jmdep
	1046	ierr = NF_INQ_VARID(ncid,namedim,dimid)
	1047	if (ierr.ne.0) then
	1048	print *, NF_STRERROR(ierr)
	1049	STOP
	1050	ENDIF
	1051
	1052	ALLOCATE ( dlat_ini(jmdep) )
	1053	ALLOCATE ( dlat(jmdep) )
	1054
	1055	#ifdef NC_DOUBLE
	1056	ierr = NF_GET_VAR_DOUBLE(ncid,dimid,dlat_ini)
	1057	#else
	1058	ierr = NF_GET_VAR_REAL(ncid,dimid,dlat_ini)
	1059	#endif
	1060	if (ierr.ne.0) then
	1061	print *, NF_STRERROR(ierr)
	1062	STOP
	1063	ENDIF
	1064	ierr = NF_INQ_DIM(ncid,ndimid(3), namedim, lmdep)
	1065	if (ierr.ne.0) then
	1066	print *, NF_STRERROR(ierr)
	1067	STOP
	1068	ENDIF
	1069	print*,'variable ', namedim, 'dimension ', lmdep
	1070	ierr = NF_INQ_VARID(ncid,namedim,dimid)
	1071	if (ierr.ne.0) then
	1072	print *, NF_STRERROR(ierr)
	1073	STOP
	1074	ENDIF
	1075	#ifdef NC_DOUBLE
	1076	ierr = NF_GET_VAR_DOUBLE(ncid,dimid,timecoord)
	1077	#else
	1078	ierr = NF_GET_VAR_REAL(ncid,dimid,timecoord)
	1079	#endif
	1080	if (ierr.ne.0) then
	1081	print *, NF_STRERROR(ierr)
	1082	STOP
	1083	ENDIF
	1084	c
	1085	ALLOCATE ( champ(imdep*jmdep) )
	1086
	1087	DO l = 1, lmdep
	1088	dimfirst(1) = 1
	1089	dimfirst(2) = 1
	1090	dimfirst(3) = l
	1091	c
	1092	dimlast(1) = imdep
	1093	dimlast(2) = jmdep
	1094	dimlast(3) = 1
	1095	c
	1096	PRINT*,'Lecture temporelle et int. horizontale ',l,timecoord(l)
	1097	#ifdef NC_DOUBLE
	1098	ierr = NF_GET_VARA_DOUBLE(ncid,varid,dimfirst,dimlast,champ)
	1099	#else
	1100	ierr = NF_GET_VARA_REAL(ncid,varid,dimfirst,dimlast,champ)
	1101	#endif
	1102	if (ierr.ne.0) then
	1103	print *, NF_STRERROR(ierr)
	1104	STOP
	1105	ENDIF
	1106
	1107	title='Albedo Amip'
	1108	c
	1109	CALL conf_dat2d(title,imdep, jmdep, dlon_ini, dlat_ini,
	1110	. dlon, dlat, champ, interbar )
	1111	c
	1112	c
	1113	IF ( interbar ) THEN
	1114	IF( l.EQ.1 ) THEN
	1115	WRITE(6,*) '-------------------------------------------------',
	1116	,'------------------------'
	1117	WRITE(6,*) '$$$ Utilisation de l interpolation barycentrique ',
	1118	, ' pour l Albedo Amip $$$ '
	1119	WRITE(6,*) '-------------------------------------------------',
	1120	,'------------------------'
	1121	ENDIF
	1122
	1123	CALL inter_barxy ( imdep,jmdep -1,dlon, dlat ,
	1124	, champ, iim, jjm, rlonu, rlatv, jjp1, champint )
	1125	ELSE
	1126	CALL grille_m(imdep, jmdep, dlon, dlat, champ,
	1127	. iim, jjp1, rlonv, rlatu, champint )
	1128	ENDIF
	1129	c
	1130	DO j = 1,jjp1
	1131	DO i = 1, iim
	1132	champtime (i, j, l) = champint(i, j)
	1133	ENDDO
	1134	ENDDO
	1135	ENDDO
	1136	c
	1137	DO l = 1, lmdep
	1138	timeyear(l) = timecoord(l)
	1139	ENDDO
	1140	print 222, timeyear
	1141	c
	1142	C interpolation temporelle
	1143	DO j = 1, jjp1
	1144	DO i = 1, iim
	1145	DO l = 1, lmdep
	1146	ax(l) = timeyear(l)
	1147	ay(l) = champtime (i, j, l)
	1148	ENDDO
	1149	CALL SPLINE(ax,ay,lmdep,1.e30,1.e30,yder)
	1150	DO k = 1, 360
	1151	time = FLOAT(k-1)
	1152	CALL SPLINT(ax,ay,yder,lmdep,time,by)
	1153	champan(i,j,k) = by
	1154	ENDDO
	1155	ENDDO
	1156	ENDDO
	1157	DO k = 1, 360
	1158	DO j = 1, jjp1
	1159	champan(iip1, j, k) = champan(1, j, k)
	1160	ENDDO
	1161	IF ( k.EQ.10 ) THEN
	1162	DO j = 1, jjp1
	1163	CALL minmax( iip1,champan(1,j,10),chmin,chmax )
	1164	PRINT *,' Albedo au temps 10 ', chmin,chmax,j
	1165	ENDDO
	1166	ENDIF
	1167	ENDDO
	1168	c
	1169	DO k = 1, 360
	1170	CALL gr_dyn_fi(1, iip1, jjp1, klon,
	1171	. champan(1,1,k), phy_alb(1,k))
	1172	ENDDO
	1173	c
	1174	ierr = NF_CLOSE(ncid)
	1175	c
	1176	c
	1177	DO k = 1, 360
	1178	DO i = 1, klon
	1179	phy_bil(i,k) = 0.0
	1180	ENDDO
	1181	ENDDO
	1182	c
	1183	PRINT*, 'Ecriture du fichier limit'
	1184	c
	1185	ierr = NF_CREATE ("limit.nc", NF_CLOBBER, nid)
	1186	c
	1187	ierr = NF_PUT_ATT_TEXT (nid, NF_GLOBAL, "title", 30,
	1188	. "Fichier conditions aux limites")
	1189	ierr = NF_DEF_DIM (nid, "points_physiques", klon, ndim)
	1190	ierr = NF_DEF_DIM (nid, "time", NF_UNLIMITED, ntim)
	1191	c
	1192	dims(1) = ndim
	1193	dims(2) = ntim
	1194	c
	1195	ierr = NF_DEF_VAR (nid, "TEMPS", NF_FLOAT, 1,ntim, id_tim)
	1196	ierr = NF_PUT_ATT_TEXT (nid, id_tim, "title", 17,
	1197	. "Jour dans l annee")
[325]	1198	IF (newlmt) THEN
	1199	c
	1200	ierr = NF_DEF_VAR (nid, "FOCE", NF_FLOAT, 2,dims, id_FOCE)
	1201	ierr = NF_PUT_ATT_TEXT (nid, id_FOCE, "title", 14,
	1202	. "Fraction ocean")
	1203	c
	1204	ierr = NF_DEF_VAR (nid, "FSIC", NF_FLOAT, 2,dims, id_FSIC)
	1205	ierr = NF_PUT_ATT_TEXT (nid, id_FSIC, "title", 21,
	1206	. "Fraction glace de mer")
	1207	c
	1208	ierr = NF_DEF_VAR (nid, "FTER", NF_FLOAT, 2,dims, id_FTER)
	1209	ierr = NF_PUT_ATT_TEXT (nid, id_FTER, "title", 14,
	1210	. "Fraction terre")
	1211	c
	1212	ierr = NF_DEF_VAR (nid, "FLIC", NF_FLOAT, 2,dims, id_FLIC)
	1213	ierr = NF_PUT_ATT_TEXT (nid, id_FLIC, "title", 17,
	1214	. "Fraction land ice")
	1215	c
	1216	ELSE
	1217	ierr = NF_DEF_VAR (nid, "NAT", NF_FLOAT, 2,dims, id_NAT)
	1218	ierr = NF_PUT_ATT_TEXT (nid, id_NAT, "title", 23,
	1219	. "Nature du sol (0,1,2,3)")
	1220	ENDIF
[259]	1221	ierr = NF_DEF_VAR (nid, "SST", NF_FLOAT, 2,dims, id_SST)
	1222	ierr = NF_PUT_ATT_TEXT (nid, id_SST, "title", 35,
[325]	1223	. "Temperature superficielle de la mer")
[259]	1224	ierr = NF_DEF_VAR (nid, "BILS", NF_FLOAT, 2,dims, id_BILS)
	1225	ierr = NF_PUT_ATT_TEXT (nid, id_BILS, "title", 32,
	1226	. "Reference flux de chaleur au sol")
	1227	ierr = NF_DEF_VAR (nid, "ALB", NF_FLOAT, 2,dims, id_ALB)
	1228	ierr = NF_PUT_ATT_TEXT (nid, id_ALB, "title", 19,
	1229	. "Albedo a la surface")
	1230	ierr = NF_DEF_VAR (nid, "RUG", NF_FLOAT, 2,dims, id_RUG)
	1231	ierr = NF_PUT_ATT_TEXT (nid, id_RUG, "title", 8,
	1232	. "Rugosite")
	1233	c
	1234	ierr = NF_ENDDEF(nid)
	1235	c
	1236	DO k = 1, 360
	1237	c
	1238	debut(1) = 1
	1239	debut(2) = k
	1240	epais(1) = klon
	1241	epais(2) = 1
	1242	c
	1243	#ifdef NC_DOUBLE
	1244	ierr = NF_PUT_VAR1_DOUBLE (nid,id_tim,k,DBLE(k))
[325]	1245	c
	1246	IF (newlmt ) THEN
	1247	ierr = NF_PUT_VARA_DOUBLE (nid,id_FOCE,debut,epais
	1248	$ ,pctsrf_t(1,is_oce,k))
	1249	ierr = NF_PUT_VARA_DOUBLE (nid,id_FSIC,debut,epais
	1250	$ ,pctsrf_t(1,is_sic,k))
	1251	ierr = NF_PUT_VARA_DOUBLE (nid,id_FTER,debut,epais
	1252	$ ,pctsrf_t(1,is_ter,k))
	1253	ierr = NF_PUT_VARA_DOUBLE (nid,id_FLIC,debut,epais
	1254	$ ,pctsrf_t(1,is_lic,k))
	1255	ELSE
	1256	ierr = NF_PUT_VARA_DOUBLE (nid,id_NAT,debut,epais
	1257	$ ,phy_nat(1,k))
	1258	ENDIF
	1259	c
[259]	1260	ierr = NF_PUT_VARA_DOUBLE (nid,id_SST,debut,epais,phy_sst(1,k))
	1261	ierr = NF_PUT_VARA_DOUBLE (nid,id_BILS,debut,epais,phy_bil(1,k))
	1262	ierr = NF_PUT_VARA_DOUBLE (nid,id_ALB,debut,epais,phy_alb(1,k))
	1263	ierr = NF_PUT_VARA_DOUBLE (nid,id_RUG,debut,epais,phy_rug(1,k))
	1264	#else
	1265	ierr = NF_PUT_VAR1_REAL (nid,id_tim,k,FLOAT(k))
[325]	1266	IF (newlmt ) THEN
	1267	ierr = NF_PUT_VARA_REAL (nid,id_FOCE,debut,epais
	1268	$ ,pctsrf_t(1,is_oce,k))
	1269	ierr = NF_PUT_VARA_REAL (nid,id_FSIC,debut,epais
	1270	$ ,pctsrf_t(1,is_sic,k))
	1271	ierr = NF_PUT_VARA_REAL (nid,id_FTER,debut,epais
	1272	$ ,pctsrf_t(1,is_ter,k))
	1273	ierr = NF_PUT_VARA_REAL (nid,id_FLIC,debut,epais
	1274	$ ,pctsrf_t(1,is_lic,k))
	1275	ELSE
	1276	ierr = NF_PUT_VARA_REAL (nid,id_NAT,debut,epais
	1277	$ ,phy_nat(1,k))
	1278	ENDIF
[259]	1279	ierr = NF_PUT_VARA_REAL (nid,id_SST,debut,epais,phy_sst(1,k))
	1280	ierr = NF_PUT_VARA_REAL (nid,id_BILS,debut,epais,phy_bil(1,k))
	1281	ierr = NF_PUT_VARA_REAL (nid,id_ALB,debut,epais,phy_alb(1,k))
	1282	ierr = NF_PUT_VARA_REAL (nid,id_RUG,debut,epais,phy_rug(1,k))
	1283	#endif
	1284	c
	1285	ENDDO
	1286	c
	1287	ierr = NF_CLOSE(nid)
	1288	c
	1289	STOP
	1290	END

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

Download in other formats:

Original Format