The TELEMAC-MASCARET system  trunk
conwac.f
Go to the documentation of this file.
1 ! *****************
2  SUBROUTINE conwac
3 ! *****************
4 !
5  &( cx, cy, ct, xk, cg, npoin2, ndire , jf , nf )
6 !
7 !***********************************************************************
8 ! TOMAWAC V6P3 14/068/2011
9 !***********************************************************************
10 !
11 !brief COMPUTES THE ADVECTION FIELD (3D WITHOUT CURRENT).
12 !
13 !warning TETA IS THE DIRECTION WRT NORTH, CLOCKWISE
14 !
15 !history M. BENOIT (EDF LNHE)
16 !+ 19/01/2004
17 !+ V5P4
18 !+
19 !
20 !history N.DURAND (HRW), S.E.BOURBAN (HRW)
21 !+ 13/07/2010
22 !+ V6P0
23 !+ Translation of French comments within the FORTRAN sources into
24 !+ English comments.
25 !
26 !history N.DURAND (HRW), S.E.BOURBAN (HRW)
27 !+ 21/08/2010
28 !+ V6P0
29 !+ Creation of DOXYGEN tags for automated documentation and
30 !+ cross-referencing of the FORTRAN sources.
31 !
32 !history G.MATTAROLO (EDF - LNHE)
33 !+ 14/06/2011
34 !+ V6P1
35 !+ Translation of French names of the variables in argument.
36 !
37 !history J-M HERVOUET (EDF-LNHE)
38 !+ 27/11/2012
39 !+ V6P3
40 !+ Optimisation (loops on NPOIN2 and NDIRE swapped to get smaller
41 !+ strides, work array TRA01 differently used, etc.).
42 !
43 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
44 !| CG |-->| DISCRETIZED GROUP VELOCITY
45 !| COSF |-->| COSINE OF THE LATITUDES OF THE POINTS 2D
46 !| CY |<--| ADVECTION FIELD ALONG X(OR PHI)
47 !| CX |<--| ADVECTION FIELD ALONG Y(OR LAMBDA)
48 !| CT |<--| ADVECTION FIELD ALONG TETA
49 !| DZY |-->| SEA BOTTOM SLOPE ALONG X
50 !| DZX |-->| SEA BOTTOM SLOPE ALONG Y
51 !| JF |-->| INDEX OF THE FREQUENCX
52 !| NF |-->| NUMBER OF FREQUENCIES
53 !| NDIRE |-->| NUMBER OF DIRECTIONS
54 !| NPOIN2 |-->| NUMBER OF POINTS IN 2D MESH
55 !| PROINF |-->| LOGICAL INDICATING INFINITE DEPTH ASSUMPTION
56 !| PROMIN |-->| MINIMUM VALUE OF WATER DEPTH
57 !| SPHE |-->| LOGICAL INDICATING SPHERICAL COORD ASSUMPTION
58 !| TGF |-->| TANGENT OF THE LATITUDES OF THE POINTS 2D
59 !| TRA01 |<->| WORK TABLE
60 !| XK |-->| DISCRETIZED WAVE NUMBER
61 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
62 !
64  & sphe, promin, depth, costet, sintet, freq,
65  & cosf , tgf , dzx , dzy, tra01
66 !
68  USE interface_tomawac, ex_conwac => conwac
69  IMPLICIT NONE
70 !
71 !
72 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
73 !
74  INTEGER, INTENT(IN) :: NF,NDIRE,NPOIN2,JF
75  DOUBLE PRECISION, INTENT(IN) :: CG(npoin2,nf),XK(npoin2,nf)
76  DOUBLE PRECISION, INTENT(INOUT) :: CY(npoin2,ndire)
77  DOUBLE PRECISION, INTENT(INOUT) :: CX(npoin2,ndire)
78  DOUBLE PRECISION, INTENT(INOUT) :: CT(npoin2,ndire)
79 !
80 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
81 !
82  INTEGER JP,IP
83  DOUBLE PRECISION GSQP,SRCF,TFSR,DDDN,DEUKD,TR1,TR2
84 !
85  gsqp=gravit/(2.d0*deupi)
86 !
87  IF(proinf) THEN
88 !
89 !-----------------------------------------------------------------------
90 ! INFINITE WATER DEPTH ...
91 !-----------------------------------------------------------------------
92 !
93  IF(.NOT.sphe) THEN
94 !
95 ! ----------------------------------------------------------------
96 ! ... AND IN CARTESIAN COORDINATE SYSTEM
97 ! ----------------------------------------------------------------
98 !
99  DO jp=1,ndire
100  tr1=gsqp/freq(jf)*costet(jp)
101  tr2=gsqp/freq(jf)*sintet(jp)
102  DO ip=1,npoin2
103  cy(ip,jp)=tr1
104  cx(ip,jp)=tr2
105  ct(ip,jp)=0.d0
106  ENDDO
107  ENDDO
108 !
109  ELSE
110 !
111 ! ----------------------------------------------------------------
112 ! ... AND IN SPHERICAL COORDINATE SYSTEM
113 ! ----------------------------------------------------------------
114 !
115  DO jp=1,ndire
116  tr1=gsqp/freq(jf)*costet(jp)
117  tr2=gsqp/freq(jf)*sintet(jp)
118  DO ip=1,npoin2
119  srcf=sr/cosf(ip)
120  tfsr=tgf(ip)*sr
121  cy(ip,jp)=tr1*sr*gradeg
122  cx(ip,jp)=tr2*srcf*gradeg
123  ct(ip,jp)=tr2*tfsr
124  ENDDO
125  ENDDO
126 !
127  ENDIF
128 !
129  ELSE
130 !
131 !-----------------------------------------------------------------------
132 ! FINITE WATER DEPTH ....
133 !-----------------------------------------------------------------------
134 !
135  DO ip=1,npoin2
136  deukd=2.d0*xk(ip,jf)*depth(ip)
137  IF(deukd.GT.7.d2) THEN
138  tra01(ip)=0.d0
139  ELSE
140  tra01(ip)=deupi*freq(jf)/sinh(deukd)
141  ENDIF
142  ENDDO
143 !
144  IF(.NOT.sphe) THEN
145 !
146 ! ----------------------------------------------------------------
147 ! ... AND IN CARTESIAN COORDINATE SYSTEM
148 ! ----------------------------------------------------------------
149 !
150  DO jp=1,ndire
151  DO ip=1,npoin2
152  IF(depth(ip).GT.promin) THEN
153  dddn=-sintet(jp)*dzy(ip)+costet(jp)*dzx(ip)
154  cy(ip,jp)=cg(ip,jf)*costet(jp)
155  cx(ip,jp)=cg(ip,jf)*sintet(jp)
156  ct(ip,jp)=-tra01(ip)*dddn
157  ELSE
158  cy(ip,jp)=0.d0
159  cx(ip,jp)=0.d0
160  ct(ip,jp)=0.d0
161  ENDIF
162  ENDDO
163  ENDDO
164 !
165  ELSE
166 !
167 ! ----------------------------------------------------------------
168 ! ... AND IN SPHERICAL COORDINATE SYSTEM
169 ! ----------------------------------------------------------------
170 !
171  DO jp=1,ndire
172  DO ip=1,npoin2
173  IF(depth(ip).GT.promin) THEN
174  srcf=sr/cosf(ip)
175  tfsr=sr*tgf(ip)
176  dddn=-sintet(jp)*dzy(ip)*sr+costet(jp)*dzx(ip)*srcf
177  cy(ip,jp)=(cg(ip,jf)*costet(jp))*sr*gradeg
178  cx(ip,jp)=(cg(ip,jf)*sintet(jp))*srcf*gradeg
179  ct(ip,jp)=cg(ip,jf)*sintet(jp)*tfsr
180  & -tra01(ip)*dddn*gradeg
181  ELSE
182  cy(ip,jp)=0.0d0
183  cx(ip,jp)=0.0d0
184  ct(ip,jp)=0.0d0
185  ENDIF
186  ENDDO
187  ENDDO
188 !
189  ENDIF
190 !
191  ENDIF
192 !
193 !-----------------------------------------------------------------------
194 !
195  RETURN
196  END
subroutine conwac(CX, CY, CT, XK, CG, NPOIN2, NDIRE, JF, NF)
Definition: conwac.f:7