Esope source files

   1 : C CRIDRU    SOURCE    CHAT      05/01/12    22:30:23     5004           
   2 :       SUBROUTINE CRIDRU(S1,SEQ,NSTRS,BETJEF)
   3 : C
   4 :       IMPLICIT INTEGER(I-N)
   5 :       IMPLICIT REAL*8(A-H,O-Z)
   6 :       DIMENSION S1(4),V1(4)
   7 : C
   8 : *
   9 :       SEGMENT BETJEF
  10 :        REAL*8 AA,BETA,RB,ALPHA,EX,PXY,GFC,GFT,CAR,ETA,TDEF,
  11 :      &          TCON,DPSTF1,DPSTF2,TETA,PDT
  12 :        INTEGER ICT,ICC,IMOD,IVIS,ITER,
  13 :      &                ISIM,IBB,IGAU,IZON
  14 :       ENDSEGMENT
  15 : *
  16 : *     COMMON /DBETJEF/AA,BETA,RB,ALPHA,EX,PXY,GFC,GFT,CAR,ETA,TDEF,
  17 : *    &          TCON,DPSTF1,DPSTF2,TETA,PDT,ICT,ICC,IMOD,IVIS,ITER,
  18 : *    &                ISIM,IBB,IGAU,IZON
  19 : C
  20 :       IF (BETA.LE.0.D0.OR.BETA.GE.1.5D0) THEN
  21 :        WRITE(*,*)'ATTENTION MAUVAISE VALEUR DE BETA'
  22 :        STOP
  23 :       ENDIF
  24 :       A1=(BETA-1.D0)/(2*BETA-1.D0)
  25 :       A2=BETA/(2*BETA-1.D0)
  25 :       CALL PRINC(S1,V1,NSTRS)
  26 :       IF (NSTRS.EQ.3) THEN
  27 :       SX=S1(1)
  28 :       SY=S1(2)
  29 :       SXY=S1(3)
  30 :       DJ2=(1.D0/6.D0)*((SX-SY)*(SX-SY)+SX*SX+SY*SY+6*SXY*SXY)
  31 :       DI1=V1(1)+V1(2)
  32 :       ELSE
  33 :       SX=S1(1)
  34 :       SY=S1(2)
  35 :       SZ=S1(3)
  36 :       SXY=S1(4)
  37 :       TX=(SX-SY)*(SX-SY)
  38 :       TY=(SX-SZ)*(SX-SZ)
  39 :       TZ=(SY-SZ)*(SY-SZ)
  40 :       DJ2=(1.D0/6.D0)*(TX+TY+TZ+6*SXY*SXY)
  41 :       DI1=V1(1)+V1(2)+V1(3)
  42 :       ENDIF
  43 :       DJ2=3.D0*DJ2
  44 :       DJ2=SQRT(DJ2)
  45 :       SEQ=(DJ2+A1*DI1)/A2
  46 : C
  47 :       RETURN
  48 :       END
  49 : 
  50 :  
  51 :