source: branches/DEV_r1879_FCM/NEMOGCM/TOOLS/NESTING/src/io_netcdf.f90 @ 2143

Last change on this file since 2143 was 2143, checked in by rblod, 10 years ago

Improvement of FCM branch

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