C$TEST PRSZ C TO RUN AS A MAIN PROGRAM REMOVE NEXT LINE SUBROUTINE PRSZ C*********************************************************************** C C EXAMPLE OF USE OF THE PORT PROGRAM SPFML C C*********************************************************************** INTEGER I, IWRITE, I1MACH, NEQ REAL X(100), B(100), ERR, SASUM EXTERNAL AROW REAL RSTACK(2500) COMMON/CSTAK/ RSTACK COMMON /NN/ NX CALL ISTKIN(2500,3) NX = 10 NEQ = 100 C C CONSTRUCT A RANDOM VECTOR FOR X C DO 10 I=1,NEQ X(I)=UNI(0) 10 CONTINUE C C FIND THE VECTOR B=AX C CALL SPFML(NEQ,AROW,X,B) C C SOLVE THE SYSTEM AX=B C CALL SPFLE(NEQ,.TRUE.,AROW,ISIZE,B,NEQ,1) C C FIND THE NORM OF THE ERROR OF THE SOLUTION C ERR=0.0 IWRITE = I1MACH(2) DO 20 I=1,NEQ ERR=ERR + ABS(B(I)-X(I)) 20 CONTINUE ERR=ERR/SASUM(NEQ,X,1) WRITE(IWRITE,21)ERR 21 FORMAT(19H RELATIVE ERROR IS ,1PE15.7) STOP END SUBROUTINE AROW(I, ROW, JCOL, NUM) REAL ROW(5) INTEGER JCOL(5) COMMON /NN/ N C C IN THE BLOCK TRIDIAGONAL MATRIX THERE ARE AT MOST 5 C NONZERO ELEMENTS PER ROW AND EACH ROW HAS A DIAGONAL C OF -4. C THE VARIABLE IN INDICATES WHICH BLOCK ONE IS IN AND C THE VARIABLE JN INDICATES WHERE IN THE BLOCK ONE IS AT C IN = (I-1)/N+1 JN = I - (IN-1) * N JCOL(1)=I ROW(1)=-4.0 NUM=2 C C DO THE OFF DIAGONAL ELEMENTS IN THE CURRENT BLOCK C JCOL(2)=I-1 ROW(2)=1.0 IF (JN.GT.1) NUM=NUM+1 JCOL(NUM)=I+1 ROW(NUM)=1.0 IF (JN.LT.N)NUM=NUM+1 C C DO THE BLOCK TO THE LEFT C JCOL(NUM)=I-N ROW(NUM)=1.0 IF (IN.GT.1)NUM=NUM+1 C C DO THE BLOCK TO THE RIGHT C JCOL(NUM)=I+N ROW(NUM)=1.0 IF(IN.EQ.N) NUM=NUM-1 RETURN END .