1 : C DRUTR1 SOURCE CHAT 05/01/12 22:55:22 5004 2 : C DRUTR1 SOURCE JFG 02/07/04 3 : SUBROUTINE DRUTR1(S1,DF,BETINSA) 4 : C 5 : IMPLICIT INTEGER(I-N) 6 : IMPLICIT REAL*8(A-H,O-Z) 7 : DIMENSION S1(6),DF(6) 8 : C 9 : SEGMENT BETINSA 10 : REAL*8 RT,RC,YOUN,XNU,GFT,GFC,CAR 11 : REAL*8 DKT,DKC,SEQT,SEQC,ENDT,ENDC 12 : INTEGER IFIS,IPLA,IBB,IGAU 13 : ENDSEGMENT 14 : C 15 : ALT=1.D0 16 : BET=2.D0 17 : C 18 : SX=S1(1) 19 : SY=S1(2) 20 : SZ=S1(3) 21 : SXY=S1(4) 22 : SXZ=S1(5) 23 : SYZ=S1(6) 24 : A = SX-SY 25 : B = SY-SZ 26 : C = SX-SZ 27 : DJ2=(A*A+B*B+C*C+SXY*SXY+SYZ*SYZ+SXZ*SXZ) 28 : DJ2=DJ2 * (1.D0/6.D0) 29 : DJ2=3.D0*DJ2 30 : DJ2=SQRT(DJ2) 31 : C 32 : DF(1) = ((2.*SX) - SY -SZ)/2./DJ2 + ALT 33 : DF(2) = (-SX +(2.*SY) -SZ)/2./DJ2 + ALT 34 : DF(3) = (-SX -SY +(2.*SZ))/2./DJ2 + ALT 35 : DF(4) = 6. * SXY/2./DJ2 36 : DF(5) = 6. * SXZ/2./DJ2 37 : DF(6) = 6. * SYZ/2./DJ2 38 : C 39 : RETURN 40 : END 41 : 42 : 43 : 44 :
© Cast3M 2003 - All rights reserved.
Disclaimer