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

Context Navigation

source: branches/2014/dev_r4650_UKMO11_restart_functionality/NEMOGCM/TOOLS/SIREN/src/file.f90 @ 5316

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

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

Download in other formats: