Esope source files

   1 : C COTATI    SOURCE    KICH      09/09/11    21:17:38     6505           
   2 : C ROTATI    SOURCE    AM        00/12/13    21:42:28     4045           
   3 : C MAZZZ     SOURCE    AM        92/09/30    21:43:12     712
   4 :       SUBROUTINE COTATI(WRK52,WRK53,WRK54,NSTRS1,NVARI,ICARA)
   5 : C
   6 : C    calcule la deformation initiale et l'increment de deformation
   7 : C    a partir de la contrainte initiale et l'increment de contrainte
   8 : C    elastique puis appelle la subroutine ROTAT2
   9 : C
  10 : C
  11 : C     variables en entree
  12 : C
  13 : C     WRK0,KRK1,WRK5  pointeurs sur des segments de travail
  14 : C
  15 : C     NSTRS1      nombre de composantes dans les vecteurs des contraintes
  16 : C                                        et les vecteurs des deformations
  17 : C
  18 : C     NVARI      nombre de variables internes (doit etre egal a 2)
  19 : C
  20 : C     NMATT      nombre de constantes du materiau
  21 : C
  22 : C     ISTEP      flag utilise pour separer les etapes dans un calcul non local
  23 : C                ISTEP=0 -----> calcul local
  24 : C                ISTEP=1 -----> calcul non local etape 1 on calcule les seuils
  25 : C                ISTEP=2 -----> calcul non local etape 2 on continue le calcul
  26 : C                               a partir des seuils moyennes
  27 : C
  28 : C
  29 : C     variables en sortie
  30 : C
  31 : C     VARF      variables internes finales dans WRK0
  32 : C
  33 : C     SIGF      contraintes finales dans WRK0
  34 :       IMPLICIT INTEGER(I-N)
  35 :       IMPLICIT REAL*8(A-H,O-Z)
  36 : -INC CCOPTIO
  37 : -INC DECHE
  38 : *
  39 :       SEGMENT WRKK2
  40 :          REAL*8 EPSILI(NSTRS)
  41 :       END SEGMENT
  42 :       INTEGER NSTRS1,NVARI
  43 :       INTEGER KCAS,IRTD,ISTRS
  44 :       REAL*8 PREC
  45 :       REAL*8 UN
  46 :       PARAMETER (UN=1.D0)
  47 :       KERRE=0
  48 : C
  49 : C     calcul de la matrice elastique
  50 : C
  51 :       CMATE = 'ISOTROPE'
  52 :       KCAS=1
  52 :       CALL DOHMAS(XMAT,CMATE,IFOUR,NSTRS1,KCAS,DDHOOK,IRTD)
  53 :       IF ( IRTD .EQ. 1) THEN
  54 : C
  55 : C     inversion de cette matrice
  56 : C
  57 :          PREC=1.D-08
  58 :          SEGINI WRKK2
  59 :          IF (IFOUR.EQ.-2) THEN
  59 :            CALL INVALM(DDHOOK,NSTRS1,2,IRTD,PREC)
  60 :            DDHOOK(4,4)=1/DDHOOK(4,4)
  61 :          ELSE
  61 :            CALL INVALM(DDHOOK,NSTRS1,NSTRS1,IRTD,PREC)
  62 :          ENDIF 
  63 :          IF (IRTD.EQ.0)THEN
  64 : C
  65 : C     calcul des deformations du materiau elastique lineaire
  66 : C
  66 :             CALL MATVE1 (DDHOOK,SIG0,NSTRS1,NSTRS1,EPSILI,1)
  67 : C
  68 : C     modification pour tenir compte de l'endommagement
  69 : C
  70 : C           PRINT*,'DANS ROTATI:'
  71 : C           PRINT*,'EPSILI',(EPSILI(ISTRS),ISTRS=1,NSTRS1)
  72 : C           PRINT*,'EPIN0',(EPIN0(ISTRS),ISTRS=1,NSTRS1)
  73 :             IF (IFOUR.EQ.-2) THEN
  74 :              EPSILI(3)=-XMAT(2)/(1.D0-XMAT(2))*(EPSILI(1)+EPSILI(2))
  75 :             ENDIF
  76 :             DO 100 ISTRS=1,NSTRS1
  77 :              EPSILI(ISTRS)=EPSILI(ISTRS)+EPIN0(ISTRS)
  78 : 100         CONTINUE
  79 : C
  80 : C      appel a la routine ROTAT2
  81 : C
  82 : *           PRINT*,'DEPSIL=DEPST',(DEPST(ISTRS),ISTRS=1,NSTRS1)
  82 :             CALL  COTAT2 (wrk52,wrk53,wrk54,WRKK2,NSTRS1,NVARI,ICARA)
  83 :          ELSE
  84 :              print*,'erreur dans invalm'
  85 :              KERRE=56
  86 :          END IF
  87 :       ELSE
  88 :          print*,'erreur dans dohmas'
  89 :          KERRE=56
  90 :       END IF
  91 :       SEGSUP WRKK2
  92 :       RETURN
  93 :       END
  94 :  
  95 :  
  96 :  
  97 :  
  98 :  
  99 :  
 100 :  
 101 :