Télécharger pinoto.eso

Retour à la liste

Numérotation des lignes :

  1. C PINOTO SOURCE CHAT 05/01/13 02:13:59 5004
  2. C PINOTO SOURCE INSL 24/10/96
  3. SUBROUTINE PINOTO(EPSR,STRN,STRNR,SIGR,SIGMR,SIGM,S1,V1,D,IPLA,
  4. 1 JFRIS,NSTRS,IFOUR,EPEQC,SEQC,EBC,EPEQ0,SEQ0,SEQB1,XE,NBNN,MELE,
  5. 2 EQSTR1,EPSEQ1,AA,BB,DK1,DK2,ILOI,ALPHA,RB,EX,PXY,EPO,ICAL,wrk12)
  6. C
  7. IMPLICIT INTEGER(I-N)
  8. IMPLICIT REAL*8(A-H,O-Z)
  9. DIMENSION S1(NSTRS),D(NSTRS,NSTRS),S2(6),EPSR(6)
  10. DIMENSION STRN(NSTRS),SIGMR(6),SIGR(6),STRNR(6)
  11. DIMENSION V1(4),V3(4),SIGM(NSTRS),XE(3,NBNN)
  12. DIMENSION SI0(6),ST0(6),DST(6),DSI(6),D1(6,6)
  13. C
  14. SEGMENT WRK12
  15. real*8 bbet1,bbet2,bbet3,bbet4,bbet5,bbet6,bbet7,bbet8,bbet9
  16. real*8 bbet10,bbet11,bbet12,bbet13,bbet14,bbet15,bbet16,bbet17
  17. real*8 bbet18,bbet19,bbet20,sct,teta,DTR1,dtr2,bbet25
  18. real*8 bbet26,bbet27,bbet28,bbet29,bbet30,bbet31,bbet32,bbet33
  19. real*8 bbet34,bbet35,bbet36,bbet37,bbet38,bbet39,bbet40,bbet41
  20. real*8 bbet42,bbet43,bbet44,bbet45,bbet46,bbet47,bbet48,bbet49
  21. real*8 bbet50,bbet51,bbet52,bbet53,bbet54,bbet55
  22. integer ibet1,ibet2,ibet3,ibet4,ibet5,ibet6,ibet7,ibet8
  23. integer ibet9,ibet10,ibet11,ibet12,ibet13,ibet14,ibet15,ibet16
  24. ENDSEGMENT
  25. * COMMON /CINSA/ POUI(20),SCT,TETA,DTR1,DTR2,POUJ(31),IPOU(16)
  26. C
  27. C ########################################################
  28. C * TRACTION-COMPRESSION OU BI-TRACTION *
  29. C * *
  30. C * IPLA = INDICE DE PLASTICITE *
  31. C * =1 ECROUISSAGE *
  32. C * =2 SOFTENING *
  33. C * =3 RUPTURE (deformation > EMAX) *
  34. C * *
  35. C * JFRIS = INDICE DE FISSURATION *
  36. C * =0 PAS DE FISSURE *
  37. C * =2 POINT FISSURE *
  38. C ########################################################
  39. C----------------------------------------------------------------------
  40. SEQ00=SEQ0
  41. EPEQ00=EPEQ0
  42. CALL ZERO(S2,6,1)
  43. DO 11 I=1,NSTRS
  44. S1(I) =SIGMR(I)
  45. DSI(I)=SIGM(I)
  46. S2(I) =STRNR(I)
  47. 11 CONTINUE
  48. IF(NSTRS.EQ.4.OR.NSTRS.EQ.6) THEN
  49. S2(3)=STRNR(4)
  50. S2(4)=STRNR(3)
  51. ENDIF
  52. S2(3)=S2(3)/2.D0
  53. CALL PRINC(S2,V3,NSTRS)
  54. S2(3)=S2(3)*2.D0
  55. C----------------------------------------------------------------------
  56. IPLA =0
  57. TU=RB
  58. ITES=0
  59. IRUP=0
  60. CALL CRIOTO(SIGMR,SEQB1,FCRI,NSTRS,TU,AA,BB,DK1,DK2)
  61. C----------------------------------------------------------------------
  62. IF(EPEQC.GE.EPO) THEN
  63. C --------------------------------------------------------------
  64. C * ON TEST SI ON A DEPASSE LE PIC EN DEFORMATION EQUIVALENTE *
  65. C --------------------------------------------------------------
  66. IRUP=1
  67. ITES=1
  68. IPLA=2
  69. CALL SCALT(SIGM,SIGR,SI0,V1,SCT,NSTRS,DTAU,RB,AA,BB,DK1,DK2,
  70. & ALPHA,RB,DTR1,DTR2,TETA)
  71. DO 10 I=1,NSTRS
  72. S1(I)=SI0(I)
  73. 10 CONTINUE
  74. GOTO 300
  75. ENDIF
  76. C==================================================================
  77. IF(ICAL.EQ.1) GOTO 200
  78. C----------------------------------------------------------------------
  79. CALL CALPIN(IFOUR,STRN,SIGM,SIGR,S1,D,NSTRS,EBC,AA,BB,DK1,DK2,
  80. 1 ILOI,RB,EX,PXY)
  81. CALL CRIOTO(S1,SEQB,FCRI,NSTRS,TU,AA,BB,DK1,DK2)
  82. IF(SEQB.LT.TU) GOTO 200
  83. C----------------------------------------------------------------------
  84. DO I=1,NSTRS
  85. DSI(I)=S1(I)-SIGR(I)
  86. END DO
  87. CALL SCALT(DSI,SIGR,SI0,V1,SCT,NSTRS,DTAU,RB,AA,BB,DK1,DK2,
  88. & ALPHA,RB,DTR1,DTR2,TETA)
  89. DO 21 I=1,NSTRS
  90. S1(I)=SI0(I)
  91. 21 CONTINUE
  92. C==================================================================
  93. 300 CONTINUE
  94. C ***************************
  95. C * LE CRITERE EST VIOLE *
  96. C ***************************
  97. C
  98. IF(V1(1).GE.0.D0.OR.V1(2).GE.0.D0.OR.JFRIS.NE.0) THEN
  99. C *******************************************
  100. C * LE CRITERE EST VIOLE PAR FISSURATION *
  101. C *******************************************
  102. TETA=V1(4)
  103. JFRIS=2
  104. IPLA=0
  105. CALL FISPLA(EPSR,STRN,STRNR,SIGR,DSI,S1,NSTRS,IFOUR,0,
  106. & XE,NBNN,MELE,wrk12)
  107. GOTO 200
  108. ENDIF
  109. C----------------------------------------------------------
  110. TETA=0.D0
  111. DTR1=0.D0
  112. DTR2=0.D0
  113. SCT =0.D0
  114. IF(IRUP.EQ.0) GOTO 200
  115. C==================================================================
  116. C *******************************************
  117. C * LE CRITERE EST VIOLE EN BICOMPRESSION *
  118. C *******************************************
  119. C
  120. CALL CALPEC(IFOUR,STRN,SIGR,SIGM,S1,D,NSTRS,SEQC,EBC,EPEQC,
  121. 1 EPSR,STRNR,JFRIS,IPLA,EPEQ00,SEQ00,XE,NBNN,MELE,EQSTR1,EPSEQ1,
  122. 2 AA,BB,DK1,DK2,ILOI,RB,ALPHA,EX,PXY,EPO,wrk12)
  123. C
  124. C==================================================================
  125. 200 CONTINUE
  126. 1991 FORMAT(18(1X,E12.5))
  127. C----------------------------------------------------------------------
  128. RETURN
  129. END
  130.  
  131.  
  132.  
  133.  
  134.  
  135.  
  136.  
  137.  

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