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

Go to the documentation of this file.
00001 !     #########
00002       SUBROUTINE READ_TEB_n(HPROGRAM,KPATCH)
00003 !     #########################################
00004 !
00005 !!****  *READ_TEB_n* - reads TEB fields
00006 !!                        
00007 !!
00008 !!    PURPOSE
00009 !!    -------
00010 !!
00011 !!**  METHOD
00012 !!    ------
00013 !!
00014 !!    EXTERNAL
00015 !!    --------
00016 !!
00017 !!
00018 !!    IMPLICIT ARGUMENTS
00019 !!    ------------------
00020 !!
00021 !!    REFERENCE
00022 !!    ---------
00023 !!
00024 !!
00025 !!    AUTHOR
00026 !!    ------
00027 !!      V. Masson   *Meteo France*      
00028 !!
00029 !!    MODIFICATIONS
00030 !!    -------------
00031 !!      Original    01/2003 
00032 !-------------------------------------------------------------------------------
00033 !
00034 !*       0.    DECLARATIONS
00035 !              ------------
00036 !
00037 USE MODD_DATA_COVER_PAR, ONLY : JPCOVER
00038 !
00039 USE MODD_TEB_n,          ONLY : NROOF_LAYER, XT_ROOF, XWS_ROOF, &
00040                                   NROAD_LAYER, XT_ROAD, XWS_ROAD, &
00041                                   NWALL_LAYER,XT_WALL_A,XT_WALL_B,&
00042                                   XTI_ROAD, CBEM,                 &
00043                                   TSNOW_ROOF, TSNOW_ROAD,         &
00044                                   XT_CANYON, XQ_CANYON,           &
00045                                   NTEB_PATCH, CROAD_DIR, CWALL_OPT
00046 USE MODD_BEM_n, ONLY : NFLOOR_LAYER, XT_FLOOR, XT_MASS,           &
00047                        XT_WIN1, XT_WIN2, XQI_BLD, XTI_BLD                                   
00048 !
00049 USE MODI_READ_SURF
00050 !
00051 USE MODI_INIT_IO_SURF_n
00052 USE MODI_SET_SURFEX_FILEIN
00053 USE MODI_END_IO_SURF_n
00054 USE MODI_TOWN_PRESENCE
00055 USE MODI_ALLOCATE_GR_SNOW
00056 USE MODI_READ_GR_SNOW
00057 !
00058 !
00059 !
00060 USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
00061 USE PARKIND1  ,ONLY : JPRB
00062 !
00063 USE MODI_GET_TYPE_DIM_n
00064 USE MODD_SURF_PAR, ONLY : XUNDEF
00065 !
00066 IMPLICIT NONE
00067 !
00068 !*       0.1   Declarations of arguments
00069 !              -------------------------
00070 !
00071  CHARACTER(LEN=6),  INTENT(IN)  :: HPROGRAM ! calling program
00072 INTEGER,           INTENT(IN)  :: KPATCH   ! current patch number
00073 !
00074 !
00075 !*       0.2   Declarations of local variables
00076 !              -------------------------------
00077 !
00078 LOGICAL           :: GTOWN          ! town variables written in the file
00079 INTEGER           :: ILU          ! 1D physical dimension
00080 !
00081 INTEGER           :: IRESP          ! Error code after redding
00082 !
00083  CHARACTER(LEN=12) :: YRECFM         ! Name of the article to be read
00084  CHARACTER(LEN=3)  :: YPATCH         ! suffix if more than 1 patch
00085 !
00086 INTEGER           :: IVERSION, IBUGFIX
00087 LOGICAL           :: GOLD_NAME      ! name of temperatures in old versions of SURFEX
00088 !
00089 INTEGER :: JLAYER  ! loop counter on layers
00090 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00091 !
00092 !-------------------------------------------------------------------------------
00093 !
00094 !* 1D physical dimension
00095 !
00096 IF (LHOOK) CALL DR_HOOK('READ_TEB_N',0,ZHOOK_HANDLE)
00097 YRECFM='SIZE_TOWN'
00098  CALL GET_TYPE_DIM_n('TOWN  ',ILU)
00099 !
00100 YPATCH='   '
00101 IF (NTEB_PATCH>1) WRITE(YPATCH,FMT='(A,I1,A)') 'T',KPATCH,'_'
00102 !  
00103  CALL READ_SURF(HPROGRAM,'VERSION',IVERSION,IRESP)
00104  CALL READ_SURF(HPROGRAM,'BUG',IBUGFIX,IRESP)
00105 GOLD_NAME = (IVERSION<7 .OR. (IVERSION==7 .AND. IBUGFIX<=2))
00106 !
00107 !*       2.     Prognostic fields:
00108 !               -----------------
00109 !
00110 !* roof temperatures
00111 !
00112 ALLOCATE(XT_ROOF(ILU,NROOF_LAYER))
00113 !
00114 DO JLAYER=1,NROOF_LAYER
00115   WRITE(YRECFM,'(A5,A5,I1.1,A1)') YPATCH,'TROOF',JLAYER,' '
00116   YRECFM=ADJUSTL(YRECFM)
00117   IF (GOLD_NAME) WRITE(YRECFM,'(A6,I1.1,A4)') 'T_ROOF',JLAYER,'    '
00118 
00119  CALL READ_SURF(HPROGRAM,YRECFM,XT_ROOF(:,JLAYER),IRESP)
00120 END DO
00121 !
00122 !* roof water content
00123 !
00124 ALLOCATE(XWS_ROOF(ILU))
00125 !
00126 YRECFM=YPATCH//'WS_ROOF'
00127 YRECFM=ADJUSTL(YRECFM)
00128  CALL READ_SURF(HPROGRAM,YRECFM,XWS_ROOF(:),IRESP)
00129 !
00130 !* road temperatures
00131 !
00132 ALLOCATE(XT_ROAD(ILU,NROAD_LAYER))
00133 !
00134 DO JLAYER=1,NROAD_LAYER
00135   WRITE(YRECFM,'(A5,A5,I1.1,A1)') YPATCH,'TROAD',JLAYER,' '
00136   YRECFM=ADJUSTL(YRECFM)
00137   IF (GOLD_NAME) WRITE(YRECFM,'(A6,I1.1,A4)') 'T_ROAD',JLAYER,'    '
00138  CALL READ_SURF(HPROGRAM,YRECFM,XT_ROAD(:,JLAYER),IRESP)
00139 END DO
00140 !
00141 !* road water content
00142 !
00143 ALLOCATE(XWS_ROAD(ILU))
00144 !
00145 YRECFM=YPATCH//'WS_ROAD'
00146 YRECFM=ADJUSTL(YRECFM)
00147  CALL READ_SURF(HPROGRAM,YRECFM,XWS_ROAD(:),IRESP)
00148 !
00149 !* wall temperatures
00150 !
00151 ALLOCATE(XT_WALL_A(ILU,NWALL_LAYER))
00152 ALLOCATE(XT_WALL_B(ILU,NWALL_LAYER))
00153 !
00154 DO JLAYER=1,NWALL_LAYER
00155   IF (CWALL_OPT=='UNIF' .OR. GOLD_NAME) THEN
00156     WRITE(YRECFM,'(A5,A5,I1.1,A1)') YPATCH,'TWALL',JLAYER,' '
00157     YRECFM=ADJUSTL(YRECFM)
00158     IF (GOLD_NAME) WRITE(YRECFM,'(A6,I1.1,A4)') 'T_WALL',JLAYER,'    '
00159     CALL READ_SURF(HPROGRAM,YRECFM,XT_WALL_A(:,JLAYER),IRESP)
00160     !
00161     XT_WALL_B = XT_WALL_A
00162   ELSE
00163     WRITE(YRECFM,'(A5,A6,I1.1)') YPATCH,'TWALLA',JLAYER
00164     YRECFM=ADJUSTL(YRECFM)
00165     CALL READ_SURF(HPROGRAM,YRECFM,XT_WALL_A(:,JLAYER),IRESP)
00166     !
00167     WRITE(YRECFM,'(A5,A6,I1.1)') YPATCH,'TWALLB',JLAYER
00168     YRECFM=ADJUSTL(YRECFM)
00169     CALL READ_SURF(HPROGRAM,YRECFM,XT_WALL_B(:,JLAYER),IRESP)
00170   END IF
00171 END DO
00172 !
00173 !* internal building temperature
00174 !
00175 ALLOCATE(XTI_BLD(ILU))
00176 !
00177 YRECFM=YPATCH//'TI_BLD'
00178 YRECFM=ADJUSTL(YRECFM)
00179  CALL READ_SURF(HPROGRAM,YRECFM,XTI_BLD(:),IRESP)
00180 
00181 !
00182 !* outdoor window temperature
00183 !
00184 ALLOCATE(XT_WIN1(ILU))
00185 !
00186 IF (IVERSION>7 .OR. IVERSION==7 .AND. IBUGFIX>=3) THEN
00187    YRECFM=YPATCH//'T_WIN1'
00188    YRECFM=ADJUSTL(YRECFM)
00189    CALL READ_SURF(HPROGRAM,YRECFM,XT_WIN1(:),IRESP)
00190 ELSE
00191    XT_WIN1(:)=XUNDEF
00192 ENDIF
00193 !
00194 !
00195 !* internal building specific humidity
00196 !
00197 ALLOCATE(XQI_BLD(ILU))
00198 !
00199 IF (CBEM=='BEM' .AND. (IVERSION>7 .OR. IVERSION==7 .AND. IBUGFIX>=3)) THEN
00200    YRECFM=YPATCH//'QI_BLD'
00201    YRECFM=ADJUSTL(YRECFM)
00202    CALL READ_SURF(HPROGRAM,YRECFM,XQI_BLD(:),IRESP)
00203 ELSE
00204    XQI_BLD(:) = XUNDEF
00205 ENDIF
00206 !
00207 IF (CBEM=='BEM') THEN
00208   !
00209   !* indoor window temperature
00210   !
00211   ALLOCATE(XT_WIN2(ILU))
00212   !
00213   YRECFM=YPATCH//'T_WIN2'
00214   YRECFM=ADJUSTL(YRECFM)
00215   CALL READ_SURF(HPROGRAM,YRECFM,XT_WIN2(:),IRESP)        
00216   !
00217   !* floor temperatures
00218   !
00219   ALLOCATE(XT_FLOOR(ILU,NFLOOR_LAYER))
00220   !
00221   DO JLAYER=1,NFLOOR_LAYER
00222     WRITE(YRECFM,'(A5,A5,I1.1,A1)') YPATCH,'TFLOO',JLAYER,' '
00223     YRECFM=ADJUSTL(YRECFM)
00224     CALL READ_SURF(HPROGRAM,YRECFM,XT_FLOOR(:,JLAYER),IRESP)
00225   END DO
00226   !
00227   !* mass temperatures
00228   !
00229   ALLOCATE(XT_MASS(ILU,NFLOOR_LAYER))
00230   !
00231   DO JLAYER=1,NFLOOR_LAYER
00232     WRITE(YRECFM,'(A5,A5,I1.1,A1)') YPATCH,'TMASS',JLAYER,' '
00233     YRECFM=ADJUSTL(YRECFM)
00234     CALL READ_SURF(HPROGRAM,YRECFM,XT_MASS(:,JLAYER),IRESP)
00235   END DO
00236   !
00237 ELSE 
00238   ALLOCATE(XT_WIN2(0))
00239   ALLOCATE(XT_FLOOR(0,0))
00240   ALLOCATE(XT_MASS(0,0))
00241 ENDIF
00242 !
00243 !* deep road temperature
00244 !
00245 ALLOCATE(XTI_ROAD(ILU))
00246 !
00247 YRECFM=YPATCH//'TI_ROAD'
00248 YRECFM=ADJUSTL(YRECFM)
00249  CALL READ_SURF(HPROGRAM,YRECFM,XTI_ROAD(:),IRESP)
00250 !
00251 !
00252 !* snow mantel
00253 !
00254  CALL END_IO_SURF_n(HPROGRAM)
00255  CALL SET_SURFEX_FILEIN(HPROGRAM,'PGD ')
00256  CALL INIT_IO_SURF_n(HPROGRAM,'TOWN  ','TEB   ','READ ')
00257 !
00258  CALL TOWN_PRESENCE(HPROGRAM,GTOWN)
00259 !
00260  CALL END_IO_SURF_n(HPROGRAM)
00261  CALL SET_SURFEX_FILEIN(HPROGRAM,'PREP')
00262  CALL INIT_IO_SURF_n(HPROGRAM,'TOWN  ','TEB   ','READ ')
00263 !
00264 IF (.NOT. GTOWN) THEN
00265   TSNOW_ROAD%SCHEME='1-L'
00266   CALL ALLOCATE_GR_SNOW(TSNOW_ROAD,ILU,1)
00267   TSNOW_ROOF%SCHEME='1-L'
00268   CALL ALLOCATE_GR_SNOW(TSNOW_ROOF,ILU,1)  
00269 ELSE
00270   IF (IVERSION>7 .OR. IVERSION==7 .AND. IBUGFIX>=3) THEN
00271     CALL READ_GR_SNOW(HPROGRAM,'RD',YPATCH,ILU,1,TSNOW_ROAD  )
00272     CALL READ_GR_SNOW(HPROGRAM,'RF',YPATCH,ILU,1,TSNOW_ROOF  )
00273   ELSE
00274     CALL READ_GR_SNOW(HPROGRAM,'ROAD',YPATCH,ILU,1,TSNOW_ROAD  )
00275     CALL READ_GR_SNOW(HPROGRAM,'ROOF',YPATCH,ILU,1,TSNOW_ROOF  )
00276   ENDIF    
00277 END IF
00278 !
00279 !-------------------------------------------------------------------------------
00280 !
00281 !*       3.     Semi-prognostic fields:
00282 !               ----------------------
00283 !
00284 !* temperature in canyon air
00285 !
00286 ALLOCATE(XT_CANYON(ILU))
00287 XT_CANYON(:) = XT_ROAD(:,1)
00288 !
00289 YRECFM=YPATCH//'TCANYON'
00290 YRECFM=ADJUSTL(YRECFM)
00291 IF (GOLD_NAME) YRECFM='T_CANYON'
00292  CALL READ_SURF(HPROGRAM,YRECFM,XT_CANYON(:),IRESP)
00293 !
00294 !* water vapor in canyon air
00295 !
00296 ALLOCATE(XQ_CANYON(ILU))
00297 XQ_CANYON(:) = 0.
00298 !
00299 YRECFM=YPATCH//'QCANYON'
00300 YRECFM=ADJUSTL(YRECFM)
00301 IF (GOLD_NAME) YRECFM='Q_CANYON'
00302  CALL READ_SURF(HPROGRAM,YRECFM,XQ_CANYON(:),IRESP)
00303 IF (LHOOK) CALL DR_HOOK('READ_TEB_N',1,ZHOOK_HANDLE)
00304 !
00305 !-------------------------------------------------------------------------------
00306 !
00307 END SUBROUTINE READ_TEB_n