The TELEMAC-MASCARET system  trunk
radia2.f
Go to the documentation of this file.
1 ! *****************
2  SUBROUTINE radia2
3 ! *****************
4 !
5  &(lishho)
6 !
7 !***********************************************************************
8 ! ARTEMIS V6P1 21/08/2010
9 !***********************************************************************
10 !
11 !brief COMPUTES THE RADIATION STRESSES AND DRIVING FORCES.
12 !
13 !reference M.W. DINGEMANS, A.C. RADDER AND H.J. DE VRIEND
14 !+ COMPUTATION OF THE DRIVING FORCES OF WACE-INDUCED
15 !+ CURRENTS. COASTAL ENGINEERING, 11 (1987) PP 539-563.
16 !
17 !history J-M HERVOUET (LNH)
18 !+
19 !+
20 !+ LINKED TO BIEF 5.0
21 !
22 !history D. AELBRECHT (LNH) ; F. BECQ (LNH)
23 !+ 04/06/1999
24 !+ V5P1
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 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
40 !| LISHHO |<--| SMOOTHING FOR THE WAVE HEIGTH
41 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
42 !
43  USE bief
46  USE interface_artemis, ex_radia2=> radia2
47 !
49  IMPLICIT NONE
50 !
51 !
52  INTEGER I
53  INTEGER LISHHO
54 !
55 ! INTERNAL VARIABLES FOR RADIA2
56 !
57  DOUBLE PRECISION COE , COCO, COSI, SISI
58  INTEGER LISRAD
59 !
60  LOGICAL MAS
61 !
62  INTRINSIC cos, sin
63 !
64 !
65 !=======================================================================
66 ! RADIATION STRESSES........METHOD 2 (IDENTICAL TO THAT USED IN TOMAWAC)
67 !=======================================================================
68 !
69  CALL os('X=Y ',x=t3,y=hho)
70 !
71 ! -------------------------------------------------------------
72 ! SMOOTHES THE WAVE HEIGHT TO ELIMINATE PARASITIC
73 ! OSCILLATIONS
74 ! -------------------------------------------------------------
75 !
76  IF(lishho.GT.0) THEN
77  mas = .true.
78  CALL filter(t3,mas,t1,t2,am1,'MATMAS ',
79  & 1.d0,sbid,sbid,sbid,sbid,sbid,sbid,
80  & mesh,msk,maskel,lishho)
81  ENDIF
82 !
83  CALL os('X=Y ',x=hho,y=t3)
84 !
85 ! -------------------------------------------------------------
86 ! COMPUTES STRESSES SXX, SXY AND SYY
87 ! -------------------------------------------------------------
88 !
89  CALL os('X=Y/Z ', x=t1 , y=cg , z=c)
90  DO i=1,npoin
91  coco=cos(inci%R(i))*cos(inci%R(i))
92  cosi=cos(inci%R(i))*sin(inci%R(i))
93  sisi=sin(inci%R(i))*sin(inci%R(i))
94  coe=grav*hale%R(i)*hale%R(i)/16.d0
95 !
96 ! THE COEFFICIENT 1/16 ABOVE STEMS FROM HHO REPRESENTING THE
97 ! SIGNIFICANT WAVE HEIGHT (ENERGY) IN RANDOM SEAS
98 !
99  sxx%R(i)= (t1%R(i)*(1.d0+coco)-0.5d0)*coe
100  sxy%R(i)= (t1%R(i)*cosi)*coe
101  syy%R(i)= (t1%R(i)*(1.d0+sisi)-0.5d0)*coe
102  END DO
103 !
104 !
105 !=======================================================================
106 ! SPACIAL GRADIENTS OF RADIATION STRESSES
107 !=======================================================================
108 !
109 ! -----------------------------------------------
110 ! OPTIONAL SMOOTHING(S) OF THE RADIATION STRESSES
111 ! -----------------------------------------------
112 !
113  lisrad = 3
114 !
115  CALL os('X=Y ',x=t3,y=sxx)
116  IF(lisrad.GT.0) THEN
117  mas = .true.
118  CALL filter(t3,mas,t1,t2,am1,'MATMAS ',
119  & 1.d0,sbid,sbid,sbid,sbid,sbid,sbid,
120  & mesh,msk,maskel,lisrad)
121  ENDIF
122  CALL os('X=Y ',x=sxx,y=t3)
123 !
124  CALL os('X=Y ',x=t3,y=sxy)
125  IF(lisrad.GT.0) THEN
126  mas = .true.
127  CALL filter(t3,mas,t1,t2,am1,'MATMAS ',
128  & 1.d0,sbid,sbid,sbid,sbid,sbid,sbid,
129  & mesh,msk,maskel,lisrad)
130  ENDIF
131  CALL os('X=Y ',x=sxy,y=t3)
132 !
133  CALL os('X=Y ',x=t3,y=syy)
134  IF(lisrad.GT.0) THEN
135  mas = .true.
136  CALL filter(t3,mas,t1,t2,am1,'MATMAS ',
137  & 1.d0,sbid,sbid,sbid,sbid,sbid,sbid,
138  & mesh,msk,maskel,lisrad)
139  ENDIF
140  CALL os('X=Y ',x=syy,y=t3)
141 !
142 ! END OF RADIATION STRESS SMOOTHING(S)
143 ! -------------------------------------------------------
144 !
145 !=======================================================================
146 ! DRIVING FORCES FX AND FY FOR WAVE-INDUCED CURRENTS
147 !=======================================================================
148 !
149  CALL vector(t1 , '=' , 'MASBAS ' , ielm ,
150  & 1.d0 , t3 , t3 , t3 , t3 , t3 , t3 ,
151  & mesh , msk , maskel )
152 !
153  CALL vector
154  & (t2,'=','GRADF X',ielm,1.d0,sxx,t4,t4,t4,t4,t4,
155  & mesh , msk , maskel )
156  CALL os('X=Y/Z ',x=t2,y=t2,z=t1)
157 !
158  CALL vector
159  & (t3,'=','GRADF Y',ielm,1.d0,sxy,t4,t4,t4,t4,t4,
160  & mesh , msk , maskel )
161  CALL os('X=Y/Z ',x=t3,y=t3,z=t1)
162 ! ------------------------------------
163 ! FORCE FX = - (DSXX/DX + DSXY/DY) / H
164 ! ------------------------------------
165  CALL os('X=Y+Z ',x=fx,y=t2,z=t3)
166  CALL os('X=CY/Z ',x=fx,y=fx,z=h,c=-1.d0)
167 !
168 ! ------------------------------------
169 !
170  CALL vector(t1 , '=' , 'MASBAS ' , ielm ,
171  & 1.d0 , t3 , t3 , t3 , t3 , t3 , t3 ,
172  & mesh , msk , maskel )
173 !
174  CALL vector
175  & (t2,'=','GRADF X',ielm,1.d0,sxy,t4,t4,t4,t4,t4,
176  & mesh , msk , maskel )
177  CALL os('X=Y/Z ',x=t2,y=t2,z=t1)
178 !
179  CALL vector
180  & (t3,'=','GRADF Y',ielm,1.d0,syy,t4,t4,t4,t4,t4,
181  & mesh , msk , maskel )
182  CALL os('X=Y/Z ',x=t3,y=t3,z=t1)
183 !
184 ! ------------------------------------
185 ! FORCE FY = - (DSXY/DX + DSYY/DY) / H
186 ! ------------------------------------
187  CALL os('X=Y+Z ',x=fy,y=t2,z=t3)
188  CALL os('X=CY/Z ',x=fy,y=fy,z=h,c=-1.d0)
189 !
190 !=======================================================================
191 !
192  RETURN
193  END
type(bief_obj), target hale
type(bief_obj), target am1
type(bief_obj), target h
subroutine filter(VEC, BLDMAT, T1, T2, A, FORMUL, XMUL, F, G, H, U, V, W, MESH, MSK, MASKEL, N)
Definition: filter.f:10
type(bief_obj), target maskel
double precision, dimension(:), pointer y
type(bief_obj), target hho
type(bief_obj), pointer t2
type(bief_mesh), target mesh
type(bief_obj), target fy
type(bief_obj), target inci
type(bief_obj), pointer t4
double precision, dimension(:), pointer x
type(bief_obj), target sbid
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), target cg
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
type(bief_obj), target sxx
type(bief_obj), target sxy
subroutine radia2(LISHHO)
Definition: radia2.f:7
type(bief_obj), target syy
type(bief_obj), target fx
Definition: bief.f:3