The TELEMAC-MASCARET system  trunk
qbrek3.f
Go to the documentation of this file.
1 ! *****************
2  SUBROUTINE qbrek3
3 ! *****************
4 !
5  &( tstot , f , fcar , varian, nf , ndire, npoin2)
6 !
7 !***********************************************************************
8 ! TOMAWAC V6P1 23/06/2011
9 !***********************************************************************
10 !
11 !brief COMPUTES THE CONTRIBUTION OF THE DEPTH-INDUCED
12 !+ BREAKING SOURCE TERM BASED ON ROELVINK (1993).
13 !
14 !note THIS SOURCE TERM IS LINEAR IN F(FREQ,TETA), AND THE LINEAR
15 !+ COEFFICIENT DOES NOT VARY WITH TIME.
16 !
17 !reference ROELVINK (1993) :
18 !+ "DISSIPATION IN RANDOM WAVE GROUPS INCIDENT ON A
19 !+ BEACH". COASTAL ENG. VOL 19, PP 127-150.
20 !
21 !history F. BECQ; M. BENOIT (EDF/DER/LNH)
22 !+ 26/03/96
23 !+ V1P1
24 !+
25 !
26 !history N.DURAND (HRW), S.E.BOURBAN (HRW)
27 !+ 13/07/2010
28 !+ V6P0
29 !+ Translation of French comments within the FORTRAN sources into
30 !+ English comments
31 !
32 !history N.DURAND (HRW), S.E.BOURBAN (HRW)
33 !+ 21/08/2010
34 !+ V6P0
35 !+ Creation of DOXYGEN tags for automated documentation and
36 !+ cross-referencing of the FORTRAN sources
37 !
38 !history G.MATTAROLO (EDF - LNHE)
39 !+ 23/06/2011
40 !+ V6P1
41 !+ Translation of French names of the variables in argument
42 !
43 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
44 !| DEPTH |-->| WATER DEPTH
45 !| F |-->| DIRECTIONAL SPECTRUM
46 !| FCAR |-->| CHARACTERISTIC FREQUENCY
47 !| NF |-->| NUMBER OF FREQUENCIES
48 !| NDIRE |-->| NUMBER OF DIRECTIONS
49 !| NPOIN2 |-->| NUMBER OF POINTS IN 2D MESH
50 !| TSTOT |<->| TOTAL PART OF THE SOURCE TERM CONTRIBUTION
51 !| VARIAN |-->| SPECTRUM VARIANCE
52 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
53 !
55  & gam2ro, iexpro, idisro, depth, betabr
56  USE interface_tomawac, ex_qbrek3 => qbrek3
57  IMPLICIT NONE
58 !
59 !.....VARIABLES IN ARGUMENT
60 ! """"""""""""""""""""
61  INTEGER, INTENT(IN) :: NF , NDIRE , NPOIN2
62  DOUBLE PRECISION, INTENT(IN) :: F(npoin2,ndire,nf)
63  DOUBLE PRECISION, INTENT(IN) :: VARIAN(npoin2), FCAR(npoin2)
64  DOUBLE PRECISION, INTENT(INOUT):: TSTOT(npoin2,ndire,nf)
65 !
66 !.....LOCAL VARIABLES
67 ! """""""""""""""""
68  INTEGER JP , IFF , IP
69  DOUBLE PRECISION COEF1 , COEF2 , SEUIL
70  DOUBLE PRECISION A , XM , SIGMA , BX , FN
71 !
72 !.....EXTERNAL FUNCTIONS
73 ! """"""""""""""""""
74 ! DOUBLE PRECISION GAMMLN, QGAUSS
75 ! EXTERNAL GAMMLN, QGAUSS
76 !
77 !
78  seuil = 1.d-6
79  coef1 = -2.d0*alfaro
80  coef2 = 8.d0/(gamaro**2)
81 !
82  IF(idisro.EQ.1) THEN
83 !
84 !.......COMPUTES THE LINEAR COEFFICIENT BETABR (WEIBULL FIT)
85 ! """""""""""""""""""""""""""""""""""""""""""""""""""""
86  DO ip = 1,npoin2
87  IF (varian(ip).GT.seuil) THEN
88  bx = coef2*varian(ip)/(depth(ip)*depth(ip))
89  sigma = sqrt(8.d0*varian(ip))/depth(ip)
90  xm = 1.d0 + 0.7d0*(tan(pisur2*sigma/gam2ro))**2
91  a = exp(xm*(gammln(1.d0+1.d0/xm,deupi)))
92  IF(xm.GT.98.d0) THEN
93  fn = 1.d0
94  ELSE
95  fn = qgauss(bx,iexpro,a,xm)
96  ENDIF
97  betabr(ip) = coef1*fcar(ip)*fn
98  ELSE
99  betabr(ip) = 0.d0
100  ENDIF
101  DO iff = 1,nf
102  DO jp = 1,ndire
103  tstot(ip,jp,iff) = tstot(ip,jp,iff)
104  & +betabr(ip)*f(ip,jp,iff)
105  ENDDO ! JP
106  ENDDO ! IFF
107  ENDDO ! IP
108 !
109  ELSE
110 !
111 !.......COMPUTES THE LINEAR COEFFICIENT BETA (RAYLEIGH FIT)
112 ! """"""""""""""""""""""""""""""""""""""""""""""""""""""
113  DO ip = 1,npoin2
114  bx = coef2*varian(ip)/(depth(ip)**2)
115  xm = 1.d0
116  a = 1.d0
117  fn = qgauss(bx,iexpro,a,xm)
118  betabr(ip) = coef1*fcar(ip)*fn
119  DO iff = 1,nf
120  DO jp = 1,ndire
121  tstot(ip,jp,iff) = tstot(ip,jp,iff)
122  & +betabr(ip)*f(ip,jp,iff)
123  ENDDO ! JP
124  ENDDO ! IFF
125  ENDDO ! IP
126  ENDIF
127 !
128  RETURN
129  END
subroutine qbrek3(TSTOT, F, FCAR, VARIAN, NF, NDIRE, NPOIN2)
Definition: qbrek3.f:7
double precision function gammln(XX, DEUPI)
Definition: gammln.f:7
double precision function qgauss(B, N, A, XM)
Definition: qgauss.f:7