Antennas

home *** CD-ROM | disk | FTP | other *** search

/ Antennas / Antennas_CD-ROM_Walnut_Creek_September_1996.iso / thinwire / asaps / asap.for < prev next >

Wrap

Text File | 1996-06-30 | 248KB | 3,026 lines

DIMENSION X(60), Y(60), Z(60), XG(60), YG(60), ZG(60) ASA00010 DIMENSION I1(60), I2(60), I3(60), JA(60), JB(60), KFLAG(30) ASA00020 DIMENSION CPHI(500), CTHET(500) ASA00030 DIMENSION DATY1(360), DATY2(360), DATY3(360), DATY4(360) ASA00040 DIMENSION D(50), IA(50), IB(50), ISC(50), MD(50,4), ND(50) ASA00050 DIMENSION LZD(60), KGEN(60) ASA00060 COMMON IWL ASA00070 DIMENSION XNP(50), YNP(50), ZNP(50) ASA00080 COMPLEX C(1830) ASA00090 COMPLEX CDAT1(500),CDAT2(500),CDAT3(500),CDAT4(500) ASA00100 COMPLEX CJ(60),EP(60),EPP(60),ET(60),ETT(60) ASA00110 COMPLEX CGD(50),SGD(60),CG(100),VG(100),ZLD(100) ASA00120 COMPLEX VOLT(60),ZLLD(60) ASA00130 COMPLEX EPPS,EPTS,ETPS,ETTS,EX,EY,EZ ASA00140 COMPLEX EP2,EP3,EP4,ERR,ETA,GAM,Y11,Z11,ZS ASA00150 DATA PI,TP/3.14159,6.28318/ ASA00160 DATA E0,U0/8.854E-12,1.2566E-6/ ASA00170 1 NGEN = -1 ASA00180 IGRD = -1 ASA00190 LOAD = -1 ASA00200 BM = -1 ASA00210 ICARD = 0 ASA00220 AM = -1 ASA00230 IFLAG = 0 ASA00240 VOLT(1) = (1.,0.) ASA00250 HGT = 0. ASA00260 NM = 0 ASA00270 NP = 0 ASA00280 MSG = 0 ASA00290 SIG2 = -1. ASA00300 TD2 = -1. ASA00310 SIG3 = -1 ASA00320 ER3 = 1 ASA00330 TD3 = 0. ASA00340 CMM = 50. ASA00350 ER2 = 1. ASA00360 FMC = 300. ASA00370 INM = 50 ASA00380 ICJ = 60 ASA00390 WRITE (6,74) ASA00400 C ASA00410 DO 2 I=1,30 ASA00420 2 KFLAG(I) = -1 ASA00430 C ASA00440 C ASA00450 DO 3 J=1,INM ASA00460 ISC(J) = 0 ASA00470 VG(J) = (.0,.0) ASA00480 ZLD(J) = (.0,.0) ASA00490 JJ = J+INM ASA00500 VG(JJ) = (.0,.0) ASA00510 3 ZLD(JJ) = (.0,.0) ASA00520 C ASA00530 4 NFFP = 0 ASA00540 NBIP = 0 ASA00550 NBAP = 0 ASA00560 AFFP = 1000. ASA00570 AFFT = 1000. ASA00580 ABIP = 1000. ASA00590 ABIT = 1000. ASA00600 ABAP = 1000. ASA00610 ABAT = 1000. ASA00620 STEP = 1. ASA00630 KNM = 0 ASA00640 CALL READ (IA,IB,IBISC,ICARD,IGAIN,IGRD,INEAR,INT,ISCAT,IWR,IFLAG,ASA00650 1KFLAG,KGEN,LOAD,LZD,MSG,NBAP,NBIP,NFFP,NGEN,NM,NP,ABAP,ABAT,AFFP,AASA00660 2FFT,ABIP,ABIT,AM,BM,CMM,ER2,ER3,ER4,FMC,HGT,PHAF,PHAI,PHIF,PHII,PHASA00670 3SF,PHSI,THAF,THAI,THIF,THII,THSF,THSI,SIG2,SIG3,SIG4,TD2,TD3,VOLT,ASA00680 4X,XNP,Y,YNP,Z,ZLLD,ZNP,STEP) ASA00690 WRITE (6,56) ASA00700 IF (MSG.LT.1) GO TO 5 ASA00710 IF (MSG.EQ.1) WRITE (6,70) KFLAG(30) ASA00720 IF (IFLAG.EQ.4) GO TO 1 ASA00730 5 IF (IFLAG.EQ.5) STOP ASA00740 IF (AM.LT.0) WRITE (6,127) ASA00750 IF (AM.LT.0) GO TO 6 ASA00760 IF ((NM.GT.0).AND.(NP.GT.0)) GO TO 7 ASA00770 WRITE (6,116) ASA00780 6 IF (IFLAG.EQ.1) GO TO 1 ASA00790 MSG = 2 ASA00800 GO TO 4 ASA00810 7 WRITE (6,114) ASA00820 WRITE (6,113) ASA00830 WRITE (6,112) ASA00840 IF (KFLAG(1).EQ.1) WRITE (6,83) FMC ASA00850 IF (KFLAG(2).EQ.1) WRITE (6,84) AM ASA00860 IF (KFLAG(3).EQ.1) WRITE (6,85) CMM ASA00870 IF (KFLAG(20).NE.1) WRITE (6,87) ASA00880 IF (KFLAG(4).EQ.1) WRITE (6,86) ASA00890 IF (KFLAG(4).EQ.1) WRITE (6,88) BM ASA00900 IF (KFLAG(5).EQ.1) WRITE (6,89) SIG2 ASA00910 IF (KFLAG(6).EQ.1) WRITE (6,90) ER2 ASA00920 IF (KFLAG(7).EQ.1) WRITE (6,91) TD2 ASA00930 IF (KFLAG(8).NE.1) WRITE (6,92) ASA00940 IF (KFLAG(9).EQ.1) WRITE (6,93) SIG3 ASA00950 IF (KFLAG(10).EQ.1) WRITE (6,94) ER3 ASA00960 IF (KFLAG(11).EQ.1) WRITE (6,95) TD3 ASA00970 IF (KFLAG(26).NE.1) WRITE (6,122) ASA00980 IF ((IGRD.GT.1).AND.(KFLAG(25).EQ.1)) WRITE (6,123) ASA00990 IF ((IGRD.EQ.1).AND.(KFLAG(25).EQ.1)) WRITE (6,125) ASA01000 IF ((IGRD.GT.1).AND.(KFLAG(25).EQ.1)) WRITE (6,124) ER4,SIG4 ASA01010 IF ((IGRD.GT.0).AND.(KFLAG(25).EQ.1)) WRITE (6,126) HGT ASA01020 IF (KFLAG(21).EQ.1) WRITE (6,121) INT ASA01030 WRITE (6,111) ASA01040 IF (KFLAG(12).EQ.1) WRITE (6,96) (I,IA(I),X(IA(I)),Y(IA(I)),Z(IA(IASA01050 1)),IB(I),X(IB(I)),Y(IB(I)),Z(IB(I)),I=1,NM) ASA01060 WRITE (6,111) ASA01070 IF (KFLAG(24).GT.0) WRITE (6,119) (LZD(I),ZLLD(I),I=1,LOAD) ASA01080 IF (KFLAG(14).GT.0) WRITE (6,118) (LZD(I),ZLLD(I),I=1,LOAD) ASA01090 WRITE (6,111) ASA01100 IF (KFLAG(23).GT.0) WRITE (6,120) (KGEN(I),VOLT(I),I=1,NGEN) ASA01110 IF (KFLAG(13).GT.0) WRITE (6,97) (KGEN(I),VOLT(I),I=1,NGEN) ASA01120 WRITE (6,111) ASA01130 WRITE (6,114) ASA01140 WRITE (6,98) ASA01150 WRITE (6,112) ASA01160 IF (KFLAG(22).NE.1) WRITE (6,110) ASA01170 IF (KFLAG(15).EQ.1) WRITE (6,99) ASA01180 IF (KFLAG(16).EQ.1) WRITE (6,100) PHAI,PHAF,THAI,THAF,STEP ASA01190 IF (KFLAG(17).EQ.1) WRITE (6,101) PHII,PHIF,THII,THIF,STEP ASA01200 IF (KFLAG(18).EQ.1) WRITE (6,102) PHSI,PHSF,THSI,THSF,STEP ASA01210 IF (KFLAG(19).EQ.1) WRITE (6,103) (XNP(I),YNP(I),ZNP(I),I=1,INEAR)ASA01220 IF (AFFP.LT.500.) WRITE (6,105) AFFP ASA01230 IF (AFFT.LT.500.) WRITE (6,104) AFFT ASA01240 IF (ABAP.LT.500.) WRITE (6,109) ABAP ASA01250 IF (ABAT.LT.500.) WRITE (6,108) ABAT ASA01260 IF (ABIP.LT.500.) WRITE (6,107) ABIP ASA01270 IF (ABIT.LT.500.) WRITE (6,106) ABIT ASA01280 IF ((IBISC.GT.0).AND.(ISCAT.LT.0)) WRITE (6,73) ASA01290 IF (KFLAG(4).LT.1) GO TO 129 ASA01300 DO 128 I=1,INM ASA01310 128 ISC(I)=1 ASA01320 129 FHZ=FMC*1.E6 ASA01330 OMEGA = TP*FHZ ASA01340 IF (SIG2.LT.0.) EP2=ER2*E0*CMPLX(1.,-TD2) ASA01350 IF (TD2.LT.0.) EP2 = CMPLX(ER2*E0,-SIG2/OMEGA) ASA01360 IF (SIG3.LT.0.) EP3=ER3*E0*CMPLX(1.,-TD3) ASA01370 IF (TD3.LT.0.) EP3 = CMPLX(ER3*E0,-SIG3/OMEGA) ASA01380 IF (IGRD.GT.1) EP4 = CMPLX(ER4*E0,-SIG4/OMEGA) ASA01390 IF (IGRD.GT.1) ERR = EP4/EP3 ASA01400 IF (KFLAG(21).GT.0) WRITE (6,121) INT ASA01410 ETA = CSQRT(U0/EP3) ASA01420 GAM = OMEGA*CSQRT(-U0*EP3) ASA01430 IF (KFLAG(12).NE.1) GO TO 9 ASA01440 NPG = NP ASA01450 NMG = NM ASA01460 C ASA01470 DO 8 I=1,NPG ASA01480 XG(I) = X(I) ASA01490 YG(I) = Y(I) ASA01500 8 ZG(I) = Z(I) ASA01510 C ASA01520 C ASA01530 9 DO 10 I=1,NPG ASA01540 X(I) = XG(I) ASA01550 Y(I) = YG(I) ASA01560 10 Z(I) = ZG(I) ASA01570 C ASA01580 NP = NPG ASA01590 NM = NMG ASA01600 IWL = 0 ASA01610 IF (IGRD.LE.0) GO TO 15 ASA01620 C SET UP IMAGE FOR GROUND PLANE ASA01630 ZMIN = Z(1) ASA01640 K = 0 ASA01650 C ASA01660 IF (Z(I).LT.ZMIN) ZMIN=Z(I) ASA01670 DO 11 I=1,NP ASA01680 Z(I) = Z(I)+HGT ASA01690 IF (Z(I).GT.1.E-60) GO TO 11 ASA01700 IWL = IWL+1 ASA01710 11 CONTINUE ASA01720 C ASA01730 IF (ZMIN.GE.0.0) GO TO 12 ASA01740 WRITE (6,117) ASA01750 IF (IFLAG.EQ.1) GO TO 1 ASA01760 IF (IFLAG.EQ.2) STOP ASA01770 MSG = 2 ASA01780 GO TO 4 ASA01790 C ASA01800 12 DO 13 J=1,NM ASA01810 K = J+NM ASA01820 IA(K) = IA(J) ASA01830 IF (IA(J).GT.IWL) IA(K)=IA(J)+NP-IWL ASA01840 13 IB(K) = IB(J)+NP-IWL ASA01850 C ASA01860 IWLP = IWL+1 ASA01870 C ASA01880 DO 14 I=IWLP,NP ASA01890 J = I+NP-IWL ASA01900 X(J) = X(I) ASA01910 Y(J) = Y(I) ASA01920 14 Z(J) = -Z(I) ASA01930 C ASA01940 KNM = NM+1 ASA01950 NM = 2*NM ASA01960 NP = 2*NP-IWL ASA01970 15 CALL SORT (IA,IB,I1,I2,I3,JA,JB,MD,ND,NM,NP,N,MAX,MIN,ICJ,INM) ASA01980 IF (MAX.LE.4) GO TO 16 ASA01990 WRITE (6,71) ASA02000 IF (IFLAG.EQ.1) GO TO 1 ASA02010 IF (IFLAG.EQ.2) STOP ASA02020 MSG = 2 ASA02030 GO TO 4 ASA02040 16 IF (MIN.GE.1) GO TO 17 ASA02050 WRITE (6,72) ASA02060 IF (IFLAG.EQ.1) GO TO 1 ASA02070 IF (IFLAG.EQ.2) STOP ASA02080 MSG = 2 ASA02090 GO TO 4 ASA02100 17 WRITE (6,56) ASA02110 IF (MAX.GT.4.OR.MIN.LT.1.OR.N.GT.ICJ) GO TO 54 ASA02120 I12 = 1 ASA02130 IF (LOAD.GT.0) GO TO 19 ASA02140 C ASA02150 DO 18 I=1,NM ASA02160 18 ZLD(I) = (0.,0.) ASA02170 C ASA02180 19 IF (NGEN.GT.0) GO TO 21 ASA02190 C ASA02200 DO 20 I=1,NM ASA02210 20 VG(I) = (0.,0.) ASA02220 C ASA02230 21 KN = NM ASA02240 IF (IGRD.GT.0) KN = NM/2 ASA02250 J = 1 ASA02260 C ANTENNA CALCULATIONS ASA02270 IF (LOAD.LE.0) GO TO 24 ASA02280 IF (KFLAG(24).GT.0) GO TO 22 ASA02290 C ASA02300 DO 23 J=1,KN ASA02310 C ASA02320 22 DO 23 I=1,LOAD ASA02330 K = LZD(I) ASA02340 IF ((IA(J).EQ.K).AND.(KFLAG(14).GT.0)) ZLD(J)=ZLLD(I) ASA02350 IF (KFLAG(24).GT.0) ZLD(K)=ZLLD(I) ASA02360 IF ((KFLAG(14).GT.0).AND.(IGRD.GT.0)) ZLD(J+KN)=ZLD(J) ASA02370 IF ((KFLAG(24).GT.0).AND.(IGRD.GT.0)) ZLD(K+KN)=ZLD(K) ASA02380 23 CONTINUE ASA02390 C ASA02400 24 IF (NGEN.LT.0) GO TO 27 ASA02410 KN = NM ASA02420 IF (IGRD.GT.0) KN = NM/2 ASA02430 IF (KFLAG(23).GT.0) GO TO 25 ASA02440 C ASA02450 DO 26 J=1,KN ASA02460 C ASA02470 25 DO 26 I=1,NGEN ASA02480 K = KGEN(I) ASA02490 IF ((IA(J).EQ.K).AND.(KFLAG(13).GT.0)) VG(J)=VOLT(I) ASA02500 IF (KFLAG(23).GT.0) VG(K)=VOLT(I) ASA02510 IF ((KFLAG(13).GT.0).AND.(IGRD.GT.0)) VG(J+KN)=-VG(J) ASA02520 IF ((IGRD.GT.0).AND.(KFLAG(23).GT.0))VG(K+KN)=-VG(K) ASA02530 26 CONTINUE ASA02540 C ASA02550 27 CALL SGANT (IA,IB,INM,INT,ISC,I1,I2,I3,JA,JB,MD,N,ND,NM,NP,AM,BM,CASA02560 1,CGD,CMM,D,EP2,EP3,ETA,FHZ,GAM,SGD,X,Y,Z,ZLD,ZS,ERR,IGRD) ASA02570 IF (N.GT.0) GO TO 28 ASA02580 IF (IFLAG.EQ.2) STOP ASA02590 MSG = 2 ASA02600 IF (IFLAG.EQ.1) GO TO 1 ASA02610 GO TO 4 ASA02620 28 IF (NGEN.LE.0) GO TO 36 ASA02630 WRITE (6,75) ASA02640 WRITE (6,76) ASA02650 WRITE (6,77) ASA02660 WRITE (6,82) ASA02670 CALL GANT1 (IA,IB,INM,IWR,I1,I2,I3,I12,JA,JB,MD,N,ND,NM,AM,C,CJ,CGASA02680 1,CMM,D,EFF,GAM,GG,CGD,SGD,VG,Y11,Z11,ZLD,ZS,IGRD) ASA02690 WRITE (6,57) EFF,GG,Z11 ASA02700 C NEAR FIELD ASA02710 IF (INEAR.LE.0) GO TO 30 ASA02720 WRITE (6,75) ASA02730 WRITE (6,78) ASA02740 WRITE (6,77) ASA02750 C ASA02760 DO 29 I=1,INEAR ASA02770 XP = XNP(I) ASA02780 YP = YNP(I) ASA02790 ZP = ZNP(I) ASA02800 CALL GNFLD (IA,IB,INM,I1,I2,I3,MD,N,ND,NM,AM,CGD,SGD,ETA,GAM,CJ,D,ASA02810 1X,Y,Z,XP,YP,ZP,EX,EY,EZ,IGRD,ERR) ASA02820 WRITE (6,58) XP,YP,ZP ASA02830 WRITE (6,59) EX,EY,EZ ASA02840 29 CONTINUE ASA02850 C ASA02860 C FAR FIELD ASA02870 30 IF (IGAIN.LE.0) GO TO 36 ASA02880 C ASA02890 DO 31 I=1,360 ASA02900 DATY1(I) = 0 ASA02910 DATY2(I) = 0 ASA02920 DATY3(I) = 0 ASA02930 31 DATY4(I) = 0 ASA02940 C ASA02950 WRITE (6,75) ASA02960 WRITE (6,79) ASA02970 WRITE (6,77) ASA02980 WRITE (6,82) ASA02990 INC = 0 ASA03000 NPL = -1 ASA03010 IF (KFLAG(16).EQ.1) WRITE (6,69) ASA03020 IF (NFFP.EQ.1) GO TO 32 ASA03030 NPHA = (PHAF-PHAI)/STEP+1 ASA03040 NTHA = (THAF-THAI)/STEP+1 ASA03050 GO TO 34 ASA03060 32 IF (AFFT.GT.500.) GO TO 33 ASA03070 NPL = 1 ASA03080 NPHA = 360 ASA03090 NTHA = 1 ASA03100 PHAI = 0. ASA03110 THAI = AFFT ASA03120 STEP = 1. ASA03130 GO TO 34 ASA03140 33 NPL = 2 ASA03150 NPHA = 1 ASA03160 NTHA = 360 ASA03170 PHAI = AFFP ASA03180 THAI = 0. ASA03190 STEP = 1. ASA03200 34 PH = PHAI-STEP ASA03210 DO 35 K=1,NPHA ASA03220 PH = PH+STEP ASA03230 TH = THAI-STEP ASA03240 DO 35 I=1,NTHA ASA03250 PHSPH = 0. ASA03260 PHSTH = 0. ASA03270 TH = TH+STEP ASA03280 IF ((IGRD.GT.0).AND.((TH.GT.90).AND.(TH.LT.270))) GO TO 35 ASA03290 CALL GFFLD (IA,IB,INC,INM,IWR,I1,I2,I3,I12,MD,N,ND,NM,AM,ACSP,ACSTASA03300 1,C,CGD,CG,CJ,CMM,D,ECSP,ECST,EP,ET,EPP,ETT,EPPS,EPTS,ETPS,ETTS,GG,ASA03310 2GPP,GTT,PH,SGD,SCSP,SCST,SPPM,SPTM,STPM,STTM,TH,X,Y,Z,ZLD,ZS,ETA,GASA03320 3AM,ERR,IGRD) ASA03330 ETMAG = CABS(ETTS) ASA03340 EPMAG = CABS(EPPS) ASA03350 IF(ETMAG.GT.1.E-32) PHSTH=57.295779*ATAN2(AIMAG(ETTS),REAL(ETTS)) ASA03360 IF(EPMAG.GT.1.E-32) PHSPH=57.295779*ATAN2(AIMAG(EPPS),REAL(EPPS)) ASA03370 IF (NPL.EQ.1) DATY1(K)=EPMAG ASA03380 IF (NPL.EQ.1) DATY2(K)=ETMAG ASA03390 IF (NPL.EQ.2) DATY1(I)=EPMAG ASA03400 IF (NPL.EQ.2) DATY2(I)=ETMAG ASA03410 IF (KFLAG(16).NE.1) GO TO 35 ASA03420 WRITE (6,60) TH,PH,GTT,GPP,ETTS,ETMAG,PHSTH,EPPS,EPMAG,PHSPH ASA03430 35 CONTINUE ASA03440 C ASA03450 WRITE (6,56) ASA03460 IF (NPL.LE.0) GO TO 36 ASA03470 CALL POLPRT (1,DATY1) ASA03480 CALL POLPRT (2,DATY2) ASA03490 C BACK SCATTERING ASA03500 36 IF (ISCAT.LE.0) GO TO 54 ASA03510 WRITE (6,75) ASA03520 WRITE (6,80) ASA03530 WRITE (6,77) ASA03540 WRITE (6,82) ASA03550 L = 0 ASA03560 NPL = -1 ASA03570 INC = 1 ASA03580 IF (NBAP.EQ.1) GO TO 37 ASA03590 NPHI = (PHIF-PHII)/STEP+1 ASA03600 NTHI = (THIF-THII)/STEP+1 ASA03610 IF (IWR.LE.0) WRITE (6,62) ASA03620 GO TO 39 ASA03630 37 IF (ABAT.GT.500.) GO TO 38 ASA03640 NPL = 1 ASA03650 NPHI = 360 ASA03660 NTHI = 1 ASA03670 PHII = 0. ASA03680 THII = ABAT ASA03690 STEP = 1. ASA03700 GO TO 39 ASA03710 38 NPL = 2 ASA03720 NPHI = 1 ASA03730 NTHI = 360 ASA03740 PHII = ABAP ASA03750 THII = 0. ASA03760 STEP = 1. ASA03770 39 PH = PHII-STEP ASA03780 C ASA03790 DO 42 K=1,NPHI ASA03800 PH = PH+STEP ASA03810 TH = THII-STEP ASA03820 C ASA03830 DO 42 I=1,NTHI ASA03840 TH = TH+STEP ASA03850 IF ((IGRD.GT.0).AND.((TH.GT.90).AND.(TH.LT.270))) GO TO 42 ASA03860 L = L+1 ASA03870 CALL GFFLD (IA,IB,INC,INM,IWR,I1,I2,I3,I12,MD,N,ND,NM,AM,ACSP,ACSTASA03880 1,C,CGD,CG,CJ,CMM,D,ECSP,ECST,EP,ET,EPP,ETT,EPPS,EPTS,ETPS,ETTS,GG,ASA03890 2GPP,GTT,PH,SGD,SCSP,SCST,SPPM,SPTM,STPM,STTM,TH,X,Y,Z,ZLD,ZS,ETA,GASA03900 3AM,ERR,IGRD) ASA03910 IF (IWR.GT.0) GO TO 40 ASA03920 IF (NPL.LT.0) WRITE (6,63) PH,TH,SPPM,SPTM,STPM,STTM,ACSP,ACST,ECSASA03930 1P,ECST,SCSP,SCST ASA03940 40 CPHI(L) = PH ASA03950 CTHET(L) = TH ASA03960 CDAT1(L) = EPPS ASA03970 CDAT2(L) = EPTS ASA03980 CDAT3(L) = ETPS ASA03990 CDAT4(L) = ETTS ASA04000 IF (NPL.NE.1) GO TO 41 ASA04010 DATY1(K) = CABS(EPPS) ASA04020 DATY2(K) = CABS(EPTS) ASA04030 DATY3(K) = CABS(ETPS) ASA04040 DATY4(K) = CABS(ETTS) ASA04050 GO TO 42 ASA04060 41 DATY1(I) = CABS(EPPS) ASA04070 DATY2(I) = CABS(EPTS) ASA04080 DATY3(I) = CABS(ETPS) ASA04090 DATY4(I) = CABS(ETTS) ASA04100 42 CONTINUE ASA04110 C ASA04120 WRITE (6,82) ASA04130 IF (NPL.LE.0) GO TO 43 ASA04140 CALL POLPRT (7,DATY1) ASA04150 CALL POLPRT (8,DATY2) ASA04160 CALL POLPRT (9,DATY3) ASA04170 CALL POLPRT (10,DATY4) ASA04180 IF (KFLAG(17).NE.1) GO TO 45 ASA04190 43 WRITE (6,64) ASA04200 C ASA04210 DO 44 I=1,L ASA04220 44 WRITE (6,65) CPHI(I),CTHET(I),CDAT1(I),CDAT2(I),CDAT3(I),CDAT4(I) ASA04230 C ASA04240 C BISTATIC SCATTERING ASA04250 45 IF (IBISC.LE.0) GO TO 54 ASA04260 WRITE (6,75) ASA04270 WRITE (6,81) ASA04280 WRITE (6,77) ASA04290 WRITE (6,82) ASA04300 WRITE (6,61) CPHI(L),CTHET(L) ASA04310 WRITE (6,82) ASA04320 L = 0 ASA04330 INC = 2 ASA04340 NPL = -1 ASA04350 IF (NBIP.EQ.1) GO TO 46 ASA04360 NPHS = (PHSF-PHSI)/STEP+1 ASA04370 NTHS = (THSF-THSI)/STEP+1 ASA04380 IF (IWR.LE.0) WRITE (6,67) ASA04390 GO TO 48 ASA04400 46 IF (ABIT.GT.500.) GO TO 47 ASA04410 NPL = 1 ASA04420 NPHS = 360 ASA04430 NTHS = 1 ASA04440 PHSI = 0. ASA04450 THSI = ABIT ASA04460 STEP = 1. ASA04470 GO TO 48 ASA04480 47 NPL = 2 ASA04490 NPHS = 1 ASA04500 NTHS = 360 ASA04510 PHSI = ABIP ASA04520 THSI = 0. ASA04530 STEP = 1. ASA04540 48 PH = PHSI-STEP ASA04550 C ASA04560 DO 51 K=1,NPHS ASA04570 PH = PH+STEP ASA04580 TH = THSI-STEP ASA04590 IF ((IGRD.GT.0).AND.((TH.GT.90).AND.(TH.LT.270))) GO TO 51 ASA04600 C ASA04610 DO 51 I=1,NTHS ASA04620 TH = TH+STEP ASA04630 L = L+1 ASA04640 CALL GFFLD (IA,IB,INC,INM,IWR,I1,I2,I3,I12,MD,N,ND,NM,AM,ACSP,ACSTASA04650 1,C,CGD,CG,CJ,CMM,D,ECSP,ECST,EP,ET,EPP,ETT,EPPS,EPTS,ETPS,ETTS,GG,ASA04660 2GPP,GTT,PH,SGD,SCSP,SCST,SPPM,SPTM,STPM,STTM,TH,X,Y,Z,ZLD,ZS,ETA,GASA04670 3AM,ERR,IGRD) ASA04680 IF (IWR.GT.0) GO TO 49 ASA04690 IF (NPL.LT.0) WRITE (6,63) PH,TH,SPPM,SPTM,STPM,STTM ASA04700 49 CPHI(L) = PH ASA04710 CTHET(L) = TH ASA04720 CDAT1(L) = EPPS ASA04730 CDAT2(L) = EPTS ASA04740 CDAT3(L) = ETPS ASA04750 CDAT4(L) = ETTS ASA04760 IF (NPL.NE.1) GO TO 50 ASA04770 DATY1(K) = CABS(EPPS) ASA04780 DATY2(K) = CABS(EPTS) ASA04790 DATY3(K) = CABS(ETPS) ASA04800 DATY4(K) = CABS(ETTS) ASA04810 50 IF (NPL.NE.2) GO TO 51 ASA04820 DATY1(I) = CABS(EPPS) ASA04830 DATY2(I) = CABS(EPTS) ASA04840 DATY3(I)=CABS(ETPS) ASA04850 DATY4(I) = CABS(ETTS) ASA04860 51 CONTINUE ASA04870 C ASA04880 WRITE (6,82) ASA04890 IF (NPL.LE.0) GO TO 52 ASA04900 CALL POLPRT (3,DATY1) ASA04910 CALL POLPRT (4,DATY2) ASA04920 CALL POLPRT (5,DATY3) ASA04930 CALL POLPRT (6,DATY4) ASA04940 IF (KFLAG(18).NE.1) GO TO 54 ASA04950 52 WRITE (6,66) ASA04960 C ASA04970 DO 53 I=1,L ASA04980 53 WRITE (6,65) CPHI(I),CTHET(I),CDAT1(I),CDAT2(I),CDAT3(I),CDAT4(I) ASA04990 C ASA05000 54 IF (IFLAG.EQ.1) GO TO 1 ASA05010 IF (IFLAG.EQ.2) STOP ASA05020 C ASA05030 KKFLAG=0 ASA05040 KJFLAG=0 ASA05050 KMFLAG=0 ASA05060 KNFLAG=0 ASA05070 IF (KFLAG(13).GT.0) KKFLAG=1 ASA05080 IF (KFLAG(23).GT.0) KJFLAG=1 ASA05090 IF (KFLAG(14).GT.0) KMFLAG=1 ASA05100 IF (KFLAG(24).GT.0) KNFLAG=1 ASA05110 DO 55 I=1,30 ASA05120 55 KFLAG(I) = -1 ASA05130 C ASA05140 KFLAG(8) = 1 ASA05150 KFLAG(20) = 1 ASA05160 KFLAG(26) = 1 ASA05170 IF (KKFLAG.GT.0) KFLAG(13)=1 ASA05180 IF (KJFLAG.GT.0) KFLAG(23)=1 ASA05190 IF (KMFLAG.GT.0) KFLAG(14)=1 ASA05200 IF (KNFLAG.GT.0) KFLAG(24)=1 ASA05210 IF (IFLAG.EQ.3) WRITE (6,68) ASA05220 IF (IFLAG.EQ.6) WRITE (6,115) ASA05230 GO TO 4 ASA05240 C ASA05250 56 FORMAT (1H0) ASA05260 57 FORMAT (10X,'THE RADIATION EFFICIENCY IS ',F15.7//10X,'THE TIME-AVASA05270 1ERAGE POWER INPUT IS ',F15.7//10X,'THE ANTENNA IMPEDANCE IS ',F15.ASA05280 27,' +J',F15.7//) ASA05290 58 FORMAT (10X,'THE NEAR-FIELD ELECTRIC FIELD INTENSITY AT THE OBSERVASA05300 1ATION POINT ',E11.5,',',E11.5,',',E11.5,' (X,Y,Z RESPECTIVELY) IS:ASA05310 2'//) ASA05320 59 FORMAT (20X,'EX=',F15.7,' +J',F15.7/20X,'EY=',F15.7,' +J',F15.7/20ASA05330 1X,'EZ=',F15.7,' +J',F15.7////) ASA05340 60 FORMAT (3X,F5.1,2X,F5.1,3X,E10.4,2X,E10.4,2(3X,3(E10.4,2X),F6.1,1XASA05350 1)) ASA05360 61 FORMAT (T41,'FOR BISTATIC SCATTERING THE INCIDENT'/T41,'PLANE WAVEASA05370 1 IS PHI=',F5.1,' THETA=',F5.1///) ASA05380 62 FORMAT (' INCIDENT',T27,'ECHO AREA SIGMA',T66,'ABSORPTION',T90,'EXASA05390 1TINCTION',T114,'SCATTERING'/' PLANE',T25,'(INCIDENT-SCATTERED)',1ASA05400 24X,3(5X,'CROSS SECTION',6X)/' WAVE ',52X,3(10X,'FOR',11X)/' PHI ASA05410 3 THETA',3X,'PHI-PHI',3X,'PHI-THETA',4X,'THETA-PHI',2X,'THETA-THETAASA05420 4',3(5X,'PHI',7X,'THETA',4X)) ASA05430 63 FORMAT (1X,2(F5.1,1X),10(E10.4,2X)) ASA05440 64 FORMAT (T54,'BACKSCATTERING'/' INCIDENT',T37,'ELECTRIC FIELD POLARASA05450 1IZATION SCATTERING MATRIX'/' PLANE',T49,'(INCIDENT-SCATTERED)'/3XASA05460 2,'WAVE',T23,'PHI-PHI',T49,'PHI-THETA',T75,'THETA-PHI',T102,'THETA-ASA05470 3THETA'/' PHI THETA',3X,4(3X,'REAL',8X,'IMAG',8X)) ASA05480 65 FORMAT (1X,2(F5.1,1X),2X,4(E11.5,2X,E11.5,3X)) ASA05490 66 FORMAT (T54,'BISTATIC'/T37,'ELECTRIC FIELD POLARIZATION SCATTERINGASA05500 1 MATRIX'/' OBSERVATION',T50,'(INCIDENT-SCATTERED)'/' POINT',14X,ASA05510 2 'PHI-PHI',T49,'PHI-THETA',T76,'THETA-PHI',T101,'THETA-THETA'/' PASA05520 3HI THETA',4X,4(3X,'REAL',8X,'IMAG',8X)) ASA05530 67 FORMAT (' OBERSVATION',T27,'ECHO AREA SIGMA'/' POINT',T25,'(INCIASA05540 1DENT-SCATTERED)'/' PHI THETA',T14,'PHI-PHI',T24,'PHI-THETA',T37,ASA05550 2 'THETA-PHI',T48,'THETA-THETA') ASA05560 68 FORMAT (1H1,5X,'CONTINUE EXECUTION WITH THE FOLLOWING ADDITIONS ANASA05570 1D/OR CHANGES'//) ASA05580 69 FORMAT (54X,'ELECTRIC FIELD INTENSITY'/5X,'DEGREES',11X,'POWER GAIASA05590 1N',28X,'THETA',42X,'PHI'/3X,'THETA',3X,'PHI',7X,'THETA',8X,'PHI',1ASA05600 2X,2(8X,'REAL',8X,'IMAG',8X,'MAGN',5X,'PHASE')) ASA05610 70 FORMAT (10X,'*****ERROR IN DATA CARD NUMBER ',I2,' EXECUTION STOPASA05620 1PED*******') ASA05630 71 FORMAT (40X,'* A WIRE SEGMENT MAYNOT BE SHARED BY MORE THAN FOASA05640 1UR *'/40X,'* DIPOLE MODES---------CHECK DESCRIPTION DATA CAASA05650 2RD *'/40X,'* EXECUTION STOPPED ASA05660 3 *') ASA05670 72 FORMAT (40X,'* AN ISOLATED WIRE MUST HAVE AT LEAST TWO SEGMENTASA05680 1S *'/40X,'* AND THREE POINTS-----CHECK DESCRIPTION DATA CAASA05690 2RD *'/40X,'* EXECUTION STOPPED ASA05700 3 *') ASA05710 73 FORMAT (30X,'A BACKSCATTERING CALL MUST BE INCLUDED FOR A BISTATICASA05720 1 CALL'//50X,'REQUEST IGNORED'/////) ASA05730 74 FORMAT ('1',T50,37('*')/T50,'*',T86,'*'/ ASA05740 1 T50,'* OHIO STATE UNIVERSITY *'/ ASA05750 2 T50,'* ANTENNA ANALYSIS PROGRAM *'/ ASA05760 3 T50,'* MODIFIED FOR USE AT *'/ ASA05770 4 T50,'* NAVAL POSTGRADUATE SCHOOL *'/ ASA05780 5 T50,'* 17 JULY 1974 *'/ ASA05790 6 T50,'*',T86,'*'/T50,37('*')) ASA05800 75 FORMAT ('1',T50,29('*')/T50,'*',T78,'*') ASA05810 76 FORMAT (T50,'*',11X,'ANTENNA',T78,'*') ASA05820 77 FORMAT (T50,'*',8X,'CALCULATIONS',T78,'*'/T50,'*',T78,'*'/T50,29('ASA05830 1*')) ASA05840 78 FORMAT (T50,'*',9X,'NEAR FIELD',T78,'*') ASA05850 79 FORMAT (T50,'*',9X,'FAR FIELD',T78,'*') ASA05860 80 FORMAT (T50,'*',7X,'BACKSCATTERING',T78,'*') ASA05870 81 FORMAT (T50,'*',4X,'BISTATIC SCATTERING',T78,'*') ASA05880 82 FORMAT (////) ASA05890 83 FORMAT (T30,'FREQUENCY (MHZ)',T81,E11.5) ASA05900 84 FORMAT (T30,'WIRE RADIUS (METERS)',T81,E11.5) ASA05910 85 FORMAT (T30,'WIRE CONDUCTIVITY (MEGAMHOS/METER)',T81,E11.5) ASA05920 86 FORMAT (T30,'WIRE INSULATED (NO/YES)',T85,'YES') ASA05930 87 FORMAT (T30,'WIRE INSULATED (NO/YES)',T85,'NO') ASA05940 88 FORMAT (T30,'INSULATION RADIUS (METERS)',T81,E11.5) ASA05950 89 FORMAT (T30,'INSULATION CONDUCTIVITY (MHOS/METER)',T81,E11.5) ASA05960 90 FORMAT (T30,'INSULATION DIELECTRIC CONSTANT (RELATIVE)',T81,E11.5)ASA05970 91 FORMAT (T30,'INSULATION LOSS TANGENT',T81,E11.5) ASA05980 92 FORMAT (T30,'EXTERIOR MEDIUM',T81,'FREE SPACE') ASA05990 93 FORMAT (T30,'EXTERIOR MEDIUM CONDUCTIVITY (MHOS/METER)',T81,E11.5)ASA06000 94 FORMAT (T30,'EXTERIOR MEDIUM DIELECTRIC CONSTANT (RELATIVE)',T81, ASA06010 1 E11.5) ASA06020 95 FORMAT (T30,'EXTERIOR MEDIUM LOSS TANGENT',T81,E11.5) ASA06030 96 FORMAT (T50,'WIRE STRUCTURE'//T20,'SEG',4X,2('NODE',19X,'LOCATION'ASA06040 1,18X)/T21,'NO.',3X,2(' NO.',9X,'X',13X,'Y',13X,'Z',7X)/(T21,I2,5X,ASA06050 22(I2,5X,E11.5,4X,E11.5,4X,E11.5,1X))) ASA06060 97 FORMAT (T50,'ANTENNA FEEDS'/T40,'NODE',16X,'VOLTS'/T41,'NO.',12X, ASA06070 1 'REAL',7X,'IMAGINARY'/(T41,I2,6X,2(4X,E11.5))) ASA06080 98 FORMAT (T50,'*', 6X,'OUTPUT REQUESTED',T78,'*') ASA06090 99 FORMAT (T30,'STRUCTURE CURRENTS') ASA06100 100 FORMAT (T30,'FAR FIELDS FOR PHI VARYING FROM',1X,F5.1,' TO ',F5.1,ASA06110 1 'AND THETA VARYING FROM ',F5.1,' TO ',F5.1/ ASA06120 2T50,'IN STEPS OF ',F5.1,' DEGREES.') ASA06130 101 FORMAT (T30,'BACKSCATTERING FOR PHI VARYING FROM ',F5.1,' TO ',F5.ASA06140 11,' AND THETA VARYING FROM ',F5.1,' TO ',F5.1/ ASA06150 2T50,'IN STEPS OF ',F5.1,' DEGREES.') ASA06160 102 FORMAT (T30,'BISTATIC SCATTERING FOR PHI VARYING FROM ',F5.1,' TO ASA06170 1',F5.1,' AND THETA VARYING FROM ',F5.1,' TO ',F5.1/ ASA06180 2T50,'IN STEPS OF ',F5.1,' DEGREES.') ASA06190 103 FORMAT (T30,'NEAR FIELDS FOR FOLLOWING POINTS (X,Y,Z)'/50(T40,3(E1ASA06200 11.5,5X))) ASA06210 104 FORMAT (T30,'PLOT FOR FAR FIELD THETA=',F5.1) ASA06220 105 FORMAT (T30,'PLOT FOR FAR FIELD PHI=',F5.1) ASA06230 106 FORMAT (T30,'PLOT FOR BISTATIC SCATTERING-FOR THETA=',F5.1) ASA06240 107 FORMAT (T30,'PLOT FOR BISTATIC SCATTERING FOR PHI=',F5.1) ASA06250 108 FORMAT (T30,'PLOT FOR BACKSCATTERING THETA=',F5.1) ASA06260 109 FORMAT (T30,'PLOT FOR BACKSCATTERING PHI=',F5.1) ASA06270 110 FORMAT (T30,'NO OUTPUT OR PLOTS REQUESTED') ASA06280 111 FORMAT (//) ASA06290 112 FORMAT (T50,'*',T78,'*'/T50,29('*')) ASA06300 113 FORMAT (T50,'*', 8X,'INPUT DATA ',T78,'*') ASA06310 114 FORMAT (T50,29('*')/T50,'*',T78,'*') ASA06320 115 FORMAT (10X,'SINCE THIS DATA BLOCK DOES NOT HAVE A TERMINATION CARASA06330 1D A CHANGE CARD IS ASSUMED') ASA06340 116 FORMAT (//10X,40('*')/10X,'THE DESCRIPTION AND THE GEOMETRY OF THEASA06350 1 STRUCTURE'/10X,'MUST BE STATED IN THE FIRST DATA BLOCK.'/10X,'***ASA06360 2* EXECUTION STOPPED ***') ASA06370 117 FORMAT (//10X,'NO PART OF THE WIRE STRUCTURE CAN LIE BELOW THE GROASA06380 1 UND PLANE.'/10X,'****EXECUTION STOPPED****') ASA06390 118 FORMAT (T50,'STRUCTURE LOADS'/T40,'NODE',16X,'OHMS'/T41,'NO.',12X ASA06400 1 ,'REAL',7X,'IMAGINARY'/(T41,I2,6X,2(4X,E11.5))) ASA06410 119 FORMAT (T50,'STRUCTURE LOADS'/T39,'SEGMENT',14X,'OHMS'/T41,'NO',12ASA06420 1X,'REAL',7X,'IMAGINARY'/(T41,I2,6X,2(4X,E11.5))) ASA06430 120 FORMAT (T50,'ANTENNA FEEDS'/T39,'SEGMENT',14X,'VOLTS'/T41,'NO.',12ASA06440 1X,'REAL',7X,'IMAGINARY'/(T41,I2,6X,2(4X,E11.5))) ASA06450 121 FORMAT (//T30,'THE NUMBER OF INTERVALS FOR CALCULATING THE ELEMENTASA06460 1S'/T30,'IN THE IMPEDANCE MATRIX WITH SIMPSONS-RULE INTEGRATION IS'ASA06470 2,/T30,I3,'. IF CLOSED FORM INTEGRATION IS REQUIRED SET INT=0'///)ASA06480 122 FORMAT (T30,'GROUND PLANE (NO/YES)',T85,'NO') ASA06490 123 FORMAT (T30,'GROUND PLANE (NO/YES)',T85,'YES') ASA06500 124 FORMAT (T30,'GROUND DIELECTRIC CONSTANT (RELATIVE)',T81,E11.5/ ASA06510 1 T30,'GROUND CONDUCTIVITY (MHOS/METER)',T81,E11.5) ASA06520 125 FORMAT (T30,'GROUND PLANE',T83,'PERFECT') ASA06530 126 FORMAT (T30,'ANTENNA HEIGHT (METERS)',T81,E11.5) ASA06540 127 FORMAT (//10X,40('*')/10X,'THE WIRE RADIUS MUST BE STATED'/10X,40(ASA06550 1'*')) ASA06560 END ASA06570 SUBROUTINE BLNK (A) ASA06580 DIMENSION A(80) ASA06590 DATA BLANK/' '/ ASA06600 K = 0 ASA06610 C ASA06620 DO 1 I=1,80 ASA06630 J = I-K ASA06640 A(J) = A(I) ASA06650 1 IF (A(I).EQ.BLANK) K=K+1 ASA06660 C ASA06670 IF (K.EQ.0) RETURN ASA06680 A(81-K) = BLANK ASA06690 RETURN ASA06700 END ASA06710 SUBROUTINE CBES (Z,B01) ASA06720 COMPLEX ARG,CC,CS,EX ASA06730 COMPLEX B01,Z,TERMJ,TERMN,MZ24,JN(2) ASA06740 DATA PI/3.14159/ ASA06750 IF (CABS(Z).GE.12.0) GO TO 4 ASA06760 FACTOR = 0.0 ASA06770 TERMN = (0.,0.) ASA06780 MZ24 = -0.25*Z*Z ASA06790 TERMJ = (1.0,0.0) ASA06800 C ASA06810 DO 3 NP=1,2 ASA06820 N = NP-1 ASA06830 JN(NP) = TERMJ ASA06840 M = 0 ASA06850 1 M = M+1 ASA06860 TERMJ = TERMJ*MZ24/FLOAT(M*(N+M)) ASA06870 JN(NP) = JN(NP)+TERMJ ASA06880 IF (NP.NE.1) GO TO 2 ASA06890 FACTOR = FACTOR+1.0/FLOAT(M) ASA06900 TERMN = TERMN+TERMJ*FACTOR ASA06910 2 ERROR = CABS(TERMJ) ASA06920 IF (ERROR.GT.1.0E-10) GO TO 1 ASA06930 3 TERMJ = 0.5*Z ASA06940 C ASA06950 B01 = JN(1)/JN(2) ASA06960 RETURN ASA06970 4 Y = AIMAG(Z) ASA06980 IF (ABS(Y).GT.20.) GO TO 5 ASA06990 ARG = (.0,1.)*Z ASA07000 EX = CEXP(ARG) ASA07010 CC = EX+1./EX ASA07020 CS = (.0,-1.)*(EX-1./EX) ASA07030 B01 = (CS+CC)/(CS-CC) ASA07040 RETURN ASA07050 5 B01 = (.0,-1.) ASA07060 IF (Y.LT.0.) B01 = (.0,1.) ASA07070 RETURN ASA07080 END ASA07090 SUBROUTINE DSHELL (AM,BM,DK,CGDS,SGDS,EP2,EP,ETA,GAM,P11,P12) ASA07100 COMPLEX CGDS,SGDS,EP2,EP,ETA,GAM,P11,P12,GD,CST ASA07110 DATA PI/3.14159/ ASA07120 GD = GAM*DK ASA07130 CST = (EP2-EP)*ETA*ALOG(BM/AM)/(4.*PI*EP2*SGDS*SGDS) ASA07140 P11 = -CST*(GD+SGDS*CGDS) ASA07150 P12 = CST*(GD*CGDS+SGDS) ASA07160 RETURN ASA07170 END ASA07180 SUBROUTINE EQUAL (N) ASA07190 INTEGER A,EQULS ASA07200 COMMON /A/ A(80) ASA07210 DATA EQULS/'='/ ASA07220 K = N ASA07230 C ASA07240 DO 1 I=K,80 ASA07250 N = I+1 ASA07260 IF (A(I).EQ.EQULS) GO TO 2 ASA07270 1 CONTINUE ASA07280 C ASA07290 N = 1 ASA07300 2 RETURN ASA07310 END ASA07320 SUBROUTINE EXPJ (V1,V2,W12) ASA07330 COMPLEX EC,E15,S,T,UC,VC,V1,V2,W12,Z ASA07340 DIMENSION V(21), W(21), D(16), E(16) ASA07350 DATA V/0.22284667E00,0.11889321E01,0.29927363E01,0.57751436E01,0.9ASA07360 18374674E01,0.15982874E02,0.93307812E-01,0.49269174E00,0.12155954E0ASA07370 21,0.22699495E01,0.36676227E01,0.54253366E01,0.75659162E01,0.101202ASA07380 328E02,0.13130282E02,0.16654408E02,0.20776479E02,0.25623894E02,0.31ASA07390 4407519E02,0.38530683E02,0.48026086E02/ ASA07400 DATA W/0.45896460E00,0.41700083E00,0.11337338E00,0.10399197E-01,0.ASA07410 126101720E-03,0.89854791E-06,0.21823487E00,0.34221017E00,0.26302758ASA07420 2E00,0.12642582E00,0.40206865E-01,0.85638778E-02,0.12124361E-02,0.1ASA07430 31167440E-03,0.64599267E-05,0.22263169E-06,0.42274304E-08,0.3921897ASA07440 43E-10,0.14565152E-12,0.14830270E-15,0.16005949E-19/ ASA07450 DATA D/0.22495842E02,0.74411568E02,-0.41431576E03,-0.78754339E02,0ASA07460 1.11254744E02,0.16021761E03,-0.23862195E03,-0.50094687E03,-0.684878ASA07470 254E02,0.12254778E02,-0.10161976E02,-0.47219591E01,0.79729681E01,-0ASA07480 3.21069574E02,0.22046490E01,0.89728244E01/ ASA07490 DATA E/0.21103107E02,-0.37959787E03,-0.97489220E02,0.12900672E03,0ASA07500 1.17949226E02,-0.12910931E03,-0.55705574E03,0.13524801E02,0.1469672ASA07510 21E03,0.17949528E02,-0.32981014E00,0.31028836E02,0.81657657E01,0.22ASA07520 3236961E02,0.39124892E02,0.81636799E01/ ASA07530 Z = V1 ASA07540 C ASA07550 DO 12 JIM=1,2 ASA07560 X = REAL(Z) ASA07570 Y = AIMAG(Z) ASA07580 E15 = (.0,.0) ASA07590 AB = CABS(Z) ASA07600 IF (AB.EQ.0.) GO TO 11 ASA07610 IF (X.GE.0..AND.AB.GT.10.) GO TO 10 ASA07620 YA = ABS(Y) ASA07630 IF (X.LE.0..AND.YA.GT.10.) GO TO 10 ASA07640 IF (YA-X.GE.17.5.OR.YA.GE.6.5.OR.X+YA.GE.5.5.OR.X.GE.3.) GO TO 2 ASA07650 IF (X.LE.-9.) GO TO 6 ASA07660 IF (YA-X.GE.2.5) GO TO 7 ASA07670 IF (X+YA.GE.1.5) GO TO 3 ASA07680 N = 6.+3.*AB ASA07690 E15 = 1./(N-1.)-Z/N**2 ASA07700 1 N = N-1 ASA07710 E15 = 1./(N-1.)-Z*E15/N ASA07720 IF (N.GE.3) GO TO 1 ASA07730 E15 = Z*E15-CMPLX(.577216+ALOG(AB),ATAN2(Y,X)) ASA07740 GO TO 11 ASA07750 2 J1 = 1 ASA07760 J2 = 6 ASA07770 GO TO 4 ASA07780 3 J1 = 7 ASA07790 J2 = 21 ASA07800 4 S = (.0,.0) ASA07810 YS = Y*Y ASA07820 C ASA07830 DO 5 I=J1,J2 ASA07840 XI = V(I)+X ASA07850 CF = W(I)/(XI*XI+YS) ASA07860 5 S = S+CMPLX(XI*CF,-YA*CF) ASA07870 C ASA07880 GO TO 9 ASA07890 6 T3 = X*X-Y*Y ASA07900 T4 = 2.*X*YA ASA07910 T5 = X*T3-YA*T4 ASA07920 T6 = X*T4+YA*T3 ASA07930 UC = CMPLX(D(11)+D(12)*X+D(13)*T3+T5-E(12)*YA-E(13)*T4,E(11)+E(12)ASA07940 1*X+E(13)*T3+T6+D(12)*YA+D(13)*T4) ASA07950 VC = CMPLX(D(14)+D(15)*X+D(16)*T3+T5-E(15)*YA-E(16)*T4,E(14)+E(15)ASA07960 1*X+E(16)*T3+T6+D(15)*YA+D(16)*T4) ASA07970 GO TO 8 ASA07980 7 T3 = X*X-Y*Y ASA07990 T4 = 2.*X*YA ASA08000 T5 = X*T3-YA*T4 ASA08010 T6 = X*T4+YA*T3 ASA08020 T7 = X*T5-YA*T6 ASA08030 T8 = X*T6+YA*T5 ASA08040 T9 = X*T7-YA*T8 ASA08050 T10 = X*T8+YA*T7 ASA08060 UC = CMPLX(D(1)+D(2)*X+D(3)*T3+D(4)*T5+D(5)*T7+T9-(E(2)*YA+E(3)*T4ASA08070 1+E(4)*T6+E(5)*T8),E(1)+E(2)*X+E(3)*T3+E(4)*T5+E(5)*T7+T10+(D(2)*YAASA08080 2+D(3)*T4+D(4)*T6+D(5)*T8)) ASA08090 VC = CMPLX(D(6)+D(7)*X+D(8)*T3+D(9)*T5+D(10)*T7+T9-(E(7)*YA+E(8)*TASA08100 14+E(9)*T6+E(10)*T8),E(6)+E(7)*X+E(8)*T3+E(9)*T5+E(10)*T7+T10+(D(7)ASA08110 2*YA+D(8)*T4+D(9)*T6+D(10)*T8)) ASA08120 8 EC = UC/VC ASA08130 S = EC/CMPLX(X,YA) ASA08140 9 EX = EXP(-X) ASA08150 T = EX*CMPLX(COS(YA),-SIN(YA)) ASA08160 E15 = S*T ASA08170 IF (Y.LT.0.) E15 = CONJG(E15) ASA08180 GO TO 11 ASA08190 10 E15 = .409319/(Z+.193044)+.421831/(Z+1.02666)+.147126/(Z+2.56788)+ASA08200 1.206335E-1/(Z+4.90035)+.107401E-2/(Z+8.18215)+.158654E-4/(Z+12.734ASA08210 22)+.317031E-7/(Z+19.3957) ASA08220 E15 = E15*CEXP(-Z) ASA08230 11 IF (JIM.EQ.1) W12 = E15 ASA08240 12 Z = V2 ASA08250 C ASA08260 Z = V2/V1 ASA08270 TH = ATAN2(AIMAG(Z),REAL(Z))-ATAN2(AIMAG(V2),REAL(V2))+ATAN2(AIMAGASA08280 1(V1),REAL(V1)) ASA08290 AB = ABS(TH) ASA08300 IF (AB.LT.1.) TH = .0 ASA08310 IF (TH.GT.1.) TH = 6.2831853 ASA08320 IF (TH.LT.-1.) TH = -6.2831853 ASA08330 W12 = W12-E15+CMPLX(.0,TH) ASA08340 RETURN ASA08350 END ASA08360 SUBROUTINE GANT1 (IA,IB,INM,IWR,I1,I2,I3,I12,JA,JB,MD,N,ND,NM,AM,CASA08370 1,CJ,CG,CMM,D,EFF,GAM,GG,CGD,SGD,VG,Y11,Z11,ZLD,ZS,IGRD) ASA08380 COMPLEX YY,CGEN ASA08390 COMPLEX C(1),CJ(1),CGD(1),SGD(1),VG(1),ZLD(1),Y11,Z11,ZS,GAM,CG(1)ASA08400 DIMENSION D(1), IA(1), IB(1), JA(1), JB(1) ASA08410 DIMENSION I1(1), I2(1), I3(1), MD(INM,4), ND(1) ASA08420 COMMON IWL ASA08430 C ASA08440 DO 3 I=1,N ASA08450 CJ(I) = (.0,.0) ASA08460 K = JA(I) ASA08470 C ASA08480 C ASA08490 DO 2 KK=1,2 ASA08500 KA = IA(K) ASA08510 KB = IB(K) ASA08520 JJ = K ASA08530 FI = 1. ASA08540 IF (KB.EQ.I2(I)) GO TO 1 ASA08550 IF (KB.EQ.I1(I)) FI=-1. ASA08560 CJ(I) = CJ(I)+FI*VG(JJ) ASA08570 GO TO 2 ASA08580 1 IF (KA.EQ.I3(I)) FI=-1. ASA08590 JJ = K+NM ASA08600 CJ(I) = CJ(I)+FI*VG(JJ) ASA08610 2 K = JB(I) ASA08620 C ASA08630 C ASA08640 3 CONTINUE ASA08650 C ASA08660 C ASA08670 C ASA08680 C ASA08690 DO 4 I=1,N ASA08700 4 CG(I) = CJ(I) ASA08710 C ASA08720 C ASA08730 CALL SQROT (C,CJ,0,I12,N) ASA08740 I12 = 2 ASA08750 Y11 = (.0,.0) ASA08760 NNN = N ASA08770 IF (IGRD.GT.0) NNN=(N+IWL)/2 ASA08780 C ASA08790 C ASA08800 DO 6 I=1,NNN ASA08810 NN = IA(JB(I)) ASA08820 CGEN=CG(I) ASA08830 IF (I.LE.IWL) CGEN=CGEN/2. ASA08840 YY=CJ(I)*CONJG(CGEN) ASA08850 IF (CABS(YY).LT.1.E-20) GO TO 5 ASA08860 Z11=(1./YY)*(CABS(CGEN)**2) ASA08870 WRITE (6,8) NN,Z11 ASA08880 5 Y11 = Y11+YY ASA08890 6 CONTINUE ASA08900 C ASA08910 C ASA08920 IF (IWR.GT.0) WRITE (6,7) ASA08930 CALL RITE (IA,IB,INM,IWR,I1,I2,I3,MD,ND,NM,CJ,CG,IGRD) ASA08940 GG = REAL(Y11) ASA08950 IF (IGRD.GT.0) GG=2.*REAL(Y11) ASA08960 PIN = GG ASA08970 CALL GDISS (AM,CG,CMM,D,DISS,GAM,NM,SGD,ZLD,ZS) ASA08980 PRAD = PIN-DISS ASA08990 EFF = 100.*PRAD/PIN ASA09000 RETURN ASA09010 C ASA09020 C ASA09030 7 FORMAT (50X,'ANTENNA BRANCH CURRENTS') ASA09040 8 FORMAT (10X,'THE INPUT IMPEDANCE AT NODE ',I3,' IS',F15.7,' + J', ASA09050 1F15.7//) ASA09060 END ASA09070 SUBROUTINE GDISS (AM,CG,CMM,D,DISS,GAM,NM,SGD,ZLD,ZS) ASA09080 COMPLEX CG(1),SGD(1),ZLD(1),CJA,CJB,GAM,ZS ASA09090 DIMENSION D(1) ASA09100 DATA PI/3.14159/ ASA09110 DISS = .0 ASA09120 IF (CMM.LE.0.) GO TO 2 ASA09130 ALPH = REAL(GAM) ASA09140 BETA = AIMAG(GAM) ASA09150 RH = REAL(ZS)/(4.*PI*AM) ASA09160 C ASA09170 DO 1 K=1,NM ASA09180 DK = D(K) ASA09190 DEN = CABS(SGD(K))**2 ASA09200 EAD = EXP(ALPH*DK) ASA09210 CAD = (EAD+1./EAD)/2. ASA09220 CBD = COS(BETA*DK) ASA09230 SAD = DK ASA09240 IF (ALPH.NE.0.) SAD=(EAD-1./EAD)/(2.*ALPH) ASA09250 SBD = DK ASA09260 IF (BETA.NE.0.) SBD=SIN(BETA*DK)/BETA ASA09270 FA = RH*(SAD*CAD-SBD*CBD)/DEN ASA09280 FB = 2.*RH*(CAD*SBD-SAD*CBD)/DEN ASA09290 CJA = CG(K) ASA09300 L = K+NM ASA09310 CJB = CG(L) ASA09320 1 DISS = DISS+FA*(CABS(CJA)**2+CABS(CJB)**2)+FB*(REAL(CJA)*REAL(CJB)ASA09330 1+AIMAG(CJA)*AIMAG(CJB)) ASA09340 C ASA09350 C ASA09360 2 DO 3 J=1,NM ASA09370 K = J+NM ASA09380 3 DISS = DISS+REAL(ZLD(J))*(CABS(CG(J))**2)+REAL(ZLD(K))*(CABS(CG(K)ASA09390 1)**2) ASA09400 C ASA09410 RETURN ASA09420 END ASA09430 SUBROUTINE GFF (XA,YA,ZA,XB,YB,ZB,D,CGD,SGD,CTH,STH,CPH,SPH,GAM,ETASA09440 1A,ET1,ET2,EP1,EP2,IGRD,ERR) ASA09450 COMPLEX ERR,RV,RH,RR,EX,EY,EZ,EE ASA09460 COMPLEX ET1,ET2,EP1,EP2,GAM,ETA ASA09470 COMPLEX GD,CGD,SGD,EGD ASA09480 COMPLEX EGFA,EGFB,EGGD,ESA,ESB ASA09490 COMPLEX CST ASA09500 FP = 12.56637 ASA09510 XAB = XB-XA ASA09520 YAB = YB-YA ASA09530 ZAB = ZB-ZA ASA09540 CA = XAB/D ASA09550 CB = YAB/D ASA09560 CG = ZAB/D ASA09570 G = (CA*CPH+CB*SPH)*STH+CG*CTH ASA09580 GK = 1.-G*G ASA09590 ET1 = (.0,.0) ASA09600 ET2 = (.0,.0) ASA09610 EP1 = (.0,.0) ASA09620 EP2 = (.0,.0) ASA09630 IF (GK.LT..001) GO TO 3 ASA09640 FA = (XA*CPH+YA*SPH)*STH+ZA*CTH ASA09650 FB = (XB*CPH+YB*SPH)*STH+ZB*CTH ASA09660 EGFA = CEXP(GAM*FA) ASA09670 EGFB = CEXP(GAM*FB) ASA09680 EGGD = CEXP(GAM*G*D) ASA09690 CST = ETA/(GK*SGD*FP) ASA09700 ESA = CST*EGFA*(EGGD-G*SGD-CGD) ASA09710 ESB = CST*EGFB*(1./EGGD+G*SGD-CGD) ASA09720 IF (IGRD.LE.0) GO TO 2 ASA09730 RV = (-1.,0.) ASA09740 RH = (-1.,0.) ASA09750 IF (IGRD.EQ.1) GO TO 1 ASA09760 RR = CSQRT(ERR-STH*STH) ASA09770 RV = -(ERR*CTH-RR)/(ERR*CTH+RR) ASA09780 RH = (CTH-RR)/(CTH+RR) ASA09790 1 EX = CA*ESA ASA09800 EY = CB*ESA ASA09810 EZ = CG*ESA ASA09820 EE = (EX*SPH-EY*CPH)*(RH-RV) ASA09830 EX = EX*RV+EE*SPH ASA09840 EY = EY*RV-EE*CPH ASA09850 EZ = -EZ*RV ASA09860 ESA=-EX*CA-EY*CB+EZ*CG ASA09870 EX = CA*ESB ASA09880 EY = CB*ESB ASA09890 EZ = CG*ESB ASA09900 EE = (EX*SPH-EY*CPH)*(RH-RV) ASA09910 EX = EX*RV+EE*SPH ASA09920 EY = EY*RV-EE*CPH ASA09930 EZ = -EZ*RV ASA09940 ESB=-EX*CA-EY*CB+EZ*CG ASA09950 2 T = (CA*CPH+CB*SPH)*CTH-CG*STH ASA09960 P = -CA*SPH+CB*CPH ASA09970 ET1 = T*ESA ASA09980 ET2 = T*ESB ASA09990 EP1 = P*ESA ASA10000 EP2 = P*ESB ASA10010 3 CONTINUE ASA10020 RETURN ASA10030 END ASA10040 SUBROUTINE GFFLD (IA,IB,INC,INM,IWR,I1,I2,I3,I12,MD,N,ND,NM,AM,ACSASA10050 1P,ACST,C,CGD,CG,CJ,CMM,D,ECSP,ECST,EP,ET,EPP,ETT,EPPS,EPTS,ETPS,ETASA10060 2TS,GG,GPP,GTT,PH,SGD,SCSP,SCST,SPPM,SPTM,STPM,STTM,TH,X,Y,Z,ZLD,ZSASA10070 3,ETA,GAM,ERR,IGRD) ASA10080 COMPLEX ERR ASA10090 COMPLEX CJI,ET1,ET2,EP1,EP2,EPPS,ETTS,EPTS,ETPS,ZS,VP,VT ASA10100 COMPLEX C(1),CJ(1),EP(1),ET(1),EPP(1),ETT(1),ZLD(1) ASA10110 COMPLEX ETA,GAM,CGD(1),SGD(1),CG(1) ASA10120 DIMENSION IA(1), IB(1), I1(1), I2(1), I3(1), ND(1), MD(INM,4) ASA10130 DIMENSION D(1), X(1), Y(1), Z(1) ASA10140 DATA PI,TP/3.14159,6.28318/ ASA10150 CJI = -4.*PI/(ETA*GAM) ASA10160 GGG = REAL(1./ETA) ASA10170 THR = .0174533*TH ASA10180 CTH = COS(THR) ASA10190 STH = SIN(THR) ASA10200 PHR = .0174533*PH ASA10210 CPH = COS(PHR) ASA10220 SPH = SIN(PHR) ASA10230 C ASA10240 DO 1 I=1,N ASA10250 ETT(I) = (.0,.0) ASA10260 1 EPP(I) = (.0,.0) ASA10270 C ASA10280 C ASA10290 DO 3 K=1,NM ASA10300 KA = IA(K) ASA10310 KB = IB(K) ASA10320 NGRD = IGRD ASA10330 IF (K.LE.NM/2) IGRD=-1 ASA10340 CALL GFF (X(KA),Y(KA),Z(KA),X(KB),Y(KB),Z(KB),D(K),CGD(K),SGD(K),CASA10350 1TH,STH,CPH,SPH,GAM,ETA,ET1,ET2,EP1,EP2,IGRD,ERR) ASA10360 IGRD = NGRD ASA10370 NDK = ND(K) ASA10380 C ASA10390 DO 3 II=1,NDK ASA10400 I = MD(K,II) ASA10410 FI = 1. ASA10420 IF (KB.EQ.I2(I)) GO TO 2 ASA10430 IF (KB.EQ.I1(I)) FI=-1. ASA10440 EPP(I) = EPP(I)+FI*EP1 ASA10450 ETT(I) = ETT(I)+FI*ET1 ASA10460 GO TO 3 ASA10470 2 IF (KA.EQ.I3(I)) FI=-1. ASA10480 EPP(I) = EPP(I)+FI*EP2 ASA10490 ETT(I) = ETT(I)+FI*ET2 ASA10500 3 CONTINUE ASA10510 C ASA10520 EPPS = (.0,.0) ASA10530 ETTS = (.0,.0) ASA10540 IF (INC.EQ.0) GO TO 8 ASA10550 IF (INC.EQ.2) GO TO 6 ASA10560 C ASA10570 DO 4 I=1,N ASA10580 ET(I) = ETT(I)*CJI ASA10590 4 EP(I) = EPP(I)*CJI ASA10600 C ASA10610 CALL SQROT (C,EP,0,I12,N) ASA10620 I12 = 2 ASA10630 CALL SQROT (C,ET,0,I12,N) ASA10640 IF (IWR.GT.0) WRITE (6,10) PH,TH ASA10650 IF (IWR.GT.0) WRITE (6,11) ASA10660 CALL RITE (IA,IB,INM,IWR,I1,I2,I3,MD,ND,NM,EP,CG,IGRD) ASA10670 CALL GDISS (AM,CG,CMM,D,PDIS,GAM,NM,SGD,ZLD,ZS) ASA10680 IF (IWR.GT.0) WRITE (6,12) ASA10690 CALL RITE (IA,IB,INM,IWR,I1,I2,I3,MD,ND,NM,ET,CG,IGRD) ASA10700 CALL GDISS (AM,CG,CMM,D,TDIS,GAM,NM,SGD,ZLD,ZS) ASA10710 ACSP = PDIS/GGG ASA10720 ACST = TDIS/GGG ASA10730 PIN = .0 ASA10740 TIN = .0 ASA10750 C ASA10760 DO 5 I=1,N ASA10770 VP = CJI*EPP(I) ASA10780 VT = CJI*ETT(I) ASA10790 PIN = PIN+REAL(VP*CONJG(EP(I))) ASA10800 5 TIN = TIN+REAL(VT*CONJG(ET(I))) ASA10810 C ASA10820 ECSP = PIN/GGG ASA10830 ECST = TIN/GGG ASA10840 SCSP = ECSP-ACSP ASA10850 SCST = ECST-ACST ASA10860 6 EPTS = (.0,.0) ASA10870 ETPS = (.0,.0) ASA10880 C ASA10890 DO 7 I=1,N ASA10900 EPPS = EPPS+EP(I)*EPP(I) ASA10910 EPTS = EPTS+EP(I)*ETT(I) ASA10920 ETTS = ETTS+ET(I)*ETT(I) ASA10930 7 ETPS = ETPS+ET(I)*EPP(I) ASA10940 C ASA10950 SPPM = 2.*TP*(CABS(EPPS)**2) ASA10960 SPTM = 2.*TP*(CABS(EPTS)**2) ASA10970 STPM = 2.*TP*(CABS(ETPS)**2) ASA10980 STTM = 2.*TP*(CABS(ETTS)**2) ASA10990 RETURN ASA11000 C ASA11010 8 DO 9 I=1,N ASA11020 ETTS = ETTS+CJ(I)*ETT(I) ASA11030 9 EPPS = EPPS+CJ(I)*EPP(I) ASA11040 C ASA11050 APP = CABS(EPPS) ASA11060 ATT = CABS(ETTS) ASA11070 GPP = 4.*PI*APP*APP*GGG/GG ASA11080 GTT = 4.*PI*ATT*ATT*GGG/GG ASA11090 RETURN ASA11100 C ASA11110 10 FORMAT (10X,'BRANCH CURRENTS ASSOCIATED WITH PLANE-WAVE SCATTERINGASA11120 1 FOR THE INCIDENT ANGLES, PHI=',F5.1,' AND THETA=',F5.1//) ASA11130 11 FORMAT (44X,'CURRENTS INDUCED BY THE PHI POLARIZED WAVE') ASA11140 12 FORMAT (44X,'CURRENTS INDUCED BY THE THETA POLARIZED WAVE') ASA11150 END ASA11160 SUBROUTINE GGS (XA,YA,ZA,XB,YB,ZB,X1,Y1,Z1,X2,Y2,Z2,AM,DS,CGDS,SGDASA11170 1S,DT,SGDT,INT,ETA,GAM,P11,P12,P21,P22,ERR,IGRD) ASA11180 COMPLEX EX1,EY1,EX2,EY2,EZ1,EZ2 ASA11190 COMPLEX P11,P12,P21,P22,EJA,EJB,EJ1,EJ2,ETA,GAM,C1,C2,CST ASA11200 COMPLEX EGD,CGDS,SGDS,SGDT,ER1,ER2,ET1,ET2 ASA11210 COMPLEX ERR ASA11220 COMPLEX EE,EXX,EYY ASA11230 COMPLEX PP,PX,PY,PZ ASA11240 COMPLEX RR1,RR2,RR3,RR4,RH1,RV1,RH2,RV2,RH3,RV3,RH4,RV4 ASA11250 DATA FP/12.56637/ ASA11260 CA = (X2-X1)/DT ASA11270 CB = (Y2-Y1)/DT ASA11280 CG = (Z2-Z1)/DT ASA11290 CAS = (XB-XA)/DS ASA11300 CBS = (YB-YA)/DS ASA11310 CGS = (ZB-ZA)/DS ASA11320 CC = CA*CAS+CB*CBS+CG*CGS ASA11330 IF ((CG.LE..003).AND.(CGS.LE..003).AND.(IGRD.GT.0)) GO TO 1 ASA11340 IF (ABS(CC).GT..997) GO TO 6 ASA11350 1 SZ = (X1-XA)*CAS+(Y1-YA)*CBS+(Z1-ZA)*CGS ASA11360 IF (INT.LE.0) GO TO 7 ASA11370 INS = 2*(INT/2) ASA11380 IF (INS.LT.2) INS = 2 ASA11390 IP = INS+1 ASA11400 DELT = DT/INS ASA11410 T = .0 ASA11420 DSZ = CC*DELT ASA11430 P11 = (.0,.0) ASA11440 P12 = (.0,.0) ASA11450 P21 = (.0,.0) ASA11460 P22 = (.0,.0) ASA11470 AMS = AM*AM ASA11480 SGN = -1. ASA11490 C ASA11500 C ASA11510 DO 5 IN=1,IP ASA11520 ZZ1 = SZ ASA11530 ZZ2 = SZ-DS ASA11540 XXZ = X1+T*CA-XA-SZ*CAS ASA11550 YYZ = Y1+T*CB-YA-SZ*CBS ASA11560 ZZZ = Z1+T*CG-ZA-SZ*CGS ASA11570 RS = XXZ**2+YYZ**2+ZZZ**2 ASA11580 R1 = SQRT(RS+ZZ1**2) ASA11590 EJA = CEXP(-GAM*R1) ASA11600 EJ1 = EJA/R1 ASA11610 R2 = SQRT(RS+ZZ2**2) ASA11620 EJB = CEXP(-GAM*R2) ASA11630 EJ2 = EJB/R2 ASA11640 ER1 = EJA*SGDS+ZZ1*EJ1*CGDS-ZZ2*EJ2 ASA11650 ER2 = -EJB*SGDS+ZZ2*EJ2*CGDS-ZZ1*EJ1 ASA11660 FAC = .0 ASA11670 IF (RS.GT.AMS) FAC = (CA*XXZ+CB*YYZ+CG*ZZZ)/RS ASA11680 ET1 = CC*(EJ2-EJ1*CGDS)+FAC*ER1 ASA11690 ET2 = CC*(EJ1-EJ2*CGDS)+FAC*ER2 ASA11700 IF (IGRD.LT.0) GO TO 4 ASA11710 RV1 = (-1.,0.) ASA11720 RH1 = (-1.,0.) ASA11730 RV2 = (-1.,0.) ASA11740 RH2 = (-1.,0.) ASA11750 IF (IGRD.EQ.1) GO TO 2 ASA11760 XG1 = X1+T*CA-XA ASA11770 YG1 = Y1+T*CB-YA ASA11780 ZG1 = Z1+T*CG-ZA ASA11790 XG2 = X1+T*CA-XB ASA11800 YG2 = Y1+T*CB-YB ASA11810 ZG2 = Z1+T*CG-ZB ASA11820 RG1 = SQRT(XG1*XG1+YG1*YG1) ASA11830 RG2 = SQRT(XG2*XG2+YG2*YG2) ASA11840 TT1 = ATAN(RG1/ZG1) ASA11850 TT2 = ATAN(RG2/ZG2) ASA11860 CTH1 = COS(TT1) ASA11870 SSTH1 = SIN(TT1)*SIN(TT1) ASA11880 CTH2 = COS(TT2) ASA11890 SSTH2 = SIN(TT2)*SIN(TT2) ASA11900 RR1 = CSQRT(ERR-SSTH1) ASA11910 RH1 = (CTH1-RR1)/(CTH1+RR1) ASA11920 RV1 = -(ERR*CTH1-RR1)/(ERR*CTH1+RR1) ASA11930 RR2 = CSQRT(ERR-SSTH2) ASA11940 RH2 = (CTH2-RR2)/(CTH2+RR2) ASA11950 RV2 = -(ERR*CTH2-RR2)/(ERR*CTH2+RR2) ASA11960 2 RG = SQRT((XB-XA)*(XB-XA)+(YB-YA)*(YB-YA)) ASA11970 CPH = 0 ASA11980 SPH = 0 ASA11990 IF (RG.LT.1.E-32) GO TO 3 ASA12000 CPH = (XB-XA)/RG ASA12010 SPH = (YB-YA)/RG ASA12020 3 EXX = ET1*CAS ASA12030 EYY = ET1*CBS ASA12040 EE = (EXX*SPH-EYY*CPH)*(RH1-RV1) ASA12050 EX1 = EXX*RV1+EE*SPH ASA12060 EY1 = EYY*RV1-EE*CPH ASA12070 EZ1 = -ET1*RV1*CGS ASA12080 ET1=-EX1*CAS-EY1*CBS+EZ1*CGS ASA12090 EXX = ET2*CAS ASA12100 EYY = ET2*CBS ASA12110 EE = (EXX*SPH-EYY*CPH)*(RH2-RV2) ASA12120 EX2 = EXX*RV2+EE*SPH ASA12130 EY2 = EYY*RV2-EE*CPH ASA12140 EZ2 = -ET2*CGS*RV2 ASA12150 ET2=-EX2*CAS-EY2*CBS+EZ2*CGS ASA12160 4 C = 3.+SGN ASA12170 IF (IN.EQ.1.OR.IN.EQ.IP) C=1. ASA12180 EGD = CEXP(GAM*(DT-T)) ASA12190 C1 = C*(EGD-1./EGD)/2. ASA12200 EGD = CEXP(GAM*T) ASA12210 C2 = C*(EGD-1./EGD)/2. ASA12220 P11 = P11+ET1*C1 ASA12230 P12 = P12+ET1*C2 ASA12240 P21 = P21+ET2*C1 ASA12250 P22 = P22+ET2*C2 ASA12260 T = T+DELT ASA12270 SZ = SZ+DSZ ASA12280 5 SGN = -SGN ASA12290 C ASA12300 C ASA12310 CST = -ETA*DELT/(3.*FP*SGDS*SGDT) ASA12320 P11 = CST*P11 ASA12330 P12 = CST*P12 ASA12340 P21 = CST*P21 ASA12350 P22 = CST*P22 ASA12360 RETURN ASA12370 6 SZ1 = (X1-XA)*CAS+(Y1-YA)*CBS+(Z1-ZA)*CGS ASA12380 DR1 = SQRT((X1-XA-SZ1*CAS)**2+(Y1-YA-SZ1*CBS)**2+(Z1-ZA-SZ1*CGS)**ASA12390 12) ASA12400 SZ2 = SZ1+DT*CC ASA12410 DR2 = SQRT((X2-XA-SZ2*CAS)**2+(Y2-YA-SZ2*CBS)**2+(Z2-ZA-SZ2*CGS)**ASA12420 12) ASA12430 DDD = (DR1+DR2)/2. ASA12440 IF (DDD.GT.20.*AM.AND.INT.GT.0) GO TO 1 ASA12450 IF (DDD.LT.AM) DDD = AM ASA12460 CALL GGMM (.0,DS,SZ1,SZ2,DDD,CGDS,SGDS,SGDT,1.,ETA,GAM,P11,P12,P21ASA12470 1,P22) ASA12480 IF (IGRD.LE.1) RETURN ASA12490 IF (IGRD.GT.1) GO TO 8 ASA12500 C ASA12510 7 SS = SQRT(1.-CC*CC) ASA12520 CAD = (CGS*CB-CBS*CG)/SS ASA12530 CBD = (CAS*CG-CGS*CA)/SS ASA12540 CGD = (CBS*CA-CAS*CB)/SS ASA12550 DK = (X1-XA)*CAD+(Y1-YA)*CBD+(Z1-ZA)*CGD ASA12560 DK = ABS(DK) ASA12570 IF (DK.LT.AM) DK = AM ASA12580 XZ = XA+SZ*CAS ASA12590 YZ = YA+SZ*CBS ASA12600 ZZ = ZA+SZ*CGS ASA12610 XP1 = X1-DK*CAD ASA12620 YP1 = Y1-DK*CBD ASA12630 ZP1 = Z1-DK*CGD ASA12640 CAP = CBS*CGD-CGS*CBD ASA12650 CBP = CGS*CAD-CAS*CGD ASA12660 CGP = CAS*CBD-CBS*CAD ASA12670 P1 = CAP*(XP1-XZ)+CBP*(YP1-YZ)+CGP*(ZP1-ZZ) ASA12680 T1 = P1/SS ASA12690 S1 = T1*CC-SZ ASA12700 CALL GGMM (S1,S1+DS,T1,T1+DT,DK,CGDS,SGDS,SGDT,CC,ETA,GAM,P11,P12,ASA12710 1P21,P22) ASA12720 RETURN ASA12730 C ASA12740 8 AMS = AM*AM ASA12750 RG = (X1-XA)*(X1-XA)+(Y1-YA)*(Y1-YA) ASA12760 IF (RG.LT.AMS) RG = AMS ASA12770 DG = SQRT((Z1-ZA)*(Z1-ZA)+RG) ASA12780 CPH = ABS(Z1-ZA)/DG ASA12790 SSPH=RG/(DG*DG) ASA12800 RR1 = CSQRT(ERR-SSPH) ASA12810 RV1 = -(ERR*CPH-RR1)/(ERR*CPH+RR1) ASA12820 P11=-P11*RV1 ASA12830 RG = (X1-XB)*(X1-XB)+(Y1-YB)*(Y1-YB) ASA12840 IF (RG.LT.AMS) RG = AMS ASA12850 DG = SQRT((Z1-ZB)*(Z1-ZB)+RG) ASA12860 CPH = ABS(Z1-ZB)/DG ASA12870 SSPH=RG/(DG*DG) ASA12880 RR1 = CSQRT(ERR-SSPH) ASA12890 RV1 = -(ERR*CPH-RR1)/(ERR*CPH+RR1) ASA12900 P12=-P12*RV1 ASA12910 RG = (X2-XA)*(X2-XA)+(Y2-YA)*(Y2-YA) ASA12920 IF (RG.LT.AMS) RG = AMS ASA12930 DG = SQRT((Z2-ZA)*(Z2-ZA)+RG) ASA12940 CPH = ABS(Z2-ZA)/DG ASA12950 SSPH=RG/(DG*DG) ASA12960 RR1 = CSQRT(ERR-SSPH) ASA12970 RV1 = -(ERR*CPH-RR1)/(ERR*CPH+RR1) ASA12980 P21=-P21*RV1 ASA12990 RG = (X2-XB)*(X2-XB)+(Y2-YB)*(Y2-YB) ASA13000 IF (RG.LT.AMS) RG = AMS ASA13010 DG = SQRT((Z2-ZB)*(Z2-ZB)+RG) ASA13020 CPH = ABS(Z2-ZB)/DG ASA13030 SSPH=RG/(DG*DG) ASA13040 RR1 = CSQRT(ERR-SSPH) ASA13050 RV1 = -(ERR*CPH-RR1)/(ERR*CPH+RR1) ASA13060 P22=-P22*RV1 ASA13070 RETURN ASA13080 END ASA13090 SUBROUTINE GGMM (S1,S2,T1,T2,D,CGDS,SGD1,SGD2,CPSI,ETA,GAM,P11,P12ASA13100 1,P21,P22) ASA13110 DOUBLE PRECISION R1,R2,DPQ,SIS,TS1,TS2,ST1,ST2,CD,BD,CPSS,SK,TL1,TASA13120 1L2,TD1,TD2,SDI,DPSI,DD,ZD ASA13130 COMPLEX CGDS,SGDS,SGDT,SGD1,SGD2,ETA,GAM,P11,P12,P21,P22 ASA13140 COMPLEX CST,EB,EC,EK,EL,EKL,EGZI,ES1,ES2,ET1,ET2,EXPA,EXPB ASA13150 COMPLEX E(2,2),F(2,2) ASA13160 COMPLEX EGZ(2,2),GM(2),GP(2) ASA13170 DATA PI/3.14159/ ASA13180 DSQ = D*D ASA13190 SGDS = SGD1 ASA13200 IF (S2.LT.S1) SGDS = -SGD1 ASA13210 SGDT = SGD2 ASA13220 IF (T2.LT.T1) SGDT = -SGD2 ASA13230 IF (ABS(CPSI).GT..997) GO TO 5 ASA13240 ES1 = CEXP(GAM*S1) ASA13250 ES2 = CEXP(GAM*S2) ASA13260 ET1 = CEXP(GAM*T1) ASA13270 ET2 = CEXP(GAM*T2) ASA13280 DD = D ASA13290 DPSI = CPSI ASA13300 TD1 = T1 ASA13310 TD2 = T2 ASA13320 CPSS = DPSI*DPSI ASA13330 CD = DD/DSQRT(1.D0-CPSS) ASA13340 C = CD ASA13350 BD = CD*DPSI ASA13360 B = BD ASA13370 EB = CEXP(GAM*CMPLX(.0,B)) ASA13380 EC = CEXP(GAM*CMPLX(.0,C)) ASA13390 C ASA13400 DO 1 K=1,2 ASA13410 C ASA13420 DO 1 L=1,2 ASA13430 1 E(K,L) = (.0,.0) ASA13440 C ASA13450 TS1 = TD1*TD1 ASA13460 TS2 = TD2*TD2 ASA13470 DPQ = DD*DD ASA13480 SI = S1 ASA13490 C ASA13500 DO 4 I=1,2 ASA13510 FI = (-1)**I ASA13520 SDI = SI ASA13530 SIS = SDI*SDI ASA13540 ST1 = 2.*SDI*TD1*DPSI ASA13550 ST2 = 2.*SDI*TD2*DPSI ASA13560 R1 = DSQRT(DPQ+SIS+TS1-ST1) ASA13570 R2 = DSQRT(DPQ+SIS+TS2-ST2) ASA13580 EK = EB ASA13590 C ASA13600 DO 3 K=1,2 ASA13610 FK = (-1)**K ASA13620 SK = FK*SDI ASA13630 EL = EC ASA13640 C ASA13650 DO 2 L=1,2 ASA13660 FL = (-1)**L ASA13670 EKL = EK*EL ASA13680 XX = FK*BD+FL*CD ASA13690 TL1 = FL*TD1 ASA13700 TL2 = FL*TD2 ASA13710 RR1 = R1+SK+TL1 ASA13720 RR2 = R2+SK+TL2 ASA13730 CALL EXPJ (GAM*CMPLX(RR1,-XX),GAM*CMPLX(RR2,-XX),EXPA) ASA13740 CALL EXPJ (GAM*CMPLX(RR1,XX),GAM*CMPLX(RR2,XX),EXPB) ASA13750 E(K,L) = E(K,L)+FI*(EXPA*EKL+EXPB/EKL) ASA13760 2 EL = 1./EC ASA13770 C ASA13780 3 EK = 1./EB ASA13790 C ASA13800 ZD = SDI*DPSI ASA13810 ZC = ZD ASA13820 EGZI = CEXP(GAM*ZC) ASA13830 RR1 = R1+ZD-TD1 ASA13840 RR2 = R2+ZD-TD2 ASA13850 CALL EXPJ (GAM*RR1,GAM*RR2,EXPB) ASA13860 RR1 = R1-ZD+TD1 ASA13870 RR2 = R2-ZD+TD2 ASA13880 CALL EXPJ (GAM*RR1,GAM*RR2,EXPA) ASA13890 F(I,1) = 2.*SGDS*EXPA/EGZI ASA13900 F(I,2) = 2.*SGDS*EXPB*EGZI ASA13910 4 SI = S2 ASA13920 C ASA13930 CST = ETA/(16.*PI*SGDS*SGDT) ASA13940 P11 = CST*((F(1,1)+E(2,2)*ES2-E(1,2)/ES2)*ET2+(-F(1,2)-E(2,1)*ES2+ASA13950 1E(1,1)/ES2)/ET2) ASA13960 P12 = CST*((-F(1,1)-E(2,2)*ES2+E(1,2)/ES2)*ET1+(F(1,2)+E(2,1)*ES2-ASA13970 1E(1,1)/ES2)/ET1) ASA13980 P21 = CST*((-F(2,1)-E(2,2)*ES1+E(1,2)/ES1)*ET2+(F(2,2)+E(2,1)*ES1-ASA13990 1E(1,1)/ES1)/ET2) ASA14000 P22 = CST*((F(2,1)+E(2,2)*ES1-E(1,2)/ES1)*ET1+(-F(2,2)-E(2,1)*ES1+ASA14010 1E(1,1)/ES1)/ET1) ASA14020 RETURN ASA14030 5 IF (CPSI.LT.0.) GO TO 6 ASA14040 TA = T1 ASA14050 TB = T2 ASA14060 GO TO 7 ASA14070 6 TA = -T1 ASA14080 TB = -T2 ASA14090 SGDT = -SGDT ASA14100 7 SI = S1 ASA14110 C ASA14120 DO 9 I=1,2 ASA14130 TJ = TA ASA14140 C ASA14150 DO 8 J=1,2 ASA14160 ZIJ = TJ-SI ASA14170 R = SQRT(DSQ+ZIJ*ZIJ) ASA14180 W = R+ZIJ ASA14190 IF (ZIJ.LT.0.) W = DSQ/(R-ZIJ) ASA14200 V = R-ZIJ ASA14210 IF (ZIJ.GT.0.) V = DSQ/(R+ZIJ) ASA14220 IF (J.EQ.1) V1 = V ASA14230 IF (J.EQ.1) W1 = W ASA14240 EGZ(I,J) = CEXP(GAM*ZIJ) ASA14250 8 TJ = TB ASA14260 C ASA14270 CALL EXPJ (GAM*V1,GAM*V,GP(I)) ASA14280 CALL EXPJ (GAM*W1,GAM*W,GM(I)) ASA14290 9 SI = S2 ASA14300 C ASA14310 CST = -ETA/(8.*PI*SGDS*SGDT) ASA14320 P11 = CST*(GM(2)*EGZ(2,2)+GP(2)/EGZ(2,2)-CGDS*(GM(1)*EGZ(1,2)+GP(1ASA14330 1)/EGZ(1,2))) ASA14340 P12 = CST*(-GM(2)*EGZ(2,1)-GP(2)/EGZ(2,1)+CGDS*(GM(1)*EGZ(1,1)+GP(ASA14350 11)/EGZ(1,1))) ASA14360 P21 = CST*(GM(1)*EGZ(1,2)+GP(1)/EGZ(1,2)-CGDS*(GM(2)*EGZ(2,2)+GP(2ASA14370 1)/EGZ(2,2))) ASA14380 P22 = CST*(-GM(1)*EGZ(1,1)-GP(1)/EGZ(1,1)+CGDS*(GM(2)*EGZ(2,1)+GP(ASA14390 12)/EGZ(2,1))) ASA14400 RETURN ASA14410 END ASA14420 SUBROUTINE GNF (XA,YA,ZA,XB,YB,ZB,X,Y,Z,AM,DS,CGDS,SGDS,ETA,GAM,EXASA14430 11,EY1,EZ1,EX2,EY2,EZ2,IGRD,ERR) ASA14440 COMPLEX ERR,RV1,RH1,RV2,RH2,RR1,RR2,EE ASA14450 COMPLEX EJA,EJB,EJ1,EJ2,ER1,ER2,ES1,ES2,SGDS,GAM,CST,CGDS,ETA ASA14460 COMPLEX EX1,EY1,EZ1,EX2,EY2,EZ2 ASA14470 DATA PI/3.14159/ ASA14480 CAS = (XB-XA)/DS ASA14490 CBS = (YB-YA)/DS ASA14500 CGS = (ZB-ZA)/DS ASA14510 SZ = (X-XA)*CAS+(Y-YA)*CBS+(Z-ZA)*CGS ASA14520 ZZ1 = SZ ASA14530 ZZ2 = SZ-DS ASA14540 XXZ = X-XA-SZ*CAS ASA14550 YYZ = Y-YA-SZ*CBS ASA14560 ZZZ = Z-ZA-SZ*CGS ASA14570 RS = XXZ**2+YYZ**2+ZZZ**2 ASA14580 R1 = SQRT(RS+ZZ1**2) ASA14590 EJA = CEXP(-GAM*R1) ASA14600 EJ1 = EJA/R1 ASA14610 R2 = SQRT(RS+ZZ2**2) ASA14620 EJB = CEXP(-GAM*R2) ASA14630 EJ2 = EJB/R2 ASA14640 ES1 = EJ2-EJ1*CGDS ASA14650 ES2 = EJ1-EJ2*CGDS ASA14660 ER1 = (.0,.0) ASA14670 ER2 = (.0,.0) ASA14680 AMS = AM*AM ASA14690 IF (RS.LT.AMS) GO TO 1 ASA14700 CTH1 = ZZ1/R1 ASA14710 CTH2 = ZZ2/R2 ASA14720 ER1 = (EJA*SGDS+EJA*CGDS*CTH1-EJB*CTH2)/RS ASA14730 ER2 = (-EJB*SGDS+EJB*CGDS*CTH2-EJA*CTH1)/RS ASA14740 1 CST = ETA/(4.*PI*SGDS) ASA14750 EX1 = CST*(ES1*CAS+ER1*XXZ) ASA14760 EY1 = CST*(ES1*CBS+ER1*YYZ) ASA14770 EZ1 = CST*(ES1*CGS+ER1*ZZZ) ASA14780 EX2 = CST*(ES2*CAS+ER2*XXZ) ASA14790 EY2 = CST*(ES2*CBS+ER2*YYZ) ASA14800 EZ2 = CST*(ES2*CGS+ER2*ZZZ) ASA14810 IF (IGRD.LE.0) RETURN ASA14820 RV1 = (-1.,0.) ASA14830 RH1 = (-1.,0.) ASA14840 RV2 = (-1.,0.) ASA14850 RH2 = (-1.,0.) ASA14860 IF (IGRD.EQ.1) GO TO 2 ASA14870 R1 = SQRT((XA-X)*(XA-X)+(YA-Y)*(YA-Y)) ASA14880 R2 = SQRT((XB-X)*(XB-X)+(YB-Y)*(YB-Y)) ASA14890 TH1 = ATAN(R1/(ZA-Z)) ASA14900 TH2 = ATAN(R2/(ZB-Z)) ASA14910 RR1 = CSQRT(ERR-SIN(TH1)*SIN(TH1)) ASA14920 RR2 = CSQRT(ERR-SIN(TH2)*SIN(TH2)) ASA14930 RV1 = -(ERR*COS(TH1)-RR1)/(ERR*COS(TH1)+RR1) ASA14940 RH1 = (COS(TH1)-RR1)/(COS(TH1)+RR1) ASA14950 RV2 = -(ERR*COS(TH2)-RR2)/(ERR*COS(TH2)+RR2) ASA14960 RH2 = (COS(TH2)-RR2)/(COS(TH2)+RR2) ASA14970 2 RG = SQRT((XA-XB)*(XA-XB)+(YA-YB)*(YA-YB)) ASA14980 CPH = 0 ASA14990 SPH = 0 ASA15000 IF (RG.LT.1.E-32) GO TO 3 ASA15010 CPH = (XB-XA)/RG ASA15020 SPH = (YB-YA)/RG ASA15030 3 EE = (EX1*SPH-EY1*CPH)*(RH1-RV1) ASA15040 EX1=-EX1*RV1+EE*SPH ASA15050 EY1=-EY1*RV1-EE*CPH ASA15060 EZ1 = EZ1*(-RV1) ASA15070 EE = (EX2*SPH-EY2*CPH)*(RH2-RV2) ASA15080 EX2=-EX2*RV2+EE*SPH ASA15090 EY2=-EY2*RV2-EE*CPH ASA15100 EZ2 = EZ2*(-RV2) ASA15110 RETURN ASA15120 END ASA15130 SUBROUTINE GNFLD (IA,IB,INM,I1,I2,I3,MD,N,ND,NM,AM,CGD,SGD,ETA,GAMASA15140 1,CJ,D,X,Y,Z,XP,YP,ZP,EX,EY,EZ,IGRD,ERR) ASA15150 COMPLEX EX,EY,EZ,EX1,EY1,EZ1,EX2,EY2,EZ2,ETA,GAM ASA15160 COMPLEX ERR ASA15170 COMPLEX CJ(1),CGD(1),SGD(1) ASA15180 DIMENSION IA(1), IB(1), I1(1), I2(1), I3(1), D(1), X(1), Y(1), Z(1ASA15190 1) ASA15200 DIMENSION MD(INM,4), ND(1) ASA15210 DATA PI,TP/3.14159,6.28318/ ASA15220 EX = (.0,.0) ASA15230 EY = (.0,.0) ASA15240 EZ = (.0,.0) ASA15250 C ASA15260 DO 2 K=1,NM ASA15270 KA = IA(K) ASA15280 KB = IB(K) ASA15290 NGRD = IGRD ASA15300 IF (K.LE.NM/2) IGRD=-1 ASA15310 CALL GNF (X(KA),Y(KA),Z(KA),X(KB),Y(KB),Z(KB),XP,YP,ZP,AM,D(K),CGDASA15320 1(K),SGD(K),ETA,GAM,EX1,EY1,EZ1,EX2,EY2,EZ2,IGRD,ERR) ASA15330 IGRD = NGRD ASA15340 NDK = ND(K) ASA15350 C ASA15360 DO 2 II=1,NDK ASA15370 I = MD(K,II) ASA15380 FI = 1. ASA15390 IF (KB.EQ.I2(I)) GO TO 1 ASA15400 IF (KB.EQ.I1(I)) FI=-1. ASA15410 EX = EX+FI*EX1*CJ(I) ASA15420 EY = EY+FI*EY1*CJ(I) ASA15430 EZ = EZ+FI*EZ1*CJ(I) ASA15440 GO TO 2 ASA15450 1 IF (KA.EQ.I3(I)) FI=-1. ASA15460 EX = EX+FI*EX2*CJ(I) ASA15470 EY = EY+FI*EY2*CJ(I) ASA15480 EZ = EZ+FI*EZ2*CJ(I) ASA15490 2 CONTINUE ASA15500 C ASA15510 RETURN ASA15520 END ASA15530 SUBROUTINE LEFT (N) ASA15540 COMMON /A/ A(80) ASA15550 DATA PLEFT/'('/ ASA15560 K = N ASA15570 C ASA15580 DO 1 I=K,80 ASA15590 N = I+1 ASA15600 IF (A(I).EQ.PLEFT) GO TO 2 ASA15610 1 CONTINUE ASA15620 C ASA15630 N = 1 ASA15640 2 RETURN ASA15650 END ASA15660 SUBROUTINE LINECK (X,Y) ASA15670 C ASA15680 C THIS SUBROUTINE INSURES ALL GRID CHARACTORS LIE ON THE POLAR GRID ASA15690 C ASA15700 COMMON ISYM,LINE ASA15710 INTEGER Y ASA15720 DIMENSION ISYM(14), LINE(130) ASA15730 IF (Y.EQ.0) GO TO 3 ASA15740 K = 0 ASA15750 IF (X.LT.10.0) GO TO 5 ASA15760 C ASA15770 C SET UP AREAS OF "PERIOD" POLAR GRID POINT CHARACTERS ASA15780 C ASA15790 I = INT(X) ASA15800 I = IABS(I) ASA15810 Z = ABS(X) ASA15820 IF ((Z-I).GT.0.5) I=I+1 ASA15830 1 IF (Z.LT.10.0.OR.Z.GT.111.0) GO TO 2 ASA15840 LINE(I) = ISYM(2) ASA15850 LINE(60) = ISYM(3) ASA15860 LINE(62) = ISYM(3) ASA15870 K = K+1 ASA15880 IF (K.EQ.2) GO TO 2 ASA15890 I = 122-I ASA15900 GO TO 1 ASA15910 2 LINE(61) = ISYM(2) ASA15920 IF (Y.NE.0) GO TO 5 ASA15930 C ASA15940 3 DO 4 K=11,111 ASA15950 LINE(K) = ISYM(2) ASA15960 4 CONTINUE ASA15970 C ASA15980 C ASA15990 C FILL IN GRID NUMBER LABELS ON HORIZONTAL AXIS ASA16000 C ASA16010 LINE(11) = ISYM(7) ASA16020 LINE(20) = ISYM(10) ASA16030 LINE(21) = ISYM(5) ASA16040 LINE(22) = ISYM(11) ASA16050 LINE(30) = ISYM(9) ASA16060 LINE(31) = ISYM(5) ASA16070 LINE(32) = ISYM(11) ASA16080 LINE(40) = ISYM(8) ASA16090 LINE(41) = ISYM(5) ASA16100 LINE(42) = ISYM(11) ASA16110 LINE(50) = ISYM(7) ASA16120 LINE(51) = ISYM(5) ASA16130 LINE(52) = ISYM(11) ASA16140 LINE(61) = ISYM(1) ASA16150 LINE(70) = ISYM(7) ASA16160 LINE(71) = ISYM(5) ASA16170 LINE(72) = ISYM(11) ASA16180 LINE(80) = ISYM(8) ASA16190 LINE(81) = ISYM(5) ASA16200 LINE(82) = ISYM(11) ASA16210 LINE(90) = ISYM(9) ASA16220 LINE(91) = ISYM(5) ASA16230 LINE(92) = ISYM(11) ASA16240 LINE(100) = ISYM(10) ASA16250 LINE(101) = ISYM(5) ASA16260 LINE(102) = ISYM(11) ASA16270 LINE(111) = ISYM(7) ASA16280 5 CONTINUE ASA16290 RETURN ASA16300 END ASA16310 SUBROUTINE NUMB (Y) ASA16320 C ASA16330 C THIS SUBROUTINE PUTS DEGREE NUMBERS ON POLAR GRID ASA16340 C ASA16350 COMMON ISYM,LINE ASA16360 INTEGER Y ASA16370 DIMENSION ISYM(14), LINE(130) ASA16380 IF (Y.NE.37) GO TO 1 ASA16390 LINE(33) = ISYM(7) ASA16400 LINE(34) = ISYM(8) ASA16410 LINE(35) = ISYM(6) ASA16420 LINE(87) = ISYM(6) ASA16430 LINE(88) = ISYM(12) ASA16440 LINE(89) = ISYM(6) ASA16450 1 IF (Y.NE.21) GO TO 2 ASA16460 LINE(12) = ISYM(7) ASA16470 LINE(13) = ISYM(11) ASA16480 LINE(14) = ISYM(6) ASA16490 LINE(108) = ISYM(6) ASA16500 LINE(109) = ISYM(9) ASA16510 LINE(110) = ISYM(6) ASA16520 2 IF (Y.NE.0) GO TO 3 ASA16530 LINE(7) = ISYM(7) ASA16540 LINE(8) = ISYM(13) ASA16550 LINE(9) = ISYM(6) ASA16560 LINE(113) = ISYM(6) ASA16570 LINE(114) = ISYM(6) ASA16580 LINE(115) = ISYM(6) ASA16590 3 IF (Y.NE.-21) GO TO 4 ASA16600 LINE(12) = ISYM(8) ASA16610 LINE(13) = ISYM(7) ASA16620 LINE(14) = ISYM(6) ASA16630 LINE(108) = ISYM(9) ASA16640 LINE(109) = ISYM(9) ASA16650 LINE(110) = ISYM(6) ASA16660 4 IF (Y.NE.-37) GO TO 5 ASA16670 LINE(33) = ISYM(8) ASA16680 LINE(34) = ISYM(10) ASA16690 LINE(35) = ISYM(6) ASA16700 LINE(87) = ISYM(9) ASA16710 LINE(88) = ISYM(6) ASA16720 LINE(89) = ISYM(6) ASA16730 5 CONTINUE ASA16740 RETURN ASA16750 END ASA16760 SUBROUTINE NUMBER (N1,N2,X,IX) ASA16770 COMMON /A/ A(80) ASA16780 DIMENSION B(10) ASA16790 DATA B/'0','1','2','3','4','5','6','7','8','9'/ ASA16800 DATA AMNUS,PLUS,POINT/'-','+','.'/ ASA16810 DATA AK,AM,AU/'K','M','U'/ ASA16820 N = N1 ASA16830 NSIGN = 0 ASA16840 II = -1 ASA16850 IX = 0 ASA16860 ISET = 0 ASA16870 IF (A(N).EQ.PLUS) N=N+1 ASA16880 IF (A(N).NE.AMNUS) GO TO 1 ASA16890 NSIGN = 1 ASA16900 N = N+1 ASA16910 C ASA16920 1 DO 6 I=N,80 ASA16930 IF (A(I).NE.POINT) GO TO 2 ASA16940 ISET = 1 ASA16950 GO TO 6 ASA16960 2 IF (ISET.EQ.1) II = II+1 ASA16970 C ASA16980 DO 3 K=1,10 ASA16990 IF (A(I).EQ.B(K)) GO TO 4 ASA17000 3 CONTINUE ASA17010 C ASA17020 GO TO 7 ASA17030 C ASA17040 4 DO 5 K=1,10 ASA17050 KK = K-1 ASA17060 IF (A(I).EQ.B(K)) NUMB=KK ASA17070 5 CONTINUE ASA17080 C ASA17090 IX = NUMB+10*IX ASA17100 N2 = I+1 ASA17110 6 CONTINUE ASA17120 C ASA17130 7 IF (NSIGN.EQ.1) IX = -IX ASA17140 Y = IX ASA17150 IF (II.LT.0) II = 0 ASA17160 X = Y/(10**II) ASA17170 IF (A(N2).EQ.POINT) N2=N2+1 ASA17180 IF (A(N2).EQ.AK) X = X*1000. ASA17190 IF (A(N2).EQ.AM) X = X*0.001 ASA17200 IF (A(N2).EQ.AU) X = X*0.000001 ASA17210 IF((A(N2).EQ.AK).OR.(A(N2).EQ.AM).OR.(A(N2).EQ.AU)) N2=N2+1 ASA17220 N1 = N2 ASA17230 RETURN ASA17240 END ASA17250 SUBROUTINE POLPRT (NAME,Y) ASA17260 COMMON ISYM,LINE ASA17270 DIMENSION X(360), Y(360), DATAX(360), DATAY(360), LINE(130), ISYM(ASA17280 114) ASA17290 DIMENSION TITLA(2), TITL2(2) ASA17300 DATA TITLA/'PHI ','THET'/ ASA17310 N = 360 ASA17320 DIM = 1.0 ASA17330 NST = 1 ASA17340 KST = 1 ASA17350 C ASA17360 C S IS SCALE FACTOR OF PRINTER: ASA17370 C ABSCISSA CHAR. PER INCH / ORDINATE CHAR. PER INCH ASA17380 C ASA17390 S = 10.0/8.0 ASA17400 C ASA17410 C ZERO DATAX AND DATAY ASA17420 C ASA17430 C ASA17440 DO 1 IA=1,N ASA17450 D = IA-1 ASA17460 DATA X(IA) = 0.0 ASA17470 DATA Y(IA) = 0.0 ASA17480 1 X(IA) = D*3.1415927/180.0 ASA17490 C ASA17500 C ASA17510 C FACTOR IS THE NORMALIZING DIVISOR ASA17520 C ASA17530 FACTOR = Y(1) ASA17540 C ASA17550 DO 2 IA=2,N ASA17560 2 IF (FACTOR.LT.Y(IA)) FACTOR=Y(IA) ASA17570 C ASA17580 C ASA17590 IF (NAME.EQ.1) TITL1=TITLA(1) ASA17600 IF (NAME.EQ.2) TITL1=TITLA(2) ASA17610 IF ((NAME.EQ.3).OR.(NAME.EQ.4).OR.(NAME.EQ.7).OR.(NAME.EQ.8)) TITLASA17620 12(1)=TITLA(1) ASA17630 IF ((NAME.EQ.5).OR.(NAME.EQ.6).OR.(NAME.EQ.9).OR.(NAME.EQ.10)) TITASA17640 1L2(1)=TITLA(2) ASA17650 IF ((NAME.EQ.3).OR.(NAME.EQ.5).OR.(NAME.EQ.7).OR.(NAME.EQ.9)) TITLASA17660 12(2)=TITLA(1) ASA17670 IF ((NAME.EQ.4).OR.(NAME.EQ.6).OR.(NAME.EQ.8).OR.(NAME.EQ.10)) TITASA17680 1L2(2)=TITLA(2) ASA17690 IF (FACTOR.GT.1.E-32) GO TO 3 ASA17700 IF (NAME.LE.2) WRITE (6,9) TITL1 ASA17710 IF (NAME.GE.3) WRITE (6,10) TITL2 ASA17720 RETURN ASA17730 C ASA17740 C NORMALIZE DATA TO ONE ASA17750 C ASA17760 C ASA17770 3 DO 4 IA=1,N ASA17780 4 Y(IA) = Y(IA)/FACTOR ASA17790 C ASA17800 C ASA17810 IF (NAME.LE.2) WRITE (6,11) TITL1,FACTOR ASA17820 IF ((NAME.GE.3).AND.(NAME.LE.6)) WRITE (6,13) TITL2,FACTOR ASA17830 IF (NAME.GE.7) WRITE (6,12) TITL2,FACTOR ASA17840 C FILL DATAX AND DATAY ARRAY FROM X AND Y ARRAY ASA17850 C ASA17860 C ASA17870 DO 5 IA=1,N ASA17880 DATA X(IA) = Y(IA)*COS(X(IA)) ASA17890 5 DATA Y(IA)= Y(IA)*SIN(X(IA)) ASA17900 C ASA17910 C ASA17920 C SORT DATA BY ORDINATE MAGNITUDE ASA17930 C ASA17940 CALL SART (DATAX,DATAY,N) ASA17950 C ASA17960 C DATAX AND DATAY ARE SORTED BY DESENDING MAGNITUDE ON THE DATAY VALASA17970 C SET UP FOR PLOTTING POLAR GRID WITH DATA ASA17980 C ASA17990 C ASA18000 DO 8 IYY=1,81 ASA18010 C ASA18020 CALL PTPLOT (IYY,S) ASA18030 C ASA18040 C LINE IS RETURNED WITH POLAR GRID INFORMATION ASA18050 C ASA18060 C SET UP 'Y' BIN SIZE UPPER AND LOWER LIMITS ASA18070 C ULL IS THE LOWER BIN LIMIT ASA18080 C UL IS THE UPPER BIN LIMIT ASA18090 C ASA18100 BIN = DIM/80.0 ASA18110 ULL = DIM-(2*IYY-1)*BIN ASA18120 UL = ULL+2*BIN ASA18130 C ASA18140 C ASA18150 C CYCLE THROUGH DATA TO FIND WHICH ONES FALL IN 'Y' BINS ASA18160 C ASA18170 C ASA18180 IF (NST.GT.N) GO TO 7 ASA18190 C ASA18200 DO 6 JJ=NST,N ASA18210 IF (DATAY(JJ).LT.ULL) GO TO 7 ASA18220 KST = JJ ASA18230 AMAG = SQRT(DATAX(JJ)*DATAX(JJ)+DATAY(JJ)*DATAY(JJ)) ASA18240 C ASA18250 C CHECK THAT MAGNITUDE IS NOT OVER DIM ASA18260 C ASA18270 IF (AMAG.GT.DIM) GO TO 6 ASA18280 C ASA18290 C OK IS THE FINAL LINE POSITION FOR THE '*' ASA18300 C ASA18310 OK = DATAX(JJ)*S*40.0/DIM+61.0 ASA18320 IF (OK.LT.10.0) GO TO 6 ASA18330 K = INT(OK) ASA18340 K = IABS(K) ASA18350 OK = ABS(OK) ASA18360 IF ((OK-K).GT.0.5) K=K+1 ASA18370 IF (OK.LT.10.0.OR.OK.GT.111.0) GO TO 6 ASA18380 LINE(K) = ISYM(4) ASA18390 6 CONTINUE ASA18400 C ASA18410 7 CONTINUE ASA18420 NST = KST+1 ASA18430 C ASA18440 C PRINT OUT ONE LINE OF PLOT ASA18450 C ASA18460 WRITE (6,14) LINE ASA18470 8 CONTINUE ASA18480 C ASA18490 RETURN ASA18500 C ASA18510 9 FORMAT (10X,1A4,' COMPONENT OF THE ELECTRIC FIELD IS LESS'/10X, ASA18520 1 'THAN 1.E-64, THEREFORE THIS FIELD WAS NOT '/10X,'PLOTTED. EXECASA18530 2UTION WILL CONTINUE AS NORMAL.'//) ASA18540 10 FORMAT (10X,'THE MAXIMUM VALUE OF THE BISTATIC PATTERN FOR '/ ASA18550 1 10X,1A4,'-',1A4,' (INCIDENT-SCATTERED) IS LESS THAN '/ ASA18560 2 10X, ' 1.E-30.) POLAR PLOT NOT CALLED.'///) ASA18570 11 FORMAT ('1',1A4,' ELECTRIC FIELD ANTENNA PATTERN FOR SPECIFIED PLAASA18580 1NE.',9X,'NORMALIZING FACTOR= ',E10.5) ASA18590 12 FORMAT ('1BISTATIC SCATTERING PATTERN FOR',1A4,'-',1A4,'(INCIDENT-ASA18600 1SCATTERED) POLARIZATION.',9X,'NORMALIZING FACTOR=',E10.5) ASA18610 13 FORMAT ('1BACKSCATTERING PATTERN FOR',1A4,'-',1A4,'(INCIDENT-SCATTASA18620 1ERED) POLARIZATION.',9X,'NORMALIZING FACTOR=',E10.5) ASA18630 14 FORMAT (1X,130A1) ASA18640 END ASA18650 SUBROUTINE PTPLOT (IYY,S) ASA18660 C ASA18670 C THIS SUBROUTINE SETS UP POLAR GRID INFORMATION ASA18680 C ASA18690 COMMON ISYM,LINE ASA18700 DIMENSION LINE(130), ISYM(14), ISYN(14) ASA18710 DATA ISYN/1H+,1H.,1H ,1H*,1H/,1H0,1H1,1H2,1H3,1H4,1H5,1H6,1H8,1H9/ASA18720 INTEGER Y,YY,W ASA18730 C ASA18740 C SET UP ISYM FROM ISYN FOR COMMON ASA18750 C ASA18760 C ASA18770 DO 1 K=1,14 ASA18780 ISYM(K) = ISYN(K) ASA18790 1 CONTINUE ASA18800 C ASA18810 C ASA18820 C CLEAR LINE AND SET TO BLANK ASA18830 C ASA18840 C ASA18850 DO 2 I=1,130 ASA18860 2 LINE(I) = ISYM(3) ASA18870 C ASA18880 Y = 41-IYY ASA18890 IF (Y.EQ.0) GO TO 7 ASA18900 C ASA18910 C SET UP EQUATIONS FOR CONCENTRIC CIRCLES ASA18920 C ASA18930 YY = Y*Y ASA18940 Z = (YY*2.5/2)*S ASA18950 X = 61.0+SQRT(2500.0-Z) ASA18960 CALL LINECK (X,Y) ASA18970 IF (Y.GT.32.OR.Y.LT.-32) GO TO 3 ASA18980 X = 61.0+SQRT(1600.0-Z) ASA18990 CALL LINECK (X,Y) ASA19000 3 IF (Y.GT.24.OR.Y.LT.-24) GO TO 4 ASA19010 X = 61.0+SQRT(900.0-Z) ASA19020 CALL LINECK (X,Y) ASA19030 4 IF (Y.GT.16.OR.Y.LT.-16) GO TO 5 ASA19040 X = 61.0+SQRT(400.0-Z) ASA19050 CALL LINECK (X,Y) ASA19060 5 IF (Y.GT.8.OR.Y.LT.-8) GO TO 6 ASA19070 X = 61.0+SQRT(100-Z) ASA19080 CALL LINECK (X,Y) ASA19090 C SET UP EQUATIONS FOR MULTIPLES OF 30 DEGREES ASA19100 6 X = 61.0+1.732051*Y*S ASA19110 CALL LINECK (X,Y) ASA19120 X = 61.0+Y*S/1.732051 ASA19130 7 CALL LINECK (X,Y) ASA19140 C ASA19150 C PUT IN POLAR PLOT NUMBER LABELS ASA19160 C ASA19170 CALL NUMB (Y) ASA19180 W = IABS(Y) ASA19190 C ASA19200 C FILL IN POLAR PLOT AT 000, 090, 180, AND 270 ASA19210 C ASA19220 IF (W.NE.40) GO TO 8 ASA19230 LINE(55) = ISYM(2) ASA19240 LINE(57) = ISYM(2) ASA19250 LINE(59) = ISYM(2) ASA19260 LINE(63) = ISYM(2) ASA19270 LINE(65) = ISYM(2) ASA19280 LINE(67) = ISYM(2) ASA19290 8 IF (W.NE.32) GO TO 9 ASA19300 LINE(56) = ISYM(2) ASA19310 LINE(58) = ISYM(2) ASA19320 LINE(60) = ISYM(2) ASA19330 LINE(62) = ISYM(2) ASA19340 LINE(64) = ISYM(2) ASA19350 LINE(66) = ISYM(2) ASA19360 9 IF (W.NE.24) GO TO 10 ASA19370 LINE(57) = ISYM(2) ASA19380 LINE(59) = ISYM(2) ASA19390 LINE(60) = ISYM(2) ASA19400 LINE(62) = ISYM(2) ASA19410 LINE(63) = ISYM(2) ASA19420 LINE(65) = ISYM(2) ASA19430 10 IF (W.NE.16) GO TO 11 ASA19440 LINE(58) = ISYM(2) ASA19450 LINE(60) = ISYM(2) ASA19460 LINE(62) = ISYM(2) ASA19470 LINE(64) = ISYM(2) ASA19480 11 IF (W.NE.08) GO TO 12 ASA19490 LINE(59) = ISYM(2) ASA19500 LINE(63) = ISYM(2) ASA19510 12 CONTINUE ASA19520 RETURN ASA19530 END ASA19540 SUBROUTINE READ (IA,IB,IBISC,ICARD,IGAIN,IGRD,INEAR,INT,ISCAT,IWR,ASA19550 1IFLAG,KFLAG,KGEN,LOAD,LZD,MSG,NBAP,NBIP,NFFP,NGEN,NM,NP,ABAP,ABAT,ASA19560 2AFFP,AFFT,ABIP,ABIT,AM,BM,CMM,ER2,ER3,ER4,FMC,HGT,PHAF,PHAI,PHIF,PASA19570 3HII,PHSF,PHSI,THAF,THAI,THIF,THII,THSF,THSI,SIG2,SIG3,SIG4,TD2,TD3ASA19580 4,VOLT,X,XNP,Y,YNP,Z,ZLLD,ZNP,STEP) ASA19590 COMMON /A/ A(80) ASA19600 COMPLEX VOLT(1),ZLLD(1) ASA19610 DIMENSION IA(1), IB(1), X(1), Y(1), Z(1), KGEN(1), KFLAG(1) ASA19620 DIMENSION XNP(1), YNP(1), ZNP(1), LZD(1) ASA19630 DATA AA,AB,AC,AD,AE,AF,AG,AH,AI,AK,AL,AMA,AN,AO,AP,AQ,AR,AS,AT,AU,ASA19640 1AW,AX/'A','B','C','D','E','F','G','H','I','K','L','M','N','O','P',ASA19650 2'Q','R','S','T','U','W','X'/ ASA19660 DATA BLANK,COMMA,MINUS,PLEFT,POINT,RIGHT,SLANT/' ',',','-','(','.'ASA19670 1,')','/'/ ASA19680 RAD = 57.295779 ASA19690 INT = 4 ASA19700 IBISC = -1 ASA19710 IGAIN = -1 ASA19720 INEAR = -1 ASA19730 ISCAT = -1 ASA19740 IWR = -1 ASA19750 IF (IFLAG.EQ.6) GO TO 2 ASA19760 IF (MSG.NE.0) GO TO 4 ASA19770 1 READ (5,76,END=72) A ASA19780 2 IF ((A(1).NE.AC).OR.(A(2).NE.BLANK).OR.(A(3).NE.BLANK).OR.(A(4).NEASA19790 1.BLANK)) GO TO 3 ASA19800 WRITE (6,74) A ASA19810 GO TO 1 ASA19820 3 WRITE (6,75) ASA19830 GO TO 5 ASA19840 4 READ (5,76,END=72) A ASA19850 5 ICARD = ICARD+1 ASA19860 WRITE (6,77) ICARD,A ASA19870 IF ((MSG.NE.0).AND.((A(1).EQ.AE).AND.(A(2).EQ.AN).AND.(A(3).EQ.AD)ASA19880 1)) GO TO 70 ASA19890 IF ((MSG.NE.0).AND.((A(1).EQ.AS).AND.(A(2).EQ.AT).AND.(A(3).EQ.AO)ASA19900 1.AND.(A(4).EQ.AP))) GO TO 69 ASA19910 IF ((A(1).EQ.AC).AND.(A(2).EQ.BLANK).AND.(A(3).EQ.BLANK).AND.(A(4)ASA19920 1.EQ.BLANK)) GO TO 73 ASA19930 IF (MSG.GT.0) GO TO 4 ASA19940 CALL BLNK (A) ASA19950 N = 4 ASA19960 C ASA19970 C INSULATION ASA19980 C ASA19990 IF ((A(1).NE.AI).OR.(A(2).NE.AN).OR.(A(3).NE.AS).OR.(A(4).NE.AU)) ASA20000 1GO TO 10 ASA20010 KFLAG(20) = 1 ASA20020 CALL LEFT (N) ASA20030 C ASA20040 6 IF ((A(N).NE.AR).OR.(A(N+1).NE.AA).OR.(A(N+2).NE.AD).OR.(A(N+3).NEASA20050 1.AI)) GO TO 7 ASA20060 KFLAG(4) = 1 ASA20070 CALL EQUAL (N) ASA20080 CALL NUMBER (N,N2,X1,IX) ASA20090 BM = X1 ASA20100 IF (A(N2).EQ.RIGHT) GO TO 4 ASA20110 IF (A(N2).NE.SLANT) GO TO 71 ASA20120 N = N2+1 ASA20130 GO TO 6 ASA20140 C ASA20150 7 IF ((A(N).NE.AD).OR.(A(N+1).NE.AI).OR.(A(N+2).NE.AE).OR.(A(N+3).NEASA20160 1.AL)) GO TO 8 ASA20170 KFLAG(6) = 1 ASA20180 CALL EQUAL (N) ASA20190 CALL NUMBER (N,N2,X1,IX) ASA20200 ER2 = X1 ASA20210 IF (A(N2).EQ.RIGHT) GO TO 4 ASA20220 IF (A(N2).NE.SLANT) GO TO 71 ASA20230 N = N2+1 ASA20240 GO TO 6 ASA20250 C ASA20260 8 IF ((A(N).NE.AC).OR.(A(N+1).NE.AO).OR.(A(N+2).NE.AN).OR.(A(N+3).NEASA20270 1.AD)) GO TO 9 ASA20280 KFLAG(5) = 1 ASA20290 CALL EQUAL (N) ASA20300 CALL NUMBER (N,N2,X1,IX) ASA20310 SIG2 = X1 ASA20320 IF (A(N2).EQ.RIGHT) GO TO 4 ASA20330 IF (A(N2).NE.SLANT) GO TO 71 ASA20340 N = N2+1 ASA20350 GO TO 6 ASA20360 C ASA20370 9 IF ((A(N).NE.AL).OR.(A(N+1).NE.AO).OR.(A(N+2).NE.AS).OR.(A(N+3).NEASA20380 1.AS)) GO TO 71 ASA20390 KFLAG(7) = 1 ASA20400 CALL EQUAL (N) ASA20410 CALL NUMBER (N,N2,X1,IX) ASA20420 TD2 = X1 ASA20430 IF (A(N2).EQ.RIGHT) GO TO 4 ASA20440 IF (A(N2).NE.SLANT) GO TO 71 ASA20450 N = N2+1 ASA20460 GO TO 6 ASA20470 C ASA20480 C WIRE ASA20490 C ASA20500 10 IF ((A(1).NE.AW).OR.(A(2).NE.AI).OR.(A(3).NE.AR).OR.(A(4).NE.AE)) ASA20510 1GO TO 13 ASA20520 CALL LEFT (N) ASA20530 C ASA20540 11 IF ((A(N).NE.AR).OR.(A(N+1).NE.AA).OR.(A(N+2).NE.AD).OR.(A(N+3).NEASA20550 1.AI)) GO TO 12 ASA20560 KFLAG(2) = 1 ASA20570 CALL EQUAL (N) ASA20580 CALL NUMBER (N,N2,X1,IX) ASA20590 AM = X1 ASA20600 IF (A(N2).EQ.RIGHT) GO TO 4 ASA20610 IF (A(N2).NE.SLANT) GO TO 71 ASA20620 N = N2+1 ASA20630 GO TO 11 ASA20640 C ASA20650 12 IF ((A(N).NE.AC).OR.(A(N+1).NE.AO).OR.(A(N+2).NE.AN).OR.(A(N+3).NEASA20660 1.AD)) GO TO 71 ASA20670 KFLAG(3) = 1 ASA20680 CALL EQUAL (N) ASA20690 CALL NUMBER (N,N2,X1,IX) ASA20700 CMM = X1 ASA20710 IF (A(N2).EQ.RIGHT) GO TO 4 ASA20720 IF (A(N2).NE.SLANT) GO TO 71 ASA20730 N = N2+1 ASA20740 GO TO 11 ASA20750 C ASA20760 C EXTERNAL MEDIUM ASA20770 C ASA20780 13 IF ((A(1).NE.AE).OR.(A(2).NE.AX).OR.(A(3).NE.AT).OR.(A(4).NE.AE)) ASA20790 1GO TO 17 ASA20800 KFLAG(8) = 1 ASA20810 CALL LEFT (N) ASA20820 C ASA20830 14 IF ((A(N).NE.AC).OR.(A(N+1).NE.AO).OR.(A(N+2).NE.AN).OR.(A(N+3).NEASA20840 1.AD)) GO TO 15 ASA20850 KFLAG(9) = 1 ASA20860 CALL EQUAL (N) ASA20870 CALL NUMBER (N,N2,X1,IX) ASA20880 SIG3 = X1 ASA20890 IF (A(N2).EQ.RIGHT) GO TO 4 ASA20900 IF (A(N2).NE.SLANT) GO TO 71 ASA20910 N = N2+1 ASA20920 GO TO 14 ASA20930 C ASA20940 15 IF ((A(N).NE.AD).OR.(A(N+1).NE.AI).OR.(A(N+2).NE.AE).OR.(A(N+3).NEASA20950 1.AL)) GO TO 16 ASA20960 KFLAG(10) = 1 ASA20970 CALL EQUAL (N) ASA20980 CALL NUMBER (N,N2,X1,IX) ASA20990 ER3 = X1 ASA21000 IF (A(N2).EQ.RIGHT) GO TO 4 ASA21010 IF (A(N2).NE.SLANT) GO TO 71 ASA21020 N = N2+1 ASA21030 GO TO 14 ASA21040 C ASA21050 16 IF ((A(N).NE.AL).OR.(A(N+1).NE.AO).OR.(A(N+2).NE.AS).OR.(A(N+3).NEASA21060 1.AS)) GO TO 71 ASA21070 KFLAG(11) = 1 ASA21080 CALL EQUAL (N) ASA21090 CALL NUMBER (N,N2,X1,IX) ASA21100 TD3 = X1 ASA21110 IF (A(N2).EQ.RIGHT) GO TO 4 ASA21120 IF (A(N2).NE.SLANT) GO TO 71 ASA21130 N = N2+1 ASA21140 GO TO 14 ASA21150 C ASA21160 C ASA21170 C LOAD ASA21180 C ASA21190 17 IF ((A(1).NE.AL).OR.(A(2).NE.AO).OR.(A(3).NE.AA).OR.(A(4).NE.AD)) ASA21200 1GO TO 18 ASA21210 KFLAG(14) = 1 ASA21220 GO TO 19 ASA21230 18 IF ((A(1).NE.AI).OR.(A(2).NE.AMA).OR.(A(3).NE.AP).OR.(A(4).NE.AE))ASA21240 1 GO TO 22 ASA21250 KFLAG(24) = 1 ASA21260 19 I = 1 ASA21270 CALL LEFT (N) ASA21280 20 CALL NUMBER (N,N2,X1,IX) ASA21290 IF (IX.LE.0) GO TO 21 ASA21300 LZD(I) = IX ASA21310 N = N2+1 ASA21320 CALL NUMBER (N,N2,X1,IX) ASA21330 RMAG = X1 ASA21340 N = N2+1 ASA21350 CALL NUMBER (N,N2,X1,IX) ASA21360 RDEG = X1 ASA21370 RREAL = RMAG*COS(RDEG/RAD) ASA21380 RIMAG = RMAG*SIN(RDEG/RAD) ASA21390 ZLLD(I) = CMPLX(RREAL,RIMAG) ASA21400 LOAD = I ASA21410 IF (A(N2).EQ.RIGHT) GO TO 4 ASA21420 IF (A(N2).NE.SLANT) GO TO 71 ASA21430 I = I+1 ASA21440 N = N2+1 ASA21450 GO TO 20 ASA21460 21 KFLAG(24) = -1 ASA21470 LOAD = -1 ASA21480 GO TO 4 ASA21490 C ASA21500 C FREQUENCY ASA21510 C ASA21520 22 IF ((A(1).NE.AF).OR.(A(2).NE.AR).OR.(A(3).NE.AE).OR.(A(4).NE.AQ)) ASA21530 1GO TO 23 ASA21540 KFLAG(1) = 1 ASA21550 CALL LEFT (N) ASA21560 CALL NUMBER (N,N2,X1,IX) ASA21570 FMC = X1 ASA21580 GO TO 4 ASA21590 C ASA21600 C PLOT ASA21610 C ASA21620 23 IF ((A(1).NE.AP).OR.(A(2).NE.AL).OR.(A(3).NE.AO).OR.(A(4).NE.AT)) ASA21630 1GO TO 31 ASA21640 KFLAG(22) = 1 ASA21650 CALL LEFT (N) ASA21660 C ASA21670 24 IF ((A(N).NE.AF).OR.(A(N+1).NE.AA).OR.(A(N+2).NE.AR).OR.(A(N+3).NEASA21680 1.AF)) GO TO 25 ASA21690 IGAIN = 1 ASA21700 NFFP = 1 ASA21710 GO TO 27 ASA21720 25 IF ((A(N).NE.AB).OR.(A(N+1).NE.AI).OR.(A(N+2).NE.AS).OR.(A(N+3).NEASA21730 1.AT)) GO TO 26 ASA21740 IBISC = 1 ASA21750 NBIP = 1 ASA21760 GO TO 27 ASA21770 26 IF ((A(N).NE.AB).OR.(A(N+1).NE.AA).OR.(A(N+2).NE.AC).OR.(A(N+3).NEASA21780 1.AK)) GO TO 71 ASA21790 ISCAT = 1 ASA21800 NBAP = 1 ASA21810 C ASA21820 C ASA21830 C ASA21840 27 DO 28 I=N,80 ASA21850 K = I+1 ASA21860 IF (A(I).EQ.SLANT) GO TO 29 ASA21870 28 CONTINUE ASA21880 C ASA21890 C ASA21900 C ASA21910 GO TO 71 ASA21920 29 N = K ASA21930 IF ((A(N).NE.AT).OR.(A(N+1).NE.AH).OR.(A(N+2).NE.AE).OR.(A(N+3).NEASA21940 1.AT)) GO TO 30 ASA21950 CALL EQUAL (N) ASA21960 CALL NUMBER (N,N2,X1,IX) ASA21970 IF (NFFP.EQ.1) AFFT=X1 ASA21980 IF (NBIP.EQ.1) ABIT=X1 ASA21990 IF (NBAP.EQ.1) ABAT=X1 ASA22000 IF (A(N2).EQ.RIGHT) GO TO 4 ASA22010 IF (A(N2).NE.SLANT) GO TO 71 ASA22020 N = N2+1 ASA22030 GO TO 24 ASA22040 30 IF ((A(N).NE.AP).OR.(A(N+1).NE.AH).OR.(A(N+2).NE.AI)) GO TO 71 ASA22050 CALL EQUAL (N) ASA22060 CALL NUMBER (N,N2,X1,IX) ASA22070 IF (NFFP.EQ.1) AFFP=X1 ASA22080 IF (NBIP.EQ.1) ABIP=X1 ASA22090 IF (NBAP.EQ.1) ABAP=X1 ASA22100 IF (A(N2).EQ.RIGHT) GO TO 4 ASA22110 IF (A(N2).NE.SLANT) GO TO 71 ASA22120 N = N2+1 ASA22130 GO TO 24 ASA22140 C ASA22150 C OUTPUT ASA22160 C ASA22170 31 IF ((A(1).NE.AO).OR.(A(2).NE.AU).OR.(A(3).NE.AT).OR.(A(4).NE.AP)) ASA22180 1GO TO 44 ASA22190 KFLAG(22) = 1 ASA22200 CALL LEFT (N) ASA22210 C ASA22220 32 IF ((A(N).NE.AB).OR.(A(N+1).NE.AI).OR.(A(N+2).NE.AS).OR.(A(N+3).NEASA22230 1.AT)) GO TO 33 ASA22240 KFLAG(18) = 1 ASA22250 IBISC = 1 ASA22260 CALL EQUAL (N) ASA22270 CALL NUMBER (N,N2,X1,IX) ASA22280 PHSI = X1 ASA22290 N = N2+1 ASA22300 CALL NUMBER (N,N2,X1,IX) ASA22310 PHSF = X1 ASA22320 N = N2+1 ASA22330 CALL NUMBER (N,N2,X1,IX) ASA22340 THSI = X1 ASA22350 N = N2+1 ASA22360 CALL NUMBER (N,N2,X1,IX) ASA22370 THSF = X1 ASA22380 IF (A(N2).EQ.RIGHT) GO TO 4 ASA22390 IF (A(N2).NE.SLANT) GO TO 71 ASA22400 N = N2+1 ASA22410 GO TO 32 ASA22420 C ASA22430 33 IF ((A(N).NE.AF).OR.(A(N+1).NE.AA).OR.(A(N+2).NE.AR).OR.(A(N+3).NEASA22440 1.AF)) GO TO 34 ASA22450 KFLAG(16) = 1 ASA22460 IGAIN = 1 ASA22470 CALL EQUAL (N) ASA22480 CALL NUMBER (N,N2,X1,IX) ASA22490 PHAI = X1 ASA22500 N = N2+1 ASA22510 CALL NUMBER (N,N2,X1,IX) ASA22520 PHAF = X1 ASA22530 N = N2+1 ASA22540 CALL NUMBER (N,N2,X1,IX) ASA22550 THAI = X1 ASA22560 N = N2+1 ASA22570 CALL NUMBER (N,N2,X1,IX) ASA22580 THAF = X1 ASA22590 IF (A(N2).EQ.RIGHT) GO TO 4 ASA22600 IF (A(N2).NE.SLANT) GO TO 71 ASA22610 N = N2+1 ASA22620 GO TO 32 ASA22630 C ASA22640 34 IF ((A(N).NE.AN).OR.(A(N+1).NE.AE).OR.(A(N+2).NE.AA).OR.(A(N+3).NEASA22650 1.AR)) GO TO 40 ASA22660 KFLAG(19) = 1 ASA22670 INEAR = 2 ASA22680 CALL EQUAL (N) ASA22690 IF (A(N).EQ.PLEFT) GO TO 35 ASA22700 INEAR = 1 ASA22710 I = 1 ASA22720 GO TO 36 ASA22730 C ASA22740 C ASA22750 C ASA22760 35 DO 37 L=1,50 ASA22770 I = L ASA22780 N = N+1 ASA22790 36 CALL NUMBER (N,N2,X1,IX) ASA22800 XNP(I) = X1 ASA22810 N = N2+1 ASA22820 CALL NUMBER (N,N2,X1,IX) ASA22830 YNP(I) = X1 ASA22840 N = N2+1 ASA22850 CALL NUMBER (N,N2,X1,IX) ASA22860 ZNP(I) = X1 ASA22870 IF (INEAR.EQ.1) GO TO 39 ASA22880 INEAR = L+1 ASA22890 IF (A(N2).EQ.RIGHT) GO TO 38 ASA22900 N = N2 ASA22910 37 CONTINUE ASA22920 C ASA22930 C ASA22940 C ASA22950 GO TO 71 ASA22960 38 N2 = N2+1 ASA22970 INEAR = INEAR-1 ASA22980 39 IF (A(N2).EQ.RIGHT) GO TO 4 ASA22990 IF (A(N2).NE.SLANT) GO TO 71 ASA23000 N = N2+1 ASA23010 GO TO 32 ASA23020 C ASA23030 40 IF ((A(N).NE.AB).OR.(A(N+1).NE.AA).OR.(A(N+2).NE.AC).OR.(A(N+3).NEASA23040 1.AK)) GO TO 41 ASA23050 KFLAG(17) = 1 ASA23060 ISCAT = 1 ASA23070 CALL EQUAL (N) ASA23080 CALL NUMBER (N,N2,X1,IX) ASA23090 PHII = X1 ASA23100 N = N2+1 ASA23110 CALL NUMBER (N,N2,X1,IX) ASA23120 PHIF = X1 ASA23130 N = N2+1 ASA23140 CALL NUMBER (N,N2,X1,IX) ASA23150 THII = X1 ASA23160 N = N2+1 ASA23170 CALL NUMBER (N,N2,X1,IX) ASA23180 THIF = X1 ASA23190 IF (A(N2).EQ.RIGHT) GO TO 4 ASA23200 IF (A(N2).NE.SLANT) GO TO 71 ASA23210 N = N2+1 ASA23220 GO TO 32 ASA23230 C ASA23240 41 IF ((A(N).NE.AC).OR.(A(N+1).NE.AU).OR.(A(N+2).NE.AR).OR.(A(N+3).NEASA23250 1.AR)) GO TO 43 ASA23260 KFLAG(15) = 1 ASA23270 IWR = 1 ASA23280 C ASA23290 C ASA23300 C ASA23310 NSPL = N ASA23320 DO 42 K=NSPL,80 ASA23330 IF (A(K).EQ.RIGHT) GO TO 4 ASA23340 N = K+1 ASA23350 IF (A(K).EQ.SLANT) GO TO 32 ASA23360 42 CONTINUE ASA23370 C ASA23380 GO TO 71 ASA23390 C ASA23400 43 IF ((A(N).NE.AS).OR.(A(N+1).NE.AT).OR.(A(N+2).NE.AE).OR.(A(N+3).NEASA23410 1.AP)) GO TO 71 ASA23420 CALL EQUAL (N) ASA23430 CALL NUMBER (N,N2,X1,IX) ASA23440 STEP = X1 ASA23450 IF (A(N2).EQ.RIGHT) GO TO 4 ASA23460 IF (A(N2).NE.SLANT) GO TO 71 ASA23470 N = N2+1 ASA23480 GO TO 32 ASA23490 C ASA23500 C FEED POINT ASA23510 C ASA23520 44 IF ((A(1).NE.AF).OR.(A(2).NE.AE).OR.(A(3).NE.AE).OR.(A(4).NE.AD)) ASA23530 1GO TO 45 ASA23540 KFLAG(13) = 1 ASA23550 GO TO 46 ASA23560 45 IF ((A(1).NE.AG).OR.(A(2).NE.AE).OR.(A(3).NE.AN).OR.(A(4).NE.AE)) ASA23570 1GO TO 49 ASA23580 KFLAG(23) = 1 ASA23590 46 NGEN = 0 ASA23600 CALL LEFT (N) ASA23610 47 CALL NUMBER (N,N2,X1,IX) ASA23620 NGEN = NGEN+1 ASA23630 KGEN(NGEN) = IX ASA23640 IF (A(N2).EQ.RIGHT) GO TO 4 ASA23650 N = N2+1 ASA23660 CALL NUMBER (N,N2,X1,IX) ASA23670 VMAG = X1 ASA23680 N = N2+1 ASA23690 CALL NUMBER (N,N2,X1,IX) ASA23700 VDEG = X1 ASA23710 VREAL = VMAG*COS(VDEG/RAD) ASA23720 VIMAG = VMAG*SIN(VDEG/RAD) ASA23730 VOLT(NGEN) = CMPLX(VREAL,VIMAG) ASA23740 IF (A(N2).EQ.RIGHT) GO TO 4 ASA23750 IF (A(N2).NE.SLANT) GO TO 71 ASA23760 IF ((A(N2).EQ.SLANT).AND.(A(N2+1).EQ.BLANK)) GO TO 48 ASA23770 N = N2+1 ASA23780 GO TO 47 ASA23790 48 READ (5,76) A ASA23800 ICARD = ICARD+1 ASA23810 WRITE (6,77) ICARD,A ASA23820 N = 1 ASA23830 CALL BLNK (A) ASA23840 GO TO 47 ASA23850 C ASA23860 C ASA23870 C DESCRIPTION ASA23880 C ASA23890 49 IF ((A(1).NE.AD).OR.(A(2).NE.AE).OR.(A(3).NE.AS).OR.(A(4).NE.AC)) ASA23900 1GO TO 52 ASA23910 KFLAG(12) = 1 ASA23920 J = 0 ASA23930 CALL LEFT (N) ASA23940 50 CALL NUMBER (N,N2,X1,IX) ASA23950 J = J+1 ASA23960 NM = J ASA23970 IA(J) = IX ASA23980 N = N2+1 ASA23990 CALL NUMBER (N,N2,X1,IX) ASA24000 IB(J) = IX ASA24010 IF (A(N2).EQ.RIGHT) GO TO 4 ASA24020 IF (A(N2).NE.SLANT) GO TO 71 ASA24030 IF ((A(N2).EQ.SLANT).AND.(A(N+1).EQ.BLANK)) GO TO 51 ASA24040 N = N2+1 ASA24050 GO TO 50 ASA24060 51 READ (5,76) A ASA24070 ICARD = ICARD+1 ASA24080 CALL BLNK (A) ASA24090 WRITE (6,77) ICARD,A ASA24100 N = 1 ASA24110 GO TO 50 ASA24120 C ASA24130 C GEOMETRY ASA24140 C ASA24150 52 IF ((A(1).NE.AG).OR.(A(2).NE.AE).OR.(A(3).NE.AO).OR.(A(4).NE.AMA))ASA24160 1 GO TO 55 ASA24170 KFLAG(12) = 1 ASA24180 JJ = 0 ASA24190 CALL LEFT (N) ASA24200 53 CALL NUMBER (N,N2,X1,IX) ASA24210 JJ = JJ+1 ASA24220 NP = JJ ASA24230 X(JJ) = X1 ASA24240 N = N2+1 ASA24250 CALL NUMBER (N,N2,X1,IX) ASA24260 Y(JJ) = X1 ASA24270 N = N2+1 ASA24280 CALL NUMBER (N,N2,X1,IX) ASA24290 Z(JJ) = X1 ASA24300 IF (A(N2).EQ.RIGHT) GO TO 4 ASA24310 IF (A(N2).NE.SLANT) GO TO 71 ASA24320 IF ((A(N2).EQ.SLANT).AND.(A(N+1).EQ.BLANK)) GO TO 54 ASA24330 N = N2+1 ASA24340 GO TO 53 ASA24350 54 READ (5,76) A ASA24360 ICARD = ICARD+1 ASA24370 WRITE (6,77) ICARD,A ASA24380 CALL BLNK (A) ASA24390 N = 1 ASA24400 GO TO 53 ASA24410 C ASA24420 C INTERVAL FOR CALCULATION ASA24430 C ASA24440 55 IF ((A(1).NE.AI).OR.(A(2).NE.AN).OR.(A(3).NE.AT).OR.(A(4).NE.AE)) ASA24450 1GO TO 56 ASA24460 KFLAG(21) = 1 ASA24470 CALL LEFT (N) ASA24480 CALL NUMBER (N,N2,X1,IX) ASA24490 INT = IX ASA24500 IF (A(N2).EQ.RIGHT) GO TO 4 ASA24510 GO TO 71 ASA24520 C ASA24530 C GROUND ASA24540 C ASA24550 56 IF ((A(1).NE.AG).OR.(A(2).NE.AR).OR.(A(3).NE.AO).OR.(A(4).NE.AU)) ASA24560 1GO TO 66 ASA24570 KFLAG(25) = 1 ASA24580 KFLAG(26) = 1 ASA24590 IGRD = 2 ASA24600 CALL LEFT (N) ASA24610 57 IF ((A(N).NE.AP).OR.(A(N+1).NE.AE).OR.(A(N+2).NE.AR).OR.(A(N+3).NEASA24620 1.AF)) GO TO 58 ASA24630 IGRD = 1 ASA24640 GO TO 64 ASA24650 58 IF ((A(N).NE.AG).OR.(A(N+1).NE.AO).OR.(A(N+2).NE.AO).OR.(A(N+3).NEASA24660 1.AD)) GO TO 59 ASA24670 ER4 = 30. ASA24680 SIG4 = .02 ASA24690 GO TO 64 ASA24700 59 IF ((A(N).NE.AP).OR.(A(N+1).NE.AO).OR.(A(N+2).NE.AO).OR.(A(N+3).NEASA24710 1.AR)) GO TO 60 ASA24720 ER4 = 4. ASA24730 SIG4 = .001 ASA24740 GO TO 64 ASA24750 60 IF ((A(N).NE.AS).OR.(A(N+1).NE.AE).OR.(A(N+2).NE.AA)) GO TO 61 ASA24760 ER4 = 80. ASA24770 SIG4 = 4. ASA24780 GO TO 64 ASA24790 61 IF ((A(N).NE.AH).OR.(A(N+1).NE.AE).OR.(A(N+2).NE.AI).OR.(A(N+3).NEASA24800 1.AG)) GO TO 62 ASA24810 CALL EQUAL (N) ASA24820 CALL NUMBER (N,N2,X1,IX) ASA24830 HGT = X1 ASA24840 IF (A(N2).EQ.RIGHT) GO TO 4 ASA24850 IF (A(N2).NE.SLANT) GO TO 71 ASA24860 N = N2+1 ASA24870 GO TO 57 ASA24880 62 IF ((A(N).NE.AC).OR.(A(N+1).NE.AO).OR.(A(N+2).NE.AN).OR.(A(N+3).NEASA24890 1.AD)) GO TO 63 ASA24900 CALL EQUAL (N) ASA24910 CALL NUMBER (N,N2,X1,IX) ASA24920 SIG4 = X1 ASA24930 IF (A(N2).EQ.RIGHT) GO TO 4 ASA24940 IF (A(N2).NE.SLANT) GO TO 71 ASA24950 N = N2+1 ASA24960 GO TO 57 ASA24970 63 IF ((A(N).NE.AD).OR.(A(N+1).NE.AI).OR.(A(N+2).NE.AE).OR.(A(N+3).NEASA24980 1.AL)) GO TO 71 ASA24990 CALL EQUAL (N) ASA25000 CALL NUMBER (N,N2,X1,IX) ASA25010 ER4 = X1 ASA25020 IF (A(N2).EQ.RIGHT) GO TO 4 ASA25030 IF (A(N2).NE.SLANT) GO TO 71 ASA25040 N = N2+1 ASA25050 GO TO 57 ASA25060 C ASA25070 C ASA25080 C ASA25090 64 NSPL = N ASA25100 DO 65 K=NSPL,80 ASA25110 IF (A(K).EQ.RIGHT) GO TO 4 ASA25120 N = K+1 ASA25130 IF (A(K).EQ.SLANT) GO TO 57 ASA25140 65 CONTINUE ASA25150 C ASA25160 C ASA25170 C ASA25180 GO TO 71 ASA25190 C ASA25200 C ASA25210 66 IF ((A(1).NE.AS).OR.(A(2).NE.AT).OR.(A(3).NE.AO).OR.(A(4).NE.AP)) ASA25220 1GO TO 67 ASA25230 IFLAG = 2 ASA25240 RETURN ASA25250 C ASA25260 67 IF ((A(1).NE.AC).OR.(A(2).NE.AH).OR.(A(3).NE.AA).OR.(A(4).NE.AN)) ASA25270 1GO TO 68 ASA25280 IFLAG = 3 ASA25290 RETURN ASA25300 C ASA25310 68 IF ((A(1).NE.AE).OR.(A(2).NE.AN).OR.(A(3).NE.AD)) GO TO 71 ASA25320 IFLAG = 1 ASA25330 RETURN ASA25340 69 IFLAG = 5 ASA25350 RETURN ASA25360 70 IFLAG = 4 ASA25370 RETURN ASA25380 71 MSG = 1 ASA25390 KFLAG(30) = ICARD ASA25400 GO TO 4 ASA25410 72 IF (IFLAG.NE.5) WRITE (6,78) ASA25420 IFLAG = 5 ASA25430 RETURN ASA25440 C ASA25450 73 IFLAG = 6 ASA25460 ICARD = ICARD-1 ASA25470 RETURN ASA25480 C ASA25490 C ASA25500 C ASA25510 74 FORMAT (5X,80A1) ASA25520 75 FORMAT (////5X,'DATA CARDS'//) ASA25530 76 FORMAT (80A1) ASA25540 77 FORMAT (6X,I2,2X,80A1) ASA25550 78 FORMAT (' $$$$$ END CARD/STOP CARD MISSING****') ASA25560 END ASA25570 SUBROUTINE RITE (IA,IB,INM,IWR,I1,I2,I3,MD,ND,NM,CJ,CG,IGRD) ASA25580 COMPLEX CJ(1),CG(1),CJA,CJB ASA25590 DIMENSION IA(1), IB(1), I1(1), I2(1), I3(1), MD(INM,4), ND(1) ASA25600 AMAX = .0 ASA25610 C ASA25620 C ASA25630 DO 3 K=1,NM ASA25640 KA = IA(K) ASA25650 KB = IB(K) ASA25660 CJA = (.0,.0) ASA25670 CJB = (.0,.0) ASA25680 NDK = ND(K) ASA25690 C ASA25700 C ASA25710 DO 2 II=1,NDK ASA25720 I = MD(K,II) ASA25730 FI = 1. ASA25740 IF (KB.EQ.I2(I)) GO TO 1 ASA25750 IF (KB.EQ.I1(I)) FI=-1. ASA25760 CJA = CJA+FI*CJ(I) ASA25770 GO TO 2 ASA25780 1 IF (KA.EQ.I3(I)) FI=-1. ASA25790 CJB = CJB+FI*CJ(I) ASA25800 2 CONTINUE ASA25810 C ASA25820 C ASA25830 CG(K) = CJA ASA25840 KK = K+NM ASA25850 CG(KK) = CJB ASA25860 ACJ = CABS(CJA) ASA25870 BCJ = CABS(CJB) ASA25880 IF (ACJ.GT.AMAX) AMAX=ACJ ASA25890 IF (BCJ.GT.AMAX) AMAX=BCJ ASA25900 3 CONTINUE ASA25910 C ASA25920 C ASA25930 IF (IWR.GT.0) GO TO 4 ASA25940 RETURN ASA25950 4 IF (AMAX.LE.0.) AMAX=1. ASA25960 WRITE (6,8) ASA25970 NMG = NM ASA25980 IF (IGRD.GT.0) NMG = NM/2 ASA25990 C ASA26000 DO 5 K=1,NMG ASA26010 CJA = CG(K) ASA26020 KK = K+NM ASA26030 CJB = CG(KK) ASA26040 CCJA = CABS(CJA) ASA26050 CCJB = CABS(CJB) ASA26060 ACJ = CCJA/AMAX ASA26070 BCJ = CCJB/AMAX ASA26080 PA = .0 ASA26090 PB = .0 ASA26100 IF (ACJ.GT.0.) PA = 57.29578*ATAN2(AIMAG(CJA),REAL(CJA)) ASA26110 IF (BCJ.GT.0.) PB = 57.29578*ATAN2(AIMAG(CJB),REAL(CJB)) ASA26120 5 WRITE (6,7) K,IA(K),CJA,CCJA,ACJ,PA,IB(K),CJB,CCJB,BCJ,PB ASA26130 C ASA26140 C ASA26150 WRITE (6,6) ASA26160 RETURN ASA26170 C ASA26180 C ASA26190 6 FORMAT (1H0) ASA26200 7 FORMAT (2X,I2,2(2X,I2,2X,E11.5,1X,E11.5,1X,E11.5,1X,E11.5,1X,F6.1)ASA26210 1) ASA26220 8 FORMAT (/2(46X,'NORMALIZED',5X)/' SEG',2(' NODE',4X,'REAL',6X,'IMAASA26230 1GINARY',3X,'MAGNITUDE',3X,'MAGNITUDE',3X,'PHASE')) ASA26240 END ASA26250 SUBROUTINE SART (DATAX,DATAY,N) ASA26260 DIMENSION DATAX(500), DATAY(500) ASA26270 C ASA26280 C THIS ROUTINE SORTS DATA IN DATAY BY MAGNITUDE ASA26290 C ASA26300 NN = N-1 ASA26310 C ASA26320 DO 2 I=1,NN ASA26330 NM = I+1 ASA26340 C ASA26350 DO 1 J=NM,N ASA26360 IF (DATAY(I).GE.DATAY(J)) GO TO 1 ASA26370 STOR = DATAY(I) ASA26380 DATA Y(I) = DATAY(J) ASA26390 DATA Y(J) = STOR ASA26400 STOR = DATAX(I) ASA26410 DATA X(I) = DATAX(J) ASA26420 DATA X(J) = STOR ASA26430 1 CONTINUE ASA26440 C ASA26450 2 CONTINUE ASA26460 C ASA26470 RETURN ASA26480 END ASA26490 SUBROUTINE SGANT (IA,IB,INM,INT,ISC,I1,I2,I3,JA,JB,MD,N,ND,NM,NP,AASA26500 1M,BM,C,CGD,CMM,D,EP2,EP3,ETA,FHZ,GAM,SGD,X,Y,Z,ZLD,ZS,ERR,IGRD) ASA26510 COMPLEX ERR ASA26520 COMPLEX ZG,ZH,ZS,EGD,GD,CGDS,SGDS,SGDT,B01 ASA26530 COMPLEX P11,P12,P21,P22,Q11,Q12,Q21,Q22,EP2,EP,ETA,GAM,EP3 ASA26540 COMPLEX EPSILA,CWEA,BETA,ZARG ASA26550 COMPLEX P(2,2),Q(2,2),CGD(1),SGD(1),C(1),ZLD(1) ASA26560 DIMENSION X(1), Y(1), Z(1), D(1), IA(1), IB(1), MD(INM,4) ASA26570 DIMENSION I1(1), I2(1), I3(1), JA(1), JB(1), ND(1), ISC(1) ASA26580 DATA E0,TP,U0/8.854E-12,6.28318,1.2566E-6/ ASA26590 EP = EP3 ASA26600 ICC = (N*N+N)/2 ASA26610 C ASA26620 DO 1 I=1,ICC ASA26630 1 C(I) = (.0,.0) ASA26640 C ASA26650 ZS = (.0,.0) ASA26660 IF (CMM.LE.0.) GO TO 2 ASA26670 OMEGA = TP*FHZ ASA26680 EPSILA = CMPLX(E0,-CMM*1.E6/OMEGA) ASA26690 CWEA = (.0,1.)*OMEGA*EPSILA ASA26700 BETA = OMEGA*SQRT(U0)*CSQRT(EPSILA-EP) ASA26710 ZARG = BETA*AM ASA26720 CALL CBES (ZARG,B01) ASA26730 ZS = BETA*B01/CWEA ASA26740 2 ZH = ZS/(TP*AM*GAM) ASA26750 DMIN = 1.E30 ASA26760 DMAX = .0 ASA26770 C ASA26780 DO 3 J=1,NM ASA26790 K = IA(J) ASA26800 L = IB(J) ASA26810 D(J) = SQRT((X(K)-X(L))**2+(Y(K)-Y(L))**2+(Z(K)-Z(L))**2) ASA26820 IF (D(J).LT.DMIN) DMIN=D(J) ASA26830 IF (D(J).GT.DMAX) DMAX=D(J) ASA26840 EGD = CEXP(GAM*D(J)) ASA26850 CGD(J) = (EGD+1./EGD)/2. ASA26860 3 SGD(J) = (EGD-1./EGD)/2. ASA26870 C ASA26880 IF (DMIN.LT.2.*AM) GO TO 4 ASA26890 IF (CABS(GAM*AM).GT.0.06) GO TO 4 ASA26900 IF (CABS(GAM*DMAX).GT.3.) GO TO 4 ASA26910 IF (AM.GT.0.) GO TO 5 ASA26920 4 CONTINUE ASA26930 C N=0 ASA26940 WRITE (6,24) AM,DMAX,DMIN ASA26950 WRITE (6,25) ASA26960 C ASA26970 5 DO 19 K=1,NM ASA26980 IFLAG = 0 ASA26990 IF ((IGRD.GT.0).AND.(K.GT.NM/2)) IFLAG=1 ASA27000 NDK = ND(K) ASA27010 KA = IA(K) ASA27020 KB = IB(K) ASA27030 DK = D(K) ASA27040 CGDS = CGD(K) ASA27050 SGDS = SGD(K) ASA27060 C ASA27070 DO 19 L=1,NM ASA27080 JFLAG = 0 ASA27090 IF ((IGRD.GT.0).AND.(L.GT.NM/2)) JFLAG=1 ASA27100 NDL = ND(L) ASA27110 LA = IA(L) ASA27120 LB = IB(L) ASA27130 DL = D(L) ASA27140 SGDT = SGD(L) ASA27150 NIL = 0 ASA27160 C ASA27170 DO 19 II=1,NDK ASA27180 I = MD(K,II) ASA27190 MM = (I-1)*N-(I*I-I)/2 ASA27200 FI = 1. ASA27210 IF (KB.EQ.I2(I)) GO TO 6 ASA27220 IF (KB.EQ.I1(I)) FI=-1. ASA27230 IS = 1 ASA27240 GO TO 7 ASA27250 6 IF (KA.EQ.I3(I)) FI=-1. ASA27260 IS = 2 ASA27270 C ASA27280 7 DO 19 JJ=1,NDL ASA27290 J = MD(L,JJ) ASA27300 MMM = MM+J ASA27310 IF (I.GT.J) GO TO 19 ASA27320 FJ = 1. ASA27330 IF (LB.EQ.I2(J)) GO TO 8 ASA27340 IF (LB.EQ.I1(J)) FJ=-1. ASA27350 JS = 1 ASA27360 GO TO 9 ASA27370 8 IF (LA.EQ.I3(J)) FJ=-1. ASA27380 JS = 2 ASA27390 9 IF (NIL.NE.0) GO TO 18 ASA27400 NIL = 1 ASA27410 IF (K.EQ.L) GO TO 14 ASA27420 IND = (LA-KA)*(LB-KA)*(LA-KB)*(LB-KB) ASA27430 NGRD = IGRD ASA27440 IF (IFLAG.EQ.JFLAG) IGRD=-1 ASA27450 IF (IND.EQ.0) GO TO 10 ASA27460 C SEGMENTS K AND L SHARE NO POINTS ASA27470 CALL GGS (X(KA),Y(KA),Z(KA),X(KB),Y(KB),Z(KB),X(LA),Y(LA),Z(LA),X(ASA27480 1LB),Y(LB),Z(LB),AM,DK,CGDS,SGDS,DL,SGDT,INT,ETA,GAM,P(1,1),P(1,2),ASA27490 2P(2,1),P(2,2),ERR,IGRD) ASA27500 IGRD = NGRD ASA27510 GO TO 18 ASA27520 C SEGMENTS K AND L SHARE ONE POINT (THEY INTERSECT) ASA27530 10 KG = 0 ASA27540 JM = KB ASA27550 JC = KA ASA27560 KF = 1 ASA27570 IND = (KB-LA)*(KB-LB) ASA27580 IF (IND.NE.0) GO TO 11 ASA27590 JC = KB ASA27600 KF = -1 ASA27610 JM = KA ASA27620 KG = 3 ASA27630 11 LG = 3 ASA27640 JP = LA ASA27650 LF = -1 ASA27660 IF (LB.EQ.JC) GO TO 12 ASA27670 JP = LB ASA27680 LF = 1 ASA27690 LG = 0 ASA27700 12 SGN = KF*LF ASA27710 CPSI = ((X(JP)-X(JC))*(X(JM)-X(JC))+(Y(JP)-Y(JC))*(Y(JM)-Y(JC))+(ZASA27720 1(JP)-Z(JC))*(Z(JM)-Z(JC)))/(DK*DL) ASA27730 CALL GGMM (.0,DK,.0,DL,AM,CGDS,SGDS,SGDT,CPSI,ETA,GAM,Q(1,1),Q(1,2ASA27740 1),Q(2,1),Q(2,2)) ASA27750 C ASA27760 DO 13 KK=1,2 ASA27770 KP = IABS(KK-KG) ASA27780 C ASA27790 DO 13 LL=1,2 ASA27800 LP = IABS(LL-LG) ASA27810 P(KP,LP) = SGN*Q(KK,LL) ASA27820 13 CONTINUE ASA27830 C ASA27840 IGRD=NGRD ASA27850 GO TO 18 ASA27860 C K=L (SELF REACTION OF SEGMENT K) ASA27870 14 Q11 = (.0,.0) ASA27880 Q12 = (.0,.0) ASA27890 IF (CMM.LE.0.) GO TO 15 ASA27900 GD = GAM*DK ASA27910 ZG = ZH/(SGDS**2) ASA27920 Q11 = ZG*(SGDS*CGDS-GD)/2. ASA27930 Q12 = ZG*(GD*CGDS-SGDS)/2. ASA27940 15 ISCK = ISC(K) ASA27950 P11 = (.0,.0) ASA27960 P12 = (.0,.0) ASA27970 IF (ISCK.EQ.0) GO TO 16 ASA27980 IF (BM.LE.AM) GO TO 16 ASA27990 CALL DSHELL (AM,BM,DK,CGDS,SGDS,EP2,EP,ETA,GAM,P11,P12) ASA28000 16 Q11 = P11+Q11 ASA28010 Q12 = P12+Q12 ASA28020 CALL GGMM (.0,DK,.0,DK,AM,CGDS,SGDS,SGDS,1.,ETA,GAM,P11,P12,P21,P2ASA28030 12) ASA28040 Q11 = P11+Q11 ASA28050 Q12 = P12+Q12 ASA28060 P(1,1) = Q11 ASA28070 P(1,2) = Q12 ASA28080 P(2,1) = Q12 ASA28090 P(2,2) = Q11 ASA28100 IF (KA.NE.LA) GO TO 17 ASA28110 GO TO 18 ASA28120 17 P(1,1) = -Q12 ASA28130 P(1,2) = -Q11 ASA28140 P(2,1) = -Q11 ASA28150 P(2,2) = -Q12 ASA28160 18 C(MMM) = C(MMM)+FI*FJ*P(IS,JS) ASA28170 19 CONTINUE ASA28180 C ASA28190 C ASA28200 DO 23 I=1,N ASA28210 MM = (I-1)*N-(I*I-I)/2 ASA28220 IJ = MM+I ASA28230 JJA = JA(I) ASA28240 J1 = JJA ASA28250 II2 = I2(I) ASA28260 II1 = I1(I) ASA28270 IF (II2.EQ.IB(J1)) J1=J1+NM ASA28280 JJB = JB(I) ASA28290 J2 = JJB ASA28300 IF (II2.EQ.IB(J2)) J2=J2+NM ASA28310 C(IJ) = C(IJ)+ZLD(J1)+ZLD(J2) ASA28320 JJJ = JJA ASA28330 C ASA28340 DO 22 K=1,2 ASA28350 NDJ = ND(JJJ) ASA28360 C ASA28370 DO 21 JJ=1,NDJ ASA28380 J = MD(JJJ,JJ) ASA28390 IF (J.EQ.I) GO TO 21 ASA28400 IF (I2(J).NE.II2) GO TO 21 ASA28410 IJ = MM+J ASA28420 FI = 1. ASA28430 IF (K.EQ.2) GO TO 20 ASA28440 IF (I1(J).NE.II1) FI=-1. ASA28450 C(IJ) = C(IJ)+FI*ZLD(J1) ASA28460 GO TO 21 ASA28470 20 IF (I3(J).NE.I3(I)) FI=-1. ASA28480 C(IJ) = C(IJ)+FI*ZLD(J2) ASA28490 21 CONTINUE ASA28500 C ASA28510 22 JJJ = JJB ASA28520 C ASA28530 23 CONTINUE ASA28540 C ASA28550 RETURN ASA28560 C ASA28570 24 FORMAT (3X,'AM = ',E10.3,3X,'DMAX = ',E10.3,3X,'DMIN = ',E10.3) ASA28580 25 FORMAT (' WARNING **********************************************'/ASA28590 1,' THIS PROBLEM EXCEED LIMIT OF THIN WIRE CONDITION, THE RESULTS ASA28600 2 ARE NOT CORRECT') ASA28610 END ASA28620 SUBROUTINE SORT (IA,IB,I1,I2,I3,JA,JB,MD,ND,NM,NP,N,MAX,MIN,ICJ,INASA28630 1M) ASA28640 DIMENSION JSP(20) ASA28650 DIMENSION I1(1), I2(1), I3(1), JA(1), JB(1) ASA28660 DIMENSION IA(1), IB(1), ND(1), MD(INM,4) ASA28670 I = 0 ASA28680 C ASA28690 DO 3 K=1,NP ASA28700 NJK = 0 ASA28710 C ASA28720 DO 1 J=1,NM ASA28730 IND = (IA(J)-K)*(IB(J)-K) ASA28740 IF (IND.NE.0) GO TO 1 ASA28750 NJK = NJK+1 ASA28760 JSP(NJK) = J ASA28770 1 CONTINUE ASA28780 C ASA28790 MOD = NJK-1 ASA28800 IF (MOD.LE.0) GO TO 3 ASA28810 C ASA28820 DO 2 IMD=1,MOD ASA28830 I = I+1 ASA28840 IF (I.GT.ICJ) GO TO 2 ASA28850 IPD = IMD+1 ASA28860 JAI = JSP(IMD) ASA28870 JA(I) = JAI ASA28880 JBI = JSP(IPD) ASA28890 JB(I) = JBI ASA28900 I1(I) = IA(JAI) ASA28910 IF (IA(JAI).EQ.K) I1(I)=IB(JAI) ASA28920 I2(I) = K ASA28930 I3(I) = IA(JBI) ASA28940 IF (IA(JBI).EQ.K) I3(I)=IB(JBI) ASA28950 2 CONTINUE ASA28960 C ASA28970 3 CONTINUE ASA28980 C ASA28990 N = I ASA29000 C ASA29010 DO 4 J=1,NM ASA29020 ND(J) = 0 ASA29030 C ASA29040 DO 4 K=1,4 ASA29050 4 MD(J,K) = 0 ASA29060 C ASA29070 III = N ASA29080 IF (N.GT.ICJ) III = ICJ ASA29090 C ASA29100 DO 8 I=1,III ASA29110 J = JA(I) ASA29120 C ASA29130 DO 7 L=1,2 ASA29140 ND(J) = ND(J)+1 ASA29150 K = 1 ASA29160 M = 0 ASA29170 5 MJK = MD(J,K) ASA29180 IF (MJK.NE.0) GO TO 6 ASA29190 M = 1 ASA29200 MD(J,K) = I ASA29210 6 K = K+1 ASA29220 IF (K.GT.4) GO TO 7 ASA29230 IF (M.EQ.0) GO TO 5 ASA29240 7 J = JB(I) ASA29250 C ASA29260 8 CONTINUE ASA29270 C ASA29280 MIN = 100 ASA29290 MAX = 0 ASA29300 C ASA29310 DO 9 J=1,NM ASA29320 NDJ = ND(J) ASA29330 IF (NDJ.GT.MAX) MAX=NDJ ASA29340 9 IF (NDJ.LT.MIN) MIN=NDJ ASA29350 C ASA29360 RETURN ASA29370 END ASA29380 SUBROUTINE SQROT (C,S,IWR,I12,NEQ) ASA29390 COMPLEX C(1),S(1),SS ASA29400 N = NEQ ASA29410 IF (I12.EQ.2) GO TO 6 ASA29420 C(1) = CSQRT(C(1)) ASA29430 C ASA29440 DO 1 K=2,N ASA29450 1 C(K) = C(K)/C(1) ASA29460 C ASA29470 C ASA29480 DO 5 I=2,N ASA29490 IMO = I-1 ASA29500 IPO = I+1 ASA29510 ID = (I-1)*N-(I*I-I)/2 ASA29520 II = ID+I ASA29530 C ASA29540 DO 2 L=1,IMO ASA29550 LI = (L-1)*N-(L*L-L)/2+I ASA29560 2 C(II) = C(II)-C(LI)*C(LI) ASA29570 C ASA29580 C(II) = CSQRT(C(II)) ASA29590 IF (IPO.GT.N) GO TO 5 ASA29600 C ASA29610 DO 4 J=IPO,N ASA29620 IJ = ID+J ASA29630 C ASA29640 DO 3 M=1,IMO ASA29650 MD = (M-1)*N-(M*M-M)/2 ASA29660 MI = MD+I ASA29670 MJ = MD+J ASA29680 3 C(IJ) = C(IJ)-C(MJ)*C(MI) ASA29690 C ASA29700 4 C(IJ) = C(IJ)/C(II) ASA29710 C ASA29720 5 CONTINUE ASA29730 C ASA29740 6 S(1) = S(1)/C(1) ASA29750 C ASA29760 DO 8 I=2,N ASA29770 IMO = I-1 ASA29780 C ASA29790 DO 7 L=1,IMO ASA29800 LI = (L-1)*N-(L*L-L)/2+I ASA29810 7 S(I) = S(I)-C(LI)*S(L) ASA29820 C ASA29830 II = (I-1)*N-(I*I-I)/2+I ASA29840 8 S(I) = S(I)/C(II) ASA29850 C ASA29860 NN = ((N+1)*N)/2 ASA29870 S(N) = S(N)/C(NN) ASA29880 NMO = N-1 ASA29890 C ASA29900 DO 10 I=1,NMO ASA29910 K = N-I ASA29920 KPO = K+1 ASA29930 KD = (K-1)*N-(K*K-K)/2 ASA29940 C ASA29950 DO 9 L=KPO,N ASA29960 KL = KD+L ASA29970 9 S(K) = S(K)-C(KL)*S(L) ASA29980 C ASA29990 KK = KD+K ASA30000 10 S(K) = S(K)/C(KK) ASA30010 C ASA30020 IF (IWR.LE.0) GO TO 13 ASA30030 CNOR = .0 ASA30040 C ASA30050 DO 11 I=1,N ASA30060 SA = CABS(S(I)) ASA30070 11 IF (SA.GT.CNOR) CNOR=SA ASA30080 C ASA30090 IF (CNOR.LE.0.) CNOR=1. ASA30100 C ASA30110 DO 12 I=1,N ASA30120 SS = S(I) ASA30130 SA = CABS(SS) ASA30140 SNOR = SA/CNOR ASA30150 PH = .0 ASA30160 IF (SA.GT.0.) PH = 57.29578*ATAN2(AIMAG(SS),REAL(SS)) ASA30170 12 WRITE (6,14) I,SNOR,SA,PH,SS ASA30180 C ASA30190 WRITE (6,15) ASA30200 13 RETURN ASA30210 C ASA30220 14 FORMAT (1X,1I5,1F10.3,1F15.7,1F10.0,2F15.6) ASA30230 15 FORMAT (1H0) ASA30240 END ASA30250