Esope source files

   1 : C DEFROT    SOURCE    CHAT      06/03/29    21:18:33     5360           
   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(IDIM,IDIM),XGLOB(IDIM,IDIM)
  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
  61 :         CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XXE)
  62 : c
  63 : c     calcul des axes locaux
  64 : c
  65 :         MINTE2=IPTR1 
  66 :         NBSH=MINTE2.SHPTOT(/2)
  66 :         CALL RLOCAL (XXE,MINTE2.SHPTOT,NBSH,NBNN,TXR)
  67 :         if (nbsh.eq.-1) then
  67 :          call erreur(525)
  68 :          return
  69 :         endif
  70 :       ENDIF
  71 : *
  72 : CPPU  IF(LUNI1)THEN
  72 : CPPU    CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE)
  73 : CPPU    NLG=NUMGEO(MELE)
  73 : CPPU    CALL RESHPT(1,NBNN,NLG,MELE,0,IPTR1,IRT1)
  74 : CPPU    MINTE2=IPTR1
  75 : CPPU    SEGACT MINTE2
  76 : CPPU    NBSH=MINTE2.SHPTOT(/2)
  76 : CPPU    CALL RLOCAL (XE,MINTE2.SHPTOT,NBSH,NBNN,TXR)
  77 : CPPU    if (iarr.eq.1) then
  78 : CPPU     iarr=0
  78 : CPPU     call erreur(525)
  79 : CPPU     return
  80 : CPPU    endif
  81 : CPPU    SEGDES MINTE2
  82 : CPPU  ENDIF
  83 : *  
  84 :       RETURN 
  85 :       END  
  86 :       
  87 :  
  88 :  
  89 :  
  90 :  
  91 :