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

Context Navigation

source: trunk/NEMOGCM/TOOLS/SIREN/src/mpp.f90 @ 6393

Last change on this file since 6393 was 6393, checked in by jpaul, 8 years ago
commit changes/bugfix/... for SIREN; see ticket #1700
File size: 143.9 KB

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

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

Download in other formats: