The TELEMAC-MASCARET system  trunk
tob_gaia.f
Go to the documentation of this file.
1 ! *******************
2  SUBROUTINE tob_gaia
3 ! *******************
4 !
5  & (tob, tobw, tobcw_mean, tobcw_max, thetac, thetaw, mu,
6  & ks,ksp, ksr,cf,fw,uetcar,cf_tel,ks_tel,code,
7  & icr, kspratio, houle,grav,xmve,xmvs, vce, karman,
8  & zero,hmin,hn, acladm, unorm,uw, tw, npoin,kscalc,iks,
9  & deltar, h_tel)
10 !
11 !***********************************************************************
12 ! GAIA
13 !***********************************************************************
14 !
16 !
17 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
57 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
58 !
59  USE bief
60  USE declarations_gaia, ONLY: nsand
61  USE interface_gaia, ex_tob_gaia=>tob_gaia
62 !
64  IMPLICIT NONE
65 !
66 !!-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
67 !
68  INTEGER, INTENT(IN) :: NPOIN,ICR, IKS
69  LOGICAL, INTENT(IN) :: KSCALC
70  LOGICAL, INTENT(IN) :: HOULE
71  CHARACTER(LEN=24), INTENT(IN) :: CODE
72  DOUBLE PRECISION, INTENT(IN) :: XMVE,XMVS, VCE,GRAV,KARMAN
73  DOUBLE PRECISION, INTENT(IN) :: ZERO,HMIN,KSPRATIO
74  TYPE(bief_obj), INTENT(IN) :: UETCAR
75  TYPE(bief_obj), INTENT(IN) :: DELTAR
76  TYPE(bief_obj), INTENT(IN) :: HN,UNORM
77  TYPE(bief_obj), INTENT(IN) :: TW,UW
78  TYPE(bief_obj), INTENT(INOUT) :: KS,KSP,KSR,KS_TEL
79  TYPE(bief_obj), INTENT(INOUT) :: MU
80  TYPE(bief_obj), INTENT(IN) :: ACLADM
81  TYPE(bief_obj), INTENT(INOUT) :: CF
82  TYPE(bief_obj), INTENT(INOUT) :: FW
83  TYPE(bief_obj), INTENT(IN ) :: THETAC, THETAW
84  TYPE(bief_obj), INTENT(INOUT) :: TOB,TOBW
85  TYPE(bief_obj), INTENT(INOUT) :: TOBCW_MEAN,TOBCW_MAX
86  TYPE(bief_obj), INTENT(IN) :: CF_TEL
87  TYPE(bief_obj), INTENT(IN) :: H_TEL
88 !
89 !!-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
90 !
91  INTEGER :: I
92  DOUBLE PRECISION :: A,B,C, HCLIP,KSMAX
93 !
94 ! 12.D0 WAS EXP(8.5*0.41)/EXP(1.D0)
95 ! 11.036D0 IS EXP(8.5*0.40)/EXP(1.D0)
96 ! CONSIDERING THAT EXP(8.5*0.40) IS 30 INSTEAD OF 29.9641...
97 ! 0.40 IS THE KARMAN CONSTANT THAT SHOULD BE PARAMETERISED SOMEWHERE
98  DOUBLE PRECISION, PARAMETER :: CSTE=11.036d0
99 !
100 ! +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
101 !
102 ! ----------------------------------------------------------------------------------------------
103 ! QUADRATIC FRICTION COEFICIENT : ---> CF
104 !-----------------------------------------------------------------------
105 !
106 ! INTERNAL COUPLING WITH TELEMAC2D OR 3D
107 ! UETCAR IS CF IN TELEMAC-2D
108 ! UETCAR IS UETCAR IN TELEMAC3D ?
109 ! KSP : skin friction
110 ! KSR: ripple roughness
111 ! KS : total bed roughness
112 ! initialisation
113 !
114  IF(nsand.GT.0) THEN
115  CALL os('X=CY ', x=ksp, y=acladm, c=kspratio)
116  CALL os('X=CY ', x=ksr, y=acladm, c=kspratio)
117 !
118  IF(kscalc) THEN
119 !
120 ! bed roughness predictor
121 !
122  CALL ks_gaia(iks,ks,ksp,ksr,kspratio,houle,
123  & grav,xmve,xmvs,vce,
124  & hn,acladm,unorm,uw,tw,npoin)
125  CALL coefro_gaia(cf,hn,ks,npoin,karman)
126  CALL ov('X=Y ', x=ks_tel%R, y=ks%R, dim1=npoin)
127 !
128  ELSE
129 !
130 ! here the total bed roughness is calculated as a function of friction coefficient
131 ! issued from Telemac
132 !
133  CALL ov('X=Y ', x=cf%R, y=cf_tel%R, dim1=cf%DIM1)
134  DO i =1,npoin
135  a = -karman*sqrt(2.d0/max(cf%R(i),zero))
136  ks%R(i)=cste*hn%R(i)*exp(a)
137  ks%R(i)=max(ks%R(i),ksp%R(i))
138  ENDDO
139 !
140  ENDIF
141  ELSE
142  CALL ov('X=Y ', x=cf%R, y=cf_tel%R, dim1=cf%DIM1)
143  ENDIF
144 !
145 ! +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
146 ! CURRENT SHEAR STRESS
147 ! --> TOB
148 !
149 ! INTERNAL COUPLING WITH TELEMAC3D
150 ! UETCAR CORRESPONDS TO THE SQUARE OF THE FRICTION VELOCITY
151 !
152  IF(code(1:9).EQ.'TELEMAC3D') THEN
153  DO i=1,npoin
154 ! TOB=0 IF H_TEL < HMIN (NOT USE HN BECAUSE HN = HMIN IN THIS CASE)
155  IF(h_tel%R(i).GE.hmin)THEN
156  tob%R(i)=(deltar%R(i)+1.d0)*xmve*uetcar%R(i)
157  ELSE
158  tob%R(i) = 0.d0
159  ENDIF
160  ENDDO
161  ELSE
162  DO i=1,npoin
163 ! TOB=0 IF H_TEL < HMIN (NOT USE HN BECAUSE HN = HMIN IN THIS CASE)
164  IF(h_tel%R(i).GE.hmin)THEN
165  tob%R(i) = xmve*0.5d0*cf%R(i)*unorm%R(i)**2
166  ELSE
167  tob%R(i) = 0.d0
168  ENDIF
169  ENDDO
170  ENDIF
171 !
172 ! -----WAVE-SHEAR STRESS -----------------------------
173 ! --> TOBW
174 !
175  IF(houle) THEN
176  CALL tobw_gaia
177  & (tobw%R,cf%R,fw%R,uw%R,tw%R,hn%R,npoin,xmve)
178  DO i=1,npoin
179  IF(h_tel%R(i).LT.hmin)THEN
180  tobw%R(i) = 0.d0
181  ENDIF
182  ENDDO
183 ! -----TOTAL CURRENT + WAVE-INDUCED SHEAR STRESS -----------
184 ! --> TOBCW_MEAN and TOBCW_MAX
185  CALL tobcw_gaia
186  & (tob%R,tobw%R,thetac%R,thetaw%R,
187  & tobcw_mean%R,tobcw_max%R,npoin)
188  ELSE
189  DO i=1,npoin
190  tobw%R(i)=0.d0
191  tobcw_mean%R(i)=tob%R(i)
192  tobcw_max%R(i)=tob%R(i)
193  ENDDO
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 tobcw_gaia(TOB, TOBW, THETAC, THETAW, TOBCW_MEAN, TOBCW_MAX, NPOIN)
Definition: tobcw_gaia.f:7
subroutine tob_gaia(TOB, TOBW, TOBCW_MEAN, TOBCW_MAX, THETAC, THETAW, MU, KS, KSP, KSR, CF, FW, UETCAR, CF_TEL, KS_TEL, CODE, ICR, KSPRATIO, HOULE, GRAV, XMVE, XMVS, VCE, KARMAN, ZERO, HMIN, HN, ACLADM, UNORM, UW, TW, NPOIN, KSCALC, IKS, DELTAR, H_TEL)
Definition: tob_gaia.f:11
subroutine tobw_gaia(TOBW, CF, FW, UW, TW, HN, NPOIN, XMVE)
Definition: tobw_gaia.f:7
integer nsand
Total number of sand.
subroutine ks_gaia(IKS, KS, KSP, KSR, KSPRATIO, HOULE, GRAV, XMVE, XMVS, VCE, HN, ACLADM, UNORM, UW, TW, NPOIN)
Definition: ks_gaia.f:8
subroutine os(OP, X, Y, Z, C, IOPT, INFINI, ZERO)
Definition: os.f:7
subroutine coefro_gaia(CF, H, KS, NPOIN, KARMAN)
Definition: coefro_gaia.f:7
Definition: bief.f:3