tassement.f

Go to the documentation of this file.

!                   ********************
                    SUBROUTINE tassement
!                   ********************
!
     &(npoin,dts,elay,dzf_tass,t2,avail,nsicla,es,xmvs,
     & xkv,trans_mass,conc_vase,nomblay,ms_sable,ms_vase)
!
!***********************************************************************
! SISYPHE   V6P1                                   21/07/2011
!***********************************************************************
!
!brief
!
!history  N.DURAND (HRW), S.E.BOURBAN (HRW)
!+        13/07/2010
!+        V6P0
!+   Translation of French comments within the FORTRAN sources into
!+   English comments
!
!history  N.DURAND (HRW), S.E.BOURBAN (HRW)
!+        21/08/2010
!+        V6P0
!+   Creation of DOXYGEN tags for automated documentation and
!+   cross-referencing of the FORTRAN sources
!
!history  C.VILLARET (EDF-LNHE), P.TASSI (EDF-LNHE)
!+        19/07/2011
!+        V6P1
!+   Name of variables
!+
!
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!| AVAIL          |<->| VOLUME PERCENT OF EACH CLASS
!| CONC_VASE      |<->| MUD CONCENTRATION FOR EACH LAYER
!| DTS            |-->| TIME STEP FOR SUSPENSION
!| DZF_TASS       |-->| BED EVOLUTION DUE TO CONSOLIDATION
!| ELAY           |<->| THICKNESS OF EACH LAYER
!| ES             |<->| LAYER THICKNESSES AS DOUBLE PRECISION
!| MS_SABLE       |<->| MASS OF SAND PER LAYER (KG/M2)
!| MS_VASE        |<->| MASS OF MUD PER LAYER (KG/M2)
!| NOMBLAY        |-->| NUMBER OF LAYERS FOR CONSOLIDATION
!| NPOIN          |-->| NUMBER OF POINTS
!| NSICLA         |-->| NUMBER OF SIZE CLASSES FOR BED MATERIALS
!| T2             |<->| WORK BIEF_OBJ STRUCTURE
!| TRANS_MASS     |-->| TRANSFER OF MASS PER LAYER (CONSOLIDATION ALGORITHM)
!| XKV            |-->| BED POROSITY
!| XMVS           |-->| SEDIMENT DENSITY
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!
      USE bief
      USE declarations_sisyphe, ONLY : nlaymax
      USE declarations_special
      IMPLICIT NONE
!
!+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
!
      INTEGER,          INTENT(IN)    :: NPOIN,NSICLA,NOMBLAY
      type(bief_obj),  INTENT(INOUT) :: dzf_tass,elay,t2
      DOUBLE PRECISION, INTENT(INOUT) :: MS_SABLE(npoin,nomblay)
      DOUBLE PRECISION, INTENT(INOUT) :: MS_VASE(npoin,nomblay)
      DOUBLE PRECISION, INTENT(IN)    :: DTS
      DOUBLE PRECISION, INTENT(INOUT) :: AVAIL(npoin,nomblay,nsicla)
      DOUBLE PRECISION, INTENT(INOUT) :: ES(npoin,nomblay)
      DOUBLE PRECISION, INTENT(IN)    :: TRANS_MASS(nomblay)
      DOUBLE PRECISION, INTENT(IN)    :: CONC_VASE(nomblay)
      DOUBLE PRECISION, INTENT(IN)    :: XMVS,XKV
!
!+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
!
      INTEGER I,J
      DOUBLE PRECISION CONC_SABLE
!
      DOUBLE PRECISION TAUX(nlaymax),TRANSFERT_MASSE_VASE(nlaymax)
      DOUBLE PRECISION TRANSFERT_MASSE_SABLE(nlaymax)
      DOUBLE PRECISION EPAI_SABLE(nlaymax),EPAI_VASE(nlaymax)
!
! COMPUTES THE TOTAL SEDIMENT THICKNESS (SAND + MUD) BEFORE CONSOLIDATION
!
      conc_sable=xmvs/xkv
!
! T2: MUD THICKNESS BEFORE CONSOLIDATION
!
      DO i=1,npoin
!
        t2%R(i)=0.d0
        DO j=1,nomblay
          epai_vase(j)=ms_vase(i,j)/conc_vase(j)
          es(i,j)=epai_vase(j)
          IF(nsicla.GT.1) THEN
            epai_sable(j)=ms_sable(i,j)/xmvs
            es(i,j)=epai_vase(j)+epai_sable(j)
          ENDIF
          t2%R(i)=t2%R(i)+es(i,j)
        ENDDO
!
        DO j=1,nomblay
          IF(ms_vase(i,j).GE.1.d-6) THEN
            transfert_masse_vase(j)=min(ms_vase(i,j),
     &              ms_vase(i,j)*dts*trans_mass(j))
            IF(nsicla.GT.1) THEN
              taux(j)=transfert_masse_vase(j)/ms_vase(i,j)
              transfert_masse_sable(j)=taux(j)*ms_sable(i,j)
            ENDIF
          ELSE
            transfert_masse_vase(j)=0.d0
            IF(nsicla.GT.1) transfert_masse_sable(j)=0.d0
          ENDIF
!**************ARRET DE TASSEMENT SI LA VASE A REMPLI LES INTERSTICES
!**************   ENTRE LES GRAINS DE SABLE
          IF(nsicla.GT.1.AND.epai_sable(j).GE.es(i,j)) THEN
            transfert_masse_vase(j) =0.d0
            transfert_masse_sable(j)=0.d0
          ENDIF
        ENDDO
!
        DO j=1,nomblay
          IF(j.EQ.nomblay) THEN
            ms_vase(i,j)=max(0.d0,ms_vase(i,j)
     &           +transfert_masse_vase(j-1))
            IF(nsicla.GT.1) THEN
              ms_sable(i,j)=max(0.d0,ms_sable(i,j)
     &                                +transfert_masse_sable(j-1))
            ENDIF
          ELSEIF(j.EQ.1) THEN
            ms_vase(i,j)=max(0.d0,ms_vase(i,j)
     &            -transfert_masse_vase(j))
            IF(nsicla.GT.1) THEN
              ms_sable(i,j)=max(0.d0,ms_sable(i,j)
     &            -transfert_masse_sable(j))
            ENDIF
          ELSE
            ms_vase(i,j)=max(0.d0,ms_vase(i,j)
     &           +transfert_masse_vase(j-1)-transfert_masse_vase(j))
            IF(nsicla.GT.1) THEN
              ms_sable(i,j)=max(0.d0,ms_sable(i,j)
     &        +transfert_masse_sable(j-1)-transfert_masse_sable(j))
            ENDIF
          ENDIF
        ENDDO
!
        elay%R(i)=0.d0
!
        DO j=1,nomblay
          epai_vase(j)=ms_vase(i,j)/conc_vase(j)
          es(i,j) = epai_vase(j)
          IF(nsicla.GT.1) THEN
            epai_sable(j)=ms_sable(i,j)/xmvs
            es(i,j)=epai_vase(j)+epai_sable(j)
          ENDIF
          elay%R(i)=elay%R(i) + es(i,j)
        ENDDO
!
!       BED EVOLUTION DUE TO CONSOLIDATION
!
        dzf_tass%R(i)=elay%R(i)-t2%R(i)
!
        IF(nsicla.GT.1) THEN
          DO j=1,nomblay
            IF(es(i,j).GE.1.d-6) THEN
              avail(i,j,1)=ms_sable(i,j)/xmvs/es(i,j)
              avail(i,j,2)=ms_vase(i,j)/conc_vase(j)/es(i,j)
            ELSE
              avail(i,j,1)=0.d0
              avail(i,j,2)=0.d0
            ENDIF
          ENDDO
        ENDIF
!
      ENDDO
!
!-----------------------------------------------------------------------
!
      RETURN
      END