C PRGURS SOURCE CHAT 05/01/13 02:26:34 5004 SUBROUTINE PRGURS(SIG0,NSTRS,DEPST,VAR0,XMAT,NCOMAT,XCAR,ICARA, 1NVARI,SIGF,VARF,DEFP,MFR1,KERRE,wrkgur) C C ================================================================== C CE SOUS-PROGRAMME EST APPELE DANS "ECOUL2". C IL PREPARE L'INTEGRATION DE LA LOI DE GURSON C C ENTREES: C ------- C NSTRS = NBR. DE COMPOSANTES DES CONTR. OU DES DEFORM. C SIG0(NSTRS) = CONTR. AU DEBUT DU PAS D'INTEGRATION C DEPST(NSTRS) = INCREMENT DES DEFORM. TOTALES C NVARI = NBR. DE VARIABLES INTERNES C VAR0(NVARI) = VARIABLES INTERNES AU DEBUT DU PAS D'INTEGRATION C CE TABLEAU CONTIENT DANS L'ORDRE: C - LA DEFORM. PLASTIQUE CUMULEE C - LA FRACTION DE VIDE INTERNE C - LA DENSITE C - LES DEFORM. PLASTIQUES C NCOMAT = NBR. DE CARACTERISTIQUES MECANIQUES DU MATERIAU C XMAT(NCOMAT) = CARACTERISTIQUES MECANIQUES DU MATERIAU C MFR = INDICE DE LA FORMULATION MECANIQUE; SEULEMENT C MASSIF OU COQUE POUR LES MATERIAUX ENDOMMAGEABLES C ICARA = NBR. DE CARACT. GEOMETRIQUES DES ELEMENTS FINIS C XCAR(ICARA) = CARACT. GEOMETRIQUES DES ELEMENTS FINIS C C SORTIES: C ------- C SIGF(NSTRS)= CONTR. A LA FIN DU PAS D'INTEGRATION C VARF(NVARI)= VARIABLES INTERNES A LA FIN DU PAS D'INTEGRATION C DEFP(NSTRS)= INCREMENT DES DEFORM. PLASTIQUES A LA FIN DU PAS C D'INTEGRATION C KERRE = INDICE QUI REGIT LES ERREURS C = 77 SI LA DEFORM. PLAST. CUMULEE ENDOMMAGEE (2IEME VAR. C INT.) EST EN DEHORS DE LA COURBE DE TRACTION, DS. C LE CAS DE L'ECROUISSAGE ET DE L'ENDOMM. ISOTROPES. C CECI PEUT SE PRODUIRE SUITE A L'APPEL A "CRIDAM" C = 99 SI LA FORMULATION MECANIQUE N'EST PAS DISPONIBLE C POUR LE MODELE CONSIDERE OU S'IL Y A INCOMPATIBILITE C ENTRE MFR ET IFOUR C ================================================================== C ICI IL FAUT PROGRAMMER EN FORTRAN PUR C =================================================================== C IMPLICIT INTEGER(I-N) IMPLICIT REAL*8(A-H,O-Z) -INC PPARAM -INC CCOPTIO segment wrkgur real*8 sigbar, sy0,phi0,rho0,g,b,h real*8 epn,phin,sqrtj2,rho,sig(6) real*8 e(7),dt real*8 conv,tol1,tol2 endsegment * common/prop/sigbar,sy0,phi0,rho0,g,b,h DIMENSION SIG0(*),DEPST(*),VAR0(*),XMAT(*),XCAR(*),SIGF(*), & VARF(*),DEFP(*) DIMENSION RSIG0(6),RDEFP(6),RSIGF(6) ,RDEPST(6) C C ADAPTATION DE L'OPTION DE CALCUL VERS LE 3D MASSIF DE SIG0 A RSIG0 C IF (MFR1 .EQ. 1) THEN C MASSIF 3D IF (NSTRS .EQ. 6) THEN DO 10 I=1,NSTRS RSIG0(I)=SIG0(I) RDEPST(I)=DEPST(I) 10 CONTINUE ELSE IF ( NSTRS .EQ. 4 .AND. (IFOUR .EQ. 0 .OR. & IFOUR .EQ. -1)) THEN C calcul axisyemmtrique ou deformation plane DO 15 I=1,NSTRS RSIG0(I)=SIG0(I) RDEPST(I)=DEPST(I) 15 CONTINUE RSIG0(5)=0.D0 RSIG0(6)=0.D0 RDEPST(5)=0.D0 RDEPST(6)=0.D0 ENDIF ELSE KERRE = 99 RETURN ENDIF C C DONNE MATERIAU C SIGBAR=XMAT(7) SY0=XMAT(5) phi0=XMAT(8) G=XMAT(1)/2.D0/(1.D0+XMAT(2)) B=XMAT(1)/3.D0/(1.D0-2.D0*XMAT(2)) H=XMAT(6) RHO0=1.D0 C C METTRE LES CONTRAINTES SOUS FORME DEVIATORIC + PRESSION C DO 20 I=1,6 RSIGF(I)=RSIG0(I) 20 CONTINUE C RP = -(RSIG0(1)+RSIG0(2)+RSIG0(3))/3.D0 RSIG0(1)=RSIG0(1)+RP RSIG0(2)=RSIG0(2)+RP RSIG0(3)=RSIG0(3)+RP * WRITE (*,*) '------------------------------' * WRITE (*,100) 'sig=' ,(RSIG0(I),I=1,6) * WRITE (*,*) 'P=',RP * WRITE (*,100) 'depst=' ,(DEPST(I),I=1,6) * WRITE (*,*) 'PHI0=',PHI0 * WRITE (*,*) 'epse=',VAR0(1), ' phi=',VAR0(2),' dens=',VAR0(3) C C NOUVEL ETAT APRES L'INCREMENT DE DEFORMATION C CALL GURSON(RSIG0,RP,RDEFP,VAR0(1),VAR0(2),VAR0(3), & RDEPST,1.D0,wrkgur) C * WRITE (*,100) 'sig=' ,(RSIG0(I),I=1,6) * WRITE (*,*) 'P=',RP * WRITE (*,*) 'epse=',VAR0(1),' phi0=',VAR0(2),' dens=',VAR0(3) RSIG0(1)=RSIG0(1)-RP RSIG0(2)=RSIG0(2)-RP RSIG0(3)=RSIG0(3)-RP C C MISE A JOUR DES VARIABLES C C VARIABLES INTERNES C DO 50 I=1,NVARI VARF(I)=VAR0(I) 50 CONTINUE C C CONTRAINTES C DO 60 I=1,6 RSIGF(I)=RSIG0(I) 60 CONTINUE C C PASSAGE A L'OPTION DE CALCUL POUR LES CONTRAINTES C IF (MFR1 .EQ. 1) THEN IF (NSTRS .EQ. 6) THEN C massif 3D DO 70 I=1,NSTRS SIGF(I)=RSIGF(I) DEFP(I)=RDEFP(I) 70 CONTINUE ELSE IF ( NSTRS .EQ. 4 .AND. (IFOUR .EQ. 0 & .OR. IFOUR .EQ. -1)) THEN C calcul axisymetrique ou deformations planes DO 80 I=1,NSTRS SIGF(I)=RSIGF(I) DEFP(I)=RDEFP(I) 80 CONTINUE IF ( ABS(RSIGF(5)) .GT. 1.E-6 .OR. & ABS(RSIGF(6)) .GT. 1.E-6) THEN * PRINT* ,'Incompatibilite de la valeur des contraintes' KERRE = 99 * CALL ERREUR(5) ENDIF ENDIF ENDIF C C WRITE (*,100) 'sig=' ,(SIGF(I),I=1,6) C WRITE (*,100) 'var=' ,(VARF(I),I=1,3) C WRITE (*,100) 'dep=' ,(DEFP(I),I=1,6) C 100 FORMAT (A,6(1PE14.7,1X)) RETURN END