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

Go to the documentation of this file.
00001 !     #########
00002       SUBROUTINE READ_PREP_TEB_CONF(HPROGRAM,HVAR,HFILE,HFILETYPE,HFILEPGD,HFILEPGDTYPE,   &
00003                                     HATMFILE,HATMFILETYPE,HPGDFILE,HPGDFILETYPE,KLUOUT,OUNIF)
00004 !     #######################################################
00005 !
00006 !!****  *READ_PREP_TEB_CONF* - routine to read the configuration for TEB
00007 !!                             fields preparation
00008 !!
00009 !!    PURPOSE
00010 !!    -------
00011 !!
00012 !!**  METHOD
00013 !!    ------
00014 !!
00015 !!    EXTERNAL
00016 !!    --------
00017 !!
00018 !!
00019 !!    IMPLICIT ARGUMENTS
00020 !!    ------------------
00021 !!
00022 !!    REFERENCE
00023 !!    ---------
00024 !!
00025 !!
00026 !!    AUTHOR
00027 !!    ------
00028 !!      V. Masson   *Meteo France*      
00029 !!
00030 !!    MODIFICATIONS
00031 !!    -------------
00032 !!      Original    01/2004 
00033 !!      P. Le Moigne 10/2005, Phasage Arome
00034 !-------------------------------------------------------------------------------
00035 !
00036 !*       0.    DECLARATIONS
00037 !              ------------
00038 !
00039 USE MODI_READ_PREP_SURF_ATM_CONF
00040 !
00041 USE MODN_PREP_TEB, ONLY : CFILE_TS, CTYPE_TS
00042 USE MODD_PREP_TEB, ONLY : CFILE_TEB, CTYPE, CFILEPGD_TEB, CTYPEPGD,                 &
00043                           CFILE_WS, CTYPE_WS, XWS_ROOF, XWS_ROAD,                   &
00044                           XTS_ROOF, XTS_ROAD, XTS_WALL, XTI_BLD, XTI_ROAD,          &
00045                           XT_CAN, XQ_CAN, XWS_ROOF_DEF, XWS_ROAD_DEF, XTI_BLD_DEF,  &
00046                           XHUI_BLD_DEF, XHUI_BLD  
00047 !
00048 USE MODD_SURF_PAR,   ONLY : XUNDEF
00049 !
00050 USE MODE_THERMOS
00051 !
00052 USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
00053 USE PARKIND1  ,ONLY : JPRB
00054 !
00055 USE MODI_ABOR1_SFX
00056 !
00057 IMPLICIT NONE
00058 !
00059 !*       0.1   Declarations of arguments
00060 !              -------------------------
00061 !
00062  CHARACTER(LEN=6),  INTENT(IN)  :: HPROGRAM ! program calling ISBA
00063  CHARACTER(LEN=7),  INTENT(IN)  :: HVAR     ! variable treated
00064  CHARACTER(LEN=28), INTENT(OUT) :: HFILE    ! file name
00065  CHARACTER(LEN=6),  INTENT(OUT) :: HFILETYPE! file type
00066  CHARACTER(LEN=28), INTENT(OUT) :: HFILEPGD    ! file name
00067  CHARACTER(LEN=6),  INTENT(OUT) :: HFILEPGDTYPE! file type
00068  CHARACTER(LEN=28), INTENT(IN)  :: HATMFILE    ! atmospheric file name
00069  CHARACTER(LEN=6),  INTENT(IN)  :: HATMFILETYPE! atmospheric file type
00070  CHARACTER(LEN=28), INTENT(IN)  :: HPGDFILE    ! atmospheric file name
00071  CHARACTER(LEN=6),  INTENT(IN)  :: HPGDFILETYPE! atmospheric file type
00072 INTEGER,           INTENT(IN)  :: KLUOUT   ! logical unit of output listing
00073 LOGICAL,           INTENT(OUT) :: OUNIF    ! flag for prescribed uniform field
00074 
00075 !
00076 !*       0.2   Declarations of local variables
00077 !              -------------------------------
00078 !
00079 INTEGER           :: IRESP          ! IRESP  : return-code if a problem appears 
00080                                     ! at the open of the file in LFI  routines 
00081 INTEGER           :: ILUNAM         ! Logical unit of namelist file
00082 !
00083  CHARACTER(LEN=28) :: YNAMELIST      ! namelist file
00084 !
00085 LOGICAL           :: GFOUND         ! Return code when searching namelist
00086 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00087 !-------------------------------------------------------------------------------
00088 !
00089 !
00090 IF (LHOOK) CALL DR_HOOK('READ_PREP_TEB_CONF',0,ZHOOK_HANDLE)
00091 HFILE = '                            '
00092 HFILETYPE = '      '
00093 !
00094 HFILEPGD = '                         '
00095 HFILEPGDTYPE = '      '
00096 !
00097 OUNIF     = .FALSE.
00098 !
00099 !-------------------------------------------------------------------------------
00100 !
00101 !* choice of input file
00102 !  --------------------
00103 !
00104 SELECT CASE (HVAR)
00105   CASE ('WS_ROOF','WS_ROAD')
00106     IF (LEN_TRIM(CFILE_WS)>0 .AND. LEN_TRIM(CTYPE_WS)>0 ) THEN
00107       HFILE     = CFILE_WS
00108       HFILETYPE = CTYPE_WS
00109     END IF
00110   CASE ('T_ROOF ','T_ROAD ','T_WALL ','T_FLOOR', 'T_MASS')
00111     IF (LEN_TRIM(CFILE_TS)>0 .AND. LEN_TRIM(CTYPE_TS)>0 ) THEN
00112       HFILE     = CFILE_TS
00113       HFILETYPE = CTYPE_TS
00114     END IF
00115 END SELECT
00116 !
00117 IF (LEN_TRIM(HFILE)==0 .AND. LEN_TRIM(CFILE_TEB)>0 .AND. LEN_TRIM(CTYPE)>0) THEN
00118   HFILE     = CFILE_TEB
00119   HFILETYPE = CTYPE
00120 END IF
00121 !
00122 IF (LEN_TRIM(HFILEPGD)==0 .AND. LEN_TRIM(CFILEPGD_TEB)>0 .AND. LEN_TRIM(CTYPEPGD)>0) THEN
00123   HFILEPGD     = CFILEPGD_TEB
00124   HFILEPGDTYPE = CTYPEPGD
00125 END IF
00126 !
00127 !! If no file name in the scheme namelist,
00128 !! try to find a name in NAM_SURF_ATM
00129 !
00130 IF (LEN_TRIM(HFILE)==0) THEN
00131 !
00132  CALL READ_PREP_SURF_ATM_CONF(HPROGRAM,HFILE,HFILETYPE,HFILEPGD,HFILEPGDTYPE,&
00133                              HATMFILE,HATMFILETYPE,HPGDFILE,HPGDFILETYPE,KLUOUT)
00134 !
00135 END IF
00136 !-------------------------------------------------------------------------------
00137 !
00138 !* Is an uniform field prescribed?
00139 !  ------------------------------
00140 !
00141 SELECT CASE (HVAR)
00142   CASE ('WS_ROOF')
00143     OUNIF = (XWS_ROOF/=XUNDEF) 
00144   CASE ('WS_ROAD')
00145     OUNIF = (XWS_ROAD/=XUNDEF) 
00146   CASE ('TI_BLD ')
00147     OUNIF = (XTI_BLD/=XUNDEF)  
00148   CASE ('TI_ROAD')
00149     OUNIF = (XTI_ROAD/=XUNDEF)    
00150   CASE ('T_ROAD ')
00151     OUNIF = (XTS_ROAD/=XUNDEF) 
00152   CASE ('T_WALL ','T_WALLA','T_WALLB')
00153     OUNIF = (XTS_WALL/=XUNDEF)     
00154   CASE ('T_ROOF ')
00155     OUNIF = (XTS_ROOF/=XUNDEF) 
00156   CASE ('T_FLOOR')
00157     OUNIF = (XTI_ROAD/=XUNDEF)     
00158   CASE ('T_MASS') 
00159     OUNIF = (XTI_BLD/=XUNDEF)
00160   CASE ('T_WIN1') 
00161     OUNIF = (XTS_WALL/=XUNDEF)
00162   CASE ('T_WIN2') 
00163     OUNIF = (XTI_BLD/=XUNDEF)
00164   CASE ('QI_BLD ')
00165     OUNIF = (XHUI_BLD/=XUNDEF .AND. XTI_BLD/=XUNDEF)     
00166 END SELECT
00167 !
00168 !-------------------------------------------------------------------------------
00169 !
00170 !* building temperature available for temperature profiles when file is present
00171 !  ----------------------------------------------------------------------------
00172 !
00173 !IF (LEN_TRIM(HFILETYPE)>0 .AND. .NOT. OUNIF) THEN
00174 !  IF (HVAR=='T_ROOF ' .OR. HVAR=='T_WALL' .OR. HVAR=='TI_BLD' .AND. XTI_BLD==XUNDEF) XTI_BLD=XTI_BLD_DEF
00175 !END IF
00176 !
00177 !-------------------------------------------------------------------------------
00178 !
00179 !* If no file and no uniform field is prescribed: default values used
00180 !  ---------------------------------------------
00181 !
00182 IF (LEN_TRIM(HFILETYPE)==0 .AND. .NOT. OUNIF) THEN
00183   SELECT CASE (HVAR)
00184     CASE ('ZS     ')
00185       OUNIF = .TRUE.
00186     CASE ('WS_ROOF')
00187       XWS_ROOF = XWS_ROOF_DEF
00188       OUNIF = .TRUE.
00189     CASE ('WS_ROAD')
00190       XWS_ROAD = XWS_ROAD_DEF
00191       OUNIF = .TRUE.
00192     CASE ('TI_BLD ')
00193       XTI_BLD  = XTI_BLD_DEF
00194       OUNIF = .TRUE.
00195     CASE ('Q_CAN  ')
00196       IF (XT_CAN/=XUNDEF) THEN
00197          XQ_CAN = XHUI_BLD_DEF * QSAT(XT_CAN, 100000.)
00198          OUNIF = .TRUE.
00199       ELSE 
00200          CALL ABOR1_SFX("READ_PREP_TEB_CONF: DON'T KNOW HOW TO INITIALIZE Q_CAN ")
00201       END IF            
00202     CASE ('T_CAN  ')  
00203       IF (XTS_ROAD/=XUNDEF) THEN
00204         XT_CAN = XTS_ROAD
00205       ELSE IF (XTS_WALL/=XUNDEF) THEN
00206         XT_CAN = XTS_WALL
00207       ELSE IF (XTS_ROOF/=XUNDEF) THEN
00208         XT_CAN = XTS_ROOF
00209       ELSE
00210         CALL ABOR1_SFX('READ_PREP_TEB_CONF: AN INPUT VALUE IS REQUIRED FOR '//HVAR)
00211       END IF 
00212     CASE ('T_WIN1  ')
00213       IF (XTS_WALL==XUNDEF) THEN
00214          CALL ABOR1_SFX('READ_PREP_TEB_CONF: AN INPUT VALUE IS REQUIRED FOR TS_WALL TO INITIALIZE T_WIN1')
00215       ELSE 
00216          OUNIF = .TRUE.
00217       ENDIF
00218     CASE ('T_WIN2  ') 
00219       XTI_BLD  = XTI_BLD_DEF
00220       OUNIF = .TRUE.
00221     CASE ('QI_BLD  ') 
00222       XHUI_BLD  = XHUI_BLD_DEF
00223       OUNIF = .TRUE.
00224     CASE ('DATE   ')
00225       IF (LHOOK) CALL DR_HOOK('READ_PREP_TEB_CONF',1,ZHOOK_HANDLE)
00226       RETURN
00227     CASE ('SN_ROOF','SN_ROAD')
00228       OUNIF = .TRUE.
00229     CASE DEFAULT
00230       CALL ABOR1_SFX('READ_PREP_TEB_CONF: AN INPUT FILE OR A UNIFORM VALUE IS REQUIRED FOR '//HVAR)
00231    END SELECT
00232 END IF
00233 !
00234 !-------------------------------------------------------------------------------
00235 !
00236 !* no file given ? nor specific value in namelist? One takes the default value.
00237 !
00238 IF (HFILETYPE=='      ' .AND. .NOT. OUNIF) THEN
00239   IF (HVAR(1:2)/='ZS') WRITE(KLUOUT,*) 'NO FILE FOR FIELD ',HVAR, &
00240                                         ': UNIFORM DEFAULT FIELD IS PRESCRIBED'
00241   OUNIF = .TRUE.
00242 END IF
00243 IF (LHOOK) CALL DR_HOOK('READ_PREP_TEB_CONF',1,ZHOOK_HANDLE)
00244 !
00245 !-------------------------------------------------------------------------------
00246 !
00247 END SUBROUTINE READ_PREP_TEB_CONF