The TELEMAC-MASCARET system  trunk
tassement.f
Go to the documentation of this file.
1 ! ********************
2  SUBROUTINE tassement
3 ! ********************
4 !
5  &(npoin,dts,elay,dzf_tass,t2,avail,nsicla,es,xmvs,
6  & xkv,trans_mass,conc_vase,nomblay,ms_sable,ms_vase)
7 !
8 !***********************************************************************
9 ! SISYPHE V6P1 21/07/2011
10 !***********************************************************************
11 !
12 !brief
13 !
14 !history N.DURAND (HRW), S.E.BOURBAN (HRW)
15 !+ 13/07/2010
16 !+ V6P0
17 !+ Translation of French comments within the FORTRAN sources into
18 !+ English comments
19 !
20 !history N.DURAND (HRW), S.E.BOURBAN (HRW)
21 !+ 21/08/2010
22 !+ V6P0
23 !+ Creation of DOXYGEN tags for automated documentation and
24 !+ cross-referencing of the FORTRAN sources
25 !
26 !history C.VILLARET (EDF-LNHE), P.TASSI (EDF-LNHE)
27 !+ 19/07/2011
28 !+ V6P1
29 !+ Name of variables
30 !+
31 !
32 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
33 !| AVAIL |<->| VOLUME PERCENT OF EACH CLASS
34 !| CONC_VASE |<->| MUD CONCENTRATION FOR EACH LAYER
35 !| DTS |-->| TIME STEP FOR SUSPENSION
36 !| DZF_TASS |-->| BED EVOLUTION DUE TO CONSOLIDATION
37 !| ELAY |<->| THICKNESS OF EACH LAYER
38 !| ES |<->| LAYER THICKNESSES AS DOUBLE PRECISION
39 !| MS_SABLE |<->| MASS OF SAND PER LAYER (KG/M2)
40 !| MS_VASE |<->| MASS OF MUD PER LAYER (KG/M2)
41 !| NOMBLAY |-->| NUMBER OF LAYERS FOR CONSOLIDATION
42 !| NPOIN |-->| NUMBER OF POINTS
43 !| NSICLA |-->| NUMBER OF SIZE CLASSES FOR BED MATERIALS
44 !| T2 |<->| WORK BIEF_OBJ STRUCTURE
45 !| TRANS_MASS |-->| TRANSFER OF MASS PER LAYER (CONSOLIDATION ALGORITHM)
46 !| XKV |-->| BED POROSITY
47 !| XMVS |-->| SEDIMENT DENSITY
48 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
49 !
50  USE bief
51  USE declarations_sisyphe, ONLY : nlaymax
53  IMPLICIT NONE
54 !
55 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
56 !
57  INTEGER, INTENT(IN) :: NPOIN,NSICLA,NOMBLAY
58  type(bief_obj), INTENT(INOUT) :: dzf_tass,elay,t2
59  DOUBLE PRECISION, INTENT(INOUT) :: MS_SABLE(npoin,nomblay)
60  DOUBLE PRECISION, INTENT(INOUT) :: MS_VASE(npoin,nomblay)
61  DOUBLE PRECISION, INTENT(IN) :: DTS
62  DOUBLE PRECISION, INTENT(INOUT) :: AVAIL(npoin,nomblay,nsicla)
63  DOUBLE PRECISION, INTENT(INOUT) :: ES(npoin,nomblay)
64  DOUBLE PRECISION, INTENT(IN) :: TRANS_MASS(nomblay)
65  DOUBLE PRECISION, INTENT(IN) :: CONC_VASE(nomblay)
66  DOUBLE PRECISION, INTENT(IN) :: XMVS,XKV
67 !
68 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
69 !
70  INTEGER I,J
71  DOUBLE PRECISION CONC_SABLE
72 !
73  DOUBLE PRECISION TAUX(nlaymax),TRANSFERT_MASSE_VASE(nlaymax)
74  DOUBLE PRECISION TRANSFERT_MASSE_SABLE(nlaymax)
75  DOUBLE PRECISION EPAI_SABLE(nlaymax),EPAI_VASE(nlaymax)
76 !
77 ! COMPUTES THE TOTAL SEDIMENT THICKNESS (SAND + MUD) BEFORE CONSOLIDATION
78 !
79  conc_sable=xmvs/xkv
80 !
81 ! T2: MUD THICKNESS BEFORE CONSOLIDATION
82 !
83  DO i=1,npoin
84 !
85  t2%R(i)=0.d0
86  DO j=1,nomblay
87  epai_vase(j)=ms_vase(i,j)/conc_vase(j)
88  es(i,j)=epai_vase(j)
89  IF(nsicla.GT.1) THEN
90  epai_sable(j)=ms_sable(i,j)/xmvs
91  es(i,j)=epai_vase(j)+epai_sable(j)
92  ENDIF
93  t2%R(i)=t2%R(i)+es(i,j)
94  ENDDO
95 !
96  DO j=1,nomblay
97  IF(ms_vase(i,j).GE.1.d-6) THEN
98  transfert_masse_vase(j)=min(ms_vase(i,j),
99  & ms_vase(i,j)*dts*trans_mass(j))
100  IF(nsicla.GT.1) THEN
101  taux(j)=transfert_masse_vase(j)/ms_vase(i,j)
102  transfert_masse_sable(j)=taux(j)*ms_sable(i,j)
103  ENDIF
104  ELSE
105  transfert_masse_vase(j)=0.d0
106  IF(nsicla.GT.1) transfert_masse_sable(j)=0.d0
107  ENDIF
108 !**************ARRET DE TASSEMENT SI LA VASE A REMPLI LES INTERSTICES
109 !************** ENTRE LES GRAINS DE SABLE
110  IF(nsicla.GT.1.AND.epai_sable(j).GE.es(i,j)) THEN
111  transfert_masse_vase(j) =0.d0
112  transfert_masse_sable(j)=0.d0
113  ENDIF
114  ENDDO
115 !
116  DO j=1,nomblay
117  IF(j.EQ.nomblay) THEN
118  ms_vase(i,j)=max(0.d0,ms_vase(i,j)
119  & +transfert_masse_vase(j-1))
120  IF(nsicla.GT.1) THEN
121  ms_sable(i,j)=max(0.d0,ms_sable(i,j)
122  & +transfert_masse_sable(j-1))
123  ENDIF
124  ELSEIF(j.EQ.1) THEN
125  ms_vase(i,j)=max(0.d0,ms_vase(i,j)
126  & -transfert_masse_vase(j))
127  IF(nsicla.GT.1) THEN
128  ms_sable(i,j)=max(0.d0,ms_sable(i,j)
129  & -transfert_masse_sable(j))
130  ENDIF
131  ELSE
132  ms_vase(i,j)=max(0.d0,ms_vase(i,j)
133  & +transfert_masse_vase(j-1)-transfert_masse_vase(j))
134  IF(nsicla.GT.1) THEN
135  ms_sable(i,j)=max(0.d0,ms_sable(i,j)
136  & +transfert_masse_sable(j-1)-transfert_masse_sable(j))
137  ENDIF
138  ENDIF
139  ENDDO
140 !
141  elay%R(i)=0.d0
142 !
143  DO j=1,nomblay
144  epai_vase(j)=ms_vase(i,j)/conc_vase(j)
145  es(i,j) = epai_vase(j)
146  IF(nsicla.GT.1) THEN
147  epai_sable(j)=ms_sable(i,j)/xmvs
148  es(i,j)=epai_vase(j)+epai_sable(j)
149  ENDIF
150  elay%R(i)=elay%R(i) + es(i,j)
151  ENDDO
152 !
153 ! BED EVOLUTION DUE TO CONSOLIDATION
154 !
155  dzf_tass%R(i)=elay%R(i)-t2%R(i)
156 !
157  IF(nsicla.GT.1) THEN
158  DO j=1,nomblay
159  IF(es(i,j).GE.1.d-6) THEN
160  avail(i,j,1)=ms_sable(i,j)/xmvs/es(i,j)
161  avail(i,j,2)=ms_vase(i,j)/conc_vase(j)/es(i,j)
162  ELSE
163  avail(i,j,1)=0.d0
164  avail(i,j,2)=0.d0
165  ENDIF
166  ENDDO
167  ENDIF
168 !
169  ENDDO
170 !
171 !-----------------------------------------------------------------------
172 !
173  RETURN
174  END
subroutine tassement(NPOIN, DTS, ELAY, DZF_TASS, T2, AVAIL, NSICLA, ES, XMVS, XKV, TRANS_MASS, CONC_VASE, NOMBLAY, MS_SABLE, MS_VASE)
Definition: tassement.f:8
integer, parameter nlaymax
Definition: bief.f:3