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/2013/dev_rev4119_MERCATOR4_CONFMAN/NEMOGCM/TOOLS/SIREN/src – NEMO

source: branches/2013/dev_rev4119_MERCATOR4_CONFMAN/NEMOGCM/TOOLS/SIREN/src/attribute.f90 @ 4213

Last change on this file since 4213 was 4213, checked in by cbricaud, 10 years ago

first draft of the CONFIGURATION MANAGER demonstrator

File size: 31.2 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!>    TYPE(TATT) :: tl_att<br/>
14!>
15!>    the attribute value inside attribute structure will be
16!>    character or real(8) 1D table.<br/>
17!>    However the attribute value could be initialised with:<br/>
18!>    - character
19!>    - scalar (real(4), real(8), integer(4) or integer(8))
20!>    - table 1D (real(4), real(8), integer(4) or integer(8))
21!>
22!>    to initialise an attribute structure :<br/>
23!>    tl_att=att_init('attname',value)<br/>
24!>    tl_att=att_init('attname',tab_value)<br/>
25!>
26!>    to print attribute information of one attribute structure:<br/>
27!>    CALL att_print(td_att)
28!>
29!>    to get character length or the number of value store in attribute
30!>    - tl_att\%i_len
31!>
32!>    to get attribute value:<br/>
33!>    - tl_att\%c_value    (for character attribute)
34!>    - tl_att\%d_value(i) (otherwise)
35!>   
36!>    to get the type number (based on NETCDF type constants) of the
37!>    attribute:<br/>
38!>    - tl_att\%i_type
39!>
40!>    to get attribute id (affected when attributes will be added to
41!>    variable or file):<br/>
42!>    - tl_att\%i_id
43!>
44!> @author
45!> J.Paul
46! REVISION HISTORY:
47!> @date Nov, 2013 - Initial Version
48!
49!> @note Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
50!> @todo
51!----------------------------------------------------------------------
52MODULE att
53   USE netcdf                          ! nf90 library
54   USE global                          ! global variable
55   USE kind                            ! F90 kind parameter
56   USE logger                             ! log file manager
57   USE fct                             ! basic useful function
58   IMPLICIT NONE
59   PRIVATE
60   ! NOTE_avoid_public_variables_if_possible
61
62   ! type and variable
63   PUBLIC :: TATT       ! attribute structure
64
65   ! function and subroutine
66   PUBLIC :: ASSIGNMENT(=)  ! copy attribute structure
67   PUBLIC :: att_init     ! initialize attribute structure
68   PUBLIC :: att_print    ! print attribute structure
69   PUBLIC :: att_get_id   ! get attribute id in table of attribute structure
70   PUBLIC :: att_clean    ! clean attribute strcuture
71
72   PRIVATE :: att__init_c     ! initialise an attribute structure with character value
73   PRIVATE :: att__init_dp    ! initialise an attribute structure with table of real(8) value
74   PRIVATE :: att__init_dp_0d ! initialise an attribute structure with real(8) value
75   PRIVATE :: att__init_sp    ! initialise an attribute structure with table of real(4) value
76   PRIVATE :: att__init_sp_0d ! initialise an attribute structure with real(4) value
77   PRIVATE :: att__init_i1    ! initialise an attribute structure with table of integer(1) value
78   PRIVATE :: att__init_i1_0d ! initialise an attribute structure with integer(1) value
79   PRIVATE :: att__init_i2    ! initialise an attribute structure with table of integer(2) value
80   PRIVATE :: att__init_i2_0d ! initialise an attribute structure with integer(2) value
81   PRIVATE :: att__init_i4    ! initialise an attribute structure with table of integer(4) value
82   PRIVATE :: att__init_i4_0d ! initialise an attribute structure with integer(4) value
83   PRIVATE :: att__init_i8    ! initialise an attribute structure with table of integer(8) value
84   PRIVATE :: att__init_i8_0d ! initialise an attribute structure with integer(8) value
85   PRIVATE :: att__copy_unit   ! copy attribute structure
86   PRIVATE :: att__copy_tab    ! copy attribute structure
87
88   !> @struct TATT
89   TYPE TATT
90      !CHARACTER(LEN=lc) :: c_name = 'unknown'  !< attribute name
91      CHARACTER(LEN=lc) :: c_name = ''  !< attribute name
92      INTEGER(i4)       :: i_id = 0          !< attribute id
93      INTEGER(i4)       :: i_type  = 0       !< attribute type
94      INTEGER(i4)       :: i_len  = 0        !< number of value store in attribute
95      CHARACTER(LEN=lc) :: c_value = "none"  !< attribute value if type CHAR
96      REAL(dp), DIMENSION(:), POINTER :: d_value => NULL() !< attribute value if type SHORT,INT,FLOAT or DOUBLE
97   END TYPE TATT
98
99   INTERFACE att_init
100      MODULE PROCEDURE att__init_c
101      MODULE PROCEDURE att__init_dp
102      MODULE PROCEDURE att__init_dp_0d
103      MODULE PROCEDURE att__init_sp
104      MODULE PROCEDURE att__init_sp_0d
105      MODULE PROCEDURE att__init_i1
106      MODULE PROCEDURE att__init_i1_0d
107      MODULE PROCEDURE att__init_i2
108      MODULE PROCEDURE att__init_i2_0d
109      MODULE PROCEDURE att__init_i4
110      MODULE PROCEDURE att__init_i4_0d
111      MODULE PROCEDURE att__init_i8
112      MODULE PROCEDURE att__init_i8_0d
113   END INTERFACE att_init
114
115   INTERFACE ASSIGNMENT(=)
116      MODULE PROCEDURE att__copy_unit   ! copy attribute structure
117      MODULE PROCEDURE att__copy_tab   ! copy attribute structure
118   END INTERFACE
119
120CONTAINS
121   !-------------------------------------------------------------------
122   !> @brief
123   !> This function copy attribute structure in another attribute
124   !> structure
125   !> @details
126   !> attribute value are copied in a temporary table, so input and output
127   !> attribute structure value do not point on the same "memory cell", and so
128   !> on are independant.
129   !>
130   !> @warning to avoid infinite loop, do not use any function inside
131   !> this subroutine
132   !>
133   !> @author J.Paul
134   !> - Nov, 2013- Initial Version
135   !
136   !> @param[out] td_att1  : attribute structure
137   !> @param[in] td_att2  : attribute structure
138   !-------------------------------------------------------------------
139   ! @code
140   SUBROUTINE att__copy_tab( td_att1, td_att2 )
141      IMPLICIT NONE
142      ! Argument
143      TYPE(TATT), DIMENSION(:)               , INTENT(IN) :: td_att2
144      TYPE(TATT), DIMENSION(SIZE(td_att2(:))),INTENT(OUT) :: td_att1
145
146      ! local variable
147      ! loop indices
148      INTEGER(i4) :: ji
149      !----------------------------------------------------------------
150
151      DO ji=1,SIZE(td_att2(:))
152         td_att1(ji)=td_att2(ji)
153      ENDDO
154
155   END SUBROUTINE att__copy_tab
156   ! @endcode
157   !-------------------------------------------------------------------
158   !> @brief
159   !> This function copy attribute structure in another attribute
160   !> structure
161   !> @details
162   !> attribute value are copied in a temporary table, so input and output
163   !> attribute structure value do not point on the same "memory cell", and so
164   !> on are independant.
165   !>
166   !> @warning to avoid infinite loop, do not use any function inside
167   !> this subroutine
168   !>
169   !> @author J.Paul
170   !> - Nov, 2013- Initial Version
171   !
172   !> @param[out] td_att1  : attribute structure
173   !> @param[in] td_att2  : attribute structure
174   !-------------------------------------------------------------------
175   ! @code
176   SUBROUTINE att__copy_unit( td_att1, td_att2 )
177      IMPLICIT NONE
178      ! Argument
179      TYPE(TATT), INTENT(OUT) :: td_att1
180      TYPE(TATT), INTENT(IN)  :: td_att2
181
182      ! local variable
183      REAL(dp), DIMENSION(:), ALLOCATABLE :: dl_value
184      !----------------------------------------------------------------
185
186      CALL logger_trace("COPY: attribute "//TRIM(td_att2%c_name) )
187
188      ! copy attribute variable
189      td_att1%c_name  = TRIM(td_att2%c_name)
190      td_att1%i_id    = td_att2%i_id
191      td_att1%i_type  = td_att2%i_type
192      td_att1%i_len   = td_att2%i_len
193      td_att1%c_value = TRIM(td_att2%c_value)
194
195      ! copy attribute pointer in an independant variable
196      IF( ASSOCIATED(td_att1%d_value) ) DEALLOCATE(td_att1%d_value)
197      IF( ASSOCIATED(td_att2%d_value) )THEN
198         ALLOCATE( dl_value(td_att2%i_len) )
199         dl_value(:) = td_att2%d_value(:)
200
201         ALLOCATE( td_att1%d_value(td_att1%i_len) )
202         td_att1%d_value(:) = dl_value(:)
203
204         DEALLOCATE( dl_value )
205      ENDIF
206
207   END SUBROUTINE att__copy_unit
208   ! @endcode
209   !-------------------------------------------------------------------
210   !> @brief This function get attribute id, in a table of attribute structure,
211   !> given attribute name
212   !>
213   !> @author J.Paul
214   !> - Nov, 2013- Initial Version
215   !
216   !> @param[in] td_att  : attribute structure
217   !> @param[in] cd_name : attribute name
218   !> @return attribute id
219   !-------------------------------------------------------------------
220   ! @code
221   INTEGER(i4) FUNCTION att_get_id( td_att, cd_name )
222      IMPLICIT NONE
223      ! Argument
224      TYPE(TATT),       DIMENSION(:), INTENT(IN) :: td_att
225      CHARACTER(LEN=*),               INTENT(IN) :: cd_name
226
227      ! local variable
228      INTEGER(i4) :: il_size
229
230      ! loop indices
231      INTEGER(i4) :: ji
232      !----------------------------------------------------------------
233      att_get_id=0
234
235      il_size=SIZE(td_att(:))
236      DO ji=1,il_size
237         IF( TRIM(td_att(ji)%c_name) == TRIM(cd_name) )THEN
238            att_get_id=ji
239            EXIT
240         ENDIF
241      ENDDO
242
243   END FUNCTION att_get_id
244   !> @endcode
245   !-------------------------------------------------------------------
246   !> @brief This function initialise an attribute structure with character
247   !> value
248   !>
249   !> @author J.Paul
250   !> - Nov, 2013- Initial Version
251   !
252   !> @param[in] cd_name : attribute name
253   !> @param[in] cd_value: attribute value
254   !> @return attribute structure
255   !-------------------------------------------------------------------
256   !> @code
257   TYPE(TATT) FUNCTION att__init_c( cd_name, cd_value )
258      IMPLICIT NONE
259      ! Argument
260      CHARACTER(LEN=*), INTENT(IN) :: cd_name
261      CHARACTER(LEN=*), INTENT(IN) :: cd_value
262      !----------------------------------------------------------------
263 
264      ! clean attribute
265      CALL att_clean(att__init_c)
266
267      CALL logger_info( &
268      &  " ATT INIT: attribute name: "//TRIM(ADJUSTL(cd_name))//&
269      &  " attribute value "//TRIM(ADJUSTL(cd_value)) )
270
271      att__init_c%c_name=TRIM(ADJUSTL(cd_name))
272
273      att__init_c%i_type=NF90_CHAR
274      att__init_c%c_value=TRIM(ADJUSTL(cd_value))
275      att__init_c%i_len=LEN( TRIM(ADJUSTL(cd_value)) )
276
277   END FUNCTION att__init_c
278   !> @endcode
279   !-------------------------------------------------------------------
280   !> @brief This function initialise an attribute structure with table
281   !> of real(8) value
282   !>
283   !> @author J.Paul
284   !> - Nov, 2013- Initial Version
285   !
286   !> @param[in] cd_name : attribute name
287   !> @param[in] dd_value: attribute value
288   !> @return attribute structure
289   !-------------------------------------------------------------------
290   !> @code
291   TYPE(TATT) FUNCTION att__init_dp( cd_name, dd_value )
292      IMPLICIT NONE
293
294      ! Argument
295      CHARACTER(LEN=*),               INTENT(IN) :: cd_name
296      REAL(dp),         DIMENSION(:), INTENT(IN) :: dd_value
297
298      ! local value
299      INTEGER(i4)       :: il_len
300      CHARACTER(LEN=lc) :: cl_value
301
302      ! loop indices
303      INTEGER(i4) :: ji
304      !----------------------------------------------------------------
305
306      ! clean attribute
307      CALL att_clean(att__init_dp)
308
309      ! table size
310      il_len=size(dd_value(:))
311
312      cl_value="(/"
313      DO ji=1,il_len-1
314         cl_value=TRIM(cl_value)//TRIM(fct_str(dd_value(ji)))//","
315      ENDDO
316      cl_value=TRIM(cl_value)//TRIM(fct_str(dd_value(il_len)))//"/)"
317
318      CALL logger_info( &
319      &  " ATT INIT: attribute name: "//TRIM(ADJUSTL(cd_name))//&
320      &  " attribute value "//TRIM(ADJUSTL(cl_value)) )
321
322      att__init_dp%c_name=TRIM(ADJUSTL(cd_name))
323
324      att__init_dp%i_type=NF90_DOUBLE
325
326      IF( ASSOCIATED(att__init_dp%d_value) )THEN
327         DEALLOCATE(att__init_dp%d_value)
328      ENDIF
329      ALLOCATE(att__init_dp%d_value(il_len))
330
331      att__init_dp%d_value(:)=dd_value(:)
332      att__init_dp%i_len=il_len
333
334   END FUNCTION att__init_dp
335   !> @endcode
336   !-------------------------------------------------------------------
337   !> @brief This function initialise an attribute structure with
338   !> real(8) value
339   !>
340   !> @author J.Paul
341   !> - Nov, 2013- Initial Version
342   !
343   !> @param[in] cd_name : attribute name
344   !> @param[in] dd_value: attribute value
345   !> @return attribute structure
346   !-------------------------------------------------------------------
347   !> @code
348   TYPE(TATT) FUNCTION att__init_dp_0d( cd_name, dd_value )
349      IMPLICIT NONE
350      ! Argument
351      CHARACTER(LEN=*), INTENT(IN) :: cd_name
352      REAL(dp),         INTENT(IN) :: dd_value
353
354      ! local value
355      CHARACTER(LEN=lc) :: cl_value
356      !----------------------------------------------------------------
357
358      ! clean attribute
359      CALL att_clean(att__init_dp_0d)
360     
361      cl_value="(/"//TRIM(fct_str(dd_value))//"/)"
362
363      CALL logger_info( &
364      &  " ATT INIT: attribute name: "//TRIM(ADJUSTL(cd_name))//&
365      &  " attribute value "//TRIM(ADJUSTL(cl_value)) )
366
367      att__init_dp_0d%c_name=TRIM(ADJUSTL(cd_name))
368
369      att__init_dp_0d%i_type=NF90_DOUBLE
370
371      IF( ASSOCIATED(att__init_dp_0d%d_value) )THEN
372         DEALLOCATE(att__init_dp_0d%d_value)
373      ENDIF
374      ALLOCATE(att__init_dp_0d%d_value(1))
375
376      att__init_dp_0d%d_value(1)=dd_value
377      att__init_dp_0d%i_len=1
378
379   END FUNCTION att__init_dp_0d
380   !> @endcode
381   !-------------------------------------------------------------------
382   !> @brief This function initialise an attribute structure with table
383   !> of real(4) value
384   !>
385   !> @author J.Paul
386   !> - Nov, 2013- Initial Version
387   !
388   !> @param[in] cd_name : attribute name
389   !> @param[in] rd_value: attribute value
390   !> @return attribute structure
391   !-------------------------------------------------------------------
392   !> @code
393   TYPE(TATT) FUNCTION att__init_sp( cd_name, rd_value )
394      IMPLICIT NONE
395      ! Argument
396      CHARACTER(LEN=*),               INTENT(IN) :: cd_name
397      REAL(sp),         DIMENSION(:), INTENT(IN) :: rd_value
398
399      ! local value
400      INTEGER(i4)       :: il_len
401      CHARACTER(LEN=lc) :: cl_value
402
403      ! loop indices
404      INTEGER(i4) :: ji
405      !----------------------------------------------------------------
406
407      ! clean attribute
408      CALL att_clean(att__init_sp)
409     
410      ! table size
411      il_len=size(rd_value(:))
412
413      cl_value="(/"
414      DO ji=1,il_len-1
415         cl_value=TRIM(cl_value)//TRIM(fct_str(rd_value(ji)))//","
416      ENDDO
417      cl_value=TRIM(cl_value)//TRIM(fct_str(rd_value(il_len)))//"/)"
418
419      CALL logger_info( &
420      &  " ATT INIT: attribute name: "//TRIM(ADJUSTL(cd_name))//&
421      &  " attribute value "//TRIM(ADJUSTL(cl_value)) )     
422
423      att__init_sp%c_name=TRIM(ADJUSTL(cd_name))
424
425      att__init_sp%i_type=NF90_FLOAT
426
427      IF( ASSOCIATED(att__init_sp%d_value) )THEN
428         DEALLOCATE(att__init_sp%d_value)
429      ENDIF
430      ALLOCATE(att__init_sp%d_value(il_len))
431
432      att__init_sp%d_value(:)=REAL(rd_value(:),dp)
433      att__init_sp%i_len=il_len
434
435   END FUNCTION att__init_sp
436   !> @endcode
437   !-------------------------------------------------------------------
438   !> @brief This function initialise an attribute structure with
439   !> real(4) value
440   !>
441   !> @author J.Paul
442   !> - Nov, 2013- Initial Version
443   !
444   !> @param[in] cd_name : attribute name
445   !> @param[in] rd_value: attribute value
446   !> @return attribute structure
447   !-------------------------------------------------------------------
448   !> @code
449   TYPE(TATT) FUNCTION att__init_sp_0d( cd_name, rd_value )
450      IMPLICIT NONE
451      ! Argument
452      CHARACTER(LEN=*), INTENT(IN) :: cd_name
453      REAL(sp),         INTENT(IN) :: rd_value
454
455      ! local value
456      CHARACTER(LEN=lc) :: cl_value
457      !----------------------------------------------------------------
458
459      ! clean attribute
460      CALL att_clean(att__init_sp_0d)
461     
462      cl_value="(/"//TRIM(fct_str(rd_value))//"/)"
463
464      CALL logger_info( &
465      &  " ATT INIT: attribute name: "//TRIM(ADJUSTL(cd_name))//&
466      &  " attribute value "//TRIM(ADJUSTL(cl_value)) )     
467
468      att__init_sp_0d%c_name=TRIM(ADJUSTL(cd_name))
469
470      att__init_sp_0d%i_type=NF90_FLOAT
471
472      IF( ASSOCIATED(att__init_sp_0d%d_value) )THEN
473         DEALLOCATE(att__init_sp_0d%d_value)
474      ENDIF
475      ALLOCATE(att__init_sp_0d%d_value(1))
476
477      att__init_sp_0d%d_value(1)=REAL(rd_value,dp)
478      att__init_sp_0d%i_len=1
479
480   END FUNCTION att__init_sp_0d
481   !> @endcode
482   !-------------------------------------------------------------------
483   !> @brief This function initialise an attribute structure with table
484   !> of integer(1) value
485   !>
486   !> @author J.Paul
487   !> - Nov, 2013- Initial Version
488   !
489   !> @param[in] cd_name : attribute name
490   !> @param[in] bd_value: attribute value
491   !> @return attribute structure
492   !-------------------------------------------------------------------
493   !> @code
494   TYPE(TATT) FUNCTION att__init_i1( cd_name, bd_value )
495      IMPLICIT NONE
496      ! Argument
497      CHARACTER(LEN=*),               INTENT(IN) :: cd_name
498      INTEGER(i1),      DIMENSION(:), INTENT(IN) :: bd_value
499
500      ! local value
501      INTEGER(i4)       :: il_len
502      CHARACTER(LEN=lc) :: cl_value
503
504      ! loop indices
505      INTEGER(i4) :: ji
506      !----------------------------------------------------------------
507
508      ! clean attribute
509      CALL att_clean(att__init_i1)
510     
511      ! table size
512      il_len=size(bd_value(:))
513
514      cl_value="(/"
515      DO ji=1,il_len-1
516         cl_value=TRIM(cl_value)//TRIM(fct_str(bd_value(ji)))//","
517      ENDDO
518      cl_value=TRIM(cl_value)//TRIM(fct_str(bd_value(il_len)))//"/)"
519
520      CALL logger_info( &
521      &  " ATT INIT: attribute name: "//TRIM(ADJUSTL(cd_name))//&
522      &  " attribute value "//TRIM(ADJUSTL(cl_value)) )     
523
524      att__init_i1%c_name=TRIM(ADJUSTL(cd_name))
525
526      att__init_i1%i_type=NF90_BYTE
527
528      IF( ASSOCIATED(att__init_i1%d_value) )THEN
529         DEALLOCATE(att__init_i1%d_value)
530      ENDIF
531      ALLOCATE(att__init_i1%d_value(il_len))
532
533      att__init_i1%d_value(:)=REAL(bd_value(:),dp)
534      att__init_i1%i_len=il_len
535
536   END FUNCTION att__init_i1
537   !> @endcode
538   !-------------------------------------------------------------------
539   !> @brief This function initialise an attribute structure with
540   !> integer(1) value
541   !>
542   !> @author J.Paul
543   !> - Nov, 2013- Initial Version
544   !
545   !> @param[in] cd_name : attribute name
546   !> @param[in] bd_value: attribute value
547   !> @return attribute structure
548   !-------------------------------------------------------------------
549   !> @code
550   TYPE(TATT) FUNCTION att__init_i1_0d( cd_name, bd_value )
551      IMPLICIT NONE
552      ! Argument
553      CHARACTER(LEN=*), INTENT(IN) :: cd_name
554      INTEGER(i1),      INTENT(IN) :: bd_value
555
556      !local value
557      CHARACTER(LEN=lc) :: cl_value
558      !----------------------------------------------------------------
559
560      ! clean attribute
561      CALL att_clean(att__init_i1_0d)
562     
563      cl_value="(/"//TRIM(fct_str(bd_value))//"/)"
564
565      CALL logger_info( &
566      &  " ATT INIT: attribute name: "//TRIM(ADJUSTL(cd_name))//&
567      &  " attibute value "//TRIM(ADJUSTL(cl_value)) )     
568
569      att__init_i1_0d%c_name=TRIM(ADJUSTL(cd_name))
570
571      att__init_i1_0d%i_type=NF90_BYTE
572
573      IF( ASSOCIATED(att__init_i1_0d%d_value) )THEN
574         DEALLOCATE(att__init_i1_0d%d_value)
575      ENDIF
576      ALLOCATE(att__init_i1_0d%d_value(1))
577
578      att__init_i1_0d%d_value(1)=REAL(bd_value,dp)
579      att__init_i1_0d%i_len=1
580
581   END FUNCTION att__init_i1_0d
582   !> @endcode
583   !-------------------------------------------------------------------
584   !> @brief This function initialise an attribute structure with table
585   !> of integer(2) value
586   !>
587   !> @author J.Paul
588   !> - Nov, 2013- Initial Version
589   !
590   !> @param[in] cd_name : attribute name
591   !> @param[in] sd_value: attribute value
592   !> @return attribute structure
593   !-------------------------------------------------------------------
594   !> @code
595   TYPE(TATT) FUNCTION att__init_i2( cd_name, sd_value )
596      IMPLICIT NONE
597      ! Argument
598      CHARACTER(LEN=*),               INTENT(IN) :: cd_name
599      INTEGER(i2),      DIMENSION(:), INTENT(IN) :: sd_value
600
601      ! local value
602      INTEGER(i4)       :: il_len
603      CHARACTER(LEN=lc) :: cl_value
604
605      ! loop indices
606      INTEGER(i4) :: ji
607      !----------------------------------------------------------------
608
609      ! clean attribute
610      CALL att_clean(att__init_i2)
611     
612      ! table size
613      il_len=size(sd_value(:))
614
615      cl_value="(/"
616      DO ji=1,il_len-1
617         cl_value=TRIM(cl_value)//TRIM(fct_str(sd_value(ji)))//","
618      ENDDO
619      cl_value=TRIM(cl_value)//TRIM(fct_str(sd_value(il_len)))//"/)"
620
621      CALL logger_info( &
622      &  " ATT INIT: attribute name: "//TRIM(ADJUSTL(cd_name))//&
623      &  " attribute value "//TRIM(ADJUSTL(cl_value)) )     
624
625      att__init_i2%c_name=TRIM(ADJUSTL(cd_name))
626
627      att__init_i2%i_type=NF90_SHORT
628
629      IF( ASSOCIATED(att__init_i2%d_value) )THEN
630         DEALLOCATE(att__init_i2%d_value)
631      ENDIF
632      ALLOCATE(att__init_i2%d_value(il_len))
633
634      att__init_i2%d_value(:)=REAL(sd_value(:),dp)
635      att__init_i2%i_len=il_len
636
637   END FUNCTION att__init_i2
638   !> @endcode
639   !-------------------------------------------------------------------
640   !> @brief This function initialise an attribute structure with
641   !> integer(2) value
642   !>
643   !> @author J.Paul
644   !> - Nov, 2013- Initial Version
645   !
646   !> @param[in] cd_name : attribute name
647   !> @param[in] sd_value: attribute value
648   !> @return attribute structure
649   !-------------------------------------------------------------------
650   !> @code
651   TYPE(TATT) FUNCTION att__init_i2_0d( cd_name, sd_value )
652      IMPLICIT NONE
653      ! Argument
654      CHARACTER(LEN=*), INTENT(IN) :: cd_name
655      INTEGER(i2),      INTENT(IN) :: sd_value
656
657      !local value
658      CHARACTER(LEN=lc) :: cl_value
659      !----------------------------------------------------------------
660
661      ! clean attribute
662      CALL att_clean(att__init_i2_0d)
663     
664      cl_value="(/"//TRIM(fct_str(sd_value))//"/)"
665
666      CALL logger_info( &
667      &  " ATT INIT: attribute name: "//TRIM(ADJUSTL(cd_name))//&
668      &  " attibute value "//TRIM(ADJUSTL(cl_value)) )     
669
670      att__init_i2_0d%c_name=TRIM(ADJUSTL(cd_name))
671
672      att__init_i2_0d%i_type=NF90_SHORT
673
674      IF( ASSOCIATED(att__init_i2_0d%d_value) )THEN
675         DEALLOCATE(att__init_i2_0d%d_value)
676      ENDIF
677      ALLOCATE(att__init_i2_0d%d_value(1))
678
679      att__init_i2_0d%d_value(1)=REAL(sd_value,dp)
680      att__init_i2_0d%i_len=1
681
682   END FUNCTION att__init_i2_0d
683   !> @endcode
684   !-------------------------------------------------------------------
685   !> @brief This function initialise an attribute structure with table
686   !> of integer(4) value
687   !>
688   !> @author J.Paul
689   !> - Nov, 2013- Initial Version
690   !
691   !> @param[in] cd_name : attribute name
692   !> @param[in] id_value: attribute value
693   !> @return attribute structure
694   !-------------------------------------------------------------------
695   !> @code
696   TYPE(TATT) FUNCTION att__init_i4( cd_name, id_value )
697      IMPLICIT NONE
698      ! Argument
699      CHARACTER(LEN=*),               INTENT(IN) :: cd_name
700      INTEGER(i4),      DIMENSION(:), INTENT(IN) :: id_value
701
702      ! local value
703      INTEGER(i4)       :: il_len
704      CHARACTER(LEN=lc) :: cl_value
705
706      ! loop indices
707      INTEGER(i4) :: ji
708      !----------------------------------------------------------------
709
710      ! clean attribute
711      CALL att_clean(att__init_i4)
712     
713      ! table size
714      il_len=size(id_value(:))
715
716      cl_value="(/"
717      DO ji=1,il_len-1
718         cl_value=TRIM(cl_value)//TRIM(fct_str(id_value(ji)))//","
719      ENDDO
720      cl_value=TRIM(cl_value)//TRIM(fct_str(id_value(il_len)))//"/)"
721
722      CALL logger_info( &
723      &  " ATT INIT: attribute name: "//TRIM(ADJUSTL(cd_name))//&
724      &  " attribute value "//TRIM(ADJUSTL(cl_value)) )     
725
726      att__init_i4%c_name=TRIM(ADJUSTL(cd_name))
727
728      att__init_i4%i_type=NF90_INT
729
730      IF( ASSOCIATED(att__init_i4%d_value) )THEN
731         DEALLOCATE(att__init_i4%d_value)
732      ENDIF
733      ALLOCATE(att__init_i4%d_value(il_len))
734
735      att__init_i4%d_value(:)=REAL(id_value(:),dp)
736      att__init_i4%i_len=il_len
737
738   END FUNCTION att__init_i4
739   !> @endcode
740   !-------------------------------------------------------------------
741   !> @brief This function initialise an attribute structure with
742   !> integer(4) value
743   !>
744   !> @author J.Paul
745   !> - Nov, 2013- Initial Version
746   !
747   !> @param[in] cd_name : attribute name
748   !> @param[in] id_value: attribute value
749   !> @return attribute structure
750   !-------------------------------------------------------------------
751   !> @code
752   TYPE(TATT) FUNCTION att__init_i4_0d( cd_name, id_value )
753      IMPLICIT NONE
754      ! Argument
755      CHARACTER(LEN=*), INTENT(IN) :: cd_name
756      INTEGER(i4),      INTENT(IN) :: id_value
757
758      !local value
759      CHARACTER(LEN=lc) :: cl_value
760      !----------------------------------------------------------------
761
762      ! clean attribute
763      CALL att_clean(att__init_i4_0d)
764     
765      cl_value="(/"//TRIM(fct_str(id_value))//"/)"
766
767      CALL logger_info( &
768      &  " ATT INIT: attribute name: "//TRIM(ADJUSTL(cd_name))//&
769      &  " attibute value "//TRIM(ADJUSTL(cl_value)) )     
770
771      att__init_i4_0d%c_name=TRIM(ADJUSTL(cd_name))
772
773      att__init_i4_0d%i_type=NF90_INT
774
775      IF( ASSOCIATED(att__init_i4_0d%d_value) )THEN
776         DEALLOCATE(att__init_i4_0d%d_value)
777      ENDIF
778      ALLOCATE(att__init_i4_0d%d_value(1))
779
780      att__init_i4_0d%d_value(1)=REAL(id_value,dp)
781      att__init_i4_0d%i_len=1
782
783   END FUNCTION att__init_i4_0d
784   !> @endcode
785   !-------------------------------------------------------------------
786   !> @brief This function initialise an attribute structure with table
787   !> of integer(8) value
788   !>
789   !> @author J.Paul
790   !> - Nov, 2013- Initial Version
791   !
792   !> @param[in] cd_name : attribute name
793   !> @param[in] kd_value: attribute value
794   !> @return attribute structure
795   !-------------------------------------------------------------------
796   !> @code
797   TYPE(TATT) FUNCTION att__init_i8( cd_name, kd_value )
798      IMPLICIT NONE
799      ! Argument
800      CHARACTER(LEN=*),               INTENT(IN) :: cd_name
801      INTEGER(i8),      DIMENSION(:), INTENT(IN) :: kd_value
802
803      ! local value
804      INTEGER(i4)       :: il_len
805      CHARACTER(LEN=lc) :: cl_value
806
807      ! loop indices
808      INTEGER(i4) :: ji
809      !----------------------------------------------------------------
810
811      ! clean attribute
812      CALL att_clean(att__init_i8)
813     
814      ! table size
815      il_len=size(kd_value(:))
816
817      cl_value="(/"
818      DO ji=1,il_len
819         cl_value=TRIM(cl_value)//TRIM(fct_str(kd_value(ji)))//","
820      ENDDO
821      cl_value=TRIM(cl_value)//TRIM(fct_str(kd_value(il_len)))//"/)"
822
823      CALL logger_info( &
824      &  " ATT INIT: attribute name: "//TRIM(ADJUSTL(cd_name))//&
825      &  " attibute value "//TRIM(ADJUSTL(cl_value)) )     
826
827      att__init_i8%c_name=TRIM(ADJUSTL(cd_name))
828
829      att__init_i8%i_type=NF90_INT
830
831      IF( ASSOCIATED(att__init_i8%d_value) )THEN
832         DEALLOCATE(att__init_i8%d_value)
833      ENDIF
834      ALLOCATE(att__init_i8%d_value(il_len))
835
836      att__init_i8%d_value(:)=REAL(kd_value(:),dp)
837      att__init_i8%i_len=il_len
838
839   END FUNCTION att__init_i8
840   !> @endcode
841   !-------------------------------------------------------------------
842   !> @brief This function initialise an attribute structure with
843   !> integer(8) value
844   !>
845   !> @author J.Paul
846   !> - Nov, 2013- Initial Version
847   !
848   !> @param[in] cd_name : attribute name
849   !> @param[in] kd_value: attribute value
850   !> @return attribute structure
851   !-------------------------------------------------------------------
852   !> @code
853   TYPE(TATT) FUNCTION att__init_i8_0d( cd_name, kd_value )
854      IMPLICIT NONE
855      ! Argument
856      CHARACTER(LEN=*), INTENT(IN) :: cd_name
857      INTEGER(i8),      INTENT(IN) :: kd_value
858
859      ! local value
860      CHARACTER(LEN=lc) :: cl_value
861      !----------------------------------------------------------------
862
863      ! clean attribute
864      CALL att_clean(att__init_i8_0d)
865     
866      cl_value="(/"//TRIM(fct_str(kd_value))//"/)"
867
868      CALL logger_info( &
869      &  " ATT INIT: attribute name: "//TRIM(ADJUSTL(cd_name))//&
870      &  " attibute value "//TRIM(ADJUSTL(cl_value)) )     
871
872      att__init_i8_0d%c_name=TRIM(ADJUSTL(cd_name))
873
874      att__init_i8_0d%i_type=NF90_INT
875
876      IF( ASSOCIATED(att__init_i8_0d%d_value) )THEN
877         DEALLOCATE(att__init_i8_0d%d_value)
878      ENDIF
879      ALLOCATE(att__init_i8_0d%d_value(1))
880
881      att__init_i8_0d%d_value(1)=REAL(kd_value,dp)
882      att__init_i8_0d%i_len=1
883
884   END FUNCTION att__init_i8_0d
885   !> @endcode   
886   !-------------------------------------------------------------------
887   !> @brief This subroutine print attribute information
888   !>
889   !> @author J.Paul
890   !> - Nov, 2013- Initial Version
891   !
892   !> @param[in] td_att : attribute structure
893   !-------------------------------------------------------------------
894   !> @code
895   SUBROUTINE att_print(td_att)
896      IMPLICIT NONE
897
898      ! Argument     
899      TYPE(TATT), INTENT(IN) :: td_att
900
901      ! local vairbale
902      CHARACTER(LEN=lc) :: cl_type
903      CHARACTER(LEN=lc) :: cl_value
904      CHARACTER(LEN=lc) :: cl_tmp
905
906      ! loop indices
907      INTEGER(i4) :: ji
908      !----------------------------------------------------------------
909
910         SELECT CASE( td_att%i_type )
911
912            CASE(NF90_CHAR)
913               cl_type='CHAR'
914            CASE(NF90_BYTE)
915               cl_type='BYTE'
916            CASE(NF90_SHORT)
917               cl_type='SHORT'
918            CASE(NF90_INT)
919               cl_type='INT'
920            CASE(NF90_FLOAT)
921               cl_type='FLOAT'
922            CASE(NF90_DOUBLE)
923               cl_type='DOUBLE'
924            CASE DEFAULT
925               cl_type=''
926               !cl_type='unknown'
927         END SELECT
928
929         SELECT CASE( td_att%i_type )
930
931            CASE(NF90_CHAR)
932               cl_value=td_att%c_value
933
934            CASE(NF90_BYTE, NF90_SHORT, NF90_INT, NF90_FLOAT, NF90_DOUBLE)   
935               IF( td_att%i_len > 1 )THEN
936
937                  cl_tmp=','
938                  cl_value='(/'
939                  DO ji=1,td_att%i_len-1
940                     cl_value=TRIM(cl_value)//&
941                     &        TRIM(fct_str(td_att%d_value(ji)))//TRIM(cl_tmp)
942                  ENDDO
943                  cl_value=TRIM(cl_value)//&
944                  &        TRIM(fct_str(td_att%d_value(td_att%i_len)))//'/)'
945
946               ELSE
947
948                  cl_value='(/'//TRIM(fct_str(td_att%d_value(1)))//'/)'
949
950               ENDIF
951            CASE DEFAULT
952               cl_value="none"
953
954         END SELECT
955
956         WRITE(*,'((3x,a,a),(/6x,a,i2.2),(a,a),(a,a))')&
957         &        " attribute : ",TRIM(ADJUSTL(td_att%c_name)),      &
958         &        " id : ",td_att%i_id,                         &
959         &        " type : ",TRIM(ADJUSTL(cl_type)),            &
960         &        " value : ",TRIM(ADJUSTL(cl_value))
961
962   END SUBROUTINE att_print
963   !> @endcode
964   !-------------------------------------------------------------------
965   !> @brief
966   !>  This subroutine clean attribute strcuture.
967   !
968   !> @author J.Paul
969   !> @date Nov, 2013
970   !
971   !> @param[inout] td_att : attribute strcuture
972   !-------------------------------------------------------------------
973   !> @code
974   SUBROUTINE att_clean( td_att )
975      IMPLICIT NONE
976      ! Argument
977      TYPE(TATT),  INTENT(INOUT) :: td_att
978
979      ! local variable
980      TYPE(TATT) :: tl_att ! empty attribute structure
981      !----------------------------------------------------------------
982
983      CALL logger_info( &
984      &  " CLEAN: reset attribute "//TRIM(td_att%c_name) )
985
986      IF( ASSOCIATED(td_att%d_value) )THEN
987         ! clean value
988         DEALLOCATE(td_att%d_value)
989      ENDIF
990
991      ! replace by empty structure
992      td_att=tl_att
993
994   END SUBROUTINE att_clean
995   !> @endcode
996END MODULE att
997
Note: See TracBrowser for help on using the repository browser.