source: branches/2014/dev_r4650_UKMO14.12_STAND_ALONE_OBSOPER/NEMOGCM/TOOLS/SIREN/src/domain.f90 @ 5600

Last change on this file since 5600 was 5600, checked in by andrewryan, 5 years ago

merged in latest version of trunk alongside changes to SAO_SRC to be compatible with latest OBS

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