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

Go to the documentation of this file.
00001 !     #########
00002       SUBROUTINE PACK_PGD_ISBA(HPROGRAM,                                    &
00003                                  PAOSIP, PAOSIM, PAOSJP, PAOSJM,              &
00004                                  PHO2IP, PHO2IM, PHO2JP, PHO2JM,              &
00005                                  PSSO_SLOPE                                   )  
00006 !     ##############################################################
00007 !
00008 !!**** *PACK_PGD_ISBA* 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_ISBA_n,          ONLY :XAOSIP, XAOSIM, XAOSJP, XAOSJM, &
00043                                   XHO2IP, XHO2IM, XHO2JP, XHO2JM, &
00044                                   XSSO_SLOPE  
00045 USE MODD_ISBA_GRID_n,     ONLY : NDIM, CGRID, XGRID_PAR
00046 !
00047 USE MODI_PACK_SAME_RANK
00048 !
00049 USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
00050 USE PARKIND1  ,ONLY : JPRB
00051 !
00052 USE MODI_GET_SURF_MASK_n
00053 !
00054 USE MODI_GET_TYPE_DIM_n
00055 !
00056 USE MODI_GET_LUOUT
00057 IMPLICIT NONE
00058 !
00059 !*    0.1    Declaration of arguments
00060 !            ------------------------
00061 !
00062  CHARACTER(LEN=6),        INTENT(IN) :: HPROGRAM  ! Type of program
00063 REAL,    DIMENSION(:),   INTENT(IN) :: PAOSIP    ! A/S i+ on all surface points
00064 REAL,    DIMENSION(:),   INTENT(IN) :: PAOSIM    ! A/S i- on all surface points
00065 REAL,    DIMENSION(:),   INTENT(IN) :: PAOSJP    ! A/S j+ on all surface points
00066 REAL,    DIMENSION(:),   INTENT(IN) :: PAOSJM    ! A/S j- on all surface points
00067 REAL,    DIMENSION(:),   INTENT(IN) :: PHO2IP    ! h/2 i+ on all surface points
00068 REAL,    DIMENSION(:),   INTENT(IN) :: PHO2IM    ! h/2 i- on all surface points
00069 REAL,    DIMENSION(:),   INTENT(IN) :: PHO2JP    ! h/2 j+ on all surface points
00070 REAL,    DIMENSION(:),   INTENT(IN) :: PHO2JM    ! h/2 j- on all surface points
00071 REAL,    DIMENSION(:),   INTENT(IN) :: PSSO_SLOPE! subgrid slope on all surface points
00072 !
00073 !
00074 !*    0.2    Declaration of local variables
00075 !            ------------------------------
00076 !
00077 INTEGER                        :: ILU    ! expected physical size of full surface array
00078 INTEGER                        :: ILUOUT ! output listing logical unit
00079 INTEGER, DIMENSION(:), POINTER :: IMASK  ! mask for packing from complete field to nature field
00080 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00081 !
00082 !-------------------------------------------------------------------------------
00083 !
00084 IF (LHOOK) CALL DR_HOOK('PACK_PGD_ISBA',0,ZHOOK_HANDLE)
00085  CALL GET_LUOUT(HPROGRAM,ILUOUT)
00086 !
00087 !*    1.      Number of points and packing
00088 !             ----------------------------
00089 !
00090  CALL GET_TYPE_DIM_n('NATURE',NDIM)
00091 ALLOCATE(IMASK(NDIM))
00092 ILU=0
00093  CALL GET_SURF_MASK_n('NATURE',NDIM,IMASK,ILU,ILUOUT)
00094 !
00095 !
00096 !-------------------------------------------------------------------------------
00097 !
00098 !*    2.      Packing of fields
00099 !             -----------------
00100 !
00101 ALLOCATE(XAOSIP(NDIM))
00102 ALLOCATE(XAOSIM(NDIM))
00103 ALLOCATE(XAOSJP(NDIM))
00104 ALLOCATE(XAOSJM(NDIM))
00105 ALLOCATE(XHO2IP(NDIM))
00106 ALLOCATE(XHO2IM(NDIM))
00107 ALLOCATE(XHO2JP(NDIM))
00108 ALLOCATE(XHO2JM(NDIM))
00109 ALLOCATE(XSSO_SLOPE(NDIM))
00110  CALL PACK_SAME_RANK(IMASK,PAOSIP(:),XAOSIP(:))
00111  CALL PACK_SAME_RANK(IMASK,PAOSIM(:),XAOSIM(:))
00112  CALL PACK_SAME_RANK(IMASK,PAOSJP(:),XAOSJP(:))
00113  CALL PACK_SAME_RANK(IMASK,PAOSJM(:),XAOSJM(:))
00114  CALL PACK_SAME_RANK(IMASK,PHO2IP(:),XHO2IP(:))
00115  CALL PACK_SAME_RANK(IMASK,PHO2IM(:),XHO2IM(:))
00116  CALL PACK_SAME_RANK(IMASK,PHO2JP(:),XHO2JP(:))
00117  CALL PACK_SAME_RANK(IMASK,PHO2JM(:),XHO2JM(:))
00118  CALL PACK_SAME_RANK(IMASK,PSSO_SLOPE(:),XSSO_SLOPE(:))
00119 IF (LHOOK) CALL DR_HOOK('PACK_PGD_ISBA',1,ZHOOK_HANDLE)
00120 !
00121 !-------------------------------------------------------------------------------
00122 !
00123 END SUBROUTINE PACK_PGD_ISBA