source: branches/2015/dev_r5021_UKMO1_CICE_coupling/NEMOGCM/TOOLS/GRIDGEN/src/io_netcdf.f90 @ 5445

Last change on this file since 5445 was 5445, checked in by davestorkey, 5 years ago

Clear SVN keywords from 2015/dev_r5021_UKMO1_CICE_coupling branch.

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