The TELEMAC-MASCARET system  trunk
speini.f
Go to the documentation of this file.
1 ! *****************
2  SUBROUTINE speini
3 ! *****************
4 !
5  &( f , spec , fra , uv , vv , fremax, fetch , sigmaa,
6  & sigmab, gamma , fpic , hm0 , alphil, teta1 , spred1, teta2 ,
7  & spred2, xlamda, npoin2, ndire , nf , inispe, depth ,
8  & frabi )
9 !
10 !***********************************************************************
11 ! TOMAWAC V6P1 28/06/2011
12 !***********************************************************************
13 !
14 !brief INITIALISES THE VARIANCE SPECTRUM.
15 !+
16 !+ SEVERAL OPTIONS ARE POSSIBLE DEPENDING ON THE VALUE
17 !+ TAKEN BY INISPE :
18 !+
19 !+ 0. ZERO EVERYWHERE
20 !+
21 !+ 1. JONSWAP-TYPE SPECTRUM AS A FUNCTION OF THE WIND
22 !+ (ZERO IF WIND SPEED IS ZERO)
23 !+
24 !+ 2. JONSWAP-TYPE SPECTRUM AS A FUNCTION OF THE WIND
25 !+ (PARAMETRIC IF WIND SPEED IS ZERO)
26 !+
27 !+ 3. PARAMETRIC JONSWAP-TYPE SPECTRUM
28 !
29 !history M. BENOIT (EDF/DER/LNH)
30 !+ 13/07/95
31 !+ V1P0
32 !+
33 !
34 !history N.DURAND (HRW), S.E.BOURBAN (HRW)
35 !+ 13/07/2010
36 !+ V6P0
37 !+ Translation of French comments within the FORTRAN sources into
38 !+ English comments
39 !
40 !history N.DURAND (HRW), S.E.BOURBAN (HRW)
41 !+ 21/08/2010
42 !+ V6P0
43 !+ Creation of DOXYGEN tags for automated documentation and
44 !+ cross-referencing of the FORTRAN sources
45 !
46 !history G.MATTAROLO (EDF - LNHE)
47 !+ 28/06/2011
48 !+ V6P1
49 !+ Translation of French names of the variables in argument
50 !
51 !history T FOUQUET (LNHE)
52 !+ 28/10/2015
53 !+ V7P0
54 !+ Modification to initialise spectrum wind is small or null
55 !+ and speini =1,3,5
56 !
57 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
58 !| ALPHIL |-->| INITIAL PHILLIPS CONSTANT (ALPHA)
59 !| DEPTH |-->| WATER DEPTH
60 !| F |<--| VARIANCE DENSITY DIRECTIONAL SPETCRUM
61 !| FETCH |-->| INITIAL MEAN FETCH VALUE
62 !| FPIC |-->| INITIAL PEAK FREQUENCY
63 !| FRA |<--| DIRECTIONAL SPREADING FUNCTION VALUES
64 !| FRABI |-->| INITIAL ANGULAR DISTRIBUTION FUNCTION
65 !| FREMAX |-->| INITIAL MAXIMUM PEAK FREQUENCY
66 !| GAMMA |-->| INITIAL JONSWAP SPECTRUM PEAK FACTOR
67 !| HM0 |-->| INITIAL SIGNIFICANT WAVE HEIGHT
68 !| INISPE |-->| TYPE OF INITIAL DIRECTIONAL SPECTRUM
69 !| NF |-->| NUMBER OF FREQUENCIES
70 !| NDIRE |-->| NUMBER OF DIRECTIONS
71 !| NPOIN2 |-->| NUMBER OF POINTS IN 2D MESH
72 !| SIGMAA |-->| INITIAL VALUE OF SIGMA FOR JONSWAP SPECTRUM
73 !| | | (F<FP)
74 !| SIGMAB |-->| INITIAL VALUE OF SIGMA FOR JONSWAP SPECTRUM
75 !| | | (F>FP)
76 !| SPEC |<--| VARIANCE DENSITY FREQUENCY SPECTRUM
77 !| SPRED1 |-->| INITIAL DIRECTIONAL SPREAD 1
78 !| SPRED2 |-->| INITIAL DIRECTIONAL SPREAD 2
79 !| TETA1 |-->| MAIN DIRECTION 1
80 !| TETA2 |-->| MAIN DIRECTION 2
81 !| UV |-->| WIND VELOCITY ALONG X AT THE MESH POINTS
82 !| VV |-->| WIND VELOCITY ALONG Y AT THE MESH POINTS
83 !| XLAMDA |-->| WEIGHTING FACTOR FOR FRA
84 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
85 !
87  & smax
88  USE interface_tomawac, ex_speini => speini
89  USE bief, ONLY: ov
90 !
92  IMPLICIT NONE
93 !
94 !
95 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
96 !
97  INTEGER, INTENT(IN) :: NPOIN2, NDIRE , NF , INISPE, FRABI
98  DOUBLE PRECISION, INTENT(IN) :: FREMAX, FETCH , SIGMAA
99  DOUBLE PRECISION, INTENT(IN) :: SIGMAB, GAMMA
100  DOUBLE PRECISION, INTENT(IN) :: FPIC , HM0 , ALPHIL, TETA1
101  DOUBLE PRECISION, INTENT(IN) :: SPRED1, TETA2
102  DOUBLE PRECISION, INTENT(IN) :: SPRED2, XLAMDA
103  DOUBLE PRECISION, INTENT(IN) :: UV(*) , VV(*)
104  DOUBLE PRECISION, INTENT(IN) :: DEPTH(npoin2)
105  DOUBLE PRECISION, INTENT(INOUT) :: F(npoin2,ndire,nf)
106  DOUBLE PRECISION, INTENT(INOUT) :: FRA(ndire), SPEC(nf)
107 !
108 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
109 !
110  INTEGER NPOIN4, IP , JF , JP
111  DOUBLE PRECISION GX , GXU , UG , AL , FP
112  DOUBLE PRECISION UVMIN , COEFA , COEFB , COEFD
113  DOUBLE PRECISION COEFE , UVENT , FPMIN , SPR1 , SPR2 , XLAM
114  DOUBLE PRECISION TET1 , TET2 , COEF
115 ! VARIABLE FOR GODA SPREADING DEPENDING ON FREQUENCY
116  DOUBLE PRECISION COEF1, DELT, ARGUM, DTETA
117 ! DOUBLE PRECISION SMAX
118 ! SMAX=35
119 !
120  npoin4= npoin2*ndire*nf
121  uvmin = 1.d-6
122  coefa = 2.84d0
123  coefb = 0.033d0
124  coefd =-3.d0/10.d0
125  coefe = 2.d0/3.d0
126  gx = gravit*fetch
127  fpmin = 1.d-4
128 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
129 !Smax recomendations (GODA): 10(Wind waves), 25 swell short decay, 75 long decay
130 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
131 !
132 ! ===========================================================
133 ! INITIAL SPECTRUM IS ZERO EVERYWHERE (INISPE=0)
134 ! (ALSO WORKS TO INITIALISE TO OTHER VALUES)
135 ! ===========================================================
136 !
137  IF(inispe.EQ.0) THEN
138 !
139  CALL ov('X=C ', x=f, c=0.d0, dim1=npoin4)
140 !
141 ! ==/ INISPE = 1 /===========================================
142 ! IF NON ZERO WIND -E(F): JONSWAP FUNCTION OF THE WIND (AL,FP)
143 ! -FRA : UNIMODAL ABOUT TETA(WIND)
144 ! IF ZERO WIND -E(F): ZERO
145 ! -FRA : ZERO
146 ! ===========================================================
147 !
148  ELSEIF(inispe.EQ.1) THEN
149 !
150  uvent =0
151  DO ip=1,npoin2
152  IF(vent) uvent=sqrt(uv(ip)**2+vv(ip)**2)
153  IF (uvent.GT.uvmin) THEN
154 !
155 ! COMPUTES THE FREQUENCY SPECTRUM (JONSWAP)
156 !
157  gxu=gx/(uvent*uvent)
158  ug = uvent/gravit
159  fp = max(0.13d0,coefa*gxu**coefd)
160  fp = min(fp,fremax*ug)
161  al = max(0.0081d0, coefb*fp**coefe)
162  fp = fp/ug
163  CALL spejon
164  &( spec , nf , al , fp , gamma , sigmaa, sigmab,
165  & fpmin )
166 !
167 ! COMPUTES THE DIRECTIONAL SPREADING FUNCTION
168 !
169  spr1=spred1
170  tet1=atan2(uv(ip),vv(ip))
171  spr2=1.d0
172  tet2=0.d0
173  xlam=1.d0
174  IF(frabi.EQ.2) THEN
175  CALL fsprd2(fra,ndire,spr1,tet1,spr2,tet2,xlam)
176  ELSEIF(frabi.EQ.3) THEN
177  CALL fsprd3(fra,ndire,spr1,tet1,spr2,tet2,xlam)
178  ELSEIF(frabi.EQ.1) THEN
179  CALL fsprd1(fra,ndire,spr1,tet1,spr2,tet2,xlam)
180  ENDIF
181 !
182 ! COMPUTES THE DIRECTIONAL SPECTRUM
183 !
184  IF (frabi.LE.3) THEN
185  DO jf=1,nf
186  DO jp=1,ndire
187  f(ip,jp,jf)=spec(jf)*fra(jp)
188  ENDDO
189  ENDDO
190  ELSEIF(frabi.EQ.4) THEN
191 ! DIRECTION DEPENDS ON FREQUENCY
192  DO jf=1,nf
193  IF(freq(jf).LT.fpic) THEN
194  coef1=smax*(freq(jf)/fpic)**(5.0d0)
195  delt=0.5d0/delfra(coef1)
196  ELSE
197  coef1=smax*(freq(jf)/fpic)**(-2.5d0)
198  delt = 0.5d0/delfra(coef1)
199  ENDIF
200  DO jp=1,ndire
201  dteta = teta(jp)-teta1
202  argum = abs(cos(0.5d0*(dteta)))
203  fra(jp)=delt*argum**(2.d0*coef1)
204  f(ip,jp,jf)=spec(jf)*fra(jp)
205  ENDDO
206  ENDDO
207  ELSE
208  WRITE(lu,*)'WRONG VALUE FOR ANGULAR DISTRIBUTION FUNCTION'
209  CALL plante(1)
210  ENDIF
211  ELSE
212  DO jf=1,nf
213  DO jp=1,ndire
214  f(ip,jp,jf)=0.d0
215  ENDDO
216  ENDDO
217  ENDIF
218 !
219  ENDDO ! IP
220 !
221 ! ==/ INISPE = 2 /===========================================
222 ! IF NON ZERO WIND -E(F): JONSWAP AS A FUNCTION OF THE WIND (AL,FP)
223 ! -FRA : UNIMODAL ABOUT TETA(WIND)
224 ! IF ZERO WIND -E(F): PARAMETERISED JONSWAP (AL,FP)
225 ! -FRA : PARAMETERISED UNIMODAL
226 ! ===========================================================
227 !
228  ELSEIF (inispe.EQ.2) THEN
229 !
230  uvent = 0
231  DO ip=1,npoin2
232  IF(vent) uvent=sqrt(uv(ip)**2+vv(ip)**2)
233 !
234 ! COMPUTES THE FREQUENCY SPECTRUM (JONSWAP)
235 !
236  IF(uvent.GT.uvmin) THEN
237  gxu=gx/uvent**2
238  ug = uvent/gravit
239  fp = max(0.13d0,coefa*gxu**coefd)
240  fp = min(fp,fremax*ug)
241  al = max(0.0081d0, coefb*fp**coefe)
242  fp = fp/ug
243  ELSE
244  al=alphil
245  fp=fpic
246  ENDIF
247  CALL spejon
248  &( spec , nf , al , fp , gamma , sigmaa, sigmab,
249  & fpmin )
250 !
251 ! COMPUTES THE DIRECTIONAL SPREADING FUNCTION
252 !
253  IF (uvent.GT.uvmin) THEN
254  tet1=atan2(uv(ip),vv(ip))
255  ELSE
256  tet1=teta1
257  ENDIF
258  spr1=spred1
259  spr2=1.d0
260  tet2=0.d0
261  xlam=1.d0
262  IF(frabi.EQ.2) THEN
263  CALL fsprd2(fra,ndire,spr1,tet1,spr2,tet2,xlam)
264  ELSEIF(frabi.EQ.3) THEN
265  CALL fsprd3(fra,ndire,spr1,tet1,spr2,tet2,xlam)
266  ELSEIF(frabi.EQ.1) THEN
267  CALL fsprd1(fra,ndire,spr1,tet1,spr2,tet2,xlam)
268  ENDIF
269 !
270 ! COMPUTES THE DIRECTIONAL SPECTRUM
271 !
272  IF(frabi.LE.3) THEN
273  DO jf=1,nf
274  DO jp=1,ndire
275  f(ip,jp,jf)=spec(jf)*fra(jp)
276  ENDDO
277  ENDDO
278  ELSEIF(frabi.EQ.4) THEN
279 ! DIRECTION DEPENDS ON FREQUENCY
280  DO jf=1,nf
281  IF(freq(jf).LT.fpic) THEN
282  coef1=smax*(freq(jf)/fpic)**(5.0d0)
283  delt=0.5d0/delfra(coef1)
284  ELSE
285  coef1=smax*(freq(jf)/fpic)**(-2.5d0)
286  delt = 0.5d0/delfra(coef1)
287  ENDIF
288  DO jp=1,ndire
289  dteta = teta(jp)-teta1
290  argum = abs(cos(0.5d0*(dteta)))
291  fra(jp)=delt*argum**(2.d0*coef1)
292  f(ip,jp,jf)=spec(jf)*fra(jp)
293  ENDDO
294  ENDDO
295  ELSE
296  WRITE(lu,*)'WRONG VALUE FOR ANGULAR DISTRIBUTION FUNCTION'
297  CALL plante(1)
298  ENDIF
299 !
300  ENDDO ! IP
301 !
302 ! ==/ INISPE = 3 /===========================================
303 ! IF NON ZERO WIND -E(F): PARAMETERISED JONSWAP (AL,FP)
304 ! -FRA : UNIMODAL ABOUT TETA(WIND)
305 ! IF ZERO WIND -E(F): ZERO
306 ! -FRA : ZERO
307 ! ===========================================================
308 !
309  ELSEIF (inispe.EQ.3) THEN
310 !
311  uvent=0
312  DO ip=1,npoin2
313  IF (vent) uvent=sqrt(uv(ip)**2+vv(ip)**2)
314  IF(uvent.GT.uvmin) THEN
315 !
316 !...........COMPUTES THE FREQUENCY SPECTRUM (JONSWAP)
317 ! """""""""""""""""""""""""""""""""""""""""
318  al = alphil
319  fp = fpic
320  CALL spejon
321  &( spec , nf , al , fp , gamma , sigmaa, sigmab,
322  & fpmin )
323 !
324 ! COMPUTES THE DIRECTIONAL SPREADING FUNCTION
325 !
326  spr1=spred1
327  tet1=atan2(uv(ip),vv(ip))
328  spr2=1.d0
329  tet2=0.d0
330  xlam=1.d0
331  IF(frabi.EQ.2) THEN
332  CALL fsprd2(fra,ndire,spr1,tet1,spr2,tet2,xlam)
333  ELSEIF(frabi.EQ.3) THEN
334  CALL fsprd3(fra,ndire,spr1,tet1,spr2,tet2,xlam)
335  ELSEIF(frabi.EQ.1) THEN
336  CALL fsprd1(fra,ndire,spr1,tet1,spr2,tet2,xlam)
337  ENDIF
338 !
339 ! COMPUTES THE DIRECTIONAL SPECTRUM
340 !
341  IF(frabi.LE.3) THEN
342  DO jf=1,nf
343  DO jp=1,ndire
344  f(ip,jp,jf)=spec(jf)*fra(jp)
345  ENDDO
346  ENDDO
347  ELSEIF(frabi.EQ.4) THEN
348 ! DIRECTION DEPENDS ON FREQUENCY
349  DO jf=1,nf
350  IF(freq(jf).LT.fpic) THEN
351  coef1=smax*(freq(jf)/fpic)**(5.0d0)
352  delt=0.5d0/delfra(coef1)
353  ELSE
354  coef1=smax*(freq(jf)/fpic)**(-2.5d0)
355  delt = 0.5d0/delfra(coef1)
356  ENDIF
357  DO jp=1,ndire
358  dteta = teta(jp)-teta1
359  argum = abs(cos(0.5d0*(dteta)))
360  fra(jp)=delt*argum**(2.d0*coef1)
361  f(ip,jp,jf)=spec(jf)*fra(jp)
362  ENDDO
363  ENDDO
364  ELSE
365  WRITE(lu,*)'WRONG VALUE FOR ANGULAR DISTRIBUTION FUNCTION'
366  CALL plante(1)
367  ENDIF
368  ELSE
369  DO jf=1,nf
370  DO jp=1,ndire
371  f(ip,jp,jf)=0.d0
372  ENDDO
373  ENDDO
374  ENDIF
375 !
376  ENDDO ! IP
377 !
378 ! ==/ INISPE = 4 /===========================================
379 ! IF NON ZERO WIND -E(F): PARAMETERISED JONSWAP (AL,FP)
380 ! -FRA : PARAMETERISED UNIMODAL
381 ! IF ZERO WIND -E(F): PARAMETERISED JONSWAP (AL,FP)
382 ! -FRA : PARAMETERISED UNIMODAL
383 ! ===========================================================
384 !
385  ELSEIF (inispe.EQ.4) THEN
386 !
387  DO ip=1,npoin2
388 !
389 ! COMPUTES THE FREQUENCY SPECTRUM (JONSWAP)
390 !
391  al = alphil
392  fp = fpic
393  CALL spejon
394  &( spec , nf , al , fp , gamma , sigmaa, sigmab,
395  & fpmin )
396 !
397 ! COMPUTES THE DIRECTIONAL SPREADING FUNCTION
398 !
399  spr1=spred1
400  tet1=teta1
401  spr2=spred2
402  tet2=teta2
403  xlam=xlamda
404  IF(frabi.EQ.2) THEN
405  CALL fsprd2(fra,ndire,spr1,tet1,spr2,tet2,xlam)
406  ELSEIF(frabi.EQ.3) THEN
407  CALL fsprd3(fra,ndire,spr1,tet1,spr2,tet2,xlam)
408  ELSEIF(frabi.EQ.1) THEN
409  CALL fsprd1(fra,ndire,spr1,tet1,spr2,tet2,xlam)
410  ENDIF
411 !
412 ! COMPUTES THE DIRECTIONAL SPECTRUM
413 !
414 
415  IF(frabi.LE.3) THEN
416  DO jf=1,nf
417  DO jp=1,ndire
418  f(ip,jp,jf)=spec(jf)*fra(jp)
419  ENDDO
420  ENDDO
421  ELSEIF(frabi.EQ.4) THEN
422 ! DIRECTION DEPENDS ON FREQUENCY
423  DO jf=1,nf
424  IF(freq(jf).LT.fpic) THEN
425  coef1=smax*(freq(jf)/fpic)**(5.0d0)
426  delt=0.5d0/delfra(coef1)
427  ELSE
428  coef1=smax*(freq(jf)/fpic)**(-2.5d0)
429  delt = 0.5d0/delfra(coef1)
430  ENDIF
431  DO jp=1,ndire
432  dteta = teta(jp)-teta1
433  argum = abs(cos(0.5d0*(dteta)))
434  fra(jp)=delt*argum**(2.d0*coef1)
435  f(ip,jp,jf)=spec(jf)*fra(jp)
436  ENDDO
437  ENDDO
438  ELSE
439  WRITE(lu,*)'WRONG VALUE FOR ANGULAR DISTRIBUTION FUNCTION'
440  CALL plante(1)
441  ENDIF
442 !
443  ENDDO ! IP
444 !
445 ! ==/ INISPE = 5 /===========================================
446 ! IF NON ZERO WIND -E(F): PARAMETERISED JONSWAP (HM0,FP)
447 ! -FRA : UNIMODAL ABOUT TETA(WIND)
448 ! IF ZERO WIND -E(F): ZERO
449 ! -FRA : ZERO
450 ! ===========================================================
451 !
452  ELSEIF (inispe.EQ.5) THEN
453 !
454  coef=0.0624d0/(0.230d0+0.0336d0*gamma-0.185d0/(1.9d0+gamma))
455  & *(deupi*fpic)**4*hm0**2/gravit**2
456 !
457  uvent=0
458  DO ip=1,npoin2
459  IF (vent) uvent=sqrt(uv(ip)**2+vv(ip)**2)
460  IF (uvent.GT.uvmin) THEN
461 !
462 ! COMPUTES THE FREQUENCY SPECTRUM (JONSWAP)
463 !
464  al=coef
465  fp = fpic
466  CALL spejon
467  &( spec , nf , al , fp , gamma , sigmaa, sigmab,
468  & fpmin )
469 !
470 ! COMPUTES THE DIRECTIONAL SPREADING FUNCTION
471 !
472  spr1=spred1
473  tet1=atan2(uv(ip),vv(ip))
474  spr2=1.d0
475  tet2=0.d0
476  xlam=1.d0
477  IF(frabi.EQ.2) THEN
478  CALL fsprd2(fra,ndire,spr1,tet1,spr2,tet2,xlam)
479  ELSEIF(frabi.EQ.3) THEN
480  CALL fsprd3(fra,ndire,spr1,tet1,spr2,tet2,xlam)
481  ELSEIF(frabi.EQ.1) THEN
482  CALL fsprd1(fra,ndire,spr1,tet1,spr2,tet2,xlam)
483  ENDIF
484 !
485 ! COMPUTES THE DIRECTIONAL SPECTRUM
486 !
487  IF(frabi.LE.3) THEN
488  DO jf=1,nf
489  DO jp=1,ndire
490  f(ip,jp,jf)=spec(jf)*fra(jp)
491  ENDDO
492  ENDDO
493  ELSEIF(frabi.EQ.4) THEN
494 ! DIRECTION DEPENDS ON FREQUENCY
495  DO jf=1,nf
496  IF(freq(jf).LT.fpic) THEN
497  coef1=smax*(freq(jf)/fpic)**(5.0d0)
498  delt=0.5d0/delfra(coef1)
499  ELSE
500  coef1=smax*(freq(jf)/fpic)**(-2.5d0)
501  delt = 0.5d0/delfra(coef1)
502  ENDIF
503  DO jp=1,ndire
504  dteta = teta(jp)-teta1
505  argum = abs(cos(0.5d0*(dteta)))
506  fra(jp)=delt*argum**(2.d0*coef1)
507  f(ip,jp,jf)=spec(jf)*fra(jp)
508  ENDDO
509  ENDDO
510  ELSE
511  WRITE(lu,*)'WRONG VALUE FOR ANGULAR DISTRIBUTION FUNCTION'
512  CALL plante(1)
513  ENDIF
514  ELSE
515  DO jf=1,nf
516  DO jp=1,ndire
517  f(ip,jp,jf)=0.d0
518  ENDDO
519  ENDDO
520  ENDIF
521 !
522  ENDDO ! IP
523 !
524 ! ==/ INISPE = 6 /===========================================
525 ! IF NON ZERO WIND -E(F): PARAMETERISED JONSWAP (HM0,FP)
526 ! -FRA : PARAMETERISED UNIMODAL
527 ! IF ZERO WIND -E(F): PARAMETERISED JONSWAP (HM0,FP)
528 ! -FRA : PARAMETERISED UNIMODAL
529 ! ===========================================================
530 !
531  ELSEIF (inispe.EQ.6) THEN
532 !
533  coef=0.0624d0/(0.230d0+0.0336d0*gamma-0.185d0/(1.9d0+gamma))
534  & *(deupi*fpic)**4*hm0**2/gravit**2
535 !
536  DO ip=1,npoin2
537 !
538 ! COMPUTES THE FREQUENCY SPECTRUM (JONSWAP)
539 !
540  al = coef
541  fp = fpic
542  CALL spejon
543  &( spec , nf , al , fp , gamma , sigmaa, sigmab,
544  & fpmin )
545 !
546 ! COMPUTES THE DIRECTIONAL SPREADING FUNCTION
547 !
548  spr1=spred1
549  tet1=teta1
550  spr2=spred2
551  tet2=teta2
552  xlam=xlamda
553  IF(frabi.EQ.2) THEN
554  CALL fsprd2(fra,ndire,spr1,tet1,spr2,tet2,xlam)
555  ELSEIF(frabi.EQ.3) THEN
556  CALL fsprd3(fra,ndire,spr1,tet1,spr2,tet2,xlam)
557  ELSEIF(frabi.EQ.1) THEN
558  CALL fsprd1(fra,ndire,spr1,tet1,spr2,tet2,xlam)
559  ENDIF
560 
561 !
562 ! COMPUTES THE DIRECTIONAL SPECTRUM
563 !
564  IF(frabi.LE.3) THEN
565  DO jf=1,nf
566  DO jp=1,ndire
567  f(ip,jp,jf)=spec(jf)*fra(jp)
568  ENDDO
569  ENDDO
570  ELSEIF(frabi.EQ.4) THEN
571 ! DIRECTION DEPENDS ON FREQUENCY
572  DO jf=1,nf
573  IF(freq(jf).LT.fpic) THEN
574  coef1=smax*(freq(jf)/fpic)**(5.0d0)
575  delt=0.5d0/delfra(coef1)
576  ELSE
577  coef1=smax*(freq(jf)/fpic)**(-2.5d0)
578  delt = 0.5d0/delfra(coef1)
579  ENDIF
580  DO jp=1,ndire
581  dteta = teta(jp)-teta1
582  argum = abs(cos(0.5d0*(dteta)))
583  fra(jp)=delt*argum**(2.d0*coef1)
584  f(ip,jp,jf)=spec(jf)*fra(jp)
585  ENDDO
586  ENDDO
587  ELSE
588  WRITE(lu,*)'WRONG VALUE FOR ANGULAR DISTRIBUTION FUNCTION'
589  CALL plante(1)
590  ENDIF
591 !
592  ENDDO ! IP
593 !
594 ! ==/ INISPE = 7 /===========================================
595 ! IF NON ZERO WIND -E(F): PARAMETERISED TMA (HM0,FP)
596 ! -FRA : PARAMETERISED UNIMODAL
597 ! IF ZERO WIND -E(F): PARAMETERISED TMA (HM0,FP)
598 ! -FRA : PARAMETERISED UNIMODAL
599 ! ===========================================================
600 !
601  ELSEIF (inispe.EQ.7) THEN
602 !
603  coef=0.0624d0/(0.230d0+0.0336d0*gamma-0.185d0/(1.9d0+gamma))
604  & *(deupi*fpic)**4*hm0**2/gravit**2
605 !
606  DO ip=1,npoin2
607 !
608 ! COMPUTES THE FREQUENCY SPECTRUM (JONSWAP)
609 !
610  al = coef
611  fp = fpic
612 !
613  CALL spetma
614  &( spec , nf , al , fp , gamma , sigmaa, sigmab,
615  & fpmin , depth(ip) )
616 !
617 ! COMPUTES THE DIRECTIONAL SPREADING FUNCTION
618 !
619  spr1=spred1
620  tet1=teta1
621  spr2=spred2
622  tet2=teta2
623  xlam=xlamda
624  IF(frabi.EQ.2) THEN
625  CALL fsprd2(fra,ndire,spr1,tet1,spr2,tet2,xlam)
626  ELSEIF(frabi.EQ.3) THEN
627  CALL fsprd3(fra,ndire,spr1,tet1,spr2,tet2,xlam)
628  ELSEIF(frabi.EQ.1) THEN
629  CALL fsprd1(fra,ndire,spr1,tet1,spr2,tet2,xlam)
630  ENDIF
631 !
632 ! COMPUTES THE THE DIRECTIONAL SPECTRUM
633 !
634  IF(frabi.LE.3) THEN
635  DO jf=1,nf
636  DO jp=1,ndire
637  f(ip,jp,jf)=spec(jf)*fra(jp)
638  ENDDO
639  ENDDO
640  ELSEIF(frabi.EQ.4) THEN
641 ! DIRECTION DEPENDS ON FREQUENCY
642  DO jf=1,nf
643  IF(freq(jf).LT.fpic) THEN
644  coef1=smax*(freq(jf)/fpic)**(5.0d0)
645  delt=0.5d0/delfra(coef1)
646  ELSE
647  coef1=smax*(freq(jf)/fpic)**(-2.5d0)
648  delt = 0.5d0/delfra(coef1)
649  ENDIF
650  DO jp=1,ndire
651  dteta = teta(jp)-teta1
652  argum = abs(cos(0.5d0*(dteta)))
653  fra(jp)=delt*argum**(2.d0*coef1)
654  f(ip,jp,jf)=spec(jf)*fra(jp)
655  ENDDO
656  ENDDO
657  ELSE
658  WRITE(lu,*)'WRONG VALUE FOR ANGULAR DISTRIBUTION FUNCTION'
659  CALL plante(1)
660  ENDIF
661 !
662  ENDDO ! IP
663 !
664  ELSE
665  WRITE(lu,*) 'SPEINI: UNKNOWN OPTION: ',inispe
666  CALL plante(1)
667  stop
668  ENDIF
669 !
670 !-----------------------------------------------------------------------
671 !
672 
673  RETURN
674  END
subroutine ov(OP, X, Y, Z, C, DIM1)
Definition: ov.f:7
double precision, dimension(:), pointer freq
subroutine spetma(SPEC, NF, AL, FP, GAMMA, SIGMAA, SIGMAB, FPMIN, DEPTH)
Definition: spetma.f:8
subroutine fsprd1(FRA, NDIRE, SPRED1, TETA1, SPRED2, TETA2, XLAMDA)
Definition: fsprd1.f:7
double precision function delfra(SS)
Definition: delfra.f:7
double precision, dimension(:), pointer teta
subroutine fsprd3(FRA, NDIRE, SPRED1, TETA1, SPRED2, TETA2, XLAMDA)
Definition: fsprd3.f:7
subroutine speini(F, SPEC, FRA, UV, VV, FREMAX, FETCH, SIGMAA, SIGMAB, GAMMA, FPIC, HM0, ALPHIL, TETA1, SPRED1, TETA2, SPRED2, XLAMDA, NPOIN2, NDIRE, NF, INISPE, DEPTH, FRABI)
Definition: speini.f:10
subroutine fsprd2(FRA, NDIRE, SPRED1, TETA1, SPRED2, TETA2, XLAMDA)
Definition: fsprd2.f:7
subroutine spejon(SPEC, NF, AL, FP, GAMMA, SIGMAA, SIGMAB, FPMIN)
Definition: spejon.f:8
Definition: bief.f:3