Context Navigation

attribute.f90 @ 13378

Last change on this file since 13378 was 13369, checked in by jpaul, 4 years ago
update: cf changelog inside documentation
File size: 48.1 KB

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

Note: See TracBrowser for help on using the repository browser.

New URL for NEMO forge! http://forge.nemo-ocean.eu

Context Navigation

source: utils/tools/SIREN/src/attribute.f90 @ 13378

Download in other formats: