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

Go to the documentation of this file.
00001 !     #########
00002       SUBROUTINE WRITESURF_TEB_n(HPROGRAM,KPATCH,HWRITE)
00003 !     ####################################
00004 !
00005 !!****  *WRITE_TEB_n* - writes TEB fields
00006 !!
00007 !!    PURPOSE
00008 !!    -------
00009 !!
00010 !!**  METHOD
00011 !!    ------
00012 !!
00013 !!    EXTERNAL
00014 !!    --------
00015 !!
00016 !!
00017 !!    IMPLICIT ARGUMENTS
00018 !!    ------------------
00019 !!
00020 !!    REFERENCE
00021 !!    ---------
00022 !!
00023 !!
00024 !!    AUTHOR
00025 !!    ------
00026 !!      V. Masson   *Meteo France*      
00027 !!
00028 !!    MODIFICATIONS
00029 !!    -------------
00030 !!      Original    01/2003 
00031 !-------------------------------------------------------------------------------
00032 !
00033 !*       0.    DECLARATIONS
00034 !              ------------
00035 !
00036 !
00037 USE MODD_TEB_n,          ONLY : LGARDEN, LGREENROOF, CBEM,      &
00038                                 NROOF_LAYER, XT_ROOF, XWS_ROOF, &
00039                                 NROAD_LAYER, XT_ROAD, XWS_ROAD, &
00040                                 NWALL_LAYER,XT_WALL_A,XT_WALL_B,&
00041                                 XTI_ROAD,                       &
00042                                 TSNOW_ROOF, TSNOW_ROAD,         &
00043                                 XT_CANYON, XQ_CANYON,           &
00044                                 TTIME, NTEB_PATCH, CROAD_DIR,   &
00045                                 XROAD_DIR,                      &
00046                                 CWALL_OPT, XROAD_DIR
00047 USE MODD_BEM_n,          ONLY : NFLOOR_LAYER, XT_FLOOR,         &
00048                                 XT_MASS, XT_WIN1, XT_WIN2,      &
00049                                 XQI_BLD, XTI_BLD                                 
00050 !
00051 USE MODD_DATA_TEB_n,     ONLY : LDATA_ROAD_DIR
00052 !
00053 USE MODI_WRITE_SURF
00054 USE MODI_WRITESURF_GR_SNOW
00055 USE MODI_WRITESURF_TEB_GARDEN_n
00056 USE MODI_WRITESURF_TEB_GREENROOF_n
00057 !
00058 !
00059 USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
00060 USE PARKIND1  ,ONLY : JPRB
00061 !
00062 IMPLICIT NONE
00063 !
00064 !*       0.1   Declarations of arguments
00065 !              -------------------------
00066 !
00067  CHARACTER(LEN=6),  INTENT(IN)  :: HPROGRAM ! program calling
00068 INTEGER,           INTENT(IN)  :: KPATCH   ! current TEB patch
00069  CHARACTER(LEN=3),    INTENT(IN)  :: HWRITE    ! 'PREP' : does not write SBL XUNDEF fields
00070 !                                             ! 'ALL' : all fields are written
00071 !
00072 !*       0.2   Declarations of local variables
00073 !              -------------------------------
00074 !
00075 INTEGER           :: IRESP          ! IRESP  : return-code if a problem appears
00076  CHARACTER(LEN=12) :: YRECFM         ! Name of the article to be read
00077  CHARACTER(LEN=100):: YCOMMENT       ! Comment string
00078  CHARACTER(LEN=3)  :: YPATCH         ! Patch identificator
00079  CHARACTER(LEN=7)  :: YDIR           ! Direction identificator
00080  CHARACTER(LEN=100):: YSTRING        ! Comment string
00081 !
00082 INTEGER :: JLAYER ! loop on surface layers
00083 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00084 !
00085 !-------------------------------------------------------------------------------
00086 !
00087 IF (LHOOK) CALL DR_HOOK('WRITESURF_TEB_N',0,ZHOOK_HANDLE)
00088 !
00089 YPATCH='   '
00090 IF (NTEB_PATCH>1) WRITE(YPATCH,FMT='(A,I1,A)') 'T',KPATCH,'_'
00091 !
00092 !
00093 !*       2.     Option for road orientation:
00094 !               ---------------------------
00095 !
00096 YCOMMENT='Option for Road orientation in TEB scheme'
00097  CALL WRITE_SURF(HPROGRAM,'ROAD_DIR',CROAD_DIR,IRESP,YCOMMENT)
00098 YCOMMENT='Option for Wall representation in TEB scheme'
00099  CALL WRITE_SURF(HPROGRAM,'WALL_OPT',CWALL_OPT,IRESP,YCOMMENT)
00100 !
00101 !*       3.     Prognostic fields:
00102 !               -----------------
00103 !
00104 !* roof temperatures
00105 !
00106 
00107 DO JLAYER=1,NROOF_LAYER
00108   WRITE(YRECFM,'(A3,A5,I1.1,A1)') YPATCH,'TROOF',JLAYER,' '
00109   WRITE(YCOMMENT,'(A9,I1.1,A4)') 'X_Y_TROOF',JLAYER,' (K)'
00110   YRECFM=ADJUSTL(YRECFM)
00111  CALL WRITE_SURF(HPROGRAM,YRECFM,XT_ROOF(:,JLAYER),IRESP,HCOMMENT=YCOMMENT)
00112 END DO
00113 
00114 !
00115 !* roof water content
00116 !
00117 
00118 YRECFM=YPATCH//'WS_ROOF'
00119 YRECFM=ADJUSTL(YRECFM)
00120 YCOMMENT='WS_ROOF (kg/m2)'
00121  CALL WRITE_SURF(HPROGRAM,YRECFM,XWS_ROOF(:),IRESP,HCOMMENT=YCOMMENT)
00122 !
00123 !* road temperatures
00124 !
00125 
00126 DO JLAYER=1,NROAD_LAYER
00127   WRITE(YRECFM,'(A3,A5,I1.1,A1)') YPATCH,'TROAD',JLAYER,' '
00128   YRECFM=ADJUSTL(YRECFM)
00129   IF (CROAD_DIR=='UNIF' .OR. LDATA_ROAD_DIR) THEN
00130     WRITE(YCOMMENT,'(A9,I1.1,A4)') 'X_Y_TROAD',JLAYER,' (K)'
00131   ELSE
00132     !* road direction is uniform spatially, one can then indicate it in the comment
00133     CALL ROAD_DIR(XROAD_DIR(1),YDIR)
00134     YSTRING=TRIM(YDIR)//' ROAD TEMP. LAYER '
00135     WRITE(YCOMMENT,'(A,I1.1,A4)') TRIM(YSTRING), JLAYER,' (K)'
00136   END IF
00137  CALL WRITE_SURF(HPROGRAM,YRECFM,XT_ROAD(:,JLAYER),IRESP,HCOMMENT=YCOMMENT)
00138 END DO
00139 !
00140 !* road water content
00141 !
00142 
00143 YRECFM=YPATCH//'WS_ROAD'
00144 YRECFM=ADJUSTL(YRECFM)
00145 YCOMMENT='WS_ROAD (kg/m2)'
00146  CALL WRITE_SURF(HPROGRAM,YRECFM,XWS_ROAD(:),IRESP,HCOMMENT=YCOMMENT)
00147 !
00148 !* wall temperatures
00149 !
00150 
00151 DO JLAYER=1,NWALL_LAYER
00152  IF (CWALL_OPT=='UNIF') THEN
00153   WRITE(YRECFM,'(A3,A5,I1.1,A1)') YPATCH,'TWALL',JLAYER,' '
00154   YRECFM=ADJUSTL(YRECFM)
00155   WRITE(YCOMMENT,'(A9,I1.1,A4)') 'X_Y_TWALL',JLAYER,' (K)'
00156   CALL WRITE_SURF(HPROGRAM,YRECFM,XT_WALL_A(:,JLAYER),IRESP,HCOMMENT=YCOMMENT)
00157  ELSE
00158   !* Wall A
00159   WRITE(YRECFM,'(A3,A6,I1.1)') YPATCH,'TWALLA',JLAYER
00160   YRECFM=ADJUSTL(YRECFM)
00161   IF (LDATA_ROAD_DIR) THEN
00162     WRITE(YCOMMENT,'(A11,I1.1,A4)') 'X_Y_TWALL_A',JLAYER,' (K)'
00163   ELSE
00164     !* wall direction is uniform spatially, one can then indicate it in the comment
00165     CALL WALLA_DIR(XROAD_DIR(1),YDIR)
00166     YSTRING=TRIM(YDIR)//'-FACING WALL TEMP. LAYER '
00167     WRITE(YCOMMENT,'(A,I1.1,A4)') TRIM(YSTRING), JLAYER,' (K)'
00168   END IF
00169   CALL WRITE_SURF(HPROGRAM,YRECFM,XT_WALL_A(:,JLAYER),IRESP,HCOMMENT=YCOMMENT)
00170   !
00171   !* Wall B
00172   WRITE(YRECFM,'(A3,A6,I1.1)') YPATCH,'TWALLB',JLAYER
00173   YRECFM=ADJUSTL(YRECFM)
00174   IF (LDATA_ROAD_DIR) THEN
00175     WRITE(YCOMMENT,'(A11,I1.1,A4)') 'X_Y_TWALL_B',JLAYER,' (K)'
00176   ELSE
00177     !* wall direction is uniform spatially, one can then indicate it in the comment
00178     CALL WALLB_DIR(XROAD_DIR(1),YDIR)
00179     YSTRING=TRIM(YDIR)//'-FACING WALL TEMP. LAYER '
00180     WRITE(YCOMMENT,'(A,I1.1,A4)') TRIM(YSTRING), JLAYER,' (K)'
00181   END IF
00182   CALL WRITE_SURF(HPROGRAM,YRECFM,XT_WALL_B(:,JLAYER),IRESP,HCOMMENT=YCOMMENT)
00183  END IF
00184 END DO
00185 !
00186 !* internal building temperature
00187 !
00188 YRECFM=YPATCH//'TI_BLD'
00189 YRECFM=ADJUSTL(YRECFM)
00190 YCOMMENT='TI_BLD (K)'
00191  CALL WRITE_SURF(HPROGRAM,YRECFM,XTI_BLD(:),IRESP,HCOMMENT=YCOMMENT)
00192 !
00193 !
00194 !* outdoor window temperature
00195 !
00196 YRECFM=YPATCH//'T_WIN1'
00197 YRECFM=ADJUSTL(YRECFM)
00198 YCOMMENT='T_WIN1 (K)'
00199  CALL WRITE_SURF(HPROGRAM,YRECFM,XT_WIN1(:),IRESP,HCOMMENT=YCOMMENT)
00200 !
00201 IF (CBEM=='BEM') THEN
00202 !* internal building specific humidity
00203 !
00204 YRECFM=YPATCH//'QI_BLD'
00205 YRECFM=ADJUSTL(YRECFM)
00206 YCOMMENT='QI_BLD (kg/kg)'
00207  CALL WRITE_SURF(HPROGRAM,YRECFM,XQI_BLD(:),IRESP,HCOMMENT=YCOMMENT)
00208 !
00209   !
00210   !* indoor window temperature
00211   !
00212   YRECFM=YPATCH//'T_WIN2'
00213   YRECFM=ADJUSTL(YRECFM)
00214   YCOMMENT='T_WIN2 (K)'
00215   CALL WRITE_SURF(HPROGRAM,YRECFM,XT_WIN2(:),IRESP,HCOMMENT=YCOMMENT)
00216   !
00217   !* floor temperatures
00218   !
00219   DO JLAYER=1,NFLOOR_LAYER
00220     WRITE(YRECFM,'(A3,A5,I1.1,A1)') YPATCH,'TFLOO',JLAYER,' '
00221     WRITE(YCOMMENT,'(A9,I1.1,A4)') 'X_Y_TFLOO',JLAYER,' (K)'
00222     YRECFM=ADJUSTL(YRECFM)
00223     CALL WRITE_SURF(HPROGRAM,YRECFM,XT_FLOOR(:,JLAYER),IRESP,HCOMMENT=YCOMMENT)
00224   END DO
00225   !
00226   !* internal th. mass temperature
00227   !
00228   DO JLAYER=1,NFLOOR_LAYER
00229     WRITE(YRECFM,'(A3,A5,I1.1,A1)') YPATCH,'TMASS',JLAYER,' '
00230     WRITE(YCOMMENT,'(A9,I1.1,A4)') 'X_Y_TMASS',JLAYER,' (K)'
00231     YRECFM=ADJUSTL(YRECFM)
00232     CALL WRITE_SURF(HPROGRAM,YRECFM,XT_MASS(:,JLAYER),IRESP,HCOMMENT=YCOMMENT)
00233   END DO        
00234   !
00235 ENDIF
00236 !
00237 !* deep road temperature
00238 !
00239 YRECFM=YPATCH//'TI_ROAD'
00240 YRECFM=ADJUSTL(YRECFM)
00241 YCOMMENT='TI_ROAD (K)'
00242  CALL WRITE_SURF(HPROGRAM,YRECFM,XTI_ROAD(:),IRESP,HCOMMENT=YCOMMENT)
00243 !
00244 !* snow mantel
00245 !
00246 YRECFM='RF'
00247  CALL WRITESURF_GR_SNOW(HPROGRAM,YRECFM,YPATCH,TSNOW_ROOF  )
00248 !
00249 YRECFM='RD'
00250  CALL WRITESURF_GR_SNOW(HPROGRAM,YRECFM,YPATCH,TSNOW_ROAD  )
00251 !
00252 !-------------------------------------------------------------------------------
00253 !
00254 !*       4.     Semi-prognostic fields:
00255 !               ----------------------
00256 !
00257 !* temperature of canyon air
00258 !
00259 YRECFM=YPATCH//'TCANYON'
00260 YRECFM=ADJUSTL(YRECFM)
00261 YCOMMENT='T_CANYON (K)'
00262  CALL WRITE_SURF(HPROGRAM,YRECFM,XT_CANYON(:),IRESP,HCOMMENT=YCOMMENT)
00263 !
00264 !* humidity of canyon air
00265 !
00266 YRECFM=YPATCH//'QCANYON'
00267 YRECFM=ADJUSTL(YRECFM)
00268 YCOMMENT='Q_CANYON (kg/kg)'
00269  CALL WRITE_SURF(HPROGRAM,YRECFM,XQ_CANYON(:),IRESP,HCOMMENT=YCOMMENT)
00270 !
00271 !-------------------------------------------------------------------------------
00272 !
00273 !*       5.  Time
00274 !            ----
00275 !
00276 IF (KPATCH==1) THEN
00277   YRECFM='DTCUR'
00278   YCOMMENT='s'
00279   CALL WRITE_SURF(HPROGRAM,YRECFM,TTIME,IRESP,HCOMMENT=YCOMMENT)
00280 END IF
00281 !
00282 !
00283 !-------------------------------------------------------------------------------
00284 !
00285 !*       6.  §Urban green areas
00286 !            ------------------
00287 !
00288 ! Gardens
00289 IF (LGARDEN) CALL WRITESURF_TEB_GARDEN_n(HPROGRAM,YPATCH)
00290 !
00291 ! Grenn roofs
00292 IF (LGREENROOF) CALL WRITESURF_TEB_GREENROOF_n(HPROGRAM,YPATCH)
00293 !
00294 IF (LHOOK) CALL DR_HOOK('WRITESURF_TEB_N',1,ZHOOK_HANDLE)
00295 !
00296 !
00297 !-------------------------------------------------------------------------------
00298 CONTAINS
00299 SUBROUTINE ROAD_DIR(PDIR,HDIR)
00300 REAL,             INTENT(IN)  :: PDIR
00301  CHARACTER(LEN=7), INTENT(OUT) :: HDIR
00302 REAL :: ZDIR
00303 ZDIR=PDIR
00304 IF (PDIR<0) ZDIR = PDIR +360.
00305 IF (ZDIR>=  0.   .AND. ZDIR< 11.25) HDIR='N-S    '
00306 IF (ZDIR>= 11.25 .AND. ZDIR< 33.75) HDIR='NNE-SSW'
00307 IF (ZDIR>= 33.75 .AND. ZDIR< 56.25) HDIR='NE-SW'
00308 IF (ZDIR>= 56.25 .AND. ZDIR< 78.75) HDIR='ENE-WSW'
00309 IF (ZDIR>= 78.75 .AND. ZDIR<101.25) HDIR='E-W    '
00310 IF (ZDIR>=101.25 .AND. ZDIR<123.75) HDIR='ESE-WNW'
00311 IF (ZDIR>=123.75 .AND. ZDIR<146.25) HDIR='SE-NW  '
00312 IF (ZDIR>=146.25 .AND. ZDIR<168.75) HDIR='SSE-NNW'
00313 IF (ZDIR>=168.75 .AND. ZDIR<180.00) HDIR='N-S    '
00314 END SUBROUTINE ROAD_DIR
00315 SUBROUTINE WALLA_DIR(PDIR,HDIR)
00316 REAL,             INTENT(IN)  :: PDIR
00317  CHARACTER(LEN=7), INTENT(OUT) :: HDIR
00318 REAL :: ZDIR
00319 ZDIR=PDIR
00320 IF (PDIR<0) ZDIR = PDIR +360.
00321 IF (ZDIR>=  0.   .AND. ZDIR< 11.25) HDIR='E      '
00322 IF (ZDIR>= 11.25 .AND. ZDIR< 33.75) HDIR='ESE    '
00323 IF (ZDIR>= 33.75 .AND. ZDIR< 56.25) HDIR='SE     ' 
00324 IF (ZDIR>= 56.25 .AND. ZDIR< 78.75) HDIR='SSE    '
00325 IF (ZDIR>= 78.75 .AND. ZDIR<101.25) HDIR='S      '
00326 IF (ZDIR>=101.25 .AND. ZDIR<123.75) HDIR='SSW    '
00327 IF (ZDIR>=123.75 .AND. ZDIR<146.25) HDIR='SW     '
00328 IF (ZDIR>=146.25 .AND. ZDIR<168.75) HDIR='WSW    '
00329 IF (ZDIR>=168.75 .AND. ZDIR<180.00) HDIR='W      '
00330 END SUBROUTINE WALLA_DIR
00331 SUBROUTINE WALLB_DIR(PDIR,HDIR)
00332 REAL,             INTENT(IN)  :: PDIR
00333  CHARACTER(LEN=7), INTENT(OUT) :: HDIR
00334 REAL :: ZDIR
00335 ZDIR=PDIR
00336 IF (PDIR<0) ZDIR = PDIR +360.
00337 IF (ZDIR>=  0.   .AND. ZDIR< 11.25) HDIR='W      '
00338 IF (ZDIR>= 11.25 .AND. ZDIR< 33.75) HDIR='WNW    '
00339 IF (ZDIR>= 33.75 .AND. ZDIR< 56.25) HDIR='NW     ' 
00340 IF (ZDIR>= 56.25 .AND. ZDIR< 78.75) HDIR='NNW    '
00341 IF (ZDIR>= 78.75 .AND. ZDIR<101.25) HDIR='N      '
00342 IF (ZDIR>=101.25 .AND. ZDIR<123.75) HDIR='NNE    '
00343 IF (ZDIR>=123.75 .AND. ZDIR<146.25) HDIR='NE     '
00344 IF (ZDIR>=146.25 .AND. ZDIR<168.75) HDIR='ENE    '
00345 IF (ZDIR>=168.75 .AND. ZDIR<180.00) HDIR='E      '
00346 END SUBROUTINE WALLB_DIR
00347 !-------------------------------------------------------------------------------
00348 !
00349 END SUBROUTINE WRITESURF_TEB_n