The TELEMAC-MASCARET system  trunk
pentco.f
Go to the documentation of this file.
1 ! *****************
2  SUBROUTINE pentco
3 ! *****************
4  &(ii)
5 !
6 !***********************************************************************
7 ! ARTEMIS V7P3 Aug 2017
8 !***********************************************************************
9 !
10 !
11 !brief FUNCTION: CALCULATE SECOND ORDER BOTTOM EFFECTS (GRADIENT&CURVATURE)
12 !+ FOR EXTENDED MILD-SLOPE EQUATION
13 !
14 !code
15 !+ OUTPUT :
16 !+ 1 + F = 1 + E1(KH)*grad(H)**2 + E2(KH)/K0*LAPLACIEN(H)
17 !+
18 !+ WE CAN CHOOSE TO ONTEGRATE ONLY GRADIANT EFFECTS : II=1
19 !+ WE CAN CHOOSE TO ONTEGRATE ONLY CURVATURE EFFECTS : II=2
20 !+ WE CAN CHOOSE TO INTEGRATE BOTH GRADIANT & CURVATURE EFFECTS : II=3
21 !+ DEFAULT VALUE : IPENTCO=0, ARTEMIS SOLVE CLASSICAL MILD-SLOPE EQUATION
22 !+
23 !+
24 !+ EXPRESSIONS FOR E1 and E2 USED HERE ARE (Chamberlain & Porter 1995) :
25 !+
26 !+ (given X = 2 KH)
27 !+
28 !+ ( X**4 + 4 X**3 SH(X) - 9 SH(X)SH(2X) + 3 X (X+2SH(X))*(CH(X)**2-2CH(X)+3) )
29 !+ E1(KH) = -----------------------------------------------------------------------------
30 !+ 3 ( X+SH(X) )**4
31 !+
32 !+
33 !+
34 !+
35 !+ (TH(X)-X)* CH(X)
36 !+ E2(KH)/K0 = 2 H * ------------------------
37 !+ X ( SH(X) + X )**2
38 !+
39 !+ K0 IS THE WAVE NUMBER FOR INFINITE DEPTH : K0 = K TH(KH)
40 !+ H IS THE WATER DEPTH
41 !+ ------
42 !+
43 !+ USING SUBROUTINE BERKHO NOTATIONS,
44 !+ AFTER VARIATIONAL FORMULATION :
45 !+ /
46 !+ AM1 = / C*CG * GRAD(PSII)*GRAD(PSIJ) DS
47 !+ /S
48 !+
49 !+ /
50 !+ - / OMEGA**2 * CG/C * (1+F) * PSII*PSIJ DS
51 !+ /S
52 !+
53 !+ /
54 !+ - / BPHIRB * PSII*PSIJ DB
55 !+ /B
56 !+
57 !+
58 !+ THE SECOND MEMEBER (DIFFUSION) IS MODIFIED
59 !
60 !history C.PEYRARD & E.RAZAFINDRAKOTO
61 !+ 31/05/11
62 !+ V6P1
63 !+
64 !
65 !history N.DURAND (HRW)
66 !+ August 2017
67 !+ V7P3
68 !+ Removed unnecessary references to PI, DEGRAD and RADDEG
69 !
70 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
71 !| II |-->| OPTION FOR GRADIENT AND CURVATURE EFFECTS
72 !| T2 |---| WORK TABLE
73 !| T4 |---| WORK TABLE
74 !| T5 |---| WORK TABLE
75 !| T6 |---| WORK TABLE
76 !| T7 |---| WORK TABLE
77 !| T9 |---| WORK TABLE
78 !| T8 |---| WORK TABLE
79 !| T11 |---| WORK TABLE
80 !| T12 |---| WORK TABLE
81 !| T3 |<--| OUTPUT WORK TABLE WITH CORRECTION TERMS FOR
82 !| | | GRADIENT AND CURVATURE EFFECTS
83 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
84 !
85 ! APPELE PAR : BERKHO
86 ! SOUS-PROGRAMMES APPELES : FCTE1 et FCTE2
87 ! TABLEAUX DE TRAVAIL UTILISES : T2 T3 T4 T5 T6 T7 T9 T8 T11 T12
88 !
89 !-----------------------------------------------------------------------
90 !
91  USE bief
92  USE interface_artemis,ONLY: fcte1,fcte2
95 !
96  IMPLICIT NONE
97 !
98 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
99 !
100  INTEGER, INTENT(IN) :: II
101 !
102 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
103 !
104  INTEGER I
105 !
106 !-----------------------------------------------------------------------
107 !
108 !
109 ! MASS MATRIX
110 !
111  CALL vector(t2 , '=' , 'MASBAS ' , ielm ,
112  & 1.d0 , c , c , c , c , c , c ,
113  & mesh , msk , maskel )
114 !
115  IF(ii.EQ.1.OR.ii.EQ.3) THEN
116 ! --------------
117 ! GRADIENT EFFECTS
118 ! --------------
119 !
120 !---> E1*GRAD(H)**2 ---> IN T4
121 !
122 ! DX
123 !
124  CALL vector(t7 , '=' , 'GRADF X' , ielm ,
125  & 1.d0 , h , t1 , t1 , t1 , t1 , t1 ,
126  & mesh , msk , maskel)
127  CALL os('X=YZ ', x=t4, y=t7, z=t7)
128 !
129 ! DY
130 !
131  CALL vector(t7 , '=' , 'GRADF Y' , ielm ,
132  & 1.d0 , h , t1 , t1 , t1 , t1 , t1 ,
133  & mesh , msk , maskel)
134  CALL os('X=YZ ' , x=t5,y=t7,z=t7)
135 !
136 ! GRAD(H)**2
137 !
138  CALL os( 'X=X+Y ', x=t4,y=t5)
139 !
140 ! SQUARE MASS
141 !
142  CALL os( 'X=YZ ' , x=t8,y=t2,z=t2)
143 !
144 ! COEFF GRAD(H)**2
145 !
146  CALL os( 'X=Y/Z ' , x=t4,y=t4,z=t8)
147 !
148 !---> FUNCTION E1
149 !
150  DO i=1,npoin
151  t11%R(i)=fcte1( k%R(i)*h%R(i) )
152  END DO
153 !
154 !---> E1*GRAD(H)**2 ---> IN T4
155 !
156  CALL os( 'X=YZ ' , x=t4,y=t4,z=t11)
157 ! END OF GRADIENT EFFECTS
158  ENDIF
159 !
160  IF(ii.EQ.2.OR.ii.EQ.3) THEN
161 ! ------------------
162 ! CURVATURE EFFECTS
163 ! ------------------
164 !---> E2/K0*LAPLACIAN(H) ---> IN T9
165 ! DX
166  CALL vector(t7 , '=' , 'GRADF X' , ielm ,
167  & 1.d0 , h , t1 , t1 , t1 , t1 , t1 ,
168  & mesh , msk , maskel)
169  CALL os( 'X=Y/Z ' , x=t7,y=t7,z=t2)
170 
171  CALL vector(t5 , '=' , 'GRADF X' , ielm ,
172  & 1.d0 , t7 , t1 , t1 , t1 , t1 , t1 ,
173  & mesh , msk , maskel)
174 !
175 ! COEFF DX
176 !
177  CALL os('X=Y/Z ' , x=t5,y=t5,z=t2)
178 !
179 ! DY
180 !
181  CALL vector(t7 , '=' , 'GRADF Y' , ielm ,
182  & 1.d0 , h , t1 , t1 , t1 , t1 , t1 ,
183  & mesh , msk , maskel)
184  CALL os('X=Y/Z ' , x=t7,y=t7,z=t2)
185 !
186  CALL vector(t6 , '=' , 'GRADF Y' , ielm ,
187  & 1.d0 , t7 , t1 , t1 , t1 , t1 , t1 ,
188  & mesh , msk , maskel)
189 !
190 ! COEFF DY
191 !
192  CALL os('X=Y/Z ', x=t6,y=t6,z=t2)
193 !
194  CALL os('X=Y+Z ', x=t9,y=t5,z=t6)
195 !
196 !---> FUNCTION E2 * 2 H
197 !
198  DO i=1,npoin
199  t12%R(i)=2.*h%R(i) * fcte2(k%R(i)*h%R(i))
200  END DO
201 !
202 !---> E2/K0*LAPLACIAN(H)
203 !
204  CALL os( 'X=YZ ' , x=t9,y=t9,z=t12)
205 !
206 ! END OF CURVATURE EFFECTS
207  ENDIF
208 !
209 ! SUM OF GRADIENT AND CURVTURE EFFECTS, DEPENDING OF OPTION "IPENTCO"
210 !
211  IF(ii.EQ.1) THEN
212 ! F= E1*GRAD(H)**2
213  CALL os( 'X=Y ' , x=t3,y=t4)
214  ENDIF
215 !
216  IF(ii.EQ.2) THEN
217 ! F= E2/K0*LAPLACIAN(H)
218  CALL os( 'X=Y ' , x=t3,y=t9)
219  ENDIF
220 !
221  IF(ii.EQ.3) THEN
222 ! F = E1*grad(H)**2 + E2/K0*LAPLACIEN(H)
223  CALL os( 'X=Y+Z ' , x=t3,y=t4,z=t9)
224  ENDIF
225 !
226 ! ADD 1., T3 = 1 + F
227 !
228  CALL os( 'X=X+C ', x=t3,c=1.d0)
229 !
230 !-----------------------------------------------------------------------
231 !
232  RETURN
233  END
234 
type(bief_obj), target h
type(bief_obj), pointer t6
type(bief_obj), pointer t11
double precision function fcte2(XX)
Definition: fcte2.f:7
type(bief_obj), target maskel
double precision, dimension(:), pointer y
type(bief_obj), pointer t5
type(bief_obj), pointer t7
type(bief_obj), pointer t9
type(bief_obj), pointer t2
type(bief_obj), target k
type(bief_mesh), target mesh
type(bief_obj), pointer t8
type(bief_obj), pointer t4
double precision, dimension(:), pointer x
subroutine vector(VEC, OP, FORMUL, IELM1, XMUL, F, G, H, U, V, W, MESH, MSK, MASKEL, LEGO, ASSPAR)
Definition: vector.f:7
type(bief_obj), pointer t12
type(bief_obj), pointer t3
subroutine os(OP, X, Y, Z, C, IOPT, INFINI, ZERO)
Definition: os.f:7
type(bief_obj), pointer t1
type(bief_obj), target c
subroutine pentco(II)
Definition: pentco.f:6
double precision function fcte1(XX)
Definition: fcte1.f:7
Definition: bief.f:3