Download crivon.eso

Back to the list

   1 : C CRIVON    SOURCE    CHAT      05/01/12    22:31:09     5004           
   2 :       SUBROUTINE CRIVON(S1,SEQ,NSTRS,BETJEF)
   3 :       IMPLICIT INTEGER(I-N)
   4 :       IMPLICIT REAL*8 (A-H,O-Z)
   5 :       DIMENSION S1(4)
   6 : *
   7 :       SEGMENT BETJEF
   8 :        REAL*8 AA,BETA,RB,ALPHA,EX,PXY,GFC,GFT,CAR,ETA,TDEF,
   9 :      &          TCON,DPSTF1,DPSTF2,TETA,PDT
  10 :        INTEGER ICT,ICC,IMOD,IVIS,ITER,
  11 :      &                ISIM,IBB,IGAU,IZON
  12 :       ENDSEGMENT
  13 : *
  14 : *     COMMON /DBETJEF/AA,BETA,RB,ALPHA,EX,PXY,GFC,GFT,CAR,ETA,TDEF,
  15 : *    &          TCON,DPSTF1,DPSTF2,TETA,PDT,ICT,ICC,IMOD,IVIS,ITER,
  16 : *    &                ISIM,IBB,IGAU,IZON
  17 :       IF (NSTRS.EQ.3) THEN
  18 :       SX=S1(1)
  19 :       SY=S1(2)
  20 :       SXY=S1(3)
  21 :       DJ2=(1.D0/6.D0)*((SX-SY)*(SX-SY)+SX*SX+SY*SY+6*SXY*SXY)
  22 :       ELSE
  23 :       SX=S1(1)
  24 :       SY=S1(2)
  25 :       SZ=S1(3)
  26 :       SXY=S1(4)
  27 :       TX=(SX-SY)*(SX-SY)
  28 :       TY=(SX-SZ)*(SX-SZ)
  29 :       TZ=(SY-SZ)*(SY-SZ)
  30 :       DJ2=(1.D0/6.D0)*(TX+TY+TZ+6*SXY*SXY)
  31 :       ENDIF
  32 :       DJ2=3.D0*DJ2
  33 :       DJ2=SQRT(DJ2)
  34 :       SEQ=DJ2
  35 : C
  36 :       RETURN
  37 :       END
  38 : 
  39 :  
  40 :  

© Cast3M 2003 - All rights reserved.
Disclaimer