src/SURFEX/read_isban.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_n(HPROGRAM)
   7 !     ##################################
   8 !
   9 !!****  *READ_ISBA_n* - routine to initialise ISBA variables
  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 !!      READ_SURF for general reading : 08/2003 (S.Malardel)
  38 !!      B. Decharme  2008    : Floodplains
  39 !!      B. Decharme  01/2009 : Optional Arpege deep soil temperature read
  40 !!      A.L. Gibelin   03/09 : modifications for CENTURY model
  41 !!      A.L. Gibelin    04/2009 : BIOMASS and RESP_BIOMASS arrays
  42 !!      A.L. Gibelin    06/2009 : Soil carbon variables for CNT option
  43 !!      B. Decharme  09/2012 : suppress NWG_LAYER (parallelization problems)
  44 !!     M.Moge    01/2016  using READ_SURF_FIELD2D/3D for 2D/3D surfex fields reads
  45 !!
  46 !-------------------------------------------------------------------------------
  47 !
  48 !*       0.    DECLARATIONS
  49 !              ------------
  50 !
  51 !
  52 USE MODD_CO2V_PAR,       ONLY : XANFMINIT, XCONDCTMIN
  53 USE MODD_ISBA_n,         ONLY : NGROUND_LAYER, NPATCH, NNBIOMASS,   &
  54                                   NNLITTER, NNLITTLEVS, NNSOILCARB,   &
  55                                   CPHOTO, CRESPSL, XTSRAD_NAT,        &
  56                                   XTG, XWG, XWGI, XWR, XLAI, TSNOW,   &
  57                                   XRESA, XANFM, XAN, XLE, XANDAY,     &
  58                                   XBSLAI, XBIOMASS, XRESP_BIOMASS,    &
  59                                   XLITTER, XSOILCARB, XLIGNIN_STRUC,  &
  60                                   LFLOOD, XZ0_FLOOD, LTEMP_ARP,       &
  61                                   NTEMPLAYER_ARP, LGLACIER, XICE_STO
  62 !
  63 USE MODD_SURF_PAR,       ONLY : XUNDEF, NUNDEF
  64 USE MODD_SNOW_PAR,       ONLY : XZ0SN
  65 !
  66 USE MODI_READ_SURF
  67 USE MODI_READ_SURF_FIELD3D
  68 USE MODI_READ_SURF_FIELD2D
  69 !
  70 USE MODI_READ_GR_SNOW
  71 !
  72 USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
  73 USE PARKIND1  ,ONLY : JPRB
  74 !
  75 USE MODI_GET_TYPE_DIM_n
  76 !
  77 IMPLICIT NONE
  78 !
  79 !*       0.1   Declarations of arguments
  80 !              -------------------------
  81 !
  82  CHARACTER(LEN=6),  INTENT(IN)  :: HPROGRAM ! calling program
  83 !
  84 !*       0.2   Declarations of local variables
  85 !              -------------------------------
  86 INTEGER           :: ILU          ! 1D physical dimension
  87 !
  88 INTEGER           :: IRESP          ! Error code after redding
  89 !
  90  CHARACTER(LEN=LEN_HREC) :: YRECFM         ! Name of the article to be read
  91 !
  92  CHARACTER(LEN=4)  :: YLVL
  93  CHARACTER(LEN=8)  :: YPATCH
  94 !
  95 REAL, DIMENSION(:,:),ALLOCATABLE  :: ZWORK      ! 2D array to write data in file
  96 !
  97 INTEGER :: IWORK   ! Work integer
  98 !
  99 INTEGER :: JP, JL, JNBIOMASS, JNLITTER, JNSOILCARB, JNLITTLEVS  ! loop counter on layers
 100 !
 101 INTEGER           :: IVERSION       ! surface version
 102 INTEGER           :: IBUGFIX
 103 !
 104 REAL(KIND=JPRB) :: ZHOOK_HANDLE
 105 !
 106 !-------------------------------------------------------------------------------
 107 !
 108 !
 109 !* 1D physical dimension
 110 !
 111 IF (LHOOK) CALL DR_HOOK('READ_ISBA_N',0,ZHOOK_HANDLE)
 112 YRECFM='SIZE_NATURE'
 113  CALL GET_TYPE_DIM_n('NATURE',ILU)
 114 !
 115 !
 116 !*       2.     Prognostic fields:
 117 !               -----------------
 118 !
 119 ALLOCATE(ZWORK(ILU,NPATCH))
 120 !* soil temperatures
 121 !
 122 IF(LTEMP_ARP)THEN
 123   IWORK=NTEMPLAYER_ARP
 124 ELSE
 125   IWORK=NGROUND_LAYER
 126 ENDIF
 127 !
 128 ALLOCATE(XTG(ILU,IWORK,NPATCH))
 129 !
 130 YRECFM='TG'
 131 CALL READ_SURF_FIELD3D(HPROGRAM,XTG,1,IWORK,YRECFM)
 132 !
 133 !
 134 !* soil liquid and ice water contents
 135 !
 136 ALLOCATE(XWG (ILU,NGROUND_LAYER,NPATCH))
 137 ALLOCATE(XWGI(ILU,NGROUND_LAYER,NPATCH))
 138 !
 139 XWG (:,:,:)=XUNDEF
 140 XWGI(:,:,:)=XUNDEF
 141 !
 142 YRECFM='WG'
 143 CALL READ_SURF_FIELD3D(HPROGRAM,XWG,1,NGROUND_LAYER,YRECFM)
 144 !
 145 YRECFM='WGI'
 146 CALL READ_SURF_FIELD3D(HPROGRAM,XWGI,1,NGROUND_LAYER,YRECFM)
 147 !
 148 !* water intercepted on leaves
 149 !
 150 ALLOCATE(XWR(ILU,NPATCH))
 151 !
 152 YRECFM='WR'
 153 CALL READ_SURF_FIELD2D(HPROGRAM,XWR,YRECFM)
 154 !
 155 !* roughness length of Flood water
 156 !
 157 IF(LFLOOD)THEN
 158   ALLOCATE(XZ0_FLOOD(ILU,NPATCH))
 159   YRECFM = 'Z0_FLOOD'
 160   CALL READ_SURF_FIELD2D(HPROGRAM,XZ0_FLOOD,YRECFM)
 161 ENDIF
 162 !
 163 !* Leaf Area Index
 164 !
 165 IF (CPHOTO=='LAI' .OR. CPHOTO=='LST' .OR. CPHOTO=='NIT' .OR. CPHOTO=='NCB') THEN
 166   YRECFM = 'LAI'
 167   CALL READ_SURF_FIELD2D(HPROGRAM,XLAI,YRECFM)
 168 END IF
 169 !
 170 !* snow mantel
 171 !
 172  CALL READ_GR_SNOW(HPROGRAM,'VEG','     ',ILU,NPATCH,TSNOW  )
 173 !
 174 YRECFM='VERSION'
 175  CALL READ_SURF(HPROGRAM,YRECFM,IVERSION,IRESP)
 176 !
 177 YRECFM='BUG'
 178  CALL READ_SURF(HPROGRAM,YRECFM,IBUGFIX,IRESP)
 179 !
 180 IF(LGLACIER)THEN
 181   ALLOCATE(XICE_STO(ILU,NPATCH))
 182   IF (IVERSION>7 .OR. IVERSION==7 .AND. IBUGFIX>=2) THEN
 183     YRECFM = 'ICE_STO'
 184     CALL READ_SURF_FIELD2D(HPROGRAM,XICE_STO,YRECFM)
 185   ELSE
 186     XICE_STO(:,:) = 0.0
 187   ENDIF
 188 ENDIF
 189 !
 190 !-------------------------------------------------------------------------------
 191 !
 192 !*       4.  Semi-prognostic variables
 193 !            -------------------------
 194 !
 195 ALLOCATE(XRESA(ILU,NPATCH))
 196 ALLOCATE(XLE  (ILU,NPATCH))
 197 IF (CPHOTO/='NON') THEN
 198   ALLOCATE(XANFM  (ILU,NPATCH))
 199   ALLOCATE(XAN    (ILU,NPATCH))
 200   ALLOCATE(XANDAY (ILU,NPATCH))
 201 END IF
 202 !
 203 IF(CPHOTO/='NON') THEN
 204   ALLOCATE(XBIOMASS         (ILU,NNBIOMASS,NPATCH))
 205   ALLOCATE(XRESP_BIOMASS    (ILU,NNBIOMASS,NPATCH))
 206 END IF
 207 !
 208 !
 209 !* aerodynamical resistance
 210 !
 211 YRECFM = 'RESA'
 212 XRESA(:,:) = 100.
 213 CALL READ_SURF_FIELD2D(HPROGRAM,XRESA,YRECFM)
 214 !
 215 !* patch averaged radiative temperature (K)
 216 !
 217 ALLOCATE(XTSRAD_NAT(ILU))
 218 IF (IVERSION<6) THEN
 219   XTSRAD_NAT(:)=0.
 220   DO JP=1,NPATCH
 221     XTSRAD_NAT(:)=XTSRAD_NAT(:)+XTG(:,1,JP)
 222   ENDDO
 223   XTSRAD_NAT(:)=XTSRAD_NAT(:)/NPATCH
 224 ELSE
 225   YRECFM='TSRAD_NAT'
 226   CALL READ_SURF(HPROGRAM,YRECFM,XTSRAD_NAT(:),IRESP)
 227 ENDIF
 228 !
 229 XLE(:,:) = XUNDEF
 230 !
 231 !*       5. ISBA-AGS variables
 232 !
 233 IF (CPHOTO/='NON') THEN
 234   YRECFM = 'AN'
 235   XAN(:,:) = 0.
 236   CALL READ_SURF_FIELD2D(HPROGRAM,XAN,YRECFM)
 237   !
 238   YRECFM = 'ANDAY'
 239   XANDAY(:,:) = 0.
 240   CALL READ_SURF_FIELD2D(HPROGRAM,XANDAY,YRECFM)
 241   !
 242   YRECFM = 'ANFM'
 243   XANFM(:,:) = XANFMINIT
 244   CALL READ_SURF_FIELD2D(HPROGRAM,XANFM,YRECFM)
 245   !
 246   YRECFM = 'LE_AGS'
 247   XLE(:,:) = 0.
 248   CALL READ_SURF_FIELD2D(HPROGRAM,XLE,YRECFM)
 249 END IF
 250 !
 251 IF (CPHOTO=='AGS' .OR. CPHOTO=='AST') THEN
 252   !
 253   XBIOMASS(:,:,:) = 0.
 254   XRESP_BIOMASS(:,:,:) = 0.
 255
 256 ELSEIF (CPHOTO=='LAI' .OR. CPHOTO=='LST') THEN
 257   !
 258   XBIOMASS(:,1,:) = XBSLAI(:,:) * XLAI(:,:)
 259   XRESP_BIOMASS(:,:,:) = 0.
 260
 261 ELSEIF (CPHOTO=='NIT') THEN
 262   !
 263   XBIOMASS(:,:,:) = 0.
 264   IF (IVERSION>7 .OR. IVERSION==7 .AND. IBUGFIX>=3) THEN
 265     YRECFM='BIOMA'
 266   ELSE
 267     YRECFM='BIOMASS'
 268   ENDIF
 269   CALL READ_SURF_FIELD3D(HPROGRAM,XBIOMASS,1,NNBIOMASS,YRECFM)
 270   !
 271   XRESP_BIOMASS(:,:,:) = 0.
 272   IF (IVERSION>7 .OR. IVERSION==7 .AND. IBUGFIX>=3) THEN
 273     YRECFM='RESPI'
 274   ELSE
 275     YRECFM='RESP_BIOM'
 276   ENDIF
 277   CALL READ_SURF_FIELD3D(HPROGRAM,XRESP_BIOMASS,2,NNBIOMASS,YRECFM)
 278   !
 279 ELSEIF (CPHOTO=='NCB') THEN
 280   !
 281   XBIOMASS(:,:,:) = 0.
 282   IF (IVERSION>7 .OR. IVERSION==7 .AND. IBUGFIX>=3) THEN
 283     YRECFM='BIOMA'
 284   ELSE
 285     YRECFM='BIOMASS'
 286   ENDIF
 287   CALL READ_SURF_FIELD3D(HPROGRAM,XBIOMASS,1,NNBIOMASS,YRECFM)
 288   !
 289   XRESP_BIOMASS(:,:,:) = 0.
 290   IF (IVERSION>7 .OR. IVERSION==7 .AND. IBUGFIX>=3) THEN
 291     YRECFM='RESPI'
 292   ELSE
 293     YRECFM='RESP_BIOM'
 294   ENDIF
 295   CALL READ_SURF_FIELD3D(HPROGRAM,XRESP_BIOMASS,2,NNBIOMASS-2,YRECFM)
 296   !
 297 ENDIF
 298 !
 299 !*       6. Soil carbon
 300 !
 301 !
 302 IF (CRESPSL=='CNT') THEN
 303   ALLOCATE(XLITTER          (ILU,NNLITTER,NNLITTLEVS,NPATCH))
 304   ALLOCATE(XSOILCARB        (ILU,NNSOILCARB,NPATCH))
 305   ALLOCATE(XLIGNIN_STRUC    (ILU,NNLITTLEVS,NPATCH))
 306 END IF
 307 !
 308 IF (CRESPSL=='CNT') THEN
 309   !
 310   XLITTER(:,:,:,:) = 0.
 311   DO JNLITTER=1,NNLITTER
 312     DO JNLITTLEVS=1,NNLITTLEVS
 313       WRITE(YLVL,'(I1,A1,I1)') JNLITTER,'_',JNLITTLEVS
 314       YRECFM='LITTER'//ADJUSTL(YLVL(:LEN_TRIM(YLVL)))
 315       CALL READ_SURF_FIELD2D(HPROGRAM,ZWORK(:,:),YRECFM)
 316       XLITTER(:,JNLITTER,JNLITTLEVS,:)=ZWORK
 317     END DO
 318   END DO
 319
 320   XSOILCARB(:,:,:) = 0.
 321   YRECFM='SOILCARB'
 322   CALL READ_SURF_FIELD3D(HPROGRAM,XSOILCARB,1,NNSOILCARB,YRECFM)
 323 !
 324   XLIGNIN_STRUC(:,:,:) = 0.
 325   YRECFM='LIGNIN_STR'
 326   CALL READ_SURF_FIELD3D(HPROGRAM,XLIGNIN_STRUC,1,NNLITTLEVS,YRECFM)
 327 !
 328 ENDIF
 329 !
 330 !
 331 DEALLOCATE(ZWORK)
 332 IF (LHOOK) CALL DR_HOOK('READ_ISBA_N',1,ZHOOK_HANDLE)
 333 !
 334 !-------------------------------------------------------------------------------
 335 !
 336 END SUBROUTINE READ_ISBA_n