94400 

 94500 

 94600 

 94700 

 94800 

 94900 

 95000 

 95100 

 95200 

 95300 

 95400 

 95500 

 95600 

 95700 

 95800 

 95900 

 96000 

 96100 

 96200 

 9G300 

 96400 

 96500 

 96600 

 96700 

 96800 

 96900 

 97000 

 97100 



97 200 

 97300 

 97400 

 97500 

 97600 

 97700 

 97800 

 97900 

 98000 



98 100 

 98200 

 98300 

 98400 

 98500 

 98600 

 98700 

 98800 

 98900 

 99000 

 99100 

 99200 

 99300 

 99400 

 99500 

 99600 

 99700 

 99800 

 99900 



1 00000 

 100100 

 100200 

 100300 

 100400 

 100500 

 100G00 

 100700 

 100800 

 100900 

 101000 

 1 O 1 1 00 

 101200 

 101300 

 101400 

 101500 

 101600 



COMMON/N USED/dUSE , T , CO , CGEN, CGGEN , ANGGEN , DX", BERM, THETAO( 10) . MMAX 



COMMON/D/SIGMA ,G, ELO. JMAX. I MAX, PI .TWOPI ,PI02,HGEN, I JET ( 10) , S JETTY 



COMMON/G/IBREAK(GO) ,HN0NBR(20) 



DIMENSION J1(60) . J2(G0) ,d1REF(60) , J3REF(60) 

 C*THIS SUB CALCS WHERE DIFFRACTION GOVERNS AND WHERE REFRACT GOVERNS. 

 C*IT WILL CALL REFRAC FOR OFFSHORE AREA(0FF TIP OF STRUCTURE). 

 C*THEN IT WILL DO THE SHADOW ZONE USING DIFF(IF THETAO .NE.0.0) 

 C* IT WILL THEN FINISH THE OTHERS USING REFRAC AGAIN. 

 C*LET'S ZERO-OUT THE DIMENSIONED ARRAYS. 



DO 1000 I=1,IMAX+2 



J1(I )=0.0 



d2(I )=0.0 



JIREFd )=0.0 

 1000 J3REF(I )=0.0 

 C*NOW, LETS FIND C.CG.RK.HB, AND WVNUM . 



DO 202 I=1,IMAX 



DO 202 d=1 ,dMAX+2 



DEPTH=DEEP(I , J) 



CALL WVNUM(DEPTH,T,DUMK) 



RK(I , J)=DUMK 



C( I , J)=CO*TANH(RK( I.J)*DEEP(I,J)) 



EN=0.5*( 1 .0+((2.*RK(I , J)*DEEP(I .d))/SINH(2.*RK(I . J)*DEEP(I, J)))) 



CG( I . J)=EN*C( I , J) 



HB( I , J)=0.78*DEEP(I , J) 

 202 CONTINUE 

 C*WILL ATTRIB AN EQUAL REACH TO EACH SIDE OF EACH M-GROIN. 



DO 200 M=1 ,MMAX 



IDUML=1 



IF(M.NE . 1 ) IDUML=( I JET( M )+I JET( M- 1 ) )/2 



IDUMR=IMAX 



IF(M.NE .MMAX) IDUMR= ( I JET( M)+I JET ( M+ 1 ) )/2 



NPTS=0 



DO 1 I=IDUML, IDUMR 



DO 2 d=1 , UMAX 



IF(Y(I , J) .LT.SJETTY) GO TO 14 



J1(I)=J 



J2(I )=JMAX 



GO TO 15 



14 CONTINUE 

 2 CONTINUE 



15 CONTINUE 



C*IF NO STRUCT IS PRESENT( SJETTY^O . O) . DO REFRAC THRUOUT GRID SYSTEM 



IF(SJETTY.EO.O.O) J1(I)=1 

 1 CONTINUE 



DO 16 I=IDUML. IDUMR 

 C* 'REFRAC STARTS ON THE NEXT TO LAST J-CONTOUR , NOT THE LAST! 



DO 16 d = J1(I ) , J2( I )-1 



16 NPTS=NPTS+1 



C*WILL NOW DO THE REFRACT FOR THE REGION 1 AREA. 



C*ISTART REPRESENTS THE DIRECTION THE SWEEPS WILL BEGIN FROM. 

 C*WILL USE DUMMY IMAX , I JET , I JET+ 1 IN CALL STTS SO IBEGIN.IEND, AND 

 C***ISTART WON'T CHANGE THEM. MUST RESET AFTER EACH CALL REFRAC. 



IMAXT=IDUMR 



IdETT=IJET(M) 



IJETP1=IJET(M)+1 



IDUMLL=IDUML 



IF(ANGGEN.GE .0.0) CALL REFRAC( J 1 , J2 , NPTS , IDUMLL . IMAXT . IDUMLL , M ) 



IF(ANGGEN.LT.O.O) CALL REFRAC( J 1 . J2 , NPTS , IDUMLL . IMAXT , IMAXT , M ) 



IMAXT=IDUMR 



IJETT=IJET(M) 



IJETP1=IJET(M)+1 



IDUMLL=IDUML 



JDUMN=J1(IJET(M) ) 



JDUMS = J1( IJET(M)+1 ) 



XDISTN=(IJET(M)-1 .0)*DX+DX/2. 



ELTIP=T*0.5*(C(IJET(M) , JDUMN)+C( I JET(M)+ 1 , JDUMS ) ) 

 C*NOW MUST CHECK THE ANGLE AT THE STRUCTURE'S TIP TO SEE WHERE SHAD ZONE 

 C*IF NO STRUCT PRE SENT ( SJETTY=0 . O) , FUTHER REFRAC/DIFF UNNECESSARY. 



IF(SJETTY.EO.O.O) GO TO 13 



THETA0(M)=0.5*(THETA(IJET(M), JDUMN)+THETA(IJET(M)+1 .JDUMS) ) 



HINC=0.5*(H(IJET(M) , JDUMN)+H( I JET ( M)+ 1 .JDUMS)) 



IF(THETAO(M) ) 10, 1 1 . 12 

 C*THIS SECTION HANDLES REFRAC/DIFF IF THETAO<0.0. 



79 



