C COQ8MA    SOURCE    CHAT      05/01/12    22:22:09     5004           
      SUBROUTINE COQ8MA (NBNO,RHOK,NBPGAU,ESP,EXCEN,WRK1,MINTE,MINTE2)          
C                                                                               
C       |--------------------------------------------------------------|        
C       | NOUVELLE PROCEDURE DE CALCUL DE LA MATRICE DE MASSE          |        
C       | AVEC UN ELEMENT DE COQUE A 8 NOEUDS                          |        
C       |                                                              |        
C       |                INSPIRE D'UNE ROUTINE PREEXISTANT DANS BILBO  |        
C       |--------------------------------------------------------------|        
C       |  ENTREES                                                     |        
C       |    NBPGAU :  NOMBRE DE POINTS DE GAUSS.                      |        
C       |    MINTE  :  FONCTIONS DE FORME AUX POINTS DE GAUSS          |        
C       |    MINTE2 :  FONCTIONS DE FORME AUX NOEUDS                   |        
C       |    RHOK   :  MASSE VOLUMIQUE.                                |        
C       |    ESP    :  EPAISSEUR.                                      |        
C       |    EXCEN  :  EXCENTREMENT.                                   |        
C       |    NBNO   :  NOMBRE DE NOEUDS                                |        
C       |--------------------------------------------------------------|        
C                                                                               
C                                                                               
C                                                                               
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8 (A-H,O-Z)                                                 
-INC     SMINTE                                                                 
      SEGMENT WRK7                                                              
      REAL*8 XJI(3,3),TXR(3,3,NBNO),FINT(3,LRE),XJ(3,3),B(3,3)                      
      REAL*8 TH(NBNO),EXC(NBNO),H(NBNO)                                                  
      ENDSEGMENT                                                                
      SEGMENT/WRK1/(REL(LRE,LRE)*D,XE(3,NBNO)*D)                                
      SEGACT MINTE                                                              
      SEGACT WRK1*MOD
      LRE=6*NBNO
      SEGINI WRK7                                                               
      DO 5 I = 1,NBNO                                                           
      EXC(I)=EXCEN                                                              
    5 TH(I) = ESP                                                               
C                                                                               
C     INITIALISATION DE LA MATRICE MASSE                                        
C                                                                               
      DO 10 I = 1,6*NBNO                                                        
      DO 10 J = 1,6*NBNO                                                        
      REL(I,J) = 0.D0                                                             
10    CONTINUE                                                                  
*                                                                               
*  CORRECTION RNUR  LE 12 / 9 / 90                                              
*                                                                               
      SEGACT MINTE2                                                             
      CALL CQ8LOC(XE,NBNO,MINTE2.SHPTOT,TXR,IRR)                                
      SEGDES MINTE2                                                       
*                                                                               
      DO 80 LX = 1,NBPGAU                                                       
      E3 = DZEGAU(LX)                                                           
      WT = POIGAU (LX)                                                          
      DO 20 I=1,NBNO                                                            
 20   H(I)=SHPTOT(1,I,LX)                                                       
      CALL CQ8JCE(LX,NBNO,E3,XE,TH,EXC,TXR,SHPTOT,B,DET,IRR)                    
      FACT = WT*DET*RHOK                                                        
      DO 30 I = 1,3                                                             
      DO 30 J = 1,NBNO*6                                                        
   30 FINT(I,J) = 0.D0                                                            
      DO 60 J = 1,NBNO                                                             
      DO 40 I = 1,3                                                             
   40 XJI(I,I) = 0.D0                                                             
      XJI(1,2) = TXR(1,1,J)*TXR(2,2,J) - TXR(2,1,J)*TXR(1,2,J)                  
      XJI(1,3) = TXR(1,1,J)*TXR(3,2,J) - TXR(1,2,J)*TXR(3,1,J)                  
      XJI(2,3) = TXR(2,1,J)*TXR(3,2,J) - TXR(2,2,J)*TXR(3,1,J)                  
      DO 50 IK = 1,3                                                            
      DO 50 JK = IK,3                                                           
   50 XJI(JK,IK) = -XJI(IK,JK)                                                  
      J1 = (J-1)*6 + 1                                                          
      J2 = J1 + 1                                                               
      J3 = J2 + 1                                                               
      J4 = J3 + 1                                                               
      J5 = J4 + 1                                                               
      J6 = J5 + 1                                                               
      A1 = H(J)*(0.5*E3*ESP+EXCEN)                                                      
      FINT(1,J1) = H(J)                                                         
      FINT(1,J5) = A1*XJI(1,2)                                                  
      FINT(1,J6) = A1*XJI(1,3)                                                  
      FINT(2,J2) = FINT(1,J1)                                                   
      FINT(2,J4) = -FINT(1,J5)                                                  
      FINT(2,J6) = A1*XJI(2,3)                                                  
      FINT(3,J3) = FINT(1,J1)                                                   
      FINT(3,J4) = -FINT(1,J6)                                                  
   60 FINT(3,J5) = -FINT(2,J6)                                                  
      DO 70 I = 1,NBNO*6                                                        
      DO 70 J = I,NBNO*6                                                        
      DO 70 K = 1,3                                                             
  70  REL(I,J) = REL(I,J) + FINT(K,I)*FINT(K,J)*FACT                            
   80 CONTINUE                                                                  
      DO 90 I = 1,NBNO*6                                                        
      DO 90 J = I,NBNO*6                                                        
   90 REL(J,I) = REL(I,J)                                                       
      SEGDES WRK1                                                               
      SEGDES MINTE                                                              
      SEGSUP WRK7                                                               
      RETURN                                                                    
      END