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 branches/2014/dev_r4650_UKMO14.4_OBS_GENERAL_VINTERP/NEMOGCM/TOOLS/SIREN/src – NEMO

Context Navigation

source: branches/2014/dev_r4650_UKMO14.4_OBS_GENERAL_VINTERP/NEMOGCM/TOOLS/SIREN/src/file.f90 @ 5951

Last change on this file since 5951 was 5951, checked in by timgraham, 8 years ago
Merged trunk r5936 into branch
Property svn:keywords set to `Id`
File size: 72.8 KB

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

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

Download in other formats: