366. 367. 368. 369. 370. 371. 372. 373. 374. 375. 376. 377. 378. 379. 380. 381. 382. 383. 384. 385. 386. 387. 388. 389. 390. 391. 392. 393. 394. 395. 396. 397. 398. 399. 400. 401. 402. 403. 404. 405. 406. 407. GO TO 553 552 STDE=0. FS=0. PCC=1. 553 WRITE(KO,1054) NAME (JCOL (I)), B, STDE, FS, TV, PCC IF(BETAQ.NE.YES) GO TO 565 WRITE(KO,126) DO 561 I=1,NIN BETA=-X (M1+JCOL (I), NCOL)*DSQRT(SS(JCOL(I))/SST) ELAS=-X (M1+JCOL(I), NCOL)*XBAR (JCOL (I))/XBAR (NCOL) 561 WRITE(KO,1054) NAME(JCOL(I)),BETA, ELAS 126 FORMAT (////2X, 'VARIABLE',4X, BETA COEFFICIENT',4X, ELASTICITY AT M 1EAN /) 565 IF(TBLQ.NE.YES) GO TO 570 WRITE(KO,127) NAME (NCOL), NAME(NCOL) 127 FORMAT(////14X, 'OBSERVED',11X, CALCULATED,10X, DEVIATION',11X, 'PE IF(NCOL.EQ.1) LCOL=2 FIND(K8 NCOL) READ(K8 NCOL) (X(I,LCOL), I=1,M) DO 566 I=1,M TEMP=X(I,LCOL)-X(I, NCOL) IF(XII,LCOL).EQ.0.) GO TO 567 PCT X(I,NCOL)/X(I,LCOL)*100. GO TO 568 567 PCT=0. 568 WRITE(KO,125) X(I,LCOL), TEMP,X(I,NCOL), PCT 125 FORMAT(10X,4(G16.7,4X)} 570 MRSQC=1.-FLOAT (M-1)/FLOAT (MDF) +FLOAT (M-1)*MRSQ/FLOAT(MDF) DW=0. IF(SSE.EQ.0.) GO TO 575 SEE DSQRT (MSE) SUM=X(1,NCOL) DO 571 I=2,M SUM=SUM+X (I,NCOL) TEMP=X(I-1,NCOL)-X(I,NCOL) 571 DW=DW+TEMP*TEMP DW=DW/SSE FS=MSR/MSE WRITE(KO,128) SST,SSR,SSE,NIN, MDF,FS, SEE, MRSQ, MRSQC, DW, SUM 128 FORMAT (/////,5X, TOTAL SUM OF SQUARES', G16.7, 1///5X, REGRESSION SUM OF SQUARES' ,G16.7///5X, SUM OF SQUARED R 2ESIDUALS',G16.7///5X, 'F-STATISTIC FOR SIGNIFICANCE OF ALL COEFFICI 3ENTS F(',13,',', 14,')=',G16.7///5X, STANDARD ERROR OF THE ESTIMA 4TE,G16.7///5X, MULTIPLE R-SQUARED,F15.7///5X, MULTIPLE R-SQUARED 4 5CORRECTED FOR DEGREES OF FREEDOM, F15.7///5X, DURBIN WATSON STATIS IF(SEE EQ.0.) GO TO 1590 DO 576 I=1,3 427. 428. 429. 430. 431. PLT=X(I,NCOL)/SEE*10. 129 FORMAT('1PLOT OF STANDARDIZED RESIDUALS' ///15X,'-5S',7X,'-45',7x,' 1-3S, 7X,' -2S',7x,'-1S',8x,'0',9x,'15',8x, '2S',8X, 35,8x, '45',8x,' DO 1580 I=1,M I PLT=PLT+51.5 IF(IPLT.LT.1) IPLT=1 IF(IPLT.GT.101) IPL T=101 IF(IPLT.GT.97) DO 581 K=1, 101 IPLT=97 IF(IPLT.NE.51) GO TO 582 KGPH (51)=KSTAR GO TO 586 KGPH (IPLT) =KSTAR WRITE(KO,130) I,PLT, (KGPH(J), J=1,101) 130 FORMAT(1X,13,2X,F7.4,3X,101A1/66X,'.') TEMP=DABS (PLT) IF(TEMP.LE.1) GO TO 587 [F(TEMP.LE.3) GO TO 1580 587 C(1)=C ( 1 ) + 1 • 588 C(2)=C(2)+1. 589 C (3)=C(3) +1. 1580 CONTINUE GO TO 589 I')) WRITE(KO,131) (I,C(I), I=1,3) 1S OF ZERO IS',F10.4)) PERCENTAGE OF DEVIATIONS WITHIN',12,' STANDARD ERROR 1591 FORMAT('1PLOT OF STANDARDIZED RESIDUALS' /5X,' ALL RESIDUALS ARE ZER 10--NO PLOTTING WILL BE DONE') 590 CONTINUE 515. 516. 517. 518. 519. 520. 521. 522. 523. 524. DO DO 620KKK=1,NPLTS READ PLOT CARD READ(K5, 111) GET REQUISITE DATA FROM K8 FIND (K8KCOL) READ(K8 KCOL){X(I,LCOL), I=1,M) DO 625 KK=1,4 TAMP=0. DO 626 I=1, M 626 TAMP=TAMP+X (I,LCOL) TAMP TAMP/M DO 625 I=1, M 625 XII,LCOL)=X(I,LCOL)-TAMP STDE=VPROD (LCOL,LCOL,1.000) STDE=DSQRT(STDE/(M-1.)) WRITE(KO,631) NAME (KCOL) 631 FORMAT(1PLOT OF STANDARDIZED RESIDUALS (Y-AXIS)',1X,'VS STANDARDI 1ZED,A8, (X-AXIS)'//12X,'-5',8x,'-4',8X,'-3', 8X,'-2',8x,'-1',9X, 2'0',9x,'1'‚9ׂ'2',9ׂ'3',9X,'4',9X,'5'/ 13X,101('.')) KAMP=6 TEMP=26.*TUMF I ROW=1 DO 2120 K=1,51 ISTRT=IROW TEMP=TEMP-TUMP 2121 J=1,101 2121 KGPH (J)=0 IF(IROW.GT.M) GO TO 2125 DO 2130 I=ISTRT,M IF(X(ICOL (I), NCOL).LT.TEMP) GO TO 2125 I PLT=10.*X(ICOL(I), LCOL)/STDE+51.5 IF(IPLT.GT.101) IF(IPLT.LT.1) IPLT=1 KGPH(IPLT)=KGPH(IPLT)+1 IROW=IROW+1 534. 2130 CONTINUE GO TO 720 702 FORMAT('1THESE ARE THE DATA USED TO MAKE PROJECTIONS ///) IF(NPROJ.EQ.C) GO TO 700 READ AND PRINT PROJECTION DATA WRITE(KO,702) DO 710 J=1,N JJ=JCOL (J) READ(K5,701) (X(I, JJ),I=1,NPROJ) 710 WRITE(KO, 1051)JJ, NAME (JJ), (X(I,JJ),I=1,NPROJ) 1051 FORMAT ( OVARIABLE', 14, '--', A8/(1X, 7616.7)) DO 720 I=1, N IF(I.EQ.N) DO 721 J=II,N DO 725 K=J,N 725 TEMP=TEMP+X (M1+JCOL (I), JCOL(K))*X(M1+JCOL (J), JCOL(K))/D(JCOL(K)) X (M1+JCOL (J), JCOL (I))=TEMP 721 CONTINUE 720 CONTINUE MAKE PROJECTIONS DO 730 K=1, NPROJ PROJ=0. IF(CSPQ.NE. YES) PROJ=-X (M1,NCOL) DO 731 J=1,N 731 PROJ=PROJ-X (K,JCOL (J))*X(M1+JCOL (J), NCOL) SEF=0. IF(CSPQ.EQ.YES) GO TO 735 TAKE OUT MEANS IF CONSTANT IN EQUATION 732 X (K, JCOL{J})=X(K, JCOL (J))-XBAR (JCOL (J)) 605. II=JCOL (I) 628. 629. 630. 631. 632. 633. 634. 635. 636. 637. 638. 639. 640. 641. 642. 643. 644. 645. 646. 647. 648. 649. 650. 651. 652. 653. 654. 655. 656. REAL*8 NAME 657. 658. 659. 660. 661. 662. 663. 664. 665. 666. 667. 668. 669. READ(K5,103) ENDQ IF(ENDQ.EQ.XMOR) GO TO 5000 STOP END SUBROUTINE ELIM(I, J) IMPLICIT INTEGER*2(I-N), REAL*8(A-H,O-Z) INTEGER 4 KO REAL*8 NAME DIMENSION X(820,10),XINV(11),SS(10),D(10), JCOL (10), NAME (10) DO 10 K=1, MN 10 X(K, J)=X(K,J)-TEMP*X(K,I) RETURN END REAL FUNCTION VPROD*8( I, J, DUMMY) IMPLICIT INTEGER *2(I-N), REAL 8(A-H, O-Z) INTEGER 4 KO REAL*8 NAME DIMENSION X (820,10),XINV(11),SS(10), D(10), JCOL (10),NAME(10) TUMP DUMMY DO 10 K=1,M TAMP X(K,I) TOMP=X(K,J) 10 TEMP TEMP+T AMP/TUMP TOMP VPROD TEMP RETURN END SUBROUTINE WRT(NCODE,I) IMPLICIT INTEGER*2 (I-N), REAL*8 (A-H,O-Z) INTEGER*4 KO,NCODE DIMENSION X (820,10), XINV(11), SS(10), D(10), JCOL(10), NAME (10) GO TO(10,20,30,40,50,60,70,80,90,100,110,120), NCODE 10 WRITE(KO,1) NAME(JCOL(I)) GO TO 1100 20 WRITE(K0,2) I,NAME(I),(X{J,I), J=1,M) GO TO 1100 30 WRITE(K0,3) I,(X ( J, I ), J= 1,M) GO TO 1100 40 WRITE(KO,4) I,(X(M1+I, J),J=1,NF) GO TO 1100 |