source: LMDZ4/branches/LMDZ4V5.0-dev/libf/dyn3dpar/limit_netcdf.F @ 1356

Last change on this file since 1356 was 1299, checked in by Laurent Fairhead, 15 years ago

Nettoyage general pour se rapprocher des normes et éviter des erreurs a la
compilation:

  • tous les FLOAT() sont remplacés par des REAL()
  • tous les STOP dans phylmd sont remplacés par des appels à abort_gcm
  • le common control défini dans le fichier control.h est remplacé par le module control_mod pour éviter des messages sur l'alignement des variables dans les déclarations
  • des $Header$ remplacés par des $Id$ pour svn

Quelques remplacements à faire ont pu m'échapper


General cleanup of the code to try and adhere to norms and to prevent some
compilation errors:

  • all FLOAT() instructions have been replaced by REAL() instructions
  • all STOP instructions in phylmd have been replaced by calls to abort_gcm
  • the common block control defined in the control.h file has been replaced by the control_mod to prevent compilation warnings on the alignement of declared variables
  • $Header$ replaced by $Id$ for svn

Some changes which should have been made might have escaped me

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