Télécharger defrot.eso

Retour à la liste

Numérotation des lignes :

  1. C DEFROT SOURCE BP208322 17/03/01 21:16:58 9325
  2. SUBROUTINE DEFROT(CMATE,MFR,NBNN,IB,MELE,LUNI1,IPTR1,
  3. . MELEME,WRK4,WRK22,WTRAV)
  4. *
  5. **********************************************************
  6. * ENTREES
  7. **********************************************************
  8. *
  9. * CMATE : nom du matériau élastique
  10. * MFR : formulation de l'élément
  11. * NBBN : nombre de noeuds de l'élément
  12. * IB : numéro de l'élément
  13. * MELE : numéro élément fini
  14. * LUNI1 : booléen pour le matériau ACIER_UNI
  15. * IPTR1 : pointeur sur un segment MINTE2
  16. * MELEME : pointeur sur le maillage
  17. *
  18. **********************************************************
  19. * SORTIES
  20. **********************************************************
  21. *
  22. * XE : coordonnées de l'élément en double précision (WRK4)
  23. * XXE : coordonnées de l'élément en double précision (WRK22)
  24. * TXR : cosinus directeurs des axes locaux de l'élément massif
  25. * (WTRAV)
  26. *
  27. **********************************************************
  28. *
  29. IMPLICIT INTEGER(I-N)
  30. IMPLICIT REAL*8(A-H,O-Z)
  31. *
  32. -INC CCOPTIO
  33. -INC SMELEME
  34. -INC SMCOORD
  35. -INC SMINTE
  36. *
  37. LOGICAL LUNI1
  38. CHARACTER*8 CMATE
  39. *
  40. SEGMENT WRK22
  41. REAL*8 XXE(3,NBNN)
  42. ENDSEGMENT
  43. *
  44. SEGMENT WRK4
  45. REAL*8 XE(3,NBNN)
  46. ENDSEGMENT
  47. *
  48. SEGMENT WTRAV
  49. REAL*8 DDAUX(LHOOK,LHOOK),VALMAT(NUMAT)
  50. REAL*8 VALCAR(NUCAR),DSIGT(NSTRS)
  51. REAL*8 TXR(IDIM,IDIM),DDHOMU(LHOOK,LHOOK)
  52. REAL*8 XLOC(3,3),XGLOB(3,3)
  53. REAL*8 D1HOOK(LHOOK,LHOOK),ROTHOO(LHOOK,LHOOK)
  54. ENDSEGMENT
  55. *
  56. IF((CMATE.EQ.'ORTHOTRO'.OR.CMATE.EQ.'ANISOTRO'.OR.
  57. 2 CMATE.EQ.'UNIDIREC').AND.(MFR.EQ.1
  58. 2 .OR.MFR.EQ.31.OR.MFR.EQ.33)) THEN
  59. c
  60. c on cherche les coordonnees des noeuds de l element ib
  61. c
  62. CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XXE)
  63. c
  64. c calcul des axes locaux
  65. c
  66. MINTE2=IPTR1
  67. NBSH=MINTE2.SHPTOT(/2)
  68. CALL RLOCAL (XXE,MINTE2.SHPTOT,NBSH,NBNN,TXR)
  69. if (nbsh.eq.-1) then
  70. call erreur(525)
  71. return
  72. endif
  73. ENDIF
  74. *
  75. CPPU IF(LUNI1)THEN
  76. CPPU CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE)
  77. CPPU NLG=NUMGEO(MELE)
  78. CPPU CALL RESHPT(1,NBNN,NLG,MELE,0,IPTR1,IRT1)
  79. CPPU MINTE2=IPTR1
  80. CPPU SEGACT MINTE2
  81. CPPU NBSH=MINTE2.SHPTOT(/2)
  82. CPPU CALL RLOCAL (XE,MINTE2.SHPTOT,NBSH,NBNN,TXR)
  83. CPPU if (iarr.eq.1) then
  84. CPPU iarr=0
  85. CPPU call erreur(525)
  86. CPPU return
  87. CPPU endif
  88. CPPU SEGDES MINTE2
  89. CPPU ENDIF
  90. *
  91. RETURN
  92. END
  93.  
  94.  
  95.  
  96.  
  97.  
  98.  
  99.  
  100.  

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