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
Line 
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.
10!>
11!> @details
12!>    define type TATT:<br/>
13!> @code
14!>    TYPE(TATT) :: tl_att
15!> @endcode
16!>
17!>    the attribute value inside attribute structure will be
18!>    character or real(8) 1D array.<br/>
19!>    However the attribute value could be initialized with:<br/>
20!>    - character
21!>    - scalar (real(4), real(8), integer(4) or integer(8))
22!>    - array 1D (real(4), real(8), integer(4) or integer(8))
23!>
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
29!>
30!>    to print attribute information of one or array of attribute structure:<br/>
31!> @code
32!>    CALL att_print(td_att)
33!> @endcode
34!>
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!>
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!>
77!>    to get attribute id (read from file):<br/>
78!>    - tl_att\%i_id
79!>
80!> @author J.Paul
81! REVISION HISTORY:
82!> @date November, 2013 - Initial Version
83!> @date November, 2014
84!> - Fix memory leaks bug
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
92   USE logger                          ! log file manager
93   USE fct                             ! basic useful function
94   IMPLICIT NONE
95   ! NOTE_avoid_public_variables_if_possible
96
97   ! type and variable
98   PUBLIC :: TATT       !< attribute structure
99
100   ! function and subroutine
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
107
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
127
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
132      INTEGER(i4)       :: i_len  = 0        !< number of value store in attribute
133      CHARACTER(LEN=lc) :: c_value = 'none'  !< attribute value if type CHAR
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
138      MODULE PROCEDURE att__init_c   
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
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   
161   END INTERFACE
162
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
168CONTAINS
169   !-------------------------------------------------------------------
170   !> @brief
171   !> This subroutine copy a array of attribute structure in another one
172   !> @details
173   !> see att__copy_unit
174   !>
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.
178   !> @warning to avoid infinite loop, do not use any function inside
179   !> this subroutine
180   !>
181   !> @author J.Paul
182   !> @date November, 2013 - Initial Version
183   !> @date November, 2014
184   !> - use function instead of overload assignment operator
185   !> (to avoid memory leak)
186   !
187   !> @param[in] td_att   array of attribute structure
188   !> @return copy of input array of attribute structure
189   !-------------------------------------------------------------------
190   FUNCTION att__copy_arr( td_att )
191      IMPLICIT NONE
192      ! Argument
193      TYPE(TATT), DIMENSION(:), INTENT(IN) :: td_att
194      ! function
195      TYPE(TATT), DIMENSION(SIZE(td_att(:))) :: att__copy_arr
196
197      ! local variable
198      ! loop indices
199      INTEGER(i4) :: ji
200      !----------------------------------------------------------------
201
202      DO ji=1,SIZE(td_att(:))
203         att__copy_arr(ji)=att_copy(td_att(ji))
204      ENDDO
205
206   END FUNCTION att__copy_arr
207   !-------------------------------------------------------------------
208   !> @brief
209   !> This subroutine copy an attribute structure in another one.
210   !> @details
211   !> attribute value are copied in a temporary array, so input and output
212   !> attribute structure value do not point on the same "memory cell", and so
213   !> on are independant.
214   !>
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.
218   !> @warning to avoid infinite loop, do not use any function inside
219   !> this subroutine
220   !>
221   !> @author J.Paul
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
228   !-------------------------------------------------------------------
229   FUNCTION att__copy_unit( td_att )
230      IMPLICIT NONE
231      ! Argument
232      TYPE(TATT), INTENT(IN)  :: td_att
233      ! function
234      TYPE(TATT) :: att__copy_unit
235
236      ! local variable
237      REAL(dp)         , DIMENSION(:), ALLOCATABLE :: dl_value
238      !----------------------------------------------------------------
239
240      ! copy attribute variable
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)
246
247      ! copy attribute pointer in an independant variable
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(:)
252
253         ALLOCATE( att__copy_unit%d_value(att__copy_unit%i_len) )
254         att__copy_unit%d_value(:) = dl_value(:)
255
256         DEALLOCATE( dl_value )
257      ENDIF
258
259   END FUNCTION att__copy_unit
260   !-------------------------------------------------------------------
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.
265   !>
266   !> @author J.Paul
267   !> @date Septempber, 2014 - Initial Version
268   !
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
303   !> @date September, 2014
304   !> - bug fix with use of id read from attribute structure
305   !>
306   !> @param[in] td_att    array of attribute structure
307   !> @param[in] cd_name   attribute name
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
327            att_get_id=td_att(ji)%i_id
328            EXIT
329         ENDIF
330      ENDDO
331
332   END FUNCTION att_get_id
333   !-------------------------------------------------------------------
334   !> @brief This function initialize an attribute structure with character
335   !> value.
336   !>
337   !> @author J.Paul
338   !> @date November, 2013 - Initial Version
339   !
340   !> @param[in] cd_name   attribute name
341   !> @param[in] cd_value  attribute value
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
354      CALL logger_trace( &
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))
359      att__init_c%i_type=NF90_CHAR
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   !-------------------------------------------------------------------
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.
370   !>
371   !> @author J.Paul
372   !> @date November, 2013 - Initial Version
373   !
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
377   !> @return attribute structure
378   !-------------------------------------------------------------------
379   TYPE(TATT) FUNCTION att__init_dp( cd_name, dd_value, id_type )
380      IMPLICIT NONE
381
382      ! Argument
383      CHARACTER(LEN=*),               INTENT(IN) :: cd_name
384      REAL(dp),         DIMENSION(:), INTENT(IN) :: dd_value
385      INTEGER(i4)                   , INTENT(IN), OPTIONAL :: id_type
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
398      ! array size
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
407      CALL logger_trace( &
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
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
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   !-------------------------------------------------------------------
429   !> @brief This function initialize an attribute structure with
430   !> real(8) value
431   !> @details
432   !> Optionaly you could specify the type of the variable to be saved.
433   !>
434   !> @author J.Paul
435   !> @date November, 2013 - Initial Version
436   !
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
440   !> @return attribute structure
441   !-------------------------------------------------------------------
442   TYPE(TATT) FUNCTION att__init_dp_0d( cd_name, dd_value, id_type )
443      IMPLICIT NONE
444      ! Argument
445      CHARACTER(LEN=*), INTENT(IN) :: cd_name
446      REAL(dp),         INTENT(IN) :: dd_value
447      INTEGER(i4)     , INTENT(IN), OPTIONAL :: id_type
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
458      CALL logger_trace( &
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
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
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   !-------------------------------------------------------------------
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.
484   !>
485   !> @author J.Paul
486   !> @date November, 2013 - Initial Version
487   !
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
491   !> @return attribute structure
492   !-------------------------------------------------------------------
493   TYPE(TATT) FUNCTION att__init_sp( cd_name, rd_value, id_type )
494      IMPLICIT NONE
495      ! Argument
496      CHARACTER(LEN=*),               INTENT(IN) :: cd_name
497      REAL(sp),         DIMENSION(:), INTENT(IN) :: rd_value
498      INTEGER(i4)                   , INTENT(IN), OPTIONAL :: id_type
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     
511      ! array size
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
520      CALL logger_trace( &
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
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
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   !-------------------------------------------------------------------
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.
546   !>
547   !> @author J.Paul
548   !> @date November, 2013 - Initial Version
549   !
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
553   !> @return attribute structure
554   !-------------------------------------------------------------------
555   TYPE(TATT) FUNCTION att__init_sp_0d( cd_name, rd_value, id_type )
556      IMPLICIT NONE
557      ! Argument
558      CHARACTER(LEN=*), INTENT(IN) :: cd_name
559      REAL(sp),         INTENT(IN) :: rd_value
560      INTEGER(i4)     , INTENT(IN), OPTIONAL :: id_type
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
571      CALL logger_trace( &
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
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
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   !-------------------------------------------------------------------
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.
597   !>
598   !> @author J.Paul
599   !> @date November, 2013 - Initial Version
600   !
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
604   !> @return attribute structure
605   !-------------------------------------------------------------------
606   TYPE(TATT) FUNCTION att__init_i1( cd_name, bd_value, id_type )
607      IMPLICIT NONE
608      ! Argument
609      CHARACTER(LEN=*),               INTENT(IN) :: cd_name
610      INTEGER(i1),      DIMENSION(:), INTENT(IN) :: bd_value
611      INTEGER(i4)                   , INTENT(IN), OPTIONAL :: id_type
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     
624      ! array size
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
633      CALL logger_trace( &
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
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
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   !-------------------------------------------------------------------
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.
659   !>
660   !> @author J.Paul
661   !> @date November, 2013 - Initial Version
662   !
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
666   !> @return attribute structure
667   !-------------------------------------------------------------------
668   TYPE(TATT) FUNCTION att__init_i1_0d( cd_name, bd_value, id_type )
669      IMPLICIT NONE
670      ! Argument
671      CHARACTER(LEN=*), INTENT(IN) :: cd_name
672      INTEGER(i1),      INTENT(IN) :: bd_value
673      INTEGER(i4)     , INTENT(IN), OPTIONAL :: id_type
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
684      CALL logger_trace( &
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
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     
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   !-------------------------------------------------------------------
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.
710   !>
711   !> @author J.Paul
712   !> @date November, 2013 - Initial Version
713   !
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
717   !> @return attribute structure
718   !-------------------------------------------------------------------
719   TYPE(TATT) FUNCTION att__init_i2( cd_name, sd_value, id_type )
720      IMPLICIT NONE
721      ! Argument
722      CHARACTER(LEN=*),               INTENT(IN) :: cd_name
723      INTEGER(i2),      DIMENSION(:), INTENT(IN) :: sd_value
724      INTEGER(i4)                   , INTENT(IN), OPTIONAL :: id_type
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     
737      ! array size
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
746      CALL logger_trace( &
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
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
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   !-------------------------------------------------------------------
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.
772   !>
773   !> @author J.Paul
774   !> @date November, 2013 - Initial Version
775   !
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
779   !> @return attribute structure
780   !-------------------------------------------------------------------
781   TYPE(TATT) FUNCTION att__init_i2_0d( cd_name, sd_value, id_type )
782      IMPLICIT NONE
783      ! Argument
784      CHARACTER(LEN=*), INTENT(IN) :: cd_name
785      INTEGER(i2),      INTENT(IN) :: sd_value
786      INTEGER(i4)     , INTENT(IN), OPTIONAL :: id_type
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
797      CALL logger_trace( &
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
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
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   !-------------------------------------------------------------------
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.
823   !>
824   !> @author J.Paul
825   !> @date November, 2013 - Initial Version
826   !
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
830   !> @return attribute structure
831   !-------------------------------------------------------------------
832   TYPE(TATT) FUNCTION att__init_i4( cd_name, id_value, id_type )
833      IMPLICIT NONE
834      ! Argument
835      CHARACTER(LEN=*),               INTENT(IN) :: cd_name
836      INTEGER(i4),      DIMENSION(:), INTENT(IN) :: id_value
837      INTEGER(i4)                   , INTENT(IN), OPTIONAL :: id_type
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     
850      ! array size
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
859      CALL logger_trace( &
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
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
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   !-------------------------------------------------------------------
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.
885   !>
886   !> @author J.Paul
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
892   !> @return attribute structure
893   !-------------------------------------------------------------------
894   TYPE(TATT) FUNCTION att__init_i4_0d( cd_name, id_value, id_type )
895      IMPLICIT NONE
896      ! Argument
897      CHARACTER(LEN=*), INTENT(IN) :: cd_name
898      INTEGER(i4),      INTENT(IN) :: id_value
899      INTEGER(i4)     , INTENT(IN), OPTIONAL :: id_type
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
910      CALL logger_trace( &
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
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
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   !-------------------------------------------------------------------
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.
936   !>
937   !> @author J.Paul
938   !> @date November, 2013 - Initial Version
939   !
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
943   !> @return attribute structure
944   !-------------------------------------------------------------------
945   TYPE(TATT) FUNCTION att__init_i8( cd_name, kd_value, id_type )
946      IMPLICIT NONE
947      ! Argument
948      CHARACTER(LEN=*),               INTENT(IN) :: cd_name
949      INTEGER(i8),      DIMENSION(:), INTENT(IN) :: kd_value
950      INTEGER(i4)                   , INTENT(IN), OPTIONAL :: id_type
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     
963      ! array size
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
972      CALL logger_trace( &
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
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
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   !-------------------------------------------------------------------
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.
998   !>
999   !> @author J.Paul
1000   !> @date November, 2013 - Initial Version
1001   !
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
1005   !> @return attribute structure
1006   !-------------------------------------------------------------------
1007   TYPE(TATT) FUNCTION att__init_i8_0d( cd_name, kd_value, id_type )
1008      IMPLICIT NONE
1009      ! Argument
1010      CHARACTER(LEN=*), INTENT(IN) :: cd_name
1011      INTEGER(i8),      INTENT(IN) :: kd_value
1012      INTEGER(i4)     , INTENT(IN), OPTIONAL :: id_type
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
1023      CALL logger_trace( &
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
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
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   !-------------------------------------------------------------------
1045   !> @brief This subroutine print informations of an array of attribute.
1046   !>
1047   !> @author J.Paul
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
1072   !> @date September, 2014
1073   !> - take into account type of attribute.
1074   !
1075   !> @param[in] td_att attribute structure
1076   !-------------------------------------------------------------------
1077   SUBROUTINE att__print_unit(td_att)
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
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
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=''
1113
1114         END SELECT
1115
1116         SELECT CASE( td_att%i_type )
1117
1118            CASE(NF90_CHAR)
1119
1120               cl_value=td_att%c_value
1121
1122            CASE(NF90_BYTE)   
1123               IF( td_att%i_len > 1 )THEN
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
1134
1135            CASE(NF90_SHORT)   
1136               IF( td_att%i_len > 1 )THEN
1137                  cl_value='(/'
1138                  DO ji=1,td_att%i_len-1
1139                     sl_tmp=INT(td_att%d_value(ji),i2)
1140                     cl_value=TRIM(cl_value)//TRIM(fct_str(sl_tmp))//','
1141                  ENDDO
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
1147
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))//'/)'
1157               ELSE
1158                  cl_value='(/'//TRIM(fct_str(td_att%d_value(1)))//'/)'
1159               ENDIF
1160
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
1171                  cl_value='(/'//TRIM(fct_str(td_att%d_value(1)))//'/)'
1172               ENDIF
1173
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)))//'/)'
1185               ENDIF
1186
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
1198   END SUBROUTINE att__print_unit
1199   !-------------------------------------------------------------------
1200   !> @brief
1201   !>  This subroutine clean attribute strcuture.
1202   !
1203   !> @author J.Paul
1204   !> @date November, 2013 - Initial Version
1205   !
1206   !> @param[inout] td_att attribute strcuture
1207   !-------------------------------------------------------------------
1208   SUBROUTINE att__clean_unit( td_att )
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
1217      CALL logger_trace( &
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
1226      td_att=att_copy(tl_att)
1227
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
1253END MODULE att
1254
Note: See TracBrowser for help on using the repository browser.