Context Navigation

limit_netcdf.F @ 5373

Last change on this file since 5373 was 733, checked in by Laurent Fairhead, 18 years ago
Petit nettoyage YM/LF
Property svn:eol-style set to `native` Property svn:keywords set to `Author Date Id Revision`
File size: 36.5 KB

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

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

Download in other formats:

Original Format