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.
iom_cdf.f90 in branches/2016/dev_INGV_UKMO_2016/NEMOGCM/TOOLS/SIREN/src – NEMO

source: branches/2016/dev_INGV_UKMO_2016/NEMOGCM/TOOLS/SIREN/src/iom_cdf.f90 @ 7351

Last change on this file since 7351 was 7351, checked in by emanuelaclementi, 7 years ago

ticket #1805 step 3: /2016/dev_INGV_UKMO_2016 aligned to the trunk at revision 7161

File size: 83.6 KB
Line 
1!----------------------------------------------------------------------
2! NEMO system team, System and Interface for oceanic RElocable Nesting
3!----------------------------------------------------------------------
4!
5! MODULE: iom_cdf
6!
7! DESCRIPTION:
8!> @brief NETCDF Input/Output manager :  Library to read Netcdf input files
9!>
10!> @details
11!>    to open netcdf file:<br/>
12!> @code
13!>    CALL iom_cdf_open(td_file)
14!> @endcode
15!>       - td_file is file structure (see @ref file)
16!>
17!>    to write in netcdf file:<br/>
18!> @code
19!>    CALL  iom_cdf_write_file(td_file)
20!> @endcode
21!>
22!>    to close netcdf file:<br/>
23!> @code
24!>    CALL iom_cdf_close(tl_file)
25!> @endcode
26!>
27!>    to read one dimension in netcdf file:<br/>
28!> @code
29!>    tl_dim = iom_cdf_read_dim(tl_file, id_dimid)
30!> @endcode
31!>    or
32!> @code
33!>    tl_dim = iom_cdf_read_dim(tl_file, cd_name)
34!> @endcode
35!>       - id_dimid is dimension id<br/>
36!>       - cd_name is dimension name
37!>
38!>    to read one attribute in netcdf file:<br/>
39!> @code
40!>    tl_att = iom_cdf_read_att(tl_file, id_varid, id_attid)
41!> @endcode
42!>    or
43!> @code
44!>    tl_att = iom_cdf_read_att(tl_file, id_varid, cd_name)
45!> @endcode
46!>       - id_varid is variable id
47!>       - id_attid is attribute id<br/>
48!>       - cd_name is attribute name
49!>   
50!>    to read one variable in netcdf file:<br/>
51!> @code
52!>    tl_var = iom_cdf_read_var(td_file, id_varid, [id_start, id_count])
53!> @endcode
54!>    or
55!> @code
56!>    tl_var = iom_cdf_read_var(td_file, cd_name, [id_start, [id_count,]])
57!> @endcode
58!>       - id_varid is variabale id
59!>       - cd_name is variabale name
60!>       - id_start is a integer(4) 1D array of index from which the data
61!>          values will be read [optional]
62!>       - id_count is a integer(4) 1D array of the number of indices selected
63!>          along each dimension [optional]
64!>
65!> @author
66!> J.Paul
67! REVISION HISTORY:
68!> @date November, 2013 - Initial Version
69!
70!> @note Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
71!----------------------------------------------------------------------
72MODULE iom_cdf
73   USE netcdf                          ! nf90 library
74   USE global                          ! global parameter
75   USE kind                            ! F90 kind parameter
76   USE fct                             ! basic useful function
77   USE logger                          ! log file manager
78   USE att                             ! attribute manage
79   USE dim                             ! dimension manager
80   USE var                             ! variable manager
81   USE file                            ! file manager
82   IMPLICIT NONE
83   ! NOTE_avoid_public_variables_if_possible
84
85   ! function and subroutine
86   PUBLIC :: iom_cdf_open        !< open or create netcdf file, return file structure
87   PUBLIC :: iom_cdf_close       !< close netcdf file
88   PUBLIC :: iom_cdf_read_dim    !< read one dimension in an opened netcdf file, return dimension structure
89   PUBLIC :: iom_cdf_read_att    !< read one attribute in an opened netcdf file, return attribute structure
90   PUBLIC :: iom_cdf_read_var    !< read one variable  in an opened netcdf file, return variable  structure
91   PUBLIC :: iom_cdf_fill_var    !< fill variable value in an opened netcdf file
92   PUBLIC :: iom_cdf_write_file  !< write file structure contents in an opened netcdf file
93
94   PRIVATE :: iom_cdf__check           ! provides a simple interface to netcdf error message
95   PRIVATE :: iom_cdf__get_info        ! get global information in an opened netcdf file
96   PRIVATE :: iom_cdf__get_file_dim    ! read dimension on an opened netcdf file, and reorder it
97   PRIVATE :: iom_cdf__get_file_att    ! read global attribute on an opened netcdf file
98   PRIVATE :: iom_cdf__get_file_var    ! read information about variable on an opened netcdf file
99   PRIVATE :: iom_cdf__read_dim_id     ! read one dimension in an opened netcdf file, given dimension id.
100   PRIVATE :: iom_cdf__read_dim_name   ! read one dimension in an opened netcdf file, given dimension name.
101   PRIVATE :: iom_cdf__read_att_name   ! read variable or global attribute in an opened netcdf file, given attribute name.
102   PRIVATE :: iom_cdf__read_att_id     ! read variable or global attribute in an opened netcdf file, given attribute id.
103   PRIVATE :: iom_cdf__read_var_id     ! read variable value in an opened netcdf file, given variable id.
104   PRIVATE :: iom_cdf__read_var_name   ! read variable value in an opened netcdf file, given variable name or standard name.
105   PRIVATE :: iom_cdf__read_var_meta   ! read metadata of a variable in an opened netcdf file.
106   PRIVATE :: iom_cdf__read_var_dim    ! read variable dimension in an opened netcdf file.
107   PRIVATE :: iom_cdf__read_var_att    ! read variable attributes in an opened netcdf file.
108   PRIVATE :: iom_cdf__read_var_value  ! read variable value in an opened netcdf file.
109   PRIVATE :: iom_cdf__write_dim       ! write one dimension in an opened netcdf file in write mode.
110   PRIVATE :: iom_cdf__write_att       ! write a variable attribute in an opened netcdf file.
111   PRIVATE :: iom_cdf__write_var       ! write a variable in an opened netcdf file.
112   PRIVATE :: iom_cdf__write_var_def   ! define variable in an opened netcdf file.
113   PRIVATE :: iom_cdf__write_var_value ! put variable value in an opened netcdf file.
114   PRIVATE :: iom_cdf__fill_var_id     ! fill variable value in an opened netcdf file, given variable id
115   PRIVATE :: iom_cdf__fill_var_name   ! fill variable value in an opened netcdf file, given variable name
116   PRIVATE :: iom_cdf__fill_var_all    ! fill all variable value in an opened netcdf file
117   PRIVATE :: iom_cdf__del_coord_var   ! remove coordinate variable from an opened netcdf file
118
119   INTERFACE iom_cdf_read_var
120      MODULE PROCEDURE iom_cdf__read_var_id
121      MODULE PROCEDURE iom_cdf__read_var_name
122   END INTERFACE iom_cdf_read_var
123
124   INTERFACE iom_cdf_fill_var
125      MODULE PROCEDURE iom_cdf__fill_var_id
126      MODULE PROCEDURE iom_cdf__fill_var_name
127      MODULE PROCEDURE iom_cdf__fill_var_all
128   END INTERFACE iom_cdf_fill_var
129
130   INTERFACE iom_cdf_read_dim
131      MODULE PROCEDURE iom_cdf__read_dim_id
132      MODULE PROCEDURE iom_cdf__read_dim_name
133   END INTERFACE iom_cdf_read_dim
134
135   INTERFACE iom_cdf_read_att
136      MODULE PROCEDURE iom_cdf__read_att_id
137      MODULE PROCEDURE iom_cdf__read_att_name
138   END INTERFACE iom_cdf_read_att
139
140CONTAINS
141   !-------------------------------------------------------------------
142   !> @brief This subroutine provides a simple interface to
143   !> netcdf error message
144   !>
145   !> @author J.Paul
146   !> @date November, 2013 - Initial Version
147   !> @date May, 2015 - add optional message to netcdf error message
148   !>
149   !> @param[in] id_status error status
150   !> @param[in] cd_msg    message
151   !-------------------------------------------------------------------
152   SUBROUTINE iom_cdf__check(id_status, cd_msg)
153      IMPLICIT NONE
154      ! Argument     
155      INTEGER(i4)     , INTENT(IN)           :: id_status
156      CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_msg
157      ! local variable
158      CHARACTER(LEN=lc) :: cl_msg
159      !----------------------------------------------------------------
160
161      cl_msg=""
162      IF( PRESENT(cd_msg) ) cl_msg=cd_msg
163
164      IF( id_status /= NF90_NOERR )THEN
165         CALL logger_error(TRIM(cl_msg)//TRIM(NF90_STRERROR(id_status)))
166      ENDIF
167
168   END SUBROUTINE iom_cdf__check
169   !-------------------------------------------------------------------
170   !> @brief This subroutine open a netcdf file in read or write mode.
171   !> @details
172   !> if try to open a file in write mode that did not exist, create it.<br/>
173   !> if file already exist, get information about0:<br/>
174   !> - the number of variables
175   !> - the number of dimensions
176   !> - the number of global attributes
177   !> - the ID of the unlimited dimension
178   !> - the file format
179   !> Finally it read dimensions, and 'longitude' variable to compute East-West
180   !> overlap.
181   !>
182   !> @author J.Paul
183   !> @date November, 2013 - Initial Version
184   !
185   !> @param[inout] td_file   file structure
186   !-------------------------------------------------------------------
187   SUBROUTINE iom_cdf_open(td_file)
188      IMPLICIT NONE
189      ! Argument     
190      TYPE(TFILE), INTENT(INOUT)  :: td_file
191
192      ! local variable
193      LOGICAL     :: ll_exist
194      LOGICAL     :: ll_open
195
196      INTEGER(i4) :: il_status
197      !----------------------------------------------------------------
198
199      ! check file existence
200      INQUIRE(FILE=TRIM(td_file%c_name), EXIST=ll_exist, OPENED=ll_open)
201      ! ll_open do not work for netcdf file, always return FALSE
202      IF( .NOT. ll_exist .OR. TRIM(td_file%c_type) /= 'cdf' )THEN
203
204         IF( .NOT. td_file%l_wrt )THEN
205
206            CALL logger_fatal( " IOM CDF OPEN: can not open file "//&
207            &               TRIM(td_file%c_name) )
208 
209         ELSE
210
211            CALL logger_info( " IOM CDF CREATE: file "//TRIM(td_file%c_name) )
212
213            il_status = NF90_CREATE(TRIM(td_file%c_name),&
214            &                       cmode=NF90_64BIT_OFFSET,&
215            &                       ncid=td_file%i_id)
216            CALL iom_cdf__check(il_status," IOM CDF CREATE: ")
217
218            td_file%l_def=.TRUE.
219
220         ENDIF
221
222      ELSE
223
224         IF( td_file%i_id /= 0 )THEN
225
226            CALL logger_error( " IOM CDF OPEN: file "//&
227            &               TRIM(td_file%c_name)//" already opened")
228
229         ELSE
230 
231            IF( .NOT. td_file%l_wrt )THEN
232
233               CALL logger_info( " IOM CDF OPEN: file "//&
234               &              TRIM(td_file%c_name)//" in read only mode" )
235
236               il_status = NF90_OPEN( TRIM(td_file%c_name), &
237               &                      NF90_NOWRITE,         &
238               &                      td_file%i_id)
239               CALL iom_cdf__check(il_status," IOM CDF OPEN: ")
240
241            ELSE
242
243               CALL logger_info( "IOM CDF OPEN: file "//&
244               &              TRIM(td_file%c_name)//" in write mode" )
245
246               il_status = NF90_OPEN( TRIM(td_file%c_name), &
247               &                      NF90_WRITE,           &
248               &                      td_file%i_id)
249               CALL iom_cdf__check(il_status,"IOM CDF OPEN: ")
250
251            ENDIF
252
253            ! get general information about file
254            CALL iom_cdf__get_info(td_file)
255
256            ! read dimension in file
257            CALL iom_cdf__get_file_dim(td_file) 
258
259            ! read global attribute in file
260            CALL iom_cdf__get_file_att(td_file)
261
262            ! get information about variables in file
263            CALL iom_cdf__get_file_var(td_file)
264
265            ! remove dimension variable from list of variable
266            CALL iom_cdf__del_coord_var(td_file)
267
268         ENDIF
269
270      ENDIF
271
272   END SUBROUTINE iom_cdf_open
273   !-------------------------------------------------------------------
274   !> @brief This subroutine close netcdf file.
275   !>
276   !> @author J.Paul
277   !> @date November, 2013 - Initial Version
278   !
279   !> @param[inout] td_file   file structure
280   !-------------------------------------------------------------------
281   SUBROUTINE iom_cdf_close(td_file)
282      IMPLICIT NONE
283      ! Argument     
284      TYPE(TFILE), INTENT(INOUT) :: td_file
285
286      ! local variable
287      INTEGER(i4) :: il_status
288      !----------------------------------------------------------------
289
290      ! check if file opened
291      IF( td_file%i_id == 0 )THEN
292
293         CALL logger_error( &
294         &  " IOM CDF CLOSE: no id associated to file "//TRIM(td_file%c_name))
295
296      ELSE
297         CALL logger_info( &
298         &  " IOM CDF CLOSE: file "//TRIM(td_file%c_name))
299
300         il_status = NF90_CLOSE(td_file%i_id)
301         CALL iom_cdf__check(il_status,"IOM CDF CLOSE: ")
302
303         td_file%i_id = 0
304
305      ENDIF
306
307   END SUBROUTINE iom_cdf_close
308   !-------------------------------------------------------------------
309   !> @brief This subroutine get global information in an opened netcdf
310   !> file.
311   !> @details
312   !> It gets the number of variables, the number of dimensions,
313   !> the number of global attributes, the ID of the unlimited dimension
314   !> and finally the format version and filled file strucuture with it.
315   !>
316   !> @author J.Paul
317   !> @date November, 2013 - Initial Version
318   !
319   !> @param[inout] td_file   file structure
320   !-------------------------------------------------------------------
321   SUBROUTINE iom_cdf__get_info(td_file)
322      IMPLICIT NONE
323      ! Argument     
324      TYPE(TFILE), INTENT(INOUT) :: td_file
325
326      ! local variable
327      INTEGER(i4) :: il_fmt   ! format version
328      INTEGER(i4) :: il_status
329      !----------------------------------------------------------------
330
331      CALL logger_trace( &
332      &  " IOM CDF GET INFO: about netcdf file "//TRIM(td_file%c_name))
333
334      il_status=NF90_INQUIRE(td_file%i_id, td_file%i_ndim, &
335      &     td_file%i_nvar, td_file%i_natt, td_file%i_uldid, il_fmt)
336      CALL iom_cdf__check(il_status,"IOM CDF GET INFO: ")
337
338      SELECT CASE(il_fmt)
339         CASE(nf90_format_classic, nf90_format_64bit)
340            td_file%c_type='cdf'
341         CASE(nf90_format_netcdf4, nf90_format_netcdf4_classic)
342            td_file%c_type='cdf4'
343      END SELECT
344
345      ! record header infos
346      td_file%i_rhd=1
347
348   END SUBROUTINE iom_cdf__get_info
349   !-------------------------------------------------------------------
350   !> @brief This subroutine read dimension on an opened netcdf file, and
351   !> reorder dimension to ('x', 'y', 'z', 't').
352   !> The dimension structure inside file structure is then completed.
353   !
354   !> @author J.Paul
355   !> @date November, 2013 - Initial Version
356   !
357   !> @param[inout] td_file   file structure
358   !-------------------------------------------------------------------
359   SUBROUTINE iom_cdf__get_file_dim(td_file)
360      IMPLICIT NONE
361      ! Argument     
362      TYPE(TFILE), INTENT(INOUT) :: td_file
363      ! local variable
364      TYPE(TDIM) :: tl_dim
365
366      ! loop indices
367      INTEGER(i4) :: ji
368      INTEGER(i4) :: ii
369      !----------------------------------------------------------------
370
371      ! clean dimension
372      DO ji=1,ip_maxdim
373         CALL dim_clean(td_file%t_dim(ji))
374      ENDDO
375
376      IF( td_file%i_ndim > 0 )THEN
377         ii=1
378         DO ji = 1, td_file%i_ndim
379            ! read dimension information
380            tl_dim=iom_cdf_read_dim( td_file, ji)
381            IF( .NOT. dim_is_dummy(tl_dim) )THEN
382               IF( ii > ip_maxdim )THEN
383                  CALL logger_fatal("IOM CDF OPEN: too much dimension "//&
384                  & "to be read. you should remove dummy dimension using "//&
385                  & " configuration file")
386               ENDIF
387               td_file%t_dim(ii)=dim_copy(tl_dim)
388               ii=ii+1
389            ENDIF
390         ENDDO
391
392         ! inform unlimited dimension
393         IF( td_file%i_uldid == -1 )THEN
394            CALL logger_warn( &
395            &  " IOM CDF GET FILE DIM: there is no unlimited dimension in file "//&
396            &  TRIM(td_file%c_name))
397         ELSE
398            td_file%t_dim( td_file%i_uldid )%l_uld=.TRUE.
399         ENDIF
400
401      ELSE
402
403         CALL logger_warn( &
404         &  " IOM CDF GET FILE DIM: there is no dimension in file "//&
405         &  TRIM(td_file%c_name))
406
407      ENDIF
408
409      ! reorder dimension to ('x','y','z','t')
410      CALL dim_reorder(td_file%t_dim(:))
411
412   END SUBROUTINE iom_cdf__get_file_dim
413   !-------------------------------------------------------------------
414   !> @brief This subroutine read global attribute on an opened netcdf
415   !> file.
416   !> The attribute structure inside file structure is then completed.
417   !
418   !> @author J.Paul
419   !> @date November, 2013 - Initial Version
420   !> @date September, 2014
421   !> - use attribute periodicity read from the file if present.
422   !
423   !> @param[inout] td_file   file structure
424   !-------------------------------------------------------------------
425   SUBROUTINE iom_cdf__get_file_att(td_file)
426      IMPLICIT NONE
427      ! Argument     
428      TYPE(TFILE), INTENT(INOUT) :: td_file
429
430      ! local variable
431      TYPE(TATT) :: tl_att
432
433      ! loop indices
434      INTEGER(i4) :: ji
435      INTEGER(i4) :: ii
436      !----------------------------------------------------------------
437
438      IF( td_file%i_natt > 0 )THEN
439         IF(ASSOCIATED(td_file%t_att))THEN
440            CALL att_clean(td_file%t_att(:))
441            DEALLOCATE(td_file%t_att)
442         ENDIF
443         ALLOCATE(td_file%t_att(td_file%i_natt))
444
445         ii=1
446         DO ji = 1, td_file%i_natt
447            ! read global attribute
448            tl_att=iom_cdf_read_att( td_file, NF90_GLOBAL, ji)
449            IF( .NOT. att_is_dummy(tl_att) )THEN
450               td_file%t_att(ii)=att_copy(tl_att)
451               ii=ii+1
452            ENDIF
453           
454         ENDDO
455
456      ELSE
457         CALL logger_debug( &
458         &  " IOM CDF GET FILE ATT: there is no global attribute in file "//&
459         &  TRIM(td_file%c_name))
460      ENDIF
461
462   END SUBROUTINE iom_cdf__get_file_att
463   !-------------------------------------------------------------------
464   !> @brief This subroutine read information about variable of an
465   !> opened netcdf file.
466   !> The variable structure inside file structure is then completed.
467   !> @note variable value are not read !
468   !
469   !> @author J.Paul
470   !> @date November, 2013 - Initial Version
471   !> @date September, 2015
472   !> - manage useless (dummy) variable
473   !> @date January, 2016
474   !> - increment n3d for 4D variable
475   !
476   !> @param[inout] td_file   file structure
477   !-------------------------------------------------------------------
478   SUBROUTINE iom_cdf__get_file_var(td_file)
479      IMPLICIT NONE
480      ! Argument     
481      TYPE(TFILE), INTENT(INOUT) :: td_file
482
483      ! local variable
484      INTEGER(i4) :: il_attid
485      INTEGER(i4) :: il_nvar
486
487      TYPE(TVAR), DIMENSION(:), ALLOCATABLE  :: tl_var
488
489      ! loop indices
490      INTEGER(i4) :: ji
491      INTEGER(i4) :: ii
492      !----------------------------------------------------------------
493
494      IF( td_file%i_nvar > 0 )THEN
495
496         IF(ASSOCIATED(td_file%t_var))THEN
497            CALL var_clean(td_file%t_var(:))
498            DEALLOCATE(td_file%t_var)
499         ENDIF
500
501         il_nvar=td_file%i_nvar
502         ALLOCATE(tl_var(il_nvar))
503         ii=0
504         DO ji = 1, il_nvar
505           ! read variable information
506           tl_var(ji)=iom_cdf__read_var_meta( td_file, ji) 
507           IF( .NOT. var_is_dummy(tl_var(ji)) )THEN
508              ii=ii+1
509           ENDIF
510         ENDDO
511
512         ! update number of variable used
513         td_file%i_nvar=ii
514
515         ALLOCATE(td_file%t_var(td_file%i_nvar))
516
517         ii=0
518         DO ji = 1, il_nvar
519            IF( .NOT. var_is_dummy(tl_var(ji)) )THEN
520               ii=ii+1
521               td_file%t_var(ii)=var_copy(tl_var(ji))
522               SELECT CASE(td_file%t_var(ii)%i_ndim)
523                  CASE(0)
524                     td_file%i_n0d=td_file%i_n0d+1
525                  CASE(1)
526                     td_file%i_n1d=td_file%i_n1d+1
527                     td_file%i_rhd=td_file%i_rhd+1
528                  CASE(2)
529                     td_file%i_n2d=td_file%i_n2d+1
530                     td_file%i_rhd=td_file%i_rhd+1
531                  CASE(3,4)
532                     td_file%i_n3d=td_file%i_n3d+1
533                     td_file%i_rhd=td_file%i_rhd+td_file%t_dim(3)%i_len
534               END SELECT
535
536               ! look for depth id
537               IF( INDEX(TRIM(fct_lower(td_file%t_var(ii)%c_name)),'depth')/=0 )THEN
538                  IF( td_file%i_depthid == 0 )THEN
539                     td_file%i_depthid=ji
540                  ELSE
541                     IF( td_file%i_depthid /= ji )THEN
542                        CALL logger_error("IOM CDF GET FILE VAR: find more"//&
543                           &  " than one depth variable in file "//&
544                           &  TRIM(td_file%c_name) )
545                     ENDIF
546                  ENDIF
547               ENDIF
548
549               ! look for time id
550               IF( INDEX(TRIM(fct_lower(td_file%t_var(ii)%c_name)),'time')/=0 )THEN
551                  IF( td_file%i_timeid == 0 )THEN
552                     td_file%i_timeid=ji
553                  ELSE
554                     il_attid=0
555                     IF( ASSOCIATED(td_file%t_var(ii)%t_att) )THEN
556                        il_attid=att_get_id(td_file%t_var(ii)%t_att(:),'calendar')
557                     ENDIF
558                     IF( il_attid /= 0 )THEN
559                        td_file%i_timeid=ji
560                     !ELSE
561                     !   CALL logger_error("IOM CDF GET FILE VAR: find more "//&
562                     !   &                 "than one time variable in file "//&
563                     !   &                 TRIM(td_file%c_name) )
564                     ENDIF
565                  ENDIF
566               ENDIF
567
568            ENDIF
569         ENDDO
570
571         CALL var_clean(tl_var(:))
572         DEALLOCATE(tl_var)
573
574      ELSE
575         CALL logger_debug( &
576         &  " IOM CDF GET FILE VAR: there is no variable in file "//&
577         &  TRIM(td_file%c_name))
578      ENDIF
579
580   END SUBROUTINE iom_cdf__get_file_var
581   !-------------------------------------------------------------------
582   !> @brief This subroutine delete coordinate variable from an
583   !> opened netcdf file if present.
584   !
585   !> @author J.Paul
586   !> @date November, 2013 - Initial Version
587   !
588   !> @param[inout] td_file   file structure
589   !-------------------------------------------------------------------
590   SUBROUTINE iom_cdf__del_coord_var(td_file)
591      IMPLICIT NONE
592      ! Argument     
593      TYPE(TFILE), INTENT(INOUT) :: td_file
594
595      ! local variable
596      CHARACTER(LEN=lc) :: cl_name
597      CHARACTER(LEN=lc) :: cl_sname
598
599      ! loop indices
600      INTEGER(i4) :: ji
601      INTEGER(i4) :: jj
602      !----------------------------------------------------------------
603      IF( td_file%i_nvar > 0 )THEN
604         DO ji=td_file%i_nvar,1,-1
605            cl_name=TRIM(td_file%t_var(ji)%c_name)
606            DO jj=1,ip_maxdim
607               IF( td_file%t_dim(jj)%l_use )THEN
608                  cl_sname=fct_upper(td_file%t_dim(jj)%c_sname)
609                  IF( TRIM(cl_name) == TRIM(cl_sname) )THEN
610                     CALL file_del_var(td_file,TRIM(cl_name))
611                     EXIT
612                  ENDIF
613               ENDIF
614            ENDDO
615         ENDDO
616      ELSE
617         CALL logger_debug( &
618         &  " IOM CDF DEL VAR DIM: there is no variable in file "//&
619         &  TRIM(td_file%c_name))
620      ENDIF
621   END SUBROUTINE iom_cdf__del_coord_var
622   !-------------------------------------------------------------------
623   !> @brief This function read one dimension in an opened netcdf file,
624   !> given dimension id.
625   !
626   !> @author J.Paul
627   !> @date November, 2013 - Initial Version
628   !> @date February, 2015 - create unused dimension, when reading dimension
629   !> of length less or equal to zero
630   !
631   !> @param[in] td_file   file structure
632   !> @param[in] id_dimid  dimension id
633   !> @return  dimension structure
634   !-------------------------------------------------------------------
635   TYPE(TDIM) FUNCTION iom_cdf__read_dim_id(td_file, id_dimid)
636      IMPLICIT NONE
637      ! Argument     
638      TYPE(TFILE), INTENT(IN) :: td_file
639      INTEGER(i4), INTENT(IN) :: id_dimid
640
641      ! local variable
642      INTEGER(i4)       :: il_status
643      INTEGER(i4)       :: il_len
644      CHARACTER(LEN=lc) :: cl_name
645      LOGICAL           :: ll_use
646      !----------------------------------------------------------------
647
648      ! check if file opened
649      IF( td_file%i_id == 0 )THEN
650
651         CALL logger_error( &
652         &  " IOM CDF READ DIM: no id associated to file "//TRIM(td_file%c_name))
653
654      ELSE     
655
656         CALL logger_trace( &
657         &  " IOM CDF READ DIM: dimension "//TRIM(fct_str(id_dimid))//&
658         &  " in file "//TRIM(td_file%c_name))
659
660         il_status=NF90_INQUIRE_DIMENSION(td_file%i_id, id_dimid, &
661         &                                cl_name, il_len )
662         CALL iom_cdf__check(il_status,"IOM CDF READ DIM: ")
663
664         ll_use=.TRUE.
665         IF( il_len <= 0 )THEN
666            CALL logger_warn( &
667         &  " IOM CDF READ DIM: dimension "//TRIM(fct_str(id_dimid))//&
668         &  " in file "//TRIM(td_file%c_name)//" is less or equel to zero")
669            il_len=1
670            ll_use=.FALSE.
671         ENDIF
672         iom_cdf__read_dim_id=dim_init(cl_name, il_len, ld_use=ll_use)
673
674      ENDIF
675
676      iom_cdf__read_dim_id%i_id=id_dimid
677
678   END FUNCTION iom_cdf__read_dim_id
679   !-------------------------------------------------------------------
680   !> @brief This function read one dimension in an opened netcdf file,
681   !> given dimension name.
682   !
683   !> @author J.Paul
684   !> @date November, 2013 - Initial Version
685   !
686   !> @param[in] td_file   file structure
687   !> @param[in] cd_name   dimension name
688   !> @return  dimension structure
689   !-------------------------------------------------------------------
690   TYPE(TDIM) FUNCTION iom_cdf__read_dim_name(td_file, cd_name)
691      IMPLICIT NONE
692      ! Argument     
693      TYPE(TFILE),      INTENT(IN) :: td_file
694      CHARACTER(LEN=*), INTENT(IN) :: cd_name
695
696      ! local variable
697      INTEGER(i4) :: il_status
698      INTEGER(i4) :: il_dimid
699      !----------------------------------------------------------------
700
701      ! check if file opened
702      IF( td_file%i_id == 0 )THEN
703
704         CALL logger_error( &
705         &  " IOM CDF READ DIM: no id associated to file "//&
706         &  TRIM(td_file%c_name))
707
708      ELSE     
709
710         il_status=NF90_INQ_DIMID( td_file%i_id, TRIM(ADJUSTL(cd_name)), &
711         &                         il_dimid)
712         CALL iom_cdf__check(il_status,"IOM CDF READ DIM: ")
713
714         iom_cdf__read_dim_name=iom_cdf_read_dim(td_file, il_dimid)
715
716      ENDIF
717
718   END FUNCTION iom_cdf__read_dim_name
719   !-------------------------------------------------------------------
720   !> @brief This function read variable or global attribute in an opened
721   !> netcdf file, given attribute name.
722   !
723   !> @author J.Paul
724   !> @date November, 2013 - Initial Version
725   !
726   !> @param[in] td_file   file structure
727   !> @param[in] id_varid  variable id. use NF90_GLOBAL to read global
728   !> attribute in a file
729   !> @param[in] cd_name   attribute name
730   !> @return  attribute structure
731   !-------------------------------------------------------------------
732   TYPE(TATT) FUNCTION iom_cdf__read_att_name(td_file, id_varid, cd_name)
733      IMPLICIT NONE
734      ! Argument     
735      TYPE(TFILE),      INTENT(IN) :: td_file
736      INTEGER(i4),      INTENT(IN) :: id_varid
737      CHARACTER(LEN=*), INTENT(IN) :: cd_name
738
739      ! local variable
740      CHARACTER(LEN=lc) :: cl_name
741
742      INTEGER(i4) :: il_status
743      INTEGER(i4) :: il_attid
744      INTEGER(i4) :: il_type
745      INTEGER(i4) :: il_len
746
747      CHARACTER(LEN=lc) :: cl_value
748     
749      INTEGER(i1), DIMENSION(:), ALLOCATABLE :: bl_value
750      INTEGER(i2), DIMENSION(:), ALLOCATABLE :: sl_value
751      INTEGER(i4), DIMENSION(:), ALLOCATABLE :: il_value
752      REAL(sp)   , DIMENSION(:), ALLOCATABLE :: fl_value
753      REAL(dp)   , DIMENSION(:), ALLOCATABLE :: dl_value
754      !----------------------------------------------------------------
755      ! check if file opened
756      IF( td_file%i_id == 0 )THEN
757
758         CALL logger_error( &
759         &  " IOM CDF READ ATT: no id associated to file "//TRIM(td_file%c_name))
760
761      ELSE     
762
763         cl_name=TRIM(ADJUSTL(cd_name))
764
765         ! inquire attribute
766         IF( id_varid == NF90_GLOBAL )THEN
767
768            CALL logger_trace( &
769            &  " IOM CDF READ ATT: inquire global attribute "//&
770            &  " in file "//TRIM(td_file%c_name))
771
772         ELSE
773
774            CALL logger_trace( &
775            &  " IOM CDF READ ATT: inquire attribute "//&
776            &  " of variable "//TRIM(fct_str(id_varid))//&
777            &  " in file "//TRIM(td_file%c_name))
778
779         ENDIF
780
781         il_status=NF90_INQUIRE_ATTRIBUTE(td_file%i_id, id_varid,  &
782         &                                cl_name,&
783         &                                il_type,&
784         &                                il_len, &
785         &                                il_attid )
786         CALL iom_cdf__check(il_status,"IOM CDF READ ATT: ")
787
788         !! get attribute value
789         CALL logger_debug( " IOM CDF READ ATT: get attribute "//&
790            &            TRIM(cl_name)//" in file "//TRIM(td_file%c_name))
791
792         SELECT CASE( il_type )
793
794            CASE(NF90_CHAR)
795
796               ! check string lengths
797               IF( LEN(cl_value) < il_len )THEN
798
799                  CALL logger_warn( &
800                  &  " IOM CDF READ ATT: not enough space to put "//&
801                  &  "attribute "//TRIM(cl_name) )
802
803               ELSE
804
805                  ! Read the attributes
806                  il_status=NF90_GET_ATT(td_file%i_id, id_varid, &
807                  &                      cl_name, &
808                  &                      cl_value )
809                  CALL iom_cdf__check(il_status,"IOM CDF READ ATT: ")
810
811                  iom_cdf__read_att_name=att_init(cl_name, cl_value)
812
813               ENDIF
814         
815            CASE(NF90_BYTE)
816
817               ALLOCATE( bl_value( il_len), &
818               &         stat=il_status)
819               IF(il_status /= 0 )THEN
820
821                  CALL logger_error( "IOM CDF READ ATT: "//&
822                  &  "not enough space to put attribute "//TRIM(cl_name) )
823
824               ELSE
825
826                  ! Read the attributes
827                  il_status=NF90_GET_ATT(td_file%i_id, id_varid, &
828                  &                      cl_name, &
829                  &                      bl_value(:))
830                  CALL iom_cdf__check(il_status,"IOM CDF READ ATT: ")   
831
832                  iom_cdf__read_att_name=att_init(cl_name, bl_value(:))
833
834               ENDIF
835
836               DEALLOCATE(bl_value)
837
838            CASE(NF90_SHORT)
839
840               ALLOCATE( sl_value( il_len), &
841               &         stat=il_status)
842               IF(il_status /= 0 )THEN
843
844                  CALL logger_error( &
845                  &  " IOM CDF READ ATT: not enough space to put "//&
846                  &  "attribute "//TRIM(cl_name) )
847
848               ELSE
849
850                  ! Read the attributes
851                  il_status=NF90_GET_ATT(td_file%i_id, id_varid, &
852                  &                      cl_name, &
853                  &                      sl_value(:))
854                  CALL iom_cdf__check(il_status,"IOM CDF READ ATT: ")   
855
856                  iom_cdf__read_att_name=att_init(cl_name, sl_value(:))
857
858               ENDIF
859
860               DEALLOCATE(sl_value)
861
862            CASE(NF90_INT)
863
864               ALLOCATE( il_value( il_len), &
865               &         stat=il_status)
866               IF(il_status /= 0 )THEN
867
868                  CALL logger_error( &
869                  &  " IOM CDF READ ATT: not enough space to put "//&
870                  &  "attribute "//TRIM(cl_name) )
871
872               ELSE
873
874                  ! Read the attributes
875                  il_status=NF90_GET_ATT(td_file%i_id, id_varid, &
876                  &                      cl_name, &
877                  &                      il_value(:))
878                  CALL iom_cdf__check(il_status,"IOM CDF READ ATT: ")   
879
880                  iom_cdf__read_att_name=att_init(cl_name, il_value(:))
881               ENDIF
882
883               DEALLOCATE(il_value)
884
885            CASE(NF90_FLOAT)
886
887               ALLOCATE( fl_value( il_len), &
888               &         stat=il_status)
889               IF(il_status /= 0 )THEN
890
891                  CALL logger_error( &
892                  &  " IOM CDF READ ATT: not enough space to put "//&
893                  &  "attribute "//TRIM(cl_name) )
894
895               ELSE
896
897                  ! Read the attributes
898                  il_status=NF90_GET_ATT(td_file%i_id, id_varid, &
899                  &                      cl_name, &
900                  &                      fl_value(:))
901                  CALL iom_cdf__check(il_status,"IOM CDF READ ATT: ")   
902
903                  iom_cdf__read_att_name=att_init(cl_name, fl_value(:))
904
905               ENDIF
906
907               DEALLOCATE(fl_value)
908
909            CASE(NF90_DOUBLE)
910
911               ALLOCATE( dl_value( il_len), &
912               &         stat=il_status)
913               IF(il_status /= 0 )THEN
914
915                  CALL logger_error( &
916                  &  " IOM CDF READ ATT: not enough space to put "//&
917                  &  "attribute "//TRIM(cl_name) )
918
919               ELSE
920
921                  ! Read the attributes
922                  il_status=NF90_GET_ATT(td_file%i_id, id_varid, &
923                  &                      cl_name, &
924                  &                      dl_value(:))
925                  CALL iom_cdf__check(il_status,"IOM CDF READ ATT: ")   
926
927                  iom_cdf__read_att_name=att_init(cl_name, dl_value(:))
928
929               ENDIF
930
931               DEALLOCATE(dl_value)
932
933         END SELECT
934
935         iom_cdf__read_att_name%i_id=il_attid
936
937      ENDIF
938
939   END FUNCTION iom_cdf__read_att_name
940   !-------------------------------------------------------------------
941   !> @brief This function read variable or global attribute in an opened
942   !> netcdf file, given attribute id.
943   !
944   !> @author J.Paul
945   !> @date November, 2013 - Initial Version
946   !
947   !> @param[in] td_file   file structure
948   !> @param[in] id_varid  variable id. use NF90_GLOBAL to read global
949   !> attribute in a file
950   !> @param[in] id_attid  attribute id
951   !> @return  attribute structure
952   !-------------------------------------------------------------------
953   TYPE(TATT) FUNCTION iom_cdf__read_att_id(td_file, id_varid, id_attid)
954      IMPLICIT NONE
955      ! Argument     
956      TYPE(TFILE), INTENT(IN) :: td_file
957      INTEGER(i4), INTENT(IN) :: id_varid
958      INTEGER(i4), INTENT(IN) :: id_attid
959
960      ! local variable
961      INTEGER(i4)       :: il_status
962      CHARACTER(LEN=lc) :: cl_name
963      !----------------------------------------------------------------
964      ! check if file opened
965      IF( td_file%i_id == 0 )THEN
966
967         CALL logger_error( &
968         &  "IOM CDF READ ATT: no id associated to file "//TRIM(td_file%c_name))
969
970      ELSE
971
972         ! get attribute name
973         il_status=NF90_INQ_ATTNAME(td_file%i_id, id_varid, id_attid, cl_name)
974         CALL iom_cdf__check(il_status,"IOM CDF READ ATT: ")
975
976         ! read attribute
977         iom_cdf__read_att_id=iom_cdf__read_att_name(td_file, id_varid, cl_name)
978
979      ENDIF
980
981   END FUNCTION iom_cdf__read_att_id
982   !-------------------------------------------------------------------
983   !> @brief This function read variable value in an opened
984   !> netcdf file, given variable id.
985   !> @details
986   !> Optionaly, start indices and number of indices selected along each dimension
987   !> could be specify in a 4 dimension array (/'x','y','z','t'/)
988   !
989   !> @author J.Paul
990   !> @date November, 2013 - Initial Version
991   !
992   !> @param[in] td_file   file structure
993   !> @param[in] id_varid  variable id
994   !> @param[in] id_start  index in the variable from which the data values
995   !> will be read
996   !> @param[in] id_count  number of indices selected along each dimension
997   !> @return  variable structure
998   !-------------------------------------------------------------------
999   TYPE(TVAR) FUNCTION iom_cdf__read_var_id(td_file, id_varid,&
1000   &                                        id_start, id_count)
1001      IMPLICIT NONE
1002      ! Argument     
1003      TYPE(TFILE),               INTENT(IN) :: td_file
1004      INTEGER(i4),               INTENT(IN) :: id_varid
1005      INTEGER(i4), DIMENSION(:), INTENT(IN), OPTIONAL :: id_start
1006      INTEGER(i4), DIMENSION(:), INTENT(IN), OPTIONAL :: id_count
1007
1008      ! local variable
1009      INTEGER(i4), DIMENSION(1) :: il_ind
1010      !----------------------------------------------------------------
1011      ! check if file opened
1012      IF( td_file%i_id == 0 )THEN
1013
1014         CALL logger_error( &
1015         &  " IOM CDF READ VAR: no id associated to file "//TRIM(td_file%c_name))
1016
1017      ELSE
1018
1019         ! look for variable index
1020         il_ind(:)=MINLOC(td_file%t_var(:)%i_id,mask=(td_file%t_var(:)%i_id==id_varid))
1021         IF( il_ind(1) /= 0 )THEN
1022
1023            iom_cdf__read_var_id=var_copy(td_file%t_var(il_ind(1)))
1024
1025            !!! read variable value
1026            CALL iom_cdf__read_var_value(td_file, iom_cdf__read_var_id, &
1027            &                            id_start, id_count)
1028
1029         ELSE
1030            CALL logger_error( &
1031            &  " IOM CDF READ VAR: there is no variable with id "//&
1032            &  TRIM(fct_str(id_varid))//" in file "//TRIM(td_file%c_name))
1033         ENDIF
1034
1035      ENDIF
1036   END FUNCTION iom_cdf__read_var_id
1037   !-------------------------------------------------------------------
1038   !> @brief This function read variable value in an opened
1039   !> netcdf file, given variable name or standard name.
1040   !> @details
1041   !> Optionaly, start indices and number of indices selected along each dimension
1042   !> could be specify in a 4 dimension array (/'x','y','z','t'/)
1043   !>
1044   !> look first for variable name. If it doesn't
1045   !> exist in file, look for variable standard name.<br/>
1046   !
1047   !> @author J.Paul
1048   !> @date November, 2013 - Initial Version
1049   !
1050   !> @param[in] td_file   file structure
1051   !> @param[in] cd_name   variable name or standard name.
1052   !> @param[in] id_start  index in the variable from which the data values will be read
1053   !> @param[in] id_count  number of indices selected along each dimension
1054   !> @return  variable structure
1055   !-------------------------------------------------------------------
1056   TYPE(TVAR) FUNCTION iom_cdf__read_var_name(td_file, cd_name,  &
1057   &                                          id_start, id_count )
1058      IMPLICIT NONE
1059      ! Argument     
1060      TYPE(TFILE)     ,                INTENT(IN) :: td_file
1061      CHARACTER(LEN=*),                INTENT(IN), OPTIONAL :: cd_name
1062      INTEGER(i4)     , DIMENSION(:),  INTENT(IN), OPTIONAL :: id_start
1063      INTEGER(i4)     , DIMENSION(:),  INTENT(IN), OPTIONAL :: id_count
1064
1065      ! local variable
1066      INTEGER(i4)       :: il_varid
1067      !----------------------------------------------------------------
1068      ! check if file opened
1069      IF( td_file%i_id == 0 )THEN
1070
1071         CALL logger_error( &
1072         &  " IOM CDF READ VAR: no id associated to file "//TRIM(td_file%c_name))
1073
1074      ELSE
1075
1076         IF( .NOT. PRESENT(cd_name) )THEN
1077
1078            CALL logger_error( &
1079            &  " IOM CDF READ VAR: you must specify a variable to read "//&
1080            &  " in file "//TRIM(td_file%c_name))
1081
1082         ELSE
1083
1084            il_varid=var_get_index(td_file%t_var(:), cd_name)
1085            IF( il_varid /= 0 )THEN
1086
1087               iom_cdf__read_var_name=var_copy(td_file%t_var(il_varid))
1088
1089               !!! read variable value
1090               CALL iom_cdf__read_var_value( td_file, &
1091               &                             iom_cdf__read_var_name, &
1092               &                             id_start, id_count)
1093
1094            ELSE
1095
1096               CALL logger_error( &
1097               &  " IOM CDF READ VAR: there is no variable with "//&
1098               &  " name or standard name "//TRIM(cd_name)//&
1099               &  " in file "//TRIM(td_file%c_name) )
1100            ENDIF
1101
1102         ENDIF
1103
1104      ENDIF
1105     
1106   END FUNCTION iom_cdf__read_var_name
1107   !-------------------------------------------------------------------
1108   !> @brief This subroutine fill all variable value from an opened
1109   !> netcdf file.
1110   !> @details
1111   !> Optionaly, start indices and number of indices selected along each dimension
1112   !> could be specify in a 4 dimension array (/'x','y','z','t'/)
1113   !
1114   !> @author J.Paul
1115   !> @date November, 2013 - Initial Version
1116   !
1117   !> @param[inout] td_file   file structure
1118   !> @param[in] id_start     index in the variable from which the data values
1119   !> will be read
1120   !> @param[in] id_count     number of indices selected along each dimension
1121   !-------------------------------------------------------------------
1122   SUBROUTINE iom_cdf__fill_var_all(td_file, id_start, id_count)
1123      IMPLICIT NONE
1124      ! Argument     
1125      TYPE(TFILE),               INTENT(INOUT) :: td_file
1126      INTEGER(i4), DIMENSION(:), INTENT(IN   ),  OPTIONAL :: id_start
1127      INTEGER(i4), DIMENSION(:), INTENT(IN   ),  OPTIONAL :: id_count
1128
1129      ! local variable
1130
1131      ! loop indices
1132      INTEGER(i4) :: ji
1133      !----------------------------------------------------------------
1134      ! check if file opened
1135      IF( td_file%i_id == 0 )THEN
1136
1137         CALL logger_error( &
1138         &  " IOM CDF FILL VAR: no id associated to file "//TRIM(td_file%c_name))
1139
1140      ELSE
1141
1142         DO ji=1,td_file%i_nvar
1143            CALL iom_cdf_fill_var(td_file, td_file%t_var(ji)%i_id, &
1144            &                     id_start, id_count)
1145         ENDDO
1146
1147      ENDIF
1148   END SUBROUTINE iom_cdf__fill_var_all
1149   !-------------------------------------------------------------------
1150   !> @brief This subroutine fill variable value in an opened
1151   !> netcdf file, given variable id.
1152   !> @details
1153   !> Optionaly, start indices and number of indices selected along each dimension
1154   !> could be specify in a 4 dimension array (/'x','y','z','t'/)
1155   !
1156   !> @author J.Paul
1157   !> @date November, 2013 - Initial Version
1158   !
1159   !> @param[inout] td_file   file structure
1160   !> @param[in] id_varid     variable id
1161   !> @param[in] id_start     index in the variable from which the data values
1162   !> will be read
1163   !> @param[in] id_count     number of indices selected along each dimension
1164   !-------------------------------------------------------------------
1165   SUBROUTINE iom_cdf__fill_var_id(td_file, id_varid, id_start, id_count)
1166      IMPLICIT NONE
1167      ! Argument     
1168      TYPE(TFILE),               INTENT(INOUT) :: td_file
1169      INTEGER(i4),               INTENT(IN)    :: id_varid
1170      INTEGER(i4), DIMENSION(:), INTENT(IN),  OPTIONAL :: id_start
1171      INTEGER(i4), DIMENSION(:), INTENT(IN),  OPTIONAL :: id_count
1172
1173      ! local variable
1174      INTEGER(i4), DIMENSION(1) :: il_varid
1175
1176      ! loop indices
1177      INTEGER(i4) :: ji
1178      !----------------------------------------------------------------
1179      ! check if file opened
1180      IF( td_file%i_id == 0 )THEN
1181
1182         CALL logger_error( &
1183         &  "IOM CDF FILL VAR: no id associated to file "//TRIM(td_file%c_name))
1184
1185      ELSE
1186
1187         ! look for variable id
1188         il_varid(:)=MINLOC( td_file%t_var(:)%i_id, &
1189         &                 mask=(td_file%t_var(:)%i_id==id_varid))
1190         IF( il_varid(1) /= 0 )THEN
1191
1192            !!! read variable value
1193            CALL iom_cdf__read_var_value(td_file, td_file%t_var(il_varid(1)), &
1194            &                            id_start, id_count)
1195
1196            DO ji=1,td_file%i_nvar
1197               CALL logger_debug(" IOM CDF FILL VAR: var id "//&
1198               &     TRIM(td_file%t_var(ji)%c_name)//" "//&
1199               &     TRIM(fct_str(td_file%t_var(ji)%i_id)) )
1200            ENDDO
1201         ELSE
1202            CALL logger_error( &
1203            &  " IOM CDF FILL VAR: there is no variable with id "//&
1204            &  TRIM(fct_str(id_varid))//" in file "//TRIM(td_file%c_name))
1205         ENDIF
1206
1207      ENDIF
1208   END SUBROUTINE iom_cdf__fill_var_id
1209   !-------------------------------------------------------------------
1210   !> @brief This subroutine fill variable value in an opened
1211   !> netcdf file, given variable name or standard name.
1212   !> @details
1213   !> Optionaly, start indices and number of indices selected along each dimension
1214   !> could be specify in a 4 dimension array (/'x','y','z','t'/)
1215   !>
1216   !> look first for variable name. If it doesn't
1217   !> exist in file, look for variable standard name.<br/>
1218   !
1219   !> @author J.Paul
1220   !> @date November, 2013 - Initial Version
1221   !
1222   !> @param[inout] td_file   file structure
1223   !> @param[in] cd_name      variable name or standard name
1224   !> @param[in] id_start     index in the variable from which the data values will be read
1225   !> @param[in] id_count     number of indices selected along each dimension
1226   !-------------------------------------------------------------------
1227   SUBROUTINE iom_cdf__fill_var_name(td_file, cd_name, id_start, id_count )
1228      IMPLICIT NONE
1229      ! Argument     
1230      TYPE(TFILE),                   INTENT(INOUT) :: td_file
1231      CHARACTER(LEN=*),              INTENT(IN)    :: cd_name
1232      INTEGER(i4),     DIMENSION(:), INTENT(IN),  OPTIONAL :: id_start
1233      INTEGER(i4),     DIMENSION(:), INTENT(IN),  OPTIONAL :: id_count
1234
1235      ! local variable
1236      INTEGER(i4)       :: il_varid
1237      !----------------------------------------------------------------
1238      ! check if file opened
1239      IF( td_file%i_id == 0 )THEN
1240
1241         CALL logger_error( &
1242         &  "IOM CDF FILL VAR: no id associated to file "//TRIM(td_file%c_name))
1243
1244      ELSE
1245
1246            il_varid=var_get_index(td_file%t_var(:), cd_name)
1247            IF( il_varid /= 0 )THEN
1248
1249               !!! read variable value
1250               CALL iom_cdf__read_var_value(td_file, td_file%t_var(il_varid), &
1251               &                            id_start, id_count)
1252
1253            ELSE
1254
1255               CALL logger_error( &
1256               &  "IOM CDF FILL VAR: there is no variable with "//&
1257               &  "name or standard name"//TRIM(cd_name)//&
1258               &  " in file "//TRIM(td_file%c_name))
1259            ENDIF
1260
1261      ENDIF
1262     
1263   END SUBROUTINE iom_cdf__fill_var_name
1264   !-------------------------------------------------------------------
1265   !> @brief This function read metadata of a variable in an opened
1266   !> netcdf file.
1267   !
1268   !> @note variable value are not read
1269   !
1270   !> @author J.Paul
1271   !> @date November, 2013 - Initial Version
1272   !> @date September, 2014
1273   !> - force to use FillValue=1.e20 if no FillValue for coordinate variable.
1274   !> @date September, 2015
1275   !> - manage useless (dummy) attribute
1276   !
1277   !> @param[in] td_file   file structure
1278   !> @param[in] id_varid  variable id
1279   !> @return  variable structure
1280   !-------------------------------------------------------------------
1281   TYPE(TVAR) FUNCTION iom_cdf__read_var_meta(td_file, id_varid)
1282      IMPLICIT NONE
1283      ! Argument     
1284      TYPE(TFILE), INTENT(IN) :: td_file
1285      INTEGER(i4), INTENT(IN) :: id_varid
1286
1287      ! local variable
1288      CHARACTER(LEN=lc)                                       :: cl_name
1289
1290      INTEGER(i4)                                             :: il_status
1291      INTEGER(i4)                                             :: il_type
1292      INTEGER(i4)                                             :: il_ndim
1293      INTEGER(i4)                                             :: il_natt
1294      INTEGER(i4)                                             :: il_attid
1295      INTEGER(i4), DIMENSION(NF90_MAX_VAR_DIMS)               :: il_dimid
1296
1297      TYPE(TDIM) , DIMENSION(ip_maxdim)                       :: tl_dim
1298      TYPE(TATT)                                              :: tl_fill
1299      TYPE(TATT) , DIMENSION(:)                 , ALLOCATABLE :: tl_att
1300      TYPE(TATT) , DIMENSION(:)                 , ALLOCATABLE :: tl_tmp
1301
1302      ! loop indices
1303      INTEGER(i4) :: ji
1304      !----------------------------------------------------------------
1305      ! check if file opened
1306      IF( td_file%i_id == 0 )THEN
1307
1308         CALL logger_error( &
1309         &  " IOM CDF READ VAR META: no id associated to file "//&
1310         &   TRIM(td_file%c_name))
1311
1312      ELSE
1313
1314         ! inquire variable
1315         CALL logger_debug( &
1316         &  " IOM CDF READ VAR META: inquire variable "//&
1317         &  TRIM(fct_str(id_varid))//&
1318         &  " in file "//TRIM(td_file%c_name))
1319         
1320         il_dimid(:)=0
1321
1322         il_status=NF90_INQUIRE_VARIABLE( td_file%i_id, id_varid,        &
1323         &                                cl_name,    &
1324         &                                il_type,    &
1325         &                                il_ndim,    &
1326         &                                il_dimid(:),&
1327         &                                il_natt )
1328         CALL iom_cdf__check(il_status,"IOM CDF READ VAR META: ")
1329
1330         !!! fill variable dimension structure
1331         tl_dim(:)=iom_cdf__read_var_dim( td_file, il_ndim, cl_name, il_dimid(:) )
1332
1333         IF( il_natt /= 0 )THEN
1334            ALLOCATE( tl_att(il_natt) )
1335            !!! fill variable attribute structure
1336            tl_att(:)=iom_cdf__read_var_att(td_file, id_varid, il_natt)
1337
1338            !! look for _FillValue. if none add one
1339            il_attid=att_get_id(tl_att(:),'_FillValue')
1340            IF( il_attid == 0 )THEN
1341               CALL logger_info("IOM CDF READ VAR META: no _FillValue for variable "//&
1342               &  TRIM(cl_name)//" in file "//TRIM(td_file%c_name) )
1343
1344               il_attid=att_get_id(tl_att(:),'missing_value')
1345               IF( il_attid /= 0 )THEN
1346                  ! create attribute _FillValue
1347                  CALL logger_info("IOM CDF READ VAR META: assume _FillValue is equal to "//&
1348                  &                "missing_value for variable "//TRIM(cl_name) )
1349                  tl_fill=att_init('_FillValue',tl_att(il_attid)%d_value(:), &
1350                  &                 id_type=tl_att(il_attid)%i_type)
1351               ELSE
1352                  ! create attribute _FillValue
1353                  SELECT CASE(TRIM(fct_lower(cl_name)))
1354                     CASE DEFAULT
1355                        CALL logger_info("IOM CDF READ VAR META: assume _FillValue is equal to "//&
1356                        &                "zero for variable "//TRIM(cl_name) )
1357                        tl_fill=att_init('_FillValue',0.)
1358                     CASE('nav_lon','nav_lat', 'nav_lev', &
1359                        &  'glamt','glamu','glamv','glamf', &
1360                        &  'gphit','gphiu','gphiv','gphif')
1361                        CALL logger_info("IOM CDF READ VAR META: assume _FillValue is equal to "//&
1362                        &                "dummy fillValue (1.e20) for variable "//TRIM(cl_name) )
1363                        tl_fill=att_init('_FillValue',1.e20)
1364                  END SELECT
1365               ENDIF
1366
1367               ALLOCATE( tl_tmp(il_natt) )
1368               ! save read attribut
1369               tl_tmp(:)=att_copy(tl_att(:))
1370               ! change number of attribute in array
1371               CALL att_clean(tl_att(:))
1372               DEALLOCATE( tl_att )
1373               ALLOCATE( tl_att(il_natt+1) )
1374               ! copy read attribut
1375               tl_att(1:il_natt)=att_copy(tl_tmp(:))
1376               ! clean
1377               CALL att_clean(tl_tmp(:))
1378               DEALLOCATE( tl_tmp )
1379
1380               ! create attribute _FillValue
1381               tl_att(il_natt+1)=att_copy(tl_fill)
1382
1383            ENDIF
1384
1385         ELSE
1386            ALLOCATE(tl_att(il_natt+1) )
1387            ! create attribute _FillValue
1388            SELECT CASE(TRIM(fct_lower(cl_name)))
1389               CASE DEFAULT
1390                  CALL logger_info("IOM CDF READ VAR META: assume _FillValue is equal to "//&
1391                  &                "zero for variable "//TRIM(cl_name) )
1392                  tl_fill=att_init('_FillValue',0.)
1393               CASE('nav_lon','nav_lat', &
1394                  &  'glamt','glamu','glamv','glamf', &
1395                  &  'gphit','gphiu','gphiv','gphif')
1396                  CALL logger_info("IOM CDF READ VAR META: assume _FillValue is equal to "//&
1397                  &                "dummy fillValue (1.e20) for variable "//TRIM(cl_name) )
1398                  tl_fill=att_init('_FillValue',1.e20)
1399            END SELECT           
1400            ! create attribute _FillValue
1401            tl_att(il_natt+1)=att_copy(tl_fill)
1402         ENDIF
1403
1404         !! initialize variable
1405         iom_cdf__read_var_meta=var_init( cl_name, il_type, tl_dim(:), &
1406         &                                tl_att(:), id_id=id_varid )
1407
1408         !! look for dummy attribute
1409         DO ji=il_natt,1,-1
1410            IF( att_is_dummy(tl_att(ji)) )THEN
1411               CALL var_del_att(iom_cdf__read_var_meta, tl_att(ji))
1412            ENDIF
1413         ENDDO
1414
1415         ! clean
1416         CALL dim_clean(tl_dim(:))
1417         CALL att_clean(tl_fill)
1418         CALL att_clean(tl_att(:))
1419         DEALLOCATE( tl_att )
1420
1421      ENDIF
1422
1423   END FUNCTION iom_cdf__read_var_meta
1424   !-------------------------------------------------------------------
1425   !> @brief This subroutine read variable dimension
1426   !> in an opened netcdf file.
1427   !>
1428   !> @details
1429   !> the number of dimension can't exceed 4,
1430   !> and should be 'x', 'y', 'z', 't' (whatever their order).<br/>
1431   !> If the number of dimension read is less than 4, the array of dimension
1432   !> strucure is filled with unused dimension.<br/>
1433   !> So the array of dimension structure of a variable is always compose of 4
1434   !> dimension (use or not).
1435   !>
1436   !> @warn dummy dimension are not used.
1437   !>
1438   !> @author J.Paul
1439   !> @date November, 2013 - Initial Version
1440   !> @date July, 2015
1441   !> - Bug fix: use order to disorder table (see dim_init)
1442   !> @date September, 2015
1443   !> - check dummy dimension
1444   !>
1445   !> @param[in] td_file   file structure
1446   !> @param[in] id_ndim   number of dimension
1447   !> @param[in] cd_name   variable name
1448   !> @param[in] id_dimid  array of dimension id
1449   !> @return array dimension structure
1450   !-------------------------------------------------------------------
1451   FUNCTION iom_cdf__read_var_dim(td_file, id_ndim, cd_name, id_dimid)
1452      IMPLICIT NONE
1453      ! Argument     
1454      TYPE(TFILE),               INTENT(IN) :: td_file
1455      INTEGER(i4),               INTENT(IN) :: id_ndim
1456      CHARACTER(LEN=*)         , INTENT(IN) :: cd_name
1457      INTEGER(i4), DIMENSION(:), INTENT(IN) :: id_dimid
1458
1459      ! function
1460      TYPE(TDIM), DIMENSION(ip_maxdim) :: iom_cdf__read_var_dim
1461
1462      ! local variable
1463      INTEGER(i4), DIMENSION(ip_maxdim) :: il_xyzt2
1464
1465      TYPE(TDIM) , DIMENSION(ip_maxdim) :: tl_dim
1466
1467      ! loop indices
1468      INTEGER(i4) :: ji
1469      INTEGER(i4) :: ii
1470      !----------------------------------------------------------------
1471
1472      IF( id_ndim == 0 )THEN
1473
1474         tl_dim(:)%l_use=.FALSE.
1475
1476         ! reorder dimension to ('x','y','z','t')
1477         CALL dim_reorder(tl_dim(:))
1478
1479         iom_cdf__read_var_dim(:)=dim_copy(tl_dim(:))
1480
1481         ! clean
1482         CALL dim_clean(tl_dim(:))
1483
1484      ELSE IF( id_ndim > 0 )THEN
1485
1486
1487         ii=1
1488         DO ji = 1, id_ndim
1489
1490            !!! check no dummy dimension to be used
1491            IF( ANY(td_file%t_dim(:)%i_id == id_dimid(ji)) )THEN
1492               IF( ii > ip_maxdim )THEN
1493                  CALL logger_error(" IOM CDF READ VAR DIM: "//&
1494                  &  "too much dimensions for variable "//&
1495                  &  TRIM(cd_name)//". check dummy configuration file.")
1496               ENDIF
1497
1498               CALL logger_debug( " IOM CDF READ VAR DIM: get variable "//&
1499                  &  "dimension "//TRIM(fct_str(ji)) )
1500
1501               il_xyzt2(ii)=td_file%t_dim(id_dimid(ji))%i_xyzt2
1502
1503               ! read dimension information
1504               tl_dim(ii) = dim_init( td_file%t_dim(il_xyzt2(ii))%c_name, &
1505               &                      td_file%t_dim(il_xyzt2(ii))%i_len )
1506           
1507               ii=ii+1
1508            ELSE
1509               CALL logger_debug( " IOM CDF READ VAR DIM: dummy variable "//&
1510               &  "dimension "//TRIM(fct_str(ji))//" not used." )
1511            ENDIF
1512         ENDDO
1513
1514         ! reorder dimension to ('x','y','z','t')
1515         CALL dim_reorder(tl_dim(:))
1516 
1517         iom_cdf__read_var_dim(:)=dim_copy(tl_dim(:))
1518
1519         ! clean
1520         CALL dim_clean(tl_dim(:))
1521
1522      ENDIF
1523
1524   END FUNCTION iom_cdf__read_var_dim
1525   !-------------------------------------------------------------------
1526   !> @brief This subroutine read variable attributes
1527   !> in an opened netcdf file.
1528   !
1529   !> @author J.Paul
1530   !> @date November, 2013 - Initial Version
1531   !
1532   !> @param[in] td_file   file structure
1533   !> @param[in] id_varid  variable id
1534   !> @param[in] id_natt   number of attributes
1535   !> @return array of attribute structure
1536   !-------------------------------------------------------------------
1537   FUNCTION iom_cdf__read_var_att(td_file, id_varid, id_natt)
1538      IMPLICIT NONE
1539      ! Argument     
1540      TYPE(TFILE), INTENT(IN) :: td_file
1541      INTEGER(i4), INTENT(IN) :: id_varid
1542      INTEGER(i4), INTENT(IN) :: id_natt     
1543
1544      ! function
1545      TYPE(TATT), DIMENSION(id_natt) :: iom_cdf__read_var_att
1546
1547      ! local variable
1548
1549      ! loop indices
1550      INTEGER(i4) :: ji
1551      !----------------------------------------------------------------
1552
1553      IF( id_natt > 0 )THEN
1554     
1555         ! read attributes
1556         DO ji = 1, id_natt
1557            CALL logger_trace( " IOM CDF READ VAR ATT: get attribute "//&
1558            &               TRIM(fct_str(ji)) )
1559
1560            iom_cdf__read_var_att(ji)=iom_cdf_read_att(td_file, id_varid, ji)
1561
1562         ENDDO
1563
1564      ELSE
1565
1566         CALL logger_debug( " IOM CDF READ VAR ATT: no attribute for variable " )
1567
1568      ENDIF
1569
1570   END FUNCTION iom_cdf__read_var_att
1571   !-------------------------------------------------------------------
1572   !> @brief This subroutine read variable value
1573   !> in an opened netcdf file.
1574   !> @details
1575   !> Optionaly, start indices and number of indices selected along each dimension
1576   !> could be specify in a 4 dimension array (/'x','y','z','t'/)
1577   !
1578   !> @author J.Paul
1579   !> @date November, 2013 - Initial Version
1580   !> @date June, 2015
1581   !> - use scale factor and offset, as soon as read variable value
1582   !
1583   !> @param[in] td_file   file structure
1584   !> @param[inout] td_var variable structure
1585   !> @param[in] id_start  index in the variable from which the data values will be read
1586   !> @param[in] id_count  number of indices selected along each dimension
1587   !> @return variable structure completed
1588   !-------------------------------------------------------------------
1589   SUBROUTINE iom_cdf__read_var_value(td_file, td_var, &
1590   &                                  id_start, id_count )
1591      IMPLICIT NONE
1592      ! Argument     
1593      TYPE(TFILE),               INTENT(IN)    :: td_file
1594      TYPE(TVAR) ,               INTENT(INOUT) :: td_var
1595      INTEGER(i4), DIMENSION(:), INTENT(IN),   OPTIONAL :: id_start
1596      INTEGER(i4), DIMENSION(:), INTENT(IN),   OPTIONAL :: id_count
1597
1598      ! local variable
1599      INTEGER(i4)                                    :: il_status
1600      INTEGER(i4)                                    :: il_tmp1
1601      INTEGER(i4)                                    :: il_tmp2
1602      INTEGER(i4)                                    :: il_varid
1603      INTEGER(i4), DIMENSION(ip_maxdim)              :: il_start
1604      INTEGER(i4), DIMENSION(ip_maxdim)              :: il_count
1605      INTEGER(i4), DIMENSION(ip_maxdim)              :: il_start_ord
1606      INTEGER(i4), DIMENSION(ip_maxdim)              :: il_count_ord
1607
1608      REAL(dp)   , DIMENSION(:,:,:,:)  , ALLOCATABLE :: dl_value
1609      REAL(dp)   , DIMENSION(:,:,:,:)  , ALLOCATABLE :: dl_tmp
1610
1611      ! loop indices
1612      INTEGER(i4) :: ji
1613      !----------------------------------------------------------------
1614
1615      ! check if variable in file structure
1616      il_varid=var_get_id(td_file%t_var(:),TRIM(td_var%c_name))
1617      IF( il_varid /= 0 )THEN
1618
1619         ! check id_count and id_start optionals parameters...
1620         IF( (       PRESENT(id_start)  .AND. (.NOT. PRESENT(id_count))) .OR. &
1621             ((.NOT. PRESENT(id_start)) .AND.        PRESENT(id_count) ) )THEN
1622            CALL logger_warn( "IOM CDF READ VAR VALUE: id_start and id_count"//&
1623               & " should be both specify")
1624         ENDIF
1625         IF( PRESENT(id_start).AND.PRESENT(id_count) )THEN
1626
1627            IF( SIZE(id_start(:)) /= ip_maxdim .OR. &
1628            &   SIZE(id_count(:)) /= ip_maxdim )THEN
1629               CALL logger_error("IOM CDF READ VAR: dimension of array start"//&
1630                  &  " or count are invalid to read variable "//&
1631                  &  TRIM(td_var%c_name)//" in file "//TRIM(td_file%c_name) )
1632            ENDIF
1633
1634            ! change dimension order from ('x','y','z','t')
1635            il_start(:)=dim_reorder_xyzt2(td_var%t_dim, id_start(:))
1636            il_count(:)=dim_reorder_xyzt2(td_var%t_dim, id_count(:))
1637
1638            ! keep ordered array ('x','y','z','t')
1639            il_start_ord(:)=id_start(:)
1640            il_count_ord(:)=id_count(:)
1641
1642         ELSE
1643
1644            ! change dimension order from ('x','y','z','t')
1645            il_start(:)=(/1,1,1,1/)
1646            il_count(:)=dim_reorder_xyzt2(td_var%t_dim(:),td_var%t_dim(:)%i_len)
1647
1648            ! keep ordered array ('x','y','z','t')
1649            il_start_ord(:)=(/1,1,1,1/)
1650            il_count_ord(:)=td_var%t_dim(:)%i_len
1651
1652         ENDIF
1653
1654         ! check dimension
1655         IF( .NOT. ALL(il_start_ord(:)>=(/1,1,1,1/)) )THEN
1656
1657            CALL logger_error( "IOM CDF READ VAR VALUE: start indices should"//&
1658            &  " be greater than or equal to 1")
1659
1660         ENDIF
1661
1662         IF(.NOT.ALL(il_start_ord(:)+il_count_ord(:)-1 <= &
1663            &  (/td_var%t_dim( 1 )%i_len,&
1664            &    td_var%t_dim( 2 )%i_len,&
1665            &    td_var%t_dim( 3 )%i_len,&
1666            &    td_var%t_dim( 4 )%i_len &
1667            &                                            /)) )THEN
1668
1669            DO ji = 1, ip_maxdim
1670               il_tmp1=il_start_ord(ji)+il_count_ord(ji)-1
1671               il_tmp2=td_var%t_dim(ji)%i_len
1672               CALL logger_debug( "IOM CDF READ VAR VALUE: start + count -1:"//&
1673               &  TRIM(fct_str(il_tmp1))//" variable dimension"//&
1674               &  TRIM(fct_str(il_tmp2)))
1675            ENDDO
1676            CALL logger_error( "IOM CDF READ VAR VALUE: start + count exceed "//&
1677            &  "variable dimension for "//TRIM(td_var%c_name) )
1678
1679         ELSE
1680
1681            ! Allocate space to hold variable value (disorder)
1682            ALLOCATE(dl_value( il_count(1), &
1683               &               il_count(2), &
1684               &               il_count(3), &
1685               &               il_count(4)),&
1686               &               stat=il_status)
1687            IF( il_status /= 0 )THEN
1688
1689              CALL logger_error( &
1690               &  "IOM CDF READ VAR VALUE: not enough space to put variable "//&
1691               &  TRIM(td_var%c_name))
1692
1693            ENDIF
1694
1695            ! read values
1696            CALL logger_debug( &
1697            &  "IOM CDF READ VAR VALUE: get variable "//TRIM(td_var%c_name)//&
1698            &  " in file "//TRIM(td_file%c_name))
1699
1700            il_status = NF90_GET_VAR( td_file%i_id, il_varid,           &
1701            &                                       dl_value(:,:,:,:),  &
1702            &                                       start = il_start(:),&
1703            &                                       count = il_count(:) )
1704            CALL iom_cdf__check(il_status,"IOM CDF READ VAR VALUE: ")
1705
1706            ! Allocate space to hold variable value in structure
1707            IF( ASSOCIATED(td_var%d_value) )THEN
1708               DEALLOCATE(td_var%d_value)   
1709            ENDIF
1710 
1711            ! new dimension length
1712            td_var%t_dim(:)%i_len=il_count_ord(:)
1713
1714!>   dummy patch for pgf95
1715            ALLOCATE( dl_tmp( td_var%t_dim(1)%i_len, &
1716            &                 td_var%t_dim(2)%i_len, &
1717            &                 td_var%t_dim(3)%i_len, &
1718            &                 td_var%t_dim(4)%i_len),&
1719            &        stat=il_status)
1720            IF(il_status /= 0 )THEN
1721
1722               CALL logger_error( &
1723               &  "IOM CDF READ VAR VALUE: not enough space to put variable "//&
1724               &  TRIM(td_var%c_name)//&
1725               &  " in variable structure")
1726            ENDIF
1727            dl_tmp(:,:,:,:)=td_var%d_fill
1728
1729            ! reshape values to be ordered as ('x','y','z','t')
1730            dl_tmp(:,:,:,:)=dim_reshape_2xyzt(td_var%t_dim(:), &
1731            &                                 dl_value(:,:,:,:))
1732
1733            DEALLOCATE(dl_value)
1734
1735            ALLOCATE(td_var%d_value( td_var%t_dim(1)%i_len, &
1736            &                        td_var%t_dim(2)%i_len, &
1737            &                        td_var%t_dim(3)%i_len, &
1738            &                        td_var%t_dim(4)%i_len),&
1739            &        stat=il_status)
1740            IF(il_status /= 0 )THEN
1741
1742               CALL logger_error( &
1743               &  "IOM CDF READ VAR VALUE: not enough space to put variable "//&
1744               &  TRIM(td_var%c_name)//&
1745               &  " in variable structure")
1746
1747            ENDIF
1748!            ! FillValue by default
1749!            td_var%d_value(:,:,:,:)=td_var%d_fill
1750!
1751!            ! reshape values to be ordered as ('x','y','z','t')
1752!            td_var%d_value(:,:,:,:)=dim_reshape_2xyzt(td_var%t_dim(:), &
1753!            &                                         dl_value(:,:,:,:))
1754!
1755!            DEALLOCATE(dl_value)
1756
1757            td_var%d_value(:,:,:,:)=dl_tmp(:,:,:,:)
1758            DEALLOCATE(dl_tmp)
1759!<   dummy patch for pgf95
1760
1761            ! force to change _FillValue to avoid mistake
1762            ! with dummy zero _FillValue
1763            IF( td_var%d_fill == 0._dp )THEN
1764               CALL var_chg_FillValue(td_var)
1765            ENDIF
1766
1767            ! use scale factor and offset
1768            WHERE( td_var%d_value(:,:,:,:) /= td_var%d_fill )
1769               td_var%d_value(:,:,:,:) = &
1770               &  td_var%d_value(:,:,:,:)*td_var%d_scf + td_var%d_ofs
1771            END WHERE
1772
1773         ENDIF
1774      ELSE
1775         CALL logger_error( &
1776         &  "IOM CDF READ VAR VALUE: no variable "//TRIM(td_var%c_name)//&
1777         &  " in file structure "//TRIM(td_file%c_name))
1778      ENDIF
1779
1780   END SUBROUTINE iom_cdf__read_var_value
1781   !-------------------------------------------------------------------
1782   !> @brief This subroutine write file structure in an opened netcdf file.
1783   !>
1784   !> @details
1785   !> optionally, you could specify dimension order (default 'xyzt')
1786   !>
1787   !> @author J.Paul
1788   !> @date November, 2013 - Initial Version
1789   !> @date July, 2015
1790   !> - add dimension order option
1791   !
1792   !> @param[inout] td_file   file structure
1793   !-------------------------------------------------------------------
1794   SUBROUTINE iom_cdf_write_file(td_file, cd_dimorder)
1795      IMPLICIT NONE
1796      ! Argument     
1797      TYPE(TFILE)     , INTENT(INOUT) :: td_file
1798      CHARACTER(LEN=*), INTENT(IN   ), OPTIONAL :: cd_dimorder
1799
1800      ! local variable
1801      INTEGER(i4), DIMENSION(:), ALLOCATABLE :: il_value
1802
1803      CHARACTER(LEN=lc)                      :: cl_dimorder
1804
1805      TYPE(TVAR)                             :: tl_var
1806
1807      TYPE(TDIM), DIMENSION(ip_maxdim)       :: tl_dim
1808
1809      ! loop indices
1810      INTEGER(i4) :: ji
1811      INTEGER(i4) :: jj
1812      INTEGER(i4) :: jvar
1813      !----------------------------------------------------------------
1814
1815      cl_dimorder='xyzt'
1816      IF( PRESENT(cd_dimorder) ) cl_dimorder=TRIM(cd_dimorder)
1817
1818      ! check if file opened
1819      IF( td_file%i_id == 0 )THEN
1820
1821         CALL logger_error( &
1822         &  " IOM CDF WRITE FILE: no id associated to file "//TRIM(td_file%c_name))
1823
1824      ELSE
1825         IF( td_file%l_wrt )THEN
1826
1827            ! remove dummy variable
1828            CALL file_del_var(td_file,'no0d')
1829            CALL file_del_var(td_file,'no1d')
1830            CALL file_del_var(td_file,'no2d')
1831            CALL file_del_var(td_file,'no3d')
1832
1833            DO ji = 1, td_file%i_nvar
1834               CALL var_check_dim( td_file%t_var(ji) )
1835            ENDDO
1836
1837            ! save usefull dimension
1838            IF( ASSOCIATED(td_file%t_var) )THEN
1839               tl_dim(:)=var_max_dim(td_file%t_var(:))
1840
1841               DO ji=1,ip_maxdim
1842                  IF( tl_dim(ji)%l_use ) CALL file_move_dim(td_file, tl_dim(ji))
1843               ENDDO
1844               ! clean
1845               CALL dim_clean(tl_dim(:))
1846            ENDIF
1847
1848            ! change dimension order
1849            IF( TRIM(cl_dimorder) /= 'xyzt' )THEN
1850               CALL dim_reorder(td_file%t_dim(:),TRIM(cl_dimorder))
1851               DO jvar=1,td_file%i_nvar
1852                  CALL logger_debug("VAR REORDER: "//TRIM(td_file%t_var(jvar)%c_name))
1853                  CALL var_reorder(td_file%t_var(jvar),TRIM(cl_dimorder))
1854               ENDDO
1855            ENDIF
1856
1857            ! write dimension in file
1858            DO ji = 1, ip_maxdim
1859               IF( td_file%t_dim(ji)%l_use )THEN
1860                  CALL iom_cdf__write_dim(td_file, td_file%t_dim(ji))
1861
1862                  ! write dimension variable
1863                  ALLOCATE(il_value(td_file%t_dim(ji)%i_len))
1864                  il_value(:)=(/(jj,jj=1,td_file%t_dim(ji)%i_len)/)
1865
1866                  tl_var=var_init( fct_upper(td_file%t_dim(ji)%c_sname), &
1867                  &                il_value(:),                          &
1868                  &                td_dim=td_file%t_dim(ji) )
1869
1870                  DEALLOCATE(il_value)
1871
1872                  ! do not use FillValue for dimension variable
1873                  CALL var_del_att(tl_var, "_FillValue")
1874                   
1875                  CALL iom_cdf__write_var(td_file,tl_var)
1876                  ! clean
1877                  CALL var_clean(tl_var)
1878
1879               ENDIF
1880            ENDDO
1881
1882            ! write global attibute in file
1883            DO ji = 1, td_file%i_natt
1884               CALL iom_cdf__write_att(td_file, NF90_GLOBAL, td_file%t_att(ji))
1885            ENDDO
1886
1887            ! write variable in file
1888            DO ji = 1, td_file%i_nvar
1889               CALL iom_cdf__write_var(td_file, td_file%t_var(ji)) 
1890            ENDDO
1891
1892         ELSE
1893
1894            CALL logger_error( &
1895            &  "IOM CDF WRITE FILE: try to write in file "//TRIM(td_file%c_name)//&
1896            &  ", not opened in write mode")
1897
1898         ENDIF
1899      ENDIF
1900
1901   END SUBROUTINE iom_cdf_write_file
1902   !-------------------------------------------------------------------
1903   !> @brief This subroutine write one dimension in an opened netcdf
1904   !> file in write mode.
1905   !
1906   !> @author J.Paul
1907   !> @date November, 2013 - Initial Version
1908   !
1909   !> @param[inout] td_file   file structure
1910   !> @param[inout] td_dim    dimension structure
1911   !-------------------------------------------------------------------
1912   SUBROUTINE iom_cdf__write_dim(td_file, td_dim)
1913      IMPLICIT NONE
1914      ! Argument     
1915      TYPE(TFILE), INTENT(INOUT) :: td_file
1916      TYPE(TDIM),  INTENT(INOUT) :: td_dim
1917
1918      ! local variable
1919      INTEGER(i4) :: il_status
1920      !----------------------------------------------------------------
1921
1922      IF( .NOT. td_file%l_def )THEN
1923
1924         CALL logger_trace( &
1925         &  " IOM CDF WRITE FILE DIM: Enter define mode, file "//TRIM(td_file%c_name))
1926
1927         ! Enter define mode
1928         il_status=NF90_REDEF(td_file%i_id)
1929         CALL iom_cdf__check(il_status,"IOM CDF WRITE FILE DIM: ")
1930
1931         td_file%l_def=.TRUE.
1932
1933      ENDIF
1934
1935      IF( td_dim%l_use )THEN
1936         IF( td_dim%l_uld )THEN
1937            ! write unlimited dimension
1938            CALL logger_trace( &
1939            &  "IOM CDF WRITE FILE DIM: write unlimited dimension "//&
1940            &  TRIM(td_dim%c_name)//" in file "//TRIM(td_file%c_name))
1941
1942            il_status=NF90_DEF_DIM(td_file%i_id, fct_upper(td_dim%c_sname), &
1943            &                      NF90_UNLIMITED, td_dim%i_id)
1944            CALL iom_cdf__check(il_status,"IOM CDF WRITE FILE DIM: ")
1945
1946         ELSE
1947            ! write not unlimited dimension
1948            CALL logger_debug( &
1949            &  "IOM CDF WRITE FILE DIM: write dimension "//TRIM(td_dim%c_name)//&
1950            &  " in file "//TRIM(td_file%c_name))
1951           
1952            il_status=NF90_DEF_DIM(td_file%i_id, fct_upper(td_dim%c_sname), &
1953            &                      td_dim%i_len, td_dim%i_id)
1954            CALL iom_cdf__check(il_status,"IOM CDF WRITE FILE DIM: ")
1955
1956         ENDIF
1957      ENDIF
1958
1959   END SUBROUTINE iom_cdf__write_dim
1960   !-------------------------------------------------------------------
1961   !> @brief This subroutine write a variable attribute in
1962   !> an opened netcdf file.
1963   !
1964   !> @author J.Paul
1965   !> @date November, 2013 - Initial Version
1966   !
1967   !> @param[inout] td_file   file structure
1968   !> @param[in] id_varid     variable id. use NF90_GLOBAL to write
1969   !> global attribute in a file
1970   !> @param[in] td_att       attribute structure
1971   !-------------------------------------------------------------------
1972   SUBROUTINE iom_cdf__write_att(td_file, id_varid, td_att)
1973      IMPLICIT NONE
1974      ! Argument     
1975      TYPE(TFILE), INTENT(INOUT) :: td_file
1976      INTEGER(i4), INTENT(IN)    :: id_varid
1977      TYPE(TATT),  INTENT(IN)    :: td_att
1978
1979      ! local variable
1980      INTEGER(i4) :: il_status
1981      !----------------------------------------------------------------
1982
1983      IF( .NOT. td_file%l_def )THEN
1984
1985         CALL logger_trace( &
1986         &  "IOM CDF WRITE FILE ATT: Enter define mode, file "//TRIM(td_file%c_name))
1987
1988         ! Enter define mode
1989         il_status=NF90_REDEF(td_file%i_id)
1990         CALL iom_cdf__check(il_status,"IOM CDF WRITE FILE ATT: ")
1991
1992         td_file%l_def=.TRUE.
1993
1994      ENDIF
1995
1996      !! put attribute value
1997      CALL logger_trace( &
1998      &  "IOM CDF WRITE FILE ATT: write attribute "//TRIM(td_att%c_name)//&
1999      &  " of variable "//TRIM(fct_str(id_varid))//&
2000      &  " in file "//TRIM(td_file%c_name))
2001      SELECT CASE( td_att%i_type )
2002
2003         CASE(NF90_CHAR)
2004            ! put the attribute
2005            il_status = NF90_PUT_ATT(td_file%i_id, id_varid, &
2006            &  td_att%c_name, td_att%c_value )
2007            CALL iom_cdf__check(il_status,"IOM CDF WRITE FILE ATT: ")
2008
2009         CASE(NF90_BYTE, NF90_SHORT, NF90_INT, NF90_FLOAT, NF90_DOUBLE)
2010            ! put the attribute
2011            il_status = NF90_PUT_ATT(td_file%i_id, id_varid, &
2012            &  td_att%c_name, td_att%d_value )
2013            CALL iom_cdf__check(il_status,"IOM CDF WRITE FILE ATT: ")
2014
2015      END SELECT
2016
2017   END SUBROUTINE iom_cdf__write_att
2018   !-------------------------------------------------------------------
2019   !> @brief This subroutine write a variable in an opened netcdf file.
2020   !
2021   !> @author J.Paul
2022   !> @date November, 2013 - Initial Version
2023   !> @date September, 2015
2024   !> - do not force to use zero as FillValue for any meshmask variable
2025   !
2026   !> @param[inout] td_file   file structure
2027   !> @param[inout] td_var    variable structure
2028   !-------------------------------------------------------------------
2029   SUBROUTINE iom_cdf__write_var(td_file, td_var)
2030      IMPLICIT NONE
2031      ! Argument     
2032      TYPE(TFILE), INTENT(INOUT) :: td_file
2033      TYPE(TVAR),  INTENT(INOUT) :: td_var
2034
2035      ! local variable
2036      INTEGER(i4) :: il_status
2037      LOGICAL     :: ll_chg
2038      ! loop indices
2039      INTEGER(i4) :: ji
2040      !----------------------------------------------------------------
2041
2042      IF( .NOT. td_file%l_def )THEN
2043
2044         CALL logger_trace( &
2045         &  " IOM CDF WRITE VAR: Enter define mode, file "//&
2046         &  TRIM(td_file%c_name))
2047
2048         ! Enter define mode
2049         il_status=NF90_REDEF(td_file%i_id)
2050         CALL iom_cdf__check(il_status,"IOM CDF WRITE VAR: ")
2051
2052         td_file%l_def=.TRUE.
2053
2054      ENDIF
2055 
2056      ! check if file and variable dimension conform
2057      IF( file_check_var_dim(td_file, td_var) )THEN
2058
2059         ll_chg=.TRUE.
2060         DO ji=1,ip_maxdim
2061            IF( TRIM(fct_lower(cp_dimorder(ji:ji))) == &
2062            &   TRIM(fct_lower(td_var%c_name)) )THEN
2063               ll_chg=.FALSE.
2064               CALL logger_trace(TRIM(fct_lower(td_var%c_name))//' is var dimension')
2065               EXIT
2066            ENDIF
2067         ENDDO
2068         ! ugly patch until NEMO do not force to use 0. as FillValue
2069         IF( ll_chg )THEN
2070            ! not a dimension variable
2071            ! change FillValue
2072            SELECT CASE( TRIM(fct_lower(td_var%c_name)) )
2073               CASE DEFAULT
2074                  CALL var_chg_FillValue(td_var,0._dp)
2075               CASE('nav_lon','nav_lat', &
2076                  & 'glamt','glamu','glamv','glamf', &
2077                  & 'gphit','gphiu','gphiv','gphif', &
2078                  & 'e1t','e1u','e1v','e1f',         &
2079                  & 'e2t','e2u','e2v','e2f','ff',    &
2080                  & 'gcost','gcosu','gcosv','gcosf', &
2081                  & 'gsint','gsinu','gsinv','gsinf', &
2082                  & 'mbathy','misf','isf_draft',     &
2083                  & 'hbatt','hbatu','hbatv','hbatf', &
2084                  & 'gsigt','gsigu','gsigv','gsigf', &
2085                  & 'e3t_0','e3u_0','e3v_0','e3w_0', &
2086                  & 'e3f_0','gdepw_1d','gdept_1d',   &
2087                  & 'e3tp','e3wp','gdepw_0','rx1',   &
2088                  & 'gdept_0','gdepu','gdepv',       &
2089                  & 'hdept','hdepw','e3w_1d','e3t_1d',&
2090                  & 'tmask','umask','vmask','fmask'  )
2091                  ! do not change for coordinates and meshmask variables
2092            END SELECT
2093         ENDIF
2094
2095         ! define variable in file
2096         td_var%i_id=iom_cdf__write_var_def(td_file, td_var) 
2097
2098         IF( td_file%l_def )THEN
2099
2100            CALL logger_trace( &
2101            &  " IOM CDF WRITE VAR: Leave define mode, file "//&
2102            &  TRIM(td_file%c_name))
2103
2104            ! Leave define mode
2105            il_status=NF90_ENDDEF(td_file%i_id)
2106            CALL iom_cdf__check(il_status,"IOM CDF WRITE VAR: ")
2107
2108            td_file%l_def=.FALSE.
2109
2110         ENDIF
2111
2112         IF( ASSOCIATED(td_var%d_value) )THEN
2113            ! write variable value in file
2114            CALL iom_cdf__write_var_value(td_file, td_var)
2115         ENDIF
2116
2117      ENDIF
2118
2119   END SUBROUTINE iom_cdf__write_var
2120   !-------------------------------------------------------------------
2121   !> @brief This function define variable in an opened netcdf file.
2122   !
2123   !> @author J.Paul
2124   !> @date November, 2013 - Initial Version
2125   !
2126   !> @param[in] td_file   file structure
2127   !> @param[in] td_var    variable structure
2128   !> @return  variable id
2129   !-------------------------------------------------------------------
2130   INTEGER(i4) FUNCTION iom_cdf__write_var_def(td_file, td_var)
2131      IMPLICIT NONE
2132      ! Argument     
2133      TYPE(TFILE), INTENT(IN) :: td_file
2134      TYPE(TVAR),  INTENT(IN) :: td_var
2135
2136      ! local variable
2137      INTEGER(i4)                       :: il_status
2138      INTEGER(i4)                       :: il_ind
2139      INTEGER(i4), DIMENSION(ip_maxdim) :: il_dimid
2140
2141      TYPE(TVAR)                        :: tl_var
2142
2143      ! loop indices
2144      INTEGER(i4) :: ji
2145      INTEGER(i4) :: jj
2146      !----------------------------------------------------------------
2147
2148      ! copy structure
2149      tl_var=var_copy(td_var)
2150
2151      ! forced to use float type
2152      IF( tl_var%d_unf /= 1. .AND. tl_var%i_type==NF90_SHORT )THEN
2153         tl_var%i_type=NF90_FLOAT
2154      ENDIF
2155
2156      IF( ALL( .NOT. tl_var%t_dim(:)%l_use ) )THEN
2157         CALL logger_debug( &
2158         &  "IOM CDF WRITE VAR DEF scalar: define variable "//&
2159         &  TRIM(tl_var%c_name)//" in file "//TRIM(td_file%c_name))
2160         ! scalar value
2161         il_status = NF90_DEF_VAR(td_file%i_id, TRIM(tl_var%c_name), &
2162         &                        tl_var%i_type, varid=iom_cdf__write_var_def) 
2163         CALL iom_cdf__check(il_status,"IOM CDF WRITE VAR DEF: ")
2164      ELSE
2165
2166         ! check which dimension use
2167         jj=0
2168         il_dimid(:)=0
2169         ! reorder dimension, so unused dimension won't be written
2170         DO ji = 1,  ip_maxdim
2171            IF( tl_var%t_dim(ji)%l_use )THEN
2172               jj=jj+1
2173               il_dimid(jj)=dim_get_id(td_file%t_dim(:),tl_var%t_dim(ji)%c_name)
2174            ENDIF
2175         ENDDO
2176
2177         CALL logger_debug( &
2178         &  "IOM CDF WRITE VAR DEF: define dimension to be used for variable "//&
2179         &  TRIM(tl_var%c_name)//" in file "//TRIM(td_file%c_name))
2180
2181         DO ji=1,jj
2182            CALL logger_debug("IOM CDF WRITE VAR DEF: dimid "//TRIM(fct_str(il_dimid(ji))) )
2183         ENDDO
2184
2185         il_status = NF90_DEF_VAR(td_file%i_id, TRIM(tl_var%c_name),     &
2186         &                        tl_var%i_type,                         &
2187         &                        il_dimid(1:jj),                        &
2188         &                        varid=iom_cdf__write_var_def           )
2189         CALL iom_cdf__check(il_status,"IOM CDF WRITE VAR DEF: ")
2190      ENDIF
2191
2192      ! remove unuseful attribute
2193      il_ind=att_get_index( tl_var%t_att(:), "ew_overlap" )
2194      IF( il_ind /= 0 )THEN
2195         IF( tl_var%t_att(il_ind)%d_value(1) == -1 )THEN
2196            CALL var_del_att(tl_var, tl_var%t_att(il_ind))
2197         ENDIF
2198      ENDIF
2199
2200      DO ji = 1, tl_var%i_natt
2201         CALL logger_debug( &
2202         &  " IOM CDF WRITE VAR DEF: put attribute "//TRIM(tl_var%t_att(ji)%c_name)//&
2203         &  " for variable "//TRIM(tl_var%c_name)//&
2204         &  " in file "//TRIM(td_file%c_name) )
2205
2206         ! forced FillValue to have same type than variable
2207         IF( TRIM(tl_var%t_att(ji)%c_name) == '_FillValue' )THEN
2208            tl_var%t_att(ji)%i_type=tl_var%i_type
2209         ENDIF
2210
2211         SELECT CASE(tl_var%t_att(ji)%i_type)
2212            CASE(NF90_CHAR)
2213               IF( TRIM(tl_var%t_att(ji)%c_value) /= '' )THEN
2214                  il_status = NF90_PUT_ATT(td_file%i_id, iom_cdf__write_var_def, &
2215                  &                        TRIM(tl_var%t_att(ji)%c_name),        &
2216                  &                        TRIM(tl_var%t_att(ji)%c_value)        )
2217               ENDIF
2218            CASE(NF90_BYTE)
2219               il_status = NF90_PUT_ATT(td_file%i_id,                   &
2220               &                        iom_cdf__write_var_def,         &
2221               &                        TRIM(tl_var%t_att(ji)%c_name),  &
2222               &                        INT(tl_var%t_att(ji)%d_value(:),i1))
2223            CASE(NF90_SHORT)
2224               il_status = NF90_PUT_ATT(td_file%i_id,                   &
2225               &                        iom_cdf__write_var_def,         &
2226               &                        TRIM(tl_var%t_att(ji)%c_name),  &
2227               &                        INT(tl_var%t_att(ji)%d_value(:),i2))
2228            CASE(NF90_INT)
2229               il_status = NF90_PUT_ATT(td_file%i_id,                   &
2230               &                        iom_cdf__write_var_def,         &
2231               &                        TRIM(tl_var%t_att(ji)%c_name),  &
2232               &                        INT(tl_var%t_att(ji)%d_value(:),i4))
2233            CASE(NF90_FLOAT)
2234               il_status = NF90_PUT_ATT(td_file%i_id,                   &
2235               &                        iom_cdf__write_var_def,         &
2236               &                        TRIM(tl_var%t_att(ji)%c_name),  &
2237               &                        REAL(tl_var%t_att(ji)%d_value(:),sp))
2238            CASE(NF90_DOUBLE)
2239               il_status = NF90_PUT_ATT(td_file%i_id,                   &
2240               &                        iom_cdf__write_var_def,         &
2241               &                        TRIM(tl_var%t_att(ji)%c_name),  &
2242               &                        REAL(tl_var%t_att(ji)%d_value(:),dp))
2243         END SELECT
2244         CALL iom_cdf__check(il_status,"IOM CDF WRITE VAR DEF: ")
2245
2246      ENDDO
2247
2248   END FUNCTION iom_cdf__write_var_def
2249   !-------------------------------------------------------------------
2250   !> @brief This subroutine put variable value in an opened netcdf file.
2251   !
2252   !> @details
2253   !> The variable is written in the type define in variable structure.
2254   !> Only dimension used are printed, and fillValue in array are
2255   !> replaced by default fill values defined in module netcdf for each type.
2256   !
2257   !> @author J.Paul
2258   !> @date November, 2013 - Initial Version
2259   !> @date June, 2015
2260   !> - reuse scale factor and offset, before writing variable
2261   !
2262   !> @param[in] td_file   file structure
2263   !> @param[in] td_var    variable structure
2264   !-------------------------------------------------------------------
2265   SUBROUTINE iom_cdf__write_var_value(td_file, td_var)
2266      IMPLICIT NONE
2267      ! Argument     
2268      TYPE(TFILE), INTENT(IN) :: td_file
2269      TYPE(TVAR),  INTENT(IN) :: td_var
2270
2271      ! local variable
2272      INTEGER(i4)                       :: il_status
2273      INTEGER(i4), DIMENSION(ip_maxdim) :: il_order
2274      INTEGER(i4), DIMENSION(ip_maxdim) :: il_shape
2275      REAL(dp),    DIMENSION(:,:,:,:), ALLOCATABLE :: dl_value
2276
2277      ! loop indices
2278      INTEGER(i4) :: ji, jj
2279      !----------------------------------------------------------------
2280
2281      ! check which dimension use
2282      CALL logger_trace( &
2283      &  "IOM CDF WRITE VAR VALUE: get dimension to be used for variable "//&
2284      &  TRIM(td_var%c_name)//" in file "//TRIM(td_file%c_name))
2285   
2286      ! use scale factor and offset
2287      WHERE( td_var%d_value(:,:,:,:) /= td_var%d_fill )
2288         td_var%d_value(:,:,:,:) = &
2289         &  (td_var%d_value(:,:,:,:)-td_var%d_ofs)/td_var%d_scf
2290      END WHERE
2291
2292      jj=0
2293      DO ji = 1, ip_maxdim
2294         IF( td_var%t_dim(ji)%l_use )THEN
2295            jj=jj+1
2296            il_order(jj)=ji
2297            il_shape(jj)=td_var%t_dim(ji)%i_len
2298         ENDIF
2299      ENDDO
2300      ! dimension not use
2301      DO ji = 1, ip_maxdim
2302         IF( .NOT. td_var%t_dim(ji)%l_use )THEN
2303            jj=jj+1
2304            il_order(jj)=ji
2305            il_shape(jj)=td_var%t_dim(ji)%i_len
2306         ENDIF
2307      ENDDO
2308
2309      ALLOCATE( dl_value( il_shape(1),il_shape(2),il_shape(3),il_shape(4) ) )
2310
2311      ! reshape array, so unused dimension won't be written
2312      dl_value(:,:,:,:)=RESHAPE(source=td_var%d_value(:,:,:,:),&
2313      &                         SHAPE = il_shape(:), &
2314      &                         ORDER = il_order(:))
2315
2316      ! put value
2317      CALL logger_debug( &
2318      &  "IOM CDF WRITE VAR VALUE: put "//TRIM(td_var%c_name)//" value "//&
2319      &  "in file "//TRIM(td_file%c_name))
2320
2321      il_status = NF90_PUT_VAR( td_file%i_id, td_var%i_id, dl_value(:,:,:,:))
2322      CALL iom_cdf__check(il_status,"IOM CDF WRITE VAR VALUE ("//&
2323         &  TRIM(td_var%c_name)//") :" )
2324
2325      DEALLOCATE( dl_value )
2326
2327   END SUBROUTINE iom_cdf__write_var_value
2328END MODULE iom_cdf
Note: See TracBrowser for help on using the repository browser.