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

Context Navigation

source: NEMO/trunk/tools/SIREN/src/mpp.f90 @ 9598

Last change on this file since 9598 was 9598, checked in by nicolasmartin, 6 years ago
Reorganisation plan for NEMO repository: changes to make compilation succeed with new structure Juste one issue left with AGRIF_NORDIC with AGRIF preprocessing Standardisation of routines header with version 4.0 and year 2018 Fix for some broken symlinks
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	!
[9598]	206	!> @note Software governed by the CeCILL licence (./LICENSE)
[4213]	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")
[7646]	268	PRIVATE :: mpp__init_mask ! initialise mpp structure, given mask array
[5037]	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
[7646]	2552	!>
[4213]	2553	!> @author J.Paul
[6393]	2554	!> @date October, 2015 - Initial version
[7646]	2555	!> @date October, 2016
	2556	!> - compare index to td_lay number of proc instead of td_mpp (bug fix)
	2557	!>
[6393]	2558	!> @param[in] td_mpp mpp strcuture
	2559	!> @param[in] id_mask sub domain mask (sea=1, land=0)
	2560	!> @pâram[in] id_niproc number of processors following I
	2561	!> @pâram[in] id_njproc number of processors following J
	2562	!> @return domain layout structure
[4213]	2563	!-------------------------------------------------------------------
[6393]	2564	FUNCTION layout__init( td_mpp, id_mask, id_niproc, id_njproc ) RESULT(td_lay)
[4213]	2565	IMPLICIT NONE
	2566	! Argument
[6393]	2567	TYPE(TMPP) , INTENT(IN) :: td_mpp
	2568	INTEGER(i4), DIMENSION(:,:), INTENT(IN) :: id_mask
	2569	INTEGER(i4) , INTENT(IN) :: id_niproc
	2570	INTEGER(i4) , INTENT(IN) :: id_njproc
[4213]	2571
[6393]	2572	! function
	2573	TYPE(TLAY) :: td_lay
	2574
[4213]	2575	! local variable
[6393]	2576	INTEGER(i4) :: ii1, ii2
	2577	INTEGER(i4) :: ij1, ij2
[4213]	2578
[6393]	2579	INTEGER(i4) :: il_ldi
	2580	INTEGER(i4) :: il_ldj
	2581	INTEGER(i4) :: il_lei
	2582	INTEGER(i4) :: il_lej
[4213]	2583
[6393]	2584	INTEGER(i4) :: il_isize !< i-direction maximum sub domain size
	2585	INTEGER(i4) :: il_jsize !< j-direction maximum sub domain size
	2586	INTEGER(i4) :: il_resti !<
	2587	INTEGER(i4) :: il_restj !<
	2588
[4213]	2589	! loop indices
	2590	INTEGER(i4) :: ji
	2591	INTEGER(i4) :: jj
	2592	!----------------------------------------------------------------
	2593
	2594	! intialise
[6393]	2595	td_lay%i_niproc=id_niproc
	2596	td_lay%i_njproc=id_njproc
[4213]	2597
[6393]	2598	CALL logger_info( "MPP COMPUTE LAYOUT: compute domain layout with "//&
	2599	& TRIM(fct_str(td_lay%i_niproc))//" x "//&
	2600	& TRIM(fct_str(td_lay%i_njproc))//" processors")
	2601
[4213]	2602	! maximum size of sub domain
[6393]	2603	il_isize = ((td_mpp%t_dim(1)%i_len - 2*td_mpp%i_preci + (td_lay%i_niproc-1))/ &
	2604	& td_lay%i_niproc) + 2*td_mpp%i_preci
	2605	il_jsize = ((td_mpp%t_dim(2)%i_len - 2*td_mpp%i_precj + (td_lay%i_njproc-1))/ &
	2606	& td_lay%i_njproc) + 2*td_mpp%i_precj
[4213]	2607
[6393]	2608	il_resti = MOD(td_mpp%t_dim(1)%i_len - 2*td_mpp%i_preci, td_lay%i_niproc)
	2609	il_restj = MOD(td_mpp%t_dim(2)%i_len - 2*td_mpp%i_precj, td_lay%i_njproc)
	2610	IF( il_resti == 0 ) il_resti = td_lay%i_niproc
	2611	IF( il_restj == 0 ) il_restj = td_lay%i_njproc
[4213]	2612
	2613	! compute dimension of each sub domain
[6393]	2614	ALLOCATE( td_lay%i_lci(td_lay%i_niproc,td_lay%i_njproc) )
	2615	ALLOCATE( td_lay%i_lcj(td_lay%i_niproc,td_lay%i_njproc) )
[4213]	2616
[6393]	2617	td_lay%i_lci( 1 : il_resti , : ) = il_isize
	2618	td_lay%i_lci( il_resti+1 : td_lay%i_niproc, : ) = il_isize-1
[4213]	2619
[6393]	2620	td_lay%i_lcj( : , 1 : il_restj ) = il_jsize
	2621	td_lay%i_lcj( : , il_restj+1 : td_lay%i_njproc) = il_jsize-1
[4213]	2622
	2623	! compute first index of each sub domain
[6393]	2624	ALLOCATE( td_lay%i_impp(td_lay%i_niproc,td_lay%i_njproc) )
	2625	ALLOCATE( td_lay%i_jmpp(td_lay%i_niproc,td_lay%i_njproc) )
[4213]	2626
[6393]	2627	td_lay%i_impp(:,:)=1
	2628	td_lay%i_jmpp(:,:)=1
[4213]	2629
[6393]	2630	IF( td_lay%i_niproc > 1 )THEN
	2631	DO jj=1,td_lay%i_njproc
	2632	DO ji=2,td_lay%i_niproc
	2633	td_lay%i_impp(ji,jj) = td_lay%i_impp(ji-1,jj) + &
	2634	& td_lay%i_lci (ji-1,jj) - 2*td_mpp%i_preci
	2635	ENDDO
[4213]	2636	ENDDO
[6393]	2637	ENDIF
[4213]	2638
[6393]	2639	IF( td_lay%i_njproc > 1 )THEN
	2640	DO jj=2,td_lay%i_njproc
	2641	DO ji=1,td_lay%i_niproc
	2642	td_lay%i_jmpp(ji,jj) = td_lay%i_jmpp(ji,jj-1) + &
	2643	& td_lay%i_lcj (ji,jj-1) - 2*td_mpp%i_precj
	2644	ENDDO
	2645	ENDDO
	2646	ENDIF
[4213]	2647
[6393]	2648	ALLOCATE(td_lay%i_msk(td_lay%i_niproc,td_lay%i_njproc))
	2649	td_lay%i_msk(:,:)=0
	2650	! init number of sea/land proc
	2651	td_lay%i_nsea=0
	2652	td_lay%i_nland=td_lay%i_njproc*td_lay%i_niproc
[4213]	2653
[6393]	2654	! check if processor is land or sea
	2655	DO jj = 1,td_lay%i_njproc
	2656	DO ji = 1,td_lay%i_niproc
[4213]	2657
	2658	! compute first and last indoor indices
	2659	! west boundary
	2660	IF( ji == 1 )THEN
[6393]	2661	il_ldi = 1
[4213]	2662	ELSE
[6393]	2663	il_ldi = 1 + td_mpp%i_preci
[4213]	2664	ENDIF
	2665
	2666	! south boundary
	2667	IF( jj == 1 )THEN
[6393]	2668	il_ldj = 1
[4213]	2669	ELSE
[6393]	2670	il_ldj = 1 + td_mpp%i_precj
[4213]	2671	ENDIF
	2672
	2673	! east boundary
[7646]	2674	IF( ji == td_lay%i_niproc )THEN
[6393]	2675	il_lei = td_lay%i_lci(ji,jj)
[4213]	2676	ELSE
[6393]	2677	il_lei = td_lay%i_lci(ji,jj) - td_mpp%i_preci
[4213]	2678	ENDIF
	2679
	2680	! north boundary
[7646]	2681	IF( jj == td_lay%i_njproc )THEN
[6393]	2682	il_lej = td_lay%i_lcj(ji,jj)
[4213]	2683	ELSE
[6393]	2684	il_lej = td_lay%i_lcj(ji,jj) - td_mpp%i_precj
[4213]	2685	ENDIF
	2686
[6393]	2687	ii1=td_lay%i_impp(ji,jj) + il_ldi - 1
	2688	ii2=td_lay%i_impp(ji,jj) + il_lei - 1
[4213]	2689
[6393]	2690	ij1=td_lay%i_jmpp(ji,jj) + il_ldj - 1
	2691	ij2=td_lay%i_jmpp(ji,jj) + il_lej - 1
[4213]	2692
[6393]	2693	td_lay%i_msk(ji,jj)=SUM( id_mask(ii1:ii2,ij1:ij2) )
	2694	IF( td_lay%i_msk(ji,jj) > 0 )THEN ! sea
	2695	td_lay%i_nsea =td_lay%i_nsea +1
	2696	td_lay%i_nland=td_lay%i_nland-1
	2697	ENDIF
[5037]	2698
[4213]	2699	ENDDO
	2700	ENDDO
	2701
[6393]	2702	CALL logger_info( "MPP COMPUTE LAYOUT: sea proc "//TRIM(fct_str(td_lay%i_nsea)))
	2703	CALL logger_info( "MPP COMPUTE LAYOUT: land proc "//TRIM(fct_str(td_lay%i_nland)))
	2704	CALL logger_info( "MPP COMPUTE LAYOUT: sum "//TRIM(fct_str( SUM(td_lay%i_msk(:,:)))))
[4213]	2705
[6393]	2706	td_lay%i_mean= SUM(td_lay%i_msk(:,:)) / td_lay%i_nsea
	2707	td_lay%i_min = MINVAL(td_lay%i_msk(:,:),td_lay%i_msk(:,:)/=0)
	2708	td_lay%i_max = MAXVAL(td_lay%i_msk(:,:))
	2709
	2710	IF( lm_layout )THEN
	2711	! print info
	2712	WRITE(im_iumout,*) ' '
	2713	WRITE(im_iumout,*) " jpni=",td_lay%i_niproc ," jpnj=",td_lay%i_njproc
	2714	WRITE(im_iumout,*) " jpi= ",il_isize," jpj= ",il_jsize
	2715	WRITE(im_iumout,*) " iresti=",td_mpp%i_preci," irestj=",td_mpp%i_precj
	2716
	2717
	2718	WRITE(im_iumout,) ' nombre de processeurs ',td_lay%i_niproctd_lay%i_njproc
	2719	WRITE(im_iumout,*) ' nombre de processeurs mer ',td_lay%i_nsea
	2720	WRITE(im_iumout,*) ' nombre de processeurs terre ',td_lay%i_nland
	2721	WRITE(im_iumout,*) ' moyenne de recouvrement ',td_lay%i_mean
	2722	WRITE(im_iumout,*) ' minimum de recouvrement ',td_lay%i_min
	2723	WRITE(im_iumout,*) ' maximum de recouvrement ',td_lay%i_max
	2724	ENDIF
	2725
	2726	END FUNCTION layout__init
[4213]	2727	!-------------------------------------------------------------------
	2728	!> @brief
[6393]	2729	!> This subroutine clean domain layout strcuture.
[5037]	2730	!>
[4213]	2731	!> @author J.Paul
[6393]	2732	!> @date October, 2015 - Initial version
[5037]	2733	!>
[6393]	2734	!> @param[inout] td_lay domain layout strcuture
[4213]	2735	!-------------------------------------------------------------------
[6393]	2736	SUBROUTINE layout__clean( td_lay )
[4213]	2737	IMPLICIT NONE
	2738	! Argument
[6393]	2739	TYPE(TLAY), INTENT(INOUT) :: td_lay
	2740	!----------------------------------------------------------------
[4213]	2741
[6393]	2742	IF( ASSOCIATED(td_lay%i_msk) )THEN
	2743	DEALLOCATE(td_lay%i_msk)
	2744	ENDIF
	2745	IF( ASSOCIATED(td_lay%i_impp) )THEN
	2746	DEALLOCATE(td_lay%i_impp)
	2747	ENDIF
	2748	IF( ASSOCIATED(td_lay%i_jmpp) )THEN
	2749	DEALLOCATE(td_lay%i_jmpp)
	2750	ENDIF
	2751	IF( ASSOCIATED(td_lay%i_lci) )THEN
	2752	DEALLOCATE(td_lay%i_lci)
	2753	ENDIF
	2754	IF( ASSOCIATED(td_lay%i_lcj) )THEN
	2755	DEALLOCATE(td_lay%i_lcj)
	2756	ENDIF
	2757
	2758	td_lay%i_niproc=0
	2759	td_lay%i_njproc=0
	2760	td_lay%i_nland =0
	2761	td_lay%i_nsea =0
	2762
	2763	td_lay%i_mean =0
	2764	td_lay%i_min =0
	2765	td_lay%i_max =0
	2766
	2767	END SUBROUTINE layout__clean
	2768	!-------------------------------------------------------------------
	2769	!> @brief
	2770	!> This subroutine copy domain layout structure in another one.
	2771	!>
	2772	!> @warning do not use on the output of a function who create or read a
	2773	!> structure (ex: tl_seg=seg__copy(seg__init()) is forbidden).
	2774	!> This will create memory leaks.
	2775	!> @warning to avoid infinite loop, do not use any function inside
	2776	!> this subroutine
	2777	!>
	2778	!> @author J.Paul
	2779	!> @date October, 2015 - Initial Version
	2780	!
	2781	!> @param[in] td_lay domain layout structure
	2782	!> @return copy of input domain layout structure
	2783	!-------------------------------------------------------------------
	2784	FUNCTION layout__copy( td_lay )
	2785	IMPLICIT NONE
	2786	! Argument
	2787	TYPE(TLAY), INTENT(IN) :: td_lay
	2788	! function
	2789	TYPE(TLAY) :: layout__copy
	2790
	2791	! local variable
	2792	INTEGER(i4), DIMENSION(2) :: il_shape
	2793	INTEGER(i4), DIMENSION(:,:), ALLOCATABLE :: il_tmp
[4213]	2794	! loop indices
	2795	!----------------------------------------------------------------
	2796
[6393]	2797	! copy scalar
	2798	layout__copy%i_niproc = td_lay%i_niproc
	2799	layout__copy%i_njproc = td_lay%i_njproc
	2800	layout__copy%i_nland = td_lay%i_nland
	2801	layout__copy%i_nsea = td_lay%i_nsea
	2802	layout__copy%i_mean = td_lay%i_mean
	2803	layout__copy%i_min = td_lay%i_min
	2804	layout__copy%i_max = td_lay%i_max
	2805
	2806	! copy pointers
	2807	IF( ASSOCIATED(layout__copy%i_msk) )THEN
	2808	DEALLOCATE(layout__copy%i_msk)
[4213]	2809	ENDIF
[6393]	2810	IF( ASSOCIATED(td_lay%i_msk) )THEN
	2811	il_shape(:)=SHAPE(td_lay%i_msk(:,:))
	2812	ALLOCATE( layout__copy%i_msk(il_shape(jp_I),il_shape(jp_J)) )
	2813	layout__copy%i_msk(:,:)=td_lay%i_msk(:,:)
	2814	ENDIF
[4213]	2815
[6393]	2816	IF( ASSOCIATED(layout__copy%i_msk) ) DEALLOCATE(layout__copy%i_msk)
	2817	IF( ASSOCIATED(td_lay%i_msk) )THEN
	2818	il_shape(:)=SHAPE(td_lay%i_msk(:,:))
	2819	ALLOCATE(il_tmp(il_shape(jp_I),il_shape(jp_J)))
	2820	il_tmp(:,:)=td_lay%i_msk(:,:)
	2821
	2822	ALLOCATE( layout__copy%i_msk(il_shape(jp_I),il_shape(jp_J)) )
	2823	layout__copy%i_msk(:,:)=il_tmp(:,:)
	2824
	2825	DEALLOCATE(il_tmp)
	2826	ENDIF
	2827
	2828	IF( ASSOCIATED(layout__copy%i_impp) ) DEALLOCATE(layout__copy%i_impp)
	2829	IF( ASSOCIATED(td_lay%i_impp) )THEN
	2830	il_shape(:)=SHAPE(td_lay%i_impp(:,:))
	2831	ALLOCATE(il_tmp(il_shape(jp_I),il_shape(jp_J)))
	2832	il_tmp(:,:)=td_lay%i_impp(:,:)
	2833
	2834	ALLOCATE( layout__copy%i_impp(il_shape(jp_I),il_shape(jp_J)) )
	2835	layout__copy%i_impp(:,:)=il_tmp(:,:)
	2836
	2837	DEALLOCATE(il_tmp)
	2838	ENDIF
	2839
	2840	IF( ASSOCIATED(layout__copy%i_jmpp) ) DEALLOCATE(layout__copy%i_jmpp)
	2841	IF( ASSOCIATED(td_lay%i_jmpp) )THEN
	2842	il_shape(:)=SHAPE(td_lay%i_jmpp(:,:))
	2843	ALLOCATE(il_tmp(il_shape(jp_I),il_shape(jp_J)))
	2844	il_tmp(:,:)=td_lay%i_jmpp(:,:)
	2845
	2846	ALLOCATE( layout__copy%i_jmpp(il_shape(jp_I),il_shape(jp_J)) )
	2847	layout__copy%i_jmpp(:,:)=il_tmp(:,:)
	2848
	2849	DEALLOCATE(il_tmp)
	2850	ENDIF
	2851
	2852	IF( ASSOCIATED(layout__copy%i_lci) ) DEALLOCATE(layout__copy%i_lci)
	2853	IF( ASSOCIATED(td_lay%i_lci) )THEN
	2854	il_shape(:)=SHAPE(td_lay%i_lci(:,:))
	2855	ALLOCATE(il_tmp(il_shape(jp_I),il_shape(jp_J)))
	2856	il_tmp(:,:)=td_lay%i_lci(:,:)
	2857
	2858	ALLOCATE( layout__copy%i_lci(il_shape(jp_I),il_shape(jp_J)) )
	2859	layout__copy%i_lci(:,:)=il_tmp(:,:)
	2860
	2861	DEALLOCATE(il_tmp)
	2862	ENDIF
	2863
	2864	IF( ASSOCIATED(layout__copy%i_lcj) ) DEALLOCATE(layout__copy%i_lcj)
	2865	IF( ASSOCIATED(td_lay%i_lcj) )THEN
	2866	il_shape(:)=SHAPE(td_lay%i_lcj(:,:))
	2867	ALLOCATE(il_tmp(il_shape(jp_I),il_shape(jp_J)))
	2868	il_tmp(:,:)=td_lay%i_lcj(:,:)
	2869
	2870	ALLOCATE( layout__copy%i_lcj(il_shape(jp_I),il_shape(jp_J)) )
	2871	layout__copy%i_lcj(:,:)=il_tmp(:,:)
	2872
	2873	DEALLOCATE(il_tmp)
	2874	ENDIF
	2875
	2876	END FUNCTION layout__copy
[4213]	2877	!-------------------------------------------------------------------
[6393]	2878	!> @brief
	2879	!> This subroutine create mpp structure using domain layout
	2880	!>
	2881	!> @detail
[4213]	2882	!
	2883	!> @author J.Paul
[6393]	2884	!> @date October, 2015 - Initial version
[4213]	2885	!
[5037]	2886	!> @param[inout] td_mpp mpp strcuture
[6393]	2887	!> @param[in] td_lay domain layout structure
[4213]	2888	!-------------------------------------------------------------------
[6393]	2889	SUBROUTINE mpp__create_layout( td_mpp, td_lay )
[4213]	2890	IMPLICIT NONE
	2891	! Argument
[6393]	2892	TYPE(TMPP), INTENT(INOUT) :: td_mpp
	2893	TYPE(TLAY), INTENT(IN ) :: td_lay
[4213]	2894
	2895	! local variable
[6393]	2896	CHARACTER(LEN=lc) :: cl_file
	2897	TYPE(TFILE) :: tl_proc
	2898	TYPE(TATT) :: tl_att
[4213]	2899
	2900	! loop indices
	2901	INTEGER(i4) :: ji
	2902	INTEGER(i4) :: jj
[6393]	2903	INTEGER(i4) :: jk
[4213]	2904	!----------------------------------------------------------------
	2905
[6393]	2906	! intialise
[4213]	2907	td_mpp%i_nproc=0
	2908
[6393]	2909	CALL logger_debug( "MPP CREATE LAYOUT: create domain decomposition with "//&
	2910	& TRIM(fct_str(td_lay%i_niproc))//" x "//&
	2911	& TRIM(fct_str(td_lay%i_njproc))//" = "//&
	2912	& TRIM(fct_str(td_lay%i_nsea))//" processors")
[4213]	2913
[6393]	2914	IF( lm_layout )THEN
	2915	WRITE(im_iumout,*) ' choix optimum'
	2916	WRITE(im_iumout,*) ' ============='
	2917	WRITE(im_iumout,*)
	2918	! print info
	2919	WRITE(im_iumout,*) ' '
	2920	WRITE(im_iumout,*) " jpni=",td_lay%i_niproc ," jpnj=",td_lay%i_njproc
	2921	WRITE(im_iumout,*) " iresti=",td_mpp%i_preci," irestj=",td_mpp%i_precj
[4213]	2922
	2923
[6393]	2924	WRITE(im_iumout,) ' nombre de processeurs ',td_lay%i_niproctd_lay%i_njproc
	2925	WRITE(im_iumout,*) ' nombre de processeurs mer ',td_lay%i_nsea
	2926	WRITE(im_iumout,*) ' nombre de processeurs terre ',td_lay%i_nland
	2927	WRITE(im_iumout,*) ' moyenne de recouvrement ',td_lay%i_mean
	2928	WRITE(im_iumout,*) ' minimum de recouvrement ',td_lay%i_min
	2929	WRITE(im_iumout,*) ' maximum de recouvrement ',td_lay%i_max
	2930	ENDIF
[5609]	2931
[6393]	2932	td_mpp%i_niproc=td_lay%i_niproc
	2933	td_mpp%i_njproc=td_lay%i_njproc
	2934	!td_mpp%i_nproc =td_lay%i_nsea
[4213]	2935
[6393]	2936	IF( td_mpp%i_niproc*td_mpp%i_njproc == td_lay%i_nsea )THEN
	2937	IF( td_lay%i_nsea == 1 )THEN
	2938	td_mpp%c_dom='full'
	2939	ELSE
	2940	td_mpp%c_dom='nooverlap'
	2941	ENDIF
	2942	ELSE
	2943	td_mpp%c_dom='noextra'
	2944	ENDIF
	2945
	2946	jk=0
	2947	DO jj=1,td_lay%i_njproc
	2948	DO ji=1,td_lay%i_niproc
[4213]	2949
[6393]	2950	IF( td_lay%i_msk(ji,jj) >= 1 )THEN
[5037]	2951
[6393]	2952	! get processor file name
	2953	cl_file=file_rename(td_mpp%c_name,jk)
	2954	! initialise file structure
	2955	tl_proc=file_init(cl_file,td_mpp%c_type)
[4213]	2956
[6393]	2957	! procesor id
	2958	tl_proc%i_pid=jk
	2959
	2960	tl_att=att_init("DOMAIN_number",tl_proc%i_pid)
	2961	CALL file_add_att(tl_proc, tl_att)
	2962
	2963	! processor indices
	2964	tl_proc%i_iind=ji
	2965	tl_proc%i_jind=jj
	2966
	2967	! fill processor dimension and first indices
	2968	tl_proc%i_impp = td_lay%i_impp(ji,jj)
	2969	tl_proc%i_jmpp = td_lay%i_jmpp(ji,jj)
	2970
	2971	tl_proc%i_lci = td_lay%i_lci(ji,jj)
	2972	tl_proc%i_lcj = td_lay%i_lcj(ji,jj)
	2973
	2974	! compute first and last indoor indices
	2975
	2976	! west boundary
	2977	IF( ji == 1 )THEN
	2978	tl_proc%i_ldi = 1
	2979	tl_proc%l_ctr = .TRUE.
	2980	ELSE
	2981	tl_proc%i_ldi = 1 + td_mpp%i_preci
	2982	ENDIF
	2983
	2984	! south boundary
	2985	IF( jj == 1 )THEN
	2986	tl_proc%i_ldj = 1
	2987	tl_proc%l_ctr = .TRUE.
	2988	ELSE
	2989	tl_proc%i_ldj = 1 + td_mpp%i_precj
	2990	ENDIF
	2991
	2992	! east boundary
	2993	IF( ji == td_mpp%i_niproc )THEN
	2994	tl_proc%i_lei = td_lay%i_lci(ji,jj)
	2995	tl_proc%l_ctr = .TRUE.
	2996	ELSE
	2997	tl_proc%i_lei = td_lay%i_lci(ji,jj) - td_mpp%i_preci
	2998	ENDIF
	2999
	3000	! north boundary
	3001	IF( jj == td_mpp%i_njproc )THEN
	3002	tl_proc%i_lej = td_lay%i_lcj(ji,jj)
	3003	tl_proc%l_ctr = .TRUE.
	3004	ELSE
	3005	tl_proc%i_lej = td_lay%i_lcj(ji,jj) - td_mpp%i_precj
	3006	ENDIF
	3007
	3008	! add processor to mpp structure
	3009	CALL mpp__add_proc(td_mpp, tl_proc)
	3010
[5037]	3011	! clean
[6393]	3012	CALL att_clean(tl_att)
	3013	CALL file_clean(tl_proc)
[4213]	3014
[6393]	3015	! update proc number
	3016	jk=jk+1 !ji+(jj-1)*td_lay%i_niproc
	3017
[4213]	3018	ENDIF
	3019	ENDDO
	3020	ENDDO
	3021
[6393]	3022	END SUBROUTINE mpp__create_layout
[4213]	3023	!-------------------------------------------------------------------
[6393]	3024	!> @brief
	3025	!> This subroutine optimize the number of sub domain to be used, given mask.
	3026	!> @details
	3027	!> Actually it get the domain decomposition with the most land
	3028	!> processors removed.
	3029	!> If no land processor could be removed, it get the decomposition with the
	3030	!> most sea processors.
	3031	!
[4213]	3032	!> @author J.Paul
[5037]	3033	!> @date November, 2013 - Initial version
[6393]	3034	!> @date October, 2015
	3035	!> - improve way to compute domain layout
	3036	!> @date February, 2016
	3037	!> - new criteria for domain layout in case no land proc
	3038	!
	3039	!> @param[inout] td_mpp mpp strcuture
	3040	!> @param[in] id_mask sub domain mask (sea=1, land=0)
	3041	!> @pram[in] id_nproc maximum number of processor to be used
[4213]	3042	!-------------------------------------------------------------------
[6393]	3043	SUBROUTINE mpp__optimiz( td_mpp, id_mask, id_nproc )
[4213]	3044	IMPLICIT NONE
	3045	! Argument
[6393]	3046	TYPE(TMPP), INTENT(INOUT) :: td_mpp
	3047	INTEGER(i4), DIMENSION(:,:), INTENT(IN) :: id_mask
	3048	INTEGER(i4) , INTENT(IN) :: id_nproc
[4213]	3049
	3050	! local variable
[6393]	3051	TYPE(TLAY) :: tl_lay
	3052	TYPE(TLAY) :: tl_sav
	3053
	3054	REAL(dp) :: dl_min
	3055	REAL(dp) :: dl_max
	3056	REAL(dp) :: dl_ratio
	3057	REAL(dp) :: dl_sav
	3058
	3059	! loop indices
	3060	INTEGER(i4) :: ji
	3061	INTEGER(i4) :: jj
[4213]	3062	!----------------------------------------------------------------
	3063
[6393]	3064	CALL logger_trace("MPP OPTIMIZ: look for best domain decomposition")
	3065	dl_sav=0
	3066	!
	3067	DO ji=1,id_nproc
	3068	DO jj=1,id_nproc
[4213]	3069
[6393]	3070	! compute domain layout
	3071	tl_lay=layout__init( td_mpp, id_mask, ji,jj )
	3072	IF( tl_lay%i_nsea <= id_nproc )THEN
	3073
	3074	IF( ASSOCIATED(tl_sav%i_lci) )THEN
	3075	IF( tl_sav%i_nland /= 0 )THEN
	3076	! look for layout with most land proc
	3077	IF( tl_lay%i_nland > tl_sav%i_nland .OR. &
	3078	& ( tl_lay%i_nland == tl_sav%i_nland .AND. &
	3079	& tl_lay%i_min > tl_sav%i_min ) )THEN
	3080	! save optimiz layout
	3081	CALL logger_info("MPP OPTIMIZ:save this decomposition "//&
	3082	& TRIM(fct_str(ji))//"x"//TRIM(fct_str(jj))//"="//&
	3083	& TRIM(fct_str(tl_lay%i_nsea)) )
	3084
	3085	tl_sav=layout__copy(tl_lay)
	3086	ENDIF
	3087	ELSE ! tl_sav%i_nland == 0
	3088	! look for layout with most sea proc
	3089	! and "square" cell
	3090	dl_min=MIN(tl_lay%i_lci(1,1),tl_lay%i_lcj(1,1))
	3091	dl_max=MAX(tl_lay%i_lci(1,1),tl_lay%i_lcj(1,1))
	3092	dl_ratio=dl_min/dl_max
	3093	IF( tl_lay%i_nsea > tl_sav%i_nsea .OR. &
	3094	& ( tl_lay%i_nsea == tl_sav%i_nsea .AND. &
	3095	& dl_ratio > dl_sav ) )THEN
	3096	! save optimiz layout
	3097	CALL logger_info("MPP OPTIMIZ:save this decomposition "//&
	3098	& TRIM(fct_str(ji))//"x"//TRIM(fct_str(jj))//"="//&
	3099	& TRIM(fct_str(tl_lay%i_nsea)) )
	3100
	3101	tl_sav=layout__copy(tl_lay)
	3102	dl_sav=dl_ratio
	3103	ENDIF
	3104	ENDIF
	3105	ELSE
	3106	! init tl_sav
	3107	tl_sav=layout__copy(tl_lay)
	3108
	3109	dl_min=MIN(tl_sav%i_lci(1,1),tl_sav%i_lcj(1,1))
	3110	dl_max=MAX(tl_sav%i_lci(1,1),tl_sav%i_lcj(1,1))
	3111	dl_sav=dl_min/dl_max
	3112	ENDIF
	3113
[4213]	3114	ENDIF
	3115
[6393]	3116	! clean
	3117	CALL layout__clean( tl_lay )
[4213]	3118
[6393]	3119	ENDDO
	3120	ENDDO
	3121
	3122	! create mpp domain layout
	3123	CALL mpp__create_layout(td_mpp, tl_sav)
	3124
	3125	! clean
	3126	CALL layout__clean( tl_sav )
	3127
	3128	END SUBROUTINE mpp__optimiz
[4213]	3129	!-------------------------------------------------------------------
	3130	!> @brief
	3131	!> This subroutine clean mpp strcuture.
[5037]	3132	!>
[4213]	3133	!> @author J.Paul
[5037]	3134	!> @date November, 2013 - Initial version
	3135	!>
	3136	!> @param[inout] td_mpp mpp strcuture
[4213]	3137	!-------------------------------------------------------------------
[5037]	3138	SUBROUTINE mpp__clean_unit( td_mpp )
[4213]	3139	IMPLICIT NONE
	3140	! Argument
	3141	TYPE(TMPP), INTENT(INOUT) :: td_mpp
	3142
	3143	! local variable
	3144	TYPE(TMPP) :: tl_mpp ! empty mpp structure
	3145
	3146	! loop indices
	3147	!----------------------------------------------------------------
	3148
	3149	CALL logger_info( &
[5037]	3150	& "MPP CLEAN: reset mpp "//TRIM(td_mpp%c_name) )
[4213]	3151
	3152	! del dimension
	3153	IF( td_mpp%i_ndim /= 0 )THEN
[5037]	3154	CALL dim_clean( td_mpp%t_dim(:) )
[4213]	3155	ENDIF
	3156
	3157	IF( ASSOCIATED(td_mpp%t_proc) )THEN
[5037]	3158	! clean array of file processor
	3159	CALL file_clean( td_mpp%t_proc(:) )
[4213]	3160	DEALLOCATE(td_mpp%t_proc)
	3161	ENDIF
	3162
	3163	! replace by empty structure
[5037]	3164	td_mpp=mpp_copy(tl_mpp)
[4213]	3165
[5037]	3166	END SUBROUTINE mpp__clean_unit
[4213]	3167	!-------------------------------------------------------------------
	3168	!> @brief
[5037]	3169	!> This subroutine clean mpp strcuture.
	3170	!>
	3171	!> @author J.Paul
	3172	!> @date November, 2013 - Initial version
	3173	!>
	3174	!> @param[inout] td_mpp mpp strcuture
	3175	!-------------------------------------------------------------------
	3176	SUBROUTINE mpp__clean_arr( td_mpp )
	3177	IMPLICIT NONE
	3178	! Argument
	3179	TYPE(TMPP), DIMENSION(:), INTENT(INOUT) :: td_mpp
	3180
	3181	! local variable
	3182	! loop indices
	3183	INTEGER(i4) :: ji
	3184	!----------------------------------------------------------------
	3185
	3186	DO ji=SIZE(td_mpp(:)),1,-1
	3187	CALL mpp_clean(td_mpp(ji))
	3188	ENDDO
	3189
	3190	END SUBROUTINE mpp__clean_arr
	3191	!-------------------------------------------------------------------
	3192	!> @brief
[4213]	3193	!> This subroutine get sub domains which cover "zoom domain".
[5037]	3194	!>
[4213]	3195	!> @author J.Paul
[5037]	3196	!> @date November, 2013 - Initial version
	3197	!>
	3198	!> @param[inout] td_mpp mpp strcuture
	3199	!> @param[in] id_imin i-direction lower indice
	3200	!> @param[in] id_imax i-direction upper indice
	3201	!> @param[in] id_jmin j-direction lower indice
	3202	!> @param[in] id_jmax j-direction upper indice
[4213]	3203	!-------------------------------------------------------------------
[5037]	3204	SUBROUTINE mpp__get_use_unit( td_mpp, id_imin, id_imax, &
	3205	& id_jmin, id_jmax )
[4213]	3206	IMPLICIT NONE
	3207	! Argument
[5037]	3208	TYPE(TMPP) , INTENT(INOUT) :: td_mpp
	3209	INTEGER(i4), INTENT(IN), OPTIONAL :: id_imin
	3210	INTEGER(i4), INTENT(IN), OPTIONAL :: id_imax
	3211	INTEGER(i4), INTENT(IN), OPTIONAL :: id_jmin
	3212	INTEGER(i4), INTENT(IN), OPTIONAL :: id_jmax
[4213]	3213
	3214	! local variable
	3215	LOGICAL :: ll_iuse
	3216	LOGICAL :: ll_juse
	3217
[5037]	3218	INTEGER(i4) :: il_imin
	3219	INTEGER(i4) :: il_imax
	3220	INTEGER(i4) :: il_jmin
	3221	INTEGER(i4) :: il_jmax
	3222
[4213]	3223	! loop indices
	3224	INTEGER(i4) :: jk
	3225	!----------------------------------------------------------------
	3226	IF( ASSOCIATED(td_mpp%t_proc) )THEN
	3227
[5037]	3228	il_imin=1
	3229	il_imax=td_mpp%t_dim(1)%i_len
	3230	IF( PRESENT(id_imin) ) il_imin=id_imin
	3231	IF( PRESENT(id_imax) ) il_imax=id_imax
	3232	il_jmin=1
	3233	il_jmax=td_mpp%t_dim(2)%i_len
	3234	IF( PRESENT(id_jmin) ) il_jmin=id_jmin
	3235	IF( PRESENT(id_jmax) ) il_jmax=id_jmax
	3236
[4213]	3237	! check domain
[5037]	3238	IF( il_imin < 1 .OR. il_imin > td_mpp%t_dim(1)%i_len .OR. &
	3239	& il_imax < 1 .OR. il_imax > td_mpp%t_dim(1)%i_len .OR. &
	3240	& il_jmin < 1 .OR. il_jmin > td_mpp%t_dim(2)%i_len .OR. &
	3241	& il_jmax < 1 .OR. il_jmax > td_mpp%t_dim(2)%i_len )THEN
	3242	CALL logger_debug("MPP GET USE: mpp gloabl size "//&
	3243	& TRIM(fct_str(td_mpp%t_dim(1)%i_len))//","//&
	3244	& TRIM(fct_str(td_mpp%t_dim(2)%i_len)))
	3245	CALL logger_debug("MPP GET USE: i-indices "//&
	3246	& TRIM(fct_str(il_imin))//","//TRIM(fct_str(il_imax)))
	3247	CALL logger_debug("MPP GET USE: j-indices "//&
	3248	& TRIM(fct_str(il_jmin))//","//TRIM(fct_str(il_jmax)))
	3249	CALL logger_error("MPP GET USE: invalid indices ")
	3250	ELSE
[4213]	3251	td_mpp%t_proc(:)%l_use=.FALSE.
	3252	DO jk=1,td_mpp%i_nproc
	3253
	3254	! check i-direction
	3255	ll_iuse=.FALSE.
[5037]	3256	IF( il_imin < il_imax )THEN
[4213]	3257
	3258	! not overlap east west boundary
	3259	IF( td_mpp%t_proc(jk)%i_impp + td_mpp%t_proc(jk)%i_lci > &
[5037]	3260	& il_imin .AND. &
	3261	& td_mpp%t_proc(jk)%i_impp < il_imax )THEN
[4213]	3262	ll_iuse=.TRUE.
	3263	ENDIF
	3264
[5037]	3265	ELSEIF( il_imin == il_imax )THEN
[4213]	3266
	3267	! east west cyclic
	3268	ll_iuse=.TRUE.
	3269
[5037]	3270	ELSE ! il_imin > id_imax
[4213]	3271
	3272	! overlap east west boundary
	3273	IF( ( td_mpp%t_proc(jk)%i_impp + td_mpp%t_proc(jk)%i_lci > &
[5037]	3274	& il_imin ) &
[4213]	3275	& .OR. &
[5037]	3276	& ( td_mpp%t_proc(jk)%i_impp < il_imax) )THEN
[4213]	3277	ll_iuse=.TRUE.
	3278	ENDIF
	3279
	3280	ENDIF
	3281
	3282	! check j-direction
	3283	ll_juse=.FALSE.
[5037]	3284	IF( il_jmin < il_jmax )THEN
[4213]	3285
	3286	! not overlap north fold
	3287	IF( td_mpp%t_proc(jk)%i_jmpp + td_mpp%t_proc(jk)%i_lcj > &
[5037]	3288	& il_jmin .AND. &
	3289	& td_mpp%t_proc(jk)%i_jmpp < il_jmax )THEN
[4213]	3290	ll_juse=.TRUE.
	3291	ENDIF
	3292
[5037]	3293	ELSE ! id_jmin >= id_jmax
[4213]	3294
	3295	IF( td_mpp%t_proc(jk)%i_jmpp + td_mpp%t_proc(jk)%i_lcj > &
	3296	& il_jmin )THEN
	3297	ll_juse=.TRUE.
	3298	ENDIF
	3299
	3300	ENDIF
	3301
	3302	IF( ll_iuse .AND. ll_juse ) td_mpp%t_proc(jk)%l_use=.TRUE.
	3303
	3304	ENDDO
	3305	ENDIF
	3306
	3307	ELSE
[5037]	3308	CALL logger_error("MPP GET USE: mpp decomposition not define.")
[4213]	3309	ENDIF
	3310
[5037]	3311	END SUBROUTINE mpp__get_use_unit
[4213]	3312	!-------------------------------------------------------------------
	3313	!> @brief
	3314	!> This subroutine get sub domains which form global domain border.
[5037]	3315	!>
[4213]	3316	!> @author J.Paul
[5617]	3317	!> @date November, 2013 - Initial version
[5037]	3318	!>
	3319	!> @param[inout] td_mpp mpp strcuture
[4213]	3320	!-------------------------------------------------------------------
	3321	SUBROUTINE mpp_get_contour( td_mpp )
	3322	IMPLICIT NONE
	3323	! Argument
	3324	TYPE(TMPP), INTENT(INOUT) :: td_mpp
	3325
	3326	! loop indices
	3327	INTEGER(i4) :: jk
	3328	!----------------------------------------------------------------
	3329
	3330	IF( ASSOCIATED(td_mpp%t_proc) )THEN
	3331
[5037]	3332	td_mpp%t_proc(:)%l_use = .FALSE.
[4213]	3333	DO jk=1,td_mpp%i_nproc
	3334	IF( td_mpp%t_proc(jk)%i_ldi == 1 .OR. &
	3335	& td_mpp%t_proc(jk)%i_ldj == 1 .OR. &
	3336	& td_mpp%t_proc(jk)%i_lei == td_mpp%t_proc(jk)%i_lci .OR. &
	3337	& td_mpp%t_proc(jk)%i_lej == td_mpp%t_proc(jk)%i_lcj )THEN
	3338
[5037]	3339	td_mpp%t_proc(jk)%l_use = .TRUE.
	3340
[4213]	3341	ENDIF
	3342	ENDDO
	3343
	3344	ELSE
[5037]	3345	CALL logger_error("MPP GET CONTOUR: domain decomposition not define.")
[4213]	3346	ENDIF
	3347
	3348	END SUBROUTINE mpp_get_contour
	3349	!-------------------------------------------------------------------
	3350	!> @brief
	3351	!> This function return processor indices, without overlap boundary,
[5037]	3352	!> given processor id.
	3353	!>
[4213]	3354	!> @author J.Paul
[5617]	3355	!> @date November, 2013 - Initial version
[5037]	3356	!>
	3357	!> @param[in] td_mpp mpp strcuture
	3358	!> @param[in] id_procid processor id
	3359	!> @return array of index (/ i1, i2, j1, j2 /)
[4213]	3360	!-------------------------------------------------------------------
	3361	FUNCTION mpp_get_proc_index( td_mpp, id_procid )
	3362	IMPLICIT NONE
	3363
	3364	! Argument
[5037]	3365	TYPE(TMPP) , INTENT(IN) :: td_mpp
[4213]	3366	INTEGER(i4), INTENT(IN) :: id_procid
	3367
	3368	! function
	3369	INTEGER(i4), DIMENSION(4) :: mpp_get_proc_index
	3370
	3371	! local variable
	3372	INTEGER(i4) :: il_i1, il_i2
	3373	INTEGER(i4) :: il_j1, il_j2
	3374	!----------------------------------------------------------------
	3375
	3376	IF( ASSOCIATED(td_mpp%t_proc) )THEN
	3377
	3378	IF( TRIM(td_mpp%c_dom) == '' )THEN
[5037]	3379	CALL logger_fatal("MPP GET PROC INDEX: decomposition type unknown. "//&
	3380	& "you should ahve run mpp_get_dom before.")
[4213]	3381	ENDIF
	3382
[5037]	3383	SELECT CASE(TRIM(td_mpp%c_dom))
[4213]	3384	CASE('full')
[6393]	3385	il_i1 = 1
	3386	il_j1 = 1
[4213]	3387
[6393]	3388	il_i2 = td_mpp%t_dim(1)%i_len
	3389	il_j2 = td_mpp%t_dim(2)%i_len
	3390	CASE('noextra')
	3391	il_i1 = td_mpp%t_proc(id_procid)%i_impp
	3392	il_j1 = td_mpp%t_proc(id_procid)%i_jmpp
	3393
	3394	il_i2 = il_i1 + td_mpp%t_proc(id_procid)%i_lci - 1
	3395	il_j2 = il_j1 + td_mpp%t_proc(id_procid)%i_lcj - 1
[4213]	3396	CASE('nooverlap')
	3397	il_i1 = td_mpp%t_proc(id_procid)%i_impp + &
	3398	& td_mpp%t_proc(id_procid)%i_ldi - 1
	3399	il_j1 = td_mpp%t_proc(id_procid)%i_jmpp + &
	3400	& td_mpp%t_proc(id_procid)%i_ldj - 1
	3401
	3402	il_i2 = td_mpp%t_proc(id_procid)%i_impp + &
	3403	& td_mpp%t_proc(id_procid)%i_lei - 1
	3404	il_j2 = td_mpp%t_proc(id_procid)%i_jmpp + &
	3405	& td_mpp%t_proc(id_procid)%i_lej - 1
	3406	CASE DEFAULT
[6393]	3407	CALL logger_error("MPP GET PROC INDEX: invalid "//&
	3408	& "decomposition type.")
[4213]	3409	END SELECT
	3410
	3411	mpp_get_proc_index(:)=(/il_i1, il_i2, il_j1, il_j2/)
	3412
	3413	ELSE
[5037]	3414	CALL logger_error("MPP GET PROC INDEX: domain decomposition not define.")
[4213]	3415	ENDIF
	3416
	3417	END FUNCTION mpp_get_proc_index
	3418	!-------------------------------------------------------------------
	3419	!> @brief
	3420	!> This function return processor domain size, depending of domain
	3421	!> decompisition type, given sub domain id.
	3422	!
	3423	!> @author J.Paul
[5617]	3424	!> @date November, 2013 - Initial version
[4213]	3425	!
[5037]	3426	!> @param[in] td_mpp mpp strcuture
	3427	!> @param[in] id_procid sub domain id
	3428	!> @return array of index (/ isize, jsize /)
[4213]	3429	!-------------------------------------------------------------------
	3430	FUNCTION mpp_get_proc_size( td_mpp, id_procid )
	3431	IMPLICIT NONE
	3432
	3433	! Argument
	3434	TYPE(TMPP), INTENT(IN) :: td_mpp
	3435	INTEGER(i4), INTENT(IN) :: id_procid
	3436
	3437	! function
	3438	INTEGER(i4), DIMENSION(2) :: mpp_get_proc_size
	3439
	3440	! local variable
	3441	INTEGER(i4) :: il_isize
	3442	INTEGER(i4) :: il_jsize
	3443	!----------------------------------------------------------------
	3444
	3445	IF( ASSOCIATED(td_mpp%t_proc) )THEN
	3446
	3447	IF( TRIM(td_mpp%c_dom) == '' )THEN
[5037]	3448	CALL logger_fatal("MPP GET PROC SIZE: decomposition type unknown. "//&
	3449	& "you should ahve run mpp_get_dom before.")
[4213]	3450	ENDIF
	3451
[5037]	3452	SELECT CASE(TRIM(td_mpp%c_dom))
[4213]	3453	CASE('full')
	3454
	3455	il_isize = td_mpp%t_dim(1)%i_len
	3456	il_jsize = td_mpp%t_dim(2)%i_len
	3457
[6393]	3458	CASE('noextra')
[4213]	3459
	3460	il_isize = td_mpp%t_proc(id_procid)%i_lci
	3461	il_jsize = td_mpp%t_proc(id_procid)%i_lcj
	3462
	3463	CASE('nooverlap')
	3464	il_isize = td_mpp%t_proc(id_procid)%i_lei - &
	3465	& td_mpp%t_proc(id_procid)%i_ldi + 1
	3466	il_jsize = td_mpp%t_proc(id_procid)%i_lej - &
	3467	& td_mpp%t_proc(id_procid)%i_ldj + 1
	3468	CASE DEFAULT
[5037]	3469	CALL logger_error("MPP GET PROC SIZE: invalid decomposition type : "//&
	3470	& TRIM(td_mpp%c_dom) )
[4213]	3471	END SELECT
	3472
	3473	mpp_get_proc_size(:)=(/il_isize, il_jsize/)
	3474
	3475	ELSE
[5037]	3476	CALL logger_error("MPP GET PROC SIZE: domain decomposition not define.")
[4213]	3477	ENDIF
	3478
	3479	END FUNCTION mpp_get_proc_size
	3480	!-------------------------------------------------------------------
	3481	!> @brief
	3482	!> This subroutine determine domain decomposition type.
	3483	!> (full, overlap, noverlap)
[5037]	3484	!>
[4213]	3485	!> @author J.Paul
[5617]	3486	!> @date November, 2013 - Initial version
[5037]	3487	!>
	3488	!> @param[inout] td_mpp mpp strcuture
[4213]	3489	!-------------------------------------------------------------------
	3490	SUBROUTINE mpp_get_dom( td_mpp )
	3491	IMPLICIT NONE
	3492	! Argument
	3493	TYPE(TMPP), INTENT(INOUT) :: td_mpp
	3494
	3495	! local variable
	3496	INTEGER(i4) :: il_isize
	3497	INTEGER(i4) :: il_jsize
	3498	!----------------------------------------------------------------
	3499
	3500	IF( ASSOCIATED(td_mpp%t_proc) )THEN
	3501
[6393]	3502	IF( td_mpp%i_niproc == 0 .AND. td_mpp%i_njproc == 0 )THEN
[5037]	3503	CALL logger_info("MPP GET DOM: use indoor indices to get domain "//&
[4213]	3504	& "decomposition type.")
	3505	IF((td_mpp%t_proc(1)%t_dim(1)%i_len == &
	3506	& td_mpp%t_proc(1)%i_lei - td_mpp%t_proc(1)%i_ldi + 1) .AND. &
	3507	& (td_mpp%t_proc(1)%t_dim(2)%i_len == &
	3508	& td_mpp%t_proc(1)%i_lej - td_mpp%t_proc(1)%i_ldj + 1) )THEN
	3509
	3510	td_mpp%c_dom='nooverlap'
	3511
	3512	ELSEIF((td_mpp%t_proc(1)%t_dim(1)%i_len == &
	3513	& td_mpp%t_proc(1)%i_lci ) .AND. &
	3514	& (td_mpp%t_proc(1)%t_dim(2)%i_len == &
	3515	& td_mpp%t_proc(1)%i_lcj ) )THEN
	3516
[6393]	3517	td_mpp%c_dom='noextra'
[4213]	3518
	3519	ELSEIF((td_mpp%t_proc(1)%t_dim(1)%i_len == &
	3520	& td_mpp%t_dim(1)%i_len ) .AND. &
	3521	& (td_mpp%t_proc(1)%t_dim(2)%i_len == &
	3522	& td_mpp%t_dim(2)%i_len ) )THEN
	3523
	3524	td_mpp%c_dom='full'
	3525
	3526	ELSE
	3527
[5037]	3528	CALL logger_error("MPP GET DOM: should have been an impossible case")
[4213]	3529
	3530	il_isize=td_mpp%t_proc(1)%t_dim(1)%i_len
	3531	il_jsize=td_mpp%t_proc(1)%t_dim(2)%i_len
[5037]	3532	CALL logger_debug("MPP GET DOM: proc size "//&
[4213]	3533	& TRIM(fct_str(il_isize))//" x "//TRIM(fct_str(il_jsize)) )
	3534
	3535	il_isize=td_mpp%t_proc(1)%i_lei - td_mpp%t_proc(1)%i_ldi + 1
	3536	il_jsize=td_mpp%t_proc(1)%i_lej - td_mpp%t_proc(1)%i_ldj + 1
[5037]	3537	CALL logger_debug("MPP GET DOM: no overlap size "//&
[4213]	3538	& TRIM(fct_str(il_isize))//" x "//TRIM(fct_str(il_jsize)) )
	3539
	3540	il_isize=td_mpp%t_proc(1)%i_lci
	3541	il_jsize=td_mpp%t_proc(1)%i_lcj
[5037]	3542	CALL logger_debug("MPP GET DOM: overlap size "//&
[4213]	3543	& TRIM(fct_str(il_isize))//" x "//TRIM(fct_str(il_jsize)) )
	3544
	3545	il_isize=td_mpp%t_dim(1)%i_len
	3546	il_jsize=td_mpp%t_dim(2)%i_len
[5037]	3547	CALL logger_debug("MPP GET DOM: full size "//&
[4213]	3548	& TRIM(fct_str(il_isize))//" x "//TRIM(fct_str(il_jsize)) )
	3549
	3550	ENDIF
	3551
	3552	ELSE
	3553
[5037]	3554	CALL logger_info("MPP GET DOM: use number of processors following "//&
[4213]	3555	& "I and J to get domain decomposition type.")
	3556	IF( td_mpp%i_niproc*td_mpp%i_njproc==td_mpp%i_nproc )THEN
	3557	IF( td_mpp%i_nproc == 1 )THEN
	3558	td_mpp%c_dom='full'
	3559	ENDIF
	3560	td_mpp%c_dom='nooverlap'
	3561	ELSE
[6393]	3562	td_mpp%c_dom='noextra'
[4213]	3563	ENDIF
	3564
	3565	ENDIF
	3566
	3567	ELSE
[5037]	3568	CALL logger_error("MPP GET DOM: domain decomposition not define.")
[4213]	3569	ENDIF
	3570
	3571	END SUBROUTINE mpp_get_dom
	3572	!-------------------------------------------------------------------
	3573	!> @brief This function check if variable and mpp structure use same
	3574	!> dimension.
[5037]	3575	!>
[4213]	3576	!> @details
[5037]	3577	!>
[4213]	3578	!> @author J.Paul
[5617]	3579	!> @date November, 2013 - Initial Version
[6393]	3580	!> @date September 2015
	3581	!> - do not check used dimension here
[5037]	3582	!>
	3583	!> @param[in] td_mpp mpp structure
	3584	!> @param[in] td_var variable structure
[4213]	3585	!> @return dimension of variable and mpp structure agree (or not)
	3586	!-------------------------------------------------------------------
	3587	LOGICAL FUNCTION mpp__check_var_dim(td_mpp, td_var)
	3588	IMPLICIT NONE
	3589	! Argument
	3590	TYPE(TMPP), INTENT(IN) :: td_mpp
	3591	TYPE(TVAR), INTENT(IN) :: td_var
	3592
	3593	! local variable
[6393]	3594	CHARACTER(LEN=lc) :: cl_dim
	3595	LOGICAL :: ll_error
	3596	LOGICAL :: ll_warn
[4213]	3597
[6393]	3598	INTEGER(i4) :: il_ind
	3599
[4213]	3600	! loop indices
	3601	INTEGER(i4) :: ji
	3602	!----------------------------------------------------------------
	3603	mpp__check_var_dim=.TRUE.
[6393]	3604
[4213]	3605	! check used dimension
[6393]	3606	ll_error=.FALSE.
	3607	ll_warn=.FALSE.
	3608	DO ji=1,ip_maxdim
	3609	il_ind=dim_get_index( td_mpp%t_dim(:), &
	3610	& TRIM(td_var%t_dim(ji)%c_name), &
	3611	& TRIM(td_var%t_dim(ji)%c_sname))
	3612	IF( il_ind /= 0 )THEN
	3613	IF( td_var%t_dim(ji)%l_use .AND. &
	3614	& td_mpp%t_dim(il_ind)%l_use .AND. &
	3615	& td_var%t_dim(ji)%i_len /= td_mpp%t_dim(il_ind)%i_len )THEN
	3616	IF( INDEX( TRIM(td_var%c_axis), &
	3617	& TRIM(fct_upper(td_var%t_dim(ji)%c_name))) == 0 )THEN
	3618	ll_warn=.TRUE.
	3619	ELSE
	3620	ll_error=.TRUE.
	3621	ENDIF
	3622	ENDIF
	3623	ENDIF
	3624	ENDDO
[4213]	3625
[6393]	3626	IF( ll_error )THEN
[4213]	3627
[6393]	3628	cl_dim='(/'
	3629	DO ji = 1, td_mpp%i_ndim
	3630	IF( td_mpp%t_dim(ji)%l_use )THEN
	3631	cl_dim=TRIM(cl_dim)//&
	3632	& TRIM(fct_upper(td_mpp%t_dim(ji)%c_sname))//':'//&
	3633	& TRIM(fct_str(td_mpp%t_dim(ji)%i_len))//','
	3634	ENDIF
[4213]	3635	ENDDO
[6393]	3636	cl_dim=TRIM(cl_dim)//'/)'
	3637	CALL logger_debug( " mpp dimension: "//TRIM(cl_dim) )
[5609]	3638
[6393]	3639	cl_dim='(/'
	3640	DO ji = 1, td_var%i_ndim
	3641	IF( td_var%t_dim(ji)%l_use )THEN
	3642	cl_dim=TRIM(cl_dim)//&
	3643	& TRIM(fct_upper(td_var%t_dim(ji)%c_sname))//':'//&
	3644	& TRIM(fct_str(td_var%t_dim(ji)%i_len))//','
	3645	ENDIF
	3646	ENDDO
	3647	cl_dim=TRIM(cl_dim)//'/)'
	3648	CALL logger_debug( " variable dimension: "//TRIM(cl_dim) )
	3649
	3650	mpp__check_var_dim=.FALSE.
	3651
[5609]	3652	CALL logger_error( &
[6393]	3653	& " MPP CHECK VAR DIM: variable and file dimension differ"//&
[5609]	3654	& " for variable "//TRIM(td_var%c_name)//&
[6393]	3655	& " and file "//TRIM(td_mpp%c_name))
[5609]	3656
[6393]	3657	ELSEIF( ll_warn )THEN
	3658	CALL logger_warn( &
	3659	& " MPP CHECK VAR DIM: variable and file dimension differ"//&
	3660	& " for variable "//TRIM(td_var%c_name)//&
	3661	& " and file "//TRIM(td_mpp%c_name)//". you should use"//&
	3662	& " var_check_dim to remove useless dimension.")
	3663	ELSE
	3664
	3665	IF( td_var%i_ndim > td_mpp%i_ndim )THEN
	3666	CALL logger_info("MPP CHECK VAR DIM: variable "//&
	3667	& TRIM(td_var%c_name)//" use more dimension than file "//&
	3668	& TRIM(td_mpp%c_name)//" do until now.")
	3669	ENDIF
	3670
[4213]	3671	ENDIF
	3672
	3673	END FUNCTION mpp__check_var_dim
[5037]	3674	!-------------------------------------------------------------------
	3675	!> @brief This function return the mpp id, in a array of mpp
	3676	!> structure, given mpp base name.
	3677	!
	3678	!> @author J.Paul
[5617]	3679	!> @date November, 2013 - Initial Version
[5037]	3680	!
	3681	!> @param[in] td_file array of file structure
	3682	!> @param[in] cd_name file name
	3683	!> @return file id in array of file structure (0 if not found)
	3684	!-------------------------------------------------------------------
	3685	INTEGER(i4) FUNCTION mpp_get_index(td_mpp, cd_name)
	3686	IMPLICIT NONE
	3687	! Argument
	3688	TYPE(TMPP) , DIMENSION(:), INTENT(IN) :: td_mpp
	3689	CHARACTER(LEN=*), INTENT(IN) :: cd_name
	3690
	3691	! local variable
	3692	CHARACTER(LEN=lc) :: cl_name
	3693	INTEGER(i4) :: il_size
	3694
	3695	! loop indices
	3696	INTEGER(i4) :: ji
	3697	!----------------------------------------------------------------
	3698	mpp_get_index=0
	3699	il_size=SIZE(td_mpp(:))
	3700
	3701	cl_name=TRIM( file_rename(cd_name) )
	3702
	3703	! check if mpp is in array of mpp structure
	3704	DO ji=1,il_size
	3705	! look for file name
	3706	IF( TRIM(fct_lower(td_mpp(ji)%c_name)) == TRIM(fct_lower(cd_name)) )THEN
	3707
	3708	mpp_get_index=ji
	3709	EXIT
	3710
	3711	ENDIF
	3712	ENDDO
	3713
	3714	END FUNCTION mpp_get_index
	3715	!-------------------------------------------------------------------
	3716	!> @brief This function recombine variable splitted mpp structure.
	3717	!
	3718	!> @author J.Paul
[5617]	3719	!> @date Ocotber, 2014 - Initial Version
[5037]	3720	!
	3721	!> @param[in] td_mpp mpp file structure
	3722	!> @param[in] cd_name variable name
	3723	!> @return variable strucutre
	3724	!-------------------------------------------------------------------
	3725	TYPE(TVAR) FUNCTION mpp_recombine_var(td_mpp, cd_name)
	3726	IMPLICIT NONE
	3727	! Argument
	3728	TYPE(TMPP) , INTENT(IN) :: td_mpp
	3729	CHARACTER(LEN=*), INTENT(IN) :: cd_name
	3730
	3731	! local variable
	3732	INTEGER(i4) :: il_varid
	3733	INTEGER(i4) :: il_status
	3734	INTEGER(i4) :: il_i1p
	3735	INTEGER(i4) :: il_i2p
	3736	INTEGER(i4) :: il_j1p
	3737	INTEGER(i4) :: il_j2p
	3738	INTEGER(i4), DIMENSION(4) :: il_ind
	3739
	3740	INTEGER(i4), DIMENSION(ip_maxdim) :: il_strt
	3741	INTEGER(i4), DIMENSION(ip_maxdim) :: il_cnt
	3742
	3743	TYPE(TVAR) :: tl_tmp
	3744	TYPE(TVAR) :: tl_var
	3745
	3746	! loop indices
	3747	INTEGER(i4) :: ji
	3748	INTEGER(i4) :: jk
	3749	!----------------------------------------------------------------
	3750
	3751	il_varid=var_get_index( td_mpp%t_proc(1)%t_var(:), cd_name)
	3752	IF( il_varid /= 0 )THEN
	3753
	3754	tl_var=var_copy(td_mpp%t_proc(1)%t_var(il_varid))
	3755	! Allocate space to hold variable value in structure
	3756	IF( ASSOCIATED(tl_var%d_value) )THEN
	3757	DEALLOCATE(tl_var%d_value)
	3758	ENDIF
	3759	!
	3760	DO ji=1,ip_maxdim
	3761	IF( tl_var%t_dim(ji)%l_use )THEN
	3762	tl_var%t_dim(ji)%i_len=td_mpp%t_dim(ji)%i_len
	3763	ENDIF
	3764	ENDDO
	3765
	3766	ALLOCATE(tl_var%d_value( tl_var%t_dim(1)%i_len, &
	3767	& tl_var%t_dim(2)%i_len, &
	3768	& tl_var%t_dim(3)%i_len, &
	3769	& tl_var%t_dim(4)%i_len),&
	3770	& stat=il_status)
	3771	IF(il_status /= 0 )THEN
	3772
	3773	CALL logger_error( &
	3774	& " MPP RECOMBINE VAR: not enough space to put variable "//&
	3775	& TRIM(tl_var%c_name)//" in variable structure")
	3776
	3777	ENDIF
	3778
	3779	! FillValue by default
	3780	tl_var%d_value(:,:,:,:)=tl_var%d_fill
	3781
	3782	! read processor
	3783	DO jk=1,td_mpp%i_nproc
	3784	IF( td_mpp%t_proc(jk)%l_use )THEN
	3785	! get processor indices
	3786	il_ind(:)=mpp_get_proc_index( td_mpp, jk )
	3787	il_i1p = il_ind(1)
	3788	il_i2p = il_ind(2)
	3789	il_j1p = il_ind(3)
	3790	il_j2p = il_ind(4)
	3791
	3792	il_strt(:)=(/ 1,1,1,1 /)
	3793
	3794	il_cnt(:)=(/ il_i2p-il_i1p+1, &
	3795	& il_j2p-il_j1p+1, &
	3796	& tl_var%t_dim(3)%i_len, &
	3797	& tl_var%t_dim(4)%i_len /)
	3798
	3799	tl_tmp=iom_read_var( td_mpp%t_proc(jk), tl_var%c_name,&
	3800	& il_strt(:), il_cnt(:) )
	3801
	3802	! replace value in output variable structure
	3803	tl_var%d_value( il_i1p : il_i2p, &
	3804	& il_j1p : il_j2p, &
	3805	& :,:) = tl_tmp%d_value(:,:,:,:)
	3806
	3807	! clean
	3808	CALL var_clean(tl_tmp)
	3809
	3810	ENDIF
	3811	ENDDO
	3812
	3813	mpp_recombine_var=var_copy(tl_var)
	3814
	3815	! clean
	3816	CALL var_clean(tl_var)
	3817
	3818	ELSE
	3819
	3820	CALL logger_error( &
	3821	& " MPP RECOMBINE VAR: there is no variable with "//&
	3822	& "name or standard name"//TRIM(cd_name)//&
	3823	& " in mpp file "//TRIM(td_mpp%c_name))
	3824	ENDIF
	3825	END FUNCTION mpp_recombine_var
[6393]	3826	!-------------------------------------------------------------------
	3827	!> @brief This subroutine read subdomain indices defined with halo
	3828	!> (NEMO netcdf way)
	3829	!>
	3830	!> @author J.Paul
	3831	!> @date January, 2016 - Initial Version
	3832	!>
	3833	!> @param[inout] td_file mpp structure
	3834	!-------------------------------------------------------------------
	3835	SUBROUTINE mpp__read_halo(td_file, td_dimglo)
	3836	IMPLICIT NONE
	3837	! Argument
	3838	TYPE(TFILE) , INTENT(INOUT) :: td_file
	3839	TYPE(TDIM) , DIMENSION(:), INTENT(IN ) :: td_dimglo
	3840
	3841	! local variable
	3842	INTEGER(i4) :: il_attid
	3843	INTEGER(i4) :: il_ifirst
	3844	INTEGER(i4) :: il_jfirst
	3845	INTEGER(i4) :: il_ilast
	3846	INTEGER(i4) :: il_jlast
	3847	INTEGER(i4) :: il_ihalostart
	3848	INTEGER(i4) :: il_jhalostart
	3849	INTEGER(i4) :: il_ihaloend
	3850	INTEGER(i4) :: il_jhaloend
	3851
	3852	CHARACTER(LEN=lc) :: cl_dom
	3853	!----------------------------------------------------------------
	3854
	3855	! DOMAIN_position_first
	3856	il_attid = 0
	3857	IF( ASSOCIATED(td_file%t_att) )THEN
	3858	il_attid=att_get_id( td_file%t_att, "DOMAIN_position_first" )
	3859	ENDIF
	3860	IF( il_attid /= 0 )THEN
	3861	il_ifirst = INT(td_file%t_att(il_attid)%d_value(1))
	3862	il_jfirst = INT(td_file%t_att(il_attid)%d_value(2))
	3863	ELSE
	3864	il_ifirst = 1
	3865	il_jfirst = 1
	3866	ENDIF
	3867
	3868	! DOMAIN_position_last
	3869	il_attid = 0
	3870	IF( ASSOCIATED(td_file%t_att) )THEN
	3871	il_attid=att_get_id( td_file%t_att, "DOMAIN_position_last" )
	3872	ENDIF
	3873	IF( il_attid /= 0 )THEN
	3874	il_ilast = INT(td_file%t_att(il_attid)%d_value(1))
	3875	il_jlast = INT(td_file%t_att(il_attid)%d_value(2))
	3876	ELSE
	3877	il_ilast = td_file%t_dim(1)%i_len
	3878	il_jlast = td_file%t_dim(2)%i_len
	3879	ENDIF
	3880
	3881	! DOMAIN_halo_size_start
	3882	il_attid = 0
	3883	IF( ASSOCIATED(td_file%t_att) )THEN
	3884	il_attid=att_get_id( td_file%t_att, "DOMAIN_halo_size_start" )
	3885	ENDIF
	3886	IF( il_attid /= 0 )THEN
	3887	il_ihalostart = INT(td_file%t_att(il_attid)%d_value(1))
	3888	il_jhalostart = INT(td_file%t_att(il_attid)%d_value(2))
	3889	ELSE
	3890	il_ihalostart = 0
	3891	il_jhalostart = 0
	3892	ENDIF
	3893
	3894	! DOMAIN_halo_size_end
	3895	il_attid = 0
	3896	IF( ASSOCIATED(td_file%t_att) )THEN
	3897	il_attid=att_get_id( td_file%t_att, "DOMAIN_halo_size_end" )
	3898	ENDIF
	3899	IF( il_attid /= 0 )THEN
	3900	il_ihaloend = INT(td_file%t_att(il_attid)%d_value(1))
	3901	il_jhaloend = INT(td_file%t_att(il_attid)%d_value(2))
	3902	ELSE
	3903	il_ihaloend = 0
	3904	il_jhaloend = 0
	3905	ENDIF
	3906
	3907	IF( (td_dimglo(jp_I)%i_len == td_file%t_dim(jp_I)%i_len) .AND. &
	3908	& (td_dimglo(jp_J)%i_len == td_file%t_dim(jp_J)%i_len) )THEN
	3909	cl_dom='full'
	3910	ELSEIF( il_ihalostart == 0 .AND. il_jhalostart == 0 .AND. &
	3911	& il_ihaloend == 0 .AND. il_jhaloend == 0 )THEN
	3912	cl_dom='nooverlap'
	3913	ELSE
	3914	cl_dom='noextra'
	3915	ENDIF
	3916
	3917	SELECT CASE(TRIM(cl_dom))
	3918	CASE('full')
	3919	td_file%i_impp = il_ifirst
	3920	td_file%i_jmpp = il_jfirst
	3921	td_file%i_lci = td_file%t_dim(jp_I)%i_len
	3922	td_file%i_lcj = td_file%t_dim(jp_J)%i_len
	3923	td_file%i_ldi = il_ihalostart + 1
	3924	td_file%i_ldj = il_jhalostart + 1
	3925	td_file%i_lei = td_file%t_dim(jp_I)%i_len - il_ihaloend
	3926	td_file%i_lej = td_file%t_dim(jp_J)%i_len - il_jhaloend
	3927	CASE('noextra')
	3928	td_file%i_impp = il_ifirst
	3929	td_file%i_jmpp = il_jfirst
	3930	td_file%i_lci = td_file%t_dim(jp_I)%i_len
	3931	td_file%i_lcj = td_file%t_dim(jp_J)%i_len
	3932	td_file%i_ldi = il_ihalostart + 1
	3933	td_file%i_ldj = il_jhalostart + 1
	3934	td_file%i_lei = td_file%i_lci - il_ihaloend
	3935	td_file%i_lej = td_file%i_lcj - il_jhaloend
	3936	CASE('nooverlap') !!!?????
	3937	td_file%i_impp = il_ifirst
	3938	td_file%i_jmpp = il_jfirst
	3939	td_file%i_lci = td_file%t_dim(jp_I)%i_len
	3940	td_file%i_lcj = td_file%t_dim(jp_J)%i_len
	3941	td_file%i_ldi = 1
	3942	td_file%i_ldj = 1
	3943	td_file%i_lei = td_file%t_dim(jp_I)%i_len
	3944	td_file%i_lej = td_file%t_dim(jp_J)%i_len
	3945	END SELECT
	3946
	3947	END SUBROUTINE mpp__read_halo
	3948	!-------------------------------------------------------------------
	3949	!> @brief This subroutine compute subdomain indices defined with halo
	3950	!> (NEMO netcdf way)
	3951	!>
	3952	!> @author J.Paul
	3953	!> @date January, 2016 - Initial Version
	3954	!>
	3955	!> @param[inout] td_mpp mpp structure
	3956	!-------------------------------------------------------------------
	3957	SUBROUTINE mpp__compute_halo(td_mpp)
	3958	IMPLICIT NONE
	3959	! Argument
	3960	TYPE(TMPP) , INTENT(INOUT) :: td_mpp
	3961
	3962	! local variable
	3963	INTEGER(i4), DIMENSION(:), ALLOCATABLE :: il_ifirst
	3964	INTEGER(i4), DIMENSION(:), ALLOCATABLE :: il_jfirst
	3965	INTEGER(i4), DIMENSION(:), ALLOCATABLE :: il_ilast
	3966	INTEGER(i4), DIMENSION(:), ALLOCATABLE :: il_jlast
	3967	INTEGER(i4), DIMENSION(:), ALLOCATABLE :: il_ihalostart
	3968	INTEGER(i4), DIMENSION(:), ALLOCATABLE :: il_jhalostart
	3969	INTEGER(i4), DIMENSION(:), ALLOCATABLE :: il_ihaloend
	3970	INTEGER(i4), DIMENSION(:), ALLOCATABLE :: il_jhaloend
	3971
	3972	TYPE(TATT) :: tl_att
	3973
	3974	! loop indices
	3975	INTEGER(i4) :: ji
	3976	!----------------------------------------------------------------
	3977
	3978	ALLOCATE( il_ifirst (td_mpp%i_nproc) )
	3979	ALLOCATE( il_jfirst (td_mpp%i_nproc) )
	3980
	3981	ALLOCATE( il_ilast (td_mpp%i_nproc) )
	3982	ALLOCATE( il_jlast (td_mpp%i_nproc) )
	3983
	3984	ALLOCATE( il_ihalostart(td_mpp%i_nproc) )
	3985	ALLOCATE( il_jhalostart(td_mpp%i_nproc) )
	3986
	3987	ALLOCATE( il_ihaloend (td_mpp%i_nproc) )
	3988	ALLOCATE( il_jhaloend (td_mpp%i_nproc) )
	3989
	3990	SELECT CASE(TRIM(td_mpp%c_dom))
	3991	CASE('full')
	3992
	3993	il_ifirst(:)=td_mpp%t_proc(:)%i_impp
	3994	il_jfirst(:)=td_mpp%t_proc(:)%i_jmpp
	3995
	3996	il_ilast(:)=td_mpp%t_proc(:)%i_impp + td_mpp%t_proc(:)%t_dim(jp_I)%i_len - 1
	3997	il_jlast(:)=td_mpp%t_proc(:)%i_jmpp + td_mpp%t_proc(:)%t_dim(jp_J)%i_len - 1
	3998
	3999	il_ihalostart(:)=td_mpp%t_proc(:)%i_ldi-1
	4000	il_jhalostart(:)=td_mpp%t_proc(:)%i_ldj-1
	4001
	4002	il_ihaloend(:)=td_mpp%t_proc(:)%t_dim(jp_I)%i_len - td_mpp%t_proc(:)%i_lei
	4003	il_jhaloend(:)=td_mpp%t_proc(:)%t_dim(jp_J)%i_len - td_mpp%t_proc(:)%i_lej
	4004
	4005	CASE('noextra')
	4006
	4007	il_ifirst(:)=td_mpp%t_proc(:)%i_impp
	4008	il_jfirst(:)=td_mpp%t_proc(:)%i_jmpp
	4009
	4010	il_ilast(:) =td_mpp%t_proc(:)%i_impp + td_mpp%t_proc(:)%i_lci - 1
	4011	il_jlast(:) =td_mpp%t_proc(:)%i_jmpp + td_mpp%t_proc(:)%i_lcj - 1
	4012
	4013	il_ihalostart(:)=td_mpp%t_proc(:)%i_ldi-1
	4014	il_jhalostart(:)=td_mpp%t_proc(:)%i_ldj-1
	4015
	4016	il_ihaloend(:)=td_mpp%t_proc(:)%i_lci - td_mpp%t_proc(:)%i_lei
	4017	il_jhaloend(:)=td_mpp%t_proc(:)%i_lcj - td_mpp%t_proc(:)%i_lej
	4018
	4019	CASE('nooverlap')
	4020
	4021	il_ifirst(:)=td_mpp%t_proc(:)%i_impp + td_mpp%t_proc(:)%i_ldi - 1
	4022	il_jfirst(:)=td_mpp%t_proc(:)%i_jmpp + td_mpp%t_proc(:)%i_ldj - 1
	4023
	4024	il_ilast(:)=td_mpp%t_proc(:)%i_impp + td_mpp%t_proc(:)%i_lei - 1
	4025	il_jlast(:)=td_mpp%t_proc(:)%i_jmpp + td_mpp%t_proc(:)%i_lej - 1
	4026
	4027	il_ihalostart(:)=0
	4028	il_jhalostart(:)=0
	4029
	4030	il_ihaloend(:)=0
	4031	il_jhaloend(:)=0
	4032
	4033	CASE DEFAULT
	4034	CALL logger_fatal("MPP INIT: invalid "//&
	4035	& "decomposition type.")
	4036	END SELECT
	4037
	4038	DO ji=1,td_mpp%i_nproc
	4039	tl_att=att_init( "DOMAIN_position_first", &
	4040	& (/ il_ifirst(ji), il_jfirst(ji) /) )
	4041	CALL file_move_att(td_mpp%t_proc(ji), tl_att)
	4042
	4043	tl_att=att_init( "DOMAIN_position_last", &
	4044	& (/ il_ilast(ji), il_jlast(ji) /) )
	4045	CALL file_move_att(td_mpp%t_proc(ji), tl_att)
	4046
	4047	tl_att=att_init( "DOMAIN_halo_size_start", &
	4048	& (/ il_ihalostart(ji), il_jhalostart(ji) /) )
	4049	CALL file_move_att( td_mpp%t_proc(ji), tl_att)
	4050
	4051	tl_att=att_init( "DOMAIN_halo_size_end", &
	4052	& (/ il_ihaloend(ji), il_jhaloend(ji) /) )
	4053	CALL file_move_att( td_mpp%t_proc(ji), tl_att)
	4054	ENDDO
	4055
	4056	DEALLOCATE( il_ifirst )
	4057	DEALLOCATE( il_jfirst )
	4058
	4059	DEALLOCATE( il_ilast )
	4060	DEALLOCATE( il_jlast )
	4061
	4062	DEALLOCATE( il_ihalostart)
	4063	DEALLOCATE( il_jhalostart)
	4064
	4065	DEALLOCATE( il_ihaloend )
	4066	DEALLOCATE( il_jhaloend )
	4067
	4068	!impp
	4069	tl_att=att_init( "SUBDOMAIN_I_left_bottom_indices", td_mpp%t_proc(:)%i_impp)
	4070	CALL mpp_move_att(td_mpp, tl_att)
	4071
	4072	tl_att=att_init( "SUBDOMAIN_J_left_bottom_indices", td_mpp%t_proc(:)%i_jmpp)
	4073	CALL mpp_move_att(td_mpp, tl_att)
	4074
	4075	! lci
	4076	tl_att=att_init( "SUBDOMAIN_I_dimensions", td_mpp%t_proc(:)%i_lci)
	4077	CALL mpp_move_att(td_mpp, tl_att)
	4078
	4079	tl_att=att_init( "SUBDOMAIN_J_dimensions", td_mpp%t_proc(:)%i_lcj)
	4080	CALL mpp_move_att(td_mpp, tl_att)
	4081
	4082	! ldi
	4083	tl_att=att_init( "SUBDOMAIN_I_first_indoor_indices", td_mpp%t_proc(:)%i_ldi)
	4084	CALL mpp_move_att(td_mpp, tl_att)
	4085
	4086	tl_att=att_init( "SUBDOMAIN_J_first_indoor_indices", td_mpp%t_proc(:)%i_ldj)
	4087	CALL mpp_move_att(td_mpp, tl_att)
	4088
	4089	! lei
	4090	tl_att=att_init( "SUBDOMAIN_I_last_indoor_indices", td_mpp%t_proc(:)%i_lei)
	4091	CALL mpp_move_att(td_mpp, tl_att)
	4092
	4093	tl_att=att_init( "SUBDOMAIN_J_last_indoor_indices", td_mpp%t_proc(:)%i_lej)
	4094	CALL mpp_move_att(td_mpp, tl_att)
	4095
	4096	! clean
	4097	CALL att_clean(tl_att)
	4098
	4099	END SUBROUTINE mpp__compute_halo
[4213]	4100	END MODULE mpp
	4101

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

Download in other formats: