Esope source files

   1 : C OTTOVE    SOURCE    CHAT      05/01/13    02:07:58     5004           
   2 :       SUBROUTINE OTTOVE(NCRIT,JCRIT,SIGMA,W,WMAX,WRUPT,SMAX,
   3 :      &       BTR,XLTR,XINVL,BILIN,SBILI,PRECIE,PRECIZ,DEFPLA,
   4 :      &       NN,NC,NCA,FC,FC2,PENTE,PENTE2,LEBIL,ISING,
   5 :      &       XCOMP,XLAMC,KERRE)
   6 : C
   7 :       IMPLICIT INTEGER(I-N)
   8 :       IMPLICIT REAL*8(A-H,O-Z)      
   9 : -INC CCOPTIO
  10 : C
  11 :       PARAMETER (XZER=0.D0)
  12 :       PARAMETER (UNDEMI=.5D0,UN=1.D0,DEUX=2.D0,TROIS=3.D0)
  13 : C
  14 :       DIMENSION SIGMA(*),W(*),WMAX(*),BILIN(*),
  15 :      &          WRUPT(*),XLTR(*),XINVL(*),SBILI(*)
  16 :       DIMENSION PENTE(*),PENTE2(*),XCOMP(*)
  17 :       DIMENSION FC(*),FC2(*),NN(*),LEBIL(*),SMAX(*)
  18 :       DIMENSION DEFPLA(*),ISING(*)
  19 :       DIMENSION JCRIT(*)
  20 :       DIMENSION ZOB(3)
  21 : *
  22 :       KERRE=0
  23 : *
  24 : *
  25 :       DO I=1,3
  26 :          IF(ABS(WMAX(I)-WRUPT(I)).LT.WRUPT(I)*PRECIE) THEN
  27 :              IF(W(I).EQ.WMAX(I)) THEN
  28 :                 W(I)=WRUPT(I)
  29 :              ENDIF
  30 :              WMAX(I)=WRUPT(I)
  31 :              SMAX(I)=0.D0
  32 :          ENDIF
  33 :       ENDDO
  34 : *
  35 : *   PURGE
  36 : *
  37 :       DO I=1,6
  38 :         IF(ABS(DEFPLA(I)).LT.PRECIE*1.D-2) DEFPLA(I)=0.D0
  39 :       ENDDO
  40 : *
  41 : *
  42 :       DO IC=1,NCRIT
  43 :          JC=JCRIT(IC)
  44 : *
  45 : *        CAS DE REOUVERTURE
  46 : *
  47 :          IF(JC.GE.10.AND.JC.LE.12) THEN
  48 :             KC=JC-9
  49 :             SIGMA(KC)=0.D0
  50 :             W(KC)=BTR*MIN(WMAX(KC),WRUPT(KC))
  51 : *
  52 : *        CAS DE REFERMETURE
  53 : *
  54 :          ELSE IF(JC.GE.13.AND.JC.LE.15) THEN
  55 :             KC=JC-12
  56 :             SIGMA(KC)=0.D0
  57 :             W(KC)=BTR*MIN(WMAX(KC),WRUPT(KC))
  58 : *
  59 : *        CAS DE RUPTURE
  60 : *
  61 :          ELSE IF(JC.GE.7.AND.JC.LE.9) THEN
  62 :             KC=JC-6
  63 :             SIGMA(KC)=0.D0
  64 :             W(KC)=WRUPT(KC)
  65 :             WMAX(KC)=WRUPT(KC)
  66 :             SMAX(KC)=0.D0
  67 : *
  68 : *        CAS DE FISSURATION
  69 : *
  70 :          ELSE IF(JC.GE.1.AND.JC.LE.3) THEN
  71 :             IF(ISING(JC).EQ.2) THEN
  72 :                SIGMA(JC)=SMAX(JC)
  73 :                W(JC)=WMAX(JC)
  74 :             ENDIF
  75 : *
  76 : *        CAS DE POURSUITE DE LA FISSURATION
  77 : *
  78 :          ELSE IF(JC.GE.4.AND.JC.LE.6) THEN
  79 :             KC=JC-3
  80 :             SIGMA(KC)=SMAX(KC)
  81 :             W(KC)=WMAX(KC)
  82 :          ENDIF
  83 :       ENDDO
  84 : *
  85 : *
  86 :       DO IC=1,NCA
  87 :          JC=NN(IC)
  88 : *
  89 : *        FISSURATION AVEC ISING=2
  90 : *
  91 :          IF((JC.GE.1.AND.JC.LE.3).AND.ISING(JC).EQ.2) THEN
  92 :             SIGMA(JC)=SMAX(JC)
  93 :             W(JC)=WMAX(JC)
  94 :          ENDIF
  95 : 
  96 :       ENDDO
  97 : *
  98 : *
  99 :       DO IC=1,NC
 100 :         NN(IC)=IC
 101 :       ENDDO
 102 : *
 102 :       CALL OTTOEC(NC,NN,SIGMA,W,WMAX,SMAX,BILIN,WRUPT,BTR,
 103 :      &     XLTR,XINVL,SBILI,FC,FC2,PENTE,PENTE2,LEBIL,ISING,
 104 :      &     PRECIE,PRECIZ,XCOMP,XLAMC,KERRE)
 105 :       IF(KERRE.NE.0) THEN
 106 :           PRINT *, ' OTTOVE - APRES OTTOEC KERRE=',KERRE
 107 :           RETURN
 108 :       ENDIF
 109 : *
 110 :       DO IC=1,NC
 111 :          IF(FC(IC).GT.PRECIZ.OR.FC2(IC).GT.PRECIZ) THEN
 112 :             PRINT *,'CRITERE DEPASSE NUMERO ',IC
 113 :             PRINT *,'CRITERE FC  = ',FC(IC)
 114 :             PRINT *,'CRITERE FC2 = ',FC2(IC)
 115 :             KERRE=2
 116 :             RETURN
 117 :          ENDIF
 118 :       ENDDO
 119 : *
 120 :       IF(IIMPI.EQ.42) THEN
 121 :         WRITE(IOIMP,78000) (FC(IC),IC=1,NC)
 122 : 78000   FORMAT( 2X, ' OTTOVE - FC '/(4(1X,1PE12.5)/)/)
 123 :       ENDIF
 124 : *
 125 :       RETURN
 126 :       END
 127 :  
 128 :  
 129 :  
 130 :  
 131 :  
 132 :  
 133 :