Sources Esope | Cast3M

uo2ve2
C UO2VE2    SOURCE    STRU      06/03/20    21:16:10     5340
      SUBROUTINE UO2VE2(NCRIT,JCRIT,SIGMA,W,WMAX,
     &                  XLTR,XINVL,PRECIE,PRECIZ,NN,
     &                  NN0,NC,NCA,FC,FC2,PENTE,LEBIL,KERRE)
C----------------------------------------------------------------------
C       ECOULEMENT MODELE UO2 (OTTOSEN ET GATT_MONERIE) SIMPLIFIE
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 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 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 LEBIL(NC)    = COMPRESSION/TRACTION
C
C  REMARQUE
C  --------
C NN0(NC)      = TABLEAU DE TRAVAIL CONTENAT TOUTES LES DIRECTIONS
C                DE FISS. SOIT 1 2 ET 3
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(*),XLTR(*),
     &          XINVL(*),NN(*),NN0(*),LEBIL(*)
      DIMENSION FC(*),FC2(*),PENTE(*)
C
      KERRE=0
C
C
      DO I=1,3
         IF (XINVL(I).NE.XZER) THEN
            PRECIW=PRECIE/XINVL(I)
            IF(ABS(WMAX(I)).LT.PRECIW) THEN
                IF(W(I).EQ.WMAX(I)) W(I)=XZER
                WMAX(I)=XZER
            ENDIF
         ENDIF
      ENDDO
C
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.4.AND.JC.LE.6) THEN
            KC=JC-3
            SIGMA(KC)=XZER
            W(KC)=XZER
C
C        CAS DE FERMETURE
C        ----------------
         ELSE IF(JC.GE.7.AND.JC.LE.9) THEN
            KC=JC-6
            SIGMA(KC)=XZER
            W(KC)=XZER
         ENDIF
      ENDDO
C**********
      ENDIF
C**********
C
C
C
C
      DO IC=1,NC
        NN0(IC)=IC
      ENDDO
C
      CALL UO2EC2(NC,NC,NN0,SIGMA,W,WMAX,
     &     XLTR,XINVL,FC,FC2,PENTE,LEBIL,
     &     PRECIE,PRECIZ,KERRE)
      IF(KERRE.NE.0) THEN
          PRINT *, ' UO2VE2 - APRES UO2EC2 KERRE=',KERRE
          RETURN
      ENDIF
C
      DO IC=1,NC
         IF(FC2(IC).GT.PRECIZ) THEN
             PRINT *,' UO2EV2 - CRITERE FISSURATION VIOLE ',IC
             PRINT *,' UO2EV2 - CRITERE FC2 = ',FC2(IC)
             KERRE=989
             RETURN
         ENDIF
         IF( (FC2(IC).LT.-PRECIZ).AND.(FC(IC).GT.PRECIZ) ) THEN
             PRINT *,' UO2EV2 - CRITERE FRACTURATION VIOLE ',IC
             PRINT *,' UO2EV2 - CRITERE FC = ',FC(IC)
             KERRE=989
             RETURN
         ENDIF
      ENDDO
C
C
      IF(IIMPI.EQ.42) THEN
        WRITE(IOIMP,78000) (FC(IC),IC=1,NC)
78000   FORMAT( 2X, ' UO2VE2 - FC '/(4(1X,1PE12.5)/)/)
        WRITE(IOIMP,78001) (FC2(IC),IC=1,NC)
78001   FORMAT( 2X, ' UO2VE2 - FC2 '/(4(1X,1PE12.5)/)/)
      ENDIF
C
      RETURN
      END