Liren Large Software Subsidy 9

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

/ Liren Large Software Subsidy 9 / 09.iso / e / e003 / 2.ddi / MODEL00.FOR next >

Wrap

Text File | 1987-09-17 | 100.7 KB | 1,258 lines

SUBROUTINE MODEL (NTYP) 00137840 IMPLICIT REAL*8(A-H,O-Z) 00137850 REAL*8 NPAR 00137860 LOGICAL ELPRT,ELPCH,GENPRT,GENPCH ,DEFPCH,GEOST 00137870 C CHARACTER C(55)*8,C111*4,RNM*4,IAPG1*4,IAPG2*4 R0137871 COMMON A(1) 00137880 COMMON/BMDATA/IAISC,ILDTYP,ILDMUL,IBMSEC,NLWAVE,ILOCAL 00137890 COMMON/COMBLD/PCT(15,7),SINC(15),NCOMB,NB(15),LD(15,7) 00137900 COMMON/RIGID/IIA(20),NREX 00137910 COMMON/RLSE/KRLX 00137920 COMMON/CTL/ELPRT,ELPCH,GENPRT,GENPCH 00137930 COMMON /TRASH/IA,NRTRAS(979) R0137940 COMMON /DYN4/KDYN,NRESS,NCRD,NCWT,NRESS1 00137950 COMMON /DYN5/FRSHFT,FRINIT,FREND,MODEFR,NOSS R0137960 COMMON /EXTRA/MODEX,NT8,N10SV,NT10,KEQB,NREXTR(21) R0137970 COMMON/GEOSTF/GEOST,NELGEO 00137980 COMMON /BAND/ NRNM(3),IO,NRBAND(4) R0137990 COMMON/MASS/LMASS 00138000 COMMON /MATL/ MATCOD 00138010 COMMON / MISC / NBLOCK,NEQB,LL,NF,LB 00138020 COMMON /ELTEMP/ TAVG,KET,NRELTE(203) R0138030 COMMON /SQZ/ ISQZ,LIST,LISTC,LISTB,LISTA,NRSQZ R0138040 COMMON/SIZE/NDMX,MXDF,NSMX,NTERM,NADND 00138050 COMMON/SLVE/NSLAVE 00138060 COMMON/AMB/ GRAV,REFT,JROT 00138070 COMMON /PREP/ XMX,XAD,KSKIP,NDYN,I1,I99,POS,PRTCOD 00138080 $ ,POSSAV,PRTOFF,PRTON,PRTDUM,IDIRC 00138090 COMMON/EQUILB/NEQIL,NX43 00138100 COMMON/QTSARG/ X(3,50),Y(3,50),Z(3,50),TI(3,3,50),XC(3),XI(3) 00138110 & ,RRQTSA(94) R013811 COMMON /OUT/ NRES,NSTR,NDIS,NBMSTR,IOSIG,IODISP 00138120 $,KELRST,MAXDF 00138130 $,INTSTR,NROUT R0138140 COMMON /ELPAR/ NPAR(14),NUMNP,MBAND,NELTYP,N1,N2,N3,N4,N5,MTOT,NEQ00138150 $ ,N2P,N3P,NMRI,NTRI,N1P,NUMEL,NUMEL2,KZ(20,2),NEMN 00138160 COMMON /JUNK/ DUM(100),G,JJ(3),NRJUNK(249) R0138170 COMMON /FORCE/ NLC,NELD 00138180 DIMENSION HED(20) 00138190 DIMENSION C(55),KK(55) 00138200 COMMON /DYN2/IFPR,IFSS,NITEM,NFO,RTOL,COFQ,RRDYN2(10) R0138210 COMMON /HEADIN/TITLE1(20),TITLE2(5),TITLE3(10) 00138220 COMMON /SUPEL/ NSELEM,NEQL,NODESE,NRSUPE(3) R0138230 COMMON /ICM/ICOMP,MMRI,MTRI,M1P,M2P,M3P 00138240 COMMON/PLOTG/IPLWRG 00138250 COMMON/PLOTH/IPLT,IPLWRT 00138260 DATA C/8HFEDGE-IN,8HA-CONSTR,8HA-PRESSR,8HNODE-INP,8HELEMENTS, 00138270 $8HPRES-TYP,8HBEAM-TYP,8HTRUS-TYP,8HTHIK-TYP,8HEND-RELS,8HM-CONSTR,00138280 $8HPUNCH---,8HEXECUTE-,8HSTOP----,8HRESTART-,8HBOUNDARY,8HLOADFACT,00138290 $8HMATERIAL,8HMAG-TAPE,8HNEW-PROB,8HRENUMBER,8HREADDATA,8HPRINT---,00138300 $8HAMBIENT-,8HREADGRID,8HCOMPOSIT,8HCOORD---,8HOUTPUT-- 00138310 $,8HTIENODES,8HMAXDIMEN,8HTEMPDIST,8HLOADS---,8HDYNAMIC-,8HLISTDATA00138320 $,8HFESAP---,8HREWIND20,8HBEAM-SEC,8HMATRIX--,8HFEMEG-IN, 00138330 $ 8HSUPER-EL,8HCLASLINE,8HHIGHTEMP,8HSURCLINK 00138340 &,8HGEN-STIF,8HBEAM-OFF,8HRIGID---,8HBEAMLOAD,8HAISC-SEC 00138350 & ,8HELEM-REL,8HBMLDMULT,8HBMLD-TYP,8HCOMBINED,8HBM-EFFLN 00138360 & ,8HSLAVE---,8HEXTRA---/ 00138370 DATA C111/4H / 00138380 DATA RNM/4HPROF/ 00138390 DATA IAPG1/4HLOW /,IAPG2/4HHIGH/ 00138400 CALL FILES(20) 00138410 MCARDS=55 00138420 CCR IF(1660830-NX43.LE.0) NX43=0 R0138430 CCR IF(NX43.EQ.0) STOP R0138440 KK(13)=1 00138450 NEQIL=0 00138460 KRE1=0 00138470 KRE2=0 00138480 NREX=0 00138490 KRLX=0 00138500 IF(KSKIP.NE.10) GO TO 100 00138510 NEMN=(MXDF+LL)*(NSMX+MXDF)+MXDF*2+NDMX*LL 00138520 DO 50 I=1,20 00138530 50 KZ(I,1)=KZ(I,1)-NEMN 00138540 NTYP=NTYP-NEMN 00138550 N1P=N1P -NEMN 00138560 N2P=N2P -NEMN 00138570 N3P=N3P -NEMN 00138580 DO 55 I=1,MCARDS 00138590 55 KK(I)=1 00138600 GO TO 130 00138610 100 DO 110 I=1,20 00138620 DO 110 J=1,2 00138630 110 KZ(I,J)=0 00138640 REWIND 3 00138650 REWIND 9 00138660 NRNM(1)=0 00138670 NSTR=0 00138680 NDIS=0 00138690 NRES=0 00138700 IOSIG = 0 00138710 IODISP = 0 00138720 NBMSTR=0 00138730 FRSHFT=0.0 00138740 FRINIT=0.0 00138750 FREND =0.0 00138760 MODEFR=0 00138770 NRESS=0 00138780 NRESS1=0 00138790 NSELEM=0 00138800 NC=0 00138810 NLC=0 00138820 KSKIP=0 00138830 MSKIP=0 00138840 NUMEL=0 00138850 JROT=0 00138860 NUMEL2=0 00138870 NUMNP=0 00138880 XMX=5500. 00138890 KET=0 00138900 NTRI=0 00138910 NMRI=0 00138920 NTYP=0 00138930 GRAV=386.4 00138940 IPLWRT=0 00138950 NSLAVE=0 00138960 IPLWRG=0 00138970 IAISC=0 00138980 IBMSEC=0 00138990 NCOMB=0 00139000 ILDTYP=0 00139010 NLWAVE=0 00139020 ILOCAL=0 00139030 ILDMUL=0 00139040 REFT=70. 00139050 INTSTR=0 00139060 NELD=1 00139070 KELRST=0 00139080 MBAND=1 00139090 MAXDF=0 00139100 KKG=0 00139110 MXDF=1 00139120 NDMX=1 00139130 NSMX=1 00139140 NEAD=1 00139150 NDKOD=0 00139160 NADND=1 00139170 NZZAD=1 00139180 IFPR=0 00139190 IFSS=0 00139200 NITEM=0 00139210 RTOL=0.0 00139220 COFQ=0.0 00139230 NFO=0 00139240 IES=0 00139250 IRAM=0 00139260 ELPRT=IRAM.GE.1 00139270 GENPRT=IRAM.GE.1 00139280 ELPCH=IRAM.EQ.1 00139290 GENPCH=IRAM.EQ.1 00139300 GEOST=.FALSE. 00139310 NELGEO=0 00139320 LMASS=0 00139330 DO 120 I=1,MCARDS 00139340 120 KK(I)=0 00139350 130 CONTINUE 00139360 IF (PRTCOD .EQ. PRTOFF) POS = PRTDUM 00139370 IF ( PRTCOD .EQ. PRTON ) POS = POSSAV 00139380 IF(PRTCOD.NE.POS .AND. KSKIP.EQ.0) TITLE3(3) = TITHOL 00139390 IF (PRTCOD .EQ. PRTON ) PRTCOD=POS 00139400 IF(PRTCOD.NE.POS.AND.KSKIP.EQ.0) TITLE3(3)=TITHOL 00139410 IDIRC = IDIRC + 1 00139420 IF(PRTCOD.NE.POS .AND.KSKIP.EQ.0) WRITE(6,134) GSAV 00139430 133 FORMAT(1X,A3) 00139440 134 FORMAT(/ 20X,46(1H*)/20X,18HPROGRAM DIRECTIVE ,A8 , 9H HAS BEEN00139450 $ ,11H PROCESSED./20X,46(1H*)) 00139460 CALL FCOPY(L5TP6,L6TP50) 00139470 TITHOL = TITLE3(3) 00139480 IF ( KK(20) .EQ. 1 ) WRITE(6,133)POSSAV 00139490 CCCCC CCC 00139500 READ (5,140,END=520) G,IPLTH,JJ,(DUM(I),I=1,13),PRTCOD 00139510 CCCC 00139520 CCCCCC CC 00139530 CCCCC 00139540 GSAV = G 00139550 CCCCFT CCC 00139560 CCCCC 00139570 135 CONTINUE 00139580 IA=JJ(3) 00139590 IF(KSKIP.EQ.10.AND.KK(13).EQ.1) KSKIP=0 00139600 NTY=0 00139610 KG=0 00139620 140 FORMAT(A8,I2,3I5,13A4,A3) 00139630 DO 150 I=1,MCARDS 00139640 IF(G.EQ.C(I)) KG=I 00139650 150 CONTINUE 00139660 NTERM=NEAD 00139670 IF ( KG .EQ. 0 ) GO TO 1002 00139680 GO TO (160,200,230,250,290,310,320,330,340,350,360,370,410,520,53000139690 $,540,550,560,570,590,620,630,650,670,700,740,750,820,850,870, 00139700 $890,950,970,975,590,976,977,978,160, 00139710 $979,980,990,992,3000,3010,3020,3030,2270,3050,2280,2290,2300 00139720 $,2310,2330,2320),KG 00139730 160 IU=5 00139740 IF(IA .EQ.1) IU=19 00139750 IF(IU.GT.7) REWIND IU 00139760 READ (IU,170) HED,NUMNP,NUMEL,IES,NDMX 00139770 DO 161 IAPG=1,20 00139780 161 TITLE1(IAPG)=HED(IAPG) 00139790 IF(NDMX.GT.8) NDKOD=1 00139800 NADEL=1 00139810 IF(NDMX.GT.8) NADND=NDMX-8 00139820 IF(NDMX.GT.8)NADEL=NUMEL 00139830 IF(NDMX.GT.8) NEAD=NUMEL 00139840 KK(1)=1 00139850 170 FORMAT(20A4/14X,I5,20X,I5,28X,I3,1X,I2) 00139860 180 WRITE(6,190) 00139870 N1=NUMNP*3 00139880 N2=NUMEL*13+1 00139890 N3=N2+NADND*NADEL 00139900 IF(N2.GT.N1) N1=N2 00139910 IF(N1.GT.MTOT) CALL ERROR(N1-MTOT) 00139920 IF(N3.GT.MTOT) CALL ERROR(N3-MTOT) 00139930 190 FORMAT (//20X, 43HTHE PUNCHED OUTPUT FROM FEDGE IS BEING READ) 00139940 CALL RDFEDG (NUMNP,NUMEL,IES,A(1),A(1),A(N2),1,JJ,NADND,NADEL, 00139950 $NDKOD,NDMX) 00139960 GO TO 130 00139970 200 WRITE(6,210) 00139980 210 FORMAT (//20X, 51HTHE AUTOMATIC SURFACE CONSTRAINTS ARE BEING APPL00139990 $IED) 00140000 KK(2)=1 00140010 IF(IES.EQ.0) WRITE(6,220) 00140020 IF(IES.EQ.0) GO TO 130 00140030 220 FORMAT(/20X, 32HTHERE ARE NO FEDGE SURFACES.... //) 00140040 CALL AUTBND (IES,NUMNP,NMP,NML,NUMEL,NUMEL2) 00140050 NUMNP=NMP 00140060 GO TO 130 00140070 230 WRITE(6,240) 00140080 KK(3)=1 00140090 240 FORMAT (//20X, 78HPRESSURE TYPES ARE BEING SPECIFIED ON ELEMENTS T00140100 $HAT ARE ON DESIGNATED SURFACES) 00140110 NADEL=1 00140120 IF(NEAD.GT.1) NADEL=NUMEL 00140130 N2=NUMEL*5+1 00140140 IF(IES.EQ.0) WRITE(6,220) 00140150 IF(IES.EQ.0) GO TO 130 00140160 CALL AUTPR(NUMEL,A(1),IES,A(N2),NADEL,NADND) 00140170 GO TO 130 00140180 250 NP=1 00140190 IF(KK(1).GT.0.OR.KK(4).GT.0) NP=NUMNP 00140200 IF(KK(2).EQ.1.OR.KK(11).EQ.1) WRITE(6,260) 00140210 260 FORMAT (/20X, 47H...WARNING... ALL CONSTRAINTS ARE ELIMINATED ON/200140220 $0X, 49H NODES WHICH HAVE COORDINATES INPU00140230 $T./) 00140240 KK(4) =1 00140250 270 FORMAT (20A4) 00140260 NUMNP=JJ(1) 00140270 IF(NUMNP.EQ.0) NUMNP=NP 00140280 280 CONTINUE 00140290 N2=NUMNP*3 00140300 IF(N2.GT.MTOT) CALL ERROR (N2-MTOT) 00140310 NZZ=NUMNP 00140320 IF(NP.GT.NUMNP) NZZ=NP 00140330 CALL NODINP (NC,NUMNP,NP,A(1),NZZ) 00140340 GO TO 130 00140350 290 NE=1 00140360 KRE2=1 00140370 IF(KK(1).GT.0.OR.KK(5).GT.0) NE=NUMEL 00140380 KK(5) =1 00140390 IF(JJ(1).GT.NUMEL.AND. KK(31).EQ.1) KSKIP=1 00140400 IF(JJ(1).GT.NUMEL.AND. KK(31).EQ.1) WRITE(6,300) 00140410 300 FORMAT(/20X, 23H*** ERROR IN INPUT ***.,5X, 00140420 147HSOME ELEMENTS WILL HAVE NO TEMPERATURE APPLIED.,/,20X, 00140430 249HMOVE THE ELEMENTS CARDS ABOVE THE TEMPDIST CARDS.,3X, 00140440 345HPROGRAM WILL CONTINUE IN THE DATA CHECK MODE.//) 00140450 NUMEL=JJ(1) 00140460 IF(NUMEL.EQ.0) NUMEL=NE 00140470 IF(JJ(2).GT.0) NDMX=JJ(2) 00140480 IF(NDMX.LE.8) NEAD=1 00140490 IF(NDMX.GT.8) NADND=NDMX - 8 00140500 IF(NDMX.GT.8)NZZAD=NUMEL 00140510 IF(NEAD.GT.NUMEL) NZZAD=NEAD 00140520 NZZ=NUMEL 00140530 IF(NE.GT.NUMEL) NZZ=NE 00140540 N2=NZZ*13+1 00140550 N3=N2+NADND*NZZAD 00140560 IF(N3.GT.MTOT) CALL ERROR(N3-MTOT) 00140570 IF(NDMX.GT.8) NDKOD=1 00140580 RRMC = 0.0D0 R0140581 CALL QVSET(RRMC ,A(1),N3) R0140590 CALL ELINP(NUMEL,A(1),NE,NZZ,A(N2),NEAD,NZZAD,NADND,NDKOD) 00140600 N4=N3+NREX*25 00140610 N5=N4+NREX/2+1 00140620 IF(KRE1.EQ.1)CALL RESWAP(A(1),A(N2),A(N3),A(N4) 00140630 & ,NUMEL,NADND,NDKOD,NREX) 00140640 GO TO 130 00140650 310 CONTINUE 00140660 KK(6) =1 00140670 IF(PRTCOD.EQ.PRTOFF) GO TO 315 00140680 IF(POS.EQ.PRTDUM.AND.PRTCOD.NE.PRTON) GO TO 315 00140690 WRITE(6,1050) 00140700 315 CONTINUE 00140710 CALL PROPRD(A(1),NTY,7) 00140720 KZ(5,1)=NTYP+1 00140730 KZ(5,2)=NTY 00140740 NTYP=NTYP+NTY*7 00140750 GO TO 130 00140760 320 CONTINUE 00140770 KK(7) =1 00140780 IF(PRTCOD.EQ.PRTOFF) GO TO 325 00140790 IF(POS.EQ.PRTDUM.AND.PRTCOD.NE.PRTON) GO TO 325 00140800 WRITE(6,1020) 00140810 325 CONTINUE 00140820 CALL PROPRD(A(1),NTY,7) 00140830 KZ(2,1)=NTYP+1 00140840 KZ(2,2)=NTY 00140850 NTYP=NTYP+NTY*7 00140860 GO TO 130 00140870 330 CONTINUE 00140880 KK(8) =1 00140890 IF(PRTCOD.EQ.PRTOFF) GO TO 335 00140900 IF(POS.EQ.PRTDUM.AND.PRTCOD.NE.PRTON) GO TO 335 00140910 WRITE(6,1010) 00140920 335 CONTINUE 00140930 CALL PROPRD(A(1),NTY,2) 00140940 KZ(1,1)=NTYP+1 00140950 KZ(1,2)=NTY 00140960 NTYP=NTYP+NTY*2 00140970 GO TO 130 00140980 340 CONTINUE 00140990 KK(9) =1 00141000 IF(PRTCOD.EQ.PRTOFF) GO TO 345 00141010 IF(POS.EQ.PRTDUM.AND.PRTCOD.NE.PRTON) GO TO 345 00141020 WRITE(6,1030) 00141030 345 CONTINUE 00141040 CALL PROPRD(A(1),NTY,1) 00141050 KZ(3,1)=NTYP+1 00141060 KZ(3,2)=NTY 00141070 NTYP=NTYP+NTY*1 00141080 GO TO 130 00141090 350 CONTINUE 00141100 KK(10)=1 00141110 IF(PRTCOD.EQ.PRTOFF) GO TO 352 00141120 IF(POS.EQ.PRTDUM.AND.PRTCOD.NE.PRTON) GO TO 352 00141130 WRITE(6,1040) 00141140 352 CONTINUE 00141150 CALL PROPRD(A(1),NTY,2) 00141160 KZ(4,1)=NTYP+1 00141170 KZ(4,2)=NTY 00141180 NTYP=NTYP+NTY*2 00141190 IF(NTY.GT.19) WRITE(6,355) 00141200 IF(NTY.GT.19) KSKIP=1 00141210 355 FORMAT(//20X,38HONLY 19 END-RELEASE TYPES ARE ALLOWED.//) 00141220 GO TO 130 00141230 360 CONTINUE 00141240 KK(11)=1 00141250 CALL DOF(NUMNP,A(1)) 00141260 GO TO 130 00141270 370 CONTINUE 00141280 ELPCH=JJ(2).EQ.1 00141290 GENPCH=JJ(3).EQ.1 00141300 ELPRT=JJ(2).GE.1 00141310 GENPRT=JJ(3).GE.1 00141320 KK(12)=1 00141330 IU=19 00141340 REWIND IU 00141350 WRITE(IU,1810) HED,NUMNP,NUMEL,NDMX 00141360 IF(JJ(1).EQ.1) WRITE(6,380) 00141370 IF(JJ(1).NE.1) WRITE(6,375) 00141380 375 FORMAT(1X ,20X,55HTHE FINAL GEOMETRY IS BEING PUT ON TAPE 19 FOR P00141390 $LOTTING//) 00141400 380 FORMAT (1X ,20X, 61HTHE FINAL GEOMETRY IS BEING PUT ON PUNCHED CAR00141410 $DS FOR PLOTTING//) 00141420 NADEL=1 00141430 IF(NEAD.GT.1) NADEL=NUMEL 00141440 N2=NUMEL*13+1 00141450 DO 390 I=1,4 00141460 MM=10*I 00141470 390 CALL PROUT(MM,A(1),A(1),A(1),A(N2),NUMNP,NUMEL,NUMEL2,NADND,NADEL,00141480 $NDKOD,NDMX,IES) 00141490 WRITE(IU,400) 00141500 400 FORMAT (3HEND) 00141510 IF(JJ(1).EQ.1) REWIND 7 00141520 IF(JJ(1).EQ.1) CALL FCOPY(L6TP19,L5PUNC) 00141530 GO TO 130 00141540 410 CONTINUE 00141550 IF(NDYN.EQ.11)GEOST=.TRUE. 00141560 IF(NELGEO.EQ.1) GEOST=.TRUE. 00141570 IF(LMASS.EQ.0)GO TO 2040 00141580 IF(LMASS.EQ.1) GO TO 2030 00141590 GO TO 2040 00141600 2030 CONTINUE 00141610 IF(LMASS.EQ.1.AND.NDYN.GT.3.AND.NDYN.LT.7) GO TO 2040 00141620 IF(LMASS.EQ.1.AND.NDYN.EQ.11) GO TO 2040 00141630 WRITE(6,1460) LMASS,NDYN 00141640 LMASS=0 00141650 KSKIP=1 00141660 2040 CONTINUE 00141670 KLAS=KK(41)+KK(43) 00141680 IF(KLAS.EQ.0) GO TO 415 00141690 IF(KK(28).EQ.1) GO TO 415 00141700 NSTR=12 00141710 IOSIG=1 00141720 REWIND NSTR 00141730 WRITE(6,824) 00141740 WRITE(6,840)NSTR 00141750 415 IF(KK(2).EQ.0.AND.KK(11).EQ.0) WRITE(6,420) 00141760 IF(JJ(2).LT.0) NEQIL=1 00141770 IF(JJ(2).LT.0) JJ(2)=0 00141780 MBAND=JJ(2) 00141790 ISQZ=1 00141800 IF(JJ(1).LT.0) MAXDF=-JJ(1) 00141810 IF(KK(2).EQ.0.AND.KK(11).EQ.0) KSKIP=1 00141820 420 FORMAT (/20X, 35HNO CONSTRAINTS HAVE BEEN APPLIED...//) 00141830 IF(JJ(2).EQ.-999.AND.KSKIP.EQ.0) GO TO 495 00141840 IF(JJ(1).EQ.0) ISQZ=1 00141850 IF(JJ(1).GT.0) ISQZ=0 00141860 IF(NUMNP.GT.500) ISQZ=0 00141870 IF(JJ(1).EQ.2) ISQZ=1 00141880 IF(JJ(3).GT.0) KEQB=-JJ(3) 00141890 KK(13)=1 00141900 IF(KET.EQ.0.AND.TAVG.EQ.0.0) KET=-1 00141910 IF(KK(17).EQ.0) TAVG=REFT 00141920 IF(TAVG.EQ.0.0) TAVG=REFT 00141930 IF(KK(17).EQ.1) GO TO 440 00141940 NTY=LL*7 00141950 IF(KK(50).NE.1) NELD=0 00141960 KET=-1 00141970 DO 430 I=1,NTY 00141980 430 A(I)=0.0 00141990 KZ(6,1)=NTYP+1 00142000 KZ(6,2)=LL 00142010 WRITE(3) (A(I),I=1,NTY) 00142020 NTYP=NTYP+NTY 00142030 440 IF(KK( 6).EQ.1) GO TO 460 00142040 NTY=7 00142050 DO 450 I=1,NTY 00142060 450 A(I)=0.0 00142070 KZ(5,1)=NTYP+1 00142080 KZ(5,2)=1 00142090 WRITE(3) (A(I),I=1,NTY) 00142100 NTYP=NTYP+NTY 00142110 460 IF(KK(26).EQ.1) GO TO 480 00142120 NTY=10 00142130 DO 470 I=1,NTY 00142140 470 A(I)=0.0 00142150 KZ(7,1)=NTYP+1 00142160 KZ(7,2)=1 00142170 WRITE(3) (A(I),I=1,NTY) 00142180 NTYP=NTYP+NTY 00142190 480 IF(KK(10).EQ.1) GO TO 495 00142200 NTY=2 00142210 DO 490 I=1,NTY 00142220 490 A(I)=0.0 00142230 KZ(4,1)=NTYP+1 00142240 KZ(4,2)=1 00142250 WRITE(3) (A(I),I=1,NTY) 00142260 NTYP=NTYP+NTY 00142270 495 CONTINUE 00142280 IF(KK(34).EQ.1)GO TO 498 00142290 NTY=7 00142300 DO 496 I=1,NTY 00142310 496 A(I)=0. 00142320 KZ(8,1)=NTYP+1 00142330 KZ(8,2)=1 00142340 WRITE(3)(A(I),I=1,NTY) 00142350 NTYP=NTYP+NTY 00142360 498 CONTINUE 00142370 IF(KK(48).EQ.1) GO TO 2060 00142380 NTY=9 00142390 DO 2050 I=1,NTY 00142400 2050 A(I)=0.0D0 00142410 KZ(15,1)=NTYP+1 00142420 KZ(15,2)=1 00142430 WRITE(3)(A(I),I=1,NTY) 00142440 NTYP=NTYP+NTY 00142450 2060 CONTINUE 00142460 IF(KK(50).EQ.1) GO TO 2080 00142470 NTY=LL*7 00142480 DO 2070 I=1,NTY 00142490 2070 A(I)=0.0D0 00142500 KZ(16,1)=NTYP+1 00142510 KZ(16,2)=1 00142520 WRITE(3)(A(I),I=1,NTY) 00142530 NTYP=NTYP+NTY 00142540 2080 CONTINUE 00142550 IF(KK(51).EQ.1) GO TO 2100 00142560 NTY=8 00142570 DO 2090 I=1,NTY 00142580 2090 A(I)=0.0D0 00142590 KZ(17,1)=NTYP+1 00142600 KZ(17,2)=1 00142610 WRITE(3) (A(I),I=1,NTY) 00142620 NTYP=NTYP+NTY 00142630 2100 CONTINUE 00142640 IF(KK(53).EQ.1) GO TO 2120 00142650 NTY=5 00142660 DO 2110 I=1,NTY 00142670 2110 A(I)=0.0D0 00142680 KZ(18,1)=NTYP+1 00142690 KZ(18,2)=1 00142700 WRITE(3) (A(I),I=1,NTY) 00142710 NTYP=NTYP+NTY 00142720 2120 CONTINUE 00142730 IF (NDYN.EQ.7.AND.KK(33).EQ.0) KSKIP=1 00142740 IF (NDYN.EQ.7.AND.KK(33).EQ.0) WRITE(6,500) 00142750 500 FORMAT (/20X, 33HTHE DYNAMIC- INPUT WAS NOT FOUND.//) 00142760 WRITE(6,1110) 00142770 IF(KELRST.EQ.1) WRITE(6,1420) 00142780 IF(KELRST.EQ.2) WRITE(6,1430) 00142790 WRITE(6,690) REFT,GRAV 00142800 WRITE(6,2150)MTOT 00142810 2150 FORMAT(//,1H0,19X,26HSIZE OF THE BLANK COMMON =,I20) 00142820 IF(NELGEO.EQ.1)WRITE(6,1470) 00142830 IF((NDYN.EQ.8.OR.NDYN.EQ.9).AND.KK(21).EQ.0) WRITE(6,501) 00142840 IF((NDYN.EQ.8.OR.NDYN.EQ.9).AND.KK(21).EQ.0) KSKIP=1 00142850 IF(NDYN.EQ.8.AND.KK(17).EQ.0) WRITE(6,502) 00142860 IF(NDYN.EQ.8.AND.KK(17).EQ.0) KSKIP=1 00142870 501 FORMAT(/20X,47HRENUMBER MUST BE CALLED WITH JJ(3) EQUAL TO THE, 00142880 $36H NEGATIVE OF THE NO. OF SUPER NODES.//) 00142890 502 FORMAT(/20X,34HTHE LOADFACTOR INPUT MUST BE USED.//) 00142900 IF(KSKIP.NE.0) RETURN 00142910 WRITE(6,1110) 00142920 510 FORMAT( 00142930 130X,69HEEEEEEEEE NN NN DDDDDD OOOOO 00142940 2 FFFFFFFFF/ 00142950 331X,69HEEEEEEEEE NNN NN DDDDDDD OOOOOOO 00142960 4 FFFFFFFFF/ 00142970 531X,69HEE NNNN NN DD DD OO OO 00142980 6 FF / 00142990 731X,69HEE NN NN NN DD DD OO OO 00143000 8 FF / 00143010 931X,69HEEEEEE NN NN NN DD DD OO OO 00143020 X FFFFFF / 00143030 131X,69HEEEEEE NN NN NN DD DD OO OO 00143040 2 FFFFFF / 00143050 331X,69HEE NN NN NN DD DD OO OO 00143060 4 FF / 00143070 531X,69HEE NN NNNN DD DD OO OO 00143080 6 FF / 00143090 731X,69HEEEEEEEEE NN NNN DDDDDDD OOOOOOO 00143100 8 FF / 00143110 931X,55HEEEEEEEEE NN NN DDDDDD OOOOO) 00143120 511 FORMAT(1H+,90X,2HFF///// 00143130 17X,118HDDDDDD AAA TTTTTTTTTT AAA 00143140 2 IIIIIIII NN NN PPPPPPP UU UU TTTTTTTTTT/ 00143150 37X,118HDDDDDDD AAAAA TTTTTTTTTT AAAAA 00143160 4 IIIIIIII NNN NN PPPPPPPP UU UU TTTTTTTTTT/ 00143170 57X,118HDD DD AA AA TT AA AA 00143180 6 II NNNN NN PP PP UU UU TT / 00143190 77X,118HDD DD AA AA TT AA AA 00143200 8 II NN NN NN PP PP UU UU TT / 00143210 97X,118HDD DD AAAAAAAAA TT AAAAAAAAA 00143220 X II NN NN NN PPPPPPPP UU UU TT / 00143230 17X,118HDD DD AAAAAAAAA TT AAAAAAAAA 00143240 2 II NN NN NN PPPPPPP UU UU TT / 00143250 37X,118HDD DD AA AA TT AA AA 00143260 4 II NN NN NN PP UU UU TT / 00143270 57X,118HDD DD AA AA TT AA AA 00143280 6 II NN NNNN PP UU UU TT / 00143290 77X,118HDDDDDDD AA AA TT AA AA 00143300 8 IIIIIIII NN NNN PP UUUUUUUUU TT / 00143310 97X, 45HDDDDDD AA AA TT AA AA) 00143320 512 FORMAT(1H+,66X,54HIIIIIIII NN NN PP UUUUUUU 00143330 1 TT///// 00143340 213X,105HEEEEEEEEE XX XX EEEEEEEEE CCCCC UU UU 00143350 3 TTTTTTTTTT IIIIIIII OOOOO NN NN/ 00143360 413X,105HEEEEEEEEE XX XX EEEEEEEEE CCCCCCC UU UU 00143370 5 TTTTTTTTTT IIIIIIII OOOOOOO NNN NN/ 00143380 613X,105HEE XX XX EE CC CC UU UU 00143390 7 TT II OO OO NNNN NN/ 00143400 813X,105HEE XX XX EE CC UU UU 00143410 9 TT II OO OO NN NN NN/ 00143420 X13X,105HEEEEEE XXX EEEEEE CC UU UU 00143430 1 TT II OO OO NN NN NN/ 00143440 213X,105HEEEEEE XXX EEEEEE CC UU UU 00143450 3 TT II OO OO NN NN NN/ 00143460 413X,105HEE XX XX EE CC UU UU 00143470 5 TT II OO OO NN NN NN/ 00143480 613X,105HEE XX XX EE CC CC UU UU 00143490 7 TT II OO OO NN NNNN/ 00143500 813X,105HEEEEEEEEE XX XX EEEEEEEEE CCCCCCC UUUUUUUUU 00143510 9 TT IIIIIIII OOOOOOO NN NNN/) 00143520 513 FORMAT(1H+, 00143530 112X,105HEEEEEEEEE XX XX EEEEEEEEE CCCCC UUUUUUU 00143540 2 TT IIIIIIII OOOOO NN NN////) 00143550 514 FORMAT( 00143560 113X,105HIIIIIIII NN NN IIIIIIII TTTTTTTTTT IIIIIIII 00143570 2 AAA TTTTTTTTTT EEEEEEEEE DDDDDD / 00143580 313X,105HIIIIIIII NNN NN IIIIIIII TTTTTTTTTT IIIIIIII 00143590 4 AAAAA TTTTTTTTTT EEEEEEEEE DDDDDDD / 00143600 513X,105H II NNNN NN II TT II 00143610 6 AA AA TT EE DD DD / 00143620 713X,105H II NN NN NN II TT II 00143630 8 AA AA TT EE DD DD/ 00143640 913X,105H II NN NN NN II TT II 00143650 X AAAAAAAAA TT EEEEEE DD DD/ 00143660 113X,105H II NN NN NN II TT II 00143670 2 AAAAAAAAA TT EEEEEE DD DD/ 00143680 313X,105H II NN NN NN II TT II 00143690 4 AA AA TT EE DD DD/ 00143700 513X,105H II NN NNNN II TT II 00143710 6 AA AA TT EE DD DD / 00143720 713X,105HIIIIIIII NN NNN IIIIIIII TT IIIIIII 00143730 8 AA AA TT EEEEEEEEE DDDDDDD / 00143740 913X, 55HIIIIIIII NN NNN IIIIIIII TT IIIIIII) 00143750 515 FORMAT(1H+,72X,42HAA AA TT EEEEEEEEE DDDDDD) 00143760 RETURN 00143770 520 IF(KK(13).NE.1) WRITE(6,1080) 00143780 CALL FCOPY(L5TP6,L6TP50) 00143790 WRITE(6,1500) 00143800 WRITE(6,133)POSSAV 00143810 CALL FILES(37) 00143820 CALL XCOPY(L6TP50,L5TP6) 00143830 REWIND 50 00143840 ENDFILE 50 00143850 KK(14)=1 00143860 CALL CLOSE 00143870 CALL EXIT 00143880 530 CONTINUE 00143890 KK(15)=1 00143900 IF(JJ(3).GT.0) KELRST=2 00143910 WRITE(6,1090) 00143920 KG=4 00143930 KK(11)=1 00143940 KK(1)=1 00143950 IF(JJ(1).EQ.0.AND.JJ(2).EQ.0) JJ(1)=13 00143960 NRES=JJ(1) 00143970 NCRD=JJ(2) 00143980 IF(NRES.EQ.0)GO TO 130 00143990 REWIND NRES 00144000 READ (NRES) HED,NUMNP,NUMEL,NUMEL2,XMX,XAD,I1,NADND,NEAD,NDKOD 00144010 $,NDMX,IES 00144020 N2=NUMEL*13+1 00144030 NADEL=1 00144040 IF(NEAD.GT.1) NADEL=NUMEL 00144050 CALL RESTRT (NUMNP,NUMEL,NUMEL2,A(1),A(1),A(1),A(N2),NADND,NADEL, 00144060 $NDKOD,IES) 00144070 IF(NRES.EQ.NCRD)NRESS=1 00144080 NRES=0 00144090 KK(15)=0 00144100 GO TO 130 00144110 540 CONTINUE 00144120 IF(JJ(3).GT.0) NUMEL2=0 00144130 KK(16)=1 00144140 KK(11)=1 00144150 CALL ELAST(NUMEL,NUMEL2) 00144160 GO TO 130 00144170 550 CONTINUE 00144180 NTY=LL 00144190 KK(17)=1 00144200 IF(JJ(1).GT.0) JROT=1 00144210 IF(PRTCOD.EQ.PRTOFF) GO TO 555 00144220 IF(POS.EQ.PRTDUM.AND.PRTCOD.NE.PRTON) GO TO 555 00144230 WRITE(6,1060) 00144240 555 CONTINUE 00144250 CALL PROPRD(A(1),NTY,7) 00144260 KZ(6,1)=NTYP+1 00144270 KZ(6,2)=NTY 00144280 NTYP=NTYP+NTY*7 00144290 GO TO 130 00144300 560 CONTINUE 00144310 KK(18)=1 00144320 CALL MATRD (NMRI,NTRI,A(1)) 00144330 N1P= NTYP+1 00144340 N2P=N1P+NTRI*4 00144350 N3P=N2P+NMRI 00144360 NTYP=NTYP+NTRI*4+NMRI*3 00144370 GO TO 130 00144380 570 CONTINUE 00144390 KK(19)=1 00144400 IF(JJ(1).NE.0) WRITE(6,1410) JJ(1) 00144410 N2=NUMEL*13+1 00144420 IF(JJ(3).GT.0) KELRST=1 00144430 NADEL=1 00144440 IF(NEAD.GT.1) NADEL=NUMEL 00144450 IF(JJ(1).EQ.0.AND.JJ(2).EQ.0) JJ(1)=13 00144460 NRES=JJ(1) 00144470 NCWT=JJ(2) 00144480 IF(NRES.EQ.0)GO TO 130 00144490 REWIND NRES 00144500 WRITE (NRES) HED,NUMNP,NUMEL,NUMEL2,XMX,XAD,I1,NADND,NEAD,NDKOD 00144510 $,NDMX,IES 00144520 DO 580 MM=1,4 00144530 580 CALL PROUT(MM,A(1),A(1),A(1),A(N2),NUMNP,NUMEL,NUMEL2,NADND,NADEL,00144540 $NDKOD,NDMX,IES) 00144550 IF(NRES.EQ.NCWT)NRESS1=1 00144560 NRES=0 00144570 GO TO 130 00144580 590 CONTINUE 00144590 IPLT=IPLTH 00144600 REWIND 31 00144610 REWIND 32 00144620 REWIND 33 00144630 WRITE(31,1840)(DUM(I),I=1,13) 00144640 NAPGX=-1 00144650 WRITE(31,1850)NAPGX 00144660 MATCOD=IAPG1 00144670 PRTCOD=POS 00144680 KK(20)=1 00144690 DO 600 I=1,20 00144700 600 HED(I)=C111 00144710 DO 610 I=1,13 00144720 610 HED(I)=DUM(I) 00144730 DO 609 IAPG=1,20 00144740 609 TITLE1(IAPG)=HED(IAPG) 00144750 NDYN=JJ(1) 00144760 LL=JJ(2) 00144770 NF=JJ(3) 00144780 CALL HDPRNT(HED,LL,NF,NDYN,KDYN,XMX) 00144790 NCX=2 00144800 IF(LISTA.EQ.1) NCX=3 00144810 IF ( MSKIP .EQ. 0 .OR. IDIRC .GT. 2 .OR. LIST .NE. 1 .OR. LISTC 00144820 $ .NE. 0 ) GO TO 614 00144830 DO 611 I2=1,MSKIP 00144840 611 READ(5,612) IDUM 00144850 612 FORMAT(A4) 00144860 CALL INLIST(0) 00144870 REWIND 5 00144880 DO 613 I2=1,NCX 00144890 613 READ(5,612) IDUM 00144900 LISTC = 1 00144910 MSKIP=MSKIP+2 00144920 WRITE(6,615) MSKIP 00144930 615 FORMAT(//20X,84(1H*)/20X,9HTHE FIRST,I7,68H CARDS IN THE INPUT STR00144940 $EAM HAVE BEEN DELETED FROM THE INPUT LISTING./20X,84(1H*)) 00144950 614 CONTINUE 00144960 IF(LIST.EQ.1.AND.LISTC.EQ.0) CALL INLIST(NCX) 00144970 IF(LIST.EQ.1 .AND. LISTC.EQ.0) LISTC=1 00144980 LIST=0 00144990 IF(LISTA.EQ.1) WRITE(6,1120) 00145000 LISTA=0 00145010 WRITE(6,1110) 00145020 GO TO 100 00145030 620 CONTINUE 00145040 IF((NDYN.EQ.8.OR.NDYN.EQ.9).AND.JJ(3).GE.0) WRITE(6,501) 00145050 IF((NDYN.EQ.8.OR.NDYN.EQ.9).AND.JJ(3).GE.0) KSKIP=1 00145060 KK(21)=1 00145070 NRNM(1)=1 00145080 NRNM(2)=JJ(2) 00145090 NRNM(3)=JJ(3) 00145100 NW=JJ(1) 00145110 IO=2 00145120 IF(DUM(1).EQ.RNM) IO=3 00145130 IF(NW.EQ.0) NW=26 00145140 ICHM=0 00145150 IF(IPLTH.EQ.1) ICHM=1 00145160 IF(ICHM.EQ.0 .OR. ICHM.EQ.1) CALL RENUM(NW,IES) R0145170 CCR IF(ICHM.EQ.1) CALL RENUMC(NW,IES) R0145180 GO TO 130 00145190 630 CONTINUE 00145200 KSKIP=1 00145210 WRITE(6,640) 00145220 640 FORMAT (/////5X,93H**READDATA MODE AND THE FOLLOWING OUTPUT IS A C00145230 $HECK OF THE INPUT TO SAP -- NO EXECUTION *****) 00145240 GO TO 130 00145250 650 CONTINUE 00145260 ELPRT=JJ(2).GE.1 00145270 GENPRT=JJ(3).GE.1 00145280 WRITE(6,1001)HED 00145290 PRTCOD=POS 00145300 NADEL=1 00145310 IF(NEAD.GT.1) NADEL=NUMEL 00145320 N2=NUMEL*13+1 00145330 DO 660 MM=1,4 00145340 IF(MM.EQ.1.AND.NUMNP.EQ.0) GO TO 660 00145350 IF(MM.EQ.2.AND.NUMEL.EQ.0) GO TO 660 00145360 IF(MM.EQ.3.AND.NUMEL2.EQ.0) GO TO 660 00145370 IF(MM.EQ.4.AND.KK(1).EQ.0)GO TO 660 00145380 CALL PROUT(MM,A(1),A(1),A(1),A(N2),NUMNP,NUMEL,NUMEL2,NADND,NADEL,00145390 $NDKOD,NDMX,IES) 00145400 660 CONTINUE 00145410 GO TO 130 00145420 670 READ(5,680)REFT,GRAV 00145430 680 FORMAT (2F10.0) 00145440 WRITE(6,690)REFT,GRAV 00145450 690 FORMAT (1H0,19X, 28HTHE REFERENCE TEMPERATURE = ,F10.5, 7H DEG. 00145460 $/20X, 9HGRAVITY =,F10.5, 12H IN/SEC*SEC.///) 00145470 GO TO 130 00145480 700 CONTINUE 00145490 IMESH=JJ(2) 00145500 IF(IMESH.EQ.0) GO TO 735 00145510 IES= JJ(1) 00145520 READ (5,710)HED,NUMEL,NUMNP,JJ 00145530 DO 709 IAPG=1,20 00145540 709 TITLE1(IAPG)=HED(IAPG) 00145550 710 FORMAT (20A4/5I4) 00145560 KKG=1 00145570 KK(1)=1 00145580 720 WRITE(6,730) 00145590 730 FORMAT (//20X, 42HTHE PUNCHED OUTPUT FROM GRID IS BEING READ//) 00145600 N1=NUMNP*3 00145610 N2=NUMEL*13 00145620 IF(N2.GT.N1) N1=N2 00145630 IF(N1.GT.MTOT) CALL ERROR(N1-MTOT) 00145640 NADEL=1 00145650 CALL RDFEDG (NUMNP,NUMEL,IES,A(1),A(1),A(1),2,JJ,NADND,NADEL, 00145660 $NDKOD,NDMX) 00145670 GO TO 130 00145680 735 CONTINUE 00145690 IU=19 00145700 IES=0 00145710 IF(IA.EQ.1) IU=1 00145720 READ(IU,1810)HED,NUMNP,NUMEL,NDMX 00145730 DO 736 IAPG=1,20 00145740 736 TITLE1(IAPG)=HED(IAPG) 00145750 IF(NDMX.GT.8) NDKOD=1 00145760 NADEL=1 00145770 IF(NDMX.GT.8) NADND=NDMX-8 00145780 IF(NDMX.GT.8) NADEL=NUMEL 00145790 IF(NDMX.GT.8) NEAD=NUMEL 00145800 KK(1)=1 00145810 WRITE(6,1830)HED,NUMNP,NUMEL,NDMX 00145820 N1=NUMNP*3 00145830 N2=NUMEL*13+1 00145840 N3=N2+NADND*NADEL 00145850 IF(N2.GT.N1) N1=N2 00145860 IF(N1.GT.MTOT) CALL ERROR(N1-MTOT) 00145870 IF(N3.GT.MTOT) CALL ERROR(N3-MTOT) 00145880 CALL RDFEDG (NUMNP,NUMEL,IES,A(1),A(1),A(N2),3,JJ,NADND,NADEL, 00145890 $NDKOD,NDMX) 00145900 KK(11)=1 00145910 GO TO 130 00145920 740 CONTINUE 00145930 IF(JJ(1).EQ.1) GO TO 745 00145940 ICOMP=0 00145950 IF(PRTCOD.EQ.PRTOFF) GO TO 742 00145960 IF(POS.EQ.PRTDUM.AND.PRTCOD.NE.PRTON) GO TO 742 00145970 WRITE(6,1070) 00145980 742 CONTINUE 00145990 KK(26)=1 00146000 CALL PROPRD(A(1),NTY,10) 00146010 KZ(7,1)=NTYP+1 00146020 KZ(7,2)=NTY 00146030 NTYP=NTYP+NTY*10 00146040 GO TO 130 00146050 745 CONTINUE 00146060 ICOMP=1 00146070 KK(26)=1 00146080 CALL MATRDA(MMRI,MTRI,A(1)) 00146090 KZ(7,1)=NTYP+1 00146100 KZ(7,2)=MMRI 00146110 M1P=NTYP+1 00146120 M2P=M1P+MTRI*9 00146130 M3P=M2P+MMRI 00146140 NTYP=NTYP+MTRI*9+MMRI*3 00146150 GO TO 130 00146160 750 CONTINUE 00146170 NC=JJ(1) 00146180 IF(NC.EQ.0) GO TO 810 00146190 READ(5,760) ((X(I,J),Y(I,J),Z(I,J),I=1,3),J=1,NC) 00146200 760 FORMAT (3F10.0,50X) 00146210 CALL COORD (NC) 00146220 WRITE(6,770) 00146230 770 FORMAT (1X ,20X, 30H ALTERNATE COORDINATE SYSTEMS / /) 00146240 DO 800 I= 1,NC 00146250 WRITE(6,780)I 00146260 780 FORMAT (1H0,20X, 22H COORDINATE SYSTEM NO.,I2///) 00146270 DO 800 J=1,3 00146280 WRITE(6,790)J,X(J,I),Y(J,I),Z(J,I) 00146290 790 FORMAT (20X, 10H POINT NO.,I2/ 00146300 $ 20X, 3H X=,F10.4,10X, 2HY=,F10.4,10X, 2HZ=,F10.4) 00146310 800 CONTINUE 00146320 810 CONTINUE 00146330 READ(5,680)YY 00146340 GO TO 130 00146350 820 CONTINUE 00146360 WRITE(6,1110) 00146370 NDIS= JJ(1) 00146380 NSTR= JJ(2) 00146390 IF(NDIS.LT.0) WRITE(6,821) 00146400 IF(NSTR.LT.0) WRITE(6,822) 00146410 821 FORMAT(/20X,33H DISPLACEMENTS WILL NOT BE OUTPUT//) 00146420 822 FORMAT(/20X,33H STRESSES WILL NOT BE OUTPUT//) 00146430 IODISP = 0 00146440 IOSIG = 0 00146450 IF ( NDIS .EQ. 3 ) IODISP=1 00146460 IF ( NDIS .EQ. 3 ) NDIS=1 00146470 IF ( NDIS .EQ. 4 ) IODISP=1 00146480 IF ( NDIS .EQ. 4 ) NDIS=2 00146490 IF ( NSTR .EQ. 3 ) IOSIG=1 00146500 IF ( NSTR .EQ. 3 ) NSTR=1 00146510 IF ( NSTR .EQ. 4 ) IOSIG=1 00146520 IF ( NSTR .EQ. 4 ) NSTR=2 00146530 IF ( IODISP .EQ. 1 ) WRITE(6,823) 00146540 IF ( IOSIG .EQ. 1 ) WRITE(6,824) 00146550 823 FORMAT(///20X,34(1H')/20X,34HDISPLACEMENTS WILL NOT BE PRINTED./ 00146560 120X,34(1H')//) 00146570 824 FORMAT(///20X,29(1H')/20X,29HSTRESSES WILL NOT BE PRINTED./20X, 00146580 1 29(1H')//) 00146590 IF(NDIS.EQ.1) NDIS=7 00146600 IF(NDIS.EQ.2) NDIS=12 00146610 IF(NSTR.EQ.1) NSTR=7 00146620 IF(NSTR.EQ.2) NSTR=12 00146630 IF(NDIS.EQ.5) NDIS=6 00146640 IF(NSTR.EQ.5) NSTR=6 00146650 IF(NDIS.GT.7) REWIND NDIS 00146660 IF(NSTR.GT.7) REWIND NSTR 00146670 IF(NDIS.GT.1) WRITE(6,830)NDIS 00146680 IF(NSTR.GT.1) WRITE(6,840)NSTR 00146690 830 FORMAT(/20X, 36HDISPLACEMENTS WILL BE OUTPUT ON UNIT,I3/) 00146700 840 FORMAT(/20X, 36HTHE STRESSES WILL BE OUTPUT ON UNIT,I3/) 00146710 IF(JJ(3).EQ.1) INTSTR=1 00146720 GO TO 130 00146730 850 CONTINUE 00146740 WRITE(6,860) 00146750 860 FORMAT (1X ,20X, 80HSPECIFIED NODES WILL BE CONSTRAINED TO MOVE T00146760 $OGETHER IN THE INDICATED DIRECTION//16X, 00146770 $ 107HDIRECT. NODES----(NEG. INDICATES GENERATION FROM THE LA00146780 $ST NODE TO THE NEG. NODE- INCR. IS THE NEXT NO.//) 00146790 CALL TIE(A(1),NUMNP) 00146800 GO TO 130 00146810 870 XMX=2*JJ(1) 00146820 XMX=XMX+0.1*XMX 00146830 WRITE(6,880)JJ(1) 00146840 880 FORMAT (//20X, 44HTHE MAXIMUM DIMENSION THAT WILL BE ALLOWED =,I5,00146850 $ 8H INCHES.//) 00146860 GO TO 130 00146870 890 CONTINUE 00146880 IF(KK(21).EQ.1) WRITE(6,900) 00146890 900 FORMAT(/20X, 65HSINCE RENUMBERING HAS BEEN DONE, TEMPS. MAY BE AT 00146900 $THEWRONG NODES.//) 00146910 IF(KK(17).EQ.0) KSKIP=1 00146920 IF(KK(17).EQ.0) WRITE(6,910) 00146930 910 FORMAT (/20X, 46HTHE LOADFACT CARDS MUST BE INPUT BEFORE TEMPS.//)00146940 KK(31)=1 00146950 IF(KK(2).EQ.1) WRITE(6,920) 00146960 920 FORMAT (/20X, 80HSINCE A-CONSTR HAS BEEN INPUT, THERE MAY NOT BE E00146970 $NOUGH NODES ON THE TEMP. INPUT.//) 00146980 IF(NUMNP.EQ.0.OR.NUMEL.EQ.0) KSKIP=1 00146990 IF(NUMNP.EQ.0.OR.NUMEL.EQ.0) WRITE(6,930) 00147000 930 FORMAT(/20X, 46HTEMPS. MUST BE INPUT AFTER NODES AND ELEMENTS.//) 00147010 NTU=JJ(1) 00147020 IF(NTU.EQ.0)GO TO 130 00147030 WRITE(6,940) 00147040 940 FORMAT (1X ,20X, 43HTHE TEMPERATURE DISTRIBUTION IS TO BE READ , 00147050 $ 35HOFF THE PUNCHED CARDS OR MAG. TAPE.//) 00147060 CALL TEMPRD (NUMNP,NTU ,MTOT ,NTYP) 00147070 NADEL=1 00147080 IF(NEAD.GT.1) NADEL=NUMEL 00147090 N2=NUMEL*13+1 00147100 N3=N2+NADEL*NADND 00147110 N4=N3+ NDMX*LL 00147120 IF(N4.GT.MTOT) CALL ERROR(N4-MTOT) 00147130 IF(KET.LT.0.AND.KSKIP.EQ.0) CALL TEMPER(NUMEL,A(1),A(N2),A(N3), 00147140 $LL,NUMNP,NDMX,NADEL,NADND) 00147150 GO TO 130 00147160 950 WRITE(6,960) 00147170 960 FORMAT (//20X, 33HLOADS ARE TO BE READ FROM CARDS. //) 00147180 KL=1 00147190 IF(JJ(1).GT.0) KL=2 00147200 NLMAX=(MTOT-8-NUMNP)/8 00147210 N12=NLMAX*6+1 00147220 IF(KK(55).EQ.1) JJ(2)=-1 00147230 CALL CONCLD (A(1),A(N12),KL,NLMAX,NLC,JJ(2)) 00147240 GO TO 130 00147250 970 KK(33)=1 00147260 LMASS=JJ(2) 00147270 NELGEO=JJ(3) 00147280 CALL DYNIN(JJ(1),KSKIP,NDYN) 00147290 GO TO 130 00147300 975 LIST=1 00147310 PRTCOD = POS 00147320 MSKIP = JJ(1) 00147330 GO TO 130 00147340 976 REWIND 20 00147350 ENDFILE 20 00147360 GO TO 130 00147370 977 KK(34)=1 00147380 IF(PRTCOD.EQ.PRTOFF) GO TO 2261 00147390 IF(POS.EQ.PRTDUM.AND.PRTCOD.NE.PRTON) GO TO 2261 00147400 WRITE(6,1300) 00147410 2261 CONTINUE 00147420 IBMSEC=1 00147430 CALL PROPRD(A(1),NTY,7) 00147440 KZ(8,1)=NTYP+1 00147450 KZ(8,2)=NTY 00147460 NTYP=NTYP+NTY*7 00147470 WRITE(6,1400) 00147480 NBMSTR=1 00147490 GO TO 130 00147500 978 KK(35)=1 00147510 CALL MATRX(A(1),NTY,21) 00147520 KZ(9,1)=NTYP+1 00147530 KZ(9,2)=NTY 00147540 NTYP=NTYP+NTY*21 00147550 GO TO 130 00147560 979 CALL SUPEIN 00147570 GO TO 130 00147580 980 NTGRID=19 00147590 NCL = JJ(2) 00147600 NT100 = NTGRID + 100 00147610 CALL FILES(37) 00147620 REWIND 60 00147630 WRITE(60) NT100 00147640 WRITE(60) NCL 00147650 WRITE(6,982) NTGRID, NCL 00147660 982 FORMAT(1X ,/////,47X,41HSTRESS CLASSIFICATION HAS BEEN REQUESTED.,00147670 A ///,54X,23HTHE GEOMETRY IS ON TAPE,I5, 00147680 B ///,52X,I4,27H LINES HAVE BEEN SPECIFIED.) 00147690 984 IF(KK(12).EQ.1) GO TO 130 00147700 PRTCOD = POS 00147710 CALL FCOPY(L5TP6,L6TP50) 00147720 TITHOL = TITLE3(3) 00147730 WRITE(6,1500) 00147740 REWIND NTGRID 00147750 IA = NTGRID 00147760 WRITE(NTGRID,170) HED, NUMNP, NUMEL, IES, NDMX 00147770 NADEL = 1 00147780 IF ( NEAD .GT. 1 ) NADEL = NUMEL 00147790 N2 = NUMEL * 5 + 1 00147800 CALL PROUT(10,A(1),A(1),A(1),A(N2),NUMNP,NUMEL,NUMEL2,NADND,NADEL,00147810 $ NDKOD,NDMX,IES) 00147820 CALL PROUT(20,A(1),A(1),A(1),A(N2),NUMNP,NUMEL,NUMEL2,NADND,NADEL,00147830 $ NDKOD,NDMX,IES) 00147840 WRITE(NTGRID,400) 00147850 WRITE(6,1500) 00147860 TITLE3(3) = TITHOL 00147870 WRITE(6,133) POSSAV 00147880 GO TO 130 00147890 990 MATCOD=IAPG2 00147900 GO TO 130 00147910 992 NTGRID=19 00147920 WRITE(6,993) 00147930 993 FORMAT(1X ,/////,20X,54HSURFACE CLASSIFICATION OF STRESSES HAS BEE00147940 1N REQUESTED. ,/,25X,32HTHE GRID GEOMETRY IS ON TAPE 19. ,/,25X, 00147950 266HELEMENT INTEGRATION POINT STRESSES AND COORDINATES ARE ON TAPE 00147960 312. ) 00147970 KK(43)=1 00147980 GO TO 984 00147990 1000 FORMAT (1X , 67H AN ERROR WAS DETECTED IN A INSTRUCTION CARD, IT00148000 $ WAS PUNCHED AS (,A8, 32H)--NO EXECUTION WILL BE ALLOWED.//) 00148010 1001 FORMAT (1X ,20X,20A4) 00148020 1002 WRITE(6,1000)G 00148030 KSKIP=1 00148040 GO TO 130 00148050 3000 KK(44)=1 00148060 J44=1177 00148070 CALL RGSEM(A(1),NTY,J44) 00148080 KZ(10,1)=NTYP+1 00148090 KZ(10,2)=NTY 00148100 NTYP=NTYP+NTY*J44 00148110 GO TO 130 00148120 3010 KK(45)=1 00148130 IF(PRTCOD.EQ.PRTOFF) GO TO 2262 00148140 IF(POS.EQ.PRTDUM.AND.PRTCOD.NE.PRTON) GO TO 2262 00148150 WRITE(6,1600) 00148160 2262 CONTINUE 00148170 CALL PROPRD(A(1),NTY,6) 00148180 KZ(11,1)=NTYP+1 00148190 KZ(11,2)=NTY 00148200 NTYP=NTYP+NTY*6 00148210 GO TO 130 00148220 3020 KK(46)=1 00148230 KRE1=1 00148240 NNMX=51 00148250 IF(KRE2.EQ.1)KSKIP=1 00148260 IF(KRE2.EQ.1)WRITE(6,3022) 00148270 3022 FORMAT(39H ****** THE # RIGID--- # DATA SET MUST 00148280 & ,43HPRECEDE THE # ELEMENT # DATA SET. *********/ 00148290 & 33H PROCEDE IN THE DATA CHECK MODE/80(1H*)) 00148300 WRITE(6,1700) 00148310 CALL RIGRED(A(1),NTY,NNMX) 00148320 KZ(12,1)=NTYP+1 00148330 KZ(12,2)=NTY 00148340 NTYP=NTYP+NTY*NNMX 00148350 NREX=NTY 00148360 GO TO 130 00148370 3030 KK(47)=1 00148380 NNMX=10 00148390 IF(PRTCOD.EQ.PRTOFF) GO TO 3035 00148400 IF(POS.EQ.PRTDUM.AND.PRTCOD.NE.PRTON) GO TO 3035 00148410 WRITE(6,1800) 00148420 3035 CONTINUE 00148430 CALL BMLOAD(A(1),NTY,NNMX) 00148440 KZ(13,1)=NTYP+1 00148450 KZ(13,2)=NTY 00148460 NTYP=NTYP+NTY*NNMX 00148470 GO TO 130 00148480 3050 KK(49)=1 00148490 MM2=1+60 00148500 NNMX=21 00148510 CALL ELTREL(A,A(MM2),KRLX,NNMX) 00148520 KZ(14,1)=NTYP+1 00148530 KZ(14,2)=KRLX 00148540 NTYP=NTYP+KRLX*NNMX 00148550 GO TO 130 00148560 2270 KK(48)=1 00148570 IAISC=1 00148580 CALL AISCPR(A(1),NTY,9) 00148590 KZ(15,1)=NTYP+1 00148600 KZ(15,2)=NTY 00148610 NTYP=NTYP+NTY*9 00148620 GO TO 130 00148630 2280 KK(50)=1 00148640 ILDMUL=1 00148650 CALL BMFACT(A(1),NTY,7,LL) 00148660 KZ(16,1)=NTYP+1 00148670 KZ(16,2)=NTY 00148680 NTYP=NTYP+NTY*7*LL 00148690 GO TO 130 00148700 2290 KK(51)=1 00148710 ILDTYP=1 00148720 NLWAVE=JJ(1) 00148730 ILOCAL=JJ(2) 00148740 IF(JJ(1).NE.0) REWIND 58 00148750 IF(JJ(1).NE.0) WRITE(6,1860)JJ(1),JJ(1) 00148760 CALL BMLDTP(A(1),NTY,8) 00148770 KZ(17,1)=NTYP+1 00148780 KZ(17,2)=NTY 00148790 NTYP=NTYP+NTY*8 00148800 GO TO 130 00148810 2300 KK(52)=1 00148820 NCOMB=JJ(1) 00148830 CALL COMBDT(NCOMB,LL) 00148840 GO TO 130 00148850 2310 KK(53)=1 00148860 CALL BMEFF(A(1),NTY,5) 00148870 KZ(18,1)=NTYP+1 00148880 KZ(18,2)=NTY 00148890 NTYP=NTYP+NTY*5 00148900 GO TO 130 00148910 2320 KK(55)=1 00148920 GO TO 130 00148930 2330 KK(54)=1 00148940 CALL SLAVIN(A(1),NUMNP) 00148950 GO TO 130 00148960 1010 FORMAT (1X ,20X, 11HTRUSS TYPES// 00148970 $ 17H TRUSS TRUSS/ 00148980 $ 32H NO. MATL. AREA//) 00148990 1020 FORMAT (1X ,40X, 11HBEAM TYPES /40X,10(1H-)//1X,112(1H-)/ 11X, 00149000 $ 6H BEAM,11X, 7HTENSILE,9X, 3H2-2,12X, 3H3-3,9X, 9HTORSION00149010 $AL,10X,3H2-2,12X, 3H3-3/ 5H NO.,7X, 5HMATL.,3(11X, 4HAREA),1X00149020 $,3(8X, 7HINERTIA,2X),/,1X,112(1H-)) 00149030 1030 FORMAT (1X ,10X, 11HTHICK TYPES// 18H NO. THICKNESS//) 00149040 1040 FORMAT (1X ,20X, 21HBEAM-END-RELEASE SETS//10X, 00149050 $ 66HSIX DIGITS CORRESPONDING TO BEAM END FORCES--(0-FORCE IS NOT00149060 $ ZERO)/55X, 34H(1-FORCE IS ZERO- ROLLER OR HINGE)/10X, 00149070 $ 62HTHE DIGITS ARE RESPECTIVELY -- R1-1,R2-2,R3-3,M1-1,M2-2,00149080 $M3-3--// 2X,2(11X, 4HNODE)/ 4H NO.,10X, 1HI,13X, 1HJ//) 00149090 1050 FORMAT (1X ,20X, 14HPRESSURE TYPES// 00149100 $ 4H NO.,7X, 8HPRESSURE,8X, 6HZ-REF.,8X, 8HFACE NO.,2( 12H/ 00149110 $ PRESSURE ,7X, 8HFACE NO.)//) 00149120 1060 FORMAT (1X ,20X, 12HLOAD FACTORS// 20H LOAD PRESSURE,18X, 1200149130 $HTIME-OR-BODY 00149140 $ ,4X, 10HBOUND. EL., 9X, 1HX,14X, 1HY,14X, 1HZ/ 00149150 $ 23H NO. MULTIPLIER , 41H TOPT(L) TEMPE00149160 $RATURE MULTIPLIER,3(8X, 4HACC.,3X)//) 00149170 1070 FORMAT (1X ,20X, 46H ANISOTROPIC MATERIAL PROPERTIES (81-100)00149180 $//124H NO. C-XX C-XY C-XS C-YY C-YS 00149190 $ G-XY DENSITY ALPHA-XX ALPHA-YY ALPHA-XY (SHELL)/ 00149200 $ 124H E-RR E-ZZ E-THETA V-RZ V-RT 00149210 $ V-ZT G-RZ DENSITY ALPHA (AXIS.)00149220 $//) 00149230 1080 FORMAT (////10X, 47HTHIS HAS BEEN A DATA CHECK ONLY - NO EXECUTIO00149240 $N) 00149250 1090 FORMAT (1X ,20X, 38HTHIS IS A RESTART FOR A PREVIOUS MODEL//) 00149260 1100 FORMAT(1X,19A4,A3) 00149270 1110 FORMAT(1X ) 00149280 1120 FORMAT(1X ,115HWARNING-AN INSTRUCTION CARD WAS PUNCHED AS $*/1. T00149290 $HIS IS NOT A VALID INSTRUCTION FOR THE CDC VERSION OF THIS CODE./ 00149300 $9X,34HTHIS INSTRUCTION HAS BEEN IGNORED.) 00149310 1300 FORMAT(1X ,20X,23HBEAM SECTION PROPERTIES// 00149320 X2X,3HNO.,10X,5HC2(+),10X,5HC2(-),10X,5HC3(+),10X,5HC3(-), 00149330 X10X,5HQ2/B2,10X,5HQ3/B3,12X,5H KOFF//) 00149340 1400 FORMAT(/6H0NOTES / 00149350 X58H (1) ALL C ARE THE DISTANCE BTWN THE EXTREME FIBER & THE, 00149360 X13H NEUTRAL AXIS/ 00149370 X60H (2) Q IS THE FIRST MOMENT OF AREA ABOVE(OR BELOW) THE PLA, 00149380 X11HNE OF SHEAR/ 00149390 X50H (3) B IS THE WIDTH OF SECTION AT PLANE OF SHEAR/ 00149400 X49H (4) ALL C,Q,B MUST BE INPUT AS ABSOLUTE VALUES/ 00149410 X21H (5) SEE USER GUIDE) 00149420 1410 FORMAT(1X ,40HTHE COMPLETE GEOMETRY HAS BEEN STORED ON, 00149430 $16H MAG TAPE NUMBER,1X,I2,1H.) 00149440 1420 FORMAT(//20X,43HTHIS ANALYSIS WILL STOP AFTER COMPUTING THE, 00149450 $35HELEMENT STIFFNESS AND LOAD MATRICES,/20X, 00149460 $37HCATALOG TAPE21 AND TAPE22 FOR RESTART//) 00149470 1430 FORMAT(//20X,46HTHIS ANALYSIS WILL USE ELEMENT MATRICES STORED, 00149480 $21H FROM A PREVIOUS RUN./20X, 00149490 $55HTHE BANDWIDTH PRINTED ON THE RUN IS INPUT ON COL. 16-20, 00149500 $35H OF THE EXECUTE- CARD FOR THIS RUN./20X, 00149510 $51HLIKEWISE MAXDF PRINTED ON THE PREVIOUS RUN IS INPUT, 00149520 $34H N COL 21-25 OF THE EXECUTE- CARD.//) 00149530 1460 FORMAT(1X ,5X,43H**ERROR, PROBLEM IS NOT A DYNAMIC ANALYSIS.,/, 00149540 &5X,8H LMASS=,I3,2X,25HIS NOT POSSIBLE FOR NDYN=,I3,/, 00149550 $5X,48H LMASS IS RESET TO 0 AND CONTINUE IN DATA CHECK, 00149560 &5H MODE) 00149570 1470 FORMAT(19X,44HBEAM COLUMN EFFECTS TAKEN INTO CONSIDERATION, 00149580 &1X,15HIN THE ANALYSIS,/, 00149590 &19X,51HGEOMETRIC STIFFNESS ADDED TO CONVENTIONAL STIFFNESS) 00149600 1500 FORMAT (1X ) 00149610 1600 FORMAT(1X ,20X,12HBEAM OFFSETS// 00149620 &20X,6HNODE I,14X,6HNODE J/ 00149630 &4H NO.,6X,2(1HX,9X,1HY,9X,1HZ,9X)) 00149640 1700 FORMAT(1X ,20X,14HRIGID ELEMENTS//) 00149650 1800 FORMAT(1X ,25X,14HBEAM LOAD DATA) 00149660 1810 FORMAT(20A4/3I5) 00149670 1830 FORMAT(//25X,44HTHE PUNCHED OUTPUT FROM MODEL (PREPROCESSOR), 00149680 122H PROGRAM IS BEING READ,/,25X,8HTITLE - ,20A4, 00149690 1/,55X,7HNUMNP =,I5,/, 00149700 255X,7HNUMEL =,I5,/,55X,7HNDMX =,I5) 00149710 1840 FORMAT(20A4) 00149720 1850 FORMAT(5X,I5) 00149730 1860 FORMAT(1X ,30X,5HNOTE:,2X,9HTHERE ARE,I5,3X,15HADDITIONAL BEAM, 00149740 129H LOADS USED FOR EACH ELEMENT.,/,38X,18HTHEY ARE READ FROM, 00149750 234H FILE 58 AND ARE USED AS THE FIRST,/,38X,2HOF, 00149760 3I5,3X,17HSYSTEM LOAD CASES) 00149770 END 00149780 SUBROUTINE BMLDTP(PROP,II,JJ) 00028560 IMPLICIT REAL*8(A-H,O-Z) 00028570 DIMENSION PROP(200,1),DUM(10),ILC(5) 00028580 COMMON /PREP/ RDUM(2),KDUM(1),NDYN,I1,I99,POS,PRTCOD 00028590 $ ,POSSAV,PRTOFF,PRTON,PRTDUM,IDIRC 00028600 COMMON /TRASH/ TD(100,3),RRTRAS(190) R0028610 COMMON /AMB/ GRAV,REFT,JROT 00028620 CALL FILES(24) 00028630 IF(PRTCOD.EQ.PRTOFF) GO TO 95 00028640 IF(POS.EQ.PRTDUM.AND.PRTCOD.NE.PRTON) GO TO 95 00028650 WRITE(6,260) 00028660 95 CONTINUE 00028670 KMAX=0 00028680 KK=II 00028690 II=0 00028700 JK=JJ 00028710 IF(KK.LE.0) GO TO 110 00028720 JTOTAL=8 00028730 DO 100 K=1,KK 00028740 DO 100 J=1,JTOTAL 00028750 100 PROP(K,J)=0.0D0 00028760 110 CONTINUE 00028770 120 READ (5,210) K,(ILC(J),J=1,5),(DUM(J),J=6,8) 00028780 IF(K.EQ.0) GO TO 180 00028790 IF(K.GT.179) WRITE(6,230) 00028800 DO 130 J=1,5 00028810 DUM(J)=ILC(J) 00028820 130 CONTINUE 00028830 IF(PRTCOD.EQ.PRTOFF) GO TO 135 00028840 IF(POS.EQ.PRTDUM.AND.PRTCOD.NE.PRTON) GO TO 135 00028850 WRITE(6,270)K,(ILC(J),J=1,5),(DUM(J),J=6,8) 00028860 135 CONTINUE 00028870 IF(K.GT.KMAX) KMAX=K 00028880 DO 170 J=1,8 00028890 170 PROP(K,J)=DUM(J) 00028900 II=II+1 00028910 IF(K.GT.II) II=K 00028920 IF(II.GT.KMAX) II=KMAX 00028930 IF(KK.GT.0) II=KK 00028940 GO TO 120 00028950 180 JJJ=8 00028960 IF(II.EQ.0) II=1 00028970 WRITE (3) ((PROP(I,J),I=1,II),J=1,JJJ) 00028980 IF(II.GT.199 ) WRITE(6,250) 00028990 RETURN 00029000 210 FORMAT (6I5,3F10.0) 00029010 230 FORMAT ( 1X ,20X, 34HNO MORE THAN 199 TYPES MAY BE USED) 00029020 250 FORMAT(1X ,20X,38HONLY BEAM TYPES CAN HAVE MORE THAN 99, 00029030 $17H ENTRIES- (179 ).//) 00029040 260 FORMAT(1X ,30X,44H INTERMEDIATE LOAD NUMBERS, PRESSURE AND, 00029050 125H THERMAL MOMENTS ON BEAMS,/,36X,64(1H-)///,2X, 00029060 14H NO.,6X,22(1H-),1X,30HINTERMEDIATE BEAM LOAD NUMBERS 00029070 2,1X,22(1H-),5X,8HPRESSURE,5X,7HTHERMAL,7X,7HTHERMAL/,11X, 00029080 129X,22HFIVE FOR EACH BMLD-TYP,/,11X, 00029090 32X,8HBMLD (A),7X,8HBMLD (B),8X, 00029100 48HBMLD (C),9X,8HBMLD (D),10X,8HBMLD (E),8X,5HAXIAL,8X, 00029110 55HMT-22,8X,5HMT-33//) 00029120 270 FORMAT(I5,3X,I10,5X,I10,5X,I10,7X,I10,7X,I10,8X,3(1X,E12.5)) 00029130 END 00029140