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

Go to the documentation of this file.
00001 !     #########
00002       SUBROUTINE PACK_PGD(HPROGRAM, HSURF,                 &
00003                             HGRID,  PGRID_PAR,               &
00004                             OCOVER, PCOVER, PZS,             &
00005                             PLAT, PLON, PMESH_SIZE, PDIR     )  
00006 !     ##############################################################
00007 !
00008 !!**** *PACK_PGD* packs ISBA physiographic fields from all surface points to ISBA points
00009 !!
00010 !!    PURPOSE
00011 !!    -------
00012 !!
00013 !!    METHOD
00014 !!    ------
00015 !!   
00016 !
00017 !!    EXTERNAL
00018 !!    --------
00019 !!
00020 !!    IMPLICIT ARGUMENTS
00021 !!    ------------------
00022 !!
00023 !!    REFERENCE
00024 !!    ---------
00025 !!
00026 !!    AUTHOR
00027 !!    ------
00028 !!
00029 !!    V. Masson        Meteo-France
00030 !!
00031 !!    MODIFICATION
00032 !!    ------------
00033 !!
00034 !!    Original    03/2004
00035 !!    Escobar J.  08/02/2005 : bug declare ILU local variable
00036 !!
00037 !----------------------------------------------------------------------------
00038 !
00039 !*    0.     DECLARATION
00040 !            -----------
00041 !
00042 USE MODD_PGD_GRID,       ONLY : NL, CGRID, XGRID_PAR
00043 !
00044 USE MODD_DATA_COVER_PAR, ONLY : JPCOVER
00045 !
00046 USE MODI_GET_COVER_n
00047 USE MODI_GET_LCOVER_n
00048 USE MODI_GET_ZS_n
00049 USE MODI_PACK_SAME_RANK
00050 USE MODI_PACK_GRID
00051 USE MODI_LATLON_GRID
00052 !
00053 !
00054 USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
00055 USE PARKIND1  ,ONLY : JPRB
00056 !
00057 USE MODI_GET_SURF_MASK_n
00058 !
00059 USE MODI_GET_TYPE_DIM_n
00060 !
00061 USE MODI_GET_LUOUT
00062 IMPLICIT NONE
00063 !
00064 !*    0.1    Declaration of arguments
00065 !            ------------------------
00066 !
00067  CHARACTER(LEN=6),        INTENT(IN) :: HPROGRAM  ! Type of program
00068  CHARACTER(LEN=6),        INTENT(IN) :: HSURF     ! surface type
00069 !
00070  CHARACTER(LEN=10),       INTENT(OUT):: HGRID     ! grid used
00071 REAL,    DIMENSION(:),   POINTER    :: PGRID_PAR ! grid definition
00072 LOGICAL, DIMENSION(:),   INTENT(OUT):: OCOVER    ! list of present cover
00073 REAL,    DIMENSION(:,:), INTENT(OUT):: PCOVER    ! cover fraction
00074 REAL,    DIMENSION(:),   INTENT(OUT):: PZS       ! zs
00075 REAL,    DIMENSION(:),   INTENT(OUT):: PLAT      ! latitude
00076 REAL,    DIMENSION(:),   INTENT(OUT):: PLON      ! longitude
00077 REAL,    DIMENSION(:),   INTENT(OUT):: PMESH_SIZE! mesh size
00078 REAL,    DIMENSION(:),   INTENT(OUT), OPTIONAL :: PDIR ! angle of grid axis with N.
00079 !
00080 !
00081 !*    0.2    Declaration of local variables
00082 !            ------------------------------
00083 !
00084 INTEGER                        :: ILUOUT ! output listing logical unit
00085 INTEGER                        :: IL     ! number of points
00086 INTEGER                        :: ILU    ! expected physical size of full surface array
00087 INTEGER, DIMENSION(:), POINTER :: IMASK  ! mask for packing from complete field to nature field
00088 REAL,    DIMENSION(SIZE(PLAT)) :: ZDIR
00089 !
00090 REAL, DIMENSION(NL,JPCOVER)    :: ZCOVER ! cover  on all surface points
00091 LOGICAL, DIMENSION(JPCOVER)    :: GCOVER ! list of existing cover
00092 REAL, DIMENSION(NL)            :: ZZS    ! zs     on all surface points
00093 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00094 !-------------------------------------------------------------------------------
00095 !
00096 IF (LHOOK) CALL DR_HOOK('PACK_PGD',0,ZHOOK_HANDLE)
00097  CALL GET_LUOUT(HPROGRAM,ILUOUT)
00098 !
00099 !*    1.      Number of points and packing
00100 !             ----------------------------
00101 !
00102  CALL GET_TYPE_DIM_n(HSURF,IL)
00103 ALLOCATE(IMASK(IL))
00104 ILU=0
00105  CALL GET_SURF_MASK_n(HSURF,IL,IMASK,ILU,ILUOUT)
00106 !
00107 !-------------------------------------------------------------------------------
00108 !
00109 !*    2.      Packing of grid
00110 !             ---------------
00111 !
00112  CALL PACK_GRID(IMASK,CGRID,HGRID,XGRID_PAR,PGRID_PAR)
00113 !
00114 !-------------------------------------------------------------------------------
00115 !
00116 !*    3.      Computes geographical quantities
00117 !             --------------------------------
00118 !
00119  CALL LATLON_GRID(HGRID,SIZE(PGRID_PAR),IL,ILUOUT,PGRID_PAR,PLAT,PLON,PMESH_SIZE,ZDIR)
00120 !
00121 IF (PRESENT(PDIR)) PDIR = ZDIR
00122 !
00123 !-------------------------------------------------------------------------------
00124 !
00125 !*    4.      Packing of fields
00126 !             -----------------
00127 !
00128  CALL GET_COVER_n(HPROGRAM,NL,JPCOVER,ZCOVER)
00129  CALL GET_LCOVER_n(HPROGRAM,JPCOVER,GCOVER)
00130  CALL GET_ZS_n(HPROGRAM,NL,ZZS)
00131 !
00132 !- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
00133 !
00134  CALL PACK_SAME_RANK(IMASK,ZCOVER(:,:),PCOVER(:,:))
00135 !
00136 OCOVER=GCOVER
00137 !
00138 !- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
00139 !
00140  CALL PACK_SAME_RANK(IMASK,ZZS(:),PZS(:))
00141 !
00142 !-------------------------------------------------------------------------------
00143 !
00144 DEALLOCATE(IMASK)
00145 IF (LHOOK) CALL DR_HOOK('PACK_PGD',1,ZHOOK_HANDLE)
00146 !
00147 !-------------------------------------------------------------------------------
00148 !
00149 END SUBROUTINE PACK_PGD