C PROGRAM LAYER (INPUT,OUTPUT,TAPE5=INPUT,TAPE6=OUTPUT,TAPE1,TAPE2, A 1
C . PUNCH) A 2
PROGRAM LAYER A 1
A 2
COMMON NUMAT,DT,N,ALFA,BETA,HED(12),A(30000) A 3
C LAYER.A
C ***** NOTICE TO USERS OF THIS SOFTWARE ***** LAYER.B
C LAYER.C
C COPYRIGHT (C) 1971 LAYER.D
C THE REGENTS OF THE UNIVERSITY OF CALIFORNIA (REGENTS) LAYER.E
C ALL RIGHTS RESERVED LAYER.F
C LAYER.G
C IN NO EVENT SHALL REGENTS OF THE UNIVERSITY OF CALIFORNIA BE LAYER.H
C LIABLE TO ANY PARTY FOR DIRECT, INDIRECT, SPECIAL, INCIDENTAL, LAYER.I
C OR CONSEQUENTIAL DAMAGES, INCLUDING LOST PROFITS, ARISING OUT OF LAYER.J
C THE USE OF THIS SOFTWARE AND ITS DOCUMENTATION, EVEN IT REGENTS LAYER.K
C HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. LAYER.L
C LAYER.M
C REGENTS SPECIFICALLY DISCLAIMS ANY WARRANTIES, INCLUDING, BUT LAYER.N
C NOT LIMITED TO, THE IMPLIED WARRANTIES OR MERCHANTABILITY AND LAYER.O
C FITNESS FOR A PARTICULAR PURPOSE. THE SOFTWARE AND ACCOMPANYING LAYER.P
C DOCUMENTATION, IF ANY, PROVIDED HEREUNDER IS PROVIDED "AS IS". LAYER.Q
C REGENTS HAS NO OBLIGATION TO PROVIDE MAINTENANCE, SUPPORT, LAYER.R
C UPDATES, ENHANCEMENTS, OR MODIFICATIONS. LAYER.S
C LAYER.T
C A 4
open (5, file='tape5.dat', status='old')
open (2, file='tape2.dat', status='unknown')
50 READ(5,1001) HED,NUMAT,IC,MPR,MP,ALFA,BETA A 5
IF(NUMAT.EQ.0) STOP A 6
WRITE(6,2001)HED,NUMAT,IC,MPR,MP,ALFA,BETA A 7
NUMAT=NUMAT-1 A 8
READ(5,1002) NUCAR,NPOINT,MMAX,NC,DT,FACT A 9
IF (FACT.EQ.0.0) FACT=1.0 A 10
WRITE(6,2002) NUCAR,NPOINT,MMAX,NC,DT,FACT A 11
N1=1 A 12
N2=N1+NUMAT A 13
N3=N2+NUMAT A 14
N4=N3+NUMAT A 15
C A 16
CALL DISCRT (A(N1),A(N2),A(N3),A(N4)) A 17
N5=N4+NUMAT A 18
N6=N5+N A 19
CALL STIFF (A(N1),A(N2),A(N3),A(N4),A(N5),A(N6),N) A 20
N2=N1+N A 21
N3=N2+2*N A 22
N4=N3+N A 23
N5=N4+N A 24
N6=N5+N A 25
N7=N6+N A 26
N8=N7+N A 27
CALL SOLVE (A(N1),A(N2),A(N3),A(N4),A(N5),A(N6),A(N7),A(N8),N, A 28
. MMAX,NMAX,MP,MPR) A 29
NM=MMAX+NMAX-1 A 30
N2=N1+NM A 31
N3=N2+MMAX A 32
N4=N3+NPOINT A 33
CALL LOAD (A(N2),A(N3),A(N4),NUCAR,MMAX,NC,DT,FACT) A 34
IF(IC.EQ.0) GO TO 70 A 35
CALL CONV(A(N1),A(N2),MMAX,MP) A 36
GO TO 50 A 37
70 IF(ALFA.EQ.0.0.AND.BETA.EQ.0.0) GO TO 80 A 38
CALL GESOL (A(N1),A(N2),A(N3),NMAX,MMAX) A 39
GO TO 50 A 40
80 CALL REV (A(N1),A(N2),A(N3),NM) A 41
GO TO 50 A 42
C A 43
1001 FORMAT (12A6/4I5,2F10.0) A 44
1002 FORMAT (4I5,2F10.0) A 45
2001 FORMAT (1H1,12A6/// A 46
. 20H NUMBER OF MATERIALS ,I5/ A 47
. 20H SOLUTION CODE ,I5/ A 48
. 20H EQ 0 DECONVOLUTION / A 49
. 20H EQ 1 CONVOLUTION / A 50
. 20H PRINT CODE ,I5/ A 51
. 21H EQ 1 WGT.SEQ.PRINTED / A 52
. 21H EQ 0 NOT PRINTED / A 53
. 20H PUNCH CODE ,I5/ A 54
. 21H EQ 1 WGT.SEQ.PUNCHED / A 55
. 21H EQ 0 NOT PUNCHED / A 56
3 22H DAMPING COEFF. (ALFA) ,F10.6/ A 57
4 22H DAMPING COEFF. (BETA) ,F10.6/////) A 58
2002 FORMAT (21H NUMBER OF ACC. CARDS ,I5/ A 59
. 21H NUMBER OF DEF. POINT ,I5/ A 60
. 21H NUMBER OF TIME STEPS ,I5/ A 61
. 20H INPUT CONDITION ,I5/ A 62
. 20H TIME INCREMENT ,F10.5/ A 63
. 20H FUNCTION MULTIPLIER ,F10.5/////) A 64
close(5)
close(2)
END A 65
SUBROUTINE DISCRT (SMU,SMOD,H,NBOUN) B 1
COMMON NUMAT,DT,N,ALFA,BETA,DHS B 2
DIMENSION SMU(1),SMOD(1),H(1),NBOUN(1) B 3
C B 4
write (*,*) '* executing subroutine DISCRT'
WRITE(6,3000) B 5
NJ=1 B 6
DO 50 I=1,NUMAT B 7
READ (5,1001) MAT,SMU(MAT),SMOD(MAT),H(MAT) B 8
C=SQRT(SMOD(I)/SMU(I)) B 9
CC=C*DT B 10
SN=H(I)/CC B 11
IF (SN.LE.0.5) SN=1.0 B 12
NS=SN B 13
IF ((SN-NS).GE.0.5) NS=NS+1 B 14
NJ=NJ+NS B 15
NBOUN(I)=NJ B 16
SM=SMOD(I) B 17
SMOD(I)=(H(I)*H(I)*SMU(I))/(NS*NS*DT*DT) B 18
DX=SQRT(SMOD(I)/SMU(I))*DT B 19
WRITE(6,2001)MAT,SMU(MAT),SM,SMOD(MAT),H(MAT),DX B 20
H(I)=DX B 21
50 CONTINUE B 22
N=NBOUN(NUMAT) B 23
READ(5,1001) MAT,SMUH,SMODH B 24
C DHS=1.0E+100 B 25
DHS=1.0E+38 B 25
IF(SMUH.EQ.0.0) GO TO 60 B 26
DHS=SMUH*SQRT(SMODH/SMUH) B 27
60 WRITE(6,2001) MAT,SMUH,SMODH B 28
C B 29
RETURN B 30
1001 FORMAT(I5,3F10.0) B 31
2001 FORMAT(I8,5F20.5/) B 32
3000 FORMAT(1H ,5X,5HLAYER,12X,4HMASS,11X,10HSHEAR MOD.,9X,13HMODIFIED B 33
.MOD.,9X,12HLAYER THICK.,6X,15HSUBLAYER THICK.,//) B 34
END B 35
SUBROUTINE STIFF (SMU,SMOD,H,NBOUN,SMASS,A,N) C 1
DIMENSION SMU(1),SMOD(1),H(1),NBOUN(1),SMASS(N),A(N,2) C 2
C*********************************************************************** C 3
C FORM STIFFNESS AND MASS MATRICES C 4
C*********************************************************************** C 5
write (*,*) '* executing subroutine STIFF'
N1=N-1 C 6
L=1 C 7
K=2 C 8
NB=NBOUN(1) C 9
SK2=-SMOD(1)/H(1) C 10
SK1=-2.0*SK2 C 11
SM=SMU(1)*H(1) C 12
A(1,1)=SK1/2.0 C 13
A(1,2)=SK2 C 14
SMASS(1)=SM/2.0 C 15
IF(N.EQ.2) GO TO 40 C 16
DO 50 I=2,N1 C 17
IF(I.EQ.NB) GO TO 60 C 18
A(I,1)=SK1 C 19
A(I,2)=SK2 C 20
SMASS(I)=SM C 21
GO TO 50 C 22
60 SK1=SMOD(L)/H(L) C 23
SK2=SMOD(K)/H(K) C 24
SM2=SMU(K)*H(K) C 25
A(I,1)=SK1+SK2 C 26
A(I,2)=-SK2 C 27
SMASS(I)=(SM+SM2)/2.0 C 28
SK1=2.0*SK2 C 29
SK2=-SK2 C 30
SM=SM2 C 31
L=L+1 C 32
K=K+1 C 33
NB=NBOUN(L) C 34
50 CONTINUE C 35
40 A(N,1)=-SK2 C 36
SMASS(N)=SM/2.0 C 37
A(N,2)=0.0 C 38
C C 39
REWIND 2 C 40
C WRITE (2) SMASS,A C 41
write (2,*) SMASS,A
C C 42
RETURN C 43
END C 44
SUBROUTINE SOLVE (SMASS,A,X0,X1,X2,B,MAXB,G,N,NUACC,NMAX, MP,MPR) D 1
COMMON NUMAT,DT,N1,ALFA,BETA,DHS D 2
DIMENSION SMASS(N),A(N,2),X0(1),X1(1),X2(1),B(1),MAXB(1),G(1) D 3
C D 4
write (*,*) '* executing subroutine SOLVE'
REWIND 2 D 5
C READ (2) SMASS,A D 6
read (2,*) SMASS,A
C D 7
C*********************************************************************** D 8
C INITIAL CONDITIONS D 9
C*********************************************************************** D 10
WRITE (6,3000) D 11
NT=0 D 12
NTOT=NUACC+N D 13
DO 100 I=1,N D 14
X0(I)=0. D 15
X1(I)=0. D 16
100 X2(I)=0. D 17
IF(BETA.NE.0.0) GO TO 75 D 18
A1=DT*DT/2. D 19
A2=2./(ALFA*DT*DT+2.*DT) D 20
A3=DT/(ALFA*DT+2.) D 21
A4=2./DT D 22
A5=1./A3 D 23
E1=SMASS(N)/(SMASS(N)*A5+DHS) D 24
E2=E1/A1 D 25
NLS=N-1 D 26
DO 177 I=1,NLS D 27
177 SMASS(I)=A5*SMASS(I) D 28
SMASS(N)=A5*SMASS(N)+DHS D 29
GO TO 175 D 30
75 A0=ALFA+2./DT D 31
A1=DT*DT/2. D 32
A2=2./(DT*DT)+ALFA/BETA+2./(BETA*DT) D 33
A3=2./(DT*DT) D 34
A4=1./BETA D 35
A5=2./DT D 36
A6=DHS/BETA D 37
DO 150 I=1,N D 38
A(I,1)=A0*SMASS(I)+BETA*A(I,1) D 39
150 A(I,2)=BETA*A(I,2) D 40
A(N,1)=A(N,1)+DHS D 41
GO TO 200 D 42
C*********************************************************************** D 43
C NUMERICAL INTEGRATION AND STORE WEIGHTING SEQUENCE D 44
C*********************************************************************** D 45
175 BAC=0. D 46
IF(NT.EQ.0) BAC=2. D 47
DO 180 I=1,N D 48
TEMP=DT*X1(I)+A1*X2(I) D 49
VEL=A2*TEMP D 50
X2(I)=A4*X1(I)+X2(I) D 51
X1(I)=VEL-A3*BAC D 52
180 X0(I)=X0(I)+TEMP D 53
X1(N)=E2*TEMP-E1*BAC D 54
CALL MULT (A,X0,B,N,2) D 55
DO 190 I=1,N D 56
X1(I)=X1(I)-B(I)/SMASS(I) D 57
190 X2(I)=A4*X1(I)-X2(I) D 58
GO TO 325 D 59
200 CALL TRIA(N,2,A,MAXB) D 60
275 IF(BETA.EQ.0.0) GO TO 175 D 61
BAC=0. D 62
IF(NT.EQ.0) BAC=2. D 63
DO 250 I=1,N D 64
DIS=X0(I)+DT*X1(I)+A1*X2(I) D 65
B(I)=-BAC*SMASS(I)+SMASS(I)*(A2*DIS-A3*X0(I)) D 66
250 X0(I)=DIS D 67
B(N)=B(N)+A6*X0(N) D 68
CALL BACKS(N,2,A,MAXB,B) D 69
DO 300 I=1,N D 70
VEL=B(I)-A4*X0(I) D 71
X2(I)=A5*(VEL-X1(I))-X2(I) D 72
300 X1(I)=VEL D 73
325 NT=NT+1 D 74
G(NT)=X2(1)+BAC D 75
IF(MPR) 330,335,330 D 76
330 WRITE (6,2000) NT,G(NT) D 77
335 IF(NT.LT.NTOT) GO TO 275 D 78
C IF(MP.EQ.1) PUNCH 2001, (G(K), K=1,NTOT) D 79
IF(MP.EQ.1) WRITE(6,2001) (G(K), K=1,NTOT) D 79
GMAX=G(N)/500. D 80
DO 400 I=1,NTOT D 81
400 IF(ABS(G(I)).LT.GMAX) G(I)=0. D 82
DO 410 I=1,NTOT D 83
IF(G(I).EQ.0.0) GO TO 410 D 84
KX=I-1 D 85
GO TO 420 D 86
410 CONTINUE D 87
420 NTG=NTOT-KX D 88
DO 425 I=1,NTG D 89
425 SMASS(I)=G(I+KX) D 90
NMAX=N-KX D 91
WRITE(6,3001) D 92
WRITE (6,2000) NMAX,SMASS(NMAX) D 93
C D 94
RETURN D 95
2000 FORMAT (I10,E20.10) D 96
2001 FORMAT(4E20.14) D 97
3000 FORMAT(1H1,5X,18HWEIGHTING SEQUENCE) D 98
3001 FORMAT(//,3X,10HBAND WIDTH,4X,14HDIAGONAL VALUE) D 99
END D 100
SUBROUTINE TRIA(NEQ,MBAND,A,NBMAX) E 1
DIMENSION A(1),NBMAX(1) E 2
C E 3
C TRIANGULARIZE BANDED MATRIX BY GAUSS ELIMINATION E 4
C E 5
write (*,*) '* executing subroutine TRIA'
IF(NEQ.EQ.1)RETURN E 6
MM=NEQ*MBAND E 7
NE=NEQ-1 E 8
DO 300 N=1,NE E 9
C E 10
C DETERMINE EQUATION LENGTH E 11
C E 12
NBMAX(N)=0 E 13
DO 100 I=N,MM,NEQ E 14
IF(A(I).NE.0.0) NBMAX(N)=I E 15
100 CONTINUE E 16
IF (A(N).EQ.0.0) GO TO 300 E 17
C E 18
C SUBSTITUTE INTO EQUATIONS WITHIN BAND E 19
C E 20
IL=N+NEQ E 21
IH=NBMAX(N) E 22
L=N E 23
DO 200 I=IL,IH,NEQ E 24
L=L+1 E 25
IF(A(I).EQ.0.0) GO TO 200 E 26
C=A(I)/A(N) E 27
J=L-I E 28
DO 50 K=I,IH,NEQ E 29
50 A(K+J)=A(K+J)-C*A(K) E 30
A(I)=C E 31
200 CONTINUE E 32
300 CONTINUE E 33
C E 34
RETURN E 35
END E 36
SUBROUTINE BACKS(NEQ,MBAND,A,NBMAX,B) F 1
DIMENSION A(1),B(1),NBMAX(1) F 2
write (*,*) '* executing subroutine BACKS'
IL=NEQ F 3
C F 4
DO 400 N=1,NEQ F 5
C=B(N) F 6
IF(A(N).NE.0.0) B(N)=B(N)/A(N) F 7
IF(N.EQ.NEQ) GO TO 450 F 8
IL=IL+1 F 9
IH=NBMAX(N) F 10
K=N F 11
DO 350 I=IL,IH,NEQ F 12
K=K+1 F 13
350 B(K)=B(K)-A(I)*C F 14
400 CONTINUE F 15
C F 16
450 IL=2*NEQ F 17
500 IL=IL-1 F 18
N=N-1 F 19
IF(N.EQ.0) RETURN F 20
IH=NBMAX(N) F 21
K=N F 22
DO 600 I=IL,IH,NEQ F 23
K=K+1 F 24
600 B(N)=B(N)-A(I)*B(K) F 25
C F 26
GO TO 500 F 27
C F 28
END F 29
SUBROUTINE MULT (A,B,C,NEQ,MB) G 1
DIMENSION A(NEQ,1),B(1),C(1) G 2
C G 3
C write (*,*) '* executing subroutine MULT'
NN=NEQ-MB+1 G 4
MX=MB G 5
C G 6
DO 200 N=1,NEQ G 7
C(N)=0.0 G 8
IF(N.GT.NN) MX=MX-1 G 9
N1=N-1 G 10
DO 100 J=1,MX G 11
100 C(N)=C(N)+A(N,J)*B(J+N1) G 12
200 CONTINUE G 13
IF(NEQ.EQ.1) RETURN G 14
C G 15
DO 400 N=2,NEQ G 16
IF(N.LE.MB) MX=N G 17
N1=N+1 G 18
DO 300 J=2,MX G 19
300 C(N)=C(N)+A(N1-J,J)*B(N1-J) G 20
400 CONTINUE G 21
C G 22
RETURN G 23
END G 24
SUBROUTINE LOAD (A,T,AC,NUCAR,MMAX,NC,DX,FACT) H 1
DIMENSION A(MMAX),T(1),AC(1) H 2
write (*,*) '* executing subroutine LOAD'
IF(NC.NE.1) GO TO 10 H 3
WRITE(6,3001) H 4
DO 100 I=1,NUCAR H 5
READ(5,1001) T(I),AC(I) H 6
AC(I)=FACT*AC(I) H 7
WRITE(6,2001) T(I),AC(I) H 8
100 CONTINUE H 9
GO TO 40 H 10
10 IF(NC.NE.2) GO TO 20 H 11
WRITE(6,3002) H 12
K=1 H 13
DO 200 I=1,NUCAR H 14
KK = 5*I H 15
READ(5,1002) (T(J),AC(J),J=K,KK) H 16
WRITE(6,2002) (T(J),AC(J),J=K,KK) H 17
200 K=KK+1 H 18
NUCAR=6*NUCAR H 19
DO 250 I=1,NUCAR H 20
250 AC(I)=FACT*AC(I) H 21
GO TO 40 H 22
20 IF(NC.NE.3) GO TO 50 H 23
READ(5,1003) DT H 24
WRITE(6,2003) DT H 25
WRITE(6,3004) H 26
NUCAR=8*NUCAR H 27
T(1)=0.0 H 28
DO 300 I=2,NUCAR H 29
300 T(I)=T(I-1)+DT H 30
C READ (5,1004) (AC(I),I=1,NUCAR) H 31
read (5,*) (AC(I),I=1,NUCAR)
DO 350 I=1,NUCAR H 32
350 AC(I)=FACT*AC(I) H 33
WRITE (6,2004) (AC(I),I=1,NUCAR) H 34
40 CALL INTPOL (T,AC,MMAX,DX,A) H 35
GO TO 500 H 36
50 READ(5,1004) (A(I),I=1,MMAX) H 37
WRITE(6,3005) H 38
DO 400 I=1,MMAX H 39
400 A(I)=FACT*A(I) H 40
WRITE(6,2004) (A(I),I=1,MMAX) H 41
C H 42
500 CONTINUE H 43
C H 44
RETURN H 45
1001 FORMAT(2F10.0) H 46
1002 FORMAT(5(F7.3,F7.3)) H 47
1003 FORMAT(F10.0) H 48
1004 FORMAT (8F9.0) H 49
2001 FORMAT (F8.4,10X,F12.8) H 50
2002 FORMAT(5(F7.3,F7.3)) H 51
2003 FORMAT (20H1 DATA INTERVAL ,F10.5///) H 52
2004 FORMAT (5F20.10) H 53
3001 FORMAT(40H1 TIME INPUT ACCELERATIONS ///) H 54
3002 FORMAT(1H1,32HTIMES AND ACCELERATIONS AS INPUT,/, H 55
1 58HTIME ACCL TIME ACCL TIME ACCL TIME ACCL TIME ACCL) H 56
3004 FORMAT ( 40H INPUT ACCELERATIONS (ROWISE) /) H 57
3005 FORMAT (1H1,40H INPUT ACCELERATIONS (ROWISE) /) H 58
END H 59
SUBROUTINE INTPOL (X, Y, MMAX, DX, A) I 1
C I 2
C SUBROUTINE TO INTERPOLATE A FUNCTION AT EQUAL INTERVALS OF X COORD I 3
C I 4
DIMENSION X(1),Y(1),A(1) I 5
write (*,*) '* executing subroutine INTPOL'
N = 2 I 6
A(1) = Y(1) I 7
X1 = X(1) I 8
DO 300 M = 2, MMAX I 9
EM = M I 10
GO TO 304 I 11
301 N = N + 1 I 12
304 B = (EM-1.0)*DX - X(N-1) + X1 I 13
C = X(N) - X(N-1) I 14
IF (C-B) 301,302,303 I 15
302 A(M) = Y(N) I 16
GO TO 300 I 17
303 SLOPE = (Y(N) - Y(N-1)) / C I 18
A(M) = Y(N-1) + B*SLOPE I 19
C I 20
300 CONTINUE I 21
RETURN I 22
END I 23
SUBROUTINE CONV (G,F,NT, MP) J 1
DIMENSION G(1),F(1), STO(4) J 2
write (*,*) '* executing subroutine CONV'
WRITE (6,3000) J 3
KS = 0 J 4
DO 200 K=1,NT J 5
H=0.0 J 6
K1=K+1 J 7
KS = KS + 1 J 8
DO 100 I=1,K J 9
100 H=H+F(I)*G(K1-I) J 10
IF(MP.EQ.0) GO TO 200 J 11
STO(KS) = H J 12
IF(KS.NE.4) GO TO 200 J 13
C PUNCH 2001, STO J 14
WRITE(6,2001) STO J 14
KS = 0 J 15
200 WRITE(6,2000) K,H J 16
C J 17
RETURN J 18
2000 FORMAT(I10,F10.5) J 19
2001 FORMAT(4E20.14) J 20
3000 FORMAT (30H1 CONVOLVED EARTHQUAKE ) J 21
END J 22
SUBROUTINE GESOL (TF,B,A,MBAND,NN) K 1
DIMENSION TF(1),B(1),A(MBAND,1) K 2
C K 3
write (*,*) '* executing subroutine GESOL'
REWIND 1 K 4
MB1=MBAND-1 K 5
NN1=NN+1 K 6
NN2=NN/2 K 7
DO 50 I=1,NN2 K 8
TEMP=B(I) K 9
II=NN1-I K 10
B(I)=B(II) K 11
50 B(II)=TEMP K 12
C K 13
DO 100 I=1,MBAND K 14
MB=MBAND-I K 15
DO 100 J=1,NN K 16
K=MB+J K 17
100 A(I,J)=TF(K) K 18
C K 19
DO 475 N=1,NN K 20
N2=N-1 K 21
N1=N+1 K 22
B(N)=B(N)/A(1,N) K 23
IF(N.EQ.NN) GO TO 490 K 24
DO 250 J=N1,NN K 25
IF(A(1,J).EQ.0.0) GO TO 250 K 26
A(1,J)=A(1,J)/A(1,N) K 27
C=A(1,J) K 28
DO 260 I=2,MBAND K 29
260 A(I,J)=A(I,J)-A(I,N)*C K 30
250 CONTINUE K 31
C K 32
DO 300 I=2,MBAND K 33
II=I+N2 K 34
300 B(II)=B(II)-A(I,N)*B(N) K 35
WRITE (1) (A(1,J),J=N1,NN) K 36
DO 400 I=1,MB1 K 37
I1=I+1 K 38
DO 400 J=N1,NN K 39
400 A(I,J)=A(I1,J) K 40
C K 41
K=0 K 42
DO 450 J=N1,NN K 43
K=K+1 K 44
450 A(MBAND,J)=TF(K) K 45
475 CONTINUE K 46
C K 47
490 BACKSPACE 1 K 48
500 N1=N K 49
N=N-1 K 50
IF(N.EQ.0) GO TO 700 K 51
READ (1) (A(1,J),J=N1,NN) K 52
BACKSPACE 1 K 53
BACKSPACE 1 K 54
DO 600 J=N1,NN K 55
600 B(N)=B(N)-A(1,J)*B(J) K 56
GO TO 500 K 57
700 DO 800 I=1,NN2 K 58
TEMP=B(I) K 59
II=NN1-I K 60
B(I)=B(II) K 61
800 B(II)=TEMP K 62
WRITE (6,3000) K 63
WRITE (6,2000) (I,B(I),I=1,NN) K 64
C K 65
RETURN K 66
2000 FORMAT (I10,F20.5) K 67
3000 FORMAT(1H1,4X,22HDECONVOLVED EARTHQUAKE) K 68
END K 69
SUBROUTINE REV (G,US,UB,NT) L 1
DIMENSION US(1),G(1),UB(NT) L 2
write (*,*) '* executing subroutine REV'
NT1=NT-1 L 3
DO 100 N=1,NT1 L 4
UB(N)=US(N)/G(1) L 5
IF (N.EQ.NT) GO TO 100 L 6
N1=N+1 L 7
DO 200 I=N1,NT L 8
II=I-N+1 L 9
200 US(I)=US(I)-UB(N)*G(II) L 10
100 CONTINUE L 11
UB(NT)=US(NT)/G(1) L 12
WRITE (6,3000) L 13
WRITE (6,2000) (I,UB(I),I=1,NT) L 14
C L 15
RETURN L 16
2000 FORMAT (I10,F20.5) L 17
3000 FORMAT(1H1,4X,22HDECONVOLVED EARTHQUAKE) L 18
END L 19
