Добавил:
Опубликованный материал нарушает ваши авторские права? Сообщите нам.
Вуз: Предмет: Файл:

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

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

DO 100 1=1,N

DO 101 J=1,N

IF (l-J) 2,1,2

1B(I,J)=1.0 GOTO 101

2B(l,J)=0.0

ANORM=ANORM+A(!,J)*A(!,J) 101 CONTINUE

100 CONTINUE A.NORM=SQRT(ANORM)

FN0RM=AN0RM'1.0E-09/FLOAT(N)

О О

... INITIALIZE INDICATORS AND COMPUTE THRESOLD

О

THR=ANORM

 

 

23 THR=THR/FLOAT(N)

О

3 IND=0

 

О О О

... SCAN DOWN COLUMNS FOR OFF-DIAGONAL ELEMENTS

GREATER THAN OR EQUAL TO THRESOLD

DO 102 l=2,N

11= 1-1

О О О

DO 103 J=1,11

IF (ABS(A(J,I))-THR) 103,4,4

... COMPUTE SIN AND COS

4!ND=1 AL=-A(J,I)

AM=(A(J,J)-A(l,l))/2.0

DBY0 = SQRT(AL*AL+AM'AM) IF(DBYO.EQ.O.O) GOTO 502

AO=AL7SQRT(AL'AL+AM'AM) IF (AM) 5,6,6

5 AO=-AO

6 SINX=AO/SQRT(2.0’(1,0+SQRT(1,0-AO*AO)))

SINX2=SINX'SINX COSX=SQRT(1.0-SINX2) COSX2=COSX'COSX

О О О

... ROTATE COLUMNS I AND J

DO 104 K=1,N IF (K-J) 7,10,7

7 IF (K-l) 8,10,8

8 AT=A(K,J) A(K,J)=AT'COSX-A(K,l)*SINX

A(K,l)«AT*SINX+A(K,l)*COSX 10 BT-B{K,J)

B(K,J)=BT*COSX-B(K,l)'’SINX

B(K,l)=BT*SINX+B(K,l)*COSX 104 CONTINUE

XT=2.0*A(J,I)*SINX*COSX

AT=A(J,J)

BT=A(I,I) A(J,J)=AT*COSX2+BT*SINX2-XT A(I,I)=AT*S1NX2+BT*C0SX2+XT

A(J,l)=(AT-BT)*SINX*COSX+A(J,l)*(COSX2-S!NX2) A(I,J)=A(J,I)

DO 105 K=1 ,N

A(J,K)=A(K,J)

A(!,K)=A(K,I) 105 CONTINUE 103 CONTINUE 102 CONTINUE

IF (IND) 20,20,3

20 IF (THR-FNORM) 25,25,23

' О О О

... SORT EIGENVALUESAND EIGENVECTORS

25 DO 110 l=2,N J=l

29 IF (A(J-1,J-1)-A(J,J)) 30,110,110 30 AT=A(J-1 ,J-1)

A(J-1,J-1)=A(J ,J) A(J,J)=AT

DO 111 K=1,N

AT=B(K,J-1) B(K,J-1)=B(K,J) B(K,J)=AT

111CONTINUE J=J-1

IF (J-1) 110,110,29 110 CONTINUE

RETURN

О О О

...DIVIDE BY ZERO

502 LZ = -9 CALL CLSALL CALL INVLID(5) CALL PAUSE(2) RETURN

END

4 1 3

S U B R O U T IN E M T R A N S C O M P U T E S T H E T R A N S P O S E M A T R IX C O F M A '

SUBROUTINE MTRANS(A,C,NRA,NCA,MAXR,MAXC) DIMENSION A(MAXR,MAXC),C(MAXR,MAXC)

DO 100 1=1 ,NRA

DO 101 J= 1,NCA

C.(J.I) = A(!,J) 1CONTINUE

0 CONTINUE RETURN END

о о о о о о

FUNCTION IJEOF(I) tJEOF=0

RETURN END

/ ADD NAME=R READ

TO READ N REAL NUMBERS FROM KEYBOARD, CHECKING FOR "QUIT", "UP" OR "HELP"

* * * * « * • * * * * * • • • * • * * * • * « , « * • * * £ • * * * * * * * • * * * * « • * * • * * * * * •

SUBROUTINE RREAD(N,A,B,C,D)

COMMON /TLC/ SAVE(20),LZ,LU,Z1,Z2,D1,D2,NZ,NSTEP,DEPINC,DFLT,UPA COMMON /FLS/ 15,16,17,18,19,110,111,112,113,IPCH,ILP,IPLOT,NCHAN

COMMON /CHAR/ MN(720),LPT COMMON /ASC/ IALPHA(96) CHARACTER*1 IALPHA.MN A=0.

B=0.

C=0.

D=0.

о

..

NUM=0

VVRITE(I6,9)

9FORMAT(1X)

1READ(I5,10) (MN(M),M=1,50)

10FORMAT(50A1)

DUM=IJEOF(l5)

IF(I12.EQ.-99) WRITE(I13,10) (MN(M),M=1,50) IF(l6.EQ.l 13) WRITE(I6,11) (MN(M),M=1,50)

11 FORMAT(1 X.50A1)

11= 1

DO 20 1=1,50 12=51-1

IF(MN(I2).EQ.IALPHA(1)) GO TO 20 GO TO 30

>0 CONTINUE

z=o.

GO TO 40

30 CALL NUMB(I1,I2,IERR.Z) IF(LZ.LT.O) GO TO 90 IF(IERR.EQ.O) GO TO 40

о о о

... TONE FOR IBM PC ONLY

CALL TONE

о о

WRITE(I6,110)

GO T 01

415

40 NUM-NUM+1 IF(NUM.EQ.I) A=Z " IF(NUM.EQ.2) B=Z IF(NUM.EQ.3) C=Z IF(NUM.EQ.4) D=Z IF(I1.LE.I2) GO TO 30 IF(NUM.LT.N) GO TO 1

90 RETURN

110 FORMAT(1X,13Hlnvalid entry,12H, Try again

 

END

CJ ADD NAME=IREAD

о о

TO READ N INTEGERS FROM KEYBOARD

о

 

о

 

 

 

SUBROUTINE IREAD(N,!,J,K,L)

 

 

COMMON Я1-С/ SAVE(20),LZ,LU,Z1 ,Z2,D1 ,D2,NZ,NSTEP,DEPINC,DFLT UPA

 

 

CALL RREAD(N,A,B,C,D)

 

 

IF(LZ.LT.O) RETURN

 

 

l-A

 

 

J*B

 

 

K-C

 

 

L=D

 

RETURN

 

 

END

о

./ ADD NAME=AREAD

о о

 

TO READ N A1 CHARACTERS FROM KEYBOARD AS INTEGERVARIABLES

о о

 

 

 

 

SUBROUTINE AREAD(N,I,J,K,L)

 

 

COMMON /TLC/ SAVE(20),LZ,LU,Z1,Z2,D1,D2,NZ,NSTEP,DEPINC,DFLT,UPA

 

 

COMMON /FLS/ 15,16,17,18,19,110,111,112,113,IPCH,ILP,IPLOT,NCHAN

 

 

COMMON /ASC/ IALPHA(96)

C

CHARACTER’1 IALPHA.IBL.M1 ,M2,M3.M4

DATA IBIT V

 

 

IBL = IALPHA(1)

 

 

IF(LZ.EQ.-5.AND.N.EQ.1) RETURN

 

 

M1-IBL

 

 

M2=IBL

 

 

M3=IBL

C

M4=IBL

WRITE(I6,9)

 

9

FORMAT(1X)

 

10

READ(I5,10) M1,M2,M3,M4

 

FORMAT(4A1)

 

 

DUM=IJE0F(I5)

4 1 6

С

IF(l12.EQ.-99) WRITE(I13,10) М1,М2,МЗ,М4

IF(I6.EQ.I13) WRITЕ{16,110) М1,М2,МЗ,М4

110

FORMAT(1X,4A1)

 

 

LZ=0

 

 

CALL CHKALL(M1,M2,M3,M4)

 

IF(LZ.LT.O) RETURN

 

 

1=1

 

 

J=1

 

 

K=1

 

 

L=1

 

' DO 120 KK=1,96

 

j

IF(I.EQ.1.AND.M1.EQ.IALPHA(KK)) !=KK

 

 

IF(J.EQ.1 ,AND.M2.EQ.IALPHA(KK}) J=KK

 

 

IF(K.EQ.1.AND.M3.EQ.IALPHA(KK}) K=Ki<

 

IF(L.EQ.1 ,AND.M4.EQ.IALPHA(KK)) L=KK

120

CONTINUE

 

RETURN

о

END

./ ADD NAME=NUMB

о о

 

CONVERTS AN Al' STRING OF CHARACTERS FROM MN(I I) TO MN(I2

о

 

TOA REALNUMBER

о о

SUBROUTINE NUMB(11,12,IERR,A)

 

 

 

COMMON /TLC/ SAVE(20),LZ,LU;Z1 ,Z2,D1 ,D2,NZ,NSTEP,DEPlNC,DFi_~

 

 

COMMON /FLS/ I5,I6,I7,18,19,110,111,112,113,IPCH,ILP,IPLOT,NCH.\N

 

i

COMMON /ASC/ IALPHA(96)

 

COMMON /CHAR/ MN(720),LPT

 

DIMENSION NM(132)

 

 

CHARACTER’ 1 IALPHA,MN,M1 ,M2,.M3,M4

 

A=DFLT

 

LZ=0

 

 

M1=MN(I1)

 

 

M2=MN(I1+1)

 

 

M3=MN(I1 +2)

 

 

M4=MN(I1 +3)

 

 

CALL CHKALL(M1,M2,M3,M4)

 

IF(LZ.LT.O) RETURN

 

NDIG=0

 

NEG=0

 

IDEC=999

 

 

DO 100 1=11,12

 

IE=I

 

IF(MN(I).NE.IALPHA(1)) GO TO 10

 

IF(NEG.EQ.O) GOTO 100

 

GO TO 200

 

10

DO 20 K=10,26

2 7 115

C
C
C 900 910

IF(MN(I).NE.!ALPHA(K)) GO TO 20

IF(K.EQ.13.0R.K.EQ.16) GO TO 200 IF(NEG.NE.O) GO TO 30

IB=I

IF;K.EQ.12) NEG=1

IF(K.EQ.14) NEG=-1 IF(NEG.NE.O) GO TO 40 NEG=1

IB=I-1

GO TO 30

20 CONTINUE GO TO 900

C

C AFTER FIRST DIGIT C

30 IF(K.LE.14.0R.K.EQ.16) GO TO 200 NDIG=NDIG+1

40 lF(K.EQ.15) IDEC=NDIG NM(I)=K-17

100 CONTINUE C

C END OF NUMBER C

200 A=0.

IF(NDIG.GT.O) GO TO 210

11= 11+1

RETURN

210 IF(NDIG*IDEC.EQ.1) GO TO 900, DO 300 J=1,NDIG

IF(J.LT.IDEC) A=10.*A+FLOAT(NM(IB+J)) IF(J.EQ.IDEC) GO TO 300

IF(J.GT.IDEC) A=A+FLOAT(NM(IB+J))'10.‘*FLOAT(IDEC-J) 300 CONTINUE

A=A*FLOAT(MEG)

IERR=0 11 =IE+1 RETURN

ERROR

WRITE(I6.910)

F0RMAT(1 X,21 HError in number field) !ERR=-1

RETURN END

C./ADD NAME=CHKALL C

C CHECKS FOR CHARACTERS SPELLING "QUIT", "UP", "HELP" ETC

418

О О О

SUBROUTINE СККАЩМ1 .М2.МЗ.М4)

CHARACIER‘1 М1.М2.МЗ.М4

CALL СНЕСК.М1 ,М2.МЗ,М4,6'2,53,48,43,-9) CALL CHECK(M1 ,М2.М?.М4.38,57,42.53,-9) CALL CNECK(M I .M2.M3.M4.34,35/8,51 ,-9} CALL C:-(EC.K(M1 ,М2Д‘ i ,M1,54,49,54.54,-1} CALL CHECK(M1,MI,M1,M1,50 r'9,50,50, 3) CALL CHECK(M1,M2.MI,M1,54, 1 54.54,-1)

CALL CHECK(M i ,M2,M3,M4,41,38,ч=.4Э.-10) CALL CHECA;i/1 Ml ,"MI ,M 1,32,32.32,32,-10)

CALL C-l iECK'Ml y ? \ ‘e ;m , 3 6 A Z * D , 5 $ , . i )

О

CALL C H E M ' /-11 ,MI .Ml ,54 34.6M.5J.-1)

CALL СНЕС ( M l Ч.М1 ,M1,41,41,4 1 ,n .-10)

CALL

CHLCK(M1 ,M1 ,M1 ,M1,82,82,£/,3i.-9)

CALL

CHEC-K(M1,' i .Li I ,M1,86,85,CL-.SS, 1)

C A L L

C H E C :<;:.;I / ; I ,M!,M I 73,73,73,73,-19)

О О О О О О

RE'i UF.: i END

./ADD NAME»CKECK

COMPARES STRING M1.M2.M3 M4 1 0 ASCI! CHARACTERS K1.K2.-v: -.4

SUBROUTINE CHECK(M1 ,M2.M.3,M4,K1 ,K2,K3,K4 L)

COMMON ,’TLC/ SAVE{20),LZ,LJ Z1,22,D1,D2,NZ,NSTEP,CEF;NC,L':r'L - д

COMMON iA SC I lALPHA(So)

CHA,">,rtCTtR*1 IALPHA,Ml ,М2 M3.M4

!F(iv! I . N £ . I A L P H A ( K 1 ) ) RETURN

IF(M2.NE.!ALPHA{K2)) RETURN

IR,M3.N E. IAL.ГHA(К3)) RETURN

IF(M4.NE.IALFHA(K4)} RETURN LZ=L

RETURN

END

27*

419

this routine wili create the audio tone

 

(subroutine TONE)

 

 

 

 

assume

cs:codes

 

 

codes

segment ’code'

 

 

 

public

tone

 

 

 

 

 

tone

proc

far

 

 

 

 

 

pusn

bp

 

;save frame pointer

 

mov

bp.sp

 

;address parameters

 

mov

ax,0

 

numerator

(low word)

 

mov

dx,12h

 

(high word)

 

mov

bx,1250

 

divisor

 

div

bx

 

.'divide

 

 

 

mov

bx.ax

 

;save quotient in BX

set 1/pitch

into timer

then

turn on

tone

 

mov

al,1OH01'i0b

;put the number

 

out

43h,al

 

;into timer

 

 

mov

nx.bx

 

1/pilch

into AX

 

out

4 2 'n .a l

 

;L-SB into iim?,'.';

 

m o v

S ',3 : i

 

jiviSB into

timsi3

 

out

4 2 h ,0 .l

 

 

 

 

 

in

al,6lh

 

;>ead port В into /j.L

 

or

ai,3

 

'.turn on

bits 0,1

 

out

eih.al

 

to turn on speaker

.sound the tone for a

w h iie ,

then turn it of?

 

mov

cx,G2FFFh

■.set up for

delay

wait

loop

wait

 

.delay

 

 

 

in

al,61h

 

;read portB

into AL

 

and

al,11 1 1 100b

;mask lower two bits

 

out

61h,al

 

1o turn

off speaker

 

pop

bp

 

restore

frame pointer

tone

ret

 

 

return

 

 

endp

 

 

 

 

 

codes

ends

 

 

 

 

 

 

end

 

 

 

 

 

420

п р е д м е т н ы й у к а з а т е л ь

А в ток ор р ел я ц и я

остатк ов

т р ен д а

148,

151,

161

 

 

 

А в ]о м а т п ч е с к а я

геол оги ч еск ая

к ор ре л я ц и я

259

 

 

 

А зи м у т

55

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

А л ьтернатива гип отезы

90, 95

 

 

 

 

 

 

 

 

 

А м п л и т у д а

285

 

 

 

 

305—308

 

 

 

 

 

 

 

А н ал и з

врем енны х р я д о в

 

 

 

 

 

 

 

А нализ

п овер хн ост ей

т р ен д а

7— 9,

 

16, 85,

9 4 — 97, 108,

133— 175,

181, 183

1 9 9 —

 

200.

2 0 8 — 213,

230

 

 

 

 

 

 

 

 

 

 

 

 

 

Ф урье 253,

2 8 3 — 301

 

 

 

 

 

 

 

 

 

 

 

А ппрок си м ац ия трап ец и ям и

70

 

 

 

 

 

 

 

 

241

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

Б е зу с л о в н а я в ероятн ость

31

 

 

 

 

 

 

 

 

 

 

В е л л м ан а принцип 245

 

 

 

 

 

 

 

 

 

 

 

 

Б ы стр ое п р е о б р а зо в а н и е

Ф у р ь е 180

 

 

 

 

 

 

В ектор

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

д о л г о т ы 55

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

— ш и роты 55

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

В е р о я т н о ст ь 18

 

 

 

 

 

 

 

 

 

 

 

 

 

 

г еом ет р и ческ ая 12

 

 

 

 

 

 

 

 

 

 

 

 

В за и м н а я к ор р е л о г р а м м а

259

 

 

 

 

 

 

 

 

 

В зв еш ен н а я к л аст ер и зац и я

с р е д н и х 247,

2 5 4 — 257

 

 

 

В з в е ш и в а ю щ а я

 

ф ун кц и я

296,

308,

 

98,

101,

105 — 114,

120 — 121,

12 7 — 129,

181

В о з в е д е н и е

м атри цы

в

степень

134

 

 

 

 

 

 

 

В р а щ е н и е

в ари м ак с

299

 

 

 

 

 

 

 

 

 

 

 

В р ем ен н ой

т р е н д - а н а л и з

3 0 5 — 308,

3 7 9

 

 

 

 

 

 

В ы бор к а

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

без

в о зв р а щ ен и я

2 7

 

 

 

 

 

 

 

 

 

 

 

 

с в о зв р а щ ен и ем 26

 

 

 

 

 

 

 

 

 

 

 

 

Г арм он и ки 73,

1 7 0 — 183

 

 

 

 

 

 

 

 

 

 

 

Г арм он и ческ ий ан али з 289

 

 

 

 

 

 

 

 

 

 

Г еол оги ч еск ая

к ор рел я ц и я 265

 

 

 

 

 

 

 

 

 

Г еом етр и ч еск ое

с р е д н е е 39,

105 — 106

 

 

 

 

 

 

Г еостати сти к а

12, 2 7 4 — 283,

121 — 132

 

 

 

 

 

 

Г е т ер осед аст и ч н ост ь

223

 

 

 

 

 

 

 

 

 

 

 

Д а н н ы е интервальной

ш к алы

15,

326,

338

 

 

 

 

— п о р я д к о в о й

ш к алы

15,

98, 117,

 

163

 

 

 

 

 

 

ш к алы

отн ош ен и й 15,

326,

338

 

 

 

 

 

 

 

 

Д в у х г р у п п о в о й дискри м и н антн ы й

ан али з

2 1 9 — 232, 3 4 9 — 350

 

 

Д и а г о н а л ь н а я

м атр и ц а

134

 

 

 

 

 

 

 

 

 

 

Д и с п е р с и я

44,

45

 

 

 

 

 

 

 

 

 

 

 

 

 

Д и с п е р с и я об ъ е д и н е н н о й

вы борки

 

242

 

 

 

 

 

 

Д и ск р ет н ы й энергетический

спектр

298

 

 

 

 

 

Д л и н а

волны 285, 173

 

 

 

 

 

 

 

 

 

 

 

 

Д р н ф т

278

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

З а к о н п р оп ор ц и он ал ь н ы х

э ф ф е к т о в 109

 

 

 

 

 

З а м к н у т а я ф ор м а 77

 

 

 

 

 

 

 

 

 

 

 

 

 

Ж и р н ы м

 

ш р и ф том

в ы дел ен ы

стр ан и ц ы в т о р о го

т ом а .

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

421