Liren Large Software Subsidy 9

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

/ Liren Large Software Subsidy 9 / 09.iso / e / e003 / 4.ddi / ELSTF01.FOR next >

Wrap

Text File | 1980-01-04 | 89.4 KB | 1,124 lines

SUBROUTINE ELSTF(NDMX,LL,TEMPD,NBLANK,NTERM,ID4,NADND 00082010 & ,ISIR,NMNP,ISL,NSLDM) 00082020 IMPLICIT REAL*8(A-H,O-Z) 00082030 INTEGER*2 ISIR(NMNP) 00082040 REAL*8 ID2 00082050 REAL*8 ID4 00082060 REAL*8 NPAR 00082070 LOGICAL ELPRT,ELPCH,GENPRT,GENPCH,DEFPCH,GEOST 00082080 INTEGER T,ZM 00082090 COMMON A(1) 00082100 COMMON /ELPAR/ NPAR(14),NUMNP,MBAND,NELTYP,N1,N2,N3,N4,N5,MTOT,NEQ00082110 $ ,N2P,N3P,NMRI,NTRI,N1P,NUMEL,NUMEL2,KZ(20,2),NEMN 00082120 COMMON/PREP/XMX,XAD,KSKIP,NDYN,I1,RRPREP(7) R0082130 DIMENSION ID4(NADND) 00082140 COMMON /ELTEMP/ TAVG,KET,NL,NOLL(100),RRELTE R0082150 COMMON /SIZE/ NDMZ,MXDF,NSMX,NRSIZE(2) R0082160 COMMON/ELARRY/NELAR(4,20) 00082170 COMMON/AMB/ GRAV,REFT,JROT R0082180 COMMON /CG/ SCG(4),RRCG(2) R0082190 COMMON/CTL/ELPRT,ELPCH,GENPRT,GENPCH 00082200 COMMON/GEOSTF/GEOST,NELGEO 00082210 COMMON/MASS/LMASS 00082220 COMMON/RIGID/IIA(20),NREX 00082230 COMMON/SLVE/NSLAVE 00082240 COMMON/BAND/KOPT,NRBAND(7) R0082250 DIMENSION ID2(13),IX(13),ISL(NSLDM,4) 00082260 DIMENSION TEMPD(NDMX,LL) 00082270 DIMENSION IA(100),ICOO(10),IFORM(4),ZDUM(9) 00082280 DATA ICOO / 3H001,3H013,3H025,3H037,3H049,3H061,3H073,3H085,3H097,00082290 $ 3H109 / 00082300 DATA IFORM(1),IFORM(3),IFORM(4)/4H(1H+,4HX,I7,4H) / 00082310 CALL FILES(8) 00082320 DO 100 I=1,4 00082330 100 SCG(I)=0.0 00082340 ZER=0.0D0 00082350 NT1=1 00082360 NT2=2 00082370 NT24=24 00082380 IF(KET.GT.0) REWIND NL 00082390 MMA=1 00082400 IF(LMASS.EQ.1)MMA=MXDF 00082410 LZ1=1 00082420 LZ2=LZ1+MXDF 00082430 LZ3=LZ2+MXDF*MXDF 00082440 LZ4=LZ3+MXDF*LL 00082450 LZ5=LZ4+MXDF 00082460 IF(LMASS.EQ.1)LZ5=LZ4+MXDF*MXDF 00082470 LZ6=LZ5+MXDF*NSMX 00082480 LZ7=LZ6+LL*NSMX 00082490 LZ8=LZ7 00082500 LZ9=LZ7 00082510 LZ10=LZ7 00082520 IF(.NOT.GEOST)GO TO 1010 00082530 LZ8=LZ7+NDMX*LL 00082540 LZ9=LZ8+MXDF*MXDF 00082550 LZ10=LZ9+MXDF*MXDF 00082560 1010 CONTINUE 00082570 K1=KZ(1,1) 00082580 KK1=KZ(1,2) 00082590 K2=KZ(2,1) 00082600 KK2=KZ(2,2) 00082610 K3=KZ(3,1) 00082620 KK3=KZ(3,2) 00082630 K4=KZ(4,1) 00082640 KK4=KZ(4,2) 00082650 K5=KZ(5,1) 00082660 KK5=KZ(5,2) 00082670 K6=KZ(6,1) 00082680 KK6=KZ(6,2) 00082690 K7=KZ(7,1) 00082700 KK7=KZ(7,2) 00082710 K8=KZ(8,1) 00082720 KK8=KZ(8,2) 00082730 K9=KZ(9,1) 00082740 KK9=KZ( 9,2) 00082750 NT30=30 00082760 REWIND NT30 00082770 K10=KZ(10,1) 00082780 KK10=KZ(10,2) 00082790 K11=KZ(11,1) 00082800 KK11=KZ(11,2) 00082810 K12=KZ(12,1) 00082820 KK12=KZ(12,2) 00082830 KK10A=KK10 00082840 IF(KK10A.EQ.0)KK10A=1 00082850 KK11A=KK11 00082860 IF(KK11A.EQ.0)KK11A=1 00082870 KK12A=KK12 00082880 IF(KK12A.EQ.0)KK12A=1 00082890 K13=KZ(13,1) 00082900 KK13=KZ(13,2) 00082910 KK13A=KK13 00082920 IF(KK13A.EQ.0)KK13A=1 00082930 K14=KZ(14,1) 00082940 IF(NREX.LE.0)GO TO 2020 00082950 IF(KOPT.LE.0)GO TO 2020 00082960 REWIND 17 00082970 READ(17)ISIR 00082980 DO 2010 I=1,NREX 00082990 NUM=A(51*(I-1)+K12) 00083000 NUM=NUM+1 00083010 DO 2010 J=2,NUM 00083020 NAM=A(51*(I-1)+K12+J-1) 00083030 NOM=ISIR(NAM) 00083040 2010 A(51*(I-1)+K12+J-1)=NOM 00083050 REWIND NT30 00083060 2020 CONTINUE 00083070 IF(NSLAVE.NE.0) READ(NT30)((ISL(I,J),J=1,4),I=1,NSLAVE) 00083080 K15=KZ(15,1) 00083090 KK15=KZ(15,2) 00083100 K16=KZ(16,1) 00083110 KK16=KZ(16,2) 00083120 K17=KZ(17,1) 00083130 KK17=KZ(17,2) 00083140 K18=KZ(18,1) 00083150 KK18=KZ(18,2) 00083160 MBAND=0 00083170 CALL RDWRT(NT1,A,1,6,M) 00083180 CALL RDWRT(NT2,A,1,6,M) 00083190 CALL RDWRT(NT24,A,1,6,M) 00083200 DO 104 M=1,LL 00083210 MP=K6+M-LL-1 00083220 KM=0 00083230 DO 103 J=1,7 00083240 MP=MP+LL 00083250 IF(A(MP).NE.0.0) KM=1 00083260 103 CONTINUE 00083270 104 NOLL(M)=KM 00083280 NPAR(1)=1 00083290 IF(KSKIP.NE.1) WRITE(6,105) 00083300 105 FORMAT(1X ,10X,69HTHE INDIVDUAL ELEMENT STIFFNESS AND LOAD MATRICE00083310 $S WILL NOW BE FORMED./ 00083320 $ 11X, 98HTHE LAST NUMBER PRINTED IS THE LAST ELEMENT TO B00083330 $E PROCESSED WHICH IS AN EVEN MULTIPLE OF TEN (10).//) 00083340 ICO=1 00083350 REWIND 68 R0083351 DO 350 M=1,NUMEL 00083360 NEL=M 00083370 IF(KSKIP.EQ.1) RETURN 00083380 CALL MEMSET (ZER,A(1),NEMN) 00083390 IF(KET.GT.0) READ (NL) TAVG,TEMPD 00083400 READ (68) ID2 R0083410 IF(NREX.GT.0)READ(NT30) IIA 00083420 DO 110 J=1,8 R0083430 NN = ID2(J) R0083440 IX(J) = NN R0083450 110 CONTINUE R0083451 KM=100 00083460 MT = ID2(13) R0083470 DO 120 J=9,13 00083480 NN = ID2(J) R0083490 IX(J) = NN R0083541 120 CONTINUE 00083500 MTYPE=IX(13) R0083510 CC WRITE (6,1008) M,MTYPE,MT,IX R0083511 C1008 FORMAT (1X,'* ID2 *',16I5/) R0083512 IF(IX(9).EQ.0) IX(9)=1 00083520 IF(IX(10).NE.0)GO TO 125 00083530 IF(MTYPE.EQ.5 .OR. MTYPE.EQ.4)GO TO 125 00083540 IF(MTYPE.EQ.2 .OR. MTYPE.EQ.9)GO TO 125 00083550 IX(10)=1 00083560 125 CONTINUE 00083570 IF(NELAR(1,MTYPE).LE.8) GO TO 140 00083580 READ (68) ID4 R0083590 ZM=10000 00083600 DO 130 J=1,NADND 00083610 T=ID4(J) 00083620 IA(J+8)=T 00083630 130 CONTINUE 00083640 140 CONTINUE 00083650 IF(.NOT.ELPRT) GO TO 1150 00083660 WRITE(6,1400)NEL 00083670 IF(ELPCH) WRITE(7,1400) NEL 00083680 1150 CONTINUE 00083690 GO TO (150,180,210,240,250,260,280,290,300,307,306,306,306,308 00083700 &,400),MTYPE 00083710 150 CONTINUE 00083730 IF(K1.GT.0) GO TO 170 00083740 KSKIP=1 00083750 WRITE(6,160) 00083760 160 FORMAT (//20X, 35HNO TRUSS TYPES HAVE BEEN SPECIFIED /20X, 00083770 $ 29HNO EXECUTION WILL BE ALLOWED.///) 00083780 RETURN 00083790 170 CONTINUE 00083800 CALL RUSS( 00083810 $ A(N1),A(K1),A(K2),A(K3),A(K4),A(K5),A(K6),A(K7),A(LZ1),A(LZ2), 00083820 $A(LZ3),A(LZ4),A(LZ5),A(LZ6),A(LZ7),A(LZ8),KK1,KK2,KK3,KK4,KK5 00083830 $,KK6,KK7,IX,IA,NEL,NUMNP,NDMX,NSMX,MXDF,MMA) 00083840 GO TO 310 00083850 180 CONTINUE 00083860 IF(K2.GT.0) GO TO 200 00083870 KSKIP=1 00083880 WRITE(6,190) 00083890 190 FORMAT (//20X, 35HNO BEAM TYPES HAVE BEEN SPECIFIED /20X, 00083900 $ 29HNO EXECUTION WILL BE ALLOWED.///) 00083910 RETURN 00083920 200 CONTINUE 00083930 CALL TEAM ( 00083940 $ A(N1),A(K1),A(K2),A(K3),A(K4),A(K5),A(K6),A(K7),A(K8), 00083950 $A(LZ1),A(LZ2),A(LZ3),A(LZ4),A(LZ5),A(LZ6),A(LZ7), 00083960 &A(LZ8),A(LZ9), 00083970 $KK1,KK2,KK3,KK4,KK5,KK6,KK7,KK8, 00083980 $IX,IA,NEL,NUMNP,NDMX,NSMX,MXDF,MMA 00083990 &,A(K11),KK11,A(K12),KK12,KK11A,KK12A,A(K13),KK13,KK13A,A(K15), 00084000 &KK15,A(K16),KK16,A(K17),KK17,A(K18),KK18,ISL,NSLDM) 00084010 GO TO 310 00084020 210 CONTINUE 00084030 IF(K3.GT.0) GO TO 230 00084040 KSKIP=1 00084050 WRITE(6,220) 00084060 220 FORMAT (//20X, 39HNO THICKNESS TYPES HAVE BEEN SPECIFIED,/20X, 00084070 $ 29HNO EXECUTION WILL BE ALLOWED.///) 00084080 RETURN 00084090 230 CONTINUE 00084100 CALL PLNAX ( 00084110 $ A(N1),A(K1),A(K2),A(K3),A(K4),A(K5),A(K6),A(K7),A(LZ1),A(LZ2), 00084120 $A(LZ3),A(LZ4),A(LZ5),A(LZ6),A(LZ7),KK1,KK2,KK3,KK4,KK5,KK6,KK7, 00084130 $IX,IA,NEL,NUMNP,NDMX,NSMX,MXDF,MMA) 00084140 GO TO 310 00084150 240 CONTINUE 00084160 CALL ASOLID( 00084170 $ A(N1),A(K1),A(K2),A(K3),A(K4),A(K5),A(K6),A(K7),A(LZ1),A(LZ2), 00084180 $A(LZ3),A(LZ4),A(LZ5),A(LZ6),A(LZ7),KK1,KK2,KK3,KK4,KK5,KK6,KK7, 00084190 $IX,IA,NEL,NUMNP,NDMX,NSMX,MXDF,MMA) 00084200 GO TO 310 00084210 250 CONTINUE 00084220 CALL BRICK8 ( 00084230 $ A(N1),A(K1),A(K2),A(K3),A(K4),A(K5),A(K6),A(K7),A(LZ1),A(LZ2), 00084240 $A(LZ3),A(LZ4),A(LZ5),A(LZ6),A(LZ7),KK1,KK2,KK3,KK4,KK5,KK6,KK7, 00084250 $IX,IA,NEL,NUMNP,NDMX,NSMX,MXDF,MMA) 00084260 GO TO 310 00084270 260 CONTINUE 00084280 IF(K3.GT.0) GO TO 270 00084290 KSKIP=1 00084300 WRITE(6,220) 00084310 RETURN 00084320 270 CONTINUE 00084330 CALL TPLATE ( 00084340 $ A(N1),A(K1),A(K2),A(K3),A(K4),A(K5),A(K6),A(K7),A(LZ1),A(LZ2), 00084350 $A(LZ3),A(LZ4),A(LZ5),A(LZ6),A(LZ7),A(LZ8),A(LZ9),A(LZ10),KK1,KK2, 00084360 $KK3,KK4,KK5,KK6,KK7,IX,IA,NEL,NUMNP,NDMX,NSMX,MXDF,MMA 00084370 & ,A(K12),KK12,KK12A,A(K14)) 00084380 GO TO 310 00084390 280 NBLANK=NBLANK+1 00084400 ZZ=7. 00084410 CALL RDWRT(NT1,ZZ,1,1,I) 00084420 GO TO 310 00084430 290 GO TO 210 00084440 300 CONTINUE CALL ELBOW( 00084450 $ A(N1),A(K1),A(K2),A(K3),A(K4),A(K5),A(K6),A(K7),A(K8), 00084460 $A(LZ1),A(LZ2),A(LZ3),A(LZ4),A(LZ5),A(LZ6),A(LZ7), 00084470 $KK1,KK2,KK3,KK4,KK5,KK6,KK7,KK8, 00084480 $IX,IA,NEL,NUMNP,NDMX,NSMX,MXDF,MMA) 00084490 GO TO 310 00084500 306 CONTINUE CALL TDFE( 00084510 $ A(N1),A(K1),A(K2),A(K3),A(K4),A(K5),A(K6),A(K7),A(LZ1),A(LZ2), 00084520 $A(LZ3),A(LZ4),A(LZ5),A(LZ6),A(LZ7),KK1,KK2,KK3,KK4,KK5,KK6,KK7, 00084530 $IX,IA,NEL,NUMNP,NDMX,NSMX,MXDF,MMA) 00084540 GO TO 310 00084550 307 CONTINUE CALL THDFE( 00084560 $ A(N1),A(K1),A(K2),A(K4),A(K5),A(K6),A(LZ1),A(LZ2), 00084570 $A(LZ3),A(LZ4),A(LZ5),A(LZ6),A(LZ7),KK1,KK2,KK4,KK5,KK6, 00084580 $IX,IA,NEL,NUMNP,NDMX,NSMX,MXDF,MMA) 00084590 GO TO 310 00084600 308 IF(KK9.GT.0) GO TO 1308 00084610 WRITE(6,2308) 00084620 2308 FORMAT(//20X,33H NO 6X6 MATRICES HAVE BEEN INPUT.//) 00084630 KSKIP=1 00084640 RETURN 00084650 1308 CONTINUE CALL SIXBY6( 00084660 $A(N1),A(K1),A(K2),A(K3),A(K4),A(K5),A(K6),A(K7),A(LZ1),A(LZ2), 00084670 $A(LZ3),A(LZ4),A(LZ5),A(LZ6),A(LZ7),KK1,KK2,KK3,KK4,KK5,KK6,KK7, 00084680 $IX, NEL,NUMNP,NDMX,NSMX,MXDF,A(K9),KK9) 00084690 GO TO 310 00084700 400 CONTINUE 00084710 CALL GESTEL(A(N1) 00084720 &,A(LZ1),A(LZ2),A(LZ3),A(LZ4),A(LZ5),A(LZ6),A(LZ7) 00084730 &,KK1,KK2,KK3,KK4,KK5,KK6,KK7,IX,IA,NEL,NUMNP,NDMX 00084740 &,NSMX,MXDF,A(K10),KK10,KK10A) 00084750 GO TO 310 00084760 310 IF(MOD(M,10)) 350,320,350 00084770 320 IFORM(2) = ICOO(ICO) 00084780 WRITE(6,9009) M R0084790 9009 FORMAT (5X,I7/) R0084781 ICO=ICO+1 00084800 IF(ICO.LT.11) GO TO 350 00084810 CC WRITE(6,340) 00084820 CC340 FORMAT(1H ) 00084830 ICO=1 00084840 350 CONTINUE 00084850 IF(NUMEL2.EQ.0) GO TO 360 00084860 CALL CLAMP ( 00084870 $ A(N1),A(K1),A(K2),A(K3),A(K4),A(K5),A(K6),A(K7),A(LZ1),A(LZ2), 00084880 $A(LZ3),A(LZ4),A(LZ5),A(LZ6),A(LZ7),KK1,KK2,KK3,KK4,KK5,KK6,KK7, 00084890 $IX,IA,NEL,NUMNP,NDMX,NSMX,MXDF) 00084900 360 WRITE(6,370) 00084910 370 FORMAT(/////20X,57(1H*)/20X,57HALL ELEMENT STIFFNESS AND LOAD MATR00084920 $ICES HAVE BEEN FORMED./20X,57(1H*)) 00084930 RETURN 00084940 1400 FORMAT(5X,17HELEMENT NUMBER = ,I5) 00084950 END 00084960 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 READ (NT) J 00199780 CALL RDA(NT,A,J) 00199790 RETURN 00199800 110 WRITE (NT) NUM 00199810 WRITE (NT) A 00199820 CC WRITE(6,1009) A C1009 FORMAT(1X,'**AA**',12E10.4/) NWDS(NT,1)=NWDS(NT,1)+NUM 00199830 RETURN 00199840 120 BACKSPACE NT 00199850 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 MATEV(MAT,NMRI,NTRI,TEMP,YM,POIS,ALF,DENS,PROP,DEN, 00130370 $NU,NEL) 00130380 IMPLICIT REAL*8 (A-H,O-Z) 00130390 REAL*8 NU 00130400 DIMENSION PROP(NTRI,4),DEN(NMRI),NU(NMRI,2) 00130410 KTEM2=0 00130420 CC REWIND 3 R0130421 CC READ (3) ((PROP(I,J),I=1,NTRI),J=1,4),(DEN(I),I=1,NMRI), R0130422 CC $ ((NU(I,J),I=1,NMRI),J=1,2) R0130423 CC WRITE (6,1008) PROP,DEN,NU C1008 FORMAT (1X,'**MA**',12E10.4/) DO 100 I=1,NMRI 00130430 MN=I 00130440 KTEM1=KTEM2+1 00130450 KTEM2=KTEM2+NU(I,2) 00130460 MX=NU(I,1) 00130470 CC WRITE (6,1009) MAT,MX,NU C1009 FORMAT (5X,'** MATEV MAT MX NU **',2I5,8E10.4/) IF(MAT.EQ.MX) GO TO 120 00130480 100 CONTINUE 00130490 MX=NU(NMRI,1) 00130500 IF(MAT.EQ.MX) GO TO 120 00130510 WRITE(6,110) MAT,NEL 00130520 110 FORMAT (1X ,20X,42H MATERIAL PROPERTIES DO NOT EXIST FOR TYPE, 00130530 $I5,11H AT ELEMENT,I5) 00130540 CALL CLOSE 00130550 CALL EXIT 00130560 120 CONTINUE 00130570 RATIO=0.0 00130580 MTN=KTEM1 00130590 MTP=MTN 00130600 IF(NU(MN,2).EQ.1) GO TO 150 00130610 DO 130 I=KTEM1,KTEM2 00130620 MTN=I-1 00130630 IF(I.EQ.KTEM1) MTN=I 00130640 IF(TEMP.LT.PROP(I,1)) GO TO 140 00130650 130 CONTINUE 00130660 140 MTP=MTN+1 00130670 DIF=PROP(MTP,1)-PROP(MTN,1) 00130680 RATIO=(TEMP-PROP(MTN,1))/DIF 00130690 150 YM=PROP(MTN,2)+(PROP(MTP,2)-PROP(MTN,2))*RATIO 00130700 POIS=PROP(MTN,3)+(PROP(MTP,3)-PROP(MTN,3))*RATIO 00130710 ALF= PROP(MTN,4)+(PROP(MTP,4)-PROP(MTN,4))*RATIO 00130720 DENS=DEN(MN) 00130730 RETURN 00130740 END 00130750 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 WRITEG(MBAND,NDIF,I,NDO,NS,LM,ST,GST) 00328070 IMPLICIT REAL*8(A-H,O-Z) 00328080 REAL*8 LM 00328090 COMMON/MASS/LMASS 00328100 COMMON/PREP/XMX,XAD,KSKIP,NDYN,I1,RRPREP(7) R0328110 COMMON/SIZE/NDMX,MXDF,NSMX,NTERM,NADND 00328120 COMMON/MISC/NZ(2),LL,NF,LB R0328130 DIMENSION LM(1),ST(1),GST(1) 00328140 ND=NDO 00328150 KST=(2+MXDF+LL)*MXDF+NSMX*MXDF+NSMX*LL+NDMX*LL-ND 00328160 IF(LMASS.EQ.1) KST=(1+MXDF+MXDF+LL)*MXDF+NSMX*MXDF+ 00328170 1NSMX*LL+NDMX*LL-ND 00328180 DO 10 NT2=1,ND 00328190 KST=KST+1 00328200 Z=LM(KST) 00328210 LM(KST)=LM(NT2) 00328220 10 LM(NT2)=Z 00328230 KST=KST-ND 00328240 Z=I 00328250 NT3=24 00328260 LSXY=MXDF*MXDF+1 00328270 LSYY=MXDF*MXDF +LSXY 00328280 CALL GSTFPK(ND,NS,MXDF,NDMX,NSMX,LL,Z,NT3,LM,ST,GST(1)) 00328290 DO 20 NT2=1,ND 00328300 KST=KST+1 00328310 Z=LM(KST) 00328320 LM(KST)=LM(NT2) 00328330 20 LM(NT2)=Z 00328340 RETURN 00328350 END 00328360 SUBROUTINE GSTFPK(ND,NS,MXDF,NDMX,NSMX,LL,Z,NT3,STIF,ST,GST) 00110490 IMPLICIT REAL*8(A-H,O-Z) 00110500 REAL*8 GST,LM 00110510 REAL*8 STIF,ST 00110520 LOGICAL ELPRT,ELPCH,GENPRT,GENPCH,GEOST,DEFPCH 00110530 DIMENSION STIF(1),ST(1),GST(1) 00110540 COMMON/CTL/ELPRT,ELPCH,GENPRT,GENPCH 00110550 COMMON/FORCE/NLC,NELD 00110560 COMMON/GEOSTF/GEOST,NELGEO 00110570 COMMON/MASS/LMASS 00110580 KOUNT=ND 00110590 KGSTF=0 00110600 DO 100 I=2,ND 00110610 KGSTF=KGSTF+MXDF 00110620 KST=KGSTF 00110630 DO 100 J=1,ND 00110640 KOUNT=KOUNT+1 00110650 KST=KST+1 00110660 100 GST(KOUNT)=GST(KST) 00110670 IF(.NOT.ELPRT) GO TO 120 00110680 WRITE(6,210)ND,NS 00110690 IF(ELPCH)WRITE(7,220)ND,NS 00110700 DO 110 I=1,ND 00110710 IF(ELPCH)WRITE(7,230)(GST(J),J=I,KOUNT,ND) 00110720 110 WRITE(6,240)(GST(J),J=I,KOUNT,ND) 00110730 120 CONTINUE 00110740 IF(Z.NE.6) GO TO 180 00110750 KGSTF=MXDF*MXDF-MXDF 00110760 DO 130 I=1,ND 00110770 KGSTF=KGSTF+MXDF 00110780 KST=KGSTF 00110790 DO 130 J=1,ND 00110800 KST=KST+1 00110810 KOUNT=KOUNT+1 00110820 130 GST(KOUNT)=GST(KST) 00110830 IF(.NOT.ELPRT) GO TO 150 00110840 WRITE(6,250) 00110850 IF(ELPCH)WRITE(7,260) 00110860 DO 140 I=1,ND 00110870 KST=ND*ND+I 00110880 IF(ELPCH)WRITE(7,230)(GST(J),J=KST,KOUNT,ND) 00110890 140 WRITE(6,240)(GST(J),J=KST,KOUNT,ND) 00110900 150 CONTINUE 00110910 KGSTF=(MXDF*MXDF)*2-MXDF 00110920 DO 160 I=1,ND 00110930 KGSTF=KGSTF+MXDF 00110940 KST=KGSTF 00110950 DO 160 J=1,ND 00110960 KST=KST+1 00110970 KOUNT=KOUNT+1 00110980 160 GST(KOUNT)=GST(KST) 00110990 IF(.NOT.ELPRT) GO TO 180 00111000 WRITE(6,270) 00111010 IF(ELPCH) WRITE(7,280) 00111020 DO 170 I=1,ND 00111030 KST=(ND*ND)*2+I 00111040 IF(ELPCH)WRITE(7,230)(GST(J),J=KST,KOUNT,ND) 00111050 170 WRITE(6,240)(GST(J),J=KST,KOUNT,ND) 00111060 180 CONTINUE 00111070 GST(KOUNT+1)=ND 00111080 GST(KOUNT+2)=Z 00111090 KOUNT=KOUNT+2+ND 00111100 KST=(2+MXDF+LL)*MXDF+NSMX*MXDF+NSMX*LL+NDMX*LL+1-ND 00111110 IF(LMASS.EQ.1) KST=(1+MXDF+MXDF+LL)*MXDF+NSMX*MXDF+ 00111120 1NSMX*LL+NDMX*LL+1-ND 00111130 CALL RDWRT(NT3,STIF(KST),KOUNT,1,K) 00111140 RETURN 00111150 210 FORMAT(1X,42HNUMBER OF DISPLACEMENTS PER ELEMENT (ND) =,I3,/, 00111160 $ 1X,42HNUMBER OF STRESSES PER ELEMENT (NS) =,I3,//, 00111170 $5X,42HNORMALIZED GEOMETRIC STIFFNESS MATRIX, GXX) 00111180 220 FORMAT(1H+,11X,6H ND=,I3,6H NS=,I3,/,5X,3HGXX) 00111190 230 FORMAT(1P8E10.3) 00111200 240 FORMAT((1H ,1P10E13.4)) 00111210 250 FORMAT(//,5X,42HNORMALIZED GEOMETRIC STIFFNESS MATRIX, GXY) 00111220 260 FORMAT(5X,3HGXY) 00111230 270 FORMAT(//,5X,42HNORMALIZED GEOMETRIC STIFFNESS MATRIX, GYY) 00111240 280 FORMAT(5X,3HGYY) 00111250 END 00111260 SUBROUTINE WRITET (MBAND,NDIF,I,NDO,NS,LM,ST) 00328370 IMPLICIT REAL*8(A-H,O-Z) 00328380 REAL*8 LM 00328390 COMMON/MASS/LMASS 00328400 COMMON/PREP/XMX,XAD,KSKIP,NDYN,I1,RRPREP(7) R0328410 COMMON/SIZE/NDMX,MXDF,NSMX,NTERM,NADND 00328420 COMMON /MISC/ NZ(2),LL,NF,LB R0328430 DIMENSION LM(1),ST(1) 00328440 ND=NDO 00328450 KST=(2+MXDF+LL)*MXDF-ND 00328460 IF(LMASS.EQ.1) KST=(1+MXDF+LL+MXDF)*MXDF-ND 00328470 DO 10 NT2=1,ND 00328480 KST=KST+1 00328490 Z=LM(KST) 00328500 LM(KST)=LM(NT2) 00328510 10 LM(NT2)=Z 00328520 KST=KST-ND 00328530 Z=I 00328540 NT1=2 00328550 NT2=1 00328560 CALL STRSPK(NT2,ND,NS,MXDF,NSMX,LL,LM,ST,Z) 00328570 DO 20 NT2=1,ND 00328580 KST=KST+1 00328590 Z=LM(KST) 00328600 LM(KST)=LM(NT2) 00328610 20 LM(NT2)=Z 00328620 MMA=1 00328630 IF(LMASS.EQ.1) MMA=MXDF 00328640 LOAD=MXDF+MXDF*MXDF+1 00328650 MASS=LOAD+MXDF*LL 00328660 CALL STIFPK(ND,MXDF,LL,NT1,LM(1),LM(MXDF+1),LM(LOAD),LM(MASS),MMA)00328670 NDIF=LM(ND)-LM(1)+1 00328680 IF(NDIF.GT.MBAND) MBAND=NDIF 00328690 110 RETURN 00328700 END 00328710 SUBROUTINE STRSPK(NT2,ND ,NS ,NDMX,NSTRMX,LL ,STIF,STR,Z) 00281810 IMPLICIT REAL*8(A-H,O-Z) 00281820 REAL*8 STIF,STR,Z 00281830 LOGICAL ELPRT,ELPCH,GENPRT,GENPCH,DEFPCH,GEOST 00281840 DIMENSION STIF(1),STR(1) 00281850 COMMON/CTL/ELPRT,ELPCH,GENPRT,GENPCH 00281860 COMMON/GEOSTF/GEOST,NELGEO 00281870 COMMON/MASS/LMASS 00281880 KOUNT=NS 00281890 KSTR=0 00281900 DO 100 I=2,ND 00281910 KSTR=KSTR+NSTRMX 00281920 KST=KSTR 00281930 DO 100 J=1,NS 00281940 KOUNT=KOUNT+1 00281950 KST=KST+1 00281960 100 STR(KOUNT)=STR(KST) 00281970 IF(.NOT.ELPRT) GO TO 1100 00281980 IF(.NOT.GEOST) GO TO 1010 00281990 WRITE(6,180) 00282000 GO TO 1015 00282010 1010 CONTINUE 00282020 WRITE(6,120)ND,NS 00282030 IF(ELPCH)WRITE(7,130)ND,NS 00282040 1015 CONTINUE 00282050 DO 1020 I=1,NS 00282060 IF(ELPCH) WRITE(7,140)(STR(J),J=I,KOUNT ,NS) 00282070 1020 WRITE(6,150)(STR(J),J=I,K OUNT,NS) 00282080 1100 CONTINUE 00282090 KSTR=NDMX*NSTRMX-NSTRMX 00282100 DO 110 I=1,LL 00282110 KSTR=KSTR+NSTRMX 00282120 KST=KSTR 00282130 DO 110 J=1,NS 00282140 KST=KST+1 00282150 KOUNT=KOUNT+1 00282160 110 STR(KOUNT)=STR(KST) 00282170 IF(.NOT.ELPRT) GO TO 1200 00282180 WRITE(6,160) 00282190 DO 1190 I=1,NS 00282200 KST=NS*ND+I 00282210 IF(ELPCH) WRITE(7,140) (STR(J),J=KST,K OUNT,NS) 00282220 WRITE(6,170)(STR(J),J=KST,K OUNT,NS) 00282230 1190 CONTINUE 00282240 1200 CONTINUE 00282250 STR(KOUNT+1)=ND 00282260 STR(KOUNT+2)=NS 00282270 STR(KOUNT+3)=Z 00282280 KOUNT=KOUNT+3+ND 00282290 KST=(2+NDMX+LL)*NDMX+1-ND 00282300 IF(LMASS.EQ.1) KST=(1+NDMX+NDMX+LL)*NDMX+1-ND 00282310 CC CALL RDWRT(NT2,STIF(KST),KOUNT,1,K) R0282320 KSTRR=KST+KOUNT-1 R0282321 WRITE (21) KOUNT R0282322 WRITE (21) (STIF(IIR),IIR=KST,KSTRR) R0282323 RETURN 00282330 120 FORMAT(1X,42HNUMBER OF DISPLACEMENTS PER ELEMENT (ND) =,I3,/, 00282340 $ 1X,42HNUMBER OF STRESSES PER ELEMEET (NS) ,I3,//, 00282350 $1X,34HELEMENT STRESS-DISPLACEMENT MATRIX) 00282360 130 FORMAT(1H+,11X,6H ND=,I3,6H NS=,I3) 00282370 140 FORMAT(1P8E10.3) 00282380 150 FORMAT( (1H ,1P10E13.4)) 00282390 160 FORMAT(/1X,28HELEMENT FIXED-NODE STRESSES ) 00282400 170 FORMAT( (1H ,1P4E13.4)) 00282410 180 FORMAT(//,1X,34HELEMENT STRESS-DISPLACEMENT MATRIX) 00282420 END 00282430 SUBROUTINE STIFPK(ND1,NDMX,LL,NT1,STIF,S,LOAD,MASS,MMA) 00271190 IMPLICIT REAL*8(A-H,O-Z) 00271200 REAL*8 S(NDMX,NDMX),LOAD(NDMX,LL),MASS(NDMX,MMA),T 00271210 REAL*8 STIF 00271220 LOGICAL ELPRT,ELPCH,GENPRT,GENPCH 00271230 DIMENSION STIF(1) 00271240 COMMON/CTL/ELPRT,ELPCH,GENPRT,GENPCH 00271250 COMMON /FORCE/ NLC,NELD 00271260 COMMON/MASS/LMASS 00271270 IF(.NOT.ELPRT) GO TO 1100 00271280 WRITE(6,160)(STIF(I),I=1,ND1) 00271290 IF(ELPCH) WRITE(7,180)(STIF(I),I=1,ND1) 00271300 WRITE(6,170) 00271310 DO 1020 I=1,ND1 00271320 IF(ELPCH) WRITE(7,180)(S(I,J),J=1,ND1) 00271330 1020 WRITE(6,190)(S(I,J),J=1,ND1) 00271340 INLL=8 00271350 IF(LL.LT.8) INLL=LL 00271360 DO 1040 J=1,LL,INLL 00271370 K=J+INLL-1 00271380 WRITE(6,220)J,K 00271390 K=J-1 00271400 DO 1040 I=1,ND1 00271410 IF(ELPCH) WRITE(7,180) (LOAD(I,K+L),L=1,INLL) 00271420 1040 WRITE(6,200) (LOAD(I,K+L),L=1,INLL) 00271430 IF(LMASS.NE.1)GO TO 1070 00271440 WRITE(6,230) 00271450 DO 1060 I=1,ND1 00271460 IF(ELPCH) WRITE(7,180)(MASS(I,J),J=1,ND1) 00271470 1060 WRITE(6,190)(MASS(I,J),J=1,ND1) 00271480 GO TO 1100 00271490 1070 CONTINUE 00271500 IF(ELPCH) WRITE(7,180)(MASS(I,1),I=1,ND1) 00271510 WRITE(6,210) (MASS(I,1),I=1,ND1) 00271520 1100 CONTINUE 00271530 IF(ND1.EQ.1) GO TO 8 00271540 NDM=ND1-1 00271550 DO 7 J=1,NDM 00271560 IF(STIF(J).LE.0.) GO TO 7 00271570 JP1=J+1 00271580 DO 6 I=JP1,ND1 00271590 IF(STIF(J).NE.STIF(I)) GO TO 6 00271600 DO 1 K=1,J 00271610 IF(LMASS.EQ.1) MASS(J,K)=MASS(J,K)+MASS(I,K) 00271620 1 S(J,K)=S(J,K)+S(I,K) 00271630 IM1=I-1 00271640 DO 2 K=J,IM1 00271650 IF(LMASS.EQ.1) MASS(K,J)=MASS(K,J)+MASS(I,K) 00271660 2 S(K,J)=S(K,J)+S(I,K) 00271670 IP1=I+1 00271680 IF(IP1.GT.ND1) GO TO 4 00271690 DO 3 K=IP1,ND1 00271700 IF(LMASS.EQ.1) MASS(K,J)=MASS(K,J)+MASS(K,I) 00271710 3 S(K,J)=S(K,J)+S(K,I) 00271720 4 STIF(I)=0.0 00271730 IF(LMASS.EQ.1) MASS(J,J)=MASS(J,J)+MASS(I,I) 00271740 S(J,J)=S(J,J)+S(I,I) 00271750 DO 5 K=1,LL 00271760 5 LOAD(J,K)=LOAD(J,K)+LOAD(I,K) 00271770 IF(LMASS.EQ.1) GO TO 6 00271780 MASS(J,1)=MASS(J,1)+MASS(I,1) 00271790 6 CONTINUE 00271800 7 CONTINUE 00271810 8 CONTINUE 00271820 I=ND1 00271830 10 EMAX=STIF(1) 00271840 J=1 00271850 DO 40 K=1,I 00271860 IF(STIF(K).GT.0.0) GO TO 30 00271870 J=K 00271880 GO TO 50 00271890 30 IF(STIF(K).LT.EMAX) GO TO 40 00271900 EMAX=STIF(K) 00271910 J=K 00271920 40 CONTINUE 00271930 50 IF(I.EQ.J)GO TO 90 00271940 JM1=J-1 00271950 IF(JM1.LT.1) GO TO 60 00271960 DO 55 K=1,JM1 00271970 IF(LMASS.NE.1) GO TO 1150 00271980 T=MASS(I,K) 00271990 MASS(I,K)=MASS(J,K) 00272000 MASS(J,K)=T 00272010 1150 CONTINUE 00272020 T=S(I,K) 00272030 S(I,K)=S(J,K) 00272040 55 S(J,K)=T 00272050 60 JP1=J+1 00272060 IM1=I-1 00272070 IF(JP1.GT.IM1) GO TO 70 00272080 DO 65 K=JP1,IM1 00272090 IF(LMASS.NE.1) GO TO 1160 00272100 T=MASS(K,J) 00272110 MASS(K,J)=MASS(I,K) 00272120 MASS(I,K)=T 00272130 1160 CONTINUE 00272140 T=S(K,J) 00272150 S(K,J)=S(I,K) 00272160 65 S(I,K)=T 00272170 70 IP1=I+1 00272180 IF(IP1.GT.ND1) GO TO 78 00272190 DO 75 K=IP1,ND1 00272200 IF(LMASS.NE.1) GO TO 1170 00272210 T=MASS(K,I) 00272220 MASS(K,I)=MASS(K,J) 00272230 MASS(K,J)=T 00272240 1170 CONTINUE 00272250 T=S(K,I) 00272260 S(K,I)=S(K,J) 00272270 75 S(K,J)=T 00272280 78 T=S(I,I) 00272290 S(I,I)=S(J,J) 00272300 S(J,J)=T 00272310 IF(LMASS.NE.1) GO TO 1175 00272320 T=MASS(I,I) 00272330 MASS(I,I)=MASS(J,J) 00272340 MASS(J,J)=T 00272350 1175 CONTINUE 00272360 DO 80 K=1,LL 00272370 T=LOAD(I,K) 00272380 LOAD(I,K)=LOAD(J,K) 00272390 80 LOAD(J,K)=T 00272400 T=STIF(I) 00272410 STIF(I)=STIF(J) 00272420 STIF(J)=T 00272430 IF(LMASS.EQ.1) GO TO 90 00272440 T=MASS(I,1) 00272450 MASS(I,1)=MASS(J,1) 00272460 MASS(J,1)=T 00272470 90 IF(STIF(I).EQ.0.0) ND1=ND1-1 00272480 I=I-1 00272490 IF(I.GT.0) GO TO 10 00272500 IF(ND1.LE.0) ND1=1 00272510 KOUNT=ND1 00272520 KST=0 00272530 DO 100 I=1,ND1 00272540 KST=KST+NDMX 00272550 KK=KST+I-1 00272560 DO 100 J=I,ND1 00272570 KK=KK+1 00272580 KOUNT=KOUNT+1 00272590 100 STIF(KOUNT)=STIF(KK) 00272600 IF(NELD.EQ.0) GO TO 115 00272610 KST=NDMX*NDMX 00272620 DO 110 I=1,LL 00272630 KST=KST+NDMX 00272640 KK=KST 00272650 DO 110 J=1,ND1 00272660 KK=KK+1 00272670 KOUNT=KOUNT+1 00272680 110 STIF(KOUNT)=STIF(KK) 00272690 115 CONTINUE 00272700 IF(LMASS.EQ.1) GO TO 1200 00272710 KK =NDMX*NDMX+NDMX*LL +NDMX 00272720 DO 120 I=1,ND1 00272730 KK=KK+1 00272740 KOUNT=KOUNT+1 00272750 120 STIF(KOUNT)=STIF(KK) 00272760 GO TO 1250 00272770 1200 CONTINUE 00272780 KST=NDMX*NDMX+NDMX*LL 00272790 DO 1210 I=1,ND1 00272800 KST=KST+NDMX 00272810 KK=KST+I-1 00272820 DO 1210 J=I,ND1 00272830 KK=KK+1 00272840 KOUNT=KOUNT+1 00272850 1210 STIF(KOUNT)=STIF(KK) 00272860 1250 CONTINUE 00272870 KOUNT=KOUNT+1 00272880 STIF(KOUNT)=ND1 00272890 CALL RDWRT(NT1,STIF,KOUNT,1,I) 00272900 CC WRITE(21) (STIF(II),II=1,KOUNT) R0272901 160 FORMAT(/1X,22HELEMENT LOCATION MATRX,/,(1H ,10F13.0)) 00272910 170 FORMAT(/1X,24HELEMENT STIFFNESS MATRIX) 00272920 180 FORMAT((1P8E10.3)) 00272930 190 FORMAT( (1H ,1P10E13.4)) 00272940 200 FORMAT( (1H ,1P8E13.4)) 00272950 210 FORMAT(/1X,19HELEMENT MASS MATRIX,/,(1H ,1P10E13.4)) 00272960 220 FORMAT(/1X,32HELEMENT LOAD MATRIX - LOAD CASES,I5,3X,2HTO,I5) 00272970 230 FORMAT(/1X,19HELEMENT MASS MATRIX) 00272980 RETURN 00272990 END 00273000 SUBROUTINE CENT(X,Y,AXN,AYN) 00038210 IMPLICIT REAL*8(A-H,O-Z) 00038220 AYN=Y 00038230 AXN=0.0 00038240 IF(X.EQ.0.0) RETURN 00038250 R=DSQRT(X**2+Y**2) 00038260 THET=DATAN2(Y,X) 00038270 10 AYN=R*DSIN(THET) 00038280 AXN=R*DCOS(THET) 00038290 RETURN 00038300 END 00038310 SUBROUTINE RUSS( 00217110 $ID,PROP1,PROP2,PROP3,PROP4,PROP5,PROP6,PROP7,LM,S,P,XM,ST,TT,TEMPD00217120 $,GSXX 00217130 $,KK1,KK2,KK3,KK4,KK5,KK6,KK7,IX,IA,NEL,NUMNP,NDMX,NSMX,MXDF,MMA) 00217140 IMPLICIT REAL*8(A-H,O-Z) 00217150 REAL*8 NPAR 00217160 REAL*8 LM 00217170 REAL*8 ID 00217180 REAL*8MODUE 00217190 LOGICAL DEFPCH,GEOST 00217200 COMMON A(1) 00217210 DIMENSION PROP1(KK1,2),PROP6(KK6,7) 00217220 DIMENSION IX(13),IA(100) 00217230 DIMENSION ID(NUMNP,3) 00217240 COMMON /ELTEMP/ TAVG,KET,NRELTE(103) R0217250 COMMON/MASS/LMASS 00217260 COMMON/MATL/MATLCO R0217261 COMMON /CG/ SCG(4),RRCG(2) R0217270 COMMON / MISC / NBLOCK,NEQB,LL,NF,LB 00217280 COMMON/AMB/ GRAV,REFT,JROT 00217290 COMMON /QTSARG/FN(4),FTH(4),RRQTSA(992) R0217300 COMMON /ELPAR/ NPAR(14),NNNNN,MBAND,NELTYP,N1,N2,N3,N4,N5,MTOT,NEQ00217310 $ ,N2P,N3P,NMRI,NTRI,N1P,NUMEL,NUMEL2,KZ(20,2),NEMN 00217320 DIMENSION LM(MXDF),S(MXDF,MXDF),P(MXDF,KK6), XM(MXDF,MMA) 00217330 DIMENSION ST(NSMX,MXDF),TT(NSMX,KK6),TEMPD(NDMX,KK6) 00217340 COMMON /JUNK/ EMUL(4,4),I,J,K,L,M,N,II,JJ,KK,MTYPE,TEMP,DX,DY,DZ, 00217350 $ XL2,XL,XX,YY,F,FT,FX,FY,FZ,MIN,MAX,NDIF,KKK,TEM,MTYP,NRJUNK(379) R0217360 COMMON/PREP/XMX,XAD,KSKIP,NDYN,I1,RRPREP(7) R0217370 COMMON/GEOSTF/GEOST,NELGEO 00217380 DIMENSION GSXX(MXDF,MXDF) 00217390 I=IX(1) 00217400 J=IX(2) 00217410 MTYPE=IX(9) 00217420 IF(MTYPE .LE.KK1) GO TO 110 00217430 WRITE(6,100)NEL 00217440 100 FORMAT (//20X, 26HTHE TRUSS TYPE FOR ELEMENT,I5,/20X, 00217450 $ 35HDOES NOT EXIST, EXECUTION WILL STOP//) 00217460 KSKIP=1 00217470 RETURN 00217480 110 CONTINUE 00217490 MAT=PROP1(MTYPE,1) 00217500 IF (MAT.GT.18.AND.NTRI.EQ.0)WRITE(6,120)NEL 00217510 IF (MAT.GT.18.AND.NTRI.EQ.0) MAT=1 00217520 120 FORMAT (//20X, 45HNO USER SUPPLIED MATERIALS ARE AVAIL. FOR EL.,I500217530 $/) 00217540 AREA=PROP1(MTYPE,2) 00217550 TEMP=TAVG 00217560 IF(MAT .GT.18) GO TO 130 00217570 YM=MODUE(TEMP,MAT) 00217580 POIS=PRATO(TEMP,MAT ) 00217590 CTEX=ALPHZM(TEMP,MAT ) 00217600 DEN=DENS(TEMP,MAT ) /1728. 00217610 GO TO 140 00217620 130 CALL MATEV(MAT ,NMRI,NTRI,TEMP,YM,POIS,CTEX,DEN, 00217630 $A(N1P),A(N2P),A(N3P),NEL) 00217640 140 CONTINUE 00217650 E=YM 00217660 150 IF (KSKIP.EQ.1) GO TO 200 00217670 CALL UNPKID ( ID ,NUMNP,W ,DX ,1,I ,1) 00217680 CALL UNPKID ( ID ,NUMNP,W ,DY ,1,I ,2) 00217690 CALL UNPKID ( ID,NUMNP,W ,DZ ,1,I ,3) 00217700 CALL UNPKID ( ID ,NUMNP,W ,XX ,1,J ,1) 00217710 CALL UNPKID ( ID ,NUMNP,W ,YY ,1,J ,2) 00217720 CALL UNPKID ( ID,NUMNP,W ,ZZ ,1,J ,3) 00217730 CALL CENT(DX,DY,FN(1),FN(2)) 00217740 CALL CENT(XX,YY,FN(3),FN(4)) 00217750 FTH(1)= FN(2) 00217760 FTH(2)=-FN(1) 00217770 FTH(3)= FN(4) 00217780 FTH(4)=-FN(3) 00217790 DX=DX-XX 00217800 DY=DY-YY 00217810 DZ=DZ-ZZ 00217820 XL2=DX*DX+DY*DY+DZ*DZ 00217830 XL= DSQRT(XL2) 00217840 XX=E*AREA*XL 00217850 ST(1,1)=DX/XL2 00217860 ST(1,2)=DY/XL2 00217870 ST(1,3)=DZ/XL2 00217880 ST(1,4)=-ST(1,1) 00217890 ST(1,5)=-ST(1,2) 00217900 ST(1,6)=-ST(1,3) 00217910 DO 170 L=1,6 00217920 YY=ST(1,L)*XX 00217930 DO 160 K=L,6 00217940 S(K,L)=ST(1,K)*YY 00217950 160 S(L,K)=S(K,L) 00217960 ST(1,L)=E *ST(1,L) 00217970 170 ST(2,L)=AREA*ST(1,L) 00217980 F=DEN*AREA*XL/2. 00217990 DO 171 L=1,4 00218000 FN(L)=FN(L)*F/GRAV 00218010 171 FTH(L)=FTH(L)*F/GRAV 00218020 FT=CTEX*AREA*E 00218030 FX=DX*FT/XL 00218040 FY=DY*FT/XL 00218050 FZ=DZ*FT/XL 00218060 DO 180 L=1,LL 00218070 ACX=PROP6(L,5) 00218080 ACZ=PROP6(L,7) 00218090 ACY=PROP6(L,6) 00218100 TOPT=PROP6(L,2) 00218110 TMR=0.0 00218120 IF(TOPT.EQ.1) TMR=(TEMPD(1,L)+TEMPD(2,L))/2.-REFT 00218130 IF(TOPT.EQ.2.0) TMR= PROP6(L,3)-REFT 00218140 TT(2,L)=-FT*TMR 00218150 TT(1,L)=TT(2,L)/AREA 00218160 TMR=-TMR 00218170 P(1,L)=-TMR*FX 00218180 P(2,L)=-TMR*FY 00218190 P(4,L)= TMR*FX 00218200 P(5,L)= TMR*FY 00218210 IF(JROT.EQ.1) GO TO 176 00218220 P(1,L)=P(1,L)+ACX*F 00218230 P(2,L)=P(2,L)+ACY*F 00218240 P(4,L)=P(4,L)+ACX*F 00218250 P(5,L)=P(5,L)+ACY*F 00218260 GO TO 177 00218270 176 P(1,L)=P(1,L)+ACX*FN(1)+FTH(1)*ACY 00218280 P(2,L)=P(2,L)+ACX*FN(2)+FTH(2)*ACY 00218290 P(4,L)=P(4,L)+ACX*FN(3)+FTH(3)*ACY 00218300 P(5,L)=P(5,L)+ACX*FN(4)+FTH(4)*ACY 00218310 177 CONTINUE 00218320 P(3,L)=ACZ*F-TMR*FZ 00218330 P(4,L)=ACX*F+TMR*FX 00218340 P(5,L)=ACY*F+TMR*FY 00218350 180 P(6,L)=ACZ*F+TMR*FZ 00218360 F=DEN*AREA*XL/2./GRAV 00218370 IF(LMASS.EQ.1) GO TO 1190 00218380 DO 190 L=1,6 00218390 190 XM(L,1)=F 00218400 GO TO 1250 00218410 1190 CONTINUE 00218420 DO 1210 L=1,6 00218430 DO 1200 K=1,6 00218440 1200 XM(L,K)=0.0E0 00218450 1210 XM(L,L)=F 00218460 1250 CONTINUE 00218470 IF(.NOT.GEOST)GO TO 200 00218480 DO 10 L=1,6 00218490 DO 10 K=1,6 00218500 10 GSXX(L,K)=0.0D0 00218510 CX=DX/XL 00218520 CY=DY/XL 00218530 CZ=DZ/XL 00218540 XLIN=1.0D0/XL 00218550 IF(CX.EQ.0.0.AND.CZ.EQ.0.0)GO TO 40 00218560 CXZ=CX**2+CZ**2 00218570 GSXX(1,1)=((CX**2)*(CY**2)+CZ**2)/CXZ 00218580 GSXX(1,2)=-CX*CY 00218590 GSXX(1,3)=(CX*CZ*(CY**2-1.0D0))/CXZ 00218600 GSXX(2,2)=CXZ 00218610 GSXX(2,3)=-CY*CZ 00218620 GSXX(3,3)=((CY**2)*(CZ**2)+CX**2)/CXZ 00218630 GSXX(1,4)=GSXX(1,1) 00218640 GSXX(1,5)=CX*CY 00218650 GSXX(1,6)=-GSXX(1,3) 00218660 GSXX(2,4)=CX*CY 00218670 GSXX(2,5)=-CXZ 00218680 GSXX(2,6)=CY*CZ 00218690 GSXX(3,4)=-GSXX(1,3) 00218700 GSXX(3,5)=CY*CZ 00218710 GSXX(3,6)=-GSXX(3,3) 00218720 GSXX(4,4)=GSXX(1,1) 00218730 GSXX(4,5)=-CX*CY 00218740 GSXX(4,6)=GSXX(1,3) 00218750 GSXX(5,5)=CXZ 00218760 GSXX(5,6)=-CY*CZ 00218770 GSXX(6,6)=GSXX(3,3) 00218780 DO 20 L=1,6 00218790 DO 20 K=L,6 00218800 20 GSXX(K,L)=GSXX(L,K) 00218810 DO 30 L=1,6 00218820 DO 30 K=1,6 00218830 30 GSXX(L,K)=XLIN*GSXX(L,K) 00218840 GO TO 200 00218850 40 GSXX(1,1)=XLIN*CY*CY 00218860 GSXX(1,4)=-GSXX(1,1) 00218870 GSXX(4,1)=-GSXX(1,1) 00218880 GSXX(4,4)=GSXX(1,1) 00218890 GSXX(3,3)=XLIN 00218900 GSXX(3,6)=-XLIN 00218910 GSXX(6,3)=-XLIN 00218920 GSXX(6,6)=XLIN 00218930 200 CONTINUE 00218940 DO 210 L=1,3 00218950 CALL UNPKID ( ID ,NUMNP,LM(L) ,DX ,2,I ,L) 00218960 210 CALL UNPKID ( ID,NUMNP,LM(L+3),DX ,2,J ,L) 00218970 ND=6 00218980 NS=2 00218990 XMCG=XM(1,1) 00219000 DO 220 I=1,2 00219010 NPNT=IX(I) 00219020 SCG(4)=SCG(4)+XMCG 00219030 DO 220 J=1,3 00219040 CALL UNPKID(ID,NUMNP,W,CORD,1,NPNT,J) 00219050 220 SCG(J)=SCG(J)+XMCG*CORD 00219060 IF(.NOT.GEOST) GO TO 1220 00219070 CALL WRITEG(MBAND,NDIF,1,ND,NS,LM,ST,GSXX) 00219080 1220 CONTINUE 00219090 CALL WRITET(MBAND,NDIF,1,ND,NS,LM,ST) 00219100 RETURN 00219110 END 00219120 SUBROUTINE RIGMAT(KK12,KK12A,P12,S,MXDF,NUMNP, 00211050 & IX,NERRT,NERR,NUMN,ID,II1,RF,SA,NSMX,LL,KSKIP,NEL,NDOFN) 00211060 IMPLICIT REAL*8 (A-H,O-Z) 00211070 DIMENSION P12(51,KK12A),CC(48,48),S(MXDF,MXDF),IX(1) 00211090 &,NP(8),XI(3,8),XP(3,8),DX(3),ID(NUMNP,1),CIN(3,3) 00211100 &,DUM(48,48),AD2(5),RF(MXDF,1),SA(NSMX,MXDF) 00211110 COMMON/BMDATA/IAISC,ILDTYP,ILDMUL,IBMSEC,NLWAVE,ILOCAL R0211080 IF(KK12.LE.0)RETURN 00211120 NT30=30 00211130 DO 1 I=1,NUMN 00211140 1 NP(I)=0 00211150 DO 5 I=1,KK12 00211160 NUM=P12(1,I) 00211170 N2=NUM+1 00211180 DO 5 J=3,N2 00211190 DO 2 K=1,NUMN 00211200 2 IF(IX(K).EQ.P12(J,I))NP(K)=P12(2,I) 00211210 5 CONTINUE 00211220 DO 6 I=1,NUMN 00211230 IF(NP(I).NE.0)GO TO 7 00211240 6 CONTINUE 00211250 RETURN 00211260 7 NERR=1 00211270 N2=NUMN-1 00211280 DO 9 I=1,N2 00211290 N1=I+1 00211300 IF(NP(I).EQ.0)GO TO 9 00211310 DO 8 J=N1,NUM 00211320 8 IF(NP(J).EQ.NP(I))NERR=NERR+1 00211330 9 CONTINUE 00211340 IF(NERR.GT.NERRT)WRITE(6,1000)NEL,NERR,NERRT 00211350 1000 FORMAT(19H FATAL ERROR. ****./9H ELEMENT,I5, 00211360 &4H HAS,I5,32H CONNECTIONS TO A RIGID ELEMENT. 00211370 $,43H THE MAXIMUM PERMITTED FOR THIS ELEMENT IS,I5) 00211380 IF(NERR.GT.NERRT)KSKIP=1 00211390 IF(NERR.GT.NERRT)RETURN 00211400 ND=NDOFN*NUMN 00211410 DO 11 I=1,ND 00211420 DO 10 J=1,ND 00211430 10 CC(I,J)=0.D0 00211440 11 CC(I,I)=1.D0 00211450 DO 20 I=1,NUMN 00211460 DO 20 J=1,3 00211470 CALL UNPKID(ID,NUMNP,X,XI(J,I),1,IX(I),J) 00211480 IF(NP(I).NE.0) 00211490 &CALL UNPKID(ID,NUMNP,X,XP(J,I),1,NP(I),J) 00211500 20 CONTINUE 00211510 DO 23 I=1,3 00211520 DO 23 J=1,3 00211530 23 CIN(I,J)=0.D0 00211540 DO 40 I=1,NUMN 00211550 IF(NP(I).EQ.0)GO TO 40 00211560 DO 25 J=1,3 00211570 25 DX(J)=XP(J,I)-XI(J,I) 00211580 CIN(1,2)=DX(3) 00211590 CIN(1,3)=-DX(2) 00211600 CIN(2,3)=DX(1) 00211610 CIN(2,1)=-DX(3) 00211620 CIN(3,1)=DX(2) 00211630 CIN(3,2)=-DX(1) 00211640 M1=6*(I-1)+3 00211650 M2=6*(I-1) 00211660 DO 30 J=1,3 00211670 JJ=J+M1 00211680 DO 30 K=1,3 00211690 KK=K+M2 00211700 30 CC(KK,JJ)=CIN(J,K) 00211710 40 CONTINUE 00211720 DO 50 I=1,ND 00211730 DO 50 J=1,ND 00211740 DUM(I,J)=0.D0 00211750 DO 50 K=1,ND 00211760 50 DUM(I,J)=DUM(I,J)+S(I,K)*CC(K,J) 00211770 DO 60 I=1,ND 00211780 DO 60 J=1,ND 00211790 S(I,J)=0.D0 00211800 DO 60 K=1,ND 00211810 60 S(I,J)=S(I,J)+CC(K,I)*DUM(K,J) 00211820 IF(LL.LE.0)GO TO 75 00211830 DO 70 K=1,LL 00211840 DO 68 I=1,ND 00211850 DUM(I,1)=0.D0 00211860 DO 68 J=1,ND 00211870 68 DUM(I,1)=DUM(I,1)+CC(J,I)*RF(J,K) 00211880 DO 69 I=1,ND 00211890 69 RF(I,K)=DUM(I,1) 00211900 70 CONTINUE 00211910 75 CONTINUE 00211920 NSMXX=NSMX 00211930 IF(IAISC.EQ.1) NSMXX=NSMX-2 00211940 DO 80 I=1,NSMXX 00211950 DO 79 J=1,ND 00211960 DUM(1,J)=0.D0 00211970 DO 79 K=1,ND 00211980 79 DUM(1,J)=DUM(1,J)+SA(I,K)*CC(K,J) 00211990 DO 80 J=1,ND 00212000 80 SA(I,J)=DUM(1,J) 00212010 RETURN 00212020 END 00212030