Файловый архив студентов. Файловый архив студентов.
1271 вуз, 4663 предмет.
/ Регистрация
FAQ Обратная связь Вопросы и предложения
Добавил:
Опубликованный материал нарушает ваши авторские права? Сообщите нам.
Вуз:
Пермский национальный исследовательский политехнический университет
Предмет:
[НЕСОРТИРОВАННОЕ]
Файл:

книги / Статистический анализ данных в геологии. Кн. 2

.pdf
Скачиваний:
0
Добавлен:
12.11.2023
Размер:
19.38 Mб
Скачать
☆

О О О

... INVALID DATA MATRIX DIMENSIONS

О О О

501 LZ - -9 CALL CLSALL CALL INVLID(4) CALL PAUSE(2) RETURN

... DIVIDE BY ZERO

502 LZ = -9

 

 

 

CALL CLSALL

 

 

 

CALL INVUD(5)

 

 

 

CALL PAUSE(2)

 

 

 

RETURN

 

 

 

2000 FORMAT (///,' Source cf,14X.'Sum

of Degrees

of Mean',/

1' Variaiion',13X,’Squares

Freedom

Squares

F-TestsV,

21X,60(1 H-))

Samples,7X,F 10.2.I8.2X.F10.3,.'.

2001 FORMAT (14H Among

141 X.F20.4)

2005 FORMAT (14H Among Samples,TX.LIO 3.:8,2Х.Е10.3./,

141 X.F20.4)

 

 

 

2 0 0 2

FORMAT

(17Н

Among

Treatments,4X,r10.2,i3,2X,Г-: '..3,/,4 1" .F2 0 .4)

2006

FORMAT

(17H

Among

Treatments.4X,t l0.3,io,r<.,E; 0.3,/,. -„Г-20

2003

FORMAT

(6H

Error,15X.F10.2,IL.2X.F10.3j

2007

FORMAT

(6H

Error,15X,E10.3,l8.2X,E10.3)

2004 FORMAT (/.16H Total Variation,5X,FI0.2,18)

2008 FORMAT i/.ILH Total Varia!ion.5X.Ei0.3,l8)

END

\_/

 

CLINFIT

L!NFIT - PROGRAM 5-3

C

 

C ROUi INE L INFIT

C

C PROGRAM TO FIT A LINEAR REGRESSION.

C ARRAY A CONTAINS X AND Y DATA THAT IS READ IN.

О ARRAY В CONTAINS THE COEFFICIENTS OF THE UNKNOWN B'3 IN THE C NORMAL EQUATIONS 5.7 AND 5.8.

C ARRAY C ORIGINALLY IS A VECTOR THAT CONTAINS THE SUM OF THE v s C AND THE SUMS OF THE CROSSPRODUCTS OF X AND Y IN EQUATION 5.11 C AFTER THE NORMAL EQUATIONS ARE SOLVED, ARRAY C CONTAINS THE C COEFFICIENTS OF THE REGRESSION EQUATION.

C SUMS OF THE CROSSPRODUCTS OF X AND Y IN EQUATION 5.11.

C ARRAY D CONTAINS X, Y, Y-CALCULATED, AND DEVIATIONS FOR ALL C DATA POINTS.

C

402

сТМ“ MAXIMUM NUMBER OF OBSERVATIONS IS 100.

C

C SUBROUTINES NEEDED ARE READM, PRINTM, AND SLE.

;\ ; E R O U T I N E U N F I T

''4MON /TLC/ SV(20),!2,LU,Z11,Z22,D11,D?2,NZZ,NSP,DPC,PFT,UPA

Г. I.’.MON /IOLUN/ I5,I6,J5,J3,J4

c: ‘ ..ION /IONAT/ KO RF,MON,IPRT,KORFO

о-FACTERM KORF,MON,IPRT,KORFO

: OMMON /DATQ/ A(100,2),S(2,2),C(2),D(100.4)

/Л Ч = 100

V' E(I3.200)

-о ".MAT(/- LINEAR REGRESSION MODULE’//)

"E’-'D X-Y DATA

KORF.EQ.'K ) WRITE(I6,201)

2 'i "ORMAT(T Enter number of obseived pairs: ') READ(J5,*,END=bC0) N.NCOL

'r;N.LE.1.0P..NC0L.NE.2) GOTO 501 l-(N.LZ.NMAX) GOTO 105

•~iTE!!6,202) NMAX

202 ,-ORMAT(/' Number of observed pairs exceed max of ',I4)

12 = -9

CALL PAUSE(2) RETURN

:C5 DO 108 1=1 ,N

r vKORF.EQ.'K') WRITE(I6,203) I

203 FORMATf Enter X, Y of observed pair ',14,': ’) READ(J5,*,END=500) (A(i,J),J=1,2)

106 CONTINUE

О О О

CALCULATE SUMS FOR LEAST SQUARES SOLUTION

DC 100 1=1,2

C 'b - 'O 0

DO 101 J= 1,2 В (1.J)—о 0

101 CONTINUE

100 CONTINUE DO 102 L1,N

8(1,1)=B(1,1) +1.0 B(1,2)=B(1,2)+A(l,1) B{2,2)=B(2,2)+A(I,1)*A(I.1) C(1)=C(1)+A(I,2)

C{2)=C(2)+A(I,1 )*A(I,2)

102CONTINUE В(2,1)=В(1,2)

о о о о

SOLVE THE SIMULTANEOUS LINEAR EQUATIONS WHICH ARE OF THE FORM OF 5.7 AND 5.8 IN THE TEXT.

IF(MON.EQ.’Y') WRITE(I6,1001)

IF(IPRT.EQ.'Y') WRITE(J6,1001)

CALL PRINTM(0,B,2,2,2,2)

IF(MON.EQ.'Y') WRITE(I6,1 002)

IF(IPRT.EQ.'Y') WRITE(J6,1002)

CALL PRINTM(0,C,1,2,1,2)

о CALL SLE(B,C,2,2,1.0E-05) IF(LZ.LT.O) CALL PAUSE(2) IF(LZ.LT.O) RETURN о SLOPE = C(2)

IF(MON.EQ.'Y') WRITE(I6,1003) IF(IPRT.EQ.'Y') WRIJE(J6,1003) CALL PRINTM(0,C,1,2,1,2)

о

^

DO 103 1=1 ,N

D(l,1 )=A(I,1)

D(I,2)=A(I,2)

D(I,3)=C(1 )+C(2)*D(l,1) D(I,4)=D(I,2)-D(I,3)

103 CONTINUE

IF(MON.EQ.'Y') WRITE(I6,1004) IF(IPRT.EQ.'Y') WRITE(J6,1004) CALL PRINTM(0,D,N,4,100,4)

ООО

... CALCULATE ERROR MEASURES

SY=0.0

SY2=0.0

SYC=0.0

SYC2=0.0 DO 104 1=1,N SY=SY+D(I,2)

SY2=SY2+D(I,2)*D(I,2)

SYC=SYC+D(I,3)

SYC2=SYC2+D(I,3)*D(I,3) 104 CONTINUE

SST=SY2-SY*SY/FLOAT(N) SSR=SYC2-SYC*SYC/FLOAT(N) SSD=SST-SSR

IF(SST.EO.O.O) GOTO 502

4 0 4

ООО

R2=SSR/SST IF(SLOPE.GE.O.O) R=SQRT(R2)

IF(SLOPE.LT.O.O) R=-1.0‘SQRT(R2' , IF(MON.EQ.’N‘) GOTO 110

WRITE (16,2000) N

WRITE (16,2001) SST

WRITE (16,2002) SSR

WRITE (16,2003) SSD

WRITE (16,2004) R2

WRITE (16,2005) R

,0 IF(IPRT.EQ.'N') GOTO 150 WRITE (J6,2000) N

WRITE (J6,2001) SST WRITE (J6.2002) SSR - WRITE (J6.2003) SSD WRITE (J6.2004) R2 WRITE (J6.2005) R

150 CALL PAUSE(3) RETURN

... END OF FILE ENCOUNTERED

500 LZ = -9 CALL CLSALL CALL INVLID(3) CALL PAUSE(2) RETURN

... INVALID DATA MATRIX DIMENSIONS

ООО

501 LZ = -9 CALL CLSALL CALL INVLlD(4) CALL PAUSE(2) RETURN

ООО

... DIVIDE BY ZERO

502 LZ = -9

CALL CLSALL

CALL INVLID(5)

CALL PAUSE(2)

RETURN

1001 FORMAT (///,' Coefficient Matrix of Unknown Parameters’,

1’ In Normal Equations')

1002 ^ORMAT(f Vector of Sum of Y”s and Sum of Crossproducts',

1' of X and Y‘)

1003 FORMATS The Estimated Parameters of the Regression Equation’)

405

1004 FORMAT)/’ Column 1 = X Variable' Г Column 2 = Y Variab'e 1‘ Column 3 = Y Value Based On Regression Equation'

2

Column 4 = Column 2 - Column 3')

 

2000 FORMAT (У,28H Number of Observed Pairs = .15)

2001

FORMAT (25H To.al Sums of Squares =

.F20.5)

2002

FORMAT (37H Sums of Squares Due To Regression -=,F20 5

2003

FORMAT (36H

Sums of Squares Due To Deviation .= Г20 5)

2004

FORMAT (19H

Goodness of Fit = ,F15.6)

.FI5.6)

О

5 FORMAT (27H Correlation Coefficient =

ILINO

 

 

с

 

CPRINTM

PRINTM - PROGRAM 4-2

О О О О

SUBROUTINE ТО PRINT A MATRIX HAVING N ROWS AND M COLUMNS

SUBROUTINE PRINTM(KFIL,A,N.M,N1,M1)

COMMON /TLC/ SV(20),LZ,LU,Z11 ,Z22,D11,D22,NZZ,NSP,DPC,DFT,ll COMMON /IOLUN/ I5,I6,J5,J6,J4

COMMON /IONAT/ KORF,MON,IPRT,KORFO CHARACTERS KORF,MON,IPRT,KORFO DIMENSION A(N1 ,M1)

О

IF(KFIL.EQ.I) CALL CLEAR IF(KFIL.EQ.I) WRITE(I6.203)

203 FORMAT(/’ PRINT OUT MATRIX'//)

О О О

... PRINT MATRIX OUT l[4 STRIPS OF 5 COLUMNS

NROW = 0

IF(KFILEQ.O) GOTO 102

О О О

.. READ MATRiX FROM INPUT DATA FILE

IF(KORF.EQ.'K') WRITE(I6,200)

200 FORMAT(/' Enter number of rows and columns for matrix: ') READ(J5,*,END=S00) N,M

IF(N,LE,N1 .AND.M.LE.M1) GOTO 103 WRITE(I6,201) N1.M1

201 FORMAT(/' Number of rows, columns exceed max of ',I4,' by ’,I4) LZ = -9

RETURN

103 DO 104 1=1 .N

IF(KORF.EQ.'K') WRITE(I6,202) I

202 FORMAT/ Enter row ':I4,' of matrix: ') READ(J5,\END=500) (A(I,J),J=1 ,M)

(04 CONTINUE

О О О

... NOW PRINT OUT MATRIX

102 DO 100 1ВИ.М.5 IE = IB + 4

IF (IE - M) 2,2,1 1 IE = M

О О О

PRINT HEADING

2 IF(MON.EQ.'Y’) WRITE(I6,2000) (l,l=IB,IE)

4 0 7

IF(IPRT.EQ.‘Y’)WRITE(J6,2000) (I.WB.IE) DO 101 J-1.N

C

C... PRINT ROW OF MATRIX C

IF(MON.EQ,’Y‘) WRITE(I6,2001) J,(A(J,K),K=IB,IE)

IFOPRT ~Q.’Y')WRITE(J6,2001) J,(A(J,K),K=IB,IE)

NROW = NROW + 1

IFfMON.EQ.’Y’.AND MOD(NROW,10).EQ.0) CALL PAUSE(O) 101 CONTINUE

100 CONTINUE

IF(MON.EQ.T.AND.MOD(NROW,10).NE.O.AND.KFIL.EQ.O) CALL PAUSE(O) IFfMON.EQ.’N'.AND.IPRT.EQ.'Y’.AND.KFlL.EQ.I) VVRITE(I6,204) ■

204 FORMATf/’ Output file created’) RETURN

C

C... END OF FILE ENCOUNTERED C

500 LZ = -9 CALL CLSALL CALL INVLID(3) RETURN

2000 FORMATf/,5X ,5(8X,14,3X),/)

2001 F0RMAT(I5,5F1 5,5) END

C

CADDM ADDM ■ PROGRAM 4-3 C

C SUBROUTINE TO ADD TWO MATRICES

C A AND В TO FORM C. ALL HAVE N ROWS AND M COLUMNS C

SUBROUTINE ADDM(A,B,C,N,M,N1 ,M1) DIMENSION A(N1 ,M1 ),B(N1 ,M1 ),C(N1 ,M1) DO 100 M ,N

DO 101 J=.1,M

C(I,J)=A(I,J)+B(I,J) 101 CONTINUE

00 CONTINUE RETURN END

C

 

CCMULT

CMULT - PROGRAM 4-5

C

 

C SUBROUTINE TO MULTIPLY EACH ELEMENT OF A MATRIX BY A C CONSTANT В TO FORM THE MATRIX C.

C EACH MATRIX HAS N ROWS AND M COLUMNS. C

C C=B*MAT(A)

4 0 8

с

SUBROUTINE CMULT(A,B.C,N,M,N1,M1) DIMENSION A(N1,M1),C(N1,M1)

DO 100 1=1,N

DO 101 J=1,M

C(I,J)=B*A(I,J)

101 CONTINUE

100 CONTINUE

RETURN END

C

CMMULT MMULT - PROGRAM 4-7 C

C SUBROUTINE FOR MULTIPLICATION OF MATRIX A BY MATRIX В

C TO GIVE MATRIX C. A IS L ROWS BY N COLUMNS.

СВ IS N ROWS BY M COLUMNS, AND C WILL BE L ROWS BY M COLUMNS

C

SUBROUTINE MMULT(A,B,C,L,N,M,NA.MA,NB,MB,NC,MC) DIMENSION A(NA,MA),B(NB,MB),C(NC,MC)

DO 100 1=1,L

DO 101 J=1,M C(l,J)=0.0 DO 102 K=1 ,N

C(I,J)=C(I,J)+A(I,K)*B(K,J) 102 CONTINUE

101 CONTINUE

100 CONTINUE

RETURN END

C

 

CMINV

MINV - PROGRAM 4-8

о о о о о

О О О о

SUBROUTINE TO FIND INVERSE OF MATRIX A. В IS THE INVERSE OF A. A IS REDUCED TO THE IDENTITY MATRIX.

A AND В ARE N X N. DET IS THE DETERMINANT OF A.

SUBROUTINE MINV(A,B,N,N1,DET)

DIMENSION A(N1,N1),B(N1,N1) COMMON /IOLUN/ I5,I6,J5,J6,J4

COMMON Я LC / SV(20),LZ,LU,Z11 ,Z22,D11 ,D22,NZZ,NSP,DPC,DFT,UPA

ZERO = 1 .OE-05

SET В TO IDENTITY MATRIX AND SAVE THE ORIGINAL A MATRIX

DO 100 1=1,N

DO 101 J=1 ,N

B(l,J)=0.0

409

101 CONTINUE

B(l.l)-1.0

100 CONTINUE

DET-1.0

C

C CALCULATE INVERSE C

DO 102 1-1,N

CDIVIDE ITH ROW OF A AND В BY A(l,I) DIV=A(I,I)

IF(ABS(DIV) ZERO) 99,99,2

2DET=DET*DIV DO 103 J-1,N

A(I,J)=A(I,J)/D!V

B(I,J)=B(I,J)/QIV 103 CONTINUE

CREDUCE THE ITH COLUMN OF A TO ZERO DO 104 J=1 ,N

 

 

IF (l-J) 1,104,1

 

 

1

RATIO=A(J,l)

 

 

DO 105 K-1.N

 

 

 

 

A(J,K)=A(J,K) RATIO*A(l,K)

 

 

 

B(J.K)=B(J,K) RATIO‘B(l,K)

 

 

105

CONTINUE

 

 

 

104 CONTINUE

 

 

 

102 CONTINUE

 

 

 

WRITE(I6,201) DET

 

 

201

FORMAT(/'

Determinant of Matrix A

» F15 5)

C

RETURN

 

 

 

 

 

 

C

MATRIX CANNOT BE INVERTED A DIAGONAL ELEMENT IS APPROXIMATELY

C

ZERO

 

 

C

 

 

 

 

99 DET - 0 0

 

 

 

WRITE(I6,202)

 

 

202 FORMAT)/'

Matrix Cannoi Be

Inverted')

 

LZ = 9

 

 

 

CALL PAUSE(2)

 

 

RETURN

 

 

C

END

 

 

 

 

 

 

CSLE

SLE

PROGRAM 4 9

 

C

C SUBROUTINE FOR SOLUTION OF N SIMULTANEOUS EQUATIONS

C MATRIX A IS N X N AND В IS A COLUMN VECTOR OF N ELEMENTS

CA IS CONVERTED TO THE IDENTITY MATRIX

СВ CONTAINS SOLUTION

C

C
C
C
C

SUBROUTINE SLE(A,B,N,N1 .ZERO)

COMMON T L C / SV(20),LZ,LU,Z11,Z22,D11,D22.NZZ,NSP,DPC,DFT UPA

COMMON /IOLUN/ l5,l6,J5,Je,J4 DIMENSION A(N1 ,N1 ),B(N1)

DO 100 1=1,N DIV=A(I,I)

IF (ABS(DIV)-ZERO) 99,99,1 1 DO 101 J=1 ,N

A(I.J)=A(I,J)/DIV

101CONTINUE 3(I)=B(I)/DIV

DO 102 J=1 ,N IF (! J) 2,102.2

2 RATIO=A(J,l)

DO 103 K=1,N A(J,K)=A(J,K)RATIO‘A(l,K)

103CONTINUE B(J)=.Bf.l)-RATIO-B(:)

102 CONTINUE

100 CONTINUE

RETURN

99 WRITE-(i6,200)

200 FORMAT(/' Matrix Cannot Be Inverted. System o!',

1/' Simultaneous Linear Equations Cannot Be Solved.') LZ = -9

RETURN EMC

C

CEIGENJ EIGTNJ - PROGRAM 4-1 0 C

C SUBROUTINE T0 CALCULATE. THE EIGENVALUES AND EIGENVECTORS

C OF AN NXN SYMMETRIC f/ATRiX.

r>

C UPON COMPLETION THE EIGENVALUES ARE STORED IN THE DIAGONAL

CELEMENTS OF MATRIX A (IN DESCENDING ORDER) THE EIGENVECTORS ARE STORED BY COLUMNS IN MATRIX B.

о о о о

EIGENVALUE A(l,I) CORRESPONDS TO EIGENVECTOR (B(J ,I),J = 1 ,N)

SUBROUTINE EIGENJ(A,B,N,N1)

DIMENSION A(N1 ,N1 ),B(N1 ,N1)

COMMON /TLC/ SV(20),U,LU,Z1 1.Z22.D1 1 ,D22,NZZ,NSP,DPC.DFT.UPA

... CALCULATE INITIAL AND FINAL NORMS SET В TO IDENTITY MATRIX

IF(N.LE.O) GOTO 502 ANORM=0.0

411

Соседние файлы в папке книги
Помощь Обратная связь Вопросы и предложения Пользовательское соглашение Политика конфиденциальности