source: LMDZ4/branches/LMDZ4_par_0/libf/dyn3dpar/limit_netcdf.F @ 3367

Last change on this file since 3367 was 630, checked in by Laurent Fairhead, 20 years ago

Import d'une version parallele de la dynamique YM
LF

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