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.

file.f90 in utils/tools/SIREN/src – NEMO

Context Navigation

source: utils/tools/SIREN/src/file.f90 @ 12080

Last change on this file since 12080 was 12080, checked in by jpaul, 4 years ago
update nemo trunk
File size: 76.8 KB

Rev	Line
[4213]	1	!----------------------------------------------------------------------
	2	! NEMO system team, System and Interface for oceanic RElocable Nesting
	3	!----------------------------------------------------------------------
	4	!
	5	!> @brief
	6	!> This module manage file structure.
[5037]	7	!>
[4213]	8	!> @details
	9	!> define type TFILE:<br/>
[5037]	10	!> @code
	11	!> TYPE(TFILE) :: tl_file
	12	!> @endcode
[4213]	13	!>
[5037]	14	!> to initialize a file structure:<br/>
	15	!> @code
	16	!> tl_file=file_init(cd_file [,cd_type] [,ld_wrt] [,cd_grid])
	17	!% tl_file=file_init(cd_file [,cd_type] [,ld_wrt] [,id_ew] [,id_perio] [,id_pivot] [,cd_grid])
	18	!> @endcode
[4213]	19	!> - cd_file is the file name
[5037]	20	!> - cd_type is the type of the file ('cdf', 'dimg') [optional]
	21	!> - ld_wrt file in write mode or not [optional]
	22	!% - id_ew is the number of point for east-west overlap [optional]
	23	!% - id_perio is the NEMO periodicity index [optional]
	24	!% - id_pivot is the NEMO pivot point index F(0),T(1) [optional]
	25	!> - cd_grid is the grid type (default 'ARAKAWA-C')
[4213]	26	!>
	27	!> to get file name:<br/>
	28	!> - tl_file\%c_name
	29	!>
	30	!> to get file id (units):<br/>
	31	!> - tl_file\%i_id
	32	!>
	33	!> to get the type of the file (cdf, cdf4, dimg):<br/>
	34	!> - tl_file\%c_type
	35	!>
	36	!> to know if file was open in write mode:<br/>
	37	!> - tl_file\%l_wrt
	38	!>
	39	!> to get the record length of the file:<br/>
	40	!> - tl_file\%i_recl
	41	!>
	42	!> Files variables<br/>
	43	!> to get the number of variable in the file:<br/>
	44	!> - tl_file\%i_nvar
	45	!>
[5037]	46	!> to get the array of variable structure associated to the file:<br/>
[4213]	47	!> - tl_file\%t_var(:)
	48	!>
	49	!> Files attributes<br/>
	50	!> to get the nmber of global attributes of the file:<br/>
	51	!> - tl_file\%i_natt
	52	!>
[5037]	53	!> to get the array of attributes structure associated to the file:<br/>
[4213]	54	!> - tl_file\%t_att(:)
	55	!>
	56	!> Files dimensions<br/>
	57	!> to get the number of dimension used in the file:<br/>
	58	!> - tl_file\%i_ndim
	59	!>
[5037]	60	!> to get the array of dimension structure (4 elts) associated to the
[4213]	61	!> file:<br/>
	62	!> - tl_file\%t_dim(:)
	63	!>
	64	!> to print information about file structure:<br/>
[5037]	65	!> @code
[4213]	66	!> CALL file_print(td_file)
[5037]	67	!> @endcode
[4213]	68	!>
[5037]	69	!> to clean file structure:<br/>
	70	!> @code
	71	!> CALL file_clean(td_file)
	72	!> @endcode
	73	!>
[4213]	74	!> to add a global attribute structure in file structure:<br/>
[5037]	75	!> @code
[4213]	76	!> CALL file_add_att(td_file, td_att)
[5037]	77	!> @endcode
[4213]	78	!> - td_att is an attribute structure
	79	!>
	80	!> to add a dimension structure in file structure:<br/>
[5037]	81	!> @code
[4213]	82	!> CALL file_add_dim(td_file, td_dim)
[5037]	83	!> @endcode
[4213]	84	!> - td_dim is a dimension structure
	85	!>
	86	!> to add a variable structure in file structure:<br/>
[5037]	87	!> @code
[4213]	88	!> CALL file_add_var(td_file, td_var)
[5037]	89	!> @endcode
[4213]	90	!> - td_var is a variable structure
	91	!>
	92	!> to delete a global attribute structure in file structure:<br/>
[5037]	93	!> @code
[4213]	94	!> CALL file_del_att(td_file, td_att)
[5037]	95	!> @endcode
[4213]	96	!> - td_att is an attribute structure
	97	!>
	98	!> to delete a dimension structure in file structure:<br/>
[5037]	99	!> @code
[4213]	100	!> CALL file_del_dim(td_file, td_dim)
[5037]	101	!> @endcode
[4213]	102	!> - td_dim is a dimension structure
	103	!>
	104	!> to delete a variable structure in file structure:<br/>
[5037]	105	!> @code
[4213]	106	!> CALL file_del_var(td_file, td_var)
[5037]	107	!> @endcode
[4213]	108	!> - td_var is a variable structure
	109	!>
	110	!> to overwrite one attribute structure in file structure:<br/>
[5037]	111	!> @code
[4213]	112	!> CALL file_move_att(td_file, td_att)
[5037]	113	!> @endcode
[4213]	114	!> - td_att is an attribute structure
	115	!>
	116	!> to overwrite one dimension strucutre in file structure:<br/>
[5037]	117	!> @code
[4213]	118	!> CALL file_move_dim(td_file, td_dim)
[5037]	119	!> @endcode
[4213]	120	!> - td_dim is a dimension structure
	121	!>
	122	!> to overwrite one variable structure in file structure:<br/>
[5037]	123	!> @code
[4213]	124	!> CALL file_move_var(td_file, td_var)
[5037]	125	!> @endcode
[4213]	126	!> - td_var is a variable structure
	127	!>
	128	!> to check if file and variable structure share same dimension:<br/>
[5037]	129	!> @code
[4213]	130	!> ll_check_dim = file_check_var_dim(td_file, td_var)
[5037]	131	!> @endcode
[4213]	132	!> - td_var is a variable structure
	133	!>
	134	!> @author
	135	!> J.Paul
[12080]	136	!>
[5609]	137	!> @date November, 2013 - Initial Version
	138	!> @date November, 2014
	139	!> - Fix memory leaks bug
[4213]	140	!>
[12080]	141	!> @note Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
[4213]	142	!----------------------------------------------------------------------
	143	MODULE file
[12080]	144
[4213]	145	USE kind ! F90 kind parameter
	146	USE global ! global variable
	147	USE fct ! basic useful function
[5037]	148	USE logger ! log file manager
[4213]	149	USE dim ! dimension manager
	150	USE att ! attribute manager
	151	USE var ! variable manager
[12080]	152
[4213]	153	IMPLICIT NONE
	154	! NOTE_avoid_public_variables_if_possible
	155
	156	! type and variable
[5037]	157	PUBLIC :: TFILE !< file structure
[4213]	158
	159	! function and subroutine
[5037]	160	PUBLIC :: file_copy !< copy file structure
	161	PUBLIC :: file_print !< print information about file structure
	162	PUBLIC :: file_clean !< clean file structure
	163	PUBLIC :: file_init !< initialize file structure
	164	PUBLIC :: file_add_att !< add one attribute structure in file structure
	165	PUBLIC :: file_add_var !< add one variable structure in file structure
	166	PUBLIC :: file_add_dim !< add one dimension strucutre in file structure
	167	PUBLIC :: file_del_att !< delete one attribute structure of file structure
	168	PUBLIC :: file_del_var !< delete one variable structure of file structure
	169	PUBLIC :: file_del_dim !< delete one dimension strucutre of file structure
	170	PUBLIC :: file_move_att !< overwrite one attribute structure in file structure
	171	PUBLIC :: file_move_var !< overwrite one variable structure in file structure
	172	PUBLIC :: file_move_dim !< overwrite one dimension strucutre in file structure
[4213]	173	PUBLIC :: file_check_var_dim !< check if file and variable structure use same dimension.
[5037]	174	PUBLIC :: file_get_type !< get type of file
	175	PUBLIC :: file_get_id !< get file id
	176	PUBLIC :: file_rename !< rename file name
	177	PUBLIC :: file_add_suffix !< add suffix to file name
[4213]	178
[5037]	179	PRIVATE :: file__clean_unit ! clean file structure
	180	PRIVATE :: file__clean_arr ! clean array of file structure
	181	PRIVATE :: file__del_var_name ! delete a variable structure in file structure, given variable name or standard name
	182	PRIVATE :: file__del_var_str ! delete a variable structure in file structure, given variable structure
	183	PRIVATE :: file__del_att_name ! delete a attribute structure in file structure, given attribute name
	184	PRIVATE :: file__del_att_str ! delete a attribute structure in file structure, given attribute structure
	185	PRIVATE :: file__get_number ! get number in file name without suffix
	186	PRIVATE :: file__get_suffix ! get suffix of file name
	187	PRIVATE :: file__copy_unit ! copy file structure
	188	PRIVATE :: file__copy_arr ! copy array of file structure
	189	PRIVATE :: file__rename_char ! rename file name, given processor number.
	190	PRIVATE :: file__rename_str ! rename file name, given file structure.
[4213]	191
[5037]	192	TYPE TFILE !< file structure
[4213]	193
	194	! general
[5037]	195	CHARACTER(LEN=lc) :: c_name = "" !< file name
	196	CHARACTER(LEN=lc) :: c_type = "" !< type of the file (cdf, cdf4, dimg)
	197	INTEGER(i4) :: i_id = 0 !< file id
	198	LOGICAL :: l_wrt = .FALSE. !< read or write mode
	199	INTEGER(i4) :: i_nvar = 0 !< number of variable
	200	TYPE(TVAR), DIMENSION(:), POINTER :: t_var => NULL() !< file variables
[4213]	201
	202	CHARACTER(LEN=lc) :: c_grid = 'ARAKAWA-C' !< grid type
	203
[5037]	204	INTEGER(i4) :: i_ew =-1 !< east-west overlap
	205	INTEGER(i4) :: i_perio =-1 !< NEMO periodicity index
	206	INTEGER(i4) :: i_pivot =-1 !< NEMO pivot point index F(0),T(1)
[4213]	207
[5037]	208	INTEGER(i4) :: i_depthid = 0 !< variable id of depth
	209	INTEGER(i4) :: i_timeid = 0 !< variable id of time
[4213]	210
	211	! netcdf file
[5037]	212	INTEGER(i4) :: i_ndim = 0 !< number of dimensions used in the file
	213	INTEGER(i4) :: i_natt = 0 !< number of global attributes in the file
	214	INTEGER(i4) :: i_uldid = 0 !< id of the unlimited dimension in the file
	215	LOGICAL :: l_def = .FALSE. !< define mode or not
	216	TYPE(TATT), DIMENSION(:), POINTER :: t_att => NULL() !< global attributes
	217	TYPE(TDIM), DIMENSION(ip_maxdim) :: t_dim !< dimension structure
[4213]	218
	219	! dimg file
[5037]	220	INTEGER(i4) :: i_recl = 0 !< record length (binary file)
	221	INTEGER(i4) :: i_n0d = 0 !< number of scalar variable
	222	INTEGER(i4) :: i_n1d = 0 !< number of 1D variable
	223	INTEGER(i4) :: i_n2d = 0 !< number of 2D variable
	224	INTEGER(i4) :: i_n3d = 0 !< number of 3D variable
	225	INTEGER(i4) :: i_rhd = 0 !< record of the header infos (last record)
[4213]	226
	227	! mpp
	228	! only use for massively parallel processing
[5037]	229	INTEGER(i4) :: i_pid = -1 !< processor id (start to 1)
	230	INTEGER(i4) :: i_impp = 0 !< i-indexes for mpp-subdomain left bottom
	231	INTEGER(i4) :: i_jmpp = 0 !< j-indexes for mpp-subdomain left bottom
	232	INTEGER(i4) :: i_lci = 0 !< i-dimensions of subdomain
	233	INTEGER(i4) :: i_lcj = 0 !< j-dimensions of subdomain
	234	INTEGER(i4) :: i_ldi = 0 !< first indoor i-indices
	235	INTEGER(i4) :: i_ldj = 0 !< first indoor j-indices
	236	INTEGER(i4) :: i_lei = 0 !< last indoor i-indices
	237	INTEGER(i4) :: i_lej = 0 !< last indoor j-indices
[4213]	238
[5037]	239	LOGICAL :: l_ctr = .FALSE. !< domain is on border
	240	LOGICAL :: l_use = .FALSE. !< domain is used
[4213]	241
[5037]	242	! only use to draw domain decomposition when initialize with mpp_init
	243	INTEGER(i4) :: i_iind = 0 !< i-direction indices
	244	INTEGER(i4) :: i_jind = 0 !< j-direction indices
[4213]	245
	246	END TYPE TFILE
	247
[5037]	248	INTERFACE file_clean
	249	MODULE PROCEDURE file__clean_unit
	250	MODULE PROCEDURE file__clean_arr
	251	END INTERFACE file_clean
	252
[4213]	253	INTERFACE file_del_var
	254	MODULE PROCEDURE file__del_var_name
	255	MODULE PROCEDURE file__del_var_str
	256	END INTERFACE file_del_var
	257
	258	INTERFACE file_del_att
	259	MODULE PROCEDURE file__del_att_name
	260	MODULE PROCEDURE file__del_att_str
	261	END INTERFACE file_del_att
	262
	263	INTERFACE file_rename
	264	MODULE PROCEDURE file__rename_char
	265	MODULE PROCEDURE file__rename_str
	266	END INTERFACE file_rename
	267
[5037]	268	INTERFACE file_copy
	269	MODULE PROCEDURE file__copy_unit
	270	MODULE PROCEDURE file__copy_arr
[4213]	271	END INTERFACE
	272
	273	CONTAINS
[12080]	274	!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
	275	FUNCTION file__copy_unit(td_file) &
	276	& RESULT (tf_file)
[4213]	277	!-------------------------------------------------------------------
	278	!> @brief
[5037]	279	!> This subroutine copy file structure in another one
[4213]	280	!> @details
[5037]	281	!> file variable and attribute value are copied in a temporary array,
[4213]	282	!> so input and output file structure value do not point on the same
	283	!> "memory cell", and so on are independant.
	284	!>
	285	!> @note new file is assume to be closed.
	286	!>
[5037]	287	!> @warning do not use on the output of a function who create or read an
	288	!> structure (ex: tl_file=file_copy(file_init()) is forbidden).
	289	!> This will create memory leaks.
[4213]	290	!> @warning to avoid infinite loop, do not use any function inside
	291	!> this subroutine
	292	!>
	293	!> @author J.Paul
[5609]	294	!> @date November, 2013 - Initial Version
[5037]	295	!> @date November, 2014
[5609]	296	!> - use function instead of overload assignment operator
[5037]	297	!> (to avoid memory leak)
[12080]	298	!> @date January, 2019
	299	!> - clean variable structure
	300	!>
[5037]	301	!> @param[in] td_file file structure
	302	!> @return copy of input file structure
[4213]	303	!-------------------------------------------------------------------
[12080]	304
[4213]	305	IMPLICIT NONE
[12080]	306
[4213]	307	! Argument
[5037]	308	TYPE(TFILE), INTENT(IN) :: td_file
[12080]	309
[5037]	310	! function
[12080]	311	TYPE(TFILE) :: tf_file
[4213]	312
[5037]	313	! local variable
	314	TYPE(TVAR) :: tl_var
	315	TYPE(TATT) :: tl_att
	316
[4213]	317	! loop indices
	318	INTEGER(i4) :: ji
	319	!----------------------------------------------------------------
	320
[5037]	321	CALL logger_trace("FILE COPY: file "//TRIM(td_file%c_name) )
[4213]	322
	323	! copy file variable
[12080]	324	tf_file%c_name = TRIM(td_file%c_name)
	325	tf_file%c_type = TRIM(td_file%c_type)
[4213]	326	! file1 should be closed even if file2 is opened right now
[12080]	327	tf_file%i_id = 0
	328	tf_file%l_wrt = td_file%l_wrt
	329	tf_file%i_nvar = td_file%i_nvar
[4213]	330
[12080]	331	tf_file%c_grid = td_file%c_grid
[4213]	332
[12080]	333	tf_file%i_ew = td_file%i_ew
	334	tf_file%i_perio= td_file%i_perio
	335	tf_file%i_pivot= td_file%i_pivot
[4213]	336
[12080]	337	tf_file%i_depthid = td_file%i_depthid
	338	tf_file%i_timeid = td_file%i_timeid
[5037]	339
[4213]	340	! copy variable structure
[12080]	341	IF( ASSOCIATED(tf_file%t_var) )THEN
	342	CALL var_clean(tf_file%t_var(:))
	343	DEALLOCATE(tf_file%t_var)
[5037]	344	ENDIF
[12080]	345	IF( ASSOCIATED(td_file%t_var) .AND. tf_file%i_nvar > 0 )THEN
	346	ALLOCATE( tf_file%t_var(tf_file%i_nvar) )
	347	DO ji=1,tf_file%i_nvar
[5037]	348	tl_var = var_copy(td_file%t_var(ji))
[12080]	349	tf_file%t_var(ji) = var_copy(tl_var)
	350	! clean
	351	CALL var_clean(tl_var)
[4213]	352	ENDDO
	353	ENDIF
	354
	355	! copy netcdf variable
[12080]	356	tf_file%i_ndim = td_file%i_ndim
	357	tf_file%i_natt = td_file%i_natt
	358	tf_file%i_uldid = td_file%i_uldid
	359	tf_file%l_def = td_file%l_def
[4213]	360
	361	! copy dimension
[12080]	362	tf_file%t_dim(:) = dim_copy(td_file%t_dim(:))
[4213]	363
	364	! copy attribute structure
[12080]	365	IF( ASSOCIATED(tf_file%t_att) )THEN
	366	CALL att_clean(tf_file%t_att(:))
	367	DEALLOCATE(tf_file%t_att)
[5037]	368	ENDIF
[12080]	369	IF( ASSOCIATED(td_file%t_att) .AND. tf_file%i_natt > 0 )THEN
	370	ALLOCATE( tf_file%t_att(tf_file%i_natt) )
	371	DO ji=1,tf_file%i_natt
[5037]	372	tl_att = att_copy(td_file%t_att(ji))
[12080]	373	tf_file%t_att(ji) = att_copy(tl_att)
[4213]	374	ENDDO
	375	ENDIF
	376
[5037]	377	! clean
	378	CALL att_clean(tl_att)
	379
[4213]	380	! copy dimg variable
[12080]	381	tf_file%i_recl = td_file%i_recl
	382	tf_file%i_n0d = td_file%i_n0d
	383	tf_file%i_n1d = td_file%i_n1d
	384	tf_file%i_n2d = td_file%i_n2d
	385	tf_file%i_n3d = td_file%i_n3d
	386	tf_file%i_rhd = td_file%i_rhd
[4213]	387
	388	! copy mpp variable
[12080]	389	tf_file%i_pid = td_file%i_pid
	390	tf_file%i_impp = td_file%i_impp
	391	tf_file%i_jmpp = td_file%i_jmpp
	392	tf_file%i_lci = td_file%i_lci
	393	tf_file%i_lcj = td_file%i_lcj
	394	tf_file%i_ldi = td_file%i_ldi
	395	tf_file%i_ldj = td_file%i_ldj
	396	tf_file%i_lei = td_file%i_lei
	397	tf_file%i_lej = td_file%i_lej
	398	tf_file%l_ctr = td_file%l_ctr
	399	tf_file%l_use = td_file%l_use
	400	tf_file%i_iind = td_file%i_iind
	401	tf_file%i_jind = td_file%i_jind
[4213]	402
[5037]	403	END FUNCTION file__copy_unit
[12080]	404	!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
	405	FUNCTION file__copy_arr(td_file) &
	406	& RESULT (tf_file)
[4213]	407	!-------------------------------------------------------------------
	408	!> @brief
[5037]	409	!> This subroutine copy a array of file structure in another one
[4213]	410	!> @details
[5037]	411	!> file variable and attribute value are copied in a temporary array,
[4213]	412	!> so input and output file structure value do not point on the same
	413	!> "memory cell", and so on are independant.
	414	!>
	415	!> @note new file is assume to be closed.
	416	!>
[5037]	417	!> @warning do not use on the output of a function who create or read an
	418	!> structure (ex: tl_file=file_copy(file_init()) is forbidden).
	419	!> This will create memory leaks.
[4213]	420	!> @warning to avoid infinite loop, do not use any function inside
	421	!> this subroutine
	422	!>
	423	!> @author J.Paul
[5609]	424	!> @date November, 2013 - Initial Version
[5037]	425	!> @date November, 2014
[5609]	426	!> - use function instead of overload assignment operator
[5037]	427	!> (to avoid memory leak)
[12080]	428	!>
[5037]	429	!> @param[in] td_file file structure
	430	!> @return copy of input array of file structure
[4213]	431	!-------------------------------------------------------------------
[12080]	432
[4213]	433	IMPLICIT NONE
[12080]	434
[4213]	435	! Argument
[12080]	436	TYPE(TFILE), DIMENSION(:), INTENT(IN ) :: td_file
	437
[5037]	438	! function
[12080]	439	TYPE(TFILE), DIMENSION(SIZE(td_file(:))) :: tf_file
[4213]	440
	441	! loop indices
	442	INTEGER(i4) :: ji
	443	!----------------------------------------------------------------
	444
[5037]	445	DO ji=1,SIZE(td_file(:))
[12080]	446	tf_file(ji)=file_copy(td_file(ji))
[4213]	447	ENDDO
	448
[5037]	449	END FUNCTION file__copy_arr
[12080]	450	!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
	451	FUNCTION file_init(cd_file, cd_type, ld_wrt, &
	452	& id_ew, id_perio, id_pivot,&
	453	& cd_grid) &
	454	& RESULT (tf_file)
[4213]	455	!-------------------------------------------------------------------
[5037]	456	!> @brief This function initialize file structure.<br/>
	457	!> @details
[4213]	458	!> If cd_type is not specify, check if file name include '.nc' or
[5037]	459	!> '.dimg'<br/>
	460	!> Optionally, you could specify:<br/>
	461	!> - write mode (default .FALSE., ld_wrt)
[12080]	462	!> - East-West overlap (id_ew)
	463	!> - NEMO periodicity index (id_perio)
	464	!> - NEMO pivot point index F(0),T(1) (id_pivot)
[5037]	465	!> - grid type (default: 'ARAKAWA-C')
[12080]	466	!>
[4213]	467	!> @details
[12080]	468	!>
[4213]	469	!> @author J.Paul
[5617]	470	!> @date November, 2013 - Initial Version
[12080]	471	!>
[5037]	472	!> @param[in] cd_file file name
	473	!> @param[in] cd_type file type ('cdf', 'dimg')
	474	!> @param[in] ld_wrt write mode (default .FALSE.)
	475	!> @param[in] id_ew east-west overlap
	476	!> @param[in] id_perio NEMO periodicity index
	477	!> @param[in] id_pivot NEMO pivot point index F(0),T(1)
	478	!> @param[in] cd_grid grid type (default 'ARAKAWA-C')
[4213]	479	!> @return file structure
	480	!-------------------------------------------------------------------
[12080]	481
[4213]	482	IMPLICIT NONE
[12080]	483
[4213]	484	! Argument
	485	CHARACTER(LEN=*), INTENT(IN) :: cd_file
	486	CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_type
	487	LOGICAL , INTENT(IN), OPTIONAL :: ld_wrt
	488	INTEGER(i4) , INTENT(IN), OPTIONAL :: id_ew
	489	INTEGER(i4) , INTENT(IN), OPTIONAL :: id_perio
	490	INTEGER(i4) , INTENT(IN), OPTIONAL :: id_pivot
	491	CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_grid
	492
[12080]	493	! function
	494	TYPE(TFILE) :: tf_file
	495
[4213]	496	! local variable
[5037]	497	TYPE(TATT) :: tl_att
[4213]	498	!----------------------------------------------------------------
	499
	500	! clean file
[12080]	501	CALL file_clean(tf_file)
[4213]	502
[12080]	503	tf_file%c_name=TRIM(ADJUSTL(cd_file))
	504	CALL logger_trace("FILE INIT: initialize file "//TRIM(tf_file%c_name))
[4213]	505
	506	! check type
	507	IF( PRESENT(cd_type) )THEN
	508	SELECT CASE(TRIM(cd_type))
	509	CASE('cdf')
[12080]	510	tf_file%c_type='cdf'
[4213]	511	CASE('dimg')
[12080]	512	tf_file%c_type='dimg'
[4213]	513	CASE DEFAULT
[5037]	514	CALL logger_error( " FILE INIT: can't initialize file "//&
[12080]	515	& TRIM(tf_file%c_name)//" : type unknown " )
[4213]	516	END SELECT
	517	ELSE
[12080]	518	CALL logger_debug("FILE INIT: look for file type "//TRIM(tf_file%c_name))
	519	tf_file%c_type=TRIM(file_get_type(cd_file))
[4213]	520	ENDIF
	521
[5037]	522	! create some global attribute
[12080]	523	IF( TRIM(tf_file%c_type) == 'cdf' )THEN
[5037]	524	tl_att=att_init("Conventions","CF-1.5")
[12080]	525	CALL file_add_att(tf_file,tl_att)
[5037]	526	ENDIF
	527
[12080]	528	tl_att=att_init("Grid",TRIM(tf_file%c_grid))
	529	CALL file_add_att(tf_file,tl_att)
[5037]	530
[4213]	531	IF( PRESENT(ld_wrt) )THEN
[12080]	532	tf_file%l_wrt=ld_wrt
[4213]	533	ENDIF
	534
	535	IF( PRESENT(id_ew) )THEN
[12080]	536	tf_file%i_ew=id_ew
[4213]	537	IF( id_ew >= 0 )THEN
	538	tl_att=att_init('ew_overlap',id_ew)
[12080]	539	CALL file_move_att(tf_file, tl_att)
[4213]	540	ENDIF
	541	ENDIF
	542
	543	IF( PRESENT(id_perio) )THEN
[12080]	544	tf_file%i_perio=id_perio
[4213]	545	IF( id_perio >= 0 )THEN
	546	tl_att=att_init('periodicity',id_perio)
[12080]	547	CALL file_move_att(tf_file, tl_att)
[4213]	548	ENDIF
	549	ENDIF
	550
	551	IF( PRESENT(id_pivot) )THEN
[12080]	552	tf_file%i_pivot=id_pivot
[4213]	553	IF( id_pivot > 0 )THEN
	554	tl_att=att_init('pivot_point',id_pivot)
[12080]	555	CALL file_move_att(tf_file, tl_att)
[4213]	556	ENDIF
	557	ENDIF
	558
	559	IF( PRESENT(cd_grid) )THEN
[12080]	560	tf_file%c_grid=cd_grid
[4213]	561	ENDIF
	562
[5037]	563	! clean
	564	CALL att_clean(tl_att)
	565
[4213]	566	END FUNCTION file_init
[12080]	567	!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
	568	FUNCTION file_get_type(cd_file) &
	569	& RESULT (cf_type)
[4213]	570	!-------------------------------------------------------------------
	571	!> @brief
	572	!> This function get type of file, given file name.
	573	!> @details
	574	!> Actually it get suffix of the file name, and compare it to 'nc', 'cdf' or
	575	!> 'dimg'<br/>
	576	!> If no suffix or suffix not identify, we assume file is dimg
	577	!
	578	!> @details
	579	!
	580	!> @author J.Paul
[5617]	581	!> @date November, 2013 - Initial Version
[12080]	582	!> @date January, 2019
	583	!> - netcdf4 files identify as netcdf file
	584	!>
[5037]	585	!> @param[in] cd_file file name
[4213]	586	!> @return type of file
	587	!-------------------------------------------------------------------
[12080]	588
[4213]	589	IMPLICIT NONE
[12080]	590
[4213]	591	! Argument
	592	CHARACTER(LEN=*), INTENT(IN) :: cd_file
[5037]	593
[12080]	594	! function
	595	CHARACTER(LEN=lc) :: cf_type
	596
[4213]	597	!local variable
	598	CHARACTER(LEN=lc) :: cl_suffix
	599	!----------------------------------------------------------------
	600
	601	cl_suffix=file__get_suffix(cd_file)
	602	SELECT CASE( TRIM(fct_lower(cl_suffix)) )
[12080]	603	CASE('.nc','.cdf','.nc4')
[5037]	604	CALL logger_debug(" FILE GET TYPE: file "//TRIM(cd_file)//" is cdf")
[12080]	605	! Warning : type could be change to cdf4 when opening file.
	606	cf_type='cdf'
[4213]	607	CASE('.dimg')
[5037]	608	CALL logger_debug(" FILE GET TYPE: file "//TRIM(cd_file)//" is dimg" )
[12080]	609	cf_type='dimg'
[4213]	610	CASE DEFAULT
[5037]	611	CALL logger_warn(" FILE GET TYPE: type unknown, we assume file: "//&
[4213]	612	& TRIM(cd_file)//" is dimg ")
[12080]	613	cf_type='dimg'
[4213]	614	END SELECT
	615
	616	END FUNCTION file_get_type
[12080]	617	!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
	618	FUNCTION file_check_var_dim(td_file, td_var, ld_chklen) &
	619	& RESULT (lf_dim)
[4213]	620	!-------------------------------------------------------------------
[12080]	621	!> @brief This function check that variable dimension to be used
	622	!> of both variable and file structure are convenient (axis, length).
[4213]	623	!
	624	!> @details
[12080]	625	!> optionaly you could choose to not check length
[4213]	626	!
	627	!> @author J.Paul
[5617]	628	!> @date November, 2013 - Initial Version
[12080]	629	!> @date September, 2017
	630	!> - add option to not check dimension length
[4213]	631	!
[5037]	632	!> @param[in] td_file file structure
	633	!> @param[in] td_var variable structure
[12080]	634	!> @param[in] ld_chklen check length
[5037]	635	!> @return true if dimension of variable and file structure agree
[4213]	636	!-------------------------------------------------------------------
[12080]	637
[4213]	638	IMPLICIT NONE
[12080]	639
[4213]	640	! Argument
	641	TYPE(TFILE), INTENT(IN) :: td_file
	642	TYPE(TVAR), INTENT(IN) :: td_var
[12080]	643	LOGICAL, INTENT(IN), OPTIONAL :: ld_chklen
[4213]	644
[12080]	645	! function
	646	LOGICAL :: lf_dim
	647
[4213]	648	! local variable
[5037]	649	CHARACTER(LEN=lc) :: cl_dim
	650	LOGICAL :: ll_error
[5609]	651	LOGICAL :: ll_warn
[12080]	652	LOGICAL :: ll_chklen
	653	LOGICAL :: ll_use
	654	LOGICAL :: ll_len
[4213]	655
[5609]	656	INTEGER(i4) :: il_ind
[5037]	657
[4213]	658	! loop indices
	659	INTEGER(i4) :: ji
	660	!----------------------------------------------------------------
[5037]	661
[12080]	662	lf_dim=.TRUE.
	663
	664	CALL logger_debug( " FILE CHECK VAR DIM: check: "//TRIM(td_var%c_name) )
	665	! check dimension length
	666	ll_chklen=.TRUE.
	667	IF( PRESENT(ld_chklen) ) ll_chklen=ld_chklen
	668
[4213]	669	! check used dimension
[5037]	670	ll_error=.FALSE.
[5609]	671	ll_warn=.FALSE.
[5037]	672	DO ji=1,ip_maxdim
	673	il_ind=dim_get_index( td_file%t_dim(:), &
	674	& TRIM(td_var%t_dim(ji)%c_name), &
	675	& TRIM(td_var%t_dim(ji)%c_sname))
[12080]	676
[5037]	677	IF( il_ind /= 0 )THEN
[12080]	678	ll_use=(td_var%t_dim(ji)%l_use .AND. td_file%t_dim(il_ind)%l_use)
	679
	680	ll_len=.TRUE.
	681	IF( ll_chklen )THEN
	682	! check dimension length
	683	ll_len=(td_var%t_dim(ji)%i_len == td_file%t_dim(il_ind)%i_len)
	684	ENDIF
	685	IF( ll_use .AND. .NOT. ll_len )THEN
[5609]	686	IF( INDEX( TRIM(td_var%c_axis), &
	687	& TRIM(fct_upper(td_var%t_dim(ji)%c_name))) == 0 )THEN
	688	ll_warn=.TRUE.
	689	ELSE
	690	ll_error=.TRUE.
	691	ENDIF
	692	ENDIF
[5037]	693	ENDIF
	694	ENDDO
[4213]	695
[5037]	696	IF( ll_error )THEN
	697
	698	cl_dim='(/'
	699	DO ji = 1, td_file%i_ndim
	700	IF( td_file%t_dim(ji)%l_use )THEN
	701	cl_dim=TRIM(cl_dim)//&
	702	& TRIM(fct_upper(td_file%t_dim(ji)%c_sname))//':'//&
	703	& TRIM(fct_str(td_file%t_dim(ji)%i_len))//','
	704	ENDIF
[4213]	705	ENDDO
[5037]	706	cl_dim=TRIM(cl_dim)//'/)'
	707	CALL logger_debug( " file dimension: "//TRIM(cl_dim) )
	708
	709	cl_dim='(/'
	710	DO ji = 1, td_var%i_ndim
	711	IF( td_var%t_dim(ji)%l_use )THEN
	712	cl_dim=TRIM(cl_dim)//&
	713	& TRIM(fct_upper(td_var%t_dim(ji)%c_sname))//':'//&
	714	& TRIM(fct_str(td_var%t_dim(ji)%i_len))//','
	715	ENDIF
	716	ENDDO
	717	cl_dim=TRIM(cl_dim)//'/)'
	718	CALL logger_debug( " variable dimension: "//TRIM(cl_dim) )
	719
[12080]	720	lf_dim=.FALSE.
[5609]	721
	722	CALL logger_error( &
	723	& " FILE CHECK VAR DIM: variable and file dimension differ"//&
	724	& " for variable "//TRIM(td_var%c_name)//&
	725	& " and file "//TRIM(td_file%c_name))
	726
	727	ELSEIF( ll_warn )THEN
	728	CALL logger_warn( &
	729	& " FILE CHECK VAR DIM: variable and file dimension differ"//&
	730	& " for variable "//TRIM(td_var%c_name)//&
	731	& " and file "//TRIM(td_file%c_name)//". you should use"//&
	732	& " var_check_dim to remove useless dimension.")
[4213]	733	ELSE
	734
[5037]	735	IF( td_var%i_ndim > td_file%i_ndim )THEN
	736	CALL logger_info("FILE CHECK VAR DIM: variable "//&
	737	& TRIM(td_var%c_name)//" use more dimension than file "//&
	738	& TRIM(td_file%c_name)//" do until now.")
[4213]	739	ENDIF
[5037]	740
[4213]	741	ENDIF
	742
	743	END FUNCTION file_check_var_dim
[12080]	744	!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
	745	SUBROUTINE file_add_var(td_file, td_var)
[4213]	746	!-------------------------------------------------------------------
	747	!> @brief This subroutine add a variable structure in a file structure.<br/>
	748	!> Do not overwrite, if variable already in file structure.
	749	!
	750	!> @note variable value is suppose to be ordered ('x','y','z','t')
	751	!
	752	!> @details
	753	!
	754	!> @author J.Paul
[5609]	755	!> @date November, 2013 - Initial Version
[5037]	756	!> @date September, 2014
[6393]	757	!> - add dimension in file if need be
[5037]	758	!> - do not reorder dimension from variable, before put in file
[6393]	759	!> @date September, 2015
	760	!> - check variable dimension expected
[12080]	761	!> @date January, 2019
	762	!> - clean variable structure
	763	!>
[5037]	764	!> @param[inout] td_file file structure
	765	!> @param[in] td_var variable structure
[4213]	766	!-------------------------------------------------------------------
[12080]	767
[4213]	768	IMPLICIT NONE
	769
	770	! Argument
	771	TYPE(TFILE), INTENT(INOUT) :: td_file
[6393]	772	TYPE(TVAR) , INTENT(INOUT) :: td_var
[4213]	773
	774	! local variable
	775	INTEGER(i4) :: il_status
[5037]	776	!INTEGER(i4) :: il_rec
[4213]	777	INTEGER(i4) :: il_ind
	778
	779	TYPE(TVAR), DIMENSION(:), ALLOCATABLE :: tl_var
	780
	781	! loop indices
	782	INTEGER(i4) :: ji
	783	!----------------------------------------------------------------
	784	! check if file opened
	785	IF( TRIM(td_file%c_name) == '' )THEN
	786
[5037]	787	CALL logger_debug( " FILE ADD VAR: you should have used file_init before "//&
[4213]	788	& "running file_add_var" )
[5609]	789	CALL logger_error( " FILE ADD VAR: structure file unknown" )
[4213]	790
	791	ELSE
	792	! check if variable exist
	793	IF( TRIM(td_var%c_name) == '' .AND. &
	794	& TRIM(td_var%c_stdname) == '' )THEN
[5037]	795	CALL logger_error(" FILE ADD VAR: variable without name ")
[4213]	796	ELSE
	797	! check if variable already in file structure
[5037]	798	il_ind=0
[4213]	799	IF( ASSOCIATED(td_file%t_var) )THEN
[5037]	800	il_ind=var_get_index( td_file%t_var(:), td_var%c_name, &
	801	& td_var%c_stdname )
[4213]	802	ENDIF
[5609]	803	CALL logger_debug( &
	804	& " FILE ADD VAR: ind "//TRIM(fct_str(il_ind)) )
[5037]	805	IF( il_ind /= 0 )THEN
[4213]	806
	807	CALL logger_error( &
[5037]	808	& " FILE ADD VAR: variable "//TRIM(td_var%c_name)//&
[4213]	809	& ", standard name "//TRIM(td_var%c_stdname)//&
	810	& ", already in file "//TRIM(td_file%c_name) )
	811
	812	DO ji=1,td_file%i_nvar
	813	CALL logger_debug( " ADD VAR: in file : &
	814	& variable "//TRIM(td_file%t_var(ji)%c_name)//&
	815	& ", standard name "//TRIM(td_file%t_var(ji)%c_stdname) )
	816	ENDDO
	817
	818	ELSE
	819
[5609]	820	CALL logger_debug( &
[5037]	821	& " FILE ADD VAR: add variable "//TRIM(td_var%c_name)//&
[4213]	822	& ", standard name "//TRIM(td_var%c_stdname)//&
	823	& ", in file "//TRIM(td_file%c_name) )
	824
	825	! check used dimension
	826	IF( file_check_var_dim(td_file, td_var) )THEN
	827
[6393]	828	! check variable dimension expected
	829	CALL var_check_dim(td_var)
	830
[5037]	831	! update dimension if need be
	832	DO ji=1,ip_maxdim
	833	IF( td_var%t_dim(ji)%l_use .AND. &
	834	& .NOT. td_file%t_dim(ji)%l_use )THEN
	835	CALL file_add_dim(td_file,td_var%t_dim(ji))
	836	ENDIF
	837	ENDDO
	838
	839	! get index of new variable
[4213]	840	SELECT CASE(td_var%i_ndim)
	841	CASE(0)
	842	il_ind=td_file%i_n0d+1
[5037]	843	!il_rec=0
[4213]	844	CASE(1)
	845	il_ind=td_file%i_n0d+td_file%i_n1d+1
[5037]	846	!il_rec=1
[4213]	847	CASE(2)
	848	il_ind=td_file%i_n0d+td_file%i_n1d+td_file%i_n2d+1
[5037]	849	!il_rec=1
[4213]	850	CASE(3,4)
	851	il_ind=td_file%i_n0d+td_file%i_n1d+td_file%i_n2d+td_file%i_n3d+1
[5037]	852	!il_rec=td_file%t_dim(3)%i_len
[4213]	853	END SELECT
	854
	855	IF( td_file%i_nvar > 0 )THEN
	856	! already other variable in file structure
	857	ALLOCATE( tl_var(td_file%i_nvar), stat=il_status )
	858	IF(il_status /= 0 )THEN
	859
	860	CALL logger_error( &
[5037]	861	& " FILE ADD VAR: not enough space to put variables "//&
[4213]	862	& "from "//TRIM(td_file%c_name)//&
	863	& " in variable structure")
	864
	865	ELSE
	866
	867	! save temporary variable of file structure
[5037]	868	tl_var(:)=var_copy(td_file%t_var(:))
[4213]	869
[5037]	870	CALL var_clean( td_file%t_var(:) )
	871	DEALLOCATE(td_file%t_var)
[4213]	872	ALLOCATE( td_file%t_var(td_file%i_nvar+1), &
	873	& stat=il_status)
	874	IF(il_status /= 0 )THEN
	875
	876	CALL logger_error( &
[5037]	877	& " FILE ADD VAR: not enough space to put variable "//&
[4213]	878	& "in file structure "//TRIM(td_file%c_name) )
	879
	880	ENDIF
	881
	882	! copy variable in file before
	883	! variable with less than or equal dimension that new variable
[5037]	884	IF( il_ind > 1 )THEN
	885	td_file%t_var( 1:il_ind-1 ) = var_copy(tl_var(1:il_ind-1))
	886	ENDIF
[4213]	887
[5609]	888	IF( il_ind < td_file%i_nvar+1 )THEN
[5037]	889	! variable with more dimension than new variable
	890	td_file%t_var( il_ind+1 : td_file%i_nvar+1 ) = &
	891	& var_copy( tl_var(il_ind : td_file%i_nvar) )
	892	ENDIF
[4213]	893
[5037]	894	! clean
	895	CALL var_clean(tl_var(:))
[4213]	896	ENDIF
[12080]	897	DEALLOCATE(tl_var)
[4213]	898
	899	ELSE
	900	! no variable in file structure
	901	IF( ASSOCIATED(td_file%t_var) )THEN
[5037]	902	CALL var_clean(td_file%t_var(:))
[4213]	903	DEALLOCATE(td_file%t_var)
	904	ENDIF
	905	ALLOCATE( td_file%t_var(td_file%i_nvar+1), stat=il_status )
	906	IF(il_status /= 0 )THEN
	907
	908	CALL logger_error( &
[5037]	909	& " FILE ADD VAR: not enough space to put variable "//&
[4213]	910	& "in file structure "//TRIM(td_file%c_name) )
	911
	912	ENDIF
	913
	914	ENDIF
	915
[5037]	916	! add new variable in array of variable
[4213]	917	ALLOCATE( tl_var(1), stat=il_status )
	918	IF(il_status /= 0 )THEN
	919
	920	CALL logger_error( &
[5037]	921	& " FILE ADD VAR: not enough space to put variables from "//&
[4213]	922	& TRIM(td_var%c_name)//" in variable structure")
	923
	924	ELSE
[5037]	925	tl_var(1)=var_copy(td_var)
[12080]	926	! remove old id
	927	tl_var(1)%i_id=0
[4213]	928
	929	! update dimension name in new variable
	930	tl_var(1)%t_dim(:)%c_name = td_file%t_dim(:)%c_name
	931
	932	! add new variable
[5037]	933	td_file%t_var(il_ind)=var_copy(tl_var(1))
[4213]	934
	935	! update number of variable
	936	td_file%i_nvar=td_file%i_nvar+1
	937	SELECT CASE(tl_var(1)%i_ndim)
	938	CASE(0)
	939	td_file%i_n0d=td_file%i_n0d+1
	940	CASE(1)
	941	td_file%i_n1d=td_file%i_n1d+1
	942	CASE(2)
	943	td_file%i_n2d=td_file%i_n2d+1
[5037]	944	CASE(3,4)
[4213]	945	td_file%i_n3d=td_file%i_n3d+1
	946	END SELECT
	947
	948	! update variable id
[5037]	949	td_file%t_var(il_ind)%i_id=var_get_unit(td_file%t_var(:))
[4213]	950
	951	! update dimension used
	952	td_file%t_dim(:)%l_use=.FALSE.
	953	DO ji=1,ip_maxdim
	954	IF( ANY(td_file%t_var(:)%t_dim(ji)%l_use) )THEN
	955	td_file%t_dim(ji)%l_use=.TRUE.
	956	ENDIF
	957	ENDDO
[5037]	958
[4213]	959	! update number of dimension
	960	td_file%i_ndim=COUNT(td_file%t_dim(:)%l_use)
	961
[5037]	962	! clean
	963	CALL var_clean( tl_var(:) )
[4213]	964	ENDIF
[12080]	965	DEALLOCATE(tl_var)
	966
[4213]	967	ENDIF
	968	ENDIF
	969	ENDIF
	970	ENDIF
	971
	972	END SUBROUTINE file_add_var
[12080]	973	!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
	974	SUBROUTINE file__del_var_name(td_file, cd_name)
[4213]	975	!-------------------------------------------------------------------
	976	!> @brief This subroutine delete a variable structure
[5037]	977	!> in file structure, given variable name or standard name.
[12080]	978	!>
[4213]	979	!> @author J.Paul
[5609]	980	!> @date November, 2013 - Initial Version
	981	!> @date February, 2015
	982	!> - define local variable structure to avoid mistake with pointer
[12080]	983	!>
[5037]	984	!> @param[inout] td_file file structure
	985	!> @param[in] cd_name variable name or standard name
[4213]	986	!-------------------------------------------------------------------
[12080]	987
[4213]	988	IMPLICIT NONE
	989
	990	! Argument
	991	TYPE(TFILE) , INTENT(INOUT) :: td_file
	992	CHARACTER(LEN=*), INTENT(IN ) :: cd_name
	993
	994	! local variable
[5037]	995	INTEGER(i4) :: il_ind
[5609]	996	TYPE(TVAR) :: tl_var
[4213]	997	!----------------------------------------------------------------
	998
	999	! check if file opened
	1000	IF( TRIM(td_file%c_name) == '' )THEN
	1001
[5037]	1002	CALL logger_error( " FILE DEL VAR NAME: file structure unknown ")
	1003	CALL logger_debug( " FILE DEL VAR NAME: you should have used file_init before "//&
[4213]	1004	& "running file_del_var" )
	1005
	1006	ELSE
	1007
	1008	IF( td_file%i_nvar /= 0 )THEN
	1009
[5037]	1010	! get the variable index, in file variable structure
	1011	il_ind=0
[4213]	1012	IF( ASSOCIATED(td_file%t_var) )THEN
[5037]	1013	il_ind=var_get_index(td_file%t_var(:), cd_name )
[4213]	1014	ENDIF
[5037]	1015
	1016	IF( il_ind /= 0 )THEN
[4213]	1017
[5609]	1018	tl_var=var_copy(td_file%t_var(il_ind))
	1019	CALL file_del_var(td_file, tl_var)
[12080]	1020	! clean
	1021	CALL var_clean(tl_var)
[4213]	1022	ELSE
	1023
[5609]	1024	CALL logger_debug( &
[5037]	1025	& " FILE DEL VAR NAME: there is no variable with name or "//&
[4213]	1026	& "standard name "//TRIM(cd_name)//" in file "//&
	1027	& TRIM(td_file%c_name))
	1028
	1029	ENDIF
	1030
	1031	ELSE
[5037]	1032	CALL logger_debug( " FILE DEL VAR NAME: "//&
	1033	& "no variable associated to file "//&
	1034	& TRIM(td_file%c_name) )
[4213]	1035	ENDIF
	1036
	1037	ENDIF
	1038
	1039	END SUBROUTINE file__del_var_name
[12080]	1040	!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
	1041	SUBROUTINE file__del_var_str(td_file, td_var)
[4213]	1042	!-------------------------------------------------------------------
	1043	!> @brief This subroutine delete a variable structure
	1044	!> in file structure, given variable structure.
[5037]	1045	!>
[4213]	1046	!> @author J.Paul
[5617]	1047	!> @date November, 2013 - Initial Version
[12080]	1048	!> @date January, 2019
	1049	!> - clean variable structure
[5037]	1050	!>
	1051	!> @param[inout] td_file file structure
	1052	!> @param[in] td_var variable structure
[4213]	1053	!-------------------------------------------------------------------
[12080]	1054
[4213]	1055	IMPLICIT NONE
	1056
	1057	! Argument
	1058	TYPE(TFILE), INTENT(INOUT) :: td_file
	1059	TYPE(TVAR), INTENT(IN) :: td_var
	1060
	1061	! local variable
	1062	INTEGER(i4) :: il_status
[5037]	1063	INTEGER(i4) :: il_ind
[4213]	1064	INTEGER(i4) :: il_rec
	1065	TYPE(TVAR), DIMENSION(:), ALLOCATABLE :: tl_var
	1066
	1067	! loop indices
	1068	INTEGER(i4) :: ji
	1069	!----------------------------------------------------------------
	1070
	1071	! check if file opened
	1072	IF( TRIM(td_file%c_name) == '' )THEN
	1073
[5037]	1074	CALL logger_error( " FILE DEL VAR: file structure unknown ")
	1075	CALL logger_debug( " FILE DEL VAR: you should have used "//&
	1076	& "file_init before running file_del_var" )
[4213]	1077
	1078	ELSE
	1079
[5037]	1080	! check if variable is member of a file
	1081	IF( td_var%l_file )THEN
	1082	CALL logger_warn( &
	1083	& " FILE DEL VAR: variable "//TRIM(td_var%c_name)//&
	1084	& ", belong to file "//TRIM(td_file%c_name)//&
	1085	& " and can not be removed.")
	1086	ELSE
	1087	! check if variable already in file structure
	1088	il_ind=0
	1089	IF( ASSOCIATED(td_file%t_var) )THEN
	1090	il_ind=var_get_index( td_file%t_var(:), td_var%c_name, &
	1091	& td_var%c_stdname )
	1092	ENDIF
[4213]	1093
[5037]	1094	IF( il_ind == 0 )THEN
[4213]	1095
[5037]	1096	CALL logger_warn( "FILE DEL VAR: no variable "//&
	1097	& TRIM(td_var%c_name)//", in file "//TRIM(td_file%c_name) )
[4213]	1098
[5037]	1099	DO ji=1,td_file%i_nvar
	1100	CALL logger_debug( "FILE DEL VAR: in file "//&
	1101	& TRIM(td_file%t_var(ji)%c_name)//", standard name "//&
	1102	& TRIM(td_file%t_var(ji)%c_stdname) )
	1103	ENDDO
[4213]	1104
[5037]	1105	ELSE
	1106
	1107	CALL logger_trace( "FILE DEL VAR: delete variable "//&
	1108	& TRIM(td_var%c_name)//", from file "//TRIM(td_file%c_name) )
[4213]	1109
[5037]	1110	ALLOCATE( tl_var(td_file%i_nvar-1), stat=il_status )
	1111	IF(il_status /= 0 )THEN
[4213]	1112
[5037]	1113	CALL logger_error( &
	1114	& " FILE DEL VAR: not enough space to put variables from "//&
	1115	& TRIM(td_file%c_name)//" in temporary variable structure")
[4213]	1116
[5037]	1117	ELSE
[4213]	1118
[5037]	1119	! save temporary variable's file structure
	1120	IF( il_ind > 1 )THEN
	1121	tl_var(1:il_ind-1)=var_copy(td_file%t_var(1:il_ind-1))
	1122	ENDIF
[4213]	1123
[5037]	1124	IF( il_ind < td_file%i_nvar )THEN
	1125	tl_var(il_ind:)=var_copy(td_file%t_var(il_ind+1:))
	1126	ENDIF
[4213]	1127
[5037]	1128	! new number of variable in file
	1129	td_file%i_nvar=td_file%i_nvar-1
	1130	SELECT CASE(td_var%i_ndim)
	1131	CASE(0)
	1132	td_file%i_n0d=td_file%i_n0d-1
	1133	il_rec=0
	1134	CASE(1)
	1135	td_file%i_n1d=td_file%i_n1d-1
	1136	il_rec=1
	1137	CASE(2)
	1138	td_file%i_n2d=td_file%i_n2d-1
	1139	il_rec=1
	1140	CASE(3,4)
	1141	td_file%i_n3d=td_file%i_n3d-1
	1142	il_rec=td_file%t_dim(3)%i_len
	1143	END SELECT
[4213]	1144
[5037]	1145	CALL var_clean( td_file%t_var(:) )
	1146	DEALLOCATE(td_file%t_var)
[4213]	1147
[5037]	1148	IF( td_file%i_nvar > 0 )THEN
	1149	ALLOCATE( td_file%t_var(td_file%i_nvar), stat=il_status )
	1150	IF(il_status /= 0 )THEN
[4213]	1151
[5037]	1152	CALL logger_error( " FILE DEL VAR: not enough space"//&
	1153	& "to put variables in file structure "//&
	1154	& TRIM(td_file%c_name) )
[4213]	1155
[5037]	1156	ENDIF
[4213]	1157
[5037]	1158	! copy attribute in file before
	1159	td_file%t_var(:)=var_copy(tl_var(:))
[4213]	1160
[5037]	1161	! update dimension used
	1162	td_file%t_dim(:)%l_use=.FALSE.
	1163	DO ji=1,ip_maxdim
	1164	IF( ANY(td_file%t_var(:)%t_dim(ji)%l_use) )THEN
	1165	td_file%t_dim(ji)%l_use=.TRUE.
	1166	ENDIF
	1167	ENDDO
[4213]	1168
[5037]	1169	! update number of dimension
	1170	td_file%i_ndim=COUNT(td_file%t_dim(:)%l_use)
[4213]	1171
[5037]	1172	ENDIF
	1173
	1174	! clean
	1175	CALL var_clean(tl_var(:))
	1176	ENDIF
[12080]	1177	DEALLOCATE(tl_var)
	1178
[5037]	1179	ENDIF
[4213]	1180	ENDIF
	1181	ENDIF
	1182
	1183	END SUBROUTINE file__del_var_str
[12080]	1184	!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
	1185	SUBROUTINE file_move_var(td_file, td_var)
[4213]	1186	!-------------------------------------------------------------------
	1187	!> @brief This subroutine overwrite variable structure
	1188	!> in file structure.
	1189	!
[5037]	1190	!> @warning change variable id in file structure.
[4213]	1191	!
	1192	!> @author J.Paul
[5617]	1193	!> @date November, 2013 - Initial Version
[4213]	1194	!
[5037]	1195	!> @param[inout] td_file file structure
	1196	!> @param[in] td_var variable structure
[4213]	1197	!-------------------------------------------------------------------
[12080]	1198
[4213]	1199	IMPLICIT NONE
	1200
	1201	! Argument
	1202	TYPE(TFILE), INTENT(INOUT) :: td_file
	1203	TYPE(TVAR), INTENT(IN) :: td_var
	1204
	1205	! local variable
	1206	TYPE(TVAR) :: tl_var
	1207	!----------------------------------------------------------------
	1208
	1209	! copy variable
[5037]	1210	tl_var=var_copy(td_var)
[4213]	1211
[5037]	1212	! remove variable with same name or standard name
	1213	CALL file_del_var(td_file, tl_var)
[4213]	1214
	1215	! add new variable
	1216	CALL file_add_var(td_file, tl_var)
	1217
[5037]	1218	! clean
	1219	CALL var_clean(tl_var)
	1220
[4213]	1221	END SUBROUTINE file_move_var
[12080]	1222	!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
	1223	SUBROUTINE file_add_att(td_file, td_att)
[4213]	1224	!-------------------------------------------------------------------
	1225	!> @brief This subroutine add a global attribute
	1226	!> in a file structure.<br/>
	1227	!> Do not overwrite, if attribute already in file structure.
	1228	!
	1229	!> @author J.Paul
[5617]	1230	!> @date November, 2013 - Initial Version
[12080]	1231	!> @date January, 2019
	1232	!> - clean attribute structure
	1233	!>
[5037]	1234	!> @param[inout] td_file file structure
	1235	!> @param[in] td_att attribute structure
[4213]	1236	!-------------------------------------------------------------------
[12080]	1237
[4213]	1238	IMPLICIT NONE
	1239
	1240	! Argument
	1241	TYPE(TFILE), INTENT(INOUT) :: td_file
	1242	TYPE(TATT), INTENT(IN) :: td_att
	1243
	1244	! local variable
	1245	INTEGER(i4) :: il_status
[5037]	1246	INTEGER(i4) :: il_ind
[4213]	1247	TYPE(TATT), DIMENSION(:), ALLOCATABLE :: tl_att
	1248
	1249	! loop indices
	1250	INTEGER(i4) :: ji
	1251	!----------------------------------------------------------------
	1252
	1253	! check if file opened
	1254	IF( TRIM(td_file%c_name) == '' )THEN
	1255
[5037]	1256	CALL logger_error( " FILE ADD ATT: file structure unknown ")
	1257	CALL logger_debug( " FILE ADD ATT: you should have used file_init before "//&
[4213]	1258	& "running file_add_att" )
	1259
	1260	ELSE
	1261
	1262	! check if attribute already in file structure
[5037]	1263	il_ind=0
[4213]	1264	IF( ASSOCIATED(td_file%t_att) )THEN
[5037]	1265	il_ind=att_get_index( td_file%t_att(:), td_att%c_name )
[4213]	1266	ENDIF
	1267
[5037]	1268	IF( il_ind /= 0 )THEN
[4213]	1269
	1270	CALL logger_error( &
[5037]	1271	& " FILE ADD ATT: attribute "//TRIM(td_att%c_name)//&
[4213]	1272	& ", already in file "//TRIM(td_file%c_name) )
	1273
	1274	DO ji=1,td_file%i_natt
	1275	CALL logger_debug( &
[5037]	1276	& " FILE ADD ATT: in file "//TRIM(td_file%t_att(ji)%c_name) )
[4213]	1277	ENDDO
	1278
	1279	ELSE
	1280
[5037]	1281	CALL logger_trace( &
	1282	& " FILE ADD ATT: add attribute "//TRIM(td_att%c_name)//&
[4213]	1283	& ", in file "//TRIM(td_file%c_name) )
	1284
	1285	IF( td_file%i_natt > 0 )THEN
	1286	! already other attribute in file structure
	1287	ALLOCATE( tl_att(td_file%i_natt), stat=il_status )
	1288	IF(il_status /= 0 )THEN
	1289
	1290	CALL logger_error( &
[5037]	1291	& " FILE ADD ATT: not enough space to put attributes from "//&
[4213]	1292	& TRIM(td_file%c_name)//" in temporary attribute structure")
	1293
	1294	ELSE
	1295
	1296	! save temporary global attribute's file structure
[5037]	1297	tl_att(:)=att_copy(td_file%t_att(:))
[4213]	1298
[5037]	1299	CALL att_clean( td_file%t_att(:) )
	1300	DEALLOCATE(td_file%t_att)
[4213]	1301	ALLOCATE( td_file%t_att(td_file%i_natt+1), stat=il_status )
	1302	IF(il_status /= 0 )THEN
	1303
	1304	CALL logger_error( &
[5037]	1305	& " FILE ADD ATT: not enough space to put attributes "//&
[4213]	1306	& "in file structure "//TRIM(td_file%c_name) )
	1307
	1308	ENDIF
	1309
	1310	! copy attribute in file before
[5037]	1311	td_file%t_att(1:td_file%i_natt)=att_copy(tl_att(:))
[4213]	1312
[5037]	1313	! clean
	1314	CALL att_clean(tl_att(:))
[12080]	1315	ENDIF
	1316	DEALLOCATE(tl_att)
[5037]	1317
[4213]	1318	ELSE
	1319	! no attribute in file structure
	1320	IF( ASSOCIATED(td_file%t_att) )THEN
[5037]	1321	CALL att_clean(td_file%t_att(:))
[4213]	1322	DEALLOCATE(td_file%t_att)
	1323	ENDIF
[5037]	1324
[4213]	1325	ALLOCATE( td_file%t_att(td_file%i_natt+1), stat=il_status )
	1326	IF(il_status /= 0 )THEN
	1327
	1328	CALL logger_error( &
[5037]	1329	& " FILE ADD ATT: not enough space to put attributes "//&
[4213]	1330	& "in file structure "//TRIM(td_file%c_name) )
	1331
	1332	ENDIF
	1333	ENDIF
[5037]	1334	! add new attribute
	1335	td_file%t_att(td_file%i_natt+1)=att_copy(td_att)
[4213]	1336
	1337	! update number of attribute
	1338	td_file%i_natt=td_file%i_natt+1
	1339	ENDIF
	1340	ENDIF
	1341
	1342	END SUBROUTINE file_add_att
[12080]	1343	!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
	1344	SUBROUTINE file__del_att_name(td_file, cd_name)
[4213]	1345	!-------------------------------------------------------------------
[5037]	1346	!> @brief This subroutine delete a global attribute structure
	1347	!> in file structure, given attribute name.
[12080]	1348	!>
[4213]	1349	!> @author J.Paul
[5609]	1350	!> @date November, 2013 - Initial Version
	1351	!> @date February, 2015
	1352	!> - define local attribute structure to avoid mistake
	1353	!> with pointer
[12080]	1354	!> @date January, 2019
	1355	!> - clean attribute structure
	1356	!>
[5037]	1357	!> @param[inout] td_file file structure
	1358	!> @param[in] cd_name attribute name
[4213]	1359	!-------------------------------------------------------------------
[12080]	1360
[4213]	1361	IMPLICIT NONE
	1362
	1363	! Argument
	1364	TYPE(TFILE) , INTENT(INOUT) :: td_file
	1365	CHARACTER(LEN=*), INTENT(IN ) :: cd_name
	1366
	1367	! local variable
[5037]	1368	INTEGER(i4) :: il_ind
[5609]	1369	TYPE(TATT) :: tl_att
[4213]	1370	!----------------------------------------------------------------
	1371
	1372	! check if file opened
	1373	IF( TRIM(td_file%c_name) == '' )THEN
	1374
[5037]	1375	CALL logger_error( " FILE DEL ATT NAME: file structure unknown ")
	1376	CALL logger_debug( " FILE DEL ATT NAME: you should have "//&
	1377	& "used file_init before running file_del_att" )
[4213]	1378
	1379	ELSE
	1380
	1381	IF( td_file%i_natt /= 0 )THEN
	1382
	1383	! get the variable id, in file variable structure
[5037]	1384	il_ind=0
[4213]	1385	IF( ASSOCIATED(td_file%t_att) )THEN
[5037]	1386	il_ind=att_get_index(td_file%t_att(:), cd_name )
[4213]	1387	ENDIF
[5037]	1388
	1389	IF( il_ind /= 0 )THEN
[4213]	1390
[5609]	1391	tl_att=att_copy(td_file%t_att(il_ind))
	1392	CALL file_del_att(td_file, tl_att)
[12080]	1393	! clean
	1394	CALL att_clean(tl_att)
[4213]	1395	ELSE
	1396
[5609]	1397	CALL logger_debug( &
[5037]	1398	& " FILE DEL ATT NAME: there is no attribute with name "//&
[4213]	1399	& TRIM(cd_name)//" in file "//TRIM(td_file%c_name))
	1400
	1401	ENDIF
	1402
	1403	ELSE
[5037]	1404	CALL logger_debug( " FILE DEL ATT NAME: no attribute "//&
	1405	& "associated to file "//TRIM(td_file%c_name) )
[4213]	1406	ENDIF
	1407
	1408	ENDIF
	1409
	1410	END SUBROUTINE file__del_att_name
[12080]	1411	!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
	1412	SUBROUTINE file__del_att_str(td_file, td_att)
[4213]	1413	!-------------------------------------------------------------------
	1414	!> @brief This subroutine delete a global attribute structure
[5037]	1415	!> from file structure, given attribute structure.
[12080]	1416	!>
[4213]	1417	!> @author J.Paul
[5617]	1418	!> @date November, 2013 - Initial Version
[12080]	1419	!> @date January, 2019
	1420	!> - clean attribute structure
	1421	!>
[5037]	1422	!> @param[inout] td_file file structure
	1423	!> @param[in] td_att attribute structure
[4213]	1424	!-------------------------------------------------------------------
[12080]	1425
[4213]	1426	IMPLICIT NONE
	1427
	1428	! Argument
	1429	TYPE(TFILE), INTENT(INOUT) :: td_file
	1430	TYPE(TATT), INTENT(IN) :: td_att
	1431
	1432	! local variable
	1433	INTEGER(i4) :: il_status
[5037]	1434	INTEGER(i4) :: il_ind
[4213]	1435	TYPE(TATT), DIMENSION(:), ALLOCATABLE :: tl_att
	1436
	1437	! loop indices
	1438	!----------------------------------------------------------------
	1439
	1440	! check if file opened
	1441	IF( TRIM(td_file%c_name) == '' )THEN
	1442
[5037]	1443	CALL logger_error( " FILE DEL ATT: file structure unknown ")
	1444	CALL logger_debug( " FILE DEL ATT: you should have used "//&
	1445	& "file_init before running file_del_att" )
[4213]	1446
	1447	ELSE
	1448
	1449	! check if attribute already in file structure
[5037]	1450	il_ind=0
[4213]	1451	IF( ASSOCIATED(td_file%t_att) )THEN
[5037]	1452	il_ind=att_get_index( td_file%t_att(:), td_att%c_name )
[4213]	1453	ENDIF
	1454
[5037]	1455	IF( il_ind == 0 )THEN
[4213]	1456
	1457	CALL logger_error( &
[5037]	1458	& " FILE DEL ATT: no attribute "//TRIM(td_att%c_name)//&
[4213]	1459	& ", in file "//TRIM(td_file%c_name) )
	1460
	1461	ELSE
	1462
[5037]	1463	CALL logger_trace( &
	1464	& " FILE DEL ATT: del attribute "//TRIM(td_att%c_name)//&
[4213]	1465	& ", in file "//TRIM(td_file%c_name) )
	1466
	1467	ALLOCATE( tl_att(td_file%i_natt-1), stat=il_status )
	1468	IF(il_status /= 0 )THEN
	1469
	1470	CALL logger_error( &
[5037]	1471	& " FILE ADD ATT: not enough space to put attributes from "//&
[4213]	1472	& TRIM(td_file%c_name)//" in temporary attribute structure")
	1473
	1474	ELSE
	1475
	1476	! save temporary global attribute's file structure
[5037]	1477	IF( il_ind > 1 )THEN
	1478	tl_att(1:il_ind-1)=att_copy(td_file%t_att(1:il_ind-1))
	1479	ENDIF
[4213]	1480
[5037]	1481	IF( il_ind < td_file%i_natt )THEN
	1482	tl_att(il_ind:)=att_copy(td_file%t_att(il_ind+1:))
	1483	ENDIF
[4213]	1484
[5037]	1485	CALL att_clean( td_file%t_att(:) )
	1486	DEALLOCATE(td_file%t_att)
	1487
[4213]	1488	! new number of attribute in file
	1489	td_file%i_natt=td_file%i_natt-1
	1490
	1491	ALLOCATE( td_file%t_att(td_file%i_natt), stat=il_status )
	1492	IF(il_status /= 0 )THEN
	1493
	1494	CALL logger_error( &
[5037]	1495	& " FILE ADD ATT: not enough space to put attributes "//&
[4213]	1496	& "in file structure "//TRIM(td_file%c_name) )
	1497
	1498	ENDIF
	1499
	1500	! copy attribute in file before
[5037]	1501	td_file%t_att(1:td_file%i_natt)=att_copy(tl_att(:))
[4213]	1502
[5037]	1503	! clean
	1504	CALL att_clean(tl_att(:))
[12080]	1505	ENDIF
	1506	DEALLOCATE(tl_att)
[4213]	1507
	1508	ENDIF
	1509	ENDIF
	1510
	1511	END SUBROUTINE file__del_att_str
[12080]	1512	!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
	1513	SUBROUTINE file_move_att(td_file, td_att)
[4213]	1514	!-------------------------------------------------------------------
	1515	!> @brief This subroutine move a global attribute structure
	1516	!> from file structure.
[5037]	1517	!> @warning change attribute id in file structure.
[12080]	1518	!>
[4213]	1519	!> @author J.Paul
[5617]	1520	!> @date November, 2013 - Initial Version
[12080]	1521	!>
[5037]	1522	!> @param[inout] td_file file structure
	1523	!> @param[in] td_att attribute structure
[4213]	1524	!-------------------------------------------------------------------
[12080]	1525
[4213]	1526	IMPLICIT NONE
	1527
	1528	! Argument
	1529	TYPE(TFILE), INTENT(INOUT) :: td_file
	1530	TYPE(TATT), INTENT(IN) :: td_att
	1531
	1532	! local variable
	1533	TYPE(TATT) :: tl_att
[5037]	1534	INTEGER(i4) :: il_ind
[4213]	1535	!----------------------------------------------------------------
	1536
	1537	! copy attribute
[5037]	1538	tl_att=att_copy(td_att)
[4213]	1539
	1540	IF( ASSOCIATED(td_file%t_att) )THEN
[5037]	1541	il_ind=att_get_index(td_file%t_att(:),TRIM(tl_att%c_name))
	1542	IF( il_ind /= 0 )THEN
[4213]	1543	! remove attribute with same name
	1544	CALL file_del_att(td_file, tl_att)
	1545	ENDIF
	1546	ENDIF
	1547
	1548	! add new attribute
	1549	CALL file_add_att(td_file, tl_att)
	1550
[5037]	1551	! clean
	1552	CALL att_clean(tl_att)
	1553
[4213]	1554	END SUBROUTINE file_move_att
[12080]	1555	!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
	1556	SUBROUTINE file_add_dim(td_file, td_dim)
[4213]	1557	!-------------------------------------------------------------------
	1558	!> @brief This subroutine add a dimension structure in file
	1559	!> structure.
	1560	!> Do not overwrite, if dimension already in file structure.
[12080]	1561	!>
[4213]	1562	!> @author J.Paul
[5609]	1563	!> @date November, 2013 - Initial Version
[5037]	1564	!> @date September, 2014
	1565	!> - do not reorder dimension, before put in file
[12080]	1566	!>
[5037]	1567	!> @param[inout] td_file file structure
	1568	!> @param[in] td_dim dimension structure
[4213]	1569	!-------------------------------------------------------------------
[12080]	1570
[4213]	1571	IMPLICIT NONE
	1572
	1573	! Argument
[5037]	1574	TYPE(TFILE) , INTENT(INOUT) :: td_file
	1575	TYPE(TDIM) , INTENT(IN ) :: td_dim
[4213]	1576
	1577	! local variable
[5037]	1578	INTEGER(i4) :: il_ind
	1579
	1580	! loop indices
	1581	INTEGER(i4) :: ji
[4213]	1582	!----------------------------------------------------------------
	1583	! check if file opened
	1584	IF( TRIM(td_file%c_name) == '' )THEN
	1585
[5037]	1586	CALL logger_error( " FILE ADD DIM: file structure unknown ")
	1587	CALL logger_debug( " FILE ADD DIM: you should have used "//&
	1588	& "file_init before running file_add_dim" )
[4213]	1589
	1590	ELSE
	1591
[5037]	1592	IF( td_file%i_ndim <= ip_maxdim )THEN
[4213]	1593
	1594	! check if dimension already in file structure
[5037]	1595	il_ind=dim_get_index(td_file%t_dim(:), td_dim%c_sname)
	1596	IF( il_ind /= 0 )THEN
	1597	IF( td_file%t_dim(il_ind)%l_use )THEN
[4213]	1598	CALL logger_error( &
[5037]	1599	& "FILE ADD DIM: dimension "//TRIM(td_dim%c_name)//&
	1600	& ", short name "//TRIM(td_dim%c_sname)//&
	1601	& ", already used in file "//TRIM(td_file%c_name) )
	1602	ELSE
	1603	! replace dimension
	1604	td_file%t_dim(il_ind)=dim_copy(td_dim)
	1605	td_file%t_dim(il_ind)%i_id=il_ind
	1606	td_file%t_dim(il_ind)%l_use=.TRUE.
[4213]	1607	ENDIF
	1608	ELSE
[5037]	1609	IF( td_file%i_ndim == ip_maxdim )THEN
	1610	CALL logger_error( &
	1611	& "FILE ADD DIM: can not add dimension "//TRIM(td_dim%c_name)//&
	1612	& ", short name "//TRIM(td_dim%c_sname)//&
	1613	& ", in file "//TRIM(td_file%c_name)//". Already "//&
	1614	& TRIM(fct_str(ip_maxdim))//" dimensions." )
	1615	ELSE
[4213]	1616	! search empty dimension
[5037]	1617	DO ji=1,ip_maxdim
	1618	IF( td_file%t_dim(ji)%i_id == 0 )THEN
	1619	il_ind=ji
	1620	EXIT
	1621	ENDIF
	1622	ENDDO
	1623
	1624	! add new dimension
	1625	td_file%t_dim(il_ind)=dim_copy(td_dim)
[4213]	1626	! update number of attribute
	1627	td_file%i_ndim=COUNT(td_file%t_dim(:)%l_use)
	1628
[5037]	1629	td_file%t_dim(il_ind)%i_id=td_file%i_ndim
	1630	td_file%t_dim(il_ind)%l_use=.TRUE.
	1631	ENDIF
[4213]	1632	ENDIF
[5037]	1633
[4213]	1634	ELSE
	1635	CALL logger_error( &
[5037]	1636	& " FILE ADD DIM: too much dimension in file "//&
[4213]	1637	& TRIM(td_file%c_name)//" ("//TRIM(fct_str(td_file%i_ndim))//")")
	1638	ENDIF
	1639
	1640	ENDIF
	1641
	1642	END SUBROUTINE file_add_dim
[12080]	1643	!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
	1644	SUBROUTINE file_del_dim(td_file, td_dim)
[4213]	1645	!-------------------------------------------------------------------
	1646	!> @brief This subroutine delete a dimension structure in file
[5037]	1647	!> structure.
	1648	!>
[4213]	1649	!> @author J.Paul
[5617]	1650	!> @date November, 2013 - Initial Version
[12080]	1651	!> @date January, 2019
	1652	!> - clean dimension structure
	1653	!>
[5037]	1654	!> @param[inout] td_file file structure
	1655	!> @param[in] td_dim dimension structure
[4213]	1656	!-------------------------------------------------------------------
[12080]	1657
[4213]	1658	IMPLICIT NONE
	1659
	1660	! Argument
[5037]	1661	TYPE(TFILE) , INTENT(INOUT) :: td_file
	1662	TYPE(TDIM) , INTENT(IN ) :: td_dim
[4213]	1663
	1664	! local variable
	1665	INTEGER(i4) :: il_status
[5037]	1666	INTEGER(i4) :: il_ind
	1667
[4213]	1668	TYPE(TDIM), DIMENSION(:), ALLOCATABLE :: tl_dim
[5037]	1669
	1670	! loop indices
	1671	INTEGER(i4) :: ji
[4213]	1672	!----------------------------------------------------------------
	1673	! check if file opened
	1674	IF( TRIM(td_file%c_name) == '' )THEN
	1675
[5037]	1676	CALL logger_error( " FILE DEL DIM: file structure unknown ")
	1677	CALL logger_debug( " FILE DEL DIM: you should have used "//&
	1678	& "file_init before running file_del_dim" )
[4213]	1679
	1680	ELSE
	1681
[5037]	1682	! check if dimension already in file structure
	1683	il_ind=dim_get_index(td_file%t_dim(:), td_dim%c_sname)
	1684	IF( il_ind == 0 )THEN
[4213]	1685
[5037]	1686	CALL logger_error( &
	1687	& "FILE DEL DIM: no dimension "//TRIM(td_dim%c_name)//&
	1688	& ", short name "//TRIM(td_dim%c_sname)//&
	1689	& ", in file "//TRIM(td_file%c_name) )
[4213]	1690
[5037]	1691	ELSE
	1692	ALLOCATE( tl_dim(td_file%i_ndim-1), stat=il_status )
	1693	IF(il_status /= 0 )THEN
	1694
[4213]	1695	CALL logger_error( &
[5037]	1696	& "FILE DEL DIM: not enough space to put dimensions from "//&
	1697	& TRIM(td_file%c_name)//" in temporary dimension structure")
[4213]	1698
[5037]	1699	ELSE
	1700	! save temporary dimension's mpp structure
	1701	tl_dim( 1 : il_ind-1 ) = dim_copy(td_file%t_dim(1 : il_ind-1))
	1702	tl_dim( il_ind : td_file%i_ndim-1 ) = &
	1703	& dim_copy(td_file%t_dim(il_ind+1 : td_file%i_ndim))
[4213]	1704
[5037]	1705	! remove dimension from file
	1706	CALL dim_clean(td_file%t_dim(:))
	1707	! copy dimension in file, except one
	1708	td_file%t_dim(1:td_file%i_ndim)=dim_copy(tl_dim(:))
[4213]	1709
[5037]	1710	! update number of dimension
	1711	td_file%i_ndim=td_file%i_ndim-1
[4213]	1712
[5037]	1713	! update dimension id
	1714	DO ji=1,td_file%i_ndim
	1715	td_file%t_dim(ji)%i_id=ji
	1716	ENDDO
[4213]	1717
[5037]	1718	! clean
	1719	CALL dim_clean(tl_dim(:))
[4213]	1720	ENDIF
[12080]	1721	DEALLOCATE(tl_dim)
	1722
[4213]	1723	ENDIF
	1724	ENDIF
	1725
	1726	END SUBROUTINE file_del_dim
[12080]	1727	!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
	1728	SUBROUTINE file_move_dim(td_file, td_dim)
[4213]	1729	!-------------------------------------------------------------------
	1730	!> @brief This subroutine move a dimension structure
	1731	!> in file structure.
[5037]	1732	!> @warning change dimension order in file structure.
[12080]	1733	!>
[4213]	1734	!> @author J.Paul
[5617]	1735	!> @date November, 2013 - Initial Version
[12080]	1736	!>
[5037]	1737	!> @param[inout] td_file file structure
	1738	!> @param[in] td_dim dimension structure
[4213]	1739	!-------------------------------------------------------------------
[12080]	1740
[4213]	1741	IMPLICIT NONE
	1742
	1743	! Argument
[5037]	1744	TYPE(TFILE) , INTENT(INOUT) :: td_file
	1745	TYPE(TDIM) , INTENT(IN ) :: td_dim
[4213]	1746
	1747	! local variable
[5037]	1748	INTEGER(i4) :: il_ind
[4213]	1749	INTEGER(i4) :: il_dimid
	1750	!----------------------------------------------------------------
[5037]	1751	IF( td_file%i_ndim <= ip_maxdim )THEN
[4213]	1752
[5037]	1753	! check if dimension already in mpp structure
	1754	il_ind=dim_get_index(td_file%t_dim(:), td_dim%c_name, td_dim%c_sname)
	1755	IF( il_ind /= 0 )THEN
[4213]	1756
[5037]	1757	il_dimid=td_file%t_dim(il_ind)%i_id
	1758	! replace dimension
	1759	td_file%t_dim(il_ind)=dim_copy(td_dim)
	1760	td_file%t_dim(il_ind)%i_id=il_dimid
	1761	td_file%t_dim(il_ind)%l_use=.TRUE.
	1762
	1763	ELSE
	1764	CALL file_add_dim(td_file, td_dim)
	1765	ENDIF
	1766
	1767	ELSE
	1768	CALL logger_error( &
	1769	& "FILE MOVE DIM: too much dimension in mpp "//&
	1770	& TRIM(td_file%c_name)//" ("//TRIM(fct_str(td_file%i_ndim))//")")
[4213]	1771	ENDIF
	1772
	1773	END SUBROUTINE file_move_dim
[12080]	1774	!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
	1775	SUBROUTINE file_print(td_file)
[4213]	1776	!-------------------------------------------------------------------
	1777	!> @brief This subroutine print some information about file strucutre.
[12080]	1778	!>
[4213]	1779	!> @author J.Paul
[5617]	1780	!> @date November, 2013 - Initial Version
[12080]	1781	!>
[5037]	1782	!> @param[in] td_file file structure
[4213]	1783	!-------------------------------------------------------------------
[12080]	1784
[4213]	1785	IMPLICIT NONE
	1786
	1787	! Argument
	1788	TYPE(TFILE), INTENT(IN) :: td_file
	1789
	1790	! local variable
	1791	CHARACTER(LEN=lc) :: cl_mode
	1792
	1793	! loop indices
	1794	INTEGER(i4) :: ji
	1795	!----------------------------------------------------------------
	1796
	1797	cl_mode='READ'
	1798	IF( td_file%l_wrt ) cl_mode='WRITE'
	1799
	1800	WRITE(*,'((a,a),2(/3x,a,a),4(/3x,a,i0))')&
	1801	& "File : ",TRIM(td_file%c_name), &
	1802	& " type : ",TRIM(td_file%c_type), &
	1803	& " mode : ",TRIM(cl_mode), &
	1804	& " id : ",td_file%i_id, &
	1805	& " ndim : ",td_file%i_ndim, &
	1806	& " natt : ",td_file%i_natt, &
	1807	& " nvar : ",td_file%i_nvar
	1808
	1809	SELECT CASE(TRIM(td_file%c_type))
	1810	CASE('cdf')
	1811	WRITE(*,'((/3x,a,a),(/3x,a,i3))')&
	1812	& "define mode : ",TRIM(fct_str(td_file%l_def)),&
	1813	& "unlimited id : ",td_file%i_uldid
	1814	CASE('dimg')
	1815	WRITE(*,'(5(/3x,a,i0))')&
	1816	& " record length : ",td_file%i_recl, &
	1817	& " n0d : ",td_file%i_n0d, &
	1818	& " n1d : ",td_file%i_n1d, &
	1819	& " n2d : ",td_file%i_n2d, &
	1820	& " n3d : ",td_file%i_n3d
	1821	END SELECT
	1822
	1823	! print dimension
	1824	IF( td_file%i_ndim /= 0 )THEN
	1825	WRITE(*,'(/a)') " File dimension"
	1826	DO ji=1,ip_maxdim
	1827	IF( td_file%t_dim(ji)%l_use )THEN
	1828	CALL dim_print(td_file%t_dim(ji))
	1829	ENDIF
	1830	ENDDO
	1831	ENDIF
	1832
	1833	! print global attribute
	1834	IF( td_file%i_natt /= 0 )THEN
	1835	WRITE(*,'(/a)') " File attribute"
	1836	DO ji=1,td_file%i_natt
	1837	CALL att_print(td_file%t_att(ji))
	1838	ENDDO
	1839	ENDIF
	1840
	1841	! print variable
	1842	IF( td_file%i_nvar /= 0 )THEN
	1843	WRITE(*,'(/a)') " File variable"
	1844	DO ji=1,td_file%i_nvar
[5609]	1845	CALL var_print(td_file%t_var(ji),.FALSE.)
[4213]	1846	ENDDO
	1847	ENDIF
	1848
	1849	END SUBROUTINE file_print
[12080]	1850	!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
	1851	FUNCTION file__get_suffix(cd_file) &
	1852	& RESULT (cf_suffix)
[4213]	1853	!-------------------------------------------------------------------
	1854	!> @brief This function get suffix of file name.
	1855	!> @details
	1856	!> we assume suffix is define as alphanumeric character following the
[5037]	1857	!> last '.' in file name.<br/>
[4213]	1858	!> If no suffix is found, return empty character.
[12080]	1859	!>
[4213]	1860	!> @author J.Paul
[5617]	1861	!> @date November, 2013 - Initial Version
[12080]	1862	!>
[5037]	1863	!> @param[in] cd_file file structure
[4213]	1864	!> @return suffix
	1865	!-------------------------------------------------------------------
[12080]	1866
[4213]	1867	IMPLICIT NONE
	1868
	1869	! Argument
	1870	CHARACTER(LEN=*), INTENT(IN) :: cd_file
	1871
[12080]	1872	! function
	1873	CHARACTER(LEN=lc) :: cf_suffix
	1874
[4213]	1875	! local variable
	1876	INTEGER(i4) :: il_ind
	1877	!----------------------------------------------------------------
	1878
[5037]	1879	CALL logger_trace( "FILE GET SUFFIX: look for suffix in file name "//&
[4213]	1880	& TRIM(cd_file) )
	1881
	1882	il_ind=INDEX(TRIM(cd_file),'.',BACK=.TRUE.)
	1883	IF( il_ind /= 0 )THEN
	1884	! read number in basename
[12080]	1885	READ( cd_file(il_ind:),'(a)' ) cf_suffix
[4213]	1886
[12080]	1887	IF( fct_is_num(cf_suffix(2:)) )THEN
	1888	cf_suffix=''
[4213]	1889	ENDIF
	1890
	1891	ELSE
[12080]	1892	cf_suffix=''
[4213]	1893	ENDIF
	1894
	1895	END FUNCTION file__get_suffix
[12080]	1896	!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
	1897	FUNCTION file__get_number(cd_file) &
	1898	& RESULT (cf_number)
[4213]	1899	!-------------------------------------------------------------------
	1900	!> @brief This function get number in file name without suffix.
	1901	!> @details
	1902	!> Actually it get the number following the last separator.
[5037]	1903	!> separator could be '.' or '_'.
[12080]	1904	!>
[4213]	1905	!> @author J.Paul
[5609]	1906	!> @date November, 2013 - Initial Version
	1907	!> @date February, 2015
	1908	!> - add case to not return date (yyyymmdd) at the end of filename
	1909	!> @date February, 2015
	1910	!> - add case to not return release number
	1911	!> we assume release number only on one digit (ex : file_v3.5.nc)
[12080]	1912	!>
[5037]	1913	!> @param[in] cd_file file name (without suffix)
	1914	!> @return character file number.
[4213]	1915	!-------------------------------------------------------------------
[12080]	1916
[4213]	1917	IMPLICIT NONE
	1918
	1919	! Argument
	1920	CHARACTER(LEN=lc), INTENT(IN) :: cd_file
	1921
[12080]	1922	! function
	1923	CHARACTER(LEN=lc) :: cf_number
	1924
[4213]	1925	! local variable
	1926	INTEGER(i4) :: il_indmax
	1927	INTEGER(i4) :: il_ind
	1928
	1929	! loop indices
	1930	INTEGER(i4) :: ji
	1931	!----------------------------------------------------------------
	1932
	1933	! get number position in file name
	1934	il_indmax=0
[5037]	1935	DO ji=1,ip_nsep
	1936	il_ind=INDEX(TRIM(cd_file),TRIM(cp_sep(ji)),BACK=.TRUE.)
[4213]	1937	IF( il_ind > il_indmax )THEN
	1938	il_indmax=il_ind
	1939	ENDIF
	1940	ENDDO
	1941
	1942	IF( il_indmax /= 0 )THEN
	1943	! read number in basename
[12080]	1944	READ( cd_file(il_indmax:),'(a)' ) cf_number
[4213]	1945
[12080]	1946	IF( .NOT. fct_is_num(cf_number(2:)) )THEN
	1947	cf_number=''
	1948	ELSEIF( LEN(TRIM(cf_number))-1 == 8 )THEN
[5609]	1949	! date case yyyymmdd
[12080]	1950	cf_number=''
	1951	ELSEIF( LEN(TRIM(cf_number))-1 == 1 )THEN
[5609]	1952	! release number case
[12080]	1953	cf_number=''
[4213]	1954	ENDIF
	1955	ELSE
[12080]	1956	cf_number=''
[4213]	1957	ENDIF
	1958
	1959	END FUNCTION file__get_number
[12080]	1960	!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
	1961	FUNCTION file__rename_char(cd_file, id_num) &
	1962	& RESULT (cf_file)
[4213]	1963	!-------------------------------------------------------------------
[5037]	1964	!> @brief This function rename file name, given processor number.
[4213]	1965	!> @details
	1966	!> If no processor number is given, return file name without number
	1967	!> If processor number is given, return file name with new number
[12080]	1968	!>
[4213]	1969	!> @author J.Paul
[5617]	1970	!> @date November, 2013 - Initial Version
[12080]	1971	!>
[5037]	1972	!> @param[in] td_file file structure
	1973	!> @param[in] id_num processor number (start to 1)
	1974	!> @return file name
[4213]	1975	!-------------------------------------------------------------------
[12080]	1976
[4213]	1977	IMPLICIT NONE
	1978
	1979	! Argument
	1980	CHARACTER(LEN=*), INTENT(IN) :: cd_file
	1981	INTEGER(i4), INTENT(IN), OPTIONAL :: id_num
	1982
[12080]	1983	! function
	1984	CHARACTER(LEN=lc) :: cf_file
	1985
[4213]	1986	! local variable
	1987	CHARACTER(LEN=lc) :: cl_suffix
	1988	CHARACTER(LEN=lc) :: cl_file
	1989	CHARACTER(LEN=lc) :: cl_number
	1990	CHARACTER(LEN=lc) :: cl_base
	1991	CHARACTER(LEN=lc) :: cl_sep
	1992	CHARACTER(LEN=lc) :: cl_format
	1993	INTEGER(i4) :: il_ind
	1994	INTEGER(i4) :: il_numlen
	1995	!----------------------------------------------------------------
	1996
	1997	! get suffix
	1998	cl_suffix=file__get_suffix(cd_file)
	1999	IF( TRIM(cl_suffix) /= '' )THEN
	2000	il_ind=INDEX(TRIM(cd_file),TRIM(cl_suffix(1:1)),BACK=.TRUE.)
	2001	cl_file=TRIM(cd_file(:il_ind-1))
	2002	ELSE
	2003	cl_file=TRIM(cd_file)
	2004	ENDIF
	2005
	2006	cl_number=file__get_number(cl_file)
	2007	IF( TRIM(cl_number) /= '' )THEN
	2008	il_ind=INDEX(TRIM(cl_file),TRIM(cl_number(1:1)),BACK=.TRUE.)
	2009	cl_base=TRIM(cl_file(:il_ind-1))
	2010
	2011	cl_sep=TRIM(cl_number(1:1))
	2012	il_numlen=LEN(TRIM(cl_number))-1
	2013	ELSE
	2014	cl_base=TRIM(cl_file)
	2015	il_numlen=4
	2016	cl_sep='_'
	2017	ENDIF
	2018
	2019	IF( PRESENT(id_num) )THEN
	2020	! format
	2021	WRITE(cl_format,'(a,i1.1,a,i1.1,a)') '(a,a,i',il_numlen,'.',il_numlen,',a)'
[12080]	2022	WRITE(cf_file,cl_format) TRIM(cl_base),TRIM(cl_sep),id_num,TRIM(cl_suffix)
[4213]	2023	ELSE
[12080]	2024	WRITE(cf_file,'(a,a)') TRIM(cl_base),TRIM(cl_suffix)
[4213]	2025	ENDIF
[12080]	2026	CALL logger_trace(" FILE RENAME : "//TRIM(cf_file))
[4213]	2027
	2028	END FUNCTION file__rename_char
[12080]	2029	!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
	2030	FUNCTION file__rename_str(td_file, id_num) &
	2031	& RESULT (tf_file)
[4213]	2032	!-------------------------------------------------------------------
	2033	!> @brief This function rename file name, given file structure.
	2034	!> @details
	2035	!> If no processor number is given, return file name without number
	2036	!> I processor number is given, return file name with new number
[12080]	2037	!>
[4213]	2038	!> @author J.Paul
[5617]	2039	!> @date November, 2013 - Initial Version
[12080]	2040	!>
[5037]	2041	!> @param[in] td_file file structure
	2042	!> @param[in] id_num processor number (start to 1)
[4213]	2043	!> @return file structure
	2044	!-------------------------------------------------------------------
[12080]	2045
[4213]	2046	IMPLICIT NONE
	2047
	2048	! Argument
	2049	TYPE(TFILE), INTENT(IN) :: td_file
	2050	INTEGER(i4), INTENT(IN), OPTIONAL :: id_num
	2051
[12080]	2052	! function
	2053	TYPE(TFILE) :: tf_file
	2054
[4213]	2055	! local variable
	2056	CHARACTER(LEN=lc) :: cl_name
	2057	!----------------------------------------------------------------
	2058
	2059	! change name
	2060	cl_name=TRIM( file_rename(td_file%c_name, id_num) )
	2061
[12080]	2062	tf_file=file_init(TRIM(cl_name), TRIM(td_file%c_type))
[4213]	2063
	2064	END FUNCTION file__rename_str
[12080]	2065	!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
	2066	FUNCTION file_add_suffix(cd_file, cd_type) &
	2067	& RESULT (cf_file)
[4213]	2068	!-------------------------------------------------------------------
	2069	!> @brief This function add suffix to file name.
[12080]	2070	!>
[4213]	2071	!> @author J.Paul
[5617]	2072	!> @date November, 2013 - Initial Version
[12080]	2073	!>
[5037]	2074	!> @param[in] td_file file structure
	2075	!> @return file name
[4213]	2076	!-------------------------------------------------------------------
[12080]	2077
[4213]	2078	IMPLICIT NONE
	2079
	2080	! Argument
	2081	CHARACTER(LEN=*), INTENT(IN) :: cd_file
	2082	CHARACTER(LEN=*), INTENT(IN) :: cd_type
	2083
[12080]	2084	! function
	2085	CHARACTER(LEN=lc) :: cf_file
	2086
[4213]	2087	! local variable
	2088	INTEGER(i4) :: il_ind
	2089	CHARACTER(LEN=lc) :: cl_file
	2090	CHARACTER(LEN=lc) :: cl_suffix
	2091	!----------------------------------------------------------------
[12080]	2092
[4213]	2093	! get suffix
	2094	cl_suffix=file__get_suffix(cd_file)
	2095	IF( TRIM(cl_suffix) /= '' )THEN
	2096	il_ind=INDEX(TRIM(cd_file),TRIM(cl_suffix(1:1)),BACK=.TRUE.)
	2097	cl_file=TRIM(cd_file(:il_ind-1))
	2098	ELSE
	2099	cl_file=TRIM(cd_file)
	2100	ENDIF
	2101
	2102	SELECT CASE(TRIM(cd_type))
	2103	CASE('cdf')
[12080]	2104	cf_file=TRIM(cl_file)//TRIM(cl_suffix)
[4213]	2105	CASE('dimg')
	2106	IF( TRIM(cl_suffix) /= '' )THEN
[12080]	2107	cf_file=TRIM(cl_file)//'.dimg'
[4213]	2108	ELSE
[12080]	2109	cf_file=TRIM(cl_file)
[4213]	2110	ENDIF
	2111	CASE DEFAULT
[5037]	2112	CALL logger_error(" FILE ADD SUFFIX: type unknown "//TRIM(cd_type))
[4213]	2113	END SELECT
	2114
	2115	END FUNCTION file_add_suffix
[12080]	2116	!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
	2117	SUBROUTINE file__clean_unit(td_file)
[4213]	2118	!-------------------------------------------------------------------
	2119	!> @brief
[5037]	2120	!> This subroutine clean file strcuture.
[12080]	2121	!>
[4213]	2122	!> @author J.Paul
[5037]	2123	!> @date November, 2013 - Inital version
[12080]	2124	!> @date January, 2019
	2125	!> - nullify attribute structure inside file structure
	2126	!> - nullify variable structure inside file structure
	2127	!>
[5037]	2128	!> @param[inout] td_file file strcuture
[4213]	2129	!-------------------------------------------------------------------
[12080]	2130
[4213]	2131	IMPLICIT NONE
[12080]	2132
[4213]	2133	! Argument
	2134	TYPE(TFILE), INTENT(INOUT) :: td_file
	2135
	2136	! local variable
	2137	TYPE(TFILE) :: tl_file ! empty file structure
	2138
	2139	! loop indices
	2140	!----------------------------------------------------------------
	2141
[5037]	2142	CALL logger_trace( &
	2143	& " FILE CLEAN: reset file "//TRIM(td_file%c_name) )
[4213]	2144
	2145	! del attribute
	2146	IF( ASSOCIATED( td_file%t_att ) )THEN
[5037]	2147	CALL att_clean( td_file%t_att(:) )
	2148	DEALLOCATE(td_file%t_att)
[12080]	2149	NULLIFY(td_file%t_att)
[4213]	2150	ENDIF
	2151
	2152	! del dimension
	2153	IF( td_file%i_ndim /= 0 )THEN
[5037]	2154	CALL dim_clean( td_file%t_dim(:) )
[4213]	2155	ENDIF
	2156
	2157	! del variable
	2158	IF( ASSOCIATED( td_file%t_var ) )THEN
[5037]	2159	CALL var_clean( td_file%t_var(:) )
	2160	DEALLOCATE(td_file%t_var)
[12080]	2161	NULLIFY(td_file%t_var)
[4213]	2162	ENDIF
	2163
	2164	! replace by empty structure
[5037]	2165	td_file=file_copy(tl_file)
[4213]	2166
[5037]	2167	END SUBROUTINE file__clean_unit
[12080]	2168	!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
	2169	SUBROUTINE file__clean_arr(td_file)
[4213]	2170	!-------------------------------------------------------------------
[5037]	2171	!> @brief
	2172	!> This subroutine clean file array of file strcuture.
[12080]	2173	!>
[4213]	2174	!> @author J.Paul
[5037]	2175	!> @date Marsh, 2014 - Inital version
[12080]	2176	!>
[5037]	2177	!> @param[inout] td_file array file strcuture
[4213]	2178	!-------------------------------------------------------------------
[12080]	2179
[5037]	2180	IMPLICIT NONE
[12080]	2181
[5037]	2182	! Argument
	2183	TYPE(TFILE), DIMENSION(:), INTENT(INOUT) :: td_file
	2184
	2185	! local variable
	2186	! loop indices
	2187	INTEGER(i4) :: ji
	2188	!----------------------------------------------------------------
	2189
	2190	DO ji=SIZE(td_file(:)),1,-1
	2191	CALL file_clean(td_file(ji))
	2192	ENDDO
	2193
	2194	END SUBROUTINE file__clean_arr
[12080]	2195	!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
	2196	FUNCTION file_get_id(td_file, cd_name) &
	2197	& RESULT (if_id)
[5037]	2198	!-------------------------------------------------------------------
	2199	!> @brief This function return the file id, in a array of file
	2200	!> structure, given file name.
[12080]	2201	!>
[5037]	2202	!> @author J.Paul
[5617]	2203	!> @date November, 2013 - Initial Version
[12080]	2204	!>
[5037]	2205	!> @param[in] td_file array of file structure
	2206	!> @param[in] cd_name file name
	2207	!> @return file id in array of file structure (0 if not found)
	2208	!-------------------------------------------------------------------
[12080]	2209
[4213]	2210	IMPLICIT NONE
[12080]	2211
[4213]	2212	! Argument
	2213	TYPE(TFILE) , DIMENSION(:), INTENT(IN) :: td_file
	2214	CHARACTER(LEN=*), INTENT(IN) :: cd_name
	2215
[12080]	2216	! function
	2217	INTEGER(i4) :: if_id
	2218
[4213]	2219	! local variable
	2220	INTEGER(i4) :: il_size
	2221
	2222	! loop indices
	2223	INTEGER(i4) :: ji
	2224	!----------------------------------------------------------------
[12080]	2225	if_id=0
[4213]	2226	il_size=SIZE(td_file(:))
	2227
[5037]	2228	! check if file is in array of file structure
[4213]	2229	DO ji=1,il_size
	2230	! look for file name
	2231	IF( fct_lower(td_file(ji)%c_name) == fct_lower(cd_name) )THEN
	2232
[12080]	2233	if_id=td_file(ji)%i_id
[4213]	2234	EXIT
	2235
	2236	ENDIF
	2237	ENDDO
	2238
	2239	END FUNCTION file_get_id
[12080]	2240	!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
	2241	FUNCTION file_get_unit(td_file) &
	2242	& RESULT (if_unit)
[5037]	2243	!-------------------------------------------------------------------
	2244	!> @brief
	2245	!> This function get the next unused unit in array of file structure.
	2246	!>
	2247	!> @author J.Paul
[5617]	2248	!> @date September, 2014 - Initial Version
[12080]	2249	!>
[5037]	2250	!> @param[in] td_file array of file
	2251	!-------------------------------------------------------------------
[12080]	2252
[5037]	2253	IMPLICIT NONE
[12080]	2254
[5037]	2255	! Argument
	2256	TYPE(TFILE), DIMENSION(:), INTENT(IN ) :: td_file
	2257
	2258	! function
[12080]	2259	INTEGER(i4) :: if_unit
[5037]	2260
	2261	! local variable
	2262	! loop indices
	2263	!----------------------------------------------------------------
	2264
[12080]	2265	if_unit=MAXVAL(td_file(:)%i_id)+1
[5037]	2266
	2267	END FUNCTION file_get_unit
[12080]	2268	!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
[4213]	2269	END MODULE file
	2270

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

Download in other formats: