home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 9 / 09.iso / e / e003 / 6.ddi / ELSTF06A.FOR next >
Encoding:
Text File  |  1987-06-04  |  26.0 KB  |  326 lines
  1.       SUBROUTINE RELESE(ASA,P14,KRLX,MXDF,NEL,NNS,RF,LLL)               00204370
  2.         IMPLICIT REAL*8(A-H,O-Z)                                        00204380
  3.         DIMENSION ASA(MXDF,MXDF),P14(21,1),RF(MXDF,1)                   00204390
  4.         IF(KRLX.LE.0)RETURN                                             00204400
  5.         LL=LLL                                                          00204410
  6.         IF(LL.LE.0)LL=1                                                 00204420
  7.         MXZ=NNS*6                                                       00204430
  8.         DO 300 I=1,KRLX                                                 00204440
  9.         M=P14(1,I)                                                      00204450
  10.         IF(M.NE.NEL)GO TO 300                                           00204460
  11.         DO 200 J=1,NNS                                                  00204470
  12.         NOLD=P14(J+1,I)                                                 00204480
  13.         DO 190 K=1,6                                                    00204490
  14.         KK=7-K+6*(J-1)                                                  00204500
  15.         NEW=(NOLD/10)*10                                                00204510
  16.         L=NOLD-NEW                                                      00204520
  17.         IF(L.EQ.0) GO TO 190                                            00204530
  18.         RRK=ASA(KK,KK)                                                  00204540
  19.         IF(RRK.EQ.0.)GO TO 190                                          00204550
  20.         DO 110 II=1,MXZ                                                 00204560
  21.         IF(II.EQ.KK)GO TO 110                                           00204570
  22.         AR=ASA(II,KK)/RRK                                               00204580
  23.         DO 90 IL=1,LL                                                   00204590
  24. 90      RF(II,IL)=RF(II,IL)-AR*RF(KK,IL)                                00204600
  25.         DO 100 JJ=1,MXZ                                                 00204610
  26.         IF(JJ.EQ.KK)GO TO 100                                           00204620
  27.         ASA(II,JJ)=ASA(II,JJ)-ASA(KK,JJ)*AR                             00204630
  28. 100     CONTINUE                                                        00204640
  29. 110     CONTINUE                                                        00204650
  30.         DO 120 II=1,MXZ                                                 00204660
  31.         DO 115 IL=1,LL                                                  00204670
  32. 115     RF(KK,IL)=0.                                                    00204680
  33.         ASA(II,KK)=0.                                                   00204690
  34. 120     ASA(KK,II)=0.                                                   00204700
  35. 190     NOLD=NOLD/10                                                    00204710
  36. 200     CONTINUE                                                        00204720
  37. 300     CONTINUE                                                        00204730
  38.         RETURN                                                          00204740
  39.         END                                                             00204750
  40.       SUBROUTINE STRETR (T,X,Y,Z,CM,SA,H,RHOM,XM,NNS,MXDF,NSMX)         00278800
  41.       IMPLICIT REAL*8 (A-H,O-Z)                                         00278810
  42.       DIMENSION   T(3,3),X(1),Y(1),Z(1),CM(3,3),SA(NSMX,MXDF),XM(1)     00278820
  43.       COMMON/JUNK/DUM(157),AM3,AAA,X4,XO,AM4,XYJ,Y1,YO,XX,X1,Y2,AC,AM1, 00278830
  44.      $S,X2,Y3,AM2,R,X3,Y4,NM1,L,JS,I,KA,J,K,NRJUNK(93)                  R0278840
  45.       COMMON/MASS/LMASS                                                 00278850
  46.       COMMON / TRASH /                                                  00278860
  47.      $            V(3,3),XY(3,2),A(12,12),        AA(12,12),ABC(9,9),   00278870
  48.      $            S1(3,9),S2(3,9),S3(3,12),MM(12),AM(4),RRTRAS(6)       R0278880
  49.       COMMON/QTSARG/ZDZ(15),HM,RRQTSA(984)                              R0278890
  50.       ZER=0.0E+00                                                       00278900
  51.       NM1=NNS-1                                                         00278910
  52.       DO 110 I=1,NM1                                                    00278920
  53.       V(I,1)=X(I+1)-X(1)                                                00278930
  54.       V(I,2)=Y(I+1)-Y(1)                                                00278940
  55.   110 V(I,3)=Z(I+1)-Z(1)                                                00278950
  56.       DO 120 I=1,NM1                                                    00278960
  57.       DO 120 J=1,2                                                      00278970
  58.       XY(I,J)=0.                                                        00278980
  59.       DO 120 K=1,3                                                      00278990
  60.   120 XY(I,J)=XY(I,J)+V(I,K)*T(J,K)                                     00279000
  61.       AC=0.25*H*RHOM                                                    00279010
  62.       XO=(XY(1,1)+XY(2,1))/3.                                           00279020
  63.       YO=(XY(1,2)+XY(2,2))/3.                                           00279030
  64.       AM1=   -XO*XY(1,2)                                                00279040
  65.       AM2=(0.5*(XY(1,1)+XY(2,1))-XO)*(XY(2,2)-XY(1,2))                  00279050
  66.       AM3=  XO* XY(2,2)                                                 00279060
  67.       AM(1)=AC*(AM1+AM3)                                                00279070
  68.       AM(2)=AC*(AM1+AM2)                                                00279080
  69.       AM(3)=AC*(AM2+AM3)                                                00279090
  70.       IF(NNS.LT.4) GO TO 130                                            00279100
  71.       XO=(XY(1,1)+XY(2,1)+XY(3,1))/4.0                                  00279110
  72.       YO=(XY(1,2)+XY(2,2)+XY(3,2))/4.0                                  00279120
  73.       AM1=XY(1,1)*YO-XO*XY(1,2)                                         00279130
  74.       AM2=(XY(1,1)-XO)*(XY(2,2)-YO)-(XY(2,1)-XO)*(XY(1,2)-YO)           00279140
  75.       AM3=(XY(2,1)-XO)*(XY(3,2)-YO)-(XY(3,1)-XO)*(XY(2,2)-YO)           00279150
  76.       AM4=XO*XY(3,2)-XY(3,1)*YO                                         00279160
  77.       AM(1)=AC*(AM1+AM4)                                                00279170
  78.       AM(2)=AC*(AM1+AM2)                                                00279180
  79.       AM(3)=AC*(AM2+AM3)                                                00279190
  80.       AM(4)=AC*(AM3+AM4)                                                00279200
  81.   130 CONTINUE                                                          00279210
  82.       IF(LMASS.EQ.1) GO TO 145                                          00279220
  83.       DO 140 L=1,NNS                                                    00279230
  84.       XX=AM(L)                                                          00279240
  85.       L61=6*(L-1)                                                       00279250
  86.       DO 140 J=1,3                                                      00279260
  87.       JS=L61+J                                                          00279270
  88.       JS3=JS+3                                                          00279280
  89.       XM(JS)=XX                                                         00279290
  90.   140 XM(JS3)=0.0                                                       00279300
  91.       GO TO 155                                                         00279310
  92.   145 IRK=6*NNS                                                         00279320
  93.       DO 150 L=1,NNS                                                    00279330
  94.       XX=AM(L)                                                          00279340
  95.       L61=6*(L-1)                                                       00279350
  96.       DO 150 J=1,3                                                      00279360
  97.       JS=L61+J                                                          00279370
  98.       JS3=JS+3                                                          00279380
  99.       JSS=(JS-1)*IRK+JS                                                 00279390
  100.       JSS3=(JS3-1)*IRK+JS3                                              00279400
  101.       XM(JSS)=XX                                                        00279410
  102.   150 XM(JSS3)=0.0E0                                                    00279420
  103.   155 CONTINUE                                                          00279430
  104.       S=0.5                                                             00279440
  105.       R=0.5                                                             00279450
  106.       IF(HM.LE.0.0E0) GO TO 185                                         00279460
  107.       CALL QVSET(ZER,S1,54)                                             00279470
  108.       AAA=(XY(2,1)-XY(1,1))* XY(1,2) - XY(1,1)*(XY(2,2)-XY(1,2))        00279480
  109.       S1(1,1)= (XY(2,2)-XY(1,2))/AAA                                    00279490
  110.       S1(1,3)= -XY(2,2)/AAA                                             00279500
  111.       S1(1,5)=  XY(1,2)/AAA                                             00279510
  112.       S1(2,2)=(-XY(2,1)+XY(1,1))/AAA                                    00279520
  113.       S1(2,4)=  XY(2,1)/AAA                                             00279530
  114.       S1(2,6)= -XY(1,1)/AAA                                             00279540
  115.       IF(NNS.LT.4) GO TO 160                                            00279550
  116.       XYJ=XY(1,1)*XY(3,2)-XY(3,1)*XY(1,2)+(XY(1,1)*(XY(2,2)-XY(3,2))    00279560
  117.      $ -(XY(2,1)-XY(3,1))*XY(1,2))*S-((XY(1,1)-XY(2,1))*XY(3,2)         00279570
  118.      $ -XY(3,1)*(XY(1,2)-XY(2,2)))*R                                    00279580
  119.       X1=XY(1,2)-XY(3,2)-(XY(2,2)-XY(3,2))*S-(XY(1,2)-XY(2,2))*R        00279590
  120.       X2=XY(3,2)+(XY(2,2)-XY(3,2))*S-XY(3,2)*R                          00279600
  121.       X3=-XY(1,2)*S+XY(3,2)*R                                           00279610
  122.       X4=-XY(1,2)+XY(1,2)*S+(XY(1,2)-XY(2,2))*R                         00279620
  123.       Y1=-XY(1,1)+XY(3,1)+(XY(2,1)-XY(3,1))*S+(XY(1,1)-XY(2,1))*R       00279630
  124.       Y2=-XY(3,1)-(XY(2,1)-XY(3,1))*S+XY(3,1)*R                         00279640
  125.       Y3=XY(1,1)*S-XY(3,1)*R                                            00279650
  126.       Y4=XY(1,1)-XY(1,1)*S-(XY(1,1)-XY(2,1))*R                          00279660
  127.       S1(1,1)=X1/XYJ                                                    00279670
  128.       S1(1,3)=X2/XYJ                                                    00279680
  129.       S1(1,5)=X3/XYJ                                                    00279690
  130.       S1(1,7)=X4/XYJ                                                    00279700
  131.       S1(2,2)=Y1/XYJ                                                    00279710
  132.       S1(2,4)=Y2/XYJ                                                    00279720
  133.       S1(2,6)=Y3/XYJ                                                    00279730
  134.       S1(2,8)=Y4/XYJ                                                    00279740
  135.   160 CONTINUE                                                          00279750
  136.       S1(3,1)=S1(2,2)                                                   00279760
  137.       S1(3,2)=S1(1,1)                                                   00279770
  138.       S1(3,3)=S1(2,4)                                                   00279780
  139.       S1(3,4)=S1(1,3)                                                   00279790
  140.       S1(3,5)=S1(2,6)                                                   00279800
  141.       S1(3,6)=S1(1,5)                                                   00279810
  142.       S1(3,7)=S1(2,8)                                                   00279820
  143.       S1(3,8)=S1(1,7)                                                   00279830
  144.       DO 180 I=1,3                                                      00279840
  145.       DO 180 J=1,8                                                      00279850
  146.       DO 170 K=1,3                                                      00279860
  147.   170 S2(I,J)=S2(I,J)+CM(I,K)*S1(K,J)                                   00279870
  148.   180 CONTINUE                                                          00279880
  149.   185 H=H/2.0E0                                                         00279890
  150.       IF(HM.LE.0.0E0) GO TO 195                                         00279900
  151.       DO 190 L=1,4                                                      00279910
  152.       KA=2*(L-1)+1                                                      00279920
  153.       KA1=KA+1                                                          00279930
  154.       L61=6*(L-1)                                                       00279940
  155.       DO 190 I=1,3                                                      00279950
  156.       DO 190 J=1,3                                                      00279960
  157.       JS=L61+J                                                          00279970
  158.   190 SA(I,JS)=S2(I,KA)*T(1,J)+S2(I,KA1)*T(2,J)                         00279980
  159.   195 CONTINUE                                                          00279990
  160.       CALL QVSET(ZER,A,288)                                             00280000
  161.       DO 210 I=1,NM1                                                    00280010
  162.       J=3*I+1                                                           00280020
  163.       A(1,J)=1.                                                         00280030
  164.       A(2,J)=XY(I,1)                                                    00280040
  165.       A(3,J)=XY(I,2)                                                    00280050
  166.       A(4,J)=XY(I,1)*XY(I,1)                                            00280060
  167.       A(5,J)=XY(I,1)*XY(I,2)                                            00280070
  168.       A(6,J)=XY(I,2)*XY(I,2)                                            00280080
  169.       A(7,J)=A(4,J)*XY(I,1)                                             00280090
  170.       A(8,J)=XY(I,1)*A(6,J)+XY(I,2)*A(4,J)                              00280100
  171.       A(9,J)=XY(I,2)*A(6,J)                                             00280110
  172.       A(8,J+1)=2*A(5,J)+A(4,J)                                          00280120
  173.       A(9,J+1)=3*A(6,J)                                                 00280130
  174.       A(8,J+2)=-A(6,J)-2*A(5,J)                                         00280140
  175.       A(3,J+1)=1.0                                                      00280150
  176.       A(5,J+1)=XY(I,1)                                                  00280160
  177.       A(6,J+1)=2.0*XY(I,2)                                              00280170
  178.       A(2,J+2)=-1.0                                                     00280180
  179.       A(4,J+2)=-2.0*XY(I,1)                                             00280190
  180.       A(5,J+2)=-XY(I,2)                                                 00280200
  181.       A(7,J+2)=-3.0*XY(I,1)*XY(I,1)                                     00280210
  182.       IF(NNS.LT.4) GO TO 210                                            00280220
  183.       A(8,J)=A(5,J)*XY(I,1)                                             00280230
  184.       A(9,J)=A(5,J)*XY(I,2)                                             00280240
  185.       A(10,J)=A(6,J)*XY(I,2)                                            00280250
  186.       A(11,J)=XY(I,1)*XY(I,1)*XY(I,1)*XY(I,2)                           00280260
  187.       A(12,J)=XY(I,1)*XY(I,2)*XY(I,2)*XY(I,2)                           00280270
  188.       A(8,J+1)=XY(I,1)*XY(I,1)                                          00280280
  189.       A(9,J+1)=2.0*XY(I,1)*XY(I,2)                                      00280290
  190.       A(10,J+1)=3.0*XY(I,2)*XY(I,2)                                     00280300
  191.       A(11,J+1)=XY(I,1)*XY(I,1)*XY(I,1)                                 00280310
  192.       A(12,J+1)=3.0*XY(I,1)*XY(I,2)*XY(I,2)                             00280320
  193.       A(8,J+2)=-2.0*XY(I,1)*XY(I,2)                                     00280330
  194.       A(9,J+2)=-XY(I,2)*XY(I,2)                                         00280340
  195.       A(11,J+2)=-3.0*XY(I,1)*XY(I,1)*XY(I,2)                            00280350
  196.       A(12,J+2)=-XY(I,2)*XY(I,2)*XY(I,2)                                00280360
  197.   210 CONTINUE                                                          00280370
  198.       A(1,1)=1.0                                                        00280380
  199.       A(3,2)=1.0                                                        00280390
  200.       A(2,3)=-1.0                                                       00280400
  201.       DO 220 I = 1, 9                                                   00280410
  202.       DO 220 J = 1, 9                                                   00280420
  203.   220 ABC(I,J) = A(I,J)                                                 00280430
  204.       IF(NNS.EQ.3)                                                      00280440
  205.      $CALL INVERT (ABC,AA,9,9,MM)                                       00280450
  206.       IF(NNS.EQ.4)                                                      00280460
  207.      $CALL INVERT (A,AA,12,12,MM)                                       00280470
  208.       IF(NNS.GT.3) GO TO 240                                            00280480
  209.       DO 230 I=1,9                                                      00280490
  210.       DO 230 J=1,9                                                      00280500
  211.   230 A(I,J)=ABC(I,J)                                                   00280510
  212.   240 CALL QVSET(ZER,S1,90)                                             00280520
  213.       S1(1,1)=2.0                                                       00280530
  214.       S1(1,4)=6.0*XO                                                    00280540
  215.       S1(1,5)=2.0*YO                                                    00280550
  216.       S1(2,3)=2.0                                                       00280560
  217.       S1(2,5)=2*XO                                                      00280570
  218.       S1(2,6)=6*YO                                                      00280580
  219.       S1(3,5)=4*(XO+YO)                                                 00280590
  220.       S1(3,2)=2.0                                                       00280600
  221.       IF(NNS.LT.4) GO TO 260                                            00280610
  222.       S1(1,8)=6.0*XO*YO                                                 00280620
  223.       S1(2,6)=2.0*XO                                                    00280630
  224.       S1(2,7)=6.0*YO                                                    00280640
  225.       S1(2,9)=6.0*XO*YO                                                 00280650
  226.       S1(3,5)=4.0*XO                                                    00280660
  227.       S1(3,6)=4.0*YO                                                    00280670
  228.       S1(3,8)=6.0*XO*XO                                                 00280680
  229.       S1(3,9)=6.0*YO*YO                                                 00280690
  230.       S1(2,5)=0.0                                                       00280700
  231.   260 DO 280 I=1,3                                                      00280710
  232.       DO 280 J=1,9                                                      00280720
  233.       DO 270 K=1,3                                                      00280730
  234.   270 S2(I,J)=S2(I,J)+CM(I,K)*S1(K,J)                                   00280740
  235.   280 S2(I,J)=-S2(I,J)*H                                                00280750
  236.       DO 290 I=1,3                                                      00280760
  237.       DO 290 J=1,12                                                     00280770
  238.       DO 290 K=1,9                                                      00280780
  239.   290 S3(I,J)=S3(I,J)+S2(I,K)*A(J,3+K)                                  00280790
  240.       DO 300 L=1,4                                                      00280800
  241.       KA=3*(L-1)+1                                                      00280810
  242.       KA1=KA+1                                                          00280820
  243.       KA2=KA+2                                                          00280830
  244.       L61=6*(L-1)                                                       00280840
  245.       DO 300 I=1,3                                                      00280850
  246.       I3=I+3                                                            00280860
  247.       DO 300 J=1,3                                                      00280870
  248.       JS=L61+J                                                          00280880
  249.       SA(I3,JS)=S3(I,KA)*T(3,J)                                         00280890
  250.       JS=JS+3                                                           00280900
  251.       SA(I3,JS)=S3(I,KA1)*T(1,J)+S3(I,KA2)*T(2,J)                       00280910
  252.   300 CONTINUE                                                          00280920
  253.       RETURN                                                            00280930
  254.       END                                                               00280940
  255.       SUBROUTINE INVERT (A,C,NN,N,M)                                    00121940
  256.       IMPLICIT REAL*8 (A-H,O-Z)                                         00121950
  257.       DIMENSION A(1),M(1),C(1)                                          00121960
  258.       DO 100 I=1,NN                                                     00121970
  259.   100 M(I)=-I                                                           00121980
  260.       DO 230 I=1,NN                                                     00121990
  261.       D=0.0                                                             00122000
  262.       DO 160 L=1,NN                                                     00122010
  263.       IF (M(L)) 110,110,160                                             00122020
  264.   110 J=L                                                               00122030
  265.       DO 150 K=1,NN                                                     00122040
  266.       IF (M(K)) 120,120,140                                             00122050
  267.   120 IF( DABS(D)- DABS(A(J))) 130,130,140                              00122060
  268.   130 LD=L                                                              00122070
  269.       KD=K                                                              00122080
  270.       D=A(J)                                                            00122090
  271.   140 J=J+N                                                             00122100
  272.   150 CONTINUE                                                          00122110
  273.   160 CONTINUE                                                          00122120
  274.       TEMP=-M(LD)                                                       00122130
  275.       M(LD)=M(KD)                                                       00122140
  276.       M(KD)=TEMP                                                        00122150
  277.       L=LD                                                              00122160
  278.       K=KD                                                              00122170
  279.       DO 170 J=1,NN                                                     00122180
  280.       C(J)=A(L)                                                         00122190
  281.       A(L)=A(K)                                                         00122200
  282.       A(K)=C(J)                                                         00122210
  283.       L=L+N                                                             00122220
  284.   170 K=K+N                                                             00122230
  285.       D=1.0/D                                                           00122240
  286.       NR=(KD-1)*N+1                                                     00122250
  287.       NH=NR+N-1                                                         00122260
  288.       DO 180 K=NR,NH                                                    00122270
  289.   180 A(K)=A(K)*D                                                       00122280
  290.       L=1                                                               00122290
  291.       DO 220 J=1,NN                                                     00122300
  292.       IF (J-KD) 200,190,200                                             00122310
  293.   190 L=L+N                                                             00122320
  294.       GO TO 220                                                         00122330
  295.   200 DO 210 K=NR,NH                                                    00122340
  296.       A(L)=A(L)-C(J)*A(K)                                               00122350
  297.   210 L=L+1                                                             00122360
  298.   220 CONTINUE                                                          00122370
  299.       C(KD)=-1.0                                                        00122380
  300.       J=KD                                                              00122390
  301.       DO 230 K=1,NN                                                     00122400
  302.       A(J)=-C(K)*D                                                      00122410
  303.   230 J=J+N                                                             00122420
  304.       DO 260 I=1,NN                                                     00122430
  305.       L=0                                                               00122440
  306.   240 L=L+1                                                             00122450
  307.       IF(M(L)-I) 240,250,240                                            00122460
  308.   250 K=(L-1)*N+1                                                       00122470
  309.       J=(I-1)*N+1                                                       00122480
  310.       M(L)=M(I)                                                         00122490
  311.       M(I)=I                                                            00122500
  312.       DO 260 L=1,NN                                                     00122510
  313.       TEMP=A(K)                                                         00122520
  314.       A(K)=A(J)                                                         00122530
  315.       A(J)=TEMP                                                         00122540
  316.                                                                         00122550
  317.        J=J+1                                                            00122560
  318.   260 K=K+1                                                             00122570
  319.       RETURN                                                            00122580
  320.       END                                                               00122590
  321.         FUNCTION IZO(NZO)                                               00122600
  322.         IZO=NZO                                                         00122610
  323.         IF(NZO.LE.0)IZO=1                                               00122620
  324.         RETURN                                                          00122630
  325.         END                                                             00122640
  326.