Télécharger cridru.eso

Retour à la liste

Numérotation des lignes :

  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)
  26. CALL PRINC(S1,V1,NSTRS)
  27. IF (NSTRS.EQ.3) THEN
  28. SX=S1(1)
  29. SY=S1(2)
  30. SXY=S1(3)
  31. DJ2=(1.D0/6.D0)*((SX-SY)*(SX-SY)+SX*SX+SY*SY+6*SXY*SXY)
  32. DI1=V1(1)+V1(2)
  33. ELSE
  34. SX=S1(1)
  35. SY=S1(2)
  36. SZ=S1(3)
  37. SXY=S1(4)
  38. TX=(SX-SY)*(SX-SY)
  39. TY=(SX-SZ)*(SX-SZ)
  40. TZ=(SY-SZ)*(SY-SZ)
  41. DJ2=(1.D0/6.D0)*(TX+TY+TZ+6*SXY*SXY)
  42. DI1=V1(1)+V1(2)+V1(3)
  43. ENDIF
  44. DJ2=3.D0*DJ2
  45. DJ2=SQRT(DJ2)
  46. SEQ=(DJ2+A1*DI1)/A2
  47. C
  48. RETURN
  49. END
  50.  
  51.  
  52.  
  53.  

© Cast3M 2003 - Tous droits réservés.
Mentions légales