Esope source files

   1 : C COQ3KC    SOURCE    KK2000    05/05/25    21:15:12     5088           
   2 :       SUBROUTINE COQ3KC(XE,RHO,XEL,BPSS,BB,REL,VROT)
   3 : c=======================================================================
   4 : c
   5 : c      calcule la matrice de raideur centrifuge des elements de coque
   6 : c       a 3 noeud
   7 : c
   8 : c   entree
   9 : c      xe(3,3)=coodonnees de l element
  10 : c      rho    =masse volumique * epaisseur
  11 : c      vrot (3) =  vecteur rotation
  12 : c   travail
  13 : c      xel(3,3)   =coordonnees locales de l element
  14 : c      bpss(3,3)  =matrice de passage
  15 : c      bb(9)      =stocke les fonctions de formes de flexion
  16 : c   sorties
  17 : c      rel(18,18)=matrice dans le repere local puis global
  18 : c
  19 : c      Didier COMBESCURE mars 2003
  20 : c
  21 : c=======================================================================
  22 :       IMPLICIT INTEGER(I-N)
  23 :       IMPLICIT REAL*8(A-H,O-Z)
  24 :       DIMENSION XE(3,*),REL(18,*),VROT(3)
  25 :       DIMENSION REWOLP(18,18),REWO(18,18),ROME(6,6)
  26 :       DIMENSION XEL(3,3),BPSS(3,3),BB(3)
  27 :       DIMENSION XX(3),YY(3)
  28 :       DATA XX/0.5D0,0.5D0,0.0D0/
  29 :       DATA YY/0.0D0,0.5D0,0.5D0/
  30 :       DATA UNSIX,UN12/.166666666666666666D0,.833333333333333333D-1/
  31 :       DATA UNTIER/.33333333333333333D0/
  32 :       DATA IZERO/0/
  33 : C
  34 : c
  35 :       DO 10 IN=1,6
  36 :         DO 10 IM=1,6
  37 :          ROME(IN,IM) = 0.D0
  38 :    10 CONTINUE
  39 : c
  40 :       ROME(1,1) = (-1.)*((VROT(2)**2) + (VROT(3)**2))
  41 :       ROME(2,2) = (-1.)*((VROT(1)**2) + (VROT(3)**2))
  42 :       ROME(3,3) = (-1.)*((VROT(1)**2) + (VROT(2)**2))
  43 :       ROME(1,2) = VROT(1)*VROT(2)
  44 :       ROME(1,3) = VROT(1)*VROT(3)
  45 :       ROME(2,3) = VROT(2)*VROT(3)
  46 :       ROME(2,1) = ROME(1,2) 
  47 :       ROME(3,1) = ROME(1,3) 
  48 :       ROME(3,2) = ROME(2,3) 
  49 : C
  50 : c     matrice de passage
  51 : c
  51 :       CALL VPAST(XE,BPSS)
  52 : c
  53 : c     coordonnees locales
  54 : c
  54 :       CALL VCORLC(XE,XEL,BPSS)
  55 : c
  56 : c     mise a 0 de la matrice de masse
  57 : c
  57 :       CALL ZERO(REWO,18,18)
  58 :       X21=XEL(1,2)-XEL(1,1)
  59 :       Y31=XEL(2,3)-XEL(2,1)
  60 :       SURF=X21*Y31*.5D0*RHO
  61 : c
  62 : c     termes diagonaux  de la membrane
  63 : c
  64 :       DO 100 IA=1,13,6
  65 :           REWO(IA  ,IA  )=UNSIX
  66 :           REWO(IA+1,IA+1)=UNSIX
  67 :           DO 110 IB=1,13,6
  68 :               IF(IB.EQ.IA) GOTO 110
  69 :               REWO(IA  ,IB  )=UN12
  70 :               REWO(IA+1,IB+1)=UN12
  71 :   110     CONTINUE
  72 :   100 CONTINUE
  73 : c
  74 : c     partie flexion   integration numerique
  75 : c
  76 : c     ia numero du point de gauss
  77 : c     ib numero d un noeud
  78 : c     ic numero d un noeud
  79 : c
  80 :       DO 200 IA=1,3
  80 :           CALL MFDKT(XX(IA),YY(IA),XEL,BB)
  81 :           DO 210 IB=1,3
  82 :               IBDERI=(IB-1)*6+2
  83 :               IBDEBB=(IB-1)*3
  84 :               DO 210 IC=1,3
  85 :                   ICDERI=(IC-1)*6+2
  86 :                   ICDEBB=(IC-1)*3
  87 :                   DO 220 ID=1,3
  88 :                    DO 220 IE=1,3
  89 :                     REWO(IBDERI+ID,ICDERI+IE)=REWO(IBDERI+ID,ICDERI+IE)
  90 :      1               +BB(IBDEBB+ID)*BB(ICDEBB+IE)*UNTIER
  91 :   220             CONTINUE
  92 :   210     CONTINUE
  93 :   200 CONTINUE
  94 : c
  95 : c     multiplication par rho*surf
  96 : c
  97 :       DO 300 IA=1,18
  98 :           DO 300 IB=1,18
  99 :               REWO(IA,IB)=REWO(IA,IB)*SURF
 100 :   300 CONTINUE
 101 : c          
 102 : c
 103 : c     changement de repere
 104 : c
 104 :       CALL TRANSK(REWO,BPSS,18,3,IZERO)
 105 : C
 106 : C On bouscule la matrice de raideur
 107 : C
 108 : C
 108 :       CALL ZERO(REL,18,18)
 109 : C
 110 :       DO   401 IN=1,3
 111 : C
 112 :         DO   402 IM=1,3
 113 : C
 114 :           DO   403 IDD1=1,3
 115 : C
 116 :             DO   404 IDD2=1,3
 117 : C
 118 :             REL((6*IN)-6+IDD1,(6*IM)-6+IDD2)=
 119 :      . REWO((6*IN)-6+IDD2,(6*IM)-6+IDD2)*ROME(IDD1,IDD2) 
 120 :             REL((6*IN)-3+IDD1,(6*IM)-6+IDD2)=
 121 :      . REWO((6*IN)-6+IDD2,(6*IM)-6+IDD2)*ROME(IDD1,IDD2) 
 122 :             REL((6*IN)-6+IDD1,(6*IM)-3+IDD2)=
 123 :      . REWO((6*IN)-6+IDD2,(6*IM)-6+IDD2)*ROME(IDD1,IDD2) 
 124 :             REL((6*IN)-3+IDD1,(6*IM)-3+IDD2)=
 125 :      . REWO((6*IN)-6+IDD2,(6*IM)-6+IDD2)*ROME(IDD1,IDD2) 
 126 : C 
 127 :   404      CONTINUE    
 128 : C 
 129 :   403     CONTINUE    
 130 : C 
 131 :   402   CONTINUE                                                         
 132 : C 
 133 :   401  CONTINUE   
 134 : C 
 135 : c
 136 :       RETURN
 137 :       END
 138 :  
 139 :  
 140 :  
 141 :