source: utils/tools/NESTING/src/io_netcdf.f90 @ 10383

Last change on this file since 10383 was 10383, checked in by clem, 23 months ago

ice restart should work in the nesting tools now. However ocean restart has been broken for some time

  • Property svn:keywords set to Id
File size: 49.5 KB
Line 
1!************************************************************************
2! Fortran 95 OPA Nesting tools                  *
3!                          *
4!     Copyright (C) 2005 Florian Lemari�(Florian.Lemarie@imag.fr) *
5!                          *
6!************************************************************************
7!
8!********************************************************************************
9!                             *
10! module io_netcdf                        *
11!                             *
12! NetCDF Fortran 90 read/write interface              *
13! using input/output functions provided                  *
14! by unidata                           *
15!                             *
16!http://my.unidata.ucar.edu/content/software/netcdf/docs/netcdf-f90/index.html   *
17!                             *
18!********************************************************************************
19!
20!
21!
22MODULE io_netcdf
23  !     
24  USE netcdf
25  USE agrif_types
26  !     
27  INTERFACE read_ncdf_var
28     MODULE PROCEDURE  &
29        read_ncdf_var0d_real, read_ncdf_var1d_real, read_ncdf_var2d_real  , read_ncdf_var2d_real_bis,                        &
30        read_ncdf_var3d_real, read_ncdf_var4d_real, read_ncdf_var3d_real_t, read_ncdf_var4d_real_t, read_ncdf_var4d_real_nt, &
31        read_ncdf_var0d_int,  read_ncdf_var1d_int , read_ncdf_var2d_int   , read_ncdf_var3d_int   , read_ncdf_var4d_int
32  END INTERFACE
33  !
34  INTERFACE write_ncdf_var
35     MODULE PROCEDURE &
36        write_ncdf_var0d_real, write_ncdf_var1d_real  , write_ncdf_var2d_real  , write_ncdf_var3d_real,    &
37        write_ncdf_var4d_real, write_ncdf_var3d_real_t, write_ncdf_var4d_real_t, write_ncdf_var4d_real_nt, &                           
38        write_ncdf_var2d_real_bis ,                                                                        &           
39        write_ncdf_var0d_int, write_ncdf_var1d_int, write_ncdf_var2d_int, write_ncdf_var3d_int, write_ncdf_var4d_int
40  END INTERFACE
41  !
42  INTERFACE copy_ncdf_att
43     MODULE PROCEDURE copy_ncdf_att_latlon,copy_ncdf_att_var
44  END INTERFACE
45  !
46CONTAINS
47  !
48  !****************************************************************
49  !   subroutine read_ncdf_dim               *
50  !                        *
51  ! subroutine to retrieve value of a given dimension       *
52  !                        *
53  !     dimname : name of dimension to retrieve       *
54  !     file    : netcdf file name           *
55  !     dimval  : value of the required dimension        *
56  !                        *
57  !****************************************************************
58  !
59  SUBROUTINE read_ncdf_dim(dimname,file,dimval)   
60    !     
61    IMPLICIT NONE
62    !           
63    CHARACTER(*),INTENT(in) :: dimname,file   
64    INTEGER    :: dimval
65    !           
66    ! local variables
67    !
68    INTEGER ncid,status,dimid
69    !     
70    status = nf90_open(file,NF90_NOWRITE,ncid)
71    IF (status/=nf90_noerr) THEN   
72       WRITE(*,*)"unable to open netcdf file : ",file
73       STOP
74    ENDIF
75    !     
76    status = nf90_inq_dimid(ncid,dimname,dimid)
77    status = nf90_inquire_dimension(ncid,dimid,len=dimval)                                 
78    !     
79    status = nf90_close(ncid)
80    !     
81  END SUBROUTINE read_ncdf_dim
82  !
83  !**************************************************************
84  ! end subroutine read_ncdf_dim
85  !**************************************************************     
86  !
87  !****************************************************************
88  !   subroutine write_ncdf_dim              *
89  !                        *
90  ! subroutine to write a dimension in a given file      *
91  !                        *
92  !     dimname : name of dimension to initialize        *
93  !     file    : netcdf file name           *
94  !     dimval  : value of the dimension to write        *
95  !                        *
96  !****************************************************************
97  !
98  SUBROUTINE write_ncdf_dim(dimname,file,dimval)   
99    !     
100    IMPLICIT NONE
101    !           
102    CHARACTER(*),INTENT(in) :: dimname,file   
103    INTEGER    :: dimval
104    !     
105    ! local variables
106    !
107    INTEGER ncid,status,dimid
108    !     
109    status = nf90_open(file,NF90_WRITE,ncid)
110    IF (status/=nf90_noerr) THEN   
111       WRITE(*,*)"unable to open netcdf file : ",file
112       STOP
113    ENDIF
114    !     
115    status = nf90_redef(ncid)
116    IF(dimval.EQ.0) THEN
117       status = nf90_def_dim(ncid,dimname,nf90_unlimited,dimid)       
118    ELSE
119       status = nf90_def_dim(ncid,dimname,dimval,dimid) 
120    END IF
121
122    status = nf90_enddef(ncid)
123    !     
124
125    status = nf90_close(ncid)
126    !     
127  END SUBROUTINE write_ncdf_dim
128  !
129  !**************************************************************
130  ! end subroutine write_ncdf_dim
131  !**************************************************************           
132  !
133  !****************************************************************
134  !   subroutine read_ncdf_var               *
135  !                        *
136  ! subroutine to retrieve values of a given variable       *
137  !                        *
138  !     varname : name of variable to retrieve        *
139  !     file    : netcdf file name           *
140  !     tabvar  : array containing values of the required variable*
141  !                        *
142  !****************************************************************
143  !     
144  SUBROUTINE read_ncdf_var1d_real(varname,file,tabvar)
145    !     
146    IMPLICIT NONE
147    !       
148    CHARACTER(*),INTENT(in) :: varname,file
149    REAL*8, DIMENSION(:), POINTER :: tabvar
150    !
151    !local variables
152    !
153    INTEGER, DIMENSION(1) :: dimID
154    INTEGER :: dim1
155    INTEGER :: status,ncid
156    INTEGER :: varid             
157    !
158    status = nf90_open(file,NF90_NOWRITE,ncid)
159    !     
160    IF (status/=nf90_noerr) THEN   
161       WRITE(*,*)"unable to open netcdf file : ",file
162       STOP
163    ENDIF
164    !     
165    status = nf90_inq_varid(ncid,varname,varid)
166    status=nf90_inquire_variable(ncid,varid,dimids=dimID)
167    status=nf90_inquire_dimension(ncid,dimID(1),len=dim1)
168    !               
169    IF(.NOT. ASSOCIATED(tabvar)) THEN
170       ALLOCATE(tabvar(dim1)) 
171    ELSE
172       IF( ANY(SHAPE(tabvar)/=(/dim1/)) ) THEN     
173          DEALLOCATE(tabvar)   
174          ALLOCATE(tabvar(dim1))     
175       ENDIF
176    ENDIF
177    !       
178    status=nf90_get_var(ncid,varid,tabvar)     
179    !     
180    status = nf90_close(ncid)
181    !
182  END SUBROUTINE read_ncdf_var1d_real
183  !           
184  !     
185  SUBROUTINE read_ncdf_var2d_real(varname,file,tabvar)
186    !     
187    IMPLICIT NONE
188    !       
189    CHARACTER(*),INTENT(in) :: varname,file
190    REAL*8, DIMENSION(:,:), POINTER :: tabvar
191    !local variables
192    INTEGER, DIMENSION(10) :: dimIDS
193    INTEGER :: dim1,dim2
194    INTEGER :: status,ncid
195    INTEGER :: varid             
196    !
197    status = nf90_open(file,NF90_NOWRITE,ncid)
198    !     
199    IF (status/=nf90_noerr) THEN   
200       WRITE(*,*)"unable to open netcdf file : ",file
201       STOP
202    ENDIF
203    !     
204    status = nf90_inq_varid(ncid,varname,varid)
205    status=nf90_inquire_variable(ncid,varid,dimids=dimIDS)
206    status=nf90_inquire_dimension(ncid,dimIDS(1),len=dim1)
207    status=nf90_inquire_dimension(ncid,dimIDS(2),len=dim2)
208    !               
209    IF(.NOT. ASSOCIATED(tabvar)) THEN
210       ALLOCATE(tabvar(dim1,dim2)) 
211    ELSE
212       IF( ANY(SHAPE(tabvar)/=(/dim1,dim2/)) ) THEN     
213          DEALLOCATE(tabvar)   
214          ALLOCATE(tabvar(dim1,dim2))     
215       ENDIF
216    ENDIF
217    !       
218    status=nf90_get_var(ncid,varid,tabvar)     
219    !     
220    status = nf90_close(ncid)
221    !     
222  END SUBROUTINE read_ncdf_var2d_real
223  !           
224  !     
225  SUBROUTINE read_ncdf_var2d_real_bis(varname,file,tabvar,strt,cnt)
226    !     
227    IMPLICIT NONE
228    !       
229    CHARACTER(*),INTENT(in) :: varname,file
230    REAL*8, DIMENSION(:,:), POINTER :: tabvar
231    !local variables
232    INTEGER, DIMENSION(10) :: dimIDS
233    INTEGER, DIMENSION(2) :: strt,cnt
234    INTEGER :: dim1,dim2
235    INTEGER :: status,ncid
236    INTEGER :: varid             
237    !
238    status = nf90_open(file,NF90_NOWRITE,ncid)
239    !     
240    IF (status/=nf90_noerr) THEN   
241       WRITE(*,*)"unable to open netcdf file : ",file
242       STOP
243    ENDIF
244    !     
245    dim1 = cnt(1) 
246    dim2 = cnt(2)
247    !     
248    status = nf90_inq_varid(ncid,varname,varid)
249    status=nf90_inquire_variable(ncid,varid,dimids=dimIDS)
250    !               
251    IF(.NOT. ASSOCIATED(tabvar)) THEN
252       ALLOCATE(tabvar(dim1,dim2)) 
253    ELSE
254       IF( ANY(SHAPE(tabvar)/=(/dim1,dim2/)) ) THEN     
255          DEALLOCATE(tabvar)   
256          ALLOCATE(tabvar(dim1,dim2))     
257       ENDIF
258    ENDIF
259    !       
260    status=nf90_get_var(ncid,varid,tabvar,start = strt,count = cnt)     
261    !     
262    status = nf90_close(ncid)
263    !     
264  END SUBROUTINE read_ncdf_var2d_real_bis
265  !           
266  !     
267  SUBROUTINE read_ncdf_var3d_real(varname,file,tabvar)
268    !     
269    IMPLICIT NONE
270    !       
271    CHARACTER(*),INTENT(in) :: varname,file
272    REAL*8, DIMENSION(:,:,:), POINTER :: tabvar
273    !
274    !local variables
275    !
276    INTEGER, DIMENSION(10) :: dimIDS
277    INTEGER :: dim1,dim2,dim3
278    INTEGER :: status,ncid
279    INTEGER :: varid             
280    !
281    status = nf90_open(file,NF90_NOWRITE,ncid)
282    !     
283    IF (status/=nf90_noerr) THEN   
284       WRITE(*,*)"unable to open netcdf file : ",file
285       STOP
286    ENDIF
287    !     
288    status = nf90_inq_varid(ncid,varname,varid)
289    status=nf90_inquire_variable(ncid,varid,dimids=dimIDS)
290    status=nf90_inquire_dimension(ncid,dimIDS(1),len=dim1)
291    status=nf90_inquire_dimension(ncid,dimIDS(2),len=dim2) 
292    status=nf90_inquire_dimension(ncid,dimIDS(3),len=dim3)
293    !   
294    IF(.NOT. ASSOCIATED(tabvar)) THEN
295       ALLOCATE(tabvar(dim1,dim2,dim3)) 
296    ELSE
297       IF( ANY(SHAPE(tabvar) /= (/dim1,dim2,dim3/)) ) THEN     
298          DEALLOCATE(tabvar)   
299          ALLOCATE(tabvar(dim1,dim2,dim3))     
300       ENDIF
301    ENDIF
302    !     
303    status=nf90_get_var(ncid,varid,tabvar) 
304    IF (status/=nf90_noerr) THEN   
305       WRITE(*,*)"unable to retrieve netcdf variable : ",TRIM(varname)
306       STOP
307    ENDIF
308    !     
309    status = nf90_close(ncid)
310    !     
311  END SUBROUTINE read_ncdf_var3d_real
312  !           
313  !     
314  SUBROUTINE read_ncdf_var4d_real(varname,file,tabvar)
315    !     
316    IMPLICIT NONE
317    !       
318    CHARACTER(*),INTENT(in) :: varname,file
319    REAL*8, DIMENSION(:,:,:,:), POINTER :: tabvar
320    !
321    !local variables
322    !
323    INTEGER, DIMENSION(10) :: dimIDS
324    INTEGER :: dim1,dim2,dim3,dim4
325    INTEGER :: status,ncid
326    INTEGER :: varid             
327    !
328    status = nf90_open(file,NF90_NOWRITE,ncid)
329    !     
330    IF (status/=nf90_noerr) THEN   
331       WRITE(*,*)"unable to open netcdf file : ",file
332       STOP
333    ENDIF
334    !     
335    status = nf90_inq_varid(ncid,varname,varid)
336    status=nf90_inquire_variable(ncid,varid,dimids=dimIDS)
337    status=nf90_inquire_dimension(ncid,dimIDS(1),len=dim1)
338    status=nf90_inquire_dimension(ncid,dimIDS(2),len=dim2) 
339    status=nf90_inquire_dimension(ncid,dimIDS(3),len=dim3)   
340    status=nf90_inquire_dimension(ncid,dimIDS(4),len=dim4)       
341    !               
342    IF(.NOT. ASSOCIATED(tabvar)) THEN
343       ALLOCATE(tabvar(dim1,dim2,dim3,dim4)) 
344    ELSE
345       IF( ANY(SHAPE(tabvar) /= (/dim1,dim2,dim3,dim4/)) ) THEN     
346          DEALLOCATE(tabvar)   
347          ALLOCATE(tabvar(dim1,dim2,dim3,dim4))     
348       ENDIF
349    ENDIF
350   
351    status=nf90_get_var(ncid,varid,tabvar)     
352    !     
353    status = nf90_close(ncid)
354    !     
355  END SUBROUTINE read_ncdf_var4d_real
356
357  SUBROUTINE read_ncdf_var0d_real(varname,file,tabvar)
358    !     
359    IMPLICIT NONE
360    !       
361    CHARACTER(*),INTENT(in) :: varname,file
362    REAL*8 :: tabvar
363    !
364    !local variables
365    !
366    INTEGER :: status,ncid
367    INTEGER :: varid             
368    !
369    status = nf90_open(file,NF90_NOWRITE,ncid)
370    !     
371    IF (status/=nf90_noerr) THEN   
372       WRITE(*,*)"unable to open netcdf file : ",file
373       STOP
374    ENDIF
375    !     
376    status = nf90_inq_varid(ncid,varname,varid)
377    !
378   
379    status=nf90_get_var(ncid,varid,tabvar)     
380    !     
381    status = nf90_close(ncid)
382    !     
383  END SUBROUTINE read_ncdf_var0d_real
384
385  SUBROUTINE read_ncdf_var0d_int(varname,file,tabvar)
386    !     
387    IMPLICIT NONE
388    !       
389    CHARACTER(*),INTENT(in) :: varname,file
390    INTEGER :: tabvar
391    !
392    !local variables
393    !
394    INTEGER :: status,ncid
395    INTEGER :: varid             
396    !
397    status = nf90_open(file,NF90_NOWRITE,ncid)
398    !     
399    IF (status/=nf90_noerr) THEN   
400       WRITE(*,*)"unable to open netcdf file : ",file
401       STOP
402    ENDIF
403    !     
404    status = nf90_inq_varid(ncid,varname,varid)
405    !
406   
407    status=nf90_get_var(ncid,varid,tabvar)     
408    !     
409    status = nf90_close(ncid)
410    !     
411  END SUBROUTINE read_ncdf_var0d_int
412  !           
413  !     
414  SUBROUTINE read_ncdf_var1d_int(varname,file,tabvar)
415    !     
416    IMPLICIT NONE
417    !       
418    CHARACTER(*),INTENT(in) :: varname,file
419    INTEGER, DIMENSION(:), POINTER :: tabvar
420    !
421    !local variables
422    !
423    INTEGER,DIMENSION(10) :: dimID
424    INTEGER :: dim1
425    INTEGER :: status,ncid
426    INTEGER :: varid             
427    !
428    status = nf90_open(file,NF90_NOWRITE,ncid)
429    !     
430    IF (status/=nf90_noerr) THEN   
431       WRITE(*,*)"unable to open netcdf file : ",file
432       STOP
433    ENDIF
434    !     
435    status = nf90_inq_varid(ncid,varname,varid)
436    status=nf90_inquire_variable(ncid,varid,dimids=dimID)
437    status=nf90_inquire_dimension(ncid,dimID(1),len=dim1)         
438    !               
439    IF(.NOT. ASSOCIATED(tabvar)) THEN
440       ALLOCATE(tabvar(dim1)) 
441    ELSE
442       IF( ANY(SHAPE(tabvar) /= (/dim1/)) ) THEN     
443          DEALLOCATE(tabvar)   
444          ALLOCATE(tabvar(dim1))     
445       ENDIF
446    ENDIF
447   
448    status=nf90_get_var(ncid,varid,tabvar)     
449    !     
450    status = nf90_close(ncid)
451    !     
452  END SUBROUTINE read_ncdf_var1d_int
453  !           
454  !     
455  SUBROUTINE read_ncdf_var2d_int(varname,file,tabvar)
456    !     
457    IMPLICIT NONE
458    !       
459    CHARACTER(*),INTENT(in) :: varname,file
460    INTEGER, DIMENSION(:,:), POINTER :: tabvar
461    !local variables
462    INTEGER, DIMENSION(10) :: dimIDS
463    INTEGER :: dim1,dim2
464    INTEGER :: status,ncid
465    INTEGER :: varid             
466    !
467    status = nf90_open(file,NF90_NOWRITE,ncid)
468    !     
469    IF (status/=nf90_noerr) THEN   
470       WRITE(*,*)"unable to open netcdf file : ",file
471       STOP
472    ENDIF
473    !     
474    status = nf90_inq_varid(ncid,varname,varid)
475    status=nf90_inquire_variable(ncid,varid,dimids=dimIDS)
476    status=nf90_inquire_dimension(ncid,dimIDS(1),len=dim1)
477    status=nf90_inquire_dimension(ncid,dimIDS(2),len=dim2)     
478    !               
479    IF(.NOT. ASSOCIATED(tabvar)) THEN
480       ALLOCATE(tabvar(dim1,dim2)) 
481    ELSE
482       IF( ANY(SHAPE(tabvar) /= (/dim1,dim2/)) ) THEN   
483          DEALLOCATE(tabvar)   
484          ALLOCATE(tabvar(dim1,dim2))     
485       ENDIF
486    ENDIF
487   
488    status=nf90_get_var(ncid,varid,tabvar)     
489    !     
490    status = nf90_close(ncid)
491    !     
492  END SUBROUTINE read_ncdf_var2d_int
493  !           
494  !     
495  SUBROUTINE read_ncdf_var3d_int(varname,file,tabvar)
496    !     
497    IMPLICIT NONE
498    !       
499    CHARACTER(*),INTENT(in) :: varname,file
500    INTEGER, DIMENSION(:,:,:), POINTER :: tabvar
501    !
502    !local variables
503    !
504    INTEGER, DIMENSION(10) :: dimIDS
505    INTEGER :: dim1,dim2,dim3
506    INTEGER :: status,ncid
507    INTEGER :: varid             
508    !
509    status = nf90_open(file,NF90_NOWRITE,ncid)
510    !     
511    IF (status/=nf90_noerr) THEN   
512       WRITE(*,*)"unable to open netcdf file : ",file
513       STOP
514    ENDIF
515    !     
516    status = nf90_inq_varid(ncid,varname,varid)
517    status=nf90_inquire_variable(ncid,varid,dimids=dimIDS)
518    status=nf90_inquire_dimension(ncid,dimIDS(1),len=dim1)
519    status=nf90_inquire_dimension(ncid,dimIDS(2),len=dim2) 
520    status=nf90_inquire_dimension(ncid,dimIDS(3),len=dim3)         
521    !               
522    IF(.NOT. ASSOCIATED(tabvar)) THEN
523       ALLOCATE(tabvar(dim1,dim2,dim3)) 
524    ELSE
525       IF( ANY(SHAPE(tabvar) /= (/dim1,dim2,dim3/)) ) THEN     
526          DEALLOCATE(tabvar)   
527          ALLOCATE(tabvar(dim1,dim2,dim3))     
528       ENDIF
529    ENDIF
530    !
531    status=nf90_get_var(ncid,varid,tabvar)     
532    !     
533    status = nf90_close(ncid)
534    !     
535  END SUBROUTINE read_ncdf_var3d_int
536  !           
537  !     
538  SUBROUTINE read_ncdf_var4d_int(varname,file,tabvar)
539    !     
540    IMPLICIT NONE
541    !       
542    CHARACTER(*),INTENT(in) :: varname,file
543    INTEGER, DIMENSION(:,:,:,:), POINTER :: tabvar
544    !
545    !local variables
546    !
547    INTEGER, DIMENSION(10) :: dimIDS
548    INTEGER :: dim1,dim2,dim3,dim4
549    INTEGER :: status,ncid
550    INTEGER :: varid             
551    !
552    status = nf90_open(file,NF90_NOWRITE,ncid)
553    !     
554    IF (status/=nf90_noerr) THEN   
555       WRITE(*,*)"unable to open netcdf file : ",file
556       STOP
557    ENDIF
558    !     
559    status = nf90_inq_varid(ncid,varname,varid)
560    status=nf90_inquire_variable(ncid,varid,dimids=dimIDS)
561    status=nf90_inquire_dimension(ncid,dimIDS(1),len=dim1)
562    status=nf90_inquire_dimension(ncid,dimIDS(2),len=dim2) 
563    status=nf90_inquire_dimension(ncid,dimIDS(3),len=dim3)   
564    status=nf90_inquire_dimension(ncid,dimIDS(4),len=dim4)       
565    !               
566    IF(.NOT. ASSOCIATED(tabvar)) THEN
567       ALLOCATE(tabvar(dim1,dim2,dim3,dim4)) 
568    ELSE
569       IF( ANY(SHAPE(tabvar) /= (/dim1,dim2,dim3,dim4/)) ) THEN     
570          DEALLOCATE(tabvar)   
571          ALLOCATE(tabvar(dim1,dim2,dim3,dim4))     
572       ENDIF
573    ENDIF
574   
575    status=nf90_get_var(ncid,varid,tabvar)     
576    !     
577    status = nf90_close(ncid)
578    !     
579  END SUBROUTINE read_ncdf_var4d_int
580  !           
581  !
582  !****************************************************************
583  !   subroutine write_ncdf_var              *
584  !                        *
585  ! subroutine to write a variable in a given file       *
586  !                        *
587  !     varname : name of variable to store        *     
588  !     dimname : name of dimensions of the given variable  *
589  !     file    : netcdf file name           *
590  !     tabvar  : values of the variable to write        *
591  !                        *
592  !****************************************************************
593  !   
594  !     
595  SUBROUTINE write_ncdf_var1d_real(varname,dimname,file,tabvar,typevar)
596    !     
597    IMPLICIT NONE
598    !       
599    CHARACTER(*),INTENT(in) :: varname,file,dimname,typevar
600    REAL*8, DIMENSION(:), INTENT(in) :: tabvar
601    !
602    ! local variables
603    !
604    INTEGER :: dimid
605    INTEGER :: status,ncid
606    INTEGER :: varid             
607    !
608    status = nf90_open(file,NF90_WRITE,ncid)       
609    IF (status/=nf90_noerr) THEN   
610       WRITE(*,*)"unable to open netcdf file : ",file
611       STOP
612    ENDIF
613    !     
614    status = nf90_inq_dimid(ncid,dimname,dimid)
615    status = nf90_inq_varid(ncid,varname,varid)
616    status = nf90_redef(ncid)
617    SELECT CASE(TRIM(typevar))
618    CASE('double')
619       status = nf90_def_var(ncid,varname,nf90_double,(/dimid/),varid)
620    CASE('float')
621       status = nf90_def_var(ncid,varname,nf90_float,(/dimid/),varid)     
622    END SELECT
623    status = nf90_enddef(ncid)
624    status = nf90_put_var(ncid,varid,tabvar)     
625    !     
626    status = nf90_close(ncid)
627    !
628  END SUBROUTINE write_ncdf_var1d_real
629  !     
630  !     
631  SUBROUTINE write_ncdf_var2d_real_bis(varname,dimname,file,tabvar,nbdim,typevar)
632    !     
633    IMPLICIT NONE
634    !       
635    CHARACTER(*),INTENT(in) :: varname,file,typevar
636    INTEGER,INTENT(in) :: nbdim
637    CHARACTER(*), DIMENSION(4) :: dimname
638    REAL*8, DIMENSION(:,:) :: tabvar
639    REAL*8, ALLOCATABLE, DIMENSION(:,:,:) :: tabtemp3d
640    REAL*8, ALLOCATABLE, DIMENSION(:,:,:,:) :: tabtemp4d
641    !
642    ! local variables
643    !
644    INTEGER :: dimid1,dimid2,dimid3,dimid4
645    INTEGER :: status,ncid,ncid2
646    INTEGER :: varid,varid2             
647    !
648    IF(nbdim==4) THEN     
649       ALLOCATE(tabtemp4d(SIZE(tabvar,1),SIZE(tabvar,2),1,1))
650       tabtemp4d(:,:,1,1) = tabvar(:,:)
651    ELSE IF(nbdim==3) THEN
652       ALLOCATE(tabtemp3d(SIZE(tabvar,1),SIZE(tabvar,2),1))
653       tabtemp3d(:,:,1) = tabvar(:,:)
654    END IF
655    !     
656    status = nf90_open(file,NF90_WRITE,ncid)       
657    IF (status/=nf90_noerr) THEN   
658       WRITE(*,*)"unable to open netcdf file : ",file
659       STOP
660    ENDIF
661    !     
662    status = nf90_inq_dimid(ncid,dimname(1), dimid1)
663    status = nf90_inq_dimid(ncid,dimname(2), dimid2)
664    status = nf90_inq_dimid(ncid,dimname(3), dimid3)
665    !     
666    IF(nbdim==4) status = nf90_inq_dimid(ncid,dimname(4), dimid4)
667    !     
668    status = nf90_inq_varid(ncid,varname,varid)
669    status = nf90_redef(ncid)
670    IF(nbdim==4 .AND. typevar == 'double') THEN
671       status = nf90_def_var(ncid,varname,nf90_double,     &
672            (/dimid1,dimid2,dimid3,dimid4/),varid)
673       !                             
674    ELSE IF(nbdim==4 .AND. typevar == 'float') THEN
675       status = nf90_def_var(ncid,varname,nf90_float,     &
676            (/dimid1,dimid2,dimid3,dimid4/),varid)                       
677       !         
678    ELSE IF(nbdim==3 .AND. typevar == 'float') THEN
679       status = nf90_def_var(ncid,varname,nf90_float,     &
680            (/dimid1,dimid2,dimid3/),varid)
681       !
682    ELSE IF(nbdim==3 .AND. typevar == 'double') THEN
683       status = nf90_def_var(ncid,varname,nf90_double,     &
684            (/dimid1,dimid2,dimid3/),varid)
685       !                                 
686    ENDIF
687    !                   
688    status = nf90_enddef(ncid)
689    IF(nbdim==4) status = nf90_put_var(ncid,varid,tabtemp4d)
690    IF(nbdim==3) status = nf90_put_var(ncid,varid,tabtemp3d)
691    !     
692    IF(ALLOCATED( tabtemp3d ) ) DEALLOCATE( tabtemp3d )   
693    IF(ALLOCATED( tabtemp4d ) ) DEALLOCATE( tabtemp4d )     
694    !
695    status = nf90_close(ncid)
696    !
697  END SUBROUTINE write_ncdf_var2d_real_bis
698  !     
699  !     
700  SUBROUTINE write_ncdf_var2d_real(varname,dimname,file,tabvar,typevar)
701    !     
702    !      implicit none
703    !       
704    CHARACTER(*),INTENT(in) :: varname,file,typevar
705    CHARACTER(*), DIMENSION(2) :: dimname
706    REAL*8, DIMENSION(:,:), INTENT(in) :: tabvar
707    !
708    ! local variables
709    !
710    INTEGER :: dimid1,dimid2
711    INTEGER :: status,ncid
712    INTEGER :: varid             
713    !
714    status = nf90_open(file,NF90_WRITE,ncid)       
715    IF (status/=nf90_noerr) THEN   
716       WRITE(*,*)"unable to open netcdf file : ",file
717       STOP
718    ENDIF
719    !     
720    status = nf90_inq_dimid(ncid,dimname(1), dimid1)
721    status = nf90_inq_dimid(ncid,dimname(2), dimid2)
722    status = nf90_inq_varid(ncid,varname,varid)
723    status = nf90_redef(ncid)
724
725    SELECT CASE(TRIM(typevar))
726    CASE('double')
727       status = nf90_def_var(ncid,varname,nf90_double,     &
728            (/dimid1,dimid2/),varid)
729    CASE('float')
730       status = nf90_def_var(ncid,varname,nf90_float,     &
731            (/dimid1,dimid2/),varid)     
732    END SELECT
733    !
734    status = nf90_enddef(ncid)
735    status = nf90_put_var(ncid,varid,tabvar)     
736    !     
737    status = nf90_close(ncid)
738    !
739  END SUBROUTINE write_ncdf_var2d_real
740  !     
741  !     
742  SUBROUTINE write_ncdf_var3d_real(varname,dimname,file,tabvar,typevar)
743    !     
744    IMPLICIT NONE
745    !       
746    CHARACTER(*),INTENT(in) :: varname,file,typevar
747    CHARACTER(*),DIMENSION(3),INTENT(in) :: dimname
748    REAL*8, DIMENSION(:,:,:), INTENT(in) :: tabvar
749    !
750    ! local variables
751    !
752    INTEGER :: dimid1,dimid2,dimid3
753    INTEGER :: status,ncid
754    INTEGER :: varid             
755    !
756    status = nf90_open(file,NF90_WRITE,ncid)       
757    IF (status/=nf90_noerr) THEN   
758       WRITE(*,*)"unable to open netcdf file : ",file
759       STOP
760    ENDIF
761    !     
762    status = nf90_inq_dimid(ncid,dimname(1), dimid1)
763    status = nf90_inq_dimid(ncid,dimname(2), dimid2)
764    status = nf90_inq_dimid(ncid,dimname(3), dimid3)
765    status = nf90_inq_varid(ncid,varname,varid)
766    status = nf90_redef(ncid)
767
768    SELECT CASE(TRIM(typevar))
769    CASE('double')
770       status = nf90_def_var(ncid,varname,nf90_double,     &
771            (/dimid1,dimid2,dimid3/),varid)
772    CASE('float')
773       status = nf90_def_var(ncid,varname,nf90_float,     &
774            (/dimid1,dimid2,dimid3/),varid)   
775    END SELECT
776    !
777    status = nf90_enddef(ncid)
778    status = nf90_put_var(ncid,varid,tabvar)     
779    !     
780    status = nf90_close(ncid)
781    !
782  END SUBROUTINE write_ncdf_var3d_real
783  !     
784  !     
785  SUBROUTINE write_ncdf_var4d_real(varname,dimname,file,tabvar,typevar)
786    !     
787    IMPLICIT NONE
788    !       
789    CHARACTER(*),INTENT(in) :: varname,file,typevar
790    CHARACTER(*),DIMENSION(4),INTENT(in) :: dimname
791    REAL*8, DIMENSION(:,:,:,:), INTENT(in) :: tabvar
792    !
793    ! local variables
794    !
795    INTEGER :: dimid1,dimid2,dimid3,dimid4
796    INTEGER :: status,ncid
797    INTEGER :: varid             
798    !
799    status = nf90_open(file,NF90_WRITE,ncid)       
800    IF (status/=nf90_noerr) THEN   
801       WRITE(*,*)"unable to open netcdf file : ",file
802       STOP
803    ENDIF
804    !
805    status = nf90_inq_varid(ncid,varname,varid)
806    !     
807    IF(status/=nf90_noerr) THEN
808       !     
809       status = nf90_inq_dimid(ncid,dimname(1), dimid1)
810       status = nf90_inq_dimid(ncid,dimname(2), dimid2)
811       status = nf90_inq_dimid(ncid,dimname(3), dimid3)
812       status = nf90_inq_dimid(ncid,dimname(4), dimid4)
813       status = nf90_redef(ncid)
814       !     
815       SELECT CASE(TRIM(typevar))
816       CASE('double')
817          status = nf90_def_var(ncid,varname,nf90_double,     &
818               (/dimid1,dimid2,dimid3,dimid4/),varid)
819       CASE('float')
820          status = nf90_def_var(ncid,varname,nf90_float,     &
821               (/dimid1,dimid2,dimid3,dimid4/),varid)   
822       END SELECT
823       !
824       status = nf90_enddef(ncid)
825    ENDIF
826    !         
827    status = nf90_put_var(ncid,varid,tabvar)     
828    !     
829    status = nf90_close(ncid)
830    !
831  END SUBROUTINE write_ncdf_var4d_real
832  !     
833  !     
834  SUBROUTINE write_ncdf_var1d_int(varname,dimname,file,tabvar,typevar)
835    !     
836    IMPLICIT NONE
837    !       
838    CHARACTER(*),INTENT(in) :: varname,file,dimname,typevar
839    INTEGER, DIMENSION(:), INTENT(in) :: tabvar
840    !
841    ! local variables
842    !
843    INTEGER :: dimid
844    INTEGER :: status,ncid
845    INTEGER :: varid             
846    !
847    !           print *,'ici tabvar = ',tabvar,varname,dimname
848    status = nf90_open(file,NF90_WRITE,ncid)       
849    IF (status/=nf90_noerr) THEN   
850       WRITE(*,*)"unable to open netcdf file : ",file
851       STOP
852    ENDIF
853    !     
854    status = nf90_inq_dimid(ncid,dimname, dimid)
855    status = nf90_inq_varid(ncid,varname,varid)
856    status = nf90_redef(ncid)
857    status = nf90_def_var(ncid,varname,nf90_int,(/dimid/),varid)
858    status = nf90_enddef(ncid)
859    status = nf90_put_var(ncid,varid,tabvar)     
860    !     
861    status = nf90_close(ncid)
862    !
863  END SUBROUTINE write_ncdf_var1d_int
864  !     
865  !     
866  SUBROUTINE write_ncdf_var2d_int(varname,dimname,file,tabvar,typevar)
867    !     
868    IMPLICIT NONE
869    !       
870    CHARACTER(*), INTENT(in) :: varname,file,typevar
871    CHARACTER(*), DIMENSION(2), INTENT(in) :: dimname
872    INTEGER, DIMENSION(:,:), INTENT(in) :: tabvar
873    !
874    ! local variables
875    !
876    INTEGER :: dimid1,dimid2
877    INTEGER :: status,ncid
878    INTEGER :: varid             
879    !
880    status = nf90_open(file,NF90_WRITE,ncid)       
881    IF (status/=nf90_noerr) THEN   
882       WRITE(*,*)"unable to open netcdf file : ",file
883       STOP
884    ENDIF
885    !     
886    status = nf90_inq_dimid(ncid,dimname(1),dimid1)
887    status = nf90_inq_dimid(ncid,dimname(2),dimid2)
888    status = nf90_inq_varid(ncid,varname,varid)
889    status = nf90_redef(ncid)
890    status = nf90_def_var(ncid,varname,nf90_int,(/dimid1,dimid2/),varid)
891    status = nf90_enddef(ncid)
892    status = nf90_put_var(ncid,varid,tabvar)     
893    !     
894    status = nf90_close(ncid)
895    !
896  END SUBROUTINE write_ncdf_var2d_int
897  !     
898  !     
899  SUBROUTINE write_ncdf_var3d_int(varname,dimname,file,tabvar,typevar)
900    !     
901    IMPLICIT NONE
902    !       
903    CHARACTER(*),INTENT(in) :: varname,file,typevar
904    CHARACTER(*),DIMENSION(3),INTENT(in) :: dimname
905    INTEGER, DIMENSION(:,:,:), INTENT(in) :: tabvar
906    !
907    ! local variables
908    !
909    INTEGER :: dimid1,dimid2,dimid3
910    INTEGER :: status,ncid
911    INTEGER :: varid             
912    !
913    status = nf90_open(file,NF90_WRITE,ncid)       
914    IF (status/=nf90_noerr) THEN   
915       WRITE(*,*)"unable to open netcdf file : ",file
916       STOP
917    ENDIF
918    !     
919    status = nf90_inq_dimid(ncid,dimname(1), dimid1)
920    status = nf90_inq_dimid(ncid,dimname(2), dimid2)
921    status = nf90_inq_dimid(ncid,dimname(3), dimid3)
922    status = nf90_inq_varid(ncid,varname,varid)
923    status = nf90_redef(ncid)
924    status = nf90_def_var(ncid,varname,nf90_int,     &
925         (/dimid1,dimid2,dimid3/),varid)
926    status = nf90_enddef(ncid)
927    status = nf90_put_var(ncid,varid,tabvar)     
928    !     
929    status = nf90_close(ncid)
930    !
931  END SUBROUTINE write_ncdf_var3d_int
932  !     
933  !     
934  SUBROUTINE write_ncdf_var4d_int(varname,dimname,file,tabvar,typevar)
935    !     
936    IMPLICIT NONE
937    !       
938    CHARACTER(*),INTENT(in) :: varname,file,typevar
939    CHARACTER(*),DIMENSION(4),INTENT(in) :: dimname
940    INTEGER, DIMENSION(:,:,:,:), INTENT(in) :: tabvar
941    !
942    ! local variables
943    !
944    INTEGER :: dimid1,dimid2,dimid3,dimid4
945    INTEGER :: status,ncid
946    INTEGER :: varid             
947    !
948    status = nf90_open(file,NF90_WRITE,ncid)       
949    IF (status/=nf90_noerr) THEN   
950       WRITE(*,*)"unable to open netcdf file : ",file
951       STOP
952    ENDIF
953    !     
954    status = nf90_inq_dimid(ncid,dimname(1), dimid1)
955    status = nf90_inq_dimid(ncid,dimname(2), dimid2)
956    status = nf90_inq_dimid(ncid,dimname(3), dimid3)
957    status = nf90_inq_dimid(ncid,dimname(4), dimid4)
958    status = nf90_inq_varid(ncid,varname,varid)
959    status = nf90_redef(ncid)
960    status = nf90_def_var(ncid,varname,nf90_int,     &
961         (/dimid1,dimid2,dimid3,dimid4/),varid)
962    status = nf90_enddef(ncid)
963    status = nf90_put_var(ncid,varid,tabvar)     
964    !     
965    status = nf90_close(ncid)
966    !
967  END SUBROUTINE write_ncdf_var4d_int
968  !     
969  !
970  !****************************************************************
971  !   subroutine read_ncdf_var_t             *
972  !                        *
973  ! subroutine to read a variable in a given file for time t   *
974  !                        *
975  !     varname : name of variable to read         *     
976  !     file    : netcdf file name           *
977  !     tabvar  : values of the read variable         *
978  !     time    : time corresponding to the values to read  * 
979  !                        *
980  !****************************************************************
981  !
982  !     
983  SUBROUTINE read_ncdf_var3d_real_t(varname,file,tabvar,time)
984    !     
985    USE agrif_types     
986    !     
987    IMPLICIT NONE
988    !       
989    CHARACTER(*),INTENT(in) :: varname,file
990    INTEGER,INTENT(in) :: time
991    REAL*8, DIMENSION(:,:,:), POINTER :: tabvar
992    !
993    !local variables
994    !
995    INTEGER, DIMENSION(3) :: dimIDS
996    INTEGER :: dim1,dim2
997    INTEGER :: status,ncid
998    INTEGER :: varid             
999    !
1000    status = nf90_open(file,NF90_NOWRITE,ncid)
1001    !     
1002    IF (status/=nf90_noerr) THEN   
1003       WRITE(*,*)"unable to open netcdf file : ",file
1004       STOP
1005    ENDIF
1006    !     
1007    status = nf90_inq_varid(ncid,varname,varid)
1008    !       
1009    status=nf90_inquire_variable(ncid,varid,dimids=dimIDS)
1010    status=nf90_inquire_dimension(ncid,dimIDS(1),len=dim1)
1011    status=nf90_inquire_dimension(ncid,dimIDS(2),len=dim2)
1012    !
1013    IF(.NOT. ASSOCIATED(tabvar)) THEN
1014       ALLOCATE(tabvar(dim1,dim2,1)) 
1015    ELSE
1016       IF( ANY(SHAPE(tabvar) /= (/dim1,dim2,1/)) ) THEN     
1017          DEALLOCATE(tabvar)   
1018          ALLOCATE(tabvar(dim1,dim2,1))     
1019       ENDIF
1020    ENDIF
1021
1022    status=nf90_get_var(ncid,varid,tabvar,start=(/1,1,time/))
1023
1024    IF (status/=nf90_noerr) THEN   
1025       WRITE(*,*)"unable to retrieve netcdf variable : ",TRIM(varname)
1026       STOP
1027    ENDIF
1028    !     
1029    status = nf90_close(ncid)
1030    !     
1031  END SUBROUTINE read_ncdf_var3d_real_t
1032  !           
1033  !
1034  !****************************************************************
1035  !   subroutine write_ncdf_var_t               *
1036  !                        *
1037  ! subroutine to write a variable in a given file for time t  *
1038  !                        *
1039  !     varname : name of variable to store        *     
1040  !     dimname : name of dimensions of the given variable  *
1041  !     file    : netcdf file name           *
1042  !     tabvar  : values of the variable to write        *
1043  !     time    : time corresponding to the values to store * 
1044  !                        *
1045  !****************************************************************
1046  !
1047  !     
1048  SUBROUTINE write_ncdf_var3d_real_t(varname,dimname,file,tabvar,time,typevar)
1049    !     
1050    IMPLICIT NONE
1051    !       
1052    CHARACTER(*),INTENT(in) :: varname,file,typevar
1053    CHARACTER(*),DIMENSION(3),INTENT(in) :: dimname
1054    INTEGER :: time
1055    REAL*8, DIMENSION(:,:,:), INTENT(in) :: tabvar
1056    !
1057    ! local variables
1058    !
1059    INTEGER :: dimid1,dimid2,dimid3
1060    INTEGER :: status,ncid
1061    INTEGER :: varid             
1062    !
1063    status = nf90_open(file,NF90_WRITE,ncid)       
1064    IF (status/=nf90_noerr) THEN   
1065       WRITE(*,*)"unable to open netcdf file : ",file
1066       STOP
1067    ENDIF
1068    !     
1069    IF(time==1) THEN
1070       !     
1071       status = nf90_inq_dimid(ncid,dimname(1), dimid1)
1072       status = nf90_inq_dimid(ncid,dimname(2), dimid2)
1073       status = nf90_inq_dimid(ncid,dimname(3), dimid3)
1074       status = nf90_redef(ncid)
1075
1076       !     
1077       SELECT CASE(TRIM(typevar))
1078       CASE('double')
1079          status = nf90_def_var(ncid,varname,nf90_double,     &
1080               (/dimid1,dimid2,dimid3/),varid) 
1081       CASE('float')
1082          status = nf90_def_var(ncid,varname,nf90_float,     &
1083               (/dimid1,dimid2,dimid3/),varid)   
1084       END SELECT
1085       !
1086       status = nf90_enddef(ncid)
1087
1088    ELSE
1089       status = nf90_inq_varid(ncid, varname, varid)
1090    ENDIF
1091    !     
1092    status = nf90_put_var(ncid,varid,tabvar,start=(/1,1,time/))
1093    IF (status/=nf90_noerr) THEN   
1094       WRITE(*,*)"unable to store variable ",varname, &
1095       " in file ",file
1096       STOP
1097    ENDIF
1098    !     
1099    status = nf90_close(ncid)
1100    !
1101  END SUBROUTINE write_ncdf_var3d_real_t
1102  !     
1103  !
1104  !****************************************************************
1105  !   subroutine read_ncdf_var_t             *
1106  !                        *
1107  ! subroutine to read a variable in a given file for time t   *
1108  !                  at level n  *
1109  !     varname : name of variable to read         *     
1110  !     file    : netcdf file name           *
1111  !     tabvar  : values of the read variable         *
1112  !     time    : time corresponding to the values to read  * 
1113  !     level   : level corresponding to the values to read *
1114  !                        *
1115  !****************************************************************
1116  !
1117  !     
1118  SUBROUTINE read_ncdf_var4d_real_nt(varname,file,tabvar,time,level)
1119    !     
1120    USE agrif_types     
1121    !     
1122    IMPLICIT NONE
1123    !       
1124    CHARACTER(*),INTENT(in) :: varname,file
1125    INTEGER,INTENT(in) :: time,level
1126    REAL*8, DIMENSION(:,:,:,:), POINTER :: tabvar
1127    !
1128    !local variables
1129    !
1130    INTEGER, DIMENSION(4) :: dimIDS
1131    INTEGER :: dim1,dim2
1132    INTEGER :: status,ncid
1133    INTEGER :: varid             
1134    !
1135    status = nf90_open(file,NF90_NOWRITE,ncid)
1136    !     
1137    IF (status/=nf90_noerr) THEN   
1138       WRITE(*,*)"unable to open netcdf file : ",file
1139       STOP
1140    ENDIF
1141    !     
1142    status = nf90_inq_varid(ncid,varname,varid)
1143    !       
1144    status=nf90_inquire_variable(ncid,varid,dimids=dimIDS)
1145    status=nf90_inquire_dimension(ncid,dimIDS(1),len=dim1)
1146    status=nf90_inquire_dimension(ncid,dimIDS(2),len=dim2)
1147    !
1148    IF(.NOT. ASSOCIATED(tabvar)) THEN
1149       ALLOCATE(tabvar(dim1,dim2,1,1)) 
1150    ELSE
1151       IF ((SIZE(tabvar,1) /= dim1) .OR. (SIZE(tabvar,2) /= dim2)) THEN
1152          DEALLOCATE(tabvar)
1153          ALLOCATE(tabvar(dim1,dim2,1,1))
1154       ENDIF
1155    ENDIF
1156    !
1157    status=nf90_get_var(ncid,varid,tabvar,start=(/1,1,level,time/),count=(/dim1,dim2,1,1/))
1158    !                                             
1159    IF (status/=nf90_noerr) THEN   
1160       WRITE(*,*)"unable to retrieve netcdf variable : ",TRIM(varname)
1161       STOP
1162    ENDIF
1163    !     
1164    status = nf90_close(ncid)
1165    !     
1166  END SUBROUTINE read_ncdf_var4d_real_nt
1167  !           
1168  !     
1169  SUBROUTINE read_ncdf_var4d_real_t(varname,file,tabvar,time)
1170    !     
1171    USE agrif_types     
1172    !     
1173    IMPLICIT NONE
1174    !       
1175    CHARACTER(*),INTENT(in) :: varname,file
1176    INTEGER,INTENT(in) :: time
1177    REAL*8, DIMENSION(:,:,:,:), POINTER :: tabvar
1178    !
1179    !local variables
1180    !
1181    INTEGER, DIMENSION(4) :: dimIDS
1182    INTEGER :: dim1,dim2,dim3
1183    INTEGER :: status,ncid
1184    INTEGER :: varid             
1185    !
1186    status = nf90_open(file,NF90_NOWRITE,ncid)
1187    !     
1188    IF (status/=nf90_noerr) THEN   
1189       WRITE(*,*)"unable to open netcdf file : ",file
1190       STOP
1191    ENDIF
1192    !     
1193    status = nf90_inq_varid(ncid,varname,varid)
1194    !       
1195    status=nf90_inquire_variable(ncid,varid,dimids=dimIDS)
1196    status=nf90_inquire_dimension(ncid,dimIDS(1),len=dim1)
1197    status=nf90_inquire_dimension(ncid,dimIDS(2),len=dim2)
1198    status=nf90_inquire_dimension(ncid,dimIDS(3),len=dim3)
1199    !
1200    IF(.NOT. ASSOCIATED(tabvar)) ALLOCATE(tabvar(dim1,dim2,dim3,1)) 
1201    status=nf90_get_var(ncid,varid,tabvar,start=(/1,1,1,time/))
1202
1203    IF (status/=nf90_noerr) THEN   
1204       WRITE(*,*)"unable to retrieve netcdf variable : ",TRIM(varname)
1205       STOP
1206    ENDIF
1207    !     
1208    status = nf90_close(ncid)
1209    !     
1210  END SUBROUTINE read_ncdf_var4d_real_t
1211  !           
1212  !****************************************************************
1213  !   subroutine write_ncdf_var_t               *
1214  !                        *
1215  ! subroutine to write a variable in a given file for time t  *
1216  !                  at level n  *
1217  !     varname : name of variable to store        *     
1218  !     dimname : name of dimensions of the given variable  *
1219  !     file    : netcdf file name           *
1220  !     tabvar  : values of the variable to write        *
1221  !     time    : time corresponding to the values to store * 
1222  !     level   : level corresponding to the values to store   *
1223  !                        *
1224  !****************************************************************
1225  !
1226  !     
1227  SUBROUTINE write_ncdf_var4d_real_t(varname,dimname,file,tabvar,time,typevar)
1228    !     
1229    IMPLICIT NONE
1230    !       
1231    CHARACTER(*),INTENT(in) :: varname,file,typevar
1232    CHARACTER(*),DIMENSION(4),INTENT(in) :: dimname
1233    INTEGER :: time,level
1234    REAL*8, DIMENSION(:,:,:,:), INTENT(in) :: tabvar
1235    !
1236    ! local variables
1237    !
1238    INTEGER :: dimid1,dimid2,dimid3,dimid4
1239    INTEGER :: status,ncid
1240    INTEGER :: varid             
1241    !
1242    status = nf90_open(file,NF90_WRITE,ncid)       
1243    IF (status/=nf90_noerr) THEN   
1244       WRITE(*,*)"unable to open netcdf file : ",file
1245       STOP
1246    ENDIF
1247    !     
1248    IF(time==1) THEN
1249       !     
1250       status = nf90_inq_dimid(ncid,dimname(1), dimid1)
1251       status = nf90_inq_dimid(ncid,dimname(2), dimid2)
1252       status = nf90_inq_dimid(ncid,dimname(3), dimid3)
1253       status = nf90_inq_dimid(ncid,dimname(4), dimid4)
1254       status = nf90_redef(ncid)
1255       !     
1256       SELECT CASE(TRIM(typevar))
1257       CASE('double')
1258          status = nf90_def_var(ncid,TRIM(varname),nf90_double,     &
1259               (/dimid1,dimid2,dimid3,dimid4/),varid) 
1260       CASE('float')
1261          status = nf90_def_var(ncid,TRIM(varname),nf90_float,     &
1262               (/dimid1,dimid2,dimid3,dimid4/),varid)   
1263       END SELECT
1264       !
1265       status = nf90_enddef(ncid)
1266
1267    ELSE
1268       status = nf90_inq_varid(ncid, varname, varid)
1269    ENDIF
1270    !   
1271    status = nf90_put_var(ncid,varid,tabvar,start=(/1,1,1,time/))
1272    IF (status/=nf90_noerr) THEN   
1273       WRITE(*,*)"unable to store variable ",varname, &
1274       " in file ",file
1275       STOP
1276    ENDIF
1277    !   
1278    status = nf90_close(ncid)
1279    !
1280  END SUBROUTINE write_ncdf_var4d_real_t
1281  !     
1282  !     
1283  SUBROUTINE write_ncdf_var4d_real_nt(varname,dimname,file,tabvar,time,level,typevar)
1284    !     
1285    IMPLICIT NONE
1286    !       
1287    CHARACTER(*),INTENT(in) :: varname,file,typevar
1288    CHARACTER(*),DIMENSION(4),INTENT(in) :: dimname
1289    INTEGER :: time,level
1290    REAL*8, DIMENSION(:,:,:,:), INTENT(in) :: tabvar
1291    !
1292    ! local variables
1293    !
1294    INTEGER :: dimid1,dimid2,dimid3,dimid4
1295    INTEGER :: status,ncid
1296    INTEGER :: varid             
1297    !
1298    status = nf90_open(file,NF90_WRITE,ncid)       
1299    IF (status/=nf90_noerr) THEN   
1300       WRITE(*,*)"unable to open netcdf file : ",file
1301       STOP
1302    ENDIF
1303    !     
1304    IF(time==1.AND.level==1) THEN
1305       !     
1306       status = nf90_inq_dimid(ncid,dimname(1), dimid1)
1307       status = nf90_inq_dimid(ncid,dimname(2), dimid2)
1308       status = nf90_inq_dimid(ncid,dimname(3), dimid3)
1309       status = nf90_inq_dimid(ncid,dimname(4), dimid4)
1310       status = nf90_redef(ncid)
1311       !     
1312       SELECT CASE(TRIM(typevar))
1313       CASE('double')
1314          status = nf90_def_var(ncid,TRIM(varname),nf90_double,     &
1315               (/dimid1,dimid2,dimid3,dimid4/),varid) 
1316       CASE('float')
1317          status = nf90_def_var(ncid,TRIM(varname),nf90_float,     &
1318               (/dimid1,dimid2,dimid3,dimid4/),varid)   
1319       END SELECT
1320       !
1321       status = nf90_enddef(ncid)
1322
1323    ELSE
1324       status = nf90_inq_varid(ncid, varname, varid)
1325    ENDIF
1326    !   
1327    status = nf90_put_var(ncid,varid,tabvar,start=(/1,1,level,time/))
1328    IF (status/=nf90_noerr) THEN   
1329       WRITE(*,*)"unable to store variable ",varname, &
1330       " in file ",file
1331       STOP
1332    ENDIF
1333    !   
1334    status = nf90_close(ncid)
1335    !
1336  END SUBROUTINE write_ncdf_var4d_real_nt
1337
1338  SUBROUTINE write_ncdf_var0d_real(varname,file,tabvar,typevar)
1339    !     
1340    IMPLICIT NONE
1341    !       
1342    CHARACTER(*),INTENT(in) :: varname,file,typevar
1343    INTEGER :: time,level
1344    REAL*8 :: tabvar
1345    !
1346    ! local variables
1347    !
1348    INTEGER :: status,ncid
1349    INTEGER :: varid             
1350    !
1351    status = nf90_open(file,NF90_WRITE,ncid)       
1352    IF (status/=nf90_noerr) THEN   
1353       WRITE(*,*)"unable to open netcdf file : ",file
1354       STOP
1355    ENDIF
1356    !     
1357
1358    status = nf90_redef(ncid)
1359    !     
1360    SELECT CASE(TRIM(typevar))
1361    CASE('double')
1362       status = nf90_def_var(ncid,TRIM(varname),nf90_double,     &
1363            varid=varid) 
1364    CASE('float')
1365       status = nf90_def_var(ncid,TRIM(varname),nf90_float,     &
1366            varid=varid)   
1367    END SELECT
1368    !
1369    status = nf90_enddef(ncid)
1370
1371    !   
1372    status = nf90_put_var(ncid,varid,tabvar)
1373    IF (status/=nf90_noerr) THEN   
1374       WRITE(*,*)"unable to store variable ",varname, &
1375       " in file ",file
1376       STOP
1377    ENDIF
1378    !   
1379    status = nf90_close(ncid)
1380    !
1381  END SUBROUTINE write_ncdf_var0d_real
1382
1383  SUBROUTINE write_ncdf_var0d_int(varname,file,tabvar,typevar)
1384    !     
1385    IMPLICIT NONE
1386    !       
1387    CHARACTER(*),INTENT(in) :: varname,file,typevar
1388    INTEGER :: tabvar
1389    !
1390    ! local variables
1391    !
1392    INTEGER :: status,ncid
1393    INTEGER :: varid
1394    !
1395    status = nf90_open(file,NF90_WRITE,ncid)
1396    IF (status/=nf90_noerr) THEN
1397       WRITE(*,*)"unable to open netcdf file : ",file
1398       STOP
1399    ENDIF
1400    !     
1401    status = nf90_redef(ncid)
1402    status = nf90_def_var(ncid,TRIM(varname),nf90_int,varid)
1403    status = nf90_enddef(ncid)
1404    status = nf90_put_var(ncid,varid,tabvar)
1405    !     
1406    IF (status/=nf90_noerr) THEN   
1407       WRITE(*,*)"unable to store variable ",varname, &
1408       " in file ",file
1409       STOP
1410    ENDIF
1411    status = nf90_close(ncid)
1412    !
1413  END SUBROUTINE write_ncdf_var0d_int
1414
1415  !
1416  !****************************************************************
1417  !   subroutine read_ncdf_VarName           *
1418  !                        *
1419  ! subroutine to retrieve of all variables        *
1420  ! included in a given file              *
1421  !                        *
1422  !     filename    : netcdf file name          *
1423  !     tabvarname  : array containing various variables names *
1424  !                        *
1425  !****************************************************************
1426  !
1427  !
1428  SUBROUTINE read_ncdf_VarName(filename,tabvarname)
1429    !     
1430    CHARACTER(*),INTENT(in) :: filename
1431    CHARACTER*20,DIMENSION(:),POINTER :: tabvarname
1432    INTEGER :: nDimensions,nVariables
1433    INTEGER :: nAttributes,unlimitedDimId,i
1434    INTEGER :: ncid,status,dimid
1435    !     
1436    status = nf90_open(filename,NF90_NOWRITE,ncid)
1437    IF (status/=nf90_noerr) THEN   
1438       WRITE(*,*)"unable to open netcdf file : ",filename
1439       STOP
1440    ENDIF
1441    !     
1442    status = nf90_inquire(ncid,nDimensions,nVariables,nAttributes, &                                                     
1443         unlimitedDimId) 
1444    !
1445    ALLOCATE(tabvarname(nVariables))
1446    !
1447    DO i=1,nVariables
1448       status = nf90_inquire_variable(ncid,i,tabvarname(i))
1449    END DO
1450
1451  END SUBROUTINE read_ncdf_Varname
1452  !
1453  !
1454  SUBROUTINE copy_ncdf_att_var(varname,filein,fileout)
1455    !     
1456    CHARACTER(*),INTENT(in) :: filein,fileout
1457    CHARACTER(*),INTENT(in) :: varname
1458    INTEGER :: ncid_in,ncid_out,status,varid_in,varid_out
1459    !     
1460    !      print *,'filein = ',filein,fileout
1461    status = nf90_open(filein,NF90_NOWRITE,ncid_in)
1462    IF (status/=nf90_noerr) THEN   
1463       WRITE(*,*)"unable to open input netcdf file : ",filein
1464       STOP
1465    ENDIF
1466    !                                 
1467    status = nf90_open(fileout,NF90_WRITE,ncid_out)
1468    IF (status/=nf90_noerr) THEN   
1469       WRITE(*,*)"unable to open output netcdf file : ",fileout
1470       STOP
1471    ENDIF
1472   
1473    !      print *,'ici1'
1474    status = nf90_inq_varid(ncid_in,varname,varid_in)
1475    status = nf90_inq_varid(ncid_out,varname,varid_out)
1476    !
1477    status = nf90_redef(ncid_out)
1478    !     
1479    status = nf90_copy_att(ncid_in,varid_in,'units',ncid_out,varid_out)
1480    status = nf90_copy_att(ncid_in,varid_in,'valid_min',ncid_out,varid_out)
1481    status = nf90_copy_att(ncid_in,varid_in,'valid_max',ncid_out,varid_out) 
1482    status = nf90_copy_att(ncid_in,varid_in,'long_name',ncid_out,varid_out)
1483    status = nf90_copy_att(ncid_in,varid_in,'calendar',ncid_out,varid_out)
1484    status = nf90_copy_att(ncid_in,varid_in,'title',ncid_out,varid_out)     
1485    status = nf90_copy_att(ncid_in,varid_in,'time_origin',ncid_out,varid_out) 
1486    status = nf90_copy_att(ncid_in,varid_in,'positive',ncid_out,varid_out)                 
1487    status = nf90_copy_att(ncid_in,varid_in,'tstep_sec',ncid_out,varid_out)         
1488    status = nf90_copy_att(ncid_in,varid_in,'nav_model',ncid_out,varid_out)   
1489    status = nf90_copy_att(ncid_in,varid_in,'Minvalue=',ncid_out,varid_out)
1490    status = nf90_copy_att(ncid_in,varid_in,'Maxvalue=',ncid_out,varid_out) 
1491    status = nf90_copy_att(ncid_in,varid_in,'short_name',ncid_out,varid_out)
1492    status = nf90_copy_att(ncid_in,varid_in,'online_operation',ncid_out,varid_out)
1493    status = nf90_copy_att(ncid_in,varid_in,'axis',ncid_out,varid_out)           
1494    status = nf90_copy_att(ncid_in,varid_in,'interval_operation',ncid_out,varid_out)
1495    status = nf90_copy_att(ncid_in,varid_in,'interval_write',ncid_out,varid_out) 
1496    status = nf90_copy_att(ncid_in,varid_in,'associate',ncid_out,varid_out)
1497    status = nf90_copy_att(ncid_in,varid_in,'actual_range',ncid_out,varid_out) 
1498    status = nf90_copy_att(ncid_in,varid_in,'longitude',ncid_out,varid_out)
1499    status = nf90_copy_att(ncid_in,varid_in,'latitude',ncid_out,varid_out)
1500    status = nf90_copy_att(ncid_in,varid_in,'scale_factor',ncid_out,varid_out)
1501    status = nf90_copy_att(ncid_in,varid_in,'add_offset',ncid_out,varid_out)
1502    status = nf90_copy_att(ncid_in,varid_in,'missing_value',ncid_out,varid_out) 
1503    !     
1504    status = nf90_enddef(ncid_out) 
1505    !
1506    status = nf90_close(ncid_in)
1507    status = nf90_close(ncid_out)
1508    !      print *,'ici2'
1509    !
1510  END SUBROUTINE copy_ncdf_att_var
1511  !
1512  !
1513  SUBROUTINE copy_ncdf_att_latlon(varname,filein,fileout,min,max)
1514    !     
1515    CHARACTER(*),INTENT(in) :: filein,fileout
1516    CHARACTER(*),INTENT(in) :: varname
1517    REAL*8 :: min,max
1518    INTEGER :: ncid_in,ncid_out,status,varid_in,varid_out
1519    !     
1520    status = nf90_open(filein,NF90_NOWRITE,ncid_in)
1521    IF (status/=nf90_noerr) THEN   
1522       WRITE(*,*)"unable to open netcdf file : ",filein
1523       STOP
1524    ENDIF
1525    !                                 
1526    status = nf90_open(fileout,NF90_WRITE,ncid_out)
1527    IF (status/=nf90_noerr) THEN   
1528       WRITE(*,*)"unable to open netcdf file : ",fileout
1529       STOP
1530    ENDIF
1531   
1532    status = nf90_inq_varid(ncid_in,varname,varid_in)
1533    status = nf90_inq_varid(ncid_out,varname,varid_out)
1534    !
1535    status = nf90_redef(ncid_out)
1536    !     
1537    SELECT CASE (varname)
1538       !     
1539    CASE('nav_lon')     
1540       status = nf90_copy_att(ncid_in,varid_in,'units',ncid_out,varid_out) 
1541       status = nf90_put_att(ncid_out,varid_out,'valid_min',REAL(min,4))
1542       status = nf90_put_att(ncid_out,varid_out,'valid_max',REAL(max,4))
1543       status = nf90_copy_att(ncid_in,varid_in,'long_name',ncid_out,varid_out)
1544       status = nf90_copy_att(ncid_in,varid_in,'nav_model',ncid_out,varid_out)
1545       status = nf90_copy_att(ncid_in,varid_in,'title',ncid_out,varid_out)
1546       !
1547    CASE('nav_lat')
1548       status = nf90_copy_att(ncid_in,varid_in,'units',ncid_out,varid_out) 
1549       status = nf90_put_att(ncid_out,varid_out,'valid_min',REAL(min,4))
1550       status = nf90_put_att(ncid_out,varid_out,'valid_max',REAL(max,4))
1551       status = nf90_copy_att(ncid_in,varid_in,'long_name',ncid_out,varid_out)
1552       status = nf90_copy_att(ncid_in,varid_in,'nav_model',ncid_out,varid_out)
1553       status = nf90_copy_att(ncid_in,varid_in,'title',ncid_out,varid_out) 
1554       !
1555    END SELECT
1556    !     
1557    status = nf90_enddef(ncid_out) 
1558    !
1559    status = nf90_close(ncid_in)
1560    status = nf90_close(ncid_out)
1561  END SUBROUTINE copy_ncdf_att_latlon
1562
1563  !*************************************************************
1564  !**************************************************************
1565  !
1566  INTEGER FUNCTION Get_NbDims( varname , filename )
1567    !
1568    CHARACTER(*),INTENT(in) :: varname,filename
1569    INTEGER :: status,ncid,varid   
1570    !     
1571    status = nf90_open(TRIM(filename),NF90_NOWRITE,ncid)
1572    IF (status/=nf90_noerr) THEN   
1573       WRITE(*,*)"unable to open netcdf file : ",TRIM(filename)
1574       STOP
1575    ENDIF
1576    status = nf90_inq_varid(ncid,TRIM(varname),varid)     
1577    status = nf90_inquire_variable(ncid, varid , ndims = Get_NbDims)
1578    !
1579    RETURN
1580    !
1581  END FUNCTION Get_NbDims
1582  !
1583  !
1584  LOGICAL FUNCTION Dims_Existence( dimname , filename )
1585    !
1586    CHARACTER(*),INTENT(in) :: dimname,filename
1587    INTEGER :: status,ncid,dimid   
1588    !     
1589    status = nf90_open(TRIM(filename),NF90_NOWRITE,ncid)
1590    IF (status/=nf90_noerr) THEN   
1591       WRITE(*,*)"unable to open netcdf file : ",TRIM(filename)
1592       STOP
1593    ENDIF
1594    status = nf90_inq_dimid(ncid,dimname,dimid)
1595    !     
1596    IF (status/=nf90_noerr) THEN
1597       Dims_Existence = .FALSE.
1598    ELSE
1599       Dims_Existence = .TRUE.
1600    ENDIF
1601    !
1602    RETURN
1603    !
1604  END FUNCTION Dims_Existence
1605  !
1606END MODULE io_netcdf
Note: See TracBrowser for help on using the repository browser.