The TELEMAC-MASCARET system  trunk
bedload_bijker_gaia.f
Go to the documentation of this file.
1 ! ******************************
2  SUBROUTINE bedload_bijker_gaia
3 ! ******************************
4 !
5  & (tobw,tob,mu,ksp,ksr,hn,npoin,dcla,dens,xmve,grav,xwc,
6  & karman,zero,t4,t7,t8,t9,qsc,qss,bijk,houle,xmvs)
7 !
8 !***********************************************************************
9 ! GAIA
10 !***********************************************************************
11 !
13 !
14 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
38 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
39 !
40  USE interface_gaia,ex_bedload_bijker => bedload_bijker_gaia
41  USE bief
43  IMPLICIT NONE
44 !
45 !!-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
46 !
47  TYPE(bief_obj), INTENT(IN) :: TOBW, TOB, KSR,KSP, HN,MU
48  INTEGER, INTENT(IN) :: NPOIN
49  LOGICAL, INTENT(IN) :: HOULE
50  DOUBLE PRECISION, INTENT(IN) :: DCLA, DENS, XMVE, GRAV, XWC
51  DOUBLE PRECISION, INTENT(IN) :: XMVS
52  DOUBLE PRECISION, INTENT(IN) :: KARMAN, ZERO
53  DOUBLE PRECISION, INTENT(IN) :: BIJK
54  TYPE(bief_obj), INTENT(INOUT) :: T4
55  TYPE(bief_obj), INTENT(INOUT) :: T7, T8, T9
56  TYPE(bief_obj), INTENT(INOUT) :: QSC, QSS
57 !
58 !!-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
59 !
60  INTEGER :: I
61  DOUBLE PRECISION :: C1, C2, UCF
62 !
63 !======================================================================!
64 !======================================================================!
65 ! PROGRAM !
66 !======================================================================!
67 !======================================================================!
68 !
69  ! ***************************************************** !
70  ! I - STRESS UNDER THE COMBINED ACTION OF WAVES AND CURRENTS !
71  ! ***************************************************** !
72  IF(houle) THEN
73  CALL os('X=CY ', x=t4, y=tobw, c= 0.5d0)
74  CALL os('X=X+Y ', x=t4, y=tob)
75  ELSE
76  CALL os('X=Y ', x=t4, y=tob)
77  ENDIF
78  ! ******************************************************* !
79  ! II - CORRECTION TO TAKE BED FORMS INTO ACCOUNT !
80  ! ******************************************************* !
81 ! CALL OS('X=Y/Z ', X=MU, Y=CFP, Z=CF)
82 ! CALL OS('X=Y**C ', X=MU, Y=MU , C=0.75D0)
83  ! ***************************** !
84  ! III - BEDLOAD TRANSPORT !
85  ! ***************************** !
86  c1 = bijk*dcla
87  c2 = dens*dcla*xmve*grav
88  DO i = 1, npoin
89  IF (t4%R(i)*mu%R(i)> zero) THEN
90  qsc%R(i) = c1*sqrt(tob%R(i)/xmve )
91  & * exp(-0.27d0*(c2/(t4%R(i)*mu%R(i))))
92  ELSE
93  qsc%R(i) = 0.d0
94  ENDIF
95  ENDDO
96  ! *********************************************************** !
97  ! IV- ROUSE NUMBER AND LOWER BOUND OF EINSTEIN INTEGRAL !
98  ! *********************************************************** !
99  DO i = 1, npoin
100  IF (t4%R(i) > 0.d0) THEN
101  ucf = sqrt( t4%R(i) / xmve)
102  t7%R(i) = xwc / ( karman * ucf )
103 ! AUX = 1.D0 + KARMAN*SQRT(2.D0/MAX(CF%R(I),ZERO))
104 ! T8%R(I) = 30.D0*EXP(-AUX)
105  t8%R(i) = max(ksr%R(i),ksp%R(i))/max(hn%R(i),zero)
106  ELSE
107  t7%R(i)= 100001.d0
108  t8%R(i)= 100001.d0
109  ENDIF
110  ENDDO
111  ! ************************************ !
112  ! V - EINSTEIN INTEGRAL !
113  ! ************************************ !
114  CALL integ_gaia(t7%R, t8%R, t9%R, npoin)
115  ! ************************************** !
116  ! VI - TRANSPORT BY SUSPENSION !
117  ! ************************************** !
118  CALL os('X=YZ ', x=qss, y=t9, z=qsc)
119 !======================================================================!
120 ! SOLID DISCHARGE IS TRANSFORMED IN [kg/(m*s)]
121 !
122  CALL os('X=CX ', x=qsc, c=xmvs)
123  CALL os('X=CX ', x=qss, c=xmvs)
124 !======================================================================!
125  RETURN
126  END SUBROUTINE bedload_bijker_gaia
subroutine integ_gaia(A, B, IEIN, NPOIN)
Definition: integ_gaia.f:7
subroutine bedload_bijker_gaia(TOBW, TOB, MU, KSP, KSR, HN, NPOIN, DCLA, DENS, XMVE, GRAV, XWC, KARMAN, ZERO, T4, T7, T8, T9, QSC, QSS, BIJK, HOULE, XMVS)
subroutine os(OP, X, Y, Z, C, IOPT, INFINI, ZERO)
Definition: os.f:7
Definition: bief.f:3