C RESHPT    SOURCE    CHAT      08/09/17    21:15:52     6160           
      SUBROUTINE RESHPT(NNNN,NBSH,IELE,MELE,NPINT,IPT,IRET)                           
C=======================================================                        
C                                                                               
C     MET LES VALEURS DES FONCTIONS DE FORMES DANS SHPTOT                       
C      ET LES COORDOONEES REDUITES LES POIDS D INTEGRATION                      
C      DANS QSIGAU ETAGAU DZEGAU POIGAU  ; LE TOUT EST                          
C      MIS DANS LE POINTEUR MINTE SON POINTEUR EST IPT                          
C     NNN   =NOMBRE DE POINTS DE GAUSS                                          
C     NBSH  =NOMBRE DE FONCTIONS D'INTERPOLATION                                
C     IELE  =NUMERO DE L ELEMENT DANS NOMS (VOIR CCGEOME )                      
C     MELE  =NUMERO DE L ELEMENT DANS NOMTP                                     
C    NPINT=NOMBRE DE POINTS D'INTEGRATION DONS LE CAS DES
C          ELEMENTS COQUES INTEGRES 
C     IPT   = POINTEUR  SUR MINTE                                               
C     IRET=1  OU  0  SUIVANT QUE MINTE A ETE CREEE OU PAS                       
C                                                                               
C     CETTE ROUTINE GERE LES MESSAGES D ERREURS                                 
C     PROVENANT DE L INCOMPATIBILTE ENTRE NOMS                                  
C     D ELEMENTS,NOMBRE DE POINTS DE GAUSS,ET FONCTIONS DE FORME                
C                                                                               
C=======================================================                        
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)                                                  
-INC CCGEOME                                                                    
-INC SMINTE                                                                     
-INC CCOPTIO                                                                    
      SEGMENT/SHXX/(SHPXXX(6,NBB)*D)                                            
      DIMENSION IMIPOR(5)                                                       
C                                                                               
      DATA IMIPOR/4,8,14,23,16/                                                 
C                                                                               
      NPINT1=NPINT
      NNN=NNNN                                                                  
      IRET=1                                                                    
      NBBB=NBNNE(IELE)                                                          
      NBNO=NBSH                                                               
      
      IP1C=0
      IF (MELE.GE.195.AND.NPINT.EQ.1) THEN
        IP1C=1
        NPINT1=0
      ELSEIF (MELE.GE.195.AND.NPINT.EQ.2) THEN
        IP1C=2
        NPINT1=0
      ENDIF
C      WRITE(6,*)'IP1C=',IP1C
      
      CALL DONRED(NNN,IELE,MELE,NBNO,NPINT1,IPT1,IRT1)
      IF (IRT1.EQ.1) GOTO 10                                                    
C                                                                               
C     MESSAGE D ERREUR  NBPGAU ET IELE NON COMPATIBLES POUR                     
C     L INSTANT                                                                 
C                                                                               
      MOTERR(1:4)=NOMS(IELE)                                                    
      INTERR(1)=NNN                                                             
      CALL ERREUR(67)                                                           
      IRET=0                                                                    
      GOTO 666                                                                  
  10  CONTINUE                                                                  
      MINTE=IPT1                                                                
      SEGACT MINTE*MOD
C                                                                               
      DO 110 IA=1,NNN                                                           
      DO 110 IB=1,6                                                             
      DO 110 IC=1,NBNO                                                          
      SHPTOT(IB,IC,IA)=0.D0
 110  CONTINUE                                                                  
      NBB=NBNO                                                                  
      SEGINI SHXX                                                               
*
*  BOUCLE SUR LES POINTS
*
      DO 100 II=1,NNN                                                           
C     INSERER EVENTUELLEMENT UN INDICATEUR DE SUCCES                            
      XX=QSIGAU(II)                                                             
      YY=ETAGAU(II)                                                             
      ZZ=DZEGAU(II)                                                             
      IF(MELE.EQ.96) THEN
        CALL SHAP96(XX,YY,ZZ,IELE,SHPXXX,IRT2)
      ELSE IF(MELE.EQ.128) THEN
        CALL SHROT3(XX,YY,ZZ,IELE,SHPXXX,IRT2)
      ELSEIF ((MELE.GE.111).AND.(MELE.LE.122)) THEN
        CALL SHPOLY(XX,YY,ZZ,II,MELE,SHPXXX,IRT2)
      ELSEIF ((MELE.GE.223).AND.(MELE.LE.236).AND.(IP1C.EQ.0)) THEN
        CALL SHMACR(XX,YY,ZZ,MELE,SHPXXX,IRT2)
      ELSEIF ((MELE.GE.195).AND.(IP1C.EQ.1)) THEN
        CALL SHP1CE(XX,YY,ZZ,MELE,SHPXXX,IRT2)
      ELSEIF(MELE.EQ.260) then
        CALL shSHB8(XX,shpxxx)
        irt2=1
      ELSE
        CALL SHAPE(XX,YY,ZZ,IELE,SHPXXX,IRT2)
      ENDIF
C                                                                               
C  TRAITEMENT SPECIAL MILIEU POREUX                                             
C                                                                               
      IF(MELE.GE.79.AND.MELE.LE.83) THEN                                        
      CALL SHAPE(XX,YY,ZZ,IMIPOR(MELE-78),
     .           SHPXXX(1,NBBB+1),IRT2)
*
      ELSE IF(MELE.GE.173.AND.MELE.LE.177) THEN
      CALL SHAPE(XX,YY,ZZ,IMIPOR(MELE-172),
     .           SHPXXX(1,NBBB+1),IRT2)
*
      ELSE IF(MELE.GE.178.AND.MELE.LE.182) THEN
      CALL SHAPE(XX,YY,ZZ,IMIPOR(MELE-177),
     .           SHPXXX(1,NBBB+1),IRT2)
*
      ENDIF                                                                     
C                                                                               
      DO 200 ID=1,6                                                             
      DO 200  NO=1,NBNO                                                         
      SHPTOT(ID,NO,II)=SHPXXX(ID,NO) 
*      WRITE(*,*) 'SHP (',ID,',',NO,') =',     SHPXXX(ID,NO)                                        
 200  CONTINUE                                                                  
 100  CONTINUE                                                                  
C                                                                               
C     ON CALCULE LES FONCTIONS D EXTRAPOLATIONS                                 
C                                                                               
      if( mele.ne.260) CALL EXTRAP(SHPTOT,NNN,NBBB,NBNO)
C                                                                               
      SEGSUP SHXX                                                               
      IF (IRT2.EQ.1) GOTO 20                                                    
C                                                                               
C     ERREUR LES FONCTIONS DE FORME PAS ENCORE IMPLEMENTEES                     
C                                                                               
      MOTERR(1:4)=NOMS(IELE)                                                    
      CALL ERREUR(68)                                                           
      IRET=0                                                                    
      SEGSUP MINTE                                                              
      GOTO 666                                                                  
  20  IPT=IPT1                                                        
      SEGDES MINTE                                                              
  666 CONTINUE                                                                  
      RETURN                                                                    
      END