The TELEMAC-MASCARET system  trunk
qmout1.f
Go to the documentation of this file.
1 ! *****************
2  SUBROUTINE qmout1
3 ! *****************
4 !
5  &( tstot , tsder , f , xk , enrj , fmoy , xkmoy ,
6  & nf , ndire , npoin2, taux1 )
7 !
8 !***********************************************************************
9 ! TOMAWAC V6P3 23/06/2011
10 !***********************************************************************
11 !
12 !brief COMPUTES THE CONTRIBUTION OF THE WHITECAPPING
13 !+ SOURCE TERM BASED ON KOMEN ET AL. (1984).
14 !
15 !note CMOUT1 (USED IN WAM-CYCLE 4) EQUALS 4.5.
16 !note CMOUT2 (USED IN WAM-CYCLE 4) EQUALS 0.5.
17 !
18 !reference KOMEN G.J., HASSELMANN S., HASSELMANN K. (1984) :
19 !+ "ON THE EXISTENCE OF A FULLY DEVELOPED WINDSEA
20 !+ SPECTRUM". JPO, VOL 14, PP 1271-1285.
21 !
22 !history P. THELLIER; M. BENOIT (EDF/DER/LNH)
23 !+ 06/04/95
24 !+ V1P0
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 !history G.MATTAROLO (EDF - LNHE)
40 !+ 23/06/2011
41 !+ V6P1
42 !+ Translation of French names of the variables in argument
43 !
44 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
45 !| ENRJ |-->| SPECTRUM VARIANCE
46 !| F |-->| DIRECTIONAL SPECTRUM
47 !| FMOY |-->| MEAN SPECTRAL FRQUENCY FMOY
48 !| NF |-->| NUMBER OF FREQUENCIES
49 !| NDIRE |-->| NUMBER OF DIRECTIONS
50 !| NPOIN2 |-->| NUMBER OF POINTS IN 2D MESH
51 !| PROINF |-->| LOGICAL INDICATING INFINITE DEPTH ASSUMPTION
52 !| TAUX1 |<--| WORK TABLE
53 !| TSDER |<->| DERIVED PART OF THE SOURCE TERM CONTRIBUTION
54 !| TSTOT |<->| TOTAL PART OF THE SOURCE TERM CONTRIBUTION
55 !| XK |-->| DISCRETIZED WAVE NUMBER
56 !| XKMOY |-->| AVERAGE WAVE NUMBER
57 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
58 !
60  & proinf, freq
61 
62 ! Variables in TOMAWAC MODULE
63 ! CMOUT1 WHITE CAPPING DISSIPATION COEFFICIENT
64 ! CMOUT2 WHITE CAPPING WEIGHTING COEFFICIENT
65 !
66  USE interface_tomawac, ex_qmout1 => qmout1
67  IMPLICIT NONE
68 !
69 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
70 !
71  INTEGER, INTENT(IN) :: NF,NDIRE,NPOIN2
72  DOUBLE PRECISION, INTENT(IN) :: XKMOY(npoin2),ENRJ(npoin2)
73  DOUBLE PRECISION, INTENT(INOUT) :: TAUX1(npoin2),FMOY(npoin2)
74  DOUBLE PRECISION, INTENT(INOUT) :: TSTOT(npoin2,ndire,nf)
75  DOUBLE PRECISION, INTENT(INOUT) :: TSDER(npoin2,ndire,nf)
76  DOUBLE PRECISION, INTENT(IN) :: F(npoin2,ndire,nf)
77  DOUBLE PRECISION, INTENT(IN) :: XK(npoin2,nf)
78 !
79 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
80 !
81  INTEGER JP , JF , IP
82  DOUBLE PRECISION AUX , C1 , C2, BETA
83 !
84  c1 = - cmout1*deupi**9/gravit**4
85  c2 = - cmout1*deupi
86 !
87  IF (proinf) THEN
88 !
89 ! INFINITE WATER DEPTH (USES F).
90 !
91 ! WORKING ARRAY (THIS TERM ONLY DEPENDS ON THE POINT IN SPACE)
92 !
93  DO ip=1,npoin2
94  taux1(ip) = c1 * enrj(ip)**2 * fmoy(ip)**9
95  ENDDO
96 !
97 ! LOOP OVER DISCRETISED FREQUENCIES
98 !
99  DO jf=1,nf
100 !
101 ! COMPUTES THE BETA COEFFICIENT : QMOUT1 = BETA * F
102 !
103  DO ip=1,npoin2
104  aux = (freq(jf)/fmoy(ip))**2
105  beta=taux1(ip)*aux*(1.d0-cmout2+cmout2*aux)
106  DO jp=1,ndire
107  tstot(ip,jp,jf) = tstot(ip,jp,jf)+beta*f(ip,jp,jf)
108  tsder(ip,jp,jf) = tsder(ip,jp,jf)+beta
109  ENDDO
110  ENDDO
111 !
112 ! TAKES THE SOURCE TERM INTO ACCOUNT
113 !
114 !
115  ENDDO
116 !
117  ELSE
118 !
119 ! FINITE WATER DEPTH (USES K).
120 !
121 ! WORKING ARRAY (THIS TERM ONLY DEPENDS ON THE POINT IN SPACE)
122 !
123  DO ip=1,npoin2
124  taux1(ip) = c2 * enrj(ip)**2 * fmoy(ip) * xkmoy(ip)**4
125  ENDDO
126 !
127 ! LOOP OVER THE DISCRETISED FREQUENCIES
128 !
129  DO jf=1,nf
130 !
131 ! COMPUTES THE BETA COEFFICIENT : QMOUT1 = BETA * F
132 !
133  DO ip=1,npoin2
134  aux = xk(ip,jf) / xkmoy(ip)
135  beta=taux1(ip)*aux*(1.d0-cmout2+cmout2*aux)
136  DO jp=1,ndire
137  tstot(ip,jp,jf) = tstot(ip,jp,jf)+beta*f(ip,jp,jf)
138  tsder(ip,jp,jf) = tsder(ip,jp,jf)+beta
139  ENDDO
140  ENDDO
141  ENDDO
142 
143 !
144  ENDIF
145 !
146 !-----------------------------------------------------------------------
147 !
148  RETURN
149  END
subroutine qmout1(TSTOT, TSDER, F, XK, ENRJ, FMOY, XKMOY, NF, NDIRE, NPOIN2, TAUX1)
Definition: qmout1.f:8