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/2014/dev_r4765_CNRS_agrif/NEMOGCM/TOOLS/SIREN/src – NEMO

source: branches/2014/dev_r4765_CNRS_agrif/NEMOGCM/TOOLS/SIREN/src/iom_cdf.f90 @ 5653

Last change on this file since 5653 was 5653, checked in by timgraham, 9 years ago

Merge head of trunk (r5643) into branch

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