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

Go to the documentation of this file.
00001 !     #########
00002       SUBROUTINE GET_ADJ_MES_GAUSS(KGRID_PAR,KL,PGRID_PAR,KLEFT,KRIGHT,KTOP,KBOTTOM)
00003 !     ##############################################################
00004 !
00005 !!**** *GET_ADJACENT_MESHES_GAUSS* 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_GAUSS
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 REAL,    DIMENSION(KGRID_PAR),   INTENT(IN)    :: PGRID_PAR ! grid parameters
00045 INTEGER, DIMENSION(KL),          INTENT(OUT)   :: KLEFT     ! left   mesh index
00046 INTEGER, DIMENSION(KL),          INTENT(OUT)   :: KRIGHT    ! right  mesh index
00047 INTEGER, DIMENSION(KL),          INTENT(OUT)   :: KTOP      ! top    mesh index
00048 INTEGER, DIMENSION(KL),          INTENT(OUT)   :: KBOTTOM   ! bottom mesh index
00049 !
00050 !*    0.2    Declaration of other local variables
00051 !            ------------------------------------
00052 !
00053 INTEGER :: INLATI   ! number of pseudo-latitudes
00054 REAL    :: ZLAPO    ! latitude of the rotated pole (deg)
00055 REAL    :: ZLOPO    ! logitude of the rotated pole (deg)
00056 REAL    :: ZCODIL   ! stretching factor
00057 INTEGER, DIMENSION(:),ALLOCATABLE :: INLOPA ! number of pseudo-longitudes
00058 !                                           ! on each pseudo-latitude circle
00059 !                                           ! on pseudo-northern hemisphere
00060 !                                           ! (starting from the rotated pole)
00061 !
00062 INTEGER :: JLAT, JLON, IL, JL
00063 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00064 !
00065 !----------------------------------------------------------------------------
00066 !
00067 IF (LHOOK) CALL DR_HOOK('GET_ADJ_MES_GAUSS',0,ZHOOK_HANDLE)
00068  CALL GET_GRIDTYPE_GAUSS(PGRID_PAR,INLATI,ZLAPO,ZLOPO,ZCODIL)
00069 !
00070 ALLOCATE(INLOPA(INLATI))
00071 !
00072  CALL GET_GRIDTYPE_GAUSS(PGRID_PAR,INLATI,ZLAPO,ZLOPO,ZCODIL,INLOPA)
00073 !
00074 KLEFT  (:) = 0
00075 KRIGHT (:) = 0
00076 KTOP   (:) = 0
00077 KBOTTOM(:) = 0
00078 !
00079 IL=0
00080 DO JLAT=1,INLATI
00081    DO JLON=1,INLOPA(JLAT)
00082       IL=IL+1
00083    ENDDO
00084 ENDDO
00085 !
00086 JL = 0.0
00087 IF (IL==KL) THEN
00088   DO JLAT=1,INLATI
00089     DO JLON=1,INLOPA(JLAT)
00090       JL = JL + 1
00091       IF (JLON>1            ) KLEFT  (JL) = JL-1
00092       IF (JLON<INLOPA(JLAT) ) KRIGHT (JL) = JL+1
00093       IF (JLAT>1            ) KBOTTOM(JL) = JL-INLOPA(JLAT-1)
00094       IF (JLAT<INLATI       ) KTOP   (JL) = JL+INLOPA(JLAT)
00095       IF (JLON==1           ) KLEFT  (JL) = JL+INLOPA(JLAT)-1
00096       IF (JLON==INLOPA(JLAT)) KRIGHT (JL) = JL-INLOPA(JLAT)+1
00097     END DO
00098   END DO
00099 END IF
00100 !
00101 DEALLOCATE(INLOPA)
00102 IF (LHOOK) CALL DR_HOOK('GET_ADJ_MES_GAUSS',1,ZHOOK_HANDLE)
00103 !
00104 !-------------------------------------------------------------------------------
00105 !
00106 END SUBROUTINE GET_ADJ_MES_GAUSS