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

Go to the documentation of this file.
00001 !     #########
00002 SUBROUTINE PREP_HOR_TEB_FIELD(HPROGRAM,HSURF,HATMFILE,HATMFILETYPE,HPGDFILE,HPGDFILETYPE)
00003 !     #################################################################################
00004 !
00005 !
00006 !!****  *PREP_HOR_TEB_FIELD* - reads, interpolates and prepares a TEB field
00007 !!
00008 !!    PURPOSE
00009 !!    -------
00010 !
00011 !!**  METHOD
00012 !!    ------
00013 !!
00014 !!    REFERENCE
00015 !!    ---------
00016 !!      
00017 !!
00018 !!    AUTHOR
00019 !!    ------
00020 !!     V. Masson 
00021 !!
00022 !!    MODIFICATIONS
00023 !!    -------------
00024 !!      Original    01/2004
00025 !!      P. Le Moigne 10/2005, Phasage Arome
00026 !!------------------------------------------------------------------
00027 !
00028 !
00029 USE MODD_PREP,     ONLY : CINGRID_TYPE, CINTERP_TYPE, XZS_LS, XLAT_OUT, XLON_OUT, &
00030                           XX_OUT, XY_OUT, CMASK
00031 USE MODD_PREP_TEB, ONLY : XGRID_ROOF, XGRID_ROAD, XGRID_WALL, XGRID_FLOOR, LSNOW_IDEAL, &
00032                           XWSNOW_ROOF, XRSNOW_ROOF, XTSNOW_ROOF, XASNOW_ROOF,           &
00033                           XWSNOW_ROAD, XRSNOW_ROAD, XTSNOW_ROAD, XASNOW_ROAD,           &
00034                           XHUI_BLD, XHUI_BLD_DEF
00035 USE MODD_TEB_n,     ONLY : TTIME, XWS_ROAD, XWS_ROOF, XT_ROAD, XT_ROOF,           &
00036                           XT_WALL_A, XT_WALL_B,                                   &
00037                           XT_CANYON,XQ_CANYON,XD_ROAD,XD_WALL,XD_ROOF,            &
00038                           NROAD_LAYER, NWALL_LAYER, NROOF_LAYER,                  &
00039                           TSNOW_ROOF, TSNOW_ROAD, XTI_ROAD, CWALL_OPT
00040 USE MODD_BEM_n,     ONLY :XTI_BLD, XT_FLOOR, NFLOOR_LAYER, XD_FLOOR, XT_MASS, &
00041                           XQI_BLD, XT_WIN1, XT_WIN2                              
00042 USE MODD_TEB_GRID_n,ONLY:  XLAT, XLON
00043 !
00044 USE MODD_CSTS, ONLY: XG, XP00
00045 USE MODD_SURF_PAR, ONLY: XUNDEF
00046 !
00047 USE MODE_THERMOS
00048 !
00049 USE MODI_READ_PREP_TEB_CONF
00050 USE MODI_READ_PREP_TEB_SNOW
00051 USE MODI_PREP_TEB_GRIB
00052 USE MODI_PREP_TEB_UNIF
00053 USE MODI_PREP_TEB_BUFFER
00054 USE MODI_HOR_INTERPOL
00055 USE MODI_PREP_HOR_SNOW_FIELDS
00056 USE MODI_GET_LUOUT
00057 USE MODI_PREP_TEB_EXTERN
00058 !
00059 USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
00060 USE PARKIND1  ,ONLY : JPRB
00061 !
00062 USE MODI_ABOR1_SFX
00063 IMPLICIT NONE
00064 !
00065 !*      0.1    declarations of arguments
00066 !
00067  CHARACTER(LEN=6),   INTENT(IN)  :: HPROGRAM  ! program calling surf. schemes
00068  CHARACTER(LEN=7),   INTENT(IN)  :: HSURF     ! type of field
00069  CHARACTER(LEN=28),  INTENT(IN)  :: HATMFILE    ! name of the Atmospheric file
00070  CHARACTER(LEN=6),   INTENT(IN)  :: HATMFILETYPE! type of the Atmospheric file
00071  CHARACTER(LEN=28),  INTENT(IN)  :: HPGDFILE    ! name of the Atmospheric file
00072  CHARACTER(LEN=6),   INTENT(IN)  :: HPGDFILETYPE! type of the Atmospheric file
00073 !
00074 !*      0.2    declarations of local variables
00075 !
00076  CHARACTER(LEN=6)              :: YFILETYPE ! type of input file
00077  CHARACTER(LEN=28)             :: YFILE     ! name of file
00078  CHARACTER(LEN=6)              :: YFILEPGDTYPE ! type of input file
00079  CHARACTER(LEN=28)             :: YFILEPGD     ! name of file
00080 REAL, DIMENSION(:), ALLOCATABLE :: ZSG1SNOW, ZSG2SNOW, ZHISTSNOW, ZAGESNOW
00081 REAL, POINTER, DIMENSION(:,:) :: ZFIELDIN  ! field to interpolate horizontally
00082 REAL, ALLOCATABLE, DIMENSION(:,:) :: ZFIELDOUT ! field interpolated   horizontally
00083 REAL, ALLOCATABLE, DIMENSION(:) :: ZPS !surface pressure
00084 REAL, PARAMETER               :: ZRHOA=1.19 ! volumic mass of air at 20°C and 1000hPa
00085 INTEGER                       :: ILUOUT    ! output listing logical unit
00086 !
00087 LOGICAL                       :: GUNIF     ! flag for prescribed uniform field
00088 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00089 !-------------------------------------------------------------------------------------
00090 !
00091 !
00092 !*      1.     Reading of input file name and type
00093 !
00094 IF (LHOOK) CALL DR_HOOK('PREP_HOR_TEB_FIELD',0,ZHOOK_HANDLE)
00095  CALL GET_LUOUT(HPROGRAM,ILUOUT)
00096 !
00097  CALL READ_PREP_TEB_CONF(HPROGRAM,HSURF,YFILE,YFILETYPE,YFILEPGD,YFILEPGDTYPE,&
00098                         HATMFILE,HATMFILETYPE,HPGDFILE,HPGDFILETYPE,ILUOUT,GUNIF)
00099 !
00100 CMASK = 'TOWN'
00101 !
00102 !-------------------------------------------------------------------------------------
00103 !
00104 !*      2.     Snow variables case?
00105 !
00106 IF (HSURF=='SN_ROOF') THEN
00107   CALL READ_PREP_TEB_SNOW(HPROGRAM,TSNOW_ROOF%SCHEME,TSNOW_ROOF%NLAYER,&
00108                                    TSNOW_ROAD%SCHEME,TSNOW_ROAD%NLAYER,&
00109                                    YFILE,YFILETYPE)
00110   IF (LEN_TRIM(YFILE)>0 .AND. LEN_TRIM(YFILETYPE)>0) GUNIF = .FALSE.                                   
00111   ALLOCATE(ZSG1SNOW(SIZE(XWSNOW_ROOF)))
00112   ALLOCATE(ZSG2SNOW(SIZE(XWSNOW_ROOF)))
00113   ALLOCATE(ZHISTSNOW(SIZE(XWSNOW_ROOF)))
00114   ALLOCATE(ZAGESNOW(SIZE(XWSNOW_ROOF)))                                 
00115   CALL PREP_HOR_SNOW_FIELDS(HPROGRAM,HSURF,              &
00116                             YFILE,YFILETYPE,             &
00117                             YFILEPGD, YFILEPGDTYPE,      &
00118                             ILUOUT,GUNIF,1,              &
00119                             SIZE(XLAT),TSNOW_ROOF, TTIME,&
00120                             XWSNOW_ROOF, XRSNOW_ROOF,    &
00121                             XTSNOW_ROOF, XASNOW_ROOF,    &
00122                             LSNOW_IDEAL, ZSG1SNOW,       &
00123                             ZSG2SNOW, ZHISTSNOW, ZAGESNOW )
00124   DEALLOCATE(ZSG1SNOW)
00125   DEALLOCATE(ZSG2SNOW)
00126   DEALLOCATE(ZHISTSNOW)
00127   DEALLOCATE(ZAGESNOW)                            
00128   IF (LHOOK) CALL DR_HOOK('PREP_HOR_TEB_FIELD',1,ZHOOK_HANDLE)
00129   RETURN
00130 ELSE IF (HSURF=='SN_ROAD') THEN
00131   CALL READ_PREP_TEB_SNOW(HPROGRAM,TSNOW_ROOF%SCHEME,TSNOW_ROOF%NLAYER,&
00132                                    TSNOW_ROAD%SCHEME,TSNOW_ROAD%NLAYER,&
00133                                    YFILE,YFILETYPE)
00134   IF (LEN_TRIM(YFILE)>0 .AND. LEN_TRIM(YFILETYPE)>0) GUNIF = .FALSE.                                   
00135   ALLOCATE(ZSG1SNOW(SIZE(XWSNOW_ROAD)))
00136   ALLOCATE(ZSG2SNOW(SIZE(XWSNOW_ROAD)))
00137   ALLOCATE(ZHISTSNOW(SIZE(XWSNOW_ROAD)))
00138   ALLOCATE(ZAGESNOW(SIZE(XWSNOW_ROAD)))                                   
00139   CALL PREP_HOR_SNOW_FIELDS(HPROGRAM,HSURF,              &
00140                             YFILE,YFILETYPE,             &
00141                             YFILEPGD, YFILEPGDTYPE,      &                            
00142                             ILUOUT,GUNIF,1,              &
00143                             SIZE(XLAT),TSNOW_ROAD, TTIME,&
00144                             XWSNOW_ROAD, XRSNOW_ROAD,    &
00145                             XTSNOW_ROAD, XASNOW_ROAD,    &
00146                             LSNOW_IDEAL, ZSG1SNOW,       &
00147                             ZSG2SNOW, ZHISTSNOW, ZAGESNOW )
00148   DEALLOCATE(ZSG1SNOW)
00149   DEALLOCATE(ZSG2SNOW)
00150   DEALLOCATE(ZHISTSNOW)
00151   DEALLOCATE(ZAGESNOW)                               
00152   IF (LHOOK) CALL DR_HOOK('PREP_HOR_TEB_FIELD',1,ZHOOK_HANDLE)
00153   RETURN
00154 END IF
00155 !
00156 !
00157 !*      4.     Reading of input  configuration (Grid and interpolation type)
00158 !
00159 IF (GUNIF) THEN
00160   CALL PREP_TEB_UNIF(ILUOUT,HSURF,ZFIELDIN)
00161 ELSE IF (YFILETYPE=='GRIB  ') THEN
00162   CALL PREP_TEB_GRIB(HPROGRAM,HSURF,YFILE,ILUOUT,ZFIELDIN)
00163  ELSE IF (YFILETYPE=='MESONH' .OR. YFILETYPE=='ASCII ' .OR. YFILETYPE=='LFI   ') THEN
00164   CALL PREP_TEB_EXTERN(HPROGRAM,HSURF,YFILE,YFILETYPE,YFILEPGD,YFILEPGDTYPE,ILUOUT,ZFIELDIN)
00165  ELSE IF (YFILETYPE=='BUFFER') THEN
00166   CALL PREP_TEB_BUFFER(HPROGRAM,HSURF,ILUOUT,ZFIELDIN)
00167  ELSE
00168   CALL ABOR1_SFX('PREP_HOR_TEB_FIELD: data file type not supported : '//YFILETYPE)
00169 END IF
00170 !
00171 !*      5.     Horizontal interpolation
00172 !
00173 ALLOCATE(ZFIELDOUT(SIZE(XLAT),SIZE(ZFIELDIN,2)))
00174 !
00175  CALL HOR_INTERPOL(ILUOUT,ZFIELDIN,ZFIELDOUT)
00176 !
00177 !*      6.     Return to historical variable
00178 !
00179 SELECT CASE (HSURF)
00180  CASE('ZS     ') 
00181   ALLOCATE(XZS_LS(SIZE(ZFIELDOUT,1)))
00182   XZS_LS(:) = ZFIELDOUT(:,1)
00183  CASE('WS_ROOF') 
00184   ALLOCATE(XWS_ROOF(SIZE(ZFIELDOUT,1)))
00185   XWS_ROOF(:) = ZFIELDOUT(:,1)
00186  CASE('WS_ROAD')
00187   ALLOCATE(XWS_ROAD(SIZE(ZFIELDOUT,1)))
00188   XWS_ROAD(:) = ZFIELDOUT(:,1)
00189  CASE('TI_ROAD') 
00190   ALLOCATE(XTI_ROAD(SIZE(ZFIELDOUT,1)))
00191   XTI_ROAD(:) = ZFIELDOUT(:,1)
00192  CASE('TI_BLD ') 
00193   ALLOCATE(XTI_BLD (SIZE(ZFIELDOUT,1)))
00194   XTI_BLD (:) = ZFIELDOUT(:,1)
00195  CASE('QI_BLD ') 
00196   ALLOCATE(XQI_BLD (SIZE(ZFIELDOUT,1)))
00197   IF (ALL(ZFIELDOUT .GE. XUNDEF-1.E+5 .AND. ZFIELDOUT .LE. XUNDEF+1.E+5)) THEN
00198      ALLOCATE(ZPS(SIZE(ZFIELDOUT,1)))
00199      ZPS = XP00 - ZRHOA * XG * XZS_LS
00200      IF (XHUI_BLD==XUNDEF) THEN
00201         ZFIELDOUT(:,1) = XHUI_BLD_DEF * QSAT(XTI_BLD, ZPS)
00202      ELSE
00203         ZFIELDOUT(:,1) = XHUI_BLD * QSAT(XTI_BLD, ZPS)
00204      ENDIF
00205      DEALLOCATE(ZPS)
00206   ENDIF
00207   XQI_BLD (:) = ZFIELDOUT(:,1)
00208  CASE('T_WIN1 ') 
00209   ALLOCATE(XT_WIN1 (SIZE(ZFIELDOUT,1)))
00210   XT_WIN1 (:) = ZFIELDOUT(:,1)
00211  CASE('T_WIN2 ') 
00212   ALLOCATE(XT_WIN2 (SIZE(ZFIELDOUT,1)))
00213   XT_WIN2 (:) = ZFIELDOUT(:,1)
00214  CASE('T_FLOOR')
00215   ALLOCATE(XT_FLOOR(SIZE(ZFIELDOUT,1),NFLOOR_LAYER))
00216   CALL INIT_FROM_REF_GRID(XGRID_FLOOR,ZFIELDOUT,XD_FLOOR,XT_FLOOR)
00217  CASE('T_MASS')
00218   ALLOCATE(XT_MASS(SIZE(ZFIELDOUT,1),NFLOOR_LAYER))
00219   CALL INIT_FROM_REF_GRID(XGRID_FLOOR,ZFIELDOUT,XD_FLOOR,XT_MASS)    
00220  CASE('T_ROAD ') 
00221   ALLOCATE(XT_ROAD(SIZE(ZFIELDOUT,1),NROAD_LAYER))
00222   CALL INIT_FROM_REF_GRID(XGRID_ROAD,ZFIELDOUT,XD_ROAD,XT_ROAD)
00223  CASE('T_WALLA')
00224   ALLOCATE(XT_WALL_A(SIZE(ZFIELDOUT,1),NWALL_LAYER))
00225   CALL INIT_FROM_REF_GRID(XGRID_WALL,ZFIELDOUT,XD_WALL,XT_WALL_A)
00226  CASE('T_WALLB')
00227   ALLOCATE(XT_WALL_B(SIZE(ZFIELDOUT,1),NWALL_LAYER))
00228   IF (CWALL_OPT=='UNIF') THEN
00229     XT_WALL_B = XT_WALL_A
00230   ELSE
00231     CALL INIT_FROM_REF_GRID(XGRID_WALL,ZFIELDOUT,XD_WALL,XT_WALL_B)
00232   END IF  
00233  CASE('T_ROOF ') 
00234   ALLOCATE(XT_ROOF(SIZE(ZFIELDOUT,1),NROOF_LAYER))
00235   CALL INIT_FROM_REF_GRID(XGRID_ROOF,ZFIELDOUT,XD_ROOF,XT_ROOF)
00236  CASE('T_CAN  ') 
00237   ALLOCATE(XT_CANYON(SIZE(ZFIELDOUT,1)))
00238   XT_CANYON (:) = ZFIELDOUT(:,1)
00239  CASE('Q_CAN  ') 
00240   ALLOCATE(XQ_CANYON(SIZE(ZFIELDOUT,1)))
00241   XQ_CANYON (:) = ZFIELDOUT(:,1)
00242 END SELECT
00243 !
00244 !-------------------------------------------------------------------------------------
00245 !
00246 !*      7.     Deallocations
00247 !
00248 DEALLOCATE(ZFIELDIN )
00249 DEALLOCATE(ZFIELDOUT)
00250 IF (LHOOK) CALL DR_HOOK('PREP_HOR_TEB_FIELD',1,ZHOOK_HANDLE)
00251 !
00252 !-------------------------------------------------------------------------------------
00253 !-------------------------------------------------------------------------------------
00254 !
00255 CONTAINS
00256 !
00257 !-------------------------------------------------------------------------------------
00258 !-------------------------------------------------------------------------------------
00259 SUBROUTINE INIT_FROM_REF_GRID(PGRID1,PT1,PD2,PT2)
00260 !
00261 USE MODI_INTERP_GRID
00262 !
00263 REAL, DIMENSION(:,:), INTENT(IN)  :: PT1    ! temperature profile
00264 REAL, DIMENSION(:),   INTENT(IN)  :: PGRID1 ! normalized grid
00265 REAL, DIMENSION(:,:), INTENT(IN)  :: PD2    ! output layer thickness
00266 REAL, DIMENSION(:,:), INTENT(OUT) :: PT2    ! temperature profile
00267 !
00268 INTEGER                                  :: JL  ! loop counter
00269 REAL, DIMENSION(SIZE(PT1,1),SIZE(PT1,2)) :: ZD1 ! input grid
00270 REAL, DIMENSION(SIZE(PD2,1),SIZE(PD2,2)) :: ZD2 ! output grid
00271 REAL, DIMENSION(SIZE(PD2,1))             :: ZD  ! output total thickness
00272 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00273 !
00274 IF (LHOOK) CALL DR_HOOK('INIT_FROM_REF_GRID',0,ZHOOK_HANDLE)
00275 ZD2(:,:) = 0.
00276 ZD (:)   = 0.
00277 !
00278 DO JL=1,SIZE(ZD2,2)
00279   ZD2(:,JL) = ZD(:) + PD2(:,JL)/2.
00280   ZD (:)    = ZD(:) + PD2(:,JL)
00281 END DO
00282 !
00283 DO JL=1,SIZE(PT1,2)
00284   ZD1(:,JL) = PGRID1(JL) * ZD(:)
00285 END DO
00286 !
00287  CALL INTERP_GRID(ZD1,PT1,ZD2,PT2)
00288 IF (LHOOK) CALL DR_HOOK('INIT_FROM_REF_GRID',1,ZHOOK_HANDLE)
00289 !
00290 END SUBROUTINE INIT_FROM_REF_GRID
00291 !-------------------------------------------------------------------------------------
00292 !
00293 END SUBROUTINE PREP_HOR_TEB_FIELD