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.

domain.f90 in branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/TOOLS/SIREN/src – NEMO

Context Navigation

source: branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/TOOLS/SIREN/src/domain.f90 @ 10248

Last change on this file since 10248 was 10248, checked in by kingr, 5 years ago
Merged 2015/nemo_v3_6_STABLE@6232
File size: 65.0 KB

Rev	Line
[4213]	1	!----------------------------------------------------------------------
	2	! NEMO system team, System and Interface for oceanic RElocable Nesting
	3	!----------------------------------------------------------------------
	4	!
	5	! MODULE: dom
	6	!
	7	! DESCRIPTION:
	8	!> @brief
	9	!> This module manage domain computation.
[5037]	10	!>
[4213]	11	!> @details
[5037]	12	!> define type TDOM:<br/>
	13	!> @code
	14	!> TYPE(TDOM) :: tl_dom
	15	!> @endcode
[4213]	16	!>
[5037]	17	!> to initialize domain structure:<br/>
	18	!> @code
	19	!> tl_dom=dom_init(td_mpp, [id_imin,] [id_imax,] [id_jmin,] [id_jmax],[cd_card])
	20	!> @endcode
	21	!> - td_mpp is mpp structure of an opened file.
	22	!> - id_imin is i-direction sub-domain lower left point indice
	23	!> - id_imax is i-direction sub-domain upper right point indice
	24	!> - id_jmin is j-direction sub-domain lower left point indice
	25	!> - id_jmax is j-direction sub-domain upper right point indice
	26	!> - cd_card is the cardinal name (for boundary case)
	27	!>
	28	!> to get global domain dimension:<br/>
	29	!> - tl_dom\%t_dim0
[4213]	30	!>
[5037]	31	!> to get NEMO periodicity index of global domain:<br/>
	32	!> - tl_dom\%i_perio0
[4213]	33	!>
[5037]	34	!> to get NEMO pivot point index F(0),T(1):<br/>
	35	!> - tl_dom\%i_pivot
[4213]	36	!>
[5037]	37	!> to get East-West overlap of global domain:<br/>
	38	!> - tl_dom\%i_ew0
[4213]	39	!>
[5037]	40	!> to get selected sub domain dimension:<br/>
	41	!> - tl_dom\%t_dim
	42	!>
	43	!> to get NEMO periodicity index of sub domain:<br/>
	44	!> - tl_dom\%i_perio
	45	!>
	46	!> to get East-West overlap of sub domain:<br/>
	47	!> - tl_dom\%i_ew
	48	!>
	49	!> to get i-direction sub-domain lower left point indice:<br/>
	50	!> - tl_dom\%i_imin
	51	!>
	52	!> to get i-direction sub-domain upper right point indice:<br/>
	53	!> - tl_dom\%i_imax
	54	!>
	55	!> to get j-direction sub-domain lower left point indice:<br/>
	56	!> - tl_dom\%i_jmin
	57	!>
	58	!> to get j-direction sub-domain upper right point indice:<br/>
	59	!> - tl_dom\%i_jmax
	60	!>
	61	!> to get size of i-direction extra band:<br/>
	62	!> - tl_dom\%i_iextra
	63	!>
	64	!> to get size of j-direction extra band:<br/>
	65	!> - tl_dom\%i_jextra
	66	!>
	67	!> to get i-direction ghost cell number:<br/>
	68	!> - tl_dom\%i_ighost
	69	!>
	70	!> to get j-direction ghost cell number:<br/>
	71	!> - tl_dom\%i_jghost
	72	!>
	73	!> to get boundary index:<br/>
	74	!> - tl_dom\%i_bdy
	75	!> - 0 = no boundary
	76	!> - 1 = north
	77	!> - 2 = south
	78	!> - 3 = east
	79	!> - 4 = west
	80	!>
	81	!> to clean domain structure:<br/>
	82	!> @code
	83	!> CALL dom_clean(td_dom)
	84	!> @endcode
	85	!> - td_dom is domain structure
	86	!>
	87	!> to print information about domain structure:<br/>
	88	!> @code
	89	!> CALL dom_print(td_dom)
	90	!> @endcode
	91	!>
	92	!> to get East-West overlap (if any):<br/>
	93	!> @code
	94	!> il_ew=dom_get_ew_overlap(td_lon)
	95	!> @endcode
	96	!> - td_lon : longitude variable structure
	97	!>
	98	!> to add extra bands to coarse grid domain (for interpolation):<br/>
	99	!> @code
	100	!> CALL dom_add_extra( td_dom, id_iext, id_jext )
	101	!> @endcode
	102	!> - td_dom is domain structure
	103	!> - id_iext is i-direction size of extra bands
	104	!> - id_jext is j-direction size of extra bands
	105	!>
	106	!> to remove extra bands from fine grid (after interpolation):<br/>
	107	!> @code
	108	!> CALL dom_del_extra( td_var, td_dom, id_rho )
	109	!> @endcode
	110	!> - td_var is variable structure to be changed
	111	!> - td_dom is domain structure
	112	!> - id_rho is a array of refinement factor following i- and j-direction
	113	!>
	114	!> to reset coarse grid domain witouht extra bands:<br/>
	115	!> @code
	116	!> CALL dom_clean_extra( td_dom )
	117	!> @endcode
	118	!>
[4213]	119	!> @author
	120	!> J.Paul
	121	! REVISION HISTORY:
[5037]	122	!> @date November, 2013 - Initial Version
	123	!> @date September, 2014
	124	!> - add header
	125	!> - use zero indice to defined cyclic or global domain
	126	!> @date October, 2014
	127	!> - use mpp file structure instead of file
[4213]	128	!>
	129	!> @note Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
	130	!----------------------------------------------------------------------
	131	MODULE dom
	132	USE kind ! F90 kind parameter
	133	USE global ! global parameter
	134	USE fct ! basic useful function
[5037]	135	USE logger ! log file manager
[4213]	136	USE dim ! dimension manager
	137	USE var ! variable manager
[5037]	138	USE mpp ! mpp file manager
[4213]	139	IMPLICIT NONE
	140	! NOTE_avoid_public_variables_if_possible
	141
	142	! type and variable
	143	PUBLIC :: TDOM !< domain structure
	144
[5037]	145	PRIVATE :: im_minext !< default minumum number of extraband
	146
[4213]	147	! function and subroutine
[5037]	148	PUBLIC :: dom_copy !< copy domain structure
	149	PUBLIc :: dom_clean !< clean domain structure
	150	PUBLIC :: dom_init !< initialise domain structure
	151	PUBLIC :: dom_print !< print information about domain
	152	PUBLIC :: dom_add_extra !< add useful extra bands to coarse grid for interpolation
	153	PUBLIC :: dom_clean_extra !< reset domain without extra bands
	154	PUBLIC :: dom_del_extra !< remove extra point from fine grid after interpolation
[4213]	155
[5037]	156	PRIVATE :: dom__init_mpp ! initialise domain structure, given mpp file structure
	157	PRIVATE :: dom__define ! define sub domain indices
	158	! define sub domain indices for input domain with
	159	PRIVATE :: dom__define_cyclic_north_fold ! - cyclic east-west boundary and north fold boundary condition.
	160	PRIVATE :: dom__define_north_fold ! - north fold boundary condition.
	161	PRIVATE :: dom__define_symmetric ! - symmetric boundary condition across the equator.
	162	PRIVATE :: dom__define_cyclic ! - cyclic east-west boundary.
	163	PRIVATE :: dom__define_closed ! - cyclic east-west boundary.
	164	! compute size of sub domain
	165	PRIVATE :: dom__size_no_pole ! - without north fold condition
	166	PRIVATE :: dom__size_no_pole_overlap ! - without north fold condition, and which overlap east-west boundary
	167	PRIVATE :: dom__size_no_pole_no_overlap ! - without north fold condition, and which do not overlap east-west boundary
	168	PRIVATE :: dom__size_pole ! - with north fold condition
	169	PRIVATE :: dom__size_pole_overlap ! - with north fold condition, and which overlap east-west boundary
	170	PRIVATE :: dom__size_pole_no_overlap ! - with north fold condition, and which do not overlap east-west boundary
	171	! compute size of
	172	PRIVATE :: dom__size_global ! - global domain
	173	PRIVATE :: dom__size_semi_global ! - semi global domain
	174	PRIVATE :: dom__copy_unit ! copy attribute structure
[4213]	175
[5037]	176	TYPE TDOM !< domain structure
	177	TYPE(TDIM), DIMENSION(ip_maxdim) :: t_dim0 !< global domain dimension
	178	TYPE(TDIM), DIMENSION(ip_maxdim) :: t_dim !< sub domain dimension
	179	INTEGER(i4) :: i_perio0 !< NEMO periodicity index of global domain
	180	INTEGER(i4) :: i_ew0 !< East-West overlap of global domain
	181	INTEGER(i4) :: i_perio !< NEMO periodicity index of sub domain
	182	INTEGER(i4) :: i_pivot !< NEMO pivot point index F(0),T(1)
	183	INTEGER(i4) :: i_imin = 0 !< i-direction sub-domain lower left point indice
	184	INTEGER(i4) :: i_imax = 0 !< i-direction sub-domain upper right point indice
	185	INTEGER(i4) :: i_jmin = 0 !< j-direction sub-domain lower left point indice
	186	INTEGER(i4) :: i_jmax = 0 !< j-direction sub-domain upper right point indice
[4213]	187
[5037]	188	INTEGER(i4) :: i_bdy = 0 !< boundary index : 0 = no boundary
	189	!< 1 = north
	190	!< 2 = south
	191	!< 3 = east
	192	!< 4 = west
	193	INTEGER(i4), DIMENSION(2,2) :: i_ghost0 = 0 !< array of ghost cell factor of global domain
	194	INTEGER(i4), DIMENSION(2,2) :: i_ghost = 0 !< array of ghost cell factor of sub domain
[4213]	195
[5037]	196	INTEGER(i4), DIMENSION(2) :: i_iextra = 0 !< i-direction extra point
	197	INTEGER(i4), DIMENSION(2) :: i_jextra = 0 !< j-direction extra point
[4213]	198
	199	END TYPE TDOM
	200
	201	INTEGER(i4), PARAMETER :: im_minext = 2 !< default minumum number of extraband
	202
	203	INTERFACE dom_init
[5037]	204	MODULE PROCEDURE dom__init_file
	205	MODULE PROCEDURE dom__init_mpp
[4213]	206	END INTERFACE dom_init
	207
[5037]	208	INTERFACE dom_copy
	209	MODULE PROCEDURE dom__copy_unit ! copy attribute structure
	210	END INTERFACE
	211
[4213]	212	CONTAINS
	213	!-------------------------------------------------------------------
[5037]	214	!> @brief
	215	!> This subroutine copy an domain structure in another one
	216	!> @details
	217	!> dummy function to get the same use for all structure
	218	!>
	219	!> @warning do not use on the output of a function who create or read an
	220	!> structure (ex: tl_dom=dom_copy(dom_init()) is forbidden).
	221	!> This will create memory leaks.
	222	!> @warning to avoid infinite loop, do not use any function inside
	223	!> this subroutine
	224	!>
	225	!> @author J.Paul
	226	!> @date November, 2014 - Initial Version
	227	!>
	228	!> @param[in] td_dom domain structure
	229	!> @return copy of input domain structure
	230	!-------------------------------------------------------------------
	231	FUNCTION dom__copy_unit( td_dom )
	232	IMPLICIT NONE
	233	! Argument
	234	TYPE(TDOM), INTENT(IN) :: td_dom
	235	! function
	236	TYPE(TDOM) :: dom__copy_unit
	237
	238	! local variable
	239	!----------------------------------------------------------------
	240
	241	dom__copy_unit=td_dom
	242
	243	END FUNCTION dom__copy_unit
	244	!-------------------------------------------------------------------
[4213]	245	!> @brief This subroutine print some information about domain strucutre.
	246	!
	247	!> @author J.Paul
[10248]	248	!> @date November, 2013 - Initial Version
[4213]	249	!
[5037]	250	!> @param[inout] td_dom dom structure
[4213]	251	!-------------------------------------------------------------------
	252	SUBROUTINE dom_print(td_dom)
	253	IMPLICIT NONE
	254	! Argument
	255	TYPE(TDOM), INTENT(IN) :: td_dom
	256
	257	! local argument
	258	CHARACTER(LEN=lc) :: cl_pivot
	259	!----------------------------------------------------------------
	260	SELECT CASE(td_dom%i_pivot)
	261	CASE(0)
	262	cl_pivot='F-point'
	263	CASE(1)
	264	cl_pivot='T-point'
	265	CASE DEFAULT
	266	cl_pivot='unknown'
	267	END SELECT
	268
[5037]	269	WRITE(*,'((a,4(i0,1x)),(/a,i2,a,a),2(/a,2(i0,1x)),(/a,4(i0,1x)),(/a,i2/),&
	270	& 4(/a,i0),4(/a,2(i0,1x)))') &
[4213]	271	& " global domain size ",td_dom%t_dim0(:)%i_len, &
	272	& " domain periodicity ",td_dom%i_perio0,", pivot: ",TRIM(cl_pivot), &
[5037]	273	& " i-direction ghost cell factor of global domain ",td_dom%i_ghost0(jp_I,:), &
	274	& " j-direction ghost cell factor of global domain ",td_dom%i_ghost0(jp_J,:), &
[4213]	275	& " sub-domain size : ",td_dom%t_dim(:)%i_len, &
	276	& " sub domain periodicity ",td_dom%i_perio, &
	277	& " i-direction sub-domain lower left point indice ",td_dom%i_imin, &
	278	& " i-direction sub-domain upper right point indice ",td_dom%i_imax, &
	279	& " j-direction sub-domain lower left point indice ",td_dom%i_jmin, &
	280	& " j-direction sub-domain upper right point indice ",td_dom%i_jmax, &
[5037]	281	& " i-direction ghost cell factor ",td_dom%i_ghost(jp_I,:), &
	282	& " j-direction ghost cell factor ",td_dom%i_ghost(jp_J,:), &
	283	& " i-direction extra point for interpolation ",td_dom%i_iextra(:), &
	284	& " j-direction extra point for interpolation ",td_dom%i_jextra(:)
[4213]	285
	286	END SUBROUTINE dom_print
	287	!-------------------------------------------------------------------
	288	!> @brief
	289	!> This function intialise domain structure, given open file structure,
[5037]	290	!> and sub domain indices.
	291	!> @details
	292	!> sub domain indices are computed, taking into account coarse grid
	293	!> periodicity, pivot point, and East-West overlap.
[4213]	294	!
	295	!> @author J.Paul
[10248]	296	!> @date June, 2013 - Initial Version
[5037]	297	!> @date September, 2014
	298	!> - add boundary index
	299	!> - add ghost cell factor
	300	!> @date October, 2014
	301	!> - work on mpp file structure instead of file structure
	302	!>
	303	!> @param[in] td_mpp mpp structure
	304	!> @param[in] id_perio grid periodicity
	305	!> @param[in] id_imin i-direction sub-domain lower left point indice
	306	!> @param[in] id_imax i-direction sub-domain upper right point indice
	307	!> @param[in] id_jmin j-direction sub-domain lower left point indice
	308	!> @param[in] id_jmax j-direction sub-domain upper right point indice
	309	!> @param[in] cd_card name of cardinal (for boundary)
[4213]	310	!> @return domain structure
	311	!-------------------------------------------------------------------
[5037]	312	TYPE(TDOM) FUNCTION dom__init_mpp( td_mpp, &
	313	& id_imin, id_imax, id_jmin, id_jmax, &
	314	& cd_card )
[4213]	315	IMPLICIT NONE
	316	! Argument
[5037]	317	TYPE(TMPP) , INTENT(IN) :: td_mpp
[4213]	318
[5037]	319	INTEGER(i4) , INTENT(IN), OPTIONAL :: id_imin
	320	INTEGER(i4) , INTENT(IN), OPTIONAL :: id_imax
	321	INTEGER(i4) , INTENT(IN), OPTIONAL :: id_jmin
	322	INTEGER(i4) , INTENT(IN), OPTIONAL :: id_jmax
	323
	324	CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_card
[4213]	325	!local variable
	326	!----------------------------------------------------------------
	327
	328	! clean domain structure
[5037]	329	CALL dom_clean(dom__init_mpp)
[4213]	330
[5037]	331	IF( .NOT. ASSOCIATED(td_mpp%t_proc) )THEN
[4213]	332
	333	CALL logger_error( &
[5037]	334	& " DOM INIT: no processor file associated to mpp "//&
	335	& TRIM(td_mpp%c_name))
[4213]	336
	337	ELSE
	338	! global domain define by file
	339
[5037]	340	! look for boundary index
	341	IF( PRESENT(cd_card) )THEN
	342	SELECT CASE(TRIM(cd_card))
	343	CASE('north')
	344	dom__init_mpp%i_bdy=jp_north
	345	CASE('south')
	346	dom__init_mpp%i_bdy=jp_south
	347	CASE('east')
	348	dom__init_mpp%i_bdy=jp_east
	349	CASE('west')
	350	dom__init_mpp%i_bdy=jp_west
	351	CASE DEFAULT
	352	! no boundary
	353	dom__init_mpp%i_bdy=0
	354	END SELECT
	355	ELSE
	356	! no boundary
	357	dom__init_mpp%i_bdy=0
	358	ENDIF
[4213]	359
[5037]	360	! use global dimension define by mpp file
	361	dom__init_mpp%t_dim0(:) = dim_copy(td_mpp%t_dim(:))
	362
	363	IF( td_mpp%i_perio < 0 .OR. td_mpp%i_perio > 6 )THEN
[10248]	364	CALL logger_error("DOM INIT: invalid grid periodicity ("//&
	365	& TRIM(fct_str(td_mpp%i_perio))//&
	366	& ") you should use grid_get_perio to compute it")
[4213]	367	ELSE
[5037]	368	dom__init_mpp%i_perio0=td_mpp%i_perio
[4213]	369	ENDIF
	370
	371	! global domain pivot point
[5037]	372	SELECT CASE(dom__init_mpp%i_perio0)
[4213]	373	CASE(3,4)
[5037]	374	dom__init_mpp%i_pivot = 0
[4213]	375	CASE(5,6)
[5037]	376	dom__init_mpp%i_pivot = 1
[4213]	377	CASE DEFAULT
[5037]	378	dom__init_mpp%i_pivot = 0
[4213]	379	END SELECT
	380
[5037]	381	! add ghost cell factor of global domain
	382	dom__init_mpp%i_ghost0(:,:)=0
	383	SELECT CASE(dom__init_mpp%i_perio0)
	384	CASE(0)
	385	dom__init_mpp%i_ghost0(:,:)=1
	386	CASE(1)
	387	dom__init_mpp%i_ghost0(jp_J,:)=1
	388	CASE(2)
	389	dom__init_mpp%i_ghost0(jp_I,:)=1
	390	dom__init_mpp%i_ghost0(jp_J,2)=1
	391	CASE(3,5)
	392	dom__init_mpp%i_ghost0(jp_I,:)=1
	393	dom__init_mpp%i_ghost0(jp_J,1)=1
	394	CASE(4,6)
	395	dom__init_mpp%i_ghost0(jp_J,1)=1
	396	END SELECT
	397
[4213]	398	! look for EW overlap
[5037]	399	dom__init_mpp%i_ew0=td_mpp%i_ew
[4213]	400
	401	! initialise domain as global
[5037]	402	dom__init_mpp%i_imin = 1
	403	dom__init_mpp%i_imax = dom__init_mpp%t_dim0(1)%i_len
[4213]	404
[5037]	405	dom__init_mpp%i_jmin = 1
	406	dom__init_mpp%i_jmax = dom__init_mpp%t_dim0(2)%i_len
[4213]	407
[5037]	408	! sub domain dimension
	409	dom__init_mpp%t_dim(:) = dim_copy(td_mpp%t_dim(:))
[4213]	410
[5037]	411	! define sub domain indices
	412	CALL dom__define( dom__init_mpp, &
	413	& id_imin, id_imax, id_jmin, id_jmax )
[4213]	414
	415	ENDIF
	416
[5037]	417	END FUNCTION dom__init_mpp
	418	!-------------------------------------------------------------------
	419	!> @brief
	420	!> This function intialise domain structure, given open file structure,
	421	!> and sub domain indices.
	422	!> @details
	423	!> sub domain indices are computed, taking into account coarse grid
	424	!> periodicity, pivot point, and East-West overlap.
	425	!
	426	!> @author J.Paul
[10248]	427	!> @date June, 2013 - Initial Version
[5037]	428	!> @date September, 2014
	429	!> - add boundary index
	430	!> - add ghost cell factor
	431	!>
	432	!> @param[in] td_file file structure
	433	!> @param[in] id_perio grid periodicity
	434	!> @param[in] id_imin i-direction sub-domain lower left point indice
	435	!> @param[in] id_imax i-direction sub-domain upper right point indice
	436	!> @param[in] id_jmin j-direction sub-domain lower left point indice
	437	!> @param[in] id_jmax j-direction sub-domain upper right point indice
	438	!> @param[in] cd_card name of cardinal (for boundary)
	439	!> @return domain structure
	440	!-------------------------------------------------------------------
	441	TYPE(TDOM) FUNCTION dom__init_file( td_file, &
	442	& id_imin, id_imax, id_jmin, id_jmax, &
	443	& cd_card )
	444	IMPLICIT NONE
	445	! Argument
	446	TYPE(TFILE) , INTENT(IN) :: td_file
[4213]	447
[5037]	448	INTEGER(i4) , INTENT(IN), OPTIONAL :: id_imin
	449	INTEGER(i4) , INTENT(IN), OPTIONAL :: id_imax
	450	INTEGER(i4) , INTENT(IN), OPTIONAL :: id_jmin
	451	INTEGER(i4) , INTENT(IN), OPTIONAL :: id_jmax
[4213]	452
[5037]	453	CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_card
	454	!local variable
	455	!----------------------------------------------------------------
[4213]	456
[5037]	457	! clean domain structure
	458	CALL dom_clean(dom__init_file)
[4213]	459
[5037]	460	IF( td_file%i_id == 0 )THEN
[4213]	461
[5037]	462	CALL logger_error( &
	463	& " DOM INIT: no id associated to file "//TRIM(td_file%c_name))
[4213]	464
[5037]	465	ELSE
	466	! global domain define by file
[4213]	467
[5037]	468	! look for boundary index
	469	IF( PRESENT(cd_card) )THEN
	470	SELECT CASE(TRIM(cd_card))
	471	CASE('north')
	472	dom__init_file%i_bdy=jp_north
	473	CASE('south')
	474	dom__init_file%i_bdy=jp_south
	475	CASE('east')
	476	dom__init_file%i_bdy=jp_east
	477	CASE('west')
	478	dom__init_file%i_bdy=jp_west
	479	CASE DEFAULT
	480	! no boundary
	481	dom__init_file%i_bdy=0
	482	END SELECT
	483	ELSE
	484	! no boundary
	485	dom__init_file%i_bdy=0
	486	ENDIF
[4213]	487
[5037]	488	! use global dimension define by file
	489	dom__init_file%t_dim0(:) = dim_copy(td_file%t_dim(:))
[4213]	490
[5037]	491	IF( td_file%i_perio < 0 .OR. td_file%i_perio > 6 )THEN
[10248]	492	CALL logger_error("DOM INIT: invalid grid periodicity ("//&
	493	& TRIM(fct_str(td_file%i_perio))//&
	494	& ") you should use grid_get_perio to compute it")
[5037]	495	ELSE
	496	dom__init_file%i_perio0=td_file%i_perio
	497	ENDIF
[4213]	498
[5037]	499	! global domain pivot point
	500	SELECT CASE(dom__init_file%i_perio0)
	501	CASE(3,4)
	502	dom__init_file%i_pivot = 0
	503	CASE(5,6)
	504	dom__init_file%i_pivot = 1
	505	CASE DEFAULT
	506	dom__init_file%i_pivot = 0
	507	END SELECT
[4213]	508
[5037]	509	! add ghost cell factor of global domain
	510	dom__init_file%i_ghost0(:,:)=0
	511	SELECT CASE(dom__init_file%i_perio0)
	512	CASE(0)
	513	dom__init_file%i_ghost0(:,:)=1
	514	CASE(1)
	515	dom__init_file%i_ghost0(jp_J,:)=1
	516	CASE(2)
	517	dom__init_file%i_ghost0(jp_I,:)=1
	518	dom__init_file%i_ghost0(jp_J,2)=1
	519	CASE(3,5)
	520	dom__init_file%i_ghost0(jp_I,:)=1
	521	dom__init_file%i_ghost0(jp_J,1)=1
	522	CASE(4,6)
	523	dom__init_file%i_ghost0(jp_J,1)=1
	524	END SELECT
[4213]	525
[5037]	526	! look for EW overlap
	527	dom__init_file%i_ew0=td_file%i_ew
[4213]	528
[5037]	529	! initialise domain as global
	530	dom__init_file%i_imin = 1
	531	dom__init_file%i_imax = dom__init_file%t_dim0(1)%i_len
	532
	533	dom__init_file%i_jmin = 1
	534	dom__init_file%i_jmax = dom__init_file%t_dim0(2)%i_len
	535
	536	! sub domain dimension
	537	dom__init_file%t_dim(:) = dim_copy(td_file%t_dim(:))
	538
	539	! define sub domain indices
	540	CALL dom__define( dom__init_file, &
	541	& id_imin, id_imax, id_jmin, id_jmax )
	542
	543	ENDIF
	544
	545	END FUNCTION dom__init_file
[4213]	546	!-------------------------------------------------------------------
	547	!> @brief
[5037]	548	!> This subroutine define sub domain indices, and compute the size
	549	!> of the sub domain.
[4213]	550	!>
	551	!> @author J.Paul
[10248]	552	!> @date November, 2013 - Initial version
[4213]	553	!
[5037]	554	!> @param[inout] td_dom domain structure
	555	!> @param[in] id_imin i-direction sub-domain lower left point indice
	556	!> @param[in] id_imax i-direction sub-domain upper right point indice
	557	!> @param[in] id_jmin j-direction sub-domain lower left point indice
	558	!> @param[in] id_jmax j-direction sub-domain upper right point indice
[4213]	559	!-------------------------------------------------------------------
	560	SUBROUTINE dom__define(td_dom, &
	561	& id_imin, id_imax, id_jmin, id_jmax )
	562	IMPLICIT NONE
	563	! Argument
	564	TYPE(TDOM), INTENT(INOUT) :: td_dom
	565	INTEGER(i4), INTENT(IN), OPTIONAL :: id_imin
	566	INTEGER(i4), INTENT(IN), OPTIONAL :: id_imax
	567	INTEGER(i4), INTENT(IN), OPTIONAL :: id_jmin
	568	INTEGER(i4), INTENT(IN), OPTIONAL :: id_jmax
	569	!----------------------------------------------------------------
	570
	571	IF( PRESENT(id_imin) ) td_dom%i_imin = id_imin
	572	IF( PRESENT(id_imax) ) td_dom%i_imax = id_imax
	573
	574	IF( PRESENT(id_jmin) ) td_dom%i_jmin = id_jmin
	575	IF( PRESENT(id_jmax) ) td_dom%i_jmax = id_jmax
	576
	577	! check indices
[5037]	578	IF(( td_dom%i_imin < -1 .OR. td_dom%i_imin > td_dom%t_dim0(1)%i_len ).OR. &
	579	& ( td_dom%i_imax < -1 .OR. td_dom%i_imax > td_dom%t_dim0(1)%i_len ).OR. &
	580	& ( td_dom%i_jmin < -1 .OR. td_dom%i_jmin > td_dom%t_dim0(2)%i_len ).OR. &
	581	& ( td_dom%i_jmax < -1 .OR. td_dom%i_jmax > td_dom%t_dim0(2)%i_len ))THEN
	582	CALL logger_debug("0 <= imin ("//TRIM(fct_str(id_imin))//") < "//&
[4213]	583	& TRIM(fct_str(td_dom%t_dim0(1)%i_len)))
[5037]	584	CALL logger_debug("0 <= imax ("//TRIM(fct_str(id_imax))//") < "//&
[4213]	585	& TRIM(fct_str(td_dom%t_dim0(1)%i_len)))
[5037]	586	CALL logger_debug("0 <= jmin ("//TRIM(fct_str(id_jmin))//") < "//&
[4213]	587	& TRIM(fct_str(td_dom%t_dim0(2)%i_len)))
[5037]	588	CALL logger_debug("0 <= jmax ("//TRIM(fct_str(id_jmax))//") < "//&
[4213]	589	& TRIM(fct_str(td_dom%t_dim0(2)%i_len)))
[5037]	590	CALL logger_fatal( "DOM INIT DEFINE: invalid grid definition."// &
	591	& " check min and max indices")
[4213]	592	ELSE
	593
[5037]	594	! force to select north fold
	595	IF( td_dom%i_perio0 > 2 .AND. &
	596	& ( td_dom%i_jmax >= td_dom%t_dim0(2)%i_len-1 .OR. &
	597	& td_dom%i_jmax < td_dom%i_jmin .OR. &
	598	& td_dom%i_jmin == 0 ) )THEN
	599	td_dom%i_jmax=0
	600	ENDIF
[4213]	601
[5037]	602	! force to use cyclic boundary
	603	IF( ( td_dom%i_perio0 == 1 .OR. &
	604	& td_dom%i_perio0 == 4 .OR. &
	605	& td_dom%i_perio0 == 6 ) .AND. &
	606	& ( td_dom%i_imin == 0 .OR. td_dom%i_imax == 0 .OR. &
	607	& ABS(td_dom%i_imax-td_dom%i_imin)+1 == td_dom%t_dim0(1)%i_len ) &
	608	& )THEN
	609	td_dom%i_imin = 0
	610	td_dom%i_imax = 0
	611	ENDIF
	612
[4213]	613	SELECT CASE(td_dom%i_perio0)
	614	CASE(0) ! closed boundary
[5037]	615	CALL logger_trace("DOM INIT DEFINE: closed boundary")
[4213]	616	CALL dom__define_closed( td_dom )
	617	CASE(1) ! cyclic east-west boundary
[5037]	618	CALL logger_trace("DOM INIT DEFINE: cyclic east-west boundary")
[4213]	619	CALL dom__define_cyclic( td_dom )
	620	CASE(2) ! symmetric boundary condition across the equator
[5037]	621	CALL logger_trace("DOM INIT DEFINE: symmetric boundary condition "//&
[4213]	622	& " across the equator")
	623	CALL dom__define_symmetric( td_dom )
	624	CASE(3) ! North fold boundary (with a F-point pivot)
[5037]	625	CALL logger_trace("DOM INIT DEFINE: North fold boundary "//&
[4213]	626	& "(with a F-point pivot)")
	627	CALL dom__define_north_fold( td_dom )
	628	CASE(5) ! North fold boundary (with a T-point pivot)
[5037]	629	CALL logger_trace("DOM INIT DEFINE: North fold boundary "//&
[4213]	630	& "(with a T-point pivot)")
	631	CALL dom__define_north_fold( td_dom )
	632	CASE(4) ! North fold boundary (with a F-point pivot)
	633	! and cyclic east-west boundary
[5037]	634	CALL logger_trace("DOM INIT DEFINE: North fold boundary "//&
[4213]	635	& "(with a F-point pivot) and cyclic "//&
	636	& "east-west boundary")
	637	CALL dom__define_cyclic_north_fold( td_dom )
	638	CASE(6) ! North fold boundary (with a T-point pivot)
	639	! and cyclic east-west boundary
[5037]	640	CALL logger_trace("DOM INIT DEFINE: North fold boundary "//&
[4213]	641	& "(with a T-point pivot) and cyclic "//&
	642	& "east-west boundary")
	643	CALL dom__define_cyclic_north_fold( td_dom )
	644	CASE DEFAULT
[5037]	645	CALL logger_error("DOM INIT DEFINE: invalid grid periodicity index")
[4213]	646	END SELECT
	647
	648	ENDIF
	649
	650	END SUBROUTINE dom__define
	651	!-------------------------------------------------------------------
	652	!> @brief
[5037]	653	!> This subroutine define sub domain indices from global domain with
[4213]	654	!> cyclic east-west boundary and north fold boundary condition.
	655	!>
	656	!> @author J.Paul
[10248]	657	!> @date November, 2013 - Initial version
[5037]	658	!> @date September, 2014
	659	!> - use zero indice to defined cyclic or global domain
[4213]	660	!
[5037]	661	!> @param[inout] td_dom domain strcuture
[4213]	662	!-------------------------------------------------------------------
	663	SUBROUTINE dom__define_cyclic_north_fold( td_dom )
	664	IMPLICIT NONE
	665	! Argument
	666	TYPE(TDOM), INTENT(INOUT) :: td_dom
	667	!----------------------------------------------------------------
	668
[5037]	669	!CALL dom__check_EW_index( td_dom )
[4213]	670
[5037]	671	IF( td_dom%i_imin == 0 .AND. td_dom%i_imax == 0 .AND. &
	672	& td_dom%i_jmin == 0 .AND. td_dom%i_jmax == 0 )THEN
[4213]	673
[5037]	674	CALL logger_trace("DOM DEFINE CYCLIC NORTH FOLD: "//&
[4213]	675	& "domain to extract is global" )
	676	! coarse domain is global domain
	677
	678	CALL dom__size_global( td_dom )
	679
[5037]	680	ELSEIF( td_dom%i_imin == 0 .AND. td_dom%i_imax == 0 .AND. &
	681	& td_dom%i_jmax == 0 )THEN
[4213]	682
[5037]	683	CALL logger_trace("DOM DEFINE CYCLIC NORTH FOLD: "//&
[4213]	684	& "domain to extract is semi-global" )
	685
	686	CALL dom__size_semi_global( td_dom )
	687
[5037]	688	ELSEIF( td_dom%i_imin == 0 .AND. td_dom%i_imax == 0 .AND. &
	689	& td_dom%i_jmax /= 0 )THEN
[4213]	690
[5037]	691	CALL logger_trace("DOM DEFINE CYCLIC NORTH FOLD: "//&
[4213]	692	& "domain to extract is band of latidue" )
	693
	694	CALL dom__size_no_pole( td_dom )
	695
[5037]	696	ELSEIF( td_dom%i_jmax == 0 )THEN
[4213]	697
[5037]	698	CALL logger_trace("DOM DEFINE CYCLIC NORTH FOLD: "//&
	699	& "domain to extract use north fold" )
[4213]	700
	701	CALL dom__size_pole( td_dom )
	702
[5037]	703	ELSEIF( td_dom%i_jmax /= 0 )THEN
[4213]	704
[5037]	705	CALL logger_trace("DOM DEFINE CYCLIC NORTH FOLD: "//&
	706	& "domain to extract do not use north fold" )
	707	! no North Pole
	708
	709	CALL dom__size_no_pole( td_dom )
[4213]	710
	711	ELSE
	712
[5037]	713	CALL logger_error("DOM DEFINE CYCLIC NORTH FOLD: "//&
[4213]	714	& "should have been an impossible case" )
	715
	716	ENDIF
	717
	718	END SUBROUTINE dom__define_cyclic_north_fold
	719	!-------------------------------------------------------------------
	720	!> @brief
[5037]	721	!> This subroutine define sub domain indices from global domain
[4213]	722	!> with north fold boundary condition.
	723	!>
	724	!> @author J.Paul
[10248]	725	!> @date November, 2013 - Initial verison
[4213]	726	!
[5037]	727	!> @param[inout] td_dom domain strcuture
[4213]	728	!-------------------------------------------------------------------
	729	SUBROUTINE dom__define_north_fold( td_dom )
	730	IMPLICIT NONE
	731	! Argument
	732	TYPE(TDOM), INTENT(INOUT) :: td_dom
	733	!----------------------------------------------------------------
	734
[5037]	735	IF( td_dom%i_jmax /= 0 )THEN
[4213]	736
[5037]	737	CALL logger_trace("DOM DEFINE NORTH FOLD: "//&
[4213]	738	& "domain to extract has no north boundary" )
	739	! no North Pole
	740
	741	CALL dom__size_no_pole_no_overlap( td_dom )
	742
	743	ELSE
	744
[5037]	745	CALL logger_trace("DOM DEFINE NORTH FOLD: "//&
	746	& "sub domain has north boundary" )
[4213]	747
	748	CALL dom__size_pole_no_overlap( td_dom )
	749
	750	ENDIF
	751
	752	END SUBROUTINE dom__define_north_fold
	753	!-------------------------------------------------------------------
	754	!> @brief
[5037]	755	!> This subroutine define sub domain indices from global domain
[4213]	756	!> with symmetric boundary condition across the equator.
	757	!>
	758	!> @author J.Paul
[10248]	759	!> @date November, 2013 - Initial version
[4213]	760	!
[5037]	761	!> @param[inout] td_dom domain strcuture
[4213]	762	!-------------------------------------------------------------------
	763	SUBROUTINE dom__define_symmetric( td_dom )
	764	IMPLICIT NONE
	765	! Argument
	766	TYPE(TDOM), INTENT(INOUT) :: td_dom
	767	!----------------------------------------------------------------
	768
	769	CALL dom__size_no_pole_no_overlap( td_dom )
	770
	771	END SUBROUTINE dom__define_symmetric
	772	!-------------------------------------------------------------------
	773	!> @brief
[5037]	774	!> This subroutine define sub domain indices from global domain
[4213]	775	!> with cyclic east-west boundary.
	776	!>
	777	!> @author J.Paul
[10248]	778	!> @date November, 2013 - Initial version
[4213]	779	!
[5037]	780	!> @param[inout] td_dom domain strcuture
[4213]	781	!-------------------------------------------------------------------
	782	SUBROUTINE dom__define_cyclic( td_dom )
	783	IMPLICIT NONE
	784	! Argument
	785	TYPE(TDOM), INTENT(INOUT) :: td_dom
	786	!----------------------------------------------------------------
	787
	788	IF( td_dom%i_imin >= td_dom%i_imax )THEN
[5037]	789	CALL logger_trace("DOM DEFINE CYCLIC: "//&
[4213]	790	& "domain to extract overlap east-west boundary")
	791
	792	CALL dom__size_no_pole_overlap( td_dom )
	793
	794	ELSE
	795	! id_imin < id_imax
[5037]	796	CALL logger_trace("DOM DEFINE CYCLIC: "//&
[4213]	797	& "domain to extract do not overlap east-west boundary")
	798
	799	CALL dom__size_no_pole_no_overlap( td_dom )
	800
	801	ENDIF
	802
	803	END SUBROUTINE dom__define_cyclic
	804	!-------------------------------------------------------------------
	805	!> @brief
[5037]	806	!> This subroutine define sub domain indices from global domain
[4213]	807	!> with closed boundaries.
	808	!>
	809	!> @author J.Paul
[10248]	810	!> @date November, 2013 - Initial version
[4213]	811	!
[5037]	812	!> @param[inout] td_dom domain strcuture
[4213]	813	!-------------------------------------------------------------------
	814	SUBROUTINE dom__define_closed( td_dom )
	815	IMPLICIT NONE
	816	! Argument
	817	TYPE(TDOM), INTENT(INOUT) :: td_dom
	818	!----------------------------------------------------------------
	819
	820	CALL dom__size_no_pole_no_overlap( td_dom )
	821
	822	END SUBROUTINE dom__define_closed
	823	!-------------------------------------------------------------------
	824	!> @brief
	825	!> This subroutine compute size of global domain
	826	!>
	827	!> @author J.Paul
[10248]	828	!> @date November, 2013 - Initial version
[4213]	829	!
[5037]	830	!> @param[inout] td_dom domain strcuture
[4213]	831	!-------------------------------------------------------------------
	832	SUBROUTINE dom__size_global( td_dom )
	833	IMPLICIT NONE
	834	! Argument
	835	TYPE(TDOM), INTENT(INOUT) :: td_dom
	836	!----------------------------------------------------------------
	837
	838	td_dom%i_imin = 1
	839	td_dom%i_imax = td_dom%t_dim0(1)%i_len
	840
	841	td_dom%i_jmin = 1
	842	td_dom%i_jmax = td_dom%t_dim0(2)%i_len
	843
	844	! domain size
	845	td_dom%t_dim(1)%i_len = td_dom%t_dim0(1)%i_len
	846	td_dom%t_dim(2)%i_len = td_dom%t_dim0(2)%i_len
	847
	848	! no ghost cell to add
[5037]	849	td_dom%i_ghost(:,:)=0
[4213]	850
[5037]	851	! periodicity
[4213]	852	IF( td_dom%i_pivot == 0 )THEN ! 0-F
	853	td_dom%i_perio=4
	854	td_dom%i_pivot=0
	855	ELSE ! 1-T
	856	td_dom%i_perio=6
	857	td_dom%i_pivot=1
	858	ENDIF
	859
	860	END SUBROUTINE dom__size_global
	861	!-------------------------------------------------------------------
	862	!> @brief
	863	!> This subroutine compute size of a semi global domain
	864	!>
	865	!> @author J.Paul
[10248]	866	!> @date November, 2013 - Initial version
[4213]	867	!
[5037]	868	!> @param[inout] td_dom domain strcuture
[4213]	869	!> @note never tested
	870	!-------------------------------------------------------------------
	871	SUBROUTINE dom__size_semi_global( td_dom )
	872	IMPLICIT NONE
	873	! Argument
	874	TYPE(TDOM), INTENT(INOUT) :: td_dom
	875
	876	! local variable
[5037]	877	INTEGER(i4) :: il_imid ! canadian bipole index (middle of global domain)
[4213]	878	!----------------------------------------------------------------
	879
	880	il_imid = td_dom%t_dim0(1)%i_len/2 + td_dom%i_pivot
	881
	882	td_dom%i_imin = 2
	883	td_dom%i_imax = il_imid !td_dom%t_dim0(1)%i_len
	884
[5037]	885	IF( td_dom%i_jmin == 0 ) td_dom%i_jmin=1
	886	td_dom%i_jmax = td_dom%t_dim0(2)%i_len
[4213]	887
	888	! domain size
[5037]	889	td_dom%t_dim(1)%i_len = td_dom%i_imax - &
	890	& td_dom%i_imin + 1
[4213]	891
	892	td_dom%t_dim(2)%i_len = ( td_dom%t_dim0(2)%i_len - &
[5037]	893	& td_dom%i_jmin + 1 ) + &
[4213]	894	& ( td_dom%t_dim0(2)%i_len - &
[5037]	895	& td_dom%i_jmin + 1 ) - 2 ! remove north fold condition ?
[4213]	896
	897	! ghost cell to add
[5037]	898	td_dom%i_ghost(:,:)=1
[4213]	899
	900	! periodicity
	901	IF( td_dom%i_pivot == 0 )THEN !0-F
	902	td_dom%i_perio=3
	903	td_dom%i_pivot=0
	904	ELSE !1-T
	905	td_dom%i_perio=5
	906	td_dom%i_pivot=1
	907	ENDIF
	908
	909	END SUBROUTINE dom__size_semi_global
	910	!-------------------------------------------------------------------
	911	!> @brief
[5037]	912	!> This subroutine compute size of sub domain without north fold
[4213]	913	!> condition
	914	!>
	915	!> @author J.Paul
[10248]	916	!> @date November, 2013 - Initial version
[4213]	917	!
[5037]	918	!> @param[inout] td_dom domain strcuture
[4213]	919	!-------------------------------------------------------------------
	920	SUBROUTINE dom__size_no_pole( td_dom )
	921	IMPLICIT NONE
	922	! Argument
	923	TYPE(TDOM), INTENT(INOUT) :: td_dom
	924	!----------------------------------------------------------------
	925
[5037]	926	IF( td_dom%i_jmax == 0 )THEN
	927	CALL logger_fatal("DOM SIZE NO POLE: invalid domain. "//&
[4213]	928	& "can not get north pole from this coarse grid. "//&
	929	& "check namelist and coarse grid periodicity." )
	930	ENDIF
	931
[5037]	932	IF( td_dom%i_imin == 0 .AND. td_dom%i_imax == 0 .OR. &
	933	& td_dom%i_imin > td_dom%i_imax )THEN
	934	CALL logger_trace("DOM SIZE NO POLE: "// &
[4213]	935	& "domain to extract overlap east-west boundary")
	936
	937	CALL dom__size_no_pole_overlap( td_dom )
	938
	939	ELSE
	940	! id_imin < id_imax
[5037]	941	CALL logger_trace("DOM SIZE NO POLE: "// &
[4213]	942	& "domain to extract do not overlap east-west boundary")
	943
	944	CALL dom__size_no_pole_no_overlap( td_dom )
	945
	946	ENDIF
	947
	948	END SUBROUTINE dom__size_no_pole
	949	!-------------------------------------------------------------------
	950	!> @brief
[5037]	951	!> This subroutine compute size of sub domain with north fold
	952	!> condition.
[4213]	953	!>
	954	!> @author J.Paul
[10248]	955	!> @date April, 2013 - Initial version
[4213]	956	!
[5037]	957	!> @param[inout] td_dom domain strcuture
	958	!> @note never tested
[4213]	959	!-------------------------------------------------------------------
	960	SUBROUTINE dom__size_pole( td_dom )
	961	IMPLICIT NONE
	962	! Argument
	963	TYPE(TDOM), INTENT(INOUT) :: td_dom
	964	!----------------------------------------------------------------
	965
[5037]	966	IF( td_dom%i_imin >= td_dom%i_imax )THEN
	967	CALL logger_trace("DOM SIZE POLE: "//&
[4213]	968	& "domain to extract overlap east-west boundary")
	969	CALL dom__size_pole_overlap( td_dom )
	970	ELSEIF( td_dom%i_imin < td_dom%i_imax )THEN
[5037]	971	CALL logger_trace("DOM SIZE POLE: "//&
[4213]	972	& "domain to extract do not overlap east-west boundary")
	973	CALL dom__size_pole_no_overlap( td_dom )
	974	ENDIF
	975
	976	END SUBROUTINE dom__size_pole
	977	!-------------------------------------------------------------------
	978	!> @brief
[5037]	979	!> This subroutine compute size of sub domain without north fold
[4213]	980	!> condition, and which overlap east-west boundary
	981	!>
	982	!> @author J.Paul
[10248]	983	!> @date November, 2013 - Initial version
[4213]	984	!
[5037]	985	!> @param[inout] td_dom domain strcuture
[4213]	986	!-------------------------------------------------------------------
	987	SUBROUTINE dom__size_no_pole_overlap( td_dom )
	988	IMPLICIT NONE
	989	! Argument
	990	TYPE(TDOM), INTENT(INOUT) :: td_dom
	991	!----------------------------------------------------------------
	992
[5037]	993	IF( td_dom%i_jmax == 0 )THEN
	994	CALL logger_fatal("DOM SIZE NO POLE OVERLAP: invalid domain. "//&
[4213]	995	& "can not get north pole from this coarse grid. "//&
	996	& "check namelist and coarse grid periodicity." )
	997	ENDIF
	998
[5037]	999	IF( td_dom%i_imin == 0 .AND. td_dom%i_imax == 0 )THEN
[4213]	1000	! domain to extract with east west cyclic boundary
[5037]	1001	CALL logger_trace("DOM SIZE NO POLE OVERLAP: "//&
[4213]	1002	& "domain to extract has cyclic east-west boundary")
	1003
	1004	td_dom%i_imin = 1
	1005	td_dom%i_imax = td_dom%t_dim0(1)%i_len
	1006
	1007	td_dom%t_dim(1)%i_len = td_dom%t_dim0(1)%i_len
	1008
	1009	! no ghost cell
[5037]	1010	td_dom%i_ghost(jp_I,:)=0
[4213]	1011
	1012	! periodicity
	1013	td_dom%i_perio=1
	1014
	1015	ELSE
	1016
	1017	! id_imin > id_imax
	1018	! extract domain overlap east-west boundary
	1019
[5037]	1020	td_dom%t_dim(1)%i_len = td_dom%i_imax + &
	1021	& td_dom%t_dim0(1)%i_len - td_dom%i_imin + 1 - &
	1022	& td_dom%i_ew0 ! remove cyclic boundary
[4213]	1023
	1024	! add ghost cell
[5037]	1025	td_dom%i_ghost(jp_I,:)=1
[4213]	1026
	1027	! periodicity
	1028	td_dom%i_perio=0
	1029
	1030	ENDIF
	1031
[5037]	1032	td_dom%t_dim(2)%i_len = td_dom%i_jmax - &
	1033	& td_dom%i_jmin + 1
[4213]	1034
	1035	! add ghost cell
[5037]	1036	td_dom%i_ghost(jp_J,:)=1
[4213]	1037
	1038	END SUBROUTINE dom__size_no_pole_overlap
	1039	!-------------------------------------------------------------------
	1040	!> @brief
[5037]	1041	!> This subroutine compute size of sub domain without north fold
[4213]	1042	!> condition, and which do not overlap east-west boundary
	1043	!>
	1044	!> @author J.Paul
[10248]	1045	!> @date November, 2013 - Initial version
[4213]	1046	!
[5037]	1047	!> @param[inout] td_dom domain strcuture
[4213]	1048	!-------------------------------------------------------------------
	1049	SUBROUTINE dom__size_no_pole_no_overlap( td_dom )
	1050	IMPLICIT NONE
	1051	! Argument
	1052	TYPE(TDOM), INTENT(INOUT) :: td_dom
	1053	!----------------------------------------------------------------
	1054
[5037]	1055	IF( td_dom%i_jmax == 0 )THEN
	1056	CALL logger_fatal("DOM SIZE NO POLE NO OVERLAP: invalid domain. "//&
[4213]	1057	& "can not get north pole from this coarse grid. "//&
[5037]	1058	& "check domain indices and grid periodicity." )
[4213]	1059	ENDIF
	1060
[5037]	1061	IF( td_dom%i_imin == 0 .OR. td_dom%i_imax == 0 )THEN
	1062	CALL logger_fatal("DOM SIZE NO POLE NO OVERLAP: invalid domain. "//&
[4213]	1063	& "can not overlap East-West boundary with this coarse grid. "//&
[5037]	1064	& "check domain indices and grid periodicity." )
[4213]	1065	ENDIF
	1066
[5037]	1067	td_dom%t_dim(1)%i_len = td_dom%i_imax - &
	1068	& td_dom%i_imin + 1
[4213]	1069
[5037]	1070	td_dom%t_dim(2)%i_len = td_dom%i_jmax - &
	1071	& td_dom%i_jmin + 1
[4213]	1072
	1073	! add ghost cell
[5037]	1074	td_dom%i_ghost(:,:)=1
[4213]	1075
	1076	! periodicity
	1077	td_dom%i_perio=0
	1078
	1079	END SUBROUTINE dom__size_no_pole_no_overlap
	1080	!-------------------------------------------------------------------
	1081	!> @brief
[5037]	1082	!> This subroutine compute size of sub domain with north fold
[4213]	1083	!> condition, and which overlap east-west boundary
	1084	!>
	1085	!> @author J.Paul
[10248]	1086	!> @date November, 2013 - Initial version
[4213]	1087	!
[5037]	1088	!> @param[inout] td_dom domain strcuture
[4213]	1089	!> @note never tested
	1090	!-------------------------------------------------------------------
	1091	SUBROUTINE dom__size_pole_overlap( td_dom )
	1092	IMPLICIT NONE
	1093	! Argument
	1094	TYPE(TDOM), INTENT(INOUT) :: td_dom
	1095
	1096	! local variable
	1097	INTEGER(i4) :: il_idom1 ! extract domain size, east part
	1098	INTEGER(i4) :: il_idom2 ! extract domain size, west part
	1099	INTEGER(i4) :: il_imid ! cananadian bipole index (middle of global domain)
	1100	!----------------------------------------------------------------
	1101
[5037]	1102	CALL logger_trace("DOM SIZE POLE OVERLAP: "//&
[4213]	1103	& "asian bipole inside domain to extract")
	1104
	1105	il_imid = td_dom%t_dim0(1)%i_len/2 + td_dom%i_pivot
	1106
	1107	il_idom1 = td_dom%t_dim0(1)%i_len - td_dom%i_imin + 1
	1108	il_idom2 = td_dom%i_imax
	1109
	1110	IF( il_idom1 > il_imid .OR. il_idom2 > il_imid )THEN
	1111
[5037]	1112	CALL logger_trace("DOM SIZE POLE OVERLAP: "//&
[4213]	1113	& "canadian bipole inside domain to extract")
[5037]	1114	td_dom%i_imin = 0
	1115	td_dom%i_imax = 0
[4213]	1116
[5037]	1117	IF( td_dom%i_jmin == 0 .AND. td_dom%i_jmax == 0 )THEN
[4213]	1118	CALL dom__size_global( td_dom )
	1119	ELSE
	1120	CALL dom__size_semi_global( td_dom )
	1121	ENDIF
	1122
	1123	! periodicity
	1124	td_dom%i_perio=0
	1125
	1126	ELSEIF( il_idom1 > il_idom2 )THEN
	1127
	1128	! east part bigger than west part
[5037]	1129	CALL logger_trace("DOM SIZE POLE OVERLAP: east part bigger than west part ")
[4213]	1130	! to respect symmetry around asian bipole
	1131	td_dom%i_imax = il_idom1
	1132
[5037]	1133	IF( td_dom%i_jmin == 0 ) td_dom%i_jmin = 1
[4213]	1134	! north pole
[5037]	1135	td_dom%i_jmax = td_dom%t_dim0(2)%i_len
[4213]	1136
	1137	! compute size
	1138	td_dom%t_dim(1)%i_len = il_idom1 !! no ghost cell ??
	1139	td_dom%t_dim(2)%i_len = ( td_dom%t_dim0(2)%i_len - &
[5037]	1140	& td_dom%i_jmin + 1 ) + &
[4213]	1141	& ( td_dom%t_dim0(2)%i_len - &
[5037]	1142	& td_dom%i_jmin + 1 ) - 2 ! remove north fold condition ?
[4213]	1143
	1144	! add ghost cell
[5037]	1145	td_dom%i_ghost(:,:)=1
[4213]	1146
	1147	! periodicity
	1148	td_dom%i_perio=0
	1149
	1150	ELSE ! il_idom2 >= il_idom1
	1151
	1152	! west part bigger than east part
[5037]	1153	CALL logger_trace("DOM SIZE POLE OVERLAP: west part bigger than east part ")
[4213]	1154
	1155	! to respect symmetry around asian bipole
	1156	td_dom%i_imin = td_dom%t_dim0(1)%i_len - il_idom2 + 1
	1157
[5037]	1158	IF( td_dom%i_jmin == 0 ) td_dom%i_jmin = 1
[4213]	1159	! north pole
[5037]	1160	td_dom%i_jmax=td_dom%t_dim0(2)%i_len
[4213]	1161
	1162	! compute size
	1163	td_dom%t_dim(1)%i_len = il_idom2
	1164	td_dom%t_dim(2)%i_len = ( td_dom%t_dim0(2)%i_len - &
[5037]	1165	& td_dom%i_jmin + 1 ) + &
[4213]	1166	& ( td_dom%t_dim0(2)%i_len - &
[5037]	1167	& td_dom%i_jmin + 1 ) - 2
[4213]	1168
	1169	! add ghost cell
[5037]	1170	td_dom%i_ghost(:,:)=1
[4213]	1171
	1172	! periodicity
	1173	td_dom%i_perio=0
	1174
	1175	ENDIF
	1176
	1177	END SUBROUTINE dom__size_pole_overlap
	1178	!-------------------------------------------------------------------
	1179	!> @brief
[5037]	1180	!> This subroutine compute size of sub domain with north fold
[4213]	1181	!> condition, and which do not overlap east-west boundary
	1182	!>
	1183	!> @author J.Paul
[10248]	1184	!> @date November, 2013 - Initial version
[4213]	1185	!
[5037]	1186	!> @param[inout] td_dom domain strcuture
[4213]	1187	!> @note never tested
	1188	!-------------------------------------------------------------------
	1189	SUBROUTINE dom__size_pole_no_overlap( td_dom )
	1190	IMPLICIT NONE
	1191	! Argument
	1192	TYPE(TDOM), INTENT(INOUT) :: td_dom
	1193
	1194	! local variable
	1195	INTEGER(i4) :: il_idom1 ! extract domain size, east part
	1196	INTEGER(i4) :: il_idom2 ! extract domain size, west part
	1197	INTEGER(i4) :: il_mid ! canadian biple index ?
	1198	!----------------------------------------------------------------
	1199
[5037]	1200	IF( td_dom%i_imin == 0 .OR. td_dom%i_imax == 0 .OR. &
	1201	& td_dom%i_imin > td_dom%i_imax )THEN
	1202	CALL logger_fatal("DOM SIZE POLE NO OVERLAP: invalid domain. "//&
[4213]	1203	& "can not overlap East-West boundary with this coarse grid. "//&
	1204	& "check namelist and coarse grid periodicity." )
	1205	ENDIF
	1206
[5037]	1207	CALL logger_trace("DOM SIZE POLE NO OVERLAP: "//&
[4213]	1208	& "no asian bipole inside domain to extract")
	1209
[5037]	1210	IF( td_dom%i_jmin==0 ) td_dom%i_jmin = 1
	1211	IF( td_dom%i_jmax==0 ) td_dom%i_jmax = td_dom%t_dim0(2)%i_len
[4213]	1212
	1213	!
	1214	il_mid = td_dom%t_dim0(1)%i_len/2 + td_dom%i_pivot
	1215
	1216	IF( (td_dom%i_imin < il_mid .AND. td_dom%i_imax < il_mid) .OR. &
	1217	& (td_dom%i_imin > il_mid .AND. td_dom%i_imax > il_mid) )THEN
[5037]	1218	CALL logger_trace("DOM SIZE POLE NO OVERLAP: "//&
[4213]	1219	& "no canadian bipole inside domain to extract")
	1220
[5037]	1221	td_dom%t_dim(1)%i_len = td_dom%i_imax - &
	1222	& td_dom%i_imin + 1
[4213]	1223
	1224	td_dom%t_dim(2)%i_len = ( td_dom%t_dim0(2)%i_len - &
[5037]	1225	& td_dom%i_jmin + 1 ) + &
[4213]	1226	& ( td_dom%t_dim0(2)%i_len - &
[5037]	1227	& td_dom%i_jmin + 1 ) - 2 ! remove north fold condition ?
[4213]	1228
	1229	! add ghost cell
[5037]	1230	td_dom%i_ghost(:,:)=1
[4213]	1231
	1232	! periodicity
	1233	td_dom%i_perio=0
	1234
	1235	ELSE ! id_imin < il_mid .AND. id_imax > il_mid
[5037]	1236	CALL logger_trace("DOM SIZE POLE NO OVERLAP: "//&
[4213]	1237	& "canadian bipole inside domain to extract")
	1238
	1239	il_idom1 = td_dom%i_imax - (il_mid - 1)
	1240	il_idom2 = il_mid - td_dom%i_imin
	1241	IF( il_idom1 > il_idom2 )THEN
	1242	! east part bigger than west part
[5037]	1243	CALL logger_trace("DOM SIZE POLE NO OVERLAP: east part bigger than west part ")
[4213]	1244	! to respect symmetry around canadian bipole
	1245	td_dom%i_imin = il_mid - il_idom1
	1246
	1247	td_dom%t_dim(1)%i_len = il_idom1 + 1
	1248	td_dom%t_dim(2)%i_len = ( td_dom%t_dim0(2)%i_len - &
[5037]	1249	& td_dom%i_jmin + 1 ) + &
[4213]	1250	& ( td_dom%t_dim0(2)%i_len - &
[5037]	1251	& td_dom%i_jmin + 1 ) &
[4213]	1252	& - 2 - 2 * td_dom%i_pivot ! remove north fold condition ?
	1253
	1254	! add ghost cell
[5037]	1255	td_dom%i_ghost(:,:)=1
[4213]	1256
	1257	! periodicity
	1258	td_dom%i_perio=0
	1259
	1260	ELSE ! il_idom2 >= il_idom1
	1261	! west part bigger than east part
[5037]	1262	CALL logger_trace("DOM SIZE POLE NO OVERLAP: west part bigger than east part ")
[4213]	1263	! to respect symmetry around canadian bipole
	1264
	1265	td_dom%i_imax = il_mid + il_idom2
	1266
	1267	td_dom%t_dim(1)%i_len = il_idom2 + 1
	1268	td_dom%t_dim(2)%i_len = ( td_dom%t_dim0(2)%i_len - &
[5037]	1269	& td_dom%i_jmin + 1 ) + &
[4213]	1270	& ( td_dom%t_dim0(2)%i_len - &
[5037]	1271	& td_dom%i_jmax + 1 ) &
[4213]	1272	& - 2 - 2 * td_dom%i_pivot ! remove north fold condition ?
	1273
	1274	! add ghost cell
[5037]	1275	td_dom%i_ghost(:,:)=1
[4213]	1276
	1277	! periodicity
	1278	td_dom%i_perio=0
	1279
	1280	ENDIF
	1281	ENDIF
	1282
	1283	END SUBROUTINE dom__size_pole_no_overlap
	1284	!-------------------------------------------------------------------
[5037]	1285	!> @brief
	1286	!> This subroutine add extra bands to coarse domain to get enough point for
	1287	!> interpolation...
	1288	!>
[4213]	1289	!> @details
[5037]	1290	!> - domain periodicity is take into account.<br/>
	1291	!> - domain indices are changed, and size of extra bands are saved.<br/>
	1292	!> - optionaly, i- and j- direction size of extra bands could be specify
	1293	!> (default=im_minext)
	1294	!>
[4213]	1295	!> @author J.Paul
[10248]	1296	!> @date November, 2013 - Initial version
[5037]	1297	!> @date September, 2014
	1298	!> - take into account number of ghost cell
[4213]	1299	!
[5037]	1300	!> @param[inout] td_dom domain strcuture
	1301	!> @param [in] id_iext i-direction size of extra bands (default=im_minext)
	1302	!> @param [in] id_jext j-direction size of extra bands (default=im_minext)
[4213]	1303	!-------------------------------------------------------------------
	1304	SUBROUTINE dom_add_extra( td_dom, id_iext, id_jext )
	1305	IMPLICIT NONE
	1306	! Argument
	1307	TYPE(TDOM) , INTENT(INOUT) :: td_dom
	1308	INTEGER(i4), INTENT(IN ), OPTIONAL :: id_iext
	1309	INTEGER(i4), INTENT(IN ), OPTIONAL :: id_jext
	1310
	1311	! local variable
	1312	INTEGER(i4) :: il_iext
	1313	INTEGER(i4) :: il_jext
	1314
	1315	! loop indices
	1316	!----------------------------------------------------------------
	1317	! init
	1318	il_iext=im_minext
	1319	IF( PRESENT(id_iext) ) il_iext=id_iext
	1320
	1321	il_jext=im_minext
	1322	IF( PRESENT(id_jext) ) il_jext=id_jext
	1323
	1324	td_dom%i_iextra(:)=0
	1325	td_dom%i_jextra(:)=0
	1326
	1327	IF( td_dom%i_imin == 1 .AND. &
	1328	& td_dom%i_imax == td_dom%t_dim0(1)%i_len .AND. &
	1329	& td_dom%i_jmin == 1 .AND. &
	1330	& td_dom%i_jmax == td_dom%t_dim0(2)%i_len )THEN
	1331	! global
	1332	! nothing to be done
	1333	ELSE
[5037]	1334
[4213]	1335	IF( td_dom%i_imin == 1 .AND. &
	1336	& td_dom%i_imax == td_dom%t_dim0(1)%i_len )THEN
	1337	! EW cyclic
	1338	! nothing to be done
	1339	ELSE
[5037]	1340	IF( td_dom%i_ew0 < 0 )THEN
	1341	! EW not cyclic
	1342	IF( td_dom%i_imin - il_iext > td_dom%i_ghost0(jp_I,1)*ip_ghost )THEN
	1343	td_dom%i_iextra(1) = il_iext
	1344	td_dom%i_imin = td_dom%i_imin - td_dom%i_iextra(1)
	1345	ELSE ! td_dom%i_imin - il_iext <= td_dom%i_ghost0(jp_I,1)*ip_ghost
	1346	td_dom%i_iextra(1) = MIN(0, &
	1347	& td_dom%i_imin - &
	1348	& td_dom%i_ghost0(jp_I,1)*ip_ghost -1)
	1349	td_dom%i_imin = td_dom%i_imin - td_dom%i_iextra(1)
	1350	ENDIF
[4213]	1351
[5037]	1352	IF( td_dom%i_imax + il_iext < &
	1353	& td_dom%t_dim0(1)%i_len - td_dom%i_ghost0(jp_I,2)*ip_ghost )THEN
	1354	td_dom%i_iextra(2) = il_iext
	1355	td_dom%i_imax = td_dom%i_imax + td_dom%i_iextra(2)
	1356	ELSE ! td_dom%i_imax + il_iext >= &
	1357	! td_dom%t_dim0(1)%i_len - td_dom%i_ghost0(jp_I,2)*ip_ghost
	1358	td_dom%i_iextra(2) = MIN(0, &
	1359	& td_dom%t_dim0(1)%i_len - &
	1360	& td_dom%i_ghost0(jp_I,2)*ip_ghost - &
	1361	& td_dom%i_imax )
	1362	td_dom%i_imax = td_dom%i_imax + td_dom%i_iextra(2)
	1363	ENDIF
[4213]	1364
[5037]	1365	ELSE ! td_dom%i_ew0 >= 0
	1366	! EW cyclic
	1367	IF( td_dom%i_imin - il_iext > 0 )THEN
	1368	td_dom%i_iextra(1) = il_iext
	1369	td_dom%i_imin = td_dom%i_imin - td_dom%i_iextra(1)
	1370	ELSE ! td_dom%i_imin - il_iext <= 0
	1371	td_dom%i_iextra(1) = il_iext
	1372	td_dom%i_imin = td_dom%t_dim0(1)%i_len + &
	1373	& td_dom%i_imin - td_dom%i_iextra(1) -&
	1374	& td_dom%i_ew0
[4213]	1375	ENDIF
	1376
[5037]	1377	IF( td_dom%i_imax + il_iext <= td_dom%t_dim0(1)%i_len )THEN
	1378	td_dom%i_iextra(2) = il_iext
	1379	td_dom%i_imax = td_dom%i_imax + td_dom%i_iextra(2)
	1380	ELSE ! td_dom%i_imax + il_iext > td_dom%t_dim0(1)%i_len
	1381	td_dom%i_iextra(2) = il_iext
	1382	td_dom%i_imax = td_dom%i_imax + td_dom%i_iextra(2) - &
	1383	& (td_dom%t_dim0(1)%i_len-td_dom%i_ew0)
	1384	ENDIF
[4213]	1385	ENDIF
	1386
	1387	ENDIF
	1388
[5037]	1389	IF( td_dom%i_jmin == 1 .AND. &
	1390	& td_dom%i_jmax == td_dom%t_dim0(2)%i_len )THEN
	1391	! nothing to be done
[4213]	1392	ELSE
[5037]	1393	IF( td_dom%i_jmin - il_jext > td_dom%i_ghost0(jp_J,1)*ip_ghost )THEN
	1394	td_dom%i_jextra(1) = il_jext
	1395	td_dom%i_jmin = td_dom%i_jmin - td_dom%i_jextra(1)
	1396	ELSE ! td_dom%i_jmin - il_jext <= td_dom%i_ghost0(jp_J,1)*ip_ghost
	1397	td_dom%i_jextra(1) = MIN(0, &
	1398	& td_dom%i_jmin - &
	1399	& td_dom%i_ghost0(jp_J,1)*ip_ghost - 1)
	1400	td_dom%i_jmin = td_dom%i_jmin - td_dom%i_jextra(1)
[4213]	1401	ENDIF
	1402
[5037]	1403	IF( td_dom%i_jmax + il_jext < &
	1404	& td_dom%t_dim0(2)%i_len - td_dom%i_ghost0(jp_J,2)*ip_ghost )THEN
	1405	td_dom%i_jextra(2) = il_jext
	1406	td_dom%i_jmax = td_dom%i_jmax + td_dom%i_jextra(2)
	1407	ELSE ! td_dom%i_jmax + il_jext >= &
	1408	! td_dom%t_dim0(2)%i_len - td_dom%i_ghost0(jp_J,2)*ip_ghost
	1409	td_dom%i_jextra(2) = MIN(0, &
	1410	& td_dom%t_dim0(2)%i_len - &
	1411	& td_dom%i_ghost0(jp_J,2)*ip_ghost - &
	1412	& td_dom%i_jmax )
	1413	td_dom%i_jmax = td_dom%i_jmax + td_dom%i_jextra(2)
[4213]	1414	ENDIF
[5037]	1415	ENDIF
[4213]	1416
[5037]	1417	ENDIF
[4213]	1418
[5037]	1419	IF( td_dom%i_imin <= td_dom%i_imax )THEN
	1420	td_dom%t_dim(1)%i_len = td_dom%i_imax - td_dom%i_imin +1
	1421	ELSE ! td_dom%i_imin > td_dom%i_imax
	1422	td_dom%t_dim(1)%i_len = td_dom%i_imax + &
	1423	& td_dom%t_dim0(1)%i_len - td_dom%i_imin + 1 - &
	1424	& td_dom%i_ew0 ! remove overlap
[4213]	1425	ENDIF
	1426
[5037]	1427	td_dom%t_dim(2)%i_len = td_dom%i_jmax-td_dom%i_jmin+1
[4213]	1428
	1429
	1430	END SUBROUTINE dom_add_extra
	1431	!-------------------------------------------------------------------
	1432	!> @brief
[5037]	1433	!> This subroutine clean coarse grid domain structure.
	1434	!> it remove extra point added.
[4213]	1435	!
	1436	!> @author J.Paul
[10248]	1437	!> @date November, 2013 - Initial version
[4213]	1438	!
[5037]	1439	!> @param[inout] td_dom domain strcuture
[4213]	1440	!-------------------------------------------------------------------
	1441	SUBROUTINE dom_clean_extra( td_dom )
	1442	IMPLICIT NONE
	1443	! Argument
	1444	TYPE(TDOM) , INTENT(INOUT) :: td_dom
	1445
	1446	! local variable
	1447	! loop indices
	1448	!----------------------------------------------------------------
	1449
	1450	! change domain
	1451	td_dom%i_imin = td_dom%i_imin + td_dom%i_iextra(1)
	1452	td_dom%i_jmin = td_dom%i_jmin + td_dom%i_jextra(1)
	1453
	1454	td_dom%i_imax = td_dom%i_imax - td_dom%i_iextra(2)
	1455	td_dom%i_jmax = td_dom%i_jmax - td_dom%i_jextra(2)
	1456
	1457	td_dom%t_dim(1)%i_len = td_dom%t_dim(1)%i_len - &
	1458	& td_dom%i_iextra(1) - &
	1459	& td_dom%i_iextra(2)
	1460	td_dom%t_dim(2)%i_len = td_dom%t_dim(2)%i_len - &
	1461	& td_dom%i_jextra(1) - &
	1462	& td_dom%i_jextra(2)
	1463
	1464	td_dom%i_iextra(:)=0
	1465	td_dom%i_jextra(:)=0
	1466
	1467	END SUBROUTINE dom_clean_extra
	1468	!-------------------------------------------------------------------
	1469	!> @brief
[5037]	1470	!> This subroutine delete extra band, from fine grid variable value,
	1471	!> and dimension, taking into account refinement factor.
	1472	!>
	1473	!> @details
	1474	!> @note This subroutine should be used before clean domain structure.
	1475	!>
	1476	!> @warning if work on coordinates grid, do not remove all extra point.
	1477	!> save value on ghost cell.
	1478	!>
[4213]	1479	!> @author J.Paul
[10248]	1480	!> @date November, 2013 - Initial version
[5037]	1481	!> @date September, 2014
	1482	!> - take into account boundary for one point size domain
	1483	!> @date December, 2014
	1484	!> - add special case for coordinates file.
[4213]	1485	!
[5037]	1486	!> @param[inout] td_var variable strcuture
	1487	!> @param[in] td_dom domain strcuture
	1488	!> @param[in] id_rho array of refinement factor
	1489	!> @param[in] ld_coord work on coordinates file or not
[4213]	1490	!-------------------------------------------------------------------
[5037]	1491	SUBROUTINE dom_del_extra( td_var, td_dom, id_rho, ld_coord )
[4213]	1492	IMPLICIT NONE
	1493	! Argument
[5037]	1494	TYPE(TVAR) , INTENT(INOUT) :: td_var
	1495	TYPE(TDOM) , INTENT(IN ) :: td_dom
	1496	INTEGER(i4), DIMENSION(:), INTENT(IN ), OPTIONAL :: id_rho
	1497	LOGICAL , INTENT(IN ), OPTIONAL :: ld_coord
[4213]	1498
	1499	! local variable
	1500	INTEGER(i4) :: il_iextra
	1501	INTEGER(i4) :: il_jextra
	1502
	1503	INTEGER(i4) :: il_imin
	1504	INTEGER(i4) :: il_imax
	1505	INTEGER(i4) :: il_jmin
	1506	INTEGER(i4) :: il_jmax
	1507
[5037]	1508	INTEGER(i4), DIMENSION(2) :: il_rho
	1509	INTEGER(i4), DIMENSION(2,2) :: il_ghost
[4213]	1510
[5037]	1511	REAL(dp) , DIMENSION(:,:,:,:), ALLOCATABLE :: dl_value
	1512
	1513	LOGICAL :: ll_coord
[4213]	1514	! loop indices
	1515	!----------------------------------------------------------------
	1516
[5037]	1517	IF( PRESENT(id_rho) )THEN
	1518	! work on coarse grid
	1519	il_rho(:)=id_rho(jp_I:jp_J)
	1520	ELSE
	1521	! work on fine grid
	1522	il_rho(:)=1
	1523	ENDIF
	1524
	1525	ll_coord=.false.
	1526	IF( PRESENT(ld_coord) ) ll_coord=ld_coord
	1527
[4213]	1528	IF( .NOT. ASSOCIATED(td_var%d_value) )THEN
	1529	CALL logger_error("DOM DEL EXTRA: no value associated to "//&
	1530	& "variable "//TRIM(td_var%c_name) )
	1531	ELSE
[5037]	1532	! get variable right domain
[4213]	1533	IF( ALL(td_var%t_dim(1:2)%l_use) )THEN
	1534
	1535	ALLOCATE(dl_value(td_var%t_dim(1)%i_len, &
	1536	& td_var%t_dim(2)%i_len, &
	1537	& td_var%t_dim(3)%i_len, &
	1538	& td_var%t_dim(4)%i_len) )
	1539	dl_value(:,:,:,:)=td_var%d_value(:,:,:,:)
	1540
[5037]	1541	il_iextra=SUM(td_dom%i_iextra(:))*il_rho(jp_I)
	1542	il_jextra=SUM(td_dom%i_jextra(:))*il_rho(jp_J)
[4213]	1543
[5037]	1544	il_ghost(:,:)=0
	1545	IF( ll_coord )THEN
	1546	il_ghost(:,:)=td_dom%i_ghost(:,:)
	1547	ENDIF
[4213]	1548
[5037]	1549	IF( il_iextra >= td_var%t_dim(1)%i_len )THEN
	1550	! case one point size dimension
	1551	SELECT CASE(td_dom%i_bdy)
[4213]	1552
[5037]	1553	CASE(jp_north,jp_east)
	1554
	1555	CALL logger_info("DOM DEL EXTRA: special case for north"//&
	1556	& " or east boundary.")
	1557	IF( td_dom%i_iextra(1) <= 0 )THEN
	1558	il_imin= 1
	1559	il_ghost(jp_I,1) = 0
	1560	ELSE
	1561	il_imin= 1 + (td_dom%i_iextra(1)-1)*il_rho(jp_I) + 1 &
	1562	& - il_ghost(jp_I,1)
	1563	ENDIF
	1564	IF( td_dom%i_iextra(2) <= 0 )THEN;
	1565	il_imax= td_var%t_dim(1)%i_len
	1566	il_ghost(jp_I,2) = 0
	1567	ELSE
	1568	il_imax= td_var%t_dim(1)%i_len - &
	1569	& td_dom%i_iextra(2)*il_rho(jp_I) &
	1570	& + il_ghost(jp_I,2)
	1571	ENDIF
	1572
	1573	CASE(jp_south,jp_west)
	1574
	1575	CALL logger_info("DOM DEL EXTRA: special case for south"//&
	1576	& " or west boundary.")
	1577	IF( td_dom%i_iextra(1) <= 0 )THEN
	1578	il_imin= 1
	1579	il_ghost(jp_I,1) = 0
	1580	ELSE
	1581	il_imin= 1 + td_dom%i_iextra(1)*il_rho(jp_I) &
	1582	& - il_ghost(jp_I,1)
	1583	ENDIF
	1584	IF( td_dom%i_iextra(2) <= 0 )THEN
	1585	il_imax= td_var%t_dim(1)%i_len
	1586	il_ghost(jp_I,2) = 0
	1587	ELSE
	1588	il_imax= td_var%t_dim(1)%i_len - &
	1589	& (td_dom%i_iextra(2)-1)*il_rho(jp_I) - 1 &
	1590	& + il_ghost(jp_I,2)
	1591	ENDIF
	1592
	1593	CASE DEFAULT
	1594
	1595	IF( MOD(il_iextra-td_var%t_dim(1)%i_len,2)==0 )THEN
	1596	! case one point size dimension with even refinment
	1597	CALL logger_fatal("DOM DEL EXTRA: should have been"//&
	1598	& "an impossible case: domain of "//&
	1599	& " one point size and even refinment.")
	1600	ELSE
	1601	il_imin= 1 + &
	1602	& (td_dom%i_iextra(1)-1)*il_rho(jp_I) + &
	1603	& (il_rho(jp_I)-1)/2 + 1 &
	1604	& - il_ghost(jp_I,1)
	1605	il_imax= td_var%t_dim(1)%i_len - &
	1606	& (td_dom%i_iextra(2)-1)*il_rho(jp_I) - &
	1607	& (il_rho(jp_I)-1)/2 - 1 &
	1608	& + il_ghost(jp_I,2)
	1609	ENDIF
	1610
	1611	END SELECT
	1612
	1613	td_var%t_dim(1)%i_len = 1 + SUM(il_ghost(jp_I,:))
	1614
	1615	ELSE
	1616	! general case
	1617	il_imin=1 + td_dom%i_iextra(1)*il_rho(jp_I) &
	1618	& - il_ghost(jp_I,1)
	1619	il_imax=td_var%t_dim(1)%i_len - td_dom%i_iextra(2)*il_rho(jp_I) &
	1620	& + il_ghost(jp_I,2)
	1621
	1622	td_var%t_dim(1)%i_len=td_var%t_dim(1)%i_len - il_iextra &
	1623	& + SUM(il_ghost(jp_I,:))
	1624	ENDIF
	1625
	1626	IF( il_jextra >= td_var%t_dim(2)%i_len )THEN
	1627	! case one point size dimension
	1628	SELECT CASE(td_dom%i_bdy)
	1629
	1630	CASE(jp_north,jp_east)
	1631
	1632	IF( td_dom%i_jextra(1) <= 0 )THEN
	1633	il_jmin= 1
	1634	il_ghost(jp_J,1) = 0
	1635	ELSE
	1636	il_jmin= 1 + (td_dom%i_jextra(1)-1)*il_rho(jp_J) + 1 &
	1637	& - il_ghost(jp_J,1)
	1638	ENDIF
	1639	IF( td_dom%i_jextra(2) <= 0 )THEN
	1640	il_jmax= td_var%t_dim(2)%i_len
	1641	il_ghost(jp_J,2) = 0
	1642	ELSE
	1643	il_jmax= td_var%t_dim(2)%i_len - &
	1644	& td_dom%i_jextra(2)*il_rho(jp_J) &
	1645	& + il_ghost(jp_J,2)
	1646	ENDIF
	1647
	1648	CASE(jp_south,jp_west)
	1649
	1650	IF( td_dom%i_iextra(2) <= 0 )THEN
	1651	il_jmin= 1
	1652	il_ghost(jp_J,1) = 0
	1653	ELSE
	1654	il_jmin= 1 + td_dom%i_jextra(1)*il_rho(jp_J) &
	1655	& - il_ghost(jp_J,1)
	1656	ENDIF
	1657	IF( td_dom%i_jextra(2) <= 0 )THEN
	1658	il_jmax= td_var%t_dim(2)%i_len
	1659	il_ghost(jp_J,2) = 0
	1660	ELSE
	1661	il_jmax= td_var%t_dim(2)%i_len - &
	1662	& (td_dom%i_jextra(2)-1)*il_rho(jp_J) - 1 &
	1663	& + il_ghost(jp_J,2)
	1664	ENDIF
	1665
	1666	CASE DEFAULT
	1667
	1668	IF( MOD(il_jextra-td_var%t_dim(2)%i_len,2)==0 )THEN
	1669	! case one point size dimension with even refinment
	1670	CALL logger_fatal("DOM DEL EXTRA: should have been"//&
	1671	& "an impossible case: domain of "//&
	1672	& " one point size and even refinment.")
	1673	ELSE
	1674	il_jmin= 1 + &
	1675	& (td_dom%i_jextra(1)-1)*il_rho(jp_J) + &
	1676	& (il_rho(jp_J)-1)/2 + 1 &
	1677	& - il_ghost(jp_J,1)
	1678	il_jmax= td_var%t_dim(2)%i_len - &
	1679	& (td_dom%i_jextra(2)-1)*il_rho(jp_J) - &
	1680	& (il_rho(jp_J)-1)/2 - 1 &
	1681	& + il_ghost(jp_J,2)
	1682	ENDIF
	1683
	1684	END SELECT
	1685
	1686	td_var%t_dim(2)%i_len = 1 + SUM(il_ghost(jp_J,:))
	1687
	1688	ELSE
	1689	! general case
	1690	il_jmin=1 + td_dom%i_jextra(1)*il_rho(jp_J) &
	1691	& - il_ghost(jp_J,1)
	1692	il_jmax=td_var%t_dim(2)%i_len - td_dom%i_jextra(2)*il_rho(jp_J) &
	1693	& + il_ghost(jp_J,2)
	1694
	1695	td_var%t_dim(2)%i_len= td_var%t_dim(2)%i_len - il_jextra &
	1696	& + SUM(il_ghost(jp_J,:))
	1697	ENDIF
	1698
[4213]	1699	DEALLOCATE(td_var%d_value)
	1700	ALLOCATE(td_var%d_value(td_var%t_dim(1)%i_len, &
	1701	& td_var%t_dim(2)%i_len, &
	1702	& td_var%t_dim(3)%i_len, &
	1703	& td_var%t_dim(4)%i_len) )
	1704
	1705	td_var%d_value(:,:,:,:)=dl_value(il_imin:il_imax, &
	1706	& il_jmin:il_jmax, &
	1707	& :, :)
	1708	DEALLOCATE(dl_value)
	1709	ENDIF
	1710
	1711	ENDIF
	1712
	1713	END SUBROUTINE dom_del_extra
	1714	!-------------------------------------------------------------------
	1715	!> @brief
[5037]	1716	!> This subroutine clean domain structure.
[4213]	1717	!
	1718	!> @author J.Paul
[10248]	1719	!> @date November, 2013 - Initial version
[4213]	1720	!
[5037]	1721	!> @param[inout] td_dom domain strcuture
[4213]	1722	!-------------------------------------------------------------------
	1723	SUBROUTINE dom_clean( td_dom )
	1724	IMPLICIT NONE
	1725	! Argument
	1726	TYPE(TDOM), INTENT(INOUT) :: td_dom
	1727
	1728	! local variable
[5037]	1729	TYPE(TDOM) :: tl_dom ! empty dom structure
[4213]	1730
	1731	! loop indices
	1732	INTEGER(i4) :: ji
	1733	!----------------------------------------------------------------
	1734
[5037]	1735	CALL logger_info( "DOM CLEAN: reset domain " )
[4213]	1736
	1737	! del dimension
	1738	DO ji=ip_maxdim,1,-1
	1739	CALL dim_clean( td_dom%t_dim0(ji) )
	1740	ENDDO
	1741
	1742	! replace by empty structure
	1743	td_dom=tl_dom
	1744
[5037]	1745	END SUBROUTINE dom_clean
[4213]	1746	END MODULE dom

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

Download in other formats: