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

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

Ignore:
Timestamp:
2016-04-20T11:33:10+02:00 (8 years ago)
Author:
davestorkey
Message:

Changes from nemo_v3_6_STABLE_copy branch.
Custom merge into /branches/UKMO/dev_r5518_GO6_package/NEMOGCM: r6237 cf. r5781 of /branches/UKMO/nemo_v3_6_STABLE_copy/NEMOGCM@6486

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/UKMO/dev_r5518_GO6_package/NEMOGCM/TOOLS/SIREN/src/grid.f90

    r5037 r6487  
    149149!>    CALL grid_check_coincidence(td_coord0, td_coord1,  
    150150!>                                id_imin0, id_imax0, id_jmin0, id_jmax0 
    151 !>                                [,id_rho]) 
     151!>                                ,id_rho) 
    152152!> @endcode 
    153153!>       - td_coord0 is coarse grid coordinate mpp structure 
     
    161161!>       - id_jmax0  is coarse grid upper right corner j-indice of fine grid  
    162162!> domain  
    163 !>       - id_rho    is array of refinement factor (default 1) 
     163!>       - id_rho    is array of refinement factor  
    164164!> 
    165165!>    to add ghost cell at boundaries:<br/> 
     
    213213!> @date October, 2014 
    214214!> - use mpp file structure instead of file 
     215!> @date February, 2015 
     216!> - add function grid_fill_small_msk to fill small domain inside bigger one 
    215217! 
    216218!> @note Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     
    255257   PUBLIC :: grid_split_domain         !< compute closed sea domain  
    256258   PUBLIC :: grid_fill_small_dom       !< fill small closed sea with fill value  
     259   PUBLIC :: grid_fill_small_msk       !< fill small domain inside bigger one  
    257260 
    258261                                     ! get closest coarse grid indices of fine grid domain 
     
    352355   !> @note need all processor files to be there 
    353356   !> @author J.Paul 
    354    !> - October, 2014- Initial Version 
     357   !> @date October, 2014 - Initial Version 
    355358   !> 
    356359   !> @param[inout] td_file file structure  
     
    466469   !> - compute East West overlap 
    467470   !> 
    468    !> @note need all processor files to be there 
     471   !> @note need all processor files 
    469472   !> @author J.Paul 
    470    !> - October, 2014- Initial Version 
     473   !> @date October, 2014 - Initial Version 
    471474   !> 
    472475   !> @param[in] td_mpp mpp structure  
     
    496499      il_ew   =-1 
    497500 
     501      CALL logger_info("GRID GET INFO: look for "//TRIM(td_mpp%c_name)) 
    498502      ! copy structure 
    499503      tl_mpp=mpp_copy(td_mpp) 
     
    523527      ENDIF 
    524528 
     529      CALL logger_info("GRID GET INFO: perio "//TRIM(fct_str(il_perio))) 
     530 
    525531      SELECT CASE(il_perio) 
    526532      CASE(3,4) 
     533         il_pivot=1 
     534      CASE(5,6) 
    527535         il_pivot=0 
    528       CASE(5,6) 
    529          il_pivot=1 
    530536      CASE(0,1,2) 
    531537         il_pivot=1 
     
    534540      IF( il_pivot < 0 .OR. il_pivot > 1 )THEN 
    535541         ! get pivot 
     542         CALL logger_info("GRID GET INFO: look for pivot ") 
    536543         il_pivot=grid_get_pivot(tl_mpp) 
    537544      ENDIF 
     
    539546      IF( il_perio < 0 .OR. il_perio > 6 )THEN 
    540547         ! get periodicity 
     548         CALL logger_info("GRID GET INFO: look for perio ") 
    541549         il_perio=grid_get_perio(tl_mpp, il_pivot) 
    542550      ENDIF 
     
    544552      IF( il_ew < 0 )THEN 
    545553         ! get periodicity 
     554         CALL logger_info("GRID GET INFO: look for overlap ") 
    546555         il_ew=grid_get_ew_overlap(tl_mpp) 
    547556      ENDIF 
     
    595604   !> 
    596605   !> @author J.Paul 
    597    !> - November, 2013- Subroutine written 
     606   !> @date November, 2013 - Initial version 
    598607   !> @date September, 2014 
    599608   !> - add dummy loop in case variable not over right point. 
     
    708717   !>  
    709718   !> @author J.Paul 
    710    !> - October, 2014 - Initial version 
     719   !> @date October, 2014 - Initial version 
    711720   ! 
    712721   !> @param[in] dd_value array of value 
     
    783792 
    784793         IF( ll_check )THEN 
    785             CALL logger_info("GRID GET PIVOT: T-pivot") 
     794            CALL logger_info("GRID GET PIVOT: F-pivot") 
    786795            grid__get_pivot_varT=0 
    787796         ENDIF 
     
    801810   !>  
    802811   !> @author J.Paul 
    803    !> - October, 2014 - Initial version 
     812   !> @date October, 2014 - Initial version 
    804813   ! 
    805814   !> @param[in] dd_value array of value 
     
    876885 
    877886         IF( ll_check )THEN 
    878             CALL logger_info("GRID GET PIVOT: T-pivot") 
     887            CALL logger_info("GRID GET PIVOT: F-pivot") 
    879888            grid__get_pivot_varU=0 
    880889         ENDIF 
     
    894903   !>  
    895904   !> @author J.Paul 
    896    !> - October, 2014 - Initial version 
     905   !> @date October, 2014 - Initial version 
    897906   ! 
    898907   !> @param[in] dd_value array of value 
     
    969978 
    970979         IF( ll_check )THEN 
    971             CALL logger_info("GRID GET PIVOT: T-pivot") 
     980            CALL logger_info("GRID GET PIVOT: F-pivot") 
    972981            grid__get_pivot_varV=0 
    973982         ENDIF 
     
    987996   !>  
    988997   !> @author J.Paul 
    989    !> - October, 2014 - Initial version 
     998   !> @date October, 2014 - Initial version 
    990999   ! 
    9911000   !> @param[in] dd_value array of value 
     
    10621071 
    10631072         IF( ll_check )THEN 
    1064             CALL logger_info("GRID GET PIVOT: T-pivot") 
     1073            CALL logger_info("GRID GET PIVOT: F-pivot") 
    10651074            grid__get_pivot_varF=0 
    10661075         ENDIF 
     
    10831092   !> 
    10841093   !> @author J.Paul 
    1085    !> - Ocotber, 2014- Initial version 
     1094   !> @date Ocotber, 2014 - Initial version 
    10861095   ! 
    10871096   !> @param[in] td_file file structure 
     
    11721181   !> 
    11731182   !> @author J.Paul 
    1174    !> - October, 2014 - Initial version 
     1183   !> @date October, 2014 - Initial version 
    11751184   ! 
    11761185   !> @param[in] td_mpp   mpp file structure 
     
    12771286   !> 1: cyclic east-west boundary 
    12781287   !> 2: symmetric boundary condition across the equator 
    1279    !> 3: North fold boundary (with a F-point pivot) 
    1280    !> 4: North fold boundary (with a F-point pivot) and cyclic east-west boundary 
    1281    !> 5: North fold boundary (with a T-point pivot) 
    1282    !> 6: North fold boundary (with a T-point pivot) and cyclic east-west boundary 
     1288   !> 3: North fold boundary (with a T-point pivot) 
     1289   !> 4: North fold boundary (with a T-point pivot) and cyclic east-west boundary 
     1290   !> 5: North fold boundary (with a F-point pivot) 
     1291   !> 6: North fold boundary (with a F-point pivot) and cyclic east-west boundary 
    12831292   !> 
    12841293   !> @warning pivot point should have been computed before run this script. see grid_get_pivot. 
    12851294   !> 
    12861295   !> @author J.Paul 
    1287    !> - November, 2013- Subroutine written 
     1296   !> @date November, 2013 - Initial version 
    12881297   !> @date October, 2014 
    12891298   !> - work on variable structure instead of file structure 
     
    14521461   !> 
    14531462   !> @author J.Paul 
    1454    !> - October, 2014 - Initial version 
     1463   !> @date October, 2014 - Initial version 
    14551464   !> 
    14561465   !> @param[in] td_file   file structure 
     
    15371546   !> 1: cyclic east-west boundary 
    15381547   !> 2: symmetric boundary condition across the equator 
    1539    !> 3: North fold boundary (with a F-point pivot) 
    1540    !> 4: North fold boundary (with a F-point pivot) and cyclic east-west boundary 
    1541    !> 5: North fold boundary (with a T-point pivot) 
    1542    !> 6: North fold boundary (with a T-point pivot) and cyclic east-west boundary 
     1548   !> 3: North fold boundary (with a T-point pivot) 
     1549   !> 4: North fold boundary (with a T-point pivot) and cyclic east-west boundary 
     1550   !> 5: North fold boundary (with a F-point pivot) 
     1551   !> 6: North fold boundary (with a F-point pivot) and cyclic east-west boundary 
    15431552   !> 
    15441553   !> @warning pivot point should have been computed before run this script. see grid_get_pivot. 
    15451554   !> 
    15461555   !> @author J.Paul 
    1547    !> - October, 2014 - Initial version 
     1556   !> @date October, 2014 - Initial version 
    15481557   ! 
    15491558   !> @param[in] td_mpp   mpp file structure 
     
    16341643   ! 
    16351644   !> @author J.Paul 
    1636    !> - November, 2013- Initial Version 
     1645   !> @date November, 2013 - Initial Version 
    16371646   !> @date October, 2014 
    16381647   !> - work on mpp file structure instead of file structure 
     
    17461755   !> 
    17471756   !> @author J.Paul 
    1748    !> - October, 2014- Initial Version 
     1757   !> @date October, 2014 - Initial Version 
    17491758   !> 
    17501759   !> @param[in] td_file file structure  
     
    17971806   ! 
    17981807   !> @author J.Paul 
    1799    !> - November, 2013- Initial Version 
     1808   !> @date November, 2013 - Initial Version 
    18001809   !> @date October, 2014 
    18011810   !> - work on mpp file structure instead of file structure 
     
    18531862   !> 
    18541863   !> @author J.Paul 
    1855    !> - November, 2013- Initial Version 
     1864   !> @date November, 2013 - Initial Version 
    18561865   !> 
    18571866   !> @param[in] td_lat latitude variable structure  
     
    18901899   ! 
    18911900   !> @author J.Paul 
    1892    !> - November, 2013- Initial Version 
     1901   !> @date November, 2013 - Initial Version 
    18931902   !> @date October, 2014 
    18941903   !> - work on mpp file structure instead of file structure 
     
    19781987   !> 
    19791988   !> @author J.Paul 
    1980    !> - November, 2013- Initial Version 
     1989   !> @date November, 2013 - Initial Version 
    19811990   !> @date September, 2014 
    19821991   !> - use grid point to read coordinates variable.  
    19831992   !> @date October, 2014 
    19841993   !> - work on mpp file structure instead of file structure 
     1994   !> @date February, 2015 
     1995   !> - use longitude or latitude as standard name, if can not find  
     1996   !> longitude_T, latitude_T... 
    19851997   !> 
    19861998   !> @param[in] td_coord0 coarse grid coordinate mpp structure 
     
    20042016 
    20052017      ! local variable 
    2006       TYPE(TMPP) :: tl_coord0 
    2007       TYPE(TMPP) :: tl_coord1 
    2008  
    2009       TYPE(TVAR)  :: tl_lon0 
    2010       TYPE(TVAR)  :: tl_lat0 
    2011       TYPE(TVAR)  :: tl_lon1 
    2012       TYPE(TVAR)  :: tl_lat1 
    2013  
    2014       INTEGER(i4), DIMENSION(:), ALLOCATABLE :: il_rho 
    2015  
    2016       INTEGER(i4), DIMENSION(2,2)         :: il_xghost0 
    2017       INTEGER(i4), DIMENSION(2,2)         :: il_xghost1 
    2018  
    2019       INTEGER(i4) :: il_imin0 
    2020       INTEGER(i4) :: il_imax0 
    2021       INTEGER(i4) :: il_jmin0 
    2022       INTEGER(i4) :: il_jmax0 
    2023  
    2024       CHARACTER(LEN= 1) :: cl_point 
    2025       CHARACTER(LEN=lc) :: cl_name 
     2018      CHARACTER(LEN= 1)                        :: cl_point 
     2019      CHARACTER(LEN=lc)                        :: cl_name 
     2020 
     2021      INTEGER(i4)                              :: il_imin0 
     2022      INTEGER(i4)                              :: il_imax0 
     2023      INTEGER(i4)                              :: il_jmin0 
     2024      INTEGER(i4)                              :: il_jmax0 
     2025      INTEGER(i4)                              :: il_ind 
     2026 
     2027      INTEGER(i4), DIMENSION(2,2)              :: il_xghost0 
     2028      INTEGER(i4), DIMENSION(2,2)              :: il_xghost1 
     2029 
     2030      INTEGER(i4), DIMENSION(:)  , ALLOCATABLE :: il_rho 
     2031 
     2032      TYPE(TVAR)                               :: tl_lon0 
     2033      TYPE(TVAR)                               :: tl_lat0 
     2034      TYPE(TVAR)                               :: tl_lon1 
     2035      TYPE(TVAR)                               :: tl_lat1 
     2036 
     2037      TYPE(TMPP)                               :: tl_coord0 
     2038      TYPE(TMPP)                               :: tl_coord1 
    20262039 
    20272040      ! loop indices 
     
    20572070         ! read coarse longitue and latitude 
    20582071         WRITE(cl_name,*) 'longitude_'//TRIM(cl_point) 
     2072         il_ind=var_get_id(tl_coord0%t_proc(1)%t_var(:), cl_name) 
     2073         IF( il_ind == 0 )THEN 
     2074            CALL logger_warn("GRID GET COARSE INDEX: no variable "//& 
     2075            &  TRIM(cl_name)//" in file "//TRIM(tl_coord0%c_name)//". & 
     2076            &  try to use longitude.") 
     2077            WRITE(cl_name,*) 'longitude' 
     2078         ENDIF 
    20592079         tl_lon0=iom_mpp_read_var(tl_coord0, TRIM(cl_name)) 
     2080 
    20602081         WRITE(cl_name,*) 'latitude_'//TRIM(cl_point) 
     2082         il_ind=var_get_id(tl_coord0%t_proc(1)%t_var(:), cl_name) 
     2083         IF( il_ind == 0 )THEN 
     2084            CALL logger_warn("GRID GET COARSE INDEX: no variable "//& 
     2085            &  TRIM(cl_name)//" in file "//TRIM(tl_coord0%c_name)//". & 
     2086            &  try to use latitude.") 
     2087            WRITE(cl_name,*) 'latitude' 
     2088         ENDIF 
    20612089         tl_lat0=iom_mpp_read_var(tl_coord0, TRIM(cl_name)) 
    20622090          
     
    20772105         ! read fine longitue and latitude 
    20782106         WRITE(cl_name,*) 'longitude_'//TRIM(cl_point) 
     2107         il_ind=var_get_id(tl_coord1%t_proc(1)%t_var(:), cl_name) 
     2108         IF( il_ind == 0 )THEN 
     2109            CALL logger_warn("GRID GET COARSE INDEX: no variable "//& 
     2110            &  TRIM(cl_name)//" in file "//TRIM(tl_coord1%c_name)//". & 
     2111            &  try to use longitude.") 
     2112            WRITE(cl_name,*) 'longitude' 
     2113         ENDIF 
    20792114         tl_lon1=iom_mpp_read_var(tl_coord1, TRIM(cl_name))  
     2115 
    20802116         WRITE(cl_name,*) 'latitude_'//TRIM(cl_point) 
     2117         il_ind=var_get_id(tl_coord1%t_proc(1)%t_var(:), cl_name) 
     2118         IF( il_ind == 0 )THEN 
     2119            CALL logger_warn("GRID GET COARSE INDEX: no variable "//& 
     2120            &  TRIM(cl_name)//" in file "//TRIM(tl_coord1%c_name)//". & 
     2121            &  try to use latitude.") 
     2122            WRITE(cl_name,*) 'latitude' 
     2123         ENDIF 
    20812124         tl_lat1=iom_mpp_read_var(tl_coord1, TRIM(cl_name)) 
    20822125  
     
    21272170   !> 
    21282171   !> @author J.Paul 
    2129    !> - November, 2013- Initial Version 
     2172   !> @date November, 2013 - Initial Version 
    21302173   !> @date September, 2014 
    21312174   !> - use grid point to read coordinates variable. 
    21322175   !> @date October, 2014 
    21332176   !> - work on mpp file structure instead of file structure 
     2177   !> @date February, 2015 
     2178   !> - use longitude or latitude as standard name, if can not find  
     2179   !> longitude_T, latitude_T... 
    21342180   !> 
    21352181   !> @param[in] td_longitude0   coarse grid longitude 
     
    21542200 
    21552201      ! local variable 
    2156       TYPE(TMPP)  :: tl_coord1 
    2157  
    2158       TYPE(TVAR)  :: tl_lon1 
    2159       TYPE(TVAR)  :: tl_lat1 
    2160  
    2161       INTEGER(i4), DIMENSION(:), ALLOCATABLE :: il_rho 
    2162  
    2163       INTEGER(i4), DIMENSION(2,2)       :: il_xghost 
    2164  
    2165       CHARACTER(LEN= 1) :: cl_point 
    2166       CHARACTER(LEN=lc) :: cl_name 
     2202      CHARACTER(LEN= 1)                        :: cl_point 
     2203      CHARACTER(LEN=lc)                        :: cl_name 
     2204 
     2205      INTEGER(i4)                              :: il_ind 
     2206 
     2207      INTEGER(i4), DIMENSION(:)  , ALLOCATABLE :: il_rho 
     2208 
     2209      INTEGER(i4), DIMENSION(2,2)              :: il_xghost 
     2210 
     2211      TYPE(TVAR)                               :: tl_lon1 
     2212      TYPE(TVAR)                               :: tl_lat1 
     2213 
     2214      TYPE(TMPP)                               :: tl_coord1 
    21672215 
    21682216      ! loop indices 
     
    22092257         ! read fine longitue and latitude 
    22102258         WRITE(cl_name,*) 'longitude_'//TRIM(cl_point) 
     2259         il_ind=var_get_id(tl_coord1%t_proc(1)%t_var(:), cl_name) 
     2260         IF( il_ind == 0 )THEN 
     2261            CALL logger_warn("GRID GET COARSE INDEX: no variable "//& 
     2262            &  TRIM(cl_name)//"in file "//TRIM(tl_coord1%c_name)//". & 
     2263            &  try to use longitude.") 
     2264            WRITE(cl_name,*) 'longitude' 
     2265         ENDIF 
    22112266         tl_lon1=iom_mpp_read_var(tl_coord1, TRIM(cl_name)) 
     2267 
    22122268         WRITE(cl_name,*) 'latitude_'//TRIM(cl_point) 
     2269         il_ind=var_get_id(tl_coord1%t_proc(1)%t_var(:), cl_name) 
     2270         IF( il_ind == 0 )THEN 
     2271            CALL logger_warn("GRID GET COARSE INDEX: no variable "//& 
     2272            &  TRIM(cl_name)//"in file "//TRIM(tl_coord1%c_name)//". & 
     2273            &  try to use longitude.") 
     2274            WRITE(cl_name,*) 'latitude' 
     2275         ENDIF 
    22132276         tl_lat1=iom_mpp_read_var(tl_coord1, TRIM(cl_name)) 
    22142277          
     
    22442307   !> 
    22452308   !> @author J.Paul 
    2246    !> - November, 2013- Initial Version 
     2309   !> @date November, 2013 - Initial Version 
    22472310   !> @date September, 2014 
    22482311   !> - use grid point to read coordinates variable. 
    22492312   !> @date October, 2014 
    22502313   !> - work on mpp file structure instead of file structure 
     2314   !> @date February, 2015 
     2315   !> - use longitude or latitude as standard name, if can not find  
     2316   !> longitude_T, latitude_T... 
    22512317   !>  
    22522318   !> @param[in] td_coord0 coarse grid coordinate mpp structure 
     
    22712337 
    22722338      ! local variable 
    2273       TYPE(TMPP)  :: tl_coord0 
    2274  
    2275       TYPE(TVAR)  :: tl_lon0 
    2276       TYPE(TVAR)  :: tl_lat0 
    2277  
    2278       INTEGER(i4), DIMENSION(:), ALLOCATABLE :: il_rho 
    2279  
    2280       INTEGER(i4), DIMENSION(2,2)       :: il_xghost 
    2281  
    2282       INTEGER(i4) :: il_imin0 
    2283       INTEGER(i4) :: il_imax0 
    2284       INTEGER(i4) :: il_jmin0 
    2285       INTEGER(i4) :: il_jmax0 
    2286  
    2287       CHARACTER(LEN= 1) :: cl_point 
    2288       CHARACTER(LEN=lc) :: cl_name       
     2339      CHARACTER(LEN= 1)                        :: cl_point 
     2340      CHARACTER(LEN=lc)                        :: cl_name       
     2341 
     2342      INTEGER(i4)                              :: il_imin0 
     2343      INTEGER(i4)                              :: il_imax0 
     2344      INTEGER(i4)                              :: il_jmin0 
     2345      INTEGER(i4)                              :: il_jmax0 
     2346      INTEGER(i4)                              :: il_ind 
     2347 
     2348      INTEGER(i4), DIMENSION(:), ALLOCATABLE   :: il_rho 
     2349 
     2350      INTEGER(i4), DIMENSION(2,2)              :: il_xghost 
     2351 
     2352      TYPE(TVAR)                               :: tl_lon0 
     2353      TYPE(TVAR)                               :: tl_lat0 
     2354 
     2355      TYPE(TMPP)                               :: tl_coord0 
    22892356 
    22902357      ! loop indices 
     
    23302397         ! read coarse longitue and latitude 
    23312398         WRITE(cl_name,*) 'longitude_'//TRIM(cl_point) 
     2399         il_ind=var_get_id(tl_coord0%t_proc(1)%t_var(:), cl_name) 
     2400         IF( il_ind == 0 )THEN 
     2401            CALL logger_warn("GRID GET COARSE INDEX: no variable "//& 
     2402            &  TRIM(cl_name)//"in file "//TRIM(tl_coord0%c_name)//". & 
     2403            &  try to use longitude.") 
     2404            WRITE(cl_name,*) 'longitude' 
     2405         ENDIF 
    23322406         tl_lon0=iom_mpp_read_var(tl_coord0, TRIM(cl_name)) 
     2407          
    23332408         WRITE(cl_name,*) 'latitude_'//TRIM(cl_point) 
     2409         il_ind=var_get_id(tl_coord0%t_proc(1)%t_var(:), cl_name) 
     2410         IF( il_ind == 0 )THEN 
     2411            CALL logger_warn("GRID GET COARSE INDEX: no variable "//& 
     2412            &  TRIM(cl_name)//"in file "//TRIM(tl_coord0%c_name)//". & 
     2413            &  try to use latitude.") 
     2414            WRITE(cl_name,*) 'latitude' 
     2415         ENDIF 
    23342416         tl_lat0=iom_mpp_read_var(tl_coord0, TRIM(cl_name)) 
    23352417 
     
    23772459   !> 
    23782460   !> @author J.Paul 
    2379    !> - November, 2013- Initial Version 
     2461   !> @date November, 2013 - Initial Version 
    23802462   !> @date September, 2014 
    23812463   !> - check grid point 
     
    25202602            CALL grid_del_ghost(tl_lon0, il_xghost0(:,:)) 
    25212603            CALL grid_del_ghost(tl_lat0, il_xghost0(:,:)) 
    2522              
     2604  
    25232605            ! "global" coarse grid indice 
    25242606            il_imin0=1 
     
    25682650            IF( dl_lon1_ll == tl_lon1%d_fill .OR. & 
    25692651            &   dl_lat1_ll == tl_lat1%d_fill )THEN 
     2652               CALL logger_debug("GRID GET COARSE INDEX: lon "//& 
     2653               &  TRIM(fct_str(dl_lon1_ll))//" "//& 
     2654               &  TRIM(fct_str(tl_lon1%d_fill)) ) 
     2655               CALL logger_debug("GRID GET COARSE INDEX: lat "//& 
     2656               &  TRIM(fct_str(dl_lat1_ll))//" "//& 
     2657               &  TRIM(fct_str(tl_lat1%d_fill)) ) 
    25702658               CALL logger_error("GRID GET COARSE INDEX: lower left corner "//& 
    25712659               &                 "point is FillValue. remove ghost cell "//& 
     
    26322720            ji = il_iul(1) 
    26332721            jj = il_iul(2) 
    2634  
    26352722            IF( ABS(tl_lon0%d_value(ji,jj,1,1)-dl_lon1_ul) > dp_delta )THEN 
    26362723               IF(tl_lon0%d_value(ji,jj,1,1) > dl_lon1_ul )THEN 
     
    26472734               ENDIF 
    26482735            ENDIF 
    2649  
    26502736            IF( ABS(tl_lat0%d_value(ji,jj,1,1)-dl_lat1_ul) > dp_delta )THEN 
    26512737               IF(tl_lat0%d_value(ji,jj,1,1) < dl_lat1_ul )THEN 
     
    27982884   ! 
    27992885   !> @author J.Paul 
    2800    !> - November, 2013- Initial Version 
     2886   !> @date November, 2013 - Initial Version 
    28012887   ! 
    28022888   !> @param[in] td_lon longitude structure  
     
    28662952   !> 
    28672953   !> @author J.Paul 
    2868    !> - November, 2013- Initial Version 
     2954   !> @date November, 2013 - Initial Version 
     2955   !> @date February, 2015 - change dichotomy method to manage ORCA grid 
    28692956   ! 
    28702957   !> @param[in] dd_lon0   coarse grid array of longitude 
     
    28722959   !> @param[in] dd_lon1   fine   grid longitude 
    28732960   !> @param[in] dd_lat1   fine   grid latitude 
     2961   !> @param[in] dd_fill   fill value 
    28742962   !> @return coarse grid indices of closest point of fine grid point 
    2875    !> 
    2876    !------------------------------------------------------------------- 
    2877    FUNCTION grid_get_closest( dd_lon0, dd_lat0, dd_lon1, dd_lat1  ) 
     2963   !------------------------------------------------------------------- 
     2964   FUNCTION grid_get_closest( dd_lon0, dd_lat0, dd_lon1, dd_lat1, dd_fill ) 
    28782965      IMPLICIT NONE 
    28792966      ! Argument 
     
    28822969      REAL(dp),                 INTENT(IN) :: dd_lon1 
    28832970      REAL(dp),                 INTENT(IN) :: dd_lat1 
     2971      REAL(dp),                 INTENT(IN), OPTIONAL :: dd_fill 
    28842972 
    28852973      ! function 
     
    29293017 
    29303018      ll_north=.FALSE. 
    2931       ll_continue=.TRUE. 
    2932  
    2933       ! look for meridian 0°/360° 
    2934       il_jmid = il_jinf + INT(il_shape(2)/2) 
    2935       il_ind(:) = MAXLOC( dl_lon0(:,il_jmid), dl_lon0(:,il_jmid) <= 360._dp ) 
    2936  
    2937       il_imid=il_ind(1) 
    2938  
    2939       IF( dl_lon1 == dl_lon0(il_imid,il_jmid) .AND. & 
    2940       &   dd_lat1 == dd_lat0(il_imid,il_jmid) )THEN 
    2941  
    2942          il_iinf = il_imid ;  il_isup = il_imid 
    2943          il_jinf = il_jmid ;  il_jsup = il_jmid 
    2944  
    2945          ll_continue=.FALSE. 
    2946  
    2947       ELSE 
    2948          IF( dl_lon1 < dl_lon0(il_isup,il_jmid) .AND. & 
    2949          &   il_imid /= il_isup )THEN 
    2950  
    2951             ! point east 
    2952             il_iinf = il_imid 
    2953        
    2954          ELSE IF( dl_lon1 > dl_lon0(il_iinf,il_jmid) .AND. & 
    2955          &        il_imid /= il_iinf )THEN 
    2956  
    2957             ! point west 
    2958             il_isup = il_imid 
    2959  
    2960          ENDIF 
     3019      ll_continue=.FALSE. 
     3020 
     3021      ! avoid to use fillvalue for reduce domain on first time 
     3022      IF( PRESENT(dd_fill) )THEN 
     3023         DO WHILE( ALL(dl_lon0(il_isup,:) == dd_fill) ) 
     3024            il_isup=il_isup-1 
     3025         ENDDO 
     3026         DO WHILE( ALL(dl_lon0(il_iinf,:) == dd_fill) ) 
     3027            il_iinf=il_iinf+1 
     3028         ENDDO 
     3029         DO WHILE( ALL(dd_lat0(:,il_jsup) == dd_fill) ) 
     3030            il_jsup=il_jsup-1 
     3031         ENDDO 
     3032         DO WHILE( ALL(dd_lat0(:,il_jinf) == dd_fill) ) 
     3033            il_jinf=il_jinf+1 
     3034         ENDDO 
    29613035 
    29623036         il_shape(1)= il_isup - il_iinf + 1 
    29633037         il_shape(2)= il_jsup - il_jinf + 1 
    29643038 
    2965          il_imid = il_iinf + INT(il_shape(1)/2)  
     3039      ENDIF 
     3040 
     3041      ! special case for north ORCA grid 
     3042      IF( dd_lat1 > 19. .AND. dl_lon1 < 74.  )THEN 
     3043         ll_north=.TRUE. 
     3044      ENDIF 
     3045 
     3046      IF( .NOT. ll_north )THEN 
     3047         ! look for meridian 0°/360° 
    29663048         il_jmid = il_jinf + INT(il_shape(2)/2) 
    2967  
    2968          ! exit if too close from north fold (safer) 
    2969          IF( dd_lat0(il_imid,il_jmid) > 50.0 ) ll_north=.TRUE. 
    2970  
    2971          ! exit when close enough of point 
    2972          IF( ANY(il_shape(:) < 10 ) ) ll_continue=.FALSE. 
     3049         il_ind(:) = MAXLOC( dl_lon0(il_iinf:il_isup,il_jmid), & 
     3050         &                   dl_lon0(il_iinf:il_isup,il_jmid) <= 360._dp ) 
     3051 
     3052         il_imid=il_ind(1) 
     3053 
     3054         IF( dl_lon1 == dl_lon0(il_imid,il_jmid) .AND. & 
     3055         &   dd_lat1 == dd_lat0(il_imid,il_jmid) )THEN 
     3056 
     3057            il_iinf = il_imid ;  il_isup = il_imid 
     3058            il_jinf = il_jmid ;  il_jsup = il_jmid 
     3059 
     3060         ELSE 
     3061            IF( ALL(dl_lon0(il_isup,il_jinf:il_jsup) >  dl_lon1 ) .AND. & 
     3062            &   il_imid /= il_isup )THEN 
     3063               ! 0 < lon1 < lon0(isup) 
     3064               ! point east 
     3065               il_iinf = il_imid+1 
     3066               ll_continue=.TRUE. 
     3067          
     3068            ELSE IF( ALL(dl_lon0(il_iinf,il_jinf:il_jsup) <  dl_lon1 ) .AND. & 
     3069            &        il_imid /= il_iinf )THEN 
     3070               ! lon0(iinf) < lon1 < 360 
     3071               ! point west 
     3072               il_isup = il_imid 
     3073               ll_continue=.TRUE. 
     3074 
     3075            ENDIF 
     3076 
     3077            il_shape(1)= il_isup - il_iinf + 1 
     3078            il_shape(2)= il_jsup - il_jinf + 1 
     3079 
     3080            il_imid = il_iinf + INT(il_shape(1)/2)  
     3081            il_jmid = il_jinf + INT(il_shape(2)/2) 
     3082 
     3083            ! exit when close enough of point 
     3084            IF( ANY(il_shape(:) < 10 ) ) ll_continue=.FALSE. 
     3085         ENDIF 
    29733086      ENDIF 
    29743087 
     
    29763089      DO WHILE( ll_continue .AND. .NOT. ll_north ) 
    29773090 
     3091         ll_continue=.FALSE. 
    29783092         IF( dl_lon1 == dl_lon0(il_imid,il_jmid) .AND. & 
    29793093         &   dd_lat1 == dd_lat0(il_imid,il_jmid) )THEN 
     
    29823096            il_jinf = il_jmid ;  il_jsup = il_jmid 
    29833097 
    2984             ll_continue=.FALSE. 
    2985  
    29863098         ELSE 
    2987             IF( dl_lon1 > dl_lon0(il_imid,il_jmid) )THEN 
     3099            IF( ALL(dl_lon0(il_imid,il_jinf:il_jsup) <  dl_lon1) )THEN     
    29883100 
    29893101               ! point east 
    29903102               il_iinf = il_imid 
     3103               ll_continue=.TRUE. 
    29913104         
    2992             ELSE IF(dl_lon1 < dl_lon0(il_imid,il_jmid) )THEN 
     3105            ELSE IF( ALL(dl_lon0(il_imid,il_jinf:il_jsup) >  dl_lon1) )THEN     
    29933106 
    29943107               ! point west 
    29953108               il_isup = il_imid 
     3109               ll_continue=.TRUE. 
    29963110 
    29973111            ENDIF 
    29983112 
    2999             IF( dd_lat1 > dd_lat0(il_imid,il_jmid) )THEN 
     3113            IF( ALL(dd_lat0(il_iinf:il_isup,il_jmid) <  dd_lat1) )THEN     
    30003114                
    30013115               ! point north 
    30023116               il_jinf = il_jmid 
    3003  
    3004             ELSE IF(dd_lat1 < dd_lat0(il_imid,il_jmid) )THEN 
     3117               ll_continue=.TRUE. 
     3118 
     3119            ELSE IF( ALL(dd_lat0(il_iinf:il_isup,il_jmid) > dd_lat1) )THEN     
    30053120 
    30063121               ! point south 
    30073122               il_jsup = il_jmid 
     3123               ll_continue=.TRUE. 
    30083124             
    30093125            ENDIF 
     
    30143130            il_imid = il_iinf + INT(il_shape(1)/2)  
    30153131            il_jmid = il_jinf + INT(il_shape(2)/2) 
    3016  
    3017             ! exit if too close from north fold (safer) 
    3018             IF( dd_lat0(il_imid,il_jmid) > 50.0 ) ll_north=.TRUE. 
    30193132 
    30203133            ! exit when close enough of point 
     
    30493162   ! 
    30503163   !> @author J.Paul 
    3051    !> - November, 2013- Initial Version 
     3164   !> @date November, 2013 - Initial Version 
    30523165   ! 
    30533166   !> @param[in] dd_lon    grid longitude array 
     
    30553168   !> @param[in] dd_lonA   longitude of point A 
    30563169   !> @param[in] dd_latA   latitude  of point A 
     3170   !> @param[in] dd_fill 
    30573171   !> @return array of distance between point A and grid points. 
    30583172   !------------------------------------------------------------------- 
    3059    FUNCTION grid_distance(dd_lon, dd_lat, dd_lonA, dd_latA) 
     3173   FUNCTION grid_distance(dd_lon, dd_lat, dd_lonA, dd_latA ) 
    30603174      IMPLICIT NONE 
    30613175      ! Argument       
     
    31103224         DO ji=1,il_shape(1) 
    31113225            IF( dl_lon(ji,jj) == dl_lonA .AND. & 
    3112             &   dl_lat(ji,jj) == dl_laTA )THEN 
     3226            &   dl_lat(ji,jj) == dl_latA )THEN 
    31133227               grid_distance(ji,jj)=0.0 
    31143228            ELSE 
    31153229               dl_tmp= SIN(dl_latA)*SIN(dl_lat(ji,jj)) + & 
    3116                &       COS(dl_latA)*COS(dl_lat(ji,jj))*COS(dl_lon(ji,jj)-dl_lonA) 
     3230               &       COS(dl_latA)*COS(dl_lat(ji,jj)) * & 
     3231               &       COS(dl_lon(ji,jj)-dl_lonA) 
    31173232               ! check to avoid mistake with ACOS 
    31183233               IF( dl_tmp < -1.0 ) dl_tmp = -1.0 
     
    31363251   ! 
    31373252   !> @author J.Paul 
    3138    !> - September, 2014- Initial Version 
     3253   !> @date September, 2014 - Initial Version 
    31393254   !> @date October, 2014 
    31403255   !> - work on mpp file structure instead of file structure 
     
    31703285 
    31713286      ! local variable 
    3172       INTEGER(i4) :: il_imin0 
    3173       INTEGER(i4) :: il_jmin0 
    3174       INTEGER(i4) :: il_imax0 
    3175       INTEGER(i4) :: il_jmax0 
     3287      INTEGER(i4)                              :: il_imin0 
     3288      INTEGER(i4)                              :: il_jmin0 
     3289      INTEGER(i4)                              :: il_imax0 
     3290      INTEGER(i4)                              :: il_jmax0 
     3291      INTEGER(i4)                              :: il_ind 
    31763292       
    3177       INTEGER(i4), DIMENSION(:), ALLOCATABLE :: il_rho 
     3293      INTEGER(i4), DIMENSION(:), ALLOCATABLE   :: il_rho 
    31783294       
    3179       INTEGER(i4), DIMENSION(2,2)         :: il_xghost0 
    3180       INTEGER(i4), DIMENSION(2,2)         :: il_xghost1 
    3181  
    3182       CHARACTER(LEN= 1) :: cl_point 
    3183       CHARACTER(LEN=lc) :: cl_name 
     3295      INTEGER(i4), DIMENSION(2,2)              :: il_xghost0 
     3296      INTEGER(i4), DIMENSION(2,2)              :: il_xghost1 
     3297 
     3298      CHARACTER(LEN= 1)                        :: cl_point 
     3299      CHARACTER(LEN=lc)                        :: cl_name 
    31843300 
    31853301      REAL(dp)   , DIMENSION(:,:), ALLOCATABLE :: dl_lon0 
     
    31883304      REAL(dp)   , DIMENSION(:,:), ALLOCATABLE :: dl_lat1 
    31893305 
    3190       TYPE(TVAR) :: tl_lon0 
    3191       TYPE(TVAR) :: tl_lat0 
    3192       TYPE(TVAR) :: tl_lon1 
    3193       TYPE(TVAR) :: tl_lat1 
    3194  
    3195       TYPE(TMPP) :: tl_coord0 
    3196       TYPE(TMPP) :: tl_coord1 
     3306      TYPE(TVAR)                               :: tl_lon0 
     3307      TYPE(TVAR)                               :: tl_lat0 
     3308      TYPE(TVAR)                               :: tl_lon1 
     3309      TYPE(TVAR)                               :: tl_lat1 
     3310 
     3311      TYPE(TMPP)                               :: tl_coord0 
     3312      TYPE(TMPP)                               :: tl_coord1 
    31973313       
    31983314      ! loop indices 
     
    32273343         ! read coarse longitue and latitude 
    32283344         WRITE(cl_name,*) 'longitude_'//TRIM(cl_point) 
     3345         il_ind=var_get_id(tl_coord0%t_proc(1)%t_var(:), cl_name) 
     3346         IF( il_ind == 0 )THEN 
     3347            CALL logger_warn("GRID GET FINE OFFSET: no variable "//& 
     3348            &  TRIM(cl_name)//" in file "//TRIM(tl_coord0%c_name)//". & 
     3349            &  try to use longitude.") 
     3350            WRITE(cl_name,*) 'longitude' 
     3351         ENDIF 
    32293352         tl_lon0=iom_mpp_read_var(tl_coord0, TRIM(cl_name)) 
     3353 
    32303354         WRITE(cl_name,*) 'latitude_'//TRIM(cl_point) 
     3355         il_ind=var_get_id(tl_coord0%t_proc(1)%t_var(:), cl_name) 
     3356         IF( il_ind == 0 )THEN 
     3357            CALL logger_warn("GRID GET FINE OFFSET: no variable "//& 
     3358            &  TRIM(cl_name)//" in file "//TRIM(tl_coord0%c_name)//". & 
     3359            &  try to use latitude.") 
     3360            WRITE(cl_name,*) 'latitude' 
     3361         ENDIF 
    32313362         tl_lat0=iom_mpp_read_var(tl_coord0, TRIM(cl_name)) 
    32323363          
     
    32673398         ! read fine longitue and latitude 
    32683399         WRITE(cl_name,*) 'longitude_'//TRIM(cl_point) 
     3400         il_ind=var_get_id(tl_coord1%t_proc(1)%t_var(:), cl_name) 
     3401         IF( il_ind == 0 )THEN 
     3402            CALL logger_warn("GRID GET FINE OFFSET: no variable "//& 
     3403            &  TRIM(cl_name)//" in file "//TRIM(tl_coord1%c_name)//". & 
     3404            &  try to use longitude.") 
     3405            WRITE(cl_name,*) 'longitude' 
     3406         ENDIF 
    32693407         tl_lon1=iom_mpp_read_var(tl_coord1, TRIM(cl_name)) 
     3408 
    32703409         WRITE(cl_name,*) 'latitude_'//TRIM(cl_point) 
     3410         il_ind=var_get_id(tl_coord1%t_proc(1)%t_var(:), cl_name) 
     3411         IF( il_ind == 0 )THEN 
     3412            CALL logger_warn("GRID GET FINE OFFSET: no variable "//& 
     3413            &  TRIM(cl_name)//" in file "//TRIM(tl_coord1%c_name)//". & 
     3414            &  try to use latitude.") 
     3415            WRITE(cl_name,*) 'latitude' 
     3416         ENDIF 
    32713417         tl_lat1=iom_mpp_read_var(tl_coord1, TRIM(cl_name)) 
    32723418  
     
    33183464   ! 
    33193465   !> @author J.Paul 
    3320    !> - September, 2014- Initial Version 
     3466   !> @date September, 2014 - Initial Version 
    33213467   !> @date October, 2014 
    33223468   !> - work on mpp file structure instead of file structure 
     
    33543500 
    33553501      ! local variable 
    3356       INTEGER(i4), DIMENSION(:), ALLOCATABLE :: il_rho 
     3502      INTEGER(i4)                              :: il_ind 
     3503      INTEGER(i4), DIMENSION(2,2)              :: il_xghost1 
     3504      INTEGER(i4), DIMENSION(:), ALLOCATABLE   :: il_rho 
    33573505       
    3358       INTEGER(i4), DIMENSION(2,2)         :: il_xghost1 
    3359  
    3360       CHARACTER(LEN= 1) :: cl_point 
    3361       CHARACTER(LEN=lc) :: cl_name 
     3506      CHARACTER(LEN= 1)                        :: cl_point 
     3507      CHARACTER(LEN=lc)                        :: cl_name 
    33623508 
    33633509      REAL(dp)   , DIMENSION(:,:), ALLOCATABLE :: dl_lon1 
    33643510      REAL(dp)   , DIMENSION(:,:), ALLOCATABLE :: dl_lat1 
    33653511 
    3366       TYPE(TVAR) :: tl_lon1 
    3367       TYPE(TVAR) :: tl_lat1 
    3368  
    3369       TYPE(TMPP) :: tl_coord1 
     3512      TYPE(TVAR)                               :: tl_lon1 
     3513      TYPE(TVAR)                               :: tl_lat1 
     3514 
     3515      TYPE(TMPP)                               :: tl_coord1 
    33703516      ! loop indices 
    33713517      !---------------------------------------------------------------- 
     
    33973543         ! read fine longitue and latitude 
    33983544         WRITE(cl_name,*) 'longitude_'//TRIM(cl_point) 
     3545         il_ind=var_get_id(tl_coord1%t_proc(1)%t_var(:), cl_name) 
     3546         IF( il_ind == 0 )THEN 
     3547            CALL logger_warn("GRID GET FINE OFFSET: no variable "//& 
     3548            &  TRIM(cl_name)//" in file "//TRIM(tl_coord1%c_name)//". & 
     3549            &  try to use longitude.") 
     3550            WRITE(cl_name,*) 'longitude' 
     3551         ENDIF 
    33993552         tl_lon1=iom_mpp_read_var(tl_coord1, TRIM(cl_name)) 
     3553 
    34003554         WRITE(cl_name,*) 'latitude_'//TRIM(cl_point) 
     3555         il_ind=var_get_id(tl_coord1%t_proc(1)%t_var(:), cl_name) 
     3556         IF( il_ind == 0 )THEN 
     3557            CALL logger_warn("GRID GET FINE OFFSET: no variable "//& 
     3558            &  TRIM(cl_name)//" in file "//TRIM(tl_coord1%c_name)//". & 
     3559            &  try to use latitude.") 
     3560            WRITE(cl_name,*) 'latitude' 
     3561         ENDIF 
    34013562         tl_lat1=iom_mpp_read_var(tl_coord1, TRIM(cl_name)) 
    34023563  
     
    34463607   ! 
    34473608   !> @author J.Paul 
    3448    !> - September, 2014- Initial Version 
     3609   !> @date September, 2014 - Initial Version 
    34493610   !> @date October, 2014 
    34503611   !> - work on mpp file structure instead of file structure 
     
    34833644 
    34843645      ! local variable 
    3485       INTEGER(i4) :: il_imin0 
    3486       INTEGER(i4) :: il_jmin0 
    3487       INTEGER(i4) :: il_imax0 
    3488       INTEGER(i4) :: il_jmax0 
     3646      INTEGER(i4)                              :: il_imin0 
     3647      INTEGER(i4)                              :: il_jmin0 
     3648      INTEGER(i4)                              :: il_imax0 
     3649      INTEGER(i4)                              :: il_jmax0 
     3650      INTEGER(i4)                              :: il_ind 
    34893651       
    3490       INTEGER(i4), DIMENSION(:), ALLOCATABLE :: il_rho 
     3652      INTEGER(i4), DIMENSION(:), ALLOCATABLE   :: il_rho 
    34913653       
    3492       INTEGER(i4), DIMENSION(2,2)         :: il_xghost0 
    3493  
    3494       CHARACTER(LEN= 1) :: cl_point 
    3495       CHARACTER(LEN=lc) :: cl_name 
     3654      INTEGER(i4), DIMENSION(2,2)              :: il_xghost0 
     3655 
     3656      CHARACTER(LEN= 1)                        :: cl_point 
     3657      CHARACTER(LEN=lc)                        :: cl_name 
    34963658 
    34973659      REAL(dp)   , DIMENSION(:,:), ALLOCATABLE :: dl_lon0 
    34983660      REAL(dp)   , DIMENSION(:,:), ALLOCATABLE :: dl_lat0 
    34993661 
    3500       TYPE(TVAR) :: tl_lon0 
    3501       TYPE(TVAR) :: tl_lat0 
    3502  
    3503       TYPE(TMPP) :: tl_coord0 
     3662      TYPE(TVAR)                               :: tl_lon0 
     3663      TYPE(TVAR)                               :: tl_lat0 
     3664 
     3665      TYPE(TMPP)                               :: tl_coord0 
    35043666      ! loop indices 
    35053667      !---------------------------------------------------------------- 
     
    35303692         ! read coarse longitue and latitude 
    35313693         WRITE(cl_name,*) 'longitude_'//TRIM(cl_point) 
     3694         il_ind=var_get_id(tl_coord0%t_proc(1)%t_var(:), cl_name) 
     3695         IF( il_ind == 0 )THEN 
     3696            CALL logger_warn("GRID GET FINE OFFSET: no variable "//& 
     3697            &  TRIM(cl_name)//" in file "//TRIM(tl_coord0%c_name)//". & 
     3698            &  try to use longitude.") 
     3699            WRITE(cl_name,*) 'longitude' 
     3700         ENDIF 
    35323701         tl_lon0=iom_mpp_read_var(tl_coord0, TRIM(cl_name)) 
     3702 
    35333703         WRITE(cl_name,*) 'latitude_'//TRIM(cl_point) 
     3704         il_ind=var_get_id(tl_coord0%t_proc(1)%t_var(:), cl_name) 
     3705         IF( il_ind == 0 )THEN 
     3706            CALL logger_warn("GRID GET FINE OFFSET: no variable "//& 
     3707            &  TRIM(cl_name)//" in file "//TRIM(tl_coord0%c_name)//". & 
     3708            &  try to use latitude.") 
     3709            WRITE(cl_name,*) 'latitude' 
     3710         ENDIF 
    35343711         tl_lat0=iom_mpp_read_var(tl_coord0, TRIM(cl_name)) 
    35353712          
     
    35853762   ! 
    35863763   !> @author J.Paul 
    3587    !> - November, 2013 - Initial Version 
    3588    !> @date September, 2014 - rename from grid_get_fine_offset 
    3589    ! 
     3764   !> @date November, 2013 - Initial Version 
     3765   !> @date September, 2014  
     3766   !> - rename from grid_get_fine_offset 
     3767   !> @date May, 2015  
     3768   !> - improve way to find offset 
     3769   !> 
    35903770   !> @param[in] dd_lon0   coarse grid longitude array  
    35913771   !> @param[in] dd_lat0   coarse grid latitude  array 
     
    36203800 
    36213801      ! local variable 
    3622       INTEGER(i4), DIMENSION(2) :: il_shape0 
    3623       INTEGER(i4), DIMENSION(2) :: il_shape1 
     3802      INTEGER(i4), DIMENSION(2)                :: il_shape0 
     3803      INTEGER(i4), DIMENSION(2)                :: il_shape1 
     3804 
    36243805      REAL(dp)   , DIMENSION(:,:), ALLOCATABLE :: dl_lon0 
    36253806      REAL(dp)   , DIMENSION(:,:), ALLOCATABLE :: dl_lon1 
     3807 
     3808      LOGICAL                                  :: ll_ii 
     3809      LOGICAL                                  :: ll_ij 
    36263810       
    36273811      ! loop indices 
     
    36573841      grid__get_fine_offset_cc(:,:)=-1 
    36583842 
    3659       IF( il_shape1(1) > 1 )THEN 
    3660  
    3661          ! look for i-direction left offset  
     3843      IF( il_shape1(jp_J) == 1 )THEN 
     3844           
     3845         grid__get_fine_offset_cc(jp_J,:)=((id_rho(jp_J)-1)/2) 
     3846 
     3847         ! work on i-direction 
     3848         ! look for i-direction left offset 
    36623849         IF( dl_lon1(1,1) < dl_lon0(id_imin0+1,id_jmin0) )THEN 
    36633850            DO ji=1,id_rho(jp_I)+2 
    36643851               IF( dl_lon1(ji,1) > dl_lon0(id_imin0+1,id_jmin0) - dp_delta )THEN 
    3665                   grid__get_fine_offset_cc(1,1)=(id_rho(jp_I)+1)-ji 
     3852                  grid__get_fine_offset_cc(jp_I,1)=(id_rho(jp_I)+1)-ji 
    36663853                  EXIT 
    36673854               ENDIF 
     
    36713858            &                 " not match fine grid lower left corner.") 
    36723859         ENDIF 
    3673  
    36743860         ! look for i-direction right offset 
    3675          IF( dl_lon1(il_shape1(1),1) > dl_lon0(id_imax0-1,id_jmin0) )THEN 
     3861         IF( dl_lon1(il_shape1(jp_I),1) > dl_lon0(id_imax0-1,id_jmin0) )THEN 
    36763862            DO ji=1,id_rho(jp_I)+2 
    3677                ii=il_shape1(1)-ji+1 
     3863               ii=il_shape1(jp_I)-ji+1 
    36783864               IF( dl_lon1(ii,1) < dl_lon0(id_imax0-1,id_jmin0) + dp_delta )THEN 
    3679                   grid__get_fine_offset_cc(1,2)=(id_rho(jp_I)+1)-ji 
     3865                  grid__get_fine_offset_cc(jp_I,2)=(id_rho(jp_I)+1)-ji 
    36803866                  EXIT 
    36813867               ENDIF 
     
    36863872         ENDIF 
    36873873 
    3688       ELSE 
    3689          grid__get_fine_offset_cc(1,:)=((id_rho(jp_I)-1)/2) 
    3690       ENDIF 
    3691  
    3692       IF( il_shape1(2) > 1 )THEN 
     3874      ELSEIF( il_shape1(jp_I) == 1 )THEN 
     3875          
     3876         grid__get_fine_offset_cc(jp_I,:)=((id_rho(jp_I)-1)/2) 
     3877          
     3878         ! work on j-direction 
    36933879 
    36943880         ! look for j-direction lower offset  
     
    36963882            DO jj=1,id_rho(jp_J)+2 
    36973883               IF( dd_lat1(1,jj) > dd_lat0(id_imin0,id_jmin0+1) - dp_delta )THEN 
    3698                   grid__get_fine_offset_cc(2,1)=(id_rho(jp_J)+1)-jj 
     3884                  grid__get_fine_offset_cc(jp_J,1)=(id_rho(jp_J)+1)-jj 
    36993885                  EXIT 
    37003886               ENDIF 
     
    37063892 
    37073893         ! look for j-direction upper offset  
    3708          IF( dd_lat1(1,il_shape1(2)) > dd_lat0(id_imin0,id_jmax0-1) )THEN 
     3894         IF( dd_lat1(1,il_shape1(jp_J)) > dd_lat0(id_imin0,id_jmax0-1) )THEN 
    37093895            DO jj=1,id_rho(jp_J)+2 
    3710                ij=il_shape1(2)-jj+1 
     3896               ij=il_shape1(jp_J)-jj+1 
    37113897               IF( dd_lat1(1,ij) < dd_lat0(id_imin0,id_jmax0-1) + dp_delta )THEN 
    3712                   grid__get_fine_offset_cc(2,2)=(id_rho(jp_J)+1)-jj 
     3898                  grid__get_fine_offset_cc(jp_J,2)=(id_rho(jp_J)+1)-jj 
    37133899                  EXIT 
    37143900               ENDIF 
     
    37173903            CALL logger_error("GRID GET FINE OFFSET: coarse grid indices do "//& 
    37183904            &                 " not match fine grid upper right corner.") 
    3719          ENDIF 
    3720       ELSE 
    3721          grid__get_fine_offset_cc(2,:)=((id_rho(jp_J)-1)/2) 
     3905         ENDIF          
     3906 
     3907      ELSE ! il_shape1(1) > 1 .AND. il_shape1(2) > 1  
     3908 
     3909         ! look for lower left offset 
     3910         IF( dl_lon1(1,1) < dl_lon0(id_imin0+1,id_jmin0+1) )THEN 
     3911 
     3912            ii=1 
     3913            ij=1 
     3914            DO ji=1,(id_rho(jp_I)+2)*(id_rho(jp_J)+2) 
     3915 
     3916               ll_ii=.FALSE. 
     3917               ll_ij=.FALSE. 
     3918 
     3919               IF( dl_lon1(ii,ij) >= dl_lon0(id_imin0+1,id_jmin0+1)-dp_delta .AND. & 
     3920               &   dd_lat1(ii,ij) >= dd_lat0(id_imin0+1,id_jmin0+1)-dp_delta )THEN 
     3921                  grid__get_fine_offset_cc(jp_I,1)=(id_rho(jp_I)+1)-ii 
     3922                  grid__get_fine_offset_cc(jp_J,1)=(id_rho(jp_J)+1)-ij 
     3923                  EXIT 
     3924               ENDIF 
     3925 
     3926               IF( dl_lon1(ii+1,ij) <= dl_lon0(id_imin0+1,id_jmin0+1)+dp_delta .AND. & 
     3927               &   dd_lat1(ii+1,ij) <= dd_lat0(id_imin0+1,id_jmin0+1)+dp_delta )THEN 
     3928                  ll_ii=.TRUE. 
     3929               ENDIF 
     3930               IF( dl_lon1(ii,ij+1) <= dl_lon0(id_imin0+1,id_jmin0+1)+dp_delta .AND. & 
     3931               &   dd_lat1(ii,ij+1) <= dd_lat0(id_imin0+1,id_jmin0+1)+dp_delta )THEN 
     3932                  ll_ij=.TRUE. 
     3933               ENDIF 
     3934 
     3935               IF( ll_ii ) ii=ii+1 
     3936               IF( ll_ij ) ij=ij+1 
     3937 
     3938            ENDDO 
     3939 
     3940         ELSE 
     3941            CALL logger_error("GRID GET FINE OFFSET: coarse grid indices do "//& 
     3942            &                 " not match fine grid lower left corner.") 
     3943         ENDIF 
     3944 
     3945         ! look for upper right offset 
     3946         IF( dl_lon1(il_shape1(jp_I),il_shape1(jp_J)) > & 
     3947            & dl_lon0(id_imax0-1,id_jmax0-1) )THEN 
     3948 
     3949            ii=il_shape1(jp_I) 
     3950            ij=il_shape1(jp_J) 
     3951            DO ji=1,(id_rho(jp_I)+2)*(id_rho(jp_J)+2) 
     3952 
     3953               ll_ii=.FALSE. 
     3954               ll_ij=.FALSE. 
     3955 
     3956               IF( dl_lon1(ii,ij) <= dl_lon0(id_imax0-1,id_jmax0-1)+dp_delta .AND. & 
     3957               &   dd_lat1(ii,ij) <= dd_lat0(id_imax0-1,id_jmax0-1)+dp_delta )THEN 
     3958                  grid__get_fine_offset_cc(jp_I,2)=(id_rho(jp_I)+1)-(il_shape1(jp_I)+1-ii) 
     3959                  grid__get_fine_offset_cc(jp_J,2)=(id_rho(jp_J)+1)-(il_shape1(jp_J)+1-ij) 
     3960                  EXIT 
     3961               ENDIF 
     3962 
     3963               IF( dl_lon1(ii-1,ij) >= dl_lon0(id_imax0-1,id_jmax0-1)-dp_delta .AND. & 
     3964               &   dd_lat1(ii-1,ij) >= dd_lat0(id_imax0-1,id_jmax0-1)-dp_delta )THEN 
     3965                  ll_ii=.TRUE. 
     3966               ENDIF 
     3967               IF( dl_lon1(ii,ij-1) >= dl_lon0(id_imax0-1,id_jmax0-1)-dp_delta .AND. & 
     3968               &   dd_lat1(ii,ij-1) >= dd_lat0(id_imax0-1,id_jmax0-1)-dp_delta )THEN 
     3969                  ll_ij=.TRUE. 
     3970               ENDIF 
     3971 
     3972               IF( ll_ii ) ii=ii-1 
     3973               IF( ll_ij ) ij=ij-1 
     3974 
     3975            ENDDO 
     3976 
     3977         ELSE 
     3978            CALL logger_error("GRID GET FINE OFFSET: coarse grid indices do "//& 
     3979            &                 " not match fine grid upper right corner.") 
     3980         ENDIF 
     3981 
    37223982      ENDIF 
    37233983 
     
    37323992   ! 
    37333993   !> @author J.Paul 
    3734    !> - November, 2013- Initial Version 
     3994   !> @date November, 2013- Initial Version 
    37353995   !> @date October, 2014 
    37363996   !> - work on mpp file structure instead of file structure 
     
    37424002   !> @param[in] id_jmin0  coarse grid lower left  corner j-indice of fine grid domain  
    37434003   !> @param[in] id_jmax0  coarse grid upper right corner j-indice of fine grid domain   
    3744    !> @param[in] id_rho    array of refinement factor (default 1)  
     4004   !> @param[in] id_rho    array of refinement factor  
    37454005   !------------------------------------------------------------------- 
    37464006   SUBROUTINE grid_check_coincidence( td_coord0, td_coord1, & 
     
    40424302   !>  
    40434303   !> @author J.Paul 
    4044    !> - November, 2013- Initial Version 
     4304   !> @date November, 2013 - Initial Version 
    40454305   ! 
    40464306   !> @param[in] dd_lon0   array of coarse grid longitude 
     
    41034363      dl_lon1 = dd_lon1(il_imin1, il_jmin1) 
    41044364      dl_lat1 = dd_lat1(il_imin1, il_jmin1) 
    4105  
    41064365 
    41074366      IF( (ABS(dl_lon1-dl_lon0)>dp_delta) .AND. (dl_lon1 < dl_lon0 ) .OR. &  
     
    42024461   ! 
    42034462   !> @author J.Paul 
    4204    !> - November, 2013- Initial Version 
     4463   !> @date November, 2013 - Initial Version 
    42054464   ! 
    42064465   !> @param[in] dd_lat0   array of coarse grid latitude  
     
    42724531   !>  
    42734532   !> @author J.Paul 
    4274    !> - November, 2013-Initial version 
     4533   !> @date November, 2013 - Initial version 
    42754534   ! 
    42764535   !> @param[inout] td_var array of variable structure  
     
    43484607   !>  
    43494608   !> @author J.Paul 
    4350    !> - November, 2013-Initial version 
     4609   !> @date November, 2013 - Initial version 
    43514610   ! 
    43524611   !> @param[inout] td_var array of variable structure  
     
    43744633      IF( ALL(td_var%t_dim(1:2)%l_use) )THEN 
    43754634 
    4376          CALL logger_warn( "GRID DEL GHOST: dimension change in variable "//& 
    4377          &              TRIM(td_var%c_name) ) 
     4635         IF( ANY(id_ghost(:,:)/=0) )THEN 
     4636            CALL logger_warn( "GRID DEL GHOST: dimension change in variable "//& 
     4637            &              TRIM(td_var%c_name) ) 
     4638         ENDIF 
    43784639 
    43794640         ! copy variable 
     
    44254686   !> 
    44264687   !> @author J.Paul 
    4427    !> - September, 2014- Initial Version 
     4688   !> @date September, 2014 - Initial Version 
    44284689   ! 
    44294690   !> @param[in] td_var variable sturcture  
     
    45554816   !>  
    45564817   !> @author J.Paul 
    4557    !> - September, 2014 - Initial Version 
     4818   !> @date September, 2014 - Initial Version 
    45584819   !> @date October, 2014 
    45594820   !> - work on mpp file structure instead of file structure 
     
    45924853          tl_mpp=mpp_copy(td_mpp) 
    45934854 
     4855          CALL logger_info("GRID GET FINE GHOST perio"//TRIM(fct_str(tl_mpp%i_perio))) 
    45944856          IF( tl_mpp%i_perio < 0 )THEN 
    45954857             ! compute NEMO periodicity index 
     
    46274889   !> 
    46284890   !> @author J.Paul 
    4629    !> - November, 2013- Initial Version 
     4891   !> @date November, 2013 - Initial Version 
    46304892   ! 
    46314893   !> @param[in] td_var    variable strucutre  
     
    46944956                        il_tmp(jim:jip,jjm:jjp)=1 
    46954957                     END WHERE 
     4958 
    46964959                  ENDIF 
    46974960               ENDDO 
     
    47204983   !> 
    47214984   !> @details 
    4722    !> the minimum size (nbumber of point) of closed sea to be kept could be 
     4985   !> the minimum size (number of point) of closed sea to be kept could be 
    47234986   !> sepcify with id_minsize. 
    47244987   !> By default only the biggest sea is preserve. 
    47254988   !> 
    47264989   !> @author J.Paul 
    4727    !> - November, 2013- Initial Version 
     4990   !> @date November, 2013 - Initial Version 
    47284991   !> 
    47294992   !> @param[inout] td_var    variable structure 
     
    47825045 
    47835046   END SUBROUTINE grid_fill_small_dom 
     5047   !------------------------------------------------------------------- 
     5048   !> @brief This subroutine fill small domain inside bigger one.  
     5049   !> 
     5050   !> @details 
     5051   !> the minimum size (number of point) of domain sea to be kept could be 
     5052   !> is sepcified with id_minsize. 
     5053   !> smaller domain are included in the one they are embedded. 
     5054   !> 
     5055   !> @author J.Paul 
     5056   !> @date Ferbruay, 2015 - Initial Version 
     5057   !> 
     5058   !> @param[inout] id_mask      domain mask (from grid_split_domain) 
     5059   !> @param[in] id_minsize   minimum size of sea to be kept 
     5060   !------------------------------------------------------------------- 
     5061   SUBROUTINE grid_fill_small_msk(id_mask, id_minsize) 
     5062      IMPLICIT NONE 
     5063      ! Argument       
     5064      INTEGER(i4), DIMENSION(:,:), INTENT(INOUT) :: id_mask 
     5065      INTEGER(i4),                 INTENT(IN   ) :: id_minsize 
     5066 
     5067      ! local variable 
     5068      INTEGER(i4)                              :: il_ndom 
     5069      INTEGER(i4)                              :: il_minsize 
     5070      INTEGER(i4)                              :: il_msk 
     5071       
     5072      INTEGER(i4)                              :: jim 
     5073      INTEGER(i4)                              :: jjm 
     5074      INTEGER(i4)                              :: jip 
     5075      INTEGER(i4)                              :: jjp 
     5076 
     5077      INTEGER(i4), DIMENSION(2)                :: il_shape 
     5078      INTEGER(i4), DIMENSION(:,:), ALLOCATABLE :: il_tmp 
     5079 
     5080      ! loop indices 
     5081      INTEGER(i4) :: ii 
     5082      INTEGER(i4) :: ij 
     5083 
     5084      INTEGER(i4) :: ji 
     5085      INTEGER(i4) :: jj 
     5086      !---------------------------------------------------------------- 
     5087 
     5088      il_shape(:)=SHAPE(id_mask(:,:)) 
     5089      il_ndom=MINVAL(id_mask(:,:)) 
     5090 
     5091      ALLOCATE( il_tmp(il_shape(1),il_shape(2)) ) 
     5092      il_tmp(:,:)=0 
     5093      DO ji=-1,il_ndom,-1 
     5094         WHERE( id_mask(:,:)==ji )  
     5095            il_tmp(:,:)=SUM(id_mask(:,:),id_mask(:,:)==ji)/ji 
     5096         END WHERE 
     5097      ENDDO 
     5098 
     5099      DO WHILE( id_minsize > MINVAL(il_tmp(:,:)) ) 
     5100 
     5101         DO jj=1,il_shape(2) 
     5102            DO ji=1,il_shape(1) 
     5103 
     5104               IF( il_tmp(ji,jj) < il_minsize )THEN 
     5105                  jim=MAX(1,ji-1)   ;  jip=MIN(il_shape(1),ji+1) 
     5106                  jjm=MAX(1,jj-1)   ;  jjp=MIN(il_shape(2),jj+1) 
     5107                   
     5108                  il_msk=0 
     5109                  DO ij=jjm,jjp 
     5110                     DO ii=jim,jip 
     5111                        IF( id_mask(ii,ij) /= id_mask(ji,jj) )THEN 
     5112                           IF( il_msk == 0 )THEN 
     5113                              il_msk=id_mask(ii,ij) 
     5114                           ELSEIF( il_msk /= id_mask(ii,ij) )THEN 
     5115                              CALL logger_error("GRID FILL SMALL MSK: "//& 
     5116                              &  "small domain not embedded in bigger one"//& 
     5117                              &  ". point should be between two different"//& 
     5118                              &  " domain.") 
     5119                           ENDIF 
     5120                        ENDIF 
     5121                     ENDDO 
     5122                  ENDDO 
     5123                  IF( il_msk /= 0 ) id_mask(ji,jj)=il_msk 
     5124 
     5125               ENDIF 
     5126 
     5127            ENDDO 
     5128         ENDDO 
     5129 
     5130 
     5131         il_tmp(:,:)=0 
     5132         DO ji=-1,il_ndom,-1 
     5133            WHERE( id_mask(:,:)==ji )  
     5134               il_tmp(:,:)=SUM(id_mask(:,:),id_mask(:,:)==ji)/ji 
     5135            END WHERE 
     5136         ENDDO             
     5137 
     5138      ENDDO 
     5139 
     5140      DEALLOCATE( il_tmp ) 
     5141 
     5142 
     5143   END SUBROUTINE grid_fill_small_msk 
    47845144END MODULE grid 
    47855145 
Note: See TracChangeset for help on using the changeset viewer.