C UO2CA2    SOURCE    STRU      07/05/31    21:15:32     5744           
C   responsable STRUB
      SUBROUTINE UO2CA2(DT,MSOUPA,PRECIE,PRECIZ,SIG0,DEPST,EPSV,VARGA0,
     &                 NGAT,W,WMAX,XLTR,
     &                 XINVL,GS,XMAT,NCOMAT,NSIMP,AAD,
     &                 TETA1,TPOINT,FI1,FPOINT,PRECIS,IB,IGAU,
     &                 NFISSU,NVF,VF,XX,IRESU,NRESU,
     &                 SIGF,DEFP,EPSVF,VARGAF,KERRE)
C----------------------------------------------------------------------
C      ECOULEMENT MODELE UO2 (OTTOSEN ET GATT_MONERIE) SIMPLIFIE
C----------------------------------------------------------------------         
C                                                                               
C  ENTREES
C  -------
C DT           = PAS D INTEGRATION
C MSOUPA       = NBR. MAX. DE SOUS PAS AUTORISES POUR LA VISCOPLASTICITE
C PRECIE       = PRECISION POUR TESTS SUR OUVERTURES DE FISSURES
C PRECIZ       = PRECISION POUR TESTS SUR CONTRAINTES
C SIG0(6)      = CONTR. AU DEBUT DU SOUS PAS D'INTEGRATION
C DEPST(6)     = INCR. DES DEFORM. TOTALES SUR LE PAS D INTEGRATION
C EPSV(6)      = DEFORM. VISCOPLAST. AU DEBUT DU SOUS PAS D'INTEGRATION
C VARGA0(NGAT) = VAR. INT. SCAL. DE GATT_MONERIE AU DEB. DU SS PAS
C NGAT         = NOMBRE DE VAR. INT. SCALAIRES DU MODELE GATT_MONERIE
C W(3)         = OUVERTURES DES FISSURES AU DEBUT DU SOUS PAS
C WMAX(3)      = OUVERTURES MAXIMALES DES FISSURES AU DEBUT DU SOUS PAS
C XLTR(3)      = LIMITES EN TRACTION POUR LA FISSURATION
C XINVL(3)     = PARAMETRES DE TAILLE
C GS(3)        = RESISTANCES AU CISAILLEMENT
C XMAT(NCOMAT) = CARACTERISTIQUES THERMOMECANIQUES DU MATERIAU
C NSIMP        = POINTE SUR LA CARACTERISTIQUE FACULTATIVE 'SIMP' DE XMAT
C AAD          = COEFFICIENT INTERVENANT DANS LE CALCUL DE L INCREMENT
C                DE LA DEFORMATION DE DENSIFICATION
C TETA1        = TEMPERATURE AU DEBUT DU PAS D INTEGRATION
C TPOINT       = VITESSE DE TEMPERATURE CTE SUR LE PAS D INTEGRATION
C FI1          = DENSITE DE FISSION AU DEBUT DU PAS D INTEGRATION
C FPOINT       = VIT. DE DENSITE DE FISSION CTE SUR LE PAS D INTEGRATION
C PRECIS       = PRECISION POUR LA VISCOPLASTICITE
C IB           = NUMERO DE L ELEMENT
C IGAU         = NUMERO DU POINT D INTEGRATION
C NFISSU       = NOMBRE DE FISSURES
C NVF          = NBR DE DIRECTIONS IMPOSEES POUVANT DEVENIR
C                DES DIRECTIONS DE FISSURATION
C
C  SORTIES
C  -------
C W(3)         = OUVERTURES DES FISSURES   A LA FIN DE LA DUREE CALCULEE
C WMAX(3)      = OUVERTURES MAX. DES FISS. A LA FIN DE LA DUREE CALCULEE
C VF(3,3)      = VECTEURS DES DIRECTIONS DE FISSURATION
C XX           = DUREE QUI VIENT D ETRE CALCULEE
C IRESU(20)    = TYPE DES NOUVELLES NON LINEARITES RENCONTREES
C                POUR LA FISSURATION
C NRESU        = NOMBRE DE NOUVELLES NON LINEARITES (FISSURATION)
C SIGF(6)      = CONTR. A LA FIN DE LA DUREE CALCULEE
C DEFP(6)      = INC. DES DEFORM. INELASTIQUES (FISSURATION+VISCOPLAST.)
C                A LA FIN DE LA DUREE CALCULEE
C EPSVF(6)     = DEFORM. VISCOPLAST. A LA FIN DE LA DUREE CALCULEE
C VARGAF(NGAT) = VAR. INT. SCAL. A LA FIN DE LA DUREE CALCULEE
C KERRE        = GESTION DES ERREURS
C
C   RAPPEL :  EN DEFO PLANES,CONTRAINTES PLANES OU AXI,
C             LA DIRECTION 1 EST CELLE PERPENDICULAIRE AU MAILLAGE
C-----------------------------------------------------------------------        
C
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)                                                  
-INC CCOPTIO                                                                   
C
      PARAMETER (XZER=0.D0,NC=3,NGATT=4)
C
      DIMENSION SIG0(*),DEPST(*),EPSV(*),VARGA0(*)
      DIMENSION W(*),WMAX(*),XLTR(*)
      DIMENSION XINVL(*)
      DIMENSION GS(*),XMAT(*)
      DIMENSION VF(3,*),IRESU(*)
      DIMENSION SIGF(*),DEFP(*),EPSVF(*),VARGAF(*)
C
      DIMENSION EPSPT(6),SIGG0(6),EPSV0(6),VAR0(NGATT)
      DIMENSION W0(3),WMAX0(3),DX0(NC),DX00(NC)
      DIMENSION SIGGF(6),EPSVVF(6),VARF(NGATT),WF(3),DXF(NC),EPSFF(6)
      DIMENSION DGDS0(6,NC),DGDSF(6,NC),DFDS(6,NC),HDFDQ(NC)
      DIMENSION WMAXF(3),DXV1(NC)
C
      DIMENSION NN(NC),FC(NC),FC2(NC),PENTE(NC),LEBIL(NC)
      DIMENSION FCV(20),FCV1(20),MM(20)
C
      DIMENSION IFERM(NC),NN0(NC)
C
      DIMENSION JFIS(3)
C
      DATA ITMAX/25/
      DATA IRMAX/5/
C
C--------------------
C   INITIALISATIONS
C--------------------
      KERRE=0
      NC1=NC+1
      IRED=0
      IFLAG1=1
      YOUN=XMAT(1)
C
C --- PAS DE TEMPS CALCULE INITIAL
C
      DTCALC=DT
C
C ------------ LA VITESSE DE LA DEFORMATION TOTALE EST CTE ------------
C
      DO 10 I=1,6
        EPSPT(I)=DEPST(I)/DT
10    CONTINUE
      IF (IFOUR.EQ.-2) EPSPT(1)=XZER
C
C
      IF(IIMPI.EQ.42) THEN
         WRITE(IOIMP,74433) (EPSPT(I),I=1,6)
74433    FORMAT(1X,' EPSPT ',6(1X,1PE12.5)/)
      ENDIF
C
C ------------ DEFORMATION DE FISSURATION EN OUVERTURE ------------
C
      DO I=1,3
         DX00(I)=W(I)*XINVL(I)
      ENDDO
C
C
888   CONTINUE
C
      IRED=IRED+1
      IF(IRED.GT.IRMAX) THEN
         PRINT *,'&&&&&&&& UO2CA2  IRED = ',IRED
         KERRE=989
         RETURN
      ENDIF
C
      IF(IRED.GT.1) DTCALC=0.5*DTCALC
C
C
C
      DTLEFT = DTCALC
      TAU    = DTLEFT
      XX     = XZER
C
      T0=TETA1
      FI0=FI1
C
C ----- CONTRAINTES - DEF. VISCOPLAST. -----
C
      DO I=1,6
        SIGG0(I)=SIG0(I)
        EPSV0(I)=EPSV(I)
      ENDDO
C
C ------- VARIABLES INTERNES DE GATT_MONERIE -------
C
      DO I=1,NGAT
        VAR0(I)=VARGA0(I)
      ENDDO
C
C ------------ VARIABLES DE FISSURATION ------------
C
      DO I=1,3
         W0(I)=W(I)
         WMAX0(I)=WMAX(I)
         DX0(I)=W0(I)*XINVL(I)
      ENDDO
C
C
      NSSINC=0
C
C --------------------------------------------------------------        
C       DEBUT DES ITERATIONS EN SSINCREMENTS / FIN SI DTLEFT = 0                
C --------------------------------------------------------------
1400  CONTINUE
      ITERU=0
1500  CONTINUE
C
      NSSINC = NSSINC + 1
      IF (NSSINC.GT.MSOUPA) THEN
        KERRE=268
        PRINT *,' UO2CA2 - PAS DE CONVERGENCE EN VISCOPLASTICITE'
        RETURN
      ENDIF
C
C-----------------------------------------------------------------------
C  Etat de fissuration au temps XX et crit. susceptibles d etre atteints
C-----------------------------------------------------------------------
      CALL ZDANUL(DXV1,3)
C
      CALL UO2ET2(NC,NN,SIGG0,W0,WMAX0,
     &           XLTR,XINVL,PRECIE,PRECIZ,FC,FC2,LEBIL,NFISSU,
     &           NVF,VF,FCV,PENTE,DXV1,YOUN,NCA,MC,MM,IFERM,KERRE)
      IF(KERRE.NE.0) RETURN
C
C
      ITERI=0
444   CONTINUE
C
      IF (ITERI.NE.0) THEN
C     --------------------
        IF(IIMPI.EQ.42) THEN
          WRITE(IOIMP,74078)
74078     FORMAT(/2X,' ON REINITIALISE LE PROCESSUS'//)
        ENDIF
        IF(ITERI.GT.NC) THEN
          KERRE=989
          PRINT *,' UO2CA2 - PAS DE CONVERGENCE - ITERI ',ITERI
          RETURN
        ENDIF
C
C       calcul de PENTE pour tableau NN reduit NN(ITERI+1)<NN(ITERI)
C
        CALL UO2CR2(NC,NCA,NN,SIGG0,W0,WMAX0,
     &             XINVL,FC,PENTE,LEBIL,PRECIE,PRECIZ,KERRE)
        IF(KERRE.NE.0) RETURN
C
      ENDIF
C     -----
C
      NDIM=NCA
      IF(IFOUR.EQ.-2) NDIM=NCA+1                                                                   
C
C --- determination d un etat converge pour TAU inf. ou egal a DTCALC
C
      CALL UO2DC2(IFLAG1,T0,TPOINT,FI0,FPOINT,PRECIS,PRECIZ,
     &            XMAT,NCOMAT,NSIMP,AAD,GS,LEBIL,XINVL,PENTE,
     &            EPSPT,SIGG0,EPSV0,VAR0,W0,WMAX0,DX0,
     &            NGAT,NC1,NCA,NDIM,NN,TAU,TAUNEX,SIGGF,EPSVVF,
     &            VARF,WF,DXF,WMAXF,TF,FIF,KERRE)
      IF (KERRE.NE.0) THEN
        RETURN 
      ENDIF
C
C --- Viole-t-on un critere de fissuration pour l etat converge ?
C
      CALL ZDANUL(DXV1,3)
C
      CALL UO2CE2(MC,MM,SIGG0,DXV1,W0,XLTR,XINVL,
     &           NFISSU,NVF,FCV1,VF,YOUN,PRECIZ,JFIS,KERRE)
      IF(KERRE.NE.0) RETURN
C
      CALL UO2XX2(T0,TPOINT,FI0,FPOINT,PRECIS,PRECIZ,
     &            XMAT,NCOMAT,NSIMP,AAD,GS,LEBIL,XINVL,PENTE,
     &            YOUN,EPSPT,SIGG0,EPSV0,VAR0,W0,WMAX0,DX0,
     &            XLTR,NFISSU,NVF,VF,MC,MM,FCV1,NGAT,NC1,NCA,NDIM,
     &            NN,TAU,SIGGF,EPSVVF,VARF,WF,DXF,WMAXF,
     &            TF,FIF,MCA,XXX,IRESU,NRESU,LERED,KERRE)
      IF(KERRE.NE.0) RETURN
      IF(LERED.EQ.1) GO TO 888
C
      IF(XXX.LE.0.D0) THEN
         KERRE=989
         PRINT *,' UO2CA2 - XXX EST NEGATIF OU NUL '
         RETURN
      ENDIF
C
C
C --- Controle de la coherence des resultats pour XXX*TAU
C     ------------------
      IF (NCA.NE.0) THEN
C     ------------------
      NCA0=NCA
      NCAA=0
      DO IJ=1,NCA
         NN0(IJ)=NN(IJ)
         JJ=NN(IJ)
         DXSOM=DXF(JJ)-DX0(JJ)
C
         IF(DXSOM.GE.0.D0) THEN
            NCAA=NCAA+1
            NN(NCAA)=JJ
         ELSE IF(DXSOM.LT.0.D0) THEN
C
            IF(LEBIL(JJ).EQ.1) THEN
C
               IF(IFERM(JJ).NE.1) THEN
                  NCAA=NCAA+1
                  NN(NCAA)=JJ
               ELSE IF(IFERM(JJ).EQ.1) THEN
                  IF(WF(JJ).GT.XZER) THEN
                     NCAA=NCAA+1
                     NN(NCAA)=JJ
                  ENDIF
               ENDIF
C
            ENDIF
         ENDIF
      ENDDO
C
      IF(IIMPI.EQ.42) THEN
         WRITE(IOIMP,77008) NCA,NCAA,(NN(IJ),IJ=1,NCAA)
77008    FORMAT(5X,'NCA=',I3,2X,'NCAA=',I3/2X,'NN ' ,8I3/)
      ENDIF
C
      IF(NCAA.EQ.0) THEN
        IF(IIMPI.EQ.42) THEN
           PRINT *,' UO2CA2 - NCAA EST NUL '
        ENDIF
           NCA=NCAA
           ITERI=ITERI+1
           GO TO 444
      ENDIF
C
C
      IF(NCA.NE.NCAA) THEN
         IF(NCAA.GT.NCA) THEN
            PRINT *,' UO2CA2 - NCAA EST SUPERIEUR A NCA '
            KERRE=989
            RETURN
         ENDIF
         NCA=NCAA
         ITERI=ITERI+1
         GO TO 444
      ENDIF
C     -----
      ENDIF
C     -----
C
C     -------------------------------------
      IF ((NCA.EQ.0).AND.(ITERI.NE.0)) THEN
C     -------------------------------------
      DO IJ=1,NCA0
         JJ=NN0(IJ)
         IF (IFERM(JJ).EQ.1) THEN
            SXDIF=SIGGF(JJ)-SIGG0(JJ)
            IF (SXDIF.GT.XZER) THEN
               PRINT *,'ATTENTION FOIREUX IB IGAU',IB,IGAU
               ITERU=ITERU+1
               IF(ITERU.GT.IRMAX) THEN
                 PRINT *,'&&&&&&&& UO2CA2  ITERU = ',ITERU
                 KERRE=989
                 RETURN
               ENDIF
               TAU=0.5*TAU
               GOTO 1500
            ENDIF
         ENDIF
      ENDDO
C     -----
      ENDIF
C     -----
C --- Fin du controle de la coherence des resultats pour XXX*TAU
C
C
      DO I=1,3
         IF(WF(I).GE.WMAXF(I)) WMAXF(I)=WF(I)
      ENDDO
C
C
C ---------------------
C ENCORE QUELQUES TESTS
C ---------------------
      CALL UO2VE2(NRESU,IRESU,SIGGF,WF,WMAXF,
     &            XLTR,XINVL,PRECIE,PRECIZ,NN,
     &            NN0,NC,NCA,FC,FC2,PENTE,LEBIL,KERRE)
      IF(KERRE.NE.0) RETURN
C
C
      IF (MCA.NE.0) THEN
        XX=XX+(XXX*TAU)
        GOTO 777
      ELSE
        XX=XX+TAU
      ENDIF
C
C ----- MAJ CONTRAINTES - DEF. VISCOPLAST. A t0+XX -----
C
      DO I=1,6
        SIGG0(I)=SIGGF(I)
        EPSV0(I)=EPSVVF(I)
      ENDDO
C
C ------- MAJ VARIABLES INTERNES DE GATT_MONERIE A t0+XX -------
C
      DO I=1,NGAT
        VAR0(I)=VARF(I)
      ENDDO
C
C ------------ MAJ VARIABLES DE FISSURATION A t0+XX ------------
C
      DO I=1,3
         W0(I)=WF(I)
         DX0(I)=DXF(I)
         WMAX0(I)=WMAXF(I)
      ENDDO
C
      T0=TF
      FI0=FIF
C
C ----------------------------------------------------
C  TEST DE FIN SS INCREMENTS /  MISE A JOUR DE TAU
C    fin des boucles en ss increments  si tau = dtleft                          
C ----------------------------------------------------
C
      IF (TAU.LT.DTLEFT) THEN
        DTLEFT = DTLEFT - TAU
        IF (TAUNEX.GT.DTLEFT) TAUNEX = DTLEFT
        TAU=TAUNEX
        GOTO 1400
      ENDIF                                                                    
C                                                                               
      IF (ABS(TAU-DTLEFT).GT.(TAU/1000.)) THEN                                 
         PRINT *, ' UO2CA2 - PROBLEME  TAU > DTLEFT '
         KERRE=989
         RETURN
      ENDIF
C
      XX=DTCALC
C
 777  CONTINUE
C
C -------------------------
C MAJ DES VARIABLES A t0+XX
C -------------------------
C ------------ MAJ VARIABLES DE FISSURATION ------------
C
      DO I=1,3
         W(I)=WF(I)
         WMAX(I)=WMAXF(I)
      ENDDO
C
C ----- MAJ DEF. VISCOPLAST. -----
C
      DO I=1,6
        EPSVF(I)=EPSVVF(I)
      ENDDO
C
C ----- MAJ INCREMENT DES DEF. DE FISS. (OUV. + GLISS.)
C
      CALL ZDANUL(EPSFF,6)
      IF (NCA.NE.0) THEN
C
C      Calcul de DGDS0/DGDSF pour SIG0/SIGGF (etats initial/duree calculee)
        CALL UO2FL(NCA,NN,XINVL,PENTE,SIG0,GS,DFDS,DGDS0,HDFDQ,KERRE)
        CALL UO2FL(NCA,NN,XINVL,PENTE,SIGGF,GS,DFDS,DGDSF,HDFDQ,KERRE)
C
        DO IJ=1,NCA
           JJ=NN(IJ)
           DO I=1,6
             DXF(IJ)=W(IJ)*XINVL(IJ)
             EPSFF(I)=EPSFF(I)+
     &                     (DGDSF(I,JJ)*DXF(IJ))-(DGDS0(I,JJ)*DX00(IJ))
           ENDDO
        ENDDO
      ENDIF
C
C ----- MAJ INCREMENT DES DEF. INELAST. (FISS.+VISCOPLAST.)
C
      DO I=1,6
        EPSFF(I)=EPSFF(I)+(EPSVF(I)-EPSV(I))
      ENDDO
C
C ------- MAJ VARIABLES INTERNES DE GATT_MONERIE -------
C
      DO I=1,NGAT
        VARGAF(I)=VARF(I)
      ENDDO
C
C --------------------------------------------------
C MAJ CONTR. - INCR. DES DEF. INELAST. - SORTIE
C --------------------------------------------------
      DO I=1,6
        SIGF(I)=SIGGF(I)
        DEFP(I)=EPSFF(I)
      ENDDO
C
C
      IF(IIMPI.EQ.42) THEN
         WRITE(IOIMP,77894) XX
77894    FORMAT(1X,'  UO2CA2 - DUREE CALCULEE XX '/1X,1PE12.5/)
         WRITE(IOIMP,77895) (SIGF(IJ),IJ=1,6)
77895    FORMAT(1X,'  UO2CA2 - SIGF    '/(6(1X,1PE12.5))/)
         WRITE(IOIMP,77896) (DEFP(IJ),IJ=1,6)
77896    FORMAT(1X,'  UO2CA2 - DEFP '/(6(1X,1PE12.5))/)
      ENDIF
C
      RETURN
      END