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

Go to the documentation of this file.
00001 !#############################################################
00002 SUBROUTINE INIT_ISBA_LANDUSE (HPROGRAM)  
00003 !#############################################################
00004 !
00005 !!****  *INIT_ISBA_LANDUSE* - routine to initialize land use for ISBA field
00006 !!
00007 !!    PURPOSE
00008 !!    -------
00009 !     Extrapolation from existing surounding cells with same patch properties:
00010 !!      (1) IPTS=n  interpol field with n pts
00011 !!      (2) IPTS=0  conserve cells mass  
00012 !!   Case 2 : simple extrapolation based on the inside cell informations.
00013 !!             this is donne before conserving cell or global mass
00014 !!
00015 !!
00016 !!**  METHOD
00017 !!    ------
00018 !!
00019 !!    EXTERNAL
00020 !!    --------
00021 !!
00022 !!
00023 !!    IMPLICIT ARGUMENTS
00024 !!    ------------------
00025 !!
00026 !!    REFERENCE
00027 !!    ---------
00028 !!
00029 !!
00030 !!    AUTHOR
00031 !!    ------
00032 !!      B. Decharme   *Meteo France*    
00033 !!
00034 !!    MODIFICATIONS
00035 !!    -------------
00036 !!      Original    07/2011
00037 !!
00038 !-------------------------------------------------------------------------------
00039 !
00040 !*       0.    DECLARATIONS
00041 !              ------------
00042 !
00043 USE MODD_ISBA_n, ONLY : CISBA, CPHOTO, CRESPSL, LFLOOD, NGROUND_LAYER,    &
00044                         NNLITTER, NNLITTLEVS, NNSOILCARB, NNBIOMASS,      &
00045                         XRESA, XDG, XTG, XWG, XWR, XWGI, XAN, XANDAY,     &
00046                         XANFM, XICE_STO, XLE, XZ0_FLOOD, XBIOMASS,        &
00047                         XRESP_BIOMASS,XLITTER, XSOILCARB, XLIGNIN_STRUC,  &
00048                         XDG_OLD,TSNOW
00049 USE MODD_TYPE_SNOW
00050 USE MODD_SURF_PAR,ONLY : XUNDEF                 
00051 !
00052 USE MODI_GET_LUOUT
00053 USE MODI_INI_VAR_FROM_PATCH
00054 USE MODI_CONSERV_GLOBAL_MASS
00055 !
00056 USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
00057 USE PARKIND1  ,ONLY : JPRB
00058 !
00059 IMPLICIT NONE
00060 !
00061 !*       0.1   Declarations of arguments
00062 !              -------------------------
00063 !
00064  CHARACTER(LEN=6),                 INTENT(IN)  :: HPROGRAM  ! program calling surf. schemes
00065 !
00066 !
00067 !*       0.2   Declarations of local variables
00068 !              -------------------------------
00069 !
00070 REAL, DIMENSION(SIZE(XDG,1),SIZE(XDG,2),SIZE(XDG,3)) :: ZZDG     ! Actual layer thicknesses
00071 REAL, DIMENSION(SIZE(XDG,1),SIZE(XDG,2),SIZE(XDG,3)) :: ZZDG_OLD ! Old layer thicknesses
00072 REAL, DIMENSION(SIZE(XDG,1),SIZE(XDG,2),SIZE(XDG,3)) :: ZWG_OLD  ! Old XWG
00073 REAL, DIMENSION(SIZE(XDG,1),SIZE(XDG,2),SIZE(XDG,3)) :: ZWGI_OLD ! Old XWGI
00074 REAL, DIMENSION(SIZE(XDG,1),1,SIZE(XDG,3)) :: ZTEST
00075 !
00076 INTEGER :: ILUOUT
00077 INTEGER :: JLAYER, JNBIOMASS, JNLITTER, JNLITTLEVS, JNSOILCARB
00078 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00079 !
00080 !-------------------------------------------------------------------------------
00081 !
00082 IF (LHOOK) CALL DR_HOOK('INIT_ISBA_LANDUSE',0,ZHOOK_HANDLE)
00083  CALL GET_LUOUT(HPROGRAM,ILUOUT)
00084 !
00085 !-------------------------------------------------------------------------------
00086 !
00087 IF(ALL(XDG(:,NGROUND_LAYER,:)==XDG_OLD(:,NGROUND_LAYER,:)))THEN
00088   IF (LHOOK) CALL DR_HOOK('INIT_ISBA_LANDUSE',1,ZHOOK_HANDLE)
00089   RETURN
00090 ENDIF
00091 !
00092 !-------------------------------------------------------------------------------
00093 ! Conserve mass in the cell
00094 !-------------------------------------------------------------------------------
00095 !
00096  CALL INI_VAR_FROM_PATCH(HPROGRAM,ILUOUT,'WR      ', XWR     (:,:),0)
00097 
00098  CALL INI_VAR_FROM_PATCH(HPROGRAM,ILUOUT,'ICE_STO ', XICE_STO(:,:),0)
00099 !
00100 DO JLAYER=1,SIZE(XTG,2)
00101    CALL INI_VAR_FROM_PATCH(HPROGRAM,ILUOUT,'TEMP GRO', XTG(:,JLAYER,:),0)
00102 END DO
00103 !
00104 !
00105  CALL INI_VAR_FROM_PATCH(HPROGRAM,ILUOUT,'ALBSNOW ', TSNOW%ALB(:,:),0)
00106 !
00107 IF (TSNOW%SCHEME=='1-L'  .OR. TSNOW%SCHEME=='3-L' .OR. TSNOW%SCHEME=='CRO') THEN
00108    CALL INI_VAR_FROM_PATCH(HPROGRAM,ILUOUT,'EMISSNOW', TSNOW%EMIS(:,:),0)    
00109    CALL INI_VAR_FROM_PATCH(HPROGRAM,ILUOUT,'TSSNOW  ', TSNOW%TS  (:,:),0)
00110 ENDIF
00111 !
00112 DO JLAYER=1,TSNOW%NLAYER
00113    !
00114    CALL INI_VAR_FROM_PATCH(HPROGRAM,ILUOUT,'WSNOW   ', TSNOW%WSNOW(:,JLAYER,:),0)
00115    !
00116    IF (TSNOW%SCHEME=='3-L' .OR. TSNOW%SCHEME=='CRO') THEN            
00117       CALL INI_VAR_FROM_PATCH(HPROGRAM,ILUOUT,'TEMPSNOW', TSNOW%TEMP(:,JLAYER,:),0)
00118       CALL INI_VAR_FROM_PATCH(HPROGRAM,ILUOUT,'HEATSNOW', TSNOW%HEAT(:,JLAYER,:),0)     
00119    ENDIF
00120    !
00121    IF (TSNOW%SCHEME=='1-L') THEN
00122       CALL INI_VAR_FROM_PATCH(HPROGRAM,ILUOUT,'TSNOW   ', TSNOW%T(:,JLAYER,:),0)
00123    ENDIF
00124    !
00125    IF(TSNOW%SCHEME=='CRO') THEN
00126       CALL INI_VAR_FROM_PATCH(HPROGRAM,ILUOUT,'GRANSNOW', TSNOW%GRAN1(:,JLAYER,:),0)
00127       CALL INI_VAR_FROM_PATCH(HPROGRAM,ILUOUT,'GRANSNOW', TSNOW%GRAN2(:,JLAYER,:),0)
00128       CALL INI_VAR_FROM_PATCH(HPROGRAM,ILUOUT,'HISTSNOW', TSNOW%HIST (:,JLAYER,:),0)
00129       CALL INI_VAR_FROM_PATCH(HPROGRAM,ILUOUT,'AGESNOW ', TSNOW%AGE  (:,JLAYER,:),0)
00130    ENDIF
00131    !
00132 ENDDO
00133 !
00134 !-------------------------------------------------------------------------------
00135 ! Conserve mass globaly because soil depth change
00136 !-------------------------------------------------------------------------------
00137 !
00138 ZWG_OLD(:,:,:) =XWG (:,:,:)
00139 ZWGI_OLD(:,:,:)=XWGI(:,:,:)
00140 !
00141 DO JLAYER=1,NGROUND_LAYER
00142    CALL INI_VAR_FROM_PATCH(HPROGRAM,ILUOUT,'WG      ', XWG (:,JLAYER,:),0)
00143    CALL INI_VAR_FROM_PATCH(HPROGRAM,ILUOUT,'WGI     ', XWGI(:,JLAYER,:),0)
00144 ENDDO
00145 !
00146 ZZDG    (:,1,:)=XDG    (:,1,:)
00147 ZZDG_OLD(:,1,:)=XDG_OLD(:,1,:)
00148 IF(CISBA=='DIF')THEN
00149   DO JLAYER=2,NGROUND_LAYER
00150      ZZDG    (:,JLAYER,:)=XDG    (:,JLAYER,:)-XDG    (:,JLAYER-1,:)
00151      ZZDG_OLD(:,JLAYER,:)=XDG_OLD(:,JLAYER,:)-XDG_OLD(:,JLAYER-1,:)
00152   ENDDO
00153 ELSE     
00154   ZZDG    (:,2,:)=XDG    (:,2,:)
00155   ZZDG_OLD(:,2,:)=XDG_OLD(:,2,:)
00156   IF(CISBA=='3-L' )THEN
00157     ZZDG    (:,3,:)=XDG    (:,3,:)-XDG    (:,2,:)
00158     ZZDG_OLD(:,3,:)=XDG_OLD(:,3,:)-XDG_OLD(:,2,:)
00159   ENDIF 
00160 ENDIF
00161 !
00162 WHERE(ZZDG(:,:,:)    >1.E+10)ZZDG    (:,:,:)=0.
00163 WHERE(ZZDG_OLD(:,:,:)>1.E+10)ZZDG_OLD(:,:,:)=0.
00164 !
00165  CALL CONSERV_GLOBAL_MASS(ILUOUT,ZZDG,ZZDG_OLD,XWG, ZWG_OLD )
00166  CALL CONSERV_GLOBAL_MASS(ILUOUT,ZZDG,ZZDG_OLD,XWGI,ZWGI_OLD)
00167 !
00168 !-------------------------------------------------------------------------------
00169 ! Extrapolation with 3 pts 
00170 !-------------------------------------------------------------------------------
00171 !
00172  CALL INI_VAR_FROM_PATCH(HPROGRAM,ILUOUT,'RESA    ', XRESA(:,:),3)
00173 !
00174 DO JLAYER=1,TSNOW%NLAYER
00175    CALL INI_VAR_FROM_PATCH(HPROGRAM,ILUOUT,'RHOSNOW ', TSNOW%RHO  (:,JLAYER,:),3)
00176 ENDDO
00177 !
00178 IF(LFLOOD)CALL INI_VAR_FROM_PATCH(HPROGRAM,ILUOUT,'Z0_FLOOD', XZ0_FLOOD(:,:),3)
00179 !
00180 IF (CPHOTO/='NON') THEN
00181    !
00182    CALL INI_VAR_FROM_PATCH(HPROGRAM,ILUOUT,'AN      ', XAN   (:,:),3)
00183    CALL INI_VAR_FROM_PATCH(HPROGRAM,ILUOUT,'ANDAY   ', XANDAY(:,:),3)   
00184    CALL INI_VAR_FROM_PATCH(HPROGRAM,ILUOUT,'ANFM    ', XANFM (:,:),3)
00185    CALL INI_VAR_FROM_PATCH(HPROGRAM,ILUOUT,'LE      ', XLE   (:,:),3)
00186    !
00187    DO JNBIOMASS=1,NNBIOMASS
00188       CALL INI_VAR_FROM_PATCH(HPROGRAM,ILUOUT,'RESPBIOM', XRESP_BIOMASS(:,JNBIOMASS,:),3)
00189       CALL INI_VAR_FROM_PATCH(HPROGRAM,ILUOUT,'BIOMASS ', XBIOMASS     (:,JNBIOMASS,:),3)
00190    ENDDO
00191    !
00192    IF (CRESPSL=='CNT') THEN
00193       !
00194       DO JNLITTLEVS=1,NNLITTLEVS
00195          CALL INI_VAR_FROM_PATCH(HPROGRAM,ILUOUT,'LIGNINST',XLIGNIN_STRUC(:,JNLITTLEVS,:),3)
00196          DO JNLITTER=1,NNLITTER
00197             CALL INI_VAR_FROM_PATCH(HPROGRAM,ILUOUT,'LITTER  ',XLITTER(:,JNLITTER,JNLITTLEVS,:),3)
00198          ENDDO
00199       ENDDO
00200       !
00201       DO JNSOILCARB=1,NNSOILCARB
00202          CALL INI_VAR_FROM_PATCH(HPROGRAM,ILUOUT,'SOILCARB',XSOILCARB(:,JNSOILCARB,:),3)
00203       ENDDO
00204       !
00205    ENDIF
00206    !
00207 ENDIF
00208 !
00209 !-------------------------------------------------------------------------------
00210 !  
00211 IF (LHOOK) CALL DR_HOOK('INIT_ISBA_LANDUSE',1,ZHOOK_HANDLE)
00212 !
00213 END SUBROUTINE INIT_ISBA_LANDUSE