source: LMDZ.3.3/branches/LF/libf/dyn3d/create_limit.F @ 1972

Last change on this file since 1972 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
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      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
166c
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)
181c
182c
183C Traitement de la rugosite
184c
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
250c
251      DO l = 1, lmdep
252         dimfirst(1) = 1
253         dimfirst(2) = 1
254         dimfirst(3) = l
255c
256         dimlast(1) = imdep
257         dimlast(2) = jmdep
258         dimlast(3) = 1
259c
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
276c
277      DO l = 1, lmdep
278         timeyear(l) = timecoord(l)
279      ENDDO
280
281      PRINT 222, timeyear
282222   FORMAT(2x,' Time year ',10f6.1)
283c
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
307c
308      DO k = 1, 360
309         CALL gr_dyn_fi(1,iip1,jjp1,klon,champan(1,1,k), phy_rug(1,k))
310      ENDDO
311c
312      ierr = NF_CLOSE(ncid)
313c
314c
315C Traitement de la glace oceanique
316c
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
382c
383      DO l = 1, lmdep
384         dimfirst(1) = 1
385         dimfirst(2) = 1
386         dimfirst(3) = l
387c
388         dimlast(1) = imdep
389         dimlast(2) = jmdep
390         dimlast(3) = 1
391c
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
407c
408      DO l = 1, lmdep
409         timeyear(l) = timecoord(l)
410      ENDDO
411      PRINT 222,  timeyear
412c
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
433c
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
448c
449      ierr = NF_CLOSE(ncid)
450c
451c
452C Traitement de la sst
453c
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
519c
520      DO l = 1, lmdep
521         dimfirst(1) = 1
522         dimfirst(2) = 1
523         dimfirst(3) = l
524c
525         dimlast(1) = imdep
526         dimlast(2) = jmdep
527         dimlast(3) = 1
528c
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
544c
545      DO l = 1, lmdep
546         timeyear(l) = timecoord(l)
547      ENDDO
548      print 222,  timeyear
549c
550C 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
570c
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
575c
576      ierr = NF_CLOSE(ncid)
577c
578c
579C Traitement de l'albedo
580c
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
645c
646      DO l = 1, lmdep
647         dimfirst(1) = 1
648         dimfirst(2) = 1
649         dimfirst(3) = l
650c
651         dimlast(1) = imdep
652         dimlast(2) = jmdep
653         dimlast(3) = 1
654c
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)
663c
664         DO j = 1,jjp1
665         DO i = 1, iim
666            champtime (i, j, l) = champint(i, j)
667         ENDDO
668         ENDDO
669      ENDDO
670c
671      DO l = 1, lmdep
672         timeyear(l) = timecoord(l)
673      ENDDO
674      print 222,  timeyear
675c
676C 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
696c
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
701c
702      ierr = NF_CLOSE(ncid)
703c
704c
705      DO k = 1, 360
706      DO i = 1, klon
707         phy_bil(i,k) = 0.0
708      ENDDO
709      ENDDO
710c
711      PRINT*, 'Ecriture du fichier limit'
712c
713      ierr = NF_CREATE ("limit.nc", NF_CLOBBER, nid)
714c
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)
719c
720      dims(1) = ndim
721      dims(2) = ntim
722c
723ccc      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")
727ccc      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)")
731ccc      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")
735ccc      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")
739ccc      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")
743ccc      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")
747c
748      ierr = NF_ENDDEF(nid)
749c
750      DO k = 1, 360
751c
752      debut(1) = 1
753      debut(2) = k
754      epais(1) = klon
755      epais(2) = 1
756c
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
772c
773      ENDDO
774c
775      ierr = NF_CLOSE(nid)
776c
777      STOP
778      END
Note: See TracBrowser for help on using the repository browser.