The TELEMAC-MASCARET system  trunk
tob_sisyphe.f
Go to the documentation of this file.
1 ! **********************
2  SUBROUTINE tob_sisyphe
3 ! **********************
4 !
5  & (tob, tobw, mu, ks,ksp, ksr,cf,fw,chestr,uetcar,
6  & cf_tel,ks_tel,code,
7  & kfrot,icr, kspratio, houle,grav,xmve,xmvs, vce, karman,
8  & zero,hmin,hn, acladm, unorm,uw, tw, npoin,kspred,iks)
9 !
10 !***********************************************************************
11 ! SISYPHE V7P2
12 !***********************************************************************
13 !
14 !brief COMPUTES THE TOTAL STRESS AT THE BOTTOM DEPENDING
15 !+ ON WHETHER SISYPHE IS COUPLED OR NOT.
16 !
17 !history CV
18 !+ **/04/05
19 !+
20 !+ CORRECTION WHEN SISYPHE IS RUN ALONE: DO NOT MODIFY
21 !
22 !history C. VILLARET (LNHE)
23 !+ 29/11/06
24 !+ V6P0
25 !+
26 !
27 !history N.DURAND (HRW), S.E.BOURBAN (HRW)
28 !+ 13/07/2010
29 !+ V6P0
30 !+ Translation of French comments within the FORTRAN sources into
31 !+ English comments
32 !
33 !history N.DURAND (HRW), S.E.BOURBAN (HRW)
34 !+ 21/08/2010
35 !+ V6P0
36 !+ Creation of DOXYGEN tags for automated documentation and
37 !+ cross-referencing of the FORTRAN sources
38 !
39 !history C.VILLARET (EDF-LNHE), P.TASSI (EDF-LNHE)
40 !+ 19/07/2011
41 !+ V6P1
42 !+ Name of variables.
43 !+
44 !
45 !history J-M HERVOUET (EDF-LAB, LNHE), ON BEHALF OF CLEMENS DORFMAN
46 !+ 12/02/2016
47 !+ V7P2
48 !+ Changing the constant 12.D0 into 11.036D0 because in the rest of the
49 !+ code the Karman constant has been changed from 0.41 to 0.40.
50 !
51 !history RIADH ATA
52 !+ 12/03/2018
53 !+ V8P0
54 !+ Change the call of OS by a call of OV since, when coupling, this
55 !+ subroutine can be called by vectors and not structures (arguments)
56 !
57 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
58 !| ACLADM |-->| MEAN DIAMETER OF SEDIMENT
59 !| CF |-->| QUADRATIC FRICTION COEFFICIENT
60 !| CF_TEL |-->| QUADRATIC FRICTION COEFFICIENT (COUPLED T2D)
61 !| CHESTR |-->| FRICTION COEFFICIENT (KEYWORD)
62 !| CODE |-->| CALLING PROGRAM IN COUPLING
63 !| FW |-->| QUADRATIC FRICTION COEFFICIENT (WAVE)
64 !| GRAV |-->| ACCELERATION OF GRAVITY
65 !| HMIN |-->| MINIMUM VALUE OF WATER DEPTH
66 !| HN |-->| WATER DEPTH
67 !| HOULE |-->| INCLUDE WAVES COMPUTATIONS
68 !| ICR |-->| ICR=0: MU=1
69 !| | | ICR=1: SKIN FRICTION CORRECTION USE KSP
70 !| | | ICR=2: RIPPLE ROUGHNESS USE KSR, KSR
71 !| KARMAN |-->| VON KARMAN CONSTANT
72 !| KFROT |-->| FRICTION LAW
73 !| KS |<--| RUGOSITE TOTALE
74 !| KSP |<--| RUGOSITE DE PEAU
75 !| KSPRATIO |-->| RATIO BETWEEN SKIN BED ROUGHNESS AND GRAIN DIAMETER
76 !| KSR |<--| RUGOSITE DE RIDE
77 !| KS_TEL |<--| RUGOSITE TOTALE
78 !| MU |<->| CORRECTION FACTOR FOR BED ROUGHNESS
79 !| NPOIN |-->| NUMBER OF POINTS
80 !| TOB |<->| BED SHEAR STRESS (TOTAL FRICTION)
81 !| TOBW |-->| WAVE INDUCED SHEAR STRESS
82 !| TW,UW |-->| WAVE PERIOD AND ORBITAL VELOCITY
83 !| UETCAR |-->| SQUARE OF THE FRICTION VELOCITY (COUPLED T3D)
84 !| UNORM |-->| INTENSITE DU COURANT
85 !| VCE |-->| WATER VISCOSITY
86 !| XMVE |-->| FLUID DENSITY (MASS)
87 !| XMVS |-->| SEDIMENT DENSITY (MASS)
88 !| ZERO |-->| ZERO
89 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
90 !
91  USE bief
92  USE interface_sisyphe, ex_tob_sisyphe=>tob_sisyphe
93 !
95  IMPLICIT NONE
96 !
97 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
98 !
99  INTEGER, INTENT(IN) :: NPOIN,KFROT,ICR, IKS
100  LOGICAL, INTENT(IN) :: KSPRED
101  LOGICAL, INTENT(IN) :: HOULE
102  CHARACTER(LEN=24), INTENT(IN) :: CODE
103  DOUBLE PRECISION, INTENT(IN) :: XMVE,XMVS, VCE,GRAV,KARMAN
104  DOUBLE PRECISION, INTENT(IN) :: ZERO,HMIN,KSPRATIO
105  TYPE(bief_obj), INTENT(IN) :: UETCAR
106  TYPE(bief_obj), INTENT(IN) :: HN,UNORM
107  TYPE(bief_obj), INTENT(IN) :: TW,UW
108  TYPE(bief_obj), INTENT(INOUT) :: KS,KSP,KSR,KS_TEL
109  TYPE(bief_obj), INTENT(INOUT) :: CHESTR,MU
110  TYPE(bief_obj), INTENT(IN) :: ACLADM
111  TYPE(bief_obj), INTENT(INOUT) :: CF,TOB
112  TYPE(bief_obj), INTENT(INOUT) :: FW,TOBW
113  TYPE(bief_obj), INTENT(IN) :: CF_TEL
114 !
115 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
116 !
117  INTEGER :: I
118  DOUBLE PRECISION :: A,B,C, HCLIP,KSMAX
119 !
120 ! 12.D0 WAS EXP(8.5*0.41)/EXP(1.D0)
121 ! 11.036D0 IS EXP(8.5*0.40)/EXP(1.D0)
122 ! CONSIDERING THAT EXP(8.5*0.40) IS 30 INSTEAD OF 29.9641...
123 ! 0.40 IS THE KARMAN CONSTANT THAT SHOULD BE PARAMETERISED SOMEWHERE
124  DOUBLE PRECISION, PARAMETER :: CSTE=11.036d0
125 !
126 ! +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
127 !
128 ! ----------------------------------------------------------------------------------------------
129 ! QUADRATIC FRICTION COEFICIENT : ---> CF
130 !-----------------------------------------------------------------------
131 !
132 ! INTERNAL COUPLING WITH TELEMAC2D OR 3D
133 ! UETCAR IS CF IN TELEMAC-2D
134 ! UETCAR IS UETCAR IN TELEMAC3D ?
135 ! KSP : skin friction
136 ! KSR: ripple roughness
137 ! KS : total bed roughness
138 ! initialisation
139 !
140  CALL os('X=CY ', x=ksp, y=acladm, c=kspratio)
141  CALL os('X=CY ', x=ksr, y=acladm, c=kspratio)
142 !
143  IF(kspred) THEN
144 !
145 ! bed roughness predictor
146 !
147  CALL ks_sisyphe(iks,ks,ksp,ksr,kspratio,houle,
148  & grav,xmve,xmvs,vce,
149  & hn,acladm,unorm,uw,tw,npoin)
150  CALL coefro_sisyphe(cf,hn,kfrot,ks,grav,npoin,hmin,karman)
151  IF(code(1:7).EQ.'TELEMAC')
152  & CALL ov( 'X=Y ', ks_tel%R, ks%R, ks%R, 0.d0, npoin)
153 !
154  ELSE
155 !
156 ! here the total bed roughness is calculated as a function of friction coefficient
157 ! -- > issued from Telemac if coupling
158 ! -- > from the steering file of Sisyphe
159 !
160  IF(code(1:7).EQ.'TELEMAC') THEN
161  CALL ov('X=Y ', x=cf%R, y=cf_tel%R, dim1=cf%DIM1)
162  ELSE
163  CALL coefro_sisyphe(cf,hn,kfrot,chestr,grav,npoin,hmin,karman)
164  ENDIF
165  DO i =1,npoin
166  a = -karman*sqrt(2.d0/max(cf%R(i),zero))
167  ks%R(i)=cste*hn%R(i)*exp(a)
168  ks%R(i)=max(ks%R(i),ksp%R(i))
169  ENDDO
170 !
171  ENDIF
172 !
173 ! +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
174 !
175 ! Frottement total: loi quadratique sauf couplage 3D
176 ! --> TOB
177 !
178 ! INTERNAL COUPLING WITH TELEMAC3D
179 ! UETCAR CORRESPONDS TO THE FRICTION VELOCITY SQUARED
180 !
181  IF(code(1:9).EQ.'TELEMAC3D') THEN
182  CALL os( 'X=CY ',x=tob,y=uetcar,c=xmve)
183  ELSE
184  DO i=1,npoin
185  tob%R(i) = xmve*0.5d0*cf%R(i)*unorm%R(i)**2
186  ENDDO
187  ENDIF
188 !
189 ! -----WAVE-INDUCED FRICTION -----------------------------
190 ! --> TOBW
191 !
192  IF(houle) THEN
193  CALL tobw_sisyphe(tobw%R,cf%R,fw%R,uw%R,tw%R,hn%R,npoin,xmve)
194  ENDIF
195 !
196 !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
197 !
198 ! SKIN FRICTION CORRECTOR
199 ! ---> MU = TOP/TOB
200 ! ICR=0: MU=1
201 ! ICR=1 : SKIN FRICTION CORRECTION USE KSP
202 ! ICR= 2 : RIPPLE ROUGHNESS USE KSR, KSR
203 ! COUPLED WITH TELEMAC: MU>1 IS ACCEPTABLE
204 !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
205 !
206  IF(icr.EQ.0) THEN
207  CALL os('X=C ', x=mu, c=1.d0)
208  ELSEIF(icr.EQ.1) THEN
209  DO i= 1, npoin
210  IF(cf%R(i).GT.zero.AND.hn%R(i).GT.ksp%R(i)) THEN
211  hclip=max(hn%R(i),ksp%R(i))
212  a = 2.5d0*log(cste*hclip/ksp%R(i))
213  c =2.d0/a**2
214  mu%R(i) = c/cf%R(i)
215  ELSE
216  mu%R(i) = 0.d0
217  ENDIF
218  ENDDO
219  ELSEIF(icr.EQ.2) THEN
220  DO i= 1, npoin
221  ksmax=max(ksr%R(i),ksp%R(i))
222  IF(hn%R(i).GT.ksmax.AND.cf%R(i).GT.zero)THEN
223  hclip=max(hn%R(i),ksmax)
224  a = log(cste*hclip/ksp%R(i))
225  b = log(cste*hclip/ksr%R(i))
226  c = 0.32d0/cf%R(i)
227  mu%R(i) = c/sqrt(b*a**3)
228  ELSE
229  mu%R(i) = 0.d0
230  ENDIF
231  ENDDO
232  ENDIF
233 !
234 !------------------------------------------------------------
235 !
236  RETURN
237  END
subroutine ov(OP, X, Y, Z, C, DIM1)
Definition: ov.f:7
subroutine ks_sisyphe(IKS, KS, KSP, KSR, KSPRATIO, HOULE, GRAV, XMVE, XMVS, VCE, HN, ACLADM, UNORM, UW, TW, NPOIN)
Definition: ks_sisyphe.f:8
subroutine tobw_sisyphe(TOBW, CF, FW, UW, TW, HN, NPOIN, XMVE)
Definition: tobw_sisyphe.f:7
subroutine coefro_sisyphe(CF, H, KFROT, CHESTR, GRAV, NPOIN, HMIN, KARMAN)
Definition: coefro_sisyphe.f:7
subroutine os(OP, X, Y, Z, C, IOPT, INFINI, ZERO)
Definition: os.f:7
subroutine tob_sisyphe(TOB, TOBW, MU, KS, KSP, KSR, CF, FW, CHESTR, UETCAR, CF_TEL, KS_TEL, CODE, KFROT, ICR, KSPRATIO, HOULE, GRAV, XMVE, XMVS, VCE, KARMAN, ZERO, HMIN, HN, ACLADM, UNORM, UW, TW, NPOIN, KSPRED, IKS)
Definition: tob_sisyphe.f:10
Definition: bief.f:3