depos_fx.f

Go to the documentation of this file.

!                  ***********************
                    SUBROUTINE depos_fx
!                   **********************
!
     &(sedp,taub,csus,taus,vitchu,npoin)
!
!***********************************************************************
! TELEMAC2D                                                       V7P2
!***********************************************************************
!
!brief    COMPUTES DEPOSITION FLUX
!
!
!
!history  R. ATA (LNHE)
!+        02/09/2015
!+        V7P1
!+
!
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!| NPOIN          |-->| TOTAL NUMBER OF MESH NODES
!| SEDP           |<--| DEPOSITION FLUX
!| TAUB           |-->| BED SHEAR STRESS
!| TAUS           |-->| SEDIMENTATION CRITICAL STRESS
!| CSUS           |-->| SUSPENDED LOAD (TRACER 1)
!| VITCHU         |-->| SEDIMENT SETTLING VELOCITY
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!
      USE bief
      USE declarations_special
      USE interface_waqtel, ex_depos_fx => depos_fx
!
      IMPLICIT NONE
!
!+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
!
      INTEGER         , INTENT(IN)     :: npoin
      DOUBLE PRECISION, INTENT(IN)     :: taus,vitchu
      TYPE(bief_obj)   , INTENT(IN   ) :: taub,csus
      TYPE(bief_obj)   , INTENT(INOUT) :: sedp
      INTRINSIC max
!
!+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
!
!
!     LOCAL VARIABLES
      INTEGER i
!
!
      IF (abs(taus).LT.1.e-10)THEN
        WRITE(lu,*) 'DEPOS_FX: CRITICAL STRESS OF RESUSPENSION    '
        WRITE(lu,*) '          TAUS VERY SMALL OR NIL - VERIFY !!!'
        WRITE(lu,*) '          TAUS = ',taus
        CALL plante(1)
        stop
      ENDIF
!
!     THIS WAY WORKS WELL FOR 2D AND FOR 3D AS WELL SINCE BED LAYER IS
!     FOR I=1 TO NPOIN
      DO i=1,npoin
        sedp%R(i)=vitchu*csus%R(i)*max(1.d0-taub%R(i)/taus,0.d0)
      ENDDO
!
      RETURN
      END
!
!-----------------------------------------------------------------------
!