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 ,
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)
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
116 DOUBLE PRECISION COEF1, DELT, ARGUM, DTETA
120 npoin4= npoin2*ndire*nf
139 CALL ov(
'X=C ', x=f, c=0.d0, dim1=npoin4)
148 ELSEIF(inispe.EQ.1)
THEN 152 IF(
vent) uvent=sqrt(uv(ip)**2+vv(ip)**2)
153 IF (uvent.GT.uvmin)
THEN 159 fp = max(0.13d0,coefa*gxu**coefd)
160 fp = min(fp,fremax*ug)
161 al = max(0.0081d0, coefb*fp**coefe)
164 &( spec , nf , al , fp , gamma , sigmaa, sigmab,
170 tet1=atan2(uv(ip),vv(ip))
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)
187 f(ip,jp,jf)=spec(jf)*fra(jp)
190 ELSEIF(frabi.EQ.4)
THEN 193 IF(
freq(jf).LT.fpic)
THEN 194 coef1=smax*(
freq(jf)/fpic)**(5.0d0)
197 coef1=smax*(
freq(jf)/fpic)**(-2.5d0)
198 delt = 0.5d0/
delfra(coef1)
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)
208 WRITE(
lu,*)
'WRONG VALUE FOR ANGULAR DISTRIBUTION FUNCTION' 228 ELSEIF (inispe.EQ.2)
THEN 232 IF(
vent) uvent=sqrt(uv(ip)**2+vv(ip)**2)
236 IF(uvent.GT.uvmin)
THEN 239 fp = max(0.13d0,coefa*gxu**coefd)
240 fp = min(fp,fremax*ug)
241 al = max(0.0081d0, coefb*fp**coefe)
248 &( spec , nf , al , fp , gamma , sigmaa, sigmab,
253 IF (uvent.GT.uvmin)
THEN 254 tet1=atan2(uv(ip),vv(ip))
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)
275 f(ip,jp,jf)=spec(jf)*fra(jp)
278 ELSEIF(frabi.EQ.4)
THEN 281 IF(
freq(jf).LT.fpic)
THEN 282 coef1=smax*(
freq(jf)/fpic)**(5.0d0)
285 coef1=smax*(
freq(jf)/fpic)**(-2.5d0)
286 delt = 0.5d0/
delfra(coef1)
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)
296 WRITE(
lu,*)
'WRONG VALUE FOR ANGULAR DISTRIBUTION FUNCTION' 309 ELSEIF (inispe.EQ.3)
THEN 313 IF (
vent) uvent=sqrt(uv(ip)**2+vv(ip)**2)
314 IF(uvent.GT.uvmin)
THEN 321 &( spec , nf , al , fp , gamma , sigmaa, sigmab,
327 tet1=atan2(uv(ip),vv(ip))
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)
344 f(ip,jp,jf)=spec(jf)*fra(jp)
347 ELSEIF(frabi.EQ.4)
THEN 350 IF(
freq(jf).LT.fpic)
THEN 351 coef1=smax*(
freq(jf)/fpic)**(5.0d0)
354 coef1=smax*(
freq(jf)/fpic)**(-2.5d0)
355 delt = 0.5d0/
delfra(coef1)
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)
365 WRITE(
lu,*)
'WRONG VALUE FOR ANGULAR DISTRIBUTION FUNCTION' 385 ELSEIF (inispe.EQ.4)
THEN 394 &( spec , nf , al , fp , gamma , sigmaa, sigmab,
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)
418 f(ip,jp,jf)=spec(jf)*fra(jp)
421 ELSEIF(frabi.EQ.4)
THEN 424 IF(
freq(jf).LT.fpic)
THEN 425 coef1=smax*(
freq(jf)/fpic)**(5.0d0)
428 coef1=smax*(
freq(jf)/fpic)**(-2.5d0)
429 delt = 0.5d0/
delfra(coef1)
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)
439 WRITE(
lu,*)
'WRONG VALUE FOR ANGULAR DISTRIBUTION FUNCTION' 452 ELSEIF (inispe.EQ.5)
THEN 454 coef=0.0624d0/(0.230d0+0.0336d0*gamma-0.185d0/(1.9d0+gamma))
459 IF (
vent) uvent=sqrt(uv(ip)**2+vv(ip)**2)
460 IF (uvent.GT.uvmin)
THEN 467 &( spec , nf , al , fp , gamma , sigmaa, sigmab,
473 tet1=atan2(uv(ip),vv(ip))
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)
490 f(ip,jp,jf)=spec(jf)*fra(jp)
493 ELSEIF(frabi.EQ.4)
THEN 496 IF(
freq(jf).LT.fpic)
THEN 497 coef1=smax*(
freq(jf)/fpic)**(5.0d0)
500 coef1=smax*(
freq(jf)/fpic)**(-2.5d0)
501 delt = 0.5d0/
delfra(coef1)
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)
511 WRITE(
lu,*)
'WRONG VALUE FOR ANGULAR DISTRIBUTION FUNCTION' 531 ELSEIF (inispe.EQ.6)
THEN 533 coef=0.0624d0/(0.230d0+0.0336d0*gamma-0.185d0/(1.9d0+gamma))
543 &( spec , nf , al , fp , gamma , sigmaa, sigmab,
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)
567 f(ip,jp,jf)=spec(jf)*fra(jp)
570 ELSEIF(frabi.EQ.4)
THEN 573 IF(
freq(jf).LT.fpic)
THEN 574 coef1=smax*(
freq(jf)/fpic)**(5.0d0)
577 coef1=smax*(
freq(jf)/fpic)**(-2.5d0)
578 delt = 0.5d0/
delfra(coef1)
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)
588 WRITE(
lu,*)
'WRONG VALUE FOR ANGULAR DISTRIBUTION FUNCTION' 601 ELSEIF (inispe.EQ.7)
THEN 603 coef=0.0624d0/(0.230d0+0.0336d0*gamma-0.185d0/(1.9d0+gamma))
614 &( spec , nf , al , fp , gamma , sigmaa, sigmab,
615 & fpmin , depth(ip) )
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)
637 f(ip,jp,jf)=spec(jf)*fra(jp)
640 ELSEIF(frabi.EQ.4)
THEN 643 IF(
freq(jf).LT.fpic)
THEN 644 coef1=smax*(
freq(jf)/fpic)**(5.0d0)
647 coef1=smax*(
freq(jf)/fpic)**(-2.5d0)
648 delt = 0.5d0/
delfra(coef1)
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)
658 WRITE(
lu,*)
'WRONG VALUE FOR ANGULAR DISTRIBUTION FUNCTION' 665 WRITE(
lu,*)
'SPEINI: UNKNOWN OPTION: ',inispe
subroutine ov(OP, X, Y, Z, C, DIM1)
double precision, dimension(:), pointer freq
subroutine spetma(SPEC, NF, AL, FP, GAMMA, SIGMAA, SIGMAB, FPMIN, DEPTH)
subroutine fsprd1(FRA, NDIRE, SPRED1, TETA1, SPRED2, TETA2, XLAMDA)
double precision function delfra(SS)
double precision, dimension(:), pointer teta
subroutine fsprd3(FRA, NDIRE, SPRED1, TETA1, SPRED2, TETA2, XLAMDA)
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)
subroutine fsprd2(FRA, NDIRE, SPRED1, TETA1, SPRED2, TETA2, XLAMDA)
subroutine spejon(SPEC, NF, AL, FP, GAMMA, SIGMAA, SIGMAB, FPMIN)