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

Go to the documentation of this file.
00001 !     #########
00002       SUBROUTINE PACK_GRID(KMASK,HGRID1,HGRID2,PGRID_PAR1,PGRID_PAR2)
00003 !     ##############################################################
00004 !
00005 !!**** *PACK_GRID* 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 !
00032 USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
00033 USE PARKIND1  ,ONLY : JPRB
00034 !
00035 USE MODI_ABOR1_SFX
00036 !
00037 USE MODI_PACK_GRID_CARTESIAN
00038 !
00039 USE MODI_PACK_GRID_CONF_PROJ
00040 !
00041 USE MODI_PACK_GRID_GAUSS
00042 !
00043 USE MODI_PACK_GRID_IGN
00044 !
00045 USE MODI_PACK_GRID_LONLAT_REG
00046 !
00047 USE MODI_PACK_GRID_LONLATVAL
00048 IMPLICIT NONE
00049 !
00050 !*    0.1    Declaration of arguments
00051 !            ------------------------
00052 !
00053 INTEGER, DIMENSION(:), INTENT(IN) :: KMASK      ! mask used
00054  CHARACTER(LEN=10),     INTENT(IN) :: HGRID1     ! input grid type
00055  CHARACTER(LEN=10),     INTENT(OUT):: HGRID2     ! output grid type
00056 REAL,    DIMENSION(:), POINTER    :: PGRID_PAR1 ! parameters of input grid
00057 REAL,    DIMENSION(:), POINTER    :: PGRID_PAR2 ! parameters of output packed grid
00058 !
00059 !*    0.2    Declaration of other local variables
00060 !            ------------------------------------
00061 !
00062 INTEGER :: KGRID_PAR2 ! size of packed grid vector
00063 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00064 !
00065 !----------------------------------------------------------------------------
00066 !
00067 !*    1.     Chooses grid type
00068 !            -----------------
00069 !
00070 IF (LHOOK) CALL DR_HOOK('PACK_GRID',0,ZHOOK_HANDLE)
00071 HGRID2 = HGRID1
00072 !
00073 !
00074 !*    2.     Computes grid parameters
00075 !            ------------------------
00076 !
00077 SELECT CASE (HGRID1)
00078 !     
00079   CASE("CONF PROJ ","LONLAT REG","CARTESIAN","GAUSS     ","IGN       ","LONLATVAL ")
00080     !
00081     !
00082     KGRID_PAR2 = 0
00083     ALLOCATE(PGRID_PAR2(0))
00084     IF (HGRID1=="CONF PROJ ") &
00085       CALL PACK_GRID_CONF_PROJ(SIZE(KMASK),KMASK,SIZE(PGRID_PAR1),PGRID_PAR1,KGRID_PAR2,.FALSE.,PGRID_PAR2)  
00086     IF (HGRID1=="CARTESIAN ") &
00087       CALL PACK_GRID_CARTESIAN(SIZE(KMASK),KMASK,SIZE(PGRID_PAR1),PGRID_PAR1,KGRID_PAR2,.FALSE.,PGRID_PAR2)  
00088     IF (HGRID1=="LONLAT REG") &
00089       CALL PACK_GRID_LONLAT_REG(SIZE(KMASK),KMASK,SIZE(PGRID_PAR1),PGRID_PAR1,KGRID_PAR2,.FALSE.,PGRID_PAR2)  
00090     IF (HGRID1=="GAUSS     ") &
00091       CALL PACK_GRID_GAUSS(SIZE(KMASK),KMASK,SIZE(PGRID_PAR1),PGRID_PAR1,KGRID_PAR2,.FALSE.,PGRID_PAR2)  
00092     IF (HGRID1=="IGN       ") &
00093       CALL PACK_GRID_IGN(SIZE(KMASK),KMASK,SIZE(PGRID_PAR1),PGRID_PAR1,KGRID_PAR2,.FALSE.,PGRID_PAR2)  
00094     IF (HGRID1=="LONLATVAL ") &
00095       CALL PACK_GRID_LONLATVAL(SIZE(KMASK),KMASK,SIZE(PGRID_PAR1),PGRID_PAR1,KGRID_PAR2,.FALSE.,PGRID_PAR2)  
00096     
00097     DEALLOCATE(PGRID_PAR2)
00098     !
00099     ALLOCATE(PGRID_PAR2(KGRID_PAR2))
00100     IF (HGRID1=="CONF PROJ ") &
00101       CALL PACK_GRID_CONF_PROJ(SIZE(KMASK),KMASK,SIZE(PGRID_PAR1),PGRID_PAR1,KGRID_PAR2,.TRUE.,PGRID_PAR2)  
00102     IF (HGRID1=="CARTESIAN ") &
00103       CALL PACK_GRID_CARTESIAN(SIZE(KMASK),KMASK,SIZE(PGRID_PAR1),PGRID_PAR1,KGRID_PAR2,.TRUE.,PGRID_PAR2)  
00104     IF (HGRID1=="LONLAT REG") &
00105       CALL PACK_GRID_LONLAT_REG(SIZE(KMASK),KMASK,SIZE(PGRID_PAR1),PGRID_PAR1,KGRID_PAR2,.TRUE.,PGRID_PAR2)  
00106     IF (HGRID1=="GAUSS     ") &
00107       CALL PACK_GRID_GAUSS(SIZE(KMASK),KMASK,SIZE(PGRID_PAR1),PGRID_PAR1,KGRID_PAR2,.TRUE.,PGRID_PAR2)  
00108     IF (HGRID1=="IGN       ") &
00109       CALL PACK_GRID_IGN(SIZE(KMASK),KMASK,SIZE(PGRID_PAR1),PGRID_PAR1,KGRID_PAR2,.TRUE.,PGRID_PAR2)  
00110     IF (HGRID1=="LONLATVAL ") &
00111       CALL PACK_GRID_LONLATVAL(SIZE(KMASK),KMASK,SIZE(PGRID_PAR1),PGRID_PAR1,KGRID_PAR2,.TRUE.,PGRID_PAR2)  
00112     !
00113   CASE DEFAULT
00114     CALL ABOR1_SFX('PACK_GRID: GRID TYPE NOT SUPPORTED '//HGRID1)
00115 
00116 END SELECT
00117 IF (LHOOK) CALL DR_HOOK('PACK_GRID',1,ZHOOK_HANDLE)
00118 !
00119 !-------------------------------------------------------------------------------
00120 !
00121 END SUBROUTINE PACK_GRID