source: LMDZ4/trunk/libf/dyn3dpar/limit_netcdf.F @ 1124

Last change on this file since 1124 was 1012, checked in by lsce, 16 years ago
  • Error in another argument list.
  • Added writing in double precision in case of NC_DOUBLE

JG

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