Download coq2kc.eso

Back to the list

   1 : C COQ2KC    SOURCE    CHAT      06/03/29    21:17:27     5360           
   2 :       SUBROUTINE COQ2KC(Q,E,DIM3,RHO,IMATMA,IFOUR,NIFOU,LRE,
   3 :      +     AMM,IARR,XDPGE,YDPGE,VROT)
   4 : C     
   5 : C***********************************************************************
   6 : C          MATRICE DE MASSE D'UN ELEMENT COQUE A 2 NOEUDS
   7 : C          CODE X.DE MAZANCOURT   DECEMBRE 85
   8 : C***********************************************************************
   9 : C ENTREES
  10 : C     Q(3,2) : COORDONNEES DES 2 NOEUDS , R PUIS Z
  11 : C     E : EPAISSEUR ( CONSTANTE )
  12 : C     RHO : MASSE VOLUMIQUE
  13 : C     IMATMA=1-MATRICE MASSE- OU 0-VECTEUR MASSE-(CAS DE MATR DIAGONALE)
  14 : C            AVANT L'APPEL IL EST MIS A 1
  15 : C     IFOUR=IFOUR DE CCOPTIO
  16 : C     NIFOU=NIFOUR DE CCOPTIO
  17 : C     LRE  = TAILEE DE LA MATRICE MASSE 6 SI IFOU.LE.0 8 SI IFOU.GT.0
  18 : C SORTIE
  19 : C    AMM(LRE,LRE) = MATRICE DE MASSE
  20 : C     IARR:INDICATEUR D'ERREUR,VAUT ZERO NORMALEMENT
  21 : C***********************************************************************
  22 :       IMPLICIT INTEGER(I-N)
  23 :       IMPLICIT REAL*8 (A-H,O-Z)
  24 : C    Include contenant quelques constantes dont XPI :
  25 : -INC CCREEL
  26 :       DIMENSION Q(3,*),AM(8,8),AMM(LRE,*)
  27 :       DIMENSION II(6)
  28 :       DIMENSION VROT(*)
  29 :       DATA II/1,2,4,5,6,8/
  30 : C     
  31 : C     ----------   INITIALISATION
  31 :       CALL ZERO(AM,8,8)
  31 :       CALL ZERO(AMM,LRE,LRE)
  32 : C     
  33 :       IARR=0
  34 :       R=.5D0*(Q(1,1)+Q(1,2))
  35 :       Y=.5D0*(Q(2,1)+Q(2,2))
  36 :       XD=XDPGE-R
  37 :       YD=Y-YDPGE
  38 :       SP=Q(1,2)-Q(1,1)
  39 :       CP=Q(2,2)-Q(2,1)
  40 :       D2=CP*CP+SP*SP
  41 :       D=SQRT(D2)
  42 :       E2=E*E
  43 :       OMEGA=VROT(2)
  44 : C     
  45 : C     -----------------------------TESTS D'ERREUR
  46 : C     
  47 :       IF(D.EQ.0) THEN
  48 :          IARR=1
  49 :          GOTO 60
  50 :       ENDIF
  51 :       IF(ABS(R/D).LE.1.D-03) THEN
  52 :             IARR=2
  53 :             GOTO 60
  54 :       ENDIF
  55 : C     
  56 :       COEF=(-1.D0)*RHO*E*XPI*(OMEGA**2)
  57 : C     ----------   PRELIMINAIRES
  58 :       IF(NIFOU.EQ.0) THEN
  59 :          COEF= COEF
  60 :       ELSE
  61 :          COEF= 0.50*COEF
  62 :       ENDIF
  63 :       SP=SP/D
  64 :       CP=CP/D
  65 : C
  66 : C     ----------   CALCULS
  67 : C
  68 :       AM(1,1) = -D*COEF*(7*CP**2*SP*D-14*CP**2*R-
  69 :      .           2*CP**4*R+35*D*SP-140*R)/210      
  70 :       AM(1,2) = SP*D*CP*COEF*(-4*CP**2*R+7*D*SP-14*R)/420      
  71 :       AM(1,3) = 0      
  72 :       AM(1,4) = CP*D**2*COEF*(CP**2*SP*D-2*CP**2*R+7*D*SP-42*R)/420      
  73 :       AM(1,5) = -D*COEF*R*(CP**4+7*CP**2-35)/105      
  74 :       AM(1,6) = -SP*D*CP*COEF*(-4*CP**2*R+7*D*SP-14*R)/420      
  75 :       AM(1,7) = 0      
  76 :       AM(1,8) = -CP*D**2*COEF*(CP**2*SP*D+2*CP**2*R-28*R)/420      
  77 :       AM(2,1) = SP*D*CP*COEF*(-4*CP**2*R+7*D*SP-14*R)/420      
  78 :       AM(2,2) = -D*COEF*CP**2*(-1+CP**2)*R/105      
  79 :       AM(2,3) = 0      
  80 :       AM(2,4) = -CP**2*SP*(-2*R+D*SP)*COEF*D**2/420      
  81 :       AM(2,5) = SP*D*CP*COEF*(4*CP**2*R+7*D*SP+14*R)/420      
  82 :       AM(2,6) = D*COEF*CP**2*(-1+CP**2)*R/105      
  83 :       AM(2,7) = 0      
  84 :       AM(2,8) = CP**2*D**2*SP*COEF*(D*SP+2*R)/420      
  85 :       AM(3,1) = 0     
  86 :       AM(3,2) = 0      
  87 :       AM(3,3) = -D*COEF*(D*SP-4*R)/6     
  88 :       AM(3,4) = 0      
  89 :       AM(3,5) = 0      
  90 :       AM(3,6) = 0      
  91 :       AM(3,7) = D*COEF*R/3      
  92 :       AM(3,8) = 0      
  93 :       AM(4,1) = CP*D**2*COEF*(CP**2*SP*D-2*CP**2*R+7*D*SP-42*R)/420      
  94 :       AM(4,2) = -CP**2*SP*(-2*R+D*SP)*COEF*D**2/420      
  95 :       AM(4,3) = 0      
  96 :       AM(4,4) = -D**3*CP**2*COEF*(D*SP-8*R)/420      
  97 :       AM(4,5) = -CP*D**2*COEF*(CP**2*SP*D-2*CP**2*R+28*R)/420      
  98 :       AM(4,6) = CP**2*SP*(-2*R+D*SP)*COEF*D**2/420      
  99 :       AM(4,7) = 0      
 100 :       AM(4,8) = -D**3*CP**2*COEF*R/70      
 101 :       AM(5,1) = -D*COEF*R*(CP**4+7*CP**2-35)/105     
 102 :       AM(5,2) = SP*D*CP*COEF*(4*CP**2*R+7*D*SP+14*R)/420      
 103 :       AM(5,3) = 0      
 104 :       AM(5,4) = -CP*D**2*COEF*(CP**2*SP*D-2*CP**2*R+28*R)/420      
 105 :       AM(5,5) = D*COEF*(2*CP**4*R+7*CP**2*SP*D+14*CP**2*R+
 106 :      .          35*D*SP+140*R)/210      
 107 :       AM(5,6) = -SP*D*CP*COEF*(4*CP**2*R+7*D*SP+14*R)/420      
 108 :       AM(5,7) = 0     
 109 :       AM(5,8) = CP*D**2*COEF*(CP**2*SP*D+2*CP**2*R+7*D*SP+42*R)/420      
 110 :       AM(6,1) = -SP*D*CP*COEF*(-4*CP**2*R+7*D*SP-14*R)/420      
 111 :       AM(6,2) = D*COEF*CP**2*(-1+CP**2)*R/105      
 112 :       AM(6,3) = 0      
 113 :       AM(6,4) = CP**2*SP*(-2*R+D*SP)*COEF*D**2/420      
 114 :       AM(6,5) = -SP*D*CP*COEF*(4*CP**2*R+7*D*SP+14*R)/420      
 115 :       AM(6,6) = -D*COEF*CP**2*(-1+CP**2)*R/105      
 116 :       AM(6,7) = 0      
 117 :       AM(6,8) = -CP**2*D**2*SP*COEF*(D*SP+2*R)/420      
 118 :       AM(7,1) = 0      
 119 :       AM(7,2) = 0      
 120 :       AM(7,3) = D*COEF*R/3      
 121 :       AM(7,4) = 0      
 122 :       AM(7,5) = 0      
 123 :       AM(7,6) = 0      
 124 :       AM(7,7) = D*COEF*(D*SP+4*R)/6      
 125 :       AM(7,8) = 0      
 126 :       AM(8,1) = -CP*D**2*COEF*(CP**2*SP*D+2*CP**2*R-28*R)/420      
 127 :       AM(8,2) = CP**2*D**2*SP*COEF*(D*SP+2*R)/420      
 128 :       AM(8,3) = 0      
 129 :       AM(8,4) = -D**3*CP**2*COEF*R/70      
 130 :       AM(8,5) = CP*D**2*COEF*(CP**2*SP*D+2*CP**2*R+7*D*SP+42*R)/420   
 131 :       AM(8,6) = -CP**2*D**2*SP*COEF*(D*SP+2*R)/420      
 132 :       AM(8,7) = 0      
 133 :       AM(8,8) = D**3*CP**2*COEF*(D*SP+8*R)/420
 134 : C
 135 :  60   CONTINUE
 136 :       DO  500 IA= 1,8
 137 :          DO  5001 IB= 1,8
 138 :                AMM(IA,IB)=AM(IA,IB)
 139 :  5001    CONTINUE
 140 :  500  CONTINUE
 141 :       RETURN
 142 :       END
 143 : 
 144 :  
 145 :  

© Cast3M 2003 - All rights reserved.
Disclaimer