Changeset 7025 for branches/2016/dev_r6999_CONFIGMAN_1/NEMOGCM/TOOLS/SIREN/src/grid.f90

Timestamp:

2016-10-13T11:08:38+02:00 (8 years ago)

Author:

jpaul

Message:

see ticket #1781

File:

• branches/2016/dev_r6999_CONFIGMAN_1/NEMOGCM/TOOLS/SIREN/src/grid.f90 (modified) (9 diffs)

branches/2016/dev_r6999_CONFIGMAN_1/NEMOGCM/TOOLS/SIREN/src/grid.f90

@@ -218 +218 @@
 !> @date February, 2015
 !> - add function grid_fill_small_msk to fill small domain inside bigger one
-!> @February, 2016
+!> @date February, 2016
 !> - improve way to check coincidence (bug fix)
 !> - manage grid cases for T,U,V or F point, with even or odd refinment (bug fix)
+!> @date April, 2016
+!> - add function to get closest grid point using coarse grid coordinates strucutre 
 !
 !> @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
 
+                                     ! return closest coarse grid point from another point
+   PRIVATE :: grid__get_closest_str    ! - using coarse grid coordinates strucutre
+   PRIVATE :: grid__get_closest_arr    ! - using coarse grid array of lon,lat
+
                                      ! get offset between fine and coarse grid
    PRIVATE :: grid__get_fine_offset_ff ! - using coarse and fine grid coordinates files
@@ -333 +339 @@
       MODULE PROCEDURE grid__get_ghost_mpp
    END INTERFACE  grid_get_ghost
+
+   INTERFACE  grid_get_closest
+      MODULE PROCEDURE grid__get_closest_str
+      MODULE PROCEDURE grid__get_closest_arr
+   END INTERFACE  grid_get_closest
 
    INTERFACE  grid_get_coarse_index
@@ -1365 +1376 @@
             END SELECT
          ELSE
+            il_perio=-1
             ! check periodicity
             IF(ANY(td_var%d_value(   1     ,:,1,1)/=td_var%d_fill).OR.&
@@ -3020 +3032 @@
    !>
    !> @author J.Paul
+   !> @date April, 2016 - Initial Version
+   !
+   !> @param[in] td_coord0 coarse grid coordinate mpp structure
+   !> @param[in] dd_lon1   fine   grid longitude
+   !> @param[in] dd_lat1   fine   grid latitude
+   !> @param[in] cd_pos    relative position of grid point from point 
+   !> @param[in] dd_fill   fill value
+   !> @return coarse grid indices of closest point of fine grid point
+   !-------------------------------------------------------------------
+   FUNCTION grid__get_closest_str( td_coord0, dd_lon1, dd_lat1, cd_pos, dd_fill ) &
+   &  RESULT(id_res)
+
+      IMPLICIT NONE
+      ! Argument
+      TYPE(TMPP )     , INTENT(IN) :: td_coord0
+      REAL(dp),         INTENT(IN) :: dd_lon1
+      REAL(dp),         INTENT(IN) :: dd_lat1
+      CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_pos
+      REAL(dp),         INTENT(IN), OPTIONAL :: dd_fill
+
+      ! function
+      INTEGER(i4), DIMENSION(2) :: id_res
+
+      ! local variable
+      CHARACTER(LEN=lc)                        :: cl_point
+      CHARACTER(LEN=lc)                        :: cl_name
+
+      INTEGER(i4)                              :: il_ind
+
+      REAL(dp)   , DIMENSION(:,:), ALLOCATABLE :: dl_lon0
+      REAL(dp)   , DIMENSION(:,:), ALLOCATABLE :: dl_lat0
+
+      TYPE(TVAR)                               :: tl_lon0
+      TYPE(TVAR)                               :: tl_lat0
+      TYPE(TMPP)                               :: tl_coord0
+      !----------------------------------------------------------------
+
+      id_res(:)=-1
+      cl_point='T'
+
+      ! copy structure
+      tl_coord0=mpp_copy(td_coord0)
+
+      IF( .NOT. ASSOCIATED(tl_coord0%t_proc) )THEN
+
+         CALL logger_error("GRID GET CLOSEST: decompsition of mpp "//&
+         &  "file "//TRIM(tl_coord0%c_name)//" not defined." )
+
+      ELSE
+
+         ! open mpp files
+         CALL iom_mpp_open(tl_coord0)
+ 
+         ! read coarse longitue and latitude
+         WRITE(cl_name,*) 'longitude_'//TRIM(cl_point)
+         il_ind=var_get_id(tl_coord0%t_proc(1)%t_var(:), cl_name)
+         IF( il_ind == 0 )THEN
+            CALL logger_warn("GRID GET CLOSEST: no variable "//&
+            &  TRIM(cl_name)//"in file "//TRIM(tl_coord0%c_name)//". &
+            &  try to use longitude.")
+            WRITE(cl_name,*) 'longitude'
+         ENDIF
+         tl_lon0=iom_mpp_read_var(tl_coord0, TRIM(cl_name))
+ 
+         WRITE(cl_name,*) 'latitude_'//TRIM(cl_point)
+         il_ind=var_get_id(tl_coord0%t_proc(1)%t_var(:), cl_name)
+         IF( il_ind == 0 )THEN
+            CALL logger_warn("GRID GET CLOSEST: no variable "//&
+            &  TRIM(cl_name)//"in file "//TRIM(tl_coord0%c_name)//". &
+            &  try to use latitude.")
+            WRITE(cl_name,*) 'latitude'
+         ENDIF
+         tl_lat0=iom_mpp_read_var(tl_coord0, TRIM(cl_name))
+
+         ! close mpp files
+         CALL iom_mpp_close(tl_coord0)
+
+         ALLOCATE(dl_lon0(tl_coord0%t_dim(jp_I)%i_len-tl_coord0%i_ew, &
+            &             tl_coord0%t_dim(jp_J)%i_len) )             
+         ALLOCATE(dl_lat0(tl_coord0%t_dim(jp_I)%i_len-tl_coord0%i_ew, &
+            &             tl_coord0%t_dim(jp_J)%i_len) )
+
+         dl_lon0(:,:)=tl_lon0%d_value(tl_coord0%i_ew+1:,:,1,1)
+         dl_lat0(:,:)=tl_lat0%d_value(tl_coord0%i_ew+1:,:,1,1)
+
+         id_res(:)=grid_get_closest( dl_lon0, dl_lat0, dd_lon1, dd_lat1, cd_pos, dd_fill )
+
+         DEALLOCATE(dl_lon0, dl_lat0)
+         CALL var_clean(tl_lon0)
+         CALL var_clean(tl_lat0)
+         CALL mpp_clean(tl_coord0)
+
+      ENDIF
+
+   END FUNCTION  grid__get_closest_str
+   !-------------------------------------------------------------------
+   !> @brief This function return grid indices of the closest point
+   !> from point (lon1,lat1) 
+   !> 
+   !> @details
+   !>
+   !> @note overlap band should have been already removed from coarse grid array 
+   !> of longitude and latitude, before running this function
+   !>
+   !> if you add cd_pos argument, you could choice to return closest point at
+   !> - lower left  (ll) of the point
+   !> - lower right (lr) of the point
+   !> - upper left  (ul) of the point
+   !> - upper right (ur) of the point
+   !> - lower       (lo) of the point
+   !> - upper       (up) of the point
+   !> -       left  (le) of the point
+   !> -       right (ri) of the point
+   !>
+   !> @author J.Paul
    !> @date November, 2013 - Initial Version
    !> @date February, 2015
@@ -3034 +3161 @@
    !> @return coarse grid indices of closest point of fine grid point
    !-------------------------------------------------------------------
-   FUNCTION grid_get_closest( dd_lon0, dd_lat0, dd_lon1, dd_lat1, cd_pos, dd_fill )
+   FUNCTION grid__get_closest_arr( dd_lon0, dd_lat0, dd_lon1, dd_lat1, cd_pos, dd_fill )
       IMPLICIT NONE
       ! Argument
@@ -3045 +3172 @@
 
       ! function
-      INTEGER(i4), DIMENSION(2) :: grid_get_closest
+      INTEGER(i4), DIMENSION(2) :: grid__get_closest_arr
 
       ! local variable
@@ -3261 +3388 @@
          END SELECT
       ENDIF
-      grid_get_closest(:)=MINLOC(dl_dist(:,:),dl_dist(:,:)/=NF90_FILL_DOUBLE)
-
-      grid_get_closest(1)=grid_get_closest(1)+il_iinf-1
-      grid_get_closest(2)=grid_get_closest(2)+il_jinf-1
+      grid__get_closest_arr(:)=MINLOC(dl_dist(:,:),dl_dist(:,:)/=NF90_FILL_DOUBLE)
+
+      grid__get_closest_arr(1)=grid__get_closest_arr(1)+il_iinf-1
+      grid__get_closest_arr(2)=grid__get_closest_arr(2)+il_jinf-1
 
       DEALLOCATE( dl_dist )
       DEALLOCATE( dl_lon0 )
 
-   END FUNCTION grid_get_closest
+   END FUNCTION grid__get_closest_arr
    !-------------------------------------------------------------------
    !> @brief This function compute the distance between a point A and grid points.  
@@ -4647 +4774 @@
 
       IF( ll_even )THEN
+
          ! look for variable value on domain for F point
          il_ind=var_get_index(tl_coord0%t_proc(1)%t_var(:), 'longitude_F')