Liren Large Software Subsidy 9

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

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

Wrap

Text File | 1980-01-04 | 66.8 KB | 859 lines

PROGRAM SAP6P3 R0001101 IMPLICIT REAL*8(A-H,O-Z) 00001100 LOGICAL ELPRT,ELPCH,GENPRT,GENPCH,DEFPCH,GEOST 00001110 COMMON A(1) R0001550 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,NRC1 R0001370 $ /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,NUMET,NNRRC,NNRRC1 R0001521 COMMON/COMMT1/NDSSS,KDSSS,NTY,NSLDM,NBLANK,MDYN,NE2B,KRK1 R0001522 COMMON /AAA1/ ATR(8000) R0001523 COMMON /AAA2/ RKFT(4),RLDG(300),RMHI(300),B(600) R0001524 COMMON /AAA3/ TMASS(350,1),BBR(200,5) R0001525 DIMENSION KZN(20),ZD(31) 00001530 DIMENSION NEXPDT(2),NOWDTE(4) 00001540 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 SAP6PC3 STARTING **********'/) R0001612 CALL SIZER3 00001610 MTOTR = MTOT R0001612 CALL COMMRW(1) R0001611 MTOT = MTOTR R0001613 WRITE (6,991) MTOT R0001614 991 FORMAT (5X,'********* MTOT IN SAP6PC3 = ',I5/) R0001615 IF (KSKIP .EQ. 1) GO TO 185 R0001613 IF (NNRRC .EQ. 183) GO TO 183 R0001612 IF(NSELEM.LE.0) GO TO 183 00002990 183 NUMET=NUMEL+NUMEL2-NBLANK+NSELEM 00003200 MBMAX=20000 00003210 IF(MBAND.LE.0.OR.MBAND.GT.MBMAX) KSKIP=1 00003220 IF(MBAND.LE.0.OR.MBAND.GT.MBMAX) WRITE(6,184)MBAND 00003230 184 FORMAT(1X ,29HERROR--BANDWIDTH OF MESH WAS ,I6,14H. THIS IS NOT, 00003240 $ 32H A VALID VALUE. JOB TERMINATED.) 00003250 185 IF(MXDF.EQ.42.OR.MXDF.EQ.33) MXDF=24 00003260 IF(KELRST.NE.1) GO TO 189 00003270 WRITE(6,186)MBAND,MAXDF 00003280 186 FORMAT(1X ,20X,40HTHE STIFFNESS AND LOAD MATRICES HAVE BEE, 00003290 111HN COMPUTED., 00003300 $/20X,6HMBAND=,I5,11H AND MAXDF=,I5, 00003310 230H . THEY ARE TO BE INPUT ON THE, 00003320 $16H EXECUTE- CARD.///) 00003330 CALL SECOND(T(3)) 00003340 T(6)=T(3) 00003350 T(4)=T(3) 00003360 T(5)=T(3) 00003370 NNRRC = 330 R0003371 GO TO 330 00003380 189 CONTINUE 00003390 NEMN=(MXDF*MXDF-MXDF)/2+MXDF*(LL+3)+1 00003400 IF(LMASS.EQ.1) NEMN=NEMN+MXDF*(MXDF-1) 00003410 IF(GEOST)NEMN=NEMN+3*(MXDF*MXDF)+1 00003420 NEMNM=NSMX*(MXDF+LL)+MXDF+3+10*LL 00003430 IF(NDYN.EQ.3.OR.NDYN.EQ.6) NEMNM=NSMX*(MXDF+LL)+MXDF+13+10*NFREQ 00003440 IF(NEMNM.GT.NEMN) NEMN=NEMNM 00003450 IF(NSELEM.GT.0) NEMNM=MAXDF+(MAXDF*MAXDF-MAXDF)/2+MAXDF*(LL+2)+1 00003460 IF(LMASS.EQ.1.AND.NSELEM.GT.0) 00003470 $ NEMNM=NEMNM+MAXDF*(MAXDF-1) 00003480 IF(GEOST.AND.NSELEM.GT.0)NEMNM=NEMNM+3*MAXDF*MAXDF 00003490 NEMN=NEMN+3 00003500 IF(NEMNM.GT.NEMN) NEMN=NEMNM 00003510 MDYN=NDYN+1 00003520 NF=NFREQ 00003530 MODEX=KSKIP 00003540 IF(NDYN.GT.11) GO TO 330 00003550 IF(NDYN.EQ.10) GO TO 320 00003560 190 NEQB=(MTOT-NEMN)/(MBAND+LL+1)/2 00003570 IF(LMASS.EQ.1.OR.GEOST) 00003580 $NEQB=(MTOT-NEMN)/(2*MBAND+LL)/2 00003590 IF(KEQB.LT.0.AND.KEQB.NE.-99999) NEQB=-KEQB 00003600 IF(NELGEO.EQ.1) GO TO 200 00003610 GO TO (200,200,200,200,210,210,210,240,200,200,200,200,210),MDYN 00003620 200 CONTINUE 00003630 NEQB1=(MTOT-MBAND-NEMN-LL*(MBAND+2))/(3*LL+MBAND+1) 00003640 IF(LMASS.EQ.1.OR.GEOST) 00003650 $NEQB1=(MTOT-MBAND-NEMN-LL*(MBAND+2))/(3*LL+2*MBAND) 00003660 IF(NEQB1.LT.NEQB) NEQB=NEQB1 00003670 NBLOCK=(NEQ-1)/NEQB +1 00003680 IF (NEQB.GT.NEQ) NEQB=NEQ 00003690 IF(NDYN.GT.3.AND.NDYN.LT.7) GO TO 210 00003700 IF(NDYN.GT.0.AND.NDYN.LT.8) GO TO 250 00003710 IF(KEQB.EQ.-99999) GO TO 250 00003720 IF(NDYN.EQ.11) GO TO 220 00003730 CALL SECOND(T(3)) 00003740 N1=1 00003750 N2=KZ(6,1)+LL*4 00003760 N3=LL*3 00003770 CALL QVCOPY(A(N2),SET4(1),N3) 00003780 N2=NUMNP*3+N1 00003790 N3=N2+NEQ 00003800 N4=N3+NEMN 00003810 IF(N4.GT.MTOT) CALL ERROR(N4-MTOT) 00003820 IF(KSKIP.EQ.1) GO TO 201 00003830 CALL CBLOK(A(N2),A(N3),LL,NBLOCK,MCB,NUMET,MTB,MVT,NEMN) 00003840 MT2B=MTB*2 00003850 WRITE(6,510)NEQ,MBAND,MCB,NBLOCK 00003860 201 CALL SECOND(T(4)) 00003870 IF(KSKIP.EQ.1) GO TO 202 00003880 N2=N1+4 00003890 N3=N2+MCB 00003900 N4=N3+MCB 00003910 N5=N1 R0003920 N6=N5+4 00003930 N7=N6+MCB 00003940 N8=N7+MCB 00003950 N9=N4+MTB R0003960 N10=N9+NEMN 00003970 IF(N10.GT.MTOT) CALL ERROR(N10-MTOT) 00003980 NN5=MCB*LL 00003990 NN6=4+2*MCB+MTB 00004000 CALL TOTSTF( A(N5),A(N5), R0004010 $A(N6),A(N7),A(N8),A(N8),A(N9),NBLOCK,MT2B,NUMET,LL,MTB, R0004020 $MCB,NEMN,NN5,NN6) 00004030 202 CALL SECOND(T(5)) 00004040 IF(KSKIP.EQ.1) GO TO 209 00004050 MLT=MAX0(MTB,NEQ-2*MCB) 00004060 MM1=3 00004070 MM2=4 00004080 MM3=62 R0004090 MM4=10 00004100 NEQB=10 00004110 205 NN2=NEQB 00004120 NEQB=10+NEQB 00004130 IF(NEQB.GT.NEQ) GO TO 206 00004140 NN1=NEMN+LL*(NEQ+NEQB+26)+NUMNP 00004150 NN3=LL*(NEQB+16)+NUMNP*3 00004160 IF(NN3.LT.MTOT.AND.NN1.LT.MTOT) GO TO 205 00004170 206 NEQB=NN2 00004180 IF(NEQB.GT.NEQ) NEQB=NEQ 00004190 NBLK2=(NEQ-1)/NEQB+1 00004200 N1=1+10*LL 00004210 N2=N1+4 00004220 N3=N2+MCB 00004230 N4=N3+MCB 00004240 N5=N1 R0004250 N6=N5+MLT 00004260 N7=N6+4 00004270 N8=N7+MCB 00004280 N9=N8+MCB 00004290 N10=N9+LL 00004300 IF(N10.GT.MTOT) CALL ERROR(N10-MTOT) 00004310 NN4=1+10*LL+NEQB*LL+NEQ 00004320 IF(NN4.GT.MTOT) CALL ERROR(NN4-MTOT) 00004330 N10=N10-NEQ 00004340 NN1=2*MCB+4 00004350 NN2=MCB+MCB+MTB+4 00004360 NN3=MCB+MCB+MLT+4 00004370 IF(KSKIP.EQ.1) GO TO 320 00004380 IF(NDYN.NE.8) GO TO 207 00004390 N11=N10+2*NEQ 00004400 N12=N11 00004410 IF(LMASS.EQ.-1) N12=N11+NEQ 00004420 IF(N11.GT.MTOT) CALL ERROR(N11-MTOT) 00004430 IF(N12.GT.MTOT) CALL ERROR(N12-MTOT) 00004440 IF(KSKIP.EQ.1) GO TO 320 00004450 N11=N11-NEQ 00004460 N12=N12-NEQ 00004470 CALL CNDNS( A(N5),A(N5),A(N11),00004480 $A(N6),A(N6),A(N7),A(N8),A(N9),LL,NBLOCK,NEQ,MTB,MCB,MVT,MLT,MM1, 00004490 $MM2,MM3,MM4,NN1,NN2,NN3,NEQB,NBLK2,A(N10),A(N1),A(1),A(1),NUMNP 00004500 $,A(N12)) 00004510 GO TO 208 00004520 207 CONTINUE 00004530 CALL SLOWR ( A(N5),A(N5),A(N5),R0004540 $A(N6),A(N6),A(N7),A(N8),A(N9),LL,NBLOCK,NEQ,MTB,MCB,MVT,MLT,MM1, 00004550 $MM2,MM3,MM4,NN1,NN2,NN3,NEQB,NBLK2,A(N10),A(N1),A(1)) 00004560 208 CONTINUE 00004570 NBLOCK=NBLK2 00004580 N1=1+NEMN 00004590 IF(NDYN.EQ.9)NDYN=0 00004600 209 CALL SECOND(T(6)) 00004610 IF(NDYN.EQ.8) GO TO 330 00004620 NNRRC1 = 320 R0004621 GO TO 320 00004630 210 IF (NEQB.LT.NEQ) GO TO 220 00004640 IF(NOSS.EQ.1)GO TO 220 00004650 NIM=3 00004660 NC=NF + NIM 00004670 NVM=6 00004680 NCA=NEQ*MAX0(MBAND,NC) 00004690 NTOT=NCA + 4*NEQ + 2*NVM*NEQ + 5*NC 00004700 IF(LMASS.EQ.1.OR.NDYN.EQ.11)NTOT=NTOT+NEQ*(MBAND-1) 00004710 NEIG=0 00004720 IF(NTOT.LE.MTOT) GO TO 230 00004730 220 NV=MIN0(2*NF,NF+8) 00004740 IF(NFVC.GT.0) NAD=NFVC 00004750 IF(NFVC.GT.0) NFVC=0 00004760 IF (NAD.NE.0) NV=NAD 00004770 NEQB1=(MTOT - MBAND)/(2*MBAND + 1) 00004780 IF(LMASS.EQ.1.OR.NDYN.EQ.11) 00004790 $NEQB1=(MTOT - MBAND)/(3*MBAND) 00004800 NEQB2=(MTOT - MBAND - 2*NV - NV*(MBAND-2))/(3*NV + MBAND + 1) 00004810 IF(LMASS.EQ.1.OR.NDYN.EQ.11) 00004820 $NEQB2=(MTOT - MBAND - 2*NV - NV*(MBAND-2))/(3*NV + 2*MBAND) 00004830 NEQB3=(MTOT - 3*NV*NV - 3*NV)/(2*NV + 1) 00004840 NEQB4=(MTOT - 6*NV)/(1 + MBAND) 00004850 IF(LMASS.EQ.1.OR.NDYN.EQ.11) 00004860 $NEQB4=(MTOT-6*NV)/(2*MBAND) 00004870 IF (NEQB1.LT.NEQB) NEQB=NEQB1 00004880 IF (NEQB2.LT.NEQB) NEQB=NEQB2 00004890 IF (NEQB3.LT.NEQB) NEQB=NEQB3 00004900 IF (NEQB4.LT.NEQB) NEQB=NEQB4 00004910 NEIG=1 00004920 230 CONTINUE 00004930 NBLOCK = (NEQ-1)/NEQB +1 00004940 IF (NEQB.GE.NEQ) NEQB=NEQ 00004950 IF(NDYN.EQ.11) GO TO 250 00004960 KREM = 1000 00004970 NTOT = NBLOCK*NEQB*NF + KREM 00004980 IF(MTOT.LT.NTOT) 00004990 $WRITE (6,540)NTOT,MTOT 00005000 IF(MTOT.LT.NTOT)KSKIP=1 00005010 GO TO 250 00005020 240 CONTINUE 00005030 NN2 = NEQ 00005040 NN3 = NEQ 00005050 NEQB1 = (MTOT-NN2-NN3-NEQ-MBAND)/(2*MBAND+1) 00005060 NEQB2 = (MTOT-MBAND-2*(NN2+NN3)-5*NEQ)/(MBAND+1) 00005070 IF(NEQB1.LT.NEQB) NEQB = NEQB1 00005080 IF(NEQB2.LT.NEQB) NEQB = NEQB2 00005090 IF(NEQB.GT.NEQ) NEQB = NEQ 00005100 NBLOCK = (NEQ-1)/NEQB +1 00005110 NN2 = 10 00005120 NN3 = 40 00005130 NN4 = 3*NUMNP + 2*NN2*NEQ 00005140 IF(NN4.GT.MTOT) 00005150 $WRITE (6,540)NN4,MTOT 00005160 IF(NN4.GT.MTOT)KSKIP=1 00005170 NN4 = NEQ*2*(NN2+1) + NN2*(1+2*NN3) 00005180 IF(NN4.GT.MTOT) 00005190 $WRITE (6,540)NN4,MTOT 00005200 IF(NN4.GT.MTOT)KSKIP=1 00005210 250 CONTINUE 00005220 MMA=1 00005230 IF(LMASS.EQ.1) MMA=MBAND 00005240 N4=N2+NEQB*LL 00005250 N3=N4+NEQB*MMA 00005260 N5=N3+6*LL 00005270 NSLDM=NSLAVE 00005280 IF(NSLDM.EQ.0) NSLDM=1 00005290 N6=N5+NSLDM*4 00005300 IF(N6.GT.MTOT) CALL ERROR(N6-MTOT) 00005310 WRITE (6,510) NEQ,MBAND,NEQB,NBLOCK 00005320 CALL SECOND(T(3)) 00005330 IF(NLC.LE.0.AND.KSKIP.EQ.1) GO TO 255 00005340 CALL INL(A(N1),A(N2),A(N3),A(N4),NUMNP,NEQB,LL,MMA,A(N6),NSLDM) R0005350 255 CONTINUE 00005360 NE2B=2*NEQB 00005370 N1=1+NEMN 00005380 CALL SECOND(T(4)) 00005390 IF(KSKIP.EQ.1) GO TO 270 00005400 NY=NUMET 00005410 IF(NUMET.LE.0) WRITE(6,260) 00005420 IF(NUMET.LE.0) KSKIP=1 00005430 260 FORMAT(//20X, 23H ALL ELEMENTS ARE BLANK//) 00005440 NN2=N1+NEQB*MBAND 00005450 NN3=NN2+NEQB*LL 00005460 NLCMR2 = NN2 R0005451 DO 264 JJ=1,LL R0005452 DO 263 II=1,NEQB R0005453 BBR(II,JJ) = A(NLCMR2) R0005454 263 NLCMR2 = NLCMR2 + 1 R0005455 264 CONTINUE R0005456 WRITE (6,2003) NN1,NN2,NN3 2003 FORMAT (5X,'*** NN1 NN2 NN3 ***',3I5/) CC WRITE (6,2001) (BBR(II,JJ),II=1,NEQB) C2001 FORMAT (1X,'**B B B**',11E10.3/) NLCMR3 = NN3 R0005461 DO 265 II=1,NEQB R0005461 TMASS(II,1) = A(NLCMR3) R0005462 NLCMR3 = NLCMR3 + 1 R0005463 265 CONTINUE R0005464 CC WRITE (6,2002) (TMASS(II,1),II=1,NEQB) C2002 FORMAT (1X,'**TMASS**',11E10.3/) NN4=N1 R0005470 IF(LMASS.EQ.1) NN4=NN3 + NEQB * MBAND R0005480 MMA=1 00005490 IF(LMASS.EQ.1) MMA=MBAND 00005500 NN5=NN4+NEQB*MBAND 00005510 NN6=NN5+NEQB*LL 00005520 CALL ADDSTF( A(NN4), NUMET,NBLOCK,R0005530 $NE2B,LL,MBAND,NEQB,NEMN,ANORM,NVV,MMA) 00005540 270 CALL SECOND(T(5)) 00005550 MODEX=KSKIP 00005560 280 CONTINUE 00005570 CCR IF(NELGEO.EQ.1) GO TO 290 R0005580 320 CONTINUE R0005581 330 CONTINUE R0005582 CALL COMMRW(0) R0005583 WRITE (*,1099) R0005584 1099 FORMAT (5X,'************ SAP6PC3 FINISHED ************') R0005585 510 FORMAT(34H1 TOTAL NUMBER OF EQUATIONS =,I5, 00007430 $ /34H BANDWIDTH =,I5, 00007440 $ /34H NUMBER OF EQUATIONS IN A BLOCK =,I5, 00007450 $ /34H NUMBER OF BLOCKS =,I5) 00007460 540 FORMAT (// 47H ** WARNING. ESTIMATE OF STORAGE FOR A DYNAMIC, 00007670 $ 32H ANALYSIS EXCEEDS AVAILABLE CORE, 00007680 &/31H CONTINUE IN THE READDATA MODE/15H MTOT REQUIRED=, 00007690 &I10,/17H MTOT AVAILABLE =,I10) 00007700 CC STOP R0007771 END 00007780 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 CLOSE RETURN END SUBROUTINE EXIT WRITE (6,101) 101 FORMAT (5X,'******** SAP6 PROGRAM STOP ********') STOP END SUBROUTINE TOTSTF ( AT2,JFT,LDG2,MHI2,A2,B2,SS,NR0308420 1BLOCK,MT2B,NUMEL,LL,MTB,MCB,NEMN,LBRD,NWTOT) 00308430 IMPLICIT REAL*8(A-H,O-Z) 00308440 REAL*8 NPAR 00308450 REAL*8 MHI,KFT,LDG,JFT,LDG2,MHI2 00308460 LOGICAL ELPRT,ELPCH,GENPRT,GENPCH 00308470 COMMON/CTL/ELPRT,ELPCH,GENPRT,GENPCH 00308480 COMMON /PREP/ XD(2),NSTOP,NDYN,NRPREP(15) R0308490 COMMON /SQZ/ ISQZ,NRSQZ(5),NRC1 R0308510 COMMON /JUNK/ NC1,NC2,NC,NORDER(200),LP1,KST,KST2,KND,KND2,LBK,LT,00308520 1N,K,II,JLOC,ND,NDP,KK,JJ,KCOL,MADD,LMI,LMII,IJ,NRJUNK(231) R0308530 COMMON /ELPAR/ NPAR(14),NUMNP,MBAND,NELTYP,N1,N2,N3,N4,N5,MTOT,NEQ00308540 & ,RRELPA(24) R0308541 COMMON /FORCE/ NLC,NELD 00308550 COMMON /AAA1/ A(8000) R0308551 COMMON /AAA2/ KFT(4),LDG(300),MHI(300),B(600) R0308552 CC DIMENSION MHI(MCB), LDG(MCB), B(LBRD), A(MTB), SS(1) R0308560 DIMENSION MHI2(MCB), LDG2(MCB), B2(LBRD), A2(MTB), SS(1) R0308570 DIMENSION JFT(4), AT2(NWTOT) R0308580 CALL FILES(3) 00308590 NRC2 = 0 R0308600 NRC3 = 1 R0308610 ZER=0.0 00308620 ANORM=0.0D0 00308630 AMIN=1.0D30 00308640 AMAX=-AMIN 00308650 NDEG=0 00308660 IF (NSTOP.GT.0) RETURN 00308670 NTA=4 00308680 CALL RDWRT (NTA,AT,1,6,INUM) 00308690 LP1=1+LL 00308700 NT2=2 00308710 REWIND 3 00308720 X=NBLOCK 00308730 MB=DSQRT(X) 00308740 MB=MB/2+1 00308750 MM=1 00308760 NTMM=3 00308770 NEBB=NEQ 00308780 KINC=NBLOCK*20/100 00308790 IF (KINC.LT.1) KINC=1 00308800 NORED=0 00308810 DO 360 N=1,NBLOCK,2 00308820 CALL QVSET (ZER,A,MTB) 00308830 CALL QVSET (ZER,A2,MTB) 00308840 READ (3) NC1,INUM,KFT,(LDG(IR),IR=1,MCB),(MHI(IR),IR=1,MCB), $ (B(IR),IR=1,LBRD) RKND=KFT(4) R0308860 RKST=KFT(3) R0308870 KND = RKND KST = RKST KST2=KST 00308880 KND2=KND 00308890 NC2=0 00308900 IF (N.EQ.NBLOCK) GO TO 120 00308910 READ (3) NC2,NEBB,JFT,LDG2,MHI2,B2 R0308920 RKST2=JFT(3) R0308930 RKND2=JFT(4) R0308940 KST2 = RKST2 KND2 = RKND2 LBK=NC2*LL+1 00308950 NC2P=NC2+1 00308960 DO 110 KK=1,NC2 00308970 K=NC2P-KK 00308980 RLDGK=LDG2(K) R0308990 LDGK = RLDGK DO 110 II=1,LL 00309000 I=LP1-II 00309010 LBK=LBK-1 00309020 A2(LDGK+I)=B2(LBK) 00309030 110 B2(LBK)=0.0 00309040 120 NC=NC1 00309050 IF (NRC3 .EQ. 1) WRITE (6,1002) KFT,JFT 1002 FORMAT (1X,'****** KFT JFT ***',8E11.4/) IF (N.EQ.NBLOCK) NEBB=NEQ 00309060 LBK=NC*LL+1 00309070 NC1P=NC1+1 00309080 DO 130 KK=1,NC 00309090 K=NC1P-KK 00309100 RLDGK=LDG(K) R0309110 LDGK = RLDGK DO 130 II=1,LL 00309120 I=LP1-II 00309130 LBK=LBK-1 00309140 A(LDGK+I)=B(LBK) 00309150 130 B(LBK)=0.0 00309160 CALL RDWRT (NT2,A,1,6,INUM) 00309170 NT=0 00309180 REWIND 10 00309190 LT=0 00309200 CALL RDWRT (NTMM,A,1,6,INUM) 00309210 NUME=NUM10 00309220 IDELT=1 00309230 NEND=NEQ+1 00309240 IF (MM.NE.1) GO TO 140 00309250 NUME=NUMEL 00309260 IDELT=100 00309270 NUM10=0 00309280 140 DO 300 K=1,NUME,IDELT 00309290 NUM=MIN0(NUMEL-LT*100,100) 00309300 IF (MM.GT.1) NUM=1 00309310 LT=LT+1 00309320 IF (NORED.EQ.0.AND.MM.EQ.1) READ (10) NORDER 00309330 DO 290 NT=1,NUM 00309340 IF (NBLOCK.LE.2) GO TO 150 00309350 IF (MM.GT.1) GO TO 160 00309360 NNT=NT*2 00309370 NST=NORDER(NNT-1) 00309380 NEND=NORDER(NNT) 00309390 IF (NST.GT.KND2.AND.NST.LE.NEBB) GO TO 270 00309400 IF (NST.GT.NEBB.OR.NEND.LT.KST) GO TO 260 00309410 150 CALL RDWRT(NT2,SS,NEMN,0,KOUNT) 00309420 GO TO 170 00309430 160 CALL RDWRT (NTMM,SS,NEMN,0,KOUNT) 00309440 170 ND=SS(KOUNT) 00309450 IF (SS(ND).LT.KST) GO TO 290 00309460 NDP=ND+1 00309470 NTOT=(ND*ND-ND)/2+ND 00309480 KK=NTOT+1 00309490 DO 240 I=1,ND 00309500 JLOC=I 00309510 LMI=SS(I) 00309520 IF (LMI.LT.KST) GO TO 230 00309530 IF (LMI.GT.KND) GO TO 200 00309540 KCOL=LMI-KST+1 00309550 RENUM = LDG(KCOL) MA= RENUM -LMI R0309560 DO 180 II=1,I 00309570 JLOC=JLOC+NDP-II 00309580 LMII=SS(II) 00309590 MADD=MA+LMII 00309600 180 A(MADD)=A(MADD)+SS(JLOC) 00309610 IF(NELD.EQ.1) GO TO 185 00309620 MA=MADD+LL 00309630 IF(NDYN.EQ.8) A(MA)=A(MA)+SS(KK+ND) 00309640 GO TO 230 00309650 185 CONTINUE 00309660 J=KK 00309670 DO 190 LC=1,LL 00309680 MA=MADD+LC 00309690 J=J+ND 00309700 190 A(MA)=A(MA)+SS(J) 00309710 IF(NDYN.EQ.8) A (MA)=A (MA)+SS(J+ND)-SS(J) 00309720 GO TO 230 00309730 200 CONTINUE 00309740 IF (LMI.GT.KND2) GO TO 250 00309750 KCOL=LMI-KST2+1 00309760 RENUM2 = LDG2(KCOL) MA= RENUM2 -LMI R0309770 DO 210 II=1,I 00309780 JLOC=JLOC+NDP-II 00309790 LMII=SS(II) 00309800 MADD=MA+LMII 00309810 210 A2(MADD)=A2(MADD)+SS(JLOC) 00309820 IF(NELD.EQ.1) GO TO 215 00309830 MA=MADD+LL 00309840 IF(NDYN.EQ.8) A2(MA)=A2(MA)+SS(KK+ND) 00309850 GO TO 230 00309860 215 CONTINUE 00309870 J=KK 00309880 DO 220 LC=1,LL 00309890 MA=MADD+LC 00309900 J=J+ND 00309910 220 A2(MA)=A2(MA)+SS(J) 00309920 IF(NDYN.EQ.8) A2(MA)=A2(MA)+SS(J+ND)-SS(J) 00309930 230 KK=KK+1 00309940 240 CONTINUE 00309950 250 CONTINUE 00309960 IF (MM.NE.1) GO TO 290 00309970 IF (NEND.GT.KND2.AND.NST.LE.NEBB) GO TO 280 00309980 GO TO 290 00309990 260 CALL RDWRT(NT2,SS,1,3,KOUNT) 00310000 GO TO 290 00310010 270 CALL RDWRT (NT2,SS,NEMN,0,KOUNT) 00310020 280 CALL RDWRT (NTMM,SS,KOUNT,1,INUM) 00310030 NUM10=NUM10+1 00310040 290 CONTINUE 00310050 IF (NUMEL.LE.100) NORED=1 00310060 300 CONTINUE 00310070 DO 310 IJ=1,NC1 00310080 RMNM=LDG(IJ) R0310090 MNM = RMNM IF (A(MNM).GT.0.) GO TO 1005 00310100 I=KST+IJ-1 00310110 WRITE(6,340) I 00310120 NSTOP=1 00310130 1005 ANORM=ANORM+A(MNM) 00310140 IF(A(MNM).NE.0.0D0.AND.A(MNM).LT.AMIN) AMIN=A(MNM) 00310150 IF(A(MNM).GT.AMAX) AMAX=A(MNM) 00310160 IF(A(MNM).NE.0)NDEG=NDEG+1 00310170 310 CONTINUE 00310180 IF(.NOT.GENPRT) GO TO 1100 00310190 WRITE(6,1500)N 00310200 DO 1010 IJ=1,NC1 00310210 I=KST+IJ-1 00310220 RMNM=LDG(IJ) R0310230 MNM = RMNM MAXH=MHI(IJ) 00310240 KL=MNM-MAXH 00310250 IF(GENPCH) WRITE(7,1520)I,MAXH 00310260 IF(GENPCH) WRITE(7,1510)(A(KL+J),J=1,MAXH) 00310270 WRITE(6,1520)I,MAXH 00310280 WRITE(6,1530)(A(KL+J),J=1,MAXH) 00310290 1010 CONTINUE 00310300 WRITE(6,1550) 00310310 DO 1020 IJ=1,NC1 00310320 I=KST+IJ-1 00310330 RMNM=LDG(IJ) R0310340 MNM = RMNM IF(GENPCH) WRITE(7,1510)(A(MNM+J),J=1,LL) 00310350 1020 WRITE(6,1540)I,(A(MNM+J),J=1,LL) 00310360 1100 CONTINUE 00310370 IF (N.EQ.NBLOCK) GO TO 330 00310380 DO 320 IJ=1,NC2 00310390 RMNM=LDG2(IJ) R0310400 MNM = RMNM IF (A2(MNM).GT.0.0) GO TO 1105 00310410 I=KST2+IJ-1 00310420 WRITE(6,340) I 00310430 NSTOP=1 00310440 1105 ANORM=ANORM+A2(MNM) 00310450 IF(A2(MNM).NE.0.0D0.AND.A2(MNM).LT.AMIN) AMIN=A2(MNM) 00310460 IF(A2(MNM).GT.AMAX) AMAX=A2(MNM) 00310470 IF(A2(MNM).NE.0)NDEG=NDEG+1 00310480 320 CONTINUE 00310490 IF(.NOT.GENPRT) GO TO 1200 00310500 MP1=N+1 00310510 WRITE(6,1500)MP1 00310520 DO 1110 IJ=1,NC2 00310530 I=KST2+IJ-1 00310540 RMNM=LDG2(IJ) R0310550 MNM = RMNM MAXH=MHI2(IJ) 00310560 KL=MNM-MAXH 00310570 IF(GENPCH) WRITE(7,1520)I,MAXH 00310580 IF(GENPCH) WRITE(7,1510)(A(KL+J),J=1,MAXH) 00310590 WRITE(6,1520)I,MAXH 00310600 WRITE(6,1530)(A2(KL+J),J=1,MAXH) 00310610 1110 CONTINUE 00310620 WRITE(6,1550) 00310630 DO 1120 IJ=1,NC2 00310640 I=KST2+IJ-1 00310650 RMNM=LDG2(IJ) R0310660 MNM = RMNM IF(GENPCH) WRITE(7,1510)(A(MNM+J),J=1,LL) 00310670 1120 WRITE(6,1540)I,(A2(MNM+J),J=1,LL) 00310680 1200 CONTINUE 00310690 330 CONTINUE 00310700 IF (NSTOP.EQ.1) GO TO 360 00310710 340 FORMAT (/31H ZERO DIAGONAL EQUATION NUMBER ,I5,21H EXECUTION TERMI00310720 1NATED) 00310730 CC CALL SQEEZE (AT,NWTOT,NTA,ISQZ) 00310740 NRC1 = 0 R0310741 IF (MTB .GT. 8000) NRC1 = 1 R0310742 IF (NRC3 .EQ. 1) WRITE (6,1007) NRC1,NRC2 NRC2 = NRC2 + 1 1007 FORMAT (5X,'**** NRC1 NRC2 ****',2I5/) WRITE (4) KFT,(LDG(IR),IR=1,MCB),(MHI(IR),IR=1,MCB) R0310743 IF (NRC1 .EQ. 1) WRITE (4) (A(IR),IR=1,8000) R0310744 IF (NRC1 .EQ. 1) WRITE (4) (A(IR),IR=8000,MTB) R0310745 IF (NRC1 .EQ. 0) WRITE (4) (A(IR),IR=1,MTB) R0310745 IF (N.EQ.NBLOCK) GO TO 360 00310750 IF (MM.EQ.MB) MM=0 00310760 MM=MM+1 00310770 IF(KPR.EQ.0) WRITE(6,350)PER 00310780 CC CALL SQEEZE (AT2,NWTOT,NTA,ISQZ) R0310790 WRITE (4) JFT,(LDG2(IR),IR=1,MCB),(MHI2(IR),IR=1,MCB) R0310791 IF (NRC1 .EQ. 1) WRITE (4) (A2(IR),IR=1,8000) R0310791 IF (NRC1 .EQ. 1) WRITE (4) (A2(IR),IR=8000,MTB) R0310792 IF (NRC1 .EQ. 0) WRITE (4) (A2(IR),IR=1,MTB) R0310793 PER=(N+1)*100.0/X 00310800 KPR=MOD(N+1,KINC) 00310810 350 FORMAT (20X,F7.2,41H PERCENT OF THE MASTER STIFFNESS AND LOAD, 00310820 130H MATRICES HAVE BEEN ASSEMBLED.///) 00310830 360 CONTINUE 00310840 IF(NDEG.GT.0) GO TO 1300 00310850 WRITE(6,1560) 00310860 STOP 00310870 1300 ANORM=(ANORM/NDEG)*1.0D-8 00310880 RATIO=1.0D30 00310890 IF(AMIN.NE.0.0D0) RATIO=AMAX/AMIN 00310900 AAVG=ANORM*1.0D8 00310910 WRITE(6,1570)AMIN,AMAX,RATIO,AAVG 00310920 WRITE(6,370) 00310930 370 FORMAT (20X,48HTHE MASTER STIFFNESS AND LOAD MATRICES HAVE BEEN, 00310940 111H ASSEMBLED.//) 00310950 RETURN 00310960 1500 FORMAT(17H OVERALL MATRICES,1X,5HBLOCK,I3,//, 00310970 117H STIFFNESS MATRIX) 00310980 1510 FORMAT((1P8E10.3)) 00310990 1520 FORMAT (1X,17HEQUATION NUMBER =,I5,5X,15HHT. OF COLUMN =,I5) 00311000 1530 FORMAT ( (1X ,1P10E13.4)) 00311010 1540 FORMAT( (1X,I5,1P10E12.4,/(6X,1P10E12.4))) 00311020 1550 FORMAT(///,12H LOAD MATRIX) 00311030 1560 FORMAT (51H0STRUCTURE WITH NO DEGREES OF FREEDOM CHECK DATA ) 00311040 1570 FORMAT(5X,27HSTIFFNESS MATRIX PARAMETERS,//, 00311050 1 15X,34HMINIMUM NON-ZERO DIAGONAL ELEMENT=,1PD10.3,/, 00311060 2 15X,34HMAXIMUM DIAGONAL ELEMENT =, D10.3,/, 00311070 3 15X,34HMAXIMUM/MINIMUM =, D10.3,/, 00311080 4 15X,34HAVERAGE DIAGONAL ELEMENT =, D10.3) 00311090 END 00311100 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 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 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