Télécharger la plaquette Cast3M


fr en

Télécharger tufpla.eso

Retour à la liste

Numérotation des lignes : 

tufpla

  1. C TUFPLA    SOURCE    BP208322  17/03/01    21:18:34     9325           
  2.       SUBROUTINE TUFPLA(WRK1,WRK0,WRK2,WTRAV,MAPL,PRECIS,
  3.      1     NSTRS,CMATE,N2EL,N2PTEL,MFR,IFOU,IB,
  4.      2     IGAU,EPAIST,MELE,NPINT,NBGMAT,NELMAT,
  5.      3     NBPGAU,SECT,LHOOK,CRIGI,KERRE)
  6. *
  7.       IMPLICIT INTEGER(I-N)
  8.       IMPLICIT REAL*8(A-H,O-Z)
  9. C----------------------------------------------------------------------
  10. C             PLASTICITE TUYAU FISSURE
  11. C    CE SOUS PROGRAMME EST APPELE PAR PLAST
  12. C
  13. C ENTREES
  14. C     SIG0(NSTRS) = CONTRAINTES INITIALES
  15. C     NSTRS       = NOMBRE DE CONTRAINTES
  16. C     DEPST(NSTRS)= INCREMENT DE CONTRAINTES TOTALES
  17. C     VAR0(NVARI) =  VARIABLES INTERNES   DEBUT
  18. C     NVARI       = NOMBRE DE VARIABLES INTERNES
  19. C     XMAT(NCXMAT)=  COMPOSANTES DE MATERIAU
  20. C     NCOMAT      = NOMBRE DE COMPOSANTES DE MATERIAU
  21. C     XCAR(ICARA) =  CARACTERISTIQUES
  22. C     ICARA       = NOMBRE DE CARACTERISTIQUES
  23. C     MAPL        = NUMERO DU MATERIAU PLASTIQUE
  24. C     NPOITR      =   NOMBRE DE POINT SUR LA COURBE DE TRACTION
  25. C     PRECIS      =   PRECISION DES ITERATIONS
  26. *     CMATE = NOM DU MATERIAU
  27. *     N2EL  = NBRE D ELEMENTS DANS SEGMENT DE HOOKE
  28. *     N2PTEL= NBRE DE POINTS DANS SEGMENT DE HOOKE
  29. *     MFR   = NUMERO DE LA FORMULATION
  30. *     IFOU  = OPTION DE CALCUL
  31. *     IB    = NUMERO DE L ELEMENT COURANT
  32. *     IGAU  = NUMERO DU POINT COURANT
  33. *     EPAIST= EPAISSEUR
  34. *     NBPGAU= NBRE DE POINTS DE GAUSS
  35. *     MELE  = NUMERO DE L ELEMENT FINI
  36. *     NPINT = NBRE DE POINTS D INTEGRATION
  37. *     NBGMAT= NBRE DE POINTS DANS SEGMENT DE CARACTERISTIQUES
  38. *     NELMAT= NBRE D ELEMENTS DANS SEGMENT DE CARACTERISTIQUES
  39. *     SECT  = SECTION
  40. *     LHOOK = TAILLE DE LA MATRICE DE HOOKE
  41. *
  42. C  SORTIES
  43. C     SIGF(NSTRS)   = CONTRAINTES FINALES
  44. C     VARF(NVARI)   = VARIABLES INTERNES FINALES
  45. C     DEFP(NSTRS)   = DEFORMATIONS PLASTIQUES
  46. C     KERRE   = 0    TOUT OK
  47. C        1   SI DLAMBDA NEGATIF
  48. C        2   NOMBRE MAX D ITERATIONS INTERNES DEPASSE
  49. C       21   ON NE TROUVE PAS L INTERSECTION AVEC LA SRFCE DE CHRG
  50. C       22   SIG0 A L EXTERIEUR DE LA SURFACE DE CHARGE
  51. C       30   LIMITE ELASTIQUE NULLE
  52. C       34   MODULE D YOUNG NUL
  53. C       75   SORTIE DE LA COURBE DE TRACTION
  54. C-----------------------------------------------------------------------
  55. -INC CCREEL
  56. *-
  57.  
  58. -INC PPARAM
  59. -INC CCOPTIO
  60. -INC SMEVOLL
  61. -INC SMLREEL
  62.       SEGMENT/WRK0/(XMAT(NCXMAT)*D)
  63.       SEGMENT/WRK1/(DDHOOK(LHOOK,LHOOK)*D,SIG0(NSTRS)*D,
  64.      .     DEPST(NSTRS)*D,SIGF(NSTRS)*D,VAR0(NVARI)*D,
  65.      .     VARF(NVARI)*D,DEFP(NSTRS)*D,XCAR(ICARA)*D)
  66.       SEGMENT/WRK2/(TRAC(LTRAC)*D)
  67.       SEGMENT/WORK/(SIG(NCOURB)*D,XLAM(NCOURB)*D)
  68.       SEGMENT/WTRAV/(DDAUX(LHOOK,LHOOK)*D,VALMAT(NUMAT)*D,
  69.      .     VALCAR(NUCAR)*D,DSIGT(NSTRS)*D,TXR(IDIM,IDIM)*D,
  70.      .     DDHOMU(LHOOK,LHOOK)*D,XLOC(3,3)*D,XGLOB(3,3)*D,
  71.      .     D1HOOK(LHOOK,LHOOK)*D,ROTHOO(LHOOK,LHOOK)*D)
  72.       DIMENSION DTUFI(2,2),CTUFI(2,2),CRIGI(12)
  73.       CHARACTER*8 CMATE
  74. C
  75.       KERRE=0
  76.       NSTRS=SIG0(/1)
  77.       NVARI=VAR0(/1)
  78. C
  79. C   ON RECUPERE LES CONSTANTES
  80. C
  81.       EPAI=XCAR(2)
  82.       RAYOM=XCAR(1)-EPAI/2.D0
  83.       THETA0=XCAR(9)*XPI/360.D0
  84. C
  85. C   A PARTIR DE LA COURBE DE TRACTION , ON CONSTRUIT  (SIG0,PHIP)
  86. C
  87.       YOUN=XMAT(1)
  88.       JDA=nint(XMAT(6))
  89.       IF(MAPL.EQ.14) THEN
  90. CCC   CAS DE LA PLASTICITE PARFAITE
  91.          IF(XMAT(5).EQ.XZERO) THEN
  92.             KERRE=30
  93.             RETURN
  94.          ENDIF
  95.          NCOURB=2
  96.          TRAC(1)=XMAT(5)
  97.          TRAC(2)=XZERO
  98.          TRAC(3)=XMAT(5)
  99.          TRAC(4)=1.D0
  100.       ELSE
  101.          IF(MAPL.EQ.18) THEN
  102. CCC   CAS DE LA PLASTICITE AVEC ECROUISSAGE
  103. C
  104. C  ON CALCULE LA COMPLAISANCE CMM ET ON REMPLIT XMAT(1)=CMM POUR VERIF
  105. C   PENTE A L ORIGINE DE LA COURBE (M,PHI)
  106. C
  107.             CALL TUFIHO(THETA0,DTUFI,CTUFI,YOUN,RAYOM,EPAI)
  108.             CMM=CTUFI(1,1)
  109.             XMAT(1)=1.D0/CMM
  110.             CALL COTRAC(WRK0,WRK2,NCOURB,KERRE)
  111.             IF(KERRE.NE.0) RETURN
  112.          ENDIF
  113.          XMAT(1)=YOUN
  114.          PMOMM=TRAC(2*NCOURB-1)
  115.          IF(PMOMM.EQ.0.D0) THEN
  116.             KERRE=30
  117.             RETURN
  118.          ENDIF
  119. C
  120. C  ON CALCULE SIG0 POUR LE MOMENT MAXI
  121. C
  122.          XM0SS0=4.D0*RAYOM*RAYOM*EPAI
  123.          XMT0=COS(THETA0/2.D0)-0.5D0*SIN(THETA0)
  124.          VSIG0=PMOMM/XM0SS0/XMT0
  125.          DO 100 I=1,NCOURB
  126.             TRAC(2*I-1)=(TRAC(2*I-1)/PMOMM)*VSIG0
  127.  100     CONTINUE
  128.       ENDIF
  129. C
  130. C   REMPLISSAGE DE LA COURBE DE (SIG0,PHIP)
  131. C
  132.       SEGINI WORK
  133.       DO 2 I=1,NCOURB
  134.          SIG(I)=TRAC(2*I-1)
  135.          XLAM(I)=TRAC(2*I)
  136.  2    CONTINUE
  137. C
  138. C   ON RECUPERE LES VARIABLES INTERNES
  139. C
  140.       XM0SS0=4.D0*RAYOM*RAYOM*EPAI
  141.       XP0SS0=2.D0*XPI*RAYOM*EPAI
  142.       XJ1C=XMAT(6)
  143.       T=XMAT(7)
  144.       XLAM0=VAR0(5)
  145.       THETA=VAR0(3)*XPI/360.D0
  146.       XJP=VAR0(4)
  147. C   CORRECTION DE L INITIALISATION FAITE PAR L OPERATEUR ZERO
  148.       IF (THETA.LT.THETA0) THETA=THETA0
  149. C
  150. C    CALCUL DE  L INCREMENT DE CONTRAINTES
  151. C
  152.       CALL CALSIG(DEPST,DDAUX,NSTRS,CMATE,VALMAT,VALCAR,
  153.      1     N2EL,N2PTEL,MFR,IFOU,IB,IGAU,EPAIST,NBPGAU,
  154.      2     MELE,NPINT,NBGMAT,NELMAT,SECT,LHOOK,TXR,XLOC,
  155.      3     XGLOB,D1HOOK,ROTHOO,DDHOMU,CRIGI,DSIGT,IRTD)
  156. *
  157.       IF(IRTD.NE.1) THEN
  158.          KERRE=69
  159.          GOTO 998
  160.       ENDIF
  161. *
  162. C
  163. C    ON RECUPERE LES CONTRAINTES ET L INCREMENT
  164. C
  165.       XM=-SIG0(6)
  166.       XP=SIG0(1)
  167. CCC   POUR LE CHARGEMENT M N , ON VERIFIE QUE L ON EST BIEN DANS
  168. C              LA SURFACE DE CHARGE
  169.       CRI=2.D0*XP0SS0*(1.D0-THETA0/XPI)*XM
  170.       CRI=CRI+XM0SS0*SIN(THETA0)*XP
  171.       IBI=0
  172.       CALL TRACTI(SIGMA0,XLAM0,SIG,XLAM,NCOURB,2,IBI)
  173.       IF(IBI.EQ.1) THEN
  174.         KERRE=75
  175.         GO TO 998
  176.       ENDIF
  177.       XM0=XM0SS0*SIGMA0
  178.       XP0=XP0SS0*SIGMA0
  179.       F=CRIT1(XM,XP,THETA0,XM0,XP0)
  180.       IF(F.GE.PRECIS) THEN
  181.          KERRE=22
  182.          GO TO 998
  183.       ENDIF
  184.       DELTAM=-DSIGT(6)
  185.       DELTAP=DSIGT(1)
  186. C
  187. C   ON REMPLIT POUR LE CAS ELASTIQUE
  188. C
  189.       DO 10 I=1,NSTRS
  190.          SIGF(I)=SIG0(I)+DSIGT(I)
  191.          DEFP(I)=0.D0
  192.          DSIGT(I)=0.D0
  193.  10   CONTINUE
  194.       DO 11 J=1,NVARI
  195.          VARF(J)=VAR0(J)
  196.  11   CONTINUE
  197. C
  198. C    ON TESTE LE CAS A TRAITER
  199. C
  200.  1    CONTINUE
  201.       XM1=XM+DELTAM
  202.       XP1=XP+DELTAP
  203.       CRI=2.D0*XP0SS0*(1.D0-THETA0/XPI)*XM1
  204.       CRI=CRI+XM0SS0*SIN(THETA0)*XP1
  205.       CALL TUFIJE(XM1,XP1,THETA0,XJE,RAYOM,EPAI,YOUN)
  206.       CALL TUFIC1(XM1,XP1,THETA0,IR1,PRECIS,XM0,XP0)
  207.       IF (MAPL.EQ.14) THEN
  208. C
  209. C DANS LE CAS DE LA PLASTICITE PARFAITE ON NE FAIT QUE DE LA PLASTICITE
  210. C
  211.          CALL TUFIC2(XJP,XJE,THETA,IR2,PRECIS,XJ1C,T,RAYOM,THETA0)
  212.       ELSE
  213.          IF (MAPL.EQ.18) THEN
  214.             IR2=0
  215.          ENDIF
  216.       ENDIF
  217.       IF(IIMPI.EQ.999)THEN
  218.          IF(IR1.EQ.1)WRITE(IOIMP,*)'PLASTICITE'
  219.          IF(IR2.EQ.1)WRITE(IOIMP,*)'ENDOMMAGEMENT'
  220.          IF((IR1.EQ.0).AND.(IR2.EQ.0))WRITE(IOIMP,*)'NI PLAST NI ENDO'
  221.       ENDIF
  222. C
  223.       IF((IR1.EQ.0).AND.(IR2.EQ.0)) GO TO 998
  224.       IF((IR1.EQ.0).AND.(IR2.EQ.1)) GO TO 2000
  225.       IF((IR1.EQ.1).AND.(IR2.EQ.0)) GO TO 3000
  226.       IF((IR1.EQ.1).AND.(IR2.EQ.1)) GO TO 4000
  227. C
  228. C    CAS DE LA PROPAGATION EN ELASTIQUE
  229. C
  230.  2000 CONTINUE
  231.       CALL TUFIEN(XM,XP,DELTAM,DELTAP,THETA,XJP,PRECIS,THETA0,XM0,
  232.      &     XP0,XJ1C,T,RAYOM,EPAI,YOUN)
  233.       IF(KERRE.NE.0) GO TO 998
  234.       SIGF(6)=-XM
  235.       SIGF(1)=XP
  236.       VARF(3)=THETA*360.D0/XPI
  237.       IF((DELTAM.EQ.XZERO).AND.(DELTAP.EQ.XZERO)) GO TO 998
  238.       GO TO 1
  239. C
  240. C    CAS DE LA PLASTICITE AVEC PROPAGATION
  241. C
  242.  3000 CONTINUE
  243. C
  244. C     ON CHERCHE L INTERSECTION AVEC LA SURFACE DE CHARGE
  245. C
  246.       VER=F
  247.       IF(IIMPI.EQ.999)WRITE (IOIMP,*) 'VERIF AVANT APPEL A TUFICO',VER
  248.       PRECUS=-PRECIS
  249.       IF(VER.LE.PRECUS) THEN
  250.          CALL TUFICO(XM,XP,DELTAM,DELTAP,THETA0,XM0,XP0)
  251.          IF(IIMPI.EQ.999)THEN
  252.             VER=F
  253.             WRITE (IOIMP,*)'ON EST SUR LE CRITERE',VER
  254.          ENDIF
  255.       ENDIF
  256. C
  257. C     ON REALISE L ECOULEMENT
  258. C
  259.       CALL TUFIPL(XM,XP,DELTAM,DELTAP,THETA,XJP,DLAM1,DLAM2,EP,FIP,
  260.      $     PRECIS,XM0,XP0,RAYOM,XLAM0,WORK,XJ1C,T,THETA0,EPAI,YOUN,KERRE
  261.      $     ,MAPL)
  262.       IF(KERRE.NE.0) GO TO 998
  263. C
  264.       IF(IIMPI.EQ.999)THEN
  265.          VER=CRIT1(XM,XP,THETA0,XM0,XP0)
  266.          WRITE (IOIMP,*) 'VERIF APRES ECOULEMENT',VER
  267.       ENDIF
  268.       CALL TUFK1A(XM,XP,YOUN,RAYOM,EPAI,THETA0,XK1,AIRE)
  269.       IF (MAPL.EQ.18) THEN
  270. C
  271. CDANS LE CAS DE LA PLASTICITE AVEC ECROUISSAGE ON FAIT DE LA PROPAGATION
  272. C
  273.         CALL TUFJDA(THETA,XJP,RAYOM,JDA,THETA0,XK1,YOUN,KERRE)
  274.         IF(KERRE.NE.0) GO TO 998
  275.       ENDIF
  276.       SIGF(6)=-XM
  277.       SIGF(1)=XP
  278.       SIGF(7)=XK1
  279.       SIGF(8)=AIRE
  280.       DEFP(6)=DEFP(6)-FIP
  281.       DEFP(1)=DEFP(1)+EP
  282.       VARF(1)=VARF(1)+DLAM1
  283.       VARF(2)=VARF(2)+DLAM2
  284.       VARF(3)=(THETA*360.D0)/XPI
  285.       VARF(4)=XJP
  286.       VARF(5)=VARF(5)+DLAM1+DLAM2
  287. C     IF((DELTAM.EQ.XZERO).AND.(DELTAP.EQ.XZERO)) GO TO 998
  288. C     GO TO 1
  289. C
  290. C    CAS DU COUPLAGE PLASTICITE PROPAGATION
  291. C
  292.  4000 GO TO 998
  293.  998  CONTINUE
  294.       SEGSUP WORK
  295.       RETURN
  296.       END
  297.  
  298.  
  299.  
  300.  
  301.  
  302.  
  303.  
  304.  
  305.  

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