Esope source files

   1 : C COQ3GY    SOURCE    CHAT      05/01/12    22:21:10     5004           
   2 :       SUBROUTINE COQ3GY(XE,RHO,XEL,BPSS,BB,REL,VROT)
   3 : c=======================================================================
   4 : c
   5 : c       calcule la matrice de couplage gyroscopique 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      rewo(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,*),XEL(3,*),BPSS(3,*),REL(18,*),BB(*),VROT(*)
  25 :       DIMENSION REWOLP(18,18),REWO(18,18),ROME(6,6)
  26 :       DIMENSION XX(3),YY(3)
  27 :       DATA XX/0.5D0,0.5D0,0.0D0/
  28 :       DATA YY/0.0D0,0.5D0,0.5D0/
  29 :       DATA UNSIX,UN12/.166666666666666666D0,.833333333333333333D-1/
  30 :       DATA UNTIER/.33333333333333333D0/
  31 :       DATA IZERO,IUN/0,1/
  32 : C
  33 : C
  34 :       DO 10 IN=1,6
  35 :         DO 10 IM=1,6
  36 :          ROME(IN,IM) = 0.D0
  37 :    10 CONTINUE
  38 : C
  39 :       ROME(1,1) = 0.
  40 :       ROME(2,2) = 0.
  41 :       ROME(3,3) = 0.
  42 :       ROME(1,2) = (-1.)*VROT(3)
  43 :       ROME(1,3) = VROT(2)
  44 :       ROME(2,3) = (-1.)*VROT(1)
  45 :       ROME(2,1) = VROT(3)
  46 :       ROME(3,1) = (-1.)*VROT(2)
  47 :       ROME(3,2) = VROT(1)
  48 : C
  49 : c     matrice de passage
  50 : c
  50 :       CALL VPAST(XE,BPSS)
  51 : c
  52 : c     coordonnees locales
  53 : c
  53 :       CALL VCORLC(XE,XEL,BPSS)
  54 : c
  55 : c     mise a 0 de la matrice de masse
  56 : c
  56 :       CALL ZERO(REWO,18,18)
  57 :       X21=XEL(1,2)-XEL(1,1)
  58 :       Y31=XEL(2,3)-XEL(2,1)
  59 :       SURF=X21*Y31*.5D0*RHO
  60 : c
  61 : c     termes diagonaux  de la membrane
  62 : c
  63 :       DO 100 IA=1,13,6
  64 :           REWO(IA  ,IA  )=UNSIX
  65 :           REWO(IA+1,IA+1)=UNSIX
  66 :           DO 110 IB=1,13,6
  67 :               IF(IB.EQ.IA) GOTO 110
  68 :               REWO(IA  ,IB  )=UN12
  69 :               REWO(IA+1,IB+1)=UN12
  70 :   110     CONTINUE
  71 :   100 CONTINUE
  72 : c
  73 : c     partie flexion   integration numerique
  74 : c
  75 : c     ia numero du point de gauss
  76 : c     ib numero d un noeud
  77 : c     ic numero d un noeud
  78 : c
  79 :       DO 200 IA=1,3
  79 :           CALL MFDKT(XX(IA),YY(IA),XEL,BB)
  80 :           DO 210 IB=1,3
  81 :               IBDERI=(IB-1)*6+2
  82 :               IBDEBB=(IB-1)*3
  83 :               DO 210 IC=1,3
  84 :                   ICDERI=(IC-1)*6+2
  85 :                   ICDEBB=(IC-1)*3
  86 :                   DO 220 ID=1,3
  87 :                    DO 220 IE=1,3
  88 :                     REWO(IBDERI+ID,ICDERI+IE)=REWO(IBDERI+ID,ICDERI+IE)
  89 :      1               +BB(IBDEBB+ID)*BB(ICDEBB+IE)*UNTIER
  90 :   220             CONTINUE
  91 :   210     CONTINUE
  92 :   200 CONTINUE
  93 : c
  94 : c     multiplication par rho*surf
  95 : c
  96 :       DO 300 IA=1,18
  97 :           DO 300 IB=1,18
  98 :               REWO(IA,IB)=REWO(IA,IB)*SURF
  99 :   300 CONTINUE
 100 : c   
 101 : C       WRITE(*,*) 'REWO avant'    
 102 :        DO 517 I=1,18
 103 : C         WRITE(*,*)  REWO(I,I)
 104 :   517  CONTINUE       
 105 : c
 106 : c     changement de repere
 107 : c
 107 :       CALL TRANSK(REWO,BPSS,18,3,IUN)
 108 : C
 109 : C On bouscule la matrice de masse
 110 : C
 110 :       CALL ZERO(REL,18,18)
 111 : C
 112 :       DO   401 IN=1,3
 113 : C
 114 :         DO   402 IM=1,3
 115 : C
 116 :           DO   403 IDD1=1,3
 117 : C
 118 :             DO   404 IDD2=1,3
 119 : C
 120 :             REL((6*IN)-6+IDD1,(6*IM)-6+IDD2)=
 121 :      . REWO((6*IN)-6+IDD2,(6*IM)-6+IDD2)*ROME(IDD1,IDD2) 
 122 :             REL((6*IN)-3+IDD1,(6*IM)-6+IDD2)=
 123 :      . REWO((6*IN)-3+IDD2,(6*IM)-6+IDD2)*ROME(IDD1,IDD2) 
 124 :             REL((6*IN)-6+IDD1,(6*IM)-3+IDD2)=
 125 :      . REWO((6*IN)-6+IDD2,(6*IM)-3+IDD2)*ROME(IDD1,IDD2) 
 126 :             REL((6*IN)-3+IDD1,(6*IM)-3+IDD2)=
 127 :      . REWO((6*IN)-3+IDD2,(6*IM)-3+IDD2)*ROME(IDD1,IDD2) 
 128 : C 
 129 :   404      CONTINUE    
 130 : C 
 131 :   403     CONTINUE    
 132 : C 
 133 :   402   CONTINUE                                                         
 134 : C 
 135 :   401  CONTINUE   
 136 : C 
 137 : C       WRITE(*,*) 'REWO'    
 138 :        DO 518 I=1,6
 139 : C         WRITE(*,*)  REWO(I,I)
 140 :   518  CONTINUE
 141 : C       WRITE(*,*) 'REL'    
 142 :        DO 519 I=1,3
 143 :        DO 519 J=1,3
 144 : C         WRITE(*,*)  REL((I + 3) ,(J + 3) )
 145 : C         WRITE(*,*)  REL((J + 3) ,(I + 3) )
 146 :   519  CONTINUE
 147 : c
 148 :       RETURN
 149 :       END
 150 :  
 151 :  
 152 :