- Timestamp:
- 2016-03-29T11:24:48+02:00 (8 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2015/dev_r5803_UKMO_AGRIF_Vert_interp/NEMOGCM/TOOLS/SIREN/src/grid.f90
r6401 r6404 80 80 !> point:<br/> 81 81 !> @code 82 !> il_index(:)=grid_get_closest(dd_lon0(:,:), dd_lat0(:,:), dd_lon1, dd_lat1) 82 !> il_index(:)=grid_get_closest(dd_lon0(:,:), dd_lat0(:,:), dd_lon1, dd_lat1 83 !> [,dd_fill] [,cd_pos]) 83 84 !> @endcode 84 85 !> - il_index(:) is coarse grid indices (/ i0, j0 /) … … 87 88 !> - dd_lon1 is fine grid longitude value (real(8)) 88 89 !> - dd_lat1 is fine grid latitude value (real(8)) 90 !> - dd_fill 91 !> - cd_pos 89 92 !> 90 93 !> to compute distance between a point A and grid points:<br/> … … 215 218 !> @date February, 2015 216 219 !> - add function grid_fill_small_msk to fill small domain inside bigger one 220 !> @February, 2016 221 !> - improve way to check coincidence (bug fix) 222 !> - manage grid cases for T,U,V or F point, with even or odd refinment (bug fix) 217 223 ! 218 224 !> @note Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) … … 664 670 665 671 ! no pivot point found 666 CALL logger_ error("GRID GET PIVOT: something wrong "//&672 CALL logger_warn("GRID GET PIVOT: something wrong "//& 667 673 & "when computing pivot point with variable "//& 668 674 & TRIM(td_var%c_name)) … … 685 691 686 692 IF( grid__get_pivot_var /= -1 )THEN 687 CALL logger_ warn("GRID GET PIVOT: variable "//&693 CALL logger_info("GRID GET PIVOT: variable "//& 688 694 & TRIM(td_var%c_name)//" seems to be on grid point "//& 689 695 & TRIM(cp_grid_point(jj)) ) … … 1335 1341 il_dim(:)=td_var%t_dim(:)%i_len 1336 1342 1337 CALL logger_ info("GRID GET PERIO: use varibale "//TRIM(td_var%c_name))1338 CALL logger_ info("GRID GET PERIO: fill value "//TRIM(fct_str(td_var%d_fill)))1339 CALL logger_ info("GRID GET PERIO: fillvalue "//TRIM(fct_str(td_var%d_value(1,1,1,1))))1343 CALL logger_debug("GRID GET PERIO: use varibale "//TRIM(td_var%c_name)) 1344 CALL logger_debug("GRID GET PERIO: fill value "//TRIM(fct_str(td_var%d_fill))) 1345 CALL logger_debug("GRID GET PERIO: first value "//TRIM(fct_str(td_var%d_value(1,1,1,1)))) 1340 1346 1341 1347 IF(ALL(td_var%d_value( 1 , : ,1,1)/=td_var%d_fill).AND.& … … 1344 1350 & ALL(td_var%d_value( : ,il_dim(2),1,1)/=td_var%d_fill))THEN 1345 1351 ! no boundary closed 1346 CALL logger_ warn("GRID GET PERIO: can't determined periodicity. "//&1352 CALL logger_error("GRID GET PERIO: can't determined periodicity. "//& 1347 1353 & "there is no boundary closed for variable "//& 1348 1354 & TRIM(td_var%c_name) ) 1355 ! check pivot 1356 SELECT CASE(id_pivot) 1357 CASE(0) 1358 ! F pivot 1359 CALL logger_warn("GRID GET PERIO: assume domain is global") 1360 grid__get_perio_var=6 1361 CASE(1) 1362 ! T pivot 1363 CALL logger_warn("GRID GET PERIO: assume domain is global") 1364 grid__get_perio_var=4 1365 END SELECT 1349 1366 ELSE 1350 1367 ! check periodicity … … 2287 2304 & il_rho(:), cl_point ) 2288 2305 2289 2290 2306 CALL var_clean(tl_lon1) 2291 2307 CALL var_clean(tl_lat1) … … 2463 2479 !> - check grid point 2464 2480 !> - take into account EW overlap 2481 !> @date February, 2016 2482 !> - use delta (lon or lat) 2483 !> - manage cases for T,U,V or F point, with even or odd refinment 2465 2484 !> 2466 2485 !> @param[in] td_lon0 coarse grid longitude … … 2490 2509 2491 2510 ! local variable 2492 REAL(dp) :: dl_lon1_ll 2493 REAL(dp) :: dl_lon1_ul 2494 REAL(dp) :: dl_lon1_lr 2495 REAL(dp) :: dl_lon1_ur 2496 2497 REAL(dp) :: dl_lat1_ll 2498 REAL(dp) :: dl_lat1_ul 2499 REAL(dp) :: dl_lat1_lr 2500 REAL(dp) :: dl_lat1_ur 2511 CHARACTER(LEN= 1) :: cl_point0 2512 CHARACTER(LEN= 1) :: cl_point1 2513 2514 LOGICAL , DIMENSION(2) :: ll_even 2515 2516 REAL(dp) :: dl_lon1 2517 REAL(dp) :: dl_dlon 2518 REAL(dp) :: dl_lat1 2519 REAL(dp) :: dl_dlat 2520 2521 INTEGER(i4) :: il_ew0 2522 INTEGER(i4) :: il_imin0 2523 INTEGER(i4) :: il_imax0 2524 INTEGER(i4) :: il_jmin0 2525 INTEGER(i4) :: il_jmax0 2526 2527 INTEGER(i4) :: il_ew1 2528 INTEGER(i4) :: il_imin1 2529 INTEGER(i4) :: il_imax1 2530 INTEGER(i4) :: il_jmin1 2531 INTEGER(i4) :: il_jmax1 2532 2533 INTEGER(i4) :: il_imin 2534 INTEGER(i4) :: il_imax 2535 INTEGER(i4) :: il_jmin 2536 INTEGER(i4) :: il_jmax 2501 2537 2502 2538 INTEGER(i4), DIMENSION(:), ALLOCATABLE :: il_rho 2503 2539 2504 INTEGER(i4), DIMENSION(2) :: il_ill 2505 INTEGER(i4), DIMENSION(2) :: il_ilr 2506 INTEGER(i4), DIMENSION(2) :: il_iul 2507 INTEGER(i4), DIMENSION(2) :: il_iur 2508 2509 INTEGER(i4) :: il_ew0 2510 INTEGER(i4) :: il_imin0 2511 INTEGER(i4) :: il_imax0 2512 INTEGER(i4) :: il_jmin0 2513 INTEGER(i4) :: il_jmax0 2514 2515 INTEGER(i4) :: il_ew1 2516 INTEGER(i4) :: il_imin1 2517 INTEGER(i4) :: il_imax1 2518 INTEGER(i4) :: il_jmin1 2519 INTEGER(i4) :: il_jmax1 2520 2521 INTEGER(i4) :: il_imin 2522 INTEGER(i4) :: il_imax 2523 INTEGER(i4) :: il_jmin 2524 INTEGER(i4) :: il_jmax 2525 2526 INTEGER(i4), DIMENSION(2,2) :: il_xghost0 2527 INTEGER(i4), DIMENSION(2,2) :: il_yghost0 2528 INTEGER(i4), DIMENSION(2,2) :: il_xghost1 2529 INTEGER(i4), DIMENSION(2,2) :: il_yghost1 2530 2531 TYPE(TVAR) :: tl_lon0 2532 TYPE(TVAR) :: tl_lat0 2533 TYPE(TVAR) :: tl_lon1 2534 TYPE(TVAR) :: tl_lat1 2535 2536 CHARACTER(LEN= 1) :: cl_point0 2537 CHARACTER(LEN= 1) :: cl_point1 2538 2540 INTEGER(i4), DIMENSION(2) :: il_ill 2541 INTEGER(i4), DIMENSION(2) :: il_ilr 2542 INTEGER(i4), DIMENSION(2) :: il_iul 2543 INTEGER(i4), DIMENSION(2) :: il_iur 2544 2545 INTEGER(i4), DIMENSION(2,2) :: il_xghost0 2546 INTEGER(i4), DIMENSION(2,2) :: il_yghost0 2547 INTEGER(i4), DIMENSION(2,2) :: il_xghost1 2548 INTEGER(i4), DIMENSION(2,2) :: il_yghost1 2549 2550 TYPE(TVAR) :: tl_lon0 2551 TYPE(TVAR) :: tl_lat0 2552 TYPE(TVAR) :: tl_lon1 2553 TYPE(TVAR) :: tl_lat1 2554 2539 2555 ! loop indices 2540 INTEGER(i4) :: ji2541 INTEGER(i4) :: jj2542 2556 !---------------------------------------------------------------- 2543 2557 ! init … … 2547 2561 il_rho(:)=1 2548 2562 IF( PRESENT(id_rho) ) il_rho(:)=id_rho(:) 2563 2564 ll_even(:)=(/ (MOD(id_rho(jp_I),2)==0), (MOD(id_rho(jp_J),2)==0) /) 2549 2565 2550 2566 cl_point0='T' … … 2645 2661 ! get indices for each corner 2646 2662 !1- search lower left corner indices 2647 dl_lon1_ll=tl_lon1%d_value( il_imin1, il_jmin1, 1, 1 ) 2648 dl_lat1_ll=tl_lat1%d_value( il_imin1, il_jmin1, 1, 1 ) 2649 2650 IF( dl_lon1_ll == tl_lon1%d_fill .OR. & 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)) ) 2663 dl_lon1=tl_lon1%d_value( il_imin1, il_jmin1, 1, 1 ) 2664 dl_lat1=tl_lat1%d_value( il_imin1, il_jmin1, 1, 1 ) 2665 2666 IF( dl_lon1 == tl_lon1%d_fill .OR. & 2667 & dl_lat1 == tl_lat1%d_fill )THEN 2658 2668 CALL logger_error("GRID GET COARSE INDEX: lower left corner "//& 2659 2669 & "point is FillValue. remove ghost cell "//& 2660 2670 & "before running grid_get_coarse_index.") 2661 2671 ENDIF 2672 2673 !!!!! i-direction !!!!! 2674 IF( ll_even(jp_I) )THEN 2675 ! even 2676 SELECT CASE(TRIM(cl_point1)) 2677 CASE('F','U') 2678 dl_dlon= ( tl_lon1%d_value(il_imin1+1,il_jmin1,1,1) - & 2679 & tl_lon1%d_value(il_imin1 ,il_jmin1,1,1) ) / & 2680 & 2. 2681 CASE DEFAULT 2682 dl_dlon=0 2683 END SELECT 2684 ELSE 2685 ! odd 2686 dl_dlon= ( tl_lon1%d_value(il_imin1+1,il_jmin1,1,1) - & 2687 & tl_lon1%d_value(il_imin1 ,il_jmin1,1,1) ) / & 2688 & 2. 2689 ENDIF 2690 2691 !!!!! j-direction !!!!! 2692 IF( ll_even(jp_J) )THEN 2693 ! even 2694 SELECT CASE(TRIM(cl_point1)) 2695 CASE('F','V') 2696 dl_dlat= ( tl_lat1%d_value(il_imin1,il_jmin1+1,1,1) - & 2697 & tl_lat1%d_value(il_imin1,il_jmin1 ,1,1) ) / & 2698 & 2. 2699 CASE DEFAULT 2700 dl_dlat=0 2701 END SELECT 2702 ELSE 2703 ! odd 2704 dl_dlat= ( tl_lat1%d_value(il_imin1,il_jmin1+1,1,1) - & 2705 & tl_lat1%d_value(il_imin1,il_jmin1 ,1,1) ) / & 2706 & 2. 2707 ENDIF 2708 2709 dl_lon1 = dl_lon1 + dl_dlon 2710 dl_lat1 = dl_lat1 + dl_dlat 2711 2662 2712 ! look for closest point on coarse grid 2663 2713 il_ill(:)= grid_get_closest(tl_lon0%d_value(il_imin0:il_imax0, & … … 2667 2717 & il_jmin0:il_jmax0, & 2668 2718 & 1,1), & 2669 & dl_lon1_ll, dl_lat1_ll ) 2670 2671 ! coarse grid point should be south west of fine grid domain 2672 ji = il_ill(1) 2673 jj = il_ill(2) 2674 2675 IF( ABS(tl_lon0%d_value(ji,jj,1,1)-dl_lon1_ll) > dp_delta )THEN 2676 IF(tl_lon0%d_value(ji,jj,1,1) > dl_lon1_ll )THEN 2677 il_ill(1)=il_ill(1)-1 2678 IF( il_ill(1) <= 0 )THEN 2679 IF( tl_lon0%i_ew >= 0 )THEN 2680 il_ill(1)=tl_lon0%t_dim(jp_I)%i_len-tl_lon0%i_ew 2681 ELSE 2682 CALL logger_error("GRID GET COARSE INDEX: error "//& 2683 & "computing lower left corner "//& 2684 & "index for longitude") 2685 ENDIF 2686 ENDIF 2687 ENDIF 2688 ENDIF 2689 IF( ABS(tl_lat0%d_value(ji,jj,1,1)-dl_lat1_ll) > dp_delta )THEN 2690 IF(tl_lat0%d_value(ji,jj,1,1) > dl_lat1_ll )THEN 2691 il_ill(2)=il_ill(2)-1 2692 IF( il_ill(2)-1 <= 0 )THEN 2693 CALL logger_error("GRID GET COARSE INDEX: error "//& 2694 & "computing lower left corner "//& 2695 & "index for latitude") 2696 ENDIF 2697 ENDIF 2698 ENDIF 2719 & dl_lon1, dl_lat1, 'll' ) 2720 2699 2721 2700 2722 !2- search upper left corner indices 2701 dl_lon1 _ul=tl_lon1%d_value( il_imin1, il_jmax1, 1, 1 )2702 dl_lat1 _ul=tl_lat1%d_value( il_imin1, il_jmax1, 1, 1 )2703 2704 IF( dl_lon1 _ul== tl_lon1%d_fill .OR. &2705 & dl_lat1 _ul== tl_lat1%d_fill )THEN2723 dl_lon1=tl_lon1%d_value( il_imin1, il_jmax1, 1, 1 ) 2724 dl_lat1=tl_lat1%d_value( il_imin1, il_jmax1, 1, 1 ) 2725 2726 IF( dl_lon1 == tl_lon1%d_fill .OR. & 2727 & dl_lat1 == tl_lat1%d_fill )THEN 2706 2728 CALL logger_error("GRID GET COARSE INDEX: upper left corner "//& 2707 2729 & "point is FillValue. remove ghost cell "//& 2708 2730 & "running grid_get_coarse_index.") 2709 2731 ENDIF 2732 2733 !!!!! i-direction !!!!! 2734 IF( ll_even(jp_I) )THEN 2735 ! even 2736 SELECT CASE(TRIM(cl_point1)) 2737 CASE('F','U') 2738 dl_dlon= ( tl_lon1%d_value(il_imin1+1,il_jmax1,1,1) - & 2739 & tl_lon1%d_value(il_imin1 ,il_jmax1,1,1) ) / & 2740 & 2. 2741 CASE DEFAULT 2742 dl_dlon=0 2743 END SELECT 2744 ELSE 2745 ! odd 2746 dl_dlon= ( tl_lon1%d_value(il_imin1+1,il_jmax1,1,1) - & 2747 & tl_lon1%d_value(il_imin1 ,il_jmax1,1,1) ) / & 2748 & 2. 2749 ENDIF 2750 2751 !!!!! j-direction !!!!! 2752 IF( ll_even(jp_J) )THEN 2753 ! even 2754 SELECT CASE(TRIM(cl_point1)) 2755 CASE('F','V') 2756 dl_dlat= ( tl_lat1%d_value(il_imin1,il_jmax1 ,1,1) - & 2757 & tl_lat1%d_value(il_imin1,il_jmax1-1,1,1) ) / & 2758 & 2. 2759 CASE DEFAULT 2760 dl_dlat=0 2761 END SELECT 2762 ELSE 2763 ! odd 2764 dl_dlat= ( tl_lat1%d_value(il_imin1,il_jmax1 ,1,1) - & 2765 & tl_lat1%d_value(il_imin1,il_jmax1-1,1,1) ) / & 2766 & 2. 2767 ENDIF 2768 2769 dl_lon1 = dl_lon1 + dl_dlon 2770 dl_lat1 = dl_lat1 - dl_dlat 2771 2710 2772 ! look for closest point on coarse grid 2711 2773 il_iul(:)= grid_get_closest(tl_lon0%d_value(il_imin0:il_imax0, & … … 2715 2777 & il_jmin0:il_jmax0, & 2716 2778 & 1,1), & 2717 & dl_lon1_ul, dl_lat1_ul ) 2718 2719 ! coarse grid point should be north west of fine grid domain 2720 ji = il_iul(1) 2721 jj = il_iul(2) 2722 IF( ABS(tl_lon0%d_value(ji,jj,1,1)-dl_lon1_ul) > dp_delta )THEN 2723 IF(tl_lon0%d_value(ji,jj,1,1) > dl_lon1_ul )THEN 2724 il_iul(1)=il_iul(1)-1 2725 IF( il_iul(1) <= 0 )THEN 2726 IF( tl_lon0%i_ew >= 0 )THEN 2727 il_iul(1)=tl_lon0%t_dim(jp_I)%i_len-tl_lon0%i_ew 2728 ELSE 2729 CALL logger_error("GRID GET COARSE INDEX: error "//& 2730 & "computing upper left corner "//& 2731 & "index for longitude") 2732 ENDIF 2733 ENDIF 2734 ENDIF 2735 ENDIF 2736 IF( ABS(tl_lat0%d_value(ji,jj,1,1)-dl_lat1_ul) > dp_delta )THEN 2737 IF(tl_lat0%d_value(ji,jj,1,1) < dl_lat1_ul )THEN 2738 il_iul(2)=il_iul(2)+1 2739 IF( il_ill(2) > tl_lat0%t_dim(jp_J)%i_len )THEN 2740 CALL logger_error("GRID GET COARSE INDEX: error "//& 2741 & "computing upper left corner "//& 2742 & "index for latitude") 2743 ENDIF 2744 ENDIF 2745 ENDIF 2779 & dl_lon1, dl_lat1, 'ul' ) 2746 2780 2747 2781 !3- search lower right corner indices 2748 dl_lon1 _lr=tl_lon1%d_value( il_imax1, il_jmin1, 1, 1 )2749 dl_lat1 _lr=tl_lat1%d_value( il_imax1, il_jmin1, 1, 1 )2750 2751 IF( dl_lon1 _lr== tl_lon1%d_fill .OR. &2752 & dl_lat1 _lr== tl_lat1%d_fill )THEN2782 dl_lon1=tl_lon1%d_value( il_imax1, il_jmin1, 1, 1 ) 2783 dl_lat1=tl_lat1%d_value( il_imax1, il_jmin1, 1, 1 ) 2784 2785 IF( dl_lon1 == tl_lon1%d_fill .OR. & 2786 & dl_lat1 == tl_lat1%d_fill )THEN 2753 2787 CALL logger_error("GRID GET COARSE INDEX: lower right corner "//& 2754 2788 & "point is FillValue. remove ghost cell "//& 2755 2789 & "running grid_get_coarse_index.") 2756 2790 ENDIF 2791 2792 !!!!! i-direction !!!!! 2793 IF( ll_even(jp_I) )THEN 2794 ! even 2795 SELECT CASE(TRIM(cl_point1)) 2796 CASE('F','U') 2797 dl_dlon= ( tl_lon1%d_value(il_imax1 ,il_jmin1,1,1) - & 2798 & tl_lon1%d_value(il_imax1-1,il_jmin1,1,1) ) / & 2799 & 2. 2800 CASE DEFAULT 2801 dl_dlon=0 2802 END SELECT 2803 ELSE 2804 ! odd 2805 dl_dlon= ( tl_lon1%d_value(il_imax1 ,il_jmin1,1,1) - & 2806 & tl_lon1%d_value(il_imax1-1,il_jmin1,1,1) ) / & 2807 & 2. 2808 ENDIF 2809 2810 !!!!! j-direction !!!!! 2811 IF( ll_even(jp_J) )THEN 2812 ! even 2813 SELECT CASE(TRIM(cl_point1)) 2814 CASE('F','V') 2815 dl_dlat= ( tl_lat1%d_value(il_imax1,il_jmin1+1,1,1) - & 2816 & tl_lat1%d_value(il_imax1,il_jmin1 ,1,1) ) / & 2817 & 2. 2818 CASE DEFAULT 2819 dl_dlat=0 2820 END SELECT 2821 ELSE 2822 ! odd 2823 dl_dlat= ( tl_lat1%d_value(il_imax1,il_jmin1+1,1,1) - & 2824 & tl_lat1%d_value(il_imax1,il_jmin1 ,1,1) ) / & 2825 & 2. 2826 ENDIF 2827 2828 dl_lon1 = dl_lon1 - dl_dlon 2829 dl_lat1 = dl_lat1 + dl_dlat 2830 2757 2831 ! look for closest point on coarse grid 2758 2832 il_ilr(:)= grid_get_closest(tl_lon0%d_value(il_imin0:il_imax0, & … … 2762 2836 & il_jmin0:il_jmax0, & 2763 2837 & 1,1), & 2764 & dl_lon1_lr, dl_lat1_lr ) 2765 2766 ! coarse grid point should be south east of fine grid domain 2767 ji = il_ilr(1) 2768 jj = il_ilr(2) 2769 IF( ABS(tl_lon0%d_value(ji,jj,1,1)-dl_lon1_lr) > dp_delta )THEN 2770 IF( tl_lon0%d_value(ji,jj,1,1) < dl_lon1_lr )THEN 2771 il_ilr(1)=il_ilr(1)+1 2772 IF( il_ilr(1) > tl_lon0%t_dim(jp_I)%i_len )THEN 2773 IF( tl_lon0%i_ew >= 0 )THEN 2774 il_ilr(1)=tl_lon0%i_ew+1 2775 ELSE 2776 CALL logger_error("GRID GET COARSE INDEX: error "//& 2777 & "computing lower right corner "//& 2778 & "index for longitude") 2779 ENDIF 2780 ENDIF 2781 ENDIF 2782 ENDIF 2783 IF( ABS(tl_lat0%d_value(ji,jj,1,1)-dl_lat1_lr) > dp_delta )THEN 2784 IF( tl_lat0%d_value(ji,jj,1,1) > dl_lat1_lr )THEN 2785 il_ilr(2)=il_ilr(2)-1 2786 IF( il_ilr(2) <= 0 )THEN 2787 CALL logger_error("GRID GET COARSE INDEX: error "//& 2788 & "computing lower right corner "//& 2789 & "index for latitude") 2790 ENDIF 2791 ENDIF 2792 ENDIF 2838 & dl_lon1, dl_lat1, 'lr' ) 2793 2839 2794 2840 !4- search upper right corner indices 2795 dl_lon1 _ur=tl_lon1%d_value( il_imax1, il_jmax1, 1, 1 )2796 dl_lat1 _ur=tl_lat1%d_value( il_imax1, il_jmax1, 1, 1 )2797 2798 IF( dl_lon1 _ur== tl_lon1%d_fill .OR. &2799 & dl_lat1 _ur== tl_lat1%d_fill )THEN2841 dl_lon1=tl_lon1%d_value( il_imax1, il_jmax1, 1, 1 ) 2842 dl_lat1=tl_lat1%d_value( il_imax1, il_jmax1, 1, 1 ) 2843 2844 IF( dl_lon1 == tl_lon1%d_fill .OR. & 2845 & dl_lat1 == tl_lat1%d_fill )THEN 2800 2846 CALL logger_error("GRID GET COARSE INDEX: upper right corner "//& 2801 2847 & "point is FillValue. remove ghost cell "//& 2802 & " running grid_get_coarse_index.")2848 & "before running grid_get_coarse_index.") 2803 2849 ENDIF 2850 2851 !!!!! i-direction !!!!! 2852 IF( ll_even(jp_I) )THEN 2853 ! even 2854 SELECT CASE(TRIM(cl_point1)) 2855 CASE('F','U') 2856 dl_dlon= ( tl_lon1%d_value(il_imax1 ,il_jmax1,1,1) - & 2857 & tl_lon1%d_value(il_imax1-1,il_jmax1,1,1) ) / & 2858 & 2. 2859 CASE DEFAULT 2860 dl_dlon=0 2861 END SELECT 2862 ELSE 2863 ! odd 2864 dl_dlon= ( tl_lon1%d_value(il_imax1 ,il_jmax1,1,1) - & 2865 & tl_lon1%d_value(il_imax1-1,il_jmax1,1,1) ) / & 2866 & 2. 2867 ENDIF 2868 2869 !!!!! j-direction !!!!! 2870 IF( ll_even(jp_J) )THEN 2871 ! even 2872 SELECT CASE(TRIM(cl_point1)) 2873 CASE('F','V') 2874 dl_dlat= ( tl_lat1%d_value(il_imax1,il_jmax1 ,1,1) - & 2875 & tl_lat1%d_value(il_imax1,il_jmax1-1,1,1) ) / & 2876 & 2. 2877 CASE DEFAULT 2878 dl_dlat=0 2879 END SELECT 2880 ELSE 2881 ! odd 2882 dl_dlat= ( tl_lat1%d_value(il_imax1,il_jmax1 ,1,1) - & 2883 & tl_lat1%d_value(il_imax1,il_jmax1-1,1,1) ) / & 2884 & 2. 2885 ENDIF 2886 2887 dl_lon1 = dl_lon1 - dl_dlon 2888 dl_lat1 = dl_lat1 - dl_dlat 2889 2804 2890 ! look for closest point on coarse grid 2805 2891 il_iur(:)= grid_get_closest(tl_lon0%d_value(il_imin0:il_imax0, & … … 2809 2895 & il_jmin0:il_jmax0, & 2810 2896 & 1,1), & 2811 & dl_lon1_ur, dl_lat1_ur ) 2812 2813 ! coarse grid point should be north east fine grid domain 2814 ji = il_iur(1) 2815 jj = il_iur(2) 2816 IF( ABS(tl_lon0%d_value(ji,jj,1,1)-dl_lon1_ur) > dp_delta )THEN 2817 IF( tl_lon0%d_value(ji,jj,1,1) < dl_lon1_ur )THEN 2818 il_iur(1)=il_iur(1)+1 2819 IF( il_iur(1) > tl_lon0%t_dim(jp_I)%i_len )THEN 2820 IF( tl_lon0%i_ew >= 0 )THEN 2821 il_iur(1)=tl_lon0%i_ew+1 2822 ELSE 2823 CALL logger_error("GRID GET COARSE INDEX: error "//& 2824 & "computing upper right corner "//& 2825 & "index for longitude") 2826 ENDIF 2827 ENDIF 2828 ENDIF 2829 ENDIF 2830 IF( ABS(tl_lat0%d_value(ji,jj,1,1)-dl_lat1_ur) > dp_delta )THEN 2831 IF( tl_lat0%d_value(ji,jj,1,1) < dl_lat1_ur )THEN 2832 il_iur(2)=il_iur(2)+1 2833 IF( il_iur(2) > tl_lat0%t_dim(jp_J)%i_len )THEN 2834 CALL logger_error("GRID GET COARSE INDEX: error "//& 2835 & "computing upper right corner "//& 2836 & "index for latitude") 2837 ENDIF 2838 ENDIF 2839 ENDIF 2897 & dl_lon1, dl_lat1, 'ur' ) 2840 2898 2841 2899 ! coarse grid indices … … 2943 3001 END FUNCTION grid_is_global 2944 3002 !------------------------------------------------------------------- 2945 !> @brief This function return coarsegrid indices of the closest point2946 !> from fine gridpoint (lon1,lat1)3003 !> @brief This function return grid indices of the closest point 3004 !> from point (lon1,lat1) 2947 3005 !> 2948 3006 !> @details … … 2951 3009 !> of longitude and latitude, before running this function 2952 3010 !> 3011 !> if you add cd_pos argument, you could choice to return closest point at 3012 !> - lower left (ll) of the point 3013 !> - lower right (lr) of the point 3014 !> - upper left (ul) of the point 3015 !> - upper right (ur) of the point 3016 !> - lower (lo) of the point 3017 !> - upper (up) of the point 3018 !> - left (le) of the point 3019 !> - right (ri) of the point 3020 !> 2953 3021 !> @author J.Paul 2954 3022 !> @date November, 2013 - Initial Version 2955 !> @date February, 2015 - change dichotomy method to manage ORCA grid 3023 !> @date February, 2015 3024 !> - change dichotomy method to manage ORCA grid 3025 !> @date February, 2016 3026 !> - add optional use of relative position 2956 3027 ! 2957 3028 !> @param[in] dd_lon0 coarse grid array of longitude … … 2959 3030 !> @param[in] dd_lon1 fine grid longitude 2960 3031 !> @param[in] dd_lat1 fine grid latitude 3032 !> @param[in] cd_pos relative position of grid point from point 2961 3033 !> @param[in] dd_fill fill value 2962 3034 !> @return coarse grid indices of closest point of fine grid point 2963 3035 !------------------------------------------------------------------- 2964 FUNCTION grid_get_closest( dd_lon0, dd_lat0, dd_lon1, dd_lat1, dd_fill )3036 FUNCTION grid_get_closest( dd_lon0, dd_lat0, dd_lon1, dd_lat1, cd_pos, dd_fill ) 2965 3037 IMPLICIT NONE 2966 3038 ! Argument … … 2969 3041 REAL(dp), INTENT(IN) :: dd_lon1 2970 3042 REAL(dp), INTENT(IN) :: dd_lat1 3043 CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_pos 2971 3044 REAL(dp), INTENT(IN), OPTIONAL :: dd_fill 2972 3045 … … 3147 3220 & dl_lon1, dd_lat1 ) 3148 3221 3222 IF( PRESENT(cd_pos) )THEN 3223 ! 3224 SELECT CASE(TRIM(cd_pos)) 3225 CASE('le') 3226 WHERE( dd_lat0(il_iinf:il_isup,il_jinf:il_jsup) > dd_lat1 ) 3227 dl_dist(:,:)=NF90_FILL_DOUBLE 3228 END WHERE 3229 CASE('ri') 3230 WHERE( dd_lat0(il_iinf:il_isup,il_jinf:il_jsup) < dd_lat1 ) 3231 dl_dist(:,:)=NF90_FILL_DOUBLE 3232 END WHERE 3233 CASE('up') 3234 WHERE( dl_lon0(il_iinf:il_isup,il_jinf:il_jsup) < dl_lon1 ) 3235 dl_dist(:,:)=NF90_FILL_DOUBLE 3236 END WHERE 3237 CASE('lo') 3238 WHERE( dl_lon0(il_iinf:il_isup,il_jinf:il_jsup) > dl_lon1 ) 3239 dl_dist(:,:)=NF90_FILL_DOUBLE 3240 END WHERE 3241 CASE('ll') 3242 WHERE( dl_lon0(il_iinf:il_isup,il_jinf:il_jsup) > dl_lon1 .OR. & 3243 & dd_lat0(il_iinf:il_isup,il_jinf:il_jsup) > dd_lat1 ) 3244 dl_dist(:,:)=NF90_FILL_DOUBLE 3245 END WHERE 3246 CASE('lr') 3247 WHERE( dl_lon0(il_iinf:il_isup,il_jinf:il_jsup) < dl_lon1 .OR. & 3248 & dd_lat0(il_iinf:il_isup,il_jinf:il_jsup) > dd_lat1 ) 3249 dl_dist(:,:)=NF90_FILL_DOUBLE 3250 END WHERE 3251 CASE('ul') 3252 WHERE( dl_lon0(il_iinf:il_isup,il_jinf:il_jsup) > dl_lon1 .OR. & 3253 & dd_lat0(il_iinf:il_isup,il_jinf:il_jsup) < dd_lat1 ) 3254 dl_dist(:,:)=NF90_FILL_DOUBLE 3255 END WHERE 3256 CASE('ur') 3257 WHERE( dl_lon0(il_iinf:il_isup,il_jinf:il_jsup) < dl_lon1 .OR. & 3258 & dd_lat0(il_iinf:il_isup,il_jinf:il_jsup) < dd_lat1 ) 3259 dl_dist(:,:)=NF90_FILL_DOUBLE 3260 END WHERE 3261 END SELECT 3262 ENDIF 3149 3263 grid_get_closest(:)=MINLOC(dl_dist(:,:),dl_dist(:,:)/=NF90_FILL_DOUBLE) 3150 3264 … … 3443 3557 & il_imax0, il_jmax0, & 3444 3558 & dl_lon1(:,:), dl_lat1(:,:),& 3445 & id_rho(:) )3559 & id_rho(:), cl_point ) 3446 3560 3447 3561 DEALLOCATE(dl_lon0, dl_lat0) … … 3588 3702 & id_imax0, id_jmax0, & 3589 3703 & dl_lon1(:,:), dl_lat1(:,:),& 3590 & id_rho(:) )3704 & id_rho(:), cl_point ) 3591 3705 3592 3706 DEALLOCATE(dl_lon1, dl_lat1) … … 3668 3782 ! init 3669 3783 grid__get_fine_offset_fc(:,:)=-1 3670 3671 3784 ALLOCATE(il_rho(ip_maxdim)) 3672 3785 il_rho(:)=1 … … 3690 3803 CALL iom_mpp_open(tl_coord0) 3691 3804 3692 ! read coarse longitu e and latitude3805 ! read coarse longitude and latitude 3693 3806 WRITE(cl_name,*) 'longitude_'//TRIM(cl_point) 3694 3807 il_ind=var_get_id(tl_coord0%t_proc(1)%t_var(:), cl_name) … … 3710 3823 ENDIF 3711 3824 tl_lat0=iom_mpp_read_var(tl_coord0, TRIM(cl_name)) 3712 3825 3713 3826 ! close mpp files 3714 3827 CALL iom_mpp_close(tl_coord0) … … 3716 3829 CALL grid_del_ghost(tl_lon0, il_xghost0(:,:)) 3717 3830 CALL grid_del_ghost(tl_lat0, il_xghost0(:,:)) 3831 3718 3832 3719 3833 ALLOCATE(dl_lon0(tl_lon0%t_dim(jp_I)%i_len, & … … 3738 3852 il_jmax0=id_jmax0-il_xghost0(jp_J,1) 3739 3853 3740 3741 3854 !3- compute 3742 3855 grid__get_fine_offset_fc(:,:)=grid_get_fine_offset(& … … 3745 3858 & il_imax0, il_jmax0, & 3746 3859 & dd_lon1(:,:), dd_lat1(:,:),& 3747 & id_rho(:) )3860 & id_rho(:), cl_point ) 3748 3861 3749 3862 DEALLOCATE(dl_lon0, dl_lat0) … … 3767 3880 !> @date May, 2015 3768 3881 !> - improve way to find offset 3882 !> @date July, 2015 3883 !> - manage case close to greenwich meridian 3884 !> @date February, 2016 3885 !> - use grid_get_closest to assess offset 3886 !> - use delta (lon or lat) 3887 !> - manage cases for T,U,V or F point, with even or odd refinment 3888 !> - check lower left(upper right) fine grid point inside lower left(upper 3889 !> right) coarse grid cell. 3890 !> 3891 !> @todo check case close from North fold. 3769 3892 !> 3770 3893 !> @param[in] dd_lon0 coarse grid longitude array … … 3777 3900 !> @param[in] dd_lat1 fine grid latitude array 3778 3901 !> @param[in] id_rho array of refinement factor 3902 !> @param[in] cd_point Arakawa grid point 3779 3903 !> @return offset array (/ (/i_offset_left,i_offset_right/),(/j_offset_lower,j_offset_upper/) /) 3780 3904 !------------------------------------------------------------------- 3781 3905 FUNCTION grid__get_fine_offset_cc( dd_lon0, dd_lat0, & 3782 3906 & id_imin0, id_jmin0, id_imax0, id_jmax0, & 3783 & dd_lon1, dd_lat1, id_rho )3907 & dd_lon1, dd_lat1, id_rho, cd_point ) 3784 3908 IMPLICIT NONE 3785 3909 ! Argument 3786 REAL(dp) , DIMENSION(:,:), INTENT(IN) :: dd_lon0 3787 REAL(dp) , DIMENSION(:,:), INTENT(IN) :: dd_lat0 3788 REAL(dp) , DIMENSION(:,:), INTENT(IN) :: dd_lon1 3789 REAL(dp) , DIMENSION(:,:), INTENT(IN) :: dd_lat1 3790 3791 INTEGER(i4), INTENT(IN) :: id_imin0 3792 INTEGER(i4), INTENT(IN) :: id_jmin0 3793 INTEGER(i4), INTENT(IN) :: id_imax0 3794 INTEGER(i4), INTENT(IN) :: id_jmax0 3795 3796 INTEGER(i4), DIMENSION(:) , INTENT(IN) :: id_rho 3910 REAL(dp) , DIMENSION(:,:), INTENT(IN) :: dd_lon0 3911 REAL(dp) , DIMENSION(:,:), INTENT(IN) :: dd_lat0 3912 REAL(dp) , DIMENSION(:,:), INTENT(IN) :: dd_lon1 3913 REAL(dp) , DIMENSION(:,:), INTENT(IN) :: dd_lat1 3914 3915 INTEGER(i4) , INTENT(IN) :: id_imin0 3916 INTEGER(i4) , INTENT(IN) :: id_jmin0 3917 INTEGER(i4) , INTENT(IN) :: id_imax0 3918 INTEGER(i4) , INTENT(IN) :: id_jmax0 3919 3920 INTEGER(i4) , DIMENSION(:) , INTENT(IN) :: id_rho 3921 CHARACTER(LEN=*) , INTENT(IN), OPTIONAL :: cd_point 3797 3922 3798 3923 ! function … … 3800 3925 3801 3926 ! local variable 3927 CHARACTER(LEN= 1) :: cl_point 3928 3929 INTEGER(i4) :: i1 3930 INTEGER(i4) :: i2 3931 INTEGER(i4) :: j1 3932 INTEGER(i4) :: j2 3933 3802 3934 INTEGER(i4), DIMENSION(2) :: il_shape0 3803 3935 INTEGER(i4), DIMENSION(2) :: il_shape1 3804 3936 3937 INTEGER(i4), DIMENSION(2) :: il_ind 3938 3805 3939 REAL(dp) , DIMENSION(:,:), ALLOCATABLE :: dl_lon0 3806 3940 REAL(dp) , DIMENSION(:,:), ALLOCATABLE :: dl_lon1 3807 3941 3808 LOGICAL :: ll_ii 3809 LOGICAL :: ll_ij 3942 REAL(dp) :: dl_lonmax0 3943 REAL(dp) :: dl_latmax0 3944 REAL(dp) :: dl_lonmin0 3945 REAL(dp) :: dl_latmin0 3946 3947 REAL(dp) :: dl_lon0F 3948 REAL(dp) :: dl_lat0F 3949 REAL(dp) :: dl_dlon 3950 REAL(dp) :: dl_dlat 3951 3952 LOGICAL , DIMENSION(2) :: ll_even 3953 LOGICAL :: ll_greenwich 3810 3954 3811 3955 ! loop indices 3812 INTEGER(i4) :: ji3813 INTEGER(i4) :: jj3814 3815 3956 INTEGER(i4) :: ii 3816 3957 INTEGER(i4) :: ij … … 3824 3965 CALL logger_fatal("GRID GET FINE OFFSET: dimension of fine "//& 3825 3966 & "longitude and latitude differ") 3826 ENDIF 3967 ENDIF 3968 3969 ll_even(:)=(/ (MOD(id_rho(jp_I),2)==0), (MOD(id_rho(jp_J),2)==0) /) 3970 3971 cl_point='T' 3972 IF( PRESENT(cd_point) ) cl_point=TRIM(fct_upper(cd_point)) 3827 3973 3828 3974 il_shape0(:)=SHAPE(dd_lon0(:,:)) 3829 3975 ALLOCATE( dl_lon0(il_shape0(1),il_shape0(2)) ) 3830 3976 3977 il_shape1(:)=SHAPE(dd_lon1(:,:)) 3978 ALLOCATE( dl_lon1(il_shape1(1),il_shape1(2)) ) 3979 3831 3980 dl_lon0(:,:)=dd_lon0(:,:) 3832 3981 WHERE( dd_lon0(:,:) < 0 ) dl_lon0(:,:)=dd_lon0(:,:)+360. 3833 3982 3834 il_shape1(:)=SHAPE(dd_lon1(:,:))3835 ALLOCATE( dl_lon1(il_shape1(1),il_shape1(2)) )3836 3837 3983 dl_lon1(:,:)=dd_lon1(:,:) 3838 WHERE( dd_lon1(:,:) < 0 ) dl_lon1(:,:)=dd_lon1(:,:)+360. 3984 WHERE( dd_lon1(:,:) < 0 ) dl_lon1(:,:)=dd_lon1(:,:)+360. 3839 3985 3840 3986 ! init 3841 3987 grid__get_fine_offset_cc(:,:)=-1 3988 ll_greenwich=.FALSE. 3842 3989 3843 3990 IF( il_shape1(jp_J) == 1 )THEN 3844 3991 3845 3992 grid__get_fine_offset_cc(jp_J,:)=((id_rho(jp_J)-1)/2) 3846 3993 3847 ! work on i-direction 3848 ! look for i-direction left offset 3849 IF( dl_lon1(1,1) < dl_lon0(id_imin0+1,id_jmin0) )THEN 3850 DO ji=1,id_rho(jp_I)+2 3851 IF( dl_lon1(ji,1) > dl_lon0(id_imin0+1,id_jmin0) - dp_delta )THEN 3852 grid__get_fine_offset_cc(jp_I,1)=(id_rho(jp_I)+1)-ji 3853 EXIT 3854 ENDIF 3855 ENDDO 3994 !!! work on i-direction 3995 !!! look for i-direction left offset 3996 i1=1 ; i2=MIN((id_rho(jp_I)+2),il_shape1(jp_I)) 3997 j1=1 ; j2=1 3998 3999 ! check if cross greenwich meridien 4000 IF( minval(dl_lon0(id_imin0:id_imin0+1,id_jmin0))<5. .OR. & 4001 & maxval(dl_lon0(id_imin0:id_imin0+1,id_jmin0))>355. )THEN 4002 ! close to greenwich meridien 4003 ll_greenwich=.TRUE. 4004 ! 0:360 => -180:180 4005 WHERE( dl_lon0(id_imin0:id_imin0+1,id_jmin0) > 180. ) 4006 dl_lon0(id_imin0:id_imin0+1,id_jmin0) = & 4007 & dl_lon0(id_imin0:id_imin0+1,id_jmin0)-360. 4008 END WHERE 4009 4010 WHERE( dl_lon1(i1:i2,j1:j2) > 180. ) 4011 dl_lon1(i1:i2,j1:j2)=dl_lon1(i1:i2,j1:j2)-360. 4012 END WHERE 4013 ENDIF 4014 4015 ! max lognitude of the left cell 4016 dl_lonmax0=dl_lon0(id_imin0+1,id_jmin0) 4017 IF( dl_lon1(1,1) < dl_lonmax0 )THEN 4018 4019 !!!!! i-direction !!!!! 4020 IF( ll_even(jp_I) )THEN 4021 ! even 4022 SELECT CASE(TRIM(cl_point)) 4023 CASE('F','U') 4024 dl_dlon= ( dl_lon0(id_imin0+1,id_jmin0) - & 4025 & dl_lon0(id_imin0 ,id_jmin0) ) / & 4026 & ( 2.*id_rho(jp_I) ) 4027 CASE DEFAULT 4028 dl_dlon=0 4029 END SELECT 4030 ELSE 4031 ! odd 4032 dl_dlon= ( dl_lon0(id_imin0+1,id_jmin0) - & 4033 & dl_lon0(id_imin0 ,id_jmin0) ) / & 4034 & ( 2.*id_rho(jp_I) ) 4035 ENDIF 4036 4037 dl_lon0F= dl_lon0(id_imin0+1,id_jmin0) + dl_dlon 4038 dl_lat0F= dd_lat0(id_imin0+1,id_jmin0) 4039 4040 il_ind(:)=grid_get_closest( dl_lon1(i1:i2,j1:j2), dd_lat1(i1:i2,j1:j2), & 4041 & dl_lon0F, dl_lat0F, 'le' ) 4042 4043 ii=il_ind(1) 4044 4045 !!!!! i-direction !!!!! 4046 IF( ll_even(jp_I) )THEN 4047 ! even 4048 SELECT CASE(TRIM(cl_point)) 4049 CASE('T','V') 4050 grid__get_fine_offset_cc(jp_I,1)=id_rho(jp_I)-ii 4051 CASE DEFAULT !'F','U' 4052 grid__get_fine_offset_cc(jp_I,1)=(id_rho(jp_I)+1)-ii 4053 END SELECT 4054 ELSE 4055 ! odd 4056 grid__get_fine_offset_cc(jp_I,1)=(id_rho(jp_I)+1)-ii 4057 ENDIF 4058 3856 4059 ELSE 3857 4060 CALL logger_error("GRID GET FINE OFFSET: coarse grid indices do "//& 3858 & " not match fine grid lower left corner.") 3859 ENDIF 3860 ! look for i-direction right offset 3861 IF( dl_lon1(il_shape1(jp_I),1) > dl_lon0(id_imax0-1,id_jmin0) )THEN 3862 DO ji=1,id_rho(jp_I)+2 3863 ii=il_shape1(jp_I)-ji+1 3864 IF( dl_lon1(ii,1) < dl_lon0(id_imax0-1,id_jmin0) + dp_delta )THEN 3865 grid__get_fine_offset_cc(jp_I,2)=(id_rho(jp_I)+1)-ji 3866 EXIT 3867 ENDIF 3868 ENDDO 4061 & " not match fine grid left corner.") 4062 ENDIF 4063 4064 IF( ll_greenwich )THEN 4065 ! close to greenwich meridien 4066 ll_greenwich=.FALSE. 4067 ! -180:180 => 0:360 4068 WHERE( dl_lon0(id_imin0:id_imin0+1,id_jmin0) < 0. ) 4069 dl_lon0(id_imin0:id_imin0+1,id_jmin0) = & 4070 & dl_lon0(id_imin0:id_imin0+1,id_jmin0)+360. 4071 END WHERE 4072 4073 WHERE( dl_lon1(i1:i2,j1:j2) < 0. ) 4074 dl_lon1(i1:i2,j1:j2)=dl_lon1(i1:i2,j1:j2)+360. 4075 END WHERE 4076 ENDIF 4077 4078 !!!!!! look for i-direction right offset !!!!!! 4079 i1=MAX(1,il_shape1(jp_I)-(id_rho(jp_I)+2)+1) ; i2=il_shape1(jp_I) 4080 j1=1 ; j2=1 4081 4082 ! check if cross greenwich meridien 4083 IF( minval(dl_lon0(id_imax0-1:id_imax0,id_jmin0))<5. .OR. & 4084 & maxval(dl_lon0(id_imax0-1:id_imax0,id_jmin0))>355. )THEN 4085 ! close to greenwich meridien 4086 ll_greenwich=.TRUE. 4087 ! 0:360 => -180:180 4088 WHERE( dl_lon0(id_imax0-1:id_imax0,id_jmin0) > 180. ) 4089 dl_lon0(id_imax0-1:id_imax0,id_jmin0) = & 4090 & dl_lon0(id_imax0-1:id_imax0,id_jmin0)-360. 4091 END WHERE 4092 4093 WHERE( dl_lon1(i1:i2,j1:j2) > 180. ) 4094 dl_lon1(i1:i2,j1:j2)=dl_lon1(i1:i2,j1:j2)-360. 4095 END WHERE 4096 ENDIF 4097 4098 ! min lognitude of the right cell 4099 dl_lonmin0=dl_lon0(id_imax0-1,id_jmin0) 4100 IF( dl_lon1(il_shape1(jp_I),il_shape1(jp_J)) > dl_lonmin0 )THEN 4101 4102 !!!!! i-direction !!!!! 4103 IF( ll_even(jp_I) )THEN 4104 ! even 4105 SELECT CASE(TRIM(cl_point)) 4106 CASE('F','U') 4107 dl_dlon= ( dl_lon0(id_imax0 ,id_jmin0) - & 4108 & dl_lon0(id_imax0-1,id_jmin0) ) / & 4109 & ( 2.*id_rho(jp_I) ) 4110 CASE DEFAULT 4111 dl_dlon=0 4112 END SELECT 4113 ELSE 4114 ! odd 4115 dl_dlon= ( dl_lon0(id_imax0 ,id_jmin0) - & 4116 & dl_lon0(id_imax0-1,id_jmin0) ) / & 4117 & ( 2.*id_rho(jp_I) ) 4118 ENDIF 4119 4120 dl_lon0F= dl_lon0(id_imax0-1,id_jmin0) - dl_dlon 4121 dl_lat0F= dd_lat0(id_imax0-1,id_jmin0) 4122 4123 il_ind(:)=grid_get_closest( dl_lon1(i1:i2,j1:j2), dd_lat1(i1:i2,j1:j2), & 4124 & dl_lon0F, dl_lat0F, 'ri' ) 4125 4126 ii=(MIN(il_shape1(jp_I),(id_rho(jp_I)+2))-il_ind(1)+1) 4127 4128 !!!!! i-direction !!!!! 4129 IF( ll_even(jp_I) )THEN 4130 ! even 4131 SELECT CASE(TRIM(cl_point)) 4132 CASE('T','V') 4133 grid__get_fine_offset_cc(jp_I,2)=id_rho(jp_I)-ii 4134 CASE DEFAULT !'F','U' 4135 grid__get_fine_offset_cc(jp_I,2)=(id_rho(jp_I)+1)-ii 4136 END SELECT 4137 ELSE 4138 ! odd 4139 grid__get_fine_offset_cc(jp_I,2)=(id_rho(jp_I)+1)-ii 4140 ENDIF 4141 3869 4142 ELSE 3870 4143 CALL logger_error("GRID GET FINE OFFSET: coarse grid indices do "//& 3871 & " not match fine grid lower right corner.") 4144 & " not match fine grid right corner.") 4145 ENDIF 4146 4147 IF( ll_greenwich )THEN 4148 ! close to greenwich meridien 4149 ll_greenwich=.FALSE. 4150 ! -180:180 => 0:360 4151 WHERE( dl_lon0(id_imax0-1:id_imax0,id_jmin0) < 0. ) 4152 dl_lon0(id_imax0-1:id_imax0,id_jmin0) = & 4153 & dl_lon0(id_imax0-1:id_imax0,id_jmin0)+360. 4154 END WHERE 4155 4156 WHERE( dl_lon1(i1:i2,j1:j2) < 0. ) 4157 dl_lon1(i1:i2,j1:j2)=dl_lon1(i1:i2,j1:j2)+360. 4158 END WHERE 3872 4159 ENDIF 3873 4160 … … 3876 4163 grid__get_fine_offset_cc(jp_I,:)=((id_rho(jp_I)-1)/2) 3877 4164 3878 ! work on j-direction 3879 3880 ! look for j-direction lower offset 3881 IF( dd_lat1(1,1) < dd_lat0(id_imin0,id_jmin0+1) )THEN 3882 DO jj=1,id_rho(jp_J)+2 3883 IF( dd_lat1(1,jj) > dd_lat0(id_imin0,id_jmin0+1) - dp_delta )THEN 3884 grid__get_fine_offset_cc(jp_J,1)=(id_rho(jp_J)+1)-jj 3885 EXIT 3886 ENDIF 3887 ENDDO 4165 !!! work on j-direction 4166 !!! look for j-direction lower offset 4167 i1=1 ; i2=1 4168 j1=1 ; j2=MIN((id_rho(jp_J)+2),il_shape1(jp_J)) 4169 4170 4171 ! max latitude of the lower cell 4172 dl_latmax0=dd_lat0(id_imin0,id_jmin0+1) 4173 IF( dd_lat1(1,1) < dl_latmax0 )THEN 4174 4175 IF( ll_even(jp_J) )THEN 4176 ! even 4177 SELECT CASE(TRIM(cl_point)) 4178 CASE('F','V') 4179 dl_dlat= ( dd_lat0(id_imin0,id_jmin0+1) - & 4180 & dd_lat0(id_imin0,id_jmin0 ) ) / & 4181 & ( 2.*id_rho(jp_J) ) 4182 CASE DEFAULT 4183 dl_dlat=0 4184 END SELECT 4185 ELSE 4186 ! odd 4187 dl_dlat= ( dd_lat0(id_imin0,id_jmin0+1) - & 4188 & dd_lat0(id_imin0,id_jmin0 ) ) / & 4189 & ( 2.*id_rho(jp_J) ) 4190 ENDIF 4191 4192 dl_lon0F= dl_lon0(id_imin0,id_jmin0+1) 4193 dl_lat0F= dd_lat0(id_imin0,id_jmin0+1) + dl_dlat 4194 4195 il_ind(:)=grid_get_closest( dl_lon1(i1:i2,j1:j2), dd_lat1(i1:i2,j1:j2), & 4196 & dl_lon0F, dl_lat0F, 'lo' ) 4197 4198 ij=il_ind(2) 4199 4200 !!!!! i-direction !!!!! 4201 IF( ll_even(jp_I) )THEN 4202 ! even 4203 SELECT CASE(TRIM(cl_point)) 4204 CASE('T','V') 4205 grid__get_fine_offset_cc(jp_I,1)=id_rho(jp_I)-ii 4206 CASE DEFAULT !'F','U' 4207 grid__get_fine_offset_cc(jp_I,1)=(id_rho(jp_I)+1)-ii 4208 END SELECT 4209 ELSE 4210 ! odd 4211 grid__get_fine_offset_cc(jp_I,1)=(id_rho(jp_I)+1)-ii 4212 ENDIF 4213 3888 4214 ELSE 3889 4215 CALL logger_error("GRID GET FINE OFFSET: coarse grid indices do "//& 3890 & " not match fine grid upper left corner.") 3891 ENDIF 3892 3893 ! look for j-direction upper offset 3894 IF( dd_lat1(1,il_shape1(jp_J)) > dd_lat0(id_imin0,id_jmax0-1) )THEN 3895 DO jj=1,id_rho(jp_J)+2 3896 ij=il_shape1(jp_J)-jj+1 3897 IF( dd_lat1(1,ij) < dd_lat0(id_imin0,id_jmax0-1) + dp_delta )THEN 3898 grid__get_fine_offset_cc(jp_J,2)=(id_rho(jp_J)+1)-jj 3899 EXIT 3900 ENDIF 3901 ENDDO 4216 & " not match fine grid lower corner.") 4217 ENDIF 4218 4219 !!! look for j-direction upper offset 4220 i1=1 ; i2=1 4221 j1=MAX(1,il_shape1(jp_J)-(id_rho(jp_J)+2)+1) ; j2=il_shape1(jp_J) 4222 4223 ! min latitude of the upper cell 4224 dl_latmin0=dd_lat0(id_imin0,id_jmax0-1) 4225 IF( dd_lat1(il_shape1(jp_I),il_shape1(jp_J)) > dl_latmin0 )THEN 4226 4227 IF( ll_even(jp_J) )THEN 4228 ! even 4229 SELECT CASE(TRIM(cl_point)) 4230 CASE('F','V') 4231 dl_dlat= ( dd_lat0(id_imin0,id_jmax0 ) - & 4232 & dd_lat0(id_imin0,id_jmax0-1) ) / & 4233 & ( 2.*id_rho(jp_J) ) 4234 CASE DEFAULT 4235 dl_dlat=0 4236 END SELECT 4237 ELSE 4238 ! odd 4239 dl_dlat= ( dd_lat0(id_imin0,id_jmax0 ) - & 4240 & dd_lat0(id_imin0,id_jmax0-1) ) / & 4241 & ( 2*id_rho(jp_J) ) 4242 ENDIF 4243 4244 dl_lon0F= dl_lon0(id_imin0,id_jmax0-1) 4245 dl_lat0F= dd_lat0(id_imin0,id_jmax0-1) - dl_dlat 4246 4247 il_ind(:)=grid_get_closest( dl_lon1(i1:i2,j1:j2), dd_lat1(i1:i2,j1:j2), & 4248 & dl_lon0F, dl_lat0F, 'up' ) 4249 4250 ij=(MIN(il_shape1(jp_J),(id_rho(jp_J)+2))-il_ind(2)+1) 4251 4252 !!!!! j-direction !!!!! 4253 IF( ll_even(jp_J) )THEN 4254 ! even 4255 SELECT CASE(TRIM(cl_point)) 4256 CASE('T','U') 4257 grid__get_fine_offset_cc(jp_J,2)=id_rho(jp_J)-ij 4258 CASE DEFAULT !'F','V' 4259 grid__get_fine_offset_cc(jp_J,2)=(id_rho(jp_J)+1)-ij 4260 END SELECT 4261 ELSE 4262 ! odd 4263 grid__get_fine_offset_cc(jp_J,2)=(id_rho(jp_J)+1)-ij 4264 ENDIF 4265 3902 4266 ELSE 3903 4267 CALL logger_error("GRID GET FINE OFFSET: coarse grid indices do "//& 4268 & " not match fine grid upper corner.") 4269 ENDIF 4270 4271 ELSE ! il_shape1(1) > 1 .AND. il_shape1(2) > 1 4272 4273 !!!!!! look for lower left offset !!!!!! 4274 i1=1 ; i2=MIN((id_rho(jp_I)+2),il_shape1(jp_I)) 4275 j1=1 ; j2=MIN((id_rho(jp_J)+2),il_shape1(jp_J)) 4276 4277 ! check if cross greenwich meridien 4278 IF( minval(dl_lon0(id_imin0:id_imin0+1,id_jmin0:id_jmin0+1))<5. .OR. & 4279 & maxval(dl_lon0(id_imin0:id_imin0+1,id_jmin0:id_jmin0+1))>355. )THEN 4280 ! close to greenwich meridien 4281 ll_greenwich=.TRUE. 4282 ! 0:360 => -180:180 4283 WHERE( dl_lon0(id_imin0:id_imin0+1,id_jmin0:id_jmin0+1) > 180. ) 4284 dl_lon0(id_imin0:id_imin0+1,id_jmin0:id_jmin0+1) = & 4285 & dl_lon0(id_imin0:id_imin0+1,id_jmin0:id_jmin0+1)-360. 4286 END WHERE 4287 4288 WHERE( dl_lon1(i1:i2,j1:j2) > 180. ) 4289 dl_lon1(i1:i2,j1:j2)=dl_lon1(i1:i2,j1:j2)-360. 4290 END WHERE 4291 ENDIF 4292 4293 ! max longitude of the lower left cell 4294 dl_lonmax0=MAX(dl_lon0(id_imin0+1,id_jmin0),dl_lon0(id_imin0+1,id_jmin0+1)) 4295 ! max latitude of the lower left cell 4296 dl_latmax0=MAX(dd_lat0(id_imin0,id_jmin0+1),dd_lat0(id_imin0+1,id_jmin0+1)) 4297 IF( dl_lon1(1,1) < dl_lonmax0 .AND. & 4298 & dd_lat1(1,1) < dl_latmax0 )THEN 4299 4300 !!!!! i-direction !!!!! 4301 IF( ll_even(jp_I) )THEN 4302 ! even 4303 SELECT CASE(TRIM(cl_point)) 4304 CASE('F','U') 4305 dl_dlon= ( dl_lon0(id_imin0+1,id_jmin0+1) - & 4306 & dl_lon0(id_imin0 ,id_jmin0+1) ) / & 4307 & ( 2.*id_rho(jp_I) ) 4308 CASE DEFAULT 4309 dl_dlon=0 4310 END SELECT 4311 ELSE 4312 ! odd 4313 dl_dlon= ( dl_lon0(id_imin0+1,id_jmin0+1) - & 4314 & dl_lon0(id_imin0 ,id_jmin0+1) ) / & 4315 & ( 2.*id_rho(jp_I) ) 4316 ENDIF 4317 4318 !!!!! j-direction !!!!! 4319 IF( ll_even(jp_J) )THEN 4320 ! even 4321 SELECT CASE(TRIM(cl_point)) 4322 CASE('F','V') 4323 dl_dlat= ( dd_lat0(id_imin0+1,id_jmin0+1) - & 4324 & dd_lat0(id_imin0+1,id_jmin0 ) ) / & 4325 & ( 2.*id_rho(jp_J) ) 4326 CASE DEFAULT 4327 dl_dlat=0 4328 END SELECT 4329 ELSE 4330 ! odd 4331 dl_dlat= ( dd_lat0(id_imin0+1,id_jmin0+1) - & 4332 & dd_lat0(id_imin0+1,id_jmin0 ) ) / & 4333 & ( 2.*id_rho(jp_J) ) 4334 ENDIF 4335 4336 dl_lon0F= dl_lon0(id_imin0+1,id_jmin0+1) + dl_dlon 4337 dl_lat0F= dd_lat0(id_imin0+1,id_jmin0+1) + dl_dlat 4338 4339 il_ind(:)=grid_get_closest( dl_lon1(i1:i2,j1:j2), dd_lat1(i1:i2,j1:j2), & 4340 & dl_lon0F, dl_lat0F, 'll' ) 4341 4342 ii=il_ind(1) 4343 ij=il_ind(2) 4344 4345 !!!!! i-direction !!!!! 4346 IF( ll_even(jp_I) )THEN 4347 ! even 4348 SELECT CASE(TRIM(cl_point)) 4349 CASE('T','V') 4350 grid__get_fine_offset_cc(jp_I,1)=id_rho(jp_I)-ii 4351 CASE DEFAULT !'F','U' 4352 grid__get_fine_offset_cc(jp_I,1)=(id_rho(jp_I)+1)-ii 4353 END SELECT 4354 ELSE 4355 ! odd 4356 grid__get_fine_offset_cc(jp_I,1)=(id_rho(jp_I)+1)-ii 4357 ENDIF 4358 4359 !!!!! j-direction !!!!! 4360 IF( ll_even(jp_J) )THEN 4361 ! even 4362 SELECT CASE(TRIM(cl_point)) 4363 CASE('T','U') 4364 grid__get_fine_offset_cc(jp_J,1)=id_rho(jp_J)-ij 4365 CASE DEFAULT !'F','V' 4366 grid__get_fine_offset_cc(jp_J,1)=(id_rho(jp_J)+1)-ij 4367 END SELECT 4368 ELSE 4369 ! odd 4370 grid__get_fine_offset_cc(jp_J,1)=(id_rho(jp_J)+1)-ij 4371 ENDIF 4372 4373 ELSE 4374 CALL logger_error("GRID GET FINE OFFSET: coarse grid indices do"//& 4375 & " not match fine grid lower left corner.") 4376 ENDIF 4377 4378 IF( ll_greenwich )THEN 4379 ! close to greenwich meridien 4380 ll_greenwich=.FALSE. 4381 ! -180:180 => 0:360 4382 WHERE( dl_lon0(id_imin0:id_imin0+1,id_jmin0:id_jmin0+1) < 0. ) 4383 dl_lon0(id_imin0:id_imin0+1,id_jmin0:id_jmin0+1) = & 4384 & dl_lon0(id_imin0:id_imin0+1,id_jmin0:id_jmin0+1)+360. 4385 END WHERE 4386 4387 WHERE( dl_lon1(i1:i2,j1:j2) < 0. ) 4388 dl_lon1(i1:i2,j1:j2)=dl_lon1(i1:i2,j1:j2)+360. 4389 END WHERE 4390 ENDIF 4391 4392 !!!!!! look for upper right offset !!!!!! 4393 i1=MAX(1,il_shape1(jp_I)-(id_rho(jp_I)+2)+1) ; i2=il_shape1(jp_I) 4394 j1=MAX(1,il_shape1(jp_J)-(id_rho(jp_J)+2)+1) ; j2=il_shape1(jp_J) 4395 4396 ! check if cross greenwich meridien 4397 IF( minval(dl_lon0(id_imax0-1:id_imax0,id_jmax0-1:id_jmax0))<5. .OR. & 4398 & maxval(dl_lon0(id_imax0-1:id_imax0,id_jmax0-1:id_jmax0))>355. )THEN 4399 ! close to greenwich meridien 4400 ll_greenwich=.TRUE. 4401 ! 0:360 => -180:180 4402 WHERE( dl_lon0(id_imax0-1:id_imax0,id_jmax0-1:id_jmax0) > 180. ) 4403 dl_lon0(id_imax0-1:id_imax0,id_jmax0-1:id_jmax0) = & 4404 & dl_lon0(id_imax0-1:id_imax0,id_jmax0-1:id_jmax0)-360. 4405 END WHERE 4406 4407 WHERE( dl_lon1(i1:i2,j1:j2) > 180. ) 4408 dl_lon1(i1:i2,j1:j2)=dl_lon1(i1:i2,j1:j2)-360. 4409 END WHERE 4410 ENDIF 4411 4412 ! min latitude of the upper right cell 4413 dl_lonmin0=MIN(dl_lon0(id_imax0-1,id_jmax0-1),dl_lon0(id_imax0-1,id_jmax0)) 4414 ! min latitude of the upper right cell 4415 dl_latmin0=MIN(dd_lat0(id_imax0-1,id_jmax0-1),dd_lat0(id_imax0,id_jmax0-1)) 4416 IF( dl_lon1(il_shape1(jp_I),il_shape1(jp_J)) > dl_lonmin0 .AND. & 4417 & dd_lat1(il_shape1(jp_I),il_shape1(jp_J)) > dl_latmin0 )THEN 4418 4419 !!!!! i-direction !!!!! 4420 IF( ll_even(jp_I) )THEN 4421 ! even 4422 SELECT CASE(TRIM(cl_point)) 4423 CASE('F','U') 4424 dl_dlon= ( dl_lon0(id_imax0 ,id_jmax0-1) - & 4425 & dl_lon0(id_imax0-1,id_jmax0-1) ) / & 4426 & ( 2.*id_rho(jp_I) ) 4427 CASE DEFAULT 4428 dl_dlon=0 4429 END SELECT 4430 ELSE 4431 ! odd 4432 dl_dlon= ( dl_lon0(id_imax0 ,id_jmax0-1) - & 4433 & dl_lon0(id_imax0-1,id_jmax0-1) ) / & 4434 & ( 2*id_rho(jp_I) ) 4435 ENDIF 4436 4437 !!!!! j-direction !!!!! 4438 IF( ll_even(jp_J) )THEN 4439 ! even 4440 SELECT CASE(TRIM(cl_point)) 4441 CASE('F','V') 4442 dl_dlat= ( dd_lat0(id_imax0-1,id_jmax0 ) - & 4443 & dd_lat0(id_imax0-1,id_jmax0-1) ) / & 4444 & ( 2.*id_rho(jp_J) ) 4445 CASE DEFAULT 4446 dl_dlat=0 4447 END SELECT 4448 ELSE 4449 ! odd 4450 dl_dlat= ( dd_lat0(id_imax0-1,id_jmax0 ) - & 4451 & dd_lat0(id_imax0-1,id_jmax0-1) ) / & 4452 & ( 2*id_rho(jp_J) ) 4453 ENDIF 4454 4455 dl_lon0F= dl_lon0(id_imax0-1,id_jmax0-1) - dl_dlon 4456 dl_lat0F= dd_lat0(id_imax0-1,id_jmax0-1) - dl_dlat 4457 4458 il_ind(:)=grid_get_closest( dl_lon1(i1:i2,j1:j2), dd_lat1(i1:i2,j1:j2), & 4459 & dl_lon0F, dl_lat0F, 'ur' ) 4460 4461 ii=(MIN(il_shape1(jp_I),(id_rho(jp_I)+2))-il_ind(1)+1) 4462 ij=(MIN(il_shape1(jp_J),(id_rho(jp_J)+2))-il_ind(2)+1) 4463 4464 !!!!! i-direction !!!!! 4465 IF( ll_even(jp_I) )THEN 4466 ! even 4467 SELECT CASE(TRIM(cl_point)) 4468 CASE('T','V') 4469 grid__get_fine_offset_cc(jp_I,2)=id_rho(jp_I)-ii 4470 CASE DEFAULT !'F','U' 4471 grid__get_fine_offset_cc(jp_I,2)=(id_rho(jp_I)+1)-ii 4472 END SELECT 4473 ELSE 4474 ! odd 4475 grid__get_fine_offset_cc(jp_I,2)=(id_rho(jp_I)+1)-ii 4476 ENDIF 4477 4478 !!!!! j-direction !!!!! 4479 IF( ll_even(jp_J) )THEN 4480 ! even 4481 SELECT CASE(TRIM(cl_point)) 4482 CASE('T','U') 4483 grid__get_fine_offset_cc(jp_J,2)=id_rho(jp_J)-ij 4484 CASE DEFAULT !'F','V' 4485 grid__get_fine_offset_cc(jp_J,2)=(id_rho(jp_J)+1)-ij 4486 END SELECT 4487 ELSE 4488 ! odd 4489 grid__get_fine_offset_cc(jp_J,2)=(id_rho(jp_J)+1)-ij 4490 ENDIF 4491 4492 ELSE 4493 CALL logger_error("GRID GET FINE OFFSET: coarse grid indices do"//& 3904 4494 & " not match fine grid upper right corner.") 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.") 4495 ENDIF 4496 4497 IF( ll_greenwich )THEN 4498 ! close to greenwich meridien 4499 ll_greenwich=.FALSE. 4500 ! -180:180 => 0:360 4501 WHERE( dl_lon0(id_imax0-1:id_imax0,id_jmax0-1:id_jmax0) < 0. ) 4502 dl_lon0(id_imax0-1:id_imax0,id_jmax0-1:id_jmax0) = & 4503 & dl_lon0(id_imax0-1:id_imax0,id_jmax0-1:id_jmax0)+360. 4504 END WHERE 4505 4506 WHERE( dl_lon1(i1:i2,j1:j2) < 0. ) 4507 dl_lon1(i1:i2,j1:j2)=dl_lon1(i1:i2,j1:j2)+360. 4508 END WHERE 3980 4509 ENDIF 3981 4510 … … 3984 4513 DEALLOCATE( dl_lon0 ) 3985 4514 DEALLOCATE( dl_lon1 ) 4515 4516 IF( ANY(grid__get_fine_offset_cc(:,:)==-1) )THEN 4517 CALL logger_fatal("GRID GET FINE OFFSET: can not found "//& 4518 & " offset between coarse and fine grid.") 4519 ENDIF 3986 4520 3987 4521 END FUNCTION grid__get_fine_offset_cc … … 3995 4529 !> @date October, 2014 3996 4530 !> - work on mpp file structure instead of file structure 3997 ! 4531 !> @date February, 2016 4532 !> - use F-point to check coincidence for even refinment 4533 !> - use F-point estimation, if can not read it. 4534 !> 3998 4535 !> @param[in] td_coord0 coarse grid coordinate file structure 3999 4536 !> @param[in] td_coord1 fine grid coordinate file structure … … 4020 4557 4021 4558 ! local variable 4022 INTEGER(i4) :: il_imid14023 INTEGER(i4) :: il_jmid14559 INTEGER(i4) :: il_imid1 4560 INTEGER(i4) :: il_jmid1 4024 4561 4025 INTEGER(i4) :: il_ew0 4026 INTEGER(i4) :: il_ew1 4027 4028 INTEGER(i4) :: il_imin1 4029 INTEGER(i4) :: il_imax1 4030 INTEGER(i4) :: il_jmin1 4031 INTEGER(i4) :: il_jmax1 4032 4033 INTEGER(i4), DIMENSION(2) :: il_indC 4034 INTEGER(i4), DIMENSION(2) :: il_indF 4035 INTEGER(i4), DIMENSION(2) :: il_iind 4036 INTEGER(i4), DIMENSION(2) :: il_jind 4037 4038 REAL(dp) :: dl_lon0 4039 REAL(dp) :: dl_lat0 4040 REAL(dp) :: dl_lon1 4041 REAL(dp) :: dl_lat1 4042 4043 REAL(dp) :: dl_lon1p 4044 REAL(dp) :: dl_lat1p 4045 4046 LOGICAL :: ll_coincidence 4047 4048 TYPE(TVAR) :: tl_lon0 4049 TYPE(TVAR) :: tl_lat0 4050 TYPE(TVAR) :: tl_lon1 4051 TYPE(TVAR) :: tl_lat1 4052 4053 TYPE(TMPP) :: tl_coord0 4054 TYPE(TMPP) :: tl_coord1 4055 4056 TYPE(TDOM) :: tl_dom0 4562 INTEGER(i4) :: il_ew0 4563 INTEGER(i4) :: il_ew1 4564 4565 INTEGER(i4) :: il_ind 4566 4567 INTEGER(i4) :: il_imin1 4568 INTEGER(i4) :: il_imax1 4569 INTEGER(i4) :: il_jmin1 4570 INTEGER(i4) :: il_jmax1 4571 4572 INTEGER(i4), DIMENSION(2) :: il_ind0 4573 INTEGER(i4), DIMENSION(2) :: il_ind1 4574 4575 INTEGER(i4), DIMENSION(2) :: il_ill1 4576 INTEGER(i4), DIMENSION(2) :: il_ilr1 4577 INTEGER(i4), DIMENSION(2) :: il_iul1 4578 INTEGER(i4), DIMENSION(2) :: il_iur1 4579 4580 REAL(dp) :: dl_lon0F 4581 REAL(dp) :: dl_lat0F 4582 REAL(dp) :: dl_lon0 4583 REAL(dp) :: dl_lat0 4584 REAL(dp) :: dl_lon1F 4585 REAL(dp) :: dl_lat1F 4586 REAL(dp) :: dl_lon1 4587 REAL(dp) :: dl_lat1 4588 4589 REAL(dp) :: dl_delta 4590 4591 LOGICAL :: ll_coincidence 4592 LOGICAL :: ll_even 4593 LOGICAL :: ll_grid0F 4594 LOGICAL :: ll_grid1F 4595 4596 TYPE(TVAR) :: tl_lon0 4597 TYPE(TVAR) :: tl_lat0 4598 TYPE(TVAR) :: tl_lon0F 4599 TYPE(TVAR) :: tl_lat0F 4600 TYPE(TVAR) :: tl_lon1 4601 TYPE(TVAR) :: tl_lat1 4602 TYPE(TVAR) :: tl_lon1F 4603 TYPE(TVAR) :: tl_lat1F 4604 4605 TYPE(TMPP) :: tl_coord0 4606 TYPE(TMPP) :: tl_coord1 4607 4608 TYPE(TDOM) :: tl_dom0 4057 4609 4058 4610 ! loop indices … … 4063 4615 ll_coincidence=.TRUE. 4064 4616 4617 ll_even=.FALSE. 4618 IF( MOD(id_rho(jp_I)*id_rho(jp_J),2) == 0 )THEN 4619 ll_even=.TRUE. 4620 ENDIF 4621 4065 4622 ! copy structure 4066 4623 tl_coord0=mpp_copy(td_coord0) … … 4075 4632 4076 4633 ! read variable value on domain 4077 tl_lon0=iom_dom_read_var(tl_coord0,'longitude',tl_dom0) 4078 tl_lat0=iom_dom_read_var(tl_coord0,'latitude' ,tl_dom0) 4634 il_ind=var_get_index(tl_coord0%t_proc(1)%t_var(:), 'longitude_T') 4635 IF( il_ind /= 0 )THEN 4636 tl_lon0=iom_dom_read_var(tl_coord0,'longitude_T',tl_dom0) 4637 ELSE 4638 tl_lon0=iom_dom_read_var(tl_coord0,'longitude',tl_dom0) 4639 ENDIF 4640 4641 il_ind=var_get_index(tl_coord0%t_proc(1)%t_var(:), 'latitude_T') 4642 IF( il_ind /= 0 )THEN 4643 tl_lat0=iom_dom_read_var(tl_coord0,'latitude_T' ,tl_dom0) 4644 ELSE 4645 tl_lat0=iom_dom_read_var(tl_coord0,'latitude' ,tl_dom0) 4646 ENDIF 4647 4648 IF( ll_even )THEN 4649 ! look for variable value on domain for F point 4650 il_ind=var_get_index(tl_coord0%t_proc(1)%t_var(:), 'longitude_F') 4651 IF( il_ind /= 0 )THEN 4652 tl_lon0F=iom_dom_read_var(tl_coord0,'longitude_F',tl_dom0) 4653 ENDIF 4654 4655 il_ind=var_get_index(tl_coord0%t_proc(1)%t_var(:), 'latitude_F') 4656 IF( il_ind /= 0 )THEN 4657 tl_lat0F=iom_dom_read_var(tl_coord0,'latitude_F' ,tl_dom0) 4658 ENDIF 4659 4660 ll_grid0F=.FALSE. 4661 IF( ASSOCIATED(tl_lon0F%d_value) .AND. & 4662 & ASSOCIATED(tl_lat0F%d_value) )THEN 4663 ll_grid0F=.TRUE. 4664 ENDIF 4665 4666 ENDIF 4079 4667 4080 4668 ! close mpp files … … 4092 4680 4093 4681 ! read fine longitue and latitude 4094 tl_lon1=iom_mpp_read_var(tl_coord1,'longitude') 4095 tl_lat1=iom_mpp_read_var(tl_coord1,'latitude') 4682 il_ind=var_get_index(tl_coord1%t_proc(1)%t_var(:), TRIM(tl_lon0%c_longname)) 4683 IF( il_ind /= 0 )THEN 4684 tl_lon1=iom_mpp_read_var(tl_coord1,TRIM(tl_lon0%c_longname)) 4685 ELSE 4686 tl_lon1=iom_mpp_read_var(tl_coord1,'longitude') 4687 ENDIF 4688 il_ind=var_get_index(tl_coord1%t_proc(1)%t_var(:), TRIM(tl_lat0%c_longname)) 4689 IF( il_ind /= 0 )THEN 4690 tl_lat1=iom_mpp_read_var(tl_coord1,TRIM(tl_lat0%c_longname)) 4691 ELSE 4692 tl_lat1=iom_mpp_read_var(tl_coord1,'latitude') 4693 ENDIF 4096 4694 4695 IF( ll_even )THEN 4696 4697 ! look for variable value on domain for F point 4698 il_ind=var_get_index(tl_coord1%t_proc(1)%t_var(:), 'longitude_F') 4699 IF( il_ind /= 0 )THEN 4700 tl_lon1F=iom_mpp_read_var(tl_coord1,'longitude_F') 4701 ENDIF 4702 4703 il_ind=var_get_index(tl_coord1%t_proc(1)%t_var(:), 'latitude_F') 4704 IF( il_ind /= 0 )THEN 4705 tl_lat1F=iom_mpp_read_var(tl_coord1,'latitude_F') 4706 ENDIF 4707 4708 ll_grid1F=.FALSE. 4709 IF( ASSOCIATED(tl_lon1F%d_value) .AND. & 4710 & ASSOCIATED(tl_lat1F%d_value) )THEN 4711 ll_grid1F=.TRUE. 4712 ENDIF 4713 4714 ENDIF 4715 4097 4716 ! close mpp files 4098 CALL iom_ dom_close(tl_coord1)4717 CALL iom_mpp_close(tl_coord1) 4099 4718 ! clean structure 4100 4719 CALL mpp_clean(tl_coord1) … … 4158 4777 IF( .NOT. ll_coincidence )THEN 4159 4778 CALL logger_fatal("GRID CHECK COINCIDENCE: no coincidence "//& 4160 & "between fine grid and coarse grid . invalid domain" )4779 & "between fine grid and coarse grid: invalid domain." ) 4161 4780 ENDIF 4162 4781 … … 4172 4791 4173 4792 ! select closest point on coarse grid 4174 il_ind C(:)=grid_get_closest(tl_lon0%d_value(:,:,1,1),&4793 il_ind0(:)=grid_get_closest(tl_lon0%d_value(:,:,1,1),& 4175 4794 & tl_lat0%d_value(:,:,1,1),& 4176 4795 & dl_lon1, dl_lat1 ) 4177 4796 4178 IF( ANY(il_ind C(:)==0) )THEN4797 IF( ANY(il_ind0(:)==0) )THEN 4179 4798 CALL logger_fatal("GRID CHECK COINCIDENCE: can not find valid "//& 4180 & "coarse grid indices. invalid domain" ) 4181 ENDIF 4182 4183 dl_lon0=tl_lon0%d_value(il_indC(1),il_indC(2),1,1) 4184 dl_lat0=tl_lat0%d_value(il_indC(1),il_indC(2),1,1) 4185 4186 ! look for closest fine grid point from selected coarse grid point 4187 il_iind(:)=MAXLOC( tl_lon1%d_value(:,:,1,1), & 4188 & tl_lon1%d_value(:,:,1,1) <= dl_lon0 ) 4189 4190 il_jind(:)=MAXLOC( tl_lat1%d_value(:,:,1,1), & 4191 & tl_lat1%d_value(:,:,1,1) <= dl_lat0 ) 4192 4193 il_indF(1)=il_iind(1) 4194 il_indF(2)=il_jind(2) 4195 4196 IF( ANY(il_indF(:)==0) )THEN 4197 CALL logger_fatal("GRID CHECK COINCIDENCE: can not find valid "//& 4198 & "fine grid indices. invalid domain" ) 4199 ENDIF 4200 4201 dl_lon1=tl_lon1%d_value(il_indF(1),il_indF(2),1,1) 4202 dl_lat1=tl_lat1%d_value(il_indF(1),il_indF(2),1,1) 4203 4204 ! check i-direction refinement factor 4205 DO ji=1,MIN(3,il_imid1) 4206 4207 IF( il_indF(1)+ji*id_rho(jp_I)+1 > tl_lon1%t_dim(1)%i_len )THEN 4208 CALL logger_warn("GRID CHECK COINCIDENCE: domain to small "//& 4209 & " to check i-direction refinement factor ") 4210 EXIT 4211 ELSE 4212 dl_lon1=tl_lon1%d_value(il_indF(1)+ji*id_rho(jp_I),il_indF(2),1,1) 4213 dl_lon0=tl_lon0%d_value(il_indC(1)+ji,il_indC(2),1,1) 4214 4215 dl_lon1p=tl_lon1%d_value(il_indF(1)+ji*id_rho(jp_I)+1,il_indF(2),1,1) 4216 4217 SELECT CASE(MOD(id_rho(jp_I),2)) 4218 4219 CASE(0) 4220 4221 IF( dl_lon1 >= dl_lon0 .OR. dl_lon0 >= dl_lon1p )THEN 4222 ll_coincidence=.FALSE. 4223 CALL logger_debug("GRID CHECK COINCIDENCE: invalid "//& 4224 & "i-direction refinement factor ("//& 4225 & TRIM(fct_str(id_rho(jp_I)))//& 4226 & ") between fine grid and coarse grid ") 4227 ENDIF 4228 4229 CASE DEFAULT 4230 4799 & "coarse grid indices: invalid domain." ) 4800 ENDIF 4801 4802 IF( .NOT. ll_even )THEN 4803 ! case odd refinment in both direction 4804 ! work on T-point 4805 4806 dl_lon0=tl_lon0%d_value(il_ind0(1),il_ind0(2),1,1) 4807 dl_lat0=tl_lat0%d_value(il_ind0(1),il_ind0(2),1,1) 4808 4809 il_ind1(:)=grid_get_closest(tl_lon1%d_value(:,:,1,1),& 4810 & tl_lat1%d_value(:,:,1,1),& 4811 & dl_lon0, dl_lat0 ) 4812 4813 ! check i-direction refinement factor 4814 DO ji=0,MIN(3,il_imid1) 4815 4816 IF( il_ind1(1)+ji*id_rho(jp_I)+1 > tl_lon1%t_dim(1)%i_len )THEN 4817 CALL logger_warn("GRID CHECK COINCIDENCE: domain to small "//& 4818 & " to check i-direction refinement factor ") 4819 EXIT 4820 ELSE 4821 dl_lon0=tl_lon0%d_value(il_ind0(1)+ji ,il_ind0(2),1,1) 4822 dl_lon1=tl_lon1%d_value(il_ind1(1)+ji*id_rho(jp_I),il_ind1(2),1,1) 4823 4824 ! assume there could be little difference due to interpolation 4231 4825 IF( ABS(dl_lon1 - dl_lon0) > dp_delta )THEN 4232 4826 ll_coincidence=.FALSE. … … 4236 4830 & ") between fine grid and coarse grid ") 4237 4831 ENDIF 4238 4239 END SELECT 4240 ENDIF 4241 4242 ENDDO 4243 4244 ! check j-direction refinement factor 4245 DO jj=1,MIN(3,il_jmid1) 4246 4247 IF( il_indF(2)+jj*id_rho(jp_J)+1 > tl_lat1%t_dim(2)%i_len )THEN 4248 CALL logger_warn("GRID CHECK COINCIDENCE: domain to small "//& 4249 & " to check j-direction refinement factor ") 4250 EXIT 4251 ELSE 4252 dl_lat1=tl_lat1%d_value(il_indF(1),il_indF(2)+jj*id_rho(jp_J),1,1) 4253 dl_lat0=tl_lat0%d_value(il_indC(1),il_indC(2)+jj,1,1) 4254 4255 dl_lat1p=tl_lat1%d_value(il_indF(1),il_indF(2)+jj*id_rho(jp_J)+1,1,1) 4256 4257 SELECT CASE(MOD(id_rho(jp_J),2)) 4258 4259 CASE(0) 4260 4261 IF( dl_lat1 >= dl_lat0 .OR. dl_lat0 >= dl_lat1p )THEN 4262 ll_coincidence=.FALSE. 4263 CALL logger_debug("GRID CHECK COINCIDENCE: invalid "//& 4264 & "j-direction refinement factor ("//& 4265 & TRIM(fct_str(id_rho(jp_J)))//& 4266 & ") between fine grid and coarse grid ") 4267 ENDIF 4268 4269 CASE DEFAULT 4270 4832 ENDIF 4833 4834 ENDDO 4835 4836 ! check j-direction refinement factor 4837 DO jj=0,MIN(3,il_jmid1) 4838 4839 IF( il_ind1(2)+jj*id_rho(jp_J)+1 > tl_lat1%t_dim(2)%i_len )THEN 4840 CALL logger_warn("GRID CHECK COINCIDENCE: domain to small "//& 4841 & " to check j-direction refinement factor ") 4842 EXIT 4843 ELSE 4844 dl_lat0=tl_lat0%d_value(il_ind0(1),il_ind0(2)+jj ,1,1) 4845 dl_lat1=tl_lat1%d_value(il_ind1(1),il_ind1(2)+jj*id_rho(jp_J),1,1) 4846 4847 ! assume there could be little difference due to interpolation 4271 4848 IF( ABS(dl_lat1-dl_lat0) > dp_delta )THEN 4272 4849 ll_coincidence=.FALSE. … … 4276 4853 & ") between fine grid and coarse grid ") 4277 4854 ENDIF 4278 4279 END SELECT 4280 ENDIF 4281 4282 ENDDO 4855 ENDIF 4856 4857 ENDDO 4858 4859 ELSE 4860 ! case even refinment at least in one direction 4861 ! work on F-point 4862 4863 dl_delta=dp_delta 4864 ! look for lower left fine point in coarse cell. 4865 IF( ll_grid0F )THEN 4866 4867 ! lower left corner of coarse cell 4868 dl_lon0F=tl_lon0F%d_value(il_ind0(1)-1,il_ind0(2)-1,1,1) 4869 dl_lat0F=tl_lat0F%d_value(il_ind0(1)-1,il_ind0(2)-1,1,1) 4870 4871 ELSE 4872 4873 ! approximate lower left corner of coarse cell (with T point) 4874 dl_lon0F=( tl_lon0%d_value(il_ind0(1) ,il_ind0(2) ,1,1) + & 4875 & tl_lon0%d_value(il_ind0(1) ,il_ind0(2)-1,1,1) + & 4876 & tl_lon0%d_value(il_ind0(1)-1,il_ind0(2) ,1,1) + & 4877 & tl_lon0%d_value(il_ind0(1)-1,il_ind0(2)-1,1,1) ) * 0.25 4878 4879 dl_lat0F=( tl_lat0%d_value(il_ind0(1) ,il_ind0(2) ,1,1) + & 4880 & tl_lat0%d_value(il_ind0(1) ,il_ind0(2)-1,1,1) + & 4881 & tl_lat0%d_value(il_ind0(1)-1,il_ind0(2) ,1,1) + & 4882 & tl_lat0%d_value(il_ind0(1)-1,il_ind0(2)-1,1,1) ) * 0.25 4883 4884 ! as we use approximation of F-point we relax condition 4885 dl_delta=100*dp_delta 4886 4887 ENDIF 4888 4889 IF( ll_grid1F )THEN 4890 4891 il_ind1(:)=grid_get_closest(tl_lon1F%d_value(:,:,1,1),& 4892 & tl_lat1F%d_value(:,:,1,1),& 4893 & dl_lon0F, dl_lat0F ) 4894 4895 ELSE 4896 4897 il_ill1(:)=grid_get_closest(tl_lon1%d_value(:,:,1,1),& 4898 & tl_lat1%d_value(:,:,1,1),& 4899 & dl_lon0F, dl_lat0F, 'll' ) 4900 4901 il_ilr1(:)=grid_get_closest(tl_lon1%d_value(:,:,1,1),& 4902 & tl_lat1%d_value(:,:,1,1),& 4903 & dl_lon0F, dl_lat0F, 'lr' ) 4904 4905 il_iul1(:)=grid_get_closest(tl_lon1%d_value(:,:,1,1),& 4906 & tl_lat1%d_value(:,:,1,1),& 4907 & dl_lon0F, dl_lat0F, 'ul' ) 4908 4909 il_iur1(:)=grid_get_closest(tl_lon1%d_value(:,:,1,1),& 4910 & tl_lat1%d_value(:,:,1,1),& 4911 & dl_lon0F, dl_lat0F, 'ur' ) 4912 4913 ! as we use approximation of F-point we relax condition 4914 dl_delta=100*dp_delta 4915 4916 ENDIF 4917 4918 ! check i-direction refinement factor 4919 DO ji=0,MIN(3,il_imid1) 4920 4921 IF( il_ind1(1)+ji*id_rho(jp_I)+1 > tl_lon1%t_dim(1)%i_len )THEN 4922 CALL logger_warn("GRID CHECK COINCIDENCE: domain to small "//& 4923 & " to check i-direction refinement factor ") 4924 EXIT 4925 ELSE 4926 IF( ll_grid0F )THEN 4927 dl_lon0F=tl_lon0F%d_value(il_ind0(1)+ji-1, il_ind0(2)-1,1,1) 4928 ELSE 4929 dl_lon0F= 0.25 * & 4930 & ( tl_lon0%d_value(il_ind0(1)+ji , il_ind0(2) ,1,1) + & 4931 & tl_lon0%d_value(il_ind0(1)+ji-1, il_ind0(2) ,1,1) + & 4932 & tl_lon0%d_value(il_ind0(1)+ji , il_ind0(2)-1,1,1) + & 4933 & tl_lon0%d_value(il_ind0(1)+ji-1, il_ind0(2)-1,1,1) ) 4934 ENDIF 4935 4936 IF( ll_grid1F )THEN 4937 dl_lon1F= tl_lon1F%d_value( il_ind1(1)+ji*id_rho(jp_I), & 4938 & il_ind1(2),1,1) 4939 ELSE 4940 dl_lon1F= 0.25 * & 4941 & ( tl_lon1%d_value( il_ill1(1)+ji*id_rho(jp_I), & 4942 & il_ill1(2),1,1) + & 4943 & tl_lon1%d_value( il_ilr1(1)+ji*id_rho(jp_I), & 4944 & il_ilr1(2),1,1) + & 4945 & tl_lon1%d_value( il_iul1(1)+ji*id_rho(jp_I), & 4946 & il_iul1(2),1,1) + & 4947 & tl_lon1%d_value( il_iur1(1)+ji*id_rho(jp_I), & 4948 & il_iur1(2),1,1) ) 4949 4950 ENDIF 4951 4952 ! assume there could be little difference due to interpolation 4953 IF( ABS(dl_lon1F - dl_lon0F) > dl_delta )THEN 4954 ll_coincidence=.FALSE. 4955 CALL logger_debug("GRID CHECK COINCIDENCE: invalid "//& 4956 & "i-direction refinement factor ("//& 4957 & TRIM(fct_str(id_rho(jp_I)))//& 4958 & ") between fine grid and coarse grid ") 4959 ENDIF 4960 ENDIF 4961 4962 ENDDO 4963 4964 ! check j-direction refinement factor 4965 DO jj=0,MIN(3,il_jmid1) 4966 4967 IF( il_ind1(2)+jj*id_rho(jp_J)+1 > tl_lat1%t_dim(2)%i_len )THEN 4968 CALL logger_warn("GRID CHECK COINCIDENCE: domain to small "//& 4969 & " to check j-direction refinement factor ") 4970 EXIT 4971 ELSE 4972 IF( ll_grid0F )THEN 4973 dl_lat0F=tl_lat0F%d_value(il_ind0(1)-1, il_ind0(2)+jj-1,1,1) 4974 ELSE 4975 dl_lat0F= 0.25 * & 4976 & ( tl_lat0%d_value(il_ind0(1) , il_ind0(2)+jj ,1,1) + & 4977 & tl_lat0%d_value(il_ind0(1)-1, il_ind0(2)+jj ,1,1) + & 4978 & tl_lat0%d_value(il_ind0(1) , il_ind0(2)+jj-1,1,1) + & 4979 & tl_lat0%d_value(il_ind0(1)-1, il_ind0(2)+jj-1,1,1) ) 4980 ENDIF 4981 4982 IF( ll_grid1F )THEN 4983 dl_lat1F= tl_lat1F%d_value( il_ind1(1), & 4984 & il_ind1(2)+jj*id_rho(jp_J),1,1) 4985 ELSE 4986 dl_lat1F= 0.25 * & 4987 & ( tl_lat1%d_value( il_ill1(1), & 4988 & il_ill1(2)+jj*id_rho(jp_J),1,1) + & 4989 & tl_lat1%d_value( il_ilr1(1), & 4990 & il_ilr1(2)+jj*id_rho(jp_J),1,1) + & 4991 & tl_lat1%d_value( il_iul1(1), & 4992 & il_iul1(2)+jj*id_rho(jp_J),1,1) + & 4993 & tl_lat1%d_value( il_iur1(1), & 4994 & il_iur1(2)+jj*id_rho(jp_J),1,1) ) 4995 4996 ENDIF 4997 4998 ! assume there could be little difference due to interpolation 4999 IF( ABS(dl_lat1F - dl_lat0F) > dl_delta )THEN 5000 ll_coincidence=.FALSE. 5001 CALL logger_debug("GRID CHECK COINCIDENCE: invalid "//& 5002 & "i-direction refinement factor ("//& 5003 & TRIM(fct_str(id_rho(jp_I)))//& 5004 & ") between fine grid and coarse grid ") 5005 ENDIF 5006 ENDIF 5007 5008 ENDDO 5009 ENDIF 4283 5010 4284 5011 ! clean … … 4851 5578 4852 5579 ! copy structure 4853 4854 4855 4856 4857 4858 4859 5580 tl_mpp=mpp_copy(td_mpp) 5581 5582 CALL logger_info("GRID GET FINE GHOST perio"//TRIM(fct_str(tl_mpp%i_perio))) 5583 IF( tl_mpp%i_perio < 0 )THEN 5584 ! compute NEMO periodicity index 5585 CALL grid_get_info(tl_mpp) 5586 ENDIF 4860 5587 4861 5588 SELECT CASE(tl_mpp%i_perio)
Note: See TracChangeset
for help on using the changeset viewer.
