src/SURFEX/read_isba_canopyn.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_ISBA_CANOPY_n(HPROGRAM)
   7 !     #########################################
   8 !
   9 !!****  *READ_ISBA_CANOPY_n* - reads ISBA 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 !!      E. Martin   01/2012 Add LSBL_COLD_START
  37 !-------------------------------------------------------------------------------
  38 !
  39 !*       0.    DECLARATIONS
  40 !              ------------
  41 !
  42 USE MODD_SURF_PAR,        ONLY : XUNDEF
  43 !
  44 USE MODD_ISBA_n,          ONLY : LCANOPY
  45 USE MODD_ISBA_CANOPY_n,   ONLY : NLVL, XZ, XU, XT, XQ, XTKE, XLMO, XDZ, XZF, XDZF, XP
  46 !
  47 USE MODI_READ_SURF
  48 USE MODI_CANOPY_GRID
  49 USE MODI_GET_TYPE_DIM_n
  50 !
  51 USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
  52 USE PARKIND1  ,ONLY : JPRB
  53 !
  54 IMPLICIT NONE
  55 !
  56 !*       0.1   Declarations of arguments
  57 !              -------------------------
  58 !
  59  CHARACTER(LEN=6),  INTENT(IN)  :: HPROGRAM ! calling program
  60 !
  61 !
  62 !*       0.2   Declarations of local variables
  63 !              -------------------------------
  64 !
  65 !
  66  CHARACTER(LEN=12) :: YRECFM         ! Name of the article to be read
  67  CHARACTER(LEN=3)  :: YREAD
  68 INTEGER :: JLAYER  ! loop counter on layers
  69 INTEGER :: ILU     ! 1D physical dimension
  70 INTEGER :: IRESP   ! Error code after redding
  71 INTEGER :: IVERSION, IBUGFIX  ! surface version
  72 REAL(KIND=JPRB) :: ZHOOK_HANDLE
  73 !-------------------------------------------------------------------------------
  74 !
  75 !* 1D physical dimension
  76 !
  77 IF (LHOOK) CALL DR_HOOK('READ_ISBA_CANOPY_N',0,ZHOOK_HANDLE)
  78 YRECFM='SIZE_NATURE'
  79  CALL GET_TYPE_DIM_n('NATURE',ILU)
  80 !
  81 !
  82 !* flag to use or not canopy levels
  83 !
  84 YRECFM='VERSION'
  85  CALL READ_SURF(HPROGRAM,YRECFM,IVERSION,IRESP)
  86 !
  87 YRECFM='BUG'
  88  CALL READ_SURF(HPROGRAM,YRECFM,IBUGFIX,IRESP)
  89 !
  90 IF (IVERSION<3) THEN
  91   LCANOPY = .FALSE.
  92 ELSE
  93   YRECFM='ISBA_CANOPY'
  94   CALL READ_SURF(HPROGRAM,YRECFM,LCANOPY,IRESP)
  95 END IF
  96 !
  97 IF (.NOT.LCANOPY) THEN
  98   ALLOCATE(XZ  (0,0))
  99   ALLOCATE(XU  (0,0))
 100   ALLOCATE(XT  (0,0))
 101   ALLOCATE(XQ  (0,0))
 102   ALLOCATE(XTKE(0,0))
 103   ALLOCATE(XLMO(0)  )
 104   ALLOCATE(XP  (0,0))
 105   ALLOCATE(XDZ (0,0))
 106   ALLOCATE(XZF (0,0))
 107   ALLOCATE(XDZF(0,0))
 108   IF (LHOOK) CALL DR_HOOK('READ_ISBA_CANOPY_N',1,ZHOOK_HANDLE)
 109   RETURN
 110 ENDIF
 111 !
 112 !* number of vertical levels
 113 !
 114 YRECFM='ISBA_CAN_LVL'
 115  CALL READ_SURF(HPROGRAM,YRECFM,NLVL,IRESP)
 116 !
 117 !*       2.     Prognostic fields:
 118 !               -----------------
 119 !
 120 !* altitudes
 121 !
 122 ALLOCATE(XZ(ILU,NLVL))
 123 !
 124 DO JLAYER=1,NLVL
 125   WRITE(YRECFM,'(A10,I2.2)') 'ISBA_CAN_Z',JLAYER
 126   CALL READ_SURF(HPROGRAM,YRECFM,XZ(:,JLAYER),IRESP)
 127 END DO
 128 !
 129 ALLOCATE(XU  (ILU,NLVL))
 130 ALLOCATE(XT  (ILU,NLVL))
 131 ALLOCATE(XQ  (ILU,NLVL))
 132 ALLOCATE(XTKE(ILU,NLVL))
 133 ALLOCATE(XLMO(ILU)     )
 134 ALLOCATE(XP  (ILU,NLVL))
 135 !
 136 IF (IVERSION>7 .OR. IVERSION==7 .AND.IBUGFIX>=2) THEN
 137   YRECFM='STORAGETYPE'
 138   CALL READ_SURF(HPROGRAM,YRECFM,YREAD,IRESP)
 139 ELSE
 140   YREAD = 'ALL'
 141 ENDIF
 142 !
 143 IF(YREAD=='ALL') THEN
 144   !
 145   !* wind in SBL
 146   DO JLAYER=1,NLVL
 147     WRITE(YRECFM,'(A10,I2.2)') 'ISBA_CAN_U',JLAYER
 148     CALL READ_SURF(HPROGRAM,YRECFM,XU(:,JLAYER),IRESP)
 149   END DO
 150   !
 151   !* theta in SBL
 152   DO JLAYER=1,NLVL
 153     WRITE(YRECFM,'(A10,I2.2)') 'ISBA_CAN_T',JLAYER
 154     CALL READ_SURF(HPROGRAM,YRECFM,XT(:,JLAYER),IRESP)
 155   END DO
 156   !
 157   !* humidity in SBL
 158   DO JLAYER=1,NLVL
 159     WRITE(YRECFM,'(A10,I2.2)') 'ISBA_CAN_Q',JLAYER
 160     CALL READ_SURF(HPROGRAM,YRECFM,XQ(:,JLAYER),IRESP)
 161   END DO
 162   !
 163   !* Tke in SBL
 164   DO JLAYER=1,NLVL
 165     WRITE(YRECFM,'(A10,I2.2)') 'ISBA_CAN_E',JLAYER
 166     CALL READ_SURF(HPROGRAM,YRECFM,XTKE(:,JLAYER),IRESP)
 167   END DO
 168   !
 169   !* Monin-Obhukov length
 170   YRECFM='ISBA_CAN_LMO     '
 171   CALL READ_SURF(HPROGRAM,YRECFM,XLMO(:),IRESP)
 172   !
 173   !* Pressure
 174   DO JLAYER=1,NLVL
 175     WRITE(YRECFM,'(A10,I2.2)') 'ISBA_CAN_P',JLAYER
 176     CALL READ_SURF(HPROGRAM,YRECFM,XP(:,JLAYER),IRESP)
 177   END DO
 178   !
 179 ELSE
 180   XU  (:,:) = XUNDEF
 181   XT  (:,:) = XUNDEF
 182   XQ  (:,:) = XUNDEF
 183   XTKE(:,:) = XUNDEF
 184   XLMO(:)   = XUNDEF
 185   XP  (:,:) = XUNDEF
 186 ENDIF
 187 !
 188 !
 189 !* Grid characteristics
 190 !
 191 !
 192 !  --------------------------------- XZ(k+1)                     XDZ(k+1)
 193 !                                                                           ^
 194 !                                                                           |
 195 !                                                                           |
 196 !  - - - - - - - - - - - - - - - - - XZf(k+1)                               | XDZf(k+1)
 197 !                                                              ^            |
 198 !                                                              |            |
 199 !  --------------------------------- XZ(k), XU, XT, XQ, XTKE   | XDZ(k)     V
 200 !                                                              |            ^
 201 !  - - - - - - - - - - - - - - - - - XZf(k)                    V            | XDZf(k)
 202 !  --------------------------------- XZ(k-1)                     XDZ(k-1)   V
 203 !  - - - - - - - - - - - - - - - - - XZf(k-1)
 204 !
 205 ALLOCATE(XDZ (ILU,NLVL))
 206 ALLOCATE(XZF (ILU,NLVL))
 207 ALLOCATE(XDZF(ILU,NLVL))
 208  CALL CANOPY_GRID(ILU,NLVL,XZ,XZF,XDZ,XDZF)
 209 !
 210 IF (LHOOK) CALL DR_HOOK('READ_ISBA_CANOPY_N',1,ZHOOK_HANDLE)
 211 !
 212 !-------------------------------------------------------------------------------
 213 !
 214 END SUBROUTINE READ_ISBA_CANOPY_n