Sources Esope | Cast3M

ottove
C OTTOVE    SOURCE    CHAT      05/01/13    02:07:58     5004
      SUBROUTINE OTTOVE(NCRIT,JCRIT,SIGMA,W,WMAX,WRUPT,SMAX,
     &       BTR,XLTR,XINVL,BILIN,SBILI,PRECIE,PRECIZ,DEFPLA,
     &       NN,NC,NCA,FC,FC2,PENTE,PENTE2,LEBIL,ISING,
     &       XCOMP,XLAMC,KERRE)
C
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)
 
-INC PPARAM
-INC CCOPTIO
C
      PARAMETER (XZER=0.D0)
      PARAMETER (UNDEMI=.5D0,UN=1.D0,DEUX=2.D0,TROIS=3.D0)
C
      DIMENSION SIGMA(*),W(*),WMAX(*),BILIN(*),
     &          WRUPT(*),XLTR(*),XINVL(*),SBILI(*)
      DIMENSION PENTE(*),PENTE2(*),XCOMP(*)
      DIMENSION FC(*),FC2(*),NN(*),LEBIL(*),SMAX(*)
      DIMENSION DEFPLA(*),ISING(*)
      DIMENSION JCRIT(*)
      DIMENSION ZOB(3)
*
      KERRE=0
*
*
      DO I=1,3
         IF(ABS(WMAX(I)-WRUPT(I)).LT.WRUPT(I)*PRECIE) THEN
             IF(W(I).EQ.WMAX(I)) THEN
                W(I)=WRUPT(I)
             ENDIF
             WMAX(I)=WRUPT(I)
             SMAX(I)=0.D0
         ENDIF
      ENDDO
*
*   PURGE
*
      DO I=1,6
        IF(ABS(DEFPLA(I)).LT.PRECIE*1.D-2) DEFPLA(I)=0.D0
      ENDDO
*
*
      DO IC=1,NCRIT
         JC=JCRIT(IC)
*
*        CAS DE REOUVERTURE
*
         IF(JC.GE.10.AND.JC.LE.12) THEN
            KC=JC-9
            SIGMA(KC)=0.D0
            W(KC)=BTR*MIN(WMAX(KC),WRUPT(KC))
*
*        CAS DE REFERMETURE
*
         ELSE IF(JC.GE.13.AND.JC.LE.15) THEN
            KC=JC-12
            SIGMA(KC)=0.D0
            W(KC)=BTR*MIN(WMAX(KC),WRUPT(KC))
*
*        CAS DE RUPTURE
*
         ELSE IF(JC.GE.7.AND.JC.LE.9) THEN
            KC=JC-6
            SIGMA(KC)=0.D0
            W(KC)=WRUPT(KC)
            WMAX(KC)=WRUPT(KC)
            SMAX(KC)=0.D0
*
*        CAS DE FISSURATION
*
         ELSE IF(JC.GE.1.AND.JC.LE.3) THEN
            IF(ISING(JC).EQ.2) THEN
               SIGMA(JC)=SMAX(JC)
               W(JC)=WMAX(JC)
            ENDIF
*
*        CAS DE POURSUITE DE LA FISSURATION
*
         ELSE IF(JC.GE.4.AND.JC.LE.6) THEN
            KC=JC-3
            SIGMA(KC)=SMAX(KC)
            W(KC)=WMAX(KC)
         ENDIF
      ENDDO
*
*
      DO IC=1,NCA
         JC=NN(IC)
*
*        FISSURATION AVEC ISING=2
*
         IF((JC.GE.1.AND.JC.LE.3).AND.ISING(JC).EQ.2) THEN
            SIGMA(JC)=SMAX(JC)
            W(JC)=WMAX(JC)
         ENDIF
 
      ENDDO
*
*
      DO IC=1,NC
        NN(IC)=IC
      ENDDO
*
      CALL OTTOEC(NC,NN,SIGMA,W,WMAX,SMAX,BILIN,WRUPT,BTR,
     &     XLTR,XINVL,SBILI,FC,FC2,PENTE,PENTE2,LEBIL,ISING,
     &     PRECIE,PRECIZ,XCOMP,XLAMC,KERRE)
      IF(KERRE.NE.0) THEN
          PRINT *, ' OTTOVE - APRES OTTOEC KERRE=',KERRE
          RETURN
      ENDIF
*
      DO IC=1,NC
         IF(FC(IC).GT.PRECIZ.OR.FC2(IC).GT.PRECIZ) THEN
            PRINT *,'CRITERE DEPASSE NUMERO ',IC
            PRINT *,'CRITERE FC  = ',FC(IC)
            PRINT *,'CRITERE FC2 = ',FC2(IC)
            KERRE=2
            RETURN
         ENDIF
      ENDDO
*
      IF(IIMPI.EQ.42) THEN
        WRITE(IOIMP,78000) (FC(IC),IC=1,NC)
78000   FORMAT( 2X, ' OTTOVE - FC '/(4(1X,1PE12.5)/)/)
      ENDIF
*
      RETURN
      END