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.

mpp.f90 in branches/2014/dev_r4650_UKMO14.12_STAND_ALONE_OBSOPER/NEMOGCM/TOOLS/SIREN/src – NEMO

Context Navigation

source: branches/2014/dev_r4650_UKMO14.12_STAND_ALONE_OBSOPER/NEMOGCM/TOOLS/SIREN/src/mpp.f90 @ 5600

Last change on this file since 5600 was 5600, checked in by andrewryan, 9 years ago
merged in latest version of trunk alongside changes to SAO_SRC to be compatible with latest OBS
File size: 127.7 KB

Rev	Line
[4213]	1	!----------------------------------------------------------------------
	2	! NEMO system team, System and Interface for oceanic RElocable Nesting
	3	!----------------------------------------------------------------------
	4	!
	5	! MODULE: mpp
	6	!
	7	! DESCRIPTION:
[5600]	8	!> @brief
	9	!> This module manage massively parallel processing.
[4213]	10	!
	11	!> @details
	12	!> define type TMPP:<br/>
[5600]	13	!> @code
	14	!> TYPE(TMPP) :: tl_mpp
	15	!> @endcode
[4213]	16	!>
	17	!> to initialise a mpp structure:<br/>
[5600]	18	!> @code
	19	!> tl_mpp=mpp_init( cd_file, id_mask,
	20	!> [id_niproc,] [id_njproc,] [id_nproc,]
	21	!> [id_preci,] [id_precj,]
	22	!> [cd_type,] [id_ew])
	23	!> @endcode
	24	!> or
	25	!> @code
	26	!> tl_mpp=mpp_init( cd_file, td_var,
	27	!> [id_niproc,] [id_njproc,] [id_nproc,]
	28	!> [id_preci,] [id_precj,]
	29	!> [cd_type] )
	30	!> @endcode
	31	!> or
	32	!> @code
	33	!> tl_mpp=mpp_init( td_file [,id_ew] )
	34	!> @endcode
[4213]	35	!> - cd_file is the filename of the global domain file, in which
	36	!> MPP will be done (example: Bathymetry)
	37	!> - td_file is the file structure of one processor file composing an MPP
[5600]	38	!> - id_mask is the 2D mask of global domain [optional]
[4213]	39	!> - td_var is a variable structure (on T-point) from global domain file.
[5600]	40	!> mask of the domain will be computed using FillValue [optional]
[4213]	41	!> - id_niproc is the number of processor following I-direction to be used
[5600]	42	!> [optional]
[4213]	43	!> - id_njproc is the number of processor following J-direction to be used
[5600]	44	!> [optional]
	45	!> - id_nproc is the total number of processor to be used [optional]
	46	!> - id_preci is the size of the overlap region following I-direction [optional]
	47	!> - id_precj is the size of the overlap region following J-direction [optional]
	48	!> - cd_type is the type of files composing MPP [optional]
	49	!> - id_ew is east-west overlap [optional]<br/>
[4213]	50	!>
	51	!> to get mpp name:<br/>
	52	!> - tl_mpp\%c_name
	53	!>
	54	!> to get the total number of processor:<br/>
	55	!> - tl_mpp\%i_nproc
	56	!>
	57	!> to get the number of processor following I-direction:<br/>
	58	!> - tl_mpp\%i_niproc
	59	!>
	60	!> to get the number of processor following J-direction:<br/>
	61	!> - tl_mpp\%i_njproc
	62	!>
	63	!> to get the length of the overlap region following I-direction:<br/>
	64	!> - tl_mpp\%i_preci
	65	!>
	66	!> to get the length of the overlap region following J-direction:<br/>
	67	!> - tl_mpp\%i_precj
	68	!>
	69	!> to get the type of files composing mpp structure:<br/>
	70	!> - tl_mpp\%c_type
	71	!>
	72	!> to get the type of the global domain:<br/>
	73	!> - tl_mpp\%c_dom
	74	!>
	75	!> MPP dimensions (global domain)<br/>
	76	!> to get the number of dimensions to be used in mpp strcuture:<br/>
	77	!> - tl_mpp\%i_ndim
	78	!>
[5600]	79	!> to get the array of dimension structure (4 elts) associated to the
[4213]	80	!> mpp structure:<br/>
	81	!> - tl_mpp\%t_dim(:)
	82	!>
	83	!> MPP processor (files composing domain)<br/>
	84	!> - tl_mpp\%t_proc(:)
	85	!>
	86	!> to clean a mpp structure:<br/>
[5600]	87	!> @code
	88	!> CALL mpp_clean(tl_mpp)
	89	!> @endcode
[4213]	90	!>
	91	!> to print information about mpp:<br/>
[5600]	92	!> @code
[4213]	93	!> CALL mpp_print(tl_mpp)
[5600]	94	!> @endcode
[4213]	95	!>
	96	!> to add variable to mpp:<br/>
[5600]	97	!> @code
[4213]	98	!> CALL mpp_add_var(td_mpp, td_var)
[5600]	99	!> @endcode
[4213]	100	!> - td_var is a variable structure
	101	!>
	102	!> to add dimension to mpp:<br/>
[5600]	103	!> @code
[4213]	104	!> CALL mpp_add_dim(td_mpp, td_dim)
[5600]	105	!> @endcode
[4213]	106	!> - td_dim is a dimension structure
	107	!>
[5600]	108	!> to add attribute to mpp:<br/>
	109	!> @code
	110	!> CALL mpp_add_att(td_mpp, td_att)
	111	!> @endcode
	112	!> - td_att is a attribute structure
	113	!>
	114	!> to delete variable from mpp:<br/>
	115	!> @code
[4213]	116	!> CALL mpp_del_var(td_mpp, td_var)
[5600]	117	!> @endcode
	118	!> or
	119	!> @code
	120	!> CALL mpp_del_var(td_mpp, cd_name)
	121	!> @endcode
[4213]	122	!> - td_var is a variable structure
[5600]	123	!> - cd_name is variable name or standard name
[4213]	124	!>
[5600]	125	!> to delete dimension from mpp:<br/>
	126	!> @code
[4213]	127	!> CALL mpp_del_dim(td_mpp, td_dim)
[5600]	128	!> @endcode
[4213]	129	!> - td_dim is a dimension structure
	130	!>
[5600]	131	!> to delete attribute from mpp:<br/>
	132	!> @code
	133	!> CALL mpp_del_att(td_mpp, td_att)
	134	!> @endcode
	135	!> or
	136	!> @code
	137	!> CALL mpp_del_att(td_mpp, cd_name)
	138	!> @endcode
	139	!> - td_att is a attribute structure
	140	!> - cd_name is attribute name
	141	!>
[4213]	142	!> to overwrite variable to mpp:<br/>
[5600]	143	!> @code
[4213]	144	!> CALL mpp_move_var(td_mpp, td_var)
[5600]	145	!> @endcode
[4213]	146	!> - td_var is a variable structure
	147	!>
	148	!> to overwrite dimension to mpp:<br/>
[5600]	149	!> @code
[4213]	150	!> CALL mpp_move_dim(td_mpp, td_dim)
[5600]	151	!> @endcode
[4213]	152	!> - td_dim is a dimension structure
	153	!>
[5600]	154	!> to overwrite attribute to mpp:<br/>
	155	!> @code
	156	!> CALL mpp_move_att(td_mpp, td_att)
	157	!> @endcode
	158	!> - td_att is a attribute structure
	159	!>
[4213]	160	!> to determine domain decomposition type:<br/>
[5600]	161	!> @code
[4213]	162	!> CALL mpp_get_dom(td_mpp)
[5600]	163	!> @endcode
[4213]	164	!>
	165	!> to get processors to be used:<br/>
[5600]	166	!> @code
	167	!> CALL mpp_get_use( td_mpp, id_imin, id_imax, id_idim, &
	168	!> & id_jmin, id_jmax, id_jdim )
	169	!> @endcode
	170	!> - id_imin
	171	!> - id_imax
	172	!> - id_idim
	173	!> - id_jmin
	174	!> - id_jmax
	175	!> - id_jdim
[4213]	176	!>
	177	!> to get sub domains which form global domain contour:<br/>
[5600]	178	!> @code
[4213]	179	!> CALL mpp_get_contour( td_mpp )
[5600]	180	!> @endcode
[4213]	181	!>
	182	!> to get global domain indices of one processor:<br/>
[5600]	183	!> @code
[4213]	184	!> il_ind(1:4)=mpp_get_proc_index( td_mpp, id_procid )
[5600]	185	!> @endcode
[4213]	186	!> - il_ind(1:4) are global domain indices (i1,i2,j1,j2)
	187	!> - id_procid is the processor id
	188	!>
	189	!> to get the processor domain size:<br/>
[5600]	190	!> @code
[4213]	191	!> il_size(1:2)=mpp_get_proc_size( td_mpp, id_procid )
[5600]	192	!> @endcode
[4213]	193	!> - il_size(1:2) are the size of domain following I and J
	194	!> - id_procid is the processor id
	195	!>
	196	!> @author
	197	!> J.Paul
	198	! REVISION HISTORY:
[5600]	199	!> @date November, 2013 - Initial Version
	200	!> @date November, 2014 - Fix memory leaks bug
[4213]	201	!
	202	!> @note Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
	203	!----------------------------------------------------------------------
	204	MODULE mpp
[5600]	205	USE global ! global parameter
[4213]	206	USE kind ! F90 kind parameter
[5600]	207	USE logger ! log file manager
[4213]	208	USE fct ! basic useful function
	209	USE dim ! dimension manager
	210	USE att ! attribute manager
	211	USE var ! variable manager
	212	USE file ! file manager
	213	USE iom ! I/O manager
	214	IMPLICIT NONE
	215	! NOTE_avoid_public_variables_if_possible
	216
	217	! type and variable
[5600]	218	PUBLIC :: TMPP !< mpp structure
[4213]	219
	220	! function and subroutine
[5600]	221	PUBLIC :: mpp_copy !< copy mpp structure
[4213]	222	PUBLIC :: mpp_init !< initialise mpp structure
	223	PUBLIC :: mpp_clean !< clean mpp strcuture
	224	PUBLIC :: mpp_print !< print information about mpp structure
	225	PUBLIC :: mpp_add_var !< split/add one variable strucutre in mpp structure
	226	PUBLIC :: mpp_add_dim !< add one dimension to mpp structure
	227	PUBLIC :: mpp_add_att !< add one attribute strucutre in mpp structure
	228	PUBLIC :: mpp_del_var !< delete one variable strucutre in mpp structure
	229	PUBLIC :: mpp_del_dim !< delete one dimension strucutre in mpp structure
	230	PUBLIC :: mpp_del_att !< delete one attribute strucutre in mpp structure
	231	PUBLIC :: mpp_move_var !< overwrite variable structure in mpp structure
	232	PUBLIC :: mpp_move_dim !< overwrite one dimension strucutre in mpp structure
	233	PUBLIC :: mpp_move_att !< overwrite one attribute strucutre in mpp structure
[5600]	234	PUBLIC :: mpp_recombine_var !< recombine variable from mpp structure
	235	PUBLIC :: mpp_get_index !< return index of mpp
[4213]	236
	237	PUBLIC :: mpp_get_dom !< determine domain decomposition type (full, overlap, noverlap)
	238	PUBLIC :: mpp_get_use !< get sub domains to be used (which cover "zoom domain")
	239	PUBLIC :: mpp_get_contour !< get sub domains which form global domain contour
	240	PUBLIC :: mpp_get_proc_index !< get processor domain indices
	241	PUBLIC :: mpp_get_proc_size !< get processor domain size
	242
[5600]	243	PRIVATE :: mpp__add_proc ! add one proc strucutre in mpp structure
	244	PRIVATE :: mpp__del_proc ! delete one proc strucutre in mpp structure
	245	PRIVATE :: mpp__del_proc_id ! delete one proc strucutre in mpp structure, given procesor id
	246	PRIVATE :: mpp__del_proc_str ! delete one proc strucutre in mpp structure, given procesor file structure
	247	PRIVATE :: mpp__move_proc ! overwrite proc strucutre in mpp structure
	248	PRIVATE :: mpp__compute ! compute domain decomposition
	249	PRIVATE :: mpp__del_land ! remove land sub domain from domain decomposition
	250	PRIVATE :: mpp__optimiz ! compute optimum domain decomposition
	251	PRIVATE :: mpp__land_proc ! check if processor is a land processor
	252	PRIVATE :: mpp__check_dim ! check mpp structure dimension with proc or variable dimension
	253	PRIVATE :: mpp__check_proc_dim ! check if processor and mpp structure use same dimension
	254	PRIVATE :: mpp__check_var_dim ! check if variable and mpp structure use same dimension
	255	PRIVATE :: mpp__del_var_name ! delete variable in mpp structure, given variable name
	256	PRIVATE :: mpp__del_var_mpp ! delete all variable in mpp structure
	257	PRIVATE :: mpp__del_var_str ! delete variable in mpp structure, given variable structure
	258	PRIVATE :: mpp__del_att_name ! delete variable in mpp structure, given variable name
	259	PRIVATE :: mpp__del_att_str ! delete variable in mpp structure, given variable structure
	260	PRIVATE :: mpp__split_var ! extract variable part that will be written in processor
	261	PRIVATE :: mpp__copy_unit ! copy mpp structure
	262	PRIVATE :: mpp__copy_arr ! copy array of mpp structure
	263	PRIVATE :: mpp__get_use_unit ! get sub domains to be used (which cover "zoom domain")
	264	PRIVATE :: mpp__init_mask ! initialise mpp structure, given file name
	265	PRIVATE :: mpp__init_var ! initialise mpp structure, given variable strcuture
	266	PRIVATE :: mpp__init_file ! initialise a mpp structure, given file structure
	267	PRIVATE :: mpp__init_file_cdf ! initialise a mpp structure with cdf file
	268	PRIVATE :: mpp__init_file_rstdimg ! initialise a mpp structure with rstdimg file
	269	PRIVATE :: mpp__clean_unit ! clean mpp strcuture
	270	PRIVATE :: mpp__clean_arr ! clean array of mpp strcuture
[4213]	271
[5600]	272	TYPE TMPP !< mpp structure
[4213]	273
	274	! general
[5600]	275	CHARACTER(LEN=lc) :: c_name = '' !< base name
	276	INTEGER(i4) :: i_id = 0 !< mpp id
[4213]	277
[5600]	278	INTEGER(i4) :: i_niproc = 0 !< number of processors following i
	279	INTEGER(i4) :: i_njproc = 0 !< number of processors following j
	280	INTEGER(i4) :: i_nproc = 0 !< total number of proccessors used
	281	INTEGER(i4) :: i_preci = 1 !< i-direction overlap region length
	282	INTEGER(i4) :: i_precj = 1 !< j-direction overlap region length
	283	INTEGER(i4) :: i_ew = -1 !< east-west overlap
	284	INTEGER(i4) :: i_perio = -1 !< NEMO periodicity index
	285	INTEGER(i4) :: i_pivot = -1 !< NEMO pivot point index F(0),T(1)
[4213]	286
[5600]	287	CHARACTER(LEN=lc) :: c_type = '' !< type of the files (cdf, cdf4, dimg)
	288	CHARACTER(LEN=lc) :: c_dom = '' !< type of domain (full, overlap, nooverlap)
[4213]	289
[5600]	290	INTEGER(i4) :: i_ndim = 0 !< number of dimensions used in mpp
	291	TYPE(TDIM), DIMENSION(ip_maxdim) :: t_dim !< global domain dimension
[4213]	292
[5600]	293	TYPE(TFILE), DIMENSION(:), POINTER :: t_proc => NULL() !< files/processors composing mpp
[4213]	294
	295	END TYPE
	296
[5600]	297	INTERFACE mpp_get_use
	298	MODULE PROCEDURE mpp__get_use_unit
	299	END INTERFACE mpp_get_use
	300
	301	INTERFACE mpp_clean
	302	MODULE PROCEDURE mpp__clean_unit
	303	MODULE PROCEDURE mpp__clean_arr
	304	END INTERFACE mpp_clean
	305
[4213]	306	INTERFACE mpp__check_dim
	307	MODULE PROCEDURE mpp__check_proc_dim !< check if processor and mpp structure use same dimension
	308	MODULE PROCEDURE mpp__check_var_dim !< check if variable and mpp structure use same dimension
	309	END INTERFACE mpp__check_dim
	310
	311	INTERFACE mpp__del_proc
	312	MODULE PROCEDURE mpp__del_proc_id
	313	MODULE PROCEDURE mpp__del_proc_str
	314	END INTERFACE mpp__del_proc
	315
	316	INTERFACE mpp_del_var
	317	MODULE PROCEDURE mpp__del_var_name
	318	MODULE PROCEDURE mpp__del_var_str
[5600]	319	MODULE PROCEDURE mpp__del_var_mpp
[4213]	320	END INTERFACE mpp_del_var
	321
	322	INTERFACE mpp_del_att
	323	MODULE PROCEDURE mpp__del_att_name
	324	MODULE PROCEDURE mpp__del_att_str
	325	END INTERFACE mpp_del_att
	326
	327	INTERFACE mpp_init
	328	MODULE PROCEDURE mpp__init_mask
	329	MODULE PROCEDURE mpp__init_var
[5600]	330	MODULE PROCEDURE mpp__init_file
[4213]	331	END INTERFACE mpp_init
	332
[5600]	333	INTERFACE mpp_copy
	334	MODULE PROCEDURE mpp__copy_unit ! copy mpp structure
	335	MODULE PROCEDURE mpp__copy_arr ! copy array of mpp structure
[4213]	336	END INTERFACE
	337
	338	CONTAINS
	339	!-------------------------------------------------------------------
	340	!> @brief
[5600]	341	!> This subroutine copy mpp structure in another one
[4213]	342	!> @details
[5600]	343	!> mpp file are copied in a temporary array,
[4213]	344	!> so input and output mpp structure do not point on the same
	345	!> "memory cell", and so on are independant.
	346	!>
[5600]	347	!> @warning do not use on the output of a function who create or read an
	348	!> structure (ex: tl_file=file_copy(file_init()) is forbidden).
	349	!> This will create memory leaks.
	350	!> @warning to avoid infinite loop, do not use any function inside
	351	!> this subroutine
	352	!>
[4213]	353	!> @author J.Paul
[5600]	354	!> - November, 2013- Initial Version
	355	!> @date November, 2014
	356	!> - use function instead of overload assignment operator
	357	!> (to avoid memory leak)
[4213]	358	!
[5600]	359	!> @param[in] td_mpp mpp structure
	360	!> @return copy of input mpp structure
[4213]	361	!-------------------------------------------------------------------
[5600]	362	FUNCTION mpp__copy_unit( td_mpp )
[4213]	363	IMPLICIT NONE
	364	! Argument
[5600]	365	TYPE(TMPP), INTENT(IN) :: td_mpp
	366	! function
	367	TYPE(TMPP) :: mpp__copy_unit
[4213]	368
[5600]	369	! local variable
	370	TYPE(TFILE) :: tl_file
	371
[4213]	372	! loop indices
	373	INTEGER(i4) :: ji
	374	!----------------------------------------------------------------
	375
[5600]	376	CALL logger_trace("MPP COPY: "//TRIM(td_mpp%c_name)//" in "//&
	377	& TRIM(mpp__copy_unit%c_name))
	378
[4213]	379	! copy mpp variable
[5600]	380	mpp__copy_unit%c_name = TRIM(td_mpp%c_name)
	381	mpp__copy_unit%i_niproc = td_mpp%i_niproc
	382	mpp__copy_unit%i_njproc = td_mpp%i_njproc
	383	mpp__copy_unit%i_nproc = td_mpp%i_nproc
	384	mpp__copy_unit%i_preci = td_mpp%i_preci
	385	mpp__copy_unit%i_precj = td_mpp%i_precj
	386	mpp__copy_unit%c_type = TRIM(td_mpp%c_type)
	387	mpp__copy_unit%c_dom = TRIM(td_mpp%c_dom)
	388	mpp__copy_unit%i_ndim = td_mpp%i_ndim
	389	mpp__copy_unit%i_ew = td_mpp%i_ew
	390	mpp__copy_unit%i_perio = td_mpp%i_perio
	391	mpp__copy_unit%i_pivot = td_mpp%i_pivot
[4213]	392
	393	! copy dimension
[5600]	394	mpp__copy_unit%t_dim(:) = dim_copy(td_mpp%t_dim(:))
[4213]	395
	396	! copy file structure
[5600]	397	IF( ASSOCIATED(mpp__copy_unit%t_proc) )THEN
	398	CALL file_clean(mpp__copy_unit%t_proc(:))
	399	DEALLOCATE(mpp__copy_unit%t_proc)
	400	ENDIF
	401	IF( ASSOCIATED(td_mpp%t_proc) .AND. mpp__copy_unit%i_nproc > 0 )THEN
	402	ALLOCATE( mpp__copy_unit%t_proc(mpp__copy_unit%i_nproc) )
	403	DO ji=1,mpp__copy_unit%i_nproc
	404	tl_file = file_copy(td_mpp%t_proc(ji))
	405	mpp__copy_unit%t_proc(ji) = file_copy(tl_file)
[4213]	406	ENDDO
[5600]	407	! clean
	408	CALL file_clean(tl_file)
[4213]	409	ENDIF
	410
[5600]	411	END FUNCTION mpp__copy_unit
[4213]	412	!-------------------------------------------------------------------
[5600]	413	!> @brief
	414	!> This subroutine copy an array of mpp structure in another one
	415	!> @details
	416	!> mpp file are copied in a temporary array,
	417	!> so input and output mpp structure do not point on the same
	418	!> "memory cell", and so on are independant.
	419	!>
	420	!> @warning do not use on the output of a function who create or read an
	421	!> structure (ex: tl_file=file_copy(file_init()) is forbidden).
	422	!> This will create memory leaks.
	423	!> @warning to avoid infinite loop, do not use any function inside
	424	!> this subroutine
	425	!>
	426	!> @author J.Paul
	427	!> - November, 2013- Initial Version
	428	!> @date November, 2014
	429	!> - use function instead of overload assignment operator
	430	!> (to avoid memory leak)
	431	!>
	432	!> @param[in] td_mpp mpp structure
	433	!> @return copy of input array of mpp structure
	434	!-------------------------------------------------------------------
	435	FUNCTION mpp__copy_arr( td_mpp )
	436	IMPLICIT NONE
	437	! Argument
	438	TYPE(TMPP), DIMENSION(:), INTENT(IN) :: td_mpp
	439	! function
	440	TYPE(TMPP), DIMENSION(SIZE(td_mpp(:))) :: mpp__copy_arr
	441
	442	! local variable
	443	! loop indices
	444	INTEGER(i4) :: ji
	445	!----------------------------------------------------------------
	446
	447	DO ji=1,SIZE(td_mpp(:))
	448	mpp__copy_arr(ji)=mpp_copy(td_mpp(ji))
	449	ENDDO
	450
	451	END FUNCTION mpp__copy_arr
	452	!-------------------------------------------------------------------
[4213]	453	!> @brief This subroutine print some information about mpp strucutre.
	454	!
	455	!> @author J.Paul
	456	!> - Nov, 2013- Initial Version
	457	!
[5600]	458	!> @param[in] td_mpp mpp structure
[4213]	459	!-------------------------------------------------------------------
	460	SUBROUTINE mpp_print(td_mpp)
	461	IMPLICIT NONE
	462
	463	! Argument
	464	TYPE(TMPP), INTENT(IN) :: td_mpp
	465
	466	! local variable
[5600]	467	INTEGER(i4), PARAMETER :: il_freq = 4
[4213]	468
	469	INTEGER(i4), DIMENSION(:,:), ALLOCATABLE :: il_proc
	470	INTEGER(i4), DIMENSION(:,:), ALLOCATABLE :: il_lci
	471	INTEGER(i4), DIMENSION(:,:), ALLOCATABLE :: il_lcj
	472
	473	! loop indices
	474	INTEGER(i4) :: ji
	475	INTEGER(i4) :: jj
	476	INTEGER(i4) :: jk
	477	INTEGER(i4) :: jl
	478	INTEGER(i4) :: jm
	479	!----------------------------------------------------------------
	480
[5600]	481	WRITE(*,'((a,a),2(/3x,a,a),9(/3x,a,i0))')&
[4213]	482	& "MPP : ",TRIM(td_mpp%c_name), &
	483	& " type : ",TRIM(td_mpp%c_type), &
	484	& " dom : ",TRIM(td_mpp%c_dom), &
	485	& " nproc : ",td_mpp%i_nproc, &
	486	& " niproc : ",td_mpp%i_niproc, &
	487	& " njproc : ",td_mpp%i_njproc, &
	488	& " preci : ",td_mpp%i_preci, &
	489	& " precj : ",td_mpp%i_precj, &
[5600]	490	& " ndim : ",td_mpp%i_ndim, &
	491	& " overlap: ",td_mpp%i_ew, &
	492	& " perio : ",td_mpp%i_perio, &
	493	& " pivot : ",td_mpp%i_pivot
[4213]	494
	495	! print dimension
	496	IF( td_mpp%i_ndim /= 0 )THEN
	497	WRITE(*,'(/a)') " File dimension"
	498	DO ji=1,ip_maxdim
	499	IF( td_mpp%t_dim(ji)%l_use )THEN
	500	CALL dim_print(td_mpp%t_dim(ji))
	501	ENDIF
	502	ENDDO
	503	ENDIF
	504
	505	! print file
	506	IF( td_mpp%i_nproc /= 0 .AND. ASSOCIATED(td_mpp%t_proc) )THEN
	507	IF( ALL( td_mpp%t_proc(:)%i_iind==0 ) .OR. &
	508	& ALL( td_mpp%t_proc(:)%i_jind==0 ) )THEN
	509
	510	DO ji=1,td_mpp%i_nproc
	511	CALL file_print(td_mpp%t_proc(ji))
	512	WRITE(*,'((a),(/3x,a,i0),2(/3x,a,a),4(/3x,a,i0,a,i0)/)')&
	513	& " Domain decomposition : ", &
	514	& " id : ",td_mpp%t_proc(ji)%i_pid, &
	515	& " used : ",TRIM(fct_str(td_mpp%t_proc(ji)%l_use)), &
	516	& " contour : ",TRIM(fct_str(td_mpp%t_proc(ji)%l_ctr)), &
	517	& " left-bottom : ",td_mpp%t_proc(ji)%i_impp,', ',&
	518	& td_mpp%t_proc(ji)%i_jmpp, &
	519	& " dimension : ",td_mpp%t_proc(ji)%i_lci,' x ',&
	520	& td_mpp%t_proc(ji)%i_lcj, &
	521	& " first indoor indices : ",td_mpp%t_proc(ji)%i_ldi,', ',&
	522	& td_mpp%t_proc(ji)%i_ldj, &
	523	& " last indoor indices : ",td_mpp%t_proc(ji)%i_lei,', ',&
	524	& td_mpp%t_proc(ji)%i_lej
	525
[5600]	526	ENDDO
[4213]	527
[5600]	528	IF( td_mpp%t_proc(1)%i_nvar > 0 )THEN
	529	WRITE(*,'(/a)') " Variable(s) used : "
	530	DO ji=1,td_mpp%t_proc(1)%i_nvar
	531	WRITE(*,'(3x,a)') TRIM(td_mpp%t_proc(1)%t_var(ji)%c_name)
	532	ENDDO
	533	ENDIF
[4213]	534
	535	ELSE
	536
	537	DO ji=1,td_mpp%i_nproc
	538	WRITE(*,'((a, a),(/3x,a,i0),(/3x,a,a),4(/3x,a,i0,a,i0)/)')&
	539	& " Domain decomposition : ",TRIM(td_mpp%t_proc(ji)%c_name),&
	540	& " id : ",td_mpp%t_proc(ji)%i_pid, &
	541	& " used : ",TRIM(fct_str(td_mpp%t_proc(ji)%l_use)),&
	542	& " left-bottom : ",td_mpp%t_proc(ji)%i_impp,', ',&
	543	& td_mpp%t_proc(ji)%i_jmpp, &
	544	& " dimension : ",td_mpp%t_proc(ji)%i_lci,' x ',&
	545	& td_mpp%t_proc(ji)%i_lcj, &
	546	& " first indoor indices : ",td_mpp%t_proc(ji)%i_ldi,',',&
	547	& td_mpp%t_proc(ji)%i_ldj, &
	548	& " last indoor indices : ",td_mpp%t_proc(ji)%i_lei,', ',&
	549	& td_mpp%t_proc(ji)%i_lej
	550
	551	ENDDO
	552
[5600]	553	IF( td_mpp%t_proc(1)%i_nvar > 0 )THEN
	554	WRITE(*,'(/a)') " Variable(s) used : "
	555	DO ji=1,td_mpp%t_proc(1)%i_nvar
	556	WRITE(*,'(3x,a)') TRIM(td_mpp%t_proc(1)%t_var(ji)%c_name)
	557	ENDDO
	558	ENDIF
	559
[4213]	560	ALLOCATE( il_proc(td_mpp%i_niproc,td_mpp%i_njproc) )
	561	ALLOCATE( il_lci(td_mpp%i_niproc,td_mpp%i_njproc) )
	562	ALLOCATE( il_lcj(td_mpp%i_niproc,td_mpp%i_njproc) )
	563
	564	DO jk=1,td_mpp%i_nproc
	565	ji=td_mpp%t_proc(jk)%i_iind
	566	jj=td_mpp%t_proc(jk)%i_jind
	567	il_proc(ji,jj)=jk
	568	il_lci(ji,jj)=td_mpp%t_proc(jk)%i_lci
	569	il_lcj(ji,jj)=td_mpp%t_proc(jk)%i_lcj
	570	ENDDO
	571
	572	jl = 1
[5600]	573	DO jk = 1,(td_mpp%i_niproc-1)/il_freq+1
	574	jm = MIN(td_mpp%i_niproc, jl+il_freq-1)
[4213]	575	WRITE(,)
	576	WRITE(*,9401) (ji, ji = jl,jm)
	577	WRITE(,9400) ('**', ji = jl,jm-1)
	578	DO jj = 1, td_mpp%i_njproc
	579	WRITE(*,9403) (' ', ji = jl,jm-1)
	580	WRITE(*,9402) jj, ( il_lci(ji,jj), il_lcj(ji,jj), ji = jl,jm)
	581	WRITE(*,9404) (il_proc(ji,jj), ji= jl,jm)
	582	WRITE(*,9403) (' ', ji = jl,jm-1)
	583	WRITE(,9400) ('**', ji = jl,jm-1)
	584	ENDDO
[5600]	585	jl = jl+il_freq
[4213]	586	ENDDO
	587
	588	DEALLOCATE( il_proc )
	589	DEALLOCATE( il_lci )
	590	DEALLOCATE( il_lcj )
	591
	592	ENDIF
	593	ELSE
	594	WRITE(*,'(/a)') " Domain decomposition : none"
	595	ENDIF
	596
	597
	598	9400 FORMAT(' *',20('***********',a3))
	599	9403 FORMAT(' * ',20(' * ',a3))
	600	9401 FORMAT(' ',20(' ',i3,' '))
	601	9402 FORMAT(' ',i3,' * ',20(i0,' x',i0,' * '))
	602	9404 FORMAT(' * ',20(' ',i3,' * '))
	603
	604	END SUBROUTINE mpp_print
	605	!-------------------------------------------------------------------
	606	!> @brief
[5600]	607	!> This function initialise mpp structure, given file name,
	608	!> and optionaly mask and number of processor following I and J
[4213]	609	!> @detail
	610	!> - If no total number of processor is defined (id_nproc), optimize
	611	!> the domain decomposition (look for the domain decomposition with
	612	!> the most land processor to remove)
	613	!> - length of the overlap region (id_preci, id_precj) could be specify
	614	!> in I and J direction (default value is 1)
	615	!
	616	!> @author J.Paul
[5600]	617	!> @date November, 2013 - Initial version
[4213]	618	!
[5600]	619	!> @param[in] cd_file file name of one file composing mpp domain
	620	!> @param[in] id_mask domain mask
	621	!> @param[in] id_niproc number of processors following i
	622	!> @param[in] id_njproc number of processors following j
	623	!> @param[in] id_nproc total number of processors
	624	!> @param[in] id_preci i-direction overlap region
	625	!> @param[in] id_precj j-direction overlap region
	626	!> @param[in] cd_type type of the files (cdf, cdf4, dimg)
	627	!> @param[in] id_ew east-west overlap
	628	!> @param[in] id_perio NEMO periodicity index
	629	!> @param[in] id_pivot NEMO pivot point index F(0),T(1)
[4213]	630	!> @return mpp structure
	631	!-------------------------------------------------------------------
	632	TYPE(TMPP) FUNCTION mpp__init_mask(cd_file, id_mask, &
	633	& id_niproc, id_njproc, id_nproc,&
	634	& id_preci, id_precj, &
[5600]	635	cd_type, id_ew, id_perio, id_pivot)
[4213]	636	IMPLICIT NONE
	637	! Argument
	638	CHARACTER(LEN=*), INTENT(IN) :: cd_file
[5600]	639	INTEGER(i4), DIMENSION(:,:), INTENT(IN) :: id_mask
[4213]	640	INTEGER(i4), INTENT(IN), OPTIONAL :: id_niproc
	641	INTEGER(i4), INTENT(IN), OPTIONAL :: id_njproc
	642	INTEGER(i4), INTENT(IN), OPTIONAL :: id_nproc
	643	INTEGER(i4), INTENT(IN), OPTIONAL :: id_preci
	644	INTEGER(i4), INTENT(IN), OPTIONAL :: id_precj
	645	CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_type
[5600]	646	INTEGER(i4), INTENT(IN), OPTIONAL :: id_ew
	647	INTEGER(i4), INTENT(IN), OPTIONAL :: id_perio
	648	INTEGER(i4), INTENT(IN), OPTIONAL :: id_pivot
[4213]	649
	650	! local variable
	651	CHARACTER(LEN=lc) :: cl_type
	652
	653	INTEGER(i4) , DIMENSION(2) :: il_shape
	654
	655	TYPE(TDIM) :: tl_dim
	656
	657	TYPE(TATT) :: tl_att
	658	! loop indices
	659	INTEGER(i4) :: ji
	660	!----------------------------------------------------------------
	661
	662	! clean mpp
	663	CALL mpp_clean(mpp__init_mask)
	664
	665	! check type
	666	cl_type=''
	667	IF( PRESENT(cd_type) ) cl_type=TRIM(ADJUSTL(cd_type))
	668
	669	IF( TRIM(cl_type) /= '' )THEN
	670	SELECT CASE(TRIM(cd_type))
	671	CASE('cdf')
	672	mpp__init_mask%c_type='cdf'
	673	CASE('dimg')
	674	mpp__init_mask%c_type='dimg'
	675	CASE DEFAULT
	676	CALL logger_warn( "MPP INIT: type "//TRIM(cd_type)//&
	677	& " unknown. type dimg will be used for mpp "//&
	678	& TRIM(mpp__init_mask%c_name) )
	679	mpp__init_mask%c_type='dimg'
	680	END SELECT
	681	ELSE
	682	mpp__init_mask%c_type=TRIM(file_get_type(cd_file))
	683	ENDIF
	684
[5600]	685	! get mpp name
	686	mpp__init_mask%c_name=TRIM(file_rename(cd_file))
[4213]	687
[5600]	688	! get global domain dimension
	689	il_shape(:)=SHAPE(id_mask)
[4213]	690
[5600]	691	tl_dim=dim_init('X',il_shape(1))
	692	CALL mpp_add_dim(mpp__init_mask, tl_dim)
[4213]	693
[5600]	694	tl_dim=dim_init('Y',il_shape(2))
	695	CALL mpp_add_dim(mpp__init_mask, tl_dim)
	696
	697	! clean
	698	CALL dim_clean(tl_dim)
	699
[4213]	700	IF( ( PRESENT(id_niproc) .AND. (.NOT. PRESENT(id_niproc))) .OR. &
	701	((.NOT. PRESENT(id_niproc)) .AND. PRESENT(id_njproc) ) )THEN
	702	CALL logger_warn( "MPP INIT: number of processors following I and J "//&
	703	& "should be both specified")
	704	ELSE
	705	! get number of processors following I and J
	706	IF( PRESENT(id_niproc) ) mpp__init_mask%i_niproc=id_niproc
	707	IF( PRESENT(id_njproc) ) mpp__init_mask%i_njproc=id_njproc
	708	ENDIF
	709
	710	! get maximum number of processors to be used
	711	IF( PRESENT(id_nproc) ) mpp__init_mask%i_nproc = id_nproc
	712
	713	! get overlap region length
	714	IF( PRESENT(id_preci) ) mpp__init_mask%i_preci= id_preci
	715	IF( PRESENT(id_precj) ) mpp__init_mask%i_precj= id_precj
	716
[5600]	717	! east-west overlap
	718	IF( PRESENT(id_ew) ) mpp__init_mask%i_ew= id_ew
	719	! NEMO periodicity
	720	IF( PRESENT(id_perio) ) mpp__init_mask%i_perio= id_perio
	721	IF( PRESENT(id_pivot) ) mpp__init_mask%i_pivot= id_pivot
	722
[4213]	723	IF( mpp__init_mask%i_nproc /= 0 .AND. &
	724	& mpp__init_mask%i_niproc /= 0 .AND. &
	725	& mpp__init_mask%i_njproc /= 0 .AND. &
	726	& mpp__init_mask%i_nproc > &
	727	& mpp__init_mask%i_niproc * mpp__init_mask%i_njproc )THEN
	728
	729	CALL logger_error("MPP INIT: invalid domain decomposition ")
	730	CALL logger_debug("MPP INIT: "// &
	731	& TRIM(fct_str(mpp__init_mask%i_nproc))//" > "//&
	732	& TRIM(fct_str(mpp__init_mask%i_niproc))//" x "//&
	733	& TRIM(fct_str(mpp__init_mask%i_njproc)) )
	734
	735	ELSE
	736
[5600]	737	IF( mpp__init_mask%i_niproc /= 0 .AND. &
	738	& mpp__init_mask%i_njproc /= 0 )THEN
[4213]	739	! compute domain decomposition
	740	CALL mpp__compute( mpp__init_mask )
	741	! remove land sub domain
	742	CALL mpp__del_land( mpp__init_mask, id_mask )
	743	ELSEIF( mpp__init_mask%i_nproc /= 0 )THEN
	744	! optimiz
	745	CALL mpp__optimiz( mpp__init_mask, id_mask )
	746
	747	ELSE
[5600]	748	CALL logger_warn("MPP INIT: number of processor to be used "//&
	749	& "not specify. force to one.")
	750	mpp__init_mask%i_nproc = 1
	751	! optimiz
	752	CALL mpp__optimiz( mpp__init_mask, id_mask )
[4213]	753	ENDIF
[5600]	754	CALL logger_info("MPP INIT: domain decoposition : "//&
	755	& 'niproc('//TRIM(fct_str(mpp__init_mask%i_niproc))//') * '//&
	756	& 'njproc('//TRIM(fct_str(mpp__init_mask%i_njproc))//') = '//&
	757	& 'nproc('//TRIM(fct_str(mpp__init_mask%i_nproc))//')' )
[4213]	758
	759	! get domain type
	760	CALL mpp_get_dom( mpp__init_mask )
	761
	762	DO ji=1,mpp__init_mask%i_nproc
	763
	764	! get processor size
	765	il_shape(:)=mpp_get_proc_size( mpp__init_mask, ji )
	766
	767	tl_dim=dim_init('X',il_shape(1))
	768	CALL file_move_dim(mpp__init_mask%t_proc(ji), tl_dim)
	769
	770	tl_dim=dim_init('Y',il_shape(2))
	771	CALL file_move_dim(mpp__init_mask%t_proc(ji), tl_dim)
	772
	773	! add type
	774	mpp__init_mask%t_proc(ji)%c_type=TRIM(mpp__init_mask%c_type)
	775
[5600]	776	! clean
	777	CALL dim_clean(tl_dim)
[4213]	778	ENDDO
	779
	780	! add global attribute
	781	tl_att=att_init("DOMAIN_number_total",mpp__init_mask%i_nproc)
	782	CALL mpp_add_att(mpp__init_mask, tl_att)
	783
	784	tl_att=att_init("DOMAIN_I_number_total",mpp__init_mask%i_niproc)
	785	CALL mpp_add_att(mpp__init_mask, tl_att)
	786
	787	tl_att=att_init("DOMAIN_J_number_total",mpp__init_mask%i_njproc)
	788	CALL mpp_add_att(mpp__init_mask, tl_att)
	789
	790	tl_att=att_init("DOMAIN_size_global",mpp__init_mask%t_dim(1:2)%i_len)
	791	CALL mpp_add_att(mpp__init_mask, tl_att)
	792
	793	tl_att=att_init( "DOMAIN_I_position_first", &
	794	& mpp__init_mask%t_proc(:)%i_impp )
	795	CALL mpp_add_att(mpp__init_mask, tl_att)
	796
	797	tl_att=att_init( "DOMAIN_J_position_first", &
	798	& mpp__init_mask%t_proc(:)%i_jmpp )
	799	CALL mpp_add_att(mpp__init_mask, tl_att)
	800
	801	tl_att=att_init( "DOMAIN_I_position_last", &
	802	& mpp__init_mask%t_proc(:)%i_lci )
	803	CALL mpp_add_att(mpp__init_mask, tl_att)
	804
	805	tl_att=att_init( "DOMAIN_J_position_last", &
	806	& mpp__init_mask%t_proc(:)%i_lcj )
	807	CALL mpp_add_att(mpp__init_mask, tl_att)
	808
	809	tl_att=att_init( "DOMAIN_I_halo_size_start", &
	810	& mpp__init_mask%t_proc(:)%i_ldi )
	811	CALL mpp_add_att(mpp__init_mask, tl_att)
	812
	813	tl_att=att_init( "DOMAIN_J_halo_size_start", &
	814	& mpp__init_mask%t_proc(:)%i_ldj )
	815	CALL mpp_add_att(mpp__init_mask, tl_att)
	816
	817	tl_att=att_init( "DOMAIN_I_halo_size_end", &
	818	& mpp__init_mask%t_proc(:)%i_lei )
	819	CALL mpp_add_att(mpp__init_mask, tl_att)
	820
	821	tl_att=att_init( "DOMAIN_J_halo_size_end", &
	822	& mpp__init_mask%t_proc(:)%i_lej )
	823	CALL mpp_add_att(mpp__init_mask, tl_att)
	824
[5600]	825	! clean
	826	CALL att_clean(tl_att)
[4213]	827	ENDIF
	828
	829	END FUNCTION mpp__init_mask
	830	!-------------------------------------------------------------------
	831	!> @brief
[5600]	832	!> This function initialise mpp structure, given variable strcuture
	833	!> and optionaly number of processor following I and J
[4213]	834	!> @detail
	835	!> - If no total number of processor is defined (id_nproc), optimize
	836	!> the domain decomposition (look for the domain decomposition with
	837	!> the most land processor to remove)
	838	!> - length of the overlap region (id_preci, id_precj) could be specify
	839	!> in I and J direction (default value is 1)
	840	!
	841	!> @author J.Paul
[5600]	842	!> @date November, 2013 - Initial version
[4213]	843	!
[5600]	844	!> @param[in] cd_file file name of one file composing mpp domain
	845	!> @param[in] td_var variable structure
	846	!> @param[in] id_niproc number of processors following i
	847	!> @param[in] id_njproc number of processors following j
	848	!> @param[in] id_nproc total number of processors
	849	!> @param[in] id_preci i-direction overlap region
	850	!> @param[in] id_precj j-direction overlap region
	851	!> @param[in] cd_type type of the files (cdf, cdf4, dimg)
	852	!> @param[in] id_perio NEMO periodicity index
	853	!> @param[in] id_pivot NEMO pivot point index F(0),T(1)
[4213]	854	!> @return mpp structure
	855	!-------------------------------------------------------------------
	856	TYPE(TMPP) FUNCTION mpp__init_var( cd_file, td_var, &
	857	& id_niproc, id_njproc, id_nproc,&
[5600]	858	& id_preci, id_precj, cd_type, &
	859	& id_perio, id_pivot )
[4213]	860	IMPLICIT NONE
	861	! Argument
	862	CHARACTER(LEN=*), INTENT(IN) :: cd_file
	863	TYPE(TVAR), INTENT(IN) :: td_var
	864	INTEGER(i4), INTENT(IN), OPTIONAL :: id_niproc
	865	INTEGER(i4), INTENT(IN), OPTIONAL :: id_njproc
	866	INTEGER(i4), INTENT(IN), OPTIONAL :: id_nproc
	867	INTEGER(i4), INTENT(IN), OPTIONAL :: id_preci
	868	INTEGER(i4), INTENT(IN), OPTIONAL :: id_precj
	869	CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_type
[5600]	870	INTEGER(i4), INTENT(IN), OPTIONAL :: id_perio
	871	INTEGER(i4), INTENT(IN), OPTIONAL :: id_pivot
[4213]	872
	873	! local variable
[5600]	874	INTEGER(i4), DIMENSION(:,:,:), ALLOCATABLE :: il_mask
[4213]	875	!----------------------------------------------------------------
	876
	877	IF( ASSOCIATED(td_var%d_value) )THEN
[5600]	878	ALLOCATE( il_mask(td_var%t_dim(1)%i_len, &
	879	& td_var%t_dim(2)%i_len, &
	880	& td_var%t_dim(3)%i_len) )
	881	il_mask(:,:,:)=var_get_mask(td_var)
[4213]	882
[5600]	883	mpp__init_var=mpp_init( cd_file, il_mask(:,:,1), &
[4213]	884	& id_niproc, id_njproc, id_nproc,&
[5600]	885	& id_preci, id_precj, cd_type, &
	886	& id_ew=td_var%i_ew, &
	887	& id_perio=id_perio, id_pivot=id_pivot)
[4213]	888
	889	DEALLOCATE(il_mask)
	890	ELSE
	891	CALL logger_error("MPP INIT: variable value not define.")
	892	ENDIF
	893
	894	END FUNCTION mpp__init_var
	895	!-------------------------------------------------------------------
[5600]	896	!> @brief This function initalise a mpp structure given file structure.
[4213]	897	!> @details
[5600]	898	!> It reads restart dimg files, or some netcdf files.
[4213]	899	!>
[5600]	900	!> @warning
	901	!> netcdf file must contains some attributes:
	902	!> - DOMAIN_number_total
	903	!> - DOMAIN_size_global
	904	!> - DOMAIN_number
	905	!> - DOMAIN_position_first
	906	!> - DOMAIN_position_last
	907	!> - DOMAIN_halo_size_start
	908	!> - DOMAIN_halo_size_end
	909	!> or the file is assume to be no mpp file.
	910	!>
	911	!>
[4213]	912	!>
	913	!> @author J.Paul
[5600]	914	!> - November, 2013- Initial Version
[4213]	915	!
[5600]	916	!> @param[in] td_file file strcuture
	917	!> @param[in] id_ew east-west overlap
	918	!> @param[in] id_perio NEMO periodicity index
	919	!> @param[in] id_pivot NEMO pivot point index F(0),T(1)
[4213]	920	!> @return mpp structure
	921	!-------------------------------------------------------------------
[5600]	922	TYPE(TMPP) FUNCTION mpp__init_file( td_file, id_ew, id_perio, id_pivot )
[4213]	923	IMPLICIT NONE
	924
	925	! Argument
	926	TYPE(TFILE), INTENT(IN) :: td_file
[5600]	927	INTEGER(i4), INTENT(IN), OPTIONAL :: id_ew
	928	INTEGER(i4), INTENT(IN), OPTIONAL :: id_perio
	929	INTEGER(i4), INTENT(IN), OPTIONAL :: id_pivot
[4213]	930
	931	! local variable
	932	TYPE(TMPP) :: tl_mpp
[5600]	933
[4213]	934	TYPE(TFILE) :: tl_file
[5600]	935
[4213]	936	TYPE(TDIM) :: tl_dim
[5600]	937
[4213]	938	TYPE(TATT) :: tl_att
[5600]	939
[4213]	940	INTEGER(i4) :: il_nproc
	941	INTEGER(i4) :: il_attid
	942
	943	INTEGER(i4), DIMENSION(2) :: il_shape
	944	! loop indices
	945	INTEGER(i4) :: ji
	946	!----------------------------------------------------------------
	947
	948	! clean mpp
[5600]	949	CALL mpp_clean(mpp__init_file)
[4213]	950
	951	! check file type
	952	SELECT CASE( TRIM(td_file%c_type) )
	953	CASE('cdf')
	954	! need to read all file to get domain decomposition
[5600]	955	tl_file=file_copy(td_file)
[4213]	956
	957	! open file
	958	CALL iom_open(tl_file)
	959
	960	! read first file domain decomposition
[5600]	961	tl_mpp=mpp__init_file_cdf(tl_file)
[4213]	962
	963	! get number of processor/file to be read
	964	il_nproc = 1
	965	il_attid = 0
	966
	967	IF( ASSOCIATED(tl_file%t_att) )THEN
	968	il_attid=att_get_id( tl_file%t_att, "DOMAIN_number_total" )
	969	ENDIF
	970	IF( il_attid /= 0 )THEN
	971	il_nproc = INT(tl_file%t_att(il_attid)%d_value(1))
	972	ENDIF
	973
	974	! close file
	975	CALL iom_close(tl_file)
	976
	977	IF( il_nproc /= 1 )THEN
	978	DO ji=1,il_nproc
	979
	980	! clean mpp strcuture
	981	CALL mpp_clean(tl_mpp)
	982
	983	! get filename
	984	tl_file=file_rename(td_file,ji)
	985
	986	! open file
	987	CALL iom_open(tl_file)
	988
	989	! read domain decomposition
[5600]	990	tl_mpp = mpp__init_file_cdf(tl_file)
[4213]	991	IF( ji == 1 )THEN
[5600]	992	mpp__init_file=mpp_copy(tl_mpp)
[4213]	993	ELSE
[5600]	994	IF( ANY( mpp__init_file%t_dim(1:2)%i_len /= &
[4213]	995	tl_mpp%t_dim(1:2)%i_len) )THEN
	996
[5600]	997	CALL logger_error("MPP INIT READ: dimension from file "//&
[4213]	998	& TRIM(tl_file%c_name)//" and mpp strcuture "//&
[5600]	999	& TRIM(mpp__init_file%c_name)//"differ ")
[4213]	1000
	1001	ELSE
	1002
	1003	! add processor to mpp strcuture
[5600]	1004	CALL mpp__add_proc(mpp__init_file, tl_mpp%t_proc(1))
[4213]	1005
	1006	ENDIF
	1007	ENDIF
	1008
	1009	! close file
	1010	CALL iom_close(tl_file)
	1011
	1012	ENDDO
[5600]	1013	IF( mpp__init_file%i_nproc /= il_nproc )THEN
	1014	CALL logger_error("MPP INIT READ: some processors can't be added &
[4213]	1015	& to mpp structure")
	1016	ENDIF
	1017
	1018	ELSE
[5600]	1019	mpp__init_file=mpp_copy(tl_mpp)
[4213]	1020	ENDIF
	1021
	1022	! mpp type
[5600]	1023	mpp__init_file%c_type=TRIM(td_file%c_type)
[4213]	1024
	1025	! mpp domain type
[5600]	1026	CALL mpp_get_dom(mpp__init_file)
[4213]	1027
	1028	! create some attributes for domain decomposition (use with dimg file)
[5600]	1029	tl_att=att_init( "DOMAIN_number_total", mpp__init_file%i_nproc )
	1030	CALL mpp_add_att(mpp__init_file, tl_att)
[4213]	1031
[5600]	1032	tl_att=att_init( "DOMAIN_I_position_first", mpp__init_file%t_proc(:)%i_impp )
	1033	CALL mpp_add_att(mpp__init_file, tl_att)
[4213]	1034
[5600]	1035	tl_att=att_init( "DOMAIN_J_position_first", mpp__init_file%t_proc(:)%i_jmpp )
	1036	CALL mpp_add_att(mpp__init_file, tl_att)
[4213]	1037
[5600]	1038	tl_att=att_init( "DOMAIN_I_position_last", mpp__init_file%t_proc(:)%i_lci )
	1039	CALL mpp_add_att(mpp__init_file, tl_att)
[4213]	1040
[5600]	1041	tl_att=att_init( "DOMAIN_J_position_last", mpp__init_file%t_proc(:)%i_lcj )
	1042	CALL mpp_add_att(mpp__init_file, tl_att)
[4213]	1043
[5600]	1044	tl_att=att_init( "DOMAIN_I_halo_size_start", mpp__init_file%t_proc(:)%i_ldi )
	1045	CALL mpp_add_att(mpp__init_file, tl_att)
[4213]	1046
[5600]	1047	tl_att=att_init( "DOMAIN_J_halo_size_start", mpp__init_file%t_proc(:)%i_ldj )
	1048	CALL mpp_add_att(mpp__init_file, tl_att)
[4213]	1049
[5600]	1050	tl_att=att_init( "DOMAIN_I_halo_size_end", mpp__init_file%t_proc(:)%i_lei )
	1051	CALL mpp_add_att(mpp__init_file, tl_att)
[4213]	1052
[5600]	1053	tl_att=att_init( "DOMAIN_J_halo_size_end", mpp__init_file%t_proc(:)%i_lej )
	1054	CALL mpp_add_att(mpp__init_file, tl_att)
[4213]	1055
[5600]	1056	! clean
	1057	CALL mpp_clean(tl_mpp)
	1058	CALL att_clean(tl_att)
[4213]	1059
	1060	CASE('dimg')
	1061	! domain decomposition could be read in one file
	1062
[5600]	1063	tl_file=file_copy(td_file)
[4213]	1064	! open file
[5600]	1065	CALL logger_debug("MPP INIT READ: open file "//TRIM(tl_file%c_name))
[4213]	1066	CALL iom_open(tl_file)
	1067
[5600]	1068	CALL logger_debug("MPP INIT READ: read mpp structure ")
[4213]	1069	! read mpp structure
[5600]	1070	mpp__init_file=mpp__init_file_rstdimg(tl_file)
[4213]	1071
	1072	! mpp type
[5600]	1073	mpp__init_file%c_type=TRIM(td_file%c_type)
[4213]	1074
	1075	! mpp domain type
[5600]	1076	CALL logger_debug("MPP INIT READ: mpp_get_dom ")
	1077	CALL mpp_get_dom(mpp__init_file)
[4213]	1078
	1079	! get processor size
[5600]	1080	CALL logger_debug("MPP INIT READ: get processor size ")
	1081	DO ji=1,mpp__init_file%i_nproc
[4213]	1082
[5600]	1083	il_shape(:)=mpp_get_proc_size( mpp__init_file, ji )
[4213]	1084
	1085	tl_dim=dim_init('X',il_shape(1))
[5600]	1086	CALL file_add_dim(mpp__init_file%t_proc(ji), tl_dim)
[4213]	1087
	1088	tl_dim=dim_init('Y',il_shape(2))
[5600]	1089	CALL file_add_dim(mpp__init_file%t_proc(ji), tl_dim)
[4213]	1090
[5600]	1091	! clean
	1092	CALL dim_clean(tl_dim)
	1093
[4213]	1094	ENDDO
	1095
	1096	! close file
	1097	CALL iom_close(tl_file)
	1098
	1099	CASE DEFAULT
[5600]	1100	CALL logger_error("MPP INIT READ: invalid type for file "//&
[4213]	1101	& TRIM(tl_file%c_name))
	1102	END SELECT
	1103
[5600]	1104	! east west overlap
	1105	IF( PRESENT(id_ew) ) mpp__init_file%i_ew=id_ew
	1106	! NEMO periodicity
	1107	IF( PRESENT(id_perio) )THEN
	1108	mpp__init_file%i_perio= id_perio
	1109	SELECT CASE(id_perio)
	1110	CASE(3,4)
	1111	mpp__init_file%i_pivot=1
	1112	CASE(5,6)
	1113	mpp__init_file%i_pivot=0
	1114	CASE DEFAULT
	1115	mpp__init_file%i_pivot=1
	1116	END SELECT
	1117	ENDIF
	1118
	1119	IF( PRESENT(id_pivot) ) mpp__init_file%i_pivot= id_pivot
	1120
	1121	! clean
	1122	CALL file_clean(tl_file)
	1123
	1124	CALL logger_debug("MPP INIT READ: fin init_read ")
	1125	END FUNCTION mpp__init_file
[4213]	1126	!-------------------------------------------------------------------
	1127	!> @brief This function initalise a mpp structure,
	1128	!> reading some netcdf files.
	1129	!
	1130	!> @details
	1131	!
	1132	!> @author J.Paul
[5600]	1133	!> - November, 2013- Initial Version
	1134	!>
	1135	!> @param[in] td_file file strcuture
[4213]	1136	!> @return mpp structure
	1137	!-------------------------------------------------------------------
[5600]	1138	TYPE(TMPP) FUNCTION mpp__init_file_cdf( td_file )
[4213]	1139	IMPLICIT NONE
	1140
	1141	! Argument
	1142	TYPE(TFILE), INTENT(IN) :: td_file
	1143
	1144	! local variable
	1145	INTEGER(i4) :: il_attid ! attribute id
[5600]	1146
[4213]	1147	LOGICAL :: ll_exist
	1148	LOGICAL :: ll_open
	1149
	1150	TYPE(TATT) :: tl_att
[5600]	1151
	1152	TYPE(TDIM) :: tl_dim
	1153
[4213]	1154	TYPE(TFILE) :: tl_proc
	1155	!----------------------------------------------------------------
	1156
[5600]	1157	CALL logger_trace("MPP INIT READ: netcdf file "//TRIM(td_file%c_name))
[4213]	1158
	1159	INQUIRE( FILE=TRIM(td_file%c_name), EXIST=ll_exist, OPENED=ll_open )
	1160	! ll_open do not work for netcdf file, return always FALSE
	1161	IF( ll_exist )THEN
	1162
	1163	IF( td_file%i_id == 0 )THEN
	1164	CALL logger_info(" id "//TRIM(fct_str(td_file%i_id)))
[5600]	1165	CALL logger_error("MPP INIT READ: netcdf file "//TRIM(td_file%c_name)//&
[4213]	1166	& " not opened")
	1167	ELSE
	1168
	1169	! get mpp name
[5600]	1170	mpp__init_file_cdf%c_name=TRIM( file_rename(td_file%c_name) )
[4213]	1171
	1172	! add type
[5600]	1173	mpp__init_file_cdf%c_type="cdf"
[4213]	1174
	1175	! global domain size
	1176	il_attid = 0
	1177	IF( ASSOCIATED(td_file%t_att) )THEN
	1178	il_attid=att_get_id( td_file%t_att, "DOMAIN_size_global" )
	1179	ENDIF
	1180	IF( il_attid /= 0 )THEN
[5600]	1181	tl_dim=dim_init('X',INT(td_file%t_att(il_attid)%d_value(1)))
	1182	CALL mpp_add_dim(mpp__init_file_cdf,tl_dim)
[4213]	1183
[5600]	1184	tl_dim=dim_init('Y',INT(td_file%t_att(il_attid)%d_value(2)))
	1185	CALL mpp_add_dim(mpp__init_file_cdf,tl_dim)
	1186	ELSE ! assume only one file (not mpp)
	1187	tl_dim=dim_init( td_file%t_dim(1)%c_name, td_file%t_dim(1)%i_len)
	1188	CALL mpp_add_dim(mpp__init_file_cdf,tl_dim)
	1189
	1190	tl_dim=dim_init( td_file%t_dim(2)%c_name, td_file%t_dim(2)%i_len)
	1191	CALL mpp_add_dim(mpp__init_file_cdf,tl_dim)
[4213]	1192	ENDIF
[5600]	1193	tl_dim=dim_init( td_file%t_dim(3)%c_name, td_file%t_dim(3)%i_len)
	1194	CALL mpp_add_dim(mpp__init_file_cdf,tl_dim)
[4213]	1195
[5600]	1196	tl_dim=dim_init( td_file%t_dim(4)%c_name, td_file%t_dim(4)%i_len)
	1197	CALL mpp_add_dim(mpp__init_file_cdf,tl_dim)
	1198
[4213]	1199	! initialise file/processor
[5600]	1200	tl_proc=file_copy(td_file)
[4213]	1201
	1202	! processor id
	1203	il_attid = 0
	1204	IF( ASSOCIATED(td_file%t_att) )THEN
	1205	il_attid=att_get_id( td_file%t_att, "DOMAIN_number" )
	1206	ENDIF
	1207	IF( il_attid /= 0 )THEN
	1208	tl_proc%i_pid = INT(td_file%t_att(il_attid)%d_value(1))
	1209	ELSE
	1210	tl_proc%i_pid = 1
	1211	ENDIF
	1212
	1213	! processor dimension
[5600]	1214	tl_proc%t_dim(:)=dim_copy(td_file%t_dim(:))
[4213]	1215
	1216	! DOMAIN_position_first
	1217	il_attid = 0
	1218	IF( ASSOCIATED(td_file%t_att) )THEN
	1219	il_attid=att_get_id( td_file%t_att, "DOMAIN_position_first" )
	1220	ENDIF
	1221	IF( il_attid /= 0 )THEN
	1222	tl_proc%i_impp = INT(td_file%t_att(il_attid)%d_value(1))
	1223	tl_proc%i_jmpp = INT(td_file%t_att(il_attid)%d_value(2))
	1224	ELSE
	1225	tl_proc%i_impp = 1
	1226	tl_proc%i_jmpp = 1
	1227	ENDIF
	1228
	1229	! DOMAIN_position_last
	1230	il_attid = 0
	1231	IF( ASSOCIATED(td_file%t_att) )THEN
	1232	il_attid=att_get_id( td_file%t_att, "DOMAIN_position_last" )
	1233	ENDIF
	1234	IF( il_attid /= 0 )THEN
	1235	tl_proc%i_lci = INT(td_file%t_att(il_attid)%d_value(1)) + tl_proc%i_impp
	1236	tl_proc%i_lcj = INT(td_file%t_att(il_attid)%d_value(2)) + tl_proc%i_jmpp
	1237	ELSE
[5600]	1238	tl_proc%i_lci = mpp__init_file_cdf%t_dim(1)%i_len
	1239	tl_proc%i_lcj = mpp__init_file_cdf%t_dim(2)%i_len
[4213]	1240	ENDIF
	1241
	1242	! DOMAIN_halo_size_start
	1243	il_attid = 0
	1244	IF( ASSOCIATED(td_file%t_att) )THEN
	1245	il_attid=att_get_id( td_file%t_att, "DOMAIN_halo_size_start" )
	1246	ENDIF
	1247	IF( il_attid /= 0 )THEN
	1248	tl_proc%i_ldi = INT(td_file%t_att(il_attid)%d_value(1))
	1249	tl_proc%i_ldj = INT(td_file%t_att(il_attid)%d_value(2))
	1250	ELSE
	1251	tl_proc%i_ldi = 1
	1252	tl_proc%i_ldj = 1
	1253	ENDIF
	1254
	1255	! DOMAIN_halo_size_end
	1256	il_attid = 0
	1257	IF( ASSOCIATED(td_file%t_att) )THEN
	1258	il_attid=att_get_id( td_file%t_att, "DOMAIN_halo_size_end" )
	1259	ENDIF
	1260	IF( il_attid /= 0 )THEN
	1261	tl_proc%i_lei = INT(td_file%t_att(il_attid)%d_value(1))
	1262	tl_proc%i_lej = INT(td_file%t_att(il_attid)%d_value(2))
	1263	ELSE
[5600]	1264	tl_proc%i_lei = mpp__init_file_cdf%t_dim(1)%i_len
	1265	tl_proc%i_lej = mpp__init_file_cdf%t_dim(2)%i_len
[4213]	1266	ENDIF
	1267
	1268	! add attributes
	1269	tl_att=att_init( "DOMAIN_size_global", &
[5600]	1270	& mpp__init_file_cdf%t_dim(:)%i_len)
[4213]	1271	CALL file_move_att(tl_proc, tl_att)
	1272
	1273	tl_att=att_init( "DOMAIN_number", tl_proc%i_pid )
	1274	CALL file_move_att(tl_proc, tl_att)
	1275
	1276	tl_att=att_init( "DOMAIN_position_first", &
	1277	& (/tl_proc%i_impp, tl_proc%i_jmpp /) )
	1278	CALL file_move_att(tl_proc, tl_att)
	1279
	1280	tl_att=att_init( "DOMAIN_position_last", &
	1281	& (/tl_proc%i_lci, tl_proc%i_lcj /) )
	1282	CALL file_move_att(tl_proc, tl_att)
	1283
	1284	tl_att=att_init( "DOMAIN_halo_size_start", &
	1285	& (/tl_proc%i_ldi, tl_proc%i_ldj /) )
	1286	CALL file_move_att(tl_proc, tl_att)
	1287
	1288	tl_att=att_init( "DOMAIN_halo_size_end", &
	1289	& (/tl_proc%i_lei, tl_proc%i_lej /) )
	1290	CALL file_move_att(tl_proc, tl_att)
	1291
	1292	! add processor to mpp structure
[5600]	1293	CALL mpp__add_proc(mpp__init_file_cdf, tl_proc)
[4213]	1294
[5600]	1295	! clean
	1296	CALL file_clean(tl_proc)
	1297	CALL att_clean(tl_att)
[4213]	1298	ENDIF
	1299
	1300	ELSE
	1301
[5600]	1302	CALL logger_error("MPP INIT READ: netcdf file "//TRIM(td_file%c_name)//&
[4213]	1303	& " do not exist")
	1304
	1305	ENDIF
[5600]	1306	END FUNCTION mpp__init_file_cdf
[4213]	1307	!-------------------------------------------------------------------
	1308	!> @brief This function initalise a mpp structure,
	1309	!> reading one dimg restart file.
	1310	!
	1311	!> @details
	1312	!
	1313	!> @author J.Paul
[5600]	1314	!> - November, 2013- Initial Version
[4213]	1315	!
[5600]	1316	!> @param[in] td_file file strcuture
[4213]	1317	!> @return mpp structure
	1318	!-------------------------------------------------------------------
[5600]	1319	TYPE(TMPP) FUNCTION mpp__init_file_rstdimg( td_file )
[4213]	1320	IMPLICIT NONE
	1321
	1322	! Argument
	1323	TYPE(TFILE), INTENT(IN) :: td_file
	1324
	1325	! local variable
[5600]	1326	INTEGER(i4) :: il_status
	1327	INTEGER(i4) :: il_recl ! record length
	1328	INTEGER(i4) :: il_nx, il_ny, il_nz ! x,y,z dimension
	1329	INTEGER(i4) :: il_n0d, il_n1d, il_n2d, il_n3d ! number of 0/1/2/3D variables
	1330	INTEGER(i4) :: il_iglo, il_jglo ! domain global size
	1331	INTEGER(i4) :: il_rhd ! record of the header infos
	1332	INTEGER(i4) :: il_pni, il_pnj, il_pnij ! domain decomposition
	1333	INTEGER(i4) :: il_area ! domain index
[4213]	1334
[5600]	1335	LOGICAL :: ll_exist
	1336	LOGICAL :: ll_open
[4213]	1337
	1338	CHARACTER(LEN=lc) :: cl_file
	1339
[5600]	1340	TYPE(TDIM) :: tl_dim ! dimension structure
	1341	TYPE(TATT) :: tl_att
	1342	TYPE(TFILE) :: tl_proc
[4213]	1343
	1344	! loop indices
	1345	INTEGER(i4) :: ji
	1346	!----------------------------------------------------------------
	1347
	1348	INQUIRE( FILE=TRIM(td_file%c_name), EXIST=ll_exist, OPENED=ll_open)
	1349	IF( ll_exist )THEN
	1350
	1351	IF( .NOT. ll_open )THEN
[5600]	1352	CALL logger_error("MPP INIT READ: dimg file "//TRIM(td_file%c_name)//&
[4213]	1353	& " not opened")
	1354	ELSE
	1355
	1356	! read first record
	1357	READ( td_file%i_id, IOSTAT=il_status, REC=1 )&
	1358	& il_recl, &
	1359	& il_nx, il_ny, il_nz, &
	1360	& il_n0d, il_n1d, il_n2d, il_n3d, &
	1361	& il_rhd, &
	1362	& il_pni, il_pnj, il_pnij, &
	1363	& il_area
	1364	CALL fct_err(il_status)
	1365	IF( il_status /= 0 )THEN
[5600]	1366	CALL logger_error("MPP INIT READ: read first line header of "//&
[4213]	1367	& TRIM(td_file%c_name))
	1368	ENDIF
	1369
	1370	! get mpp name
[5600]	1371	mpp__init_file_rstdimg%c_name=TRIM( file_rename(td_file%c_name) )
[4213]	1372
[5600]	1373	! add type
	1374	mpp__init_file_rstdimg%c_type="dimg"
	1375
[4213]	1376	! number of processors to be read
[5600]	1377	mpp__init_file_rstdimg%i_nproc = il_pnij
	1378	mpp__init_file_rstdimg%i_niproc = il_pni
	1379	mpp__init_file_rstdimg%i_njproc = il_pnj
[4213]	1380
[5600]	1381	IF( ASSOCIATED(mpp__init_file_rstdimg%t_proc) )THEN
	1382	CALL file_clean(mpp__init_file_rstdimg%t_proc(:))
	1383	DEALLOCATE(mpp__init_file_rstdimg%t_proc)
[4213]	1384	ENDIF
[5600]	1385	ALLOCATE( mpp__init_file_rstdimg%t_proc(il_pnij) , stat=il_status )
	1386
	1387	tl_proc=file_copy(td_file)
	1388	! remove dimension from file
	1389	CALL dim_clean(tl_proc%t_dim(:))
	1390	! initialise file/processors
	1391	DO ji=1,mpp__init_file_rstdimg%i_nproc
	1392	mpp__init_file_rstdimg%t_proc(ji)=file_copy(tl_proc)
	1393	ENDDO
	1394
[4213]	1395	IF( il_status /= 0 )THEN
[5600]	1396	CALL logger_error("MPP INIT READ: not enough space to read domain &
[4213]	1397	& decomposition in file "//TRIM(td_file%c_name))
	1398	ENDIF
	1399
	1400	! read first record
	1401	READ( td_file%i_id, IOSTAT=il_status, REC=1 )&
	1402	& il_recl, &
	1403	& il_nx, il_ny, il_nz, &
	1404	& il_n0d, il_n1d, il_n2d, il_n3d, &
	1405	& il_rhd, &
	1406	& il_pni, il_pnj, il_pnij, &
	1407	& il_area, &
	1408	& il_iglo, il_jglo, &
[5600]	1409	& mpp__init_file_rstdimg%t_proc(:)%i_lci, &
	1410	& mpp__init_file_rstdimg%t_proc(:)%i_lcj, &
	1411	& mpp__init_file_rstdimg%t_proc(:)%i_ldi, &
	1412	& mpp__init_file_rstdimg%t_proc(:)%i_ldj, &
	1413	& mpp__init_file_rstdimg%t_proc(:)%i_lei, &
	1414	& mpp__init_file_rstdimg%t_proc(:)%i_lej, &
	1415	& mpp__init_file_rstdimg%t_proc(:)%i_impp, &
	1416	& mpp__init_file_rstdimg%t_proc(:)%i_jmpp
[4213]	1417	CALL fct_err(il_status)
	1418	IF( il_status /= 0 )THEN
[5600]	1419	CALL logger_error("MPP INIT READ: read first line of "//&
[4213]	1420	& TRIM(td_file%c_name))
	1421	ENDIF
	1422
[5600]	1423	! global domain size
[4213]	1424	tl_dim=dim_init('X',il_iglo)
[5600]	1425	CALL mpp_add_dim(mpp__init_file_rstdimg,tl_dim)
[4213]	1426	tl_dim=dim_init('Y',il_jglo)
[5600]	1427	CALL mpp_add_dim(mpp__init_file_rstdimg,tl_dim)
[4213]	1428
[5600]	1429	tl_dim=dim_init('Z',il_nz)
	1430	CALL mpp_add_dim(mpp__init_file_rstdimg,tl_dim)
	1431
	1432	DO ji=1,mpp__init_file_rstdimg%i_nproc
[4213]	1433	! get file name
	1434	cl_file = file_rename(td_file%c_name,ji)
[5600]	1435	mpp__init_file_rstdimg%t_proc(ji)%c_name = TRIM(cl_file)
[4213]	1436	! update processor id
[5600]	1437	mpp__init_file_rstdimg%t_proc(ji)%i_pid=ji
[4213]	1438
	1439	! add attributes
	1440	tl_att=att_init( "DOMAIN_number", ji )
[5600]	1441	CALL file_move_att(mpp__init_file_rstdimg%t_proc(ji), tl_att)
[4213]	1442
	1443	tl_att=att_init( "DOMAIN_position_first", &
[5600]	1444	& (/mpp__init_file_rstdimg%t_proc(ji)%i_impp, &
	1445	& mpp__init_file_rstdimg%t_proc(ji)%i_jmpp /) )
	1446	CALL file_move_att(mpp__init_file_rstdimg%t_proc(ji), tl_att)
[4213]	1447
	1448	tl_att=att_init( "DOMAIN_position_last", &
[5600]	1449	& (/mpp__init_file_rstdimg%t_proc(ji)%i_lci, &
	1450	& mpp__init_file_rstdimg%t_proc(ji)%i_lcj /) )
	1451	CALL file_move_att(mpp__init_file_rstdimg%t_proc(ji), tl_att)
[4213]	1452
	1453	tl_att=att_init( "DOMAIN_halo_size_start", &
[5600]	1454	& (/mpp__init_file_rstdimg%t_proc(ji)%i_ldi, &
	1455	& mpp__init_file_rstdimg%t_proc(ji)%i_ldj /) )
	1456	CALL file_move_att(mpp__init_file_rstdimg%t_proc(ji), tl_att)
[4213]	1457
	1458	tl_att=att_init( "DOMAIN_halo_size_end", &
[5600]	1459	& (/mpp__init_file_rstdimg%t_proc(ji)%i_lei, &
	1460	& mpp__init_file_rstdimg%t_proc(ji)%i_lej /) )
	1461	CALL file_move_att(mpp__init_file_rstdimg%t_proc(ji), tl_att)
[4213]	1462	ENDDO
[5600]	1463
[4213]	1464	! add type
[5600]	1465	mpp__init_file_rstdimg%t_proc(:)%c_type="dimg"
[4213]	1466
	1467	! add attributes
	1468	tl_att=att_init( "DOMAIN_size_global", &
[5600]	1469	& mpp__init_file_rstdimg%t_dim(:)%i_len)
	1470	CALL mpp_move_att(mpp__init_file_rstdimg, tl_att)
[4213]	1471
	1472	tl_att=att_init( "DOMAIN_number_total", &
[5600]	1473	& mpp__init_file_rstdimg%i_nproc )
	1474	CALL mpp_move_att(mpp__init_file_rstdimg, tl_att)
[4213]	1475
	1476	tl_att=att_init( "DOMAIN_I_number_total", &
[5600]	1477	& mpp__init_file_rstdimg%i_niproc )
	1478	CALL mpp_move_att(mpp__init_file_rstdimg, tl_att)
[4213]	1479
	1480	tl_att=att_init( "DOMAIN_J_number_total", &
[5600]	1481	& mpp__init_file_rstdimg%i_njproc )
	1482	CALL mpp_move_att(mpp__init_file_rstdimg, tl_att)
[4213]	1483
	1484	tl_att=att_init( "DOMAIN_I_position_first", &
[5600]	1485	& mpp__init_file_rstdimg%t_proc(:)%i_impp )
	1486	CALL mpp_move_att(mpp__init_file_rstdimg, tl_att)
[4213]	1487
	1488	tl_att=att_init( "DOMAIN_J_position_first", &
[5600]	1489	& mpp__init_file_rstdimg%t_proc(:)%i_jmpp )
	1490	CALL mpp_move_att(mpp__init_file_rstdimg, tl_att)
[4213]	1491
	1492	tl_att=att_init( "DOMAIN_I_position_last", &
[5600]	1493	& mpp__init_file_rstdimg%t_proc(:)%i_lci )
	1494	CALL mpp_move_att(mpp__init_file_rstdimg, tl_att)
[4213]	1495
	1496	tl_att=att_init( "DOMAIN_J_position_last", &
[5600]	1497	& mpp__init_file_rstdimg%t_proc(:)%i_lcj )
	1498	CALL mpp_move_att(mpp__init_file_rstdimg, tl_att)
[4213]	1499
	1500	tl_att=att_init( "DOMAIN_I_halo_size_start", &
[5600]	1501	& mpp__init_file_rstdimg%t_proc(:)%i_ldi )
	1502	CALL mpp_move_att(mpp__init_file_rstdimg, tl_att)
[4213]	1503
	1504	tl_att=att_init( "DOMAIN_J_halo_size_start", &
[5600]	1505	& mpp__init_file_rstdimg%t_proc(:)%i_ldj )
	1506	CALL mpp_move_att(mpp__init_file_rstdimg, tl_att)
[4213]	1507
	1508	tl_att=att_init( "DOMAIN_I_halo_size_end", &
[5600]	1509	& mpp__init_file_rstdimg%t_proc(:)%i_lei )
	1510	CALL mpp_move_att(mpp__init_file_rstdimg, tl_att)
[4213]	1511
	1512	tl_att=att_init( "DOMAIN_J_halo_size_end", &
[5600]	1513	& mpp__init_file_rstdimg%t_proc(:)%i_lej )
	1514	CALL mpp_move_att(mpp__init_file_rstdimg, tl_att)
	1515
	1516	! clean
	1517	CALL dim_clean(tl_dim)
	1518	CALL att_clean(tl_att)
[4213]	1519	ENDIF
	1520
	1521	ELSE
	1522
[5600]	1523	CALL logger_error("MPP INIT READ: dimg file "//TRIM(td_file%c_name)//&
[4213]	1524	& " do not exist")
	1525
	1526	ENDIF
	1527
[5600]	1528	END FUNCTION mpp__init_file_rstdimg
[4213]	1529	!-------------------------------------------------------------------
	1530	!> @brief This function check if variable and mpp structure use same
	1531	!> dimension.
	1532	!
	1533	!> @author J.Paul
	1534	!> - Nov, 2013- Initial Version
	1535	!
[5600]	1536	!> @param[in] td_mpp mpp structure
	1537	!> @param[in] td_proc processor structure
[4213]	1538	!> @return dimension of processor and mpp structure agree (or not)
	1539	!-------------------------------------------------------------------
	1540	LOGICAL FUNCTION mpp__check_proc_dim(td_mpp, td_proc)
	1541	IMPLICIT NONE
	1542	! Argument
	1543	TYPE(TMPP), INTENT(IN) :: td_mpp
	1544	TYPE(TFILE), INTENT(IN) :: td_proc
	1545
	1546	! local variable
	1547	INTEGER(i4) :: il_isize !< i-direction maximum sub domain size
	1548	INTEGER(i4) :: il_jsize !< j-direction maximum sub domain size
	1549
	1550	!----------------------------------------------------------------
	1551	mpp__check_proc_dim=.TRUE.
	1552	! check used dimension
	1553	IF( td_mpp%i_niproc /= 0 .AND. td_mpp%i_njproc /= 0 )THEN
	1554	! check with maximum size of sub domain
	1555	il_isize = ( td_mpp%t_dim(1)%i_len - 2*td_mpp%i_preci + &
	1556	& (td_mpp%i_niproc-1) ) / td_mpp%i_niproc + 2*td_mpp%i_preci
	1557	il_jsize = ( td_mpp%t_dim(2)%i_len - 2*td_mpp%i_precj + &
	1558	& (td_mpp%i_njproc-1) ) / td_mpp%i_njproc + 2*td_mpp%i_precj
	1559
	1560	IF( il_isize < td_proc%i_lci .OR. &
	1561	& il_jsize < td_proc%i_lcj )THEN
	1562
	1563	mpp__check_proc_dim=.FALSE.
	1564
[5600]	1565	CALL logger_error( "MPP CHECK DIM: processor and mpp dimension differ" )
[4213]	1566
	1567	ENDIF
	1568
	1569	ELSE
	1570	! check with global domain size
	1571	IF( td_mpp%t_dim(1)%i_len < td_proc%i_lci .OR. &
	1572	& td_mpp%t_dim(2)%i_len < td_proc%i_lcj )THEN
	1573
	1574	mpp__check_proc_dim=.FALSE.
	1575
[5600]	1576	CALL logger_error( "MPP CHECK DIM: processor and mpp dimension differ" )
[4213]	1577
	1578	ENDIF
	1579	ENDIF
	1580
	1581	END FUNCTION mpp__check_proc_dim
	1582	!-------------------------------------------------------------------
	1583	!> @brief
[5600]	1584	!> This subroutine add variable in all files of mpp structure.
[4213]	1585	!>
	1586	!> @author J.Paul
[5600]	1587	!> @date November, 2013 - Initial version
[4213]	1588	!
[5600]	1589	!> @param[inout] td_mpp mpp strcuture
	1590	!> @param[in] td_var variable strcuture
[4213]	1591	!-------------------------------------------------------------------
	1592	SUBROUTINE mpp_add_var( td_mpp, td_var )
	1593	IMPLICIT NONE
	1594	! Argument
	1595	TYPE(TMPP), INTENT(INOUT) :: td_mpp
	1596	TYPE(TVAR), INTENT(IN) :: td_var
	1597
	1598	! local variable
	1599	INTEGER(i4) :: il_varid
	1600	TYPE(TVAR) :: tl_var
	1601
	1602	! loop indices
	1603	INTEGER(i4) :: ji
	1604	!----------------------------------------------------------------
	1605	! check if mpp exist
	1606	IF( .NOT. ASSOCIATED(td_mpp%t_proc) )THEN
	1607
[5600]	1608	CALL logger_error( "MPP ADD VAR: processor decomposition not "//&
	1609	& "define for mpp "//TRIM(td_mpp%c_name))
[4213]	1610
	1611	ELSE
	1612	! check if variable exist
	1613	IF( TRIM(td_var%c_name) == '' .AND. &
	1614	& TRIM(td_var%c_stdname) == '' )THEN
	1615	CALL logger_error("MPP ADD VAR: variable not define ")
	1616	ELSE
	1617	! check if variable already in mpp structure
	1618	il_varid=0
	1619	IF( ASSOCIATED(td_mpp%t_proc(1)%t_var) )THEN
[5600]	1620	il_varid=var_get_index( td_mpp%t_proc(1)%t_var(:), &
	1621	& td_var%c_name, td_var%c_stdname )
[4213]	1622	ENDIF
	1623
	1624	IF( il_varid /= 0 )THEN
	1625
	1626	CALL logger_error( " MPP ADD VAR: variable "//TRIM(td_var%c_name)//&
	1627	& ", standard name "//TRIM(td_var%c_stdname)//&
	1628	& ", already in mpp "//TRIM(td_mpp%c_name) )
	1629
	1630	DO ji=1,td_mpp%t_proc(1)%i_nvar
	1631	CALL logger_debug( " MPP ADD VAR: in mpp structure : &
	1632	& variable "//TRIM(td_mpp%t_proc(1)%t_var(ji)%c_name)//&
	1633	& ", standard name "//&
	1634	& TRIM(td_mpp%t_proc(1)%t_var(ji)%c_stdname) )
	1635	ENDDO
	1636
	1637	ELSE
	1638
	1639	CALL logger_info( &
	1640	& " MPP ADD VAR: add variable "//TRIM(td_var%c_name)//&
	1641	& ", standard name "//TRIM(td_var%c_stdname)//&
	1642	& ", in mpp "//TRIM(td_mpp%c_name) )
	1643	! check used dimension
	1644	IF( mpp__check_dim(td_mpp, td_var) )THEN
	1645
[5600]	1646	! update dimension if need be
	1647	DO ji=1,ip_maxdim
	1648	IF( td_var%t_dim(ji)%l_use .AND. &
	1649	& .NOT. td_mpp%t_dim(ji)%l_use )THEN
	1650	CALL mpp_add_dim(td_mpp,td_var%t_dim(ji))
	1651	ENDIF
	1652	ENDDO
	1653
[4213]	1654	! add variable in each processor
	1655	DO ji=1,td_mpp%i_nproc
	1656
	1657	! split variable on domain decomposition
	1658	tl_var=mpp__split_var(td_mpp, td_var, ji)
	1659
	1660	CALL file_add_var(td_mpp%t_proc(ji), tl_var)
	1661
[5600]	1662	! clean
	1663	CALL var_clean(tl_var)
[4213]	1664	ENDDO
	1665
	1666	ENDIF
	1667	ENDIF
	1668	ENDIF
	1669	ENDIF
	1670
	1671	END SUBROUTINE mpp_add_var
	1672	!-------------------------------------------------------------------
[5600]	1673	!> @brief This function extract, from variable structure, part that will
[4213]	1674	!> be written in processor id_procid.<br/>
	1675	!
	1676	!> @author J.Paul
[5600]	1677	!> - November, 2013- Initial Version
[4213]	1678	!
[5600]	1679	!> @param[in] td_mpp mpp structure
	1680	!> @param[in] td_var variable structure
	1681	!> @param[in] id_procid processor id
[4213]	1682	!> @return variable structure
	1683	!-------------------------------------------------------------------
	1684	TYPE(TVAR) FUNCTION mpp__split_var(td_mpp, td_var, id_procid)
	1685	IMPLICIT NONE
	1686	! Argument
	1687	TYPE(TMPP), INTENT(IN) :: td_mpp
	1688	TYPE(TVAR), INTENT(IN) :: td_var
	1689	INTEGER(i4), INTENT(IN) :: id_procid
	1690
	1691	! local variable
	1692	TYPE(TDIM) :: tl_dim
	1693
	1694	INTEGER(i4), DIMENSION(4) :: il_ind
	1695	INTEGER(i4), DIMENSION(2) :: il_size
	1696	INTEGER(i4) :: il_i1
	1697	INTEGER(i4) :: il_i2
	1698	INTEGER(i4) :: il_j1
	1699	INTEGER(i4) :: il_j2
	1700	!----------------------------------------------------------------
	1701
	1702	! copy mpp
[5600]	1703	mpp__split_var=var_copy(td_var)
[4213]	1704
[5600]	1705	IF( ASSOCIATED(td_var%d_value) )THEN
	1706	! remove value over global domain from pointer
	1707	CALL var_del_value( mpp__split_var )
[4213]	1708
[5600]	1709	! get processor dimension
	1710	il_size(:)=mpp_get_proc_size( td_mpp, id_procid )
[4213]	1711
[5600]	1712	! define new dimension in variable structure
	1713	IF( td_var%t_dim(1)%l_use )THEN
	1714	tl_dim=dim_init( TRIM(td_var%t_dim(1)%c_name), il_size(1) )
	1715	CALL var_move_dim( mpp__split_var, tl_dim )
	1716	ENDIF
	1717	IF( td_var%t_dim(2)%l_use )THEN
	1718	tl_dim=dim_init( TRIM(td_var%t_dim(2)%c_name), il_size(2) )
	1719	CALL var_move_dim( mpp__split_var, tl_dim )
	1720	ENDIF
[4213]	1721
[5600]	1722	! get processor indices
	1723	il_ind(:)=mpp_get_proc_index( td_mpp, id_procid )
	1724	il_i1 = il_ind(1)
	1725	il_i2 = il_ind(2)
	1726	il_j1 = il_ind(3)
	1727	il_j2 = il_ind(4)
[4213]	1728
[5600]	1729	IF( .NOT. td_var%t_dim(1)%l_use )THEN
	1730	il_i1=1
	1731	il_i2=1
	1732	ENDIF
[4213]	1733
[5600]	1734	IF( .NOT. td_var%t_dim(2)%l_use )THEN
	1735	il_j1=1
	1736	il_j2=1
	1737	ENDIF
[4213]	1738
[5600]	1739	! add variable value on processor
	1740	CALL var_add_value( mpp__split_var, &
	1741	& td_var%d_value(il_i1:il_i2, il_j1:il_j2, :, :) )
	1742	ENDIF
[4213]	1743
	1744	END FUNCTION mpp__split_var
	1745	!-------------------------------------------------------------------
[5600]	1746	!> @brief
	1747	!> This subroutine delete all variable in mpp strcuture.
	1748	!>
	1749	!> @author J.Paul
	1750	!> @date October, 2014 - Initial version
	1751	!>
	1752	!> @param[inout] td_mpp mpp strcuture
	1753	!-------------------------------------------------------------------
	1754	SUBROUTINE mpp__del_var_mpp( td_mpp )
	1755	IMPLICIT NONE
	1756	! Argument
	1757	TYPE(TMPP), INTENT(INOUT) :: td_mpp
	1758
	1759	! local variable
	1760	! loop indices
	1761	INTEGER(i4) :: ji
	1762	!----------------------------------------------------------------
	1763
	1764	CALL logger_info( &
	1765	& "MPP CLEAN VAR: reset all variable "//&
	1766	& "in mpp strcuture "//TRIM(td_mpp%c_name) )
	1767
	1768	IF( ASSOCIATED(td_mpp%t_proc) )THEN
	1769	DO ji=td_mpp%t_proc(1)%i_nvar,1,-1
	1770	CALL mpp_del_var(td_mpp, td_mpp%t_proc(1)%t_var(ji))
	1771	ENDDO
	1772	ENDIF
	1773
	1774	END SUBROUTINE mpp__del_var_mpp
	1775	!-------------------------------------------------------------------
[4213]	1776	!> @brief
	1777	!> This subroutine delete variable in mpp structure, given variable
	1778	!> structure.
	1779	!>
	1780	!> @author J.Paul
[5600]	1781	!> @date November, 2013 - Initial version
[4213]	1782	!
[5600]	1783	!> @param[inout] td_mpp mpp strcuture
	1784	!> @param[in] td_var variable strcuture
[4213]	1785	!-------------------------------------------------------------------
	1786	SUBROUTINE mpp__del_var_str( td_mpp, td_var )
	1787	IMPLICIT NONE
	1788	! Argument
	1789	TYPE(TMPP), INTENT(INOUT) :: td_mpp
	1790	TYPE(TVAR), INTENT(IN) :: td_var
	1791
	1792	! local variable
	1793	INTEGER(i4) :: il_varid
	1794	CHARACTER(LEN=lc) :: cl_name
	1795
	1796	! loop indices
	1797	INTEGER(i4) :: ji
	1798	!----------------------------------------------------------------
	1799	! check if mpp exist
	1800	IF( .NOT. ASSOCIATED(td_mpp%t_proc) )THEN
	1801
[5600]	1802	CALL logger_error( "MPP DEL VAR: domain decomposition not define "//&
[4213]	1803	& " in mpp strcuture "//TRIM(td_mpp%c_name))
	1804
	1805	ELSE
	1806
	1807	! check if variable already in mpp structure
	1808	il_varid = 0
	1809	IF( ASSOCIATED(td_mpp%t_proc(1)%t_var) )THEN
[5600]	1810	il_varid=var_get_index( td_mpp%t_proc(1)%t_var(:), &
	1811	& td_var%c_name, td_var%c_stdname )
[4213]	1812	ENDIF
	1813	IF( il_varid == 0 )THEN
	1814	CALL logger_error( &
[5600]	1815	& "MPP DEL VAR: no variable "//TRIM(td_var%c_name)//&
[4213]	1816	& ", in mpp structure "//TRIM(td_mpp%c_name) )
	1817
	1818	DO ji=1,td_mpp%t_proc(1)%i_nvar
[5600]	1819	CALL logger_debug( "MPP DEL VAR: in mpp structure : &
[4213]	1820	& variable : "//TRIM(td_mpp%t_proc(1)%t_var(ji)%c_name)//&
	1821	& ", standard name "//&
	1822	& TRIM(td_mpp%t_proc(1)%t_var(ji)%c_stdname) )
	1823	ENDDO
	1824
	1825	ELSE
	1826
	1827	cl_name=TRIM(td_var%c_name)
	1828	DO ji=1,td_mpp%i_nproc
	1829	CALL file_del_var(td_mpp%t_proc(ji), TRIM(cl_name))
	1830	ENDDO
	1831
	1832	ENDIF
	1833
	1834	ENDIF
	1835	END SUBROUTINE mpp__del_var_str
	1836	!-------------------------------------------------------------------
	1837	!> @brief
	1838	!> This subroutine delete variable in mpp structure, given variable name.
	1839	!>
	1840	!> @author J.Paul
[5600]	1841	!> @date November, 2013 - Initial version
[4213]	1842	!
[5600]	1843	!> @param[inout] td_mpp mpp strcuture
	1844	!> @param[in] cd_name variable name
[4213]	1845	!-------------------------------------------------------------------
	1846	SUBROUTINE mpp__del_var_name( td_mpp, cd_name )
	1847	IMPLICIT NONE
	1848	! Argument
	1849	TYPE(TMPP) , INTENT(INOUT) :: td_mpp
	1850	CHARACTER(LEN=*), INTENT(IN ) :: cd_name
	1851
	1852	! local variable
	1853	INTEGER(i4) :: il_varid
	1854	!----------------------------------------------------------------
	1855	! check if mpp exist
	1856	IF( .NOT. ASSOCIATED(td_mpp%t_proc) )THEN
	1857
[5600]	1858	CALL logger_error( "MPP DEL VAR: domain decomposition not define "//&
[4213]	1859	& " in mpp strcuture "//TRIM(td_mpp%c_name))
	1860
	1861	ELSE
	1862
	1863	IF( td_mpp%t_proc(1)%i_nvar == 0 )THEN
[5600]	1864	CALL logger_debug( "MPP DEL VAR NAME: no variable associated to mpp &
[4213]	1865	& structure "//TRIM(td_mpp%c_name) )
	1866	ELSE
	1867
	1868	! get the variable id, in file variable structure
	1869	il_varid=0
	1870	IF( ASSOCIATED(td_mpp%t_proc(1)%t_var) )THEN
[5600]	1871	il_varid=var_get_index( td_mpp%t_proc(1)%t_var(:), &
	1872	& cd_name )
[4213]	1873	ENDIF
[5600]	1874
[4213]	1875	IF( il_varid == 0 )THEN
	1876
	1877	CALL logger_warn( &
[5600]	1878	& "MPP DEL VAR : there is no variable with name "//&
[4213]	1879	& "or standard name "//TRIM(ADJUSTL(cd_name))//&
	1880	& " in mpp structure "//TRIM(td_mpp%c_name))
	1881
	1882	ELSE
	1883
	1884	CALL mpp_del_var(td_mpp, td_mpp%t_proc(1)%t_var(il_varid))
	1885
	1886	ENDIF
	1887	ENDIF
	1888
	1889	ENDIF
	1890	END SUBROUTINE mpp__del_var_name
	1891	!-------------------------------------------------------------------
	1892	!> @brief
	1893	!> This subroutine overwrite variable in mpp structure.
	1894	!>
	1895	!> @author J.Paul
[5600]	1896	!> @date November, 2013 - Initial version
[4213]	1897	!
[5600]	1898	!> @param[inout] td_mpp mpp strcuture
	1899	!> @param[in] td_var variable structure
[4213]	1900	!-------------------------------------------------------------------
	1901	SUBROUTINE mpp_move_var( td_mpp, td_var )
	1902	IMPLICIT NONE
	1903	! Argument
	1904	TYPE(TMPP), INTENT(INOUT) :: td_mpp
	1905	TYPE(TVAR), INTENT(IN) :: td_var
	1906
	1907	!local variable
	1908	TYPE(TVAR) :: tl_var
	1909	!----------------------------------------------------------------
	1910	! copy variable
[5600]	1911	tl_var=var_copy(td_var)
[4213]	1912
	1913	! remove processor
	1914	CALL mpp_del_var(td_mpp, tl_var)
	1915
	1916	! add processor
	1917	CALL mpp_add_var(td_mpp, tl_var)
	1918
[5600]	1919	! clean
	1920	CALL var_clean(tl_var)
	1921
[4213]	1922	END SUBROUTINE mpp_move_var
	1923	!> @endcode
	1924	!-------------------------------------------------------------------
	1925	!> @brief
	1926	!> This subroutine add processor to mpp structure.
	1927	!>
	1928	!> @author J.Paul
[5600]	1929	!> @date November, 2013 - Initial version
[4213]	1930	!
[5600]	1931	!> @param[inout] td_mpp mpp strcuture
	1932	!> @param[in] td_proc processor strcuture
[4213]	1933	!
	1934	!> @todo
	1935	!> - check proc type
	1936	!-------------------------------------------------------------------
	1937	SUBROUTINE mpp__add_proc( td_mpp, td_proc )
	1938	IMPLICIT NONE
	1939	! Argument
	1940	TYPE(TMPP) , INTENT(INOUT) :: td_mpp
	1941	TYPE(TFILE), INTENT(IN) :: td_proc
	1942
	1943	! local variable
	1944	INTEGER(i4) :: il_status
	1945	INTEGER(i4) :: il_procid
	1946	INTEGER(i4) , DIMENSION(1) :: il_ind
	1947
	1948	TYPE(TFILE) , DIMENSION(:), ALLOCATABLE :: tl_proc
	1949
	1950	CHARACTER(LEN=lc) :: cl_name
	1951	!----------------------------------------------------------------
	1952
	1953	! check file name
	1954	cl_name=TRIM( file_rename(td_proc%c_name) )
	1955	IF( TRIM(cl_name) /= TRIM(td_mpp%c_name) )THEN
	1956	CALL logger_warn("MPP ADD PROC: processor name do not match mpp name")
	1957	ENDIF
	1958
	1959	il_procid=0
	1960	IF( ASSOCIATED(td_mpp%t_proc) )THEN
	1961	! check if processor already in mpp structure
	1962	il_ind(:)=MINLOC( td_mpp%t_proc(:)%i_pid, &
	1963	mask=(td_mpp%t_proc(:)%i_pid==td_proc%i_pid) )
	1964	il_procid=il_ind(1)
	1965	ENDIF
	1966
	1967	IF( il_procid /= 0 )THEN
	1968
	1969	CALL logger_error( &
[5600]	1970	& "MPP ADD PROC: processor "//TRIM(fct_str(td_proc%i_pid))//&
[4213]	1971	& ", already in mpp structure " )
	1972
	1973	ELSE
[5600]	1974
	1975	CALL logger_trace("MPP ADD PROC: add processor "//&
[4213]	1976	& TRIM(fct_str(td_mpp%i_nproc+1))//" in mpp structure")
	1977
	1978	IF( td_mpp%i_nproc > 0 )THEN
	1979	!
	1980	il_ind(:)=MAXLOC( td_mpp%t_proc(:)%i_pid, &
	1981	mask=(td_mpp%t_proc(:)%i_pid < td_proc%i_pid) )
	1982	il_procid=il_ind(1)
	1983
	1984	! already other processor in mpp structure
	1985	ALLOCATE( tl_proc(td_mpp%i_nproc), stat=il_status )
	1986	IF(il_status /= 0 )THEN
	1987
[5600]	1988	CALL logger_error( "MPP ADD PROC: not enough space to put processor &
[4213]	1989	& in mpp structure")
	1990
	1991	ELSE
	1992	! save temporary mpp structure
[5600]	1993	tl_proc(:)=file_copy(td_mpp%t_proc(:))
[4213]	1994
[5600]	1995	CALL file_clean( td_mpp%t_proc(:) )
	1996	DEALLOCATE(td_mpp%t_proc)
[4213]	1997	ALLOCATE( td_mpp%t_proc(td_mpp%i_nproc+1), stat=il_status)
	1998	IF(il_status /= 0 )THEN
	1999
[5600]	2000	CALL logger_error( "MPP ADD PROC: not enough space to put "//&
[4213]	2001	& "processor in mpp structure ")
	2002
	2003	ENDIF
	2004
	2005	! copy processor in mpp before
[5600]	2006	! processor with lower id than new processor
	2007	td_mpp%t_proc( 1:il_procid ) = file_copy(tl_proc( 1:il_procid ))
[4213]	2008
	2009	! processor with greater id than new processor
	2010	td_mpp%t_proc( il_procid+1 : td_mpp%i_nproc+1 ) = &
[5600]	2011	& file_copy(tl_proc( il_procid : td_mpp%i_nproc ))
[4213]	2012
[5600]	2013	! clean
	2014	CALL file_clean(tl_proc(:))
[4213]	2015	DEALLOCATE(tl_proc)
	2016	ENDIF
	2017
	2018	ELSE
	2019	! no processor in mpp structure
	2020	IF( ASSOCIATED(td_mpp%t_proc) )THEN
[5600]	2021	CALL file_clean(td_mpp%t_proc(:))
[4213]	2022	DEALLOCATE(td_mpp%t_proc)
	2023	ENDIF
	2024	ALLOCATE( td_mpp%t_proc(td_mpp%i_nproc+1), stat=il_status )
	2025	IF(il_status /= 0 )THEN
	2026
[5600]	2027	CALL logger_error( "MPP ADD PROC: not enough space to put "//&
[4213]	2028	& "processor in mpp structure " )
	2029
	2030	ENDIF
	2031	ENDIF
	2032
	2033	! check dimension
	2034	IF( ANY(td_mpp%t_dim(1:2)%i_len < td_proc%t_dim(1:2)%i_len) )THEN
[5600]	2035	CALL logger_error( "MPP ADD PROC: mpp structure and new processor "//&
[4213]	2036	& " dimension differ. ")
[5600]	2037	CALL logger_debug("MPP ADD PROC: mpp dimension ("//&
[4213]	2038	& TRIM(fct_str(td_mpp%t_dim(1)%i_len))//","//&
	2039	& TRIM(fct_str(td_mpp%t_dim(2)%i_len))//")" )
[5600]	2040	CALL logger_debug("MPP ADD PROC: processor dimension ("//&
[4213]	2041	& TRIM(fct_str(td_proc%t_dim(1)%i_len))//","//&
	2042	& TRIM(fct_str(td_proc%t_dim(2)%i_len))//")" )
	2043	ELSE
	2044	td_mpp%i_nproc=td_mpp%i_nproc+1
	2045
	2046	! add new processor
[5600]	2047	td_mpp%t_proc(td_mpp%i_nproc)=file_copy(td_proc)
[4213]	2048	ENDIF
	2049
	2050	ENDIF
	2051	END SUBROUTINE mpp__add_proc
	2052	!-------------------------------------------------------------------
	2053	!> @brief
	2054	!> This subroutine delete processor in mpp structure, given processor id.
	2055	!>
	2056	!> @author J.Paul
[5600]	2057	!> @date November, 2013 - Initial version
	2058	!>
	2059	!> @param[inout] td_mpp mpp strcuture
	2060	!> @param[in] id_procid processor id
[4213]	2061	!-------------------------------------------------------------------
	2062	SUBROUTINE mpp__del_proc_id( td_mpp, id_procid )
	2063	IMPLICIT NONE
	2064	! Argument
	2065	TYPE(TMPP), INTENT(INOUT) :: td_mpp
	2066	INTEGER(i4), INTENT(IN) :: id_procid
	2067
	2068	! local variable
	2069	INTEGER(i4) :: il_status
	2070	INTEGER(i4) :: il_procid
	2071	INTEGER(i4), DIMENSION(1) :: il_ind
	2072	TYPE(TFILE), DIMENSION(:), ALLOCATABLE :: tl_proc
[5600]	2073
	2074	! loop indices
[4213]	2075	!----------------------------------------------------------------
	2076
	2077	il_ind(:)=MINLOC(td_mpp%t_proc(:)%i_pid,td_mpp%t_proc(:)%i_pid==id_procid)
	2078	il_procid=il_ind(1)
	2079	IF( il_procid == 0 )THEN
[5600]	2080	CALL logger_error("MPP DEL PROC: no processor "//&
	2081	& TRIM(fct_str(id_procid))//&
	2082	& " associated to mpp structure")
[4213]	2083	ELSE
[5600]	2084	CALL logger_trace("DEL PROC: remove processor "//&
	2085	& TRIM(fct_str(id_procid)))
[4213]	2086
	2087	IF( td_mpp%i_nproc > 1 )THEN
	2088	ALLOCATE( tl_proc(td_mpp%i_nproc-1), stat=il_status )
	2089	IF(il_status /= 0 )THEN
[5600]	2090	CALL logger_error( "MPP DEL PROC: not enough space to put &
	2091	& processor in temporary mpp structure")
[4213]	2092
	2093	ELSE
	2094
	2095	! save temporary processor's mpp structure
	2096	IF( il_procid > 1 )THEN
[5600]	2097	tl_proc(1:il_procid-1)=file_copy(td_mpp%t_proc(1:il_procid-1))
[4213]	2098	ENDIF
	2099
[5600]	2100	IF( il_procid < td_mpp%i_nproc )THEN
	2101	tl_proc(il_procid:)=file_copy(td_mpp%t_proc(il_procid+1:))
	2102	ENDIF
	2103
[4213]	2104	! new number of processor in mpp
	2105	td_mpp%i_nproc=td_mpp%i_nproc-1
	2106
[5600]	2107	CALL file_clean( td_mpp%t_proc(:) )
	2108	DEALLOCATE(td_mpp%t_proc)
[4213]	2109	ALLOCATE( td_mpp%t_proc(td_mpp%i_nproc), stat=il_status )
	2110	IF(il_status /= 0 )THEN
	2111
[5600]	2112	CALL logger_error( "MPP DEL PROC: not enough space &
	2113	& to put processors in mpp structure " )
[4213]	2114
	2115	ELSE
	2116
	2117	! copy processor in mpp before
[5600]	2118	td_mpp%t_proc(:)=file_copy(tl_proc(:))
[4213]	2119
	2120	! update processor id
	2121	td_mpp%t_proc( il_procid : td_mpp%i_nproc )%i_pid = &
	2122	& td_mpp%t_proc( il_procid : td_mpp%i_nproc )%i_pid - 1
	2123
	2124	ENDIF
	2125	ENDIF
[5600]	2126	! clean
	2127	CALL file_clean( tl_proc(:) )
	2128	DEALLOCATE(tl_proc)
[4213]	2129	ELSE
[5600]	2130	CALL file_clean( td_mpp%t_proc(:) )
	2131	DEALLOCATE(td_mpp%t_proc)
[4213]	2132
	2133	! new number of processor in mpp
	2134	td_mpp%i_nproc=td_mpp%i_nproc-1
	2135	ENDIF
	2136	ENDIF
	2137	END SUBROUTINE mpp__del_proc_id
	2138	!-------------------------------------------------------------------
	2139	!> @brief
	2140	!> This subroutine delete processor in mpp structure, given processor
	2141	!> structure.
	2142	!>
	2143	!> @author J.Paul
[5600]	2144	!> @date November, 2013 - Initial version
[4213]	2145	!
	2146	!> @param[inout] td_mpp : mpp strcuture
	2147	!> @param[in] td_proc : file/processor structure
	2148	!-------------------------------------------------------------------
	2149	SUBROUTINE mpp__del_proc_str( td_mpp, td_proc )
	2150	IMPLICIT NONE
	2151	! Argument
	2152	TYPE(TMPP), INTENT(INOUT) :: td_mpp
	2153	TYPE(TFILE), INTENT(IN) :: td_proc
	2154	!----------------------------------------------------------------
	2155
	2156	IF( td_proc%i_pid >= 0 )THEN
	2157	CALL mpp__del_proc( td_mpp, td_proc%i_pid )
	2158	ELSE
[5600]	2159	CALL logger_error("MPP DEL PROC: processor not defined")
[4213]	2160	ENDIF
	2161
	2162	END SUBROUTINE mpp__del_proc_str
	2163	!-------------------------------------------------------------------
	2164	!> @brief
	2165	!> This subroutine overwrite processor in mpp structure.
	2166	!>
	2167	!> @detail
	2168	!
	2169	!> @author J.Paul
[5600]	2170	!> @date Nov, 2013 - Initial version
[4213]	2171	!
[5600]	2172	!> @param[inout] td_mpp mpp strcuture
	2173	!> @param[in] id_procid processor id
[4213]	2174	!-------------------------------------------------------------------
	2175	SUBROUTINE mpp__move_proc( td_mpp, td_proc )
	2176	IMPLICIT NONE
	2177	! Argument
	2178	TYPE(TMPP), INTENT(INOUT) :: td_mpp
	2179	TYPE(TFILE), INTENT(IN) :: td_proc
	2180	!----------------------------------------------------------------
	2181
	2182	! remove processor
	2183	CALL mpp__del_proc(td_mpp, td_proc)
	2184
	2185	! add processor
	2186	CALL mpp__add_proc(td_mpp, td_proc)
	2187
	2188	END SUBROUTINE mpp__move_proc
	2189	!-------------------------------------------------------------------
	2190	!> @brief This subroutine add a dimension structure in a mpp
	2191	!> structure.
	2192	!> Do not overwrite, if dimension already in mpp structure.
[5600]	2193	!>
[4213]	2194	!> @author J.Paul
[5600]	2195	!> - November, 2013- Initial Version
	2196	!>
	2197	!> @param[inout] td_mpp mpp structure
	2198	!> @param[in] td_dim dimension structure
[4213]	2199	!-------------------------------------------------------------------
	2200	SUBROUTINE mpp_add_dim(td_mpp, td_dim)
	2201	IMPLICIT NONE
	2202	! Argument
	2203	TYPE(TMPP), INTENT(INOUT) :: td_mpp
	2204	TYPE(TDIM), INTENT(IN) :: td_dim
	2205
	2206	! local variable
[5600]	2207	INTEGER(i4) :: il_ind
[4213]	2208
	2209	! loop indices
[5600]	2210	INTEGER(i4) :: ji
[4213]	2211	!----------------------------------------------------------------
[5600]	2212	IF( td_mpp%i_ndim <= ip_maxdim )THEN
[4213]	2213
	2214	! check if dimension already in mpp structure
[5600]	2215	il_ind=dim_get_index(td_mpp%t_dim(:), td_dim%c_name, td_dim%c_sname)
	2216	IF( il_ind /= 0 )THEN
[4213]	2217
[5600]	2218	IF( td_mpp%t_dim(il_ind)%l_use )THEN
	2219	CALL logger_error( &
	2220	& "MPP ADD DIM: dimension "//TRIM(td_dim%c_name)//&
	2221	& ", short name "//TRIM(td_dim%c_sname)//&
	2222	& ", already used in mpp "//TRIM(td_mpp%c_name) )
	2223	ELSE
	2224	! replace dimension
	2225	td_mpp%t_dim(il_ind)=dim_copy(td_dim)
	2226	td_mpp%t_dim(il_ind)%i_id=il_ind
	2227	td_mpp%t_dim(il_ind)%l_use=.TRUE.
	2228	ENDIF
[4213]	2229
	2230	ELSE
	2231
[5600]	2232	IF( td_mpp%i_ndim == ip_maxdim )THEN
	2233	CALL logger_error( &
	2234	& "MPP ADD DIM: can not add dimension "//TRIM(td_dim%c_name)//&
	2235	& ", short name "//TRIM(td_dim%c_sname)//&
	2236	& ", in mpp "//TRIM(td_mpp%c_name)//". Already "//&
	2237	& TRIM(fct_str(ip_maxdim))//" dimensions." )
	2238	ELSE
[4213]	2239	! search empty dimension
[5600]	2240	DO ji=1,ip_maxdim
	2241	IF( td_mpp%t_dim(ji)%i_id == 0 )THEN
	2242	il_ind=ji
	2243	EXIT
	2244	ENDIF
	2245	ENDDO
	2246
	2247	! add new dimension
	2248	td_mpp%t_dim(il_ind)=dim_copy(td_dim)
[4213]	2249	! update number of attribute
	2250	td_mpp%i_ndim=COUNT(td_mpp%t_dim(:)%l_use)
[5600]	2251
	2252	td_mpp%t_dim(il_ind)%l_use=.TRUE.
	2253	td_mpp%t_dim(il_ind)%i_id=td_mpp%i_ndim
[4213]	2254	ENDIF
	2255
	2256	ENDIF
	2257
	2258	ELSE
	2259	CALL logger_error( &
[5600]	2260	& "MPP ADD DIM: too much dimension in mpp "//&
[4213]	2261	& TRIM(td_mpp%c_name)//" ("//TRIM(fct_str(td_mpp%i_ndim))//")")
	2262	ENDIF
	2263
	2264	END SUBROUTINE mpp_add_dim
	2265	!-------------------------------------------------------------------
	2266	!> @brief This subroutine delete a dimension structure in a mpp
	2267	!> structure.<br/>
[5600]	2268	!>
[4213]	2269	!> @author J.Paul
[5600]	2270	!> - November, 2013- Initial Version
	2271	!>
	2272	!> @param[inout] td_mpp mpp structure
	2273	!> @param[in] td_dim dimension structure
[4213]	2274	!-------------------------------------------------------------------
	2275	SUBROUTINE mpp_del_dim(td_mpp, td_dim)
	2276	IMPLICIT NONE
	2277	! Argument
	2278	TYPE(TMPP), INTENT(INOUT) :: td_mpp
	2279	TYPE(TDIM), INTENT(IN) :: td_dim
	2280
	2281	! local variable
	2282	INTEGER(i4) :: il_status
[5600]	2283	INTEGER(i4) :: il_ind
[4213]	2284	TYPE(TDIM), DIMENSION(:), ALLOCATABLE :: tl_dim
	2285
	2286	! loop indices
[5600]	2287	INTEGER(i4) :: ji
[4213]	2288	!----------------------------------------------------------------
[5600]	2289	! check if dimension already in mpp structure
	2290	il_ind=dim_get_index(td_mpp%t_dim(:), td_dim%c_name, td_dim%c_sname)
	2291	IF( il_ind == 0 )THEN
[4213]	2292
[5600]	2293	CALL logger_error( &
	2294	& "MPP DEL DIM: no dimension "//TRIM(td_dim%c_name)//&
	2295	& ", short name "//TRIM(td_dim%c_sname)//&
	2296	& ", in mpp "//TRIM(td_mpp%c_name) )
[4213]	2297
[5600]	2298	ELSE
	2299
	2300	ALLOCATE( tl_dim(td_mpp%i_ndim-1), stat=il_status )
	2301	IF(il_status /= 0 )THEN
	2302
[4213]	2303	CALL logger_error( &
[5600]	2304	& "MPP DEL DIM: not enough space to put dimensions from "//&
	2305	& TRIM(td_mpp%c_name)//" in temporary dimension structure")
[4213]	2306
	2307	ELSE
	2308
[5600]	2309	! save temporary dimension's mpp structure
	2310	tl_dim( 1 : il_ind-1 ) = dim_copy(td_mpp%t_dim( 1 : il_ind-1 ))
	2311	tl_dim( il_ind : td_mpp%i_ndim-1 ) = &
	2312	& dim_copy(td_mpp%t_dim( il_ind+1 : td_mpp%i_ndim ))
[4213]	2313
[5600]	2314	! remove dimension from file
	2315	CALL dim_clean(td_mpp%t_dim(:))
	2316	! copy dimension in file, except one
	2317	td_mpp%t_dim(1:td_mpp%i_ndim)=dim_copy(tl_dim(:))
[4213]	2318
[5600]	2319	! update number of dimension
	2320	td_mpp%i_ndim=td_mpp%i_ndim-1
[4213]	2321
[5600]	2322	! update dimension id
	2323	DO ji=1,td_mpp%i_ndim
	2324	td_mpp%t_dim(ji)%i_id=ji
	2325	ENDDO
[4213]	2326
[5600]	2327	! clean
	2328	CALL dim_clean(tl_dim(:))
	2329	DEALLOCATE(tl_dim)
[4213]	2330
[5600]	2331	ENDIF
[4213]	2332
	2333	ENDIF
	2334
	2335	END SUBROUTINE mpp_del_dim
	2336	!-------------------------------------------------------------------
	2337	!> @brief This subroutine move a dimension structure
	2338	!> in mpp structure.
	2339	!> @warning dimension order may have changed
[5600]	2340	!>
[4213]	2341	!> @author J.Paul
[5600]	2342	!> - November, 2013- Initial Version
	2343	!>
	2344	!> @param[inout] td_mpp mpp structure
	2345	!> @param[in] td_dim dimension structure
[4213]	2346	!-------------------------------------------------------------------
	2347	SUBROUTINE mpp_move_dim(td_mpp, td_dim)
	2348	IMPLICIT NONE
	2349	! Argument
	2350	TYPE(TMPP), INTENT(INOUT) :: td_mpp
	2351	TYPE(TDIM), INTENT(IN) :: td_dim
	2352
	2353	! local variable
[5600]	2354	INTEGER(i4) :: il_ind
[4213]	2355	INTEGER(i4) :: il_dimid
	2356	!----------------------------------------------------------------
[5600]	2357	IF( td_mpp%i_ndim <= ip_maxdim )THEN
[4213]	2358
[5600]	2359	! check if dimension already in mpp structure
	2360	il_ind=dim_get_index(td_mpp%t_dim(:), td_dim%c_name, td_dim%c_sname)
	2361	IF( il_ind /= 0 )THEN
[4213]	2362
[5600]	2363	il_dimid=td_mpp%t_dim(il_ind)%i_id
	2364	! replace dimension
	2365	td_mpp%t_dim(il_ind)=dim_copy(td_dim)
	2366	td_mpp%t_dim(il_ind)%i_id=il_dimid
	2367	td_mpp%t_dim(il_ind)%l_use=.TRUE.
[4213]	2368
[5600]	2369	ELSE
	2370	CALL mpp_add_dim(td_mpp, td_dim)
	2371	ENDIF
	2372
	2373	ELSE
	2374	CALL logger_error( &
	2375	& "MPP MOVE DIM: too much dimension in mpp "//&
	2376	& TRIM(td_mpp%c_name)//" ("//TRIM(fct_str(td_mpp%i_ndim))//")")
	2377	ENDIF
[4213]	2378	END SUBROUTINE mpp_move_dim
	2379	!-------------------------------------------------------------------
	2380	!> @brief
	2381	!> This subroutine add global attribute to mpp structure.
	2382	!>
	2383	!> @author J.Paul
[5600]	2384	!> @date November, 2013 - Initial version
	2385	!>
	2386	!> @param[inout] td_mpp mpp strcuture
	2387	!> @param[in] td_att attribute strcuture
[4213]	2388	!-------------------------------------------------------------------
	2389	SUBROUTINE mpp_add_att( td_mpp, td_att )
	2390	IMPLICIT NONE
	2391	! Argument
	2392	TYPE(TMPP), INTENT(INOUT) :: td_mpp
	2393	TYPE(TATT), INTENT(IN) :: td_att
	2394
	2395	! local variable
	2396	INTEGER(i4) :: il_attid
	2397
	2398	! loop indices
	2399	INTEGER(i4) :: ji
	2400	!----------------------------------------------------------------
	2401	! check if mpp exist
	2402	IF( .NOT. ASSOCIATED(td_mpp%t_proc) )THEN
	2403
	2404	CALL logger_error( "MPP ADD ATT: domain decomposition not define "//&
	2405	& "for mpp "//TRIM(td_mpp%c_name))
	2406
	2407	ELSE
	2408	! check if variable exist
	2409	IF( TRIM(td_att%c_name) == '' )THEN
	2410	CALL logger_error("MPP ADD ATT: attribute not define ")
	2411	ELSE
	2412	! check if attribute already in mpp structure
	2413	il_attid=0
	2414	IF( ASSOCIATED(td_mpp%t_proc(1)%t_att) )THEN
[5600]	2415	il_attid=att_get_index( td_mpp%t_proc(1)%t_att(:), &
[4213]	2416	& td_att%c_name )
	2417	ENDIF
	2418	IF( il_attid /= 0 )THEN
	2419
[5600]	2420	CALL logger_error( " MPP ADD ATT: attribute "//&
	2421	& TRIM(td_att%c_name)//&
	2422	& ", already in mpp "//TRIM(td_mpp%c_name) )
[4213]	2423
	2424	DO ji=1,td_mpp%t_proc(1)%i_natt
	2425	CALL logger_debug( " MPP ADD ATT: in mpp structure : &
	2426	& attribute "//TRIM(td_mpp%t_proc(1)%t_att(ji)%c_name) )
	2427	ENDDO
	2428
	2429	ELSE
	2430
	2431	CALL logger_info( &
[5600]	2432	& " MPP ADD ATT: add attribute "//TRIM(td_att%c_name)//&
[4213]	2433	& ", in mpp "//TRIM(td_mpp%c_name) )
	2434
	2435	! add attribute in each processor
	2436	DO ji=1,td_mpp%i_nproc
	2437
	2438	CALL file_add_att(td_mpp%t_proc(ji), td_att)
	2439
	2440	ENDDO
	2441
	2442	ENDIF
	2443	ENDIF
	2444	ENDIF
	2445
	2446	END SUBROUTINE mpp_add_att
	2447	!-------------------------------------------------------------------
	2448	!> @brief
	2449	!> This subroutine delete attribute in mpp structure, given attribute
	2450	!> structure.
	2451	!>
	2452	!> @author J.Paul
[5600]	2453	!> @date November, 2013 - Initial version
	2454	!>
	2455	!> @param[inout] td_mpp mpp strcuture
	2456	!> @param[in] td_att attribute strcuture
[4213]	2457	!-------------------------------------------------------------------
	2458	SUBROUTINE mpp__del_att_str( td_mpp, td_att )
	2459	IMPLICIT NONE
	2460	! Argument
	2461	TYPE(TMPP), INTENT(INOUT) :: td_mpp
	2462	TYPE(TATT), INTENT(IN) :: td_att
	2463
	2464	! local variable
	2465	INTEGER(i4) :: il_attid
	2466	CHARACTER(LEN=lc) :: cl_name
	2467
	2468	! loop indices
	2469	INTEGER(i4) :: ji
	2470	!----------------------------------------------------------------
	2471	! check if mpp exist
	2472	IF( .NOT. ASSOCIATED(td_mpp%t_proc) )THEN
	2473
[5600]	2474	CALL logger_warn( "MPP DEL VAR: domain decomposition not define "//&
[4213]	2475	& " in mpp strcuture "//TRIM(td_mpp%c_name))
	2476
	2477	ELSE
	2478
	2479	! check if attribute already in mpp structure
	2480	il_attid=0
	2481	IF( ASSOCIATED(td_mpp%t_proc(1)%t_att) )THEN
[5600]	2482	il_attid=att_get_index( td_mpp%t_proc(1)%t_att(:), &
[4213]	2483	& td_att%c_name )
	2484	ENDIF
	2485	IF( il_attid == 0 )THEN
[5600]	2486	CALL logger_warn( &
	2487	& "MPP DEL VAR: no attribute "//TRIM(td_att%c_name)//&
[4213]	2488	& ", in mpp structure "//TRIM(td_mpp%c_name) )
	2489
[5600]	2490	IF( ASSOCIATED(td_mpp%t_proc(1)%t_var) )THEN
	2491	DO ji=1,td_mpp%t_proc(1)%i_natt
	2492	CALL logger_debug( "MPP DEL ATT: in mpp structure : &
	2493	& attribute : "//TRIM(td_mpp%t_proc(1)%t_var(ji)%c_name) )
	2494	ENDDO
	2495	ENDIF
[4213]	2496
	2497	ELSE
	2498
	2499	cl_name=TRIM(td_att%c_name)
[5600]	2500	CALL logger_debug( "MPP DEL ATT: delete in mpp structure : &
	2501	& attribute : "//TRIM(cl_name) )
[4213]	2502	DO ji=1,td_mpp%i_nproc
	2503	CALL file_del_att(td_mpp%t_proc(ji), TRIM(cl_name))
	2504	ENDDO
	2505
	2506	ENDIF
	2507
	2508	ENDIF
	2509	END SUBROUTINE mpp__del_att_str
	2510	!-------------------------------------------------------------------
	2511	!> @brief
	2512	!> This subroutine delete attribute in mpp structure, given attribute name.
	2513	!>
	2514	!> @detail
	2515	!
	2516	!> @author J.Paul
[5600]	2517	!> @date November, 2013 - Initial version
[4213]	2518	!
[5600]	2519	!> @param[inout] td_mpp mpp strcuture
	2520	!> @param[in] cd_name attribute name
[4213]	2521	!-------------------------------------------------------------------
	2522	SUBROUTINE mpp__del_att_name( td_mpp, cd_name )
	2523	IMPLICIT NONE
	2524	! Argument
	2525	TYPE(TMPP) , INTENT(INOUT) :: td_mpp
	2526	CHARACTER(LEN=*) , INTENT(IN ) :: cd_name
	2527
	2528	! local variable
	2529	INTEGER(i4) :: il_attid
	2530	!----------------------------------------------------------------
	2531	! check if mpp exist
	2532	IF( .NOT. ASSOCIATED(td_mpp%t_proc) )THEN
	2533
[5600]	2534	CALL logger_warn( "MPP DEL ATT: domain decomposition not define "//&
[4213]	2535	& " in mpp strcuture "//TRIM(td_mpp%c_name))
	2536
	2537	ELSE
	2538
	2539	IF( td_mpp%t_proc(1)%i_natt == 0 )THEN
[5600]	2540	CALL logger_debug( "MPP DEL ATT NAME: no attribute associated to mpp &
[4213]	2541	& structure "//TRIM(td_mpp%c_name) )
	2542	ELSE
	2543
	2544	! get the attribute id, in file variable structure
	2545	il_attid=0
	2546	IF( ASSOCIATED(td_mpp%t_proc(1)%t_att) )THEN
	2547	il_attid=att_get_id( td_mpp%t_proc(1)%t_att(:), &
	2548	& cd_name )
	2549	ENDIF
	2550
	2551	IF( il_attid == 0 )THEN
	2552
	2553	CALL logger_warn( &
[5600]	2554	& "MPP DEL ATT : there is no attribute with "//&
[4213]	2555	& "name "//TRIM(cd_name)//" in mpp structure "//&
	2556	& TRIM(td_mpp%c_name))
	2557
	2558	ELSE
	2559
	2560	CALL mpp_del_att(td_mpp, td_mpp%t_proc(1)%t_att(il_attid))
	2561
	2562	ENDIF
	2563	ENDIF
	2564
	2565	ENDIF
	2566	END SUBROUTINE mpp__del_att_name
	2567	!-------------------------------------------------------------------
	2568	!> @brief
	2569	!> This subroutine overwrite attribute in mpp structure.
	2570	!>
	2571	!> @author J.Paul
[5600]	2572	!> @date November, 2013 - Initial version
[4213]	2573	!
[5600]	2574	!> @param[inout] td_mpp mpp strcuture
	2575	!> @param[in] td_att attribute structure
[4213]	2576	!-------------------------------------------------------------------
	2577	SUBROUTINE mpp_move_att( td_mpp, td_att )
	2578	IMPLICIT NONE
	2579	! Argument
	2580	TYPE(TMPP), INTENT(INOUT) :: td_mpp
	2581	TYPE(TATT), INTENT(IN) :: td_att
	2582
	2583	!local variable
[5600]	2584	TYPE(TATT) :: tl_att
[4213]	2585	!----------------------------------------------------------------
	2586	! copy variable
[5600]	2587	tl_att=att_copy(td_att)
[4213]	2588
	2589	! remove processor
	2590	CALL mpp_del_att(td_mpp, tl_att)
	2591
	2592	! add processor
	2593	CALL mpp_add_att(td_mpp, tl_att)
	2594
[5600]	2595	! clean
	2596	CALL att_clean(tl_att)
	2597
[4213]	2598	END SUBROUTINE mpp_move_att
	2599	!-------------------------------------------------------------------
	2600	!> @brief
	2601	!> This subroutine compute domain decomposition for niproc and njproc
	2602	!> processors following I and J.
	2603	!>
	2604	!> @detail
	2605	!> To do so, it need to know :
	2606	!> - global domain dimension
	2607	!> - overlap region length
	2608	!> - number of processors following I and J
	2609	!
	2610	!> @author J.Paul
[5600]	2611	!> @date November, 2013 - Initial version
[4213]	2612	!
[5600]	2613	!> @param[inout] td_mpp mpp strcuture
[4213]	2614	!-------------------------------------------------------------------
	2615	SUBROUTINE mpp__compute( td_mpp )
	2616	IMPLICIT NONE
	2617	! Argument
	2618	TYPE(TMPP), INTENT(INOUT) :: td_mpp
	2619
	2620	! local variable
	2621	INTEGER(i4) :: il_isize !< i-direction maximum sub domain size
	2622	INTEGER(i4) :: il_jsize !< j-direction maximum sub domain size
	2623	INTEGER(i4) :: il_resti !<
	2624	INTEGER(i4) :: il_restj !<
	2625	INTEGER(i4), DIMENSION(:,:), ALLOCATABLE :: il_nlci
	2626	INTEGER(i4), DIMENSION(:,:), ALLOCATABLE :: il_nlcj
	2627	INTEGER(i4), DIMENSION(:,:), ALLOCATABLE :: il_impp
	2628	INTEGER(i4), DIMENSION(:,:), ALLOCATABLE :: il_jmpp
	2629
	2630	CHARACTER(LEN=lc) :: cl_file
	2631	TYPE(TFILE) :: tl_proc
[5600]	2632	TYPE(TATT) :: tl_att
[4213]	2633
	2634	! loop indices
	2635	INTEGER(i4) :: ji
	2636	INTEGER(i4) :: jj
	2637	INTEGER(i4) :: jk
	2638	!----------------------------------------------------------------
	2639
	2640	! intialise
	2641	td_mpp%i_nproc=0
	2642
[5600]	2643	CALL logger_trace( "MPP COMPUTE: compute domain decomposition with "//&
[4213]	2644	& TRIM(fct_str(td_mpp%i_niproc))//" x "//&
	2645	& TRIM(fct_str(td_mpp%i_njproc))//" processors")
	2646	! maximum size of sub domain
	2647	il_isize = ((td_mpp%t_dim(1)%i_len - 2*td_mpp%i_preci + (td_mpp%i_niproc-1))/ &
	2648	& td_mpp%i_niproc) + 2*td_mpp%i_preci
	2649	il_jsize = ((td_mpp%t_dim(2)%i_len - 2*td_mpp%i_precj + (td_mpp%i_njproc-1))/ &
	2650	& td_mpp%i_njproc) + 2*td_mpp%i_precj
	2651
	2652	il_resti = MOD(td_mpp%t_dim(1)%i_len - 2*td_mpp%i_preci, td_mpp%i_niproc)
	2653	il_restj = MOD(td_mpp%t_dim(2)%i_len - 2*td_mpp%i_precj, td_mpp%i_njproc)
	2654	IF( il_resti == 0 ) il_resti = td_mpp%i_niproc
	2655	IF( il_restj == 0 ) il_restj = td_mpp%i_njproc
	2656
	2657	! compute dimension of each sub domain
	2658	ALLOCATE( il_nlci(td_mpp%i_niproc,td_mpp%i_njproc) )
	2659	ALLOCATE( il_nlcj(td_mpp%i_niproc,td_mpp%i_njproc) )
	2660
	2661	il_nlci( 1 : il_resti , : ) = il_isize
	2662	il_nlci( il_resti+1 : td_mpp%i_niproc, : ) = il_isize-1
	2663
	2664	il_nlcj( : , 1 : il_restj ) = il_jsize
	2665	il_nlcj( : , il_restj+1 : td_mpp%i_njproc) = il_jsize-1
	2666
	2667	! compute first index of each sub domain
	2668	ALLOCATE( il_impp(td_mpp%i_niproc,td_mpp%i_njproc) )
	2669	ALLOCATE( il_jmpp(td_mpp%i_niproc,td_mpp%i_njproc) )
	2670
	2671	il_impp(:,:)=1
	2672	il_jmpp(:,:)=1
	2673
	2674	DO jj=1,td_mpp%i_njproc
	2675	DO ji=2,td_mpp%i_niproc
	2676	il_impp(ji,jj)=il_impp(ji-1,jj)+il_nlci(ji-1,jj)-2*td_mpp%i_preci
	2677	ENDDO
	2678	ENDDO
	2679
	2680	DO jj=2,td_mpp%i_njproc
	2681	DO ji=1,td_mpp%i_niproc
	2682	il_jmpp(ji,jj)=il_jmpp(ji,jj-1)+il_nlcj(ji,jj-1)-2*td_mpp%i_precj
	2683	ENDDO
	2684	ENDDO
	2685
	2686	DO jj=1,td_mpp%i_njproc
	2687	DO ji=1,td_mpp%i_niproc
	2688
	2689	jk=ji+(jj-1)*td_mpp%i_niproc
	2690
	2691	! get processor file name
	2692	cl_file=file_rename(td_mpp%c_name,jk)
	2693	! initialise file structure
	2694	tl_proc=file_init(cl_file,td_mpp%c_type)
	2695
	2696	! procesor id
	2697	tl_proc%i_pid=jk
	2698
	2699	tl_att=att_init("DOMAIN_number",tl_proc%i_pid)
	2700	CALL file_add_att(tl_proc, tl_att)
	2701
	2702	! processor indices
	2703	tl_proc%i_iind=ji
	2704	tl_proc%i_jind=jj
	2705
	2706	! fill processor dimension and first indices
	2707	tl_proc%i_impp = il_impp(ji,jj)
	2708	tl_proc%i_jmpp = il_jmpp(ji,jj)
	2709
	2710	tl_att=att_init( "DOMAIN_poistion_first", &
	2711	& (/tl_proc%i_impp, tl_proc%i_jmpp/) )
	2712	CALL file_add_att(tl_proc, tl_att)
	2713
	2714	tl_proc%i_lci = il_nlci(ji,jj)
	2715	tl_proc%i_lcj = il_nlcj(ji,jj)
	2716
	2717	tl_att=att_init( "DOMAIN_poistion_last", &
	2718	& (/tl_proc%i_lci, tl_proc%i_lcj/) )
	2719	CALL file_add_att(tl_proc, tl_att)
	2720
	2721	! compute first and last indoor indices
	2722
	2723	! west boundary
	2724	IF( ji == 1 )THEN
	2725	tl_proc%i_ldi = 1
	2726	tl_proc%l_ctr = .TRUE.
	2727	ELSE
	2728	tl_proc%i_ldi = 1 + td_mpp%i_preci
	2729	ENDIF
	2730
	2731	! south boundary
	2732	IF( jj == 1 )THEN
	2733	tl_proc%i_ldj = 1
	2734	tl_proc%l_ctr = .TRUE.
	2735	ELSE
	2736	tl_proc%i_ldj = 1 + td_mpp%i_precj
	2737	ENDIF
	2738
	2739	! east boundary
	2740	IF( ji == td_mpp%i_niproc )THEN
	2741	tl_proc%i_lei = il_nlci(ji,jj)
	2742	tl_proc%l_ctr = .TRUE.
	2743	ELSE
	2744	tl_proc%i_lei = il_nlci(ji,jj) - td_mpp%i_preci
	2745	ENDIF
	2746
	2747	! north boundary
	2748	IF( jj == td_mpp%i_njproc )THEN
	2749	tl_proc%i_lej = il_nlcj(ji,jj)
	2750	tl_proc%l_ctr = .TRUE.
	2751	ELSE
	2752	tl_proc%i_lej = il_nlcj(ji,jj) - td_mpp%i_precj
	2753	ENDIF
	2754
	2755	tl_att=att_init( "DOMAIN_halo_size_start", &
	2756	& (/tl_proc%i_ldi, tl_proc%i_ldj/) )
	2757	CALL file_add_att(tl_proc, tl_att)
	2758	tl_att=att_init( "DOMAIN_halo_size_end", &
	2759	& (/tl_proc%i_ldi, tl_proc%i_ldj/) )
	2760	CALL file_add_att(tl_proc, tl_att)
	2761
	2762	! add processor to mpp structure
	2763	CALL mpp__add_proc(td_mpp, tl_proc)
	2764
[5600]	2765	! clean
	2766	CALL att_clean(tl_att)
	2767	CALL file_clean(tl_proc)
	2768
[4213]	2769	ENDDO
	2770	ENDDO
	2771
	2772	DEALLOCATE( il_impp, il_jmpp )
	2773	DEALLOCATE( il_nlci, il_nlcj )
	2774
	2775	END SUBROUTINE mpp__compute
	2776	!-------------------------------------------------------------------
	2777	!> @brief
	2778	!> This subroutine remove land processor from domain decomposition.
[5600]	2779	!>
[4213]	2780	!> @author J.Paul
[5600]	2781	!> @date November, 2013 - Initial version
	2782	!>
	2783	!> @param[inout] td_mpp mpp strcuture
	2784	!> @param[in] id_mask sub domain mask (sea=1, land=0)
[4213]	2785	!-------------------------------------------------------------------
	2786	SUBROUTINE mpp__del_land( td_mpp, id_mask )
	2787	IMPLICIT NONE
	2788	! Argument
	2789	TYPE(TMPP), INTENT(INOUT) :: td_mpp
	2790	INTEGER(i4), DIMENSION(:,:), INTENT(IN) :: id_mask
	2791
	2792	! loop indices
	2793	INTEGER(i4) :: jk
	2794	!----------------------------------------------------------------
	2795
	2796	IF( ASSOCIATED(td_mpp%t_proc) )THEN
	2797	jk=1
	2798	DO WHILE( jk <= td_mpp%i_nproc )
	2799	IF( mpp__land_proc(td_mpp, jk, id_mask(:,:)) )THEN
	2800	CALL mpp__del_proc(td_mpp, jk)
	2801	ELSE
	2802	jk=jk+1
	2803	ENDIF
	2804	ENDDO
	2805	ELSE
[5600]	2806	CALL logger_error("MPP DEL LAND: domain decomposition not define.")
[4213]	2807	ENDIF
	2808
	2809	END SUBROUTINE mpp__del_land
	2810	!-------------------------------------------------------------------
	2811	!> @brief
	2812	!> This subroutine optimize the number of sub domain to be used, given mask.
	2813	!> @details
	2814	!> Actually it get the domain decomposition with the most land
	2815	!> processor removed.
	2816	!
	2817	!> @author J.Paul
[5600]	2818	!> @date November, 2013 - Initial version
[4213]	2819	!
[5600]	2820	!> @param[inout] td_mpp mpp strcuture
	2821	!> @param[in] id_mask sub domain mask (sea=1, land=0)
[4213]	2822	!-------------------------------------------------------------------
	2823	SUBROUTINE mpp__optimiz( td_mpp, id_mask )
	2824	IMPLICIT NONE
	2825	! Argument
	2826	TYPE(TMPP), INTENT(INOUT) :: td_mpp
	2827	INTEGER(i4), DIMENSION(:,:), INTENT(IN) :: id_mask
	2828
	2829	! local variable
	2830	TYPE(TMPP) :: tl_mpp
	2831	INTEGER(i4) :: il_maxproc
	2832
	2833	TYPE(TFILE), DIMENSION(:), ALLOCATABLE :: tl_proc
	2834	! loop indices
	2835	INTEGER(i4) :: ji
	2836	INTEGER(i4) :: jj
	2837	!----------------------------------------------------------------
	2838
[5600]	2839	CALL logger_trace("MPP OPTIMIZ: look for best domain decomposition")
	2840	tl_mpp=mpp_copy(td_mpp)
[4213]	2841
	2842	! save maximum number of processor to be used
	2843	il_maxproc=td_mpp%i_nproc
	2844	!
	2845	td_mpp%i_nproc=0
	2846	DO ji=1,il_maxproc
	2847	DO jj=1,il_maxproc
	2848
	2849	! clean mpp processor
	2850	IF( ASSOCIATED(tl_mpp%t_proc) )THEN
[5600]	2851	CALL file_clean(tl_mpp%t_proc(:))
[4213]	2852	DEALLOCATE(tl_mpp%t_proc)
	2853	ENDIF
	2854
	2855	! compute domain decomposition
	2856	tl_mpp%i_niproc=ji
	2857	tl_mpp%i_njproc=jj
	2858
	2859	CALL mpp__compute( tl_mpp )
	2860
	2861	! remove land sub domain
	2862	CALL mpp__del_land( tl_mpp, id_mask )
	2863
[5600]	2864	CALL logger_info("MPP OPTIMIZ: number of processor "//&
[4213]	2865	& TRIM(fct_str(tl_mpp%i_nproc)) )
	2866	IF( tl_mpp%i_nproc > td_mpp%i_nproc .AND. &
	2867	& tl_mpp%i_nproc <= il_maxproc )THEN
	2868	! save optimiz decomposition
	2869
	2870	! clean mpp
	2871	CALL mpp_clean(td_mpp)
	2872
[5600]	2873	! save processor array
[4213]	2874	ALLOCATE( tl_proc(tl_mpp%i_nproc) )
[5600]	2875	tl_proc(:)=file_copy(tl_mpp%t_proc(:))
[4213]	2876
[5600]	2877	! remove pointer on processor array
	2878	CALL file_clean(tl_mpp%t_proc(:))
[4213]	2879	DEALLOCATE(tl_mpp%t_proc)
	2880
[5600]	2881	! save data except processor array
	2882	td_mpp=mpp_copy(tl_mpp)
	2883
	2884	! save processor array
[4213]	2885	ALLOCATE( td_mpp%t_proc(td_mpp%i_nproc) )
[5600]	2886	td_mpp%t_proc(:)=file_copy(tl_proc(:))
[4213]	2887
[5600]	2888	! clean
	2889	CALL file_clean( tl_proc(:) )
	2890	DEALLOCATE(tl_proc)
[4213]	2891
	2892	ENDIF
	2893
	2894	ENDDO
	2895	ENDDO
	2896
[5600]	2897	! clean
	2898	CALL mpp_clean(tl_mpp)
	2899
[4213]	2900	END SUBROUTINE mpp__optimiz
	2901	!-------------------------------------------------------------------
	2902	!> @brief
	2903	!> This function check if processor is a land processor.
[5600]	2904	!>
[4213]	2905	!> @author J.Paul
[5600]	2906	!> @date November, 2013 - Initial version
	2907	!>
	2908	!> @param[in] td_mpp mpp strcuture
	2909	!> @param[in] id_proc processor id
	2910	!> @param[in] id_mask sub domain mask (sea=1, land=0)
[4213]	2911	!-------------------------------------------------------------------
	2912	LOGICAL FUNCTION mpp__land_proc( td_mpp , id_proc, id_mask )
	2913	IMPLICIT NONE
	2914	! Argument
	2915	TYPE(TMPP), INTENT(IN) :: td_mpp
	2916	INTEGER(i4), INTENT(IN) :: id_proc
	2917	INTEGER(i4), DIMENSION(:,:), INTENT(IN) :: id_mask
	2918
	2919	! local variable
	2920	INTEGER(i4), DIMENSION(2) :: il_shape
	2921	!----------------------------------------------------------------
	2922
[5600]	2923	CALL logger_trace("MPP LAND PROC: check processor "//TRIM(fct_str(id_proc))//&
[4213]	2924	& " of mpp "//TRIM(td_mpp%c_name) )
	2925	mpp__land_proc=.FALSE.
	2926	IF( ASSOCIATED(td_mpp%t_proc) )THEN
	2927
	2928	il_shape(:)=SHAPE(id_mask)
	2929	IF( il_shape(1) /= td_mpp%t_dim(1)%i_len .OR. &
	2930	& il_shape(2) /= td_mpp%t_dim(2)%i_len )THEN
[5600]	2931	CALL logger_debug("MPP LAND PROC: mask size ("//&
	2932	& TRIM(fct_str(il_shape(1)))//","//&
	2933	& TRIM(fct_str(il_shape(2)))//")")
	2934	CALL logger_debug("MPP LAND PROC: domain size ("//&
	2935	& TRIM(fct_str(td_mpp%t_dim(1)%i_len))//","//&
	2936	& TRIM(fct_str(td_mpp%t_dim(2)%i_len))//")")
	2937	CALL logger_error("MPP LAND PROC: mask and domain size differ")
[4213]	2938	ELSE
	2939	IF( ALL(id_mask( td_mpp%t_proc(id_proc)%i_impp + &
	2940	& td_mpp%t_proc(id_proc)%i_ldi - 1 : &
	2941	& td_mpp%t_proc(id_proc)%i_impp + &
	2942	& td_mpp%t_proc(id_proc)%i_lei - 1, &
	2943	& td_mpp%t_proc(id_proc)%i_jmpp + &
	2944	& td_mpp%t_proc(id_proc)%i_ldj - 1 : &
	2945	& td_mpp%t_proc(id_proc)%i_jmpp + &
	2946	& td_mpp%t_proc(id_proc)%i_lej - 1) &
	2947	& /= 1 ) )THEN
	2948	! land domain
[5600]	2949	CALL logger_info("MPP LAND PROC: processor "//TRIM(fct_str(id_proc))//&
[4213]	2950	& " is land processor")
	2951	mpp__land_proc=.TRUE.
	2952	ENDIF
	2953	ENDIF
	2954
	2955	ELSE
[5600]	2956	CALL logger_error("MPP LAND PROC: domain decomposition not define.")
[4213]	2957	ENDIF
	2958
	2959	END FUNCTION mpp__land_proc
	2960	!-------------------------------------------------------------------
	2961	!> @brief
	2962	!> This subroutine clean mpp strcuture.
[5600]	2963	!>
[4213]	2964	!> @author J.Paul
[5600]	2965	!> @date November, 2013 - Initial version
	2966	!>
	2967	!> @param[inout] td_mpp mpp strcuture
[4213]	2968	!-------------------------------------------------------------------
[5600]	2969	SUBROUTINE mpp__clean_unit( td_mpp )
[4213]	2970	IMPLICIT NONE
	2971	! Argument
	2972	TYPE(TMPP), INTENT(INOUT) :: td_mpp
	2973
	2974	! local variable
	2975	TYPE(TMPP) :: tl_mpp ! empty mpp structure
	2976
	2977	! loop indices
	2978	!----------------------------------------------------------------
	2979
	2980	CALL logger_info( &
[5600]	2981	& "MPP CLEAN: reset mpp "//TRIM(td_mpp%c_name) )
[4213]	2982
	2983	! del dimension
	2984	IF( td_mpp%i_ndim /= 0 )THEN
[5600]	2985	CALL dim_clean( td_mpp%t_dim(:) )
[4213]	2986	ENDIF
	2987
	2988	IF( ASSOCIATED(td_mpp%t_proc) )THEN
[5600]	2989	! clean array of file processor
	2990	CALL file_clean( td_mpp%t_proc(:) )
[4213]	2991	DEALLOCATE(td_mpp%t_proc)
	2992	ENDIF
	2993
	2994	! replace by empty structure
[5600]	2995	td_mpp=mpp_copy(tl_mpp)
[4213]	2996
[5600]	2997	END SUBROUTINE mpp__clean_unit
[4213]	2998	!-------------------------------------------------------------------
	2999	!> @brief
[5600]	3000	!> This subroutine clean mpp strcuture.
	3001	!>
	3002	!> @author J.Paul
	3003	!> @date November, 2013 - Initial version
	3004	!>
	3005	!> @param[inout] td_mpp mpp strcuture
	3006	!-------------------------------------------------------------------
	3007	SUBROUTINE mpp__clean_arr( td_mpp )
	3008	IMPLICIT NONE
	3009	! Argument
	3010	TYPE(TMPP), DIMENSION(:), INTENT(INOUT) :: td_mpp
	3011
	3012	! local variable
	3013	! loop indices
	3014	INTEGER(i4) :: ji
	3015	!----------------------------------------------------------------
	3016
	3017	DO ji=SIZE(td_mpp(:)),1,-1
	3018	CALL mpp_clean(td_mpp(ji))
	3019	ENDDO
	3020
	3021	END SUBROUTINE mpp__clean_arr
	3022	!-------------------------------------------------------------------
	3023	!> @brief
[4213]	3024	!> This subroutine get sub domains which cover "zoom domain".
[5600]	3025	!>
[4213]	3026	!> @author J.Paul
[5600]	3027	!> @date November, 2013 - Initial version
	3028	!>
	3029	!> @param[inout] td_mpp mpp strcuture
	3030	!> @param[in] id_imin i-direction lower indice
	3031	!> @param[in] id_imax i-direction upper indice
	3032	!> @param[in] id_jmin j-direction lower indice
	3033	!> @param[in] id_jmax j-direction upper indice
[4213]	3034	!-------------------------------------------------------------------
[5600]	3035	SUBROUTINE mpp__get_use_unit( td_mpp, id_imin, id_imax, &
	3036	& id_jmin, id_jmax )
[4213]	3037	IMPLICIT NONE
	3038	! Argument
[5600]	3039	TYPE(TMPP) , INTENT(INOUT) :: td_mpp
	3040	INTEGER(i4), INTENT(IN), OPTIONAL :: id_imin
	3041	INTEGER(i4), INTENT(IN), OPTIONAL :: id_imax
	3042	INTEGER(i4), INTENT(IN), OPTIONAL :: id_jmin
	3043	INTEGER(i4), INTENT(IN), OPTIONAL :: id_jmax
[4213]	3044
	3045	! local variable
	3046	LOGICAL :: ll_iuse
	3047	LOGICAL :: ll_juse
	3048
[5600]	3049	INTEGER(i4) :: il_imin
	3050	INTEGER(i4) :: il_imax
	3051	INTEGER(i4) :: il_jmin
	3052	INTEGER(i4) :: il_jmax
	3053
[4213]	3054	! loop indices
	3055	INTEGER(i4) :: jk
	3056	!----------------------------------------------------------------
	3057	IF( ASSOCIATED(td_mpp%t_proc) )THEN
	3058
[5600]	3059	il_imin=1
	3060	il_imax=td_mpp%t_dim(1)%i_len
	3061	IF( PRESENT(id_imin) ) il_imin=id_imin
	3062	IF( PRESENT(id_imax) ) il_imax=id_imax
	3063	il_jmin=1
	3064	il_jmax=td_mpp%t_dim(2)%i_len
	3065	IF( PRESENT(id_jmin) ) il_jmin=id_jmin
	3066	IF( PRESENT(id_jmax) ) il_jmax=id_jmax
	3067
[4213]	3068	! check domain
[5600]	3069	IF( il_imin < 1 .OR. il_imin > td_mpp%t_dim(1)%i_len .OR. &
	3070	& il_imax < 1 .OR. il_imax > td_mpp%t_dim(1)%i_len .OR. &
	3071	& il_jmin < 1 .OR. il_jmin > td_mpp%t_dim(2)%i_len .OR. &
	3072	& il_jmax < 1 .OR. il_jmax > td_mpp%t_dim(2)%i_len )THEN
	3073	CALL logger_debug("MPP GET USE: mpp gloabl size "//&
	3074	& TRIM(fct_str(td_mpp%t_dim(1)%i_len))//","//&
	3075	& TRIM(fct_str(td_mpp%t_dim(2)%i_len)))
	3076	CALL logger_debug("MPP GET USE: i-indices "//&
	3077	& TRIM(fct_str(il_imin))//","//TRIM(fct_str(il_imax)))
	3078	CALL logger_debug("MPP GET USE: j-indices "//&
	3079	& TRIM(fct_str(il_jmin))//","//TRIM(fct_str(il_jmax)))
	3080	CALL logger_error("MPP GET USE: invalid indices ")
	3081	ELSE
[4213]	3082	td_mpp%t_proc(:)%l_use=.FALSE.
	3083	DO jk=1,td_mpp%i_nproc
	3084
	3085	! check i-direction
	3086	ll_iuse=.FALSE.
[5600]	3087	IF( il_imin < il_imax )THEN
[4213]	3088
	3089	! not overlap east west boundary
	3090	IF( td_mpp%t_proc(jk)%i_impp + td_mpp%t_proc(jk)%i_lci > &
[5600]	3091	& il_imin .AND. &
	3092	& td_mpp%t_proc(jk)%i_impp < il_imax )THEN
[4213]	3093	ll_iuse=.TRUE.
	3094	ENDIF
	3095
[5600]	3096	ELSEIF( il_imin == il_imax )THEN
[4213]	3097
	3098	! east west cyclic
	3099	ll_iuse=.TRUE.
	3100
[5600]	3101	ELSE ! il_imin > id_imax
[4213]	3102
	3103	! overlap east west boundary
	3104	IF( ( td_mpp%t_proc(jk)%i_impp + td_mpp%t_proc(jk)%i_lci > &
[5600]	3105	& il_imin ) &
[4213]	3106	& .OR. &
[5600]	3107	& ( td_mpp%t_proc(jk)%i_impp < il_imax) )THEN
[4213]	3108	ll_iuse=.TRUE.
	3109	ENDIF
	3110
	3111	ENDIF
	3112
	3113	! check j-direction
	3114	ll_juse=.FALSE.
[5600]	3115	IF( il_jmin < il_jmax )THEN
[4213]	3116
	3117	! not overlap north fold
	3118	IF( td_mpp%t_proc(jk)%i_jmpp + td_mpp%t_proc(jk)%i_lcj > &
[5600]	3119	& il_jmin .AND. &
	3120	& td_mpp%t_proc(jk)%i_jmpp < il_jmax )THEN
[4213]	3121	ll_juse=.TRUE.
	3122	ENDIF
	3123
[5600]	3124	ELSE ! id_jmin >= id_jmax
[4213]	3125
	3126	IF( td_mpp%t_proc(jk)%i_jmpp + td_mpp%t_proc(jk)%i_lcj > &
	3127	& il_jmin )THEN
	3128	ll_juse=.TRUE.
	3129	ENDIF
	3130
	3131	ENDIF
	3132
	3133	IF( ll_iuse .AND. ll_juse ) td_mpp%t_proc(jk)%l_use=.TRUE.
	3134
	3135	ENDDO
	3136	ENDIF
	3137
	3138	ELSE
[5600]	3139	CALL logger_error("MPP GET USE: mpp decomposition not define.")
[4213]	3140	ENDIF
	3141
[5600]	3142	END SUBROUTINE mpp__get_use_unit
[4213]	3143	!-------------------------------------------------------------------
	3144	!> @brief
	3145	!> This subroutine get sub domains which form global domain border.
[5600]	3146	!>
[4213]	3147	!> @author J.Paul
[5600]	3148	!> @date November, 2013
	3149	!>
	3150	!> @param[inout] td_mpp mpp strcuture
[4213]	3151	!-------------------------------------------------------------------
	3152	SUBROUTINE mpp_get_contour( td_mpp )
	3153	IMPLICIT NONE
	3154	! Argument
	3155	TYPE(TMPP), INTENT(INOUT) :: td_mpp
	3156
	3157	! loop indices
	3158	INTEGER(i4) :: jk
	3159	!----------------------------------------------------------------
	3160
	3161	IF( ASSOCIATED(td_mpp%t_proc) )THEN
	3162
[5600]	3163	td_mpp%t_proc(:)%l_use = .FALSE.
[4213]	3164	DO jk=1,td_mpp%i_nproc
	3165	IF( td_mpp%t_proc(jk)%i_ldi == 1 .OR. &
	3166	& td_mpp%t_proc(jk)%i_ldj == 1 .OR. &
	3167	& td_mpp%t_proc(jk)%i_lei == td_mpp%t_proc(jk)%i_lci .OR. &
	3168	& td_mpp%t_proc(jk)%i_lej == td_mpp%t_proc(jk)%i_lcj )THEN
	3169
[5600]	3170	td_mpp%t_proc(jk)%l_use = .TRUE.
	3171
[4213]	3172	ENDIF
	3173	ENDDO
	3174
	3175	ELSE
[5600]	3176	CALL logger_error("MPP GET CONTOUR: domain decomposition not define.")
[4213]	3177	ENDIF
	3178
	3179	END SUBROUTINE mpp_get_contour
	3180	!-------------------------------------------------------------------
	3181	!> @brief
	3182	!> This function return processor indices, without overlap boundary,
[5600]	3183	!> given processor id.
	3184	!>
[4213]	3185	!> @author J.Paul
[5600]	3186	!> @date November, 2013
	3187	!>
	3188	!> @param[in] td_mpp mpp strcuture
	3189	!> @param[in] id_procid processor id
	3190	!> @return array of index (/ i1, i2, j1, j2 /)
[4213]	3191	!-------------------------------------------------------------------
	3192	FUNCTION mpp_get_proc_index( td_mpp, id_procid )
	3193	IMPLICIT NONE
	3194
	3195	! Argument
[5600]	3196	TYPE(TMPP) , INTENT(IN) :: td_mpp
[4213]	3197	INTEGER(i4), INTENT(IN) :: id_procid
	3198
	3199	! function
	3200	INTEGER(i4), DIMENSION(4) :: mpp_get_proc_index
	3201
	3202	! local variable
	3203	INTEGER(i4) :: il_i1, il_i2
	3204	INTEGER(i4) :: il_j1, il_j2
	3205	!----------------------------------------------------------------
	3206
	3207	IF( ASSOCIATED(td_mpp%t_proc) )THEN
	3208
	3209	IF( TRIM(td_mpp%c_dom) == '' )THEN
[5600]	3210	CALL logger_fatal("MPP GET PROC INDEX: decomposition type unknown. "//&
	3211	& "you should ahve run mpp_get_dom before.")
[4213]	3212	ENDIF
	3213
[5600]	3214	SELECT CASE(TRIM(td_mpp%c_dom))
[4213]	3215	CASE('full')
	3216	il_i1 = 1 ; il_i2 = td_mpp%t_dim(1)%i_len
	3217	il_j1 = 1 ; il_j2 = td_mpp%t_dim(2)%i_len
	3218	CASE('overlap')
	3219	il_i1 = td_mpp%t_proc(id_procid)%i_impp
	3220	il_j1 = td_mpp%t_proc(id_procid)%i_jmpp
	3221
[5600]	3222	il_i2 = il_i1 + td_mpp%t_proc(id_procid)%i_lci - 1
[4213]	3223	il_j2 = il_j1 + td_mpp%t_proc(id_procid)%i_lcj - 1
	3224	CASE('nooverlap')
	3225	il_i1 = td_mpp%t_proc(id_procid)%i_impp + &
	3226	& td_mpp%t_proc(id_procid)%i_ldi - 1
	3227	il_j1 = td_mpp%t_proc(id_procid)%i_jmpp + &
	3228	& td_mpp%t_proc(id_procid)%i_ldj - 1
	3229
	3230	il_i2 = td_mpp%t_proc(id_procid)%i_impp + &
	3231	& td_mpp%t_proc(id_procid)%i_lei - 1
	3232	il_j2 = td_mpp%t_proc(id_procid)%i_jmpp + &
	3233	& td_mpp%t_proc(id_procid)%i_lej - 1
	3234	CASE DEFAULT
[5600]	3235	CALL logger_error("MPP GET PROC INDEX: invalid decomposition type.")
[4213]	3236	END SELECT
	3237
	3238	mpp_get_proc_index(:)=(/il_i1, il_i2, il_j1, il_j2/)
	3239
	3240	ELSE
[5600]	3241	CALL logger_error("MPP GET PROC INDEX: domain decomposition not define.")
[4213]	3242	ENDIF
	3243
	3244	END FUNCTION mpp_get_proc_index
	3245	!-------------------------------------------------------------------
	3246	!> @brief
	3247	!> This function return processor domain size, depending of domain
	3248	!> decompisition type, given sub domain id.
	3249	!
	3250	!> @author J.Paul
[5600]	3251	!> @date November, 2013
[4213]	3252	!
[5600]	3253	!> @param[in] td_mpp mpp strcuture
	3254	!> @param[in] id_procid sub domain id
	3255	!> @return array of index (/ isize, jsize /)
[4213]	3256	!-------------------------------------------------------------------
	3257	FUNCTION mpp_get_proc_size( td_mpp, id_procid )
	3258	IMPLICIT NONE
	3259
	3260	! Argument
	3261	TYPE(TMPP), INTENT(IN) :: td_mpp
	3262	INTEGER(i4), INTENT(IN) :: id_procid
	3263
	3264	! function
	3265	INTEGER(i4), DIMENSION(2) :: mpp_get_proc_size
	3266
	3267	! local variable
	3268	INTEGER(i4) :: il_isize
	3269	INTEGER(i4) :: il_jsize
	3270	!----------------------------------------------------------------
	3271
	3272	IF( ASSOCIATED(td_mpp%t_proc) )THEN
	3273
	3274	IF( TRIM(td_mpp%c_dom) == '' )THEN
[5600]	3275	CALL logger_fatal("MPP GET PROC SIZE: decomposition type unknown. "//&
	3276	& "you should ahve run mpp_get_dom before.")
[4213]	3277	ENDIF
	3278
[5600]	3279	SELECT CASE(TRIM(td_mpp%c_dom))
[4213]	3280	CASE('full')
	3281
	3282	il_isize = td_mpp%t_dim(1)%i_len
	3283	il_jsize = td_mpp%t_dim(2)%i_len
	3284
	3285	CASE('overlap')
	3286
	3287	il_isize = td_mpp%t_proc(id_procid)%i_lci
	3288	il_jsize = td_mpp%t_proc(id_procid)%i_lcj
	3289
	3290	CASE('nooverlap')
	3291	il_isize = td_mpp%t_proc(id_procid)%i_lei - &
	3292	& td_mpp%t_proc(id_procid)%i_ldi + 1
	3293	il_jsize = td_mpp%t_proc(id_procid)%i_lej - &
	3294	& td_mpp%t_proc(id_procid)%i_ldj + 1
	3295	CASE DEFAULT
[5600]	3296	CALL logger_error("MPP GET PROC SIZE: invalid decomposition type : "//&
	3297	& TRIM(td_mpp%c_dom) )
[4213]	3298	END SELECT
	3299
	3300	mpp_get_proc_size(:)=(/il_isize, il_jsize/)
	3301
	3302	ELSE
[5600]	3303	CALL logger_error("MPP GET PROC SIZE: domain decomposition not define.")
[4213]	3304	ENDIF
	3305
	3306	END FUNCTION mpp_get_proc_size
	3307	!-------------------------------------------------------------------
	3308	!> @brief
	3309	!> This subroutine determine domain decomposition type.
	3310	!> (full, overlap, noverlap)
[5600]	3311	!>
[4213]	3312	!> @author J.Paul
[5600]	3313	!> @date November, 2013
	3314	!>
	3315	!> @param[inout] td_mpp mpp strcuture
[4213]	3316	!-------------------------------------------------------------------
	3317	SUBROUTINE mpp_get_dom( td_mpp )
	3318	IMPLICIT NONE
	3319	! Argument
	3320	TYPE(TMPP), INTENT(INOUT) :: td_mpp
	3321
	3322	! local variable
	3323	INTEGER(i4) :: il_isize
	3324	INTEGER(i4) :: il_jsize
	3325	!----------------------------------------------------------------
	3326
	3327	IF( ASSOCIATED(td_mpp%t_proc) )THEN
	3328
	3329	IF( td_mpp%i_niproc == 0 .AND. td_mpp%i_niproc == 0 )THEN
[5600]	3330	CALL logger_info("MPP GET DOM: use indoor indices to get domain "//&
[4213]	3331	& "decomposition type.")
	3332	IF((td_mpp%t_proc(1)%t_dim(1)%i_len == &
	3333	& td_mpp%t_proc(1)%i_lei - td_mpp%t_proc(1)%i_ldi + 1) .AND. &
	3334	& (td_mpp%t_proc(1)%t_dim(2)%i_len == &
	3335	& td_mpp%t_proc(1)%i_lej - td_mpp%t_proc(1)%i_ldj + 1) )THEN
	3336
	3337	td_mpp%c_dom='nooverlap'
	3338
	3339	ELSEIF((td_mpp%t_proc(1)%t_dim(1)%i_len == &
	3340	& td_mpp%t_proc(1)%i_lci ) .AND. &
	3341	& (td_mpp%t_proc(1)%t_dim(2)%i_len == &
	3342	& td_mpp%t_proc(1)%i_lcj ) )THEN
	3343
	3344	td_mpp%c_dom='overlap'
	3345
	3346	ELSEIF((td_mpp%t_proc(1)%t_dim(1)%i_len == &
	3347	& td_mpp%t_dim(1)%i_len ) .AND. &
	3348	& (td_mpp%t_proc(1)%t_dim(2)%i_len == &
	3349	& td_mpp%t_dim(2)%i_len ) )THEN
	3350
	3351	td_mpp%c_dom='full'
	3352
	3353	ELSE
	3354
[5600]	3355	CALL logger_error("MPP GET DOM: should have been an impossible case")
[4213]	3356
	3357	il_isize=td_mpp%t_proc(1)%t_dim(1)%i_len
	3358	il_jsize=td_mpp%t_proc(1)%t_dim(2)%i_len
[5600]	3359	CALL logger_debug("MPP GET DOM: proc size "//&
[4213]	3360	& TRIM(fct_str(il_isize))//" x "//TRIM(fct_str(il_jsize)) )
	3361
	3362	il_isize=td_mpp%t_proc(1)%i_lei - td_mpp%t_proc(1)%i_ldi + 1
	3363	il_jsize=td_mpp%t_proc(1)%i_lej - td_mpp%t_proc(1)%i_ldj + 1
[5600]	3364	CALL logger_debug("MPP GET DOM: no overlap size "//&
[4213]	3365	& TRIM(fct_str(il_isize))//" x "//TRIM(fct_str(il_jsize)) )
	3366
	3367	il_isize=td_mpp%t_proc(1)%i_lci
	3368	il_jsize=td_mpp%t_proc(1)%i_lcj
[5600]	3369	CALL logger_debug("MPP GET DOM: overlap size "//&
[4213]	3370	& TRIM(fct_str(il_isize))//" x "//TRIM(fct_str(il_jsize)) )
	3371
	3372	il_isize=td_mpp%t_dim(1)%i_len
	3373	il_jsize=td_mpp%t_dim(2)%i_len
[5600]	3374	CALL logger_debug("MPP GET DOM: full size "//&
[4213]	3375	& TRIM(fct_str(il_isize))//" x "//TRIM(fct_str(il_jsize)) )
	3376
	3377	ENDIF
	3378
	3379	ELSE
	3380
[5600]	3381	CALL logger_info("MPP GET DOM: use number of processors following "//&
[4213]	3382	& "I and J to get domain decomposition type.")
	3383	IF( td_mpp%i_niproc*td_mpp%i_njproc==td_mpp%i_nproc )THEN
	3384	IF( td_mpp%i_nproc == 1 )THEN
	3385	td_mpp%c_dom='full'
	3386	ENDIF
	3387	td_mpp%c_dom='nooverlap'
	3388	ELSE
	3389	td_mpp%c_dom='overlap'
	3390	ENDIF
	3391
	3392	ENDIF
	3393
	3394	ELSE
[5600]	3395	CALL logger_error("MPP GET DOM: domain decomposition not define.")
[4213]	3396	ENDIF
	3397
	3398	END SUBROUTINE mpp_get_dom
	3399	!-------------------------------------------------------------------
	3400	!> @brief This function check if variable and mpp structure use same
	3401	!> dimension.
[5600]	3402	!>
[4213]	3403	!> @details
[5600]	3404	!>
[4213]	3405	!> @author J.Paul
[5600]	3406	!> - November, 2013- Initial Version
	3407	!>
	3408	!> @param[in] td_mpp mpp structure
	3409	!> @param[in] td_var variable structure
[4213]	3410	!> @return dimension of variable and mpp structure agree (or not)
	3411	!-------------------------------------------------------------------
	3412	LOGICAL FUNCTION mpp__check_var_dim(td_mpp, td_var)
	3413	IMPLICIT NONE
	3414	! Argument
	3415	TYPE(TMPP), INTENT(IN) :: td_mpp
	3416	TYPE(TVAR), INTENT(IN) :: td_var
	3417
	3418	! local variable
	3419	INTEGER(i4) :: il_ndim
	3420
	3421	! loop indices
	3422	INTEGER(i4) :: ji
	3423	!----------------------------------------------------------------
	3424	mpp__check_var_dim=.TRUE.
	3425	! check used dimension
	3426	IF( ANY( td_var%t_dim(:)%l_use .AND. &
	3427	& td_var%t_dim(:)%i_len /= td_mpp%t_dim(:)%i_len) )THEN
	3428
	3429	mpp__check_var_dim=.FALSE.
	3430
	3431	CALL logger_error( &
[5600]	3432	& "MPP CHECK DIM: variable and mpp dimension differ"//&
[4213]	3433	& " for variable "//TRIM(td_var%c_name)//&
	3434	& " and mpp "//TRIM(td_mpp%c_name))
	3435
	3436	CALL logger_debug( &
	3437	& " mpp dimension: "//TRIM(fct_str(td_mpp%i_ndim))//&
	3438	& " variable dimension: "//TRIM(fct_str(td_var%i_ndim)) )
	3439	il_ndim=MIN(td_var%i_ndim, td_mpp%i_ndim )
	3440	DO ji = 1, il_ndim
	3441	CALL logger_debug( &
[5600]	3442	& "MPP CHECK DIM: for dimension "//&
[4213]	3443	& TRIM(td_mpp%t_dim(ji)%c_name)//&
	3444	& ", mpp length: "//&
	3445	& TRIM(fct_str(td_mpp%t_dim(ji)%i_len))//&
	3446	& ", variable length: "//&
	3447	& TRIM(fct_str(td_var%t_dim(ji)%i_len))//&
	3448	& ", variable used "//TRIM(fct_str(td_var%t_dim(ji)%l_use)))
	3449	ENDDO
	3450	ENDIF
	3451
	3452	END FUNCTION mpp__check_var_dim
[5600]	3453	!-------------------------------------------------------------------
	3454	!> @brief This function return the mpp id, in a array of mpp
	3455	!> structure, given mpp base name.
	3456	!
	3457	!> @author J.Paul
	3458	!> - November, 2013- Initial Version
	3459	!
	3460	!> @param[in] td_file array of file structure
	3461	!> @param[in] cd_name file name
	3462	!> @return file id in array of file structure (0 if not found)
	3463	!-------------------------------------------------------------------
	3464	INTEGER(i4) FUNCTION mpp_get_index(td_mpp, cd_name)
	3465	IMPLICIT NONE
	3466	! Argument
	3467	TYPE(TMPP) , DIMENSION(:), INTENT(IN) :: td_mpp
	3468	CHARACTER(LEN=*), INTENT(IN) :: cd_name
	3469
	3470	! local variable
	3471	CHARACTER(LEN=lc) :: cl_name
	3472	INTEGER(i4) :: il_size
	3473
	3474	! loop indices
	3475	INTEGER(i4) :: ji
	3476	!----------------------------------------------------------------
	3477	mpp_get_index=0
	3478	il_size=SIZE(td_mpp(:))
	3479
	3480	cl_name=TRIM( file_rename(cd_name) )
	3481
	3482	! check if mpp is in array of mpp structure
	3483	DO ji=1,il_size
	3484	! look for file name
	3485	IF( TRIM(fct_lower(td_mpp(ji)%c_name)) == TRIM(fct_lower(cd_name)) )THEN
	3486
	3487	mpp_get_index=ji
	3488	EXIT
	3489
	3490	ENDIF
	3491	ENDDO
	3492
	3493	END FUNCTION mpp_get_index
	3494	!-------------------------------------------------------------------
	3495	!> @brief This function recombine variable splitted mpp structure.
	3496	!
	3497	!> @author J.Paul
	3498	!> - Ocotber, 2014- Initial Version
	3499	!
	3500	!> @param[in] td_mpp mpp file structure
	3501	!> @param[in] cd_name variable name
	3502	!> @return variable strucutre
	3503	!-------------------------------------------------------------------
	3504	TYPE(TVAR) FUNCTION mpp_recombine_var(td_mpp, cd_name)
	3505	IMPLICIT NONE
	3506	! Argument
	3507	TYPE(TMPP) , INTENT(IN) :: td_mpp
	3508	CHARACTER(LEN=*), INTENT(IN) :: cd_name
	3509
	3510	! local variable
	3511	INTEGER(i4) :: il_varid
	3512	INTEGER(i4) :: il_status
	3513	INTEGER(i4) :: il_i1p
	3514	INTEGER(i4) :: il_i2p
	3515	INTEGER(i4) :: il_j1p
	3516	INTEGER(i4) :: il_j2p
	3517	INTEGER(i4), DIMENSION(4) :: il_ind
	3518
	3519	INTEGER(i4), DIMENSION(ip_maxdim) :: il_strt
	3520	INTEGER(i4), DIMENSION(ip_maxdim) :: il_cnt
	3521
	3522	TYPE(TVAR) :: tl_tmp
	3523	TYPE(TVAR) :: tl_var
	3524
	3525	! loop indices
	3526	INTEGER(i4) :: ji
	3527	INTEGER(i4) :: jk
	3528	!----------------------------------------------------------------
	3529
	3530	il_varid=var_get_index( td_mpp%t_proc(1)%t_var(:), cd_name)
	3531	IF( il_varid /= 0 )THEN
	3532
	3533	tl_var=var_copy(td_mpp%t_proc(1)%t_var(il_varid))
	3534	! Allocate space to hold variable value in structure
	3535	IF( ASSOCIATED(tl_var%d_value) )THEN
	3536	DEALLOCATE(tl_var%d_value)
	3537	ENDIF
	3538	!
	3539	DO ji=1,ip_maxdim
	3540	IF( tl_var%t_dim(ji)%l_use )THEN
	3541	tl_var%t_dim(ji)%i_len=td_mpp%t_dim(ji)%i_len
	3542	ENDIF
	3543	ENDDO
	3544
	3545	ALLOCATE(tl_var%d_value( tl_var%t_dim(1)%i_len, &
	3546	& tl_var%t_dim(2)%i_len, &
	3547	& tl_var%t_dim(3)%i_len, &
	3548	& tl_var%t_dim(4)%i_len),&
	3549	& stat=il_status)
	3550	IF(il_status /= 0 )THEN
	3551
	3552	CALL logger_error( &
	3553	& " MPP RECOMBINE VAR: not enough space to put variable "//&
	3554	& TRIM(tl_var%c_name)//" in variable structure")
	3555
	3556	ENDIF
	3557
	3558	! FillValue by default
	3559	tl_var%d_value(:,:,:,:)=tl_var%d_fill
	3560
	3561	! read processor
	3562	DO jk=1,td_mpp%i_nproc
	3563	IF( td_mpp%t_proc(jk)%l_use )THEN
	3564	! get processor indices
	3565	il_ind(:)=mpp_get_proc_index( td_mpp, jk )
	3566	il_i1p = il_ind(1)
	3567	il_i2p = il_ind(2)
	3568	il_j1p = il_ind(3)
	3569	il_j2p = il_ind(4)
	3570
	3571	il_strt(:)=(/ 1,1,1,1 /)
	3572
	3573	il_cnt(:)=(/ il_i2p-il_i1p+1, &
	3574	& il_j2p-il_j1p+1, &
	3575	& tl_var%t_dim(3)%i_len, &
	3576	& tl_var%t_dim(4)%i_len /)
	3577
	3578	tl_tmp=iom_read_var( td_mpp%t_proc(jk), tl_var%c_name,&
	3579	& il_strt(:), il_cnt(:) )
	3580
	3581	! replace value in output variable structure
	3582	tl_var%d_value( il_i1p : il_i2p, &
	3583	& il_j1p : il_j2p, &
	3584	& :,:) = tl_tmp%d_value(:,:,:,:)
	3585
	3586	! clean
	3587	CALL var_clean(tl_tmp)
	3588
	3589	ENDIF
	3590	ENDDO
	3591
	3592	mpp_recombine_var=var_copy(tl_var)
	3593
	3594	! clean
	3595	CALL var_clean(tl_var)
	3596
	3597	ELSE
	3598
	3599	CALL logger_error( &
	3600	& " MPP RECOMBINE VAR: there is no variable with "//&
	3601	& "name or standard name"//TRIM(cd_name)//&
	3602	& " in mpp file "//TRIM(td_mpp%c_name))
	3603	ENDIF
	3604	END FUNCTION mpp_recombine_var
[4213]	3605	END MODULE mpp
	3606

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

Download in other formats: