Liren Large Software Subsidy 9

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

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

Wrap

Text File | 1987-04-18 | 44.7 KB | 559 lines

SUBROUTINE RECOOR(LIMIT,NUMEL,NSTOR,X,Y,Z,ICON,AX,AY MOD05524 1,ITYPE,IPS,MTYP,THICK,BETA,IELD) MOD05525 COMMON/UNIT/IN,IO,ID1,ID2,ID3,ITER,IS6,I30,I57,I58,I60 MOD05526 1,I22,I26,I27 MOD05527 COMMON/TERM1/IDIG,IELTOT,NODTOT MOD05528 DIMENSION NSTOR(LIMIT),X(LIMIT),Y(LIMIT),Z(LIMIT),ICON(NUMEL,20) MOD05529 1,AX(LIMIT),AY(LIMIT),ITYPE(NUMEL),IPS(NUMEL),MTYP(NUMEL) MOD05530 2,THICK(NUMEL),BETA(NUMEL),IELD(NUMEL),IKAR(20) MOD05531 REWIND I26 MOD05532 ITO=0 MOD05533 20 READ(I26,5,END=100,ERR=100)I,XOL,YOL,ZOL,BX,BY MOD05534 IF(I.LT.0)GO TO 200 MOD05535 IF(I.GT.LIMIT)CALL PRTERR(7) MOD05536 NSTOR(I)=I MOD05537 ITO=ITO+1 MOD05538 X(I)=XOL MOD05539 Y(I)=YOL MOD05540 Z(I)=ZOL MOD05541 AX(I)=BX MOD05542 AY(I)=BY MOD05543 5 FORMAT(I5,5F15.5) MOD05544 GO TO 20 MOD05545 100 WRITE(IO,300)ITO MOD05546 300 FORMAT(10X,'TOTAL NODES READ FROM PREVIOUS RUN ARE = ',I5) MOD05547 NODTOT=ITO MOD05548 RETURN MOD05549 200 WRITE(IO,300)ITO MOD05550 NODTOT=ITO MOD05551 ITO=0 MOD05552 201 READ(I26,205,END=250,ERR=250)J,(IKAR(K),K=1,20) MOD05553 IF(J.LT.0)GO TO 250 MOD05554 READ(I26,207)ITYPE(J),IPS(J),MTYP(J),THICK(J),BETA(J) MOD05555 1,IELD(J) MOD05556 205 FORMAT(21I5) MOD05557 207 FORMAT(3I5,2F15.5,I5) MOD05558 DO 260 MY=1,20 MOD05559 ICON(J,MY)=IKAR(MY) MOD05560 260 CONTINUE MOD05561 ITO=ITO+1 MOD05562 GO TO 201 MOD05563 250 WRITE(IO,255)ITO MOD05564 IELTOT=ITO MOD05565 255 FORMAT(10X,'TOTAL ELEMENT READ FROM PREVIOUS RUN =',I5) MOD05566 RETURN MOD05567 END MOD05568 SUBROUTINE RECO1(LIMIT,NODE,X,Y,Z) MOD05496 LOGICAL IGET,RGET MOD05497 COMMON/UNIT/INN,IOUT,IDUMY(11),I27 MOD05498 DIMENSION NODE(LIMIT),X(LIMIT),Y(LIMIT),Z(LIMIT) MOD05499 IF(IGET(ITOT))CALL PRTERR(0) MOD05500 IF(ITOT.GT.0)GO TO 10 MOD05501 WRITE(IOUT,8)ITOT MOD05502 8 FORMAT(' *** F *** TOTAL NODES TO BE READ FROM FILE 27 IS =',I5,/MOD05503 1,10X,'INPUT THE NUMBER OF NODES YOU WISH TO READ FROM FILE 27 IN' MOD05504 2,/,10X,'RCOORDINATE CARD') MOD05505 STOP MOD05506 10 REWIND I27 MOD05507 ISAVE=INN MOD05508 INN=I27 MOD05509 DO 20 I=1,ITOT MOD05510 CALL GETNL(GET001) MOD05511 IF(IGET(J))CALL PRTERR(0) MOD05512 IF(J.GT.LIMIT)CALL PRTERR(7) MOD05513 NODE(J)=J MOD05514 IF(RGET(X(J)))CALL PRTERR(0) MOD05515 IF(RGET(Y(J)))CALL PRTERR(0) MOD05516 IF(RGET(Z(J)))CALL PRTERR(0) MOD05517 20 CONTINUE MOD05518 WRITE(IOUT,40)ITOT MOD05519 40 FORMAT(' ++ W ++ TOTAL NODES READ FROM FILE 27 ARE =',I5) MOD05520 INN=ISAVE MOD05521 RETURN MOD05522 END MOD05523 SUBROUTINE CG1(IECHO) MOD00429 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC MOD00430 IMPLICIT REAL*8(A-H,O-Z) MOD00431 REAL A MOD00432 COMMON /SAP6/ ISAP6 MOD00433 COMMON /CGELE/ I MOD00434 COMMON /UNIT/ INN,IOUT,IP MOD00435 COMMON A(1) MOD00436 IB = 15 MOD00437 REWIND IP MOD00438 REWIND IB MOD00439 READ (IP,11) DUMM MOD00440 11 FORMAT(A1) MOD00441 READ (IP,11) DUMM MOD00442 READ(IP,101) NTOT MOD00443 101 FORMAT(I10) MOD00444 N1 = 1 MOD00445 N2 = N1 + NTOT*3*2 MOD00446 CALL CENT(A(N1),A(N2),IECHO,IB,NTOT) MOD00447 RETURN MOD00448 END MOD00449 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC MOD00450 SUBROUTINE JACOB1 MOD03521 IMPLICIT REAL*8 (A-H,O-Z) MOD03522 COMMON A(1) MOD03523 COMMON/JACHEK/ISEE MOD03524 COMMON/UNIT/INN,IOUT,IP MOD03525 ISEE=1 MOD03526 CALL SECOND(T1) MOD03527 WRITE(IOUT,15) MOD03528 15 FORMAT(1X,/, MOD03529 1' * * * CALCULATING JACOBIAN AND ITS DETERMINANT * * *') MOD03530 REWIND IP MOD03531 READ(IP,11,END=100,ERR=100)DUMM MOD03532 11 FORMAT(A1) MOD03533 READ(IP,11,END=100,ERR=100)DUMM MOD03534 READ(IP,101,END=100,ERR=100)NTOT MOD03535 101 FORMAT(I10) MOD03536 N1=1 MOD03537 CALL JACOB2(NTOT,A(N1)) MOD03538 ISEE=0 MOD03539 CALL SECOND(T2) MOD03540 TT=T2-T1 MOD03541 WRITE(IOUT,300)TT MOD03542 300 FORMAT(' . . . . TOTAL CPU SECOND FOR JACOBIAN CALCULATION =' MOD03543 1,E12.5) MOD03544 RETURN MOD03545 100 WRITE(IOUT,104) MOD03546 104 FORMAT(' ++ F ++ PLOT FILE IS MISSING , YOU CAN USE' MOD03547 1,/,10X,'THE JACOB COMMAND AFTER GENERATING ALL THE NODES AND' MOD03548 2,/,10X,'ELEMENT CONNECTIONS AND SAVE THEM ON DISK USING ' MOD03549 3,/,10X,'NWRITE AND EWRITE COMMAND ') MOD03550 STOP MOD03551 END MOD03552 SUBROUTINE PUSH1(LIMIT,COOR,GAUSS1) MOD05270 LOGICAL IGET,RGET,SKIP,WH MOD05271 INTEGER AGET,AGETW,WHO,SSS,STWO,TWO,WHO2 MOD05272 COMMON/UNIT/INN,IOO MOD05273 DIMENSION COOR(LIMIT,3),INDE(8),NEWIND(8),GLOB(3),GAUSS(2) MOD05274 1,INDE1(8),INDE2(8),GAUSS1(LIMIT,2) MOD05275 DATA SSS/1HS/,TWO/1H2/,LLL/1HL/ MOD05276 IF(IGET(NTIM))CALL PRTERR(0) MOD05277 IF(IGET(N1))CALL PRTERR(0) MOD05278 IF(IGET(N2))CALL PRTERR(0) MOD05279 IF(IGET(INC))CALL PRTERR(0) MOD05280 STWO=0 MOD05281 LTWO=0 MOD05282 ICON=0 MOD05283 WHO=AGETW(0) MOD05284 WHO2=AGET(2) MOD05285 SKIP=.FALSE. MOD05286 WH=.FALSE. MOD05287 IF(RGET(ZONE))GO TO 10 MOD05288 IF(ZONE.LE.0.0)ZONE=0.001 MOD05289 IF(IGET(IADD1))GO TO 10 MOD05290 IF(IGET(IADD2))GO TO 10 MOD05291 IF(IGET(IADD3))GO TO 10 MOD05292 IF(WHO.EQ.SSS)SKIP=.TRUE. MOD05293 IF(WHO.EQ.TWO.AND.WHO2.EQ.SSS)STWO=1 MOD05294 IF(WHO.EQ.SSS.AND.WHO2.EQ.LLL)LTWO=1 MOD05295 IF(WHO.EQ.LLL.AND.WHO2.EQ.SSS)LTWO=1 MOD05296 IF(STWO.NE.1)GO TO 5 MOD05297 SKIP=.TRUE. MOD05298 5 IF(LTWO.NE.1)GO TO 6 MOD05299 SKIP=.TRUE. MOD05300 6 CONTINUE MOD05301 GAUSS(2)=0. MOD05302 IF(N1.LE.0)N1=1 MOD05303 IF(N2.LE.0)N2=N1 MOD05304 IF(INC.EQ.0)INC=1 MOD05305 IF(IADD1.EQ.0)IADD1=1 MOD05306 IF(NTIM.LE.0)NTIM=1 MOD05307 10 CALL GETNL(0) MOD05308 NUM1=0 MOD05309 DO 15 I=1,8 MOD05310 IF(IGET(INDE1(I)))GO TO 10 MOD05311 IF (INDE1(I).GT.0) NUM1=NUM1+1 MOD05312 15 CONTINUE MOD05313 IF(STWO.EQ.1.OR.LTWO.EQ.1)GO TO 7 MOD05314 GO TO 16 MOD05315 7 CALL GETNL(0) MOD05316 NUM2=0 MOD05317 DO 17 I=1,8 MOD05318 IF(IGET(INDE2(I)))GO TO 10 MOD05319 IF(INDE2(I).GT.0)NUM2=NUM2+1 MOD05320 17 CONTINUE MOD05321 16 NUM=NUM1 MOD05322 DO 18 I=1,8 MOD05323 INDE(I)=INDE1(I) MOD05324 18 CONTINUE MOD05325 DO 100 K=1,NTIM MOD05326 19 IF (SKIP) NSEL=ICRSEL(INDE,NUM,NEWIND) MOD05327 DELTA=0.0 MOD05328 ICON=ICON+1 MOD05329 DO 200 NODE=N1,N2,INC MOD05330 DO 210 I=1,3 MOD05331 210 GLOB(I)=COOR(NODE,I) MOD05332 IF (SKIP) GO TO 220 MOD05333 CALL LININT (LIMIT,NUM,COOR,INDE,GLOB,GAUSS,I) MOD05334 GAUSS1(NODE,1)=GAUSS(1) MOD05335 GAUSS1(NODE,2)=GAUSS(2) MOD05336 IF (I.NE.0) WRITE (IOO,1) MOD05337 1 FORMAT (1X,'+++ F +++',1X,'DEGENERATE LINE') MOD05338 GO TO 230 MOD05339 220 CALL SURINT (LIMIT,NUM,NSEL,COOR,NEWIND,GLOB,I,GAUSS) MOD05340 GAUSS1(NODE,1)=GAUSS(1) MOD05341 GAUSS1(NODE,2)=GAUSS(2) MOD05342 IF (I.NE.0) WRITE (IOO,2) MOD05343 2 FORMAT (1X,'+++ F +++',1X,'DEGENERATE SURFACE') MOD05344 230 DO 200 I=1,3 MOD05345 IF(STWO.EQ.1.OR.LTWO.EQ.1)GO TO 201 MOD05346 GO TO 200 MOD05347 201 DX=ABS(COOR(NODE,I)-GLOB(I)) MOD05348 IF(DX.GT.DELTA)DELTA=DX MOD05349 200 COOR(NODE,I)=GLOB(I) MOD05350 IF(STWO.EQ.1.OR.LTWO.EQ.1)GO TO 202 MOD05351 GO TO 60 MOD05352 202 IF(DELTA.LE.ZONE)GO TO 70 MOD05353 IF(WH)GO TO 50 MOD05354 NUM=NUM2 MOD05355 DO 55 I=1,8 MOD05356 55 INDE(I)=INDE2(I) MOD05357 WH=.TRUE. MOD05358 IF(LTWO.EQ.1)SKIP=.FALSE. MOD05359 GO TO 19 MOD05360 50 NUM=NUM1 MOD05361 DO 56 I=1,8 MOD05362 56 INDE(I)=INDE1(I) MOD05363 WH=.FALSE. MOD05364 IF(LTWO.EQ.1)SKIP=.TRUE. MOD05365 GO TO 19 MOD05366 70 IF(STWO.EQ.1)WRITE(IOO,71)ICON,ZONE MOD05367 IF(LTWO.EQ.1)WRITE(IOO,72)ICON,ZONE MOD05368 71 FORMAT(10X,'NODES ARE PUSHED ONTO INTERSECTION OF TWO SURFACES ' MOD05369 1,/,10X, 'AFTER ',I5,' ITERATIONS FOR ZONE =',E12.5) MOD05370 72 FORMAT(10X,'NODES ARE PUSHED ONTO INTERSECTION OF LINE AND' MOD05371 1,/,10X,'SURFACE AFTER ',I5,' ITERATIONS FOR ZONE =',E12.5) MOD05372 60 N1=N1+IADD1 MOD05373 N2=N2+IADD1 MOD05374 DO 99 JJ=1,8 MOD05375 INDE1(JJ)=INDE1(JJ)+IADD2 MOD05376 INDE2(JJ)=INDE2(JJ)+IADD3 MOD05377 99 CONTINUE MOD05378 ICON=0 MOD05379 DELTA=0.0 MOD05380 100 CONTINUE MOD05381 RETURN MOD05382 END MOD05383 SUBROUTINE LININT (LIMIT,NUM,COOR,INDEX,GLOB,R,IER) MOD03770 DIMENSION COOR(LIMIT,3),INDEX(1),GLOB(3) MOD03771 DIMENSION T(3),E(3),PHI(3),PHID(3) MOD03772 LOGICAL SKIP MOD03773 R=.5D0 MOD03774 IER=0 MOD03775 SKIP=.FALSE. MOD03776 211 CONTINUE MOD03777 IF (NUM.EQ.2) GO TO 11 MOD03778 X=1.D0-R MOD03779 Y=.5D0-R MOD03780 PHI(1)=2.D0*X*Y MOD03781 PHI(2)=-2.D0*Y*R MOD03782 PHI(3)=4.D0*R*X MOD03783 X=4.D0*R MOD03784 PHID(1)=X-3.D0 MOD03785 PHID(2)=X-1.D0 MOD03786 PHID(3)=4.D0-X-X MOD03787 GO TO 22 MOD03788 11 PHI(1)=1.D0-R MOD03789 PHI(2)=R MOD03790 PHID(1)=-1.D0 MOD03791 PHID(2)=1.D0 MOD03792 22 DO 311 I=1,3 MOD03793 D=GLOB(I) MOD03794 DO 322 K=1,NUM MOD03795 J=INDEX(K) MOD03796 322 D=D-PHI(K)*COOR(J,I) MOD03797 311 E(I)=D MOD03798 IF (SKIP) GO TO 222 MOD03799 S=0.D0 MOD03800 DO 44 I=1,3 MOD03801 D=0.D0 MOD03802 DO 55 J=1,NUM MOD03803 K=INDEX(J) MOD03804 55 D=D+PHID(J)*COOR(K,I) MOD03805 T(I)=D MOD03806 44 S=S+D**2 MOD03807 IF (S.GT.0.) GO TO 66 MOD03808 IER=1 MOD03809 RETURN MOD03810 66 S=1.D0/SQRT(S) MOD03811 DO 77 I=1,3 MOD03812 77 T(I)=T(I)*S MOD03813 Y=0.D0 MOD03814 DO 233 I=1,3 MOD03815 233 Y=Y+E(I)*T(I) MOD03816 Y=Y*S MOD03817 SKIP=Y**2.LE.1.E-6 MOD03818 R=R+Y MOD03819 GO TO 211 MOD03820 222 DO 88 I=1,3 MOD03821 88 GLOB(I)=GLOB(I)-E(I) MOD03822 RETURN MOD03823 END MOD03824 SUBROUTINE DIM1(XYZ,DEN,AREA,XM1,NOD,NTOT) MOD00568 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC MOD00569 IMPLICIT REAL*8 (A-H,O-Z) MOD00570 DIMENSION XYZ(NTOT,1), NOD(1), XLENG(3) MOD00571 SQRT(X)=DSQRT(X) MOD00572 XLENGT = 0.0 MOD00573 DO 100 I = 1, 3 MOD00574 XLENG(I) = XYZ(NOD(1),I)-XYZ(NOD(2),I) MOD00575 XLENGT = XLENGT + XLENG(I)**2 MOD00576 100 CONTINUE MOD00577 XLENGT = SQRT(XLENGT) MOD00578 XM1 = XLENGT * AREA * DEN * 0.5 MOD00579 RETURN MOD00580 END MOD00581 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC MOD00582 SUBROUTINE DIM2(XYZ,DEN,THICK,XM,NOD,IEL,KIND,NTOT,N) MOD00603 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC MOD00604 IMPLICIT REAL*8 (A-H,O-Z) MOD00605 COMMON/JACHEK/ISEE,IERR MOD00606 DIMENSION XYZ(NTOT,1),XM(1),NOD(1),NOD5(4),YZ(16),DUM(3) MOD00607 IEL = 0 MOD00608 DO 100 I = 1, 8 MOD00609 XM(I) = 0.0 MOD00610 IF (NOD(I) .LE. 0) GO TO 100 MOD00611 IEL = IEL + 1 MOD00612 100 CONTINUE MOD00613 IF(ISEE.EQ.1)GO TO 80 MOD00614 IF(KIND.EQ.6 .OR. KIND.EQ.16) GO TO 400 MOD00615 80 II = 0 MOD00616 DO 200 I = 5, 8 MOD00617 NN = NOD(I) MOD00618 IF(NN .EQ. 0) GO TO 200 MOD00619 II = II + 1 MOD00620 NOD5(II) = I MOD00621 200 CONTINUE MOD00622 NND5 = IEL -4 MOD00623 I2 = 0 MOD00624 DO 310 I = 1, IEL MOD00625 II = NOD(I) MOD00626 IF (I .LE. 4) GO TO 300 MOD00627 JJ = NOD5(I-4) MOD00628 II = NOD(JJ) MOD00629 300 I2 = I2 + 2 MOD00630 YZ(I2-1) = XYZ(II,2) MOD00631 YZ(I2) = XYZ(II,3) MOD00632 310 CONTINUE MOD00633 ND = 2 * IEL MOD00634 CALL QUADM(N,ND,XM,YZ,NOD5,IEL,THICK,DEN,NND5,KIND) MOD00635 RETURN MOD00636 400 CONTINUE MOD00637 IF (KIND .EQ. 6) GO TO 450 MOD00638 IF (IEL.EQ.3 .OR. IEL.EQ.6) GO TO 440 MOD00639 IEL = 4 MOD00640 GO TO 450 MOD00641 440 IEL = 3 MOD00642 450 CALL TAREA(XYZ,NOD,1,2,3,TR,DUM,2,NTOT) MOD00643 TR = TR * DEN * THICK MOD00644 DO 510 I = 1, 3 MOD00645 XM(I) = TR MOD00646 510 CONTINUE MOD00647 IF (IEL .EQ. 4) GO TO 600 MOD00648 RETURN MOD00649 600 CONTINUE MOD00650 CALL TAREA(XYZ,NOD,1,3,4,TR,DUM,2,NTOT) MOD00651 TR = TR * DEN * THICK MOD00652 XM(1) = XM(1) + TR MOD00653 XM(3) = XM(3) + TR MOD00654 XM(4) = XM(4) + TR MOD00655 XMT = 0.0 MOD00656 DO 620 I = 1, 4 MOD00657 XMT = XMT + XM(I) MOD00658 620 CONTINUE MOD00659 DO 630 I = 1, 4 MOD00660 XM(I) = XMT / 4.0 MOD00661 630 CONTINUE MOD00662 RETURN MOD00663 END MOD00664 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC MOD00665 SUBROUTINE DIM3(XYZ,DEN,XM,NOD,IEL,NTOT,N) MOD00666 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC MOD00667 CC MOD00668 IMPLICIT REAL*8 (A-H,O-Z) MOD00669 COMMON/JACHEK/ISEE,IERR MOD00670 DIMENSION XYZ(NTOT,1),NOD(1),XM(1) MOD00671 DIMENSION XYZ1(63),NOD9(17),VECT(3),TVEC(3) MOD00672 ABS(X)=DABS(X) MOD00673 IEL = 0 MOD00674 DO 100 I = 1, 21 MOD00675 XM(I) = 0.0 MOD00676 IF (NOD(I) .LE. 0) GO TO 100 MOD00677 IEL = IEL + 1 MOD00678 100 CONTINUE MOD00679 IF ( ISEE.EQ.1) GO TO 80 MOD00680 IF (IEL .LE. 8) GO TO 500 MOD00681 80 II = 0 MOD00682 DO 200 I = 9, 21 MOD00683 NN = NOD(I) MOD00684 IF (NN .EQ. 0) GO TO 200 MOD00685 II = II + 1 MOD00686 NOD9(II) = I MOD00687 200 CONTINUE MOD00688 ND = IEL * 3 MOD00689 NND9 = IEL - 8 MOD00690 I2 = 0 MOD00691 DO 300 I = 1, IEL MOD00692 II = NOD(I) MOD00693 IF(I .LE.8) GO TO 290 MOD00694 JJ = NOD9(I-8) MOD00695 II = NOD(JJ) MOD00696 290 I2 = I2 + 3 MOD00697 XYZ1(I2-2) = XYZ(II,1) MOD00698 XYZ1(I2-1) = XYZ(II,2) MOD00699 XYZ1(I2) = XYZ(II,3) MOD00700 300 CONTINUE MOD00701 IST = 0 MOD00702 IELX = IEL MOD00703 CALL QUADM3(N,ND,XM,XYZ1,NOD9,IST,IEL,IELX,DEN,NND9) MOD00704 RETURN MOD00705 500 CONTINUE MOD00706 VOL = 0.0 MOD00707 IF (IEL .EQ. 8) GO TO 800 MOD00708 DO 600 I = 1, 3 MOD00709 VECT(I) = XYZ(NOD(5),I) - XYZ(NOD(1),I) MOD00710 600 CONTINUE MOD00711 CALL TAREA(XYZ,NOD,1,2,3,TR,TVEC,3,NTOT) MOD00712 DO 610 I = 1, 3 MOD00713 VOL = VOL + ABS(VECT(I)*TVEC(I))/3. MOD00714 610 CONTINUE MOD00715 CALL TAREA(XYZ,NOD,1,3,6,TR,TVEC,3,NTOT) MOD00716 DO 620 I = 1, 3 MOD00717 VOL = VOL + ABS(VECT(I)*TVEC(I))/3. MOD00718 620 CONTINUE MOD00719 CALL TAREA(XYZ,NOD,1,4,6,TR,TVEC,3,NTOT) MOD00720 DO 630 I = 1, 3 MOD00721 VOL = VOL + ABS(VECT(I)*TVEC(I))/3. MOD00722 630 CONTINUE MOD00723 VOL = VOL / 6.0 MOD00724 DO 700 I = 1, 6 MOD00725 XM(I) = VOL MOD00726 700 CONTINUE MOD00727 RETURN MOD00728 800 CONTINUE MOD00729 DO 810 I = 1, 3 MOD00730 VECT(I) = XYZ(NOD(6),I) - XYZ(NOD(1),I) MOD00731 810 CONTINUE MOD00732 CALL TAREA(XYZ,NOD,1,2,4,TR,TVEC,3,NTOT) MOD00733 DO 820 I = 1, 3 MOD00734 VOL = VOL + ABS(VECT(I)*TVEC(I))/3. MOD00735 820 CONTINUE MOD00736 CALL TAREA(XYZ,NOD,1,4,8,TR,TVEC,3,NTOT) MOD00737 DO 830 I = 1, 3 MOD00738 VOL = VOL + ABS(VECT(I)*TVEC(I))/3. MOD00739 830 CONTINUE MOD00740 CALL TAREA(XYZ,NOD,1,5,8,TR,TVEC,3,NTOT) MOD00741 DO 840 I = 1, 3 MOD00742 VOL = VOL + ABS(VECT(I)*TVEC(I))/3. MOD00743 840 CONTINUE MOD00744 DO 900 I = 1, 3 MOD00745 VECT(I) = XYZ(NOD(8),I) - XYZ(NOD(3),I) MOD00746 900 CONTINUE MOD00747 CALL TAREA(XYZ,NOD,2,3,4,TR,TVEC,3,NTOT) MOD00748 DO 910 I = 1, 3 MOD00749 VOL = VOL + ABS(VECT(I)*TVEC(I))/3. MOD00750 910 CONTINUE MOD00751 CALL TAREA(XYZ,NOD,3,2,6,TR,TVEC,3,NTOT) MOD00752 DO 920 I = 1, 3 MOD00753 VOL = VOL + ABS(VECT(I)*TVEC(I))/3. MOD00754 920 CONTINUE MOD00755 CALL TAREA(XYZ,NOD,3,7,6,TR,TVEC,3,NTOT) MOD00756 DO 930 I = 1, 3 MOD00757 VOL = VOL + ABS(VECT(I)*TVEC(I))/3. MOD00758 930 CONTINUE MOD00759 VOL = VOL / 8.0 MOD00760 DO 1000 I = 1, 8 MOD00761 XM(I) = VOL MOD00762 1000 CONTINUE MOD00763 RETURN MOD00764 END MOD00765 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC MOD00766 SUBROUTINE CURVE(XYZ,DEN,AREA,XM1,NOD,NTOT) MOD00583 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC MOD00584 IMPLICIT REAL*8 (A-H,O-Z) MOD00585 DIMENSION XYZ(NTOT,1),NOD(1),VECI(3),VECJ(3) MOD00586 SQRT(X)=DSQRT(X) MOD00587 AA = 0 MOD00588 AB = 0 MOD00589 DO 100 I = 1, 3 MOD00590 VECI(I) = XYZ(NOD(1),I)-XYZ(NOD(3),I) MOD00591 VECJ(I) = XYZ(NOD(2),I)-XYZ(NOD(3),I) MOD00592 AB = AB + VECI(I)*VECJ(I) MOD00593 AA = AA + VECI(I)**2 MOD00594 100 CONTINUE MOD00595 TH =DARCOS(AB/AA) MOD00596 IF (TH .LT. 0.0) TH = TH + 3.141592 MOD00597 XL = SQRT(AA) * TH MOD00598 XM1 = XL * AREA * 0.5 MOD00599 RETURN MOD00600 END MOD00601 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC MOD00602 SUBROUTINE MATRI1 MOD04077 LOGICAL IGET,RGET MOD04078 INTEGER AGET,AGETW MOD04079 COMMON/UNIT/IN,IO,IP,I1,I2,I3,I4,I5,I6,I7,I25 MOD04080 DIMENSION NPAR(20),ICO(7),PRO(8) MOD04081 DATA ICO/1HT,1H2,1H3,1HB,1HG,1HP,1HE/ MOD04082 KK=AGETW(0) MOD04083 DO 5 I=1,7 MOD04084 IF(KK.EQ.ICO(I))GO TO 7 MOD04085 5 CONTINUE MOD04086 WRITE(IO,8)KK MOD04087 8 FORMAT(' +++ F +++ ELEMENT TYPE =',A1,' IN MATERIAL' MOD04088 1,1X,'CARD IS ILLEGAL') MOD04089 STOP MOD04090 7 GO TO (100,100,100,100,100,100,100),I MOD04091 100 IF(IGET(NPAR(3)))CALL PRTERR(0) MOD04092 IF(IGET(NPAR(15)))CALL PRTERR(0) MOD04093 IF(IGET(NPAR(16)))CALL PRTERR(0) MOD04094 IF(IGET(NPAR(17)))CALL PRTERR(0) MOD04095 IF(NPAR(3).LE.0)NPAR(3)=1 MOD04096 IF(NPAR(15).LE.0)NPAR(15)=1 MOD04097 IF(NPAR(16).LE.0)NPAR(16)=1 MOD04098 IF(NPAR(17).LE.0)NPAR(17)=1 MOD04099 WRITE(I25,3500)(NPAR(K),K=3,20) MOD04100 3500 FORMAT(18I5) MOD04101 KK=NPAR(16) MOD04102 DO 3000 KKJJ=1,KK MOD04103 CALL GETNL(GET001) MOD04104 IF(IGET(N))CALL PRTERR(0) MOD04105 IF(NPAR(15).EQ.2)GO TO 11 MOD04106 IF(RGET(E))CALL PRTERR(0) MOD04107 IF(RGET(THERM))CALL PRTERR(0) MOD04108 IF(RGET(AREA))CALL PRTERR(0) MOD04109 IF(RGET(DEN))CALL PRTERR(0) MOD04110 IF(RGET(STRAI))CALL PRTERR(0) MOD04111 WRITE(I25,3501)N,E,THERM,AREA,DEN,STRAI MOD04112 3501 FORMAT(I5,5E14.7) MOD04113 GO TO 3000 MOD04114 11 IF(RGET(AREA))CALL PRTERR(0) MOD04115 IF(RGET(DEN))CALL PRTERR(0) MOD04116 IF(RGET(STRAI))CALL PRTERR(0) MOD04117 WRITE(I25,3503)N,AREA,DEN,STRAI MOD04118 3503 FORMAT(I5,3E14.7) MOD04119 NCON=NPAR(17) MOD04120 29 CALL GETNL(GET001) MOD04121 ICOUNT=0 MOD04122 DO 30 J=1,NCON MOD04123 ICOUNT=ICOUNT+1 MOD04124 IF(RGET(PRO(ICOUNT)))GO TO 29 MOD04125 IF(ICOUNT.EQ.8.AND.J.NE.NCON)CALL GETNL(GET001) MOD04126 IF(ICOUNT.EQ.8.OR.J.EQ.NCON)WRITE(I25,3505)(PRO(M),M=1,8) MOD04127 IF(ICOUNT.EQ.8.OR.J.EQ.NCON)GO TO 33 MOD04128 3505 FORMAT(8E14.7) MOD04129 IF(ICOUNT.EQ.8)ICOUNT=0 MOD04130 GO TO 30 MOD04131 33 DO 34 M=1,8 MOD04132 PRO(M)=0.0 MOD04133 34 CONTINUE MOD04134 IF(ICOUNT.EQ.8)ICOUNT=0 MOD04135 30 CONTINUE MOD04136 3000 CONTINUE MOD04137 RETURN MOD04138 END MOD04139