source: LMDZ4/branches/V3_test/libf/dyn3d/limit_netcdf.F @ 1270

Last change on this file since 1270 was 733, checked in by Laurent Fairhead, 18 years ago

Petit nettoyage
YM/LF

  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 36.5 KB
Line 
1!
2! $Header$
3!
4C
5C
6      SUBROUTINE limit_netcdf(interbar, extrap, oldice, masque, pctsrf)
7      USE dimphy
8      IMPLICIT none
9c
10c-------------------------------------------------------------
11C Author : L. Fairhead
12C Date   : 27/01/94
13C Objet  : Construction des fichiers de conditions aux limites
14C          pour le nouveau
15C          modele a partir de fichiers de climatologie. Les deux
16C          grilles doivent etre regulieres
17c
18c Modifie par z.x.li (le23mars1994)
19c Modifie par L. Fairhead (fairhead@lmd.jussieu.fr) septembre 1999
20c                         pour lecture netcdf dans LMDZ.3.3
21c Modifie par P;Le Van  ,  juillet 2001
22c-------------------------------------------------------------
23c
24#include "dimensions.h"
25#include "paramet.h"
26#include "control.h"
27#include "logic.h"
28#include "netcdf.inc"
29#include "comvert.h"
30#include "comgeom2.h"
31#include "comconst.h"
32cy#include "dimphy.h"
33#include "indicesol.h"
34c
35c-----------------------------------------------------------------------
36      LOGICAL interbar, extrap, oldice
37
38      REAL phy_nat(klon,360), phy_nat0(klon)
39      REAL phy_alb(klon,360)
40      REAL phy_sst(klon,360)
41      REAL phy_bil(klon,360)
42      REAL phy_rug(klon,360)
43      REAL phy_ice(klon)
44c
45      real pctsrf_t(klon,nbsrf,360)
46      real pctsrf(klon,nbsrf)
47      REAL verif
48
49      REAL masque(iip1,jjp1)
50      REAL mask(iim,jjp1)
51CPB
52C newlmt indique l'utilisation de la sous-maille fractionnelle
53C tandis que l'ancien codage utilise l'indicateur du sol (0,1,2,3)
54      LOGICAL newlmt, fracterre
55      PARAMETER(newlmt=.TRUE.)
56      PARAMETER(fracterre = .TRUE.)
57
58C Declarations pour le champ de depart
59      INTEGER imdep, jmdep,lmdep
60      INTEGER  tbid
61      PARAMETER ( tbid = 60 )        ! >52 semaines
62      REAL  timecoord(tbid)
63c
64      REAL , ALLOCATABLE :: dlon_msk(:), dlat_msk(:)
65      REAL , ALLOCATABLE :: lonmsk_ini(:), latmsk_ini(:)
66      REAL , ALLOCATABLE :: dlon(:), dlat(:)
67      REAL , ALLOCATABLE :: dlon_ini(:), dlat_ini(:)
68      REAL , ALLOCATABLE :: champ_msk(:), champ(:)
69      REAL , ALLOCATABLE :: work(:,:)
70
71      CHARACTER*25 title
72
73C Declarations pour le champ interpole 2D
74      REAL champint(iim,jjp1)
75      real chmin,chmax
76
77C Declarations pour le champ interpole 3D
78      REAL champtime(iim,jjp1,tbid)
79      REAL timeyear(tbid)
80      REAL champan(iip1,jjp1,366)
81
82C Declarations pour l'inteprolation verticale
83      REAL ax(tbid), ay(tbid)
84      REAL by
85      REAL yder(tbid)
86
87
88      INTEGER ierr
89      INTEGER dimfirst(3)
90      INTEGER dimlast(3)
91c
92      INTEGER nid, ndim, ntim
93      INTEGER dims(2), debut(2), epais(2)
94      INTEGER id_tim
95      INTEGER id_NAT, id_SST, id_BILS, id_RUG, id_ALB
96CPB
97      INTEGER id_FOCE, id_FSIC, id_FTER, id_FLIC
98
99      INTEGER i, j, k, l, ji
100c declarations pour lecture glace de mer
101      INTEGER :: iml_lic, jml_lic, llm_tmp, ttm_tmp, iret
102      INTEGER :: itaul(1), fid
103      REAL :: lev(1), date, dt
104      REAL, ALLOCATABLE, DIMENSION(:,:) :: lon_lic, lat_lic
105      REAL, ALLOCATABLE, DIMENSION(:)  :: dlon_lic, dlat_lic
106      REAL, ALLOCATABLE, DIMENSION (:,:) :: fraclic
107      REAL :: flic_tmp(iip1, jjp1)
108
109c Diverses variables locales
110      REAL time
111! pour la lecture du fichier masque ocean
112      integer :: nid_o2a
113      logical :: couple = .false.
114      INTEGER :: iml_omask, jml_omask
115      REAL, ALLOCATABLE, DIMENSION(:,:) :: lon_omask, lat_omask
116      REAL, ALLOCATABLE, DIMENSION(:)  :: dlon_omask, dlat_omask
117      REAL, ALLOCATABLE, DIMENSION (:,:) :: ocemask, ocetmp
118      real, dimension(klon) :: ocemask_fi
119
120      INTEGER          longcles
121      PARAMETER      ( longcles = 20 )
122      REAL  clesphy0 ( longcles      )
123#include "serre.h"
124      INTEGER ncid,varid,ndimid(4),dimid
125      character*30 namedim
126      CHARACTER*80 :: varname
127
128cIM28/02/2002 <== PM
129      REAL tmidmonth(12)
130      SAVE tmidmonth
131      DATA tmidmonth/15,45,75,105,135,165,195,225,255,285,315,345/
132
133c initialisations:
134      CALL conf_gcm( 99, .TRUE. , clesphy0 )
135
136
137      pi     = 4. * ATAN(1.)
138      rad    = 6 371 229.
139      omeg   = 4.* ASIN(1.)/(24.*3600.)
140      g      = 9.8
141      daysec = 86400.
142      kappa  = 0.2857143
143      cpp    = 1004.70885
144      dtvr    = daysec/FLOAT(day_step)
145      CALL inigeom
146c
147C Traitement du relief au sol
148c
149      write(*,*) 'Traitement du relief au sol pour fabriquer masque'
150      ierr = NF_OPEN('Relief.nc', NF_NOWRITE, ncid)
151
152      if (ierr.ne.0) then
153        print *, NF_STRERROR(ierr)
154        STOP
155      ENDIF
156
157      ierr = NF_INQ_VARID(ncid,'RELIEF',varid)
158      if (ierr.ne.0) then
159        print *, NF_STRERROR(ierr)
160        STOP
161      ENDIF
162      ierr = NF_INQ_VARDIMID (ncid,varid,ndimid)
163      if (ierr.ne.0) then
164        print *, NF_STRERROR(ierr)
165        STOP
166      ENDIF
167      ierr = NF_INQ_DIM(ncid,ndimid(1), namedim, imdep)
168      if (ierr.ne.0) then
169        print *, NF_STRERROR(ierr)
170        STOP
171      ENDIF
172      print*,'variable ', namedim, 'dimension ', imdep
173      ierr = NF_INQ_VARID(ncid,namedim,dimid)
174      if (ierr.ne.0) then
175        print *, NF_STRERROR(ierr)
176        STOP
177      ENDIF
178
179      ALLOCATE( lonmsk_ini(imdep) )
180      ALLOCATE(   dlon_msk(imdep) )
181
182#ifdef NC_DOUBLE
183      ierr = NF_GET_VAR_DOUBLE(ncid,dimid,lonmsk_ini)
184#else
185      ierr = NF_GET_VAR_REAL(ncid,dimid,lonmsk_ini)
186#endif
187
188c
189      if (ierr.ne.0) then
190        print *, NF_STRERROR(ierr)
191        STOP
192      ENDIF
193      ierr = NF_INQ_DIM(ncid,ndimid(2), namedim, jmdep)
194      if (ierr.ne.0) then
195        print *, NF_STRERROR(ierr)
196        STOP
197      ENDIF
198      print*,'variable ', namedim, 'dimension ', jmdep
199      ierr = NF_INQ_VARID(ncid,namedim,dimid)
200      if (ierr.ne.0) then
201        print *, NF_STRERROR(ierr)
202        STOP
203      ENDIF
204
205      ALLOCATE( latmsk_ini(jmdep) )
206      ALLOCATE(   dlat_msk(jmdep) )
207      ALLOCATE(  champ_msk(imdep*jmdep) )
208
209#ifdef NC_DOUBLE
210      ierr = NF_GET_VAR_DOUBLE(ncid,dimid,latmsk_ini)
211#else
212      ierr = NF_GET_VAR_REAL(ncid,dimid,latmsk_ini)
213#endif
214c
215      if (ierr.ne.0) then
216        print *, NF_STRERROR(ierr)
217        STOP
218      ENDIF
219#ifdef NC_DOUBLE
220      ierr = NF_GET_VAR_DOUBLE(ncid,varid,champ_msk)
221#else
222      ierr = NF_GET_VAR_REAL(ncid,varid,champ_msk)
223#endif
224c
225      if (ierr.ne.0) then
226        print *, NF_STRERROR(ierr)
227        STOP
228      ENDIF
229c
230      title='RELIEF'
231
232      CALL conf_dat2d(title,imdep, jmdep, lonmsk_ini, latmsk_ini,
233     . dlon_msk, dlat_msk, champ_msk, interbar  )
234
235      DO i = 1, iim
236      DO j = 1, jjp1
237         mask(i,j) = masque(i,j)
238      ENDDO
239      ENDDO
240      WRITE(*,*) 'MASK:'
241      WRITE(*,'(96i1)')INT(mask)     
242      ierr = NF_CLOSE(ncid)
243c
244c
245C Traitement de la rugosite
246c
247      PRINT*, 'Traitement de la rugosite'
248      ierr = NF_OPEN('Rugos.nc', NF_NOWRITE, ncid)
249      if (ierr.ne.0) then
250        print *, NF_STRERROR(ierr)
251        STOP
252      ENDIF
253
254      ierr = NF_INQ_VARID(ncid,'RUGOS',varid)
255      if (ierr.ne.0) then
256        print *, NF_STRERROR(ierr)
257        STOP
258      ENDIF
259      ierr = NF_INQ_VARDIMID (ncid,varid,ndimid)
260      if (ierr.ne.0) then
261        print *, NF_STRERROR(ierr)
262        STOP
263      ENDIF
264      ierr = NF_INQ_DIM(ncid,ndimid(1), namedim, imdep)
265      if (ierr.ne.0) then
266        print *, NF_STRERROR(ierr)
267        STOP
268      ENDIF
269      print*,'variable ', namedim, 'dimension ', imdep
270      ierr = NF_INQ_VARID(ncid,namedim,dimid)
271      if (ierr.ne.0) then
272        print *, NF_STRERROR(ierr)
273        STOP
274      ENDIF
275
276      ALLOCATE( dlon_ini(imdep) )
277      ALLOCATE(     dlon(imdep) )
278
279#ifdef NC_DOUBLE
280      ierr = NF_GET_VAR_DOUBLE(ncid,dimid,dlon_ini)
281#else
282      ierr = NF_GET_VAR_REAL(ncid,dimid,dlon_ini)
283#endif
284      if (ierr.ne.0) then
285        print *, NF_STRERROR(ierr)
286        STOP
287      ENDIF
288      ierr = NF_INQ_DIM(ncid,ndimid(2), namedim, jmdep)
289      if (ierr.ne.0) then
290        print *, NF_STRERROR(ierr)
291        STOP
292      ENDIF
293      print*,'variable ', namedim, 'dimension ', jmdep
294      ierr = NF_INQ_VARID(ncid,namedim,dimid)
295      if (ierr.ne.0) then
296        print *, NF_STRERROR(ierr)
297        STOP
298      ENDIF
299
300      ALLOCATE( dlat_ini(jmdep) )
301      ALLOCATE(     dlat(jmdep) )
302
303#ifdef NC_DOUBLE
304      ierr = NF_GET_VAR_DOUBLE(ncid,dimid,dlat_ini)
305#else
306      ierr = NF_GET_VAR_REAL(ncid,dimid,dlat_ini)
307#endif
308      if (ierr.ne.0) then
309        print *, NF_STRERROR(ierr)
310        STOP
311      ENDIF
312      ierr = NF_INQ_DIM(ncid,ndimid(3), namedim, lmdep)
313      if (ierr.ne.0) then
314        print *, NF_STRERROR(ierr)
315        STOP
316      ENDIF
317      print*,'variable ', namedim, 'dimension ', lmdep
318      ierr = NF_INQ_VARID(ncid,namedim,dimid)
319      if (ierr.ne.0) then
320        print *, NF_STRERROR(ierr)
321        STOP
322      ENDIF
323#ifdef NC_DOUBLE
324      ierr = NF_GET_VAR_DOUBLE(ncid,dimid,timecoord)
325#else
326      ierr = NF_GET_VAR_REAL(ncid,dimid,timecoord)
327#endif
328      if (ierr.ne.0) then
329        print *, NF_STRERROR(ierr)
330        STOP
331      ENDIF
332c
333      ALLOCATE( champ(imdep*jmdep) )
334
335      DO  200 l = 1, lmdep
336         dimfirst(1) = 1
337         dimfirst(2) = 1
338         dimfirst(3) = l
339c
340         dimlast(1) = imdep
341         dimlast(2) = jmdep
342         dimlast(3) = 1
343c
344         PRINT*,'Lecture temporelle et int. horizontale ',l,timecoord(l)
345         print*,dimfirst,dimlast
346#ifdef NC_DOUBLE
347         ierr = NF_GET_VARA_DOUBLE(ncid,varid,dimfirst,dimlast,champ)
348#else
349         ierr = NF_GET_VARA_REAL(ncid,varid,dimfirst,dimlast,champ)
350#endif
351         if (ierr.ne.0) then
352           print *, NF_STRERROR(ierr)
353           STOP
354         ENDIF
355   
356        title = 'Rugosite Amip '
357c
358        CALL conf_dat2d(title,imdep, jmdep, dlon_ini, dlat_ini,
359     .                      dlon, dlat, champ, interbar          )
360
361       IF ( interbar )   THEN
362         DO j = 1, imdep * jmdep
363           champ(j) = LOG(champ(j))
364         ENDDO
365
366        IF( l.EQ.1 )  THEN
367         WRITE(6,*) '-------------------------------------------------',
368     ,'------------------------'
369         WRITE(6,*) '$$$ Utilisation de l interpolation barycentrique ',
370     , ' pour la rugosite $$$ '
371         WRITE(6,*) '-------------------------------------------------',
372     ,'------------------------'
373        ENDIF
374        CALL inter_barxy ( imdep,jmdep -1,dlon,dlat,champ ,
375     ,                  iim,jjm,rlonu,rlatv, jjp1,champint )
376         DO j=1,jjp1
377          DO i=1,iim
378           champint(i,j)=EXP(champint(i,j))
379          ENDDO
380         ENDDO
381
382         DO j = 1, jjp1
383           DO i = 1, iim
384             IF(NINT(mask(i,j)).NE.1)  THEN
385               champint( i,j ) = 0.001
386             ENDIF
387           ENDDO
388         ENDDO
389      ELSE
390         CALL rugosite(imdep, jmdep, dlon, dlat, champ,
391     .             iim, jjp1, rlonv, rlatu, champint, mask)
392      ENDIF
393         DO j = 1,jjp1
394         DO i = 1, iim
395            champtime (i,j,l) = champint(i,j)
396         ENDDO
397         ENDDO
398200      CONTINUE
399c
400      DO l = 1, lmdep
401         timeyear(l) = timecoord(l)
402      ENDDO
403
404      PRINT 222, timeyear
405222   FORMAT(2x,' Time year ',10f6.1)
406c
407       
408      PRINT*, 'Interpolation temporelle dans l annee'
409
410      DO j = 1, jjp1
411      DO i = 1, iim
412          DO l = 1, lmdep
413            ax(l) = timeyear(l)
414            ay(l) = champtime (i,j,l)
415          ENDDO
416          CALL SPLINE(ax,ay,lmdep,1.e30,1.e30,yder)
417          DO k = 1, 360
418            time = FLOAT(k-1)
419            CALL SPLINT(ax,ay,yder,lmdep,time,by)
420            champan(i,j,k) = by
421          ENDDO
422      ENDDO
423      ENDDO
424      DO k = 1, 360
425      DO j = 1, jjp1
426         champan(iip1,j,k) = champan(1,j,k)
427      ENDDO
428        IF ( k.EQ.10 )  THEN
429          DO j = 1, jjp1
430            CALL minmax( iip1,champan(1,j,10),chmin,chmax )
431            PRINT *,' Rugosite au temps 10 ', chmin,chmax,j
432          ENDDO
433        ENDIF
434      ENDDO
435c
436      DO k = 1, 360
437         CALL gr_dyn_fi(1,iip1,jjp1,klon,champan(1,1,k), phy_rug(1,k))
438      ENDDO
439c
440      ierr = NF_CLOSE(ncid)
441
442       DEALLOCATE( dlon      )
443       DEALLOCATE( dlon_ini  )
444       DEALLOCATE( dlat      )
445       DEALLOCATE( dlat_ini  )
446       DEALLOCATE( champ     )
447c
448c
449C Traitement de la glace oceanique
450c
451      PRINT*, 'Traitement de la glace oceanique'
452
453      ierr = NF_OPEN('amipbc_sic_1x1.nc', NF_NOWRITE, ncid)
454      if (ierr.ne.0) THEN
455        ierr = NF_OPEN('amipbc_sic_1x1_clim.nc', NF_NOWRITE, ncid)
456        if (ierr.ne.0) THEN
457          print *, NF_STRERROR(ierr)
458          STOP
459        endif
460      ENDIF
461
462cIM22/02/2002
463cIM07/03/2002 AMIP.nc & amip79to95.nc
464cIM   ierr = NF_INQ_VARID(ncid,'SEA_ICE',varid)
465cIM07/03/2002 amipbc_sic_1x1_clim.nc & amipbc_sic_1x1.nc
466      ierr = NF_INQ_VARID(ncid,'sicbcs',varid)
467cIM22/02/2002
468      if (ierr.ne.0) then
469        print *, NF_STRERROR(ierr),'sicbcs'
470        STOP
471      ENDIF
472      ierr = NF_INQ_VARDIMID (ncid,varid,ndimid)
473      if (ierr.ne.0) then
474        print *, NF_STRERROR(ierr)
475        STOP
476      ENDIF
477      ierr = NF_INQ_DIM(ncid,ndimid(1), namedim, imdep)
478      if (ierr.ne.0) then
479        print *, NF_STRERROR(ierr)
480        STOP
481      ENDIF
482      print*,'variable ', namedim, 'dimension ', imdep
483      ierr = NF_INQ_VARID(ncid,namedim,dimid)
484      if (ierr.ne.0) then
485        print *, NF_STRERROR(ierr)
486        STOP
487      ENDIF
488
489      ALLOCATE ( dlon_ini(imdep) )
490      ALLOCATE (     dlon(imdep) )
491
492#ifdef NC_DOUBLE
493      ierr = NF_GET_VAR_DOUBLE(ncid,dimid,dlon_ini)
494#else
495      ierr = NF_GET_VAR_REAL(ncid,dimid,dlon_ini)
496#endif
497      if (ierr.ne.0) then
498        print *, NF_STRERROR(ierr)
499        STOP
500      ENDIF
501      ierr = NF_INQ_DIM(ncid,ndimid(2), namedim, jmdep)
502      if (ierr.ne.0) then
503        print *, NF_STRERROR(ierr)
504        STOP
505      ENDIF
506      print*,'variable ', namedim, jmdep
507      ierr = NF_INQ_VARID(ncid,namedim,dimid)
508      if (ierr.ne.0) then
509        print *, NF_STRERROR(ierr)
510        STOP
511      ENDIF
512
513      ALLOCATE ( dlat_ini(jmdep) )
514      ALLOCATE (     dlat(jmdep) )
515
516#ifdef NC_DOUBLE
517      ierr = NF_GET_VAR_DOUBLE(ncid,dimid,dlat_ini)
518#else
519      ierr = NF_GET_VAR_REAL(ncid,dimid,dlat_ini)
520#endif
521      if (ierr.ne.0) then
522        print *, NF_STRERROR(ierr)
523        STOP
524      ENDIF
525      ierr = NF_INQ_DIM(ncid,ndimid(3), namedim, lmdep)
526      if (ierr.ne.0) then
527        print *, NF_STRERROR(ierr)
528        STOP
529      ENDIF
530      print*,'variable ', namedim, lmdep
531cIM28/02/2002
532cPM28/02/2002 : nouvelle coord temporelle fichiers AMIP pas en jours
533c               Ici on suppose qu'on a 12 mois (de 30 jours).
534      IF (lmdep.NE.12) THEN
535          print *, 'Unknown AMIP file: not 12 months ?'
536          STOP
537       ENDIF
538cIM28/02/2002
539      ierr = NF_INQ_VARID(ncid,namedim,dimid)
540      if (ierr.ne.0) then
541        print *, NF_STRERROR(ierr)
542        STOP
543      ENDIF
544#ifdef NC_DOUBLE
545      ierr = NF_GET_VAR_DOUBLE(ncid,dimid,timecoord)
546#else
547      ierr = NF_GET_VAR_REAL(ncid,dimid,timecoord)
548#endif
549      if (ierr.ne.0) then
550        print *, NF_STRERROR(ierr)
551        STOP
552      ENDIF
553c
554      ALLOCATE ( champ(imdep*jmdep) )
555
556      DO l = 1, lmdep
557         dimfirst(1) = 1
558         dimfirst(2) = 1
559         dimfirst(3) = l
560c
561         dimlast(1) = imdep
562         dimlast(2) = jmdep
563         dimlast(3) = 1
564c
565         PRINT*,'Lecture temporelle et int. horizontale ',l,timecoord(l)
566#ifdef NC_DOUBLE
567         ierr = NF_GET_VARA_DOUBLE(ncid,varid,dimfirst,dimlast,champ)
568#else
569         ierr = NF_GET_VARA_REAL(ncid,varid,dimfirst,dimlast,champ)
570#endif
571         if (ierr.ne.0) then
572           print *, NF_STRERROR(ierr)
573           STOP
574         ENDIF
575 
576         title = 'Sea-ice Amip '
577c
578         CALL conf_dat2d(title,imdep, jmdep, dlon_ini, dlat_ini,
579     .                        dlon, dlat, champ, interbar          )
580c
581      IF( oldice )  THEN
582                 CALL sea_ice(imdep, jmdep, dlon, dlat, champ,
583     .             iim, jjp1, rlonv, rlatu, champint )
584      ELSEIF ( interbar )  THEN
585       IF( l.EQ.1 )  THEN
586        WRITE(6,*) '-------------------------------------------------',
587     ,'------------------------'
588        WRITE(6,*) '$$$ Utilisation de l interpolation barycentrique ',
589     , ' pour Sea-ice Amip  $$$ '
590        WRITE(6,*) '-------------------------------------------------',
591     ,'------------------------'
592       ENDIF
593cIM07/03/2002
594cIM22/02/2002 : Sea-ice Amip entre 0. et 1.
595cIM    PRINT*,'SUB. limit_netcdf.F IM : Sea-ice et SST Amip_new clim'
596cIM   DO j = 1, imdep * jmdep
597cIM28/02/2002 <==PM         champ(j) = champ(j)/100.
598cIM14/03/2002      champ(j) = max(0.0,(min(1.0, (champ(j)/100.) )))
599cIM      champ(j) = amax1(0.0,(amin1(1.0, (champ(j)/100.) )))
600cIM   ENDDO
601cIM22/02/2002
602         CALL inter_barxy ( imdep,jmdep -1,dlon, dlat ,
603     ,     champ, iim, jjm, rlonu, rlatv, jjp1, champint )
604      ELSE
605         CALL sea_ice(imdep, jmdep, dlon, dlat, champ,
606     .             iim, jjp1, rlonv, rlatu, champint )
607      ENDIF
608         DO j = 1,jjp1
609         DO i = 1, iim
610            champtime (i,j,l) = champint(i,j)
611         ENDDO
612         ENDDO
613      ENDDO
614c
615      DO l = 1, lmdep
616cIM28/02/2002 <== PM  timeyear(l) = timecoord(l)
617cIM      timeyear(l) = timecoord(l)
618cIM07/03/2002     
619         timeyear(l) = tmidmonth(l)
620      ENDDO
621      PRINT 222,  timeyear
622c
623      PRINT*, 'Interpolation temporelle'
624      DO j = 1, jjp1
625      DO i = 1, iim
626          DO l = 1, lmdep
627            ax(l) = timeyear(l)
628            ay(l) = champtime (i,j,l)
629          ENDDO
630          CALL SPLINE(ax,ay,lmdep,1.e30,1.e30,yder)
631          DO k = 1, 360
632            time = FLOAT(k-1)
633            CALL SPLINT(ax,ay,yder,lmdep,time,by)
634            champan(i,j,k) = by
635          ENDDO
636      ENDDO
637      ENDDO
638      DO k = 1, 360
639      DO j = 1, jjp1
640         champan(iip1, j, k) = champan(1, j, k)
641      ENDDO
642        IF ( k.EQ.10 )  THEN
643          DO j = 1, jjp1
644            CALL minmax( iip1,champan(1,j,10),chmin,chmax )
645            PRINT *,' Sea ice au temps 10 ', chmin,chmax,j
646          ENDDO
647        ENDIF
648      ENDDO
649c
650cIM14/03/2002 : Sea-ice Amip entre 0. et 1.
651      PRINT*,'SUB. limit_netcdf.F IM : Sea-ice Amipbc '
652      DO k = 1, 360
653      DO j = 1, jjp1
654      DO i = 1, iim
655        champan(i, j, k) =
656     $ amax1(0.0,(amin1(1.0,(champan(i, j, k)/100.))))
657      ENDDO
658        champan(iip1, j, k) = champan(1, j, k)
659      ENDDO
660      ENDDO
661cIM14/03/2002
662
663      DO k = 1, 360
664         CALL gr_dyn_fi(1, iip1, jjp1, klon,
665     .                  champan(1,1,k), phy_ice)
666        IF ( newlmt) THEN
667
668CPB  en attendant de mettre fraction de terre
669c
670          WHERE(phy_ice(1:klon) .GE. 1.) phy_ice(1 : klon) = 1.
671          WHERE(phy_ice(1:klon) .LT. EPSFRA) phy_ice(1 : klon) = 0.
672c
673          IF (fracterre ) THEN
674c            WRITE(*,*) 'passe dans cas fracterre'
675            pctsrf_t(:,is_ter,k) = pctsrf(:,is_ter)
676            pctsrf_t(:,is_lic,k) = pctsrf(:,is_lic)
677            pctsrf_t(1:klon,is_sic,k) =   phy_ice(1:klon)
678     $            - pctsrf_t(1:klon,is_lic,k)
679c Il y a des cas ou il y a de la glace dans landiceref et pas dans AMIP
680            WHERE (pctsrf_t(1:klon,is_sic,k) .LE. 0)
681              pctsrf_t(1:klon,is_sic,k) = 0.
682            END WHERE
683            WHERE( 1. - zmasq(1:klon) .LT. EPSFRA)
684              pctsrf_t(1:klon,is_sic,k) = 0.
685              pctsrf_t(1:klon,is_oce,k) = 0.
686            END WHERE
687            DO i = 1, klon
688              IF ( 1. - zmasq(i) .GT. EPSFRA) THEN
689                IF ( pctsrf_t(i,is_sic,k) .GE. 1 - zmasq(i)) THEN
690                  pctsrf_t(i,is_sic,k) = 1 - zmasq(i)
691                  pctsrf_t(i,is_oce,k) = 0.
692                ELSE
693                  pctsrf_t(i,is_oce,k) = 1 - zmasq(i)
694     $                    - pctsrf_t(i,is_sic,k)
695                  IF (pctsrf_t(i,is_oce,k) .LT. EPSFRA) THEN
696                    pctsrf_t(i,is_oce,k) = 0.
697                    pctsrf_t(i,is_sic,k) = 1 - zmasq(i)
698                  ENDIF
699                ENDIF
700              ENDIF 
701              if (pctsrf_t(i,is_oce,k) .lt. 0.) then
702                WRITE(*,*) 'pb sous maille au point : i,k '
703     $              , i,k,pctsrf_t(:,is_oce,k)
704              ENDIF
705              IF ( abs( pctsrf_t(i, is_ter,k) + pctsrf_t(i, is_lic,k) +
706     $          pctsrf_t(i, is_oce,k) + pctsrf_t(i, is_sic,k)  - 1.)
707     $            .GT. EPSFRA) THEN
708                  WRITE(*,*) 'physiq : pb sous surface au point ', i,
709     $                pctsrf_t(i, 1 : nbsrf,k), phy_ice(i)
710              ENDIF
711            END DO
712          ELSE
713            DO i = 1, klon
714              pctsrf_t(i,is_ter,k) = pctsrf(i,is_ter)
715              IF (NINT(pctsrf(i,is_ter)).EQ.1 ) THEN
716                pctsrf_t(i,is_sic,k) = 0.
717                pctsrf_t(i,is_oce,k) = 0.                 
718                IF(phy_ice(i) .GE. 1.e-5) THEN
719                  pctsrf_t(i,is_lic,k) = phy_ice(i)
720                  pctsrf_t(i,is_ter,k) = pctsrf_t(i,is_ter,k)
721     .                                   - pctsrf_t(i,is_lic,k)
722                ELSE
723                  pctsrf_t(i,is_lic,k) = 0.
724                ENDIF
725              ELSE
726                pctsrf_t(i,is_lic,k) = 0.
727                IF(phy_ice(i) .GE. 1.e-5) THEN
728                  pctsrf_t(i,is_ter,k) = 0.
729                  pctsrf_t(i,is_sic,k) = phy_ice(i)
730                  pctsrf_t(i,is_oce,k) = 1. - pctsrf_t(i,is_sic,k)
731                ELSE
732                  pctsrf_t(i,is_sic,k) = 0.
733                  pctsrf_t(i,is_oce,k) = 1.                     
734                ENDIF
735              ENDIF
736              verif = pctsrf_t(i,is_ter,k) +
737     .                pctsrf_t(i,is_oce,k) +
738     .                pctsrf_t(i,is_sic,k) +
739     .                pctsrf_t(i,is_lic,k)
740              IF ( verif .LT. 1. - 1.e-5 .OR.
741     $             verif .GT. 1 + 1.e-5) THEN 
742                WRITE(*,*) 'pb sous maille au point : i,k,verif '
743     $                    , i,k,verif
744              ENDIF
745            END DO
746          ENDIF
747        ELSE 
748          DO i = 1, klon
749            phy_nat(i,k) = phy_nat0(i)
750            IF ( (phy_ice(i) - 0.5).GE.1.e-5 ) THEN
751              IF (NINT(phy_nat0(i)).EQ.0) THEN
752                phy_nat(i,k) = 3.0
753              ELSE
754                phy_nat(i,k) = 2.0
755              ENDIF
756            ENDIF
757            IF( NINT(phy_nat(i,k)).EQ.0 ) THEN
758              IF ( phy_rug(i,k).NE.0.001 ) phy_rug(i,k) = 0.001
759            ENDIF
760          END DO
761        ENDIF
762      ENDDO
763c
764
765      ierr = NF_CLOSE(ncid)
766c
767       DEALLOCATE( dlon      )
768       DEALLOCATE( dlon_ini  )
769       DEALLOCATE( dlat      )
770       DEALLOCATE( dlat_ini  )
771       DEALLOCATE( champ     )
772
773477    continue
774c
775C Traitement de la sst
776c
777      PRINT*, 'Traitement de la sst'
778c     ierr = NF_OPEN('AMIP_SST.nc', NF_NOWRITE, ncid)
779      ierr = NF_OPEN('amipbc_sst_1x1.nc', NF_NOWRITE, ncid)
780      if (ierr.ne.0) THEN
781        ierr = NF_OPEN('amipbc_sst_1x1_clim.nc', NF_NOWRITE, ncid)
782        if (ierr.ne.0) THEN
783          print *, NF_STRERROR(ierr)
784          STOP
785        endif
786      ENDIF
787
788cIM22/02/2002
789cIM   ierr = NF_INQ_VARID(ncid,'SST',varid)
790      ierr = NF_INQ_VARID(ncid,'tosbcs',varid)
791cIM22/02/2002
792      if (ierr.ne.0) then
793        print *, NF_STRERROR(ierr)
794        STOP
795      ENDIF
796      ierr = NF_INQ_VARDIMID (ncid,varid,ndimid)
797      if (ierr.ne.0) then
798        print *, NF_STRERROR(ierr)
799        STOP
800      ENDIF
801      ierr = NF_INQ_DIM(ncid,ndimid(1), namedim, imdep)
802      if (ierr.ne.0) then
803        print *, NF_STRERROR(ierr)
804        STOP
805      ENDIF
806      print*,'variable SST ', namedim,'dimension ', imdep
807      ierr = NF_INQ_VARID(ncid,namedim,dimid)
808      if (ierr.ne.0) then
809        print *, NF_STRERROR(ierr)
810        STOP
811      ENDIF
812 
813      ALLOCATE( dlon_ini(imdep) )
814      ALLOCATE(     dlon(imdep) )
815
816#ifdef NC_DOUBLE
817      ierr = NF_GET_VAR_DOUBLE(ncid,dimid,dlon_ini)
818#else
819      ierr = NF_GET_VAR_REAL(ncid,dimid,dlon_ini)
820#endif
821
822      if (ierr.ne.0) then
823        print *, NF_STRERROR(ierr)
824        STOP
825      ENDIF
826      ierr = NF_INQ_DIM(ncid,ndimid(2), namedim, jmdep)
827      if (ierr.ne.0) then
828        print *, NF_STRERROR(ierr)
829        STOP
830      ENDIF
831      print*,'variable SST ', namedim, 'dimension ', jmdep
832      ierr = NF_INQ_VARID(ncid,namedim,dimid)
833      if (ierr.ne.0) then
834        print *, NF_STRERROR(ierr)
835        STOP
836      ENDIF
837
838      ALLOCATE( dlat_ini(jmdep) )
839      ALLOCATE(     dlat(jmdep) )
840
841#ifdef NC_DOUBLE
842      ierr = NF_GET_VAR_DOUBLE(ncid,dimid,dlat_ini)
843#else
844      ierr = NF_GET_VAR_REAL(ncid,dimid,dlat_ini)
845#endif
846      if (ierr.ne.0) then
847        print *, NF_STRERROR(ierr)
848        STOP
849      ENDIF
850      ierr = NF_INQ_DIM(ncid,ndimid(3), namedim, lmdep)
851      if (ierr.ne.0) then
852        print *, NF_STRERROR(ierr)
853        STOP
854      ENDIF
855      print*,'variable ', namedim, 'dimension ', lmdep
856cIM28/02/2002
857cPM28/02/2002 : nouvelle coord temporelle fichiers AMIP pas en jours
858c               Ici on suppose qu'on a 12 mois (de 30 jours).
859      IF (lmdep.NE.12) THEN
860          print *, 'Unknown AMIP file: not 12 months ?'
861          STOP
862       ENDIF
863cIM28/02/2002
864      ierr = NF_INQ_VARID(ncid,namedim,dimid)
865      if (ierr.ne.0) then
866        print *, NF_STRERROR(ierr)
867        STOP
868      ENDIF
869#ifdef NC_DOUBLE
870      ierr = NF_GET_VAR_DOUBLE(ncid,dimid,timecoord)
871#else
872      ierr = NF_GET_VAR_REAL(ncid,dimid,timecoord)
873#endif
874      if (ierr.ne.0) then
875        print *, NF_STRERROR(ierr)
876        STOP
877      ENDIF
878
879       ALLOCATE( champ(imdep*jmdep) )
880       IF( extrap )   THEN
881         ALLOCATE ( work(imdep,jmdep) )
882       ENDIF
883c
884      DO l = 1, lmdep
885         dimfirst(1) = 1
886         dimfirst(2) = 1
887         dimfirst(3) = l
888c
889         dimlast(1) = imdep
890         dimlast(2) = jmdep
891         dimlast(3) = 1
892c
893         PRINT*,'Lecture temporelle et int. horizontale ',l,timecoord(l)
894#ifdef NC_DOUBLE
895         ierr = NF_GET_VARA_DOUBLE(ncid,varid,dimfirst,dimlast,champ)
896#else
897         ierr = NF_GET_VARA_REAL(ncid,varid,dimfirst,dimlast,champ)
898#endif
899         if (ierr.ne.0) then
900           print *, NF_STRERROR(ierr)
901           STOP
902         ENDIF
903
904         title='Sst Amip'
905c
906         CALL conf_dat2d(title,imdep, jmdep, dlon_ini, dlat_ini,
907     .                            dlon, dlat, champ, interbar     )
908       IF ( extrap )  THEN
909        CALL extrapol(champ, imdep, jmdep, 999999.,.TRUE.,.TRUE.,2,work)
910       ENDIF
911c
912
913      IF ( interbar )  THEN
914        IF( l.EQ.1 )  THEN
915         WRITE(6,*) '-------------------------------------------------',
916     ,'------------------------'
917         WRITE(6,*) '$$$ Utilisation de l interpolation barycentrique ',
918     , ' pour la Sst Amip $$$ '
919         WRITE(6,*) '-------------------------------------------------',
920     ,'------------------------'
921        ENDIF
922       CALL inter_barxy ( imdep,jmdep -1,dlon, dlat ,
923     , champ, iim, jjm, rlonu, rlatv, jjp1, champint )
924      ELSE
925       CALL grille_m(imdep, jmdep, dlon, dlat, champ,
926     .          iim, jjp1, rlonv, rlatu, champint   )
927      ENDIF
928
929         DO j = 1,jjp1
930         DO i = 1, iim
931            champtime (i,j,l) = champint(i,j)
932         ENDDO
933         ENDDO
934      ENDDO
935c
936      DO l = 1, lmdep
937cIM28/02/2002 <==PM  timeyear(l) = timecoord(l)
938         timeyear(l) = tmidmonth(l)
939      ENDDO
940      print 222,  timeyear
941c
942C interpolation temporelle
943      DO j = 1, jjp1
944      DO i = 1, iim
945          DO l = 1, lmdep
946            ax(l) = timeyear(l)
947            ay(l) = champtime (i,j,l)
948          ENDDO
949          CALL SPLINE(ax,ay,lmdep,1.e30,1.e30,yder)
950          DO k = 1, 360
951            time = FLOAT(k-1)
952            CALL SPLINT(ax,ay,yder,lmdep,time,by)
953            champan(i,j,k) = by
954          ENDDO
955      ENDDO
956      ENDDO
957      DO k = 1, 360
958      DO j = 1, jjp1
959         champan(iip1,j,k) = champan(1,j,k)
960      ENDDO
961        IF ( k.EQ.10 )  THEN
962          DO j = 1, jjp1
963            CALL minmax( iip1,champan(1,j,10),chmin,chmax )
964            PRINT *,' SST au temps 10 ', chmin,chmax,j
965          ENDDO
966        ENDIF
967      ENDDO
968c
969cIM14/03/2002 : SST amipbc greater then 271.38
970      PRINT*,'SUB. limit_netcdf.F IM : SST Amipbc >= 271.38 '
971      DO k = 1, 360
972      DO j = 1, jjp1
973      DO i = 1, iim
974         champan(i, j, k) = amax1(champan(i, j, k), 271.38)
975      ENDDO
976         champan(iip1, j, k) = champan(1, j, k)
977      ENDDO
978      ENDDO
979cIM14/03/2002
980      DO k = 1, 360
981         CALL gr_dyn_fi(1, iip1, jjp1, klon,
982     .                  champan(1,1,k), phy_sst(1,k))
983      ENDDO
984c
985      ierr = NF_CLOSE(ncid)
986c
987       DEALLOCATE( dlon      )
988       DEALLOCATE( dlon_ini  )
989       DEALLOCATE( dlat      )
990       DEALLOCATE( dlat_ini  )
991       DEALLOCATE( champ     )
992c
993C Traitement de l'albedo
994c
995      PRINT*, 'Traitement de l albedo'
996      ierr = NF_OPEN('Albedo.nc', NF_NOWRITE, ncid)
997      if (ierr.ne.0) then
998        print *, NF_STRERROR(ierr)
999        STOP
1000      ENDIF
1001      ierr = NF_INQ_VARID(ncid,'ALBEDO',varid)
1002      if (ierr.ne.0) then
1003        print *, NF_STRERROR(ierr)
1004        STOP
1005      ENDIF
1006      ierr = NF_INQ_VARDIMID (ncid,varid,ndimid)
1007      if (ierr.ne.0) then
1008        print *, NF_STRERROR(ierr)
1009        STOP
1010      ENDIF
1011      ierr = NF_INQ_DIM(ncid,ndimid(1), namedim, imdep)
1012      if (ierr.ne.0) then
1013        print *, NF_STRERROR(ierr)
1014        STOP
1015      ENDIF
1016      print*,'variable ', namedim, 'dimension ', imdep
1017      ierr = NF_INQ_VARID(ncid,namedim,dimid)
1018      if (ierr.ne.0) then
1019        print *, NF_STRERROR(ierr)
1020        STOP
1021      ENDIF
1022
1023      ALLOCATE ( dlon_ini(imdep) )
1024      ALLOCATE (     dlon(imdep) )
1025
1026#ifdef NC_DOUBLE
1027      ierr = NF_GET_VAR_DOUBLE(ncid,dimid,dlon_ini)
1028#else
1029      ierr = NF_GET_VAR_REAL(ncid,dimid,dlon_ini)
1030#endif
1031      if (ierr.ne.0) then
1032        print *, NF_STRERROR(ierr)
1033        STOP
1034      ENDIF
1035      ierr = NF_INQ_DIM(ncid,ndimid(2), namedim, jmdep)
1036      if (ierr.ne.0) then
1037        print *, NF_STRERROR(ierr)
1038        STOP
1039      ENDIF
1040      print*,'variable ', namedim, 'dimension ', jmdep
1041      ierr = NF_INQ_VARID(ncid,namedim,dimid)
1042      if (ierr.ne.0) then
1043        print *, NF_STRERROR(ierr)
1044        STOP
1045      ENDIF
1046
1047      ALLOCATE ( dlat_ini(jmdep) )
1048      ALLOCATE (     dlat(jmdep) )
1049
1050#ifdef NC_DOUBLE
1051      ierr = NF_GET_VAR_DOUBLE(ncid,dimid,dlat_ini)
1052#else
1053      ierr = NF_GET_VAR_REAL(ncid,dimid,dlat_ini)
1054#endif
1055      if (ierr.ne.0) then
1056        print *, NF_STRERROR(ierr)
1057        STOP
1058      ENDIF
1059      ierr = NF_INQ_DIM(ncid,ndimid(3), namedim, lmdep)
1060      if (ierr.ne.0) then
1061        print *, NF_STRERROR(ierr)
1062        STOP
1063      ENDIF
1064      print*,'variable ', namedim, 'dimension ', lmdep
1065      ierr = NF_INQ_VARID(ncid,namedim,dimid)
1066      if (ierr.ne.0) then
1067        print *, NF_STRERROR(ierr)
1068        STOP
1069      ENDIF
1070#ifdef NC_DOUBLE
1071      ierr = NF_GET_VAR_DOUBLE(ncid,dimid,timecoord)
1072#else
1073      ierr = NF_GET_VAR_REAL(ncid,dimid,timecoord)
1074#endif
1075      if (ierr.ne.0) then
1076        print *, NF_STRERROR(ierr)
1077        STOP
1078      ENDIF
1079c
1080      ALLOCATE ( champ(imdep*jmdep) )
1081
1082      DO l = 1, lmdep
1083         dimfirst(1) = 1
1084         dimfirst(2) = 1
1085         dimfirst(3) = l
1086c
1087         dimlast(1) = imdep
1088         dimlast(2) = jmdep
1089         dimlast(3) = 1
1090c
1091         PRINT*,'Lecture temporelle et int. horizontale ',l,timecoord(l)
1092#ifdef NC_DOUBLE
1093         ierr = NF_GET_VARA_DOUBLE(ncid,varid,dimfirst,dimlast,champ)
1094#else
1095         ierr = NF_GET_VARA_REAL(ncid,varid,dimfirst,dimlast,champ)
1096#endif
1097         if (ierr.ne.0) then
1098           print *, NF_STRERROR(ierr)
1099           STOP
1100         ENDIF
1101
1102         title='Albedo Amip'
1103c
1104         CALL conf_dat2d(title,imdep, jmdep, dlon_ini, dlat_ini,
1105     .                            dlon, dlat, champ, interbar      )
1106c
1107c
1108      IF ( interbar )  THEN
1109        IF( l.EQ.1 )  THEN
1110         WRITE(6,*) '-------------------------------------------------',
1111     ,'------------------------'
1112         WRITE(6,*) '$$$ Utilisation de l interpolation barycentrique ',
1113     , ' pour l Albedo Amip $$$ '
1114         WRITE(6,*) '-------------------------------------------------',
1115     ,'------------------------'
1116        ENDIF
1117
1118       CALL inter_barxy ( imdep,jmdep -1,dlon, dlat ,
1119     , champ, iim, jjm, rlonu, rlatv, jjp1, champint )
1120      ELSE
1121       CALL grille_m(imdep, jmdep, dlon, dlat, champ,
1122     .          iim, jjp1, rlonv, rlatu, champint   )
1123      ENDIF
1124c
1125         DO j = 1,jjp1
1126         DO i = 1, iim
1127            champtime (i, j, l) = champint(i, j)
1128         ENDDO
1129         ENDDO
1130      ENDDO
1131c
1132      DO l = 1, lmdep
1133         timeyear(l) = timecoord(l)
1134      ENDDO
1135      print 222,  timeyear
1136c
1137C interpolation temporelle
1138      DO j = 1, jjp1
1139      DO i = 1, iim
1140          DO l = 1, lmdep
1141            ax(l) = timeyear(l)
1142            ay(l) = champtime (i, j, l)
1143          ENDDO
1144          CALL SPLINE(ax,ay,lmdep,1.e30,1.e30,yder)
1145          DO k = 1, 360
1146            time = FLOAT(k-1)
1147            CALL SPLINT(ax,ay,yder,lmdep,time,by)
1148            champan(i,j,k) = by
1149          ENDDO
1150      ENDDO
1151      ENDDO
1152      DO k = 1, 360
1153      DO j = 1, jjp1
1154         champan(iip1, j, k) = champan(1, j, k)
1155      ENDDO
1156        IF ( k.EQ.10 )  THEN
1157          DO j = 1, jjp1
1158            CALL minmax( iip1,champan(1,j,10),chmin,chmax )
1159            PRINT *,' Albedo au temps 10 ', chmin,chmax,j
1160          ENDDO
1161        ENDIF
1162      ENDDO
1163c
1164      DO k = 1, 360
1165         CALL gr_dyn_fi(1, iip1, jjp1, klon,
1166     .                  champan(1,1,k), phy_alb(1,k))
1167      ENDDO
1168c
1169      ierr = NF_CLOSE(ncid)
1170c
1171c
1172      DO k = 1, 360
1173      DO i = 1, klon
1174         phy_bil(i,k) = 0.0
1175      ENDDO
1176      ENDDO
1177c
1178      PRINT*, 'Ecriture du fichier limit'
1179c
1180      ierr = NF_CREATE ("limit.nc", NF_CLOBBER, nid)
1181c
1182      ierr = NF_PUT_ATT_TEXT (nid, NF_GLOBAL, "title", 30,
1183     .                       "Fichier conditions aux limites")
1184      ierr = NF_DEF_DIM (nid, "points_physiques", klon, ndim)
1185      ierr = NF_DEF_DIM (nid, "time", NF_UNLIMITED, ntim)
1186c
1187      dims(1) = ndim
1188      dims(2) = ntim
1189c
1190      ierr = NF_DEF_VAR (nid, "TEMPS", NF_FLOAT, 1,ntim, id_tim)
1191      ierr = NF_PUT_ATT_TEXT (nid, id_tim, "title", 17,
1192     .                        "Jour dans l annee")
1193      IF (newlmt) THEN
1194c
1195        ierr = NF_DEF_VAR (nid, "FOCE", NF_FLOAT, 2,dims, id_FOCE)
1196        ierr = NF_PUT_ATT_TEXT (nid, id_FOCE, "title", 14,
1197     .                      "Fraction ocean")
1198c
1199        ierr = NF_DEF_VAR (nid, "FSIC", NF_FLOAT, 2,dims, id_FSIC)
1200        ierr = NF_PUT_ATT_TEXT (nid, id_FSIC, "title", 21,
1201     .                      "Fraction glace de mer")
1202c
1203        ierr = NF_DEF_VAR (nid, "FTER", NF_FLOAT, 2,dims, id_FTER)
1204        ierr = NF_PUT_ATT_TEXT (nid, id_FTER, "title", 14,
1205     .                      "Fraction terre")
1206c
1207        ierr = NF_DEF_VAR (nid, "FLIC", NF_FLOAT, 2,dims, id_FLIC)
1208        ierr = NF_PUT_ATT_TEXT (nid, id_FLIC, "title", 17,
1209     .                      "Fraction land ice")
1210c
1211      ELSE
1212        ierr = NF_DEF_VAR (nid, "NAT", NF_FLOAT, 2,dims, id_NAT)
1213        ierr = NF_PUT_ATT_TEXT (nid, id_NAT, "title", 23,
1214     .                      "Nature du sol (0,1,2,3)")
1215      ENDIF
1216      ierr = NF_DEF_VAR (nid, "SST", NF_FLOAT, 2,dims, id_SST)
1217      ierr = NF_PUT_ATT_TEXT (nid, id_SST, "title", 35,
1218     .                      "Temperature superficielle de la mer")
1219      ierr = NF_DEF_VAR (nid, "BILS", NF_FLOAT, 2,dims, id_BILS)
1220      ierr = NF_PUT_ATT_TEXT (nid, id_BILS, "title", 32,
1221     .                        "Reference flux de chaleur au sol")
1222      ierr = NF_DEF_VAR (nid, "ALB", NF_FLOAT, 2,dims, id_ALB)
1223      ierr = NF_PUT_ATT_TEXT (nid, id_ALB, "title", 19,
1224     .                        "Albedo a la surface")
1225      ierr = NF_DEF_VAR (nid, "RUG", NF_FLOAT, 2,dims, id_RUG)
1226      ierr = NF_PUT_ATT_TEXT (nid, id_RUG, "title", 8,
1227     .                        "Rugosite")
1228c
1229      ierr = NF_ENDDEF(nid)
1230c
1231      DO k = 1, 360
1232c
1233      debut(1) = 1
1234      debut(2) = k
1235      epais(1) = klon
1236      epais(2) = 1
1237c
1238#ifdef NC_DOUBLE
1239      ierr = NF_PUT_VAR1_DOUBLE (nid,id_tim,k,DBLE(k))
1240c
1241      IF (newlmt ) THEN
1242          ierr = NF_PUT_VARA_DOUBLE (nid,id_FOCE,debut,epais
1243     $        ,pctsrf_t(1,is_oce,k))
1244          ierr = NF_PUT_VARA_DOUBLE (nid,id_FSIC,debut,epais
1245     $        ,pctsrf_t(1,is_sic,k))
1246          ierr = NF_PUT_VARA_DOUBLE (nid,id_FTER,debut,epais
1247     $        ,pctsrf_t(1,is_ter,k))
1248          ierr = NF_PUT_VARA_DOUBLE (nid,id_FLIC,debut,epais
1249     $        ,pctsrf_t(1,is_lic,k))
1250      ELSE
1251          ierr = NF_PUT_VARA_DOUBLE (nid,id_NAT,debut,epais
1252     $        ,phy_nat(1,k))
1253      ENDIF
1254c
1255      ierr = NF_PUT_VARA_DOUBLE (nid,id_SST,debut,epais,phy_sst(1,k))
1256      ierr = NF_PUT_VARA_DOUBLE (nid,id_BILS,debut,epais,phy_bil(1,k))
1257      ierr = NF_PUT_VARA_DOUBLE (nid,id_ALB,debut,epais,phy_alb(1,k))
1258      ierr = NF_PUT_VARA_DOUBLE (nid,id_RUG,debut,epais,phy_rug(1,k))
1259#else
1260      ierr = NF_PUT_VAR1_REAL (nid,id_tim,k,FLOAT(k))
1261      IF (newlmt ) THEN
1262          ierr = NF_PUT_VARA_REAL (nid,id_FOCE,debut,epais
1263     $        ,pctsrf_t(1,is_oce,k))
1264          ierr = NF_PUT_VARA_REAL (nid,id_FSIC,debut,epais
1265     $        ,pctsrf_t(1,is_sic,k))
1266          ierr = NF_PUT_VARA_REAL (nid,id_FTER,debut,epais
1267     $        ,pctsrf_t(1,is_ter,k))
1268          ierr = NF_PUT_VARA_REAL (nid,id_FLIC,debut,epais
1269     $        ,pctsrf_t(1,is_lic,k))
1270      ELSE
1271          ierr = NF_PUT_VARA_REAL (nid,id_NAT,debut,epais
1272     $        ,phy_nat(1,k))
1273      ENDIF
1274      ierr = NF_PUT_VARA_REAL (nid,id_SST,debut,epais,phy_sst(1,k))
1275      ierr = NF_PUT_VARA_REAL (nid,id_BILS,debut,epais,phy_bil(1,k))
1276      ierr = NF_PUT_VARA_REAL (nid,id_ALB,debut,epais,phy_alb(1,k))
1277      ierr = NF_PUT_VARA_REAL (nid,id_RUG,debut,epais,phy_rug(1,k))
1278#endif
1279c
1280      ENDDO
1281c
1282      ierr = NF_CLOSE(nid)
1283c
1284      STOP
1285      END
Note: See TracBrowser for help on using the repository browser.