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.
Changeset 6225 for branches/2014/dev_r4704_NOC5_MPP_BDY_UPDATE/NEMOGCM/TOOLS/SIREN/src/domain.f90 – NEMO

Ignore:
Timestamp:
2016-01-08T10:35:19+01:00 (8 years ago)
Author:
jamesharle
Message:

Update MPP_BDY_UPDATE branch to be consistent with head of trunk

File:
1 edited

Legend:

Unmodified
Added
Removed

  • branches/2014/dev_r4704_NOC5_MPP_BDY_UPDATE/NEMOGCM/TOOLS/SIREN/src/domain.f90

    r4213 r6225  
    88!> @brief 
    99!> This module manage domain computation. 
    10 ! 
     10!> 
    1111!> @details 
    12 !> 
    13 !> 
    14 !> 
    15 !> 
     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 
    16118!> 
    17119!> @author 
    18120!> J.Paul 
    19121! REVISION HISTORY: 
    20 !> @date Nov, 2013 - Initial Version 
    21 !> @todo 
    22 !> - check use of id_pivot 
     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 
    23128!>  
    24129!> @note Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    … …  
    28133   USE global                          ! global parameter 
    29134   USE fct                             ! basic useful function 
    30    USE logger                             ! log file manager 
     135   USE logger                          ! log file manager 
    31136   USE dim                             ! dimension manager 
    32137   USE var                             ! variable manager 
    33    USE file                            ! file manager 
     138   USE mpp                             ! mpp file manager 
    34139   IMPLICIT NONE 
    35    PRIVATE 
    36140   ! NOTE_avoid_public_variables_if_possible 
    37141 
    … …  
    39143   PUBLIC :: TDOM     !< domain structure 
    40144 
     145   PRIVATE :: im_minext !< default minumum number of extraband 
     146 
    41147   ! function and subroutine 
    42    PUBLIc :: dom_clean     !< clean domain structure 
    43    PUBLIC :: dom_init      !< initialise domain structure 
    44    PUBLIC :: dom_print     !< print information about domain 
    45    PUBLIC :: dom_get_ew_overlap !< get east west overlap 
    46    PUBLIC :: dom_add_extra   !< add useful extra point to coarse grid for interpolation 
    47    PUBLIC :: dom_clean_extra  !< reset domain without extra point 
    48    PUBLIC :: dom_del_extra   !< remove extra point from fine grid after interpolation 
     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 
    49155     
    50    PRIVATE :: dom__define    !< define extract domain indices 
    51                                             !< define extract domain indices for input domain with 
    52    PRIVATE :: dom__define_cyclic_north_fold !< - cyclic east-west boundary and north fold boundary condition. 
    53    PRIVATE :: dom__define_north_fold        !< - north fold boundary condition. 
    54    PRIVATE :: dom__define_symmetric         !< - symmetric boundary condition across the equator. 
    55    PRIVATE :: dom__define_cyclic            !< - cyclic east-west boundary. 
    56    PRIVATE :: dom__define_closed            !< - cyclic east-west boundary. 
    57    PRIVATE :: dom__check_EW_index           !< check East-West indices 
    58                                             !< compute size of an extract domain 
    59    PRIVATE :: dom__size_no_pole             !< - without north fold condition 
    60    PRIVATE :: dom__size_no_pole_overlap     !< - without north fold condition, and which overlap east-west boundary 
    61    PRIVATE :: dom__size_no_pole_no_overlap  !< - without north fold condition, and which do not overlap east-west boundary 
    62    PRIVATE :: dom__size_pole                !< - with north fold condition 
    63    PRIVATE :: dom__size_pole_overlap        !< - with north fold condition, and which overlap east-west boundary 
    64    PRIVATE :: dom__size_pole_no_overlap     !< - with north fold condition, and which do not overlap east-west boundary 
    65  
    66    !> @struct 
    67    TYPE TDOM 
    68       TYPE(TDIM), DIMENSION(ip_maxdim)  :: t_dim0           !< global domain dimension 
    69       TYPE(TDIM), DIMENSION(ip_maxdim)  :: t_dim              !< sub domain dimension 
    70       INTEGER(i4) :: i_perio0   !< NEMO periodicity index 
    71       INTEGER(i4) :: i_ew0      !< East-West overlap 
    72       INTEGER(i4) :: i_perio    !< NEMO periodicity index 
    73       INTEGER(i4) :: i_pivot    !< NEMO pivot point index F(0),T(1) 
    74       INTEGER(i4) :: i_imin = 1 !< i-direction sub-domain lower left  point indice 
    75       INTEGER(i4) :: i_imax = 1 !< i-direction sub-domain upper right point indice 
    76       INTEGER(i4) :: i_jmin = 1 !< j-direction sub-domain lower left  point indice 
    77       INTEGER(i4) :: i_jmax = 1 !< j-direction sub-domain upper right point indice 
    78       INTEGER(i4) :: i_kmin = 1 !< k-direction sub-domain lower level indice 
    79       INTEGER(i4) :: i_kmax = 1 !< k-direction sub-domain upper level indice 
    80       INTEGER(i4) :: i_lmin = 1 !< l-direction sub-domain lower time indice 
    81       INTEGER(i4) :: i_lmax = 1 !< l-direction sub-domain upper time indice 
    82  
    83       INTEGER(i4) :: i_ighost = 0 !< i-direction ghost cell factor 
    84       INTEGER(i4) :: i_jghost = 0 !< j-direction ghost cell factor 
    85  
    86       INTEGER(i4), DIMENSION(2) :: i_iextra = 0 !< i-direction extra point 
    87       INTEGER(i4), DIMENSION(2) :: i_jextra = 0 !< j-direction extra point 
     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 
    88198 
    89199   END TYPE TDOM 
    … …  
    92202 
    93203   INTERFACE dom_init 
    94       MODULE PROCEDURE dom_init_file 
    95 !      MODULE PROCEDURE dom_init_mpp 
     204      MODULE PROCEDURE dom__init_file 
     205      MODULE PROCEDURE dom__init_mpp 
    96206   END INTERFACE dom_init 
    97207 
     208   INTERFACE dom_copy 
     209      MODULE PROCEDURE dom__copy_unit  ! copy attribute structure 
     210   END INTERFACE 
     211 
    98212CONTAINS 
    99213   !------------------------------------------------------------------- 
     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   !------------------------------------------------------------------- 
    100245   !> @brief This subroutine print some information about domain strucutre. 
    101246   ! 
    102247   !> @author J.Paul 
    103    !> - Nov, 2013- Initial Version 
    104    ! 
    105    !> @param[inout] td_dom : dom structure 
    106    !------------------------------------------------------------------- 
    107    !> @code 
     248   !> @date November, 2013 - Initial Version 
     249   ! 
     250   !> @param[inout] td_dom dom structure 
     251   !------------------------------------------------------------------- 
    108252   SUBROUTINE dom_print(td_dom) 
    109253      IMPLICIT NONE 
    … …  
    123267      END SELECT 
    124268 
    125       WRITE(*,'((a,4(i0,1x)),(/a,i2,a,a),(/a,4(i0,1x)),(/a,i2/),10(/a,i0))') & 
     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)))') & 
    126271      &  " global domain size ",td_dom%t_dim0(:)%i_len, & 
    127272      &  " 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,:), & 
    128275      &  " sub-domain size : ",td_dom%t_dim(:)%i_len,                         & 
    129276      &  " sub domain periodicity ",td_dom%i_perio,                           & 
    … …  
    132279      &  " j-direction sub-domain lower left  point indice ",td_dom%i_jmin,   & 
    133280      &  " j-direction sub-domain upper right point indice ",td_dom%i_jmax,   & 
    134 !      &  " k-direction sub-domain lower level indice       ",td_dom%i_kmin,   & 
    135 !      &  " k-direction sub-domain upper level indice       ",td_dom%i_kmax,   & 
    136 !      &  " l-direction sub-domain lower time indice        ",td_dom%i_lmin,   & 
    137 !      &  " l-direction sub-domain upper time indice        ",td_dom%i_lmax,   & 
    138       &  " i-direction ghost cell factor                   ",td_dom%i_ighost, & 
    139       &  " j-direction ghost cell factor                   ",td_dom%i_jghost 
     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(:) 
    140285 
    141286      END SUBROUTINE dom_print 
    142    !> @endcode 
    143287   !------------------------------------------------------------------- 
    144288   !> @brief  
    145289   !> This function intialise domain structure, given open file structure, 
    146    !> and grid periodicity.  
    147    ! 
    148    !> @author J.Paul 
    149    !> - June, 2013- Initial Version 
    150    ! 
    151    !> @param[in] td_file : file structure 
    152    !> @param[in] id_perio : grid periodicity 
    153    !> @param[in] id_imin : i-direction sub-domain lower left  point indice 
    154    !> @param[in] id_imax : i-direction sub-domain upper right point indice 
    155    !> @param[in] id_jmin : j-direction sub-domain lower left  point indice 
    156    !> @param[in] id_jmax : j-direction sub-domain upper right point indice 
    157    !> @param[in] id_kmin : k-direction sub-domain lower level indice 
    158    !> @param[in] id_kmax : k-direction sub-domain upper level indice 
    159    !> @param[in] id_lmin : l-direction sub-domain lower time indice 
    160    !> @param[in] id_lmax : l-direction sub-domain upper time indice 
     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) 
    161310   !> @return domain structure 
    162    !> 
    163    !> @todo 
    164    !> - initialiser domain 
    165    !> - add info new perio.. dans sortie 
    166    !------------------------------------------------------------------- 
    167    !> @code 
    168    TYPE(TDOM) FUNCTION dom_init_file( td_file, & 
    169    &                                  id_imin, id_imax, id_jmin, id_jmax ) 
    170 !   &                                  id_kmin, id_kmax, id_lmin, id_lmax ) 
    171       IMPLICIT NONE 
    172       ! Argument 
    173       TYPE(TFILE), INTENT(IN) :: td_file  
    174       INTEGER(i4), INTENT(IN), OPTIONAL :: id_imin 
    175       INTEGER(i4), INTENT(IN), OPTIONAL :: id_imax 
    176       INTEGER(i4), INTENT(IN), OPTIONAL :: id_jmin 
    177       INTEGER(i4), INTENT(IN), OPTIONAL :: id_jmax 
    178 !      INTEGER(i4), INTENT(IN), OPTIONAL :: id_kmin 
    179 !      INTEGER(i4), INTENT(IN), OPTIONAL :: id_kmax 
    180 !      INTEGER(i4), INTENT(IN), OPTIONAL :: id_lmin 
    181 !      INTEGER(i4), INTENT(IN), OPTIONAL :: id_lmax 
    182  
     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 
    183325      !local variable 
    184326      !---------------------------------------------------------------- 
    185327 
    186328      ! clean domain structure 
    187       CALL dom_clean(dom_init_file) 
     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) 
    188459 
    189460      IF( td_file%i_id == 0 )THEN 
    … …  
    195466         ! global domain define by file 
    196467 
     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 
    197488         ! use global dimension define by file 
    198          dom_init_file%t_dim0(:) = td_file%t_dim(:) 
     489         dom__init_file%t_dim0(:) = dim_copy(td_file%t_dim(:)) 
    199490 
    200491         IF( td_file%i_perio < 0 .OR. td_file%i_perio > 6 )THEN 
    201             CALL logger_error("DOM INIT: invalid grid periodicity. "//& 
    202             &  "you should use dom_get_perio to compute it") 
     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") 
    203495         ELSE 
    204             dom_init_file%i_perio0=td_file%i_perio 
     496            dom__init_file%i_perio0=td_file%i_perio 
    205497         ENDIF 
    206498 
    207499         ! global domain pivot point 
    208          SELECT CASE(dom_init_file%i_perio0) 
     500         SELECT CASE(dom__init_file%i_perio0) 
    209501            CASE(3,4) 
    210                dom_init_file%i_pivot = 0 
     502               dom__init_file%i_pivot = 0 
    211503            CASE(5,6) 
    212                dom_init_file%i_pivot = 1 
     504               dom__init_file%i_pivot = 1 
    213505            CASE DEFAULT 
    214                dom_init_file%i_pivot = 0 
     506               dom__init_file%i_pivot = 0 
    215507         END SELECT 
    216508 
     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 
    217526         ! look for EW overlap 
    218          dom_init_file%i_ew0=td_file%i_ew 
     527         dom__init_file%i_ew0=td_file%i_ew 
    219528 
    220529         ! initialise domain as global 
    221          dom_init_file%i_imin = 1  
    222          dom_init_file%i_imax = dom_init_file%t_dim0(1)%i_len 
    223  
    224          dom_init_file%i_jmin = 1  
    225          dom_init_file%i_jmax = dom_init_file%t_dim0(2)%i_len 
    226  
    227 !         dom_init_file%i_kmin = 1  
    228 !         dom_init_file%i_kmax = dom_init_file%t_dim(3)%i_len 
    229 ! 
    230 !         dom_init_file%i_lmin = 1  
    231 !         dom_init_file%i_lmax = dom_init_file%t_dim(4)%i_len 
    232  
    233          ! extract domain dimension 
    234          dom_init_file%t_dim(:) = td_file%t_dim(:) 
    235  
    236          ! define extract domain indices  
    237          CALL dom__define( dom_init_file, & 
    238    &                       id_imin, id_imax, id_jmin, id_jmax ) 
    239 !   &                       id_kmin, id_kmax, id_lmin, id_lmax ) 
    240  
    241       ENDIF 
    242  
    243    END FUNCTION dom_init_file 
    244    !> @endcode 
    245  !  !------------------------------------------------------------------- 
    246  !  !> @brief  
    247  !  !> This function intialise domain structure, given mpp structure, 
    248  !  !> and variable name. domain indices could be specify. 
    249  !  ! 
    250  !  !> @details 
    251  !  !>  
    252  !  ! 
    253  !  !> @author J.Paul 
    254  !  !> - Nov, 2013- Initial Version 
    255  !  ! 
    256  !  !> @param[in] td_mpp : mpp structure 
    257  !  !> @param[in] cd_varname : variable name 
    258  !  !> @return domain structure 
    259  !  !> 
    260  !  !> @todo 
    261  !  !> - initialiser domain 
    262  !  !------------------------------------------------------------------- 
    263  !  !> @code 
    264  !  TYPE(TDOM) FUNCTION dom_init_mpp( td_mpp, cd_varname ) 
    265  !     IMPLICIT NONE 
    266  !     ! Argument       
    267  !     TYPE(TMPP),       INTENT(IN) :: td_mpp  
    268  !     CHARACTER(LEN=*), INTENT(IN) :: cd_varname 
    269  !     !---------------------------------------------------------------- 
    270  
    271  !     ! clean domain structure 
    272  !     CALL dom_clean(dom_init_mpp) 
    273  
    274  !     IF( ASSOCIATED(td_mpp%t_proc) )THEN 
    275  
    276  !        CALL logger_error( " INIT: mpp strcuture "//TRIM(td_mpp%c_name)//& 
    277  !        &               " not define" ) 
    278  
    279  !     ELSE 
    280  !        ! global domain define by mpp 
    281  
    282  !        ! use global dimension define by mpp 
    283  !        dom_init_mpp%t_dim(:) = td_mpp%t_dim(:) 
    284  
    285  !        ! get global domain periodicity ?? 
    286  !        dom_init_mpp%i_perio =  dom_get_perio(td_mpp, cd_varname) 
    287  
    288  !        ! global domain pivot point 
    289  !        SELECT CASE(dom_init%i_perio) 
    290  !           CASE(3,4) 
    291  !              dom_init%i_pivot = 0 
    292  !           CASE(5,6) 
    293  !              dom_init%i_pivot = 1 
    294  !           CASE DEFAULT 
    295  !              dom_init%i_pivot = 0 
    296  !        END SELECT 
    297  
    298  !        ! initialise domain as global 
    299  !        dom_init_mpp%i_imin = 1  
    300  !        dom_init_mpp%i_imax = dom_init_mpp%t_dim(1)%i_len 
    301  
    302  !        dom_init_mpp%i_jmin = 1  
    303  !        dom_init_mpp%i_jmax = dom_init_mpp%t_dim(2)%i_len 
    304  
    305  !        dom_init_mpp%i_kmin = 1  
    306  !        dom_init_mpp%i_kmax = dom_init_mpp%t_dim(3)%i_len 
    307  
    308  !        dom_init_mpp%i_lmin = 1  
    309  !        dom_init_mpp%i_lmax = dom_init_mpp%t_dim(4)%i_len 
    310  
    311  !     ENDIF 
    312  
    313  !  END FUNCTION dom_init_mpp 
    314  !  !> @endcode 
     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 
    315546   !------------------------------------------------------------------- 
    316547   !> @brief  
    317    !> This subroutine define extract domain indices, and compute the size  
    318    !> of the domain. 
    319    !> 
    320    !> @author J.Paul 
    321    !> - Nov, 2013- Subroutine written 
    322    ! 
    323    !> @param[inout] td_dom : domain structure 
    324    !> @param[in] id_imin : i-direction sub-domain lower left  point indice 
    325    !> @param[in] id_imax : i-direction sub-domain upper right point indice 
    326    !> @param[in] id_jmin : j-direction sub-domain lower left  point indice 
    327    !> @param[in] id_jmax : j-direction sub-domain upper right point indice 
    328    !> @param[in] id_kmin : k-direction sub-domain lower level indice 
    329    !> @param[in] id_kmax : k-direction sub-domain upper level indice 
    330    !> @param[in] id_lmin : l-direction sub-domain lower time indice 
    331    !> @param[in] id_lmax : l-direction sub-domain upper time indice 
    332    !------------------------------------------------------------------- 
    333    !> @code 
     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   !------------------------------------------------------------------- 
    334560   SUBROUTINE dom__define(td_dom, & 
    335561   &                      id_imin, id_imax, id_jmin, id_jmax ) 
    336 !   &                      id_kmin, id_kmax, id_lmin, id_lmax ) 
    337562      IMPLICIT NONE 
    338563      ! Argument       
    … …  
    342567      INTEGER(i4), INTENT(IN), OPTIONAL :: id_jmin 
    343568      INTEGER(i4), INTENT(IN), OPTIONAL :: id_jmax 
    344 !      INTEGER(i4), INTENT(IN), OPTIONAL :: id_kmin 
    345 !      INTEGER(i4), INTENT(IN), OPTIONAL :: id_kmax 
    346 !      INTEGER(i4), INTENT(IN), OPTIONAL :: id_lmin 
    347 !      INTEGER(i4), INTENT(IN), OPTIONAL :: id_lmax 
    348569      !---------------------------------------------------------------- 
    349570 
    … …  
    354575      IF( PRESENT(id_jmax) ) td_dom%i_jmax = id_jmax 
    355576 
    356 !      IF( PRESENT(id_kmin) ) td_dom%i_kmin = id_kmin 
    357 !      IF( PRESENT(id_kmax) ) td_dom%i_kmax = id_kmax 
    358 ! 
    359 !      IF( PRESENT(id_lmin) ) td_dom%i_lmin = id_lmin 
    360 !      IF( PRESENT(id_lmax) ) td_dom%i_lmax = id_lmax 
    361  
    362577      ! check indices 
    363       IF(( td_dom%i_imin < 0 .OR. td_dom%i_imin > td_dom%t_dim0(1)%i_len ).OR. & 
    364       &  ( td_dom%i_imax < 0 .OR. td_dom%i_imax > td_dom%t_dim0(1)%i_len ).OR. & 
    365       &  ( td_dom%i_jmin < 0 .OR. td_dom%i_jmin > td_dom%t_dim0(2)%i_len ).OR. & 
    366       &  ( td_dom%i_jmax < 0 .OR. td_dom%i_jmax > td_dom%t_dim0(2)%i_len ))THEN 
    367 !      &  ( td_dom%i_kmin < 0 .OR. td_dom%i_kmin > td_dom%t_dim0(3)%i_len ).OR. & 
    368 !      &  ( td_dom%i_kmax < 0 .OR. td_dom%i_kmax > td_dom%t_dim0(3)%i_len ).OR. & 
    369 !      &  ( td_dom%i_lmin < 0 .OR. td_dom%i_lmin > td_dom%t_dim0(4)%i_len ).OR. & 
    370 !      &  ( td_dom%i_lmax < 0 .OR. td_dom%i_lmax > td_dom%t_dim0(4)%i_len ))THEN 
    371          CALL logger_error( "DOM INIT DEFINE: invalid grid definition."// & 
     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."// & 
    372591         &               " check min and max indices") 
    373          CALL logger_debug("0 < imin ("//TRIM(fct_str(id_imin))//") < "//& 
    374          &              TRIM(fct_str(td_dom%t_dim0(1)%i_len))) 
    375          CALL logger_debug("0 < imax ("//TRIM(fct_str(id_imax))//") < "//& 
    376          &              TRIM(fct_str(td_dom%t_dim0(1)%i_len))) 
    377          CALL logger_debug("0 < jmin ("//TRIM(fct_str(id_jmin))//") < "//& 
    378          &              TRIM(fct_str(td_dom%t_dim0(2)%i_len))) 
    379          CALL logger_debug("0 < jmax ("//TRIM(fct_str(id_jmax))//") < "//& 
    380          &              TRIM(fct_str(td_dom%t_dim0(2)%i_len))) 
    381 !         CALL logger_debug("0 < kmin ("//TRIM(fct_str(id_kmin))//") < "//& 
    382 !         &              TRIM(fct_str(td_dom%t_dim0(3)%i_len))) 
    383 !         CALL logger_debug("0 < kmax ("//TRIM(fct_str(id_kmax))//") < "//& 
    384 !         &              TRIM(fct_str(td_dom%t_dim0(3)%i_len))) 
    385 !         CALL logger_debug("0 < lmin ("//TRIM(fct_str(id_lmin))//") < "//& 
    386 !         &              TRIM(fct_str(td_dom%t_dim0(4)%i_len))) 
    387 !         CALL logger_debug("0 < lmax ("//TRIM(fct_str(id_lmax))//") < "//& 
    388 !         &              TRIM(fct_str(td_dom%t_dim0(4)%i_len))) 
    389592      ELSE 
    390593 
    391 !         td_dom%t_dim(3)%i_len=td_dom%i_kmax-td_dom%i_kmin+1 
    392 !         td_dom%t_dim(4)%i_len=td_dom%i_lmax-td_dom%i_lmin+1 
     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 
    393612 
    394613         SELECT CASE(td_dom%i_perio0) 
    395614            CASE(0) ! closed boundary 
    396                CALL logger_trace("DEFINE: closed boundary") 
     615               CALL logger_trace("DOM INIT DEFINE: closed boundary") 
    397616               CALL dom__define_closed( td_dom ) 
    398617            CASE(1) ! cyclic east-west boundary 
    399                CALL logger_trace("DEFINE: cyclic east-west boundary") 
     618               CALL logger_trace("DOM INIT DEFINE: cyclic east-west boundary") 
    400619               CALL dom__define_cyclic( td_dom ) 
    401620            CASE(2) ! symmetric boundary condition across the equator 
    402                CALL logger_trace("DEFINE: symmetric boundary condition "//& 
     621               CALL logger_trace("DOM INIT DEFINE: symmetric boundary condition "//& 
    403622               &                 " across the equator") 
    404623               CALL dom__define_symmetric( td_dom ) 
    405624            CASE(3) ! North fold boundary (with a F-point pivot)   
    406                CALL logger_trace("DEFINE: North fold boundary "//& 
     625               CALL logger_trace("DOM INIT DEFINE: North fold boundary "//& 
    407626               &                 "(with a F-point pivot)") 
    408627               CALL dom__define_north_fold( td_dom ) 
    409628            CASE(5) ! North fold boundary (with a T-point pivot) 
    410                CALL logger_trace("DEFINE: North fold boundary "//& 
     629               CALL logger_trace("DOM INIT DEFINE: North fold boundary "//& 
    411630               &                 "(with a T-point pivot)") 
    412631               CALL dom__define_north_fold( td_dom ) 
    413632            CASE(4) ! North fold boundary (with a F-point pivot)  
    414633                    ! and cyclic east-west boundary 
    415                CALL logger_trace("DEFINE:  North fold boundary "//& 
     634               CALL logger_trace("DOM INIT DEFINE:  North fold boundary "//& 
    416635               &                 "(with a F-point pivot) and cyclic "//& 
    417636               &                 "east-west boundary") 
    … …  
    419638            CASE(6) ! North fold boundary (with a T-point pivot)  
    420639                    ! and cyclic east-west boundary 
    421                CALL logger_trace("DEFINE: North fold boundary "//& 
     640               CALL logger_trace("DOM INIT DEFINE: North fold boundary "//& 
    422641               &                 "(with a T-point pivot) and cyclic "//& 
    423642               &                 "east-west boundary") 
    424643               CALL dom__define_cyclic_north_fold( td_dom ) 
    425644            CASE DEFAULT 
    426                CALL logger_error("DEFINE: invalid grid periodicity index") 
     645               CALL logger_error("DOM INIT DEFINE: invalid grid periodicity index") 
    427646         END SELECT 
    428647 
    … …  
    430649 
    431650   END SUBROUTINE dom__define 
    432    !> @endcode 
    433651   !------------------------------------------------------------------- 
    434652   !> @brief  
    435    !> This subroutine define domain indices from global domain with 
     653   !> This subroutine define sub domain indices from global domain with 
    436654   !> cyclic east-west boundary and north fold boundary condition. 
    437655   !> 
    438656   !> @author J.Paul 
    439    !> - Nov, 2013- Subroutine written 
    440    ! 
    441    !> @param[inout] td_dom : domain strcuture 
    442    !------------------------------------------------------------------- 
    443    !> @code 
     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   !------------------------------------------------------------------- 
    444663   SUBROUTINE dom__define_cyclic_north_fold( td_dom ) 
    445664      IMPLICIT NONE 
    … …  
    448667      !---------------------------------------------------------------- 
    449668 
    450       CALL dom__check_EW_index( td_dom ) 
    451  
    452       IF( td_dom%i_imin == td_dom%i_imax .AND. & 
    453       &   td_dom%i_jmin == td_dom%i_jmax )THEN 
    454  
    455          CALL logger_trace("DEFINE CYCLIC NORTH FOLD: "//& 
     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: "//& 
    456675         &  "domain to extract is global" ) 
    457676         ! coarse domain is global domain 
    … …  
    459678         CALL dom__size_global( td_dom ) 
    460679 
    461       ELSEIF( td_dom%i_imin == td_dom%i_imax .AND. & 
    462       &       td_dom%i_jmin >= td_dom%i_jmax )THEN 
    463  
    464          CALL logger_trace("DEFINE CYCLIC NORTH FOLD: "//& 
     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: "//& 
    465684         &  "domain to extract is semi-global" ) 
    466685 
    467686         CALL dom__size_semi_global( td_dom ) 
    468687 
    469       ELSEIF( td_dom%i_imin == td_dom%i_imax .AND. & 
    470       &       td_dom%i_jmin < td_dom%i_jmax )THEN 
    471  
    472          CALL logger_trace("DEFINE CYCLIC NORTH FOLD: "//& 
     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: "//& 
    473692         &  "domain to extract is band of latidue" ) 
    474693 
    475694         CALL dom__size_no_pole( td_dom ) 
    476695 
    477       ELSEIF( td_dom%i_imin /= td_dom%i_imax .AND. & 
    478       &       td_dom%i_jmin == td_dom%i_jmax )THEN 
    479  
    480          CALL logger_trace("DEFINE CYCLIC NORTH FOLD: "//& 
    481          &  "domain to extract has north boundary" ) 
     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" ) 
    482700 
    483701         CALL dom__size_pole( td_dom ) 
    484702 
    485       ELSEIF( td_dom%i_imin /= td_dom%i_imax .AND. & 
    486       &       td_dom%i_jmin /= td_dom%i_jmax )THEN 
    487  
    488          IF( td_dom%i_jmax < td_dom%t_dim0(2)%i_len-1 .AND. & 
    489          &   td_dom%i_jmax > td_dom%i_jmin )THEN 
    490  
    491             CALL logger_trace("DEFINE CYCLIC NORTH FOLD: "//& 
    492             &  "domain to extract has no north boundary" ) 
    493             ! no North Pole 
    494              
    495             CALL dom__size_no_pole( td_dom ) 
    496  
    497          ELSE 
    498  
    499             CALL logger_trace("DEFINE CYCLIC NORTH FOLD: "//& 
    500             &  "domain to extract has north boundary" ) 
    501  
    502             CALL dom__size_pole( td_dom ) 
    503  
    504          ENDIF 
     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 ) 
    505710 
    506711      ELSE 
    507712 
    508          CALL logger_error("DEFINE CYCLIC NORTH FOLD: "//& 
     713         CALL logger_error("DOM DEFINE CYCLIC NORTH FOLD: "//& 
    509714         &  "should have been an impossible case" ) 
    510715 
    … …  
    512717       
    513718   END SUBROUTINE dom__define_cyclic_north_fold 
    514    !> @endcode 
    515719   !------------------------------------------------------------------- 
    516720   !> @brief  
    517    !> This subroutine define extract domain indices from global domain  
     721   !> This subroutine define sub domain indices from global domain  
    518722   !> with north fold boundary condition. 
    519723   !> 
    520724   !> @author J.Paul 
    521    !> - Nov, 2013- Subroutine written 
    522    ! 
    523    !> @param[inout] td_dom : domain strcuture 
    524    !------------------------------------------------------------------- 
    525    !> @code 
     725   !> @date November, 2013 - Initial verison 
     726   ! 
     727   !> @param[inout] td_dom domain strcuture 
     728   !------------------------------------------------------------------- 
    526729   SUBROUTINE dom__define_north_fold( td_dom ) 
    527730      IMPLICIT NONE 
    … …  
    530733      !---------------------------------------------------------------- 
    531734 
    532       IF( td_dom%i_jmax < td_dom%t_dim0(2)%i_len-1 .AND. & 
    533       &   td_dom%i_jmax > td_dom%i_jmin )THEN 
    534  
    535          CALL logger_trace("DEFINE NORTH FOLD: "//& 
     735      IF( td_dom%i_jmax /= 0 )THEN 
     736 
     737         CALL logger_trace("DOM DEFINE NORTH FOLD: "//& 
    536738         &  "domain to extract has no north boundary" ) 
    537739         ! no North Pole 
    … …  
    541743      ELSE 
    542744 
    543          CALL logger_trace("DEFINE NORTH FOLD: "//& 
    544          &  "domain to extract has north boundary" ) 
     745         CALL logger_trace("DOM DEFINE NORTH FOLD: "//& 
     746         &  "sub domain has north boundary" ) 
    545747 
    546748         CALL dom__size_pole_no_overlap( td_dom ) 
    … …  
    549751 
    550752   END SUBROUTINE dom__define_north_fold 
    551    !> @endcode 
    552753   !------------------------------------------------------------------- 
    553754   !> @brief  
    554    !> This subroutine define extract domain indices from global domain  
     755   !> This subroutine define sub domain indices from global domain  
    555756   !> with symmetric boundary condition across the equator. 
    556757   !> 
    557758   !> @author J.Paul 
    558    !> - Nov, 2013- Subroutine written 
    559    ! 
    560    !> @param[inout] td_dom : domain strcuture 
    561    !------------------------------------------------------------------- 
    562    !> @code 
     759   !> @date November, 2013 - Initial version 
     760   ! 
     761   !> @param[inout] td_dom domain strcuture 
     762   !------------------------------------------------------------------- 
    563763   SUBROUTINE dom__define_symmetric( td_dom ) 
    564764      IMPLICIT NONE 
    … …  
    570770 
    571771   END SUBROUTINE dom__define_symmetric 
    572    !> @endcode 
    573772   !------------------------------------------------------------------- 
    574773   !> @brief  
    575    !> This subroutine define extract domain indices from global domain 
     774   !> This subroutine define sub domain indices from global domain 
    576775   !> with cyclic east-west boundary. 
    577776   !> 
    578777   !> @author J.Paul 
    579    !> - Nov, 2013- Subroutine written 
    580    ! 
    581    !> @param[inout] td_dom : domain strcuture 
    582    !------------------------------------------------------------------- 
    583    !> @code 
     778   !> @date November, 2013 - Initial version 
     779   ! 
     780   !> @param[inout] td_dom domain strcuture 
     781   !------------------------------------------------------------------- 
    584782   SUBROUTINE dom__define_cyclic( td_dom ) 
    585783      IMPLICIT NONE 
    … …  
    587785      TYPE(TDOM), INTENT(INOUT) :: td_dom 
    588786      !---------------------------------------------------------------- 
    589       CALL dom__check_EW_index( td_dom ) 
    590787       
    591788      IF( td_dom%i_imin >= td_dom%i_imax )THEN 
    592          CALL logger_trace("DEFINE CYCLIC: "//& 
     789         CALL logger_trace("DOM DEFINE CYCLIC: "//& 
    593790         &  "domain to extract overlap east-west boundary") 
    594791 
    … …  
    597794      ELSE 
    598795         ! id_imin < id_imax 
    599          CALL logger_trace("DEFINE CYCLIC: "//& 
     796         CALL logger_trace("DOM DEFINE CYCLIC: "//& 
    600797         &  "domain to extract do not overlap east-west boundary") 
    601798 
    … …  
    605802 
    606803   END SUBROUTINE dom__define_cyclic 
    607    !> @endcode 
    608804   !------------------------------------------------------------------- 
    609805   !> @brief  
    610    !> This subroutine define extract domain indices from global domain 
     806   !> This subroutine define sub domain indices from global domain 
    611807   !> with closed boundaries. 
    612808   !> 
    613809   !> @author J.Paul 
    614    !> - Nov, 2013- Subroutine written 
    615    ! 
    616    !> @param[inout] td_dom : domain strcuture 
    617    !------------------------------------------------------------------- 
    618    !> @code 
     810   !> @date November, 2013 - Initial version 
     811   ! 
     812   !> @param[inout] td_dom domain strcuture 
     813   !------------------------------------------------------------------- 
    619814   SUBROUTINE dom__define_closed( td_dom ) 
    620815      IMPLICIT NONE 
    … …  
    626821 
    627822   END SUBROUTINE dom__define_closed 
    628    !> @endcode 
    629    !------------------------------------------------------------------- 
    630    !> @brief  
    631    !> This subroutine check East-West indices, use inside a cyclic domain, 
    632    !> and redefine it in some particular cases. 
    633    !> 
    634    !> @author J.Paul 
    635    !> - Nov, 2013- Subroutine written 
    636    ! 
    637    !> @param[inout] td_dom : domain strcuture 
    638    !------------------------------------------------------------------- 
    639    !> @code 
    640    SUBROUTINE dom__check_EW_index( td_dom ) 
    641       IMPLICIT NONE 
    642       ! Argument 
    643       TYPE(TDOM), INTENT(INOUT) :: td_dom 
    644       !---------------------------------------------------------------- 
    645  
    646       IF( td_dom%i_imin /= td_dom%i_imax )THEN 
    647  
    648          IF((ABS(td_dom%i_imax-td_dom%i_imin) >= td_dom%t_dim0(1)%i_len-1).OR.& 
    649             (ABS(td_dom%i_imax-td_dom%i_imin) <= td_dom%i_ew0 ) )THEN 
    650  
    651             td_dom%i_imin = td_dom%i_imax 
    652  
    653          ENDIF 
    654  
    655       ENDIF 
    656  
    657    END SUBROUTINE dom__check_EW_index 
    658    !> @endcode 
    659823   !------------------------------------------------------------------- 
    660824   !> @brief 
    … …  
    662826   !> 
    663827   !> @author J.Paul 
    664    !> - Nov, 2013- Subroutine written 
    665    ! 
    666    !> @param[inout] td_dom : domain strcuture 
    667    !------------------------------------------------------------------- 
    668    !> @code 
     828   !> @date November, 2013 - Initial version 
     829   ! 
     830   !> @param[inout] td_dom domain strcuture 
     831   !------------------------------------------------------------------- 
    669832   SUBROUTINE dom__size_global( td_dom ) 
    670833      IMPLICIT NONE 
    … …  
    684847 
    685848      ! no ghost cell to add 
    686       td_dom%i_ighost=0 
    687       td_dom%i_jghost=0 
    688  
    689       ! peiordicity 
     849      td_dom%i_ghost(:,:)=0 
     850 
     851      ! periodicity 
    690852      IF( td_dom%i_pivot == 0 )THEN ! 0-F 
    691853         td_dom%i_perio=4 
    … …  
    697859 
    698860   END SUBROUTINE dom__size_global 
    699    !> @endcode 
    700861   !------------------------------------------------------------------- 
    701862   !> @brief 
    … …  
    703864   !> 
    704865   !> @author J.Paul 
    705    !> - Nov, 2013- Subroutine written 
    706    ! 
    707    !> @param[inout] td_dom : domain strcuture 
     866   !> @date November, 2013 - Initial version 
     867   ! 
     868   !> @param[inout] td_dom domain strcuture 
    708869   !> @note never tested 
    709870   !------------------------------------------------------------------- 
    710    !> @code 
    711871   SUBROUTINE dom__size_semi_global( td_dom ) 
    712872      IMPLICIT NONE 
    … …  
    715875 
    716876      ! local variable 
    717       INTEGER(i4) :: il_imid   ! cananadian bipole index (middle of global domain)  
     877      INTEGER(i4) :: il_imid   ! canadian bipole index (middle of global domain)  
    718878      !---------------------------------------------------------------- 
    719879 
    … …  
    723883      td_dom%i_imax = il_imid !td_dom%t_dim0(1)%i_len 
    724884 
    725       IF( td_dom%i_jmax >= td_dom%t_dim0(2)%i_len-1 )THEN 
    726          td_dom%i_jmax=MIN( td_dom%i_jmin, &  
    727          &                  td_dom%t_dim0(2)%i_len-td_dom%i_jmax ) 
    728       ELSE 
    729          td_dom%i_jmin=td_dom%i_jmax 
    730       ENDIF 
     885      IF( td_dom%i_jmin == 0 ) td_dom%i_jmin=1 
     886      td_dom%i_jmax = td_dom%t_dim0(2)%i_len 
    731887 
    732888      ! domain size 
    733       td_dom%t_dim(1)%i_len = (td_dom%i_imax ) - & 
    734       &                         (td_dom%i_imin ) + 1 
     889      td_dom%t_dim(1)%i_len = td_dom%i_imax - & 
     890      &                       td_dom%i_imin + 1 
    735891 
    736892      td_dom%t_dim(2)%i_len = ( td_dom%t_dim0(2)%i_len - & 
    737       &                         ( td_dom%i_jmin ) + 1 ) +      & 
     893      &                         td_dom%i_jmin + 1 ) +      & 
    738894      &                         ( td_dom%t_dim0(2)%i_len - & 
    739       &                         ( td_dom%i_jmax ) + 1 ) - 2    ! remove north fold condition ? 
     895      &                           td_dom%i_jmin + 1 ) - 2    ! remove north fold condition ? 
    740896 
    741897      ! ghost cell to add 
    742       td_dom%i_ighost=1 
    743       td_dom%i_jghost=1 
     898      td_dom%i_ghost(:,:)=1 
    744899 
    745900      ! periodicity 
    … …  
    753908 
    754909   END SUBROUTINE dom__size_semi_global 
    755    !> @endcode 
    756910   !------------------------------------------------------------------- 
    757911   !> @brief 
    758    !> This subroutine compute size of an extract domain without north fold 
     912   !> This subroutine compute size of sub domain without north fold 
    759913   !> condition 
    760914   !> 
    761915   !> @author J.Paul 
    762    !> - Nov, 2013- Subroutine written 
    763    ! 
    764    !> @param[inout] td_dom : domain strcuture 
    765    !------------------------------------------------------------------- 
    766    !> @code 
     916   !> @date November, 2013 - Initial version 
     917   ! 
     918   !> @param[inout] td_dom domain strcuture 
     919   !------------------------------------------------------------------- 
    767920   SUBROUTINE dom__size_no_pole( td_dom ) 
    768921      IMPLICIT NONE 
    … …  
    771924      !---------------------------------------------------------------- 
    772925 
    773       IF( td_dom%i_jmin >= td_dom%i_jmax )THEN 
    774          CALL logger_fatal("DOM INIT: invalid domain. "//& 
     926      IF( td_dom%i_jmax == 0 )THEN 
     927         CALL logger_fatal("DOM SIZE NO POLE: invalid domain. "//& 
    775928         &  "can not get north pole from this coarse grid. "//& 
    776929         &  "check namelist and coarse grid periodicity." ) 
    777930      ENDIF 
    778931 
    779       IF( td_dom%i_imin >= td_dom%i_imax )THEN 
    780          CALL logger_trace("DEFINE NO POLE: "// & 
     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: "// & 
    781935         &  "domain to extract overlap east-west boundary") 
    782936 
    … …  
    785939      ELSE 
    786940         ! id_imin < id_imax 
    787          CALL logger_trace("DEFINE NO POLE: "// & 
     941         CALL logger_trace("DOM SIZE NO POLE: "// & 
    788942         &  "domain to extract do not overlap east-west boundary") 
    789943 
    … …  
    793947 
    794948   END SUBROUTINE dom__size_no_pole 
    795    !> @endcode 
    796949   !------------------------------------------------------------------- 
    797950   !> @brief 
    798    !> This subroutine compute size of an extract domain with north fold 
    799    !> condition 
    800    !> 
    801    !> @author J.Paul 
    802    !> - April, 2013- Subroutine written 
    803    ! 
    804    !> @param[inout] td_dom : domain strcuture 
    805    !------------------------------------------------------------------- 
    806    !> @code 
     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   !------------------------------------------------------------------- 
    807960   SUBROUTINE dom__size_pole( td_dom ) 
    808961      IMPLICIT NONE 
    … …  
    811964      !---------------------------------------------------------------- 
    812965 
    813       IF( td_dom%i_imin > td_dom%i_imax )THEN 
    814          CALL logger_trace("DEFINE POLE: "//& 
     966      IF( td_dom%i_imin >= td_dom%i_imax )THEN 
     967         CALL logger_trace("DOM SIZE POLE: "//& 
    815968         &  "domain to extract overlap east-west boundary") 
    816969         CALL dom__size_pole_overlap( td_dom ) 
    817970      ELSEIF( td_dom%i_imin < td_dom%i_imax )THEN 
    818          CALL logger_trace("DEFINE POLE: "//& 
     971         CALL logger_trace("DOM SIZE POLE: "//& 
    819972         &  "domain to extract do not overlap east-west boundary") 
    820973         CALL dom__size_pole_no_overlap( td_dom ) 
    … …  
    822975 
    823976   END SUBROUTINE dom__size_pole 
    824    !> @endcode 
    825977   !------------------------------------------------------------------- 
    826978   !> @brief 
    827    !> This subroutine compute size of an extract domain without north fold 
     979   !> This subroutine compute size of sub domain without north fold 
    828980   !> condition, and which overlap east-west boundary 
    829981   !> 
    830982   !> @author J.Paul 
    831    !> - Nov, 2013- Subroutine written 
    832    ! 
    833    !> @param[inout] td_dom : domain strcuture 
    834    !------------------------------------------------------------------- 
    835    !> @code 
     983   !> @date November, 2013 - Initial version 
     984   ! 
     985   !> @param[inout] td_dom domain strcuture 
     986   !------------------------------------------------------------------- 
    836987   SUBROUTINE dom__size_no_pole_overlap( td_dom ) 
    837988      IMPLICIT NONE 
    … …  
    840991      !---------------------------------------------------------------- 
    841992 
    842       IF( td_dom%i_jmin >= td_dom%i_jmax )THEN 
    843          CALL logger_fatal("DOM INIT: invalid domain. "//& 
     993      IF( td_dom%i_jmax == 0 )THEN 
     994         CALL logger_fatal("DOM SIZE NO POLE OVERLAP: invalid domain. "//& 
    844995         &  "can not get north pole from this coarse grid. "//& 
    845996         &  "check namelist and coarse grid periodicity." ) 
    846997      ENDIF 
    847998 
    848       IF( td_dom%i_imin == td_dom%i_imax )THEN 
     999      IF( td_dom%i_imin == 0 .AND. td_dom%i_imax == 0 )THEN 
    8491000         ! domain to extract with east west cyclic boundary 
    850          CALL logger_trace("DEFINE NO POLE OVERLAP: "//& 
     1001         CALL logger_trace("DOM SIZE NO POLE OVERLAP: "//& 
    8511002         &  "domain to extract has cyclic east-west boundary") 
    8521003 
    … …  
    8571008 
    8581009         ! no ghost cell 
    859          td_dom%i_ighost=0 
     1010         td_dom%i_ghost(jp_I,:)=0 
    8601011 
    8611012         ! periodicity 
    … …  
    8671018         ! extract domain overlap east-west boundary 
    8681019 
    869          td_dom%t_dim(1)%i_len = td_dom%t_dim0(1)%i_len -            & 
    870          &                       (td_dom%i_imin ) + 1 + &  
    871          &                       (td_dom%i_imax ) - 2     ! remove cyclic boundary 
     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 
    8721023 
    8731024         ! add ghost cell 
    874          td_dom%i_ighost=1 
     1025         td_dom%i_ghost(jp_I,:)=1 
    8751026 
    8761027         ! periodicity 
    … …  
    8791030      ENDIF 
    8801031 
    881       td_dom%t_dim(2)%i_len = (td_dom%i_jmax ) - & 
    882       &                       (td_dom%i_jmin ) + 1 
     1032      td_dom%t_dim(2)%i_len = td_dom%i_jmax - & 
     1033      &                       td_dom%i_jmin + 1 
    8831034 
    8841035      ! add ghost cell 
    885       td_dom%i_jghost=1 
     1036      td_dom%i_ghost(jp_J,:)=1 
    8861037 
    8871038   END SUBROUTINE dom__size_no_pole_overlap 
    888    !> @endcode 
    8891039   !------------------------------------------------------------------- 
    8901040   !> @brief 
    891    !> This subroutine compute size of an extract domain without north fold 
     1041   !> This subroutine compute size of sub domain without north fold 
    8921042   !> condition, and which do not overlap east-west boundary 
    8931043   !> 
    8941044   !> @author J.Paul 
    895    !> - Nov, 2013- Subroutine written 
    896    ! 
    897    !> @param[inout] td_dom : domain strcuture 
    898    !------------------------------------------------------------------- 
    899    !> @code 
     1045   !> @date November, 2013 - Initial version 
     1046   ! 
     1047   !> @param[inout] td_dom domain strcuture 
     1048   !------------------------------------------------------------------- 
    9001049   SUBROUTINE dom__size_no_pole_no_overlap( td_dom ) 
    9011050      IMPLICIT NONE 
    … …  
    9041053      !---------------------------------------------------------------- 
    9051054 
    906       IF( td_dom%i_jmin >= td_dom%i_jmax )THEN 
    907          CALL logger_fatal("DOM INIT: invalid domain. "//& 
     1055      IF( td_dom%i_jmax == 0 )THEN 
     1056         CALL logger_fatal("DOM SIZE NO POLE NO OVERLAP: invalid domain. "//& 
    9081057         &  "can not get north pole from this coarse grid. "//& 
    909          &  "check namelist and coarse grid periodicity." ) 
    910       ENDIF 
    911  
    912       IF( td_dom%i_imin >= td_dom%i_imax )THEN 
    913          CALL logger_fatal("DOM INIT: invalid domain. "//& 
     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. "//& 
    9141063         &  "can not overlap East-West boundary with this coarse grid. "//& 
    915          &  "check namelist and coarse grid periodicity." ) 
    916       ENDIF 
    917  
    918       td_dom%t_dim(1)%i_len = ( td_dom%i_imax ) - &  
    919       &                       ( td_dom%i_imin ) + 1  
    920  
    921       td_dom%t_dim(2)%i_len = ( td_dom%i_jmax ) - & 
    922       &                       ( td_dom%i_jmin ) + 1 
     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 
    9231072       
    9241073      ! add ghost cell 
    925       td_dom%i_ighost=1 
    926       td_dom%i_jghost=1 
     1074      td_dom%i_ghost(:,:)=1 
    9271075 
    9281076      ! periodicity 
    … …  
    9301078 
    9311079   END SUBROUTINE dom__size_no_pole_no_overlap 
    932    !> @endcode 
    9331080   !------------------------------------------------------------------- 
    9341081   !> @brief 
    935    !> This subroutine compute size of an extract domain with north fold 
     1082   !> This subroutine compute size of sub domain with north fold 
    9361083   !> condition, and which overlap east-west boundary 
    9371084   !> 
    9381085   !> @author J.Paul 
    939    !> - Nov, 2013- Subroutine written 
    940    ! 
    941    !> @param[inout] td_dom : domain strcuture 
     1086   !> @date November, 2013 - Initial version 
     1087   ! 
     1088   !> @param[inout] td_dom domain strcuture 
    9421089   !> @note never tested 
    9431090   !------------------------------------------------------------------- 
    944    !> @code 
    9451091   SUBROUTINE dom__size_pole_overlap( td_dom ) 
    9461092      IMPLICIT NONE 
    … …  
    9541100      !---------------------------------------------------------------- 
    9551101 
    956       CALL logger_trace("DEFINE POLE OVERLAP: "//& 
     1102      CALL logger_trace("DOM SIZE POLE OVERLAP: "//& 
    9571103      &  "asian bipole inside domain to extract") 
    9581104 
    … …  
    9641110      IF( il_idom1 > il_imid .OR. il_idom2 > il_imid )THEN 
    9651111 
    966          CALL logger_trace("DEFINE POLE OVERLAP: "//& 
     1112         CALL logger_trace("DOM SIZE POLE OVERLAP: "//& 
    9671113         &  "canadian bipole inside domain to extract") 
    968          td_dom%i_imin = td_dom%i_imax 
    969  
    970          IF( td_dom%i_jmin == td_dom%i_jmax )THEN 
     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 
    9711118            CALL dom__size_global( td_dom ) 
    9721119         ELSE 
    … …  
    9801127 
    9811128         ! east part bigger than west part 
    982          CALL logger_trace("DEFINE POLE OVERLAP: east part bigger than west part ") 
     1129         CALL logger_trace("DOM SIZE POLE OVERLAP: east part bigger than west part ") 
    9831130         ! to respect symmetry around asian bipole 
    9841131         td_dom%i_imax = il_idom1 
    9851132 
     1133         IF( td_dom%i_jmin == 0 ) td_dom%i_jmin = 1  
    9861134         ! north pole 
    987          IF( td_dom%i_jmax >= td_dom%t_dim0(2)%i_len-1 )THEN 
    988             td_dom%i_jmax=MIN( td_dom%i_jmin, &  
    989             &                  td_dom%t_dim0(2)%i_len-td_dom%i_jmax ) 
    990          ELSE 
    991             td_dom%i_jmax=MIN( td_dom%i_jmin, td_dom%i_jmax ) 
    992          ENDIF 
    993          td_dom%i_jmin=td_dom%i_jmax 
     1135         td_dom%i_jmax = td_dom%t_dim0(2)%i_len 
    9941136 
    9951137         ! compute size 
    9961138         td_dom%t_dim(1)%i_len = il_idom1  !! no ghost cell ?? 
    9971139         td_dom%t_dim(2)%i_len = ( td_dom%t_dim0(2)%i_len - & 
    998          &                         ( td_dom%i_jmin ) + 1 ) + &    
     1140         &                         td_dom%i_jmin + 1 ) + &    
    9991141         &                         ( td_dom%t_dim0(2)%i_len - & 
    1000          &                         ( td_dom%i_jmax ) + 1 ) - 2   ! remove north fold condition ? 
     1142         &                         td_dom%i_jmin + 1 ) - 2   ! remove north fold condition ? 
    10011143 
    10021144         ! add ghost cell 
    1003          td_dom%i_ighost=1 
    1004          td_dom%i_jghost=1 
     1145         td_dom%i_ghost(:,:)=1 
    10051146 
    10061147         ! periodicity 
    … …  
    10101151 
    10111152         ! west part bigger than east part 
    1012          CALL logger_trace("DEFINE POLE OVERLAP: west part bigger than east part ") 
     1153         CALL logger_trace("DOM SIZE POLE OVERLAP: west part bigger than east part ") 
    10131154 
    10141155         ! to respect symmetry around asian bipole 
    10151156         td_dom%i_imin = td_dom%t_dim0(1)%i_len - il_idom2 + 1 
    10161157 
     1158         IF( td_dom%i_jmin == 0 ) td_dom%i_jmin = 1  
    10171159         ! north pole 
    1018          IF( td_dom%i_jmax >= td_dom%t_dim0(2)%i_len-1 )THEN 
    1019             td_dom%i_jmax=MIN( td_dom%i_jmin, &  
    1020             &                  td_dom%t_dim0(2)%i_len-td_dom%i_jmax ) 
    1021          ELSE 
    1022             td_dom%i_jmax=MIN( td_dom%i_jmin, td_dom%i_jmax ) 
    1023          ENDIF 
    1024          td_dom%i_jmin=td_dom%i_jmax 
     1160         td_dom%i_jmax=td_dom%t_dim0(2)%i_len 
    10251161 
    10261162         ! compute size 
    10271163         td_dom%t_dim(1)%i_len = il_idom2 
    10281164         td_dom%t_dim(2)%i_len = ( td_dom%t_dim0(2)%i_len - & 
    1029          &                         ( td_dom%i_jmin ) + 1 ) + & 
     1165         &                         td_dom%i_jmin + 1 ) + & 
    10301166         &                         ( td_dom%t_dim0(2)%i_len - & 
    1031          &                         ( td_dom%i_jmax ) + 1 ) - 2 
     1167         &                         td_dom%i_jmin + 1 ) - 2 
    10321168 
    10331169         ! add ghost cell 
    1034          td_dom%i_ighost=1 
    1035          td_dom%i_jghost=1 
     1170         td_dom%i_ghost(:,:)=1 
    10361171          
    10371172         ! periodicity 
    … …  
    10411176 
    10421177   END SUBROUTINE dom__size_pole_overlap 
    1043    !> @endcode 
    10441178   !------------------------------------------------------------------- 
    10451179   !> @brief 
    1046    !> This subroutine compute size of an extract domain with north fold 
     1180   !> This subroutine compute size of sub domain with north fold 
    10471181   !> condition, and which do not overlap east-west boundary 
    10481182   !> 
    10491183   !> @author J.Paul 
    1050    !> - Nov, 2013- Subroutine written 
    1051    ! 
    1052    !> @param[inout] td_dom : domain strcuture 
     1184   !> @date November, 2013 - Initial version 
     1185   ! 
     1186   !> @param[inout] td_dom domain strcuture 
    10531187   !> @note never tested 
    10541188   !------------------------------------------------------------------- 
    1055    !> @code 
    10561189   SUBROUTINE dom__size_pole_no_overlap( td_dom ) 
    10571190      IMPLICIT NONE 
    … …  
    10651198      !---------------------------------------------------------------- 
    10661199 
    1067       IF( td_dom%i_imin >= td_dom%i_imax )THEN 
    1068          CALL logger_fatal("DOM INIT: invalid domain. "//& 
     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. "//& 
    10691203         &  "can not overlap East-West boundary with this coarse grid. "//& 
    10701204         &  "check namelist and coarse grid periodicity." ) 
    10711205      ENDIF 
    10721206 
    1073       CALL logger_trace("DEFINE POLE NO OVERLAP: "//& 
     1207      CALL logger_trace("DOM SIZE POLE NO OVERLAP: "//& 
    10741208      &  "no asian bipole inside domain to extract") 
    10751209 
    1076       ! north pole 
    1077       IF( td_dom%i_jmax >= td_dom%t_dim0(2)%i_len-1 )THEN 
    1078          td_dom%i_jmax=MIN( td_dom%i_jmin, &  
    1079          &                  td_dom%t_dim0(2)%i_len-td_dom%i_jmax ) 
    1080       ELSE 
    1081          td_dom%i_jmax=MIN( td_dom%i_jmin, td_dom%i_jmax ) 
    1082       ENDIF 
    1083       td_dom%i_jmin=td_dom%i_jmax 
     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 
    10841212 
    10851213      !  
    … …  
    10881216      IF( (td_dom%i_imin < il_mid .AND. td_dom%i_imax < il_mid) .OR. & 
    10891217      &   (td_dom%i_imin > il_mid .AND. td_dom%i_imax > il_mid) )THEN 
    1090          CALL logger_trace("DEFINE POLE NO OVERLAP: "//& 
     1218         CALL logger_trace("DOM SIZE POLE NO OVERLAP: "//& 
    10911219         &  "no canadian bipole inside domain to extract") 
    10921220 
    1093          td_dom%t_dim(1)%i_len = ( td_dom%i_imax ) - & 
    1094          &                       ( td_dom%i_imin ) + 1 
     1221         td_dom%t_dim(1)%i_len = td_dom%i_imax - & 
     1222         &                       td_dom%i_imin + 1 
    10951223 
    10961224         td_dom%t_dim(2)%i_len = ( td_dom%t_dim0(2)%i_len - & 
    1097          &                       ( td_dom%i_jmin ) + 1 ) + & 
     1225         &                       td_dom%i_jmin + 1 ) + & 
    10981226         &                       ( td_dom%t_dim0(2)%i_len - & 
    1099          &                       ( td_dom%i_jmax ) + 1 ) - 2 ! remove north fold condition ? 
     1227         &                       td_dom%i_jmin + 1 ) - 2 ! remove north fold condition ? 
    11001228 
    11011229         ! add ghost cell 
    1102          td_dom%i_ighost=1 
    1103          td_dom%i_jghost=1 
     1230         td_dom%i_ghost(:,:)=1 
    11041231 
    11051232         ! periodicity 
    … …  
    11071234 
    11081235      ELSE ! id_imin < il_mid .AND. id_imax > il_mid 
    1109          CALL logger_trace("DEFINE POLE NO OVERLAP: "//& 
     1236         CALL logger_trace("DOM SIZE POLE NO OVERLAP: "//& 
    11101237         &  "canadian bipole inside domain to extract") 
    11111238 
    … …  
    11141241         IF( il_idom1 > il_idom2 )THEN 
    11151242            ! east part bigger than west part 
    1116             CALL logger_trace("DEFINE POLE NO OVERLAP: east part bigger than west part ") 
     1243            CALL logger_trace("DOM SIZE POLE NO OVERLAP: east part bigger than west part ") 
    11171244            ! to respect symmetry around canadian bipole 
    11181245            td_dom%i_imin = il_mid - il_idom1 
    … …  
    11201247            td_dom%t_dim(1)%i_len = il_idom1 + 1 
    11211248            td_dom%t_dim(2)%i_len = ( td_dom%t_dim0(2)%i_len - & 
    1122             &                         ( td_dom%i_jmin ) + 1 ) + &  
     1249            &                         td_dom%i_jmin + 1 ) + &  
    11231250            &                         ( td_dom%t_dim0(2)%i_len - & 
    1124             &                         ( td_dom%i_jmax ) + 1 ) &    
     1251            &                         td_dom%i_jmin + 1 ) &    
    11251252            &                         - 2 - 2 * td_dom%i_pivot    ! remove north fold condition ? 
    11261253 
    11271254            ! add ghost cell 
    1128             td_dom%i_ighost=1 
    1129             td_dom%i_jghost=1 
     1255            td_dom%i_ghost(:,:)=1 
    11301256 
    11311257            ! periodicity 
    … …  
    11341260         ELSE ! il_idom2 >= il_idom1 
    11351261            ! west part bigger than east part 
    1136             CALL logger_trace("DEFINE POLE NO OVERLAP: west part bigger than east part ") 
     1262            CALL logger_trace("DOM SIZE POLE NO OVERLAP: west part bigger than east part ") 
    11371263            ! to respect symmetry around canadian bipole 
    11381264 
    … …  
    11411267            td_dom%t_dim(1)%i_len = il_idom2 + 1 
    11421268            td_dom%t_dim(2)%i_len = ( td_dom%t_dim0(2)%i_len -  & 
    1143             &                         ( td_dom%i_jmin ) + 1 ) +     &  
     1269            &                         td_dom%i_jmin + 1 ) +     &  
    11441270            &                         ( td_dom%t_dim0(2)%i_len -  & 
    1145             &                         ( td_dom%i_jmax ) + 1 )       &  
     1271            &                         td_dom%i_jmax + 1 )       &  
    11461272            &                         - 2 - 2 * td_dom%i_pivot  !  remove north fold condition ? 
    11471273 
    11481274            ! add ghost cell 
    1149             td_dom%i_ighost=1 
    1150             td_dom%i_jghost=1 
     1275            td_dom%i_ghost(:,:)=1 
    11511276 
    11521277            ! periodicity 
    … …  
    11571282 
    11581283   END SUBROUTINE dom__size_pole_no_overlap 
    1159    !> @endcode 
    1160    !------------------------------------------------------------------- 
    1161    !> @brief This function get east west overlap. 
    1162    ! 
     1284   !------------------------------------------------------------------- 
     1285   !> @brief  
     1286   !>  This subroutine add extra bands to coarse domain to get enough point for 
     1287   !>  interpolation... 
     1288   !> 
    11631289   !> @details 
    1164    !> If no east -west wrap return -1,  
    1165    !> else return the size of the ovarlap band  
    1166    ! 
    1167    !> @author J.Paul 
    1168    !> - 2013- Initial Version 
    1169    ! 
    1170    !> @param[in]  
    1171    !------------------------------------------------------------------- 
    1172    !> @code 
    1173    FUNCTION dom_get_ew_overlap(td_lon) 
    1174       IMPLICIT NONE 
    1175       ! Argument       
    1176       TYPE(TVAR), INTENT(IN) :: td_lon 
    1177  
    1178       ! function 
    1179       INTEGER(i4) :: dom_get_ew_overlap 
    1180  
    1181       ! local variable 
    1182       REAL(dp), DIMENSION(:,:,:,:), ALLOCATABLE :: dl_value 
    1183       REAL(dp), DIMENSION(:)      , ALLOCATABLE :: dl_lone 
    1184       REAL(dp), DIMENSION(:)      , ALLOCATABLE :: dl_lonw 
    1185  
    1186       REAL(dp)    :: dl_delta 
    1187       REAL(dp)    :: dl_lonmax 
    1188       REAL(dp)    :: dl_lonmin 
    1189  
    1190       INTEGER(i4) :: il_east 
    1191       INTEGER(i4) :: il_west 
    1192       INTEGER(i4) :: il_jmin 
    1193       INTEGER(i4) :: il_jmax 
    1194  
    1195       INTEGER(i4), PARAMETER :: ip_max_overlap = 5 
    1196  
    1197       ! loop indices 
    1198       INTEGER(i4) :: ji 
    1199       !---------------------------------------------------------------- 
    1200       ! init  
    1201       dom_get_ew_overlap=-1 
    1202  
    1203       il_west=1 
    1204       il_east=td_lon%t_dim(1)%i_len 
    1205  
    1206       ALLOCATE( dl_value(td_lon%t_dim(1)%i_len, & 
    1207       &                  td_lon%t_dim(2)%i_len, & 
    1208       &                  td_lon%t_dim(3)%i_len, & 
    1209       &                  td_lon%t_dim(4)%i_len) ) 
    1210  
    1211       dl_value(:,:,:,:)=td_lon%d_value(:,:,:,:) 
    1212       WHERE( dl_value(:,:,:,:) > 180._dp .AND. & 
    1213       &      dl_value(:,:,:,:) /= td_lon%d_fill )  
    1214          dl_value(:,:,:,:)=360.-dl_value(:,:,:,:) 
    1215       END WHERE 
    1216  
    1217       ! we do not use jmax as dimension length due to north fold boundary 
    1218       il_jmin=1+ig_ghost 
    1219       il_jmax=(td_lon%t_dim(2)%i_len-ig_ghost)/2 
    1220  
    1221       ALLOCATE( dl_lone(il_jmax-il_jmin+1) ) 
    1222       ALLOCATE( dl_lonw(il_jmax-il_jmin+1) ) 
    1223  
    1224       dl_lone(:)=dl_value(il_east,il_jmin:il_jmax,1,1) 
    1225       dl_lonw(:)=dl_value(il_west,il_jmin:il_jmax,1,1) 
    1226  
    1227       IF( .NOT.(  ALL(dl_lone(:)==td_lon%d_fill) .AND. & 
    1228       &           ALL(dl_lonw(:)==td_lon%d_fill) ) )THEN 
    1229  
    1230          dl_lonmax=MAXVAL(dl_value(:,il_jmin:il_jmax,:,:)) 
    1231          dl_lonmin=MINVAL(dl_value(:,il_jmin:il_jmax,:,:)) 
    1232  
    1233          dl_delta=(dl_lonmax-dl_lonmin)/td_lon%t_dim(1)%i_len 
    1234  
    1235          IF( ALL(ABS(dl_lone(:)) - ABS(dl_lonw(:)) == dl_delta) )THEN 
    1236  
    1237             dom_get_ew_overlap=0 
    1238  
    1239          ELSE IF( ALL( ABS(dl_lone(:)) - ABS(dl_lonw(:)) < & 
    1240          &             ip_max_overlap*dl_delta             ) )THEN 
    1241             DO ji=0,ip_max_overlap 
    1242  
    1243                IF( il_east-ji == il_west )THEN 
    1244                   ! case of small domain 
    1245                   EXIT 
    1246                ELSE 
    1247                   dl_lone(:)=dl_value(il_east-ji,il_jmin:il_jmax,1,1) 
    1248                    
    1249                   IF( ALL( dl_lonw(:) == dl_lone(:) ) )THEN 
    1250                      dom_get_ew_overlap=ji+1 
    1251                      EXIT 
    1252                   ENDIF 
    1253                ENDIF 
    1254  
    1255             ENDDO 
    1256          ENDIF 
    1257  
    1258       ENDIF 
    1259  
    1260       DEALLOCATE( dl_value ) 
    1261  
    1262    END FUNCTION dom_get_ew_overlap 
    1263    !> @endcode 
    1264    !------------------------------------------------------------------- 
    1265    !> @brief  
    1266    !>  This subroutine add extra point to domain 
    1267    ! 
    1268    !> @author J.Paul 
    1269    !> @date Nov, 2013 
    1270    ! 
    1271    !> @param[inout] td_dom : domain strcuture 
    1272    !> @param [in] id_iext : i-direction size of extra bands (default=im_minext) 
    1273    !> @param [in] id_jext : j-direction size of extra bands (default=im_minext) 
    1274    !------------------------------------------------------------------- 
    1275    !> @code 
     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   !------------------------------------------------------------------- 
    12761304   SUBROUTINE dom_add_extra( td_dom, id_iext, id_jext ) 
    12771305      IMPLICIT NONE 
    … …  
    12881316      !---------------------------------------------------------------- 
    12891317      ! init 
    1290       !WARNING: two extrabands are required for cubic interpolation 
    12911318      il_iext=im_minext 
    12921319      IF( PRESENT(id_iext) ) il_iext=id_iext 
    … …  
    13051332         ! nothing to be done 
    13061333      ELSE 
     1334 
    13071335         IF( td_dom%i_imin == 1                       .AND. & 
    13081336         &   td_dom%i_imax == td_dom%t_dim0(1)%i_len )THEN 
    … …  
    13101338            ! nothing to be done 
    13111339         ELSE 
    1312             IF( td_dom%i_imin /= 1 )THEN 
    1313                td_dom%i_iextra(1)=il_iext 
    1314  
    1315             ELSE 
    1316                IF( td_dom%i_ew0 > 0 )THEN 
    1317                   td_dom%i_iextra(1)=il_iext 
    1318  
     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) 
    13191350               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                
    13201385            ENDIF 
    13211386 
    1322             IF( td_dom%i_imax /= td_dom%t_dim(1)%i_len )THEN 
    1323                td_dom%i_iextra(2)=1 
    1324  
    1325             ELSE 
    1326                IF( td_dom%i_ew0 > 0 )THEN 
    1327                   td_dom%i_iextra(2)=il_jext 
    1328  
    1329                ENDIF 
     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) 
    13301401            ENDIF 
    13311402 
    1332          ENDIF 
    1333  
    1334          IF( td_dom%i_jmin == td_dom%i_jmax )THEN 
    1335             td_dom%i_jextra(1)=il_iext 
    1336             td_dom%i_jextra(2)=il_jext 
    1337  
    1338          ELSE 
    1339             IF( td_dom%i_jmin /= 1)THEN 
    1340                td_dom%i_jextra(1)=il_iext 
    1341  
     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) 
    13421414            ENDIF 
    1343             IF( td_dom%i_jmax /= td_dom%t_dim(2)%i_len )THEN 
    1344                td_dom%i_jextra(2)=il_jext 
    1345  
    1346             ENDIF 
    1347  
    1348          ENDIF 
    1349  
    1350       ENDIF 
    1351  
    1352       ! change domain 
    1353       td_dom%i_imin         = td_dom%i_imin - td_dom%i_iextra(1) 
    1354       td_dom%i_jmin         = td_dom%i_jmin - td_dom%i_jextra(1) 
    1355  
    1356       td_dom%i_imax         = td_dom%i_imax + td_dom%i_iextra(2) 
    1357       td_dom%i_jmax         = td_dom%i_jmax + td_dom%i_jextra(2) 
    1358  
    1359       td_dom%t_dim(1)%i_len = td_dom%t_dim(1)%i_len + & 
    1360       &                          td_dom%i_iextra(1) + & 
    1361       &                          td_dom%i_iextra(2) 
    1362       td_dom%t_dim(2)%i_len = td_dom%t_dim(2)%i_len + & 
    1363       &                          td_dom%i_jextra(1) + & 
    1364       &                          td_dom%i_jextra(2) 
     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 
    13651428 
    13661429 
    13671430   END SUBROUTINE dom_add_extra 
    1368    !> @endcode 
    13691431   !------------------------------------------------------------------- 
    13701432   !> @brief  
    1371    !>  This subroutine clean domain structure. it remove extra point added.  
    1372    ! 
    1373    !> @author J.Paul 
    1374    !> @date Nov, 2013 
    1375    ! 
    1376    !> @param[inout] td_dom : domain strcuture 
    1377    !------------------------------------------------------------------- 
    1378    !> @code 
     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   !------------------------------------------------------------------- 
    13791441   SUBROUTINE dom_clean_extra( td_dom ) 
    13801442      IMPLICIT NONE 
    … …  
    14041466 
    14051467   END SUBROUTINE dom_clean_extra 
    1406    !> @endcode 
    14071468   !------------------------------------------------------------------- 
    14081469   !> @brief  
    1409    !>  This subroutine  
    1410    ! 
    1411    !> @author J.Paul 
    1412    !> @date Nov, 2013 
    1413    ! 
    1414    !> @param[inout] td_var : variable strcuture 
    1415    !> @param[inout] td_dom : domain strcuture 
    1416    !> @param[inout] id_rhoi : i-direction refinement factor 
    1417    !> @param[inout] id_rhoj : j-direction refinement factor 
    1418    !------------------------------------------------------------------- 
    1419    !> @code 
    1420    SUBROUTINE dom_del_extra( td_var, td_dom, id_rho ) 
    1421       IMPLICIT NONE 
    1422       ! Argument 
    1423       TYPE(TVAR) , INTENT(INOUT) :: td_var 
    1424       TYPE(TDOM) , INTENT(IN   ) :: td_dom 
    1425       INTEGER(i4), DIMENSION(:), INTENT(IN   ) :: id_rho 
     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 
    14261498 
    14271499      ! local variable 
    … …  
    14341506      INTEGER(i4) :: il_jmax 
    14351507       
    1436       REAL(dp), DIMENSION(:,:,:,:), ALLOCATABLE :: dl_value 
    1437  
     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 
    14381514      ! loop indices 
    14391515      !---------------------------------------------------------------- 
     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 
    14401527 
    14411528      IF( .NOT. ASSOCIATED(td_var%d_value) )THEN 
    … …  
    14431530         &     "variable "//TRIM(td_var%c_name) ) 
    14441531      ELSE 
    1445          ! get vairbale right domain 
     1532         ! get variable right domain 
    14461533         IF( ALL(td_var%t_dim(1:2)%l_use) )THEN 
    1447             il_iextra=SUM(td_dom%i_iextra(:))*id_rho(jp_I) 
    1448             il_jextra=SUM(td_dom%i_jextra(:))*id_rho(jp_J) 
    14491534 
    14501535            ALLOCATE(dl_value(td_var%t_dim(1)%i_len, & 
    … …  
    14541539            dl_value(:,:,:,:)=td_var%d_value(:,:,:,:) 
    14551540 
    1456             il_imin=1                     + td_dom%i_iextra(1)*id_rho(jp_I) 
    1457             il_imax=td_var%t_dim(1)%i_len - td_dom%i_iextra(2)*id_rho(jp_I) 
    1458  
    1459             il_jmin=1                     + td_dom%i_jextra(1)*id_rho(jp_J) 
    1460             il_jmax=td_var%t_dim(2)%i_len - td_dom%i_jextra(2)*id_rho(jp_J) 
    1461  
    1462             td_var%t_dim(1)%i_len=td_var%t_dim(1)%i_len-il_iextra 
    1463             td_var%t_dim(2)%i_len=td_var%t_dim(2)%i_len-il_jextra 
     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 
    14641698 
    14651699            DEALLOCATE(td_var%d_value) 
    … …  
    14781712 
    14791713   END SUBROUTINE dom_del_extra 
    1480    !> @endcode 
    14811714   !------------------------------------------------------------------- 
    14821715   !> @brief  
    1483    !>  This subroutine clean mpp strcuture. 
    1484    ! 
    1485    !> @author J.Paul 
    1486    !> @date Nov, 2013 
    1487    ! 
    1488    !> @param[inout] td_dom : domain strcuture 
    1489    !------------------------------------------------------------------- 
    1490    !> @code 
     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   !------------------------------------------------------------------- 
    14911723   SUBROUTINE dom_clean( td_dom ) 
    14921724      IMPLICIT NONE 
    … …  
    14951727 
    14961728      ! local variable 
    1497       TYPE(TDOM) :: tl_dom ! empty file structure 
     1729      TYPE(TDOM) :: tl_dom ! empty dom structure 
    14981730 
    14991731      ! loop indices 
    … …  
    15011733      !---------------------------------------------------------------- 
    15021734 
    1503       CALL logger_info( " CLEAN: reset domain " ) 
     1735      CALL logger_info( "DOM CLEAN: reset domain " ) 
    15041736 
    15051737      ! del dimension 
    … …  
    15111743      td_dom=tl_dom 
    15121744 
    1513       END SUBROUTINE dom_clean 
     1745   END SUBROUTINE dom_clean 
    15141746END MODULE dom 
Note: See TracChangeset for help on using the changeset viewer.