Liren Large Software Subsidy 9

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

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

Wrap

Text File | 1980-01-04 | 76.1 KB | 959 lines

SUBROUTINE SLOWR ( BB,B,DIAG,JF,JFACTS,JR0242720 1DIAG,JHIGH,RDELT,NLC,NBLKS,NEQ,MTB,MCB,MAXVT,MLT,NRESLT,NSTIF,N1,N00242730 22,KFN,KSUM,JSUM,NEQB,NBLK2,DISP,BLDIS,GDISP) 00242740 IMPLICIT REAL*8(A-H,O-Z) 00242750 REAL*8 KF,KFACTS,KDIAG,KHIGH,JF,JFACTS,JDIAG,JHIGH,JFACTR R0242760 DIMENSION BB(JSUM), B(ML00242770 1T), DIAG(1), JDIAG(1), JHIGH(1), RDELT(1), DISP(NEQ), BLDIS(NEQB,N00242780 2LC) 00242790 DIMENSION FOLD(4), JFACTS(4), JF(KFN),JFACTR(4) R0242800 DIMENSION GDISP(10,NLC) 00242810 COMMON/EQUILB/NEQIL,ITX2 00242820 COMMON /GPS/ NEQ4(10),NRGPS(10) R0242830 COMMON /SUPEL/NSELEM,NEQL,NRSUPE(4) R0242840 COMMON /PREP / XQ(2),KSKIP,RRPREP(8) R0242850 COMMON /SQZ/ ISQZ,NRSQZ(5),NRC1 R0242860 COMMON /AAA1/ A(8000) R0242861 COMMON /AAA2/ KFACTS(4),KDIAG(300),KHIGH(300) R0242862 NRC2 = 0 NRC3 = 1 CALL FILES(4) 00242870 CALL SECOND(TIM1) 00242880 CALL RDWRT (NRESLT,A,1,6,INUM) 00242890 CALL RDWRT (NSTIF,A,1,6,INUM) 00242900 REWIND N1 00242910 REWIND N2 00242920 NGP=0 00242930 IF(ITX2.LE.0) KSKIP=1 00242940 DO 100 I=1,10 00242950 IF (NEQ4(I).GT.0) NGP=I 00242960 100 CONTINUE 00242970 DIAGCK=1.0D-08 00242980 X=NBLKS 00242990 KINC=NBLKS*20/100 00243000 IF (KINC.LT.1) KINC=1 00243010 ZER=0.0D0 00243020 KFIRST=1 00243030 IF(NEQIL.EQ.1) REWIND 41 00243040 DO 320 N=1,NBLKS 00243050 CC CALL EXPAND (AA,KSUM,NSTIF) 00243060 READ (4) KFACTS,(KDIAG(IR),IR=1,MCB),(KHIGH(IR),IR=1,MCB) R0243061 READ (4) (A(IR),IR=1,MLT) R0243062 IF(NEQIL.EQ.1) WRITE(41)AA 00243070 DO 101 I=1,4 00243071 101 JFACTR(I)=KFACTS(I) 00243072 KSTART = JFACTR(3) R0243080 KEND = JFACTR(4) R0243090 JFIRST=KFIRST 00243100 DO 280 NBOPR=JFIRST,N 00243110 IF (N.EQ.1) GO TO 110 00243120 READ (N1) JF,B R0243131 IF (NBOPR.NE.N) GO TO 130 00243140 110 DO 120 I=1,4 00243150 120 JFACTS(I)=KFACTS(I) 00243160 130 IF (KFACTS(2).GT.JFACTS(4)) GO TO 260 00243170 JFCT3=JFACTS(3) 00243180 JFCT4=JFACTS(4) 00243190 DO 250 NCOL=KSTART,KEND 00243200 KCOL=NCOL-KSTART+1 00243210 DO 140 LC=1,NLC 00243220 140 RDELT(LC)=0.0D0 00243230 RRNC1 = KHIGH(KCOL) R0243240 KHI = RRNC1 R0243241 RRNC2 = KDIAG(KCOL) R0243250 KD = RRNC2 R0243251 NSTART=NCOL-KHI+1 00243260 IF (NSTART.GT.JFCT4) GO TO 250 00243270 JSTART=MAX0(JFCT3,NSTART) 00243280 JEND=MIN0(JFCT4,NCOL-1) 00243290 IF (JSTART.GT.JEND.OR.KHI.EQ.1) GO TO 190 00243300 MCHNG=KD-NCOL+JSTART 00243310 IF(NBOPR.NE.N) GO TO 149 00243320 DO 146 NOPER=JSTART,JEND 00243330 JOPER=NOPER-JFACTS(3)+1 00243340 RRNC3 = KDIAG(JOPER) R0243350 JD = RRNC3 R0243351 RRNC4 = KHIGH(JOPER) R0243360 JHJ = RRNC4 R0243361 NTERMS=MIN0(JHJ-1,NOPER-NSTART) R0243370 IF(NTERMS.EQ.0) GO TO 144 00243380 MNRR = MCHNG - NTERMS R0243381 JNRR = JD - NTERMS R0243382 IF (JNRR .LE. MTB) GO TO 141 R0243384 JN1 = JNRR - MTB R0243383 CALL QVDOT1 (DELT,MNRR, B(JN1) ,NTERMS,1,1) R0243390 GO TO 143 R0243391 141 CONTINUE R0243392 CALL QVDOT(DELT,A(MCHNG-NTERMS),A(JD-NTERMS),NTERMS,1,1) R0243393 143 CONTINUE R0243394 A(MCHNG)=A(MCHNG)-DELT 00243400 144 DO 145 LC=1,NLC 00243410 145 RDELT(LC)=RDELT(LC)+A(JD+LC)*A(MCHNG) 00243420 146 MCHNG=MCHNG+1 00243430 GO TO 210 00243440 149 DO 180 NOPER=JSTART,JEND 00243450 JOPER=NOPER-JFACTS(3)+1 00243460 RRNC5 = JDIAG(JOPER) R0243470 JD = RRNC5 R0243471 RRNC6 = JHIGH(JOPER) R0243480 JHJ = RRNC6 R0243481 NTERMS=MIN0(JHJ-1,NOPER-NSTART) 00243490 MNRR = MCHNG - NTERMS R0243491 JNRR = JD - NTERMS R0243492 JN1 = JNRR - MTB R0243493 IF (NTERMS.EQ.0) GO TO 160 00243500 CALL QVDOT1(DELT,MNRR, B(JN1) ,NTERMS,1,1) R0243510 A(MCHNG)=A(MCHNG)-DELT 00243520 160 CONTINUE 00243530 DO 170 LC=1,NLC 00243540 JLRR = JD + LC R0243541 IF(JLRR .LE. MTB) RDELT(LC)=RDELT(LC)+A(JD+LC)*A(MCHNG) R0243550 IF(JLRR .LE. MTB) GO TO 170 R0243551 JLRR = JLRR - MTB R0243552 RDELT(LC)=RDELT(LC)+B(JLRR)*A(MCHNG) R0243552 170 CONTINUE R0243552 180 MCHNG=MCHNG+1 00243560 190 IF (NBOPR.EQ.N) GO TO 210 00243570 IF (KHI.EQ.1) GO TO 250 00243580 DO 200 LC=1,NLC 00243590 200 A(KD+LC)=A(KD+LC)-RDELT(LC) 00243600 GO TO 250 00243610 210 DELT=0.0D0 00243620 IF (KHI.EQ.1) GO TO 230 00243630 II=KD-KHI+1 00243640 III=KD-1 00243650 NSM=NSTART-II 00243660 DO 220 I=II,III 00243670 RMULT=A(I) 00243680 A(I)=RMULT*DIAG(NSM+I) 00243690 220 DELT=DELT+RMULT*A(I) 00243700 A(KD)=A(KD)-DELT 00243710 230 IF(A(KD).EQ.0.0)A(KD)=1.E-20 00243720 DIAG(NCOL)=1.00D0/A(KD) 00243730 IF(A(KD).LT.DIAGCK) WRITE(6,235)NCOL 00243740 235 FORMAT(/20X,8HEQUATION,I5,17H MAY BE SINGULAR.) 00243750 RMULT=DIAG(NCOL) 00243760 DO 240 LC=1,NLC 00243770 240 A(KD+LC)=(A(KD+LC)-RDELT(LC))*RMULT 00243780 250 CONTINUE 00243790 260 IF (JFACTS(4)+JFACTS(1).LE.KFACTS(4)) GO TO 270 00243800 IF (N.EQ.NBLKS.OR.N.EQ.NBOPR) GO TO 280 00243810 WRITE (N2) JF,B R0243820 GO TO 280 00243830 270 KFIRST=KFIRST+1 00243840 280 CONTINUE 00243850 IF(N.EQ.NBLKS) GO TO 301 00243860 CC CALL RDWRT (NRESLT,AA,KSUM,1,INUM) R0243870 WRITE (23) KFACTS,(KDIAG(IR),IR=1,MCB),(KHIGH(IR),IR=1,MCB) R0243871 WRITE (23) (A(IR),IR=1,MLT) R0243872 NRC2 = NRC2 + 1 R0243873 IF (NRC3 .EQ. 1) WRITE (6,1009) NRESLT,NRC2 R0243874 1009 FORMAT (5X,'****** NRESLT NRC2 ******',2I5/) R0243875 DO 290 I=1,MCB 00243880 290 KDIAG(I)=KDIAG(I)+MTB 00243890 WRITE (N2) KFACTS,(KDIAG(IR),IR=1,MCB),(KHIGH(IR) R0243900 $ ,IR=1,MCB),(A(IR),IR=1,MLT) R0243901 WRITE (N2) JF,B R0243910 MOPER=N1 00243920 N1=N2 00243930 N2=MOPER 00243940 300 REWIND N1 00243950 REWIND N2 00243960 301 PER=N*100.0D0/X 00243970 KPR=MOD(N,KINC) 00243980 IF (KPR.EQ.0) WRITE(6,310) PER 00243990 310 FORMAT (20X,F7.2,39H PERCENT OF THE FWD. REDUCTION HAS BEEN, 00244000 110HCOMPLETED.///) 00244010 320 CONTINUE 00244020 CALL SECOND(TIM2) 00244030 NT1=15 00244040 REWIND NT1 00244050 NRIT=0 00244060 MLDB=0 00244070 NFLC=1 00244080 LLC=MAXVT 00244090 CALL RDWRT (NSTIF,A,1,6,INUM) 00244100 IF(NEQL.LE.0) GO TO 325 00244110 MLDB=1 00244120 NRIT=1 00244130 CC CALL RDWRT(NRESLT,AA,KSUM,1,ISUM) 00244140 WRITE (23) KFACTS,(KDIAG(IR),IR=1,MCB),(KHIGH(IR),IR=1,MCB) R0244141 WRITE (23) (A(IR),IR=1,MLT) R0244142 NDF=NEQ-NEQL 00244150 CALL RDWRT(NRESLT,AA,KSUM,2,INUM) 00244160 CALL SETDIS(NRESLT,NSTIF, KSUM,MCB,MLT, R0244170 1KFN,NEQ,B,NBLKS,NLC,KSKIP,NDF) 00244180 CC CALL EXPAND(AA,KSUM,NSTIF) 00244190 READ (4) KFACTS,(KDIAG(IR),IR=1,MCB),(KHIGH(IR),IR=1,MCB) R0244191 READ (4) (A(IR),IR=1,MLT) R0244192 NRESLT=NSTIF 00244200 IF(KSKIP.EQ.1) RETURN 00244210 GO TO 328 00244220 325 CONTINUE 00244230 IF (NBLKS.GT.1) CALL RDWRT (NRESLT,A,1,2,INUM) 00244240 328 CONTINUE 00244250 MTT=MAXVT*NEQ 00244260 330 CALL QVSET (ZER,DIAG,MTT) 00244270 DO 380 N=1,NBLKS 00244280 NCB=KFACTS(4)-KFACTS(3)+1 00244290 DO 360 NC=1,NCB 00244300 NCOL=KFACTS(4)-NC+1 00244310 KCOL=NCB-NC+1 00244320 RRNC7 = KHIGH(KCOL) R0244331 KHI = RRNC7 - 1 R0244330 RRNC8 = KDIAG(KCOL) R0244340 KD = RRNC8 R0244341 LX=0 00244350 DO 340 LC=NFLC,LLC 00244360 NX=LX*NEQ+NCOL 00244370 DIAG(NX)=A(KD+LC)-DIAG(NX) 00244380 340 LX=LX+1 00244390 IF (KHI.EQ.0) GO TO 360 00244400 LX=0 00244410 KJ=KD-KHI-1 00244420 DO 350 LC=NFLC,LLC 00244430 LX=LX+1 00244440 MEND=NCOL+(LX-1)*NEQ 00244450 RMULT=-DIAG(MEND) 00244460 MCOL=MEND-KHI 00244470 IF(NEQL.LE.0) GO TO 345 00244480 IF(NCOL.LE.NEQL) GO TO 345 00244490 MEND=MEND-NCOL+NEQL+1 00244500 IF(MCOL.GT.MEND) GO TO 350 00244510 345 CONTINUE 00244520 KJRR = KJ + 1 R0244521 CALL QMR2 (DIAG(MCOL),DIAG(MCOL),RMULT,A(KJ+1),MEND-MCOL,1,1,1) R0244530 350 CONTINUE 00244540 360 CONTINUE 00244550 IF (LLC.EQ.NLC.OR.NRIT.EQ.1) GO TO 370 00244560 CC CALL SQEEZE (AA,KSUM,NSTIF,ISQZ) 00244570 WRITE (NSTIF) KFACTS,(KDIAG(IR),IR=1,MCB),(KHIGH(IR),IR=1,MCB) R0244571 WRITE (NSTIF) (A(IR),IR=1,MLT) R0244572 370 IF (N.EQ.NBLKS) GO TO 380 00244580 CC CALL EXPAND (AA,KSUM,NRESLT) 00244590 READ (23) KFACTS,(KDIAG(IR),IR=1,MCB),(KHIGH(IR),IR=1,MCB) R0244591 READ (23) (A(IR),IR=1,MLT) R0244592 IF (MLDB.EQ.1) GO TO 380 00244600 IF(N+1.GE.NBLKS) GO TO 380 00244610 CALL RDWRT (NRESLT,A,1,2,INUM) 00244620 CALL RDWRT (NRESLT,A,1,2,INUM) 00244630 380 CONTINUE 00244640 ND=0 00244650 DO 390 I=NFLC,LLC 00244660 NS=ND+1 00244670 ND=NS+NEQ-1 00244680 390 WRITE (NT1) (DIAG(NX),NX=NS,ND) 00244690 IF (LLC.EQ.NLC) GO TO 400 00244700 NRIT=1 00244710 MLDB=1 00244720 NFLC=NFLC+MAXVT 00244730 LLC=MIN0(LLC+MAXVT,NLC) 00244740 CALL RDWRT (NSTIF,A,1,6,INUM) 00244750 CC CALL EXPAND (AA,KSUM,NSTIF) 00244760 READ (NSTIF) KFACTS,(KDIAG(IR),IR=1,MCB),(KHIGH(IR),IR=1,MCB) R0244761 READ (NSTIF) (A(IR),IR=1,MLT) R0244762 NRESLT=NSTIF 00244770 GO TO 330 00244780 400 CONTINUE 00244790 IF(NEQIL.LE.0)GO TO 910 00244800 KOUT=4 00244810 REWIND NT1 00244820 DO 900 L=1,NLC 00244830 WRITE(6,9011)L 00244840 REWIND 41 00244850 9011 FORMAT(1X ,27H FORCE CHECK ON LOAD CASE,I5/ 00244860 & 24X,12HFORCE/MOMENT/4(12H DOF ACTUAL,7X,12HCALCULATED )) 00244870 READ(NT1)DISP 00244880 DO 890 N=1,NBLKS 00244890 READ(41)AA 00244900 RRNC9 = KFACTS(3) R0244910 KSTART = RRNC9 R0244911 RRNC10 = KFACTS(4) R0244920 KEND = RRNC10 R0244921 DO 880 K=KSTART,KEND 00244930 KCOL=K-KSTART+1 00244940 RRNC11 = KHIGH(KCOL) R0244950 KHI = RRNC11 R0244951 RRNC12 = KDIAG(KCOL) R0244960 KD = RRNC12 R0244961 II1=K-KHI+1 00244970 II2=K-1 00244980 IB=KD-KHI 00244990 B(K)=0. 00245000 IF(II2.LE.0)GO TO 875 00245010 IF(II1.GE.K)GO TO 875 00245020 DO 870 I=II1,II2 00245030 IB=IB+1 00245040 B(I)=B(I)+A(IB)*DISP(K) 00245050 B(K)=B(K)+A(IB)*DISP(I) 00245060 870 CONTINUE 00245070 875 B(K)=B(K)+A(KD)*DISP(K) 00245080 880 CONTINUE 00245090 890 CONTINUE 00245100 ENGY=0. 00245110 DO 894 I=1,NEQ 00245120 894 ENGY=ENGY+DISP(I)*B(I) 00245130 ENGY=ENGY/2. 00245140 KFOR=0 00245150 NK=0 00245160 DIFM=0. 00245170 DIFF2=0. 00245180 REWIND 41 00245190 DO 899 I=1,NBLKS 00245200 READ(41)AA 00245210 RRNC13 = KFACTS(3) R0245220 KST = RRNC13 R0245221 RRNC14 = KFACTS(4) R0245230 KEND = RRNC14 R0245231 DO 898 K=KST,KEND 00245240 KCOL=K-KST+1 00245250 RRNC15 = KDIAG(KCOL) R0245260 KD = RRNC15 R0245261 NK=NK+1 00245270 IB=KD+L 00245280 P1=A(IB) 00245290 DIFF=DABS(P1-B(NK)) 00245300 DIFF2=DIFF2+DIFF*DIFF 00245310 DIFM=DMAX1(DIFM,DIFF) 00245320 KFOR=KFOR+1 00245330 IF(KFOR.EQ.KOUT+1)KFOR=1 00245340 FOLD(KFOR)=P1 00245350 IF(NK.EQ.NEQ)GO TO 895 00245360 IF(KFOR.NE.KOUT)GO TO 896 00245370 895 KK1=NK-KFOR+1 00245380 WRITE(6,9012)(KKL,FOLD(KKL-KK1+1),B(KKL),KKL=KK1,NK) 00245390 896 CONTINUE 00245400 9012 FORMAT(4(I5,1P2E13.5)) 00245410 898 CONTINUE 00245420 899 CONTINUE 00245430 DMSE=DIFF2/DBLE (NEQ) R0245440 DMSE=DSQRT(DMSE) 00245450 WRITE(6,9010)L,DIFM,DMSE,ENGY 00245460 9010 FORMAT(2H ,80(1H*)/29H EQUILIBRIUM CHECK LOAD CASE, 00245470 & I5/19H MAXIMUM ERROR=,1PE10.3/21H ROOT MEAN SQUARE, 00245480 & 7H ERROR=,E10.3/25H TOTAL STRAIN ENERGY=,1PE18.10) 00245490 900 CONTINUE 00245500 910 CONTINUE 00245510 NT2 = 62 R0245520 REWIND NT2 00245530 NS=1-NEQB 00245540 ND=NEQB 00245550 DO 430 I=1,NBLK2 00245560 IF (I.EQ.NBLK2) ND=NEQ-NEQB*(NBLK2-1) 00245570 REWIND NT1 00245580 NS=NS+NEQB 00245590 DO 420 J=1,NLC 00245600 READ (NT1) DISP 00245610 IF (I.GT.1) GO TO 420 00245620 IF (NGP.EQ.0) GO TO 420 00245630 DO 410 K=1,NGP 00245640 MCOL=NEQ4(K) 00245650 410 GDISP(K,J)=DISP(MCOL) 00245660 420 CALL QVCOPY (DISP(NS),BLDIS(1,J),ND) 00245670 IF (NRC3 .EQ. 1) WRITE(6,2105) (DISP(IR),IR=1,11) 2105 FORMAT (1X,'**DISP**',11E11.4/) IF (NRC3 .EQ. 1) WRITE(6,2107) (BLDIS(IR,1),IR=1,11) 2107 FORMAT (1X,'**BLDIS**',11E11.4/) 430 WRITE (NT2) BLDIS 00245680 WRITE(6,440) 00245690 440 FORMAT (/20X,37HBACK-SUBSTITUTION HAS BEEN COMPLETED.///) 00245700 TIM1=TIM2-TIM1 00245710 WRITE(6,450)TIM1 00245720 450 FORMAT(1H+,20X,30HTIME FOR FORWARD REDUCTION WAS,F9.3,8H MINUTS /)R0245730 CALL SECOND(TIM1) 00245740 TIM1=TIM1-TIM2 00245750 WRITE(6,460)TIM1 00245760 460 FORMAT(1H0,20X,30HTIME FOR BACK SUBSTITUTION WAS,F9.3,8H MINUTS /)R0245770 RETURN 00245780 END 00245790 SUBROUTINE SETDIS(N1,N2, KSUM,MCB,MLT, R0235070 $KFN,NEQ,B,NBLKS,NLC,KSKIP,NDF) 00235080 IMPLICIT REAL*8(A-H,O-Z) 00235090 REAL*8 KFACTS,KF,KDIAG,KHIGH,A R0235100 DIMENSION B(NDF,NLC) 00235110 COMMON /SUPEL/ NSELEM,LEQN,NODESE,MATNO,NEADD,NSEL 00235120 COMMON /AAA1/ A(8000) R0235121 COMMON /AAA2/ KFACTS(4),KDIAG(300),KHIGH(300) R0235122 NT=27 00235130 REWIND NT 00235140 100 READ (NT,END=150) M,N,ND,LL 00235150 110 CONTINUE 00235160 IF(M.NE.MATNO) GO TO 140 00235170 IF(NSEL.GT.0.AND.N.NE.NSEL) GO TO 140 00235180 IF(ND.NE.NDF.OR.LL.NE.NLC) GO TO 120 00235190 GO TO 170 00235200 120 WRITE(6,130)M 00235210 130 FORMAT(///20X,20HSUPER ELEMENT MATRIX,I4,18H WAS FOUND BUT DID, 00235220 $52H NOT HAVE THE CORRECT NO. OF DISPLACEMENTS OR LOADS.///) 00235230 135 KSKIP=1 00235240 RETURN 00235250 140 READ (NT,END=150) 00235260 GO TO 100 00235270 150 WRITE(6,160)MATNO 00235280 160 FORMAT (//20X,6HMATRIX,I4,30H COULD NOT BE FOUND ON TAPE27.///) 00235290 GO TO 135 00235300 170 READ (NT) B 00235310 DO 210 N=1,NBLKS 00235320 CC CALL EXPAND(AA,KSUM,N1) 00235330 READ (4) KFACTS,(KDIAG(IR),IR=1,MCB),(KHIGH(IR),IR=1,MCB) READ (4) (A(IR),IR=1,MLT) KS=KFACTS(3) 00235340 KE=KFACTS(4) 00235350 IF(KE.LE.LEQN) GO TO 200 00235360 KSTART=LEQN+1 00235370 I=1 00235380 IF(KSTART.LT.KS) I=KS-LEQN 00235390 IF(KSTART.LT.KS) KSTART=KS 00235400 DO 190 K=KSTART,KE 00235410 IF(I.GT.ND) GO TO 120 00235420 KCOL=K-KS+1 00235430 KD=KDIAG(KCOL) 00235440 DO 180 LC=1,NLC 00235450 180 A(KD+LC)=B(I,LC) 00235460 190 I=I+1 00235470 200 CALL RDWRT(N2,AA,KSUM,1,INUM) 00235480 IF(N.EQ.NBLKS) GO TO 210 00235490 CALL RDWRT(N1,AA,KSUM,2,INUM) 00235500 CALL RDWRT(N1,AA,KSUM,2,INUM) 00235510 210 CONTINUE 00235520 CALL RDWRT(N2,AA,KSUM,6,INUM) 00235530 RETURN 00235540 END 00235550 SUBROUTINE QVCOPY(FROM,TO,N) 00193850 REAL*8 FROM,TO 00193860 DIMENSION FROM(1),TO(1) 00193870 DO 100 I=1,N 00193880 100 TO(I)=FROM(I) 00193890 RETURN 00193900 END 00193910 SUBROUTINE INL(ID,B,TR,TMASS,NUMNP,NEQB,LL,MMA,ISL,NSLDM) R0114820 IMPLICIT REAL*8(A-H,O-Z) 00114830 REAL*8 ID 00114840 LOGICAL ISLAVE 00114850 COMMON/FORCE/ NLC,NELD R0114860 COMMON /CG/ SCG(4),RRCG(2) R0114870 COMMON /AMB/ GRAV,REFT,JROT R0114880 DIMENSION ID(NUMNP,3),B(NEQB,LL),TR(6,LL),TMASS(NEQB,MMA) R0114890 1,ISL(NSLDM,4),XMAST(3),XSLAVE(3) 00114900 COMMON / JUNK / R(6),TXM(6),RRJUNK(215) R0114910 COMMON/PREP/XMX,XAD,KSKIP,NDYN,I1,RRPREP(7) R0114920 COMMON/SLVE/NSLAVE 00114930 CC COMMON /AAA1/ TMASS(200,40) R0114931 CALL FILES(9) 00114940 100 FORMAT (10X,I5) 00114950 IF(NSLAVE.EQ.0) GO TO 105 00114960 REWIND 30 00114970 READ(30)((ISL(I,J),J=1,4),I=1,NSLAVE) 00114980 105 CONTINUE 00114990 NMWA=NEQB*MMA 00115000 ZER=0.0D0 00115010 NWDS=LL*NEQB 00115020 M=15 00115030 IF(NLC.LE.0) GO TO 240 00115040 NT=3 00115050 NWDSB=NWDS+NEQB*MMA 00115060 CALL RDWRT(NT,B,1,6,INUM) 00115070 REWIND 15 00115080 KSHF=0 00115090 CALL MEMSET (ZER,TMASS (1,1),NMWA) 00115100 CALL MEMSET (ZER, B(1,1),NWDS) 00115110 NLAST=0 00115120 DO 230 NN=1,NUMNP 00115130 DO 110 I=1,6 00115140 TXM(I)=0. 00115150 DO 110 J=1,LL 00115160 110 TR(I,J)=0.0 00115170 IF(NN.EQ.1) GO TO 160 00115180 120 IF(N.NE.NN) GO TO 180 00115190 DO 150 I=1,6 00115200 IF(L.GT.0) GO TO 140 00115210 IF(R(2).LE.0) R(2)=R(1) 00115220 IF(R(3).LE.0) R(3)=R(1) 00115230 130 TXM(I)=R(I) 00115240 IF(I.GT.3) GO TO 150 00115250 CALL UNPKID(ID,NUMNP,W,CORD,1,N ,I) 00115260 XMCG=TXM(I) 00115270 SCG(I)=SCG(I)+XMCG*CORD 00115280 IF(I.EQ.1) SCG(4)=SCG(4)+XMCG 00115290 GO TO 150 00115300 140 TR(I,L)=R(I) 00115310 150 CONTINUE 00115320 160 READ (M) N,L,R 00115330 IF (N.EQ.0) GO TO 120 00115340 IF(N.LT.NLAST) WRITE(6,170)N 00115350 IF(N.LT.NLAST) KSKIP=1 00115360 170 FORMAT (/20X, 4HNODE,I5, 36HIS LESS THAN THE PREVIOUS NODE-ERROR/00115370 $/) 00115380 NLAST=N 00115390 GO TO 120 00115400 180 CONTINUE 00115410 ISLAVE=.FALSE. 00115420 IF(NSLAVE.EQ.0)GO TO 1310 00115430 DO 1300 I=1,6 00115440 IF(ISLAVE) GO TO 1195 00115450 DO 1100 J=1,NSLAVE 00115460 IF(NB.EQ.ISL(J,1)) ISLAVE=.TRUE. 00115470 IF(ISLAVE) GO TO 1190 00115480 1100 CONTINUE 00115490 1190 ISLV=J 00115500 1195 CONTINUE 00115510 IF(.NOT.ISLAVE) GO TO 1230 00115520 K=I 00115530 IF(K.GT.3) K=K-3 00115540 ISLN=ISL(ISLV,K+1) 00115550 IF(I.LE.3) ISLN=MOD(ISLN,10000) 00115560 IF(I.GT.3) ISLN=ISLN/10000 00115570 IF(ISLN.EQ.0) GO TO 1230 00115580 DO 1200 J=1,3 00115590 CALL UNPKID(ID,NUMNP,W,XSLAVE(J),1,NB,J) 00115600 CALL UNPKID(ID,NUMNP,W,XMAST(J),1,ISLN,J) 00115610 1200 CONTINUE 00115620 XDIFF=XSLAVE(1)-XMAST(1) 00115630 YDIFF=XSLAVE(2)-XMAST(2) 00115640 ZDIFF=XSLAVE(3)-XMAST(3) 00115650 DO 1220 J=1,LL 00115660 IF(I.EQ.4) TR(4,J)=TR(4,J)-TR(2,J)*ZDIFF+TR(3,J)*ZDIFF 00115670 IF(I.EQ.5) TR(5,J)=TR(5,J)+TR(1,J)*ZDIFF-TR(3,J)*XDIFF 00115680 IF(I.EQ.6) TR(6,J)=TR(6,J)-TR(1,J)*YDIFF+TR(2,J)*XDIFF 00115690 IF(I.EQ.4) TXM(4)=TXM(2)*ZDIFF*ZDIFF+TXM(3)*YDIFF*YDIFF 00115700 IF(I.EQ.5) TXM(5)=TXM(1)*ZDIFF*ZDIFF+TXM(3)*XDIFF*XDIFF 00115710 IF(I.EQ.6) TXM(6)=TXM(1)*YDIFF*YDIFF+TXM(2)*XDIFF*XDIFF 00115720 1220 CONTINUE 00115730 1230 CONTINUE 00115740 1300 CONTINUE 00115750 1310 CONTINUE 00115760 DO 220 J=1,6 00115770 IF (KSKIP.EQ.1) GO TO 230 00115780 CALL UNPKID ( ID ,NUMNP,W ,WX ,2,NN,J) 00115790 NNN=W 00115800 II=NNN-KSHF 00115810 IF(NNN.LE.0) GO TO 220 00115820 IF(II.LE.0) GO TO 220 00115830 190 DO 200 K=1,LL 00115840 200 B(II,K)=TR(J,K) +B(II,K) 00115850 TMASS(II,1)=TMASS(II,1)+TXM(J) 00115860 210 IF(II.NE.NEQB) GO TO 220 00115870 CALL RDWRT(NT,B,NWDSB,1,INUM) 00115880 KSHF=KSHF+NEQB 00115890 CALL MEMSET (ZER,TMASS (1,1),NMWA) 00115900 CALL MEMSET (ZER, B(1,1),NWDS) 00115910 220 CONTINUE 00115920 230 CONTINUE 00115930 240 IF(SCG(4).LE.0.0) GO TO 270 00115940 DO 250 I=1,3 00115950 250 SCG(I)=SCG(I)/SCG(4) 00115960 SCG(4)=SCG(4)*GRAV 00115970 IF(SCG(4).GT.0.0) WRITE(6,260)SCG 00115980 260 FORMAT(1X ,19X, 49HTHE CENTER OF GRAVITY OF THE FINITE ELEMENT MOD00115990 $EL, 7H IS AT,//30X, 4HX = ,F12.4, 8H UNITS, 00116000 $ /30X, 4HY = ,F12.4, 8H UNITS, 00116010 $ /30X, 4HZ = ,F12.4, 8H UNITS. 00116020 $ //20X, 26HTHE TOTAL MODEL WEIGHT IS ,F25.5, 8H U00116030 $NITS.////) 00116040 270 IF(NLC.EQ.0) RETURN 00116050 IF (KSKIP.EQ.1) GO TO 280 00116060 CALL RDWRT(NT,B,NWDSB,1,INUM) 00116070 280 RETURN 00116080 290 FORMAT (2I5,7F10.4) 00116090 300 FORMAT (2I5,7F10.3) 00116100 310 FORMAT (23H1.....NODAL POINT LOADS // 10H NODE LOAD,23X, 00116110 $ 14HAPPLIED LOADS / 10H NO. CASE ,6X, 2HFX,8X, 00116120 $ 2HFY,8X,2HFZ,8X,2HMX,8X,2HMY,8X,2HMZ ) 00116130 END 00116140 SUBROUTINE MEMSET (KONST,IARRAY,NWDS) 00135760 REAL*8 IARRAY, KONST 00135770 DIMENSION IARRAY(1) 00135780 DO 100 I=1,NWDS 00135790 100 IARRAY(I)=KONST 00135800 RETURN 00135810 END 00135820 SUBROUTINE ADDSTF( A2, NUMEL,NBLOCK,NE2B,LL, R0011060 $MBAND,NEQB,NEMN,ANORM,NVV,MMA) 00011070 IMPLICIT REAL*8(A-H,O-Z) 00011080 LOGICAL ELPRT,ELPCH,GENPRT,GENPCH,GEOST 00011090 COMMON STIF(1) 00011100 CC DIMENSION A(NEQB,MBAND), B(NEQB,LL), TMASS(NEQB,MMA) R0011110 DIMENSION A2(NEQB,MBAND) R0011120 DIMENSION ICOO(10),IFORM(4) 00011130 COMMON/CTL/ELPRT,ELPCH,GENPRT,GENPCH 00011140 COMMON/GEOSTF/GEOST,NELGEO 00011150 COMMON/MASS/LMASS 00011160 COMMON /SQZ/ ISQZ,NRSQZ(5) R0011170 COMMON/PREP/XMX,XAD,KSKIP,NDYN,I1,RRPREP(7) R0011180 COMMON /DYN5/FRSHFT,FRINIT,FREND,MODEFR,NOSS R0011190 COMMON /FORCE/ NLC,NELD 00011200 COMMON/ELPAR/ XPAR(14),KDUM(9),KEQ,RRELPA(24) R0011210 COMMON /DYN2/IFPR,IFSS,NITEM,NFO,RTOL,COFQ,DT,ALFA,BETA,NFN,NGM, 00011220 $NAT,NT,NOT,NRDYN2(9) R0011230 COMMON /AAA1/ A(150,53) R0011231 COMMON /AAA2/ TMASS(200,1),B(200,3),TMASS2(200,1),B2(200,3) R0011232 DATA ICOO / 3H001,3H013,3H025,3H037,3H049,3H061,3H073,3H085,3H097,00011240 $ 3H109/ 00011250 DATA IFORM(1),IFORM(3),IFORM(4)/4H(1H+,4HX,F7,4H.2) / 00011260 KX(I,J,ND1)=MIN0(I,J)*(2*ND1+1-MIN0(I,J))/2-ND1+MAX0(I,J)+ND1 00011270 ZER=0.0D0 00011280 NWDS=NEQB*(MBAND+LL) 00011290 NWA=MBAND*NEQB 00011300 IF(NDYN.GT.3.AND.NDYN.LE.7) NWDS=NWA 00011310 IF(NDYN.EQ.11.OR.NELGEO.EQ.1) NWDS=NWA 00011320 NWB= LL*NEQB 00011330 NTA=4 00011340 REWIND 3 00011350 LLF=LL 00011360 IF(NELD.EQ.0) LLF=0 00011370 NTD=9 00011380 NT1=2 00011390 NT2=10 00011400 K=NEQB+1 00011410 X=NBLOCK 00011420 NFLG=0 00011430 MB= DSQRT(X) 00011460 MB=MB/2+1 00011470 NEBB=MB*NE2B 00011480 MM=1 00011490 NSHIFT=0 00011500 NTB=3 00011510 NWDSB=NWB+NEQB*MMA 00011520 CALL RDWRT(NTB,B,1,6,INUM) 00011530 CALL RDWRT(NTA,A,1,6,INUM) 00011540 ANORM=0.0 00011550 NDEG=0 00011560 AMIN=1.0D30 00011570 AMAX=-AMIN 00011580 NNZTRM=0 00011590 NVV=0 00011600 IF(NDYN.NE.7) GO TO 110 00011610 TETA=1.4 00011620 DT1=TETA*DT 00011630 DT2=DT1*DT1 00011640 A0=(6.+3*ALFA*DT1)/(DT2+3*BETA*DT1) 00011650 110 CONTINUE 00011660 REWIND NTD 00011670 WRITE(6,115) 00011680 115 FORMAT(//,10X,48HTHE LAST NUMBER PRINTED IS THE PERCENT OF THE MA,00011690 $ 55HSTER STIFFNESS AND LOAD MATRICES THAT HAS BEEN ASSEMBLE,00011700 $ 2HD.,//) 00011710 ICO = 1 00011720 CC DO 117 IIR=1,NEQB CC117 TMASS(IIR,1) = TMASS2(IIR,1) WRITE (6,2002) NLC,(TMASS(II,1),II=1,8) 2002 FORMAT (5X,'*** NLC TMASS ***',I5,8E11.4/) DO 310 M=1,NBLOCK ,2 00011730 NWA1 = 150*53 R0011731 CALL MEMSET (ZER,A2(1,1),NWA) 00011740 CALL MEMSET (ZER, A(1,1),NWA1) R0011750 IF(NLC.GT.0) GO TO 120 00011760 NMWA=NEQB*MMA 00011770 NMWA1=200 R0011771 NWB1=1200 R0011772 CALL MEMSET (ZER,TMASS2(1,1),NMWA) 00011780 CALL MEMSET (ZER,TMASS (1,1),NMWA1) R0011790 CALL MEMSET (ZER,B2(1,1),NWB) 00011800 CALL MEMSET (ZER, B(1,1),NWB1) R0011810 GO TO 130 00011820 120 CONTINUE 00011830 CALL RDWRT(NTB,B ,NWDSB,0,N) 00011840 IF (M.EQ.NBLOCK) GO TO 130 00011850 CALL RDWRT(NTB,B2,NWDSB,0,N) 00011860 130 CONTINUE 00011870 CALL RDWRT(NT1,STIF,1,6,N) 00011880 CALL RDWRT(NT2,STIF,1,6,N) 00011890 NA=NT2 00011900 NUME=NUM7 00011910 IF (MM.NE.1) GO TO 140 00011920 NA=NT1 00011930 NUME=NUMEL 00011940 NUM7 =0 00011950 140 DO 240 N=1,NUME 00011960 CALL RDWRT(NA,STIF,NEMN,0,KOUNT) 00011970 ND1=STIF(KOUNT) 00011980 NTOT=(ND1*ND1-ND1)/2+ND1 00011990 KSTXM=LLF*ND1+NTOT+ND1 00012000 DO 210 I=1,ND1 00012010 LMN=1-STIF(I) 00012020 II=STIF(I)-NSHIFT 00012030 IF (II.LE.0.OR.II.GT.NE2B) GO TO 210 00012040 IF(II.GT.NEQB)GO TO 180 00012050 IF(LMASS.EQ.1) GO TO 2120 00012060 TMASS(II,1)=TMASS(II,1)+STIF(KSTXM+I) 00012070 2120 CONTINUE 00012080 IF(NELD.EQ.0) GO TO 155 00012090 KSTP=NTOT+I 00012100 DO 150 L=1,LL 00012110 KSTP=KSTP+ND1 00012120 150 B(II,L)=B(II,L)+STIF(KSTP) 00012130 155 CONTINUE 00012140 DO 170 J=1,ND1 00012150 JJ=STIF(J)+LMN 00012160 IF(JJ) 170,170,160 00012170 160 KSTS=KX(I,J,ND1) 00012180 A(II,JJ)=A(II,JJ)+STIF(KSTS) 00012190 IF(LMASS.NE.1) GO TO 170 00012200 KSTM=KX(I,J,ND1)-ND1 00012210 TMASS(II,JJ)=TMASS(II,JJ)+STIF(KSTXM+KSTM) 00012220 170 CONTINUE 00012230 GO TO 210 00012240 180 II=II-NEQB 00012250 IF(LMASS.EQ.1) GO TO 2130 00012260 TMASS2(II,1)=TMASS2(II,1)+STIF(KSTXM+I) 00012270 2130 CONTINUE 00012280 IF(NELD.EQ.0) GO TO 195 00012290 KSTP=NTOT+I 00012300 DO 190 L=1,LL 00012310 KSTP=KSTP+ND1 00012320 190 B2(II,L)=B2(II,L)+STIF(KSTP) 00012330 195 CONTINUE 00012340 DO 200 J=1,ND1 00012350 JJ=STIF(J)+LMN 00012360 IF(JJ.LE.0) GO TO 200 00012370 KSTS=KX(I,J,ND1) 00012380 A2(II,JJ)=A2(II,JJ)+STIF(KSTS) 00012390 IF(LMASS.NE.1) GO TO 200 00012400 KSTM=KX(I,J,ND1)-ND1 00012410 TMASS2(II,JJ)=TMASS2(II,JJ)+STIF(KSTXM+KSTM) 00012420 200 CONTINUE 00012430 210 CONTINUE 00012440 IF (MM.GT.1) GO TO 240 00012450 DO 220 I=1,ND1 00012460 II=STIF(I)-NSHIFT 00012470 IF(II.GT.NE2B.AND.II.LE.NEBB) GO TO 230 00012480 220 CONTINUE 00012490 GO TO 240 00012500 230 CALL RDWRT(NT2,STIF,KOUNT,1,I) 00012510 NUM7=NUM7+1 00012520 240 CONTINUE 00012530 IF(NDYN.LT.4.OR.NDYN.GT.6) GO TO 260 00012540 IF(FRSHFT.EQ.0.)FRSHFT=-1.0 00012550 IF(LMASS.EQ.1) GO TO 2150 00012560 CALL QMR22( FRSHFT, NEQB,1,1,1) R0012570 IF(M.NE.NBLOCK)CALL QMR2(A2,A2,FRSHFT,TMASS2,NEQB, 00012580 11,1,1) 00012590 GO TO 2160 00012600 2150 CALL QMR3(A,A,FRSHFT,TMASS,NEQB,1,1,1,NWA) 00012610 IF(M.NE.NBLOCK)CALL QMR3(A2,A2,FRSHFT,TMASS2,NEQB, 00012620 11,1,1,NWA) 00012630 2160 CONTINUE 00012640 DO 250 I=1,NEQB 00012650 D=A(I,1) 00012660 ANORM=ANORM+D 00012670 IF(D.NE.0.0) NDEG=NDEG+1 00012680 IF(D.NE.0.0D0.AND.D.LT.AMIN)AMIN=D 00012690 IF(D.GT.AMAX) AMAX=D 00012700 IF(D.EQ.0.0) A(I,1)=1.0E+20 00012710 IF(TMASS(I,1).NE.0.) NVV=NVV+1 00012720 DO 2162 KAPG=1,MBAND 00012730 IF(A(I,KAPG).NE.0.0D0)NNZTRM=NNZTRM+1 00012740 2162 CONTINUE 00012750 IF(M.EQ.NBLOCK) GO TO 250 00012760 D=A2(I,1) 00012770 ANORM=ANORM+D 00012780 IF(D.NE.0.0) NDEG=NDEG+1 00012790 IF(D.NE.0.0D0.AND.D.LT.AMIN)AMIN=D 00012800 IF(D.GT.AMAX) AMAX=D 00012810 IF(D.EQ.0.0) A2(I,1)=1.0E+20 00012820 IF(TMASS2(I,1).NE.0.0) NVV=NVV+1 00012830 DO 2165 KAPG=1,MBAND 00012840 IF(A2(I,KAPG).NE.0.0D0)NNZTRM=NNZTRM+1 00012850 2165 CONTINUE 00012860 250 CONTINUE 00012870 260 CONTINUE 00012880 IF(NDYN.NE.7) GO TO 290 00012890 DO 270 I=1,NEQB 00012900 270 A(I,1)=A(I,1)+A0*TMASS(I,1) 00012910 IF(M.EQ.NBLOCK) GO TO 290 00012920 DO 280 I=1,NEQB 00012930 280 A2(I,1)=A2(I,1)+A0*TMASS2(I,1) 00012940 290 CONTINUE 00012950 IF(.NOT.GENPRT) GO TO 1200 00012960 WRITE(6,1500)M 00012970 DO 1020 I=1,NEQB 00012980 IF(GENPCH)WRITE(7,1510)(A(I,J),J=1,MBAND) 00012990 1020 WRITE(6,1520)(A(I,J),J=1,MBAND) 00013000 WRITE(6,1530) 00013010 DO 1030 I=1,NEQB 00013020 IF(GENPCH) WRITE(7,1510)(B(I,J),J=1,LL) 00013030 1030 WRITE(6,1520)(B(I,J),J=1,LL) 00013040 WRITE(6,1540) 00013050 IF(LMASS.EQ.1) GO TO 2170 00013060 IF(GENPCH) WRITE(7,1510)(TMASS(I,1),I=1,NEQB) 00013070 WRITE(6,1520)(TMASS(I,1),I=1,NEQB) 00013080 GO TO 2190 00013090 2170 DO 2180 I=1,NEQB 00013100 IF(GENPCH) WRITE(7,1510)(TMASS(I,J),J=1,MBAND) 00013110 2180 WRITE(6,1520)(TMASS(I,J),J=1,MBAND) 00013120 2190 CONTINUE 00013130 IF(M.EQ.NBLOCK) GO TO 1200 00013140 MP1=M+1 00013150 WRITE(6,1500)MP1 00013160 DO 1060 I=1,NEQB 00013170 IF(GENPCH)WRITE(7,1510)(A2(I,J),J=1,MBAND) 00013180 1060 WRITE(6,1520)(A2(I,J),J=1,MBAND) 00013190 WRITE(6,1530) 00013200 DO 1070 I=1,NEQB 00013210 IF(GENPCH) WRITE(7,1510)(B2(I,J),J=1,LL) 00013220 1070 WRITE(6,1520)(B2(I,J),J=1,LL) 00013230 WRITE(6,1540) 00013240 IF(LMASS.EQ.1) GO TO 2200 00013250 IF(GENPCH) WRITE(7,1510)(TMASS2(I,1),I=1,NEQB) 00013260 WRITE(6,1520)(TMASS2(I,1),I=1,NEQB) 00013270 GO TO 1200 00013280 2200 DO 2210 I=1,NEQB 00013290 IF(GENPCH)WRITE(7,1510)(TMASS2(I,J),J=1,MBAND) 00013300 2210 WRITE(6,1520)(TMASS2(I,J),J=1,MBAND) 00013310 1200 CONTINUE 00013320 IF(MODEFR.GT.0) GO TO 247 00013330 DO 246 I=1,NEQB 00013340 D=A(I,1) 00013350 IF(D.GT.0.0) GO TO 243 00013360 NJ=NEQB*(M-1)+I 00013370 IF(NJ.GT.KEQ) GO TO 246 00013380 NFLG=1 00013390 WRITE(6,242)NJ,D 00013400 242 FORMAT(/10X,9HEQUATION ,I5,26H HAS A SINGULAR DIAGONAL = ,E10.4) 00013410 WRITE(6,115) 00013420 ICO=1 00013430 243 D=A2(I,1) 00013440 IF(D.GT.0.0) GO TO 246 00013450 NJ=NEQB*M+I 00013460 IF(NJ.GT.KEQ) GO TO 246 00013470 NFLG=1 00013480 WRITE(6,242)NJ,D 00013490 246 CONTINUE 00013500 247 CONTINUE 00013510 IF(NDYN.GT.0.AND.NDYN.LE.3) WRITE (NTD) ((TMASS(II,JJ),II=1,NEQB),R0013520 $ JJ=1,MMA),((B(II,JJ),II=1,NEQB),JJ=1,LL) R0013521 IF(NDYN.GT.3.AND.NDYN.LT.7) WRITE (NTD) ((TMASS(II,JJ),II=1,NEQB),R0013530 $ JJ=1,MMA),(A(I,1),I=1,NEQB) R0013531 WRITE (6,8087) ((TMASS(II,JJ),II=1,NEQB),JJ=1,MMA) 8087 FORMAT (1X,'**TMASS*',12E10.4/) IF(NDYN.EQ.7)WRITE (NTD) ((TMASS(II,JJ),II=1,NEQB),JJ=1,MMA) R0013540 IF(NDYN.EQ.11) WRITE(NTD) ((TMASS(II,JJ),II=1,NEQB),JJ=1,MMA),(A(IR0013550 $ ,1),I=1,NEQB) R0013551 IF(NDYN.EQ.11.OR.NELGEO.EQ.1) WRITE(3) ((B(I,J),I=1,NEQB),J=1,LL) R0013561 IF(NDYN.GT.3.AND.NDYN.LE.7) NWDS = MBAND * NEQB R0013561 IF(NDYN.EQ.11.OR.NELGEO.EQ.1) NWDS = MBAND * NEQB R0013562 WRITE (4) ((A(II,JJ),II=1,NEQB),JJ=1,MBAND) R0013570 CC CALL SQEEZE(A ,NWDS,NTA,ISQZ) 00013570 WRITE (6,3333) NEQB,MBAND,NWDS,ISQZ,NTA 3333 FORMAT (1X,'*** NEQB MBAND NWDS ISQZ NTA ***',3X,5I5/) IF(M.EQ.NBLOCK) GO TO 310 00013580 IF(NDYN.GT.0.AND.NDYN.LE.3) WRITE (NTD)((TMASS2(II,JJ),II=1,NEQB),R0013590 $ JJ=1,MMA),((B2(II,JJ),II=1,NEQB),JJ=1,LL) R0013591 IF(NDYN.GT.3.AND.NDYN.LT.7) WRITE (NTD)((TMASS2(II,JJ),II=1,NEQB),R0013600 $ JJ=1,MMA),(A2(I,1),I=1,NEQB) R0013601 IF(NDYN.EQ.7)WRITE (NTD) ((TMASS2(II,JJ),II=1,NEQB),JJ=1,MMA) R0013610 IF(NDYN.EQ.11)WRITE(NTD) ((TMASS(II,JJ),II=1,NEQB),JJ=1,MMA),(A2(IR0013620 $ ,1),I=1,NEQB) R0013621 IF(NDYN.EQ.11.OR.NELGEO.EQ.1) WRITE(3) ((B2(I,J),I=1,NEQB),J=1,LL)R0013631 IF(NDYN.GT.3.AND.NDYN.LE.7) NWDS = MBAND * NEQB R0013631 WRITE (4) ((A2(II,JJ),II=1,NEQB),JJ=1,MBAND) R0013640 CC CALL SQEEZE(A2,NWDS,NTA,ISQZ) 00013640 IF (MM.EQ.MB) MM=0 00013650 MM=MM+1 00013660 PER=(M+1)*100.0/X 00013670 IFORM(2) = ICOO(ICO) 00013680 WRITE(6,2003) PER R0013690 2003 FORMAT (5X,F10.4/) R0013691 ICO = ICO + 1 00013700 IF ( ICO .LT. 11 ) GO TO 310 00013710 WRITE(6,295) 00013720 295 FORMAT(1H ) 00013730 ICO = 1 00013740 310 NSHIFT=NSHIFT+NE2B 00013750 WRITE(6,320) 00013760 320 FORMAT(////20X,59(1H*)/20X,59HTHE MASTER STIFFNESS AND LOAD MATRIC00013770 $ES HAVE BEEN ASSEMBLED./20X,59(1H*)) 00013780 IF(NFLG.EQ.1) KSKIP=1 00013790 IF(NDYN.LT.4.OR.NDYN.GT.6) RETURN 00013800 IF(NDEG.GT.0) GO TO 340 00013810 WRITE(6,330) 00013820 330 FORMAT (51H0STRUCTURE WITH NO DEGREES OF FREEDOM CHECK DATA ) 00013830 KSKIP=1 00013840 RETURN 00013850 340 IF(NDEG.GT.0) ANORM= (ANORM/NDEG)*1.0E-08 00013860 NTERM=NEQB*NBLOCK*MBAND 00013870 PCT=100.0D0*DBLE (NNZTRM)/DBLE (NTERM) R0013880 RATIO=1.0D30 00013890 IF(AMIN.NE.0D0) RATIO=AMAX/AMIN 00013900 AAVG=ANORM*1.0D8 00013910 WRITE(6,1550)AMIN,AMAX,RATIO,AAVG,PCT 00013920 RETURN 00013930 1500 FORMAT(17H OVERALL MATRICES,1X,5HBLOCK,I3,//, 00013940 117H STIFFNESS MATRIX) 00013950 1510 FORMAT((1P8E10.3)) 00013960 1520 FORMAT ( (1H ,1P10E13.4)) 00013970 1530 FORMAT(///,12H LOAD MATRIX) 00013980 1540 FORMAT(///,12H MASS MATRIX) 00013990 1550 FORMAT(5X,27HSTIFFNESS MATRIX PARAMETERS,//, 00014000 1 15X,34HMINIMUM NON-ZERO DIAGONAL ELEMENT=,1PD10.3,/, 00014010 2 15X,34HMAXIMUM DIAGONAL ELEMENT =, D10.3,/, 00014020 3 15X,34HMAXIMUM/MINIMUM =, D10.3,/, 00014030 4 15X,34HAVERAGE DIAGONAL ELEMENT =, D10.3,/, 00014040 5 15X,34HDENSITY OF THE MATRIX =, D10.3) 00014050 END 00014060 FUNCTION AGET(IIPOS) 00014070 INTEGER SECT,POINT,BEGIN,GETSEC,EPOINT,BLANK,AGET,AGETW 00014080 DOUBLE PRECISION RGET,XX 00014090 LOGICAL EOL,EOS,EOF,ERROR,INDEX,GETWRD 00014100 COMMON /FRECNT/ LINE(80),SECT,EOL,EOS,EOF, 00014110 1ERROR,BLANK,ICOMMA,POINT,BEGIN,LENGTH, 00014120 2EPOINT,NSECT,LINENM,MAXSTR,KUNIT,JUNIT,IUNIT 00014130 AGET = BLANK 00014140 IPOSIT = IIPOS 00014150 GO TO 500 00014160 ENTRY AGETW(AGE001) 00014170 AGETW = BLANK 00014180 IPOSIT = 1 00014190 IF (.NOT.GETWRD(GET001).OR.LENGTH.EQ.0) RETURN 00014200 DO 450 ILOOP=BEGIN,80 00014210 IF (LINE(ILOOP).EQ.ICOMMA) GO TO 460 00014220 450 CONTINUE 00014230 460 MAXSTR = ILOOP - BEGIN 00014240 500 IF (IPOSIT.GT.MAXSTR.OR.IPOSIT.LE.0) RETURN 00014250 IF ((BEGIN+IPOSIT-1).LE.80) AGET = LINE (BEGIN+IPOSIT-1) 00014260 AGETW = AGET 00014270 RETURN 00014280 END 00014290 SUBROUTINE QMR3(C,D,FAC,B,N,JC,KC,JB,NWA) 00186950 IMPLICIT REAL*8(A-H,O-Z) 00186960 DIMENSION B(1),C(1),D(1) 00186970 MBAND=NWA/N 00186980 IB=1 00186990 IC=1 00187000 DO 100 I=1,N 00187010 DO 90 J=1,MBAND 00187020 KB=N*(J-1)+IB 00187030 KCC=N*(J-1)+IC 00187040 C(KCC)=D(KCC)-FAC*B(KB) 00187050 90 CONTINUE 00187060 IB=IB+JB 00187070 100 IC=IC+JC 00187080 210 FORMAT(5X,10E10.3) 00187090 RETURN 00187100 END 00187110 SUBROUTINE QVDOT1 (C,N1,B,N,JA,JB) R0193990 REAL*8 A,B,C 00194000 COMMON /AAA1/ A(8000) R0194001 DIMENSION B(1) R0194010 IA = N1 R0194020 IB=1 00194030 C=0.0 00194040 DO 100 I=1,N 00194050 C=C+A(IA)*B(IB) 00194060 IA=IA+JA 00194070 100 IB=IB+JB 00194080 RETURN 00194090 END 00194100 SUBROUTINE QVDOT(C,A,B,N,JA,JB) 00193990 REAL*8 A,B,C 00194000 DIMENSION A(1),B(1) 00194010 IA=1 00194020 IB=1 00194030 C=0.0 00194040 DO 100 I=1,N 00194050 C=C+A(IA)*B(IB) 00194060 IA=IA+JA 00194070 100 IB=IB+JB 00194080 RETURN 00194090 END 00194100