C INDCR     SOURCE    PV        09/03/12    21:25:16     6325           
      SUBROUTINE INDCR(MOT,NMO,IER,IMAIL,ICHA)                                  
C=======================================================================        
C     SUBROUTINE DE LA PROCEDURE INDIC DE QUALITE D'UN MAILLAGE                 
C          PHILIPPE BEAUMIER  90                                                
C     CONTIENT LES ZONES RELATIVES AUX DIFFERENTS CHAMPS                        
C     CREATION DU CHAMELEM RESULTAT                                             
C                                                                               
C=======================================================================        
C                                                                               
C  INPUT                                                                        
C                                                                               
C     MOT    : SUCCESSION DES MOTS CLES LUS                                     
C     NMO   : NOMBRE DE MOTS CLES LUS                                           
C     IER    : INDICATEUR D'ERREUR (0 SI ERREUR)                                
C     IMAIL  : POINTEUR SUR LE MAILLAGE                                         
C     ICHA   : POINTEUR SUR LE CHAMELEM                                         
C                                                                               
C   OUTPUT                                                                      
C                                                                               
C     ICHA   : POINTEUR SUR LE CHAMELEM                                         
C                                                                               
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)                                                  
-INC CCOPTIO                                                                    
-INC SMCHAML                                                                    
-INC SMELEME                                                                    
-INC SMCOORD                                                                    
C                                                                               
      CHARACTER*(*) MOT(*)                                                      
      SEGMENT/WRK1/(XE(3,NBNO))                                                 
C                                                                               
      IER = 1                                                                   
      MELEME = IMAIL                                                            
      SEGACT MELEME                                                             
      IPT1 = MELEME                                                             
      IF(NMO.EQ.0) IER=0                                                        
      IF(IER.EQ.0) GOTO 666                                                     
      L1=7                                                                      
      NSOUS = LISOUS(/1)                                                        
      N1=NSOUS                                                                  
      IF(N1.EQ.0) N1=1                                                          
      N3=5                                                                      
      SEGINI MCHELM                                                             
      ICHA = MCHELM                                                             
      IFOCHE = IFOUR                                                            
C                                                                               
C     BOUCLE SUR LES DIFFERENTS MOTS CLES                                       
C                                                                               
      DO 1 IMOT=1,NMO                                                           
      IF (MOT(IMOT).EQ.'PLAN') THEN                                             
C                                                                               
C======================================================================         
C                                                                               
C     ZONE RELATIVE AU CALCUL DE LA PLANEARITE DU MAILLAGE                      
C                                                                               
C======================================================================         
C                                                                               
C     ON CREE UN CHAMELEM INDIQUANT LA PLANEARITE D'UN MAILLAGE                 
C                                                                               
      TITCHE='QUALITE'                                                          
      DO 10 ISOUS=1,MAX(1,NSOUS)                                                
      IF(NSOUS.NE.0) THEN                                                       
      IPT1=LISOUS(ISOUS)                                                        
      SEGACT IPT1                                                               
      ENDIF                                                                     
      IMACHE(ISOUS)=IPT1                                                        
      CONCHE(ISOUS)='                '                                          
      INFCHE(ISOUS,1)=0                                                         
      INFCHE(ISOUS,2)=0                                                         
      INFCHE(ISOUS,3)=NIFOUR                                                    
      INFCHE(ISOUS,4)=0                                                         
      INFCHE(ISOUS,5)=0                                                         
      N2 = NMO                                                                  
      SEGINI MCHAML                                                             
      NOMCHE(IMOT)='PLAN'                                                       
      TYPCHE(IMOT)='REAL*8'                                                     
      ICHAML(ISOUS)=MCHAML                                                      
      IF(((IPT1.ITYPEL).NE.8).AND.((IPT1.ITYPEL).NE.10).AND.                    
     1 ((IPT1.ITYPEL).NE.4).AND.((IPT1.ITYPEL).NE.6)) THEN                      
C                                                                               
C     LES ELEMENTS NE SONT PAS DES QUA4,QUA8,TRI3,TRI6                          
C                                                                               
      N1PTEL=0                                                                  
      N2PTEL=0                                                                  
      N1EL=0                                                                    
      N2EL=0                                                                    
      SEGINI MELVAL                                                             
      IELVAL(IMOT)=MELVAL                                                       
      ELSE                                                                      
C                                                                               
C     ELEMENT QUA4,QUA8,TRI3,TRI6                                               
C                                                                               
      N1PTEL=1                                                                  
C     NB DE NOEUDS PAR ELEMENT DANS LE MELEME                                   
      N2PTEL=0                                                                  
      N1EL=IPT1.NUM(/2)                                                         
C     NB D'ELEMENTS DANS LE MELEME                                              
      N2EL=0                                                                    
      SEGINI MELVAL                                                             
      IELVAL(IMOT)=MELVAL                                                       
C                                                                               
C     CALCUL DES VALEURS DU CHAMP                                               
C                                                                               
      NBNO = IPT1.NUM(/1)                                                       
      SEGINI WRK1                                                               
      CALL NORCOS(VELCHE,IPT1.NUM(/1),N1EL,XCOOR,IDIM,IPT1.NUM,                 
     1 XE,IPT1.ITYPEL)                                                          
      SEGDES WRK1                                                               
      ENDIF                                                                     
      SEGDES MELVAL                                                             
      IF(NSOUS.NE.0) THEN                                                       
      SEGDES IPT1                                                               
      ENDIF                                                                     
      SEGDES MCHAML                                                             
   10 CONTINUE                                                                  
C                                                                               
      ELSE                                                                      
C                                                                               
C     AUTRES MOTS CLES                                                          
C                                                                               
      ENDIF                                                                     
C                                                                               
    1 CONTINUE                                                                  
      MCHELM = ICHA                                                             
      SEGDES MCHELM                                                             
      MELEME=IMAIL                                                              
      SEGDES MELEME                                                             
666   RETURN                                                                    
      END