Télécharger la plaquette Cast3M


fr en

Télécharger ctufpl.eso

Retour à la liste

Numérotation des lignes : 

ctufpl

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

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