Context Navigation

create_limit.F @ 3

Last change on this file since 3 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

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	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