Liren Large Software Subsidy 9

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

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

Wrap

Text File | 1980-01-04 | 57.8 KB | 726 lines

SUBROUTINE ELAST(NUMEL,NUMEL2) 00071800 IMPLICIT REAL*8(A-H,O-Z) 00071810 DIMENSION C(3) 00071820 COMMON/JUNK/KO,IX(5),IXI(5),KN,D, U(3),KN1,I,SC,X(5),UI(3),SCI00071830 & ,RRJUNK(206) R0071831 DATA C/2HNM,2HND,2HNR/ 0 CALL FILES(28) 00071850 WRITE(6,150) 00071860 REWIND 9 00071870 IF (NUMEL2.EQ.0) GO TO 110 00071880 DO 100 I=1,NUMEL2 00071890 100 READ (9) X,SC,U 00071900 KO=1 00071910 110 READ (5,120) IX,D,KN,KN1,U 00071920 120 FORMAT (5I5,3X,A2,2I5,3F10.0) 00071930 IF(IX(1).EQ.0) RETURN 00071940 SC=0 00071950 IF(D.EQ.C(1)) SC=11. 00071960 IF(D.EQ.C(2)) SC=10. 00071970 IF(D.EQ.C(3)) SC=01. 00071980 IF(SC.EQ.0) WRITE(6,130)IX(1) 00071990 130 FORMAT (20X,13HERROR ON NODE,I5) 00072000 IF(SC.EQ.0) GO TO 110 00072010 IF(KO.GT.0) GO TO 180 00072020 IF(KN.EQ.0) GO TO 180 00072030 N=(IX(1)-IXI( 1))/KN-1 00072040 DO 170 I=1,N 00072050 X(1)=IXI(1)+I*KN 00072060 IKN1=I*KN1 00072070 DO 140 J=2,5 00072080 X(J)=IXI(J)+I*KN1 00072090 IF(IXI(J).EQ.0) X(J)=0.0 00072100 140 CONTINUE 00072110 NUMEL2=NUMEL2+1 00072120 150 FORMAT (1X ,20X,16HBOUNDARY ELEMENT,13X,18HNM- NO MOTION, ND-, 00072130 $26H NO DISP., NR- NO ROTATION//20X, 00072140 $60HELEMENT AT NODE NODES DEFINING DIRECT. CODE SPEC., 00072150 $24H SPEC. SPRING/20X, 00072160 $60H NO. NO. I J K L DISP., 00072170 $26H ROTAT. CONSTANT) 00072180 160 FORMAT (20X,I5,2F10.0,3F6.0,6X,A2,2F10.4,E13.5) 00072190 WRITE (9) X,SCI,UI 00072200 170 CONTINUE 00072210 180 KO=0 00072220 NUMEL2=NUMEL2+1 00072230 SCI=SC 00072240 DO 190 I=1,3 00072250 190 UI(I)=U(I) 00072260 DO 200 I=1,5 00072270 X(I)=IX(I) 00072280 200 IXI(I)=IX(I) 00072290 NUM=NUMEL2+NUMEL 00072300 IF(U(3).EQ.0.0) GO TO 1150 00072310 WRITE(6,160)NUM ,X,D,U 00072320 GO TO 1160 00072330 1150 RU=1.0D10 00072340 WRITE(6,160)NUM ,X,D,U(1),U(2),RU 00072350 1160 CONTINUE 00072360 WRITE (9) X,SC,U 00072370 GO TO 110 00072380 END 00072390 SUBROUTINE MATRD (NMRI,NTRI,PROP) 00132140 IMPLICIT REAL*8 (A-H,O-Z) 00132150 REAL*8 NU 00132160 DIMENSION PROP( 200,4) 00132170 COMMON/JUNK/DENS(50),NU(50,2),NL,NM,I,J,K,L,KTEM1,KTEM2,JJJ 00132180 & ,NRJUNK(145) R0132181 COMMON /PREP/ XMX,XAD,KSKIP,NDYN,I1,I99,POS,PRTCOD 00132190 $ ,POSSAV,PRTOFF,PRTON,PRTDUM,IDIRC 00132200 I=0 00132210 NM=0 00132220 NMRI=0 00132230 100 NL=NM 00132240 I=I+1 00132250 READ (5,110) NM,(PROP(I,J),J=1,4),DENSIT 00132260 110 FORMAT (I10,F10.0, 0PF10.0,0PF10.0,0PF10.0,0PF10.0) 00132270 IF(NM.EQ.0) GO TO 140 00132280 IF(NL.EQ.NM) GO TO 120 00132290 NMRI=NMRI+1 00132300 DENS(NMRI)=DENSIT 00132310 NU(NMRI,1)=NM 00132320 NU(NMRI,2)=0 00132330 120 NU(NMRI,2)= NU(NMRI,2)+1 00132340 IM1=I-1 00132350 DO 130 J=1,4 00132360 IF(NL.EQ.NM.AND.PROP(I,J).EQ.0.0) PROP(I,J)=PROP(IM1,J) 00132370 130 CONTINUE 00132380 GO TO 100 00132390 140 NTRI=I-1 00132400 IF(NMRI.EQ.0) RETURN 00132410 KTEM2=0 00132420 DO 180 I=1,NMRI 00132430 KTEM1=KTEM2+1 00132440 KTEM2=KTEM2+NU(I,2) 00132450 IF (KTEM1.EQ.KTEM2) GO TO 180 00132460 JJJ=KTEM1 00132470 DO 170 J=KTEM1,KTEM2 00132480 JJJ=JJJ+1 00132490 IF(JJJ.GT.KTEM2) GO TO 170 00132500 DO 160 K= JJJ,KTEM2 00132510 IF(PROP(J,1).LE.PROP(K,1)) GO TO 160 00132520 DO 150 L=1,4 00132530 ZZ=PROP(K,L) 00132540 PROP(K,L)=PROP(J,L) 00132550 150 PROP(J,L)=ZZ 00132560 160 CONTINUE 00132570 170 CONTINUE 00132580 180 CONTINUE 00132590 IF(PRTCOD.EQ.PRTOFF) GO TO 195 00132600 IF(POS.EQ.PRTDUM.AND.PRTCOD.NE.PRTON) GO TO 195 00132610 WRITE(6,190) 00132620 190 FORMAT (1X //30X,33HUSER SUPPLIED MATERIAL LIBRARY/30X, 00132630 $31HTHIS IS IN ADDITION TO THE/30X, 00132640 $34HSAP6 MATERIAL PROPERTY LIBRARY ///10X, 00132650 $12HMATERIAL NO.,4X,11HTEMPERATURE,6X,14HYOUNGS MODULUS,7X, 00132660 $36HPOISSONS RATIO COEF. THERM. EXPAN.,7X, 00132670 $7HDENSITY//) 00132680 195 CONTINUE 00132690 KTEM2=0 00132700 DO 210 I=1,NMRI 00132710 KTEM1=KTEM2+1 00132720 KTEM2=KTEM2+NU(I,2) 00132730 NO=NU(I,1) 00132740 DO 200 J=KTEM1,KTEM2 00132750 IF(PROP(J,3).GT.0.5) WRITE(6,240) 00132760 IF(PRTCOD.EQ.PRTOFF) GO TO 200 00132770 IF(POS.EQ.PRTDUM.AND.PRTCOD.NE.PRTON) GO TO 200 00132780 WRITE(6,220) NO,(PROP(J,L),L=1,4),DENS(I) 00132790 200 CONTINUE 00132800 210 CONTINUE 00132810 220 FORMAT(I17,F17.2,1PE21.4,E21.4,E19.4,E21.4) 00132820 WRITE (3) ((PROP(I,J),I=1,NTRI),J=1,4),(DENS(I),I=1,NMRI), 00132830 $((NU(I,J),I=1,NMRI),J=1,2) 00132840 WRITE (6,1009) ((PROP(I,J),I=1,NTRI),J=1,4),(DENS(I),I=1,NMRI), 00132830 $((NU(I,J),I=1,NMRI),J=1,2) 00132840 1009 FORMAT (1X,'**MO**',12E10.4/) 240 FORMAT(1H0,9X,55HWARNING--POISSONS RATIO WAS SPECIFIED GREATER THA00132850 $N 0.5.) 00132860 RETURN 00132870 END 00132880 SUBROUTINE RDFEDG(NUMNP,NUMEL,IES,ID,ID2,ID4,KK,JJ,NADND,NADEL, 00196670 $NDKOD,NDMZ) 00196680 IMPLICIT REAL*8(A-H,O-Z) 00196690 REAL*8 ID,ID2 00196700 REAL*8 ID4 00196710 REAL*8 MT2 00196720 DIMENSION ID(NUMNP,3),ID2(NUMEL,13),IC(6) 00196730 DIMENSION ID4(NADEL,NADND),IXX(13),IAA(12) 00196740 DIMENSION JJ(3) 00196750 COMMON/PREP/XMX,XAD,KSKIP,NDYN,I1,RRPREP(7) R0196760 COMMON/JUNK/ I,J,K,L,KM,NNN,NN1,NN2,NN3,JN,J1,J2,J3,J4,NN,LX,JK,JL00196770 & ,RRJUNK(218) R0196771 COMMON/TRASH/IA(20),ND(100),DCOSN(100,3),X,IX(8),RRTRAS(125) R0196780 COMMON/SIZE/NDMX,NRSIZE(4) R0196790 DIMENSION IPERM(4,2) 00196800 DATA IPERM/4,1,2,3,2,3,4,1/ 00196810 DATA D/3HEND/ 00196820 CALL FILES(30) 00196830 XM=XMX/2. 00196840 REWIND 4 00196850 REWIND 8 00196860 IF(KK.EQ.2) GO TO 430 00196870 IF(KK.EQ.3) GO TO 600 00196880 REWIND 1 00196890 REWIND 2 00196900 IU=5 00196910 IF(IA(1).EQ.1) IU=19 00196920 READ(IU,100)((ID(I,J),J=1,3),I=1,NUMNP) 00196930 100 FORMAT(2(4X,3F10.5,6X)) 00196940 110 FORMAT (//20X, 17H A COORD. OF NODE,I5, 61H HAS BEEN FOUND TO BE L00196950 $ARGER THAN THE MAX. DIMENSION ALLOWED.//) 00196960 DO 140 I=1,NUMNP 00196970 DO 120 J=1,3 00196980 IF( DABS(ID(I,J)).GT.XM) WRITE(6,110)I 00196990 IF( DABS(ID(I,J)).GT.XM) KSKIP=1 00197000 120 ID(I,J)=ID(I,J)/XMX+XAD 00197010 130 CONTINUE 00197020 140 CONTINUE 00197030 XADI1=1.0+I1+XAD 00197040 WRITE (8) ((ID(I,J),J=1,3),I=1,NUMNP) 00197050 MT=10000 00197060 MT2=MT*MT 00197070 IF(NDKOD.EQ.1) GO TO 180 00197080 READ(IU,170)(ID2(I,13),(ID2(I,J),J=1,8),(ID2(I,J),J=9,12), 00197090 1I=1,NUMEL) 00197100 170 FORMAT(2(3X,F5.0,8F8.0)) 00197110 GO TO 230 00197120 180 DO 220 I=1,NUMEL 00197130 READ(IU,190) ID2(I,13),(ID2(I,J),J=1,8),(ID2(I,J),J=9,12) 00197140 190 FORMAT(3X,F5.0,8F8.0) 00197150 READ(IU,200)(ND(J),J=9,NDMX) 00197160 200 FORMAT(20I4) 00197170 KOUNT=0 00197180 DO 210 J=9,NDMX,1 00197190 KOUNT=KOUNT+1 00197200 210 ID4(I,KOUNT)=ND(J) 00197210 220 CONTINUE 00197220 230 CONTINUE 00197230 KM=10000 00197240 DO 270 I=1,NUMEL 00197250 NN1=ID2(I,13) 00197260 IF(NN1.EQ.0) NN1=7 00197270 CALL ELSZ(NN1) 00197280 ID2(I,13)=NN1 00197290 IF(JJ(1).EQ.1) WRITE(6,240)I,(ID2(I,J),J=1,8) 00197300 240 FORMAT(/20X,I5,8F10.0) 00197310 DO 250 J=1,8 00197320 NNN=ID2(I,J) 00197330 IX(J)=NNN 00197340 250 CONTINUE 00197350 DO 260 J=1,8 00197360 260 ID2(I,J)=IX(J) 00197370 270 CONTINUE 00197380 IF(IES.LE.0) GO TO 400 00197390 DO 390 I=1,IES 00197400 JN=16 00197410 READ(IU,280) J1,J2,J3,J4,(IA(J),J=1,16) 00197420 280 FORMAT (20I4) 00197430 IF (J4.LE.16) JN=J4 00197440 IF(J2.EQ.1.OR.J2.EQ.2) J2=12 00197450 IF(J2.EQ.3.OR.J2.EQ.4) J2=34 00197460 IF(J2.EQ.5.OR.J2.EQ.6) J2=56 00197470 IF(J3.NE.5) GO TO 300 00197480 DO 290 J=1,JN 00197490 NN=IA(J) 00197500 ZNN=ID2(NN,13) 00197510 ID2(NN,13)=ZNN 00197520 290 CONTINUE 00197530 300 WRITE (2) J1,J2,J3,J4 00197540 WRITE (2) (IA(J),J=1,JN) 00197550 IF(J4.LE.16) GO TO 340 00197560 310 READ(IU,280) IA 00197570 JN=JN+20 00197580 DO 330 J=1,20 00197590 NN=IA(J) 00197600 IF(NN.LE.0) GO TO 330 00197610 IF(J3.NE.5) GO TO 320 00197620 ZNN=ID2(NN,13) 00197630 ID2(NN,13)=ZNN 00197640 320 NNN=J 00197650 330 CONTINUE 00197660 WRITE (2) (IA(J),J=1,NNN) 00197670 IF(JN.LT.J4) GO TO 310 00197680 340 CONTINUE 00197690 READ(IU,350) L1,(ND(J),(DCOSN(J,K),K=1,3),J=1,4) 00197700 JN=4 00197710 LX=L1/100+1 00197720 IF(L1.LT.4) JN=L1 00197730 350 FORMAT (I4,4(I4,3F5.3)) 00197740 WRITE (1) J1,L1 00197750 IF (L1.LE.4) 00197760 $WRITE (1) (ND(J),(DCOSN(J,K),K=1,3),J=1,JN) 00197770 IF(L1.LE.4) GO TO 390 00197780 360 JK=5 00197790 DO 370 J=1,LX 00197800 JL=100 00197810 IF(J.EQ.LX) JL=L1-(LX-1)*100 00197820 READ(IU,380) (ND(K),(DCOSN(K,L),L=1,3),K=JK,JL) 00197830 WRITE (1) (ND(K),(DCOSN(K,L),L=1,3),K= 1,JL) 00197840 370 JK=1 00197850 380 FORMAT((4X,4(I4,3F5.3))) 00197860 390 CONTINUE 00197870 400 CONTINUE 00197880 WRITE (4) ((ID2(I,J),J=1,13),I=1,NUMEL) 00197890 IF(NDKOD.EQ.1) WRITE(4) ((ID4(I,J),J=1,NADND),I=1,NUMEL) 00197900 READ (IU,410) X 00197910 410 FORMAT (A3) 00197920 NDMZ=NDMX 00197930 IF(X.EQ.D) RETURN 00197940 WRITE(6,420) 00197950 420 FORMAT (1X ,20X, 48H END CARD AT THE END OF FEDGE INPUT NOT DETECT00197960 $ED, 20HEXECUTION TERMINATED) 00197970 CALL CLOSE 00197980 CALL EXIT 00197990 430 READ (5,440) ((ID2(I,J),J=1,8),I=1,NUMEL) 00198000 440 FORMAT(4(4X,8F4.0)) 00198010 CALL ELSZ(4) 00198020 DO 450 I=1,NUMEL 00198030 450 ID2(I,13)=4 00198040 WRITE (4) ((ID2(I,J),J=1,13),I=1,NUMEL) 00198050 READ (5,460) ((ID(I,J),J=2,3),I=1,NUMNP) 00198060 460 FORMAT(2(4X,2F18.6)) 00198070 XADI1=1.0+I1+XAD 00198080 DO 470 I=1,NUMNP 00198090 470 ID(I,1)=XADI1 00198100 DO 490 I=1,NUMNP 00198110 DO 480 J=2,3 00198120 IF( DABS(ID(I,J)).GT.XM) WRITE(6,110)I 00198130 IF( DABS(ID(I,J)).GT.XM) KSKIP=1 00198140 480 ID(I,J)=ID(I,J)/XMX+XAD+I1 00198150 490 CONTINUE 00198160 WRITE (8) ((ID(I,J),J=1,3),I=1,NUMNP) 00198170 REWIND 4 00198180 READ(4)((ID2 (I,J),J=1,13),I=1,NUMEL) 00198190 DO 520 I=1,3 00198200 LX=JJ(I) 00198210 IF(LX.EQ.0) GO TO 520 00198220 J3=20 00198230 LX=(LX-1)/20+1 00198240 IF(I.EQ.3) GO TO 499 00198250 IF(IES .LE.0) GO TO 499 00198260 IF(I.EQ.1.AND.IES.EQ.2) GO TO 499 00198270 IF(I.EQ.2.AND.IES.EQ.1) GO TO 499 00198280 KM=I*10000 00198290 JL=0 00198300 DO 498 J=1,LX 00198310 ND(1)=ND(J3) 00198320 J2=2 00198330 IF(J.EQ.1) J2=1 00198340 J3=J2+19 00198350 READ (5,200) (ND(K),K=J2,J3) 00198360 JN=19 00198370 IF(J.GT.1) JN=20 00198380 DO 497 M=1,JN 00198390 JL=JL+1 00198400 IF(JL.EQ.JJ(I)) GO TO 520 00198410 DO 491 N=1,NUMEL 00198420 DO 491 J2=1,4 00198430 NN1=N 00198440 NN2=J2 00198450 L1=IPERM(J2,I) 00198460 IF(ND(M).EQ.ID2(N,J2).AND.ND(M+1).EQ.ID2(N,L1)) GO TO 492 00198470 491 NN1=-1 00198480 492 N=1 00198490 IF(NN1.GT.0) ID2(NN1,13)=ID2(NN1,13)+KM 00198500 IF(NN2.EQ.2.OR.NN1.LT.0) GO TO 497 00198510 IF(NN2.EQ.4) N=2 00198520 JK=1 00198530 IF(NN2.EQ.3) JK=2 00198540 DO 495 K=1,N 00198550 DO 493 J2=1,4 00198560 493 IA(J2)=ID2(NN1,J2) 00198570 DO 494 J2=1,4 00198580 L1=IPERM(J2,JK) 00198590 494 ID2(NN1,J2)=IA(L1) 00198600 IF(IA(3).EQ.IA(4).AND.JK.EQ.1) ID2(NN1,4)=ID2(NN1,3) 00198610 IF(IA(3).EQ.IA(4).AND.JK.EQ.2) ID2(NN1,3)=ID2(NN1,4) 00198620 495 CONTINUE 00198630 497 CONTINUE 00198640 498 CONTINUE 00198650 GO TO 520 00198660 499 CONTINUE 00198670 DO 500 J=1,LX 00198680 500 READ (5,510) KM 00198690 510 FORMAT (I4,76X) 00198700 520 CONTINUE 00198710 IES=0 00198720 REWIND 4 00198730 WRITE (4)((ID2(I,J),J=1,13),I=1,NUMEL) 00198740 NDMZ=NDMX 00198750 RETURN 00198760 600 IU=19 00198770 IF(IA(1).EQ.1) IU=1 00198780 IF(JJ(1).EQ.0) WRITE(6,830) 00198790 DO 640 I=1,NUMNP 00198800 READ(IU,810)K,(IC(L),L=1,6),(ID(K,J),J=1,3) 00198810 IF(JJ(1).EQ.0) WRITE(6,820)K,(IC(L),L=1,6),(ID(K,J),J=1,3) 00198820 DO 620 J=1,3 00198830 IF( DABS(ID(I,J)).GT.XM) WRITE(6,110)I 00198840 IF( DABS(ID(I,J)).GT.XM) KSKIP=1 00198850 NN1=0 00198860 NN2=0 00198870 IF(IC(J).EQ.1) NN1=1 00198880 IF(IC(J+3).EQ.1) NN2=1 00198890 ID(I,J)=ID(I,J)/XMX+XAD 00198900 NNN=ID(I,J) 00198910 ID(I,J)=(ID(I,J)-NNN)+NN1+NN2*I1 00198920 620 CONTINUE 00198930 630 CONTINUE 00198940 640 CONTINUE 00198950 XADI1=1.0+I1+XAD 00198960 WRITE (8) ((ID(I,J),J=1,3),I=1,NUMNP) 00198970 680 CONTINUE 00198980 IF(JJ(1).EQ.0) WRITE(6,840) 00198990 IF(JJ(1).EQ.0) WRITE(6,850) 00199000 DO 720 I=1,NUMEL 00199010 READ(IU,800) K,IXX(13),(IXX(J),J=1,8),(IXX(J),J=9,12) 00199020 IF(K.GT.NUMEL) WRITE(6,880)K,IXX(13),(IXX(J),J=1,8) 00199030 1,(IXX(J),J=9,12),K,NUMEL 00199040 IF(K.GT.NUMEL) STOP 00199050 IF(JJ(1).EQ.0) 00199060 1WRITE(6,860) K,IXX(13),(IXX(J),J=1,8),(IXX(J),J=9,12) 00199070 DO 690 J=1,13 00199080 690 ID2(K,J)=IXX(J) 00199090 MT=ID2(K,13) 00199100 IF(MT.EQ.10) 00199110 1READ(IU,800)(ND(J),J=9,NDMX) 00199120 IF(MT.NE.10) GO TO 720 00199130 IF(JJ(1).EQ.0) WRITE(6,870)(ND(J),J=9,NDMX) 00199140 KOUNT=0 00199150 DO 710 J=9,NDMX,1 00199160 KOUNT=KOUNT+1 00199170 710 ID4(I,KOUNT)=ND(J) 00199180 720 CONTINUE 00199190 DO 770 I=1,NUMEL 00199200 NN1=ID2(I,13) 00199210 IF(NN1.EQ.0) NN1=7 00199220 CALL ELSZ(NN1) 00199230 ID2(I,13)=NN1 00199240 DO 750 J=1,8 00199250 NNN=ID2(I,J) 00199260 IX(J)=NNN 00199270 750 CONTINUE 00199280 DO 760 J=1,8 00199290 760 ID2(I,J)=IX(J) 00199300 770 CONTINUE 00199310 DO 775 II=1,NUMEL R0199311 WRITE (4) (ID2(II,J),J=1,13) R0199320 IF(NDKOD.EQ.1) WRITE(4) (ID4(II,J),J=1,NADND) R0199330 775 CONTINUE R0199321 RETURN 00199340 790 FORMAT(/20X,I5,8F10.0) 00199350 800 FORMAT( 14I5) 00199360 810 FORMAT(7I5,3F10.0) 00199370 820 FORMAT(5X,I8,6I10,5X,E10.3,5X,E10.3,5X,E10.3) 00199380 830 FORMAT(1X //,55X,10HNODE INPUT,/,55X,10(1H-),/, 00199390 15X,8HNODE NO.,8X,2HDX,8X,2HDY,8X,2HDZ,8X,2HRX,8X,2HRY, 00199400 18X,2HRZ,10X,1HX,14X,1HY,14X,1HZ) 00199410 840 FORMAT (1X ,//,55X,13HELEMENT INPUT,/,55X,13(1H-),/,20X, 00199420 $50HN1-MATL. NO. OR GEOMETRIC PROPERTY (TRUSS OR BEAM)//20X, 00199430 $ 90HN2-THICK TYPE - PLANE STRESS OR SHELL ELEMENTS OR INTEGRATIO00199440 $N OEDER FOR THE SOLID ELEMENT /23X, 00199450 $44HOR SECTION PROPERTY TYPE NO FOR BEAM ELEMENT //20X, 00199460 $ 67HN3-PRESSURE SET NO.- SOLID ELEMENTS, SHELL ELEMENTS OR AXI00199470 $SYMMETRIC//20X, 00199480 $ 57HN4-STRESS FACES - SOLID ELEMENT OR END RELEASE SET - BEA00199490 $M /23X, 00199500 $50HOR SECTION PROPERTY TYPE NO FOR CURVED BEAM(ELBOW) ///) 00199510 850 FORMAT (20X, 13HELEMENT TYPE//20X, 00199520 $ 63H NO. NO. I J K L M N O P N100199530 $ , 24HN2 N3 N4 KN1 KN2// ) 00199540 860 FORMAT(20X,I5,I7,I8,13I5) 00199550 870 FORMAT(12X,16HADDITIONAL NODES,I8,13I5) 00199560 880 FORMAT(20X,I5,I7,I8,11I5,//,5X, 00199570 132H **** ERROR *** ELEMENT NUMBER =,I5,5X, 00199580 253H IS GREATER THAN MAXIMUM NUMBER OF ELEMENTS (NUMEL) =,I5//5X, 00199590 351HCHECK YOUR FINITE ELEMENT MODEL AS GENERATED BY THE, 00199600 429H PREPROCESSOR PROGRAM *MODEL*) 00199610 END 00199620 SUBROUTINE MATRDA(NMRI,NTRI,PROP) 00132890 IMPLICIT REAL*8 (A-H,O-Z) 00132900 REAL*8 NU 00132910 DIMENSION PROP(200,9) 00132920 COMMON/JUNK/DENS(50),NU(50,2),NL,NM,I,J,K,L,KTEM1,KTEM2,JJJ, R0132930 & NRJUNK(145) R0132931 FX=0.5 00132940 EX=1.0E+06 00132950 I=0 00132960 NM=0 00132970 NMRI=0 00132980 100 NL=NM 00132990 I=I+1 00133000 READ(5,110)NM,(PROP(I,J),J=1,7) 00133010 110 FORMAT(I10,7F10.0) 00133020 IF(NM.EQ.0) GO TO 140 00133030 READ(5,111)PROP(I,8),DENSIT,PROP(I,9) 00133040 111 FORMAT(8F10.0) 00133050 IF(NL.EQ.NM) GO TO 120 00133060 NMRI=NMRI+1 00133070 DENS(NMRI)=DENSIT 00133080 NU(NMRI,1)=NM 00133090 NU(NMRI,2)=0 00133100 120 NU(NMRI,2)= NU(NMRI,2)+1 00133110 IM1=I-1 00133120 DO 130 J=1,9 00133130 IF(NL.EQ.NM.AND.PROP(I,J).EQ.0.0) PROP(I,J)=PROP(IM1,J) 00133140 130 CONTINUE 00133150 GO TO 100 00133160 140 NTRI=I-1 00133170 IF(NMRI.EQ.0) RETURN 00133180 KTEM2=0 00133190 DO 180 I=1,NMRI 00133200 KTEM1=KTEM2+1 00133210 KTEM2=KTEM2+NU(I,2) 00133220 IF (KTEM1.EQ.KTEM2) GO TO 180 00133230 JJJ=KTEM1 00133240 DO 170 J=KTEM1,KTEM2 00133250 JJJ=JJJ+1 00133260 IF(JJJ.GT.KTEM2) GO TO 170 00133270 DO 160 K= JJJ,KTEM2 00133280 IF(PROP(J,1).LE.PROP(K,1)) GO TO 160 00133290 DO 150 L=1,9 00133300 ZZ=PROP(K,L) 00133310 PROP(K,L)=PROP(J,L) 00133320 150 PROP(J,L)=ZZ 00133330 160 CONTINUE 00133340 170 CONTINUE 00133350 180 CONTINUE 00133360 WRITE (6,190) 00133370 190 FORMAT(1X //45X,33HUSER SUPPLIED MATERIAL LIBRARY/ 00133380 1 35X,46H ORTHOTROPIC MATERIAL PROPERTIES (81-100) //, 00133390 2 124H MAT. TEMPERATURE E-RR E-ZZ E-THETA V-ZR 00133400 3 V-TR V-TZ G-RZ ALPHA DENSITY //)00133410 KTEM2=0 00133420 DO 210 I=1,NMRI 00133430 KTEM1=KTEM2+1 00133440 KTEM2=KTEM2+NU(I,2) 00133450 NO=NU(I,1) 00133460 DO 200 J=KTEM1,KTEM2 00133470 IF(PROP(J,2).LT.EX.OR.PROP(J,3).LT.EX.OR.PROP(J,4).LT.EX) 00133480 1WRITE(6,230) 00133490 IF(PROP(J,5).GT.FX.OR.PROP(J,6).GT.FX.OR.PROP(J,7).GT.FX) 00133500 1WRITE(6,240) 00133510 200 WRITE(6,220) NO,(PROP(J,L),L=1,9),DENS(I) 00133520 210 CONTINUE 00133530 220 FORMAT(I5,4X,10(2X,G9.3)) 00133540 WRITE (3) ((PROP(I,J),I=1,NTRI),J=1,9 ),(DENS(I),I=1,NMRI), 00133550 $((NU(I,J),I=1,NMRI),J=1,2) 00133560 230 FORMAT(1H0,9X,56HWARNING--YOUNGS MODULUS WAS SPECIFIED LESS THAN 100133570 $.0E+06.) 00133580 240 FORMAT(1H0,9X,55HWARNING--POISSONS RATIO WAS SPECIFIED GREATER THA00133590 $N 0.5.) 00133600 RETURN 00133610 END 00133620 SUBROUTINE COORD(N) 00051420 IMPLICIT REAL*8(A-H,O-Z) 00051430 COMMON/JUNK/ X1,Y1,Z1,X2,Y2,Z2,C,S1,S2,AX,AY,AZ,RRJUNK(215) R0051440 COMMON/QTSARG/ X(3,50),Y(3,50),Z(3,50),TI(3,3,50),XC(3),XI(3) 00051450 & ,RRQTSA(94) R0051451 DO 100 I=1,N 00051460 X1=X(2,I)-X(1,I) 00051470 Y1=Y(2,I)-Y(1,I) 00051480 Z1=Z(2,I)-Z(1,I) 00051490 X2=X(3,I)-X(1,I) 00051500 Y2=Y(3,I)-Y(1,I) 00051510 Z2=Z(3,I)-Z(1,I) 00051520 S1=X1*X1+Y1*Y1+Z1*Z1 00051530 S1= DSQRT(S1) 00051540 AX=Y1*Z2-Z1*Y2 00051550 AY=Z1*X2-X1*Z2 00051560 AZ=X1*Y2-Y1*X2 00051570 S2=AX*AX+AY*AY+AZ*AZ 00051580 S2= DSQRT(S2) 00051590 X1=X1/S1 00051600 Y1=Y1/S1 00051610 Z1=Z1/S1 00051620 AX=AX/S2 00051630 AY=AY/S2 00051640 AZ=AZ/S2 00051650 X2=AY*Z1-AZ*Y1 00051660 Y2=AZ*X1-AX*Z1 00051670 Z2=AX*Y1-AY*X1 00051680 TI(1,1,I)=X1 00051690 TI(1,2,I)=Y1 00051700 TI(1,3,I)=Z1 00051710 TI(2,1,I)=X2 00051720 TI(2,2,I)=Y2 00051730 TI(2,3,I)=Z2 00051740 TI(3,1,I)=AX 00051750 TI(3,2,I)=AY 00051760 100 TI(3,3,I)=AZ 00051770 RETURN 00051780 END 00051790 SUBROUTINE TIE(ID,NUMNP) 00305700 IMPLICIT REAL*8(A-H,O-Z) 00305710 REAL*8 ID 00305720 COMMON/PREP/XMX,XAD,KSKIP,NDYN,I1,RRPREP(7) R0305730 DIMENSION ID(NUMNP,3),C1(4),N(15) 00305740 DATA C1/1HX,1HY,1HZ,1H / 00305750 CALL FILES(35) 00305760 NG=1000 00305770 KNT=0 00305780 REWIND 8 00305790 READ (8) ((ID(I,J),J=1,3),I=1,NUMNP) 00305800 100 READ (5,110)C,N 00305810 110 FORMAT (A1,4X,15I5) 00305820 IF(N(1).EQ.0)GO TO 190 00305830 WRITE(6,120)C,N 00305840 120 FORMAT (20X,A1,9X,15I6) 00305850 IF(C.EQ.C1(4)) GO TO 150 00305860 J=0 00305870 DO 130 I=1,3 00305880 IF(C.EQ.C1(I)) J=I 00305890 130 CONTINUE 00305900 IF(J.EQ.0) GO TO 200 00305910 140 FORMAT (//20X,31HERROR ON THE LAST CARD PRINTED.//) 00305920 KNT=KNT+1 00305930 KNT1=-1 00305940 NEQ=NG*KNT 00305950 150 IF(KNT.EQ.0) GO TO 100 00305960 DO 180 I=1,15 00305970 IF(N(I).EQ.0) GO TO 180 00305980 IF(I.EQ.1) GO TO 170 00305990 IF(N(I-1).LT.0) GO TO 180 00306000 IF(N(I).GT.0) GO TO 170 00306010 KN=N(I+1) 00306020 KF=-N(I) 00306030 KI=N(I-1)+KN 00306040 DO 160 II=KI,KF,KN 00306050 KNT1=KNT1+1 00306060 NNN=ID(II,J) 00306070 NNN= MOD(NNN,I1) 00306080 ID(II,J)=NEQ+KNT1+ID(II,J)-NNN 00306090 160 CONTINUE 00306100 GO TO 180 00306110 170 CONTINUE 00306120 KNT1=KNT1+1 00306130 II=N(I) 00306140 NNN=ID(II,J) 00306150 NNN= MOD(NNN,I1) 00306160 ID(II,J)=NEQ+KNT1+ID(II,J)-NNN 00306170 180 CONTINUE 00306180 GO TO 100 00306190 190 REWIND 8 00306200 WRITE (8) ((ID(I,J),J=1,3),I=1,NUMNP) 00306210 RETURN 00306220 200 WRITE(6,140) 00306230 KSKIP=1 00306240 GO TO 100 00306250 END 00306260 SUBROUTINE TEMPRD(NUMNP,NTU,MTOT ,NTYP) 00300080 IMPLICIT REAL*8(A-H,O-Z) 00300090 COMMON /SIZE/NDMX,NRSIZE(4) R0300100 COMMON A(1) 00300110 COMMON /ELTEMP/ TAVG,KET,NL,TIM(100),RRELTE R0300120 COMMON /MISC/ NBLOCK,NEQB,LL,NF,LB R0300130 COMMON /PREP/XD(2),KSKIP,RRPREP(8) R0300140 CALL FILES(31) 00300150 ERROR=1.0E-6 00300160 IF(NTU.GE.2) NTU=11 00300170 IF(NTU.EQ.1) NTU=5 00300180 IF(NTU.LT.1) WRITE(6,100)NTU 00300190 100 FORMAT (1X ,20X, 91HTHE WRONG CODE WAS PUNCHED FOR SPECIFYING WHET00300200 $HER PUNCHED CARDS OR MAG. TAPE IS BEING USED./20X, 00300210 $ 43HTHE CODE MUST BE 1 OR 2, BUT WAS PUNCHED AS,I5//) 00300220 IF(NTU.LT.1) RETURN 00300230 IF(NTU.GT.7) REWIND NTU 00300240 110 FORMAT (3I5) 00300250 READ (NTU,110) KK,NT,NDOF 00300260 IF(KK.NE.3) WRITE(6,120) 00300270 120 FORMAT (1X ,20X, 44H THE TEMP. IDENTIFIER (3) COULD NOT BE FOUND//00300280 $) 00300290 IF(KK.NE.3) RETURN 00300300 IF(NDOF.LT.2) NDOF=1 00300310 IF(NDOF.GE.2) NDOF=2 00300320 IF(NDOF.EQ.2.AND.NDMX.LT.8) NDMX=8 00300330 NREC=NT*(NDOF*NUMNP+1) 00300340 IF(NTU.EQ.5) GO TO 180 00300350 NREC=0 00300360 DO 170 I=1,NT 00300370 READ (NTU,130)TIME 00300380 130 FORMAT(F10.2) 00300390 NFL=0 00300400 DO 140 J=1,LL 00300410 DELTA= DABS(TIM(J)-TIME) 00300420 IF(DELTA.LT.ERROR) NFL=1 00300430 140 CONTINUE 00300440 IF(NFL.GT.0) NREC=NREC+1 00300450 DO 150 J=1,NDOF 00300460 150 READ (NTU,160) (A(K),K=1,NUMNP) 00300470 160 FORMAT(8F10.0) 00300480 170 CONTINUE 00300490 REWIND NTU 00300500 READ (NTU,110) KK 00300510 NREC=NREC*(NDOF*NUMNP+1) 00300520 IF(NREC.GT.0) GO TO 180 00300530 WRITE(6,175) 00300540 175 FORMAT(//10X,48HNO TEMPERATURE DISTRIBUTIONS WERE FOUND AT TIMES, 00300550 $26H LISTED ON LOADFACT CARDS.//) 00300560 KSKIP=1 00300570 RETURN 00300580 180 CONTINUE 00300590 NREC=NREC/(MTOT-NTYP-100)+1 00300600 NT1=(MTOT-NTYP-400)/(NDOF*NUMNP+1) 00300610 NTP1=NT1+1 00300620 CALL TEMPIN (NTU,NREC,NDOF,NUMNP,NT,A(1),A(NTP1),NT1) 00300630 RETURN 00300640 END 00300650 SUBROUTINE TEMPIN(NTU,NREC,NDOF,NUMNP,NT,TIME,T,NT1) 00299580 IMPLICIT REAL*8(A-H,O-Z) 00299590 DIMENSION T(NT1,NUMNP,NDOF),TIME(NT1) 00299600 COMMON /ELTEMP/ TAVG,KET,NL,TIM(100),RRELTE R0299610 COMMON /MISC/ NBLOCK,NEQB,LL,NF,LB R0299620 CALL FILES(32) 00299630 ERROR=1.0E-6 00299640 REWIND 10 00299650 WRITE (10) NREC,NDOF 00299660 WRITE(6,100) 00299670 100 FORMAT (1X ,20X,28H NODAL TEMPERATURES AS INPUT//) 00299680 K=0 00299690 DO 230 II=1,NREC 00299700 I=1 00299710 105 NFL=0 00299720 K=K+1 00299730 M=I 00299740 READ (NTU,110) TIME(I) 00299750 110 FORMAT (F10.2) 00299760 DO 120 J=1,NDOF 00299770 120 READ (NTU,140) (T(I,KK,J),KK=1,NUMNP) 00299780 IF(NTU.EQ.5) GO TO 135 00299790 DO 130 J=1,LL 00299800 DELTA= DABS(TIM(J)-TIME(I)) 00299810 IF(DELTA.LT.ERROR) NFL=1 00299820 130 CONTINUE 00299830 IF(K.EQ.NT.AND.NFL.EQ.0) M=M-1 00299840 IF(NFL.GT.0) I=I+1 00299850 135 IF(NTU.EQ.5) I=I+1 00299860 IF(K.EQ.NT) GO TO 150 00299870 IF(I.LE.NT1) GO TO 105 00299880 140 FORMAT (8F10.3) 00299890 150 WRITE (10) M 00299900 160 WRITE(10)(TIME(I),((T(I,J,KC),J=1,NUMNP),KC=1,NDOF),I=1,M) 00299910 DO 180 I=1,M 00299920 WRITE(6,170)TIME(I) 00299930 170 FORMAT (//20X,23H TEMPERATURES AT TIME =,F15.5//) 00299940 IF(NDOF.EQ.1) WRITE(6,190) 00299950 IF(NDOF.EQ.2) WRITE(6,200) 00299960 IF(NDOF.EQ.1) WRITE(6,210)(J, T(I,J,1), J=1,NUMNP) 00299970 IF(NDOF.EQ.2) WRITE(6,220)(J,(T(I,J,KC),KC=1,2),J=1,NUMNP) 00299980 180 CONTINUE 00299990 190 FORMAT (15X,6(15H NODE TEMP. )//) 00300000 200 FORMAT (10X,4(25H NODE TEMP. GRAD.)//) 00300010 210 FORMAT((15X,6(I5, F10.3))) 00300020 220 FORMAT((10X,4(I5,2F10.3))) 00300030 230 CONTINUE 00300040 READ (NTU,110) TIME(1) 00300050 RETURN 00300060 END 00300070 SUBROUTINE DATE(NOWDTE) 00052140 CALL TIME(NOWDTE) 00052150 RETURN 00052160 END 00052170 SUBROUTINE TIME(NN) RETURN END