Télécharger la plaquette Cast3M


fr en

Télécharger tensi3.eso

Retour à la liste

Numérotation des lignes : 

tensi3

  1. C TENSI3    SOURCE    PV090527  24/06/12    21:15:10     11940          
  2.       SUBROUTINE TENSI3 (SIGMA,DSIGT,DEPST,YUNG,XNU,BETR,
  3.      .           VECX,VECY,VECZ,ANGLE,NBVECD,
  4.      .           XLTR,EPTR,XLTT,EPTT,EPRS,RT,OUVER,
  5.      .           SIGFIN,DEPSP,KERRE)
  6. C
  7.       IMPLICIT INTEGER(I-N)
  8.       IMPLICIT REAL*8(A-H,O-Z)
  9.  
  10. -INC PPARAM
  11. -INC CCOPTIO
  12. C
  13.       DIMENSION SIGMA(*),DSIGT(*),DEPST(*),SIGFIN(*),
  14.      .          CONTR(6),DCONT(6),DDEFT(6),CONFIN(6),DCONPR(6),
  15.      .          DSIGS(6),DCONS(6),DEPSP(*),DDEFP(6),DDEFS(6),DEFP(6),
  16.      .          VECX(*),VECY(*),VECZ(*),JECHA(3),JECHAN(3),
  17.      .          XLTR(*),EPTR(*),XLTT(*),EPTT(*),EPRS(*),RT(*),CISA(3),
  18.      .          OUVER(*),DEFPR(3),DEFRF(3),ET(3),JECRO(3),KOMPR(3),
  19.      .          ROTATS(6,6),TATORS(6,6),ROTATE(6,6),TATORE(6,6),
  20.      .          AAA(6,6),DDP(6,6)
  21. C
  22. C INITIALISATION
  23. C
  24.       GAMA = 0.D0
  25.       RFE=1.D-8
  26.       RFS=1.D-8
  27.       UNIT=0.0174532925199432957692D0
  28.       CALL ZDANUL(DEFP,6)
  29.       CALL ZDANUL(DEPSP,6)
  30.       CALL ZDANUL(DDEFP,6)
  31.       DO 9 I=1,3
  32.       JECRO(I)=0
  33.       KOMPR(I)=0
  34.       JECHA(I)=0
  35.       JECHAN(I)=0
  36.       DEFRF(I)=0.D0
  37.       DEFPR(I)=0.D0
  38.       DEFP(I)=OUVER(I)
  39.     9 CONTINUE
  40. C
  41.       IF(IIMPI.EQ.9) THEN
  42.         WRITE(IOIMP,1000)
  43.         WRITE(IOIMP,1001) (SIGMA(I),I=1,6)
  44.         WRITE(IOIMP,1002) (DSIGT(I),I=1,6)
  45.         WRITE(IOIMP,1003) (DEPST(I),I=1,6)
  46.         WRITE(IOIMP,1004) (VECX(I),I=1,3)
  47.         WRITE(IOIMP,1005) (VECY(I),I=1,3)
  48.         WRITE(IOIMP,1006) (VECZ(I),I=1,3)
  49.         WRITE(IOIMP,1007) (XLTR(I),I=1,3)
  50.         WRITE(IOIMP,1008) (EPTR(I),I=1,3)
  51.         WRITE(IOIMP,1009) (XLTT(I),I=1,3)
  52.         WRITE(IOIMP,1010) (EPTT(I),I=1,3)
  53.         WRITE(IOIMP,1011) (EPRS(I),I=1,3)
  54.         WRITE(IOIMP,1012) (RT(I),I=1,3)
  55.         WRITE(IOIMP,1013) (OUVER(I),I=1,3)
  56.         WRITE(IOIMP,1014) YUNG,XNU,BETR,(ANGLE/UNIT),NBVECD
  57.       ENDIF
  58. C
  59. C **********************************************************************
  60. C ******************* CAS DE NB DE VECT PROPRES DONNES = 0 *************
  61. C **********************************************************************
  62. C
  63.       IF(NBVECD.EQ.0) THEN
  64. C
  65.         CALL CLCRIT (SIGMA,DSIGT,RT,DEFP,DDEFP,DEFRF,NBVECD,KOMPR,
  66.      .       JECRO,KRITER,KRITC1,KRITC2,KRITC3,KRITE1,KRITE2,KRITE3)
  67. C
  68.         IF(IIMPI.EQ.9) THEN
  69.           WRITE(IOIMP,1015) KRITER
  70.           WRITE(IOIMP,1016) KRITC1,KRITC2,KRITC3
  71.           WRITE(IOIMP,1017) KRITE1,KRITE2,KRITE3
  72.         ENDIF
  73. C
  74.         IF(KRITER.NE.0) THEN
  75.           CALL CLGAMA (SIGMA,DSIGT,RT,DEFP,DDEFP,DEFRF,NBVECD,
  76.      .         KRITC1,KRITC2,KRITC3,KRITE1,KRITE2,KRITE3,GAMA,
  77.      .         YUNG,KOMPR,KERRE)
  78.           IF(KERRE.NE.0) RETURN
  79. C
  80.           IF(IIMPI.EQ.9) THEN
  81.             WRITE(IOIMP,1018) GAMA
  82.           ENDIF
  83.         ENDIF
  84. C
  85.         IF(KRITER.EQ.0.OR.GAMA.GE.1) THEN
  86. C
  87. C CAS DU COMPORTEMENT ELASTIQUE LINEAIRE
  88. C
  89.           DO 10 I=1,6
  90.            SIGFIN(I)=SIGMA(I)+DSIGT(I)
  91.            DEPSP(I)=0.D0
  92.    10     CONTINUE
  93. C
  94.           IF(IIMPI.EQ.9) THEN
  95.             WRITE(IOIMP,1030) (SIGFIN(I),I=1,6)
  96.             WRITE(IOIMP,1031) (DEPSP(I),I=1,6)
  97.           ENDIF
  98. C
  99.           RETURN
  100. C
  101.         ELSE
  102. C
  103.           DO 20 I=1,6
  104.            SIGMA(I)=SIGMA(I)+(GAMA*DSIGT(I))
  105.            DSIGT(I)=(1.D0-GAMA)*DSIGT(I)
  106.            DEPST(I)=(1.D0-GAMA)*DEPST(I)
  107.    20     CONTINUE
  108. C
  109.           IF(IIMPI.EQ.9) THEN
  110.             WRITE(IOIMP,1001) (SIGMA(I),I=1,6)
  111.             WRITE(IOIMP,1002) (DSIGT(I),I=1,6)
  112.             WRITE(IOIMP,1003) (DEPST(I),I=1,6)
  113.           ENDIF
  114. C
  115. C  POUR CALCULER VECZ
  116. C
  117.           IANGLE=0
  118.           CALL CLVECA (SIGMA,VECZ,ANGLE,IANGLE)
  119. C
  120.           IF(IIMPI.EQ.9) THEN
  121.             WRITE(IOIMP,1006) (VECZ(I),I=1,3)
  122.           ENDIF
  123. C
  124.           NBVECD=1
  125.         ENDIF
  126.       ENDIF
  127. C
  128. C **********************************************************************
  129. C ******************* CAS DE NB DE VECT PROPRES DONNES = 1 *************
  130. C **********************************************************************
  131. C
  132.       IF(NBVECD.EQ.1) THEN
  133. C
  134. C  INITIALISATION
  135. C
  136.         ITERA=0
  137.         IANGLE=0
  138.         ANGLE=0.D0
  139.         ET(1)=YUNG
  140.         ET(2)=YUNG
  141.         DEFPR(1)=0.D0
  142.         DEFPR(2)=0.D0
  143.         JECRO(3)=0
  144.         KOMPR(3)=0
  145.         JECHA(3)=0
  146.         JECHAN(3)=0
  147.         NJECHA=0
  148. C
  149. C  POUR CALCULER VECX ET VECY
  150. C
  151.         CALL CLREP(VECX,VECY,VECZ,ANGLE,IANGLE)
  152. C
  153.         IF(IIMPI.EQ.9) THEN
  154.           WRITE(IOIMP,1004) (VECX(I),I=1,3)
  155.           WRITE(IOIMP,1005) (VECY(I),I=1,3)
  156.         ENDIF
  157. C
  158. C  POUR SE METTRE DANS LE REPERE DE LA FISSURE
  159. C
  160.         CALL ROTA3D(ROTATS,TATORS,ROTATE,TATORE,VECX,VECY,VECZ,ANGLE)
  161. C
  162.         IF(IIMPI.EQ.9) THEN
  163.           WRITE(IOIMP,*) 'TATORS'
  164.           WRITE(IOIMP,999) ((TATORS(I,J),J=1,6),I=1,6)
  165.           WRITE(IOIMP,*) 'TATORE'
  166.           WRITE(IOIMP,999) ((TATORE(I,J),J=1,6),I=1,6)
  167.         ENDIF
  168. C
  169.         CALL MULMAT(CONTR,TATORS,SIGMA,6,1,6)
  170.         CALL MULMAT(DCONT,TATORS,DSIGT,6,1,6)
  171.         CALL MULMAT(DDEFT,TATORE,DEPST,6,1,6)
  172. C
  173.         IF(IIMPI.EQ.9) THEN
  174.           WRITE(IOIMP,1020) (CONTR(I),I=1,6)
  175.           WRITE(IOIMP,1021) (DCONT(I),I=1,6)
  176.           WRITE(IOIMP,1022) (DDEFT(I),I=1,6)
  177. C
  178.           ENERG=DSIGT(1)*DEPST(1)+DSIGT(2)*DEPST(2)+DSIGT(3)*DEPST(3)+
  179.      .          DSIGT(4)*DEPST(4)+DSIGT(5)*DEPST(5)+DSIGT(6)*DEPST(6)
  180.           ENERR=DCONT(1)*DDEFT(1)+DCONT(2)*DDEFT(2)+DCONT(3)*DDEFT(3)+
  181.      .          DCONT(4)*DDEFT(4)+DCONT(5)*DDEFT(5)+DCONT(6)*DDEFT(6)
  182.           DELEN=ENERG-ENERR
  183.           WRITE(IOIMP,*) 'ENERG =',ENERG,' ENERR =',ENERR
  184.           WRITE(IOIMP,*) 'DELEN =',DELEN
  185.         ENDIF
  186. C
  187.   111   CALL CLDETA(YUNG,XNU,RT,XLTR,XLTT,EPTT,EPTR,EPRS,OUVER,
  188.      .              CONTR,DDEFT,DCONPR)
  189. C
  190.    11   CALL CLMODU(YUNG,CONTR(3),DEFP(3),DCONPR(3),DDEFT(3),RT(3),
  191.      .       XLTR(3),XLTT(3),EPTT(3),EPTR(3),EPRS(3),
  192.      .       ET(3),DEFRF(3),DEFPR(3),JECRO(3),KOMPR(3),JECHA(3),
  193.      .       KERRE)
  194.         IF(KERRE.NE.0) RETURN
  195. C
  196.         IF(IIMPI.EQ.9) THEN
  197.           WRITE(IOIMP,1023) (ET(I),I=1,3)
  198.           WRITE(IOIMP,1024) (DEFRF(I),I=1,3)
  199.           WRITE(IOIMP,1026) (DEFPR(I),I=1,3)
  200.           WRITE(IOIMP,1025) (JECRO(I),I=1,3)
  201.           WRITE(IOIMP,1035) (KOMPR(I),I=1,3)
  202.           WRITE(IOIMP,1036) (JECHA(I),I=1,3)
  203.         ENDIF
  204. C
  205.         CALL CLCISA(ET,YUNG,XNU,BETR,XLTR,CISA)
  206. C
  207.         IF(IIMPI.EQ.9) THEN
  208.           WRITE(IOIMP,1027) (CISA(I),I=1,3)
  209.         ENDIF
  210. C
  211. C       CALCUL DU MODE DE DOMAGE
  212. C
  214.         IF(ET(1).NE.YUNG) KRITER=KRITER+1
  215.         IF(ET(2).NE.YUNG) KRITER=KRITER+2
  216.         IF(ET(3).NE.YUNG) KRITER=KRITER+4
  217. C
  218.         IF(IIMPI.EQ.9) THEN
  219.           WRITE(IOIMP,1015) KRITER
  220.         ENDIF
  221. C
  222. C  CALCUL DES MATRICES : A ET D'
  223. C
  224.         CALL CLOUVE(AAA,YUNG,XNU,ET,CISA,KRITER,KERRE)
  225.         CALL CLENDO(DDP,YUNG,XNU,ET,CISA,KRITER,KERRE)
  226.         IF(KERRE.NE.0) RETURN
  227. C
  228.         IF(IIMPI.EQ.9) THEN
  229.           WRITE(IOIMP,*) 'AAA'
  230.           WRITE(IOIMP,999) ((AAA(I,J),J=1,6),I=1,6)
  231.           WRITE(IOIMP,*) 'DDP'
  232.           WRITE(IOIMP,999) ((DDP(I,J),J=1,6),I=1,6)
  233.         ENDIF
  234. C
  235. C  CALCUL DU DELTA DEFORMATION PLASTIQUE  (DDEFS)
  236. C      ET DU DELTA CONTRAINTE SOLUTION    (DCONS)
  237. C
  238.         CALL MULMAT(DDEFS,AAA,DDEFT,6,1,6)
  239.         CALL MULMAT(DCONS,DDP,DDEFT,6,1,6)
  240. C
  241.         IF(IIMPI.EQ.9) THEN
  242.           WRITE(IOIMP,1028) (DDEFS(I),I=1,6)
  243.           WRITE(IOIMP,1029) (DCONS(I),I=1,6)
  244.         ENDIF
  245. C
  246.         IF(NJECHA.LE.2) THEN
  247.           JECHAN(3)=JECHA(3)
  248.           IF(JECHA(3).EQ.1) THEN
  249.             IF((ABS(DDEFS(3))).GT.RFE) THEN
  250.               IF(DDEFS(3).LT.0.D0) JECHAN(3)=2
  251.             ELSE
  252.               IF((DCONS(3).LT.0.D0.AND.(ABS(DCONS(3))).GT.RFS).
  253.      .           AND.JECRO(3).NE.1) JECHAN(3)=2
  254.             ENDIF
  255.           ENDIF
  256.           IF(JECHA(3).EQ.2) THEN
  257.             IF((ABS(DDEFS(3))).GT.RFE) THEN
  258.               IF(DDEFS(3).GT.0.D0) JECHAN(3)=1
  259.             ELSE
  260.               IF((DCONS(3).GT.0.D0.AND.(ABS(DCONS(3))).GT.RFS).
  261.      .            OR.JECRO(3).EQ.1) JECHAN(3)=1
  262.             ENDIF
  263.           ENDIF
  264.           IF(IIMPI.EQ.9) WRITE(IOIMP,1036) (JECHA(I),I=1,3)
  265.           IF(JECHAN(3).NE.JECHA(3)) THEN
  266.             NJECHA=NJECHA+1
  267.             JECHA(3)=JECHAN(3)
  268.             IF(IIMPI.EQ.9) WRITE(IOIMP,1036) (JECHA(I),I=1,3)
  269.             GO TO 11
  270.           ENDIF
  271.         ENDIF
  272. C
  273.         IF(ET(3).EQ.0.D0) THEN
  274.           CONTR(3)=0.D0
  275.           DCONS(3)=0.D0
  276.         ENDIF
  277. C
  278.         CALL CLCRIT (CONTR,DCONS,RT,DEFP,DDEFS,DEFRF,NBVECD,KOMPR,
  279.      .       JECRO,KRITER,KRITC1,KRITC2,KRITC3,KRITE1,KRITE2,KRITE3)
  280. C
  281.         IF(IIMPI.EQ.9) THEN
  282.           WRITE(IOIMP,1015) KRITER
  283.           WRITE(IOIMP,1016) KRITC1,KRITC2,KRITC3
  284.           WRITE(IOIMP,1017) KRITE1,KRITE2,KRITE3
  285.         ENDIF
  286. C
  287.         IF(KRITER.NE.0) THEN
  288.           CALL CLGAMA (CONTR,DCONS,RT,DEFP,DDEFS,DEFRF,NBVECD,
  289.      .         KRITC1,KRITC2,KRITC3,KRITE1,KRITE2,KRITE3,GAMA,
  290.      .         YUNG,KOMPR,KERRE)
  291.           IF(KERRE.NE.0) RETURN
  292. C
  293.           IF(IIMPI.EQ.9) THEN
  294.             WRITE(IOIMP,1018) GAMA
  295.           ENDIF
  296.         ENDIF
  297. C
  298.         IF(KRITER.EQ.0.OR.GAMA.GE.1) THEN
  299. C
  300. C CAS DE L ECOULEMENT SELON LA DIRECTION Z SEULE
  301. C
  302.           DO 30 I=1,6
  303.            CONFIN(I)=CONTR(I)+DCONS(I)
  304.            DEFP(I)=DEFP(I)+DDEFS(I)
  305.            DDEFP(I)=DDEFP(I)+DDEFS(I)
  306.    30     CONTINUE
  307. C
  308.           IF(IIMPI.EQ.9) THEN
  309.             WRITE(IOIMP,1032) (CONFIN(I),I=1,6)
  310.             WRITE(IOIMP,1033) (DEFP(I),I=1,6)
  311.             WRITE(IOIMP,1034) (DDEFP(I),I=1,6)
  312.           ENDIF
  313. C
  314. C  POUR SE METTRE DANS LE REPERE GLOBAL
  315. C
  316.           CALL MULMAT(SIGFIN,ROTATS,CONFIN,6,1,6)
  317.           CALL MULMAT(DEPSP,ROTATE,DDEFP,6,1,6)
  318. C
  319. C  MISE A JOUR DES VARIABLES INTERNES
  320. C
  321.           OUVER(1)=DEFP(1)
  322.           OUVER(2)=DEFP(2)
  323.           OUVER(3)=DEFP(3)
  324.           IF(JECRO(3).EQ.1.AND.RT(3).GT.CONFIN(3)) RT(3)=CONFIN(3)
  325.           IF(RT(3).LT.0.D0) RT(3)=0.D0
  326. C
  327.           IF(IIMPI.EQ.9) THEN
  328.             WRITE(IOIMP,1030) (SIGFIN(I),I=1,6)
  329.             WRITE(IOIMP,1031) (DEPSP(I),I=1,6)
  330.           ENDIF
  331. C
  332.           RETURN
  333. C
  334.         ELSE
  335. C
  336.           DO 40 I=1,6
  337.            DCONS(I)=GAMA*DCONS(I)
  338.            DDEFS(I)=GAMA*DDEFS(I)
  339.            DCONT(I)=(1.D0-GAMA)*DCONT(I)
  340.            DDEFT(I)=(1.D0-GAMA)*DDEFT(I)
  341.            CONTR(I)=CONTR(I)+DCONS(I)
  342.            DEFP(I)=DEFP(I)+DDEFS(I)
  343.            DDEFP(I)=DDEFP(I)+DDEFS(I)
  344.    40     CONTINUE
  345.           IF(JECRO(3).EQ.1.AND.RT(3).GT.CONTR(3)) RT(3)=CONTR(3)
  346.           IF(RT(3).LT.0.D0) RT(3)=0.D0
  347. C
  348.         IF(IIMPI.EQ.9) THEN
  349.           WRITE(IOIMP,1012) (RT(I),I=1,3)
  350.           WRITE(IOIMP,1028) (DDEFS(I),I=1,6)
  351.           WRITE(IOIMP,1029) (DCONS(I),I=1,6)
  352.           WRITE(IOIMP,1020) (CONTR(I),I=1,6)
  353.           WRITE(IOIMP,1021) (DCONT(I),I=1,6)
  354.           WRITE(IOIMP,1022) (DDEFT(I),I=1,6)
  355.           WRITE(IOIMP,1033) (DEFP(I),I=1,6)
  356.           WRITE(IOIMP,1034) (DDEFP(I),I=1,6)
  357.         ENDIF
  358. C
  359.           GO TO (1,1,1,2,1,1,1),KRITER
  360.           KERRE=465
  361.           RETURN
  362. C
  363.     2       IF (ITERA.LE.10) THEN
  364.               ITERA=ITERA+1
  365.               JECRO(3)=0
  366.               KOMPR(3)=0
  367.               JECHA(3)=0
  368.               JECHAN(3)=0
  369.               NJECHA=0
  370.               GO TO 111
  371.             ELSE
  372.               KERRE=466
  373.               RETURN
  374.             ENDIF
  375. C
  376. C  POUR SE METTRE DANS LE REPERE GLOBAL
  377. C
  378.     1     CALL MULMAT(SIGMA,ROTATS,CONTR,6,1,6)
  379.           CALL MULMAT(DSIGT,ROTATS,DCONT,6,1,6)
  380.           CALL MULMAT(DEPST,ROTATS,DDEFT,6,1,6)
  381.           CALL MULMAT(DEPSP,ROTATS,DDEFP,6,1,6)
  382. C
  383.           IF(IIMPI.EQ.9) THEN
  384.             WRITE(IOIMP,1001) (SIGMA(I),I=1,6)
  385.             WRITE(IOIMP,1002) (DSIGT(I),I=1,6)
  386.             WRITE(IOIMP,1003) (DEPST(I),I=1,6)
  387.             WRITE(IOIMP,1031) (DEPSP(I),I=1,6)
  388.           ENDIF
  389. C
  390. C  POUR CALCULER L ANGLE
  391. C
  392.           IANGLE=2
  393.           CALL CLVECA (CONTR,VECZ,ANGLE,IANGLE)
  394. C
  395.           IF(IIMPI.EQ.9) THEN
  396.             WRITE(IOIMP,1019) ANGLE/UNIT
  397.           ENDIF
  398. C
  399.           NBVECD=2
  400.         ENDIF
  401.       ENDIF
  402. C
  403. C **********************************************************************
  404. C ******************* CAS DE NB DE VECT PROPRES DONNES = 2 *************
  405. C **********************************************************************
  406. C
  407.       IF(NBVECD.EQ.2) THEN
  408. C
  409. C  INITIALISATION
  410. C
  411.         ITERB=0
  412.         NJECHA=0
  413.         DO 49 I=1,3
  414.          JECRO(I)=0
  415.          KOMPR(I)=0
  416.          JECHA(I)=0
  417.          JECHAN(I)=0
  418.    49   CONTINUE
  419. C
  420. C  POUR SE METTRE DANS LE REPERE DE LA FISSURE
  421. C
  422.         CALL ROTA3D(ROTATS,TATORS,ROTATE,TATORE,VECX,VECY,VECZ,ANGLE)
  423. C
  424.         IF(IIMPI.EQ.9) THEN
  425.           WRITE(IOIMP,*) 'TATORS'
  426.           WRITE(IOIMP,999) ((TATORS(I,J),J=1,6),I=1,6)
  427.           WRITE(IOIMP,*) 'TATORE'
  428.           WRITE(IOIMP,999) ((TATORE(I,J),J=1,6),I=1,6)
  429.         ENDIF
  430. C
  431.         CALL MULMAT(CONTR,TATORS,SIGMA,6,1,6)
  432.         CALL MULMAT(DCONT,TATORS,DSIGT,6,1,6)
  433.         CALL MULMAT(DDEFT,TATORE,DEPST,6,1,6)
  434. C
  435.         IF(IIMPI.EQ.9) THEN
  436.           WRITE(IOIMP,1020) (CONTR(I),I=1,6)
  437.           WRITE(IOIMP,1021) (DCONT(I),I=1,6)
  438.           WRITE(IOIMP,1022) (DDEFT(I),I=1,6)
  439. C
  440.           ENERG=DSIGT(1)*DEPST(1)+DSIGT(2)*DEPST(2)+DSIGT(3)*DEPST(3)+
  441.      .          DSIGT(4)*DEPST(4)+DSIGT(5)*DEPST(5)+DSIGT(6)*DEPST(6)
  442.           ENERR=DCONT(1)*DDEFT(1)+DCONT(2)*DDEFT(2)+DCONT(3)*DDEFT(3)+
  443.      .          DCONT(4)*DDEFT(4)+DCONT(5)*DDEFT(5)+DCONT(6)*DDEFT(6)
  444.           DELEN=ENERG-ENERR
  445.           WRITE(IOIMP,*) 'ENERG =',ENERG,' ENERR =',ENERR
  446.           WRITE(IOIMP,*) 'DELEN =',DELEN
  447.         ENDIF
  448. C
  449.   222   CALL CLDETA(YUNG,XNU,RT,XLTR,XLTT,EPTT,EPTR,EPRS,OUVER,
  450.      .              CONTR,DDEFT,DCONPR)
  451. C
  452.    22   DO 50 I=1,3
  453.          CALL CLMODU(YUNG,CONTR(I),DEFP(I),DCONPR(I),DDEFT(I),RT(I),
  454.      .        XLTR(I),XLTT(I),EPTT(I),EPTR(I),EPRS(I),
  455.      .        ET(I),DEFRF(I),DEFPR(I),JECRO(I),KOMPR(I),JECHA(I),
  456.      .        KERRE)
  457.          IF(KERRE.NE.0) RETURN
  458.    50   CONTINUE
  459. C
  460.         IF(IIMPI.EQ.9) THEN
  461.           WRITE(IOIMP,1023) (ET(I),I=1,3)
  462.           WRITE(IOIMP,1024) (DEFRF(I),I=1,3)
  463.           WRITE(IOIMP,1026) (DEFPR(I),I=1,3)
  464.           WRITE(IOIMP,1025) (JECRO(I),I=1,3)
  465.           WRITE(IOIMP,1035) (KOMPR(I),I=1,3)
  466.           WRITE(IOIMP,1036) (JECHA(I),I=1,3)
  467.         ENDIF
  468. C
  469.         CALL CLCISA(ET,YUNG,XNU,BETR,XLTR,CISA)
  470. C
  471.         IF(IIMPI.EQ.9) THEN
  472.           WRITE(IOIMP,1027) (CISA(I),I=1,3)
  473.         ENDIF
  474. C
  475. C       CALCUL DU MODE DE DOMAGE
  476. C
  478.         IF(ET(1).NE.YUNG) KRITER=KRITER+1
  479.         IF(ET(2).NE.YUNG) KRITER=KRITER+2
  480.         IF(ET(3).NE.YUNG) KRITER=KRITER+4
  481. C
  482.         IF(IIMPI.EQ.9) THEN
  483.           WRITE(IOIMP,1015) KRITER
  484.         ENDIF
  485. C
  486. C  CALCUL DES MATRICES : A ET D'
  487. C
  488.         CALL CLOUVE(AAA,YUNG,XNU,ET,CISA,KRITER,KERRE)
  489.         CALL CLENDO(DDP,YUNG,XNU,ET,CISA,KRITER,KERRE)
  490.         IF(KERRE.NE.0) RETURN
  491. C
  492.         IF(IIMPI.EQ.9) THEN
  493.           WRITE(IOIMP,*) 'AAA'
  494.           WRITE(IOIMP,999) ((AAA(I,J),J=1,6),I=1,6)
  495.           WRITE(IOIMP,*) 'DDP'
  496.           WRITE(IOIMP,999) ((DDP(I,J),J=1,6),I=1,6)
  497.         ENDIF
  498. C
  499. C  CALCUL DU DELTA DEFORMATION PLASTIQUE  (DDEFS)
  500. C      ET DU DELTA CONTRAINTE SOLUTION    (DCONS)
  501. C
  502.         CALL MULMAT(DDEFS,AAA,DDEFT,6,1,6)
  503.         CALL MULMAT(DCONS,DDP,DDEFT,6,1,6)
  504. C
  505.         IF(IIMPI.EQ.9) THEN
  506.           WRITE(IOIMP,1028) (DDEFS(I),I=1,6)
  507.           WRITE(IOIMP,1029) (DCONS(I),I=1,6)
  508.         ENDIF
  509. C
  510.         IF(NJECHA.LE.8) THEN
  511.           DO 51 I=1,3
  512.            JECHAN(I)=JECHA(I)
  513.           IF(JECHA(I).EQ.1) THEN
  514.             IF((ABS(DDEFS(I))).GT.RFE) THEN
  515.               IF(DDEFS(I).LT.0.D0) JECHAN(I)=2
  516.             ELSE
  517.               IF((DCONS(I).LT.0.D0.AND.(ABS(DCONS(I))).GT.RFS).
  518.      .           AND.JECRO(I).NE.1) JECHAN(I)=2
  519.             ENDIF
  520.           ENDIF
  521.           IF(JECHA(I).EQ.2) THEN
  522.             IF((ABS(DDEFS(I))).GT.RFE) THEN
  523.               IF(DDEFS(I).GT.0.D0) JECHAN(I)=1
  524.             ELSE
  525.               IF((DCONS(I).GT.0.D0.AND.(ABS(DCONS(I))).GT.RFS).
  526.      .            OR.JECRO(I).EQ.1) JECHAN(I)=1
  527.             ENDIF
  528.           ENDIF
  529.    51     CONTINUE
  530.           IF(IIMPI.EQ.9) WRITE(IOIMP,1036) (JECHA(I),I=1,3)
  531.           IF(JECHAN(1).NE.JECHA(1).OR.JECHAN(2).NE.JECHA(2).OR.
  532.      .       JECHAN(3).NE.JECHA(3)) THEN
  533.             NJECHA=NJECHA+1
  534.             DO 52 I=1,3
  535.              JECHA(I)=JECHAN(I)
  536.    52       CONTINUE
  537.             IF(IIMPI.EQ.9) WRITE(IOIMP,1036) (JECHA(I),I=1,3)
  538.             GO TO 22
  539.           ENDIF
  540.         ENDIF
  541. C
  542.         DO 53 I=1,3
  543.          IF(ET(I).EQ.0.D0) THEN
  544.            CONTR(I)=0.D0
  545.            DCONS(I)=0.D0
  546.          ENDIF
  547.    53       CONTINUE
  548. C
  549.         CALL CLCRIT (CONTR,DCONS,RT,DEFP,DDEFS,DEFRF,NBVECD,KOMPR,
  550.      .       JECRO,KRITER,KRITC1,KRITC2,KRITC3,KRITE1,KRITE2,KRITE3)
  551. C
  552.         IF(IIMPI.EQ.9) THEN
  553.           WRITE(IOIMP,1015) KRITER
  554.           WRITE(IOIMP,1016) KRITC1,KRITC2,KRITC3
  555.           WRITE(IOIMP,1017) KRITE1,KRITE2,KRITE3
  556.         ENDIF
  557. C
  558.         IF(KRITER.NE.0) THEN
  559.           CALL CLGAMA (CONTR,DCONS,RT,DEFP,DDEFS,DEFRF,NBVECD,
  560.      .         KRITC1,KRITC2,KRITC3,KRITE1,KRITE2,KRITE3,GAMA,
  561.      .         YUNG,KOMPR,KERRE)
  562.           IF(KERRE.NE.0) RETURN
  563. C
  564.           IF(IIMPI.EQ.9) THEN
  565.             WRITE(IOIMP,1018) GAMA
  566.           ENDIF
  567.         ENDIF
  568. C
  569.         IF(KRITER.EQ.0.OR.GAMA.GE.1) THEN
  570. C
  571. C CAS DE L ECOULEMENT SANS DIFFICULTE
  572. C
  573.           DO 60 I=1,6
  574.            CONFIN(I)=CONTR(I)+DCONS(I)
  575.            DEFP(I)=DEFP(I)+DDEFS(I)
  576.            DDEFP(I)=DDEFP(I)+DDEFS(I)
  577.    60     CONTINUE
  578. C
  579.           IF(IIMPI.EQ.9) THEN
  580.             WRITE(IOIMP,1032) (CONFIN(I),I=1,6)
  581.             WRITE(IOIMP,1033) (DEFP(I),I=1,6)
  582.             WRITE(IOIMP,1034) (DDEFP(I),I=1,6)
  583.           ENDIF
  584. C
  585. C  POUR SE METTRE DANS LE REPERE GLOBAL
  586. C
  587.           CALL MULMAT(SIGFIN,ROTATS,CONFIN,6,1,6)
  588.           CALL MULMAT(DEPSP,ROTATE,DDEFP,6,1,6)
  589. C
  590.           IF(IIMPI.EQ.9) THEN
  591.             WRITE(IOIMP,1030) (SIGFIN(I),I=1,6)
  592.             WRITE(IOIMP,1031) (DEPSP(I),I=1,6)
  593.           ENDIF
  594. C
  595. C  MISE A JOUR DES VARIABLES INTERNES
  596. C
  597.           DO 70 I=1,3
  598.            OUVER(I)=DEFP(I)
  599.            IF(JECRO(I).EQ.1.AND.RT(I).GT.CONFIN(I)) RT(I)=CONFIN(I)
  600.            IF(RT(I).LT.0.D0) RT(I)=0.D0
  601.    70     CONTINUE
  602.           RETURN
  603. C
  604.         ELSE
  605. C
  606.           DO 80 I=1,6
  607.            DCONS(I)=GAMA*DCONS(I)
  608.            DDEFS(I)=GAMA*DDEFS(I)
  609.            DCONT(I)=(1.D0-GAMA)*DCONT(I)
  610.            DDEFT(I)=(1.D0-GAMA)*DDEFT(I)
  611.            CONTR(I)=CONTR(I)+DCONS(I)
  612.            DEFP(I)=DEFP(I)+DDEFS(I)
  613.            DDEFP(I)=DDEFP(I)+DDEFS(I)
  614.    80     CONTINUE
  615. C
  616.           DO 90 I=1,3
  617.            IF(JECRO(I).EQ.1.AND.RT(I).GT.CONTR(I)) RT(I)=CONTR(I)
  618.            IF(RT(I).LT.0.D0) RT(I)=0.D0
  619.    90     CONTINUE
  620. C
  621.         IF(IIMPI.EQ.9) THEN
  622.           WRITE(IOIMP,1012) (RT(I),I=1,3)
  623.           WRITE(IOIMP,1028) (DDEFS(I),I=1,6)
  624.           WRITE(IOIMP,1029) (DCONS(I),I=1,6)
  625.           WRITE(IOIMP,1020) (CONTR(I),I=1,6)
  626.           WRITE(IOIMP,1021) (DCONT(I),I=1,6)
  627.           WRITE(IOIMP,1022) (DDEFT(I),I=1,6)
  628.           WRITE(IOIMP,1033) (DEFP(I),I=1,6)
  629.           WRITE(IOIMP,1034) (DDEFP(I),I=1,6)
  630.         ENDIF
  631. C
  632.           IF (ITERB.LE.15) THEN
  633.             ITERB=ITERB+1
  634.             NJECHA=0
  635.             DO 91 I=1,3
  636.              JECRO(I)=0
  637.              KOMPR(I)=0
  638.              JECHA(I)=0
  639.              JECHAN(I)=0
  640.    91       CONTINUE
  641.             GO TO 222
  642.           ELSE
  643.             KERRE=467
  644.             RETURN
  645.           ENDIF
  646.         ENDIF
  647.       ENDIF
  648. C
  649.   999 FORMAT(6(1X,1PE12.5))
  650.  1000 FORMAT(1X,'ETAT INITIAL AU DEBUT DE L ECOULEMENT')
  651.  1001 FORMAT(1X,'SIGMA =',6(1X,1PE12.5))
  652.  1002 FORMAT(1X,'DSIGT =',6(1X,1PE12.5))
  653.  1003 FORMAT(1X,'DEPST =',6(1X,1PE12.5))
  654.  1004 FORMAT(1X,'VECX  =',3(1X,1PE12.5))
  655.  1005 FORMAT(1X,'VECY  =',3(1X,1PE12.5))
  656.  1006 FORMAT(1X,'VECZ  =',3(1X,1PE12.5))
  657.  1007 FORMAT(1X,'XLTR  =',3(1X,1PE12.5))
  658.  1008 FORMAT(1X,'EPTR  =',3(1X,1PE12.5))
  659.  1009 FORMAT(1X,'XLTT  =',3(1X,1PE12.5))
  660.  1010 FORMAT(1X,'EPTT  =',3(1X,1PE12.5))
  661.  1011 FORMAT(1X,'EPRS  =',3(1X,1PE12.5))
  662.  1012 FORMAT(1X,'RT    =',3(1X,1PE12.5))
  663.  1013 FORMAT(1X,'OUVER =',3(1X,1PE12.5))
  664.  1014 FORMAT(1X,'YUNG  = ',1PE12.5,2X,'XNU   = ',1PE12.5,2X,/,
  665.      .       1X,'BETR  = ',1PE12.5,2X,'ANGLE = ',1PE12.5,2X,
  666.      .          'NBVECD= ',I3)
  667.  1015 FORMAT(1X,'KRITER= ',I3)
  668.  1016 FORMAT(1X,'KRITC1= ',I3,2X,'KRITC2= ',I3,2X,'KRITC3= ',I3)
  669.  1017 FORMAT(1X,'KRITE1= ',I3,2X,'KRITE2= ',I3,2X,'KRITE3= ',I3)
  670.  1018 FORMAT(1X,'GAMA  = ',1PE12.5)
  671.  1019 FORMAT(1X,'ANGLE = ',1PE12.5)
  672.  1020 FORMAT(1X,'CONTR =',6(1X,1PE12.5))
  673.  1021 FORMAT(1X,'DCONT =',6(1X,1PE12.5))
  674.  1022 FORMAT(1X,'DDEFT =',6(1X,1PE12.5))
  675.  1023 FORMAT(1X,'ET    =',3(1X,1PE12.5))
  676.  1024 FORMAT(1X,'DEFRF =',3(1X,1PE12.5))
  677.  1025 FORMAT(1X,'JECRO =',3(1X,I3))
  678.  1026 FORMAT(1X,'DEFPR =',3(1X,1PE12.5))
  679.  1027 FORMAT(1X,'CISA  =',3(1X,1PE12.5))
  680.  1028 FORMAT(1X,'DDEFS =',6(1X,1PE12.5))
  681.  1029 FORMAT(1X,'DCONS =',6(1X,1PE12.5))
  682.  1030 FORMAT(1X,'SIGFIN=',6(1X,1PE12.5))
  683.  1031 FORMAT(1X,'DEPSP =',6(1X,1PE12.5))
  684.  1032 FORMAT(1X,'CONFIN=',6(1X,1PE12.5))
  685.  1033 FORMAT(1X,'DEFP  =',6(1X,1PE12.5))
  686.  1034 FORMAT(1X,'DDEFP =',6(1X,1PE12.5))
  687.  1035 FORMAT(1X,'KOMPR =',3(1X,I3))
  688.  1036 FORMAT(1X,'JECHA =',3(1X,I3))
  689. C
  690.       END
  691.  
  692.  
  693.  
  694.  

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