Context Navigation

create_limit.F @ 5306

Last change on this file since 5306 was 154, checked in by lmdz, 24 years ago
Rajout des ifdef NC_DOUBLE/NC_REAL pour les lectures LF
Property svn:eol-style set to `native` Property svn:keywords set to `Author Date Id Revision`
File size: 22.8 KB

Rev	Line
[2]	1	PROGRAM create_limit
	2	IMPLICIT none
	3	c
	4	c-------------------------------------------------------------
	5	C Author : L. Fairhead
	6	C Date : 27/01/94
	7	C Objet : Construction des fichiers de conditions aux limites
	8	C pour le nouveau
	9	C modele a partir de fichiers de climatologie. Les deux
	10	C grilles doivent etre regulieres
	11	c
	12	c Modifie par z.x.li (le23mars1994)
	13	c Modifie par L. Fairhead (fairhead@lmd.jussieu.fr) septembre 1999
	14	c pour lecture netcdf dans LMDZ.3.3
	15	c-------------------------------------------------------------
	16	c
	17	#include "dimensions.h"
	18	#include "paramet.h"
	19	#include "control.h"
	20	#include "logic.h"
	21	#include "netcdf.inc"
	22	#include "comvert.h"
	23	#include "comgeom2.h"
	24	#include "comconst.h"
	25	c
	26	c-----------------------------------------------------------------------
	27	INTEGER KIDIA, KFDIA, KLON, KLEV
	28	PARAMETER (KIDIA=1,KFDIA=iim*(jjm-1)+2,
	29	. KLON=KFDIA-KIDIA+1,KLEV=llm)
	30	c-----------------------------------------------------------------------
	31	REAL phy_nat(klon,360), phy_nat0(klon)
	32	REAL phy_alb(klon,360)
	33	REAL phy_sst(klon,360)
	34	REAL phy_bil(klon,360)
	35	REAL phy_rug(klon,360)
	36	REAL phy_ice(klon,360)
	37	c
	38	REAL masque(iip1,jjp1)
	39	REAL mask(iim,jjp1)
	40
	41	C Declarations pour le champ de depart
	42	INTEGER imdep, jmdep,lmdep
	43	INTEGER ibid, jbid, tbid
	44	PARAMETER (ibid = 400, ! >360 pts
	45	. jbid = 200, ! >181 pts
	46	. tbid = 60) ! >52 semaines
	47	REAL champ(ibid*jbid)
	48	REAL dlon(ibid), dlat(jbid), timecoord(tbid)
	49	c
	50	INTEGER ibid_msk, jbid_msk
	51	PARAMETER(ibid_msk=2200,jbid_msk=1100)
	52	REAL champ_msk(ibid_msk*jbid_msk)
	53	REAL dlon_msk(ibid_msk), dlat_msk(jbid_msk)
	54
	55	C Declarations pour le champ interpole 2D
	56	REAL champint(iim,jjp1)
	57
	58	C Declarations pour le champ interpole 3D
	59	REAL champtime(iim,jjp1,tbid)
	60	REAL timeyear(tbid)
	61	REAL champan(iip1,jjp1,366)
	62
	63	C Declarations pour l'inteprolation verticale
	64	REAL ax(tbid), ay(tbid)
	65	REAL by
	66	REAL yder(tbid)
	67
	68
	69	INTEGER ierr
	70	INTEGER dimfirst(3)
	71	INTEGER dimlast(3)
	72	c
	73	INTEGER nid, ndim, ntim
	74	INTEGER dims(2), debut(2), epais(2)
	75	INTEGER id_tim
	76	INTEGER id_NAT, id_SST, id_BILS, id_RUG, id_ALB
	77
	78	INTEGER i, j, k, l
	79	c Diverses variables locales
	80	REAL time
	81
	82	INTEGER longcles
	83	PARAMETER ( longcles = 20 )
	84	REAL clesphy0 ( longcles )
	85	#include "serre.h"
	86	INTEGER ncid,varid,ndimid(4),dimid
	87	character*30 namedim
	88
	89	c initialisations:
	90	OPEN (8,file='run.def',form='formatted')
	91	CALL defrun_new(8,.TRUE.,clesphy0)
	92	CLOSE(8)
	93
	94	pi = 4. * ATAN(1.)
	95	rad = 6 371 229.
	96	omeg = 4.* ASIN(1.)/(24.*3600.)
	97	g = 9.8
	98	daysec = 86400.
	99	kappa = 0.2857143
	100	cpp = 1004.70885
	101	dtvr = daysec/FLOAT(day_step)
	102	c
	103	ccc CALL iniconst ( non indispensable )
	104
	105	CALL inigeom
	106	c
	107	c
	108	C Traitement du relief au sol
	109	c
	110	write(,) 'Traitement du relief au sol pour fabriquer masque'
	111	ierr = NF_OPEN('Relief.nc', NF_NOWRITE, ncid)
	112
	113	if (ierr.ne.0) then
	114	print *, NF_STRERROR(ierr)
	115	STOP
	116	ENDIF
	117
	118	ierr = NF_INQ_VARID(ncid,'RELIEF',varid)
	119	if (ierr.ne.0) then
	120	print *, NF_STRERROR(ierr)
	121	STOP
	122	ENDIF
	123	ierr = NF_INQ_VARDIMID (ncid,varid,ndimid)
	124	if (ierr.ne.0) then
	125	print *, NF_STRERROR(ierr)
	126	STOP
	127	ENDIF
	128	ierr = NF_INQ_DIM(ncid,ndimid(1), namedim, imdep)
	129	if (ierr.ne.0) then
	130	print *, NF_STRERROR(ierr)
	131	STOP
	132	ENDIF
	133	print*,'variable ', namedim, 'dimension ', imdep
	134	ierr = NF_INQ_VARID(ncid,namedim,dimid)
	135	if (ierr.ne.0) then
	136	print *, NF_STRERROR(ierr)
	137	STOP
	138	ENDIF
[154]	139	#ifdef NC_DOUBLE
[71]	140	ierr = NF_GET_VAR_DOUBLE(ncid,dimid,dlon_msk)
[154]	141	#else
	142	ierr = NF_GET_VAR_REAL(ncid,dimid,dlon_msk)
	143	#endif
	144
[71]	145	c
[2]	146	if (ierr.ne.0) then
	147	print *, NF_STRERROR(ierr)
	148	STOP
	149	ENDIF
	150	ierr = NF_INQ_DIM(ncid,ndimid(2), namedim, jmdep)
	151	if (ierr.ne.0) then
	152	print *, NF_STRERROR(ierr)
	153	STOP
	154	ENDIF
	155	print*,'variable ', namedim, 'dimension ', jmdep
	156	ierr = NF_INQ_VARID(ncid,namedim,dimid)
	157	if (ierr.ne.0) then
	158	print *, NF_STRERROR(ierr)
	159	STOP
	160	ENDIF
[154]	161	#ifdef NC_DOUBLE
[71]	162	ierr = NF_GET_VAR_DOUBLE(ncid,dimid,dlat_msk)
[154]	163	#else
	164	ierr = NF_GET_VAR_REAL(ncid,dimid,dlat_msk)
	165	#endif
[71]	166	c
[2]	167	if (ierr.ne.0) then
	168	print *, NF_STRERROR(ierr)
	169	STOP
	170	ENDIF
[154]	171	#ifdef NC_DOUBLE
[71]	172	ierr = NF_GET_VAR_DOUBLE(ncid,varid,champ_msk)
[154]	173	#else
	174	ierr = NF_GET_VAR_REAL(ncid,varid,champ_msk)
	175	#endif
[71]	176	c
[2]	177	if (ierr.ne.0) then
	178	print *, NF_STRERROR(ierr)
	179	STOP
	180	ENDIF
	181
	182	c
	183	CALL mask_c_o(imdep, jmdep, dlon_msk, dlat_msk,champ_msk,
	184	. iim, jjp1, rlonv, rlatu, champint)
	185	CALL gr_int_dyn(champint, masque, iim, jjp1)
	186	DO i = 1, iim
	187	masque(i,1) = FLOAT(NINT(masque(i,1)))
	188	masque(i,jjp1) = FLOAT(NINT(masque(i,jjp1)))
	189	ENDDO
	190	DO i = 1, iim
	191	DO j = 1, jjp1
	192	mask(i,j) = champint(i,j)
	193	ENDDO
	194	ENDDO
	195	CALL gr_dyn_fi(1, iip1, jjp1, klon, masque, phy_nat0)
	196	ierr = NF_CLOSE(ncid)
	197	c
	198	c
	199	C Traitement de la rugosite
	200	c
	201	PRINT*, 'Traitement de la rugosite'
	202	ierr = NF_OPEN('Rugos.nc', NF_NOWRITE, ncid)
	203	if (ierr.ne.0) then
	204	print *, NF_STRERROR(ierr)
	205	STOP
	206	ENDIF
	207
	208	ierr = NF_INQ_VARID(ncid,'RUGOS',varid)
	209	if (ierr.ne.0) then
	210	print *, NF_STRERROR(ierr)
	211	STOP
	212	ENDIF
	213	ierr = NF_INQ_VARDIMID (ncid,varid,ndimid)
	214	if (ierr.ne.0) then
	215	print *, NF_STRERROR(ierr)
	216	STOP
	217	ENDIF
	218	ierr = NF_INQ_DIM(ncid,ndimid(1), namedim, imdep)
	219	if (ierr.ne.0) then
	220	print *, NF_STRERROR(ierr)
	221	STOP
	222	ENDIF
	223	print*,'variable ', namedim, 'dimension ', imdep
	224	ierr = NF_INQ_VARID(ncid,namedim,dimid)
	225	if (ierr.ne.0) then
	226	print *, NF_STRERROR(ierr)
	227	STOP
	228	ENDIF
[154]	229	#ifdef NC_DOUBLE
[71]	230	ierr = NF_GET_VAR_DOUBLE(ncid,dimid,dlon)
[154]	231	#else
	232	ierr = NF_GET_VAR_REAL(ncid,dimid,dlon)
	233	#endif
[2]	234	if (ierr.ne.0) then
	235	print *, NF_STRERROR(ierr)
	236	STOP
	237	ENDIF
	238	ierr = NF_INQ_DIM(ncid,ndimid(2), namedim, jmdep)
	239	if (ierr.ne.0) then
	240	print *, NF_STRERROR(ierr)
	241	STOP
	242	ENDIF
	243	print*,'variable ', namedim, 'dimension ', jmdep
	244	ierr = NF_INQ_VARID(ncid,namedim,dimid)
	245	if (ierr.ne.0) then
	246	print *, NF_STRERROR(ierr)
	247	STOP
	248	ENDIF
[154]	249	#ifdef NC_DOUBLE
[71]	250	ierr = NF_GET_VAR_DOUBLE(ncid,dimid,dlat)
[154]	251	#else
	252	ierr = NF_GET_VAR_REAL(ncid,dimid,dlat)
	253	#endif
[2]	254	if (ierr.ne.0) then
	255	print *, NF_STRERROR(ierr)
	256	STOP
	257	ENDIF
	258	ierr = NF_INQ_DIM(ncid,ndimid(3), namedim, lmdep)
	259	if (ierr.ne.0) then
	260	print *, NF_STRERROR(ierr)
	261	STOP
	262	ENDIF
	263	print*,'variable ', namedim, 'dimension ', lmdep
	264	ierr = NF_INQ_VARID(ncid,namedim,dimid)
	265	if (ierr.ne.0) then
	266	print *, NF_STRERROR(ierr)
	267	STOP
	268	ENDIF
[154]	269	#ifdef NC_DOUBLE
[71]	270	ierr = NF_GET_VAR_DOUBLE(ncid,dimid,timecoord)
[154]	271	#else
	272	ierr = NF_GET_VAR_REAL(ncid,dimid,timecoord)
	273	#endif
[2]	274	if (ierr.ne.0) then
	275	print *, NF_STRERROR(ierr)
	276	STOP
	277	ENDIF
	278	c
	279	DO l = 1, lmdep
	280	dimfirst(1) = 1
	281	dimfirst(2) = 1
	282	dimfirst(3) = l
	283	c
	284	dimlast(1) = imdep
	285	dimlast(2) = jmdep
	286	dimlast(3) = 1
	287	c
	288	PRINT*,'Lecture temporelle et int. horizontale ',l,timecoord(l)
	289	print*,dimfirst,dimlast
[154]	290	#ifdef NC_DOUBLE
[71]	291	ierr = NF_GET_VARA_DOUBLE(ncid,varid,dimfirst,dimlast,champ)
[154]	292	#else
	293	ierr = NF_GET_VARA_REAL(ncid,varid,dimfirst,dimlast,champ)
	294	#endif
[2]	295	if (ierr.ne.0) then
	296	print *, NF_STRERROR(ierr)
	297	STOP
	298	ENDIF
	299
	300	CALL rugosite(imdep, jmdep, dlon, dlat, champ,
	301	. iim, jjp1, rlonv, rlatu, champint, mask)
	302	DO j = 1,jjp1
	303	DO i = 1, iim
	304	champtime (i,j,l) = champint(i,j)
	305	ENDDO
	306	ENDDO
	307	ENDDO
	308	c
	309	DO l = 1, lmdep
	310	timeyear(l) = timecoord(l)
	311	ENDDO
	312
	313	PRINT 222, timeyear
	314	222 FORMAT(2x,' Time year ',10f6.1)
	315	c
	316
	317	PRINT*, 'Interpolation temporelle dans l annee'
	318
	319
	320	DO j = 1, jjp1
	321	DO i = 1, iim
	322	DO l = 1, lmdep
	323	ax(l) = timeyear(l)
	324	ay(l) = champtime (i,j,l)
	325	ENDDO
	326	CALL SPLINE(ax,ay,lmdep,1.e30,1.e30,yder)
	327	DO k = 1, 360
	328	time = FLOAT(k-1)
	329	CALL SPLINT(ax,ay,yder,lmdep,time,by)
	330	champan(i,j,k) = by
	331	ENDDO
	332	ENDDO
	333	ENDDO
	334	DO k = 1, 360
	335	DO j = 1, jjp1
	336	champan(iip1,j,k) = champan(1,j,k)
	337	ENDDO
	338	ENDDO
	339	c
	340	DO k = 1, 360
	341	CALL gr_dyn_fi(1,iip1,jjp1,klon,champan(1,1,k), phy_rug(1,k))
	342	ENDDO
	343	c
	344	ierr = NF_CLOSE(ncid)
	345	c
	346	c
	347	C Traitement de la glace oceanique
	348	c
	349	PRINT*, 'Traitement de la glace oceanique'
	350	ierr = NF_OPEN('AMIP.nc', NF_NOWRITE, ncid)
	351	if (ierr.ne.0) then
	352	print *, NF_STRERROR(ierr)
	353	STOP
	354	ENDIF
	355
	356	ierr = NF_INQ_VARID(ncid,'SEA_ICE',varid)
	357	if (ierr.ne.0) then
	358	print *, NF_STRERROR(ierr)
	359	STOP
	360	ENDIF
	361	ierr = NF_INQ_VARDIMID (ncid,varid,ndimid)
	362	if (ierr.ne.0) then
	363	print *, NF_STRERROR(ierr)
	364	STOP
	365	ENDIF
	366	ierr = NF_INQ_DIM(ncid,ndimid(1), namedim, imdep)
	367	if (ierr.ne.0) then
	368	print *, NF_STRERROR(ierr)
	369	STOP
	370	ENDIF
	371	print*,'variable ', namedim, 'dimension ', imdep
	372	ierr = NF_INQ_VARID(ncid,namedim,dimid)
	373	if (ierr.ne.0) then
	374	print *, NF_STRERROR(ierr)
	375	STOP
	376	ENDIF
[154]	377	#ifdef NC_DOUBLE
[71]	378	ierr = NF_GET_VAR_DOUBLE(ncid,dimid,dlon)
[154]	379	#else
	380	ierr = NF_GET_VAR_REAL(ncid,dimid,dlon)
	381	#endif
[2]	382	if (ierr.ne.0) then
	383	print *, NF_STRERROR(ierr)
	384	STOP
	385	ENDIF
	386	ierr = NF_INQ_DIM(ncid,ndimid(2), namedim, jmdep)
	387	if (ierr.ne.0) then
	388	print *, NF_STRERROR(ierr)
	389	STOP
	390	ENDIF
	391	print*,'variable ', namedim, jmdep
	392	ierr = NF_INQ_VARID(ncid,namedim,dimid)
	393	if (ierr.ne.0) then
	394	print *, NF_STRERROR(ierr)
	395	STOP
	396	ENDIF
[154]	397	#ifdef NC_DOUBLE
[71]	398	ierr = NF_GET_VAR_DOUBLE(ncid,dimid,dlat)
[154]	399	#else
	400	ierr = NF_GET_VAR_REAL(ncid,dimid,dlat)
	401	#endif
[2]	402	if (ierr.ne.0) then
	403	print *, NF_STRERROR(ierr)
	404	STOP
	405	ENDIF
	406	ierr = NF_INQ_DIM(ncid,ndimid(3), namedim, lmdep)
	407	if (ierr.ne.0) then
	408	print *, NF_STRERROR(ierr)
	409	STOP
	410	ENDIF
	411	print*,'variable ', namedim, lmdep
	412	ierr = NF_INQ_VARID(ncid,namedim,dimid)
	413	if (ierr.ne.0) then
	414	print *, NF_STRERROR(ierr)
	415	STOP
	416	ENDIF
[154]	417	#ifdef NC_DOUBLE
[71]	418	ierr = NF_GET_VAR_DOUBLE(ncid,dimid,timecoord)
[154]	419	#else
	420	ierr = NF_GET_VAR_REAL(ncid,dimid,timecoord)
	421	#endif
[2]	422	if (ierr.ne.0) then
	423	print *, NF_STRERROR(ierr)
	424	STOP
	425	ENDIF
	426	c
	427	DO l = 1, lmdep
	428	dimfirst(1) = 1
	429	dimfirst(2) = 1
	430	dimfirst(3) = l
	431	c
	432	dimlast(1) = imdep
	433	dimlast(2) = jmdep
	434	dimlast(3) = 1
	435	c
	436	PRINT*,'Lecture temporelle et int. horizontale ',l,timecoord(l)
[154]	437	#ifdef NC_DOUBLE
[71]	438	ierr = NF_GET_VARA_DOUBLE(ncid,varid,dimfirst,dimlast,champ)
[154]	439	#else
	440	ierr = NF_GET_VARA_REAL(ncid,varid,dimfirst,dimlast,champ)
	441	#endif
[2]	442	if (ierr.ne.0) then
	443	print *, NF_STRERROR(ierr)
	444	STOP
	445	ENDIF
	446
	447	CALL sea_ice(imdep, jmdep, dlon, dlat, champ,
	448	. iim, jjp1, rlonv, rlatu, champint)
	449	DO j = 1,jjp1
	450	DO i = 1, iim
	451	champtime (i,j,l) = champint(i,j)
	452	ENDDO
	453	ENDDO
	454	ENDDO
	455	c
	456	DO l = 1, lmdep
	457	timeyear(l) = timecoord(l)
	458	ENDDO
	459	PRINT 222, timeyear
	460	c
	461	PRINT*, 'Interpolation temporelle'
	462	DO j = 1, jjp1
	463	DO i = 1, iim
	464	DO l = 1, lmdep
	465	ax(l) = timeyear(l)
	466	ay(l) = champtime (i,j,l)
	467	ENDDO
	468	CALL SPLINE(ax,ay,lmdep,1.e30,1.e30,yder)
	469	DO k = 1, 360
	470	time = FLOAT(k-1)
	471	CALL SPLINT(ax,ay,yder,lmdep,time,by)
	472	champan(i,j,k) = by
	473	ENDDO
	474	ENDDO
	475	ENDDO
	476	DO k = 1, 360
	477	DO j = 1, jjp1
	478	champan(iip1, j, k) = champan(1, j, k)
	479	ENDDO
	480	ENDDO
	481	c
	482	DO k = 1, 360
	483	CALL gr_dyn_fi(1, iip1, jjp1, klon,
	484	. champan(1,1,k), phy_ice(1,k))
	485	DO i = 1, klon
	486	phy_nat(i,k) = phy_nat0(i)
	487	IF ( (phy_ice(i,k) - 0.5).GE.1.e-5 ) THEN
	488	IF (NINT(phy_nat0(i)).EQ.0) THEN
	489	phy_nat(i,k) = 3.0
	490	ELSE
	491	phy_nat(i,k) = 2.0
	492	ENDIF
	493	ENDIF
	494	ENDDO
	495	ENDDO
	496	c
	497	ierr = NF_CLOSE(ncid)
	498	c
	499	c
	500	C Traitement de la sst
	501	c
	502	PRINT*, 'Traitement de la sst'
	503	ierr = NF_OPEN('AMIP.nc', NF_NOWRITE, ncid)
	504	if (ierr.ne.0) then
	505	print *, NF_STRERROR(ierr)
	506	STOP
	507	ENDIF
	508
	509	ierr = NF_INQ_VARID(ncid,'SST',varid)
	510	if (ierr.ne.0) then
	511	print *, NF_STRERROR(ierr)
	512	STOP
	513	ENDIF
	514	ierr = NF_INQ_VARDIMID (ncid,varid,ndimid)
	515	if (ierr.ne.0) then
	516	print *, NF_STRERROR(ierr)
	517	STOP
	518	ENDIF
	519	ierr = NF_INQ_DIM(ncid,ndimid(1), namedim, imdep)
	520	if (ierr.ne.0) then
	521	print *, NF_STRERROR(ierr)
	522	STOP
	523	ENDIF
	524	print*,'variable ', namedim,'dimension ', imdep
	525	ierr = NF_INQ_VARID(ncid,namedim,dimid)
	526	if (ierr.ne.0) then
	527	print *, NF_STRERROR(ierr)
	528	STOP
	529	ENDIF
[154]	530	#ifdef NC_DOUBLE
[71]	531	ierr = NF_GET_VAR_DOUBLE(ncid,dimid,dlon)
[154]	532	#else
	533	ierr = NF_GET_VAR_REAL(ncid,dimid,dlon)
	534	#endif
	535
[2]	536	if (ierr.ne.0) then
	537	print *, NF_STRERROR(ierr)
	538	STOP
	539	ENDIF
	540	ierr = NF_INQ_DIM(ncid,ndimid(2), namedim, jmdep)
	541	if (ierr.ne.0) then
	542	print *, NF_STRERROR(ierr)
	543	STOP
	544	ENDIF
	545	print*,'variable ', namedim, 'dimension ', jmdep
	546	ierr = NF_INQ_VARID(ncid,namedim,dimid)
	547	if (ierr.ne.0) then
	548	print *, NF_STRERROR(ierr)
	549	STOP
	550	ENDIF
[154]	551	#ifdef NC_DOUBLE
[71]	552	ierr = NF_GET_VAR_DOUBLE(ncid,dimid,dlat)
[154]	553	#else
	554	ierr = NF_GET_VAR_REAL(ncid,dimid,dlat)
	555	#endif
[2]	556	if (ierr.ne.0) then
	557	print *, NF_STRERROR(ierr)
	558	STOP
	559	ENDIF
	560	ierr = NF_INQ_DIM(ncid,ndimid(3), namedim, lmdep)
	561	if (ierr.ne.0) then
	562	print *, NF_STRERROR(ierr)
	563	STOP
	564	ENDIF
	565	print*,'variable ', namedim, 'dimension ', lmdep
	566	ierr = NF_INQ_VARID(ncid,namedim,dimid)
	567	if (ierr.ne.0) then
	568	print *, NF_STRERROR(ierr)
	569	STOP
	570	ENDIF
[154]	571	#ifdef NC_DOUBLE
[71]	572	ierr = NF_GET_VAR_DOUBLE(ncid,dimid,timecoord)
[154]	573	#else
	574	ierr = NF_GET_VAR_REAL(ncid,dimid,timecoord)
	575	#endif
[2]	576	if (ierr.ne.0) then
	577	print *, NF_STRERROR(ierr)
	578	STOP
	579	ENDIF
	580	c
	581	DO l = 1, lmdep
	582	dimfirst(1) = 1
	583	dimfirst(2) = 1
	584	dimfirst(3) = l
	585	c
	586	dimlast(1) = imdep
	587	dimlast(2) = jmdep
	588	dimlast(3) = 1
	589	c
	590	PRINT*,'Lecture temporelle et int. horizontale ',l,timecoord(l)
[154]	591	#ifdef NC_DOUBLE
[71]	592	ierr = NF_GET_VARA_DOUBLE(ncid,varid,dimfirst,dimlast,champ)
[154]	593	#else
	594	ierr = NF_GET_VARA_REAL(ncid,varid,dimfirst,dimlast,champ)
	595	#endif
[2]	596	if (ierr.ne.0) then
	597	print *, NF_STRERROR(ierr)
	598	STOP
	599	ENDIF
	600	CALL grille_m(imdep, jmdep, dlon, dlat, champ,
	601	. iim, jjp1, rlonv, rlatu, champint)
	602
	603	DO j = 1,jjp1
	604	DO i = 1, iim
	605	champtime (i,j,l) = champint(i,j)
	606	ENDDO
	607	ENDDO
	608	ENDDO
	609	c
	610	DO l = 1, lmdep
	611	timeyear(l) = timecoord(l)
	612	ENDDO
	613	print 222, timeyear
	614	c
	615	C interpolation temporelle
	616	DO j = 1, jjp1
	617	DO i = 1, iim
	618	DO l = 1, lmdep
	619	ax(l) = timeyear(l)
	620	ay(l) = champtime (i,j,l)
	621	ENDDO
	622	CALL SPLINE(ax,ay,lmdep,1.e30,1.e30,yder)
	623	DO k = 1, 360
	624	time = FLOAT(k-1)
	625	CALL SPLINT(ax,ay,yder,lmdep,time,by)
	626	champan(i,j,k) = by
	627	ENDDO
	628	ENDDO
	629	ENDDO
	630	DO k = 1, 360
	631	DO j = 1, jjp1
	632	champan(iip1,j,k) = champan(1,j,k)
	633	ENDDO
	634	ENDDO
	635	c
	636	DO k = 1, 360
	637	CALL gr_dyn_fi(1, iip1, jjp1, klon,
	638	. champan(1,1,k), phy_sst(1,k))
	639	ENDDO
	640	c
	641	ierr = NF_CLOSE(ncid)
	642	c
	643	c
	644	C Traitement de l'albedo
	645	c
	646	PRINT*, 'Traitement de l albedo'
	647	ierr = NF_OPEN('Albedo.nc', NF_NOWRITE, ncid)
	648	if (ierr.ne.0) then
	649	print *, NF_STRERROR(ierr)
	650	STOP
	651	ENDIF
	652	ierr = NF_INQ_VARID(ncid,'ALBEDO',varid)
	653	if (ierr.ne.0) then
	654	print *, NF_STRERROR(ierr)
	655	STOP
	656	ENDIF
	657	ierr = NF_INQ_VARDIMID (ncid,varid,ndimid)
	658	if (ierr.ne.0) then
	659	print *, NF_STRERROR(ierr)
	660	STOP
	661	ENDIF
	662	ierr = NF_INQ_DIM(ncid,ndimid(1), namedim, imdep)
	663	if (ierr.ne.0) then
	664	print *, NF_STRERROR(ierr)
	665	STOP
	666	ENDIF
	667	print*,'variable ', namedim, 'dimension ', imdep
	668	ierr = NF_INQ_VARID(ncid,namedim,dimid)
	669	if (ierr.ne.0) then
	670	print *, NF_STRERROR(ierr)
	671	STOP
	672	ENDIF
[154]	673	#ifdef NC_DOUBLE
[71]	674	ierr = NF_GET_VAR_DOUBLE(ncid,dimid,dlon)
[154]	675	#else
	676	ierr = NF_GET_VAR_REAL(ncid,dimid,dlon)
	677	#endif
[2]	678	if (ierr.ne.0) then
	679	print *, NF_STRERROR(ierr)
	680	STOP
	681	ENDIF
	682	ierr = NF_INQ_DIM(ncid,ndimid(2), namedim, jmdep)
	683	if (ierr.ne.0) then
	684	print *, NF_STRERROR(ierr)
	685	STOP
	686	ENDIF
	687	print*,'variable ', namedim, 'dimension ', jmdep
	688	ierr = NF_INQ_VARID(ncid,namedim,dimid)
	689	if (ierr.ne.0) then
	690	print *, NF_STRERROR(ierr)
	691	STOP
	692	ENDIF
[154]	693	#ifdef NC_DOUBLE
[71]	694	ierr = NF_GET_VAR_DOUBLE(ncid,dimid,dlat)
[154]	695	#else
	696	ierr = NF_GET_VAR_REAL(ncid,dimid,dlat)
	697	#endif
[2]	698	if (ierr.ne.0) then
	699	print *, NF_STRERROR(ierr)
	700	STOP
	701	ENDIF
	702	ierr = NF_INQ_DIM(ncid,ndimid(3), namedim, lmdep)
	703	if (ierr.ne.0) then
	704	print *, NF_STRERROR(ierr)
	705	STOP
	706	ENDIF
	707	print*,'variable ', namedim, 'dimension ', lmdep
	708	ierr = NF_INQ_VARID(ncid,namedim,dimid)
	709	if (ierr.ne.0) then
	710	print *, NF_STRERROR(ierr)
	711	STOP
	712	ENDIF
[154]	713	#ifdef NC_DOUBLE
[71]	714	ierr = NF_GET_VAR_DOUBLE(ncid,dimid,timecoord)
[154]	715	#else
	716	ierr = NF_GET_VAR_REAL(ncid,dimid,timecoord)
	717	#endif
[2]	718	if (ierr.ne.0) then
	719	print *, NF_STRERROR(ierr)
	720	STOP
	721	ENDIF
	722	c
	723	DO l = 1, lmdep
	724	dimfirst(1) = 1
	725	dimfirst(2) = 1
	726	dimfirst(3) = l
	727	c
	728	dimlast(1) = imdep
	729	dimlast(2) = jmdep
	730	dimlast(3) = 1
	731	c
	732	PRINT*,'Lecture temporelle et int. horizontale ',l,timecoord(l)
[154]	733	#ifdef NC_DOUBLE
[71]	734	ierr = NF_GET_VARA_DOUBLE(ncid,varid,dimfirst,dimlast,champ)
[154]	735	#else
	736	ierr = NF_GET_VARA_REAL(ncid,varid,dimfirst,dimlast,champ)
	737	#endif
[2]	738	if (ierr.ne.0) then
	739	print *, NF_STRERROR(ierr)
	740	STOP
	741	ENDIF
	742	CALL grille_m(imdep, jmdep, dlon, dlat, champ,
	743	. iim, jjp1, rlonv, rlatu, champint)
	744	c
	745	DO j = 1,jjp1
	746	DO i = 1, iim
	747	champtime (i, j, l) = champint(i, j)
	748	ENDDO
	749	ENDDO
	750	ENDDO
	751	c
	752	DO l = 1, lmdep
	753	timeyear(l) = timecoord(l)
	754	ENDDO
	755	print 222, timeyear
	756	c
	757	C interpolation temporelle
	758	DO j = 1, jjp1
	759	DO i = 1, iim
	760	DO l = 1, lmdep
	761	ax(l) = timeyear(l)
	762	ay(l) = champtime (i, j, l)
	763	ENDDO
	764	CALL SPLINE(ax,ay,lmdep,1.e30,1.e30,yder)
	765	DO k = 1, 360
	766	time = FLOAT(k-1)
	767	CALL SPLINT(ax,ay,yder,lmdep,time,by)
	768	champan(i,j,k) = by
	769	ENDDO
	770	ENDDO
	771	ENDDO
	772	DO k = 1, 360
	773	DO j = 1, jjp1
	774	champan(iip1, j, k) = champan(1, j, k)
	775	ENDDO
	776	ENDDO
	777	c
	778	DO k = 1, 360
	779	CALL gr_dyn_fi(1, iip1, jjp1, klon,
	780	. champan(1,1,k), phy_alb(1,k))
	781	ENDDO
	782	c
	783	ierr = NF_CLOSE(ncid)
	784	c
	785	c
	786	DO k = 1, 360
	787	DO i = 1, klon
	788	phy_bil(i,k) = 0.0
	789	ENDDO
	790	ENDDO
	791	c
	792	PRINT*, 'Ecriture du fichier limit'
	793	c
	794	ierr = NF_CREATE ("limit.nc", NF_CLOBBER, nid)
	795	c
	796	ierr = NF_PUT_ATT_TEXT (nid, NF_GLOBAL, "title", 30,
	797	. "Fichier conditions aux limites")
	798	ierr = NF_DEF_DIM (nid, "points_physiques", klon, ndim)
	799	ierr = NF_DEF_DIM (nid, "time", NF_UNLIMITED, ntim)
	800	c
	801	dims(1) = ndim
	802	dims(2) = ntim
	803	c
	804	ccc ierr = NF_DEF_VAR (nid, "TEMPS", NF_DOUBLE, 1,ntim, id_tim)
	805	ierr = NF_DEF_VAR (nid, "TEMPS", NF_FLOAT, 1,ntim, id_tim)
	806	ierr = NF_PUT_ATT_TEXT (nid, id_tim, "title", 17,
	807	. "Jour dans l annee")
	808	ccc ierr = NF_DEF_VAR (nid, "NAT", NF_DOUBLE, 2,dims, id_NAT)
	809	ierr = NF_DEF_VAR (nid, "NAT", NF_FLOAT, 2,dims, id_NAT)
	810	ierr = NF_PUT_ATT_TEXT (nid, id_NAT, "title", 23,
	811	. "Nature du sol (0,1,2,3)")
	812	ccc ierr = NF_DEF_VAR (nid, "SST", NF_DOUBLE, 2,dims, id_SST)
	813	ierr = NF_DEF_VAR (nid, "SST", NF_FLOAT, 2,dims, id_SST)
	814	ierr = NF_PUT_ATT_TEXT (nid, id_SST, "title", 35,
	815	. "Temperature superficielle de la mer")
	816	ccc ierr = NF_DEF_VAR (nid, "BILS", NF_DOUBLE, 2,dims, id_BILS)
	817	ierr = NF_DEF_VAR (nid, "BILS", NF_FLOAT, 2,dims, id_BILS)
	818	ierr = NF_PUT_ATT_TEXT (nid, id_BILS, "title", 32,
	819	. "Reference flux de chaleur au sol")
	820	ccc ierr = NF_DEF_VAR (nid, "ALB", NF_DOUBLE, 2,dims, id_ALB)
	821	ierr = NF_DEF_VAR (nid, "ALB", NF_FLOAT, 2,dims, id_ALB)
	822	ierr = NF_PUT_ATT_TEXT (nid, id_ALB, "title", 19,
	823	. "Albedo a la surface")
	824	ccc ierr = NF_DEF_VAR (nid, "RUG", NF_DOUBLE, 2,dims, id_RUG)
	825	ierr = NF_DEF_VAR (nid, "RUG", NF_FLOAT, 2,dims, id_RUG)
	826	ierr = NF_PUT_ATT_TEXT (nid, id_RUG, "title", 8,
	827	. "Rugosite")
	828	c
	829	ierr = NF_ENDDEF(nid)
	830	c
	831	DO k = 1, 360
	832	c
	833	debut(1) = 1
	834	debut(2) = k
	835	epais(1) = klon
	836	epais(2) = 1
	837	c
	838	#ifdef NC_DOUBLE
	839	ierr = NF_PUT_VAR1_DOUBLE (nid,id_tim,k,DBLE(k))
	840	ierr = NF_PUT_VARA_DOUBLE (nid,id_NAT,debut,epais,phy_nat(1,k))
	841	ierr = NF_PUT_VARA_DOUBLE (nid,id_SST,debut,epais,phy_sst(1,k))
	842	ierr = NF_PUT_VARA_DOUBLE (nid,id_BILS,debut,epais,phy_bil(1,k))
	843	ierr = NF_PUT_VARA_DOUBLE (nid,id_ALB,debut,epais,phy_alb(1,k))
	844	ierr = NF_PUT_VARA_DOUBLE (nid,id_RUG,debut,epais,phy_rug(1,k))
	845	#else
	846	ierr = NF_PUT_VAR1_REAL (nid,id_tim,k,FLOAT(k))
	847	ierr = NF_PUT_VARA_REAL (nid,id_NAT,debut,epais,phy_nat(1,k))
	848	ierr = NF_PUT_VARA_REAL (nid,id_SST,debut,epais,phy_sst(1,k))
	849	ierr = NF_PUT_VARA_REAL (nid,id_BILS,debut,epais,phy_bil(1,k))
	850	ierr = NF_PUT_VARA_REAL (nid,id_ALB,debut,epais,phy_alb(1,k))
	851	ierr = NF_PUT_VARA_REAL (nid,id_RUG,debut,epais,phy_rug(1,k))
	852	#endif
	853	c
	854	ENDDO
	855	c
	856	ierr = NF_CLOSE(nid)
	857	c
	858	STOP
	859	END

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

Download in other formats:

Original Format