source: LMDZ.3.3/branches/rel-LF/libf/dyn3d/limit_netcdf.F @ 487

Last change on this file since 487 was 430, checked in by lmdzadmin, 22 years ago

Changement du nom des fichiers de donnees brutes sst/ice (plus de
distinction climato/annuel)
LF

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