基础工程分析与设计英文版第2版的筏板程序问题

以下是英文版里的计算筏板网格法的程序，编译通过，运行有问题，那个高手看能不能改好，
C FOUNDATION ANALYSIS AND DESIGN 2nd
C B-7 FINITE-ELEMENT PROGRAM FOR SOVLING MAT FOUNDATIONS AS A PLATE ON
C AN ELASTIC FOUNDATION(MAY BE USED FOR PILE CAPS AND COUNTERFORT
C RETAINING WALL)
C J E BOWLES DIRECT ELEMENT METHOD OF MAT ON ELASTIC FOUNDATION
C B=MEM WIDTH, T=MEM THICK,;
C H,V=HOR AND VERT DISP FOR LENGTH PROGRAM COMPUTES I AND J(POLAR 1);
C E=MOD OF ELAST; G=G=SHEAR MOD;
C NM=NO OF MEMBERS; NP=SIZE OF MATRIX;
C NNZP=NO OF NON-ZERO P-VALUES TO BE READ IN;
C NLC=NO OF LOADING CONDITIONS--USE 1 IF IREPT>0
C NOX,NOY,NNODE=NO OF NODES IN X & Y DIRECTIONS & TOTAL NO OF NODES
C CAN VARY SOIL MODULUS BUT NOT ACROSS ANY NODE.READ SK>0 AND
C ** USE KSM=0 AND SK1,SK2=0.0 FOR SUPPORTED PLATESS
C USE KSM=0 AND SK=VALUE FOR CONSTANT SOIL MODULUS AND IT IS
C NOT NECESSARY TO HAVE SK1,SK2 ON MEMBER DATA CARDS
C IF USE CARD DEVELOPER PROGRAM READ KSM=1 AND SK=0.
C LAST MEMBER CARD NM+1 IS PUNCHED AS SUCH IN COL 5
C ***********
C GRID MUST BE ORIENTED SO GO ACROSS THEN DOWN--KEEP BAND WIDTH
C AS SMALE AS POSSIBLE BY ROTATION OF MAT. NARROW BAND WIDTH IS
C MAXIMUM MATRIX REDUCTION EFFICIENCY
C ** FOR ODD SHAPED MATS THE COUNTERS USED FOR SUMMING JOINT MOMENTS
C MAY NOT COUNT PROPERLY--CHECK OUTPUT UNLESS ELEMENTAS ARE HORIZ OR VERT
C LIST=1 WILL LIST ASAT MATRIX;LISTB=1 LISTS BAND MATRIX
C ***********
C *** NOTE THAT CERTAIN COMBINATIONS OF E,G,T,AND FIG SIZE MAY
C REQUIRE USING "ODUBLE PRECISION STIFF,P" TO OBTAIN A SATISFACTORY
C SOLUTION--IF SUM VERT FORCES IS NOT EQUAL TO ZERO WITHIN ABOUT 0.5%
C ERROR USE DOUBLE PRECISION--AFTER CHECKING MEMBER DATA CARDS
C ***********
C NOZX=NO OF ZERO X-VALUES TO DESCRIBE BOUNDARY CONDITIONS OF ZERO
C ROTATION OR DEFLECTION
C *********
C ********* CAUTION DO NOT USE IREPT AND NLC >1 AT SAME TIME
C ********* CAUTION DO NOT USE NLC>1 IF PROGRAM RECYCLES
C DUE TO NEGATIVE SOIL PRESSURES--PROGRAM MAY OR MAY
C NOT FUNCTION PROPERLY IF YOU DO
C ***********
C IPCAP>0 SOLVES PILE CAP PROBLEMS FOR BENDING MOMENTS
C USE ONLY APPROPRIATE PARTS OF OUTPUT OF 3-D PILE GROUP
C AS MAT INPUT TO SOLVE AS MAT PROBLEM
C *********
C ************
C IREPT,IREPTM INDEX TO REPEAT PROBLEM IF IREPT>0 *** IREPTM IS MAX
C NUMBER OF REPEAT CYCLES-USE THIS TO COMPARE ROTATION VS NO ROTAT.
C IF IREPT > 0 MUST READ SEPARATE NOZP DATA,NZEROP DATA AND NEW P-MATRIX EN
C TRIES TO BUILD P-MATRIX ANEW
C ************
C *********
C *** ALPH=COEFF FOR B/A RATIO OF GRID (OR PLATE)=.75 FOR B/A=1
C ALPH=1.00 FOR B/A>1 AND MAY USE 1.05 FOR FIXED EDGE PLATE
C ************** THIS PROGRAM WILL ALSO SOLVE SIMPLY AND FIXED EDGE SUPPORT
C PLATES AS FOR EXAMPLE FLOOR SLABS OF CONCRETE
C
C IF KSM=0 AND SK1,SK2 ON CARDS WILL ZERO SK1,SK2 (FOR USING SAME MEM
C CARDS FOR OTHER PROBS)
C FOR GENERAL SOIL PROBS USING SSK1,SK2 ON MEMBER DATA CARDS USE KSM=1
C IF KSM=0 AND SK>0 SETS SK1,SK2=SK WHERE SK=CONSTANT VALUE
C OF SOIL MODULUS BENEATH FOOTING
C FOR FLOOR SLABS,PILE CAPS SET KSM=0 AND SK=0
C
C ITHICK=SWITCH TO READ VARIABLE THICKNESS FOR VERTICAL WALLS--USE 1
C FOR WALLS--USE O FOR PLATES ON ELASTIC FOUNDATION AS CURRENTLY SET
C I3EDGE=SWITCH FOR PLATES FIXED ON 3-EDGES TO AVOID RECYCLING
C UT1:FT,UT3:KIPS,UT4:FT-K,UT5:KSF:UT6:K/CU FT
C UT1:M ,UT3:KN ,UT4:KN-M,UT5:KPa:UT6:KN/CU M
C
PROGRAM MAIN
DIMENSION P(200,2),NPE(6),EA(6,5),ASAT(200),ES(5,5),STIFF(5200),
1ESAT(5,6),EASAT(6,6),INDEX(10),F(5),XX(100),SOILP(100),
2SUMP(5),NNP(100),ICOUN(10),R(5),S(5),LCOUN(100),MEM(100,4),
3XMX(110,2),XMY(110,2),FTGWT(200),NZEROX(50),TITLE(20)
EQUIVALENCE (XMX(1),STIFF(2200)),(STIFF(2700),XMY(1)),(NNP(1),
1LCOUN(1)),(STIFF(320),MEM(1)),(ASAT(1),LCOUN(1))
CHARACTER UT1*2,UT3*5,UT5*5,UT6*9
C
DEFINE FILE 10(200,432,U,IR)
C DOUBLE PRECISION UT5,UT6
C
OPEN(1,FILE='EX102SE.txt',STATUS='OLD')
OPEN(3,FILE='OUT.TXT',STATUS='UNKNOWN')
6000 READ(1,1000,END=150) TITLE
READ(1,*) UT1,UT3,UT5,UT6
1000 FORMAT(20A4)
C
READ(1,1005)NP,NM,NNZP,KSM,NLC,NBAND,NOX,NOY,NNODE,LIST,LISTB
1,IREPT
READ(1,1005)NOZX,IREPTM,IPCAP,ITHICK,I3EDGE
1005 FORMAT(16I5)
NMP1=NM+1
101 WRITE(3,1002)TITLE
1002 FORMAT('1',//,T5,20A4)
IF(I3EDGE.GT.0)WRITE(3,3102)
3102 FORMAT(//,8X,'SOLUTION FOR PLATE FIXED ON 3-EDGES',/)
IF(IPCAP.GT.0)WRITE(3,3103)
3103 FORMAT(//,8X,'SOLUTION FOR PILE CAP',/)
C
READ(1,1007)E,G,SK,T,UNITWT,ALPH
1007 FORMAT(8F10.4)
WRITE(3,1008)E,UT5,G,UT5,SK,UT6,UNITWT,UT6,NOX,NOY,NNODE,NP,NOZX
1,ALPH,NNZP
1008 FORMAT(//T5,'E=',F10.1,1X,A7,5X,'G=',F10.1,1X,A7,5X,'SOIL MODULU
1S=',F9.2,1X,A7/ T5,'UNIT WT=',F7.3,1X,A7//,T5,'NO OF X-NODES='
2,I5,3X,'NO OF Y-NODES=',I5,3X,'TOTAL NO OF NODES=',I6,/,T5,
3'NO OF NP=',I4,3X,'NO OF ZERO NP=',I3,2X,'ALPHA COEFF FOR GJ
4/L=',F6.2,/,10X,'NO OF NON-ZERO P-MATRIX ENTRIES=',I4,//)
IR=1
II=0
III=0
N3=1
IZERO=1
WRITE(3,104)
104 FORMAT(/,2X,'MEMNO',2X,'NP1',2X,'NP2',2X,'NP3',2X,'NP4',2X,
+'NP5',2X,'NP6',6X,'H',7X,'V',7X,'LEN',7X,'B',7X,'T',8X,'SM1'
+,5X,'SM2',4X,'INERTIA',3X,'POLAR I',//)
C RELOOP HERE TO REBUILD SAT
C RELOOP HERE TO REBUILD ELEMENT A AND SAT MATRICES TO
C COMPUTE ELEMENT FORCES AFTER ASAT IS INVERTED
106 IF(II.GT.0.OR.III.GT.0) GOTO 11

C READ GRID MEMBER DATA AT ONE CARD PER MEMBER

IF(ITHICK.LE.0)READ(1,107)MEMNO,(NPE(I),I=1,6),H,V,B,SK1,SK2
IF(ITHICK.GT.0)READ(1,107)MEMNO,(NPE(I),I=1,6),H,V,B,T
107 FORMAT(7I5,3F10.4,2F7.2)

C THESE 2 STATEMENTS ALLOWS USE OF SAME MEMBER DATA CARDS WITH NO SOIL
C SPRINGS IF KSM=0 AND SK=0.0 REGARDLESS OF WHAT IS ON MEM CARD

IF(KSM.EQ.0)SK1=0.
IF(KSM.EQ.0)SK2=0.
BPR=B
AA=AMAX1(BPR,T)
IF(MEMNO.EQ.NMP1)GOTO 21
BB=AMIN1(BPR,T)
C=AA/BB
IF(C.LE.2.)BE=0.087*C+0.054
IF(C.GT.2.AND.C.LE.4.5)BE=0.0288*C+0.174
IF(C.GT.4.5)BE=0.00218*C+0.2902
21 XJ=BE*AA*BB**3
XI=B*T**3/12.
XL=SQRT(H**2+V**2)
IF(MEMNO.NE.NM+1)COSA=H/XL
IF(MEMNO.NE.NM+1)SINA=V/XL
IF(KSM.EQ.0.AND.SK1.EQ.0)SK1=SK
IF(KSM.EQ.0.AND.SK2.EQ.0)SK2=SK
SM1=SK1*B*XL/4.
SM2=SK2*B*XL/4.
FW1=UNITWT*B*T*XL/4.
FW2=UNITWT*B*T*XL/4.
WRITE(3,110)MEMNO,(NPE(I),I=1,6),H,V,XL,B,T,SM1,SM2,XI,XJ
110 FORMAT(T1,7I5,2X,7F9.3,2X,2F8.5)

C WRITE MEMBER DATA ON DISK WORK AREAS 5 AND 6
C WORK AREA 6 IS PERMANENT RECORD SO IF NLC>1 AND MAT-SOIL SEPARATION
C HAS OCCURRED THE NODAL SOIL DATA IS NOT LOST FOR REMAINING NLC'S
WRITE(5)MEMNO,(NPE(I),I=1,6),H,V,XL,B,T,SM1,SM2,XI,XJ,COSA,SINA,
1SK1,SK2
WRITE(6)MEMNO,(NPE(I),I=1,6),H,V,XL,B,T,SM1,SM2,XI,XJ,COSA,SINA,
1SK1,SK2
11 IF(II.GT.0.OR.III.GT.0)READ(5)MEMNO,(NPE(I),I=1,6),H,V,XL,B,T,
1SM1,SM2,XI,XJ,COSA,SINA,SK1,SK2
IF(MEMNO.EQ.NM+1) GOTO 301

IF(MEMNO.GT.1.OR.II.GT.0) GOTO 108
DO 75 MM=1,NP
FTGWT(MM)=0.
75 ASAT(MM)=0.
DO 103 I=1,NP
103 WRITE(10'IR)(ASAT(MM),MM=1,NP)
108 DO 80 I=1,6
DO 80 J=1,5
80 EA(I,J)=0.
C BUILD ELEMENT A MATRIX
EA(1,1)=-SINA
EA(1,3)=-COSA
EA(2,1)=COSA
EA(2,3)=-SINA
EA(3,1)=1./XL
EA(3,2)=1./XL
EA(3,4)=-1.
EA(4,2)=-SINA
EA(4,3)=COSA
EA(5,2)=COSA
EA(5,3)=SINA
EA(6,1)=-1./XL
EA(6,2)=-1./XL
EA(6,5)=-1.
DO 81 I=1,5
DO 81 J=1,5
81 ES(I,J)=0.
C BUILD ELEMENT S-MATRIX
ES(1,1)=4.*E*XI/XL
ES(1,2)=.5*ES(1,1)
ES(2,1)=ES(1,2)
ES(2,2)=ES(1,1)
ES(3,3)=ALPH*G*XJ/XL
ES(4,4)=SM1
ES(5,5)=SM2
DO 202 I=1,5
DO 202 J=1,6
ESAT(I,J)=0.0
C BUILD ELEMENT SAT MATRIX
DO 202 K=1,5
202 ESAT(I,J)=ESAT(I,J)+ES(I,K)*EA(J,K)
IF(II) 203,203,605
C BUILD ELEMENT ASAT
203 DO 204 I=1,6
DO 204 J=1,6
EASAT(I,J)=0.
DO 204 K=1,5
204 EASAT(I,J)=EASAT(I,J)+EA(I,K)*ESAT(K,J)
C PUT ELEMENT ASAT IN GLOBAL ASAT
DO 205 I=1,6
NS1=NPE(I)
READ(10'NS1)(ASAT(MM),MM=1,NP)
DO 78 J=1,6
NS2=NPE(J)
78 ASAT(NS2)=ASAT(NS2)+EASAT(I,J)
205 WRITE(10'NS1)(ASAT(MM),MM=1,NP)
FTGWT(NPE(3))=FW1+FTGWT(NPE(3))
FTGWT(NPE(6))=FW2+FTGWT(NPE(6))
GOTO 106
C END OF ASAT MATRIX FORMATION
301 IF(II)302,302,605
302 CONTINUE
C WRITE ASAT IF LIST>0
IF(LIST.LE.0) GOTO 401
WRITE(3,8823)
8823 FORMAT('1',//,10X,'THE ASAT MATRIX')
IZ=1
8824 IP=IZ+10
IF(IP.GT.NP)IP=NP
DO 8825 JJ=1,NP
READ(10'JJ)(ASAT(MM),MM=1,NP)
8825 WRITE(3,8828)JJ,(ASAT(MM),MM=IZ,IP)
8828 FORMAT(T3,I3,2X,-2P11F10.2)
IF(IP.LT.NP)WRITE(3,8895)
8895 FORMAT('1',//,T5,'ASAT MATRIX CONTINUED')
IZ=IP+1
IF(IP.LT.NP)GOTO 8824
C ZERO & BUILT P-MATRIX
401 IF(IZERO.GT.1)GOTO 8650
C *****
C READ NEW REPEAT DATA FOR ZERO ROTAT & DEFL
C ********
C LOOP FOR REPEATING PROBLEM WITH ROTAT OR DEFL AS ZERO
C NOTE P-MATRIX IS REBUILT WHEN IREPT >0 AND NOTE P-MATRIX
C IS READ BEFORE THE BAND MATRIX IS ZEROED WITH NZEROX(I)
C
9880 IF(IREPT.GT.1)READ(1,1005)NOZX,IREPTM
IF(IREPT.GT.1)WRITE(3,9881)
9881 FORMAT(//,8X,'PROBLEM REPEATED WITH ALTERN.BOUND.CONDITIONS',/)
IF(IREPT.GT.1)WRITE(3,1008) E,UT5,G,UT5,SK,UT6,UNITWT,UT6,NOX,
1NOY,NNODE,NP,NOZX,ALPH,NNZP
IF(N3.GT.1) GOTO 8650
DO 406 K=N3,NLC
WRITE(3,3334) K
3334 FORMAT(///,T5,'LOAD CONDITION',I4,//)
C ***********
C BUILD P-MATRIX
SUMP(K)=0.
DO 402 I=1,NP
402 P(I,K)=0.
DO 404 JJ=1,NNZP
READ(1,405) I,P(I,K)
405 FORMAT(I5,F10.4)
404 CONTINUE
DO 15 I=1,NP
IF(I/3*3.NE.I)GOTO 15
P(I,K)=P(I,K)+FTGWT(I)
SUMP(K)=SUMP(K)+P(I,K)
15 CONTINUE
DO 16 I=1,NP
16 IF(P(I,K).NE.0)WRITE(3,3333) I,P(I,K)
3333 FORMAT(T5,I3,2X,'P=',F10.4)
IR=NP+K
WRITE(10'IR)(P(I,K),I=1,NP)
406 CONTINUE
8650 IF(III.LE.0) GOTO 8700
305 IR=NP+N3
DO 506 K=N3,NLC
506 READ(10'IR)(P(I,K),I=1,NP)
C SUBROUTINE TO WRITE ASAT IN COMPUTER AS UPPER TRIANGLE OF
C APPLICABLE BANDWIDTH
8700 N=1
NWIDTH=NBAND
DO 5600 J=1,NP
READ(10'J)(ASAT(I),I=1,NP)
LM=(J-1)*NBAND
DO 5700 JJ=1,NWIDTH
IF(JJ.GT.NP) GOTO 5300
STIFF(N)=ASAT(JJ)
GOTO 5550
5300 IF(N.LE.LM+NBAND) STIFF(N)=0.
5550 IF(N.LE.LM+NBAND) N=N+1
5700 CONTINUE
NWIDTH=NWIDTH+1
5600 CONTINUE
WRITE(3,4961) N
4961 FORMAT(//,T10,'NO OF STIFF(I) ENTRIES,N=',I5,///)
C ROUTINE TO ZERO THE APPROPRIATE LINE AND DIAG OF BAND MATRIX
IF(NOZX.EQ.0) GOTO 6668
READ(1,1005)(NZEROX(IZ),IZ=1,NOZX)
DO 6663 IZ=1,NOZX
NPZI=NZEROX(IZ)
LL=(NPZI-1)*NBAND+1
STIFF(LL)=0.
DO 6661 K=2,NBAND
6661 STIFF(LL+K-1)=0.
NO1=NPZI-1
NO2=NPZI-2
IF(NO1.GT.NBAND)NO1=NBAND-1
DO 6664 L=1,NO1
JL=NO2*NBAND+1+L
STIFF(JL)=0.
6664 NO2=NO2-1
6663 CONTINUE
6668 IF(LISTB.LE.0) GOTO 4985
C ** WRITE BAND MATRIX IN ORDER AT 11 ENTRIES PER GROUP ***
7777 WRITE(3,8757)
8757 FORMAT('1',//,4X,'THE BAND MATRIX CORRECTED FOR BOUNDARY
1CONDITIONS OF ZERO DISP AND ROTATION',/)
KK=1
LL=11
LM=0
4935 DIFF=NBAND-LL
DO 4975 I=1,NP
WRITE(3,4980) I,(STIFF(J),J=KK,LL)
4980 FORMAT(I4,1X,11F11.1)
IF(LL.EQ.N-1) GOTO 4985
KK=LL+LM*11+DIFF+1
LL=KK+10
IZ=(I+1)*NBAND
IF(LL.GT.IZ) LL=IZ
4975 CONTINUE
LM=LM+1
KK=LM*11+1
LL=KK+10
IF(LL.GT.NBAND) LL=NBAND
WRITE(3,8757)
GOTO 4935
C END OF WRITE BAND MATRIX ROUTINE
C SUBROUTINE TO REDUCE A SYMMETRIC TRIANGULAR NBAND MATRIX
C MATRIX IS STORED AND OPERATED ON USING NBANDWIDTH NBAND
C NOTE THAT MORE THAN 1 LOAD CONDITION CAN BE TREATED AT
C ONE TIME BY MODIFYING N3
4985 N1=1
DO 5910 N=1,NP
I=N
9999 DO 5908 L=2,NBAND
NL=(N-1)*NBAND+L
I=I+1
IF(STIFF(NL).EQ.0.) GOTO 5908
B=STIFF(NL)/STIFF(N1)
J=0
9998 DO 5907 K=L,NBAND
J=J+1
IJ=(I-1)*NBAND+J
NK=(N-1)*NBAND+K
5907 IF(STIFF(NK).NE.0.) STIFF(IJ)=STIFF(IJ)-B*STIFF(NK)
STIFF(NL)=B
C APPLY LOAD MATRIX BASED ON NUMBER OF LOAD CONDITIONS
9997 DO 5904 M=N3,NLC
5904 P(I,M)=P(I,M)-B*P(N,M)
5908 CONTINUE
DO 5906 M=N3,NLC
P(N,M)=P(N,M)/STIFF(N1)
5906 CONTINUE
5910 N1=N1+NBAND
C BACK SUBSTITUTION
N=NP
6010 N=N-1
IF(N.LE.0) GOTO 6025
L=N-1
DO 6011 K=2,NBAND
NK=(N-1)*NBAND+K
DO 6011 M=N3,NLC
IF(STIFF(NK).NE.0.)P(N,M)=P(N,M)-STIFF(NK)*P(L+K,M)
6011 CONTINUE
GOTO 6010
6025 CONTINUE
C END OF REDUCTION ROUTINE,SOLUTION IS IN P-MATRIX LOCATION
5500 SUMR=0.
LOADC=N3
ICOUN(1)=0
WRITE(3,3334) LOADC
4500 WRITE(3,604)
604 FORMAT(//,T5,'MEMNO',9X,'BENDING MOMENTS',T41,'TORSION MOMENT',
+T57,'ELEMENT SOIL REACTIONS',//)
II=II+1
PAUSE
REWIND 5
GOTO 11
C COMPUTE MEMBER FORCE
605 IF(MEMNO.EQ.NM+1) GOTO 957
LM=(MEMNO-1)*10
606 DO 607 I=1,5
F(I)=0.
DO 609 K=1,6
N=NPE(K)
609 F(I)=F(I)+ESAT(I,K)*P(N,LOADC)
607 IF(I.EQ.4.OR.I.EQ.5)SUMR=SUMR+F(I)
WRITE(3,608)MEMNO,(F(I),I=1,5)
608 FORMAT(T5,I5,5F14.3)
C WRITE SELECTED DATA IN STIFF(I) LOCATION FOR USE
C IN SUMMING MOMENTS AT NODES
STIFF(LM+1)=MEMNO
STIFF(LM+2)=NPE(1)
STIFF(LM+3)=NPE(4)
STIFF(LM+6)=H
STIFF(LM+7)=V
STIFF(LM+8)=F(1)
STIFF(LM+9)=F(2)
STIFF(LM+10)=F(3)
GOTO 11
957 WRITE(3,610)SUMP(LOADC),UT3,SUMR,UT3
610 FORMAT(//T10,'THE SUM OF VERTIC&L COL LOADS=',F10.4,1X,A4/,T12,
A'SUM ELEMENT REACTIONS=',F10.4,2X,A4,//)
WRITE(3,423) UT1
423 FORMAT(T8,'THE DEFORMATION MATRIX,',1X,A2,'OR RAD--EVERY 3RD=
1DEFL'//)
WRITE(3,426)(I,P(I,LOADC),I=1,NP)
426 FORMAT((T4,8(I4,2X,F9.5),//))
C NOTE IF IPCAP>1 TRANSFER CONTROL TO 5426 TO AVOID RECYCLING DUE TO
C NEGATIVE SOIL DEFLECTIONS SINCE NO SOIL IS USED FFOR SOIL SPRINGS
C TRANSFER CONTROL TO 5426 FOR PILE CAPS OR PLATES FIXED 3-EDGE
IF(IPCAP.GT.0.OR.I3EDGE.GT.0) GOTO 5426
JCOUN=0
J=0
C CHECK FOR MAT-SOIL SEPARATION(-DEFLECTIONS)
C ICOUN(IZERO)=NUMBER OF -DEFLECTIONS FOUND
DO 428 I=1,NP
IF(I/3*3.NE.I) GOTO 428
J=J+1
XX(J)=P(I,LOADC)
IF(XX(J).LT.0.)JCOUN=JCOUN+1
IF(XX(J).LT.0.)NNP(JCOUN)=I
428 CONTINUE
IZERO=IZERO+1
ICOUN(IZERO)=JCOUN
K=0
M=0
REWIND 5
IF(JCOUN.GT.0)REWIND 4
DO 431 LK=1,NMP1
READ(5)MEMNO,(NPE(I),I=1,6),H,V,XL,B,T,SM1,SM2,XI,XJ,COSA,SINA
1,SK1,SK2
IF(LK.EQ.NMP1) GOTO 408
M=M+1
IF(H.EQ.0.) M=0
IF(H.EQ.0.) GOTO 429
IF(M.EQ.1) K=K+1
SOILP(K+1)=XX(K+1)*SK2
IF(M.EQ.1)SOILP(K)=XX(K)*SK1
K=K+1
429 IF(JCOUN.EQ.0) GOTO 431
DO 430 LM=1,JCOUN
IF(NNP(LM).EQ.NPE(3)) SK1=0.
430 IF(NNP(LM).EQ.NPE(6)) SK2=0.
IF(SK1.EQ.0.) SM1=0.
IF(SK2.EQ.0.) SM2=0.
C IF FOOTING SEPARATES DATA FROM DDIAK AREA 5 IS WRITTEN ON DISK
C WORK AREA 4-THIS STEP IS NECESSARY SO THAT
C COMPARISON OF CURRENT AND PREVIOUS NUMBER OF SOIL
C SPRING CAN BE MADE
408 WRITE(4)MEMNO,(NPE(I),I=1,6),H,V,XL,B,T,SM1,SM2,XI,XJ,COSA,SINA
1,SK1,SK2
431 CONTINUE
WRITE(3,432) UT5
432 FORMAT(//,T8,'THE NODAL SOIL PRESSURE(',A7,')',//)
WRITE(3,426)(I,SOILP(I),I=1,J)
7513 II=0
IR=1
III=1
WRITE(3,5425)IZERO,ICOUN(IZERO),ICOUN(IZERO-1),JCOUN,N3
5425 FORMAT(//,4X,'IZERO=',I3,3X,'ICOUN(IZERO)=',I3,3X,'ICOUN(IZERO-1
1=',I3,3X,'JCOUN=',I3,3X,'CURRENT LOAD COUNDIT=',I2,/)
C
IF(ICOUN(IZERO).LE.ICOUN(IZERO-1)) GOTO 5426
REWIND 4
REWIND 5
DO 433 M=1,NMP1
READ(4)MEMNO,(NPE(I),I=1,6),H,V,XL,B,T,SM1,SM2,XI,XJ,COSA,SINA
1,SK1,SK2
433 WRITE(5)MEMNO,(NPE(I),I=1,6),H,V,XL,B,T,SM1,SM2,XI,XJ,COSA,SINA
1,SK1,SK2
REWIND 5
GOTO 11
5426 CONTINUE
IFF1=1
C CONVERT ELEMENT FORCES TO BENDING MOMENTS IN X & Y DIRECTIONS
C FIND NUMBER OF MEMBERS FRAMING INTO EACH NODE AND THEIR MEMBER NOS.
WRITE(3,7089)
7089 FORMAT(///,T5,'MEMBER NOS AND OF MEMBERS AT NODE',//)
DO 8011 KO=1,J
LCOUN(KO)=1
MEM(KO,3)=0
MEM(KO,4)=0
REWIND 5
DO 8010 N=1,NM
IF(LCOUN(KO).GT.4) GOTO 8008
READ(5)MEMNO,(NPE(I),I=1,6),H,V,XL,B,T,SM1,SM2,XI,XJ,COSA,SINA
1,SK1,SK2
IF(NPE(I).EQ.IFF1)MEM(KO,LCOUN(KO))=N
IF(NPE(4).EQ.IFF1)MEM(KO,LCOUN(KO))=N
IF(NPE(1).EQ.IFF1.OR.NPE(4).EQ.IFF1)LCOUN(KO)=LCOUN(KO)+1
8010 CONTINUE
8008 LCOUN(KO)=LCOUN(KO)-1
IFF1=IFF1+3
8011 CONTINUE
WRITE(3,8021)(KO,(MEM(KO,I),I=1,4),LCOUN(KO),KO=1,J)
8021 FORMAT(T5,5I6,2X,I6)
C FIND NODE MOMENTS EACH SSIDE OF NODE-IF ONLY 1 VALUE EXISTS OTHER
C VALUE IS MADE 0.0
DO 8040 KO=1,J
XMX(KO,1)=0.
XMX(KO,2)=0.
XMY(KO,1)=0.
XMY(KO,2)=0.
LM1=(MEM(KO,1)-1)*10
LM2=(MEM(KO,2)-1)*10
LM3=(MEM(KO,3)-1)*10
IF(LCOUN(KO).EQ.2) GOTO 794
IF(LCOUN(KO).EQ.3) GOTO 803
IF(LCOUN(KO).EQ.4) GOTO 804
794 IF(STIFF(LM1+2).EQ.STIFF(LM2+2).AND.STIFF(LM1+6).GE..01) GOTO 793
IF(STIFF(LM1+3).EQ.STIFF(LM2+2).AND.STIFF(LM2+6).LE..01) GOTO 795
IF(STIFF(LM1+3).EQ.STIFF(LM2+2).AND.STIFF(LM2+6).GE..01) GOTO 796
IF(STIFF(LM1+3).EQ.STIFF(LM2+3)) GOTO 797
C UPPER LEFT CORNER
793 XMX(KO,1)=STIFF(LM2+10)+STIFF(LM1+8)
XMY(KO,1)=STIFF(LM2+8)-STIFF(LM1+10)
GOTO 8040
C UPPER RIGHT CORNER
795 XMX(KO,1)=STIFF(LM1+9)+STIFF(LM2+10)
XMY(KO,1)=STIFF(LM1+10)+STIFF(LM2+8)
GOTO 8040
C LOWER LEFT CORNER
796 XMX(KO,1)=STIFF(LM1+10)-STIFF(LM2+8)
XMY(KO,1)=STIFF(LM1+9)-STIFF(LM2+10)
GOTO 8040
C LOWER RIGHT CORNER
797 XMX(KO,1)=STIFF(LM1+10)-STIFF(LM2+9)
XMY(KO,1)=STIFF(LM1+9)+STIFF(LM2+10)
GOTO 8040
803 IF(MEM(KO,2).EQ.MEM(KO,1)+1) GOTO 8001
IF(MEM(KO,3).EQ.MEM(KO,2)+1) GOTO 8005
IF(STIFF(LM1+3).EQ.STIFF(LM2+2).AND.(STIFF(LM2+2).EQ.STIFF(LM3+2)
1).AND.(STIFF(LM1+6).LE.0.)) GOTO 8004
GOTO 8003
C BENDING MOMENTS ALONG TOP
8001 IF(STIFF(LM1+9).GT.0.)XMX(KO,1)=STIFF(LM1+9)
IF(STIFF(LM2+8).GT.0.)XMX(KO,1)=XMX(KO,1)+STIFF(LM2+8)
IF(STIFF(LM3+10).GT.0.)XMX(KO,1)=XMX(KO,1)+STIFF(LM3+10)
IF(STIFF(LM1+9).LE.0.)XMX(KO,2)=STIFF(LM1+9)
IF(STIFF(LM2+8).LE.0.)XMX(KO,2)=XMX(KO,2)+STIFF(LM2+8)
IF(STIFF(LM3+10).LE.0.)XMX(KO,2)=XMX(KO,2)+STIFF(LM3+10)
XMY(KO,1)=STIFF(LM1+10)+STIFF(LM3+8)-STIFF(LM2+10)
GOTO 8040
C BENDING MOMENTS ALONG LEFT SIDE
8004 IF(STIFF(LM1+9).GT.0.)XMY(KO,1)=STIFF(LM1+9)
IF(STIFF(LM2+10).LT.0.)XMY(KO,1)=XMY(KO,1)-STIFF(LM2+10)
IF(STIFF(LM3+8).GT.0.)XMY(KO,1)=XMY(KO,1)+STIFF(LM3+8)
IF(STIFF(LM1+9).LT.0.)XMY(KO,2)=STIFF(LM1+9)
IF(STIFF(LM2+10).GT.0.)XMY(KO,2)=XMY(KO,2)-STIFF(LM2+10)
IF(STIFF(LM3+8).LT.0.)XMY(KO,2)=XMY(KO,2)+STIFF(LM3+8)
XMX(KO,1)=STIFF(LM1+10)-STIFF(LM2+8)-STIFF(LM3+10)
GOTO 8040
C BENDING MOMENTS ALONG RIGHT SIDE
8003 XMX(KO,1)=STIFF(LM1+10)-STIFF(LM2+9)-STIFF(LM3+10)
IF(STIFF(LM1+9).GT.0.)XMY(KO,1)=STIFF(LM1+9)
IF(STIFF(LM2+10).GT.0.)XMY(KO,1)=XMY(KO,1)+STIFF(LM2+10)
IF(STIFF(LM3+8).GT.0.)XMY(KO,1)=XMY(KO,1)+STIFF(LM3+8)
IF(STIFF(LM1+9).LT.0.)XMY(KO,2)=STIFF(LM1+9)
IF(STIFF(LM2+10).LT.0.)XMY(KO,2)=XMY(KO,2)+STIFF(LM2+10)
IF(STIFF(LM3+8).LT.0.)XMY(KO,2)=XMY(KO,2)+STIFF(LM3+8)
GOTO 8040
C BENDING MOMENTS ALONG BOTTOM
8005 XMY(KO,1)=STIFF(LM1+9)+STIFF(LM2+10)-STIFF(LM3+10)
IF(STIFF(LM1+10).GT.0.)XMX(KO,1)=STIFF(LM1+9)
IF(STIFF(LM2+9).LT.0.)XMX(KO,1)=XMX(KO,1)-STIFF(LM2+9)
IF(STIFF(LM3+8).LT.0.)XMX(KO,1)=XMX(KO,1)-STIFF(LM3+8)
IF(STIFF(LM1+10).LT.0.)XMX(KO,2)=STIFF(LM1+10)
IF(STIFF(LM2+9).GT.0.)XMX(KO,2)=XMX(KO,2)-STIFF(LM2+9)
IF(STIFF(LM3+8).GT.0.)XMX(KO,2)=XMX(KO,2)-STIFF(LM3+8)
GOTO 8040
804 LM4=(MEM(KO,4)-1)*10
S(1)=STIFF(LM1+9)
S(2)=STIFF(LM2+10)
S(3)=STIFF(LM4+8)
S(4)=STIFF(LM3+10)
R(1)=STIFF(LM2+9)
R(2)=STIFF(LM3+8)
R(3)=STIFF(LM4+10)
R(4)=STIFF(LM1+10)
IF(S(M).GT.0.)XMY(KO,1)=XMY(KO,1)+S(M)
IF(S(M).LT.0.)XMY(KO,2)=XMY(KO,2)+S(M)
IF(R(M).GT.0.)XMX(KO,1)=XMX(KO,1)+R(M)
820 IF(R(M).LT.0.)XMX(KO,2)=XMX(KO,2)+R(M)
IF(S(4).LT.0.)XMY(KO,1)=XMY(KO,1)-S(4)
IF(S(4).GT.0.)XMY(KO,2)=XMY(KO,2)-S(4)
IF(R(4).GT.0.)XMX(KO,2)=XMX(KO,2)-R(4)
IF(R(4).LT.0.)XMX(KO,1)=XMX(KO,1)-R(4)
8040 CONTINUE
WRITE(3,8041)
8041 FORMAT(///,T5,'NODAL MOMENTS (COLUMN MOMENTS FROM P-MATRIX NOT IN
1CLUDEED)',//T13,'X-1',8X,'X-2',12X,'Y-1',11X,'Y-2')
DO 8042 I=1,KO
8042 WRITE(3,8044)I,(XMX(I,J),J=1,2),(XMY(I,J),J=1,2)
8044 FORMAT(T3,I5,2X,4F12.4)
C N3 AS LOAD CONDITION COUNTER LS INCREMENTED HARE
7551 IF(IREPT.LE.0) N3=N3+1
WRITE(3,3457)IZERO,ICOUN(IZERO),ICOUN(IZERO-1),JCOUN,N3
3457 FORMAT(//,T5,'IZERO=',I3,3X,'ICOUN(IZERO)=',I3,3X,'ICOUN(IZERO-1)
1=',I3,3X,'JCOUN=',I3,3X,'NEXT LOAD CONDIT=',I3,//)
C CHECK ON LOOPING SOIL PRESSURE,REPEATING PROBLEM (IREPT>0)
C CHECK ON NLC
IF(I3EDGE.GT.0)GOTO 6000
IF(N3.LE.NLC.AND.(ICOUN(IZERO-1).LE.0).AND.IREPT.LE.0) GOTO 5500
IF(IREPT.GT.0) IREPT=IREPT+1
IF(LOADC.EQ.NLC) GOTO 149
9975 FORMAT(7F10.7)
C TRANSFER ORIGINAL DATA FROM DISK AREA 6 TO DISK AREA 5
REWIND 5
REWIND 6
DO 434 J=1,NMP1
READ(6)MEMNO,(NPE(I),I=1,6),H,V,XL,B,T,SM1,SM2,XI,XJ,COSA,SINA
1,SK1,SK2
434 WRITE(5)MEMNO,(NPE(I),I=1,6),H,V,XL,B,T,SM1,SM2,XI,XJ,COSA,SINA
1,SK1,SK2
REWIND 5
REWIND 6
II=0
IZERO=1
IR=1
III=1
GOTO 11
149 IF(IREPT.GT.1.AND.IREPT.LE.IREPTM) GOTO 9880
REWIND 5
REWIND 6
GOTO 6000
150 STOP
END