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.
attribute.f90 in branches/UKMO/dev_r5518_nemo2cice_prints/NEMOGCM/TOOLS/SIREN/src – NEMO

source: branches/UKMO/dev_r5518_nemo2cice_prints/NEMOGCM/TOOLS/SIREN/src/attribute.f90 @ 9817

Last change on this file since 9817 was 9817, checked in by dancopsey, 6 years ago

Merged in GO6 package branch up to revision 8356.

File size: 41.7 KB
RevLine 
[4213]1!----------------------------------------------------------------------
2! NEMO system team, System and Interface for oceanic RElocable Nesting
3!----------------------------------------------------------------------
4!
5! MODULE: att
6!
7! DESCRIPTION:
8!> @brief
9!> This module manage attribute of variable or file.
[5037]10!>
[4213]11!> @details
12!>    define type TATT:<br/>
[5037]13!> @code
14!>    TYPE(TATT) :: tl_att
15!> @endcode
[4213]16!>
17!>    the attribute value inside attribute structure will be
[5037]18!>    character or real(8) 1D array.<br/>
19!>    However the attribute value could be initialized with:<br/>
[4213]20!>    - character
21!>    - scalar (real(4), real(8), integer(4) or integer(8))
[5037]22!>    - array 1D (real(4), real(8), integer(4) or integer(8))
[4213]23!>
[5037]24!>    to initialize an attribute structure :<br/>
25!> @code
26!>    tl_att=att_init('attname',value)
27!> @endcode
28!>    - value is a character, scalar value or table of value
[4213]29!>
[5037]30!>    to print attribute information of one or array of attribute structure:<br/>
31!> @code
[4213]32!>    CALL att_print(td_att)
[5037]33!> @endcode
[4213]34!>
[5037]35!>    to clean attribute structure:<br/>
36!> @code
37!>    CALL att_clean(td_att)
38!> @endcode
39!>
40!>    to copy attribute structure in another one (using different memory cell):<br/>
41!> @code
42!>    tl_att2=att_copy(tl_att1)
43!> @endcode
44!>    @note as we use pointer for the value array of the attribute structure,
45!>    the use of the assignment operator (=) to copy attribute structure
46!>    create a pointer on the same array.
47!>    This is not the case with this copy function.
48!>
49!>    to get attribute index, in an array of attribute structure:<br/>
50!> @code
51!>   il_index=att_get_index( td_att, cd_name )
52!> @endcode
53!>    - td_att array of attribute structure
54!>    - cd_name attribute name
55!>
56!>    to get attribute id, read from a file:<br/>
57!>@code
58!>  il_id=att_get_id( td_att, cd_name )
59!>@endcode
60!>    - td_att array of attribute structure
61!>    - cd_name attribute name
62!>
63!>    to get attribute name
64!>    - tl_att\%c_name
65!>
[4213]66!>    to get character length or the number of value store in attribute
67!>    - tl_att\%i_len
68!>
69!>    to get attribute value:<br/>
70!>    - tl_att\%c_value    (for character attribute)
71!>    - tl_att\%d_value(i) (otherwise)
72!>   
73!>    to get the type number (based on NETCDF type constants) of the
74!>    attribute:<br/>
75!>    - tl_att\%i_type
76!>
[5037]77!>    to get attribute id (read from file):<br/>
[4213]78!>    - tl_att\%i_id
79!>
[5037]80!> @author J.Paul
[4213]81! REVISION HISTORY:
[5037]82!> @date November, 2013 - Initial Version
[9817]83!> @date November, 2014
84!> - Fix memory leaks bug
[4213]85!
86!> @note Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
87!----------------------------------------------------------------------
88MODULE att
89   USE netcdf                          ! nf90 library
90   USE global                          ! global variable
91   USE kind                            ! F90 kind parameter
[5037]92   USE logger                          ! log file manager
[4213]93   USE fct                             ! basic useful function
94   IMPLICIT NONE
95   ! NOTE_avoid_public_variables_if_possible
96
97   ! type and variable
[5037]98   PUBLIC :: TATT       !< attribute structure
[4213]99
100   ! function and subroutine
[5037]101   PUBLIC :: att_init       !< initialize attribute structure
102   PUBLIC :: att_print      !< print attribute structure
103   PUBLIC :: att_clean      !< clean attribute strcuture
104   PUBLIC :: att_copy       !< copy attribute structure
105   PUBLIC :: att_get_index  !< get attribute index, in an array of attribute structure
106   PUBLIC :: att_get_id     !< get attribute id, read from file
[4213]107
[5037]108   PRIVATE :: att__clean_unit ! clean attribute strcuture
109   PRIVATE :: att__clean_arr  ! clean array of attribute strcuture
110   PRIVATE :: att__print_unit ! print information on one attribute
111   PRIVATE :: att__print_arr  ! print information on a array of attribute
112   PRIVATE :: att__init_c     ! initialize an attribute structure with character value
113   PRIVATE :: att__init_dp    ! initialize an attribute structure with array of real(8) value
114   PRIVATE :: att__init_dp_0d ! initialize an attribute structure with real(8) value
115   PRIVATE :: att__init_sp    ! initialize an attribute structure with array of real(4) value
116   PRIVATE :: att__init_sp_0d ! initialize an attribute structure with real(4) value
117   PRIVATE :: att__init_i1    ! initialize an attribute structure with array of integer(1) value
118   PRIVATE :: att__init_i1_0d ! initialize an attribute structure with integer(1) value
119   PRIVATE :: att__init_i2    ! initialize an attribute structure with array of integer(2) value
120   PRIVATE :: att__init_i2_0d ! initialize an attribute structure with integer(2) value
121   PRIVATE :: att__init_i4    ! initialize an attribute structure with array of integer(4) value
122   PRIVATE :: att__init_i4_0d ! initialize an attribute structure with integer(4) value
123   PRIVATE :: att__init_i8    ! initialize an attribute structure with array of integer(8) value
124   PRIVATE :: att__init_i8_0d ! initialize an attribute structure with integer(8) value
125   PRIVATE :: att__copy_unit  ! copy attribute structure
126   PRIVATE :: att__copy_arr   ! copy array of attribute structure
[4213]127
[5037]128   TYPE TATT !< attribute structure
129      CHARACTER(LEN=lc) :: c_name = ''       !< attribute name
130      INTEGER(i4)       :: i_id   = 0        !< attribute id
131      INTEGER(i4)       :: i_type = 0        !< attribute type
[4213]132      INTEGER(i4)       :: i_len  = 0        !< number of value store in attribute
[9817]133      CHARACTER(LEN=lc) :: c_value = 'none'  !< attribute value if type CHAR
[4213]134      REAL(dp), DIMENSION(:), POINTER :: d_value => NULL() !< attribute value if type SHORT,INT,FLOAT or DOUBLE
135   END TYPE TATT
136
137   INTERFACE att_init
[9817]138      MODULE PROCEDURE att__init_c   
[4213]139      MODULE PROCEDURE att__init_dp
140      MODULE PROCEDURE att__init_dp_0d
141      MODULE PROCEDURE att__init_sp
142      MODULE PROCEDURE att__init_sp_0d
143      MODULE PROCEDURE att__init_i1
144      MODULE PROCEDURE att__init_i1_0d
145      MODULE PROCEDURE att__init_i2
146      MODULE PROCEDURE att__init_i2_0d
147      MODULE PROCEDURE att__init_i4
148      MODULE PROCEDURE att__init_i4_0d
149      MODULE PROCEDURE att__init_i8
150      MODULE PROCEDURE att__init_i8_0d
151   END INTERFACE att_init
152
[5037]153   INTERFACE att_print
154      MODULE PROCEDURE att__print_unit ! print information on one attribute
155      MODULE PROCEDURE att__print_arr  ! print information on a array of attribute
156   END INTERFACE att_print
157
158   INTERFACE att_clean
159      MODULE PROCEDURE att__clean_unit 
160      MODULE PROCEDURE att__clean_arr   
[4213]161   END INTERFACE
162
[5037]163   INTERFACE att_copy
164      MODULE PROCEDURE att__copy_unit  ! copy attribute structure
165      MODULE PROCEDURE att__copy_arr   ! copy array of attribute structure
166   END INTERFACE
167
[4213]168CONTAINS
169   !-------------------------------------------------------------------
170   !> @brief
[5037]171   !> This subroutine copy a array of attribute structure in another one
[4213]172   !> @details
[5037]173   !> see att__copy_unit
[4213]174   !>
[5037]175   !> @warning do not use on the output of a function who create or read an
176   !> attribute (ex: tl_att=att_copy(att_init()) is forbidden).
177   !> This will create memory leaks.
[4213]178   !> @warning to avoid infinite loop, do not use any function inside
179   !> this subroutine
180   !>
181   !> @author J.Paul
[5037]182   !> @date November, 2013 - Initial Version
183   !> @date November, 2014
[9817]184   !> - use function instead of overload assignment operator
[5037]185   !> (to avoid memory leak)
[4213]186   !
[5037]187   !> @param[in] td_att   array of attribute structure
188   !> @return copy of input array of attribute structure
[4213]189   !-------------------------------------------------------------------
[5037]190   FUNCTION att__copy_arr( td_att )
[4213]191      IMPLICIT NONE
192      ! Argument
[5037]193      TYPE(TATT), DIMENSION(:), INTENT(IN) :: td_att
194      ! function
195      TYPE(TATT), DIMENSION(SIZE(td_att(:))) :: att__copy_arr
[4213]196
197      ! local variable
198      ! loop indices
199      INTEGER(i4) :: ji
200      !----------------------------------------------------------------
201
[5037]202      DO ji=1,SIZE(td_att(:))
203         att__copy_arr(ji)=att_copy(td_att(ji))
[4213]204      ENDDO
205
[5037]206   END FUNCTION att__copy_arr
[4213]207   !-------------------------------------------------------------------
208   !> @brief
[5037]209   !> This subroutine copy an attribute structure in another one.
[4213]210   !> @details
[5037]211   !> attribute value are copied in a temporary array, so input and output
[4213]212   !> attribute structure value do not point on the same "memory cell", and so
213   !> on are independant.
214   !>
[5037]215   !> @warning do not use on the output of a function who create or read an
216   !> attribute (ex: tl_att=att_copy(att_init()) is forbidden).
217   !> This will create memory leaks.
[4213]218   !> @warning to avoid infinite loop, do not use any function inside
219   !> this subroutine
220   !>
221   !> @author J.Paul
[5037]222   !> @date November, 2013 - Initial Version
223   !> @date November, 2014
224   !> - use function instead of overload assignment operator (to avoid memory leak)
225   !>
226   !> @param[in] td_att   attribute structure
227   !> @return copy of input attribute structure
[4213]228   !-------------------------------------------------------------------
[5037]229   FUNCTION att__copy_unit( td_att )
[4213]230      IMPLICIT NONE
231      ! Argument
[5037]232      TYPE(TATT), INTENT(IN)  :: td_att
233      ! function
234      TYPE(TATT) :: att__copy_unit
[4213]235
236      ! local variable
[9817]237      REAL(dp)         , DIMENSION(:), ALLOCATABLE :: dl_value
[4213]238      !----------------------------------------------------------------
239
240      ! copy attribute variable
[5037]241      att__copy_unit%c_name  = TRIM(td_att%c_name)
242      att__copy_unit%i_id    = td_att%i_id
243      att__copy_unit%i_type  = td_att%i_type
244      att__copy_unit%i_len   = td_att%i_len
245      att__copy_unit%c_value = TRIM(td_att%c_value)
[4213]246
247      ! copy attribute pointer in an independant variable
[5037]248      IF( ASSOCIATED(att__copy_unit%d_value) ) DEALLOCATE(att__copy_unit%d_value)
249      IF( ASSOCIATED(td_att%d_value) )THEN
250         ALLOCATE( dl_value(td_att%i_len) )
251         dl_value(:) = td_att%d_value(:)
[4213]252
[5037]253         ALLOCATE( att__copy_unit%d_value(att__copy_unit%i_len) )
254         att__copy_unit%d_value(:) = dl_value(:)
[4213]255
256         DEALLOCATE( dl_value )
257      ENDIF
258
[5037]259   END FUNCTION att__copy_unit
[4213]260   !-------------------------------------------------------------------
[5037]261   !> @brief This function return attribute index, in a array of attribute structure,
262   !> given attribute name.<br/>
263   !> @details
264   !> if attribute name do not exist, return 0.
[4213]265   !>
266   !> @author J.Paul
[5037]267   !> @date Septempber, 2014 - Initial Version
[4213]268   !
[5037]269   !> @param[in] td_att    array of attribute structure
270   !> @param[in] cd_name   attribute name
271   !> @return attribute index
272   !-------------------------------------------------------------------
273   INTEGER(i4) FUNCTION att_get_index( td_att, cd_name )
274      IMPLICIT NONE
275      ! Argument
276      TYPE(TATT),       DIMENSION(:), INTENT(IN) :: td_att
277      CHARACTER(LEN=*),               INTENT(IN) :: cd_name
278
279      ! local variable
280      INTEGER(i4) :: il_size
281
282      ! loop indices
283      INTEGER(i4) :: ji
284      !----------------------------------------------------------------
285      att_get_index=0
286
287      il_size=SIZE(td_att(:))
288      DO ji=1,il_size
289         IF( TRIM(td_att(ji)%c_name) == TRIM(cd_name) )THEN
290            att_get_index=ji
291            EXIT
292         ENDIF
293      ENDDO
294
295   END FUNCTION att_get_index
296   !-------------------------------------------------------------------
297   !> @brief This function return attribute id, read from a file.<br/>
298   !> @details
299   !> if attribute name do not exist, return 0.
300   !>
301   !> @author J.Paul
302   !> @date November, 2013 - Initial Version
[9817]303   !> @date September, 2014
304   !> - bug fix with use of id read from attribute structure
305   !>
[5037]306   !> @param[in] td_att    array of attribute structure
307   !> @param[in] cd_name   attribute name
[4213]308   !> @return attribute id
309   !-------------------------------------------------------------------
310   INTEGER(i4) FUNCTION att_get_id( td_att, cd_name )
311      IMPLICIT NONE
312      ! Argument
313      TYPE(TATT),       DIMENSION(:), INTENT(IN) :: td_att
314      CHARACTER(LEN=*),               INTENT(IN) :: cd_name
315
316      ! local variable
317      INTEGER(i4) :: il_size
318
319      ! loop indices
320      INTEGER(i4) :: ji
321      !----------------------------------------------------------------
322      att_get_id=0
323
324      il_size=SIZE(td_att(:))
325      DO ji=1,il_size
326         IF( TRIM(td_att(ji)%c_name) == TRIM(cd_name) )THEN
[5037]327            att_get_id=td_att(ji)%i_id
[4213]328            EXIT
329         ENDIF
330      ENDDO
331
332   END FUNCTION att_get_id
333   !-------------------------------------------------------------------
[5037]334   !> @brief This function initialize an attribute structure with character
335   !> value.
[4213]336   !>
337   !> @author J.Paul
[5037]338   !> @date November, 2013 - Initial Version
[4213]339   !
[5037]340   !> @param[in] cd_name   attribute name
341   !> @param[in] cd_value  attribute value
[4213]342   !> @return attribute structure
343   !-------------------------------------------------------------------
344   TYPE(TATT) FUNCTION att__init_c( cd_name, cd_value )
345      IMPLICIT NONE
346      ! Argument
347      CHARACTER(LEN=*), INTENT(IN) :: cd_name
348      CHARACTER(LEN=*), INTENT(IN) :: cd_value
349      !----------------------------------------------------------------
350 
351      ! clean attribute
352      CALL att_clean(att__init_c)
353
[5037]354      CALL logger_trace( &
[4213]355      &  " ATT INIT: attribute name: "//TRIM(ADJUSTL(cd_name))//&
356      &  " attribute value "//TRIM(ADJUSTL(cd_value)) )
357
358      att__init_c%c_name=TRIM(ADJUSTL(cd_name))
[9817]359      att__init_c%i_type=NF90_CHAR
[4213]360
361      att__init_c%c_value=TRIM(ADJUSTL(cd_value))
362      att__init_c%i_len=LEN( TRIM(ADJUSTL(cd_value)) )
363
364   END FUNCTION att__init_c
365   !-------------------------------------------------------------------
[5037]366   !> @brief This function initialize an attribute structure with array
367   !> of real(8) value.
368   !> @details
369   !> Optionaly you could specify the type of the variable to be saved.
[4213]370   !>
371   !> @author J.Paul
[9817]372   !> @date November, 2013 - Initial Version
[4213]373   !
[5037]374   !> @param[in] cd_name   attribute name
375   !> @param[in] dd_value  attribute value
376   !> @param[in] id_type   type of the variable to be saved
[4213]377   !> @return attribute structure
378   !-------------------------------------------------------------------
[5037]379   TYPE(TATT) FUNCTION att__init_dp( cd_name, dd_value, id_type )
[4213]380      IMPLICIT NONE
381
382      ! Argument
383      CHARACTER(LEN=*),               INTENT(IN) :: cd_name
384      REAL(dp),         DIMENSION(:), INTENT(IN) :: dd_value
[5037]385      INTEGER(i4)                   , INTENT(IN), OPTIONAL :: id_type
[4213]386
387      ! local value
388      INTEGER(i4)       :: il_len
389      CHARACTER(LEN=lc) :: cl_value
390
391      ! loop indices
392      INTEGER(i4) :: ji
393      !----------------------------------------------------------------
394
395      ! clean attribute
396      CALL att_clean(att__init_dp)
397
[5037]398      ! array size
[4213]399      il_len=size(dd_value(:))
400
401      cl_value="(/"
402      DO ji=1,il_len-1
403         cl_value=TRIM(cl_value)//TRIM(fct_str(dd_value(ji)))//","
404      ENDDO
405      cl_value=TRIM(cl_value)//TRIM(fct_str(dd_value(il_len)))//"/)"
406
[5037]407      CALL logger_trace( &
[4213]408      &  " ATT INIT: attribute name: "//TRIM(ADJUSTL(cd_name))//&
409      &  " attribute value "//TRIM(ADJUSTL(cl_value)) )
410
411      att__init_dp%c_name=TRIM(ADJUSTL(cd_name))
412
[5037]413      IF( PRESENT(id_type) )THEN
414         att__init_dp%i_type=id_type
415      ELSE
416         att__init_dp%i_type=NF90_DOUBLE
417      ENDIF
[4213]418
419      IF( ASSOCIATED(att__init_dp%d_value) )THEN
420         DEALLOCATE(att__init_dp%d_value)
421      ENDIF
422      ALLOCATE(att__init_dp%d_value(il_len))
423
424      att__init_dp%d_value(:)=dd_value(:)
425      att__init_dp%i_len=il_len
426
427   END FUNCTION att__init_dp
428   !-------------------------------------------------------------------
[5037]429   !> @brief This function initialize an attribute structure with
[4213]430   !> real(8) value
[5037]431   !> @details
432   !> Optionaly you could specify the type of the variable to be saved.
[4213]433   !>
434   !> @author J.Paul
[5037]435   !> @date November, 2013 - Initial Version
[4213]436   !
[5037]437   !> @param[in] cd_name   attribute name
438   !> @param[in] dd_value  attribute value
439   !> @param[in] id_type   type of the variable to be saved
[4213]440   !> @return attribute structure
441   !-------------------------------------------------------------------
[5037]442   TYPE(TATT) FUNCTION att__init_dp_0d( cd_name, dd_value, id_type )
[4213]443      IMPLICIT NONE
444      ! Argument
445      CHARACTER(LEN=*), INTENT(IN) :: cd_name
446      REAL(dp),         INTENT(IN) :: dd_value
[5037]447      INTEGER(i4)     , INTENT(IN), OPTIONAL :: id_type
[4213]448
449      ! local value
450      CHARACTER(LEN=lc) :: cl_value
451      !----------------------------------------------------------------
452
453      ! clean attribute
454      CALL att_clean(att__init_dp_0d)
455     
456      cl_value="(/"//TRIM(fct_str(dd_value))//"/)"
457
[5037]458      CALL logger_trace( &
[4213]459      &  " ATT INIT: attribute name: "//TRIM(ADJUSTL(cd_name))//&
460      &  " attribute value "//TRIM(ADJUSTL(cl_value)) )
461
462      att__init_dp_0d%c_name=TRIM(ADJUSTL(cd_name))
463
[5037]464      IF( PRESENT(id_type) )THEN
465         att__init_dp_0d%i_type=id_type
466      ELSE
467         att__init_dp_0d%i_type=NF90_DOUBLE
468      ENDIF
[4213]469
470      IF( ASSOCIATED(att__init_dp_0d%d_value) )THEN
471         DEALLOCATE(att__init_dp_0d%d_value)
472      ENDIF
473      ALLOCATE(att__init_dp_0d%d_value(1))
474
475      att__init_dp_0d%d_value(1)=dd_value
476      att__init_dp_0d%i_len=1
477
478   END FUNCTION att__init_dp_0d
479   !-------------------------------------------------------------------
[5037]480   !> @brief This function initialize an attribute structure with array
481   !> of real(4) value.
482   !> @details
483   !> Optionaly you could specify the type of the variable to be saved.
[4213]484   !>
485   !> @author J.Paul
[5037]486   !> @date November, 2013 - Initial Version
[4213]487   !
[5037]488   !> @param[in] cd_name   attribute name
489   !> @param[in] rd_value  attribute value
490   !> @param[in] id_type   type of the variable to be saved
[4213]491   !> @return attribute structure
492   !-------------------------------------------------------------------
[5037]493   TYPE(TATT) FUNCTION att__init_sp( cd_name, rd_value, id_type )
[4213]494      IMPLICIT NONE
495      ! Argument
496      CHARACTER(LEN=*),               INTENT(IN) :: cd_name
497      REAL(sp),         DIMENSION(:), INTENT(IN) :: rd_value
[5037]498      INTEGER(i4)                   , INTENT(IN), OPTIONAL :: id_type
[4213]499
500      ! local value
501      INTEGER(i4)       :: il_len
502      CHARACTER(LEN=lc) :: cl_value
503
504      ! loop indices
505      INTEGER(i4) :: ji
506      !----------------------------------------------------------------
507
508      ! clean attribute
509      CALL att_clean(att__init_sp)
510     
[5037]511      ! array size
[4213]512      il_len=size(rd_value(:))
513
514      cl_value="(/"
515      DO ji=1,il_len-1
516         cl_value=TRIM(cl_value)//TRIM(fct_str(rd_value(ji)))//","
517      ENDDO
518      cl_value=TRIM(cl_value)//TRIM(fct_str(rd_value(il_len)))//"/)"
519
[5037]520      CALL logger_trace( &
[4213]521      &  " ATT INIT: attribute name: "//TRIM(ADJUSTL(cd_name))//&
522      &  " attribute value "//TRIM(ADJUSTL(cl_value)) )     
523
524      att__init_sp%c_name=TRIM(ADJUSTL(cd_name))
525
[5037]526      IF( PRESENT(id_type) )THEN
527         att__init_sp%i_type=id_type
528      ELSE
529         att__init_sp%i_type=NF90_FLOAT
530      ENDIF
[4213]531
532      IF( ASSOCIATED(att__init_sp%d_value) )THEN
533         DEALLOCATE(att__init_sp%d_value)
534      ENDIF
535      ALLOCATE(att__init_sp%d_value(il_len))
536
537      att__init_sp%d_value(:)=REAL(rd_value(:),dp)
538      att__init_sp%i_len=il_len
539
540   END FUNCTION att__init_sp
541   !-------------------------------------------------------------------
[5037]542   !> @brief This function initialize an attribute structure with
543   !> real(4) value.
544   !> @details
545   !> Optionaly you could specify the type of the variable to be saved.
[4213]546   !>
547   !> @author J.Paul
[5037]548   !> @date November, 2013 - Initial Version
[4213]549   !
[5037]550   !> @param[in] cd_name   attribute name
551   !> @param[in] rd_value  attribute value
552   !> @param[in] id_type   type of the variable to be saved
[4213]553   !> @return attribute structure
554   !-------------------------------------------------------------------
[5037]555   TYPE(TATT) FUNCTION att__init_sp_0d( cd_name, rd_value, id_type )
[4213]556      IMPLICIT NONE
557      ! Argument
558      CHARACTER(LEN=*), INTENT(IN) :: cd_name
559      REAL(sp),         INTENT(IN) :: rd_value
[5037]560      INTEGER(i4)     , INTENT(IN), OPTIONAL :: id_type
[4213]561
562      ! local value
563      CHARACTER(LEN=lc) :: cl_value
564      !----------------------------------------------------------------
565
566      ! clean attribute
567      CALL att_clean(att__init_sp_0d)
568     
569      cl_value="(/"//TRIM(fct_str(rd_value))//"/)"
570
[5037]571      CALL logger_trace( &
[4213]572      &  " ATT INIT: attribute name: "//TRIM(ADJUSTL(cd_name))//&
573      &  " attribute value "//TRIM(ADJUSTL(cl_value)) )     
574
575      att__init_sp_0d%c_name=TRIM(ADJUSTL(cd_name))
576
[5037]577      IF( PRESENT(id_type) )THEN
578         att__init_sp_0d%i_type=id_type
579      ELSE
580         att__init_sp_0d%i_type=NF90_FLOAT
581      ENDIF
[4213]582
583      IF( ASSOCIATED(att__init_sp_0d%d_value) )THEN
584         DEALLOCATE(att__init_sp_0d%d_value)
585      ENDIF
586      ALLOCATE(att__init_sp_0d%d_value(1))
587
588      att__init_sp_0d%d_value(1)=REAL(rd_value,dp)
589      att__init_sp_0d%i_len=1
590
591   END FUNCTION att__init_sp_0d
592   !-------------------------------------------------------------------
[5037]593   !> @brief This function initialize an attribute structure with array
594   !> of integer(1) value.
595   !> @details
596   !> Optionaly you could specify the type of the variable to be saved.
[4213]597   !>
598   !> @author J.Paul
[5037]599   !> @date November, 2013 - Initial Version
[4213]600   !
[5037]601   !> @param[in] cd_name   attribute name
602   !> @param[in] bd_value  attribute value
603   !> @param[in] id_type   type of the variable to be saved
[4213]604   !> @return attribute structure
605   !-------------------------------------------------------------------
[5037]606   TYPE(TATT) FUNCTION att__init_i1( cd_name, bd_value, id_type )
[4213]607      IMPLICIT NONE
608      ! Argument
609      CHARACTER(LEN=*),               INTENT(IN) :: cd_name
610      INTEGER(i1),      DIMENSION(:), INTENT(IN) :: bd_value
[5037]611      INTEGER(i4)                   , INTENT(IN), OPTIONAL :: id_type
[4213]612
613      ! local value
614      INTEGER(i4)       :: il_len
615      CHARACTER(LEN=lc) :: cl_value
616
617      ! loop indices
618      INTEGER(i4) :: ji
619      !----------------------------------------------------------------
620
621      ! clean attribute
622      CALL att_clean(att__init_i1)
623     
[5037]624      ! array size
[4213]625      il_len=size(bd_value(:))
626
627      cl_value="(/"
628      DO ji=1,il_len-1
629         cl_value=TRIM(cl_value)//TRIM(fct_str(bd_value(ji)))//","
630      ENDDO
631      cl_value=TRIM(cl_value)//TRIM(fct_str(bd_value(il_len)))//"/)"
632
[5037]633      CALL logger_trace( &
[4213]634      &  " ATT INIT: attribute name: "//TRIM(ADJUSTL(cd_name))//&
635      &  " attribute value "//TRIM(ADJUSTL(cl_value)) )     
636
637      att__init_i1%c_name=TRIM(ADJUSTL(cd_name))
638
[5037]639      IF( PRESENT(id_type) )THEN
640         att__init_i1%i_type=id_type
641      ELSE
642         att__init_i1%i_type=NF90_BYTE
643      ENDIF
[4213]644
645      IF( ASSOCIATED(att__init_i1%d_value) )THEN
646         DEALLOCATE(att__init_i1%d_value)
647      ENDIF
648      ALLOCATE(att__init_i1%d_value(il_len))
649
650      att__init_i1%d_value(:)=REAL(bd_value(:),dp)
651      att__init_i1%i_len=il_len
652
653   END FUNCTION att__init_i1
654   !-------------------------------------------------------------------
[5037]655   !> @brief This function initialize an attribute structure with
656   !> integer(1) value.
657   !> @details
658   !> Optionaly you could specify the type of the variable to be saved.
[4213]659   !>
660   !> @author J.Paul
[5037]661   !> @date November, 2013 - Initial Version
[4213]662   !
[5037]663   !> @param[in] cd_name   attribute name
664   !> @param[in] bd_value  attribute value
665   !> @param[in] id_type   type of the variable to be saved
[4213]666   !> @return attribute structure
667   !-------------------------------------------------------------------
[5037]668   TYPE(TATT) FUNCTION att__init_i1_0d( cd_name, bd_value, id_type )
[4213]669      IMPLICIT NONE
670      ! Argument
671      CHARACTER(LEN=*), INTENT(IN) :: cd_name
672      INTEGER(i1),      INTENT(IN) :: bd_value
[5037]673      INTEGER(i4)     , INTENT(IN), OPTIONAL :: id_type
[4213]674
675      !local value
676      CHARACTER(LEN=lc) :: cl_value
677      !----------------------------------------------------------------
678
679      ! clean attribute
680      CALL att_clean(att__init_i1_0d)
681     
682      cl_value="(/"//TRIM(fct_str(bd_value))//"/)"
683
[5037]684      CALL logger_trace( &
[4213]685      &  " ATT INIT: attribute name: "//TRIM(ADJUSTL(cd_name))//&
686      &  " attibute value "//TRIM(ADJUSTL(cl_value)) )     
687
688      att__init_i1_0d%c_name=TRIM(ADJUSTL(cd_name))
689
[5037]690      IF( PRESENT(id_type) )THEN
691         att__init_i1_0d%i_type=id_type
692      ELSE
693         att__init_i1_0d%i_type=NF90_BYTE
694      ENDIF     
[4213]695
696      IF( ASSOCIATED(att__init_i1_0d%d_value) )THEN
697         DEALLOCATE(att__init_i1_0d%d_value)
698      ENDIF
699      ALLOCATE(att__init_i1_0d%d_value(1))
700
701      att__init_i1_0d%d_value(1)=REAL(bd_value,dp)
702      att__init_i1_0d%i_len=1
703
704   END FUNCTION att__init_i1_0d
705   !-------------------------------------------------------------------
[5037]706   !> @brief This function initialize an attribute structure with array
707   !> of integer(2) value.
708   !> @details
709   !> Optionaly you could specify the type of the variable to be saved.
[4213]710   !>
711   !> @author J.Paul
[5037]712   !> @date November, 2013 - Initial Version
[4213]713   !
[5037]714   !> @param[in] cd_name   attribute name
715   !> @param[in] sd_value  attribute value
716   !> @param[in] id_type   type of the variable to be saved
[4213]717   !> @return attribute structure
718   !-------------------------------------------------------------------
[5037]719   TYPE(TATT) FUNCTION att__init_i2( cd_name, sd_value, id_type )
[4213]720      IMPLICIT NONE
721      ! Argument
722      CHARACTER(LEN=*),               INTENT(IN) :: cd_name
723      INTEGER(i2),      DIMENSION(:), INTENT(IN) :: sd_value
[5037]724      INTEGER(i4)                   , INTENT(IN), OPTIONAL :: id_type
[4213]725
726      ! local value
727      INTEGER(i4)       :: il_len
728      CHARACTER(LEN=lc) :: cl_value
729
730      ! loop indices
731      INTEGER(i4) :: ji
732      !----------------------------------------------------------------
733
734      ! clean attribute
735      CALL att_clean(att__init_i2)
736     
[5037]737      ! array size
[4213]738      il_len=size(sd_value(:))
739
740      cl_value="(/"
741      DO ji=1,il_len-1
742         cl_value=TRIM(cl_value)//TRIM(fct_str(sd_value(ji)))//","
743      ENDDO
744      cl_value=TRIM(cl_value)//TRIM(fct_str(sd_value(il_len)))//"/)"
745
[5037]746      CALL logger_trace( &
[4213]747      &  " ATT INIT: attribute name: "//TRIM(ADJUSTL(cd_name))//&
748      &  " attribute value "//TRIM(ADJUSTL(cl_value)) )     
749
750      att__init_i2%c_name=TRIM(ADJUSTL(cd_name))
751
[5037]752      IF( PRESENT(id_type) )THEN
753         att__init_i2%i_type=id_type
754      ELSE
755         att__init_i2%i_type=NF90_SHORT
756      ENDIF
[4213]757
758      IF( ASSOCIATED(att__init_i2%d_value) )THEN
759         DEALLOCATE(att__init_i2%d_value)
760      ENDIF
761      ALLOCATE(att__init_i2%d_value(il_len))
762
763      att__init_i2%d_value(:)=REAL(sd_value(:),dp)
764      att__init_i2%i_len=il_len
765
766   END FUNCTION att__init_i2
767   !-------------------------------------------------------------------
[5037]768   !> @brief This function initialize an attribute structure with
769   !> integer(2) value.
770   !> @details
771   !> Optionaly you could specify the type of the variable to be saved.
[4213]772   !>
773   !> @author J.Paul
[5037]774   !> @date November, 2013 - Initial Version
[4213]775   !
[5037]776   !> @param[in] cd_name   attribute name
777   !> @param[in] sd_value  attribute value
778   !> @param[in] id_type   type of the variable to be saved
[4213]779   !> @return attribute structure
780   !-------------------------------------------------------------------
[5037]781   TYPE(TATT) FUNCTION att__init_i2_0d( cd_name, sd_value, id_type )
[4213]782      IMPLICIT NONE
783      ! Argument
784      CHARACTER(LEN=*), INTENT(IN) :: cd_name
785      INTEGER(i2),      INTENT(IN) :: sd_value
[5037]786      INTEGER(i4)     , INTENT(IN), OPTIONAL :: id_type
[4213]787
788      !local value
789      CHARACTER(LEN=lc) :: cl_value
790      !----------------------------------------------------------------
791
792      ! clean attribute
793      CALL att_clean(att__init_i2_0d)
794     
795      cl_value="(/"//TRIM(fct_str(sd_value))//"/)"
796
[5037]797      CALL logger_trace( &
[4213]798      &  " ATT INIT: attribute name: "//TRIM(ADJUSTL(cd_name))//&
799      &  " attibute value "//TRIM(ADJUSTL(cl_value)) )     
800
801      att__init_i2_0d%c_name=TRIM(ADJUSTL(cd_name))
802
[5037]803      IF( PRESENT(id_type) )THEN
804         att__init_i2_0d%i_type=id_type
805      ELSE
806         att__init_i2_0d%i_type=NF90_SHORT
807      ENDIF
[4213]808
809      IF( ASSOCIATED(att__init_i2_0d%d_value) )THEN
810         DEALLOCATE(att__init_i2_0d%d_value)
811      ENDIF
812      ALLOCATE(att__init_i2_0d%d_value(1))
813
814      att__init_i2_0d%d_value(1)=REAL(sd_value,dp)
815      att__init_i2_0d%i_len=1
816
817   END FUNCTION att__init_i2_0d
818   !-------------------------------------------------------------------
[5037]819   !> @brief This function initialize an attribute structure with array
820   !> of integer(4) value.
821   !> @details
822   !> Optionaly you could specify the type of the variable to be saved.
[4213]823   !>
824   !> @author J.Paul
[5037]825   !> @date November, 2013 - Initial Version
[4213]826   !
[5037]827   !> @param[in] cd_name   attribute name
828   !> @param[in] id_value  attribute value
829   !> @param[in] id_type   type of the variable to be saved
[4213]830   !> @return attribute structure
831   !-------------------------------------------------------------------
[5037]832   TYPE(TATT) FUNCTION att__init_i4( cd_name, id_value, id_type )
[4213]833      IMPLICIT NONE
834      ! Argument
835      CHARACTER(LEN=*),               INTENT(IN) :: cd_name
836      INTEGER(i4),      DIMENSION(:), INTENT(IN) :: id_value
[5037]837      INTEGER(i4)                   , INTENT(IN), OPTIONAL :: id_type
[4213]838
839      ! local value
840      INTEGER(i4)       :: il_len
841      CHARACTER(LEN=lc) :: cl_value
842
843      ! loop indices
844      INTEGER(i4) :: ji
845      !----------------------------------------------------------------
846
847      ! clean attribute
848      CALL att_clean(att__init_i4)
849     
[5037]850      ! array size
[4213]851      il_len=size(id_value(:))
852
853      cl_value="(/"
854      DO ji=1,il_len-1
855         cl_value=TRIM(cl_value)//TRIM(fct_str(id_value(ji)))//","
856      ENDDO
857      cl_value=TRIM(cl_value)//TRIM(fct_str(id_value(il_len)))//"/)"
858
[5037]859      CALL logger_trace( &
[4213]860      &  " ATT INIT: attribute name: "//TRIM(ADJUSTL(cd_name))//&
861      &  " attribute value "//TRIM(ADJUSTL(cl_value)) )     
862
863      att__init_i4%c_name=TRIM(ADJUSTL(cd_name))
864
[5037]865      IF( PRESENT(id_type) )THEN
866         att__init_i4%i_type=id_type
867      ELSE
868         att__init_i4%i_type=NF90_INT
869      ENDIF
[4213]870
871      IF( ASSOCIATED(att__init_i4%d_value) )THEN
872         DEALLOCATE(att__init_i4%d_value)
873      ENDIF
874      ALLOCATE(att__init_i4%d_value(il_len))
875
876      att__init_i4%d_value(:)=REAL(id_value(:),dp)
877      att__init_i4%i_len=il_len
878
879   END FUNCTION att__init_i4
880   !-------------------------------------------------------------------
[5037]881   !> @brief This function initialize an attribute structure with
882   !> integer(4) value.
883   !> @details
884   !> Optionaly you could specify the type of the variable to be saved.
[4213]885   !>
886   !> @author J.Paul
[5037]887   !> @date November, 2013 - Initial Version
888   !>
889   !> @param[in] cd_name   attribute name
890   !> @param[in] id_value  attribute value
891   !> @param[in] id_type   type of the variable to be saved
[4213]892   !> @return attribute structure
893   !-------------------------------------------------------------------
[5037]894   TYPE(TATT) FUNCTION att__init_i4_0d( cd_name, id_value, id_type )
[4213]895      IMPLICIT NONE
896      ! Argument
897      CHARACTER(LEN=*), INTENT(IN) :: cd_name
898      INTEGER(i4),      INTENT(IN) :: id_value
[5037]899      INTEGER(i4)     , INTENT(IN), OPTIONAL :: id_type
[4213]900
901      !local value
902      CHARACTER(LEN=lc) :: cl_value
903      !----------------------------------------------------------------
904
905      ! clean attribute
906      CALL att_clean(att__init_i4_0d)
907     
908      cl_value="(/"//TRIM(fct_str(id_value))//"/)"
909
[5037]910      CALL logger_trace( &
[4213]911      &  " ATT INIT: attribute name: "//TRIM(ADJUSTL(cd_name))//&
912      &  " attibute value "//TRIM(ADJUSTL(cl_value)) )     
913
914      att__init_i4_0d%c_name=TRIM(ADJUSTL(cd_name))
915
[5037]916      IF( PRESENT(id_type) )THEN
917         att__init_i4_0d%i_type=id_type
918      ELSE
919         att__init_i4_0d%i_type=NF90_INT
920      ENDIF
[4213]921
922      IF( ASSOCIATED(att__init_i4_0d%d_value) )THEN
923         DEALLOCATE(att__init_i4_0d%d_value)
924      ENDIF
925      ALLOCATE(att__init_i4_0d%d_value(1))
926
927      att__init_i4_0d%d_value(1)=REAL(id_value,dp)
928      att__init_i4_0d%i_len=1
929
930   END FUNCTION att__init_i4_0d
931   !-------------------------------------------------------------------
[5037]932   !> @brief This function initialize an attribute structure with array
933   !> of integer(8) value.
934   !> @details
935   !> Optionaly you could specify the type of the variable to be saved.
[4213]936   !>
937   !> @author J.Paul
[5037]938   !> @date November, 2013 - Initial Version
[4213]939   !
[5037]940   !> @param[in] cd_name   attribute name
941   !> @param[in] kd_value  attribute value
942   !> @param[in] id_type   type of the variable to be saved
[4213]943   !> @return attribute structure
944   !-------------------------------------------------------------------
[5037]945   TYPE(TATT) FUNCTION att__init_i8( cd_name, kd_value, id_type )
[4213]946      IMPLICIT NONE
947      ! Argument
948      CHARACTER(LEN=*),               INTENT(IN) :: cd_name
949      INTEGER(i8),      DIMENSION(:), INTENT(IN) :: kd_value
[5037]950      INTEGER(i4)                   , INTENT(IN), OPTIONAL :: id_type
[4213]951
952      ! local value
953      INTEGER(i4)       :: il_len
954      CHARACTER(LEN=lc) :: cl_value
955
956      ! loop indices
957      INTEGER(i4) :: ji
958      !----------------------------------------------------------------
959
960      ! clean attribute
961      CALL att_clean(att__init_i8)
962     
[5037]963      ! array size
[4213]964      il_len=size(kd_value(:))
965
966      cl_value="(/"
967      DO ji=1,il_len
968         cl_value=TRIM(cl_value)//TRIM(fct_str(kd_value(ji)))//","
969      ENDDO
970      cl_value=TRIM(cl_value)//TRIM(fct_str(kd_value(il_len)))//"/)"
971
[5037]972      CALL logger_trace( &
[4213]973      &  " ATT INIT: attribute name: "//TRIM(ADJUSTL(cd_name))//&
974      &  " attibute value "//TRIM(ADJUSTL(cl_value)) )     
975
976      att__init_i8%c_name=TRIM(ADJUSTL(cd_name))
977
[5037]978      IF( PRESENT(id_type) )THEN
979         att__init_i8%i_type=id_type
980      ELSE
981         att__init_i8%i_type=NF90_INT
982      ENDIF
[4213]983
984      IF( ASSOCIATED(att__init_i8%d_value) )THEN
985         DEALLOCATE(att__init_i8%d_value)
986      ENDIF
987      ALLOCATE(att__init_i8%d_value(il_len))
988
989      att__init_i8%d_value(:)=REAL(kd_value(:),dp)
990      att__init_i8%i_len=il_len
991
992   END FUNCTION att__init_i8
993   !-------------------------------------------------------------------
[5037]994   !> @brief This function initialize an attribute structure with
995   !> integer(8) value.
996   !> @details
997   !> Optionaly you could specify the type of the variable to be saved.
[4213]998   !>
999   !> @author J.Paul
[5037]1000   !> @date November, 2013 - Initial Version
[4213]1001   !
[5037]1002   !> @param[in] cd_name   attribute name
1003   !> @param[in] kd_value  attribute value
1004   !> @param[in] id_type   type of the variable to be saved
[4213]1005   !> @return attribute structure
1006   !-------------------------------------------------------------------
[5037]1007   TYPE(TATT) FUNCTION att__init_i8_0d( cd_name, kd_value, id_type )
[4213]1008      IMPLICIT NONE
1009      ! Argument
1010      CHARACTER(LEN=*), INTENT(IN) :: cd_name
1011      INTEGER(i8),      INTENT(IN) :: kd_value
[5037]1012      INTEGER(i4)     , INTENT(IN), OPTIONAL :: id_type
[4213]1013
1014      ! local value
1015      CHARACTER(LEN=lc) :: cl_value
1016      !----------------------------------------------------------------
1017
1018      ! clean attribute
1019      CALL att_clean(att__init_i8_0d)
1020     
1021      cl_value="(/"//TRIM(fct_str(kd_value))//"/)"
1022
[5037]1023      CALL logger_trace( &
[4213]1024      &  " ATT INIT: attribute name: "//TRIM(ADJUSTL(cd_name))//&
1025      &  " attibute value "//TRIM(ADJUSTL(cl_value)) )     
1026
1027      att__init_i8_0d%c_name=TRIM(ADJUSTL(cd_name))
1028
[5037]1029      IF( PRESENT(id_type) )THEN
1030         att__init_i8_0d%i_type=id_type
1031      ELSE
1032         att__init_i8_0d%i_type=NF90_INT
1033      ENDIF
[4213]1034
1035      IF( ASSOCIATED(att__init_i8_0d%d_value) )THEN
1036         DEALLOCATE(att__init_i8_0d%d_value)
1037      ENDIF
1038      ALLOCATE(att__init_i8_0d%d_value(1))
1039
1040      att__init_i8_0d%d_value(1)=REAL(kd_value,dp)
1041      att__init_i8_0d%i_len=1
1042
1043   END FUNCTION att__init_i8_0d
1044   !-------------------------------------------------------------------
[5037]1045   !> @brief This subroutine print informations of an array of attribute.
[4213]1046   !>
1047   !> @author J.Paul
[5037]1048   !> @date June, 2014 - Initial Version
1049   !>
1050   !> @param[in] td_att array of attribute structure
1051   !-------------------------------------------------------------------
1052   SUBROUTINE att__print_arr(td_att)
1053      IMPLICIT NONE
1054
1055      ! Argument     
1056      TYPE(TATT), DIMENSION(:), INTENT(IN) :: td_att
1057
1058      ! loop indices
1059      INTEGER(i4) :: ji
1060      !----------------------------------------------------------------
1061
1062      DO ji=1,SIZE(td_att(:))
1063         CALL att_print(td_att(ji))
1064      ENDDO
1065
1066   END SUBROUTINE att__print_arr
1067   !-------------------------------------------------------------------
1068   !> @brief This subroutine print attribute information.
1069   !>
1070   !> @author J.Paul
1071   !> @date November, 2013 - Initial Version
[9817]1072   !> @date September, 2014
1073   !> - take into account type of attribute.
[4213]1074   !
[5037]1075   !> @param[in] td_att attribute structure
[4213]1076   !-------------------------------------------------------------------
[5037]1077   SUBROUTINE att__print_unit(td_att)
[4213]1078      IMPLICIT NONE
1079
1080      ! Argument     
1081      TYPE(TATT), INTENT(IN) :: td_att
1082
1083      ! local vairbale
1084      CHARACTER(LEN=lc) :: cl_type
1085      CHARACTER(LEN=lc) :: cl_value
1086
[5037]1087      INTEGER(i8)       :: kl_tmp
1088      INTEGER(i2)       :: sl_tmp
1089      INTEGER(i1)       :: bl_tmp
1090      REAL(sp)          :: rl_tmp
1091      REAL(dp)          :: dl_tmp
1092
[4213]1093      ! loop indices
1094      INTEGER(i4) :: ji
1095      !----------------------------------------------------------------
1096
1097         SELECT CASE( td_att%i_type )
1098
1099            CASE(NF90_CHAR)
1100               cl_type='CHAR'
1101            CASE(NF90_BYTE)
1102               cl_type='BYTE'
1103            CASE(NF90_SHORT)
1104               cl_type='SHORT'
1105            CASE(NF90_INT)
1106               cl_type='INT'
1107            CASE(NF90_FLOAT)
1108               cl_type='FLOAT'
1109            CASE(NF90_DOUBLE)
1110               cl_type='DOUBLE'
1111            CASE DEFAULT
1112               cl_type=''
[5037]1113
[4213]1114         END SELECT
1115
1116         SELECT CASE( td_att%i_type )
1117
1118            CASE(NF90_CHAR)
[9817]1119
[4213]1120               cl_value=td_att%c_value
1121
[5037]1122            CASE(NF90_BYTE)   
[4213]1123               IF( td_att%i_len > 1 )THEN
[5037]1124                  cl_value='(/'
1125                  DO ji=1,td_att%i_len-1
1126                     bl_tmp=INT(td_att%d_value(ji),i1)
1127                     cl_value=TRIM(cl_value)//TRIM(fct_str(bl_tmp))//','
1128                  ENDDO
1129                  bl_tmp=INT(td_att%d_value(td_att%i_len),i1)
1130                  cl_value=TRIM(cl_value)//TRIM(fct_str(bl_tmp))//'/)'
1131               ELSE
1132                  cl_value='(/'//TRIM(fct_str(td_att%d_value(1)))//'/)'
1133               ENDIF
[4213]1134
[5037]1135            CASE(NF90_SHORT)   
1136               IF( td_att%i_len > 1 )THEN
[4213]1137                  cl_value='(/'
1138                  DO ji=1,td_att%i_len-1
[5037]1139                     sl_tmp=INT(td_att%d_value(ji),i2)
1140                     cl_value=TRIM(cl_value)//TRIM(fct_str(sl_tmp))//','
[4213]1141                  ENDDO
[5037]1142                  sl_tmp=INT(td_att%d_value(td_att%i_len),i2)
1143                  cl_value=TRIM(cl_value)//TRIM(fct_str(sl_tmp))//'/)'
1144               ELSE
1145                  cl_value='(/'//TRIM(fct_str(td_att%d_value(1)))//'/)'
1146               ENDIF
[4213]1147
[5037]1148            CASE(NF90_INT)   
1149               IF( td_att%i_len > 1 )THEN
1150                  cl_value='(/'
1151                  DO ji=1,td_att%i_len-1
1152                     kl_tmp=INT(td_att%d_value(ji),i8)
1153                     cl_value=TRIM(cl_value)//TRIM(fct_str(kl_tmp))//','
1154                  ENDDO
1155                  kl_tmp=INT(td_att%d_value(td_att%i_len),i8)
1156                  cl_value=TRIM(cl_value)//TRIM(fct_str(kl_tmp))//'/)'
[4213]1157               ELSE
[5037]1158                  cl_value='(/'//TRIM(fct_str(td_att%d_value(1)))//'/)'
1159               ENDIF
[4213]1160
[5037]1161            CASE(NF90_FLOAT)   
1162               IF( td_att%i_len > 1 )THEN
1163                  cl_value='(/'
1164                  DO ji=1,td_att%i_len-1
1165                     rl_tmp=REAL(td_att%d_value(ji),sp)
1166                     cl_value=TRIM(cl_value)//TRIM(fct_str(rl_tmp))//','
1167                  ENDDO
1168                  rl_tmp=REAL(td_att%d_value(td_att%i_len),sp)
1169                  cl_value=TRIM(cl_value)//TRIM(fct_str(rl_tmp))//'/)'
1170               ELSE
[4213]1171                  cl_value='(/'//TRIM(fct_str(td_att%d_value(1)))//'/)'
[5037]1172               ENDIF
[4213]1173
[5037]1174            CASE(NF90_DOUBLE)   
1175               IF( td_att%i_len > 1 )THEN
1176                  cl_value='(/'
1177                  DO ji=1,td_att%i_len-1
1178                     dl_tmp=REAL(td_att%d_value(ji),dp)
1179                     cl_value=TRIM(cl_value)//TRIM(fct_str(dl_tmp))//','
1180                  ENDDO
1181                  dl_tmp=REAL(td_att%d_value(td_att%i_len),dp)
1182                  cl_value=TRIM(cl_value)//TRIM(fct_str(dl_tmp))//'/)'
1183               ELSE
1184                  cl_value='(/'//TRIM(fct_str(td_att%d_value(1)))//'/)'
[4213]1185               ENDIF
[5037]1186
[4213]1187            CASE DEFAULT
1188               cl_value="none"
1189
1190         END SELECT
1191
1192         WRITE(*,'((3x,a,a),(/6x,a,i2.2),(a,a),(a,a))')&
1193         &        " attribute : ",TRIM(ADJUSTL(td_att%c_name)),      &
1194         &        " id : ",td_att%i_id,                         &
1195         &        " type : ",TRIM(ADJUSTL(cl_type)),            &
1196         &        " value : ",TRIM(ADJUSTL(cl_value))
1197
[5037]1198   END SUBROUTINE att__print_unit
[4213]1199   !-------------------------------------------------------------------
1200   !> @brief
1201   !>  This subroutine clean attribute strcuture.
1202   !
1203   !> @author J.Paul
[5037]1204   !> @date November, 2013 - Initial Version
[4213]1205   !
[5037]1206   !> @param[inout] td_att attribute strcuture
[4213]1207   !-------------------------------------------------------------------
[5037]1208   SUBROUTINE att__clean_unit( td_att )
[4213]1209      IMPLICIT NONE
1210      ! Argument
1211      TYPE(TATT),  INTENT(INOUT) :: td_att
1212
1213      ! local variable
1214      TYPE(TATT) :: tl_att ! empty attribute structure
1215      !----------------------------------------------------------------
1216
[5037]1217      CALL logger_trace( &
[4213]1218      &  " CLEAN: reset attribute "//TRIM(td_att%c_name) )
1219
1220      IF( ASSOCIATED(td_att%d_value) )THEN
1221         ! clean value
1222         DEALLOCATE(td_att%d_value)
1223      ENDIF
1224
1225      ! replace by empty structure
[5037]1226      td_att=att_copy(tl_att)
[4213]1227
[5037]1228   END SUBROUTINE att__clean_unit
1229   !-------------------------------------------------------------------
1230   !> @brief
1231   !>  This subroutine clean array of attribute strcuture.
1232   !
1233   !> @author J.Paul
1234   !> @date September, 2014 - Initial Version
1235   !
1236   !> @param[inout] td_att attribute strcuture
1237   !-------------------------------------------------------------------
1238   SUBROUTINE att__clean_arr( td_att )
1239      IMPLICIT NONE
1240      ! Argument
1241      TYPE(TATT), DIMENSION(:), INTENT(INOUT) :: td_att
1242
1243      ! local variable
1244      ! loop indices
1245      INTEGER(i4) :: ji
1246      !----------------------------------------------------------------
1247
1248      DO ji=SIZE(td_att(:)),1,-1
1249         CALL att_clean(td_att(ji) )
1250      ENDDO
1251
1252   END SUBROUTINE att__clean_arr
[4213]1253END MODULE att
1254
Note: See TracBrowser for help on using the repository browser.