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

Go to the documentation of this file.
00001 !     ###########################################################
00002       SUBROUTINE ZOOM_PGD_TEB(HPROGRAM,HINIFILE,HINIFILETYPE,OECOCLIMAP,OGARDEN)
00003 !     ###########################################################
00004 
00005 !!
00006 !!    PURPOSE
00007 !!    -------
00008 !!   This program prepares the physiographic data fields.
00009 !!
00010 !!    METHOD
00011 !!    ------
00012 !!   
00013 !!    EXTERNAL
00014 !!    --------
00015 !!
00016 !!
00017 !!    IMPLICIT ARGUMENTS
00018 !!    ------------------
00019 !!
00020 !!
00021 !!    REFERENCE
00022 !!    ---------
00023 !!
00024 !!    AUTHOR
00025 !!    ------
00026 !!
00027 !!    V. Masson                   Meteo-France
00028 !!
00029 !!    MODIFICATION
00030 !!    ------------
00031 !!
00032 !!    Original     13/10/03
00033 !----------------------------------------------------------------------------
00034 !
00035 !*    0.     DECLARATION
00036 !            -----------
00037 !
00038 !
00039 USE MODD_DATA_COVER_PAR,  ONLY : JPCOVER
00040 USE MODD_TEB_GRID_n,      ONLY : XLAT, XLON, CGRID, XGRID_PAR,          &
00041                                  XMESH_SIZE, NDIM
00042 USE MODD_TEB_n,           ONLY : XCOVER, LCOVER, XZS,                   &
00043                                  NROOF_LAYER, NROAD_LAYER, NWALL_LAYER, &
00044                                  LECOCLIMAP, LGARDEN, NTEB_PATCH,       &
00045                                  CBEM, CBLD_ATYPE
00046 USE MODD_BEM_n,           ONLY : NFLOOR_LAYER
00047 !
00048 USE MODD_PREP,            ONLY : CINGRID_TYPE, CINTERP_TYPE, LINTERP
00049 !
00050 USE MODI_GET_LUOUT
00051 USE MODI_ABOR1_SFX
00052 USE MODI_OPEN_AUX_IO_SURF
00053 USE MODI_GET_SURF_SIZE_n
00054 USE MODI_PACK_PGD
00055 USE MODI_PREP_GRID_EXTERN
00056 USE MODI_PREP_OUTPUT_GRID
00057 USE MODI_READ_SURF
00058 USE MODI_READ_PGD_TEB_PAR_n
00059 USE MODI_CLOSE_AUX_IO_SURF
00060 USE MODI_CLEAN_PREP_OUTPUT_GRID
00061 USE MODI_GOTO_TEB
00062 !
00063 USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
00064 USE PARKIND1  ,ONLY : JPRB
00065 !
00066 !
00067 IMPLICIT NONE
00068 !
00069 !*    0.1    Declaration of dummy arguments
00070 !            ------------------------------
00071 !
00072  CHARACTER(LEN=6),     INTENT(IN)  :: HPROGRAM    ! program calling
00073  CHARACTER(LEN=28),    INTENT(IN)  :: HINIFILE    ! file to read
00074  CHARACTER(LEN=6),     INTENT(IN)  :: HINIFILETYPE! file type
00075 LOGICAL,              INTENT(IN)  :: OECOCLIMAP  ! flag to use ecoclimap
00076 LOGICAL,              INTENT(IN)  :: OGARDEN     ! flag to use garden
00077 !
00078 !
00079 !*    0.2    Declaration of local variables
00080 !            ------------------------------
00081 !
00082 INTEGER :: IRESP   ! error return code
00083 INTEGER :: ILUOUT  ! output listing logical unit
00084 INTEGER :: INI     ! total 1D dimension (input grid)
00085 INTEGER :: JLAYER  ! loop counter
00086 INTEGER :: ILU     ! total 1D dimension (output grid, TOWN points only)
00087 INTEGER :: JPATCH  ! TEB patch
00088 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00089 INTEGER           :: IVERSION
00090 INTEGER           :: IBUGFIX
00091 !------------------------------------------------------------------------------
00092 IF (LHOOK) CALL DR_HOOK('ZOOM_PGD_TEB',0,ZHOOK_HANDLE)
00093  CALL GET_LUOUT(HPROGRAM,ILUOUT)
00094 !
00095 LECOCLIMAP = OECOCLIMAP
00096 LGARDEN = OGARDEN
00097 !
00098 IF (.NOT. OECOCLIMAP) THEN
00099   WRITE(ILUOUT,*) 'ERROR'
00100   WRITE(ILUOUT,*) 'Ecoclimap is not used'
00101   WRITE(ILUOUT,*) 'Routine zoom_pgd_teb.f90 must be updated'
00102   WRITE(ILUOUT,*) 'to interpolate all TEB physiographic fields'
00103   CALL ABOR1_SFX('ZOOM_PGD_TEB: ECOCLIMAP NOT USED, ROUTINE MUST BE UPDATED')
00104 END IF
00105 !
00106 !
00107 !*      1.     Preparation of IO for reading in the file
00108 !              -----------------------------------------
00109 !
00110 !* Note that all points are read, even those without physical meaning.
00111 !  These points will not be used during the horizontal interpolation step.
00112 !  Their value must be defined as XUNDEF.
00113 !
00114  CALL OPEN_AUX_IO_SURF(HINIFILE,HINIFILETYPE,'FULL  ')
00115 !
00116  CALL GOTO_TEB(1)
00117 !-------------------------------------------------------------------------------
00118 !
00119 !*    2.      Number of points and packing of general fields
00120 !             ----------------------------------------------
00121 !
00122 !
00123  CALL GET_SURF_SIZE_n('TOWN  ',ILU)
00124 !
00125 ALLOCATE(LCOVER     (JPCOVER))
00126 ALLOCATE(XCOVER     (ILU,JPCOVER))
00127 ALLOCATE(XZS        (ILU))
00128 ALLOCATE(XLAT       (ILU))
00129 ALLOCATE(XLON       (ILU))
00130 ALLOCATE(XMESH_SIZE (ILU))
00131 !
00132  CALL PACK_PGD(HPROGRAM, 'TOWN  ',                      &
00133                 CGRID,  XGRID_PAR,                     &
00134                 LCOVER, XCOVER, XZS,                   &
00135                 XLAT, XLON, XMESH_SIZE                 )  
00136 !
00137 NDIM = ILU
00138 !
00139 !
00140  CALL READ_SURF(HPROGRAM,'VERSION',IVERSION,IRESP)
00141  CALL READ_SURF(HPROGRAM,'BUG',IBUGFIX,IRESP)
00142 !------------------------------------------------------------------------------
00143 !
00144 !*      3.     Reading of grid
00145 !              ---------------
00146 !
00147  CALL PREP_GRID_EXTERN(HINIFILETYPE,ILUOUT,CINGRID_TYPE,CINTERP_TYPE,INI)
00148 !
00149  CALL PREP_OUTPUT_GRID(ILUOUT,CGRID,XGRID_PAR,XLAT,XLON)
00150 !
00151 !
00152 !------------------------------------------------------------------------------
00153 !
00154 !*      4.     Reading & interpolation of fields
00155 !              ---------------------------------
00156 !
00157 IF (IVERSION<7 .OR. IVERSION==7 .AND. IBUGFIX<=2) THEN
00158   NTEB_PATCH=1
00159 ELSE
00160   CALL READ_SURF(HPROGRAM,'TEB_PATCH',NTEB_PATCH,IRESP)
00161 END IF
00162 
00163 !
00164  CALL READ_SURF(HPROGRAM,'ROOF_LAYER',NROOF_LAYER,IRESP)
00165  CALL READ_SURF(HPROGRAM,'ROAD_LAYER',NROAD_LAYER,IRESP)
00166  CALL READ_SURF(HPROGRAM,'WALL_LAYER',NWALL_LAYER,IRESP)
00167 !
00168 IF (IVERSION<7 .OR.( IVERSION==7 .AND. IBUGFIX<=2)) THEN
00169   CBLD_ATYPE='ARI'
00170   CBEM = 'DEF'
00171 ELSE
00172   CALL READ_SURF(HPROGRAM,'BLD_ATYPE' ,CBLD_ATYPE,IRESP)
00173   CALL READ_SURF(HPROGRAM,'BEM'       ,CBEM      ,IRESP)
00174 END IF
00175 !
00176 IF (CBEM/='DEF') THEN
00177   CALL READ_SURF(HPROGRAM,'FLOOR_LAYER',NFLOOR_LAYER,IRESP)
00178 END IF
00179 !
00180 DO JPATCH=1,NTEB_PATCH
00181   CALL GOTO_TEB(JPATCH)
00182   CALL READ_PGD_TEB_PAR_n(HPROGRAM,INI,'A')
00183 !
00184 !------------------------------------------------------------------------------
00185 !
00186 !*      5.     Gardens
00187 !              -------
00188 !
00189   IF (LGARDEN) CALL ZOOM_PGD_TEB_GARDEN
00190 END DO
00191 !
00192  CALL CLOSE_AUX_IO_SURF(HINIFILE,HINIFILETYPE)
00193 !
00194  CALL CLEAN_PREP_OUTPUT_GRID
00195 !
00196 !------------------------------------------------------------------------------
00197 IF (LHOOK) CALL DR_HOOK('ZOOM_PGD_TEB',1,ZHOOK_HANDLE)
00198 !------------------------------------------------------------------------------
00199 !
00200 CONTAINS
00201 !
00202 SUBROUTINE ZOOM_PGD_TEB_GARDEN
00203 !
00204 USE MODI_HOR_INTERPOL
00205 !
00206 USE MODD_TEB_VEG_n,    ONLY : CPHOTO, CISBA,                &
00207                               CPEDOTF, NNBIOMASS
00208 USE MODD_TEB_GARDEN_n, ONLY : NGROUND_LAYER,                &
00209                               XSAND, XCLAY,                 &
00210                               XWDRAIN, XRUNOFFB, LPAR_GARDEN
00211 !
00212 IMPLICIT NONE
00213 !
00214 REAL, DIMENSION(:,:), POINTER     :: ZIN     ! field  on all surface points
00215 !
00216 REAL, DIMENSION(INI)              :: ZFIELD  ! field read
00217 REAL, DIMENSION(ILU,1)            :: ZOUT    ! final field
00218 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00219 !
00220 IF (LHOOK) CALL DR_HOOK('ZOOM_PGD_TEB:ZOOM_PGD_TEB_GARDEN',0,ZHOOK_HANDLE)
00221 !
00222 LINTERP(:) = .TRUE.
00223 !
00224 IF (IVERSION>7 .OR. IVERSION==7 .AND. IBUGFIX>=3) THEN
00225   CALL READ_SURF(HPROGRAM,'GD_LAYER',NGROUND_LAYER,IRESP)
00226   CALL READ_SURF(HPROGRAM,'GD_ISBA',CISBA,IRESP)
00227   CALL READ_SURF(HPROGRAM,'GD_PHOTO',CPHOTO,IRESP)
00228   CALL READ_SURF(HPROGRAM,'GD_PEDOTF',CPEDOTF,IRESP)
00229   NNBIOMASS=1
00230   IF (CPHOTO=='NIT') NNBIOMASS=3  
00231 ELSE
00232   CALL READ_SURF(HPROGRAM,'TWN_LAYER',NGROUND_LAYER,IRESP)
00233   CALL READ_SURF(HPROGRAM,'TWN_ISBA',CISBA,IRESP)
00234   CALL READ_SURF(HPROGRAM,'TWN_PHOTO',CPHOTO,IRESP)
00235   CALL READ_SURF(HPROGRAM,'TWN_PEDOTF',CPEDOTF,IRESP)
00236   CALL READ_SURF(HPROGRAM,'TWN_NBIOMASS',NNBIOMASS,IRESP)
00237 ENDIF
00238 !
00239 !* sand
00240 !
00241 ALLOCATE(ZIN(INI,NGROUND_LAYER))
00242  CALL READ_SURF(HPROGRAM,'TWN_SAND',ZFIELD,IRESP,HDIR='A')
00243 DO JLAYER=1,NGROUND_LAYER
00244   ZIN(:,JLAYER) = ZFIELD(:)
00245 END DO
00246 ALLOCATE(XSAND(ILU,NGROUND_LAYER))
00247  CALL HOR_INTERPOL(ILUOUT,ZIN,XSAND)
00248 DEALLOCATE(ZIN)
00249 !
00250 !* clay
00251 !
00252 ALLOCATE(ZIN(INI,NGROUND_LAYER))
00253  CALL READ_SURF(HPROGRAM,'TWN_CLAY',ZFIELD,IRESP,HDIR='A')
00254 DO JLAYER=1,NGROUND_LAYER
00255   ZIN(:,JLAYER) = ZFIELD(:)
00256 END DO
00257 ALLOCATE(XCLAY(ILU,NGROUND_LAYER))
00258  CALL HOR_INTERPOL(ILUOUT,ZIN,XCLAY)
00259 DEALLOCATE(ZIN)
00260 !
00261 !* runoff & drainage
00262 !
00263 ALLOCATE(ZIN(INI,1))
00264  CALL READ_SURF(HPROGRAM,'TWN_RUNOFFB',ZFIELD,IRESP,HDIR='A')
00265 ZIN(:,1) = ZFIELD(:)
00266 ALLOCATE(XRUNOFFB(ILU))
00267  CALL HOR_INTERPOL(ILUOUT,ZIN,ZOUT)
00268 XRUNOFFB(:) = ZOUT(:,1)
00269 !
00270  CALL READ_SURF(HPROGRAM,'TWN_WDRAIN',ZFIELD,IRESP,HDIR='A')
00271 ZIN(:,1) = ZFIELD(:)
00272 ALLOCATE(XWDRAIN(ILU))
00273  CALL HOR_INTERPOL(ILUOUT,ZIN,ZOUT)
00274 XWDRAIN(:) = ZOUT(:,1)
00275 !
00276 DEALLOCATE(ZIN)
00277 !
00278 !* other garden parameters
00279 !
00280  CALL READ_SURF(HPROGRAM,'PAR_GARDEN',LPAR_GARDEN,IRESP)
00281 !
00282 !!
00283 IF (LPAR_GARDEN) THEN
00284   WRITE(ILUOUT,*) 'ERROR'
00285   WRITE(ILUOUT,*) 'Specific garden fields are prescribed'
00286   WRITE(ILUOUT,*) 'Routine zoom_pgd_teb.f90 must be updated'
00287   WRITE(ILUOUT,*) 'to interpolate all TEB physiographic garden fields'
00288   CALL ABOR1_SFX('ZOOM_PGD_TEB: GARDEN fields used, ROUTINE MUST BE UPDATED')
00289 END IF
00290 !
00291 IF (LHOOK) CALL DR_HOOK('ZOOM_PGD_TEB:ZOOM_PGD_TEB_GARDEN',1,ZHOOK_HANDLE)
00292 !
00293 END SUBROUTINE ZOOM_PGD_TEB_GARDEN
00294 !_______________________________________________________________________________
00295 !
00296 END SUBROUTINE ZOOM_PGD_TEB