Sources Esope | Cast3M

uo2et2
C UO2ET2    SOURCE    STRU      06/03/20    21:15:48     5340
      SUBROUTINE UO2ET2(NC,NN,SIGMA,W,WMAX,
     &       XLTR,XINVL,PRECIE,PRECIZ,FC,FC2,LEBIL,NFISSU,
     &       NVF,VF,FC0,PENTE,DXV1,YOUN,NCA,MC,MM,IFERM,KERRE)
C----------------------------------------------------------------------
C          MODELE UO2 (OTTOSEN ET GATT_MONERIE) SIMPLIFIE
C                  ENERGIE DE FISSURATION NULLE
C          DETERMINATION DE L ETAT INITIAL DE FISSURATION
C----------------------------------------------------------------------
C
C  ENTREES
C  -------
C NC           = (3) NBR. TOTAL DE DIRECTIONS DE FISS. POSSIBLES
C SIGMA(6)     = CONTRAINTES INITIALES
C W(3)         = OUVERTURES INITIALES DES FISSURES
C WMAX(3)      = OUVERTURES MAXIMALES INITIALES DES FISSURES
C                RELATION BILINEAIRE ENTRE CONTRAINTE ET OUVERTURE
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 NFISSU       = NOMBRE DE FISSURES
C NVF          = NBR DE DIRECTIONS IMPOSEES POUVANT DEVENIR
C                DES DIRECTIONS DE FISSURATION
C DXV1(3)      = INCREMENT DES DEF. DE FISSURATION INITIALES (OUV.)
C YOUN         = MODULE D YOUNG
C
C  SORTIES
C  -------
C NN(NC)       = NUMEROS DES DIRECTIONS DE FISS. OU UN CRIT. EST ATTEINT
C FC(NC)       = CRITERE DE FRACTURATION
C FC2(NC)      = CRITERE DE FISSURATION
C LEBIL(NC)    = COMPRESSION/TRACTION
C VF(3,3)      = VECTEURS DES DIRECTIONS DE FISSURATION
C FC0(20)      = CRIT. DE FISS. SUSCEPTIBLES D ETRE ATTEINTS
C PENTE(NC)    = PENTE DE LA DROITE DE FISSURATION CORRESPONDANT A FC
C NCA          = NBR. DE DIRECTIONS DE FISS. OU UN CRITERE EST ATTEINT
C MM(20)       = TYPES DES CRIT. DE FISS. SUSCEPTIBLES D ETRE ATTEINTS
C MC           = NBR. DE CRITERES DE FISS. SUSCEPTIBLES D ETRE ATTEINTS
C IFERM(NC)    = FISSURES FERMEES
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)
C
      DIMENSION SIGMA(*),W(*),WMAX(*),XLTR(*)
      DIMENSION XINVL(*),DXV1(*)
      DIMENSION NN(*),FC(*),FC2(*),LEBIL(*),VF(3,*),FC0(*)
      DIMENSION PENTE(*),MM(*)
      DIMENSION IFERM(*)
      DIMENSION WREOUV(3),JFIS(3)
C
      KERRE=0
      CALL IANUL(IFERM,NC)
C
      DO IC=1,NC
         NN(IC)=IC
      ENDDO
C
C ------ calcul de FC FC2 PENTE LEBIL ------
C ------    caracterisant l etat de fissuration    ------
C
      CALL UO2EC2(NC,NC,NN,SIGMA,W,WMAX,
     &     XLTR,XINVL,FC,FC2,PENTE,LEBIL,
     &     PRECIE,PRECIZ,KERRE)
      IF(KERRE.NE.0) THEN
          PRINT *, ' UO2ET2 - APRES UO2EC2 KERRE=',KERRE
          RETURN
      ENDIF
C
      NCA=0
      MC=0
C
C
      DO IC=1,3
C
         IF(FC2(IC).GT.PRECIZ) THEN
C            cas ou la limite de fissuration est violée
             KERRE=989
             PRINT *,' UO2ET2 - CRITERE FISSURATION VIOLE ',IC
             RETURN
         ENDIF
C
         IF(ABS(FC2(IC)).LE.PRECIZ) THEN
C            cas ou la limite de fissuration vient d'être atteinte
             IF(XINVL(IC).EQ.XZER) THEN
                 KERRE=989
                 PRINT *,' UO2ET2 - XINVL EST NUL  IC=  ',IC
                 RETURN
             ENDIF
C            la fissuration devient de la fracturation
             SIGMA(IC)=XZER
             FC(IC)=SIGMA(IC)
             FC2(IC)=-1.D4*PRECIZ
         ENDIF
C
         IF(FC(IC).GT.PRECIZ) THEN
             IF(XINVL(IC).EQ.XZER) THEN
C               on va vers la fissuration
                MC=MC+1
                MM(MC)= IC
             ELSE
C               cas ou la limite de fracturation est violée
                KERRE=989
                PRINT *,' UO2ET2 - CRITERE FRACTURATION VIOLE ',IC
                RETURN
             ENDIF
         ENDIF
C
C
         IF(FC(IC).LT.-PRECIZ) THEN
C
C        cas ou le critere de fracturation n'est pas atteint
C        ---------------------------------------------------
C
C --->       sous-cas 1 : la direction n'a pas encore fissure
C
             IF(XINVL(IC).EQ.XZER) THEN
C
C               on va vers la fissuration
                MC=MC+1
                MM(MC)= IC
C
             ELSE
C
C --->       sous-cas 2 : la direction a deja fissure
C
                IF(LEBIL(IC).EQ.0) THEN
C                   on est en compression - réouverture ?
                    MC=MC+1
                    MM(MC)= 3+IC
                ELSE
                    KERRE=989
                    PRINT *,' UO2ET2 - CAS IMPOSSIBLE ',IC
                    RETURN
                ENDIF
C
             ENDIF
C
         ELSE IF(ABS(FC(IC)).LE.PRECIZ) THEN
C
C        cas ou le critere de fracturation est atteint
C        ---------------------------------------------
C
             IF(XINVL(IC).EQ.XZER) THEN
                 KERRE=989
                 PRINT *,' UO2ET2 - XINVL EST NUL  IC=  ',IC
                 RETURN
             ENDIF
C
             PRECIW=PRECIE/XINVL(IC)
             NCA=NCA+1
             NN(NCA)=IC
C
C
             IF(W(IC).LT.-PRECIW) THEN
C
                 KERRE=989
                 PRINT *,' UO2ET2 -  W &lt; 0.  IC= ',IC
                 PRINT *,'W(IC)=',W(IC)
                 PRINT *,'WMAX(IC)=',WMAX(IC)
                 RETURN
C
             ELSE
C
C            on est en ouverture
C            ou bien on est pile sur la limite sigma=0
C            LEBIL vaut 1 dans les 2 cas
C
                 IF(LEBIL(IC).NE.1) THEN
                     KERRE=989
                     PRINT *,' UO2ET2 - LEBIL NEG 1 SELON ',IC
                     RETURN
                 ENDIF
C
                 IF(W(IC).GT.PRECIW) THEN
C                    fermeture ?
                     MC=MC+1
                     MM(MC)= 6+IC
                 ELSE
                     IFERM(IC)=1
                 ENDIF
C
             ENDIF
C
         ENDIF
C
      ENDDO
C
C
C
C     TEST SUR MC
C
      IF(MC.EQ.0) THEN
        KERRE=989
        PRINT *,' UO2ET2 - MC EST NUL '
        RETURN
      ENDIF
C
C    APPEL A UO2CE2
C
      CALL UO2CE2(MC,MM,SIGMA,DXV1,W,XLTR,XINVL,
     &      NFISSU,NVF,FC0,VF,YOUN,PRECIZ,JFIS,KERRE)
      IF(KERRE.NE.0) THEN
          PRINT *, ' UO2ET2 - APRES UO2CE KERRE=',KERRE
          RETURN
      ENDIF
C
C     TEST DE L'ETAT INITIAL
C
      DO IC=1,MC
         JC=MM(IC)
         IF(FC0(JC).GT.PRECIZ)THEN
            PRINT *,'UO2ET2 - ETAT INITIAL INADMISSIBLE'
            KERRE=989
            RETURN
         ENDIF
      ENDDO
C
      IF(IIMPI.EQ.42) THEN
        WRITE(IOIMP,77000) (FC(IC),IC=1,NC)
77000   FORMAT( 2X, ' UO2ET2 - FC '/(4(1X,1PE12.5)/)/)
        WRITE(IOIMP,77001) (LEBIL(IC),IC=1,NC)
77001   FORMAT( 2X, ' UO2ET2 - LEBIL '/(7I4)/)
        WRITE(IOIMP,77002) NCA,MC
77002   FORMAT( 2X, ' UO2ET2 - NCA=',I3,2X,'MC=',I3/)
        WRITE(IOIMP,77003) (NN(IC),IC=1,NCA)
77003   FORMAT( 2X, ' UO2ET2 - NN  '/16(1X,I3)/)
        WRITE(IOIMP,77004) (MM(IC),IC=1,MC)
77004   FORMAT( 2X, ' UO2ET2 - MM  '/16(1X,I3)/)
      ENDIF
C
      RETURN
      END