bedload_evol.f

Go to the documentation of this file.

!                   ***********************
                    SUBROUTINE bedload_evol
!                   ***********************
!
     &(s,elay,ava,coefpn,calfa,salfa,limtec,ebor,
     & maskel,mask,v2dpar,unsv2d,debug,npoin,nptfr,
     & ielmt,kent,kdir,kddl,
     & dts,
     & vf,entet,msk,mesh,
     & qs,t1,t2,t3,t4,t8,
     & t11,t12,t13,csf_sable,breach,qsx,qsy,zfcl,slopeff,icla,
     & flbcla,liqbor,qbor,maxadv)
!
!***********************************************************************
! SISYPHE   V7P0                                    03/06/2014
!***********************************************************************
!
!brief    COMPUTES THE EVOLUTION FOR THE BEDLOAD TRANSPORT.
!
!history  F. HUVELIN
!+        14/09/2004
!+        V6P0
!+
!
!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
!+
!history  J-M HERVOUET (EDF-LNHE)
!+        27/01/2012
!+        V6P2
!+  Argument ICLA added
!
!history  J-M HERVOUET (EDF-LNHE)
!+        09/01/2013
!+        V6P3
!+  Pointer FLULIM added to avoid a hidden temporary array allocation
!
!history  R.ATA (EDF-LNHE)
!+        02/06/2014
!+        V7P0
!+  Corrections of normals and nubo tables
!+  after changes in FV data structure of Telemac2d
!+
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!| AVA            |-->| PERCENT AVAILABLE
!| BREACH         |<->| INDICATOR FOR NON ERODIBLE BED (FINITE VOLUMES SHEMES)
!| CALFA          |<->| COSINUS OF THE ANGLE BETWEEN MEAN FLOW AND TRANSPORT
!| COEFPN         |<->| CORRECTION OF TRANSORT FOR SLOPING BED EFFECT
!| DEBUG          |-->| FLAG FOR DEBUGGING
!| DTS            |<->| TIME STEP FOR SUSPENSION
!| EBOR           |<->| BOUNDARY CONDITION FOR BED EVOLUTION (DIRICHLET)
!| ELAY           |<->| THICKNESS OF SURFACE LAYER
!| ELAY0          |<->| ACTIVE LAYER THICKNESS
!| ENTET          |-->| LOGICAL, IF YES INFORMATION IS GIVEN ON MASS CONSERVATION
!| FLBCLA         |-->| BLOCK OF FLUXES AT BOUNDARY FOR EACH CLASS
!| ICLA           |-->| CLASS NUMBER
!| IELMT          |-->| NUMBER OF ELEMENTS
!| KDDL           |-->| CONVENTION FOR DEGREE OF FREEDOM
!| KDIR           |-->| CONVENTION FOR DIRICHLET POINT
!| KENT           |-->| CONVENTION FOR LIQUID INPUT WITH PRESCRIBED VALUE
!| LIMTEC         |<->| TYPE OF BOUNDARY CONDITION
!| LIQBOR         |-->| TYPE OF BOUNDARY CONDITION FOR BEDLOAD DISCHARGE
!| MASK           |-->| BLOCK OF MASKS, EVERY ONE FOR A TYPE OF BOUNDARY
!| MASKEL         |-->| MASKING OF ELEMENTS
!| MAXADV         |-->| MAXIMUM NUMBER OF ITERATIONS (IN POSITIVE_DEPTHS)
!| MESH           |<->| MESH STRUCTURE
!| MSK            |-->| IF YES, THERE IS MASKED ELEMENTS
!| NPOIN          |-->| NUMBER OF POINTS
!| NPTFR          |-->| NUMBER OF BOUNDARY POINTS
!| QBOR           |-->| PRESCRIBED BEDLOAD DISCHARGE
!| QS             |<->| EDLOAD TRANSPORT RATE
!| QSX            |<->| SOLID DISCHARGE X
!| QSY            |<->| SOLID DISCHARGE Y
!| S              |-->| VOID STRUCTURE
!| SALFA          |<->| SINUS OF THE ANGLE BETWEEN TRANSPORT RATE AND CURRENT
!| SLOPEFF        |-->| LOGICAL, SLOPING BED EFFECT OR NOT
!| T1             |<->| WORK BIEF_OBJ STRUCTURE
!| T11            |<->| WORK BIEF_OBJ STRUCTURE
!| T12            |<->| WORK BIEF_OBJ STRUCTURE
!| T13            |<->| WORK BIEF_OBJ STRUCTURE
!| T2             |<->| WORK BIEF_OBJ STRUCTURE
!| T3             |<->| WORK BIEF_OBJ STRUCTURE
!| T4             |<->| WORK BIEF_OBJ STRUCTURE
!| T8             |<->| WORK BIEF_OBJ STRUCTURE
!| UNSV2D         |-->| INVERSE OF INTEGRALS OF TEST FUNCTIONS
!| V2DPAR         |-->| INTEGRAL OF TEST FUNCTIONS, ASSEMBLED IN PARALLEL
!| VF             |-->| LOGICAL, FINITE VOLUMES OR NOT
!| ZFCL           |<->| BED EVOLUTION PER CLASS, DUE TO SUSPENDED SEDIMENT
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!
      USE interface_sisyphe, ex_bedload_evol => bedload_evol
      USE bief
      USE declarations_special
      IMPLICIT NONE
!
!+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
!
      TYPE(bief_obj),   INTENT(IN)    :: S,UNSV2D,ELAY
      TYPE(bief_obj),   INTENT(IN)    :: COEFPN,CALFA,SALFA
      TYPE(bief_obj),   INTENT(IN)    :: MASKEL,MASK,V2DPAR
      INTEGER,          INTENT(IN)    :: DEBUG,SLOPEFF,NPOIN,NPTFR,ICLA
      INTEGER,          INTENT(IN)    :: IELMT,KENT,KDIR,KDDL
      INTEGER,          INTENT(IN)    :: MAXADV
      DOUBLE PRECISION, INTENT(IN)    :: DTS
      DOUBLE PRECISION, INTENT(IN)    :: AVA(npoin)
      LOGICAL,          INTENT(IN)    :: VF,ENTET,MSK
      TYPE(bief_mesh),  INTENT(INOUT) :: MESH
      TYPE(bief_obj),   INTENT(INOUT) :: QS,EBOR,FLBCLA
      TYPE(bief_obj),   INTENT(INOUT) :: T1, T2, T3, T4
      TYPE(bief_obj),   INTENT(INOUT) :: T8,T11, T12, T13
      DOUBLE PRECISION, INTENT(IN)    :: CSF_SABLE
      TYPE(bief_obj),   INTENT(INOUT) :: BREACH, QSX, QSY, ZFCL,LIMTEC
      TYPE(bief_obj),   INTENT(IN)    :: LIQBOR,QBOR
!
!+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
!
      INTEGER          :: J
      DOUBLE PRECISION, POINTER :: FLULIM(:)
!
!=======================================================================
!                               PROGRAM
!=======================================================================
!
!     POINTER TO A WORK ARRAY
!
      flulim => mesh%MSEG%X%R(mesh%NSEG+1:2*mesh%NSEG)
!
!     SLOPE EFFECT
!
      IF(slopeff.EQ.1) CALL os('X=XY    ', x=qs , y=coefpn)
      CALL os('X=YZ    ', x=qsx, y=qs, z=calfa)
      CALL os('X=YZ    ', x=qsy, y=qs, z=salfa)
!
!     TREATMENT OF NON ERODABLE BOTTOM
!
      IF(vf) THEN
        IF(debug.GT.0) WRITE(lu,*) 'CALLING BEDLOAD_NERBED_VF'
        CALL bedload_nerbed_vf
     &        (mesh,limtec,kddl,elay%R,v2dpar%R,qsx,qsy,ava,npoin,
     &         mesh%NSEG,nptfr,dts,qs,t1,t2,t3,breach,csf_sable,
     &         mesh%NUBO%I,mesh%VNOIN%R)
        IF(debug.GT.0) WRITE(lu,*) 'RETURN FROM BEDLOAD_NERBED_VF'
        CALL os('X=YZ    ', x=qsx, y=qs, z=calfa)
        CALL os('X=YZ    ', x=qsy, y=qs, z=salfa)
      ENDIF
!
!     SOLVES THE BED-EVOLUTION EQUATION : F.V.
!
      IF(vf) THEN
        IF(debug.GT.0) WRITE(lu,*) 'CALLING BEDLOAD_SOLVS_VF'
        CALL bedload_solvs_vf(mesh,qsx,qsy,limtec,unsv2d,ebor,
     &                        breach,mesh%NSEG,nptfr,npoin,
     &                        kent,kdir,kddl,dts,zfcl,t11,
     &                        csf_sable,flbcla%ADR(icla)%P,ava,
     &                        liqbor,qbor,mesh%NUBO%I,mesh%VNOIN%R)
        IF(debug.GT.0) WRITE(lu,*) 'RETURN FROM BEDLOAD_SOLVS_VF'
!
!     SOLVES THE BED-EVOLUTION EQUATION : F.E.
!
      ELSE
        DO j=1,npoin
!         T13 IS THE SEDIMENT HEIGHT (EXCLUDING VOIDS, SO *CSF_SABLE)
          t13%R(j)=ava(j)*elay%R(j)*csf_sable
        ENDDO
        IF(debug.GT.0) WRITE(lu,*) 'BEDLOAD_SOLVS_FE'
        CALL bedload_solvs_fe(mesh,s,ebor,maskel,mask,
     &                        qsx,qsy,ielmt,npoin,nptfr,kent,kdir,kddl,
     &                        limtec,dts,msk,entet,t1,t2,t3,t4,t8,
     &                        zfcl,t12,t13,mesh%GLOSEG%I,
     &                        mesh%GLOSEG%DIM1,mesh%MSEG%X,
     &                        flulim,mesh%NSEG,unsv2d,csf_sable,icla,
     &                        flbcla%ADR(icla)%P,ava,liqbor,qbor,
     &                        maxadv)
        IF(debug.GT.0) WRITE(lu,*) 'END_BEDLOAD_SOLVS_FE'
      ENDIF
!
!======================================================================!
!======================================================================!
!
      RETURN
      END