1 : C DRUCOM SOURCE CHAT 05/01/12 22:55:19 5004 2 : C DRUCOM SOURCE JFG 02/07/04 3 : SUBROUTINE DRUCOM(S1,SEQ,BETINSA) 4 : C 5 : IMPLICIT INTEGER(I-N) 6 : IMPLICIT REAL*8(A-H,O-Z) 7 : DIMENSION S1(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 : BETA = 1.2D0 16 : ALC=(BETA-1.)/(2.*BETA-1.) 17 : BEC=BETA/(2.*BETA-1.) 18 : C 19 : SX=S1(1) 20 : SY=S1(2) 21 : SZ=S1(3) 22 : SXY=S1(4) 23 : SXZ=S1(5) 24 : SYZ=S1(6) 25 : A = SX-SY 26 : B = SY-SZ 27 : C = SX-SZ 28 : DJ2=(A*A+B*B+C*C+SXY*SXY+SYZ*SYZ+SXZ*SXZ) 29 : DJ2=DJ2 * (1.D0/6.D0) 30 : DI1=SX+SY+SZ 31 : C 32 : DJ2=3.D0*DJ2 33 : DJ2=SQRT(DJ2) 34 : SEQ=(DJ2+ALC*DI1)/BEC 35 : C 36 : RETURN 37 : END 38 : 39 : 40 : 41 :
© Cast3M 2003 - All rights reserved.
Disclaimer