|
SURFEX v7.3
General documentation of Surfex
|
|
SURFEX v7.3
General documentation of Surfex
|
00001 ! ######### 00002 SUBROUTINE PREP_TEB_EXTERN(HPROGRAM,HSURF,HFILE,HFILETYPE,HFILEPGD,HFILEPGDTYPE,KLUOUT,PFIELD) 00003 ! ################################################################################# 00004 ! 00005 USE MODD_TYPE_DATE_SURF 00006 ! 00007 USE MODI_PREP_GRID_EXTERN 00008 USE MODI_READ_SURF 00009 USE MODI_GET_TEB_DEPTHS 00010 USE MODI_INTERP_GRID 00011 USE MODI_OPEN_AUX_IO_SURF 00012 USE MODI_CLOSE_AUX_IO_SURF 00013 USE MODI_TOWN_PRESENCE 00014 USE MODI_READ_TEB_PATCH 00015 USE MODI_GET_CURRENT_TEB_PATCH 00016 ! 00017 USE MODD_PREP, ONLY : CINGRID_TYPE, CINTERP_TYPE 00018 USE MODD_PREP_TEB, ONLY : XGRID_ROAD, XGRID_WALL, XGRID_ROOF, & 00019 XGRID_FLOOR, XWS_ROOF, XWS_ROAD, & 00020 XTI_BLD_DEF, XWS_ROOF_DEF, XWS_ROAD_DEF, XHUI_BLD_DEF 00021 USE MODD_DATA_COVER_PAR, ONLY : JPCOVER 00022 USE MODD_SURF_PAR, ONLY: XUNDEF 00023 ! 00024 USE YOMHOOK ,ONLY : LHOOK, DR_HOOK 00025 USE PARKIND1 ,ONLY : JPRB 00026 ! 00027 IMPLICIT NONE 00028 ! 00029 !* 0.1 declarations of arguments 00030 ! 00031 CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling surf. schemes 00032 CHARACTER(LEN=7), INTENT(IN) :: HSURF ! type of field 00033 CHARACTER(LEN=28), INTENT(IN) :: HFILE ! name of file 00034 CHARACTER(LEN=6), INTENT(IN) :: HFILETYPE ! type of input file 00035 CHARACTER(LEN=28), INTENT(IN) :: HFILEPGD ! name of file 00036 CHARACTER(LEN=6), INTENT(IN) :: HFILEPGDTYPE ! type of input file 00037 INTEGER, INTENT(IN) :: KLUOUT ! logical unit of output listing 00038 REAL,DIMENSION(:,:), POINTER :: PFIELD ! field to interpolate horizontally 00039 ! 00040 !* 0.2 declarations of local variables 00041 ! 00042 REAL, DIMENSION(:,:), ALLOCATABLE :: ZFIELD ! field read 00043 REAL, DIMENSION(:,:), ALLOCATABLE :: ZDEPTH ! depth of each layer 00044 REAL, DIMENSION(:), ALLOCATABLE :: ZDEPTH_TOT ! total depth of surface 00045 ! 00046 REAL, DIMENSION(:,:), ALLOCATABLE :: ZD ! intermediate array 00047 ! 00048 CHARACTER(LEN=12) :: YRECFM ! Name of the article to be read 00049 INTEGER :: IRESP ! reading return code 00050 INTEGER :: ILAYER ! number of layers 00051 INTEGER :: JLAYER ! loop counter 00052 INTEGER :: IVERSION ! SURFEX version 00053 INTEGER :: IBUGFIX ! SURFEX bug version 00054 LOGICAL :: GOLD_NAME ! old name flag for temperatures 00055 CHARACTER(LEN=4) :: YWALL_OPT ! option of walls 00056 CHARACTER(LEN=6) :: YSURF ! Surface type 00057 CHARACTER(LEN=3) :: YBEM ! key of the building energy model DEF for DEFault (Masson et al. 2002) , 00058 ! BEM for Building Energy Model (Bueno et al. 2012) 00059 ! 00060 INTEGER :: INI ! total 1D dimension 00061 ! 00062 LOGICAL :: GTEB ! flag if TEB fields are present 00063 INTEGER :: IPATCH ! number of soil temperature patches 00064 INTEGER :: ITEB_PATCH! number of TEB patches in file 00065 INTEGER :: ICURRENT_PATCH! current TEB patch to be initialized 00066 CHARACTER(LEN=3) :: YPATCH ! indentificator for TEB patch 00067 REAL(KIND=JPRB) :: ZHOOK_HANDLE 00068 !------------------------------------------------------------------------------------- 00069 ! 00070 !* 1. Preparation of IO for reading in the file 00071 ! ----------------------------------------- 00072 ! 00073 !* Note that all points are read, even those without physical meaning. 00074 ! These points will not be used during the horizontal interpolation step. 00075 ! Their value must be defined as XUNDEF. 00076 ! 00077 IF (LHOOK) CALL DR_HOOK('PREP_TEB_EXTERN',0,ZHOOK_HANDLE) 00078 ! 00079 CALL OPEN_AUX_IO_SURF(HFILEPGD,HFILEPGDTYPE,'TOWN ') 00080 ! 00081 !* reading of version of the file being read 00082 CALL READ_SURF(HFILEPGDTYPE,'VERSION',IVERSION,IRESP) 00083 CALL READ_SURF(HFILEPGDTYPE,'BUG',IBUGFIX,IRESP) 00084 GOLD_NAME=(IVERSION<7 .OR. (IVERSION==7 .AND. IBUGFIX<3)) 00085 ! 00086 IF (.NOT.GOLD_NAME) THEN 00087 YRECFM='BEM' 00088 CALL READ_SURF(HFILEPGDTYPE,YRECFM,YBEM,IRESP) 00089 ELSE 00090 YBEM='DEF' 00091 ENDIF 00092 !------------------------------------------------------------------------------------- 00093 ! 00094 !* 2. Reading of grid 00095 ! --------------- 00096 ! 00097 !* reads the grid 00098 CALL PREP_GRID_EXTERN(HFILEPGDTYPE,KLUOUT,CINGRID_TYPE,CINTERP_TYPE,INI) 00099 ! 00100 ! 00101 !* reads if TEB fields exist in the input file 00102 CALL TOWN_PRESENCE(HFILEPGDTYPE,GTEB) 00103 ! 00104 !--------------------------------------------------------------------------------------- 00105 ! 00106 !* 3. Orography 00107 ! --------- 00108 ! 00109 IF (HSURF=='ZS ') THEN 00110 ! 00111 ALLOCATE(PFIELD(INI,1)) 00112 YRECFM='ZS' 00113 CALL READ_SURF(HFILEPGDTYPE,YRECFM,PFIELD(:,1),IRESP,HDIR='A') 00114 CALL CLOSE_AUX_IO_SURF(HFILEPGD,HFILEPGDTYPE) 00115 ! 00116 !--------------------------------------------------------------------------------------- 00117 ELSE 00118 !--------------------------------------------------------------------------------------- 00119 ! 00120 !* 4. TEB fields are read 00121 ! ------------------- 00122 ! 00123 IF (GTEB) THEN 00124 ! 00125 CALL READ_TEB_PATCH(HFILEPGDTYPE,ITEB_PATCH) 00126 CALL GET_CURRENT_TEB_PATCH(ICURRENT_PATCH) 00127 YPATCH=' ' 00128 IF (ITEB_PATCH>1) THEN 00129 WRITE(YPATCH,FMT='(A,I1,A)') 'T',MIN(ICURRENT_PATCH,ITEB_PATCH),'_' 00130 END IF 00131 !--------------------------------------------------------------------------------------- 00132 SELECT CASE(HSURF) 00133 !--------------------------------------------------------------------------------------- 00134 ! 00135 !* 4.1 Profile of temperatures in roads, roofs or walls 00136 ! ------------------------------------------------ 00137 ! 00138 CASE('T_ROAD','T_ROOF','T_WALLA','T_WALLB','T_FLOOR','T_MASS') 00139 YSURF=HSURF(1:6) 00140 !* reading of number of layers 00141 IF (YSURF=='T_ROAD') YRECFM='ROAD_LAYER' 00142 IF (YSURF=='T_ROOF') YRECFM='ROOF_LAYER' 00143 IF (YSURF=='T_WALL') YRECFM='WALL_LAYER' 00144 IF (YSURF=='T_FLOO' .OR. YSURF=='T_MASS') THEN 00145 IF (YBEM=='DEF') THEN 00146 YRECFM='ROAD_LAYER' 00147 ELSE 00148 YRECFM='FLOOR_LAYER' 00149 END IF 00150 END IF 00151 CALL READ_SURF(HFILEPGDTYPE,YRECFM,ILAYER,IRESP) 00152 ! 00153 ALLOCATE(ZD(INI,ILAYER)) 00154 IF (YSURF=='T_ROAD') CALL GET_TEB_DEPTHS(HFILEPGDTYPE,PD_ROAD=ZD) 00155 IF (YSURF=='T_ROOF') CALL GET_TEB_DEPTHS(HFILEPGDTYPE,PD_ROOF=ZD) 00156 IF (YSURF=='T_WALL') CALL GET_TEB_DEPTHS(HFILEPGDTYPE,PD_WALL=ZD) 00157 IF (YSURF=='T_MASS') CALL GET_TEB_DEPTHS(HFILEPGDTYPE,PD_FLOOR=ZD) 00158 IF (YSURF=='T_FLOO') CALL GET_TEB_DEPTHS(HFILEPGDTYPE,PD_FLOOR=ZD) 00159 ! 00160 CALL CLOSE_AUX_IO_SURF(HFILEPGD,HFILEPGDTYPE) 00161 CALL OPEN_AUX_IO_SURF(HFILE,HFILETYPE,'TOWN ') 00162 ! 00163 !* reading option for road orientation 00164 YWALL_OPT = 'UNIF' 00165 IF (YSURF =='T_WALL' .AND. .NOT. GOLD_NAME) THEN 00166 CALL READ_SURF(HFILETYPE,'WALL_OPT',YWALL_OPT,IRESP) 00167 END IF 00168 ! 00169 !* reading of the profile 00170 ALLOCATE(ZFIELD(INI,ILAYER)) 00171 print*,HSURF,GOLD_NAME 00172 DO JLAYER=1,ILAYER 00173 IF (GOLD_NAME) THEN 00174 WRITE(YRECFM,'(A6,I1.1)') HSURF(1:6),JLAYER 00175 ELSE 00176 print*,HSURF(1:1),HSURF(3:6),JLAYER 00177 WRITE(YRECFM,'(A1,A4,I1.1)') HSURF(1:1),HSURF(3:6),JLAYER 00178 IF (YSURF =='T_WALL' .AND. YWALL_OPT/='UNIF') & 00179 WRITE(YRECFM,'(A1,A5,I1.1)') HSURF(1:1),HSURF(3:7),JLAYER 00180 IF ((HSURF=='T_FLOOR' .OR. HSURF=='T_MASS') .AND. YBEM=='DEF') THEN 00181 IF (HSURF=='T_FLOOR' .AND. JLAYER>1) THEN 00182 WRITE(YRECFM,'(A5,I1.1)') 'TROAD',JLAYER 00183 ELSE 00184 WRITE(YRECFM,'(A6)') 'TI_BLD' 00185 ENDIF 00186 END IF 00187 END IF 00188 YRECFM=YPATCH//YRECFM 00189 YRECFM=ADJUSTL(YRECFM) 00190 CALL READ_SURF(HFILETYPE,YRECFM,ZFIELD(:,JLAYER),IRESP,HDIR='A') 00191 END DO 00192 CALL CLOSE_AUX_IO_SURF(HFILE,HFILETYPE) 00193 ! 00194 !* recovers middle layer depth (from the surface) 00195 ALLOCATE(ZDEPTH (INI,ILAYER)) 00196 ALLOCATE(ZDEPTH_TOT(INI)) 00197 ZDEPTH (:,1)=ZD(:,1)/2. 00198 ZDEPTH_TOT(:) =ZD(:,1) 00199 DO JLAYER=2,ILAYER 00200 ZDEPTH (:,JLAYER) = ZDEPTH_TOT(:) + ZD(:,JLAYER)/2. 00201 ZDEPTH_TOT(:) = ZDEPTH_TOT(:) + ZD(:,JLAYER) 00202 END DO 00203 ! 00204 !* in case of wall or roof, normalizes by total wall or roof thickness 00205 IF (YSURF=='T_ROOF' .OR. YSURF=='T_WALL' .OR. HSURF == 'T_FLOOR' .OR. HSURF == 'T_MASS') THEN 00206 DO JLAYER=1,ILAYER 00207 ZDEPTH(:,JLAYER) = ZDEPTH(:,JLAYER) / ZDEPTH_TOT(:) 00208 END DO 00209 END IF 00210 ! 00211 !* interpolation on the fine vertical grid 00212 IF (YSURF=='T_ROAD') THEN 00213 ALLOCATE(PFIELD(SIZE(ZFIELD,1),SIZE(XGRID_ROAD))) 00214 CALL INTERP_GRID(ZDEPTH,ZFIELD,XGRID_ROAD,PFIELD) 00215 ELSEIF (YSURF=='T_ROOF') THEN 00216 ALLOCATE(PFIELD(SIZE(ZFIELD,1),SIZE(XGRID_ROOF))) 00217 CALL INTERP_GRID(ZDEPTH,ZFIELD,XGRID_ROOF,PFIELD) 00218 ELSEIF (YSURF=='T_WALL') THEN 00219 ALLOCATE(PFIELD(SIZE(ZFIELD,1),SIZE(XGRID_WALL))) 00220 CALL INTERP_GRID(ZDEPTH,ZFIELD,XGRID_WALL,PFIELD) 00221 ELSEIF (YSURF=='T_FLOO' .OR. YSURF=='T_MASS') THEN 00222 ALLOCATE(PFIELD(SIZE(ZFIELD,1),SIZE(XGRID_FLOOR))) 00223 CALL INTERP_GRID(ZDEPTH,ZFIELD,XGRID_FLOOR,PFIELD) 00224 END IF 00225 ! 00226 !* end 00227 DEALLOCATE(ZD) 00228 DEALLOCATE(ZFIELD) 00229 DEALLOCATE(ZDEPTH) 00230 DEALLOCATE(ZDEPTH_TOT) 00231 !--------------------------------------------------------------------------------------- 00232 ! 00233 !* 4.2 Internal moisture 00234 ! --------------- 00235 ! 00236 CASE('QI_BLD ') 00237 ALLOCATE(PFIELD(INI,1)) 00238 IF (YBEM=='BEM') THEN 00239 YRECFM='QI_BLD' 00240 YRECFM=YPATCH//YRECFM 00241 YRECFM=ADJUSTL(YRECFM) 00242 CALL CLOSE_AUX_IO_SURF(HFILEPGD,HFILEPGDTYPE) 00243 CALL OPEN_AUX_IO_SURF(HFILE,HFILETYPE,'TOWN ') 00244 CALL READ_SURF(HFILETYPE,YRECFM,PFIELD(:,1),IRESP,HDIR='A') 00245 CALL CLOSE_AUX_IO_SURF(HFILE,HFILETYPE) 00246 ELSE 00247 PFIELD(:,1) = XUNDEF 00248 ENDIF 00249 ! 00250 !--------------------------------------------------------------------------------------- 00251 ! 00252 !* 4.2 Other variables 00253 ! --------------- 00254 ! 00255 CASE DEFAULT 00256 ALLOCATE(PFIELD(INI,1)) 00257 YRECFM=HSURF 00258 IF (HSURF=='T_CAN ') THEN 00259 YRECFM='TCANYON' 00260 IF (GOLD_NAME) YRECFM='T_CANYON' 00261 ELSEIF (HSURF=='Q_CAN ') THEN 00262 YRECFM='QCANYON' 00263 IF (GOLD_NAME) YRECFM='Q_CANYON' 00264 ELSEIF (HSURF=='T_WIN2 ' .OR. HSURF=='T_WIN1') THEN 00265 IF (YBEM=='BEM') THEN 00266 YRECFM=HSURF 00267 ELSE 00268 YRECFM='TI_BLD' 00269 ENDIF 00270 ENDIF 00271 YRECFM=YPATCH//YRECFM 00272 YRECFM=ADJUSTL(YRECFM) 00273 CALL CLOSE_AUX_IO_SURF(HFILEPGD,HFILEPGDTYPE) 00274 CALL OPEN_AUX_IO_SURF(HFILE,HFILETYPE,'TOWN ') 00275 CALL READ_SURF(HFILETYPE,YRECFM,PFIELD(:,1),IRESP,HDIR='A') 00276 CALL CLOSE_AUX_IO_SURF(HFILE,HFILETYPE) 00277 ! 00278 !--------------------------------------------------------------------------------------- 00279 END SELECT 00280 !--------------------------------------------------------------------------------------- 00281 ! 00282 !* 5. Subtitutes if TEB fields do not exist 00283 ! ------------------------------------- 00284 ! 00285 ELSE 00286 00287 CALL CLOSE_AUX_IO_SURF(HFILEPGD,HFILEPGDTYPE) 00288 00289 SELECT CASE(HSURF) 00290 00291 !* temperature profiles 00292 CASE('T_ROAD','T_ROOF','T_WALL','T_WIN1','T_FLOOR','T_CAN','TI_ROAD') 00293 YSURF=HSURF(1:6) 00294 !* reading of the soil surface temperature 00295 CALL OPEN_AUX_IO_SURF(HFILEPGD,HFILEPGDTYPE,'NATURE') 00296 CALL READ_SURF(HFILEPGDTYPE,'PATCH_NUMBER',IPATCH,IRESP) 00297 CALL CLOSE_AUX_IO_SURF(HFILEPGD,HFILEPGDTYPE) 00298 ALLOCATE(ZFIELD(INI,IPATCH)) 00299 CALL OPEN_AUX_IO_SURF(HFILE,HFILETYPE,'NATURE') 00300 IF (YSURF=='T_FLOO' .OR. YSURF=='T_CAN ' .OR. YSURF=='TI_ROA') THEN 00301 CALL READ_SURF(HFILETYPE,'TG2',ZFIELD(:,:),IRESP,HDIR='A') 00302 ELSE 00303 CALL READ_SURF(HFILETYPE,'TG1',ZFIELD(:,:),IRESP,HDIR='A') 00304 ENDIF 00305 CALL CLOSE_AUX_IO_SURF(HFILE,HFILETYPE) 00306 !* fills the whole temperature profile by this soil temperature 00307 IF (YSURF=='T_ROAD') ILAYER=SIZE(XGRID_ROAD) 00308 IF (YSURF=='T_ROOF') ILAYER=SIZE(XGRID_ROOF) 00309 IF (YSURF=='T_WALL') ILAYER=SIZE(XGRID_WALL) 00310 IF (YSURF=='T_FLOO') ILAYER=SIZE(XGRID_FLOOR) 00311 IF (YSURF=='T_WIN1' .OR. YSURF=='T_CAN ' .OR. YSURF=='TI_ROA') ILAYER=1 00312 ALLOCATE(PFIELD(INI,ILAYER)) 00313 IF (YSURF=='T_FLOO') THEN 00314 !* sets the temperature equal to this deep soil temperature 00315 PFIELD(:,1) = XTI_BLD_DEF 00316 ELSE 00317 PFIELD(:,1) = ZFIELD(:,1) 00318 ENDIF 00319 DO JLAYER=2,ILAYER 00320 PFIELD(:,JLAYER) = ZFIELD(:,1) 00321 END DO 00322 DEALLOCATE(ZFIELD) 00323 00324 CASE('T_MASS','TI_BLD','T_WIN2') 00325 YSURF=HSURF(1:6) 00326 IF (YSURF=='T_MASS') ILAYER = SIZE(XGRID_FLOOR) 00327 IF (YSURF=='TI_BLD'.OR.YSURF=='T_WIN2') ILAYER=1 00328 ALLOCATE(PFIELD(INI, ILAYER)) 00329 PFIELD(:,:) = XTI_BLD_DEF 00330 00331 !* building moisture 00332 CASE('QI_BLD ') 00333 ALLOCATE(PFIELD(INI,1)) 00334 PFIELD(:,1) = XUNDEF 00335 00336 !* water reservoirs 00337 CASE('WS_ROOF','WS_ROAD') 00338 ALLOCATE(PFIELD(INI,1)) 00339 IF (HSURF=='WS_ROOF') PFIELD = XWS_ROOF_DEF 00340 IF (HSURF=='WS_ROAD') PFIELD = XWS_ROAD_DEF 00341 00342 !* other fields 00343 CASE DEFAULT 00344 ALLOCATE(PFIELD(INI,1)) 00345 PFIELD = 0. 00346 00347 END SELECT 00348 00349 END IF 00350 !------------------------------------------------------------------------------------- 00351 END IF 00352 !------------------------------------------------------------------------------------- 00353 ! 00354 !* 6. End of IO 00355 ! --------- 00356 ! 00357 IF (LHOOK) CALL DR_HOOK('PREP_TEB_EXTERN',1,ZHOOK_HANDLE) 00358 ! 00359 !--------------------------------------------------------------------------------------- 00360 ! 00361 END SUBROUTINE PREP_TEB_EXTERN
1.8.0
