Context Navigation

limit_netcdf.F @ 1150

Last change on this file since 1150 was 1012, checked in by lsce, 16 years ago

Error in another argument list.
Added writing in double precision in case of NC_DOUBLE

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

File size: 37.4 KB

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

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

Download in other formats:

Original Format