Télécharger uo2et.eso

Retour à la liste

uo2et
C UO2ET     SOURCE    STRU      05/12/12    21:15:01     5272
      SUBROUTINE UO2ET(NC,NN,SIGMA,W,WMAX,SMAX,BILIN,WRUPT,BTR,
     &       XLTR,XINVL,SBILI,PRECIE,PRECIZ,FC,FC2,LEBIL,NFISSU,
     &       NVF,VF,FC0,PENTE,PENTE2,DXV1,YOUN,NCA,MC,MM,
     &       ISING,IFERM,IBRUP,KERRE)
C----------------------------------------------------------------------
C                MODELE UO2 (OTTOSEN ET GATT_MONERIE)
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 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 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 FISSURATION
C FC2(NC)      = DEUXIEME CRITERE DE FISSURATION SI BIFURCATION POSSIBLE
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 PENTE2(NC)   = PENTE DE LA DROITE DE FISSURATION CORRESPONDANT A FC2
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 ISING(NC)    = SINGULARITES CORRESPONDANT A UNE BIFURCATION
C IFERM(NC)    = FISSURES FERMEES
C IBRUP(NC)    = FISSURES ROMPUES
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(*),SMAX(*),BILIN(*),WRUPT(*),XLTR(*)
      DIMENSION XINVL(*),SBILI(*),DXV1(*)
      DIMENSION NN(*),FC(*),FC2(*),LEBIL(*),VF(3,*),FC0(*)
      DIMENSION PENTE(*),PENTE2(*),MM(*)
      DIMENSION ISING(*),IFERM(*),IBRUP(*)
      DIMENSION WREOUV(3),JFIS(3)
C
      KERRE=0
      CALL IANUL(ISING,NC)
      CALL IANUL(IFERM,NC)
      CALL IANUL(IBRUP,NC)
C
      DO IC=1,NC
         NN(IC)=IC
      ENDDO
C
C ------ calcul de FC FC2 PENTE PENTE2 LEBIL ISING ------
C ------    caracterisant l etat de fissuration    ------
C
      CALL UO2EC(NC,NC,NN,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 *, ' UO2ET - APRES UO2EC KERRE=',KERRE
          RETURN
      ENDIF
C
      NCA=0
      MC=0
C
C
      DO IC=1,3
         WREOUV(IC)=BTR*MIN(WMAX(IC),WRUPT(IC))
C
         IF(FC(IC).GT.PRECIZ.OR.FC2(IC).GT.PRECIZ) THEN
C            cas ou le critere est violé
             KERRE=2
             PRINT *,' UO2ET - CRITERE VIOLE ',IC
             RETURN
         ENDIF
C
C        cas ou le critere n'est pas atteint
C        -----------------------------------
C
         IF(FC(IC).LT.-PRECIZ.AND.FC2(IC).LT.-PRECIZ) THEN
C
C --->       sous-cas 1 : la direction n'a pas encore fissure
C
             IF(XINVL(IC).EQ.XZER) THEN
                MC=MC+1
                MM(MC)= IC
             ELSE
C
C --->       sous-cas 2 : la direction a deja fissure
C
                IF(LEBIL(IC).EQ.0) THEN
C                   on est en compression
                    IF(BTR.LT.1.D0.AND.WMAX(IC).NE.XZER) THEN
                       MC=MC+1
                       MM(MC)= 9+IC
                    ELSE
                       MC=MC+1
                       MM(MC)= 3+IC
                    ENDIF
                ELSE
                    KERRE=2
                    PRINT *,' UO2ET - CAS IMPOSSIBLE ',IC
                    RETURN
                ENDIF
C
             ENDIF
C
         ELSE
C
C        cas ou le critere est atteint
C        -----------------------------
C
             IF(XINVL(IC).EQ.XZER) THEN
                 KERRE=2
                 PRINT *,' UO2ET - XINVL EST NUL  IC=  ',IC
                 RETURN
             ENDIF
C
             PRECIW=PRECIE/XINVL(IC)
             NCA=NCA+1
             NN(NCA)=IC
C
C --->       sous-cas 1 : le materiau n est pas totalement casse
C            ---------------------------------------------------
C
             IF(WMAX(IC).LT.WRUPT(IC)) THEN
C
                IF(ABS(W(IC)-WREOUV(IC)).LT.PRECIW) THEN
C
                    IF(WMAX(IC).EQ.0.D0.OR.BTR.EQ.1.D0) THEN
C
C                      le materiau vient d'atteindre la limite
C
                       MC=MC+1
                       MM(MC)= 6+IC
                       IBRUP(IC)=1
C
                    ELSE
C
C                      on est pile sur le critere sigma=0  (==> IFERM=1)
C                      et  LEBIL vaut 1
C
                       IF(LEBIL(IC).NE.1) THEN
                          KERRE=2
                          PRINT *,' UO2ET - LEBIL NEG 1 SELON ',IC
                          RETURN
                       ENDIF
C
                       MC=MC+1
                       MM(MC)= 3+IC
                       IFERM(IC)=1
                    ENDIF
C
                ELSE IF(W(IC).GT.WREOUV(IC)) THEN
C
                  IF(ABS(W(IC)-WMAX(IC)).LT.PRECIW) THEN
C
C                    LEBIL vaut 2
C
                     IF(LEBIL(IC).NE.2) THEN
                        KERRE=2
                        PRINT *,' UO2ET - LEBIL NEG 2 SELON ',IC
                        RETURN
                     ENDIF
C
C                    d abord les 2
C
                     IF(FC(IC).GT.-PRECIZ.AND.FC2(IC).GT.-PRECIZ) THEN
C
                        MC=MC+1
                        MM(MC)= 6+IC
                        MC=MC+1
                        MM(MC)= 12+IC
C
C                    sinon seul le secant
C
                     ELSE IF(FC(IC).LT.-PRECIZ.AND.
     &                  FC2(IC).GT.-PRECIZ) THEN
C
C                       on remet lebil a 1
C
                        LEBIL(IC)=1
                        FC(IC)=FC2(IC)
                        PENTE(IC)=PENTE2(IC)
                        MC=MC+1
                        MM(MC)= 3+IC
                        MC=MC+1
                        MM(MC)= 12+IC
C
                     ELSE
                        KERRE=2
                        PRINT *,' UO2ET - CAS PAS POSSIBLE SELON ',IC
                        RETURN
                     ENDIF
C
C
                  ELSE
C
C                    on est sur le secant et  LEBIL vaut 1
C
                     IF(LEBIL(IC).NE.1) THEN
                        KERRE=2
                        PRINT *,' UO2ET - LEBIL NEG 1 SELON ',IC
                        RETURN
                     ENDIF
C
                     MC=MC+1
                     MM(MC)= 3+IC
                     MC=MC+1
                     MM(MC)= 12+IC
                  ENDIF
C
                ELSE
C
C                 W < WREOUV  :  CAS IMPOSSIBLE
C
                  KERRE=2
                  PRINT *,' UO2ET -  W < WREOUV  IC= ',IC
                  PRINT *,'W(IC)=',W(IC)
                  PRINT *,'WMAX(IC)=',WMAX(IC)
                  PRINT *,'WREOUV(IC)=',WREOUV(IC)
                  PRINT *,'WRUPT(IC)=',WRUPT(IC)
 
 
                  RETURN
                ENDIF
C
C --->       sous-cas 2 : le materiau est totalement casse
C            ---------------------------------------------
C
             ELSE IF(WMAX(IC).GE.WRUPT(IC)) THEN
C
C
                   IF(W(IC)-WREOUV(IC).LT.-PRECIW) THEN
C
                     KERRE=2
                     PRINT *,' UO2ET -  W < WREOUV  IC= ',IC
                     PRINT *,'W(IC)=',W(IC)
                     PRINT *,'WMAX(IC)=',WMAX(IC)
                     PRINT *,'WREOUV(IC)=',WREOUV(IC)
                     PRINT *,'WRUPT(IC)=',WRUPT(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=2
                         PRINT *,' UO2ET - LEBIL NEG 1 SELON ',IC
                         RETURN
                      ENDIF
C
                      IF(W(IC)-WREOUV(IC).GT.PRECIW) THEN
                         MC=MC+1
                         MM(MC)= 12+IC
                      ELSE
                         IFERM(IC)=1
                      ENDIF
C
                   ENDIF
             ENDIF
C
         ENDIF
C
      ENDDO
C
C
C
C     TEST SUR MC
C
      IF(MC.EQ.0) THEN
        KERRE=2
        PRINT *,' UO2ET - MC EST NUL '
        RETURN
      ENDIF
C
C    APPEL A UO2CE
C
      CALL UO2CE(MC,MM,SIGMA,DXV1,W,WMAX,SMAX,WRUPT,XLTR,XINVL,BTR,
     &      NFISSU,NVF,FC0,VF,YOUN,PRECIZ,JFIS,KERRE)
      IF(KERRE.NE.0) THEN
          PRINT *, ' UO2ET - 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 *,'UO2ET - ETAT INITIAL INADMISSIBLE'
            KERRE=2
            RETURN
         ENDIF
      ENDDO
C
      IF(IIMPI.EQ.42) THEN
        WRITE(IOIMP,77000) (FC(IC),IC=1,NC)
77000   FORMAT( 2X, ' UO2ET - FC '/(4(1X,1PE12.5)/)/)
        WRITE(IOIMP,77001) (LEBIL(IC),IC=1,NC)
77001   FORMAT( 2X, ' UO2ET - LEBIL '/(7I4)/)
        WRITE(IOIMP,77002) NCA,MC
77002   FORMAT( 2X, ' UO2ET - NCA=',I3,2X,'MC=',I3/)
        WRITE(IOIMP,77003) (NN(IC),IC=1,NCA)
77003   FORMAT( 2X, ' UO2ET - NN  '/16(1X,I3)/)
        WRITE(IOIMP,77004) (MM(IC),IC=1,MC)
77004   FORMAT( 2X, ' UO2ET - MM  '/16(1X,I3)/)
      ENDIF
C
      RETURN
      END
 
 
 
 

© Cast3M 2003 - Tous droits réservés.
Mentions légales