C SORE      SOURCE    CHAT      11/03/16    21:31:42     6902           
    
      SUBROUTINE SORE                                                          
************************************************************************        
*                                                                               
*                             SORE                                        
*                             ----                                                                                                                 
*                                                                               
* FONCTION:                                                                     
* ---------                                                                     
*     CREATION D UNE MATRICE DE CONDUCTIVITE  ASSOCIEE A L EFFET SORET 
*              INTEGRATION DE    N DIV(GRAD T)
*        ELEMENTS MASSIFS UNIQUEMENT                                 
*                                                                               
* PHRASE D'APPEL (EN GIBIANE):                                                  
* ----------------------------                                                  
*                                                                               
*     CND1 = SORE  MOD1 MAT1  MCHAM1 CHPO1  ;                                       
*                                                                               
* OPERANDES ET RESULTAT:                                                        
* ----------------------                                                        
*                                                                               
*     CND1     'RIGIDITE'  MATRICE DE CONDUCTIVITE 
*                             
*     MOD1     'MODELE'    STRUCTURE MODELISEE 
*     MAT1     'MCHAML'    PROPRIETES  DU MATERIAU 
*     MCHAM1   'MCHAML'    CHAMP DES FACTEURS DU POTENTIEL                        
*     CHPO1    'CHPOINT'   POTENTIEL DONT LE GRADIENT EST LA 'FORCE MOTRICE'                                                          
*                                                                                                                                                                                                                                                                                                                                                                                                                                                                                  
*                                                                               
* AUTEUR,DATE DE CREATION:                                                      
* ------------------------                                                      
*                                                                               
*     J.M.BAZE   AVRIL 97                                           
*                                                                               
* LANGAGE:                                                                      
* --------                                                                      
*                                                                               
*       ESOPE + FORTRAN77                                                       
*                                                                               
************************************************************************                                               
*                                                                
      IMPLICIT INTEGER(I-N)
-INC CCOPTIO                                                                    
-INC SMCHAML  
-INC SMMODEL 
-INC SMCHPOI
      CHARACTER*8 LETYPE 
      PARAMETER ( LINUM=14,LINUC=12)                                            
      INTEGER INUMA(LINUM)
 
*                TRI3 TRI6 QUA4 QUA8 CUB8 CU20 PRI6 PR15                        
      DATA INUMA/   4,   6,   8,  10,  14,  15,  16,  17,                       
*                TET4 TET10 PYR5 PY13 T1D2 T1D3                                 
     1             23,   24,  25,  26, 191, 192 /


*      SEGMENT INFO
*      INTEGER INFELE(JG) 
*      END SEGMENT
                                                                                     
      MOTERR(1:8)=' MODELE '                                                    
      CALL MESLIR(-137)                                                         
      CALL LIROBJ('MMODEL',IPMODE,1,IRET1)                                      
      IF (IERR.NE.0) RETURN 
*      
      CALL MESLIR(-135)                                                         
      CALL LIROBJ('MCHAML',IPCHEL,1,IRET1)                                      
      IF (IERR.NE.0) RETURN       
* *                                                                               
*     TEST SUR LE SOUS-TYPE DE LE CHAMELEM                                      
*                                                                               
      MCHELM=IPCHEL                                                             
      SEGACT,MCHELM                                                             
*                                                                               
      LETYPE = TITCHE                                                           
      IF (LETYPE.NE.'CARACTER') THEN                                            
         SEGDES,MCHELM                                                    
         MOTERR='CARACTERISTIQUES'                                              
         CALL ERREUR(291)                                                       
         RETURN                                                                 
      ENDIF          
*
      MOTERR(1:8)='MCHAML  '  
      CALL MESLIR(-137)                                                         
      CALL LIROBJ('MCHAML',IPCHE1,1,IRET1)                                      
      IF (IERR.NE.0) RETURN 
                                                              
      MOTERR(1:8)='CHPOINT '                                                                              
      CALL MESLIR(-137) 
      CALL LIROBJ('CHPOINT',IPCHPO,1,IRETOU)
      IF (IERR.NE.0) RETURN                                                                            
*  quelque verifications . formulation pour massifs exclusivement

      MMODEL = IPMODE       
      SEGACT,MMODEL
      NSOUS = KMODEL(/1)
*      
      DO 10 ISOUS = 1,NSOUS
      IMODEL = KMODEL(ISOUS)
      SEGACT,IMODEL
      NF1 = FORMOD(/2)
      NEF = NEFMOD          
      CALL PLACE(FORMOD,NF1,IF1,'THERMIQUE')   
      CALL PLACE2(INUMA,LINUM,IOK,NEF)      
         IF (IF1.EQ.0.OR.IOK.EQ.0) THEN     
*             OPTION INDISPONIBLE 
          CALL ERREUR(19)  
          SEGDES,IMODEL,MMODEL
          RETURN
         ENDIF
          SEGDES,IMODEL      
 10   CONTINUE 
      SEGDES,MMODEL 
      
*   on veut un chpoint  de composante  T

       MCHPOI = IPCHPO
       SEGACT,MCHPOI       
       SEGINI,MCHPO1 = MCHPOI
       SEGDES,MCHPOI 
*        
       IPCHP2 = MCHPO1      
       NSOUS = MCHPO1.IPCHP(/1) 
       DO 20 IZ = 1,NSOUS
       MSOUPO = MCHPO1.IPCHP(IZ)
       SEGACT,MSOUPO*MOD
       NOCOMP(1) = 'T   '
       SEGDES,MSOUPO
 20    CONTINUE 
       SEGDES,MCHPO1                                                                              
                                                                         
      CALL SORE1(IPMODE,IPCHEL,IPCHE1,IPCHPO,IPRIGI)                                    
      IF (IERR.NE.0) RETURN                                                     
*                                                                               
      CALL ECROBJ('RIGIDITE',IPRIGI)                                            
      RETURN                                                                    
      END