Télécharger la plaquette Cast3M


fr en

Télécharger giocrt.eso

Retour à la liste

Numérotation des lignes : 

giocrt

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

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