Sources Esope | Cast3M

uo2vi2
C UO2VI2    SOURCE    FANDEUR   22/05/02    21:15:31     11359          
C   responsable STRUB
       SUBROUTINE  UO2VI2(NC1,NCA,NDIM,NN,PRECIZ,EPSPT,EPSVPT,
     &                    EPSDPT,EPSGPT,DDE,DFDS,DGDS,HDFDQ,DDX,SIGPT,
     &                    KERRE)
C-----------------------------------------------------------------------
C                MODELE UO2 (OTTOSEN+GATT_MONERIE)
C          CALCUL DES VITESSES DES GRANDEURS SUIVANTES:
C  - DEFORMATIONS DUES A LA FISSURATION (OUVERTURES)
C  - CONTRAINTES
C-----------------------------------------------------------------------
C
C  ENTREES
C  -------
C NC1          = NC+1 AVEC NC(=3) NBR. TOTAL DE DIRECTIONS DE FISS.
C NCA          = NBR. DE DIRECTIONS DE FISS. OU UN CRITERE EST ATTEINT
C NDIM         = NCA+1 SI CP, NCA SINON
C NN(NC)       = NUMEROS DES DIRECTIONS DE FISS. OU UN CRIT. EST ATTEINT
C PRECIZ       = PRECISION POUR L INVERSION DE LA MATRICE
C EPSPT(6)     = VIT. DE DEF. TOT.
C EPSVPT(6)    = VIT. DE DEF. VISCOPLAST.
C EPSDPT(3)    = VIT. DE DEF. DE DENSIFICATION
C EPSGPT(3)    = VIT. DE DEF. DE GONFLEMENT
C DDE(18)      = MATRICE DE HOOKE FISSUREE
C DFDS(6,NC)   = DERIVEES DES CRITERES DE FISSURATION / CONTRAINTES
C DGDS(6,NC)   = MATRICE DE PASSAGE DU VECTEUR DES DEF. DE FISSURATION
C                EN OUVERTURE AU VECTEUR DE FISSURATION COMPLET
C                (OUVERTURES + GLISSEMENTS)
C HDFDQ(NC)    = DERIVEES DES CRITERES DE FISSURATION /
C                VECTEUR DES DEF. DE FISSURATION EN OUVERTURE
C
C  SORTIES
C  -------
C DDX(NC1)     = VIT. DES DEF. DE FISSURATION (+ PREMIERE COMPOSANTE
C                DE LA VIT. DE DEF. TOT. SI CP)
C SIGPT(6)     = VIT. DES CONTRAINTES
C KERRE        = GESTION DES ERREURS
C-----------------------------------------------------------------------
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)
 
-INC PPARAM
-INC CCOPTIO
 
       DIMENSION NN(*),EPSPT(*),EPSVPT(*),EPSDPT(*),EPSGPT(*),DDE(*)
       DIMENSION DFDS(6,*),DGDS(6,*),HDFDQ(*),DDX(*),SIGPT(*)
       DIMENSION AA(4,4),BB1(4)
       DIMENSION VAUX1(6),DEPS(6),DSIGT(6),EPSPT1(6),EPSFPT(6)
 
      KERRE=0
      CALL ZDANUL(DDX,NC1)
      CALL ZDANUL(VAUX1,6)
      CALL ZDANUL(EPSFPT,6)
 
      DO I=1,6
        DEPS(I)=EPSPT(I)-EPSVPT(I)
      ENDDO
      DO I=1,3
        DEPS(I)=DEPS(I)-(EPSDPT(I)+EPSGPT(I))
      ENDDO
      CALL OTTOPR(DDE,DEPS,DSIGT)
C
C
C calcul de DDX - vit des def de fiss (+ premiere compos de la vit de def tot si cp)
C
      IF (NCA.EQ.0) THEN
C     ------------------
        IF (IFOUR.EQ.-2) DDX(NDIM)=-DSIGT(1)/DDE(1)
      ELSE
C     ----
      DO IJ=1,NCA
C
         JJ=NN(IJ)
         CALL OTTOPR(DDE,DGDS(1,JJ),VAUX1)
C
         DO IK=1,NCA
            JK=NN(IK)
            r_z = 0.D0
            DO i = 1, 6
               r_z = r_z + DFDS(i,JK)*VAUX1(i)
            ENDDO
            IF (IK.EQ.IJ) r_z = r_z - HDFDQ(JK)
            AA(IK,IJ) = r_z
         ENDDO
 
         r_z = 0.D0
         DO i = 1, 6
            r_z = r_z + DFDS(i,JJ)*DSIGT(i)
         ENDDO
         BB1(IJ) = r_z
C
C        SPECIAL CP
C
         IF(IFOUR.EQ.-2) THEN
C           LA COMPOSANTE EPS 33 EST EN POSITION 1
            AA(IJ,NDIM)=-(DFDS(1,JJ)*DDE(1)+DFDS(2,JJ)*DDE(6)
     &                   +DFDS(3,JJ)*DDE(5)+DFDS(4,JJ)*DDE(10)
     &                   +DFDS(5,JJ)*DDE(13)+DFDS(6,JJ)*DDE(16))
            AA(NDIM,IJ)=VAUX1(1)
            AA(NDIM,NDIM)=-DDE(1)
            BB1(NDIM)=DSIGT(1)
         ENDIF
C
      ENDDO
C
      DO IK=1,NCA
         IF(AA(IK,IK).LT.0.D0) THEN
            WRITE(IOIMP,*) ' UO2VI2 - TERME DIAGONAL NEGATIF'
            KERRE=61
            WRITE(IOIMP,77011) ((AA(I,J),J=1,5),I=1,5)
            RETURN
         ENDIF
      ENDDO
C
      IF(IIMPI.EQ.42) THEN
         WRITE(IOIMP,77011) ((AA(I,J),J=1,4),I=1,4)
77011    FORMAT(5X,' MATRICE AA'/(5(1X,1PE12.5)))
         WRITE(IOIMP,77012) (BB1(I),I=1,4)
77012    FORMAT(5X,' VECTEUR BB1'/(5(1X,1PE12.5)))
      ENDIF
C
C --- RESOLUTION
C
      CALL INVALM(AA,NC1,NDIM,KERRE,1D-10)
      IF(KERRE.NE.0) THEN
         WRITE(IOIMP,*) ' UO2VI2 - INVERSION MATRICE IMPOSSIBLE'
         RETURN
      ENDIF
      IF(IIMPI.EQ.42) THEN
         WRITE(IOIMP,77013) ((AA(I,J),J=1,4),I=1,4)
77013    FORMAT(5X,' MATRICE AA INVERSEE '/(5(1X,1PE12.5)))
      ENDIF
C
      CALL MULMA2(DDX,AA,BB1,NDIM,1,NDIM,NC1,NC1)
C
C --- CALCUL DE |F*dµ/dt
C
      DO IJ=1,NCA
         JJ=NN(IJ)
         DO I=1,6
           EPSFPT(I)=EPSFPT(I)+DGDS(I,JJ)*DDX(IJ)
         ENDDO
      ENDDO
C
      ENDIF
C     ----
C
C calcul de SIGPT - vit de contraintes
C
      CALL ZDANUL(EPSPT1,6)
      IF(IFOUR.EQ.-2) EPSPT1(1)=DDX(NDIM)
C
      DO I=1,6
        DEPS(I)=DEPS(I)+EPSPT1(I)-EPSFPT(I)
      ENDDO
      CALL OTTOPR(DDE,DEPS,SIGPT)
C
      RETURN
      END