src/SURFEX/zoom_pgd_teb.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 ZOOM_PGD_TEB(HPROGRAM,HINIFILE,HINIFILETYPE,OECOCLIMAP,OGARDEN)
   7 !     ###########################################################
   8
   9 !!
  10 !!    PURPOSE
  11 !!    -------
  12 !!   This program prepares the physiographic data fields.
  13 !!
  14 !!    METHOD
  15 !!    ------
  16 !!
  17 !!    EXTERNAL
  18 !!    --------
  19 !!
  20 !!
  21 !!    IMPLICIT ARGUMENTS
  22 !!    ------------------
  23 !!
  24 !!
  25 !!    REFERENCE
  26 !!    ---------
  27 !!
  28 !!    AUTHOR
  29 !!    ------
  30 !!
  31 !!    V. Masson                   Meteo-France
  32 !!
  33 !!    MODIFICATION
  34 !!    ------------
  35 !!
  36 !!    Original     13/10/03
  37 !----------------------------------------------------------------------------
  38 !
  39 !*    0.     DECLARATION
  40 !            -----------
  41 !
  42 USE MODD_SURF_PAR,        ONLY : XUNDEF
  43 !
  44 USE MODD_DATA_COVER_PAR,  ONLY : JPCOVER
  45 USE MODD_TEB_GRID_n,      ONLY : XLAT, XLON, CGRID, XGRID_PAR,          &
  46                                  XMESH_SIZE, NDIM
  47 USE MODD_TEB_n,           ONLY : XCOVER, LCOVER, XZS,                   &
  48                                  NROOF_LAYER, NROAD_LAYER, NWALL_LAYER, &
  49                                  LECOCLIMAP, LGARDEN, NTEB_PATCH,       &
  50                                  CBEM, CBLD_ATYPE
  51 USE MODD_BEM_n,           ONLY : NFLOOR_LAYER
  52 !
  53 USE MODD_PREP,            ONLY : CINGRID_TYPE, CINTERP_TYPE, LINTERP
  54 !
  55 USE MODI_GET_LUOUT
  56 USE MODI_ABOR1_SFX
  57 USE MODI_OPEN_AUX_IO_SURF
  58 USE MODI_GET_SURF_SIZE_n
  59 USE MODI_PACK_PGD
  60 USE MODI_PREP_GRID_EXTERN
  61 USE MODI_PREP_OUTPUT_GRID
  62 USE MODI_READ_SURF
  63 USE MODI_READ_PGD_TEB_PAR_n
  64 USE MODI_CLOSE_AUX_IO_SURF
  65 USE MODI_CLEAN_PREP_OUTPUT_GRID
  66 USE MODI_GOTO_TEB
  67 !
  68 USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
  69 USE PARKIND1  ,ONLY : JPRB
  70 !
  71 !
  72 IMPLICIT NONE
  73 !
  74 !*    0.1    Declaration of dummy arguments
  75 !            ------------------------------
  76 !
  77  CHARACTER(LEN=6),     INTENT(IN)  :: HPROGRAM    ! program calling
  78  CHARACTER(LEN=28),    INTENT(IN)  :: HINIFILE    ! file to read
  79  CHARACTER(LEN=6),     INTENT(IN)  :: HINIFILETYPE! file type
  80 LOGICAL,              INTENT(IN)  :: OECOCLIMAP  ! flag to use ecoclimap
  81 LOGICAL,              INTENT(IN)  :: OGARDEN     ! flag to use garden
  82 !
  83 !
  84 !*    0.2    Declaration of local variables
  85 !            ------------------------------
  86 !
  87 INTEGER :: IRESP   ! error return code
  88 INTEGER :: ILUOUT  ! output listing logical unit
  89 INTEGER :: INI     ! total 1D dimension (input grid)
  90 INTEGER :: JLAYER  ! loop counter
  91 INTEGER :: ILU     ! total 1D dimension (output grid, TOWN points only)
  92 INTEGER :: JPATCH  ! TEB patch
  93 REAL(KIND=JPRB) :: ZHOOK_HANDLE
  94 INTEGER           :: IVERSION
  95 INTEGER           :: IBUGFIX
  96 !------------------------------------------------------------------------------
  97 IF (LHOOK) CALL DR_HOOK('ZOOM_PGD_TEB',0,ZHOOK_HANDLE)
  98  CALL GET_LUOUT(HPROGRAM,ILUOUT)
  99 !
 100 LECOCLIMAP = OECOCLIMAP
 101 LGARDEN = OGARDEN
 102 !
 103 IF (.NOT. OECOCLIMAP) THEN
 104   WRITE(ILUOUT,*) 'ERROR'
 105   WRITE(ILUOUT,*) 'Ecoclimap is not used'
 106   WRITE(ILUOUT,*) 'Routine zoom_pgd_teb.f90 must be updated'
 107   WRITE(ILUOUT,*) 'to interpolate all TEB physiographic fields'
 108   CALL ABOR1_SFX('ZOOM_PGD_TEB: ECOCLIMAP NOT USED, ROUTINE MUST BE UPDATED')
 109 END IF
 110 !
 111 !
 112 !*      1.     Preparation of IO for reading in the file
 113 !              -----------------------------------------
 114 !
 115 !* Note that all points are read, even those without physical meaning.
 116 !  These points will not be used during the horizontal interpolation step.
 117 !  Their value must be defined as XUNDEF.
 118 !
 119  CALL OPEN_AUX_IO_SURF(HINIFILE,HINIFILETYPE,'FULL  ')
 120 !
 121  CALL GOTO_TEB(1)
 122 !-------------------------------------------------------------------------------
 123 !
 124 !*    2.      Number of points and packing of general fields
 125 !             ----------------------------------------------
 126 !
 127 !
 128  CALL GET_SURF_SIZE_n('TOWN  ',ILU)
 129 !
 130 ALLOCATE(LCOVER     (JPCOVER))
 131 ALLOCATE(XCOVER     (ILU,JPCOVER))
 132 ALLOCATE(XZS        (ILU))
 133 ALLOCATE(XLAT       (ILU))
 134 ALLOCATE(XLON       (ILU))
 135 ALLOCATE(XMESH_SIZE (ILU))
 136 !
 137  CALL PACK_PGD(HPROGRAM, 'TOWN  ',                      &
 138                 CGRID,  XGRID_PAR,                     &
 139                 LCOVER, XCOVER, XZS,                   &
 140                 XLAT, XLON, XMESH_SIZE                 )
 141 !
 142 NDIM = ILU
 143 !
 144 !
 145  CALL READ_SURF(HPROGRAM,'VERSION',IVERSION,IRESP)
 146  CALL READ_SURF(HPROGRAM,'BUG',IBUGFIX,IRESP)
 147 !------------------------------------------------------------------------------
 148 !
 149 !*      3.     Reading of grid
 150 !              ---------------
 151 !
 152  CALL PREP_GRID_EXTERN(HINIFILETYPE,ILUOUT,CINGRID_TYPE,CINTERP_TYPE,INI)
 153 !
 154  CALL PREP_OUTPUT_GRID(ILUOUT,CGRID,XGRID_PAR,XLAT,XLON)
 155 !
 156 !
 157 !------------------------------------------------------------------------------
 158 !
 159 !*      4.     Reading & interpolation of fields
 160 !              ---------------------------------
 161 !
 162 !
 163 IF (IVERSION<7 .OR. IVERSION==7 .AND. IBUGFIX<=2) THEN
 164   NTEB_PATCH=1
 165 ELSE
 166   CALL READ_SURF(HPROGRAM,'TEB_PATCH',NTEB_PATCH,IRESP)
 167 END IF
 168
 169 !
 170  CALL READ_SURF(HPROGRAM,'ROOF_LAYER',NROOF_LAYER,IRESP)
 171  CALL READ_SURF(HPROGRAM,'ROAD_LAYER',NROAD_LAYER,IRESP)
 172  CALL READ_SURF(HPROGRAM,'WALL_LAYER',NWALL_LAYER,IRESP)
 173 !
 174 IF (IVERSION<7 .OR.( IVERSION==7 .AND. IBUGFIX<=2)) THEN
 175   CBLD_ATYPE='ARI'
 176   CBEM = 'DEF'
 177 ELSE
 178   CALL READ_SURF(HPROGRAM,'BLD_ATYPE' ,CBLD_ATYPE,IRESP)
 179   CALL READ_SURF(HPROGRAM,'BEM'       ,CBEM      ,IRESP)
 180 END IF
 181 !
 182 IF (CBEM/='DEF') THEN
 183   CALL READ_SURF(HPROGRAM,'FLOOR_LAYER',NFLOOR_LAYER,IRESP)
 184 END IF
 185 !
 186 DO JPATCH=1,NTEB_PATCH
 187   CALL GOTO_TEB(JPATCH)
 188   CALL READ_PGD_TEB_PAR_n(HPROGRAM,INI,'A')
 189 !
 190 !------------------------------------------------------------------------------
 191 !
 192 !*      5.     Gardens
 193 !              -------
 194 !
 195   IF (LGARDEN) CALL ZOOM_PGD_TEB_GARDEN
 196 END DO
 197 !
 198  CALL CLOSE_AUX_IO_SURF(HINIFILE,HINIFILETYPE)
 199 !
 200  CALL CLEAN_PREP_OUTPUT_GRID
 201 !
 202 !------------------------------------------------------------------------------
 203 IF (LHOOK) CALL DR_HOOK('ZOOM_PGD_TEB',1,ZHOOK_HANDLE)
 204 !------------------------------------------------------------------------------
 205 !
 206 CONTAINS
 207 !
 208 SUBROUTINE ZOOM_PGD_TEB_GARDEN
 209 !
 210 USE MODI_HOR_INTERPOL
 211 !
 212 USE MODD_ISBA_PAR,     ONLY : XOPTIMGRID
 213 USE MODD_TEB_VEG_n,    ONLY : CPHOTO, CISBA,                 &
 214                               CPEDOTF, NNBIOMASS
 215 USE MODD_TEB_GARDEN_n, ONLY : NGROUND_LAYER,                 &
 216                               XSAND, XCLAY,                  &
 217                               XWDRAIN, XRUNOFFB, LPAR_GARDEN,&
 218                               XSOILGRID
 219 !
 220 IMPLICIT NONE
 221 !
 222 REAL, DIMENSION(:,:), POINTER     :: ZIN     ! field  on all surface points
 223 !
 224 REAL, DIMENSION(INI)              :: ZFIELD  ! field read
 225 REAL, DIMENSION(ILU,1)            :: ZOUT    ! final field
 226 REAL(KIND=JPRB) :: ZHOOK_HANDLE
 227  CHARACTER(LEN=12) :: YRECFM         ! Name of the article to be read
 228 !
 229 IF (LHOOK) CALL DR_HOOK('ZOOM_PGD_TEB:ZOOM_PGD_TEB_GARDEN',0,ZHOOK_HANDLE)
 230 !
 231 LINTERP(:) = .TRUE.
 232 !
 233 IF (IVERSION>7 .OR. IVERSION==7 .AND. IBUGFIX>=3) THEN
 234   CALL READ_SURF(HPROGRAM,'GD_LAYER',NGROUND_LAYER,IRESP)
 235   CALL READ_SURF(HPROGRAM,'GD_ISBA',CISBA,IRESP)
 236   CALL READ_SURF(HPROGRAM,'GD_PHOTO',CPHOTO,IRESP)
 237   CALL READ_SURF(HPROGRAM,'GD_PEDOTF',CPEDOTF,IRESP)
 238   NNBIOMASS=1
 239   IF (CPHOTO=='NIT') NNBIOMASS=3
 240 ELSE
 241   CALL READ_SURF(HPROGRAM,'TWN_LAYER',NGROUND_LAYER,IRESP)
 242   CALL READ_SURF(HPROGRAM,'TWN_ISBA',CISBA,IRESP)
 243   CALL READ_SURF(HPROGRAM,'TWN_PHOTO',CPHOTO,IRESP)
 244   CALL READ_SURF(HPROGRAM,'TWN_PEDOTF',CPEDOTF,IRESP)
 245   CALL READ_SURF(HPROGRAM,'TWN_NBIOMASS',NNBIOMASS,IRESP)
 246 ENDIF
 247 !
 248 !* sand
 249 !
 250 ALLOCATE(ZIN(INI,NGROUND_LAYER))
 251 YRECFM='TWN_SAND'
 252 IF (IVERSION>7 .OR. IVERSION==7 .AND. IBUGFIX>=3) YRECFM='GD_SAND'
 253  CALL READ_SURF(HPROGRAM,YRECFM,ZFIELD,IRESP,HDIR='A')
 254 DO JLAYER=1,NGROUND_LAYER
 255   ZIN(:,JLAYER) = ZFIELD(:)
 256 END DO
 257 ALLOCATE(XSAND(ILU,NGROUND_LAYER))
 258  CALL HOR_INTERPOL(ILUOUT,ZIN,XSAND)
 259 DEALLOCATE(ZIN)
 260 !
 261 !* clay
 262 !
 263 ALLOCATE(ZIN(INI,NGROUND_LAYER))
 264 YRECFM='TWN_CLAY'
 265 IF (IVERSION>7 .OR. IVERSION==7 .AND. IBUGFIX>=3) YRECFM='GD_CLAY'
 266  CALL READ_SURF(HPROGRAM,YRECFM,ZFIELD,IRESP,HDIR='A')
 267 DO JLAYER=1,NGROUND_LAYER
 268   ZIN(:,JLAYER) = ZFIELD(:)
 269 END DO
 270 ALLOCATE(XCLAY(ILU,NGROUND_LAYER))
 271  CALL HOR_INTERPOL(ILUOUT,ZIN,XCLAY)
 272 DEALLOCATE(ZIN)
 273 !
 274 !* runoff & drainage
 275 !
 276 ALLOCATE(ZIN(INI,1))
 277 YRECFM='TWN_RUNOFFB'
 278 IF (IVERSION>7 .OR. IVERSION==7 .AND. IBUGFIX>=3) YRECFM='GD_RUNOFFB'
 279 CALL READ_SURF(HPROGRAM,YRECFM,ZFIELD,IRESP,HDIR='A')
 280 ZIN(:,1) = ZFIELD(:)
 281 ALLOCATE(XRUNOFFB(ILU))
 282  CALL HOR_INTERPOL(ILUOUT,ZIN,ZOUT)
 283 XRUNOFFB(:) = ZOUT(:,1)
 284 !
 285 IF (IVERSION<=3) THEN
 286   XWDRAIN = 0.
 287 ELSE
 288  YRECFM='TWN_WDRAIN'
 289  IF (IVERSION>7 .OR. IVERSION==7 .AND. IBUGFIX>=3) YRECFM='GD_WDRAIN'
 290  CALL READ_SURF(HPROGRAM,YRECFM,ZFIELD,IRESP,HDIR='A')
 291  ZIN(:,1) = ZFIELD(:)
 292  ALLOCATE(XWDRAIN(ILU))
 293  CALL HOR_INTERPOL(ILUOUT,ZIN,ZOUT)
 294  XWDRAIN(:) = ZOUT(:,1)
 295 ENDIF
 296 !
 297 DEALLOCATE(ZIN)
 298 !
 299 IF(CISBA=='DIF') THEN
 300   ALLOCATE(XSOILGRID(NGROUND_LAYER))
 301   XSOILGRID=XUNDEF
 302   IF (IVERSION>7 .OR. IVERSION==7 .AND. IBUGFIX>=2) THEN
 303     CALL READ_SURF(HPROGRAM,'GD_SOILGRID',XSOILGRID,IRESP,HDIR='-')
 304   ELSE
 305     XSOILGRID(1:NGROUND_LAYER)=XOPTIMGRID(1:NGROUND_LAYER)
 306   ENDIF
 307 ELSE
 308   ALLOCATE(XSOILGRID(0))
 309 ENDIF
 310 !
 311 !
 312 !* other garden parameters
 313 !
 314  CALL READ_SURF(HPROGRAM,'PAR_GARDEN',LPAR_GARDEN,IRESP)
 315 !
 316 !!
 317 IF (LPAR_GARDEN) THEN
 318   WRITE(ILUOUT,*) 'ERROR'
 319   WRITE(ILUOUT,*) 'Specific garden fields are prescribed'
 320   WRITE(ILUOUT,*) 'Routine zoom_pgd_teb.f90 must be updated'
 321   WRITE(ILUOUT,*) 'to interpolate all TEB physiographic garden fields'
 322   CALL ABOR1_SFX('ZOOM_PGD_TEB: GARDEN fields used, ROUTINE MUST BE UPDATED')
 323 END IF
 324 !
 325 IF (LHOOK) CALL DR_HOOK('ZOOM_PGD_TEB:ZOOM_PGD_TEB_GARDEN',1,ZHOOK_HANDLE)
 326 !
 327 END SUBROUTINE ZOOM_PGD_TEB_GARDEN
 328 !_______________________________________________________________________________
 329 !
 330 END SUBROUTINE ZOOM_PGD_TEB