The TELEMAC-MASCARET system  trunk
ride_gaia.f
Go to the documentation of this file.
1 ! ********************
2  SUBROUTINE ride_gaia
3 ! ********************
4 !
5  &(ks,tw,uw,unorm,grav,xmve,xmvs,vce,npoin,kspratio,acladm)
6 !
7 !***********************************************************************
8 ! GAIA
9 !***********************************************************************
10 !
12 !
16 !
17 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
29 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
30 !
31  IMPLICIT NONE
32 !
33  INTEGER I,NPOIN
34  DOUBLE PRECISION, INTENT (INOUT) :: KS(npoin)
35 !
36  DOUBLE PRECISION, INTENT (IN) :: GRAV,XMVE,XMVS, VCE
37  DOUBLE PRECISION, INTENT (IN) :: UNORM(npoin),UW(npoin),TW(npoin)
38 !
39  DOUBLE PRECISION, INTENT(IN) :: KSPRATIO
40  DOUBLE PRECISION, INTENT(IN) :: ACLADM(npoin)
41 !
42 !---------------------------------------------------------------------
43 ! LOCAL VARIABLES
44  DOUBLE PRECISION PI, ZERO,AI
45 !
46  DOUBLE PRECISION ETA, LAMBDA
47 !
48  DOUBLE PRECISION AA,BB,CC,DD
49  DOUBLE PRECISION ALPHA,S,M,A0
50  DOUBLE PRECISION WH1,WH2,WH3
51  DOUBLE PRECISION VAR1,DHRA,LRA,HRA,LRO
52  DOUBLE PRECISION UC,KSP
53 !---------------------------------------------------------------------
54 !
55  pi=4.d0*atan(1.d0)
56  zero=1.d-6
57 !
58 ! COEFFICIENTS
59 !
60  wh1=0.095d0
61  wh2=0.442d0
62  wh3=2.28d0
63  aa=(wh2+1.d0)/2.d0/wh1
64  bb=aa*aa-wh3/wh1
65  cc=1.d0/wh1
66 !
67 ! LOOP ON THE NODES
68 !
69  DO i=1,npoin
70 !
71 ! SKIN FRICTION
72 !
73  ksp = kspratio * acladm(i)
74  ai = acladm(i)*grav*(xmvs-xmve)/xmve
75 !
76 ! MOBILITY NUMBER
77 !
78  m=uw(i)**2/ai
79 !
80  IF(m.LT.1.69d0) THEN
81 !
82  ks(i)=ksp
83 !
84  ELSE
85 !
86 ! WIBERG AND HARRIS
87 !
88  a0=uw(i)*tw(i)/(2.d0*pi)
89  s=acladm(i)*sqrt(ai)/4.d0/vce
90  lra=535.d0*acladm(i)
91 !JMB***************************************************
92 !JMB LINE OF CODE MOVED SO ALPHA COMPUTED BEFORE VAR1
93 !JMB TANNAKA AND DANG (1996)
94  uc=unorm(i)
95  IF(uw(i).GT.zero) THEN
96  alpha=(tanh(0.3d0*s**(2.d0/3.d0)))**2.5d0
97  alpha=1.d0+0.81d0*alpha*(uc/uw(i))**1.9d0
98  ELSE
99  alpha=1.d0
100  ENDIF
101 !JMB*******************************************************
102  var1=log(alpha*2.d0*a0/lra)
103  dd=max((bb-cc*var1),0.d0)
104  dhra=exp(aa-sqrt(dd))
105  hra=alpha*2.d0*a0/dhra
106 !
107  IF(dhra.LE.20.d0) THEN
108 ! ORBITAL RIPPLES DHRA
109  lro=0.62d0*2.d0*a0*alpha
110  lambda=lro
111  eta=0.17d0*lambda
112  ELSEIF(dhra.LE.100.d0) THEN
113 ! SUB ORBITAL RIPPLES 20
114  lro=0.62d0*2.d0*a0*alpha
115  var1=(log(dhra)-log(100.d0))/(log(20.d0)-log(100.d0))
116  var1=log(lra)+var1*(log(lro)-log(lra))
117  lambda=exp(var1)
118  var1=log(alpha*2.d0*a0/lambda)
119 !CV 25/05 ETA=ALPHA*2.D0*A0/EXP(AA-SQRT(BB-CC*VAR1))
120  dd=max((bb-cc*var1),0.d0)
121  eta=alpha*2.d0*a0/exp(aa-sqrt(dd))
122  ELSE
123 ! ANORBITAL RIPPLES DHRA>100
124 ! LAMBDA NOT USED HERE BUT KEPT FOR OTHER FORMULATIONS
125 ! LAMBDA=LRA
126  eta=hra
127  ENDIF
128 !
129  ks(i)=max(eta,ksp)
130 !
131  ENDIF
132 !
133  ENDDO
134 !
135 !---------------------------------------------------------------------
136 !
137  RETURN
138  END
subroutine ride_gaia(KS, TW, UW, UNORM, GRAV, XMVE, XMVS, VCE, NPOIN, KSPRATIO, ACLADM)
Definition: ride_gaia.f:7