Sources Esope | Cast3M

ottoce
C OTTOCE    SOURCE    CHAT      05/01/13    02:07:11     5004
      SUBROUTINE OTTOCE(MC,MM,SIGMA,DX,DXV1,W,WMAX,SMAX,
     &     WRUPT,XLTR,XINVL,BTR,NFISSU,NVF,FCRIT,VF,YOUN,
     &     PRECIZ,JRESU,XCOMP,XLAMC,DFF,DGG,KERRE)
C=========================================================================
C
C       1   NOUVELLE FISSURATION SELON LA DIRECTION 1
C       2   NOUVELLE FISSURATION SELON LA DIRECTION 2
C       3   NOUVELLE FISSURATION SELON LA DIRECTION 3
C       4   POURSUITE DE LA FISSURATION SELON LA DIRECTION 1
C       5   POURSUITE DE LA FISSURATION SELON LA DIRECTION 2
C       6   POURSUITE DE LA FISSURATION SELON LA DIRECTION 3
C       7   RUPTURE SELON LA DIRECTION 1
C       8   RUPTURE SELON LA DIRECTION 2
C       9   RUPTURE SELON LA DIRECTION 3
C      10   REOUVERTURE SELON LA DIRECTION 1
C      11   REOUVERTURE SELON LA DIRECTION 2
C      12   REOUVERTURE SELON LA DIRECTION 3
C      13   REFERMETURE SELON LA DIRECTION 1
C      14   REFERMETURE SELON LA DIRECTION 2
C      15   REFERMETURE SELON LA DIRECTION 3
C      16   COMPRESSION
C
C  ENTREES :
C    SIGMA,W,WMAX,SMAX,WRUPT,XLTR,XINVL,NFISSU,NVF
C
C
C  SORTIES :
C    FCRIT,VF
C
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(6),W(3),WMAX(3),WRUPT(3),XLTR(3),XINVL(3)
      DIMENSION FCRIT(*),MM(*),SMAX(*),DX(*),DXV1(*)
      DIMENSION FCF(3),VF(3,3),JRESU(3),XCOMP(*)
      DIMENSION DFF(*),DGG(*)
 
C
C     INITIALISATIONS
C
      KERRE=0
      DO IC=1,16
        FCRIT(IC)=-1.D4*PRECIZ
      ENDDO
      CALL IANUL(JRESU,3)
*
*
      LAPPEL=0
      DO IC=1,MC
         JC=MM(IC)
         IF(JC.GE.1.AND.JC.LE.3) THEN
            LAPPEL=1
            GO TO 200
         ENDIF
      ENDDO
*
 200  CONTINUE
*
      IF(XINVL(1)*XINVL(2)*XINVL(3).EQ.0.D0.AND.LAPPEL.EQ.1) THEN
          CALL OTTOFI(SIGMA,NFISSU,NVF,XLTR,XINVL,
     &                VF,JRESU,FCF,PRECIZ,KERRE)
          IF(KERRE.NE.0) RETURN
           IF(IIMPI.EQ.42) THEN
              WRITE(IOIMP,76600)
76600         FORMAT(// 2X, ' OTTOCE - APRES OTTOFI '  /)
              WRITE(IOIMP,76601) (JRESU(IC),IC=1,3)
76601         FORMAT(2X, ' JRESU ',2X,3I3/)
            ENDIF
      ENDIF
*
*
      DO IC=1,MC
         JC=MM(IC)
*
         GO TO (1,1,1,4,4,4,7,7,7,10,10,10,13,13,13,16),JC
*
         KERRE=99
         RETURN
*
 1       CONTINUE
*
*       nouvelle fissure selon une direction
*       ------------------------------------
*
           IF(JRESU(JC).NE.0) THEN
              FCRIT(JC)=FCF(JC)
           ENDIF
         GO TO 100
*
 4       CONTINUE
         KC=JC-3
*
*        poursuite de la fissuration selon la direction KC ( 1, 2 OU 3 )
*        ---------------------------------------------------------------
*
         FCRIT(JC)= SIGMA(KC) - SMAX(KC)
         GO TO 100
*
 7       CONTINUE
         KC=JC-6
*
*        rupture selon la direction KC ( 1, 2 OU 3 )
*        -------------------------------------------
*
         FCRIT(JC)= -SIGMA(KC)
         GO TO 100
*
 10      CONTINUE
         KC=JC-9
*
*        reouverture selon la direction KC ( 1, 2 OU 3 )
*        -----------------------------------------------
*
         FCRIT(JC)= SIGMA(KC)
         GO TO 100
*
 13      CONTINUE
         KC=JC-12
*
*        refermeture selon la direction KC ( 1, 2 OU 3 )
*        -----------------------------------------------
*
         WREOUV=BTR*MIN(WMAX(KC),WRUPT(KC))
         WAUX=W(KC)+DXV1(KC)/XINVL(KC)
         FCRIT(JC)=YOUN*(WREOUV-WAUX)*XINVL(KC)
         GO TO 100
*
 16      CONTINUE
*
*        compression
*        -----------
*
         PRECIE=1.D-10
         CALL OTTOCP(SIGMA,FCR4,XLTR,DFF,DGG,H4,
     &                PRECIE,PRECIZ,XCOMP,XLAMC,KERRE)
 
 
         FCRIT(JC) = FCR4
         GO TO 100
*
 100     CONTINUE
*
      ENDDO
*
*     IF(IIMPI.EQ.42) THEN
*       WRITE(IOIMP,77000)
*77000   FORMAT(// 2X, ' EN SORTIE DE OTTOCE ' /)
*       DO IC=1,MC
*         JC=MM(IC)
*         WRITE(IOIMP,77001) IC,JC,FCRIT(JC)
*77001     FORMAT( 2X, ' OTTOCE - IC=',I3,2X,'JC=',I3,2X,
*    &      'FCRIT=',1PE12.5/)
*       ENDDO
*     ENDIF
*
      RETURN
      END