Liren Large Software Subsidy 9

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

/ Liren Large Software Subsidy 9 / 09.iso / e / e003 / 9.ddi / SAP6PC5.FOR < prev

Wrap

Text File | 1987-06-23 | 101.9 KB | 1,280 lines

PROGRAM SAP6P5 R0001101 IMPLICIT REAL*8(A-H,O-Z) 00001100 LOGICAL ELPRT,ELPCH,GENPRT,GENPCH,DEFPCH,GEOST 00001110 COMMON/BMDATA/IAISC,ILDTYP,ILDMUL,IBMSEC,NLWAVE,ILOCAL 00001120 COMMON/EQUILB/NEQIL,NX43 00001130 COMMON/CTL/ELPRT,ELPCH,GENPRT,GENPCH 00001140 COMMON / JUNK / DUK(227) 00001150 REAL*8 NPAR 00001160 COMMON /QTSARG/ QQQ(1000) 00001170 COMMON/DYN3/ NEIG,NAD,ANORM,NVV,NFO 00001180 COMMON /DYN4/KDYN,NRESS,NCRD,NCWT,NRESS1 00001190 COMMON /DYN5/FRSHFT,FRINIT,FREND,MODEFR,NOSS 00001200 COMMON /TAPES/NSTIF,NRED,NL,NR,NT,NMASS 00001210 COMMON /EXTRA/MODEX,NT8,N10SV,NT10,KEQB,NY,T(10) 00001220 COMMON/GEOSTF/GEOST,NELGEO 00001230 COMMON/MASS/LMASS 00001240 COMMON/MATL/MATLCO R0001241 COMMON/SIZE/NDMX,MXDF,NSMX,NTERM,NADND 00001250 COMMON/SLVE/NSLAVE 00001260 COMMON /ELPAR/ NPAR(14),NUMNP,MBAND,NELTYP,N1,N2,N3,N4,N5,MTOT,NEQ00001270 $ ,N2P,N3P,NMRI,NTRI,N1P,NUMEL,NUMEL2,KZ(20,2),NEMN 00001280 COMMON / MISC / NBLOCK,NEQB,LL,NFREQ,LB 00001290 COMMON/AMB/ GRAV,REFT,JROT 00001300 COMMON /PREP/ XMX,XAD,KSKIP,NDYN,I1,I99,POS,PRTCOD 00001310 $ ,POSSAV,PRTOFF,PRTON,PRTDUM,IDIRC 00001320 COMMON /DYN/ IFIL1(11),IFIL2 00001330 COMMON/ELARRY/NELAR(4,20) 00001340 COMMON /ELTEMP/ SET1(103) 00001350 $ /OUT/KSET2(6),KELRST,MAXDF,IFIL3(2) 00001360 $ /SQZ/ SET3,LIST,LISTC,LISTB,LISTA 00001370 $ /TRASH/ SET4(490) 00001380 $ /GPS/ SET5(10) 00001390 $ /CG/ SET6(4),RFIL1(2) 00001400 $ /TAPES/ SET7(6) 00001410 $ /DYN2/KSET8(3),NFVC,SET8(12) 00001420 COMMON /WORDS/ NWDS(30,2) 00001430 COMMON /BAND/ NRNM(3),IRSK,IFIL4(4) 00001440 COMMON /HEADIN/TITLE1(20),TITLE2(5),TITLE3(10) 00001450 COMMON /SUPEL/ NSELEM,NEQL,NODESE 00001460 $,KSET(3) 00001470 COMMON/FORCE/ NLC,NELD 00001480 COMMON/DAPG/NQ1,NQX,DUMY(210) 00001490 COMMON/VAXPLT/IVPLT,XVB(6),XVA(4),MINX,MINY,LEN 00001500 COMMON /ICM/ICOMP,MMRI,MTRI,M1P,M2P,M3P 00001510 COMMON/PLOTH/IPLT,IPLWRT 00001520 COMMON/COMMT/NTYP,NNRRC,NNRRC1 R0001521 COMMON/COMMT1/NDSSS,KDSSS,NTY,NSLDM,NBLANK,MDYN,NE2B,KRK1,MCB,MLT R0001522 DIMENSION KZN(20),ZD(31) 00001530 DIMENSION NEXPDT(2),NOWDTE(4) 00001540 COMMON A(1) 00001550 DATA KZN/2,7,1,2,7,7,10,7,21,1177,6,51,10,21,9,7,8,5,0,0/ 00001560 DATA NEXPDT/78,222/ 00001570 WRITE (*,990) R0001611 990 FORMAT (5X,'********** PROGRAM SAP6PC5 STARTING *********') R0001612 CALL SIZER5 R0001612 MTOTR = MTOT R0001613 CALL COMMRW(1) R0001612 MTOT = MTOTR R0001613 WRITE (6,1099) MTOT 1099 FORMAT (5X,'**** MTOT IN SAP6PC5 ****',3X,I5/) IF (NNRRC .EQ. 330) GO TO 330 R0001613 IF (NDYN .GT. 11) GO TO 330 R0001614 IF (NDYN .EQ. 8) GO TO 330 R0001617 IF (MDYN .EQ. 5) GO TO 350 R0001621 IF (MDYN .EQ. 6) GO TO 360 R0001622 IF (MDYN .EQ. 7 .OR. MDYN .EQ. 13) GO TO 410 R0001623 IF (MDYN .EQ. 8) GO TO 460 R0001634 IF (NDYN .LE.1 .AND. KSKIP .EQ. 1) GO TO 330 R0001635 IF (NDYN .NE. 11 .AND. NELGEO .NE. 1) GO TO 1410 R0001636 CALL ADDGEO(A(N1),A(NN2),A(NN3),A(NN4),A(NN5),A(NN6),NUMET,NBLOCK,00006140 $NE2B,LL,MBAND,NEQB,NEMN,ANORM,NVV,MGA) 00006150 CALL SECOND(T(8)) 00006160 TT1=T(5) 00006170 TT2=T(8) 00006180 DO 1340 I=5,7 00006190 1340 T(I)=T(I+1)-T(I) 00006200 T(8)=T(5)+T(6)+T(7) 00006210 WRITE(6,560)(T(I),I=5,8) 00006220 T(5)=TT1 00006230 T(6)=TT2 00006240 IF(NDYN.GT.3.AND.NDYN.LT.7) GO TO 1360 00006250 LMASS=1 00006260 NMASS=25 00006270 GO TO 355 00006280 1360 CONTINUE 00006290 IF(NDYN.EQ.4) GO TO 355 00006300 IF(NDYN.EQ.5) GO TO 365 00006310 IF(NDYN.EQ.6) GO TO 415 00006320 1410 CONTINUE 00006330 IF(NDYN.EQ.2) CALL HISTRY 00006340 IF(NDYN.EQ.3) CALL RESPEC 00006350 IF(NDYN.EQ.10) CALL PASS 00006360 330 CALL SECOND (T(7)) 00006370 DO 340 I=1,6 00006380 340 T(I)=T(I+1)-T(I) 00006390 T(7)=T(1)+T(2)+T(3)+T(4)+T(5)+T(6) 00006400 WRITE(6,520)(T(I),I=1,7) 00006410 GO TO 500 00006420 350 T(6) = T(5) 00006430 355 CONTINUE 00006440 IF(KSKIP.EQ.0) CALL EIGEN 00006450 CALL SECOND (T(7)) 00006460 T(8) = T(7) 00006470 T(9) = T(7) 00006480 T(10)= T(7) 00006490 GO TO 480 00006500 360 T(6) = T(5) 00006510 365 CONTINUE 00006520 IF(KDYN.LT.0) GO TO 370 00006530 CALL EIGEN 00006540 CALL SECOND (T(7)) 00006550 KSKIP=MODEX 00006560 GO TO 400 00006570 370 DO 380 I=1,6 00006580 380 T(I+1)=T(I) 00006590 IF(NRESS.EQ.0) REWIND NCRD 00006600 READ(NCRD)NEQ,NBLOCK,NEQB,MBAND,N1,NF,(QQQ(I),I=1,NF) 00006610 NWW=NEQB*NF 00006620 CALL RDWRT(NCRD,A(N1),NF,14,I) 00006630 CALL RDWRT(NT,A(N1),NF,6,I) 00006640 CALL RDWRT(NT,A(N1),NF,13,I) 00006650 DO 390 L=1,NBLOCK 00006660 CALL RDWRT(NCRD,A(N1),NWW,14,I) 00006670 CALL RDWRT(NT,A(N1),NWW,13,I) 00006680 390 CONTINUE 00006690 WRITE(6,395)NCRD,NF 00006700 395 FORMAT(55H A PREVIOUSLY GENERATED EIGEN-SOLUTIONS HAVE BEEN READ,00006710 $8HOFF TAPE/ 00006720 $ 13H UNIT NUMBER=,I5/ 00006730 $ 30H NUMBER OF FREQUENCIES FOUND=,I5//) 00006740 400 CALL HISTRY 00006750 MODEX=KSKIP 00006760 CALL SECOND (T(8)) 00006770 T(9) = T(8) 00006780 T(10)= T(8) 00006790 GO TO 480 00006800 410 T(6) = T(5) 00006810 415 CONTINUE 00006820 IF(KDYN.LT.0) GO TO 420 00006830 IF(KSKIP.EQ.0) CALL EIGEN 00006840 CALL SECOND (T(7)) 00006850 T(8) = T(7) 00006860 KSKIP=MODEX 00006870 GO TO 450 00006880 420 DO 430 I=1,7 00006890 430 T(I+1)=T(I) 00006900 IF(NRESS.EQ.0) REWIND NCRD 00006910 READ(NCRD)NEQ,NBLOCK,NEQB,MBAND,N1,NF,(QQQ(I),I=1,NF) 00006920 NWW=NEQB*NF 00006930 CALL RDWRT(NCRD,A(N1),NF,14,I) 00006940 CALL RDWRT(NT,A(N1),NF,6,I) 00006950 CALL RDWRT(NT,A(N1),NF,13,I) 00006960 DO 440 L=1,NBLOCK 00006970 CALL RDWRT(NCRD,A(N1),NWW,14,I) 00006980 CALL RDWRT(NT,A(N1),NWW,13,I) 00006990 440 CONTINUE 00007000 WRITE(6,395)NCRD,NF 00007010 450 CONTINUE 00007020 IF(NDSSS.EQ.6)CALL RESPEC 00007030 IF(NDSSS.EQ.12)CALL FRFREQ 00007040 MODEX=KSKIP 00007050 CALL SECOND (T(9)) 00007060 T(10)= T(9) 00007070 GO TO 480 00007080 460 DO 470 I=6,9 00007090 470 T(I) = T(5) 00007100 CALL STEP 00007110 CALL SECOND (T(10)) 00007120 480 TT = 0.0 00007130 DO 490 I=1,9 00007140 T(I) = T(I+1)-T(I) 00007150 TT = TT + T(I) 00007160 490 CONTINUE 00007170 T(10)=0. 00007180 IF(NDSSS.EQ.12)T(10)=T(8) 00007190 IF(NDSSS.EQ.12)T(8)=0. 00007200 WRITE (6,530) (T(K),K=1,10),TT 00007210 KSKIP=MODEX 00007220 500 CALL RDWRT(1,A(1),1,12,I) 00007230 N1=1 00007240 NF=NFREQ 00007250 IF(NDYN.GT.0.AND.NDYN.LT.8) LL=NF 00007260 N2=N1+NEQB*LL 00007270 N3=MAXDF*LL+MAXDF+2 00007280 N4=N2+N3+10 00007290 LB=(MTOT-N4)/NEQ 00007300 IF(LB.GT.LL) LB=LL 00007310 N4=N2+NEQ*LB 00007320 N3=MTOT-N3-1+MAXDF+2 00007330 IF(KELRST.EQ.1) GO TO 505 00007340 CALL RECUVR (A(N1),A(N2),A(N4),A(N3),A(N1),LB,LL,NEQ,NEQB,NBLOCK, 00007350 $MAXDF) 00007360 505 CONTINUE 00007370 KSKIP1=KSKIP 00007380 IF (KSKIP.EQ.0)KSKIP=10 00007390 CCR IF(IPLT.NE.0) CALL SAPLOT(LL,NFREQ,MDYN,NEQB,NEQ,NBLOCK,IPLT 00007400 CCR &,KSKIP1) 00007410 CALL COMMRW (0) R0007411 WRITE (*,1095) R0007411 1095 FORMAT (5X,'************ SAP6PC TOTILE FINISHED ***********') R0007420 520 FORMAT ( 12H1OVERALL LOG // 00007470 $ 33H F.E. MODEL INPUT.............. ,F8.2// 00007480 $ 33H FORM ELEMENT STIFFNESSES...... ,F8.2// 00007490 $ 33H INPUT NODAL LOADS............. ,F8.2// 00007500 $ 33H FORM TOTAL STIFFNESS.......... ,F8.2// 00007510 $ 33H EQUATION SOLVING.............. ,F8.2// 00007520 $ 33H PARTICULAR SOLUTION(ABOVE).... ,F8.2/// 00007530 $ 33H TOTAL SOLUTION TIME........... ,F8.2) 00007540 530 FORMAT (1X ,31HO V E R A L L T I M E L O G, // 00007550 $ 5X,30HF.E. MODEL INPUT =, F8.2 / 00007560 $ 5X,30HELEMENT STIFFNESS FORMATION =, F8.2 / 00007570 $ 5X,30HNODAL LOAD INPUT =, F8.2 / 00007580 $ 5X,30HTOTAL STIFFNESS FORMATION =, F8.2 / 00007590 $ 5X,30HSTATIC ANALYSIS =, F8.2 / 00007600 $ 5X,30HEIGENVALUE EXTRACTION =, F8.2 / 00007610 $ 5X,30HFORCED RESPONSE ANALYSIS =, F8.2 / 00007620 $ 5X,30HRESPONSE SPECTRUM ANALYSIS =, F8.2 / 00007630 $ 5X,30HSTEP-BY-STEP INTEGRATION =, F8.2 / 00007640 & 5X,30HSINUSOIDAL FREQUENCY ANALYSIS=,F8.2// 00007650 $ 5X,30HTOTAL SOLUTION TIME =, F8.2 /) 00007660 560 FORMAT( 25H1STATIC SOLUTION TIME LOG,//, 00007730 $ 5X,51HEQUATION SOLVING...................................,F8.2/, 00007740 $ 5X,51HSTRESS AND ELEMENT GEOMETRIC MATRIX COMPUTATION....,F8.2/, 00007750 $ 5X,51HFORM TOTAL GEOMETRIC STIFFNESS.....................,F8.2//,00007760 $ 5X,51HTOTAL SOLUTION TIME (SUM OF THE ABOVE).............,F8.2//)00007770 STOP R0007771 END 00007780 SUBROUTINE SECOND(T) 00234270 IMPLICIT REAL*8 (A-H,O-Z) 00234280 CALL GETTIM(NA,NB,NC,ND) R0234281 AA = NA * 100.0 R0234282 CC = NC R0234283 CC = CC / 100.0 R0234284 T = AA + NB + CC R0234285 RETURN 00234300 END R0234286 SUBROUTINE ERROR(I) 00086230 IMPLICIT REAL*8(A-H,O-Z) 00086240 REAL*8 X 00086250 COMMON /EXTRA/ MODEX,NREXTR(25) R0086260 COMMON /PREP/ X(2),KSKIP,RRPREP(8) R0086270 KSKIP=1 00086280 MODEX=1 00086290 WRITE(6,100)I 00086300 100 FORMAT (1H0//1X,30HALLOCATED STORAGE EXCEEDED BY ,I7,6H WORDS) 00086310 WRITE(6,110) 00086320 110 FORMAT(/1X, 29HNO EXECUTION WILL BE ALLOWED./) 00086330 RETURN 00086340 END 00086350 SUBROUTINE RDWRT(JT,A,NUM,N,J) 00199630 IMPLICIT REAL*8(A-H,O-Z) 00199640 REAL*8 A 00199650 COMMON /WORDS/ NWDS(30,2) 00199660 DIMENSION A(NUM) 00199670 DIMENSION IUNIT(41) 00199680 DATA 00199690 $ IUNIT/21,22,23,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19, 00199700 $20,1,62,23,24,25,26,27,28,29,30,31,32,33,34,35,36,37,38,39,40,41/ R0199710 NT=IUNIT(JT) 00199720 K=N+1 00199730 LNTRC=NUM*8 00199740 GO TO (100,110,120,130,230,140,150, 00199750 $230,230,230,230, 00199760 $160,180,210,220),K 00199770 100 CONTINUE CC WRITE (6,109) NT,J,K,JT,N C109 FORMAT (5X,'****** NT,J,K,JT,N ******* =', 5I5) READ (NT) J R0199780 CALL RDA(NT,A,J) 00199790 RETURN 00199800 110 CONTINUE R0199801 CC WRITE (6,1009) NT,J,K,JT,N,NUM C1009 FORMAT (5X,'****** WRITE (NT,J,K,JT,N) ******* =', 6I5) WRITE (NT) NUM R0199810 WRITE (NT) A 00199820 NWDS(NT,1)=NWDS(NT,1)+NUM 00199830 RETURN 00199840 120 CONTINUE R0199841 CC WRITE (6,1008) NT,J,K,JT,N C1008 FORMAT (5X,'****** BACKSPACE (NT,J,K,JT,N) ******* =', 5I5) BACKSPACE NT R0199850 BACKSPACE NT 00199860 RETURN 00199870 130 READ (NT) 00199880 READ (NT) 00199890 RETURN 00199900 140 READ (NT) J,A 00199910 RETURN 00199920 150 REWIND NT 00199930 IF(NWDS(NT,1).GT.NWDS(NT,2)) NWDS(NT,2)=NWDS(NT,1) 00199940 NWDS(NT,1)=0 00199950 RETURN 00199960 160 DO 170 I=1,20 00199970 DO 170 J=1,2 00199980 170 NWDS(I,J)=0 00199990 RETURN 00200000 180 DO 200 I=1,20 00200010 J=NWDS(I,1) 00200020 IF(NWDS(I,2).GT.J) J=NWDS(I,2) 00200030 IF(J.GT.0) WRITE(6,190)I,J 00200040 190 FORMAT(//20X,13HDISK FILE NO.,I3,25H WAS REQUIRED TO STORE A, 00200050 $12H MAXIMUM OF,1X,I9,18H WORDS OF STORAGE./) 00200060 200 CONTINUE 00200070 RETURN 00200080 210 WRITE(NT) A 00200090 NWDS(NT,1)=NWDS(NT,1)+NUM 00200100 RETURN 00200110 220 READ(NT)A 00200120 230 RETURN 00200130 END 00200140 SUBROUTINE RDA(NT,A,NUM) 00196460 REAL*8 A 00196470 DIMENSION A(NUM) 00196480 READ (NT) A 00196490 RETURN 00196500 END 00196510 SUBROUTINE FILES(NN) RETURN END BLOCKDATA 00007790 IMPLICIT REAL*8(A-H,O-Z) 00007800 COMMON/HEADIN/TITLE1(20),TITLE2(5),TITLE3(10) 00007810 COMMON/ELARRY/NELAR(4,20) 00007820 COMMON /GASS/ XK(4,4),WGT(4,4),IPERM(3) 00007830 COMMON/GASS2/A5(7,2),W5(7) 00007840 COMMON /PREP/XMX,XAD,KSKIP,NDYN,I1,I99,POS,PRTCOD 00007850 1,POSSAV,PRTOFF,PRTON,PRTDUM,IDIRC 00007860 DATA XK / 0.D0, 0.D0, 0.D0, 0.D0,00007870 $ -.5773502691896D0, .5773502691896D0, 0.D0, 0.D0,00007880 $ -.7745966692415D0, .0000000000000D0, .7745966692415D0, 0.D0,00007890 $ -.8611363115941D0,-.3399810435849D0, .3399810435849D0, 00007900 $.8611363115941D0/ 00007910 DATA WGT / 2.000D0, 0.D0, 0.D0, 0.D0, 00007920 $ 1.0000000000000D0,1.0000000000000D0, 0.D0, 0.D0, 00007930 $ .5555555555556D0, .8888888888889D0, .5555555555556D0,0.D0, 00007940 $ .3478548451375D0, .6521451548625D0, .6521451548625D0, 00007950 $ .3478548451375D0/ 00007960 DATA IPERM / 2,3,1 / 00007970 DATA A5(1,1)/-0.333333333333D0/,A5(2,1)/-0.88056825640D0/ 00007980 DATA A5(3,1)/-0.05971587178D0/,A5(4,1)/-0.05971587178D0/ 00007990 DATA A5(5,1)/ 0.59485397070D0/, A5(6,1)/-0.79742698530D0/ 00008000 DATA A5(7,1)/-0.79742698530D0/, A5(1,2)/-0.333333333333D0/ 00008010 DATA A5(2,2)/-0.05971587178D0/, A5(3,2)/-0.88076825640D0/ 00008020 DATA A5(4,2)/-0.05971587178D0/ ,A5(5,2)/-0.79742698530D0/ 00008030 DATA A5(6,2)/ 0.59485397070D0/ ,A5(7,2)/-0.79742698530D0/ 00008040 DATA W5(1)/ 0.225 D0/, W5(2)/ 0.13239415 D0/ 00008050 DATA W5(3)/ 0.13239415 D0/, W5(4)/ 0.13239415 D0/ 00008060 DATA W5(5)/ 0.12593918 D0/, W5(6)/ 0.12593918 D0/ 00008070 DATA W5(7)/ 0.12593918 D0/ 00008080 DATA NELAR / 00008090 $ 2, 2, 6, 2, 00008100 $ 3, 2, 12, 28, 00008110 $ 4, 4, 12, 8, 00008120 $ 4, 4, 8, 4, 00008130 $ 8, 8, 33, 54, 00008140 $ 4, 4, 42, 24, 00008150 $ 1, 1, 1, 1, 00008160 $ 4, 4, 8, 4, 00008170 $ 3, 2, 12, 39, 00008180 $ 20, 20, 60, 54, 00008190 $ 8, 8, 16, 52, 00008200 $ 8, 8, 16, 52, 00008210 $ 8, 8, 16, 52, 00008220 $ 4, 1, 6, 6, 00008230 $ 8, 8, 48, 6, 00008240 $ 20*0/ 00008250 DATA TITLE2/4H ,4HSAP6,4H ,4HVER.,4H 2.0/ 00008260 DATA TITLE3(3)/4H LPI/,TITLE3(4)/4HAUTO/,TITLE3(5)/54./ 00008330 DATA POS/3H /,PRTCOD/3H / 00008340 DATA POSSAV/3H /,PRTOFF/3HOFF/,PRTON/3HON-/,PRTDUM/3HDUM/ 00008350 DATA IDIRC/0/ 00008360 END 00008370 SUBROUTINE RECUVR(B,D,SA,DISP,DISP2,LB,LL,NEQ,NEQB,NBLKS,MAXDF) 00200150 IMPLICIT REAL*8(A-H,O-Z) 00200160 DIMENSION D(NEQ,LB),B(NEQB,LL) 00200170 &,SA(1),DISP(1),DISP2(1),IU(11) 00200180 COMMON /PREP/XZ(2),KSKIP,NDYN,NRPREP(15) R0200190 COMMON /ELPAR/ XP(14),IDUM(15),NUMEL,NUMEL2,NRELPA(41) R0200200 COMMON /SUPEL/NSELEM,NRSUPE(5) R0200210 DATA IU/15,10,-1, 2,10,-1, 2,-1,-1,15,2/ 00200220 CALL FILES(6) 00200230 IF(KSKIP.EQ.1) RETURN 00200240 IF(NSELEM.LE.0) RETURN 00200250 NT=IU(NDYN+1) 00200260 IF(NT.LE.0) RETURN 00200270 NUMET=NUMEL+NUMEL2 00200280 NEMN=MAXDF+2 00200290 NT1=1 00200300 N18=18 00200310 N17=17 00200320 N27=27 00200330 N1=N18 00200340 N2=N17 00200350 LH=0 00200360 MT=(LL-1)/LB+1 00200370 REWIND N1 00200380 REWIND N2 00200390 REWIND NT 00200400 DO 190 II=1,MT 00200410 LT=LH+1 00200420 LLT=1-LT 00200430 LH=LT+LB-1 00200440 IF(LH.GT.LL) LH=LL 00200450 IF(NT.EQ.15) GO TO 120 00200460 REWIND NT 00200470 NQ=NEQB*NBLKS 00200480 NWRDS=LL*4 00200490 READ (NT) 00200500 DO 110 NN=1,NBLKS 00200510 READ (NT) B 00200520 N=NEQB 00200530 IF(NN.EQ.1) N=NEQ-NQ+NEQB 00200540 NQ=NQ-NEQB 00200550 DO 110 J=1,N 00200560 I=NQ+J 00200570 DO 110 L=LT,LH 00200580 K=LLT+L 00200590 110 D(I,K)=B(J,L) 00200600 GO TO 140 00200610 120 DO 130 L=LT,LH 00200620 K=L+LLT 00200630 130 READ(NT) (D(I,K),I=1,NEQ) 00200640 140 CALL RDWRT(NT1,SA,1,6,J) 00200650 DO 150 I=1,NUMET 00200660 150 CALL RDWRT(NT1,SA,1,3,KOUNT) 00200670 DO 180 I=1,NSELEM 00200680 IF(II.EQ.1) GO TO 160 00200690 READ (N1)M,N,ND,LX 00200700 NWD=ND*LX 00200710 READ (N1) (DISP(J),J=1,NWD) 00200720 160 CONTINUE 00200730 CALL RDWRT(NT1,SA,NEMN,0,KOUNT) 00200740 ND=SA(KOUNT) 00200750 M= SA(KOUNT-1) 00200760 DO 170 J=1,ND 00200770 JJ=SA(J) 00200780 DO 170 L=LT,LH 00200790 K=L+LLT 00200800 NWD=J+ND*(L-1) 00200810 170 DISP(NWD)=D(JJ,K) 00200820 WRITE (N2) M,I,ND,LL 00200830 NWD=ND*LL 00200840 WRITE (N2) (DISP(N),N=1,NWD) 00200850 180 CONTINUE 00200860 IF(II.EQ.MT) GO TO 190 00200870 REWIND N1 00200880 REWIND N2 00200890 LX=N1 00200900 N1=N2 00200910 N2=LX 00200920 190 CONTINUE 00200930 REWIND N27 00200940 NEL=0 00200950 200 READ (N27,END=220) M,N,ND,LX 00200960 210 IF(M.LE.0) GO TO 220 00200970 NEL=NEL+1 00200980 WRITE(N2) M,N,ND,LX 00200990 NWD=ND*LX 00201000 READ (N27) (DISP2(J),J=1,NWD) 00201010 WRITE(N2) (DISP2(J),J=1,NWD) 00201020 GO TO 200 00201030 220 REWIND N27 00201040 REWIND N2 00201050 IF(NEL.EQ.0) GO TO 240 00201060 DO 230 I=1,NEL 00201070 READ (N2) M,N,ND,LX 00201080 WRITE(N27)M,N,ND,LX 00201090 NWD=ND*LX 00201100 READ (N2) (DISP2(J),J=1,NWD) 00201110 230 WRITE(N27) (DISP2(J),J=1,NWD) 00201120 240 DO 250 I=1,NSELEM 00201130 READ (N2) M,N,ND,LX 00201140 WRITE(N27)M,N,ND,LX 00201150 NWD=ND*LX 00201160 READ (N2) (DISP2(J),J=1,NWD) 00201170 250 WRITE(N27) (DISP2(J),J=1,NWD) 00201180 RETURN 00201190 END 00201200 SUBROUTINE UNPKID(ID,NUMNP,X,COORD,MODE,N,IDOF) 00317660 IMPLICIT REAL*8 (A-H ,O-Z) 00317670 REAL*8 ID 00317680 DIMENSION ID(NUMNP,3) 00317690 COMMON /PREP/XMX,XAD,J1(2),I1,RRPREP(7) R0317700 GO TO (100,110),MODE 00317710 100 X=ID(N,IDOF) 00317720 K=X 00317730 IF(X.LT.0.0) K=K-1 00317740 COORD=(X-K-XAD)*XMX 00317750 RETURN 00317760 110 JJ=IDOF 00317770 IF(IDOF.GE.4) GO TO 120 00317780 NNN=ID(N,JJ) 00317790 IF(NNN.LT.0) GO TO 115 00317800 NNN= MOD(NNN,I1) 00317810 GO TO 117 00317820 115 CONTINUE 00317830 IF(IABS(NNN).GT.I1) GO TO 116 00317840 NNN=MOD(NNN,I1) 00317850 IF(NNN.LT.0) NNN=0 00317860 GO TO 117 00317870 116 NNN=1-NNN 00317880 NNN=MOD(NNN,I1) 00317890 GO TO 117 00317900 117 X=NNN 00317910 RETURN 00317920 120 JJ=JJ-3 00317930 NNN=ID(N,JJ) 00317940 00317950 IF(NNN.GE.0) GO TO 130 00317960 IF(IABS(NNN).LT.I1) GO TO 130 00317970 NN2=NNN/I1 00317980 NNN=-NN2 00317990 GO TO 140 00318000 130 CONTINUE 00318010 NN2=MOD(NNN,I1) 00318020 NNN=NNN/I1 00318030 IF(NNN.GT.0) NNN=NNN+NN2 00318040 IF(NN2.LT.0) NNN=1-NN2 00318050 140 CONTINUE 00318060 X=NNN 00318070 RETURN 00318080 END 00318090 SUBROUTINE QVCOPY(FROM,TO,N) 00193850 REAL*8 FROM,TO 00193860 DIMENSION FROM(1),TO(1) 00193870 DO 100 I=1,N 00193880 100 TO(I)=FROM(I) 00193890 RETURN 00193900 END 00193910 SUBROUTINE QMR2(C,D,FAC,B,N,JC,KC,JB) 00186840 IMPLICIT REAL*8(A-H,O-Z) 00186850 DIMENSION B(1),C(1),D(1) 00186860 IB=1 00186870 IC=1 00186880 DO 100 I=1,N 00186890 C(IC)=D(IC)-FAC*B(IB) 00186900 IB=IB+JB 00186910 100 IC=IC+JC 00186920 RETURN 00186930 END 00186940 SUBROUTINE QVSET(C,AAB,N) 00194580 IMPLICIT REAL*8 (A-H,O-Z) R0194581 REAL*8 C,AAB 00194590 DIMENSION AAB(N) 00194600 DO 100 I=1,N 00194610 AAB(I)=C 00194620 100 CONTINUE R0194621 RETURN 00194630 END 00194640 SUBROUTINE SQEEZE(A,NUM,NT,KOD) 00254540 IMPLICIT REAL*8(A-H,O-Z) 00254550 REAL*8 A 00254560 DIMENSION A(1) 00254570 IF(KOD.GT.0) GO TO 100 00254580 CALL SQISH(A,NUM,N) 00254590 CALL RDWRT(NT,A,N,1,K) 00254600 RETURN 00254610 100 CALL RDWRT(NT,A,NUM,1,K) 00254620 RETURN 00254630 END 00254640 SUBROUTINE EXPAND(A,NUM,NT) 00086360 IMPLICIT REAL*8(A-H,O-Z) 00086370 REAL*8 A 00086380 DIMENSION A(1) 00086390 CALL RDWRT(NT,A,NUM,0,J) 00086400 IF(J.EQ.NUM) RETURN 00086410 RETURN 00086420 END 00086430 SUBROUTINE MEMSET (KONST,IARRAY,NWDS) 00135760 REAL*8 IARRAY, KONST 00135770 DIMENSION IARRAY(1) 00135780 DO 100 I=1,NWDS 00135790 100 IARRAY(I)=KONST 00135800 RETURN 00135810 END 00135820 SUBROUTINE QVDOT(C,A,B,N,JA,JB) 00193990 REAL*8 A,B,C 00194000 DIMENSION A(1),B(1) 00194010 IA=1 00194020 IB=1 00194030 C=0.0 00194040 DO 100 I=1,N 00194050 C=C+A(IA)*B(IB) 00194060 IA=IA+JA 00194070 100 IB=IB+JB 00194080 RETURN 00194090 END 00194100 SUBROUTINE QVMPY1(A,B,C,N,INCA,INCB,INCC) 00194240 IMPLICIT REAL*8(A-H,O-Z) 00194250 DIMENSION A(1),B(1) 00194260 JA=1 00194270 JB=1 00194280 DO 100 I=1,N 00194290 A(JA)=B(JB)*C 00194300 JA=JA+INCA 00194310 100 JB=JB+INCB 00194320 RETURN 00194330 END 00194340 SUBROUTINE MEMOVE (IFROM,ITO,NWDS) 00135690 REAL*8 IFROM, ITO 00135700 DIMENSION IFROM(1),ITO(1) 00135710 DO 100 I=1,NWDS 00135720 100 ITO(I)=IFROM(I) 00135730 RETURN 00135740 END 00135750 FUNCTION GETWRD(GET001) 00105400 INTEGER SECT,POINT,BEGIN,GETSEC,EPOINT,BLANK,AGET,AGETW 00105410 LOGICAL EOL,EOS,EOF,ERROR,INDEX,GETWRD,IGET,RGET,ERR1 00105420 COMMON /FRECNT/ LINE(80),SECT,EOL,EOS,EOF, 00105430 1ERROR,BLANK,ICOMMA,POINT,BEGIN,LENGTH, 00105440 2EPOINT,NSECT,LINENM,MAXSTR,KUNIT,JUNIT,IUNIT 00105450 GETWRD = .FALSE. 00105460 LENGTH = 0 00105470 IF (EOL) RETURN 00105480 DO 100 BEGIN = POINT,80 00105490 IF (LINE(BEGIN).NE.BLANK) GO TO 110 00105500 100 CONTINUE 00105510 EOL = .TRUE. 00105520 POINT = 80 00105530 RETURN 00105540 110 DO 170 POINT = BEGIN,80 00105550 IF (LINE(POINT).EQ.BLANK.OR.LINE(POINT).EQ.ICOMMA) 00105560 1GO TO 180 00105570 LENGTH = POINT - BEGIN + 1 00105580 MAXSTR = LENGTH 00105590 170 CONTINUE 00105600 GETWRD = .TRUE. 00105610 EOL = .TRUE. 00105620 RETURN 00105630 180 IP = POINT 00105640 DO 200 POINT = POINT,80 00105650 IF (LINE(POINT).EQ.ICOMMA) GO TO 210 00105660 IF (LINE(POINT).NE.BLANK) GO TO 190 00105670 200 CONTINUE 00105680 GETWRD = .TRUE. 00105690 EOL =.TRUE. 00105700 RETURN 00105710 190 POINT = IP 00105720 GETWRD = .TRUE. 00105730 RETURN 00105740 210 POINT = POINT + 1 00105750 GETWRD = .TRUE. 00105760 RETURN 00105770 END 00105780 SUBROUTINE ADDGEO(A,B,TMASS,A2,B2,TMASS2,NUMEL,NBLOCK,NE2B,LL, 00008380 $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) 00008430 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(24) R0008530 COMMON /DYN2/IFPR,IFSS,NITEM,NFO,RTOL,COFQ,DT,ALFA,BETA,NFN,NGM, 00008540 $NAT,NT,NOT,NRDYN2(9) R0008550 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 (1H1) 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 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 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 CALL SQEEZE(A ,NWDS,NTA,ISQZ) 00010380 IF(M.EQ.NBLOCK) GO TO 310 00010390 WRITE (NTD) TMASS2,(A2(I,1),I=1,NEQB) 00010400 CALL SQEEZE(A2,NWDS,NTA,ISQZ) 00010410 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 QMR3(C,D,FAC,B,N,JC,KC,JB,NWA) 00186950 IMPLICIT REAL*8(A-H,O-Z) 00186960 DIMENSION B(1),C(1),D(1) 00186970 MBAND=NWA/N 00186980 IB=1 00186990 IC=1 00187000 DO 100 I=1,N 00187010 DO 90 J=1,MBAND 00187020 KB=N*(J-1)+IB 00187030 KCC=N*(J-1)+IC 00187040 C(KCC)=D(KCC)-FAC*B(KB) 00187050 90 CONTINUE 00187060 IB=IB+JB 00187070 100 IC=IC+JC 00187080 210 FORMAT(5X,10E10.3) 00187090 RETURN 00187100 END 00187110 SUBROUTINE QVCPY1(FROM,TO,N) 00193920 REAL*8 FROM,TO 00193930 DIMENSION FROM(N,1),TO(1) 00193940 DO 100 I=1,N 00193950 100 TO(I)=FROM(I,1) 00193960 RETURN 00193970 END 00193980 SUBROUTINE DISPLY (X,F,NF,NDS,NUM,NN,KKK,ISD,ISP) 00059680 IMPLICIT REAL*8(A-H,O-Z) 00059690 REAL*8 NPAR 00059700 DIMENSION NTAPE(4),X(NF,NDS,3),F(8,NF),NUM(NN) 00059710 COMMON / JUNK /TM(8),DM(8),D(8),KD(3,8),RRJUNK(191) R0059720 COMMON / DYN / NT,NOT,DAMP,DT,RRDYN(3) R0059730 COMMON / ELPAR / NPAR(14),RRELPA(29) R0059740 DATA NTAPE/48,45,46,47/ 00059750 REWIND 3 00059760 REWIND 4 00059770 NT45=NTAPE(ISD) 00059780 REWIND NT45 00059790 READ (4) X 00059800 DO 320 N=1,NN 00059810 REWIND 2 00059820 REWIND 9 00059830 MM=NUM(N) 00059840 MMM=3 00059850 IF(ISD.EQ.3)MMM=2 00059860 IF(ISD.EQ.4)MMM=1 00059870 100 IF(MM.EQ.0) GO TO 320 00059880 DO 270 M=1,MM 00059890 READ (3) L,KD,F 00059900 GO TO (110,160,140),KKK 00059910 110 GO TO (120,111,112,114),ISD 00059920 111 WRITE (6,330) M 00059930 GO TO 130 00059940 112 WRITE(6,331)M 00059950 GO TO 130 00059960 114 WRITE(6,332)M 00059970 GO TO 130 00059980 120 WRITE (6,390) M 00059990 130 WRITE (6,400) (KD(1,I),KD(2,I),I=1,L) 00060000 GO TO 160 00060010 140 IF(M.GT.1) GO TO 160 00060020 GO TO (150,141,142,143),ISD 00060030 141 WRITE (6,340) 00060040 WRITE (6,450) 00060050 GO TO 160 00060060 142 WRITE(6,341) 00060070 WRITE(6,451) 00060080 GO TO 160 00060090 143 WRITE(6,342) 00060100 WRITE(6,452) 00060110 GO TO 160 00060120 150 WRITE (6,410) 00060130 WRITE (6,430) 00060140 160 DO 170 I=1,L 00060150 TM(I)=0. 00060160 170 DM(I)=0. 00060170 TIME=0. 00060180 DO 230 K=1,NDS 00060190 TIME=TIME + DT 00060200 DO 200 I=1,L 00060210 DD=0. 00060220 DO 180 J=1,NF 00060230 180 DD = DD + F(I,J)*X(J,K,MMM) 00060240 AD= DABS(DD) 00060250 IF(AD-DM(I)) 200,200,190 00060260 190 DM(I)=AD 00060270 TM(I)=TIME 00060280 200 D(I)=DD 00060290 WRITE(NT45,1000)TIME,M,(D(I),I=1,L) 00060300 GO TO (210,220,230),KKK 00060310 210 WRITE (6,350) TIME,(D(I),I=1,L) 00060320 GO TO 230 00060330 220 WRITE (9) D 00060340 230 CONTINUE 00060350 GO TO (240,250,260),KKK 00060360 240 WRITE (6,360) (DM(I),I=1,L) 00060370 WRITE (6,370) (TM(I),I=1,L) 00060380 GO TO 270 00060390 250 WRITE (2) KD,DM,TM,L 00060400 GO TO 270 00060410 260 WRITE (6,380) (KD(1,I),KD(2,I),DM(I),TM(I),I=1,L) 00060420 270 CONTINUE 00060430 IF(KKK.NE.2) GO TO 320 00060440 REWIND 2 00060450 REWIND 9 00060460 DO 310 M=1,MM 00060470 GO TO (280,290,291,292),ISD 00060480 280 WRITE (6,420) M 00060490 WRITE (6,430) 00060500 GO TO 300 00060510 290 WRITE (6,440) M 00060520 WRITE (6,450) 00060530 GO TO 300 00060540 291 WRITE(6,441)M 00060550 WRITE(6,451) 00060560 GO TO 300 00060570 292 WRITE(6,442)M 00060580 WRITE(6,452) 00060590 300 CALL PLOTDY (2,9,NDS,ISP) 00060600 310 CONTINUE 00060610 320 CONTINUE 00060620 RETURN 00060630 330 FORMAT (50H1TIME HISTORY FOR SELECTED DISPLACEMENT COMPONENTS , 00060640 $ 5H..... ,I3//10X,40HNODE NUMBERS AND DISPLACEMENT COMPONENTS ) 00060650 340 FORMAT (59H1MAXIMUM DISPLACEMENT VALUES FROM DYNAMIC RESPONSE ANAL00060660 $YSIS //) 00060670 350 FORMAT (F8.3,2X,1P8E12.3) 00060680 360 FORMAT ( /24H MAXIMUM ABSOLUTE VALUES // 00060690 $ 10H MAXIMUM ,1P8E12.3) 00060700 370 FORMAT (10H TIME ,1P8E12.3) 00060710 380 FORMAT (I6,I13,1PE18.3,E12.3,5X,2HNA) 00060720 390 FORMAT ( 44H1TIME HISTORY FOR SELECTED STRESS COMPONENTS , 00060730 $ 5H..... , I3//10X,37H ELEMENT AND STRESS COMPONENT NUMBERS ) 00060740 400 FORMAT (8H TIME , 2X, 8(I8,1H-,I2,1X)) 00060750 410 FORMAT ( 00060760 $ 53H1MAXIMUM STRESS VALUES FROM DYNAMIC RESPONSE ANALYSIS //) 00060770 420 FORMAT ( 00060780 $ 39H1NORMALISED PLOT OF STRESS HISTORIES...,I3/) 00060790 430 FORMAT(58H ELEMENT STRESS MAXIMUM TIME AT PLO00060800 $T / 58H NUMBER COMPONENT VALUE MAXIMUM SYMBOL)00060810 440 FORMAT (46H1NORMALISED PLOT OF DISPLACEMENT HISTORIES....,I3/) 00060820 450 FORMAT(58H NODE DISPLACEMENT MAXIMUM TIME AT PLO00060830 $T / 58H NUMBER COMPONENT VALUE MAXIMUM SYMBOL)00060840 331 FORMAT (50H1TIME HISTORY FOR SELECTED VELOCITY COMPONENTS , 00060850 $ 5H..... ,I3//10X,40HNODE NUMBERS AND VELOCITY COMPONENTS ) 00060860 332 FORMAT (50H1TIME HISTORY FOR SELECTED ACCELERATION COMPONENTS , 00060870 $ 5H..... ,I3//10X,40HNODE NUMBERS AND ACCELERATION COMPONENTS ) 00060880 341 FORMAT (59H1MAXIMUM VELOCITY VALUES FROM DYNAMIC RESPONSE ANAL00060890 $YSIS //) 00060900 342 FORMAT (59H1MAXIMUM ACCELERATION VALUES FROM DYNAMIC RESPONSE ANAL00060910 $YSIS //) 00060920 451 FORMAT(58H NODE VELOCITY MAXIMUM TIME AT PLO00060930 $T / 58H NUMBER COMPONENT VALUE MAXIMUM SYMBOL)00060940 452 FORMAT(58H NODE ACCELERATION MAXIMUM TIME AT PLO00060950 $T / 58H NUMBER COMPONENT VALUE MAXIMUM SYMBOL)00060960 441 FORMAT (46H1NORMALISED PLOT OF VELOCITY HISTORIES....,I3/) 00060970 442 FORMAT (46H1NORMALISED PLOT OF ACCELERATION HISTORIES....,I3/) 00060980 1000 FORMAT(E13.5,I5,8E13.5) 00060990 END 00061000 SUBROUTINE DSHELL 00063280 IMPLICIT REAL *8 (A-H,O-Z) 00063290 COMMON /JUNK/ SIG(200),MM,L,K,NTAG,NDYN,NRJUNK(49) R0063300 COMMON /OUT/ NRES,NSTR,NDIS,NROUT(7) R0063310 DIMENSION EFS(2) 00063320 10 IF (NTAG.EQ.0) WRITE (6,30) 00063330 SIG(7)=SIG(1)+SIG(4) 00063340 SIG(8)=SIG(2)+SIG(5) 00063350 SIG(9)=SIG(3)+SIG(6) 00063360 CC=(SIG(7)+SIG(8))/2. 00063370 BB=(SIG(7)-SIG(8))/2. 00063380 CR=DSQRT(BB**2+SIG(9)**2) 00063390 SIG(10)=CC+CR 00063400 SIG(11)=CC-CR 00063410 SIG(12)=0.0 00063420 IF (BB.NE.0) SIG(12)=28.648*DATAN2(SIG(9),BB) 00063430 SIG(13)=SIG(1)-SIG(4) 00063440 SIG(14)=SIG(2)-SIG(5) 00063450 SIG(15)=SIG(3)-SIG(6) 00063460 CC=(SIG(13)+SIG(14))/2. 00063470 BB=(SIG(13)-SIG(14))/2. 00063480 CR=DSQRT(BB**2+SIG(15)**2) 00063490 SIG(16)=CC+CR 00063500 SIG(17)=CC-CR 00063510 SIG(18)=0.0 00063520 IF (BB.NE.0) SIG(18)=28.648*DATAN2(SIG(15),BB) 00063530 EFS(1)=SIG(10)**2+SIG(11)**2-SIG(10)*SIG(11) 00063540 EFS(1)=DSQRT(EFS(1)) 00063550 EFS(2)=SIG(16)**2+SIG(17)**2-SIG(16)*SIG(17) 00063560 EFS(2)=DSQRT(EFS(2)) 00063570 WRITE (6,40) MM,L,(SIG(I),I=1,12),EFS(1),(SIG(I),I=13,18),EFS(2) 00063580 IF (NSTR.GT.0) WRITE (NSTR,20) L,SIG(10),SIG(11),EFS(1),SIG(16),SI00063590 1G(17),EFS(2),(SIG(I),I=7,9),SIG(12),(SIG(I),I=13,15),SIG(18) 00063600 20 FORMAT (4H 14,I2,4H12 6,7G10.4/(8G10.4)) 00063610 RETURN 00063620 30 FORMAT ( 24H1 SHELL ELEMENT STRESSES//10X,19H ELEMENT LOAD,00063630 138H SIG-X SIG-Y SIG-XY SIG-MAX, 00063640 230H SIG-MIN ANGLE SIG-EF) 00063650 40 FORMAT (//10H MEMBRANE ,2I10,3F10.2/9H BENDING,21X,3F10.2/ 00063660 110H +T/2 SIDE,20X,7F10.2/10H -T/2 SIDE,20X,7F10.2) 00063670 END 00063680 SUBROUTINE SDSPLY (TEMP,X,MMX,MAX,NCL,NUM,NN,KKK,ISD,ISP,NPT,KT) 00227660 IMPLICIT REAL*8 (A-H,O-Z) 00227670 COMMON /QTSARG/ SSA(8,60),KLM(8,60) 00227680 $,TM(8),DM(8),D(8),RRQTSA(256) R0227690 COMMON /JUNK/NDUM(6),NBL,LAST,KD(2,8),RRJUNK(215) R0227700 COMMON /DYN2/IFPR,IFSS,NITEM,NFO,RTOL,COFQ,DT,ALFA,BETA,NFN,NGM, 00227710 $NAT,NT,NOT,NRDYN2(9) R0227720 COMMON /OUT/NRES,NSTR,NDIS,NROUT(7) R0227730 DIMENSION TEMP(MAX,NCL),X(MMX,NCL),NUM(NN) 00227740 IT = 3 00227750 REWIND KT 00227760 NT9 = 9 00227770 NT8 = 8 00227780 REWIND NT8 00227790 NT2 = 1 00227800 NT4 = 2 00227810 IU=0 00227820 IF(ISD.EQ.1.AND.NSTR.GT.0) IU=NSTR 00227830 IF(ISD.EQ.2.AND.NDIS.GT.0) IU=NDIS 00227840 IF(IU.GT.0) WRITE (IU,540) ISD,NUM(1),NPT 00227850 IF(MAX.NE.MMX) GO TO 100 00227860 IT=KT 00227870 NBLOCK = NBL 00227880 GO TO 130 00227890 100 K=0 00227900 REWIND IT 00227910 NBLOCK = 0 00227920 DO 120 NB=1,NBL 00227930 READ (KT) TEMP 00227940 DO 110 I=1,MAX 00227950 II=I+K 00227960 DO 110 J=1,NCL 00227970 110 X(II,J)=TEMP(I,J) 00227980 K=K+MAX 00227990 L = K+MAX 00228000 IF(L.LE.MMX) GO TO 120 00228010 WRITE (IT) X 00228020 K=0 00228030 NBLOCK=NBLOCK+1 00228040 120 CONTINUE 00228050 IF(K.EQ.0) GO TO 130 00228060 WRITE (IT) X 00228070 NBLOCK = NBLOCK +1 00228080 130 IF=0 00228090 DO 410 N=1,NN 00228100 REWIND NT2 00228110 REWIND NT4 00228120 MM=NUM(N) 00228130 140 IF(MM.EQ.0) GO TO 410 00228140 MTYPL=0 00228150 DO 360 M=1,MM 00228160 REWIND IT 00228170 IF(ISD.EQ.1) READ (NT8) ND,((SSA(I,J),I=1,8),J=1,ND), 00228180 $ ((KLM(I,J),I=1,8),J=1,ND),MTYPE 00228190 READ (NT9) KD,L 00228200 IF(IU.GT.0) WRITE (IU,540) M,L 00228210 IF(IU.GT.0) WRITE (IU,540) (KD(1,I),KD(2,I),I=1,L) 00228220 GO TO (150,190,170),KKK 00228230 150 IF(ISD.EQ.1) GO TO 160 00228240 WRITE (6,420) M 00228250 WRITE (6,480) (KD(1,I),KD(2,I),I=1,L) 00228260 GO TO 190 00228270 160 00228280 $CALL ELOUTS (KD,L,MTYPE,M,ND) 00228290 GO TO 190 00228300 170 IF(ISD.EQ.1) GO TO 180 00228310 IF(M.GT.1) GO TO 190 00228320 WRITE (6,430) 00228330 WRITE (6,530) 00228340 GO TO 190 00228350 180 WRITE (6,490) MTYPE 00228360 WRITE (6,510) 00228370 190 DO 200 I=1,L 00228380 TM(I)=0.E0 00228390 200 DM(I)=0.E0 00228400 TIME=0.E0 00228410 MTYPL=MTYPE 00228420 NR = MMX 00228430 DO 320 NB=1,NBLOCK 00228440 READ (IT) X 00228450 IF(NB.LT.NBLOCK) GO TO 210 00228460 NR = NPT - (NBLOCK-1)*MMX 00228470 210 CONTINUE 00228480 DO 310 K=1,NR 00228490 TIME=TIME + DT 00228500 DO 280 I=1,L 00228510 GO TO (220,250),ISD 00228520 220 DD=0.E0 00228530 DO 240 J=1,ND 00228540 JJ=KLM(I,J) 00228550 IF(JJ) 240,240,230 00228560 230 DD=DD+SSA(I,J)*X(K,JJ) 00228570 240 CONTINUE 00228580 GO TO 260 00228590 250 JJ = IF+I 00228600 DD = X(K,JJ) 00228610 260 AD= DABS(DD) 00228620 IF(AD-DM(I)) 280,280,270 00228630 270 DM(I)=AD 00228640 TM(I)=TIME 00228650 280 D(I)=DD 00228660 IF(IU.GT.0) WRITE (IU,550) TIME,(D(I),I=1,L) 00228670 GO TO (290,300,310),KKK 00228680 290 WRITE (6,440) TIME,(D(I),I=1,L) 00228690 GO TO 310 00228700 300 WRITE (NT4) D 00228710 310 CONTINUE 00228720 320 CONTINUE 00228730 GO TO (330,340,350),KKK 00228740 330 WRITE (6,450) (DM(I),I=1,L) 00228750 WRITE (6,460) (TM(I),I=1,L) 00228760 GO TO 360 00228770 340 WRITE (NT2) KD,DM,TM,L 00228780 GO TO 360 00228790 350 WRITE (6,470) (KD(1,I),KD(2,I),DM(I),TM(I),I=1,L) 00228800 360 IF=IF+L 00228810 IF(KKK.NE.2) GO TO 410 00228820 REWIND NT2 00228830 REWIND NT4 00228840 DO 400 M=1,MM 00228850 GO TO (370,380),ISD 00228860 370 WRITE (6,500) MTYPE,M 00228870 WRITE (6,510) 00228880 GO TO 390 00228890 380 WRITE (6,520) M 00228900 WRITE (6,530) 00228910 390 CALL SPLOT (NT2,NT4,NPT,ISP) 00228920 400 CONTINUE 00228930 410 CONTINUE 00228940 RETURN 00228950 420 FORMAT (50H1D I S P L A C E M E N T T I M E H I S T O R Y, // 00228960 $ 13H OUTPUT SET =,I4, // 14X,27H*NODE NUMBER* - (COMPONENT , 00228970 $ 7HNUMBER), 1X) 00228980 430 FORMAT (38H1D I S P L A C E M E N T M A X I M A, // 1X) 00228990 440 FORMAT (F12.5,2X,1P8E12.3) 00229000 450 FORMAT (/ 24H MAXIMUM ABSOLUTE VALUES, // 8H MAXIMUM,6X,1P8E12.3) 00229010 460 FORMAT (5H TIME,9X,1P8E12.3) 00229020 470 FORMAT (I8,12X,I3,1P2E14.4,7X,2HNA) 00229030 480 FORMAT (8X,4HTIME,2X, 8(3X,I4,2H-(,I2,1H)) / 1X) 00229040 490 FORMAT (46H1S T R E S S C O M P O N E N T M A X I M A, // 00229050 $ 22H ELEMENT TYPE NUMBER =, I3, // 1X) 00229060 500 FORMAT (51H N O R M A L I Z E D S T R E S S H I S T O R Y,3X,00229070 $ 7HP L O T, // 22H ELEMENT TYPE NUMBER =, I3 / 00229080 $ 22H OUTPUT SET NUMBER =, I3 // 1X) 00229090 510 FORMAT (8H ELEMENT,9X,6HSTRESS,7X,7HMAXIMUM,7X,7HTIME AT,5X, 00229100 $ 4HPLOT,/ 8H NUMBER,6X,9HCOMPONENT,9X,5HVALUE,7X,7HMAXIMUM,3X, 00229110 $ 6HSYMBOL, / 1X) 00229120 520 FORMAT (46H1N O R M A L I Z E D D I S P L A C E M E N T,3X, 00229130 $ 23HH I S T O R Y P L O T, // 22H OUTPUT SET NUMBER =, I3//1X)00229140 530 FORMAT (4X,4HNODE,3X,12HDISPLACEMENT,7X,7HMAXIMUM,7X,7HTIME AT, 00229150 $ 5X,4HPLOT, / 8H NUMBER,6X,9HCOMPONENT,9X,5HVALUE,7X,7HMAXIMUM, 00229160 $ 3X,6HSYMBOL, / 1X) 00229170 540 FORMAT(16I5) 00229180 550 FORMAT(6G12.6,8X) 00229190 END 00229200 SUBROUTINE SPHT2 (T,M,SPHT ) 00250720 IMPLICIT REAL*8(A-H,O-Z) 00250730 DIMENSION COEF(11,8) 00250740 DATA COEF/ 00250750 1 4.0,100.0,1500.0,1.017891E-1,1.046516E-4,-1.522855E-7, 00250760 1 1.070093E-10,-2.562681E-14,0.0,0.0,0.0, 00250770 2 4.0,100.0,1500.0,1.017891E-1,1.046516E-4,-1.522855E-7, 00250780 2 1.070093E-10,-2.562681E-14,0.0,0.0,0.0, 00250790 3 2.0,32.0,1650.0,3.4574E-1,-7.9226E-5,3.4086E-8,0.0,0.0,0.0,0.,0.,00250800 4 7.0,75.0,1600.,1.014456E-1,4.378752E-5,-2.046138E-8,3.418111E-11,00250810 4 -2.060318E-13,3.682836E-16,-2.458648E-19,5.597571E-23, 00250820 5 4.0,100.0,800.0,1.154315E-1,-2.500197E-5,2.354774E-7, 00250830 5 -3.738534E-10,2.230893E-13,0.0,0.0,0.0, 00250840 6 4.0,100.0,800.0,1.154315E-1,-2.500197E-5,2.354774E-7, 00250850 6 -3.738534E-10,2.230893E-13,0.0,0.0,0.0, 00250860 7 4.0,100.0,800.0,9.374201E-2,1.659039E-4,-3.860357E-7, 00250870 7 4.889573E-10,-2.067584E-13,0.0,0.0,0.0, 00250880 8 3.0,0.0,2500.0,2.397434E-1,-1.270842E-6,3.997813E-8, 00250890 8 -1.522993E-11,0.0,0.0,0.0,0.0/ 00250900 ICODE=2 00250910 IF(M.LT.1.OR.M.GT.8)CALL RPZLVZ(M,T,ICODE,8) 00250920 N=COEF(1,M) 00250930 T1=COEF(2,M) 00250940 T2=COEF(3,M) 00250950 IF(T.LT.T1.OR.T.GT.T2)CALL RPZLVZ(M,T,ICODE,1) 00250960 IF(T.GT.208.OR.M.NE.3)GO TO 5 00250970 SPHT=2.845E-1+3.647E-5*T+7.765E-7*T*T 00250980 RETURN 00250990 5 CONTINUE 00251000 SPHT =COEF(N+4,M) 00251010 IF(N.EQ.0)RETURN 00251020 DO 10 I=1,N 00251030 10 SPHT =SPHT *T+COEF(N-I+4,M) 00251040 RETURN 00251050 END 00251060