Télécharger la plaquette Cast3M


fr en

Télécharger ottofi.eso

Retour à la liste

Numérotation des lignes : 

ottofi

  1. C OTTOFI    SOURCE    CHAT      05/01/13    02:07:32     5004
  2.       SUBROUTINE OTTOFI(SIGMA,NFISSU,NVF,XLTR,XINVL,
  3.      &                  VF,JRESU,FC,PRECIZ,KERRE)
  4. *
  5. C==========================================================================
  6. C
  7. C  ENTREES :
  8. C    SIGMA,NFISSU,NVF,XLTR,XINVL
  9. C
  10. C  SORTIES :
  11. C    FC    CRITERES
  12. C    JRESU,VF  (JRESU = 1 POUR LES DIRECTIONS POTENTIELLES DE
  13. C               FISSURATION  DONT LA DIRECTION EST CONNUE
  14. C               JRESU = 2 POUR LES DIRECTIONS POTENTIELLES DE
  15. C               FISSURATION DONT LA DIRECTION EST INCONNUE EN PLAN
  16. C               JRESU = 3 POUR LES DIRECTIONS POTENTIELLES DE
  17. C               FISSURATION DONT LA DIRECTION EST INCONNUE EN 3D
  18. C                          VF CONTIENT LES VECTEURS CORRESPONDANTS)
  19. C==========================================================================
  20. C
  21.       IMPLICIT INTEGER(I-N)
  22.       IMPLICIT REAL*8(A-H,O-Z)
  23.  
  24. -INC PPARAM
  25. -INC CCOPTIO
  26. C
  27.       PARAMETER (XZER=0.D0,UN=1.D0)
  28. C
  29.       DIMENSION SIGMA(6),XLTR(3),VF(3,3),XINVL(3)
  30. *
  31. *   VF  1-ER INDICE  : COMPOSANTE
  32. *       2-EME INDICE : DIRECTION DE FISSURE
  33. C
  34.       DIMENSION A3(3,3),D3(3),E3(3,3)
  35.       DIMENSION JRESU(3),FC(3)
  36. *
  37.       DO IC=1,3
  38.          JRESU(IC)=0
  39.          FC(IC)=-1.D4*PRECIZ
  40.          DO JC=1,3
  41.            VF(IC,JC)=XZER
  42.          ENDDO
  43.       ENDDO
  44. C
  45. C- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  46. C            LES TROIS DIRECTIONS SONT DEJA FISSUREES
  47. C- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  48. C
  49.       IF (NFISSU.EQ.3) THEN
  50.          RETURN
  51.       ENDIF
  52. C
  53. C- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  54. C            DEUX DIRECTIONS SONT DEJA FISSUREES
  55. C- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  56. C
  57.       IF (NFISSU.EQ.2) THEN
  58. C
  59. C        SEULE LA DIRECTION no IFIS N EST PAS FISSUREE
  60. C
  61.          IF ((XINVL(1)*XINVL(2)).NE.XZER) IFIS=3
  62.          IF ((XINVL(1)*XINVL(3)).NE.XZER) IFIS=2
  63.          IF ((XINVL(2)*XINVL(3)).NE.XZER) IFIS=1
  64. *
  65. *         IF(IIMPI.EQ.42) THEN
  66. *            WRITE(IOIMP,77003) IFIS
  67. *77003       FORMAT( 2X, 'OTTOFI - IFIS =',I4/)
  68. *         ENDIF
  69. C
  70.          FC(IFIS)=SIGMA(IFIS)-XLTR(IFIS)
  71.          JRESU(IFIS)=1
  72.          IF (FC(IFIS).GT.-PRECIZ) THEN
  73.             VF(IFIS,IFIS)=UN
  74.          ENDIF
  75.       ENDIF
  76. C
  77. C- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  78. C            UNE DIRECTION EST DEJA FISSUREE
  79. C- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  80. C
  81.       IF (NFISSU.EQ.1) THEN
  82. C
  83. C        SEULE LA DIRECTION no IFIS EST FISSUREE
  84. C
  85.          IF (XINVL(1).NE.XZER) IFIS=1
  86.          IF (XINVL(2).NE.XZER) IFIS=2
  87.          IF (XINVL(3).NE.XZER) IFIS=3
  88. *
  89. *         IF(IIMPI.EQ.42) THEN
  90. *            WRITE(IOIMP,77004) IFIS
  91. *77004       FORMAT( 2X, 'OTTOFI - IFIS =',I4/)
  92. *         ENDIF
  93. C
  94. C    CAS 1 :
  95. C       DEUX DIRECTIONS DE FAIBLESSE NON FISSUREE, UNE DIRECTION FISSUREE
  96. C
  97. C remarque : ce cas est identique a une direction de faiblesse
  98. C            non fissuree et une direction de fissuration.
  99. C
  100.          IF (NVF.EQ.2.OR.NVF.EQ.1) THEN
  101. C
  102. C         direction 1 fissuree
  103. C
  104.  
  105.             IF (IFIS.EQ.1) THEN
  106.                FC(2)=SIGMA(2)-XLTR(2)
  107.                JRESU(2)=1
  108.                IF (FC(2).GT.-PRECIZ) THEN
  109.                   VF(2,2)=UN
  110.                ENDIF
  111.                FC(3)=SIGMA(3)-XLTR(3)
  112.                JRESU(3)=1
  113.                IF (FC(3).GT.-PRECIZ) THEN
  114.                   VF(3,3)=UN
  115.                ENDIF
  116.             ENDIF
  117. C
  118. C         direction 2 fissuree
  119. C
  120.             IF (IFIS.EQ.2) THEN
  121.                FC(1)=SIGMA(1)-XLTR(1)
  122.                JRESU(1)=1
  123.                IF (FC(1).GT.-PRECIZ) THEN
  124.                   VF(1,1)=UN
  125.                ENDIF
  126.                FC(3)=SIGMA(3)-XLTR(3)
  127.                JRESU(3)=1
  128.                IF (FC(3).GT.-PRECIZ) THEN
  129.                   VF(3,3)=UN
  130.                ENDIF
  131.             ENDIF
  132. C
  133. C         direction 3 fissuree
  134. C
  135. C  remarque : ce cas est impossible s il n y a qu une direction imposee
  136. C             et une direction de fissuration.
  137. C
  138.             IF (IFIS.EQ.3) THEN
  139.                FC(1)=SIGMA(1)-XLTR(1)
  140.                JRESU(1)=1
  141.                IF (FC(1).GT.-PRECIZ) THEN
  142.                   VF(1,1)=UN
  143.                ENDIF
  144.                FC(2)=SIGMA(2)-XLTR(2)
  145.                JRESU(2)=1
  146.                IF (FC(2).GT.-PRECIZ) THEN
  147.                   VF(2,2)=UN
  148.                ENDIF
  149.             ENDIF
  150.          ENDIF
  151. C
  152. C    CAS 2 :  PAS DE DIRECTION DE FAIBLESSE
  153. C
  154.          IF (NVF.EQ.0) THEN
  155. C
  156.             CALL ZERO(A3,3,3)
  157.             A3(1,1)=SIGMA(2)
  158.             A3(1,2)=SIGMA(6)
  159.             A3(2,1)=SIGMA(6)
  160.             A3(2,2)=SIGMA(3)
  161.             CALL JACOB3(A3,2,D3,E3)
  162.  
  163. *
  164.             IF(IIMPI.EQ.42) THEN
  165.                WRITE(IOIMP,78783) D3(1),D3(2)
  166. 78783          FORMAT( 2X, 'OTTOFI - D3(1)=',1PE12.5,2X,
  167.      &                 ' D3(2)=',1PE12.5/)
  168.             ENDIF
  169. C
  170. C---------rq XLTR(2)=XLTR(3) puisque l on n a pas fissure---------
  171. C-----------et qu il n y a pas de direction de faiblesse----------
  172. C
  173.                IVP1=1
  174.                IVP2=2
  175.                IF(D3(2).GE.D3(1)) THEN
  176.                   IVP1=2
  177.                   IVP2=1
  178.                ENDIF
  179. *
  180.                FC(2)=D3(IVP1)-XLTR(2)
  181.                JRESU(2)=2
  182.                IF(FC(2).GT.-PRECIZ) THEN
  183.                   VF(2,2)=E3(1,IVP1)
  184.                   VF(3,2)=E3(2,IVP1)
  185.                ENDIF
  186. *
  187.                FC(3)=D3(IVP2)-XLTR(3)
  188.                JRESU(3)=2
  189.                IF(FC(3).GT.-PRECIZ) THEN
  190.                   VF(2,3)=E3(1,IVP2)
  191.                   VF(3,3)=E3(2,IVP2)
  192.                ENDIF
  193.           ENDIF
  194.           RETURN
  195.       ENDIF
  196. C
  197. C- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  198. C               AUCUNE DIRECTION DEJA FISSUREE
  199. C- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  200. C
  201.       IF (NFISSU.EQ.0) THEN
  202. C
  203. C    CAS 1 : DEUX OU TROIS DIRECTIONS DE FAIBLESSE
  204. C
  205.  
  206.          IF (NVF.EQ.2.OR.NVF.EQ.3) THEN
  207.             FC(1)=SIGMA(1)-XLTR(1)
  208.             JRESU(1)=1
  209.             IF (FC(1).GT.-PRECIZ) THEN
  210.                VF(1,1)=UN
  211.             ENDIF
  212.             FC(2)=SIGMA(2)-XLTR(2)
  213.             JRESU(2)=1
  214.             IF (FC(2).GT.-PRECIZ) THEN
  215.                VF(2,2)=UN
  216.             ENDIF
  217.             FC(3)=SIGMA(3)-XLTR(3)
  218.             JRESU(3)=1
  219.             IF (FC(3).GT.-PRECIZ) THEN
  220.                VF(3,3)=UN
  221.             ENDIF
  222.          ENDIF
  223. C
  224. C    CAS 2 : UNE DIRECTION DE FAIBLESSE
  225. C
  226.          IF (NVF.EQ.1) THEN
  227.             FC(1)=SIGMA(1)-XLTR(1)
  228.             JRESU(1)=1
  229.             IF (FC(1).GT.-PRECIZ) THEN
  230.                VF(1,1)=UN
  231.             ENDIF
  232. C
  233.             CALL ZERO(A3,3,3)
  234.             A3(1,1)=SIGMA(2)
  235.             A3(1,2)=SIGMA(6)
  236.             A3(2,1)=SIGMA(6)
  237.             A3(2,2)=SIGMA(3)
  238. C
  239.             CALL JACOB3(A3,2,D3,E3)
  240.  
  241. *
  242.             IF(IIMPI.EQ.42) THEN
  243.                WRITE(IOIMP,78784) D3(1),D3(2)
  244. 78784          FORMAT( 2X, 'OTTOFI - D3(1)=',1PE12.5,2X,
  245.      &                 ' D3(2)=',1PE12.5/)
  246.             ENDIF
  247. C
  248.             IVP1=1
  249.             IVP2=2
  250.             IF(D3(2).GE.D3(1)) THEN
  251.                IVP1=2
  252.                IVP2=1
  253.             ENDIF
  254. *
  255.             FC(2)=D3(IVP1)-XLTR(2)
  256.             JRESU(2)=2
  257.             IF(FC(2).GT.-PRECIZ) THEN
  258.                VF(2,2)=E3(1,IVP1)
  259.                VF(3,2)=E3(2,IVP1)
  260.             ENDIF
  261. *
  262.             FC(3)=D3(IVP2)-XLTR(3)
  263.             JRESU(3)=2
  264.             IF(FC(3).GT.-PRECIZ) THEN
  265.                VF(2,3)=E3(1,IVP2)
  266.                VF(3,3)=E3(2,IVP2)
  267.             ENDIF
  268.          ENDIF
  269. C
  270. C    CAS 3 : PAS DE DIRECTION DE FAIBLESSE
  271. C
  272.          IF (NVF.EQ.0) THEN
  273. C
  274.             A3(1,1)=SIGMA(1)
  275.             A3(1,2)=SIGMA(4)
  276.             A3(1,3)=SIGMA(5)
  277.             A3(2,1)=SIGMA(4)
  278.             A3(2,2)=SIGMA(2)
  279.             A3(2,3)=SIGMA(6)
  280.             A3(3,1)=SIGMA(5)
  281.             A3(3,2)=SIGMA(6)
  282.             A3(3,3)=SIGMA(3)
  283. *
  284.             IF(IIMPI.EQ.42) THEN
  285.                WRITE(IOIMP,78788) ((A3(I,J),J=1,3),I=1,3)
  286. 78788          FORMAT( 2X, 'OTTOFI - MATRICE A3 '/(3(1X,1PE12.5))/)
  287.             ENDIF
  288. *
  289.             CALL JACOB3(A3,3,D3,E3)
  290. *
  291.             IF(IIMPI.EQ.42) THEN
  292.                WRITE(IOIMP,78785) D3(1),D3(2),D3(3)
  293. 78785          FORMAT( 2X, 'OTTOFI - D3(1)=',1PE12.5,2X,
  294.      &         ' D3(2)=',1PE12.5,2X,' D3(3)=',1PE12.5/)
  295.             ENDIF
  296. C
  297.             IF (D3(1).GE.D3(2).AND.D3(1).GE.D3(3))THEN
  298.                IVP1=1
  299.                IVP2=2
  300.                IVP3=3
  301.                IF (D3(3).GE.D3(2)) THEN
  302.                   IVP2=3
  303.                   IVP3=2
  304.                ENDIF
  305.             ELSEIF (D3(2).GE.D3(3).AND.D3(2).GE.D3(1))THEN
  306.                IVP1=2
  307.                IVP2=3
  308.                IVP3=1
  309.                IF (D3(1).GE.D3(3)) THEN
  310.                   IVP2=1
  311.                   IVP3=3
  312.                ENDIF
  313.             ELSEIF (D3(3).GE.D3(1).AND.D3(3).GE.D3(2))THEN
  314.                IVP1=3
  315.                IVP2=1
  316.                IVP3=2
  317.                IF (D3(2).GE.D3(1)) THEN
  318.                   IVP2=2
  319.                   IVP3=1
  320.                ENDIF
  321.             ENDIF
  322. *
  323.             FC(1)=D3(IVP1)-XLTR(1)
  324.             JRESU(1)=3
  325.             IF(FC(1).GT.-PRECIZ) THEN
  326.                VF(1,1)=E3(1,IVP1)
  327.                VF(2,1)=E3(2,IVP1)
  328.                VF(3,1)=E3(3,IVP1)
  329.              ENDIF
  330. *
  331.             FC(2)=D3(IVP2)-XLTR(2)
  332.             JRESU(2)=3
  333.             IF(FC(2).GT.-PRECIZ) THEN
  334.                VF(1,2)=E3(1,IVP2)
  335.                VF(2,2)=E3(2,IVP2)
  336.                VF(3,2)=E3(3,IVP2)
  337.              ENDIF
  338. *
  339.             FC(3)=D3(IVP3)-XLTR(2)
  340.             JRESU(3)=3
  341.             IF(FC(3).GT.-PRECIZ) THEN
  342.                VF(1,3)=E3(1,IVP3)
  343.                VF(2,3)=E3(2,IVP3)
  344.                VF(3,3)=E3(3,IVP3)
  345.              ENDIF
  346.          ENDIF
  347.       ENDIF
  348.  
  349.       RETURN
  350.       END
  351.  
  352.  
  353.  
  354.  
  355.  
  356.  
  357.  

© Cast3M 2003 - Tous droits réservés.
Mentions légales