home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 10 / 10.iso / l / l292 / 1.ddi / CGJ.FOR < prev    next >
Encoding:
Text File  |  1990-02-20  |  1.5 KB  |  47 lines
  1.       SUBROUTINE ComplexGaussJordan (coefary, constary, numcol,
  2.      +         solcoef, invary, det)
  3.       INCLUDE 'STDHDR.FOR'
  4.       COMPLEX coefary(0:maxc, 0:maxc), constary(0:maxc)
  5.       COMPLEX solcoef(0:maxc), invary(0:maxc, 0:maxc)
  6.       REAL det
  7.       REAL inv[ALLOCATABLE](:,:),coef[ALLOCATABLE](:,:)
  8.       REAL sol[ALLOCATABLE](:),cons[ALLOCATABLE](:)
  9.       INTEGER i, j, nn, ii, jj,iErr
  10.  
  11.       ALLOCATE(inv(0:maxc,0:maxc),coef(0:maxc, 0:maxc), STAT=iErr)
  12.       CALL CheckMem(iErr)
  13.       ALLOCATE(sol(0:maxc),cons(0:maxc),STAT=iErr)
  14.       CALL CheckMem(iErr)
  15.  
  16.       DO i = 0, numcol - 1
  17.         ii = 2 * i
  18.         DO j = 0, numcol - 1
  19.           jj = 2 * j
  20.           coef(ii, jj) = REAL(coefary(i, j))
  21.           coef(ii, jj  + 1) = -IMAG(coefary(i, j))
  22.           coef(ii + 1, jj) = IMAG(coefary(i, j))
  23.           coef(ii + 1, jj + 1) = REAL(coefary(i, j))
  24.         END DO
  25.         cons(ii) = REAL(constary(i))
  26.         cons(ii + 1) = IMAG(constary(i))
  27.       END DO
  28.       nn = 2 * numcol
  29.       CALL GaussJordan(coef, cons, nn, sol, inv, det)
  30.  
  31.       DO i = 0, numcol - 1
  32.         ii = 2 * i
  33.         DO j = 0, numcol - 1
  34.           jj = 2 * j
  35.           invary(i, j) = CMPLX(inv(ii, jj),inv(ii + 1, jj))
  36.         END DO
  37.       solcoef(i) = CMPLX(sol(ii),sol(ii + 1))
  38.       END DO
  39.       DEALLOCATE(inv,coef, STAT=iErr)
  40.       CALL CheckDealloc(iErr)
  41.       DEALLOCATE(sol,cons,STAT=iErr)
  42.       CALL CheckDealloc(iErr)
  43.       END !SUBROUTINE ComplexGaussJordan
  44.  
  45.  
  46.  
  47.