1 : C CFATTT SOURCE KICH 09/09/11 21:15:48 6505 2 : SUBROUTINE CFATTT(WRK52,WRK53,WRK54,NVARI,Iecou) 3 : C 4 : C calcule la deformation initiale et l'increment de deformation 5 : C a partir de la contrainte initiale et l'increment de contrainte 6 : C elastique puis appelle la subroutine CFATI 7 : C 8 : C 9 : C variables en entree 10 : C 11 : C WRK0,KRK1,WRK5 pointeurs sur des segments de travail 12 : C 13 : C NSTRS1 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 2) 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 : C 33 : C Modif L.Bode - 09/10/92 - Traitement particulier des coques 34 : C Modif L.Bode - 14/10/92 - Modifications complementaires 35 : C 36 : c KICH XCARB<- XCAR , CMAZAR <- MAZARS 37 : 38 : IMPLICIT INTEGER(I-N) 39 : IMPLICIT REAL*8(A-H,O-Z) 40 : -INC CCOPTIO 41 : -INC DECHE 42 : * 43 : SEGMENT IECOU 44 : * COMMON/IECOU/NYOG,NYNU,NYALFA,NYSMAX,NYN,NYM,NYKK, 45 : INTEGER icow1,icow2,icow3,icow4,icow5,icow6,icow7, 46 : C INTEGER NYOG, NYNU, NYALFA,NYSMAX,NYN, NYM, NYKK, 47 : 1 icow8,icow9,icow10,icow11,icow12,icow13,icow14,icow15,icow16, 48 : C . NYALF1,NYBET1,NYR, NYA, NYRHO,NSIGY, NNKX, NYKX, IND, 49 : 2 icow17,icow18,icow19,icow20,icow21,icow22,icow23,icow24, 50 : C . NSOM, NINV, NINCMA,NCOMP, JELEM, LEGAUS,INAT, NCXMAT, 51 : 3 icow25,icow26,icow27,icow28,icow29,icow30,ICARA, 52 : C . LTRAC, MFR, IELE, NHRM, NBNN, NBELEM,ICARA, 53 : 4 icow32,icow33,NSTRS1,MFR1,icow36,icow37,icow38, 54 : C . LW2, NDEF, NSTRSS,MFR1, NBGMAT,NELMAT,MSOUPA, 55 : 5 icow39,icow40,icow41,icow42,icow43,icow44 56 : C . NUMAT1,LENDO, NBBB, NNVARI,KERR1, MELEME 57 : INTEGER icow45,icow46,icow47,icow48,icow49,icow50, 58 : . icow51,icow52,icow53,icow54,icow55,icow56 59 : . icow57,icow58 60 : ENDSEGMENT 61 : C 62 : SEGMENT WRKK2 63 : REAL*8 EPSILI(NSTRSV) 64 : END SEGMENT 65 : * 66 : SEGMENT WRK6 67 : REAL*8 SIG0S(NSTRS),DEPSTS(NSTRS) 68 : END SEGMENT 69 : * 70 : INTEGER NVARI 71 : INTEGER KCAS,IRTD,ISTRS 72 : REAL*8 PREC,EPAI,FAC,AUX,AUX1,AUX2,YOUN,XNU 73 : REAL*8 UN 74 : PARAMETER (UN=1.D0) 75 : KERRE=0 76 : YOUN = XMAT(1) 77 : XNU = XMAT(2) 78 : C 79 : C ON CALCULE LES CONTRAINTES VRAIES DANS LE CAS DES COQUES 80 : C 81 : C print*,'dans mazzzz MFR1=', mfr1 82 : IF (MFR1 .EQ. 9) THEN 83 : EPAI=XCARB(1) 84 : SEGINI WRK6 85 : DO 101 ISTRS=1,NSTRS1 86 : SIG0S(ISTRS)=SIG0(ISTRS) 87 : DEPSTS(ISTRS)=DEPST(ISTRS) 88 : 101 CONTINUE 89 : NSTRSV=4 90 : IFOUR2=-2 91 : C Modif L.Bode - 14/10/92 92 : C Dans le cas des coques, on force la dimension a 2 pour MAZARS 93 : C ie on travaille en contraintes planes 94 : JDIM =2 95 : C Fin modif L.Bode 96 : DO 102 ISTRS=1,2 97 : SIG0(ISTRS)=SIG0S(ISTRS)/EPAI 98 : 102 CONTINUE 99 : DEPST(3)=0.D0 100 : DEPST(4)=DEPSTS(3) 101 : SIG0(3)=0.D0 102 : SIG0(4)=SIG0S(3)/EPAI 103 : ELSE IF (MFR1 .EQ. 1) THEN 104 : NSTRSV=NSTRS1 105 : IFOUR2=IFOUR 106 : C Modif L.Bode - 14/10/92 107 : C Pour les elts massifs, on utilise la vraie dimension 108 : JDIM = IDIM 109 : C Fin modif L.Bode 110 : ELSE 111 : PRINT*,'MFR1=',MFR1 112 : KERRE=57 113 : RETURN 114 : END IF 115 : SEGINI WRKK2 116 : 117 : 118 : C 119 : C calcul de la matrice elastique 120 : C 121 : CMATE = 'ISOTROPE' 122 : KCAS=1 123 : * print*,'increment de deformation elastique' 123 : CALL DOHMAS(XMAT,CMATE,IFOUR2,NSTRSV,KCAS,DDHOOK,IRTD) 124 : * DO ISTRS=1,NSTRS1 125 : * print*,(DDHOOK(ISTRS,J),j=1,nstrs) 126 : * print*,DEPST(ISTRS) 127 : * END DO 128 : IF ( IRTD .EQ. 1) THEN 129 : C 130 : C calcul de l'increment de contrainte 131 : C 131 : CALL MATVE1 (DDHOOK,DEPST,NSTRSV,NSTRSV,DSIGT,1) 132 : C 133 : C 134 : C inversion de cette matrice 135 : C 136 : PREC=1.D-08 136 : CALL DOHMAS(XMAT,CMATE,IFOUR2,NSTRSV,2,DDHOOK,IRTD) 137 : * DO ISTRS=1,NSTRSV 138 : * print*,(DDHOOK(ISTRS,J),j=1,nstrsv) 139 : * END DO 140 : * print*,'appel a invalm' 140 : CALL INVALM(DDHOOK,NSTRSV,NSTRSV,IRTD,PREC) 141 : IF (IRTD.EQ.0)THEN 142 : C 143 : C calcul des deformations du materiau elastique lineaire 144 : C 145 : * print*,'appel a matve1' 145 : CALL MATVE1 (DDHOOK,SIG0,NSTRSV,NSTRSV,EPSILI,1) 146 : C 147 : C modification pour tenir compte de l'endommagement 148 : C 149 : DO 100 ISTRS=1,NSTRSV 150 : EPSILI(ISTRS)=EPSILI(ISTRS)+EPIN0(ISTRS) 151 : 100 CONTINUE 152 : 153 : C 154 : C appel a la routine MAZARS 155 : C 156 : C Modif L.Bode - 14/10/92 157 : C On envoie la dimension et le numero de la formulation 158 : C ( Elts Coques JDIM =2 , IFOUR2 = -2 => contraintes planes 159 : C Elts Massifs JDIM = IDIM ,IFOUR2 = IFOUR) 160 : * print*,'appel a mazars' 161 : icarbi=icara 161 : C CALL CMAZAR (WRK52,WRK53,WRK54,WRKK2,NSTRSV,NVARI, 162 : C 1 ICARbi,JDIM,IFOUR2) 162 : CALL CFATI (WRK52,WRK53,WRK54,WRKK2,NSTRSV,NVARI, 163 : 1 ICARbi,JDIM,IFOUR2) 164 : icara=icarbi 165 : C Fin modif L.Bode 166 : C 167 : C ON RECALCULE LES CONTRAINTES EFFECTIVES POUR LES COQUES 168 : C 169 : * print*,'apres mazars' 170 : IF (MFR1 .EQ. 9) THEN 171 : 172 : 173 : C 174 : C ON MET A JOUR DE FACON NON LINEAIRE LA PARTIE MEMBRANE 175 : C ET LES PARTIES FLEXION ET EFFORTS 176 : C TRANCHANTS LE CAS ECHEANT 177 : C 178 : FAC=(EPAI**3)/12.D0 179 : AUX =FAC*YOUN/(1.D0-XNU*XNU) 180 : AUX1=FAC*YOUN*.5D0/(1.D0+XNU) 181 : AUX2=EPAI*YOUN*.5D0/(1.d0+XNU)/1.2d0 182 : DO 103 ISTRS=1,NSTRS1 183 : SIG0(ISTRS)=SIG0S(ISTRS) 184 : DEPST(ISTRS)=DEPSTS(ISTRS) 185 : 103 CONTINUE 186 : 187 : DO 104 ISTRS=1,2 188 : SIGF (ISTRS)=SIGF(ISTRS)*EPAI 189 : 104 CONTINUE 190 : SIGF(3)=SIGF(4)*EPAI 191 : SIGF(4)=SIG0(4)+AUX*(DEPST(4)+XNU*DEPST(5)) 192 : SIGF(5)=SIG0(5)+AUX*(DEPST(5)+XNU*DEPST(4)) 193 : SIGF(6)=SIG0(6)+AUX1*DEPST(6) 194 : SIGF(7)=SIG0(7)+AUX2*DEPST(7) 195 : SIGF(8)=SIG0(8)+AUX2*DEPST(8) 196 : SEGSUP WRK6 197 : END IF 198 : ELSE 199 : print*,'erreur dans invalm' 200 : KERRE=56 201 : END IF 202 : ELSE 203 : print*,'erreur dans dohmas' 204 : KERRE=56 205 : END IF 206 : SEGSUP WRKK2 207 : RETURN 208 : END 209 : 210 : 211 : 212 : 213 : 214 : 215 : 216 : 217 : 218 : 219 :
© Cast3M 2003 - All rights reserved.
Disclaimer