      SUBROUTINE PETR(X,B,WRK,LDA,IPAR,SPAR,MATVEC,CMATVEC)
      IMPLICIT NONE
C solves Ax=b
C
C Input:
C B(LOCLEN) - RHS (doesn't change on output)
C WRK(LDA, LOCLEN) - scratch array 
C IPAR - defines integer paramteres (see documentation of PIM)
C SPAR - define real parameters
C LDA - leading dimension of arrays 
C MATVEC -- name of procedure for computing y=Ax
C CMATVEC -- name of procedure for computing y= conj(A') x
C
C Output:
C X(LOCLEN)
C 
C Reference:
C    Petravic,M and Kuo-Petravic,G. 1979, JCP, 32,263
C History: 
C    Late 80'  (Coded by Draine)
C    Changes to include "cprod" (PJF+BTD)
C    95.06.01 (PJF) re-written to conform to PIM
C    95.08.11 (BTD) minor editing (comments, etc.)
C
C Parameters:
      INTEGER IACE,IAXI,IGI,IPI,IQI,IR
      PARAMETER (IACE=1,IGI=2,IPI=3,IQI=4,IAXI=5,IR=6)
C Arguments:
      INTEGER LDA
      INTEGER IPAR(*)
      REAL SPAR(*)
      COMPLEX B(*), WRK(LDA,*), X(*)
      EXTERNAL CMATVEC,MATVEC
C
C Local variables
      COMPLEX CDUMMY
      INTEGER IDUMMY,ITNO,L,LOCLEN,MAXIT,STATUS
      REAL
     &   ALPHAI,BETAI1,BNORM,DUMMY,EPSILON,EXITNORM,
     &   GIGI,GI1GI1,QIQI,RHSSTOP
      REAL SCSETRHSSTOP
      EXTERNAL PSCNRM2
C
C***********************************************************************
      LOCLEN = IPAR(4)
      MAXIT = IPAR(10)
      EPSILON=SPAR(1)
C
C Compute RHSSTOP = EPSILON*|B|
C
      RHSSTOP = SCSETRHSSTOP(B,CDUMMY,EPSILON,IPAR,CDUMMY,PSCNRM2)
C
C Compute conjg(A')*B
C
      CALL CMATVEC(B,WRK(1,IACE),IDUMMY)
      BNORM = 0.
      DO 170 L = 1,LOCLEN
         BNORM = BNORM + REAL(B(L)*CONJG(B(L)))
         WRK(L,IGI) = WRK(L,IACE)
         WRK(L,IPI) = WRK(L,IGI)
  170 CONTINUE
C
C Compute |QI>=A|PI>
C
      CALL MATVEC(WRK(1,IPI), WRK(1,IQI), IDUMMY)
      QIQI = 0.
      GIGI = 0.
      DO 190 L = 1,LOCLEN
         GIGI = GIGI + REAL(CONJG(WRK(L,IGI))*WRK(l,IGI))
         QIQI = QIQI + REAL(CONJG(WRK(L,IQI))*WRK(L,IQI))
  190 CONTINUE
      ALPHAI = GIGI/QIQI
      DO 200 L = 1,LOCLEN
         X(L) = X(L) + ALPHAI*WRK(L,IPI)
  200 CONTINUE
C
C compute |AX1>:
C
      CALL MATVEC(X,WRK(1,IAXI),IDUMMY)
C
      DO 340 ITNO = 2,MAXIT
         IPAR(11) = ITNO
C
C Transfer <GI|GI> -> <GI-1|GI-1>:
C
         GI1GI1 = GIGI
C
C compute |GI>=AC|E>-AC|AXI>:
C
         CALL CMATVEC(WRK(1,IAXI), WRK(1,IGI), IDUMMY)
C
C Compute GIGI=<GI|GI>:
         GIGI = 0.
         DO 230 L = 1,LOCLEN
            WRK(L,IGI) = WRK(L,IACE) - WRK(L,IGI)
  230    CONTINUE
         DO 235 L = 1,LOCLEN
            GIGI = GIGI + REAL(CONJG(WRK(L,IGI))*WRK(L,IGI))
  235    CONTINUE
C
C Compute BETAI-1=<GI|GI>/<GI-1|GI-1>:
C
         BETAI1 = GIGI/GI1GI1
C
C Compute |PI>=|GI>+BETAI-1|PI-1>:
C
         DO 240 L = 1,LOCLEN
            WRK(L,IPI) = WRK(L,IGI) + BETAI1*WRK(L,IPI)
  240    CONTINUE
C
C Compute |QI>=A|PI>:
C
         CALL MATVEC(WRK(1,IPI), WRK(1,IQI), IDUMMY)
C
C Compute <QI|QI>:
C
         QIQI = 0.
         DO 250 L = 1,LOCLEN
            QIQI = QIQI + REAL(CONJG(WRK(L,IQI))*WRK(L,IQI))
  250    CONTINUE
C
C Compute ALPHAI = <GI|GI>/<QI|QI>:
C
         ALPHAI = GIGI/QIQI
C
C Compute |XI+1>=|XI>+ALPHAI*|PI>:
C
         DO 260 L = 1,LOCLEN
            X(L) = X(L) + ALPHAI*WRK(L,IPI)
  260    CONTINUE
C
C Except every 10TH iteration, compute |AXI+1>=|AXI>+ALPHAI*|QI>
C Draine: warning this part perhaps not checked 
C
         IF (ITNO.NE.10* (ITNO/10)) THEN
         DO 270 L = 1,LOCLEN
            WRK(L,IAXI) = WRK(L,IAXI) + ALPHAI*WRK(L,IQI)
  270    CONTINUE
         ELSE 
            CALL MATVEC(X,WRK(1,IAXI),IDUMMY)
         ENDIF
C
C Compute residual vector |RI>=A|XI>-|B>
C
         DO 300 L=1, LOCLEN
            WRK(L,IR) = WRK(L,IAXI)-B(L)
 300     CONTINUE
C
C Call STOPCRIT to check whether to terminate iteration.
C Criterion: terminate if <RI|RI> < TOL**2 * <B|B>
C Return with STATUS=0 if this condition is satisfied.
C
         CALL STOPCRIT(B,WRK(1,IR),CDUMMY,CDUMMY,CDUMMY,WRK,
     +                 RHSSTOP,IDUMMY,EXITNORM,
     +                 STATUS,IPAR,DUMMY,DUMMY,DUMMY,DUMMY,PSCNRM2)
C
C Call PROGRESS to report "error" = sqrt(<RI|RI>)/sqrt(<B|B>)
C
         CALL PROGRESS(LOCLEN,ITNO,EXITNORM,CDUMMY,CDUMMY,CDUMMY)
C      
      IF(STATUS.EQ.0)GOTO 500
 340  CONTINUE
 500  CONTINUE
      IPAR(12) = 0
      RETURN
      END



