Sources Esope | Cast3M

ottocr
C OTTOCR    SOURCE    AM        11/05/03    21:17:51     6955
C   responsable MILLARD
      SUBROUTINE OTTOCR(NCA,NN,SIGMA,W,WMAX,SMAX,BILIN,WRUPT,BTR,
     &    XLTR,XINVL,SBILI,FCRIT,PENTE,LEBIL,
     &    PRECIE,PRECIZ,XCOMP,XLAMC,KERRE)
C=========================================================================
C
C  ENTREES :
C    SIGMA,W,WMAX,SMAX,BILIN,WRUPT,BTR,XLTR,XINVL,SBILI
C    CETTE FOIS, LEBIL EST EN ENTREE
C
C  SORTIES :
C    FCRIT,PENTE
C
C==========================================================================
C
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)
 
-INC PPARAM
-INC CCOPTIO
C
      PARAMETER (XZER=0.D0,UNDEMI=.5D0,UN=1.D0,DEUX=2.D0,TROIS=3.D0)
      PARAMETER (NC=4)
C
      DIMENSION SIGMA(6),W(3),WMAX(3),BILIN(3),WREOUV(3),
     &          WRUPT(3),XLTR(3),XINVL(3),SBILI(3),FJ(3),XCOMP(*)
      DIMENSION FCRIT(*),NN(*),SMAX(*)
      DIMENSION LEBIL(*)
      DIMENSION PENTE(*)
*
      DIMENSION DFF(6),DGG(6)
 
C
C     INITIALISATIONS
C
      KERRE=0
      DO IC=1,NC
        FCRIT(IC)=-1.D4*PRECIZ
      ENDDO
*
      DO IC=1,NCA
         JC=NN(IC)
*
         GO TO (1,1,1,4),JC
*
         KERRE=99
         RETURN
*
  1      CONTINUE
*
         IF (XINVL(JC).NE.XZER) THEN
*
           WREOUV(JC) = BTR*MIN(WMAX(JC),WRUPT(JC))
           PRECIW=PRECIE/XINVL(JC)
 
      IF(IIMPI.EQ.42) THEN
            PRINT *,'  '
            PRINT *,'OTTOCR - JC     =',JC
            PRINT *,'OTTOCR - W      =',W(JC)
            PRINT *,'OTTOCR - WMAX   =',WMAX(JC)
            PRINT *,'OTTOCR - WREOUV =',WREOUV(JC)
            PRINT *,'OTTOCR - WRUPT  =',WRUPT(JC)
            PRINT *,'OTTOCR - SMAX   =',SMAX(JC)
            PRINT *,'OTTOCR - LEBIL  =',LEBIL(JC)
      ENDIF
 
*
*
*          cas ou le materiau n'est pas totalement casse
*          ---------------------------------------------
*
           IF(WMAX(JC).LT.WRUPT(JC)) THEN
 
             IF(ABS(W(JC)-WREOUV(JC)).LT.PRECIW) THEN
 
                IF(WMAX(JC).EQ.0.D0.OR.BTR.EQ.UN) THEN
*
*               le materiau vient d'atteindre la limite
*
                  CALL OTTOFU(XINVL,XLTR,WRUPT,BTR,BILIN,SBILI,W,
     &                      WMAX,SMAX,PENTE,JC)
                  FCRIT(JC)=SIGMA(JC)-SMAX(JC)
 
**************************************************
****     AM   AMELIORATION POUR BRUIT NUMERIQUE
**************************************************
 
                ELSE IF(WMAX(JC).NE.0.D0.AND.
     &                  ABS(W(JC)-WMAX(JC)).LT.PRECIW) THEN
*
*               on a deja atteint la limite, mais on a w = wmax tres petits
*               on reprend la sequence qui est plus loin dans le cas
*               ou  W > WREOUV
*
*                  CAS A L'INTERSECTION SECANTE - POST PIC
*
                   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)
 
                   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))
*
                   ELSE IF(LEBIL(JC).EQ.2) THEN
                      PRINT *,'OTTOCR CAS IMPOSSIBLE SELON ',JC
                      KERRE=7
                      RETURN
                   ENDIF
 
*************************************************************
****     AM          fin de l'amelioration
*************************************************************
 
                ELSE
 
*
*                  CAS A L'INTERSECTION SIGMA=0 - SECANTE
*
                   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
*
                   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))
*
                   ELSE IF(LEBIL(JC).EQ.2) THEN
                      PRINT *,'OTTOCR CAS IMPOSSIBLE SELON ',JC
                      KERRE=7
                      RETURN
                   ENDIF
                ENDIF
*
             ELSE IF(W(JC).GT.WREOUV(JC)) THEN
 
 
                IF(W(JC)-WMAX(JC).GT.PRECIW) THEN
 
                   PRINT *,' OTTOCR  -  W > WMAX  SELON ',JC
                   PRINT *,'W(JC) =',W(JC)
                   PRINT *,'WMAX(JC) =',WMAX(JC)
                   KERRE=7
                   RETURN
 
*
 
                ELSE IF(ABS(W(JC)-WMAX(JC)).LT.PRECIW) THEN
*
*                  CAS A L'INTERSECTION SECANTE - POST PIC
*
                   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)
 
                   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))
*
                   ELSE IF(LEBIL(JC).EQ.2) THEN
                      PRINT *,'OTTOCR CAS IMPOSSIBLE SELON ',JC
                      KERRE=7
                      RETURN
                   ENDIF
*
 
                ELSE IF(W(JC).LT.WMAX(JC)) THEN
 
                   PENTE(JC) = SMAX(JC)/(WMAX(JC)-WREOUV(JC))
                   FCRIT(JC)= SIGMA(JC) - PENTE(JC)*(W(JC)-WREOUV(JC))
 
                ENDIF
 
             ELSE IF(W(JC).LT.WREOUV(JC)) THEN
                PRINT *,' OTTOCR  -  W &lt; WREOUV SELON ',JC
                PRINT *,'W(JC) =',W(JC)
                PRINT *,'WREOUV(JC) =',WREOUV(JC)
                KERRE=7
                RETURN
             ENDIF
*
*          cas ou le materiau est totalement casse
*          ---------------------------------------
*
           ELSE IF(WMAX(JC).GE.WRUPT(JC)) THEN
 
             FCRIT(JC)=SIGMA(JC)
 
             IF(IIMPI.EQ.42) THEN
               PRINT *,'W(JC) =',W(JC)
               PRINT *,'WREOUV(JC) =',WREOUV(JC)
             ENDIF
*
             IF(ABS(W(JC)-WREOUV(JC)).LT.PRECIW) THEN
*
                IF(IIMPI.EQ.42) THEN
                    PRINT *,' OTTOCR - ON EST A LA LIMITE '
                ENDIF
*
                IF(FCRIT(JC).GE.-PRECIZ) THEN
                   PENTE(JC)=0.D0
                ENDIF
             ELSE IF(W(JC).GT.WREOUV(JC)) THEN
                PENTE(JC)=0.D0
             ENDIF
 
           ENDIF
 
         ENDIF
         GO TO 100
*
  4      CONTINUE
*
         CALL OTTOCP(SIGMA,FCR4,XLTR,DFF,DGG,H4,
     &               PRECIE,PRECIZ,XCOMP,XLAMC,KERRE)
 
 
         FCRIT(4) = FCR4
         GO TO 100
*
 100     CONTINUE
*
      ENDDO
*
      IF(IIMPI.EQ.42) THEN
        WRITE(IOIMP,77000) (FCRIT(IC),IC=1,4)
77000   FORMAT( 2X, ' OTTOCR - FCRIT '/(4(1X,1PE12.5)/)/)
        WRITE(IOIMP,77003) (PENTE(IC),IC=1,4)
77003   FORMAT( 2X, ' OTTOCR - PENTE '/(4(1X,1PE12.5)/)/)
      ENDIF
*
      RETURN
      END