Liren Large Software Subsidy 9

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

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

Wrap

Text File | 1980-01-05 | 95.4 KB | 1,196 lines

SUBROUTINE STATIC 00265780 IMPLICIT REAL*8(A-H,O-Z) 00265790 REAL*8 NPAR 00265800 COMMON/BMDATA/IAISC,ILDTYP,ILDMUL,IBMSEC,NLWAVE,ILOCAL R0265810 COMMON/SLVE/NSLAVE 00265820 COMMON/BMJUNK/NUMBM 00265830 COMMON / MISC / NBLOCK,NEQB,LL,NF,LB 00265840 COMMON / JUNK / DUK(200),KKK(4),NDYN,NRJUNK(49) R0265850 COMMON /BAND/ KOPT,NRBAND(7) R0265860 DIMENSION T(3) 00265870 COMMON /ELPAR/ NPAR(14),NUMNP,MBAND,NELTYP,N1,N2,N3,N4,N5,MTOT,NEQ00265880 & ,RRELPA(24) R0265881 COMMON /OUT/IDUMM(4),IOSIG,IODISP,NROUT(4) R0265890 COMMON /HEADIN/TITLE1(20),TITLE2(5),TITLE3(10) 00265900 COMMON A(1) 00265910 CALL FILES(12) 00265920 CALL SECOND (T(1)) 00265930 N2=N1+NUMNP*3 00265940 N3=N2+6*LL 00265950 N4=N3+NEQB*LL 00265960 NSLDM=NSLAVE 00265970 IF(NSLDM.EQ.0) NSLDM=1 00265980 IF(IODISP.EQ.1) CALL FCOPY(L5TP6,L6TP50) 00265990 IF(IODISP.EQ.1) TITHOL=TITLE3(3) 00266000 CALL SPRNTD(A(N1),A(N2),A(N3),NEQB,NUMNP,LL,NBLOCK,NEQ,62,0,A(1), R0266010 1A(N4),NSLDM) 00266020 IF(IODISP.EQ.1) WRITE(6,220) 00266030 IF(IODISP.EQ.1) TITLE3(3)= TITHOL 00266040 CALL SECOND (T(2)) 00266050 100 NADD=1 00266060 IF(KOPT.GT.0) NADD=NUMNP 00266070 N2=N1 00266080 N2A=N2+NEQB*LL 00266090 N3=N2A+NADD 00266100 LB=(MTOT-N3)/(NEQ +12) 00266110 NDYN=0 00266120 KL=1+10*LL 00266130 IF(LB.LE.0) NADD=1 00266140 IF(LB.LE.0) N3=N2+NEQB*LL 00266150 IF(LB.LE.0) LB=(MTOT-N3)/(NEQ+12) 00266160 IF(IOSIG.EQ.1.AND.IODISP.NE.1) CALL FCOPY(L5TP6,L6TP50) 00266170 IF(IOSIG.EQ.1) TITHOL=TITLE3(3) 00266180 CALL SSTRES(A(N1),A(N2),A(N3),NEQB,LB,LL,NEQ,NBLOCK,A(1),A(KL), 00266190 $A(N2A),NADD) 00266200 IF(IAISC.NE.1) GO TO 1500 00266210 LBB=LB 00266220 IF(LBB.GT.LL) LBB=LL 00266230 N3=N2+LBB*12 00266240 N4=N3+LBB*12 00266250 CALL COMBIN(A(N2),A(N3),A(N4),LL,LB) 00266260 CALL AISC(NUMBM) 00266270 1500 CONTINUE 00266280 IF(IOSIG.EQ.1) WRITE(6,220) 00266290 IF(IODISP.EQ.1) WRITE(6,200) 00266300 IF(IOSIG.EQ.1) WRITE(6, 210) 00266310 IF(IOSIG.EQ.1) TITLE3(3)=TITHOL 00266320 CALL SECOND (T(3)) 00266330 T(1)=T(2)-T(1) 00266340 T(2)=T(3)-T(2) 00266350 WRITE (6,110) T(1),T(2) 00266360 RETURN 00266370 110 FORMAT(27H1....TIME LOG (CPU MINUTS) /// R0266380 $ 33H PRINT DISPLACEMENTS........... , F8.2 // 00266390 $ 33H COMPUTE STRESSES.............. , F8.2 //) 00266400 200 FORMAT(///20X,34(1H*)/20X,34HDISPLACEMENTS WILL NOT BE PRINTED./ 00266410 120X,34(1H*)//) 00266420 210 FORMAT(///20X,29(1H*)/20X,29HSTRESSES WILL NOT BE PRINTED./20X, 00266430 1 29(1H*)//) 00266440 220 FORMAT (1H1) 00266450 END 00266460 SUBROUTINE SPRNTD(ID,D,B,NEQB,NUMNP,LL,NBLOCK,NEQ,NT,NF,DIS,ISL, 00252830 1NSLDM) 00252840 IMPLICIT REAL*8(A-H,O-Z) 00252850 REAL*8 ID 00252860 COMMON/PREP/XMX,XAD,KSKIP,NDYN,I1,RRPREP(7) R0252870 COMMON/SLVE/NSLAVE 00252880 INTEGER DUMMY 00252890 COMMON/OUT/NRES,NSTR,NDIS,DUMMY,IOSIG,IODISP,NROUT(4) R0252900 DIMENSION DIS(10,LL),ISL(NSLDM,4) 00252910 COMMON /QTSARG/ NEQ3(10),RRQTSA(995) R0252920 COMMON /GPS/ NEQ4(10),NRGPS(10) R0252930 COMMON /ELPAR/ XPAR(14),NDUM(8),MTOT 00252940 $,IZX(6),NUMEL,NUMEL2,NRELPA(41) R0252950 COMMON A(1) 00252960 COMMON/RIGID/IIA(20),NREX 00252970 COMMON /DYN4/ KDYN,NRDYN4(4) R0252980 COMMON/COMBLD/PCT(15,7),SINC(15),NCOMB,NB(15),LD(15,7) 00252990 DIMENSION ID(NUMNP,3),B(NEQB,LL),D(6,LL) 00253000 IF(NDIS.LT.0) RETURN 00253010 REWIND NT 00253020 IF(NF.GT.0) READ (NT) 00253030 REWIND 8 00253040 READ (8) ID 00253050 IF(NSLAVE.NE.0) REWIND 30 00253060 IF(NSLAVE.NE.0) READ(30)((ISL(I,J),J=1,4),I=1,NSLAVE) 00253070 REWIND 17 00253080 REWIND 18 00253090 NREL=NREX 00253100 IF(NREL.LE.0)NREL=1 00253110 NDPBLK=(MTOT-(16*LL)-4*NUMNP-(6*LL+51)*NREL-NSLDM*4)/(6*LL) 00253120 IF(NDPBLK.GT.NUMNP) NDPBLK=NUMNP 00253130 NBLK= (NUMNP-1)/NDPBLK+1 00253140 KK=1 00253150 NFIL=1 00253160 IF(NDIS.GT.0.AND.IABS(KDYN).NE.11) WRITE(NDIS,7123)NFIL,LL,NDYN,ND00253170 $IS,NSTR,NUMNP,NUMEL,NUMEL2 00253180 7123 FORMAT(2I5,5X,7I5) 00253190 M=1 00253200 NN=-NEQB 00253210 NEND=1 00253220 NGPS=0 00253230 IF(NF.EQ.0) WRITE (6,220) 00253240 IF(NF.GT.0) WRITE (6,240) 00253250 N=NUMNP 00253260 DO 100 I=1,10 00253270 IF(NEQ4(I).GT.0) NGPS=I 00253280 100 NEQ3(I)=0 00253290 DO 210 N=1,NUMNP 00253300 DO 190 I=1,6 00253310 DO 110 L=1,LL 00253320 110 D(I,L)=0. 00253330 IF(NEND.GT.M) GO TO 120 00253340 IF(M.GT.NEQ) GO TO 120 00253350 READ (NT) B 00253360 NN=NN+NEQB 00253370 NEND=NN+NEQB+1 00253380 K=M-NN 00253390 ND=0 00253400 120 CALL UNPKID ( ID ,NUMNP,W ,WX ,2,N,I) 00253410 NNN=W 00253420 IF(NNN.LT.1) GO TO 190 00253430 K=M-NN 00253440 KI=0 00253450 IF(NGPS.EQ.0) GO TO 160 00253460 DO 130 L=1,NGPS 00253470 IF(NNN.EQ.NEQ4(L)) KI=L 00253480 130 CONTINUE 00253490 IF(KI.EQ.0) GO TO 160 00253500 140 DO 150 L=1,LL 00253510 150 D(I,L)=DIS(KI,L) 00253520 IF(NNN.EQ.M) M=M+1 00253530 GO TO 190 00253540 160 CONTINUE 00253550 IF(NSLAVE.EQ.0) GO TO 170 00253560 DO 163 J=1,NSLAVE 00253570 IF(N.EQ.ISL(J,1)) GO TO 164 00253580 163 CONTINUE 00253590 GO TO 170 00253600 164 CONTINUE 00253610 IRK=I 00253620 IF(IRK.LE.3) NMAST=MOD(ISL(J,IRK+1),10000) 00253630 IF(IRK.GT.3) NMAST=ISL(J,IRK-2)/10000 00253640 IF(NMAST.EQ.0) GO TO 170 00253650 IF(NNN.LE.NN) GO TO 1170 00253660 IF(NNN.GE.NEND) GO TO 1195 00253670 KI=NNN-NN 00253680 DO 165 L=1,LL 00253690 165 D(I,L)=B(KI,L) 00253700 GO TO 190 00253710 1170 REWIND NT 00253720 NNRK=-NEQB 00253730 1175 NNRK=NNRK+NEQB 00253740 NENDRK=NNRK+NEQB+1 00253750 READ(NT) B 00253760 IF(NNN.LT.NENDRK) GO TO 1180 00253770 GO TO 1175 00253780 1180 KI=NNN-NNRK 00253790 DO 1185 L=1,LL 00253800 1185 D(I,L)=B(KI,L) 00253810 IF(NN.EQ.NNRK) GO TO 190 00253820 GO TO 1230 00253830 1195 NNRK=NN 00253840 1200 NNRK=NNRK+NEQB 00253850 NENDRK=NNRK+NEQB+1 00253860 READ(NT) B 00253870 IF(NNN.LT.NENDRK) GO TO 1210 00253880 GO TO 1200 00253890 1210 KI=NNN-NNRK 00253900 DO 1220 L=1,LL 00253910 1220 D(I,L)=B(KI,L) 00253920 REWIND NT 00253930 NRK=-NEQB 00253940 1230 NNRK=NNRK+NEQB 00253950 NENDRK=NNRK+NEQB+1 00253960 READ(NT) 00253970 IF(NN.EQ.NNRK) GO TO 190 00253980 GO TO 1230 00253990 170 CONTINUE 00254000 M=M+1 00254010 DO 180 L=1,LL 00254020 180 D(I,L)=B(K,L) 00254030 190 CONTINUE 00254040 200 FORMAT (2I5) 00254050 WRITE (18) D 00254060 210 CONTINUE 00254070 IF(NCOMB.EQ.0) GO TO 260 00254080 K=1+10*LL 00254090 N2=K 00254100 N3=N2+6*LL 00254110 N4=N3+6*NCOMB 00254120 IF(N4.GT.MTOT) CALL ERROR(N4-MTOT) 00254130 CALL COMBDS(A(N2),A(N3),LL,18,NCOMB,NUMNP) 00254140 K=1+10*NCOMB 00254150 N2=K+NUMNP 00254160 N3=N2+6*NCOMB 00254170 NDPBLK=(MTOT-(16*NCOMB)-4*NUMNP-(6*NCOMB+51)*NREL-NSLDM*4) 00254180 1/(6*NCOMB) 00254190 IF(NDPBLK.GT.NUMNP)NDPBLK=NUMNP 00254200 NBLK= (NUMNP-1)/NDPBLK+1 00254210 N4=N3+6*NCOMB*NDPBLK 00254220 N5=N4+NUMNP*3 00254230 N6=N5+NREL*6*NCOMB 00254240 N7=N6+51*NREL 00254250 N8=N7+NSLAVE*4 00254260 IF(N8.GT.MTOT) CALL ERROR(N8-MTOT) 00254270 CALL WRDIS1(A(K),A(N2),A(N3),NUMNP,NCOMB,NDPBLK,NDIS,NBLK 00254280 & ,A(N4),A(N5),A(N6),NREL,A(N7),NSLDM) 00254290 RETURN 00254300 260 CONTINUE 00254310 K=1+10*LL 00254320 N2=K+NUMNP 00254330 N3=N2+6*LL 00254340 N4=N3+6*LL*NDPBLK 00254350 N5=N4+NUMNP*3 00254360 N6=N5+NREL*6*LL 00254370 N7=N6+51*NREL 00254380 N8=N7+NSLAVE*4 00254390 IF(N8.GT.MTOT) CALL ERROR(N8-MTOT) 00254400 CALL WRDIS1(A(K),A(N2),A(N3),NUMNP,LL,NDPBLK,NDIS,NBLK 00254410 & ,A(N4),A(N5),A(N6),NREL,A(N7),NSLDM) 00254420 RETURN 00254430 220 FORMAT (1X ,45HTC++NODE DISPLACEMENTS AND ROTATIONS PRINTOUT, 00254440 $ ///40H0.......NODE DISPLACEMENTS AND ROTATIONS// 00254450 $ 5H NODE,5H LOAD,12X,1HX,17X,1HY,19X,1HZ,19X,2HXX, 00254460 $ 19X, 2HYY,19X, 2HZZ) 00254470 230 FORMAT (1H0,I4,I5,1P3E12.3,3E11.2/(I10,3E12.3,3E11.2)) 00254480 240 FORMAT (19H1.......MODE SHAPES // 00254490 $ 5H NODE,5H MODE,7X,1HX,11X,1HY,11X,1HZ,9X,2HXX, 00254500 $ 9X, 2HYY, 9X, 2HZZ) 00254510 250 FORMAT (I10,7E10.4/(8E10.4)) 00254520 END 00254530 SUBROUTINE SSTRES(STR,B,D,NEQB,LB,LL,NEQ,NBLOCK,DIS,SA,NORD,NADD) 00257810 IMPLICIT REAL*8(A-H,O-Z) 00257820 REAL*8 NPAR 00257830 LOGICAL GEOST 00257840 DIMENSION AD2(13),D(NEQ,LB),B(NEQB,LL),STR(4,LL),AD4(12) 00257850 DIMENSION SA(1) 00257860 DIMENSION DIS(10,LL) 00257870 COMMON/BMDATA/IAISC,ILDTYP,ILDMUL,IBMSEC,NLWAVE,ILOCAL 00257880 COMMON/SIZE/NDMX,MXDF,NSMX,NTERM,NADND 00257890 COMMON/ELARRY/NELAR(4,20) 00257900 COMMON/BMJUNK/NUMBM 00257910 COMMON /ELPAR/ NPAR(14),NUMNP,MBAND,NELTYP,N1,N2,N3,N4,N5,MTOT,MEQ00257920 $ ,N2P,N3P,NMRI,NTRI,N1P,NUMEL,NUMEL2,KZ(20,2),NEMN 00257930 INTEGER DUMMY 00257940 COMMON/OUT/NRES,NSTR,NDIS,DUMMY,IOSIG,IODISP,NROUT(4) R0257950 DIMENSION NORD(NADD) 00257960 COMMON /JUNK/ SIG(200),MM,L,KDU,NTAG,NDYN,NRJUNK(49) R0257970 COMMON /GPS/ NEQ4(10),NRGPS(10) R0257980 COMMON /SIGO/MTYP 00257990 COMMON /RIGID/IIA(20),NREX 00258000 COMMON/BAND/KOPT,NRBAND(7) R0258010 COMMON/COMBLD/PCT(15,7),SINC(15),NCOMB,NB(15),LD(15,7) 00258020 COMMON/GEOSTF/GEOST,NELGEO 00258030 IF(NSTR.LT.0) RETURN 00258040 NT1=1 00258050 NT3=3 00258060 NT9=17 00258070 NT2 = 2 00258080 NT24=24 00258090 NT10=10 00258100 CC REWIND NT1 R0258110 REWIND NT3 00258120 NBLANK=0 00258130 ZERO=0.0D0 00258140 NUMBM=0 00258150 WRITE (6,1006) NADD,NT9,NSTR,NREX,KOPT 1006 FORMAT (5X,'*** NADD NT9 NSTR NREX KOPT ***',5I5/) IF(NADD.GT.1) REWIND NT9 00258160 IF(NADD.GT.1) READ (NT9) NORD 00258170 NT=(LL-1)/LB +1 00258180 LH=0 00258190 CALL RDWRT(NT3,SA,1,6,J) 00258200 NELAST=0 00258210 NFIL=2 00258220 NSTR = 0 IF(NSTR.GT.0) WRITE(NSTR,7123)NFIL,LL,NDYN,NDIS,NSTR,NUMNP,NUMEL,N00258230 $UMEL2,IOPT 00258240 7123 FORMAT(2I5,5X,6I5/I10) 00258250 N=2 00258260 100 FORMAT (2I5) 00258270 DO 290 II=1,NT 00258280 LT =LH+1 00258290 LLT=1-LT 00258300 LH=LT+LB-1 00258310 IF(LH.GT.LL) LH=LL 00258320 IF(NSTR.GT.0) WRITE (NSTR,100) LT,LH 00258330 REWIND 62 R0258340 IF(NDYN.EQ.3) READ (62) R0258350 NQ=-NEQB 00258360 DO 110 NN=1,NBLOCK 00258370 READ (62) B R0258380 N=NEQB 00258390 IF(NN.EQ.NBLOCK) N=NEQ-(NBLOCK-1)*NEQB 00258400 NQ=NQ+NEQB 00258410 DO 110 J=1,N 00258420 I=NQ+J 00258430 DO 110 L=LT,LH 00258440 K=L+LLT 00258450 110 D(I,K)=B(J,L) 00258460 LK=LH-LT+1 00258470 WRITE (6,1007) NDYN 1007 FORMAT (5X,'*** 25848 ***',I5/) IF (.NOT.GEOST) GO TO 111 R0258471 CALL RDWRT(NT1,SA,1,6,J) R0258480 CALL RDWRT(NT2,SA,1,6,J) 00258490 CALL RDWRT(NT24,SA,1,6,J) R0258500 CALL RDWRT(NT10,SA,1,6,J) 00258510 CC WRITE(6,340) 00258520 111 NPAR(1)=0 R0258530 REWIND 68 R0258540 CC READ(68) R0258550 IF(NREX.LE.0)GO TO 115 00258570 IF(KOPT.LE.0)GO TO 115 00258580 REWIND 30 00258560 DO 113 L=1,NUMEL 00258590 113 READ(30) 00258600 115 CONTINUE 00258610 NUME=NUMEL+NUMEL2 00258620 DO 290 MM=1,NUME 00258630 IF (GEOST) CALL RDWRT(NT1,SA,NEMN,0,KOUNT) R0258640 IF (.NOT.GEOST) READ(21) KOUNT R0258641 CC WRITE (6,1009) MM,NEMN,NUMEL,NUME,KOUNT C1009 FORMAT (5X,'*** 25863 MM NEMN NUMEL NUME KOUNT ***',5I5/) IF (.NOT.GEOST) READ(21) (SA(IIR),IIR=1,KOUNT) R0258642 Z=SA(KOUNT) 00258650 IF(MM.GT.NUMEL)GO TO 130 00258660 READ (68) AD2 R0258670 IZ=Z 00258680 IF(NTERM.GT.1.AND.NELAR(1,IZ).GT.8) 00258690 1READ (68)AD4 R0258700 NI=AD2(1) 00258710 NJ=AD2(2) 00258720 NK=AD2(3) 00258730 DO 112 L=1,4 00258740 112 IIA(L)=AD2(L) 00258750 IF(NREX.GT.0)READ(30)IIA 00258760 IF(Z.NE.7)GO TO 130 00258770 NELAST=7 00258780 IF(II.EQ.1) NBLANK=NBLANK+1 00258790 WRITE(6,120)MM 00258800 120 FORMAT(/20X, 7HELEMENT,I5, 19H IS A BLANK ELEMENT/) 00258810 IF(NDYN.EQ.3) CALL RDWRT(NT3,Z,1,1,J) 00258820 DO 125 L=LT,LH 00258830 IF(IAISC.EQ.0) GO TO 1135 00258840 IF(NT.EQ.1.AND.L.EQ.1) GO TO 1120 00258850 GO TO 1130 00258860 1120 NUMBM=NUMBM+1 00258870 ND1=0 00258880 WRITE(NT1)(ND1,I=1,5),(ZERO,I=1,24) 00258890 1130 CONTINUE 00258900 WRITE(NT3)(ZERO,I=1,12) 00258910 1135 CONTINUE 00258920 IF(.NOT.GEOST) GO TO 125 00258930 ZZ=7 00258940 CALL RDWRT(NT10,ZZ,1,1,I) 00258950 125 IF(NSTR.GT.0) WRITE(NSTR,1234) L 00258960 1234 FORMAT(3X,1H1,I2,2X,2H 7,6G10.4) 00258970 GO TO 290 00258980 130 CONTINUE 00258990 NS1=SA(KOUNT-1) 00259000 ND1=SA(KOUNT-2) 00259010 NDIM=3*ND1*ND1+2+ND1 00259020 K=0 00259030 KSTR=ND1*NS1+ND1 00259040 DO 280 L=LT,LH 00259050 K=K+1 00259060 LMIN1=(L-1)*NS1+KSTR 00259070 DO 170 N=1,NS1 00259080 NPN=N+ND1 00259090 SIG(N)=SA(LMIN1+N) 00259100 DO 170 J=1,ND1 00259110 NELM=NPN+(J-1)*NS1 00259120 JJ=SA(J) 00259130 IF(JJ.LE.0) GO TO 170 00259140 160 SIG(N)=SIG(N)+SA(NELM )*D(JJ,K) 00259150 170 CONTINUE 00259160 MTYPE=Z 00259170 NTAG=1 00259180 IF(MTYPE.NE.NELAST) NTAG=0 00259190 NELAST=MTYPE 00259200 GO TO(180,190,200,210,220,230,240,250,260,265,261,261,261,267 00259210 &,268 00259220 $),MTYPE 00259230 180 CALL STRUSS 00259240 IF (.NOT.GEOST)GO TO 270 00259250 CALL RDWRT(NT2,SA,NEMN,0,KOUNT) 00259260 CALL RDWRT(NT24,SA(KOUNT),NDIM,0,KOUNT2) 00259270 ND2=ND1*ND1 00259280 KST=KOUNT+ND1-1 00259290 DO 185 I=1,ND2 00259300 185 SA(KST+I)=SIG(2)*SA(KST+I) 00259310 ND2=ND1 00259320 CALL STFGPK(ND1,ND2,SA(KOUNT),SA(KOUNT+ND2),KOUNT2) 00259330 KOUNT=KOUNT+KOUNT2-1 00259340 CALL RDWRT(NT10,SA,KOUNT,1,I) 00259350 GO TO 270 00259360 190 CONTINUE 00259370 SIG(200)=NS1 00259380 IF(IAISC.EQ.1) SIG(200)=NS1-2 00259390 IF(NCOMB.EQ.0) 00259400 1CALL SBEAM 00259410 IF(IAISC.EQ.0) GO TO 1410 00259420 DO 1180 J=1,2 00259430 NSASE=ND1+26+J 00259440 NSIGSE=0 00259450 IF(J.EQ.2) NSIGSE=12 00259460 DO 1180 I=1,12 00259470 NSA=NS1*(I-1)+NSASE 00259480 SIG(26+I+NSIGSE)=SA(NSA) 00259490 1180 CONTINUE 00259500 IF(NT.EQ.1.AND.L.EQ.1) GO TO 1200 00259510 GO TO 1400 00259520 1200 NUMBM=NUMBM+1 00259530 NII=NI 00259540 NJJ=NJ 00259550 IF(KOPT.GT.0) NII=NORD(NI) 00259560 IF(KOPT.GT.0) NJJ=NORD(NJ) 00259570 WRITE(NT1)ND1,NS1,NII,NJJ,NK,(SIG(I+26),I=1,24) 00259580 1400 CONTINUE 00259590 WRITE(NT3)(SIG(I),I=1,12) 00259600 1410 CONTINUE 00259610 IF (.NOT.GEOST)GO TO 270 00259620 CALL RDWRT(NT2,SA,NEMN,0,KOUNT) 00259630 CALL RDWRT(NT24,SA(KOUNT),NDIM,0,KOUNT2) 00259640 ND2=ND1*ND1 00259650 KST=KOUNT+ND1-1 00259660 DO 195 I=1,ND2 00259670 195 SA(KST+I)=-SIG(1)*SA(KST+I) 00259680 ND2=ND1 00259690 CALL STFGPK(ND1,ND2,SA(KOUNT),SA(KOUNT+ND2),KOUNT2) 00259700 KOUNT=KOUNT+KOUNT2-1 00259710 CALL RDWRT(NT10,SA,KOUNT,1,I) 00259720 GO TO 270 00259730 200 CALL SPLANE 00259740 IF(.NOT.GEOST) GO TO 270 00259750 CALL RDWRT(NT2,SA,NEMN,0,KOUNT) 00259760 CALL RDWRT(NT10,SA,KOUNT,1,I) 00259770 GO TO 270 00259780 210 CALL SAXIS 00259790 IF(.NOT.GEOST) GO TO 270 00259800 CALL RDWRT(NT2,SA,NEMN,0,KOUNT) 00259810 CALL RDWRT(NT10,SA,KOUNT,1,I) 00259820 GO TO 270 00259830 220 NELM=KSTR 00259840 SIG(13)=SA(NELM+4) 00259850 SIG(14)=SA(NELM+6) 00259860 SIG(15)=NS1 00259870 CALL STHRED 00259880 IF(.NOT.GEOST) GO TO 270 00259890 CALL RDWRT(NT2,SA,NEMN,0,KOUNT) 00259900 CALL RDWRT(NT10,SA,KOUNT,1,I) 00259910 GO TO 270 00259920 230 CALL SSHELL 00259930 IF(.NOT.GEOST)GO TO 270 00259940 CALL RDWRT(NT2,SA,NEMN,0,KOUNT) 00259950 CALL RDWRT(NT24,SA(KOUNT),NDIM,0,KOUNT2) 00259960 KST=KOUNT+ND1-1 00259970 ND2=ND1*ND1 00259980 DO 231 I=1,ND2 00259990 231 SA(KST+I)=+SIG(1)*SA(KST+I) 00260000 KST=KOUNT+ND1+ND2-1 00260010 DO 232 I=1,ND2 00260020 232 SA(KST+I)=+SIG(3)*SA(KST+I) 00260030 KST=KOUNT+ND1+2*ND2-1 00260040 DO 233 I=1,ND2 00260050 233 SA(KST+I)=+SIG(2)*SA(KST+I) 00260060 KST=KOUNT+ND1-1 00260070 DO 234 I=1,ND2 00260080 I1=KST+ND2 00260090 II1=KST+2*ND2 00260100 234 SA(KST+I)=SA(KST+I)+SA(I1+I)+SA(II1+I) 00260110 ND2=ND1 00260120 CALL STFGPK(ND1,ND2,SA(KOUNT),SA(KOUNT+ND2),KOUNT2) 00260130 KOUNT=KOUNT+KOUNT2-1 00260140 CALL RDWRT(NT10,SA,KOUNT,1,I) 00260150 GO TO 270 00260160 240 SIG(150)=DABS(SA(KSTR+1)) 00260170 SIG(151)=DABS(SA(KSTR+2)) 00260180 IF(NCOMB.EQ.0) 00260190 1 CALL SBOUND(NORD,NADD) 00260200 IF(IAISC.EQ.0)GO TO 1600 00260210 IF(NT.EQ.1.AND.L.EQ.1) GO TO 1500 00260220 GO TO 1550 00260230 1500 NUMBM=NUMBM+1 00260240 NII=SIG(150)*10000.0D0+.001D0 00260250 IF(SIG(150).GT.1.0) NII=SIG(151)*10000.0D0+0.001D0 00260260 IF(KOPT.GT.0) NII=NORD(NII) 00260270 NJJ=0 00260280 NK=-7 00260290 WRITE(NT1)ND,NS1,NII,NJJ,NK,(ZERO,I=1,24) 00260300 1550 CONTINUE 00260310 WRITE(NT3)(SIG(I),I=1,12) 00260320 1600 CONTINUE 00260330 IF(.NOT.GEOST) GO TO 270 00260340 CALL RDWRT(NT2,SA,NEMN,0,KOUNT) 00260350 CALL RDWRT(NT10,SA,KOUNT,1,I) 00260360 GO TO 270 00260370 250 CALL SPLANE 00260380 GO TO 270 00260390 260 CONTINUE 00260400 SIG(200)=NS1 00260410 CALL ELBSTR 00260420 IF(.NOT.GEOST) GO TO 270 00260430 CALL RDWRT(NT2,SA,NEMN,0,KOUNT) 00260440 CALL RDWRT(NT10,SA,KOUNT,1,I) 00260450 GO TO 270 00260460 261 NELM=KSTR-1 00260470 JJ=(NS1-16)/4 00260480 IF(JJ.LE.0)JJ=1 00260490 KK=NS1 00260500 DO 262 N=1,JJ 00260510 NELM=NELM+4 00260520 KK=KK+1 00260530 262 SIG(KK)=SA(NELM) 00260540 SIG(150)=NS1 00260550 IF(NS1.LE.4) GO TO 264 00260560 JJ=JJ+1 00260570 JF=NS1/4 00260580 DO 263 N=JJ,JF 00260590 NELM=NELM+4 00260600 KK=KK+1 00260610 SIG(KK)=SA(NELM) 00260620 KK=KK+1 00260630 263 SIG(KK)=SA(NELM+1) 00260640 264 SIG(151)=Z 00260650 CALL ST2D1(NORD,NADD) 00260660 IF(.NOT.GEOST) GO TO 270 00260670 CALL RDWRT(NT2,SA,NEMN,0,KOUNT) 00260680 CALL RDWRT(NT10,SA,KOUNT,1,I) 00260690 GO TO 270 00260700 265 NELM=KSTR-2 00260710 JJ=NS1/6 00260720 KK=NS1 00260730 DO 266 N=1,JJ 00260740 NELM=NELM+6 00260750 KK=KK+1 00260760 266 SIG(KK)=SA(NELM) 00260770 SIG(150)=NS1 00260780 CALL ST3D1(NORD,NADD) 00260790 GO TO 270 00260800 267 CALL SIXST1 00260810 IF(.NOT.GEOST) GO TO 270 00260820 CALL RDWRT(NT2,SA,NEMN,0,KOUNT) 00260830 CALL RDWRT(NT10,SA,KOUNT,1,I) 00260840 GO TO 270 00260850 268 CONTINUE 00260860 270 CONTINUE 00260870 280 CONTINUE 00260880 290 CONTINUE 00260890 IF(.NOT.GEOST) RETURN 00260900 NT41=41 00260910 CALL RDWRT(NT10,SA,1,6,J) 00260920 CALL RDWRT(NT41,SA,1,6,J) 00260930 NUME=NUME-NBLANK 00260940 DO 295 MM=1,NUME 00260950 CALL RDWRT(NT10,SA,NEMN,0,KOUNT) 00260960 CALL RDWRT(NT41,SA,KOUNT,1,I) 00260970 295 CONTINUE 00260980 RETURN 00260990 CC320 FORMAT (/) 00261000 C340 FORMAT(/) 00261010 END 00261020 SUBROUTINE COMBIN(A1,A2,SIG1,LL,LB) 00046500 IMPLICIT REAL*8(A-H,O-Z) 00046510 DIMENSION A1(12,1),A2(12,1),SIG1(12,1),BOUND(2) 00046520 COMMON/BMJUNK/NUMBM 00046530 COMMON/COMBLD/PCT(15,7),SINC(15),NCOMB,NB(15),LD(15,7) 00046540 COMMON /JUNK/ SIG(200),MM,L,KDU,NTAG,NDYN,NRJUNK(49) R0046550 COMMON/IOFILS/IIN,IOUT,ITAPE1,ITAPE2,ITAPE3,ITAPE4,ITAPE7,ITAPE8, 00046560 1 ITAPE0,IOC 00046570 DATA BOUND/4HBOUN,4HDARY/ 00046580 NT=(LL-1)/LB+1 00046590 IOUT=6 00046600 IIN=5 00046610 ITAPE1=1 00046620 ITAPE2=2 00046630 ITAPE3=3 00046640 ITAPE0=10 00046650 REWIND ITAPE1 00046660 REWIND ITAPE2 00046670 REWIND ITAPE3 00046680 REWIND ITAPE0 00046690 IF(NCOMB.GT.0.AND.NCOMB.LT.16) GO TO 105 00046700 IF(NCOMB.EQ.0) NCOMB=LL 00046710 IF(NCOMB.GT.15) GO TO 600 00046720 ZERO=0.0D0 00046730 DO 100 N=1,NCOMB 00046740 NB(N)=1 00046750 DO 90 L=1,7 00046760 LD(N,L)=0 00046770 90 PCT(N,L)=0.0D0 00046780 LD(N,1)=N 00046790 PCT(N,1)=1.0D0 00046800 SINC(N)=1.0D0 00046810 100 CONTINUE 00046820 105 CONTINUE 00046830 REWIND ITAPE3 00046840 MNEW=0 00046850 WRITE(6,850) 00046860 WRITE(6,860) 00046870 REWIND ITAPE1 00046880 NCT=1 00046890 DO 500 MM=1,NUMBM 00046900 NBLANK=0 00046910 READ (ITAPE1) ND,NS,NI,NJ,NK,(SIG(26+I),I=1,24) 00046920 IF(ND.EQ.0) NBLANK=7 00046930 IF(NJ.EQ.0.AND.NK.EQ.-7) NBLANK=-7 00046940 DO 110 I=1,12 00046950 DO 110 N=1,NCOMB 00046960 110 SIG1(I,N)=0.0D0 00046970 REWIND ITAPE2 00046980 NUM2=MM-2 00046990 IF(NUM2.LE.0.OR.MNEW.EQ.0) GO TO 130 00047000 DO 120 J=1,NUM2 00047010 120 READ (ITAPE2) 00047020 130 CONTINUE 00047030 LT=0 00047040 LH=0 00047050 DO 400 II=1,NT 00047060 LT=LH+1 00047070 LH=LT+LB-1 00047080 IF(LH.GT.LL) LH=LL 00047090 L1=LH-LT+1 00047100 IF(II.EQ.NT) GO TO 160 00047110 IF(MM.GT.1.AND.MNEW.EQ.1) 00047120 1READ (ITAPE2) ((A1(I,L),I=1,12),L=1,L1) 00047130 160 CONTINUE 00047140 L1=0 00047150 DO 350 L=LT,LH 00047160 L1=L1+1 00047170 IF(II.EQ.NT) GO TO 170 00047180 IF(MM.GT.1.AND.MNEW.EQ.1) GO TO 180 00047190 170 CONTINUE 00047200 READ (ITAPE3) (A1(I,L1),I=1,12) 00047210 180 CONTINUE 00047220 DO 300 N=1,NCOMB 00047230 NB1=NB(N) 00047240 DO 290 M=1,NB1 00047250 LCASE=LD(N,M) 00047260 IF(LCASE.NE.L1) GO TO 290 00047270 DO 280 I=1,12 00047280 280 SIG1(I,N)=SIG1(I,N)+A1(I,L1)*PCT(N,M) 00047290 290 CONTINUE 00047300 300 CONTINUE 00047310 350 CONTINUE 00047320 IF(II.EQ.NT) GO TO 400 00047330 IF(MNEW.EQ.1.AND.MM.GT.1) GO TO 380 00047340 MNEW=1 00047350 DO 370 J=MM,NUMBM 00047360 L1=0 00047370 DO 360 L=LT,LH 00047380 L1=L1+1 00047390 360 READ (ITAPE3) (A2(I,L1),I=1,12) 00047400 WRITE (ITAPE2) ((A2(I,L),I=1,12),L=1,L1) 00047410 370 CONTINUE 00047420 380 CONTINUE 00047430 NUM2=NUMBM-2 00047440 DO 390 J=1,NUM2 00047450 READ (ITAPE2) 00047460 390 CONTINUE 00047470 400 CONTINUE 00047480 DO 460 N=1,NCOMB 00047490 IF(NBLANK.EQ.7) GO TO 425 00047500 IF(NBLANK.EQ.-7) GO TO 426 00047510 SIG1(4,N)=SIG1(4,N)/12.0D0 00047520 SIG1(5,N)=SIG1(5,N)/12.0D0 00047530 SIG1(6,N)=SIG1(6,N)/12.0D0 00047540 SIG1(10,N)=SIG1(10,N)/12.0D0 00047550 SIG1(11,N)=SIG1(11,N)/12.0D0 00047560 SIG1(12,N)=SIG1(12,N)/12.0D0 00047570 ICT=0 00047580 IF(SIG1(1,N).GT.0.0D0) ICT=1 00047590 FAI=DABS(SIG1(1,N))/SIG(27) 00047600 FAJ=FAI 00047610 IF(SIG(47).LE.1.0D0) GO TO 410 00047620 XMI=DSQRT(SIG1(5,N)*SIG1(5,N)+SIG1(6,N)*SIG1(6,N)) 00047630 XMJ=DSQRT(SIG1(11,N)*SIG1(11,N)+SIG1(12,N)*SIG1(12,N)) 00047640 FB2I=(XMI*SIG(28))*12.0D0 00047650 FB2J=(XMJ*SIG(28))*12.0D0 00047660 FB3I=0.0D0 00047670 FB3J=0.0D0 00047680 GO TO 420 00047690 410 FB2I=(DABS(SIG1(5,N))*SIG(30))*12.0D0 00047700 FB2J=(DABS(SIG1(11,N))*SIG(30))*12.0D0 00047710 FB3I=(DABS(SIG1(6,N))*SIG(28))*12.0D0 00047720 FB3J=(DABS(SIG1(12,N))*SIG(28))*12.0D0 00047730 420 CI=FAI+FB2I+FB3I 00047740 CJ=FAJ+FB2J+FB3J 00047750 WRITE(6,870)MM,N,NI,(SIG1(I,N),I=1,6), FAI,FB2I,FB3I,CI, 00047760 1 NJ,(SIG1(I,N),I=7,12),FAJ,FB2J,FB3J,CJ 00047770 WRITE (ITAPE0)ICT,(SIG1(I,N),I=1,12) 00047780 NCT=NCT+3 00047790 GO TO 428 00047800 425 CONTINUE 00047810 IF(NBLANK.EQ.7.AND.N.EQ.1)WRITE(6,890)MM 00047820 ICT=0 00047830 WRITE (ITAPE0)ICT,(ZERO,I=1,12) 00047840 NCT=NCT+1 00047850 GO TO 428 00047860 426 CONTINUE 00047870 SIG1(2,N)=SIG1(2,N)/12.0D0 00047880 WRITE(6,900)MM,N,NI,BOUND,(SIG1(I,N),I=1,2) 00047890 ICT=0 00047900 WRITE(ITAPE0)ICT,(SIG1(I,N),I=1,12) 00047910 NCT=NCT+2 00047920 428 CONTINUE 00047930 IF(NCT-54)460,430,430 00047940 430 NCT=0 00047950 WRITE(6,850) 00047960 IF(N.EQ.NCOMB) GO TO 460 00047970 WRITE(6,860) 00047980 NCT=NCT+1 00047990 460 CONTINUE 00048000 WRITE(6,860) 00048010 NCT=NCT+1 00048020 500 CONTINUE 00048030 RETURN 00048040 600 WRITE(6,870)NCOMB 00048050 STOP 00048060 850 FORMAT(1X ,4X,33HBEAM FORCES, MOMENTS AND STRESSES,//,5X, 00048070 1 58HBEAM LOAD JOINT AXIAL SHEAR SHEAR TORSION, 00048080 2 5X,52HBENDING BENDING AX STR BEND STR BEND STR,3X, 00048090 3 8HCOMB STR,/,6X,35HNO NO NO RI(K) R2(K),5X, 00048100 4 52HR3(K) MI(F-K) M2(F-K) M3(F-K) RI(KSI),4X, 00048110 5 28HM2(KSI) M3(KSI) (KSI)) 00048120 860 FORMAT(1X) 00048130 870 FORMAT(2X,2I6,I7,3F10.3,3F12.2,3F11.2,F10.2,/,14X,I7,3F10.3, 00048140 1 3F12.2,3F11.2,F10.2,/) 00048150 880 FORMAT(5X,49H*** ERROR *** ONLY 15 VALUES OF NCOMB ARE ALLOWED, 00048160 1 34H NCOMB IN YOUR DATA HAS A VALUE OF,I5) 00048170 890 FORMAT(2X,I6,20X,13HBLANK ELEMENT) 00048180 900 FORMAT(2X,2I6,I7,2X,2A4,10X,F10.3,24X,F12.2/) 00048190 END 00048200 FUNCTION COMPNT(IG,II1,IC,IDEG,IW,ICC,NN) 00048210 IMPLICIT REAL*8(A-H,O-Z) 00048220 INTEGER*2 IC,IDEG,IW,ICC 00048230 INTEGER*2 IG 00048240 DIMENSION IG(II1,1),IC(1),IDEG(1),IW(1),ICC(1) 00048250 DO 100 I=1,NN 00048260 ICC(I)=0 00048270 IC(I)=0 00048280 100 CONTINUE 00048290 NC=0 00048300 ICC(1)=1 00048310 110 DO 120 I=1,NN 00048320 IF(IC(I)) 120,130,120 00048330 120 COMPNT=NC 00048340 RETURN 00048350 130 NC=NC+1 00048360 KI=0 00048370 KO=1 00048380 IW(1)=I 00048390 IC(I)=NC 00048400 IF(NC-1)150,140,140 00048410 140 IS=ICC(NC)+1 00048420 ICC(NC+1)=IS 00048430 150 KI=KI+1 00048440 II=IW(KI) 00048450 N=IDEG(II) 00048460 IF(N)160,110,160 00048470 160 DO 180 I=1,N 00048480 IA = IG(II,I) 00048490 IF(IC(IA)) 180,170,180 00048500 170 IC(IA)=NC 00048510 KO=KO+1 00048520 IW(KO)=IA 00048530 IS=ICC(NC+1)+1 00048540 ICC(NC+1)=IS 00048550 180 CONTINUE 00048560 IF(KO-KI)110,110,150 00048570 END 00048580 SUBROUTINE AISC(NUME) 00014300 DOUBLE PRECISION A,SM2,SM3,VQIB2,VQIB3,DP,BF,TF,TW,DIAM,WALL,R2, 00014310 1 R3,EBM,RED,FY,XK,YK,DL,FATEN,FASHR,FACOM,FB2,FB3,PSI,SHR,COMB,00014320 2 AXR,BEND2,BEND3,P,S2I,S3I,S2J,S3J,XM2I,XM3I,XM2J,XM3J,TYPE, 00014330 3 PI,XLR2,XLR3,XLR,CC,RTL,FE2,FE3,XINER,AWC,DT257,FY6,AF,C,S76, 00014340 4 FB4,AFC,SQFY,S20,BT,T1,BT65,C102,DT,AW,BT95,C510,FB5,B,TI,XX, 00014350 5 DT1,ROD,CID,DT2,RID,DTA,AOD,AID,COD,ST,BTT,SS,DTT,BT190,BTS, 00014360 6 BT238,DTS,FS,T2,CM3T3,XFB2I,COMB2J,XFB3JB,T3,SH2I,XFB3I,TJ, 00014370 7 XFAFA,CM2,SH2J,XFB2J,COMB1I,XFB2IB,CM3,SH3I,XFB3J,COMB2I, 00014380 8 XFB3IB,CM2T2,SH3J,XFA,COMB1J,XFB2JB,TEMP,FLG,XINC, 00014390 9 XINER2,XINER3 00014400 DOUBLE PRECISION BZ,TZ,DDL,SHRM,COMBM,AXRM,BEND2M,BEND3M,FFLG 00014410 1,SIG,PCT,SINC 00014420 DIMENSION 00014430 1 ZA(6) 00014440 COMMON/BMDATA/IAISC,ILDTYP,ILDMUL,IBMSEC,NLWAVE,ILOCAL 00014450 COMMON /EM/ LM(24),ND,NS,BZ(24,24),TZ(24,4) 00014460 COMMON/COMBLD/PCT(15,7),SINC(15),NCOMB,NB(15),LD(15,7) 00014470 COMMON/STEEL/A,SM2,SM3,VQIB2,VQIB3,DP,BF,TF,TW,DIAM,WALL,R2,R3, 00014480 1 EBM,RED,FY,XK,YK,DL,FATEN,FASHR,FACOM,FB2,FB3,PSI,SHR,COMB, 00014490 2 AXR,BEND2,BEND3,P,S2I,S3I,S2J,S3J,XM2I,XM3I,XM2J,XM3J, 00014500 3 TYPE,PI,XLR2,XLR3,XLR,CC,RTL,FE2,FE3,XINER,AWC,DT257,FY6,AF, 00014510 4 C,S76,FB4,AFC,SQFY,S20,BT,T1,BT65,C102,DT,AW,BT95,C510,FB5, 00014520 5 B,TI,XX,DT1,ROD,CID,DT2,RID,DTA,AOD,AID,COD,ST,BTT,SS,DTT, 00014530 6 BT190,BTS,BT238,DTS,FS,T2,CM3T3,XFB2I,COMB2J,XFB3JB,T3,SH2I, 00014540 7 XFB3I,TJ,XFAFA,CM2,SH2J,XFB2J,COMB1I,XFB2IB,CM3,SH3I,XFB3J, 00014550 8 COMB2I,XFB3IB,CM2T2,SH3J,XFA,COMB1J,XFB2JB,TEMP,FLG,XINC, 00014560 9 XINER2,XINER3,ICT,KATX,KATY 00014570 COMMON/IOFILS/IIN,IOUT,ITAPE1,ITAPE2,ITAPE3,ITAPE4,ITAPE7,ITAPE8, 00014580 1 ITAPE0,IOC 00014590 COMMON /JUNK/ SIG(200),M,LL,KDU,NTAG,NDYN,NRJUNK(49) R0014600 2000 FORMAT(1X ,11X,37HMEMBER CHECK IN ACCORDANCE WITH AISC , 00014610 1 14HSPECIFICATIONS,//,12X, 00014620 2 35HIF COMB= 6.6666 - CHECK SHEAR RATIO,/,12X, 00014630 3 40HIF COMB= 7.7777 - HIGH B/T OR D/T RATIOS,/,12X, 00014640 4 39HIF COMB= 8.8888 - KL/R GREATER THAN 200,/,12X, 00014650 5 46HIF COMB= 9.9999 - AXIAL STRESS GREATER THAN FE,//,12X, 00014660 6 57HMBR JT JT TYPE YIELD LENGTH CATA LY K(2), 00014670 7 4X,47HK(3) LOAD SHEAR AXIAL BEND 2 BEND 3,5X, 00014680 8 4HCOMB,/,12X,36HNUM I J STRESS (FT),2X, 00014690 9 6H(2)(3),2X, 00014700 A 4H(FT),17X,41HCASE RATIO RATIO RATIO RATIO,5X, 00014710 B 5HRATIO) 00014720 2001 FORMAT(/,9X,3I6,I5,F8.1,F9.2,2I3,2F7.2,F8.2,I5,F11.4,3F9.4,F10.4) 00014730 2002 FORMAT(77X,I5,F11.4,3F9.4,F10.4) 00014740 2050 FORMAT(1X ,11X,47HAISC MEMBER CHECK SUMMARY - CRITICAL LOAD CASES,00014750 1 //,12X,36HIF COMB = 6.6666 - CHECK SHEAR RATIO, 00014760 2 /,12X,41HIF COMB = 7.7777 - HIGH B/T OR D/T RATIOS, 00014770 3 /,12X,40HIF COMB = 8.8888 - KL/R GREATER THAN 200, 00014780 4 /,12X,47HIF COMB = 9.9999 - AXIAL STRESS GREATER THAN FE, 00014790 5 //,14X,49HMBR JT JT LOAD SHEAR AXIAL BEND 2, 00014800 6 4X,15HBEND 3 COMB,/,14X,3HNUM,5X,1HI,5X,1HJ,2X,4HCASE, 00014810 7 3X,5HRATIO,5X,5HRATIO,5X,5HRATIO,5X,5HRATIO,5X,5HRATIO) 00014820 2051 FORMAT(/,12X,I5,2I6,I5,F9.4,4F10.4) 00014830 2060 FORMAT(1X ,10X) 00014840 PI=3.1415927D0 00014850 IP=0 00014860 NLC=NCOMB 00014870 IPC=51/(NLC+1) 00014880 WRITE(IOUT,2000) 00014890 IMBRCK=0 00014900 REWIND ITAPE1 00014910 REWIND ITAPE3 00014920 REWIND ITAPE0 00014930 DO 8000 M=1,NUME 00014940 READ (ITAPE1)ND,NS,NI,NJ,NK,(SIG(I+26),I=1,24) 00014950 A=SIG(27) 00014960 IZERO=0 00014970 IF(SIG(28).EQ.0.0)GO TO 50 00014980 SM3=1.0D0/SIG(28) 00014990 GO TO 55 00015000 50 SM3=SIG(28) 00015010 IZERO=1 00015020 55 IF(SIG(30).EQ.0.0) GO TO 60 00015030 SM2=1.0D0/SIG(30) 00015040 GO TO 65 00015050 60 SM2=SIG(30) 00015060 IZERO=1 00015070 65 CONTINUE 00015080 XINER2=SIG(32) 00015090 XINER3=SIG(33) 00015100 VQIB3=SIG(34) 00015110 VQIB2=SIG(35) 00015120 DL=SIG(36) 00015130 EBM=SIG(37) 00015140 FY=SIG(38) 00015150 DP=SIG(39) 00015160 BF=SIG(40) 00015170 TW=SIG(41) 00015180 TF=SIG(42) 00015190 XK=SIG(43) 00015200 YK=SIG(44) 00015210 ITYPE=SIG(45) 00015220 NCHECK=SIG(46) 00015230 IF(IZERO.EQ.1) NCHECK=0 00015240 ICOP=SIG(47) 00015250 TYPE=ICOP 00015260 FLG=SIG(48) 00015270 KATX=SIG(49) 00015280 KATY=SIG(50) 00015290 IF(NCHECK.LE.0)GO TO 160 00015300 IMBRCK=IMBRCK+1 00015310 SQFY=DSQRT(FY) 00015320 FY6=.6D0*FY 00015330 DDL=DL/12.0D0 00015340 FFLG=FLG/12.0D0 00015350 DIAM=DP 00015360 WALL=BF 00015370 IF(TYPE-1.0D0)100,101,102 00015380 100 CALL WIDEF 00015390 GO TO 150 00015400 101 CALL TUBE 00015410 GO TO 150 00015420 102 CALL PIPE 00015430 150 CALL ALLFA 00015440 LMX=0 00015450 SHRM=0.0D0 00015460 AXRM=0.0D0 00015470 BEND2M=0.0D0 00015480 BEND3M=0.0D0 00015490 COMBM=0.0D0 00015500 160 DO 800 L=1,NCOMB 00015510 XINC=SINC(L) 00015520 READ(ITAPE0)ICT,(SIG(I),I=1,12) 00015530 IF(NCHECK.LE.0)GO TO 800 00015540 P =SIG(1) 00015550 S2I =SIG(2) 00015560 S3I =SIG(3) 00015570 XM2I=SIG(5) 00015580 XM3I=SIG(6) 00015590 S2J=SIG(8) 00015600 S3J=SIG(9) 00015610 XM2J=SIG(11) 00015620 XM3J=SIG(12) 00015630 CALL RATIO 00015640 IF(XLR.GT.200.0D0)COMB=8.8888D0 00015650 IF(FB2.LE.1.0D0.OR.FB3.LE.1.0D0)COMB=7.7777D0 00015660 IF(SHR.GT.1.0D0)COMB=6.6666D0 00015670 IF(COMB-COMBM)500,500,501 00015680 501 LMX=L 00015690 SHRM=SHR 00015700 AXRM=AXR 00015710 BEND2M=BEND2 00015720 BEND3M=BEND3 00015730 COMBM=COMB 00015740 ITYPE=TYPE 00015750 500 IF(L-1)300,300,301 00015760 300 WRITE(IOUT,2001)M,NI,NJ,ITYPE,FY,DDL,KATX,KATY,FFLG,XK,YK,L,SHR, 00015770 1 AXR,BEND2,BEND3,COMB 00015780 GO TO 302 00015790 301 WRITE(IOUT,2002)L,SHR,AXR,BEND2,BEND3,COMB 00015800 302 CONTINUE 00015810 800 CONTINUE 00015820 IF(NCHECK.LE.0)GO TO 8000 00015830 IF(NCOMB.GT.1)WRITE(ITAPE2)M,NI,NJ,LMX,SHRM,AXRM,BEND2M,BEND3M, 00015840 1 COMBM 00015850 IP=IP+1 00015860 IF(IP-IPC)8000,400,400 00015870 400 WRITE(IOUT,2000) 00015880 IP=0 00015890 8000 CONTINUE 00015900 IF(IMBRCK.EQ.0) GO TO 600 00015910 IF(NCOMB.EQ.1)GO TO 600 00015920 IP=0 00015930 REWIND ITAPE2 00015940 WRITE(IOUT,2050) 00015950 DO 8050 J=1,IMBRCK 00015960 READ(ITAPE2)M,NI,NJ,LMX,SHRM,AXRM,BEND2M,BEND3M,COMBM 00015970 WRITE(IOUT,2051)M,NI,NJ,LMX,SHRM,AXRM,BEND2M,BEND3M,COMBM 00015980 IP=IP+1 00015990 IF(IP-25)8050,8051,8051 00016000 8051 IP=0 00016010 WRITE(IOUT,2050) 00016020 8050 CONTINUE 00016030 600 CONTINUE 00016040 WRITE(IOUT,2060) 00016050 RETURN 00016060 END 00016070 00016080 00016090 SUBROUTINE MODES 00149790 IMPLICIT REAL*8(A-H,O-Z) 00149800 REAL*8 NPAR 00149810 COMMON / MISC / NBLOCK,NEQB,LL,NF,LB 00149820 COMMON /ELPAR/ NPAR(14),NUMNP,MBAND,NELTYP,N1,N2,N3,N4,N5,MTOT,NEQ00149830 & ,RRELPA(24) R0149831 COMMON /OUT/IDUMM(4),IOSIG,IODISP,NROUT(4) R0149840 COMMON /HEADIN/TITLE1(20),TITLE2(5),TITLE3(10) 00149850 DIMENSION T(3) 00149860 COMMON A(1) 00149870 CALL FILES(14) 00149880 CALL SECOND (T(1)) 00149890 N2=N1+NF 00149900 N3=N2+LL*NF 00149910 N4=N3+LL*LL 00149920 N5=N4+LL*LL 00149930 N6=N5+LL*LL 00149940 N7=N6+NEQB 00149950 N8=N7+NEQB*LL 00149960 N9=N8+NEQB*LL 00149970 IF(N9.GT.MTOT) CALL ERROR(N9-MTOT) 00149980 CALL 00149990 $ MDYNAM(A(N1),A(N2),A(N3),A(N4),A(N5),A(N6),A(N7),A(N8),A(N8), 00150000 $ NEQB,LL,NBLOCK,NF) 00150010 CALL SECOND (T(2)) 00150020 N2=N1+3*NUMNP 00150030 N3=N2+6*NF 00150040 IF(IODISP.EQ.1) CALL FCOPY(L5TP6,L6TP50) 00150050 IF(IODISP.EQ.1) TITHOL=TITLE3(3) 00150060 CALL MPRNTD (A(N1),A(N2),A(N3),NEQB,NUMNP,NF,NBLOCK,NEQ,10,NF, 00150070 $A(1)) 00150080 IF(IODISP.EQ.1) WRITE(6,240) 00150090 IF(IODISP.EQ.1) WRITE(6,200) 00150100 IF(IODISP.EQ.1) TITLE3(3)= TITHOL 00150110 CALL SECOND (T(3)) 00150120 T(1)=T(2)-T(1) 00150130 T(2)=T(3)-T(2) 00150140 WRITE (6,100) T(1),T(2) 00150150 NPAR(1)=T(1)+T(2) 00150160 RETURN 00150170 100 FORMAT(27H1....TIME LOG (CPU MINUTS) /// R0150180 $ 33H MODE SHAPES AND FREQUENCIES... ,F8.2 // 00150190 $ 33H PRINT MODE SHAPES............. ,F8.2 // ) 00150200 200 FORMAT(///20X,32(1H')/20X,32HMODE SHAPES WILL NOT BE PRINTED./20X,00150210 1 31(1H')//) 00150220 240 FORMAT (/) 00150230 END 00150240 SUBROUTINE MDYNAM(W,V,G,S,VV,XM,A,P,FI,NEQB,NS,NBLOCK,NF) 00134680 IMPLICIT REAL*8(A-H,O-Z) 00134690 DIMENSION G(NS,NS),S(NS,NS),VV(NS,NS),V(NS,NF),XM(NEQB), 00134700 $ A(NEQB,NS),W(NF),P(NEQB,NS),FI(NEQB,NF) 00134710 COMMON / JUNK / FIJ,I,IH,J,K,N,NR,TEMP,TPI,WMIN,XX,RRJUNK(219) R0134720 TPI=6.2831853 00134730 DO 100 I=1,NS 00134740 DO 100 J=1,NS 00134750 G(I,J)=0.0 00134760 100 S(I,J)=0.0 00134770 REWIND 9 00134780 REWIND 10 00134790 L2RC=NEQB*NS*4 00134800 DO 110 N=1,NBLOCK 00134810 BACKSPACE 2 00134820 READ (2) A 00134830 BACKSPACE 2 00134840 READ (9) XM,P 00134850 DO 110 I=1,NS 00134860 DO 110 J=1,NS 00134870 DO 110 K=1,NEQB 00134880 G(I,J)=G(I,J)+A(K,I)*XM(K)*A(K,J) 00134890 110 S(I,J)=S(I,J)+A(K,I)*P(K,J) 00134900 CALL MPRMAT(G,NS,NS,NS,16HGENERAL MASS ) R0134910 CALL MPRMAT(S,NS,NS,NS,16HGENERAL STIFF ) R0134920 CALL MHDIAG(G,NS,0,VV,NR,P,V) 00134930 DO 130 J=1,NS 00134940 IF (G(J,J).LT.0.0) WRITE(6,120) J,G(J,J) 00134950 120 FORMAT (//20X,4H THE,I5,36HTHE DIAGONAL TERM OF THE MASS MATRIX, 00134960 116H WAS FOUND TO BE,1X,E14.6,1H,/ 00134970 $20X,38HIT WAS CHANGED TO A SMALL POSITIVE NO.///) 00134980 IF (G(J,J).LT.0.0) G(J,J)=1.0 E-33 00134990 XX= DSQRT(G(J,J)) 00135000 DO 130 I=1,NS 00135010 130 VV(I,J)=VV(I,J)/XX 00135020 DO 140 I=1,NS 00135030 DO 140 J=1,NS 00135040 G(I,J)=0.0 00135050 DO 140 K=1,NS 00135060 140 G(I,J)=G(I,J)+S(I,K)*VV(K,J) 00135070 DO 150 I=1,NS 00135080 DO 150 J=1,NS 00135090 S(I,J)=0.0 00135100 DO 150 K=1,NS 00135110 150 S(I,J)=S(I,J)+VV(K,I)*G(K,J) 00135120 CALL MHDIAG(S,NS,0,G,NR,P,V) 00135130 DO 190 I=1,NF 00135140 WMIN=S(I,I) 00135150 K=I 00135160 DO 170 J=I,NS 00135170 IF(WMIN.LT.S(J,J)) GO TO 170 00135180 160 K=J 00135190 WMIN=S(J,J) 00135200 170 CONTINUE 00135210 S(K,K)=S(I,I) 00135220 S(I,I)=WMIN 00135230 DO 180 J=1,NS 00135240 TEMP=G(J,I) 00135250 G(J,I)=G(J,K) 00135260 180 G(J,K)=TEMP 00135270 W(I)= DSQRT(S(I,I)) 00135280 190 CONTINUE 00135290 DO 200 I=1,NS 00135300 DO 200 J=1,NF 00135310 V(I,J)=0. 00135320 DO 200 K=1,NS 00135330 200 V(I,J)=VV(I,K)*G(K,J)+V(I,J) 00135340 WRITE (10) W 00135350 DO 240 I=1,NF,6 00135360 IH=I+5 00135370 IF(IH.GT.NF) IH=NF 00135380 WRITE (6,280) (N,N=I,IH) 00135390 WRITE (6,290) (W(N),N=I,IH) 00135400 DO 210 N=I,IH 00135410 210 W(N)=W(N)/TPI 00135420 WRITE(6,330) (W(N),N=I,IH) 00135430 DO 220 N=I,IH 00135440 220 W(N)=1.0/W(N) 00135450 WRITE (6,310) (W(N),N=I,IH) 00135460 WRITE (6,300) 00135470 DO 230 J=1,NS 00135480 230 WRITE (6,320) J,(V(J,N),N=I,IH) 00135490 240 CONTINUE 00135500 REWIND 2 00135510 DO 270 N=1,NBLOCK 00135520 READ (2) A 00135530 DO 260 I=1,NEQB 00135540 DO 260 J=1,NF 00135550 FIJ=0. 00135560 DO 250 K=1,NS 00135570 250 FIJ=FIJ + A(I,K)*V(K,J) 00135580 260 FI(I,J)=FIJ 00135590 270 WRITE (10) FI 00135600 RETURN 00135610 280 FORMAT (12H1MODE NUMBER,6I14) 00135620 290 FORMAT (12H0FREQUENCIES,1P6E14.3) 00135630 300 FORMAT (41H0 MODE SHAPES (GENERALIZED DISPLACEMENTS)) 00135640 310 FORMAT (12H0PERIOD ,1P6E14.3) 00135650 320 FORMAT (I12,6F14.4) 00135660 330 FORMAT (1X,3HCPS,8X,1P6E14.3) 00135670 END 00135680 SUBROUTINE MPRNTD(ID,D,B,NEQB,NUMNP,LL,NBLOCK,NEQ,NT,NF,DIS) 00150960 IMPLICIT REAL*8(A-H,O-Z) 00150970 REAL*8 ID 00150980 COMMON/PREP/XMX,XAD,KSKIP,NDYN,I1,RRPREP(7) R0150990 COMMON /OUT/NRES,NSTR,NDIS,NROUT(7) R0151000 DIMENSION DIS(10,LL) 00151010 COMMON /QTSARG/ NEQ3(10),RRQTSA(995) R0151020 COMMON /GPS/ NEQ4(10),NRGPS(10) R0151030 COMMON /ELPAR/ XPAR(14),NDUM(8),MTOT,NRELPA(49) R0151040 COMMON A(1) 00151050 DIMENSION ID(NUMNP,3),B(NEQB,LL),D(6,LL) 00151060 IF(NDIS.LT.0) RETURN 00151070 REWIND NT 00151080 IF(NF.GT.0) READ (NT) 00151090 REWIND 8 00151100 READ (8) ID 00151110 REWIND 17 00151120 REWIND 18 00151130 NDPBLK=(MTOT-(16*LL)-NUMNP)/(6*LL) 00151140 NBLK= (NUMNP-1)/NDPBLK+1 00151150 KK=1 00151160 IF(NDIS.GT.0) WRITE (NDIS,200) KK,LL 00151170 M=NEQ 00151180 NN=NEQB*NBLOCK 00151190 IF(NF.EQ.0) WRITE (6,220) 00151200 IF(NF.GT.0) WRITE (6,240) 00151210 N=NUMNP 00151220 DO 100 I=1,10 00151230 100 NEQ3(I)=0 00151240 DO 210 KK=1,NUMNP 00151250 I=6 00151260 DO 190 II=1,6 00151270 DO 110 L=1,LL 00151280 110 D(I,L)=0. 00151290 IF(M.GT.NN) GO TO 120 00151300 IF (M.EQ.0) GO TO 120 00151310 READ (NT) B 00151320 NN=NN-NEQB 00151330 K=M-NN 00151340 ND=0 00151350 120 CALL UNPKID ( ID ,NUMNP,W ,WX ,2,N,I) 00151360 NNN=W 00151370 IF(NNN.LT.1) GO TO 190 00151380 K=M-NN 00151390 KI=0 00151400 DO 130 L=1,10 00151410 IF(NNN.EQ.NEQ4(L)) KI=L 00151420 130 CONTINUE 00151430 IF(KI.EQ.0) GO TO 160 00151440 IF(NEQ3(KI).GT.0) GO TO 140 00151450 K=K-M+NNN 00151460 IF(K.LT.0) GO TO 140 00151470 NEQ3(KI)=1 00151480 IF(NNN.EQ.M) M=M-1 00151490 GO TO 170 00151500 140 DO 150 L=1,LL 00151510 150 D(I,L)=DIS(KI,L) 00151520 IF(NNN.EQ.M) M=M-1 00151530 GO TO 190 00151540 160 CONTINUE 00151550 M=M-1 00151560 170 KND=K-ND 00151570 DO 180 L=1,LL 00151580 IF(KI.EQ.0) GO TO 180 00151590 DIS(KI,L)=B(KND,L) 00151600 180 D(I,L)=B(KND,L) 00151610 190 I=I-1 00151620 200 FORMAT (2I5) 00151630 WRITE (18) D 00151640 210 N=N-1 00151650 K=1+10*LL 00151660 N2=K+NUMNP 00151670 N3=N2+6*LL 00151680 N4=N3+6*LL*NDPBLK 00151690 CALL WRDIS2(A(K),A(N2),A(N3),NUMNP,LL,NDPBLK,NDIS,NBLK) 00151700 RETURN 00151710 220 FORMAT (40H1.......NODE DISPLACEMENTS AND ROTATIONS// 00151720 $ 5H NODE, 5H LOAD, 11X, 1HX, 11X, 1HY, 11X, 1HZ, 9X ,2HXX, 00151730 $ 9X, 2HYY, 9X, 2HZZ) 00151740 230 FORMAT (1H0,I4,I5,1P3E12.3,3E11.2/(I10,3E12.3,3E11.2)) 00151750 240 FORMAT (19H1.......MODE SHAPES // 00151760 $ 5H0NODE, 5H MODE, 11X, 1HX, 11X, 1HY, 11X, 1HZ ,9X ,2HXX, 00151770 $ 9X, 2HYY, 9X, 2HZZ) 00151780 250 FORMAT (I10,7E10.4/(8E10.4)) 00151790 END 00151800