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

Go to the documentation of this file.
00001 !     ###############################################################
00002       SUBROUTINE GET_MESH_INDEX_GAUSS(KGRID_PAR,KL,PGRID_PAR,PLAT,PLON,KINDEX,KSSO,KISSOX,KISSOY)
00003 !     ###############################################################
00004 !
00005 !!**** *GET_MESH_INDEX_GAUSS* get the grid mesh where point (lat,lon) is located
00006 !!
00007 !!    PURPOSE
00008 !!    -------
00009 !!
00010 !!    AUTHOR
00011 !!    ------
00012 !!
00013 !!    B. Decharme         Meteo-France
00014 !!
00015 !!    MODIFICATION
00016 !!    ------------
00017 !!
00018 !!    Original    02/2010
00019 !!
00020 !----------------------------------------------------------------------------
00021 !
00022 !*    0.     DECLARATION
00023 !            -----------
00024 !
00025 USE MODD_GET_MESH_INDEX_GAUSS, ONLY : IINDEX_1KM,IINDEX_10KM,IINDEX_100KM, &
00026                                         IISSOX_1KM,IISSOX_10KM,IISSOX_100KM, &
00027                                         IISSOY_1KM,IISSOY_10KM,IISSOY_100KM, &
00028                                         IMASK_GAUSS  
00029 !
00030 !
00031 USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
00032 USE PARKIND1  ,ONLY : JPRB
00033 !
00034 USE MODI_ABOR1_SFX
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 REAL,    DIMENSION(KL),        INTENT(IN)    :: PLAT      ! latitude of the point  (degrees)
00045 REAL,    DIMENSION(KL),        INTENT(IN)    :: PLON      ! longitude of the point (degrees)
00046 INTEGER, DIMENSION(KL),        INTENT(OUT)   :: KINDEX    ! index of the grid mesh where the point is
00047 INTEGER,                       INTENT(IN)    :: KSSO      ! number of subgrid mesh in each direction
00048 INTEGER, DIMENSION(KL),        INTENT(OUT)   :: KISSOX    ! X index of the subgrid mesh
00049 INTEGER, DIMENSION(KL),        INTENT(OUT)   :: KISSOY    ! Y index of the subgrid mesh
00050 !
00051 !*    0.2    Declaration of other local variables
00052 !            ------------------------------------
00053 !
00054 INTEGER                           :: JI          ! loop counter in x
00055 INTEGER                           :: JJ          ! loop counter in y
00056 !
00057 INTEGER                           :: INDIM
00058 !
00059 INTEGER, DIMENSION(:), ALLOCATABLE :: IINDEX
00060 INTEGER, DIMENSION(:), ALLOCATABLE :: IISSOX
00061 INTEGER, DIMENSION(:), ALLOCATABLE :: IISSOY
00062 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00063 !
00064 !----------------------------------------------------------------------------
00065 !
00066 IF (LHOOK) CALL DR_HOOK('GET_MESH_INDEX_GAUSS',0,ZHOOK_HANDLE)
00067 INDIM=SIZE(IMASK_GAUSS)
00068 !
00069 ALLOCATE(IINDEX(INDIM))
00070 ALLOCATE(IISSOX(INDIM))
00071 ALLOCATE(IISSOY(INDIM))
00072 !
00073 KINDEX = -999
00074 KISSOX = -999
00075 KISSOY = -999
00076 !
00077 IF (KSSO/=0) THEN
00078 !        
00079    SELECT CASE (INDIM)
00080        CASE (21600*43200)
00081             IINDEX(:) = IINDEX_1KM(:)
00082             IISSOX(:) = IISSOX_1KM(:)
00083             IISSOY(:) = IISSOY_1KM(:)              
00084        CASE (2160*4320)
00085             IINDEX(:) = IINDEX_10KM(:)
00086             IISSOX(:) = IISSOX_10KM(:)
00087             IISSOY(:) = IISSOY_10KM(:)
00088        CASE (216*432)
00089             IINDEX(:) = IINDEX_100KM(:)
00090             IISSOX(:) = IISSOX_100KM(:)
00091             IISSOY(:) = IISSOY_100KM(:)
00092        CASE DEFAULT
00093             CALL ABOR1_SFX('GET_MESH_INDEX_GAUSS: RESOLUTION NOT KNOW')
00094    END SELECT               
00095 !   
00096 ELSE
00097 !
00098    SELECT CASE (INDIM)
00099        CASE (21600*43200)
00100             IINDEX(:) = IINDEX_1KM(:)
00101        CASE (2160*4320)
00102             IINDEX(:) = IINDEX_10KM(:)
00103        CASE (216*432)
00104             IINDEX(:) = IINDEX_100KM(:)
00105        CASE DEFAULT
00106             CALL ABOR1_SFX('GET_MESH_INDEX_GAUSS: RESOLUTION NOT KNOW')
00107    END SELECT               
00108 !   
00109 ENDIF
00110 !
00111 IF(ALL(IMASK_GAUSS(:)==1))THEN
00112 !        
00113   KINDEX=IINDEX
00114   IF(KSSO/=0)THEN
00115     KISSOX=IISSOX
00116     KISSOY=IISSOY
00117   ENDIF
00118 !  
00119 ELSE
00120 !
00121   JJ=0
00122   DO JI=1,INDIM
00123      IF(IMASK_GAUSS(JI)==1)THEN
00124         JJ=JJ+1
00125         KINDEX(JJ)=IINDEX(JI)
00126         IF(KSSO/=0)THEN
00127            KISSOX(JJ)=IISSOX(JI)
00128            KISSOY(JJ)=IISSOY(JI)
00129         ENDIF
00130      ENDIF
00131   ENDDO
00132 ! 
00133 ENDIF
00134 !
00135 DEALLOCATE(IINDEX)
00136 DEALLOCATE(IISSOX)
00137 DEALLOCATE(IISSOY)
00138 IF (LHOOK) CALL DR_HOOK('GET_MESH_INDEX_GAUSS',1,ZHOOK_HANDLE)
00139 !
00140 !-------------------------------------------------------------------------------
00141 !
00142 END SUBROUTINE GET_MESH_INDEX_GAUSS