source: LMDZ.3.3/trunk/libf/dyn3d/create_limit.F @ 1611

Last change on this file since 1611 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
Line 
1      PROGRAM create_limit
2      IMPLICIT none
3c
4c-------------------------------------------------------------
5C Author : L. Fairhead
6C Date   : 27/01/94
7C Objet  : Construction des fichiers de conditions aux limites
8C          pour le nouveau
9C          modele a partir de fichiers de climatologie. Les deux
10C          grilles doivent etre regulieres
11c
12c Modifie par z.x.li (le23mars1994)
13c Modifie par L. Fairhead (fairhead@lmd.jussieu.fr) septembre 1999
14c                         pour lecture netcdf dans LMDZ.3.3
15c-------------------------------------------------------------
16c
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"
25c
26c-----------------------------------------------------------------------
27      INTEGER KIDIA, KFDIA, KLON, KLEV
28      PARAMETER (KIDIA=1,KFDIA=iim*(jjm-1)+2,
29     .           KLON=KFDIA-KIDIA+1,KLEV=llm)
30c-----------------------------------------------------------------------
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)
37c
38      REAL masque(iip1,jjp1)
39      REAL mask(iim,jjp1)
40
41C 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)
49c
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
55C Declarations pour le champ interpole 2D
56      REAL champint(iim,jjp1)
57
58C Declarations pour le champ interpole 3D
59      REAL champtime(iim,jjp1,tbid)
60      REAL timeyear(tbid)
61      REAL champan(iip1,jjp1,366)
62
63C 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)
72c
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
79c 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
89c 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)
102c
103ccc      CALL iniconst ( non  indispensable )
104
105      CALL inigeom
106c
107c
108C Traitement du relief au sol
109c
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
145c
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
166c
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
176c
177      if (ierr.ne.0) then
178        print *, NF_STRERROR(ierr)
179        STOP
180      ENDIF
181
182c
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)
197c
198c
199C Traitement de la rugosite
200c
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
278c
279      DO l = 1, lmdep
280         dimfirst(1) = 1
281         dimfirst(2) = 1
282         dimfirst(3) = l
283c
284         dimlast(1) = imdep
285         dimlast(2) = jmdep
286         dimlast(3) = 1
287c
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
308c
309      DO l = 1, lmdep
310         timeyear(l) = timecoord(l)
311      ENDDO
312
313      PRINT 222, timeyear
314222   FORMAT(2x,' Time year ',10f6.1)
315c
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
339c
340      DO k = 1, 360
341         CALL gr_dyn_fi(1,iip1,jjp1,klon,champan(1,1,k), phy_rug(1,k))
342      ENDDO
343c
344      ierr = NF_CLOSE(ncid)
345c
346c
347C Traitement de la glace oceanique
348c
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
426c
427      DO l = 1, lmdep
428         dimfirst(1) = 1
429         dimfirst(2) = 1
430         dimfirst(3) = l
431c
432         dimlast(1) = imdep
433         dimlast(2) = jmdep
434         dimlast(3) = 1
435c
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
455c
456      DO l = 1, lmdep
457         timeyear(l) = timecoord(l)
458      ENDDO
459      PRINT 222,  timeyear
460c
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
481c
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
496c
497      ierr = NF_CLOSE(ncid)
498c
499c
500C Traitement de la sst
501c
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
580c
581      DO l = 1, lmdep
582         dimfirst(1) = 1
583         dimfirst(2) = 1
584         dimfirst(3) = l
585c
586         dimlast(1) = imdep
587         dimlast(2) = jmdep
588         dimlast(3) = 1
589c
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
609c
610      DO l = 1, lmdep
611         timeyear(l) = timecoord(l)
612      ENDDO
613      print 222,  timeyear
614c
615C 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
635c
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
640c
641      ierr = NF_CLOSE(ncid)
642c
643c
644C Traitement de l'albedo
645c
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
722c
723      DO l = 1, lmdep
724         dimfirst(1) = 1
725         dimfirst(2) = 1
726         dimfirst(3) = l
727c
728         dimlast(1) = imdep
729         dimlast(2) = jmdep
730         dimlast(3) = 1
731c
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)
744c
745         DO j = 1,jjp1
746         DO i = 1, iim
747            champtime (i, j, l) = champint(i, j)
748         ENDDO
749         ENDDO
750      ENDDO
751c
752      DO l = 1, lmdep
753         timeyear(l) = timecoord(l)
754      ENDDO
755      print 222,  timeyear
756c
757C 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
777c
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
782c
783      ierr = NF_CLOSE(ncid)
784c
785c
786      DO k = 1, 360
787      DO i = 1, klon
788         phy_bil(i,k) = 0.0
789      ENDDO
790      ENDDO
791c
792      PRINT*, 'Ecriture du fichier limit'
793c
794      ierr = NF_CREATE ("limit.nc", NF_CLOBBER, nid)
795c
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)
800c
801      dims(1) = ndim
802      dims(2) = ntim
803c
804ccc      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")
808ccc      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)")
812ccc      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")
816ccc      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")
820ccc      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")
824ccc      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")
828c
829      ierr = NF_ENDDEF(nid)
830c
831      DO k = 1, 360
832c
833      debut(1) = 1
834      debut(2) = k
835      epais(1) = klon
836      epais(2) = 1
837c
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
853c
854      ENDDO
855c
856      ierr = NF_CLOSE(nid)
857c
858      STOP
859      END
Note: See TracBrowser for help on using the repository browser.