Sources Esope | Cast3M

uo2ve
C UO2VE     SOURCE    STRU      06/03/20    21:16:14     5340
      SUBROUTINE UO2VE(NCRIT,JCRIT,SIGMA,W,WMAX,WRUPT,SMAX,
     &                 BTR,XLTR,XINVL,BILIN,SBILI,PRECIE,PRECIZ,NN,
     &                 NN0,NC,NCA,FC,FC2,PENTE,PENTE2,LEBIL,ISING,KERRE)
C----------------------------------------------------------------------
C            ECOULEMENT MODELE UO2 (OTTOSEN ET GATT_MONERIE)
C              PREPARATION DU TERRAIN POUR LE PAS SUIVANT
C----------------------------------------------------------------------
C
C  ENTREES
C  -------
C NCRIT        = NOMBRE DE NOUVELLES NON LINEARITES (FISSURATION)
C JCRIT(20)    = TYPE DES NOUVELLES NON LINEARITES RENCONTREES
C                POUR LA FISSURATION
C SIGMA(6)     = CONTR. A LA FIN DE LA DUREE CALCULEE
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 WRUPT(3)     = OUVERTURES CONDITIONNANT LA RUPTURE
C SMAX(3)      = CONTR. CORRESPONDANT A WMAX
C BTR          = PARAMETRE DE FERMETURE
C XLTR(3)      = LIMITES EN TRACTION POUR LA FISSURATION
C XINVL(3)     = PARAMETRES DE TAILLE
C BILIN(3)     = OUVERTURES DEFINISSANT LE CHANGEMENT DE PENTE EN CAS DE
C                RELATION BILINEAIRE ENTRE CONTRAINTE ET OUVERTURE
C SBILI(3)     = CONTR. CORRESPONDANT A BILIN
C PRECIE       = PRECISION POUR TESTS SUR OUVERTURES DE FISSURES
C PRECIZ       = PRECISION POUR TESTS SUR CONTRAINTES
C NN(NCA)      = NUMEROS DES DIRECTIONS DE FISS. OU UN CRIT. EST ATTEINT
C                POUR L ETAT INITIAL
C NC           = (=3) NBR. TOTAL DE DIRECTIONS DE FISS. POSSIBLES
C
C  SORTIES
C  -------
C FC(NC)       = CRITERE DE FISSURATION
C FC2(NC)      = DEUXIEME CRITERE DE FISSURATION SI BIFURCATION POSSIBLE
C PENTE(NC)    = PENTE DE LA DROITE DE FISSURATION CORRESPONDANT A FCRIT
C PENTE2(NC)   = PENTE DE LA DROITE DE FISS. CORRESPONDANT A FCRIT2
C LEBIL(NC)    = COMPRESSION/TRACTION
C ISING(NC)    = SINGULARITES CORRESPONDANT A UNE BIFURCATION
C----------------------------------------------------------------------
C
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)
 
-INC PPARAM
-INC CCOPTIO
C
      PARAMETER (XZER=0.D0)
C
      DIMENSION JCRIT(*),SIGMA(*),W(*),WMAX(*),WRUPT(*),SMAX(*),XLTR(*),
     &          XINVL(*),BILIN(*),SBILI(*),NN(*),NN0(*),LEBIL(*),
     &          ISING(*)
      DIMENSION FC(*),FC2(*),PENTE(*),PENTE2(*)
C
      KERRE=0
C
C
      DO I=1,3
         IF(ABS(WMAX(I)-WRUPT(I)).LT.WRUPT(I)*PRECIE) THEN
             IF(W(I).EQ.WMAX(I)) THEN
                W(I)=WRUPT(I)
             ENDIF
             WMAX(I)=WRUPT(I)
             SMAX(I)=XZER
         ENDIF
      ENDDO
C
C
C ---------------------------------------------
C   INCREMENT DES DEF. DE FISS. (OUV. + GLISS.)
C ---------------------------------------------
*      DO I=1,6
*        IF(ABS(DEFPLA(I)).LT.PRECIE*1.D-2) DEFPLA(I)=XZER
*      ENDDO
C
C
C*************************
      IF (NCRIT.NE.0) THEN
C*************************
      DO IC=1,NCRIT
         JC=JCRIT(IC)
C
C        CAS DE REOUVERTURE
C        ------------------
         IF(JC.GE.10.AND.JC.LE.12) THEN
            KC=JC-9
            SIGMA(KC)=XZER
            W(KC)=BTR*MIN(WMAX(KC),WRUPT(KC))
C
C        CAS DE FERMETURE
C        ----------------
         ELSE IF(JC.GE.13.AND.JC.LE.15) THEN
            KC=JC-12
            SIGMA(KC)=XZER
            W(KC)=BTR*MIN(WMAX(KC),WRUPT(KC))
C
C        CAS DE RUPTURE
C        --------------
         ELSE IF(JC.GE.7.AND.JC.LE.9) THEN
            KC=JC-6
            SIGMA(KC)=XZER
            W(KC)=WRUPT(KC)
            WMAX(KC)=WRUPT(KC)
            SMAX(KC)=XZER
C
C        CAS DE FISSURATION
C        ------------------
         ELSE IF(JC.GE.1.AND.JC.LE.3) THEN
            IF(ISING(JC).EQ.2) THEN
               SIGMA(JC)=SMAX(JC)
               W(JC)=WMAX(JC)
            ENDIF
C
C        CAS DE POURSUITE DE LA FISSURATION
C        ----------------------------------
         ELSE IF(JC.GE.4.AND.JC.LE.6) THEN
            KC=JC-3
            SIGMA(KC)=SMAX(KC)
            W(KC)=WMAX(KC)
         ENDIF
      ENDDO
C**********
      ENDIF
C**********
C
C
C
      IF (NCA.NE.0) THEN
         DO IC=1,NCA
            JC=NN(IC)
C
C           FISSURATION AVEC ISING=2
C           ------------------------
            IF((JC.GE.1.AND.JC.LE.3).AND.ISING(JC).EQ.2) THEN
               SIGMA(JC)=SMAX(JC)
               W(JC)=WMAX(JC)
            ENDIF
C
         ENDDO
      ENDIF
C
C
C
      DO IC=1,NC
        NN0(IC)=IC
      ENDDO
C
      CALL UO2EC(NC,NC,NN0,SIGMA,W,WMAX,SMAX,BILIN,WRUPT,BTR,
     &     XLTR,XINVL,SBILI,FC,FC2,PENTE,PENTE2,LEBIL,ISING,
     &     PRECIE,PRECIZ,KERRE)
      IF(KERRE.NE.0) THEN
          PRINT *, ' UO2VE - APRES UO2EC KERRE=',KERRE
          RETURN
      ENDIF
C
      DO IC=1,NC
         IF(FC(IC).GT.PRECIZ.OR.FC2(IC).GT.PRECIZ) THEN
            PRINT *,'CRITERE DEPASSE NUMERO ',IC
            PRINT *,'CRITERE FC  = ',FC(IC)
            PRINT *,'CRITERE FC2 = ',FC2(IC)
            KERRE=989
            RETURN
         ENDIF
      ENDDO
C
C
      IF(IIMPI.EQ.42) THEN
        WRITE(IOIMP,78000) (FC(IC),IC=1,NC)
78000   FORMAT( 2X, ' UO2VE - FC '/(4(1X,1PE12.5)/)/)
      ENDIF
C
      RETURN
      END