home *** CD-ROM | disk | FTP | other *** search
/ Oakland CPM Archive / oakcpm.iso / sigm / vol152 / ladder.mf4 < prev    next >
Encoding:
Text File  |  1984-04-29  |  4.0 KB  |  171 lines
  1.     PROGRAM LADDER
  2.     INTEGER CHAR
  3.     DIMENSION R(100)
  4.     PI=3.14159
  5.     WRITE (3,1)
  6. 1    FORMAT (' LADDER NETWORK ANALYSIS PROGRAM')
  7.     WRITE (3,222)
  8. 222    FORMAT (
  9.      &' This program analyses a full ladder network for gain and phase'
  10.      &/'  starting at the load and working towards the voltage source.'
  11.      &/' Any null or infinite branches must be declared as such.'
  12.      &/' ...report problems to Trevor Marshall,'
  13.      &/'               SYSOP, Thousand Oaks Tech RBBS (805) 492 3693'/)
  14.     WRITE (3,16)
  15. 16    FORMAT (' NUMBER OF BRANCHES (including the load) ? ')
  16.     READ (3,2) A
  17. 2    FORMAT (F2.0)
  18.     N=2*A+9
  19.     DO 100 I=0,N
  20.     R(I)=0.
  21. 100    CONTINUE
  22.     NN=1
  23. 150    FLAG3=0
  24.     WRITE (3,17)
  25. 17    FORMAT (' R, L or C ? ')
  26.     READ (3,3) CHAR
  27. 3    FORMAT (A1)
  28.     IF (CHAR.EQ.'R ' .OR. CHAR.EQ.'r ') R(3)=1.
  29.     IF (CHAR.EQ.'L ' .OR. CHAR.EQ.'l ') R(3)=2.
  30.     IF (CHAR.EQ.'C ' .OR. CHAR.EQ.'c ') R(3)=3.
  31.     IF (R(3).EQ.3) FLAG3=1
  32.     WRITE (3,18)
  33. 18    FORMAT (' VALUE ? ')
  34.     READ (3,4) R(4)
  35. 4    FORMAT (E12.5)
  36.     IF (R(3).NE.1) GO TO 200
  37. C    IF (.NOT. CHAR.EQ.'R ' .OR. CHAR.EQ.'r ') GOTO 200
  38.     R(NN+10)=R(4)
  39.     GO TO 300
  40. 200    R(NN+11)=PWR1(FLAG3)*R(4)
  41. 300    NN=NN+2
  42.     IF (NN.LE.(2.*A-1.)) GO TO 150
  43.     WRITE (3,5)
  44. 5    FORMAT ('0      OUTPUT')
  45.     IF (R(11).GT.1E-30) WRITE (3,6)
  46. 6    FORMAT ('0OHMS 0----R----O'/'      !         !')
  47.     IF (R(11).GT.1E-30)GO TO 400
  48.     IF (R(12).GT.1E-30) WRITE (3,7)
  49. 7    FORMAT (' HY   O----L----O'/'      !         !')
  50.     IF (R(12).GT.1E-30) GO TO 400
  51.     WRITE (3,8)
  52. 8    FORMAT (' FD   O----C----O'/'      !         !')
  53. 400    NN=3
  54. 450    R(0)=((NN-1.0)/4.0-INT((NN-1.0)/4.0))
  55.     IF (R(0).GT.1E-30) GO TO 500
  56.     IF (R(NN+10).GT.1E-30) WRITE (3,9)
  57. 9    FORMAT (' OHMS !----R----!'/'      !         !')
  58.     IF (R(NN+10).GT.1E-30) GO TO 600
  59.     IF (R(NN+11).GT.1E-30) WRITE (3,10)
  60. 10    FORMAT (' HY   !----L----!'/'      !         !')
  61.     IF (R(NN+11).GT.1E-30) GO TO 600
  62.     WRITE (3,11)
  63. 11    FORMAT (' FD   !----C----!'/'      !         !')
  64.     GO TO 600
  65. 500    IF (R(NN+10).GT.1E-30) WRITE (3,12)
  66. 12    FORMAT (' OHMS R         !'/'      !         !')
  67.     IF (R(NN+10).GT.1E-30) GO TO 600
  68.     IF (R(NN+11).GT.1E-30) WRITE (3,13)
  69. 13    FORMAT (' HY   L         !'/'      !         !')
  70.     IF (R(NN+11).GT.1E-30) GO TO 600
  71.     WRITE (3,14)
  72. 14    FORMAT (' FD   C         !'/'      !         !')
  73. 600    NN=NN+2
  74.     IF (NN.LE.(2*A-1)) GO TO 450
  75. 700    WRITE (3,15)
  76. 15    FORMAT ('      O  INPUT  O')
  77. C
  78. 750    WRITE(3,28)
  79. 28    FORMAT('0FREQUENCY SWEEP STARTS AT ? ')
  80.     READ (3,19) R(0)
  81. 19    FORMAT(E12.5)
  82. C    R(0)=R(0)/(2*PI)                          omega
  83.     WRITE(3,20)
  84. 20    FORMAT('+              AND ENDS AT ? ')
  85.     READ (3,21)R(1)
  86. 21    FORMAT(F5.0)
  87. C    R(1)=R(1)/(2*PI)                          omega
  88.     WRITE(3,22)
  89. 22    FORMAT(' NUMBER OF INTERVALS ')
  90.     READ(3,23)R(2)
  91. 23    FORMAT(F3.0)
  92.     WRITE(3,24)
  93. 24    FORMAT('0FREQ.(HZ),MAGNITUDE (DB),PHASE (DEGREES)'/' ')
  94.     C=R(0)
  95.     R(4)=(R(1)/R(0))**(1./R(2))
  96. C    CALL PLOT S/R 'P'
  97. 900    R(7)=1.
  98.     X=1
  99.     Y=0
  100.     R(5)=0
  101.     R(6)=0
  102.     R(8)=0
  103.     NN=1
  104. 1300    FLAG1=0
  105.     FLAG2=0
  106.     FLAG3=0
  107.     FLAG4=0
  108.     IF(R(NN+10).GT.1E-30)FLAG1=1
  109.     IF(R(NN+10).GT.1E-30)GO TO 1000
  110.     R(10)=R(NN+11)*2.*PI*C
  111.     IF(R(10).GT.1E-30)Z=FLAG2
  112.     IF(R(10).GT.1E-30)GO TO 1100
  113.     FLAG3=1
  114.     R(10)=-1./(R(NN+11)*2.*PI*C)
  115. 1000    R(3)=R(NN+10)
  116. 1100    ZZ=((NN+1.0)/4.0-INT((NN+1.0)/4.0))
  117.     IF(ZZ)1115,1115,1120
  118. 1120    IF(FLAG1.EQ.1)R(3)=1./R(3)
  119.     FLAG4=1.
  120.     IF(FLAG1.EQ.1)GO TO 1115
  121.     R(10)=1./R(10)
  122. 1115    IF(FLAG1.EQ.1)X=R(3)*X
  123.     IF(FLAG1.EQ.0)X=R(10)*X
  124.     IF(FLAG1.EQ.0)ZZ=FLAG4*FLAG2+(1-FLAG4)*FLAG3
  125.     IF(FLAG1.EQ.0)Y=Y+PWR1(ZZ)*PI/2.0
  126.     Z=X*COS(Y)
  127.     Y=X*SIN(Y)
  128.     X=Z
  129.     IF(FLAG4.EQ.0)X=R(7)+X
  130.     IF(FLAG4.EQ.0)Y=R(8)+Y
  131.     IF(FLAG4.EQ.1)X=R(5)+X
  132.     IF(FLAG4.EQ.1)Y=R(6)+Y
  133.     IF(FLAG4.EQ.1)R(5)=X
  134.     IF(FLAG4.EQ.1)R(6)=Y
  135.     IF(FLAG4.EQ.1)GO TO 1200
  136.     R(7)=X
  137.     R(8)=Y
  138. 1200    Z=SQRT(X*X+Y*Y)
  139.     IF(Y.GT.0)R(2)=PI/2.0
  140.     IF(Y.LE.0)R(2)=-PI/2.0
  141.     IF(X)2220,2250,2220
  142. 2220    R(2)=ATAN(Y/X)
  143.     IF(X.LT.0)R(2)=R(2)+PI
  144.     IF(Y.LT.0)R(2)=R(2)-2*PI
  145. 2250    Y=R(2)
  146.     X=Z
  147.     NN=NN+2
  148.     IF(NN.LE.IFIX(2.0*A))GO TO 1300
  149.     X=1.0/X
  150.     ZZ=20*ALOG10(X)
  151.     ZZZ=-Y*180./PI
  152. C    CC=C*2.0*PI                              omega
  153.     CC=C
  154.     WRITE(3,25)CC,ZZ,ZZZ
  155. 25    FORMAT(F8.2,2(' ',F12.2))
  156.     IF (R(0).EQ.R(1))GO TO 1550
  157.     C=C*R(4)
  158.     IF(C.LE.R(1))GO TO 900
  159. 1550    WRITE (3,26)
  160. 26    FORMAT('0NEW SWEEP (Y/N) ? ')
  161.     READ(3,27)ISTRG
  162. 27    FORMAT(A1)
  163.     IF(ISTRG.EQ.'Y ')GO TO 750
  164.     END
  165.     FUNCTION PWR1(Z)
  166.     IF(Z.EQ.0)PWR1=1
  167.     IF(Z.EQ.1)PWR1=-1
  168.     IF(Z.EQ.2)PWR1=1
  169.     RETURN
  170.     END
  171.