Sources Esope | Cast3M

uo2ec2
C UO2EC2    SOURCE    STRU      06/03/20    21:15:44     5340
      SUBROUTINE UO2EC2(NC,NCA,NN,SIGMA,W,WMAX,
     &    XLTR,XINVL,FCRIT,FCRIT2,PENTE,LEBIL,
     &    PRECIE,PRECIZ,KERRE)
C----------------------------------------------------------------------
C         MODELE UO2 (OTTOSEN ET GATT_MONERIE) SIMPLIFIE
C                  ENERGIE DE FISSURATION NULLE
C             CARACTERISATION DE L ETAT DE FISSURATION
C----------------------------------------------------------------------
C
C  ENTREES
C  -------
C NC           = (3) NBR. TOTAL DE DIRECTIONS DE FISS. POSSIBLES
C NCA          = NBR. DE DIRECTIONS DE FISS. OU UN CRITERE EST ATTEINT
C                (NCA=NC=3 A L APPEL PAR UO2ET)
C NN(NC)       = NUMEROS DES DIRECTIONS DE FISS. OU UN CRIT. EST ATTEINT
C                (CONTIENT NN(I)=I I=1,3 A L APPEL PAR UO2ET)
C SIGMA(6)     = CONTRAINTES INITIALES
C W(3)         = OUVERTURES INITIALES DES FISSURES
C WMAX(3)      = OUVERTURES MAXIMALES INITIALES DES FISSURES
C XLTR(3)      = LIMITES EN TRACTION POUR LA FISSURATION
C XINVL(3)     = PARAMETRES DE TAILLE
C PRECIE       = PRECISION POUR TESTS SUR OUVERTURES DE FISSURES
C PRECIZ       = PRECISION POUR TESTS SUR CONTRAINTES
C
C
C
C  SORTIES
C  -------
C FCRIT(NC)    = CRITERE DE FRACTURATION
C FCRIT2(NC)   = CRITERE DE FISSURATION
C PENTE(NC)    = PENTE DE LA DROITE DE FRACTURATION CORRESPONDANT A FCRIT
C LEBIL(NC)    = COMPRESSION/TRACTION
C----------------------------------------------------------------------
C
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)
 
-INC PPARAM
-INC CCOPTIO
C
      PARAMETER (XZER=0.D0,UNDEMI=.5D0,UN=1.D0,DEUX=2.D0,TROIS=3.D0)
C
      DIMENSION NN(*),SIGMA(*),W(*),WMAX(*)
      DIMENSION XLTR(*),XINVL(*)
      DIMENSION FCRIT(*),FCRIT2(*),PENTE(*),LEBIL(*)
C
C -----------------------
C     INITIALISATIONS
C -----------------------
C
      KERRE=0
      DO IC=1,NC
        FCRIT(IC)=-1.D4*PRECIZ
        FCRIT2(IC)=-1.D4*PRECIZ
        LEBIL(IC)=0
      ENDDO
C
C
      DO IC=1,NCA
         JC=NN(IC)
C
         GO TO (1,1,1),JC
C
         PRINT *,'UO2EC2 - CAS IMPOSSIBLE JC = ',JC
         KERRE=989
         RETURN
C
  1      CONTINUE
C-----------------
C
         IF (XINVL(JC).NE.XZER) THEN
C
           PRECIW=PRECIE/XINVL(JC)
C
           FCRIT(JC)=SIGMA(JC)
           PENTE(JC)=XZER
C
           IF(IIMPI.EQ.42) THEN
                  PRINT *,'UO2EC2 - JC     =',JC
                  PRINT *,'UO2EC2 - W      =',W(JC)
                  PRINT *,'UO2EC2 - WMAX   =',WMAX(JC)
            ENDIF
C
C
C          fissuration ou fracturation sans ouverture prealable
C          ----------------------------------------------------
C
           IF (WMAX(JC).EQ.XZER) THEN
 
             IF (FCRIT(JC).GT.PRECIZ) THEN
               FCRIT2(JC) = SIGMA(JC) - XLTR(JC)
               LEBIL(JC)=1
             ELSE
               IF (FCRIT(JC).GE.-PRECIZ) LEBIL(JC)=1
             ENDIF
 
           ELSE
C
C          fracturation
C          ------------
C
             IF (ABS(W(JC)).LT.PRECIW) THEN
               IF (FCRIT(JC).GE.-PRECIZ) LEBIL(JC)=1
             ELSE IF(W(JC).GT.XZER) THEN
               LEBIL(JC)=1
             ENDIF
C
           ENDIF
C
C          fin tests sur ouvertures
C          ------------------------
C
         ENDIF
C
      ENDDO
C
      IF(IIMPI.EQ.42) THEN
        WRITE(IOIMP,77000) (FCRIT(IC),IC=1,NC)
77000   FORMAT( 2X, ' UO2EC2 - FCRIT '/(3(1X,1PE12.5)/)/)
        WRITE(IOIMP,77001) (FCRIT2(IC),IC=1,NC)
77001   FORMAT( 2X, ' UO2EC2 - FCRIT '/(3(1X,1PE12.5)/)/)
        WRITE(IOIMP,77002) (PENTE(IC),IC=1,NC)
77002   FORMAT( 2X, ' UO2EC2 - PENTE '/(3(1X,1PE12.5)/)/)
        WRITE(IOIMP,77004) (LEBIL(IC),IC=1,NC)
77004   FORMAT( 2X, ' UO2EC2 - LEBIL '/(3I4)/)
      ENDIF
C
      RETURN
      END