Context Navigation

create_limit.F @ 92

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

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

Download in other formats:

Original Format