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

Go to the documentation of this file.
00001 !#############################################################
00002 SUBROUTINE INIT_TEB_GREENROOF_n(HPROGRAM,HINIT,KI,KSW,PSW_BANDS)
00003 !#############################################################
00004 !
00005 !!****  *INIT_TEB_GREENROOF_n* - routine to initialize ISBA
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 !!      A. Lemonsu  *Meteo France*      
00027 !!
00028 !!    MODIFICATIONS
00029 !!    -------------
00030 !!      Original    09/2009
00031 !-------------------------------------------------------------------------------
00032 !
00033 !*       0.    DECLARATIONS
00034 !              ------------
00035 !
00036 USE MODD_TYPE_DATE_SURF
00037 USE MODD_TYPE_SNOW
00038 !
00039 USE MODD_TEB_n,                ONLY: TTIME, NTEB_PATCH, LCANOPY
00040 USE MODD_TEB_VEG_n,            ONLY: CALBEDO, CCPSURF,  CROUGH, CPHOTO
00041 USE MODD_TEB_GREENROOF_n,      ONLY: CISBA_GR, LTR_ML_GR,                  &
00042                                      TSNOW, XLAI, XLAIMIN, XZ0, XVEG, XEMIS, &
00043                                      XALBNIR_SOIL, XALBVIS_SOIL, XALBUV_SOIL, &
00044                                      XALBNIR, XALBVIS, XALBUV, XWG, XTG,      &
00045                                      XWSAT, XFAPARC, XFAPIRC, XLAI_EFFC, XMUS,&                                     
00046                                      XWSAT,                                   &
00047                                      LPAR_GREENROOF, XVEGTYPE, XH_TREE,       &
00048                                      NLAYER_GR,                               &
00049                                      XALBVIS_DRY, XALBNIR_DRY, XALBUV_DRY,    &
00050                                      XALBNIR_VEG, XALBVIS_VEG, XALBUV_VEG,    &
00051                                      XALBVIS_WET, XALBNIR_WET, XALBUV_WET,    &
00052                                      XPSN, XPSNG, XPSNV, XPSNV_A
00053 USE MODD_DIAG_MISC_TEB_n,      ONLY: LSURF_DIAG_ALBEDO
00054 !
00055 USE MODD_DATA_COVER_PAR,       ONLY: NVEGTYPE
00056 USE MODD_SURF_PAR,             ONLY: XUNDEF, NUNDEF
00057 !
00058 USE MODD_SURF_ATM,             ONLY: LCPL_ARP
00059 !
00060 USE MODI_GET_LUOUT
00061 USE MODI_READ_PREP_GREENROOF_SNOW
00062 USE MODI_ALLOCATE_TEB_GREENROOF
00063 USE MODI_ABOR1_SFX
00064 USE MODI_GET_CURRENT_TEB_PATCH
00065 USE MODI_READ_TEB_GREENROOF_n
00066 USE MODI_INIT_VEG_GARDEN_n
00067 USE MODI_SOIL_ALBEDO
00068 USE MODI_INIT_FROM_DATA_GREENROOF_n
00069 USE MODI_AVG_ALBEDO_EMIS_GREENROOF
00070 !
00071 USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
00072 USE PARKIND1  ,ONLY : JPRB
00073 !
00074 IMPLICIT NONE
00075 !
00076 !*       0.1   Declarations of arguments
00077 !              -------------------------
00078 !
00079  CHARACTER(LEN=6),                   INTENT(IN)  :: HPROGRAM  ! program calling surf. schemes
00080  CHARACTER(LEN=3),                   INTENT(IN)  :: HINIT     ! choice of fields to initialize
00081 INTEGER,                            INTENT(IN)  :: KI        ! number of points
00082 INTEGER,                            INTENT(IN)  :: KSW       ! number of short-wave spectral bands
00083 REAL,             DIMENSION(KSW),   INTENT(IN)  :: PSW_BANDS ! middle wavelength of each band
00084 !
00085 !*       0.2   Declarations of local variables
00086 !              -------------------------------
00087 !
00088 INTEGER           :: ILUOUT   ! unit of output listing file
00089 !
00090 INTEGER           :: IDECADE  ! decade of simulation
00091 !
00092 INTEGER :: JTEB_PATCH  ! loop counter on TEB patches
00093  CHARACTER(LEN=3) :: YPATCH ! patch identificator
00094 !
00095 REAL, DIMENSION(KI)               :: ZWG1 ! work array for surface water content
00096 REAL, DIMENSION(KI)               :: ZTG1 ! work array for surface temperature
00097 REAL, DIMENSION(KI,KSW)           :: ZDIR_ALB  ! direct albedo for each band
00098 REAL, DIMENSION(KI,KSW)           :: ZSCA_ALB  ! diffuse albedo for each band
00099 REAL, DIMENSION(KI)               :: ZEMIS     ! emissivity
00100 REAL, DIMENSION(KI)               :: ZTSRAD    ! radiative temperature
00101 !
00102 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00103 !
00104 !-------------------------------------------------------------------------------
00105 !
00106 !               Initialisation for IO
00107 !
00108 IF (LHOOK) CALL DR_HOOK('INIT_TEB_GREENROOF_N',0,ZHOOK_HANDLE)
00109  CALL GET_LUOUT(HPROGRAM,ILUOUT)
00110 !
00111 !-------------------------------------------------------------------------------
00112 !
00113 !*       1.     Reading of snow configuration:
00114 !               ------------------------------
00115 !
00116 !* initialization of snow scheme (TSNOW defined in MODD_TEB_GREENROOF_n)
00117 !
00118 IF (HINIT=='PRE') THEN
00119    CALL READ_PREP_GREENROOF_SNOW(HPROGRAM,TSNOW%SCHEME,TSNOW%NLAYER)
00120 !
00121    IF (TSNOW%SCHEME.NE.'3-L' .AND. TSNOW%SCHEME.NE.'CRO' .AND. CISBA_GR=='DIF') THEN
00122     CALL ABOR1_SFX("INIT_TEB_GREENROOF_n: WITH CISBA_GR = DIF, CSNOW MUST BE 3-L OR CRO")
00123   ENDIF
00124   IF (LHOOK) CALL DR_HOOK('INIT_TEB_GREENROOF_N',1,ZHOOK_HANDLE)
00125   RETURN
00126 ENDIF
00127 !-------------------------------------------------------------------------------
00128 !
00129  CALL ALLOCATE_TEB_GREENROOF(KI, NLAYER_GR)  
00130 !
00131 !-------------------------------------------------------------------------------
00132 !
00133 IF( CCPSURF=='DRY' .AND. LCPL_ARP ) THEN
00134   CALL ABOR1_SFX('CCPSURF=DRY must not be used with LCPL_ARP')
00135 ENDIF
00136 !
00137 !-------------------------------------------------------------------------------
00138 !
00139 IF (HINIT/='ALL') THEN
00140   IF (LHOOK) CALL DR_HOOK('INIT_TEB_GREENROOF_N',1,ZHOOK_HANDLE)      
00141   RETURN
00142 ENDIF
00143 !
00144 !-------------------------------------------------------------------------------
00145 !
00146 !*       2.     Prognostic and semi-prognostic fields
00147 !               -------------------------------------
00148 !
00149 !* allocation of urban green area variables
00150 !
00151 !
00152   YPATCH='   '
00153   CALL GET_CURRENT_TEB_PATCH(JTEB_PATCH)
00154   IF (NTEB_PATCH>1) WRITE(YPATCH,FMT='(A,I1,A)') 'T',JTEB_PATCH,'_'
00155 !
00156   CALL READ_TEB_GREENROOF_n(HPROGRAM,YPATCH)
00157 !
00158 !
00159  CALL INIT_VEG_GARDEN_n(KI, LCANOPY, CROUGH, TSNOW, &
00160                    CPHOTO, XLAIMIN, XH_TREE, XVEGTYPE, XLAI, XZ0, XVEG, XEMIS, &
00161                    LTR_ML_GR, XFAPARC, XFAPIRC, XLAI_EFFC, XMUS, &
00162                    XALBNIR_SOIL, XALBVIS_SOIL, XALBUV_SOIL, XALBNIR, XALBVIS, XALBUV, &
00163                    LSURF_DIAG_ALBEDO, XPSN, XPSNG, XPSNV, XPSNV_A, &
00164                    ZDIR_ALB, ZSCA_ALB, ZEMIS, ZTSRAD )
00165 !
00166 ZWG1(:) = XWG(:,1)
00167 ZTG1(:) = XTG(:,1)
00168 !
00169 IF (.NOT. LPAR_GREENROOF) THEN
00170   CALL SOIL_ALBEDO(CALBEDO,                               &
00171                      XWSAT(:,1),ZWG1,                       &
00172                      XALBVIS_DRY,XALBNIR_DRY,XALBUV_DRY,    &
00173                      XALBVIS_WET,XALBNIR_WET,XALBUV_WET,    &
00174                      XALBVIS_SOIL,XALBNIR_SOIL,XALBUV_SOIL  )  
00175 ELSE
00176   IF (TTIME%TDATE%MONTH /= NUNDEF) THEN
00177     IDECADE = 3 * ( TTIME%TDATE%MONTH - 1 ) + MIN(TTIME%TDATE%DAY-1,29) / 10 + 1
00178   ELSE
00179     IDECADE = 1
00180   END IF
00181   CALL INIT_FROM_DATA_GREENROOF_n(IDECADE,CPHOTO,              &
00182                                   PALBNIR_SOIL=XALBNIR_SOIL,   &
00183                                   PALBVIS_SOIL=XALBVIS_SOIL,   &
00184                                   PALBUV_SOIL=XALBUV_SOIL      )  
00185 END IF
00186 !
00187 ! 
00188  CALL AVG_ALBEDO_EMIS_GREENROOF(CALBEDO,                                &
00189                                XVEG,XZ0,XLAI,ZTG1,                     &
00190                                PSW_BANDS,                              &
00191                                XALBNIR_VEG,XALBVIS_VEG,XALBUV_VEG,     &
00192                                XALBNIR_SOIL,XALBVIS_SOIL,XALBUV_SOIL,  &
00193                                XEMIS,                                  &
00194                                TSNOW,                                  &
00195                                XALBNIR,XALBVIS,XALBUV,                 &
00196                                ZDIR_ALB, ZSCA_ALB,                     &
00197                                ZEMIS,ZTSRAD                            )  
00198 !
00199 !-------------------------------------------------------------------------------
00200 !
00201 IF (LHOOK) CALL DR_HOOK('INIT_TEB_GREENROOF_N',1,ZHOOK_HANDLE)
00202 !
00203 !-------------------------------------------------------------------------------
00204 !
00205 !
00206 END SUBROUTINE INIT_TEB_GREENROOF_n