Liren Large Software Subsidy 9

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

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

Wrap

Text File | 1980-01-04 | 104.0 KB | 1,305 lines

SUBROUTINE GDCOMP (A,B,MAXA,NEQB,MA,NBLOCK,NWA,NTB,NSCH,NEQ,MI) R0103040 IMPLICIT REAL*8 (A-H,O-Z) 00103050 REAL*8 MAXA 00103060 COMMON /EXTRA/ MODEX,NREXTR(25) R0103070 COMMON /SQZ/ ISQZ,NRSQZ(5) R0103080 CC COMMON /AAA1/ A(8000) R0103081 DIMENSION A(NWA),B(NWA),MAXA(MI) R0103090 DIMENSION ICOO(10),IFORM(4) 00103100 DATA ICOO /3H001,3H013,3H025,3H037,3H049,3H061,3H073,3H085,3H097, 00103110 $ 3H109/ 00103120 DATA IFORM(1),IFORM(3),IFORM(4) /4H(1H+,4HX,F7,4H.2) / 00103130 NSTIF=4 00103140 NT=10 00103150 NL=22 00103160 NRED=15 00103170 MA2=MA - 2 00103180 IF(MA2.EQ.0) MA2=1 00103190 INC=NEQB - 1 00103200 IF(INC.EQ.0)INC=1 00103210 N1=NL 00103220 N2=NT 00103230 NWANM=NWA+MI 00103240 CALL RDWRT(NSTIF,A,1,6,I) 00103250 CALL RDWRT(NRED ,A,1,6,I) 00103260 CALL RDWRT(N1 ,A,1,6,I) 00103270 CALL RDWRT(N2 ,A,1,6,I) 00103280 NSCH=0 00103290 WRITE(6,90) 00103300 90 FORMAT(1X ,10X,48HTHE LAST NUMBER PRINTED IS THE PERCENT OF THE FO00103310 $ ,40HRWARD REDUCTION THAT HAS BEEN COMPLETED.//) 00103320 ICO=1 00103330 DO 420 NJ=1,NBLOCK 00103340 IF (NJ.NE.1) GO TO 100 00103350 CC CALL EXPAND(A,NWA,NSTIF) 00103360 WRITE (6,1010) N1,N2,NSTIF 1010 FORMAT (5X,'** N1 N2 NSTIF **',3I5/) READ (NSTIF) (A(II),II=1,NWA) R0103361 GO TO 110 00103370 100 IF (NTB.EQ.1) GO TO 110 00103380 CALL RDWRT(N1 ,A,1,6,I) 00103390 CALL RDWRT(N2 ,A,1,6,I) 00103400 CALL EXPAND(A,NWA,N1) 00103410 110 KU=1 00103420 KM=MIN0(MA,NEQB) 00103430 MAXA(1)=1 00103440 DO 170 N=2,MI 00103450 IF (N-MA) 120,120,130 00103460 120 KU=KU + NEQB 00103470 KK=KU 00103480 MM=MIN0(N,KM) 00103490 GO TO 150 00103500 130 KU=KU + 1 00103510 KK=KU 00103520 IF (N-NEQB) 150,150,140 00103530 140 MM=MM - 1 00103540 150 DO 160 K=1,MM 00103550 IF (A(KK)) 170,160,170 00103560 160 KK=KK - INC 00103570 170 MAXA(N)=KK 00103580 IF (A(1)) 190,180,200 00103590 180 KK=(NJ-1)*NEQB + 1 00103600 IF (KK.GT.NEQ) GO TO 390 00103610 WRITE (6,430) KK 00103620 MODEX=1 00103630 RETURN 00103640 190 NSCH=NSCH + 1 00103650 200 DO 280 N=2,NEQB 00103660 NH=MAXA(N) 00103670 IF (NH-N) 280,280,210 00103680 210 KL=N + INC 00103690 KU=NH 00103700 K=N 00103710 D=0.E0 00103720 DO 220 KK=KL,KU,INC 00103730 K=K - 1 00103740 C=A(KK)/A(K) 00103750 D=D + C*A(KK) 00103760 220 A(KK)=C 00103770 A(N)=A(N) - D 00103780 IF (A(N)) 240,230,250 00103790 230 KK=(NJ-1)*NEQB + N 00103800 IF (KK.GT.NEQ) GO TO 390 00103810 WRITE (6,430) KK 00103820 MODEX=1 00103830 RETURN 00103840 240 NSCH=NSCH + 1 00103850 250 IC=NEQB 00103860 DO 270 J=1,MA2 00103870 MJ=MAXA(N+J) - IC 00103880 IF (MJ-N) 270,270,260 00103890 260 KU=MIN0(MJ,NH) 00103900 KN=N + IC 00103910 C=0.E0 00103920 CONST=C 00103930 CALL QVDOT(C,A(KL),A(KL+IC), (KU-KL)/INC+1,INC,INC) 00103940 C=CONST-C 00103950 A(KN)=A(KN)+C 00103960 270 IC=IC + NEQB 00103970 280 CONTINUE 00103980 IF(NJ.EQ.NBLOCK) CALL SQEEZE(A,NWANM,NRED,ISQZ) 00103990 IF(NJ.EQ.NBLOCK) GO TO 400 00104000 290 DO 380 NK=1,NTB 00104010 IF ((NK+NJ).GT.NBLOCK) GO TO 380 00104020 NI=N1 00104030 IF ((NJ.EQ.1).OR.(NK.EQ.NTB)) NI=NSTIF 00104040 CALL EXPAND(B,NWA,NI) 00104050 ML=NK*NEQB + 1 00104060 MR=MIN0((NK+1)*NEQB,MI) 00104070 MD=MI - ML 00104080 KL=NEQB + (NK-1)*NEQB*NEQB 00104090 N=1 00104100 DO 360 M=ML,MR 00104110 NH=MAXA(M) 00104120 KL=KL + NEQB 00104130 IF (NH-KL) 350,300,300 00104140 300 KU=NH 00104150 K=NEQB 00104160 D=0.E0 00104170 DO 310 KK=KL,KU,INC 00104180 C=A(KK)/A(K) 00104190 D=D + C*A(KK) 00104200 A(KK)=C 00104210 310 K=K - 1 00104220 B(N)=B(N) - D 00104230 IF (MD) 360,360,320 00104240 320 IC=NEQB 00104250 DO 340 J=1,MD 00104260 MJ=MAXA(M+J) - IC 00104270 IF (MJ-KL) 340,330,330 00104280 330 KU=MIN0(MJ,NH) 00104290 KN=N + IC 00104300 C=0.E0 00104310 CONST=C 00104320 CALL QVDOT(C,A(KL),A(KL+IC), (KU-KL)/INC+1,INC,INC) 00104330 C=CONST-C 00104340 B(KN)=B(KN)+C 00104350 340 IC=IC + NEQB 00104360 350 MD=MD - 1 00104370 360 N=N + 1 00104380 IF (NTB.NE.1) GO TO 370 00104390 CALL SQEEZE(A,NWANM,NRED,ISQZ) 00104400 CALL MEMOVE(B(1),A(1),NWA) 00104410 GO TO 400 00104420 370 CALL SQEEZE(B,NWA,N2,ISQZ) 00104430 380 CONTINUE 00104440 M=N1 00104450 N1=N2 00104460 N2=M 00104470 390 CALL SQEEZE(A,NWANM,NRED,ISQZ) 00104480 400 CONTINUE 00104490 PER=NJ*100.0/NBLOCK 00104500 IFORM(2)=ICOO(ICO) 00104510 WRITE(6,1009) PER R0104520 ICO=ICO+1 00104530 IF(ICO.LT.11) GO TO 420 00104540 WRITE(6,410) 00104550 410 FORMAT(1X,1X) R0104560 ICO=1 00104570 420 CONTINUE 00104580 1009 FORMAT (5X,F10.4/) R0104581 430 FORMAT (37H0***ERROR SOLUTION STOP IN *DECOMP*, / 12X, 00104590 $ 37HZERO PIVOT FOUND DURING FACTORIZATION, / 12X, 00104600 $ 17HEQUATION NUMBER =, I5 / 1X) 00104610 WRITE(6,440) 00104620 440 FORMAT(////20X,37(1H*)/20X,37HFORWARD REDUCTION HAS BEEN COMPLETED00104630 $./20X,37(1H*)) 00104640 RETURN 00104650 END 00104660 SUBROUTINE GREDBK (A,VA,VV,MAXA,NEQB,NV,NWA,NWV,NWVV,NTB,NBLOCK, 0108380 $MI,MA) 00108390 IMPLICIT REAL*8 (A-H,O-Z) 00108400 REAL*8 MAXA 00108410 COMMON /SQZ/ ISQZ,NRSQZ(5) R0108420 DIMENSION A(NWA),VA(NWV),VV(NWVV),MAXA(MI) 00108430 NR=3 00108440 NL=18 00108450 NT=10 00108460 NRED=15 00108470 NWANM=NWA+MI 00108480 INC=NEQB - 1 00108490 IF(INC.EQ.0) INC=1 00108500 NEB=NTB*NEQB 00108510 NEBT=NEB+NEQB 00108520 CALL RDWRT(NRED ,A,1,6,I) 00108530 REWIND NR 00108540 REWIND NL 00108550 REWIND NT 00108560 CALL EXPAND(A,NWANM,NRED) 00108570 ISV=NTB+1 00108580 IF (NBLOCK.EQ.1) ISV=1 00108590 LL=0 00108600 DO 120 L=1,ISV 00108610 READ (NR) VA 00108620 K=0 00108630 KK=LL 00108640 DO 110 J=1,NV 00108650 DO 100 I=1,NEQB 00108660 K=K+1 00108670 KK=KK+1 00108680 100 VV(KK)=VA(K) 00108690 110 KK=KK+NEB 00108700 120 LL=LL+NEQB 00108710 ISA=1 00108720 130 DO 160 N=2,NEQB 00108730 KL=N + INC 00108740 KU=MAXA(N) 00108750 IF (KU-KL) 160,140,140 00108760 140 K=N 00108770 DO 150 L=1,NV 00108780 CONST=VV(K) 00108790 CALL QVDOT(VV(K ),A(KL),VV(K-1), (KU-KL)/INC+1,INC,-1) 00108800 VV(K )=CONST-VV(K ) 00108810 150 K=K + NEBT 00108820 160 CONTINUE 00108830 170 KL=NEQB 00108840 ML=NEQB + 1 00108850 DO 200 N=ML,MI 00108860 KL=KL + NEQB 00108870 KU=MAXA(N) 00108880 IF (KU-KL) 200,180,180 00108890 180 K=NEQB 00108900 KN=N 00108910 DO 190 L=1,NV 00108920 CONST=VV(KN) 00108930 CALL QVDOT(VV(KN ),A(KL),VV(K) ,(KU-KL)/INC+1,INC,-1) 00108940 VV(KN )=CONST-VV(KN ) 00108950 K=K + NEBT 00108960 190 KN=KN + NEBT 00108970 200 CONTINUE 00108980 DO 230 I=1,NEQB 00108990 C=A(I) 00109000 IF (C) 210,230,210 00109010 210 KK=I 00109020 DO 220 L=1,NV 00109030 VV(KK)=VV(KK)/C 00109040 220 KK=KK+NEBT 00109050 230 CONTINUE 00109060 IF (ISA.EQ.NBLOCK) GO TO 300 00109070 CALL EXPAND(A,NWANM,NRED) 00109080 ISA=ISA+1 00109090 K=0 00109100 KK=0 00109110 DO 250 J=1,NV 00109120 DO 240 I=1,NEQB 00109130 K=K+1 00109140 KK=KK+1 00109150 240 VA(K)=VV(KK) 00109160 250 KK=KK+NEB 00109170 WRITE (NT) VA 00109180 K=1 00109190 DO 270 J=1,NV 00109200 DO 260 I=1,NEB 00109210 VV(K)=VV(K+NEQB) 00109220 260 K=K+1 00109230 270 K=K+NEQB 00109240 IF (ISV.EQ.NBLOCK) GO TO 130 00109250 READ (NR) VA 00109260 ISV=ISV+1 00109270 KK=NEB 00109280 K=0 00109290 DO 290 J=1,NV 00109300 DO 280 I=1,NEQB 00109310 K=K+1 00109320 KK=KK+1 00109330 280 VV(KK)=VA(K) 00109340 290 KK=KK+NEB 00109350 GO TO 130 00109360 300 CALL RDWRT(NRED ,A,1,2,I) 00109370 ISA=1 00109380 310 ML=NEQB+1 00109390 KL=NEQB 00109400 DO 340 M=ML,MI 00109410 KL=KL+NEQB 00109420 KU=MAXA(M) 00109430 IF (KU-KL) 340,320,320 00109440 320 K=NEQB 00109450 KM=M 00109460 DO 330 L=1,NV 00109470 CALL QMR2(VV(K ),VV(K ),VV(KM),A(KL),(KU-KL)/INC+1,-1,-1,INC) 00109480 KM=KM + NEBT 00109490 330 K=K + NEBT 00109500 340 CONTINUE 00109510 N=NEQB 00109520 DO 370 LJ=2,NEQB 00109530 KL=N + INC 00109540 KU=MAXA(N) 00109550 IF (KU-KL) 370,350,350 00109560 350 K=N 00109570 DO 360 L=1,NV 00109580 CALL QMR2(VV(K-1 ),VV(K-1 ),VV(K ),A(KL),(KU-KL)/INC+1,-1,-1,INC) 00109590 360 K=K + NEBT 00109600 370 N=N - 1 00109610 380 KK=0 00109620 K=0 00109630 DO 400 J=1,NV 00109640 DO 390 I=1,NEQB 00109650 K=K+1 00109660 KK=KK+1 00109670 390 VA(K)=VV(KK) 00109680 400 KK=KK+NEB 00109690 WRITE (NL) VA 00109700 IF (ISA.EQ.NBLOCK) GO TO 450 00109710 CALL RDWRT(NRED ,A,1,2,I) 00109720 CALL EXPAND(A,NWANM,NRED) 00109730 CALL RDWRT(NRED ,A,1,2,I) 00109740 ISA=ISA+1 00109750 BACKSPACE NT 00109760 READ (NT) VA 00109770 BACKSPACE NT 00109780 K=NEBT 00109790 DO 420 J=1,NV 00109800 DO 410 I=1,NEB 00109810 VV(K)=VV(K-NEQB) 00109820 410 K=K-1 00109830 420 K=K+NEBT+NEB 00109840 K=0 00109850 KK=0 00109860 DO 440 J=1,NV 00109870 DO 430 I=1,NEQB 00109880 K=K+1 00109890 KK=KK+1 00109900 430 VV(KK)=VA(K) 00109910 440 KK=KK+NEB 00109920 GO TO 310 00109930 450 RETURN 00109940 END 00109950 SUBROUTINE GSTATC(A,LL,NBLOCK,NEQB,NT18,NT2) 00110360 IMPLICIT REAL*8(A-H,O-Z) 00110370 DIMENSION A(1) 00110380 BACKSPACE NT18 00110390 CALL RDWRT(NT2,A,1,6,J) 00110400 LS=NEQB*LL 00110410 DO 100 I=1,NBLOCK 00110420 CALL RDWRT(NT18,A,LS,14,1) 00110430 CALL RDWRT(NT2,A,LS,13,1) 00110440 CALL RDWRT(NT18,A,LS,2,1) 00110450 100 CONTINUE 00110460 RETURN 00110470 END 00110480 SUBROUTINE ADDGEO(A,B,TMASS,A2,B2,TMASS2,NUMEL,NBLOCK,NE2B,LL, R0008380 $MBAND,NEQB,NEMN,ANORM,NVV,MMA) 00008390 IMPLICIT REAL*8(A-H,O-Z) LOGICAL ELPRT,ELPCH,GENPRT,GENPCH,GEOST 00008410 COMMON STIF(1) 00008420 DIMENSION A(NEQB,MBAND), B(NEQB,LL), TMASS(NEQB,MMA) R0008430 DIMENSION A2(NEQB,MBAND),B2(NEQB,LL),TMASS2(NEQB,MMA) 00008440 DIMENSION ICOO(10),IFORM(4) 00008450 COMMON/CTL/ELPRT,ELPCH,GENPRT,GENPCH 00008460 COMMON/MASS/LMASS 00008470 COMMON /SQZ/ ISQZ,NRSQZ(5) R0008480 COMMON/PREP/XMX,XAD,KSKIP,NDYN,I1,RRPREP(7) R0008490 COMMON /DYN5/FRSHFT,FRINIT,FREND,MODEFR,NOSS R0008500 COMMON /FORCE/ NLC,NELD 00008510 COMMON/GEOSTF/GEOST,NELGEO 00008520 COMMON/ELPAR/ XPAR(14),KDUM(9),KEQ,RRELPA(23) R0008530 COMMON /DYN2/IFPR,IFSS,NITEM,NFO,RTOL,COFQ,DT,ALFA,BETA,NFN,NGM, 00008540 $NAT,NT,NOT,NRDYN2(9) R0008550 CC COMMON /AAA1/A(150,53) R0008551 CC COMMON /AAA2/ TMASS(200,1),B(200,3) R0008552 DATA ICOO / 3H001,3H013,3H025,3H037,3H049,3H061,3H073,3H085,3H097,00008560 $ 3H109/ 00008570 DATA IFORM(1),IFORM(3),IFORM(4)/4H(1H+,4HX,F7,4H.2) / 00008580 KX(I,J,ND1)=MIN0(I,J)*(2*ND1+1-MIN0(I,J))/2-ND1+MAX0(I,J)+ND1 00008590 ZER=0.0D0 00008600 NWDS=NEQB*(MBAND+LL) 00008610 NWA=MBAND*NEQB 00008620 IF(NDYN.GT.3.AND.NDYN.LE.7) NWDS=NWA 00008630 IF(NDYN.EQ.11.OR.NELGEO.EQ.1) NWDS=NWA 00008640 NWB= LL*NEQB 00008650 NTA=4 00008660 LLF=LL 00008670 IF(NELD.EQ.0) LLF=0 00008680 NTD=25 00008690 NT1=41 00008700 NT2=10 00008710 K=NEQB+1 00008720 X=NBLOCK 00008730 NFLG=0 00008740 CC WRITE(6,100) 00008750 CC100 FORMAT (1X ) 00008760 MB= DSQRT(X) 00008770 MB=MB/2+1 00008780 NEBB=MB*NE2B 00008790 MM=1 00008800 NSHIFT=0 00008810 AMIN=1.0D30 00008820 AMAX=-AMIN 00008830 NTB=18 00008840 NWDSB=NWB+NEQB 00008850 CALL RDWRT(NTB,B,1,6,INUM) 00008860 CALL RDWRT(NTA,A,1,6,INUM) 00008870 ANORM=0.0 00008880 NDEG=0 00008890 NVV=0 00008900 IF(NDYN.NE.7) GO TO 110 00008910 TETA=1.4 00008920 DT1=TETA*DT 00008930 DT2=DT1*DT1 00008940 A0=(6.+3*ALFA*DT1)/(DT2+3*BETA*DT1) 00008950 110 CONTINUE 00008960 REWIND NTD 00008970 WRITE(6,115) 00008980 115 FORMAT(//,10X,48HTHE LAST NUMBER PRINTED IS THE PERCENT OF THE MA,00008990 $ 55HSTER (CONVENTIONAL AND GEOMETRIC) STIFFNESS AND LOAD MA,00009000 $ 6HTRICES,/,10X,42X,24HTHAT HAS BEEN ASSEMBLED.,//) 00009010 ICO = 1 00009020 DO 310 M=1,NBLOCK ,2 00009030 CALL MEMSET (ZER,A2(1,1),NWA) 00009040 CALL MEMSET (ZER, A(1,1),NWA) 00009050 NMWA=NEQB*MMA 00009060 CALL MEMSET (ZER,TMASS2(1,1),NMWA) 00009070 CALL MEMSET (ZER,TMASS (1,1),NMWA) 00009080 CALL MEMSET (ZER,B2(1,1),NWB) 00009090 CALL MEMSET (ZER, B(1,1),NWB) 00009100 CALL RDWRT(NT1,STIF,1,6,N) 00009110 CALL RDWRT(NT2,STIF,1,6,N) 00009120 NA=NT2 00009130 NUME=NUM7 00009140 IF (MM.NE.1) GO TO 140 00009150 NA=NT1 00009160 NUME=NUMEL 00009170 NUM7 =0 00009180 140 DO 240 N=1,NUME 00009190 CALL RDWRT(NA,STIF,NEMN,0,KOUNT) 00009200 WRITE (6,1021) NUME,KOUNT,MM 1021 FORMAT (5X,'** NUME KOUNT MM **',3I5/) CC WRITE(6,1001) (STIF(IIR),IIR=1,KOUNT) C1001 FORMAT (1X,'**NA**',12E10.4/) ND1=STIF(KOUNT) 00009210 NTOT=(ND1*ND1-ND1)/2+ND1 00009220 KSTXM=LLF*ND1+NTOT+ND1+ND1 00009230 IF(LMASS.EQ.1) KSTXM=KSTXM+NTOT-ND1 00009240 DO 210 I=1,ND1 00009250 LMN=1-STIF(I) 00009260 II=STIF(I)-NSHIFT 00009270 IF (II.LE.0.OR.II.GT.NE2B) GO TO 210 00009280 IF(II.GT.NEQB)GO TO 180 00009290 IF(NELD.EQ.0) GO TO 155 00009300 KSTP=NTOT+I 00009310 DO 150 L=1,LL 00009320 KSTP=KSTP+ND1 00009330 150 B(II,L)=B(II,L)+STIF(KSTP) 00009340 155 CONTINUE 00009350 DO 170 J=1,ND1 00009360 JJ=STIF(J)+LMN 00009370 IF(JJ) 170,170,160 00009380 160 KSTS=KX(I,J,ND1) 00009390 A(II,JJ)=A(II,JJ)+STIF(KSTS) 00009400 KSTM=KX(I,J,ND1)-ND1 00009410 IF((KSTXM+KSTM).GE.KOUNT) GO TO 170 00009420 TMASS(II,JJ)=TMASS(II,JJ)-STIF(KSTXM+KSTM) 00009430 IF(NELGEO.EQ.1) A(II,JJ)=A(II,JJ)+STIF(KSTXM+KSTM) 00009440 170 CONTINUE 00009450 GO TO 210 00009460 180 II=II-NEQB 00009470 IF(NELD.EQ.0) GO TO 195 00009480 KSTP=NTOT+I 00009490 DO 190 L=1,LL 00009500 KSTP=KSTP+ND1 00009510 190 B2(II,L)=B2(II,L)+STIF(KSTP) 00009520 195 CONTINUE 00009530 DO 200 J=1,ND1 00009540 JJ=STIF(J)+LMN 00009550 IF(JJ.LE.0) GO TO 200 00009560 KSTS=KX(I,J,ND1) 00009570 A2(II,JJ)=A2(II,JJ)+STIF(KSTS) 00009580 KSTM=KX(I,J,ND1)-ND1 00009590 IF((KSTXM+KSTM).GE.KOUNT) GO TO 200 00009600 TMASS2(II,JJ)=TMASS2(II,JJ)-STIF(KSTXM+KSTM) 00009610 IF(NELGEO.EQ.1) A2(II,JJ)=A2(II,JJ)+STIF(KSTXM+KSTM) 00009620 200 CONTINUE 00009630 210 CONTINUE 00009640 IF (MM.GT.1) GO TO 240 00009650 DO 220 I=1,ND1 00009660 II=STIF(I)-NSHIFT 00009670 IF(II.GT.NE2B.AND.II.LE.NEBB) GO TO 230 00009680 220 CONTINUE 00009690 GO TO 240 00009700 230 CALL RDWRT(NT2,STIF,KOUNT,1,I) 00009710 WRITE (6,1002) STIF 1002 FORMAT (1X,'**NT2**',12E10.4/) NUM7=NUM7+1 00009720 240 CONTINUE 00009730 DO 250 I=1,NEQB 00009740 D=A(I,1) 00009750 ANORM=ANORM+D 00009760 IF(D.NE.0.0) NDEG=NDEG+1 00009770 IF(D.NE.0.0D0.AND.D.LT.AMIN) AMIN=D 00009780 IF(D.GT.AMAX) AMAX=D 00009790 IF(TMASS(I,1).NE.0) NVV=NVV+1 00009800 IF(M.EQ.NBLOCK) GO TO 250 00009810 D=A2(I,1) 00009820 ANORM=ANORM+D 00009830 IF(D.NE.0.0) NDEG=NDEG+1 00009840 IF(D.NE.0.0D0.AND.D.LT.AMIN) AMIN=D 00009850 IF(D.GT.AMAX) AMAX=D 00009860 IF(TMASS2(I,1).NE.0.0) NVV=NVV+1 00009870 250 CONTINUE 00009880 260 CONTINUE 00009890 IF(.NOT.GENPRT) GO TO 1200 00009900 WRITE(6,1500)M 00009910 DO 1020 I=1,NEQB 00009920 IF(GENPCH)WRITE(7,1510)(A(I,J),J=1,MBAND) 00009930 1020 WRITE(6,1520)(A(I,J),J=1,MBAND) 00009940 WRITE(6,1530) 00009950 DO 1030 I=1,NEQB 00009960 IF(GENPCH) WRITE(7,1510)(B(I,J),J=1,LL) 00009970 1030 WRITE(6,1520)(B(I,J),J=1,LL) 00009980 WRITE(6,1540) 00009990 2170 DO 2180 I=1,NEQB 00010000 IF(GENPCH) WRITE(7,1510)(TMASS(I,J),J=1,MBAND) 00010010 2180 WRITE(6,1520)(TMASS(I,J),J=1,MBAND) 00010020 IF(M.EQ.NBLOCK) GO TO 1200 00010030 MP1=M+1 00010040 WRITE(6,1500)MP1 00010050 DO 1060 I=1,NEQB 00010060 IF(GENPCH)WRITE(7,1510)(A2(I,J),J=1,MBAND) 00010070 1060 WRITE(6,1520)(A2(I,J),J=1,MBAND) 00010080 WRITE(6,1530) 00010090 DO 1070 I=1,NEQB 00010100 IF(GENPCH) WRITE(7,1510)(B2(I,J),J=1,LL) 00010110 1070 WRITE(6,1520)(B2(I,J),J=1,LL) 00010120 WRITE(6,1540) 00010130 2200 DO 2210 I=1,NEQB 00010140 IF(GENPCH)WRITE(7,1510)(TMASS2(I,J),J=1,MBAND) 00010150 2210 WRITE(6,1520)(TMASS2(I,J),J=1,MBAND) 00010160 1200 CONTINUE 00010170 IF(MODEFR.GT.0) GO TO 247 00010180 DO 246 I=1,NEQB 00010190 D=A(I,1) 00010200 IF(D.GT.0.0) GO TO 243 00010210 NJ=NEQB*(M-1)+I 00010220 IF(NJ.GT.KEQ) GO TO 246 00010230 NFLG=1 00010240 WRITE(6,242)NJ,D 00010250 242 FORMAT(/10X,9HEQUATION ,I5,26H HAS A SINGULAR DIAGONAL = ,E10.4) 00010260 WRITE(6,115) 00010270 ICO=1 00010280 243 D=A2(I,1) 00010290 IF(D.GT.0.0) GO TO 246 00010300 NJ=NEQB*M+I 00010310 IF(NJ.GT.KEQ) GO TO 246 00010320 NFLG=1 00010330 WRITE(6,242)NJ,D 00010340 246 CONTINUE 00010350 247 CONTINUE 00010360 WRITE (NTD) TMASS,(A(I,1),I=1,NEQB) 00010370 IF(NDYN.GT.3.AND.NDYN.LE.7) NWDS=MBAND*NEQB R0010371 IF(NDYN.EQ.11.OR.NELGEO.EQ.1) NWDS=MBAND*NEQB R0010372 WRITE (6,2020) NTA,NWDS,MBAND,NEQB,ISQZ,NTD,MMA 2020 FORMAT (5X,'** NTA NWDS MBAND NEQB ISQZ NTD MMA **',7I5/) CC CALL SQEEZE(A ,NWDS,NTA,ISQZ) R0010380 WRITE (NTA) A R0010381 IF(M.EQ.NBLOCK) GO TO 310 00010390 WRITE (NTD) TMASS2,(A2(I,1),I=1,NEQB) 00010400 WRITE (NTA) A R0010401 CC CALL SQEEZE(A2,NWDS,NTA,ISQZ) R0010410 IF (MM.EQ.MB) MM=0 00010420 MM=MM+1 00010430 PER=(M+1)*100.0/X 00010440 IFORM(2) = ICOO(ICO) 00010450 WRITE(6,IFORM) PER 00010460 ICO = ICO + 1 00010470 IF ( ICO .LT. 11 ) GO TO 310 00010480 WRITE(6,295) 00010490 295 FORMAT(1H ) 00010500 ICO = 1 00010510 310 NSHIFT=NSHIFT+NE2B 00010520 WRITE(6,320) 00010530 320 FORMAT(////20X,98(1H*)/20X,34HTHE MASTER STIFFNESS (CONVENTIONAL, 00010540 148H AND GEOMETRIC) STIFFNESS AND LOAD MATRICES HAVE, 00010550 216H BEEN ASSEMBLED./20X,98(1H*)) 00010560 IF(NFLG.EQ.1) KSKIP=1 00010570 IF(NDEG.GT.0) GO TO 340 00010580 WRITE(6,330) 00010590 330 FORMAT(51H0STRUCTURE WITH NO DEGREES OF FREEDOM CHECK DATA ) 00010600 KSKIP =1 00010610 RETURN 00010620 340 CONTINUE 00010630 IF(NDEG.GT.0) ANORM= (ANORM/NDEG)*1.0E-08 00010640 IF(NDYN.EQ.11) WRITE(6,1550) 00010650 IF(NDYN.NE.11) WRITE(6,1560) 00010660 RATIO=1.0D30 00010670 IF(AMIN.NE.0.0D0) RATIO=AMAX/AMIN 00010680 WRITE(6,1570)AMIN,AMAX,RATIO 00010690 RETURN 00010700 1500 FORMAT(17H OVERALL MATRICES,1X,5HBLOCK,I3,//, 00010710 117H STIFFNESS MATRIX) 00010720 1510 FORMAT((1P8E10.3)) 00010730 1520 FORMAT ( (1H ,1P10E13.4)) 00010740 1530 FORMAT(///,12H LOAD MATRIX) 00010750 1540 FORMAT(///,23H GEOMETRIC MATRIX (-KG)) 00010760 1550 FORMAT(5X,37HGEOMETRIC STIFFNESS MATRIX PARAMETERS) 00010770 1560 FORMAT(15X,43HSTIFFNESS MATRIX PARAMETERS AFTER INCLUSION, 00010780 1 1X,26HOF THE GEOMETRIX STIFFNESS) 00010790 1570 FORMAT(//, 00010800 1 15X,34HMINIMUM NON-ZERO DIAGONAL ELEMENT=,1PD10.3,/, 00010810 2 15X,34HMAXIMUM DIAGONAL ELEMENT =, D10.3,/, 00010820 3 15X,34HMAXIMUM/MINIMUM =, D10.3) 00010830 END 00010840 SUBROUTINE ST2D1(NORD,NADD) 00261030 IMPLICIT REAL*8(A-H,O-Z) 00261040 COMMON /JUNK/ SIG(200),MM,L,K,NTAG,RRJUNK(25) R0261050 COMMON /BAND/KOPT,NRBAND(7) R0261060 COMMON /OUT/NRES,NSTR,NROUT(8) R0261070 COMMON/PREP/XMX,XAD,NRPREP(17) R0261080 DIMENSION NORD(NADD) 00261090 COMMON /QTSARG/ SIGEX(100),X(2),RRQTSA(898) R0261100 DIMENSION C(4),D(4),Q(3) 00261110 DATA Q/4HNODE,4HC.G.,4HI.P./ 00261120 JJ=SIG(150)/4 00261130 MTYP=SIG(151) 00261140 KL=0 00261150 IF(NTAG.GT.0) GO TO 154 00261160 IF(MTYP.EQ.11.AND.NTAG.EQ.0) WRITE(6,100) 00261170 IF(MTYP.EQ.12.AND.NTAG.EQ.0) WRITE(6,110) 00261180 IF(MTYP.EQ.13.AND.NTAG.EQ.0) WRITE(6,120) 00261190 100 FORMAT(1X , 32H .... AXISYMMETRIC ELEMENTS ..../) 00261200 110 FORMAT(1X , 32H .... PLANE STRESS ELEMENTS ..../) 00261210 120 FORMAT(1X , 32H .... PLANE STRAIN ELEMENTS ..../) 00261220 IF(NTAG.EQ.0.AND.MTYP .NE.11) WRITE(6,130) 00261230 IF(NTAG.EQ.0.AND.MTYP .EQ.11) WRITE(6,140) 00261240 130 FORMAT(12H0EL.NO. LOAD,12X,90HY-STRESS Z-STRESS YZ-STRESS T-S00261250 $TRESS MAX-STRESS MIN-STRESS ANGLE SIG-EF LOCATION /) 00261260 140 FORMAT(12H0EL.NO. LOAD,12X,90HR-STRESS Z-STRESS RZ-STRESS T-S00261270 $TRESS MAX-STRESS MIN-STRESS ANGLE SIG-EF LOCATION /) 00261280 IF(NTAG.EQ.0.AND.KOPT.GT.1.AND.NADD.EQ.1) WRITE(6,150) 00261290 150 FORMAT( 5X,39HNOTE - NODES ARE NEW RENUMBERED NODES /) 00261300 154 KK=SIG(150) 00261310 NSCG=8 00261320 JL=1000 00261330 IF(JJ.GT.1) JL=(KK-16)/4 00261340 DO 200 I=1,JJ 00261350 KK=KK+1 00261360 FACE=SIG(KK)*10000.+.001 00261370 NF=FACE 00261380 LL=NF 00261390 A=Q(2) 00261400 IF(I.EQ.1) GO TO 155 00261410 IF(NADD.GT.1.AND.I.LE.JL) NF=NORD(LL) 00261420 A=Q(1) 00261430 IF(I.EQ.1) A=Q(2) 00261440 IF(I.LE.JL) GO TO 155 00261450 A=Q(3) 00261460 NF=I-JL 00261470 LL=SIG(KK) 00261480 IF(SIG(KK).LT.0.0) LL=LL-1 00261490 X(1)=(SIG(KK)-LL-XAD)*XMX 00261500 KK=KK+1 00261510 LL=SIG(KK) 00261520 IF(SIG(KK).LT.0.0) LL=LL-1 00261530 X(2)=(SIG(KK)-LL-XAD)*XMX 00261540 155 CONTINUE 00261550 LL=4*(I-1) 00261560 DO 160 J=1,4 00261570 LL=LL+1 00261580 D(J)=SIG(LL) 00261590 160 CONTINUE 00261600 CALL MXMN1 (D,C(1),C(2),C(3),C(4)) 00261610 DO 165 K=1,4 00261620 KL=KL+1 00261630 165 SIGEX(KL)=C(K) 00261640 170 FORMAT(I4,I2,2H12,6F9.0) 00261650 IF(I.EQ.1) WRITE(6,180)MM,L,D,C,A 00261660 IF(I.GT.1.AND.I.LE.JL) WRITE(6,190)D,C,A,NF 00261670 IF(I.GT.JL) SIGEX(KL-1)=X(1) 00261680 IF(I.GT.JL) SIGEX(KL )=X(2) 00261690 IF(I.GT.JL) GO TO 200 00261700 IF(I.GT.JL.AND.L.EQ.1) WRITE(6,175)X(1),X(2),D,C,A,NF 00261710 IF(I.GT.JL.AND.L.GT.1) WRITE(6,190)D,C,A,NF 00261720 175 FORMAT(3H Y=,F8.2,3H Z=,F8.2,F10.0,5E11.4,F7.2,E11.4,2X,A4,I5) 00261730 180 FORMAT(2I6, 9X,6E11.4,F7.2,E11.4,2X,A4,I5) 00261740 190 FORMAT(21X, 6E11.4,F7.2,E11.4,2X,A4,I5) 00261750 IF(I.EQ.1)WRITE(35,1235)MM,MTYP,L,D,C 00261760 200 CONTINUE 00261770 KK=SIG(150) 00261780 LL=JJ*4 00261790 NS=KK+LL 00261800 IF(NSTR.GT.0) WRITE(NSTR,1234) NS,L,MTYP,(SIGEX(I),I=1,LL),(SIG(I)00261810 $,I=1,KK) 00261820 1234 FORMAT(I4,I2,2X,I2 ,7G10.4/(8G10.4)) 00261830 1235 FORMAT(3I5,10E10.3) 00261840 RETURN 00261850 END 00261860 SUBROUTINE ST3D1(NORD,NADD) 00263600 IMPLICIT REAL*8(A-H,O-Z) 00263610 COMMON /JUNK/ SIG(200),MM,L,K,NTAG,RRJUNK(25) R0263620 COMMON /BAND/ KOPT,NRBAND(7) R0263630 COMMON /OUT/NR,NSTR,NROUT(8) R0263640 COMMON/QTSARG/SIGEX(90),RRQTSA(910) R0263650 DIMENSION C(6),D(12),Q(2) 00263660 DIMENSION NORD(NADD) 00263670 DATA Q/4HNODE,4HC.G./ 00263680 MTYP=10 00263690 JJ=SIG(150)/6. 00263700 IF(NTAG.GT.0) GO TO 125 00263710 IF(NTAG.EQ.0) WRITE(6,100) 00263720 100 FORMAT(1X , 39H .... 3-D SOLID ELEMENTS 8-20NODE .... /) 00263730 IF(NTAG.EQ.0.AND.KOPT.GT.1.AND.NADD.EQ.1) WRITE(6,110) 00263740 110 FORMAT(5X, 35H NODE NUMBERS ARE RENUMBERED NODES /) 00263750 IF(NTAG.EQ.0) WRITE(6,120) 00263760 120 FORMAT( 00263770 $61H ELEM. LOAD LOC. SIG-XX SIG-YY SIG-ZZ SIG-XY S, 00263780 $57HIG-YZ SIG-ZX SIG-MAX SIG-MIN SIG-MID SIG-EF/) 00263790 125 KK=SIG(150) 00263800 A=0. 00263810 B=0. 00263820 E=6. 00263830 KL=0 00263840 DO 180 I=1,JJ 00263850 KK=KK+1 00263860 FACE=SIG(KK)*10000.+.001 00263870 NF=FACE 00263880 LL=NF 00263890 IF(NADD.GT.1.AND.I.GT.1) NF=NORD(LL) 00263900 LL=6*(I-1) 00263910 DO 130 J=1,6 00263920 LL=LL+1 00263930 130 D(J)=SIG(LL) 00263940 CALL SPRIST(A,B,D,C,E) 00263950 EFS=(C(1)-C(2))**2+(C(2)-C(3))**2+(C(3)-C(1))**2 00263960 EFS= DSQRT(EFS/2.) 00263970 DO 135 K=1,3 00263980 KL=KL+1 00263990 135 SIGEX(KL)=C(K) 00264000 KL=KL+1 00264010 SIGEX(KL)=EFS 00264020 IF(I.GT.1) GO TO 160 00264030 140 FORMAT(I4,I2,2H71,6F9.0) 00264040 WRITE(6,150)MM,L,Q(2),(D(J),J=1,6),(C(J),J=1,3),EFS 00264050 WRITE(35,1235)MM,MTYP,L,(D(J),J=1,6),(C(J),J=1,3),EFS 00264060 150 FORMAT(I5,I4,1X,A4,1X,10E10.3) 00264070 GO TO 180 00264080 160 WRITE(6,170)Q(1),NF,(D(J),J=1,6),(C(J),J=1,3),EFS 00264090 170 FORMAT (5X,A4,I5,1X,10E10.3) 00264100 180 CONTINUE 00264110 KK=SIG(150) 00264120 LL=JJ*4 00264130 NS=KK+LL 00264140 IF(NSTR.GT.0) WRITE(NSTR,1234) NS,L,(SIGEX(I),I=1,LL),(SIG(I),I=1,00264150 $KK) 00264160 1234 FORMAT(I4,I2,2X,2H10,7G10.4/(8G10.4)) 00264170 1235 FORMAT(3I5,10E10.3) 00264180 RETURN 00264190 END 00264200 SUBROUTINE MPRMAT(A,NR,NC,MAX,TITLE) 00150800 IMPLICIT REAL*8(A-H,O-Z) 00150810 DIMENSION A(MAX,1) , TITLE(2) 00150820 WRITE(6,150)TITLE 00150830 DO 120 J=1,NC,8 00150840 JH=J+7 00150850 IF (JH-NC) 110,110,100 00150860 100 JH=NC 00150870 110 WRITE(6,130)(N,N=J,JH) 00150880 DO 120 I=1,NR 00150890 120 WRITE(6,140)I,(A(I,K),K=J,JH) 00150900 RETURN 00150910 130 FORMAT (///8X,8I14) 00150920 140 FORMAT (I4,4X,8E14.7) 00150930 150 FORMAT(1X ,8H MATRIX ,2A8) 00150940 END 00150950 SUBROUTINE TUBE 00316510 DOUBLE PRECISION A,SM2,SM3,VQIB2,VQIB3,DP,BF,TF,TW,DIAM,WALL,R2, 00316520 1 R3,EBM,RED,FY,XK,YK,DL,FATEN,FASHR,FACOM,FB2,FB3,PSI,SHR,COMB,00316530 2 AXR,BEND2,BEND3,P,S2I,S3I,S2J,S3J,XM2I,XM3I,XM2J,XM3J,TYPE, 00316540 3 PI,XLR2,XLR3,XLR,CC,RTL,FE2,FE3,XINER,AWC,DT257,FY6,AF,C,S76, 00316550 4 FB4,AFC,SQFY,S20,BT,T1,BT65,C102,DT,AW,BT95,C510,FB5,B,TI,XX, 00316560 5 DT1,ROD,CID,DT2,RID,DTA,AOD,AID,COD,ST,BTT,SS,DTT,BT190,BTS, 00316570 6 BT238,DTS,FS,T2,CM3T3,XFB2I,COMB2J,XFB3JB,T3,SH2I,XFB3I,TJ, 00316580 7 XFAFA,CM2,SH2J,XFB2J,COMB1I,XFB2IB,CM3,SH3I,XFB3J,COMB2I, 00316590 8 XFB3IB,CM2T2,SH3J,XFA,COMB1J,XFB2JB,TEMP,FLG,XINC, 00316600 9 XINER2,XINER3 00316610 COMMON/STEEL/A,SM2,SM3,VQIB2,VQIB3,DP,BF,TF,TW,DIAM,WALL,R2,R3, 00316620 1 EBM,RED,FY,XK,YK,DL,FATEN,FASHR,FACOM,FB2,FB3,PSI,SHR,COMB, 00316630 2 AXR,BEND2,BEND3,P,S2I,S3I,S2J,S3J,XM2I,XM3I,XM2J,XM3J, 00316640 3 TYPE,PI,XLR2,XLR3,XLR,CC,RTL,FE2,FE3,XINER,AWC,DT257,FY6,AF, 00316650 4 C,S76,FB4,AFC,SQFY,S20,BT,T1,BT65,C102,DT,AW,BT95,C510,FB5, 00316660 5 B,TI,XX,DT1,ROD,CID,DT2,RID,DTA,AOD,AID,COD,ST,BTT,SS,DTT, 00316670 6 BT190,BTS,BT238,DTS,FS,T2,CM3T3,XFB2I,COMB2J,XFB3JB,T3,SH2I, 00316680 7 XFB3I,TJ,XFAFA,CM2,SH2J,XFB2J,COMB1I,XFB2IB,CM3,SH3I,XFB3J, 00316690 8 COMB2I,XFB3IB,CM2T2,SH3J,XFA,COMB1J,XFB2JB,TEMP,FLG,XINC, 00316700 9 XINER2,XINER3,ICT,KATX,KATY 00316710 RED=1.0D0 00316720 XINER=SM3*DP/2.0D0 00316730 R3=DSQRT(XINER/A) 00316740 AF=BF*TF 00316750 AFC=(DP/2.0D0)-(TF/2.0D0) 00316760 T1=(DP/2.0D0)-TF 00316770 AW=T1*TW*2.0D0 00316780 AWC=T1/2.0D0 00316790 C=((AF*AFC)+(AW*AWC))/(AF+AW) 00316800 VQIB2=(A*C)/(4.0D0*XINER*TW) 00316810 XINER=SM2*BF/2.0D0 00316820 R2=DSQRT(XINER/A) 00316830 AF=DP*TW 00316840 AFC=(BF/2.0D0)-(TW/2.0D0) 00316850 T1=(BF/2.0D0)-TW 00316860 AW=T1*TF*2.0D0 00316870 AWC=T1/2.0D0 00316880 C=((AF*AFC)+(AW*AWC))/(AF+AW) 00316890 VQIB3=(A*C)/(4.0D0*XINER*TF) 00316900 VQIB3=(A*C)/(4.0D0*XINER*TF) 00316910 RTL=0.0D0 00316920 BT190=190.0D0/SQFY 00316930 BT238=238.0D0/SQFY 00316940 BTT=(BF-TW-TW)/TF 00316950 DTT=DP/TW 00316960 BTS=(DP-TF-TF)/TW 00316970 DTS=BF/TF 00316980 RETURN 00316990 END 00317000 00317010 00317020 SUBROUTINE FCOPY(ID,IF) 00086440 RETURN 00086450 END 00086460 SUBROUTINE RATIO 00194650 DOUBLE PRECISION FATEN,FASHR,FACOM,FE2,FE3,FB2,FB3 00194660 DOUBLE PRECISION A,SM2,SM3,VQIB2,VQIB3,DP,BF,TF,TW,DIAM,WALL,R2, 00194670 1 R3,EBM,RED,FY,XK,YK,DL,ZATEN,ZASHR,ZACOM,ZB2,ZB3,PSI,SHR,COMB,00194680 2 AXR,BEND2,BEND3,P,S2I,S3I,S2J,S3J,XM2I,XM3I,XM2J,XM3J,TYPE, 00194690 3 PI,XLR2,XLR3,XLR,CC,RTL,ZE2,ZE3,XINER,AWC,DT257,FY6,AF,C,S76, 00194700 4 FB4,AFC,SQFY,S20,BT,T1,BT65,C102,DT,AW,BT95,C510,FB5,B,TI,XX, 00194710 5 DT1,ROD,CID,DT2,RID,DTA,AOD,AID,COD,ST,BTT,SS,DTT,BT190,BTS, 00194720 6 BT238,DTS,FS,T2,CM3T3,XFB2I,COMB2J,XFB3JB,T3,SH2I,XFB3I,TJ, 00194730 7 XFAFA,CM2,SH2J,XFB2J,COMB1I,XFB2IB,CM3,SH3I,XFB3J,COMB2I, 00194740 8 XFB3IB,CM2T2,SH3J,XFA,COMB1J,XFB2JB,TEMP,FLG,XINC, 00194750 9 XINER2,XINER3 00194760 COMMON/STEEL/A,SM2,SM3,VQIB2,VQIB3,DP,BF,TF,TW,DIAM,WALL,R2,R3, 00194770 1 EBM,RED,FY,XK,YK,DL,ZATEN,ZASHR,ZACOM,ZB2,ZB3,PSI,SHR,COMB, 00194780 2 AXR,BEND2,BEND3,P,S2I,S3I,S2J,S3J,XM2I,XM3I,XM2J,XM3J, 00194790 3 TYPE,PI,XLR2,XLR3,XLR,CC,RTL,ZE2,ZE3,XINER,AWC,DT257,FY6,AF, 00194800 4 C,S76,FB4,AFC,SQFY,S20,BT,T1,BT65,C102,DT,AW,BT95,C510,FB5, 00194810 5 B,TI,XX,DT1,ROD,CID,DT2,RID,DTA,AOD,AID,COD,ST,BTT,SS,DTT, 00194820 6 BT190,BTS,BT238,DTS,FS,T2,CM3T3,XFB2I,COMB2J,XFB3JB,T3,SH2I, 00194830 7 XFB3I,TJ,XFAFA,CM2,SH2J,XFB2J,COMB1I,XFB2IB,CM3,SH3I,XFB3J, 00194840 8 COMB2I,XFB3IB,CM2T2,SH3J,XFA,COMB1J,XFB2JB,TEMP,FLG,XINC, 00194850 9 XINER2,XINER3,ICT,KATX,KATY 00194860 T2=0.0D0 00194870 T3=0.0D0 00194880 CM2=0.0D0 00194890 CM3=0.0D0 00194900 CM2T2=0.0D0 00194910 CM3T3=0.0D0 00194920 FATEN=XINC*ZATEN 00194930 FASHR=XINC*ZASHR 00194940 FACOM=XINC*ZACOM 00194950 FE2=XINC*ZE2 00194960 FE3=XINC*ZE3 00194970 SH2I=DABS(S2I)*VQIB2 00194980 SH2J=DABS(S2J)*VQIB2 00194990 SH3I=DABS(S3I)*VQIB3 00195000 SH3J=DABS(S3J)*VQIB3 00195010 IF(TYPE-1.0D0)100,100,101 00195020 101 SH3I=0.0D0 00195030 SH3J=0.0D0 00195040 SH2I=DSQRT(S2I*S2I+S3I*S3I)*VQIB2 00195050 SH2J=DSQRT(S2J*S2J+S3J*S3J)*VQIB2 00195060 100 SHR=DMAX1(SH2I,SH2J,SH3I,SH3J) 00195070 SHR=SHR/FASHR 00195080 XFB2I=12.0D0*DABS(XM2I)/SM2 00195090 XFB3I=12.0D0*DABS(XM3I)/SM3 00195100 XFB2J=12.0D0*DABS(XM2J)/SM2 00195110 XFB3J=12.0D0*DABS(XM3J)/SM3 00195120 XFA=DABS(P)/A 00195130 IF(TYPE.EQ.0.0D0)CALL WFFB 00195140 IF(TYPE.EQ.1.0D0)CALL TUFB 00195150 FB2=XINC*ZB2 00195160 FB3=XINC*ZB3 00195170 IF(TYPE-1.0D0)200,200,201 00195180 201 TI=DSQRT(XFB2I*XFB2I+XFB3I*XFB3I) 00195190 TJ=DSQRT(XFB2J*XFB2J+XFB3J*XFB3J) 00195200 IF(TI.LE.0.0D0)TI=1.0D0 00195210 IF(TJ.LE.0.0D0)TJ=1.0D0 00195220 XFB2I=XFB2I*XFB2I/TI 00195230 XFB2J=XFB2J*XFB2J/TJ 00195240 XFB3I=XFB3I*XFB3I/TI 00195250 XFB3J=XFB3J*XFB3J/TJ 00195260 200 IF(ICT)300,300,301 00195270 300 AXR=XFA/FATEN 00195280 COMB1I=(XFB2I/FB2)+(XFB3I/FB3) 00195290 COMB2I=AXR+(XFB2I/FB2)+(XFB3I/FB3) 00195300 COMB1J=(XFB2J/FB2)+(XFB3J/FB3) 00195310 COMB2J=AXR+(XFB2J/FB2)+(XFB3J/FB3) 00195320 COMB=DMAX1(COMB1I,COMB1J,COMB2I,COMB2J) 00195330 IF(COMB.EQ.COMB1I)GO TO 400 00195340 IF(COMB.EQ.COMB2I)GO TO 401 00195350 IF(COMB.EQ.COMB1J)GO TO 402 00195360 IF(COMB.EQ.COMB2J)GO TO 403 00195370 GO TO 9999 00195380 400 AXR=0.0D0 00195390 BEND2=XFB2I/FB2 00195400 BEND3=XFB3I/FB3 00195410 GO TO 9999 00195420 401 BEND2=XFB2I/FB2 00195430 BEND3=XFB3I/FB3 00195440 GO TO 9999 00195450 402 AXR=0.0D0 00195460 BEND2=XFB2J/FB2 00195470 BEND3=XFB3J/FB3 00195480 GO TO 9999 00195490 403 BEND2=XFB2J/FB2 00195500 BEND3=XFB3J/FB3 00195510 GO TO 9999 00195520 301 XFAFA=XFA/FACOM 00195530 XFB2IB=XFB2I/FB2 00195540 XFB3IB=XFB3I/FB3 00195550 XFB2JB=XFB2J/FB2 00195560 XFB3JB=XFB3J/FB3 00195570 IF(XFAFA-.15D0)600,600,601 00195580 600 COMB1I=XFAFA+XFB2IB+XFB3IB 00195590 COMB1J=XFAFA+XFB2JB+XFB3JB 00195600 AXR=XFAFA 00195610 IF(COMB1I-COMB1J)650,650,651 00195620 650 COMB=COMB1J 00195630 BEND2=XFB2JB 00195640 BEND3=XFB3JB 00195650 GO TO 9999 00195660 651 COMB=COMB1I 00195670 BEND2=XFB2IB 00195680 BEND3=XFB3IB 00195690 GO TO 9999 00195700 601 COMB1I=(XFA/FATEN)+XFB2IB+XFB3IB 00195710 COMB1J=(XFA/FATEN)+XFB2JB+XFB3JB 00195720 T2=1.0D0-(XFA/FE2) 00195730 T3=1.0D0-(XFA/FE3) 00195740 IF(T2.LE.0.0D0.OR.T3.LE.0.0D0)GO TO 700 00195750 GO TO 750 00195760 700 AXR=9.9999D0 00195770 BEND2=0.0D0 00195780 BEND3=0.0D0 00195790 COMB=9.9999D0 00195800 GO TO 9999 00195810 750 GO TO(901,902,1300,1310,903,1320,1330),KATX 00195820 901 CM2=1.0D0-(.18D0*XFA/FE2) 00195830 GO TO 904 00195840 902 CM2=1.0 00195850 IF(DABS(XM2I).GT.DABS(XM2J))CM2=XM2J/XM2I 00195860 IF(DABS(XM2J).GT.DABS(XM2I))CM2=XM2I/XM2J 00195870 CM2=DSQRT(.3*CM2*CM2-.4*CM2+.3) 00195880 GO TO 904 00195890 1300 CM2=1.0D0 00195900 GO TO 904 00195910 1310 CM2=1.0D0-(0.2D0*XFA/FE2) 00195920 GO TO 904 00195930 903 CM2=1.0D0-(.3D0*XFA/FE2) 00195940 GO TO 904 00195950 1320 CM2=1.0D0-(0.4*XFA/FE2) 00195960 GO TO 904 00195970 1330 CM2=1.0D0-(0.6*XFA/FE2) 00195980 904 GO TO(911,912,1370,1380,913,1390,1400),KATY 00195990 911 CM3=1.0D0-(.18D0*XFA/FE3) 00196000 GO TO 914 00196010 912 CM3=1.0 00196020 IF(DABS(XM3I).GT.DABS(XM3J))CM3=XM3J/XM3I 00196030 IF(DABS(XM3J).GT.DABS(XM3I))CM3=XM3I/XM3J 00196040 CM3=DSQRT(.3*CM3*CM3-.4*CM3+.3) 00196050 GO TO 914 00196060 1370 CM3=1.0D0 00196070 GO TO 914 00196080 1380 CM3=1.0D0-(0.2*XFA/FE3) 00196090 GO TO 914 00196100 913 CM3=1.0D0-(.3D0*XFA/FE3) 00196110 GO TO 914 00196120 1390 CM3=1.0D0-(0.4D0*XFA/FE3) 00196130 GO TO 914 00196140 1400 CM3=1.0D0-(0.6D0*XFA/FE3) 00196150 914 CM2T2=CM2/T2 00196160 CM3T3=CM3/T3 00196170 IF(CM2T2.LT.1.0) CM2T2=1.0 00196180 IF(CM3T3.LT.1.0) CM3T3=1.0 00196190 COMB2I=XFAFA+CM2T2*XFB2IB+CM3T3*XFB3IB 00196200 COMB2J=XFAFA+CM2T2*XFB2JB+CM3T3*XFB3JB 00196210 COMB=DMAX1(COMB1I,COMB1J,COMB2I,COMB2J) 00196220 IF(COMB.EQ.COMB1I)GO TO 800 00196230 IF(COMB.EQ.COMB1J)GO TO 801 00196240 IF(COMB.EQ.COMB2I)GO TO 802 00196250 IF(COMB.EQ.COMB2J)GO TO 803 00196260 GO TO 9999 00196270 800 AXR=XFA/FATEN 00196280 BEND2=XFB2IB 00196290 BEND3=XFB3IB 00196300 GO TO 9999 00196310 801 AXR=XFA/FATEN 00196320 BEND2=XFB2JB 00196330 BEND3=XFB3JB 00196340 GO TO 9999 00196350 802 AXR=XFAFA 00196360 BEND2=(CM2T2)*XFB2IB 00196370 BEND3=(CM3T3)*XFB3IB 00196380 GO TO 9999 00196390 803 AXR=XFAFA 00196400 BEND2=(CM2T2)*XFB2JB 00196410 BEND3=(CM3T3)*XFB3JB 00196420 9999 CONTINUE 00196430 RETURN 00196440 END 00196450 SUBROUTINE MHDIAG(H,N,IEGEN,U,NR,X,IQ) 00135830 IMPLICIT REAL*8(A-H,O-Z) 00135840 REAL*8 IQ 00135850 DIMENSION H(N,N),U(N,N),X(N),IQ(N) 00135860 IF (IEGEN) 140,100,140 00135870 100 DO 130 I=1,N 00135880 DO 130 J=1,N 00135890 IF(I-J) 120,110,120 00135900 110 U(I,J)=1.0 00135910 GO TO 130 00135920 120 U(I,J)=0. 00135930 130 CONTINUE 00135940 140 NR = 0 00135950 IF (N-1) 540,540,150 00135960 150 NMI1=N-1 00135970 DO 170 I=1,NMI1 00135980 X(I) = 0. 00135990 IPL1=I+1 00136000 DO 170 J=IPL1,N 00136010 IF ( X(I) - DABS( H(I,J))) 160,160,170 00136020 160 X(I)= DABS(H(I,J)) 00136030 IQ(I)=J 00136040 170 CONTINUE 00136050 RAP=7.450580596E-9 00136060 HDTEST=1.0E38 00136070 180 DO 210 I=1,NMI1 00136080 IF (I-1) 200,200,190 00136090 190 IF ( XMAX- X(I)) 200,210,210 00136100 200 XMAX=X(I) 00136110 IPIV=I 00136120 JPIV=IQ(I) 00136130 210 CONTINUE 00136140 IF ( XMAX) 540,540,220 00136150 220 IF (HDTEST) 240,240,230 00136160 230 IF (XMAX - HDTEST) 240,240,270 00136170 240 HDIMIN = DABS( H(1,1) ) 00136180 DO 260 I= 2,N 00136190 IF (HDIMIN- DABS( H(I,I))) 260,260,250 00136200 250 HDIMIN= DABS(H(I,I)) 00136210 260 CONTINUE 00136220 HDTEST=HDIMIN*RAP 00136230 IF (HDTEST- XMAX) 270,540,540 00136240 270 NR = NR+1 00136250 280 TANG = DSIGN(2.D0,(H(IPIV,IPIV)-H(JPIV,JPIV)))*H(IPIV,JPIV)/(DABS(00136260 $H(IPIV,IPIV)-H(JPIV,JPIV))+ DSQRT((H(IPIV,IPIV)-H(JPIV,JPIV)) 00136270 $**2+4.0*H(IPIV,JPIV)**2)) 00136280 COSINE=1.0/ DSQRT(1.0+TANG**2) 00136290 SINE=TANG*COSINE 00136300 HII=H(IPIV,IPIV) 00136310 H(IPIV,IPIV)=COSINE**2*(HII+TANG*(2.*H(IPIV,JPIV)+TANG*H(JPIV,JPIV00136320 $))) 00136330 H(JPIV,JPIV)=COSINE**2*(H(JPIV,JPIV)-TANG*(2.*H(IPIV,JPIV)-TANG*H 00136340 $II)) 00136350 H(IPIV,JPIV)=0. 00136360 IF ( H(IPIV,IPIV) - H(JPIV,JPIV)) 290,300,300 00136370 290 HTEMP = H(IPIV,IPIV) 00136380 H(IPIV,IPIV) = H(JPIV,JPIV) 00136390 H(JPIV,JPIV) = HTEMP 00136400 HTEMP=DSIGN (1.D0,-SINE)*COSINE 00136410 COSINE = DABS (SINE) 00136420 SINE = HTEMP 00136430 300 CONTINUE 00136440 DO 380 I=1,NMI1 00136450 IF(I-IPIV)320,380,310 00136460 310 IF(I-JPIV)320,380,320 00136470 320 IF(IQ(I)-IPIV)330,340,330 00136480 330 IF(IQ(I)-JPIV)380,340,380 00136490 340 K=IQ(I) 00136500 350 HTEMP=H(I,K) 00136510 H(I,K)=0. 00136520 IPL1=I+1 00136530 X(I) =0. 00136540 DO 370 J=IPL1,N 00136550 IF ( X(I)- DABS( H(I,J)) ) 360,360,370 00136560 360 X(I) = DABS(H(I,J)) 00136570 IQ(I)=J 00136580 370 CONTINUE 00136590 H(I,K)=HTEMP 00136600 380 CONTINUE 00136610 X(IPIV) =0. 00136620 X(JPIV) =0. 00136630 DO 510 I=1,N 00136640 IF(I-IPIV)390,510,430 00136650 390 HTEMP = H(I,IPIV) 00136660 H(I,IPIV) = COSINE*HTEMP + SINE*H(I,JPIV) 00136670 IF ( X(I) - DABS( H(I,IPIV)) )400,410,410 00136680 400 X(I) = DABS(H(I,IPIV)) 00136690 IQ(I) = IPIV 00136700 410 H(I,JPIV) = -SINE*HTEMP + COSINE*H(I,JPIV) 00136710 IF ( X(I) - DABS( H(I,JPIV)) ) 420,510,510 00136720 420 X(I) = DABS(H(I,JPIV)) 00136730 IQ(I) = JPIV 00136740 GO TO 510 00136750 430 IF(I-JPIV)440,510,470 00136760 440 HTEMP = H(IPIV,I) 00136770 H(IPIV,I) = COSINE*HTEMP + SINE*H(I,JPIV) 00136780 IF ( X(IPIV) - DABS( H(IPIV,I)) ) 450,460,460 00136790 450 X(IPIV) = DABS(H(IPIV,I)) 00136800 IQ(IPIV) = I 00136810 460 H(I,JPIV) = -SINE*HTEMP + COSINE*H(I,JPIV) 00136820 IF ( X(I) - DABS( H(I,JPIV)) ) 420,510,510 00136830 470 HTEMP = H(IPIV,I) 00136840 H(IPIV,I) = COSINE*HTEMP + SINE*H(JPIV,I) 00136850 IF ( X(IPIV) - DABS( H(IPIV,I)) ) 480,490,490 00136860 480 X(IPIV) = DABS(H(IPIV,I)) 00136870 IQ(IPIV) = I 00136880 490 H(JPIV,I) = -SINE*HTEMP + COSINE*H(JPIV,I) 00136890 IF ( X(JPIV) - DABS( H(JPIV,I)) ) 500,510,510 00136900 500 X(JPIV) = DABS(H(JPIV,I)) 00136910 IQ(JPIV) = I 00136920 510 CONTINUE 00136930 IF(IEGEN)180,520,180 00136940 520 DO 530 I=1,N 00136950 HTEMP=U(I,IPIV) 00136960 U(I,IPIV)=COSINE*HTEMP+SINE*U(I,JPIV) 00136970 530 U(I,JPIV)=-SINE*HTEMP+COSINE*U(I,JPIV) 00136980 GO TO 180 00136990 540 RETURN 00137000 END 00137010 FUNCTION MINDEG(NC,IC,IDEG,NN) 00137020 INTEGER*2 IC,IDEG 00137030 DIMENSION IC(1),IDEG(1) 00137040 M=10000 00137050 DO 130 I=1,NN 00137060 IF(NC)100,110,100 00137070 100 IF(IC(I)-NC) 130,110,130 00137080 110 IF(M-IDEG(I)) 130,130,120 00137090 120 M=IDEG(I) 00137100 130 CONTINUE 00137110 MINDEG=M 00137120 RETURN 00137130 END 00137140 SUBROUTINE PIPE 00164640 DOUBLE PRECISION FXE,FXC 00164650 DOUBLE PRECISION A,SM2,SM3,VQIB2,VQIB3,DP,BF,TF,TW,DIAM,WALL,R2, 00164660 1 R3,EBM,RED,FY,XK,YK,DL,FATEN,FASHR,FACOM,FB2,FB3,PSI,SHR,COMB,00164670 2 AXR,BEND2,BEND3,P,S2I,S3I,S2J,S3J,XM2I,XM3I,XM2J,XM3J,TYPE, 00164680 3 PI,XLR2,XLR3,XLR,CC,RTL,FE2,FE3,XINER,AWC,DT257,FY6,AF,C,S76, 00164690 4 FB4,AFC,SQFY,S20,BT,T1,BT65,C102,DT,AW,BT95,C510,FB5,B,TI,XX, 00164700 5 DT1,ROD,CID,DT2,RID,DTA,AOD,AID,COD,ST,BTT,SS,DTT,BT190,BTS, 00164710 6 BT238,DTS,FS,T2,CM3T3,XFB2I,COMB2J,XFB3JB,T3,SH2I,XFB3I,TJ, 00164720 7 XFAFA,CM2,SH2J,XFB2J,COMB1I,XFB2IB,CM3,SH3I,XFB3J,COMB2I, 00164730 8 XFB3IB,CM2T2,SH3J,XFA,COMB1J,XFB2JB,TEMP,FLG,XINC, 00164740 9 XINER2,XINER3 00164750 COMMON/STEEL/A,SM2,SM3,VQIB2,VQIB3,DP,BF,TF,TW,DIAM,WALL,R2,R3, 00164760 1 EBM,RED,FY,XK,YK,DL,FATEN,FASHR,FACOM,FB2,FB3,PSI,SHR,COMB, 00164770 2 AXR,BEND2,BEND3,P,S2I,S3I,S2J,S3J,XM2I,XM3I,XM2J,XM3J, 00164780 3 TYPE,PI,XLR2,XLR3,XLR,CC,RTL,FE2,FE3,XINER,AWC,DT257,FY6,AF, 00164790 4 C,S76,FB4,AFC,SQFY,S20,BT,T1,BT65,C102,DT,AW,BT95,C510,FB5, 00164800 5 B,TI,XX,DT1,ROD,CID,DT2,RID,DTA,AOD,AID,COD,ST,BTT,SS,DTT, 00164810 6 BT190,BTS,BT238,DTS,FS,T2,CM3T3,XFB2I,COMB2J,XFB3JB,T3,SH2I, 00164820 7 XFB3I,TJ,XFAFA,CM2,SH2J,XFB2J,COMB1I,XFB2IB,CM3,SH3I,XFB3J, 00164830 8 COMB2I,XFB3IB,CM2T2,SH3J,XFA,COMB1J,XFB2JB,TEMP,FLG,XINC, 00164840 9 XINER2,XINER3,ICT,KATX,KATY 00164850 DTA=DIAM/WALL 00164860 FXE=0.6*EBM*WALL/DIAM 00164870 FXC=FY*(1.64-0.23*DTA**0.25) 00164880 IF(FXC.GT.FXE)FXC=FXE 00164890 IF(FXC.GT.FY)FXC=FY 00164900 RED=FXC/FY 00164910 FB2=.6666667D0*FY*RED 00164920 FB3=FB2 00164930 XINER=SM2*DIAM/2.0D0 00164940 R2=DSQRT(XINER/A) 00164950 R3=R2 00164960 ROD=DIAM/2.0D0 00164970 RID=ROD-WALL 00164980 AOD=1.570796D0*ROD*ROD 00164990 AID=1.570796D0*RID*RID 00165000 COD=.424413D0*ROD 00165010 CID=.424413D0*RID 00165020 C=((AOD*COD)-(AID*CID))/(AOD-AID) 00165030 VQIB2=(A*C)/(4.0D0*XINER*WALL) 00165040 VQIB3=VQIB2 00165050 RTL=0.0D0 00165060 RETURN 00165070 END 00165080 00165090 00165100 SUBROUTINE SIXST1 00238110 IMPLICIT REAL*8(A-H,O-Z) 00238120 COMMON /OUT/NRES,NSTR,NROUT(8) R0238130 COMMON/JUNK/SIG(6),EXTRA(194),MM,L,K,NTAG,RRJUNK(25) R0238140 IF(NTAG.EQ.0) WRITE(6,300) 00238150 WRITE(6,100)MM,L,SIG 00238160 NTAG=1 00238170 IF(NSTR.GT.0) WRITE (NSTR,1234) L,SIG 00238180 1234 FORMAT(3X,1H6,I2,2X,2H14,6G10.4) 00238190 RETURN 00238200 100 FORMAT (2I6,6E15.8) 00238210 200 FORMAT (I4,I2,2H12,6F9.0) 00238220 300 FORMAT (//10X,48H SIX BY SIX STIFFNESS ELEMENT FORCES AND MOMENTS/00238230 $20X,18H(LOCAL DIRECTIONS)/ 00238240 $12H0EL.NO. LOAD,5X,10HFORCE - XX,5X,10HFORCE - YY,5X,10HFORCE - ZZ00238250 $,4X,11HMOMENT - XX,4X,11HMOMENT - YY,4X,11HMOMENT - ZZ) 00238260 END 00238270 SUBROUTINE STRUSS 00282440 IMPLICIT REAL*8(A-H,O-Z) 00282450 REAL*8 NPAR COMMON A(1) 00282460 COMMON /ELPAR/ NPAR(14),NUMNP,MBAND,NELTYP,N1,N2,N3,N4,N5,MTOT,NEQ00282470 $ ,N2P,N3P,NMRI,NTRI,N1P,NUMEL,NUMEL2,KZ(20,2),NEMN R0282480 COMMON/JUNK/SIG(12),EXTRA(188),MM,L,K,NTAG,NDYN,NRJUNK(49) R0282490 COMMON /OUT/NRES,NSTR,NDIS,NROUT(7) R0282500 100 IF (NTAG.EQ.0) WRITE (6,130) 00282510 110 WRITE(6,140) MM,L,SIG(1),SIG(2) 00282520 NTAG=1 00282530 IF(NSTR.GT.0) WRITE(NSTR,1234) L,SIG(1),SIG(2) 00282540 1234 FORMAT(3X,1H2,I2,2X,2H 1,6G10.4) 00282550 120 FORMAT (I4,I2,2H12 ) 00282560 RETURN 00282570 130 FORMAT(23H1 TRUSS MEMBER ACTIONS // 00282580 $ 46H0 MEMBER LOAD STRESS FORCE/) 00282590 140 FORMAT (2I8,E15.5,E15.5) 00282600 END 00282610 SUBROUTINE SAXIS 00221180 IMPLICIT REAL*8(A-H,O-Z) 00221190 REAL*8 NPAR RR221191 COMMON/JUNK/SIG(200),MM,L,K,NTAG,NDYN,NRJUNK(49) R0221200 COMMON /ELPAR/ NPAR(14),NUMNP,MBAND,NELTYP,N1,N2,N3,N4,N5,MTOT,NEQ00221210 $ ,N2P,N3P,NMRI,NTRI,N1P,NUMEL,NUMEL2,KZ(20,2),NEMN 00221220 COMMON /OUT/NRES,NSTR,NDIS,NROUT(7) R0221230 MTYP=4 00221240 100 IF(NTAG.EQ.0) WRITE (6,130) 00221250 CC=(SIG(1)+SIG(2))/2.0 00221260 BB=(SIG(1)-SIG(2))/2. 00221270 CR= DSQRT(BB**2+SIG(4)**2) 00221280 SIG(5)=CC+CR 00221290 SIG(6)=CC-CR 00221300 SIG(7)=0.0 00221310 EF=(SIG(3)-SIG(5))**2+(SIG(5)-SIG(6))**2+(SIG(6)-SIG(3))**2 00221320 EF= DSQRT(EF/2.) 00221330 IF ((BB.EQ.0.0).AND.(SIG(4).EQ.0.0)) GO TO 110 00221340 SIG(7)=28.648* DATAN2(SIG(4),BB) 00221350 110 WRITE(6,140)MM,L,(SIG (I),I=1,7),EF 00221360 WRITE(35,1235)MM,MTYP,L,(SIG(I),I=1,7),EF 00221370 IF(NSTR.GT.0) WRITE(NSTR,1234) L,SIG(5),SIG(6),EF,(SIG(I),I=1,4) 00221380 1234 FORMAT(3X,1H7,I2,4H12 4 ,7G10.4) 00221390 1235 FORMAT(3I5,10E10.3) 00221400 120 FORMAT (I4,I2,2H12,6F9.0) 00221410 NTAG=1 00221420 RETURN 00221430 130 FORMAT(32H1 AXISYMMETRIC ELEMENT STRESSES // 00221440 $ 12H0EL.NO. LOAD,7X,8HR-STRESS,7X,8HZ-STRESS,7X, 00221450 $ 8HT-STRESS,6X,9HRZ-STRESS,5X,10HMAX-STRESS,5X,10HMIN-STRESS, 00221460 $3X,5HANGLE,5X,6HSIG-EF/) 00221470 140 FORMAT(2I6,6E15.5,F8.3,E12.5) 00221480 END 00221490 SUBROUTINE ELBSTR 00076740 IMPLICIT REAL*8(A-H,O-Z) 00076750 COMMON /JUNK/ SIG(39),EXR(161),MM,L,K,NTAG,RRJUNK(25) R0076760 COMMON / OUT / N,NSTR,NDIS,NBMSTR,NROUT(6) R0076770 IF(NTAG.EQ.0) WRITE(6,100) 00076780 IF(NTAG.EQ.0 .AND. NBMSTR.EQ.1)WRITE(6,125) 00076790 IF(NTAG.EQ.0)WRITE(6,126) 00076800 126 FORMAT(1X) 00076810 100 FORMAT(85H1E L B O W - F O R C E S, M O M E N T S, A 00076820 XN D S T R E S S E S // 00076830 X1X,7HELEMENT,2X,4HLOAD,2X,7HSTATION,15X,5HAXIAL,2(6X,5HSHEAR), 00076840 X4X,9HTORSION ,2(5X,13HB E N D I N G ,4X)/ 00076850 X2X,6HNUMBER,2X,4HCASE,11X,5HFORCE, 00076860 X 11X,2HRX,9X,2HRY,9X,2HRZ,9X,2HMX,20X,2HMY,20X,2HMZ) 00076870 125 FORMAT( 00076880 X25X,6HSTRESS,7X,5HRX/A1,3X,8HAT Q3/B3,4X,8HAT Q2/B2,5X,4H- - ,1X, 00076890 X2X,9H AT +C3,2X,9H AT -C3, 00076900 X2X,9H AT +C2,2X,9H AT -C2 ) 00076910 NS=EXR(161) 00076920 IF(NS.GT.18) 00076930 XWRITE(6,120)MM,L,(SIG(I1),I1= 1, 6), 00076940 X (SIG(I2),I2=19,25), 00076950 X (SIG(I3),I3= 7,12), 00076960 X (SIG(I4),I4=26,32), 00076970 X (SIG(I5),I5=13,18), 00076980 X (SIG(I6),I6=33,39) 00076990 IF(NS.LE.18) 00077000 XWRITE(6,140)MM,L,(SIG(I1),I1= 1,18) 00077010 NTAG=1 00077020 IF(NSTR.GT.0) WRITE(NSTR,1234) NS,L,(SIG(I),I=1,NS) 00077030 1234 FORMAT(I4,I2,2X,2H 9,7G10.4/(8G10.4)) 00077040 120 FORMAT(4X,I4,2X,I4,4X, 00077050 X 5HEND-I, 2X,6HFORCE ,2X,1P4E12.4,12X,1PE12.4,12X,1PE12.4/ 00077060 X23X,2X,6HSTRESS,2X,1P3E12.4,12X,1P4E12.4/ 00077070 X18X,6HCENTER,3X,6HFORCE ,2X,1P4E12.4,12X,1PE12.4,12X,1PE12.4/ 00077080 X23X,2X,6HSTRESS,2X,1P3E12.4,12X,1P4E12.4/ 00077090 X18X,5HEND-J, 2X,6HFORCE ,2X,1P4E12.4,12X,1PE12.4,12X,1PE12.4/ 00077100 X23X,2X,6HSTRESS,2X,1P3E12.4,12X,1P4E12.4) 00077110 140 FORMAT(4X,I4,2X,I4,4X, 00077120 X 5HEND-I, 2X,6HFORCE ,2X,1P4E12.4,12X,1PE12.4,12X,1PE12.4/ 00077130 X18X,6HCENTER,2X,6HFORCE ,2X,1P4E12.4,12X,1PE12.4,12X,1PE12.4/ 00077140 X18X,5HEND-J, 2X,6HFORCE ,2X,1P4E12.4,12X,1PE12.4,12X,1PE12.4) 00077150 RETURN 00077160 END 00077170 SUBROUTINE MXMN1(STRESS,P1,P2,AG,EF) 00151810 IMPLICIT REAL*8 (A-H,O-Z) 00151820 DIMENSION STRESS(1) 00151830 CC = (STRESS(1)+STRESS(2)) * 0.5E0 00151840 BB = (STRESS(1)-STRESS(2)) * 0.5E0 00151850 CR = DSQRT(BB**2 + STRESS(3)**2) 00151860 P1 = CC+CR 00151870 P2 = CC-CR 00151880 AG=45.0E0 00151890 IF( DABS(BB).LT.1.0E-8) GO TO 100 00151900 AG = 28.648E0* DATAN2(STRESS(3),BB) 00151910 100 EF=(P1-P2)**2+(P2-STRESS(4))**2+(STRESS(4)-P1)**2 00151920 EF= DSQRT(EF/2.0) 00151930 RETURN 00151940 END 00151950