Sources Esope | Cast3M

prvpar
C PRVPAR    SOURCE    BP208322  17/03/01    21:18:02     9325           
      SUBROUTINE PRVPAR(SIG0,NSTRS,DEPST,VAR0,XMAT,NCOMAT,XCAR,ICARA,
     1NVARI,SIGF,VARF,DEFP,MFR1,DDAUX,CMATE,VALMAT,VALCAR,N2EL,N2PTEL,
     2 NBPGAU,IFOU,IB,IGAU,EPAIST,MELE,NPINT,NBGMAT,NELMAT,SECT,
     3 LHOOK,TXR,XLOC,XGLOB,D1HOOK,ROTHOO,DDHOMU,CRIGI,DSIGT,KERRE,DT)
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. CALCULE ELASTIQUEMENT
C                A PARTIR DE L'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
* DDAUX = MATRICE DE HOOKE ELASTIQUE
* NSTRS = NBRE DE COMPOSANTES DES DEFORMATIONS
* CMATE = NOM DU MATERIAU
* VALMAT= TABLEAU DE CARACTERISTIQUES DU MATERIAU
* VALCAR= TABLEAU DE CARACTERISTIQUES GEOMETRIQUES
* N2EL  = NBRE D ELEMENTS DANS SEGMENT DE HOOKE
* N2PTEL= NBRE DE POINTS DANS SEGMENT DE HOOKE
* MFR   = NUMERO DE LA FORMULATION
* IFOU  = OPTION DE CALCUL
* IB    = NUMERO DE L ELEMENT COURANT
* IGAU  = NUMERO DU POINT COURANT
* EPAIST= EPAISSEUR
* NBPGAU= NBRE DE POINTS DE GAUSS
* MELE  = NUMERO DE L ELEMENT FINI
* NPINT = NBRE DE POINTS D INTEGRATION
* NBGMAT= NBRE DE POINTS DANS SEGMENT DE CARACTERISTIQUES
* NELMAT= NBRE D ELEMENTS DANS SEGMENT DE CARACTERISTIQUES
* SECT  = SECTION
* LHOOK = TAILLE DE LA MATRICE DE HOOKE
* TXR,XLOC,XGLOB,D1HOOK,ROTHOO,DDHOMU,CRIGI = TABLEAUX UTILISES
* POUR LE CALCUL DE LA MATRICE DE HOOKE
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
      DIMENSION SIG0(*),DEPST(*),VAR0(*),XMAT(*),XCAR(*),SIGF(*),
     &          VARF(*),DEFP(*)
      DIMENSION RSIG0(6),RDSIGT(6),RDEFP(6),RSIGF(6),DSIGT(*)
      DIMENSION VALMAT(*),VALCAR(*)
      DIMENSION TXR(IDIM,*),CRIGI(12)
      DIMENSION DDAUX(LHOOK,*),DDHOMU(LHOOK,*)
      DIMENSION XLOC(3,3),XGLOB(3,3)
      DIMENSION D1HOOK(LHOOK,*),ROTHOO(LHOOK,*)
      CHARACTER*8 CMATE
C
C   CALCUL DE L'INCREMENT DE CONTRAINTES
C
      CALL CALSIG(DEPST,DDAUX,NSTRS,CMATE,VALMAT,VALCAR,
     1  N2EL,N2PTEL,MFR1,IFOU,IB,IGAU,EPAIST,NBPGAU,
     2     MELE,NPINT,NBGMAT,NELMAT,SECT,LHOOK,TXR,XLOC,
     3        XGLOB,D1HOOK,ROTHOO,DDHOMU,CRIGI,DSIGT,IRTD)
*
      IF(IRTD.NE.1) THEN
         KERRE=69
         GOTO 1000
      ENDIF
*
C
C   ADAPTATION DE L'OPTION DE CACUL VERS LE 3D MASSIF DE SIG0 A RSIG0
C
      IF (MFR1 .EQ. 1 .OR. MFR1 .EQ. 31)  THEN
C   1 formulation massive
C   2 formulation quasi incompressible
C         MASSIF 3D
        IF (NSTRS .EQ. 6) THEN
          DO 10 I=1,NSTRS
            RSIG0(I)=SIG0(I)
            RDSIGT(I)=DSIGT(I)
  10      CONTINUE
        ELSE IF ( NSTRS .EQ. 4 .AND. ((IFOUR .EQ. 0)
     &           .OR. (IFOUR .EQ. -1))) THEN
C         calcul en mode contraintes planes ou axisymetrique
          DO 15 I=1,NSTRS
            RSIG0(I)=SIG0(I)
            RDSIGT(I)=DSIGT(I)
  15      CONTINUE
          RSIG0(5)=0.D0
          RSIG0(6)=0.D0
          RDSIGT(5)=0.D0
          RDSIGT(6)=0.D0
        ENDIF
      ELSE
        KERRE = 99
        RETURN
      ENDIF
C
C   DONNE MATERIAU
C
      YOUNG = XMAT(1)
      POISSON = XMAT(2)
      Y = XMAT(5)
      CK = XMAT(7)
      CN = XMAT(6)
*
*      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       WRITE (*,*) '------------------------------'
C       WRITE (*,100)    'sig=' ,(RSIG0(I),I=1,6)
C       WRITE (*,*) 'P=',RP
C       WRITE (*,100)    'dsig=' ,(DSIGT(I),I=1,6)
C       WRITE (*,100)    'dept=' ,(RDEF(I),I=1,6)
C       WRITE (*,*) 'YOUNG=',YOUNG
C       WRITE (*,*) 'NU=' , POISSON
C       WRITE (*,*) 'epse=',VAR0(1), ' phi=',VAR0(2),' dens=',VAR0(3)
 
C
C  NOUVEL ETAT APRES L'INCREMENT DE DEFORMATION
C
      CALL VPARF(YOUNG,POISSON,Y,CK,CN,RSIG0,RDSIGT,RDEFP,RSIGF,DT)
C
C        WRITE (*,100)    'sig=' ,(RSIGF(I),I=1,6)
C       WRITE (*,*) 'P=',RP
C       WRITE (*,*) 'epse=',VAR0(1),' phi0=',VAR0(2),' dens=',VAR0(3)
C
 
C  VARIABLES INTERNES
C
      DO 50 I=1,NVARI
        VARF(I)=VAR0(I)
 50   CONTINUE
C
C    PASSAGE A L'OPTION DE CALCUL POUR LES CONTRAINTES
C
      IF (MFR1 .EQ. 1 .OR. MFR1 .EQ. 31)  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 ) THEN
C         CALCUL AXYSYMETRQUE OU CONTRAINTE PLANES
          DO 80 I=1,NSTRS
            SIGF(I)=RSIGF(I)
            DEFP(I)=RDEFP(I)
  80      CONTINUE
          IF ( RSIGF(5) .GT. 1.E-6 .OR.  RSIGF(6) .GT. 1.E-6) THEN
                WRITE (*,*) 'Dans la routine prvpar
     &          SMRT OU SMTZ NON NULLES APRES ECOUL'
          ENDIF
        ENDIF
      ENDIF
c     ajustement de l'ecrouissage
      GAMMA = 0.D0
      DO 90 I=1,NSTRS
         GAMMA = GAMMA+DEFP(I)*DEFP(I)
  90  CONTINUE
      GAMMA = SQRT(2.D0/3.D0*GAMMA)
      VARF(1)=VAR0(1)+GAMMA
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(1PE12.5,1X))
 1000 RETURN
      END