Context Navigation

create_limit.F @ 8

Last change on this file since 8 was 2, checked in by lmdz, 25 years ago
Initial revision
Property svn:eol-style set to `native` Property svn:keywords set to `Author Date Id Revision`
File size: 21.3 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
	139	ierr = NF_GET_VAR_REAL(ncid,dimid,dlon_msk)
	140	if (ierr.ne.0) then
	141	print *, NF_STRERROR(ierr)
	142	STOP
	143	ENDIF
	144	ierr = NF_INQ_DIM(ncid,ndimid(2), namedim, jmdep)
	145	if (ierr.ne.0) then
	146	print *, NF_STRERROR(ierr)
	147	STOP
	148	ENDIF
	149	print*,'variable ', namedim, 'dimension ', jmdep
	150	ierr = NF_INQ_VARID(ncid,namedim,dimid)
	151	if (ierr.ne.0) then
	152	print *, NF_STRERROR(ierr)
	153	STOP
	154	ENDIF
	155	ierr = NF_GET_VAR_REAL(ncid,dimid,dlat_msk)
	156	if (ierr.ne.0) then
	157	print *, NF_STRERROR(ierr)
	158	STOP
	159	ENDIF
	160	ierr = NF_GET_VAR_REAL(ncid,varid,champ_msk)
	161	if (ierr.ne.0) then
	162	print *, NF_STRERROR(ierr)
	163	STOP
	164	ENDIF
	165
	166	c
	167	CALL mask_c_o(imdep, jmdep, dlon_msk, dlat_msk,champ_msk,
	168	. iim, jjp1, rlonv, rlatu, champint)
	169	CALL gr_int_dyn(champint, masque, iim, jjp1)
	170	DO i = 1, iim
	171	masque(i,1) = FLOAT(NINT(masque(i,1)))
	172	masque(i,jjp1) = FLOAT(NINT(masque(i,jjp1)))
	173	ENDDO
	174	DO i = 1, iim
	175	DO j = 1, jjp1
	176	mask(i,j) = champint(i,j)
	177	ENDDO
	178	ENDDO
	179	CALL gr_dyn_fi(1, iip1, jjp1, klon, masque, phy_nat0)
	180	ierr = NF_CLOSE(ncid)
	181	c
	182	c
	183	C Traitement de la rugosite
	184	c
	185	PRINT*, 'Traitement de la rugosite'
	186	ierr = NF_OPEN('Rugos.nc', NF_NOWRITE, ncid)
	187	if (ierr.ne.0) then
	188	print *, NF_STRERROR(ierr)
	189	STOP
	190	ENDIF
	191
	192	ierr = NF_INQ_VARID(ncid,'RUGOS',varid)
	193	if (ierr.ne.0) then
	194	print *, NF_STRERROR(ierr)
	195	STOP
	196	ENDIF
	197	ierr = NF_INQ_VARDIMID (ncid,varid,ndimid)
	198	if (ierr.ne.0) then
	199	print *, NF_STRERROR(ierr)
	200	STOP
	201	ENDIF
	202	ierr = NF_INQ_DIM(ncid,ndimid(1), namedim, imdep)
	203	if (ierr.ne.0) then
	204	print *, NF_STRERROR(ierr)
	205	STOP
	206	ENDIF
	207	print*,'variable ', namedim, 'dimension ', imdep
	208	ierr = NF_INQ_VARID(ncid,namedim,dimid)
	209	if (ierr.ne.0) then
	210	print *, NF_STRERROR(ierr)
	211	STOP
	212	ENDIF
	213	ierr = NF_GET_VAR_REAL(ncid,dimid,dlon)
	214	if (ierr.ne.0) then
	215	print *, NF_STRERROR(ierr)
	216	STOP
	217	ENDIF
	218	ierr = NF_INQ_DIM(ncid,ndimid(2), namedim, jmdep)
	219	if (ierr.ne.0) then
	220	print *, NF_STRERROR(ierr)
	221	STOP
	222	ENDIF
	223	print*,'variable ', namedim, 'dimension ', jmdep
	224	ierr = NF_INQ_VARID(ncid,namedim,dimid)
	225	if (ierr.ne.0) then
	226	print *, NF_STRERROR(ierr)
	227	STOP
	228	ENDIF
	229	ierr = NF_GET_VAR_REAL(ncid,dimid,dlat)
	230	if (ierr.ne.0) then
	231	print *, NF_STRERROR(ierr)
	232	STOP
	233	ENDIF
	234	ierr = NF_INQ_DIM(ncid,ndimid(3), namedim, lmdep)
	235	if (ierr.ne.0) then
	236	print *, NF_STRERROR(ierr)
	237	STOP
	238	ENDIF
	239	print*,'variable ', namedim, 'dimension ', lmdep
	240	ierr = NF_INQ_VARID(ncid,namedim,dimid)
	241	if (ierr.ne.0) then
	242	print *, NF_STRERROR(ierr)
	243	STOP
	244	ENDIF
	245	ierr = NF_GET_VAR_REAL(ncid,dimid,timecoord)
	246	if (ierr.ne.0) then
	247	print *, NF_STRERROR(ierr)
	248	STOP
	249	ENDIF
	250	c
	251	DO l = 1, lmdep
	252	dimfirst(1) = 1
	253	dimfirst(2) = 1
	254	dimfirst(3) = l
	255	c
	256	dimlast(1) = imdep
	257	dimlast(2) = jmdep
	258	dimlast(3) = 1
	259	c
	260	PRINT*,'Lecture temporelle et int. horizontale ',l,timecoord(l)
	261	print*,dimfirst,dimlast
	262	ierr = NF_GET_VARA_REAL(ncid,varid,dimfirst,dimlast,champ)
	263	if (ierr.ne.0) then
	264	print *, NF_STRERROR(ierr)
	265	STOP
	266	ENDIF
	267
	268	CALL rugosite(imdep, jmdep, dlon, dlat, champ,
	269	. iim, jjp1, rlonv, rlatu, champint, mask)
	270	DO j = 1,jjp1
	271	DO i = 1, iim
	272	champtime (i,j,l) = champint(i,j)
	273	ENDDO
	274	ENDDO
	275	ENDDO
	276	c
	277	DO l = 1, lmdep
	278	timeyear(l) = timecoord(l)
	279	ENDDO
	280
	281	PRINT 222, timeyear
	282	222 FORMAT(2x,' Time year ',10f6.1)
	283	c
	284
	285	PRINT*, 'Interpolation temporelle dans l annee'
	286
	287
	288	DO j = 1, jjp1
	289	DO i = 1, iim
	290	DO l = 1, lmdep
	291	ax(l) = timeyear(l)
	292	ay(l) = champtime (i,j,l)
	293	ENDDO
	294	CALL SPLINE(ax,ay,lmdep,1.e30,1.e30,yder)
	295	DO k = 1, 360
	296	time = FLOAT(k-1)
	297	CALL SPLINT(ax,ay,yder,lmdep,time,by)
	298	champan(i,j,k) = by
	299	ENDDO
	300	ENDDO
	301	ENDDO
	302	DO k = 1, 360
	303	DO j = 1, jjp1
	304	champan(iip1,j,k) = champan(1,j,k)
	305	ENDDO
	306	ENDDO
	307	c
	308	DO k = 1, 360
	309	CALL gr_dyn_fi(1,iip1,jjp1,klon,champan(1,1,k), phy_rug(1,k))
	310	ENDDO
	311	c
	312	ierr = NF_CLOSE(ncid)
	313	c
	314	c
	315	C Traitement de la glace oceanique
	316	c
	317	PRINT*, 'Traitement de la glace oceanique'
	318	ierr = NF_OPEN('AMIP.nc', NF_NOWRITE, ncid)
	319	if (ierr.ne.0) then
	320	print *, NF_STRERROR(ierr)
	321	STOP
	322	ENDIF
	323
	324	ierr = NF_INQ_VARID(ncid,'SEA_ICE',varid)
	325	if (ierr.ne.0) then
	326	print *, NF_STRERROR(ierr)
	327	STOP
	328	ENDIF
	329	ierr = NF_INQ_VARDIMID (ncid,varid,ndimid)
	330	if (ierr.ne.0) then
	331	print *, NF_STRERROR(ierr)
	332	STOP
	333	ENDIF
	334	ierr = NF_INQ_DIM(ncid,ndimid(1), namedim, imdep)
	335	if (ierr.ne.0) then
	336	print *, NF_STRERROR(ierr)
	337	STOP
	338	ENDIF
	339	print*,'variable ', namedim, 'dimension ', imdep
	340	ierr = NF_INQ_VARID(ncid,namedim,dimid)
	341	if (ierr.ne.0) then
	342	print *, NF_STRERROR(ierr)
	343	STOP
	344	ENDIF
	345	ierr = NF_GET_VAR_REAL(ncid,dimid,dlon)
	346	if (ierr.ne.0) then
	347	print *, NF_STRERROR(ierr)
	348	STOP
	349	ENDIF
	350	ierr = NF_INQ_DIM(ncid,ndimid(2), namedim, jmdep)
	351	if (ierr.ne.0) then
	352	print *, NF_STRERROR(ierr)
	353	STOP
	354	ENDIF
	355	print*,'variable ', namedim, jmdep
	356	ierr = NF_INQ_VARID(ncid,namedim,dimid)
	357	if (ierr.ne.0) then
	358	print *, NF_STRERROR(ierr)
	359	STOP
	360	ENDIF
	361	ierr = NF_GET_VAR_REAL(ncid,dimid,dlat)
	362	if (ierr.ne.0) then
	363	print *, NF_STRERROR(ierr)
	364	STOP
	365	ENDIF
	366	ierr = NF_INQ_DIM(ncid,ndimid(3), namedim, lmdep)
	367	if (ierr.ne.0) then
	368	print *, NF_STRERROR(ierr)
	369	STOP
	370	ENDIF
	371	print*,'variable ', namedim, lmdep
	372	ierr = NF_INQ_VARID(ncid,namedim,dimid)
	373	if (ierr.ne.0) then
	374	print *, NF_STRERROR(ierr)
	375	STOP
	376	ENDIF
	377	ierr = NF_GET_VAR_REAL(ncid,dimid,timecoord)
	378	if (ierr.ne.0) then
	379	print *, NF_STRERROR(ierr)
	380	STOP
	381	ENDIF
	382	c
	383	DO l = 1, lmdep
	384	dimfirst(1) = 1
	385	dimfirst(2) = 1
	386	dimfirst(3) = l
	387	c
	388	dimlast(1) = imdep
	389	dimlast(2) = jmdep
	390	dimlast(3) = 1
	391	c
	392	PRINT*,'Lecture temporelle et int. horizontale ',l,timecoord(l)
	393	ierr = NF_GET_VARA_REAL(ncid,varid,dimfirst,dimlast,champ)
	394	if (ierr.ne.0) then
	395	print *, NF_STRERROR(ierr)
	396	STOP
	397	ENDIF
	398
	399	CALL sea_ice(imdep, jmdep, dlon, dlat, champ,
	400	. iim, jjp1, rlonv, rlatu, champint)
	401	DO j = 1,jjp1
	402	DO i = 1, iim
	403	champtime (i,j,l) = champint(i,j)
	404	ENDDO
	405	ENDDO
	406	ENDDO
	407	c
	408	DO l = 1, lmdep
	409	timeyear(l) = timecoord(l)
	410	ENDDO
	411	PRINT 222, timeyear
	412	c
	413	PRINT*, 'Interpolation temporelle'
	414	DO j = 1, jjp1
	415	DO i = 1, iim
	416	DO l = 1, lmdep
	417	ax(l) = timeyear(l)
	418	ay(l) = champtime (i,j,l)
	419	ENDDO
	420	CALL SPLINE(ax,ay,lmdep,1.e30,1.e30,yder)
	421	DO k = 1, 360
	422	time = FLOAT(k-1)
	423	CALL SPLINT(ax,ay,yder,lmdep,time,by)
	424	champan(i,j,k) = by
	425	ENDDO
	426	ENDDO
	427	ENDDO
	428	DO k = 1, 360
	429	DO j = 1, jjp1
	430	champan(iip1, j, k) = champan(1, j, k)
	431	ENDDO
	432	ENDDO
	433	c
	434	DO k = 1, 360
	435	CALL gr_dyn_fi(1, iip1, jjp1, klon,
	436	. champan(1,1,k), phy_ice(1,k))
	437	DO i = 1, klon
	438	phy_nat(i,k) = phy_nat0(i)
	439	IF ( (phy_ice(i,k) - 0.5).GE.1.e-5 ) THEN
	440	IF (NINT(phy_nat0(i)).EQ.0) THEN
	441	phy_nat(i,k) = 3.0
	442	ELSE
	443	phy_nat(i,k) = 2.0
	444	ENDIF
	445	ENDIF
	446	ENDDO
	447	ENDDO
	448	c
	449	ierr = NF_CLOSE(ncid)
	450	c
	451	c
	452	C Traitement de la sst
	453	c
	454	PRINT*, 'Traitement de la sst'
	455	ierr = NF_OPEN('AMIP.nc', NF_NOWRITE, ncid)
	456	if (ierr.ne.0) then
	457	print *, NF_STRERROR(ierr)
	458	STOP
	459	ENDIF
	460
	461	ierr = NF_INQ_VARID(ncid,'SST',varid)
	462	if (ierr.ne.0) then
	463	print *, NF_STRERROR(ierr)
	464	STOP
	465	ENDIF
	466	ierr = NF_INQ_VARDIMID (ncid,varid,ndimid)
	467	if (ierr.ne.0) then
	468	print *, NF_STRERROR(ierr)
	469	STOP
	470	ENDIF
	471	ierr = NF_INQ_DIM(ncid,ndimid(1), namedim, imdep)
	472	if (ierr.ne.0) then
	473	print *, NF_STRERROR(ierr)
	474	STOP
	475	ENDIF
	476	print*,'variable ', namedim,'dimension ', imdep
	477	ierr = NF_INQ_VARID(ncid,namedim,dimid)
	478	if (ierr.ne.0) then
	479	print *, NF_STRERROR(ierr)
	480	STOP
	481	ENDIF
	482	ierr = NF_GET_VAR_REAL(ncid,dimid,dlon)
	483	if (ierr.ne.0) then
	484	print *, NF_STRERROR(ierr)
	485	STOP
	486	ENDIF
	487	ierr = NF_INQ_DIM(ncid,ndimid(2), namedim, jmdep)
	488	if (ierr.ne.0) then
	489	print *, NF_STRERROR(ierr)
	490	STOP
	491	ENDIF
	492	print*,'variable ', namedim, 'dimension ', jmdep
	493	ierr = NF_INQ_VARID(ncid,namedim,dimid)
	494	if (ierr.ne.0) then
	495	print *, NF_STRERROR(ierr)
	496	STOP
	497	ENDIF
	498	ierr = NF_GET_VAR_REAL(ncid,dimid,dlat)
	499	if (ierr.ne.0) then
	500	print *, NF_STRERROR(ierr)
	501	STOP
	502	ENDIF
	503	ierr = NF_INQ_DIM(ncid,ndimid(3), namedim, lmdep)
	504	if (ierr.ne.0) then
	505	print *, NF_STRERROR(ierr)
	506	STOP
	507	ENDIF
	508	print*,'variable ', namedim, 'dimension ', lmdep
	509	ierr = NF_INQ_VARID(ncid,namedim,dimid)
	510	if (ierr.ne.0) then
	511	print *, NF_STRERROR(ierr)
	512	STOP
	513	ENDIF
	514	ierr = NF_GET_VAR_REAL(ncid,dimid,timecoord)
	515	if (ierr.ne.0) then
	516	print *, NF_STRERROR(ierr)
	517	STOP
	518	ENDIF
	519	c
	520	DO l = 1, lmdep
	521	dimfirst(1) = 1
	522	dimfirst(2) = 1
	523	dimfirst(3) = l
	524	c
	525	dimlast(1) = imdep
	526	dimlast(2) = jmdep
	527	dimlast(3) = 1
	528	c
	529	PRINT*,'Lecture temporelle et int. horizontale ',l,timecoord(l)
	530	ierr = NF_GET_VARA_REAL(ncid,varid,dimfirst,dimlast,champ)
	531	if (ierr.ne.0) then
	532	print *, NF_STRERROR(ierr)
	533	STOP
	534	ENDIF
	535	CALL grille_m(imdep, jmdep, dlon, dlat, champ,
	536	. iim, jjp1, rlonv, rlatu, champint)
	537
	538	DO j = 1,jjp1
	539	DO i = 1, iim
	540	champtime (i,j,l) = champint(i,j)
	541	ENDDO
	542	ENDDO
	543	ENDDO
	544	c
	545	DO l = 1, lmdep
	546	timeyear(l) = timecoord(l)
	547	ENDDO
	548	print 222, timeyear
	549	c
	550	C interpolation temporelle
	551	DO j = 1, jjp1
	552	DO i = 1, iim
	553	DO l = 1, lmdep
	554	ax(l) = timeyear(l)
	555	ay(l) = champtime (i,j,l)
	556	ENDDO
	557	CALL SPLINE(ax,ay,lmdep,1.e30,1.e30,yder)
	558	DO k = 1, 360
	559	time = FLOAT(k-1)
	560	CALL SPLINT(ax,ay,yder,lmdep,time,by)
	561	champan(i,j,k) = by
	562	ENDDO
	563	ENDDO
	564	ENDDO
	565	DO k = 1, 360
	566	DO j = 1, jjp1
	567	champan(iip1,j,k) = champan(1,j,k)
	568	ENDDO
	569	ENDDO
	570	c
	571	DO k = 1, 360
	572	CALL gr_dyn_fi(1, iip1, jjp1, klon,
	573	. champan(1,1,k), phy_sst(1,k))
	574	ENDDO
	575	c
	576	ierr = NF_CLOSE(ncid)
	577	c
	578	c
	579	C Traitement de l'albedo
	580	c
	581	PRINT*, 'Traitement de l albedo'
	582	ierr = NF_OPEN('Albedo.nc', NF_NOWRITE, ncid)
	583	if (ierr.ne.0) then
	584	print *, NF_STRERROR(ierr)
	585	STOP
	586	ENDIF
	587	ierr = NF_INQ_VARID(ncid,'ALBEDO',varid)
	588	if (ierr.ne.0) then
	589	print *, NF_STRERROR(ierr)
	590	STOP
	591	ENDIF
	592	ierr = NF_INQ_VARDIMID (ncid,varid,ndimid)
	593	if (ierr.ne.0) then
	594	print *, NF_STRERROR(ierr)
	595	STOP
	596	ENDIF
	597	ierr = NF_INQ_DIM(ncid,ndimid(1), namedim, imdep)
	598	if (ierr.ne.0) then
	599	print *, NF_STRERROR(ierr)
	600	STOP
	601	ENDIF
	602	print*,'variable ', namedim, 'dimension ', imdep
	603	ierr = NF_INQ_VARID(ncid,namedim,dimid)
	604	if (ierr.ne.0) then
	605	print *, NF_STRERROR(ierr)
	606	STOP
	607	ENDIF
	608	ierr = NF_GET_VAR_REAL(ncid,dimid,dlon)
	609	if (ierr.ne.0) then
	610	print *, NF_STRERROR(ierr)
	611	STOP
	612	ENDIF
	613	ierr = NF_INQ_DIM(ncid,ndimid(2), namedim, jmdep)
	614	if (ierr.ne.0) then
	615	print *, NF_STRERROR(ierr)
	616	STOP
	617	ENDIF
	618	print*,'variable ', namedim, 'dimension ', jmdep
	619	ierr = NF_INQ_VARID(ncid,namedim,dimid)
	620	if (ierr.ne.0) then
	621	print *, NF_STRERROR(ierr)
	622	STOP
	623	ENDIF
	624	ierr = NF_GET_VAR_REAL(ncid,dimid,dlat)
	625	if (ierr.ne.0) then
	626	print *, NF_STRERROR(ierr)
	627	STOP
	628	ENDIF
	629	ierr = NF_INQ_DIM(ncid,ndimid(3), namedim, lmdep)
	630	if (ierr.ne.0) then
	631	print *, NF_STRERROR(ierr)
	632	STOP
	633	ENDIF
	634	print*,'variable ', namedim, 'dimension ', lmdep
	635	ierr = NF_INQ_VARID(ncid,namedim,dimid)
	636	if (ierr.ne.0) then
	637	print *, NF_STRERROR(ierr)
	638	STOP
	639	ENDIF
	640	ierr = NF_GET_VAR_REAL(ncid,dimid,timecoord)
	641	if (ierr.ne.0) then
	642	print *, NF_STRERROR(ierr)
	643	STOP
	644	ENDIF
	645	c
	646	DO l = 1, lmdep
	647	dimfirst(1) = 1
	648	dimfirst(2) = 1
	649	dimfirst(3) = l
	650	c
	651	dimlast(1) = imdep
	652	dimlast(2) = jmdep
	653	dimlast(3) = 1
	654	c
	655	PRINT*,'Lecture temporelle et int. horizontale ',l,timecoord(l)
	656	ierr = NF_GET_VARA_REAL(ncid,varid,dimfirst,dimlast,champ)
	657	if (ierr.ne.0) then
	658	print *, NF_STRERROR(ierr)
	659	STOP
	660	ENDIF
	661	CALL grille_m(imdep, jmdep, dlon, dlat, champ,
	662	. iim, jjp1, rlonv, rlatu, champint)
	663	c
	664	DO j = 1,jjp1
	665	DO i = 1, iim
	666	champtime (i, j, l) = champint(i, j)
	667	ENDDO
	668	ENDDO
	669	ENDDO
	670	c
	671	DO l = 1, lmdep
	672	timeyear(l) = timecoord(l)
	673	ENDDO
	674	print 222, timeyear
	675	c
	676	C interpolation temporelle
	677	DO j = 1, jjp1
	678	DO i = 1, iim
	679	DO l = 1, lmdep
	680	ax(l) = timeyear(l)
	681	ay(l) = champtime (i, j, l)
	682	ENDDO
	683	CALL SPLINE(ax,ay,lmdep,1.e30,1.e30,yder)
	684	DO k = 1, 360
	685	time = FLOAT(k-1)
	686	CALL SPLINT(ax,ay,yder,lmdep,time,by)
	687	champan(i,j,k) = by
	688	ENDDO
	689	ENDDO
	690	ENDDO
	691	DO k = 1, 360
	692	DO j = 1, jjp1
	693	champan(iip1, j, k) = champan(1, j, k)
	694	ENDDO
	695	ENDDO
	696	c
	697	DO k = 1, 360
	698	CALL gr_dyn_fi(1, iip1, jjp1, klon,
	699	. champan(1,1,k), phy_alb(1,k))
	700	ENDDO
	701	c
	702	ierr = NF_CLOSE(ncid)
	703	c
	704	c
	705	DO k = 1, 360
	706	DO i = 1, klon
	707	phy_bil(i,k) = 0.0
	708	ENDDO
	709	ENDDO
	710	c
	711	PRINT*, 'Ecriture du fichier limit'
	712	c
	713	ierr = NF_CREATE ("limit.nc", NF_CLOBBER, nid)
	714	c
	715	ierr = NF_PUT_ATT_TEXT (nid, NF_GLOBAL, "title", 30,
	716	. "Fichier conditions aux limites")
	717	ierr = NF_DEF_DIM (nid, "points_physiques", klon, ndim)
	718	ierr = NF_DEF_DIM (nid, "time", NF_UNLIMITED, ntim)
	719	c
	720	dims(1) = ndim
	721	dims(2) = ntim
	722	c
	723	ccc ierr = NF_DEF_VAR (nid, "TEMPS", NF_DOUBLE, 1,ntim, id_tim)
	724	ierr = NF_DEF_VAR (nid, "TEMPS", NF_FLOAT, 1,ntim, id_tim)
	725	ierr = NF_PUT_ATT_TEXT (nid, id_tim, "title", 17,
	726	. "Jour dans l annee")
	727	ccc ierr = NF_DEF_VAR (nid, "NAT", NF_DOUBLE, 2,dims, id_NAT)
	728	ierr = NF_DEF_VAR (nid, "NAT", NF_FLOAT, 2,dims, id_NAT)
	729	ierr = NF_PUT_ATT_TEXT (nid, id_NAT, "title", 23,
	730	. "Nature du sol (0,1,2,3)")
	731	ccc ierr = NF_DEF_VAR (nid, "SST", NF_DOUBLE, 2,dims, id_SST)
	732	ierr = NF_DEF_VAR (nid, "SST", NF_FLOAT, 2,dims, id_SST)
	733	ierr = NF_PUT_ATT_TEXT (nid, id_SST, "title", 35,
	734	. "Temperature superficielle de la mer")
	735	ccc ierr = NF_DEF_VAR (nid, "BILS", NF_DOUBLE, 2,dims, id_BILS)
	736	ierr = NF_DEF_VAR (nid, "BILS", NF_FLOAT, 2,dims, id_BILS)
	737	ierr = NF_PUT_ATT_TEXT (nid, id_BILS, "title", 32,
	738	. "Reference flux de chaleur au sol")
	739	ccc ierr = NF_DEF_VAR (nid, "ALB", NF_DOUBLE, 2,dims, id_ALB)
	740	ierr = NF_DEF_VAR (nid, "ALB", NF_FLOAT, 2,dims, id_ALB)
	741	ierr = NF_PUT_ATT_TEXT (nid, id_ALB, "title", 19,
	742	. "Albedo a la surface")
	743	ccc ierr = NF_DEF_VAR (nid, "RUG", NF_DOUBLE, 2,dims, id_RUG)
	744	ierr = NF_DEF_VAR (nid, "RUG", NF_FLOAT, 2,dims, id_RUG)
	745	ierr = NF_PUT_ATT_TEXT (nid, id_RUG, "title", 8,
	746	. "Rugosite")
	747	c
	748	ierr = NF_ENDDEF(nid)
	749	c
	750	DO k = 1, 360
	751	c
	752	debut(1) = 1
	753	debut(2) = k
	754	epais(1) = klon
	755	epais(2) = 1
	756	c
	757	#ifdef NC_DOUBLE
	758	ierr = NF_PUT_VAR1_DOUBLE (nid,id_tim,k,DBLE(k))
	759	ierr = NF_PUT_VARA_DOUBLE (nid,id_NAT,debut,epais,phy_nat(1,k))
	760	ierr = NF_PUT_VARA_DOUBLE (nid,id_SST,debut,epais,phy_sst(1,k))
	761	ierr = NF_PUT_VARA_DOUBLE (nid,id_BILS,debut,epais,phy_bil(1,k))
	762	ierr = NF_PUT_VARA_DOUBLE (nid,id_ALB,debut,epais,phy_alb(1,k))
	763	ierr = NF_PUT_VARA_DOUBLE (nid,id_RUG,debut,epais,phy_rug(1,k))
	764	#else
	765	ierr = NF_PUT_VAR1_REAL (nid,id_tim,k,FLOAT(k))
	766	ierr = NF_PUT_VARA_REAL (nid,id_NAT,debut,epais,phy_nat(1,k))
	767	ierr = NF_PUT_VARA_REAL (nid,id_SST,debut,epais,phy_sst(1,k))
	768	ierr = NF_PUT_VARA_REAL (nid,id_BILS,debut,epais,phy_bil(1,k))
	769	ierr = NF_PUT_VARA_REAL (nid,id_ALB,debut,epais,phy_alb(1,k))
	770	ierr = NF_PUT_VARA_REAL (nid,id_RUG,debut,epais,phy_rug(1,k))
	771	#endif
	772	c
	773	ENDDO
	774	c
	775	ierr = NF_CLOSE(nid)
	776	c
	777	STOP
	778	END

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

Download in other formats:

Original Format