C FILE MAC.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 ****************************************************************** C * MCDANIEL PROBLEM * C * JOURNAL OF COMPUTERS AND MATH - VOL 14, NO 5, 1987, PG 339 * C * USER WRITES THIS ROUTINE * C * BOTTOM PROFILE - RANGE,DEPTH * C ****************************************************************** C ****************************************************************** INCLUDE 'FOR3D.CMN' DO 24 L=1,NSOL TRACK(1,1,L)=0.0 ! RANGE IN METERS TRACK(1,2,L)=250.0 ! DEPTH IN METERS TRACK(2,1,L)=15000.0 TRACK(2,2,L)=250.0 TRACK(3,1,L)=16500.0 TRACK(3,2,L)=100.0 TRACK(4,1,L)=25000.0 TRACK(4,2,L)=100.0 C *** EXTEND LAST DEPTH BEYOND MAX RANGE. TRACK(5,1,L)=1.0E+38 TRACK(5,2,L)=TRACK(4,2,L) R2(L)=TRACK(1,1,L) Z2(L)=TRACK(1,2,L) 24 CONTINUE ZBOT=250.0 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 * MCDANIEL PROBLEM * C * JOURNAL OF COMPUTERS AND MATH - VOL 14, NO 5, 1987, PG 339 * C ****************************************************************** C ****************************************************************** INCLUDE 'FOR3D.CMN' C DIMENSION ZW(6),CW(6) DATA ZW/0,76.2,108.5,167.6,204.8,250/ DATA CW/1538.9,1540.5,1541.1,1533.4,1528.9,1525.0/ C GO TO (100,200,300,400) ,KSVP NSVP=0 RETURN C 100 CONTINUE DO 75 L=1,NSOL NLYRS(L)=4 R=RA/1000.0 DZLYR=.1*(RA-15000.0) ZLYR(1,L)=250.0-DZLYR DZLYR=(212.0/1500.0)*(RA-15000.0) ZLYR(2,L)=512.0-DZLYR ZLYR(3,L)=512.0 ZLYR(4,L)=600.0 RHO(1,L)=1.0 RHO(2,L)=1.7+.1333*(R-15) IF(RA.GT.15750)RHO(2,L)=1.8 RHO(3,L)=2.0 RHO(4,L)=2.5 RHOG(1,L)=0.0 RHOG(2,L)=0.0 RHOG(2,L)=0.0 RHOG(3,L)=0.0 RHOG(4,L)=0.0 BETA(1,L)=0.0 BETA(3,L)=.38 BETA(4,L)=0.0 BETAG(1,L)=0.0 BETAG(3,L)=0.0 BETAG(4,L)=0.0 ZI=ZLYR(1,L) M=6 DO 50 J=1,M IF(ZI.GT.ZW(J)) GO TO 50 CI=CW(J-1)+(CW(J)-CW(J-1))*(ZI-ZW(J-1))/(ZW(J)-ZW(J-1)) GO TO 60 50 CONTINUE 55 CI=CW(M-1)+(CW(M)-CW(M-1))*(ZI-ZW(M-1))/(ZW(M)-ZW(M-1)) 60 CONTINUE J=6 ZSVP(J,L)=ZLYR(1,L) ZSVP(J+1,L)=ZLYR(1,L) ZSVP(J+2,L)=ZLYR(2,L) ZSVP(J+3,L)=ZLYR(2,L) ZSVP(J+4,L)=ZLYR(3,L) ZSVP(J+5,L)=ZLYR(3,L) ZSVP(J+6,L)=ZLYR(4,L) CSVP(J,L)=CI CSVP(J+1,L)=1.00328*CI*(1.0+.102*(R-15)) CSVP(J+2,L)=1.00328*CI*(1.0+.102*(R-15))+.5*(ZLYR(2,L)-ZLYR(1,L)) IF(RA.GT.15750) CSVP(J+1,L)=1.08*CI IF(RA.GT.15750) CSVP(J+2,L)=1.08*CI+.5*(ZLYR(2,L)-ZLYR(1,L)) BETA(2,L)=(.2+.0667*(R-15.0))*(CSVP(J+1,L)+CSVP(J+2,L))/2000.0 IF(RA.GT.15750.0) BETA(2,L)=.25*(CSVP(J+1,L)+CSVP(J+2,L))/2000.0 BETAG(2,L)=0.0 CSVP(J+3,L)=1900.0 CSVP(J+4,L)=1900.0 CSVP(J+5,L)=4500.0 CSVP(J+6,L)=4500.0 NSVP=J+6 IXSVP(1,L)=J IXSVP(2,L)=J+2 IXSVP(3,L)=J+4 IXSVP(4,L)=J+6 291 FORMAT(1X,2F10.3) DZLYR=ZLYR(2,L)-ZLYR(1,L) K=IXSVP(1,L)+1 290 CONTINUE 75 CONTINUE 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