Télécharger la plaquette Cast3M


fr en

Télécharger ubiqui.eso

Retour à la liste

Numérotation des lignes : 

ubiqui

  1. C UBIQUI    SOURCE    OF166741  25/11/04    21:16:10     12349          
  2.       SUBROUTINE UBIQUI(DDAUX,CMATE,VALMAT,VALCAR,N2EL,N2PTEL,
  3.      1 IB,IGAU,EPAIST,MELE,NPINT,SECT,LHOOK,TXR,XLOC,
  4.      2 XGLOB,D1HOOK,ROTHOO,DDHOMU,CRIGI,SIG0,DEPST,VAR0,XMAT,
  5.      3           NBPGAU,NCOMAT,XCAR,DSIGT,SIGF,VARF,DEFP,KERRE
  6.      4, ecou,necou,iecou)
  7.  
  8. C----------------------------------------------------------------------
  9. C             PLASTICITE MODELE UBIQUITOUS
  10. C
  11. C ENTREES
  12. C     SIG0(NSTRS) = CONTRAINTES INITIALES
  13. C     NSTRS       = NOMBRE DE CONTRAINTES
  14. C     DEPST(NSTRS)= INCREMENT DE DEFORMATIONS TOTALES
  15. C     VAR0(NVARI) =  VARIABLES INTERNES   DEBUT
  16. C         (  1  ) = EPSE
  17. C         (  2  ) = EPN1
  18. C         (  3  ) = GAP1
  19. C         (  4  ) = LAM1
  20. C         (  5  ) = EPN2
  21. C         (  6  ) = GAP2
  22. C         (  7  ) = LAM2
  23. C     XMAT(NCOMAT)=  COMPOSANTES DE MATERIAU
  24. C     NCOMAT      = NOMBRE DE COMPOSANTES DE MATERIAU
  25. C     XCAR(ICARA) =  CARACTERISTIQUES
  26. *     CMATE = NOM DU MATERIAU
  27. *     VALMAT= TABLEAU DE CARACTERISTIQUES DU MATERIAU
  28. *     VALCAR= TABLEAU DE CARACTERISTIQUES GEOMETRIQUES
  29. *     N2EL  = NBRE D ELEMENTS DANS SEGMENT DE HOOKE
  30. *     N2PTEL= NBRE DE POINTS DANS SEGMENT DE HOOKE
  31. *     MFRb  = NUMERO DE LA FORMULATION
  32. *     IFOU  = OPTION DE CALCUL
  33. *     IB    = NUMERO DE L ELEMENT COURANT
  34. *     IGAU  = NUMERO DU POINT COURANT
  35. *     EPAIST= EPAISSEUR
  36. *     NBPGAU= NBRE DE POINTS DE GAUSS
  37. *     MELE  = NUMERO DE L ELEMENT FINI
  38. *     NPINT = NBRE DE POINTS D INTEGRATION
  39. *     NBGMAT= NBRE DE POINTS DANS SEGMENT DE CARACTERISTIQUES
  40. *     NELMAT= NBRE D ELEMENTS DANS SEGMENT DE CARACTERISTIQUES
  41. *     SECT  = SECTION
  42. *     LHOOK = TAILLE DE LA MATRICE DE HOOKE
  43. *     TXR,XLOC,XGLOB,D1HOOK,ROTHOO,DDHOMU,CRIGI = TABLEAUX UTILISES
  44. *     UTILISES POUR LE CALCUL DE LA MATRICE DE HOOKE
  45. *
  46. C  SORTIES
  47. C     SIGF(NSTRS)   = CONTRAINTES FINALES
  48. C     VARF(NVARI)   = VARIABLES INTERNES FINALES
  49. C     DEFP(NSTRS)   = DEFORMATIONS PLASTIQUES
  50. C     KERRE   = 0    TOUT OK
  51. C        1   SI DLAMBDA NEGATIF
  52. C        2   NOMBRE MAX D ITERATIONS INTERNES DEPASSE
  53. C       21   ON NE TROUVE PAS L INTERSECTION AVEC LA SURFACE DE CHARGE
  54. C       22   SIG0 A L EXTERIEUR DE LA SURFACE DE CHARGE
  55. C
  56. C-----------------------------------------------------------------------
  57.  
  58.       IMPLICIT INTEGER(I-N)
  59.       IMPLICIT REAL*8(A-H,O-Z)
  60.  
  61. -INC PPARAM
  62. -INC CCOPTIO
  63.  
  64. -INC TECOU
  65.  
  66.       DIMENSION SIG0(*),DEPST(*),VAR0(*),XMAT(*),XCAR(*)
  67.       DIMENSION SIGF(*),VARF(*),DEFP(*)
  68.       DIMENSION SIGMA(6),DSIGMA(6),SIGFIN(6)
  69.       DIMENSION XLAMBD(6),DEFPLA(6),DSIGT(*)
  70.       DIMENSION SPHER(6),AUXIL(6),DSIGZE(6)
  71.       DIMENSION VALMAT(*),VALCAR(*)
  72.       DIMENSION TXR(IDIM,*),CRIGI(12)
  73.       DIMENSION DDAUX(LHOOK,*),DDHOMU(LHOOK,*)
  74.       DIMENSION XLOC(3,3),XGLOB(3,3)
  75.       DIMENSION D1HOOK(LHOOK,*),ROTHOO(LHOOK,*)
  76.       CHARACTER*(*) CMATE
  77.  
  78.       PARAMETER (UNIT=0.0174532925199432957692D0)
  79.  
  80.       KERRE = 0
  81.  
  82.       iforb  = necou.ifourb
  83.       nstrs  = iecou.nstrss
  84.       mfrb   = iecou.mfr1
  85.       nbgmab = iecou.nbgmat
  86.       nematb = iecou.nelmat
  87.  
  88. C -----------------------------------------------------------
  89. C ON SE LIMITE AUX DEFORMATIONS PLANES , CONTRAINTES PLANES
  90. C ET AXISYMETRIQUE
  91. C------------------------------------------------------------
  92.       IF (iforb.GT.0) THEN
  93.         KERRE=539
  94.         RETURN
  95.       ENDIF
  96. C
  97. C TEST DE CONSISTANCE DES DONNEES
  98. C
  99.       IF (IIMPI.EQ.28) WRITE(IOIMP,3000) (XMAT(I),I=1,13)
  100.       DO I=1,NCOMAT
  101.         IF (XMAT(I).LT.0.D0) KERRE=538
  102.       ENDDO
  103.       IF (KERRE.EQ.538) RETURN
  104. C
  105.       TRA1=0.D0
  106.       PHI1=0.D0
  107.       PSI1=0.D0
  108.       COHE1=0.D0
  109.       TPHI1=0.D0
  110.       TPSI1=0.D0
  111.       HACHE1=0.D0
  112.       TRA2=0.D0
  113.       PHI2=0.D0
  114.       PSI2=0.D0
  115.       COHE2=0.D0
  116.       TPHI2=0.D0
  117.       TPSI2=0.D0
  118.       HACHE2=0.D0
  119.       CO21=0.D0
  120.       CO22=0.D0
  121.       SI21=0.D0
  122.       SI22=0.D0
  123. C
  124.       YOUN=XMAT(1)
  125.       XNU =XMAT(2)
  126.       NCRI= INT(XMAT(3))
  127.       ANG1=XMAT(4)
  128.       TRA1=XMAT(5)
  129.       PHI1=XMAT(6)
  130.       PSI1=XMAT(7)
  131.       RHO =XMAT(8)
  132.       ALPH=XMAT(9)
  133.       ANG2=XMAT(10)
  134.       TRA2=XMAT(11)
  135.       PHI2=XMAT(12)
  136.       PSI2=XMAT(13)
  137. C
  138. C  PETIT TEST SUR NU POUR CERTAINS CAS
  139. C
  140.       IF (MFRb.EQ.3 .AND. iforb.EQ.-2 .AND. XNU.NE.0.D0) THEN
  141.         KERRE=38
  142.         RETURN
  143.       ENDIF
  144. C
  145. C CALCUL ET TEST DES PARAMETRES DU MATERIAU UBIQUITOUS
  146. C
  147. C       TEST D'ERREUR SUR LE NOMBRE DE CRITERES
  148. C-----------------------------------------------
  149. C-------------------------------------------------------------
  150.       NCAS=2
  151.       IF (iforb.EQ.-2) NCAS=1
  152.  
  153.       IF (NCRI.NE.1.AND.NCRI.NE.2) THEN
  154.         KERRE=540
  155.         RETURN
  156.       ENDIF
  157. C----------------------------------------------------------------
  158. C      TEST SUR L'EGALITE DE ANG1 ET ANG2 (CAS DE DEUX CRITERES)
  159. C----------------------------------------------------------------
  160.       IF (NCRI.EQ.2) THEN
  161.         ANG=MIN (ABS(ANG1-ANG2),ABS(ABS(ANG2-ANG1)-180.D0))
  162.         IF (ANG.LE.1.D-3) THEN
  163.           KERRE=541
  164.           RETURN
  165.         ENDIF
  166. C------------------------------------
  167. C        TEST SUR LA VALEUR DE ANG2
  168. C------------------------------------
  169.         IF (ANG2.LT.0.D0.OR.ANG2.GT.180.D0) THEN
  170.           KERRE=542
  171.           RETURN
  172.         ENDIF
  173.       ENDIF
  174. C
  175. C------ CAS D'UN SEUL CRITERE
  176. C
  177. C------------------------------------
  178. C        TEST SUR LA VALEUR DE ANG1
  179. C------------------------------------
  180.       IF (ANG1.LT.0.D0.OR.ANG1.GT.180.D0) THEN
  181.         KERRE=543
  182.         RETURN
  183.       ENDIF
  184. C===============================================
  185. C   CALCUL DES PARAMETRES GEOMETRIQUES
  186. C===============================================
  187. C  CAS DE DEUX CRITERES
  188. C
  189.       IF (NCRI.EQ.2) THEN
  190.         ANG2=ANG2*UNIT
  191.         CO22=COS(ANG2)
  192.         SI22=SIN(ANG2)
  193.         ANG1=ANG1*UNIT
  194.         CO11=COS(ANG1)
  195.         SI11=SIN(ANG1)
  196.         CO21=COS(ANG2-ANG1)
  197.         SI21=SIN(ANG2-ANG1)
  198. C
  199. C      CAS D'UN SEUL CRITERE
  200. C
  201.       ELSE
  202.         ANG1=ANG1*UNIT
  203.         CO11=COS(ANG1)
  204.         SI11=SIN(ANG1)
  205.       ENDIF
  206. C***************************************************************
  207.       IF (NCRI.EQ.2) THEN
  208. C---------------------------------------------------------------
  209. C        TEST SUR PHI2 (PHI2 COMPRIS ENTRE 0 ET 90 STRICTEMENT)
  210. C---------------------------------------------------------------
  211.         IF (PHI2.LT.0.D0.OR.PHI2.GE.90.D0) THEN
  212.           KERRE=544
  213.           RETURN
  214.         ENDIF
  215. C---------------------------------------------------------------
  216. C        TEST SUR PSI2 (PSI2 COMPRIS ENTRE 0 ET 90 STRICTEMENT)
  217. C---------------------------------------------------------------
  218.         IF (PSI2.LT.0.D0.OR.PSI2.GE.90.D0) THEN
  219.           KERRE=545
  220.           RETURN
  221.         ENDIF
  222. C--------------------------------------------
  223. C        TEST SUR TRA2 (TRA2 POSITIF OU NUL)
  224. C--------------------------------------------
  225.         IF (TRA2.LT.0.D0) THEN
  226.           KERRE=546
  227.           RETURN
  228.         ENDIF
  229. C---------------------------------------------------------------
  230.       ENDIF
  231.  
  232. C---------------------------------------------------------------
  233. C        TEST SUR PHI1 (PHI1 COMPRIS ENTRE 0 ET 90 STRICTEMENT)
  234. C---------------------------------------------------------------
  235.       IF (PHI1.LT.0.D0.OR.PHI1.GE.90.D0) THEN
  236.         KERRE=547
  237.         RETURN
  238.       ENDIF
  239. C---------------------------------------------------------------
  240. C        TEST SUR PSI1 (PSI1 COMPRIS ENTRE 0 ET 90 STRICTEMENT)
  241. C---------------------------------------------------------------
  242.       IF (PSI1.LT.0.D0.OR.PSI1.GE.90.D0) THEN
  243.         KERRE=548
  244.         RETURN
  245.       ENDIF
  246. C-----------------------------------------------------
  247. C        TEST SUR TRA1 (TRA1 DOIT ETRE POSTIF OU NUL)
  248. C-----------------------------------------------------
  249.       IF (TRA1.LT.0.D0) THEN
  250.         KERRE=549
  251.         MOTERR(1:4)='TRA1'
  252.         RETURN
  253.       ENDIF
  254. C===========================================================
  255. C   CALCUL DES PARAMETRES PHISIQUES
  256. C===========================================================
  257.       IF (NCRI.EQ.2) THEN
  258. C---------------------------
  259. C   CALCUL DES PARAMETRES  2
  260. C---------------------------
  261.         TPSI2=TAN(PSI2*UNIT)
  262.         TPHI2=TAN(PHI2*UNIT)
  263.         COHE2=TPHI2*TRA2
  264. C------------------------------------------------------------
  265. C        CALCUL DE HACHE2(CAS=1 CONT PLANE;CAS=2 DEFO PLANE)
  266. C------------------------------------------------------------
  267.         IF (NCAS.EQ.1) HACHE2=TPSI2*TPHI2*YOUN/(1.D0-XNU*
  268.      1   XNU)+YOUN/(XNU+1.D0)
  269.         IF (NCAS.EQ.2) HACHE2=TPSI2*TPHI2*YOUN*(1.D0-XNU)/(1.D0+XNU)/
  270.      1   (1.D0-2.D0*XNU)+YOUN/(XNU+1.D0)
  271. C---------------------------------------
  272.       ENDIF
  273. C------------------------------
  274. C      CAS D'UN SEUL CRITERE
  275. C------------------------------
  276. C---------------------------
  277. C   CALCUL DES PARAMETRES  1
  278. C---------------------------
  279.       TPSI1=TAN(PSI1*UNIT)
  280.       TPHI1=TAN(PHI1*UNIT)
  281.       COHE1=TPHI1*TRA1
  282. C------------------------------------------------------------
  283. C        CALCUL DE HACHE1(CAS=1 CONT PLANE;CAS=2 DEFO PLANE)
  284. C------------------------------------------------------------
  285.       IF (NCAS.EQ.1) HACHE1=TPSI1*TPHI1*YOUN/(1.D0-XNU*
  286.      1 XNU)+YOUN/(XNU+1.D0)
  287.       IF (NCAS.EQ.2) HACHE1=TPSI1*TPHI1*YOUN*(1.D0-XNU)/(1.D0+XNU)/
  288.      1 (1.D0-2.D0*XNU)+YOUN/(XNU+1.D0)
  289. C
  290. C IMPRESSION DES VARIABLES
  291. C
  292.       IF(IIMPI.EQ.28) THEN
  293.         WRITE(IOIMP,1000)
  294.         WRITE(IOIMP,1001) NCRI,NCAS
  295.         WRITE(IOIMP,1002) ANG1,TRA1,COHE1
  296.         WRITE(IOIMP,1003) PHI1,PSI1,HACHE1
  297.         WRITE(IOIMP,1004) ANG2,TRA2,COHE2
  298.         WRITE(IOIMP,1005) PHI2,PSI2,HACHE2
  299.       ENDIF
  300. C
  301. C CALCUL DE L INCREMENT DE CONTRAINTE
  302. C
  303.       CALL CALSIG(DEPST,DDAUX,NSTRS,CMATE,VALMAT,VALCAR,
  304.      1    N2EL,N2PTEL,MFRB,IFORB,IB,IGAU,EPAIST,NBPGAU,
  305.      2       MELE,NPINT,NBGMAb,NEMATb,SECT,LHOOK,TXR,XLOC,
  306.      3        XGLOB,D1HOOK,ROTHOO,DDHOMU,CRIGI,DSIGT,IRTD)
  307.  
  308.       IF (IRTD.NE.1) THEN
  309.         KERRE=69
  310.         GOTO 1900
  311.       ENDIF
  312. C
  313. C ECOULEMENT PLASTIQUE
  314. C
  315.       MCOD=1
  316.       CALL VISAVI(SIG0,DSIGT,VAR0,SIGMA,DSIGMA,SPHER,AUXIL,
  317.      .      SIGF,DEFP,VARF,SIGFIN,DEFPLA,
  318.      .      DSIGZE,ICENT2,MCOD,IBOU,MFRB,NSTRS,XCAR,CMATE,ecou,necou)
  319. * VISAVI initialise necou.ITYP.
  320.       IF (necou.ITYP.EQ.0) THEN
  321.         KERRE=269
  322.         RETURN
  323.       ENDIF
  324.  
  325. C CAS DES CONTRAINTES PLANES : IFOUR = -2
  326. C AVEC DEUX TYPES DE FORMULATION MECANIQUE :
  327. C          CAS DES COQUES :             ITYP = 2 ==> ALFAH = 0
  328. C                                   OU  ITYP = 7 ==> ALFAH = 0
  329. C          CAS DES CONTRAINTES PLANES : ITYP = 6
  330.       IF (necou.ITYP.EQ.2 .OR. necou.ITYP.EQ.7) ecou.ALFAH = 0.D0
  331. C
  332. C INITIALISATIONS DES PARAMETRES
  333. C
  334.       EPSE     =VAR0(1)
  335.       XLAMBD(1)=VAR0(2)
  336.       XLAMBD(2)=VAR0(3)
  337.       XLAMBD(5)=VAR0(4)
  338.       XLAMBD(3)=VAR0(5)
  339.       XLAMBD(4)=VAR0(6)
  340.       XLAMBD(6)=VAR0(7)
  341. C
  342.       DO 200 IBA=1,IBOU
  343.        ecou.STOT(IBA)=SIGMA(IBA)+DSIGMA(IBA)
  344.  200  CONTINUE
  345.       IF(IIMPI.EQ.28) THEN
  346.         WRITE(IOIMP,2000)
  347.         WRITE(IOIMP,2001) (SIGMA(I),I=1,IBOU)
  348.         WRITE(IOIMP,2002) (DSIGMA(I),I=1,IBOU)
  349.         WRITE(IOIMP,2003) (ecou.STOT(I),I=1,IBOU)
  350.       ENDIF
  351. C
  352. C ECOULEMENT PLASTIQUE
  353. C
  354.       CALL ECUBI(SIGMA,DSIGMA,XLAMBD,DEFPLA,YOUN,XNU,
  355.      .           NCRI,ANG1,TRA1,TPHI1,TPSI1,HACHE1,COHE1,CO11,SI11,
  356.      .           NCAS,ANG2,TRA2,TPHI2,TPSI2,HACHE2,COHE2,CO22,SI22,
  357.      .           CO21,SI21,
  358.      .           SIGFIN,IDAM,KERRE)
  359. C
  360.       IF(IIMPI.EQ.28) THEN
  361.         WRITE(IOIMP,2000)
  362.         WRITE(IOIMP,2001) (SIGMA(I),I=1,IBOU)
  363.         WRITE(IOIMP,2002) (DSIGMA(I),I=1,IBOU)
  364.         WRITE(IOIMP,2003) (ecou.STOT(I),I=1,IBOU)
  365.         WRITE(IOIMP,2004) (SIGFIN(I),I=1,IBOU)
  366.         WRITE(IOIMP,2005) (DEFPLA(I),I=1,IBOU)
  367.         WRITE(IOIMP,2006) (XLAMBD(I),I=1,6)
  368.       ENDIF
  369. C
  370.       IF(KERRE.NE.0) RETURN
  371. C
  372. C PAS DE PLASTICITE COMPORTEMENT ELASTIQUE
  373. C
  374.       IF (IDAM.EQ.0) THEN
  375.         DO 400 IBA=1,IBOU
  376.           SIGFIN(IBA)=ecou.STOT(IBA)
  377.           DEFPLA(IBA)=0.D0
  378.   400   CONTINUE
  379.       ENDIF
  380. C
  381. C NOUS AVONS ENDOMMAGE LE MATERIAU
  382. C
  383. C MISE A JOUR DES VARIABLES INTERNES
  384. C
  385.       VARF(1)=EPSE+(SQRT(XLAMBD(1)*XLAMBD(1)+XLAMBD(2)*XLAMBD(2)+
  386.      &                   XLAMBD(3)*XLAMBD(3)+XLAMBD(4)*XLAMBD(4)))
  387.       VARF(2)=XLAMBD(1)
  388.       VARF(3)=XLAMBD(2)
  389.       VARF(4)=XLAMBD(5)
  390.       VARF(5)=XLAMBD(3)
  391.       VARF(6)=XLAMBD(4)
  392.       VARF(7)=XLAMBD(6)
  393. C
  394.       MCOD=2
  395.       CALL VISAVI(SIG0,DSIGT,VAR0,SIGMA,DSIGMA,SPHER,AUXIL,
  396.      &        SIGF,DEFP,VARF,SIGFIN,DEFPLA,
  397.      &    DSIGZE,ICENT2,MCOD,IBOU,MFRb,nstrs,XCAR,CMATE,ecou,necou)
  398. C
  399. C LES FORMATS D IMPRESSION
  400. C
  401.  1000 FORMAT(1X,'CONSTANTES DU MATERIAU UBIQUITOUS')
  402.  1001 FORMAT(1X,'NCRI =',I4,3X,'NCAS =',I4)
  403.  1002 FORMAT(1X,'ANG1 =',E12.5,2X,'TRA1 =',E12.5,2X,'COHE1 =',E12.5)
  404.  1003 FORMAT(1X,'PHI1 =',E12.5,2X,'PSI1 =',E12.5,2X,'HACH1 =',E12.5)
  405.  1004 FORMAT(1X,'ANG2 =',E12.5,2X,'TRA2 =',E12.5,2X,'COHE2 =',E12.5)
  406.  1005 FORMAT(1X,'PHI1 =',E12.5,2X,'PSI1 =',E12.5,2X,'HACH2 =',E12.5)
  407.  2000 FORMAT(1X,'RESULTATS DE L ECOULEMENT PLASTIQUE')
  408.  2001 FORMAT(1X,'SIGMA  =',6(1X,1PE12.5))
  409.  2002 FORMAT(1X,'DSIGMA =',6(1X,1PE12.5))
  410.  2003 FORMAT(1X,'STOT   =',6(1X,1PE12.5))
  411.  2004 FORMAT(1X,'SIGFIN =',6(1X,1PE12.5))
  412.  2005 FORMAT(1X,'DEFPLA =',6(1X,1PE12.5))
  413.  2006 FORMAT(1X,'XLAMBD =',6(1X,1PE12.5))
  414.  3000 FORMAT(1X,'XMAT   =',/,3(6(1X,1PE12.5),/))
  415. C
  416.  1900 CONTINUE
  417.       RETURN
  418.       END
  419.  
  420.  
  421.  

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