Liren Large Software Subsidy 9

home *** CD-ROM | disk | FTP | other *** search

/ Liren Large Software Subsidy 9 / 09.iso / e / e003 / 7.ddi / STIDYN1.FOR < prev next >

Wrap

Text File | 1980-01-04 | 86.5 KB | 1,084 lines

SUBROUTINE CBLOK (MHI,LM,LL,NBLOCK,MCB,NUMEL,MTB,MVT,NEMN) 00036240 IMPLICIT REAL*8(A-H,O-Z) 00036250 REAL*8MHI,KFT 00036260 REAL*8 NEQP 00036270 REAL*8 LM,NPAR 00036280 COMMON /FORCE/ NLC,NELD R0036290 COMMON /CG/ SCG(4),RRCG(2) R0036300 COMMON/MASS/LMASS 00036310 COMMON /SUPEL/ KSE,NEQL,NRSUPE(4) R0036320 COMMON/SLVE/NSLAVE 00036330 COMMON /AMB/ GRAV,REFT,JROT R0036340 COMMON/PREP/QD(2),NSTOP,NDYN,NRPREP(15) R0036350 DIMENSION MHI(1), LM(1) 00036360 COMMON A(1) COMMON /JUNK/ KFT(4),MCC,KST,KND,NORDER(200),JUK(15),RRJUNK(114) R0036380 COMMON /ELPAR/ NPAR(14),NUMNP,MBAND,NELTYP,N1,N2,N3,N4,N5,MTOT,NEQ00036390 & ,RRELPA(24) R0036391 CALL FILES(18) 00036400 REWIND 3 00036410 ZER=0.0 00036420 CALL QVSET (ZER,A(N2),NEQ) 00036430 NT1=10 00036440 NT2=2 00036450 REWIND NT1 00036460 CALL RDWRT (NT2,LM,1,6,I) 00036470 MCC=0 00036480 IF (NLC.EQ.0) MCC=1 00036490 MCB=0 00036500 NEQP=NEQ+1 00036510 NMIN=NEMN+9 00036520 IF(NDYN.EQ.8) NMIN=NEMN+NEQ+9 00036530 IF(NDYN.EQ.8.AND.LMASS.EQ.-1) NMIN=NEMN+NEQ+NEQ+9 00036540 KND=NEQ-NEQL 00036550 KST=(KND*KND-KND)/2+KND*(LL+1) 00036560 IF(KST.GT.MTOT.AND.NDYN.EQ.8) CALL ERROR(KST-MTOT) 00036570 CALL QVSET (NEQP,MHI,NEQ) 00036580 NT=0 00036590 DO 110 I=1,NUMEL 00036600 CALL RDWRT (NT2,LM,NEMN,0,KOUNT) 00036610 ND=LM(KOUNT) 00036620 KCOL=LM(1) 00036630 XCOL=KCOL 00036640 NT=NT+1 00036650 NNT=NT*2 00036660 NORDER(NNT-1)=KCOL 00036670 NORDER(NNT)=LM(ND) 00036680 IF (NT.NE.100.AND.I.NE.NUMEL) GO TO 100 00036690 WRITE (NT1) NORDER 00036700 NT=0 00036710 100 DO 110 J=1,ND 00036720 NCOL=LM(J) 00036730 110 IF (XCOL.LT.MHI(NCOL)) MHI(NCOL)=KCOL 00036740 DO 130 I=1,NEQ 00036750 MHI(I)=I-MHI(I)+1 00036760 IF (MHI(I)) 120,120,130 00036770 120 WRITE (6,320) I 00036780 MHI(I)=0 00036790 NSTOP=1 00036800 130 CONTINUE 00036810 MCBI=-100 00036820 135 MCBI=MCBI+100 00036830 MCB=MCBI 00036840 IF(MCB.GT.MTOT/4) WRITE(6,136) 00036850 IF(MCB.GT.MTOT/4) NSTOP=1 00036860 136 FORMAT(////20X,47HONE COLUMN OF THE STIFFNESS MATRIX IS TOO LARGE,00036870 $33H TO FIT IN CORE - TOTSTF ROUTINE.///) 00036880 IF (NSTOP.EQ.1) RETURN 00036890 MTB=(MTOT-4*MCB-NMIN)/2 00036900 II=0 00036910 MNCE=0 00036920 MC=0 00036930 DO 150 I=1,NEQ 00036940 MNCE=MNCE+1 00036950 II=II+MHI(I)+LL 00036960 IF (I.EQ.NEQ) GO TO 140 00036970 IF (II.LT.MTB) GO TO 150 00036980 140 II=II-MTB 00036990 IF (MNCE.GT.MC) MC=MNCE 00037000 MNCE=0 00037010 IF (II.GT.0) MNCE=1 00037020 IF (II.LT.0) II=0 00037030 150 CONTINUE 00037040 MTB=MTB+2*MCBI 00037050 MTB=MTB-4*MC/2 00037060 IF(NDYN.NE.8) GO TO 155 00037070 IF(KST.LE.MTB) GO TO 155 00037080 IF( MTB+2*MC+4.LT.KST) MTB=MTOT-2*MC-KST 00037090 155 CONTINUE 00037100 IF (NEQ+LL.LE.MTB) GO TO 160 00037110 IF(MTB+2*MC.LT.NEQ+LL) MTB=MTOT-2*MC-NMIN-NEQ-LL 00037120 160 MLT=MAX0(MTB,NEQ) 00037130 DO 170 I=1,LL 00037140 170 IF (NEQ*I.LE.MLT) MVT=I 00037150 IF(LMASS.EQ.-1.AND.NDYN.EQ.8) GO TO 1160 00037160 GO TO 1180 00037170 1160 IRK=NEQ-NEQL 00037180 DO 1170 I=1,IRK 00037190 1170 IF(NEQ*I.LE.MLT) MVTT=I 00037200 IF(MVTT.GT.MVT) MVT=MVTT 00037210 1180 CONTINUE 00037220 J=1 00037230 X=0. 00037240 MCB=1 00037250 180 NTB=0 00037260 KST=J 00037270 190 NTB=NTB+MHI(J)+LL 00037280 J=J+1 00037290 IF (J.GT.NEQ) GO TO 200 00037300 MHJ=MHI(J) 00037310 IF (NTB+MHJ+LL.LE.MTB) GO TO 190 00037320 200 KND=J-1 00037330 X=X+1. 00037340 NC=KND-KST+1 00037350 IF (NC.GT.MCB) MCB=NC 00037360 IF (J.LE.NEQ) GO TO 180 00037370 IF(NMIN+4*MCB+2*MTB.GT.MTOT) GO TO 135 00037380 NWB=MCB*LL 00037390 N3=NEQ+MCB+N2 00037400 N4=N3+6*LL 00037410 N5=N4+NWB 00037420 N6=N5+MCB 00037430 N8=N6+MCB 00037440 IF (N8.GT.MTOT) CALL ERROR (N8-MTOT) 00037450 MB=DSQRT(X) 00037460 MB=MB/2+1 00037470 MB=MB*2 00037480 KLEQ=NEQ 00037490 J=1 00037500 NBLOCK=0 00037510 210 MIN=NEQ 00037520 NTB=0 00037530 KFT(3)=J 00037540 220 NTB=NTB+MHI(J)+LL 00037550 NST=J-MHI(J)+1 00037560 IF (NST.LT.MIN) MIN=NST 00037570 J=J+1 00037580 IF (J.GT.NEQ) GO TO 230 00037590 MHJ=MHI(J) 00037600 IF (NTB+MHJ+LL.LE.MTB) GO TO 220 00037610 230 KFT(4)=J-1 00037620 KFT(2)=MIN 00037630 KFT(1)=0 00037640 IF (J.GT.NEQ) GO TO 250 00037650 DO 240 NCOL=J,NEQ 00037660 NSTART=NCOL-MHI(NCOL)+1 00037670 240 IF (NSTART.LE.J-1) KFT(1)=NCOL 00037680 KFT(1)=KFT(1)-KFT(4) 00037690 250 KST=KFT(3) 00037700 KND=KFT(4) 00037710 NC=KND-KST+1 00037720 KFL=MOD(NBLOCK,MB) 00037730 IF (KFL.NE.0.OR.KND.GE.NEQ) GO TO 290 00037740 IF (X.EQ.1.) GO TO 290 00037750 KMB=1 00037760 KM=J 00037770 260 NTB=0 00037780 KMB=KMB+1 00037790 270 NTB=NTB+MHI(KM)+LL 00037800 KM=KM+1 00037810 IF (KM.GT.NEQ) GO TO 280 00037820 MHJ=MHI(KM) 00037830 IF (NTB+MHJ+LL.LE.MTB) GO TO 270 00037840 280 KLEQ=KM-1 00037850 IF (KM.GE.NEQ) GO TO 290 00037860 IF (KMB.NE.MB) GO TO 260 00037870 290 CONTINUE 00037880 IF (KLEQ.GT.NEQ) KLEQ=NEQ 00037890 IF (KND.EQ.NEQ) KLEQ=NEQ 00037900 N8=N2+KST-1 00037910 N9=N6+MCB 00037920 NSLDM=NSLAVE 00037930 IF(NSLDM.EQ.0) NSLDM=1 00037940 CALL CINL (A(N8),A(N3),A(N4),A(N5),A(N6),LL,NC,A(N1),NUMNP,NBLOCK 00037950 1,NWB,MCB,KLEQ,A(N9),NSLDM) 00037960 NBLOCK=NBLOCK+1 00037970 IF (J.LE.NEQ) GO TO 210 00037980 IF (SCG(4).LE.0.0) RETURN 00037990 DO 300 I=1,3 00038000 300 SCG(I)=SCG(I)/SCG(4) 00038010 SCG(4)=SCG(4)*GRAV 00038020 WRITE(6,310) SCG 00038030 310 FORMAT(//20X,49HTHE CENTER OF GRAVITY OF THE FINITE ELEMENT MODEL,00038040 17H IS AT,//30X,4HX = ,F12.4,8H UNITS,/30X,4HY = ,F12.4, 00038050 18H UNITS,/30X,4HZ = ,F12.4,8H UNITS., 00038060 2//20X,25HTHE TOTAL MODEL WEIGHT IS,F12.3,7H UNITS.////) 00038070 320 FORMAT (//,30H NO TERMS IN EQUATION NUMBER =,I5) 00038080 RETURN 00038090 END 00038100 SUBROUTINE QVSET(C,A,N) 00194580 REAL*8 C,A 00194590 DIMENSION A(1) 00194600 DO 100 I=1,N 00194610 100 A(I)=C 00194620 RETURN 00194630 END 00194640 SUBROUTINE RDWRT(JT,A,NUM,N,J) 00199630 IMPLICIT REAL*8(A-H,O-Z) 00199640 REAL*8 A 00199650 COMMON /WORDS/ NWDS(30,2) 00199660 DIMENSION A(NUM) 00199670 DIMENSION IUNIT(41) 00199680 DATA 00199690 $ IUNIT/21,22,23,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19, 00199700 $20,1,2,23,24,25,26,27,28,29,30,31,32,33,34,35,36,37,38,39,40,41/ 00199710 NT=IUNIT(JT) 00199720 K=N+1 00199730 LNTRC=NUM*8 00199740 GO TO (100,110,120,130,230,140,150, 00199750 $230,230,230,230, 00199760 $160,180,210,220),K 00199770 100 CONTINUE READ (NT) J R0199780 CALL RDA(NT,A,J) 00199790 RETURN 00199800 110 CONTINUE R0199801 WRITE (NT) NUM R0199810 WRITE (NT) A 00199820 NWDS(NT,1)=NWDS(NT,1)+NUM 00199830 RETURN 00199840 120 CONTINUE R0199841 BACKSPACE NT R0199850 BACKSPACE NT 00199860 RETURN 00199870 130 READ (NT) 00199880 READ (NT) 00199890 RETURN 00199900 140 READ (NT) J,A 00199910 RETURN 00199920 150 REWIND NT 00199930 IF(NWDS(NT,1).GT.NWDS(NT,2)) NWDS(NT,2)=NWDS(NT,1) 00199940 NWDS(NT,1)=0 00199950 RETURN 00199960 160 DO 170 I=1,20 00199970 DO 170 J=1,2 00199980 170 NWDS(I,J)=0 00199990 RETURN 00200000 180 DO 200 I=1,20 00200010 J=NWDS(I,1) 00200020 IF(NWDS(I,2).GT.J) J=NWDS(I,2) 00200030 IF(J.GT.0) WRITE(6,190)I,J 00200040 190 FORMAT(//20X,13HDISK FILE NO.,I3,25H WAS REQUIRED TO STORE A, 00200050 $12H MAXIMUM OF,1X,I9,18H WORDS OF STORAGE./) 00200060 200 CONTINUE 00200070 RETURN 00200080 210 WRITE(NT) A 00200090 NWDS(NT,1)=NWDS(NT,1)+NUM 00200100 RETURN 00200110 220 READ(NT)A 00200120 230 RETURN 00200130 END 00200140 SUBROUTINE RDA(NT,A,NUM) 00196460 REAL*8 A 00196470 DIMENSION A(NUM) 00196480 READ (NT) A 00196490 RETURN 00196500 END 00196510 SUBROUTINE ERROR(I) 00086230 IMPLICIT REAL*8(A-H,O-Z) 00086240 REAL*8 X 00086250 COMMON /EXTRA/ MODEX,NREXTR(25) R0086260 COMMON /PREP/ X(2),KSKIP,RRPREP(8) R0086270 KSKIP=1 00086280 MODEX=1 00086290 WRITE(6,100)I 00086300 100 FORMAT (1H0//1X,30HALLOCATED STORAGE EXCEEDED BY ,I7,6H WORDS) 00086310 WRITE(6,110) 00086320 110 FORMAT(/1X, 29HNO EXECUTION WILL BE ALLOWED./) 00086330 RETURN 00086340 END 00086350 SUBROUTINE CINL (MHI,TR,B,LDG,TMASS,LL,NC,ID,NUMNP,NBLOCK,NWB,MCB 00038320 1,KLEQ,ISL,NSLDM) 00038330 IMPLICIT REAL*8(A-H,O-Z) 00038340 REAL*8 MHI,KFT,LDG 00038350 REAL*8 ID(NUMNP,3) 00038360 LOGICAL ISLAVE 00038370 COMMON /CG/ SCG(4),RRCG(2) R0038380 COMMON /PREP/ XDZ(2),KSKIP,NDYN,NRPREP(15) R0038390 COMMON /AMB/ GRAV,REFT,JROT 00038400 COMMON/QTSARG/RAD,THET,X,Y,FN(2),AC(2),RRQTSA(992) R0038410 COMMON /TRASH/ ACC(490) 00038420 COMMON /JUNK/ KFT(4),MCC,KST,KND,JUK(214),NB,RRJUNK(114) R0038430 DIMENSION MHI(MCB), B(NWB), TR(6,LL), LDG(MCB), TMASS(MCB) 00038440 1,ISL(NSLDM,4),XMAST(3),XSLAVE(3),R(6),TXM(6) 00038450 COMMON /BAND/ KOPT,NRBAND(7) R0038460 COMMON/SLVE/NSLAVE 00038470 DIMENSION PRNT(6) 00038480 DATA PRNT/2HFX,2HFY,2HFZ,2HMX,2HMY,2HMZ/ 00038490 ZER=0.0 00038500 IF (NBLOCK.GT.0) GO TO 100 00038510 REWIND 8 00038520 READ (8) ID 00038530 IF(NSLAVE.EQ.0) GO TO 100 00038540 REWIND 30 00038550 READ(30)((ISL(I,J),J=1,4),I=1,NSLAVE) 00038560 100 CONTINUE 00038570 NLT=15 00038580 NL=0 00038590 LLL=-LL 00038600 DO 110 I=1,NC 00038610 LLL=LLL+MHI(I)+LL 00038620 LDG(I)=LLL 00038630 110 CONTINUE 00038640 CALL QVSET (ZER,TMASS,MCB) 00038650 CALL QVSET (ZER,B,NWB) 00038660 IF (MCC.EQ.1) GO TO 270 00038670 IF (KST.NE.1)GO TO 210 00038680 120 READ (NLT) N,L,R 00038690 NB=N 00038700 DO 130 I=1,6 00038710 TXM(I)=0.0 00038720 DO 130 J=1,LL 00038730 130 TR(I,J)=0.0 00038740 IF (N.NE.0) GO TO 190 00038750 MCC=1 00038760 GO TO 270 00038770 140 IF (N.NE.NB) GO TO 210 00038780 150 DO 180 I=1,6 00038790 IF (L) 160,160,170 00038800 160 TXM(I)=R(I) 00038810 IF (I.GT.3) GO TO 180 00038820 IF(JROT.EQ.0) GO TO 163 00038830 IF(I.EQ.2) GO TO 166 00038840 IF(I.EQ.3) GO TO 163 00038850 CALL UNPKID(ID,NUMNP,W,X,1,N,1) 00038860 CALL UNPKID(ID,NUMNP,W,Y,1,N,2) 00038870 FN(1)=0.0 00038880 FN(2)=Y 00038890 IF(X.EQ.0) GO TO 161 00038900 THET=DATAN2(Y,X) 00038910 RAD=DSQRT(X**2+Y**2) 00038920 FN(1)=RAD*DCOS(THET) 00038930 FN(2)=RAD*DSIN(THET) 00038940 161 DO 162 J=1,LL 00038950 AC(1)=ACC(J) 00038960 AC(2)=ACC(J+LL) 00038970 TR(1,J)=TR(1,J)+TXM(1)*(FN(1)*AC(1)+FN(2)*AC(2)) 00038980 162 TR(2,J)=TR(2,J)+TXM(1)*(FN(2)*AC(1)-FN(1)*AC(2)) 00038990 GO TO 166 00039000 163 CONTINUE 00039010 JLOC=LL*(I-1) 00039020 DO 165 J=1,LL 00039030 JJ=JLOC+J 00039040 165 TR(I,J)=TR(I,J)+ACC(JJ)*TXM(I)*GRAV 00039050 166 CALL UNPKID (ID,NUMNP,W,WX,1,N,I) 00039060 SCG(I)=SCG(I)+TXM(I)*WX 00039070 IF (I.EQ.1) SCG(4)=SCG(4)+TXM(1) 00039080 GO TO 180 00039090 170 TR(I,L)=R(I) 00039100 180 CONTINUE 00039110 NB=N 00039120 READ (NLT) N,L,R 00039130 IF (N.EQ.0) GO TO 210 00039140 190 IF(L.GT.0) GO TO 140 00039150 IF (R(2).LE.0.0) R(2)=R(1) 00039160 IF (R(3).LE.0.0) R(3)=R(1) 00039170 GO TO 140 00039180 210 CONTINUE 00039190 ISLAVE=.FALSE. 00039200 IF(NSLAVE.EQ.0)GO TO 1310 00039210 DO 1300 I=1,6 00039220 IF(ISLAVE) GO TO 1195 00039230 DO 1100 J=1,NSLAVE 00039240 IF(NB.EQ.ISL(J,1)) ISLAVE=.TRUE. 00039250 IF(ISLAVE) GO TO 1190 00039260 1100 CONTINUE 00039270 1190 ISLV=J 00039280 1195 CONTINUE 00039290 IF(.NOT.ISLAVE) GO TO 1230 00039300 K=I 00039310 IF(K.GT.3) K=K-3 00039320 ISLN=ISL(ISLV,K+1) 00039330 IF(I.LE.3) ISLN=MOD(ISLN,10000) 00039340 IF(I.GT.3) ISLN=ISLN/10000 00039350 IF(ISLN.EQ.0) GO TO 1230 00039360 DO 1200 J=1,3 00039370 CALL UNPKID(ID,NUMNP,W,XSLAVE(J),1,NB,J) 00039380 CALL UNPKID(ID,NUMNP,W,XMAST(J),1,ISLN,J) 00039390 1200 CONTINUE 00039400 XDIFF=XSLAVE(1)-XMAST(1) 00039410 YDIFF=XSLAVE(2)-XMAST(2) 00039420 ZDIFF=XSLAVE(3)-XMAST(3) 00039430 DO 1220 J=1,LL 00039440 IF(I.EQ.4) TR(4,J)=TR(4,J)-TR(2,J)*ZDIFF+TR(3,J)*ZDIFF 00039450 IF(I.EQ.5) TR(5,J)=TR(5,J)+TR(1,J)*ZDIFF-TR(3,J)*XDIFF 00039460 IF(I.EQ.6) TR(6,J)=TR(6,J)-TR(1,J)*YDIFF+TR(2,J)*XDIFF 00039470 IF(I.EQ.4) TXM(4)=TXM(2)*ZDIFF*ZDIFF+TXM(3)*YDIFF*YDIFF 00039480 IF(I.EQ.5) TXM(5)=TXM(1)*ZDIFF*ZDIFF+TXM(3)*XDIFF*XDIFF 00039490 IF(I.EQ.6) TXM(6)=TXM(1)*YDIFF*YDIFF+TXM(2)*XDIFF*XDIFF 00039500 1220 CONTINUE 00039510 1230 CONTINUE 00039520 1300 CONTINUE 00039530 1310 CONTINUE 00039540 DO 260 I=1,6 00039550 CALL UNPKID (ID,NUMNP,W,WX,2,NB,I) 00039560 JJ=W-KND 00039570 IF (JJ) 220,220,270 00039580 220 II=JJ+NC 00039590 IF (II.LE.0) GO TO 240 00039600 JLOC=(II-1)*LL 00039610 DO 230 J=1,LL 00039620 JLOC=JLOC+1 00039630 B(JLOC)=TR(I,J)+B(JLOC) 00039640 230 TR(I,J)=0.0 00039650 TMASS(II)=TMASS(II)+TXM(I) 00039660 IF(NDYN.EQ.8) B(JLOC)=B(JLOC)+TXM(I) 00039670 TXM(I)=0.0 00039680 240 IF (W.NE.0.0) GO TO 260 00039690 TXM(I)=0.0 00039700 DO 250 KJ=1,LL 00039710 IF(ISLAVE) GO TO 1350 00039720 GO TO 1360 00039730 1350 CONTINUE 00039740 ISLN=ISL(ISLV,K+1) 00039750 IF(I.LE.3) ISLN=MOD(ISLN,10000) 00039760 IF(I.GT.3) ISLN=ISLN/10000 00039770 IF(ISLN.EQ.0) GO TO 1360 00039780 IF(TR(I,KJ).NE.0.0) WRITE(6,300) ISLN,PRNT(I),PRNT(I) 00039790 GO TO 250 00039800 1360 CONTINUE 00039810 IF(TR(I,KJ).NE.0.0) WRITE(6,300) NB,PRNT(I),PRNT(I) 00039820 250 TR(I,KJ)=0.0 00039830 260 CONTINUE 00039840 IF(N.EQ.0) MCC=1 00039850 IF (N.EQ.0) GO TO 270 00039860 GO TO 150 00039870 270 WRITE (3) NC,KLEQ,KFT,LDG,MHI,B 00039880 280 FORMAT (2I5,7F10.3) 00039890 290 FORMAT (23H1.....NODAL POINT LOADS//10H NODE LOAD,23X, 00039900 114HAPPLIED LOADS,/, 00039910 110H NO. CASE,6X,2HRX,8X,2HRY,8X,2HRZ,8X,2HMX,8X,2HMY,8X,2HMZ) 00039920 IF(KOPT.GT.0.AND.NBLOCK.EQ.0) WRITE(6,310) 00039930 300 FORMAT(25H WARNING* NO EQN FOR NODE,I5,2X,2H- ,A2,2H. ,A2,1X, 00039940 $17H WAS SET TO ZERO./) 00039950 310 FORMAT(10X,63HANY NODE NUMBER PRINTED WITH A WARNING IS A RENUMBER00039960 $ED NODE NO. ) 00039970 RETURN 00039980 END 00039990 SUBROUTINE UNPKID(ID,NUMNP,X,COORD,MODE,N,IDOF) 00317660 IMPLICIT REAL*8 (A-H ,O-Z) 00317670 REAL*8 ID 00317680 DIMENSION ID(NUMNP,3) 00317690 COMMON /PREP/XMX,XAD,J1(2),I1,RRPREP(7) R0317700 GO TO (100,110),MODE 00317710 100 X=ID(N,IDOF) 00317720 K=X 00317730 IF(X.LT.0.0) K=K-1 00317740 COORD=(X-K-XAD)*XMX 00317750 RETURN 00317760 110 JJ=IDOF 00317770 IF(IDOF.GE.4) GO TO 120 00317780 NNN=ID(N,JJ) 00317790 IF(NNN.LT.0) GO TO 115 00317800 NNN= MOD(NNN,I1) 00317810 GO TO 117 00317820 115 CONTINUE 00317830 IF(IABS(NNN).GT.I1) GO TO 116 00317840 NNN=MOD(NNN,I1) 00317850 IF(NNN.LT.0) NNN=0 00317860 GO TO 117 00317870 116 NNN=1-NNN 00317880 NNN=MOD(NNN,I1) 00317890 GO TO 117 00317900 117 X=NNN 00317910 RETURN 00317920 120 JJ=JJ-3 00317930 NNN=ID(N,JJ) 00317940 00317950 IF(NNN.GE.0) GO TO 130 00317960 IF(IABS(NNN).LT.I1) GO TO 130 00317970 NN2=NNN/I1 00317980 NNN=-NN2 00317990 GO TO 140 00318000 130 CONTINUE 00318010 NN2=MOD(NNN,I1) 00318020 NNN=NNN/I1 00318030 IF(NNN.GT.0) NNN=NNN+NN2 00318040 IF(NN2.LT.0) NNN=1-NN2 00318050 140 CONTINUE 00318060 X=NNN 00318070 RETURN 00318080 END 00318090 SUBROUTINE SQEEZE(A,NUM,NT,KOD) 00254540 IMPLICIT REAL*8(A-H,O-Z) 00254550 REAL*8 A 00254560 DIMENSION A(NUM) R0254570 IF(KOD.GT.0) GO TO 100 00254580 CALL SQISH(A,NUM,N) 00254590 CALL RDWRT(NT,A,N,1,K) 00254600 RETURN 00254610 100 CALL RDWRT(NT,A,NUM,1,K) 00254620 RETURN 00254630 END 00254640 SUBROUTINE SQISH(A,I,J) 00254650 IMPLICIT REAL*8(A-H,O-Z) R0254651 REAL*8 A 00254652 DIMENSION A(NUM) R0254653 J=I 00254670 RETURN 00254680 END 00254690 SUBROUTINE CNDNS ( BB,B,DIAG,JF,JFACTS,J00041910 1DIAG,JHIGH,RDELT,NLC,NBLKS,NEQ,MTB,MCB,MAXVT,MLT,NRESLT,NSTIF,N1,N00041920 22,KFN,KSUM,JSUM,NEQB,NBLK2,DISP,BLDIS,GDISP,XD,NUMNP,XM 00041930 $) 00041940 IMPLICIT REAL*8(A-H,O-Z) 00041950 REAL*8 KF,KFACTS,KDIAG,KHIGH,JF,JFACTS,JDIAG,JHIGH 00041960 DIMENSION BB(JSUM), B(ML00041970 1T), DIAG(1), JDIAG(1), JHIGH(1), RDELT(1), DISP(NEQ), BLDIS(NEQB,N00041980 2LC), XM(1) 00041990 DIMENSION JFACTS(4), JF(KFN) R0042000 DIMENSION GDISP(10,NLC) 00042010 DIMENSION XD(NUMNP,3) 00042020 COMMON /CG/SCG(6) 00042030 COMMON/MASS/LMASS 00042040 COMMON /SQZ/ ISQZ,NRSQZ(5) R0042050 COMMON /SUPEL/NSELEM,LEQN,NRSUPE(4) R0042060 COMMON /PREP/ADUM(2),KSKIP,NDYN,NRPREP(15) R0042070 COMMON /AAA1/ A(8000) R0042071 COMMON /AAA2/ KFACTS(4),KDIAG(300),KHIGH(300) R0042072 WRITE (6,1001) NRESLT,NSTIF,N1,N2 1001 FORMAT (5X,'*** NRESLT NSTIF N1 N2 ***',4I5/) ZER=0.0D0 00042080 REWIND NRESLT 00042090 N18=18 00042100 IF(LMASS.EQ.-1) CALL RDWRT(N18,A,1,6,INUM) 00042110 CALL RDWRT (NSTIF,A,1,6,INUM) 00042120 REWIND N1 00042130 REWIND N2 00042140 REWIND 8 00042150 READ (8) XD 00042160 DO 1 I=1,NEQ 00042170 1 DIAG(I)=0.0 00042180 DO 2 I=1,6 00042190 2 SCG(I)=0.0 00042200 DO 4 I=1,NUMNP 00042210 DO 3 J=1,6 00042220 CALL UNPKID(XD,NUMNP,W,WX,2,I,J) 00042230 NN=W 00042240 IF(NN.EQ.0) GO TO 3 00042250 DIAG(NN)=J 00042260 3 CONTINUE 00042270 4 CONTINUE 00042280 REWIND 8 00042290 KD=LEQN+1 00042300 WRITE (8) (DIAG(I),I=KD,NEQ) 00042310 DO 6 N=1,NBLKS 00042320 CC CALL EXPAND(AA,KSUM,NSTIF) R0042330 READ (4) KFACTS,(KDIAG(IR),IR=1,MCB),(KHIGH(IR),IR=1,MCB) R0042331 READ (4) (A(IR),IR=1,MLT) R0042332 KSTART=KFACTS(3) 00042340 KEND =KFACTS(4) 00042350 DO 5 I=KSTART,KEND 00042360 KCOL=I-KSTART+1 00042370 KD=KDIAG(KCOL)+NLC 00042380 LC=DIAG(I) 00042390 5 SCG(LC)=SCG(LC)+A(KD) 00042400 6 CONTINUE 00042410 CALL RDWRT(NSTIF,A,1,6,INUM) 00042420 CALL FILES(5) 00042430 X=NBLKS 00042440 KINC=NBLKS*20/100 00042450 IF (KINC.LT.1) KINC=1 00042460 KFIRST=1 00042470 IF(LEQN.GT.1.OR.LEQN.LT.NEQ) GO TO 20 00042480 KSKIP=1 00042490 WRITE(6,10) 00042500 10 FORMAT(/20X,49HTHE LAST EQUATION NO. TO BE REDUCED IS OUTSIDE OF, 00042510 $52H ALLOWABLE RANGE (2 TO NEQ),EXECUTION IS TERMINATED.//) 00042520 RETURN 00042530 20 LEQP=LEQN+2 00042540 NLCM=NLC-1 00042550 DO 320 N=1,NBLKS 00042560 CC CALL EXPAND (AA,KSUM,NSTIF) R0042570 READ (4) KFACTS,(KDIAG(IR),IR=1,MCB),(KHIGH(IR),IR=1,MCB) R0042571 READ (4) (A(IR),IR=1,MLT) R0042572 KSTART=KFACTS(3) 00042580 KEND=KFACTS(4) 00042590 JFIRST=KFIRST 00042600 DO 280 NBOPR=JFIRST,N 00042610 IF (N.EQ.1) GO TO 110 00042620 READ (N1) JF,B 00042630 IF (NBOPR.NE.N) GO TO 130 00042640 110 DO 120 I=1,4 00042650 120 JFACTS(I)=KFACTS(I) 00042660 130 IF (KFACTS(2).GT.JFACTS(4)) GO TO 260 00042670 JFCT3=JFACTS(3) 00042680 JFCT4=JFACTS(4) 00042690 LSUB=KSTART-1 00042700 KSUB=KSTART-LEQP 00042710 IF(KSTART.GT.LEQN) LSUB=LEQN 00042720 IF(KSUB.LT.0) KSUB=0 00042730 DO 250 NCOL=KSTART,KEND 00042740 IF(NCOL.LE.LEQN) LSUB=LSUB+1 00042750 IF(NCOL.GE.LEQP) KSUB=KSUB+1 00042760 KCOL=NCOL-KSTART+1 00042770 DO 140 LC=1,NLC 00042780 140 RDELT(LC)=0.0 00042790 KHI=KHIGH(KCOL) 00042800 KD=KDIAG(KCOL) 00042810 LTERM=KD-NCOL+LSUB 00042820 NSTART=NCOL-KHI+1 00042830 IF (NSTART.GT.JFCT4) GO TO 250 00042840 JSTART=MAX0(JFCT3,NSTART) 00042850 JEND=MIN0(JFCT4,NCOL-1) 00042860 IF (JSTART.GT.JEND.OR.KHI.EQ.1) GO TO 190 00042870 MCHNG=KD-NCOL+JSTART 00042880 DO 180 NOPER=JSTART,JEND 00042890 DELT=0.0 00042900 MEND=MCHNG-1 00042910 JOPER=NOPER-JFACTS(3)+1 00042920 JD=JDIAG(JOPER) 00042930 JHJ=JHIGH(JOPER) 00042940 NTERMS=MIN0(JHJ-1,NOPER-NSTART) 00042950 IF (NBOPR.NE.N) GO TO 150 00042960 JD=KDIAG(JOPER) 00042970 KHJ=KHIGH(JOPER) 00042980 NTERMS=MIN0(KHJ-1,NOPER-NSTART) 00042990 150 J=JD-MCHNG 00043000 IF (NTERMS.EQ.0) GO TO 160 00043010 MCOL=MCHNG-NTERMS 00043020 IF(MEND.GT.LTERM) MEND=LTERM 00043030 IF(MCOL.GT.MEND) GO TO 160 00043040 NSM=NOPER-NTERMS-MCOL 00043050 DO 155 K=MCOL,MEND 00043060 155 DELT=DELT+A(K)*A(J+K)*DIAG(K+NSM) 00043070 A(MCHNG)=A(MCHNG)-DELT 00043080 160 CONTINUE 00043090 IF(MCHNG.GT.LTERM) GO TO 180 00043100 RMULT=A(MCHNG)*DIAG(NOPER) 00043110 RMASS=RMULT**2 00043120 IF(A(KD+NLC).EQ.0.0) RMASS=0.0E0 00043130 IF(NLCM.LE.0) GO TO 175 00043140 DO 170 LC=1,NLCM 00043150 170 RDELT( LC)=RDELT( LC)+A(JD+ LC)*RMULT 00043160 175 RDELT(NLC)=RDELT(NLC)-A(JD+NLC)*RMASS 00043170 180 MCHNG=MCHNG+1 00043180 190 IF (NBOPR.EQ.N) GO TO 210 00043190 IF (KHI.EQ.1) GO TO 250 00043200 DO 200 LC=1,NLC 00043210 IF(LC.EQ.NLC.AND.LMASS.EQ.-1) GO TO 1200 00043220 200 A(KD+LC)=A(KD+LC)-RDELT(LC) 00043230 GO TO 250 00043240 1200 XM(NCOL)=A(KD+NLC) 00043250 GO TO 250 00043260 210 DELT=0.0 00043270 IF (KHI.EQ.1) GO TO 230 00043280 II=KD-KHI+1 00043290 III=KD-KSUB-1 00043300 IF(II.GT.III) GO TO 230 00043310 NSM=NSTART-II 00043320 DO 220 I=II,III 00043330 220 DELT=DELT+(A(I)**2)*DIAG(NSM+I) 00043340 A(KD)=A(KD)-DELT 00043350 230 IF(A(KD).EQ.0.0E0) A(KD)=1.0E-7 00043360 DIAG(NCOL)=1.00/A(KD) 00043370 DO 240 LC=1,NLC 00043380 IF(LC.EQ.NLC.AND.LMASS.EQ.-1) GO TO 1240 00043390 240 A(KD+LC)=(A(KD+LC)-RDELT(LC)) 00043400 GO TO 250 00043410 1240 XM(NCOL)=A(KD+NLC) 00043420 250 CONTINUE 00043430 260 IF (JFACTS(4)+JFACTS(1).LE.KFACTS(4)) GO TO 270 00043440 IF (N.EQ.NBLKS.OR.N.EQ.NBOPR) GO TO 280 00043450 WRITE (N2) JF,B 00043460 GO TO 280 00043470 270 KFIRST=KFIRST+1 00043480 280 CONTINUE 00043490 IF(N.EQ.NBLKS) GO TO 301 00043500 IF(LMASS.EQ.-1) WRITE (N18) KFACTS,(KDIAG(IR),IR=1,MCB), R0043510 $ (KHIGH(IR),IR=1,MCB),(A(IR),IR=1,MLT) R0043511 IF(KEND.GT.LEQN) WRITE (NRESLT) KFACTS,(KDIAG(IR),IR=1,MCB), R0043520 $ (KHIGH(IR),IR=1,MCB),(A(IR),IR=1,MLT) R0043521 DO 290 I=1,MCB 00043530 290 KDIAG(I)=KDIAG(I)+MTB 00043540 WRITE (N2) KFACTS,(KDIAG(IR),IR=1,MCB),(KHIGH(IR),IR=1,MCB), R0043550 $ (A(IR),IR=1,MLT) R0043551 WRITE (N2) JF,B 00043560 MOPER=N1 00043570 N1=N2 00043580 N2=MOPER 00043590 300 REWIND N1 00043600 REWIND N2 00043610 301 PER=N*100.0/X 00043620 KPR=MOD(N,KINC) 00043630 IF (KPR.EQ.0) WRITE(6,310) PER 00043640 310 FORMAT (20X,F7.2,39H PERCENT OF THE FWD. REDUCTION HAS BEEN, 00043650 110HCOMPLETED.///) 00043660 320 CONTINUE 00043670 WRITE(6,321) 00043680 321 FORMAT(//20X,39HSTATIC CONDENSATION HAS BEEN COMPLETED.//) 00043690 WRITE (NRESLT) KFACTS,(KDIAG(IR),IR=1,MCB),(KHIGH(IR),IR=1,MCB), R0043700 $ (A(IR),IR=1,MLT) R0043701 IF(LMASS.NE.-1) GO TO 450 00043710 NT1=N2 00043720 REWIND NT1 00043730 REWIND N1 00043740 MLDB=0 00043750 NRIT=0 00043760 NFLC=LEQN+1 00043770 LLC=LEQN+MAXVT 00043780 MTT=MAXVT*NEQ 00043790 CALL RDWRT(NSTIF,A,1,6,INUM) 00043800 IF(NBLKS.GT.1) CALL RDWRT(N18,A,1,2,INUM) 00043810 IF(NBLKS.GT.1) CALL RDWRT(N18,A,1,2,INUM) R0043811 330 CALL QVSET(ZER,B,MTT) 00043820 DO 380 N=1,NBLKS 00043830 NCB=KFACTS(4)-KFACTS(3)+1 00043840 DO 360 NC=1,NCB 00043850 NCOL=KFACTS(4)-NC+1 00043860 KCOL=NCB-NC+1 00043870 KHI=KHIGH(KCOL)-1 00043880 KD=KDIAG(KCOL) 00043890 LX=0 00043900 DO 340 LC=NFLC,LLC 00043910 NX=LX*NEQ+NCOL 00043920 IF(NCOL.GT.LEQN.AND.LC.EQ.NCOL) GO TO 335 00043930 B(NX)=-B(NX)/A(KD) 00043940 GO TO 340 00043950 335 B(NX)=1.0E0-B(NX) 00043960 340 LX=LX+1 00043970 IF(KHI.EQ.0) GO TO 360 00043980 LX=0 00043990 KJ=KD-KHI-1 00044000 DO 350 LC=NFLC,LLC 00044010 LX=LX+1 00044020 KJ=KD-KHI-1 00044030 MEND=NCOL+(LX-1)*NEQ 00044040 RMULT=-B(MEND) 00044050 MCOL=MEND-KHI 00044060 IF(NCOL.LE.LEQN) GO TO 345 00044070 MEND=MEND-NCOL+LEQN+1 00044080 IF(MCOL.GT.MEND) GO TO 350 00044090 345 CONTINUE 00044100 CALL QMR2(B(MCOL),B(MCOL),RMULT,A(KJ+1),MEND-MCOL,1,1,1) 00044110 350 CONTINUE 00044120 360 CONTINUE 00044130 IF(LLC.EQ.NEQ.OR.NRIT.EQ.1) GO TO 370 00044140 CC CALL SQEEZE(AA,KSUM,NSTIF,ISQZ) 00044150 WRITE (4) KFACTS,(KDIAG(IR),IR=1,MCB),(KHIGH(IR),IR=1,MCB) R0044151 WRITE (4) (A(IR),IR=1,MLT) R0044152 370 CONTINUE 00044160 NDCNDS=NEQ-LEQN 00044170 NWCNDS=(NEQ-LEQN)*(NEQ-LEQN+1)/2 00044180 IF((NFLC-LEQN).NE.1) GO TO 1330 00044190 CALL QVSET(ZER,A,NWCNDS) 00044200 1330 CONTINUE 00044210 IF((NFLC-LEQN).EQ.1) GO TO 1390 00044220 REWIND N1 00044230 JLOCI=NFLC-LEQN-1 00044240 READ(N1)(A(I),I=1,NWCNDS) 00044250 REWIND NT1 00044260 DO 1360 I=1,JLOCI 00044270 READ(NT1)(DIAG(J),J=1,NEQ) 00044280 KL=0 00044290 ND=0 00044300 JJ=(I-1)*NDCNDS+I-(I*I-I)/2+JLOCI-I+1 00044310 DO 1350 J=NFLC,LLC 00044320 NS=ND+1 00044330 ND=NS+NEQ-1 00044340 DO 1340 II=1,NEQ 00044350 NX=NS+II-1 00044360 1340 A(JJ)=A(JJ)+DIAG(II)*XM(II)*B(NX) 00044370 JJ=JJ+1 00044380 1350 CONTINUE 00044390 1360 CONTINUE 00044400 1390 CONTINUE 00044410 NDD=0 00044420 DO 1420 I=NFLC,LLC 00044430 NSS=NDD+1 00044440 NDD=NSS+NEQ-1 00044450 NS=NSS 00044460 ND=NDD 00044470 NN=I-LEQN 00044480 JJ=(NN-1)*NDCNDS+NN-(NN*NN-NN)/2-1 00044490 DO 1410 J=I,LLC 00044500 JJ=JJ+1 00044510 DO 1400 II=1,LEQN 00044520 NX=NS+II-1 00044530 NXX=NSS+II-1 00044540 1400 A(JJ)=A(JJ)+B(NXX)*XM(II)*B(NX) 00044550 NS=ND+1 00044560 ND=NS+NEQ-1 00044570 1410 CONTINUE 00044580 1420 CONTINUE 00044590 REWIND N1 00044600 WRITE(N1)(A(I),I=1,NWCNDS) 00044610 IF(N.EQ.NBLKS) GO TO 380 00044620 CC CALL EXPAND(AA,KSUM,N18) R0044630 READ (N18) KFACTS,(KDIAG(IR),IR=1,MCB),(KHIGH(IR),IR=1,MCB) R0044631 READ (N18) (A(IR),IR=1,MLT) R0044632 IF(MLDB.EQ.1) GO TO 380 00044640 IF(N+1.GE.NBLKS) GO TO 380 00044650 CALL RDWRT(N18,A,1,2,INUM) 00044660 CALL RDWRT(N18,A,1,2,INUM) 00044670 CALL RDWRT(N18,A,1,2,INUM) R0044671 CALL RDWRT(N18,A,1,2,INUM) R0044672 380 CONTINUE 00044680 ND=0 00044690 DO 390 I=NFLC,LLC 00044700 NS=ND+1 00044710 ND=NS+NEQ-1 00044720 390 WRITE(NT1) (B(NX),NX=NS,ND) 00044730 IF(LLC.EQ.NEQ) GO TO 400 00044740 NRIT=1 00044750 MLDB=1 00044760 NFLC=NFLC+MAXVT 00044770 LLC=MIN0(LLC+MAXVT,NEQ) 00044780 CALL RDWRT(NSTIF,A,1,6,INUM) 00044790 CC CALL EXPAND(AA,KSUM,NSTIF) R0044800 READ (4) KFACTS,(KDIAG(IR),IR=1,MCB),(KHIGH(IR),IR=1,MCB) R0044801 READ (4) (A(IR),IR=1,MLT) R0044802 N18=NSTIF 00044810 GO TO 330 00044820 400 CONTINUE 00044830 REWIND N1 00044840 READ(N1)(A(I),I=1,NWCNDS) 00044850 DO 405 I=1,NDCNDS 00044860 II=(I-1)*NDCNDS+I-(I*I-I)/2-1 00044870 JJ=II+1 00044880 A(JJ)=A(JJ)+XM(I+LEQN) 00044890 405 CONTINUE 00044900 REWIND N1 00044910 WRITE(N1)(A(I),I=1,NWCNDS) 00044920 450 CONTINUE 00044930 NBLKS=NBLKS-KFIRST+1 00044940 REWIND NRESLT 00044950 REWIND N1 00044960 N2=NRESLT 00044970 CALL FORMSE( KFACTS,KDIAG,KHIGH,A,B,NBLKS,N2,LEQN,NEQ,KFN,MCB, R0044980 $MLT,NLC,N1) 00044990 RETURN 00045000 END 00045010 SUBROUTINE EXPAND(A,NUM,NT) 00086360 IMPLICIT REAL*8(A-H,O-Z) 00086370 REAL*8 A 00086380 DIMENSION A(1) 00086390 CALL RDWRT(NT,A,NUM,0,J) 00086400 IF(J.EQ.NUM) RETURN 00086410 RETURN 00086420 END 00086430 SUBROUTINE QMR2(C,D,FAC,B,N,JC,KC,JB) 00186840 IMPLICIT REAL*8(A-H,O-Z) 00186850 DIMENSION B(1),C(1),D(1) 00186860 IB=1 00186870 IC=1 00186880 DO 100 I=1,N 00186890 C(IC)=D(IC)-FAC*B(IB) 00186900 IB=IB+JB 00186910 100 IC=IC+JC 00186920 RETURN 00186930 END 00186940 SUBROUTINE QMR22 ( FAC, N,JC,KC,JB) R0186840 IMPLICIT REAL*8(A-H,O-Z) 00186850 COMMON /AAA1/ A(150,53) R0186851 COMMON /AAA3/ TMASS(200,1),B(200,6) R0186852 CC DIMENSION C(1),D(1) R0186860 IB = 1 R0186870 IC=1 00186880 DO 100 I=1,N 00186890 A(IC,1)=A(IC,1)-FAC*B(IB,1) R0186900 IB=IB+JB 00186910 100 IC=IC+JC 00186920 RETURN 00186930 END 00186940 SUBROUTINE FORMSE( KFACTS,KDIAG,KHIGH,A,B,NBLKS,N2,LEQN,NEQ, R0088360 $KFN,MCB,MLT,LL,N1) 00088370 IMPLICIT REAL*8(A-H,O-Z) 00088380 LOGICAL ELPRT,ELPCH,GENPRT,GENPCH,DEFPCH,GEOST 00088390 REAL*8 KFACTS(4),KDIAG(MCB),KHIGH(MCB),A(MLT),B(1) R0088400 COMMON /CG/SCG(6) 00088410 COMMON/CTL/ELPRT,ELPCH,GENPRT,GENPCH 00088420 COMMON /JUNK/ NROW,ND,N,KS,KE,NCOL,LOCB,KD,NS,NSM ,KCOL,NC,K,JLOCI00088430 $,KLF(7),MATNO,KET,KK,NDF,NEL,NRJUNK(428) R0088440 COMMON/MASS/LMASS 00088450 DIMENSION ICOL(10),IFORM(4) 00088460 DATA ICOL/ 3H001,3H013,3H025,3H037,3H049,3H061,3H073,3H085,3H097,00088470 $3H109/ 00088480 DATA IFORM(1),IFORM(3),IFORM(4)/4H(1H+,4HX,I7,4H) / 00088490 LEQN=LEQN+1 00088500 NROW=0 00088510 ND=NEQ-LEQN+1 00088520 NT20=20 00088530 NT27=27 00088540 REWIND NT20 00088550 N=1 00088560 CCCCC CCC 00088570 10 READ (NT20,END=30) MATNO,NDF,KET,KK 00088580 CCCCC 00088590 CCCCC CCC 00088600 CCCCC 00088610 15 N=N+1 00088620 WRITE (NT27) MATNO,NDF,KET,KK 00088630 KE=KET*3 00088640 IF(KET.EQ.0) KE=3 00088650 READ (NT20) KLF,(A(I),I=1,KE) 00088660 WRITE (NT27) KLF,(A(I),I=1,KE) 00088670 KE=(NDF*NDF-NDF)/2+NDF 00088680 READ (NT20) (A(I),I=1,KE) 00088690 WRITE (NT27) (A(I),I=1,KE) 00088700 DO 20 K=1,KK 00088710 READ (NT20) (A(I),I=1,NDF) 00088720 WRITE (NT27) (A(I),I=1,NDF) 00088730 20 CONTINUE 00088740 IF(LMASS.NE.-1) GO TO 10 00088750 READ(NT20)(A(I),I=1,KE) 00088760 WRITE(NT27)(A(I),I=1,KE) 00088770 GO TO 10 00088780 30 REWIND NT20 00088790 REWIND NT27 00088800 READ (NT27) MATNO,KET,KK 00088810 WRITE (NT20) MATNO,ND ,KET,KK 00088820 MATCHK=MATNO 00088830 KE=KET*3 00088840 IF(KET.EQ.0) KE=3 00088850 READ (NT27) KLF,(A(I),I=1,KE) 00088860 WRITE (NT20) KLF,(A(I),I=1,KE) 00088870 NEL=N 00088880 JLOCI=(ND*ND-ND)/2+ND 00088890 IF(.NOT.ELPRT) GO TO 1010 00088900 WRITE(6,190)MATNO,ND,KET,KK 00088910 WRITE(6,310)(KLF(I),I=1,7) 00088920 WRITE(6,320)(A(I),I=1,KE) 00088930 IF(ELPCH)WRITE(7,180)MATNO,ND,KET,KK 00088940 IF(ELPCH)WRITE(7,180)(KLF(I),I=1,7) 00088950 IF(ELPCH)WRITE(7,280)(A(I),I=1,KE) 00088960 1010 CONTINUE 00088970 CCCCC CCC 00088980 35 READ(N2,END=120) KFACTS,(KDIAG(IR),IR=1,MCB),(KHIGH(IR),IR=1,MCB),R0088990 $ (A(IR),IR=1,MLT) R0089000 CCCCCC CC 00089010 CCCCC 00089020 40 CONTINUE 00089030 IF(KFACTS(4).LT.LEQN) GO TO 120 00089040 KS=KFACTS(3) 00089050 KE=KFACTS(4) 00089060 DO 110 NCOL=KS,KE 00089070 IF(NCOL.LT.LEQN) GO TO 110 00089080 NROW=NROW+1 00089090 KCOL=NCOL-KS+1 00089100 LOCB=NROW 00089110 KD=KDIAG(KCOL) 00089120 NS=KD-NROW+1 00089130 NSM=NS+ND-1 00089140 K=KD-KHIGH(KCOL)+1 00089150 IF(K.LE.NS) GO TO 85 00089160 K=K-1 00089170 DO 75 NC=NS,K 00089180 B(LOCB)=0.0E+00 00089190 75 LOCB=LOCB+NSM-NC 00089200 NS=K+1 00089210 85 CONTINUE 00089220 DO 100 NC=NS,KD 00089230 B(LOCB)=A(NC) 00089240 100 LOCB=LOCB+NSM-NC 00089250 DO 105 K=1,LL 00089260 LOCB=JLOCI+ND*(K-1)+NROW 00089270 105 B(LOCB)=A(KD+K) 00089280 110 CONTINUE 00089290 GO TO 35 00089300 120 CONTINUE 00089310 IF(NROW.NE.ND) GO TO 140 00089320 WRITE (NT20) (B(I),I=1,JLOCI) 00089330 IF(.NOT.ELPRT) GO TO 1030 00089340 WRITE(6,270) 00089350 IK=0 00089360 DO 1020 I=1,ND 00089370 JJ=ND-I+1 00089380 IF(ELPCH) WRITE(7,280)(B(IK+J),J=1,JJ) 00089390 WRITE(6,290)(B(IK+J),J=1,JJ) 00089400 1020 IK=IK+JJ 00089410 1030 CONTINUE 00089420 REWIND 8 00089430 READ (8) (B(I),I=1,ND) 00089440 DO 121 I=4,6 00089450 121 SCG(I)=0.0 00089460 KS=JLOCI+ND*(LL-1)+1 00089470 KE=KS+ND-1 00089480 K=0 00089490 DO 123 I=KS,KE 00089500 K=K+1 00089510 NC=B(K)+3 00089520 IF(NC.LE.6) GO TO 122 00089530 B(I)=0.0 00089540 GO TO 123 00089550 122 SCG(NC)=SCG(NC)+B(I) 00089560 123 CONTINUE 00089570 DO 124 I=1,3 00089580 IF(SCG(I).NE.0.0) SCG(I)=SCG(I)/SCG(I+3) 00089590 124 CONTINUE 00089600 K=0 00089610 DO 125 I=KS,KE 00089620 K=K+1 00089630 NC=B(K) 00089640 IF(NC.GT.3) GO TO 125 00089650 B(I)=B(I)*SCG(NC) 00089660 125 CONTINUE 00089670 DO 130 K=1,LL 00089680 KS=JLOCI+ND*(K-1)+1 00089690 KE=KS+ND-1 00089700 IF(.NOT.ELPRT) GO TO 130 00089710 WRITE(6,300)K 00089720 WRITE(6,290)(B(I),I=KS,KE) 00089730 IF(ELPCH)WRITE(7,280)(B(I),I=KS,KE) 00089740 130 WRITE(NT20)(B(I),I=KS,KE) 00089750 IF(LMASS.NE.-1) GO TO 1130 00089760 READ(N1)(A(I),I=1,JLOCI) 00089770 WRITE(NT20)(A(I),I=1,JLOCI) 00089780 IF(.NOT.ELPRT) GO TO 1120 00089790 WRITE(6,230) 00089800 IK=0 00089810 DO 1110 I=1,ND 00089820 JJ=ND-I+1 00089830 IF(ELPCH) WRITE(7,280)(A(IK+J),J=1,JJ) 00089840 WRITE(6,290)(A(IK+J),J=1,JJ) 00089850 1110 IK=IK+JJ 00089860 1120 CONTINUE 00089870 IF(LMASS.EQ.-1) WRITE(6,170) 00089880 1130 CONTINUE 00089890 WRITE(6,131)NEL 00089900 131 FORMAT(1H ,20X,13HTHE FOLLOWING,I3,24H MATRICES ARE ON TAPE20.//) 00089910 IC=2 00089920 IFORM(2)=ICOL(1) 00089930 WRITE(6,9909) MATNO R0089940 9909 FORMAT (5X,I7) R0089941 IF(NEL.LE.1) GO TO 161 00089950 DO 160 N=2,NEL 00089960 READ (NT27) MATNO,NDF,KET,KK 00089970 WRITE (NT20) MATNO,NDF,KET,KK 00089980 IF(MATNO.EQ.MATCHK) MATCHK=-MATCHK 00089990 IFORM(2)=ICOL(IC) 00090000 WRITE(6,IFORM) MATNO 00090010 IC=IC+1 00090020 IF(IC.LT.11) GO TO 135 00090030 WRITE(6,132) 00090040 132 FORMAT(1H ) 00090050 IC=1 00090060 135 CONTINUE 00090070 KE=KET*3 00090080 IF(KET.EQ.0) KE=3 00090090 READ (NT27) KLF,(A(I),I=1,KE) 00090100 WRITE (NT20) KLF,(A(I),I=1,KE) 00090110 KE=(NDF*NDF-NDF)/2+NDF 00090120 READ (NT27) (A(I),I=1,KE) 00090130 WRITE (NT20) (A(I),I=1,KE) 00090140 DO 155 K=1,KK 00090150 READ (NT27) (A(I),I=1,NDF) 00090160 WRITE (NT20) (A(I),I=1,NDF) 00090170 155 CONTINUE 00090180 IF(LMASS.NE.-1) GO TO 160 00090190 READ(NT27)(A(I),I=1,KE) 00090200 WRITE(NT20)(A(I),I=1,KE) 00090210 160 CONTINUE 00090220 161 REWIND NT27 00090230 MATNO=-1 00090240 WRITE (NT27) MATNO,ND,ND,ND 00090250 IF(MATCHK.GT.0) RETURN 00090260 MATCHK=-MATCHK 00090270 WRITE(6,165)MATCHK 00090280 165 FORMAT(/10X,30HWARNING--A DUPLICATE OF MATRIX,I4, 00090290 120H WAS FOUND ON TAPE20, 00090300 $46H, ONLY THE FIRST ONE ON THE TAPE WILL BE USED.///) 00090310 RETURN 00090320 140 CONTINUE 00090330 KSKIP=1 00090340 WRITE(6,150) 00090350 150 FORMAT(///20X,35HTHE MATRIX WAS NOT FORMED CORRECTLY//) 00090360 170 FORMAT(1H ,///20X,41HNOTE: THE CONDENSED MASS MATRIX IS A FULL,1X,00090370 125HMATRIX. HENCE SUBSEQUENT,/,26X,28HANALYSIS NUST HAVE NDYN=4,5,00090380 2,28H OR 6 AND MUST HAVE LMASS=1,///) 00090390 180 FORMAT(16I5) 00090400 190 FORMAT(1H1,5X,7HMATNO =,I5,5X,4HND =,I5,5X,5HKET =,I5, 00090410 15X,4HKK =,I5) 00090420 230 FORMAT(/1X,41HELEMENT MASS MATRIX - LOWER TRIANGLE ONLY,2X, 00090430 118H(FULL MASS MATRIX)) 00090440 270 FORMAT(/1X,30HSUPER ELEMENT STIFFNESS MATRIX, 00090450 11X,21H- LOWER TRIANGLE ONLY) 00090460 280 FORMAT((1P8E10.3)) 00090470 290 FORMAT((1H ,1P10E13.4)) 00090480 300 FORMAT(/5X,11HLOAD CASE =,I5) 00090490 310 FORMAT(/5X,2X,33HKCF KR KAX KAY KAX KM KBE,/, 00090500 1 5X,7I5) 00090510 320 FORMAT(/5X,33HTERMS ASSOCIATED WITH TEMPERATURE/(5X,10E12.5)) 00090520 RETURN 00090530 END 00090540