SURFEX v7.3
General documentation of Surfex
|
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