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