home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 10 / 10.iso / l / l292 / 1.ddi / CGJDEMO.FOR < prev    next >
Encoding:
Text File  |  1990-02-20  |  3.4 KB  |  119 lines
  1.  
  2.  
  3.       PROGRAM CGJDEMO
  4.       INCLUDE 'STDHDR.FOR'
  5.  
  6.       COMPLEX  x(0:maxc, 0:maxc),y(0:maxc)
  7.       COMPLEX solution(0:maxc),  cinv(0:maxc, 0:maxc)
  8.       INTEGER numvar,i
  9.       REAL matdet
  10.  
  11.  
  12.       CALL  Getdata(x,y,numvar)
  13.  
  14.       CALL ComplexGaussJordan(x, y, numvar, solution, cinv, matdet)
  15.  
  16.       WRITE (*,*) 'The solution is: '
  17.       WRITE (*,*)
  18.       DO i = 0, numvar - 1
  19.         WRITE (*,20) 'x', i, ' = ', REAL(solution(i)),
  20.      +        IMAG(solution(i)), 'j '
  21. 20    FORMAT (A2, I2, A3 F7.2, F7.2, A2)
  22.       END DO
  23.       WRITE (*,*)
  24.       WRITE (*,25) 'Matrix determinant = ', matdet
  25. 25    FORMAT (1X, A21, F10.2)
  26.       CALL CheckAnswer(x, solution, numvar)
  27.  
  28.       END
  29.  
  30.  
  31.  
  32.  
  33.       SUBROUTINE CheckAnswer( x, solution, numvar)
  34.       INCLUDE 'STDHDR.FOR'
  35.       COMPLEX  x(0:maxc, 0:maxc)
  36.       COMPLEX solution(0:maxc)
  37.  
  38.       COMPLEX sum(0:maxr),temp, temp2
  39.       INTEGER i, j
  40.        WRITE (*,*) 'Checking the answer by calculating'
  41.        WRITE (*,*) 'y values using calculated'
  42.        WRITE (*,*) 'x values and original coefficients.'
  43.        DO i = 0, numvar - 1
  44.         sum(i) = CMPLX(0.0,0.0)
  45.         DO j = 0, numvar - 1
  46.           CALL ComplexMath(x(i, j), 2, solution(j), temp)
  47.           CALL ComplexMath(sum(i), 0, temp, temp2)
  48.           sum(i) = temp2
  49.         END DO
  50.         WRITE (*,15) 'y', i,
  51.      +      ' = ( ', REAL(sum(i)), IMAG(sum(i)), 'J  )'
  52. 15      FORMAT (1X, A2, I2, A6, F7.2, 1X, F7.2, A5)
  53.         WRITE (*,*)
  54.       END DO
  55.       END !SUBROUTINE CheckAnswer
  56.  
  57.  
  58.  
  59.  
  60.  
  61.       SUBROUTINE Getdata(x,y,numvar)
  62.       INCLUDE 'STDHDR.FOR'
  63.       COMPLEX  x(0:maxc, 0:maxc),y(0:maxc)
  64.       INTEGER numvar, ans
  65.       REAL tmpr,tmpi
  66.  
  67.       ans = 0
  68.       DO WHILE (ans .eq. 0)
  69.         WRITE (*,*) 'Enter number of equations '
  70.         WRITE (*,11) 'must equal number of variables:  '
  71. 11      FORMAT (1X, A33 \)
  72.         READ *, numvar
  73.         WRITE (*,*)
  74.         WRITE (*,*)
  75.      +     'You will be asked to enter the complex coefficients.'
  76.         WRITE (*,*) 'Enter the real part first, then the'
  77.         WRITE (*,*) 'Coefficient of the imaginary part.'
  78.         DO i = 0, numvar - 1
  79.           WRITE (*,*) 'Equation # ', i
  80.           DO j = 0, numvar - 1
  81.             WRITE (*,14) 'Complex coefficient # ',j
  82. 14          FORMAT (1X, A22 I2 )
  83.             WRITE (*,12) ' Real=     '
  84.             READ  *, tmpr
  85.             WRITE (*,12) ' Imaginary= '
  86. 12          FORMAT (A18 \)
  87.             READ *, tmpi
  88.             x(i, j) = CMPLX(tmpr,tmpi)
  89.           END DO
  90.           WRITE (*,13) ' Constant  real =  '
  91.           READ *, tmpr
  92.           WRITE (*,13) '      Imaginary =  '
  93. 13        FORMAT (A25 \)
  94.           READ *, tmpi
  95.           y(i) = CMPLX(tmpr,tmpi)
  96.           WRITE (*,*)
  97.         END DO
  98.         WRITE (*,*) 'The following system of equations was entered:'
  99.         WRITE (*,*)
  100.         DO i = 0, numvar - 1
  101.           DO j = 0, numvar - 1
  102.             WRITE (*,19) '(', REAL(x(i, j)), IMAG(x(i, j)),
  103.      +         'i X',j,')'
  104.             IF (j .NE. numvar)  WRITE (*,20) '+'
  105. 19          FORMAT( 1X, A2, 2(F5.2) A3,I2, A1\)
  106. 20          FORMAT( A2\ )
  107.           END DO
  108.           WRITE (*,21) ' = (', REAL(y(i)), IMAG(y(i)), 'i)'
  109. 21        FORMAT (A5, 2(F5.2), A3)
  110.           WRITE (*,*)
  111.         END DO
  112.  
  113.         WRITE (*,*) 'Is this right (1-y OR 0-n) '
  114.         READ *, ans
  115.       END DO
  116.       END !SUBROUTINE GetData
  117.  
  118.  
  119.