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

Context Navigation

source: utils/tools/SIREN/src/domain.f90 @ 12491

Last change on this file since 12491 was 12080, checked in by jpaul, 4 years ago
update nemo trunk
File size: 66.2 KB

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

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

Download in other formats: