src/SURFEX/read_pgd_flaken.F90

   1 !SURFEX_LIC Copyright 1994-2014 Meteo-France
   2 !SURFEX_LIC This is part of the SURFEX software governed by the CeCILL-C  licence
   3 !SURFEX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
   4 !SURFEX_LIC for details. version 1.
   5 !     #########
   6       SUBROUTINE READ_PGD_FLAKE_n(HPROGRAM)
   7 !     #########################################
   8 !
   9 !!****  *READ_PGD_FLAKE_n* - read FLAKE physiographic fields
  10 !!
  11 !!
  12 !!    PURPOSE
  13 !!    -------
  14 !!
  15 !!**  METHOD
  16 !!    ------
  17 !!
  18 !!    EXTERNAL
  19 !!    --------
  20 !!
  21 !!
  22 !!    IMPLICIT ARGUMENTS
  23 !!    ------------------
  24 !!
  25 !!    REFERENCE
  26 !!    ---------
  27 !!
  28 !!
  29 !!    AUTHOR
  30 !!    ------
  31 !!      V. Masson   *Meteo France*
  32 !!
  33 !!    MODIFICATIONS
  34 !!    -------------
  35 !!      Original    01/2003
  36 !-------------------------------------------------------------------------------
  37 !
  38 !*       0.    DECLARATIONS
  39 !              ------------
  40 !
  41 USE MODD_TYPE_DATE_SURF
  42 !
  43 USE MODD_DATA_COVER_PAR, ONLY : JPCOVER
  44 USE MODD_FLAKE_n,      ONLY : XCOVER        , XZS           , &
  45                               TTIME         , LCOVER        , &
  46                               XWATER_DEPTH  , XWATER_FETCH  , &
  47                               XT_BS         , XDEPTH_BS     , &
  48                               XEXTCOEF_WATER
  49
  50
  51 USE MODD_FLAKE_GRID_n, ONLY : XLAT, XLON, XMESH_SIZE, CGRID, XGRID_PAR, NDIM
  52 !
  53 USE MODI_READ_SURF
  54 USE MODI_READ_GRID
  55 USE MODI_READ_LCOVER
  56 !
  57 !
  58 USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
  59 USE PARKIND1  ,ONLY : JPRB
  60 !
  61 USE MODI_GET_TYPE_DIM_n
  62 !
  63 IMPLICIT NONE
  64 !
  65 !*       0.1   Declarations of arguments
  66 !              -------------------------
  67 !
  68  CHARACTER(LEN=6),  INTENT(IN)  :: HPROGRAM ! calling program
  69 !
  70 !*       0.2   Declarations of local variables
  71 !              -------------------------------
  72 !
  73 INTEGER           :: IRESP          ! Error code after redding
  74 !
  75  CHARACTER(LEN=LEN_HREC) :: YRECFM         ! Name of the article to be read
  76 !
  77 REAL(KIND=JPRB) :: ZHOOK_HANDLE
  78 !-------------------------------------------------------------------------------
  79 !
  80 !* 1D physical dimension
  81 !
  82 IF (LHOOK) CALL DR_HOOK('READ_PGD_FLAKE_N',0,ZHOOK_HANDLE)
  83 YRECFM='SIZE_WATER'
  84  CALL GET_TYPE_DIM_n('WATER ',NDIM)
  85 !
  86 !
  87 !
  88 !*       2.     Physiographic data fields:
  89 !               -------------------------
  90 !
  91 !* cover classes
  92 !
  93 ALLOCATE(LCOVER(JPCOVER))
  94  CALL READ_LCOVER(HPROGRAM,LCOVER)
  95 !
  96 ALLOCATE(XCOVER(NDIM,JPCOVER))
  97  CALL READ_SURF(HPROGRAM,'COVER',XCOVER(:,:),LCOVER,IRESP)
  98 !
  99 !* orography
 100 !
 101 ALLOCATE(XZS(NDIM))
 102 YRECFM='ZS'
 103  CALL READ_SURF(HPROGRAM,YRECFM,XZS(:),IRESP)
 104 !
 105 !* latitude, longitude
 106 !
 107 ALLOCATE(XLAT      (NDIM))
 108 ALLOCATE(XLON      (NDIM))
 109 ALLOCATE(XMESH_SIZE(NDIM))
 110  CALL READ_GRID(HPROGRAM,CGRID,XGRID_PAR,XLAT,XLON,XMESH_SIZE,IRESP)
 111 !
 112 !* FLake parameters
 113 !
 114 ALLOCATE(XWATER_DEPTH   (NDIM))
 115 YRECFM='WATER_DEPTH'
 116  CALL READ_SURF(HPROGRAM,YRECFM,XWATER_DEPTH(:),IRESP)
 117 !
 118 ALLOCATE(XWATER_FETCH   (NDIM))
 119 YRECFM='WATER_FETCH'
 120  CALL READ_SURF(HPROGRAM,YRECFM,XWATER_FETCH(:),IRESP)
 121 !
 122 ALLOCATE(XT_BS          (NDIM))
 123 YRECFM='T_BS'
 124  CALL READ_SURF(HPROGRAM,YRECFM,XT_BS(:),IRESP)
 125 !
 126 ALLOCATE(XDEPTH_BS      (NDIM))
 127 YRECFM='DEPTH_BS'
 128  CALL READ_SURF(HPROGRAM,YRECFM,XDEPTH_BS(:),IRESP)
 129 !
 130 ALLOCATE(XEXTCOEF_WATER (NDIM))
 131 YRECFM='EXTCOEF_WAT'
 132  CALL READ_SURF(HPROGRAM,YRECFM,XEXTCOEF_WATER(:),IRESP)
 133 !
 134 IF (LHOOK) CALL DR_HOOK('READ_PGD_FLAKE_N',1,ZHOOK_HANDLE)
 135 !-------------------------------------------------------------------------------
 136 !
 137 END SUBROUTINE READ_PGD_FLAKE_n