Esope source files

   1 : C OTTOCE    SOURCE    CHAT      05/01/13    02:07:11     5004           
   2 :       SUBROUTINE OTTOCE(MC,MM,SIGMA,DX,DXV1,W,WMAX,SMAX,
   3 :      &     WRUPT,XLTR,XINVL,BTR,NFISSU,NVF,FCRIT,VF,YOUN,
   4 :      &     PRECIZ,JRESU,XCOMP,XLAMC,DFF,DGG,KERRE)
   5 : C=========================================================================
   6 : C
   7 : C       1   NOUVELLE FISSURATION SELON LA DIRECTION 1
   8 : C       2   NOUVELLE FISSURATION SELON LA DIRECTION 2
   9 : C       3   NOUVELLE FISSURATION SELON LA DIRECTION 3
  10 : C       4   POURSUITE DE LA FISSURATION SELON LA DIRECTION 1
  11 : C       5   POURSUITE DE LA FISSURATION SELON LA DIRECTION 2
  12 : C       6   POURSUITE DE LA FISSURATION SELON LA DIRECTION 3
  13 : C       7   RUPTURE SELON LA DIRECTION 1
  14 : C       8   RUPTURE SELON LA DIRECTION 2
  15 : C       9   RUPTURE SELON LA DIRECTION 3
  16 : C      10   REOUVERTURE SELON LA DIRECTION 1
  17 : C      11   REOUVERTURE SELON LA DIRECTION 2
  18 : C      12   REOUVERTURE SELON LA DIRECTION 3
  19 : C      13   REFERMETURE SELON LA DIRECTION 1
  20 : C      14   REFERMETURE SELON LA DIRECTION 2
  21 : C      15   REFERMETURE SELON LA DIRECTION 3
  22 : C      16   COMPRESSION
  23 : C
  24 : C  ENTREES :
  25 : C    SIGMA,W,WMAX,SMAX,WRUPT,XLTR,XINVL,NFISSU,NVF
  26 : C
  27 : C
  28 : C  SORTIES :
  29 : C    FCRIT,VF
  30 : C
  31 : C==========================================================================
  32 : C
  33 :       IMPLICIT INTEGER(I-N)
  34 :       IMPLICIT REAL*8(A-H,O-Z)      
  35 : -INC CCOPTIO
  36 : C
  37 :       PARAMETER (XZER=0.D0)
  38 : C
  39 :       DIMENSION SIGMA(6),W(3),WMAX(3),WRUPT(3),XLTR(3),XINVL(3)
  40 :       DIMENSION FCRIT(*),MM(*),SMAX(*),DX(*),DXV1(*)
  41 :       DIMENSION FCF(3),VF(3,3),JRESU(3),XCOMP(*)
  42 :       DIMENSION DFF(*),DGG(*)
  43 : 
  44 : C
  45 : C     INITIALISATIONS
  46 : C
  47 :       KERRE=0
  48 :       DO IC=1,16
  49 :         FCRIT(IC)=-1.D4*PRECIZ
  50 :       ENDDO
  50 :       CALL IANUL(JRESU,3)
  51 : *
  52 : *
  53 :       LAPPEL=0
  54 :       DO IC=1,MC
  55 :          JC=MM(IC)
  56 :          IF(JC.GE.1.AND.JC.LE.3) THEN
  57 :             LAPPEL=1
  58 :             GO TO 200
  59 :          ENDIF
  60 :       ENDDO
  61 : *
  62 :  200  CONTINUE
  63 : *
  64 :       IF(XINVL(1)*XINVL(2)*XINVL(3).EQ.0.D0.AND.LAPPEL.EQ.1) THEN
  64 :           CALL OTTOFI(SIGMA,NFISSU,NVF,XLTR,XINVL,
  65 :      &                VF,JRESU,FCF,PRECIZ,KERRE)
  66 :           IF(KERRE.NE.0) RETURN
  67 :            IF(IIMPI.EQ.42) THEN
  68 :               WRITE(IOIMP,76600)
  69 : 76600         FORMAT(// 2X, ' OTTOCE - APRES OTTOFI '  /)
  70 :               WRITE(IOIMP,76601) (JRESU(IC),IC=1,3)
  71 : 76601         FORMAT(2X, ' JRESU ',2X,3I3/)
  72 :             ENDIF
  73 :       ENDIF
  74 : *
  75 : *
  76 :       DO IC=1,MC
  77 :          JC=MM(IC)
  78 : *
  79 :          GO TO (1,1,1,4,4,4,7,7,7,10,10,10,13,13,13,16),JC
  80 : *
  81 :          KERRE=99
  82 :          RETURN
  83 : *
  84 :  1       CONTINUE
  85 : *
  86 : *       nouvelle fissure selon une direction
  87 : *       ------------------------------------
  88 : *
  89 :            IF(JRESU(JC).NE.0) THEN
  90 :               FCRIT(JC)=FCF(JC)
  91 :            ENDIF
  92 :          GO TO 100
  93 : *
  94 :  4       CONTINUE
  95 :          KC=JC-3
  96 : *
  97 : *        poursuite de la fissuration selon la direction KC ( 1, 2 OU 3 )
  98 : *        ---------------------------------------------------------------
  99 : *
 100 :          FCRIT(JC)= SIGMA(KC) - SMAX(KC)
 101 :          GO TO 100
 102 : *
 103 :  7       CONTINUE
 104 :          KC=JC-6
 105 : *
 106 : *        rupture selon la direction KC ( 1, 2 OU 3 )
 107 : *        -------------------------------------------
 108 : *
 109 :          FCRIT(JC)= -SIGMA(KC)
 110 :          GO TO 100
 111 : *
 112 :  10      CONTINUE
 113 :          KC=JC-9
 114 : *
 115 : *        reouverture selon la direction KC ( 1, 2 OU 3 )
 116 : *        -----------------------------------------------
 117 : *
 118 :          FCRIT(JC)= SIGMA(KC)
 119 :          GO TO 100
 120 : *
 121 :  13      CONTINUE
 122 :          KC=JC-12
 123 : *
 124 : *        refermeture selon la direction KC ( 1, 2 OU 3 )
 125 : *        -----------------------------------------------
 126 : *
 127 :          WREOUV=BTR*MIN(WMAX(KC),WRUPT(KC))
 128 :          WAUX=W(KC)+DXV1(KC)/XINVL(KC)
 129 :          FCRIT(JC)=YOUN*(WREOUV-WAUX)*XINVL(KC)
 130 :          GO TO 100
 131 : *
 132 :  16      CONTINUE
 133 : *
 134 : *        compression
 135 : *        -----------
 136 : *
 137 :          PRECIE=1.D-10
 137 :          CALL OTTOCP(SIGMA,FCR4,XLTR,DFF,DGG,H4,
 138 :      &                PRECIE,PRECIZ,XCOMP,XLAMC,KERRE)
 139 : 
 140 : 
 141 :          FCRIT(JC) = FCR4
 142 :          GO TO 100
 143 : *
 144 :  100     CONTINUE
 145 : *
 146 :       ENDDO
 147 : *
 148 : *     IF(IIMPI.EQ.42) THEN
 149 : *       WRITE(IOIMP,77000)
 150 : *77000   FORMAT(// 2X, ' EN SORTIE DE OTTOCE ' /)
 151 : *       DO IC=1,MC
 152 : *         JC=MM(IC)
 153 : *         WRITE(IOIMP,77001) IC,JC,FCRIT(JC)
 154 : *77001     FORMAT( 2X, ' OTTOCE - IC=',I3,2X,'JC=',I3,2X,
 155 : *    &      'FCRIT=',1PE12.5/)
 156 : *       ENDDO
 157 : *     ENDIF
 158 : *
 159 :       RETURN
 160 :       END
 161 :  
 162 :  
 163 :  
 164 :  
 165 :  
 166 :  
 167 :