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

Go to the documentation of this file.
00001 !     ##############################################################
00002       SUBROUTINE PACK_GRID_CONF_PROJ(KMASK_SIZE,KMASK,KGRID_PAR1,PGRID_PAR1,KGRID_PAR2,OPACK,PGRID_PAR2)
00003 !     ##############################################################
00004 !
00005 !!**** *PACK_GRID_CONF_PROJ* 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_CONF_PROJ
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 REAL                              :: ZRPK     ! projection parameter 
00057 !                                             !   K=1 : stereographic north pole
00058 !                                             ! 0<K<1 : Lambert, north hemisphere
00059 !                                             !   K=0 : Mercator
00060 !                                             !-1<K<0 : Lambert, south hemisphere
00061 !                                             !   K=-1: stereographic south pole
00062 REAL                              :: ZBETA    ! angle between grid and reference longitude
00063 REAL                              :: ZLATOR   ! latitude  of point of coordinates X=0, Y=0
00064 REAL                              :: ZLONOR   ! longitude of point of coordinates X=0, Y=0
00065 INTEGER                           :: IIMAX    ! number of points in I direction
00066 INTEGER                           :: IJMAX    ! number of points in J direction
00067 REAL, DIMENSION(:), ALLOCATABLE   :: ZX1      ! X conformal coordinate of grid mesh
00068 REAL, DIMENSION(:), ALLOCATABLE   :: ZY1      ! Y conformal coordinate of grid mesh
00069 REAL, DIMENSION(:), ALLOCATABLE   :: ZDX1     ! X grid mesh size
00070 REAL, DIMENSION(:), ALLOCATABLE   :: ZDY1     ! Y grid mesh size
00071 REAL, DIMENSION(:), ALLOCATABLE   :: ZX2      ! X conformal coordinate of grid mesh
00072 REAL, DIMENSION(:), ALLOCATABLE   :: ZY2      ! Y conformal coordinate of grid mesh
00073 REAL, DIMENSION(:), ALLOCATABLE   :: ZDX2     ! X grid mesh size
00074 REAL, DIMENSION(:), ALLOCATABLE   :: ZDY2     ! Y grid mesh size
00075 
00076 INTEGER                           :: IL1        ! number of points of input grid
00077 REAL, DIMENSION(:), POINTER       :: ZGRID_PAR2 ! parameters of output grid
00078 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00079 !----------------------------------------------------------------------------
00080 !
00081 !*    2.     Computes grid parameters
00082 !            ------------------------
00083 !
00084 IF (LHOOK) CALL DR_HOOK('PACK_GRID_CONF_PROJ',0,ZHOOK_HANDLE)
00085  CALL GET_GRIDTYPE_CONF_PROJ(PGRID_PAR1,KL=IL1)
00086 !
00087 ALLOCATE(ZX1 (IL1))
00088 ALLOCATE(ZY1 (IL1))
00089 ALLOCATE(ZDX1(IL1))
00090 ALLOCATE(ZDY1(IL1))
00091 !
00092  CALL GET_GRIDTYPE_CONF_PROJ(PGRID_PAR1,ZLAT0,ZLON0,ZRPK,ZBETA,&
00093                               ZLATOR,ZLONOR,IIMAX,IJMAX,        &
00094                               ZX1,ZY1,ZDX1,ZDY1                 )  
00095 !
00096 ALLOCATE(ZX2 (KMASK_SIZE))
00097 ALLOCATE(ZY2 (KMASK_SIZE))
00098 ALLOCATE(ZDX2(KMASK_SIZE))
00099 ALLOCATE(ZDY2(KMASK_SIZE))
00100 !
00101  CALL PACK_SAME_RANK(KMASK,ZX1 ,ZX2 )
00102  CALL PACK_SAME_RANK(KMASK,ZY1 ,ZY2 )
00103  CALL PACK_SAME_RANK(KMASK,ZDX1,ZDX2)
00104  CALL PACK_SAME_RANK(KMASK,ZDY1,ZDY2)
00105 !
00106 DEALLOCATE(ZX1 )
00107 DEALLOCATE(ZY1 )
00108 DEALLOCATE(ZDX1)
00109 DEALLOCATE(ZDY1)
00110 !
00111  CALL PUT_GRIDTYPE_CONF_PROJ(ZGRID_PAR2,ZLAT0,ZLON0,ZRPK,ZBETA,&
00112                               ZLATOR,ZLONOR,IIMAX,IJMAX,        &
00113                               ZX2,ZY2,ZDX2,ZDY2                 )  
00114 !
00115 IF (OPACK) THEN
00116   PGRID_PAR2(:) = ZGRID_PAR2(:)
00117 ELSE
00118   KGRID_PAR2    = SIZE(ZGRID_PAR2(:))
00119 END IF
00120 !
00121 DEALLOCATE(ZGRID_PAR2)
00122 DEALLOCATE(ZX2 )
00123 DEALLOCATE(ZY2 )
00124 DEALLOCATE(ZDX2)
00125 DEALLOCATE(ZDY2)
00126 IF (LHOOK) CALL DR_HOOK('PACK_GRID_CONF_PROJ',1,ZHOOK_HANDLE)
00127 !-------------------------------------------------------------------------------
00128 !
00129 END SUBROUTINE PACK_GRID_CONF_PROJ