|
SURFEX v7.3
General documentation of Surfex
|
|
SURFEX v7.3
General documentation of Surfex
|
00001 ! ######### 00002 SUBROUTINE GET_NEAR_MESHES_LONLAT_REG(KGRID_PAR,KL,PGRID_PAR,KNEAR_NBR,KNEAR) 00003 ! ############################################################## 00004 ! 00005 !!**** *GET_NEAR_MESHES_LONLAT_REG* 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_LONLAT_REG 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 :: ILON ! number of points in longitude 00052 INTEGER :: ILAT ! number of points in latitude 00053 INTEGER :: JLAT, JLON 00054 INTEGER :: JL 00055 INTEGER :: JX, JY 00056 INTEGER :: IDIST 00057 INTEGER :: ICOUNT 00058 REAL(KIND=JPRB) :: ZHOOK_HANDLE 00059 !---------------------------------------------------------------------------- 00060 ! 00061 IF (LHOOK) CALL DR_HOOK('GET_NEAR_MESHES_LONLAT_REG',0,ZHOOK_HANDLE) 00062 CALL GET_GRIDTYPE_LONLAT_REG(PGRID_PAR,KLON=ILON,KLAT=ILAT) 00063 ! 00064 KNEAR (:,:) = 0 00065 ! 00066 IDIST = INT(SQRT(FLOAT(KNEAR_NBR))) 00067 ! 00068 IF (ILON*ILAT==KL) THEN 00069 DO JLAT=1,ILAT 00070 DO JLON=1,ILON 00071 ICOUNT = 0 00072 JL = JLON + ILON * (JLAT-1) 00073 KNEAR(JL,:) = 0 00074 DO JX=-(IDIST-1)/2,IDIST/2 00075 DO JY=-(IDIST-1)/2,IDIST/2 00076 IF (JLON+JX>0 .AND. JLON+JX<ILON+1 .AND. JLAT+JY>0 .AND. JLAT+JY<ILAT+1) THEN 00077 ICOUNT = ICOUNT + 1 00078 KNEAR(JL,ICOUNT) = (JLON+JX) + ILON * (JLAT+JY-1) 00079 END IF 00080 END DO 00081 END DO 00082 END DO 00083 END DO 00084 END IF 00085 IF (LHOOK) CALL DR_HOOK('GET_NEAR_MESHES_LONLAT_REG',1,ZHOOK_HANDLE) 00086 ! 00087 !------------------------------------------------------------------------------- 00088 ! 00089 END SUBROUTINE GET_NEAR_MESHES_LONLAT_REG
1.8.0
