Télécharger la plaquette Cast3M


fr en

Télécharger defrot.eso

Retour à la liste

Numérotation des lignes : 

defrot

  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.  
  33. -INC PPARAM
  34. -INC CCOPTIO
  35. -INC SMELEME
  36. -INC SMCOORD
  37. -INC SMINTE
  38. *
  39.       LOGICAL LUNI1
  40.       CHARACTER*8 CMATE
  41. *
  42.       SEGMENT WRK22
  43.       REAL*8 XXE(3,NBNN)
  44.       ENDSEGMENT
  45. *
  46.       SEGMENT WRK4
  47.         REAL*8 XE(3,NBNN)
  48.       ENDSEGMENT
  49. *
  50.       SEGMENT WTRAV
  51.         REAL*8 DDAUX(LHOOK,LHOOK),VALMAT(NUMAT)
  52.         REAL*8 VALCAR(NUCAR),DSIGT(NSTRS)
  53.         REAL*8 TXR(IDIM,IDIM),DDHOMU(LHOOK,LHOOK)
  54.         REAL*8 XLOC(3,3),XGLOB(3,3)
  55.         REAL*8 D1HOOK(LHOOK,LHOOK),ROTHOO(LHOOK,LHOOK)
  56.       ENDSEGMENT
  57. *
  58.       IF((CMATE.EQ.'ORTHOTRO'.OR.CMATE.EQ.'ANISOTRO'.OR.
  59.      2  CMATE.EQ.'UNIDIREC').AND.(MFR.EQ.1
  60.      2         .OR.MFR.EQ.31.OR.MFR.EQ.33)) THEN
  61. c
  62. c     on cherche  les coordonnees des noeuds de l element ib
  63. c
  64.         CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XXE)
  65. c
  66. c     calcul des axes locaux
  67. c
  68.         MINTE2=IPTR1
  69.         NBSH=MINTE2.SHPTOT(/2)
  70.         CALL RLOCAL (XXE,MINTE2.SHPTOT,NBSH,NBNN,TXR)
  71.         if (nbsh.eq.-1) then
  72.          call erreur(525)
  73.          return
  74.         endif
  75.       ENDIF
  76. *
  77. CPPU  IF(LUNI1)THEN
  78. CPPU    CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE)
  79. CPPU    NLG=NUMGEO(MELE)
  80. CPPU    CALL RESHPT(1,NBNN,NLG,MELE,0,IPTR1,IRT1)
  81. CPPU    MINTE2=IPTR1
  82. CPPU    SEGACT MINTE2
  83. CPPU    NBSH=MINTE2.SHPTOT(/2)
  84. CPPU    CALL RLOCAL (XE,MINTE2.SHPTOT,NBSH,NBNN,TXR)
  85. CPPU    if (iarr.eq.1) then
  86. CPPU     iarr=0
  87. CPPU     call erreur(525)
  88. CPPU     return
  89. CPPU    endif
  90. CPPU    SEGDES MINTE2
  91. CPPU  ENDIF
  92. *
  93.       RETURN
  94.       END
  95.  
  96.  
  97.  
  98.  
  99.  
  100.  
  101.  
  102.  

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