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

Go to the documentation of this file.
00001 !     #########
00002 SUBROUTINE DIAG_MISC_ISBA_n(PTSTEP, HISBA, HPHOTO, HSNOW, OAGRIP, OTR_ML, &
00003                             PTIME, KSIZE, KPATCH, KMASK, PSEUIL,          &
00004                             PPSN, PPSNG, PPSNV, PFF, PFFG, PFFV,          &
00005                             PWG, PWGI, PWFC, PWWILT, PWSNOW, PRSNOW,      &
00006                             PFAPARC, PFAPIRC, PLAI_EFFC, PMUS, PFSAT,     &
00007                             PDG, PTG                                      )  
00008 !     ###############################################################################
00009 !
00010 !!****  *DIAG_MISC-ISBA_n * - additional diagnostics for ISBA
00011 !!
00012 !!    PURPOSE
00013 !!    -------
00014 !
00015 !!**  METHOD
00016 !!    ------
00017 !!
00018 !!    REFERENCE
00019 !!    ---------
00020 !!      
00021 !!
00022 !!    AUTHOR
00023 !!    ------
00024 !!     P. Le Moigne 
00025 !!
00026 !!    MODIFICATIONS
00027 !!    -------------
00028 !!      Original    10/2004
00029 !!      Modified    10/2004 by P. Le Moigne: Halstead coefficient
00030 !!      B. Decharme   2008    Do not limit the SWI to 1
00031 !!                            Add total SWI
00032 !!      S. Lafont    03/2009 : change unit of carbon output in kg/m2/s
00033 !!      A.L. Gibelin 04/2009 : Add respiration diagnostics
00034 !!      A.L. Gibelin 07/2009 : Suppress RDK and transform GPP as a diagnostic
00035 !!        S. Lafont  01/2011 : accumulate carbon variable between 2 outputs
00036 !!       B. Decharme 05/2012 : Carbon fluxes in diag_evap
00037 !!       B. Decharme 05/2012 : Active and frozen layers thickness for dif
00038 !!
00039 !!------------------------------------------------------------------
00040 !
00041 USE MODD_SURF_PAR,   ONLY : XUNDEF
00042 !
00043 USE MODD_PACK_DIAG_ISBA,      ONLY : XP_HV, XP_SWI, XP_ALBT, XP_TSWI,     &
00044                                      XP_TWSNOW, XP_TDSNOW, XP_SNOWTEMP,   &
00045                                      XP_SNOWLIQ,                          &
00046                                      XP_FAPAR, XP_FAPIR, XP_FAPAR_BS,     &
00047                                      XP_FAPIR_BS 
00048 !                                     
00049 USE MODD_DIAG_MISC_ISBA_n,    ONLY : LSURF_MISC_BUDGET,                       &
00050                                      XHV, XSWI, XDPSNG, XDPSNV, XDPSN, XSEUIL,&
00051                                      XALBT, XTSWI, XDFF, XDFFG,               &
00052                                      XDFFV, XTWSNOW, XTDSNOW, XTTSNOW,        &
00053                                      XSNOWLIQ, XSNOWTEMP, XDLAI_EFFC,         &
00054                                      XFAPAR, XFAPIR, XDFAPARC, XDFAPIRC,      &
00055                                      XFAPAR_BS, XFAPIR_BS, XDFSAT, XALT,      &
00056                                      XFLT
00057 USE MODD_TYPE_SNOW
00058 !
00059 !
00060 USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
00061 USE PARKIND1  ,ONLY : JPRB
00062 !
00063 IMPLICIT NONE
00064 !
00065 !*      0.1    declarations of arguments
00066 !
00067 REAL,               INTENT(IN)    :: PTSTEP        ! timestep for  accumulated values 
00068  CHARACTER(LEN=*), INTENT(IN)      :: HISBA         ! ISBA scheme
00069  CHARACTER(LEN=*), INTENT(IN)      :: HPHOTO        ! type of photosynthesis
00070  CHARACTER(LEN=*), INTENT(IN)      :: HSNOW         ! snow scheme
00071 LOGICAL, INTENT(IN)               :: OAGRIP
00072 LOGICAL, INTENT(IN)               :: OTR_ML
00073 REAL,    INTENT(IN)               :: PTIME   ! current time since midnight
00074 INTEGER, INTENT(IN)               :: KSIZE, KPATCH
00075 INTEGER, DIMENSION(:), INTENT(IN) :: KMASK
00076 REAL, DIMENSION(:), INTENT(IN)    :: PSEUIL
00077 !    
00078 !Snow/flood fraction at t
00079 REAL, DIMENSION(:), INTENT(IN)    :: PPSN
00080 REAL, DIMENSION(:), INTENT(IN)    :: PPSNG
00081 REAL, DIMENSION(:), INTENT(IN)    :: PPSNV
00082 REAL, DIMENSION(:), INTENT(IN)    :: PFF
00083 REAL, DIMENSION(:), INTENT(IN)    :: PFFG
00084 REAL, DIMENSION(:), INTENT(IN)    :: PFFV
00085 !
00086 REAL, DIMENSION(:,:),  INTENT(IN) :: PWG           ! soil water content profile (m3/m3)
00087 REAL, DIMENSION(:,:),  INTENT(IN) :: PWGI          ! soil solid water content profile (m3/m3)
00088 REAL, DIMENSION(:,:),  INTENT(IN) :: PWFC          ! field capacity profile (m3/m3)
00089 REAL, DIMENSION(:,:),  INTENT(IN) :: PWWILT        ! wilting point  profile (m3/m3)
00090 REAL, DIMENSION(:,:),  INTENT(IN) :: PWSNOW        ! snow reservoir (kg/m2)
00091 REAL, DIMENSION(:,:),  INTENT(IN) :: PRSNOW        ! snow density (kg/m3)
00092 !
00093 REAL, DIMENSION(:,:),  INTENT(IN) :: PDG           ! soil layer depth
00094 REAL, DIMENSION(:,:),  INTENT(IN) :: PTG           ! soil temperature
00095 !
00096 REAL, DIMENSION(:), INTENT(INOUT) :: PFAPARC
00097 REAL, DIMENSION(:), INTENT(INOUT) :: PFAPIRC
00098 REAL, DIMENSION(:), INTENT(INOUT) :: PLAI_EFFC
00099 REAL, DIMENSION(:), INTENT(INOUT) :: PMUS
00100 !
00101 REAL, DIMENSION(:), INTENT(IN)    :: PFSAT
00102 !
00103 !*      0.2    declarations of local variables
00104 !
00105 REAL, DIMENSION(SIZE(PPSN))    :: ZSNOWTEMP
00106 REAL, DIMENSION(SIZE(PWSNOW,1),SIZE(PWSNOW,2)) :: ZWORK
00107 !
00108 LOGICAL :: GMASK
00109 INTEGER :: JJ, JI, JK
00110 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00111 !
00112 !-------------------------------------------------------------------------------------
00113 !
00114 IF (LHOOK) CALL DR_HOOK('DIAG_MISC_ISBA_N',0,ZHOOK_HANDLE)
00115 IF (LSURF_MISC_BUDGET) THEN
00116   !
00117   XP_SWI (:,:)=XUNDEF
00118   XP_TSWI(:,:)=XUNDEF  
00119   DO JJ=1,SIZE(PWG,2)
00120     DO JI=1,SIZE(PWG,1)
00121       IF(PWG (JI,JJ)/=XUNDEF)THEN    
00122         XP_SWI (JI,JJ) = (PWG (JI,JJ)               - PWWILT(JI,JJ)) / (PWFC(JI,JJ) - PWWILT(JI,JJ))
00123         XP_TSWI(JI,JJ) = (PWG (JI,JJ) + PWGI(JI,JJ) - PWWILT(JI,JJ)) / (PWFC(JI,JJ) - PWWILT(JI,JJ))
00124       ENDIF
00125     ENDDO
00126   ENDDO
00127   !
00128   DO JK=1,SIZE(XP_SWI,2)
00129 !cdir nodep
00130     DO JJ=1,KSIZE
00131       JI                      =  KMASK         (JJ)
00132       !
00133       XSWI     (JI,JK,KPATCH)  =  XP_SWI        (JJ,JK)
00134       XTSWI    (JI,JK,KPATCH)  =  XP_TSWI       (JJ,JK)
00135       !
00136     END DO
00137   ENDDO  
00138   !
00139   DO JI = 1,SIZE(PWSNOW,2)
00140 !cdir nodep 
00141     DO JJ = 1,SIZE(PWSNOW,1)
00142       ZWORK(JJ,JI)  = PWSNOW(JJ,JI) / PRSNOW(JJ,JI)
00143     ENDDO
00144   ENDDO
00145   !
00146   XP_TWSNOW=0.
00147   XP_TDSNOW=0.
00148   ZSNOWTEMP=0.  
00149   !
00150   DO JI = 1,SIZE(PWSNOW,2)
00151 !cdir nodep 
00152     DO JJ = 1,SIZE(PWSNOW,1)
00153       XP_TWSNOW(JJ) = XP_TWSNOW(JJ) + PWSNOW(JJ,JI)      
00154       XP_TDSNOW(JJ) = XP_TDSNOW(JJ) + ZWORK (JJ,JI)
00155       ZSNOWTEMP(JJ) = ZSNOWTEMP(JJ) + XP_SNOWTEMP(JJ,JI) * ZWORK(JJ,JI)
00156     ENDDO
00157   ENDDO
00158   !
00159   WHERE(XP_TDSNOW(:)>0.0)
00160         ZSNOWTEMP(:)=ZSNOWTEMP(:)/XP_TDSNOW(:)
00161   ELSEWHERE
00162         ZSNOWTEMP(:)=XUNDEF
00163   ENDWHERE
00164   !
00165 !cdir nodep
00166   DO JJ=1,KSIZE
00167      JI                     =  KMASK       (JJ)
00168      !
00169      XHV      (JI, KPATCH)  =  XP_HV       (JJ)
00170      XDPSNG   (JI, KPATCH)  =  PPSNG       (JJ)
00171      XDPSNV   (JI, KPATCH)  =  PPSNV       (JJ)
00172      XDPSN    (JI, KPATCH)  =  PPSN        (JJ)     
00173      XALBT    (JI, KPATCH)  =  XP_ALBT     (JJ)
00174      XDFF     (JI, KPATCH)  =  PFF         (JJ)
00175      XDFFG    (JI, KPATCH)  =  PFFG        (JJ)
00176      XDFFV    (JI, KPATCH)  =  PFFV        (JJ)     
00177      XTWSNOW  (JI, KPATCH)  =  XP_TWSNOW   (JJ)
00178      XTDSNOW  (JI, KPATCH)  =  XP_TDSNOW   (JJ)
00179      XTTSNOW  (JI, KPATCH)  =  ZSNOWTEMP   (JJ)
00180      XDFSAT   (JI, KPATCH)  =  PFSAT       (JJ)     
00181      !
00182   END DO
00183 !
00184   IF (HSNOW=='3-L' .OR. HSNOW=='CRO') THEN
00185      !
00186     DO JK=1,SIZE(XP_SNOWLIQ,2)
00187 !cdir nodep
00188       DO JJ=1,KSIZE
00189         JI                      =  KMASK         (JJ)
00190         !
00191         XSNOWLIQ (JI,JK,KPATCH)  =  XP_SNOWLIQ    (JJ,JK)
00192         XSNOWTEMP(JI,JK,KPATCH)  =  XP_SNOWTEMP   (JJ,JK)
00193         !
00194       END DO
00195     ENDDO
00196      !
00197   ENDIF
00198 !
00199 ! cosine of solar zenith angle 
00200 !
00201 
00202   IF (HPHOTO/='NON'.AND.OTR_ML) THEN
00203        !
00204 !cdir nodep
00205        DO JJ=1,KSIZE
00206          JI = KMASK(JJ)
00207          !
00208          XFAPAR      (JI, KPATCH) = XP_FAPAR      (JJ)
00209          XFAPIR      (JI, KPATCH) = XP_FAPIR      (JJ)
00210          XFAPAR_BS   (JI, KPATCH) = XP_FAPAR_BS   (JJ)
00211          XFAPIR_BS   (JI, KPATCH) = XP_FAPIR_BS   (JJ)
00212          !
00213        ENDDO
00214        !
00215        ! Mask where vegetation evolution is performed (just before solar midnight)
00216        GMASK = ( PTIME - PTSTEP < 0. ) .AND. ( PTIME >= 0. )
00217        IF (GMASK) THEN
00218 !cdir nodep
00219          DO JJ=1,KSIZE
00220            JI = KMASK(JJ)
00221            !
00222            IF (PMUS(JJ).NE.0.) THEN
00223              XDFAPARC   (JI, KPATCH) = PFAPARC   (JJ) / PMUS(JJ) 
00224              XDFAPIRC   (JI, KPATCH) = PFAPIRC   (JJ) / PMUS(JJ)
00225              XDLAI_EFFC (JI, KPATCH) = PLAI_EFFC (JJ) / PMUS(JJ)
00226            ENDIF
00227            !
00228          ENDDO
00229 !cdir nodep         
00230          DO JJ=1,KSIZE   
00231            PFAPARC(JJ)   = 0.
00232            PFAPIRC(JJ)   = 0.
00233            PLAI_EFFC(JJ) = 0.
00234            PMUS(JJ)      = 0.
00235          ENDDO
00236        ENDIF
00237        !
00238   ENDIF
00239   !
00240   IF(HISBA=='DIF')THEN
00241     CALL COMPUT_COLD_LAYERS_THICK
00242   ENDIF
00243   !
00244 END IF
00245 !
00246 IF (OAGRIP) THEN
00247   !
00248 !cdir nodep
00249   DO JJ=1,KSIZE
00250      JI                     =  KMASK         (JJ)
00251      !
00252      XSEUIL   (JI, KPATCH)  =  PSEUIL (JJ)
00253      !
00254   END DO
00255 !
00256 END IF
00257 IF (LHOOK) CALL DR_HOOK('DIAG_MISC_ISBA_N',1,ZHOOK_HANDLE)
00258 !-------------------------------------------------------------------------------------
00259 !
00260 CONTAINS
00261 !
00262 SUBROUTINE COMPUT_COLD_LAYERS_THICK
00263 !
00264 ! Comput active layer (ALT) and frozen layer (FLT) theaknesses 
00265 ! using linear interpolation between two nodes :
00266 !       ALT = depth to zero centigrade isotherm in permafrost
00267 !       FLT = depth to zero centigrade isotherm in non-permafrost
00268 !
00269 USE MODD_CSTS, ONLY : XTT
00270 USE MODD_SURF_PAR, ONLY : NUNDEF
00271 !
00272 IMPLICIT NONE
00273 !
00274 REAL, DIMENSION(KSIZE,SIZE(PDG,2)) :: ZNODE
00275 INTEGER, DIMENSION(KSIZE)          :: IUP_ALT, IDOWN_ALT
00276 INTEGER, DIMENSION(KSIZE)          :: IUP_FLT, IDOWN_FLT
00277 !
00278 REAL    :: ZTG_UP, ZTG_DOWN
00279 REAL    :: ZUP, ZDOWN
00280 REAL    :: ZALT, ZFLT, ZSLOPE
00281 !
00282 INTEGER :: JJ, JI, JL, INL
00283 !
00284 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00285 !
00286 IF (LHOOK) CALL DR_HOOK('DIAG_MISC_ISBA_N:COMPUT_COLD_LAYERS_THICK',0,ZHOOK_HANDLE)
00287 !
00288 INL=SIZE(PDG,2)
00289 !
00290 XALT(:,KPATCH)=0.0   
00291 !
00292 IUP_ALT  (:)=0
00293 IDOWN_ALT(:)=0
00294 IUP_FLT  (:)=0
00295 IDOWN_FLT(:)=0
00296 !
00297 !Surface soil layer
00298 !
00299 ZNODE(:,1)=0.5*PDG(:,1)
00300 WHERE(PTG(:,1)>XTT.AND.PTG(:,2)<=XTT.AND.PTG(:,3)<=XTT)
00301       IUP_ALT  (:)=1
00302       IDOWN_ALT(:)=2
00303 ENDWHERE
00304 WHERE(PTG(:,1)<XTT.AND.PTG(:,2)>=XTT.AND.PTG(:,3)>=XTT)
00305       IUP_FLT  (:)=1
00306       IDOWN_FLT(:)=2
00307 ENDWHERE
00308 !
00309 !Middle soil layer
00310 !
00311 DO JL=2,INL-1
00312    DO JJ=1,KSIZE 
00313       ZNODE(JJ,JL)=0.5*(PDG(JJ,JL)+PDG(JJ,JL-1))
00314       IF(PTG(JJ,JL-1)>XTT.AND.PTG(JJ,JL)>XTT.AND.PTG(JJ,JL+1)<=XTT)THEN
00315         IUP_ALT  (JJ)=JL
00316         IDOWN_ALT(JJ)=JL+1
00317       ENDIF
00318       IF(PTG(JJ,JL-1)<XTT.AND.PTG(JJ,JL)<XTT.AND.PTG(JJ,JL+1)>=XTT)THEN
00319         IUP_FLT  (JJ)=JL
00320         IDOWN_FLT(JJ)=JL+1
00321       ENDIF      
00322    ENDDO
00323 ENDDO
00324 !
00325 !Last soil layer
00326 !
00327 ZNODE(:,INL)=0.5*(PDG(:,INL)+PDG(:,INL-1))
00328 WHERE(PTG(:,INL)>XTT)IDOWN_ALT(:)=NUNDEF
00329 WHERE(PTG(:,INL)<XTT)IDOWN_FLT(:)=NUNDEF
00330 !
00331 DO JJ=1,KSIZE
00332 !
00333    ZALT  =0.0
00334    IF(IDOWN_ALT(JJ)>0.AND.IDOWN_ALT(JJ)<=INL)THEN
00335      ZTG_UP    = PTG  (JJ,IUP_ALT  (JJ))
00336      ZTG_DOWN  = PTG  (JJ,IDOWN_ALT(JJ))
00337      ZUP       = ZNODE(JJ,IUP_ALT  (JJ))
00338      ZDOWN     = ZNODE(JJ,IDOWN_ALT(JJ))
00339      ZSLOPE    = (ZUP-ZDOWN)/(ZTG_UP-ZTG_DOWN)
00340      ZALT      = ZDOWN+(XTT-ZTG_DOWN)*ZSLOPE
00341    ENDIF
00342 !
00343    ZFLT  =0.0
00344    IF(IDOWN_FLT(JJ)>0.AND.IDOWN_FLT(JJ)<=INL)THEN
00345      ZTG_UP    = PTG  (JJ,IUP_FLT  (JJ))
00346      ZTG_DOWN  = PTG  (JJ,IDOWN_FLT(JJ))
00347      ZUP       = ZNODE(JJ,IUP_FLT  (JJ))
00348      ZDOWN     = ZNODE(JJ,IDOWN_FLT(JJ))
00349      ZSLOPE    = (ZUP-ZDOWN)/(ZTG_UP-ZTG_DOWN)
00350      ZFLT      = ZDOWN+(XTT-ZTG_DOWN)*ZSLOPE
00351    ENDIF
00352 !
00353    JI              =  KMASK(JJ)
00354    XALT(JI,KPATCH) =  ZALT 
00355    XFLT(JI,KPATCH) =  ZFLT 
00356 !
00357 ENDDO
00358 !
00359 IF (LHOOK) CALL DR_HOOK('DIAG_MISC_ISBA_N:COMPUT_COLD_LAYERS_THICK',1,ZHOOK_HANDLE)
00360 !
00361 END SUBROUTINE COMPUT_COLD_LAYERS_THICK
00362 !-------------------------------------------------------------------------------------
00363 !
00364 END SUBROUTINE DIAG_MISC_ISBA_n