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

Go to the documentation of this file.
00001 !     ##############################################################
00002       SUBROUTINE PACK_GRID_CARTESIAN(KMASK_SIZE,KMASK,KGRID_PAR1,PGRID_PAR1,KGRID_PAR2,OPACK,PGRID_PAR2)
00003 !     ##############################################################
00004 !
00005 !!**** *PACK_GRID_CARTESIAN* packs the grid definition vector
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 MODI_PACK_SAME_RANK
00032 USE MODE_GRIDTYPE_CARTESIAN
00033 !
00034 !
00035 USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
00036 USE PARKIND1  ,ONLY : JPRB
00037 !
00038 IMPLICIT NONE
00039 !
00040 !*    0.1    Declaration of arguments
00041 !            ------------------------
00042 !
00043 INTEGER,                        INTENT(IN)    :: KMASK_SIZE ! size of mask
00044 INTEGER, DIMENSION(KMASK_SIZE), INTENT(IN)    :: KMASK      ! mask used
00045 INTEGER,                        INTENT(IN)    :: KGRID_PAR1 ! size of input grid vector
00046 REAL,    DIMENSION(KGRID_PAR1), INTENT(IN)    :: PGRID_PAR1 ! parameters of input grid
00047 INTEGER,                        INTENT(INOUT) :: KGRID_PAR2 ! size of output grid vector
00048 LOGICAL,                        INTENT(IN)    :: OPACK      ! flag to pack the grid vector
00049 REAL,    DIMENSION(KGRID_PAR2), INTENT(OUT)   :: PGRID_PAR2 ! parameters of output grid
00050 !
00051 !*    0.2    Declaration of other local variables
00052 !            ------------------------------------
00053 !
00054 REAL                              :: ZLAT0    ! reference latitude
00055 REAL                              :: ZLON0    ! reference longitude
00056 INTEGER                           :: IIMAX    ! number of points in I direction
00057 INTEGER                           :: IJMAX    ! number of points in J direction
00058 REAL, DIMENSION(:), ALLOCATABLE   :: ZX1      ! X conformal coordinate of grid mesh
00059 REAL, DIMENSION(:), ALLOCATABLE   :: ZY1      ! Y conformal coordinate of grid mesh
00060 REAL, DIMENSION(:), ALLOCATABLE   :: ZDX1     ! X grid mesh size
00061 REAL, DIMENSION(:), ALLOCATABLE   :: ZDY1     ! Y grid mesh size
00062 REAL, DIMENSION(:), ALLOCATABLE   :: ZX2      ! X conformal coordinate of grid mesh
00063 REAL, DIMENSION(:), ALLOCATABLE   :: ZY2      ! Y conformal coordinate of grid mesh
00064 REAL, DIMENSION(:), ALLOCATABLE   :: ZDX2     ! X grid mesh size
00065 REAL, DIMENSION(:), ALLOCATABLE   :: ZDY2     ! Y grid mesh size
00066 
00067 INTEGER                           :: IL1        ! number of points of input grid
00068 REAL, DIMENSION(:), POINTER       :: ZGRID_PAR2 ! parameters of output grid
00069 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00070 !----------------------------------------------------------------------------
00071 !
00072 !*    2.     Computes grid parameters
00073 !            ------------------------
00074 !
00075 IF (LHOOK) CALL DR_HOOK('PACK_GRID_CARTESIAN',0,ZHOOK_HANDLE)
00076  CALL GET_GRIDTYPE_CARTESIAN(PGRID_PAR1,KL=IL1)
00077 !
00078 ALLOCATE(ZX1 (IL1))
00079 ALLOCATE(ZY1 (IL1))
00080 ALLOCATE(ZDX1(IL1))
00081 ALLOCATE(ZDY1(IL1))
00082 !
00083  CALL GET_GRIDTYPE_CARTESIAN(PGRID_PAR1,ZLAT0,ZLON0,           &
00084                               IIMAX,IJMAX,                      &
00085                               ZX1,ZY1,ZDX1,ZDY1                 )  
00086 !
00087 ALLOCATE(ZX2 (KMASK_SIZE))
00088 ALLOCATE(ZY2 (KMASK_SIZE))
00089 ALLOCATE(ZDX2(KMASK_SIZE))
00090 ALLOCATE(ZDY2(KMASK_SIZE))
00091 !
00092  CALL PACK_SAME_RANK(KMASK,ZX1 ,ZX2 )
00093  CALL PACK_SAME_RANK(KMASK,ZY1 ,ZY2 )
00094  CALL PACK_SAME_RANK(KMASK,ZDX1,ZDX2)
00095  CALL PACK_SAME_RANK(KMASK,ZDY1,ZDY2)
00096 !
00097 DEALLOCATE(ZX1 )
00098 DEALLOCATE(ZY1 )
00099 DEALLOCATE(ZDX1)
00100 DEALLOCATE(ZDY1)
00101 !
00102  CALL PUT_GRIDTYPE_CARTESIAN(ZGRID_PAR2,ZLAT0,ZLON0,           &
00103                               IIMAX,IJMAX,                      &
00104                               ZX2,ZY2,ZDX2,ZDY2                 )  
00105 !
00106 IF (OPACK) THEN
00107   PGRID_PAR2(:) = ZGRID_PAR2(:)
00108 ELSE
00109   KGRID_PAR2    = SIZE(ZGRID_PAR2(:))
00110 END IF
00111 !
00112 DEALLOCATE(ZGRID_PAR2)
00113 DEALLOCATE(ZX2 )
00114 DEALLOCATE(ZY2 )
00115 DEALLOCATE(ZDX2)
00116 DEALLOCATE(ZDY2)
00117 IF (LHOOK) CALL DR_HOOK('PACK_GRID_CARTESIAN',1,ZHOOK_HANDLE)
00118 !-------------------------------------------------------------------------------
00119 !
00120 END SUBROUTINE PACK_GRID_CARTESIAN