Liren Large Software Subsidy 9

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

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

Wrap

Text File | 1987-06-12 | 73.6 KB | 920 lines

SUBROUTINE TDFE(ID,PROP1,PROP2,PROP3,PROP4,PROP5,PROP6,PROP7,LM, 00290970 $S,RF,XM,SA,SF,TEMPD,KK1,KK2,KK3,KK4,KK5,KK6,KK7,IX,IA,NEL,NUMNP, 00290980 $NDMX,NSMX,MXDF,MMA) 00290990 IMPLICIT REAL*8 (A-H,O-Z) 00291000 REAL*8 ID,LM 00291010 REAL*8MODUE 00291020 COMMON /QTSARG/ SS(136),D(4,4),P(2,8),YZ(16),H(8),XX(16),TAU(4), 00291030 $PROP(10),B(4,16),XJ(2,2),HP(16),UP(16),THIC,BET,DE,DET,NOD(8), 00291040 $NOD5(8),IEL,NND5,ITYP2D,IMASS,MODEL,MEL,NINT,NINTOP,RRQTSA(662) R0291050 COMMON /ELTEMP/TAVG,RRELTE(102) R0291060 COMMON /CG/ SCG(4),RRCG(2) R0291070 COMMON /PREP/ XZ(2),KSKIP 00291080 $,NDYN,NRPREP(15) R0291090 COMMON /TRASH/ BS(4,16),H4(4),TM(4,4,2),ASCN,BSCN,CSCN,ASMN, 00291100 1BSMN,RS,FN(8,2),IDK,LST,RRTRAS(367) R0291110 COMMON /AMB/ GRAV,REFT,JROT 00291120 COMMON /ELPAR/ XPAR(14),NZQ,MBAND,NZD(8),N2P,N3P,NMRI,NTRI,N1P 00291130 & ,NRELPA(43) R0291131 COMMON/MASS/LMASS 00291140 DIMENSION LM(MXDF),RF(MXDF,KK6),S(MXDF,MXDF),SA(NSMX,MXDF), 00291150 $SF(NSMX,KK6),TEMPD(NDMX,KK6) 00291160 DIMENSION PROP6(KK6,7),ITABLE(13),PROP3(1),PROP7(KK7,10) 00291170 DIMENSION PROP5(KK5,7),XM(MXDF,MMA) 00291180 DIMENSION IX(13),ID(NUMNP,3) 00291190 COMMON A(1) 00291200 COMMON /ICM/ICOMP,MMRI,MTRI,M1P,M2P,M3P 00291210 DIMENSION EVAL(13,2) 00291220 COMMON /GASS/ XK(4,4),WGT(4,4),IPERM(3) R0291230 DATA EVAL/ 00291240 $ 1.0,-1.0,-1.0, 1.0, 0.0,-1.0, 0.0, 1.0, 0.0, 0.0, 0.0, 0.0, 0.0, 00291250 $ 1.0, 1.0,-1.0,-1.0, 1.0, 0.0,-1.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0/ 00291260 LL=KK6 00291270 MEL=NEL 00291280 IMASS=1 00291290 DO 100 I=2,9 00291300 100 ITABLE(I)=0 00291310 ITABLE(1)=9 00291320 IF(IX(4).EQ.0) IX(4)=IX(3) 00291330 LST=0 00291340 IF(IX(4).EQ.IX(3).AND.IX(7).EQ.IX(3)) LST=1 00291350 J=1 00291360 IEL=0 00291370 DO 110 I=1,8 00291380 IF(IX(I).EQ.0) GO TO 110 00291390 IEL=IEL+1 00291400 J=J+1 00291410 ITABLE(J)=I 00291420 110 NOD(I)=IX(I) 00291430 IF (IEL.EQ.4) GO TO 130 00291440 II=0 00291450 DO 120 I=5,8 00291460 NN=NOD(I) 00291470 IF (NN.EQ.0) GO TO 120 00291480 II=II + 1 00291490 NOD5 (II)=I 00291500 120 CONTINUE 00291510 130 CONTINUE 00291520 140 I2=0 00291530 DO 160 I=1,IEL 00291540 II=NOD (I) 00291550 IF (I.LE.4) GO TO 150 00291560 JJ=NOD5 (I-4) 00291570 II=NOD (JJ) 00291580 150 I2=I2 + 2 00291590 CALL UNPKID(ID,NUMNP,LM(I2-1),W,2,II,2) 00291600 CALL UNPKID(ID,NUMNP,LM(I2) ,W,2,II,3) 00291610 CALL UNPKID(ID,NUMNP,W,YZ(I2-1),1,II,2) 00291620 160 CALL UNPKID(ID,NUMNP,W,YZ(I2) ,1,II,3) 00291630 IF(JROT.EQ.0) GO TO 164 00291640 I2=-1 00291650 DO 162 I=1,IEL 00291660 I2=I2+2 00291670 162 CALL CENT(YZ(I2),YZ(I2+1),FN(I,1),FN(I,2)) 00291680 164 CONTINUE 00291690 NS=J*4 00291700 IF(IX(3).EQ.IX(4)) NS=4 00291710 IF(IEL.LE.4) NS=4 00291720 NTH=IX(10) 00291730 THIC=1.0E0 00291740 IF(NTH.LE.KK3.OR.IX(13).NE.12) GO TO 180 00291750 WRITE(6,170)NEL 00291760 170 FORMAT(//20X, 30HTHE THICKNESS TYPE FOR ELEMENT,I5/20X, 36HDOES NO00291770 $T EXIST, EXECUTION WILL STOP.//) 00291780 KSKIP=1 00291790 RETURN 00291800 180 CONTINUE 00291810 IF(IX(13).EQ.12) THIC=PROP3(NTH) 00291820 ITYP2D=0 00291830 IF(IX(13).EQ.12) ITYP2D=2 00291840 IF(IX(13).EQ.13) ITYP2D=1 00291850 BET=0.00E0 00291860 MAT=IX(9) 00291870 IF(MAT.GT.80) GO TO 210 00291880 MODEL=1 00291890 IF(MAT.GT.18.AND.NTRI.EQ.0) WRITE(6,190)NEL 00291900 IF(MAT.GT.18.AND.NTRI.EQ.0) MAT=1 00291910 190 FORMAT (//20X, 45HNO USER SUPPLIED MATERIALS ARE AVAIL. FOR EL.,I500291920 $/) 00291930 IF(MAT.GT.18) GO TO 200 00291940 PROP(1)= MODUE(TAVG,MAT) 00291950 PROP(2)=PRATO (TAVG,MAT) 00291960 PROP(8)=DENS(TAVG,MAT)/1728.0E0/GRAV 00291970 PROP(9)=ALPHZM(TAVG,MAT) 00291980 IF(ITYP2D.EQ.1) PROP(9)=PROP(9)*(1+PROP(2)) 00291990 GO TO 240 00292000 200 CALL MATEV(MAT,NMRI,NTRI,TAVG,PROP(1),PROP(2),PROP(9),PROP(8), 00292010 $A(N1P),A(N2P),A(N3P),NEL) 00292020 PROP(8)=PROP(8)/GRAV 00292030 GO TO 240 00292040 210 CONTINUE 00292050 IF(ICOMP.NE.1) GO TO 215 00292060 CALL MATEVA(MAT,MMRI,MTRI,TAVG,A(M1P),A(M2P),A(M3P),NEL,PROP) 00292070 PROP(8)=PROP(8)/GRAV 00292080 MODEL=2 00292090 BET=0.0 00292100 GO TO 240 00292110 215 CONTINUE 00292120 I=MAT-80 00292130 MODEL=2 00292140 IF(I.GT.KK7) WRITE(6,220)NEL 00292150 IF(I.GT.KK7) KSKIP=1 00292160 IF(I.GT.KK7) RETURN 00292170 220 FORMAT(/20X, 51HA ANISOTROPIC MATERIAL IS NOT AVAILABLE FOR ELEMEN00292180 $T ,I5//) 00292190 BET=PROP7(I,10) 00292200 DO 230 JK=1,9 00292210 230 PROP(JK)=PROP7(I,JK) 00292220 PROP(8)=PROP(8)/GRAV 00292230 240 CONTINUE 00292240 NINT=3 00292250 NINTOP=IX(12) 00292260 IF(NDYN.EQ.7) NINTOP=9 00292270 IF(NINTOP.GT.9.AND.NINTOP.LE.2) NINT=2 00292280 IF(NINTOP.GT.0.AND.NINTOP.LE.2) NINTOP=2 00292290 IF(IEL.LE.4) NINT=2 00292300 DO 245 I=1,2 00292310 EVAL(10,I)=XK(NINT,NINT) 00292320 EVAL(12,I)=-EVAL(10,I) 00292330 EVAL(13,I)= EVAL(10,I) 00292340 EVAL(13,2)=-EVAL(10,I) 00292350 245 EVAL(11,I)=-EVAL(13,I) 00292360 IF(MAT.EQ.19.OR.MAT.EQ.20) NINT=1 00292370 IF(NINT.EQ.1) MODEL=3 00292380 ND=2*IEL 00292390 NND5=IEL - 4 00292400 DE=PROP(8) 00292410 DO 250 I=1,136 00292420 250 SS(I)=0.0E0 00292430 CALL QUADS(ND,SS,RF,PROP6,LL,TEMPD,NDMX,MXDF,REFT,XM) 00292440 IF(KSKIP.EQ.1) RETURN 00292450 IF(LST.EQ.0) GO TO 255 00292460 NS=20 00292470 ITABLE(5)=5 00292480 IF(IX(6).GT.0) ITABLE(6)=6 00292490 IF(IX(6).GT.0) NS=NS+4 00292500 IF(IX(8).LE.0) GO TO 255 00292510 NS=NS+4 00292520 IF(IX(6).EQ.0) ITABLE(6)=8 00292530 IF(IX(6).GT.0) ITABLE(7)=8 00292540 255 CONTINUE 00292550 KK=0 00292560 DO 260 I=1,ND 00292570 DO 260 J=I,ND 00292580 KK=KK+1 00292590 260 S(J,I)=SS(KK) 00292600 IF(NINT.EQ.1) GO TO 380 00292610 IF(NS.LE.4) GO TO 265 00292620 J=NS/4 00292630 DO 262 I=10,13 00292640 J=J+1 00292650 262 ITABLE(J)=I 00292660 NS=NS+16 00292670 265 CONTINUE 00292680 KK=NS/4 00292690 JJ=KK-3 00292700 IF(NS.EQ.4) JJ=1 00292710 DO 320 II=JJ,KK 00292720 I4=4*(II-1) 00292730 I=ITABLE(II) 00292740 CALL DERIQ(NEL,YZ,B,DET,EVAL(I,1),EVAL(I,2),X1BAR,NOD5,1) 00292750 DO 300 L=1,LL 00292760 TOPT=PROP6(L,2) 00292770 IF(TOPT.EQ.0) GO TO 300 00292780 IF(TOPT.EQ.2) TEMP=PROP6(L,3) 00292790 IF(TOPT.NE.1) GO TO 280 00292800 TEMP=0.0E0 00292810 KL=0 00292820 DO 270 K=1,8 00292830 IF(IX(K).EQ.0) GO TO 270 00292840 KL=KL+1 00292850 TEMP=TEMP+H(KL)*TEMPD(K,L) 00292860 270 CONTINUE 00292870 280 CONTINUE 00292880 TEMP=TEMP-REFT 00292890 DO 290 LK=1,2 00292900 IM=I4+LK 00292910 290 SF(IM,L)=-TAU(LK)*TEMP 00292920 IF(ITYP2D.EQ.2) GO TO 300 00292930 IM=4+4*(II-1) 00292940 SF(IM,L)=-TAU(4)*TEMP 00292950 300 CONTINUE 00292960 DO 310 LK=1,4 00292970 IM=I4+LK 00292980 DO 310 MK=1,ND 00292990 DO 310 NK=1,4 00293000 SA(IM,MK)=SA(IM,MK)+D(LK,NK)*B(NK,MK) 00293010 310 CONTINUE 00293020 IF(I.LT.10) GO TO 320 00293030 TEMP=0.0 00293040 X1BAR=0.0 00293050 DO 312 LK=1,IEL 00293060 X1BAR=X1BAR+H(LK)*YZ(2*LK-1) 00293070 312 TEMP=TEMP+H(LK)*YZ(LK*2) 00293080 TEMP=TEMP/XZ(1)+XZ(2) 00293090 X1BAR=X1BAR/XZ(1)+XZ(2) 00293100 MK=SF(I4+3,1) 00293110 NK=SF(I4+4,1) 00293120 SF(I4+3,1)=MK+X1BAR 00293130 SF(I4+4,1)=NK+TEMP 00293140 320 CONTINUE 00293150 IF(NS.EQ.4) GO TO 328 00293160 RS=1.0/XK(NINT,NINT) 00293170 RSF=0.0 00293180 IF(NINT.EQ.3) RSF=1.0/3.0 00293190 ASCN=(1.0+RS/2.0)-RSF 00293200 BSCN=-0.5+RSF 00293210 CSCN=2.0-ASCN-2.0*RSF 00293220 ASMN=(1.0+RS)/4.0 00293230 BSMN=0.5-ASMN 00293240 DO 321 I=1,4 00293250 TM(I,I,1)=ASCN 00293260 321 TM(I,I,2)=ASMN 00293270 DO 322 I=1,3 00293280 J=I+1 00293290 TM(I,J,1)=BSCN 00293300 TM(J,I,1)=BSCN 00293310 TM(I,J,2)=ASMN 00293320 322 TM(J,I,2)=BSMN 00293330 DO 323 I=1,2 00293340 J=I+2 00293350 TM(I,J,1)=CSCN 00293360 TM(J,I,1)=CSCN 00293370 TM(I,J,2)=BSMN 00293380 323 TM(J,I,2)=BSMN 00293390 TM(1,4,1)=BSCN 00293400 TM(4,1,1)=BSCN 00293410 TM(4,1,2)=ASMN 00293420 TM(1,4,2)=BSMN 00293430 DO 325 I=1,4 00293440 LK=(KK+I)*4-20 00293450 DO 325 J=1,4 00293460 II=LK+J 00293470 DO 324 L=1,LL 00293480 324 SF(J,L)=SF(J,L)+0.25*SF(II,L) 00293490 DO 325 K=1,ND 00293500 325 SA(J,K)=SA(J,K)+0.25*SA(II,K) 00293510 JJ=JJ-1 00293520 DO 327 NK=2,JJ 00293530 IM=1 00293540 IF(ITABLE(NK).GT.4) IM=2 00293550 IROW=ITABLE(NK)-4*IM+4 00293560 DO 327 I=1,4 00293570 TEMP=TM(IROW,I,IM) 00293580 KL=NK*4-4 00293590 LK=(KK+I)*4-20 00293600 DO 327 J=1,4 00293610 II=LK+J 00293620 MK=KL+J 00293630 DO 326 L=1,LL 00293640 326 SF(MK,L)=SF(MK,L)+TEMP*SF(II,L) 00293650 DO 327 K=1,ND 00293660 327 SA(MK,K)=SA(MK,K)+TEMP*SA(II,K) 00293670 328 CONTINUE 00293680 IF(DE.EQ.0.0) GO TO 341 00293690 IF(LMASS.NE.1) GO TO 1330 00293700 DO 1300 I=1,ND 00293710 1300 XM(I,I)=XM(I,1) 00293720 DO 1320 I=1,ND 00293730 IRK=I+1 00293740 IF(IRK.GT.ND) GO TO 1320 00293750 DO 1310 J=IRK,ND 00293760 XM(I,J)=0.0E0 00293770 1310 XM(J,I)=XM(I,J) 00293780 1320 CONTINUE 00293790 1330 CONTINUE 00293800 DO 340 I=1,LL 00293810 IF(JROT.EQ.1) GO TO 334 00293820 IF(PROP6(I,6).EQ.0.0E0.AND.PROP6(I,7).EQ.0.0E0) GO TO 340 00293830 ACZ=PROP6(I,7)*GRAV 00293840 ACR=PROP6(I,6) 00293850 IF(ITYP2D.EQ.0) ACR=PROP6(I,6)**2/GRAV 00293860 ACR=ACR*GRAV 00293870 DO 330 J=1,ND,2 00293880 ACC=ACR 00293890 IF(ITYP2D.EQ.0) ACC=ACR*YZ(J) 00293900 IRK=1 00293910 IF(LMASS.EQ.1)IRK=J 00293920 RF(J,I)=RF(J,I)+ACC*XM(J,IRK) 00293930 IRK=1 00293940 IF(LMASS.EQ.1)IRK=J+1 00293950 330 RF(J+1,I)=RF(J+1,I)+ACZ*XM(J+1,IRK) 00293960 GO TO 340 00293970 334 ACR=PROP6(I,5) 00293980 ACC=PROP6(I,6) 00293990 IM2=-1 00294000 IRK1=1 00294010 IRK2=1 00294020 DO 335 J=1,IEL 00294030 IM2=IM2+2 00294040 IM1=IM2+1 00294050 IF(LMASS.NE.1) GO TO 1350 00294060 IRK1=IM1 00294070 IRK2=IM2 00294080 1350 CONTINUE 00294090 RF(IM2,I)=RF(IM2,I)+XM(IM2,IRK2)*(ACR*FN(J,1)+ACC*FN(J,2)) 00294100 335 RF(IM1,I)=RF(IM1,I)+XM(IM1,IRK1)*(ACR*FN(J,2)-ACC*FN(J,1)) 00294110 340 CONTINUE 00294120 341 CONTINUE 00294130 NPR=IX(11) 00294140 IF(NPR.LE.0) GO TO 380 00294150 IF(NPR.LE.KK5) GO TO 360 00294160 WRITE(6,350)NEL 00294170 350 FORMAT(//20X, 44HTHE PRESSURE TYPE DOES NOT EXIST FOR ELEMENT,I5/ 00294180 $ 20X, 21H EXECUTION WILL STOP.//) 00294190 KSKIP=1 00294200 RETURN 00294210 360 DO 370 I=1,7 00294220 370 XX(I)=PROP5(NPR,I) 00294230 CALL PLD2D(PROP6,LL,RF,MXDF) 00294240 IF(KSKIP.EQ.1) RETURN 00294250 380 CONTINUE 00294260 IF(LST.LE.0) GO TO 381 00294270 IEL=6 00294280 LM(7)=0. 00294290 LM(8)=0. 00294300 LM(13)=0. 00294310 LM(14)=0. 00294320 381 CONTINUE 00294330 IF(DE.EQ.0.0) GO TO 391 00294340 IF(NDYN.NE.7) GO TO 388 00294350 WT=0.0 00294360 IRK=1 00294370 DO 382 IM=2,ND,2 00294380 IF(LMASS.EQ.1)IRK=IM 00294390 382 WT=WT+XM(IM,IRK) 00294400 WT=WT/IEL 00294410 IRK=1 00294420 DO 383 IM=2,ND,2 00294430 IF(LMASS.EQ.1)IRK=IM 00294440 XM(IM,IRK)=WT 00294450 IRK=1 00294460 IF(LMASS.EQ.1)IRK=IM-1 00294470 383 XM(IM-1,IRK)=WT 00294480 388 CONTINUE 00294490 XMCG=2.0E0*3.14159265E0 00294500 IF(ITYP2D.NE.0) XMCG=1.0 00294510 XMY=1.0 00294520 IF(ITYP2D.EQ.0)XMY=0.0 00294530 IRK=1 00294540 DO 390 J=2,ND,2 00294550 IF(LMASS.EQ.1)IRK=J 00294560 SCG(2)=SCG(2)+XMY*YZ(J-1)*XM(J,IRK) 00294570 SCG(3)=SCG(3)+XMCG*YZ(J)*XM(J,IRK) 00294580 390 SCG(4)=SCG(4)+XMCG*XM(J,IRK) 00294590 391 CONTINUE 00294600 IF(NINT.EQ.1) GO TO 401 00294610 IF(NND5.EQ.0) GO TO 401 00294620 L=(NS-16)/4 00294630 DO 400 I=2,L 00294640 J=ITABLE(I) 00294650 KNT=(I-1)*4+3 00294660 400 SF(KNT,1)=IX(J)/10000. 00294670 401 CONTINUE 00294680 CALL WRITET(MBAND,NDIF,IX(13),ND,NS,LM,SA) 00294690 RETURN 00294700 END 00294710 SUBROUTINE QUADS (ND,S,RF,PROP6,LL,TEMPD,NDMX,MXDF,REFT,XM) 00192410 IMPLICIT REAL*8 (A-H,O-Z) 00192420 COMMON /PREP/ FZ(2),KSKIP,RRPREP(8) R0192430 COMMON /QTSARG/ SS(136),D(4,4),P(2,8),YZ(16),H(8),XX(16),TAU(4), 00192440 $PROP(10),B(4,16),XJ(2,2),HP(16),UP(16),THIC,BET,DE,DET,NOD(8), 00192450 $NOD5(8),IEL,NND5,ITYP2D,IMASS,MODEL,NEL,NINT,NINTOP,RRQTSA(662) R0192460 COMMON /TRASH/ BS(4,16),H4(4),RRTRAS(422) R0192470 COMMON/GASS/XG(4,4),WGT(4,4),IPERM(3) R0192480 DIMENSION DB(4) 00192490 DIMENSION S(1),RF(MXDF,LL),TEMPD(NDMX,LL),PROP6(LL,7) 00192500 DIMENSION XM(1) 00192510 IST=4 00192520 IF (ITYP2D.NE.0) IST=3 00192530 NINTR=NINT 00192540 NINTS=NINT 00192550 IF(NINTOP.EQ.1) NINTR=NINT-1 00192560 IF(NINTOP.EQ.2) NINTS=NINT-1 00192570 IF(NINT.EQ.1) NINTR=3 00192580 IF(NINT.EQ.1) NINTS=3 00192590 ZER=0.0E0 00192600 WGH=0.0 00192610 CALL STSTL (NEL,YZ,PROP,D) 00192620 IF(KSKIP.EQ.1) RETURN 00192630 DO 340 LX=1,NINTR 00192640 E1=XG(LX,NINTR) 00192650 DO 340 LY=1,NINTS 00192660 E2=XG(LY,NINTS) 00192670 WT=WGT(LX,NINTR)*WGT(LY,NINTS) 00192680 CALL MEMSET(ZER,BS,64) 00192690 CALL DERIQ (NEL,YZ,B,DET,E1,E2,XBAR,NOD5,0) 00192700 IF(KSKIP.EQ.1) RETURN 00192710 IF (IST.EQ.3) XBAR=THIC 00192720 FAC=WT*XBAR*DET 00192730 IF(DE.LE.0.0) GO TO 110 00192740 FACM=FAC*DE 00192750 IF(NINTOP.EQ.9) GO TO 101 00192760 DO 100 I=1,IEL 00192770 IK=2*I-1 00192780 100 XM(IK)=XM(IK)+FACM*H(I) 00192790 GO TO 110 00192800 101 IK=1 00192810 DO 105 I=1,ND,2 00192820 XM(I)=XM(I)+H(IK)*H(IK)*FACM 00192830 105 IK=IK+1 00192840 WGH=WGH+FACM 00192850 110 CONTINUE 00192860 KL=1 00192870 DO 140 J=1,ND,2 00192880 DO 120 K=1,3 00192890 DB(K)=D(K,1)*B(1,J) 00192900 BS(K,J)=DB(K) 00192910 120 DB(K)=DB(K)*FAC 00192920 DB(3)=DB(3)+D(3,3)*B(3,J)*FAC 00192930 DO 130 I=J,ND,2 00192940 S(KL)=S(KL) + B(1,I)*DB(1) + B(3,I)*DB(3) 00192950 KL=KL + 1 00192960 S(KL)=S(KL) + B(2,I+1)*DB(2) + B(3,I+1)*DB(3) 00192970 130 KL=KL + 1 00192980 140 KL=KL + ND - J 00192990 KL=ND + 1 00193000 DO 190 J=2,ND,2 00193010 DO 150 K=1,3 00193020 DB(K)=D(K,2)*B(2,J) 00193030 BS(K,J)=DB(K) 00193040 150 DB(K)=DB(K)*FAC 00193050 DB(3)=DB(3)+D(3,3)*B(3,J)*FAC 00193060 KS=KL 00193070 DO 160 I=J,ND,2 00193080 S(KS)=S(KS) + B(2,I)*DB(2) + B(3,I)*DB(3) 00193090 160 KS=KS + 2 00193100 IF (J-ND) 170,190,190 00193110 170 K=J + 1 00193120 KS=KL + 1 00193130 DO 180 II=K,ND,2 00193140 S(KS)=S(KS) + B(1,II)*DB(1) + B(3,II)*DB(3) 00193150 180 KS=KS + 2 00193160 190 KL=KL + 2*ND - 2*J + 1 00193170 IF (IST.EQ.3) GO TO 250 00193180 KL=1 00193190 DO 220 J=1,ND,2 00193200 DB(1)=D(1,4)*B(4,J) 00193210 DB(2)=D(2,4)*B(4,J) 00193220 DB(3)=D(3,4)*B(4,J) 00193230 DB(4)=D(4,1)*B(1,J) + D(4,3)*B(3,J) + D(4,4)*B(4,J) 00193240 BS(1,J)=BS(1,J)+DB(1) 00193250 BS(2,J)=BS(2,J)+DB(2) 00193260 BS(4,J)=DB(4) 00193270 BS(4,J)=BS(4,J)+D(4,2)*B(2,J) 00193280 DO 200 I=1,4 00193290 200 DB(I)=DB(I)*FAC 00193300 DO 210 I=J,ND,2 00193310 S(KL)=S(KL) + B(1,I)*DB(1) + B(3,I)*DB(3) + B(4,I)*DB(4) 00193320 KL=KL + 1 00193330 S(KL)=S(KL) + B(2,I+1)*DB(2) + B(3,I+1)*DB(3) 00193340 210 KL=KL + 1 00193350 220 KL=KL + ND - J 00193360 KL=ND + 1 00193370 DO 240 J=2,ND,2 00193380 DB(4)=D(4,2)*B(2,J) + D(4,3)*B(3,J) 00193390 BS(4,J)=DB(4) 00193400 DB(4)=DB(4)*FAC 00193410 DO 230 I=J,ND 00193420 S(KL)=S(KL) + B(4,I)*DB(4) 00193430 230 KL=KL + 1 00193440 240 KL=KL + ND - J 00193450 250 IF(ITYP2D.NE.1) GO TO 280 00193460 DO 260 I=1,ND,2 00193470 260 BS(4,I)=D(4,1)*B(1,I) 00193480 DO 270 I=2,ND,2 00193490 270 BS(4,I)=D(4,2)*B(2,I) 00193500 280 CONTINUE 00193510 DO 330 J=1,LL 00193520 TOPT=PROP6(J,2) 00193530 IF(TOPT.EQ.0) GO TO 330 00193540 IF(TOPT.EQ.2) TEMP=PROP6(J,3) 00193550 IF(TOPT.NE.1) GO TO 300 00193560 TEMP=0.0E0 00193570 KL=0 00193580 DO 290 K=1,8 00193590 IF(NOD(K).EQ.0) GO TO 290 00193600 KL=KL+1 00193610 TEMP=TEMP+ H(KL)*TEMPD(K,J) 00193620 290 CONTINUE 00193630 300 TEMP=TEMP-REFT 00193640 FAT=FAC*TEMP*PROP(9) 00193650 DO 310 K=1,ND 00193660 DO 310 M=1,2 00193670 310 RF(K,J)=RF(K,J)+FAT*BS(M,K) 00193680 IF(ITYP2D.EQ.2) GO TO 330 00193690 DO 320 K=1,ND 00193700 320 RF(K,J)=RF(K,J)+FAT*BS(4,K) 00193710 330 CONTINUE 00193720 340 CONTINUE 00193730 IF(DE.LE.0.0) RETURN 00193740 TEMP=0.0 00193750 DO 345 I=1,ND,2 00193760 345 TEMP=TEMP+XM(I) 00193770 WGH=WGH/TEMP 00193780 IF(NINTOP.NE.9) WGH=1.0 00193790 DO 350 I=1,ND,2 00193800 XM(I)=XM(I)*WGH 00193810 350 XM(I+1)=XM(I) 00193820 RETURN 00193830 END 00193840 SUBROUTINE STSTL (NEL,XX,PROP,C) 00282940 IMPLICIT REAL*8 (A-H,O-Z) 00282950 COMMON /QTSARG/ SS(136),Q(4,4),P(2,8),YZ(16),H(8),ZZ(16),TAU(4), 00282960 $ZROP(10),B(4,16),XJ(2,2),HP(16),UP(16),THIC,BET,DE,DET,NOD(8), 00282970 $NOD5(8),IEL,NND5,ITYP2D,IMASS,MODEL,MEL,NINT,NRQTSA(1325) R0282980 COMMON /PREP/ FZ(2),KSKIP,RRPREP(8) R0282990 DIMENSION XX(2,1),PROP(1),C(4,1),D(4,4),T(4,4) 00283000 GO TO (100,120,320),MODEL 00283010 100 YM=PROP(1) 00283020 PV=PROP(2) 00283030 C1=YM/(1+PV) 00283040 B1=C1*PV/(1.E0-2.E0*PV) 00283050 A1=B1+C1 00283060 C(1,1)=A1 00283070 C(1,2)=B1 00283080 C(1,3)=0.E0 00283090 C(2,1)=B1 00283100 C(2,2)=A1 00283110 C(2,3)=0.E0 00283120 C(3,1)=0.E0 00283130 C(3,2)=0.E0 00283140 C(3,3)=C1/2.E0 00283150 DO 110 I=1,4 00283160 C(I,4)=0.0 00283170 110 C(4,I)=0.0 00283180 IF (ITYP2D.EQ.1) GO TO 270 00283190 C(1,4)=B1 00283200 C(2,4)=B1 00283210 C(3,4)=0.E0 00283220 C(4,1)=B1 00283230 C(4,2)=B1 00283240 C(4,3)=0.E0 00283250 C(4,4)=A1 00283260 IF (ITYP2D.LT.2) GO TO 270 00283270 GO TO 240 00283280 120 IF (PROP(3).EQ.0.E0) GO TO 100 00283290 PI = 4.0D0* DATAN(1.D0) 00283300 DX = XX(1,2) - XX(1,1) 00283310 DY = XX(2,2) - XX(2,1) 00283320 XL = DX**2 + DY**2 00283330 IF(XL.GT.1.0E-12) GO TO 130 00283340 WRITE (6,300) NEL 00283350 KSKIP=1 00283360 RETURN 00283370 130 XL = DSQRT(XL) 00283380 SA = DABS(DY/XL) 00283390 AL = DASIN(SA) R0283400 IF(DX.GE.0.0E0 .AND. DY.GE.0.0E0) P12 = AL 00283410 IF(DX.LT.0.0E0 .AND. DY.GE.0.0E0) P12 = PI - AL 00283420 IF(DX.LT.0.0E0 .AND. DY.LT.0.0E0) P12 = PI + AL 00283430 IF(DX.GE.0.0E0 .AND. DY.LT.0.0E0) P12 = PI*2.0E0- AL 00283440 PI2=PI*2.E0 00283450 IF( DABS(P12).LT.PI2) GO TO 150 00283460 WRITE(6,140)MEL 00283470 140 FORMAT(/20X, 39HCHECK THE MATERIAL ANGLE ON THE ELEMENT,I5//) 00283480 KSKIP=1 00283490 RETURN 00283500 150 CONTINUE 00283510 BET=BET/PI 00283520 P12=0.0 00283530 GAM=P12 + BET 00283540 IF (GAM.GE.PI2) GAM=GAM-PI2 00283550 IF( DABS(GAM).LT.1.0E-8) GO TO 160 00283560 SG = DSIN(GAM) 00283570 CG = DCOS(GAM) 00283580 T(1,1) = CG**2 00283590 T(1,2) = SG**2 00283600 T(1,3) = CG* SG 00283610 T(1,4) = 0.0E0 00283620 T(2,1) = T(1,2) 00283630 T(2,2) = T(1,1) 00283640 T(2,3) = -T(1,3) 00283650 T(2,4) = 0.0E0 00283660 T(3,1) = T(2,3)* 2.0E0 00283670 T(3,2) = -T(3,1) 00283680 T(3,3) = T(1,1)- T(1,2) 00283690 T(3,4) = 0.0E0 00283700 T(4,1) = 0.0E0 00283710 T(4,2) = 0.0E0 00283720 T(4,3) = 0.0E0 00283730 T(4,4) = 1.0E0 00283740 160 CONTINUE 00283750 DUM = PROP(1)* PROP(2)* PROP(3)* PROP(7) 00283760 IF (DUM.GT.1.0E-08) GO TO 170 00283770 WRITE (6,310) 00283780 STOP 00283790 170 C(1,1) = 1.0E0/PROP(1) 00283800 C(2,2) = 1.0E0/PROP(2) 00283810 C(3,3) = 1.0E0/PROP(7) 00283820 C(4,4) = 1.0E0/PROP(3) 00283830 C(1,2) =-PROP(4)* C(2,2) 00283840 C(1,4) =-PROP(5)* C(4,4) 00283850 C(2,4) =-PROP(6)* C(4,4) 00283860 C(1,3) = 0.0E0 00283870 C(2,3) = 0.0E0 00283880 C(3,4) = 0.0E0 00283890 DO 180 I=1,4 00283900 DO 180 J=I,4 00283910 180 C(J,I) = C(I,J) 00283920 CALL POSINV (C,4,4) 00283930 IF ( DABS(GAM).LT.1.0E-08) GO TO 230 00283940 DO 200 IR=1,4 00283950 DO 200 IC=1,4 00283960 D(IR,IC) = 0.0E0 00283970 DO 190 IN=1,4 00283980 190 D(IR,IC) = D(IR,IC) + T(IN,IR)* C(IN,IC) 00283990 200 CONTINUE 00284000 DO 220 IR=1,4 00284010 DO 220 IC=IR,4 00284020 C(IR,IC) = 0.0E0 00284030 DO 210 IN=1,4 00284040 210 C(IR,IC) = C(IR,IC) + D(IR,IN)* T(IN,IC) 00284050 220 C(IC,IR)=C(IR,IC) 00284060 230 IF (ITYP2D.LT.2) GO TO 270 00284070 240 DO 250 I=1,3 00284080 A=C(I,4)/C(4,4) 00284090 DO 250 J=I,3 00284100 C(I,J)=C(I,J) - C(4,J)*A 00284110 250 C(J,I)=C(I,J) 00284120 DO 260 I=1,4 00284130 C(I,4)=0.0 00284140 260 C(4,I)=0.0 00284150 270 CONTINUE 00284160 CTEX=PROP(9) 00284170 IF(ITYP2D.NE.1) GO TO 280 00284180 CTEX=PROP(9)*(1+PROP(2)) 00284190 IF(MODEL.EQ.2) CTEX=PROP(9)*(1+PROP(4)) 00284200 C(4,1)= PROP(2)*(C(1,1)+C(2,1)) 00284210 C(4,2)= PROP(2)*(C(2,2)+C(2,1)) 00284220 280 CONTINUE 00284230 DO 290 I =1,4 00284240 TAU(I)=0.0E0 00284250 DO 290 IS=1,4 00284260 290 TAU(I)=TAU(I)+C(I ,IS)*CTEX 00284270 IF(ITYP2D.EQ.1.AND.MODEL.EQ.1) TAU(4)=(A1+B1+B1)*PROP(9) 00284280 IF(ITYP2D.EQ.1.AND.MODEL.EQ.2) TAU(4)=TAU(4)*(1.+PROP(4))**2 00284290 TAU(3)=0.0E0 00284300 300 FORMAT (10H0*** ERROR,/ 00284310 $ 43H ZERO LENGTH BETWEEN NODES 1-2 IN ELEMENT (,I4,1H)) 00284320 310 FORMAT (45H0***ERROR MATERIAL PROPERTIES NOT ADMISSABLE ) 00284330 RETURN 00284340 320 DO 340 I=1,4 00284350 DO 330 J=1,4 00284360 330 C(I,J)=PROP(1) 00284370 340 TAU(I)=0.0 00284380 DO 345 I=1,4 00284390 C(I,3)=0.0 00284400 345 C(3,I)=0.0 00284410 IF(ITYP2D.LE.0) RETURN 00284420 DO 350 I=1,4 00284430 C(4,I)=0.0 00284440 350 C(I,4)=0.0 00284450 RETURN 00284460 END 00284470 SUBROUTINE DERIQ (NEL,XX,B,DET,R,S,X1BAR,NOD5,KFL) 00057170 IMPLICIT REAL*8 (A-H,O-Z) 00057180 COMMON /PREP/ FZ(2),KSKIP,RRPREP(8) R0057190 COMMON /QTSARG/ SS(136),D(4,4),P(2,8),YZ(16),H(8),ZZ(16),TAU(4), 00057200 $PROP(10),Q(4,16),XJ(2,2),HP(16),UP(16),THIC,BET,DE,ZET,NOD(8), 00057210 $MOD5(8),IEL,NND5,ITYP2D,IMASS,MODEL,MEL,NINT,NRQTSA(1325) R0057220 COMMON /JUNK/XJI(2,2),FACM,FAC,XBAR,WT,LX,LY,KS,KL,I,J,RRJUNK(216)R0057230 DIMENSION XX(2,1),B(4,1),NOD5(1) 00057240 CALL FUNCT2 (R,S,H,P,NOD5,XJ,DET,XX,NEL,IEL,NND5,KFL) 00057250 IF(KSKIP.EQ.1) RETURN 00057260 IF(DET.LT.1.0E-20) DET=1.0E-20 00057270 DUM = 1.0E0/DET 00057280 XJI(1,1) = XJ(2,2)* DUM 00057290 XJI(1,2) =-XJ(1,2)* DUM 00057300 XJI(2,1) =-XJ(2,1)* DUM 00057310 XJI(2,2) = XJ(1,1)* DUM 00057320 DO 110 K=1,IEL 00057330 K2=K*2 00057340 B(1,K2-1) = 0.E0 00057350 B(1,K2 ) = 0.E0 00057360 B(2,K2-1) = 0.E0 00057370 B(2,K2 ) = 0.E0 00057380 DO 100 I=1,2 00057390 B(1,K2-1) = B(1,K2-1) + XJI(1,I) * P(I,K) 00057400 100 B(2,K2 ) = B(2,K2 ) + XJI(2,I) * P(I,K) 00057410 B(3,K2 ) = B(1,K2-1) 00057420 110 B(3,K2-1) = B(2,K2 ) 00057430 IF (ITYP2D.GT.0) RETURN 00057440 X1BAR = 0.0E0 00057450 DO 120 K=1,IEL 00057460 120 X1BAR = X1BAR + H(K)* XX(1,K) 00057470 IF(X1BAR.GT.1.0E-8) GO TO 140 00057480 ND=2*IEL 00057490 DO 130 K=1,ND 00057500 130 B(4,K)=B(1,K) 00057510 RETURN 00057520 140 DUM = 1.0E0/X1BAR 00057530 DO 150 K=1,IEL 00057540 K2=K*2 00057550 B(4,K2 ) = 0.E0 00057560 150 B(4,K2-1) = H(K) * DUM 00057570 RETURN 00057580 END 00057590 SUBROUTINE FUNCT2 (R,S,H,P,NOD5,XJ,DET,XX,NEL,IEL,NND5,KFL) 00099560 IMPLICIT REAL*8 (A-H,O-Z) 00099570 COMMON /PREP/ FZ(2),KSKIP,RRPREP(8) R0099580 COMMON /TRASH/ BS(4,16),H4(4),RJUK(54),IJUK,LST,RRTRAS(367) R0099590 DIMENSION H(1),P(2,1),NOD5(1),IPERM(4),XJ(2,2),XX(2,1) 00099600 DATA IPERM/2,3,4,1/ 00099610 RP = 1.0E0 + R 00099620 SP = 1.0E0 + S 00099630 RM = 1.0E0 - R 00099640 SM = 1.0E0 - S 00099650 R2 = 1.0E0 - R*R 00099660 S2 = 1.0E0 - S*S 00099670 H(1) = 0.25E0* RP* SP 00099680 H(2) = 0.25E0* RM* SP 00099690 H(3) = 0.25E0* RM* SM 00099700 H(4) = 0.25E0* RP* SM 00099710 DO 50 I=1,4 00099720 50 H4(I)=H(I) 00099730 P(1,1)=0.25E0*SP 00099740 P(1,2)=-P(1,1) 00099750 P(1,3)=-0.25E0*SM 00099760 P(1,4)=-P(1,3) 00099770 P(2,1)=0.25E0*RP 00099780 P(2,2)=0.25E0*RM 00099790 P(2,3)=-P(2,2) 00099800 P(2,4)=-P(2,1) 00099810 IF (IEL.EQ.4) GO TO 180 00099820 I=0 00099830 100 I=I + 1 00099840 IF (I.GT.NND5) GO TO 150 00099850 NN=NOD5(I) - 4 00099860 GO TO (110,120,130,140), NN 00099870 110 H(5) = 0.50E0* R2* SP 00099880 P(1,5)=-R*SP 00099890 P(2,5)=0.50E0*R2 00099900 GO TO 100 00099910 120 H(6) = 0.50E0* RM* S2 00099920 P(1,6)=-0.50E0*S2 00099930 P(2,6)=-RM*S 00099940 GO TO 100 00099950 130 H(7) = 0.50E0* R2* SM 00099960 P(1,7)=-R*SM 00099970 P(2,7)=-0.50E0*R2 00099980 GO TO 100 00099990 140 H(8) = 0.50E0* RP* S2 00100000 P(1,8)=0.50E0*S2 00100010 P(2,8)=-RP*S 00100020 GO TO 100 00100030 150 IH=0 00100040 160 IH=IH + 1 00100050 IF (IH.GT.NND5) GO TO 180 00100060 IN=NOD5(IH) 00100070 I1=IN - 4 00100080 I2=IPERM(I1) 00100090 H(I1)=H(I1) - 0.5E0*H(IN) 00100100 H(I2)=H(I2) - 0.5E0*H(IN) 00100110 H(IH + 4)=H(IN) 00100120 DO 170 J=1,2 00100130 P(J,I1)=P(J,I1) - 0.5E0*P(J,IN) 00100140 P(J,I2)=P(J,I2) - 0.5E0*P(J,IN) 00100150 170 P(J,IH + 4)=P(J,IN) 00100160 GO TO 160 00100170 180 CONTINUE 00100180 IF(LST.LE.0) GO TO 185 00100190 DELTH=R2*S2*0.125 00100200 H(1)=H(1)+DELTH 00100210 H(2)=H(2)+DELTH 00100220 H(3)=H(3)+H(4)+H(7) 00100230 H(5)=H(5)-2.0*DELTH 00100240 H(4)=0.0 00100250 H(7)=0.0 00100260 PDELTR=-0.25*R*S2 00100270 PDELTS=-0.25*R2*S 00100280 P(1,1)=P(1,1)+PDELTR 00100290 P(2,1)=P(2,1)+PDELTS 00100300 P(1,2)=P(1,2)+PDELTR 00100310 P(2,2)=P(2,2)+PDELTS 00100320 P(1,3)=P(1,3)+P(1,4)+P(1,7) 00100330 P(2,3)=P(2,3)+P(2,4)+P(2,7) 00100340 P(1,5)=P(1,5)-2.*PDELTR 00100350 P(2,5)=P(2,5)-2.*PDELTS 00100360 P(1,4)=0.0 00100370 P(2,4)=0.0 00100380 P(1,7)=0.0 00100390 P(2,7)=0.0 00100400 185 DO 200 I=1,2 00100410 DO 200 J=1,2 00100420 DUM = 0.0E0 00100430 DO 190 K=1,IEL 00100440 190 DUM = DUM + P(I,K)* XX(J,K) 00100450 200 XJ(I,J) = DUM 00100460 DET = XJ(1,1)* XJ(2,2) - XJ(2,1)* XJ(1,2) 00100470 IF(DET.GT.1.0E-08) GO TO 210 00100480 IF(KFL.GT.0) GO TO 210 00100490 WRITE (6,220) NEL 00100500 KSKIP=1 00100510 RETURN 00100520 210 CONTINUE 00100530 RETURN 00100540 220 FORMAT (10H0*** ERROR, 00100550 $ 40H ZERO JACOBIAN DETERMINANT FOR ELEMENT (,I4,1H) / 00100560 $, 10X, 37HCHECK NODE NUMBERING OR NODAL COORD. ) 00100570 END 00100580 SUBROUTINE PLD2D(PROP6,LL,RF,MXDF) 00165410 IMPLICIT REAL*8(A-H,O-Z) 00165420 COMMON /PREP/ FZ(2),KSKIP,RRPREP(8) R0165430 COMMON /QTSARG/ SS(136),D(4,4),P(2,8),YZ(16),H(8),PRES(16),TAU(4),00165440 $PROP(10),B(4,16),XJ(2,2),HP(16),UP(16),THIC,BET,DE,DET,NOD(8), 00165450 $NOD5(8),IEL,NND5,ITYP2D,IMASS,MODEL,MEL,NINT,NRQTSA(1325) R0165460 COMMON /GASS/ XK(4,4),WGT(4,4),IPERM(3) R0165470 DIMENSION PROP6(LL,7),RF(MXDF,LL) 00165480 DIMENSION F1(4),K1(4) 00165490 DIMENSION R(4),S(4) 00165500 DATA F1/-1.0,-1.0, 1.0, 1.0/ 00165510 DATA K1/1,2,1,2/ 00165520 DATA R/0.,-1.,0.,1./ 00165530 DATA S/ 1.,0.,-1.,0./ 00165540 ND=2*IEL 00165550 DO 100 I=1,ND 00165560 100 UP(I)=0.0 00165570 KHP=0 00165580 KUP=0 00165590 DO 180 II=1,3 00165600 ZREF=PRES(2) 00165610 KTYPE=1 00165620 IF(II.EQ.1.AND.ZREF.NE.0.0) KTYPE=2 00165630 PR=PRES(1) 00165640 IF(II.GE.2) PR=PRES(2*II) 00165650 KF=PRES(2*II+1) 00165660 IF(KF.LT.0.OR.KF.GT.4) GO TO 230 00165670 IF(NOD(3).EQ.NOD(4).AND.KF.EQ.3) GO TO 230 00165680 IF(PR.EQ.0.0) GO TO 180 00165690 IF(KF.EQ.0) GO TO 180 00165700 IF(KTYPE.EQ.2) KHP=1 00165710 IF(KTYPE.EQ.1) KUP=1 00165720 R1=R(KF) 00165730 S1=S(KF) 00165740 DO 160 INT=1,NINT 00165750 R2=R1 00165760 S2=S1 00165770 IF(R1.EQ.0.0) R2=XK(INT,NINT) 00165780 IF(S1.EQ.0.0) S2=XK(INT,NINT) 00165790 WT=WGT(INT,NINT) 00165800 CALL FUNCT2(R2,S2,H,P,NOD5,XJ,DET,YZ,NEL,IEL,NND5,1) 00165810 IF(KTYPE.EQ.1) GO TO 120 00165820 Z=0.0 00165830 DO 110 K=1,IEL 00165840 KZ=K*2 00165850 110 Z=Z+H(K)*YZ(KZ) 00165860 120 CONTINUE 00165870 K5=K1(KF) 00165880 A1= F1(KF)*XJ(K5,2) 00165890 A2=-F1(KF)*XJ(K5,1) 00165900 AA= DSQRT(A1*A1+A2*A2) 00165910 A1=A1/AA 00165920 A2=A2/AA 00165930 C=XJ(K5,1)*XJ(K5,1)+XJ(K5,2)*XJ(K5,2) 00165940 C= DSQRT(C) 00165950 FORCE=PR 00165960 IF(KTYPE.EQ.2) FORCE=PR*(ZREF-Z) 00165970 FORCE=-FORCE 00165980 IF(KTYPE.EQ.2.AND.Z.GT.ZREF) GO TO 160 00165990 XBAR=1. 00166000 IF(ITYP2D.EQ.2) XBAR=THIC 00166010 IF(ITYP2D.GT.0) GO TO 140 00166020 XBAR=0.0 00166030 DO 130 K=1,IEL 00166040 KZ=K*2-1 00166050 130 XBAR=XBAR+H(K)*YZ(KZ) 00166060 140 CONTINUE 00166070 C=C*XBAR 00166080 TS=C*WT*FORCE 00166090 DO 150 I=1,IEL 00166100 KK=I*2 00166110 QQ= TS*H(I) 00166120 UP(KK-1)=UP(KK-1)+QQ*A1 00166130 150 UP(KK) =UP(KK ) +QQ*A2 00166140 160 CONTINUE 00166150 IF(KTYPE.LT.2) GO TO 180 00166160 DO 170 I=1,ND 00166170 HP(I)=UP(I) 00166180 170 UP(I)=0.0 00166190 180 CONTINUE 00166200 IF(KHP.EQ.0.AND.KUP.EQ.0) RETURN 00166210 DO 220 I=1,LL 00166220 PLF=PROP6(I,1) 00166230 PHF=1.0 00166240 IF(PLF.EQ.0.0) PHF=0.0 00166250 IF(KUP.EQ.0) GO TO 200 00166260 DO 190 J=1,ND 00166270 190 RF(J,I)=RF(J,I)+PLF*UP(J) 00166280 200 IF(KHP.EQ.0) GO TO 220 00166290 DO 210 J=1,ND 00166300 210 RF(J,I)=RF(J,I)+PHF*HP(J) 00166310 220 CONTINUE 00166320 RETURN 00166330 230 WRITE(6,240)MEL 00166340 240 FORMAT(/20X, 45H A ILLEGAL FACE NO. WAS REQUESTED FOR ELEMENT,I5//00166350 $) 00166360 KSKIP=1 00166370 RETURN 00166380 END 00166390