New URL for NEMO forge!   http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
domain.f90 in branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/TOOLS/SIREN/src – NEMO

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

Last change on this file since 10248 was 10248, checked in by kingr, 5 years ago

Merged 2015/nemo_v3_6_STABLE@6232

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