PROGRAM LEASTSQ WRITE (*,1000) 1000 FORMAT(' LEAST SQUARES FITTING PACKAGE'/ 1' SELECT A CODE CORRESPONDING TO ONE OF THE FOLLOWING PACKAGES'/ 2/'CODE PACKAGE'/ 3' 1 FIT TO EYRING EQUATION FOR ACTIVATION PARAMETERS'/ 4' 2 FIT TO FIRST ORDER RATE EQUATION (ADJUSTABLE INFINITY)'/ 5' 3 FIT TO GENERALISED POLYNOMIAL') 2 READ(*,*,END=5) ICODE IF(ICODE.EQ.1) CALL ACTIV IF(ICODE.EQ.2) CALL FIRST IF(ICODE.EQ.3) CALL POLY GO TO 2 5 WRITE(6,2000) 2000 FORMAT(' EXIT FROM PACKAGE--------'/ 1' FOR A PLOT OF YOUR DATA, EXECUTE:'/ 2' STEK '// 3' AND SELECT THE XY OPTION') CALL EXIT END SUBROUTINE ACTIV DIMENSION X(50),Y(50),XX(50),YY(50),ICAP(12),XC(50),YC(50),YD(50) DIMENSION T95(600), T99(600), IYF(50) CHARACTER IYF*2, ICAP*10 DATA R,RX/8.3142,23.76/ DATA (T95(I),I=1,29)/12.7062,4.3027,3.1825,2.7765,2.5706,2.4469,2. 13646,2.3060,2.2622,2.2281,2.2010,2.1788,2.1604,2.1448,2.1315,2.119 29,2.1098,2.1009,2.0930,2.0860,2.0796,2.0739,2.0687,2.0639,2.0595,2 3.0555,2.0518,2.0484,2.0452/ DATA (T95(I),I=30,500)/10*2.0423,10*2.0211,10*2.0086,10*2.0003,10* 11.9944,10*1.9901,10*1.9867,20*1.9840,30*1.9799,50*1.9759,50*1.9719 2,50*1.9695,50*1.9679,50*1.9668,50*1.9659,50*1.9652,1.9647/ DATA (T99(I),I=1,29)/63.6569,9.9248,5.8410,4.6042,4.0322,3.7075,3. 14995,3.3554,3.2499,3.1693,3.1058,3.0546,3.0123,2.9769,2.9467,2.920 28,2.8982,2.8785,2.8609,2.8454,2.8314,2.8188,2.8073,2.7970,2.7874,2 3.7787,2.7707,2.7633,2.7564/ DATA (T99(I),I=30,500)/10*2.7500,10*2.7045,10*2.6778,10*2.6603,10* 12.6479,10*2.6387,10*2.6316,20*2.6259,30*2.6174,50*2.6090,50*2.6006 2,50*2.5956,50*2.5923,50*2.5899,50*2.5882,50*2.5868,2.5857/ DATA (T95(I),I=501,600)/100*1.9647/ DATA (T99(I),I=501,600)/100*2.5857/ 10 VAR=0. DO 9 KK = 1,50 9 IYF(KK) = ' ' NN=0 SUMXY=0. VAR=0. SUMXX=0. SUMYY=0. SUMX=0. SUMY=0. WRITE(6,4444) 4444 FORMAT('INPUT A TITLE') READ (*,227,END=223) (ICAP(J),J=1,5) 227 FORMAT(5A10) WRITE(6,4445) 4445 FORMAT('INPUT NUMBER OF PAIRS OF TEMP. AND RATES') READ (*,*,END=223) NN WRITE(6,2219) READ (*,*,END=331) (XX(L),YY(L),L=1,NN) 2219 FORMAT('INPUT PAIRS OF TEMPERATURES AND RATE CONSTANTS'//) DO 20 L=1,NN X(L)=1./(XX(L)-0.0000) Y(L) = ALOG(ABS(YY(L)/XX(L))) SUMX=SUMX+X(L) SUMY=SUMY+Y(L) SUMYY=SUMYY+Y(L)*Y(L) SUMXX=SUMXX+X(L)*X(L) SUMXY=SUMXY+X(L)*Y(L) 20 CONTINUE G=NN DENOM=SUMX**2-G*SUMXX SLOPE=(SUMX*SUMY-G*SUMXY)/DENOM AINT=(SUMX*SUMXY-SUMY*SUMXX)/DENOM IF(NN.GT.2)VAR=(SUMYY-AINT*SUMY-SLOPE*SUMXY)/(G-2.) IF(NN.EQ.2)VAR=1.0 SEY = SQRT(VAR) ENTHAL=-(SLOPE*R)/1.E+03 ENTROP=(AINT-RX)*R GIBBS = ENTHAL - 298.0*ENTROP/1.E+03 DO 78 KK = 1,NN YC(KK) = AINT + SLOPE*X(KK) YD(KK) = YC(KK) - Y(KK) IF(ABS(YD(KK)).GT. 1.0*SEY) IYF(KK) = ' *' IF(ABS(YD(KK)).GT. 2.0*SEY) IYF(KK) = '**' 78 CONTINUE ERRENT=1.0 ENT95=1.0 ENNT99=1.0 ERRETO=1.0 ETH95=1.0 ETH99=1.0 SEGIBBS=1.0 IF(NN.EQ.2) GOTO 779 ERRENT=(SQRT(ABS((G/DENOM)*VAR)))*(R/1.E+03) ENT95=ERRENT*T95(NN-2) ENT99=ERRENT*T99(NN-2) ERRETO=(SQRT(ABS((SUMXX/DENOM)*VAR)))*R ETH95=ERRETO*T95(NN-2) ETH99=ERRETO*T99(NN-2) SEGIBBS = SQRT(ERRETO**2 +((298.0*ERRENT)**2)/1.E+6) 779 WRITE (6,60) WRITE (6,70) (XX(L),X(L),YY(L),Y(L),YC(L),YD(L),IYF(L),L=1,NN) WRITE (6,80) SEY WRITE (6,90) ENTHAL,ERRETO,ETH95,ETH99,ENTROP,ERRENT,ENT95,ENT99 WRITE (6,91) GIBBS, SEGIBBS WRITE(12,555) (ICAP(K),K=1,5) 555 FORMAT('***', 6A10) WRITE(12,556) NN,NN 556 FORMAT('2 ', I2, 1X, '-1 ', I2, 1X, '+1') WRITE(12,557) (X(K), Y(K), K=1,NN), (X(K), YC(K),K=1,NN) 557 FORMAT(6(F10.6,2X)) GO TO 10 C 30 FORMAT (I2,I1,12A6) 40 FORMAT (4(F6.2,E12.5)) 50 FORMAT (1H1,31X,12A6/31X,30(2H--)///) 60 FORMAT (1X, ' TEMP.(DEG K) 1/T RATE (S-1) LN(K/T) 1 LN(K/T) CALC DIFF') 70 FORMAT (1X, F8.2,F14.9,E12.4,F16.7,2X,F14.7,2X,F14.7,2X,A2) 80 FORMAT (/' POINTS MARKED * DEVIATE BY MORE THAN * STANDARD DEVIAT 1IONS',/' STANDARD DEVIATION FOR LN(K/T) = ', F8.3//) 90 FORMAT (1X, 25HENTHALPY OF ACTIVATION = ,F8.3,5H +/- ,F8.3, 13H KJ 1/MOL (SE) ,/39X,F8.3, 13H (95) ,/39X,F8.3, 14H (99) 2 ,/1X, 24HENTROPY OF ACTIVATION = ,F9.3,5H +/- ,F8.5, 9H J/MOL/ 3K,/39X,F8.5, 12H (95),/39X,F8.5, 12H (99)) 91 FORMAT(/1X, 'FREE ENERGY OF ACTIVATION (298K) = ', F8.3, ' +/- ' 1,F9.3,' KJ/MOL (SE)') C 223 WRITE(12,4412) 4412 FORMAT('$$$') RETURN 331 WRITE(6,332) 332 FORMAT('NOT ENOUGH PAIRS OF POINTS') RETURN END SUBROUTINE FIRST DIMENSION A(3,3), COEF(3), IWT(4), YY(50), ICAP(12), C(6), X(50) DIMENSION Y(50), B(4) CHARACTER IWT*10, ICAP*10 DATA IWT/' ABSOLUTE',' RELATIVE',' ABSOLUTE',' RELATIVE'/ 10 WRITE (6,1000) READ (*,1050,END=26,ERR=25) (ICAP(M),M=1,11) IF (ICAP(1).EQ.'STOP. ') WRITE (6,1010) IF (ICAP(1).EQ.'STOP. ') RETURN WRITE (6,1020) READ (*,*,END=25,ERR=25) JW,ABC WRITE (4,1030) (ICAP(M),M=1,11),JW,ABC WRITE (6,1040) NN = 0 20 NN = NN+1 READ (*,*,ERR=27,END=30) YY(NN),X(NN) WRITE (4,1060) YY(NN),X(NN) IF (ABS(YY(NN)).LT.1.E-09.AND.NN.NE.1) GO TO 30 GO TO 20 27 WRITE(6,1151) NN= NN-1 GO TO 20 30 CONTINUE NN = NN-1 IF (NN.LT.3.OR.NN.GT.50.OR.JW.GT.2.OR.JW.LT.0) GO TO 10 BC = NN-3 AN = NN VAR = 0.0 SUMXY = VAR SUMX2 = SUMXY SUMX = SUMX2 SUMY = SUMX MARK = 0 DO 40 JJ = 1,NN Y(JJ) = ALOG(ABS(YY(JJ)-ABC)) SUMXY = SUMXY+Y(JJ)*X(JJ) SUMX2 = SUMX2+X(JJ)**2 SUMX = SUMX+X(JJ) 40 SUMY = SUMY+Y(JJ) DENOM = AN*SUMX2-SUMX**2 IF ((YY(NN)-ABC).GT.0.) JN = 1 IF ((YY(NN)-ABC).LT.0.) JN = 2 C(4) = ABC C(5) = (SUMY*SUMX2-SUMX*SUMXY)/DENOM B1 = C(5) C(6) = (SUMX*SUMY-AN*SUMXY)/DENOM AK1 = C(6) 50 DO 60 J = 1,3 B(J) = 0. C(J) = B(J) COEF(J) = C(J) DO 60 K = 1,3 60 A(J,K) = 0.0 MARK = MARK+1 DO 70 JJ = 1,NN IF (JN.EQ.1.AND.YY(JJ).LE.C(4).OR.JN.EQ.2.AND.YY(JJ).GE.C(4)) GO 1 TO 130 WT = 1.0 IF (JW.EQ.1) WT = 1./(YY(JJ)*YY(JJ)) D = EXP(C(5)-C(6)*X(JJ)) IF (JN.EQ.2) D = -D A(1,1) = A(1,1)+WT A(1,2) = A(1,2)+D*WT A(1,3) = A(1,3)-X(JJ)*D*WT COEF(1) = COEF(1)-(C(4)+D-YY(JJ))*WT A(2,2) = A(2,2)+D*D*WT A(2,3) = A(2,3)-X(JJ)*D*D*WT COEF(2) = COEF(2)-(C(4)+D-YY(JJ))*D*WT A(3,3) = A(3,3)+(X(JJ)**2)*D*D*WT COEF(3) = COEF(3)+((C(4)+D-YY(JJ)))*D*X(JJ)*WT 70 CONTINUE A(2,1) = A(1,2) A(3,1) = A(1,3) A(3,2) = A(2,3) CALL MTRXIN (A,3,WARN) DO 90 J = 1,3 DO 80 K = 1,3 80 C(J) = C(J)+A(J,K)*COEF(K) 90 C(J+3) = C(J+3)+C(J) IF (ABS(C(3)).GE.(C(6)/1.E+03).AND.MARK.LT.10) GO TO 50 DO 110 JJ = 1,NN IF (JW.EQ.1) WT = 1./(YY(JJ)*YY(JJ)) IF (JN.EQ.2) GO TO 100 Y(JJ+NN) = C(4)+EXP(C(5)-C(6)*X(JJ)) B2 = C(4)+EXP(C(5)) GO TO 110 100 Y(JJ+NN) = C(4)-EXP(C(5)-C(6)*X(JJ)) B2 = C(4)-EXP(C(5)) 110 VAR = VAR+((Y(JJ+NN)-YY(JJ))**2)*WT VAR = SQRT(VAR/BC) DO 120 J = 1,3 120 B(J) = (SQRT(ABS(A(J,J)))*VAR) WRITE (6,1070) MARK IF (X(1).GT.0.001) WRITE (6,1080) B2 WRITE (6,1090) (X(JJ),YY(JJ),Y(JJ+NN),JJ=1,NN) WRITE(12,6093) (ICAP(J),J=1,11) 6093 FORMAT('***',11A6) WRITE (12,6094) NN, NN WRITE (12,6095)(X(JJ),YY(JJ),JJ=1,NN),(X(JJ),Y(JJ+NN),JJ=1,NN) 6094 FORMAT(' 2 ',I2,' -1 ',I2,' +1 ') 6095 FORMAT(6(F12.4,1X)) WRITE (6,1100) ABC,C(4),B(1) WRITE (6,1110) B1,C(5),B(2),AK1,C(6),B(3),VAR,IWT(JW+1) IF (MARK.GE.10) WRITE (6,1120) C IF (JW.LT.3) CALL PLOT (X,Y,NN,120,0,0) GO TO 10 130 WRITE (6,1130) MARK WRITE (6,1140) (X(JJ),YY(JJ),JJ=1,NN) C CALL PLOT (X,Y,NN,120,0,0) GO TO 10 C C C 25 WRITE(6,1151) GO TO 10 26 WRITE(12,6096) 6096 FORMAT('$$$') RETURN 1000 FORMAT ('READ TITLE') 1010 FORMAT ('A COPY OF YOUR DATA INPUT IS BEING WRITTEN ON TO'/'LOCAL 1FILE . YOU CAN EDIT THIS IF YOU WANT, AND'/'RUN IT AGAIN BY 2 EXECUTING: RENAME,DATA=TAPE4'/' KINTICB 3,DATA.') 1020 FORMAT ('READ A WEIGHTING FACTOR (2 FOR ABSOLUTE, 1 FOR'/ 1'RELATIVE WEIGHTING) AND AN APPROXIMATE INFINITY, WHICH'/'MUST BE 2EITHER GREATER THAN OR LESS THAN ANY OF THE DATA.') 1030 FORMAT (11A6/2I5,F10.5) 1040 FORMAT ('READ PAIRS OF Y AND TIME; TERMINATE WITH ZERO VALUES.') 1050 FORMAT (11A6) 1060 FORMAT (6(F9.3,F6.1)) 1070 FORMAT (3X,56HVALUES OF PARAMETERS TO A TOLERANCE OF 0.1 PERCENT A 1FTER,I2,12H ITERATIONS.,/3X,35(2H -)//3X,39HTIME REACTION ORD 2INATE R.O.(CALC),/) 1080 FORMAT (3X,6H 0.0,F31.3) 1090 FORMAT (3X,F8.1,F15.3,F14.3) 1100 FORMAT (3X,8HINFINITY,F15.3,F14.3,5H +/-,F6.3) 1110 FORMAT (//3X,35HINITIAL VALUE FOR INTERCEPT ,E11.4/3X,35HFI 1NAL VALUE FOR INTERCEPT ,E11.4,1X,4H+/- ,E10.3/3X,35HINIT 2IAL VALUE FOR RATE CONSTANT ,E11.4/3X,35HFINAL VALUE FOR RATE C 3ONSTANT ,E11.4,1X,4H+/- ,E10.3/3X,35HSTANDARD ERROR OF REACTI 4ON ORDINATE,F23.4,A10/3X,34(2H--)) 1120 FORMAT (//3X,34H ITERATION INCOMPLETE---CHECK DATA) 1130 FORMAT (//3X,38HNEGATIVE LOG TAKEN, DATA DUMPED AFTER ,I2,11HITERA 1TIONS ,//3X,27HTIME REACTION ORDINATE,/) 1140 FORMAT (3X,F8.1,F15.3) 1151 FORMAT('WRONG TYPE OF DATA OR EOF, START AGAIN') END SUBROUTINE MTRXIN (A,N,WARN) DIMENSION A(3,3), IPV(3,3) DO 10 J = 1,N 10 IPV(J,3) = 0 DO 110 I = 1,N AMAX = 0. DO 40 J = 1,N IF (IPV(J,3).EQ.1) GO TO 40 DO 30 K = 1,N IF (IPV(K,3)-1) 20,30,150 20 IF (AMAX.GE.ABS(A(J,K))) GO TO 30 IROW = J ICOLUM = K AMAX = ABS(A(J,K)) 30 CONTINUE 40 CONTINUE C C ILL CONDITIONED MATRIX TEST NORMALISATION C IF (I.GT.1) GO TO 60 AMAX12 = AMAX DO 50 J = 1,N DO 50 K = 1,N 50 A(J,K) = A(J,K)/AMAX 60 IPV(ICOLUM,3) = IPV(ICOLUM,3)+1 IPV(I,1) = IROW IPV(I,2) = ICOLUM IF (IROW.EQ.ICOLUM) GO TO 80 DO 70 LL = 1,N SWAP = A(IROW,LL) A(IROW,LL) = A(ICOLUM,LL) 70 A(ICOLUM,LL) = SWAP 80 PIVOT = A(ICOLUM,ICOLUM) A(ICOLUM,ICOLUM) = 1.0 DO 90 LL = 1,N 90 A(ICOLUM,LL) = A(ICOLUM,LL)/PIVOT DO 110 L1 = 1,N IF (L1.EQ.ICOLUM) GO TO 110 T = A(L1,ICOLUM) A(L1,ICOLUM) = 0.0 DO 100 LL = 1,N 100 A(L1,LL) = A(L1,LL)-A(ICOLUM,LL)*T 110 CONTINUE DO 130 I = 1,N LL = N-I+1 IF (IPV(LL,1).EQ.IPV(LL,2)) GO TO 130 JROW = (IPV(LL,1)) JCOLUM = (IPV(LL,2)) DO 120 K = 1,N SWAP = A(K,JROW) A(K,JROW) = A(K,JCOLUM) 120 A(K,JCOLUM) = SWAP 130 CONTINUE DO 140 J = 1,N DO 140 K = 1,N 140 A(J,K) = A(J,K)/AMAX12 RETURN 150 WRITE (6,1000) RETURN C C C 1000 FORMAT (1X,30H MATRIX IS SINGULAR-CHECK DATA/1X,60(2H *)) END SUBROUTINE POLY C C GENERAL POLYNOMIAL CURVE FITTING PROGRAM C DIMENSION A(10,10), COEF(10), XX(50), YY(50), ICAP(12), C(10), X(5 10),DIFFC(50) CHARACTER ICAP*10 DIMENSION Y(50), B(10), YC(50) C REWIND12 C FIRST DATA CARD. MN= MAXIMUM DEGREE OF POLYNOMIAL, NN= NUMBER OF C**** DATA POINTS, NWT= WEIGHTING(1 FOR RELATIVE ERRORS, 0 FOR ABSOLUTE C**** ERRORS). ICAP CONTAINS TITLE OF PRINTOUT. C WRITE(6,9000) 9000 FORMAT('READ DEGREE, NUMBER OF POINTS, WEIGHTING (1/REL,0/ABS)') 10 READ (*,*,END=222) MN,NN,NWT WRITE(4,140) MN,NN,NWT IF (MN.EQ.0) GOTO 222 IF (NN.EQ. 0) NN = 99 IF (NN.LE.MN) GO TO 130 WRITE(6,9001) 9001 FORMAT('READ VALUES FOR Y AND X') IC = 0 DO 502 JJ=1,NN READ(*,*) YY(JJ), XX(JJ) IF(YY(JJ).EQ.0.0) GO TO 501 IC = IC+1 502 CONTINUE 501 CONTINUE IF (NN.EQ.99) NN= IC WRITE(6,9002) NN 9002 FORMAT('NUMBER OF POINTS IN SET IS ', I3) WRITE(4,160) (YY(JJ),XX(JJ),JJ=1,NN) DO 20 JJ=1,NN C C FUNCTION CARDS-APPROPRIATE FUNCTION OF THE VARIABLES IS FORMED HER C X(JJ)=XX(JJ) Y(JJ) = YY(JJ) 20 CONTINUE DO 120 N=2,MN SUMYZ=0.0 DO 30 J=1,N COEF(J)=0.0 C(J)=0.0 DO 30 K=1,N 30 A(J,K)=0.0 DO 70 JJ=1,NN WT=1. IF (NWT.NE.0) WT=1./(Y(JJ)*Y(JJ)) DO 70 J=1,N IF (J.NE.1) GO TO 40 COEF(J)=COEF(J)+WT*Y(JJ) GO TO 50 40 COEF(J)=COEF(J)+(X(JJ)**(J-1))*WT*Y(JJ) 50 DO 70 K=1,N IF ((K+J).NE.2) GO TO 60 A(J,K)=A(J,K)+WT GO TO 70 60 A(J,K)=A(J,K)+(X(JJ)**(K+J-2))*WT 70 CONTINUE CALL MTRXIN1(A,N,WARN) DO 80 J=1,N DO 80 K=1,N 80 C(J)=C(J)+A(J,K)*COEF(K) DO 100 JJ=1,NN WT=1. IF (NWT.NE.0) WT=1./(Y(JJ)*Y(JJ)) YC(JJ)=C(1) DO 90 J=2,N 90 YC(JJ)=C(J)*(X(JJ)**(J-1))+YC(JJ) DIFFC(JJ) = YC(JJ) - Y(JJ) 100 SUMYZ = SUMYZ + (DIFFC(JJ)**2)*WT AN=NN-N S=SQRT(ABS(SUMYZ/AN)) WRITE (6,170) N,S WRITE (6,180) (XX(JJ),X(JJ),YY(JJ),Y(JJ),YC(JJ),DIFFC(JJ),JJ=1, 1NN) WRITE(12,1211) NN,NN 1211 FORMAT('***'/'2 ', I2, ' -1 ', I2, ' +1 ') WRITE(12,1212) (X(JJ),Y(JJ),JJ=1,NN),(X(JJ),YC(JJ),JJ=1,NN) 1212 FORMAT(8F10.5) DO 110 J=1,N B(J)=(SQRT(ABS(A(J,J))))*S IJ=J-1 WRITE (6,190) IJ,C(J),B(J) 110 CONTINUE 120 CONTINUE GO TO 10 130 WRITE (6,200) GO TO 10 C 222 WRITE(12,1210) 1210 FORMAT('$$$') RETURN 140 FORMAT (I2,I3,I1) 160 FORMAT (2F12.5) 170 FORMAT (///1X, 49HLINEAR LEAST SQUARES FIT TO POLYNOMIAL OF DEGRE 1E ,I1,/1X,'S.E. OF Y IS ',E10.5/1X,30(2H -)//1X, ' INPUT X 1PROCESSED X INPUT Y PROCESSED Y CALCULATED Y DIFFEREN 2CE IN Y',/) 180 FORMAT (6(2X,E12.5)) 190 FORMAT (/1X, 16HCOEFFICIENT OF X,I1, 3H = ,E12.5, 9H +/- ,E 112.5) 200 FORMAT (1X,36H INSUFFICIENT DATA-EXECUTION DELETED) C END SUBROUTINE MTRXIN1(A,N,WARN) DIMENSION A(10,10), IPV(10,10) DO 10 J=1,N 10 IPV(J,3)=0 DO 110 I=1,N AMAX=0. DO 40 J=1,N IF (IPV(J,3).EQ.1) GO TO 40 DO 30 K=1,N IF (IPV(K,3)-1) 20,30,150 20 IF (AMAX.GE.ABS(A(J,K))) GO TO 30 IROW=J ICOLUM=K AMAX=ABS(A(J,K)) 30 CONTINUE 40 CONTINUE C C ILL CONDITIONED MATRIX TEST NORMALISATION C IF (I.GT.1) GO TO 60 AMAX12=AMAX DO 50 J=1,N DO 50 K=1,N 50 A(J,K)=A(J,K)/AMAX 60 IPV(ICOLUM,3)=IPV(ICOLUM,3)+1 IPV(I,1)=IROW IPV(I,2)=ICOLUM IF (IROW.EQ.ICOLUM) GO TO 80 DO 70 LL=1,N SWAP=A(IROW,LL) A(IROW,LL)=A(ICOLUM,LL) 70 A(ICOLUM,LL)=SWAP 80 PIVOT=A(ICOLUM,ICOLUM) A(ICOLUM,ICOLUM)=1.0 DO 90 LL=1,N 90 A(ICOLUM,LL)=A(ICOLUM,LL)/PIVOT DO 110 L1=1,N IF (L1.EQ.ICOLUM) GO TO 110 T=A(L1,ICOLUM) A(L1,ICOLUM)=0.0 DO 100 LL=1,N 100 A(L1,LL)=A(L1,LL)-A(ICOLUM,LL)*T 110 CONTINUE DO 130 I=1,N LL=N-I+1 IF (IPV(LL,1).EQ.IPV(LL,2)) GO TO 130 JROW=(IPV(LL,1)) JCOLUM=(IPV(LL,2)) DO 120 K=1,N SWAP=A(K,JROW) A(K,JROW)=A(K,JCOLUM) 120 A(K,JCOLUM)=SWAP 130 CONTINUE DO 140 J=1,N DO 140 K=1,N 140 A(J,K)=A(J,K)/AMAX12 RETURN 150 WRITE (6,160) RETURN C 160 FORMAT (1X,30H MATRIX IS SINGULAR-CHECK DATA/1X,60(2H *)) C END