Context Navigation

← Previous Revision
Latest Revision
Next Revision →
Blame
Revision Log

create_limit.F @ 349

Last change on this file since 349 was 253, checked in by (none), 23 years ago
This commit was manufactured by cvs2svn to create branch 'rel-1-0-patch'.
Property svn:eol-style set to `native` Property svn:keywords set to `Author Date Id Revision`
File size: 22.8 KB

Line
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	#ifdef NC_DOUBLE
140	ierr = NF_GET_VAR_DOUBLE(ncid,dimid,dlon_msk)
141	#else
142	ierr = NF_GET_VAR_REAL(ncid,dimid,dlon_msk)
143	#endif
144
145	c
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
161	#ifdef NC_DOUBLE
162	ierr = NF_GET_VAR_DOUBLE(ncid,dimid,dlat_msk)
163	#else
164	ierr = NF_GET_VAR_REAL(ncid,dimid,dlat_msk)
165	#endif
166	c
167	if (ierr.ne.0) then
168	print *, NF_STRERROR(ierr)
169	STOP
170	ENDIF
171	#ifdef NC_DOUBLE
172	ierr = NF_GET_VAR_DOUBLE(ncid,varid,champ_msk)
173	#else
174	ierr = NF_GET_VAR_REAL(ncid,varid,champ_msk)
175	#endif
176	c
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
229	#ifdef NC_DOUBLE
230	ierr = NF_GET_VAR_DOUBLE(ncid,dimid,dlon)
231	#else
232	ierr = NF_GET_VAR_REAL(ncid,dimid,dlon)
233	#endif
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
249	#ifdef NC_DOUBLE
250	ierr = NF_GET_VAR_DOUBLE(ncid,dimid,dlat)
251	#else
252	ierr = NF_GET_VAR_REAL(ncid,dimid,dlat)
253	#endif
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
269	#ifdef NC_DOUBLE
270	ierr = NF_GET_VAR_DOUBLE(ncid,dimid,timecoord)
271	#else
272	ierr = NF_GET_VAR_REAL(ncid,dimid,timecoord)
273	#endif
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
290	#ifdef NC_DOUBLE
291	ierr = NF_GET_VARA_DOUBLE(ncid,varid,dimfirst,dimlast,champ)
292	#else
293	ierr = NF_GET_VARA_REAL(ncid,varid,dimfirst,dimlast,champ)
294	#endif
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
377	#ifdef NC_DOUBLE
378	ierr = NF_GET_VAR_DOUBLE(ncid,dimid,dlon)
379	#else
380	ierr = NF_GET_VAR_REAL(ncid,dimid,dlon)
381	#endif
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
397	#ifdef NC_DOUBLE
398	ierr = NF_GET_VAR_DOUBLE(ncid,dimid,dlat)
399	#else
400	ierr = NF_GET_VAR_REAL(ncid,dimid,dlat)
401	#endif
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
417	#ifdef NC_DOUBLE
418	ierr = NF_GET_VAR_DOUBLE(ncid,dimid,timecoord)
419	#else
420	ierr = NF_GET_VAR_REAL(ncid,dimid,timecoord)
421	#endif
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)
437	#ifdef NC_DOUBLE
438	ierr = NF_GET_VARA_DOUBLE(ncid,varid,dimfirst,dimlast,champ)
439	#else
440	ierr = NF_GET_VARA_REAL(ncid,varid,dimfirst,dimlast,champ)
441	#endif
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
530	#ifdef NC_DOUBLE
531	ierr = NF_GET_VAR_DOUBLE(ncid,dimid,dlon)
532	#else
533	ierr = NF_GET_VAR_REAL(ncid,dimid,dlon)
534	#endif
535
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
551	#ifdef NC_DOUBLE
552	ierr = NF_GET_VAR_DOUBLE(ncid,dimid,dlat)
553	#else
554	ierr = NF_GET_VAR_REAL(ncid,dimid,dlat)
555	#endif
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
571	#ifdef NC_DOUBLE
572	ierr = NF_GET_VAR_DOUBLE(ncid,dimid,timecoord)
573	#else
574	ierr = NF_GET_VAR_REAL(ncid,dimid,timecoord)
575	#endif
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)
591	#ifdef NC_DOUBLE
592	ierr = NF_GET_VARA_DOUBLE(ncid,varid,dimfirst,dimlast,champ)
593	#else
594	ierr = NF_GET_VARA_REAL(ncid,varid,dimfirst,dimlast,champ)
595	#endif
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
673	#ifdef NC_DOUBLE
674	ierr = NF_GET_VAR_DOUBLE(ncid,dimid,dlon)
675	#else
676	ierr = NF_GET_VAR_REAL(ncid,dimid,dlon)
677	#endif
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
693	#ifdef NC_DOUBLE
694	ierr = NF_GET_VAR_DOUBLE(ncid,dimid,dlat)
695	#else
696	ierr = NF_GET_VAR_REAL(ncid,dimid,dlat)
697	#endif
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
713	#ifdef NC_DOUBLE
714	ierr = NF_GET_VAR_DOUBLE(ncid,dimid,timecoord)
715	#else
716	ierr = NF_GET_VAR_REAL(ncid,dimid,timecoord)
717	#endif
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)
733	#ifdef NC_DOUBLE
734	ierr = NF_GET_VARA_DOUBLE(ncid,varid,dimfirst,dimlast,champ)
735	#else
736	ierr = NF_GET_VARA_REAL(ncid,varid,dimfirst,dimlast,champ)
737	#endif
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