Sources Esope | Cast3M

cridru
C CRIDRU    SOURCE    CHAT      05/01/12    22:30:23     5004
      SUBROUTINE CRIDRU(S1,SEQ,NSTRS,BETJEF)
C
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)
      DIMENSION S1(4),V1(4)
C
*
      SEGMENT BETJEF
       REAL*8 AA,BETA,RB,ALPHA,EX,PXY,GFC,GFT,CAR,ETA,TDEF,
     &          TCON,DPSTF1,DPSTF2,TETA,PDT
       INTEGER ICT,ICC,IMOD,IVIS,ITER,
     &                ISIM,IBB,IGAU,IZON
      ENDSEGMENT
*
*     COMMON /DBETJEF/AA,BETA,RB,ALPHA,EX,PXY,GFC,GFT,CAR,ETA,TDEF,
*    &          TCON,DPSTF1,DPSTF2,TETA,PDT,ICT,ICC,IMOD,IVIS,ITER,
*    &                ISIM,IBB,IGAU,IZON
C
      IF (BETA.LE.0.D0.OR.BETA.GE.1.5D0) THEN
       WRITE(*,*)'ATTENTION MAUVAISE VALEUR DE BETA'
       STOP
      ENDIF
      A1=(BETA-1.D0)/(2*BETA-1.D0)
      A2=BETA/(2*BETA-1.D0)
      CALL PRINC(S1,V1,NSTRS)
      IF (NSTRS.EQ.3) THEN
      SX=S1(1)
      SY=S1(2)
      SXY=S1(3)
      DJ2=(1.D0/6.D0)*((SX-SY)*(SX-SY)+SX*SX+SY*SY+6*SXY*SXY)
      DI1=V1(1)+V1(2)
      ELSE
      SX=S1(1)
      SY=S1(2)
      SZ=S1(3)
      SXY=S1(4)
      TX=(SX-SY)*(SX-SY)
      TY=(SX-SZ)*(SX-SZ)
      TZ=(SY-SZ)*(SY-SZ)
      DJ2=(1.D0/6.D0)*(TX+TY+TZ+6*SXY*SXY)
      DI1=V1(1)+V1(2)+V1(3)
      ENDIF
      DJ2=3.D0*DJ2
      DJ2=SQRT(DJ2)
      SEQ=(DJ2+A1*DI1)/A2
C
      RETURN
      END