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

Go to the documentation of this file.
00001 !     #########
00002       SUBROUTINE READ_ISBA_n(HPROGRAM)
00003 !     ##################################
00004 !
00005 !!****  *READ_ISBA_n* - routine to initialise ISBA variables
00006 !!                         
00007 !!
00008 !!    PURPOSE
00009 !!    -------
00010 !!
00011 !!**  METHOD
00012 !!    ------
00013 !!
00014 !!    EXTERNAL
00015 !!    --------
00016 !!
00017 !!
00018 !!    IMPLICIT ARGUMENTS
00019 !!    ------------------
00020 !!
00021 !!    REFERENCE
00022 !!    ---------
00023 !!
00024 !!
00025 !!    AUTHOR
00026 !!    ------
00027 !!      V. Masson   *Meteo France*      
00028 !!
00029 !!    MODIFICATIONS
00030 !!    -------------
00031 !!      Original    01/2003
00032 !!
00033 !!      READ_SURF for general reading : 08/2003 (S.Malardel)
00034 !!      B. Decharme  2008    : Floodplains
00035 !!      B. Decharme  01/2009 : Optional Arpege deep soil temperature read
00036 !!      A.L. Gibelin   03/09 : modifications for CENTURY model 
00037 !!      A.L. Gibelin    04/2009 : BIOMASS and RESP_BIOMASS arrays 
00038 !!      A.L. Gibelin    06/2009 : Soil carbon variables for CNT option
00039 !!      B. Decharme  09/2012 : suppress NWG_LAYER (parallelization problems)
00040 !!
00041 !-------------------------------------------------------------------------------
00042 !
00043 !*       0.    DECLARATIONS
00044 !              ------------
00045 !
00046 !
00047 USE MODD_CO2V_PAR,       ONLY : XANFMINIT, XCONDCTMIN
00048 USE MODD_ISBA_n,         ONLY : NGROUND_LAYER, NPATCH, NNBIOMASS,   &
00049                                   NNLITTER, NNLITTLEVS, NNSOILCARB,   &
00050                                   CPHOTO, CRESPSL, XTSRAD_NAT,        &
00051                                   XTG, XWG, XWGI, XWR, XLAI, TSNOW,   &
00052                                   XRESA, XANFM, XAN, XLE, XANDAY,     &
00053                                   XBSLAI, XBIOMASS, XRESP_BIOMASS,    &
00054                                   XLITTER, XSOILCARB, XLIGNIN_STRUC,  &
00055                                   LFLOOD, XZ0_FLOOD, LTEMP_ARP,       &
00056                                   NTEMPLAYER_ARP, LGLACIER, XICE_STO  
00057 !                                
00058 USE MODD_SURF_PAR,       ONLY : XUNDEF, NUNDEF
00059 USE MODD_SNOW_PAR,       ONLY : XZ0SN
00060 !
00061 USE MODI_READ_SURF
00062 !
00063 USE MODI_READ_GR_SNOW
00064 !
00065 USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
00066 USE PARKIND1  ,ONLY : JPRB
00067 !
00068 USE MODI_GET_TYPE_DIM_n
00069 !
00070 IMPLICIT NONE
00071 !
00072 !*       0.1   Declarations of arguments
00073 !              -------------------------
00074 !
00075  CHARACTER(LEN=6),  INTENT(IN)  :: HPROGRAM ! calling program
00076 !
00077 !*       0.2   Declarations of local variables
00078 !              -------------------------------
00079 INTEGER           :: ILU          ! 1D physical dimension
00080 !
00081 INTEGER           :: IRESP          ! Error code after redding
00082 !
00083  CHARACTER(LEN=12) :: YRECFM         ! Name of the article to be read
00084 !
00085  CHARACTER(LEN=4)  :: YLVL
00086 !
00087 REAL, DIMENSION(:,:),ALLOCATABLE  :: ZWORK      ! 2D array to write data in file
00088 !
00089 INTEGER :: IWORK   ! Work integer
00090 !
00091 INTEGER :: JP, JL, JNBIOMASS, JNLITTER, JNSOILCARB, JNLITTLEVS  ! loop counter on layers
00092 !
00093 INTEGER           :: IVERSION       ! surface version
00094 INTEGER           :: IBUGFIX
00095 !
00096 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00097 !
00098 !-------------------------------------------------------------------------------
00099 !
00100 !
00101 !* 1D physical dimension
00102 !
00103 IF (LHOOK) CALL DR_HOOK('READ_ISBA_N',0,ZHOOK_HANDLE)
00104 YRECFM='SIZE_NATURE'
00105  CALL GET_TYPE_DIM_n('NATURE',ILU)
00106 !
00107 !
00108 !*       2.     Prognostic fields:
00109 !               -----------------
00110 !
00111 ALLOCATE(ZWORK(ILU,NPATCH))
00112 !* soil temperatures
00113 !
00114 IF(LTEMP_ARP)THEN
00115   IWORK=NTEMPLAYER_ARP
00116 ELSE
00117   IWORK=NGROUND_LAYER
00118 ENDIF
00119 !
00120 ALLOCATE(XTG(ILU,IWORK,NPATCH))
00121 !
00122 DO JL=1,IWORK
00123   WRITE(YLVL,'(I4)') JL
00124   YRECFM='TG'//ADJUSTL(YLVL(:LEN_TRIM(YLVL)))
00125   CALL READ_SURF(HPROGRAM,YRECFM,ZWORK(:,:),IRESP)
00126   XTG(:,JL,:)=ZWORK
00127 END DO
00128 !
00129 !
00130 !* soil liquid and ice water contents
00131 !
00132 ALLOCATE(XWG (ILU,NGROUND_LAYER,NPATCH))
00133 ALLOCATE(XWGI(ILU,NGROUND_LAYER,NPATCH))
00134 !
00135 XWG (:,:,:)=XUNDEF
00136 XWGI(:,:,:)=XUNDEF
00137 !
00138 DO JL=1,NGROUND_LAYER
00139   WRITE(YLVL,'(I4)') JL
00140   YRECFM='WG'//ADJUSTL(YLVL(:LEN_TRIM(YLVL)))
00141    CALL READ_SURF(HPROGRAM,YRECFM,ZWORK(:,:),IRESP)
00142    XWG(:,JL,:)=ZWORK
00143 END DO
00144 !
00145 DO JL=1,NGROUND_LAYER
00146   WRITE(YLVL,'(I4)') JL
00147   YRECFM='WGI'//ADJUSTL(YLVL(:LEN_TRIM(YLVL)))
00148   CALL READ_SURF(HPROGRAM,YRECFM,ZWORK(:,:),IRESP)
00149   XWGI(:,JL,:)=ZWORK
00150 END DO
00151 !
00152 !* water intercepted on leaves
00153 !
00154 ALLOCATE(XWR(ILU,NPATCH))
00155 !
00156 YRECFM = 'WR'
00157  CALL READ_SURF(HPROGRAM,YRECFM,XWR(:,:),IRESP)
00158 !
00159 !* roughness length of Flood water
00160 !
00161 IF(LFLOOD)THEN
00162   ALLOCATE(XZ0_FLOOD(ILU,NPATCH))
00163   YRECFM = 'Z0_FLOOD'
00164   CALL READ_SURF(HPROGRAM,YRECFM,XZ0_FLOOD(:,:),IRESP)
00165 ENDIF
00166 !
00167 !* Leaf Area Index
00168 !
00169 IF (CPHOTO=='LAI' .OR. CPHOTO=='LST' .OR. CPHOTO=='NIT' .OR. CPHOTO=='NCB') THEN
00170   YRECFM = 'LAI'
00171   CALL READ_SURF(HPROGRAM,YRECFM,XLAI(:,:),IRESP)
00172 END IF
00173 !
00174 !* snow mantel
00175 !
00176  CALL READ_GR_SNOW(HPROGRAM,'VEG','     ',ILU,NPATCH,TSNOW  )
00177 !
00178 YRECFM='VERSION'
00179  CALL READ_SURF(HPROGRAM,YRECFM,IVERSION,IRESP)
00180 !
00181 YRECFM='BUG'
00182  CALL READ_SURF(HPROGRAM,YRECFM,IBUGFIX,IRESP)
00183 !
00184 IF(LGLACIER)THEN
00185   ALLOCATE(XICE_STO(ILU,NPATCH))
00186   IF (IVERSION>7 .OR. IVERSION==7 .AND. IBUGFIX>=2) THEN
00187     YRECFM = 'ICE_STO'
00188     CALL READ_SURF(HPROGRAM,YRECFM,XICE_STO(:,:),IRESP)
00189   ELSE
00190     XICE_STO(:,:) = 0.0
00191   ENDIF
00192 ENDIF
00193 !
00194 !-------------------------------------------------------------------------------
00195 !
00196 !*       4.  Semi-prognostic variables
00197 !            -------------------------
00198 !
00199 ALLOCATE(XRESA(ILU,NPATCH))
00200 ALLOCATE(XLE  (ILU,NPATCH))
00201 IF (CPHOTO/='NON') THEN
00202   ALLOCATE(XANFM  (ILU,NPATCH))
00203   ALLOCATE(XAN    (ILU,NPATCH))
00204   ALLOCATE(XANDAY (ILU,NPATCH))
00205 END IF
00206 !
00207 IF(CPHOTO/='NON') THEN
00208   ALLOCATE(XBIOMASS         (ILU,NNBIOMASS,NPATCH))
00209   ALLOCATE(XRESP_BIOMASS    (ILU,NNBIOMASS,NPATCH))
00210 END IF
00211 !
00212 !
00213 !* aerodynamical resistance
00214 !
00215 YRECFM = 'RESA'
00216 XRESA(:,:) = 100.
00217  CALL READ_SURF(HPROGRAM,YRECFM,XRESA(:,:),IRESP)
00218 !
00219 !* patch averaged radiative temperature (K)
00220 !
00221 ALLOCATE(XTSRAD_NAT(ILU))
00222 IF (IVERSION<6) THEN
00223   XTSRAD_NAT(:)=0.
00224   DO JP=1,NPATCH
00225     XTSRAD_NAT(:)=XTSRAD_NAT(:)+XTG(:,1,JP)
00226   ENDDO
00227   XTSRAD_NAT(:)=XTSRAD_NAT(:)/NPATCH
00228 ELSE
00229   YRECFM='TSRAD_NAT'
00230   CALL READ_SURF(HPROGRAM,YRECFM,XTSRAD_NAT(:),IRESP)
00231 ENDIF
00232 !
00233 XLE(:,:) = XUNDEF
00234 !
00235 !*       5. ISBA-AGS variables
00236 !
00237 IF (CPHOTO/='NON') THEN
00238   YRECFM = 'AN'
00239   XAN(:,:) = 0.
00240   CALL READ_SURF(HPROGRAM,YRECFM,XAN(:,:),IRESP)
00241   !
00242   YRECFM = 'ANDAY'
00243   XANDAY(:,:) = 0.
00244   CALL READ_SURF(HPROGRAM,YRECFM,XANDAY(:,:),IRESP)
00245   !
00246   YRECFM = 'ANFM'
00247   XANFM(:,:) = XANFMINIT
00248   CALL READ_SURF(HPROGRAM,YRECFM,XANFM(:,:),IRESP)
00249   !
00250   YRECFM = 'LE_AGS'
00251   XLE(:,:) = 0.
00252   CALL READ_SURF(HPROGRAM,YRECFM,XLE(:,:),IRESP)
00253 END IF
00254 !
00255 IF (CPHOTO=='AGS' .OR. CPHOTO=='AST') THEN
00256   !
00257   XBIOMASS(:,:,:) = 0.
00258   XRESP_BIOMASS(:,:,:) = 0.
00259 
00260 ELSEIF (CPHOTO=='LAI' .OR. CPHOTO=='LST') THEN
00261   !
00262   XBIOMASS(:,1,:) = XBSLAI(:,:) * XLAI(:,:)
00263   XRESP_BIOMASS(:,:,:) = 0.
00264 
00265 ELSEIF (CPHOTO=='NIT') THEN
00266   !
00267   XBIOMASS(:,:,:) = 0.
00268   DO JNBIOMASS=1,NNBIOMASS
00269     WRITE(YLVL,'(I1)') JNBIOMASS
00270     IF (IVERSION>7 .OR. IVERSION==7 .AND. IBUGFIX>=3) THEN
00271       YRECFM='BIOMA'//ADJUSTL(YLVL(:LEN_TRIM(YLVL)))
00272     ELSE
00273       YRECFM='BIOMASS'//ADJUSTL(YLVL(:LEN_TRIM(YLVL)))
00274     ENDIF
00275     CALL READ_SURF(HPROGRAM,YRECFM,ZWORK(:,:),IRESP)
00276     XBIOMASS(:,JNBIOMASS,:)=ZWORK
00277   END DO
00278 
00279   XRESP_BIOMASS(:,:,:) = 0.
00280   DO JNBIOMASS=2,NNBIOMASS
00281     WRITE(YLVL,'(I1)') JNBIOMASS
00282     IF (IVERSION>7 .OR. IVERSION==7 .AND. IBUGFIX>=3) THEN
00283       YRECFM='RESPI'//ADJUSTL(YLVL(:LEN_TRIM(YLVL)))
00284     ELSE
00285       YRECFM='RESP_BIOM'//ADJUSTL(YLVL(:LEN_TRIM(YLVL)))
00286     ENDIF    
00287     CALL READ_SURF(HPROGRAM,YRECFM,ZWORK(:,:),IRESP)
00288     XRESP_BIOMASS(:,JNBIOMASS,:)=ZWORK
00289   END DO
00290 
00291 ELSEIF (CPHOTO=='NCB') THEN
00292   !
00293   XBIOMASS(:,:,:) = 0.
00294   DO JNBIOMASS=1,NNBIOMASS
00295     WRITE(YLVL,'(I1)') JNBIOMASS
00296     IF (IVERSION>7 .OR. IVERSION==7 .AND. IBUGFIX>=3) THEN
00297       YRECFM='BIOMA'//ADJUSTL(YLVL(:LEN_TRIM(YLVL)))
00298     ELSE
00299       YRECFM='BIOMASS'//ADJUSTL(YLVL(:LEN_TRIM(YLVL)))
00300     ENDIF    
00301     CALL READ_SURF(HPROGRAM,YRECFM,ZWORK(:,:),IRESP)
00302     XBIOMASS(:,JNBIOMASS,:)=ZWORK
00303   END DO
00304 
00305   XRESP_BIOMASS(:,:,:) = 0.
00306   DO JNBIOMASS=2,NNBIOMASS-2
00307     WRITE(YLVL,'(I1)') JNBIOMASS
00308     IF (IVERSION>7 .OR. IVERSION==7 .AND. IBUGFIX>=3) THEN
00309       YRECFM='RESPI'//ADJUSTL(YLVL(:LEN_TRIM(YLVL)))
00310     ELSE
00311       YRECFM='RESP_BIOM'//ADJUSTL(YLVL(:LEN_TRIM(YLVL)))
00312     ENDIF    
00313     CALL READ_SURF(HPROGRAM,YRECFM,ZWORK(:,:),IRESP)
00314     XRESP_BIOMASS(:,JNBIOMASS,:)=ZWORK
00315   END DO
00316   !
00317 ENDIF
00318 !
00319 !*       6. Soil carbon
00320 !
00321 !
00322 IF (CRESPSL=='CNT') THEN
00323   ALLOCATE(XLITTER          (ILU,NNLITTER,NNLITTLEVS,NPATCH))
00324   ALLOCATE(XSOILCARB        (ILU,NNSOILCARB,NPATCH))
00325   ALLOCATE(XLIGNIN_STRUC    (ILU,NNLITTLEVS,NPATCH))
00326 END IF
00327 !
00328 IF (CRESPSL=='CNT') THEN
00329   !
00330   XLITTER(:,:,:,:) = 0.
00331   DO JNLITTER=1,NNLITTER
00332     DO JNLITTLEVS=1,NNLITTLEVS
00333       WRITE(YLVL,'(I1,A1,I1)') JNLITTER,'_',JNLITTLEVS
00334       YRECFM='LITTER'//ADJUSTL(YLVL(:LEN_TRIM(YLVL)))
00335       CALL READ_SURF(HPROGRAM,YRECFM,ZWORK(:,:),IRESP)
00336       XLITTER(:,JNLITTER,JNLITTLEVS,:)=ZWORK
00337     END DO
00338   END DO
00339 
00340   XSOILCARB(:,:,:) = 0.
00341   DO JNSOILCARB=1,NNSOILCARB
00342     WRITE(YLVL,'(I4)') JNSOILCARB
00343     YRECFM='SOILCARB'//ADJUSTL(YLVL(:LEN_TRIM(YLVL)))
00344     CALL READ_SURF(HPROGRAM,YRECFM,ZWORK(:,:),IRESP)
00345     XSOILCARB(:,JNSOILCARB,:)=ZWORK
00346   END DO
00347 !
00348   XLIGNIN_STRUC(:,:,:) = 0.
00349   DO JNLITTLEVS=1,NNLITTLEVS
00350     WRITE(YLVL,'(I4)') JNLITTLEVS
00351     YRECFM='LIGNIN_STR'//ADJUSTL(YLVL(:LEN_TRIM(YLVL)))
00352     CALL READ_SURF(HPROGRAM,YRECFM,ZWORK(:,:),IRESP)
00353     XLIGNIN_STRUC(:,JNLITTLEVS,:)=ZWORK
00354   END DO
00355 !
00356 ENDIF
00357 !
00358 !
00359 DEALLOCATE(ZWORK)
00360 IF (LHOOK) CALL DR_HOOK('READ_ISBA_N',1,ZHOOK_HANDLE)
00361 !
00362 !-------------------------------------------------------------------------------
00363 !
00364 END SUBROUTINE READ_ISBA_n