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 5260 for branches/2014/dev_r4650_UKMO10_Tidally_Meaned_Diagnostics/NEMOGCM/TOOLS/SIREN/src/grid.f90 – NEMO

Ignore:
Timestamp:
2015-05-12T12:37:15+02:00 (9 years ago)
Author:
deazer
Message:

Merged branch with Trunk at revision 5253.
Checked with SETTE, passes modified iodef.xml for AMM12 experiment

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/2014/dev_r4650_UKMO10_Tidally_Meaned_Diagnostics/NEMOGCM/TOOLS/SIREN/src/grid.f90

    r4213 r5260  
    66! 
    77! DESCRIPTION: 
    8 !> @brief grid manager <br/> 
     8!> @brief This module is grid manager. 
    99!> 
    1010!> @details 
    11 !>  
     11!>    to get NEMO pivot point index:<br/> 
     12!> @code 
     13!>    il_pivot=grid_get_pivot(td_file) 
     14!> @endcode 
     15!>       - il_pivot is NEMO pivot point index F(0), T(1) 
     16!>       - td_file is mpp structure  
     17!> 
     18!>    to get NEMO periodicity index:<br/> 
     19!> @code 
     20!>    il_perio=grid_get_perio(td_file) 
     21!> @endcode 
     22!>       - il_perio is NEMO periodicity index (0,1,2,3,4,5,6) 
     23!>       - td_file is mpp structure 
     24!> 
     25!>    to check domain validity:<br/> 
     26!> @code 
     27!>    CALL grid_check_dom(td_coord, id_imin, id_imax, id_jmin, id_jmax) 
     28!> @endcode 
     29!>       - td_coord is coordinates mpp structure 
     30!>       - id_imin is i-direction lower left  point indice 
     31!>       - id_imax is i-direction upper right point indice 
     32!>       - id_jmin is j-direction lower left  point indice 
     33!>       - id_jmax is j-direction upper right point indice 
     34!> 
     35!>    to get closest coarse grid indices of fine grid domain:<br/> 
     36!> @code 
     37!>    il_index(:,:)=grid_get_coarse_index(td_coord0, td_coord1, 
     38!>                                      [id_rho,] [cd_point]) 
     39!> @endcode 
     40!>    or  
     41!> @code 
     42!>    il_index(:,:)=grid_get_coarse_index(td_lon0, td_lat0, td_coord1, 
     43!>                                      [id_rho,] [cd_point]) 
     44!> @endcode 
     45!>    or 
     46!> @code 
     47!>    il_index(:,:)=grid_get_coarse_index(td_coord0, td_lon1, td_lat1, 
     48!>                                      [id_rho,] [cd_point]) 
     49!> @endcode 
     50!>    or 
     51!> @code 
     52!>    il_index(:,:)=grid_get_coarse_index(td_lon0, td_lat0, td_lon1, td_lat1, 
     53!>                                      [id_rho,] [cd_point]) 
     54!> @endcode 
     55!>       - il_index(:,:) is  coarse grid indices (/ (/ imin0, imax0 /),  
     56!> (/ jmin0, jmax0 /) /) 
     57!>       - td_coord0 is coarse grid coordinate mpp structure  
     58!>       - td_coord1 is fine grid coordinate mpp structure 
     59!>       - td_lon0 is coarse grid longitude variable structure  
     60!>       - td_lat0 is coarse grid latitude  variable structure  
     61!>       - td_lon1 is fine   grid longitude variable structure  
     62!>       - td_lat1 is fine   grid latitude  variable structure  
     63!>       - id_rho is array of refinment factor (default 1) 
     64!>       - cd_point is Arakawa grid point (default 'T') 
     65!> 
     66!>    to know if grid is global:<br/> 
     67!> @code 
     68!>    ll_global=grid_is_global(td_lon, td_lat) 
     69!> @endcode 
     70!>       - td_lon is longitude variable structure 
     71!>       - td_lat is latitude variable structure 
     72!>    
     73!>    to know if grid contains north fold:<br/> 
     74!> @code 
     75!>    ll_north=grid_is_north_fold(td_lat) 
     76!> @endcode 
     77!>       - td_lat is latitude variable structure     
     78!> 
     79!>    to get coarse grid indices of the closest point from one fine grid  
     80!> point:<br/> 
     81!> @code 
     82!>    il_index(:)=grid_get_closest(dd_lon0(:,:), dd_lat0(:,:), dd_lon1, dd_lat1) 
     83!> @endcode 
     84!>       - il_index(:) is  coarse grid indices (/ i0, j0 /) 
     85!>       - dd_lon0 is coarse grid array of longitude value (real(8)) 
     86!>       - dd_lat0 is coarse grid array of latitude  value (real(8)) 
     87!>       - dd_lon1 is fine grid longitude value (real(8)) 
     88!>       - dd_lat1 is fine grid latitude  value (real(8)) 
     89!> 
     90!>    to compute distance between a point A and grid points:<br/> 
     91!> @code 
     92!>    il_dist(:,:)=grid_distance(dd_lon, dd_lat, dd_lonA, dd_latA) 
     93!> @endcode 
     94!>       - il_dist(:,:) is array of distance between point A and grid points 
     95!>       - dd_lon is array of longitude value (real(8)) 
     96!>       - dd_lat is array of longitude value (real(8)) 
     97!>       - dd_lonA is longitude of point A (real(8)) 
     98!>       - dd_latA is latitude  of point A (real(8)) 
     99!> 
     100!>    to get offset between fine grid and coarse grid:<br/>  
     101!> @code 
     102!>    il_offset(:,:)=grid_get_fine_offset(td_coord0,  
     103!>                                        id_imin0, id_jmin0, id_imax0, id_jmax0, 
     104!>                                        td_coord1 
     105!>                                        [,id_rho] [,cd_point]) 
     106!> @endcode 
     107!>    or 
     108!> @code 
     109!>    il_offset(:,:)=grid_get_fine_offset(dd_lon0, dd_lat0,  
     110!>                                        id_imin0, id_jmin0,id_imax0, id_jmax0, 
     111!>                                        td_coord1  
     112!>                                        [,id_rho] [,cd_point]) 
     113!> @endcode 
     114!>    or 
     115!> @code 
     116!>    il_offset(:,:)=grid_get_fine_offset(td_coord0,  
     117!>                                        id_imin0, id_jmin0, id_imax0, id_jmax0, 
     118!>                                        dd_lon1, dd_lat1  
     119!>                                        [,id_rho] [,cd_point]) 
     120!> @endcode 
     121!>    or 
     122!> @code 
     123!>    il_offset(:,:)=grid_get_fine_offset(dd_lon0, dd_lat0, 
     124!>                                        id_imin0, id_jmin0, id_imax0, id_jmax0, 
     125!>                                        dd_lon1, dd_lat1 
     126!>                                        [,id_rho] [,cd_point]) 
     127!> @endcode 
     128!>       - il_offset(:,:) is offset array  
     129!>    (/ (/ i_offset_left, i_offset_right /), (/ j_offset_lower, j_offset_upper /) /) 
     130!>       - td_coord0 is coarse grid coordinate mpp structure  
     131!>       - dd_lon0  is coarse grid longitude array (real(8)) 
     132!>       - dd_lat0  is coarse grid latitude  array (real(8)) 
     133!>       - id_imin0 is coarse grid lower left  corner i-indice of fine grid  
     134!> domain 
     135!>       - id_jmin0 is coarse grid lower left  corner j-indice of fine grid  
     136!> domain 
     137!>       - id_imax0 is coarse grid upper right corner i-indice of fine grid  
     138!> domain 
     139!>       - id_jmax0 is coarse grid upper right corner j-indice of fine grid  
     140!> domain 
     141!>       - td_coord1 is fine grid coordinate mpp structure 
     142!>       - dd_lon1  is fine   grid longitude array (real(8)) 
     143!>       - dd_lat1  is fine   grid latitude  array (real(8)) 
     144!>       - id_rho is array of refinment factor (default 1) 
     145!>       - cd_point is Arakawa grid point (default 'T') 
     146!> 
     147!>    to check fine and coarse grid coincidence:<br/> 
     148!> @code 
     149!>    CALL grid_check_coincidence(td_coord0, td_coord1,  
     150!>                                id_imin0, id_imax0, id_jmin0, id_jmax0 
     151!>                                [,id_rho]) 
     152!> @endcode 
     153!>       - td_coord0 is coarse grid coordinate mpp structure 
     154!>       - td_coord1 is fine   grid coordinate mpp structure 
     155!>       - id_imin0  is coarse grid lower left  corner i-indice of fine grid  
     156!> domain 
     157!>       - id_imax0  is coarse grid upper right corner i-indice of fine grid  
     158!> domain 
     159!>       - id_jmin0  is coarse grid lower left  corner j-indice of fine grid  
     160!> domain 
     161!>       - id_jmax0  is coarse grid upper right corner j-indice of fine grid  
     162!> domain  
     163!>       - id_rho    is array of refinement factor (default 1) 
     164!> 
     165!>    to add ghost cell at boundaries:<br/> 
     166!> @code 
     167!>    CALL grid_add_ghost(td_var, id_ghost) 
     168!> @endcode 
     169!>       - td_var is array of variable structure 
     170!>       - id_ghost is 2D array of ghost cell factor 
     171!> 
     172!>    to delete ghost cell at boundaries:<br/> 
     173!> @code 
     174!>    CALL grid_del_ghost(td_var, id_ghost) 
     175!> @endcode 
     176!>       - td_var is array of variable structure 
     177!>       - id_ghost is 2D array of ghost cell factor 
     178!> 
     179!>    to get ghost cell factor (use or not):<br/> 
     180!> @code 
     181!>    il_factor(:)= grid_get_ghost( td_var ) 
     182!> @endcode 
     183!>    or 
     184!> @code 
     185!>    il_factor(:)= grid_get_ghost( td_mpp ) 
     186!> @endcode 
     187!>       - il_factor(:) is  array of ghost cell factor (0 or 1) 
     188!>       - td_var  is variable structure 
     189!>       - td_mpp is mpp sturcture 
     190!> 
     191!>    to compute closed sea domain:<br/> 
     192!> @code 
     193!>    il_mask(:,:)=grid_split_domain(td_var, [id_level]) 
     194!> @endcode 
     195!>       - il_mask(:,:) is domain mask 
     196!>       - td_var is variable strucutre 
     197!>       - id_level is level to be used [optional]  
     198!> 
     199!>    to fill small closed sea with _FillValue:<br/> 
     200!> @code 
     201!>    CALL grid_fill_small_dom(td_var, id_mask, [id_minsize]) 
     202!> @endcode 
     203!>       - td_var  is variable structure 
     204!>       - id_mask is domain mask (from grid_split_domain) 
     205!>       - id_minsize is minimum size of sea to be kept [optional] 
     206!> 
    12207!> @author 
    13208!> J.Paul 
    14209! REVISION HISTORY: 
    15 !> @date Nov, 2013 - Initial Version 
     210!> @date November, 2013 - Initial Version 
     211!> @date September, 2014 
     212!> - add header 
     213!> @date October, 2014 
     214!> - use mpp file structure instead of file 
    16215! 
    17216!> @note Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    18 !> @todo 
    19217!---------------------------------------------------------------------- 
    20218MODULE grid 
     
    24222   USE global                          ! global parameter 
    25223   USE phycst                          ! physical constant 
    26    USE logger                             ! log file manager 
     224   USE logger                          ! log file manager 
    27225   USE file                            ! file manager 
     226   USE att                             ! attribute manager 
    28227   USE var                             ! variable manager 
    29228   USE dim                             ! dimension manager 
    30    USE dom                             ! domain manager 
    31229   USE iom                             ! I/O manager 
    32230   USE mpp                             ! MPP manager 
     231   USE dom                             ! domain manager 
    33232   USE iom_mpp                         ! MPP I/O manager 
     233   USE iom_dom                         ! DOM I/O manager 
    34234   IMPLICIT NONE 
    35    PRIVATE 
    36235   ! NOTE_avoid_public_variables_if_possible 
    37236 
     
    39238 
    40239   ! function and subroutine 
    41    PUBLIC :: grid_check_dom !< check domain validity  
    42    PUBLIC :: grid_get_coarse_index !< get closest coarse grid indices of fine grid domain. 
    43    PUBLIC :: grid_is_global !< check if grid is global or not 
    44    PUBLIC :: grid_get_closest !< return closest coarse grid point from another point 
    45    PUBLIC :: grid_distance !< compute grid distance to a point 
    46    PUBLIC :: grid_get_fine_offset !< get fine grid offset 
    47    PUBLIC :: grid_check_coincidence !< check fine and coarse grid coincidence 
    48    PUBLIC :: grid_get_perio !< return NEMO periodicity index 
    49    PUBLIC :: grid_get_pivot !< return NEMO pivot point index 
    50    PUBLIC :: grid_add_ghost !< add ghost cell at boundaries. 
    51    PUBLIC :: grid_del_ghost !< delete ghost cell at boundaries. 
    52    PUBLIC :: grid_get_ghost !< return ghost cell factor 
    53    PUBLIC :: grid_split_domain !<  
    54    PUBLIC :: grid_fill_small_dom !<  
    55  
    56    PRIVATE :: grid_get_coarse_index_ff 
    57    PRIVATE :: grid_get_coarse_index_cf 
    58    PRIVATE :: grid_get_coarse_index_fc 
    59    PRIVATE :: grid_get_coarse_index_cc 
    60    PRIVATE :: grid__get_ghost_f   
    61    PRIVATE :: grid__get_ghost_ll 
    62    PRIVATE :: grid__check_corner 
     240   PUBLIC :: grid_get_info             !< get information about mpp global domain (pivot, perio, ew) 
     241   PUBLIC :: grid_get_pivot            !< get NEMO pivot point index 
     242   PUBLIC :: grid_get_perio            !< get NEMO periodicity index 
     243   PUBLIC :: grid_get_ew_overlap       !< get East West overlap 
     244   PUBLIC :: grid_check_dom            !< check domain validity  
     245   PUBLIC :: grid_get_coarse_index     !< get closest coarse grid indices of fine grid domain. 
     246   PUBLIC :: grid_is_global            !< check if grid is global or not 
     247   PUBLIC :: grid_is_north_fold 
     248   PUBLIC :: grid_get_closest          !< return closest coarse grid point from another point 
     249   PUBLIC :: grid_distance             !< compute grid distance to a point 
     250   PUBLIC :: grid_get_fine_offset      !< get fine grid offset 
     251   PUBLIC :: grid_check_coincidence    !< check fine and coarse grid coincidence 
     252   PUBLIC :: grid_add_ghost            !< add ghost cell at boundaries. 
     253   PUBLIC :: grid_del_ghost            !< delete ghost cell at boundaries. 
     254   PUBLIC :: grid_get_ghost            !< return ghost cell factor 
     255   PUBLIC :: grid_split_domain         !< compute closed sea domain  
     256   PUBLIC :: grid_fill_small_dom       !< fill small closed sea with fill value  
     257 
     258                                     ! get closest coarse grid indices of fine grid domain 
     259   PRIVATE :: grid__get_coarse_index_ff ! - using coarse and fine grid coordinates files 
     260   PRIVATE :: grid__get_coarse_index_cf ! - using coarse grid array of lon,lat and fine grid coordinates files 
     261   PRIVATE :: grid__get_coarse_index_fc ! - using coarse grid coordinates files, and fine grid array of lon,lat 
     262   PRIVATE :: grid__get_coarse_index_cc ! - using coarse and fine grid array of lon,lat 
     263 
     264                                     ! get offset between fine and coarse grid 
     265   PRIVATE :: grid__get_fine_offset_ff ! - using coarse and fine grid coordinates files 
     266   PRIVATE :: grid__get_fine_offset_cf ! - using coarse grid array of lon,lat and fine grid coordinates files 
     267   PRIVATE :: grid__get_fine_offset_fc ! - using coarse grid coordinates files, and fine grid array of lon,lat 
     268   PRIVATE :: grid__get_fine_offset_cc ! - using coarse and fine grid array of lon,lat 
     269 
     270                                     ! get information about global domain (pivot, perio, ew) 
     271   PRIVATE :: grid__get_info_mpp      ! - using mpp files structure 
     272   PRIVATE :: grid__get_info_file     ! - using files structure 
     273 
     274                                     ! get NEMO pivot point index 
     275   PRIVATE :: grid__get_pivot_mpp      ! - using mpp files structure 
     276   PRIVATE :: grid__get_pivot_file     ! - using files structure 
     277   PRIVATE :: grid__get_pivot_var      ! - using variable structure 
     278   PRIVATE :: grid__get_pivot_varT   ! compute NEMO pivot point index for variable on grid T  
     279   PRIVATE :: grid__get_pivot_varU   ! compute NEMO pivot point index for variable on grid U 
     280   PRIVATE :: grid__get_pivot_varV   ! compute NEMO pivot point index for variable on grid V 
     281   PRIVATE :: grid__get_pivot_varF   ! compute NEMO pivot point index for variable on grid F 
     282 
     283                                     ! get NEMO periodicity index 
     284   PRIVATE :: grid__get_perio_mpp      ! - using mpp files structure 
     285   PRIVATE :: grid__get_perio_file     ! - using files structure 
     286   PRIVATE :: grid__get_perio_var      ! - using variable structure 
     287 
     288                                     ! get East West overlap 
     289   PRIVATE :: grid__get_ew_overlap_mpp  ! - using mpp files structure 
     290   PRIVATE :: grid__get_ew_overlap_file ! - using files structure 
     291   PRIVATE :: grid__get_ew_overlap_var  ! - using longitude variable structure 
     292 
     293                                    ! return ghost cell factor 
     294   PRIVATE :: grid__get_ghost_mpp      ! - using mpp files structure 
     295   PRIVATE :: grid__get_ghost_var      ! - using array of lon,lat 
     296   PRIVATE :: grid__check_corner    ! check that fine grid is inside coarse grid 
     297   PRIVATE :: grid__check_lat       ! check that fine grid latitude are inside coarse grid latitude 
    63298    
     299   INTERFACE  grid_get_info 
     300      MODULE PROCEDURE grid__get_info_mpp 
     301      MODULE PROCEDURE grid__get_info_file 
     302   END INTERFACE grid_get_info 
     303 
     304   INTERFACE  grid_get_pivot 
     305      MODULE PROCEDURE grid__get_pivot_mpp 
     306      MODULE PROCEDURE grid__get_pivot_file 
     307      MODULE PROCEDURE grid__get_pivot_var 
     308   END INTERFACE grid_get_pivot 
     309 
     310   INTERFACE  grid_get_perio 
     311      MODULE PROCEDURE grid__get_perio_mpp 
     312      MODULE PROCEDURE grid__get_perio_file 
     313      MODULE PROCEDURE grid__get_perio_var 
     314   END INTERFACE grid_get_perio 
     315 
     316   INTERFACE  grid_get_ew_overlap 
     317      MODULE PROCEDURE grid__get_ew_overlap_mpp 
     318      MODULE PROCEDURE grid__get_ew_overlap_file 
     319      MODULE PROCEDURE grid__get_ew_overlap_var 
     320   END INTERFACE grid_get_ew_overlap 
     321 
    64322   INTERFACE  grid_get_ghost 
    65       MODULE PROCEDURE grid__get_ghost_ll 
    66       MODULE PROCEDURE grid__get_ghost_f 
     323      MODULE PROCEDURE grid__get_ghost_var 
     324      MODULE PROCEDURE grid__get_ghost_mpp 
    67325   END INTERFACE  grid_get_ghost 
    68326 
    69327   INTERFACE  grid_get_coarse_index 
    70       MODULE PROCEDURE grid_get_coarse_index_ff 
    71       MODULE PROCEDURE grid_get_coarse_index_cf 
    72       MODULE PROCEDURE grid_get_coarse_index_fc 
    73       MODULE PROCEDURE grid_get_coarse_index_cc 
     328      MODULE PROCEDURE grid__get_coarse_index_ff 
     329      MODULE PROCEDURE grid__get_coarse_index_cf 
     330      MODULE PROCEDURE grid__get_coarse_index_fc 
     331      MODULE PROCEDURE grid__get_coarse_index_cc 
    74332   END INTERFACE grid_get_coarse_index 
    75333 
     334   INTERFACE  grid_get_fine_offset 
     335      MODULE PROCEDURE grid__get_fine_offset_ff 
     336      MODULE PROCEDURE grid__get_fine_offset_fc 
     337      MODULE PROCEDURE grid__get_fine_offset_cf 
     338      MODULE PROCEDURE grid__get_fine_offset_cc 
     339   END INTERFACE grid_get_fine_offset    
     340 
    76341CONTAINS 
    77342   !------------------------------------------------------------------- 
     343   !> @brief This subroutine get information about global domain, given file 
     344   !> strucutre. 
     345   !> 
     346   !> @details 
     347   !> open edge files then: 
     348   !> - compute NEMO pivot point  
     349   !> - compute NEMO periodicity 
     350   !> - compute East West overlap 
     351   !> 
     352   !> @note need all processor files to be there 
     353   !> @author J.Paul 
     354   !> - October, 2014- Initial Version 
     355   !> 
     356   !> @param[inout] td_file file structure  
     357   !------------------------------------------------------------------- 
     358   SUBROUTINE grid__get_info_file(td_file) 
     359      IMPLICIT NONE 
     360      ! Argument       
     361      TYPE(TFILE), INTENT(INOUT) :: td_file 
     362 
     363      ! local variable 
     364      INTEGER(i4) :: il_ew 
     365      INTEGER(i4) :: il_pivot 
     366      INTEGER(i4) :: il_perio 
     367      INTEGER(i4) :: il_attid 
     368 
     369      TYPE(TATT)  :: tl_att 
     370 
     371      TYPE(TFILE) :: tl_file 
     372 
     373      ! loop indices 
     374      INTEGER(i4) :: ji 
     375      !---------------------------------------------------------------- 
     376      ! intialise 
     377      il_pivot=-1 
     378      il_perio=-1 
     379      il_ew   =-1  
     380 
     381      ! copy structure 
     382      tl_file=file_copy(td_file) 
     383 
     384      ! open file to be used 
     385      CALL iom_open(tl_file) 
     386 
     387      IF( td_file%i_perio >= 0 .AND. td_file%i_perio <= 6 )THEN 
     388         il_perio=td_file%i_perio 
     389      ELSE 
     390         ! look for attribute in file 
     391         il_attid=att_get_index(tl_file%t_att(:),'periodicity') 
     392         IF( il_attid /= 0 )THEN 
     393            il_perio=INT(tl_file%t_att(il_attid)%d_value(1),i4) 
     394         ENDIF 
     395      ENDIF 
     396 
     397      IF( td_file%i_ew >= 0 )THEN 
     398         il_ew=td_file%i_ew 
     399      ELSE 
     400         ! look for attribute in file 
     401         il_attid=att_get_index(tl_file%t_att(:),'ew_overlap') 
     402         IF( il_attid /= 0 )THEN 
     403            il_ew=INT(tl_file%t_att(il_attid)%d_value(1),i4) 
     404         ENDIF 
     405      ENDIF 
     406 
     407      SELECT CASE(il_perio) 
     408      CASE(3,4) 
     409         il_pivot=0 
     410      CASE(5,6) 
     411         il_pivot=1 
     412      CASE(0,1,2) 
     413         il_pivot=1 
     414      END SELECT 
     415       
     416      IF( il_pivot < 0 .OR. il_pivot > 1 )THEN 
     417         ! get pivot 
     418         il_pivot=grid_get_pivot(tl_file) 
     419      ENDIF 
     420 
     421      IF( il_perio < 0 .OR. il_perio > 6 )THEN 
     422         ! get periodicity 
     423         il_perio=grid_get_perio(tl_file, il_pivot) 
     424      ENDIF 
     425 
     426      IF( il_ew < 0 )THEN 
     427         ! get periodicity 
     428         il_ew=grid_get_ew_overlap(tl_file) 
     429      ENDIF 
     430 
     431      ! close 
     432      CALL iom_close(tl_file) 
     433 
     434      !save in file structure 
     435      td_file%i_ew=il_ew 
     436      td_file%i_pivot=il_pivot 
     437      td_file%i_perio=il_perio 
     438 
     439      ! save in variable of file structure 
     440      tl_att=att_init("ew_overlap",il_ew) 
     441      DO ji=1,td_file%i_nvar 
     442         IF( td_file%t_var(ji)%t_dim(jp_I)%l_use )THEN 
     443            CALL var_move_att(td_file%t_var(ji),tl_att) 
     444         ENDIF 
     445      ENDDO 
     446 
     447      ! clean  
     448      CALL file_clean(tl_file) 
     449      CALL att_clean(tl_att) 
     450 
     451      IF( td_file%i_perio == -1 )THEN 
     452         CALL logger_fatal("GRID GET INFO: can not read or compute "//& 
     453         &  "domain periodicity from file "//TRIM(td_file%c_name)//"."//& 
     454         &  " you have to inform periodicity in namelist.") 
     455      ENDIF 
     456 
     457   END SUBROUTINE grid__get_info_file 
     458   !------------------------------------------------------------------- 
     459   !> @brief This subroutine get information about global domain, given mpp 
     460   !> strucutre. 
     461   !> 
     462   !> @details 
     463   !> open edge files then: 
     464   !> - compute NEMO pivot point  
     465   !> - compute NEMO periodicity 
     466   !> - compute East West overlap 
     467   !> 
     468   !> @note need all processor files to be there 
     469   !> @author J.Paul 
     470   !> - October, 2014- Initial Version 
     471   !> 
     472   !> @param[in] td_mpp mpp structure  
     473   !------------------------------------------------------------------- 
     474   SUBROUTINE grid__get_info_mpp(td_mpp) 
     475      IMPLICIT NONE 
     476      ! Argument       
     477      TYPE(TMPP) , INTENT(INOUT) :: td_mpp 
     478 
     479      ! local variable 
     480      INTEGER(i4) :: il_ew 
     481      INTEGER(i4) :: il_pivot 
     482      INTEGER(i4) :: il_perio 
     483      INTEGER(i4) :: il_attid 
     484 
     485      TYPE(TATT)  :: tl_att 
     486 
     487      TYPE(TMPP)  :: tl_mpp 
     488 
     489      ! loop indices 
     490      INTEGER(i4) :: ji 
     491      INTEGER(i4) :: jj 
     492      !---------------------------------------------------------------- 
     493      ! intialise 
     494      il_pivot=-1 
     495      il_perio=-1 
     496      il_ew   =-1 
     497 
     498      ! copy structure 
     499      tl_mpp=mpp_copy(td_mpp) 
     500      ! select edge files 
     501      CALL mpp_get_contour(tl_mpp) 
     502      ! open mpp file to be used 
     503      CALL iom_mpp_open(tl_mpp) 
     504 
     505      IF( td_mpp%i_perio >= 0 .AND. td_mpp%i_perio <= 6 )THEN 
     506         il_perio=td_mpp%i_perio 
     507      ELSE 
     508         ! look for attribute in mpp files 
     509         il_attid=att_get_index(tl_mpp%t_proc(1)%t_att(:),'periodicity') 
     510         IF( il_attid /= 0 )THEN 
     511            il_perio=INT(tl_mpp%t_proc(1)%t_att(il_attid)%d_value(1),i4) 
     512         ENDIF 
     513      ENDIF 
     514       
     515      IF( td_mpp%i_ew >= 0 )THEN 
     516         il_ew=td_mpp%i_ew 
     517      ELSE 
     518         ! look for attribute in mpp files 
     519         il_attid=att_get_index(tl_mpp%t_proc(1)%t_att(:),'ew_overlap') 
     520         IF( il_attid /= 0 )THEN 
     521            il_ew=INT(tl_mpp%t_proc(1)%t_att(il_attid)%d_value(1),i4) 
     522         ENDIF 
     523      ENDIF 
     524 
     525      SELECT CASE(il_perio) 
     526      CASE(3,4) 
     527         il_pivot=0 
     528      CASE(5,6) 
     529         il_pivot=1 
     530      CASE(0,1,2) 
     531         il_pivot=1 
     532      END SELECT 
     533 
     534      IF( il_pivot < 0 .OR. il_pivot > 1 )THEN 
     535         ! get pivot 
     536         il_pivot=grid_get_pivot(tl_mpp) 
     537      ENDIF 
     538 
     539      IF( il_perio < 0 .OR. il_perio > 6 )THEN 
     540         ! get periodicity 
     541         il_perio=grid_get_perio(tl_mpp, il_pivot) 
     542      ENDIF 
     543 
     544      IF( il_ew < 0 )THEN 
     545         ! get periodicity 
     546         il_ew=grid_get_ew_overlap(tl_mpp) 
     547      ENDIF 
     548 
     549      ! close 
     550      CALL iom_mpp_close(tl_mpp) 
     551 
     552      !save in mpp structure 
     553      td_mpp%i_ew=il_ew 
     554      td_mpp%i_pivot=il_pivot 
     555      td_mpp%i_perio=il_perio 
     556 
     557      ! save in variable of mpp structure 
     558      IF( ASSOCIATED(td_mpp%t_proc) )THEN 
     559         tl_att=att_init("ew_overlap",il_ew) 
     560         DO jj=1,td_mpp%i_nproc 
     561            DO ji=1,td_mpp%t_proc(jj)%i_nvar 
     562               IF( td_mpp%t_proc(jj)%t_var(ji)%t_dim(jp_I)%l_use )THEN 
     563                  CALL var_move_att(td_mpp%t_proc(jj)%t_var(ji),tl_att) 
     564               ENDIF 
     565            ENDDO 
     566         ENDDO 
     567      ENDIF 
     568 
     569      ! clean  
     570      CALL mpp_clean(tl_mpp) 
     571      CALL att_clean(tl_att) 
     572 
     573      IF( td_mpp%i_perio == -1 )THEN 
     574         CALL logger_fatal("GRID GET INFO: can not read or compute "//& 
     575         &  "domain periodicity from mpp "//TRIM(td_mpp%c_name)//"."//& 
     576         &  " you have to inform periodicity in namelist.") 
     577      ENDIF 
     578 
     579   END SUBROUTINE grid__get_info_mpp 
     580   !------------------------------------------------------------------- 
    78581   !> @brief  
    79    !> This funtion return NEMO pivot point index of the input variable. 
     582   !> This function compute NEMO pivot point index of the input variable. 
    80583   !> - F-point : 0 
    81584   !> - T-point : 1 
    82585   !> 
     586   !> @details 
     587   !> check north points of latitude grid (indices jpj to jpj-3) depending on which grid point 
     588   !> (T,F,U,V) variable is defined 
     589   !>  
     590   !> @note variable must be at least 2D variable, and should not be coordinate 
     591   !> variable (i.e lon, lat) 
     592   !>  
    83593   !> @warning  
    84    !> - variable must be nav_lon or nav_lat 
    85594   !> - do not work with ORCA2 grid (T-point) 
    86595   !> 
    87596   !> @author J.Paul 
    88    !> - Nov, 2013- Subroutine written 
    89    ! 
    90    !> @todo  
    91    !> - improve check between T or F pivot. 
    92    ! 
    93    !> @param[in] td_file : file structure 
    94    !> @param[in] cd_varname : variable name 
    95    !> @return NEMO pivot point index 
    96    !------------------------------------------------------------------- 
    97    !> @code 
    98    INTEGER(i4) FUNCTION grid_get_pivot(td_file) 
     597   !> - November, 2013- Subroutine written 
     598   !> @date September, 2014 
     599   !> - add dummy loop in case variable not over right point. 
     600   !> @date October, 2014 
     601   !> - work on variable structure instead of file structure 
     602   ! 
     603   !> @param[in] td_lat  latitude variable structure 
     604   !> @param[in] td_var  variable structure 
     605   !> @return pivot point index 
     606   !------------------------------------------------------------------- 
     607   FUNCTION grid__get_pivot_var(td_var) 
    99608      IMPLICIT NONE 
    100609      ! Argument       
    101       TYPE(TFILE),       INTENT(IN) :: td_file 
     610      TYPE(TVAR), INTENT(IN) :: td_var 
     611 
     612      ! function 
     613      INTEGER(i4) :: grid__get_pivot_var 
    102614 
    103615      ! local variable 
    104       TYPE(TVAR)                        :: tl_var 
     616      INTEGER(i4), DIMENSION(ip_maxdim)            :: il_dim 
     617 
     618      REAL(dp)   , DIMENSION(:,:,:,:), ALLOCATABLE :: dl_value 
     619 
     620      ! loop indices 
     621      INTEGER(i4) :: jj 
     622      !---------------------------------------------------------------- 
     623      ! intitalise 
     624      grid__get_pivot_var=-1 
     625 
     626      IF( .NOT. ASSOCIATED(td_var%d_value) .OR. & 
     627      &   .NOT. ALL(td_var%t_dim(1:2)%l_use) )THEN 
     628         CALL logger_error("GRID GET PIVOT: can not compute pivot point"//& 
     629         &  " with variable "//TRIM(td_var%c_name)//"."//& 
     630         &  " no value associated or missing dimension.") 
     631      ELSE 
     632         il_dim(:)=td_var%t_dim(:)%i_len 
     633 
     634         ALLOCATE(dl_value(il_dim(1),4,1,1)) 
     635         ! extract value 
     636         dl_value(:,:,:,:)=td_var%d_value( 1:il_dim(1),          & 
     637         &                                 il_dim(2)-3:il_dim(2),& 
     638         &                                 1:1,                  & 
     639         &                                 1:1 ) 
     640 
     641         SELECT CASE(TRIM(td_var%c_point)) 
     642         CASE('T') 
     643            grid__get_pivot_var=grid__get_pivot_varT(dl_value) 
     644         CASE('U') 
     645            grid__get_pivot_var=grid__get_pivot_varU(dl_value) 
     646         CASE('V') 
     647            grid__get_pivot_var=grid__get_pivot_varV(dl_value) 
     648         CASE('F') 
     649            grid__get_pivot_var=grid__get_pivot_varF(dl_value) 
     650         END SELECT 
     651 
     652         ! dummy loop in case variable not over right point  
     653         ! (ex: nav_lon over U-point) 
     654         IF( grid__get_pivot_var == -1 )THEN 
     655             
     656            ! no pivot point found 
     657            CALL logger_error("GRID GET PIVOT: something wrong "//& 
     658            &  "when computing pivot point with variable "//& 
     659            &  TRIM(td_var%c_name)) 
     660 
     661            DO jj=1,ip_npoint 
     662               SELECT CASE(TRIM(cp_grid_point(jj))) 
     663               CASE('T') 
     664                  CALL logger_debug("GRID GET PIVOT: check variable on point T") 
     665                  grid__get_pivot_var=grid__get_pivot_varT(dl_value) 
     666               CASE('U') 
     667                  CALL logger_debug("GRID GET PIVOT: check variable on point U") 
     668                  grid__get_pivot_var=grid__get_pivot_varU(dl_value) 
     669               CASE('V') 
     670                  CALL logger_debug("GRID GET PIVOT: check variable on point V") 
     671                  grid__get_pivot_var=grid__get_pivot_varV(dl_value) 
     672               CASE('F') 
     673                  CALL logger_debug("GRID GET PIVOT: check variable on point F") 
     674                  grid__get_pivot_var=grid__get_pivot_varF(dl_value) 
     675               END SELECT 
     676 
     677               IF( grid__get_pivot_var /= -1 )THEN 
     678                  CALL logger_warn("GRID GET PIVOT: variable "//& 
     679                  &  TRIM(td_var%c_name)//" seems to be on grid point "//& 
     680                  &  TRIM(cp_grid_point(jj)) ) 
     681                  EXIT 
     682               ENDIF 
     683 
     684            ENDDO 
     685         ENDIF 
     686 
     687         IF( grid__get_pivot_var == -1 )THEN 
     688            CALL logger_warn("GRID GET PIVOT: not able to found pivot point. "//& 
     689            &  "Force to use pivot point T.") 
     690            grid__get_pivot_var = 1 
     691         ENDIF 
     692 
     693         ! clean 
     694         DEALLOCATE(dl_value) 
     695 
     696      ENDIF 
     697 
     698   END FUNCTION grid__get_pivot_var 
     699   !------------------------------------------------------------------- 
     700   !> @brief  
     701   !> This function compute NEMO pivot point index for variable on grid T. 
     702   !> 
     703   !> @details 
     704   !> - F-point : 0 
     705   !> - T-point : 1 
     706   !> 
     707   !> @note array of value must be only the top border of the domain. 
     708   !>  
     709   !> @author J.Paul 
     710   !> - October, 2014 - Initial version 
     711   ! 
     712   !> @param[in] dd_value array of value 
     713   !> @return pivot point index 
     714   !------------------------------------------------------------------- 
     715   FUNCTION grid__get_pivot_varT(dd_value) 
     716      IMPLICIT NONE 
     717      ! Argument       
     718      REAL(dp), DIMENSION(:,:,:,:), INTENT(IN) :: dd_value 
     719 
     720      ! function 
     721      INTEGER(i4) :: grid__get_pivot_varT 
     722 
     723      ! local variable 
     724      INTEGER(i4)                       :: il_midT 
     725      INTEGER(i4)                       :: il_midF 
     726 
     727      INTEGER(i4)                       :: it1 
     728      INTEGER(i4)                       :: it2 
     729      INTEGER(i4)                       :: jt1 
     730      INTEGER(i4)                       :: jt2 
     731 
     732      INTEGER(i4)                       :: if1 
     733      INTEGER(i4)                       :: if2 
     734      INTEGER(i4)                       :: jf1 
     735      INTEGER(i4)                       :: jf2 
     736 
     737      INTEGER(i4), DIMENSION(ip_maxdim) :: il_dim 
     738 
     739      LOGICAL                           :: ll_check 
     740 
     741      ! loop indices 
     742      INTEGER(i4) :: ji 
     743      !---------------------------------------------------------------- 
     744      ! intitalise 
     745      grid__get_pivot_varT=-1 
     746 
     747      il_dim(:)=SHAPE(dd_value(:,:,:,:)) 
     748 
     749      ! T-point pivot !case of ORCA2, ORCA025, ORCA12 grid 
     750      jt1=4  ; jt2=2  
     751      il_midT=il_dim(1)/2+1 
     752 
     753      ! F-point pivot !case of ORCA05 grid 
     754      jf1=4 ; jf2=3 
     755      il_midF=il_dim(1)/2 
     756 
     757      ! check T-point pivot 
     758      DO ji=2,il_midT 
     759         ll_check=.TRUE. 
     760         it1=ji 
     761         it2=il_dim(1)-(ji-2) 
     762         IF( dd_value(it1,jt1,1,1) /= dd_value(it2,jt2,1,1) )THEN 
     763            ll_check=.FALSE. 
     764            EXIT 
     765         ENDIF 
     766      ENDDO 
     767 
     768      IF( ll_check )THEN 
     769         CALL logger_info("GRID GET PIVOT: T-pivot") 
     770         grid__get_pivot_varT=1 
     771      ELSE 
     772 
     773         ! check F-point pivot 
     774         DO ji=1,il_midF 
     775            ll_check=.TRUE. 
     776            if1=ji 
     777            if2=il_dim(1)-(ji-1) 
     778            IF( dd_value(if1,jf1,1,1) /= dd_value(if2,jf2,1,1) )THEN 
     779               ll_check=.FALSE. 
     780               EXIT 
     781            ENDIF 
     782         ENDDO 
     783 
     784         IF( ll_check )THEN 
     785            CALL logger_info("GRID GET PIVOT: T-pivot") 
     786            grid__get_pivot_varT=0 
     787         ENDIF 
     788 
     789      ENDIF 
     790 
     791   END FUNCTION grid__get_pivot_varT 
     792   !------------------------------------------------------------------- 
     793   !> @brief  
     794   !> This function compute NEMO pivot point index for variable on grid U. 
     795   !> 
     796   !> @details 
     797   !> - F-point : 0 
     798   !> - T-point : 1 
     799   !> 
     800   !> @note array of value must be only the top border of the domain. 
     801   !>  
     802   !> @author J.Paul 
     803   !> - October, 2014 - Initial version 
     804   ! 
     805   !> @param[in] dd_value array of value 
     806   !> @return pivot point index 
     807   !------------------------------------------------------------------- 
     808   FUNCTION grid__get_pivot_varU(dd_value) 
     809      IMPLICIT NONE 
     810      ! Argument       
     811      REAL(dp), DIMENSION(:,:,:,:), INTENT(IN) :: dd_value 
     812 
     813      ! function 
     814      INTEGER(i4) :: grid__get_pivot_varU 
     815 
     816      ! local variable 
     817      INTEGER(i4)                       :: il_midT 
     818      INTEGER(i4)                       :: il_midF 
     819 
     820      INTEGER(i4)                       :: it1 
     821      INTEGER(i4)                       :: it2 
     822      INTEGER(i4)                       :: jt1 
     823      INTEGER(i4)                       :: jt2 
     824 
     825      INTEGER(i4)                       :: if1 
     826      INTEGER(i4)                       :: if2 
     827      INTEGER(i4)                       :: jf1 
     828      INTEGER(i4)                       :: jf2 
     829 
     830      INTEGER(i4), DIMENSION(ip_maxdim) :: il_dim 
     831 
     832      LOGICAL                           :: ll_check 
     833 
     834      ! loop indices 
     835      INTEGER(i4) :: ji 
     836      !---------------------------------------------------------------- 
     837      ! intitalise 
     838      grid__get_pivot_varU=-1 
     839 
     840      il_dim(:)=SHAPE(dd_value(:,:,:,:)) 
     841 
     842      ! T-point pivot !case of ORCA2, ORCA025, ORCA12 grid 
     843      jt1=4 ; jt2=2  
     844      il_midT=il_dim(1)/2+1 
     845 
     846      ! F-point pivot !case of ORCA05 grid 
     847      jf1=4 ; jf2=3 
     848      il_midF=il_dim(1)/2 
     849 
     850      ! check T-point pivot 
     851      DO ji=1,il_midT 
     852         ll_check=.TRUE. 
     853         it1=ji 
     854         it2=il_dim(1)-(ji-2) 
     855         IF( dd_value(it1,jt1,1,1) /= dd_value(it2-1,jt2,1,1) )THEN 
     856            ll_check=.FALSE. 
     857            EXIT 
     858         ENDIF 
     859      ENDDO 
     860 
     861      IF( ll_check )THEN 
     862         CALL logger_info("GRID GET PIVOT: T-pivot") 
     863         grid__get_pivot_varU=1 
     864      ELSE 
     865 
     866         ! check F-point pivot 
     867         DO ji=1,il_midF 
     868            ll_check=.TRUE. 
     869            if1=ji 
     870            if2=il_dim(1)-(ji-1) 
     871            IF( dd_value(if1,jf1,1,1) /= dd_value(if2-1,jf2,1,1) )THEN 
     872               ll_check=.FALSE. 
     873               EXIT 
     874            ENDIF 
     875         ENDDO 
     876 
     877         IF( ll_check )THEN 
     878            CALL logger_info("GRID GET PIVOT: T-pivot") 
     879            grid__get_pivot_varU=0 
     880         ENDIF 
     881 
     882      ENDIF 
     883 
     884   END FUNCTION grid__get_pivot_varU 
     885   !------------------------------------------------------------------- 
     886   !> @brief  
     887   !> This function compute NEMO pivot point index for variable on grid V. 
     888   !> 
     889   !> @details 
     890   !> - F-point : 0 
     891   !> - T-point : 1 
     892   !> 
     893   !> @note array of value must be only the top border of the domain. 
     894   !>  
     895   !> @author J.Paul 
     896   !> - October, 2014 - Initial version 
     897   ! 
     898   !> @param[in] dd_value array of value 
     899   !> @return pivot point index 
     900   !------------------------------------------------------------------- 
     901   FUNCTION grid__get_pivot_varV(dd_value) 
     902      IMPLICIT NONE 
     903      ! Argument       
     904      REAL(dp), DIMENSION(:,:,:,:), INTENT(IN) :: dd_value 
     905 
     906      ! function 
     907      INTEGER(i4) :: grid__get_pivot_varV 
     908 
     909      ! local variable 
     910      INTEGER(i4)                       :: il_midT 
     911      INTEGER(i4)                       :: il_midF 
     912 
     913      INTEGER(i4)                       :: it1 
     914      INTEGER(i4)                       :: it2 
     915      INTEGER(i4)                       :: jt1 
     916      INTEGER(i4)                       :: jt2 
     917 
     918      INTEGER(i4)                       :: if1 
     919      INTEGER(i4)                       :: if2 
     920      INTEGER(i4)                       :: jf1 
     921      INTEGER(i4)                       :: jf2 
     922 
     923      INTEGER(i4), DIMENSION(ip_maxdim) :: il_dim 
     924 
     925      LOGICAL                           :: ll_check 
     926 
     927      ! loop indices 
     928      INTEGER(i4) :: ji 
     929      !---------------------------------------------------------------- 
     930      ! intitalise 
     931      grid__get_pivot_varV=-1 
     932 
     933      il_dim(:)=SHAPE(dd_value(:,:,:,:)) 
     934 
     935      ! T-point pivot !case of ORCA2, ORCA025, ORCA12 grid 
     936      jt1=4 ; jt2=2  
     937      il_midT=il_dim(1)/2+1 
     938 
     939      ! F-point pivot !case of ORCA05 grid 
     940      jf1=4 ; jf2=3 
     941      il_midF=il_dim(1)/2 
     942 
     943      ! check T-point pivot 
     944      DO ji=2,il_midT 
     945         ll_check=.TRUE. 
     946         it1=ji 
     947         it2=il_dim(1)-(ji-2) 
     948         IF( dd_value(it1,jt1,1,1) /= dd_value(it2,jt2-1,1,1) )THEN 
     949            ll_check=.FALSE. 
     950            EXIT 
     951         ENDIF 
     952      ENDDO 
     953 
     954      IF( ll_check )THEN 
     955         CALL logger_info("GRID GET PIVOT: T-pivot") 
     956         grid__get_pivot_varV=1 
     957      ELSE 
     958 
     959         ! check F-point pivot 
     960         DO ji=1,il_midF 
     961            ll_check=.TRUE. 
     962            if1=ji 
     963            if2=il_dim(1)-(ji-1) 
     964            IF( dd_value(if1,jf1,1,1) /= dd_value(if2,jf2-1,1,1) )THEN 
     965               ll_check=.FALSE. 
     966               EXIT 
     967            ENDIF 
     968         ENDDO 
     969 
     970         IF( ll_check )THEN 
     971            CALL logger_info("GRID GET PIVOT: T-pivot") 
     972            grid__get_pivot_varV=0 
     973         ENDIF 
     974 
     975      ENDIF 
     976 
     977   END FUNCTION grid__get_pivot_varV 
     978   !------------------------------------------------------------------- 
     979   !> @brief  
     980   !> This function compute NEMO pivot point index for variable on grid F. 
     981   !> 
     982   !> @details 
     983   !> - F-point : 0 
     984   !> - T-point : 1 
     985   !> 
     986   !> @note array of value must be only the top border of the domain. 
     987   !>  
     988   !> @author J.Paul 
     989   !> - October, 2014 - Initial version 
     990   ! 
     991   !> @param[in] dd_value array of value 
     992   !> @return pivot point index 
     993   !------------------------------------------------------------------- 
     994   FUNCTION grid__get_pivot_varF(dd_value) 
     995      IMPLICIT NONE 
     996      ! Argument       
     997      REAL(dp), DIMENSION(:,:,:,:), INTENT(IN) :: dd_value 
     998 
     999      ! function 
     1000      INTEGER(i4) :: grid__get_pivot_varF 
     1001 
     1002      ! local variable 
     1003      INTEGER(i4)                       :: il_midT 
     1004      INTEGER(i4)                       :: il_midF 
     1005 
     1006      INTEGER(i4)                       :: it1 
     1007      INTEGER(i4)                       :: it2 
     1008      INTEGER(i4)                       :: jt1 
     1009      INTEGER(i4)                       :: jt2 
     1010 
     1011      INTEGER(i4)                       :: if1 
     1012      INTEGER(i4)                       :: if2 
     1013      INTEGER(i4)                       :: jf1 
     1014      INTEGER(i4)                       :: jf2 
     1015 
     1016      INTEGER(i4), DIMENSION(ip_maxdim) :: il_dim 
     1017 
     1018      LOGICAL                           :: ll_check 
     1019 
     1020      ! loop indices 
     1021      INTEGER(i4) :: ji 
     1022      !---------------------------------------------------------------- 
     1023      ! intitalise 
     1024      grid__get_pivot_varF=-1 
     1025 
     1026      il_dim(:)=SHAPE(dd_value(:,:,:,:)) 
     1027 
     1028      ! T-point pivot !case of ORCA2, ORCA025, ORCA12 grid 
     1029      jt1=4 ; jt2=2  
     1030      il_midT=il_dim(1)/2+1 
     1031 
     1032      ! F-point pivot !case of ORCA05 grid 
     1033      jf1=4 ; jf2=3 
     1034      il_midF=il_dim(1)/2 
     1035 
     1036      ! check T-point pivot 
     1037      DO ji=1,il_midT 
     1038         ll_check=.TRUE. 
     1039         it1=ji 
     1040         it2=il_dim(1)-(ji-2) 
     1041         IF( dd_value(it1,jt1,1,1) /= dd_value(it2-1,jt2-1,1,1) )THEN 
     1042            ll_check=.FALSE. 
     1043            EXIT 
     1044         ENDIF 
     1045      ENDDO 
     1046 
     1047      IF( ll_check )THEN 
     1048         CALL logger_info("GRID GET PIVOT: T-pivot") 
     1049         grid__get_pivot_varF=1 
     1050      ELSE 
     1051 
     1052         ! check F-point pivot 
     1053         DO ji=1,il_midF 
     1054            ll_check=.TRUE. 
     1055            if1=ji 
     1056            if2=il_dim(1)-(ji-1) 
     1057            IF( dd_value(if1,jf1,1,1) /= dd_value(if2-1,jf2-1,1,1) )THEN 
     1058               ll_check=.FALSE. 
     1059               EXIT 
     1060            ENDIF 
     1061         ENDDO 
     1062 
     1063         IF( ll_check )THEN 
     1064            CALL logger_info("GRID GET PIVOT: T-pivot") 
     1065            grid__get_pivot_varF=0 
     1066         ENDIF 
     1067 
     1068      ENDIF 
     1069 
     1070   END FUNCTION grid__get_pivot_varF 
     1071   !------------------------------------------------------------------- 
     1072   !> @brief  
     1073   !> This function compute NEMO pivot point index from input file variable. 
     1074   !> - F-point : 0 
     1075   !> - T-point : 1 
     1076   !> 
     1077   !> @details 
     1078   !> check north points of latitude grid (indices jpj to jpj-3) depending on which grid point 
     1079   !> (T,F,U,V) variable is defined 
     1080   !>  
     1081   !> @warning  
     1082   !> - do not work with ORCA2 grid (T-point) 
     1083   !> 
     1084   !> @author J.Paul 
     1085   !> - Ocotber, 2014- Initial version 
     1086   ! 
     1087   !> @param[in] td_file file structure 
     1088   !> @return pivot point index 
     1089   !------------------------------------------------------------------- 
     1090   FUNCTION grid__get_pivot_file(td_file) 
     1091      IMPLICIT NONE 
     1092      ! Argument       
     1093      TYPE(TFILE), INTENT(IN) :: td_file 
     1094 
     1095      ! function 
     1096      INTEGER(i4) :: grid__get_pivot_file 
     1097 
     1098      ! local variable 
    1051099      INTEGER(i4)                       :: il_varid 
    1061100      INTEGER(i4), DIMENSION(ip_maxdim) :: il_dim 
    1071101 
     1102      LOGICAL                           :: ll_north 
     1103 
     1104      TYPE(TVAR)                        :: tl_var 
     1105      TYPE(TVAR)                        :: tl_lat 
     1106 
    1081107      ! loop indices 
    1091108      INTEGER(i4) :: ji 
    110  
    111       INTEGER(i4) :: it1 
    112       INTEGER(i4) :: it2 
    113       INTEGER(i4) :: jt1 
    114       INTEGER(i4) :: jt2 
    115  
    116       INTEGER(i4) :: if1 
    117       INTEGER(i4) :: if2 
    118       INTEGER(i4) :: jf1 
    119       INTEGER(i4) :: jf2 
    1201109      !---------------------------------------------------------------- 
    121       ! initialise 
    122       grid_get_pivot=-1 
     1110      ! intitalise 
     1111      grid__get_pivot_file=-1 
     1112 
     1113      ! look for north fold 
     1114      il_varid=var_get_index(td_file%t_var(:), 'latitude') 
     1115      IF( il_varid == 0 )THEN 
     1116         CALL logger_error("GRID GET PIVOT: no variable with name "//& 
     1117         &  "or standard name latitude in file structure "//& 
     1118         &  TRIM(td_file%c_name)) 
     1119      ENDIF 
     1120      IF( ASSOCIATED(td_file%t_var(il_varid)%d_value) )THEN 
     1121         tl_lat=var_copy(td_file%t_var(il_varid)) 
     1122      ELSE 
     1123         tl_lat=iom_read_var(td_file, 'latitude') 
     1124      ENDIF 
     1125 
     1126      ll_north=grid_is_north_fold(tl_lat) 
     1127      ! clean 
     1128      CALL var_clean(tl_lat) 
     1129 
     1130      IF( ll_north )THEN       
     1131         ! look for suitable variable 
     1132         DO ji=1,td_file%i_nvar 
     1133            IF( .NOT. ALL(td_file%t_var(ji)%t_dim(1:2)%l_use) ) CYCLE 
     1134 
     1135            IF( ASSOCIATED(td_file%t_var(ji)%d_value) )THEN 
     1136               tl_var=var_copy(td_file%t_var(ji)) 
     1137            ELSE 
     1138               il_dim(:)=td_file%t_var(ji)%t_dim(:)%i_len 
     1139               tl_var=iom_read_var(td_file, & 
     1140               &                   td_file%t_var(ji)%c_name, & 
     1141               &                   id_start=(/1,il_dim(2)-3,1,1/), & 
     1142               &                   id_count=(/il_dim(1),4,1,1/) ) 
     1143            ENDIF 
     1144         ENDDO 
     1145 
     1146         IF( ASSOCIATED(tl_var%d_value) )THEN 
     1147 
     1148            grid__get_pivot_file=grid_get_pivot(tl_var) 
     1149 
     1150         ENDIF 
     1151 
     1152         ! clean 
     1153         CALL var_clean(tl_var) 
     1154      ELSE 
     1155         CALL logger_warn("GRID GET PIVOT: no north fold. force to use T-PIVOT") 
     1156         grid__get_pivot_file=1 
     1157      ENDIF 
     1158 
     1159   END FUNCTION grid__get_pivot_file 
     1160   !------------------------------------------------------------------- 
     1161   !> @brief  
     1162   !> This function compute NEMO pivot point index from input mpp variable. 
     1163   !> - F-point : 0 
     1164   !> - T-point : 1 
     1165   !> 
     1166   !> @details 
     1167   !> check north points of latitude grid (indices jpj to jpj-3) depending on which grid point 
     1168   !> (T,F,U,V) variable is defined 
     1169   !>  
     1170   !> @warning  
     1171   !> - do not work with ORCA2 grid (T-point) 
     1172   !> 
     1173   !> @author J.Paul 
     1174   !> - October, 2014 - Initial version 
     1175   ! 
     1176   !> @param[in] td_mpp   mpp file structure 
     1177   !> @return pivot point index 
     1178   !------------------------------------------------------------------- 
     1179   FUNCTION grid__get_pivot_mpp(td_mpp) 
     1180      IMPLICIT NONE 
     1181      ! Argument       
     1182      TYPE(TMPP), INTENT(IN) :: td_mpp 
     1183 
     1184      ! function 
     1185      INTEGER(i4) :: grid__get_pivot_mpp 
     1186 
     1187      ! local variable 
     1188      INTEGER(i4)                       :: il_varid 
     1189      INTEGER(i4), DIMENSION(ip_maxdim) :: il_dim 
     1190 
     1191      LOGICAL                           :: ll_north 
     1192 
     1193      TYPE(TVAR)                        :: tl_var 
     1194      TYPE(TVAR)                        :: tl_lat 
     1195  
     1196      ! loop indices 
     1197      INTEGER(i4) :: ji 
     1198      !---------------------------------------------------------------- 
     1199      ! intitalise 
     1200      grid__get_pivot_mpp=-1 
     1201 
     1202      ! look for north fold 
     1203      il_varid=var_get_index(td_mpp%t_proc(1)%t_var(:), 'latitude') 
     1204      IF( il_varid == 0 )THEN 
     1205         CALL logger_error("GRID GET PIVOT: no variable with name "//& 
     1206         &  "or standard name latitude in mpp structure "//& 
     1207         &  TRIM(td_mpp%c_name)//". Assume there is north fold and "//& 
     1208         &  "try to get pivot point") 
     1209 
     1210         ll_north=.TRUE. 
     1211      ELSE 
     1212         IF( ASSOCIATED(td_mpp%t_proc(1)%t_var(il_varid)%d_value) )THEN 
     1213            !  
     1214            tl_lat=mpp_recombine_var(td_mpp, 'latitude') 
     1215         ELSE 
     1216            tl_lat=iom_mpp_read_var(td_mpp, 'latitude') 
     1217         ENDIF       
     1218 
     1219         ll_north=grid_is_north_fold(tl_lat) 
     1220      ENDIF 
     1221 
     1222      IF( ll_north )THEN 
     1223 
     1224         IF( ASSOCIATED(tl_lat%d_value) )THEN 
     1225            grid__get_pivot_mpp=grid_get_pivot(tl_lat) 
     1226         ELSE 
     1227            ! look for suitable variable 
     1228            DO ji=1,td_mpp%t_proc(1)%i_nvar 
     1229               IF(.NOT. ALL(td_mpp%t_proc(1)%t_var(ji)%t_dim(1:2)%l_use)) CYCLE 
     1230 
     1231               IF( ASSOCIATED(td_mpp%t_proc(1)%t_var(ji)%d_value) )THEN 
     1232                  CALL logger_debug("GRID GET PIVOT: mpp_recombine_var"//& 
     1233                  &         TRIM(td_mpp%t_proc(1)%t_var(ji)%c_name)) 
     1234                  tl_var=mpp_recombine_var(td_mpp, & 
     1235                  &              TRIM(td_mpp%t_proc(1)%t_var(ji)%c_name)) 
     1236               ELSE 
     1237                  CALL logger_debug("GRID GET PIVOT: iom_mpp_read_var "//& 
     1238                  &        TRIM(td_mpp%t_proc(1)%t_var(ji)%c_name)) 
     1239                  il_dim(:)=td_mpp%t_dim(:)%i_len 
     1240 
     1241                  ! read variable 
     1242                  tl_var=iom_mpp_read_var(td_mpp, & 
     1243                  &                       td_mpp%t_proc(1)%t_var(ji)%c_name, & 
     1244                  &                       id_start=(/1,il_dim(2)-3,1,1/), & 
     1245                  &                       id_count=(/il_dim(1),4,1,1/) ) 
     1246               ENDIF 
     1247               EXIT 
     1248            ENDDO 
     1249 
     1250            IF( ASSOCIATED(tl_var%d_value) )THEN 
     1251 
     1252               grid__get_pivot_mpp=grid_get_pivot(tl_var) 
     1253 
     1254           ELSE 
     1255               CALL logger_warn("GRID GET PIVOT: force to use T-PIVOT") 
     1256               grid__get_pivot_mpp=1 
     1257            ENDIF 
     1258 
     1259            ! clean 
     1260            CALL var_clean(tl_var) 
     1261         ENDIF 
     1262      ELSE 
     1263         CALL logger_warn("GRID GET PIVOT: no north fold. force to use T-PIVOT") 
     1264         grid__get_pivot_mpp=1 
     1265      ENDIF 
     1266 
     1267      CALL var_clean(tl_lat) 
     1268   END FUNCTION grid__get_pivot_mpp 
     1269   !------------------------------------------------------------------- 
     1270   !> @brief  
     1271   !> This subroutine search NEMO periodicity index given variable structure and 
     1272   !> pivot point index. 
     1273   !> @details 
     1274   !> The variable must be on T point. 
     1275   !> 
     1276   !> 0: closed boundaries 
     1277   !> 1: cyclic east-west boundary 
     1278   !> 2: symmetric boundary condition across the equator 
     1279   !> 3: North fold boundary (with a F-point pivot) 
     1280   !> 4: North fold boundary (with a F-point pivot) and cyclic east-west boundary 
     1281   !> 5: North fold boundary (with a T-point pivot) 
     1282   !> 6: North fold boundary (with a T-point pivot) and cyclic east-west boundary 
     1283   !> 
     1284   !> @warning pivot point should have been computed before run this script. see grid_get_pivot. 
     1285   !> 
     1286   !> @author J.Paul 
     1287   !> - November, 2013- Subroutine written 
     1288   !> @date October, 2014 
     1289   !> - work on variable structure instead of file structure 
     1290   ! 
     1291   !> @param[in] td_var   variable structure 
     1292   !> @param[in] id_pivot pivot point index 
     1293   !------------------------------------------------------------------- 
     1294   FUNCTION grid__get_perio_var(td_var, id_pivot) 
     1295      IMPLICIT NONE 
     1296 
     1297      ! Argument       
     1298      TYPE(TVAR) , INTENT(IN) :: td_var 
     1299      INTEGER(i4), INTENT(IN) :: id_pivot 
     1300 
     1301      ! function 
     1302      INTEGER(i4) :: grid__get_perio_var 
     1303 
     1304      ! local variable 
     1305      INTEGER(i4)                       :: il_perio 
     1306 
     1307      INTEGER(i4), DIMENSION(ip_maxdim) :: il_dim 
     1308 
     1309      ! loop indices 
     1310      !---------------------------------------------------------------- 
     1311      ! intitalise 
     1312      grid__get_perio_var=-1 
     1313 
     1314      IF( id_pivot < 0 .OR. id_pivot > 1 )THEN 
     1315         CALL logger_error("GRID GET PERIO: invalid pivot point index. "//& 
     1316         &  "you should use grid_get_pivot to compute it") 
     1317      ENDIF 
     1318 
     1319      IF( .NOT. ASSOCIATED(td_var%d_value) .OR. & 
     1320      &   .NOT. ALL(td_var%t_dim(1:2)%l_use) )THEN 
     1321         CALL logger_error("GRID GET PERIO: can not compute periodicity"//& 
     1322         &  " with variable "//TRIM(td_var%c_name)//"."//& 
     1323         &  " no value associated or missing dimension.") 
     1324      ELSE 
     1325 
     1326         il_dim(:)=td_var%t_dim(:)%i_len 
     1327 
     1328         CALL logger_info("GRID GET PERIO: use varibale "//TRIM(td_var%c_name)) 
     1329         CALL logger_info("GRID GET PERIO: fill value "//TRIM(fct_str(td_var%d_fill))) 
     1330         CALL logger_info("GRID GET PERIO: fill value "//TRIM(fct_str(td_var%d_value(1,1,1,1)))) 
     1331 
     1332         IF(ALL(td_var%d_value(    1    ,    :    ,1,1)/=td_var%d_fill).AND.& 
     1333         &  ALL(td_var%d_value(il_dim(1),    :    ,1,1)/=td_var%d_fill).AND.& 
     1334         &  ALL(td_var%d_value(    :    ,    1    ,1,1)/=td_var%d_fill).AND.& 
     1335         &  ALL(td_var%d_value(    :    ,il_dim(2),1,1)/=td_var%d_fill))THEN 
     1336         ! no boundary closed 
     1337            CALL logger_warn("GRID GET PERIO: can't determined periodicity. "//& 
     1338            &             "there is no boundary closed for variable "//& 
     1339            &              TRIM(td_var%c_name) ) 
     1340         ELSE 
     1341            ! check periodicity 
     1342            IF(ANY(td_var%d_value(   1     ,:,1,1)/=td_var%d_fill).OR.& 
     1343            &  ANY(td_var%d_value(il_dim(1),:,1,1)/=td_var%d_fill))THEN 
     1344            ! East-West cyclic (1,4,6) 
     1345 
     1346               IF( ANY(td_var%d_value(:, 1, 1, 1) /= td_var%d_fill) )THEN 
     1347               ! South boundary not closed  
     1348 
     1349                  CALL logger_debug("GRID GET PERIO: East_West cyclic") 
     1350                  CALL logger_debug("GRID GET PERIO: South boundary not closed") 
     1351                  CALL logger_error("GRID GET PERIO: should have been an "//& 
     1352                  &              "impossible case") 
     1353 
     1354               ELSE 
     1355               ! South boundary closed (1,4,6) 
     1356                  CALL logger_info("GRID GET PERIO: South boundary closed") 
     1357 
     1358                  IF(ANY(td_var%d_value(:,il_dim(2),1,1)/=td_var%d_fill) )THEN 
     1359                  ! North boundary not closed (4,6) 
     1360                     CALL logger_info("GRID GET PERIO: North boundary not closed") 
     1361                     ! check pivot 
     1362                     SELECT CASE(id_pivot) 
     1363                        CASE(0) 
     1364                           ! F pivot 
     1365                           il_perio=6 
     1366                        CASE(1) 
     1367                           ! T pivot 
     1368                           il_perio=4 
     1369                        CASE DEFAULT 
     1370                           CALL logger_error("GRID GET PERIO: invalid pivot ") 
     1371                     END SELECT 
     1372                  ELSE 
     1373                  ! North boundary closed 
     1374                     CALL logger_info("GRID GET PERIO: North boundary closed") 
     1375                     il_perio=1 ! North and South boundaries closed 
     1376                  ENDIF 
     1377 
     1378               ENDIF 
     1379 
     1380            ELSE 
     1381            ! East-West boundaries closed (0,2,3,5) 
     1382               CALL logger_info("GRID GET PERIO: East West boundaries closed") 
     1383 
     1384               IF( ANY(td_var%d_value(:, 1, 1, 1) /= td_var%d_fill) )THEN 
     1385               ! South boundary not closed (2) 
     1386                  CALL logger_info("GRID GET PERIO: South boundary not closed") 
     1387 
     1388                  IF(ANY(td_var%d_value(:,il_dim(2),1,1)/=td_var%d_fill))THEN 
     1389                  ! North boundary not closed 
     1390                     CALL logger_debug("GRID GET PERIO: East West boundaries "//& 
     1391                     &              "closed") 
     1392                     CALL logger_debug("GRID GET PERIO: South boundary not closed") 
     1393                     CALL logger_debug("GRID GET PERIO: North boundary not closed") 
     1394                     CALL logger_error("GRID GET PERIO: should have been "//& 
     1395                     &              "an impossible case") 
     1396                  ELSE 
     1397                  ! North boundary closed 
     1398                     il_perio=2   ! East-West and North boundaries closed  
     1399                  ENDIF 
     1400 
     1401               ELSE 
     1402               ! South boundary closed (0,3,5) 
     1403                  CALL logger_info("GRID GET PERIO: South boundary closed") 
     1404 
     1405                  IF(ANY(td_var%d_value(:,il_dim(2),1,1)/=td_var%d_fill))THEN 
     1406                  ! North boundary not closed (3,5) 
     1407                     CALL logger_info("GRID GET PERIO: North boundary not closed") 
     1408                     ! check pivot 
     1409                     SELECT CASE(id_pivot) 
     1410                        CASE(0) 
     1411                           ! F pivot 
     1412                           il_perio=5 
     1413                        CASE(1) 
     1414                           ! T pivot 
     1415                           il_perio=3 
     1416                        CASE DEFAULT 
     1417                           CALL logger_error("GRID GET PERIO: invalid pivot") 
     1418                     END SELECT 
     1419                  ELSE 
     1420                  ! North boundary closed    
     1421                     CALL logger_info("GRID GET PERIO: North boundary closed") 
     1422                     il_perio=0   ! all boundary closed 
     1423                  ENDIF 
     1424 
     1425               ENDIF 
     1426 
     1427            ENDIF 
     1428 
     1429            grid__get_perio_var=il_perio 
     1430 
     1431         ENDIF 
     1432 
     1433      ENDIF 
     1434 
     1435   END FUNCTION grid__get_perio_var 
     1436   !------------------------------------------------------------------- 
     1437   !> @brief  
     1438   !> This subroutine search NEMO periodicity index given file structure, and 
     1439   !> optionaly pivot point index. 
     1440   !> @details 
     1441   !> The variable used must be on T point. 
     1442   !> 
     1443   !> 0: closed boundaries 
     1444   !> 1: cyclic east-west boundary 
     1445   !> 2: symmetric boundary condition across the equator 
     1446   !> 3: North fold boundary (with a F-point pivot) 
     1447   !> 4: North fold boundary (with a F-point pivot) and cyclic east-west boundary 
     1448   !> 5: North fold boundary (with a T-point pivot) 
     1449   !> 6: North fold boundary (with a T-point pivot) and cyclic east-west boundary 
     1450   !> 
     1451   !> @warning pivot point should have been computed before run this script. see grid_get_pivot. 
     1452   !> 
     1453   !> @author J.Paul 
     1454   !> - October, 2014 - Initial version 
     1455   !> 
     1456   !> @param[in] td_file   file structure 
     1457   !> @param[in] id_pivot  pivot point index 
     1458   !------------------------------------------------------------------- 
     1459   FUNCTION grid__get_perio_file(td_file, id_pivot) 
     1460      IMPLICIT NONE 
     1461 
     1462      ! Argument       
     1463      TYPE(TFILE), INTENT(IN) :: td_file 
     1464      INTEGER(i4), INTENT(IN), OPTIONAL :: id_pivot 
     1465 
     1466      ! function 
     1467      INTEGER(i4) :: grid__get_perio_file 
     1468 
     1469      ! local variable 
     1470      INTEGER(i4)                       :: il_varid 
     1471      INTEGER(i4)                       :: il_pivot 
     1472      INTEGER(i4), DIMENSION(ip_maxdim) :: il_dim 
     1473 
     1474      TYPE(TVAR)                        :: tl_var 
     1475 
     1476      ! loop indices 
     1477      INTEGER(i4) :: ji 
     1478      !---------------------------------------------------------------- 
     1479      !initialise 
     1480      grid__get_perio_file=-1 
     1481 
     1482      IF(PRESENT(id_pivot) )THEN 
     1483         il_pivot=id_pivot 
     1484      ELSE 
     1485         il_pivot=grid_get_pivot(td_file) 
     1486      ENDIF 
     1487 
     1488      IF( il_pivot < 0 .OR. il_pivot > 1 )THEN 
     1489         CALL logger_error("GRID GET PERIO: invalid pivot point index. "//& 
     1490         &  "you should use grid_get_pivot to compute it") 
     1491      ENDIF 
    1231492 
    1241493      ! look for suitable variable 
     
    1341503      ENDDO 
    1351504 
    136       IF( il_varid/=0 )THEN 
    137          IF( ASSOCIATED(td_file%t_var(il_varid)%d_value) )THEN 
    138             CALL logger_debug("GRID GET PIVOT: ASSOCIATED") 
    139             tl_var=td_file%t_var(il_varid) 
    140          ELSE 
    141             ! read variable 
    142             il_dim(:)=td_file%t_var(il_varid)%t_dim(:)%i_len 
    143  
    144             CALL logger_debug("GRID GET PIVOT: read variable") 
    145             tl_var=iom_read_var(td_file, td_file%t_var(il_varid)%c_name,     & 
    146             &                   id_start=(/1,il_dim(2)-3,1,1/), & 
    147             &                   id_count=(/3,4,1,1/) ) 
    148          ENDIF 
    149  
    150          CALL logger_debug("GRID GET PIVOT: use variable "//TRIM(tl_var%c_name)) 
    151  
    152          IF( ASSOCIATED(tl_var%d_value) )THEN 
    153  
    154             CALL logger_debug("GRID GET PIVOT: point "//TRIM(tl_var%c_point)) 
    155             ! T-point pivot !case of ORCA2, ORCA025, ORCA12 grid 
    156             it1=1 ; jt1=4  
    157             it2=3 ; jt2=2  
    158  
    159             ! F-point pivot !case of ORCA05 grid 
    160             if1=1 ; jf1=4  
    161             if2=2 ; jf2=3  
    162  
    163             SELECT CASE(TRIM(tl_var%c_point)) 
    164             CASE('T') 
    165                IF( ABS(tl_var%d_value(it1,jt1,1,1)) == & 
    166                &   ABS(tl_var%d_value(it2,jt2,1,1)) )THEN 
    167                   CALL logger_info("GRID GET PIVOT: T-pivot") 
    168                   grid_get_pivot=1 
    169                ELSEIF( ABS(tl_var%d_value(if1,jf1,1,1)) == & 
    170                &       ABS(tl_var%d_value(if2,jf2,1,1)) )THEN 
    171                   CALL logger_info("GRID GET PIVOT: F-pivot") 
    172                   grid_get_pivot=0 
    173                ELSE 
    174                   CALL logger_error("GRID GET PIVOT: something wrong when "//& 
    175                   &  "computing pivot point") 
    176                ENDIF 
    177             CASE('U') 
    178                IF( ABS(tl_var%d_value(it1  ,jt1,1,1)) == & 
    179                &   ABS(tl_var%d_value(it2-1,jt2,1,1)) )THEN 
    180                   CALL logger_info("GRID GET PIVOT: T-pivot") 
    181                   grid_get_pivot=1 
    182                ELSEIF( ABS(tl_var%d_value(if1  ,jf1,1,1)) == & 
    183                &       ABS(tl_var%d_value(if2-1,jf2,1,1)) )THEN 
    184                   CALL logger_info("GRID GET PIVOT: F-pivot") 
    185                   grid_get_pivot=0 
    186                ELSE 
    187                   CALL logger_error("GRID GET PIVOT: something wrong when "//& 
    188                   &  "computing pivot point") 
    189                ENDIF 
    190             CASE('V') 
    191                IF( ABS(tl_var%d_value(it1,jt1  ,1,1)) == & 
    192                &   ABS(tl_var%d_value(it2,jt2-1,1,1)) )THEN 
    193                   CALL logger_info("GRID GET PIVOT: T-pivot") 
    194                   grid_get_pivot=1 
    195                ELSEIF( ABS(tl_var%d_value(if1,jf1  ,1,1)) == & 
    196                &       ABS(tl_var%d_value(if2,jf2-1,1,1)) )THEN 
    197                   CALL logger_info("GRID GET PIVOT: F-pivot") 
    198                   grid_get_pivot=0 
    199                ELSE 
    200                   CALL logger_error("GRID GET PIVOT: something wrong when "//& 
    201                   &  "computing pivot point") 
    202                ENDIF 
    203             CASE('F') 
    204                IF( ABS(tl_var%d_value(it1  ,jt1  ,1,1)) == & 
    205                &   ABS(tl_var%d_value(it2-1,jt2-1,1,1)) )THEN 
    206                   CALL logger_info("GRID GET PIVOT: T-pivot") 
    207                   grid_get_pivot=1 
    208                ELSEIF( ABS(tl_var%d_value(if1  ,jf1  ,1,1)) == & 
    209                &       ABS(tl_var%d_value(if2-1,jf2-1,1,1)) )THEN 
    210                   CALL logger_info("GRID GET PIVOT: F-pivot") 
    211                   grid_get_pivot=0 
    212                ELSE 
    213                   CALL logger_error("GRID GET PIVOT: something wrong when "//& 
    214                   &  "computing pivot point") 
    215                ENDIF 
    216             END SELECT 
    217          ELSE 
    218             CALL logger_error("GRID GET PIVOT: can't compute pivot point. "//& 
    219             &  "no value associated to variable "//TRIM(tl_var%c_name) ) 
    220          ENDIF 
     1505      IF( il_varid==0 )THEN 
     1506       
     1507         CALL logger_error("GRID GET PERIO: no suitable variable to compute "//& 
     1508         &              " periodicity in file "//TRIM(td_file%c_name)) 
    2211509 
    2221510      ELSE 
    223          CALL logger_error("GRID GET PIVOT: no suitable variable to compute "//& 
    224          &              "pivot point in file "//TRIM(td_file%c_name)) 
    225       ENDIF 
    226  
    227    END FUNCTION grid_get_pivot 
    228    !> @endcode 
     1511 
     1512         il_dim(:)= td_file%t_var(il_varid)%t_dim(:)%i_len 
     1513 
     1514         ! read variable 
     1515         tl_var=iom_read_var(td_file, & 
     1516         &                   td_file%t_var(il_varid)%c_name, & 
     1517         &                   id_start=(/1,1,1,1/), & 
     1518         &                   id_count=(/il_dim(1),il_dim(2),1,1/) ) 
     1519 
     1520 
     1521         grid__get_perio_file=grid_get_perio(tl_var,il_pivot) 
     1522  
     1523         ! clean  
     1524         CALL var_clean(tl_var) 
     1525 
     1526      ENDIF 
     1527 
     1528   END FUNCTION grid__get_perio_file 
    2291529   !------------------------------------------------------------------- 
    2301530   !> @brief  
    231    !> This funtion return NEMO periodicity index of the input file. 
     1531   !> This subroutine search NEMO periodicity given mpp structure and optionaly 
     1532   !> pivot point index. 
     1533   !> @details 
    2321534   !> The variable used must be on T point. 
    233    !> 
    234    !> @note the NEMO periodicity index can't be compute from coordinates file, 
    235    !> neither with mpp files. 
    2361535   !> 
    2371536   !> 0: closed boundaries 
     
    2431542   !> 6: North fold boundary (with a T-point pivot) and cyclic east-west boundary 
    2441543   !> 
     1544   !> @warning pivot point should have been computed before run this script. see grid_get_pivot. 
     1545   !> 
    2451546   !> @author J.Paul 
    246    !> - Nov, 2013- Subroutine written 
    247    ! 
    248    !> @todo  
    249    !> - improve check between T or F pivot. 
    250    !> - manage mpp case (read only border files) 
    251    ! 
    252    !> @param[in] td_file : file structure 
    253    !> @param[in] id_pivot : pivot point 
    254    !> @return NEMO periodicity index 
    255    !------------------------------------------------------------------- 
    256    !> @code 
    257    INTEGER(i4) FUNCTION grid_get_perio(td_file, id_pivot) 
     1547   !> - October, 2014 - Initial version 
     1548   ! 
     1549   !> @param[in] td_mpp   mpp file structure 
     1550   !> @param[in] id_pivot pivot point index 
     1551   !------------------------------------------------------------------- 
     1552   FUNCTION grid__get_perio_mpp(td_mpp, id_pivot) 
    2581553      IMPLICIT NONE 
    2591554 
    2601555      ! Argument       
    261       TYPE(TFILE), INTENT(IN) :: td_file 
    262       INTEGER(i4), INTENT(IN) :: id_pivot 
     1556      TYPE(TMPP) , INTENT(IN) :: td_mpp 
     1557      INTEGER(i4), INTENT(IN), OPTIONAL :: id_pivot 
     1558 
     1559      ! function 
     1560      INTEGER(i4) :: grid__get_perio_mpp 
    2631561 
    2641562      ! local variable 
     1563      INTEGER(i4)                       :: il_varid 
     1564      INTEGER(i4)                       :: il_pivot 
     1565      INTEGER(i4), DIMENSION(ip_maxdim) :: il_dim 
     1566 
    2651567      TYPE(TVAR)                        :: tl_var 
    266       INTEGER(i4)                       :: il_varid 
    267       INTEGER(i4), DIMENSION(ip_maxdim) :: il_dim 
    2681568 
    2691569      ! loop indices 
    2701570      INTEGER(i4) :: ji 
    2711571      !---------------------------------------------------------------- 
    272  
    2731572      ! initialise 
    274       grid_get_perio=-1 
    275  
    276       IF( id_pivot < 0 .OR. id_pivot > 1 )THEN 
     1573      grid__get_perio_mpp=-1 
     1574 
     1575      IF(PRESENT(id_pivot) )THEN 
     1576         il_pivot=id_pivot 
     1577      ELSE 
     1578         il_pivot=grid_get_pivot(td_mpp) 
     1579      ENDIF 
     1580 
     1581      IF( il_pivot < 0 .OR. il_pivot > 1 )THEN 
    2771582         CALL logger_error("GRID GET PERIO: invalid pivot point index. "//& 
    2781583         &  "you should use grid_get_pivot to compute it") 
     
    2811586      ! look for suitable variable 
    2821587      il_varid=0 
    283       DO ji=1,td_file%i_nvar 
    284          IF( .NOT. ALL(td_file%t_var(ji)%t_dim(1:2)%l_use) ) CYCLE 
    285          SELECT CASE(TRIM(fct_lower(td_file%t_var(ji)%c_stdname)) ) 
     1588      DO ji=1,td_mpp%t_proc(1)%i_nvar 
     1589         IF( .NOT. ALL(td_mpp%t_proc(1)%t_var(ji)%t_dim(1:2)%l_use) ) CYCLE 
     1590         SELECT CASE(TRIM(fct_lower(td_mpp%t_proc(1)%t_var(ji)%c_stdname)) ) 
    2861591            CASE('longitude','latitude') 
    2871592            CASE DEFAULT 
     
    2921597 
    2931598      IF( il_varid==0 )THEN 
    294  
     1599       
    2951600         CALL logger_error("GRID GET PERIO: no suitable variable to compute "//& 
    296          &              " periodicity in file "//TRIM(td_file%c_name)) 
     1601         &              " periodicity in file "//TRIM(td_mpp%c_name)) 
    2971602      ELSE 
    298          il_dim(:)=td_file%t_var(il_varid)%t_dim(:)%i_len 
    299  
    300          IF( ASSOCIATED(td_file%t_var(il_varid)%d_value) )THEN 
    301             tl_var=td_file%t_var(il_varid) 
    302          ELSE 
    303             ! read variable 
    304             tl_var=iom_read_var(td_file, td_file%t_var(il_varid)%c_name, & 
    305             &                   id_start=(/1,1,1,1/), & 
    306             &                   id_count=(/il_dim(1),il_dim(2),1,1/) ) 
     1603  
     1604         DO ji=1,ip_maxdim 
     1605            IF( td_mpp%t_proc(1)%t_var(il_varid)%t_dim(ji)%l_use )THEN 
     1606               il_dim(ji)=td_mpp%t_dim(ji)%i_len 
     1607            ELSE 
     1608               il_dim(ji)=1 
     1609            ENDIF 
     1610         ENDDO 
     1611 
     1612         ! read variable 
     1613         tl_var=iom_mpp_read_var(td_mpp, & 
     1614         &                       td_mpp%t_proc(1)%t_var(il_varid)%c_name, & 
     1615         &                       id_start=(/1,1,1,1/), & 
     1616         &                       id_count=(/il_dim(1),il_dim(2),1,1/) ) 
     1617 
     1618         grid__get_perio_mpp=grid_get_perio(tl_var, il_pivot) 
     1619 
     1620         ! clean  
     1621         CALL var_clean(tl_var) 
     1622      ENDIF 
     1623 
     1624   END FUNCTION grid__get_perio_mpp 
     1625   !------------------------------------------------------------------- 
     1626   !> @brief This function get East-West overlap. 
     1627   ! 
     1628   !> @details 
     1629   !> If no East-West wrap return -1,  
     1630   !> else return the size of the ovarlap band. 
     1631   !> East-West overlap is computed comparing longitude value of the   
     1632   !> South" part of the domain, to avoid  north fold boundary. 
     1633   !> 
     1634   ! 
     1635   !> @author J.Paul 
     1636   !> - November, 2013- Initial Version 
     1637   !> @date October, 2014 
     1638   !> - work on mpp file structure instead of file structure 
     1639   !> 
     1640   !> @param[in] td_lon longitude variable structure  
     1641   !> @return East West overlap 
     1642   !------------------------------------------------------------------- 
     1643   FUNCTION grid__get_ew_overlap_var(td_var) 
     1644      IMPLICIT NONE 
     1645      ! Argument       
     1646      TYPE(TVAR), INTENT(INOUT) :: td_var 
     1647      ! function 
     1648      INTEGER(i4) :: grid__get_ew_overlap_var 
     1649 
     1650      ! local variable 
     1651      REAL(dp), DIMENSION(:,:), ALLOCATABLE :: dl_value 
     1652      REAL(dp), DIMENSION(:)  , ALLOCATABLE :: dl_vare 
     1653      REAL(dp), DIMENSION(:)  , ALLOCATABLE :: dl_varw 
     1654 
     1655      REAL(dp)    :: dl_delta 
     1656      REAL(dp)    :: dl_varmax 
     1657      REAL(dp)    :: dl_varmin 
     1658 
     1659      INTEGER(i4) :: il_east 
     1660      INTEGER(i4) :: il_west 
     1661      INTEGER(i4) :: il_jmin 
     1662      INTEGER(i4) :: il_jmax 
     1663 
     1664      INTEGER(i4), PARAMETER :: il_max_overlap = 5 
     1665 
     1666      ! loop indices 
     1667      INTEGER(i4) :: ji 
     1668      !---------------------------------------------------------------- 
     1669      ! initialise 
     1670      grid__get_ew_overlap_var=-1 
     1671 
     1672      IF( ASSOCIATED(td_var%d_value) )THEN 
     1673         IF( td_var%t_dim(1)%i_len > 1 )THEN 
     1674            il_west=1 
     1675            il_east=td_var%t_dim(1)%i_len 
     1676 
     1677            ALLOCATE( dl_value(td_var%t_dim(1)%i_len, & 
     1678            &                  td_var%t_dim(2)%i_len) ) 
     1679 
     1680            dl_value(:,:)=td_var%d_value(:,:,1,1) 
     1681 
     1682            ! we do not use jmax as dimension length due to north fold boundary 
     1683            il_jmin=1+ip_ghost 
     1684            il_jmax=(td_var%t_dim(2)%i_len-ip_ghost)/2 
     1685 
     1686            ALLOCATE( dl_vare(il_jmax-il_jmin+1) ) 
     1687            ALLOCATE( dl_varw(il_jmax-il_jmin+1) ) 
     1688             
     1689            dl_vare(:)=dl_value(il_east,il_jmin:il_jmax) 
     1690            dl_varw(:)=dl_value(il_west,il_jmin:il_jmax) 
     1691             
     1692            IF( .NOT.(  ALL(dl_vare(:)==td_var%d_fill) .AND. & 
     1693            &           ALL(dl_varw(:)==td_var%d_fill) ) )THEN 
     1694          
     1695               IF( TRIM(td_var%c_stdname) == 'longitude' )THEN 
     1696                  WHERE( dl_value(:,:) > 180._dp .AND. & 
     1697                  &      dl_value(:,:) /= td_var%d_fill )  
     1698                     dl_value(:,:)=360.-dl_value(:,:) 
     1699                  END WHERE 
     1700 
     1701                  dl_varmax=MAXVAL(dl_value(:,il_jmin:il_jmax)) 
     1702                  dl_varmin=MINVAL(dl_value(:,il_jmin:il_jmax)) 
     1703 
     1704                  dl_delta=(dl_varmax-dl_varmin)/td_var%t_dim(1)%i_len 
     1705 
     1706                  IF( ALL(ABS(dl_vare(:)) - ABS(dl_varw(:)) == dl_delta) )THEN 
     1707                     grid__get_ew_overlap_var=0 
     1708                  ENDIF 
     1709               ENDIF 
     1710 
     1711               IF( grid__get_ew_overlap_var == -1 )THEN 
     1712                  DO ji=0,il_max_overlap 
     1713 
     1714                     IF( il_east-ji == il_west )THEN 
     1715                        ! case of small domain 
     1716                        EXIT 
     1717                     ELSE 
     1718                        dl_vare(:)=dl_value(il_east-ji,il_jmin:il_jmax) 
     1719                         
     1720                        IF( ALL( dl_varw(:) == dl_vare(:) ) )THEN 
     1721                           grid__get_ew_overlap_var=ji+1 
     1722                           EXIT 
     1723                        ENDIF 
     1724                     ENDIF 
     1725 
     1726                  ENDDO 
     1727               ENDIF 
     1728            ENDIF 
     1729 
    3071730         ENDIF 
    308  
    309          IF(ALL(tl_var%d_value(    1    ,    :    ,1,1)/=tl_var%d_fill).AND.& 
    310          &  ALL(tl_var%d_value(il_dim(1),    :    ,1,1)/=tl_var%d_fill).AND.& 
    311          &  ALL(tl_var%d_value(    :    ,    1    ,1,1)/=tl_var%d_fill).AND.& 
    312          &  ALL(tl_var%d_value(    :    ,il_dim(2),1,1)/=tl_var%d_fill))THEN 
    313          ! no boundary closed 
    314             CALL logger_warn("GRID GET PERIO: can't determined periodicity. "//& 
    315             &             "there is no boundary closed for variable "//& 
    316             &              TRIM(tl_var%c_name)//" in file "//& 
    317             &              TRIM(td_file%c_name) ) 
    318          ELSE 
    319             ! check periodicity 
    320             IF(ANY(tl_var%d_value(   1     ,:,1,1)/=tl_var%d_fill).OR.& 
    321             &  ANY(tl_var%d_value(il_dim(1),:,1,1)/=tl_var%d_fill))THEN 
    322             ! East-West cyclic (1,4,6) 
    323  
    324                IF( ANY(tl_var%d_value(:, 1, 1, 1) /= tl_var%d_fill) )THEN 
    325                ! South boundary not closed  
    326  
    327                   CALL logger_error("GRID GET PERIO: should have been an "//& 
    328                   &              "impossible case") 
    329                   CALL logger_debug("GRID GET PERIO: East_West cyclic") 
    330                   CALL logger_debug("GRID GET PERIO: South boundary not closed") 
    331  
    332                ELSE 
    333                ! South boundary closed (1,4,6) 
    334                   CALL logger_info("GRID GET PERIO: South boundary closed") 
    335  
    336                   IF(ANY(tl_var%d_value(:,il_dim(2),1,1)/=tl_var%d_fill) )THEN 
    337                   ! North boundary not closed (4,6) 
    338                      CALL logger_info("GRID GET PERIO: North boundary not closed") 
    339                      ! check pivot 
    340                      SELECT CASE(id_pivot) 
    341                         CASE(0) 
    342                            ! F pivot 
    343                            grid_get_perio=4 
    344                         CASE(1) 
    345                            ! T pivot 
    346                            grid_get_perio=6 
    347                         CASE DEFAULT 
    348                            CALL logger_error("GRID GET PERIO: invalid pivot ") 
    349                      END SELECT 
    350                   ELSE 
    351                   ! North boundary closed 
    352                      CALL logger_info("GRID GET PERIO: North boundary closed") 
    353                      grid_get_perio=1 ! North and South boundaries closed 
    354                   ENDIF 
    355  
    356                ENDIF 
    357  
    358             ELSE 
    359             ! East-West boundaries closed (0,2,3,5) 
    360                CALL logger_info("GRID GET PERIO: East West boundaries closed") 
    361  
    362                IF( ANY(tl_var%d_value(:, 1, 1, 1) /= tl_var%d_fill) )THEN 
    363                ! South boundary not closed (2) 
    364                   CALL logger_info("GRID GET PERIO: South boundary not closed") 
    365  
    366                   IF(ANY(tl_var%d_value(:,il_dim(2),1,1)/=tl_var%d_fill))THEN 
    367                   ! North boundary not closed 
    368                      CALL logger_error("GRID GET PERIO: should have been "//& 
    369                      &              "an impossible case") 
    370                      CALL logger_debug("GRID GET PERIO: East West boundaries "//& 
    371                      &              "closed") 
    372                      CALL logger_debug("GRID GET PERIO: South boundary not closed") 
    373                      CALL logger_debug("GRID GET PERIO: North boundary not closed") 
    374                   ELSE 
    375                   ! North boundary closed 
    376                      grid_get_perio=2   ! East-West and North boundaries closed  
    377                   ENDIF 
    378  
    379                ELSE 
    380                ! South boundary closed (0,3,5) 
    381                   CALL logger_info("GRID GET PERIO: South boundary closed") 
    382  
    383                   IF(ANY(tl_var%d_value(:,il_dim(2),1,1)/=tl_var%d_fill))THEN 
    384                   ! North boundary not closed (3,5) 
    385                      CALL logger_info("GRID GET PERIO: North boundary not closed") 
    386                      ! check pivot 
    387                      SELECT CASE(id_pivot) 
    388                         CASE(0) 
    389                            ! F pivot 
    390                            grid_get_perio=3 
    391                         CASE(1) 
    392                            ! T pivot 
    393                            grid_get_perio=5 
    394                         CASE DEFAULT 
    395                            CALL logger_error("GRID GET PERIO: invalid pivot") 
    396                      END SELECT 
    397                   ELSE 
    398                   ! North boundary closed    
    399                      CALL logger_info("GRID GET PERIO: North boundary closed") 
    400                      grid_get_perio=0   ! all boundary closed 
    401                   ENDIF 
    402  
    403                ENDIF 
    404  
    405             ENDIF 
    406  
     1731      ELSE 
     1732         CALL logger_error("GRID GET EW OVERLAP: input variable standard name"//& 
     1733         &  TRIM(td_var%c_stdname)//" can not be used to compute East West "//& 
     1734         &  "overalp. no value associated. ") 
     1735      ENDIF 
     1736 
     1737   END FUNCTION grid__get_ew_overlap_var 
     1738   !------------------------------------------------------------------- 
     1739   !> @brief This function get East-West overlap. 
     1740   ! 
     1741   !> @details 
     1742   !> If no East-West wrap return -1,  
     1743   !> else return the size of the ovarlap band. 
     1744   !> East-West overlap is computed comparing longitude value of the   
     1745   !> South" part of the domain, to avoid  north fold boundary. 
     1746   !> 
     1747   !> @author J.Paul 
     1748   !> - October, 2014- Initial Version 
     1749   !> 
     1750   !> @param[in] td_file file structure  
     1751   !> @return East West overlap 
     1752   !------------------------------------------------------------------- 
     1753   FUNCTION grid__get_ew_overlap_file(td_file) 
     1754      IMPLICIT NONE 
     1755      ! Argument       
     1756      TYPE(TFILE), INTENT(INOUT) :: td_file 
     1757      ! function 
     1758      INTEGER(i4) :: grid__get_ew_overlap_file 
     1759 
     1760      ! local variable 
     1761      INTEGER(i4) :: il_varid 
     1762 
     1763      TYPE(TVAR)  :: tl_var 
     1764 
     1765      ! loop indices 
     1766      INTEGER(i4) :: ji 
     1767      !---------------------------------------------------------------- 
     1768 
     1769      il_varid=var_get_index(td_file%t_var(:), 'longitude') 
     1770      IF( il_varid /= 0 )THEN 
     1771         ! read longitude on boundary 
     1772         tl_var=iom_read_var(td_file, 'longitude') 
     1773      ELSE 
     1774         DO ji=1,td_file%i_nvar 
     1775            IF( .NOT. ALL(td_file%t_var(ji)%t_dim(1:2)%l_use) ) CYCLE 
     1776 
     1777            tl_var=iom_read_var(td_file, td_file%t_var(ji)%c_name) 
     1778            EXIT 
     1779         ENDDO 
     1780      ENDIF 
     1781 
     1782      grid__get_ew_overlap_file=grid_get_ew_overlap(tl_var) 
     1783 
     1784      ! clean 
     1785      CALL var_clean(tl_var) 
     1786 
     1787   END FUNCTION grid__get_ew_overlap_file 
     1788   !------------------------------------------------------------------- 
     1789   !> @brief This function get East-West overlap. 
     1790   ! 
     1791   !> @details 
     1792   !> If no East-West wrap return -1,  
     1793   !> else return the size of the ovarlap band. 
     1794   !> East-West overlap is computed comparing longitude value of the   
     1795   !> South" part of the domain, to avoid  north fold boundary. 
     1796   !> 
     1797   ! 
     1798   !> @author J.Paul 
     1799   !> - November, 2013- Initial Version 
     1800   !> @date October, 2014 
     1801   !> - work on mpp file structure instead of file structure 
     1802   !> 
     1803   !> @param[in] td_mpp mpp structure  
     1804   !> @return East West overlap 
     1805   !------------------------------------------------------------------- 
     1806   FUNCTION grid__get_ew_overlap_mpp(td_mpp) 
     1807      IMPLICIT NONE 
     1808      ! Argument       
     1809      TYPE(TMPP), INTENT(INOUT) :: td_mpp 
     1810      ! function 
     1811      INTEGER(i4) :: grid__get_ew_overlap_mpp 
     1812 
     1813      ! local variable 
     1814      INTEGER(i4) :: il_ew 
     1815      INTEGER(i4) :: il_varid 
     1816 
     1817      TYPE(TVAR)  :: tl_var 
     1818      ! loop indices 
     1819      INTEGER(i4) :: ji 
     1820      !---------------------------------------------------------------- 
     1821 
     1822      ! initialise 
     1823      grid__get_ew_overlap_mpp=td_mpp%i_ew 
     1824 
     1825      ! read longitude on boundary 
     1826      il_varid=var_get_index(td_mpp%t_proc(1)%t_var(:),'longitude') 
     1827      IF( il_varid /= 0 )THEN 
     1828         tl_var=iom_mpp_read_var(td_mpp, 'longitude') 
     1829      ELSE 
     1830         DO ji=1,td_mpp%t_proc(1)%i_nvar 
     1831            IF( .NOT. ALL(td_mpp%t_proc(1)%t_var(ji)%t_dim(1:2)%l_use) ) CYCLE 
     1832 
     1833            tl_var=iom_mpp_read_var(td_mpp, td_mpp%t_proc(1)%t_var(ji)%c_name) 
     1834            EXIT 
     1835         ENDDO          
     1836      ENDIF 
     1837 
     1838      il_ew=grid_get_ew_overlap(tl_var) 
     1839      IF( il_ew >= 0 )THEN 
     1840         grid__get_ew_overlap_mpp=il_ew 
     1841      ENDIF 
     1842 
     1843 
     1844      ! clean 
     1845      CALL var_clean(tl_var) 
     1846 
     1847   END FUNCTION grid__get_ew_overlap_mpp 
     1848   !------------------------------------------------------------------- 
     1849   !> @brief This subroutine check if there is north fold. 
     1850   !> 
     1851   !> @details 
     1852   !> check if maximum latitude greater than 88°N  
     1853   !> 
     1854   !> @author J.Paul 
     1855   !> - November, 2013- Initial Version 
     1856   !> 
     1857   !> @param[in] td_lat latitude variable structure  
     1858   !------------------------------------------------------------------- 
     1859   LOGICAL FUNCTION grid_is_north_fold(td_lat) 
     1860      IMPLICIT NONE 
     1861      ! Argument       
     1862      TYPE(TVAR), INTENT(IN) :: td_lat 
     1863 
     1864      ! local variable 
     1865      ! loop indices 
     1866      !---------------------------------------------------------------- 
     1867    
     1868      ! init 
     1869      grid_is_north_fold=.FALSE. 
     1870 
     1871      IF( .NOT. ASSOCIATED(td_lat%d_value) )THEN 
     1872         CALL logger_error("GRID IS NORTH FOLD: "//& 
     1873         &                 " no value associated to latitude") 
     1874      ELSE       
     1875         IF( MAXVAL(td_lat%d_value(:,:,:,:), & 
     1876         &          td_lat%d_value(:,:,:,:)/= td_lat%d_fill) >= 88.0 )THEN 
     1877 
     1878            grid_is_north_fold=.TRUE. 
     1879             
    4071880         ENDIF 
    4081881      ENDIF 
    4091882 
    410    END FUNCTION grid_get_perio 
    411    !> @endcode 
     1883   END FUNCTION grid_is_north_fold 
    4121884   !------------------------------------------------------------------- 
    4131885   !> @brief This subroutine check domain validity. 
     
    4151887   !> @details 
    4161888   !> If maximum latitude greater than 88°N, program will stop.  
    417    !> It is not able to manage north fold boundary for now. 
     1889   !> @note Not able to manage north fold for now. 
    4181890   ! 
    4191891   !> @author J.Paul 
    420    !> - Nov, 2013- Initial Version 
    421    ! 
    422    !> @param[in] cd_coord : coordinate file  
    423    !> @param[in] id_imin : i-direction lower left  point indice   
    424    !> @param[in] id_imax : i-direction upper right point indice  
    425    !> @param[in] id_jmin : j-direction lower left  point indice  
    426    !> @param[in] id_jmax : j-direction upper right point indice  
    427    !> 
    428    !> @todo 
    429    !> - use domain instead of start count 
    430    !------------------------------------------------------------------- 
    431    !> @code 
     1892   !> - November, 2013- Initial Version 
     1893   !> @date October, 2014 
     1894   !> - work on mpp file structure instead of file structure 
     1895   ! 
     1896   !> @param[in] cd_coord  coordinate file  
     1897   !> @param[in] id_imin   i-direction lower left  point indice   
     1898   !> @param[in] id_imax   i-direction upper right point indice  
     1899   !> @param[in] id_jmin   j-direction lower left  point indice  
     1900   !> @param[in] id_jmax   j-direction upper right point indice  
     1901   !------------------------------------------------------------------- 
    4321902   SUBROUTINE grid_check_dom(td_coord, id_imin, id_imax, id_jmin, id_jmax) 
    4331903      IMPLICIT NONE 
    4341904      ! Argument       
    435       TYPE(TFILE), INTENT(IN) :: td_coord 
     1905      TYPE(TMPP) , INTENT(IN) :: td_coord 
    4361906      INTEGER(i4), INTENT(IN) :: id_imin 
    4371907      INTEGER(i4), INTENT(IN) :: id_imax 
     
    4401910 
    4411911      ! local variable 
    442       TYPE(TVAR)                        :: tl_var 
    443  
    444       TYPE(TFILE)                       :: tl_coord 
    445  
    446       TYPE(TMPP)                        :: tl_mppcoord 
    447  
    448       TYPE(TDOM)                        :: tl_dom 
    449  
     1912      TYPE(TVAR) :: tl_var 
     1913 
     1914      TYPE(TMPP) :: tl_coord 
     1915 
     1916      TYPE(TDOM) :: tl_dom 
    4501917      ! loop indices 
    4511918      !---------------------------------------------------------------- 
    4521919 
    453       IF( id_jmin >= id_jmax )THEN 
     1920      IF( id_jmin > id_jmax .OR. id_jmax == 0 )THEN 
    4541921 
    4551922         CALL logger_fatal("GRID CHECK DOM: invalid domain. "//& 
     
    4571924 
    4581925      ELSE 
    459  
    460          IF( td_coord%i_id == 0 )THEN 
    461             CALL logger_error("GRID CHECK DOM: can not check domain. "//& 
    462             &  " file "//TRIM(td_coord%c_name)//" not opened." ) 
    463          ELSE 
    4641926 
    4651927            IF( id_imin == id_imax .AND. td_coord%i_ew < 0 )THEN 
     
    4691931            ENDIF 
    4701932 
    471             !1- read domain 
    472             tl_coord=td_coord 
    473             CALL iom_open(tl_coord) 
    474  
    475             !1-1 compute domain 
     1933            ! copy structure 
     1934            tl_coord=mpp_copy(td_coord) 
     1935 
     1936            ! compute domain 
    4761937            tl_dom=dom_init( tl_coord,        & 
    477             &                 id_imin, id_imax,& 
    478             &                 id_jmin, id_jmax ) 
     1938            &                id_imin, id_imax,& 
     1939            &                id_jmin, id_jmax ) 
    4791940             
    480             !1-2 close file 
    481             CALL iom_close(tl_coord) 
    482  
    483             !1-3 read variables on domain (ugly way to do it, have to work on it) 
    484             !1-3-1 init mpp structure 
    485             tl_mppcoord=mpp_init(tl_coord)    
    486  
    487             CALL file_clean(tl_coord) 
    488  
    489             !1-3-2 get processor to be used 
    490             CALL mpp_get_use( tl_mppcoord, tl_dom ) 
    491  
    492             !1-3-3 open mpp files 
    493             CALL iom_mpp_open(tl_mppcoord) 
    494  
    495             !1-3-4 read variable value on domain 
    496             tl_var=iom_mpp_read_var(tl_mppcoord,'latitude',td_dom=tl_dom) 
    497  
    498             !1-3-5 close mpp files 
    499             CALL iom_mpp_close(tl_mppcoord) 
    500  
    501             !1-3-6 clean structure 
    502             CALL mpp_clean(tl_mppcoord) 
     1941            ! open mpp files to be used 
     1942            CALL iom_dom_open(tl_coord, tl_dom) 
     1943 
     1944            ! read variable value on domain 
     1945            tl_var=iom_dom_read_var(tl_coord,'latitude',tl_dom) 
     1946 
     1947            ! close mpp files 
     1948            CALL iom_dom_close(tl_coord) 
     1949 
     1950            ! clean structure 
     1951            CALL mpp_clean(tl_coord) 
    5031952 
    5041953            IF( MAXVAL(tl_var%d_value(:,:,:,:), & 
     
    5131962 
    5141963            ! clean 
     1964            CALL dom_clean(tl_dom) 
    5151965            CALL var_clean(tl_var) 
    5161966 
    517          ENDIF 
    518  
    519  
    5201967      ENDIF 
    5211968 
    5221969   END SUBROUTINE grid_check_dom 
    523    !> @endcode 
    5241970   !------------------------------------------------------------------- 
    5251971   !> @brief This function get closest coarse grid indices of fine grid domain. 
    5261972   ! 
    5271973   !> @details 
    528    !> 
    529    ! 
     1974   !> it use coarse and fine grid coordinates files. 
     1975   !> optionally, you could specify the array of refinment factor (default 1.) 
     1976   !> optionally, you could specify on which Arakawa grid point you want to 
     1977   !> work (default 'T') 
     1978   !> 
    5301979   !> @author J.Paul 
    531    !> - Nov, 2013- Initial Version 
    532    ! 
    533    !> @param[in] td_coord0 : coarse grid coordinate structure 
    534    !> @param[in] td_coord1 : fine grid coordinate structure 
    535    !> @return coarse grid indices (/ (/imin0, imax0/), (/jmin0, jmax0/) /) 
    536    !> @todo 
    537    !> - use domain instead of start count 
    538    !------------------------------------------------------------------- 
    539    !> @code 
    540    FUNCTION grid_get_coarse_index_ff( td_coord0, td_coord1, & 
    541    &                                  id_rho ) 
     1980   !> - November, 2013- Initial Version 
     1981   !> @date September, 2014 
     1982   !> - use grid point to read coordinates variable.  
     1983   !> @date October, 2014 
     1984   !> - work on mpp file structure instead of file structure 
     1985   !> 
     1986   !> @param[in] td_coord0 coarse grid coordinate mpp structure 
     1987   !> @param[in] td_coord1 fine grid coordinate mpp structure 
     1988   !> @param[in] id_rho    array of refinment factor (default 1.) 
     1989   !> @param[in] cd_point  Arakawa grid point (default 'T'). 
     1990   !> @return coarse grid indices(/(/imin0, imax0/), (/jmin0, jmax0/)/) 
     1991   !>                                      
     1992   !------------------------------------------------------------------- 
     1993   FUNCTION grid__get_coarse_index_ff( td_coord0, td_coord1, & 
     1994   &                                   id_rho, cd_point ) 
    5421995      IMPLICIT NONE 
    5431996      ! Argument 
    544       TYPE(TFILE), INTENT(IN) :: td_coord0 
    545       TYPE(TFILE), INTENT(IN) :: td_coord1 
    546       INTEGER(i4), DIMENSION(:), INTENT(IN), OPTIONAL :: id_rho 
     1997      TYPE(TMPP)                    , INTENT(IN) :: td_coord0 
     1998      TYPE(TMPP)                    , INTENT(IN) :: td_coord1 
     1999      INTEGER(i4)     , DIMENSION(:), INTENT(IN), OPTIONAL :: id_rho 
     2000      CHARACTER(LEN=*)              , INTENT(IN), OPTIONAL :: cd_point 
    5472001 
    5482002      ! function 
    549       INTEGER(i4), DIMENSION(2,2,2) :: grid_get_coarse_index_ff 
     2003      INTEGER(i4), DIMENSION(2,2) :: grid__get_coarse_index_ff 
    5502004 
    5512005      ! local variable 
     2006      TYPE(TMPP) :: tl_coord0 
     2007      TYPE(TMPP) :: tl_coord1 
     2008 
    5522009      TYPE(TVAR)  :: tl_lon0 
    5532010      TYPE(TVAR)  :: tl_lat0 
     
    5552012      TYPE(TVAR)  :: tl_lat1 
    5562013 
    557       INTEGER(i4) , DIMENSION(:), ALLOCATABLE :: il_rho 
    558  
    559       INTEGER(i4), DIMENSION(ip_maxdim) :: il_start 
    560       INTEGER(i4), DIMENSION(ip_maxdim) :: il_count 
    561       INTEGER(i4), DIMENSION(2)         :: il_xghost0 
    562       INTEGER(i4), DIMENSION(2)         :: il_xghost1 
     2014      INTEGER(i4), DIMENSION(:), ALLOCATABLE :: il_rho 
     2015 
     2016      INTEGER(i4), DIMENSION(2,2)         :: il_xghost0 
     2017      INTEGER(i4), DIMENSION(2,2)         :: il_xghost1 
    5632018 
    5642019      INTEGER(i4) :: il_imin0 
     
    5672022      INTEGER(i4) :: il_jmax0 
    5682023 
    569       INTEGER(i4) :: il_imin1 
    570       INTEGER(i4) :: il_imax1 
    571       INTEGER(i4) :: il_jmin1 
    572       INTEGER(i4) :: il_jmax1 
     2024      CHARACTER(LEN= 1) :: cl_point 
     2025      CHARACTER(LEN=lc) :: cl_name 
    5732026 
    5742027      ! loop indices 
     
    5762029 
    5772030      ! init 
    578       grid_get_coarse_index_ff(:,:,:)=0 
    579  
    580       ALLOCATE(il_rho(ig_ndim)) 
     2031      grid__get_coarse_index_ff(:,:)=0 
     2032 
     2033      ALLOCATE(il_rho(ip_maxdim)) 
    5812034      il_rho(:)=1 
    5822035      IF( PRESENT(id_rho) ) il_rho(:)=id_rho(:) 
    5832036 
    584       IF( td_coord0%i_id == 0 .OR. td_coord1%i_id == 0 )THEN 
    585          CALL logger_error("GRID GET COARSE INDEX: can not get corase "//& 
    586          &  "grid indices. file "//TRIM(td_coord0%c_name)//" and/or "//& 
    587          &   TRIM(td_coord1%c_name)//" not opened." ) 
     2037      cl_point='T' 
     2038      IF( PRESENT(cd_point) ) cl_point=TRIM(fct_upper(cd_point)) 
     2039 
     2040      ! copy structure 
     2041      tl_coord0=mpp_copy(td_coord0) 
     2042      tl_coord1=mpp_copy(td_coord1) 
     2043 
     2044      IF( .NOT. ASSOCIATED(tl_coord0%t_proc) .OR. & 
     2045      &   .NOT. ASSOCIATED(tl_coord1%t_proc) )THEN 
     2046         CALL logger_error("GRID GET COARSE INDEX: can not get coarse "//& 
     2047         &  "grid indices. decompsition of mpp file "//TRIM(tl_coord0%c_name)//& 
     2048         &  " and/or "//TRIM(tl_coord1%c_name)//" not defined." ) 
    5882049      ELSE 
    589          !1- Coarse grid 
     2050         ! Coarse grid 
     2051         ! get ghost cell factor on coarse grid 
     2052         il_xghost0(:,:)=grid_get_ghost( tl_coord0 ) 
     2053 
     2054         ! open mpp files 
     2055         CALL iom_mpp_open(tl_coord0) 
     2056 
    5902057         ! read coarse longitue and latitude 
    591          tl_lon0=iom_read_var(td_coord0,'longitude') 
    592          tl_lat0=iom_read_var(td_coord0,'latitude') 
    593  
    594          ! get ghost cell factor on coarse grid 
    595          il_xghost0(:)=grid_get_ghost( tl_lon0, tl_lat0 ) 
    596  
    597          il_imin0=1+il_xghost0(1)*ig_ghost 
    598          il_jmin0=1+il_xghost0(2)*ig_ghost 
    599  
    600          il_imax0=tl_lon0%t_dim(1)%i_len-il_xghost0(1)*ig_ghost 
    601          il_jmax0=tl_lon0%t_dim(2)%i_len-il_xghost0(2)*ig_ghost 
    602  
    603          CALL var_clean(tl_lon0) 
    604          CALL var_clean(tl_lat0) 
    605  
    606          ! read coarse longitue and latitude without ghost cell 
    607          il_start(:)=(/il_imin0,il_jmin0,1,1/) 
    608          il_count(:)=(/il_imax0-il_imin0+1, & 
    609          &             il_jmax0-il_jmin0+1, & 
    610          &             tl_lon0%t_dim(3)%i_len, & 
    611          &             tl_lon0%t_dim(4)%i_len /) 
    612  
    613          tl_lon0=iom_read_var(td_coord0,'longitude',il_start(:), il_count(:)) 
    614          tl_lat0=iom_read_var(td_coord0,'latitude' ,il_start(:), il_count(:)) 
     2058         WRITE(cl_name,*) 'longitude_'//TRIM(cl_point) 
     2059         tl_lon0=iom_mpp_read_var(tl_coord0, TRIM(cl_name)) 
     2060         WRITE(cl_name,*) 'latitude_'//TRIM(cl_point) 
     2061         tl_lat0=iom_mpp_read_var(tl_coord0, TRIM(cl_name)) 
    6152062          
    616          !2- Fine grid 
     2063         CALL grid_del_ghost(tl_lon0, il_xghost0(:,:)) 
     2064         CALL grid_del_ghost(tl_lat0, il_xghost0(:,:)) 
     2065 
     2066         ! close mpp files 
     2067         CALL iom_mpp_close(tl_coord0) 
     2068 
     2069         ! Fine grid 
     2070 
     2071         ! get ghost cell factor on fine grid 
     2072         il_xghost1(:,:)=grid_get_ghost( tl_coord1 ) 
     2073 
     2074         ! open mpp files 
     2075         CALL iom_mpp_open(tl_coord1) 
     2076 
    6172077         ! read fine longitue and latitude 
    618          tl_lon1=iom_read_var(td_coord1,'longitude') 
    619          tl_lat1=iom_read_var(td_coord1,'latitude') 
    620  
    621          ! get ghost cell factor on fine grid 
    622          il_xghost1(:)=grid_get_ghost( tl_lon1, tl_lat1 ) 
    623  
    624          il_imin1=1+il_xghost1(1)*ig_ghost 
    625          il_jmin1=1+il_xghost1(2)*ig_ghost 
    626  
    627          il_imax1=tl_lon1%t_dim(1)%i_len-il_xghost1(1)*ig_ghost 
    628          il_jmax1=tl_lon1%t_dim(2)%i_len-il_xghost1(2)*ig_ghost 
    629  
    630          CALL var_clean(tl_lon1) 
    631          CALL var_clean(tl_lat1) 
    632  
    633          ! read fine longitue and latitude without ghost cell 
    634          il_start(:)=(/il_imin1,il_jmin1,1,1/) 
    635          il_count(:)=(/il_imax1-il_imin1+1, & 
    636          &             il_jmax1-il_jmin1+1, & 
    637          &             tl_lon1%t_dim(3)%i_len, & 
    638          &             tl_lon1%t_dim(4)%i_len /) 
    639  
    640          tl_lon1=iom_read_var(td_coord1,'longitude',il_start(:), il_count(:)) 
    641  
    642          tl_lat1=iom_read_var(td_coord1,'latitude' ,il_start(:), il_count(:)) 
     2078         WRITE(cl_name,*) 'longitude_'//TRIM(cl_point) 
     2079         tl_lon1=iom_mpp_read_var(tl_coord1, TRIM(cl_name))  
     2080         WRITE(cl_name,*) 'latitude_'//TRIM(cl_point) 
     2081         tl_lat1=iom_mpp_read_var(tl_coord1, TRIM(cl_name)) 
    6432082  
    644          !3- compute 
    645           
    646          grid_get_coarse_index_ff(:,:,:)=grid_get_coarse_index(tl_lon0,tl_lat0,& 
    647          &                                                     tl_lon1,tl_lat1,& 
    648          &                                                     il_rho(:) ) 
    649  
    650          il_imin0=grid_get_coarse_index_ff(1,1,1)-il_xghost0(1)*ig_ghost 
    651          il_imax0=grid_get_coarse_index_ff(1,2,1)+il_xghost0(1)*ig_ghost 
    652          il_jmin0=grid_get_coarse_index_ff(2,1,1)-il_xghost0(2)*ig_ghost 
    653          il_jmax0=grid_get_coarse_index_ff(2,2,1)+il_xghost0(2)*ig_ghost 
    654  
    655          grid_get_coarse_index_ff(1,1,1)=il_imin0 
    656          grid_get_coarse_index_ff(1,2,1)=il_imax0 
    657          grid_get_coarse_index_ff(2,1,1)=il_jmin0 
    658          grid_get_coarse_index_ff(2,2,1)=il_jmax0 
     2083         CALL grid_del_ghost(tl_lon1, il_xghost1(:,:)) 
     2084         CALL grid_del_ghost(tl_lat1, il_xghost1(:,:)) 
     2085 
     2086         ! close mpp files 
     2087         CALL iom_mpp_close(tl_coord1) 
     2088 
     2089         ! compute 
     2090         grid__get_coarse_index_ff(:,:)=grid_get_coarse_index(tl_lon0,tl_lat0,& 
     2091         &                                                    tl_lon1,tl_lat1,& 
     2092         &                                                    il_rho(:) ) 
     2093 
     2094         ! add ghost cell to indices 
     2095         il_imin0=grid__get_coarse_index_ff(1,1)+il_xghost0(jp_I,1)*ip_ghost 
     2096         il_imax0=grid__get_coarse_index_ff(1,2)+il_xghost0(jp_I,1)*ip_ghost 
     2097 
     2098         il_jmin0=grid__get_coarse_index_ff(2,1)+il_xghost0(jp_J,1)*ip_ghost 
     2099         il_jmax0=grid__get_coarse_index_ff(2,2)+il_xghost0(jp_J,1)*ip_ghost 
     2100 
     2101         grid__get_coarse_index_ff(jp_I,1)=il_imin0 
     2102         grid__get_coarse_index_ff(jp_I,2)=il_imax0 
     2103         grid__get_coarse_index_ff(jp_J,1)=il_jmin0 
     2104         grid__get_coarse_index_ff(jp_J,2)=il_jmax0 
    6592105 
    6602106         CALL var_clean(tl_lon0) 
     
    6652111      ENDIF 
    6662112 
    667    END FUNCTION grid_get_coarse_index_ff 
    668    !> @endcode 
     2113      ! clean 
     2114      CALL mpp_clean(tl_coord0) 
     2115      CALL mpp_clean(tl_coord1) 
     2116      DEALLOCATE(il_rho) 
     2117 
     2118   END FUNCTION grid__get_coarse_index_ff 
    6692119   !------------------------------------------------------------------- 
    6702120   !> @brief This function get closest coarse grid indices of fine grid domain. 
    6712121   ! 
    6722122   !> @details 
    673    !> 
    674    ! 
     2123   !> it use coarse array of longitude and latitude and fine grid coordinates file. 
     2124   !> optionaly, you could specify the array of refinment factor (default 1.) 
     2125   !> optionally, you could specify on which Arakawa grid point you want to 
     2126   !> work (default 'T') 
     2127   !> 
    6752128   !> @author J.Paul 
    676    !> - Nov, 2013- Initial Version 
    677    ! 
    678    !> @param[in] td_longitude0 : coarse grid longitude 
    679    !> @param[in] td_latitude0  : coarse grid latitude 
    680    !> @param[in] td_coord1 : fine grid coordinate structure 
    681    !> @return coarse grid indices (/ (/imin0, imax0/), (/jmin0, jmax0/) /) 
    682    !------------------------------------------------------------------- 
    683    !> @code 
    684    FUNCTION grid_get_coarse_index_cf( td_lon0, td_lat0, td_coord1, & 
    685    &                                  id_rho ) 
     2129   !> - November, 2013- Initial Version 
     2130   !> @date September, 2014 
     2131   !> - use grid point to read coordinates variable. 
     2132   !> @date October, 2014 
     2133   !> - work on mpp file structure instead of file structure 
     2134   !> 
     2135   !> @param[in] td_longitude0   coarse grid longitude 
     2136   !> @param[in] td_latitude0    coarse grid latitude 
     2137   !> @param[in] td_coord1       fine grid coordinate mpp structure 
     2138   !> @param[in] id_rho          array of refinment factor 
     2139   !> @param[in] cd_point        Arakawa grid point (default 'T') 
     2140   !> @return coarse grid indices (/(/imin0, imax0/), (/jmin0, jmax0/)/) 
     2141   !------------------------------------------------------------------- 
     2142   FUNCTION grid__get_coarse_index_cf( td_lon0, td_lat0, td_coord1, & 
     2143   &                                   id_rho, cd_point ) 
    6862144      IMPLICIT NONE 
    6872145      ! Argument 
    688       TYPE(TVAR ), INTENT(IN) :: td_lon0 
    689       TYPE(TVAR ), INTENT(IN) :: td_lat0 
    690       TYPE(TFILE), INTENT(IN) :: td_coord1 
    691       INTEGER(i4), DIMENSION(:), INTENT(IN), OPTIONAL :: id_rho 
     2146      TYPE(TVAR )                   , INTENT(IN) :: td_lon0 
     2147      TYPE(TVAR )                   , INTENT(IN) :: td_lat0 
     2148      TYPE(TMPP )                   , INTENT(IN) :: td_coord1 
     2149      INTEGER(i4)     , DIMENSION(:), INTENT(IN), OPTIONAL :: id_rho 
     2150      CHARACTER(LEN=*)              , INTENT(IN), OPTIONAL :: cd_point 
    6922151 
    6932152      ! function 
    694       INTEGER(i4), DIMENSION(2,2,2) :: grid_get_coarse_index_cf 
     2153      INTEGER(i4), DIMENSION(2,2) :: grid__get_coarse_index_cf 
    6952154 
    6962155      ! local variable 
     2156      TYPE(TMPP)  :: tl_coord1 
     2157 
    6972158      TYPE(TVAR)  :: tl_lon1 
    6982159      TYPE(TVAR)  :: tl_lat1 
     
    7002161      INTEGER(i4), DIMENSION(:), ALLOCATABLE :: il_rho 
    7012162 
    702       INTEGER(i4), DIMENSION(ip_maxdim) :: il_start 
    703       INTEGER(i4), DIMENSION(ip_maxdim) :: il_count 
    704       INTEGER(i4), DIMENSION(2)         :: il_xghost 
    705  
    706       INTEGER(i4) :: il_imin1 
    707       INTEGER(i4) :: il_imax1 
    708       INTEGER(i4) :: il_jmin1 
    709       INTEGER(i4) :: il_jmax1 
     2163      INTEGER(i4), DIMENSION(2,2)       :: il_xghost 
     2164 
     2165      CHARACTER(LEN= 1) :: cl_point 
     2166      CHARACTER(LEN=lc) :: cl_name 
    7102167 
    7112168      ! loop indices 
     
    7132170 
    7142171      ! init 
    715       grid_get_coarse_index_cf(:,:,:)=0 
    716  
    717       ALLOCATE(il_rho(ig_ndim) ) 
     2172      grid__get_coarse_index_cf(:,:)=0 
     2173 
     2174      ALLOCATE(il_rho(ip_maxdim) ) 
    7182175      il_rho(:)=1 
    7192176      IF( PRESENT(id_rho) ) il_rho(:)=id_rho(:) 
    7202177 
    721       IF( td_coord1%i_id == 0 )THEN 
    722          CALL logger_error("GRID GET COARSE INDEX: file "//& 
    723          &   TRIM(td_coord1%c_name)//" not opened." ) 
     2178      ! copy structure 
     2179      tl_coord1=mpp_copy(td_coord1) 
     2180       
     2181      cl_point='T' 
     2182      IF( PRESENT(cd_point) ) cl_point=TRIM(fct_upper(cd_point)) 
     2183 
     2184      IF( .NOT. ASSOCIATED(tl_coord1%t_proc) )THEN 
     2185         CALL logger_error("GRID GET COARSE INDEX: decompsition of mpp "//& 
     2186         &  "file "//TRIM(tl_coord1%c_name)//" not defined." ) 
    7242187 
    7252188      ELSE IF( .NOT. ASSOCIATED(td_lon0%d_value) .OR. & 
     
    7312194      ELSE 
    7322195          
    733          !1- Fine grid 
     2196         IF( TRIM(td_lon0%c_point)/='' )THEN 
     2197            cl_point=TRIM(td_lon0%c_point) 
     2198         ELSEIF( TRIM(td_lat0%c_point)/='' )THEN 
     2199            cl_point=TRIM(td_lat0%c_point) 
     2200         ENDIF 
     2201 
     2202         ! Fine grid 
     2203         ! get ghost cell factor on fine grid 
     2204         il_xghost(:,:)=grid_get_ghost( tl_coord1 ) 
     2205 
     2206         ! open mpp files 
     2207         CALL iom_mpp_open(tl_coord1) 
     2208 
    7342209         ! read fine longitue and latitude 
    735          tl_lon1=iom_read_var(td_coord1,'longitude') 
    736          tl_lat1=iom_read_var(td_coord1,'latitude') 
    737  
    738          ! get ghost cell factor on fine grid 
    739          il_xghost(:)=grid_get_ghost( tl_lon1, tl_lat1 ) 
    740  
    741          il_imin1=1+il_xghost(1)*ig_ghost 
    742          il_jmin1=1+il_xghost(2)*ig_ghost 
    743  
    744          il_imax1=tl_lon1%t_dim(1)%i_len-il_xghost(1)*ig_ghost 
    745          il_jmax1=tl_lon1%t_dim(2)%i_len-il_xghost(2)*ig_ghost 
    746  
    747          CALL var_clean(tl_lon1) 
    748          CALL var_clean(tl_lat1) 
    749  
    750          ! read fine longitue and latitude without ghost cell 
    751          il_start(:)=(/il_imin1,il_jmin1,1,1/) 
    752          il_count(:)=(/il_imax1-il_imin1+1, & 
    753          &             il_jmax1-il_jmin1+1, & 
    754          &             tl_lon1%t_dim(3)%i_len, & 
    755          &             tl_lon1%t_dim(4)%i_len /) 
    756  
    757          tl_lon1=iom_read_var(td_coord1,'longitude',il_start(:), il_count(:)) 
    758          tl_lat1=iom_read_var(td_coord1,'latitude' ,il_start(:), il_count(:)) 
     2210         WRITE(cl_name,*) 'longitude_'//TRIM(cl_point) 
     2211         tl_lon1=iom_mpp_read_var(tl_coord1, TRIM(cl_name)) 
     2212         WRITE(cl_name,*) 'latitude_'//TRIM(cl_point) 
     2213         tl_lat1=iom_mpp_read_var(tl_coord1, TRIM(cl_name)) 
    7592214          
    760          !3- compute 
    761          grid_get_coarse_index_cf(:,:,:)=grid_get_coarse_index(td_lon0,td_lat0,& 
    762          &                                                     tl_lon1,tl_lat1,& 
    763          &                                                     il_rho(:) ) 
    764  
     2215         CALL grid_del_ghost(tl_lon1, il_xghost(:,:)) 
     2216         CALL grid_del_ghost(tl_lat1, il_xghost(:,:)) 
     2217 
     2218         ! close mpp files 
     2219         CALL iom_mpp_close(tl_coord1) 
     2220 
     2221         ! compute 
     2222         grid__get_coarse_index_cf(:,:)=grid_get_coarse_index(td_lon0,td_lat0,& 
     2223         &                                                    tl_lon1,tl_lat1,& 
     2224         &                                                    il_rho(:), cl_point ) 
     2225 
     2226          
    7652227         CALL var_clean(tl_lon1) 
    7662228         CALL var_clean(tl_lat1)          
     
    7682230      ENDIF 
    7692231 
    770    END FUNCTION grid_get_coarse_index_cf 
    771    !> @endcode 
     2232      DEALLOCATE(il_rho) 
     2233      CALL mpp_clean(tl_coord1) 
     2234 
     2235   END FUNCTION grid__get_coarse_index_cf 
    7722236   !------------------------------------------------------------------- 
    7732237   !> @brief This function get closest coarse grid indices of fine grid domain. 
    7742238   ! 
    7752239   !> @details 
    776    !> 
    777    !> @warning use ghost cell so can not be used on extracted domain without 
    778    !> ghost cell 
    779    ! 
     2240   !> it use coarse grid coordinates file and fine grid array of longitude and latitude. 
     2241   !> optionaly, you could specify the array of refinment factor (default 1.) 
     2242   !> optionally, you could specify on which Arakawa grid point you want to 
     2243   !> work (default 'T') 
     2244   !> 
    7802245   !> @author J.Paul 
    781    !> - Nov, 2013- Initial Version 
    782    ! 
    783    !> @param[in] td_coord0 : coarse grid coordinate structure 
    784    !> @param[in] td_lon1 : fine grid longitude 
    785    !> @param[in] td_lat1 : fine grid latitude 
    786    !> @return coarse grid indices (/ (/imin0, imax0/), (/jmin0, jmax0/) /) 
    787    !------------------------------------------------------------------- 
    788    !> @code 
    789    FUNCTION grid_get_coarse_index_fc( td_coord0, td_lon1, td_lat1, & 
    790    &                                  id_rho ) 
     2246   !> - November, 2013- Initial Version 
     2247   !> @date September, 2014 
     2248   !> - use grid point to read coordinates variable. 
     2249   !> @date October, 2014 
     2250   !> - work on mpp file structure instead of file structure 
     2251   !>  
     2252   !> @param[in] td_coord0 coarse grid coordinate mpp structure 
     2253   !> @param[in] td_lon1   fine grid longitude 
     2254   !> @param[in] td_lat1   fine grid latitude 
     2255   !> @param[in] id_rho    array of refinment factor (default 1.) 
     2256   !> @param[in] cd_point  Arakawa grid point (default 'T') 
     2257   !> @return coarse grid indices (/(/imin0, imax0/), (/jmin0, jmax0/)/) 
     2258   !------------------------------------------------------------------- 
     2259   FUNCTION grid__get_coarse_index_fc( td_coord0, td_lon1, td_lat1, & 
     2260   &                                  id_rho, cd_point ) 
    7912261      IMPLICIT NONE 
    7922262      ! Argument 
    793       TYPE(TFILE), INTENT(IN) :: td_coord0 
    794       TYPE(TVAR ), INTENT(IN) :: td_lon1 
    795       TYPE(TVAR ), INTENT(IN) :: td_lat1 
    796       INTEGER(i4), DIMENSION(:), INTENT(IN), OPTIONAL :: id_rho 
     2263      TYPE(TMPP )                   , INTENT(IN) :: td_coord0 
     2264      TYPE(TVAR )                   , INTENT(IN) :: td_lon1 
     2265      TYPE(TVAR )                   , INTENT(IN) :: td_lat1 
     2266      INTEGER(i4)     , DIMENSION(:), INTENT(IN), OPTIONAL :: id_rho 
     2267      CHARACTER(LEN=*)              , INTENT(IN), OPTIONAL :: cd_point 
    7972268 
    7982269      ! function 
    799       INTEGER(i4), DIMENSION(2,2,2) :: grid_get_coarse_index_fc 
     2270      INTEGER(i4), DIMENSION(2,2) :: grid__get_coarse_index_fc 
    8002271 
    8012272      ! local variable 
     2273      TYPE(TMPP)  :: tl_coord0 
     2274 
    8022275      TYPE(TVAR)  :: tl_lon0 
    8032276      TYPE(TVAR)  :: tl_lat0 
     
    8052278      INTEGER(i4), DIMENSION(:), ALLOCATABLE :: il_rho 
    8062279 
    807       INTEGER(i4), DIMENSION(ip_maxdim) :: il_start 
    808       INTEGER(i4), DIMENSION(ip_maxdim) :: il_count 
    809       INTEGER(i4), DIMENSION(2)         :: il_xghost 
     2280      INTEGER(i4), DIMENSION(2,2)       :: il_xghost 
    8102281 
    8112282      INTEGER(i4) :: il_imin0 
     
    8142285      INTEGER(i4) :: il_jmax0 
    8152286 
     2287      CHARACTER(LEN= 1) :: cl_point 
     2288      CHARACTER(LEN=lc) :: cl_name       
    8162289 
    8172290      ! loop indices 
     
    8192292 
    8202293      ! init 
    821       grid_get_coarse_index_fc(:,:,:)=0 
    822  
    823       ALLOCATE(il_rho(ig_ndim)) 
     2294      grid__get_coarse_index_fc(:,:)=0 
     2295 
     2296      ALLOCATE(il_rho(ip_maxdim)) 
    8242297      il_rho(:)=1 
    8252298      IF( PRESENT(id_rho) ) il_rho(:)=id_rho(:) 
    8262299 
    827       IF( td_coord0%i_id == 0 )THEN 
    828          CALL logger_error("GRID GET COARSE INDEX: file "//& 
    829          &                 TRIM(td_coord0%c_name)//" not opened." ) 
     2300      cl_point='T' 
     2301      IF( PRESENT(cd_point) ) cl_point=TRIM(fct_upper(cd_point)) 
     2302 
     2303      ! copy structure 
     2304      tl_coord0=mpp_copy(td_coord0) 
     2305 
     2306      IF( .NOT. ASSOCIATED(tl_coord0%t_proc) )THEN 
     2307         CALL logger_error("GRID GET COARSE INDEX: decompsition of mpp "//& 
     2308         &  "file "//TRIM(tl_coord0%c_name)//" not defined." ) 
    8302309 
    8312310      ELSE IF( .NOT. ASSOCIATED(td_lon1%d_value) .OR. & 
     
    8362315 
    8372316      ELSE 
     2317 
     2318         IF( TRIM(td_lon1%c_point)/='' )THEN 
     2319            cl_point=TRIM(td_lon1%c_point) 
     2320         ELSEIF( TRIM(td_lat1%c_point)/='' )THEN 
     2321            cl_point=TRIM(td_lat1%c_point) 
     2322         ENDIF 
     2323 
     2324         ! get ghost cell factor on coarse grid 
     2325         il_xghost(:,:)=grid_get_ghost( tl_coord0 ) 
     2326 
     2327         ! open mpp files 
     2328         CALL iom_mpp_open(tl_coord0) 
     2329 
    8382330         ! read coarse longitue and latitude 
    839          tl_lon0=iom_read_var(td_coord0,'longitude') 
    840          tl_lat0=iom_read_var(td_coord0,'latitude') 
    841  
    842          ! get ghost cell factor on coarse grid 
    843          il_xghost(:)=grid_get_ghost( tl_lon0, tl_lat0 ) 
    844  
    845          il_imin0=1+il_xghost(1)*ig_ghost 
    846          il_jmin0=1+il_xghost(2)*ig_ghost 
    847  
    848          il_imax0=tl_lon0%t_dim(1)%i_len-il_xghost(1)*ig_ghost 
    849          il_jmax0=tl_lon0%t_dim(2)%i_len-il_xghost(2)*ig_ghost 
     2331         WRITE(cl_name,*) 'longitude_'//TRIM(cl_point) 
     2332         tl_lon0=iom_mpp_read_var(tl_coord0, TRIM(cl_name)) 
     2333         WRITE(cl_name,*) 'latitude_'//TRIM(cl_point) 
     2334         tl_lat0=iom_mpp_read_var(tl_coord0, TRIM(cl_name)) 
     2335 
     2336         CALL grid_del_ghost(tl_lon0, il_xghost(:,:)) 
     2337         CALL grid_del_ghost(tl_lat0, il_xghost(:,:)) 
     2338 
     2339         ! close mpp files 
     2340         CALL iom_mpp_close(tl_coord0) 
     2341 
     2342         grid__get_coarse_index_fc(:,:)=grid_get_coarse_index(tl_lon0,tl_lat0,& 
     2343         &                                                    td_lon1,td_lat1,& 
     2344         &                                                    il_rho(:), cl_point ) 
     2345 
     2346         ! remove ghost cell 
     2347         il_imin0=grid__get_coarse_index_fc(1,1)+il_xghost(jp_I,1)*ip_ghost 
     2348         il_imax0=grid__get_coarse_index_fc(1,2)+il_xghost(jp_I,1)*ip_ghost 
     2349 
     2350         il_jmin0=grid__get_coarse_index_fc(2,1)+il_xghost(jp_J,1)*ip_ghost 
     2351         il_jmax0=grid__get_coarse_index_fc(2,2)+il_xghost(jp_J,1)*ip_ghost 
     2352 
     2353         grid__get_coarse_index_fc(1,1)=il_imin0 
     2354         grid__get_coarse_index_fc(1,2)=il_imax0 
     2355         grid__get_coarse_index_fc(2,1)=il_jmin0 
     2356         grid__get_coarse_index_fc(2,2)=il_jmax0 
    8502357 
    8512358         CALL var_clean(tl_lon0) 
    8522359         CALL var_clean(tl_lat0) 
    8532360 
    854          ! read coarse longitue and latitude without ghost cell 
    855          il_start(:)=(/il_imin0,il_jmin0,1,1/) 
    856          il_count(:)=(/il_imax0-il_imin0+1, & 
    857          &             il_jmax0-il_jmin0+1, & 
    858          &             tl_lon0%t_dim(3)%i_len, & 
    859          &             tl_lon0%t_dim(4)%i_len /) 
    860  
    861          tl_lon0=iom_read_var(td_coord0,'longitude',il_start(:), il_count(:)) 
    862          tl_lat0=iom_read_var(td_coord0,'latitude' ,il_start(:), il_count(:)) 
    863  
    864          grid_get_coarse_index_fc(:,:,:)=grid_get_coarse_index(tl_lon0,tl_lat0,& 
    865          &                                                     td_lon1,td_lat1,& 
    866          &                                                     il_rho(:) ) 
    867  
    868          ! remove ghost cell 
    869          il_imin0=grid_get_coarse_index_fc(1,1,1)+il_xghost(1)*ig_ghost 
    870          il_imax0=grid_get_coarse_index_fc(1,2,1)+il_xghost(1)*ig_ghost 
    871          il_jmin0=grid_get_coarse_index_fc(2,1,1)+il_xghost(2)*ig_ghost 
    872          il_jmax0=grid_get_coarse_index_fc(2,2,1)+il_xghost(2)*ig_ghost 
    873  
    874          grid_get_coarse_index_fc(1,1,1)=il_imin0 
    875          grid_get_coarse_index_fc(1,2,1)=il_imax0 
    876          grid_get_coarse_index_fc(2,1,1)=il_jmin0 
    877          grid_get_coarse_index_fc(2,2,1)=il_jmax0 
    878  
    879          CALL var_clean(tl_lon0) 
    880          CALL var_clean(tl_lat0) 
    881  
    882       ENDIF 
    883  
    884    END FUNCTION grid_get_coarse_index_fc 
    885    !> @endcode 
     2361      ENDIF 
     2362 
     2363      CALL mpp_clean(tl_coord0) 
     2364      DEALLOCATE(il_rho) 
     2365 
     2366   END FUNCTION grid__get_coarse_index_fc 
    8862367   !------------------------------------------------------------------- 
    8872368   !> @brief This function get closest coarse grid indices of fine grid domain. 
    8882369   ! 
    8892370   !> @details 
    890    !> 
    891    !> @warning use ghost cell so can not be used on extracted domain without 
    892    !> ghost cell 
    893    ! 
     2371   !> it use coarse and fine grid array of longitude and latitude. 
     2372   !> optionaly, you could specify the array of refinment factor (default 1.) 
     2373   !> optionally, you could specify on which Arakawa grid point you want to 
     2374   !> work (default 'T') 
     2375   !> 
     2376   !> @note do not use ghost cell 
     2377   !> 
    8942378   !> @author J.Paul 
    895    !> - Nov, 2013- Initial Version 
    896    ! 
    897    !> @param[in] td_lon0 : coarse grid longitude 
    898    !> @param[in] td_lat0 : coarse grid latitude 
    899    !> @param[in] td_lon1 : fine grid longitude 
    900    !> @param[in] td_lat1 : fine grid latitude 
    901    !> @return coarse grid indices (/ (/imin0, imax0/), (/jmin0, jmax0/) /) 
    902    !> 
    903    !------------------------------------------------------------------- 
    904    !> @code 
    905    FUNCTION grid_get_coarse_index_cc( td_lon0, td_lat0, td_lon1, td_lat1, & 
    906    &                                  id_rho ) 
     2379   !> - November, 2013- Initial Version 
     2380   !> @date September, 2014 
     2381   !> - check grid point 
     2382   !> - take into account EW overlap 
     2383   !> 
     2384   !> @param[in] td_lon0   coarse grid longitude 
     2385   !> @param[in] td_lat0   coarse grid latitude 
     2386   !> @param[in] td_lon1   fine grid longitude 
     2387   !> @param[in] td_lat1   fine grid latitude 
     2388   !> @param[in] id_rho    array of refinment factor 
     2389   !> @param[in] cd_point  Arakawa grid point ('T','U','V','F') 
     2390   !> @return coarse grid indices (/(/imin0, imax0/), (/jmin0, jmax0/)/) 
     2391   !> 
     2392   !> @todo 
     2393   !> -check case boundary domain on overlap band 
     2394   !------------------------------------------------------------------- 
     2395   FUNCTION grid__get_coarse_index_cc( td_lon0, td_lat0, td_lon1, td_lat1, & 
     2396   &                                   id_rho, cd_point ) 
    9072397      IMPLICIT NONE 
    9082398      ! Argument 
    909       TYPE(TVAR) , INTENT(IN) :: td_lon0 
    910       TYPE(TVAR) , INTENT(IN) :: td_lat0 
    911       TYPE(TVAR) , INTENT(IN) :: td_lon1 
    912       TYPE(TVAR) , INTENT(IN) :: td_lat1 
    913       INTEGER(i4), DIMENSION(:), INTENT(IN), OPTIONAL :: id_rho 
     2399      TYPE(TVAR)                    , INTENT(IN) :: td_lon0 
     2400      TYPE(TVAR)                    , INTENT(IN) :: td_lat0 
     2401      TYPE(TVAR)                    , INTENT(IN) :: td_lon1 
     2402      TYPE(TVAR)                    , INTENT(IN) :: td_lat1 
     2403      INTEGER(i4)     , DIMENSION(:), INTENT(IN), OPTIONAL :: id_rho 
     2404      CHARACTER(LEN=*)              , INTENT(IN), OPTIONAL :: cd_point 
    9142405 
    9152406      ! function 
    916       INTEGER(i4), DIMENSION(2,2,2) :: grid_get_coarse_index_cc 
     2407      INTEGER(i4), DIMENSION(2,2) :: grid__get_coarse_index_cc 
    9172408 
    9182409      ! local variable 
     
    9272418      REAL(dp)    :: dl_lat1_ur 
    9282419 
    929       REAL(dp)    :: dl_dlon 
    930       REAL(dp)    :: dl_dlat 
    931  
    9322420      INTEGER(i4), DIMENSION(:), ALLOCATABLE :: il_rho 
    9332421 
     
    9542442      INTEGER(i4) :: il_jmax       
    9552443 
    956       INTEGER(i4), DIMENSION(2,2) :: il_offset 
    957  
     2444      INTEGER(i4), DIMENSION(2,2) :: il_xghost0 
     2445      INTEGER(i4), DIMENSION(2,2) :: il_yghost0 
     2446      INTEGER(i4), DIMENSION(2,2) :: il_xghost1 
     2447      INTEGER(i4), DIMENSION(2,2) :: il_yghost1 
     2448 
     2449      TYPE(TVAR) :: tl_lon0 
     2450      TYPE(TVAR) :: tl_lat0 
     2451      TYPE(TVAR) :: tl_lon1 
     2452      TYPE(TVAR) :: tl_lat1 
     2453 
     2454      CHARACTER(LEN= 1) :: cl_point0 
     2455      CHARACTER(LEN= 1) :: cl_point1 
     2456       
    9582457      ! loop indices 
    9592458      INTEGER(i4) :: ji 
    9602459      INTEGER(i4) :: jj 
    9612460      !---------------------------------------------------------------- 
    962  
    9632461      ! init 
    964       grid_get_coarse_index_cc(:,:,:)=0 
    965  
    966       ALLOCATE( il_rho(ig_ndim) ) 
     2462      grid__get_coarse_index_cc(:,:)=0 
     2463 
     2464      ALLOCATE( il_rho(ip_maxdim) ) 
    9672465      il_rho(:)=1 
    9682466      IF( PRESENT(id_rho) ) il_rho(:)=id_rho(:) 
    9692467 
     2468      cl_point0='T' 
     2469      cl_point1='T' 
     2470      IF( PRESENT(cd_point) )THEN 
     2471         cl_point0=TRIM(fct_upper(cd_point)) 
     2472         cl_point1=TRIM(fct_upper(cd_point)) 
     2473      ENDIF 
     2474       
    9702475      IF( .NOT. ASSOCIATED(td_lon0%d_value) .OR. & 
    9712476      &   .NOT. ASSOCIATED(td_lat0%d_value) .OR. & 
     
    9762481      ELSE 
    9772482 
     2483         IF( TRIM(td_lon0%c_point)/='' )THEN 
     2484            cl_point0=TRIM(td_lon0%c_point) 
     2485         ELSEIF( TRIM(td_lat0%c_point)/='' )THEN 
     2486            cl_point0=TRIM(td_lat0%c_point) 
     2487         ENDIF 
     2488         IF( TRIM(td_lon1%c_point)/='' )THEN 
     2489            cl_point1=TRIM(td_lon1%c_point) 
     2490         ELSEIF( TRIM(td_lat1%c_point)/='' )THEN 
     2491            cl_point1=TRIM(td_lat1%c_point) 
     2492         ENDIF 
     2493         IF( cl_point0 /= cl_point1 )THEN 
     2494            CALL logger_error("GRID GET COARSE INDEX: fine and coarse grid"//& 
     2495         &                 " coordinate not on same grid point.") 
     2496         ENDIF 
     2497 
    9782498         IF( grid_is_global(td_lon1, td_lat1) )THEN 
    9792499 
    9802500            IF( grid_is_global(td_lon0, td_lat0) )THEN 
    9812501               CALL logger_trace("GRID GET COARSE INDEX: fine grid is global ") 
    982                grid_get_coarse_index_cc(:,:,1) = 1 
    983                grid_get_coarse_index_cc(:,:,2) = 0 
     2502               grid__get_coarse_index_cc(:,:) = 1 
     2503               grid__get_coarse_index_cc(:,:) = 0 
    9842504            ELSE 
    9852505               CALL logger_error("GRID GET COARSE INDEX: fine grid is "//& 
     
    9892509         ELSE 
    9902510 
     2511            il_xghost0(:,:)=grid_get_ghost( td_lon0 ) 
     2512            il_yghost0(:,:)=grid_get_ghost( td_lat0 ) 
     2513            IF( ANY(il_xghost0(:,:) /= il_yghost0(:,:)) )THEN 
     2514               CALL logger_error("GRID GET COARSE INDEX: coarse grid "//& 
     2515               &        "coordinate do not share same ghost cell") 
     2516            ENDIF 
     2517 
     2518            tl_lon0=var_copy(td_lon0) 
     2519            tl_lat0=var_copy(td_lat0) 
     2520            CALL grid_del_ghost(tl_lon0, il_xghost0(:,:)) 
     2521            CALL grid_del_ghost(tl_lat0, il_xghost0(:,:)) 
     2522             
    9912523            ! "global" coarse grid indice 
    9922524            il_imin0=1 
    9932525            il_jmin0=1 
    9942526 
    995             il_imax0=td_lon0%t_dim(1)%i_len 
    996             il_jmax0=td_lon0%t_dim(2)%i_len 
     2527            il_imax0=tl_lon0%t_dim(1)%i_len 
     2528            il_jmax0=tl_lon0%t_dim(2)%i_len 
    9972529 
    9982530            ! get east west overlap for coarse grid 
    999             il_ew0=dom_get_ew_overlap(td_lon0) 
     2531            il_ew0=tl_lon0%i_ew 
    10002532            IF( il_ew0 >= 0 )THEN 
    10012533               ! last point before overlap 
     
    10032535            ENDIF 
    10042536 
     2537            il_xghost1(:,:)=grid_get_ghost( td_lon1 ) 
     2538            il_yghost1(:,:)=grid_get_ghost( td_lat1 ) 
     2539            IF( ANY(il_xghost1(:,:) /= il_yghost1(:,:)) )THEN 
     2540               CALL logger_error("GRID GET COARSE INDEX: fine grid "//& 
     2541               &        "coordinate do not share same ghost cell") 
     2542            ENDIF 
     2543 
     2544            tl_lon1=var_copy(td_lon1) 
     2545            tl_lat1=var_copy(td_lat1) 
     2546            CALL grid_del_ghost(tl_lon1, il_xghost1(:,:)) 
     2547            CALL grid_del_ghost(tl_lat1, il_xghost1(:,:)) 
     2548             
    10052549            ! "global" fine grid indice 
    10062550            il_imin1=1 
    10072551            il_jmin1=1 
    10082552 
    1009             il_imax1=td_lon1%t_dim(1)%i_len 
    1010             il_jmax1=td_lon1%t_dim(2)%i_len 
    1011  
    1012             ! get east west overlap for coarse grid 
    1013             il_ew1=dom_get_ew_overlap(td_lon1) 
     2553            il_imax1=tl_lon1%t_dim(1)%i_len 
     2554            il_jmax1=tl_lon1%t_dim(2)%i_len 
     2555 
     2556            ! get east west overlap for fine grid 
     2557            il_ew1=tl_lon1%i_ew 
    10142558            IF( il_ew1 >= 0 )THEN 
    10152559               ! last point before overlap 
     
    10192563            ! get indices for each corner 
    10202564            !1- search lower left corner indices 
    1021             dl_lon1_ll=td_lon1%d_value( il_imin1, il_jmin1, 1, 1 ) 
    1022             dl_lat1_ll=td_lat1%d_value( il_imin1, il_jmin1, 1, 1 ) 
    1023  
    1024             dl_dlon=ABS(td_lon1%d_value(il_imin1+1,il_jmin1  ,1,1)-dl_lon1_ll) 
    1025             dl_dlat=ABS(td_lat1%d_value(il_imin1  ,il_jmin1+1,1,1)-dl_lat1_ll) 
    1026  
    1027 !            CALL logger_debug("GRID GET COARSE INDEX: lon1 ll "//& 
    1028 !            &  TRIM(fct_str(dl_lon1_ll)) ) 
    1029 !            CALL logger_debug("GRID GET COARSE INDEX: lat1 ll "//& 
    1030 !            &  TRIM(fct_str(dl_lat1_ll)) ) 
    1031 ! 
    1032 !            CALL logger_debug("GRID GET COARSE INDEX: lon0 min "//& 
    1033 !            &  TRIM(fct_str(minval(td_lon0%d_value(2:,2:,:,:)))) ) 
    1034 !            CALL logger_debug("GRID GET COARSE INDEX: lon0 max "//& 
    1035 !            &  TRIM(fct_str(maxval(td_lon0%d_value(2:,2:,:,:)))) ) 
    1036 ! 
    1037 !            CALL logger_debug("GRID GET COARSE INDEX: lat0 min "//& 
    1038 !            &  TRIM(fct_str(minval(td_lat0%d_value(2:,2:,:,:)))) ) 
    1039 !            CALL logger_debug("GRID GET COARSE INDEX: lat0 max "//& 
    1040 !            &  TRIM(fct_str(maxval(td_lat0%d_value(2:,2:,:,:)))) ) 
    1041  
     2565            dl_lon1_ll=tl_lon1%d_value( il_imin1, il_jmin1, 1, 1 ) 
     2566            dl_lat1_ll=tl_lat1%d_value( il_imin1, il_jmin1, 1, 1 ) 
     2567 
     2568            IF( dl_lon1_ll == tl_lon1%d_fill .OR. & 
     2569            &   dl_lat1_ll == tl_lat1%d_fill )THEN 
     2570               CALL logger_error("GRID GET COARSE INDEX: lower left corner "//& 
     2571               &                 "point is FillValue. remove ghost cell "//& 
     2572               &                 "before running grid_get_coarse_index.") 
     2573            ENDIF 
    10422574            ! look for closest point on coarse grid 
    1043             il_ill(:)= grid_get_closest(td_lon0%d_value(il_imin0:il_imax0, & 
     2575            il_ill(:)= grid_get_closest(tl_lon0%d_value(il_imin0:il_imax0, & 
    10442576            &                                           il_jmin0:il_jmax0, & 
    10452577            &                                           1,1), & 
    1046             &                           td_lat0%d_value(il_imin0:il_imax0, & 
     2578            &                           tl_lat0%d_value(il_imin0:il_imax0, & 
    10472579            &                                           il_jmin0:il_jmax0, & 
    10482580            &                                           1,1), & 
     
    10532585            jj = il_ill(2) 
    10542586 
    1055             IF( ABS(td_lon0%d_value(ji,jj,1,1)-dl_lon1_ll) > dl_dlon*1.e-3 )THEN 
    1056                IF(td_lon0%d_value(ji,jj,1,1) > dl_lon1_ll ) il_ill(1)=il_ill(1)-1 
     2587            IF( ABS(tl_lon0%d_value(ji,jj,1,1)-dl_lon1_ll) > dp_delta )THEN 
     2588               IF(tl_lon0%d_value(ji,jj,1,1) > dl_lon1_ll )THEN 
     2589                  il_ill(1)=il_ill(1)-1 
     2590                  IF( il_ill(1) <= 0 )THEN 
     2591                     IF( tl_lon0%i_ew >= 0 )THEN 
     2592                        il_ill(1)=tl_lon0%t_dim(jp_I)%i_len-tl_lon0%i_ew 
     2593                     ELSE 
     2594                        CALL logger_error("GRID GET COARSE INDEX: error "//& 
     2595                        &                 "computing lower left corner "//& 
     2596                        &                 "index for longitude") 
     2597                     ENDIF 
     2598                  ENDIF 
     2599               ENDIF 
    10572600            ENDIF 
    1058             IF( ABS(td_lat0%d_value(ji,jj,1,1)-dl_lat1_ll) > dl_dlat*1.e-3 )THEN 
    1059                IF(td_lat0%d_value(ji,jj,1,1) > dl_lat1_ll ) il_ill(2)=il_ill(2)-1 
     2601            IF( ABS(tl_lat0%d_value(ji,jj,1,1)-dl_lat1_ll) > dp_delta )THEN 
     2602               IF(tl_lat0%d_value(ji,jj,1,1) > dl_lat1_ll )THEN 
     2603                  il_ill(2)=il_ill(2)-1 
     2604                  IF( il_ill(2)-1 <= 0 )THEN 
     2605                     CALL logger_error("GRID GET COARSE INDEX: error "//& 
     2606                     &                 "computing lower left corner "//& 
     2607                     &                 "index for latitude") 
     2608                  ENDIF 
     2609               ENDIF 
    10602610            ENDIF 
    10612611 
    10622612            !2- search upper left corner indices 
    1063             dl_lon1_ul=td_lon1%d_value( il_imin1, il_jmax1, 1, 1 ) 
    1064             dl_lat1_ul=td_lat1%d_value( il_imin1, il_jmax1, 1, 1 ) 
    1065  
    1066             dl_dlon=ABS(td_lon1%d_value(il_imin1+1,il_jmax1  ,1,1)-dl_lon1_ll) 
    1067             dl_dlat=ABS(td_lat1%d_value(il_imin1  ,il_jmax1-1,1,1)-dl_lat1_ll) 
    1068              
     2613            dl_lon1_ul=tl_lon1%d_value( il_imin1, il_jmax1, 1, 1 ) 
     2614            dl_lat1_ul=tl_lat1%d_value( il_imin1, il_jmax1, 1, 1 ) 
     2615 
     2616            IF( dl_lon1_ul == tl_lon1%d_fill .OR. & 
     2617            &   dl_lat1_ul == tl_lat1%d_fill )THEN 
     2618               CALL logger_error("GRID GET COARSE INDEX: upper left corner "//& 
     2619               &                 "point is FillValue. remove ghost cell "//& 
     2620               &                 "running grid_get_coarse_index.") 
     2621            ENDIF             
    10692622            ! look for closest point on coarse grid 
    1070             il_iul(:)= grid_get_closest(td_lon0%d_value(il_imin0:il_imax0, & 
     2623            il_iul(:)= grid_get_closest(tl_lon0%d_value(il_imin0:il_imax0, & 
    10712624            &                                           il_jmin0:il_jmax0, & 
    10722625            &                                           1,1), & 
    1073             &                           td_lat0%d_value(il_imin0:il_imax0, & 
     2626            &                           tl_lat0%d_value(il_imin0:il_imax0, & 
    10742627            &                                           il_jmin0:il_jmax0, & 
    10752628            &                                           1,1), & 
     
    10802633            jj = il_iul(2) 
    10812634 
    1082             IF( ABS(td_lon0%d_value(ji,jj,1,1)-dl_lon1_ul) > dl_dlon*1.e-3 )THEN 
    1083                IF(td_lon0%d_value(ji,jj,1,1) > dl_lon1_ul ) il_iul(1)=il_iul(1)-1 
     2635            IF( ABS(tl_lon0%d_value(ji,jj,1,1)-dl_lon1_ul) > dp_delta )THEN 
     2636               IF(tl_lon0%d_value(ji,jj,1,1) > dl_lon1_ul )THEN 
     2637                  il_iul(1)=il_iul(1)-1 
     2638                  IF( il_iul(1) <= 0 )THEN 
     2639                     IF( tl_lon0%i_ew >= 0 )THEN 
     2640                        il_iul(1)=tl_lon0%t_dim(jp_I)%i_len-tl_lon0%i_ew 
     2641                     ELSE 
     2642                        CALL logger_error("GRID GET COARSE INDEX: error "//& 
     2643                        &                 "computing upper left corner "//& 
     2644                        &                 "index for longitude") 
     2645                     ENDIF 
     2646                  ENDIF 
     2647               ENDIF 
    10842648            ENDIF 
    1085             IF( ABS(td_lat0%d_value(ji,jj,1,1)-dl_lat1_ul) > dl_dlat*1.e-3 )THEN 
    1086                IF(td_lat0%d_value(ji,jj,1,1) < dl_lat1_ul ) il_iul(2)=il_iul(2)+1 
     2649 
     2650            IF( ABS(tl_lat0%d_value(ji,jj,1,1)-dl_lat1_ul) > dp_delta )THEN 
     2651               IF(tl_lat0%d_value(ji,jj,1,1) < dl_lat1_ul )THEN 
     2652                  il_iul(2)=il_iul(2)+1 
     2653                  IF( il_ill(2) > tl_lat0%t_dim(jp_J)%i_len )THEN 
     2654                     CALL logger_error("GRID GET COARSE INDEX: error "//& 
     2655                     &                 "computing upper left corner "//& 
     2656                     &                 "index for latitude") 
     2657                  ENDIF 
     2658               ENDIF 
    10872659            ENDIF 
    10882660 
    10892661            !3- search lower right corner indices 
    1090             dl_lon1_lr=td_lon1%d_value( il_imax1, il_jmin1, 1, 1 ) 
    1091             dl_lat1_lr=td_lat1%d_value( il_imax1, il_jmin1, 1, 1 ) 
    1092  
    1093             dl_dlon=ABS(td_lon1%d_value(il_imax1-1,il_jmin1  ,1,1)-dl_lon1_ll) 
    1094             dl_dlat=ABS(td_lat1%d_value(il_imax1  ,il_jmin1+1,1,1)-dl_lat1_ll) 
    1095              
     2662            dl_lon1_lr=tl_lon1%d_value( il_imax1, il_jmin1, 1, 1 ) 
     2663            dl_lat1_lr=tl_lat1%d_value( il_imax1, il_jmin1, 1, 1 ) 
     2664 
     2665            IF( dl_lon1_lr == tl_lon1%d_fill .OR. & 
     2666            &   dl_lat1_lr == tl_lat1%d_fill )THEN 
     2667               CALL logger_error("GRID GET COARSE INDEX: lower right corner "//& 
     2668               &                 "point is FillValue. remove ghost cell "//& 
     2669               &                 "running grid_get_coarse_index.") 
     2670            ENDIF             
    10962671            ! look for closest point on coarse grid 
    1097             il_ilr(:)= grid_get_closest(td_lon0%d_value(il_imin0:il_imax0, & 
     2672            il_ilr(:)= grid_get_closest(tl_lon0%d_value(il_imin0:il_imax0, & 
    10982673            &                                           il_jmin0:il_jmax0, & 
    10992674            &                                           1,1), & 
    1100             &                           td_lat0%d_value(il_imin0:il_imax0, & 
     2675            &                           tl_lat0%d_value(il_imin0:il_imax0, & 
    11012676            &                                           il_jmin0:il_jmax0, & 
    11022677            &                                           1,1), & 
     
    11062681            ji = il_ilr(1) 
    11072682            jj = il_ilr(2) 
    1108             IF( ABS(td_lon0%d_value(ji,jj,1,1)-dl_lon1_lr) > dl_dlon*1.e-3 )THEN 
    1109                IF( td_lon0%d_value(ji,jj,1,1) < dl_lon1_lr ) il_ilr(1)=il_ilr(1)+1 
     2683            IF( ABS(tl_lon0%d_value(ji,jj,1,1)-dl_lon1_lr) > dp_delta )THEN 
     2684               IF( tl_lon0%d_value(ji,jj,1,1) < dl_lon1_lr )THEN 
     2685                  il_ilr(1)=il_ilr(1)+1 
     2686                  IF( il_ilr(1) > tl_lon0%t_dim(jp_I)%i_len )THEN 
     2687                     IF( tl_lon0%i_ew >= 0 )THEN 
     2688                        il_ilr(1)=tl_lon0%i_ew+1 
     2689                     ELSE 
     2690                        CALL logger_error("GRID GET COARSE INDEX: error "//& 
     2691                        &                 "computing lower right corner "//& 
     2692                        &                 "index for longitude") 
     2693                     ENDIF 
     2694                  ENDIF 
     2695               ENDIF 
    11102696            ENDIF 
    1111             IF( ABS(td_lat0%d_value(ji,jj,1,1)-dl_lat1_lr) > dl_dlat*1.e-3 )THEN 
    1112                IF( td_lat0%d_value(ji,jj,1,1) > dl_lat1_lr ) il_ilr(2)=il_ilr(2)-1 
     2697            IF( ABS(tl_lat0%d_value(ji,jj,1,1)-dl_lat1_lr) > dp_delta )THEN 
     2698               IF( tl_lat0%d_value(ji,jj,1,1) > dl_lat1_lr )THEN 
     2699                  il_ilr(2)=il_ilr(2)-1 
     2700                  IF( il_ilr(2) <= 0 )THEN 
     2701                     CALL logger_error("GRID GET COARSE INDEX: error "//& 
     2702                     &                 "computing lower right corner "//& 
     2703                     &                 "index for latitude") 
     2704                  ENDIF 
     2705               ENDIF 
    11132706            ENDIF 
    11142707 
    11152708            !4- search upper right corner indices 
    1116             dl_lon1_ur=td_lon1%d_value( il_imax1, il_jmax1, 1, 1 ) 
    1117             dl_lat1_ur=td_lat1%d_value( il_imax1, il_jmax1, 1, 1 ) 
    1118  
    1119             dl_dlon=ABS(td_lon1%d_value(il_imax1-1,il_jmax1  ,1,1)-dl_lon1_ll) 
    1120             dl_dlat=ABS(td_lat1%d_value(il_imax1  ,il_jmax1-1,1,1)-dl_lat1_ll) 
    1121              
     2709            dl_lon1_ur=tl_lon1%d_value( il_imax1, il_jmax1, 1, 1 ) 
     2710            dl_lat1_ur=tl_lat1%d_value( il_imax1, il_jmax1, 1, 1 ) 
     2711 
     2712            IF( dl_lon1_ur == tl_lon1%d_fill .OR. & 
     2713            &   dl_lat1_ur == tl_lat1%d_fill )THEN 
     2714               CALL logger_error("GRID GET COARSE INDEX: upper right corner "//& 
     2715               &                 "point is FillValue. remove ghost cell "//& 
     2716               &                 "running grid_get_coarse_index.") 
     2717            ENDIF             
    11222718            ! look for closest point on coarse grid 
    1123             il_iur(:)= grid_get_closest(td_lon0%d_value(il_imin0:il_imax0, & 
     2719            il_iur(:)= grid_get_closest(tl_lon0%d_value(il_imin0:il_imax0, & 
    11242720            &                                           il_jmin0:il_jmax0, & 
    11252721            &                                           1,1), & 
    1126             &                           td_lat0%d_value(il_imin0:il_imax0, & 
     2722            &                           tl_lat0%d_value(il_imin0:il_imax0, & 
    11272723            &                                           il_jmin0:il_jmax0, & 
    11282724            &                                           1,1), & 
     
    11322728            ji = il_iur(1) 
    11332729            jj = il_iur(2) 
    1134             IF( ABS(td_lon0%d_value(ji,jj,1,1)-dl_lon1_ur) > dl_dlon*1.e-3 )THEN 
    1135                IF( td_lon0%d_value(ji,jj,1,1) < dl_lon1_ur ) il_iur(1)=il_iur(1)+1 
     2730            IF( ABS(tl_lon0%d_value(ji,jj,1,1)-dl_lon1_ur) > dp_delta )THEN 
     2731               IF( tl_lon0%d_value(ji,jj,1,1) < dl_lon1_ur )THEN 
     2732                  il_iur(1)=il_iur(1)+1 
     2733                  IF( il_iur(1) > tl_lon0%t_dim(jp_I)%i_len )THEN 
     2734                     IF( tl_lon0%i_ew >= 0 )THEN 
     2735                        il_iur(1)=tl_lon0%i_ew+1 
     2736                     ELSE 
     2737                        CALL logger_error("GRID GET COARSE INDEX: error "//& 
     2738                        &                 "computing upper right corner "//& 
     2739                        &                 "index for longitude") 
     2740                     ENDIF 
     2741                  ENDIF 
     2742               ENDIF 
    11362743            ENDIF 
    1137             IF( ABS(td_lat0%d_value(ji,jj,1,1)-dl_lat1_ur) > dl_dlat*1.e-3 )THEN 
    1138                IF( td_lat0%d_value(ji,jj,1,1) < dl_lat1_ur ) il_iur(2)=il_iur(2)+1 
     2744            IF( ABS(tl_lat0%d_value(ji,jj,1,1)-dl_lat1_ur) > dp_delta )THEN 
     2745               IF( tl_lat0%d_value(ji,jj,1,1) < dl_lat1_ur )THEN 
     2746                  il_iur(2)=il_iur(2)+1 
     2747                  IF( il_iur(2) > tl_lat0%t_dim(jp_J)%i_len )THEN 
     2748                     CALL logger_error("GRID GET COARSE INDEX: error "//& 
     2749                     &                 "computing upper right corner "//& 
     2750                     &                 "index for latitude") 
     2751                  ENDIF 
     2752               ENDIF 
    11392753            ENDIF 
    11402754 
     
    11442758 
    11452759            IF( il_imax <= il_ew0 )THEN 
    1146                il_imax = td_lon0%t_dim(1)%i_len - il_ew0 + il_imax  
     2760               !il_imin = 1 
     2761               il_imax = tl_lon0%t_dim(1)%i_len - il_ew0 + il_imax  
    11472762            ENDIF 
    11482763 
    11492764            il_jmin = il_jmin0-1+MIN(il_ill(2), il_ilr(2)) 
    11502765            il_jmax = il_jmin0-1+MAX(il_iul(2), il_iur(2)) 
    1151  
    1152             il_offset(:,:)= grid_get_fine_offset( td_lon0%d_value( :,:,1,1 ), & 
    1153             &                                     td_lat0%d_value( :,:,1,1 ), & 
    1154             &                                     il_imin, il_jmin, & 
    1155             &                                     il_imax, il_jmax, & 
    1156             &                                     td_lon1%d_value( :,:,1,1 ), & 
    1157             &                                     td_lat1%d_value( :,:,1,1 ), & 
    1158             &                                     il_rho(:) ) 
    1159  
    1160             grid_get_coarse_index_cc(1,1,2) = il_offset(1,1) 
    1161             grid_get_coarse_index_cc(1,2,2) = il_offset(1,2) 
    1162  
    1163             grid_get_coarse_index_cc(2,1,2) = il_offset(2,1) 
    1164             grid_get_coarse_index_cc(2,2,2) = il_offset(2,2)  
    11652766 
    11662767            ! special case if east west overlap 
     
    11702771 
    11712772               il_imin = 1 
    1172                il_imax = 1 
    1173  
    1174                grid_get_coarse_index_cc(1,1,2) = 0 
    1175                grid_get_coarse_index_cc(1,2,2) = 0 
     2773               il_imax = tl_lon0%t_dim(1)%i_len 
     2774 
    11762775            ENDIF 
    1177  
    11782776         ENDIF 
    11792777 
    1180          IF( il_imin == il_imax ) il_imax=td_lon0%t_dim(1)%i_len 
    1181          IF( il_jmin == il_jmax ) il_jmax=td_lon0%t_dim(2)%i_len 
    1182  
    1183          grid_get_coarse_index_cc(1,1,1) = il_imin 
    1184          grid_get_coarse_index_cc(1,2,1) = il_imax 
    1185  
    1186          grid_get_coarse_index_cc(2,1,1) = il_jmin 
    1187          grid_get_coarse_index_cc(2,2,1) = il_jmax 
     2778         grid__get_coarse_index_cc(1,1) = il_imin 
     2779         grid__get_coarse_index_cc(1,2) = il_imax 
     2780 
     2781         grid__get_coarse_index_cc(2,1) = il_jmin 
     2782         grid__get_coarse_index_cc(2,2) = il_jmax 
    11882783  
    1189       ENDIF 
    1190  
    1191    END FUNCTION grid_get_coarse_index_cc 
    1192    !> @endcode 
     2784         ! clean  
     2785         CALL var_clean(tl_lon1) 
     2786         CALL var_clean(tl_lat1) 
     2787         CALL var_clean(tl_lon0) 
     2788         CALL var_clean(tl_lat0) 
     2789      ENDIF 
     2790 
     2791      DEALLOCATE( il_rho ) 
     2792 
     2793   END FUNCTION grid__get_coarse_index_cc 
    11932794   !------------------------------------------------------------------- 
    11942795   !> @brief This function check if grid is global or not 
     
    11972798   ! 
    11982799   !> @author J.Paul 
    1199    !> - Nov, 2013- Initial Version 
    1200    ! 
    1201    !> @param[in] td_lon : longitude structure  
    1202    !> @param[in] td_lat : latitude structure  
    1203    !------------------------------------------------------------------- 
    1204    !> @code 
     2800   !> - November, 2013- Initial Version 
     2801   ! 
     2802   !> @param[in] td_lon longitude structure  
     2803   !> @param[in] td_lat latitude structure  
     2804   !------------------------------------------------------------------- 
    12052805   FUNCTION grid_is_global(td_lon, td_lat) 
    12062806      IMPLICIT NONE 
     
    12332833      IF( .NOT. ASSOCIATED(td_lon%d_value) .OR. & 
    12342834      &   .NOT. ASSOCIATED(td_lat%d_value) )THEN 
    1235          CALL logger_error("GRID IS GLOBAL: na value associated to "//& 
     2835         CALL logger_error("GRID IS GLOBAL: no value associated to "//& 
    12362836         &              " longitude or latitude strucutre")       
    12372837      ELSE 
     
    12562856 
    12572857   END FUNCTION grid_is_global 
    1258    !> @endcode 
    1259  
    12602858   !------------------------------------------------------------------- 
    12612859   !> @brief This function return coarse grid indices of the closest point 
    12622860   !> from fine grid point (lon1,lat1)  
    12632861   !>  
    1264    ! 
    12652862   !> @details 
    1266    ! 
    1267    !> @note overlap band should have been already removed from coarse grid table  
     2863   !> 
     2864   !> @note overlap band should have been already removed from coarse grid array  
    12682865   !> of longitude and latitude, before running this function 
    12692866   !> 
    12702867   !> @author J.Paul 
    1271    !> - Nov, 2013- Initial Version 
    1272    ! 
    1273    !> @param[in] dd_lon0 : coarse grid table of longitude 
    1274    !> @param[in] dd_lat0 : coarse grid table of latitude 
    1275    !> @param[in] dd_lon1 : fine   grid longitude 
    1276    !> @param[in] dd_lat1 : fine   grid latitude 
     2868   !> - November, 2013- Initial Version 
     2869   ! 
     2870   !> @param[in] dd_lon0   coarse grid array of longitude 
     2871   !> @param[in] dd_lat0   coarse grid array of latitude 
     2872   !> @param[in] dd_lon1   fine   grid longitude 
     2873   !> @param[in] dd_lat1   fine   grid latitude 
    12772874   !> @return coarse grid indices of closest point of fine grid point 
    12782875   !> 
    1279    !> @todo  
    1280    !------------------------------------------------------------------- 
    1281    !> @code 
     2876   !------------------------------------------------------------------- 
    12822877   FUNCTION grid_get_closest( dd_lon0, dd_lat0, dd_lon1, dd_lat1  ) 
    12832878      IMPLICIT NONE 
     
    13262921      IF( dd_lon1 < 0 ) dl_lon1 = dd_lon1 + 360. 
    13272922 
    1328       !1- first, use dichotomy to reduce domain 
     2923      ! first, use dichotomy to reduce domain 
    13292924      il_iinf = 1              ; il_jinf = 1 
    13302925      il_isup = il_shape(1)    ; il_jsup = il_shape(2) 
     
    13362931      ll_continue=.TRUE. 
    13372932 
    1338       !1-1 look for meridian 0°/360° 
     2933      ! look for meridian 0°/360° 
    13392934      il_jmid = il_jinf + INT(il_shape(2)/2) 
    13402935      il_ind(:) = MAXLOC( dl_lon0(:,il_jmid), dl_lon0(:,il_jmid) <= 360._dp ) 
     
    13782973      ENDIF 
    13792974 
    1380       !1-2 
     2975      ! 
    13812976      DO WHILE( ll_continue .AND. .NOT. ll_north ) 
    13822977 
     
    14012996 
    14022997            ENDIF 
    1403  
    14042998 
    14052999            IF( dd_lat1 > dd_lat0(il_imid,il_jmid) )THEN 
     
    14303024      ENDDO 
    14313025 
    1432       !2- then find closest point by computing distances 
     3026      ! then find closest point by computing distances 
    14333027      il_shape(1)= il_isup - il_iinf + 1 
    14343028      il_shape(2)= il_jsup - il_jinf + 1 
     
    14493043 
    14503044   END FUNCTION grid_get_closest 
    1451    !> @endcode 
    1452    !------------------------------------------------------------------- 
    1453    !> @brief This function compute the distance between a point A and  
    1454    !> points of a grid   
     3045   !------------------------------------------------------------------- 
     3046   !> @brief This function compute the distance between a point A and grid points.   
    14553047   ! 
    14563048   !> @details 
    14573049   ! 
    14583050   !> @author J.Paul 
    1459    !> - Nov, 2013- Initial Version 
    1460    ! 
    1461    !> @param[in] dd_lon : grid longitude table 
    1462    !> @param[in] dd_lat : grid latitude  table 
    1463    !> @param[in] dd_lonA : longitude of point A 
    1464    !> @param[in] dd_latA : latitude  of point A 
    1465    !------------------------------------------------------------------- 
    1466    !> @code 
     3051   !> - November, 2013- Initial Version 
     3052   ! 
     3053   !> @param[in] dd_lon    grid longitude array 
     3054   !> @param[in] dd_lat    grid latitude  array 
     3055   !> @param[in] dd_lonA   longitude of point A 
     3056   !> @param[in] dd_latA   latitude  of point A 
     3057   !> @return array of distance between point A and grid points. 
     3058   !------------------------------------------------------------------- 
    14673059   FUNCTION grid_distance(dd_lon, dd_lat, dd_lonA, dd_latA) 
    14683060      IMPLICIT NONE 
     
    15073099      IF(   dd_lonA     < 0 ) dl_lonA     = dd_lonA     + 360. 
    15083100       
    1509       dl_lonA = dd_lonA * dg_deg2rad 
    1510       dl_latA = dd_latA * dg_deg2rad 
    1511  
    1512       dl_lon(:,:) = dl_lon(:,:) * dg_deg2rad 
    1513       dl_lat(:,:) = dd_lat(:,:) * dg_deg2rad 
     3101      dl_lonA = dd_lonA * dp_deg2rad 
     3102      dl_latA = dd_latA * dp_deg2rad 
     3103 
     3104      dl_lon(:,:) = dl_lon(:,:) * dp_deg2rad 
     3105      dl_lat(:,:) = dd_lat(:,:) * dp_deg2rad 
    15143106 
    15153107      grid_distance(:,:)=NF90_FILL_DOUBLE 
     
    15183110         DO ji=1,il_shape(1) 
    15193111            IF( dl_lon(ji,jj) == dl_lonA .AND. & 
    1520             &   dl_lat(ji,jj) == dl_lATA )THEN 
     3112            &   dl_lat(ji,jj) == dl_laTA )THEN 
    15213113               grid_distance(ji,jj)=0.0 
    15223114            ELSE 
     
    15263118               IF( dl_tmp < -1.0 ) dl_tmp = -1.0 
    15273119               IF( dl_tmp >  1.0 ) dl_tmp =  1.0 
    1528                grid_distance(ji,jj)=ACOS(dl_tmp)*dg_rearth 
     3120               grid_distance(ji,jj)=ACOS(dl_tmp)*dp_rearth 
    15293121            ENDIF 
    15303122         ENDDO 
     
    15353127 
    15363128   END FUNCTION grid_distance 
    1537    !> @endcode 
    1538    !------------------------------------------------------------------- 
    1539    !> @brief This function get fine grid offset. 
     3129   !------------------------------------------------------------------- 
     3130   !> @brief This function get offset between fine grid and coarse grid. 
     3131   ! 
     3132   !> @details 
     3133   !> optionally, you could specify on which Arakawa grid point you want to 
     3134   !> work (default 'T') 
     3135   !> offset value could be 0,1,..,rho-1 
     3136   ! 
     3137   !> @author J.Paul 
     3138   !> - September, 2014- Initial Version 
     3139   !> @date October, 2014 
     3140   !> - work on mpp file structure instead of file structure 
     3141   ! 
     3142   !> @param[in] td_coord0 coarse grid coordinate  
     3143   !> @param[in] id_imin0  coarse grid lower left corner i-indice of fine grid domain 
     3144   !> @param[in] id_jmin0  coarse grid lower left corner j-indice of fine grid domain 
     3145   !> @param[in] id_imax0  coarse grid upper right corner i-indice of fine grid domain 
     3146   !> @param[in] id_jmax0  coarse grid upper right corner j-indice of fine grid domain 
     3147   !> @param[in] td_coord1 fine   grid coordinate  
     3148   !> @param[in] id_rho    array of refinement factor 
     3149   !> @param[in] cd_point  Arakawa grid point 
     3150   !> @return offset array (/ (/i_offset_left,i_offset_right/),(/j_offset_lower,j_offset_upper/) /) 
     3151   !------------------------------------------------------------------- 
     3152   FUNCTION grid__get_fine_offset_ff( td_coord0, & 
     3153   &                                  id_imin0, id_jmin0, id_imax0, id_jmax0, & 
     3154   &                                  td_coord1, id_rho, cd_point ) 
     3155      IMPLICIT NONE 
     3156      ! Argument 
     3157      TYPE(TMPP)                    , INTENT(IN) :: td_coord0 
     3158      TYPE(TMPP)                    , INTENT(IN) :: td_coord1 
     3159 
     3160      INTEGER(i4)                   , INTENT(IN) :: id_imin0 
     3161      INTEGER(i4)                   , INTENT(IN) :: id_jmin0 
     3162      INTEGER(i4)                   , INTENT(IN) :: id_imax0 
     3163      INTEGER(i4)                   , INTENT(IN) :: id_jmax0 
     3164 
     3165      INTEGER(i4)     , DIMENSION(:), INTENT(IN), OPTIONAL :: id_rho 
     3166      CHARACTER(LEN=*)              , INTENT(IN), OPTIONAL :: cd_point 
     3167 
     3168      ! function 
     3169      INTEGER(i4), DIMENSION(2,2) :: grid__get_fine_offset_ff 
     3170 
     3171      ! local variable 
     3172      INTEGER(i4) :: il_imin0 
     3173      INTEGER(i4) :: il_jmin0 
     3174      INTEGER(i4) :: il_imax0 
     3175      INTEGER(i4) :: il_jmax0 
     3176       
     3177      INTEGER(i4), DIMENSION(:), ALLOCATABLE :: il_rho 
     3178       
     3179      INTEGER(i4), DIMENSION(2,2)         :: il_xghost0 
     3180      INTEGER(i4), DIMENSION(2,2)         :: il_xghost1 
     3181 
     3182      CHARACTER(LEN= 1) :: cl_point 
     3183      CHARACTER(LEN=lc) :: cl_name 
     3184 
     3185      REAL(dp)   , DIMENSION(:,:), ALLOCATABLE :: dl_lon0 
     3186      REAL(dp)   , DIMENSION(:,:), ALLOCATABLE :: dl_lat0 
     3187      REAL(dp)   , DIMENSION(:,:), ALLOCATABLE :: dl_lon1 
     3188      REAL(dp)   , DIMENSION(:,:), ALLOCATABLE :: dl_lat1 
     3189 
     3190      TYPE(TVAR) :: tl_lon0 
     3191      TYPE(TVAR) :: tl_lat0 
     3192      TYPE(TVAR) :: tl_lon1 
     3193      TYPE(TVAR) :: tl_lat1 
     3194 
     3195      TYPE(TMPP) :: tl_coord0 
     3196      TYPE(TMPP) :: tl_coord1 
     3197       
     3198      ! loop indices 
     3199      !---------------------------------------------------------------- 
     3200      ! init 
     3201      grid__get_fine_offset_ff(:,:)=-1 
     3202 
     3203      ALLOCATE(il_rho(ip_maxdim)) 
     3204      il_rho(:)=1 
     3205      IF( PRESENT(id_rho) ) il_rho(:)=id_rho(:) 
     3206 
     3207      cl_point='T' 
     3208      IF( PRESENT(cd_point) ) cl_point=TRIM(fct_upper(cd_point)) 
     3209 
     3210      ! copy structure 
     3211      tl_coord0=mpp_copy(td_coord0) 
     3212      tl_coord1=mpp_copy(td_coord1) 
     3213 
     3214      IF( .NOT. ASSOCIATED(tl_coord0%t_proc) .OR. & 
     3215      &   .NOT. ASSOCIATED(tl_coord1%t_proc) )THEN 
     3216         CALL logger_error("GRID GET FINE OFFSET: can not get coarse "//& 
     3217         &  "grid indices. decompsition of mpp file "//TRIM(tl_coord0%c_name)//& 
     3218         &  " and/or "//TRIM(tl_coord1%c_name)//" not defined." ) 
     3219      ELSE       
     3220         !1- Coarse grid 
     3221         ! get ghost cell factor on coarse grid 
     3222         il_xghost0(:,:)=grid_get_ghost( tl_coord0 ) 
     3223 
     3224         ! open mpp files 
     3225         CALL iom_mpp_open(tl_coord0) 
     3226 
     3227         ! read coarse longitue and latitude 
     3228         WRITE(cl_name,*) 'longitude_'//TRIM(cl_point) 
     3229         tl_lon0=iom_mpp_read_var(tl_coord0, TRIM(cl_name)) 
     3230         WRITE(cl_name,*) 'latitude_'//TRIM(cl_point) 
     3231         tl_lat0=iom_mpp_read_var(tl_coord0, TRIM(cl_name)) 
     3232          
     3233         ! close mpp files 
     3234         CALL iom_mpp_close(tl_coord0) 
     3235 
     3236         CALL grid_del_ghost(tl_lon0, il_xghost0(:,:)) 
     3237         CALL grid_del_ghost(tl_lat0, il_xghost0(:,:)) 
     3238 
     3239         ALLOCATE(dl_lon0(tl_lon0%t_dim(jp_I)%i_len, & 
     3240         &                tl_lon0%t_dim(jp_J)%i_len )) 
     3241 
     3242         dl_lon0(:,:)=tl_lon0%d_value(:,:,1,1) 
     3243 
     3244         ALLOCATE(dl_lat0(tl_lat0%t_dim(jp_I)%i_len, & 
     3245         &                tl_lat0%t_dim(jp_J)%i_len )) 
     3246 
     3247         dl_lat0(:,:)=tl_lat0%d_value(:,:,1,1) 
     3248 
     3249         ! clean 
     3250         CALL var_clean(tl_lon0) 
     3251         CALL var_clean(tl_lat0) 
     3252 
     3253         ! adjust coarse grid indices 
     3254         il_imin0=id_imin0-il_xghost0(jp_I,1) 
     3255         il_imax0=id_imax0-il_xghost0(jp_I,1) 
     3256 
     3257         il_jmin0=id_jmin0-il_xghost0(jp_J,1) 
     3258         il_jmax0=id_jmax0-il_xghost0(jp_J,1) 
     3259 
     3260         !2- Fine grid 
     3261         ! get ghost cell factor on fine grid 
     3262         il_xghost1(:,:)=grid_get_ghost( tl_coord1 ) 
     3263 
     3264         ! open mpp files 
     3265         CALL iom_mpp_open(tl_coord1) 
     3266 
     3267         ! read fine longitue and latitude 
     3268         WRITE(cl_name,*) 'longitude_'//TRIM(cl_point) 
     3269         tl_lon1=iom_mpp_read_var(tl_coord1, TRIM(cl_name)) 
     3270         WRITE(cl_name,*) 'latitude_'//TRIM(cl_point) 
     3271         tl_lat1=iom_mpp_read_var(tl_coord1, TRIM(cl_name)) 
     3272  
     3273         ! close mpp files 
     3274         CALL iom_mpp_close(tl_coord1) 
     3275 
     3276         CALL grid_del_ghost(tl_lon1, il_xghost1(:,:)) 
     3277         CALL grid_del_ghost(tl_lat1, il_xghost1(:,:)) 
     3278 
     3279         ALLOCATE(dl_lon1(tl_lon1%t_dim(jp_I)%i_len, & 
     3280         &                tl_lon1%t_dim(jp_J)%i_len )) 
     3281 
     3282         dl_lon1(:,:)=tl_lon1%d_value(:,:,1,1) 
     3283 
     3284         ALLOCATE(dl_lat1(tl_lat1%t_dim(jp_I)%i_len, & 
     3285         &                tl_lat1%t_dim(jp_J)%i_len )) 
     3286 
     3287         dl_lat1(:,:)=tl_lat1%d_value(:,:,1,1) 
     3288 
     3289         ! clean 
     3290         CALL var_clean(tl_lon1) 
     3291         CALL var_clean(tl_lat1) 
     3292  
     3293         !3- compute 
     3294         grid__get_fine_offset_ff(:,:)=grid_get_fine_offset( & 
     3295         &                                         dl_lon0(:,:), dl_lat0(:,:),& 
     3296         &                                         il_imin0, il_jmin0, & 
     3297         &                                         il_imax0, il_jmax0, & 
     3298         &                                         dl_lon1(:,:), dl_lat1(:,:),& 
     3299         &                                         id_rho(:) ) 
     3300  
     3301         DEALLOCATE(dl_lon0, dl_lat0) 
     3302         DEALLOCATE(dl_lon1, dl_lat1) 
     3303      ENDIF 
     3304 
     3305      ! clean  
     3306      CALL mpp_clean(tl_coord0) 
     3307      CALL mpp_clean(tl_coord1) 
     3308      DEALLOCATE(il_rho) 
     3309 
     3310   END FUNCTION grid__get_fine_offset_ff 
     3311   !------------------------------------------------------------------- 
     3312   !> @brief This function get offset between fine grid and coarse grid. 
     3313   ! 
     3314   !> @details 
     3315   !> optionally, you could specify on which Arakawa grid point you want to 
     3316   !> work (default 'T') 
     3317   !> offset value could be 0,1,..,rho-1 
     3318   ! 
     3319   !> @author J.Paul 
     3320   !> - September, 2014- Initial Version 
     3321   !> @date October, 2014 
     3322   !> - work on mpp file structure instead of file structure 
     3323   ! 
     3324   !> @param[in] dd_lon0   coarse grid longitude array  
     3325   !> @param[in] dd_lat0   coarse grid latitude  array 
     3326   !> @param[in] id_imin0  coarse grid lower left corner i-indice of fine grid domain 
     3327   !> @param[in] id_jmin0  coarse grid lower left corner j-indice of fine grid domain 
     3328   !> @param[in] id_imax0  coarse grid upper right corner i-indice of fine grid domain 
     3329   !> @param[in] id_jmax0  coarse grid upper right corner j-indice of fine grid domain 
     3330   !> @param[in] td_coord1 fine   grid coordinate  
     3331   !> @param[in] id_rho    array of refinement factor 
     3332   !> @param[in] cd_point  Arakawa grid point 
     3333   !> @return offset array (/ (/i_offset_left,i_offset_right/),(/j_offset_lower,j_offset_upper/) /) 
     3334   !------------------------------------------------------------------- 
     3335   FUNCTION grid__get_fine_offset_cf( dd_lon0, dd_lat0, & 
     3336   &                                  id_imin0, id_jmin0, id_imax0, id_jmax0, & 
     3337   &                                  td_coord1, id_rho, cd_point ) 
     3338      IMPLICIT NONE 
     3339      ! Argument 
     3340      REAL(dp)       , DIMENSION(:,:), INTENT(IN) :: dd_lon0 
     3341      REAL(dp)       , DIMENSION(:,:), INTENT(IN) :: dd_lat0 
     3342      TYPE(TMPP)                     , INTENT(IN) :: td_coord1 
     3343 
     3344      INTEGER(i4)                    , INTENT(IN) :: id_imin0 
     3345      INTEGER(i4)                    , INTENT(IN) :: id_jmin0 
     3346      INTEGER(i4)                    , INTENT(IN) :: id_imax0 
     3347      INTEGER(i4)                    , INTENT(IN) :: id_jmax0 
     3348 
     3349      INTEGER(i4)     , DIMENSION(:) , INTENT(IN), OPTIONAL :: id_rho 
     3350      CHARACTER(LEN=*)               , INTENT(IN), OPTIONAL :: cd_point 
     3351 
     3352      ! function 
     3353      INTEGER(i4), DIMENSION(2,2) :: grid__get_fine_offset_cf 
     3354 
     3355      ! local variable 
     3356      INTEGER(i4), DIMENSION(:), ALLOCATABLE :: il_rho 
     3357       
     3358      INTEGER(i4), DIMENSION(2,2)         :: il_xghost1 
     3359 
     3360      CHARACTER(LEN= 1) :: cl_point 
     3361      CHARACTER(LEN=lc) :: cl_name 
     3362 
     3363      REAL(dp)   , DIMENSION(:,:), ALLOCATABLE :: dl_lon1 
     3364      REAL(dp)   , DIMENSION(:,:), ALLOCATABLE :: dl_lat1 
     3365 
     3366      TYPE(TVAR) :: tl_lon1 
     3367      TYPE(TVAR) :: tl_lat1 
     3368 
     3369      TYPE(TMPP) :: tl_coord1 
     3370      ! loop indices 
     3371      !---------------------------------------------------------------- 
     3372      ! init 
     3373      grid__get_fine_offset_cf(:,:)=-1 
     3374 
     3375      ALLOCATE(il_rho(ip_maxdim)) 
     3376      il_rho(:)=1 
     3377      IF( PRESENT(id_rho) ) il_rho(:)=id_rho(:) 
     3378 
     3379      cl_point='T' 
     3380      IF( PRESENT(cd_point) ) cl_point=TRIM(fct_upper(cd_point)) 
     3381 
     3382      ! copy structure 
     3383      tl_coord1=mpp_copy(td_coord1) 
     3384 
     3385      IF( .NOT. ASSOCIATED(tl_coord1%t_proc) )THEN 
     3386         CALL logger_error("GRID GET FINE OFFSET: decompsition of mpp "//& 
     3387         &  "file "//TRIM(tl_coord1%c_name)//" not defined." ) 
     3388      ELSE       
     3389 
     3390         ! Fine grid 
     3391         ! get ghost cell factor on fine grid 
     3392         il_xghost1(:,:)=grid_get_ghost( tl_coord1 ) 
     3393 
     3394         ! open mpp files 
     3395         CALL iom_mpp_open(tl_coord1) 
     3396 
     3397         ! read fine longitue and latitude 
     3398         WRITE(cl_name,*) 'longitude_'//TRIM(cl_point) 
     3399         tl_lon1=iom_mpp_read_var(tl_coord1, TRIM(cl_name)) 
     3400         WRITE(cl_name,*) 'latitude_'//TRIM(cl_point) 
     3401         tl_lat1=iom_mpp_read_var(tl_coord1, TRIM(cl_name)) 
     3402  
     3403         ! close mpp files 
     3404         CALL iom_mpp_close(tl_coord1) 
     3405 
     3406         CALL grid_del_ghost(tl_lon1, il_xghost1(:,:)) 
     3407         CALL grid_del_ghost(tl_lat1, il_xghost1(:,:)) 
     3408 
     3409         ALLOCATE(dl_lon1(tl_lon1%t_dim(jp_I)%i_len, & 
     3410         &                tl_lon1%t_dim(jp_J)%i_len )) 
     3411 
     3412         dl_lon1(:,:)=tl_lon1%d_value(:,:,1,1) 
     3413 
     3414         ALLOCATE(dl_lat1(tl_lat1%t_dim(jp_I)%i_len, & 
     3415         &                tl_lat1%t_dim(jp_J)%i_len )) 
     3416 
     3417         dl_lat1(:,:)=tl_lat1%d_value(:,:,1,1) 
     3418 
     3419         ! clean 
     3420         CALL var_clean(tl_lon1) 
     3421         CALL var_clean(tl_lat1) 
     3422       
     3423         ! compute 
     3424         grid__get_fine_offset_cf(:,:)=grid_get_fine_offset( & 
     3425         &                                         dd_lon0(:,:), dd_lat0(:,:),& 
     3426         &                                         id_imin0, id_jmin0, & 
     3427         &                                         id_imax0, id_jmax0, & 
     3428         &                                         dl_lon1(:,:), dl_lat1(:,:),& 
     3429         &                                         id_rho(:) ) 
     3430          
     3431         DEALLOCATE(dl_lon1, dl_lat1) 
     3432      ENDIF 
     3433 
     3434      ! clean  
     3435      CALL mpp_clean(tl_coord1) 
     3436      DEALLOCATE(il_rho) 
     3437 
     3438   END FUNCTION grid__get_fine_offset_cf 
     3439   !------------------------------------------------------------------- 
     3440   !> @brief This function get offset between fine grid and coarse grid. 
     3441   ! 
     3442   !> @details 
     3443   !> optionally, you could specify on which Arakawa grid point you want to 
     3444   !> work (default 'T') 
     3445   !> offset value could be 0,1,..,rho-1 
     3446   ! 
     3447   !> @author J.Paul 
     3448   !> - September, 2014- Initial Version 
     3449   !> @date October, 2014 
     3450   !> - work on mpp file structure instead of file structure 
     3451   ! 
     3452   !> @param[in] td_coord0 coarse grid coordinate  
     3453   !> @param[in] id_imin0  coarse grid lower left corner i-indice of fine grid domain 
     3454   !> @param[in] id_jmin0  coarse grid lower left corner j-indice of fine grid domain 
     3455   !> @param[in] id_imax0  coarse grid upper right corner i-indice of fine grid domain 
     3456   !> @param[in] id_jmax0  coarse grid upper right corner j-indice of fine grid domain 
     3457   !> @param[in] dd_lon1   fine   grid longitude array  
     3458   !> @param[in] dd_lat1   fine   grid latitude  array 
     3459   !> @param[in] id_rho    array of refinement factor 
     3460   !> @param[in] cd_point  Arakawa grid point 
     3461   !> @return offset array (/ (/i_offset_left,i_offset_right/),(/j_offset_lower,j_offset_upper/) /) 
     3462   !------------------------------------------------------------------- 
     3463   FUNCTION grid__get_fine_offset_fc( td_coord0, & 
     3464   &                                  id_imin0, id_jmin0, id_imax0, id_jmax0, & 
     3465   &                                  dd_lon1, dd_lat1, & 
     3466   &                                  id_rho, cd_point ) 
     3467      IMPLICIT NONE 
     3468      ! Argument 
     3469      TYPE(TMPP)                      , INTENT(IN) :: td_coord0 
     3470      REAL(dp)        , DIMENSION(:,:), INTENT(IN) :: dd_lon1 
     3471      REAL(dp)        , DIMENSION(:,:), INTENT(IN) :: dd_lat1 
     3472 
     3473      INTEGER(i4)                     , INTENT(IN) :: id_imin0 
     3474      INTEGER(i4)                     , INTENT(IN) :: id_jmin0 
     3475      INTEGER(i4)                     , INTENT(IN) :: id_imax0 
     3476      INTEGER(i4)                     , INTENT(IN) :: id_jmax0 
     3477 
     3478      INTEGER(i4)     , DIMENSION(:)  , INTENT(IN), OPTIONAL :: id_rho 
     3479      CHARACTER(LEN=*)                , INTENT(IN), OPTIONAL :: cd_point 
     3480 
     3481      ! function 
     3482      INTEGER(i4), DIMENSION(2,2) :: grid__get_fine_offset_fc 
     3483 
     3484      ! local variable 
     3485      INTEGER(i4) :: il_imin0 
     3486      INTEGER(i4) :: il_jmin0 
     3487      INTEGER(i4) :: il_imax0 
     3488      INTEGER(i4) :: il_jmax0 
     3489       
     3490      INTEGER(i4), DIMENSION(:), ALLOCATABLE :: il_rho 
     3491       
     3492      INTEGER(i4), DIMENSION(2,2)         :: il_xghost0 
     3493 
     3494      CHARACTER(LEN= 1) :: cl_point 
     3495      CHARACTER(LEN=lc) :: cl_name 
     3496 
     3497      REAL(dp)   , DIMENSION(:,:), ALLOCATABLE :: dl_lon0 
     3498      REAL(dp)   , DIMENSION(:,:), ALLOCATABLE :: dl_lat0 
     3499 
     3500      TYPE(TVAR) :: tl_lon0 
     3501      TYPE(TVAR) :: tl_lat0 
     3502 
     3503      TYPE(TMPP) :: tl_coord0 
     3504      ! loop indices 
     3505      !---------------------------------------------------------------- 
     3506      ! init 
     3507      grid__get_fine_offset_fc(:,:)=-1 
     3508 
     3509      ALLOCATE(il_rho(ip_maxdim)) 
     3510      il_rho(:)=1 
     3511      IF( PRESENT(id_rho) ) il_rho(:)=id_rho(:) 
     3512 
     3513      cl_point='T' 
     3514      IF( PRESENT(cd_point) ) cl_point=TRIM(fct_upper(cd_point)) 
     3515 
     3516      ! copy structure 
     3517      tl_coord0=mpp_copy(td_coord0) 
     3518 
     3519      IF( .NOT. ASSOCIATED(tl_coord0%t_proc) )THEN 
     3520         CALL logger_error("GRID GET FINE OFFSET: decompsition of mpp "//& 
     3521         &  "file "//TRIM(tl_coord0%c_name)//" not defined." ) 
     3522      ELSE       
     3523         !1- Coarse grid 
     3524         ! get ghost cell factor on coarse grid 
     3525         il_xghost0(:,:)=grid_get_ghost( tl_coord0 ) 
     3526 
     3527         ! open mpp files 
     3528         CALL iom_mpp_open(tl_coord0) 
     3529 
     3530         ! read coarse longitue and latitude 
     3531         WRITE(cl_name,*) 'longitude_'//TRIM(cl_point) 
     3532         tl_lon0=iom_mpp_read_var(tl_coord0, TRIM(cl_name)) 
     3533         WRITE(cl_name,*) 'latitude_'//TRIM(cl_point) 
     3534         tl_lat0=iom_mpp_read_var(tl_coord0, TRIM(cl_name)) 
     3535          
     3536         ! close mpp files 
     3537         CALL iom_mpp_close(tl_coord0) 
     3538 
     3539         CALL grid_del_ghost(tl_lon0, il_xghost0(:,:)) 
     3540         CALL grid_del_ghost(tl_lat0, il_xghost0(:,:)) 
     3541 
     3542         ALLOCATE(dl_lon0(tl_lon0%t_dim(jp_I)%i_len, & 
     3543         &                tl_lon0%t_dim(jp_J)%i_len )) 
     3544 
     3545         dl_lon0(:,:)=tl_lon0%d_value(:,:,1,1) 
     3546 
     3547         ALLOCATE(dl_lat0(tl_lat0%t_dim(jp_I)%i_len, & 
     3548         &                tl_lat0%t_dim(jp_J)%i_len )) 
     3549 
     3550         dl_lat0(:,:)=tl_lat0%d_value(:,:,1,1) 
     3551 
     3552         ! clean 
     3553         CALL var_clean(tl_lon0) 
     3554         CALL var_clean(tl_lat0) 
     3555 
     3556         ! adjust coarse grid indices 
     3557         il_imin0=id_imin0-il_xghost0(jp_I,1) 
     3558         il_imax0=id_imax0-il_xghost0(jp_I,1) 
     3559 
     3560         il_jmin0=id_jmin0-il_xghost0(jp_J,1) 
     3561         il_jmax0=id_jmax0-il_xghost0(jp_J,1) 
     3562 
     3563       
     3564         !3- compute 
     3565         grid__get_fine_offset_fc(:,:)=grid_get_fine_offset(& 
     3566         &                                         dl_lon0(:,:), dl_lat0(:,:),& 
     3567         &                                         il_imin0, il_jmin0, & 
     3568         &                                         il_imax0, il_jmax0, & 
     3569         &                                         dd_lon1(:,:), dd_lat1(:,:),& 
     3570         &                                         id_rho(:) ) 
     3571          
     3572         DEALLOCATE(dl_lon0, dl_lat0) 
     3573      ENDIF 
     3574 
     3575      ! clean 
     3576      CALL mpp_clean(tl_coord0) 
     3577      DEALLOCATE(il_rho) 
     3578 
     3579   END FUNCTION grid__get_fine_offset_fc 
     3580   !------------------------------------------------------------------- 
     3581   !> @brief This function get offset between fine grid and coarse grid. 
    15403582   ! 
    15413583   !> @details 
     
    15433585   ! 
    15443586   !> @author J.Paul 
    1545    !> - Nov, 2013- Initial Version 
    1546    ! 
    1547    !> @param[in] dd_lon0 : coarse grid longitude table  
    1548    !> @param[in] dd_lat0 : coarse grid latitude  table 
    1549    !> @param[in] dd_lon1 : fine   grid longitude table  
    1550    !> @param[in] dd_lat1 : fine   grid latitude  table 
    1551    !> @param[in] id_imin0 : coarse grid lower left corner i-indice of fine grid domain 
    1552    !> @param[in] id_jmin0 : coarse grid lower left corner j-indice of fine grid domain 
    1553    !> @param[in] id_imax0 : coarse grid upper right corner i-indice of fine grid domain 
    1554    !> @param[in] id_jmax0 : coarse grid upper right corner j-indice of fine grid domain 
    1555    !> @param[in] id_rhoi : i-direction refinement factor 
    1556    !> @param[in] id_rhoj : j-direction refinement factor 
    1557    !> @return offset table (/ (/i_offset_left,i_offset_right!/),(/j_offset_lower,j_offset_upper/) /) 
    1558    !------------------------------------------------------------------- 
    1559    !> @code 
    1560    FUNCTION grid_get_fine_offset( dd_lon0, dd_lat0, & 
    1561    &                              id_imin0, id_jmin0, id_imax0, id_jmax0, & 
    1562    &                              dd_lon1, dd_lat1, id_rho ) 
     3587   !> - November, 2013 - Initial Version 
     3588   !> @date September, 2014 - rename from grid_get_fine_offset 
     3589   ! 
     3590   !> @param[in] dd_lon0   coarse grid longitude array  
     3591   !> @param[in] dd_lat0   coarse grid latitude  array 
     3592   !> @param[in] id_imin0  coarse grid lower left corner i-indice of fine grid domain 
     3593   !> @param[in] id_jmin0  coarse grid lower left corner j-indice of fine grid domain 
     3594   !> @param[in] id_imax0  coarse grid upper right corner i-indice of fine grid domain 
     3595   !> @param[in] id_jmax0  coarse grid upper right corner j-indice of fine grid domain 
     3596   !> @param[in] dd_lon1   fine   grid longitude array  
     3597   !> @param[in] dd_lat1   fine   grid latitude  array 
     3598   !> @param[in] id_rho    array of refinement factor 
     3599   !> @return offset array (/ (/i_offset_left,i_offset_right/),(/j_offset_lower,j_offset_upper/) /) 
     3600   !------------------------------------------------------------------- 
     3601   FUNCTION grid__get_fine_offset_cc( dd_lon0, dd_lat0, & 
     3602   &                                  id_imin0, id_jmin0, id_imax0, id_jmax0, & 
     3603   &                                  dd_lon1, dd_lat1, id_rho ) 
    15633604      IMPLICIT NONE 
    15643605      ! Argument 
     
    15763617 
    15773618      ! function 
    1578       INTEGER(i4), DIMENSION(2,2) :: grid_get_fine_offset 
     3619      INTEGER(i4), DIMENSION(2,2) :: grid__get_fine_offset_cc 
    15793620 
    15803621      ! local variable 
     
    15843625      REAL(dp)   , DIMENSION(:,:), ALLOCATABLE :: dl_lon1 
    15853626       
    1586       REAL(dp) :: dl_dlon 
    1587       REAL(dp) :: dl_dlat 
    1588  
    15893627      ! loop indices 
    15903628      INTEGER(i4) :: ji 
     
    16163654      WHERE( dd_lon1(:,:) < 0 ) dl_lon1(:,:)=dd_lon1(:,:)+360.          
    16173655 
    1618       grid_get_fine_offset(:,:)=-1 
    1619  
    1620       ! look for i-direction left offset  
    1621       IF( dl_lon1(1,1) < dl_lon0(id_imin0+1,id_jmin0) )THEN 
    1622          DO ji=1,id_rho(jp_I)+2 
    1623             dl_dlon=ABS(dl_lon1(ji+1,1)-dl_lon1(ji,1))*1.e-3 
    1624             IF( dl_lon1(ji,1) > dl_lon0(id_imin0+1,id_jmin0) + dl_dlon )THEN 
    1625                grid_get_fine_offset(1,1)=(id_rho(jp_I)+1)-ji+MOD(id_rho(jp_I),2) 
    1626                EXIT 
    1627             ENDIF 
    1628          ENDDO 
     3656      ! init 
     3657      grid__get_fine_offset_cc(:,:)=-1 
     3658 
     3659      IF( il_shape1(1) > 1 )THEN 
     3660 
     3661         ! look for i-direction left offset  
     3662         IF( dl_lon1(1,1) < dl_lon0(id_imin0+1,id_jmin0) )THEN 
     3663            DO ji=1,id_rho(jp_I)+2 
     3664               IF( dl_lon1(ji,1) > dl_lon0(id_imin0+1,id_jmin0) - dp_delta )THEN 
     3665                  grid__get_fine_offset_cc(1,1)=(id_rho(jp_I)+1)-ji 
     3666                  EXIT 
     3667               ENDIF 
     3668            ENDDO 
     3669         ELSE 
     3670            CALL logger_error("GRID GET FINE OFFSET: coarse grid indices do "//& 
     3671            &                 " not match fine grid lower left corner.") 
     3672         ENDIF 
     3673 
     3674         ! look for i-direction right offset 
     3675         IF( dl_lon1(il_shape1(1),1) > dl_lon0(id_imax0-1,id_jmin0) )THEN 
     3676            DO ji=1,id_rho(jp_I)+2 
     3677               ii=il_shape1(1)-ji+1 
     3678               IF( dl_lon1(ii,1) < dl_lon0(id_imax0-1,id_jmin0) + dp_delta )THEN 
     3679                  grid__get_fine_offset_cc(1,2)=(id_rho(jp_I)+1)-ji 
     3680                  EXIT 
     3681               ENDIF 
     3682            ENDDO 
     3683         ELSE 
     3684            CALL logger_error("GRID GET FINE OFFSET: coarse grid indices do "//& 
     3685            &                 " not match fine grid lower right corner.") 
     3686         ENDIF 
     3687 
    16293688      ELSE 
    1630          CALL logger_error("GRID GET FINE OFFSET: coarse grid indices do "//& 
    1631          &                 " not match fine grid lower left corner.") 
    1632       ENDIF 
    1633  
    1634       ! look for i-direction right offset 
    1635       IF( dl_lon1(il_shape1(1),1) > dl_lon0(id_imax0-1,id_jmin0) )THEN 
    1636          DO ji=1,id_rho(jp_I)+2 
    1637             ii=il_shape1(1)-ji+1 
    1638             dl_dlon=ABS(dl_lon1(ii,1)-dl_lon1(ii-1,1))*1.e-3 
    1639             IF( dl_lon1(ii,1) < dl_lon0(id_imax0-1,id_jmin0) - dl_dlon )THEN 
    1640                grid_get_fine_offset(1,2)=(id_rho(jp_I)+1)-ji+MOD(id_rho(jp_I),2) 
    1641                EXIT 
    1642             ENDIF 
    1643          ENDDO 
     3689         grid__get_fine_offset_cc(1,:)=((id_rho(jp_I)-1)/2) 
     3690      ENDIF 
     3691 
     3692      IF( il_shape1(2) > 1 )THEN 
     3693 
     3694         ! look for j-direction lower offset  
     3695         IF( dd_lat1(1,1) < dd_lat0(id_imin0,id_jmin0+1) )THEN 
     3696            DO jj=1,id_rho(jp_J)+2 
     3697               IF( dd_lat1(1,jj) > dd_lat0(id_imin0,id_jmin0+1) - dp_delta )THEN 
     3698                  grid__get_fine_offset_cc(2,1)=(id_rho(jp_J)+1)-jj 
     3699                  EXIT 
     3700               ENDIF 
     3701            ENDDO 
     3702         ELSE 
     3703            CALL logger_error("GRID GET FINE OFFSET: coarse grid indices do "//& 
     3704            &                 " not match fine grid upper left corner.") 
     3705         ENDIF 
     3706 
     3707         ! look for j-direction upper offset  
     3708         IF( dd_lat1(1,il_shape1(2)) > dd_lat0(id_imin0,id_jmax0-1) )THEN 
     3709            DO jj=1,id_rho(jp_J)+2 
     3710               ij=il_shape1(2)-jj+1 
     3711               IF( dd_lat1(1,ij) < dd_lat0(id_imin0,id_jmax0-1) + dp_delta )THEN 
     3712                  grid__get_fine_offset_cc(2,2)=(id_rho(jp_J)+1)-jj 
     3713                  EXIT 
     3714               ENDIF 
     3715            ENDDO 
     3716         ELSE 
     3717            CALL logger_error("GRID GET FINE OFFSET: coarse grid indices do "//& 
     3718            &                 " not match fine grid upper right corner.") 
     3719         ENDIF 
    16443720      ELSE 
    1645          CALL logger_error("GRID GET FINE OFFSET: coarse grid indices do "//& 
    1646          &                 " not match fine grid lower right corner.") 
    1647       ENDIF 
    1648  
    1649       ! look for j-direction lower offset  
    1650       IF( dd_lat1(1,1) < dd_lat0(id_imin0,id_jmin0+1) )THEN 
    1651          DO jj=1,id_rho(jp_J)+2 
    1652             dl_dlat=ABS(dd_lat1(1,jj+1)-dd_lat1(1,jj))*1.e-3 
    1653             IF( dd_lat1(1,jj) > dd_lat0(id_imin0,id_jmin0+1) + dl_dlat )THEN 
    1654                grid_get_fine_offset(2,1)=(id_rho(jp_J)+1)-jj+MOD(id_rho(jp_J),2) 
    1655                EXIT 
    1656             ENDIF 
    1657          ENDDO 
    1658       ELSE 
    1659          CALL logger_error("GRID GET FINE OFFSET: coarse grid indices do "//& 
    1660          &                 " not match fine grid upper left corner.") 
    1661       ENDIF 
    1662  
    1663       ! look for j-direction upper offset  
    1664       IF( dd_lat1(1,il_shape1(2)) > dd_lat0(id_imin0,id_jmax0-1) )THEN 
    1665          DO jj=1,id_rho(jp_J)+2 
    1666             ij=il_shape1(2)-jj+1 
    1667             dl_dlat=ABS(dd_lat1(1,ij)-dd_lat1(1,ij-1))*1.e-3 
    1668             IF( dd_lat1(1,ij) < dd_lat0(id_imin0,id_jmax0-1) - dl_dlat )THEN 
    1669                grid_get_fine_offset(2,2)=(id_rho(jp_J)+1)-jj+MOD(id_rho(jp_J),2) 
    1670                EXIT 
    1671             ENDIF 
    1672          ENDDO 
    1673       ELSE 
    1674          CALL logger_error("GRID GET FINE OFFSET: coarse grid indices do "//& 
    1675          &                 " not match fine grid upper right corner.") 
     3721         grid__get_fine_offset_cc(2,:)=((id_rho(jp_J)-1)/2) 
    16763722      ENDIF 
    16773723 
     
    16793725      DEALLOCATE( dl_lon1 ) 
    16803726 
    1681    END FUNCTION grid_get_fine_offset 
    1682    !> @endcode 
    1683    !------------------------------------------------------------------- 
    1684    !> @brief This function check if ghost cell are used or not, and return ghost 
    1685    !> cell factor (0,1) in i- and j-direction. 
     3727   END FUNCTION grid__get_fine_offset_cc 
     3728   !------------------------------------------------------------------- 
     3729   !> @brief This subroutine check fine and coarse grid coincidence. 
    16863730   ! 
    16873731   !> @details 
    16883732   ! 
    16893733   !> @author J.Paul 
    1690    !> - Nov, 2013- Initial Version 
    1691    ! 
    1692    !> @param[in] td_lon  : grid longitude sturcture  
    1693    !> @param[in] td_lat  : grid latitude  structure 
    1694    !------------------------------------------------------------------- 
    1695    !> @code 
    1696    FUNCTION grid__get_ghost_ll( td_lon, td_lat ) 
    1697       IMPLICIT NONE 
    1698       ! Argument 
    1699       TYPE(TVAR), INTENT(IN) :: td_lon 
    1700       TYPE(TVAR), INTENT(IN) :: td_lat 
    1701  
    1702       ! function 
    1703       INTEGER(i4), DIMENSION(2) :: grid__get_ghost_ll 
    1704  
    1705       ! local variable 
    1706       INTEGER(i4) :: il_ew 
    1707       ! loop indices 
    1708       !---------------------------------------------------------------- 
    1709       ! init 
    1710       grid__get_ghost_ll(:)=0 
    1711  
    1712       IF( grid_is_global(td_lon, td_lat) )THEN 
    1713          grid__get_ghost_ll(:)=0 
    1714       ELSE 
    1715          grid__get_ghost_ll(2)=1 
    1716  
    1717          il_ew=td_lon%i_ew 
    1718          IF( il_ew < 0 )THEN 
    1719             grid__get_ghost_ll(1)=1 
    1720          ELSE 
    1721             grid__get_ghost_ll(1)=0 
    1722          ENDIF 
    1723       ENDIF 
    1724  
    1725    END FUNCTION grid__get_ghost_ll 
    1726    !> @endcode 
    1727    !------------------------------------------------------------------- 
    1728    !> @brief This function check if ghost cell are used or not, and return ghost 
    1729    !> cell factor (0,1) in i- and j-direction. 
    1730    ! 
    1731    !> @details 
    1732    ! 
    1733    !> @author J.Paul 
    1734    !> - Nov, 2013- Initial Version 
    1735    ! 
    1736    !> @param[in] td_file : file sturcture  
    1737    !------------------------------------------------------------------- 
    1738    !> @code 
    1739    FUNCTION grid__get_ghost_f( td_file ) 
    1740       IMPLICIT NONE 
    1741       ! Argument 
    1742       TYPE(TFILE), INTENT(IN) :: td_file 
    1743  
    1744       ! function 
    1745       INTEGER(i4), DIMENSION(2) :: grid__get_ghost_f 
    1746  
    1747       ! local variable 
    1748       TYPE(TVAR)  :: tl_lon 
    1749       TYPE(TVAR)  :: tl_lat 
    1750  
    1751       INTEGER(i4) :: il_lonid 
    1752       INTEGER(i4) :: il_latid 
    1753       ! loop indices 
    1754       INTEGER(i4)  :: ji 
    1755       !---------------------------------------------------------------- 
    1756       ! init 
    1757       grid__get_ghost_f(:)=0 
    1758  
    1759       IF( td_file%i_id == 0 )THEN 
    1760          CALL logger_error("GRID GET GHOST: file "//& 
    1761          &                 TRIM(td_file%c_name)//" not opened." ) 
    1762  
    1763       ELSE 
    1764  
    1765          IF( ASSOCIATED(td_file%t_var) )THEN 
    1766             ! read coarse longitue and latitude 
    1767             il_lonid=var_get_id(td_file%t_var(:),'longitude') 
    1768             il_latid=var_get_id(td_file%t_var(:),'latitude') 
    1769  
    1770             print *,'file ',trim(td_file%c_name),td_file%i_ew 
    1771             DO ji=1,td_file%i_nvar 
    1772                print *,ji,trim(td_file%t_var(ji)%c_name),': ',td_file%t_var(ji)%i_ew 
    1773             ENDDO 
    1774             print *,'lonid ',il_lonid 
    1775             print *,'latid ',il_latid 
    1776             IF( il_lonid /=0 .AND. il_latid /= 0 )THEN 
    1777                tl_lon=iom_read_var(td_file,il_lonid) 
    1778                print *,'lon ',tl_lon%i_ew 
    1779                tl_lat=iom_read_var(td_file,il_latid) 
    1780                print *,'lat ',tl_lat%i_ew 
    1781                ! get ghost cell factor on coarse grid 
    1782                grid__get_ghost_f(:)=grid_get_ghost( tl_lon, tl_lat ) 
    1783             ELSE 
    1784                CALL logger_error("GRID GET GHOST: can not find "//& 
    1785                &           "longitude or latitude "//& 
    1786                &           "in file "//TRIM(td_file%c_name)) 
    1787             ENDIF 
    1788          ELSE 
    1789            CALL logger_error("GRID GET GHOST: no variable "//& 
    1790            &           "associated to file "//TRIM(td_file%c_name)) 
    1791          ENDIF 
    1792  
    1793       ENDIF 
    1794  
    1795    END FUNCTION grid__get_ghost_f 
    1796    !> @endcode 
    1797    !------------------------------------------------------------------- 
    1798    !> @brief This subroutine check fine and coarse grid coincidence 
    1799    ! 
    1800    !> @details 
    1801    ! 
    1802    !> @author J.Paul 
    1803    !> - Nov, 2013- Initial Version 
    1804    ! 
    1805    !> @param[in] td_coord0 : coarse grid coordinate file structure  
    1806    !> @param[in] td_coord1 : fine   grid coordinate file structure  
    1807    !> @param[in] id_imin0 : coarse grid lower left  corner i-indice of fine grid domain  
    1808    !> @param[in] id_imax0 : coarse grid upper right corner i-indice of fine grid domain 
    1809    !> @param[in] id_jmin0 : coarse grid lower left  corner j-indice of fine grid domain  
    1810    !> @param[in] id_jmax0 : coarse grid upper right corner j-indice of fine grid domain   
    1811    !> @param[in] id_rho   : table of refinement factor  
    1812    !------------------------------------------------------------------- 
    1813    !> @code 
     3734   !> - November, 2013- Initial Version 
     3735   !> @date October, 2014 
     3736   !> - work on mpp file structure instead of file structure 
     3737   ! 
     3738   !> @param[in] td_coord0 coarse grid coordinate file structure  
     3739   !> @param[in] td_coord1 fine   grid coordinate file structure  
     3740   !> @param[in] id_imin0  coarse grid lower left  corner i-indice of fine grid domain  
     3741   !> @param[in] id_imax0  coarse grid upper right corner i-indice of fine grid domain 
     3742   !> @param[in] id_jmin0  coarse grid lower left  corner j-indice of fine grid domain  
     3743   !> @param[in] id_jmax0  coarse grid upper right corner j-indice of fine grid domain   
     3744   !> @param[in] id_rho    array of refinement factor (default 1)  
     3745   !------------------------------------------------------------------- 
    18143746   SUBROUTINE grid_check_coincidence( td_coord0, td_coord1, & 
    18153747   &                                  id_imin0, id_imax0, & 
     
    18193751       
    18203752      ! Argument       
    1821       TYPE(TFILE), INTENT(IN) :: td_coord0 
    1822       TYPE(TFILE), INTENT(IN) :: td_coord1 
    1823       INTEGER(i4), INTENT(IN) :: id_imin0 
    1824       INTEGER(i4), INTENT(IN) :: id_imax0 
    1825       INTEGER(i4), INTENT(IN) :: id_jmin0 
    1826       INTEGER(i4), INTENT(IN) :: id_jmax0 
     3753      TYPE(TMPP)               , INTENT(IN) :: td_coord0 
     3754      TYPE(TMPP)               , INTENT(IN) :: td_coord1 
     3755      INTEGER(i4)              , INTENT(IN) :: id_imin0 
     3756      INTEGER(i4)              , INTENT(IN) :: id_imax0 
     3757      INTEGER(i4)              , INTENT(IN) :: id_jmin0 
     3758      INTEGER(i4)              , INTENT(IN) :: id_jmax0 
    18273759      INTEGER(i4), DIMENSION(:), INTENT(IN) :: id_rho 
    18283760 
     
    18523784      REAL(dp)    :: dl_lat1p 
    18533785 
    1854       REAL(dp)    :: dl_dlon 
    1855       REAL(dp)    :: dl_dlat 
    1856  
    18573786      LOGICAL     :: ll_coincidence 
    18583787 
     
    18623791      TYPE(TVAR)  :: tl_lat1 
    18633792 
    1864       TYPE(TFILE) :: tl_coord0 
    1865  
    1866       TYPE(TMPP)  :: tl_mppcoord0 
     3793      TYPE(TMPP)  :: tl_coord0 
     3794      TYPE(TMPP)  :: tl_coord1 
    18673795 
    18683796      TYPE(TDOM)  :: tl_dom0 
     
    18753803      ll_coincidence=.TRUE. 
    18763804 
    1877       ! read coarse longitue and latitude on domain 
    1878       tl_coord0=td_coord0 
    1879       CALL iom_open(tl_coord0) 
    1880  
    1881       !2-1 compute domain 
     3805      ! copy structure 
     3806      tl_coord0=mpp_copy(td_coord0) 
     3807 
     3808      ! compute domain 
    18823809      tl_dom0=dom_init( tl_coord0,         & 
    18833810      &                 id_imin0, id_imax0,& 
    18843811      &                 id_jmin0, id_jmax0 ) 
    18853812 
    1886       !2-2 close file 
    1887       CALL iom_close(tl_coord0) 
    1888  
    1889       !2-3 read variables on domain (ugly way to do it, have to work on it) 
    1890       !2-3-1 init mpp structure 
    1891       tl_mppcoord0=mpp_init(tl_coord0) 
    1892  
    1893       CALL file_clean(tl_coord0) 
    1894  
    1895       !2-3-2 get processor to be used 
    1896       CALL mpp_get_use( tl_mppcoord0, tl_dom0 ) 
    1897  
    1898       !2-3-3 open mpp files 
    1899       CALL iom_mpp_open(tl_mppcoord0) 
    1900  
    1901       !2-3-4 read variable value on domain 
    1902       tl_lon0=iom_mpp_read_var(tl_mppcoord0,'longitude',td_dom=tl_dom0) 
    1903       tl_lat0=iom_mpp_read_var(tl_mppcoord0,'latitude' ,td_dom=tl_dom0) 
    1904  
    1905       !2-3-5 close mpp files 
    1906       CALL iom_mpp_close(tl_mppcoord0) 
    1907  
    1908       !2-3-6 clean structure 
    1909       CALL mpp_clean(tl_mppcoord0) 
     3813      ! open mpp files 
     3814      CALL iom_dom_open(tl_coord0, tl_dom0) 
     3815 
     3816      ! read variable value on domain 
     3817      tl_lon0=iom_dom_read_var(tl_coord0,'longitude',tl_dom0) 
     3818      tl_lat0=iom_dom_read_var(tl_coord0,'latitude' ,tl_dom0) 
     3819 
     3820      ! close mpp files 
     3821      CALL iom_dom_close(tl_coord0) 
     3822 
     3823      ! clean structure 
     3824      CALL mpp_clean(tl_coord0) 
     3825      CALL dom_clean(tl_dom0) 
     3826 
     3827      ! copy structure 
     3828      tl_coord1=mpp_copy(td_coord1) 
     3829 
     3830      ! open mpp files 
     3831      CALL iom_mpp_open(tl_coord1) 
    19103832 
    19113833      ! read fine longitue and latitude 
    1912       tl_lon1=iom_read_var(td_coord1,'longitude') 
    1913       tl_lat1=iom_read_var(td_coord1,'latitude') 
     3834      tl_lon1=iom_mpp_read_var(tl_coord1,'longitude') 
     3835      tl_lat1=iom_mpp_read_var(tl_coord1,'latitude') 
    19143836       
     3837      ! close mpp files 
     3838      CALL iom_dom_close(tl_coord1) 
     3839      ! clean structure 
     3840      CALL mpp_clean(tl_coord1) 
     3841 
    19153842      CALL logger_debug("GRID CHECK COINCIDENCE:"//& 
    19163843      &        " fine   grid "//TRIM(td_coord1%c_name) ) 
     
    19183845      &        " coarse grid "//TRIM(td_coord0%c_name) ) 
    19193846 
    1920       !1- check domain 
    1921       !1-1 check global grid 
     3847      ! check domain 
     3848      ! check global grid 
    19223849      IF( .NOT. grid_is_global(tl_lon0, tl_lat0) )THEN 
    19233850         IF( grid_is_global(tl_lon1, tl_lat1) )THEN 
     
    19293856 
    19303857         ELSE 
    1931             !1-2 ew overlap 
    19323858            il_ew1=tl_lon1%i_ew 
    19333859            IF( il_ew1 >= 0 )THEN 
     3860               ! ew overlap 
    19343861 
    19353862               il_ew0=tl_lon0%i_ew 
     
    19403867               ENDIF 
    19413868 
    1942                il_jmin1=1+ig_ghost 
    1943                il_jmax1=tl_lon1%t_dim(2)%i_len-ig_ghost 
     3869               il_jmin1=1+ip_ghost 
     3870               il_jmax1=tl_lon1%t_dim(2)%i_len-ip_ghost 
    19443871 
    19453872               ll_coincidence=grid__check_lat(& 
    19463873               &                     tl_lat0%d_value(1,:,1,1),& 
    1947                &                     tl_lat1%d_value(1,il_jmin1:il_jmax1,1,1),& 
    1948                &                     id_rho(jp_J) ) 
     3874               &                     tl_lat1%d_value(1,il_jmin1:il_jmax1,1,1)) 
    19493875 
    19503876            ELSE 
    1951                !1-3 other case 
    1952                il_imin1=1+ig_ghost 
    1953                il_jmin1=1+ig_ghost 
    1954  
    1955                il_imax1=tl_lon1%t_dim(1)%i_len-ig_ghost 
    1956                il_jmax1=tl_lon1%t_dim(2)%i_len-ig_ghost 
     3877               ! other case 
     3878               il_imin1=1+ip_ghost 
     3879               il_jmin1=1+ip_ghost 
     3880 
     3881               il_imax1=tl_lon1%t_dim(1)%i_len-ip_ghost 
     3882               il_jmax1=tl_lon1%t_dim(2)%i_len-ip_ghost 
    19573883 
    19583884               ll_coincidence=grid__check_corner(& 
     
    19673893 
    19683894            ENDIF 
    1969              
     3895  
    19703896         ENDIF 
    19713897 
     
    19773903      ENDIF 
    19783904  
    1979       !2- check refinement factor 
     3905      ! check refinement factor 
    19803906      ! select point in middle of fine grid 
    19813907      il_imid1=INT(tl_lon1%t_dim(1)%i_len*0.5) 
    19823908      il_jmid1=INT(tl_lon1%t_dim(2)%i_len*0.5) 
    1983        
     3909  
    19843910      dl_lon1=tl_lon1%d_value(il_imid1, il_jmid1,1,1) 
    19853911      dl_lat1=tl_lat1%d_value(il_imid1, il_jmid1,1,1) 
     
    20003926      ! look for closest fine grid point from selected coarse grid point 
    20013927      il_iind(:)=MAXLOC( tl_lon1%d_value(:,:,1,1), & 
    2002       &                  tl_lon1%d_value(:,:,1,1) <= dl_lon0) 
     3928      &                  tl_lon1%d_value(:,:,1,1) <= dl_lon0 ) 
    20033929 
    20043930      il_jind(:)=MAXLOC( tl_lat1%d_value(:,:,1,1), & 
     
    20163942      dl_lat1=tl_lat1%d_value(il_indF(1),il_indF(2),1,1) 
    20173943 
    2018       !2-1 check i-direction refinement factor 
     3944      ! check i-direction refinement factor 
    20193945      DO ji=1,MIN(3,il_imid1) 
    20203946 
    20213947         IF( il_indF(1)+ji*id_rho(jp_I)+1 > tl_lon1%t_dim(1)%i_len )THEN 
    2022             CALL logger_debug("GRID CHECK COINCIDENCE: tl_lon1%t_dim(1)%i_len "//TRIM(fct_str(tl_lon1%t_dim(1)%i_len))) 
    2023             CALL logger_debug("GRID CHECK COINCIDENCE: il_indF(1)+ji*id_rhoi+1 "//TRIM(fct_str(il_indF(1)+ji*id_rho(jp_I)+1))) 
    2024             CALL logger_debug("GRID CHECK COINCIDENCE: il_indF(1) "//TRIM(fct_str(il_indF(1)))) 
    2025             CALL logger_debug("GRID CHECK COINCIDENCE: id_rhoi "//TRIM(fct_str(id_rho(jp_I)))) 
    20263948            CALL logger_warn("GRID CHECK COINCIDENCE: domain to small "//& 
    20273949            &  " to check i-direction refinement factor ") 
     
    20323954 
    20333955            dl_lon1p=tl_lon1%d_value(il_indF(1)+ji*id_rho(jp_I)+1,il_indF(2),1,1) 
    2034  
    2035             dl_dlon=ABS(dl_lon1p-dl_lon1)*1.e-3 
    20363956 
    20373957            SELECT CASE(MOD(id_rho(jp_I),2)) 
     
    20493969            CASE DEFAULT          
    20503970             
    2051                IF( ABS(dl_lon1 - dl_lon0) > dl_dlon )THEN 
     3971               IF( ABS(dl_lon1 - dl_lon0) > dp_delta )THEN 
    20523972                  ll_coincidence=.FALSE. 
    20533973                  CALL logger_debug("GRID CHECK COINCIDENCE: invalid "//& 
     
    20623982      ENDDO 
    20633983 
    2064       !2-2 check j-direction refinement factor 
     3984      ! check j-direction refinement factor 
    20653985      DO jj=1,MIN(3,il_jmid1) 
    20663986 
     
    20743994 
    20753995            dl_lat1p=tl_lat1%d_value(il_indF(1),il_indF(2)+jj*id_rho(jp_J)+1,1,1) 
    2076  
    2077             dl_dlat=ABS(dl_lat1p-dl_lat1)*1.e-3 
    20783996 
    20793997            SELECT CASE(MOD(id_rho(jp_J),2)) 
     
    20914009            CASE DEFAULT 
    20924010 
    2093                IF( ABS(dl_lat1-dl_lat0) > dl_dlat )THEN 
     4011               IF( ABS(dl_lat1-dl_lat0) > dp_delta )THEN 
    20944012                  ll_coincidence=.FALSE. 
    20954013                  CALL logger_debug("GRID CHECK COINCIDENCE: invalid "//& 
     
    21044022      ENDDO 
    21054023 
     4024      ! clean  
     4025      CALL var_clean(tl_lon1) 
     4026      CALL var_clean(tl_lat1) 
     4027      CALL var_clean(tl_lon0) 
     4028      CALL var_clean(tl_lat0) 
     4029 
    21064030      IF( .NOT. ll_coincidence )THEN 
    21074031         CALL logger_fatal("GRID CHECK COINCIDENCE: no coincidence "//& 
     
    21114035 
    21124036   END SUBROUTINE grid_check_coincidence 
    2113    !> @endcode 
    21144037   !------------------------------------------------------------------- 
    21154038   !> @brief This function check that fine grid is  
     
    21184041   !> @details 
    21194042   !>  
    2120    !> @note deltalon and delatlat are used only to avoid issue due to  
    2121    !> cubic interpolation approximation on the firsts grid points   
    2122    ! 
    21234043   !> @author J.Paul 
    2124    !> - Nov, 2013- Initial Version 
    2125    ! 
    2126    !> @param[in] dd_lon0 : table of coarse grid longitude 
    2127    !> @param[in] dd_lat0 : table of coarse grid latitude 
    2128    !> @param[in] dd_lon1 : table of fine   grid longitude  
    2129    !> @param[in] dd_lat1 : table of fine   grid latitude 
     4044   !> - November, 2013- Initial Version 
     4045   ! 
     4046   !> @param[in] dd_lon0   array of coarse grid longitude 
     4047   !> @param[in] dd_lat0   array of coarse grid latitude 
     4048   !> @param[in] dd_lon1   array of fine   grid longitude  
     4049   !> @param[in] dd_lat1   array of fine   grid latitude 
    21304050   !> @return logical, fine grid is inside coarse grid 
    21314051   !------------------------------------------------------------------- 
    2132    !> @code 
    21334052   FUNCTION grid__check_corner(dd_lon0, dd_lat0, & 
    21344053   &                           dd_lon1, dd_lat1 ) 
     
    21624081      REAL(dp)    :: dl_lon1 
    21634082      REAL(dp)    :: dl_lat1 
    2164  
    2165       REAL(dp)    :: dl_dlon 
    2166       REAL(dp)    :: dl_dlat 
    21674083      ! loop indices 
    21684084      !---------------------------------------------------------------- 
     
    21824098 
    21834099      ! check lower left corner 
    2184       dl_lon0 = dd_lon0(il_imin0, il_jmin0  ) 
    2185       dl_lat0 = dd_lat0(il_imin0, il_jmin0  ) 
     4100      dl_lon0 = dd_lon0(il_imin0, il_jmin0) 
     4101      dl_lat0 = dd_lat0(il_imin0, il_jmin0) 
    21864102 
    21874103      dl_lon1 = dd_lon1(il_imin1, il_jmin1) 
    21884104      dl_lat1 = dd_lat1(il_imin1, il_jmin1) 
    21894105 
    2190       dl_dlon=ABS(dd_lon1(il_imin1+1,il_jmin1  )-dl_lon1)*1.e-3 
    2191       dl_dlat=ABS(dd_lat1(il_imin1  ,il_jmin1+1)-dl_lat1)*1.e-3 
    2192  
    2193       IF( (ABS(dl_lon1-dl_lon0)>dl_dlon) .AND. (dl_lon1 < dl_lon0 ) .OR. &  
    2194       &   (ABS(dl_lat1-dl_lat0)>dl_dlat) .AND. (dl_lat1 < dl_lat0 ) )THEN 
     4106 
     4107      IF( (ABS(dl_lon1-dl_lon0)>dp_delta) .AND. (dl_lon1 < dl_lon0 ) .OR. &  
     4108      &   (ABS(dl_lat1-dl_lat0)>dp_delta) .AND. (dl_lat1 < dl_lat0 ) )THEN 
    21954109 
    21964110         CALL logger_error("GRID CHECK COINCIDENCE: fine grid lower left "//& 
     
    22074121 
    22084122      ! check upper left corner 
    2209       dl_lon0 = dd_lon0(il_imin0, il_jmax0  ) 
    2210       dl_lat0 = dd_lat0(il_imin0, il_jmax0  ) 
     4123      dl_lon0 = dd_lon0(il_imin0, il_jmax0) 
     4124      dl_lat0 = dd_lat0(il_imin0, il_jmax0) 
    22114125 
    22124126      dl_lon1 = dd_lon1(il_imin1, il_jmax1) 
    22134127      dl_lat1 = dd_lat1(il_imin1, il_jmax1) 
    22144128 
    2215       dl_dlon=ABS(dd_lon1(il_imin1+1,il_jmax1  )-dl_lon1)*1.e-3 
    2216       dl_dlat=ABS(dd_lat1(il_imin1  ,il_jmax1-1)-dl_lat1)*1.e-3 
    2217  
    2218       IF( (ABS(dl_lon1-dl_lon0)>dl_dlon) .AND. (dl_lon1 < dl_lon0) .OR. & 
    2219       &   (ABS(dl_lat1-dl_lat0)>dl_dlat) .AND. (dl_lat1 > dl_lat0) )THEN 
     4129 
     4130      IF( (ABS(dl_lon1-dl_lon0)>dp_delta) .AND. (dl_lon1 < dl_lon0) .OR. & 
     4131      &   (ABS(dl_lat1-dl_lat0)>dp_delta) .AND. (dl_lat1 > dl_lat0) )THEN 
    22204132 
    22214133         CALL logger_error("GRID CHECK COINCIDENCE: fine grid upper left "//& 
     
    22324144 
    22334145      ! check lower right corner 
    2234       dl_lon0 = dd_lon0(il_imax0, il_jmin0  ) 
    2235       dl_lat0 = dd_lat0(il_imax0, il_jmin0  ) 
     4146      dl_lon0 = dd_lon0(il_imax0, il_jmin0) 
     4147      dl_lat0 = dd_lat0(il_imax0, il_jmin0) 
    22364148 
    22374149      dl_lon1 = dd_lon1(il_imax1, il_jmin1) 
    22384150      dl_lat1 = dd_lat1(il_imax1, il_jmin1) 
    22394151 
    2240       dl_dlon=ABS(dd_lon1(il_imax1-1,il_jmin1  )-dl_lon1)*1.e-3 
    2241       dl_dlat=ABS(dd_lat1(il_imax1  ,il_jmin1+1)-dl_lat1)*1.e-3 
    2242  
    2243       IF( (ABS(dl_lon1-dl_lon0)>dl_dlon) .AND. (dl_lon1 > dl_lon0) .OR. & 
    2244       &   (ABS(dl_lat1-dl_lat0)>dl_dlat) .AND. (dl_lat1 < dl_lat0) )THEN 
     4152 
     4153      IF( (ABS(dl_lon1-dl_lon0)>dp_delta) .AND. (dl_lon1 > dl_lon0) .OR. & 
     4154      &   (ABS(dl_lat1-dl_lat0)>dp_delta) .AND. (dl_lat1 < dl_lat0) )THEN 
    22454155 
    22464156         CALL logger_error("GRID CHECK COINCIDENCE: fine grid lower right "//& 
    2247          &     "corner not north west west of coarse grid (imax,jmin) ") 
     4157         &     "corner not north west of coarse grid (imax,jmin) ") 
    22484158         CALL logger_debug(" fine   grid lower right ( "//& 
    22494159         &              TRIM(fct_str(dl_lon1))//","//& 
     
    22574167 
    22584168      ! check upper right corner 
    2259       dl_lon0 = dd_lon0(il_imax0, il_jmax0  ) 
    2260       dl_lat0 = dd_lat0(il_imax0, il_jmax0  ) 
     4169      dl_lon0 = dd_lon0(il_imax0, il_jmax0) 
     4170      dl_lat0 = dd_lat0(il_imax0, il_jmax0) 
    22614171 
    22624172      dl_lon1 = dd_lon1(il_imax1, il_jmax1) 
    22634173      dl_lat1 = dd_lat1(il_imax1, il_jmax1) 
    22644174 
    2265       dl_dlon=ABS(dd_lon1(il_imax1-1,il_jmax1  )-dl_lon1)*1.e-3 
    2266       dl_dlat=ABS(dd_lat1(il_imax1  ,il_jmax1-1)-dl_lat1)*1.e-3 
    2267  
    2268       IF( (ABS(dl_lon1-dl_lon0)>dl_dlon) .AND. (dl_lon1 > dl_lon0) .OR. & 
    2269       &   (ABS(dl_lat1-dl_lat0)>dl_dlat) .AND. (dl_lat1 > dl_lat0) )THEN 
     4175      IF( (ABS(dl_lon1-dl_lon0)>dp_delta) .AND. (dl_lon1 > dl_lon0) .OR. & 
     4176      &   (ABS(dl_lat1-dl_lat0)>dp_delta) .AND. (dl_lat1 > dl_lat0) )THEN 
    22704177 
    22714178         CALL logger_error("GRID CHECK COINCIDENCE: fine grid upper right "//& 
     
    22884195 
    22894196   END FUNCTION grid__check_corner 
    2290    !> @endcode 
    22914197   !------------------------------------------------------------------- 
    22924198   !> @brief This function check that fine grid latitude are  
     
    22964202   ! 
    22974203   !> @author J.Paul 
    2298    !> - Nov, 2013- Initial Version 
    2299    ! 
    2300    !> @param[in] dd_lat0 : table of coarse grid latitude  
    2301    !> @param[in] dd_lat1 : table of fine grid latitude  
    2302    !------------------------------------------------------------------- 
    2303    !> @code 
    2304    FUNCTION grid__check_lat(dd_lat0, dd_lat1, id_rhoj) 
     4204   !> - November, 2013- Initial Version 
     4205   ! 
     4206   !> @param[in] dd_lat0   array of coarse grid latitude  
     4207   !> @param[in] dd_lat1   array of fine grid latitude  
     4208   !------------------------------------------------------------------- 
     4209   FUNCTION grid__check_lat(dd_lat0, dd_lat1) 
    23054210      IMPLICIT NONE 
    23064211      ! Argument  
    23074212      REAL(dp), DIMENSION(:), INTENT(IN) :: dd_lat0 
    23084213      REAL(dp), DIMENSION(:), INTENT(IN) :: dd_lat1 
    2309       INTEGER(i4)           , INTENT(IN) :: id_rhoj 
    23104214 
    23114215      ! function 
     
    23214225      INTEGER(i4) :: il_jmin1 
    23224226      INTEGER(i4) :: il_jmax1 
    2323  
    2324       REAL(dp)    :: dl_dlat 
    23254227      ! loop indices 
    23264228      !---------------------------------------------------------------- 
     
    23334235 
    23344236      !1- check if fine grid inside coarse grid domain 
    2335       il_jmin0=1+1 ; il_jmax0=il_shape0(1)-1 
    2336  
    2337       il_jmin1=1+id_rhoj ; il_jmax1=il_shape1(1)-id_rhoj 
    2338  
    2339       dl_dlat=ABS(dd_lat1(il_jmin1+1)-dd_lat1(il_jmin1))*1.e-3 
     4237      il_jmin0=1 ; il_jmax0=il_shape0(1) 
     4238      il_jmin1=1 ; il_jmax1=il_shape1(1) 
    23404239 
    23414240      ! check lower left fine grid 
    2342       IF( ABS(dd_lat1(il_jmin1)-dd_lat0(il_jmin0)) > dl_dlat .AND. & 
     4241      IF( ABS(dd_lat1(il_jmin1)-dd_lat0(il_jmin0)) > dp_delta .AND. & 
    23434242      &   dd_lat1(il_jmin1) < dd_lat0(il_jmin0) )THEN 
    23444243 
     
    23534252      ENDIF 
    23544253 
    2355       dl_dlat=ABS(dd_lat1(il_jmax1-1)-dd_lat1(il_jmax1))*1.e-3 
    2356  
    23574254      ! check upper left fine grid 
    2358       IF( ABS(dd_lat1(il_jmax1)-dd_lat0(il_jmax0)) > dl_dlat .AND. & 
     4255      IF( ABS(dd_lat1(il_jmax1)-dd_lat0(il_jmax0)) > dp_delta .AND. & 
    23594256      &   dd_lat1(il_jmax1) > dd_lat0(il_jmax0) )THEN 
    23604257 
     
    23704267       
    23714268   END FUNCTION grid__check_lat 
    2372    !> @endcode 
    23734269   !------------------------------------------------------------------- 
    23744270   !> @brief 
     
    23764272   !>  
    23774273   !> @author J.Paul 
    2378    !> - Nov, 2013-Initial version 
    2379    ! 
    2380    !> @param[inout] td_var : table of variable structure  
    2381    !> @param[in] id_ighost : i-direction ghost cell factor  
    2382    !> @param[in] id_jghost : j-direction ghost cell factor  
    2383    !------------------------------------------------------------------- 
    2384    !> @code 
    2385    SUBROUTINE grid_add_ghost(td_var, id_ighost, id_jghost) 
     4274   !> - November, 2013-Initial version 
     4275   ! 
     4276   !> @param[inout] td_var array of variable structure  
     4277   !> @param[in] id_ghost  array of ghost cell factor  
     4278   !------------------------------------------------------------------- 
     4279   SUBROUTINE grid_add_ghost(td_var, id_ghost) 
    23864280      IMPLICIT NONE 
    23874281      ! Argument 
    2388       TYPE(TVAR) , INTENT(INOUT) :: td_var 
    2389       INTEGER(i4), INTENT(IN   ) :: id_ighost 
    2390       INTEGER(i4), INTENT(IN   ) :: id_jghost 
     4282      TYPE(TVAR) ,                 INTENT(INOUT) :: td_var 
     4283      INTEGER(i4), DIMENSION(2,2), INTENT(IN   ) :: id_ghost 
    23914284 
    23924285      ! local variable 
     
    24094302 
    24104303         ! copy variable 
    2411          tl_var=td_var 
     4304         tl_var=var_copy(td_var) 
    24124305 
    24134306         CALL var_del_value(td_var) 
    24144307 
    24154308         ! compute indice to fill center 
    2416          il_imin=1+id_ighost*ig_ghost 
    2417          il_jmin=1+id_jghost*ig_ghost 
    2418  
    2419          il_imax=il_imin+tl_var%t_dim(1)%i_len-1 
    2420          il_jmax=il_jmin+tl_var%t_dim(2)%i_len-1 
     4309         il_imin=1+id_ghost(jp_I,1)*ip_ghost 
     4310         il_jmin=1+id_ghost(jp_J,1)*ip_ghost 
     4311 
     4312         il_imax=tl_var%t_dim(1)%i_len+id_ghost(jp_I,1)*ip_ghost 
     4313         il_jmax=tl_var%t_dim(2)%i_len+id_ghost(jp_J,1)*ip_ghost 
    24214314 
    24224315         ! compute new dimension 
    2423          td_var%t_dim(1)%i_len = tl_var%t_dim(1)%i_len + 2*id_ighost*ig_ghost 
    2424          td_var%t_dim(2)%i_len = tl_var%t_dim(2)%i_len + 2*id_jghost*ig_ghost 
     4316         td_var%t_dim(1)%i_len = tl_var%t_dim(1)%i_len + & 
     4317         &                             SUM(id_ghost(jp_I,:))*ip_ghost 
     4318         td_var%t_dim(2)%i_len = tl_var%t_dim(2)%i_len + & 
     4319         &                             SUM(id_ghost(jp_J,:))*ip_ghost 
    24254320 
    24264321         ALLOCATE(dl_value(td_var%t_dim(1)%i_len, & 
     
    24484343 
    24494344   END SUBROUTINE grid_add_ghost 
    2450    !> @endcode 
    24514345   !------------------------------------------------------------------- 
    24524346   !> @brief 
     
    24544348   !>  
    24554349   !> @author J.Paul 
    2456    !> - Nov, 2013-Initial version 
    2457    ! 
    2458    !> @param[inout] td_var : table of variable structure  
    2459    !> @param[in] id_ighost : i-direction ghost cell factor  
    2460    !> @param[in] id_jghost : j-direction ghost cell factor  
    2461    !------------------------------------------------------------------- 
    2462    !> @code 
    2463    SUBROUTINE grid_del_ghost(td_var, id_ighost, id_jghost) 
     4350   !> - November, 2013-Initial version 
     4351   ! 
     4352   !> @param[inout] td_var array of variable structure  
     4353   !> @param[in] id_ghost  array of ghost cell factor  
     4354   !------------------------------------------------------------------- 
     4355   SUBROUTINE grid_del_ghost(td_var, id_ghost) 
    24644356      IMPLICIT NONE 
    24654357      ! Argument 
    2466       TYPE(TVAR) , INTENT(INOUT) :: td_var 
    2467       INTEGER(i4), INTENT(IN   ) :: id_ighost 
    2468       INTEGER(i4), INTENT(IN   ) :: id_jghost 
     4358      TYPE(TVAR) ,                 INTENT(INOUT) :: td_var 
     4359      INTEGER(i4), DIMENSION(2,2), INTENT(IN   ) :: id_ghost 
    24694360 
    24704361      ! local variable 
     
    24834374      IF( ALL(td_var%t_dim(1:2)%l_use) )THEN 
    24844375 
    2485          CALL logger_warn( "DEL GHOST: dimension change in variable "//& 
     4376         CALL logger_warn( "GRID DEL GHOST: dimension change in variable "//& 
    24864377         &              TRIM(td_var%c_name) ) 
    24874378 
    24884379         ! copy variable 
    2489          tl_var=td_var 
     4380         tl_var=var_copy(td_var) 
    24904381 
    24914382         CALL var_del_value(td_var) 
    24924383 
    24934384         ! compute indice to get center 
    2494          il_imin=1+id_ighost*ig_ghost 
    2495          il_jmin=1+id_jghost*ig_ghost 
    2496  
    2497          il_imax=tl_var%t_dim(1)%i_len-id_ighost*ig_ghost 
    2498          il_jmax=tl_var%t_dim(2)%i_len-id_jghost*ig_ghost 
     4385         il_imin=1+id_ghost(jp_I,1)*ip_ghost 
     4386         il_jmin=1+id_ghost(jp_J,1)*ip_ghost 
     4387 
     4388         il_imax=tl_var%t_dim(1)%i_len-id_ghost(jp_I,2)*ip_ghost 
     4389         il_jmax=tl_var%t_dim(2)%i_len-id_ghost(jp_J,2)*ip_ghost 
    24994390 
    25004391         ! compute new dimension 
    2501          td_var%t_dim(1)%i_len = tl_var%t_dim(1)%i_len - 2*id_ighost*ig_ghost 
    2502          td_var%t_dim(2)%i_len = tl_var%t_dim(2)%i_len - 2*id_jghost*ig_ghost 
     4392         td_var%t_dim(1)%i_len = il_imax - il_imin +1  
     4393         td_var%t_dim(2)%i_len = il_jmax - il_jmin +1  
    25034394 
    25044395         ALLOCATE(dl_value(td_var%t_dim(1)%i_len, & 
     
    25264417 
    25274418   END SUBROUTINE grid_del_ghost 
    2528    !> @endcode 
    2529    !------------------------------------------------------------------- 
    2530    !> @brief This subroutine fill small closed sea with fill value.  
     4419   !------------------------------------------------------------------- 
     4420   !> @brief This function check if ghost cell are used or not, and return ghost 
     4421   !> cell factor (0,1) in horizontal plan. 
    25314422   ! 
    25324423   !> @details 
    2533    !> the minimum size (nbumber of point) of closed sea to be kept could be 
    2534    !> sepcify with id_minsize. 
    2535    !> By default only the biggest sea is preserve. 
    2536    ! 
     4424   !> check if domain is global, and if there is an East-West overlap. 
     4425   !> 
    25374426   !> @author J.Paul 
    2538    !> - Nov, 2013- Initial Version 
    2539    ! 
    2540    !> @param[inout] td_var : variable structure 
    2541    !> @param[in] id_mask : domain mask (from grid_split_domain) 
    2542    !> @param[in] id_minsize : minimum size of sea to be kept 
    2543    !------------------------------------------------------------------- 
    2544    !> @code 
    2545    SUBROUTINE grid_fill_small_dom(td_var, id_mask, id_minsize) 
     4427   !> - September, 2014- Initial Version 
     4428   ! 
     4429   !> @param[in] td_var variable sturcture  
     4430   !> @return array of ghost cell factor 
     4431   !------------------------------------------------------------------- 
     4432   FUNCTION grid__get_ghost_var( td_var ) 
    25464433      IMPLICIT NONE 
    2547       ! Argument       
    2548       TYPE(TVAR) ,                 INTENT(INOUT) :: td_var 
    2549       INTEGER(i4), DIMENSION(:,:), INTENT(IN   ), OPTIONAL :: id_mask 
    2550       INTEGER(i4),                 INTENT(IN   ), OPTIONAL :: id_minsize 
     4434      ! Argument 
     4435      TYPE(TVAR), INTENT(IN) :: td_var 
     4436 
     4437      ! function 
     4438      INTEGER(i4), DIMENSION(2,2) :: grid__get_ghost_var 
    25514439 
    25524440      ! local variable 
    2553       INTEGER(i4)                              :: il_ndom 
    2554       INTEGER(i4)                              :: il_minsize 
    2555       INTEGER(i4), DIMENSION(2)                :: il_shape 
    2556       INTEGER(i4), DIMENSION(:,:), ALLOCATABLE :: il_tmp 
     4441      INTEGER(i4), DIMENSION(ip_maxdim) :: il_dim 
    25574442 
    25584443      ! loop indices 
    2559       INTEGER(i4) :: ji 
    2560       INTEGER(i4) :: jk 
    2561       INTEGER(i4) :: jl 
    25624444      !---------------------------------------------------------------- 
    2563  
    2564       il_shape(:)=SHAPE(id_mask(:,:)) 
    2565       IF( ANY(il_shape(:) /= td_var%t_dim(1:2)%i_len) )THEN 
    2566          CALL logger_error("GRID FILL SMALL DOM: variable and mask "//& 
    2567          &              "dimension differ") 
     4445      ! init 
     4446      grid__get_ghost_var(:,:)=0 
     4447 
     4448      IF( .NOT. ALL(td_var%t_dim(1:2)%l_use) )THEN 
     4449         CALL logger_error("GRID GET GHOST: "//TRIM(td_var%c_name)//" is not a suitable"//& 
     4450         &                 " variable to look for ghost cell (not 2D).") 
    25684451      ELSE 
    2569  
    2570          il_ndom=MINVAL(id_mask(:,:)) 
    2571  
    2572          ALLOCATE( il_tmp(il_shape(1),il_shape(2)) ) 
    2573          il_tmp(:,:)=0 
    2574          DO ji=-1,il_ndom,-1 
    2575             WHERE( id_mask(:,:)==ji )  
    2576                il_tmp(:,:)=SUM(id_mask(:,:),id_mask(:,:)==ji)/ji 
    2577             END WHERE 
    2578          ENDDO 
    2579  
    2580          il_minsize=MAXVAL(il_tmp(:,:)) 
    2581          IF( PRESENT(id_minsize) ) il_minsize=id_minsize 
    2582  
    2583          DO jl=1,td_var%t_dim(4)%i_len 
    2584             DO jk=1,td_var%t_dim(3)%i_len 
    2585                WHERE( il_tmp(:,:) < il_minsize )  
    2586                   td_var%d_value(:,:,jk,jl)=td_var%d_fill 
    2587                END WHERE 
    2588             ENDDO 
    2589          ENDDO 
    2590  
    2591          DEALLOCATE( il_tmp ) 
    2592  
    2593       ENDIF 
    2594  
    2595    END SUBROUTINE grid_fill_small_dom 
    2596    !> @endcode 
     4452         IF( .NOT. ASSOCIATED(td_var%d_value) )THEN 
     4453            CALL logger_error("GRID GET GHOST: no value associated to "//TRIM(td_var%c_name)//& 
     4454            &                 ". can't look for ghost cell.") 
     4455         ELSE 
     4456            il_dim(:)=td_var%t_dim(:)%i_len 
     4457 
     4458            IF(ALL(td_var%d_value(    1    ,    :    ,1,1)/=td_var%d_fill).AND.& 
     4459            &  ALL(td_var%d_value(il_dim(1),    :    ,1,1)/=td_var%d_fill).AND.& 
     4460            &  ALL(td_var%d_value(    :    ,    1    ,1,1)/=td_var%d_fill).AND.& 
     4461            &  ALL(td_var%d_value(    :    ,il_dim(2),1,1)/=td_var%d_fill))THEN 
     4462            ! no boundary closed 
     4463               CALL logger_warn("GRID GET GHOST: can't determined ghost cell. "//& 
     4464               &             "there is no boundary closed for variable "//& 
     4465               &              TRIM(td_var%c_name)) 
     4466 
     4467            ELSE 
     4468               ! check periodicity 
     4469               IF(ANY(td_var%d_value(   1     ,:,1,1)/=td_var%d_fill).OR.& 
     4470               &  ANY(td_var%d_value(il_dim(1),:,1,1)/=td_var%d_fill))THEN 
     4471               ! East-West cyclic (1,4,6) 
     4472                  CALL logger_info("GRID GET GHOST: East West cyclic") 
     4473                  grid__get_ghost_var(jp_I,:)=0 
     4474 
     4475                  IF( ANY(td_var%d_value(:, 1, 1, 1) /= td_var%d_fill) )THEN 
     4476                  ! South boundary not closed  
     4477 
     4478                     CALL logger_debug("GRID GET GHOST: East_West cyclic") 
     4479                     CALL logger_debug("GRID GET GHOST: South boundary not closed") 
     4480                     CALL logger_error("GRID GET GHOST: should have been an "//& 
     4481                     &              "impossible case") 
     4482 
     4483                  ELSE 
     4484                  ! South boundary closed (1,4,6) 
     4485                     CALL logger_info("GRID GET GHOST: South boundary closed") 
     4486                     grid__get_ghost_var(jp_J,1)=1 
     4487 
     4488                     IF(ANY(td_var%d_value(:,il_dim(2),1,1)/=td_var%d_fill) )THEN 
     4489                     ! North boundary not closed (4,6) 
     4490                        CALL logger_info("GRID GET GHOST: North boundary not closed") 
     4491                        grid__get_ghost_var(jp_J,2)=0 
     4492                     ELSE 
     4493                     ! North boundary closed 
     4494                        CALL logger_info("GRID GET GHOST: North boundary closed") 
     4495                        grid__get_ghost_var(jp_J,2)=1 
     4496                     ENDIF 
     4497 
     4498                  ENDIF 
     4499 
     4500               ELSE 
     4501               ! East-West boundaries closed (0,2,3,5) 
     4502                  CALL logger_info("GRID GET GHOST: East West boundaries closed") 
     4503                  grid__get_ghost_var(jp_I,:)=1 
     4504 
     4505                  IF( ANY(td_var%d_value(:, 1, 1, 1) /= td_var%d_fill) )THEN 
     4506                  ! South boundary not closed (2) 
     4507                     CALL logger_info("GRID GET GHOST: South boundary not closed") 
     4508                     grid__get_ghost_var(jp_J,1)=0 
     4509 
     4510                     IF(ANY(td_var%d_value(:,il_dim(2),1,1)/=td_var%d_fill))THEN 
     4511                     ! North boundary not closed 
     4512                        CALL logger_debug("GRID GET GHOST: East West boundaries "//& 
     4513                        &              "closed") 
     4514                        CALL logger_debug("GRID GET GHOST: South boundary not closed") 
     4515                        CALL logger_debug("GRID GET GHOST: North boundary not closed") 
     4516                        CALL logger_error("GRID GET GHOST: should have been "//& 
     4517                        &              "an impossible case") 
     4518                     ELSE 
     4519                     ! North boundary closed 
     4520                        grid__get_ghost_var(jp_J,2)=1 
     4521                     ENDIF 
     4522 
     4523                  ELSE 
     4524                  ! South boundary closed (0,3,5) 
     4525                     CALL logger_info("GRID GET GHOST: South boundary closed") 
     4526                     grid__get_ghost_var(jp_J,1)=1 
     4527 
     4528                     IF(ANY(td_var%d_value(:,il_dim(2),1,1)/=td_var%d_fill))THEN 
     4529                     ! North boundary not closed (3,5) 
     4530                        CALL logger_info("GRID GET GHOST: North boundary not closed") 
     4531                        grid__get_ghost_var(jp_J,2)=0 
     4532                     ELSE 
     4533                     ! North boundary closed    
     4534                        CALL logger_info("GRID GET GHOST: North boundary closed") 
     4535                        grid__get_ghost_var(jp_J,2)=1 
     4536                     ENDIF 
     4537 
     4538                  ENDIF 
     4539 
     4540               ENDIF 
     4541 
     4542            ENDIF 
     4543 
     4544         ENDIF 
     4545      ENDIF 
     4546 
     4547   END FUNCTION grid__get_ghost_var 
     4548   !------------------------------------------------------------------- 
     4549   !> @brief This function check if ghost cell are used or not, and return ghost 
     4550   !> cell factor (0,1) in i- and j-direction. 
     4551   ! 
     4552   !> @details 
     4553   !> get longitude an latitude array, then 
     4554   !> check if domain is global, and if there is an East-West overlap 
     4555   !>  
     4556   !> @author J.Paul 
     4557   !> - September, 2014 - Initial Version 
     4558   !> @date October, 2014 
     4559   !> - work on mpp file structure instead of file structure 
     4560   ! 
     4561   !> @param[in] td_file   file sturcture 
     4562   !> @return array of ghost cell factor 
     4563   !------------------------------------------------------------------- 
     4564   FUNCTION grid__get_ghost_mpp( td_mpp ) 
     4565      IMPLICIT NONE 
     4566      ! Argument 
     4567      TYPE(TMPP), INTENT(IN) :: td_mpp 
     4568 
     4569      ! function 
     4570      INTEGER(i4), DIMENSION(2,2) :: grid__get_ghost_mpp 
     4571 
     4572      ! local variable 
     4573      !TYPE(TVAR)  :: tl_lon 
     4574      !TYPE(TVAR)  :: tl_lat 
     4575 
     4576      TYPE(TMPP) :: tl_mpp 
     4577 
     4578      !INTEGER(i4) :: il_lonid 
     4579      !INTEGER(i4) :: il_latid 
     4580      ! loop indices 
     4581      !---------------------------------------------------------------- 
     4582      ! init 
     4583      grid__get_ghost_mpp(:,:)=0 
     4584 
     4585      IF( .NOT. ASSOCIATED(td_mpp%t_proc) )THEN 
     4586         CALL logger_error("GRID GET GHOST: decomposition of mpp file "//& 
     4587         &                 TRIM(td_mpp%c_name)//" not defined." ) 
     4588 
     4589      ELSE 
     4590 
     4591         ! copy structure 
     4592          tl_mpp=mpp_copy(td_mpp) 
     4593 
     4594          IF( tl_mpp%i_perio < 0 )THEN 
     4595             ! compute NEMO periodicity index 
     4596             CALL grid_get_info(tl_mpp) 
     4597          ENDIF 
     4598 
     4599         SELECT CASE(tl_mpp%i_perio) 
     4600            CASE(0) 
     4601               grid__get_ghost_mpp(:,:)=1 
     4602            CASE(1) 
     4603               grid__get_ghost_mpp(jp_J,:)=1 
     4604            CASE(2) 
     4605               grid__get_ghost_mpp(jp_I,:)=1 
     4606               grid__get_ghost_mpp(jp_J,2)=1 
     4607            CASE(3,5) 
     4608               grid__get_ghost_mpp(jp_I,:)=1 
     4609               grid__get_ghost_mpp(jp_J,1)=1 
     4610            CASE(4,6) 
     4611               grid__get_ghost_mpp(jp_J,1)=1 
     4612            CASE DEFAULT 
     4613         END SELECT 
     4614 
     4615         ! clean  
     4616         CALL mpp_clean(tl_mpp) 
     4617 
     4618      ENDIF 
     4619 
     4620   END FUNCTION grid__get_ghost_mpp 
    25974621   !------------------------------------------------------------------- 
    25984622   !> @brief This subroutine compute closed sea domain. 
    25994623   ! 
    26004624   !> @details 
    2601    !> to each domain is associated a negative value id (from -1 to ...) 
    2602    ! 
     4625   !> to each domain is associated a negative value id (from -1 to ...)<br/> 
     4626   !> optionaly you could specify which level use (default 1) 
     4627   !> 
    26034628   !> @author J.Paul 
    2604    !> - Nov, 2013- Initial Version 
    2605    ! 
    2606    !> @param[in] td_var : variable strucutre  
    2607    !> @param[in] id_level : level 
     4629   !> - November, 2013- Initial Version 
     4630   ! 
     4631   !> @param[in] td_var   variable strucutre  
     4632   !> @param[in] id_level level 
    26084633   !> @return domain mask   
    26094634   !------------------------------------------------------------------- 
    2610    !> @code 
    26114635   FUNCTION grid_split_domain(td_var, id_level) 
    26124636      IMPLICIT NONE 
     
    26924716 
    26934717   END FUNCTION grid_split_domain 
    2694    !> @endcode 
    2695 !   !------------------------------------------------------------------- 
    2696 !   !> @brief This function  
    2697 !   ! 
    2698 !   !> @details 
    2699 !   ! 
    2700 !   !> @author J.Paul 
    2701 !   !> - Nov, 2013- Initial Version 
    2702 !   ! 
    2703 !   !> @param[in]  
    2704 !   !------------------------------------------------------------------- 
    2705 !   !> @code 
    2706 !   FUNCTION grid_() 
    2707 !      IMPLICIT NONE 
    2708 !      ! Argument       
    2709 !      ! function 
    2710 !      ! local variable 
    2711 !      ! loop indices 
    2712 !      !---------------------------------------------------------------- 
    2713 ! 
    2714 !   END FUNCTION grid_ 
    2715 !   !> @endcode 
    2716 !   !------------------------------------------------------------------- 
    2717 !   !> @brief This subroutine  
    2718 !   ! 
    2719 !   !> @details 
    2720 !   ! 
    2721 !   !> @author J.Paul 
    2722 !   !> - Nov, 2013- Initial Version 
    2723 !   ! 
    2724 !   !> @param[in]  
    2725 !   !------------------------------------------------------------------- 
    2726 !   !> @code 
    2727 !   SUBROUTINE grid_() 
    2728 !      IMPLICIT NONE 
    2729 !      ! Argument       
    2730 !      ! local variable 
    2731 !      ! loop indices 
    2732 !      !---------------------------------------------------------------- 
    2733 ! 
    2734 !   END SUBROUTINE grid_ 
    2735 !   !> @endcode 
     4718   !------------------------------------------------------------------- 
     4719   !> @brief This subroutine fill small closed sea with fill value.  
     4720   !> 
     4721   !> @details 
     4722   !> the minimum size (nbumber of point) of closed sea to be kept could be 
     4723   !> sepcify with id_minsize. 
     4724   !> By default only the biggest sea is preserve. 
     4725   !> 
     4726   !> @author J.Paul 
     4727   !> - November, 2013- Initial Version 
     4728   !> 
     4729   !> @param[inout] td_var    variable structure 
     4730   !> @param[in] id_mask      domain mask (from grid_split_domain) 
     4731   !> @param[in] id_minsize   minimum size of sea to be kept 
     4732   !------------------------------------------------------------------- 
     4733   SUBROUTINE grid_fill_small_dom(td_var, id_mask, id_minsize) 
     4734      IMPLICIT NONE 
     4735      ! Argument       
     4736      TYPE(TVAR) ,                 INTENT(INOUT) :: td_var 
     4737      INTEGER(i4), DIMENSION(:,:), INTENT(IN   ) :: id_mask 
     4738      INTEGER(i4),                 INTENT(IN   ), OPTIONAL :: id_minsize 
     4739 
     4740      ! local variable 
     4741      INTEGER(i4)                              :: il_ndom 
     4742      INTEGER(i4)                              :: il_minsize 
     4743      INTEGER(i4), DIMENSION(2)                :: il_shape 
     4744      INTEGER(i4), DIMENSION(:,:), ALLOCATABLE :: il_tmp 
     4745 
     4746      ! loop indices 
     4747      INTEGER(i4) :: ji 
     4748      INTEGER(i4) :: jk 
     4749      INTEGER(i4) :: jl 
     4750      !---------------------------------------------------------------- 
     4751 
     4752      il_shape(:)=SHAPE(id_mask(:,:)) 
     4753      IF( ANY(il_shape(:) /= td_var%t_dim(1:2)%i_len) )THEN 
     4754         CALL logger_error("GRID FILL SMALL DOM: variable and mask "//& 
     4755         &              "dimension differ") 
     4756      ELSE 
     4757 
     4758         il_ndom=MINVAL(id_mask(:,:)) 
     4759 
     4760         ALLOCATE( il_tmp(il_shape(1),il_shape(2)) ) 
     4761         il_tmp(:,:)=0 
     4762         DO ji=-1,il_ndom,-1 
     4763            WHERE( id_mask(:,:)==ji )  
     4764               il_tmp(:,:)=SUM(id_mask(:,:),id_mask(:,:)==ji)/ji 
     4765            END WHERE 
     4766         ENDDO 
     4767 
     4768         il_minsize=MAXVAL(il_tmp(:,:)) 
     4769         IF( PRESENT(id_minsize) ) il_minsize=id_minsize 
     4770 
     4771         DO jl=1,td_var%t_dim(4)%i_len 
     4772            DO jk=1,td_var%t_dim(3)%i_len 
     4773               WHERE( il_tmp(:,:) < il_minsize )  
     4774                  td_var%d_value(:,:,jk,jl)=td_var%d_fill 
     4775               END WHERE 
     4776            ENDDO 
     4777         ENDDO 
     4778 
     4779         DEALLOCATE( il_tmp ) 
     4780 
     4781      ENDIF 
     4782 
     4783   END SUBROUTINE grid_fill_small_dom 
    27364784END MODULE grid 
    27374785 
Note: See TracChangeset for help on using the changeset viewer.