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

Go to the documentation of this file.
00001 !     #########
00002       SUBROUTINE PGD_TEB_GARDEN_PAR(HPROGRAM)
00003 !     ##############################################################
00004 !
00005 !!**** *PGD_TEB_GARDEN_PAR* monitor for averaging and interpolations of cover fractions
00006 !!
00007 !!    PURPOSE
00008 !!    -------
00009 !!
00010 !!    METHOD
00011 !!    ------
00012 !!   
00013 !
00014 !!    EXTERNAL
00015 !!    --------
00016 !!
00017 !!    IMPLICIT ARGUMENTS
00018 !!    ------------------
00019 !!
00020 !!    REFERENCE
00021 !!    ---------
00022 !!
00023 !!    AUTHOR
00024 !!    ------
00025 !!
00026 !!    A. Lemonsu       Meteo-France
00027 !!
00028 !!    MODIFICATION
00029 !!    ------------
00030 !!
00031 !!    Original    09/2009
00032 !!
00033 !----------------------------------------------------------------------------
00034 !
00035 !*    0.     DECLARATION
00036 !            -----------
00037 !
00038 USE MODD_DATA_COVER_PAR,    ONLY : NVEGTYPE
00039 USE MODD_SURF_PAR,          ONLY : XUNDEF
00040 USE MODD_TEB_GRID_n,        ONLY : NDIM
00041 USE MODD_TEB_VEG_n,         ONLY : CISBA, CPHOTO
00042 USE MODD_TEB_GARDEN_n,      ONLY : NGROUND_LAYER, LPAR_GARDEN,              &
00043                                    CTYPE_HVEG, CTYPE_LVEG, CTYPE_NVEG  
00044 USE MODD_DATA_TEB_GARDEN_n, ONLY : XDATA_FRAC_HVEG, XDATA_FRAC_LVEG,        &
00045                                    XDATA_FRAC_NVEG,                         &
00046                                    XDATA_LAI_HVEG , XDATA_LAI_LVEG ,        &
00047                                    XDATA_H_HVEG, NTIME_n => NTIME
00048 !
00049 USE MODD_PGDWORK,           ONLY : CATYPE
00050 !
00051 USE MODI_GET_LUOUT
00052 USE MODI_OPEN_NAMELIST
00053 USE MODI_CLOSE_NAMELIST
00054 USE MODI_PGD_FIELD
00055 USE MODI_ABOR1_SFX
00056 !
00057 USE MODE_POS_SURF
00058 !
00059 !
00060 USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
00061 USE PARKIND1  ,ONLY : JPRB
00062 !
00063 IMPLICIT NONE
00064 !
00065 !*    0.1    Declaration of arguments
00066 !            ------------------------
00067 !
00068  CHARACTER(LEN=6),    INTENT(IN)    :: HPROGRAM     ! Type of program
00069 !
00070 !
00071 !*    0.2    Declaration of local variables
00072 !            ------------------------------
00073 !
00074 INTEGER               :: ILUOUT    ! output listing logical unit
00075 INTEGER               :: ILUNAM    ! namelist file  logical unit
00076 LOGICAL               :: GFOUND    ! true if namelist is found
00077 LOGICAL               :: GNO_PAR_GARDEN ! true no fraction is prescribed
00078 INTEGER               :: JTIME     ! loop counter on time
00079 !
00080 !*    0.3    Declaration of namelists
00081 !            ------------------------
00082 !
00083 INTEGER                                :: NTIME
00084 INTEGER, PARAMETER                     :: NGROUND_MAX  = 20
00085 INTEGER, PARAMETER                     :: NVEGTYPE_MAX = 12
00086 INTEGER, PARAMETER                     :: NTIME_MAX    = 12
00087 !
00088 ! type of vegetation
00089 !
00090  CHARACTER(LEN=4)                       :: CTYP_GARDEN_HVEG ! type of high vegetation
00091  CHARACTER(LEN=4)                       :: CTYP_GARDEN_LVEG ! type of low  vegetation
00092  CHARACTER(LEN=4)                       :: CTYP_GARDEN_NVEG ! type of bare soil
00093 !
00094 ! uniform value
00095 !
00096 REAL                                   :: XUNIF_FRAC_HVEG  ! fractions of high vegetation
00097 REAL                                   :: XUNIF_FRAC_LVEG  ! fractions of low  vegetation
00098 REAL                                   :: XUNIF_FRAC_NVEG  ! fractions of bare soil
00099 REAL,DIMENSION(NTIME_MAX)              :: XUNIF_LAI_HVEG   ! LAI       of high vegetation
00100 REAL,DIMENSION(NTIME_MAX)              :: XUNIF_LAI_LVEG   ! LAI       of low  vegetation
00101 REAL                                   :: XUNIF_H_HVEG     ! height of trees
00102 !
00103 ! name of files containing data
00104 !
00105  CHARACTER(LEN=28)                      :: CFNAM_FRAC_HVEG  ! fractions of high vegetation
00106  CHARACTER(LEN=28)                      :: CFNAM_FRAC_LVEG  ! fractions of low  vegetation
00107  CHARACTER(LEN=28)                      :: CFNAM_FRAC_NVEG  ! fractions of bare soil
00108  CHARACTER(LEN=28),DIMENSION(NTIME_MAX) :: CFNAM_LAI_HVEG   ! LAI       of high vegetation
00109  CHARACTER(LEN=28),DIMENSION(NTIME_MAX) :: CFNAM_LAI_LVEG   ! LAI       of low  vegetation
00110  CHARACTER(LEN=28)                      :: CFNAM_H_HVEG     ! height of trees
00111 !
00112 ! type of files containing data
00113 !
00114  CHARACTER(LEN=28)                      :: CFTYP_FRAC_HVEG  ! fractions of high vegetation
00115  CHARACTER(LEN=28)                      :: CFTYP_FRAC_LVEG  ! fractions of low  vegetation
00116  CHARACTER(LEN=28)                      :: CFTYP_FRAC_NVEG  ! fractions of bare soil
00117  CHARACTER(LEN=28),DIMENSION(NTIME_MAX) :: CFTYP_LAI_HVEG   ! LAI       of high vegetation
00118  CHARACTER(LEN=28),DIMENSION(NTIME_MAX) :: CFTYP_LAI_LVEG   ! LAI       of low  vegetation
00119  CHARACTER(LEN=28)                      :: CFTYP_H_HVEG     ! height of trees
00120 !
00121 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00122 !
00123 NAMELIST/NAM_DATA_TEB_GARDEN/   NTIME,                                             &
00124                                 CTYP_GARDEN_HVEG, CTYP_GARDEN_LVEG,                &
00125                                 CTYP_GARDEN_NVEG,                                  &
00126                                 XUNIF_FRAC_HVEG, XUNIF_FRAC_LVEG, XUNIF_FRAC_NVEG, &
00127                                 XUNIF_LAI_HVEG , XUNIF_LAI_LVEG ,                  &
00128                                 XUNIF_H_HVEG   ,                                   &
00129                                 CFNAM_FRAC_HVEG, CFNAM_FRAC_LVEG, CFNAM_FRAC_NVEG, &
00130                                 CFNAM_LAI_HVEG , CFNAM_LAI_LVEG ,                  &
00131                                 CFNAM_H_HVEG   ,                                   &
00132                                 CFTYP_FRAC_HVEG, CFTYP_FRAC_LVEG, CFTYP_FRAC_NVEG, &
00133                                 CFTYP_LAI_HVEG , CFTYP_LAI_LVEG ,                  &
00134                                 CFTYP_H_HVEG  
00135 
00136 !-------------------------------------------------------------------------------
00137 !
00138 !*    1.      Initializations
00139 !             ---------------
00140 !
00141 IF (LHOOK) CALL DR_HOOK('PGD_TEB_GARDEN_PAR',0,ZHOOK_HANDLE)
00142 
00143 NTIME = 12
00144 !
00145 CTYP_GARDEN_HVEG   = 'TREE'           ! Forest and trees
00146 CTYP_GARDEN_LVEG   = 'PARK'           ! Grassland
00147 CTYP_GARDEN_NVEG   = 'NO  '           ! No vegetation
00148 !
00149 XUNIF_FRAC_HVEG    = XUNDEF
00150 XUNIF_FRAC_LVEG    = XUNDEF
00151 XUNIF_FRAC_NVEG    = XUNDEF
00152 XUNIF_LAI_HVEG     = XUNDEF
00153 XUNIF_LAI_LVEG     = XUNDEF
00154 XUNIF_H_HVEG       = XUNDEF
00155 !
00156 CFNAM_FRAC_HVEG    = '                            '
00157 CFNAM_FRAC_LVEG    = '                            '
00158 CFNAM_FRAC_NVEG    = '                            '
00159 CFNAM_LAI_HVEG     = '                            '
00160 CFNAM_LAI_LVEG     = '                            '
00161 CFNAM_H_HVEG       = '                            '
00162 !
00163 CFTYP_FRAC_HVEG    = '      '
00164 CFTYP_FRAC_LVEG    = '      '
00165 CFTYP_FRAC_NVEG    = '      '
00166 CFTYP_LAI_HVEG     = '      '
00167 CFTYP_LAI_LVEG     = '      '
00168 CFTYP_H_HVEG       = '      '
00169 !
00170 !-------------------------------------------------------------------------------
00171 NTIME_n = 12
00172 !-------------------------------------------------------------------------------
00173 !
00174 !*    2.      Input file for cover types
00175 !             --------------------------
00176 !
00177  CALL GET_LUOUT(HPROGRAM,ILUOUT)
00178  CALL OPEN_NAMELIST(HPROGRAM,ILUNAM)
00179 !
00180  CALL POSNAM(ILUNAM,'NAM_DATA_TEB_GARDEN',GFOUND,ILUOUT)
00181 IF (GFOUND) READ(UNIT=ILUNAM,NML=NAM_DATA_TEB_GARDEN)
00182 !
00183  CALL CLOSE_NAMELIST(HPROGRAM,ILUNAM)
00184 !
00185 IF (NTIME==1) THEN
00186   XUNIF_LAI_HVEG(2:) = XUNIF_LAI_HVEG(1)
00187   XUNIF_LAI_LVEG(2:) = XUNIF_LAI_LVEG(1)
00188 ELSE IF (NTIME/=12) THEN
00189   CALL ABOR1_SFX( 'Namelist NAM_DATA_TEB_GARDEN: NTIME must be equal to 1 or 12')
00190 END IF
00191 !-------------------------------------------------------------------------------
00192 !
00193 !*    3.      Coherence check
00194 !             ---------------
00195 !
00196 LPAR_GARDEN =  (XUNIF_FRAC_HVEG /= XUNDEF .OR. LEN_TRIM(CFNAM_FRAC_HVEG) >0 )&
00197          .AND. (XUNIF_FRAC_LVEG /= XUNDEF .OR. LEN_TRIM(CFNAM_FRAC_LVEG) >0 )&
00198          .AND. (XUNIF_FRAC_NVEG /= XUNDEF .OR. LEN_TRIM(CFNAM_FRAC_NVEG) >0 )
00199 
00200 GNO_PAR_GARDEN = (XUNIF_FRAC_HVEG == XUNDEF .AND. LEN_TRIM(CFNAM_FRAC_HVEG)==0)&
00201            .AND. (XUNIF_FRAC_LVEG == XUNDEF .AND. LEN_TRIM(CFNAM_FRAC_LVEG)==0)&
00202            .AND. (XUNIF_FRAC_NVEG == XUNDEF .AND. LEN_TRIM(CFNAM_FRAC_NVEG)==0)
00203 
00204 IF ( .NOT. LPAR_GARDEN .AND. .NOT. GNO_PAR_GARDEN ) THEN
00205   WRITE(ILUOUT,*) ' Error for fraction of high, low and no vegetation fractions in gardens '
00206   WRITE(ILUOUT,*) ' You need to specify the three of them ... or none. '
00207   CALL ABOR1_SFX( 'Namelist NAM_DATA_TEB_GARDEN: you need to specify all of  HVEG, LVEG, NVEG fractions or NONE of them')
00208 END IF
00209 !
00210 IF (GNO_PAR_GARDEN) THEN
00211   IF (LHOOK) CALL DR_HOOK('PGD_TEB_GARDEN_PAR',1,ZHOOK_HANDLE)
00212   RETURN
00213 END IF
00214 !
00215 !-------------------------------------------------------------------------------
00216 !
00217 ALLOCATE(XDATA_FRAC_HVEG   (NDIM        ))
00218 ALLOCATE(XDATA_FRAC_LVEG   (NDIM        ))
00219 ALLOCATE(XDATA_FRAC_NVEG   (NDIM        ))
00220 ALLOCATE(XDATA_LAI_HVEG    (NDIM,NTIME_n))
00221 ALLOCATE(XDATA_LAI_LVEG    (NDIM,NTIME_n))
00222 ALLOCATE(XDATA_H_HVEG      (NDIM        ))
00223 !
00224 CTYPE_HVEG = CTYP_GARDEN_HVEG
00225 CTYPE_LVEG = CTYP_GARDEN_LVEG
00226 CTYPE_NVEG = CTYP_GARDEN_NVEG
00227 !
00228 !-------------------------------------------------------------------------------
00229 !
00230 !*    3.      Uniform fields are prescribed
00231 !             -----------------------------
00232 !
00233 CATYPE = 'ARI'
00234 !
00235  CALL PGD_FIELD(HPROGRAM,'FRAC_HVEG: fraction of high vegetation','TWN',CFNAM_FRAC_HVEG,   &
00236                  CFTYP_FRAC_HVEG,XUNIF_FRAC_HVEG,XDATA_FRAC_HVEG(:))  
00237 !
00238  CALL PGD_FIELD(HPROGRAM,'FRAC_LVEG: fraction of low vegetation' ,'TWN',CFNAM_FRAC_LVEG,   &
00239                  CFTYP_FRAC_LVEG,XUNIF_FRAC_LVEG,XDATA_FRAC_LVEG(:))  
00240 !
00241  CALL PGD_FIELD(HPROGRAM,'FRAC_NVEG: fraction of bare soil'      ,'TWN',CFNAM_FRAC_NVEG,   &
00242                  CFTYP_FRAC_NVEG,XUNIF_FRAC_NVEG,XDATA_FRAC_NVEG(:))  
00243 !
00244 !
00245 DO JTIME=1,NTIME_n
00246 !
00247  CALL PGD_FIELD(HPROGRAM,'LAI_HVEG: LAI of high vegetation','TWN',CFNAM_LAI_HVEG(JTIME),  &
00248                   CFTYP_LAI_HVEG(JTIME),XUNIF_LAI_HVEG(JTIME),XDATA_LAI_HVEG(:,JTIME))  
00249 !
00250  CALL PGD_FIELD(HPROGRAM,'LAI_LVEG: LAI of low  vegetation','TWN',CFNAM_LAI_LVEG(JTIME),  &
00251                   CFTYP_LAI_LVEG(JTIME),XUNIF_LAI_LVEG(JTIME),XDATA_LAI_LVEG(:,JTIME))  
00252 !
00253 !
00254 ENDDO
00255 !
00256 !
00257  CALL PGD_FIELD(HPROGRAM,'H_HVEG: height of trees','TWN',CFNAM_H_HVEG,                     &
00258                  CFTYP_H_HVEG,XUNIF_H_HVEG,XDATA_H_HVEG(:))  
00259 IF (LHOOK) CALL DR_HOOK('PGD_TEB_GARDEN_PAR',1,ZHOOK_HANDLE)
00260 !
00261 !-------------------------------------------------------------------------------
00262 !
00263 END SUBROUTINE PGD_TEB_GARDEN_PAR