Liren Large Software Subsidy 9

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

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

Wrap

Text File | 1980-01-04 | 89.8 KB | 1,123 lines

SUBROUTINE TEMPER(NUMEL,ID2,ID4,TEMPD,LL,NUMNP,NDMX,NADEL,NADND) 00299060 IMPLICIT REAL*8 (A-H,O-Z) 00299070 REAL*8 ID4 00299080 REAL*8 ID2 00299090 DIMENSION ID4(NADEL,NADND),TEMPD(NDMX,LL) 00299100 DIMENSION ID2(NUMEL,13) 00299110 COMMON /ELTEMP/ TAVG,KET,NL,TIM(100),RRELTE R0299120 COMMON A(1) 00299130 CALL FILES(33) 00299140 KET=-KET 00299150 TAVGI=TAVG 00299160 100 CONTINUE 00299170 REWIND 4 00299180 DO 104 II=1,NUMEL R0299181 READ (4) (ID2(II,J),J=1,13) R0299190 IF(NADEL.GT.1) READ (4) (ID4(II,J),J=1,NADND) R0299200 104 CONTINUE R0299201 REWIND 4 00299210 DO 107 II=1,NUMEL R0299211 WRITE (4) (ID2(II,J),J=1,13) R0299220 IF(NADEL.GT.1) WRITE(4) (ID4(II,J),J=1,NADND) R0299230 107 CONTINUE R0299231 DO 110 I=1,NUMEL 00299240 WRITE (4) (ID2(I,J),J=1,13) 00299250 IF(NADEL.GT.1) WRITE (4) (ID4(I,J),J=1,NADND) 00299260 110 CONTINUE 00299270 REWIND 4 00299280 DO 115 II=1,NUMEL R0299291 READ (4) (ID2(II,J),J=1,13) R0299290 IF(NADEL.GT.1) READ(4) (ID4(II,J),J=1,NADND) R0299300 115 CONTINUE R0299301 REWIND 10 00299310 READ (10) NREC,NDOF 00299320 N1=1 00299330 REWIND 17 00299340 REWIND 18 00299350 120 CONTINUE 00299360 DO 130 I=1,NREC 00299370 READ (10) M 00299380 MP=N1+M+1 00299390 N2=MP+NADND 00299400 NP=N2+NDMX*LL 00299410 CALL TEMSET(A(N1),A(MP),A(NP),M,LL,NUMEL,NREC,NDOF,NUMNP, 00299420 $I,TAVGI,NADND,NDMX,A(N2),NADEL) 00299430 REWIND 17 00299440 REWIND 18 00299450 REWIND 4 00299460 DO 125 II=1,NUMEL R0299461 READ (4) (ID2(II,J),J=1,13) R0299470 IF(NADEL.GT.1) READ (4) (ID4(II,J),J=1,NADND) R0299480 125 CONTINUE R0299481 130 CONTINUE 00299490 REWIND 10 00299500 DO 140 I=1,NUMEL 00299510 READ (NL) TAVG,TEMPD 00299520 140 WRITE (10) TAVG,TEMPD 00299530 NL=10 00299540 REWIND 10 00299550 RETURN 00299560 END 00299570 SUBROUTINE TEMSET(TIME,ID4,T,M,LL,NUMEL,NREC,NDOF,NUMNP,II,TAVGI, 00300660 $NADND,NDMX,TEMPD,NADEL) 00300670 IMPLICIT REAL*8 (A-H,O-Z) 00300680 REAL*8 ID2 00300690 REAL*8 ID4 00300700 INTEGER T1,XM 00300710 DIMENSION ID4(NADND),TEMPD(NDMX,LL) 00300720 DIMENSION TIME(M),T(M,NUMNP,NDOF),ID2(13) 00300730 COMMON /ELTEMP/ TAVG,KET,NL,TIM(100),RRELTE R0300740 COMMON/ELARRY/NELAR(4,20) 00300750 COMMON /TRASH/ IX(100),RRTRAS(440) R0300760 COMMON /PREP/ XMX,XAD,KSKIP,NDYN,I1,RRPREP(7) R0300770 CALL FILES(34) 00300780 ERROR=1.0D-06 00300790 READ (10) (TIME(I),((T(I,J,K),J=1,NUMNP),K=1,NDOF),I=1,M) 00300800 IF(II.EQ.1) NL=17 00300810 IF(II.EQ.1) NM=18 00300820 NX=NL 00300830 NL=NM 00300840 NM=NX 00300850 DO 200 I=1,NUMEL 00300860 READ (4) ID2 00300870 DO 100 J=1,8 00300880 NN=ID2(J) 00300890 100 IX(J)= NN 00300900 ND=NDOF 00300910 MT=ID2(13) 00300920 IF(MT.NE.6) ND=1 00300930 XM=10000 00300940 IF(NADEL.LE.1) GO TO 120 00300950 READ (4) ID4 00300960 DO 110 J=1,NADND 00300970 T1=ID4(J) 00300980 IX(J+8)=T1 00300990 110 CONTINUE 00301000 120 CONTINUE 00301010 NNOD= NELAR(2,MT) 00301020 K=0 00301030 DO 130 J=1,NNOD 00301040 IF(IX(J).EQ.0) K=K+1 00301050 130 CONTINUE 00301060 NACT=NNOD-K 00301070 IF(II.GT.1) GO TO 150 00301080 TAVG=TAVGI*NACT 00301090 DO 140 J=1,NDMX 00301100 DO 140 K=1,LL 00301110 140 TEMPD(J,K)=0.0D0 00301120 150 IF(II.GT.1) READ (NM) TAVG,TEMPD 00301130 IF(MT.EQ.7) GO TO 190 00301140 DO 180 IK=1,LL 00301150 IF(TIM(IK).LT.0.0D0) GO TO 180 00301160 IT1=0 00301170 DO 160 IT=1,M 00301180 DELTA= DABS(TIM(IK)-TIME(IT)) 00301190 IF(DELTA.LT.ERROR) IT1=IT 00301200 160 CONTINUE 00301210 IF(IT1.EQ.0) GO TO 180 00301220 DO 170 J=1,ND 00301230 NAD=4*J-4 00301240 DO 170 K=1,NNOD 00301250 NNN=IX(K) 00301260 IF(K.EQ.4.AND.NNN.EQ.0) NNN=IX(3) 00301270 IF(NNN.EQ.0) GO TO 170 00301280 TEMPD(K+NAD,IK)=T(IT1,NNN,J) 00301290 IF(K.EQ.4.AND.IX(4).EQ.0) GO TO 170 00301300 IF(J.EQ.1) TAVG=TAVG+T(IT1,NNN,1) 00301310 170 CONTINUE 00301320 180 CONTINUE 00301330 IF(II.EQ.NREC)TAVG=TAVG/NACT/KET 00301340 190 CONTINUE 00301350 WRITE (NL) TAVG,TEMPD 00301360 200 CONTINUE 00301370 DO 220 IK=1,LL 00301380 IT1=0 00301390 DO 210 IT=1,M 00301400 DELTA= DABS(TIM(IK)-TIME(IT)) 00301410 IF(DELTA.LT.ERROR) IT1=IK 00301420 210 CONTINUE 00301430 IF(IT1.EQ.0) GO TO 220 00301440 TIM(IT1)=-10.0D0 00301450 220 CONTINUE 00301460 IF(II.LT.NREC) RETURN 00301470 DO 230 IK=1,LL 00301480 IF(TIM(IK).GE.0.0D0) WRITE(6,240)IK 00301490 IF(TIM(IK).GE.0.0D0) KSKIP=1 00301500 230 CONTINUE 00301510 240 FORMAT (//20X, 45HNO TEMP. DISTRIBUTION WAS FOUND FOR LOAD CASE,I500301520 $) 00301530 RETURN 00301540 END 00301550 SUBROUTINE CONCLD (FORC,LN,KK,NLMAX,NLC,K) 00048590 IMPLICIT REAL*8(A-H,O-Z) 00048600 INTEGER LN 00048610 COMMON /AMB/ GRAV,REFT,JROT R0048620 DIMENSION FORC(NLMAX,6),LN(NLMAX,2),F(6) 00048630 COMMON /PREP/ ZD(2),KSKIP,NDYN,I1,I99,POS,PRTCOD 00048640 $ ,POSSAV,PRTOFF,PRTON,PRTDUM,IDIRC 00048650 DATA SPH/1HS/ 00048660 DATA BLANK/1H / 00048670 CALL FILES(22) 00048680 NLC=0 00048690 IF(PRTCOD.EQ.PRTOFF) GO TO 55 00048700 IF(POS.EQ.PRTDUM.AND.PRTCOD.NE.PRTON) GO TO 55 00048710 WRITE(6,50) 00048720 50 FORMAT (1X ,20X,46HLOADS AS INPUT -LOADS ARE GENERATED FROM THE N,00048730 $37HODE N TO NODE KN IN INCREMENTS OF KN1//22X,5H NODE, 00048740 $5H LOAD,3(10H FORCE ),3(10H MOMENT ),2(5H NODE)/24X, 00048750 $8HN NO.,6X,1HX, 9X,1HY, 9X, 00048760 $1HZ, 9X,1HX, 9X,1HY, 9X,1HZ,5X,8HKN KN1//) 00048770 55 CONTINUE 00048780 KREAD=K 00048790 M1=5 00048800 IF(K.EQ.1)M1=14 00048810 NT57=57 00048820 IF(K.GT.1) M1=NT57 00048830 IF(M1.NE.5) REWIND M1 00048840 IF(KK.EQ.2.AND.K.LT.0) GO TO 80 00048850 GO TO 90 00048860 80 CONTINUE 00048870 WRITE(6,230)KK,K 00048880 90 CONTINUE 00048890 M2=15 00048900 REWIND M2 00048910 RDN=0.01745329251 00048920 NODMIN=100000 00048930 NODMAX=0 00048940 GO TO (100,190),KK 00048950 100 CONTINUE 00048960 IF(M1.EQ.NT57) READ(NT57,240,END=160)LTOT,LCASE,KEY 00048970 110 CONTINUE 00048980 IF(M1.NE.NT57) READ(5,210)N,A,M,F,KN,KN1 00048990 IF(M1.EQ.NT57) READ(M1,250)N,F 00049000 IF(M1.NE.NT57) GO TO 1110 00049010 KN=0 00049020 A=BLANK 00049030 KN1=0 00049040 IF(KEY.EQ.0) M=LCASE 00049050 IF(KEY.EQ.1) M=0 00049060 IF(KEY.EQ.2) M=-1 00049070 1110 CONTINUE 00049080 IF(A.NE.SPH) GO TO 111 00049090 R=F(1) 00049100 TH=F(2)*RDN 00049110 PH=F(3)*RDN 00049120 F(1)=R*DSIN(PH)*DCOS(TH) 00049130 F(2)=R*DSIN(PH)*DSIN(TH) 00049140 F(3)=R*DCOS(PH) 00049150 R=F(4) 00049160 F(4)=R*DSIN(PH)*DCOS(TH) 00049170 F(5)=R*DSIN(PH)*DSIN(TH) 00049180 F(6)=R*DCOS(PH) 00049190 111 CONTINUE 00049200 IF(N.EQ.0.AND.KREAD.LT.0) GO TO 155 00049210 IF(N.EQ.0.AND.M1.EQ.NT57) GO TO 100 00049220 IF(N.EQ.0) GO TO 160 00049230 IF(PRTCOD.EQ.PRTOFF) GO TO 1150 00049240 IF(POS.EQ.PRTDUM.AND.PRTCOD.NE.PRTON) GO TO 1150 00049250 WRITE(6,220)N,M,F,KN ,KN1 00049260 1150 CONTINUE 00049270 IF(M.NE. -1) GO TO 115 00049280 DO 112 I=1,3 00049290 112 F(I)=F(I)/GRAV 00049300 M=0 00049310 115 CONTINUE 00049320 IF(KN.EQ.0) KN=N 00049330 IF(KN1.EQ.0)KN1=1 00049340 IF(MOD(KN-N,KN1) .EQ.0) GO TO 119 00049350 KSKIP=1 00049360 WRITE(6,116)N,KN 00049370 116 FORMAT(//20X,33HINCORRECT INCREMENT BETWEEN NODES,I5,4H AND,I5//) 00049380 KN1=KN-N 00049390 119 CONTINUE 00049400 DO 130 I=N,KN,KN1 00049410 IF(PRTCOD.EQ.PRTOFF) GO TO 1160 00049420 IF(POS.EQ.PRTDUM.AND.PRTCOD.NE.PRTON) GO TO 1160 00049430 IF(I.NE.N) WRITE(6,220)I,M,F 00049440 1160 CONTINUE 00049450 NLC=NLC+1 00049460 IF(NLC.GT.NLMAX) GO TO 140 00049470 LN(NLC,1)=I 00049480 LN(NLC,2)=M 00049490 DO 120 J=1,6 00049500 120 FORC(NLC,J)=F(J) 00049510 130 CONTINUE 00049520 IF(N.LT.NODMIN) NODMIN=N 00049530 IF(KN.GT.NODMAX)NODMAX=KN 00049540 GO TO 110 00049550 140 WRITE(6,150) 00049560 150 FORMAT (//20X, 46HNOT ENOUGH STORAGE HAS BEEN ALLOCATED TO ALLOW, 00049570 $58HGENERATION OF NODES OR SUBSEQUENT RENUMBERING OF THE GEOM., 00049580 $/20X,55HSET JJ(1)=1 AFTER THE LOADS--- CARD AND INPUT THE NODES, 00049590 $42H IN NUMERICAL ORDER AFTER ANY RENUMBERING.//) 00049600 KSKIP=1 00049610 GO TO 110 00049620 155 IF(KREAD.EQ.-1) M1=14 00049630 IF(KREAD.EQ.-2) M1=NT57 00049640 REWIND M1 00049650 IF(M1.EQ.NT57) GO TO 100 00049660 GO TO 110 00049670 160 CONTINUE 00049680 IF(NLC.GT.NLMAX) RETURN 00049690 DO 180 I=NODMIN,NODMAX 00049700 DO 170 J=1,NLC 00049710 IF(LN(J,1).NE.I) GO TO 170 00049720 WRITE (M2) I,LN(J,2),(FORC(J,N),N=1,6) 00049730 170 CONTINUE 00049740 180 CONTINUE 00049750 GO TO 200 00049760 190 READ(M1,210) N,A,M,F 00049770 IF(N.EQ.0) GO TO 200 00049780 IF(PRTCOD.EQ.PRTOFF) GO TO 1170 00049790 IF(POS.EQ.PRTDUM.AND.PRTCOD.NE.PRTON) GO TO 1170 00049800 WRITE(6,220)N,M,F 00049810 1170 CONTINUE 00049820 NLC=NLC+1 00049830 WRITE (M2) N,M,F 00049840 GO TO 190 00049850 200 I=0 00049860 WRITE (M2) I,I,F 00049870 REWIND M2 00049880 RETURN 00049890 210 FORMAT(I5,A1,I4,6F10.0,2I5) 00049900 220 FORMAT(20X,2I5,6G10.3,2I5) 00049910 230 FORMAT(5X,13H** ERROR KK =,I3,3X, 7HAND K =,I3,3X, 00049920 1 49HNOT ALLOWED. ONLY DATA FROM FILE 5 WILL BE READ.) 00049930 240 FORMAT(3I5) 00049940 250 FORMAT(I5,6F15.5) 00049950 END 00049960 DOUBLE PRECISION FUNCTION CONDT (T,M) 00049970 IMPLICIT REAL*8(A-H,O-Z) 00049980 COMMON/MATL/MATLCO 00049990 DATA NHIGH/4HHIGH/ 00050000 IF(MATLCO.NE.NHIGH)GO TO 10 00050010 CALL CONDT2 (T,M,X) 00050020 CONDT=X*12. 00050030 RETURN 00050040 10 CALL CONDT1 (T,M,X) 00050050 CONDT=X 00050060 RETURN 00050070 END 00050080 SUBROUTINE DYNIN(JJ,KSKIP,NDYN) IMPLICIT REAL*8(A-H,O-Z) 00067140 LOGICAL GEOST 00067150 COMMON /DYN2/IFPR,IFSS,NITEM,NFO,RTOL,COFQ,DT,ALFA,BETA,NFN,NGM, 00067160 $NAT,NT,NOT,MIND,TLAST,NRDYN2(6) R0067170 COMMON /DYN5/FRSHFT,FRINIT,FREND,MODEFR,NOSS 00067180 COMMON/MASS/LMASS 00067190 COMMON/GEOSTF/GEOST,NELGEO 00067200 IF(NDYN.EQ.7) GO TO 115 00067210 IFPR=JJ 00067220 READ (5,100) IFSS,NITEM,NFO,RTOL,COFQ,FRINIT 00067230 &,FRSHFT,NOSS 00067240 100 FORMAT(3I5,4F10.0,I5) 00067250 FREND =COFQ 00067260 WRITE(6,110)LMASS,NELGEO,IFSS,NITEM,NFO,RTOL 00067270 110 FORMAT (1X ,20X, 58HTHE FOLLOWING EIGENVALUE SOLUTION INPUT HAS BE00067280 $EN RECEIVED.// 00067290 $ 5X,31HLMASS : MASS TYPE = ,I5/ 00067300 $ 7X,26HEQ.0, : LUMPED MASS MATRIX,/ 00067310 $ 7X,26HEQ.1, : FULL MASS MATRIX,/ 00067320 $ 7X,26HEQ.-1,: FULL MASS MATRIX,/ 00067330 $ 7X,26H FOR SUBSTRUCTURING,// 00067340 & 5X,31HNELGEO : =,I5/ 00067350 & 7X,46HEQ.0, : GEOMETRIC STIFFNES MATRIX NOT INCLUDED/ 00067360 & 7X,43HEQ.1, : GEOMETRIC STIFFNESS MATRIX INCLUDED// 00067370 $ 5X,31HSTURM SEQUENCE CHECK FLAG (*) = ,I5/ 00067380 $ 7X,19HEQ.0, PERFORM CHECK, / 00067390 $ 7X,10HEQ.1, PASS // 00067400 $ 5X,31HMAXIMUM ITERATION CYCLES (*) = ,I5// 00067410 $ 5X,31HNO. OF ITERATION VECTORS = ,I5/ 00067420 $ 5X,33H(EQ.0, ACCEPT INTERNAL VALUES) // 00067430 $ 5X,31HCONVERGENCE TOLERANCE (*) = ,E14.4) 00067440 WRITE(6,1110)FRINIT,COFQ,FRSHFT 00067450 1110 FORMAT(1H ,/ 00067460 $ 5X,31HSTARTING FREQUENCY (CPS) (*) =,F10.3// 00067470 $ 5X,31HCUT-OFF FREQUENCY (CPS) =,F10.3// 00067480 & 5X,36HFREQUENCY SHIFT (RIGID BODY MODES) =,E14.4/// 00067490 $ 5X,26H(*) APPLICABLE TO SUBSPACE, / 00067500 $ 5X,28H ITERATION SOLUTIONS ONLY, 1X) 00067510 TPI=6.283185307 00067520 FRSHFT=-FRSHFT 00067530 COFQ=COFQ*TPI 00067540 COFQ=COFQ*COFQ 00067550 IF(FRINIT.EQ.0.0)RETURN 00067560 IF(FREND.EQ.FRINIT) MODEFR=1 00067570 IFSS=1 00067580 FRSHFT=COFQ 00067590 IF(MODEFR.EQ.1) WRITE(6,111)FREND 00067600 IF(MODEFR.EQ.1) RETURN 00067610 MODEFR=2 00067620 FRINIT=(FRINIT*TPI)**2 00067630 FRSHFT=(FRINIT+COFQ)/2.0 00067640 111 FORMAT(//5X,43HTHE ANALYSIS WILL CALCULATE ONLY THE NO. OF,/ 00067650 $5X,17HFREQUENCIES BELOW,F10.3,5H CPS.//) 00067660 RETURN 00067670 115 CONTINUE 00067680 READ(5,120)NFN,NGM,NAT,NT,NOT,DT,ALFA,BETA,TLAST,MIND 00067690 120 FORMAT(5I5,4F10.0,I5) 00067700 WRITE(6,130)NFN,NGM,NAT,NT,NOT,DT,ALFA,BETA 00067710 130 FORMAT(1X ,10X,42HTHE FOLLOWING INFORMATION HAS BEEN INPUT /00067720 $ 10X, 37HFOR A TIME-DEPENDENT DYNAMIC ANALYSIS/// 00067730 $ 5X,35HNUMBER OF TIME VARYING FUNCTIONS = ,I5 // 00067740 $ 5X,35HGROUND MOTION INDICATOR = ,I5 / 00067750 $ 8X,10HEQ.0,NONE, / 00067760 $ 8X,29HGT.0, READ ACCELERATION INPUT, // 00067770 $ 5X,35HNUMBER OF ARRIVAL TIMES ,I5/ 00067780 $ 8X,26HEQ.0, ALL FUNCTIONS ARRIVE, / 00067790 $ 8X,18H AT TIME ZERO, // 00067800 $ 5X,35HNUMBER OF SOLUTION TIME STEPS = ,I5// 00067810 $ 5X,35HOUTPUT (PRINT) INTERVAL = ,I5 // 00067820 $ 5X,35HSOLUTION TIME INCREMENT = ,E14.4// 00067830 $ 5X,30HMASS- PROPORTIONAL DAMPING, / 00067840 $ 5X,35HCOEFFICIENT (ALPHA) =, E14.4// 00067850 $ 5X,30HSTIFFNESS-PROPORTIONAL DAMPING, / 00067860 $ 5X,35HCOEFFICIENT (BETA) =,E14.4 ///1X) 00067870 IF(DT.LT.1.0E-12) WRITE(6,140) 00067880 IF(DT.LT.1.0E-12) KSKIP=1 00067890 140 FORMAT (27H0*** ERROR ZERO TIME STEP ,/1X) 00067900 IF(MIND.GT.0) WRITE(6,150) 00067910 150 FORMAT(///10X,39HTHE ANALYSIS WILL USE ONLY DISPLACEMENT,1X, 00067920 $17HFORCING FUNCTIONS //) 00067930 IF(TLAST.GT.0.0) WRITE(6, 160)TLAST 00067940 160 FORMAT(//10X,42HTAPE 14 WILL BE SEARCHED TO FIND A RESTART/ 00067950 $ 10X,9HAT TIME =,1X,E10.4//) 00067960 RETURN 00067970 END 00067980 SUBROUTINE MATRX(A,KMAX,JJ) 00133630 IMPLICIT REAL*8(A-H,O-Z) 00133640 DIMENSION A(100,21),ALPH(6) 00133650 COMMON /TRASH/ B(6,6),D,MFL,K,I,J,N,KK,RRTRAS(450) R0133660 COMMON/PREP/WDM(2),KSKIP,RRPREP(8) R0133670 DATA ALPH/2HX ,2HY ,2HZ ,2HXX,2HYY,2HZZ/ 00133680 KMAX=0 00133690 100 READ (5,10) K,MFL 00133700 IF(K.EQ.0) GO TO 220 00133710 10 FORMAT(2I10) 00133720 20 FORMAT(6F10.0) 00133730 DO 30 I=1,6 00133740 30 READ (5,20) (B(I,J),J=1,I) 00133750 DO 40 I=1,6 00133760 DO 40 J=I,6 00133770 40 B(I,J)=B(J,I) 00133780 WRITE(6,50) 00133790 50 FORMAT (1X ,40X,24H 6 X 6 MATRIX AS INPUT//) 00133800 IF(MFL.EQ.0) WRITE(6,60) K 00133810 IF(MFL.GT.0) WRITE(6,70) K 00133820 60 FORMAT( /20X,23HSTIFFNESS MATRIX NUMBER,I3/) 00133830 70 FORMAT( /20X,25HFLEXIBILITY MATRIX NUMBER,I3/) 00133840 WRITE(6,80) 00133850 80 FORMAT(50X,11HC O L U M N/) 00133860 WRITE(6,90) (ALPH(I),I=1,6) 00133870 90 FORMAT(16X,6(13X,A2)/) 00133880 115 FORMAT(13X,3HROW,2X,A2,6E15.6/) 00133890 DO 110 I=1,6 00133900 110 WRITE(6,115) ALPH(I),(B(I,J),J=1,6) 00133910 IF(MFL.EQ.0) GO TO 180 00133920 120 FORMAT(20X,6HMATRIX,1X,I3,19H HAS A SINGULARITY.//) 00133930 DO 170 N=1,6 00133940 IF(DABS(B(N,N)).GT.1.D-20) GO TO 130 00133950 WRITE(6,120) K 00133960 KSKIP=1 00133970 GO TO 180 00133980 130 D=1.0/B(N,N) 00133990 DO 140 J=1,6 00134000 140 B(N,J)=-B(N,J)*D 00134010 DO 160 I=1,6 00134020 IF(N.EQ.I) GO TO 160 00134030 DO 150 J=1,6 00134040 IF(N.EQ.J) GO TO 150 00134050 B(I,J)=B(I,J)+B(I,N)*B(N,J) 00134060 150 CONTINUE 00134070 160 B(I,N)=B(I,N)*D 00134080 B(N,N)=D 00134090 170 CONTINUE 00134100 180 CONTINUE 00134110 IF(K.LE.99) GO TO 200 00134120 WRITE(6,190) K 00134130 190 FORMAT(/20X,10HMATRIX NO.,1X,I10,27HIS GREATER THAN THE ALLOWED, 00134140 13H 99//) 00134150 KSKIP=1 00134160 GO TO 100 00134170 200 CONTINUE 00134180 KK=0 00134190 DO 210 I=1,6 00134200 DO 210 J=I,6 00134210 KK=KK+1 00134220 210 A(K,KK)=B(J,I) 00134230 IF(K.GT.KMAX) KMAX=K 00134240 GO TO 100 00134250 220 WRITE (3)((A(I,J),I=1,KMAX),J=1,21) 00134260 RETURN 00134270 END 00134280 FUNCTION MAXBND(NC,IG,II1,IC,IDEG,NEW,ILD,NN,IH) 00134290 IMPLICIT REAL*8(A-H,O-Z) 00134300 INTEGER*2 IC,IDEG,NEW 00134310 INTEGER*2 IG, ILD 00134320 DIMENSION IG(II1,1),IC(1),IDEG(1),NEW(1),ILD(1) 00134330 IH=0 00134340 M=0 00134350 DO 140 I=1,NN 00134360 MX=0 00134370 IA=NEW(I) 00134380 IF(NC)100,110,100 00134390 100 IF(IA.EQ.0)GO TO 140 00134400 IF(NC-IC(IA)) 140,110,140 00134410 110 N=IDEG(IA) 00134420 IF(N)140,140,120 00134430 120 DO 130 J=1,N 00134440 II = IG(IA,J) 00134450 IB=MAX0(0,I-ILD(II)) 00134460 IF(IB.GT.MX) MX=IB 00134470 130 CONTINUE 00134480 IF(MX.GT.M) M=MX 00134490 IH=IH+MX 00134500 140 CONTINUE 00134510 MAXBND=M 00134520 RETURN 00134530 END 00134540 FUNCTION MAXDGR(NC,IC,IDEG,NN) 00134550 INTEGER*2 IC,IDEG 00134560 DIMENSION IC(1),IDEG(1) 00134570 M=0 00134580 DO 130 I=1,NN 00134590 IF(NC)100,110,100 00134600 100 IF(IC(I)-NC) 130,110,130 00134610 110 IF(IDEG(I)-M) 130,130,120 00134620 120 M=IDEG(I) 00134630 130 CONTINUE 00134640 MAXDGR=M 00134650 RETURN 00134660 END 00134670 SUBROUTINE RGSEM(S,NTY,MAX) 00210610 IMPLICIT REAL*8 (A-H,O-Z) 00210620 DIMENSION S(1),NR(48),SA(48) 00210630 NTY=0 00210640 M9=0 00210650 2 READ(5,1000)NN,MATYP,NROW,NODS 00210660 IF(NN.EQ.0)GO TO 50 00210670 IF(NROW.EQ.0)NROW=2 00210680 IF(NODS.EQ.0)NODS=2 00210690 NM=6*NODS 00210700 READ(5,1000)(NR(I),I=1,NM) 00210710 M1=M9+1 00210720 M9=M1+MAX-1 00210730 DO 10 I=M1,M9 00210740 10 S(I)=0.D0 00210750 M2=M1-1 00210760 M3=NM+1 00210770 N=NROW+1 00210780 DO 18 K=1,NM 00210790 M3=M3-1 00210800 M1=M2+1 00210810 M2=M1+M3-1 00210820 IF(NR(K).LE.0)GO TO 18 00210830 N=N-1 00210840 M=K-1 00210850 READ(5,1020)(SA(J),J=1,N) 00210860 MM=1 00210870 DO 16 I=M1,M2 00210880 M=M+1 00210890 IF(NR(M).LE.0)GO TO 16 00210900 S(I)=SA(MM) 00210910 MM=MM+1 00210920 16 CONTINUE 00210930 18 CONTINUE 00210940 NTY=NTY+1 00210950 MAXX=MAX*NTY 00210960 S(MAXX)=MATYP 00210970 GO TO 2 00210980 50 CONTINUE 00210990 WRITE(3)(S(I),I=1,MAXX) 00211000 RETURN 00211010 1000 FORMAT(6I5) 00211020 1020 FORMAT(6F10.0) 00211030 END 00211040 SUBROUTINE RIGRED(A,NELX,NNMX) 00212040 IMPLICIT REAL*8 (A-H,O-Z) 00212050 DIMENSION A(1),NN(50) 00212060 M2=0 00212070 NT30=30 00212080 NT40=40 00212090 REWIND NT30 00212100 NELX=0 00212110 WRITE(6,1000) 00212120 1000 FORMAT(1H ,79(1H*)) 00212130 5 READ(5,100)NEL,NUM,NEL2,INC 00212140 100 FORMAT(16I5) 00212150 IF(NEL.EQ.0)GO TO 30 00212160 IF(INC.EQ.0.AND.NEL2.NE.0)INC=1 00212170 READ(5,100)(NN(I),I=1,NUM) 00212180 GO TO 9 00212190 8 NEL=NEL+1 00212200 DO 11 I=1,NUM 00212210 11 NN(I)=NN(I)+INC 00212220 9 CONTINUE 00212230 M1=M2+1 00212240 M2=M1+NNMX-1 00212250 DO 10 I=M1,M2 00212260 10 A(I)=0. 00212270 K=M1 00212280 A(M1)=NUM 00212290 DO 20 I=1,NUM 00212300 K=K+1 00212310 20 A(K)=NN(I) 00212320 NELX=NELX+1 00212330 WRITE(6,1010)NEL,NN(1) 00212340 1010 FORMAT(16H ELEMENT NUMBER,I5/14H PRIMARY NODE= 00212350 &,I5/18H SECONDARY NODES:) 00212360 WRITE(6,1020)(NN(I),I=2,NUM) 00212370 WRITE(NT30)NEL,NUM,(NN(I),I=1,NUM) 00212380 1020 FORMAT(10I5) 00212390 WRITE(6,1000) 00212400 IF(NEL.LT.NEL2)GO TO 8 00212410 GO TO 5 00212420 30 CONTINUE 00212430 MAXX=NELX*NNMX 00212440 WRITE(3)(A(I),I=1,MAXX) 00212450 WRITE(NT40)(A(I),I=1,MAXX) 00212460 RETURN 00212470 END 00212480 SUBROUTINE BMLOAD(A,NTY,NC) 00029150 IMPLICIT REAL*8 (A-H,O-Z) 00029160 DIMENSION DIR(3),A(1) 00029170 COMMON /JUNK/ DUM(100),G,JJ(3),NRJUNK(249) R0029180 COMMON/PREP/XMX,XAD,KSKIP,NDYN,I1,I99,POS,PRTCOD 00029190 $ ,POSSAV,PRTOFF,PRTON,PRTDUM,IDIRC 00029200 NTY=0 00029210 M10=0 00029220 IF(PRTCOD.EQ.PRTOFF) GO TO 1105 00029230 IF(POS.EQ.PRTDUM.AND.PRTCOD.NE.PRTON) GO TO 1105 00029240 WRITE(6,2000) 00029250 1105 CONTINUE 00029260 IF(JJ(1).EQ.0)GO TO 1200 00029270 REWIND 58 00029280 IF(PRTCOD.EQ.PRTOFF) GO TO 1106 00029290 IF(POS.EQ.PRTDUM.AND.PRTCOD.NE.PRTON) GO TO 1106 00029300 WRITE(6,2050)JJ(1) 00029310 1106 CONTINUE 00029320 1110 READ(58,END=1190)LS,NTYP,NL 00029330 DO 1120 J=1,NL 00029340 READ(58)(A(I),I=1,8) 00029350 IF(PRTCOD.EQ.PRTOFF) GO TO 1120 00029360 IF(POS.EQ.PRTDUM.AND.PRTCOD.NE.PRTON) GO TO 1120 00029370 IF(NTYP.EQ.3.AND.J.EQ.1) 00029380 & WRITE(6,2030)LS,NTYP,NL,J,(A(K),K=1,8) 00029390 IF(NTYP.EQ.3.AND.J.GT.1) 00029400 & WRITE(6,2040)J,(A(K),K=1,8) 00029410 IF(NTYP.EQ.3) GO TO 1120 00029420 IF(NTYP.LT.3.AND.J.EQ.1) 00029430 & WRITE(6,2010)LS,NTYP,NL,J,(A(K),K=1,5) 00029440 IF(NTYP.LT.3.AND.J.GT.1) 00029450 & WRITE(6,2020)J,(A(K),K=1,5) 00029460 1120 CONTINUE 00029470 GO TO 1110 00029480 1190 CONTINUE 00029490 IF(PRTCOD.EQ.PRTOFF) GO TO 1195 00029500 IF(POS.EQ.PRTDUM.AND.PRTCOD.NE.PRTON) GO TO 1195 00029510 WRITE(6,2060) 00029520 1195 CONTINUE 00029530 REWIND 58 00029540 1200 CONTINUE 00029550 1 READ(5,1000)LS,NTYP,NL 00029560 IF(LS.EQ.0)GO TO 500 00029570 IF(NL.EQ.0)NL=1 00029580 DO 410 J=1,NL 00029590 M1=M10+1 00029600 M10=M1+NC-1 00029610 M9=M10-1 00029620 M8=M10-2 00029630 NTY=NTY+1 00029640 DO 10 I=M1,M10 00029650 10 A(I)=0. 00029660 GO TO (100,100,300),NTYP 00029670 100 READ(5,1010)FM,AX,DIR 00029680 A(M1)=FM 00029690 A(M1+3)=AX 00029700 A(M1+5)=DIR(1) 00029710 A(M1+6)=DIR(2) 00029720 A(M1+7)=DIR(3) 00029730 A(M9)=NTYP 00029740 IF(J.EQ.1)A(M10)=NL 00029750 GO TO 400 00029760 300 READ(5,1020)(A(K),K=M1,M8) 00029770 IF(A(M1+4).EQ.0.)A(M1+4)=1. 00029780 A(M9)=NTYP 00029790 IF(J.EQ.1)A(M10)=NL 00029800 400 CONTINUE 00029810 IF(PRTCOD.EQ.PRTOFF) GO TO 410 00029820 IF(POS.EQ.PRTDUM.AND.PRTCOD.NE.PRTON) GO TO 410 00029830 IF(NTYP.LT.3.AND.J.EQ.1) 00029840 & WRITE(6,2010)LS,NTYP,NL,J,FM,AX,DIR 00029850 IF(NTYP.LT.3.AND.J.GT.1) 00029860 & WRITE(6,2020)J,FM,AX,DIR 00029870 IF(NTYP.EQ.3.AND.J.EQ.1) 00029880 & WRITE(6,2030)LS,NTYP,NL,J,(A(K),K=M1,M8) 00029890 IF(NTYP.EQ.3.AND.J.GT.1) 00029900 & WRITE(6,2040)J,(A(K),K=M1,M8) 00029910 410 CONTINUE 00029920 GO TO 1 00029930 500 CONTINUE 00029940 IF(NTY.EQ.0) NTY=1 00029950 MAXX=NC*NTY 00029960 WRITE(3)(A(I),I=1,MAXX) 00029970 RETURN 00029980 1000 FORMAT(3I5) 00029990 1010 FORMAT(5F10.0) 00030000 1020 FORMAT(8F10.0) 00030010 2000 FORMAT(1X,4H SET,5H TYPE,5H NO.,5H LOAD,8X,2HFM,9X,2HAX,10X, 00030020 & 2HW0,12X,2HW1,12X,2HW2,9X,1HA,8X,1HB,6X,6HDIR(X) 00030030 & ,3X,6HDIR(Y),3X,6HDIR(Z)) 00030040 2010 FORMAT(4I5,E14.5,F9.4,60X,3F9.4) 00030050 2020 FORMAT(15X,I5,E14.5,F9.4,60X,3F9.4) 00030060 2030 FORMAT(4I5,23X,3E14.5,2F9.4,3F9.4) 00030070 2040 FORMAT(15X,I5,23X,3E14.5,2F9.4,3F9.4) 00030080 2050 FORMAT(5X,33HREAD BEAM LOAD DATA FROM FILE 58.,5X, 00030090 1 33HNUMBER OF LOAD CASES ON FILE 58 =,I5) 00030100 2060 FORMAT(5X,21HEND READ FROM FILE 58) 00030110 END 00030120 SUBROUTINE ELTREL(PDIR,A,KRLX,NNMX) 00085150 REAL*8 A(1) 00085160 DIMENSION NREL(20),DIR(6),PDIR(20,6) 00085170 DATA DIR/2HDX,2HDY,2HDZ,2HRX,2HRY,2HRZ/ 00085180 DATA BLANK /2H / 00085190 KRLX=0 00085200 MM=0 00085210 WRITE(6,2000) 00085220 5 DO 10 I=9,20 00085230 10 NREL(I)=0 00085240 READ(5,1000)NEL1,NEL2,INC,(NREL(I),I=1,8),MORE 00085250 IF(MORE.NE.0)READ(5,1010)(NREL(I),I=9,20) 00085260 IF(NEL1.EQ.0)GO TO 50 00085270 IF(NEL2.EQ.0)NEL2=NEL1 00085280 IF(INC.EQ.0)INC=1 00085290 DO 40 I=NEL1,NEL2,INC 00085300 KRLX=KRLX+1 00085310 MM=MM+1 00085320 A(MM)=I 00085330 DO 20 J=1,20 00085340 MM=MM+1 00085350 20 A(MM)=NREL(J) 00085360 DO 22 J=1,20 00085370 NOLD=NREL(J) 00085380 DO 22 K=1,6 00085390 KK=7-K 00085400 NEW=(NOLD/10)*10 00085410 L=NOLD-NEW 00085420 PDIR(J,KK)=BLANK 00085430 IF(L.NE.0)PDIR(J,KK)=DIR(KK) 00085440 22 NOLD=NOLD/10 00085450 WRITE(6,2010)I,((PDIR(J,K),K=1,6),J=1,4) 00085460 DO 26 J=5,8 00085470 IF(NREL(J).EQ.0)GO TO 26 00085480 GO TO 30 00085490 26 CONTINUE 00085500 GO TO 40 00085510 30 WRITE(6,2020)((PDIR(J,K),K=1,6),J=5,8) 00085520 40 CONTINUE 00085530 GO TO 5 00085540 50 CONTINUE 00085550 WRITE(3)(A(I),I=1,MM) 00085560 RETURN 00085570 1000 FORMAT(3I5,8I6,I2) 00085580 1010 FORMAT(12I6) 00085590 2000 FORMAT(1X ,20X,19HNODAL RELEASE CODES/80(1H*)//8H ELEMENT) 00085600 2010 FORMAT(11X,17H--------I--------,3X,17H--------J--------,3X, 00085610 & 17H--------K--------,3X,17H--------L--------/ 00085620 & 2X,I5,5X,4(6A3,2X)) 00085630 2020 FORMAT(11X,17H--------M--------,3X,17H--------N--------,3X, 00085640 & 17H--------O--------,3X,17H--------P--------/ 00085650 & 12X,4(6A3,2X)) 00085660 END 00085670 SUBROUTINE AISCPR(PROP,II,JJ) 00016100 IMPLICIT REAL*8(A-H,O-Z) 00016110 DIMENSION PROP(200,JJ),DUM(14) 00016120 COMMON /PREP/ RDUM(2),KDUM(1),NDYN,NRPREP(15) R0016130 COMMON /TRASH/ TD(100,3),RRTRAS(190) R0016140 COMMON /AMB/ GRAV,REFT,JROT 00016150 CALL FILES(24) 00016160 WRITE(6,260) 00016170 KMAX=0 00016180 KK=II 00016190 II=0 00016200 JK=JJ 00016210 IF(KK.LE.0) GO TO 110 00016220 DO 100 K=1,KK 00016230 DO 100 J=1,JJ 00016240 100 PROP(K,J)=0.0D0 00016250 110 CONTINUE 00016260 IF(JJ.GT.7) JK=7 00016270 120 READ (5,220) K,NCHECK,ICOP,IUSE,NOFF,NDUM,(DUM(J),J=1,5) 00016280 IF(K.EQ.0) GO TO 180 00016290 IF(K.GT.200) WRITE(6,230) 00016300 WRITE(6,240)K,NCHECK,ICOP,IUSE,NOFF,NDUM, 00016310 1(DUM(J),J=1,5) 00016320 IF(K.GT.KMAX) KMAX=K 00016330 DUM(6)=IUSE 00016340 DUM(7)=NCHECK 00016350 DUM(8)=ICOP 00016360 DUM(9)=NOFF 00016370 DO 170 J=1,JJ 00016380 170 PROP(K,J)=DUM(J) 00016390 II=II+1 00016400 IF(K.GT.II) II=K 00016410 IF(II.GT.KMAX) II=KMAX 00016420 IF(KK.GT.0) II=KK 00016430 GO TO 120 00016440 180 CONTINUE 00016450 IF(II.EQ.0) II=1 00016460 WRITE (3) ((PROP(I,J),I=1,II),J=1,JJ) 00016470 IF(II.GT.200 ) WRITE(6,250) 00016480 RETURN 00016490 210 FORMAT (8F10.0) 00016500 220 FORMAT(6I5,5F10.0) 00016510 230 FORMAT ( 1X ,20X, 34HNO MORE THAN 200 TYPES MAY BE USED) 00016520 240 FORMAT(3X,I4,2I9,3I8,5X,5(2X,G12.5)) 00016530 250 FORMAT(1X ,20X,38HONLY BEAM TYPES CAN HAVE MORE THAN 200, 00016540 $17H ENTRIES- (179 ).//) 00016550 260 FORMAT(1X ,40X,38HBEAM SECTION PROPERTIES FOR AISC CHECK,/, 00016560 141X,38(1H-)/// 00016570 11X,127(1H-)/,4X,3HNO.,3X,6HNCHECK,5X,4HICOP, 00016580 24X,4HIUSE,4X,4HNOFF,3X,4HNDUM,12X,1HD,13X,1HB,12X,2HTF,12X,2HTW, 00016590 312X,2HFY,/,1X,127(1H-)) 00016600 END 00016610 SUBROUTINE COMBDT(KK,LL) 00045940 IMPLICIT REAL*8(A-H,O-Z) 00045950 COMMON/COMBLD/PCT(15,7),SINC(15),NCOMB,NB(15),LD(15,7) 00045960 DIMENSION PROP(8),IPROP(7) 00045970 WRITE(6,320) 00045980 NCOMB=0 00045990 30 READ (5,300)K,(IPROP(L),PROP(L),L=1,7),PROP(8) 00046000 IF(K.EQ.0) GO TO 150 00046010 IF(K.GT.15) GO TO 230 00046020 IF(K.GT.NCOMB) NCOMB=K 00046030 DO 40 L=1,7 00046040 LD(K,L)=IPROP(L) 00046050 40 PCT(K,L)=PROP(L) 00046060 SINC(K)=PROP(8) 00046070 IF(SINC(K).LE.0.0)SINC(K)=1.0 00046080 NB1=0 00046090 DO 90 M=1,7 00046100 IF(LD(K,M).GT.0)NB1=NB1+1 00046110 90 CONTINUE 00046120 NB(K)=NB1 00046130 GO TO 30 00046140 150 CONTINUE 00046150 IF(NCOMB.GT.0) GO TO 190 00046160 NCOMB=LL 00046170 DO 180 N=1,NCOMB 00046180 NB(N)=1 00046190 DO 170 L=1,7 00046200 LD(N,L)=0 00046210 170 PCT(N,L)=0.0D0 00046220 LD(N,1)=N 00046230 PCT(N,1)=1.0D0 00046240 SINC(N)=1.0D0 00046250 180 CONTINUE 00046260 190 CONTINUE 00046270 DO 200 J=1,NCOMB 00046280 NB1=NB(J) 00046290 WRITE (6,310)J,NB1,SINC(J),(LD(J,L),PCT(J,L),L=1,NB1) 00046300 200 CONTINUE 00046310 RETURN 00046320 230 CONTINUE 00046330 WRITE(6,330)NCOMB 00046340 STOP 00046350 300 FORMAT(I3,7(I3,F7.0),F6.0) 00046360 310 FORMAT(/,6X,I4,I4,F10.3,7(I7,F8.3)) 00046370 320 FORMAT(1X ,//,35X,42HFACTORS FOR COMBINED LOAD CASES AND STRESS 00046380 1,17H INCREASE FACTORS,/,35X,59(1H-),/// 00046390 1,4X, 42HDESIGN NB1 STRESS BASIC RATIO BASIC 00046400 X,7H RATIO, 00046410 1 3X,50HBASIC RATIO BASIC RATIO BASIC RATIO BASIC, 00046420 2 2X,20HRATIO BASIC RATIO,/,6X,4HCASE,9X,5HINCR.,3X,4HCASE, 00046430 3 11X,4HCASE,11X,4HCASE,11X,4HCASE,11X,4HCASE,11X,4HCASE,11X, 00046440 4 4HCASE) 00046450 330 FORMAT(5X,49H*** ERROR *** ONLY 15 VALUES OF NCOMB ARE ALLOWED, 00046460 1 34H NCOMB IN YOUR DATA HAS A VALUE OF,I5) 00046470 340 FORMAT(I5) 00046480 END 00046490 SUBROUTINE BMEFF(PROP,II,JJ) 00027160 IMPLICIT REAL*8(A-H,O-Z) 00027170 DIMENSION PROP(200,JJ),DUM(14) 00027180 COMMON /PREP/ RDUM(2),KDUM(1),NDYN,NRPREP(15) R0027190 COMMON /TRASH/ TD(100,3),RRTRAS(190) R0027200 COMMON /AMB/ GRAV,REFT,JROT 00027210 DATA MBR/1HL/ 00027220 CALL FILES(24) 00027230 WRITE(6,260) 00027240 KMAX=0 00027250 KK=II 00027260 II=0 00027270 JK=JJ 00027280 IF(KK.LE.0) GO TO 110 00027290 DO 100 K=1,KK 00027300 DO 100 J=1,JJ 00027310 100 PROP(K,J)=0.0D0 00027320 110 CONTINUE 00027330 IF(JJ.GT.7) JK=7 00027340 120 READ (5,220) K,KATX,KATY,XK,YK,FLG 00027350 IF(K.EQ.0) GO TO 180 00027360 IF(K.GT.200) WRITE(6,230) 00027370 IF(KATX.LE.0) KATX=1 00027380 IF(KATY.LE.0) KATY=1 00027390 IF(XK.LE.0) XK=1.0 00027400 IF(YK.LE.0) YK=1.0 00027410 IF(FLG.LE.0) GO TO 140 00027420 WRITE(6,240)K,KATX,KATY,XK,YK,FLG 00027430 GO TO 145 00027440 140 WRITE(6,245)K,KATX,KATY,XK,YK,MBR 00027450 145 CONTINUE 00027460 IF(K.GT.KMAX) KMAX=K 00027470 PROP(K,1)=KATX 00027480 PROP(K,2)=KATY 00027490 PROP(K,3)=XK 00027500 PROP(K,4)=YK 00027510 PROP(K,5)=FLG 00027520 II=II+1 00027530 IF(K.GT.II) II=K 00027540 IF(II.GT.KMAX) II=KMAX 00027550 IF(KK.GT.0) II=KK 00027560 GO TO 120 00027570 180 WRITE (3) ((PROP(I,J),I=1,II),J=1,JJ) 00027580 IF(II.GT.200 ) WRITE(6,250) 00027590 RETURN 00027600 210 FORMAT (8F10.0) 00027610 220 FORMAT(3I10,3F10.0) 00027620 230 FORMAT ( 1X ,20X, 34HNO MORE THAN 200 TYPES MAY BE USED) 00027630 240 FORMAT(21X,I4,2I14,6X,G12.5,6X,G12.5,4X,G12.5) 00027640 245 FORMAT(21X,I4,2I14,6X,G12.5,6X,G12.5,8X,A4) 00027650 250 FORMAT(1X ,20X,38HONLY BEAM TYPES CAN HAVE MORE THAN 200, 00027660 $17H ENTRIES- (179 ).//) 00027670 260 FORMAT(1X ,40X,38HBEAM EFFECTIVE LENGTH PROPERTIES /, 00027680 141X,32(1H-)/// 00027690 116X,92(1H-)/,22X,3HNO.,10X,4HCATX,10X, 00027700 24HCATY, 00027710 310X,2HXK,14X,2HYK,14X,4HFFLY/,16X,92(1H-)) 00027720 END 00027730 SUBROUTINE SLAVIN(ISL,NUMNP) 00239930 IMPLICIT REAL*8(A-H,O-Z) 00239940 COMMON /PREP/ XMX,XAD,KSKIP,NDYN,I1,I99,POS,PRTCOD 00239950 $ ,POSSAV,PRTOFF,PRTON,PRTDUM,IDIRC 00239960 COMMON/RIGID/IIA(20),NREX 00239970 COMMON/SLVE/NSLAVE 00239980 DIMENSION ISL(NUMNP,4),MASTER(6) 00239990 CALL FILES (35) 00240000 NSLVE=0 00240010 IF(PRTCOD.EQ.PRTOFF) GO TO 95 00240020 IF(POS.EQ.PRTDUM.AND.PRTCOD.NE.PRTON) GO TO 95 00240030 WRITE(6,240) 00240040 95 CONTINUE 00240050 100 READ (5,210)NSL,(MASTER(I),I=1,6),NSLND,KN 00240060 IF(NSL.EQ.0) GO TO 190 00240070 IF(PRTCOD.EQ.PRTOFF) GO TO 105 00240080 IF(POS.EQ.PRTDUM.AND.PRTCOD.NE.PRTON) GO TO 105 00240090 WRITE(6,230)NSL,(MASTER(I),I=1,6),NSLND,KN 00240100 105 CONTINUE 00240110 NSLO=NSL 00240120 IF(NSLND.EQ.0) NSLND=NSLO 00240130 IF(KN.EQ.0) KN=1 00240140 IF(PRTCOD.EQ.PRTOFF) GO TO 115 00240150 IF(POS.EQ.PRTDUM.AND.PRTCOD.NE.PRTON) GO TO 115 00240160 IF(NSLND.NE.NSLO) WRITE(6,250) 00240170 115 CONTINUE 00240180 DO 120 I=NSLO,NSLND,KN 00240190 IF(PRTCOD.EQ.PRTOFF) GO TO 125 00240200 IF(POS.EQ.PRTDUM.AND.PRTCOD.NE.PRTON) GO TO 125 00240210 IF(I.NE.NSLO) WRITE(6,220)I,(MASTER(J),J=1,6) 00240220 125 CONTINUE 00240230 NSLAVE=NSLAVE+1 00240240 ISL(NSLAVE,1)=I 00240250 ISL(NSLAVE,2)=MASTER(1)+10000*MASTER(4) 00240260 ISL(NSLAVE,3)=MASTER(2)+10000*MASTER(5) 00240270 ISL(NSLAVE,4)=MASTER(3)+10000*MASTER(6) 00240280 120 CONTINUE 00240290 GO TO 100 00240300 190 CONTINUE 00240310 IF(NSLAVE.EQ.0) RETURN 00240320 IF(NREX.EQ.0) REWIND 30 00240330 WRITE(30)((ISL(I,J),J=1,4),I=1,NSLAVE) 00240340 RETURN 00240350 210 FORMAT(7I10,2I5) 00240360 220 FORMAT(5X,I5,10X,6(I6,4X),5X,I10,5X,I10) 00240370 230 FORMAT(/5X,I5,10X,6(I6,4X),5X,I10,5X,I10) 00240380 240 FORMAT(1X ,//1X,50X,11HSLAVE NODES,/,51X,11(1H-),///,5X, 00240390 110HSLAVE NODE, 5X,17(1H-),1X,23HASSOCIATED MASTER NODES,1X, 00240400 217(1H-)/,10X,10X,4X,2HDX,8X,2HDY,8X,2HDZ,8X,2HRX,8X,2HRY, 00240410 38X,2HRZ,10X,15HLAST SLAVE NODE,5X,9HINCREMENT,/,5X,110(1H-)) 00240420 250 FORMAT(5X,14HGENERATED DATA) 00240430 END 00240440 SUBROUTINE SUPEIN 00285960 IMPLICIT REAL*8(A-H,O-Z) 00285970 COMMON/PREP/QD(2),KSKIP,RRPREP(8) R0285980 COMMON/TRASH/ NOD(450),NDUM(16),MATNO,NUM,KN,I,RRTRAS(255) R0285990 COMMON /SUPEL/ NSELEM,NEQL,NODESE,NRSUPE(3) R0286000 WRITE (6,2001) 00286010 2001 FORMAT (5X,'***** IN SUPEIN *****'/) NSE=16 00286020 IF(NSELEM.EQ.0) REWIND NSE 00286030 WRITE(6,50) 00286040 50 FORMAT(1X ,20X,31HSUPER ELEMENT INPUT INFORMATION/// 00286050 $20X,50HSUPER ELEMENT MATRIX NO. OF CONNECTING NODES/ 00286060 $20X,28H NO. NO. NODES//) 00286070 100 READ (5,110) MATNO,NUM,KN 00286080 110 FORMAT(16I5) 00286090 IF(MATNO.LE.0) RETURN 00286100 MAXN=450 00286110 I=0 00286120 IF(NUM .GT.MAXN) GO TO 140 00286130 111 READ (5,110) NDUM 00286140 DO 114 J=1,16 00286150 IF(I.GT.NUM) GO TO 150 00286160 IF(NDUM(J).EQ.0) GO TO 115 00286170 IF(J.EQ.1) GO TO 113 00286180 IF(J.EQ.16.AND.NDUM(16).LT.0) GO TO 150 00286190 IF(NDUM(J-1).LT.0) GO TO 114 00286200 IF(NDUM(J).GT.0) GO TO 113 00286210 KT=NDUM(J+1) 00286220 KF=-NDUM(J) 00286230 KI=NDUM(J-1)+KT 00286240 DO 112 K=KI,KF,KT 00286250 I=I+1 00286260 112 NOD(I)=K 00286270 GO TO 114 00286280 113 I=I+1 00286290 NOD(I)=NDUM(J) 00286300 114 CONTINUE 00286310 115 IF(I.NE.NUM) GO TO 111 00286320 NSELEM=NSELEM+1 00286330 DO 116 I=1,NUM 00286340 116 NOD(I)=NOD(I)+KN 00286350 120 CONTINUE 00286360 WRITE(6,130)NSELEM,MATNO,NUM,(NOD(I),I=1,NUM) 00286370 130 FORMAT(20X,I6,9X,I5,I7,7X,10I5/(54X,10I5)) 00286380 WRITE (NSE) MATNO,NUM,(NOD(I),I=1,NUM) 00286390 GO TO 100 00286400 140 WRITE(6,145)NUM,MAXN 00286410 145 FORMAT(/20X,20HERROR-TOO MANY NODES,I5,11H ALLOWABLE-,I5//) 00286420 GO TO 160 00286430 150 WRITE(6,155)NDUM 00286440 155 FORMAT(/20X,28HERROR ON THE FOLLOWING CARD-/20X,16I5//) 00286450 160 KSKIP=1 00286460 RETURN 00286470 END 00286480 SUBROUTINE BMFACT(PROP,II,JJ,LL) 00027740 IMPLICIT REAL*8(A-H,O-Z) 00027750 DIMENSION PROP(200,1),DUM(10),DUMO(10) 00027760 COMMON /PREP/ RDUM(2),KDUM(1),NDYN,I1,I99,POS,PRTCOD 00027770 $ ,POSSAV,PRTOFF,PRTON,PRTDUM,IDIRC 00027780 COMMON /TRASH/ TD(100,3),RRTRAS(190) R0027790 COMMON /AMB/ GRAV,REFT,JROT 00027800 CALL FILES(24) 00027810 IF(PRTCOD.EQ.PRTOFF) GO TO 95 00027820 IF(POS.EQ.PRTDUM.AND.PRTCOD.NE.PRTON) GO TO 95 00027830 WRITE(6,260) 00027840 95 CONTINUE 00027850 KMAX=0 00027860 KK=II 00027870 II=0 00027880 JK=JJ 00027890 JTOTAL=7*LL 00027900 DO 100 K=1,200 00027910 DO 100 J=1,JTOTAL 00027920 100 PROP(K,J)=0.0D0 00027930 110 CONTINUE 00027940 KO=0 00027950 120 READ (5,210) LCASE,K,(DUM(J),J=1,7) 00027960 IF(LCASE.EQ.0) GO TO 180 00027970 IF(K.GT.200) WRITE(6,230) 00027980 IF(PRTCOD.EQ.PRTOFF) GO TO 125 00027990 IF(POS.EQ.PRTDUM.AND.PRTCOD.NE.PRTON) GO TO 125 00028000 WRITE(6,270)LCASE,K,(DUM(J),J=1,7) 00028010 125 CONTINUE 00028020 KN=IABS(K) 00028030 KSTRT=KO+1 00028040 IF(PRTCOD.EQ.PRTOFF) GO TO 135 00028050 IF(POS.EQ.PRTDUM.AND.PRTCOD.NE.PRTON) GO TO 135 00028060 IF(K.LE.0) WRITE(6,290)KO,KN 00028070 135 CONTINUE 00028080 IF(K.GT.0) KSTRT=KN 00028090 IF(K.LE.0.AND.LCASEO.NE.LCASE) WRITE(6,280)LCASEO,LCASE 00028100 IF(K.LE.0.AND.LCASEO.NE.LCASE) STOP 00028110 DO 1150 K=KSTRT,KN 00028120 IF(K.GT.KMAX) KMAX=K 00028130 IF(PRTCOD.EQ.PRTOFF) GO TO 145 00028140 IF(POS.EQ.PRTDUM.AND.PRTCOD.NE.PRTON) GO TO 145 00028150 IF(KSTRT.NE.KN) WRITE(6,270)LCASE,K,(DUM(J),J=1,7) 00028160 145 CONTINUE 00028170 JUMP=(LCASE-1)*7 00028180 DO 170 J=1,7 00028190 JUMP1=JUMP+J 00028200 170 PROP(K,JUMP1)=DUM(J) 00028210 IF(K.LE.II) GO TO 175 00028220 II=K 00028230 175 CONTINUE 00028240 IF(II.GT.KMAX) II=KMAX 00028250 IF(KK.GT.0) II=KK 00028260 LCASEO=LCASE 00028270 KO=K 00028280 1150 CONTINUE 00028290 DO 1160 J=1,7 00028300 1160 DUMO(J)=DUM(J) 00028310 GO TO 120 00028320 180 JJJ=LL*7 00028330 IF(II.EQ.0) II=1 00028340 WRITE (3) ((PROP(I,J),I=1,II),J=1,JJJ) 00028350 IF(II.GT.200 ) WRITE(6,250) 00028360 RETURN 00028370 210 FORMAT (2I5,7F10.0) 00028380 230 FORMAT ( 1X ,20X, 34HNO MORE THAN 200 TYPES MAY BE USED) 00028390 250 FORMAT(1X ,20X,38HONLY BEAM TYPES CAN HAVE MORE THAN 200, 00028400 $17H ENTRIES- (179 ).//) 00028410 260 FORMAT(1X ,35X,45HBEAM LOAD MULTIPLIER (FOR EACH PRES-TYP OR BM, 00028420 112HLD-TYP CARD)/,36X,57(1H-)///,5H LOAD, 00028430 13X,11HPRES-TYP OR,3X,24(1H-),1X,26HBEAM LOAD CASE MULTIPLIERS,1X, 00028440 224(1H-),9X,8HPRESSURE,3X,7HTHERMAL,/,5H NO.,3X,12HBMLD-TYP NO., 00028450 34X,8HBMLD (A),7X,8HBMLD (B),8X, 00028460 48HBMLD (C),9X,8HBMLD (D),10X,8HBMLD (E),10X,5HMULT.,10X,5HMULT.//)00028470 270 FORMAT(I5,5X,I5,6X,E10.3,5X,E10.3,6X,E10.3,2X,5X,E10.3, 00028480 18X,E10.3,7X,E10.3,4X,E10.3) 00028490 280 FORMAT(5X,44HERROR IN GENERATION OF BEAM LOAD MULTIPLIERS,/, 00028500 1 44HLOAD CASE FROM LAST CARD IS ,I5,/, 00028510 2 44HLOAD CASE FROM PRESENT CARD IS ,I5) 00028520 290 FORMAT(/5X,46HGENERATION OF LOAD MULTIPLIERS IS DONE BETWEEN, 00028530 1 1X,8HBMLD-TYP,I5,5X, 8HBMLD-TYP,I5/) 00028540 END 00028550 SUBROUTINE CONDT2 (T,M,CONDT ) 00050090 IMPLICIT REAL*8(A-H,O-Z) 00050100 DIMENSION COEF(11,8) 00050110 DATA COEF/ 00050120 1 2.0,100.0,1500.0,8.104445,4.310117E-3,2.455443E-8,0.,0.,0.,0.,0.,00050130 2 1.0,100.0,1500.0,8.093782,4.348935E-3,0.0,0.0,0.0,0.0,0.0,0.0, 00050140 3 2.0,32.0,2500.0,5.4306E1,-1.878E-2,2.0914E-6,0.0,0.0,0.0,0.0,0.0,00050150 4 5.0,75.0,1600.0,8.011332,4.643719E-3,1.872857E-6,-3.914512E-9, 00050160 4 3.475513E-12,-9.936696E-16,0.0,0.0, 00050170 5 4.0,100.0,800.0,31.97807,-9.938505E-3,9.269174E-7,-3.163481E-10, 00050180 5 -3.730373E-13,0.0,0.0,0.0, 00050190 6 4.0,100.0,800.0,31.97807,-9.938505E-3,9.269174E-7,-3.163481E-10, 00050200 6 -3.730373E-13,0.0,0.0,0.0, 00050210 7 4.0,100.0,800.0,31.97807,-9.938505E-3,9.269174E-7,-3.163481E-10, 00050220 7 -3.730373E-13,0.0,0.0,0.0, 00050230 8 4.0,100.0,800.0,1.328876E-2,2.480551E-5,-9.147992E-10, 00050240 8 -7.971376E-12,7.021763E-15,0.0,0.0,0.0/ 00050250 ICODE=1 00050260 IF(M.LT.1.OR.M.GT.8)CALL RPZLVZ(M,T,ICODE,8) 00050270 N=COEF(1,M) 00050280 T1=COEF(2,M) 00050290 T2=COEF(3,M) 00050300 IF(T.LT.T1.OR.T.GT.T2)CALL RPZLVZ(M,T,ICODE,1) 00050310 IF(T.GT.208.OR.M.NE.3)GO TO 5 00050320 CONDT=80.7-0.0536*T 00050330 RETURN 00050340 5 CONTINUE 00050350 CONDT =COEF(N+4,M) 00050360 IF(N.EQ.0)RETURN 00050370 DO 10 I=1,N 00050380 10 CONDT =CONDT *T+COEF(N-I+4,M) 00050390 RETURN 00050400 END 00050410 SUBROUTINE CONDT1 (T,M,CONDT ) 00050090 IMPLICIT REAL*8(A-H,O-Z) 00050100 RETURN 00050400 END 00050410