Esope source files

   1 : C ROTATI    SOURCE    CHAT      05/01/13    03:05:11     5004           
   2 : C MAZZZ     SOURCE    AM        92/09/30    21:43:12     712
   3 :       SUBROUTINE ROTATI(WRK0,WRK1,WRK5,NSTRS,NVARI,NMATT,
   4 :      1                                           ISTEP,ICARA,KERRE)
   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     NSTRS      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 :       SEGMENT WRK0
  38 :         REAL*8 XMAT(NMATT)
  39 :       ENDSEGMENT
  40 : *
  41 :       SEGMENT WRK1
  42 :         REAL*8 DDHOOK(LHOOK,LHOOK),SIG0(NSTRS),DEPST(NSTRS)
  43 :         REAL*8 SIGF(NSTRS),VAR0(NVARI),VARF(NVARI)                              
  44 :         REAL*8 DEFP(NSTRS),XCAR(ICARA)                                          
  45 :       ENDSEGMENT
  46 :       SEGMENT WRKK2
  47 :          REAL*8 EPSILI(NSTRS)
  48 :       END SEGMENT
  49 :       SEGMENT WRK5
  50 :         REAL*8 EPIN0(NSTRS),EPINF(NSTRS),EPST0(NSTRS)
  51 :       ENDSEGMENT
  52 :       CHARACTER*8 CMATE
  53 :       INTEGER NSTRS,NVARI,NMATT
  54 :       INTEGER KCAS,IRTD,ISTRS,KERRE
  55 :       REAL*8 PREC
  56 :       REAL*8 UN
  57 :       PARAMETER (UN=1.D0)
  58 :       KERRE=0
  59 : C
  60 : C     calcul de la matrice elastique
  61 : C
  62 :       CMATE = 'ISOTROPE'
  63 :       KCAS=1
  63 :       CALL DOHMAS(XMAT,CMATE,IFOUR,NSTRS,KCAS,DDHOOK,IRTD)
  64 :       IF ( IRTD .EQ. 1) THEN
  65 : C
  66 : C     inversion de cette matrice
  67 : C
  68 :          PREC=1.D-08
  69 :          SEGINI WRKK2
  70 :          IF (IFOUR.EQ.-2) THEN
  70 :            CALL INVALM(DDHOOK,NSTRS,2,IRTD,PREC)
  71 :            DDHOOK(4,4)=1/DDHOOK(4,4)
  72 :          ELSE
  72 :            CALL INVALM(DDHOOK,NSTRS,NSTRS,IRTD,PREC)
  73 :          ENDIF 
  74 :          IF (IRTD.EQ.0)THEN
  75 : C
  76 : C     calcul des deformations du materiau elastique lineaire
  77 : C
  77 :             CALL MATVE1 (DDHOOK,SIG0,NSTRS,NSTRS,EPSILI,1)
  78 : C
  79 : C     modification pour tenir compte de l'endommagement
  80 : C
  81 : C           PRINT*,'DANS ROTATI:'
  82 : C           PRINT*,'EPSILI',(EPSILI(ISTRS),ISTRS=1,NSTRS)
  83 : C           PRINT*,'EPIN0',(EPIN0(ISTRS),ISTRS=1,NSTRS)
  84 :             IF (IFOUR.EQ.-2) THEN
  85 :              EPSILI(3)=-XMAT(2)/(1.D0-XMAT(2))*(EPSILI(1)+EPSILI(2))
  86 :             ENDIF
  87 :             DO 100 ISTRS=1,NSTRS
  88 :              EPSILI(ISTRS)=EPSILI(ISTRS)+EPIN0(ISTRS)
  89 : 100         CONTINUE
  90 : C
  91 : C      appel a la routine ROTAT2
  92 : C
  93 : *           PRINT*,'DEPSIL=DEPST',(DEPST(ISTRS),ISTRS=1,NSTRS)
  93 :             CALL  ROTAT2 (WRK0,WRK1,WRKK2,WRK5,NSTRS,NVARI,NMATT,
  94 :      1                                                 ISTEP,ICARA)
  95 :          ELSE
  96 :              print*,'erreur dans invalm'
  97 :              KERRE=56
  98 :          END IF
  99 :       ELSE
 100 :          print*,'erreur dans dohmas'
 101 :          KERRE=56
 102 :       END IF
 103 :       SEGSUP WRKK2
 104 :       RETURN
 105 :       END
 106 :  
 107 :  
 108 :