CTITLESAPK05 - SUBROUTINE USED BY SDPICK 00010000 C*********************************************************************** C COPYRIGHT ATLANTIC RICHFIELD COMPANY 1991 * C*********************************************************************** CA 00020000 CA DESIGNER P. C. LUH 00030000 CA AUTHOR P. C. LUH 00040000 CA LANGUAGE FORTRAN 00050000 CA SYSTEM IBM ONLY 00060000 CA DATE MM/DD/YY 00070000 C REVISED 03/06/86 LBL OLD NAME = FIT 00080000 C 00090000 C 00100000 C SUBROUTINE FIT(A,B,XL,XOF,T,X) 00110000 SUBROUTINE SAPK05(A,B,XL,XOF,T,X) 00120000 C 00130000 COMMON/IND/INXT,INX2,NSEG,NSEF,NSEH,NX,INXX,INTX,NSHOT 00140000 + ,INDI,INDJ,INDK,INJJ,INKK,INJ0,INK0,INII,INI0 00150000 + ,MX,INX1,INT1,INXP,INNS,INYJ,INGK,INAL,INWK 00160000 + ,ISXC,IXC2,IXCD,INSD,ININ,IWK1,SUMRE,IPR,DX,KPBUGF,CONS 00170000 C 00180000 DIMENSION A(1),B(1),X(1),XOF(1),T(1),XL(1) 00190000 C 00200000 C CALL INFIT(NSEG,NX,XL,XOF,T,X(INYJ),X(INGK),NSEH,X(INAL),X(ININ), 00210000 CALL SAPK08(NSEG,NX,XL,XOF,T,X(INYJ),X(INGK),NSEH,X(INAL),X(ININ),00220000 + IPR) 00230000 C 00240000 C CALL RLLAV(X(INAL),NX,NX,NSEG,0,A,SUMRE,ITER,IRANK,X(INXX), 00250000 CALL SAPK38(X(INAL),NX,NX,NSEG,0,A,SUMRE,ITER,IRANK,X(INXX), 00260000 + X(IWK1),IER) 00270000 IF(KPBUGF.GT.0) 00280000 +WRITE(IPR, *)SUMRE,ITER,IRANK,IER 00290000 C 00300000 B(1)=A(NSEH) 00310000 X(INWK)=1. 00320000 IF(NSEG.LT.2) GO TO 20 00330000 XX=B(1) 00340000 C 00350000 DO 10 I=2,NSEG 00360000 XX=XX+X(INGK+I-2)*A(I-1) 00370000 B(I)=XX-A(I)*XL(I-1) 00380000 X(INWK+I-2)=-100. 00390000 IF(A(I-1).NE.0.) X(INWK+I-2)=A(I)/A(I-1) 00400000 IF(X(INWK+I-2).LE.0.) X(INWK+I-2)=-100. 00410000 10 CONTINUE 00420000 C 00430000 20 CONTINUE 00440000 IF(KPBUGF.LT.1) RETURN 00450000 WRITE(IPR, *)(A(I),I=1,NSEG),(X(INWK+I-1),I=1,NSEF) 00460000 WRITE(IPR, *)(B(I),I=1,NSEG) 00470000 C 00480000 RETURN 00490000 C 00500000 END 00510000