Context Navigation

limit_netcdf.F @ 4667

Last change on this file since 4667 was 1299, checked in by Laurent Fairhead, 15 years ago

Nettoyage general pour se rapprocher des normes et éviter des erreurs a la
compilation:

tous les FLOAT() sont remplacés par des REAL()
tous les STOP dans phylmd sont remplacés par des appels à abort_gcm
le common control défini dans le fichier control.h est remplacé par le module control_mod pour éviter des messages sur l'alignement des variables dans les déclarations
des $Header$ remplacés par des $Id$ pour svn

Quelques remplacements à faire ont pu m'échapper

General cleanup of the code to try and adhere to norms and to prevent some
compilation errors:

all FLOAT() instructions have been replaced by REAL() instructions
all STOP instructions in phylmd have been replaced by calls to abort_gcm
the common block control defined in the control.h file has been replaced by the control_mod to prevent compilation warnings on the alignement of declared variables
$Header$ replaced by $Id$ for svn

Some changes which should have been made might have escaped me

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

File size: 37.5 KB

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

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

Download in other formats:

Original Format