Esope source files

   1 : C CLBBBB    SOURCE    CHAT      05/01/12    22:04:23     5004           
   2 :       SUBROUTINE CLBBBB(WRK0,WRK1,WRK5,NSTRS,NVARI,NMATT,ISTEP,
   3 :      1                                    ICARA,KERRE,MFR,IFOURB)
   4 : C
   5 : C    calcule la deformation initiale a partir de la contrainte initiale
   6 : C    puis appelle la subroutine CLBCOM
   7 : C
   8 : C
   9 : C     variables en entree
  10 : C
  11 : C     WRK0,KRK1  pointeurs sur des segments de travail
  12 : C
  13 : C     NSTRS      nombre de composantes dans les vecteurs des contraintes
  14 : C                                        et les vecteurs des deformations
  15 : C
  16 : C     NVARI      nombre de variables internes (doit etre egal a 4)
  17 : C
  18 : C     NMATT      nombre de constantes du materiau
  19 : C
  20 : C     ISTEP      flag utilise pour separer les etapes dans un calcul non local
  21 : C                ISTEP=0 -----> calcul local
  22 : C                ISTEP=1 -----> calcul non local etape 1 on calcule les seuils
  23 : C                ISTEP=2 -----> calcul non local etape 2 on continue le calcul
  24 : C                               a partir des seuils moyennes
  25 : C
  26 : C
  27 : C     variables en sortie
  28 : C
  29 : C     VARF      variables internes finales dans WRK0
  30 : C
  31 : C     SIGF      contraintes finales dans WRK0
  32 :       IMPLICIT INTEGER(I-N)
  33 :       IMPLICIT REAL*8(A-H,O-Z)
  34 : -INC CCOPTIO
  35 :       SEGMENT WRK0
  36 :         REAL*8 XMAT(NMATT)
  37 :       ENDSEGMENT
  38 : *
  39 :       SEGMENT WRK1
  40 :         REAL*8 DDHOOK(NSTRS,NSTRS),SIG0(NSTRS),DEPST(NSTRS)
  41 :         REAL*8 SIGF(NSTRS),VAR0(NVARI),VARF(NVARI)
  42 :         REAL*8 DEFP(NSTRS),XCAR(ICARA)
  43 :       ENDSEGMENT
  44 :       SEGMENT WRKK2
  45 :          REAL*8 EPSILI(NSTRSV)
  46 :       END SEGMENT
  47 : *
  48 :       SEGMENT WRK5
  49 :         REAL*8 EPIN0(NSTRS),EPINF(NSTRS),EPST0(NSTRS)
  50 :       ENDSEGMENT
  51 :       SEGMENT WRK6
  52 :         REAL*8 SIG0S(NSTRS)
  53 :       END SEGMENT
  54 : *
  55 :       CHARACTER*8 CMATE
  56 :       DIMENSION DSIGT(6)
  57 :       PARAMETER (UN=1.D0)
  58 :       KERRE=0
  59 : C
  60 :       IF (MFR .EQ. 9) THEN
  61 :          NSTRSV=4
  62 :          IFOUR2=-2
  63 :       ELSE IF (MFR .EQ. 1) THEN
  64 :          NSTRSV=NSTRS
  65 :          IF (IFOURB.NE. -2)THEN
  66 :             KERRE=57
  67 :             RETURN
  68 :          END IF
  69 :          IFOUR2=IFOURB
  70 :       ELSE
  71 :          KERRE=57
  72 :          RETURN
  73 :       END IF
  74 : C
  75 : C     calcul de la matrice elastique
  76 : C
  77 :       CMATE = 'ISOTROPE'
  78 :       KCAS=2
  78 :       CALL DOHMAS(XMAT,CMATE,IFOUR2,NSTRSV,KCAS,DDHOOK,IRTD)
  79 :       IF ( IRTD .EQ. 1) THEN
  80 : C
  81 : C      calcul de l'increment de contrainte
  82 : C
  82 :          CALL MATVE1 (DDHOOK,DEPST,NSTRSV,NSTRSV,DSIGT,1)
  83 : C
  84 : C
  85 : C     ON CALCULE LES CONTRAINTES VRAIES DANS LE CAS DES COQUES
  86 : C
  87 :          IF (MFR .EQ. 9) THEN
  88 :            EPAI=XCAR(1)
  89 :            SEGINI WRK6
  90 :            DO ISTRS=1,NSTRS
  91 :              SIG0S(ISTRS)=SIG0(ISTRS)
  92 :            END DO
  93 :            DO ISTRS=1,2
  94 :              SIG0(ISTRS)=SIG0(ISTRS)/EPAI
  95 :            END DO
  96 :            SIG0(3)=0.D0
  97 :            SIG0(4)=SIG0S(3)/EPAI
  98 :          END IF
  99 : C
 100 : C     inversion de la matrice
 101 : C
 102 :          PREC=1.D-08
 103 :          SEGINI WRKK2
 103 :          CALL INVALM(DDHOOK,NSTRSV,NSTRSV,IRTD,PREC)
 104 :          IF (IRTD.EQ.0)THEN
 105 : C
 106 : C     calcul des deformations du materiau elastique lineaire
 107 : C
 107 :            CALL MATVE1 (DDHOOK,SIG0,NSTRSV,NSTRSV,EPSILI,1)
 108 : C
 109 : C     modification pour tenir compte de l'endommagement
 110 : C
 111 :             DO 100 ISTRS=1,NSTRSV
 112 :                EPSILI(ISTRS)=EPSILI(ISTRS)+EPIN0(ISTRS)
 113 : 100         CONTINUE
 114 : C
 115 : C      appel a la routine CLBCOM
 116 : C
 116 :             CALL  CLBECO (WRK0,WRK1,WRKK2,WRK5,NSTRSV,NVARI,NMATT,
 117 :      1                                         ISTEP,ICARA,KERRE)
 118 : C
 119 : C      ON RECALCULE LES CONTRAINTES EFFECTIVES POUR LES COQUES
 120 : C
 121 :             IF (MFR .EQ. 9) THEN
 122 :                DO ISTRS=1,NSTRS
 123 :                   SIG0(ISTRS)=SIG0S(ISTRS)
 124 :                END DO
 125 :                DO ISTRS=1,2
 126 :                   SIGF (ISTRS)=SIGF(ISTRS)*EPAI
 127 :                END DO
 128 :                SIGF (3)=SIGF(4)*EPAI
 129 :                DO ISTRS=4,NSTRS
 130 :                   SIGF(ISTRS)=SIG0(ISTRS)+DSIGT(ISTRS)
 131 :                END DO
 132 :                SEGSUP WRK6
 133 :             END IF
 134 :          ELSE
 135 :              print*,'erreur dans invalm'
 136 :              KERRE=56
 137 :          END IF
 138 :       ELSE
 139 :          print*,'erreur dans dohmas'
 140 :          KERRE=56
 141 :       END IF
 142 :       SEGSUP WRKK2
 143 :       RETURN
 144 :       END
 145 :  
 146 :  
 147 :