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

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