- Timestamp:
- 2017-11-30T16:58:49+01:00 (6 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2015/nemo_v3_6_STABLE/NEMOGCM/TOOLS/SIREN/src/grid.f90
r7372 r8862 218 218 !> @date February, 2015 219 219 !> - add function grid_fill_small_msk to fill small domain inside bigger one 220 !> @ February, 2016220 !> @date February, 2016 221 221 !> - improve way to check coincidence (bug fix) 222 222 !> - manage grid cases for T,U,V or F point, with even or odd refinment (bug fix) 223 !> @date April, 2016 224 !> - add function to get closest grid point using coarse grid coordinates strucutre 223 225 ! 224 226 !> @note Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) … … 271 273 PRIVATE :: grid__get_coarse_index_cc ! - using coarse and fine grid array of lon,lat 272 274 275 ! return closest coarse grid point from another point 276 PRIVATE :: grid__get_closest_str ! - using coarse grid coordinates strucutre 277 PRIVATE :: grid__get_closest_arr ! - using coarse grid array of lon,lat 278 273 279 ! get offset between fine and coarse grid 274 280 PRIVATE :: grid__get_fine_offset_ff ! - using coarse and fine grid coordinates files … … 333 339 MODULE PROCEDURE grid__get_ghost_mpp 334 340 END INTERFACE grid_get_ghost 341 342 INTERFACE grid_get_closest 343 MODULE PROCEDURE grid__get_closest_str 344 MODULE PROCEDURE grid__get_closest_arr 345 END INTERFACE grid_get_closest 335 346 336 347 INTERFACE grid_get_coarse_index … … 467 478 !------------------------------------------------------------------- 468 479 !> @brief This subroutine get information about global domain, given mpp 469 !> struc utre.480 !> structure. 470 481 !> 471 482 !> @details … … 536 547 537 548 SELECT CASE(il_perio) 538 CASE(3,4)539 il_pivot=1540 CASE(5,6)541 il_pivot=0542 CASE(0,1,2)543 il_pivot=1549 CASE(3,4) 550 il_pivot=1 551 CASE(5,6) 552 il_pivot=0 553 CASE(0,1,2) 554 il_pivot=1 544 555 END SELECT 545 556 … … 1365 1376 END SELECT 1366 1377 ELSE 1378 il_perio=-1 1367 1379 ! check periodicity 1368 1380 IF(ANY(td_var%d_value( 1 ,:,1,1)/=td_var%d_fill).OR.& … … 1656 1668 !> else return the size of the ovarlap band. 1657 1669 !> East-West overlap is computed comparing longitude value of the 1658 !> South "part of the domain, to avoid north fold boundary.1670 !> South part of the domain, to avoid north fold boundary. 1659 1671 !> 1660 1672 ! … … 1663 1675 !> @date October, 2014 1664 1676 !> - work on mpp file structure instead of file structure 1677 !> @date October, 2016 1678 !> - check longitude as longname 1665 1679 !> 1666 1680 !> @param[in] td_lon longitude variable structure … … 1712 1726 ALLOCATE( dl_vare(il_jmax-il_jmin+1) ) 1713 1727 ALLOCATE( dl_varw(il_jmax-il_jmin+1) ) 1714 1728 1715 1729 dl_vare(:)=dl_value(il_east,il_jmin:il_jmax) 1716 1730 dl_varw(:)=dl_value(il_west,il_jmin:il_jmax) 1717 1718 IF( .NOT.( ALL(dl_vare(:)==td_var%d_fill) .AND. & 1719 & ALL(dl_varw(:)==td_var%d_fill) ) )THEN 1720 1721 IF( TRIM(td_var%c_stdname) == 'longitude' )THEN 1731 1732 IF( .NOT.( ALL(dl_vare(:)==td_var%d_fill) .AND. & 1733 & ALL(dl_varw(:)==td_var%d_fill) ) )THEN 1734 1735 IF( TRIM(td_var%c_stdname) == 'longitude' .OR. & 1736 & SCAN( TRIM(td_var%c_longname), 'longitude') == 0 )THEN 1722 1737 WHERE( dl_value(:,:) > 180._dp .AND. & 1723 1738 & dl_value(:,:) /= td_var%d_fill ) … … 1743 1758 ELSE 1744 1759 dl_vare(:)=dl_value(il_east-ji,il_jmin:il_jmax) 1745 1760 1746 1761 IF( ALL( dl_varw(:) == dl_vare(:) ) )THEN 1747 1762 grid__get_ew_overlap_var=ji+1 … … 1769 1784 !> else return the size of the ovarlap band. 1770 1785 !> East-West overlap is computed comparing longitude value of the 1771 !> South "part of the domain, to avoid north fold boundary.1786 !> South part of the domain, to avoid north fold boundary. 1772 1787 !> 1773 1788 !> @author J.Paul 1774 1789 !> @date October, 2014 - Initial Version 1790 !> @date October, 2016 1791 !> - check varid for longitude_T 1775 1792 !> 1776 1793 !> @param[in] td_file file structure … … 1793 1810 !---------------------------------------------------------------- 1794 1811 1795 il_varid=var_get_i ndex(td_file%t_var(:), 'longitude')1812 il_varid=var_get_id(td_file%t_var(:), 'longitude', 'longitude_T') 1796 1813 IF( il_varid /= 0 )THEN 1797 1814 ! read longitude on boundary 1798 tl_var=iom_read_var(td_file, 'longitude')1815 tl_var=iom_read_var(td_file, il_varid) 1799 1816 ELSE 1800 1817 DO ji=1,td_file%i_nvar … … 1819 1836 !> else return the size of the ovarlap band. 1820 1837 !> East-West overlap is computed comparing longitude value of the 1821 !> South "part of the domain, to avoid north fold boundary.1838 !> South part of the domain, to avoid north fold boundary. 1822 1839 !> 1823 1840 ! … … 1826 1843 !> @date October, 2014 1827 1844 !> - work on mpp file structure instead of file structure 1845 !> @date October, 2016 1846 !> - check varid for longitude_T 1828 1847 !> 1829 1848 !> @param[in] td_mpp mpp structure … … 1850 1869 1851 1870 ! read longitude on boundary 1852 il_varid=var_get_i ndex(td_mpp%t_proc(1)%t_var(:),'longitude')1871 il_varid=var_get_id(td_mpp%t_proc(1)%t_var(:),'longitude', 'longitude_T') 1853 1872 IF( il_varid /= 0 )THEN 1854 tl_var=iom_mpp_read_var(td_mpp, 'longitude')1873 tl_var=iom_mpp_read_var(td_mpp, il_varid) 1855 1874 ELSE 1856 1875 DO ji=1,td_mpp%t_proc(1)%i_nvar … … 1866 1885 grid__get_ew_overlap_mpp=il_ew 1867 1886 ENDIF 1868 1869 1887 1870 1888 ! clean … … 3020 3038 !> 3021 3039 !> @author J.Paul 3040 !> @date April, 2016 - Initial Version 3041 !> @date October, 2016 3042 !> - use max of zero and east-west overlap instead of east-west overlap 3043 !> 3044 !> @param[in] td_coord0 coarse grid coordinate mpp structure 3045 !> @param[in] dd_lon1 fine grid longitude 3046 !> @param[in] dd_lat1 fine grid latitude 3047 !> @param[in] cd_pos relative position of grid point from point 3048 !> @param[in] dd_fill fill value 3049 !> @return coarse grid indices of closest point of fine grid point 3050 !------------------------------------------------------------------- 3051 FUNCTION grid__get_closest_str( td_coord0, dd_lon1, dd_lat1, cd_pos, dd_fill ) & 3052 & RESULT(id_res) 3053 3054 IMPLICIT NONE 3055 ! Argument 3056 TYPE(TMPP ) , INTENT(IN) :: td_coord0 3057 REAL(dp), INTENT(IN) :: dd_lon1 3058 REAL(dp), INTENT(IN) :: dd_lat1 3059 CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_pos 3060 REAL(dp), INTENT(IN), OPTIONAL :: dd_fill 3061 3062 ! function 3063 INTEGER(i4), DIMENSION(2) :: id_res 3064 3065 ! local variable 3066 CHARACTER(LEN=lc) :: cl_point 3067 CHARACTER(LEN=lc) :: cl_name 3068 3069 INTEGER(i4) :: il_ind 3070 INTEGER(i4) :: il_ew 3071 3072 REAL(dp) , DIMENSION(:,:), ALLOCATABLE :: dl_lon0 3073 REAL(dp) , DIMENSION(:,:), ALLOCATABLE :: dl_lat0 3074 3075 TYPE(TVAR) :: tl_lon0 3076 TYPE(TVAR) :: tl_lat0 3077 TYPE(TMPP) :: tl_coord0 3078 !---------------------------------------------------------------- 3079 3080 id_res(:)=-1 3081 cl_point='T' 3082 3083 ! copy structure 3084 tl_coord0=mpp_copy(td_coord0) 3085 3086 IF( .NOT. ASSOCIATED(tl_coord0%t_proc) )THEN 3087 3088 CALL logger_error("GRID GET CLOSEST: decompsition of mpp "//& 3089 & "file "//TRIM(tl_coord0%c_name)//" not defined." ) 3090 3091 ELSE 3092 3093 ! open mpp files 3094 CALL iom_mpp_open(tl_coord0) 3095 3096 ! read coarse longitue and latitude 3097 WRITE(cl_name,*) 'longitude_'//TRIM(cl_point) 3098 il_ind=var_get_id(tl_coord0%t_proc(1)%t_var(:), cl_name) 3099 IF( il_ind == 0 )THEN 3100 CALL logger_warn("GRID GET CLOSEST: no variable "//& 3101 & TRIM(cl_name)//"in file "//TRIM(tl_coord0%c_name)//". & 3102 & try to use longitude.") 3103 WRITE(cl_name,*) 'longitude' 3104 ENDIF 3105 tl_lon0=iom_mpp_read_var(tl_coord0, TRIM(cl_name)) 3106 3107 WRITE(cl_name,*) 'latitude_'//TRIM(cl_point) 3108 il_ind=var_get_id(tl_coord0%t_proc(1)%t_var(:), cl_name) 3109 IF( il_ind == 0 )THEN 3110 CALL logger_warn("GRID GET CLOSEST: no variable "//& 3111 & TRIM(cl_name)//"in file "//TRIM(tl_coord0%c_name)//". & 3112 & try to use latitude.") 3113 WRITE(cl_name,*) 'latitude' 3114 ENDIF 3115 tl_lat0=iom_mpp_read_var(tl_coord0, TRIM(cl_name)) 3116 3117 ! close mpp files 3118 CALL iom_mpp_close(tl_coord0) 3119 3120 il_ew=MAX(0,tl_coord0%i_ew) 3121 ALLOCATE(dl_lon0(tl_coord0%t_dim(jp_I)%i_len-il_ew, & 3122 & tl_coord0%t_dim(jp_J)%i_len) ) 3123 ALLOCATE(dl_lat0(tl_coord0%t_dim(jp_I)%i_len-il_ew, & 3124 & tl_coord0%t_dim(jp_J)%i_len) ) 3125 3126 dl_lon0(:,:)=tl_lon0%d_value(il_ew+1:,:,1,1) 3127 dl_lat0(:,:)=tl_lat0%d_value(il_ew+1:,:,1,1) 3128 3129 id_res(:)=grid_get_closest( dl_lon0, dl_lat0, dd_lon1, dd_lat1, cd_pos, dd_fill ) 3130 3131 DEALLOCATE(dl_lon0, dl_lat0) 3132 CALL var_clean(tl_lon0) 3133 CALL var_clean(tl_lat0) 3134 CALL mpp_clean(tl_coord0) 3135 3136 ENDIF 3137 3138 END FUNCTION grid__get_closest_str 3139 !------------------------------------------------------------------- 3140 !> @brief This function return grid indices of the closest point 3141 !> from point (lon1,lat1) 3142 !> 3143 !> @details 3144 !> 3145 !> @note overlap band should have been already removed from coarse grid array 3146 !> of longitude and latitude, before running this function 3147 !> 3148 !> if you add cd_pos argument, you could choice to return closest point at 3149 !> - lower left (ll) of the point 3150 !> - lower right (lr) of the point 3151 !> - upper left (ul) of the point 3152 !> - upper right (ur) of the point 3153 !> - lower (lo) of the point 3154 !> - upper (up) of the point 3155 !> - left (le) of the point 3156 !> - right (ri) of the point 3157 !> 3158 !> @author J.Paul 3022 3159 !> @date November, 2013 - Initial Version 3023 3160 !> @date February, 2015 … … 3034 3171 !> @return coarse grid indices of closest point of fine grid point 3035 3172 !------------------------------------------------------------------- 3036 FUNCTION grid_ get_closest( dd_lon0, dd_lat0, dd_lon1, dd_lat1, cd_pos, dd_fill )3173 FUNCTION grid__get_closest_arr( dd_lon0, dd_lat0, dd_lon1, dd_lat1, cd_pos, dd_fill ) 3037 3174 IMPLICIT NONE 3038 3175 ! Argument … … 3045 3182 3046 3183 ! function 3047 INTEGER(i4), DIMENSION(2) :: grid_ get_closest3184 INTEGER(i4), DIMENSION(2) :: grid__get_closest_arr 3048 3185 3049 3186 ! local variable … … 3261 3398 END SELECT 3262 3399 ENDIF 3263 grid_ get_closest(:)=MINLOC(dl_dist(:,:),dl_dist(:,:)/=NF90_FILL_DOUBLE)3264 3265 grid_ get_closest(1)=grid_get_closest(1)+il_iinf-13266 grid_ get_closest(2)=grid_get_closest(2)+il_jinf-13400 grid__get_closest_arr(:)=MINLOC(dl_dist(:,:),dl_dist(:,:)/=NF90_FILL_DOUBLE) 3401 3402 grid__get_closest_arr(1)=grid__get_closest_arr(1)+il_iinf-1 3403 grid__get_closest_arr(2)=grid__get_closest_arr(2)+il_jinf-1 3267 3404 3268 3405 DEALLOCATE( dl_dist ) 3269 3406 DEALLOCATE( dl_lon0 ) 3270 3407 3271 END FUNCTION grid_ get_closest3408 END FUNCTION grid__get_closest_arr 3272 3409 !------------------------------------------------------------------- 3273 3410 !> @brief This function compute the distance between a point A and grid points. … … 3475 3612 ENDIF 3476 3613 tl_lat0=iom_mpp_read_var(tl_coord0, TRIM(cl_name)) 3477 3614 3478 3615 ! close mpp files 3479 3616 CALL iom_mpp_close(tl_coord0) … … 4647 4784 4648 4785 IF( ll_even )THEN 4786 4649 4787 ! look for variable value on domain for F point 4650 4788 il_ind=var_get_index(tl_coord0%t_proc(1)%t_var(:), 'longitude_F') … … 5112 5250 dl_lon1 = dd_lon1(il_imin1, il_jmax1) 5113 5251 dl_lat1 = dd_lat1(il_imin1, il_jmax1) 5114 5115 5252 5116 5253 IF( (ABS(dl_lon1-dl_lon0)>dp_delta) .AND. (dl_lon1 < dl_lon0) .OR. &
Note: See TracChangeset
for help on using the changeset viewer.
