- Timestamp:
- 2015-12-21T14:20:48+01:00 (9 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2015/dev_agrif_v3_6_STABLE/NEMOGCM/TOOLS/SIREN/src/grid.f90
r6092 r6146 149 149 !> CALL grid_check_coincidence(td_coord0, td_coord1, 150 150 !> id_imin0, id_imax0, id_jmin0, id_jmax0 151 !> [,id_rho])151 !> ,id_rho) 152 152 !> @endcode 153 153 !> - td_coord0 is coarse grid coordinate mpp structure … … 161 161 !> - id_jmax0 is coarse grid upper right corner j-indice of fine grid 162 162 !> domain 163 !> - id_rho is array of refinement factor (default 1)163 !> - id_rho is array of refinement factor 164 164 !> 165 165 !> to add ghost cell at boundaries:<br/> … … 213 213 !> @date October, 2014 214 214 !> - 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 215 217 ! 216 218 !> @note Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) … … 255 257 PUBLIC :: grid_split_domain !< compute closed sea domain 256 258 PUBLIC :: grid_fill_small_dom !< fill small closed sea with fill value 259 PUBLIC :: grid_fill_small_msk !< fill small domain inside bigger one 257 260 258 261 ! get closest coarse grid indices of fine grid domain … … 352 355 !> @note need all processor files to be there 353 356 !> @author J.Paul 354 !> - October, 2014- Initial Version357 !> @date October, 2014 - Initial Version 355 358 !> 356 359 !> @param[inout] td_file file structure … … 466 469 !> - compute East West overlap 467 470 !> 468 !> @note need all processor files to be there471 !> @note need all processor files 469 472 !> @author J.Paul 470 !> - October, 2014- Initial Version473 !> @date October, 2014 - Initial Version 471 474 !> 472 475 !> @param[in] td_mpp mpp structure … … 496 499 il_ew =-1 497 500 501 CALL logger_info("GRID GET INFO: look for "//TRIM(td_mpp%c_name)) 498 502 ! copy structure 499 503 tl_mpp=mpp_copy(td_mpp) … … 523 527 ENDIF 524 528 529 CALL logger_info("GRID GET INFO: perio "//TRIM(fct_str(il_perio))) 530 525 531 SELECT CASE(il_perio) 526 532 CASE(3,4) 533 il_pivot=1 534 CASE(5,6) 527 535 il_pivot=0 528 CASE(5,6)529 il_pivot=1530 536 CASE(0,1,2) 531 537 il_pivot=1 … … 534 540 IF( il_pivot < 0 .OR. il_pivot > 1 )THEN 535 541 ! get pivot 542 CALL logger_info("GRID GET INFO: look for pivot ") 536 543 il_pivot=grid_get_pivot(tl_mpp) 537 544 ENDIF … … 539 546 IF( il_perio < 0 .OR. il_perio > 6 )THEN 540 547 ! get periodicity 548 CALL logger_info("GRID GET INFO: look for perio ") 541 549 il_perio=grid_get_perio(tl_mpp, il_pivot) 542 550 ENDIF … … 544 552 IF( il_ew < 0 )THEN 545 553 ! get periodicity 554 CALL logger_info("GRID GET INFO: look for overlap ") 546 555 il_ew=grid_get_ew_overlap(tl_mpp) 547 556 ENDIF … … 595 604 !> 596 605 !> @author J.Paul 597 !> - November, 2013- Subroutine written606 !> @date November, 2013 - Initial version 598 607 !> @date September, 2014 599 608 !> - add dummy loop in case variable not over right point. … … 708 717 !> 709 718 !> @author J.Paul 710 !> -October, 2014 - Initial version719 !> @date October, 2014 - Initial version 711 720 ! 712 721 !> @param[in] dd_value array of value … … 783 792 784 793 IF( ll_check )THEN 785 CALL logger_info("GRID GET PIVOT: T-pivot")794 CALL logger_info("GRID GET PIVOT: F-pivot") 786 795 grid__get_pivot_varT=0 787 796 ENDIF … … 801 810 !> 802 811 !> @author J.Paul 803 !> -October, 2014 - Initial version812 !> @date October, 2014 - Initial version 804 813 ! 805 814 !> @param[in] dd_value array of value … … 876 885 877 886 IF( ll_check )THEN 878 CALL logger_info("GRID GET PIVOT: T-pivot")887 CALL logger_info("GRID GET PIVOT: F-pivot") 879 888 grid__get_pivot_varU=0 880 889 ENDIF … … 894 903 !> 895 904 !> @author J.Paul 896 !> -October, 2014 - Initial version905 !> @date October, 2014 - Initial version 897 906 ! 898 907 !> @param[in] dd_value array of value … … 969 978 970 979 IF( ll_check )THEN 971 CALL logger_info("GRID GET PIVOT: T-pivot")980 CALL logger_info("GRID GET PIVOT: F-pivot") 972 981 grid__get_pivot_varV=0 973 982 ENDIF … … 987 996 !> 988 997 !> @author J.Paul 989 !> -October, 2014 - Initial version998 !> @date October, 2014 - Initial version 990 999 ! 991 1000 !> @param[in] dd_value array of value … … 1062 1071 1063 1072 IF( ll_check )THEN 1064 CALL logger_info("GRID GET PIVOT: T-pivot")1073 CALL logger_info("GRID GET PIVOT: F-pivot") 1065 1074 grid__get_pivot_varF=0 1066 1075 ENDIF … … 1083 1092 !> 1084 1093 !> @author J.Paul 1085 !> - Ocotber, 2014- Initial version1094 !> @date Ocotber, 2014 - Initial version 1086 1095 ! 1087 1096 !> @param[in] td_file file structure … … 1172 1181 !> 1173 1182 !> @author J.Paul 1174 !> -October, 2014 - Initial version1183 !> @date October, 2014 - Initial version 1175 1184 ! 1176 1185 !> @param[in] td_mpp mpp file structure … … 1277 1286 !> 1: cyclic east-west boundary 1278 1287 !> 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 boundary1281 !> 5: North fold boundary (with a T-point pivot)1282 !> 6: North fold boundary (with a T-point pivot) and cyclic east-west boundary1288 !> 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 1283 1292 !> 1284 1293 !> @warning pivot point should have been computed before run this script. see grid_get_pivot. 1285 1294 !> 1286 1295 !> @author J.Paul 1287 !> - November, 2013- Subroutine written1296 !> @date November, 2013 - Initial version 1288 1297 !> @date October, 2014 1289 1298 !> - work on variable structure instead of file structure … … 1452 1461 !> 1453 1462 !> @author J.Paul 1454 !> -October, 2014 - Initial version1463 !> @date October, 2014 - Initial version 1455 1464 !> 1456 1465 !> @param[in] td_file file structure … … 1537 1546 !> 1: cyclic east-west boundary 1538 1547 !> 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 boundary1541 !> 5: North fold boundary (with a T-point pivot)1542 !> 6: North fold boundary (with a T-point pivot) and cyclic east-west boundary1548 !> 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 1543 1552 !> 1544 1553 !> @warning pivot point should have been computed before run this script. see grid_get_pivot. 1545 1554 !> 1546 1555 !> @author J.Paul 1547 !> -October, 2014 - Initial version1556 !> @date October, 2014 - Initial version 1548 1557 ! 1549 1558 !> @param[in] td_mpp mpp file structure … … 1634 1643 ! 1635 1644 !> @author J.Paul 1636 !> - November, 2013- Initial Version1645 !> @date November, 2013 - Initial Version 1637 1646 !> @date October, 2014 1638 1647 !> - work on mpp file structure instead of file structure … … 1746 1755 !> 1747 1756 !> @author J.Paul 1748 !> - October, 2014- Initial Version1757 !> @date October, 2014 - Initial Version 1749 1758 !> 1750 1759 !> @param[in] td_file file structure … … 1797 1806 ! 1798 1807 !> @author J.Paul 1799 !> - November, 2013- Initial Version1808 !> @date November, 2013 - Initial Version 1800 1809 !> @date October, 2014 1801 1810 !> - work on mpp file structure instead of file structure … … 1853 1862 !> 1854 1863 !> @author J.Paul 1855 !> - November, 2013- Initial Version1864 !> @date November, 2013 - Initial Version 1856 1865 !> 1857 1866 !> @param[in] td_lat latitude variable structure … … 1890 1899 ! 1891 1900 !> @author J.Paul 1892 !> - November, 2013- Initial Version1901 !> @date November, 2013 - Initial Version 1893 1902 !> @date October, 2014 1894 1903 !> - work on mpp file structure instead of file structure … … 1978 1987 !> 1979 1988 !> @author J.Paul 1980 !> - November, 2013- Initial Version1989 !> @date November, 2013 - Initial Version 1981 1990 !> @date September, 2014 1982 1991 !> - use grid point to read coordinates variable. 1983 1992 !> @date October, 2014 1984 1993 !> - 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... 1985 1997 !> 1986 1998 !> @param[in] td_coord0 coarse grid coordinate mpp structure … … 2004 2016 2005 2017 ! 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 2026 2039 2027 2040 ! loop indices … … 2057 2070 ! read coarse longitue and latitude 2058 2071 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 2059 2079 tl_lon0=iom_mpp_read_var(tl_coord0, TRIM(cl_name)) 2080 2060 2081 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 2061 2089 tl_lat0=iom_mpp_read_var(tl_coord0, TRIM(cl_name)) 2062 2090 … … 2077 2105 ! read fine longitue and latitude 2078 2106 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 2079 2114 tl_lon1=iom_mpp_read_var(tl_coord1, TRIM(cl_name)) 2115 2080 2116 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 2081 2124 tl_lat1=iom_mpp_read_var(tl_coord1, TRIM(cl_name)) 2082 2125 … … 2127 2170 !> 2128 2171 !> @author J.Paul 2129 !> - November, 2013- Initial Version2172 !> @date November, 2013 - Initial Version 2130 2173 !> @date September, 2014 2131 2174 !> - use grid point to read coordinates variable. 2132 2175 !> @date October, 2014 2133 2176 !> - 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... 2134 2180 !> 2135 2181 !> @param[in] td_longitude0 coarse grid longitude … … 2154 2200 2155 2201 ! 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 2167 2215 2168 2216 ! loop indices … … 2209 2257 ! read fine longitue and latitude 2210 2258 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 2211 2266 tl_lon1=iom_mpp_read_var(tl_coord1, TRIM(cl_name)) 2267 2212 2268 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 2213 2276 tl_lat1=iom_mpp_read_var(tl_coord1, TRIM(cl_name)) 2214 2277 … … 2244 2307 !> 2245 2308 !> @author J.Paul 2246 !> - November, 2013- Initial Version2309 !> @date November, 2013 - Initial Version 2247 2310 !> @date September, 2014 2248 2311 !> - use grid point to read coordinates variable. 2249 2312 !> @date October, 2014 2250 2313 !> - 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... 2251 2317 !> 2252 2318 !> @param[in] td_coord0 coarse grid coordinate mpp structure … … 2271 2337 2272 2338 ! 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 2289 2356 2290 2357 ! loop indices … … 2330 2397 ! read coarse longitue and latitude 2331 2398 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 2332 2406 tl_lon0=iom_mpp_read_var(tl_coord0, TRIM(cl_name)) 2407 2333 2408 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 2334 2416 tl_lat0=iom_mpp_read_var(tl_coord0, TRIM(cl_name)) 2335 2417 … … 2377 2459 !> 2378 2460 !> @author J.Paul 2379 !> - November, 2013- Initial Version2461 !> @date November, 2013 - Initial Version 2380 2462 !> @date September, 2014 2381 2463 !> - check grid point … … 2520 2602 CALL grid_del_ghost(tl_lon0, il_xghost0(:,:)) 2521 2603 CALL grid_del_ghost(tl_lat0, il_xghost0(:,:)) 2522 2604 2523 2605 ! "global" coarse grid indice 2524 2606 il_imin0=1 … … 2568 2650 IF( dl_lon1_ll == tl_lon1%d_fill .OR. & 2569 2651 & 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)) ) 2570 2658 CALL logger_error("GRID GET COARSE INDEX: lower left corner "//& 2571 2659 & "point is FillValue. remove ghost cell "//& … … 2632 2720 ji = il_iul(1) 2633 2721 jj = il_iul(2) 2634 2635 2722 IF( ABS(tl_lon0%d_value(ji,jj,1,1)-dl_lon1_ul) > dp_delta )THEN 2636 2723 IF(tl_lon0%d_value(ji,jj,1,1) > dl_lon1_ul )THEN … … 2647 2734 ENDIF 2648 2735 ENDIF 2649 2650 2736 IF( ABS(tl_lat0%d_value(ji,jj,1,1)-dl_lat1_ul) > dp_delta )THEN 2651 2737 IF(tl_lat0%d_value(ji,jj,1,1) < dl_lat1_ul )THEN … … 2798 2884 ! 2799 2885 !> @author J.Paul 2800 !> - November, 2013- Initial Version2886 !> @date November, 2013 - Initial Version 2801 2887 ! 2802 2888 !> @param[in] td_lon longitude structure … … 2866 2952 !> 2867 2953 !> @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 2869 2956 ! 2870 2957 !> @param[in] dd_lon0 coarse grid array of longitude … … 2872 2959 !> @param[in] dd_lon1 fine grid longitude 2873 2960 !> @param[in] dd_lat1 fine grid latitude 2961 !> @param[in] dd_fill fill value 2874 2962 !> @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 ) 2878 2965 IMPLICIT NONE 2879 2966 ! Argument … … 2882 2969 REAL(dp), INTENT(IN) :: dd_lon1 2883 2970 REAL(dp), INTENT(IN) :: dd_lat1 2971 REAL(dp), INTENT(IN), OPTIONAL :: dd_fill 2884 2972 2885 2973 ! function … … 2929 3017 2930 3018 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 2961 3035 2962 3036 il_shape(1)= il_isup - il_iinf + 1 2963 3037 il_shape(2)= il_jsup - il_jinf + 1 2964 3038 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° 2966 3048 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 2973 3086 ENDIF 2974 3087 … … 2976 3089 DO WHILE( ll_continue .AND. .NOT. ll_north ) 2977 3090 3091 ll_continue=.FALSE. 2978 3092 IF( dl_lon1 == dl_lon0(il_imid,il_jmid) .AND. & 2979 3093 & dd_lat1 == dd_lat0(il_imid,il_jmid) )THEN … … 2982 3096 il_jinf = il_jmid ; il_jsup = il_jmid 2983 3097 2984 ll_continue=.FALSE.2985 2986 3098 ELSE 2987 IF( dl_lon1 > dl_lon0(il_imid,il_jmid) )THEN3099 IF( ALL(dl_lon0(il_imid,il_jinf:il_jsup) < dl_lon1) )THEN 2988 3100 2989 3101 ! point east 2990 3102 il_iinf = il_imid 3103 ll_continue=.TRUE. 2991 3104 2992 ELSE IF( dl_lon1 < dl_lon0(il_imid,il_jmid) )THEN3105 ELSE IF( ALL(dl_lon0(il_imid,il_jinf:il_jsup) > dl_lon1) )THEN 2993 3106 2994 3107 ! point west 2995 3108 il_isup = il_imid 3109 ll_continue=.TRUE. 2996 3110 2997 3111 ENDIF 2998 3112 2999 IF( dd_lat1 > dd_lat0(il_imid,il_jmid) )THEN3113 IF( ALL(dd_lat0(il_iinf:il_isup,il_jmid) < dd_lat1) )THEN 3000 3114 3001 3115 ! point north 3002 3116 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 3005 3120 3006 3121 ! point south 3007 3122 il_jsup = il_jmid 3123 ll_continue=.TRUE. 3008 3124 3009 3125 ENDIF … … 3014 3130 il_imid = il_iinf + INT(il_shape(1)/2) 3015 3131 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.3019 3132 3020 3133 ! exit when close enough of point … … 3049 3162 ! 3050 3163 !> @author J.Paul 3051 !> - November, 2013- Initial Version3164 !> @date November, 2013 - Initial Version 3052 3165 ! 3053 3166 !> @param[in] dd_lon grid longitude array … … 3055 3168 !> @param[in] dd_lonA longitude of point A 3056 3169 !> @param[in] dd_latA latitude of point A 3170 !> @param[in] dd_fill 3057 3171 !> @return array of distance between point A and grid points. 3058 3172 !------------------------------------------------------------------- 3059 FUNCTION grid_distance(dd_lon, dd_lat, dd_lonA, dd_latA )3173 FUNCTION grid_distance(dd_lon, dd_lat, dd_lonA, dd_latA ) 3060 3174 IMPLICIT NONE 3061 3175 ! Argument … … 3110 3224 DO ji=1,il_shape(1) 3111 3225 IF( dl_lon(ji,jj) == dl_lonA .AND. & 3112 & dl_lat(ji,jj) == dl_la TA )THEN3226 & dl_lat(ji,jj) == dl_latA )THEN 3113 3227 grid_distance(ji,jj)=0.0 3114 3228 ELSE 3115 3229 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) 3117 3232 ! check to avoid mistake with ACOS 3118 3233 IF( dl_tmp < -1.0 ) dl_tmp = -1.0 … … 3136 3251 ! 3137 3252 !> @author J.Paul 3138 !> - September, 2014- Initial Version3253 !> @date September, 2014 - Initial Version 3139 3254 !> @date October, 2014 3140 3255 !> - work on mpp file structure instead of file structure … … 3170 3285 3171 3286 ! 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 3176 3292 3177 INTEGER(i4), DIMENSION(:), ALLOCATABLE :: il_rho3293 INTEGER(i4), DIMENSION(:), ALLOCATABLE :: il_rho 3178 3294 3179 INTEGER(i4), DIMENSION(2,2) :: il_xghost03180 INTEGER(i4), DIMENSION(2,2) :: il_xghost13181 3182 CHARACTER(LEN= 1) :: cl_point3183 CHARACTER(LEN=lc) :: cl_name3295 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 3184 3300 3185 3301 REAL(dp) , DIMENSION(:,:), ALLOCATABLE :: dl_lon0 … … 3188 3304 REAL(dp) , DIMENSION(:,:), ALLOCATABLE :: dl_lat1 3189 3305 3190 TYPE(TVAR) :: tl_lon03191 TYPE(TVAR) :: tl_lat03192 TYPE(TVAR) :: tl_lon13193 TYPE(TVAR) :: tl_lat13194 3195 TYPE(TMPP) :: tl_coord03196 TYPE(TMPP) :: tl_coord13306 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 3197 3313 3198 3314 ! loop indices … … 3227 3343 ! read coarse longitue and latitude 3228 3344 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 3229 3352 tl_lon0=iom_mpp_read_var(tl_coord0, TRIM(cl_name)) 3353 3230 3354 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 3231 3362 tl_lat0=iom_mpp_read_var(tl_coord0, TRIM(cl_name)) 3232 3363 … … 3267 3398 ! read fine longitue and latitude 3268 3399 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 3269 3407 tl_lon1=iom_mpp_read_var(tl_coord1, TRIM(cl_name)) 3408 3270 3409 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 3271 3417 tl_lat1=iom_mpp_read_var(tl_coord1, TRIM(cl_name)) 3272 3418 … … 3318 3464 ! 3319 3465 !> @author J.Paul 3320 !> - September, 2014- Initial Version3466 !> @date September, 2014 - Initial Version 3321 3467 !> @date October, 2014 3322 3468 !> - work on mpp file structure instead of file structure … … 3354 3500 3355 3501 ! 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 3357 3505 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 3362 3508 3363 3509 REAL(dp) , DIMENSION(:,:), ALLOCATABLE :: dl_lon1 3364 3510 REAL(dp) , DIMENSION(:,:), ALLOCATABLE :: dl_lat1 3365 3511 3366 TYPE(TVAR) :: tl_lon13367 TYPE(TVAR) :: tl_lat13368 3369 TYPE(TMPP) :: tl_coord13512 TYPE(TVAR) :: tl_lon1 3513 TYPE(TVAR) :: tl_lat1 3514 3515 TYPE(TMPP) :: tl_coord1 3370 3516 ! loop indices 3371 3517 !---------------------------------------------------------------- … … 3397 3543 ! read fine longitue and latitude 3398 3544 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 3399 3552 tl_lon1=iom_mpp_read_var(tl_coord1, TRIM(cl_name)) 3553 3400 3554 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 3401 3562 tl_lat1=iom_mpp_read_var(tl_coord1, TRIM(cl_name)) 3402 3563 … … 3446 3607 ! 3447 3608 !> @author J.Paul 3448 !> - September, 2014- Initial Version3609 !> @date September, 2014 - Initial Version 3449 3610 !> @date October, 2014 3450 3611 !> - work on mpp file structure instead of file structure … … 3483 3644 3484 3645 ! 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 3489 3651 3490 INTEGER(i4), DIMENSION(:), ALLOCATABLE :: il_rho3652 INTEGER(i4), DIMENSION(:), ALLOCATABLE :: il_rho 3491 3653 3492 INTEGER(i4), DIMENSION(2,2) :: il_xghost03493 3494 CHARACTER(LEN= 1) :: cl_point3495 CHARACTER(LEN=lc) :: cl_name3654 INTEGER(i4), DIMENSION(2,2) :: il_xghost0 3655 3656 CHARACTER(LEN= 1) :: cl_point 3657 CHARACTER(LEN=lc) :: cl_name 3496 3658 3497 3659 REAL(dp) , DIMENSION(:,:), ALLOCATABLE :: dl_lon0 3498 3660 REAL(dp) , DIMENSION(:,:), ALLOCATABLE :: dl_lat0 3499 3661 3500 TYPE(TVAR) :: tl_lon03501 TYPE(TVAR) :: tl_lat03502 3503 TYPE(TMPP) :: tl_coord03662 TYPE(TVAR) :: tl_lon0 3663 TYPE(TVAR) :: tl_lat0 3664 3665 TYPE(TMPP) :: tl_coord0 3504 3666 ! loop indices 3505 3667 !---------------------------------------------------------------- … … 3530 3692 ! read coarse longitue and latitude 3531 3693 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 3532 3701 tl_lon0=iom_mpp_read_var(tl_coord0, TRIM(cl_name)) 3702 3533 3703 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 3534 3711 tl_lat0=iom_mpp_read_var(tl_coord0, TRIM(cl_name)) 3535 3712 … … 3585 3762 ! 3586 3763 !> @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 !> 3590 3770 !> @param[in] dd_lon0 coarse grid longitude array 3591 3771 !> @param[in] dd_lat0 coarse grid latitude array … … 3620 3800 3621 3801 ! 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 3624 3805 REAL(dp) , DIMENSION(:,:), ALLOCATABLE :: dl_lon0 3625 3806 REAL(dp) , DIMENSION(:,:), ALLOCATABLE :: dl_lon1 3807 3808 LOGICAL :: ll_ii 3809 LOGICAL :: ll_ij 3626 3810 3627 3811 ! loop indices … … 3657 3841 grid__get_fine_offset_cc(:,:)=-1 3658 3842 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 3662 3849 IF( dl_lon1(1,1) < dl_lon0(id_imin0+1,id_jmin0) )THEN 3663 3850 DO ji=1,id_rho(jp_I)+2 3664 3851 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)-ji3852 grid__get_fine_offset_cc(jp_I,1)=(id_rho(jp_I)+1)-ji 3666 3853 EXIT 3667 3854 ENDIF … … 3671 3858 & " not match fine grid lower left corner.") 3672 3859 ENDIF 3673 3674 3860 ! look for i-direction right offset 3675 IF( dl_lon1(il_shape1( 1),1) > dl_lon0(id_imax0-1,id_jmin0) )THEN3861 IF( dl_lon1(il_shape1(jp_I),1) > dl_lon0(id_imax0-1,id_jmin0) )THEN 3676 3862 DO ji=1,id_rho(jp_I)+2 3677 ii=il_shape1( 1)-ji+13863 ii=il_shape1(jp_I)-ji+1 3678 3864 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)-ji3865 grid__get_fine_offset_cc(jp_I,2)=(id_rho(jp_I)+1)-ji 3680 3866 EXIT 3681 3867 ENDIF … … 3686 3872 ENDIF 3687 3873 3688 ELSE 3689 grid__get_fine_offset_cc(1,:)=((id_rho(jp_I)-1)/2)3690 ENDIF3691 3692 IF( il_shape1(2) > 1 )THEN3874 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 3693 3879 3694 3880 ! look for j-direction lower offset … … 3696 3882 DO jj=1,id_rho(jp_J)+2 3697 3883 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)-jj3884 grid__get_fine_offset_cc(jp_J,1)=(id_rho(jp_J)+1)-jj 3699 3885 EXIT 3700 3886 ENDIF … … 3706 3892 3707 3893 ! look for j-direction upper offset 3708 IF( dd_lat1(1,il_shape1( 2)) > dd_lat0(id_imin0,id_jmax0-1) )THEN3894 IF( dd_lat1(1,il_shape1(jp_J)) > dd_lat0(id_imin0,id_jmax0-1) )THEN 3709 3895 DO jj=1,id_rho(jp_J)+2 3710 ij=il_shape1( 2)-jj+13896 ij=il_shape1(jp_J)-jj+1 3711 3897 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)-jj3898 grid__get_fine_offset_cc(jp_J,2)=(id_rho(jp_J)+1)-jj 3713 3899 EXIT 3714 3900 ENDIF … … 3717 3903 CALL logger_error("GRID GET FINE OFFSET: coarse grid indices do "//& 3718 3904 & " 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 3722 3982 ENDIF 3723 3983 … … 3732 3992 ! 3733 3993 !> @author J.Paul 3734 !> -November, 2013- Initial Version3994 !> @date November, 2013- Initial Version 3735 3995 !> @date October, 2014 3736 3996 !> - work on mpp file structure instead of file structure … … 3742 4002 !> @param[in] id_jmin0 coarse grid lower left corner j-indice of fine grid domain 3743 4003 !> @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 3745 4005 !------------------------------------------------------------------- 3746 4006 SUBROUTINE grid_check_coincidence( td_coord0, td_coord1, & … … 4042 4302 !> 4043 4303 !> @author J.Paul 4044 !> - November, 2013- Initial Version4304 !> @date November, 2013 - Initial Version 4045 4305 ! 4046 4306 !> @param[in] dd_lon0 array of coarse grid longitude … … 4103 4363 dl_lon1 = dd_lon1(il_imin1, il_jmin1) 4104 4364 dl_lat1 = dd_lat1(il_imin1, il_jmin1) 4105 4106 4365 4107 4366 IF( (ABS(dl_lon1-dl_lon0)>dp_delta) .AND. (dl_lon1 < dl_lon0 ) .OR. & … … 4202 4461 ! 4203 4462 !> @author J.Paul 4204 !> - November, 2013- Initial Version4463 !> @date November, 2013 - Initial Version 4205 4464 ! 4206 4465 !> @param[in] dd_lat0 array of coarse grid latitude … … 4272 4531 !> 4273 4532 !> @author J.Paul 4274 !> - November, 2013-Initial version4533 !> @date November, 2013 - Initial version 4275 4534 ! 4276 4535 !> @param[inout] td_var array of variable structure … … 4348 4607 !> 4349 4608 !> @author J.Paul 4350 !> - November, 2013-Initial version4609 !> @date November, 2013 - Initial version 4351 4610 ! 4352 4611 !> @param[inout] td_var array of variable structure … … 4374 4633 IF( ALL(td_var%t_dim(1:2)%l_use) )THEN 4375 4634 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 4378 4639 4379 4640 ! copy variable … … 4425 4686 !> 4426 4687 !> @author J.Paul 4427 !> - September, 2014- Initial Version4688 !> @date September, 2014 - Initial Version 4428 4689 ! 4429 4690 !> @param[in] td_var variable sturcture … … 4555 4816 !> 4556 4817 !> @author J.Paul 4557 !> -September, 2014 - Initial Version4818 !> @date September, 2014 - Initial Version 4558 4819 !> @date October, 2014 4559 4820 !> - work on mpp file structure instead of file structure … … 4592 4853 tl_mpp=mpp_copy(td_mpp) 4593 4854 4855 CALL logger_info("GRID GET FINE GHOST perio"//TRIM(fct_str(tl_mpp%i_perio))) 4594 4856 IF( tl_mpp%i_perio < 0 )THEN 4595 4857 ! compute NEMO periodicity index … … 4627 4889 !> 4628 4890 !> @author J.Paul 4629 !> - November, 2013- Initial Version4891 !> @date November, 2013 - Initial Version 4630 4892 ! 4631 4893 !> @param[in] td_var variable strucutre … … 4694 4956 il_tmp(jim:jip,jjm:jjp)=1 4695 4957 END WHERE 4958 4696 4959 ENDIF 4697 4960 ENDDO … … 4720 4983 !> 4721 4984 !> @details 4722 !> the minimum size (n bumber of point) of closed sea to be kept could be4985 !> the minimum size (number of point) of closed sea to be kept could be 4723 4986 !> sepcify with id_minsize. 4724 4987 !> By default only the biggest sea is preserve. 4725 4988 !> 4726 4989 !> @author J.Paul 4727 !> - November, 2013- Initial Version4990 !> @date November, 2013 - Initial Version 4728 4991 !> 4729 4992 !> @param[inout] td_var variable structure … … 4782 5045 4783 5046 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 4784 5144 END MODULE grid 4785 5145
Note: See TracChangeset
for help on using the changeset viewer.