DPCGRCV.f

Go to the documentation of this file.

      SUBROUTINE dpcgrc(IDO,N,X,P,R,Z,RELERR,ITMAX)
*
      REAL*8 x(n),p(n)
      REAL*8 r(n),z(n)
      REAL*8 relerr
      INTEGER ido,n,itmax
*
      common/dpcgr1/iter
      INTEGER iter
      common/dpcgr2/rsnorm
      REAL*8 rsnorm
      common/dpcgr3/c
      REAL*8 c
      REAL*8 alfa,beta,error,c1
*
      IF(ido.EQ.0) THEN
*       P=X
        DO i=1,n
          p(i)=x(i)
        ENDDO
*       RSNORM=|Z|
        rsnorm=0.
        DO i=1,n
          rsnorm=rsnorm+r(i)*r(i)
        ENDDO
        rsnorm=dsqrt(rsnorm)
        ido=1
        iter=0
        RETURN
      ELSE IF(ido.EQ.1 .AND. iter.EQ.0) THEN
*<      Z=A*P
*       R=R-Z
        DO i=1,n
          r(i)=r(i)-z(i)
        ENDDO
        error = 0.
        DO i = 1,n
          error = error + r(i)*r(i)
        ENDDO
        error=dsqrt(error)/rsnorm
        IF(error.LE.relerr) THEN
          ido=3
          RETURN
        ENDIF
        ido=2
        iter=0
        RETURN
      ELSE IF(ido.EQ.2 .AND.iter.EQ.0) THEN
*<      Z=M-1*R
*       P=Z
        DO i=1,n
          p(i)=z(i)
        ENDDO
*       C=(Z,R)
        c=0.
        DO i=1,n
          c=c+z(i)*r(i)
        ENDDO
        ido=1
        iter=1
        RETURN
      ELSE IF(ido.EQ.1) THEN
*<      Z=A*P
*       ALFA=C/(Z,P)
        alfa=0.
        DO i=1,n
          alfa=alfa+z(i)*p(i)
        ENDDO
        alfa=c/alfa
*       X=X+ALFA*P
        DO i=1,n
          x(i)=x(i)+alfa*p(i)
        ENDDO
*       R=R-ALFA*Z
        DO i=1,n
          r(i)=r(i)-alfa*z(i)
        ENDDO
        error = 0.
        DO i = 1,n
          error = error + r(i)*r(i)
        ENDDO
        error=dsqrt(error)/rsnorm
        IF(error.LE.relerr .OR. iter.GE.itmax) THEN
          ido=3
          RETURN
        ENDIF
        ido=2
        iter=iter+1
        RETURN
      ELSE IF(ido.EQ.2) THEN
*<      Z=M-1*R
*       BETA=(Z,R)/C
        c1=0.
        DO i=1,n
          c1=c1+z(i)*r(i)
        ENDDO
        beta=c1/c
        c=c1
*       P=Z+BETA*P
        DO i=1,n
          p(i)=z(i)+beta*p(i)
        ENDDO
        ido=1
        RETURN
      ENDIF
*
      RETURN
      END