Télécharger la plaquette Cast3M


fr en

Télécharger ottoet.eso

Retour à la liste

Numérotation des lignes : 

ottoet

  1. C OTTOET    SOURCE    CHAT      05/01/13    02:07:28     5004
  2.       SUBROUTINE OTTOET(NC,NN,SIGMA,W,WMAX,SMAX,BILIN,WRUPT,BTR,
  3.      &       XLTR,XINVL,SBILI,PRECIE,PRECIZ,FC,FC2,LEBIL,NFISSU,
  4.      &       NVF,VF,FC0,PENTE,PENTE2,DX,DXV1,YOUN,NCA,MC,MM,
  5.      &       ISING,IFERM,IBRUP,IPLAS,XCOMP,XLAMC,DFF,DGG,KERRE)
  6. C
  7. C=========================================================================
  8. C
  9. C  ENTREES :
  10. C    SIGMA,W,WMAX,SMAX,BILIN,WRUPT,BTR,XLTR,XINVL,SBILI
  11. C
  12. C
  13. C  SORTIES :
  14. C    FC,LEBIL,NCA,MC,MM,FC0,PENTE
  15. C
  16. C==========================================================================
  17. C
  18.       IMPLICIT INTEGER(I-N)
  19.       IMPLICIT REAL*8(A-H,O-Z)
  20.  
  21. -INC PPARAM
  22. -INC CCOPTIO
  23. C
  24.       PARAMETER (XZER=0.D0)
  25. C
  26.       DIMENSION SIGMA(6),W(3),WMAX(3),BILIN(3),WREOUV(3),
  27.      &          WRUPT(3),XLTR(3),XINVL(3),SBILI(3),XCOMP(*)
  28.       DIMENSION PENTE(*),PENTE2(*),JFIS(3)
  29.       DIMENSION FC(*),FC2(*),NN(*),MM(*),LEBIL(*),SMAX(*)
  30.       DIMENSION VF(3,3),FC0(*)
  31.       DIMENSION ISING(*),IFERM(*),IBRUP(*)
  32.       DIMENSION DX(*),DXV1(*)
  33. *
  34.       DIMENSION DFF(*),DGG(*)
  35.  
  36.  
  37.       KERRE=0
  38.       IPLAS=0
  39.       CALL IANUL(ISING,NC)
  40.       CALL IANUL(IFERM,NC)
  41.       CALL IANUL(IBRUP,NC)
  42. *
  43.       DO IC=1,NC
  44.          NN(IC)=IC
  45.       ENDDO
  46. *
  47.       CALL OTTOEC(NC,NN,SIGMA,W,WMAX,SMAX,BILIN,WRUPT,BTR,
  48.      &     XLTR,XINVL,SBILI,FC,FC2,PENTE,PENTE2,LEBIL,ISING,
  49.      &     PRECIE,PRECIZ,XCOMP,XLAMC,KERRE)
  50.       IF(KERRE.NE.0) THEN
  51.           PRINT *, ' OTTOET - APRES OTTOEC KERRE=',KERRE
  52.           RETURN
  53.       ENDIF
  54. *
  55.       NCA=0
  56.       MC=0
  57.       LACOMP=0
  58. *
  59. *
  60.       DO IC=1,3
  61.          WREOUV(IC)=BTR*MIN(WMAX(IC),WRUPT(IC))
  62. *
  63.          IF(FC(IC).GT.PRECIZ.OR.FC2(IC).GT.PRECIZ) THEN
  64. *            cas ou le critere est violé
  65.              KERRE=2
  66.              PRINT *,' OTTOET - CRITERE VIOLE ',IC
  67.              RETURN
  68.          ENDIF
  69. *
  70. *        cas ou le critere n'est pas atteint
  71. *        -----------------------------------
  72. *
  73.          IF(FC(IC).LT.-PRECIZ.AND.FC2(IC).LT.-PRECIZ) THEN
  74. *
  75. * --->       sous-cas 1 : la direction n'a pas encore fissure
  76. *
  77.              IF(XINVL(IC).EQ.XZER) THEN
  78.  
  79.                 MC=MC+1
  80.                 MM(MC)= IC
  81. *
  82.              ELSE
  83. *
  84. * --->       sous-cas 2 : la direction a deja fissure
  85. *
  86.                 IF(LEBIL(IC).EQ.0) THEN
  87. *                   on est en compression
  88. *
  89.                     IF(BTR.LT.1.D0.AND.WMAX(IC).NE.XZER) THEN
  90.                        MC=MC+1
  91.                        MM(MC)= 9+IC
  92.                        LACOMP=1
  93.                     ELSE
  94.                        MC=MC+1
  95.                        MM(MC)= 3+IC
  96.                        LACOMP=1
  97.                     ENDIF
  98.                 ELSE
  99.                     KERRE=2
  100.                     PRINT *,' OTTOET - CAS IMPOSSIBLE ',IC
  101. *                   CAS IMPOSSIBLE
  102.                     RETURN
  103.                 ENDIF
  104. *
  105.              ENDIF
  106.  
  107.          ELSE
  108. *
  109. *        cas ou le critere est atteint
  110. *        -----------------------------
  111. *
  112.              IF(XINVL(IC).EQ.XZER) THEN
  113.                  KERRE=2
  114.                  PRINT *,' OTTOET - XINVL EST NUL  IC=  ',IC
  115.                  RETURN
  116.              ENDIF
  117. *
  118.              PRECIW=PRECIE/XINVL(IC)
  119.              NCA=NCA+1
  120.              NN(NCA)=IC
  121. *
  122. * --->       sous-cas 1 : le materiau n'est pas totalement casse
  123. *            ---------------------------------------------------
  124. *
  125.              IF(WMAX(IC).LT.WRUPT(IC)) THEN
  126. *
  127.                 IF(ABS(W(IC)-WREOUV(IC)).LT.PRECIW) THEN
  128. *
  129.                     IF(WMAX(IC).EQ.0.D0.OR.BTR.EQ.1.D0) THEN
  130. *
  131. *                      le materiau vient d'atteindre la limite
  132. *
  133.                        MC=MC+1
  134.                        MM(MC)= 6+IC
  135.                        LACOMP=1
  136.                        IBRUP(IC)=1
  137.  
  138.                     ELSE
  139. *
  140. *                      on est pile sur le critere sigma=0  (==> IFERM=1)
  141. *                      et  LEBIL vaut 1
  142. *
  143.                        IF(LEBIL(IC).NE.1) THEN
  144.                           KERRE=2
  145.                           PRINT *,' OTTOET - LEBIL NEG 1 SELON ',IC
  146.                           RETURN
  147.                        ENDIF
  148. *
  149.                        MC=MC+1
  150.                        MM(MC)= 3+IC
  151.                        LACOMP=1
  152.                        IFERM(IC)=1
  153.                     ENDIF
  154.  
  155.                 ELSE IF(W(IC).GT.WREOUV(IC)) THEN
  156.                   IPLAS=1
  157. *
  158.                   IF(ABS(W(IC)-WMAX(IC)).LT.PRECIW) THEN
  159. *
  160. *                    LEBIL vaut 2
  161. *
  162.                      IF(LEBIL(IC).NE.2) THEN
  163.                         KERRE=2
  164.                         PRINT *,' OTTOET - LEBIL NEG 2 SELON ',IC
  165.                         RETURN
  166.                      ENDIF
  167. *
  168. *                    d'abord les 2
  169. *
  170.                      IF(FC(IC).GT.-PRECIZ.AND.
  171.      &                  FC2(IC).GT.-PRECIZ) THEN
  172. *
  173.                         MC=MC+1
  174.                         MM(MC)= 6+IC
  175.                         MC=MC+1
  176.                         MM(MC)= 12+IC
  177. *
  178. *                    sinon seul le secant
  179. *
  180.                      ELSE IF(FC(IC).LT.-PRECIZ.AND.
  181.      &                  FC2(IC).GT.-PRECIZ) THEN
  182. *
  183. *                       on remet lebil a 1
  184. *
  185.                         LEBIL(IC)=1
  186.                         FC(IC)=FC2(IC)
  187.                         PENTE(IC)=PENTE2(IC)
  188.                         MC=MC+1
  189.                         MM(MC)= 3+IC
  190.                         MC=MC+1
  191.                         MM(MC)= 12+IC
  192. *
  193.                      ELSE
  194.                         KERRE=2
  195.                         PRINT *,' OTTOET - CAS PAS ',
  196.      &                           'POSSIBLE SELON ',IC
  197.                         RETURN
  198.                      ENDIF
  199. *
  200. *
  201.                   ELSE
  202. *
  203. *                    on est sur le secant ,
  204. *                    et  LEBIL vaut 1
  205. *
  206.                      IF(LEBIL(IC).NE.1) THEN
  207.                         KERRE=2
  208.                         PRINT *,' OTTOET - LEBIL NEG 1 SELON ',IC
  209.                         RETURN
  210.                      ENDIF
  211. *
  212.                      MC=MC+1
  213.                      MM(MC)= 3+IC
  214.                      MC=MC+1
  215.                      MM(MC)= 12+IC
  216.                   ENDIF
  217. *
  218.                 ELSE
  219. *
  220. *                 W < WREOUV  :  CAS IMPOSSIBLE
  221. *
  222.                   KERRE=2
  223.                   PRINT *,' OTTOET -  W < WREOUV  IC= ',IC
  224.                   PRINT *,'W(IC)=',W(IC)
  225.                   PRINT *,'WMAX(IC)=',WMAX(IC)
  226.                   PRINT *,'WREOUV(IC)=',WREOUV(IC)
  227.                   PRINT *,'WRUPT(IC)=',WRUPT(IC)
  228.  
  229.  
  230.                   RETURN
  231.                 ENDIF
  232. *
  233. * --->       sous-cas 2 : le materiau est totalement casse
  234. *            ---------------------------------------------
  235. *
  236.              ELSE IF(WMAX(IC).GE.WRUPT(IC)) THEN
  237. *
  238.  
  239.                    IF(W(IC)-WREOUV(IC).LT.-PRECIW) THEN
  240.  
  241. *
  242. *                    W < WREOUV  :  CAS IMPOSSIBLE
  243. *
  244.                      KERRE=2
  245.                      PRINT *,' OTTOET -  W < WREOUV  IC= ',IC
  246.                      PRINT *,'W(IC)=',W(IC)
  247.                      PRINT *,'WMAX(IC)=',WMAX(IC)
  248.                      PRINT *,'WREOUV(IC)=',WREOUV(IC)
  249.                      PRINT *,'WRUPT(IC)=',WRUPT(IC)
  250.                      RETURN
  251.  
  252.  
  253.                    ELSE
  254. *
  255. *                     on est en ouverture (IPLAS=1)
  256. *                     ou bien on est pile sur la limite sigma=0 (IPLAS=0)
  257. *                     LEBIL vaut 1 dans les 2 cas
  258. *
  259.                       IF(LEBIL(IC).NE.1) THEN
  260.                          KERRE=2
  261.                          PRINT *,' OTTOET - LEBIL NEG 1 SELON ',IC
  262.                          RETURN
  263.                       ENDIF
  264. *
  265.                       IF(W(IC)-WREOUV(IC).GT.PRECIW) THEN
  266.                          IPLAS=1
  267.                          MC=MC+1
  268.                          MM(MC)= 12+IC
  269.                       ELSE
  270.                          IFERM(IC)=1
  271.                          LACOMP=1
  272.                       ENDIF
  273. *
  274.                    ENDIF
  275.              ENDIF
  276.  
  277.          ENDIF
  278.  
  279.       ENDDO
  280. *
  281. *
  282. *
  283. *     CAS NUMERO 4
  284. *
  285.       IF(FC(4).GT.PRECIZ) THEN
  286.           KERRE=2
  287.           PRINT *,' OTTOET - CRITERE VIOLE  N0 4 '
  288.           RETURN
  289.       ENDIF
  290. *
  291. *
  292.  
  293.       IF(FC(4).LT.-PRECIZ) THEN
  294.          LACOMP=1
  295.       ELSE
  296.          NCA=NCA+1
  297.          NN(NCA)=4
  298.          LACOMP=0
  299.          IFERM(4)=1
  300.       ENDIF
  301. *
  302.  
  303. *   MLR 9/7/99
  304. *   ON MET 16 SYSTEMATIQUEMENT
  305. *
  306. *
  307. ***** IF(LACOMP.EQ.1) THEN
  308. *****    MC=MC+1
  309. *****    MM(MC)=16
  310. ***** ENDIF
  311. *
  312.  
  313.       MC=MC+1
  314.       MM(MC)=16
  315.  
  316. *
  317. *
  318. *     TEST SUR MC
  319. *
  320.       IF(MC.EQ.0) THEN
  321.         KERRE=2
  322.         PRINT *,' OTTOET - MC EST NUL '
  323.         RETURN
  324.       ENDIF
  325. *
  326. *    APPEL A OTTOCE
  327. *
  328.       CALL OTTOCE(MC,MM,SIGMA,DX,DXV1,W,WMAX,SMAX,WRUPT,
  329.      &       XLTR,XINVL,BTR,NFISSU,NVF,FC0,VF,YOUN,
  330.      &       PRECIZ,JFIS,XCOMP,XLAMC,DFF,DGG,KERRE)
  331.       IF(KERRE.NE.0) THEN
  332.           PRINT *, ' OTTOET - APRES OTTOCE KERRE=',KERRE
  333.           RETURN
  334.       ENDIF
  335. *
  336. *     TEST DE L'ETAT INITIAL
  337. *
  338.       DO IC=1,MC
  339.          JC=MM(IC)
  340.          IF(FC0(JC).GT.PRECIZ)THEN
  341.             PRINT *,'OTTOET - ETAT INITIAL INADMISSIBLE'
  342.             KERRE=2
  343.             RETURN
  344.          ENDIF
  345.       ENDDO
  346. *
  347.       IF(IIMPI.EQ.42) THEN
  348.         WRITE(IOIMP,77000) (FC(IC),IC=1,NC)
  349. 77000   FORMAT( 2X, ' OTTOET - FC '/(4(1X,1PE12.5)/)/)
  350.         WRITE(IOIMP,77001) (LEBIL(IC),IC=1,NC)
  351. 77001   FORMAT( 2X, ' OTTOET - LEBIL '/(7I4)/)
  352.         WRITE(IOIMP,77002) NCA,MC
  353. 77002   FORMAT( 2X, ' OTTOET - NCA=',I3,2X,'MC=',I3/)
  354.         WRITE(IOIMP,77003) (NN(IC),IC=1,NCA)
  355. 77003   FORMAT( 2X, ' OTTOET - NN  '/16(1X,I3)/)
  356.         WRITE(IOIMP,77004) (MM(IC),IC=1,MC)
  357. 77004   FORMAT( 2X, ' OTTOET - MM  '/16(1X,I3)/)
  358.       ENDIF
  359. *
  360.       RETURN
  361.       END
  362.  
  363.  
  364.  
  365.  
  366.  
  367.  
  368.  
  369.  

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