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    PASCAL    19/07/26    21:15:11     10198          
  2.       SUBROUTINE CTUFPL(WRK52,WRK53,WRK54,WRK2,
  3.      1     IFOU,IB,IGAU,NBPGAU,iecou)
  4. C TUFPLA    SOURCE    KICH      98/07/01    00:32:42     3239
  5. c      SUBROUTINE TUFPLA(WRK1,WRK0,WRK2,WTRAV,MAPL,PRECIS,
  6. c     1     NSTRS,CMATE,N2EL,N2PTEL,MFR,IFOU,IB,
  7. c     2     IGAU,EPAIST,MELE,NPINT,NBGMAT,NELMAT,
  8. c     3     NBPGAU,SECT,LHOOK,CRIGI,KERRE)
  9. *
  10.       IMPLICIT INTEGER(I-N)
  11.       IMPLICIT REAL*8(A-H,O-Z)
  12. C----------------------------------------------------------------------
  13. C             PLASTICITE TUYAU FISSURE
  14. C    CE SOUS PROGRAMME EST APPELE PAR PLAST
  15. C
  16. C ENTREES
  17. C     SIG0(NSTRS1) = CONTRAINTES INITIALES
  18. C     NSTRS1       = NOMBRE DE CONTRAINTES
  19. C     DEPST(NSTRS1)= INCREMENT DE CONTRAINTES TOTALES
  20. C     VAR0(NVARI) =  VARIABLES INTERNES   DEBUT
  21. C     NVARI       = NOMBRE DE VARIABLES INTERNES
  22. C     XMAT(NCXMAT)=  COMPOSANTES DE MATERIAU
  23. C     NCOMAT      = NOMBRE DE COMPOSANTES DE MATERIAU
  24. C     xcarb(ICARA) =  CARACTERISTIQUES
  25. C     ICARA       = NOMBRE DE CARACTERISTIQUES
  26. C     MAPL        = NUMERO DU MATERIAU PLASTIQUE
  27. C     NPOITR      =   NOMBRE DE POINT SUR LA COURBE DE TRACTION
  28. C     PRECIS      =   PRECISION DES ITERATIONS
  29. *     CMATE = NOM DU MATERIAU
  30. *     N2EL  = NBRE D ELEMENTS DANS SEGMENT DE HOOKE
  31. *     N2PTEL= NBRE DE POINTS DANS SEGMENT DE HOOKE
  32. *     MFR1  = NUMERO DE LA FORMULATION
  33. *     IFOU  = OPTION DE CALCUL
  34. *     IB    = NUMERO DE L ELEMENT COURANT
  35. *     IGAU  = NUMERO DU POINT COURANT
  36. *     EPAIST= EPAISSEUR
  37. *     NBPGAU= NBRE DE POINTS DE GAUSS
  38. *     MELE  = NUMERO DE L ELEMENT FINI
  39. *     NPINT = NBRE DE POINTS D INTEGRATION
  40. *     NBGMAT= NBRE DE POINTS DANS SEGMENT DE CARACTERISTIQUES
  41. *     NELMAT= NBRE D ELEMENTS DANS SEGMENT DE CARACTERISTIQUES
  42. *     SECT  = SECTION
  43. *     LHOOK = TAILLE DE LA MATRICE DE HOOKE
  44. *
  45. C  SORTIES
  46. C     SIGF(NSTRS1)   = CONTRAINTES FINALES
  47. C     VARF(NVARI)   = VARIABLES INTERNES FINALES
  48. C     DEFP(NSTRS1)   = DEFORMATIONS PLASTIQUES
  49. C     KERRE   = 0    TOUT OK
  50. C        1   SI DLAMBDA NEGATIF
  51. C        2   NOMBRE MAX D ITERATIONS INTERNES DEPASSE
  52. C       21   ON NE TROUVE PAS L INTERSECTION AVEC LA SRFCE DE CHRG
  53. C       22   SIG0 A L EXTERIEUR DE LA SURFACE DE CHARGE
  54. C       30   LIMITE ELASTIQUE NULLE
  55. C       34   MODULE D YOUNG NUL
  56. C       75   SORTIE DE LA COURBE DE TRACTION
  57. C-----------------------------------------------------------------------
  58. -INC CCREEL
  59. *-
  60.  
  61. -INC PPARAM
  62. -INC CCOPTIO
  63. -INC SMEVOLL
  64. -INC SMLREEL
  65. -INC DECHE
  66.        SEGMENT IECOU
  67. *      COMMON/IECOU/NYOG,NYNU,NYALFA,NYSMAX,NYN,NYM,NYKK,
  68.        INTEGER icow1,icow2,icow3,icow4,icow5,icow6,icow7,
  69. C      INTEGER NYOG, NYNU, NYALFA,NYSMAX,NYN, NYM,  NYKK,
  70.      1  icow8,icow9,icow10,icow11,icow12,icow13,icow14,icow15,icow16,
  71. C    .  NYALF1,NYBET1,NYR,  NYA,   NYRHO,NSIGY,  NNKX,  NYKX,  IND,
  72.      2 icow17,icow18,icow19,icow20,icow21,icow22,icow23,icow24,
  73. C    .  NSOM,  NINV, NINCMA,NCOMP, JELEM, LEGAUS,INAT,  NCXMAT,
  74.      3 icow25,icow26,icow27,icow28,icow29,icow30,icow31,
  75. C    .  LTRAC, MFR,  IELE,  NHRM,   NBNN, NBELEM,ICARA,
  76.      4  icow32,icow33,NSTRS1,MFR1,NBGMAT,NELMAT,icow38,
  77. C    .  LW2,   NDEF,  NSTRSS,MFR1,  NBGMAT,NELMAT,MSOUPA,
  78.      5  icow39,icow40,icow41,icow42,icow43,icow44
  79. C    .  NUMAT1,LENDO, NBBB,  NNVARI,KERR1, MELEME
  80.         INTEGER icow45,icow46,icow47,icow48,icow49,icow50,
  81.      .          icow51,icow52,icow53,icow54,icow55,icow56
  82.      .          icow57,icow58
  83.       ENDSEGMENT
  84.       SEGMENT/WRK2/(TRAC(LTRAC)*D)
  85.       SEGMENT/WORK/(SIG(NCOURB)*D,XLAM(NCOURB)*D)
  86.       DIMENSION DTUFI(2,2),CTUFI(2,2),CRIGI(12)
  87. C
  88.       MAPL = INPLAS
  89.       KERRE=0
  90.       NSTRS1=SIG0(/1)
  91.       NVARI=VAR0(/1)
  92. C
  93. C   ON RECUPERE LES CONSTANTES
  94. C
  95.       EPAI=xcarb(2)
  96.       RAYOM=xcarb(1)-EPAI/2.D0
  97.       THETA0=xcarb(9)*XPI/360.D0
  98. C
  99. C   A PARTIR DE LA COURBE DE TRACTION , ON CONSTRUIT  (SIG0,PHIP)
  100. C
  101.       YOUN=XMAT(1)
  102.       JDA=nint(XMAT(6))
  103.       IF(MAPL.EQ.14) THEN
  104. CCC   CAS DE LA PLASTICITE PARFAITE
  105.          IF(XMAT(5).EQ.XZERO) THEN
  106.             KERRE=30
  107.             RETURN
  108.          ENDIF
  109.          NCOURB=2
  110.          TRAC(1)=XMAT(5)
  111.          TRAC(2)=XZERO
  112.          TRAC(3)=XMAT(5)
  113.          TRAC(4)=1.D0
  114.       ELSE
  115.          IF(MAPL.EQ.18) THEN
  116. CCC   CAS DE LA PLASTICITE AVEC ECROUISSAGE
  117. C
  118. C  ON CALCULE LA COMPLAISANCE CMM ET ON REMPLIT XMAT(1)=CMM POUR VERIF
  119. C   PENTE A L ORIGINE DE LA COURBE (M,PHI)
  120. C
  121.             CALL TUFIHO(THETA0,DTUFI,CTUFI,YOUN,RAYOM,EPAI)
  122.             CMM=CTUFI(1,1)
  123.             XMAT(1)=1.D0/CMM
  124. c            CALL COTRAC(WRK0,WRK2,NCOURB,KERRE)
  125.             call CCOTR4(WRK52,WRK2,NCOURB,WRK53)
  126.             IF(KERRE.NE.0) RETURN
  127.          ENDIF
  128.          XMAT(1)=YOUN
  129.          PMOMM=TRAC(2*NCOURB-1)
  130.          IF(PMOMM.EQ.0.D0) THEN
  131.             KERRE=30
  132.             RETURN
  133.          ENDIF
  134. C
  135. C  ON CALCULE SIG0 POUR LE MOMENT MAXI
  136. C
  137.          XM0SS0=4.D0*RAYOM*RAYOM*EPAI
  138.          XMT0=COS(THETA0/2.D0)-0.5D0*SIN(THETA0)
  139.          VSIG0=PMOMM/XM0SS0/XMT0
  140.          DO 100 I=1,NCOURB
  141.             TRAC(2*I-1)=(TRAC(2*I-1)/PMOMM)*VSIG0
  142.  100     CONTINUE
  143.       ENDIF
  144. C
  145. C   REMPLISSAGE DE LA COURBE DE (SIG0,PHIP)
  146. C
  147.       SEGINI WORK
  148.       DO 2 I=1,NCOURB
  149.          SIG(I)=TRAC(2*I-1)
  150.          XLAM(I)=TRAC(2*I)
  151.  2    CONTINUE
  152. C
  153. C   ON RECUPERE LES VARIABLES INTERNES
  154. C
  155.       XM0SS0=4.D0*RAYOM*RAYOM*EPAI
  156.       XP0SS0=2.D0*XPI*RAYOM*EPAI
  157.       XJ1C=XMAT(6)
  158.       T=XMAT(7)
  159.       XLAM0=VAR0(5)
  160.       THETA=VAR0(3)*XPI/360.D0
  161.       XJP=VAR0(4)
  162. C   CORRECTION DE L INITIALISATION FAITE PAR L OPERATEUR ZERO
  163.       IF (THETA.LT.THETA0) THETA=THETA0
  164. C
  165. C    CALCUL DE  L INCREMENT DE CONTRAINTES
  166. C
  167.       nstrbi=nstrs1
  168.       mfr1bi=mfr1
  169.       nbgmab=nbgmat
  170.       nlmatb=nelmat
  171.       CALL CALSIG(DEPST,DDAUX,NSTRbi,CMATE,VALMAT,VALCAR,
  172.      1     N2EL,N2PTEL,MFR1bi,IFOU,IB,IGAU,EPAIST,NBPGAU,
  173.      2     MELE,NPINT,NBGMAb,NLMATb,SECT,LHOOK,TXR,XLOC,
  174.      3     XGLOB,D1HOOK,ROTHOO,DDHOMU,CRIGI,DSIGT,IRTD)
  175.       nstrs1=nstrbi
  176.       mfr1=mfr1bi
  177.       nbgmat=nbgmab
  178.       nelmat=nlmatb
  179. *
  180.       IF(IRTD.NE.1) THEN
  181.          KERRE=69
  182.          GOTO 998
  183.       ENDIF
  184. *
  185. C
  186. C    ON RECUPERE LES CONTRAINTES ET L INCREMENT
  187. C
  188.       XM=-SIG0(6)
  189.       XP=SIG0(1)
  190. CCC   POUR LE CHARGEMENT M N , ON VERIFIE QUE L ON EST BIEN DANS
  191. C              LA SURFACE DE CHARGE
  192.       CRI=2.D0*XP0SS0*(1.D0-THETA0/XPI)*XM
  193.       CRI=CRI+XM0SS0*SIN(THETA0)*XP
  194.       IBI=0
  195.       CALL TRACTI(SIGMA0,XLAM0,SIG,XLAM,NCOURB,2,IBI)
  196.       IF(IBI.EQ.1) THEN
  197.         KERRE=75
  198.         GO TO 998
  199.       ENDIF
  200.       XM0=XM0SS0*SIGMA0
  201.       XP0=XP0SS0*SIGMA0
  202.       F=CRIT1(XM,XP,THETA0,XM0,XP0)
  203.       IF(F.GE.PRECIS) THEN
  204.          KERRE=22
  205.          GO TO 998
  206.       ENDIF
  207.       DELTAM=-DSIGT(6)
  208.       DELTAP=DSIGT(1)
  209. C
  210. C   ON REMPLIT POUR LE CAS ELASTIQUE
  211. C
  212.       DO 10 I=1,NSTRS1
  213.          SIGF(I)=SIG0(I)+DSIGT(I)
  214.          DEFP(I)=0.D0
  215.          DSIGT(I)=0.D0
  216.  10   CONTINUE
  217.       DO 11 J=1,NVARI
  218.          VARF(J)=VAR0(J)
  219.  11   CONTINUE
  220. C
  221. C    ON TESTE LE CAS A TRAITER
  222. C
  223.  1    CONTINUE
  224.       XM1=XM+DELTAM
  225.       XP1=XP+DELTAP
  226.       CRI=2.D0*XP0SS0*(1.D0-THETA0/XPI)*XM1
  227.       CRI=CRI+XM0SS0*SIN(THETA0)*XP1
  228.       CALL TUFIJE(XM1,XP1,THETA0,XJE,RAYOM,EPAI,YOUN)
  229.       CALL TUFIC1(XM1,XP1,THETA0,IR1,PRECIS,XM0,XP0)
  230.       IF (MAPL.EQ.14) THEN
  231. C
  232. C DANS LE CAS DE LA PLASTICITE PARFAITE ON NE FAIT QUE DE LA PLASTICITE
  233. C
  234.          CALL TUFIC2(XJP,XJE,THETA,IR2,PRECIS,XJ1C,T,RAYOM,THETA0)
  235.       ELSE
  236.          IF (MAPL.EQ.18) THEN
  237.             IR2=0
  238.          ENDIF
  239.       ENDIF
  240.       IF(IIMPI.EQ.999)THEN
  241.          IF(IR1.EQ.1)WRITE(IOIMP,*)'PLASTICITE'
  242.          IF(IR2.EQ.1)WRITE(IOIMP,*)'ENDOMMAGEMENT'
  243.          IF((IR1.EQ.0).AND.(IR2.EQ.0))WRITE(IOIMP,*)'NI PLAST NI ENDO'
  244.       ENDIF
  245. C
  246.       IF((IR1.EQ.0).AND.(IR2.EQ.0)) GO TO 998
  247.       IF((IR1.EQ.0).AND.(IR2.EQ.1)) GO TO 2000
  248.       IF((IR1.EQ.1).AND.(IR2.EQ.0)) GO TO 3000
  249.       IF((IR1.EQ.1).AND.(IR2.EQ.1)) GO TO 4000
  250. C
  251. C    CAS DE LA PROPAGATION EN ELASTIQUE
  252. C
  253.  2000 CONTINUE
  254.       CALL TUFIEN(XM,XP,DELTAM,DELTAP,THETA,XJP,PRECIS,THETA0,XM0,
  255.      &     XP0,XJ1C,T,RAYOM,EPAI,YOUN)
  256.       IF(KERRE.NE.0) GO TO 998
  257.       SIGF(6)=-XM
  258.       SIGF(1)=XP
  259.       VARF(3)=THETA*360.D0/XPI
  260.       IF((DELTAM.EQ.XZERO).AND.(DELTAP.EQ.XZERO)) GO TO 998
  261.       GO TO 1
  262. C
  263. C    CAS DE LA PLASTICITE AVEC PROPAGATION
  264. C
  265.  3000 CONTINUE
  266. C
  267. C     ON CHERCHE L INTERSECTION AVEC LA SURFACE DE CHARGE
  268. C
  269.       VER=F
  270.       IF(IIMPI.EQ.999)WRITE (IOIMP,*) 'VERIF AVANT APPEL A TUFICO',VER
  271.       PRECUS=-PRECIS
  272.       IF(VER.LE.PRECUS) THEN
  273.          CALL TUFICO(XM,XP,DELTAM,DELTAP,THETA0,XM0,XP0)
  274.          IF(IIMPI.EQ.999)THEN
  275.             VER=F
  276.             WRITE (IOIMP,*)'ON EST SUR LE CRITERE',VER
  277.          ENDIF
  278.       ENDIF
  279. C
  280. C     ON REALISE L ECOULEMENT
  281. C
  282.       CALL TUFIPL(XM,XP,DELTAM,DELTAP,THETA,XJP,DLAM1,DLAM2,EP,FIP,
  283.      $     PRECIS,XM0,XP0,RAYOM,XLAM0,WORK,XJ1C,T,THETA0,EPAI,YOUN,KERRE
  284.      $     ,MAPL)
  285.       IF(KERRE.NE.0) GO TO 998
  286. C
  287.       IF(IIMPI.EQ.999)THEN
  288.          VER=CRIT1(XM,XP,THETA0,XM0,XP0)
  289.          WRITE (IOIMP,*) 'VERIF APRES ECOULEMENT',VER
  290.       ENDIF
  291.       CALL TUFK1A(XM,XP,YOUN,RAYOM,EPAI,THETA0,XK1,AIRE)
  292.       IF (MAPL.EQ.18) THEN
  293. C
  294. CDANS LE CAS DE LA PLASTICITE AVEC ECROUISSAGE ON FAIT DE LA PROPAGATION
  295. C
  296.         CALL TUFJDA(THETA,XJP,RAYOM,JDA,THETA0,XK1,YOUN,KERRE2)
  297.          KERRE = KERRE2
  298.         IF(KERRE.NE.0) GO TO 998
  299.       ENDIF
  300.       SIGF(6)=-XM
  301.       SIGF(1)=XP
  302.       SIGF(7)=XK1
  303.       SIGF(8)=AIRE
  304.       DEFP(6)=DEFP(6)-FIP
  305.       DEFP(1)=DEFP(1)+EP
  306.       VARF(1)=VARF(1)+DLAM1
  307.       VARF(2)=VARF(2)+DLAM2
  308.       VARF(3)=(THETA*360.D0)/XPI
  309.       VARF(4)=XJP
  310.       VARF(5)=VARF(5)+DLAM1+DLAM2
  311. C     IF((DELTAM.EQ.XZERO).AND.(DELTAP.EQ.XZERO)) GO TO 998
  312. C     GO TO 1
  313. C
  314. C    CAS DU COUPLAGE PLASTICITE PROPAGATION
  315. C
  316.  4000 GO TO 998
  317.  998  CONTINUE
  318.       SEGSUP WORK
  319.       RETURN
  320.       END
  321.  
  322.  
  323.  
  324.  
  325.  
  326.  
  327.  
  328.  
  329.  
  330.  
  331.  
  332.  
  333.  
  334.  
  335.  
  336.  
  337.  
  338.  
  339.  
  340.  

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