Liren Large Software Subsidy 9

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

/ Liren Large Software Subsidy 9 / 09.iso / e / e003 / 3.ddi / MODEL05.FOR next >

Wrap

Text File | 1980-01-04 | 94.6 KB | 1,183 lines

SUBROUTINE PTS2 (P1,P2,P3,A,B,C,D) 00183190 IMPLICIT REAL*8 (A-H,O-Z) 00183200 DIMENSION P1(3),P2(3),P3(3) 00183210 A=P2(1)-P1(1) 00183220 B=P2(2)-P1(2) 00183230 C=P2(3)-P1(3) 00183240 D=A*P3(1)+B*P3(2)+C*P3(3) 00183250 RETURN 00183260 END 00183270 SUBROUTINE PTS3 (P1,P2,A,B,C,D,P3) 00183280 IMPLICIT REAL*8 (A-H,O-Z) 00183290 REAL*8 NX,NY,NZ 00183300 DIMENSION P1(3),P2(3),P3(3) 00183310 NX=P2(1)-P1(1) 00183320 NY=P2(2)-P1(2) 00183330 NZ=P2(3)-P1(3) 00183340 IF (NX.EQ.0.) GO TO 10 00183350 P3(1)= (D+B*NY/NX*P1(1)-B*P1(2)+C*NZ/NX*P1(1)-C*P1(3)) 00183360 $ / (A+B*NY/NX+C*NZ/NX) 00183370 P3(2)= NY*(P3(1)-P1(1))/NX+P1(2) 00183380 P3(3)= NZ*(P3(1)-P1(1))/NX+P1(3) 00183390 GO TO 30 00183400 10 CONTINUE 00183410 IF (NZ.EQ.0.) GO TO 20 00183420 P3(3)= (D-A*P1(1)+B*NY/NZ*P1(3)-B*P1(2))/(B*NY/NZ+C) 00183430 P3(1)= P1(1) 00183440 P3(2)= NY/NZ*(P3(3)-P1(3))+P1(2) 00183450 GO TO 30 00183460 20 CONTINUE 00183470 P3(1)= P1(1) 00183480 P3(3)= P1(3) 00183490 P3(2)= (D-A*P1(1)-C*P1(3))/B 00183500 30 CONTINUE 00183510 RETURN 00183520 END 00183530 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 ELINP(NUMEL,ID2,NE,NZZ,ID4,NEAD,NZZAD,NADND,NDKOD) 00077180 IMPLICIT REAL*8(A-H,O-Z) 00077190 REAL*8 MLT2 00077200 REAL*8 ID2,ID4 00077210 DIMENSION ID2(NZZ,13),ID4(NZZAD,NADND) 00077220 COMMON /PREP/ XMX,XAD,KSKIP,NDYN,I1,I99,POS,PRTCOD 00077230 $ ,POSSAV,PRTOFF,PRTON,PRTDUM,IDIRC 00077240 COMMON/JUNK/IX(8),IXI(8),IP(4),IPI(5),I,J,N,MT, 00077250 $MTYPI,MTYP,K1,K2,K3,KN1,KN2,NI,KO,L,NG,MG,KM,NNI,NRJUNK(411) R0077260 COMMON /ELARRY/NELAR(4,20) 00077270 COMMON/TRASH/ IA(100),IAI(100),RRTRAS(390) R0077280 BLANK=700000000. 00077290 MLT=10000 00077300 MLT2=MLT*MLT 00077310 CALL FILES(27) 00077320 IF (NE.GT.1) REWIND 4 00077330 IF (NE.GT.1) READ (4) ((ID2(I,J),J=1,13),I=1,NE) 00077340 IF(NEAD.GT.1) READ (4) ((ID4(I,J),J=1,NADND),I=1,NEAD) 00077350 IF(NEAD.GT.1) NEAD=NEAD+1 00077360 IF(NE.GT.1) NE=NE+1 00077370 IF(NE.GE.NUMEL) GO TO 120 00077380 DO 110 I=NE,NUMEL 00077390 DO 100 J=1,12 00077400 100 ID2(I,J)=0.0 00077410 ID2(I,13)=7. 00077420 110 CONTINUE 00077430 120 CONTINUE 00077440 IF(PRTCOD.EQ.PRTOFF) GO TO 155 00077450 IF(POS.EQ.PRTDUM.AND.PRTCOD.NE.PRTON) GO TO 155 00077460 WRITE(6,130) 00077470 130 FORMAT (1X ,20X, 22H ELEMENT DATA AS INPUT///) 00077480 WRITE(6,140) 00077490 140 FORMAT (20X, 00077500 $ 50HN1-MATL. NO. OR GEOMETRIC PROPERTY (TRUSS OR BEAM)//20X, 00077510 $ 90HN2-THICK TYPE - PLANE STRESS OR SHELL ELEMENTS OR INTEGRATIO00077520 *N ORDER FOR THE SOLID ELEMENT /23X, 00077530 $44HOR SECTION PROPERTY TYPE NO FOR BEAM ELEMENT //20X, 00077540 $ 67HN3-PRESSURE SET NO.- SOLID ELEMENTS, SHELL ELEMENTS OR AXI00077550 $SYMMETRIC//20X, 00077560 $ 57HN4-STRESS FACES - SOLID ELEMENT OR END RELEASE SET - BEA00077570 $M /23X, 00077580 $50HOR SECTION PROPERTY TYPE NO FOR CURVED BEAM(ELBOW) //20X, 00077590 $50HN5 - BEAM EFFECTIVE LENGTH AND AISC CATX(Y) TYPE ///) 00077600 WRITE(6,150) 00077610 150 FORMAT (20X, 13HELEMENT TYPE//20X, 00077620 $ 60H NO. NO. I J K L M N O P/N5 N1,00077630 $3X, 23HN2 N3 N4 KN1 KN2// ) 00077640 155 CONTINUE 00077650 IF(NEAD.GT.NUMEL) GO TO 170 00077660 IF(NZZAD.LE.1) GO TO 170 00077670 IF(NEAD.LT.1) GO TO 170 00077680 DO 160 I=NEAD,NUMEL 00077690 DO 160 J=1,NADND 00077700 160 ID4(I,J)=0 00077710 170 CONTINUE 00077720 KO=1 00077730 180 READ (5,190)N,MTYP,IX,IP,KN1,KN2 00077740 IF( N .LT.0.OR. N .GT.NUMEL) WRITE(6,370)KN1 00077750 IF(N.EQ.0) GO TO 420 00077760 190 FORMAT (16I5) 00077770 IF(PRTCOD.EQ.PRTOFF) GO TO 195 00077780 IF(POS.EQ.PRTDUM.AND.PRTCOD.NE.PRTON) GO TO 195 00077790 WRITE(6,200)N,MTYP,IX,IP,KN1,KN2 00077800 195 CONTINUE 00077810 200 FORMAT(20X,I5,I7,I8,13I5) 00077820 IF(ID2(N,1).GT.0.0 .AND. IX(1).EQ.0) GO TO 350 00077830 IF(KO.GT.0) GO TO 240 00077840 IF(KN1.EQ.0) GO TO 240 00077850 IF(KN2.EQ.0) GO TO 1180 00077860 IF(KN1.GE.KN2) GO TO 1210 00077870 K1=KN1 00077880 K2=IX(1)-IXI(1)+KN1+KN2 00077890 K3=KN2*(N-NI+1) 00077900 K4=K2*K2-4*K1*K3 00077910 X=K4 00077920 X= DSQRT(X)+.001 00077930 K5=X 00077940 IF(K5*K5.NE.K4) GO TO 1210 00077950 NG=(K2-K5)/(2*K1) 00077960 MG=(N-NI+1)/NG 00077970 IF(MG*NG.NE.(N-NI+1)) GO TO 1210 00077980 1180 MT=MTYPI 00077990 IF(MT.LE.0) GO TO 1220 00078000 MT=NELAR(2,MT) 00078010 IF(MT.GT.8) MT=8 00078020 K6=IX(1)-IXI(1) 00078030 DO 1200 I=2,MT 00078040 IF(IXI(I).LT.0) GO TO 1200 00078050 IF(IX(I).GT.0) GO TO 1190 00078060 IF(IXI(I).NE.0) GO TO 1210 00078070 GO TO 1200 00078080 1190 IF(IXI(I)+K6.NE.IX(I)) GO TO 1210 00078090 1200 CONTINUE 00078100 GO TO 1220 00078110 1210 KSKIP=1 00078120 WRITE(6,1215)NI,N 00078130 1215 FORMAT(//20X,26HGENERATION BETWEEN ELEMENT,I5,12H AND ELEMENT,I5, 00078140 $13HIS INCORRECT.//) 00078150 GO TO 240 00078160 1220 CONTINUE 00078170 IF(KN2.EQ.0) MG=1 00078180 IF(KN2.EQ.0) NG=N-NI+1 00078190 NNI=NI-1 00078200 KM=1 00078210 MX=0 00078220 IF(IP(3).GE.0) GO TO 201 00078230 KM=-IP(3) 00078240 MX=IP(4) 00078250 201 CONTINUE 00078260 DO 230 K=1,KM 00078270 K2=-KN2 00078280 DO 230 I=1,MG 00078290 K2=K2+KN2 00078300 K1=-KN1+(K-1)*MX 00078310 DO 220 J=1,NG 00078320 NNI=NNI+1 00078330 K1=K1+KN1 00078340 K3=K2+K1 00078350 DO 210 L=1,8 00078360 K4=K3 00078370 K5=K3 00078380 IF(IXI(L).EQ.0) K4=0 00078390 IF(IXI(L).LT.0) K4=-2*IXI(L) 00078400 MT=MTYPI 00078410 IF((NELAR(1,MT).NE.NELAR(2,MT)).AND.(L.GT.NELAR(2,MT)))K4=0 00078420 210 ID2(NNI,L)=IXI(L)+K4 00078430 ID2(NNI,13)=MTYPI 00078440 ID2(NNI,9)=IPI(1) 00078450 ID2(NNI,10)=IPI(2) 00078460 ID2(NNI,11)=IPI(3) 00078470 ID2(NNI,12)=IPI(4) 00078480 220 CONTINUE 00078490 230 CONTINUE 00078500 240 KO=0 00078510 IF(MTYP.NE.0) CALL ELSZ(MTYP) 00078520 IF(KN1.GT.0) GO TO 245 00078530 MTYPI=MTYP 00078540 DO 255 I=1,4 00078550 255 IPI(I)=IP(I) 00078560 245 NII=NI 00078570 NI=N 00078580 DO 250 I=1,8 00078590 IXI(I)=IX(I) 00078600 250 IX(I)=IABS(IX(I)) 00078610 DO 260 I=1,8 00078620 260 ID2(N,I)=IX(I) 00078630 ID2(N,13)=MTYPI 00078640 DO 261 I=1,4 00078650 261 ID2(N,I+8)=IPI(I) 00078660 IF(NUMEL.EQ.1) GO TO 265 00078670 IF(NZZAD.LE.1) GO TO 180 00078680 265 CONTINUE 00078690 IF(MTYP.EQ.0) WRITE(6,270)N 00078700 IF(MTYP.EQ.0) GO TO 180 00078710 270 FORMAT(20X, 38HELEMENT TYPE MUST BE INPUT FOR ELEMENT,I6/) 00078720 IF(NELAR(1,MTYP).LE.8) GO TO 180 00078730 NODES=NELAR(1,MTYP) 00078740 READ (5,280) (IA(I),I=9,NODES) 00078750 280 FORMAT (16I5) 00078760 IF(PRTCOD.EQ.PRTOFF) GO TO 285 00078770 IF(POS.EQ.PRTDUM.AND.PRTCOD.NE.PRTON) GO TO 285 00078780 WRITE(6,290)(IA(I),I=9,NODES) 00078790 285 CONTINUE 00078800 290 FORMAT (18X, 17HADDITIONAL NODES ,12I5) 00078810 IF(KN1.EQ.0) GO TO 310 00078820 DO 295 I=9,NODES 00078830 IF(IA(I).GT.0) GO TO 292 00078840 IF(IAI(I).NE.0) GO TO 1210 00078850 GO TO 295 00078860 292 IF(IAI(I)+K6.NE.IA(I)) GO TO 1210 00078870 295 CONTINUE 00078880 NNI=NII-1 00078890 DO 300 K=1,KM 00078900 K2=-KN2 00078910 DO 300 I=1,MG 00078920 K2=K2+KN2 00078930 K1=-KN1+(K-1)*MX 00078940 DO 300 J=1,NG 00078950 NNI=NNI+1 00078960 K1=K1+KN1 00078970 K3=K2+K1 00078980 KOUNT=0 00078990 DO 300 L=9,NODES,1 00079000 K4=K3 00079010 K5=K3 00079020 K6=K3 00079030 M1=IAI(L) 00079040 IF(M1.EQ.0) K4=0 00079050 IF(M1.LT.0) K4=-2*M1 00079060 KOUNT=KOUNT+1 00079070 ID4(NNI,KOUNT)=M1+K4 00079080 300 CONTINUE 00079090 310 KOUNT=0 00079100 DO 320 I=9,NODES 00079110 IAI(I)=IA(I) 00079120 320 IA(I)=IABS(IA(I)) 00079130 DO 330 J=9,NODES,1 00079140 KOUNT=KOUNT+1 00079150 ID4(N,KOUNT)=IA(J) 00079160 330 CONTINUE 00079170 IF(KOUNT.GT.NADND) WRITE(6,340)NODES 00079180 340 FORMAT (10X, 18HINCREASE JJ(2) TO ,I3, 21HON THE ELEMENTS- CARD/) 00079190 NDKOD = 1 00079200 GO TO 180 00079210 350 NI=N 00079220 IF(KN2.LT.0.OR.KN2.GT.NUMEL) WRITE(6,370)KN2 00079230 IF(KN1.LT.0.OR.KN1.GT.NUMEL) WRITE(6,370)N 00079240 IF(KN1.EQ.0) KN1=NI 00079250 IF(KN2.EQ.0)KN2=1 00079260 KDT=KN1-N 00079270 IF(KDT.EQ.0.AND.KN2.EQ.1) GO TO 360 00079280 KDT= MOD(KDT,KN2) 00079290 IF(KDT.NE.0) KSKIP=1 00079300 IF(KDT.NE.0) WRITE(6,370)N 00079310 IF(KDT.NE.0) GO TO 180 00079320 360 CONTINUE 00079330 370 FORMAT(//20X, 16HERROR ON ELEMENT,I5//) 00079340 DO 410 J=N,KN1,KN2 00079350 MT=ID2(J,13) 00079360 KM=100 00079370 DO 380 I=1,4 00079380 IPI(I)= ID2(J,I+8) 00079390 380 CONTINUE 00079400 IF(MTYP.GT.0) MT=MTYP 00079410 IF(MTYP.NE.0) CALL ELSZ(MTYP) 00079420 DO 390 I=1,4 00079430 IF(IP(I).GT.0) IPI(I)=IP(I) 00079440 IF(IP(I).LT.0) IPI(I)=0 00079450 390 CONTINUE 00079460 IPI(5)=MT 00079470 DO 400 I=1,4 00079480 400 ID2(J,I+8)=IPI(I) 00079490 410 ID2(J,13)=IPI(5) 00079500 GO TO 180 00079510 420 REWIND 4 00079520 DO 430 II=1,NUMEL R0079521 WRITE (4) (ID2(II,J),J=1,13) R0079530 IF(NDKOD.EQ.1) NEAD=NUMEL 00079540 IF(NDKOD.EQ.1) WRITE (4) (ID4(II,J),J=1,NADND) R0079550 430 CONTINUE R0079551 RETURN 00079560 END 00079570 SUBROUTINE RESWAP(ID2,ID4,NN,NUM,NUMEL,NADND,NDKOD,NELX) 209940 REAL *8 ID2(NUMEL,13),ID4(NUMEL,NADND),XMX,XAD 00209950 COMMON /PREP/ XMX,XAD,KSKIP,NDYN,I1,NRPREP(14) R0209960 DIMENSION NN(NELX,1),NUM(1),IA(20),IX(8) 00209970 NT30=30 00209980 REWIND 4 00209990 REWIND NT30 00210000 DO 10 I=1,NELX 00210010 READ (NT30) NEL,NNN,(NN(I,J),J=1,NNN) 00210020 10 NUM(I)=NNN 00210030 READ(4)((ID2(I,J),J=1,13),I=1,NUMEL) 00210040 IF(NDKOD.EQ.1)READ(4)((ID4(I,J),J=1,NADND),I=1,NUMEL) 00210050 NODE=NADND+8 00210060 IF(NDKOD.NE.1)NODE=8 00210070 KM=100 00210080 MZ=10000 00210090 REWIND NT30 00210100 REWIND 4 00210110 DO 100 I=1,NUMEL 00210120 DO 12 J=1,20 00210130 12 IA(J)=0 00210140 DO 15 J=1,8 00210150 N=ID2(I,J) 00210160 15 IX(J)=N 00210170 IF(NDKOD.NE.1) GO TO 35 00210180 DO 30 J=1,NADND 00210190 N=ID4(I,J) 00210200 IA(J+8)=N 00210210 30 CONTINUE 00210220 35 CONTINUE 00210230 DO 40 J=1,8 00210240 40 IA(J)=IX(J) 00210250 WRITE(NT30)IA 00210260 DO 45 J=1,NODE 00210270 DO 45 K=1,NELX 00210280 N=NUM(K) 00210290 DO 45 L=1,N 00210300 IF(IA(J).EQ.NN(K,L))IA(J)=NN(K,1) 00210310 45 CONTINUE 00210320 DO 50 J=1,8 00210330 50 ID2(I,J)=IA(J) 00210340 IF(NDKOD.NE.1)GO TO 100 00210350 K=0 00210360 DO 60 J=9,NODE,1 00210370 K=K+1 00210380 60 ID4(I,K)=IA(J) 00210390 100 CONTINUE 00210400 WRITE(4)((ID2(I,J),J=1,13),I=1,NUMEL) 00210410 IF(NDKOD.EQ.1)WRITE(4)((ID4(I,J),J=1,NADND),I=1,NUMEL) 00210420 RETURN 00210430 END 00210440 SUBROUTINE DOF(NUMNP,ID) 00061410 IMPLICIT REAL*8(A-H,O-Z) 00061420 REAL*8 ID 00061430 DIMENSION ID(NUMNP,3) 00061440 DIMENSION C1(3),C2(9) 00061450 COMMON/PREP/XMX,XAD,KSKIP,NDYN,I1,I99,POS,PRTCOD 00061460 $ ,POSSAV,PRTOFF,PRTON,PRTDUM,IDIRC 00061470 COMMON/JUNK/C(6),D,IC(6),RRJUNK(217) R0061480 DATA C1/4HFIX ,4H ,4HFREE/ 00061490 DATA C2/2HDX,2HDY,2HDZ,2HRX,2HRY,2HRZ,2HND,2HNR,2HNM/ 00061500 IF(PRTCOD.EQ.PRTOFF) GO TO 115 00061510 IF(POS.EQ.PRTDUM.AND.PRTCOD.NE.PRTON) GO TO 115 00061520 WRITE(6,110) 00061530 100 FORMAT (10X,2I12,I11,7X,A4,2X,6(2X,A2)) 00061540 110 FORMAT (1X ,20X,23HNODAL GLOBAL RESTRAINTS///20X,11HNODE - TO -, 00061550 $28H NODE INCR. FIX OR FREE,7X,10HRESTRAINTS/21X,1HI,11X,1HJ, 00061560 $//) 00061570 115 CONTINUE 00061580 REWIND 8 00061590 READ (8) ((ID(I,J),J=1,3),I=1,NUMNP) 00061600 120 READ (5,130)I,J,KN,D,C 00061610 130 FORMAT (3I5,A4,1X,6A2) 00061620 IF(D.EQ.C1(2)) D=C1(1) 00061630 IF (I.EQ.0) GO TO 210 00061640 IF(PRTCOD.EQ.PRTOFF) GO TO 135 00061650 IF(POS.EQ.PRTDUM.AND.PRTCOD.NE.PRTON) GO TO 135 00061660 WRITE(6,100)I,J,KN,D,C 00061670 135 CONTINUE 00061680 IF(I.GT.NUMNP) GO TO 220 00061690 IF(J.GT.NUMNP) GO TO 220 00061700 DO 140 K=1,6 00061710 IC(K)=0 00061720 140 CONTINUE 00061730 DO 150 K=1,6 00061740 DO 150 L=1,6 00061750 150 IF(C(K).EQ.C2(9)) IC(L)=1 00061760 DO 170 K=1,3 00061770 DO 160 L=1,6 00061780 IF((C(L).EQ.C2(K)).OR.(C(L).EQ.C2(7))) IC(K)=1 00061790 160 CONTINUE 00061800 170 CONTINUE 00061810 DO 190 K=4,6 00061820 DO 180 L=1,6 00061830 IF((C(L).EQ.C2(K)).OR.(C(L).EQ.C2(8))) IC(K)=1 00061840 180 CONTINUE 00061850 190 CONTINUE 00061860 IF(J.EQ.0) J=I 00061870 IF((J-I).LT.KN) GO TO 220 00061880 IF(KN.EQ.0) KN=1 00061890 DO 200 L=I,J,KN 00061900 DO 200 K=1,3 00061910 NNN=ID(L,K) 00061920 NN1= MOD(NNN,I1) 00061930 NN2= NNN/I1 00061940 IF(IC(K).EQ.1.AND.D.EQ.C1(1)) NN1=1 00061950 IF(IC(K).EQ.1.AND.D.EQ.C1(3)) NN1=0 00061960 IF(IC(K+3).EQ.1.AND.D.EQ.C1(1) ) NN2=1 00061970 IF(IC(K+3).EQ.1.AND.D.EQ.C1(3) ) NN2=0 00061980 200 ID(L,K)=(ID(L,K)-NNN)+NN1+NN2*I1 00061990 GO TO 120 00062000 210 REWIND 8 00062010 WRITE (8) ((ID(I,J),J=1,3),I=1,NUMNP) 00062020 RETURN 00062030 220 WRITE(6,230)I 00062040 230 FORMAT (/20X,14HERROR--ON NODE,I5//) 00062050 KSKIP=1 00062060 GO TO 120 00062070 END 00062080 SUBROUTINE PROPRD(PROP,II,JJ) 00178100 IMPLICIT REAL*8(A-H,O-Z) 00178110 DIMENSION PROP(200,JJ),DUM(10) 00178120 COMMON /ELTEMP/ TAVG,KET,NL,TIM(100),RRELTE R0178130 INTEGER T27 00178140 COMMON /PREP/ RDUM(2),KDUM(1),NDYN,I1,I99,POS,PRTCOD 00178150 $ ,POSSAV,PRTOFF,PRTON,PRTDUM,IDIRC 00178160 COMMON /SUPEL/LDUM(3),MATNO,NRSUPE(2) R0178170 COMMON /TRASH/ TD(100,3),RRTRAS(190) R0178180 COMMON /AMB/ GRAV,REFT,JROT 00178190 CALL FILES(24) 00178200 KMAX=0 00178210 KK=II 00178220 II=0 00178230 JK=JJ 00178240 IF(KK.LE.0) GO TO 110 00178250 DO 100 K=1,KK 00178260 DO 100 J=1,JJ 00178270 100 PROP(K,J)=0.0D0 00178280 110 CONTINUE 00178290 IF(JJ.GT.7) JK=7 00178300 120 READ (5,130) K,(DUM(J),J=1,JK) 00178310 130 FORMAT (I10, 7F10.0) 00178320 IF(K.EQ.0) GO TO 180 00178330 IF(JJ.GT.7) READ (5,140) (DUM(J),J=8,JJ) 00178340 140 FORMAT (3F10.0) 00178350 IF(K.GT.179) WRITE(6,150) 00178360 150 FORMAT ( 1X ,20X, 34HNO MORE THAN 100 TYPES MAY BE USED) 00178370 IF(PRTCOD.EQ.PRTOFF) GO TO 195 00178380 IF(POS.EQ.PRTDUM.AND.PRTCOD.NE.PRTON) GO TO 195 00178390 IF(JJ.LE.7) WRITE(6,200)K,(DUM(J),J=1,JJ) 00178400 IF(JJ.GT.7) WRITE(6,160)K,(DUM(J),J=1,JJ) 00178410 195 CONTINUE 00178420 160 FORMAT (I5,10(2X,G9.3)) 00178430 IF(JJ.EQ.10) K=K-80 00178440 IF(K.GT.KMAX) KMAX=K 00178450 IF(KK.GT.0.AND.JROT.EQ.1) DUM(5)=DUM(5)**2 00178460 DO 170 J=1,JJ 00178470 170 PROP(K,J)=DUM(J) 00178480 II=II+1 00178490 IF(K.GT.II) II=K 00178500 IF(II.GT.KMAX) II=KMAX 00178510 IF(KK.GT.0) II=KK 00178520 GO TO 120 00178530 180 WRITE (3) ((PROP(I,J),I=1,II),J=1,JJ) 00178540 IF(II.GT.99 ) WRITE(6,185) 00178550 185 FORMAT(1X ,20X,45HONLY BEAM TYPES CAN HAVE MORE THAN 99 ENTRIES, 00178560 $11H - ( 179 ).//) 00178570 IF(KK.EQ.0) RETURN 00178580 TAVG=0.0D0 00178590 IF(JROT.EQ.1) WRITE(6,186) 00178600 186 FORMAT(/5X,38HTHIS IS A CENTRIFUGAL LOADING PROBLEM.//) 00178610 LM=0 00178620 DO 190 K=1,KK 00178630 LT=PROP(K,2) 00178640 IF(LT.EQ.1.OR.LT.EQ.2) KET=KET+1 00178650 IF(LT.EQ.2) TAVG=TAVG+PROP(K,3) 00178660 IF(LT.EQ.1) LM=1 00178670 TIM(K)=-10.0D0 00178680 IF(LT.EQ.1) TIM(K)=PROP(K,3) 00178690 190 CONTINUE 00178700 IF(NDYN.NE.8) GO TO 310 00178710 T27=27 00178720 REWIND T27 00178730 KCF=0 00178740 DO 220 K=1,KK 00178750 KP=0 00178760 IF(K.EQ.KK) GO TO 220 00178770 DO 210 J=1,JJ 00178780 IF(J.EQ.3) GO TO 210 00178790 IF(PROP(K,J).NE.0.0)KP=KP+1 00178800 210 CONTINUE 00178810 IF(KP.EQ.1) GO TO 220 00178820 IF(KCF+1.EQ.K) KCF=KCF+1 00178830 220 CONTINUE 00178840 KP=0 00178850 DO 230 K=1,KK 00178860 IF((PROP(K,1).EQ.1.0).AND.(K.GT.KCF)) KP=K 00178870 230 CONTINUE 00178880 KBE=0 00178890 DO 235 K=1,KK 00178900 IF((PROP(K,4).EQ.1.0D0).AND.(K.GT.KCF)) KBE=K 00178910 235 CONTINUE 00178920 KAX=0 00178930 KAY=0 00178940 KAZ=0 00178950 KM=0 00178960 KCFP=KCF+1 00178970 DO 260 K=KCFP,KK 00178980 IF(PROP(K,5).EQ.1.D0) GO TO 240 00178990 IF(PROP(K,6).EQ.1.0D0) KAY=K 00179000 IF(PROP(K,7).EQ.1.0D0) KAZ=K 00179010 GO TO 260 00179020 240 CONTINUE 00179030 IF(PROP(K,5).EQ.PROP(K,6).AND.PROP(K,5).EQ.PROP(K,7)) GO TO 250 00179040 KAX=K 00179050 GO TO 260 00179060 250 KM=K 00179070 260 CONTINUE 00179080 KM=KK 00179090 II=0 00179100 TD(1,1)=0.0D0 00179110 IF(KET.EQ.0) GO TO 300 00179120 DO 290 K=KCFP,KK 00179130 IF(PROP(K,2).NE.1.0D0. AND.PROP(K,2).NE.2.0D0) GO TO 290 00179140 II=II+1 00179150 TD(II,1)=K 00179160 TD(II,2)=PROP(K,2) 00179170 TD(II,3)=PROP(K,3) 00179180 290 CONTINUE 00179190 300 CONTINUE 00179200 WRITE (T27) MATNO,II,KK 00179210 IF(II.LE.0) II=1 00179220 IF(KET.EQ.0) II=1 00179230 WRITE (T27) KCF,KP,KAX,KAY,KAZ,KM,KBE,((TD(J,K),K=1,3),J=1,II) 00179240 WRITE(6,301)MATNO 00179250 IF(KCF.GT.0) WRITE(6,302)KCF 00179260 IF(KP.GT.0) WRITE(6,303)KP 00179270 IF(KAX.GT.0) WRITE(6,304)KAX 00179280 IF(KAY.GT.0) WRITE(6,305)KAY 00179290 IF(KAZ.GT.0) WRITE(6,306)KAZ 00179300 IF(KM.GT.0) WRITE(6,307)KM 00179310 IF(KET.GT.0) WRITE(6,308)(TD(J,1),J=1,II) 00179320 IF(KBE.GT.0) WRITE(6,309)KBE 00179330 301 FORMAT(/20X,45HTHE FOLLOWING LOAD CASES ARE BEING FORMED FOR, 00179340 $13HSUPER ELEMENT,I5/) 00179350 302 FORMAT(20X,26HLOAD CASE 1 THRU LOAD CASE,I3, 00179360 124H ARE CONCENTRATED LOADS.) 00179370 303 FORMAT(20X,9HLOAD CASE,I3,20H IS A PRESSURE LOAD.) 00179380 304 FORMAT(20X,9HLOAD CASE,I3,35H IS AN INERTIAL LOAD - X DIRECTION.) 00179390 305 FORMAT(20X,9HLOAD CASE,I3,35H IS AN INERTIAL LOAD - Y DIRECTION.) 00179400 306 FORMAT(20X,9HLOAD CASE,I3,35H IS AN INERTIAL LOAD - Z DIRECTION.) 00179410 307 FORMAT(20X,9HLOAD CASE,I3,25H IS THE DISTRIBUTED MASS.) 00179420 309 FORMAT(20X,9HLOAD CASE,I3,29H IS A SPECIFIED DISPLACEMENT.) 00179430 308 FORMAT( 00179440 $20X,37HTHE FOLLOWING LOAD CASES ARE THERMAL-,10F5.0/(57X,10F5.0)) 00179450 310 CONTINUE 00179460 II=KK 00179470 IF(LM.EQ.1) KET=-KET 00179480 IF(LM.EQ.0.AND.KET.GT.0) TAVG=TAVG/KET 00179490 IF(LM.EQ.0) KET=0 00179500 RETURN 00179510 200 FORMAT (I5,7(4X,G12.6)) 00179520 END 00179530 SUBROUTINE PROUT(KRS,ID,ID2,ID3,ID4,NUMNP,NUMEL,NUMEL2,NADND, 00179540 $NADEL,NDKOD,NDMX,IES) 00179550 IMPLICIT REAL*8(A-H,O-Z) 00179560 REAL*8 ID,ID2,ID3 00179570 REAL*8 ID4 00179580 INTEGER T,XM 00179590 DIMENSION IAPG(20),ID(NUMNP,3),ID2(NUMEL,13),ID3( 1,9) 00179600 DIMENSION ID4(NADEL,NADND) 00179610 COMMON/ELARRY/NELAR(4,20) 00179620 COMMON/PREP/XMX,XAD,KSKIP,NDYN,I1,RRPREP(7) R0179630 COMMON /OUT/NRES,NSTR,NDIS,NROUT(7) R0179640 COMMON /TRASH/IA(20),ND(100),DCOSN(100,3),RRTRAS(130) R0179650 COMMON/JUNK/X(3),CX(6),DX(8),IX(8),JX(5),I,IXX(16),JXX(4), KX(12) 00179660 & ,RRJUNK(187) R0179661 COMMON/PLOTH/IPLT,IPLWRT 00179670 COMMON/PLOTG/IPLWRG 00179680 COMMON/RIGID/IIA(20),NREX 00179690 DIMENSION C(8),G(3),NC(6) 00179700 DATA C/2HDX,2HDY,2HDZ,2HRX,2HRY,2HRZ,2H ,2H**/ 00179710 DATA G/2HNM,2HND,2HNR/ 00179720 CALL FILES(23) 00179730 NDD=6 00179740 NELMX=0 00179750 NDIFMX=0 00179760 IU=19 00179770 KP=0 00179780 KK=KRS 00179790 IF(KK.GT.4)KP=1 00179800 IF(KK.GT.4)KK=KK/10 00179810 GO TO (100,160,340,395),KK 00179820 100 REWIND 8 00179830 READ (8) ((ID(I,J),J=1,3),I=1,NUMNP) 00179840 IF(NRES.EQ.0) GO TO 110 00179850 WRITE (NRES) ((ID(I,J),J=1,3),I=1,NUMNP) 00179860 110 CONTINUE 00179870 WRITE (6,400) 00179880 WRITE (6,410) 00179890 NZERO=0 00179900 IF(IPLWRG.EQ.0)WRITE(31,770)NUMNP 00179910 IF(IPLT.NE.0.AND.IPLWRT.EQ.0) REWIND 55 00179920 DO 150 N=1,NUMNP 00179930 DO 120 I=1,NDD 00179940 120 CX(I)=C(7) 00179950 MP= MOD(N,2) 00179960 MP=3-3*MP 00179970 MP2=2*MP 00179980 DO 130 I=1,3 00179990 NNN=ID(N,I) 00180000 IF(NNN.LT.0) NNN=NNN-1 00180010 X(I)= (ID(N,I)-NNN-XAD)*XMX 00180020 DX(I+MP)=X(I) 00180030 NN1= MOD(NNN,I1) 00180040 NN2=NNN/I1 00180050 KX(I+MP2)=NN1 00180060 IF(NN1.GE.10) KX(I+MP2)=0 00180070 KX(I+MP2+3)=NN2 00180080 IF(NN1.GT.0) CX(I)=C(I) 00180090 IF(NN1.GE.100) CX(I)=C(8) 00180100 IF(NN2.GT.0) CX(I+3)=C(I+3) 00180110 IF(NN1.LT.0) CX(I+3)=C(I+3) 00180120 130 CONTINUE 00180130 NI=N-1 00180140 IF(N.EQ.NUMNP.AND.MP.EQ.0) NI=N 00180150 IF(N.EQ.NUMNP) MP=6 00180160 DO 132 J=1,6 00180170 NC(J)=0 00180180 IF(CX(J).NE.C(7))NC(J)=1 00180190 132 IF(CX(J).EQ.C(8))NC(J)=0 00180200 IF(IPLWRG.EQ.0) WRITE(34,133)N,NC 00180210 133 FORMAT(7I5) 00180220 IRK=0 00180230 IF(MP.GT.0) IRK=6 00180240 IF(KP.EQ.1) WRITE(IU,800)N,(KX(J+IRK),J=1,6),(X(J),J=1,3) 00180250 IF(IPLT.NE.0.AND.IPLWRT.EQ.0) WRITE(55)X 00180260 140 FORMAT (2(I4,3F10.5,6I1)) 00180270 IF(MOD(N,2)) 145,146,145 00180280 145 WRITE(6,420) N,CX,X 00180290 IF(IPLWRG.EQ.0)WRITE(31,770)N 00180300 IF(IPLWRG.EQ.0) WRITE(31,780)X 00180310 GO TO 150 00180320 146 WRITE(6,421) N,CX,X 00180330 IF(IPLWRG.EQ.0)WRITE(31,770)N 00180340 IF(IPLWRG.EQ.0) WRITE(31,780)X 00180350 150 CONTINUE 00180360 IF(IPLWRG.EQ.0) WRITE(31,770)NZERO 00180370 3001 FORMAT(I5) 00180380 3002 FORMAT(3(F10.5,1X)) 00180390 WRITE(6,430)C(8) 00180400 RETURN 00180410 160 REWIND 4 00180420 DO 165 II=1,NUMEL R0180421 READ (4) (ID2(II,J),J=1,13) R0180430 IF(NDKOD.EQ.1)READ(4) (ID4(II,J),J=1,NADND) R0180440 165 CONTINUE R0180441 NT30=30 00180450 REWIND NT30 00180460 IF(NRES.EQ.0) GO TO 170 00180470 WRITE (NRES) ((ID2(I,J),J=1,13),I=1,NUMEL) 00180480 IF(NDKOD.EQ.1) WRITE(NRES) ((ID4(I,J),J=1,NADND),I=1,NUMEL) 00180490 170 CONTINUE 00180500 WRITE(6,180) 00180510 180 FORMAT (1X ,5X, 23H COMPLETE ELEMENT DATA ///) 00180520 WRITE(6,190) 00180530 190 FORMAT (20X, 00180540 $ 50HN1-MATL. NO. OR GEOMETRIC PROPERTY (TRUSS OR BEAM)//20X, 00180550 $ 90HN2-THICK TYPE - PLANE STRESS OR SHELL ELEMENTS OR INTEGRATIO00180560 $N ORDER FOR THE SOLID ELEMENT /23X, 00180570 $44HOR SECTION PROPERTY TYPE NO FOR BEAM ELEMENT //20X, 00180580 $ 67HN3-PRESSURE SET NO.- SOLID ELEMENTS, SHELL ELEMENTS OR AXI00180590 $SYMMETRIC//20X, 00180600 $ 57HN4-STRESS FACES - SOLID ELEMENT OR END RELEASE SET - BEA00180610 $M /23X, 00180620 $50HOR SECTION PROPERTY TYPE NO FOR CURVED BEAM(ELBOW) //20X, 00180630 $50HN5 - BEAM EFFECTIVE LENGTH AND AISC CATX(Y) TYPE ///) 00180640 WRITE(6,200) 00180650 200 FORMAT (20X, 13HELEMENT TYPE,8X, 25HNODES AT ELEMENT VERTICES//2000180660 $X, 56H NO. NO. I J K L M N O P/N5, 00180670 $3X,2HN1,3X,25HN2 N3 N4 NODE DIFF.//) 00180680 IF(IPLWRG.EQ.0) WRITE(31,770)NUMEL 00180690 DO 320 I=1,NUMEL 00180700 DO 210 J=1,8 00180710 NN=ID2(I,J) 00180720 IIA(J)=NN 00180730 210 IX(J)= NN 00180740 XM=100 00180750 DO 220 J=1,5 00180760 JX(J)=ID2(I,J+8) 00180770 220 CONTINUE 00180780 MIN=100000 00180790 MAX=0 00180800 MP= MOD(I,2) 00180810 MP=8-8*MP 00180820 MT=JX(5) 00180830 DO 230 J=1,8 00180840 IXX(J+MP)=IX(J) 00180850 IF(IX(J).EQ.0) GO TO 230 00180860 IF(J.GT.NELAR(2,MT)) GO TO 230 00180870 IF(IX(J).GT.MAX) MAX=IX(J) 00180880 IF(IX(J).LT.MIN) MIN=IX(J) 00180890 230 CONTINUE 00180900 NDIF=MAX-MIN 00180910 IF(MT.EQ.7) NDIF=0 00180920 MP=MP/4 00180930 JXX(1+MP)=JX(5) 00180940 JXX(2+MP)=JX(1) 00180950 NI=I-1 00180960 IF(I.EQ.NUMEL.AND.MP.EQ.0) NI=I 00180970 IF(I.EQ.NUMEL) MP=2 00180980 IF(KP.EQ.1.AND.NDKOD.EQ.1) KP=2 00180990 IF(KP.GE.1) WRITE(IU,810)I,JX(5),(IX(J),J=1,8),JX(1),JX(2),JX(3), 00181000 1JX(4) 00181010 IF(KP.EQ.2) WRITE(IU,250)JX(5),JX(1),IX 00181020 240 FORMAT(2(3X,I2,I2,1X,8I4)) 00181030 250 FORMAT (3X,I2,I2,1X,8I4) 00181040 260 FORMAT (20X,I5,I7,I8,11I5,I8) 00181050 IF(NDKOD.EQ.0.OR.NDMX.LE.8) GO TO 300 00181060 MT=JX(5) 00181070 DO 265 J=9,20 00181080 265 IA(J)=0 00181090 IF(NELAR(1,MT).LE.8) GO TO 285 00181100 XM=10000 00181110 DO 270 J=1,NADND 00181120 T=ID4(I,J) 00181130 IA(J+8)=T 00181140 IIA(J+8)=IA(J+8) 00181150 270 CONTINUE 00181160 DO 280 J=9,NDMX 00181170 IF(IA(J).EQ.0) GO TO 280 00181180 IF(IA(J).GT.MAX) MAX=IA(J) 00181190 IF(IA(J).LT.MIN) MIN=IA(J) 00181200 280 CONTINUE 00181210 NDIF=MAX-MIN 00181220 285 CONTINUE 00181230 IF(KP.GE.1) WRITE(IU,810)(IA(J),J=9,NDMX) 00181240 290 FORMAT (20I4) 00181250 MT=JX(5) 00181260 300 IF(NREX.GT.0)READ(NT30)IIA 00181270 WRITE(6,260)I,JX(5),(IIA(J),J=1,8),(JX(J),J=1,4),NDIF 00181280 IF(NELAR(1,MT).GT.8) WRITE(6,310)(IIA(J),J=9,NDMX) 00181290 DO 299J=1,20 00181300 299 IAPG(J)=0 00181310 DO 301 J=1,8 00181320 301 IAPG(J)=IIA(J) 00181330 IF(NELAR(1,MT).LE.8)GO TO 303 00181340 DO 302 J=9,NDMX 00181350 302 IAPG(J)=IIA(J) 00181360 303 IF(IPLWRG.EQ.0) WRITE(31,770)JX(5) 00181370 ITYPE=JX(5) 00181380 IAPGX=NELAR(1,MT) 00181390 IF(IPLWRG.EQ.0) WRITE(31,790)I,(IAPG(J),J=1,IAPGX) 00181400 3003 FORMAT(21(I5,1X)) 00181410 IF(IPLT.NE.0.AND.IPLWRT.EQ.0) CALL PLOTDT(ITYPE,IIA,IIA) 00181420 310 FORMAT(18X, 17HADDITIONAL NODES ,12I5) 00181430 IF(NDIF.GT.NDIFMX) NELMX=I 00181440 IF(NDIF.GT.NDIFMX) NDIFMX=NDIF 00181450 320 CONTINUE 00181460 IF(IPLWRG.EQ.0)WRITE(31,770)NZERO 00181470 MHIM=-1 00181480 IF( IPLT.NE.0.AND.IPLWRT.EQ.0)WRITE(55)MHIM,MHIM 00181490 IF(IPLT.NE.0) IPLWRT=1 00181500 IPLWRG=1 00181510 WRITE(6,330)NDIFMX,NELMX 00181520 330 FORMAT(////20X,30HTHE MAXIMUM NODE DIFFERENCE IS,I4,24H, AND OCCUR00181530 $S AT ELEMENT ,I4,1H.) 00181540 RETURN 00181550 340 REWIND 9 00181560 IF(NUMEL2.EQ.0) RETURN 00181570 WRITE(6,350) 00181580 350 FORMAT (1X ,20X, 16HBOUNDARY ELEMENT,13X, 18HNM- NO MOTION, ND-, 00181590 $28H NO DISP., NR- NO ROTATION//20X, 00181600 $ 52HELEMENT AT NODE NODES DEFINING DIRECT. CODE, 00181610 $33H SPEC. SPEC. SPRING/20X, 00181620 $ 42H NO. NO. I J K L,6X, 00181630 $14X, 25HDISP. ROTAT. CONSTANT) 00181640 N=NUMEL 00181650 DO 390 I=1,NUMEL2 00181660 J=1 00181670 READ (9) (ID3(1,K),K=1,9) 00181680 IF(NRES.EQ.0) GO TO 360 00181690 WRITE (NRES) (ID3(1,K),K=1,9) 00181700 360 CONTINUE 00181710 IF(ID3(J,6).EQ.11.) ID3(J,6)=G(1) 00181720 IF(ID3(J,6).EQ.10.) ID3(J,6)=G(2) 00181730 IF(ID3(J,6).EQ.1.0) ID3(J,6)=G(3) 00181740 N=N+1 00181750 IF(ID3(J,9).EQ.0) GO TO 1160 00181760 WRITE(6,370)N,(ID3(J,K),K=1,9) 00181770 GO TO 1170 00181780 1160 RU=1.0D10 00181790 WRITE(6,370)N,(ID3(J,K),K=1,8),RU 00181800 1170 CONTINUE 00181810 370 FORMAT (20X,I5,2F10.0,3F6.0,6X,A2,1P3E10.3) 00181820 380 CONTINUE 00181830 390 CONTINUE 00181840 RETURN 00181850 395 CONTINUE 00181860 IF(IES.EQ.0)RETURN 00181870 WRITE(6,590) 00181880 KS1=1 00181890 KS2=2 00181900 REWIND KS1 00181910 REWIND KS2 00181920 DO 401 I=1,IES 00181930 READ(KS2) J1,J2,J3,J4 00181940 IF(NRES.NE.0) 00181950 XWRITE(NRES) J1,J2,J3,J4 00181960 WRITE(6,600)J1,J3,J4 00181970 J5=J2/10 00181980 IF(J3.EQ.5)WRITE(6,610)J5 00181990 LX=(J4-16)/20+1 00182000 JL=16 00182010 IF(J4.LE.16)JL=J4 00182020 READ(KS2)(IA(K),K=1,JL) 00182030 IF(NRES.NE.0) 00182040 XWRITE(NRES) (IA(K),K=1,JL) 00182050 WRITE(6,620)(IA(K),K=1,JL) 00182060 IF(J4.LE.16)GO TO 405 00182070 DO 402 J=1,LX 00182080 JL=20 00182090 IF(J.EQ.LX)JL=J4-(LX-1)*20-16 00182100 IF(JL.EQ.0)GO TO 405 00182110 READ(KS2)(IA(K),K=1,JL) 00182120 IF(NRES.NE.0) 00182130 XWRITE(NRES) (IA(K),K=1,JL) 00182140 WRITE(6,630)(IA(K),K=1,JL) 00182150 402 CONTINUE 00182160 405 CONTINUE 00182170 READ(KS1) J1,L1 00182180 IF(NRES.NE.0) 00182190 XWRITE(NRES) J1,L1 00182200 WRITE(6,730)L1 00182210 LX=L1/100+1 00182220 DO 408 MJ=1,LX 00182230 JL=4 00182240 IF(L1.LT.4)JL=L1 00182250 IF(L1.LE.4)GO TO 407 00182260 JL=100 00182270 IF(MJ.EQ.LX)JL=L1-(LX-1)*100 00182280 407 CONTINUE 00182290 READ(KS1)(ND(K),(DCOSN(K,M),M=1,3),K=1,JL) 00182300 IF(NRES.NE.0) 00182310 XWRITE(NRES) (ND(K),(DCOSN(K,M),M=1,3),K=1,JL) 00182320 DO 403 K=1,JL 00182330 DO 403 M=1,3 00182340 IF(DCOSN(K,M).LE.-0.999) DCOSN(K,M)=-0.999 00182350 403 CONTINUE 00182360 IF(MJ.EQ.1)GO TO 411 00182370 GO TO 450 00182380 411 CONTINUE 00182390 IF(JL.LE.4)GO TO 450 00182400 450 CONTINUE 00182410 JLAST=8 00182420 IF(JL.LT.8)JLAST=JL 00182430 WRITE(6,740)(ND(K),DCOSN(K,1),K=1,JLAST) 00182440 WRITE(6,750)( DCOSN(K,2),K=1,JLAST) 00182450 WRITE(6,750)( DCOSN(K,3),K=1,JLAST) 00182460 IF(JL.LE.8)GO TO 408 00182470 JN=(JL-8)/8 00182480 JL2=JLAST 00182490 IF(JN.EQ.0)GO TO 452 00182500 DO 451 J=1,JN 00182510 JL1=JL2+1 00182520 JL2=JL1+7 00182530 WRITE(6,760)(ND(K),DCOSN(K,1),K=JL1,JL2) 00182540 WRITE(6,750)( DCOSN(K,2),K=JL1,JL2) 00182550 WRITE(6,750)( DCOSN(K,3),K=JL1,JL2) 00182560 451 CONTINUE 00182570 452 CONTINUE 00182580 JN=(JN+1)*8 00182590 JN=JL-JN 00182600 IF(JN.LE.0)GO TO 408 00182610 JL1=JL2+1 00182620 JL2=JL 00182630 WRITE(6,760)(ND(K),DCOSN(K,1),K=JL1,JL2) 00182640 WRITE(6,750)( DCOSN(K,2),K=JL1,JL2) 00182650 WRITE(6,750)( DCOSN(K,3),K=JL1,JL2) 00182660 408 CONTINUE 00182670 401 CONTINUE 00182680 RETURN 00182690 50 FORMAT(20I4) 00182700 60 FORMAT(I4,4(I4,3F5.3)) 00182710 70 FORMAT(4X,I4,3F5.3,I4,3F5.3,I4,3F5.3,I4,3F5.3) 00182720 400 FORMAT(1X ,52X,25HCOMPLETE NODAL POINT DATA/53X,25(1H-)) 00182730 410 FORMAT(// 00182740 $60H NODE BOUNDARY CONDITION CODES NODAL POINT COORDINATES, 00182750 $9X, 00182760 $60H NODE BOUNDARY CONDITION CODES NODAL POINT COORDINATES/ 00182770 $60H NO. X Y Z XX YY ZZ X Y Z, 00182780 $9X, 00182790 $60H NO. X Y Z XX YY ZZ X Y Z/) 00182800 420 FORMAT(1X,I5,4X,6(A2,2X),3(F8.2,2X)) 00182810 421 FORMAT(1H+,69X, I5,4X,6(A2,2X),3(F8.2,2X)) 00182820 430 FORMAT (/10X,A2, 53HINDICATES THAT NODES ARE CONSTRAINED TO MOVE T00182830 $OGETHER//) 00182840 590 FORMAT(////1X ,24X,75HS U R F A C E E L E M E N T S + 00182850 XN O D E S (W/DIRECTION COSINES)// 1H ,38HSURF LOCAL ELEM NO 00182860 XOF ELEMENTS/ /1H ,40H NO FACE NO TYPE ELEMS/ NODES COSX / 00182870 X1H ,2X,39H FESAP/FETAP NODES COSY / 00182880 X1H ,33X,4HCOSZ ) 00182890 600 FORMAT (1H0,I3,13X,I1,4X,I4) 00182900 610 FORMAT (1H+,9X,I1) 00182910 620 FORMAT (1H+,28X,20I5) 00182920 630 FORMAT(1H ,28X,20I5) 00182930 730 FORMAT(1H0,21X,I4) 00182940 740 FORMAT(1H+,27X,8(I5,F7.3)) 00182950 750 FORMAT(1H ,27X,8F12.3) 00182960 760 FORMAT(1H ,27X,8(I5,F7.3)) 00182970 770 FORMAT(5X,I5) 00182980 780 FORMAT(3E12.5) 00182990 790 FORMAT(5X,I5,21I5) 00183000 800 FORMAT(7I5,1P3E10.3) 00183010 810 FORMAT(16I5) 00183020 END 00183030 SUBROUTINE PLOTDT(ITYP,IX,IA) 00171300 DIMENSION IX(8),KOD(20),IA(20) 00171310 IF(ITYP.GT.13)GO TO 100 00171320 IF(ITYP.LT.1)GO TO 100 00171330 GO TO( 00171340 *1,2,3,4,5,6,7,8,9,10,11,12,13 00171350 *),ITYP 00171360 1 WRITE(55)IX(1),IX(2) 00171370 GO TO 110 00171380 2 GO TO 1 00171390 3 WRITE(55)IX(1),IX(2) 00171400 WRITE(55)IX(2),IX(3) 00171410 IF(IX(4).EQ.0) GO TO 1100 00171420 WRITE(55)IX(3),IX(4) 00171430 WRITE(55)IX(4),IX(1) 00171440 GO TO 110 00171450 1100 WRITE(55)IX(1),IX(3) 00171460 GO TO 110 00171470 4 GO TO 3 00171480 5 IF(IX(7).EQ.0) GO TO 1200 00171490 WRITE(55)IX(1),IX(2) 00171500 WRITE(55)IX(1),IX(4) 00171510 WRITE(55)IX(1),IX(5) 00171520 WRITE(55)IX(2),IX(3) 00171530 WRITE(55)IX(2),IX(6) 00171540 WRITE(55)IX(3),IX(4) 00171550 WRITE(55)IX(3),IX(7) 00171560 WRITE(55)IX(4),IX(8) 00171570 WRITE(55)IX(5),IX(6) 00171580 WRITE(55)IX(5),IX(8) 00171590 WRITE(55)IX(6),IX(7) 00171600 WRITE(55)IX(7),IX(8) 00171610 GO TO 110 00171620 1200 WRITE(55)IX(1),IX(2) 00171630 WRITE(55)IX(1),IX(3) 00171640 WRITE(55)IX(1),IX(4) 00171650 WRITE(55)IX(2),IX(3) 00171660 WRITE(55)IX(2),IX(5) 00171670 WRITE(55)IX(3),IX(6) 00171680 WRITE(55)IX(4),IX(5) 00171690 WRITE(55)IX(4),IX(6) 00171700 WRITE(55)IX(5),IX(6) 00171710 GO TO 110 00171720 6 GO TO 3 00171730 7 GO TO 110 00171740 8 GO TO 3 00171750 9 WRITE(55)IX(1),IX(2) 00171760 WRITE(55)IX(2),IX(3) 00171770 GO TO 110 00171780 10 DO 600 I=1,8 00171790 600 KOD(I)=IX(I) 00171800 DO 650 I=9,20 00171810 650 KOD(I)=IA(I) 00171820 700 IF (KOD(9) .EQ. 0) GO TO 710 00171830 WRITE (55) KOD(1),KOD(9) 00171840 WRITE (55) KOD(9),KOD(2) 00171850 GO TO 720 00171860 710 WRITE (55) KOD(1),KOD(2) 00171870 720 IF (KOD(10) .EQ. 0) GO TO 730 00171880 WRITE (55) KOD(2),KOD(10) 00171890 WRITE (55) KOD(10),KOD(3) 00171900 GO TO 740 00171910 730 WRITE (55) KOD(2),KOD(3) 00171920 740 IF (KOD(11) .EQ. 0) GO TO 750 00171930 WRITE (55) KOD(3),KOD(11) 00171940 WRITE (55) KOD(11),KOD(4) 00171950 GO TO 760 00171960 750 WRITE (55) KOD(3),KOD(4) 00171970 760 IF (KOD(12) .EQ. 0) GO TO 770 00171980 WRITE (55) KOD(4),KOD(12) 00171990 WRITE (55) KOD(12),KOD(1) 00172000 GO TO 780 00172010 770 WRITE (55) KOD(4),KOD(1) 00172020 780 IF (KOD(13) .EQ. 0) GO TO 790 00172030 WRITE (55) KOD(5),KOD(13) 00172040 WRITE (55) KOD(13),KOD(6) 00172050 GO TO 800 00172060 790 WRITE (55) KOD(5),KOD(6) 00172070 800 IF (KOD(14) .EQ. 0) GO TO 810 00172080 WRITE (55) KOD(6),KOD(14) 00172090 WRITE (55) KOD(14),KOD(7) 00172100 GO TO 820 00172110 810 WRITE (55) KOD(6),KOD(7) 00172120 820 IF (KOD(15) .EQ. 0) GO TO 830 00172130 WRITE (55) KOD(7),KOD(15) 00172140 WRITE (55) KOD(15),KOD(8) 00172150 GO TO 840 00172160 830 WRITE (55) KOD(7),KOD(8) 00172170 840 IF (KOD(16) .EQ. 0) GO TO 850 00172180 WRITE (55) KOD(8),KOD(16) 00172190 WRITE (55) KOD(16),KOD(5) 00172200 GO TO 860 00172210 850 WRITE (55) KOD(8),KOD(5) 00172220 860 IF (KOD(17) .EQ. 0) GO TO 870 00172230 WRITE (55) KOD(1),KOD(17) 00172240 WRITE (55) KOD(17),KOD(5) 00172250 GO TO 880 00172260 870 WRITE (55) KOD(1),KOD(5) 00172270 880 IF (KOD(18) .EQ. 0) GO TO 890 00172280 WRITE (55) KOD(2),KOD(18) 00172290 WRITE (55) KOD(18),KOD(6) 00172300 GO TO 900 00172310 890 WRITE (55) KOD(2),KOD(6) 00172320 900 IF (KOD(19) .EQ. 0) GO TO 910 00172330 WRITE (55) KOD(3),KOD(19) 00172340 WRITE (55) KOD(19),KOD(7) 00172350 GO TO 920 00172360 910 WRITE (55) KOD(3),KOD(7) 00172370 920 IF (KOD(20) .EQ. 0) GO TO 930 00172380 WRITE (55) KOD(4),KOD(20) 00172390 WRITE (55) KOD(20),KOD(8) 00172400 GO TO 940 00172410 930 WRITE (55) KOD(4),KOD(8) 00172420 940 CONTINUE 00172430 GO TO 110 00172440 11 IF(IX(4).EQ.0) IX(4)=IX(3) 00172450 IF(IX(5).EQ.0) GO TO 1010 00172460 WRITE(55)IX(1),IX(5) 00172470 WRITE(55)IX(5),IX(2) 00172480 GO TO 1020 00172490 1010 WRITE(55)IX(1),IX(2) 00172500 1020 IF(IX(6).EQ.0)GO TO 1030 00172510 WRITE(55)IX(2),IX(6) 00172520 WRITE(55)IX(6),IX(3) 00172530 GO TO 1040 00172540 1030 WRITE(55)IX(2),IX(3) 00172550 1040 IF(IX(7).EQ.0)GO TO 1050 00172560 WRITE(55)IX(3),IX(7) 00172570 WRITE(55)IX(7),IX(4) 00172580 GO TO 1060 00172590 1050 WRITE(55)IX(3),IX(4) 00172600 1060 IF(IX(8).EQ.0)GO TO 1070 00172610 WRITE(55)IX(4),IX(8) 00172620 WRITE(55)IX(8),IX(1) 00172630 GO TO 1080 00172640 1070 WRITE(55)IX(4),IX(1) 00172650 1080 CONTINUE 00172660 IF(IX(4).EQ.IX(3)) IX(4)=0 00172670 GO TO 110 00172680 12 GO TO 11 00172690 13 GO TO 11 00172700 100 WRITE(6,90)ITYP 00172710 90 FORMAT(31H ***** PLOTTER FOR ELEMENT TYPE,1X,I3,13HNOT AVAILABLE) 00172720 110 RETURN 00172730 END 00172740 SUBROUTINE XCOPY(X,E) 00328720 RETURN 00328730 END 00328740 FUNCTION XP(X,Y) 00328750 COMMON/ANGLS/SINA,COSA,SINB,COSB 00328760 XP=-X*SINB+Y*COSB 00328770 RETURN 00328780 END 00328790 DOUBLE PRECISION FUNCTION YDSTR (T,M) 00328800 IMPLICIT REAL*8(A-H,O-Z) 00328810 COMMON/MATL/MATLCO 00328820 DATA NHIGH/4HHIGH/ 00328830 IF(MATLCO.NE.NHIGH)GO TO 10 00328840 CALL YDSTR2 (T,M,X) 00328850 YDSTR=X 00328860 RETURN 00328870 10 CALL YDSTR1 (T,M,X) 00328880 YDSTR=X 00328890 RETURN 00328900 END 00328910 SUBROUTINE RESTRT(NUMNP,NUMEL,NUMEL2,ID,ID2,ID3,ID4,NADND,NADEL, 00209280 $NDKOD,IES) 00209290 IMPLICIT REAL*8(A-H,O-Z) REAL*8 ID,ID2,ID3 00209310 REAL*8 ID4 00209320 DIMENSION ID(NUMNP,3),ID2(NUMEL,13),ID3(9) 00209330 DIMENSION ID4(NADEL,NADND) 00209340 COMMON /OUT/NRES,NSTR,NDIS,NROUT(7) R0209350 COMMON /TRASH/IA(20),ND(100),DCOSN(100,3),RRTRAS(130) R0209360 CALL FILES(36) 00209370 REWIND 4 00209380 REWIND 8 00209390 REWIND 9 00209400 READ (NRES) ((ID(I,J),J=1,3),I=1,NUMNP) 00209410 WRITE (8) ((ID(I,J),J=1,3),I=1,NUMNP) 00209420 READ (NRES) ((ID2(I,J),J=1,13),I=1,NUMEL) 00209430 MT=100000000 00209440 DO 100 I=1,NUMEL 00209450 KM=ID2(I,13) 00209460 CALL ELSZ(KM) 00209470 100 CONTINUE 00209480 WRITE (4) ((ID2(I,J),J=1,13),I=1,NUMEL) 00209490 IF(NDKOD.EQ.1) READ (NRES) ((ID4(I,J),J=1,NADND),I=1,NUMEL) 00209500 IF(NDKOD.EQ.1) WRITE (4) ((ID4(I,J),J=1,NADND),I=1,NUMEL) 00209510 IF(NUMEL2.EQ.0) RETURN 00209520 DO 110 I=1,NUMEL2 00209530 READ (NRES) (ID3(J),J=1,9) 00209540 110 WRITE (9) (ID3(J),J=1,9) 00209550 IF(IES.EQ.0)RETURN 00209560 KS1=1 00209570 KS2=2 00209580 REWIND KS1 00209590 REWIND KS2 00209600 DO 401 I=1,IES 00209610 READ(NRES)J1,J2,J3,J4 00209620 WRITE(KS2)J1,J2,J3,J4 00209630 LX=(J4-16)/20+1 00209640 JL=16 00209650 IF(J4.LE.16)JL=J4 00209660 READ(NRES) (IA(K),K=1,JL) 00209670 WRITE(KS2)(IA(K),K=1,JL) 00209680 IF(J4.LE.16)GO TO 405 00209690 DO 402 J=1,LX 00209700 JL=20 00209710 IF(J.EQ.LX)JL=J4-(LX-1)*20-16 00209720 IF(JL.EQ.0)GO TO 405 00209730 READ(NRES) (IA(K),K=1,JL) 00209740 WRITE(KS2)(IA(K),K=1,JL) 00209750 402 CONTINUE 00209760 405 CONTINUE 00209770 READ(NRES) J1,L1 00209780 WRITE(KS1) J1,L1 00209790 LX=L1/100+1 00209800 DO 408 MJ=1,LX 00209810 JL=4 00209820 IF(L1.LT.4)JL=L1 00209830 IF(L1.LE.4)GO TO 407 00209840 JL=100 00209850 IF(MJ.EQ.LX)JL=L1-(LX-1)*100 00209860 407 CONTINUE 00209870 READ(NRES) (ND(K),(DCOSN(K,M),M=1,3),K=1,JL) 00209880 WRITE(KS1) (ND(K),(DCOSN(K,M),M=1,3),K=1,JL) 00209890 408 CONTINUE 00209900 401 CONTINUE 00209910 RETURN 00209920 END 00209930 SUBROUTINE YDSTR2 (T,M,YDSTR ) 00328920 IMPLICIT REAL*8(A-H,O-Z) 00328930 DIMENSION COEF(11,8) 00328940 DATA COEF/ 00328950 1 5.0,100.0,1500.0,34.72464,-6.826723E-2,1.229436E-4,-1.278711E-7, 00328960 1 7.054887E-11,-1.646542E-14,0.0,0.0, 00328970 2 6.0,100.0,1500.0,36.8359,-8.634825E-2,2.121526E-4,-3.445285E-7, 00328980 2 3.353186E-10,-1.707864E-13,3.429939E-17,0.0, 00328990 3 0.0,32.0,2500.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0, 00329000 4 7.0,75.0,1600.0,48.54762,-1.486879E-2,6.903795E-5,-2.698611E-7, 00329010 4 4.532527E-10,-3.453004E-13,1.094993E-16,-9.939983E-21, 00329020 5 4.0,100.0,800.0,55.17627,-6.617713E-2,1.641853E-4,-2.000865E-7, 00329030 5 8.265141E-11,0.0,0.0,0.0, 00329040 6 4.0,100.0,800.0,55.17627,-6.617713E-2,1.641853E-4,-2.000865E-7, 00329050 6 8.265141E-11,0.0,0.0,0.0, 00329060 7 4.0,100.0,800.0,100.0546,-6.381357E-2,1.555042E-4,-2.031958E-7, 00329070 7 7.513135E-11,0.0,0.0,0.0, 00329080 8 0.0,0.0,2500.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0/ 00329090 ICODE=6 00329100 IF(M.LT.1.OR.M.GT.8)CALL RPZLVZ(M,T,ICODE,8) 00329110 N=COEF(1,M) 00329120 T1=COEF(2,M) 00329130 T2=COEF(3,M) 00329140 IF(T.LT.T1.OR.T.GT.T2)CALL RPZLVZ(M,T,ICODE,1) 00329150 YDSTR =COEF(N+4,M) 00329160 IF(N.EQ.0)RETURN 00329170 DO 10 I=1,N 00329180 10 YDSTR =YDSTR *T+COEF(N-I+4,M) 00329190 RETURN 00329200 END 00329210 SUBROUTINE YDSTR1 (T,M,YDSTR ) 00328920 IMPLICIT REAL*8(A-H,O-Z) 00328930 RETURN END 00329210 SUBROUTINE RPZLVZ(MCODE,TEMP,PCODE,ECODE) 00216460 IMPLICIT REAL*8(A-H,O-Z) 00216470 INTEGER PROP(2,10),PCODE,ECODE 00216480 DATA PROP/4HCOND,4HT ,4HSPHT,4H ,4HDENS,4H ,4HALPH,4HZM ,00216490 X 4HMODU,4HE ,4HYDST,4HR ,4HPRAT,4HO ,4HBIYL,4HD ,00216500 X 4HPLAS,4HTC ,4HHBIY,4HLD / 00216510 IF(ECODE.GT.1)GO TO 10 00216520 RETURN 00216530 10 WRITE(6,30)(PROP(I,PCODE),I=1,2),MCODE,ECODE,TEMP 00216540 RETURN 00216550 20 FORMAT(//,68H **** WARNING - YOU HAVE ENTERED THE LMFBR MARERIAL L00216560 2IBRARY ROUTINE ,2A4,18HWITH A TEMPERATURE,F7.0,20H OUT OF VALID RA00216570 3NGE.,/,42H PLEASE CHECK YOUR INPUT. MATERIAL CODE =,I3,/) 00216580 30 FORMAT(//,66H **** ERROR - YOU HAVE ENTERED THE LMFBR MATERIAL LIB00216590 2RARY ROUTINE ,2A4,23HWITH A MATERIAL CODE OF,I5,/,20HONLY CODES 1 00216600 3THROUGH,I3,43H ARE VALID. JOB TERMINATED. TEMPERATURE =,F7.0,/) 00216610 END 00216620