C TENSI3 SOURCE CHAT 05/01/13 03:36:04 5004 SUBROUTINE TENSI3 (SIGMA,DSIGT,DEPST,YUNG,XNU,BETR, . VECX,VECY,VECZ,ANGLE,NBVECD, . XLTR,EPTR,XLTT,EPTT,EPRS,RT,OUVER, . SIGFIN,DEPSP,KERRE) C IMPLICIT INTEGER(I-N) IMPLICIT REAL*8(A-H,O-Z) -INC CCOPTIO C DIMENSION SIGMA(*),DSIGT(*),DEPST(*),SIGFIN(*), . CONTR(6),DCONT(6),DDEFT(6),CONFIN(6),DCONPR(6), . DSIGS(6),DCONS(6),DEPSP(*),DDEFP(6),DDEFS(6),DEFP(6), . VECX(*),VECY(*),VECZ(*),JECHA(3),JECHAN(3), . XLTR(*),EPTR(*),XLTT(*),EPTT(*),EPRS(*),RT(*),CISA(3), . OUVER(*),DEFPR(3),DEFRF(3),ET(3),JECRO(3),KOMPR(3), . ROTATS(6,6),TATORS(6,6),ROTATE(6,6),TATORE(6,6), . AAA(6,6),DDP(6,6) C C INITIALISATION C RFE=1.D-8 RFS=1.D-8 UNIT=0.0174532925199432957692D0 CALL ZDANUL(DEFP,6) CALL ZDANUL(DEPSP,6) CALL ZDANUL(DDEFP,6) DO 9 I=1,3 JECRO(I)=0 KOMPR(I)=0 JECHA(I)=0 JECHAN(I)=0 DEFRF(I)=0.D0 DEFPR(I)=0.D0 DEFP(I)=OUVER(I) 9 CONTINUE C IF(IIMPI.EQ.9) THEN WRITE(IOIMP,1000) WRITE(IOIMP,1001) (SIGMA(I),I=1,6) WRITE(IOIMP,1002) (DSIGT(I),I=1,6) WRITE(IOIMP,1003) (DEPST(I),I=1,6) WRITE(IOIMP,1004) (VECX(I),I=1,3) WRITE(IOIMP,1005) (VECY(I),I=1,3) WRITE(IOIMP,1006) (VECZ(I),I=1,3) WRITE(IOIMP,1007) (XLTR(I),I=1,3) WRITE(IOIMP,1008) (EPTR(I),I=1,3) WRITE(IOIMP,1009) (XLTT(I),I=1,3) WRITE(IOIMP,1010) (EPTT(I),I=1,3) WRITE(IOIMP,1011) (EPRS(I),I=1,3) WRITE(IOIMP,1012) (RT(I),I=1,3) WRITE(IOIMP,1013) (OUVER(I),I=1,3) WRITE(IOIMP,1014) YUNG,XNU,BETR,(ANGLE/UNIT),NBVECD ENDIF C C ********************************************************************** C ******************* CAS DE NB DE VECT PROPRES DONNES = 0 ************* C ********************************************************************** C IF(NBVECD.EQ.0) THEN C CALL CLCRIT (SIGMA,DSIGT,RT,DEFP,DDEFP,DEFRF,NBVECD,KOMPR, . JECRO,KRITER,KRITC1,KRITC2,KRITC3,KRITE1,KRITE2,KRITE3) C IF(IIMPI.EQ.9) THEN WRITE(IOIMP,1015) KRITER WRITE(IOIMP,1016) KRITC1,KRITC2,KRITC3 WRITE(IOIMP,1017) KRITE1,KRITE2,KRITE3 ENDIF C IF(KRITER.NE.0) THEN CALL CLGAMA (SIGMA,DSIGT,RT,DEFP,DDEFP,DEFRF,NBVECD, . KRITC1,KRITC2,KRITC3,KRITE1,KRITE2,KRITE3,GAMA, . YUNG,KOMPR,KERRE) IF(KERRE.NE.0) RETURN C IF(IIMPI.EQ.9) THEN WRITE(IOIMP,1018) GAMA ENDIF ENDIF C IF(KRITER.EQ.0.OR.GAMA.GE.1) THEN C C CAS DU COMPORTEMENT ELASTIQUE LINEAIRE C DO 10 I=1,6 SIGFIN(I)=SIGMA(I)+DSIGT(I) DEPSP(I)=0.D0 10 CONTINUE C IF(IIMPI.EQ.9) THEN WRITE(IOIMP,1030) (SIGFIN(I),I=1,6) WRITE(IOIMP,1031) (DEPSP(I),I=1,6) ENDIF C RETURN C ELSE C DO 20 I=1,6 SIGMA(I)=SIGMA(I)+(GAMA*DSIGT(I)) DSIGT(I)=(1.D0-GAMA)*DSIGT(I) DEPST(I)=(1.D0-GAMA)*DEPST(I) 20 CONTINUE C IF(IIMPI.EQ.9) THEN WRITE(IOIMP,1001) (SIGMA(I),I=1,6) WRITE(IOIMP,1002) (DSIGT(I),I=1,6) WRITE(IOIMP,1003) (DEPST(I),I=1,6) ENDIF C C POUR CALCULER VECZ C IANGLE=0 CALL CLVECA (SIGMA,VECZ,ANGLE,IANGLE) C IF(IIMPI.EQ.9) THEN WRITE(IOIMP,1006) (VECZ(I),I=1,3) ENDIF C NBVECD=1 ENDIF ENDIF C C ********************************************************************** C ******************* CAS DE NB DE VECT PROPRES DONNES = 1 ************* C ********************************************************************** C IF(NBVECD.EQ.1) THEN C C INITIALISATION C ITERA=0 IANGLE=0 ANGLE=0.D0 ET(1)=YUNG ET(2)=YUNG DEFPR(1)=0.D0 DEFPR(2)=0.D0 JECRO(3)=0 KOMPR(3)=0 JECHA(3)=0 JECHAN(3)=0 NJECHA=0 C C POUR CALCULER VECX ET VECY C CALL CLREP(VECX,VECY,VECZ,ANGLE,IANGLE) C IF(IIMPI.EQ.9) THEN WRITE(IOIMP,1004) (VECX(I),I=1,3) WRITE(IOIMP,1005) (VECY(I),I=1,3) ENDIF C C POUR SE METTRE DANS LE REPERE DE LA FISSURE C CALL ROTA3D(ROTATS,TATORS,ROTATE,TATORE,VECX,VECY,VECZ,ANGLE) C IF(IIMPI.EQ.9) THEN WRITE(IOIMP,*) 'TATORS' WRITE(IOIMP,999) ((TATORS(I,J),J=1,6),I=1,6) WRITE(IOIMP,*) 'TATORE' WRITE(IOIMP,999) ((TATORE(I,J),J=1,6),I=1,6) ENDIF C CALL MULMAT(CONTR,TATORS,SIGMA,6,1,6) CALL MULMAT(DCONT,TATORS,DSIGT,6,1,6) CALL MULMAT(DDEFT,TATORE,DEPST,6,1,6) C IF(IIMPI.EQ.9) THEN WRITE(IOIMP,1020) (CONTR(I),I=1,6) WRITE(IOIMP,1021) (DCONT(I),I=1,6) WRITE(IOIMP,1022) (DDEFT(I),I=1,6) C ENERG=DSIGT(1)*DEPST(1)+DSIGT(2)*DEPST(2)+DSIGT(3)*DEPST(3)+ . DSIGT(4)*DEPST(4)+DSIGT(5)*DEPST(5)+DSIGT(6)*DEPST(6) ENERR=DCONT(1)*DDEFT(1)+DCONT(2)*DDEFT(2)+DCONT(3)*DDEFT(3)+ . DCONT(4)*DDEFT(4)+DCONT(5)*DDEFT(5)+DCONT(6)*DDEFT(6) DELEN=ENERG-ENERR WRITE(IOIMP,*) 'ENERG =',ENERG,' ENERR =',ENERR WRITE(IOIMP,*) 'DELEN =',DELEN ENDIF C 111 CALL CLDETA(YUNG,XNU,RT,XLTR,XLTT,EPTT,EPTR,EPRS,OUVER, . CONTR,DDEFT,DCONPR) C 11 CALL CLMODU(YUNG,CONTR(3),DEFP(3),DCONPR(3),DDEFT(3),RT(3), . XLTR(3),XLTT(3),EPTT(3),EPTR(3),EPRS(3), . ET(3),DEFRF(3),DEFPR(3),JECRO(3),KOMPR(3),JECHA(3), . KERRE) IF(KERRE.NE.0) RETURN C IF(IIMPI.EQ.9) THEN WRITE(IOIMP,1023) (ET(I),I=1,3) WRITE(IOIMP,1024) (DEFRF(I),I=1,3) WRITE(IOIMP,1026) (DEFPR(I),I=1,3) WRITE(IOIMP,1025) (JECRO(I),I=1,3) WRITE(IOIMP,1035) (KOMPR(I),I=1,3) WRITE(IOIMP,1036) (JECHA(I),I=1,3) ENDIF C CALL CLCISA(ET,YUNG,XNU,BETR,XLTR,CISA) C IF(IIMPI.EQ.9) THEN WRITE(IOIMP,1027) (CISA(I),I=1,3) ENDIF C C CALCUL DU MODE DE DOMAGE C KRITER=0 IF(ET(1).NE.YUNG) KRITER=KRITER+1 IF(ET(2).NE.YUNG) KRITER=KRITER+2 IF(ET(3).NE.YUNG) KRITER=KRITER+4 C IF(IIMPI.EQ.9) THEN WRITE(IOIMP,1015) KRITER ENDIF C C CALCUL DES MATRICES : A ET D' C CALL CLOUVE(AAA,YUNG,XNU,ET,CISA,KRITER,KERRE) CALL CLENDO(DDP,YUNG,XNU,ET,CISA,KRITER,KERRE) IF(KERRE.NE.0) RETURN C IF(IIMPI.EQ.9) THEN WRITE(IOIMP,*) 'AAA' WRITE(IOIMP,999) ((AAA(I,J),J=1,6),I=1,6) WRITE(IOIMP,*) 'DDP' WRITE(IOIMP,999) ((DDP(I,J),J=1,6),I=1,6) ENDIF C C CALCUL DU DELTA DEFORMATION PLASTIQUE (DDEFS) C ET DU DELTA CONTRAINTE SOLUTION (DCONS) C CALL MULMAT(DDEFS,AAA,DDEFT,6,1,6) CALL MULMAT(DCONS,DDP,DDEFT,6,1,6) C IF(IIMPI.EQ.9) THEN WRITE(IOIMP,1028) (DDEFS(I),I=1,6) WRITE(IOIMP,1029) (DCONS(I),I=1,6) ENDIF C IF(NJECHA.LE.2) THEN JECHAN(3)=JECHA(3) IF(JECHA(3).EQ.1) THEN IF((ABS(DDEFS(3))).GT.RFE) THEN IF(DDEFS(3).LT.0.D0) JECHAN(3)=2 ELSE IF((DCONS(3).LT.0.D0.AND.(ABS(DCONS(3))).GT.RFS). . AND.JECRO(3).NE.1) JECHAN(3)=2 ENDIF ENDIF IF(JECHA(3).EQ.2) THEN IF((ABS(DDEFS(3))).GT.RFE) THEN IF(DDEFS(3).GT.0.D0) JECHAN(3)=1 ELSE IF((DCONS(3).GT.0.D0.AND.(ABS(DCONS(3))).GT.RFS). . OR.JECRO(3).EQ.1) JECHAN(3)=1 ENDIF ENDIF IF(IIMPI.EQ.9) WRITE(IOIMP,1036) (JECHA(I),I=1,3) IF(JECHAN(3).NE.JECHA(3)) THEN NJECHA=NJECHA+1 JECHA(3)=JECHAN(3) IF(IIMPI.EQ.9) WRITE(IOIMP,1036) (JECHA(I),I=1,3) GO TO 11 ENDIF ENDIF C IF(ET(3).EQ.0.D0) THEN CONTR(3)=0.D0 DCONS(3)=0.D0 ENDIF C CALL CLCRIT (CONTR,DCONS,RT,DEFP,DDEFS,DEFRF,NBVECD,KOMPR, . JECRO,KRITER,KRITC1,KRITC2,KRITC3,KRITE1,KRITE2,KRITE3) C IF(IIMPI.EQ.9) THEN WRITE(IOIMP,1015) KRITER WRITE(IOIMP,1016) KRITC1,KRITC2,KRITC3 WRITE(IOIMP,1017) KRITE1,KRITE2,KRITE3 ENDIF C IF(KRITER.NE.0) THEN CALL CLGAMA (CONTR,DCONS,RT,DEFP,DDEFS,DEFRF,NBVECD, . KRITC1,KRITC2,KRITC3,KRITE1,KRITE2,KRITE3,GAMA, . YUNG,KOMPR,KERRE) IF(KERRE.NE.0) RETURN C IF(IIMPI.EQ.9) THEN WRITE(IOIMP,1018) GAMA ENDIF ENDIF C IF(KRITER.EQ.0.OR.GAMA.GE.1) THEN C C CAS DE L ECOULEMENT SELON LA DIRECTION Z SEULE C DO 30 I=1,6 CONFIN(I)=CONTR(I)+DCONS(I) DEFP(I)=DEFP(I)+DDEFS(I) DDEFP(I)=DDEFP(I)+DDEFS(I) 30 CONTINUE C IF(IIMPI.EQ.9) THEN WRITE(IOIMP,1032) (CONFIN(I),I=1,6) WRITE(IOIMP,1033) (DEFP(I),I=1,6) WRITE(IOIMP,1034) (DDEFP(I),I=1,6) ENDIF C C POUR SE METTRE DANS LE REPERE GLOBAL C CALL MULMAT(SIGFIN,ROTATS,CONFIN,6,1,6) CALL MULMAT(DEPSP,ROTATE,DDEFP,6,1,6) C C MISE A JOUR DES VARIABLES INTERNES C OUVER(1)=DEFP(1) OUVER(2)=DEFP(2) OUVER(3)=DEFP(3) IF(JECRO(3).EQ.1.AND.RT(3).GT.CONFIN(3)) RT(3)=CONFIN(3) IF(RT(3).LT.0.D0) RT(3)=0.D0 C IF(IIMPI.EQ.9) THEN WRITE(IOIMP,1030) (SIGFIN(I),I=1,6) WRITE(IOIMP,1031) (DEPSP(I),I=1,6) ENDIF C RETURN C ELSE C DO 40 I=1,6 DCONS(I)=GAMA*DCONS(I) DDEFS(I)=GAMA*DDEFS(I) DCONT(I)=(1.D0-GAMA)*DCONT(I) DDEFT(I)=(1.D0-GAMA)*DDEFT(I) CONTR(I)=CONTR(I)+DCONS(I) DEFP(I)=DEFP(I)+DDEFS(I) DDEFP(I)=DDEFP(I)+DDEFS(I) 40 CONTINUE IF(JECRO(3).EQ.1.AND.RT(3).GT.CONTR(3)) RT(3)=CONTR(3) IF(RT(3).LT.0.D0) RT(3)=0.D0 C IF(IIMPI.EQ.9) THEN WRITE(IOIMP,1012) (RT(I),I=1,3) WRITE(IOIMP,1028) (DDEFS(I),I=1,6) WRITE(IOIMP,1029) (DCONS(I),I=1,6) WRITE(IOIMP,1020) (CONTR(I),I=1,6) WRITE(IOIMP,1021) (DCONT(I),I=1,6) WRITE(IOIMP,1022) (DDEFT(I),I=1,6) WRITE(IOIMP,1033) (DEFP(I),I=1,6) WRITE(IOIMP,1034) (DDEFP(I),I=1,6) ENDIF C GO TO (1,1,1,2,1,1,1),KRITER KERRE=465 RETURN C 2 IF (ITERA.LE.10) THEN ITERA=ITERA+1 JECRO(3)=0 KOMPR(3)=0 JECHA(3)=0 JECHAN(3)=0 NJECHA=0 GO TO 111 ELSE KERRE=466 RETURN ENDIF C C POUR SE METTRE DANS LE REPERE GLOBAL C 1 CALL MULMAT(SIGMA,ROTATS,CONTR,6,1,6) CALL MULMAT(DSIGT,ROTATS,DCONT,6,1,6) CALL MULMAT(DEPST,ROTATS,DDEFT,6,1,6) CALL MULMAT(DEPSP,ROTATS,DDEFP,6,1,6) C IF(IIMPI.EQ.9) THEN WRITE(IOIMP,1001) (SIGMA(I),I=1,6) WRITE(IOIMP,1002) (DSIGT(I),I=1,6) WRITE(IOIMP,1003) (DEPST(I),I=1,6) WRITE(IOIMP,1031) (DEPSP(I),I=1,6) ENDIF C C POUR CALCULER L ANGLE C IANGLE=2 CALL CLVECA (CONTR,VECZ,ANGLE,IANGLE) C IF(IIMPI.EQ.9) THEN WRITE(IOIMP,1019) ANGLE/UNIT ENDIF C NBVECD=2 ENDIF ENDIF C C ********************************************************************** C ******************* CAS DE NB DE VECT PROPRES DONNES = 2 ************* C ********************************************************************** C IF(NBVECD.EQ.2) THEN C C INITIALISATION C ITERB=0 NJECHA=0 DO 49 I=1,3 JECRO(I)=0 KOMPR(I)=0 JECHA(I)=0 JECHAN(I)=0 49 CONTINUE C C POUR SE METTRE DANS LE REPERE DE LA FISSURE C CALL ROTA3D(ROTATS,TATORS,ROTATE,TATORE,VECX,VECY,VECZ,ANGLE) C IF(IIMPI.EQ.9) THEN WRITE(IOIMP,*) 'TATORS' WRITE(IOIMP,999) ((TATORS(I,J),J=1,6),I=1,6) WRITE(IOIMP,*) 'TATORE' WRITE(IOIMP,999) ((TATORE(I,J),J=1,6),I=1,6) ENDIF C CALL MULMAT(CONTR,TATORS,SIGMA,6,1,6) CALL MULMAT(DCONT,TATORS,DSIGT,6,1,6) CALL MULMAT(DDEFT,TATORE,DEPST,6,1,6) C IF(IIMPI.EQ.9) THEN WRITE(IOIMP,1020) (CONTR(I),I=1,6) WRITE(IOIMP,1021) (DCONT(I),I=1,6) WRITE(IOIMP,1022) (DDEFT(I),I=1,6) C ENERG=DSIGT(1)*DEPST(1)+DSIGT(2)*DEPST(2)+DSIGT(3)*DEPST(3)+ . DSIGT(4)*DEPST(4)+DSIGT(5)*DEPST(5)+DSIGT(6)*DEPST(6) ENERR=DCONT(1)*DDEFT(1)+DCONT(2)*DDEFT(2)+DCONT(3)*DDEFT(3)+ . DCONT(4)*DDEFT(4)+DCONT(5)*DDEFT(5)+DCONT(6)*DDEFT(6) DELEN=ENERG-ENERR WRITE(IOIMP,*) 'ENERG =',ENERG,' ENERR =',ENERR WRITE(IOIMP,*) 'DELEN =',DELEN ENDIF C 222 CALL CLDETA(YUNG,XNU,RT,XLTR,XLTT,EPTT,EPTR,EPRS,OUVER, . CONTR,DDEFT,DCONPR) C 22 DO 50 I=1,3 CALL CLMODU(YUNG,CONTR(I),DEFP(I),DCONPR(I),DDEFT(I),RT(I), . XLTR(I),XLTT(I),EPTT(I),EPTR(I),EPRS(I), . ET(I),DEFRF(I),DEFPR(I),JECRO(I),KOMPR(I),JECHA(I), . KERRE) IF(KERRE.NE.0) RETURN 50 CONTINUE C IF(IIMPI.EQ.9) THEN WRITE(IOIMP,1023) (ET(I),I=1,3) WRITE(IOIMP,1024) (DEFRF(I),I=1,3) WRITE(IOIMP,1026) (DEFPR(I),I=1,3) WRITE(IOIMP,1025) (JECRO(I),I=1,3) WRITE(IOIMP,1035) (KOMPR(I),I=1,3) WRITE(IOIMP,1036) (JECHA(I),I=1,3) ENDIF C CALL CLCISA(ET,YUNG,XNU,BETR,XLTR,CISA) C IF(IIMPI.EQ.9) THEN WRITE(IOIMP,1027) (CISA(I),I=1,3) ENDIF C C CALCUL DU MODE DE DOMAGE C KRITER=0 IF(ET(1).NE.YUNG) KRITER=KRITER+1 IF(ET(2).NE.YUNG) KRITER=KRITER+2 IF(ET(3).NE.YUNG) KRITER=KRITER+4 C IF(IIMPI.EQ.9) THEN WRITE(IOIMP,1015) KRITER ENDIF C C CALCUL DES MATRICES : A ET D' C CALL CLOUVE(AAA,YUNG,XNU,ET,CISA,KRITER,KERRE) CALL CLENDO(DDP,YUNG,XNU,ET,CISA,KRITER,KERRE) IF(KERRE.NE.0) RETURN C IF(IIMPI.EQ.9) THEN WRITE(IOIMP,*) 'AAA' WRITE(IOIMP,999) ((AAA(I,J),J=1,6),I=1,6) WRITE(IOIMP,*) 'DDP' WRITE(IOIMP,999) ((DDP(I,J),J=1,6),I=1,6) ENDIF C C CALCUL DU DELTA DEFORMATION PLASTIQUE (DDEFS) C ET DU DELTA CONTRAINTE SOLUTION (DCONS) C CALL MULMAT(DDEFS,AAA,DDEFT,6,1,6) CALL MULMAT(DCONS,DDP,DDEFT,6,1,6) C IF(IIMPI.EQ.9) THEN WRITE(IOIMP,1028) (DDEFS(I),I=1,6) WRITE(IOIMP,1029) (DCONS(I),I=1,6) ENDIF C IF(NJECHA.LE.8) THEN DO 51 I=1,3 JECHAN(I)=JECHA(I) IF(JECHA(I).EQ.1) THEN IF((ABS(DDEFS(I))).GT.RFE) THEN IF(DDEFS(I).LT.0.D0) JECHAN(I)=2 ELSE IF((DCONS(I).LT.0.D0.AND.(ABS(DCONS(I))).GT.RFS). . AND.JECRO(I).NE.1) JECHAN(I)=2 ENDIF ENDIF IF(JECHA(I).EQ.2) THEN IF((ABS(DDEFS(I))).GT.RFE) THEN IF(DDEFS(I).GT.0.D0) JECHAN(I)=1 ELSE IF((DCONS(I).GT.0.D0.AND.(ABS(DCONS(I))).GT.RFS). . OR.JECRO(I).EQ.1) JECHAN(I)=1 ENDIF ENDIF 51 CONTINUE IF(IIMPI.EQ.9) WRITE(IOIMP,1036) (JECHA(I),I=1,3) IF(JECHAN(1).NE.JECHA(1).OR.JECHAN(2).NE.JECHA(2).OR. . JECHAN(3).NE.JECHA(3)) THEN NJECHA=NJECHA+1 DO 52 I=1,3 JECHA(I)=JECHAN(I) 52 CONTINUE IF(IIMPI.EQ.9) WRITE(IOIMP,1036) (JECHA(I),I=1,3) GO TO 22 ENDIF ENDIF C DO 53 I=1,3 IF(ET(I).EQ.0.D0) THEN CONTR(I)=0.D0 DCONS(I)=0.D0 ENDIF 53 CONTINUE C CALL CLCRIT (CONTR,DCONS,RT,DEFP,DDEFS,DEFRF,NBVECD,KOMPR, . JECRO,KRITER,KRITC1,KRITC2,KRITC3,KRITE1,KRITE2,KRITE3) C IF(IIMPI.EQ.9) THEN WRITE(IOIMP,1015) KRITER WRITE(IOIMP,1016) KRITC1,KRITC2,KRITC3 WRITE(IOIMP,1017) KRITE1,KRITE2,KRITE3 ENDIF C IF(KRITER.NE.0) THEN CALL CLGAMA (CONTR,DCONS,RT,DEFP,DDEFS,DEFRF,NBVECD, . KRITC1,KRITC2,KRITC3,KRITE1,KRITE2,KRITE3,GAMA, . YUNG,KOMPR,KERRE) IF(KERRE.NE.0) RETURN C IF(IIMPI.EQ.9) THEN WRITE(IOIMP,1018) GAMA ENDIF ENDIF C IF(KRITER.EQ.0.OR.GAMA.GE.1) THEN C C CAS DE L ECOULEMENT SANS DIFFICULTE C DO 60 I=1,6 CONFIN(I)=CONTR(I)+DCONS(I) DEFP(I)=DEFP(I)+DDEFS(I) DDEFP(I)=DDEFP(I)+DDEFS(I) 60 CONTINUE C IF(IIMPI.EQ.9) THEN WRITE(IOIMP,1032) (CONFIN(I),I=1,6) WRITE(IOIMP,1033) (DEFP(I),I=1,6) WRITE(IOIMP,1034) (DDEFP(I),I=1,6) ENDIF C C POUR SE METTRE DANS LE REPERE GLOBAL C CALL MULMAT(SIGFIN,ROTATS,CONFIN,6,1,6) CALL MULMAT(DEPSP,ROTATE,DDEFP,6,1,6) C IF(IIMPI.EQ.9) THEN WRITE(IOIMP,1030) (SIGFIN(I),I=1,6) WRITE(IOIMP,1031) (DEPSP(I),I=1,6) ENDIF C C MISE A JOUR DES VARIABLES INTERNES C DO 70 I=1,3 OUVER(I)=DEFP(I) IF(JECRO(I).EQ.1.AND.RT(I).GT.CONFIN(I)) RT(I)=CONFIN(I) IF(RT(I).LT.0.D0) RT(I)=0.D0 70 CONTINUE RETURN C ELSE C DO 80 I=1,6 DCONS(I)=GAMA*DCONS(I) DDEFS(I)=GAMA*DDEFS(I) DCONT(I)=(1.D0-GAMA)*DCONT(I) DDEFT(I)=(1.D0-GAMA)*DDEFT(I) CONTR(I)=CONTR(I)+DCONS(I) DEFP(I)=DEFP(I)+DDEFS(I) DDEFP(I)=DDEFP(I)+DDEFS(I) 80 CONTINUE C DO 90 I=1,3 IF(JECRO(I).EQ.1.AND.RT(I).GT.CONTR(I)) RT(I)=CONTR(I) IF(RT(I).LT.0.D0) RT(I)=0.D0 90 CONTINUE C IF(IIMPI.EQ.9) THEN WRITE(IOIMP,1012) (RT(I),I=1,3) WRITE(IOIMP,1028) (DDEFS(I),I=1,6) WRITE(IOIMP,1029) (DCONS(I),I=1,6) WRITE(IOIMP,1020) (CONTR(I),I=1,6) WRITE(IOIMP,1021) (DCONT(I),I=1,6) WRITE(IOIMP,1022) (DDEFT(I),I=1,6) WRITE(IOIMP,1033) (DEFP(I),I=1,6) WRITE(IOIMP,1034) (DDEFP(I),I=1,6) ENDIF C IF (ITERB.LE.15) THEN ITERB=ITERB+1 NJECHA=0 DO 91 I=1,3 JECRO(I)=0 KOMPR(I)=0 JECHA(I)=0 JECHAN(I)=0 91 CONTINUE GO TO 222 ELSE KERRE=467 RETURN ENDIF ENDIF ENDIF C 999 FORMAT(6(1X,1PE12.5)) 1000 FORMAT(1X,'ETAT INITIAL AU DEBUT DE L ECOULEMENT') 1001 FORMAT(1X,'SIGMA =',6(1X,1PE12.5)) 1002 FORMAT(1X,'DSIGT =',6(1X,1PE12.5)) 1003 FORMAT(1X,'DEPST =',6(1X,1PE12.5)) 1004 FORMAT(1X,'VECX =',3(1X,1PE12.5)) 1005 FORMAT(1X,'VECY =',3(1X,1PE12.5)) 1006 FORMAT(1X,'VECZ =',3(1X,1PE12.5)) 1007 FORMAT(1X,'XLTR =',3(1X,1PE12.5)) 1008 FORMAT(1X,'EPTR =',3(1X,1PE12.5)) 1009 FORMAT(1X,'XLTT =',3(1X,1PE12.5)) 1010 FORMAT(1X,'EPTT =',3(1X,1PE12.5)) 1011 FORMAT(1X,'EPRS =',3(1X,1PE12.5)) 1012 FORMAT(1X,'RT =',3(1X,1PE12.5)) 1013 FORMAT(1X,'OUVER =',3(1X,1PE12.5)) 1014 FORMAT(1X,'YUNG = ',1PE12.5,2X,'XNU = ',1PE12.5,2X,/, . 1X,'BETR = ',1PE12.5,2X,'ANGLE = ',1PE12.5,2X, . 'NBVECD= ',I3) 1015 FORMAT(1X,'KRITER= ',I3) 1016 FORMAT(1X,'KRITC1= ',I3,2X,'KRITC2= ',I3,2X,'KRITC3= ',I3) 1017 FORMAT(1X,'KRITE1= ',I3,2X,'KRITE2= ',I3,2X,'KRITE3= ',I3) 1018 FORMAT(1X,'GAMA = ',1PE12.5) 1019 FORMAT(1X,'ANGLE = ',1PE12.5) 1020 FORMAT(1X,'CONTR =',6(1X,1PE12.5)) 1021 FORMAT(1X,'DCONT =',6(1X,1PE12.5)) 1022 FORMAT(1X,'DDEFT =',6(1X,1PE12.5)) 1023 FORMAT(1X,'ET =',3(1X,1PE12.5)) 1024 FORMAT(1X,'DEFRF =',3(1X,1PE12.5)) 1025 FORMAT(1X,'JECRO =',3(1X,I3)) 1026 FORMAT(1X,'DEFPR =',3(1X,1PE12.5)) 1027 FORMAT(1X,'CISA =',3(1X,1PE12.5)) 1028 FORMAT(1X,'DDEFS =',6(1X,1PE12.5)) 1029 FORMAT(1X,'DCONS =',6(1X,1PE12.5)) 1030 FORMAT(1X,'SIGFIN=',6(1X,1PE12.5)) 1031 FORMAT(1X,'DEPSP =',6(1X,1PE12.5)) 1032 FORMAT(1X,'CONFIN=',6(1X,1PE12.5)) 1033 FORMAT(1X,'DEFP =',6(1X,1PE12.5)) 1034 FORMAT(1X,'DDEFP =',6(1X,1PE12.5)) 1035 FORMAT(1X,'KOMPR =',3(1X,I3)) 1036 FORMAT(1X,'JECHA =',3(1X,I3)) C END