Esope source files

   1 : C COLBBB    SOURCE    KICH      09/09/11    21:16:49     6505           
   2 :       SUBROUTINE COLBBB(WRK52,WRK53,WRK54,NVARI,iecou,necou)
   3 : C CLBBBB    SOURCE    AM        98/12/23    21:19:43     3409           
   4 : c      SUBROUTINE CLBBBB(WRK0,WRK1,WRK5,NSTRS,NVARI,NMATT,ISTEP,
   5 : c     1                                    ICARA,KERRE,MFR,IFOURB)
   6 : C
   7 : C    calcule la deformation initiale a partir de la contrainte initiale
   8 : C    puis appelle la subroutine CLBCOM
   9 : C
  10 : C
  11 : C     variables en entree
  12 : C
  13 : C     WRK0,KRK1  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 4)
  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 KICH     XCARB <- XCAR      colbbb <- clbbbb
  30 : 
  31 :       IMPLICIT INTEGER(I-N)
  32 :       IMPLICIT REAL*8(A-H,O-Z)
  33 : -INC CCOPTIO
  34 : -INC DECHE
  35 :       SEGMENT IECOU
  36 : *      COMMON/IECOU/NYOG,NYNU,NYALFA,NYSMAX,NYN,NYM,NYKK,
  37 :        INTEGER icow1,icow2,icow3,icow4,icow5,icow6,icow7,
  38 : C      INTEGER NYOG, NYNU, NYALFA,NYSMAX,NYN, NYM,  NYKK,
  39 :      1  icow8,icow9,icow10,icow11,icow12,icow13,icow14,icow15,icow16,
  40 : C    .  NYALF1,NYBET1,NYR,  NYA,   NYRHO,NSIGY,  NNKX,  NYKX,  IND,
  41 :      2 icow17,icow18,icow19,icow20,icow21,icow22,icow23,icow24,
  42 : C    .  NSOM,  NINV, NINCMA,NCOMP, JELEM, LEGAUS,INAT,  NCXMAT,
  43 :      3 icow25,icow26,icow27,icow28,icow29,icow30,ICARA,
  44 : C    .  LTRAC, MFR,  IELE,  NHRM,   NBNN, NBELEM,ICARA,
  45 :      4  icow32,icow33,NSTRS1,MFR1,icow36,icow37,icow38,
  46 : C    .  LW2,   NDEF,  NSTRSS,MFR1,  NBGMAT,NELMAT,MSOUPA,
  47 :      5  icow39,icow40,icow41,icow42,icow43,icow44
  48 : C    .  NUMAT1,LENDO, NBBB,  NNVARI,KERR1, MELEME
  49 :         INTEGER icow45,icow46,icow47,icow48,icow49,icow50,
  50 :      .          icow51,icow52,icow53,icow54,icow55,icow56
  51 :      .          icow57,icow58
  52 :       ENDSEGMENT
  53 :       SEGMENT NECOU
  54 : *      COMMON/NECOU/NCOURB,IPLAST,IT,IMAPLA,ISOTRO,
  55 :        INTEGER ncow(6), IFOURB,ncow1(14)
  56 :       ENDSEGMENT
  57 :       SEGMENT WRKK2
  58 :          REAL*8 EPSILI(NSTRSV)
  59 :       END SEGMENT
  60 : *
  61 :       SEGMENT WRK6
  62 :         REAL*8 SIG0S(NSTRS1)
  63 :       END SEGMENT
  64 : *
  65 :       DIMENSION DSIGT(6)
  66 :       PARAMETER (UN=1.D0)
  67 :       KERRE=0
  68 : *      PRINT*,'DANS COLBBB MFR=', MFR, 'IFOURB=',IFOURB,NIFOUR,ifour
  69 : C
  70 :       IF (MFR1 .EQ. 9) THEN
  71 :          NSTRSV=4
  72 :          IFOUR2=-2
  73 :       ELSE IF (MFR1 .EQ. 1) THEN
  74 :          NSTRSV=NSTRS1
  75 :          IF (IFOUR.NE. -2)THEN
  76 :             KERRE=57
  77 :             RETURN
  78 :          END IF
  79 :          IFOUR2=IFOUR
  80 :       ELSE
  81 :          KERRE=57
  82 :          RETURN
  83 :       END IF
  84 : *      PRINT*,'DANS COLBBB apres test MFR' 
  85 : C
  86 : C     calcul de la matrice elastique
  87 : C
  88 :       CMATE = 'ISOTROPE'
  89 :       KCAS=2
  89 :       CALL DOHMAS(XMAT,CMATE,IFOUR2,NSTRSV,KCAS,DDHOOK,IRTD)
  90 :       IF ( IRTD .EQ. 1) THEN
  91 : C
  92 : C      calcul de l'increment de contrainte
  93 : C
  93 :          CALL MATVE1 (DDHOOK,DEPST,NSTRSV,NSTRSV,DSIGT,1)
  94 : *         PRINT*,DEPST(1),DEPST(2),DEPST(3)
  95 : C
  96 : C
  97 : C     ON CALCULE LES CONTRAINTES VRAIES DANS LE CAS DES COQUES
  98 : C
  99 :          IF (MFR1 .EQ. 9) THEN
 100 :            EPAI=XCARB(1)
 101 :            SEGINI WRK6
 102 :            DO ISTRS=1,NSTRS1
 103 :              SIG0S(ISTRS)=SIG0(ISTRS)
 104 :            END DO
 105 :            DO ISTRS=1,2
 106 :              SIG0(ISTRS)=SIG0(ISTRS)/EPAI
 107 :            END DO
 108 :            SIG0(3)=0.D0
 109 :            SIG0(4)=SIG0S(3)/EPAI
 110 :          END IF
 111 : C
 112 : C     inversion de la matrice
 113 : C
 114 :          PREC=1.D-08
 115 :          SEGINI WRKK2
 115 :          CALL INVALM(DDHOOK,NSTRSV,NSTRSV,IRTD,PREC)
 116 :          IF (IRTD.EQ.0)THEN
 117 : C
 118 : C     calcul des deformations du materiau elastique lineaire
 119 : C
 119 :            CALL MATVE1 (DDHOOK,SIG0,NSTRSV,NSTRSV,EPSILI,1)
 120 : C
 121 : C     modification pour tenir compte de l'endommagement
 122 : C
 123 :             DO 100 ISTRS=1,NSTRSV
 124 :                EPSILI(ISTRS)=EPSILI(ISTRS)+EPIN0(ISTRS)
 125 : 100         CONTINUE
 126 : *            PRINT*,EPSILI(1),EPSILI(2),EPSILI(3)
 127 : C
 128 : C      appel a la routine CLBCOM
 129 : C
 130 :           icarbi=icara
 130 :             CALL  COLBEC (WRK52,WRK53,WRK54,WRKK2,NSTRSV,NVARI,ICARbi)
 131 :           icara=icarbi
 132 : C
 133 : C      ON RECALCULE LES CONTRAINTES EFFECTIVES POUR LES COQUES
 134 : C
 135 :             IF (MFR1 .EQ. 9) THEN
 136 :                DO ISTRS=1,NSTRS1
 137 :                   SIG0(ISTRS)=SIG0S(ISTRS)
 138 :                END DO
 139 :                DO ISTRS=1,2
 140 :                   SIGF (ISTRS)=SIGF(ISTRS)*EPAI
 141 :                END DO
 142 :                SIGF (3)=SIGF(4)*EPAI
 143 :                DO ISTRS=4,NSTRS1
 144 :                   SIGF(ISTRS)=SIG0(ISTRS)+DSIGT(ISTRS)
 145 :                END DO
 146 :                SEGSUP WRK6
 147 :             END IF
 148 :          ELSE
 149 :              print*,'erreur dans invalm'
 150 :              KERRE=56
 151 :          END IF
 152 :       ELSE
 153 :          print*,'erreur dans dohmas'
 154 :          KERRE=56
 155 :       END IF
 156 :       SEGSUP WRKK2
 157 :       RETURN
 158 :       END
 159 :  
 160 :  
 161 : 
 162 :  
 163 :  
 164 : 
 165 :  
 166 :  
 167 :  
 168 :  
 169 :  
 170 :  
 171 :