C FILE USER.F C ****************************************************************** C C *********** C * UBCON3D * C *********** SUBROUTINE UBCON3D C ****************************************************************** C *** USER BOTTOM BOUNDARY CONDITION SUBROUTINE C ****************************************************************** INCLUDE 'FOR3D.CMN' ZI=(N+1)*DZ DO 250 J=1,NSOL+2 ANGR=-FLDW/2.0*PI/180.0+((J-2)*PHI) BOTY(J)=BOTX(J) C BOTX(J)=... 250 CONTINUE RETURN END C *********** C * UBOTTOM * C *********** SUBROUTINE UBOTTOM C ****************************************************************** C * USER WRITES THIS ROUTINE * C * BOTTOM PROFILE - RANGE,DEPTH * C ****************************************************************** INCLUDE 'FOR3D.CMN' C *** TEMPLATE SET UP FOR 4 POINTS IN BOTTOM PROFILE. C *** ISOL=1 IS FOR LEFTMOST SECTOR BOUNDARY. ISOL=1 C TRACK(1,1,ISOL)=0.0 ! RANGE IN METERS C TRACK(1,2,ISOL)= ! DEPTH IN METERS C TRACK(2,1,ISOL)= ! RANGE C TRACK(2,2,ISOL)= ! DEPTH C TRACK(3,1,ISOL)= C TRACK(3,2,ISOL)= C TRACK(4,1,ISOL)= C TRACK(4,2,ISOL)= C *** EXTEND LAST DEPTH BEYOND MAX RANGE. TRACK(5,1,ISOL)=1.0E+38 TRACK(5,2,ISOL)=TRACK(4,2,ISOL) R2(ISOL)=TRACK(1,1,ISOL) Z2(ISOL)=TRACK(1,2,ISOL) C C *** NEXT BOUNDARY ISOL=2 C TRACK(1,1,ISOL)=0.0 ! RANGE IN METERS C TRACK(1,2,ISOL)= ! DEPTH IN METERS C TRACK(2,1,ISOL)= C TRACK(2,2,ISOL)= C TRACK(3,1,ISOL)= C TRACK(3,2,ISOL)= C TRACK(4,1,ISOL)= C TRACK(4,2,ISOL)= C *** EXTEND LAST DEPTH BEYOND MAX RANGE. TRACK(5,1,ISOL)=1.0E+38 TRACK(5,2,ISOL)=TRACK(4,2,ISOL) R2(ISOL)=TRACK(1,1,ISOL) Z2(ISOL)=TRACK(1,2,ISOL) C C ETC. C C ZBOT= MAXIMUM DEPTH ENTERED BY USER RETURN END C *********** C * UEXACT * C *********** SUBROUTINE UEXACT C ****************************************************************** C * EXACT SOLUTION - USED FOR TEST PURPOSES C * USER COMPUTES EXACT SOLUTION UB AT PRESENT RANGE RA, DEPTH ZI, C * AND AZIMUTH ANG. MAIN PROGRAM COMPUTES UA. RELATIVE ERROR C * MAY BE COMPUTED AS SHOWN BELOW. RA, ZI, ANG, UA, UB IN COMMON. C ****************************************************************** INCLUDE 'FOR3D.CMN' C UB=... USER COMPUTES THIS PL=-20.0*ALOG10(CABS(UB))+10.0*ALOG10(RA) UC=(UA-UB) WRITE(NPU,120) PL,UB 120 FORMAT(20X,3X,F10.3,3X,'(',E12.5,2X,E12.5,' )') RELERR=CABS(UC/UB) WRITE(NPU,150) UC,RELERR 150 FORMAT(36X,'(',E12.5,2X,E12.5,' )',2X,E12.5) RETURN END C *********** C * UPORT3D * C *********** SUBROUTINE UPORT3D C ****************************************************************** C * PORT SIDEWALL BOUNDARY CONDITION C ****************************************************************** INCLUDE 'FOR3D.CMN' J=0 ANGR=-FLDW/2.0*PI/180.0+((J-1)*PHI) DO 100 I=1,N ZI=I*DZ PORTY(I)=PORTX(I) C PORTX(I)=... 100 CONTINUE RETURN END C *********** C * USCON3D * C *********** SUBROUTINE USCON3D C ***************************************************************** C *** USER SURFACE BOUNDARY CONDITION SUBROUTINE C ***************************************************************** INCLUDE 'FOR3D.CMN' ZI=0.0 DO 250 J=1,NSOL+2 ANGR=-FLDW/2.0*PI/180.0+((J-2)*PHI) SURY(J)=SURX(J) C SURX(J)=.... 250 CONTINUE RETURN END C *********** C * USFLD3D * C *********** SUBROUTINE USFLD3D C ****************************************************************** C *** USER STARTING FIELD C *** USER WRITES THIS SUBROUTINE IF GAUSSIAN FIELD NOT DESIRED C *** USFLD3D IS CALLED IF ISF = 1 C ****************************************************************** C *** UFIELD SUBROUTINE SUPPLIES: C *** U - COMPLEX STARTING FIELD C ****************************************************************** INCLUDE 'FOR3D.CMN' DO 200 J=1,NSOL M=(J-1)*N ANGR=-FLDW/2.0*PI/180.0+((J-1)*PHI) DO 100 I=1,N ZI=I*DZ C U(M+I)= .... 100 CONTINUE 200 CONTINUE RETURN END C *********** C * USTBD3D * C *********** SUBROUTINE USTBD3D C ****************************************************************** C * STARBOARD SIDEWALL BOUNDARY CONDITION C ****************************************************************** INCLUDE 'FOR3D.CMN' J=NSOL+1 ANGR=-FLDW/2.0*PI/180.0+((J-1)*PHI) DO 100 I=1,N ZI=I*DZ STBDY(I)=STBDX(I) C STBDX(I)=... 100 CONTINUE RETURN END C *********** C * USVP3D * C *********** SUBROUTINE USVP3D C ****************************************************************** C ****************************************************************** C * USER SOUND SPEED SUBROUTINE * C ****************************************************************** C ****************************************************************** INCLUDE 'FOR3D.CMN' C *** TEMPLATE SET UP FOR 2 LAYERS C GO TO (100,200,300,400) ,KSVP NSVP=0 RETURN C 100 CONTINUE ISOL=1 ILYR=1 C ZLYR(ILYR,ISOL)= C RHO(ILYR,ISOL)=1.0 C RHOG(ILYR,ISOL)=0.0 C BETA(ILYR,ISOL)=0.0 C BETAG(ILYR,ISOL)=0.0 C ZSVP(1,ISOL)=0.0 C CSVP(1,ISOL)= C ZSVP(2,ISOL)= C CSVP(2,ISOL)= C ZSVP(3,ISOL)=ZLYR(ILYR,ISOL) C CSVP(3,ISOL)= C IXSVP(ILYR,ISOL)=3 C C ILYR=2 C ZLYR(ILYR,ISOL)= C RHO(ILYR,ISOL)= C RHOG(ILYR,ISOL)= C BETA(ILYR,ISOL)= C BETAG(ILYR,ISOL)= C ZSVP(4,ISOL)=ZSVP(3,ISOL) C CSVP(4,ISOL)= C ZSVP(5,ISOL)= C CSVP(5,ISOL)= C ZSVP(6,ISOL)=ZLYR(ILYR,ISOL) C CSVP(6,ISOL)= C IXSVP(ILYR,ISOL)=6 C C NLYRS(ISOL)=2 C RETURN C 200 CONTINUE C *** USER INSERTS CODE HERE IF DESIRED RETURN C 300 CONTINUE C *** USER INSERTS CODE HERE IF DESIRED RETURN C 400 CONTINUE C *** USER INSERTS CODE HERE IF DESIRED RETURN END