SURFEX v7.3
General documentation of Surfex
 All Classes Files Functions Variables Typedefs
/home/dasprezs/EXPORT_v7_3/src/SURFEX/get_near_meshes_cartesian.F90
Go to the documentation of this file.
00001 !     #########
00002       SUBROUTINE GET_NEAR_MESHES_CARTESIAN(KGRID_PAR,KL,PGRID_PAR,KNEAR_NBR,KNEAR)
00003 !     ##############################################################
00004 !
00005 !!**** *GET_NEAR_MESHES_CARTESIAN* 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_CARTESIAN
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 INTEGER                            :: IIMAX, IJMAX
00052 INTEGER                            :: JI, JJ
00053 INTEGER                            :: JX, JY
00054 INTEGER                            :: JL
00055 INTEGER                            :: IDIST
00056 INTEGER                            :: ICOUNT
00057 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00058 !----------------------------------------------------------------------------
00059 !
00060 IF (LHOOK) CALL DR_HOOK('GET_NEAR_MESHES_CARTESIAN',0,ZHOOK_HANDLE)
00061  CALL GET_GRIDTYPE_CARTESIAN(PGRID_PAR,KIMAX=IIMAX,KJMAX=IJMAX)
00062 !
00063 KNEAR  (:,:) = 0
00064 !
00065 IDIST = INT(SQRT(FLOAT(KNEAR_NBR)))
00066 !
00067 IF (IIMAX*IJMAX==KL) THEN
00068   DO JJ=1,IJMAX
00069     DO JI=1,IIMAX
00070       ICOUNT = 0
00071       JL = JI + IIMAX * (JJ-1)
00072       KNEAR(JL,:) = 0      
00073       DO JX=-(IDIST-1)/2,IDIST/2
00074         DO JY=-(IDIST-1)/2,IDIST/2
00075           IF (JI+JX>0 .AND. JI+JX<IIMAX+1 .AND. JJ+JY>0 .AND. JJ+JY<IJMAX+1) THEN
00076             ICOUNT = ICOUNT + 1
00077             KNEAR(JL,ICOUNT) = (JI+JX) + IIMAX * (JJ+JY-1)
00078           END IF
00079         END DO
00080       END DO
00081     END DO
00082   END DO
00083 END IF
00084 IF (LHOOK) CALL DR_HOOK('GET_NEAR_MESHES_CARTESIAN',1,ZHOOK_HANDLE)
00085 !
00086 !-------------------------------------------------------------------------------
00087 !
00088 END SUBROUTINE GET_NEAR_MESHES_CARTESIAN