New URL for NEMO forge!   http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
io_netcdf.f90 in utils/tools/NESTING/src – NEMO

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

Last change on this file since 10025 was 10025, checked in by clem, 6 years ago

nesting tools are partly rewritten (mostly for create_coordinates and bathy) to get better functionality. Now you can use the nesting to either define an agrif zoom or a regional domain (for bdy purposes). Also, the nesting tools output a domain_cfg.nc that can be directly used in NEMO4 without the need of DOMAINcfg tool. The option of median average for bathymetry interpolation still does not work properly but it's not new

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