flood_update.F90

Go to the documentation of this file.

!     #########
      SUBROUTINE flood_update (PTAB_F,PTAB_H,PTAB_VF,PAREA,PFLOOD_STO, &
                               PLEN,PHFLOOD,PFFLOOD,PFLOOD_LEN,PWFLOOD )  
!     ##########################################################################
!
!!****  *FLOOD_UPDATE*  
!!
!!    PURPOSE
!!    -------
!
!     Compute HFLOOD, FFLOOD, LFLOOD, WFLOOD.
!     
!!**  METHOD
!!    ------
!
!     Direct calculation
!
!!    EXTERNAL
!!    --------
!
!     None
!!
!!    IMPLICIT ARGUMENTS
!!    ------------------
!!
!!      
!!    REFERENCE
!!    ---------
!!      
!!    AUTHOR
!!    ------
!!      B. Decharme
!!
!!    MODIFICATIONS
!!    -------------
!!      Original    01/11/06 
!-------------------------------------------------------------------------------
!
!*       0.     DECLARATIONS
!               ------------
!
USE modn_trip,     ONLY : xratmed
!
USE modd_trip_par, ONLY : xundef, xrholw
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
IMPLICIT NONE
!
!*      0.1    declarations of arguments
!
REAL,DIMENSION(:,:,:), INTENT(IN)  :: PTAB_F  ! Flood fraction array
REAL,DIMENSION(:,:,:), INTENT(IN)  :: PTAB_H  ! Topo height array
REAL,DIMENSION(:,:,:), INTENT(IN)  :: PTAB_VF ! Flood volume array
REAL,DIMENSION(:,:),   INTENT(IN)  :: PAREA   ! grid area                 [m²]
REAL,DIMENSION(:,:),   INTENT(IN)  :: PFLOOD_STO ! Floodplain water mass  [kg]
REAL,DIMENSION(:,:),   INTENT(IN)  :: PLEN    ! River lenght              [m]
!
REAL,DIMENSION(:,:),   INTENT(OUT) :: PHFLOOD ! Floodplain fraction        [-]
REAL,DIMENSION(:,:),   INTENT(OUT) :: PFFLOOD    ! Floodplain water depth  [m]
REAL,DIMENSION(:,:),   INTENT(OUT) :: PFLOOD_LEN ! Floodplain lenght       [m]
REAL,DIMENSION(:,:),   INTENT(OUT) :: PWFLOOD    ! Floodplain width        [m]
!
!*      0.2    declarations of local variables
!
REAL,    DIMENSION(SIZE(PAREA,1),SIZE(PAREA,2)) :: ZFLOOD_STO !kg/m2
!
INTEGER, DIMENSION(SIZE(PAREA,1),SIZE(PAREA,2)) :: IUP, IDOWN
!
INTEGER :: ILON, ILAT, JLON, JLAT, JPAS, IPAS
!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
!-------------------------------------------------------------------------------
! * Initialize local variable
!-------------------------------------------------------------------------------
!
IF (lhook) CALL dr_hook('FLOOD_UPDATE',0,zhook_handle)
!
ilon = SIZE(ptab_f,1)
ilat = SIZE(ptab_f,2)
ipas = SIZE(ptab_f,3)
!
phflood(:,:) = 0.0
pfflood(:,:) = 0.0
pwflood(:,:) = 0.0
pflood_len(:,:) = 0.0
!
zflood_sto(:,:) = pflood_sto(:,:)/parea(:,:)
!
DO jlat=1,ilat
   DO jlon=1,ilon
      IF(zflood_sto(jlon,jlat)>0.0)THEN
        DO jpas=1,ipas-1
           IF(zflood_sto(jlon,jlat)>=ptab_vf(jlon,jlat,jpas))THEN
             iup(jlon,jlat) = jpas+1
             idown(jlon,jlat) = jpas
           ENDIF
        ENDDO
      ENDIF
   ENDDO
ENDDO
!
!-------------------------------------------------------------------------------
! * Calculate new Fflood and Hflood
!-------------------------------------------------------------------------------
!
DO jlat=1,ilat
   DO jlon=1,ilon
      IF(zflood_sto(jlon,jlat)>0.0)THEN
         pfflood(jlon,jlat) = ptab_f(jlon,jlat,idown(jlon,jlat))                                      &
                            + (zflood_sto(jlon,jlat) -ptab_vf(jlon,jlat,idown(jlon,jlat))) &
                            * (ptab_f(jlon,jlat,iup(jlon,jlat))-ptab_f(jlon,jlat,idown(jlon,jlat))) &
                            / (ptab_vf(jlon,jlat,iup(jlon,jlat))-ptab_vf(jlon,jlat,idown(jlon,jlat)))
         phflood(jlon,jlat) = ptab_h(jlon,jlat,idown(jlon,jlat))                                      &
                            + (zflood_sto(jlon,jlat)           -ptab_vf(jlon,jlat,idown(jlon,jlat))) &
                            * (ptab_h(jlon,jlat,iup(jlon,jlat))-ptab_h(jlon,jlat,idown(jlon,jlat))) &
                            / (ptab_vf(jlon,jlat,iup(jlon,jlat))-ptab_vf(jlon,jlat,idown(jlon,jlat))) 
      ENDIF
      IF(pfflood(jlon,jlat)>=1.0)THEN
         pfflood(jlon,jlat) = 1.0
         phflood(jlon,jlat) = ptab_h(jlon,jlat,iup(jlon,jlat))                                   &
                            + (zflood_sto(jlon,jlat)-ptab_vf(jlon,jlat,iup(jlon,jlat))) / xrholw
      ENDIF
   ENDDO
ENDDO
!
!-------------------------------------------------------------------------------
! * Calculate new Wflood, Lflood
!-------------------------------------------------------------------------------
!
WHERE(zflood_sto(:,:)>0.0)
  pflood_len(:,:) = min(plen(:,:),xratmed*sqrt(pfflood(:,:)*parea(:,:)))
  pwflood(:,:) = parea(:,:)*pfflood(:,:)/pflood_len(:,:)
ENDWHERE
!
IF (lhook) CALL dr_hook('FLOOD_UPDATE',1,zhook_handle)
!
!-------------------------------------------------------------------------------
END SUBROUTINE flood_update