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/2015/nemo_v3_6_STABLE/NEMOGCM/TOOLS/SIREN/src – NEMO

source: branches/2015/nemo_v3_6_STABLE/NEMOGCM/TOOLS/SIREN/src/attribute.f90 @ 6392

Last change on this file since 6392 was 6392, checked in by jpaul, 8 years ago

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