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

Go to the documentation of this file.
00001 !     #########
00002       SUBROUTINE GET_NEAR_MESHES_IGN(KGRID_PAR,KL,PGRID_PAR,KNEAR_NBR,KNEAR)
00003 !     ##############################################################
00004 !
00005 !!**** *GET_NEAR_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 !!    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_IGN
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 INTEGER,                         INTENT(IN)    :: KNEAR_NBR ! number of nearest points wanted
00045 REAL,    DIMENSION(KGRID_PAR),   INTENT(IN)    :: PGRID_PAR ! grid parameters
00046 INTEGER, DIMENSION(:,:),POINTER :: KNEAR    ! near mesh indices
00047 !
00048 !*    0.2    Declaration of other local variables
00049 !            ------------------------------------
00050 !
00051 REAL, DIMENSION(KL,KL) :: ZDIS
00052 REAL,DIMENSION(KL)    :: ZX
00053 REAL,DIMENSION(KL)    :: ZY
00054 REAL,DIMENSION(KL)    :: ZDX
00055 REAL,DIMENSION(KL)    :: ZDY
00056 REAL, DIMENSION(KL) :: ZDMAX
00057 INTEGER, DIMENSION(KL) :: ID0
00058 INTEGER :: JP1, JP2, JN
00059 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00060 !
00061 !----------------------------------------------------------------------------
00062 !
00063 IF (LHOOK) CALL DR_HOOK('GET_NEAR_MESHES_IGN',0,ZHOOK_HANDLE)
00064 !
00065  CALL GET_GRIDTYPE_IGN(PGRID_PAR,PX=ZX,PY=ZY,PDX=ZDX,PDY=ZDY)
00066 !
00067 KNEAR  (:,:) = 0
00068 !
00069 ! calcul de la distance de tous les points 2 à 2
00070 !
00071 ZDIS = 1.E20
00072 !
00073 DO JP1=1,KL
00074   DO JP2=1,KL
00075     ZDIS(JP1,JP2) = SQRT((ZX(JP1)-ZX(JP2))**2+(ZY(JP1)-ZY(JP2))**2)
00076   ENDDO
00077   ZDMAX(JP1) = MAXVAL(ZDIS(JP1,:)) + 1.
00078   ZDIS(JP1,JP1) = ZDMAX(JP1)
00079 ENDDO
00080 !
00081 ! on prend les knear_nbr premiers, pour chaque
00082 !
00083 DO JN=1,KNEAR_NBR
00084   !
00085   ID0(:) = 0
00086   !
00087   IF (JN<KL) THEN
00088     !
00089     DO JP1=1,KL
00090       ID0(JP1) = MAXVAL(MINLOC(ZDIS(JP1,:)))
00091     ENDDO         
00092     !
00093     DO JP1=1,KL
00094       !
00095       KNEAR(JP1,JN) = ID0(JP1)
00096       ZDIS(JP1,ID0(JP1)) = ZDMAX(JP1)
00097       !
00098     ENDDO
00099     !
00100   ENDIF
00101   !
00102 ENDDO
00103 !
00104 IF (LHOOK) CALL DR_HOOK('GET_NEAR_MESHES_IGN',1,ZHOOK_HANDLE)
00105 !
00106 !-------------------------------------------------------------------------------
00107 !
00108 END SUBROUTINE GET_NEAR_MESHES_IGN