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.
grid.f90 in trunk/NEMOGCM/TOOLS/SIREN/src – NEMO

source: trunk/NEMOGCM/TOOLS/SIREN/src/grid.f90 @ 6393

Last change on this file since 6393 was 6393, checked in by jpaul, 8 years ago

commit changes/bugfix/... for SIREN; see ticket #1700

File size: 209.5 KB
Line 
1!----------------------------------------------------------------------
2! NEMO system team, System and Interface for oceanic RElocable Nesting
3!----------------------------------------------------------------------
4!
5! MODULE: grid
6!
7! DESCRIPTION:
8!> @brief This module is grid manager.
9!>
10!> @details
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!>                                 [,dd_fill] [,cd_pos])
84!> @endcode
85!>       - il_index(:) is  coarse grid indices (/ i0, j0 /)
86!>       - dd_lon0 is coarse grid array of longitude value (real(8))
87!>       - dd_lat0 is coarse grid array of latitude  value (real(8))
88!>       - dd_lon1 is fine grid longitude value (real(8))
89!>       - dd_lat1 is fine grid latitude  value (real(8))
90!>       - dd_fill
91!>       - cd_pos
92!>
93!>    to compute distance between a point A and grid points:<br/>
94!> @code
95!>    il_dist(:,:)=grid_distance(dd_lon, dd_lat, dd_lonA, dd_latA)
96!> @endcode
97!>       - il_dist(:,:) is array of distance between point A and grid points
98!>       - dd_lon is array of longitude value (real(8))
99!>       - dd_lat is array of longitude value (real(8))
100!>       - dd_lonA is longitude of point A (real(8))
101!>       - dd_latA is latitude  of point A (real(8))
102!>
103!>    to get offset between fine grid and coarse grid:<br/>
104!> @code
105!>    il_offset(:,:)=grid_get_fine_offset(td_coord0,
106!>                                        id_imin0, id_jmin0, id_imax0, id_jmax0,
107!>                                        td_coord1
108!>                                        [,id_rho] [,cd_point])
109!> @endcode
110!>    or
111!> @code
112!>    il_offset(:,:)=grid_get_fine_offset(dd_lon0, dd_lat0,
113!>                                        id_imin0, id_jmin0,id_imax0, id_jmax0,
114!>                                        td_coord1
115!>                                        [,id_rho] [,cd_point])
116!> @endcode
117!>    or
118!> @code
119!>    il_offset(:,:)=grid_get_fine_offset(td_coord0,
120!>                                        id_imin0, id_jmin0, id_imax0, id_jmax0,
121!>                                        dd_lon1, dd_lat1
122!>                                        [,id_rho] [,cd_point])
123!> @endcode
124!>    or
125!> @code
126!>    il_offset(:,:)=grid_get_fine_offset(dd_lon0, dd_lat0,
127!>                                        id_imin0, id_jmin0, id_imax0, id_jmax0,
128!>                                        dd_lon1, dd_lat1
129!>                                        [,id_rho] [,cd_point])
130!> @endcode
131!>       - il_offset(:,:) is offset array
132!>    (/ (/ i_offset_left, i_offset_right /), (/ j_offset_lower, j_offset_upper /) /)
133!>       - td_coord0 is coarse grid coordinate mpp structure
134!>       - dd_lon0  is coarse grid longitude array (real(8))
135!>       - dd_lat0  is coarse grid latitude  array (real(8))
136!>       - id_imin0 is coarse grid lower left  corner i-indice of fine grid
137!> domain
138!>       - id_jmin0 is coarse grid lower left  corner j-indice of fine grid
139!> domain
140!>       - id_imax0 is coarse grid upper right corner i-indice of fine grid
141!> domain
142!>       - id_jmax0 is coarse grid upper right corner j-indice of fine grid
143!> domain
144!>       - td_coord1 is fine grid coordinate mpp structure
145!>       - dd_lon1  is fine   grid longitude array (real(8))
146!>       - dd_lat1  is fine   grid latitude  array (real(8))
147!>       - id_rho is array of refinment factor (default 1)
148!>       - cd_point is Arakawa grid point (default 'T')
149!>
150!>    to check fine and coarse grid coincidence:<br/>
151!> @code
152!>    CALL grid_check_coincidence(td_coord0, td_coord1,
153!>                                id_imin0, id_imax0, id_jmin0, id_jmax0
154!>                                ,id_rho)
155!> @endcode
156!>       - td_coord0 is coarse grid coordinate mpp structure
157!>       - td_coord1 is fine   grid coordinate mpp structure
158!>       - id_imin0  is coarse grid lower left  corner i-indice of fine grid
159!> domain
160!>       - id_imax0  is coarse grid upper right corner i-indice of fine grid
161!> domain
162!>       - id_jmin0  is coarse grid lower left  corner j-indice of fine grid
163!> domain
164!>       - id_jmax0  is coarse grid upper right corner j-indice of fine grid
165!> domain
166!>       - id_rho    is array of refinement factor
167!>
168!>    to add ghost cell at boundaries:<br/>
169!> @code
170!>    CALL grid_add_ghost(td_var, id_ghost)
171!> @endcode
172!>       - td_var is array of variable structure
173!>       - id_ghost is 2D array of ghost cell factor
174!>
175!>    to delete ghost cell at boundaries:<br/>
176!> @code
177!>    CALL grid_del_ghost(td_var, id_ghost)
178!> @endcode
179!>       - td_var is array of variable structure
180!>       - id_ghost is 2D array of ghost cell factor
181!>
182!>    to get ghost cell factor (use or not):<br/>
183!> @code
184!>    il_factor(:)= grid_get_ghost( td_var )
185!> @endcode
186!>    or
187!> @code
188!>    il_factor(:)= grid_get_ghost( td_mpp )
189!> @endcode
190!>       - il_factor(:) is  array of ghost cell factor (0 or 1)
191!>       - td_var  is variable structure
192!>       - td_mpp is mpp sturcture
193!>
194!>    to compute closed sea domain:<br/>
195!> @code
196!>    il_mask(:,:)=grid_split_domain(td_var, [id_level])
197!> @endcode
198!>       - il_mask(:,:) is domain mask
199!>       - td_var is variable strucutre
200!>       - id_level is level to be used [optional]
201!>
202!>    to fill small closed sea with _FillValue:<br/>
203!> @code
204!>    CALL grid_fill_small_dom(td_var, id_mask, [id_minsize])
205!> @endcode
206!>       - td_var  is variable structure
207!>       - id_mask is domain mask (from grid_split_domain)
208!>       - id_minsize is minimum size of sea to be kept [optional]
209!>
210!> @author
211!> J.Paul
212! REVISION HISTORY:
213!> @date November, 2013 - Initial Version
214!> @date September, 2014
215!> - add header
216!> @date October, 2014
217!> - use mpp file structure instead of file
218!> @date February, 2015
219!> - add function grid_fill_small_msk to fill small domain inside bigger one
220!> @February, 2016
221!> - improve way to check coincidence (bug fix)
222!> - manage grid cases for T,U,V or F point, with even or odd refinment (bug fix)
223!
224!> @note Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
225!----------------------------------------------------------------------
226MODULE grid
227   USE netcdf
228   USE kind                            ! F90 kind parameter
229   USE fct                             ! basic usefull function
230   USE global                          ! global parameter
231   USE phycst                          ! physical constant
232   USE logger                          ! log file manager
233   USE file                            ! file manager
234   USE att                             ! attribute manager
235   USE var                             ! variable manager
236   USE dim                             ! dimension manager
237   USE iom                             ! I/O manager
238   USE mpp                             ! MPP manager
239   USE dom                             ! domain manager
240   USE iom_mpp                         ! MPP I/O manager
241   USE iom_dom                         ! DOM I/O manager
242   IMPLICIT NONE
243   ! NOTE_avoid_public_variables_if_possible
244
245   ! type and variable
246
247   ! function and subroutine
248   PUBLIC :: grid_get_info             !< get information about mpp global domain (pivot, perio, ew)
249   PUBLIC :: grid_get_pivot            !< get NEMO pivot point index
250   PUBLIC :: grid_get_perio            !< get NEMO periodicity index
251   PUBLIC :: grid_get_ew_overlap       !< get East West overlap
252   PUBLIC :: grid_check_dom            !< check domain validity
253   PUBLIC :: grid_get_coarse_index     !< get closest coarse grid indices of fine grid domain.
254   PUBLIC :: grid_is_global            !< check if grid is global or not
255   PUBLIC :: grid_is_north_fold
256   PUBLIC :: grid_get_closest          !< return closest coarse grid point from another point
257   PUBLIC :: grid_distance             !< compute grid distance to a point
258   PUBLIC :: grid_get_fine_offset      !< get fine grid offset
259   PUBLIC :: grid_check_coincidence    !< check fine and coarse grid coincidence
260   PUBLIC :: grid_add_ghost            !< add ghost cell at boundaries.
261   PUBLIC :: grid_del_ghost            !< delete ghost cell at boundaries.
262   PUBLIC :: grid_get_ghost            !< return ghost cell factor
263   PUBLIC :: grid_split_domain         !< compute closed sea domain
264   PUBLIC :: grid_fill_small_dom       !< fill small closed sea with fill value
265   PUBLIC :: grid_fill_small_msk       !< fill small domain inside bigger one
266
267                                     ! get closest coarse grid indices of fine grid domain
268   PRIVATE :: grid__get_coarse_index_ff ! - using coarse and fine grid coordinates files
269   PRIVATE :: grid__get_coarse_index_cf ! - using coarse grid array of lon,lat and fine grid coordinates files
270   PRIVATE :: grid__get_coarse_index_fc ! - using coarse grid coordinates files, and fine grid array of lon,lat
271   PRIVATE :: grid__get_coarse_index_cc ! - using coarse and fine grid array of lon,lat
272
273                                     ! get offset between fine and coarse grid
274   PRIVATE :: grid__get_fine_offset_ff ! - using coarse and fine grid coordinates files
275   PRIVATE :: grid__get_fine_offset_cf ! - using coarse grid array of lon,lat and fine grid coordinates files
276   PRIVATE :: grid__get_fine_offset_fc ! - using coarse grid coordinates files, and fine grid array of lon,lat
277   PRIVATE :: grid__get_fine_offset_cc ! - using coarse and fine grid array of lon,lat
278
279                                     ! get information about global domain (pivot, perio, ew)
280   PRIVATE :: grid__get_info_mpp      ! - using mpp files structure
281   PRIVATE :: grid__get_info_file     ! - using files structure
282
283                                     ! get NEMO pivot point index
284   PRIVATE :: grid__get_pivot_mpp      ! - using mpp files structure
285   PRIVATE :: grid__get_pivot_file     ! - using files structure
286   PRIVATE :: grid__get_pivot_var      ! - using variable structure
287   PRIVATE :: grid__get_pivot_varT   ! compute NEMO pivot point index for variable on grid T
288   PRIVATE :: grid__get_pivot_varU   ! compute NEMO pivot point index for variable on grid U
289   PRIVATE :: grid__get_pivot_varV   ! compute NEMO pivot point index for variable on grid V
290   PRIVATE :: grid__get_pivot_varF   ! compute NEMO pivot point index for variable on grid F
291
292                                     ! get NEMO periodicity index
293   PRIVATE :: grid__get_perio_mpp      ! - using mpp files structure
294   PRIVATE :: grid__get_perio_file     ! - using files structure
295   PRIVATE :: grid__get_perio_var      ! - using variable structure
296
297                                     ! get East West overlap
298   PRIVATE :: grid__get_ew_overlap_mpp  ! - using mpp files structure
299   PRIVATE :: grid__get_ew_overlap_file ! - using files structure
300   PRIVATE :: grid__get_ew_overlap_var  ! - using longitude variable structure
301
302                                    ! return ghost cell factor
303   PRIVATE :: grid__get_ghost_mpp      ! - using mpp files structure
304   PRIVATE :: grid__get_ghost_var      ! - using array of lon,lat
305   PRIVATE :: grid__check_corner    ! check that fine grid is inside coarse grid
306   PRIVATE :: grid__check_lat       ! check that fine grid latitude are inside coarse grid latitude
307   
308   INTERFACE  grid_get_info
309      MODULE PROCEDURE grid__get_info_mpp
310      MODULE PROCEDURE grid__get_info_file
311   END INTERFACE grid_get_info
312
313   INTERFACE  grid_get_pivot
314      MODULE PROCEDURE grid__get_pivot_mpp
315      MODULE PROCEDURE grid__get_pivot_file
316      MODULE PROCEDURE grid__get_pivot_var
317   END INTERFACE grid_get_pivot
318
319   INTERFACE  grid_get_perio
320      MODULE PROCEDURE grid__get_perio_mpp
321      MODULE PROCEDURE grid__get_perio_file
322      MODULE PROCEDURE grid__get_perio_var
323   END INTERFACE grid_get_perio
324
325   INTERFACE  grid_get_ew_overlap
326      MODULE PROCEDURE grid__get_ew_overlap_mpp
327      MODULE PROCEDURE grid__get_ew_overlap_file
328      MODULE PROCEDURE grid__get_ew_overlap_var
329   END INTERFACE grid_get_ew_overlap
330
331   INTERFACE  grid_get_ghost
332      MODULE PROCEDURE grid__get_ghost_var
333      MODULE PROCEDURE grid__get_ghost_mpp
334   END INTERFACE  grid_get_ghost
335
336   INTERFACE  grid_get_coarse_index
337      MODULE PROCEDURE grid__get_coarse_index_ff
338      MODULE PROCEDURE grid__get_coarse_index_cf
339      MODULE PROCEDURE grid__get_coarse_index_fc
340      MODULE PROCEDURE grid__get_coarse_index_cc
341   END INTERFACE grid_get_coarse_index
342
343   INTERFACE  grid_get_fine_offset
344      MODULE PROCEDURE grid__get_fine_offset_ff
345      MODULE PROCEDURE grid__get_fine_offset_fc
346      MODULE PROCEDURE grid__get_fine_offset_cf
347      MODULE PROCEDURE grid__get_fine_offset_cc
348   END INTERFACE grid_get_fine_offset   
349
350CONTAINS
351   !-------------------------------------------------------------------
352   !> @brief This subroutine get information about global domain, given file
353   !> strucutre.
354   !>
355   !> @details
356   !> open edge files then:
357   !> - compute NEMO pivot point
358   !> - compute NEMO periodicity
359   !> - compute East West overlap
360   !>
361   !> @note need all processor files to be there
362   !> @author J.Paul
363   !> @date October, 2014 - Initial Version
364   !>
365   !> @param[inout] td_file file structure
366   !-------------------------------------------------------------------
367   SUBROUTINE grid__get_info_file(td_file)
368      IMPLICIT NONE
369      ! Argument     
370      TYPE(TFILE), INTENT(INOUT) :: td_file
371
372      ! local variable
373      INTEGER(i4) :: il_ew
374      INTEGER(i4) :: il_pivot
375      INTEGER(i4) :: il_perio
376      INTEGER(i4) :: il_attid
377
378      TYPE(TATT)  :: tl_att
379
380      TYPE(TFILE) :: tl_file
381
382      ! loop indices
383      INTEGER(i4) :: ji
384      !----------------------------------------------------------------
385      ! intialise
386      il_pivot=-1
387      il_perio=-1
388      il_ew   =-1 
389
390      ! copy structure
391      tl_file=file_copy(td_file)
392
393      ! open file to be used
394      CALL iom_open(tl_file)
395
396      IF( td_file%i_perio >= 0 .AND. td_file%i_perio <= 6 )THEN
397         il_perio=td_file%i_perio
398      ELSE
399         ! look for attribute in file
400         il_attid=att_get_index(tl_file%t_att(:),'periodicity')
401         IF( il_attid /= 0 )THEN
402            il_perio=INT(tl_file%t_att(il_attid)%d_value(1),i4)
403         ENDIF
404      ENDIF
405
406      IF( td_file%i_ew >= 0 )THEN
407         il_ew=td_file%i_ew
408      ELSE
409         ! look for attribute in file
410         il_attid=att_get_index(tl_file%t_att(:),'ew_overlap')
411         IF( il_attid /= 0 )THEN
412            il_ew=INT(tl_file%t_att(il_attid)%d_value(1),i4)
413         ENDIF
414      ENDIF
415
416      SELECT CASE(il_perio)
417      CASE(3,4)
418         il_pivot=0
419      CASE(5,6)
420         il_pivot=1
421      CASE(0,1,2)
422         il_pivot=1
423      END SELECT
424     
425      IF( il_pivot < 0 .OR. il_pivot > 1 )THEN
426         ! get pivot
427         il_pivot=grid_get_pivot(tl_file)
428      ENDIF
429
430      IF( il_perio < 0 .OR. il_perio > 6 )THEN
431         ! get periodicity
432         il_perio=grid_get_perio(tl_file, il_pivot)
433      ENDIF
434
435      IF( il_ew < 0 )THEN
436         ! get periodicity
437         il_ew=grid_get_ew_overlap(tl_file)
438      ENDIF
439
440      ! close
441      CALL iom_close(tl_file)
442
443      !save in file structure
444      td_file%i_ew=il_ew
445      td_file%i_pivot=il_pivot
446      td_file%i_perio=il_perio
447
448      ! save in variable of file structure
449      tl_att=att_init("ew_overlap",il_ew)
450      DO ji=1,td_file%i_nvar
451         IF( td_file%t_var(ji)%t_dim(jp_I)%l_use )THEN
452            CALL var_move_att(td_file%t_var(ji),tl_att)
453         ENDIF
454      ENDDO
455
456      ! clean
457      CALL file_clean(tl_file)
458      CALL att_clean(tl_att)
459
460      IF( td_file%i_perio == -1 )THEN
461         CALL logger_fatal("GRID GET INFO: can not read or compute "//&
462         &  "domain periodicity from file "//TRIM(td_file%c_name)//"."//&
463         &  " you have to inform periodicity in namelist.")
464      ENDIF
465
466   END SUBROUTINE grid__get_info_file
467   !-------------------------------------------------------------------
468   !> @brief This subroutine get information about global domain, given mpp
469   !> strucutre.
470   !>
471   !> @details
472   !> open edge files then:
473   !> - compute NEMO pivot point
474   !> - compute NEMO periodicity
475   !> - compute East West overlap
476   !>
477   !> @note need all processor files
478   !> @author J.Paul
479   !> @date October, 2014 - Initial Version
480   !>
481   !> @param[in] td_mpp mpp structure
482   !-------------------------------------------------------------------
483   SUBROUTINE grid__get_info_mpp(td_mpp)
484      IMPLICIT NONE
485      ! Argument     
486      TYPE(TMPP) , INTENT(INOUT) :: td_mpp
487
488      ! local variable
489      INTEGER(i4) :: il_ew
490      INTEGER(i4) :: il_pivot
491      INTEGER(i4) :: il_perio
492      INTEGER(i4) :: il_attid
493
494      TYPE(TATT)  :: tl_att
495
496      TYPE(TMPP)  :: tl_mpp
497
498      ! loop indices
499      INTEGER(i4) :: ji
500      INTEGER(i4) :: jj
501      !----------------------------------------------------------------
502      ! intialise
503      il_pivot=-1
504      il_perio=-1
505      il_ew   =-1
506
507      CALL logger_info("GRID GET INFO: look for "//TRIM(td_mpp%c_name))
508      ! copy structure
509      tl_mpp=mpp_copy(td_mpp)
510      ! select edge files
511      CALL mpp_get_contour(tl_mpp)
512      ! open mpp file to be used
513      CALL iom_mpp_open(tl_mpp)
514
515      IF( td_mpp%i_perio >= 0 .AND. td_mpp%i_perio <= 6 )THEN
516         il_perio=td_mpp%i_perio
517      ELSE
518         ! look for attribute in mpp files
519         il_attid=att_get_index(tl_mpp%t_proc(1)%t_att(:),'periodicity')
520         IF( il_attid /= 0 )THEN
521            il_perio=INT(tl_mpp%t_proc(1)%t_att(il_attid)%d_value(1),i4)
522         ENDIF
523      ENDIF
524     
525      IF( td_mpp%i_ew >= 0 )THEN
526         il_ew=td_mpp%i_ew
527      ELSE
528         ! look for attribute in mpp files
529         il_attid=att_get_index(tl_mpp%t_proc(1)%t_att(:),'ew_overlap')
530         IF( il_attid /= 0 )THEN
531            il_ew=INT(tl_mpp%t_proc(1)%t_att(il_attid)%d_value(1),i4)
532         ENDIF
533      ENDIF
534
535      CALL logger_info("GRID GET INFO: perio "//TRIM(fct_str(il_perio)))
536
537      SELECT CASE(il_perio)
538      CASE(3,4)
539         il_pivot=1
540      CASE(5,6)
541         il_pivot=0
542      CASE(0,1,2)
543         il_pivot=1
544      END SELECT
545
546      IF( il_pivot < 0 .OR. il_pivot > 1 )THEN
547         ! get pivot
548         CALL logger_info("GRID GET INFO: look for pivot ")
549         il_pivot=grid_get_pivot(tl_mpp)
550      ENDIF
551
552      IF( il_perio < 0 .OR. il_perio > 6 )THEN
553         ! get periodicity
554         CALL logger_info("GRID GET INFO: look for perio ")
555         il_perio=grid_get_perio(tl_mpp, il_pivot)
556      ENDIF
557
558      IF( il_ew < 0 )THEN
559         ! get periodicity
560         CALL logger_info("GRID GET INFO: look for overlap ")
561         il_ew=grid_get_ew_overlap(tl_mpp)
562      ENDIF
563
564      ! close
565      CALL iom_mpp_close(tl_mpp)
566
567      !save in mpp structure
568      td_mpp%i_ew=il_ew
569      td_mpp%i_pivot=il_pivot
570      td_mpp%i_perio=il_perio
571
572      ! save in variable of mpp structure
573      IF( ASSOCIATED(td_mpp%t_proc) )THEN
574         tl_att=att_init("ew_overlap",il_ew)
575         DO jj=1,td_mpp%i_nproc
576            DO ji=1,td_mpp%t_proc(jj)%i_nvar
577               IF( td_mpp%t_proc(jj)%t_var(ji)%t_dim(jp_I)%l_use )THEN
578                  CALL var_move_att(td_mpp%t_proc(jj)%t_var(ji),tl_att)
579               ENDIF
580            ENDDO
581         ENDDO
582      ENDIF
583
584      ! clean
585      CALL mpp_clean(tl_mpp)
586      CALL att_clean(tl_att)
587
588      IF( td_mpp%i_perio == -1 )THEN
589         CALL logger_fatal("GRID GET INFO: can not read or compute "//&
590         &  "domain periodicity from mpp "//TRIM(td_mpp%c_name)//"."//&
591         &  " you have to inform periodicity in namelist.")
592      ENDIF
593
594   END SUBROUTINE grid__get_info_mpp
595   !-------------------------------------------------------------------
596   !> @brief
597   !> This function compute NEMO pivot point index of the input variable.
598   !> - F-point : 0
599   !> - T-point : 1
600   !>
601   !> @details
602   !> check north points of latitude grid (indices jpj to jpj-3) depending on which grid point
603   !> (T,F,U,V) variable is defined
604   !>
605   !> @note variable must be at least 2D variable, and should not be coordinate
606   !> variable (i.e lon, lat)
607   !>
608   !> @warning
609   !> - do not work with ORCA2 grid (T-point)
610   !>
611   !> @author J.Paul
612   !> @date November, 2013 - Initial version
613   !> @date September, 2014
614   !> - add dummy loop in case variable not over right point.
615   !> @date October, 2014
616   !> - work on variable structure instead of file structure
617   !
618   !> @param[in] td_lat  latitude variable structure
619   !> @param[in] td_var  variable structure
620   !> @return pivot point index
621   !-------------------------------------------------------------------
622   FUNCTION grid__get_pivot_var(td_var)
623      IMPLICIT NONE
624      ! Argument     
625      TYPE(TVAR), INTENT(IN) :: td_var
626
627      ! function
628      INTEGER(i4) :: grid__get_pivot_var
629
630      ! local variable
631      INTEGER(i4), DIMENSION(ip_maxdim)            :: il_dim
632
633      REAL(dp)   , DIMENSION(:,:,:,:), ALLOCATABLE :: dl_value
634
635      ! loop indices
636      INTEGER(i4) :: jj
637      !----------------------------------------------------------------
638      ! intitalise
639      grid__get_pivot_var=-1
640
641      IF( .NOT. ASSOCIATED(td_var%d_value) .OR. &
642      &   .NOT. ALL(td_var%t_dim(1:2)%l_use) )THEN
643         CALL logger_error("GRID GET PIVOT: can not compute pivot point"//&
644         &  " with variable "//TRIM(td_var%c_name)//"."//&
645         &  " no value associated or missing dimension.")
646      ELSE
647         il_dim(:)=td_var%t_dim(:)%i_len
648
649         ALLOCATE(dl_value(il_dim(1),4,1,1))
650         ! extract value
651         dl_value(:,:,:,:)=td_var%d_value( 1:il_dim(1),          &
652         &                                 il_dim(2)-3:il_dim(2),&
653         &                                 1:1,                  &
654         &                                 1:1 )
655
656         SELECT CASE(TRIM(td_var%c_point))
657         CASE('T')
658            grid__get_pivot_var=grid__get_pivot_varT(dl_value)
659         CASE('U')
660            grid__get_pivot_var=grid__get_pivot_varU(dl_value)
661         CASE('V')
662            grid__get_pivot_var=grid__get_pivot_varV(dl_value)
663         CASE('F')
664            grid__get_pivot_var=grid__get_pivot_varF(dl_value)
665         END SELECT
666
667         ! dummy loop in case variable not over right point
668         ! (ex: nav_lon over U-point)
669         IF( grid__get_pivot_var == -1 )THEN
670           
671            ! no pivot point found
672            CALL logger_warn("GRID GET PIVOT: something wrong "//&
673            &  "when computing pivot point with variable "//&
674            &  TRIM(td_var%c_name))
675
676            DO jj=1,ip_npoint
677               SELECT CASE(TRIM(cp_grid_point(jj)))
678               CASE('T')
679                  CALL logger_debug("GRID GET PIVOT: check variable on point T")
680                  grid__get_pivot_var=grid__get_pivot_varT(dl_value)
681               CASE('U')
682                  CALL logger_debug("GRID GET PIVOT: check variable on point U")
683                  grid__get_pivot_var=grid__get_pivot_varU(dl_value)
684               CASE('V')
685                  CALL logger_debug("GRID GET PIVOT: check variable on point V")
686                  grid__get_pivot_var=grid__get_pivot_varV(dl_value)
687               CASE('F')
688                  CALL logger_debug("GRID GET PIVOT: check variable on point F")
689                  grid__get_pivot_var=grid__get_pivot_varF(dl_value)
690               END SELECT
691
692               IF( grid__get_pivot_var /= -1 )THEN
693                  CALL logger_info("GRID GET PIVOT: variable "//&
694                  &  TRIM(td_var%c_name)//" seems to be on grid point "//&
695                  &  TRIM(cp_grid_point(jj)) )
696                  EXIT
697               ENDIF
698
699            ENDDO
700         ENDIF
701
702         IF( grid__get_pivot_var == -1 )THEN
703            CALL logger_warn("GRID GET PIVOT: not able to found pivot point. "//&
704            &  "Force to use pivot point T.")
705            grid__get_pivot_var = 1
706         ENDIF
707
708         ! clean
709         DEALLOCATE(dl_value)
710
711      ENDIF
712
713   END FUNCTION grid__get_pivot_var
714   !-------------------------------------------------------------------
715   !> @brief
716   !> This function compute NEMO pivot point index for variable on grid T.
717   !>
718   !> @details
719   !> - F-point : 0
720   !> - T-point : 1
721   !>
722   !> @note array of value must be only the top border of the domain.
723   !>
724   !> @author J.Paul
725   !> @date October, 2014 - Initial version
726   !
727   !> @param[in] dd_value array of value
728   !> @return pivot point index
729   !-------------------------------------------------------------------
730   FUNCTION grid__get_pivot_varT(dd_value)
731      IMPLICIT NONE
732      ! Argument     
733      REAL(dp), DIMENSION(:,:,:,:), INTENT(IN) :: dd_value
734
735      ! function
736      INTEGER(i4) :: grid__get_pivot_varT
737
738      ! local variable
739      INTEGER(i4)                       :: il_midT
740      INTEGER(i4)                       :: il_midF
741
742      INTEGER(i4)                       :: it1
743      INTEGER(i4)                       :: it2
744      INTEGER(i4)                       :: jt1
745      INTEGER(i4)                       :: jt2
746
747      INTEGER(i4)                       :: if1
748      INTEGER(i4)                       :: if2
749      INTEGER(i4)                       :: jf1
750      INTEGER(i4)                       :: jf2
751
752      INTEGER(i4), DIMENSION(ip_maxdim) :: il_dim
753
754      LOGICAL                           :: ll_check
755
756      ! loop indices
757      INTEGER(i4) :: ji
758      !----------------------------------------------------------------
759      ! intitalise
760      grid__get_pivot_varT=-1
761
762      il_dim(:)=SHAPE(dd_value(:,:,:,:))
763
764      ! T-point pivot !case of ORCA2, ORCA025, ORCA12 grid
765      jt1=4  ; jt2=2 
766      il_midT=il_dim(1)/2+1
767
768      ! F-point pivot !case of ORCA05 grid
769      jf1=4 ; jf2=3
770      il_midF=il_dim(1)/2
771
772      ! check T-point pivot
773      DO ji=2,il_midT
774         ll_check=.TRUE.
775         it1=ji
776         it2=il_dim(1)-(ji-2)
777         IF( dd_value(it1,jt1,1,1) /= dd_value(it2,jt2,1,1) )THEN
778            ll_check=.FALSE.
779            EXIT
780         ENDIF
781      ENDDO
782
783      IF( ll_check )THEN
784         CALL logger_info("GRID GET PIVOT: T-pivot")
785         grid__get_pivot_varT=1
786      ELSE
787
788         ! check F-point pivot
789         DO ji=1,il_midF
790            ll_check=.TRUE.
791            if1=ji
792            if2=il_dim(1)-(ji-1)
793            IF( dd_value(if1,jf1,1,1) /= dd_value(if2,jf2,1,1) )THEN
794               ll_check=.FALSE.
795               EXIT
796            ENDIF
797         ENDDO
798
799         IF( ll_check )THEN
800            CALL logger_info("GRID GET PIVOT: F-pivot")
801            grid__get_pivot_varT=0
802         ENDIF
803
804      ENDIF
805
806   END FUNCTION grid__get_pivot_varT
807   !-------------------------------------------------------------------
808   !> @brief
809   !> This function compute NEMO pivot point index for variable on grid U.
810   !>
811   !> @details
812   !> - F-point : 0
813   !> - T-point : 1
814   !>
815   !> @note array of value must be only the top border of the domain.
816   !>
817   !> @author J.Paul
818   !> @date October, 2014 - Initial version
819   !
820   !> @param[in] dd_value array of value
821   !> @return pivot point index
822   !-------------------------------------------------------------------
823   FUNCTION grid__get_pivot_varU(dd_value)
824      IMPLICIT NONE
825      ! Argument     
826      REAL(dp), DIMENSION(:,:,:,:), INTENT(IN) :: dd_value
827
828      ! function
829      INTEGER(i4) :: grid__get_pivot_varU
830
831      ! local variable
832      INTEGER(i4)                       :: il_midT
833      INTEGER(i4)                       :: il_midF
834
835      INTEGER(i4)                       :: it1
836      INTEGER(i4)                       :: it2
837      INTEGER(i4)                       :: jt1
838      INTEGER(i4)                       :: jt2
839
840      INTEGER(i4)                       :: if1
841      INTEGER(i4)                       :: if2
842      INTEGER(i4)                       :: jf1
843      INTEGER(i4)                       :: jf2
844
845      INTEGER(i4), DIMENSION(ip_maxdim) :: il_dim
846
847      LOGICAL                           :: ll_check
848
849      ! loop indices
850      INTEGER(i4) :: ji
851      !----------------------------------------------------------------
852      ! intitalise
853      grid__get_pivot_varU=-1
854
855      il_dim(:)=SHAPE(dd_value(:,:,:,:))
856
857      ! T-point pivot !case of ORCA2, ORCA025, ORCA12 grid
858      jt1=4 ; jt2=2 
859      il_midT=il_dim(1)/2+1
860
861      ! F-point pivot !case of ORCA05 grid
862      jf1=4 ; jf2=3
863      il_midF=il_dim(1)/2
864
865      ! check T-point pivot
866      DO ji=1,il_midT
867         ll_check=.TRUE.
868         it1=ji
869         it2=il_dim(1)-(ji-2)
870         IF( dd_value(it1,jt1,1,1) /= dd_value(it2-1,jt2,1,1) )THEN
871            ll_check=.FALSE.
872            EXIT
873         ENDIF
874      ENDDO
875
876      IF( ll_check )THEN
877         CALL logger_info("GRID GET PIVOT: T-pivot")
878         grid__get_pivot_varU=1
879      ELSE
880
881         ! check F-point pivot
882         DO ji=1,il_midF
883            ll_check=.TRUE.
884            if1=ji
885            if2=il_dim(1)-(ji-1)
886            IF( dd_value(if1,jf1,1,1) /= dd_value(if2-1,jf2,1,1) )THEN
887               ll_check=.FALSE.
888               EXIT
889            ENDIF
890         ENDDO
891
892         IF( ll_check )THEN
893            CALL logger_info("GRID GET PIVOT: F-pivot")
894            grid__get_pivot_varU=0
895         ENDIF
896
897      ENDIF
898
899   END FUNCTION grid__get_pivot_varU
900   !-------------------------------------------------------------------
901   !> @brief
902   !> This function compute NEMO pivot point index for variable on grid V.
903   !>
904   !> @details
905   !> - F-point : 0
906   !> - T-point : 1
907   !>
908   !> @note array of value must be only the top border of the domain.
909   !>
910   !> @author J.Paul
911   !> @date October, 2014 - Initial version
912   !
913   !> @param[in] dd_value array of value
914   !> @return pivot point index
915   !-------------------------------------------------------------------
916   FUNCTION grid__get_pivot_varV(dd_value)
917      IMPLICIT NONE
918      ! Argument     
919      REAL(dp), DIMENSION(:,:,:,:), INTENT(IN) :: dd_value
920
921      ! function
922      INTEGER(i4) :: grid__get_pivot_varV
923
924      ! local variable
925      INTEGER(i4)                       :: il_midT
926      INTEGER(i4)                       :: il_midF
927
928      INTEGER(i4)                       :: it1
929      INTEGER(i4)                       :: it2
930      INTEGER(i4)                       :: jt1
931      INTEGER(i4)                       :: jt2
932
933      INTEGER(i4)                       :: if1
934      INTEGER(i4)                       :: if2
935      INTEGER(i4)                       :: jf1
936      INTEGER(i4)                       :: jf2
937
938      INTEGER(i4), DIMENSION(ip_maxdim) :: il_dim
939
940      LOGICAL                           :: ll_check
941
942      ! loop indices
943      INTEGER(i4) :: ji
944      !----------------------------------------------------------------
945      ! intitalise
946      grid__get_pivot_varV=-1
947
948      il_dim(:)=SHAPE(dd_value(:,:,:,:))
949
950      ! T-point pivot !case of ORCA2, ORCA025, ORCA12 grid
951      jt1=4 ; jt2=2 
952      il_midT=il_dim(1)/2+1
953
954      ! F-point pivot !case of ORCA05 grid
955      jf1=4 ; jf2=3
956      il_midF=il_dim(1)/2
957
958      ! check T-point pivot
959      DO ji=2,il_midT
960         ll_check=.TRUE.
961         it1=ji
962         it2=il_dim(1)-(ji-2)
963         IF( dd_value(it1,jt1,1,1) /= dd_value(it2,jt2-1,1,1) )THEN
964            ll_check=.FALSE.
965            EXIT
966         ENDIF
967      ENDDO
968
969      IF( ll_check )THEN
970         CALL logger_info("GRID GET PIVOT: T-pivot")
971         grid__get_pivot_varV=1
972      ELSE
973
974         ! check F-point pivot
975         DO ji=1,il_midF
976            ll_check=.TRUE.
977            if1=ji
978            if2=il_dim(1)-(ji-1)
979            IF( dd_value(if1,jf1,1,1) /= dd_value(if2,jf2-1,1,1) )THEN
980               ll_check=.FALSE.
981               EXIT
982            ENDIF
983         ENDDO
984
985         IF( ll_check )THEN
986            CALL logger_info("GRID GET PIVOT: F-pivot")
987            grid__get_pivot_varV=0
988         ENDIF
989
990      ENDIF
991
992   END FUNCTION grid__get_pivot_varV
993   !-------------------------------------------------------------------
994   !> @brief
995   !> This function compute NEMO pivot point index for variable on grid F.
996   !>
997   !> @details
998   !> - F-point : 0
999   !> - T-point : 1
1000   !>
1001   !> @note array of value must be only the top border of the domain.
1002   !>
1003   !> @author J.Paul
1004   !> @date October, 2014 - Initial version
1005   !
1006   !> @param[in] dd_value array of value
1007   !> @return pivot point index
1008   !-------------------------------------------------------------------
1009   FUNCTION grid__get_pivot_varF(dd_value)
1010      IMPLICIT NONE
1011      ! Argument     
1012      REAL(dp), DIMENSION(:,:,:,:), INTENT(IN) :: dd_value
1013
1014      ! function
1015      INTEGER(i4) :: grid__get_pivot_varF
1016
1017      ! local variable
1018      INTEGER(i4)                       :: il_midT
1019      INTEGER(i4)                       :: il_midF
1020
1021      INTEGER(i4)                       :: it1
1022      INTEGER(i4)                       :: it2
1023      INTEGER(i4)                       :: jt1
1024      INTEGER(i4)                       :: jt2
1025
1026      INTEGER(i4)                       :: if1
1027      INTEGER(i4)                       :: if2
1028      INTEGER(i4)                       :: jf1
1029      INTEGER(i4)                       :: jf2
1030
1031      INTEGER(i4), DIMENSION(ip_maxdim) :: il_dim
1032
1033      LOGICAL                           :: ll_check
1034
1035      ! loop indices
1036      INTEGER(i4) :: ji
1037      !----------------------------------------------------------------
1038      ! intitalise
1039      grid__get_pivot_varF=-1
1040
1041      il_dim(:)=SHAPE(dd_value(:,:,:,:))
1042
1043      ! T-point pivot !case of ORCA2, ORCA025, ORCA12 grid
1044      jt1=4 ; jt2=2 
1045      il_midT=il_dim(1)/2+1
1046
1047      ! F-point pivot !case of ORCA05 grid
1048      jf1=4 ; jf2=3
1049      il_midF=il_dim(1)/2
1050
1051      ! check T-point pivot
1052      DO ji=1,il_midT
1053         ll_check=.TRUE.
1054         it1=ji
1055         it2=il_dim(1)-(ji-2)
1056         IF( dd_value(it1,jt1,1,1) /= dd_value(it2-1,jt2-1,1,1) )THEN
1057            ll_check=.FALSE.
1058            EXIT
1059         ENDIF
1060      ENDDO
1061
1062      IF( ll_check )THEN
1063         CALL logger_info("GRID GET PIVOT: T-pivot")
1064         grid__get_pivot_varF=1
1065      ELSE
1066
1067         ! check F-point pivot
1068         DO ji=1,il_midF
1069            ll_check=.TRUE.
1070            if1=ji
1071            if2=il_dim(1)-(ji-1)
1072            IF( dd_value(if1,jf1,1,1) /= dd_value(if2-1,jf2-1,1,1) )THEN
1073               ll_check=.FALSE.
1074               EXIT
1075            ENDIF
1076         ENDDO
1077
1078         IF( ll_check )THEN
1079            CALL logger_info("GRID GET PIVOT: F-pivot")
1080            grid__get_pivot_varF=0
1081         ENDIF
1082
1083      ENDIF
1084
1085   END FUNCTION grid__get_pivot_varF
1086   !-------------------------------------------------------------------
1087   !> @brief
1088   !> This function compute NEMO pivot point index from input file variable.
1089   !> - F-point : 0
1090   !> - T-point : 1
1091   !>
1092   !> @details
1093   !> check north points of latitude grid (indices jpj to jpj-3) depending on which grid point
1094   !> (T,F,U,V) variable is defined
1095   !>
1096   !> @warning
1097   !> - do not work with ORCA2 grid (T-point)
1098   !>
1099   !> @author J.Paul
1100   !> @date Ocotber, 2014 - Initial version
1101   !
1102   !> @param[in] td_file file structure
1103   !> @return pivot point index
1104   !-------------------------------------------------------------------
1105   FUNCTION grid__get_pivot_file(td_file)
1106      IMPLICIT NONE
1107      ! Argument     
1108      TYPE(TFILE), INTENT(IN) :: td_file
1109
1110      ! function
1111      INTEGER(i4) :: grid__get_pivot_file
1112
1113      ! local variable
1114      INTEGER(i4)                       :: il_varid
1115      INTEGER(i4), DIMENSION(ip_maxdim) :: il_dim
1116
1117      LOGICAL                           :: ll_north
1118
1119      TYPE(TVAR)                        :: tl_var
1120      TYPE(TVAR)                        :: tl_lat
1121
1122      ! loop indices
1123      INTEGER(i4) :: ji
1124      !----------------------------------------------------------------
1125      ! intitalise
1126      grid__get_pivot_file=-1
1127
1128      ! look for north fold
1129      il_varid=var_get_index(td_file%t_var(:), 'latitude')
1130      IF( il_varid == 0 )THEN
1131         CALL logger_error("GRID GET PIVOT: no variable with name "//&
1132         &  "or standard name latitude in file structure "//&
1133         &  TRIM(td_file%c_name))
1134      ENDIF
1135      IF( ASSOCIATED(td_file%t_var(il_varid)%d_value) )THEN
1136         tl_lat=var_copy(td_file%t_var(il_varid))
1137      ELSE
1138         tl_lat=iom_read_var(td_file, 'latitude')
1139      ENDIF
1140
1141      ll_north=grid_is_north_fold(tl_lat)
1142      ! clean
1143      CALL var_clean(tl_lat)
1144
1145      IF( ll_north )THEN     
1146         ! look for suitable variable
1147         DO ji=1,td_file%i_nvar
1148            IF( .NOT. ALL(td_file%t_var(ji)%t_dim(1:2)%l_use) ) CYCLE
1149
1150            IF( ASSOCIATED(td_file%t_var(ji)%d_value) )THEN
1151               tl_var=var_copy(td_file%t_var(ji))
1152            ELSE
1153               il_dim(:)=td_file%t_var(ji)%t_dim(:)%i_len
1154               tl_var=iom_read_var(td_file, &
1155               &                   td_file%t_var(ji)%c_name, &
1156               &                   id_start=(/1,il_dim(2)-3,1,1/), &
1157               &                   id_count=(/il_dim(1),4,1,1/) )
1158            ENDIF
1159         ENDDO
1160
1161         IF( ASSOCIATED(tl_var%d_value) )THEN
1162
1163            grid__get_pivot_file=grid_get_pivot(tl_var)
1164
1165         ENDIF
1166
1167         ! clean
1168         CALL var_clean(tl_var)
1169      ELSE
1170         CALL logger_warn("GRID GET PIVOT: no north fold. force to use T-PIVOT")
1171         grid__get_pivot_file=1
1172      ENDIF
1173
1174   END FUNCTION grid__get_pivot_file
1175   !-------------------------------------------------------------------
1176   !> @brief
1177   !> This function compute NEMO pivot point index from input mpp variable.
1178   !> - F-point : 0
1179   !> - T-point : 1
1180   !>
1181   !> @details
1182   !> check north points of latitude grid (indices jpj to jpj-3) depending on which grid point
1183   !> (T,F,U,V) variable is defined
1184   !>
1185   !> @warning
1186   !> - do not work with ORCA2 grid (T-point)
1187   !>
1188   !> @author J.Paul
1189   !> @date October, 2014 - Initial version
1190   !
1191   !> @param[in] td_mpp   mpp file structure
1192   !> @return pivot point index
1193   !-------------------------------------------------------------------
1194   FUNCTION grid__get_pivot_mpp(td_mpp)
1195      IMPLICIT NONE
1196      ! Argument     
1197      TYPE(TMPP), INTENT(IN) :: td_mpp
1198
1199      ! function
1200      INTEGER(i4) :: grid__get_pivot_mpp
1201
1202      ! local variable
1203      INTEGER(i4)                       :: il_varid
1204      INTEGER(i4), DIMENSION(ip_maxdim) :: il_dim
1205
1206      LOGICAL                           :: ll_north
1207
1208      TYPE(TVAR)                        :: tl_var
1209      TYPE(TVAR)                        :: tl_lat
1210 
1211      ! loop indices
1212      INTEGER(i4) :: ji
1213      !----------------------------------------------------------------
1214      ! intitalise
1215      grid__get_pivot_mpp=-1
1216
1217      ! look for north fold
1218      il_varid=var_get_index(td_mpp%t_proc(1)%t_var(:), 'latitude')
1219      IF( il_varid == 0 )THEN
1220         CALL logger_error("GRID GET PIVOT: no variable with name "//&
1221         &  "or standard name latitude in mpp structure "//&
1222         &  TRIM(td_mpp%c_name)//". Assume there is north fold and "//&
1223         &  "try to get pivot point")
1224
1225         ll_north=.TRUE.
1226      ELSE
1227         IF( ASSOCIATED(td_mpp%t_proc(1)%t_var(il_varid)%d_value) )THEN
1228            !
1229            tl_lat=mpp_recombine_var(td_mpp, 'latitude')
1230         ELSE
1231            tl_lat=iom_mpp_read_var(td_mpp, 'latitude')
1232         ENDIF     
1233
1234         ll_north=grid_is_north_fold(tl_lat)
1235      ENDIF
1236
1237      IF( ll_north )THEN
1238
1239         IF( ASSOCIATED(tl_lat%d_value) )THEN
1240            grid__get_pivot_mpp=grid_get_pivot(tl_lat)
1241         ELSE
1242            ! look for suitable variable
1243            DO ji=1,td_mpp%t_proc(1)%i_nvar
1244               IF(.NOT. ALL(td_mpp%t_proc(1)%t_var(ji)%t_dim(1:2)%l_use)) CYCLE
1245
1246               IF( ASSOCIATED(td_mpp%t_proc(1)%t_var(ji)%d_value) )THEN
1247                  CALL logger_debug("GRID GET PIVOT: mpp_recombine_var"//&
1248                  &         TRIM(td_mpp%t_proc(1)%t_var(ji)%c_name))
1249                  tl_var=mpp_recombine_var(td_mpp, &
1250                  &              TRIM(td_mpp%t_proc(1)%t_var(ji)%c_name))
1251               ELSE
1252                  CALL logger_debug("GRID GET PIVOT: iom_mpp_read_var "//&
1253                  &        TRIM(td_mpp%t_proc(1)%t_var(ji)%c_name))
1254                  il_dim(:)=td_mpp%t_dim(:)%i_len
1255
1256                  ! read variable
1257                  tl_var=iom_mpp_read_var(td_mpp, &
1258                  &                       td_mpp%t_proc(1)%t_var(ji)%c_name, &
1259                  &                       id_start=(/1,il_dim(2)-3,1,1/), &
1260                  &                       id_count=(/il_dim(1),4,1,1/) )
1261               ENDIF
1262               EXIT
1263            ENDDO
1264
1265            IF( ASSOCIATED(tl_var%d_value) )THEN
1266
1267               grid__get_pivot_mpp=grid_get_pivot(tl_var)
1268
1269           ELSE
1270               CALL logger_warn("GRID GET PIVOT: force to use T-PIVOT")
1271               grid__get_pivot_mpp=1
1272            ENDIF
1273
1274            ! clean
1275            CALL var_clean(tl_var)
1276         ENDIF
1277      ELSE
1278         CALL logger_warn("GRID GET PIVOT: no north fold. force to use T-PIVOT")
1279         grid__get_pivot_mpp=1
1280      ENDIF
1281
1282      CALL var_clean(tl_lat)
1283   END FUNCTION grid__get_pivot_mpp
1284   !-------------------------------------------------------------------
1285   !> @brief
1286   !> This subroutine search NEMO periodicity index given variable structure and
1287   !> pivot point index.
1288   !> @details
1289   !> The variable must be on T point.
1290   !>
1291   !> 0: closed boundaries
1292   !> 1: cyclic east-west boundary
1293   !> 2: symmetric boundary condition across the equator
1294   !> 3: North fold boundary (with a T-point pivot)
1295   !> 4: North fold boundary (with a T-point pivot) and cyclic east-west boundary
1296   !> 5: North fold boundary (with a F-point pivot)
1297   !> 6: North fold boundary (with a F-point pivot) and cyclic east-west boundary
1298   !>
1299   !> @warning pivot point should have been computed before run this script. see grid_get_pivot.
1300   !>
1301   !> @author J.Paul
1302   !> @date November, 2013 - Initial version
1303   !> @date October, 2014
1304   !> - work on variable structure instead of file structure
1305   !
1306   !> @param[in] td_var   variable structure
1307   !> @param[in] id_pivot pivot point index
1308   !-------------------------------------------------------------------
1309   FUNCTION grid__get_perio_var(td_var, id_pivot)
1310      IMPLICIT NONE
1311
1312      ! Argument     
1313      TYPE(TVAR) , INTENT(IN) :: td_var
1314      INTEGER(i4), INTENT(IN) :: id_pivot
1315
1316      ! function
1317      INTEGER(i4) :: grid__get_perio_var
1318
1319      ! local variable
1320      INTEGER(i4)                       :: il_perio
1321
1322      INTEGER(i4), DIMENSION(ip_maxdim) :: il_dim
1323
1324      ! loop indices
1325      !----------------------------------------------------------------
1326      ! intitalise
1327      grid__get_perio_var=-1
1328
1329      IF( id_pivot < 0 .OR. id_pivot > 1 )THEN
1330         CALL logger_error("GRID GET PERIO: invalid pivot point index. "//&
1331         &  "you should use grid_get_pivot to compute it")
1332      ENDIF
1333
1334      IF( .NOT. ASSOCIATED(td_var%d_value) .OR. &
1335      &   .NOT. ALL(td_var%t_dim(1:2)%l_use) )THEN
1336         CALL logger_error("GRID GET PERIO: can not compute periodicity"//&
1337         &  " with variable "//TRIM(td_var%c_name)//"."//&
1338         &  " no value associated or missing dimension.")
1339      ELSE
1340
1341         il_dim(:)=td_var%t_dim(:)%i_len
1342
1343         CALL logger_debug("GRID GET PERIO: use varibale "//TRIM(td_var%c_name))
1344         CALL logger_debug("GRID GET PERIO: fill value "//TRIM(fct_str(td_var%d_fill)))
1345         CALL logger_debug("GRID GET PERIO: first value "//TRIM(fct_str(td_var%d_value(1,1,1,1))))
1346
1347         IF(ALL(td_var%d_value(    1    ,    :    ,1,1)/=td_var%d_fill).AND.&
1348         &  ALL(td_var%d_value(il_dim(1),    :    ,1,1)/=td_var%d_fill).AND.&
1349         &  ALL(td_var%d_value(    :    ,    1    ,1,1)/=td_var%d_fill).AND.&
1350         &  ALL(td_var%d_value(    :    ,il_dim(2),1,1)/=td_var%d_fill))THEN
1351         ! no boundary closed
1352            CALL logger_error("GRID GET PERIO: can't determined periodicity. "//&
1353            &             "there is no boundary closed for variable "//&
1354            &              TRIM(td_var%c_name) )
1355            ! check pivot
1356            SELECT CASE(id_pivot)
1357               CASE(0)
1358                  ! F pivot
1359                  CALL logger_warn("GRID GET PERIO: assume domain is global")
1360                  grid__get_perio_var=6
1361               CASE(1)
1362                  ! T pivot
1363                  CALL logger_warn("GRID GET PERIO: assume domain is global")
1364                  grid__get_perio_var=4
1365            END SELECT
1366         ELSE
1367            ! check periodicity
1368            IF(ANY(td_var%d_value(   1     ,:,1,1)/=td_var%d_fill).OR.&
1369            &  ANY(td_var%d_value(il_dim(1),:,1,1)/=td_var%d_fill))THEN
1370            ! East-West cyclic (1,4,6)
1371
1372               IF( ANY(td_var%d_value(:, 1, 1, 1) /= td_var%d_fill) )THEN
1373               ! South boundary not closed
1374
1375                  CALL logger_debug("GRID GET PERIO: East_West cyclic")
1376                  CALL logger_debug("GRID GET PERIO: South boundary not closed")
1377                  CALL logger_error("GRID GET PERIO: should have been an "//&
1378                  &              "impossible case")
1379
1380               ELSE
1381               ! South boundary closed (1,4,6)
1382                  CALL logger_info("GRID GET PERIO: South boundary closed")
1383
1384                  IF(ANY(td_var%d_value(:,il_dim(2),1,1)/=td_var%d_fill) )THEN
1385                  ! North boundary not closed (4,6)
1386                     CALL logger_info("GRID GET PERIO: North boundary not closed")
1387                     ! check pivot
1388                     SELECT CASE(id_pivot)
1389                        CASE(0)
1390                           ! F pivot
1391                           il_perio=6
1392                        CASE(1)
1393                           ! T pivot
1394                           il_perio=4
1395                        CASE DEFAULT
1396                           CALL logger_error("GRID GET PERIO: invalid pivot ")
1397                     END SELECT
1398                  ELSE
1399                  ! North boundary closed
1400                     CALL logger_info("GRID GET PERIO: North boundary closed")
1401                     il_perio=1 ! North and South boundaries closed
1402                  ENDIF
1403
1404               ENDIF
1405
1406            ELSE
1407            ! East-West boundaries closed (0,2,3,5)
1408               CALL logger_info("GRID GET PERIO: East West boundaries closed")
1409
1410               IF( ANY(td_var%d_value(:, 1, 1, 1) /= td_var%d_fill) )THEN
1411               ! South boundary not closed (2)
1412                  CALL logger_info("GRID GET PERIO: South boundary not closed")
1413
1414                  IF(ANY(td_var%d_value(:,il_dim(2),1,1)/=td_var%d_fill))THEN
1415                  ! North boundary not closed
1416                     CALL logger_debug("GRID GET PERIO: East West boundaries "//&
1417                     &              "closed")
1418                     CALL logger_debug("GRID GET PERIO: South boundary not closed")
1419                     CALL logger_debug("GRID GET PERIO: North boundary not closed")
1420                     CALL logger_error("GRID GET PERIO: should have been "//&
1421                     &              "an impossible case")
1422                  ELSE
1423                  ! North boundary closed
1424                     il_perio=2   ! East-West and North boundaries closed
1425                  ENDIF
1426
1427               ELSE
1428               ! South boundary closed (0,3,5)
1429                  CALL logger_info("GRID GET PERIO: South boundary closed")
1430
1431                  IF(ANY(td_var%d_value(:,il_dim(2),1,1)/=td_var%d_fill))THEN
1432                  ! North boundary not closed (3,5)
1433                     CALL logger_info("GRID GET PERIO: North boundary not closed")
1434                     ! check pivot
1435                     SELECT CASE(id_pivot)
1436                        CASE(0)
1437                           ! F pivot
1438                           il_perio=5
1439                        CASE(1)
1440                           ! T pivot
1441                           il_perio=3
1442                        CASE DEFAULT
1443                           CALL logger_error("GRID GET PERIO: invalid pivot")
1444                     END SELECT
1445                  ELSE
1446                  ! North boundary closed   
1447                     CALL logger_info("GRID GET PERIO: North boundary closed")
1448                     il_perio=0   ! all boundary closed
1449                  ENDIF
1450
1451               ENDIF
1452
1453            ENDIF
1454
1455            grid__get_perio_var=il_perio
1456
1457         ENDIF
1458
1459      ENDIF
1460
1461   END FUNCTION grid__get_perio_var
1462   !-------------------------------------------------------------------
1463   !> @brief
1464   !> This subroutine search NEMO periodicity index given file structure, and
1465   !> optionaly pivot point index.
1466   !> @details
1467   !> The variable used must be on T point.
1468   !>
1469   !> 0: closed boundaries
1470   !> 1: cyclic east-west boundary
1471   !> 2: symmetric boundary condition across the equator
1472   !> 3: North fold boundary (with a F-point pivot)
1473   !> 4: North fold boundary (with a F-point pivot) and cyclic east-west boundary
1474   !> 5: North fold boundary (with a T-point pivot)
1475   !> 6: North fold boundary (with a T-point pivot) and cyclic east-west boundary
1476   !>
1477   !> @warning pivot point should have been computed before run this script. see grid_get_pivot.
1478   !>
1479   !> @author J.Paul
1480   !> @date October, 2014 - Initial version
1481   !>
1482   !> @param[in] td_file   file structure
1483   !> @param[in] id_pivot  pivot point index
1484   !-------------------------------------------------------------------
1485   FUNCTION grid__get_perio_file(td_file, id_pivot)
1486      IMPLICIT NONE
1487
1488      ! Argument     
1489      TYPE(TFILE), INTENT(IN) :: td_file
1490      INTEGER(i4), INTENT(IN), OPTIONAL :: id_pivot
1491
1492      ! function
1493      INTEGER(i4) :: grid__get_perio_file
1494
1495      ! local variable
1496      INTEGER(i4)                       :: il_varid
1497      INTEGER(i4)                       :: il_pivot
1498      INTEGER(i4), DIMENSION(ip_maxdim) :: il_dim
1499
1500      TYPE(TVAR)                        :: tl_var
1501
1502      ! loop indices
1503      INTEGER(i4) :: ji
1504      !----------------------------------------------------------------
1505      !initialise
1506      grid__get_perio_file=-1
1507
1508      IF(PRESENT(id_pivot) )THEN
1509         il_pivot=id_pivot
1510      ELSE
1511         il_pivot=grid_get_pivot(td_file)
1512      ENDIF
1513
1514      IF( il_pivot < 0 .OR. il_pivot > 1 )THEN
1515         CALL logger_error("GRID GET PERIO: invalid pivot point index. "//&
1516         &  "you should use grid_get_pivot to compute it")
1517      ENDIF
1518
1519      ! look for suitable variable
1520      il_varid=0
1521      DO ji=1,td_file%i_nvar
1522         IF( .NOT. ALL(td_file%t_var(ji)%t_dim(1:2)%l_use) ) CYCLE
1523         SELECT CASE(TRIM(fct_lower(td_file%t_var(ji)%c_stdname)) )
1524            CASE('longitude','latitude')
1525            CASE DEFAULT
1526               il_varid=ji
1527               EXIT
1528         END SELECT
1529      ENDDO
1530
1531      IF( il_varid==0 )THEN
1532     
1533         CALL logger_error("GRID GET PERIO: no suitable variable to compute "//&
1534         &              " periodicity in file "//TRIM(td_file%c_name))
1535
1536      ELSE
1537
1538         il_dim(:)= td_file%t_var(il_varid)%t_dim(:)%i_len
1539
1540         ! read variable
1541         tl_var=iom_read_var(td_file, &
1542         &                   td_file%t_var(il_varid)%c_name, &
1543         &                   id_start=(/1,1,1,1/), &
1544         &                   id_count=(/il_dim(1),il_dim(2),1,1/) )
1545
1546
1547         grid__get_perio_file=grid_get_perio(tl_var,il_pivot)
1548 
1549         ! clean
1550         CALL var_clean(tl_var)
1551
1552      ENDIF
1553
1554   END FUNCTION grid__get_perio_file
1555   !-------------------------------------------------------------------
1556   !> @brief
1557   !> This subroutine search NEMO periodicity given mpp structure and optionaly
1558   !> pivot point index.
1559   !> @details
1560   !> The variable used must be on T point.
1561   !>
1562   !> 0: closed boundaries
1563   !> 1: cyclic east-west boundary
1564   !> 2: symmetric boundary condition across the equator
1565   !> 3: North fold boundary (with a T-point pivot)
1566   !> 4: North fold boundary (with a T-point pivot) and cyclic east-west boundary
1567   !> 5: North fold boundary (with a F-point pivot)
1568   !> 6: North fold boundary (with a F-point pivot) and cyclic east-west boundary
1569   !>
1570   !> @warning pivot point should have been computed before run this script. see grid_get_pivot.
1571   !>
1572   !> @author J.Paul
1573   !> @date October, 2014 - Initial version
1574   !
1575   !> @param[in] td_mpp   mpp file structure
1576   !> @param[in] id_pivot pivot point index
1577   !-------------------------------------------------------------------
1578   FUNCTION grid__get_perio_mpp(td_mpp, id_pivot)
1579      IMPLICIT NONE
1580
1581      ! Argument     
1582      TYPE(TMPP) , INTENT(IN) :: td_mpp
1583      INTEGER(i4), INTENT(IN), OPTIONAL :: id_pivot
1584
1585      ! function
1586      INTEGER(i4) :: grid__get_perio_mpp
1587
1588      ! local variable
1589      INTEGER(i4)                       :: il_varid
1590      INTEGER(i4)                       :: il_pivot
1591      INTEGER(i4), DIMENSION(ip_maxdim) :: il_dim
1592
1593      TYPE(TVAR)                        :: tl_var
1594
1595      ! loop indices
1596      INTEGER(i4) :: ji
1597      !----------------------------------------------------------------
1598      ! initialise
1599      grid__get_perio_mpp=-1
1600
1601      IF(PRESENT(id_pivot) )THEN
1602         il_pivot=id_pivot
1603      ELSE
1604         il_pivot=grid_get_pivot(td_mpp)
1605      ENDIF
1606
1607      IF( il_pivot < 0 .OR. il_pivot > 1 )THEN
1608         CALL logger_error("GRID GET PERIO: invalid pivot point index. "//&
1609         &  "you should use grid_get_pivot to compute it")
1610      ENDIF
1611
1612      ! look for suitable variable
1613      il_varid=0
1614      DO ji=1,td_mpp%t_proc(1)%i_nvar
1615         IF( .NOT. ALL(td_mpp%t_proc(1)%t_var(ji)%t_dim(1:2)%l_use) ) CYCLE
1616         SELECT CASE(TRIM(fct_lower(td_mpp%t_proc(1)%t_var(ji)%c_stdname)) )
1617            CASE('longitude','latitude')
1618            CASE DEFAULT
1619               il_varid=ji
1620               EXIT
1621         END SELECT
1622      ENDDO
1623
1624      IF( il_varid==0 )THEN
1625     
1626         CALL logger_error("GRID GET PERIO: no suitable variable to compute "//&
1627         &              " periodicity in file "//TRIM(td_mpp%c_name))
1628      ELSE
1629 
1630         DO ji=1,ip_maxdim
1631            IF( td_mpp%t_proc(1)%t_var(il_varid)%t_dim(ji)%l_use )THEN
1632               il_dim(ji)=td_mpp%t_dim(ji)%i_len
1633            ELSE
1634               il_dim(ji)=1
1635            ENDIF
1636         ENDDO
1637
1638         ! read variable
1639         tl_var=iom_mpp_read_var(td_mpp, &
1640         &                       td_mpp%t_proc(1)%t_var(il_varid)%c_name, &
1641         &                       id_start=(/1,1,1,1/), &
1642         &                       id_count=(/il_dim(1),il_dim(2),1,1/) )
1643
1644         grid__get_perio_mpp=grid_get_perio(tl_var, il_pivot)
1645
1646         ! clean
1647         CALL var_clean(tl_var)
1648      ENDIF
1649
1650   END FUNCTION grid__get_perio_mpp
1651   !-------------------------------------------------------------------
1652   !> @brief This function get East-West overlap.
1653   !
1654   !> @details
1655   !> If no East-West wrap return -1,
1656   !> else return the size of the ovarlap band.
1657   !> East-West overlap is computed comparing longitude value of the 
1658   !> South" part of the domain, to avoid  north fold boundary.
1659   !>
1660   !
1661   !> @author J.Paul
1662   !> @date November, 2013 - Initial Version
1663   !> @date October, 2014
1664   !> - work on mpp file structure instead of file structure
1665   !>
1666   !> @param[in] td_lon longitude variable structure
1667   !> @return East West overlap
1668   !-------------------------------------------------------------------
1669   FUNCTION grid__get_ew_overlap_var(td_var)
1670      IMPLICIT NONE
1671      ! Argument     
1672      TYPE(TVAR), INTENT(INOUT) :: td_var
1673      ! function
1674      INTEGER(i4) :: grid__get_ew_overlap_var
1675
1676      ! local variable
1677      REAL(dp), DIMENSION(:,:), ALLOCATABLE :: dl_value
1678      REAL(dp), DIMENSION(:)  , ALLOCATABLE :: dl_vare
1679      REAL(dp), DIMENSION(:)  , ALLOCATABLE :: dl_varw
1680
1681      REAL(dp)    :: dl_delta
1682      REAL(dp)    :: dl_varmax
1683      REAL(dp)    :: dl_varmin
1684
1685      INTEGER(i4) :: il_east
1686      INTEGER(i4) :: il_west
1687      INTEGER(i4) :: il_jmin
1688      INTEGER(i4) :: il_jmax
1689
1690      INTEGER(i4), PARAMETER :: il_max_overlap = 5
1691
1692      ! loop indices
1693      INTEGER(i4) :: ji
1694      !----------------------------------------------------------------
1695      ! initialise
1696      grid__get_ew_overlap_var=-1
1697
1698      IF( ASSOCIATED(td_var%d_value) )THEN
1699         IF( td_var%t_dim(1)%i_len > 1 )THEN
1700            il_west=1
1701            il_east=td_var%t_dim(1)%i_len
1702
1703            ALLOCATE( dl_value(td_var%t_dim(1)%i_len, &
1704            &                  td_var%t_dim(2)%i_len) )
1705
1706            dl_value(:,:)=td_var%d_value(:,:,1,1)
1707
1708            ! we do not use jmax as dimension length due to north fold boundary
1709            il_jmin=1+ip_ghost
1710            il_jmax=(td_var%t_dim(2)%i_len-ip_ghost)/2
1711
1712            ALLOCATE( dl_vare(il_jmax-il_jmin+1) )
1713            ALLOCATE( dl_varw(il_jmax-il_jmin+1) )
1714           
1715            dl_vare(:)=dl_value(il_east,il_jmin:il_jmax)
1716            dl_varw(:)=dl_value(il_west,il_jmin:il_jmax)
1717           
1718            IF( .NOT.(  ALL(dl_vare(:)==td_var%d_fill) .AND. &
1719            &           ALL(dl_varw(:)==td_var%d_fill) ) )THEN
1720         
1721               IF( TRIM(td_var%c_stdname) == 'longitude' )THEN
1722                  WHERE( dl_value(:,:) > 180._dp .AND. &
1723                  &      dl_value(:,:) /= td_var%d_fill ) 
1724                     dl_value(:,:)=360.-dl_value(:,:)
1725                  END WHERE
1726
1727                  dl_varmax=MAXVAL(dl_value(:,il_jmin:il_jmax))
1728                  dl_varmin=MINVAL(dl_value(:,il_jmin:il_jmax))
1729
1730                  dl_delta=(dl_varmax-dl_varmin)/td_var%t_dim(1)%i_len
1731
1732                  IF( ALL(ABS(dl_vare(:)) - ABS(dl_varw(:)) == dl_delta) )THEN
1733                     grid__get_ew_overlap_var=0
1734                  ENDIF
1735               ENDIF
1736
1737               IF( grid__get_ew_overlap_var == -1 )THEN
1738                  DO ji=0,il_max_overlap
1739
1740                     IF( il_east-ji == il_west )THEN
1741                        ! case of small domain
1742                        EXIT
1743                     ELSE
1744                        dl_vare(:)=dl_value(il_east-ji,il_jmin:il_jmax)
1745                       
1746                        IF( ALL( dl_varw(:) == dl_vare(:) ) )THEN
1747                           grid__get_ew_overlap_var=ji+1
1748                           EXIT
1749                        ENDIF
1750                     ENDIF
1751
1752                  ENDDO
1753               ENDIF
1754            ENDIF
1755
1756         ENDIF
1757      ELSE
1758         CALL logger_error("GRID GET EW OVERLAP: input variable standard name"//&
1759         &  TRIM(td_var%c_stdname)//" can not be used to compute East West "//&
1760         &  "overalp. no value associated. ")
1761      ENDIF
1762
1763   END FUNCTION grid__get_ew_overlap_var
1764   !-------------------------------------------------------------------
1765   !> @brief This function get East-West overlap.
1766   !
1767   !> @details
1768   !> If no East-West wrap return -1,
1769   !> else return the size of the ovarlap band.
1770   !> East-West overlap is computed comparing longitude value of the 
1771   !> South" part of the domain, to avoid  north fold boundary.
1772   !>
1773   !> @author J.Paul
1774   !> @date October, 2014 - Initial Version
1775   !>
1776   !> @param[in] td_file file structure
1777   !> @return East West overlap
1778   !-------------------------------------------------------------------
1779   FUNCTION grid__get_ew_overlap_file(td_file)
1780      IMPLICIT NONE
1781      ! Argument     
1782      TYPE(TFILE), INTENT(INOUT) :: td_file
1783      ! function
1784      INTEGER(i4) :: grid__get_ew_overlap_file
1785
1786      ! local variable
1787      INTEGER(i4) :: il_varid
1788
1789      TYPE(TVAR)  :: tl_var
1790
1791      ! loop indices
1792      INTEGER(i4) :: ji
1793      !----------------------------------------------------------------
1794
1795      il_varid=var_get_index(td_file%t_var(:), 'longitude')
1796      IF( il_varid /= 0 )THEN
1797         ! read longitude on boundary
1798         tl_var=iom_read_var(td_file, 'longitude')
1799      ELSE
1800         DO ji=1,td_file%i_nvar
1801            IF( .NOT. ALL(td_file%t_var(ji)%t_dim(1:2)%l_use) ) CYCLE
1802
1803            tl_var=iom_read_var(td_file, td_file%t_var(ji)%c_name)
1804            EXIT
1805         ENDDO
1806      ENDIF
1807
1808      grid__get_ew_overlap_file=grid_get_ew_overlap(tl_var)
1809
1810      ! clean
1811      CALL var_clean(tl_var)
1812
1813   END FUNCTION grid__get_ew_overlap_file
1814   !-------------------------------------------------------------------
1815   !> @brief This function get East-West overlap.
1816   !
1817   !> @details
1818   !> If no East-West wrap return -1,
1819   !> else return the size of the ovarlap band.
1820   !> East-West overlap is computed comparing longitude value of the 
1821   !> South" part of the domain, to avoid  north fold boundary.
1822   !>
1823   !
1824   !> @author J.Paul
1825   !> @date November, 2013 - Initial Version
1826   !> @date October, 2014
1827   !> - work on mpp file structure instead of file structure
1828   !>
1829   !> @param[in] td_mpp mpp structure
1830   !> @return East West overlap
1831   !-------------------------------------------------------------------
1832   FUNCTION grid__get_ew_overlap_mpp(td_mpp)
1833      IMPLICIT NONE
1834      ! Argument     
1835      TYPE(TMPP), INTENT(INOUT) :: td_mpp
1836      ! function
1837      INTEGER(i4) :: grid__get_ew_overlap_mpp
1838
1839      ! local variable
1840      INTEGER(i4) :: il_ew
1841      INTEGER(i4) :: il_varid
1842
1843      TYPE(TVAR)  :: tl_var
1844      ! loop indices
1845      INTEGER(i4) :: ji
1846      !----------------------------------------------------------------
1847
1848      ! initialise
1849      grid__get_ew_overlap_mpp=td_mpp%i_ew
1850
1851      ! read longitude on boundary
1852      il_varid=var_get_index(td_mpp%t_proc(1)%t_var(:),'longitude')
1853      IF( il_varid /= 0 )THEN
1854         tl_var=iom_mpp_read_var(td_mpp, 'longitude')
1855      ELSE
1856         DO ji=1,td_mpp%t_proc(1)%i_nvar
1857            IF( .NOT. ALL(td_mpp%t_proc(1)%t_var(ji)%t_dim(1:2)%l_use) ) CYCLE
1858
1859            tl_var=iom_mpp_read_var(td_mpp, td_mpp%t_proc(1)%t_var(ji)%c_name)
1860            EXIT
1861         ENDDO         
1862      ENDIF
1863
1864      il_ew=grid_get_ew_overlap(tl_var)
1865      IF( il_ew >= 0 )THEN
1866         grid__get_ew_overlap_mpp=il_ew
1867      ENDIF
1868
1869
1870      ! clean
1871      CALL var_clean(tl_var)
1872
1873   END FUNCTION grid__get_ew_overlap_mpp
1874   !-------------------------------------------------------------------
1875   !> @brief This subroutine check if there is north fold.
1876   !>
1877   !> @details
1878   !> check if maximum latitude greater than 88°N
1879   !>
1880   !> @author J.Paul
1881   !> @date November, 2013 - Initial Version
1882   !>
1883   !> @param[in] td_lat latitude variable structure
1884   !-------------------------------------------------------------------
1885   LOGICAL FUNCTION grid_is_north_fold(td_lat)
1886      IMPLICIT NONE
1887      ! Argument     
1888      TYPE(TVAR), INTENT(IN) :: td_lat
1889
1890      ! local variable
1891      ! loop indices
1892      !----------------------------------------------------------------
1893   
1894      ! init
1895      grid_is_north_fold=.FALSE.
1896
1897      IF( .NOT. ASSOCIATED(td_lat%d_value) )THEN
1898         CALL logger_error("GRID IS NORTH FOLD: "//&
1899         &                 " no value associated to latitude")
1900      ELSE     
1901         IF( MAXVAL(td_lat%d_value(:,:,:,:), &
1902         &          td_lat%d_value(:,:,:,:)/= td_lat%d_fill) >= 88.0 )THEN
1903
1904            grid_is_north_fold=.TRUE.
1905           
1906         ENDIF
1907      ENDIF
1908
1909   END FUNCTION grid_is_north_fold
1910   !-------------------------------------------------------------------
1911   !> @brief This subroutine check domain validity.
1912   !
1913   !> @details
1914   !> If maximum latitude greater than 88°N, program will stop.
1915   !> @note Not able to manage north fold for now.
1916   !
1917   !> @author J.Paul
1918   !> @date November, 2013 - Initial Version
1919   !> @date October, 2014
1920   !> - work on mpp file structure instead of file structure
1921   !
1922   !> @param[in] cd_coord  coordinate file
1923   !> @param[in] id_imin   i-direction lower left  point indice 
1924   !> @param[in] id_imax   i-direction upper right point indice
1925   !> @param[in] id_jmin   j-direction lower left  point indice
1926   !> @param[in] id_jmax   j-direction upper right point indice
1927   !-------------------------------------------------------------------
1928   SUBROUTINE grid_check_dom(td_coord, id_imin, id_imax, id_jmin, id_jmax)
1929      IMPLICIT NONE
1930      ! Argument     
1931      TYPE(TMPP) , INTENT(IN) :: td_coord
1932      INTEGER(i4), INTENT(IN) :: id_imin
1933      INTEGER(i4), INTENT(IN) :: id_imax
1934      INTEGER(i4), INTENT(IN) :: id_jmin
1935      INTEGER(i4), INTENT(IN) :: id_jmax
1936
1937      ! local variable
1938      TYPE(TVAR) :: tl_var
1939
1940      TYPE(TMPP) :: tl_coord
1941
1942      TYPE(TDOM) :: tl_dom
1943      ! loop indices
1944      !----------------------------------------------------------------
1945
1946      IF( id_jmin > id_jmax .OR. id_jmax == 0 )THEN
1947
1948         CALL logger_fatal("GRID CHECK DOM: invalid domain. "//&
1949         &  "can not create configuration with north pole.")
1950
1951      ELSE
1952
1953            IF( id_imin == id_imax .AND. td_coord%i_ew < 0 )THEN
1954               CALL logger_fatal("GRID CHECK DOM: invalid domain."//&
1955               &  " can not create east-west cyclic fine grid"//&
1956               &  " inside closed coarse grid")
1957            ENDIF
1958
1959            ! copy structure
1960            tl_coord=mpp_copy(td_coord)
1961
1962            ! compute domain
1963            tl_dom=dom_init( tl_coord,        &
1964            &                id_imin, id_imax,&
1965            &                id_jmin, id_jmax )
1966           
1967            ! open mpp files to be used
1968            CALL iom_dom_open(tl_coord, tl_dom)
1969
1970            ! read variable value on domain
1971            tl_var=iom_dom_read_var(tl_coord,'latitude',tl_dom)
1972
1973            ! close mpp files
1974            CALL iom_dom_close(tl_coord)
1975
1976            ! clean structure
1977            CALL mpp_clean(tl_coord)
1978
1979            IF( MAXVAL(tl_var%d_value(:,:,:,:), &
1980            &          tl_var%d_value(:,:,:,:)/= tl_var%d_fill) >= 88.0 )THEN
1981               
1982               CALL logger_debug("GRID CHECK DOM: max latitude "//&
1983               &  TRIM(fct_str(MAXVAL(tl_var%d_value(:,:,:,:)))) )
1984               CALL logger_fatal("GRID CHECK DOM: invalid domain. "//&
1985               &  "can not create configuration too close from north pole.")
1986
1987            ENDIF
1988
1989            ! clean
1990            CALL dom_clean(tl_dom)
1991            CALL var_clean(tl_var)
1992
1993      ENDIF
1994
1995   END SUBROUTINE grid_check_dom
1996   !-------------------------------------------------------------------
1997   !> @brief This function get closest coarse grid indices of fine grid domain.
1998   !
1999   !> @details
2000   !> it use coarse and fine grid coordinates files.
2001   !> optionally, you could specify the array of refinment factor (default 1.)
2002   !> optionally, you could specify on which Arakawa grid point you want to
2003   !> work (default 'T')
2004   !>
2005   !> @author J.Paul
2006   !> @date November, 2013 - Initial Version
2007   !> @date September, 2014
2008   !> - use grid point to read coordinates variable.
2009   !> @date October, 2014
2010   !> - work on mpp file structure instead of file structure
2011   !> @date February, 2015
2012   !> - use longitude or latitude as standard name, if can not find
2013   !> longitude_T, latitude_T...
2014   !>
2015   !> @param[in] td_coord0 coarse grid coordinate mpp structure
2016   !> @param[in] td_coord1 fine grid coordinate mpp structure
2017   !> @param[in] id_rho    array of refinment factor (default 1.)
2018   !> @param[in] cd_point  Arakawa grid point (default 'T').
2019   !> @return coarse grid indices(/(/imin0, imax0/), (/jmin0, jmax0/)/)
2020   !>                                     
2021   !-------------------------------------------------------------------
2022   FUNCTION grid__get_coarse_index_ff( td_coord0, td_coord1, &
2023   &                                   id_rho, cd_point )
2024      IMPLICIT NONE
2025      ! Argument
2026      TYPE(TMPP)                    , INTENT(IN) :: td_coord0
2027      TYPE(TMPP)                    , INTENT(IN) :: td_coord1
2028      INTEGER(i4)     , DIMENSION(:), INTENT(IN), OPTIONAL :: id_rho
2029      CHARACTER(LEN=*)              , INTENT(IN), OPTIONAL :: cd_point
2030
2031      ! function
2032      INTEGER(i4), DIMENSION(2,2) :: grid__get_coarse_index_ff
2033
2034      ! local variable
2035      CHARACTER(LEN= 1)                        :: cl_point
2036      CHARACTER(LEN=lc)                        :: cl_name
2037
2038      INTEGER(i4)                              :: il_imin0
2039      INTEGER(i4)                              :: il_imax0
2040      INTEGER(i4)                              :: il_jmin0
2041      INTEGER(i4)                              :: il_jmax0
2042      INTEGER(i4)                              :: il_ind
2043
2044      INTEGER(i4), DIMENSION(2,2)              :: il_xghost0
2045      INTEGER(i4), DIMENSION(2,2)              :: il_xghost1
2046
2047      INTEGER(i4), DIMENSION(:)  , ALLOCATABLE :: il_rho
2048
2049      TYPE(TVAR)                               :: tl_lon0
2050      TYPE(TVAR)                               :: tl_lat0
2051      TYPE(TVAR)                               :: tl_lon1
2052      TYPE(TVAR)                               :: tl_lat1
2053
2054      TYPE(TMPP)                               :: tl_coord0
2055      TYPE(TMPP)                               :: tl_coord1
2056
2057      ! loop indices
2058      !----------------------------------------------------------------
2059
2060      ! init
2061      grid__get_coarse_index_ff(:,:)=0
2062
2063      ALLOCATE(il_rho(ip_maxdim))
2064      il_rho(:)=1
2065      IF( PRESENT(id_rho) ) il_rho(:)=id_rho(:)
2066
2067      cl_point='T'
2068      IF( PRESENT(cd_point) ) cl_point=TRIM(fct_upper(cd_point))
2069
2070      ! copy structure
2071      tl_coord0=mpp_copy(td_coord0)
2072      tl_coord1=mpp_copy(td_coord1)
2073
2074      IF( .NOT. ASSOCIATED(tl_coord0%t_proc) .OR. &
2075      &   .NOT. ASSOCIATED(tl_coord1%t_proc) )THEN
2076         CALL logger_error("GRID GET COARSE INDEX: can not get coarse "//&
2077         &  "grid indices. decompsition of mpp file "//TRIM(tl_coord0%c_name)//&
2078         &  " and/or "//TRIM(tl_coord1%c_name)//" not defined." )
2079      ELSE
2080         ! Coarse grid
2081         ! get ghost cell factor on coarse grid
2082         il_xghost0(:,:)=grid_get_ghost( tl_coord0 )
2083
2084         ! open mpp files
2085         CALL iom_mpp_open(tl_coord0)
2086
2087         ! read coarse longitue and latitude
2088         WRITE(cl_name,*) 'longitude_'//TRIM(cl_point)
2089         il_ind=var_get_id(tl_coord0%t_proc(1)%t_var(:), cl_name)
2090         IF( il_ind == 0 )THEN
2091            CALL logger_warn("GRID GET COARSE INDEX: no variable "//&
2092            &  TRIM(cl_name)//" in file "//TRIM(tl_coord0%c_name)//". &
2093            &  try to use longitude.")
2094            WRITE(cl_name,*) 'longitude'
2095         ENDIF
2096         tl_lon0=iom_mpp_read_var(tl_coord0, TRIM(cl_name))
2097
2098         WRITE(cl_name,*) 'latitude_'//TRIM(cl_point)
2099         il_ind=var_get_id(tl_coord0%t_proc(1)%t_var(:), cl_name)
2100         IF( il_ind == 0 )THEN
2101            CALL logger_warn("GRID GET COARSE INDEX: no variable "//&
2102            &  TRIM(cl_name)//" in file "//TRIM(tl_coord0%c_name)//". &
2103            &  try to use latitude.")
2104            WRITE(cl_name,*) 'latitude'
2105         ENDIF
2106         tl_lat0=iom_mpp_read_var(tl_coord0, TRIM(cl_name))
2107         
2108         CALL grid_del_ghost(tl_lon0, il_xghost0(:,:))
2109         CALL grid_del_ghost(tl_lat0, il_xghost0(:,:))
2110
2111         ! close mpp files
2112         CALL iom_mpp_close(tl_coord0)
2113
2114         ! Fine grid
2115
2116         ! get ghost cell factor on fine grid
2117         il_xghost1(:,:)=grid_get_ghost( tl_coord1 )
2118
2119         ! open mpp files
2120         CALL iom_mpp_open(tl_coord1)
2121
2122         ! read fine longitue and latitude
2123         WRITE(cl_name,*) 'longitude_'//TRIM(cl_point)
2124         il_ind=var_get_id(tl_coord1%t_proc(1)%t_var(:), cl_name)
2125         IF( il_ind == 0 )THEN
2126            CALL logger_warn("GRID GET COARSE INDEX: no variable "//&
2127            &  TRIM(cl_name)//" in file "//TRIM(tl_coord1%c_name)//". &
2128            &  try to use longitude.")
2129            WRITE(cl_name,*) 'longitude'
2130         ENDIF
2131         tl_lon1=iom_mpp_read_var(tl_coord1, TRIM(cl_name)) 
2132
2133         WRITE(cl_name,*) 'latitude_'//TRIM(cl_point)
2134         il_ind=var_get_id(tl_coord1%t_proc(1)%t_var(:), cl_name)
2135         IF( il_ind == 0 )THEN
2136            CALL logger_warn("GRID GET COARSE INDEX: no variable "//&
2137            &  TRIM(cl_name)//" in file "//TRIM(tl_coord1%c_name)//". &
2138            &  try to use latitude.")
2139            WRITE(cl_name,*) 'latitude'
2140         ENDIF
2141         tl_lat1=iom_mpp_read_var(tl_coord1, TRIM(cl_name))
2142 
2143         CALL grid_del_ghost(tl_lon1, il_xghost1(:,:))
2144         CALL grid_del_ghost(tl_lat1, il_xghost1(:,:))
2145
2146         ! close mpp files
2147         CALL iom_mpp_close(tl_coord1)
2148
2149         ! compute
2150         grid__get_coarse_index_ff(:,:)=grid_get_coarse_index(tl_lon0,tl_lat0,&
2151         &                                                    tl_lon1,tl_lat1,&
2152         &                                                    il_rho(:) )
2153
2154         ! add ghost cell to indices
2155         il_imin0=grid__get_coarse_index_ff(1,1)+il_xghost0(jp_I,1)*ip_ghost
2156         il_imax0=grid__get_coarse_index_ff(1,2)+il_xghost0(jp_I,1)*ip_ghost
2157
2158         il_jmin0=grid__get_coarse_index_ff(2,1)+il_xghost0(jp_J,1)*ip_ghost
2159         il_jmax0=grid__get_coarse_index_ff(2,2)+il_xghost0(jp_J,1)*ip_ghost
2160
2161         grid__get_coarse_index_ff(jp_I,1)=il_imin0
2162         grid__get_coarse_index_ff(jp_I,2)=il_imax0
2163         grid__get_coarse_index_ff(jp_J,1)=il_jmin0
2164         grid__get_coarse_index_ff(jp_J,2)=il_jmax0
2165
2166         CALL var_clean(tl_lon0)
2167         CALL var_clean(tl_lat0)         
2168         CALL var_clean(tl_lon1)
2169         CALL var_clean(tl_lat1)         
2170
2171      ENDIF
2172
2173      ! clean
2174      CALL mpp_clean(tl_coord0)
2175      CALL mpp_clean(tl_coord1)
2176      DEALLOCATE(il_rho)
2177
2178   END FUNCTION grid__get_coarse_index_ff
2179   !-------------------------------------------------------------------
2180   !> @brief This function get closest coarse grid indices of fine grid domain.
2181   !
2182   !> @details
2183   !> it use coarse array of longitude and latitude and fine grid coordinates file.
2184   !> optionaly, you could specify the array of refinment factor (default 1.)
2185   !> optionally, you could specify on which Arakawa grid point you want to
2186   !> work (default 'T')
2187   !>
2188   !> @author J.Paul
2189   !> @date November, 2013 - Initial Version
2190   !> @date September, 2014
2191   !> - use grid point to read coordinates variable.
2192   !> @date October, 2014
2193   !> - work on mpp file structure instead of file structure
2194   !> @date February, 2015
2195   !> - use longitude or latitude as standard name, if can not find
2196   !> longitude_T, latitude_T...
2197   !>
2198   !> @param[in] td_longitude0   coarse grid longitude
2199   !> @param[in] td_latitude0    coarse grid latitude
2200   !> @param[in] td_coord1       fine grid coordinate mpp structure
2201   !> @param[in] id_rho          array of refinment factor
2202   !> @param[in] cd_point        Arakawa grid point (default 'T')
2203   !> @return coarse grid indices (/(/imin0, imax0/), (/jmin0, jmax0/)/)
2204   !-------------------------------------------------------------------
2205   FUNCTION grid__get_coarse_index_cf( td_lon0, td_lat0, td_coord1, &
2206   &                                   id_rho, cd_point )
2207      IMPLICIT NONE
2208      ! Argument
2209      TYPE(TVAR )                   , INTENT(IN) :: td_lon0
2210      TYPE(TVAR )                   , INTENT(IN) :: td_lat0
2211      TYPE(TMPP )                   , INTENT(IN) :: td_coord1
2212      INTEGER(i4)     , DIMENSION(:), INTENT(IN), OPTIONAL :: id_rho
2213      CHARACTER(LEN=*)              , INTENT(IN), OPTIONAL :: cd_point
2214
2215      ! function
2216      INTEGER(i4), DIMENSION(2,2) :: grid__get_coarse_index_cf
2217
2218      ! local variable
2219      CHARACTER(LEN= 1)                        :: cl_point
2220      CHARACTER(LEN=lc)                        :: cl_name
2221
2222      INTEGER(i4)                              :: il_ind
2223
2224      INTEGER(i4), DIMENSION(:)  , ALLOCATABLE :: il_rho
2225
2226      INTEGER(i4), DIMENSION(2,2)              :: il_xghost
2227
2228      TYPE(TVAR)                               :: tl_lon1
2229      TYPE(TVAR)                               :: tl_lat1
2230
2231      TYPE(TMPP)                               :: tl_coord1
2232
2233      ! loop indices
2234      !----------------------------------------------------------------
2235
2236      ! init
2237      grid__get_coarse_index_cf(:,:)=0
2238
2239      ALLOCATE(il_rho(ip_maxdim) )
2240      il_rho(:)=1
2241      IF( PRESENT(id_rho) ) il_rho(:)=id_rho(:)
2242
2243      ! copy structure
2244      tl_coord1=mpp_copy(td_coord1)
2245     
2246      cl_point='T'
2247      IF( PRESENT(cd_point) ) cl_point=TRIM(fct_upper(cd_point))
2248
2249      IF( .NOT. ASSOCIATED(tl_coord1%t_proc) )THEN
2250         CALL logger_error("GRID GET COARSE INDEX: decompsition of mpp "//&
2251         &  "file "//TRIM(tl_coord1%c_name)//" not defined." )
2252
2253      ELSE IF( .NOT. ASSOCIATED(td_lon0%d_value) .OR. &
2254      &        .NOT. ASSOCIATED(td_lat0%d_value) )THEN
2255
2256         CALL logger_error("GRID GET COARSE INDEX: some coarse grid"//&
2257         &                 " coordinate value are not associated.")         
2258
2259      ELSE
2260         
2261         IF( TRIM(td_lon0%c_point)/='' )THEN
2262            cl_point=TRIM(td_lon0%c_point)
2263         ELSEIF( TRIM(td_lat0%c_point)/='' )THEN
2264            cl_point=TRIM(td_lat0%c_point)
2265         ENDIF
2266
2267         ! Fine grid
2268         ! get ghost cell factor on fine grid
2269         il_xghost(:,:)=grid_get_ghost( tl_coord1 )
2270
2271         ! open mpp files
2272         CALL iom_mpp_open(tl_coord1)
2273
2274         ! read fine longitue and latitude
2275         WRITE(cl_name,*) 'longitude_'//TRIM(cl_point)
2276         il_ind=var_get_id(tl_coord1%t_proc(1)%t_var(:), cl_name)
2277         IF( il_ind == 0 )THEN
2278            CALL logger_warn("GRID GET COARSE INDEX: no variable "//&
2279            &  TRIM(cl_name)//"in file "//TRIM(tl_coord1%c_name)//". &
2280            &  try to use longitude.")
2281            WRITE(cl_name,*) 'longitude'
2282         ENDIF
2283         tl_lon1=iom_mpp_read_var(tl_coord1, TRIM(cl_name))
2284
2285         WRITE(cl_name,*) 'latitude_'//TRIM(cl_point)
2286         il_ind=var_get_id(tl_coord1%t_proc(1)%t_var(:), cl_name)
2287         IF( il_ind == 0 )THEN
2288            CALL logger_warn("GRID GET COARSE INDEX: no variable "//&
2289            &  TRIM(cl_name)//"in file "//TRIM(tl_coord1%c_name)//". &
2290            &  try to use longitude.")
2291            WRITE(cl_name,*) 'latitude'
2292         ENDIF
2293         tl_lat1=iom_mpp_read_var(tl_coord1, TRIM(cl_name))
2294         
2295         CALL grid_del_ghost(tl_lon1, il_xghost(:,:))
2296         CALL grid_del_ghost(tl_lat1, il_xghost(:,:))
2297
2298         ! close mpp files
2299         CALL iom_mpp_close(tl_coord1)
2300
2301         ! compute
2302         grid__get_coarse_index_cf(:,:)=grid_get_coarse_index(td_lon0,td_lat0,&
2303         &                                                    tl_lon1,tl_lat1,&
2304         &                                                    il_rho(:), cl_point )
2305
2306         CALL var_clean(tl_lon1)
2307         CALL var_clean(tl_lat1)         
2308
2309      ENDIF
2310
2311      DEALLOCATE(il_rho)
2312      CALL mpp_clean(tl_coord1)
2313
2314   END FUNCTION grid__get_coarse_index_cf
2315   !-------------------------------------------------------------------
2316   !> @brief This function get closest coarse grid indices of fine grid domain.
2317   !
2318   !> @details
2319   !> it use coarse grid coordinates file and fine grid array of longitude and latitude.
2320   !> optionaly, you could specify the array of refinment factor (default 1.)
2321   !> optionally, you could specify on which Arakawa grid point you want to
2322   !> work (default 'T')
2323   !>
2324   !> @author J.Paul
2325   !> @date November, 2013 - Initial Version
2326   !> @date September, 2014
2327   !> - use grid point to read coordinates variable.
2328   !> @date October, 2014
2329   !> - work on mpp file structure instead of file structure
2330   !> @date February, 2015
2331   !> - use longitude or latitude as standard name, if can not find
2332   !> longitude_T, latitude_T...
2333   !>
2334   !> @param[in] td_coord0 coarse grid coordinate mpp structure
2335   !> @param[in] td_lon1   fine grid longitude
2336   !> @param[in] td_lat1   fine grid latitude
2337   !> @param[in] id_rho    array of refinment factor (default 1.)
2338   !> @param[in] cd_point  Arakawa grid point (default 'T')
2339   !> @return coarse grid indices (/(/imin0, imax0/), (/jmin0, jmax0/)/)
2340   !-------------------------------------------------------------------
2341   FUNCTION grid__get_coarse_index_fc( td_coord0, td_lon1, td_lat1, &
2342   &                                  id_rho, cd_point )
2343      IMPLICIT NONE
2344      ! Argument
2345      TYPE(TMPP )                   , INTENT(IN) :: td_coord0
2346      TYPE(TVAR )                   , INTENT(IN) :: td_lon1
2347      TYPE(TVAR )                   , INTENT(IN) :: td_lat1
2348      INTEGER(i4)     , DIMENSION(:), INTENT(IN), OPTIONAL :: id_rho
2349      CHARACTER(LEN=*)              , INTENT(IN), OPTIONAL :: cd_point
2350
2351      ! function
2352      INTEGER(i4), DIMENSION(2,2) :: grid__get_coarse_index_fc
2353
2354      ! local variable
2355      CHARACTER(LEN= 1)                        :: cl_point
2356      CHARACTER(LEN=lc)                        :: cl_name     
2357
2358      INTEGER(i4)                              :: il_imin0
2359      INTEGER(i4)                              :: il_imax0
2360      INTEGER(i4)                              :: il_jmin0
2361      INTEGER(i4)                              :: il_jmax0
2362      INTEGER(i4)                              :: il_ind
2363
2364      INTEGER(i4), DIMENSION(:), ALLOCATABLE   :: il_rho
2365
2366      INTEGER(i4), DIMENSION(2,2)              :: il_xghost
2367
2368      TYPE(TVAR)                               :: tl_lon0
2369      TYPE(TVAR)                               :: tl_lat0
2370
2371      TYPE(TMPP)                               :: tl_coord0
2372
2373      ! loop indices
2374      !----------------------------------------------------------------
2375
2376      ! init
2377      grid__get_coarse_index_fc(:,:)=0
2378
2379      ALLOCATE(il_rho(ip_maxdim))
2380      il_rho(:)=1
2381      IF( PRESENT(id_rho) ) il_rho(:)=id_rho(:)
2382
2383      cl_point='T'
2384      IF( PRESENT(cd_point) ) cl_point=TRIM(fct_upper(cd_point))
2385
2386      ! copy structure
2387      tl_coord0=mpp_copy(td_coord0)
2388
2389      IF( .NOT. ASSOCIATED(tl_coord0%t_proc) )THEN
2390         CALL logger_error("GRID GET COARSE INDEX: decompsition of mpp "//&
2391         &  "file "//TRIM(tl_coord0%c_name)//" not defined." )
2392
2393      ELSE IF( .NOT. ASSOCIATED(td_lon1%d_value) .OR. &
2394      &        .NOT. ASSOCIATED(td_lat1%d_value) )THEN
2395
2396         CALL logger_error("GRID GET COARSE INDEX: some fine grid"//&
2397         &                 " coordinate value are not associated.")
2398
2399      ELSE
2400
2401         IF( TRIM(td_lon1%c_point)/='' )THEN
2402            cl_point=TRIM(td_lon1%c_point)
2403         ELSEIF( TRIM(td_lat1%c_point)/='' )THEN
2404            cl_point=TRIM(td_lat1%c_point)
2405         ENDIF
2406
2407         ! get ghost cell factor on coarse grid
2408         il_xghost(:,:)=grid_get_ghost( tl_coord0 )
2409
2410         ! open mpp files
2411         CALL iom_mpp_open(tl_coord0)
2412
2413         ! read coarse longitue and latitude
2414         WRITE(cl_name,*) 'longitude_'//TRIM(cl_point)
2415         il_ind=var_get_id(tl_coord0%t_proc(1)%t_var(:), cl_name)
2416         IF( il_ind == 0 )THEN
2417            CALL logger_warn("GRID GET COARSE INDEX: no variable "//&
2418            &  TRIM(cl_name)//"in file "//TRIM(tl_coord0%c_name)//". &
2419            &  try to use longitude.")
2420            WRITE(cl_name,*) 'longitude'
2421         ENDIF
2422         tl_lon0=iom_mpp_read_var(tl_coord0, TRIM(cl_name))
2423         
2424         WRITE(cl_name,*) 'latitude_'//TRIM(cl_point)
2425         il_ind=var_get_id(tl_coord0%t_proc(1)%t_var(:), cl_name)
2426         IF( il_ind == 0 )THEN
2427            CALL logger_warn("GRID GET COARSE INDEX: no variable "//&
2428            &  TRIM(cl_name)//"in file "//TRIM(tl_coord0%c_name)//". &
2429            &  try to use latitude.")
2430            WRITE(cl_name,*) 'latitude'
2431         ENDIF
2432         tl_lat0=iom_mpp_read_var(tl_coord0, TRIM(cl_name))
2433
2434         CALL grid_del_ghost(tl_lon0, il_xghost(:,:))
2435         CALL grid_del_ghost(tl_lat0, il_xghost(:,:))
2436
2437         ! close mpp files
2438         CALL iom_mpp_close(tl_coord0)
2439
2440         grid__get_coarse_index_fc(:,:)=grid_get_coarse_index(tl_lon0,tl_lat0,&
2441         &                                                    td_lon1,td_lat1,&
2442         &                                                    il_rho(:), cl_point )
2443
2444         ! remove ghost cell
2445         il_imin0=grid__get_coarse_index_fc(1,1)+il_xghost(jp_I,1)*ip_ghost
2446         il_imax0=grid__get_coarse_index_fc(1,2)+il_xghost(jp_I,1)*ip_ghost
2447
2448         il_jmin0=grid__get_coarse_index_fc(2,1)+il_xghost(jp_J,1)*ip_ghost
2449         il_jmax0=grid__get_coarse_index_fc(2,2)+il_xghost(jp_J,1)*ip_ghost
2450
2451         grid__get_coarse_index_fc(1,1)=il_imin0
2452         grid__get_coarse_index_fc(1,2)=il_imax0
2453         grid__get_coarse_index_fc(2,1)=il_jmin0
2454         grid__get_coarse_index_fc(2,2)=il_jmax0
2455
2456         CALL var_clean(tl_lon0)
2457         CALL var_clean(tl_lat0)
2458
2459      ENDIF
2460
2461      CALL mpp_clean(tl_coord0)
2462      DEALLOCATE(il_rho)
2463
2464   END FUNCTION grid__get_coarse_index_fc
2465   !-------------------------------------------------------------------
2466   !> @brief This function get closest coarse grid indices of fine grid domain.
2467   !
2468   !> @details
2469   !> it use coarse and fine grid array of longitude and latitude.
2470   !> optionaly, you could specify the array of refinment factor (default 1.)
2471   !> optionally, you could specify on which Arakawa grid point you want to
2472   !> work (default 'T')
2473   !>
2474   !> @note do not use ghost cell
2475   !>
2476   !> @author J.Paul
2477   !> @date November, 2013 - Initial Version
2478   !> @date September, 2014
2479   !> - check grid point
2480   !> - take into account EW overlap
2481   !> @date February, 2016
2482   !> - use delta (lon or lat)
2483   !> - manage cases for T,U,V or F point, with even or odd refinment
2484   !>
2485   !> @param[in] td_lon0   coarse grid longitude
2486   !> @param[in] td_lat0   coarse grid latitude
2487   !> @param[in] td_lon1   fine grid longitude
2488   !> @param[in] td_lat1   fine grid latitude
2489   !> @param[in] id_rho    array of refinment factor
2490   !> @param[in] cd_point  Arakawa grid point ('T','U','V','F')
2491   !> @return coarse grid indices (/(/imin0, imax0/), (/jmin0, jmax0/)/)
2492   !>
2493   !> @todo
2494   !> -check case boundary domain on overlap band
2495   !-------------------------------------------------------------------
2496   FUNCTION grid__get_coarse_index_cc( td_lon0, td_lat0, td_lon1, td_lat1, &
2497   &                                   id_rho, cd_point )
2498      IMPLICIT NONE
2499      ! Argument
2500      TYPE(TVAR)                    , INTENT(IN) :: td_lon0
2501      TYPE(TVAR)                    , INTENT(IN) :: td_lat0
2502      TYPE(TVAR)                    , INTENT(IN) :: td_lon1
2503      TYPE(TVAR)                    , INTENT(IN) :: td_lat1
2504      INTEGER(i4)     , DIMENSION(:), INTENT(IN), OPTIONAL :: id_rho
2505      CHARACTER(LEN=*)              , INTENT(IN), OPTIONAL :: cd_point
2506
2507      ! function
2508      INTEGER(i4), DIMENSION(2,2) :: grid__get_coarse_index_cc
2509
2510      ! local variable
2511      CHARACTER(LEN= 1)                      :: cl_point0
2512      CHARACTER(LEN= 1)                      :: cl_point1
2513
2514      LOGICAL    , DIMENSION(2)              :: ll_even
2515
2516      REAL(dp)                               :: dl_lon1
2517      REAL(dp)                               :: dl_dlon
2518      REAL(dp)                               :: dl_lat1
2519      REAL(dp)                               :: dl_dlat
2520
2521      INTEGER(i4)                            :: il_ew0 
2522      INTEGER(i4)                            :: il_imin0
2523      INTEGER(i4)                            :: il_imax0
2524      INTEGER(i4)                            :: il_jmin0
2525      INTEGER(i4)                            :: il_jmax0
2526
2527      INTEGER(i4)                            :: il_ew1 
2528      INTEGER(i4)                            :: il_imin1
2529      INTEGER(i4)                            :: il_imax1
2530      INTEGER(i4)                            :: il_jmin1
2531      INTEGER(i4)                            :: il_jmax1
2532
2533      INTEGER(i4)                            :: il_imin
2534      INTEGER(i4)                            :: il_imax
2535      INTEGER(i4)                            :: il_jmin
2536      INTEGER(i4)                            :: il_jmax     
2537
2538      INTEGER(i4), DIMENSION(:), ALLOCATABLE :: il_rho
2539
2540      INTEGER(i4), DIMENSION(2)              :: il_ill
2541      INTEGER(i4), DIMENSION(2)              :: il_ilr
2542      INTEGER(i4), DIMENSION(2)              :: il_iul
2543      INTEGER(i4), DIMENSION(2)              :: il_iur
2544
2545      INTEGER(i4), DIMENSION(2,2)            :: il_xghost0
2546      INTEGER(i4), DIMENSION(2,2)            :: il_yghost0
2547      INTEGER(i4), DIMENSION(2,2)            :: il_xghost1
2548      INTEGER(i4), DIMENSION(2,2)            :: il_yghost1
2549
2550      TYPE(TVAR)                             :: tl_lon0
2551      TYPE(TVAR)                             :: tl_lat0
2552      TYPE(TVAR)                             :: tl_lon1
2553      TYPE(TVAR)                             :: tl_lat1
2554
2555      ! loop indices
2556      !----------------------------------------------------------------
2557      ! init
2558      grid__get_coarse_index_cc(:,:)=0
2559
2560      ALLOCATE( il_rho(ip_maxdim) )
2561      il_rho(:)=1
2562      IF( PRESENT(id_rho) ) il_rho(:)=id_rho(:)
2563
2564      ll_even(:)=(/ (MOD(id_rho(jp_I),2)==0), (MOD(id_rho(jp_J),2)==0) /)
2565
2566      cl_point0='T'
2567      cl_point1='T'
2568      IF( PRESENT(cd_point) )THEN
2569         cl_point0=TRIM(fct_upper(cd_point))
2570         cl_point1=TRIM(fct_upper(cd_point))
2571      ENDIF
2572     
2573      IF( .NOT. ASSOCIATED(td_lon0%d_value) .OR. &
2574      &   .NOT. ASSOCIATED(td_lat0%d_value) .OR. &
2575      &   .NOT. ASSOCIATED(td_lon1%d_value) .OR. &
2576      &   .NOT. ASSOCIATED(td_lat1%d_value) )THEN
2577         CALL logger_error("GRID GET COARSE INDEX: some fine or coarse grid"//&
2578         &                 " coordinate value not associated.")
2579      ELSE
2580
2581         IF( TRIM(td_lon0%c_point)/='' )THEN
2582            cl_point0=TRIM(td_lon0%c_point)
2583         ELSEIF( TRIM(td_lat0%c_point)/='' )THEN
2584            cl_point0=TRIM(td_lat0%c_point)
2585         ENDIF
2586         IF( TRIM(td_lon1%c_point)/='' )THEN
2587            cl_point1=TRIM(td_lon1%c_point)
2588         ELSEIF( TRIM(td_lat1%c_point)/='' )THEN
2589            cl_point1=TRIM(td_lat1%c_point)
2590         ENDIF
2591         IF( cl_point0 /= cl_point1 )THEN
2592            CALL logger_error("GRID GET COARSE INDEX: fine and coarse grid"//&
2593         &                 " coordinate not on same grid point.")
2594         ENDIF
2595
2596         IF( grid_is_global(td_lon1, td_lat1) )THEN
2597
2598            IF( grid_is_global(td_lon0, td_lat0) )THEN
2599               CALL logger_trace("GRID GET COARSE INDEX: fine grid is global ")
2600               grid__get_coarse_index_cc(:,:) = 1
2601               grid__get_coarse_index_cc(:,:) = 0
2602            ELSE
2603               CALL logger_error("GRID GET COARSE INDEX: fine grid is "//&
2604               &                 "global, coarse grid not.")
2605            ENDIF
2606
2607         ELSE
2608
2609            il_xghost0(:,:)=grid_get_ghost( td_lon0 )
2610            il_yghost0(:,:)=grid_get_ghost( td_lat0 )
2611            IF( ANY(il_xghost0(:,:) /= il_yghost0(:,:)) )THEN
2612               CALL logger_error("GRID GET COARSE INDEX: coarse grid "//&
2613               &        "coordinate do not share same ghost cell")
2614            ENDIF
2615
2616            tl_lon0=var_copy(td_lon0)
2617            tl_lat0=var_copy(td_lat0)
2618            CALL grid_del_ghost(tl_lon0, il_xghost0(:,:))
2619            CALL grid_del_ghost(tl_lat0, il_xghost0(:,:))
2620 
2621            ! "global" coarse grid indice
2622            il_imin0=1
2623            il_jmin0=1
2624
2625            il_imax0=tl_lon0%t_dim(1)%i_len
2626            il_jmax0=tl_lon0%t_dim(2)%i_len
2627
2628            ! get east west overlap for coarse grid
2629            il_ew0=tl_lon0%i_ew
2630            IF( il_ew0 >= 0 )THEN
2631               ! last point before overlap
2632               il_imax0=il_imax0-il_ew0
2633            ENDIF
2634
2635            il_xghost1(:,:)=grid_get_ghost( td_lon1 )
2636            il_yghost1(:,:)=grid_get_ghost( td_lat1 )
2637            IF( ANY(il_xghost1(:,:) /= il_yghost1(:,:)) )THEN
2638               CALL logger_error("GRID GET COARSE INDEX: fine grid "//&
2639               &        "coordinate do not share same ghost cell")
2640            ENDIF
2641
2642            tl_lon1=var_copy(td_lon1)
2643            tl_lat1=var_copy(td_lat1)
2644            CALL grid_del_ghost(tl_lon1, il_xghost1(:,:))
2645            CALL grid_del_ghost(tl_lat1, il_xghost1(:,:))
2646           
2647            ! "global" fine grid indice
2648            il_imin1=1
2649            il_jmin1=1
2650
2651            il_imax1=tl_lon1%t_dim(1)%i_len
2652            il_jmax1=tl_lon1%t_dim(2)%i_len
2653
2654            ! get east west overlap for fine grid
2655            il_ew1=tl_lon1%i_ew
2656            IF( il_ew1 >= 0 )THEN
2657               ! last point before overlap
2658               il_imax1=il_imax1-il_ew1
2659            ENDIF
2660
2661            ! get indices for each corner
2662            !1- search lower left corner indices
2663            dl_lon1=tl_lon1%d_value( il_imin1, il_jmin1, 1, 1 )
2664            dl_lat1=tl_lat1%d_value( il_imin1, il_jmin1, 1, 1 )
2665
2666            IF( dl_lon1 == tl_lon1%d_fill .OR. &
2667            &   dl_lat1 == tl_lat1%d_fill )THEN
2668               CALL logger_error("GRID GET COARSE INDEX: lower left corner "//&
2669               &                 "point is FillValue. remove ghost cell "//&
2670               &                 "before running grid_get_coarse_index.")
2671            ENDIF
2672
2673            !!!!! i-direction !!!!!
2674            IF( ll_even(jp_I) )THEN
2675               ! even
2676               SELECT CASE(TRIM(cl_point1))
2677                  CASE('F','U')
2678                     dl_dlon= ( tl_lon1%d_value(il_imin1+1,il_jmin1,1,1) -   &
2679                        &       tl_lon1%d_value(il_imin1  ,il_jmin1,1,1) ) / &
2680                        &     2.
2681                  CASE DEFAULT
2682                     dl_dlon=0
2683               END SELECT
2684            ELSE
2685               ! odd
2686               dl_dlon= ( tl_lon1%d_value(il_imin1+1,il_jmin1,1,1) -   &
2687                  &       tl_lon1%d_value(il_imin1  ,il_jmin1,1,1) ) / &
2688                  &     2.
2689            ENDIF
2690
2691            !!!!! j-direction !!!!!
2692            IF( ll_even(jp_J) )THEN
2693               ! even
2694               SELECT CASE(TRIM(cl_point1))
2695                  CASE('F','V')
2696                     dl_dlat= ( tl_lat1%d_value(il_imin1,il_jmin1+1,1,1) -   &
2697                        &       tl_lat1%d_value(il_imin1,il_jmin1  ,1,1) ) / &
2698                        &     2.
2699                  CASE DEFAULT
2700                     dl_dlat=0
2701               END SELECT
2702            ELSE
2703               ! odd
2704               dl_dlat= ( tl_lat1%d_value(il_imin1,il_jmin1+1,1,1) -   &
2705                  &       tl_lat1%d_value(il_imin1,il_jmin1  ,1,1) ) / &
2706                  &     2.
2707            ENDIF
2708
2709            dl_lon1 = dl_lon1 + dl_dlon
2710            dl_lat1 = dl_lat1 + dl_dlat
2711
2712            ! look for closest point on coarse grid
2713            il_ill(:)= grid_get_closest(tl_lon0%d_value(il_imin0:il_imax0, &
2714            &                                           il_jmin0:il_jmax0, &
2715            &                                           1,1), &
2716            &                           tl_lat0%d_value(il_imin0:il_imax0, &
2717            &                                           il_jmin0:il_jmax0, &
2718            &                                           1,1), &
2719            &                           dl_lon1, dl_lat1, 'll'   )
2720
2721
2722            !2- search upper left corner indices
2723            dl_lon1=tl_lon1%d_value( il_imin1, il_jmax1, 1, 1 )
2724            dl_lat1=tl_lat1%d_value( il_imin1, il_jmax1, 1, 1 )
2725
2726            IF( dl_lon1 == tl_lon1%d_fill .OR. &
2727            &   dl_lat1 == tl_lat1%d_fill )THEN
2728               CALL logger_error("GRID GET COARSE INDEX: upper left corner "//&
2729               &                 "point is FillValue. remove ghost cell "//&
2730               &                 "running grid_get_coarse_index.")
2731            ENDIF           
2732
2733            !!!!! i-direction !!!!!
2734            IF( ll_even(jp_I) )THEN
2735               ! even
2736               SELECT CASE(TRIM(cl_point1))
2737                  CASE('F','U')
2738                     dl_dlon= ( tl_lon1%d_value(il_imin1+1,il_jmax1,1,1) -   &
2739                        &       tl_lon1%d_value(il_imin1  ,il_jmax1,1,1) ) / &
2740                        &     2.
2741                  CASE DEFAULT
2742                     dl_dlon=0
2743               END SELECT
2744            ELSE
2745               ! odd
2746               dl_dlon= ( tl_lon1%d_value(il_imin1+1,il_jmax1,1,1) -   &
2747                  &       tl_lon1%d_value(il_imin1  ,il_jmax1,1,1) ) / &
2748                  &     2.
2749            ENDIF
2750
2751            !!!!! j-direction !!!!!
2752            IF( ll_even(jp_J) )THEN
2753               ! even
2754               SELECT CASE(TRIM(cl_point1))
2755                  CASE('F','V')
2756                     dl_dlat= ( tl_lat1%d_value(il_imin1,il_jmax1  ,1,1) -   &
2757                        &       tl_lat1%d_value(il_imin1,il_jmax1-1,1,1) ) / &
2758                        &     2.
2759                  CASE DEFAULT
2760                     dl_dlat=0
2761               END SELECT
2762            ELSE
2763               ! odd
2764               dl_dlat= ( tl_lat1%d_value(il_imin1,il_jmax1  ,1,1) -   &
2765                  &       tl_lat1%d_value(il_imin1,il_jmax1-1,1,1) ) / &
2766                  &     2.
2767            ENDIF
2768
2769            dl_lon1 = dl_lon1 + dl_dlon
2770            dl_lat1 = dl_lat1 - dl_dlat
2771
2772            ! look for closest point on coarse grid
2773            il_iul(:)= grid_get_closest(tl_lon0%d_value(il_imin0:il_imax0, &
2774            &                                           il_jmin0:il_jmax0, &
2775            &                                           1,1), &
2776            &                           tl_lat0%d_value(il_imin0:il_imax0, &
2777            &                                           il_jmin0:il_jmax0, &
2778            &                                           1,1), &
2779            &                           dl_lon1, dl_lat1, 'ul' )
2780
2781            !3- search lower right corner indices
2782            dl_lon1=tl_lon1%d_value( il_imax1, il_jmin1, 1, 1 )
2783            dl_lat1=tl_lat1%d_value( il_imax1, il_jmin1, 1, 1 )
2784
2785            IF( dl_lon1 == tl_lon1%d_fill .OR. &
2786            &   dl_lat1 == tl_lat1%d_fill )THEN
2787               CALL logger_error("GRID GET COARSE INDEX: lower right corner "//&
2788               &                 "point is FillValue. remove ghost cell "//&
2789               &                 "running grid_get_coarse_index.")
2790            ENDIF           
2791
2792            !!!!! i-direction !!!!!
2793            IF( ll_even(jp_I) )THEN
2794               ! even
2795               SELECT CASE(TRIM(cl_point1))
2796                  CASE('F','U')
2797                     dl_dlon= ( tl_lon1%d_value(il_imax1  ,il_jmin1,1,1) -   &
2798                        &       tl_lon1%d_value(il_imax1-1,il_jmin1,1,1) ) / &
2799                        &     2.
2800                  CASE DEFAULT
2801                     dl_dlon=0
2802               END SELECT
2803            ELSE
2804               ! odd
2805               dl_dlon= ( tl_lon1%d_value(il_imax1  ,il_jmin1,1,1) -   &
2806                  &       tl_lon1%d_value(il_imax1-1,il_jmin1,1,1) ) / &
2807                  &     2.
2808            ENDIF
2809
2810            !!!!! j-direction !!!!!
2811            IF( ll_even(jp_J) )THEN
2812               ! even
2813               SELECT CASE(TRIM(cl_point1))
2814                  CASE('F','V')
2815                     dl_dlat= ( tl_lat1%d_value(il_imax1,il_jmin1+1,1,1) -   &
2816                        &       tl_lat1%d_value(il_imax1,il_jmin1  ,1,1) ) / &
2817                        &     2.
2818                  CASE DEFAULT
2819                     dl_dlat=0
2820               END SELECT
2821            ELSE
2822               ! odd
2823               dl_dlat= ( tl_lat1%d_value(il_imax1,il_jmin1+1,1,1) -   &
2824                  &       tl_lat1%d_value(il_imax1,il_jmin1  ,1,1) ) / &
2825                  &     2.
2826            ENDIF
2827
2828            dl_lon1 = dl_lon1 - dl_dlon
2829            dl_lat1 = dl_lat1 + dl_dlat
2830
2831            ! look for closest point on coarse grid
2832            il_ilr(:)= grid_get_closest(tl_lon0%d_value(il_imin0:il_imax0, &
2833            &                                           il_jmin0:il_jmax0, &
2834            &                                           1,1), &
2835            &                           tl_lat0%d_value(il_imin0:il_imax0, &
2836            &                                           il_jmin0:il_jmax0, &
2837            &                                           1,1), &
2838            &                           dl_lon1, dl_lat1, 'lr' )
2839
2840            !4- search upper right corner indices
2841            dl_lon1=tl_lon1%d_value( il_imax1, il_jmax1, 1, 1 )
2842            dl_lat1=tl_lat1%d_value( il_imax1, il_jmax1, 1, 1 )
2843
2844            IF( dl_lon1 == tl_lon1%d_fill .OR. &
2845            &   dl_lat1 == tl_lat1%d_fill )THEN
2846               CALL logger_error("GRID GET COARSE INDEX: upper right corner "//&
2847               &                 "point is FillValue. remove ghost cell "//&
2848               &                 "before running grid_get_coarse_index.")
2849            ENDIF           
2850
2851            !!!!! i-direction !!!!!
2852            IF( ll_even(jp_I) )THEN
2853               ! even
2854               SELECT CASE(TRIM(cl_point1))
2855                  CASE('F','U')
2856                     dl_dlon= ( tl_lon1%d_value(il_imax1  ,il_jmax1,1,1) -   &
2857                        &       tl_lon1%d_value(il_imax1-1,il_jmax1,1,1) ) / &
2858                        &     2.
2859                  CASE DEFAULT
2860                     dl_dlon=0
2861               END SELECT
2862            ELSE
2863               ! odd
2864               dl_dlon= ( tl_lon1%d_value(il_imax1  ,il_jmax1,1,1) -   &
2865                  &       tl_lon1%d_value(il_imax1-1,il_jmax1,1,1) ) / &
2866                  &     2.
2867            ENDIF
2868
2869            !!!!! j-direction !!!!!
2870            IF( ll_even(jp_J) )THEN
2871               ! even
2872               SELECT CASE(TRIM(cl_point1))
2873                  CASE('F','V')
2874                     dl_dlat= ( tl_lat1%d_value(il_imax1,il_jmax1  ,1,1) -   &
2875                        &       tl_lat1%d_value(il_imax1,il_jmax1-1,1,1) ) / &
2876                        &     2.
2877                  CASE DEFAULT
2878                     dl_dlat=0
2879               END SELECT
2880            ELSE
2881               ! odd
2882               dl_dlat= ( tl_lat1%d_value(il_imax1,il_jmax1  ,1,1) -   &
2883                  &       tl_lat1%d_value(il_imax1,il_jmax1-1,1,1) ) / &
2884                  &     2.
2885            ENDIF
2886
2887            dl_lon1 = dl_lon1 - dl_dlon
2888            dl_lat1 = dl_lat1 - dl_dlat
2889
2890            ! look for closest point on coarse grid
2891            il_iur(:)= grid_get_closest(tl_lon0%d_value(il_imin0:il_imax0, &
2892            &                                           il_jmin0:il_jmax0, &
2893            &                                           1,1), &
2894            &                           tl_lat0%d_value(il_imin0:il_imax0, &
2895            &                                           il_jmin0:il_jmax0, &
2896            &                                           1,1), &
2897            &                           dl_lon1, dl_lat1, 'ur' )
2898
2899            ! coarse grid indices
2900            il_imin = il_imin0-1+MIN(il_ill(1), il_iul(1))
2901            il_imax = il_imin0-1+MAX(il_ilr(1), il_iur(1))
2902
2903            IF( il_imax <= il_ew0 )THEN
2904               !il_imin = 1
2905               il_imax = tl_lon0%t_dim(1)%i_len - il_ew0 + il_imax 
2906            ENDIF
2907
2908            il_jmin = il_jmin0-1+MIN(il_ill(2), il_ilr(2))
2909            il_jmax = il_jmin0-1+MAX(il_iul(2), il_iur(2))
2910
2911            ! special case if east west overlap
2912            IF( il_ew1 >= 0 )THEN
2913               CALL logger_debug("GRID GET COARSE INDEX: East-West overlap "//&
2914               &                 "found for fine grid " )
2915
2916               il_imin = 1
2917               il_imax = tl_lon0%t_dim(1)%i_len
2918
2919            ENDIF
2920         ENDIF
2921
2922         grid__get_coarse_index_cc(1,1) = il_imin
2923         grid__get_coarse_index_cc(1,2) = il_imax
2924
2925         grid__get_coarse_index_cc(2,1) = il_jmin
2926         grid__get_coarse_index_cc(2,2) = il_jmax
2927 
2928         ! clean
2929         CALL var_clean(tl_lon1)
2930         CALL var_clean(tl_lat1)
2931         CALL var_clean(tl_lon0)
2932         CALL var_clean(tl_lat0)
2933      ENDIF
2934
2935      DEALLOCATE( il_rho )
2936
2937   END FUNCTION grid__get_coarse_index_cc
2938   !-------------------------------------------------------------------
2939   !> @brief This function check if grid is global or not
2940   !
2941   !> @details
2942   !
2943   !> @author J.Paul
2944   !> @date November, 2013 - Initial Version
2945   !
2946   !> @param[in] td_lon longitude structure
2947   !> @param[in] td_lat latitude structure
2948   !-------------------------------------------------------------------
2949   FUNCTION grid_is_global(td_lon, td_lat)
2950      IMPLICIT NONE
2951      ! Argument     
2952      TYPE(TVAR), INTENT(IN) :: td_lon
2953      TYPE(TVAR), INTENT(IN) :: td_lat
2954
2955      ! function
2956      LOGICAL :: grid_is_global
2957     
2958      ! local variable
2959      INTEGER(i4)               :: il_ew
2960      INTEGER(i4)               :: il_south
2961      INTEGER(i4)               :: il_north
2962
2963      REAL(dp)                  :: dl_lat_min
2964      REAL(dp)                  :: dl_lat_max
2965
2966      ! loop indices
2967      !----------------------------------------------------------------
2968
2969      ! init
2970      grid_is_global=.FALSE.
2971
2972      IF( ANY( td_lon%t_dim(:)%i_len /= td_lat%t_dim(:)%i_len )  )THEN
2973         CALL logger_fatal("GRID IS GLOBAL: dimension of longitude and "//&
2974         &              " latitude differ")
2975      ENDIF
2976
2977      IF( .NOT. ASSOCIATED(td_lon%d_value) .OR. &
2978      &   .NOT. ASSOCIATED(td_lat%d_value) )THEN
2979         CALL logger_error("GRID IS GLOBAL: no value associated to "//&
2980         &              " longitude or latitude strucutre")     
2981      ELSE
2982
2983         il_south=1
2984         il_north=td_lon%t_dim(2)%i_len
2985
2986         dl_lat_min=MINVAL(td_lat%d_value(:,il_south,1,1))
2987         dl_lat_max=MAXVAL(td_lat%d_value(:,il_north,1,1))
2988
2989         IF( dl_lat_min < -77.0 .AND. dl_lat_max > 89.0 )THEN
2990
2991            il_ew=td_lon%i_ew
2992            IF( il_ew >= 0 )THEN
2993
2994               grid_is_global=.TRUE.
2995
2996            ENDIF
2997
2998         ENDIF
2999      ENDIF
3000
3001   END FUNCTION grid_is_global
3002   !-------------------------------------------------------------------
3003   !> @brief This function return grid indices of the closest point
3004   !> from point (lon1,lat1)
3005   !>
3006   !> @details
3007   !>
3008   !> @note overlap band should have been already removed from coarse grid array
3009   !> of longitude and latitude, before running this function
3010   !>
3011   !> if you add cd_pos argument, you could choice to return closest point at
3012   !> - lower left  (ll) of the point
3013   !> - lower right (lr) of the point
3014   !> - upper left  (ul) of the point
3015   !> - upper right (ur) of the point
3016   !> - lower       (lo) of the point
3017   !> - upper       (up) of the point
3018   !> -       left  (le) of the point
3019   !> -       right (ri) of the point
3020   !>
3021   !> @author J.Paul
3022   !> @date November, 2013 - Initial Version
3023   !> @date February, 2015
3024   !> - change dichotomy method to manage ORCA grid
3025   !> @date February, 2016
3026   !> - add optional use of relative position
3027   !
3028   !> @param[in] dd_lon0   coarse grid array of longitude
3029   !> @param[in] dd_lat0   coarse grid array of latitude
3030   !> @param[in] dd_lon1   fine   grid longitude
3031   !> @param[in] dd_lat1   fine   grid latitude
3032   !> @param[in] cd_pos    relative position of grid point from point
3033   !> @param[in] dd_fill   fill value
3034   !> @return coarse grid indices of closest point of fine grid point
3035   !-------------------------------------------------------------------
3036   FUNCTION grid_get_closest( dd_lon0, dd_lat0, dd_lon1, dd_lat1, cd_pos, dd_fill )
3037      IMPLICIT NONE
3038      ! Argument
3039      REAL(dp), DIMENSION(:,:), INTENT(IN) :: dd_lon0
3040      REAL(dp), DIMENSION(:,:), INTENT(IN) :: dd_lat0
3041      REAL(dp),                 INTENT(IN) :: dd_lon1
3042      REAL(dp),                 INTENT(IN) :: dd_lat1
3043      CHARACTER(LEN=*),         INTENT(IN), OPTIONAL :: cd_pos
3044      REAL(dp),                 INTENT(IN), OPTIONAL :: dd_fill
3045
3046      ! function
3047      INTEGER(i4), DIMENSION(2) :: grid_get_closest
3048
3049      ! local variable
3050      INTEGER(i4)                              :: il_iinf
3051      INTEGER(i4)                              :: il_imid
3052      INTEGER(i4)                              :: il_isup
3053      INTEGER(i4)                              :: il_jinf
3054      INTEGER(i4)                              :: il_jmid
3055      INTEGER(i4)                              :: il_jsup
3056      INTEGER(i4), DIMENSION(2)                :: il_shape
3057      INTEGER(i4), DIMENSION(1)                :: il_ind
3058   
3059      LOGICAL                                  :: ll_north
3060      LOGICAL                                  :: ll_continue
3061
3062      REAL(dp)                                 :: dl_lon1
3063      REAL(dp)   , DIMENSION(:,:), ALLOCATABLE :: dl_dist
3064      REAL(dp)   , DIMENSION(:,:), ALLOCATABLE :: dl_lon0
3065
3066      ! loop indices
3067      !----------------------------------------------------------------
3068
3069      IF( ANY( SHAPE(dd_lon0(:,:)) /= SHAPE(dd_lat0(:,:)) ) )THEN
3070         CALL logger_fatal("GRID GET CLOSEST: dimension of longitude and "//&
3071         &              " latitude differ")
3072      ENDIF
3073
3074      il_shape(:)=SHAPE(dd_lon0(:,:))
3075     
3076      ALLOCATE( dl_lon0(il_shape(1),il_shape(2)) ) 
3077     
3078      dl_lon0(:,:) = dd_lon0(:,:)
3079      WHERE(dd_lon0(:,:) < 0 ) dl_lon0(:,:) = dd_lon0(:,:) + 360.
3080
3081      dl_lon1 = dd_lon1
3082      IF( dd_lon1 < 0 ) dl_lon1 = dd_lon1 + 360.
3083
3084      ! first, use dichotomy to reduce domain
3085      il_iinf = 1              ; il_jinf = 1
3086      il_isup = il_shape(1)    ; il_jsup = il_shape(2)
3087
3088      il_shape(1)= il_isup - il_iinf + 1
3089      il_shape(2)= il_jsup - il_jinf + 1
3090
3091      ll_north=.FALSE.
3092      ll_continue=.FALSE.
3093
3094      ! avoid to use fillvalue for reduce domain on first time
3095      IF( PRESENT(dd_fill) )THEN
3096         DO WHILE( ALL(dl_lon0(il_isup,:) == dd_fill) )
3097            il_isup=il_isup-1
3098         ENDDO
3099         DO WHILE( ALL(dl_lon0(il_iinf,:) == dd_fill) )
3100            il_iinf=il_iinf+1
3101         ENDDO
3102         DO WHILE( ALL(dd_lat0(:,il_jsup) == dd_fill) )
3103            il_jsup=il_jsup-1
3104         ENDDO
3105         DO WHILE( ALL(dd_lat0(:,il_jinf) == dd_fill) )
3106            il_jinf=il_jinf+1
3107         ENDDO
3108
3109         il_shape(1)= il_isup - il_iinf + 1
3110         il_shape(2)= il_jsup - il_jinf + 1
3111
3112      ENDIF
3113
3114      ! special case for north ORCA grid
3115      IF( dd_lat1 > 19. .AND. dl_lon1 < 74.  )THEN
3116         ll_north=.TRUE.
3117      ENDIF
3118
3119      IF( .NOT. ll_north )THEN
3120         ! look for meridian 0°/360°
3121         il_jmid = il_jinf + INT(il_shape(2)/2)
3122         il_ind(:) = MAXLOC( dl_lon0(il_iinf:il_isup,il_jmid), &
3123         &                   dl_lon0(il_iinf:il_isup,il_jmid) <= 360._dp )
3124
3125         il_imid=il_ind(1)
3126
3127         IF( dl_lon1 == dl_lon0(il_imid,il_jmid) .AND. &
3128         &   dd_lat1 == dd_lat0(il_imid,il_jmid) )THEN
3129
3130            il_iinf = il_imid ;  il_isup = il_imid
3131            il_jinf = il_jmid ;  il_jsup = il_jmid
3132
3133         ELSE
3134            IF( ALL(dl_lon0(il_isup,il_jinf:il_jsup) >  dl_lon1 ) .AND. &
3135            &   il_imid /= il_isup )THEN
3136               ! 0 < lon1 < lon0(isup)
3137               ! point east
3138               il_iinf = il_imid+1
3139               ll_continue=.TRUE.
3140         
3141            ELSE IF( ALL(dl_lon0(il_iinf,il_jinf:il_jsup) <  dl_lon1 ) .AND. &
3142            &        il_imid /= il_iinf )THEN
3143               ! lon0(iinf) < lon1 < 360
3144               ! point west
3145               il_isup = il_imid
3146               ll_continue=.TRUE.
3147
3148            ENDIF
3149
3150            il_shape(1)= il_isup - il_iinf + 1
3151            il_shape(2)= il_jsup - il_jinf + 1
3152
3153            il_imid = il_iinf + INT(il_shape(1)/2) 
3154            il_jmid = il_jinf + INT(il_shape(2)/2)
3155
3156            ! exit when close enough of point
3157            IF( ANY(il_shape(:) < 10 ) ) ll_continue=.FALSE.
3158         ENDIF
3159      ENDIF
3160
3161      !
3162      DO WHILE( ll_continue .AND. .NOT. ll_north )
3163
3164         ll_continue=.FALSE.
3165         IF( dl_lon1 == dl_lon0(il_imid,il_jmid) .AND. &
3166         &   dd_lat1 == dd_lat0(il_imid,il_jmid) )THEN
3167
3168            il_iinf = il_imid ;  il_isup = il_imid
3169            il_jinf = il_jmid ;  il_jsup = il_jmid
3170
3171         ELSE
3172            IF( ALL(dl_lon0(il_imid,il_jinf:il_jsup) <  dl_lon1) )THEN   
3173
3174               ! point east
3175               il_iinf = il_imid
3176               ll_continue=.TRUE.
3177       
3178            ELSE IF( ALL(dl_lon0(il_imid,il_jinf:il_jsup) >  dl_lon1) )THEN   
3179
3180               ! point west
3181               il_isup = il_imid
3182               ll_continue=.TRUE.
3183
3184            ENDIF
3185
3186            IF( ALL(dd_lat0(il_iinf:il_isup,il_jmid) <  dd_lat1) )THEN   
3187               
3188               ! point north
3189               il_jinf = il_jmid
3190               ll_continue=.TRUE.
3191
3192            ELSE IF( ALL(dd_lat0(il_iinf:il_isup,il_jmid) > dd_lat1) )THEN   
3193
3194               ! point south
3195               il_jsup = il_jmid
3196               ll_continue=.TRUE.
3197           
3198            ENDIF
3199
3200            il_shape(1)= il_isup - il_iinf + 1
3201            il_shape(2)= il_jsup - il_jinf + 1
3202
3203            il_imid = il_iinf + INT(il_shape(1)/2) 
3204            il_jmid = il_jinf + INT(il_shape(2)/2)
3205
3206            ! exit when close enough of point
3207            IF( ANY(il_shape(:) < 10 ) ) ll_continue=.FALSE.
3208         ENDIF
3209         
3210      ENDDO
3211
3212      ! then find closest point by computing distances
3213      il_shape(1)= il_isup - il_iinf + 1
3214      il_shape(2)= il_jsup - il_jinf + 1
3215
3216      ALLOCATE( dl_dist(il_shape(1), il_shape(2)) )
3217
3218      dl_dist(:,:)=grid_distance(dl_lon0(il_iinf:il_isup,il_jinf:il_jsup), &
3219      &                          dd_lat0(il_iinf:il_isup,il_jinf:il_jsup), &
3220      &                          dl_lon1, dd_lat1 )
3221
3222      IF( PRESENT(cd_pos) )THEN
3223         !
3224         SELECT CASE(TRIM(cd_pos))
3225            CASE('le')
3226               WHERE( dd_lat0(il_iinf:il_isup,il_jinf:il_jsup) > dd_lat1 )
3227                  dl_dist(:,:)=NF90_FILL_DOUBLE
3228               END WHERE
3229            CASE('ri')
3230               WHERE( dd_lat0(il_iinf:il_isup,il_jinf:il_jsup) < dd_lat1 )
3231                  dl_dist(:,:)=NF90_FILL_DOUBLE
3232               END WHERE
3233            CASE('up')
3234               WHERE( dl_lon0(il_iinf:il_isup,il_jinf:il_jsup) < dl_lon1 )
3235                  dl_dist(:,:)=NF90_FILL_DOUBLE
3236               END WHERE
3237            CASE('lo')
3238               WHERE( dl_lon0(il_iinf:il_isup,il_jinf:il_jsup) > dl_lon1 )
3239                  dl_dist(:,:)=NF90_FILL_DOUBLE
3240               END WHERE
3241            CASE('ll')
3242               WHERE( dl_lon0(il_iinf:il_isup,il_jinf:il_jsup) > dl_lon1 .OR. &
3243                    & dd_lat0(il_iinf:il_isup,il_jinf:il_jsup) > dd_lat1 )
3244                  dl_dist(:,:)=NF90_FILL_DOUBLE
3245               END WHERE
3246            CASE('lr')
3247               WHERE( dl_lon0(il_iinf:il_isup,il_jinf:il_jsup) < dl_lon1 .OR. &
3248                    & dd_lat0(il_iinf:il_isup,il_jinf:il_jsup) > dd_lat1 )
3249                  dl_dist(:,:)=NF90_FILL_DOUBLE
3250               END WHERE               
3251            CASE('ul')
3252               WHERE( dl_lon0(il_iinf:il_isup,il_jinf:il_jsup) > dl_lon1 .OR. &
3253                    & dd_lat0(il_iinf:il_isup,il_jinf:il_jsup) < dd_lat1 )
3254                  dl_dist(:,:)=NF90_FILL_DOUBLE
3255               END WHERE               
3256            CASE('ur')
3257               WHERE( dl_lon0(il_iinf:il_isup,il_jinf:il_jsup) < dl_lon1 .OR. &
3258                    & dd_lat0(il_iinf:il_isup,il_jinf:il_jsup) < dd_lat1 )
3259                  dl_dist(:,:)=NF90_FILL_DOUBLE
3260               END WHERE
3261         END SELECT
3262      ENDIF
3263      grid_get_closest(:)=MINLOC(dl_dist(:,:),dl_dist(:,:)/=NF90_FILL_DOUBLE)
3264
3265      grid_get_closest(1)=grid_get_closest(1)+il_iinf-1
3266      grid_get_closest(2)=grid_get_closest(2)+il_jinf-1
3267
3268      DEALLOCATE( dl_dist )
3269      DEALLOCATE( dl_lon0 )
3270
3271   END FUNCTION grid_get_closest
3272   !-------------------------------------------------------------------
3273   !> @brief This function compute the distance between a point A and grid points. 
3274   !
3275   !> @details
3276   !
3277   !> @author J.Paul
3278   !> @date November, 2013 - Initial Version
3279   !
3280   !> @param[in] dd_lon    grid longitude array
3281   !> @param[in] dd_lat    grid latitude  array
3282   !> @param[in] dd_lonA   longitude of point A
3283   !> @param[in] dd_latA   latitude  of point A
3284   !> @param[in] dd_fill
3285   !> @return array of distance between point A and grid points.
3286   !-------------------------------------------------------------------
3287   FUNCTION grid_distance(dd_lon, dd_lat, dd_lonA, dd_latA )
3288      IMPLICIT NONE
3289      ! Argument     
3290      REAL(dp), DIMENSION(:,:), INTENT(IN) :: dd_lon
3291      REAL(dp), DIMENSION(:,:), INTENT(IN) :: dd_lat
3292      REAL(dp),                 INTENT(IN) :: dd_lonA
3293      REAL(dp),                 INTENT(IN) :: dd_latA
3294
3295      ! function
3296      REAL(dp), DIMENSION(SIZE(dd_lon(:,:),DIM=1),&
3297      &                   SIZE(dd_lon(:,:),DIM=2)) :: grid_distance
3298
3299      ! local variable
3300      INTEGER(i4), DIMENSION(2) :: il_shape
3301
3302      REAL(dp)   , DIMENSION(:,:), ALLOCATABLE :: dl_lon
3303      REAL(dp)   , DIMENSION(:,:), ALLOCATABLE :: dl_lat
3304      REAL(dp)                                 :: dl_lonA
3305      REAL(dp)                                 :: dl_latA
3306
3307      REAL(dp)                                 :: dl_tmp
3308
3309      ! loop indices
3310      INTEGER(i4) :: ji
3311      INTEGER(i4) :: jj
3312      !----------------------------------------------------------------
3313
3314      IF( ANY( SHAPE(dd_lon(:,:)) /= SHAPE(dd_lat(:,:)) ) )THEN
3315         CALL logger_fatal("GRID DISTANCE: dimension of longitude and "//&
3316         &              " latitude differ")
3317      ENDIF
3318      il_shape(:)=SHAPE(dd_lon(:,:))
3319     
3320      ALLOCATE(dl_lon(il_shape(1),il_shape(2)))
3321      ALLOCATE(dl_lat(il_shape(1),il_shape(2)))
3322
3323      dl_lon(:,:) = dd_lon(:,:)
3324      dl_lonA     = dd_lonA
3325
3326      WHERE(dd_lon(:,:) < 0 ) dl_lon(:,:) = dd_lon(:,:) + 360.
3327      IF(   dd_lonA     < 0 ) dl_lonA     = dd_lonA     + 360.
3328     
3329      dl_lonA = dd_lonA * dp_deg2rad
3330      dl_latA = dd_latA * dp_deg2rad
3331
3332      dl_lon(:,:) = dl_lon(:,:) * dp_deg2rad
3333      dl_lat(:,:) = dd_lat(:,:) * dp_deg2rad
3334
3335      grid_distance(:,:)=NF90_FILL_DOUBLE
3336
3337      DO jj=1,il_shape(2)
3338         DO ji=1,il_shape(1)
3339            IF( dl_lon(ji,jj) == dl_lonA .AND. &
3340            &   dl_lat(ji,jj) == dl_latA )THEN
3341               grid_distance(ji,jj)=0.0
3342            ELSE
3343               dl_tmp= SIN(dl_latA)*SIN(dl_lat(ji,jj)) + &
3344               &       COS(dl_latA)*COS(dl_lat(ji,jj)) * &
3345               &       COS(dl_lon(ji,jj)-dl_lonA)
3346               ! check to avoid mistake with ACOS
3347               IF( dl_tmp < -1.0 ) dl_tmp = -1.0
3348               IF( dl_tmp >  1.0 ) dl_tmp =  1.0
3349               grid_distance(ji,jj)=ACOS(dl_tmp)*dp_rearth
3350            ENDIF
3351         ENDDO
3352      ENDDO
3353
3354      DEALLOCATE(dl_lon)
3355      DEALLOCATE(dl_lat)
3356
3357   END FUNCTION grid_distance
3358   !-------------------------------------------------------------------
3359   !> @brief This function get offset between fine grid and coarse grid.
3360   !
3361   !> @details
3362   !> optionally, you could specify on which Arakawa grid point you want to
3363   !> work (default 'T')
3364   !> offset value could be 0,1,..,rho-1
3365   !
3366   !> @author J.Paul
3367   !> @date September, 2014 - Initial Version
3368   !> @date October, 2014
3369   !> - work on mpp file structure instead of file structure
3370   !
3371   !> @param[in] td_coord0 coarse grid coordinate
3372   !> @param[in] id_imin0  coarse grid lower left corner i-indice of fine grid domain
3373   !> @param[in] id_jmin0  coarse grid lower left corner j-indice of fine grid domain
3374   !> @param[in] id_imax0  coarse grid upper right corner i-indice of fine grid domain
3375   !> @param[in] id_jmax0  coarse grid upper right corner j-indice of fine grid domain
3376   !> @param[in] td_coord1 fine   grid coordinate
3377   !> @param[in] id_rho    array of refinement factor
3378   !> @param[in] cd_point  Arakawa grid point
3379   !> @return offset array (/ (/i_offset_left,i_offset_right/),(/j_offset_lower,j_offset_upper/) /)
3380   !-------------------------------------------------------------------
3381   FUNCTION grid__get_fine_offset_ff( td_coord0, &
3382   &                                  id_imin0, id_jmin0, id_imax0, id_jmax0, &
3383   &                                  td_coord1, id_rho, cd_point )
3384      IMPLICIT NONE
3385      ! Argument
3386      TYPE(TMPP)                    , INTENT(IN) :: td_coord0
3387      TYPE(TMPP)                    , INTENT(IN) :: td_coord1
3388
3389      INTEGER(i4)                   , INTENT(IN) :: id_imin0
3390      INTEGER(i4)                   , INTENT(IN) :: id_jmin0
3391      INTEGER(i4)                   , INTENT(IN) :: id_imax0
3392      INTEGER(i4)                   , INTENT(IN) :: id_jmax0
3393
3394      INTEGER(i4)     , DIMENSION(:), INTENT(IN), OPTIONAL :: id_rho
3395      CHARACTER(LEN=*)              , INTENT(IN), OPTIONAL :: cd_point
3396
3397      ! function
3398      INTEGER(i4), DIMENSION(2,2) :: grid__get_fine_offset_ff
3399
3400      ! local variable
3401      INTEGER(i4)                              :: il_imin0
3402      INTEGER(i4)                              :: il_jmin0
3403      INTEGER(i4)                              :: il_imax0
3404      INTEGER(i4)                              :: il_jmax0
3405      INTEGER(i4)                              :: il_ind
3406     
3407      INTEGER(i4), DIMENSION(:), ALLOCATABLE   :: il_rho
3408     
3409      INTEGER(i4), DIMENSION(2,2)              :: il_xghost0
3410      INTEGER(i4), DIMENSION(2,2)              :: il_xghost1
3411
3412      CHARACTER(LEN= 1)                        :: cl_point
3413      CHARACTER(LEN=lc)                        :: cl_name
3414
3415      REAL(dp)   , DIMENSION(:,:), ALLOCATABLE :: dl_lon0
3416      REAL(dp)   , DIMENSION(:,:), ALLOCATABLE :: dl_lat0
3417      REAL(dp)   , DIMENSION(:,:), ALLOCATABLE :: dl_lon1
3418      REAL(dp)   , DIMENSION(:,:), ALLOCATABLE :: dl_lat1
3419
3420      TYPE(TVAR)                               :: tl_lon0
3421      TYPE(TVAR)                               :: tl_lat0
3422      TYPE(TVAR)                               :: tl_lon1
3423      TYPE(TVAR)                               :: tl_lat1
3424
3425      TYPE(TMPP)                               :: tl_coord0
3426      TYPE(TMPP)                               :: tl_coord1
3427     
3428      ! loop indices
3429      !----------------------------------------------------------------
3430      ! init
3431      grid__get_fine_offset_ff(:,:)=-1
3432
3433      ALLOCATE(il_rho(ip_maxdim))
3434      il_rho(:)=1
3435      IF( PRESENT(id_rho) ) il_rho(:)=id_rho(:)
3436
3437      cl_point='T'
3438      IF( PRESENT(cd_point) ) cl_point=TRIM(fct_upper(cd_point))
3439
3440      ! copy structure
3441      tl_coord0=mpp_copy(td_coord0)
3442      tl_coord1=mpp_copy(td_coord1)
3443
3444      IF( .NOT. ASSOCIATED(tl_coord0%t_proc) .OR. &
3445      &   .NOT. ASSOCIATED(tl_coord1%t_proc) )THEN
3446         CALL logger_error("GRID GET FINE OFFSET: can not get coarse "//&
3447         &  "grid indices. decompsition of mpp file "//TRIM(tl_coord0%c_name)//&
3448         &  " and/or "//TRIM(tl_coord1%c_name)//" not defined." )
3449      ELSE     
3450         !1- Coarse grid
3451         ! get ghost cell factor on coarse grid
3452         il_xghost0(:,:)=grid_get_ghost( tl_coord0 )
3453
3454         ! open mpp files
3455         CALL iom_mpp_open(tl_coord0)
3456
3457         ! read coarse longitue and latitude
3458         WRITE(cl_name,*) 'longitude_'//TRIM(cl_point)
3459         il_ind=var_get_id(tl_coord0%t_proc(1)%t_var(:), cl_name)
3460         IF( il_ind == 0 )THEN
3461            CALL logger_warn("GRID GET FINE OFFSET: no variable "//&
3462            &  TRIM(cl_name)//" in file "//TRIM(tl_coord0%c_name)//". &
3463            &  try to use longitude.")
3464            WRITE(cl_name,*) 'longitude'
3465         ENDIF
3466         tl_lon0=iom_mpp_read_var(tl_coord0, TRIM(cl_name))
3467
3468         WRITE(cl_name,*) 'latitude_'//TRIM(cl_point)
3469         il_ind=var_get_id(tl_coord0%t_proc(1)%t_var(:), cl_name)
3470         IF( il_ind == 0 )THEN
3471            CALL logger_warn("GRID GET FINE OFFSET: no variable "//&
3472            &  TRIM(cl_name)//" in file "//TRIM(tl_coord0%c_name)//". &
3473            &  try to use latitude.")
3474            WRITE(cl_name,*) 'latitude'
3475         ENDIF
3476         tl_lat0=iom_mpp_read_var(tl_coord0, TRIM(cl_name))
3477         
3478         ! close mpp files
3479         CALL iom_mpp_close(tl_coord0)
3480
3481         CALL grid_del_ghost(tl_lon0, il_xghost0(:,:))
3482         CALL grid_del_ghost(tl_lat0, il_xghost0(:,:))
3483
3484         ALLOCATE(dl_lon0(tl_lon0%t_dim(jp_I)%i_len, &
3485         &                tl_lon0%t_dim(jp_J)%i_len ))
3486
3487         dl_lon0(:,:)=tl_lon0%d_value(:,:,1,1)
3488
3489         ALLOCATE(dl_lat0(tl_lat0%t_dim(jp_I)%i_len, &
3490         &                tl_lat0%t_dim(jp_J)%i_len ))
3491
3492         dl_lat0(:,:)=tl_lat0%d_value(:,:,1,1)
3493
3494         ! clean
3495         CALL var_clean(tl_lon0)
3496         CALL var_clean(tl_lat0)
3497
3498         ! adjust coarse grid indices
3499         il_imin0=id_imin0-il_xghost0(jp_I,1)
3500         il_imax0=id_imax0-il_xghost0(jp_I,1)
3501
3502         il_jmin0=id_jmin0-il_xghost0(jp_J,1)
3503         il_jmax0=id_jmax0-il_xghost0(jp_J,1)
3504
3505         !2- Fine grid
3506         ! get ghost cell factor on fine grid
3507         il_xghost1(:,:)=grid_get_ghost( tl_coord1 )
3508
3509         ! open mpp files
3510         CALL iom_mpp_open(tl_coord1)
3511
3512         ! read fine longitue and latitude
3513         WRITE(cl_name,*) 'longitude_'//TRIM(cl_point)
3514         il_ind=var_get_id(tl_coord1%t_proc(1)%t_var(:), cl_name)
3515         IF( il_ind == 0 )THEN
3516            CALL logger_warn("GRID GET FINE OFFSET: no variable "//&
3517            &  TRIM(cl_name)//" in file "//TRIM(tl_coord1%c_name)//". &
3518            &  try to use longitude.")
3519            WRITE(cl_name,*) 'longitude'
3520         ENDIF
3521         tl_lon1=iom_mpp_read_var(tl_coord1, TRIM(cl_name))
3522
3523         WRITE(cl_name,*) 'latitude_'//TRIM(cl_point)
3524         il_ind=var_get_id(tl_coord1%t_proc(1)%t_var(:), cl_name)
3525         IF( il_ind == 0 )THEN
3526            CALL logger_warn("GRID GET FINE OFFSET: no variable "//&
3527            &  TRIM(cl_name)//" in file "//TRIM(tl_coord1%c_name)//". &
3528            &  try to use latitude.")
3529            WRITE(cl_name,*) 'latitude'
3530         ENDIF
3531         tl_lat1=iom_mpp_read_var(tl_coord1, TRIM(cl_name))
3532 
3533         ! close mpp files
3534         CALL iom_mpp_close(tl_coord1)
3535
3536         CALL grid_del_ghost(tl_lon1, il_xghost1(:,:))
3537         CALL grid_del_ghost(tl_lat1, il_xghost1(:,:))
3538
3539         ALLOCATE(dl_lon1(tl_lon1%t_dim(jp_I)%i_len, &
3540         &                tl_lon1%t_dim(jp_J)%i_len ))
3541
3542         dl_lon1(:,:)=tl_lon1%d_value(:,:,1,1)
3543
3544         ALLOCATE(dl_lat1(tl_lat1%t_dim(jp_I)%i_len, &
3545         &                tl_lat1%t_dim(jp_J)%i_len ))
3546
3547         dl_lat1(:,:)=tl_lat1%d_value(:,:,1,1)
3548
3549         ! clean
3550         CALL var_clean(tl_lon1)
3551         CALL var_clean(tl_lat1)
3552 
3553         !3- compute
3554         grid__get_fine_offset_ff(:,:)=grid_get_fine_offset( &
3555         &                                         dl_lon0(:,:), dl_lat0(:,:),&
3556         &                                         il_imin0, il_jmin0, &
3557         &                                         il_imax0, il_jmax0, &
3558         &                                         dl_lon1(:,:), dl_lat1(:,:),&
3559         &                                         id_rho(:), cl_point )
3560 
3561         DEALLOCATE(dl_lon0, dl_lat0)
3562         DEALLOCATE(dl_lon1, dl_lat1)
3563      ENDIF
3564
3565      ! clean
3566      CALL mpp_clean(tl_coord0)
3567      CALL mpp_clean(tl_coord1)
3568      DEALLOCATE(il_rho)
3569
3570   END FUNCTION grid__get_fine_offset_ff
3571   !-------------------------------------------------------------------
3572   !> @brief This function get offset between fine grid and coarse grid.
3573   !
3574   !> @details
3575   !> optionally, you could specify on which Arakawa grid point you want to
3576   !> work (default 'T')
3577   !> offset value could be 0,1,..,rho-1
3578   !
3579   !> @author J.Paul
3580   !> @date September, 2014 - Initial Version
3581   !> @date October, 2014
3582   !> - work on mpp file structure instead of file structure
3583   !
3584   !> @param[in] dd_lon0   coarse grid longitude array
3585   !> @param[in] dd_lat0   coarse grid latitude  array
3586   !> @param[in] id_imin0  coarse grid lower left corner i-indice of fine grid domain
3587   !> @param[in] id_jmin0  coarse grid lower left corner j-indice of fine grid domain
3588   !> @param[in] id_imax0  coarse grid upper right corner i-indice of fine grid domain
3589   !> @param[in] id_jmax0  coarse grid upper right corner j-indice of fine grid domain
3590   !> @param[in] td_coord1 fine   grid coordinate
3591   !> @param[in] id_rho    array of refinement factor
3592   !> @param[in] cd_point  Arakawa grid point
3593   !> @return offset array (/ (/i_offset_left,i_offset_right/),(/j_offset_lower,j_offset_upper/) /)
3594   !-------------------------------------------------------------------
3595   FUNCTION grid__get_fine_offset_cf( dd_lon0, dd_lat0, &
3596   &                                  id_imin0, id_jmin0, id_imax0, id_jmax0, &
3597   &                                  td_coord1, id_rho, cd_point )
3598      IMPLICIT NONE
3599      ! Argument
3600      REAL(dp)       , DIMENSION(:,:), INTENT(IN) :: dd_lon0
3601      REAL(dp)       , DIMENSION(:,:), INTENT(IN) :: dd_lat0
3602      TYPE(TMPP)                     , INTENT(IN) :: td_coord1
3603
3604      INTEGER(i4)                    , INTENT(IN) :: id_imin0
3605      INTEGER(i4)                    , INTENT(IN) :: id_jmin0
3606      INTEGER(i4)                    , INTENT(IN) :: id_imax0
3607      INTEGER(i4)                    , INTENT(IN) :: id_jmax0
3608
3609      INTEGER(i4)     , DIMENSION(:) , INTENT(IN), OPTIONAL :: id_rho
3610      CHARACTER(LEN=*)               , INTENT(IN), OPTIONAL :: cd_point
3611
3612      ! function
3613      INTEGER(i4), DIMENSION(2,2) :: grid__get_fine_offset_cf
3614
3615      ! local variable
3616      INTEGER(i4)                              :: il_ind
3617      INTEGER(i4), DIMENSION(2,2)              :: il_xghost1
3618      INTEGER(i4), DIMENSION(:), ALLOCATABLE   :: il_rho
3619     
3620      CHARACTER(LEN= 1)                        :: cl_point
3621      CHARACTER(LEN=lc)                        :: cl_name
3622
3623      REAL(dp)   , DIMENSION(:,:), ALLOCATABLE :: dl_lon1
3624      REAL(dp)   , DIMENSION(:,:), ALLOCATABLE :: dl_lat1
3625
3626      TYPE(TVAR)                               :: tl_lon1
3627      TYPE(TVAR)                               :: tl_lat1
3628
3629      TYPE(TMPP)                               :: tl_coord1
3630      ! loop indices
3631      !----------------------------------------------------------------
3632      ! init
3633      grid__get_fine_offset_cf(:,:)=-1
3634
3635      ALLOCATE(il_rho(ip_maxdim))
3636      il_rho(:)=1
3637      IF( PRESENT(id_rho) ) il_rho(:)=id_rho(:)
3638
3639      cl_point='T'
3640      IF( PRESENT(cd_point) ) cl_point=TRIM(fct_upper(cd_point))
3641
3642      ! copy structure
3643      tl_coord1=mpp_copy(td_coord1)
3644
3645      IF( .NOT. ASSOCIATED(tl_coord1%t_proc) )THEN
3646         CALL logger_error("GRID GET FINE OFFSET: decompsition of mpp "//&
3647         &  "file "//TRIM(tl_coord1%c_name)//" not defined." )
3648      ELSE     
3649
3650         ! Fine grid
3651         ! get ghost cell factor on fine grid
3652         il_xghost1(:,:)=grid_get_ghost( tl_coord1 )
3653
3654         ! open mpp files
3655         CALL iom_mpp_open(tl_coord1)
3656
3657         ! read fine longitue and latitude
3658         WRITE(cl_name,*) 'longitude_'//TRIM(cl_point)
3659         il_ind=var_get_id(tl_coord1%t_proc(1)%t_var(:), cl_name)
3660         IF( il_ind == 0 )THEN
3661            CALL logger_warn("GRID GET FINE OFFSET: no variable "//&
3662            &  TRIM(cl_name)//" in file "//TRIM(tl_coord1%c_name)//". &
3663            &  try to use longitude.")
3664            WRITE(cl_name,*) 'longitude'
3665         ENDIF
3666         tl_lon1=iom_mpp_read_var(tl_coord1, TRIM(cl_name))
3667
3668         WRITE(cl_name,*) 'latitude_'//TRIM(cl_point)
3669         il_ind=var_get_id(tl_coord1%t_proc(1)%t_var(:), cl_name)
3670         IF( il_ind == 0 )THEN
3671            CALL logger_warn("GRID GET FINE OFFSET: no variable "//&
3672            &  TRIM(cl_name)//" in file "//TRIM(tl_coord1%c_name)//". &
3673            &  try to use latitude.")
3674            WRITE(cl_name,*) 'latitude'
3675         ENDIF
3676         tl_lat1=iom_mpp_read_var(tl_coord1, TRIM(cl_name))
3677 
3678         ! close mpp files
3679         CALL iom_mpp_close(tl_coord1)
3680
3681         CALL grid_del_ghost(tl_lon1, il_xghost1(:,:))
3682         CALL grid_del_ghost(tl_lat1, il_xghost1(:,:))
3683
3684         ALLOCATE(dl_lon1(tl_lon1%t_dim(jp_I)%i_len, &
3685         &                tl_lon1%t_dim(jp_J)%i_len ))
3686
3687         dl_lon1(:,:)=tl_lon1%d_value(:,:,1,1)
3688
3689         ALLOCATE(dl_lat1(tl_lat1%t_dim(jp_I)%i_len, &
3690         &                tl_lat1%t_dim(jp_J)%i_len ))
3691
3692         dl_lat1(:,:)=tl_lat1%d_value(:,:,1,1)
3693
3694         ! clean
3695         CALL var_clean(tl_lon1)
3696         CALL var_clean(tl_lat1)
3697     
3698         ! compute
3699         grid__get_fine_offset_cf(:,:)=grid_get_fine_offset( &
3700         &                                         dd_lon0(:,:), dd_lat0(:,:),&
3701         &                                         id_imin0, id_jmin0, &
3702         &                                         id_imax0, id_jmax0, &
3703         &                                         dl_lon1(:,:), dl_lat1(:,:),&
3704         &                                         id_rho(:), cl_point )
3705         
3706         DEALLOCATE(dl_lon1, dl_lat1)
3707      ENDIF
3708
3709      ! clean
3710      CALL mpp_clean(tl_coord1)
3711      DEALLOCATE(il_rho)
3712
3713   END FUNCTION grid__get_fine_offset_cf
3714   !-------------------------------------------------------------------
3715   !> @brief This function get offset between fine grid and coarse grid.
3716   !
3717   !> @details
3718   !> optionally, you could specify on which Arakawa grid point you want to
3719   !> work (default 'T')
3720   !> offset value could be 0,1,..,rho-1
3721   !
3722   !> @author J.Paul
3723   !> @date September, 2014 - Initial Version
3724   !> @date October, 2014
3725   !> - work on mpp file structure instead of file structure
3726   !
3727   !> @param[in] td_coord0 coarse grid coordinate
3728   !> @param[in] id_imin0  coarse grid lower left corner i-indice of fine grid domain
3729   !> @param[in] id_jmin0  coarse grid lower left corner j-indice of fine grid domain
3730   !> @param[in] id_imax0  coarse grid upper right corner i-indice of fine grid domain
3731   !> @param[in] id_jmax0  coarse grid upper right corner j-indice of fine grid domain
3732   !> @param[in] dd_lon1   fine   grid longitude array
3733   !> @param[in] dd_lat1   fine   grid latitude  array
3734   !> @param[in] id_rho    array of refinement factor
3735   !> @param[in] cd_point  Arakawa grid point
3736   !> @return offset array (/ (/i_offset_left,i_offset_right/),(/j_offset_lower,j_offset_upper/) /)
3737   !-------------------------------------------------------------------
3738   FUNCTION grid__get_fine_offset_fc( td_coord0, &
3739   &                                  id_imin0, id_jmin0, id_imax0, id_jmax0, &
3740   &                                  dd_lon1, dd_lat1, &
3741   &                                  id_rho, cd_point )
3742      IMPLICIT NONE
3743      ! Argument
3744      TYPE(TMPP)                      , INTENT(IN) :: td_coord0
3745      REAL(dp)        , DIMENSION(:,:), INTENT(IN) :: dd_lon1
3746      REAL(dp)        , DIMENSION(:,:), INTENT(IN) :: dd_lat1
3747
3748      INTEGER(i4)                     , INTENT(IN) :: id_imin0
3749      INTEGER(i4)                     , INTENT(IN) :: id_jmin0
3750      INTEGER(i4)                     , INTENT(IN) :: id_imax0
3751      INTEGER(i4)                     , INTENT(IN) :: id_jmax0
3752
3753      INTEGER(i4)     , DIMENSION(:)  , INTENT(IN), OPTIONAL :: id_rho
3754      CHARACTER(LEN=*)                , INTENT(IN), OPTIONAL :: cd_point
3755
3756      ! function
3757      INTEGER(i4), DIMENSION(2,2) :: grid__get_fine_offset_fc
3758
3759      ! local variable
3760      INTEGER(i4)                              :: il_imin0
3761      INTEGER(i4)                              :: il_jmin0
3762      INTEGER(i4)                              :: il_imax0
3763      INTEGER(i4)                              :: il_jmax0
3764      INTEGER(i4)                              :: il_ind
3765     
3766      INTEGER(i4), DIMENSION(:), ALLOCATABLE   :: il_rho
3767     
3768      INTEGER(i4), DIMENSION(2,2)              :: il_xghost0
3769
3770      CHARACTER(LEN= 1)                        :: cl_point
3771      CHARACTER(LEN=lc)                        :: cl_name
3772
3773      REAL(dp)   , DIMENSION(:,:), ALLOCATABLE :: dl_lon0
3774      REAL(dp)   , DIMENSION(:,:), ALLOCATABLE :: dl_lat0
3775
3776      TYPE(TVAR)                               :: tl_lon0
3777      TYPE(TVAR)                               :: tl_lat0
3778
3779      TYPE(TMPP)                               :: tl_coord0
3780      ! loop indices
3781      !----------------------------------------------------------------
3782      ! init
3783      grid__get_fine_offset_fc(:,:)=-1
3784      ALLOCATE(il_rho(ip_maxdim))
3785      il_rho(:)=1
3786      IF( PRESENT(id_rho) ) il_rho(:)=id_rho(:)
3787
3788      cl_point='T'
3789      IF( PRESENT(cd_point) ) cl_point=TRIM(fct_upper(cd_point))
3790
3791      ! copy structure
3792      tl_coord0=mpp_copy(td_coord0)
3793
3794      IF( .NOT. ASSOCIATED(tl_coord0%t_proc) )THEN
3795         CALL logger_error("GRID GET FINE OFFSET: decompsition of mpp "//&
3796         &  "file "//TRIM(tl_coord0%c_name)//" not defined." )
3797      ELSE     
3798         !1- Coarse grid
3799         ! get ghost cell factor on coarse grid
3800         il_xghost0(:,:)=grid_get_ghost( tl_coord0 )
3801
3802         ! open mpp files
3803         CALL iom_mpp_open(tl_coord0)
3804
3805         ! read coarse longitude and latitude
3806         WRITE(cl_name,*) 'longitude_'//TRIM(cl_point)
3807         il_ind=var_get_id(tl_coord0%t_proc(1)%t_var(:), cl_name)
3808         IF( il_ind == 0 )THEN
3809            CALL logger_warn("GRID GET FINE OFFSET: no variable "//&
3810            &  TRIM(cl_name)//" in file "//TRIM(tl_coord0%c_name)//". &
3811            &  try to use longitude.")
3812            WRITE(cl_name,*) 'longitude'
3813         ENDIF
3814         tl_lon0=iom_mpp_read_var(tl_coord0, TRIM(cl_name))
3815
3816         WRITE(cl_name,*) 'latitude_'//TRIM(cl_point)
3817         il_ind=var_get_id(tl_coord0%t_proc(1)%t_var(:), cl_name)
3818         IF( il_ind == 0 )THEN
3819            CALL logger_warn("GRID GET FINE OFFSET: no variable "//&
3820            &  TRIM(cl_name)//" in file "//TRIM(tl_coord0%c_name)//". &
3821            &  try to use latitude.")
3822            WRITE(cl_name,*) 'latitude'
3823         ENDIF
3824         tl_lat0=iom_mpp_read_var(tl_coord0, TRIM(cl_name))
3825 
3826         ! close mpp files
3827         CALL iom_mpp_close(tl_coord0)
3828
3829         CALL grid_del_ghost(tl_lon0, il_xghost0(:,:))
3830         CALL grid_del_ghost(tl_lat0, il_xghost0(:,:))
3831
3832
3833         ALLOCATE(dl_lon0(tl_lon0%t_dim(jp_I)%i_len, &
3834         &                tl_lon0%t_dim(jp_J)%i_len ))
3835
3836         dl_lon0(:,:)=tl_lon0%d_value(:,:,1,1)
3837
3838         ALLOCATE(dl_lat0(tl_lat0%t_dim(jp_I)%i_len, &
3839         &                tl_lat0%t_dim(jp_J)%i_len ))
3840
3841         dl_lat0(:,:)=tl_lat0%d_value(:,:,1,1)
3842
3843         ! clean
3844         CALL var_clean(tl_lon0)
3845         CALL var_clean(tl_lat0)
3846
3847         ! adjust coarse grid indices
3848         il_imin0=id_imin0-il_xghost0(jp_I,1)
3849         il_imax0=id_imax0-il_xghost0(jp_I,1)
3850
3851         il_jmin0=id_jmin0-il_xghost0(jp_J,1)
3852         il_jmax0=id_jmax0-il_xghost0(jp_J,1)
3853
3854         !3- compute
3855         grid__get_fine_offset_fc(:,:)=grid_get_fine_offset(&
3856         &                                         dl_lon0(:,:), dl_lat0(:,:),&
3857         &                                         il_imin0, il_jmin0, &
3858         &                                         il_imax0, il_jmax0, &
3859         &                                         dd_lon1(:,:), dd_lat1(:,:),&
3860         &                                         id_rho(:), cl_point )
3861         
3862         DEALLOCATE(dl_lon0, dl_lat0)
3863      ENDIF
3864
3865      ! clean
3866      CALL mpp_clean(tl_coord0)
3867      DEALLOCATE(il_rho)
3868
3869   END FUNCTION grid__get_fine_offset_fc
3870   !-------------------------------------------------------------------
3871   !> @brief This function get offset between fine grid and coarse grid.
3872   !
3873   !> @details
3874   !> offset value could be 0,1,..,rho-1
3875   !
3876   !> @author J.Paul
3877   !> @date November, 2013 - Initial Version
3878   !> @date September, 2014
3879   !> - rename from grid_get_fine_offset
3880   !> @date May, 2015
3881   !> - improve way to find offset
3882   !> @date July, 2015
3883   !> - manage case close to greenwich meridian
3884   !> @date February, 2016
3885   !> - use grid_get_closest to assess offset
3886   !> - use delta (lon or lat)
3887   !> - manage cases for T,U,V or F point, with even or odd refinment
3888   !> - check lower left(upper right) fine grid point inside lower left(upper
3889   !> right) coarse grid cell.
3890   !>
3891   !> @todo check case close from North fold.
3892   !>
3893   !> @param[in] dd_lon0   coarse grid longitude array
3894   !> @param[in] dd_lat0   coarse grid latitude  array
3895   !> @param[in] id_imin0  coarse grid lower left corner i-indice of fine grid domain
3896   !> @param[in] id_jmin0  coarse grid lower left corner j-indice of fine grid domain
3897   !> @param[in] id_imax0  coarse grid upper right corner i-indice of fine grid domain
3898   !> @param[in] id_jmax0  coarse grid upper right corner j-indice of fine grid domain
3899   !> @param[in] dd_lon1   fine   grid longitude array
3900   !> @param[in] dd_lat1   fine   grid latitude  array
3901   !> @param[in] id_rho    array of refinement factor
3902   !> @param[in] cd_point  Arakawa grid point
3903   !> @return offset array (/ (/i_offset_left,i_offset_right/),(/j_offset_lower,j_offset_upper/) /)
3904   !-------------------------------------------------------------------
3905   FUNCTION grid__get_fine_offset_cc( dd_lon0, dd_lat0, &
3906   &                                  id_imin0, id_jmin0, id_imax0, id_jmax0, &
3907   &                                  dd_lon1, dd_lat1, id_rho, cd_point )
3908      IMPLICIT NONE
3909      ! Argument
3910      REAL(dp)        , DIMENSION(:,:), INTENT(IN) :: dd_lon0
3911      REAL(dp)        , DIMENSION(:,:), INTENT(IN) :: dd_lat0
3912      REAL(dp)        , DIMENSION(:,:), INTENT(IN) :: dd_lon1
3913      REAL(dp)        , DIMENSION(:,:), INTENT(IN) :: dd_lat1
3914
3915      INTEGER(i4)     ,                 INTENT(IN) :: id_imin0
3916      INTEGER(i4)     ,                 INTENT(IN) :: id_jmin0
3917      INTEGER(i4)     ,                 INTENT(IN) :: id_imax0
3918      INTEGER(i4)     ,                 INTENT(IN) :: id_jmax0
3919
3920      INTEGER(i4)     , DIMENSION(:)  , INTENT(IN) :: id_rho
3921      CHARACTER(LEN=*)                , INTENT(IN), OPTIONAL :: cd_point
3922
3923      ! function
3924      INTEGER(i4), DIMENSION(2,2) :: grid__get_fine_offset_cc
3925
3926      ! local variable
3927      CHARACTER(LEN= 1)                        :: cl_point
3928
3929      INTEGER(i4)                              :: i1
3930      INTEGER(i4)                              :: i2
3931      INTEGER(i4)                              :: j1
3932      INTEGER(i4)                              :: j2
3933
3934      INTEGER(i4), DIMENSION(2)                :: il_shape0
3935      INTEGER(i4), DIMENSION(2)                :: il_shape1
3936
3937      INTEGER(i4), DIMENSION(2)                :: il_ind
3938
3939      REAL(dp)   , DIMENSION(:,:), ALLOCATABLE :: dl_lon0
3940      REAL(dp)   , DIMENSION(:,:), ALLOCATABLE :: dl_lon1
3941
3942      REAL(dp)                                 :: dl_lonmax0
3943      REAL(dp)                                 :: dl_latmax0
3944      REAL(dp)                                 :: dl_lonmin0
3945      REAL(dp)                                 :: dl_latmin0
3946
3947      REAL(dp)                                 :: dl_lon0F
3948      REAL(dp)                                 :: dl_lat0F
3949      REAL(dp)                                 :: dl_dlon
3950      REAL(dp)                                 :: dl_dlat
3951
3952      LOGICAL    , DIMENSION(2)                :: ll_even
3953      LOGICAL                                  :: ll_greenwich
3954     
3955      ! loop indices
3956      INTEGER(i4) :: ii
3957      INTEGER(i4) :: ij
3958      !----------------------------------------------------------------
3959      IF( ANY( SHAPE(dd_lon0(:,:)) /= SHAPE(dd_lat0(:,:)) ) )THEN
3960         CALL logger_fatal("GRID GET FINE OFFSET: dimension of coarse "//&
3961         &              "longitude and latitude differ")
3962      ENDIF
3963
3964      IF( ANY( SHAPE(dd_lon1(:,:)) /= SHAPE(dd_lat1(:,:)) ) )THEN
3965         CALL logger_fatal("GRID GET FINE OFFSET: dimension of fine "//&
3966         &              "longitude and latitude differ")
3967      ENDIF
3968
3969      ll_even(:)=(/ (MOD(id_rho(jp_I),2)==0), (MOD(id_rho(jp_J),2)==0) /)
3970
3971      cl_point='T'
3972      IF( PRESENT(cd_point) ) cl_point=TRIM(fct_upper(cd_point))
3973
3974      il_shape0(:)=SHAPE(dd_lon0(:,:))
3975      ALLOCATE( dl_lon0(il_shape0(1),il_shape0(2)) )
3976
3977      il_shape1(:)=SHAPE(dd_lon1(:,:))
3978      ALLOCATE( dl_lon1(il_shape1(1),il_shape1(2)) )
3979
3980      dl_lon0(:,:)=dd_lon0(:,:)
3981      WHERE( dd_lon0(:,:) < 0 ) dl_lon0(:,:)=dd_lon0(:,:)+360.
3982
3983      dl_lon1(:,:)=dd_lon1(:,:)
3984      WHERE( dd_lon1(:,:) < 0 ) dl_lon1(:,:)=dd_lon1(:,:)+360.
3985
3986      ! init
3987      grid__get_fine_offset_cc(:,:)=-1
3988      ll_greenwich=.FALSE.
3989
3990      IF( il_shape1(jp_J) == 1 )THEN
3991 
3992         grid__get_fine_offset_cc(jp_J,:)=((id_rho(jp_J)-1)/2)
3993
3994         !!! work on i-direction
3995         !!! look for i-direction left offset
3996         i1=1 ; i2=MIN((id_rho(jp_I)+2),il_shape1(jp_I))
3997         j1=1 ; j2=1
3998
3999         ! check if cross greenwich meridien
4000         IF( minval(dl_lon0(id_imin0:id_imin0+1,id_jmin0))<5. .OR. &
4001           & maxval(dl_lon0(id_imin0:id_imin0+1,id_jmin0))>355. )THEN
4002            ! close to greenwich meridien
4003            ll_greenwich=.TRUE.
4004            ! 0:360 => -180:180
4005            WHERE( dl_lon0(id_imin0:id_imin0+1,id_jmin0) > 180. )
4006               dl_lon0(id_imin0:id_imin0+1,id_jmin0) = &
4007                  & dl_lon0(id_imin0:id_imin0+1,id_jmin0)-360.
4008            END WHERE
4009
4010            WHERE( dl_lon1(i1:i2,j1:j2) > 180. )
4011               dl_lon1(i1:i2,j1:j2)=dl_lon1(i1:i2,j1:j2)-360.
4012            END WHERE
4013         ENDIF
4014
4015         ! max lognitude of the left cell
4016         dl_lonmax0=dl_lon0(id_imin0+1,id_jmin0)
4017         IF( dl_lon1(1,1) < dl_lonmax0 )THEN
4018
4019            !!!!! i-direction !!!!!
4020            IF( ll_even(jp_I) )THEN
4021               ! even
4022               SELECT CASE(TRIM(cl_point))
4023                  CASE('F','U')
4024                     dl_dlon= ( dl_lon0(id_imin0+1,id_jmin0) -   &
4025                        &       dl_lon0(id_imin0  ,id_jmin0) ) / &
4026                        &     ( 2.*id_rho(jp_I) )
4027                  CASE DEFAULT
4028                     dl_dlon=0
4029               END SELECT
4030            ELSE
4031               ! odd
4032               dl_dlon= ( dl_lon0(id_imin0+1,id_jmin0) -   &
4033                  &       dl_lon0(id_imin0  ,id_jmin0) ) / &
4034                  &     ( 2.*id_rho(jp_I) )
4035            ENDIF
4036
4037            dl_lon0F= dl_lon0(id_imin0+1,id_jmin0) + dl_dlon
4038            dl_lat0F= dd_lat0(id_imin0+1,id_jmin0)
4039
4040            il_ind(:)=grid_get_closest( dl_lon1(i1:i2,j1:j2), dd_lat1(i1:i2,j1:j2), &
4041            &                           dl_lon0F, dl_lat0F, 'le' )
4042     
4043            ii=il_ind(1)
4044
4045            !!!!! i-direction !!!!!
4046            IF( ll_even(jp_I) )THEN
4047               ! even
4048               SELECT CASE(TRIM(cl_point))
4049                  CASE('T','V')
4050                     grid__get_fine_offset_cc(jp_I,1)=id_rho(jp_I)-ii
4051                  CASE DEFAULT !'F','U'
4052                     grid__get_fine_offset_cc(jp_I,1)=(id_rho(jp_I)+1)-ii
4053               END SELECT
4054            ELSE
4055               ! odd
4056               grid__get_fine_offset_cc(jp_I,1)=(id_rho(jp_I)+1)-ii
4057            ENDIF
4058
4059         ELSE
4060            CALL logger_error("GRID GET FINE OFFSET: coarse grid indices do "//&
4061            &                 " not match fine grid left corner.")
4062         ENDIF
4063
4064         IF( ll_greenwich )THEN
4065            ! close to greenwich meridien
4066            ll_greenwich=.FALSE.
4067            ! -180:180 => 0:360
4068            WHERE( dl_lon0(id_imin0:id_imin0+1,id_jmin0) < 0. )
4069               dl_lon0(id_imin0:id_imin0+1,id_jmin0) = &
4070                  & dl_lon0(id_imin0:id_imin0+1,id_jmin0)+360.
4071            END WHERE
4072
4073            WHERE( dl_lon1(i1:i2,j1:j2) < 0. )
4074               dl_lon1(i1:i2,j1:j2)=dl_lon1(i1:i2,j1:j2)+360.
4075            END WHERE
4076         ENDIF
4077
4078         !!!!!! look for i-direction right offset !!!!!!
4079         i1=MAX(1,il_shape1(jp_I)-(id_rho(jp_I)+2)+1) ; i2=il_shape1(jp_I)
4080         j1=1                                         ; j2=1
4081
4082         ! check if cross greenwich meridien
4083         IF( minval(dl_lon0(id_imax0-1:id_imax0,id_jmin0))<5. .OR. &
4084           & maxval(dl_lon0(id_imax0-1:id_imax0,id_jmin0))>355. )THEN
4085            ! close to greenwich meridien
4086            ll_greenwich=.TRUE.
4087            ! 0:360 => -180:180
4088            WHERE( dl_lon0(id_imax0-1:id_imax0,id_jmin0) > 180. )
4089               dl_lon0(id_imax0-1:id_imax0,id_jmin0) = &
4090                  & dl_lon0(id_imax0-1:id_imax0,id_jmin0)-360.
4091            END WHERE
4092
4093            WHERE( dl_lon1(i1:i2,j1:j2) > 180. )
4094               dl_lon1(i1:i2,j1:j2)=dl_lon1(i1:i2,j1:j2)-360.
4095            END WHERE
4096         ENDIF
4097
4098         ! min lognitude of the right cell
4099         dl_lonmin0=dl_lon0(id_imax0-1,id_jmin0)
4100         IF( dl_lon1(il_shape1(jp_I),il_shape1(jp_J)) > dl_lonmin0 )THEN
4101
4102            !!!!! i-direction !!!!!
4103            IF( ll_even(jp_I) )THEN
4104               ! even
4105               SELECT CASE(TRIM(cl_point))
4106                  CASE('F','U')
4107                     dl_dlon= ( dl_lon0(id_imax0  ,id_jmin0) -   &
4108                        &       dl_lon0(id_imax0-1,id_jmin0) ) / &
4109                        &     ( 2.*id_rho(jp_I) )
4110                  CASE DEFAULT
4111                     dl_dlon=0
4112               END SELECT
4113            ELSE
4114               ! odd
4115               dl_dlon= ( dl_lon0(id_imax0  ,id_jmin0) -   &
4116                  &       dl_lon0(id_imax0-1,id_jmin0) ) / &
4117                  &     ( 2.*id_rho(jp_I) )
4118            ENDIF
4119
4120            dl_lon0F= dl_lon0(id_imax0-1,id_jmin0) - dl_dlon
4121            dl_lat0F= dd_lat0(id_imax0-1,id_jmin0)
4122
4123            il_ind(:)=grid_get_closest( dl_lon1(i1:i2,j1:j2), dd_lat1(i1:i2,j1:j2), &
4124            &                           dl_lon0F, dl_lat0F, 'ri' )
4125
4126            ii=(MIN(il_shape1(jp_I),(id_rho(jp_I)+2))-il_ind(1)+1)
4127
4128            !!!!! i-direction !!!!!
4129            IF( ll_even(jp_I) )THEN
4130               ! even
4131               SELECT CASE(TRIM(cl_point))
4132                  CASE('T','V')
4133                     grid__get_fine_offset_cc(jp_I,2)=id_rho(jp_I)-ii
4134                  CASE DEFAULT !'F','U'
4135                     grid__get_fine_offset_cc(jp_I,2)=(id_rho(jp_I)+1)-ii
4136               END SELECT
4137            ELSE
4138               ! odd
4139               grid__get_fine_offset_cc(jp_I,2)=(id_rho(jp_I)+1)-ii
4140            ENDIF
4141
4142         ELSE
4143            CALL logger_error("GRID GET FINE OFFSET: coarse grid indices do "//&
4144            &                 " not match fine grid right corner.")
4145         ENDIF
4146
4147         IF( ll_greenwich )THEN
4148            ! close to greenwich meridien
4149            ll_greenwich=.FALSE.
4150            ! -180:180 => 0:360
4151            WHERE( dl_lon0(id_imax0-1:id_imax0,id_jmin0) < 0. )
4152               dl_lon0(id_imax0-1:id_imax0,id_jmin0) = &
4153                  & dl_lon0(id_imax0-1:id_imax0,id_jmin0)+360.
4154            END WHERE
4155
4156            WHERE( dl_lon1(i1:i2,j1:j2) < 0. )
4157               dl_lon1(i1:i2,j1:j2)=dl_lon1(i1:i2,j1:j2)+360.
4158            END WHERE
4159         ENDIF
4160
4161      ELSEIF( il_shape1(jp_I) == 1 )THEN
4162         
4163         grid__get_fine_offset_cc(jp_I,:)=((id_rho(jp_I)-1)/2)
4164         
4165         !!! work on j-direction
4166         !!! look for j-direction lower offset
4167         i1=1 ; i2=1
4168         j1=1 ; j2=MIN((id_rho(jp_J)+2),il_shape1(jp_J))
4169
4170
4171         ! max latitude of the lower cell
4172         dl_latmax0=dd_lat0(id_imin0,id_jmin0+1)
4173         IF( dd_lat1(1,1) < dl_latmax0 )THEN
4174
4175            IF( ll_even(jp_J) )THEN
4176               ! even
4177               SELECT CASE(TRIM(cl_point))
4178                  CASE('F','V')
4179                     dl_dlat= ( dd_lat0(id_imin0,id_jmin0+1) -   &
4180                        &       dd_lat0(id_imin0,id_jmin0  ) ) / &
4181                        &     ( 2.*id_rho(jp_J) )
4182                  CASE DEFAULT
4183                     dl_dlat=0
4184               END SELECT
4185            ELSE
4186               ! odd
4187               dl_dlat= ( dd_lat0(id_imin0,id_jmin0+1) -   &
4188                  &       dd_lat0(id_imin0,id_jmin0  ) ) / &
4189                  &     ( 2.*id_rho(jp_J) )
4190            ENDIF
4191
4192            dl_lon0F= dl_lon0(id_imin0,id_jmin0+1)
4193            dl_lat0F= dd_lat0(id_imin0,id_jmin0+1) + dl_dlat 
4194           
4195            il_ind(:)=grid_get_closest( dl_lon1(i1:i2,j1:j2), dd_lat1(i1:i2,j1:j2), &
4196            &                           dl_lon0F, dl_lat0F, 'lo' )
4197
4198            ij=il_ind(2)
4199
4200            !!!!! i-direction !!!!!
4201            IF( ll_even(jp_I) )THEN
4202               ! even
4203               SELECT CASE(TRIM(cl_point))
4204                  CASE('T','V')
4205                     grid__get_fine_offset_cc(jp_I,1)=id_rho(jp_I)-ii
4206                  CASE DEFAULT !'F','U'
4207                     grid__get_fine_offset_cc(jp_I,1)=(id_rho(jp_I)+1)-ii
4208               END SELECT
4209            ELSE
4210               ! odd
4211               grid__get_fine_offset_cc(jp_I,1)=(id_rho(jp_I)+1)-ii
4212            ENDIF
4213
4214         ELSE
4215            CALL logger_error("GRID GET FINE OFFSET: coarse grid indices do "//&
4216            &                 " not match fine grid lower corner.")
4217         ENDIF
4218
4219         !!! look for j-direction upper offset
4220         i1=1                                         ; i2=1
4221         j1=MAX(1,il_shape1(jp_J)-(id_rho(jp_J)+2)+1) ; j2=il_shape1(jp_J)
4222
4223         ! min latitude of the upper cell
4224         dl_latmin0=dd_lat0(id_imin0,id_jmax0-1)
4225         IF( dd_lat1(il_shape1(jp_I),il_shape1(jp_J)) > dl_latmin0 )THEN
4226
4227            IF( ll_even(jp_J) )THEN
4228               ! even
4229               SELECT CASE(TRIM(cl_point))
4230                  CASE('F','V')
4231                     dl_dlat= ( dd_lat0(id_imin0,id_jmax0  ) -   &
4232                        &       dd_lat0(id_imin0,id_jmax0-1) ) / &
4233                        &     ( 2.*id_rho(jp_J) )
4234                  CASE DEFAULT
4235                     dl_dlat=0
4236               END SELECT
4237            ELSE
4238               ! odd
4239               dl_dlat= ( dd_lat0(id_imin0,id_jmax0  ) -   &
4240                  &       dd_lat0(id_imin0,id_jmax0-1) ) / &
4241                  &     ( 2*id_rho(jp_J) )
4242            ENDIF
4243
4244            dl_lon0F= dl_lon0(id_imin0,id_jmax0-1) 
4245            dl_lat0F= dd_lat0(id_imin0,id_jmax0-1) - dl_dlat
4246           
4247            il_ind(:)=grid_get_closest( dl_lon1(i1:i2,j1:j2), dd_lat1(i1:i2,j1:j2), &
4248            &                           dl_lon0F, dl_lat0F, 'up' )
4249
4250            ij=(MIN(il_shape1(jp_J),(id_rho(jp_J)+2))-il_ind(2)+1)
4251
4252            !!!!! j-direction !!!!!
4253            IF( ll_even(jp_J) )THEN
4254               ! even
4255               SELECT CASE(TRIM(cl_point))
4256                  CASE('T','U')
4257                     grid__get_fine_offset_cc(jp_J,2)=id_rho(jp_J)-ij
4258                  CASE DEFAULT !'F','V'
4259                     grid__get_fine_offset_cc(jp_J,2)=(id_rho(jp_J)+1)-ij
4260               END SELECT
4261            ELSE
4262               ! odd
4263               grid__get_fine_offset_cc(jp_J,2)=(id_rho(jp_J)+1)-ij
4264            ENDIF
4265
4266         ELSE
4267            CALL logger_error("GRID GET FINE OFFSET: coarse grid indices do "//&
4268            &                 " not match fine grid upper corner.")
4269         ENDIF
4270
4271      ELSE ! il_shape1(1) > 1 .AND. il_shape1(2) > 1
4272
4273         !!!!!! look for lower left offset !!!!!!
4274         i1=1 ; i2=MIN((id_rho(jp_I)+2),il_shape1(jp_I))
4275         j1=1 ; j2=MIN((id_rho(jp_J)+2),il_shape1(jp_J))
4276
4277         ! check if cross greenwich meridien
4278         IF( minval(dl_lon0(id_imin0:id_imin0+1,id_jmin0:id_jmin0+1))<5. .OR. &
4279           & maxval(dl_lon0(id_imin0:id_imin0+1,id_jmin0:id_jmin0+1))>355. )THEN
4280            ! close to greenwich meridien
4281            ll_greenwich=.TRUE.
4282            ! 0:360 => -180:180
4283            WHERE( dl_lon0(id_imin0:id_imin0+1,id_jmin0:id_jmin0+1) > 180. )
4284               dl_lon0(id_imin0:id_imin0+1,id_jmin0:id_jmin0+1) = &
4285                  & dl_lon0(id_imin0:id_imin0+1,id_jmin0:id_jmin0+1)-360.
4286            END WHERE
4287
4288            WHERE( dl_lon1(i1:i2,j1:j2) > 180. )
4289               dl_lon1(i1:i2,j1:j2)=dl_lon1(i1:i2,j1:j2)-360.
4290            END WHERE
4291         ENDIF
4292
4293         ! max longitude of the lower left cell
4294         dl_lonmax0=MAX(dl_lon0(id_imin0+1,id_jmin0),dl_lon0(id_imin0+1,id_jmin0+1))
4295         ! max latitude of the lower left cell
4296         dl_latmax0=MAX(dd_lat0(id_imin0,id_jmin0+1),dd_lat0(id_imin0+1,id_jmin0+1))
4297         IF( dl_lon1(1,1) < dl_lonmax0 .AND. &
4298           & dd_lat1(1,1) < dl_latmax0 )THEN
4299
4300            !!!!! i-direction !!!!!
4301            IF( ll_even(jp_I) )THEN
4302               ! even
4303               SELECT CASE(TRIM(cl_point))
4304                  CASE('F','U')
4305                     dl_dlon= ( dl_lon0(id_imin0+1,id_jmin0+1) -   &
4306                        &       dl_lon0(id_imin0  ,id_jmin0+1) ) / &
4307                        &     ( 2.*id_rho(jp_I) )
4308                  CASE DEFAULT
4309                     dl_dlon=0
4310               END SELECT
4311            ELSE
4312               ! odd
4313               dl_dlon= ( dl_lon0(id_imin0+1,id_jmin0+1) -   &
4314                  &       dl_lon0(id_imin0  ,id_jmin0+1) ) / &
4315                  &     ( 2.*id_rho(jp_I) )
4316            ENDIF
4317
4318            !!!!! j-direction !!!!!
4319            IF( ll_even(jp_J) )THEN
4320               ! even
4321               SELECT CASE(TRIM(cl_point))
4322                  CASE('F','V')
4323                     dl_dlat= ( dd_lat0(id_imin0+1,id_jmin0+1) -   &
4324                        &       dd_lat0(id_imin0+1,id_jmin0  ) ) / &
4325                        &     ( 2.*id_rho(jp_J) )
4326                  CASE DEFAULT
4327                     dl_dlat=0
4328               END SELECT
4329            ELSE
4330               ! odd
4331               dl_dlat= ( dd_lat0(id_imin0+1,id_jmin0+1) -   &
4332                  &       dd_lat0(id_imin0+1,id_jmin0  ) ) / &
4333                  &     ( 2.*id_rho(jp_J) )
4334            ENDIF
4335
4336            dl_lon0F= dl_lon0(id_imin0+1,id_jmin0+1) + dl_dlon
4337            dl_lat0F= dd_lat0(id_imin0+1,id_jmin0+1) + dl_dlat
4338
4339            il_ind(:)=grid_get_closest( dl_lon1(i1:i2,j1:j2), dd_lat1(i1:i2,j1:j2), &
4340            &                           dl_lon0F, dl_lat0F, 'll' )
4341
4342            ii=il_ind(1)
4343            ij=il_ind(2)
4344
4345            !!!!! i-direction !!!!!
4346            IF( ll_even(jp_I) )THEN
4347               ! even
4348               SELECT CASE(TRIM(cl_point))
4349                  CASE('T','V')
4350                     grid__get_fine_offset_cc(jp_I,1)=id_rho(jp_I)-ii
4351                  CASE DEFAULT !'F','U'
4352                     grid__get_fine_offset_cc(jp_I,1)=(id_rho(jp_I)+1)-ii
4353               END SELECT
4354            ELSE
4355               ! odd
4356               grid__get_fine_offset_cc(jp_I,1)=(id_rho(jp_I)+1)-ii
4357            ENDIF
4358
4359            !!!!! j-direction !!!!!
4360            IF( ll_even(jp_J) )THEN
4361               ! even
4362               SELECT CASE(TRIM(cl_point))
4363                  CASE('T','U')
4364                     grid__get_fine_offset_cc(jp_J,1)=id_rho(jp_J)-ij
4365                  CASE DEFAULT !'F','V'
4366                     grid__get_fine_offset_cc(jp_J,1)=(id_rho(jp_J)+1)-ij
4367               END SELECT
4368            ELSE
4369               ! odd
4370               grid__get_fine_offset_cc(jp_J,1)=(id_rho(jp_J)+1)-ij
4371            ENDIF
4372
4373         ELSE
4374            CALL logger_error("GRID GET FINE OFFSET: coarse grid indices do"//&
4375            &                 " not match fine grid lower left corner.")
4376         ENDIF
4377
4378         IF( ll_greenwich )THEN
4379            ! close to greenwich meridien
4380            ll_greenwich=.FALSE.
4381            ! -180:180 => 0:360
4382            WHERE( dl_lon0(id_imin0:id_imin0+1,id_jmin0:id_jmin0+1) < 0. )
4383               dl_lon0(id_imin0:id_imin0+1,id_jmin0:id_jmin0+1) = &
4384                  & dl_lon0(id_imin0:id_imin0+1,id_jmin0:id_jmin0+1)+360.
4385            END WHERE
4386
4387            WHERE( dl_lon1(i1:i2,j1:j2) < 0. )
4388               dl_lon1(i1:i2,j1:j2)=dl_lon1(i1:i2,j1:j2)+360.
4389            END WHERE
4390         ENDIF
4391
4392         !!!!!! look for upper right offset !!!!!!
4393         i1=MAX(1,il_shape1(jp_I)-(id_rho(jp_I)+2)+1) ; i2=il_shape1(jp_I)
4394         j1=MAX(1,il_shape1(jp_J)-(id_rho(jp_J)+2)+1) ; j2=il_shape1(jp_J)
4395
4396         ! check if cross greenwich meridien
4397         IF( minval(dl_lon0(id_imax0-1:id_imax0,id_jmax0-1:id_jmax0))<5. .OR. &
4398           & maxval(dl_lon0(id_imax0-1:id_imax0,id_jmax0-1:id_jmax0))>355. )THEN
4399            ! close to greenwich meridien
4400            ll_greenwich=.TRUE.
4401            ! 0:360 => -180:180
4402            WHERE( dl_lon0(id_imax0-1:id_imax0,id_jmax0-1:id_jmax0) > 180. )
4403               dl_lon0(id_imax0-1:id_imax0,id_jmax0-1:id_jmax0) = &
4404                  & dl_lon0(id_imax0-1:id_imax0,id_jmax0-1:id_jmax0)-360.
4405            END WHERE
4406
4407            WHERE( dl_lon1(i1:i2,j1:j2) > 180. )
4408               dl_lon1(i1:i2,j1:j2)=dl_lon1(i1:i2,j1:j2)-360.
4409            END WHERE
4410         ENDIF
4411
4412         ! min latitude of the upper right cell
4413         dl_lonmin0=MIN(dl_lon0(id_imax0-1,id_jmax0-1),dl_lon0(id_imax0-1,id_jmax0))
4414         ! min latitude of the upper right cell
4415         dl_latmin0=MIN(dd_lat0(id_imax0-1,id_jmax0-1),dd_lat0(id_imax0,id_jmax0-1))
4416         IF( dl_lon1(il_shape1(jp_I),il_shape1(jp_J)) > dl_lonmin0 .AND. &
4417           & dd_lat1(il_shape1(jp_I),il_shape1(jp_J)) > dl_latmin0 )THEN
4418
4419            !!!!! i-direction !!!!!
4420            IF( ll_even(jp_I) )THEN
4421               ! even
4422               SELECT CASE(TRIM(cl_point))
4423                  CASE('F','U')
4424                     dl_dlon= ( dl_lon0(id_imax0  ,id_jmax0-1) -   &
4425                        &       dl_lon0(id_imax0-1,id_jmax0-1) ) / &
4426                        &     ( 2.*id_rho(jp_I) )
4427                  CASE DEFAULT
4428                     dl_dlon=0
4429               END SELECT               
4430            ELSE
4431               ! odd
4432               dl_dlon= ( dl_lon0(id_imax0  ,id_jmax0-1) -   &
4433                  &       dl_lon0(id_imax0-1,id_jmax0-1) ) / &
4434                  &     ( 2*id_rho(jp_I) )
4435            ENDIF
4436
4437            !!!!! j-direction !!!!!
4438            IF( ll_even(jp_J) )THEN
4439               ! even
4440               SELECT CASE(TRIM(cl_point))
4441                  CASE('F','V')
4442                     dl_dlat= ( dd_lat0(id_imax0-1,id_jmax0  ) -   &
4443                        &       dd_lat0(id_imax0-1,id_jmax0-1) ) / &
4444                        &     ( 2.*id_rho(jp_J) )
4445                  CASE DEFAULT
4446                     dl_dlat=0
4447               END SELECT
4448            ELSE
4449               ! odd
4450               dl_dlat= ( dd_lat0(id_imax0-1,id_jmax0  ) -   &
4451                  &       dd_lat0(id_imax0-1,id_jmax0-1) ) / &
4452                  &     ( 2*id_rho(jp_J) )
4453            ENDIF
4454
4455            dl_lon0F= dl_lon0(id_imax0-1,id_jmax0-1) - dl_dlon
4456            dl_lat0F= dd_lat0(id_imax0-1,id_jmax0-1) - dl_dlat
4457
4458            il_ind(:)=grid_get_closest( dl_lon1(i1:i2,j1:j2), dd_lat1(i1:i2,j1:j2), &
4459            &                           dl_lon0F, dl_lat0F, 'ur' )
4460
4461            ii=(MIN(il_shape1(jp_I),(id_rho(jp_I)+2))-il_ind(1)+1)
4462            ij=(MIN(il_shape1(jp_J),(id_rho(jp_J)+2))-il_ind(2)+1)
4463
4464            !!!!! i-direction !!!!!
4465            IF( ll_even(jp_I) )THEN
4466               ! even
4467               SELECT CASE(TRIM(cl_point))
4468                  CASE('T','V')
4469                     grid__get_fine_offset_cc(jp_I,2)=id_rho(jp_I)-ii
4470                  CASE DEFAULT !'F','U'
4471                     grid__get_fine_offset_cc(jp_I,2)=(id_rho(jp_I)+1)-ii
4472               END SELECT
4473            ELSE
4474               ! odd
4475               grid__get_fine_offset_cc(jp_I,2)=(id_rho(jp_I)+1)-ii
4476            ENDIF
4477
4478            !!!!! j-direction !!!!!
4479            IF( ll_even(jp_J) )THEN
4480               ! even
4481               SELECT CASE(TRIM(cl_point))
4482                  CASE('T','U')
4483                     grid__get_fine_offset_cc(jp_J,2)=id_rho(jp_J)-ij
4484                  CASE DEFAULT !'F','V'
4485                     grid__get_fine_offset_cc(jp_J,2)=(id_rho(jp_J)+1)-ij
4486               END SELECT
4487            ELSE
4488               ! odd
4489               grid__get_fine_offset_cc(jp_J,2)=(id_rho(jp_J)+1)-ij
4490            ENDIF
4491
4492         ELSE
4493            CALL logger_error("GRID GET FINE OFFSET: coarse grid indices do"//&
4494            &                 " not match fine grid upper right corner.")
4495         ENDIF
4496
4497         IF( ll_greenwich )THEN
4498            ! close to greenwich meridien
4499            ll_greenwich=.FALSE.
4500            ! -180:180 => 0:360
4501            WHERE( dl_lon0(id_imax0-1:id_imax0,id_jmax0-1:id_jmax0) < 0. )
4502               dl_lon0(id_imax0-1:id_imax0,id_jmax0-1:id_jmax0) = &
4503                  & dl_lon0(id_imax0-1:id_imax0,id_jmax0-1:id_jmax0)+360.
4504            END WHERE
4505
4506            WHERE( dl_lon1(i1:i2,j1:j2) < 0. )
4507               dl_lon1(i1:i2,j1:j2)=dl_lon1(i1:i2,j1:j2)+360.
4508            END WHERE
4509         ENDIF
4510
4511      ENDIF
4512
4513      DEALLOCATE( dl_lon0 )
4514      DEALLOCATE( dl_lon1 )
4515
4516      IF( ANY(grid__get_fine_offset_cc(:,:)==-1) )THEN
4517         CALL logger_fatal("GRID GET FINE OFFSET: can not found "//&
4518         &                 " offset between coarse and fine grid.")
4519      ENDIF
4520
4521   END FUNCTION grid__get_fine_offset_cc
4522   !-------------------------------------------------------------------
4523   !> @brief This subroutine check fine and coarse grid coincidence.
4524   !
4525   !> @details
4526   !
4527   !> @author J.Paul
4528   !> @date November, 2013- Initial Version
4529   !> @date October, 2014
4530   !> - work on mpp file structure instead of file structure
4531   !> @date February, 2016
4532   !> - use F-point to check coincidence for even refinment
4533   !> - use F-point estimation, if can not read it.
4534   !>
4535   !> @param[in] td_coord0 coarse grid coordinate file structure
4536   !> @param[in] td_coord1 fine   grid coordinate file structure
4537   !> @param[in] id_imin0  coarse grid lower left  corner i-indice of fine grid domain
4538   !> @param[in] id_imax0  coarse grid upper right corner i-indice of fine grid domain
4539   !> @param[in] id_jmin0  coarse grid lower left  corner j-indice of fine grid domain
4540   !> @param[in] id_jmax0  coarse grid upper right corner j-indice of fine grid domain 
4541   !> @param[in] id_rho    array of refinement factor
4542   !-------------------------------------------------------------------
4543   SUBROUTINE grid_check_coincidence( td_coord0, td_coord1, &
4544   &                                  id_imin0, id_imax0, &
4545   &                                  id_jmin0, id_jmax0, &
4546   &                                  id_rho )
4547      IMPLICIT NONE
4548     
4549      ! Argument     
4550      TYPE(TMPP)               , INTENT(IN) :: td_coord0
4551      TYPE(TMPP)               , INTENT(IN) :: td_coord1
4552      INTEGER(i4)              , INTENT(IN) :: id_imin0
4553      INTEGER(i4)              , INTENT(IN) :: id_imax0
4554      INTEGER(i4)              , INTENT(IN) :: id_jmin0
4555      INTEGER(i4)              , INTENT(IN) :: id_jmax0
4556      INTEGER(i4), DIMENSION(:), INTENT(IN) :: id_rho
4557
4558      ! local variable
4559      INTEGER(i4)               :: il_imid1
4560      INTEGER(i4)               :: il_jmid1
4561     
4562      INTEGER(i4)               :: il_ew0
4563      INTEGER(i4)               :: il_ew1
4564
4565      INTEGER(i4)               :: il_ind
4566
4567      INTEGER(i4)               :: il_imin1
4568      INTEGER(i4)               :: il_imax1
4569      INTEGER(i4)               :: il_jmin1
4570      INTEGER(i4)               :: il_jmax1
4571
4572      INTEGER(i4), DIMENSION(2) :: il_ind0
4573      INTEGER(i4), DIMENSION(2) :: il_ind1
4574
4575      INTEGER(i4), DIMENSION(2) :: il_ill1
4576      INTEGER(i4), DIMENSION(2) :: il_ilr1
4577      INTEGER(i4), DIMENSION(2) :: il_iul1
4578      INTEGER(i4), DIMENSION(2) :: il_iur1
4579
4580      REAL(dp)                  :: dl_lon0F
4581      REAL(dp)                  :: dl_lat0F
4582      REAL(dp)                  :: dl_lon0
4583      REAL(dp)                  :: dl_lat0
4584      REAL(dp)                  :: dl_lon1F
4585      REAL(dp)                  :: dl_lat1F
4586      REAL(dp)                  :: dl_lon1
4587      REAL(dp)                  :: dl_lat1
4588
4589      REAL(dp)                  :: dl_delta
4590
4591      LOGICAL                   :: ll_coincidence
4592      LOGICAL                   :: ll_even
4593      LOGICAL                   :: ll_grid0F
4594      LOGICAL                   :: ll_grid1F
4595
4596      TYPE(TVAR)                :: tl_lon0
4597      TYPE(TVAR)                :: tl_lat0
4598      TYPE(TVAR)                :: tl_lon0F
4599      TYPE(TVAR)                :: tl_lat0F
4600      TYPE(TVAR)                :: tl_lon1
4601      TYPE(TVAR)                :: tl_lat1
4602      TYPE(TVAR)                :: tl_lon1F
4603      TYPE(TVAR)                :: tl_lat1F
4604
4605      TYPE(TMPP)                :: tl_coord0
4606      TYPE(TMPP)                :: tl_coord1
4607
4608      TYPE(TDOM)                :: tl_dom0
4609
4610      ! loop indices
4611      INTEGER(i4) :: ji
4612      INTEGER(i4) :: jj
4613      !----------------------------------------------------------------
4614
4615      ll_coincidence=.TRUE.
4616
4617      ll_even=.FALSE.
4618      IF( MOD(id_rho(jp_I)*id_rho(jp_J),2) == 0 )THEN
4619         ll_even=.TRUE.
4620      ENDIF
4621
4622      ! copy structure
4623      tl_coord0=mpp_copy(td_coord0)
4624
4625      ! compute domain
4626      tl_dom0=dom_init( tl_coord0,         &
4627      &                 id_imin0, id_imax0,&
4628      &                 id_jmin0, id_jmax0 )
4629
4630      ! open mpp files
4631      CALL iom_dom_open(tl_coord0, tl_dom0)
4632
4633      ! read variable value on domain
4634      il_ind=var_get_index(tl_coord0%t_proc(1)%t_var(:), 'longitude_T')
4635      IF( il_ind /= 0 )THEN
4636         tl_lon0=iom_dom_read_var(tl_coord0,'longitude_T',tl_dom0)
4637      ELSE
4638         tl_lon0=iom_dom_read_var(tl_coord0,'longitude',tl_dom0)
4639      ENDIF
4640
4641      il_ind=var_get_index(tl_coord0%t_proc(1)%t_var(:), 'latitude_T')
4642      IF( il_ind /= 0 )THEN
4643         tl_lat0=iom_dom_read_var(tl_coord0,'latitude_T' ,tl_dom0)
4644      ELSE
4645         tl_lat0=iom_dom_read_var(tl_coord0,'latitude' ,tl_dom0)
4646      ENDIF
4647
4648      IF( ll_even )THEN
4649         ! look for variable value on domain for F point
4650         il_ind=var_get_index(tl_coord0%t_proc(1)%t_var(:), 'longitude_F')
4651         IF( il_ind /= 0 )THEN
4652            tl_lon0F=iom_dom_read_var(tl_coord0,'longitude_F',tl_dom0)
4653         ENDIF
4654
4655         il_ind=var_get_index(tl_coord0%t_proc(1)%t_var(:), 'latitude_F')
4656         IF( il_ind /= 0 )THEN
4657            tl_lat0F=iom_dom_read_var(tl_coord0,'latitude_F' ,tl_dom0)
4658         ENDIF
4659
4660         ll_grid0F=.FALSE.
4661         IF( ASSOCIATED(tl_lon0F%d_value) .AND. &
4662         &   ASSOCIATED(tl_lat0F%d_value) )THEN
4663            ll_grid0F=.TRUE.
4664         ENDIF
4665
4666      ENDIF
4667
4668      ! close mpp files
4669      CALL iom_dom_close(tl_coord0)
4670
4671      ! clean structure
4672      CALL mpp_clean(tl_coord0)
4673      CALL dom_clean(tl_dom0)
4674
4675      ! copy structure
4676      tl_coord1=mpp_copy(td_coord1)
4677
4678      ! open mpp files
4679      CALL iom_mpp_open(tl_coord1)
4680
4681      ! read fine longitue and latitude
4682      il_ind=var_get_index(tl_coord1%t_proc(1)%t_var(:), TRIM(tl_lon0%c_longname))
4683      IF( il_ind /= 0 )THEN
4684         tl_lon1=iom_mpp_read_var(tl_coord1,TRIM(tl_lon0%c_longname))
4685      ELSE
4686         tl_lon1=iom_mpp_read_var(tl_coord1,'longitude')
4687      ENDIF
4688      il_ind=var_get_index(tl_coord1%t_proc(1)%t_var(:), TRIM(tl_lat0%c_longname))
4689      IF( il_ind /= 0 )THEN
4690         tl_lat1=iom_mpp_read_var(tl_coord1,TRIM(tl_lat0%c_longname))
4691      ELSE
4692         tl_lat1=iom_mpp_read_var(tl_coord1,'latitude')
4693      ENDIF
4694     
4695      IF( ll_even )THEN
4696
4697         ! look for variable value on domain for F point
4698         il_ind=var_get_index(tl_coord1%t_proc(1)%t_var(:), 'longitude_F')
4699         IF( il_ind /= 0 )THEN
4700            tl_lon1F=iom_mpp_read_var(tl_coord1,'longitude_F')
4701         ENDIF
4702
4703         il_ind=var_get_index(tl_coord1%t_proc(1)%t_var(:), 'latitude_F')
4704         IF( il_ind /= 0 )THEN
4705            tl_lat1F=iom_mpp_read_var(tl_coord1,'latitude_F')
4706         ENDIF
4707
4708         ll_grid1F=.FALSE.
4709         IF( ASSOCIATED(tl_lon1F%d_value) .AND. &
4710         &   ASSOCIATED(tl_lat1F%d_value) )THEN
4711            ll_grid1F=.TRUE.
4712         ENDIF
4713
4714      ENDIF
4715
4716      ! close mpp files
4717      CALL iom_mpp_close(tl_coord1)
4718      ! clean structure
4719      CALL mpp_clean(tl_coord1)
4720
4721      CALL logger_debug("GRID CHECK COINCIDENCE:"//&
4722      &        " fine   grid "//TRIM(td_coord1%c_name) )
4723      CALL logger_debug("GRID CHECK COINCIDENCE:"//&
4724      &        " coarse grid "//TRIM(td_coord0%c_name) )
4725
4726      ! check domain
4727      ! check global grid
4728      IF( .NOT. grid_is_global(tl_lon0, tl_lat0) )THEN
4729         IF( grid_is_global(tl_lon1, tl_lat1) )THEN
4730
4731            ll_coincidence=.FALSE.
4732            CALL logger_fatal("GRID CHECK COINCIDENCE:"//&
4733            &        " fine   grid is global,"//&
4734            &        " coarse grid is not ")
4735
4736         ELSE
4737            il_ew1=tl_lon1%i_ew
4738            IF( il_ew1 >= 0 )THEN
4739               ! ew overlap
4740
4741               il_ew0=tl_lon0%i_ew
4742               IF( il_ew0 < 0 )THEN
4743                  CALL logger_fatal("GRID CHECK COINCIDENCE: "//&
4744                  &        "fine grid has east west overlap,"//&
4745                  &        " coarse grid not ")
4746               ENDIF
4747
4748               il_jmin1=1+ip_ghost
4749               il_jmax1=tl_lon1%t_dim(2)%i_len-ip_ghost
4750
4751               ll_coincidence=grid__check_lat(&
4752               &                     tl_lat0%d_value(1,:,1,1),&
4753               &                     tl_lat1%d_value(1,il_jmin1:il_jmax1,1,1))
4754
4755            ELSE
4756               ! other case
4757               il_imin1=1+ip_ghost
4758               il_jmin1=1+ip_ghost
4759
4760               il_imax1=tl_lon1%t_dim(1)%i_len-ip_ghost
4761               il_jmax1=tl_lon1%t_dim(2)%i_len-ip_ghost
4762
4763               ll_coincidence=grid__check_corner(&
4764               &                      tl_lon0%d_value(:,:,1,1),&
4765               &                      tl_lat0%d_value(:,:,1,1),&
4766               &                      tl_lon1%d_value(il_imin1:il_imax1, &
4767               &                                      il_jmin1:il_jmax1, &
4768               &                                      1,1),&
4769               &                      tl_lat1%d_value(il_imin1:il_imax1, &
4770               &                                      il_jmin1:il_jmax1, &
4771               &                                      1,1) )
4772
4773            ENDIF
4774 
4775         ENDIF
4776
4777         IF( .NOT. ll_coincidence )THEN
4778            CALL logger_fatal("GRID CHECK COINCIDENCE: no coincidence "//&
4779            &              "between fine grid and coarse grid: invalid domain." )
4780         ENDIF
4781
4782      ENDIF
4783 
4784      ! check refinement factor
4785      ! select point in middle of fine grid
4786      il_imid1=INT(tl_lon1%t_dim(1)%i_len*0.5)
4787      il_jmid1=INT(tl_lon1%t_dim(2)%i_len*0.5)
4788 
4789      dl_lon1=tl_lon1%d_value(il_imid1, il_jmid1,1,1)
4790      dl_lat1=tl_lat1%d_value(il_imid1, il_jmid1,1,1)
4791
4792      ! select closest point on coarse grid
4793      il_ind0(:)=grid_get_closest(tl_lon0%d_value(:,:,1,1),&
4794      &                           tl_lat0%d_value(:,:,1,1),&
4795      &                           dl_lon1, dl_lat1   )
4796
4797      IF( ANY(il_ind0(:)==0) )THEN
4798         CALL logger_fatal("GRID CHECK COINCIDENCE: can not find valid "//&
4799         &              "coarse grid indices: invalid domain." )
4800      ENDIF
4801
4802      IF( .NOT. ll_even )THEN
4803         ! case odd refinment in both direction
4804         ! work on T-point
4805
4806         dl_lon0=tl_lon0%d_value(il_ind0(1),il_ind0(2),1,1)
4807         dl_lat0=tl_lat0%d_value(il_ind0(1),il_ind0(2),1,1)
4808
4809         il_ind1(:)=grid_get_closest(tl_lon1%d_value(:,:,1,1),&
4810         &                           tl_lat1%d_value(:,:,1,1),&
4811         &                           dl_lon0, dl_lat0 )
4812
4813         ! check i-direction refinement factor
4814         DO ji=0,MIN(3,il_imid1)
4815
4816            IF( il_ind1(1)+ji*id_rho(jp_I)+1 > tl_lon1%t_dim(1)%i_len )THEN
4817               CALL logger_warn("GRID CHECK COINCIDENCE: domain to small "//&
4818               &  " to check i-direction refinement factor ")
4819               EXIT
4820            ELSE
4821               dl_lon0=tl_lon0%d_value(il_ind0(1)+ji             ,il_ind0(2),1,1)
4822               dl_lon1=tl_lon1%d_value(il_ind1(1)+ji*id_rho(jp_I),il_ind1(2),1,1)
4823
4824               ! assume there could be little difference due to interpolation
4825               IF( ABS(dl_lon1 - dl_lon0) > dp_delta )THEN
4826                  ll_coincidence=.FALSE.
4827                  CALL logger_debug("GRID CHECK COINCIDENCE: invalid "//&
4828                  &  "i-direction refinement factor ("//&
4829                  &   TRIM(fct_str(id_rho(jp_I)))//&
4830                  &  ") between fine grid and coarse grid ")
4831               ENDIF
4832            ENDIF
4833
4834         ENDDO
4835
4836         ! check j-direction refinement factor
4837         DO jj=0,MIN(3,il_jmid1)
4838
4839            IF( il_ind1(2)+jj*id_rho(jp_J)+1 > tl_lat1%t_dim(2)%i_len )THEN
4840               CALL logger_warn("GRID CHECK COINCIDENCE: domain to small "//&
4841               &  " to check j-direction refinement factor ")
4842               EXIT
4843            ELSE     
4844               dl_lat0=tl_lat0%d_value(il_ind0(1),il_ind0(2)+jj             ,1,1)
4845               dl_lat1=tl_lat1%d_value(il_ind1(1),il_ind1(2)+jj*id_rho(jp_J),1,1)
4846
4847               ! assume there could be little difference due to interpolation
4848               IF( ABS(dl_lat1-dl_lat0) > dp_delta )THEN
4849                  ll_coincidence=.FALSE.
4850                  CALL logger_debug("GRID CHECK COINCIDENCE: invalid "//&
4851                  &  "j-direction refinement factor ("//&
4852                  &   TRIM(fct_str(id_rho(jp_J)))//&
4853                  &  ") between fine grid and coarse grid ")
4854               ENDIF
4855            ENDIF
4856
4857         ENDDO
4858
4859      ELSE
4860         ! case even refinment at least in one direction
4861         ! work on F-point
4862
4863         dl_delta=dp_delta
4864         ! look for lower left fine point in coarse cell.
4865         IF( ll_grid0F )THEN
4866     
4867            ! lower left corner of coarse cell
4868            dl_lon0F=tl_lon0F%d_value(il_ind0(1)-1,il_ind0(2)-1,1,1)
4869            dl_lat0F=tl_lat0F%d_value(il_ind0(1)-1,il_ind0(2)-1,1,1)
4870
4871         ELSE
4872
4873            ! approximate lower left corner of coarse cell (with T point)
4874            dl_lon0F=( tl_lon0%d_value(il_ind0(1)  ,il_ind0(2)  ,1,1) + &
4875            &          tl_lon0%d_value(il_ind0(1)  ,il_ind0(2)-1,1,1) + &
4876            &          tl_lon0%d_value(il_ind0(1)-1,il_ind0(2)  ,1,1) + &
4877            &          tl_lon0%d_value(il_ind0(1)-1,il_ind0(2)-1,1,1) ) * 0.25
4878
4879            dl_lat0F=( tl_lat0%d_value(il_ind0(1)  ,il_ind0(2)  ,1,1) + &
4880            &          tl_lat0%d_value(il_ind0(1)  ,il_ind0(2)-1,1,1) + &
4881            &          tl_lat0%d_value(il_ind0(1)-1,il_ind0(2)  ,1,1) + &
4882            &          tl_lat0%d_value(il_ind0(1)-1,il_ind0(2)-1,1,1) ) * 0.25
4883
4884            ! as we use approximation of F-point we relax condition
4885            dl_delta=100*dp_delta
4886
4887         ENDIF
4888
4889         IF( ll_grid1F )THEN
4890     
4891            il_ind1(:)=grid_get_closest(tl_lon1F%d_value(:,:,1,1),&
4892            &                           tl_lat1F%d_value(:,:,1,1),&
4893            &                           dl_lon0F, dl_lat0F )
4894
4895         ELSE
4896
4897            il_ill1(:)=grid_get_closest(tl_lon1%d_value(:,:,1,1),&
4898            &                           tl_lat1%d_value(:,:,1,1),&
4899            &                           dl_lon0F, dl_lat0F, 'll' )
4900
4901            il_ilr1(:)=grid_get_closest(tl_lon1%d_value(:,:,1,1),&
4902            &                           tl_lat1%d_value(:,:,1,1),&
4903            &                           dl_lon0F, dl_lat0F, 'lr' )
4904
4905            il_iul1(:)=grid_get_closest(tl_lon1%d_value(:,:,1,1),&
4906            &                           tl_lat1%d_value(:,:,1,1),&
4907            &                           dl_lon0F, dl_lat0F, 'ul' )
4908
4909            il_iur1(:)=grid_get_closest(tl_lon1%d_value(:,:,1,1),&
4910            &                           tl_lat1%d_value(:,:,1,1),&
4911            &                           dl_lon0F, dl_lat0F, 'ur' )
4912
4913            ! as we use approximation of F-point we relax condition
4914            dl_delta=100*dp_delta
4915
4916         ENDIF
4917
4918         ! check i-direction refinement factor
4919         DO ji=0,MIN(3,il_imid1)
4920
4921            IF( il_ind1(1)+ji*id_rho(jp_I)+1 > tl_lon1%t_dim(1)%i_len )THEN
4922               CALL logger_warn("GRID CHECK COINCIDENCE: domain to small "//&
4923               &  " to check i-direction refinement factor ")
4924               EXIT
4925            ELSE
4926               IF( ll_grid0F )THEN
4927                  dl_lon0F=tl_lon0F%d_value(il_ind0(1)+ji-1, il_ind0(2)-1,1,1)
4928               ELSE
4929                  dl_lon0F= 0.25 * &
4930                  & ( tl_lon0%d_value(il_ind0(1)+ji  , il_ind0(2)  ,1,1) + &
4931                  &   tl_lon0%d_value(il_ind0(1)+ji-1, il_ind0(2)  ,1,1) + &
4932                  &   tl_lon0%d_value(il_ind0(1)+ji  , il_ind0(2)-1,1,1) + &
4933                  &   tl_lon0%d_value(il_ind0(1)+ji-1, il_ind0(2)-1,1,1) )
4934               ENDIF
4935
4936               IF( ll_grid1F )THEN
4937                  dl_lon1F= tl_lon1F%d_value( il_ind1(1)+ji*id_rho(jp_I), &
4938                                            & il_ind1(2),1,1)
4939               ELSE
4940                  dl_lon1F= 0.25 * &
4941                  & ( tl_lon1%d_value( il_ill1(1)+ji*id_rho(jp_I), &
4942                                     & il_ill1(2),1,1) + &
4943                  &   tl_lon1%d_value( il_ilr1(1)+ji*id_rho(jp_I), &
4944                                     & il_ilr1(2),1,1) + &
4945                  &   tl_lon1%d_value( il_iul1(1)+ji*id_rho(jp_I), &
4946                                     & il_iul1(2),1,1) + &
4947                  &   tl_lon1%d_value( il_iur1(1)+ji*id_rho(jp_I), &
4948                                     & il_iur1(2),1,1) )
4949                 
4950               ENDIF
4951
4952               ! assume there could be little difference due to interpolation
4953               IF( ABS(dl_lon1F - dl_lon0F) > dl_delta )THEN
4954                  ll_coincidence=.FALSE.
4955                  CALL logger_debug("GRID CHECK COINCIDENCE: invalid "//&
4956                  &  "i-direction refinement factor ("//&
4957                  &   TRIM(fct_str(id_rho(jp_I)))//&
4958                  &  ") between fine grid and coarse grid ")
4959               ENDIF
4960            ENDIF
4961
4962         ENDDO
4963
4964         ! check j-direction refinement factor
4965         DO jj=0,MIN(3,il_jmid1)
4966
4967            IF( il_ind1(2)+jj*id_rho(jp_J)+1 > tl_lat1%t_dim(2)%i_len )THEN
4968               CALL logger_warn("GRID CHECK COINCIDENCE: domain to small "//&
4969               &  " to check j-direction refinement factor ")
4970               EXIT
4971            ELSE     
4972               IF( ll_grid0F )THEN
4973                  dl_lat0F=tl_lat0F%d_value(il_ind0(1)-1, il_ind0(2)+jj-1,1,1)
4974               ELSE
4975                  dl_lat0F= 0.25 * &
4976                  & ( tl_lat0%d_value(il_ind0(1)  , il_ind0(2)+jj  ,1,1) + &
4977                  &   tl_lat0%d_value(il_ind0(1)-1, il_ind0(2)+jj  ,1,1) + &
4978                  &   tl_lat0%d_value(il_ind0(1)  , il_ind0(2)+jj-1,1,1) + &
4979                  &   tl_lat0%d_value(il_ind0(1)-1, il_ind0(2)+jj-1,1,1) )
4980               ENDIF
4981
4982               IF( ll_grid1F )THEN
4983                  dl_lat1F= tl_lat1F%d_value( il_ind1(1), &
4984                                            & il_ind1(2)+jj*id_rho(jp_J),1,1)
4985               ELSE
4986                  dl_lat1F= 0.25 * &
4987                  & ( tl_lat1%d_value( il_ill1(1), &
4988                                     & il_ill1(2)+jj*id_rho(jp_J),1,1) + &
4989                  &   tl_lat1%d_value( il_ilr1(1), &
4990                                     & il_ilr1(2)+jj*id_rho(jp_J),1,1) + &
4991                  &   tl_lat1%d_value( il_iul1(1), &
4992                                     & il_iul1(2)+jj*id_rho(jp_J),1,1) + &
4993                  &   tl_lat1%d_value( il_iur1(1), &
4994                                     & il_iur1(2)+jj*id_rho(jp_J),1,1) )
4995                 
4996               ENDIF
4997
4998               ! assume there could be little difference due to interpolation
4999               IF( ABS(dl_lat1F - dl_lat0F) > dl_delta )THEN
5000                  ll_coincidence=.FALSE.
5001                  CALL logger_debug("GRID CHECK COINCIDENCE: invalid "//&
5002                  &  "i-direction refinement factor ("//&
5003                  &   TRIM(fct_str(id_rho(jp_I)))//&
5004                  &  ") between fine grid and coarse grid ")
5005               ENDIF
5006            ENDIF
5007
5008         ENDDO
5009      ENDIF
5010
5011      ! clean
5012      CALL var_clean(tl_lon1)
5013      CALL var_clean(tl_lat1)
5014      CALL var_clean(tl_lon0)
5015      CALL var_clean(tl_lat0)
5016
5017      IF( .NOT. ll_coincidence )THEN
5018         CALL logger_fatal("GRID CHECK COINCIDENCE: no coincidence "//&
5019         &              "between fine and coarse grid: "//&
5020         &              "invalid refinement factor" )
5021      ENDIF
5022
5023   END SUBROUTINE grid_check_coincidence
5024   !-------------------------------------------------------------------
5025   !> @brief This function check that fine grid is
5026   !> inside coarse grid
5027   !
5028   !> @details
5029   !>
5030   !> @author J.Paul
5031   !> @date November, 2013 - Initial Version
5032   !
5033   !> @param[in] dd_lon0   array of coarse grid longitude
5034   !> @param[in] dd_lat0   array of coarse grid latitude
5035   !> @param[in] dd_lon1   array of fine   grid longitude
5036   !> @param[in] dd_lat1   array of fine   grid latitude
5037   !> @return logical, fine grid is inside coarse grid
5038   !-------------------------------------------------------------------
5039   FUNCTION grid__check_corner(dd_lon0, dd_lat0, &
5040   &                           dd_lon1, dd_lat1 )
5041   IMPLICIT NONE
5042      ! Argument     
5043      REAL(dp), DIMENSION(:,:), INTENT(IN) :: dd_lon0
5044      REAL(dp), DIMENSION(:,:), INTENT(IN) :: dd_lat0
5045      REAL(dp), DIMENSION(:,:), INTENT(IN) :: dd_lon1
5046      REAL(dp), DIMENSION(:,:), INTENT(IN) :: dd_lat1
5047
5048      ! function
5049      LOGICAL :: grid__check_corner
5050
5051      ! local variable
5052      INTEGER(i4), DIMENSION(2) :: il_shape0
5053      INTEGER(i4), DIMENSION(2) :: il_shape1
5054
5055      INTEGER(i4) :: il_imin0
5056      INTEGER(i4) :: il_jmin0
5057      INTEGER(i4) :: il_imax0
5058      INTEGER(i4) :: il_jmax0
5059
5060      INTEGER(i4) :: il_imin1
5061      INTEGER(i4) :: il_jmin1
5062      INTEGER(i4) :: il_imax1
5063      INTEGER(i4) :: il_jmax1
5064
5065      REAL(dp)    :: dl_lon0
5066      REAL(dp)    :: dl_lat0
5067
5068      REAL(dp)    :: dl_lon1
5069      REAL(dp)    :: dl_lat1
5070      ! loop indices
5071      !----------------------------------------------------------------
5072
5073      ! init
5074      grid__check_corner=.TRUE.
5075
5076      il_shape0=SHAPE(dd_lon0(:,:))
5077      il_shape1=SHAPE(dd_lon1(:,:))
5078
5079      !1- check if fine grid inside coarse grid domain
5080      il_imin0=1 ; il_imax0=il_shape0(1)
5081      il_jmin0=1 ; il_jmax0=il_shape0(2)
5082
5083      il_imin1=1 ; il_imax1=il_shape1(1)
5084      il_jmin1=1 ; il_jmax1=il_shape1(2)
5085
5086      ! check lower left corner
5087      dl_lon0 = dd_lon0(il_imin0, il_jmin0)
5088      dl_lat0 = dd_lat0(il_imin0, il_jmin0)
5089
5090      dl_lon1 = dd_lon1(il_imin1, il_jmin1)
5091      dl_lat1 = dd_lat1(il_imin1, il_jmin1)
5092
5093      IF( (ABS(dl_lon1-dl_lon0)>dp_delta) .AND. (dl_lon1 < dl_lon0 ) .OR. & 
5094      &   (ABS(dl_lat1-dl_lat0)>dp_delta) .AND. (dl_lat1 < dl_lat0 ) )THEN
5095
5096         CALL logger_error("GRID CHECK COINCIDENCE: fine grid lower left "//&
5097         &     "corner  not north east of coarse grid (imin,jmin) ")
5098         CALL logger_debug(" fine   grid lower left ( "//&
5099         &              TRIM(fct_str(dl_lon1))//","//&
5100         &              TRIM(fct_str(dl_lat1))//")" )
5101         CALL logger_debug(" coarse grid lower left ( "//&
5102         &              TRIM(fct_str(dl_lon0))//","//&
5103         &              TRIM(fct_str(dl_lat0))//")" )
5104         grid__check_corner=.FALSE.
5105
5106      ENDIF
5107
5108      ! check upper left corner
5109      dl_lon0 = dd_lon0(il_imin0, il_jmax0)
5110      dl_lat0 = dd_lat0(il_imin0, il_jmax0)
5111
5112      dl_lon1 = dd_lon1(il_imin1, il_jmax1)
5113      dl_lat1 = dd_lat1(il_imin1, il_jmax1)
5114
5115
5116      IF( (ABS(dl_lon1-dl_lon0)>dp_delta) .AND. (dl_lon1 < dl_lon0) .OR. &
5117      &   (ABS(dl_lat1-dl_lat0)>dp_delta) .AND. (dl_lat1 > dl_lat0) )THEN
5118
5119         CALL logger_error("GRID CHECK COINCIDENCE: fine grid upper left "//&
5120         &     "corner not south east of coarse grid (imin,jmax) ")
5121         CALL logger_debug(" fine   grid upper left ("//&
5122         &              TRIM(fct_str(dl_lon1))//","//&
5123         &              TRIM(fct_str(dl_lat1))//")")
5124         CALL logger_debug(" coasre grid upper left ("//&
5125         &              TRIM(fct_str(dl_lon0))//","//&
5126         &              TRIM(fct_str(dl_lat0))//")")
5127         grid__check_corner=.FALSE.
5128
5129      ENDIF
5130
5131      ! check lower right corner
5132      dl_lon0 = dd_lon0(il_imax0, il_jmin0)
5133      dl_lat0 = dd_lat0(il_imax0, il_jmin0)
5134
5135      dl_lon1 = dd_lon1(il_imax1, il_jmin1)
5136      dl_lat1 = dd_lat1(il_imax1, il_jmin1)
5137
5138
5139      IF( (ABS(dl_lon1-dl_lon0)>dp_delta) .AND. (dl_lon1 > dl_lon0) .OR. &
5140      &   (ABS(dl_lat1-dl_lat0)>dp_delta) .AND. (dl_lat1 < dl_lat0) )THEN
5141
5142         CALL logger_error("GRID CHECK COINCIDENCE: fine grid lower right "//&
5143         &     "corner not north west of coarse grid (imax,jmin) ")
5144         CALL logger_debug(" fine   grid lower right ( "//&
5145         &              TRIM(fct_str(dl_lon1))//","//&
5146         &              TRIM(fct_str(dl_lat1))//")" )
5147         CALL logger_debug(" coarse grid lower right ( "//&
5148         &              TRIM(fct_str(dl_lon0))//","//&
5149         &              TRIM(fct_str(dl_lat0))//")" )   
5150         grid__check_corner=.FALSE.
5151
5152      ENDIF
5153
5154      ! check upper right corner
5155      dl_lon0 = dd_lon0(il_imax0, il_jmax0)
5156      dl_lat0 = dd_lat0(il_imax0, il_jmax0)
5157
5158      dl_lon1 = dd_lon1(il_imax1, il_jmax1)
5159      dl_lat1 = dd_lat1(il_imax1, il_jmax1)
5160
5161      IF( (ABS(dl_lon1-dl_lon0)>dp_delta) .AND. (dl_lon1 > dl_lon0) .OR. &
5162      &   (ABS(dl_lat1-dl_lat0)>dp_delta) .AND. (dl_lat1 > dl_lat0) )THEN
5163
5164         CALL logger_error("GRID CHECK COINCIDENCE: fine grid upper right "//&
5165         &     "corner not south west of coarse grid (imax,jmax) ")
5166         CALL logger_debug(" fine   grid upper right ( "//&
5167         &              TRIM(fct_str(dl_lon1))//","//&
5168         &              TRIM(fct_str(dl_lat1))//")" )
5169         CALL logger_debug(" fine   imax1 jmax1 ( "//&
5170         &              TRIM(fct_str(il_imax1))//","//&
5171         &              TRIM(fct_str(il_jmax1))//")" )
5172         CALL logger_debug(" coarse grid upper right ( "//&
5173         &              TRIM(fct_str(dl_lon0))//","//&
5174         &              TRIM(fct_str(dl_lat0))//")" )   
5175         CALL logger_debug(" fine   imax0 jmax0 ( "//&
5176         &              TRIM(fct_str(il_imax0))//","//&
5177         &              TRIM(fct_str(il_jmax0))//")" )
5178         grid__check_corner=.FALSE.
5179
5180      ENDIF     
5181
5182   END FUNCTION grid__check_corner
5183   !-------------------------------------------------------------------
5184   !> @brief This function check that fine grid latitude are
5185   !> inside coarse grid latitude
5186   !
5187   !> @details
5188   !
5189   !> @author J.Paul
5190   !> @date November, 2013 - Initial Version
5191   !
5192   !> @param[in] dd_lat0   array of coarse grid latitude
5193   !> @param[in] dd_lat1   array of fine grid latitude
5194   !-------------------------------------------------------------------
5195   FUNCTION grid__check_lat(dd_lat0, dd_lat1)
5196      IMPLICIT NONE
5197      ! Argument
5198      REAL(dp), DIMENSION(:), INTENT(IN) :: dd_lat0
5199      REAL(dp), DIMENSION(:), INTENT(IN) :: dd_lat1
5200
5201      ! function
5202      LOGICAL :: grid__check_lat
5203
5204      ! local variable
5205      INTEGER(i4), DIMENSION(1) :: il_shape0
5206      INTEGER(i4), DIMENSION(1) :: il_shape1
5207
5208      INTEGER(i4) :: il_jmin0
5209      INTEGER(i4) :: il_jmax0
5210
5211      INTEGER(i4) :: il_jmin1
5212      INTEGER(i4) :: il_jmax1
5213      ! loop indices
5214      !----------------------------------------------------------------
5215
5216      ! init
5217      grid__check_lat=.TRUE.
5218
5219      il_shape0(:)=SHAPE(dd_lat0(:))
5220      il_shape1(:)=SHAPE(dd_lat1(:))
5221
5222      !1- check if fine grid inside coarse grid domain
5223      il_jmin0=1 ; il_jmax0=il_shape0(1)
5224      il_jmin1=1 ; il_jmax1=il_shape1(1)
5225
5226      ! check lower left fine grid
5227      IF( ABS(dd_lat1(il_jmin1)-dd_lat0(il_jmin0)) > dp_delta .AND. &
5228      &   dd_lat1(il_jmin1) < dd_lat0(il_jmin0) )THEN
5229
5230         CALL logger_error("GRID CHECK COINCIDENCE: fine grid lower point"//&
5231         &     " not north of coarse grid (jmin) ")
5232         CALL logger_debug(" fine grid lower point ( "//&
5233         &              TRIM(fct_str(dd_lat1(il_jmin1)))//")" )
5234         CALL logger_debug(" coarse grid lower point ( "//&
5235         &              TRIM(fct_str(dd_lat0(il_jmin0)))//")" )
5236         grid__check_lat=.FALSE.
5237
5238      ENDIF
5239
5240      ! check upper left fine grid
5241      IF( ABS(dd_lat1(il_jmax1)-dd_lat0(il_jmax0)) > dp_delta .AND. &
5242      &   dd_lat1(il_jmax1) > dd_lat0(il_jmax0) )THEN
5243
5244         CALL logger_error("GRID CHECK COINCIDENCE: fine grid upper point"//&
5245         &     " not south of coarse grid (jmax) ")
5246         CALL logger_debug(" fine grid upper point ("//&
5247         &              TRIM(fct_str(dd_lat1(il_jmax1)))//")")
5248         CALL logger_debug(" coasre grid upper point ("//&
5249         &              TRIM(fct_str(dd_lat0(il_jmax0)))//")")
5250         grid__check_lat=.FALSE.
5251
5252      ENDIF
5253     
5254   END FUNCTION grid__check_lat
5255   !-------------------------------------------------------------------
5256   !> @brief
5257   !> This subroutine add ghost cell at boundaries.
5258   !>
5259   !> @author J.Paul
5260   !> @date November, 2013 - Initial version
5261   !
5262   !> @param[inout] td_var array of variable structure
5263   !> @param[in] id_ghost  array of ghost cell factor
5264   !-------------------------------------------------------------------
5265   SUBROUTINE grid_add_ghost(td_var, id_ghost)
5266      IMPLICIT NONE
5267      ! Argument
5268      TYPE(TVAR) ,                 INTENT(INOUT) :: td_var
5269      INTEGER(i4), DIMENSION(2,2), INTENT(IN   ) :: id_ghost
5270
5271      ! local variable
5272      INTEGER(i4) :: il_imin
5273      INTEGER(i4) :: il_jmin
5274      INTEGER(i4) :: il_imax
5275      INTEGER(i4) :: il_jmax
5276
5277      REAL(dp), DIMENSION(:,:,:,:) , ALLOCATABLE :: dl_value
5278     
5279      TYPE(TVAR) :: tl_var
5280
5281      ! loop indices
5282      !----------------------------------------------------------------
5283
5284      IF( ALL(td_var%t_dim(1:2)%l_use) )THEN
5285
5286         CALL logger_warn( "ADD GHOST: dimension change in variable "//&
5287         &              TRIM(td_var%c_name) )
5288
5289         ! copy variable
5290         tl_var=var_copy(td_var)
5291
5292         CALL var_del_value(td_var)
5293
5294         ! compute indice to fill center
5295         il_imin=1+id_ghost(jp_I,1)*ip_ghost
5296         il_jmin=1+id_ghost(jp_J,1)*ip_ghost
5297
5298         il_imax=tl_var%t_dim(1)%i_len+id_ghost(jp_I,1)*ip_ghost
5299         il_jmax=tl_var%t_dim(2)%i_len+id_ghost(jp_J,1)*ip_ghost
5300
5301         ! compute new dimension
5302         td_var%t_dim(1)%i_len = tl_var%t_dim(1)%i_len + &
5303         &                             SUM(id_ghost(jp_I,:))*ip_ghost
5304         td_var%t_dim(2)%i_len = tl_var%t_dim(2)%i_len + &
5305         &                             SUM(id_ghost(jp_J,:))*ip_ghost
5306
5307         ALLOCATE(dl_value(td_var%t_dim(1)%i_len, &
5308         &                 td_var%t_dim(2)%i_len, &
5309         &                 td_var%t_dim(3)%i_len, &
5310         &                 td_var%t_dim(4)%i_len) )
5311
5312         dl_value(:,:,:,:)=tl_var%d_fill
5313
5314         dl_value(il_imin:il_imax, &
5315         &        il_jmin:il_jmax, &
5316         &              :,:)  =  tl_var%d_value(:,:,:,:)
5317
5318         ! add variable value
5319         CALL var_add_value(td_var,dl_value(:,:,:,:))
5320
5321         ! save variable type
5322         td_var%i_type=tl_var%i_type
5323         
5324         DEALLOCATE( dl_value )
5325
5326         CALL var_clean(tl_var)
5327
5328      ENDIF
5329
5330   END SUBROUTINE grid_add_ghost
5331   !-------------------------------------------------------------------
5332   !> @brief
5333   !> This subroutine delete ghost cell at boundaries.
5334   !>
5335   !> @author J.Paul
5336   !> @date November, 2013 - Initial version
5337   !
5338   !> @param[inout] td_var array of variable structure
5339   !> @param[in] id_ghost  array of ghost cell factor
5340   !-------------------------------------------------------------------
5341   SUBROUTINE grid_del_ghost(td_var, id_ghost)
5342      IMPLICIT NONE
5343      ! Argument
5344      TYPE(TVAR) ,                 INTENT(INOUT) :: td_var
5345      INTEGER(i4), DIMENSION(2,2), INTENT(IN   ) :: id_ghost
5346
5347      ! local variable
5348      INTEGER(i4) :: il_imin
5349      INTEGER(i4) :: il_jmin
5350      INTEGER(i4) :: il_imax
5351      INTEGER(i4) :: il_jmax
5352
5353      REAL(dp), DIMENSION(:,:,:,:) , ALLOCATABLE :: dl_value
5354     
5355      TYPE(TVAR) :: tl_var
5356
5357      ! loop indices
5358      !----------------------------------------------------------------
5359
5360      IF( ALL(td_var%t_dim(1:2)%l_use) )THEN
5361
5362         IF( ANY(id_ghost(:,:)/=0) )THEN
5363            CALL logger_warn( "GRID DEL GHOST: dimension change in variable "//&
5364            &              TRIM(td_var%c_name) )
5365         ENDIF
5366
5367         ! copy variable
5368         tl_var=var_copy(td_var)
5369
5370         CALL var_del_value(td_var)
5371
5372         ! compute indice to get center
5373         il_imin=1+id_ghost(jp_I,1)*ip_ghost
5374         il_jmin=1+id_ghost(jp_J,1)*ip_ghost
5375
5376         il_imax=tl_var%t_dim(1)%i_len-id_ghost(jp_I,2)*ip_ghost
5377         il_jmax=tl_var%t_dim(2)%i_len-id_ghost(jp_J,2)*ip_ghost
5378
5379         ! compute new dimension
5380         td_var%t_dim(1)%i_len = il_imax - il_imin +1 
5381         td_var%t_dim(2)%i_len = il_jmax - il_jmin +1 
5382
5383         ALLOCATE(dl_value(td_var%t_dim(1)%i_len, &
5384         &                 td_var%t_dim(2)%i_len, &
5385         &                 td_var%t_dim(3)%i_len, &
5386         &                 td_var%t_dim(4)%i_len) )
5387
5388         dl_value(:,:,:,:)=tl_var%d_fill
5389
5390         dl_value(:,:,:,:)  =  tl_var%d_value(il_imin:il_imax, &
5391         &                                    il_jmin:il_jmax, &
5392         &                                    :,:)
5393
5394         ! add variable value
5395         CALL var_add_value(td_var,dl_value(:,:,:,:))
5396
5397         ! save variable type
5398         td_var%i_type=tl_var%i_type
5399         
5400         DEALLOCATE( dl_value )
5401
5402         CALL var_clean(tl_var)
5403
5404      ENDIF
5405
5406   END SUBROUTINE grid_del_ghost
5407   !-------------------------------------------------------------------
5408   !> @brief This function check if ghost cell are used or not, and return ghost
5409   !> cell factor (0,1) in horizontal plan.
5410   !
5411   !> @details
5412   !> check if domain is global, and if there is an East-West overlap.
5413   !>
5414   !> @author J.Paul
5415   !> @date September, 2014 - Initial Version
5416   !
5417   !> @param[in] td_var variable sturcture
5418   !> @return array of ghost cell factor
5419   !-------------------------------------------------------------------
5420   FUNCTION grid__get_ghost_var( td_var )
5421      IMPLICIT NONE
5422      ! Argument
5423      TYPE(TVAR), INTENT(IN) :: td_var
5424
5425      ! function
5426      INTEGER(i4), DIMENSION(2,2) :: grid__get_ghost_var
5427
5428      ! local variable
5429      INTEGER(i4), DIMENSION(ip_maxdim) :: il_dim
5430
5431      ! loop indices
5432      !----------------------------------------------------------------
5433      ! init
5434      grid__get_ghost_var(:,:)=0
5435
5436      IF( .NOT. ALL(td_var%t_dim(1:2)%l_use) )THEN
5437         CALL logger_error("GRID GET GHOST: "//TRIM(td_var%c_name)//" is not a suitable"//&
5438         &                 " variable to look for ghost cell (not 2D).")
5439      ELSE
5440         IF( .NOT. ASSOCIATED(td_var%d_value) )THEN
5441            CALL logger_error("GRID GET GHOST: no value associated to "//TRIM(td_var%c_name)//&
5442            &                 ". can't look for ghost cell.")
5443         ELSE
5444            il_dim(:)=td_var%t_dim(:)%i_len
5445
5446            IF(ALL(td_var%d_value(    1    ,    :    ,1,1)/=td_var%d_fill).AND.&
5447            &  ALL(td_var%d_value(il_dim(1),    :    ,1,1)/=td_var%d_fill).AND.&
5448            &  ALL(td_var%d_value(    :    ,    1    ,1,1)/=td_var%d_fill).AND.&
5449            &  ALL(td_var%d_value(    :    ,il_dim(2),1,1)/=td_var%d_fill))THEN
5450            ! no boundary closed
5451               CALL logger_warn("GRID GET GHOST: can't determined ghost cell. "//&
5452               &             "there is no boundary closed for variable "//&
5453               &              TRIM(td_var%c_name))
5454
5455            ELSE
5456               ! check periodicity
5457               IF(ANY(td_var%d_value(   1     ,:,1,1)/=td_var%d_fill).OR.&
5458               &  ANY(td_var%d_value(il_dim(1),:,1,1)/=td_var%d_fill))THEN
5459               ! East-West cyclic (1,4,6)
5460                  CALL logger_info("GRID GET GHOST: East West cyclic")
5461                  grid__get_ghost_var(jp_I,:)=0
5462
5463                  IF( ANY(td_var%d_value(:, 1, 1, 1) /= td_var%d_fill) )THEN
5464                  ! South boundary not closed
5465
5466                     CALL logger_debug("GRID GET GHOST: East_West cyclic")
5467                     CALL logger_debug("GRID GET GHOST: South boundary not closed")
5468                     CALL logger_error("GRID GET GHOST: should have been an "//&
5469                     &              "impossible case")
5470
5471                  ELSE
5472                  ! South boundary closed (1,4,6)
5473                     CALL logger_info("GRID GET GHOST: South boundary closed")
5474                     grid__get_ghost_var(jp_J,1)=1
5475
5476                     IF(ANY(td_var%d_value(:,il_dim(2),1,1)/=td_var%d_fill) )THEN
5477                     ! North boundary not closed (4,6)
5478                        CALL logger_info("GRID GET GHOST: North boundary not closed")
5479                        grid__get_ghost_var(jp_J,2)=0
5480                     ELSE
5481                     ! North boundary closed
5482                        CALL logger_info("GRID GET GHOST: North boundary closed")
5483                        grid__get_ghost_var(jp_J,2)=1
5484                     ENDIF
5485
5486                  ENDIF
5487
5488               ELSE
5489               ! East-West boundaries closed (0,2,3,5)
5490                  CALL logger_info("GRID GET GHOST: East West boundaries closed")
5491                  grid__get_ghost_var(jp_I,:)=1
5492
5493                  IF( ANY(td_var%d_value(:, 1, 1, 1) /= td_var%d_fill) )THEN
5494                  ! South boundary not closed (2)
5495                     CALL logger_info("GRID GET GHOST: South boundary not closed")
5496                     grid__get_ghost_var(jp_J,1)=0
5497
5498                     IF(ANY(td_var%d_value(:,il_dim(2),1,1)/=td_var%d_fill))THEN
5499                     ! North boundary not closed
5500                        CALL logger_debug("GRID GET GHOST: East West boundaries "//&
5501                        &              "closed")
5502                        CALL logger_debug("GRID GET GHOST: South boundary not closed")
5503                        CALL logger_debug("GRID GET GHOST: North boundary not closed")
5504                        CALL logger_error("GRID GET GHOST: should have been "//&
5505                        &              "an impossible case")
5506                     ELSE
5507                     ! North boundary closed
5508                        grid__get_ghost_var(jp_J,2)=1
5509                     ENDIF
5510
5511                  ELSE
5512                  ! South boundary closed (0,3,5)
5513                     CALL logger_info("GRID GET GHOST: South boundary closed")
5514                     grid__get_ghost_var(jp_J,1)=1
5515
5516                     IF(ANY(td_var%d_value(:,il_dim(2),1,1)/=td_var%d_fill))THEN
5517                     ! North boundary not closed (3,5)
5518                        CALL logger_info("GRID GET GHOST: North boundary not closed")
5519                        grid__get_ghost_var(jp_J,2)=0
5520                     ELSE
5521                     ! North boundary closed   
5522                        CALL logger_info("GRID GET GHOST: North boundary closed")
5523                        grid__get_ghost_var(jp_J,2)=1
5524                     ENDIF
5525
5526                  ENDIF
5527
5528               ENDIF
5529
5530            ENDIF
5531
5532         ENDIF
5533      ENDIF
5534
5535   END FUNCTION grid__get_ghost_var
5536   !-------------------------------------------------------------------
5537   !> @brief This function check if ghost cell are used or not, and return ghost
5538   !> cell factor (0,1) in i- and j-direction.
5539   !
5540   !> @details
5541   !> get longitude an latitude array, then
5542   !> check if domain is global, and if there is an East-West overlap
5543   !>
5544   !> @author J.Paul
5545   !> @date September, 2014 - Initial Version
5546   !> @date October, 2014
5547   !> - work on mpp file structure instead of file structure
5548   !
5549   !> @param[in] td_file   file sturcture
5550   !> @return array of ghost cell factor
5551   !-------------------------------------------------------------------
5552   FUNCTION grid__get_ghost_mpp( td_mpp )
5553      IMPLICIT NONE
5554      ! Argument
5555      TYPE(TMPP), INTENT(IN) :: td_mpp
5556
5557      ! function
5558      INTEGER(i4), DIMENSION(2,2) :: grid__get_ghost_mpp
5559
5560      ! local variable
5561      !TYPE(TVAR)  :: tl_lon
5562      !TYPE(TVAR)  :: tl_lat
5563
5564      TYPE(TMPP) :: tl_mpp
5565
5566      !INTEGER(i4) :: il_lonid
5567      !INTEGER(i4) :: il_latid
5568      ! loop indices
5569      !----------------------------------------------------------------
5570      ! init
5571      grid__get_ghost_mpp(:,:)=0
5572
5573      IF( .NOT. ASSOCIATED(td_mpp%t_proc) )THEN
5574         CALL logger_error("GRID GET GHOST: decomposition of mpp file "//&
5575         &                 TRIM(td_mpp%c_name)//" not defined." )
5576
5577      ELSE
5578
5579         ! copy structure
5580         tl_mpp=mpp_copy(td_mpp)
5581
5582         CALL logger_info("GRID GET FINE GHOST perio"//TRIM(fct_str(tl_mpp%i_perio)))
5583         IF( tl_mpp%i_perio < 0 )THEN
5584            ! compute NEMO periodicity index
5585            CALL grid_get_info(tl_mpp)
5586         ENDIF
5587
5588         SELECT CASE(tl_mpp%i_perio)
5589            CASE(0)
5590               grid__get_ghost_mpp(:,:)=1
5591            CASE(1)
5592               grid__get_ghost_mpp(jp_J,:)=1
5593            CASE(2)
5594               grid__get_ghost_mpp(jp_I,:)=1
5595               grid__get_ghost_mpp(jp_J,2)=1
5596            CASE(3,5)
5597               grid__get_ghost_mpp(jp_I,:)=1
5598               grid__get_ghost_mpp(jp_J,1)=1
5599            CASE(4,6)
5600               grid__get_ghost_mpp(jp_J,1)=1
5601            CASE DEFAULT
5602         END SELECT
5603
5604         ! clean
5605         CALL mpp_clean(tl_mpp)
5606
5607      ENDIF
5608
5609   END FUNCTION grid__get_ghost_mpp
5610   !-------------------------------------------------------------------
5611   !> @brief This subroutine compute closed sea domain.
5612   !
5613   !> @details
5614   !> to each domain is associated a negative value id (from -1 to ...)<br/>
5615   !> optionaly you could specify which level use (default 1)
5616   !>
5617   !> @author J.Paul
5618   !> @date November, 2013 - Initial Version
5619   !
5620   !> @param[in] td_var    variable strucutre
5621   !> @param[in] id_level  level
5622   !> @return domain mask 
5623   !-------------------------------------------------------------------
5624   FUNCTION grid_split_domain(td_var, id_level)
5625      IMPLICIT NONE
5626      ! Argument
5627      TYPE(TVAR) , INTENT(IN) :: td_var
5628      INTEGER(i4), INTENT(IN), OPTIONAL :: id_level
5629
5630      ! function
5631      INTEGER(i4), DIMENSION(td_var%t_dim(1)%i_len, &
5632      &                      td_var%t_dim(2)%i_len ) :: grid_split_domain
5633
5634      ! local variable
5635      INTEGER(i4)                              :: il_domid
5636      INTEGER(i4)                              :: il_level
5637      INTEGER(i4), DIMENSION(2)                :: il_shape
5638      INTEGER(i4), DIMENSION(2)                :: il_ind
5639      INTEGER(i4), DIMENSION(:,:), ALLOCATABLE :: il_mask
5640      INTEGER(i4), DIMENSION(:,:), ALLOCATABLE :: il_tmp
5641
5642      LOGICAL                                  :: ll_full
5643
5644      ! loop indices
5645      INTEGER(i4) :: ji
5646      INTEGER(i4) :: jim
5647      INTEGER(i4) :: jip
5648      INTEGER(i4) :: jj
5649      INTEGER(i4) :: jjm
5650      INTEGER(i4) :: jjp
5651      !----------------------------------------------------------------
5652      il_level=1
5653      IF( PRESENT(id_level) ) il_level=id_level
5654
5655      ! init
5656      il_domid=-1
5657
5658      il_shape(:)=td_var%t_dim(1:2)%i_len
5659      ALLOCATE( il_mask(il_shape(1),il_shape(2)) )
5660      il_mask(:,:)=0
5661      WHERE( td_var%d_value(:,:,il_level,1)/=td_var%d_fill ) il_mask(:,:)=1
5662
5663      il_ind(:)=MAXLOC( il_mask(:,:) )
5664      DO WHILE( il_mask(il_ind(1), il_ind(2)) == 1 )
5665
5666         il_mask(il_ind(1),il_ind(2))=il_domid
5667         ll_full=.FALSE.
5668
5669         ALLOCATE( il_tmp(il_shape(1),il_shape(2)) )
5670
5671         DO WHILE( .NOT. ll_full )
5672            il_tmp(:,:)=0
5673
5674            ll_full=.TRUE.
5675            DO jj=1,il_shape(2)
5676               DO ji=1,il_shape(1)
5677                  IF( il_mask(ji,jj)==il_domid )THEN
5678                     jim=MAX(1,ji-1)   ;  jip=MIN(il_shape(1),ji+1)
5679                     jjm=MAX(1,jj-1)   ;  jjp=MIN(il_shape(2),jj+1)
5680                     
5681                     WHERE( il_mask(jim:jip,jjm:jjp)==1 )
5682                        il_mask(jim:jip,jjm:jjp)=il_domid
5683                        il_tmp(jim:jip,jjm:jjp)=1
5684                     END WHERE
5685
5686                  ENDIF
5687               ENDDO
5688            ENDDO
5689            IF( SUM(il_tmp(:,:))/=0 ) ll_full=.FALSE.
5690
5691         ENDDO
5692         DEALLOCATE( il_tmp )
5693
5694         il_ind(:)=MAXLOC( il_mask(:,:) )
5695         il_domid=il_domid-1
5696
5697      ENDDO
5698
5699      ! save result
5700      grid_split_domain(:,:)=il_mask(:,:)
5701
5702      DEALLOCATE( il_mask )
5703
5704      CALL logger_info("GRID SPLIT DOMAIN: "//TRIM( fct_str(ABS(il_domid+1)) )//&
5705      &             " domain found" ) 
5706
5707   END FUNCTION grid_split_domain
5708   !-------------------------------------------------------------------
5709   !> @brief This subroutine fill small closed sea with fill value.
5710   !>
5711   !> @details
5712   !> the minimum size (number of point) of closed sea to be kept could be
5713   !> sepcify with id_minsize.
5714   !> By default only the biggest sea is preserve.
5715   !>
5716   !> @author J.Paul
5717   !> @date November, 2013 - Initial Version
5718   !>
5719   !> @param[inout] td_var    variable structure
5720   !> @param[in] id_mask      domain mask (from grid_split_domain)
5721   !> @param[in] id_minsize   minimum size of sea to be kept
5722   !-------------------------------------------------------------------
5723   SUBROUTINE grid_fill_small_dom(td_var, id_mask, id_minsize)
5724      IMPLICIT NONE
5725      ! Argument     
5726      TYPE(TVAR) ,                 INTENT(INOUT) :: td_var
5727      INTEGER(i4), DIMENSION(:,:), INTENT(IN   ) :: id_mask
5728      INTEGER(i4),                 INTENT(IN   ), OPTIONAL :: id_minsize
5729
5730      ! local variable
5731      INTEGER(i4)                              :: il_ndom
5732      INTEGER(i4)                              :: il_minsize
5733      INTEGER(i4), DIMENSION(2)                :: il_shape
5734      INTEGER(i4), DIMENSION(:,:), ALLOCATABLE :: il_tmp
5735
5736      ! loop indices
5737      INTEGER(i4) :: ji
5738      INTEGER(i4) :: jk
5739      INTEGER(i4) :: jl
5740      !----------------------------------------------------------------
5741
5742      il_shape(:)=SHAPE(id_mask(:,:))
5743      IF( ANY(il_shape(:) /= td_var%t_dim(1:2)%i_len) )THEN
5744         CALL logger_error("GRID FILL SMALL DOM: variable and mask "//&
5745         &              "dimension differ")
5746      ELSE
5747
5748         il_ndom=MINVAL(id_mask(:,:))
5749
5750         ALLOCATE( il_tmp(il_shape(1),il_shape(2)) )
5751         il_tmp(:,:)=0
5752         DO ji=-1,il_ndom,-1
5753            WHERE( id_mask(:,:)==ji ) 
5754               il_tmp(:,:)=SUM(id_mask(:,:),id_mask(:,:)==ji)/ji
5755            END WHERE
5756         ENDDO
5757
5758         il_minsize=MAXVAL(il_tmp(:,:))
5759         IF( PRESENT(id_minsize) ) il_minsize=id_minsize
5760
5761         DO jl=1,td_var%t_dim(4)%i_len
5762            DO jk=1,td_var%t_dim(3)%i_len
5763               WHERE( il_tmp(:,:) < il_minsize ) 
5764                  td_var%d_value(:,:,jk,jl)=td_var%d_fill
5765               END WHERE
5766            ENDDO
5767         ENDDO
5768
5769         DEALLOCATE( il_tmp )
5770
5771      ENDIF
5772
5773   END SUBROUTINE grid_fill_small_dom
5774   !-------------------------------------------------------------------
5775   !> @brief This subroutine fill small domain inside bigger one.
5776   !>
5777   !> @details
5778   !> the minimum size (number of point) of domain sea to be kept could be
5779   !> is sepcified with id_minsize.
5780   !> smaller domain are included in the one they are embedded.
5781   !>
5782   !> @author J.Paul
5783   !> @date Ferbruay, 2015 - Initial Version
5784   !>
5785   !> @param[inout] id_mask      domain mask (from grid_split_domain)
5786   !> @param[in] id_minsize   minimum size of sea to be kept
5787   !-------------------------------------------------------------------
5788   SUBROUTINE grid_fill_small_msk(id_mask, id_minsize)
5789      IMPLICIT NONE
5790      ! Argument     
5791      INTEGER(i4), DIMENSION(:,:), INTENT(INOUT) :: id_mask
5792      INTEGER(i4),                 INTENT(IN   ) :: id_minsize
5793
5794      ! local variable
5795      INTEGER(i4)                              :: il_ndom
5796      INTEGER(i4)                              :: il_minsize
5797      INTEGER(i4)                              :: il_msk
5798     
5799      INTEGER(i4)                              :: jim
5800      INTEGER(i4)                              :: jjm
5801      INTEGER(i4)                              :: jip
5802      INTEGER(i4)                              :: jjp
5803
5804      INTEGER(i4), DIMENSION(2)                :: il_shape
5805      INTEGER(i4), DIMENSION(:,:), ALLOCATABLE :: il_tmp
5806
5807      ! loop indices
5808      INTEGER(i4) :: ii
5809      INTEGER(i4) :: ij
5810
5811      INTEGER(i4) :: ji
5812      INTEGER(i4) :: jj
5813      !----------------------------------------------------------------
5814
5815      il_shape(:)=SHAPE(id_mask(:,:))
5816      il_ndom=MINVAL(id_mask(:,:))
5817
5818      ALLOCATE( il_tmp(il_shape(1),il_shape(2)) )
5819      il_tmp(:,:)=0
5820      DO ji=-1,il_ndom,-1
5821         WHERE( id_mask(:,:)==ji ) 
5822            il_tmp(:,:)=SUM(id_mask(:,:),id_mask(:,:)==ji)/ji
5823         END WHERE
5824      ENDDO
5825
5826      DO WHILE( id_minsize > MINVAL(il_tmp(:,:)) )
5827
5828         DO jj=1,il_shape(2)
5829            DO ji=1,il_shape(1)
5830
5831               IF( il_tmp(ji,jj) < il_minsize )THEN
5832                  jim=MAX(1,ji-1)   ;  jip=MIN(il_shape(1),ji+1)
5833                  jjm=MAX(1,jj-1)   ;  jjp=MIN(il_shape(2),jj+1)
5834                 
5835                  il_msk=0
5836                  DO ij=jjm,jjp
5837                     DO ii=jim,jip
5838                        IF( id_mask(ii,ij) /= id_mask(ji,jj) )THEN
5839                           IF( il_msk == 0 )THEN
5840                              il_msk=id_mask(ii,ij)
5841                           ELSEIF( il_msk /= id_mask(ii,ij) )THEN
5842                              CALL logger_error("GRID FILL SMALL MSK: "//&
5843                              &  "small domain not embedded in bigger one"//&
5844                              &  ". point should be between two different"//&
5845                              &  " domain.")
5846                           ENDIF
5847                        ENDIF
5848                     ENDDO
5849                  ENDDO
5850                  IF( il_msk /= 0 ) id_mask(ji,jj)=il_msk
5851
5852               ENDIF
5853
5854            ENDDO
5855         ENDDO
5856
5857
5858         il_tmp(:,:)=0
5859         DO ji=-1,il_ndom,-1
5860            WHERE( id_mask(:,:)==ji ) 
5861               il_tmp(:,:)=SUM(id_mask(:,:),id_mask(:,:)==ji)/ji
5862            END WHERE
5863         ENDDO           
5864
5865      ENDDO
5866
5867      DEALLOCATE( il_tmp )
5868
5869
5870   END SUBROUTINE grid_fill_small_msk
5871END MODULE grid
5872
Note: See TracBrowser for help on using the repository browser.