Sources Esope | Cast3M

uo2cr
C UO2CR     SOURCE    CHAT      05/01/13    03:58:52     5004
C   responsable STRUB
      SUBROUTINE UO2CR(NC,NCA,NN,SIGMA,W,WMAX,SMAX,BILIN,WRUPT,BTR,
     &      XLTR,XINVL,SBILI,FCRIT,PENTE,LEBIL,PRECIE,PRECIZ,KERRE)
C----------------------------------------------------------------------
C            ECOULEMENT MODELE UO2 (OTTOSEN ET GATT_MONERIE)
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 NN(NC)       = NUMEROS DES DIRECTIONS DE FISS. OU UN CRIT. EST ATTEINT
C SIGMA(6)     = CONTRAINTES
C W(3)         = OUVERTURES DES FISSURES
C WMAX(3)      = OUVERTURES MAXIMALES DES FISSURES
C SMAX(3)      = CONTR. CORRESPONDANT A WMAX
C BILIN(3)     = OUVERTURES DEFINISSANT LE CHANGEMENT DE PENTE EN CAS DE
C                RELATION BILINEAIRE ENTRE CONTRAINTE ET OUVERTURE
C WRUPT(3)     = OUVERTURES CONDITIONNANT LA RUPTURE
C BTR          = PARAMETRE DE FERMETURE
C XLTR(3)      = LIMITES EN TRACTION POUR LA FISSURATION
C XINVL(3)     = PARAMETRES DE TAILLE
C SBILI(3)     = CONTR. CORRESPONDANT A BILIN
C LEBIL(NC)    = COMPRESSION/TRACTION
C PRECIE       = PRECISION POUR TESTS SUR OUVERTURES DE FISSURES
C PRECIZ       = PRECISION POUR TESTS SUR CONTRAINTES
C
C  SORTIES
C  -------
C FCRIT(NC)    = CRITERE DE FISSURATION
C PENTE(NC)    = PENTE DE LA DROITE DE FISSURATION CORRESPONDANT A FCRIT
C KERRE        = GESTION DES ERREURS
C----------------------------------------------------------------------
C
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)
 
-INC PPARAM
-INC CCOPTIO
C
      PARAMETER (XZER=0.D0,UN=1.D0)
C
      DIMENSION NN(*),SIGMA(*),W(*),WMAX(*),SMAX(*),BILIN(*),WRUPT(3)
      DIMENSION XLTR(*),XINVL(*),SBILI(*),FCRIT(*),PENTE(*),LEBIL(*)
      DIMENSION WREOUV(3)
C
C     INITIALISATIONS
C
      KERRE=0
      DO IC=1,NC
        FCRIT(IC)=-1.D4*PRECIZ
      ENDDO
C
      DO IC=1,NCA
         JC=NN(IC)
C
         GO TO (1,1,1),JC
C
         KERRE=99
         RETURN
C
  1      CONTINUE
C
         IF (XINVL(JC).NE.XZER) THEN
C
           WREOUV(JC) = BTR*MIN(WMAX(JC),WRUPT(JC))
           PRECIW=PRECIE/XINVL(JC)
 
      IF(IIMPI.EQ.42) THEN
            PRINT *,'  '
            PRINT *,'UO2CR - JC     =',JC
            PRINT *,'UO2CR - W      =',W(JC)
            PRINT *,'UO2CR - WMAX   =',WMAX(JC)
            PRINT *,'UO2CR - WREOUV =',WREOUV(JC)
            PRINT *,'UO2CR - WRUPT  =',WRUPT(JC)
            PRINT *,'UO2CR - SMAX   =',SMAX(JC)
            PRINT *,'UO2CR - LEBIL  =',LEBIL(JC)
      ENDIF
C
C
C          cas ou le materiau n est pas totalement casse
C          ---------------------------------------------
C
           IF(WMAX(JC).LT.WRUPT(JC)) THEN
C
             IF(ABS(W(JC)-WREOUV(JC)).LT.PRECIW) THEN
C
                IF(WMAX(JC).EQ.0.D0.OR.BTR.EQ.UN) THEN
C
C               le materiau vient d'atteindre la limite
C
                  CALL OTTOFU(XINVL,XLTR,WRUPT,BTR,BILIN,SBILI,W,
     &                      WMAX,SMAX,PENTE,JC)
                  FCRIT(JC)=SIGMA(JC)-SMAX(JC)
C
                ELSE
C
C                  CAS A L'INTERSECTION SIGMA=0 - SECANTE
C
                   IF(LEBIL(JC).EQ.0) THEN
                      FCRIT(JC)=SIGMA(JC)
                      IF(FCRIT(JC).GE.-PRECIZ) THEN
                        PENTE(JC) = SMAX(JC)/(WMAX(JC)-WREOUV(JC))
                      ENDIF
C
                   ELSE IF(LEBIL(JC).EQ.1) THEN
                      PENTE(JC) = SMAX(JC)/(WMAX(JC)-WREOUV(JC))
                      FCRIT(JC)= SIGMA(JC) -
     &                   PENTE(JC)*(W(JC)-WREOUV(JC))
C
                   ELSE IF(LEBIL(JC).EQ.2) THEN
                      PRINT *,'UO2CR CAS IMPOSSIBLE SELON ',JC
                      KERRE=7
                      RETURN
                   ENDIF
                ENDIF
C
             ELSE IF(W(JC).GT.WREOUV(JC)) THEN
C
C
                IF(W(JC)-WMAX(JC).GT.PRECIW) THEN
C
                   PRINT *,' UO2CR  -  W > WMAX  SELON ',JC
                   PRINT *,'W(JC) =',W(JC)
                   PRINT *,'WMAX(JC) =',WMAX(JC)
                   KERRE=7
                   RETURN
 
C
C
                ELSE IF(ABS(W(JC)-WMAX(JC)).LT.PRECIW) THEN
C
C                  CAS A L'INTERSECTION SECANTE - POST PIC
C
                   IF(LEBIL(JC).EQ.0) THEN
                      CALL OTTOFU(XINVL,XLTR,WRUPT,BTR,BILIN,
     &                            SBILI,W,WMAX,SMAX,PENTE,JC)
                      FCRIT(JC)=SIGMA(JC)-SMAX(JC)
C
                   ELSE IF(LEBIL(JC).EQ.1) THEN
                      PENTE(JC) = SMAX(JC)/(WMAX(JC)-WREOUV(JC))
                      FCRIT(JC)= SIGMA(JC) -
     &                   PENTE(JC)*(W(JC)-WREOUV(JC))
C
                   ELSE IF(LEBIL(JC).EQ.2) THEN
                      PRINT *,'UO2CR CAS IMPOSSIBLE SELON ',JC
                      KERRE=7
                      RETURN
                   ENDIF
C
C
                ELSE IF(W(JC).LT.WMAX(JC)) THEN
C
                   PENTE(JC) = SMAX(JC)/(WMAX(JC)-WREOUV(JC))
                   FCRIT(JC)= SIGMA(JC) - PENTE(JC)*(W(JC)-WREOUV(JC))
C
                ENDIF
C
             ELSE IF(W(JC).LT.WREOUV(JC)) THEN
                PRINT *,' UO2CR  -  W &lt; WREOUV SELON ',JC
                PRINT *,'W(JC) =',W(JC)
                PRINT *,'WREOUV(JC) =',WREOUV(JC)
                KERRE=7
                RETURN
             ENDIF
C
C          cas ou le materiau est totalement casse
C          ---------------------------------------
C
           ELSE IF(WMAX(JC).GE.WRUPT(JC)) THEN
C
             FCRIT(JC)=SIGMA(JC)
C
             IF(IIMPI.EQ.42) THEN
               PRINT *,'W(JC) =',W(JC)
               PRINT *,'WREOUV(JC) =',WREOUV(JC)
             ENDIF
C
             IF(ABS(W(JC)-WREOUV(JC)).LT.PRECIW) THEN
C
                IF(IIMPI.EQ.42) THEN
                    PRINT *,' UO2CR - ON EST A LA LIMITE '
                ENDIF
C
                IF(FCRIT(JC).GE.-PRECIZ) THEN
                   PENTE(JC)=0.D0
                ENDIF
             ELSE IF(W(JC).GT.WREOUV(JC)) THEN
                PENTE(JC)=0.D0
             ENDIF
C
           ENDIF
C
         ENDIF
C
      ENDDO
C
      IF(IIMPI.EQ.42) THEN
        WRITE(IOIMP,77000) (FCRIT(IC),IC=1,3)
77000   FORMAT( 2X, ' UO2CR - FCRIT '/(3(1X,1PE12.5)/)/)
        WRITE(IOIMP,77003) (PENTE(IC),IC=1,3)
77003   FORMAT( 2X, ' UO2CR - PENTE '/(3(1X,1PE12.5)/)/)
      ENDIF
C
      RETURN
      END