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

Go to the documentation of this file.
00001 !#############################################################
00002 SUBROUTINE INIT_VEG_GARDEN_n(KI, OCANOPY, HROUGH, TPSNOW, &
00003                          HPHOTO, PLAIMIN, PH_TREE, PVEGTYPE, PLAI, PZ0, PVEG, PEMIS, &
00004                          OTR_ML, PFAPARC, PFAPIRC, PLAI_EFFC, PMUS, &
00005                          PALBNIR_SOIL, PALBVIS_SOIL, PALBUV_SOIL, PALBNIR, PALBVIS, PALBUV, &
00006                          OSURF_DIAG_ALBEDO, PPSN, PPSNG, PPSNV, PPSNV_A, &
00007                          PDIR_ALB, PSCA_ALB, PEMIS_OUT, PTSRAD )  
00008 !#############################################################
00009 !
00010 !!****  *INIT_VEG_GARDEN_n* - routine to initialize ISBA
00011 !!
00012 !!    PURPOSE
00013 !!    -------
00014 !!
00015 !!**  METHOD
00016 !!    ------
00017 !!
00018 !!    EXTERNAL
00019 !!    --------
00020 !!
00021 !!
00022 !!    IMPLICIT ARGUMENTS
00023 !!    ------------------
00024 !!
00025 !!    REFERENCE
00026 !!    ---------
00027 !!
00028 !!
00029 !!    AUTHOR
00030 !!    ------
00031 !!      V. Masson   *Meteo France*      
00032 !!
00033 !!    MODIFICATIONS
00034 !!
00035 !-------------------------------------------------------------------------------
00036 !
00037 !*       0.    DECLARATIONS
00038 !              ------------
00039 !
00040 USE MODD_TYPE_SNOW
00041 USE MODD_DATA_COVER_PAR,  ONLY: NVEGTYPE
00042 !
00043 USE MODI_INIT_VEG_n
00044 !
00045 USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
00046 USE PARKIND1  ,ONLY : JPRB
00047 !
00048 IMPLICIT NONE
00049 !
00050 !*       0.1   Declarations of arguments
00051 !              -------------------------
00052 !
00053 INTEGER, INTENT(IN) :: KI
00054 LOGICAL, INTENT(IN) :: OCANOPY
00055  CHARACTER(LEN=4), INTENT(INOUT) :: HROUGH
00056 TYPE(SURF_SNOW),      INTENT(INOUT) :: TPSNOW  ! snow characteristics
00057 !
00058  CHARACTER(LEN=3), INTENT(IN) :: HPHOTO
00059 REAL, DIMENSION(:), INTENT(IN) :: PLAIMIN
00060 REAL, DIMENSION(:), INTENT(IN) :: PH_TREE
00061 REAL, DIMENSION(:,:), INTENT(IN) :: PVEGTYPE
00062 REAL, DIMENSION(:), INTENT(INOUT) :: PLAI
00063 REAL, DIMENSION(:), INTENT(INOUT) :: PZ0
00064 REAL, DIMENSION(:), INTENT(INOUT) :: PVEG
00065 REAL, DIMENSION(:), INTENT(INOUT) :: PEMIS
00066 !
00067 LOGICAL, INTENT(IN) :: OTR_ML
00068 REAL, DIMENSION(:), POINTER :: PFAPARC
00069 REAL, DIMENSION(:), POINTER :: PFAPIRC
00070 REAL, DIMENSION(:), POINTER :: PLAI_EFFC
00071 REAL, DIMENSION(:), POINTER :: PMUS
00072 !
00073 REAL, DIMENSION(:), POINTER :: PALBNIR_SOIL
00074 REAL, DIMENSION(:), POINTER :: PALBVIS_SOIL
00075 REAL, DIMENSION(:), POINTER :: PALBUV_SOIL
00076 REAL, DIMENSION(:), POINTER :: PALBNIR
00077 REAL, DIMENSION(:), POINTER :: PALBVIS
00078 REAL, DIMENSION(:), POINTER :: PALBUV
00079 !
00080 LOGICAL, INTENT(OUT) :: OSURF_DIAG_ALBEDO
00081 !
00082 REAL, DIMENSION(:), POINTER :: PPSN
00083 REAL, DIMENSION(:), POINTER :: PPSNG
00084 REAL, DIMENSION(:), POINTER :: PPSNV
00085 REAL, DIMENSION(:), POINTER :: PPSNV_A
00086 !
00087 REAL, DIMENSION(:,:), INTENT(OUT) :: PDIR_ALB
00088 REAL, DIMENSION(:,:), INTENT(OUT) :: PSCA_ALB
00089 REAL, DIMENSION(:), INTENT(OUT) :: PEMIS_OUT
00090 REAL, DIMENSION(:), INTENT(OUT) :: PTSRAD
00091 !
00092 !*       0.2   Declarations of local variables
00093 !              -------------------------------
00094 !
00095 REAL, DIMENSION(:,:), POINTER :: ZFAPARC
00096 REAL, DIMENSION(:,:), POINTER :: ZFAPIRC
00097 REAL, DIMENSION(:,:), POINTER :: ZLAI_EFFC
00098 REAL, DIMENSION(:,:), POINTER :: ZMUS
00099 !
00100 REAL, DIMENSION(:,:), POINTER :: ZALBNIR_SOIL
00101 REAL, DIMENSION(:,:), POINTER :: ZALBVIS_SOIL
00102 REAL, DIMENSION(:,:), POINTER :: ZALBUV_SOIL
00103 REAL, DIMENSION(:,:), POINTER :: ZALBNIR
00104 REAL, DIMENSION(:,:), POINTER :: ZALBVIS
00105 REAL, DIMENSION(:,:), POINTER :: ZALBUV
00106 !
00107 REAL, DIMENSION(:,:), POINTER :: ZPSN
00108 REAL, DIMENSION(:,:), POINTER :: ZPSNG
00109 REAL, DIMENSION(:,:), POINTER :: ZPSNV
00110 REAL, DIMENSION(:,:), POINTER :: ZPSNV_A
00111 !
00112 REAL, DIMENSION(KI,NVEGTYPE,1) :: ZVEGTYPE_PATCH
00113 !
00114 REAL, DIMENSION(SIZE(PLAIMIN),1) :: ZLAIMIN
00115 REAL, DIMENSION(SIZE(PH_TREE),1) :: ZH_TREE
00116 REAL, DIMENSION(SIZE(PLAI),1) :: ZLAI
00117 REAL, DIMENSION(SIZE(PZ0),1) :: ZZ0
00118 REAL, DIMENSION(SIZE(PVEG),1) :: ZVEG
00119 REAL, DIMENSION(SIZE(PEMIS),1) :: ZEMIS
00120 !
00121 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00122 !
00123 !-------------------------------------------------------------------------------
00124 !
00125 !               Initialisation for IO
00126 !
00127 IF (LHOOK) CALL DR_HOOK('INIT_VEG_GARDEN_n',0,ZHOOK_HANDLE)
00128 !
00129 NULLIFY(ZFAPARC)
00130 NULLIFY(ZFAPIRC)
00131 NULLIFY(ZLAI_EFFC)
00132 NULLIFY(ZMUS)
00133 !
00134 NULLIFY(ZALBNIR_SOIL)
00135 NULLIFY(ZALBVIS_SOIL)
00136 NULLIFY(ZALBUV_SOIL)
00137 NULLIFY(ZALBNIR)
00138 NULLIFY(ZALBVIS)
00139 NULLIFY(ZALBUV)
00140 !
00141 NULLIFY(ZPSN)
00142 NULLIFY(ZPSNG)
00143 NULLIFY(ZPSNV)
00144 NULLIFY(ZPSNV_A)
00145 !
00146 ZLAIMIN(:,1) = PLAIMIN(:)
00147 ZH_TREE(:,1) = PH_TREE(:)
00148 ZLAI(:,1) = PLAI(:)
00149 ZZ0(:,1) = PZ0(:)
00150 ZVEG(:,1) = PVEG(:)
00151 ZEMIS(:,1) = PEMIS(:)
00152 !
00153 ZVEGTYPE_PATCH(:,:,1) = PVEGTYPE(:,:)
00154 !-------------------------------------------------------------------------------
00155 !
00156  CALL INIT_VEG_n(1, KI, OCANOPY, HROUGH, TPSNOW, &
00157                    HPHOTO, ZLAIMIN, ZH_TREE, ZVEGTYPE_PATCH, ZLAI, ZZ0, ZVEG, ZEMIS, &
00158                    OTR_ML, ZFAPARC, ZFAPIRC, ZLAI_EFFC, ZMUS, &
00159                    ZALBNIR_SOIL, ZALBVIS_SOIL, ZALBUV_SOIL, ZALBNIR, ZALBVIS, ZALBUV, &
00160                    OSURF_DIAG_ALBEDO, ZPSN, ZPSNG, ZPSNV, ZPSNV_A, &
00161                    PDIR_ALB, PSCA_ALB, PEMIS, PTSRAD )
00162 !
00163 PLAI(:) = ZLAI(:,1)
00164 PZ0(:) = ZZ0(:,1)
00165 PVEG(:) = ZVEG(:,1)
00166 PEMIS(:) = ZEMIS(:,1)
00167 !
00168 ALLOCATE(PFAPARC(SIZE(ZFAPARC,1)))
00169 IF (SIZE(ZFAPARC)>0) &
00170 PFAPARC(:)=ZFAPARC(:,1)
00171 
00172 ALLOCATE(PFAPIRC(SIZE(ZFAPIRC,1)))
00173 IF (SIZE(ZFAPIRC)>0) &
00174 PFAPIRC(:)=ZFAPIRC(:,1)
00175 
00176 ALLOCATE(PLAI_EFFC(SIZE(ZLAI_EFFC,1)))
00177 IF (SIZE(ZLAI_EFFC)>0) &
00178 PLAI_EFFC(:)=ZLAI_EFFC(:,1)
00179 
00180 ALLOCATE(PMUS(SIZE(ZMUS,1)))
00181 IF (SIZE(ZMUS)>0) &
00182 PMUS(:)=ZMUS(:,1)
00183 !
00184 ALLOCATE(PALBNIR_SOIL(SIZE(ZALBNIR_SOIL,1)))
00185 PALBNIR_SOIL(:)=ZALBNIR_SOIL(:,1)
00186 ALLOCATE(PALBVIS_SOIL(SIZE(ZALBVIS_SOIL,1)))
00187 PALBVIS_SOIL(:)=ZALBVIS_SOIL(:,1)
00188 ALLOCATE(PALBUV_SOIL(SIZE(ZALBUV_SOIL,1)))
00189 PALBUV_SOIL(:)=ZALBUV_SOIL(:,1)
00190 ALLOCATE(PALBNIR(SIZE(ZALBNIR,1)))
00191 PALBNIR(:)=ZALBNIR(:,1)
00192 ALLOCATE(PALBVIS(SIZE(ZALBVIS,1)))
00193 PALBVIS(:)=ZALBVIS(:,1)
00194 ALLOCATE(PALBUV(SIZE(ZALBUV,1)))
00195 PALBUV(:)=ZALBUV(:,1)
00196 !
00197 ALLOCATE(PPSN(SIZE(ZPSN,1)))
00198 IF (SIZE(ZPSN)>0) &
00199 PPSN(:)=ZPSN(:,1)
00200 
00201 ALLOCATE(PPSNG(SIZE(ZPSNG,1)))
00202 IF (SIZE(ZPSNG)>0) &
00203 PPSNG(:)=ZPSNG(:,1)
00204 
00205 ALLOCATE(PPSNV(SIZE(ZPSNV,1)))
00206 IF (SIZE(ZPSNV)>0) &
00207 PPSNV(:)=ZPSNV(:,1)
00208 
00209 ALLOCATE(PPSNV_A(SIZE(ZPSNV_A,1)))
00210 IF (SIZE(ZPSNV_A)>0) &
00211 PPSNV_A(:)=ZPSNV_A(:,1)
00212 !
00213 IF (LHOOK) CALL DR_HOOK('INIT_VEG_GARDEN_n',1,ZHOOK_HANDLE)
00214 !
00215 END SUBROUTINE INIT_VEG_GARDEN_n