Télécharger giocrt.eso

Retour à la liste

Numérotation des lignes :

  1. C GIOCRT SOURCE CB215821 16/04/21 21:17:01 8920
  2. SUBROUTINE GIOCRT(EVP,EVP0,NSTRS,VAR,NVARI,INVERS)
  3. C
  4. IMPLICIT INTEGER(I-N)
  5. IMPLICIT REAL*8(A-H,O-Z)
  6. C
  7. C
  8. DIMENSION EVP(*),EVP0(*),VAR(*)
  9. C
  10. C CRITERE D'INVERSION : EXTREMUM D'UNE DES COMPOSANTES DU TENSEUR
  11. C DES DEFORMATIONS VISCOPLASTIQUES
  12. C
  13. C
  14. IDEB=NVARI-2*NSTRS
  15. IDEBI=NVARI-NSTRS
  16. TOL=1D-4
  17. C
  18. DO 30 I= 1,NSTRS
  19. C
  20. TEST=ABS( (VAR(IDEB+I)-3D0)/3D0 )
  21. IF(TEST.LT.TOL)THEN
  22. C
  23. DEVP0= EVP(I)-EVP0(I)
  24. DABSE= ABS(DEVP0)
  25. IF(DABSE.LT.(1.D-6))THEN
  26. GO TO 327
  27. ENDIF
  28. C
  29. IF(VAR(IDEBI+I).GT.0D0)THEN
  30. C
  31. IF(EVP(I).GT.EVP0(I))THEN
  32. VAR(IDEB+I)= 5D0
  33. VAR(IDEBI+I)= 1D0
  34. ELSE
  35. VAR(IDEB+I)= 1D0
  36. VAR(IDEBI+I)= -1D0
  37. ENDIF
  38. C
  39. ELSE
  40. C
  41. IF(EVP(I).LT.EVP0(I))THEN
  42. VAR(IDEB+I)= 5D0
  43. VAR(IDEBI+I)= -1D0
  44. ELSE
  45. VAR(IDEB+I)= 1D0
  46. VAR(IDEBI+I)= 1D0
  47. ENDIF
  48. C
  49. ENDIF
  50. C
  51. 327 CONTINUE
  52. C
  53. ENDIF
  54. C
  55. TEST=ABS( (VAR(IDEB+I)-2D0)/2D0 )
  56. IF(TEST.LT.TOL)THEN
  57. C
  58. DEVP0= EVP(I)-EVP0(I)
  59. DABSE= ABS(DEVP0)
  60. IF(DABSE.LT.(1.D-6))THEN
  61. GO TO 328
  62. ENDIF
  63. C
  64. IF(VAR(IDEBI+I).GE.0D0)THEN
  65. C
  66. IF(EVP(I).GT.EVP0(I))THEN
  67. VAR(IDEB+I)= 2D0
  68. VAR(IDEBI+I)= 1D0
  69. ELSE
  70. VAR(IDEB+I)= 3D0
  71. VAR(IDEBI+I)= -1D0
  72. ENDIF
  73. C
  74. ELSE
  75. C
  76. IF(EVP(I).LT.EVP0(I))THEN
  77. VAR(IDEB+I)= 2D0
  78. VAR(IDEBI+I)= -1D0
  79. ELSE
  80. VAR(IDEB+I)= 3D0
  81. VAR(IDEBI+I)= 1D0
  82. ENDIF
  83. C
  84. ENDIF
  85. C
  86. 328 CONTINUE
  87. C
  88. ENDIF
  89. C
  90. IF(VAR(IDEB+I).LE.1D0)THEN
  91. C
  92. DEVP0= EVP(I)-EVP0(I)
  93. DABSE= ABS(DEVP0)
  94. IF(DABSE.LT.(1.D-6))GO TO 329
  95. C
  96. IF(VAR(IDEBI+I).GE.0D0)THEN
  97. C
  98. IF(EVP(I).GT.EVP0(I))THEN
  99. VAR(IDEB+I)= 2D0
  100. VAR(IDEBI+I)= 1D0
  101. ELSE
  102. VAR(IDEB+I)= 1D0
  103. VAR(IDEBI+I)= -1D0
  104. ENDIF
  105. C
  106. ELSE
  107. C
  108. IF(EVP(I).LT.EVP0(I))THEN
  109. VAR(IDEB+I)= 2D0
  110. VAR(IDEBI+I)= -1D0
  111. ELSE
  112. VAR(IDEB+I)= 1D0
  113. VAR(IDEBI+I)= 1D0
  114. ENDIF
  115. C
  116. ENDIF
  117.  
  118. 329 CONTINUE
  119. C
  120. ENDIF
  121. C
  122. 30 CONTINUE
  123. C
  124. XIVERS= 0D0
  125. DO 34 I= 1,NSTRS
  126. XIVERS= DMAX1(XIVERS,VAR(IDEB+I))
  127. 34 CONTINUE
  128. C
  129. TEST=ABS( (XIVERS-5D0)/5D0 )
  130. IF(TEST.LT.TOL)THEN
  131. C
  132. C------ MAJ DE VAR(4+NSTRS+1 @ NVARI)
  133. C Gestion des inversions : P1M, K, EPSVIK
  134. C K = VAR (6+NSTRS) ; EPSVIK = VAR (6+NSTRS+ 1..NSTRS)
  135. C P1 = VAR (2) ; P1M = VAR (5+NSTRS)
  136. C --- INVERSION : K=K+1 ; P1M=P1 ; P1=0 ; EPSVIK=EVP -----
  137. C
  138. CCCC PSI1M= PSI1
  139. VAR(5+NSTRS) = VAR(2)
  140. VAR(2) = 0.0
  141. VAR(6+NSTRS) = VAR(6+NSTRS) + 1D0
  142. INVERS= 1
  143. DO 35 I= 1,NSTRS
  144. VAR(6+NSTRS+I) = EVP(I)
  145. VAR(IDEB+I)= 0D0
  146. 35 CONTINUE
  147. ENDIF
  148. C
  149. RETURN
  150. END
  151.  
  152.  
  153.  
  154.  
  155.  
  156.  
  157.  

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