SURFEX v7.3: /home/dasprezs/EXPORT_v7_3/src/SURFEX/get_adj_mes

Go to the documentation of this file.
00001 !     #########
00002       SUBROUTINE GET_ADJ_MES_LONLATVAL(KGRID_PAR,KL,PGRID_PAR,KLEFT,KRIGHT,KTOP,KBOTTOM)
00003 !     ##############################################################
00004 !
00005 !!**** *GET_ADJ_MES_LONLATVAL* get the near grid mesh indices
00006 !!
00007 !!    PURPOSE
00008 !!    -------
00009 !!
00010 !!    METHOD
00011 !!    ------
00012 !!   
00013 !!    REFERENCE
00014 !!    ---------
00015 !!
00016 !!    AUTHOR
00017 !!    ------
00018 !!
00019 !!    V. Masson         Meteo-France
00020 !!
00021 !!    MODIFICATION
00022 !!    ------------
00023 !!
00024 !!    Original    03/2004
00025 !!
00026 !----------------------------------------------------------------------------
00027 !
00028 !*    0.     DECLARATION
00029 !            -----------
00030 !
00031 USE MODE_GRIDTYPE_LONLATVAL
00032 !
00033 !
00034 USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
00035 USE PARKIND1  ,ONLY : JPRB
00036 !
00037 IMPLICIT NONE
00038 !
00039 !*    0.1    Declaration of arguments
00040 !            ------------------------
00041 !
00042 INTEGER,                         INTENT(IN)    :: KGRID_PAR ! size of PGRID_PAR
00043 INTEGER,                         INTENT(IN)    :: KL        ! number of points
00044 REAL,    DIMENSION(KGRID_PAR),   INTENT(IN)    :: PGRID_PAR ! grid parameters
00045 INTEGER, DIMENSION(KL),          INTENT(OUT)   :: KLEFT     ! left   mesh index
00046 INTEGER, DIMENSION(KL),          INTENT(OUT)   :: KRIGHT    ! right  mesh index
00047 INTEGER, DIMENSION(KL),          INTENT(OUT)   :: KTOP      ! top    mesh index
00048 INTEGER, DIMENSION(KL),          INTENT(OUT)   :: KBOTTOM   ! bottom mesh index
00049 !
00050 !*    0.2    Declaration of other local variables
00051 !            ------------------------------------
00052 !
00053 REAL,DIMENSION(KL)    :: ZX
00054 REAL,DIMENSION(KL)    :: ZY
00055 REAL,DIMENSION(KL)    :: ZDX
00056 REAL,DIMENSION(KL)    :: ZDY
00057 REAL :: ZECX, ZECY, ZECDX, ZECDY
00058 INTEGER :: JLAT, JLON
00059 INTEGER :: IL
00060 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00061 !
00062 !----------------------------------------------------------------------------
00063 !
00064 IF (LHOOK) CALL DR_HOOK('GET_ADJ_MES_LONLATVAL',0,ZHOOK_HANDLE)
00065 !
00066  CALL GET_GRIDTYPE_LONLATVAL(PGRID_PAR,IL,ZX,ZY,ZDX,ZDY)
00067 !
00068 KLEFT  (:) = 0
00069 KRIGHT (:) = 0
00070 KTOP   (:) = 0
00071 KBOTTOM(:) = 0
00072 !
00073 DO JLAT=1,KL
00074   !
00075   DO JLON=1,KL
00076     !
00077     ZECX = ABS(ZX(JLON)-ZX(JLAT))
00078     ZECY = ABS(ZY(JLON)-ZY(JLAT))
00079     !
00080     ZECDX = (ZDX(JLON)+ZDX(JLAT))/2.
00081     ZECDY = (ZDY(JLON)+ZDY(JLAT))/2.
00082     !
00083     IF ( ZECX <= ZECDX .AND. ZECY <= ZECDY ) THEN ! points overlap or are next to each other in x and y directions
00084       !
00085       IF ( ZECDY-ZECY <= ZECDX-ZECX .AND. ZECX/=ZECDX ) THEN ! overlap smaller in y than in x
00086         !
00087         IF ( ZY(JLON) < ZY(JLAT) .AND. &                       ! Y under X in y direction
00088            ( KBOTTOM(JLAT)==0                     .OR. &     ! bottom not assigned yet
00089              ZECY < ABS(ZY(MAX(1,KBOTTOM(JLAT)))-ZY(JLAT)) .OR. &     ! this y point is closer to x in y direction
00090              ZECX < ABS(ZX(MAX(1,KBOTTOM(JLAT)))-ZX(JLAT)) ) ) THEN   ! this y point is closer to x in x direction
00091           !
00092           KBOTTOM(JLAT) = JLON
00093           !
00094         ELSEIF ( ZY(JLON) > ZY(JLAT) .AND. &                   ! Y above X in y direction
00095                ( KTOP(JLAT)==0                     .OR. &    ! top not assigned yet
00096                  ZECY < ABS(ZY(MAX(1,KTOP(JLAT)))-ZY(JLAT)) .OR. &    ! this y point is closer to x in y direction
00097                  ZECX < ABS(ZX(MAX(1,KTOP(JLAT)))-ZX(JLAT)) ) ) THEN  ! this y point is closer to x in x direction
00098           !
00099           KTOP(JLAT) = JLON
00100           !
00101         ENDIF
00102         !
00103       ELSEIF (ZECDX-ZECX < ZECDY-ZECY ) THEN ! overlap smaller in x than in y
00104         !
00105         IF ( ZX(JLON) < ZX(JLAT) .AND. &                     ! Y left X in x direction
00106            ( KLEFT(JLAT)==0                     .OR. &     ! left not assigned yet
00107              ZECY < ABS(ZY(MAX(1,KLEFT(JLAT)))-ZY(JLAT)) .OR. &     ! this y point is closer to x in y direction
00108              ZECX < ABS(ZX(MAX(1,KLEFT(JLAT)))-ZX(JLAT)) ) ) THEN   ! this y point is closer to x in x direction            
00109           !
00110           KLEFT(JLAT)=JLON
00111           !
00112         ELSEIF ( ZX(JLON) > ZX(JLAT) .AND. &                     ! Y right X in x direction
00113                ( KRIGHT(JLAT)==0                     .OR. &    ! right not assigned yet
00114                  ZECY < ABS(ZY(MAX(1,KRIGHT(JLAT)))-ZY(JLAT)) .OR. &    ! this y point is closer to x in y direction
00115                  ZECX < ABS(ZX(MAX(1,KRIGHT(JLAT)))-ZX(JLAT)) ) ) THEN  ! this y point is closer to x in x direction
00116           !
00117           KRIGHT(JLAT)=JLON
00118           !
00119         ENDIF
00120         !
00121       ENDIF  
00122       !
00123     ENDIF
00124     !
00125   ENDDO
00126   !
00127 ENDDO
00128 !
00129 IF (LHOOK) CALL DR_HOOK('GET_ADJ_MES_LONLATVAL',1,ZHOOK_HANDLE)
00130 !
00131 !-------------------------------------------------------------------------------
00132 !
00133 END SUBROUTINE GET_ADJ_MES_LONLATVAL