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

Line
1	!----------------------------------------------------------------------
2	! NEMO system team, System and Interface for oceanic RElocable Nesting
3	!----------------------------------------------------------------------
4	!
5	! DESCRIPTION:
6	!> @brief
7	!> This module manage domain computation.
8	!>
9	!> @details
10	!> define type TDOM:<br/>
11	!> @code
12	!> TYPE(TDOM) :: tl_dom
13	!> @endcode
14	!>
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
28	!>
29	!> to get NEMO periodicity index of global domain:<br/>
30	!> - tl_dom\%i_perio0
31	!>
32	!> to get NEMO pivot point index F(0),T(1):<br/>
33	!> - tl_dom\%i_pivot
34	!>
35	!> to get East-West overlap of global domain:<br/>
36	!> - tl_dom\%i_ew0
37	!>
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	!>
117	!> @author
118	!> J.Paul
119	!>
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
126	!>
127	!> @note Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
128	!----------------------------------------------------------------------
129	MODULE dom
130
131	USE kind ! F90 kind parameter
132	USE global ! global parameter
133	USE fct ! basic useful function
134	USE logger ! log file manager
135	USE dim ! dimension manager
136	USE var ! variable manager
137	USE mpp ! mpp file manager
138
139	IMPLICIT NONE
140	! NOTE_avoid_public_variables_if_possible
141
142	! type and variable
143	PUBLIC :: TDOM !< domain structure
144
145	PRIVATE :: im_minext !< default minumum number of extraband
146
147	! function and subroutine
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
155
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
175
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
187
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
195
196	INTEGER(i4), DIMENSION(2) :: i_iextra = 0 !< i-direction extra point
197	INTEGER(i4), DIMENSION(2) :: i_jextra = 0 !< j-direction extra point
198
199	END TYPE TDOM
200
201	INTEGER(i4), PARAMETER :: im_minext = 2 !< default minumum number of extraband
202
203	INTERFACE dom_init
204	MODULE PROCEDURE dom__init_file
205	MODULE PROCEDURE dom__init_mpp
206	END INTERFACE dom_init
207
208	INTERFACE dom_copy
209	MODULE PROCEDURE dom__copy_unit ! copy attribute structure
210	END INTERFACE
211
212	CONTAINS
213	!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
214	FUNCTION dom__copy_unit(td_dom) &
215	& RESULT (tf_dom)
216	!-------------------------------------------------------------------
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	!-------------------------------------------------------------------
234
235	IMPLICIT NONE
236
237	! Argument
238	TYPE(TDOM), INTENT(IN) :: td_dom
239
240	! function
241	TYPE(TDOM) :: tf_dom
242
243	! local variable
244	!----------------------------------------------------------------
245
246	tf_dom=td_dom
247
248	END FUNCTION dom__copy_unit
249	!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
250	SUBROUTINE dom_print(td_dom)
251	!-------------------------------------------------------------------
252	!> @brief This subroutine print some information about domain strucutre.
253	!>
254	!> @author J.Paul
255	!> @date November, 2013 - Initial Version
256	!>
257	!> @param[inout] td_dom dom structure
258	!-------------------------------------------------------------------
259
260	IMPLICIT NONE
261
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
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)))') &
279	& " global domain size ",td_dom%t_dim0(:)%i_len, &
280	& " domain periodicity ",td_dom%i_perio0,", pivot: ",TRIM(cl_pivot), &
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,:), &
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, &
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(:)
293
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)
298	!-------------------------------------------------------------------
299	!> @brief
300	!> This function intialise domain structure, given open file structure,
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.
305	!>
306	!> @author J.Paul
307	!> @date June, 2013 - Initial Version
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)
321	!> @return domain structure
322	!-------------------------------------------------------------------
323
324	IMPLICIT NONE
325
326	! Argument
327	TYPE(TMPP) , INTENT(IN) :: td_mpp
328
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
335
336	! function
337	TYPE(TDOM) :: tf_dom
338
339	!local variable
340	!----------------------------------------------------------------
341
342	! clean domain structure
343	CALL dom_clean(tf_dom)
344
345	IF( .NOT. ASSOCIATED(td_mpp%t_proc) )THEN
346
347	CALL logger_error( &
348	& " DOM INIT: no processor file associated to mpp "//&
349	& TRIM(td_mpp%c_name))
350
351	ELSE
352	! global domain define by file
353
354	! look for boundary index
355	IF( PRESENT(cd_card) )THEN
356	SELECT CASE(TRIM(cd_card))
357	CASE('north')
358	tf_dom%i_bdy=jp_north
359	CASE('south')
360	tf_dom%i_bdy=jp_south
361	CASE('east')
362	tf_dom%i_bdy=jp_east
363	CASE('west')
364	tf_dom%i_bdy=jp_west
365	CASE DEFAULT
366	! no boundary
367	tf_dom%i_bdy=0
368	END SELECT
369	ELSE
370	! no boundary
371	tf_dom%i_bdy=0
372	ENDIF
373
374	! use global dimension define by mpp file
375	tf_dom%t_dim0(:) = dim_copy(td_mpp%t_dim(:))
376
377	IF( td_mpp%i_perio < 0 .OR. td_mpp%i_perio > 6 )THEN
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")
381	ELSE
382	tf_dom%i_perio0=td_mpp%i_perio
383	ENDIF
384
385	! global domain pivot point
386	SELECT CASE(tf_dom%i_perio0)
387	CASE(3,4)
388	tf_dom%i_pivot = 0
389	CASE(5,6)
390	tf_dom%i_pivot = 1
391	CASE DEFAULT
392	tf_dom%i_pivot = 0
393	END SELECT
394
395	! add ghost cell factor of global domain
396	tf_dom%i_ghost0(:,:)=0
397	SELECT CASE(tf_dom%i_perio0)
398	CASE(0)
399	tf_dom%i_ghost0(:,:)=1
400	CASE(1)
401	tf_dom%i_ghost0(jp_J,:)=1
402	CASE(2)
403	tf_dom%i_ghost0(jp_I,:)=1
404	tf_dom%i_ghost0(jp_J,2)=1
405	CASE(3,5)
406	tf_dom%i_ghost0(jp_I,:)=1
407	tf_dom%i_ghost0(jp_J,1)=1
408	CASE(4,6)
409	tf_dom%i_ghost0(jp_J,1)=1
410	END SELECT
411
412	! look for EW overlap
413	tf_dom%i_ew0=td_mpp%i_ew
414
415	! initialise domain as global
416	tf_dom%i_imin = 1
417	tf_dom%i_imax = tf_dom%t_dim0(1)%i_len
418
419	tf_dom%i_jmin = 1
420	tf_dom%i_jmax = tf_dom%t_dim0(2)%i_len
421
422	! sub domain dimension
423	tf_dom%t_dim(:) = dim_copy(td_mpp%t_dim(:))
424
425	! define sub domain indices
426	CALL dom__define(tf_dom, id_imin, id_imax, id_jmin, id_jmax)
427
428	ENDIF
429
430	END FUNCTION dom__init_mpp
431	!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
432	FUNCTION dom__init_file(td_file, id_imin, id_imax, id_jmin, id_jmax, cd_card) &
433	& RESULT (tf_dom)
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.
441	!>
442	!> @author J.Paul
443	!> @date June, 2013 - Initial Version
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	!-------------------------------------------------------------------
457
458	IMPLICIT NONE
459
460	! Argument
461	TYPE(TFILE) , INTENT(IN) :: td_file
462
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
467
468	CHARACTER(LEN=*) , INTENT(IN), OPTIONAL :: cd_card
469
470	! function
471	TYPE(TDOM) :: tf_dom
472
473	!local variable
474	!----------------------------------------------------------------
475
476	! clean domain structure
477	CALL dom_clean(tf_dom)
478
479	IF( td_file%i_id == 0 )THEN
480
481	CALL logger_error( &
482	& " DOM INIT: no id associated to file "//TRIM(td_file%c_name))
483
484	ELSE
485	! global domain define by file
486
487	! look for boundary index
488	IF( PRESENT(cd_card) )THEN
489	SELECT CASE(TRIM(cd_card))
490	CASE('north')
491	tf_dom%i_bdy=jp_north
492	CASE('south')
493	tf_dom%i_bdy=jp_south
494	CASE('east')
495	tf_dom%i_bdy=jp_east
496	CASE('west')
497	tf_dom%i_bdy=jp_west
498	CASE DEFAULT
499	! no boundary
500	tf_dom%i_bdy=0
501	END SELECT
502	ELSE
503	! no boundary
504	tf_dom%i_bdy=0
505	ENDIF
506
507	! use global dimension define by file
508	tf_dom%t_dim0(:) = dim_copy(td_file%t_dim(:))
509
510	IF( td_file%i_perio < 0 .OR. td_file%i_perio > 6 )THEN
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")
514	ELSE
515	tf_dom%i_perio0=td_file%i_perio
516	ENDIF
517
518	! global domain pivot point
519	SELECT CASE(tf_dom%i_perio0)
520	CASE(3,4)
521	tf_dom%i_pivot = 0
522	CASE(5,6)
523	tf_dom%i_pivot = 1
524	CASE DEFAULT
525	tf_dom%i_pivot = 0
526	END SELECT
527
528	! add ghost cell factor of global domain
529	tf_dom%i_ghost0(:,:)=0
530	SELECT CASE(tf_dom%i_perio0)
531	CASE(0)
532	tf_dom%i_ghost0(:,:)=1
533	CASE(1)
534	tf_dom%i_ghost0(jp_J,:)=1
535	CASE(2)
536	tf_dom%i_ghost0(jp_I,:)=1
537	tf_dom%i_ghost0(jp_J,2)=1
538	CASE(3,5)
539	tf_dom%i_ghost0(jp_I,:)=1
540	tf_dom%i_ghost0(jp_J,1)=1
541	CASE(4,6)
542	tf_dom%i_ghost0(jp_J,1)=1
543	END SELECT
544
545	! look for EW overlap
546	tf_dom%i_ew0=td_file%i_ew
547
548	! initialise domain as global
549	tf_dom%i_imin = 1
550	tf_dom%i_imax = tf_dom%t_dim0(1)%i_len
551
552	tf_dom%i_jmin = 1
553	tf_dom%i_jmax = tf_dom%t_dim0(2)%i_len
554
555	! sub domain dimension
556	tf_dom%t_dim(:) = dim_copy(td_file%t_dim(:))
557
558	! define sub domain indices
559	CALL dom__define(tf_dom, id_imin, id_imax, id_jmin, id_jmax)
560
561	ENDIF
562
563	END FUNCTION dom__init_file
564	!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
565	SUBROUTINE dom__define(td_dom, &
566	& id_imin, id_imax, id_jmin, id_jmax)
567	!-------------------------------------------------------------------
568	!> @brief
569	!> This subroutine define sub domain indices, and compute the size
570	!> of the sub domain.
571	!>
572	!> @author J.Paul
573	!> @date November, 2013 - Initial version
574	!>
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
580	!-------------------------------------------------------------------
581
582	IMPLICIT NONE
583
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
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))//") < "//&
604	& TRIM(fct_str(td_dom%t_dim0(1)%i_len)))
605	CALL logger_debug("0 <= imax ("//TRIM(fct_str(id_imax))//") < "//&
606	& TRIM(fct_str(td_dom%t_dim0(1)%i_len)))
607	CALL logger_debug("0 <= jmin ("//TRIM(fct_str(id_jmin))//") < "//&
608	& TRIM(fct_str(td_dom%t_dim0(2)%i_len)))
609	CALL logger_debug("0 <= jmax ("//TRIM(fct_str(id_jmax))//") < "//&
610	& TRIM(fct_str(td_dom%t_dim0(2)%i_len)))
611	CALL logger_fatal( "DOM INIT DEFINE: invalid grid definition."// &
612	& " check min and max indices")
613	ELSE
614
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
622
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
634	SELECT CASE(td_dom%i_perio0)
635	CASE(0) ! closed boundary
636	CALL logger_trace("DOM INIT DEFINE: closed boundary")
637	CALL dom__define_closed( td_dom )
638	CASE(1) ! cyclic east-west boundary
639	CALL logger_trace("DOM INIT DEFINE: cyclic east-west boundary")
640	CALL dom__define_cyclic( td_dom )
641	CASE(2) ! symmetric boundary condition across the equator
642	CALL logger_trace("DOM INIT DEFINE: symmetric boundary condition "//&
643	& " across the equator")
644	CALL dom__define_symmetric( td_dom )
645	CASE(3) ! North fold boundary (with a F-point pivot)
646	CALL logger_trace("DOM INIT DEFINE: North fold boundary "//&
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)
650	CALL logger_trace("DOM INIT DEFINE: North fold boundary "//&
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
655	CALL logger_trace("DOM INIT DEFINE: North fold boundary "//&
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
661	CALL logger_trace("DOM INIT DEFINE: North fold boundary "//&
662	& "(with a T-point pivot) and cyclic "//&
663	& "east-west boundary")
664	CALL dom__define_cyclic_north_fold( td_dom )
665	CASE DEFAULT
666	CALL logger_error("DOM INIT DEFINE: invalid grid periodicity index")
667	END SELECT
668
669	ENDIF
670
671	END SUBROUTINE dom__define
672	!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
673	SUBROUTINE dom__define_cyclic_north_fold(td_dom)
674	!-------------------------------------------------------------------
675	!> @brief
676	!> This subroutine define sub domain indices from global domain with
677	!> cyclic east-west boundary and north fold boundary condition.
678	!>
679	!> @author J.Paul
680	!> @date November, 2013 - Initial version
681	!> @date September, 2014
682	!> - use zero indice to defined cyclic or global domain
683	!>
684	!> @param[inout] td_dom domain strcuture
685	!-------------------------------------------------------------------
686
687	IMPLICIT NONE
688
689	! Argument
690	TYPE(TDOM), INTENT(INOUT) :: td_dom
691	!----------------------------------------------------------------
692
693	!CALL dom__check_EW_index( td_dom )
694
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
697
698	CALL logger_trace("DOM DEFINE CYCLIC NORTH FOLD: "//&
699	& "domain to extract is global" )
700	! coarse domain is global domain
701
702	CALL dom__size_global( td_dom )
703
704	ELSEIF( td_dom%i_imin == 0 .AND. td_dom%i_imax == 0 .AND. &
705	& td_dom%i_jmax == 0 )THEN
706
707	CALL logger_trace("DOM DEFINE CYCLIC NORTH FOLD: "//&
708	& "domain to extract is semi-global" )
709
710	CALL dom__size_semi_global( td_dom )
711
712	ELSEIF( td_dom%i_imin == 0 .AND. td_dom%i_imax == 0 .AND. &
713	& td_dom%i_jmax /= 0 )THEN
714
715	CALL logger_trace("DOM DEFINE CYCLIC NORTH FOLD: "//&
716	& "domain to extract is band of latidue" )
717
718	CALL dom__size_no_pole( td_dom )
719
720	ELSEIF( td_dom%i_jmax == 0 )THEN
721
722	CALL logger_trace("DOM DEFINE CYCLIC NORTH FOLD: "//&
723	& "domain to extract use north fold" )
724
725	CALL dom__size_pole( td_dom )
726
727	ELSEIF( td_dom%i_jmax /= 0 )THEN
728
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 )
734
735	ELSE
736
737	CALL logger_error("DOM DEFINE CYCLIC NORTH FOLD: "//&
738	& "should have been an impossible case" )
739
740	ENDIF
741
742	END SUBROUTINE dom__define_cyclic_north_fold
743	!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
744	SUBROUTINE dom__define_north_fold(td_dom)
745	!-------------------------------------------------------------------
746	!> @brief
747	!> This subroutine define sub domain indices from global domain
748	!> with north fold boundary condition.
749	!>
750	!> @author J.Paul
751	!> @date November, 2013 - Initial verison
752	!>
753	!> @param[inout] td_dom domain strcuture
754	!-------------------------------------------------------------------
755
756	IMPLICIT NONE
757
758	! Argument
759	TYPE(TDOM), INTENT(INOUT) :: td_dom
760	!----------------------------------------------------------------
761
762	IF( td_dom%i_jmax /= 0 )THEN
763
764	CALL logger_trace("DOM DEFINE NORTH FOLD: "//&
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
772	CALL logger_trace("DOM DEFINE NORTH FOLD: "//&
773	& "sub domain has north boundary" )
774
775	CALL dom__size_pole_no_overlap( td_dom )
776
777	ENDIF
778
779	END SUBROUTINE dom__define_north_fold
780	!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
781	SUBROUTINE dom__define_symmetric(td_dom)
782	!-------------------------------------------------------------------
783	!> @brief
784	!> This subroutine define sub domain indices from global domain
785	!> with symmetric boundary condition across the equator.
786	!>
787	!> @author J.Paul
788	!> @date November, 2013 - Initial version
789	!>
790	!> @param[inout] td_dom domain strcuture
791	!-------------------------------------------------------------------
792
793	IMPLICIT NONE
794
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
802	!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
803	SUBROUTINE dom__define_cyclic(td_dom)
804	!-------------------------------------------------------------------
805	!> @brief
806	!> This subroutine define sub domain indices from global domain
807	!> with cyclic east-west boundary.
808	!>
809	!> @author J.Paul
810	!> @date November, 2013 - Initial version
811	!>
812	!> @param[inout] td_dom domain strcuture
813	!-------------------------------------------------------------------
814
815	IMPLICIT NONE
816
817	! Argument
818	TYPE(TDOM), INTENT(INOUT) :: td_dom
819	!----------------------------------------------------------------
820
821	IF( td_dom%i_imin >= td_dom%i_imax )THEN
822	CALL logger_trace("DOM DEFINE CYCLIC: "//&
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
829	CALL logger_trace("DOM DEFINE CYCLIC: "//&
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
837	!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
838	SUBROUTINE dom__define_closed(td_dom)
839	!-------------------------------------------------------------------
840	!> @brief
841	!> This subroutine define sub domain indices from global domain
842	!> with closed boundaries.
843	!>
844	!> @author J.Paul
845	!> @date November, 2013 - Initial version
846	!>
847	!> @param[inout] td_dom domain strcuture
848	!-------------------------------------------------------------------
849
850	IMPLICIT NONE
851
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
859	!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
860	SUBROUTINE dom__size_global(td_dom)
861	!-------------------------------------------------------------------
862	!> @brief
863	!> This subroutine compute size of global domain
864	!>
865	!> @author J.Paul
866	!> @date November, 2013 - Initial version
867	!>
868	!> @param[inout] td_dom domain strcuture
869	!-------------------------------------------------------------------
870
871	IMPLICIT NONE
872
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
888	td_dom%i_ghost(:,:)=0
889
890	! periodicity
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
900	!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
901	SUBROUTINE dom__size_semi_global(td_dom)
902	!-------------------------------------------------------------------
903	!> @brief
904	!> This subroutine compute size of a semi global domain
905	!>
906	!> @author J.Paul
907	!> @date November, 2013 - Initial version
908	!>
909	!> @param[inout] td_dom domain strcuture
910	!> @note never tested
911	!-------------------------------------------------------------------
912
913	IMPLICIT NONE
914
915	! Argument
916	TYPE(TDOM), INTENT(INOUT) :: td_dom
917
918	! local variable
919	INTEGER(i4) :: il_imid ! canadian bipole index (middle of global domain)
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
927	IF( td_dom%i_jmin == 0 ) td_dom%i_jmin=1
928	td_dom%i_jmax = td_dom%t_dim0(2)%i_len
929
930	! domain size
931	td_dom%t_dim(1)%i_len = td_dom%i_imax - &
932	& td_dom%i_imin + 1
933
934	td_dom%t_dim(2)%i_len = ( td_dom%t_dim0(2)%i_len - &
935	& td_dom%i_jmin + 1 ) + &
936	& ( td_dom%t_dim0(2)%i_len - &
937	& td_dom%i_jmin + 1 ) - 2 ! remove north fold condition ?
938
939	! ghost cell to add
940	td_dom%i_ghost(:,:)=1
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
952	!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
953	SUBROUTINE dom__size_no_pole(td_dom)
954	!-------------------------------------------------------------------
955	!> @brief
956	!> This subroutine compute size of sub domain without north fold
957	!> condition
958	!>
959	!> @author J.Paul
960	!> @date November, 2013 - Initial version
961	!>
962	!> @param[inout] td_dom domain strcuture
963	!-------------------------------------------------------------------
964
965	IMPLICIT NONE
966
967	! Argument
968	TYPE(TDOM), INTENT(INOUT) :: td_dom
969	!----------------------------------------------------------------
970
971	IF( td_dom%i_jmax == 0 )THEN
972	CALL logger_fatal("DOM SIZE NO POLE: invalid domain. "//&
973	& "can not get north pole from this coarse grid. "//&
974	& "check namelist and coarse grid periodicity." )
975	ENDIF
976
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: "// &
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
986	CALL logger_trace("DOM SIZE NO POLE: "// &
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
994	!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
995	SUBROUTINE dom__size_pole(td_dom)
996	!-------------------------------------------------------------------
997	!> @brief
998	!> This subroutine compute size of sub domain with north fold
999	!> condition.
1000	!>
1001	!> @author J.Paul
1002	!> @date April, 2013 - Initial version
1003	!>
1004	!> @param[inout] td_dom domain strcuture
1005	!> @note never tested
1006	!-------------------------------------------------------------------
1007
1008	IMPLICIT NONE
1009
1010	! Argument
1011	TYPE(TDOM), INTENT(INOUT) :: td_dom
1012	!----------------------------------------------------------------
1013
1014	IF( td_dom%i_imin >= td_dom%i_imax )THEN
1015	CALL logger_trace("DOM SIZE POLE: "//&
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
1019	CALL logger_trace("DOM SIZE POLE: "//&
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
1025	!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1026	SUBROUTINE dom__size_no_pole_overlap(td_dom)
1027	!-------------------------------------------------------------------
1028	!> @brief
1029	!> This subroutine compute size of sub domain without north fold
1030	!> condition, and which overlap east-west boundary
1031	!>
1032	!> @author J.Paul
1033	!> @date November, 2013 - Initial version
1034	!>
1035	!> @param[inout] td_dom domain strcuture
1036	!-------------------------------------------------------------------
1037
1038	IMPLICIT NONE
1039
1040	! Argument
1041	TYPE(TDOM), INTENT(INOUT) :: td_dom
1042	!----------------------------------------------------------------
1043
1044	IF( td_dom%i_jmax == 0 )THEN
1045	CALL logger_fatal("DOM SIZE NO POLE OVERLAP: invalid domain. "//&
1046	& "can not get north pole from this coarse grid. "//&
1047	& "check namelist and coarse grid periodicity." )
1048	ENDIF
1049
1050	IF( td_dom%i_imin == 0 .AND. td_dom%i_imax == 0 )THEN
1051	! domain to extract with east west cyclic boundary
1052	CALL logger_trace("DOM SIZE NO POLE OVERLAP: "//&
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
1061	td_dom%i_ghost(jp_I,:)=0
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
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
1074
1075	! add ghost cell
1076	td_dom%i_ghost(jp_I,:)=1
1077
1078	! periodicity
1079	td_dom%i_perio=0
1080
1081	ENDIF
1082
1083	td_dom%t_dim(2)%i_len = td_dom%i_jmax - &
1084	& td_dom%i_jmin + 1
1085
1086	! add ghost cell
1087	td_dom%i_ghost(jp_J,:)=1
1088
1089	END SUBROUTINE dom__size_no_pole_overlap
1090	!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1091	SUBROUTINE dom__size_no_pole_no_overlap(td_dom)
1092	!-------------------------------------------------------------------
1093	!> @brief
1094	!> This subroutine compute size of sub domain without north fold
1095	!> condition, and which do not overlap east-west boundary
1096	!>
1097	!> @author J.Paul
1098	!> @date November, 2013 - Initial version
1099	!>
1100	!> @param[inout] td_dom domain strcuture
1101	!-------------------------------------------------------------------
1102
1103	IMPLICIT NONE
1104
1105	! Argument
1106	TYPE(TDOM), INTENT(INOUT) :: td_dom
1107	!----------------------------------------------------------------
1108
1109	IF( td_dom%i_jmax == 0 )THEN
1110	CALL logger_fatal("DOM SIZE NO POLE NO OVERLAP: invalid domain. "//&
1111	& "can not get north pole from this coarse grid. "//&
1112	& "check domain indices and grid periodicity." )
1113	ENDIF
1114
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. "//&
1117	& "can not overlap East-West boundary with this coarse grid. "//&
1118	& "check domain indices and grid periodicity." )
1119	ENDIF
1120
1121	td_dom%t_dim(1)%i_len = td_dom%i_imax - &
1122	& td_dom%i_imin + 1
1123
1124	td_dom%t_dim(2)%i_len = td_dom%i_jmax - &
1125	& td_dom%i_jmin + 1
1126
1127	! add ghost cell
1128	td_dom%i_ghost(:,:)=1
1129
1130	! periodicity
1131	td_dom%i_perio=0
1132
1133	END SUBROUTINE dom__size_no_pole_no_overlap
1134	!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1135	SUBROUTINE dom__size_pole_overlap(td_dom)
1136	!-------------------------------------------------------------------
1137	!> @brief
1138	!> This subroutine compute size of sub domain with north fold
1139	!> condition, and which overlap east-west boundary
1140	!>
1141	!> @author J.Paul
1142	!> @date November, 2013 - Initial version
1143	!>
1144	!> @param[inout] td_dom domain strcuture
1145	!> @note never tested
1146	!-------------------------------------------------------------------
1147
1148	IMPLICIT NONE
1149
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
1159	CALL logger_trace("DOM SIZE POLE OVERLAP: "//&
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
1169	CALL logger_trace("DOM SIZE POLE OVERLAP: "//&
1170	& "canadian bipole inside domain to extract")
1171	td_dom%i_imin = 0
1172	td_dom%i_imax = 0
1173
1174	IF( td_dom%i_jmin == 0 .AND. td_dom%i_jmax == 0 )THEN
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
1186	CALL logger_trace("DOM SIZE POLE OVERLAP: east part bigger than west part ")
1187	! to respect symmetry around asian bipole
1188	td_dom%i_imax = il_idom1
1189
1190	IF( td_dom%i_jmin == 0 ) td_dom%i_jmin = 1
1191	! north pole
1192	td_dom%i_jmax = td_dom%t_dim0(2)%i_len
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 - &
1197	& td_dom%i_jmin + 1 ) + &
1198	& ( td_dom%t_dim0(2)%i_len - &
1199	& td_dom%i_jmin + 1 ) - 2 ! remove north fold condition ?
1200
1201	! add ghost cell
1202	td_dom%i_ghost(:,:)=1
1203
1204	! periodicity
1205	td_dom%i_perio=0
1206
1207	ELSE ! il_idom2 >= il_idom1
1208
1209	! west part bigger than east part
1210	CALL logger_trace("DOM SIZE POLE OVERLAP: west part bigger than east part ")
1211
1212	! to respect symmetry around asian bipole
1213	td_dom%i_imin = td_dom%t_dim0(1)%i_len - il_idom2 + 1
1214
1215	IF( td_dom%i_jmin == 0 ) td_dom%i_jmin = 1
1216	! north pole
1217	td_dom%i_jmax=td_dom%t_dim0(2)%i_len
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 - &
1222	& td_dom%i_jmin + 1 ) + &
1223	& ( td_dom%t_dim0(2)%i_len - &
1224	& td_dom%i_jmin + 1 ) - 2
1225
1226	! add ghost cell
1227	td_dom%i_ghost(:,:)=1
1228
1229	! periodicity
1230	td_dom%i_perio=0
1231
1232	ENDIF
1233
1234	END SUBROUTINE dom__size_pole_overlap
1235	!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1236	SUBROUTINE dom__size_pole_no_overlap(td_dom)
1237	!-------------------------------------------------------------------
1238	!> @brief
1239	!> This subroutine compute size of sub domain with north fold
1240	!> condition, and which do not overlap east-west boundary
1241	!>
1242	!> @author J.Paul
1243	!> @date November, 2013 - Initial version
1244	!>
1245	!> @param[inout] td_dom domain strcuture
1246	!> @note never tested
1247	!-------------------------------------------------------------------
1248
1249	IMPLICIT NONE
1250
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
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. "//&
1263	& "can not overlap East-West boundary with this coarse grid. "//&
1264	& "check namelist and coarse grid periodicity." )
1265	ENDIF
1266
1267	CALL logger_trace("DOM SIZE POLE NO OVERLAP: "//&
1268	& "no asian bipole inside domain to extract")
1269
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
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
1278	CALL logger_trace("DOM SIZE POLE NO OVERLAP: "//&
1279	& "no canadian bipole inside domain to extract")
1280
1281	td_dom%t_dim(1)%i_len = td_dom%i_imax - &
1282	& td_dom%i_imin + 1
1283
1284	td_dom%t_dim(2)%i_len = ( td_dom%t_dim0(2)%i_len - &
1285	& td_dom%i_jmin + 1 ) + &
1286	& ( td_dom%t_dim0(2)%i_len - &
1287	& td_dom%i_jmin + 1 ) - 2 ! remove north fold condition ?
1288
1289	! add ghost cell
1290	td_dom%i_ghost(:,:)=1
1291
1292	! periodicity
1293	td_dom%i_perio=0
1294
1295	ELSE ! id_imin < il_mid .AND. id_imax > il_mid
1296	CALL logger_trace("DOM SIZE POLE NO OVERLAP: "//&
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
1303	CALL logger_trace("DOM SIZE POLE NO OVERLAP: east part bigger than west part ")
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 - &
1309	& td_dom%i_jmin + 1 ) + &
1310	& ( td_dom%t_dim0(2)%i_len - &
1311	& td_dom%i_jmin + 1 ) &
1312	& - 2 - 2 * td_dom%i_pivot ! remove north fold condition ?
1313
1314	! add ghost cell
1315	td_dom%i_ghost(:,:)=1
1316
1317	! periodicity
1318	td_dom%i_perio=0
1319
1320	ELSE ! il_idom2 >= il_idom1
1321	! west part bigger than east part
1322	CALL logger_trace("DOM SIZE POLE NO OVERLAP: west part bigger than east part ")
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 - &
1329	& td_dom%i_jmin + 1 ) + &
1330	& ( td_dom%t_dim0(2)%i_len - &
1331	& td_dom%i_jmax + 1 ) &
1332	& - 2 - 2 * td_dom%i_pivot ! remove north fold condition ?
1333
1334	! add ghost cell
1335	td_dom%i_ghost(:,:)=1
1336
1337	! periodicity
1338	td_dom%i_perio=0
1339
1340	ENDIF
1341	ENDIF
1342
1343	END SUBROUTINE dom__size_pole_no_overlap
1344	!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1345	SUBROUTINE dom_add_extra(td_dom, id_iext, id_jext)
1346	!-------------------------------------------------------------------
1347	!> @brief
1348	!> This subroutine add extra bands to coarse domain to get enough point for
1349	!> interpolation...
1350	!>
1351	!> @details
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	!>
1357	!> @author J.Paul
1358	!> @date November, 2013 - Initial version
1359	!> @date September, 2014
1360	!> - take into account number of ghost cell
1361	!> @date February, 2016
1362	!> - number of extra point is the MAX (not the MIN) of zero and asess value.
1363	!>
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)
1367	!-------------------------------------------------------------------
1368
1369	IMPLICIT NONE
1370
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
1399
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
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
1411	td_dom%i_iextra(1) = MAX(0, &
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
1416
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
1423	td_dom%i_iextra(2) = MAX( 0, &
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
1429
1430	ELSE ! td_dom%i_ew0 >= 0
1431
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
1441	ENDIF
1442
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
1451	ENDIF
1452
1453	ENDIF
1454
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
1458	ELSE
1459
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
1464	td_dom%i_jextra(1) = MAX( 0, &
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)
1468	ENDIF
1469
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
1476	td_dom%i_jextra(2) = MAX( 0, &
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)
1481	ENDIF
1482	ENDIF
1483
1484	ENDIF
1485
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
1492	ENDIF
1493
1494	td_dom%t_dim(2)%i_len = td_dom%i_jmax-td_dom%i_jmin+1
1495
1496
1497	END SUBROUTINE dom_add_extra
1498	!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1499	SUBROUTINE dom_clean_extra(td_dom)
1500	!-------------------------------------------------------------------
1501	!> @brief
1502	!> This subroutine clean coarse grid domain structure.
1503	!> it remove extra point added.
1504	!>
1505	!> @author J.Paul
1506	!> @date November, 2013 - Initial version
1507	!>
1508	!> @param[inout] td_dom domain strcuture
1509	!-------------------------------------------------------------------
1510
1511	IMPLICIT NONE
1512
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
1538	!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1539	SUBROUTINE dom_del_extra(td_var, td_dom, id_rho, ld_coord)
1540	!-------------------------------------------------------------------
1541	!> @brief
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	!>
1551	!> @author J.Paul
1552	!> @date November, 2013 - Initial version
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.
1557	!>
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
1562	!-------------------------------------------------------------------
1563
1564	IMPLICIT NONE
1565
1566	! Argument
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
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
1581	INTEGER(i4), DIMENSION(2) :: il_rho
1582	INTEGER(i4), DIMENSION(2,2) :: il_ghost
1583
1584	REAL(dp) , DIMENSION(:,:,:,:), ALLOCATABLE :: dl_value
1585
1586	LOGICAL :: ll_coord
1587	! loop indices
1588	!----------------------------------------------------------------
1589
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
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
1605	! get variable right domain
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
1614	il_iextra=SUM(td_dom%i_iextra(:))*il_rho(jp_I)
1615	il_jextra=SUM(td_dom%i_jextra(:))*il_rho(jp_J)
1616
1617	il_ghost(:,:)=0
1618	IF( ll_coord )THEN
1619	il_ghost(:,:)=td_dom%i_ghost(:,:)
1620	ENDIF
1621
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)
1625
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
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
1787	!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1788	SUBROUTINE dom_clean(td_dom)
1789	!-------------------------------------------------------------------
1790	!> @brief
1791	!> This subroutine clean domain structure.
1792	!>
1793	!> @author J.Paul
1794	!> @date November, 2013 - Initial version
1795	!>
1796	!> @param[inout] td_dom domain strcuture
1797	!-------------------------------------------------------------------
1798
1799	IMPLICIT NONE
1800
1801	! Argument
1802	TYPE(TDOM), INTENT(INOUT) :: td_dom
1803
1804	! local variable
1805	TYPE(TDOM) :: tl_dom ! empty dom structure
1806
1807	! loop indices
1808	INTEGER(i4) :: ji
1809	!----------------------------------------------------------------
1810
1811	CALL logger_info( "DOM CLEAN: reset domain " )
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
1821	END SUBROUTINE dom_clean
1822	!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1823	END MODULE dom

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

Download in other formats: