Sources Esope | Cast3M

prgurs
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