C ARED3M SOURCE CB215821 26/08/24 21:15:10 12622 SUBROUTINE ARED3M(SIGT,EPST,ENDT,XLIMT, * SIGD,EPSD,ENDD,XLIMD, * DEPS,VDEP,VDEP1,NPA,VAL,VP,EPSPLS,VAL1,VP1, * VAL2,VAL3,VP2,VP3,EPSTT,FDDD,D,SIFF,VDEII, * VDEP2,EPSC,PPLUS,U,PROD,ENDOPL,VDEI,KM,AAA) C====================================================================== C TEST D ENDOMMAGEMENT INITIAL POUR LES ELEMENTS TRIDIMENSIONNELS C====================================================================== C C C MODIF. : F.CORMERY C E.N.S.M.A - LMPM C JUIN 1993 C C====================================================================== C ENTREES : SIGT,EPST,ENDT, VALEURS AU PAS PRECEDENT C DSIG,DEPS ACCROISSEMENTS INITIAUX C SORTIES SIGD,EPSD,ENDD, VALEURS A LA FIN DU PAS C DEPS ACCROISSEMENTS C VDEP MATRICE TANGENTE C====================================================================== IMPLICIT INTEGER(I-N) IMPLICIT REAL*8(A-H,O-Z) REAL*8 LAMB,MUT C---------------------------------------------------------------------- C COMMON C---------------------------------------------------------------------- COMMON /APENTE/ LAMB,MUT,G,ALP1,BETA C---------------------------------------------------------------------- C DATA ET DIMENSIONS C---------------------------------------------------------------------- C N9 CC DIMENSION SIGD(6),EPSD(6),ENDD(6),D(3,3),VAL1(3,3),VP1(3), C N15 N51 CC * SIGT(6),EPST(6),ENDT(6),SIFF(6),VDEII(6,6), C CC * DEPS(6),VDEP(6,6),VDEP1(6,6),VAL(3,3),VP(3), C N87 CC * VAL2(3,3),VAL3(3,3),VP3(3),VP2(3),VDEP2(6,6) C N93 N174 N255 CC DIMENSION EPSC(6),EPSPLS(6),PPLUS(3,3,3,3),U(3,3,3,3) C N261 N267 N303 N309 CC DIMENSION PROD(6),ENDOPL(6),VDEI(6,6),KM(6),EPSTT(6) C C DIMENSION AAA(*) DIMENSION SIGD(*),EPSD(*),ENDD(*),D(3,*),VAL1(3,*),VP1(*), C N15 N51 * SIGT(*),EPST(*),ENDT(*),SIFF(*),VDEII(6,*), C * DEPS(*),VDEP(6,*),VDEP1(6,*),VAL(3,*),VP(*), C N87 * VAL2(3,*),VAL3(3,*),VP3(*),VP2(*),VDEP2(6,*) C N93 N174 N255 DIMENSION EPSC(*),EPSPLS(*),PPLUS(3,3,3,*),U(3,3,3,*) C N261 N267 N303 N309 DIMENSION PROD(*),ENDOPL(*),VDEI(6,*),KM(*),EPSTT(*) DIMENSION NII(6),MII(6),NIII(6),MIII(6) DATA NII/1,2,3,3,3,2/ DATA MII/1,2,3,2,1,1/ DATA NIII/1,2,3,2,3,3/ DATA MIII/1,2,3,1,2,1/ DATA ZERO/0.D0/ DATA IMA/6/,DEUX/2.D0/,UD/0.5D0/ C---------------------------------------------------------------------- MT=6 IKK=1 C---------------------------------------------------------------------- C TENSEUR DE DEFORMATION ACTUALISEE C---------------------------------------------------------------------- MMI=1 GOTO 121 C------------ 3 CONTINUE C------------ DO 900 I=1,6 M= MII(I) N=NII(I) DO 144 J=1,6 K=MII(J) L=NII(J) VDEI(I,J)=U(M,N,K,L) VDEII(I,J)=U(M,N,K,L) 144 CONTINUE 900 CONTINUE C---------------------------Calcul de la deformation initiale---------- IF(NPA.EQ.1)THEN C------------ CALL INVERE(VDEI,6,6,KM,DET) C------------ DO 901 I=1,6 EPST(I)=0.D0 DO 4 J=1,6 EPST(I)=EPST(I)+VDEI(I,J)*(-G*ENDT(J)) 4 CONTINUE 901 CONTINUE C------------ MMI=0 ENDIF C---------------------------------------------------------------------- 234 CONTINUE DO 10 I=1,IMA EPSD(I)=EPST(I)+DEPS(I) EPSC(I)=EPSD(I) 10 CONTINUE C---------------------------------------------------------------------- C CALCUL DU TENSEUR DE DEFORMATION POSITIVE C---------------------------------------------------------------------- 7 CALL EPPLUM(EPSC,PPLUS,1,VAL1,VP1,AAA(442), . AAA(478),AAA(514),AAA(517),AAA(526), . AAA(532)) C---------------- EPSD(4)=EPSD(4)/2 EPSD(5)=EPSD(5)/2 EPSD(6)=EPSD(6)/2 C---------------- CALL T4CT2(PPLUS,EPSD,EPSPLS,6) C---------------- DO 324 I=1,6 IF(ABS(EPSPLS(I)).LE.1E-15)EPSPLS(I)=0.D0 324 CONTINUE C---------------- EPSD(4)=EPSD(4)*2 EPSD(5)=EPSD(5)*2 EPSD(6)=EPSD(6)*2 EPSPLS(4)=EPSPLS(4)*2 EPSPLS(5)=EPSPLS(5)*2 EPSPLS(6)=EPSPLS(6)*2 C---------------------------------------------------------------------- C TEST D ENDOMMAGEMENT C---------------------------------------------------------------------- CALL AVENDO(EPSPLS,ENDT,DEQ) CRIT=DEQ-XLIMT IF(CRIT.LE.ZERO)GO TO 100 C---------------------------------------------------------------------- C CALCUL DU MULTIPLICATEUR C---------------------------------------------------------------------- XLMD=ZERO CALL AMULTM(EPSPLS,ENDT,XLMD,XLIMT) C---------------------------------------------------------------------- C ACTUALISATION DES GRANDEURS C---------------------------------------------------------------------- CALL AACTUM(SIGT,EPST,ENDT,XLIMT,SIGD,EPSD,ENDD,XLIMD, * VDEP,EPSC,EPSPLS,XLMD,PPLUS, * VDEP1,SIFF,VDEP2,FDDD,AAA(442),AAA(448), * AAA(454),AAA(460),AAA(466),AAA(472), * AAA(478),AAA(484),AAA(493),AAA(502), * AAA(511),AAA(520),AAA(529),AAA(538), * AAA(547),AAA(628),AAA(709),AAA(790), * AAA(871)) ISS=2 GO TO 899 C********************************************************************** C CAS ELASTIQUE C********************************************************************** 100 CONTINUE ISS=1 C---------------------------------------------------------------------- DO 110 I=1,IMA ENDD(I)=ENDT(I) 110 CONTINUE XLIMD=XLIMT C--------------------------------CALCUL PPLUS:D=D+ ------------ * MODEE1=1 * IF(MODEE1.EQ.1)THEN DO 123 I=1,6 ENDOPL(I)=ENDD(I) 123 CONTINUE * GOTO 108 * ENDIF * CALL T4CT2(PPLUS,ENDD,ENDOPL,6) C--------------------------------CALCUL DES CONTRAINTES---------------- *108 TRAC2=EPSD(1)*ENDD(1)+EPSD(2)*ENDD(2)+EPSD(3)*ENDD(3) TRAC2=EPSD(1)*ENDD(1)+EPSD(2)*ENDD(2)+EPSD(3)*ENDD(3) * +EPSD(4)*ENDD(4)+EPSD(5)*ENDD(5)+EPSD(6)*ENDD(6) TRAC3=EPSD(1)+EPSD(2)+EPSD(3) PROD(1)=DEUX*EPSD(1)*ENDD(1)+EPSD(5)*ENDD(5)+EPSD(6)*ENDD(6) PROD(2)=DEUX*EPSD(2)*ENDD(2)+EPSD(4)*ENDD(4)+EPSD(6)*ENDD(6) PROD(3)=DEUX*EPSD(3)*ENDD(3)+EPSD(5)*ENDD(5)+EPSD(4)*ENDD(4) PROD(4)=UD*EPSD(6)*ENDD(5)+EPSD(2)*ENDD(4)+UD*EPSD(4)*ENDD(3)+ * UD*EPSD(5)*ENDD(6)+UD*EPSD(4)*ENDD(2)+EPSD(3)*ENDD(4) PROD(5)=UD*EPSD(5)*ENDD(1)+UD*EPSD(4)*ENDD(6)+EPSD(3)*ENDD(5)+ * EPSD(1)*ENDD(5)+UD*EPSD(6)*ENDD(4)+UD*EPSD(5)*ENDD(3) PROD(6)=UD*EPSD(6)*ENDD(1)+EPSD(2)*ENDD(6)+UD*EPSD(4)*ENDD(5)+ * EPSD(1)*ENDD(6)+UD*EPSD(6)*ENDD(2)+UD*EPSD(5)*ENDD(4) C--------------------- DO 115 I=1,3 SIGD(I)=G*ENDOPL(I)+LAMB*TRAC3+ALP1*(TRAC2+TRAC3*ENDD(I)) * +DEUX*BETA*PROD(I)+DEUX*MUT*EPSD(I) 115 CONTINUE C--------------------- DO 116 I=4,6 SIGD(I)=G*ENDOPL(I)+ALP1*TRAC3*ENDD(I) * +DEUX*BETA*PROD(I)+MUT*EPSD(I) 116 CONTINUE C------------------ DO 902 I=1,6 SIFF(I)=0 DO 17 J=1,6 SIFF(I)=SIFF(I)+VDEII(I,J)*EPSC(J) 17 CONTINUE 902 CONTINUE DO 18 I=1,6 SIFF(I)=SIFF(I)+G*ENDOPL(I) 18 CONTINUE C---------------------------------------------------------------------- MMI=0 C---------------------------------------------------------------------- C CALCUL MATRICE TANGENTE ELASTIQUE ANISOTROPE C---------------------------------------------------------------------- C C---------------------------------Passage en notation indicielle------- 121 CONTINUE DO 42 I=1,3 D(I,I)=ENDT(I) DO 43 J=I+1,3 K = 9 - I -J * IF ((I.EQ.1).AND.(J.EQ.2)) K=6 * IF ((I.EQ.1).AND.(J.EQ.3)) K=5 * IF ((I.EQ.2).AND.(J.EQ.3)) K=4 D(I,J)=ENDT(K) D(J,I)=ENDT(K) 43 CONTINUE 42 CONTINUE C----------------------------Calcul de la matrice tangente------------- DO 905 I=1,3 DO 904 J=1,3 DO 903 K=1,3 DO 51 L=1,3 C------------------------- U(I,J,K,L)=LAMB*DELT(I,J)*DELT(K,L)+MUT*(DELT(I,K)*DELT(J,L) * +DELT(I,L)*DELT(J,K))+ALP1*(DELT(I,J)*D(K,L)+D(I,J)*DELT(K,L)) * +BETA*(D(I,K)*DELT(J,L)+D(L,J)*DELT(I,K)+DELT(I,L) * *D(J,K)+D(I,L)*DELT(J,K)) C------------------------- 51 CONTINUE 903 CONTINUE 904 CONTINUE 905 CONTINUE C-------------------------------Notation de VOIGT-------------------- IF(MMI.EQ.1)GOTO 3 DO 906 I=1,6 M=MIII(I) N=NIII(I) DO 134 J=1,6 K= MIII(J) L= NIII(J) VDEP(I,J)=U(M,N,K,L) 134 CONTINUE 906 CONTINUE C------------------------------------------------------------------- DO 907 I=1,6 DO 142 J=1,6 VDEP1(I,J)=VDEP(I,J) VDEP2(I,J)=VDEP(I,J) 142 CONTINUE 907 CONTINUE C******************************************************************** C C******************************************************************** 899 DO 321 I=1,6 IF(ABS(SIGD(I)).LE.1E-15)SIGD(I)=0.D0 321 CONTINUE C-------------------------------------------------------------------- CALL VECT(SIGD,VAL,VP,AAA(442),AAA(451),AAA(457)) DO 332 I=4,6 EPSPLS(I)=EPSPLS(I)/2 332 CONTINUE CALL VECT(EPSPLS,VAL2,VP2,AAA(442),AAA(451),AAA(457)) DO 333 I=4,6 EPSPLS(I)=EPSPLS(I)*2 333 CONTINUE CALL VECT(ENDD,VAL3,VP3,AAA(442),AAA(451),AAA(457)) C-------------------------------------------------------------------- CALL INVERE(VDEP2,6,6,KM,DET) C------------ DO 908 I=1,6 EPSTT(I)=0.D0 DO 401 J=1,6 EPSTT(I)=EPSTT(I)+VDEP2(I,J)*(-G*ENDD(J)) 401 CONTINUE 908 CONTINUE RETURN END