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

source: branches/2014/dev_r4650_UKMO12_CFL_diags_take2/NEMOGCM/TOOLS/SIREN/src/attribute.f90 @ 5947

Last change on this file since 5947 was 5947, checked in by timgraham, 8 years ago

Reinstate svn Id keywords before merge

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