Esope source files

   1 : C COQ2MA    SOURCE    CHAT      06/03/29    21:17:32     5360           
   2 :       SUBROUTINE COQ2MA(Q,E,DIM3,RHO,IMATMA,IFOUR,NIFOU,LRE,
   3 :      +     AMM,IARR,XDPGE,YDPGE)
   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(9,9),AMM(LRE,*)
  27 :       DIMENSION II(6)
  28 :       DATA II/1,2,4,5,6,8/
  29 : C     
  30 : C     ----------   INITIALISATION
  30 :       CALL ZERO(AM,9,9)
  30 :       CALL ZERO(AMM,LRE,LRE)
  31 : C     
  32 :       IARR=0
  33 :       R=.5D0*(Q(1,1)+Q(1,2))
  34 :       Y=.5D0*(Q(2,1)+Q(2,2))
  35 :       XD=XDPGE-R
  36 :       YD=Y-YDPGE
  37 :       SP=Q(1,2)-Q(1,1)
  38 :       CP=Q(2,2)-Q(2,1)
  39 :       D2=CP*CP+SP*SP
  40 :       D=SQRT(D2)
  41 :       E2=E*E
  42 : C     
  43 : C     -----------------------------TESTS D'ERREUR
  44 : C     
  45 :       IF(D.EQ.0) THEN
  46 :          IARR=1
  47 :          GOTO 60
  48 :       ENDIF
  49 :       IF(IFOUR.GE.0) THEN
  50 :          IF(ABS(R/D).LE.1.D-03) THEN
  51 :             IARR=2
  52 :             GOTO 60
  53 :          ENDIF
  54 :       ELSE
  55 :          R=1.D0
  56 :       ENDIF
  57 : C     
  58 : C     ----------   NORME
  59 : C ********** CASTEM20 SOMME(COS**2)=1
  60 : C     
  61 :       COEF=RHO*E*D*DIM3
  62 :       IF(IMATMA.NE.0) GOTO 20
  63 : C     ----------   VECTEUR MASSE
  64 :       RM=.5D0*COEF*R
  65 :       IF(IFOUR.EQ.0.OR.(IFOUR.EQ.1.AND.NIFOU.EQ.0)) THEN
  66 :          RM=2*XPI*RM
  67 :       ELSEIF(IFOUR.EQ.1.AND.NIFOU.NE.0) THEN
  68 :          RM=XPI*RM
  69 :       ENDIF
  70 :       DO 15 I=1,2
  71 :          K=4*(I-1)
  72 :          DO 151 J=1,3
  73 :             K=K+1
  74 :             AM(K,K)=RM
  75 :  151     CONTINUE
  76 :  15   CONTINUE
  77 :       RETURN
  78 : C     
  79 : C     ----------   PRELIMINAIRES
  80 : C     
  81 :  20   CONTINUE
  82 :       A=COEF*R/420.D0
  83 :       B=COEF*SP/840.D0
  84 :       IF(IFOUR.LT.0) B=0.D0
  85 :       IF(IFOUR.EQ.0.OR.(IFOUR.EQ.1.AND.NIFOU.EQ.0)) THEN
  86 :          A=2*XPI*A
  87 :          B=2*XPI*B
  88 :       ELSEIF(IFOUR.EQ.1.AND.NIFOU.NE.0) THEN
  89 :          A=XPI*A
  90 :          B=XPI*B
  91 :       ENDIF
  92 :       SP=SP/D
  93 :       CP=CP/D
  94 :       SP2=SP*SP
  95 :       CP2=CP*CP
  96 :       SPCP=SP*CP
  97 :       DSP=D*SP
  98 :       DCP=D*CP
  99 :       ASP2=A*SP2
 100 :       ACP2=A*CP2
 101 :       BSP2=B*SP2
 102 :       BCP2=B*CP2
 103 :       ASPCP=A*SPCP
 104 :       BSPCP=B*SPCP
 105 :       AUX=22.D0*A-8.D0*B
 106 :       AUX1=13.D0*A-B
 107 : C     ----------   CALCULS
 108 :       AM(1,1)=156.D0*ACP2-84.D0*BCP2+140.D0*ASP2-70.D0*BSP2
 109 :       AM(1,2)=14.D0*BSPCP-16.D0*ASPCP
 110 :       AM(1,4)=-DCP*AUX
 111 :       AM(1,5)=54.D0*ACP2+70.D0*ASP2
 112 :       AM(1,6)=16.D0*ASPCP
 113 :       AM(1,8)=DCP*AUX1
 114 :       AM(2,2)=156.D0*ASP2-84.D0*BSP2+140.D0*ACP2-70.D0*BCP2
 115 :       AM(2,4)=DSP*AUX
 116 :       AM(2,5)=AM(1,6)
 117 :       AM(2,6)=54.D0*ASP2+70.D0*ACP2
 118 :       AM(2,8)=-DSP*AUX1
 119 :       AM(3,3)=140.D0*A-70.D0*B
 120 :       AM(3,7)=70.D0*A
 121 :       AM(4,4)=D2*(4.D0*A-B)
 122 :       AUX=22.D0*A+8.D0*B
 123 :       AUX1=13.D0*A+B
 124 :       AM(4,5)=-DCP*AUX1
 125 :       AM(4,6)=DSP*AUX1
 126 :       AM(4,8)=-3.D0*D2*A
 127 :       AM(5,5)=156.D0*ACP2+84.D0*BCP2+140.D0*ASP2+70.D0*BSP2
 128 :       AM(5,6)=-16.D0*ASPCP-14.D0*BSPCP
 129 :       AM(5,8)=DCP*AUX
 130 :       AM(6,6)=156.D0*ASP2+84.D0*BSP2+140.D0*ACP2+70.D0*BCP2
 131 :       AM(6,8)=-DSP*AUX
 132 :       AM(7,7)=140.D0*A+70.D0*B
 133 :       AM(8,8)=D2*(4.D0*A+B)
 134 : C     ----------   ON COMPLETE PAR SYMETRIE
 135 :       DO 50 I=2,8
 136 :          JFIN=I-1
 137 :          DO 501 J=1,JFIN
 138 :             AM(I,J)=AM(J,I)
 139 :  501     CONTINUE
 140 :  50   CONTINUE
 141 :  60   CONTINUE
 142 :       IF(IFOUR.GT.0) THEN
 143 :          DO  500 IA= 1,8
 144 :             DO  5001 IB= 1,8
 145 :                AMM(IA,IB)=AM(IA,IB)
 146 :  5001       CONTINUE
 147 :  500     CONTINUE
 148 :       ELSE IF(IFOUR.LE.0) THEN
 149 :          DO  600 IA= 1,6
 150 :             DO  6001 IB= 1,6
 151 :                AMM(IA,IB)=AM(II(IA),II(IB))
 152 :  6001       CONTINUE
 153 :  600     CONTINUE
 154 :       ENDIF
 155 :       IF(IFOUR.EQ.-3)THEN
 156 :          AMM(7,7)=COEF
 157 :          AMM(7,8)=COEF*XD
 158 :          AMM(7,9)=COEF*YD
 159 :          AMM(8,7)=AMM(7,8)
 160 :          AMM(8,8)=COEF*((D2*CP2/12.D0)+(E2*SP2/12.D0)+(XD*XD))
 161 :          AMM(8,9)=COEF*(SPCP*((E2/12.D0)-(D2/12.D0))+(XD*YD))
 162 :          AMM(9,7)=AMM(7,9)
 163 :          AMM(9,8)=AMM(8,9)
 164 :          AMM(9,9)=COEF*((E2*CP2/12.D0)+(D2*SP2/12.D0)+(YD*YD))
 165 :       ENDIF
 166 :       RETURN
 167 :       END
 168 : 
 169 : 
 170 : 
 171 : 
 172 :  
 173 :  
 174 :  
 175 :