home *** CD-ROM | disk | FTP | other *** search
/ CP/M / CPM_CDROM.iso / simtel / cpmug / cpmug091.ark / ARIT.FOR < prev    next >
Encoding:
Text File  |  1984-04-29  |  3.1 KB  |  109 lines
  1. C*****************************************************************
  2. C
  3. C Written by Victor De Pinto
  4. C Revised Jan. 12, 1982
  5. C
  6.       PROGRAM ARIT
  7.       LOGICAL FN1(11), FN2(11), FN3(11)
  8.       DIMENSION DAT1 (2,1024), DAT2 (2,1024)
  9. 1     WRITE (1,2)
  10. 2     FORMAT (/' --ARITHMETIC FUNCTIONS MENU--'/
  11.      X        ' This routine performs arithmetic functions on one'/
  12.      X        ' or more source files and puts the result in the'/
  13.      X        ' destination file. Select function:'/
  14.      X ' 1  SUM FILES'/
  15.      X ' 2  SUBTRACT SOURCE 2 FROM SOURCE 1'/
  16.      X ' 3  MULTIPLY FILES'/
  17.      X ' 4  DIVIDE SOURCE 1 BY SOURCE 2'/
  18.      X ' 5  MULTIPLY FILE BY A CONSTANT'/
  19.      X ' 6  CONJUGATE OF FILE'/
  20.      X ' 7  MAGNITUDE SQUARED OF A FILE'/
  21.      X ' 8  BACK TO MAIN MENU >> ')
  22. 6     FORMAT (' Source filename 1,')
  23. 5     FORMAT (' Source filename 2,')
  24. 7     FORMAT (' Destination filename,')
  25.       READ (1,4) ICOM
  26. 4     FORMAT (I2)
  27.       GO TO (3,3,3,3,60,60,60,999), ICOM
  28.       GO TO 999
  29. C READ ONE SOURCE FILE
  30. 60    WRITE (1,61)
  31. 61    FORMAT (' Source filename,')
  32.       CALL NAME ( FN1 )
  33.       WRITE (1,7)
  34.       CALL NAME (FN3)
  35.       CALL OPEN (3, FN1, 0)
  36.       READ (3) DAT1
  37.       ENDFILE 3
  38.       GO TO (1,1,1,1,80,90,100,1), ICOM
  39. C READ TWO SOURCE FILES
  40. 3     WRITE (1,6)
  41.       CALL NAME( FN1 )
  42.       WRITE (1,5)
  43.       CALL NAME ( FN2 )
  44.       WRITE (1,7)
  45.       CALL NAME ( FN3 )
  46.       CALL OPEN (3, FN1, 0)
  47.       CALL OPEN (4, FN2, 0)
  48.       READ (3) DAT1
  49.       READ (4) DAT2
  50.       ENDFILE 3
  51.       ENDFILE 4
  52.       GO TO (20,70,30,50,1,1,1,1), ICOM
  53. C DIVIDE DAT1 BY DAT2. RESULT IN DAT2
  54. 50    DO 55 K=1,1024
  55.       A = DAT1(1,K)
  56.       B = DAT1(2,K)
  57.       C = DAT2(1,K)
  58.       D = DAT2(2,K)
  59.       DEN = C**2 + D**2
  60.       DAT2(1,K) = (A*C + B*D) / DEN
  61. 55    DAT2(2,K) = (B*C - A*D) / DEN
  62.       GO TO 40
  63. C SUM DAT1 + DAT2. RESULT IN DAT2.
  64. 20    DO 22 K=1,1024
  65.       DAT2(1,K) = DAT1(1,K) + DAT2(1,K)
  66. 22    DAT2(2,K) = DAT1(2,K) + DAT2(2,K)
  67.       GO TO 40
  68. C MULTIPLY DAT1 X DAT2. RESULT IN DAT2.
  69. 30    DO 34 K=1,1024
  70.       A = DAT1(1,K)
  71.       B = DAT1(2,K)
  72.       C = DAT2(1,K)
  73.       D = DAT2(2,K)
  74.       DAT2(1,K) = A*C - B*D
  75. 34    DAT2(2,K) = B*C + A*D
  76.       GO TO 40
  77. C SUBTRACT DAT2 FROM DAT1. RESULT IN DAT2.
  78. 70    DO 73 K=1,1024
  79.       DAT2(1,K) = DAT1(1,K) - DAT2(1,K)
  80. 73    DAT2(2,K) = DAT1(2,K) - DAT2(2,K)
  81.       GO TO 40
  82. C MULTIPLY DAT1 BY A CONSTANT. RESULT IN DAT2.
  83. 80    WRITE (1,82)
  84. 82    FORMAT (' Enter the constant multiplier:')
  85.       READ (1,84) C
  86. 84    FORMAT (F10.0)
  87.       DO 86 K=1,1024
  88.       DAT2(1,K) = DAT1(1,K) * C
  89. 86    DAT2(2,K) = DAT1(2,K) * C
  90.       GO TO 40
  91. C COMPLEX CONJUGATE OF DAT1. RESULT IN DAT2.
  92. 90    DO 95 K=1,1024
  93.       DAT2(1,K) = DAT1(1,K)
  94. 95    DAT2(2,K) = -DAT1(2,K)
  95.       GO TO 40
  96. C MAGNITUDE SQUARED OF DAT1. RESULT IN DAT2.
  97. 100   DO 105 K=1,1024
  98.       DAT2(2,K) = 0.0
  99. 105   DAT2(1,K) = DAT1(1,K)**2 + DAT1(2,K)**2
  100.       GO TO 40
  101. C WRITE DAT2 TO DISK AND GO TO MENU.
  102. 40    CALL OPEN (5, FN3, 0)
  103.       WRITE (5) DAT2
  104.       ENDFILE 5
  105.       GO TO 1
  106. C DONE. CHAIN BACK TO UTILITY.
  107. 999   CALL FCHAIN ( 'UTIL    COM', 0 )
  108.       E  N  D
  109.