Download giocrt.eso

Back to the list

   1 : C GIOCRT    SOURCE    CHAT      05/01/13    00:18:25     5004           
   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 :       INVERS=0
  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=DABS ( (VAR(IDEB+I)-3D0)/3D0 )
  22 :       IF(TEST.LT.TOL)THEN
  23 : C
  24 :       DEVP0= EVP(I)-EVP0(I)
  25 :       DABSE= DABS(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=DABS ( (VAR(IDEB+I)-2D0)/2D0 )
  57 :       IF(TEST.LT.TOL)THEN
  58 : C
  59 :       DEVP0= EVP(I)-EVP0(I)
  60 :       DABSE= DABS(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= DABS(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= DMAX1(XIVERS,VAR(IDEB+I))
 128 :    34 CONTINUE
 129 : C
 130 :          TEST=DABS ( (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 :  

© Cast3M 2003 - All rights reserved.
Disclaimer