Context Navigation

limit_netcdf.F @ 1091

Last change on this file since 1091 was 997, checked in by lsce, 16 years ago

Remetais/ajoutais ecriture de limit.nc en double precision pour un compilation avec le cle 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
[524]	1	!
	2	! $Header$
	3	!
	4	C
	5	C
[989]	6	SUBROUTINE limit_netcdf(interbar, extrap, oldice, masque)
[762]	7	USE dimphy
[989]	8	use phys_state_var_mod , ONLY : pctsrf
[524]	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"
[762]	33	cy#include "dimphy.h"
[524]	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)
[989]	47
[524]	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)
[677]	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
[524]	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)
[677]	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
[524]	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
[997]	1191	#ifdef NC_DOUBLE
	1192	ierr = NF_DEF_VAR (nid, "TEMPS", NF_DOUBLE, 1,ntim, id_tim)
	1193	#else
[524]	1194	ierr = NF_DEF_VAR (nid, "TEMPS", NF_FLOAT, 1,ntim, id_tim)
[997]	1195	#endif
[524]	1196	ierr = NF_PUT_ATT_TEXT (nid, id_tim, "title", 17,
	1197	. "Jour dans l annee")
	1198	IF (newlmt) THEN
	1199	c
[997]	1200	#ifdef NC_DOUBLE
	1201	ierr = NF_DEF_VAR (nid, "FOCE", NF_DOUBLE, 2,dims, id_FOCE)
	1202	#else
[524]	1203	ierr = NF_DEF_VAR (nid, "FOCE", NF_FLOAT, 2,dims, id_FOCE)
[997]	1204	#endif
[524]	1205	ierr = NF_PUT_ATT_TEXT (nid, id_FOCE, "title", 14,
	1206	. "Fraction ocean")
	1207	c
[997]	1208	#ifdef NC_DOUBLE
	1209	ierr = NF_DEF_VAR (nid, "FSIC", NF_DOUBLE, 2,dims, id_FSIC)
	1210	#else
[524]	1211	ierr = NF_DEF_VAR (nid, "FSIC", NF_FLOAT, 2,dims, id_FSIC)
[997]	1212	#endif
[524]	1213	ierr = NF_PUT_ATT_TEXT (nid, id_FSIC, "title", 21,
	1214	. "Fraction glace de mer")
	1215	c
[997]	1216	#ifdef NC_DOUBLE
	1217	ierr = NF_DEF_VAR (nid, "FTER", NF_DOUBLE, 2,dims, id_FTER)
	1218	#else
[524]	1219	ierr = NF_DEF_VAR (nid, "FTER", NF_FLOAT, 2,dims, id_FTER)
[997]	1220	#endif
[524]	1221	ierr = NF_PUT_ATT_TEXT (nid, id_FTER, "title", 14,
	1222	. "Fraction terre")
	1223	c
[997]	1224	#ifdef NC_DOUBLE
	1225	ierr = NF_DEF_VAR (nid, "FLIC", NF_DOUBLE, 2,dims, id_FLIC)
	1226	#else
[524]	1227	ierr = NF_DEF_VAR (nid, "FLIC", NF_FLOAT, 2,dims, id_FLIC)
[997]	1228	#endif
[524]	1229	ierr = NF_PUT_ATT_TEXT (nid, id_FLIC, "title", 17,
	1230	. "Fraction land ice")
	1231	c
	1232	ELSE
[997]	1233	#ifdef NC_DOUBLE
	1234	ierr = NF_DEF_VAR (nid, "NAT", NF_DOUBLE, 2,dims, id_NAT)
	1235	#else
[524]	1236	ierr = NF_DEF_VAR (nid, "NAT", NF_FLOAT, 2,dims, id_NAT)
[997]	1237	#endif
[524]	1238	ierr = NF_PUT_ATT_TEXT (nid, id_NAT, "title", 23,
	1239	. "Nature du sol (0,1,2,3)")
	1240	ENDIF
[997]	1241	#ifdef NC_DOUBLE
	1242	ierr = NF_DEF_VAR (nid, "SST", NF_DOUBLE, 2,dims, id_SST)
	1243	#else
[524]	1244	ierr = NF_DEF_VAR (nid, "SST", NF_FLOAT, 2,dims, id_SST)
[997]	1245	#endif
[524]	1246	ierr = NF_PUT_ATT_TEXT (nid, id_SST, "title", 35,
	1247	. "Temperature superficielle de la mer")
[997]	1248	#ifdef NC_DOUBLE
	1249	ierr = NF_DEF_VAR (nid, "BILS", NF_DOUBLE, 2,dims, id_BILS)
	1250	#else
[524]	1251	ierr = NF_DEF_VAR (nid, "BILS", NF_FLOAT, 2,dims, id_BILS)
[997]	1252	#endif
[524]	1253	ierr = NF_PUT_ATT_TEXT (nid, id_BILS, "title", 32,
	1254	. "Reference flux de chaleur au sol")
[997]	1255	#ifdef NC_DOUBLE
	1256	ierr = NF_DEF_VAR (nid, "ALB", NF_DOUBLE, 2,dims, id_ALB)
	1257	#else
[524]	1258	ierr = NF_DEF_VAR (nid, "ALB", NF_FLOAT, 2,dims, id_ALB)
[997]	1259	#endif
[524]	1260	ierr = NF_PUT_ATT_TEXT (nid, id_ALB, "title", 19,
	1261	. "Albedo a la surface")
[997]	1262	#ifdef NC_DOUBLE
	1263	ierr = NF_DEF_VAR (nid, "RUG", NF_DOUBLE, 2,dims, id_RUG)
	1264	#else
[524]	1265	ierr = NF_DEF_VAR (nid, "RUG", NF_FLOAT, 2,dims, id_RUG)
[997]	1266	#endif
[524]	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
[997]	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
[524]	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))
[997]	1319	#endif
[524]	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