C PSCALA    SOURCE    CHAT      05/01/13    02:37:12     5004           
C   CALCULE LE PRODUIT SCALAIRE DE DEUX VECTEURS                                
C                            OU DE DEUX CHPOINTS                                
C                            OU DE DEUX TABLES DE SOUS-TYPE VECTEUR
C                            OU DE DEUX CHAMELEMS             
C                                                                               
      SUBROUTINE PSCALA                                                         
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8 (A-H,O-Z)                                                 
-INC CCOPTIO                                                                    
-INC SMCOORD                                                                    
-INC SMTABLE                                                                    
      CHARACTER*8 CAUX1,CAUX2                                                   
      CALL LIROBJ('POINT ',IP1,0,IRETOU)                                        
      IF(IRETOU.EQ.0) GO TO 10                                                  
C                                                                               
C     CAS DE DEUX VECTEURS                                                      
C                                                                               
      CALL LIROBJ('POINT ',IP2,1,IRETOU)                                        
      IF (IERR.NE.0) RETURN                                                     
      SEGACT MCOORD                                                             
      IREF1=(IDIM+1)*(IP1-1)                                                    
      IREF2=(IDIM+1)*(IP2-1)                                                    
      SCAL=0.D0                                                                 
      DO 1 I=1,IDIM                                                             
      SCAL=SCAL+XCOOR(IREF1+I)*XCOOR(IREF2+I)                                   
   1  CONTINUE                                                                  
      CALL ECRREE(SCAL)                                                         
      RETURN                                                                    
C                                                                               
C     CAS DE DEUX CHPOINTS                                                      
C                                                                               
  10  CONTINUE                                                                  
      CALL LIROBJ('CHPOINT ',MCHPO1,0,IRETOU)                                   
      IF(IRETOU.EQ.0) GOTO 20                                                   
      CALL LIROBJ('CHPOINT ',MCHPO2,1,IRETOU)                                   
      CALL LIROBJ('LISTMOTS',MLMOTX,1,IRETOU)                                   
      CALL LIROBJ('LISTMOTS',MLMOTY,1,IRETOU)                                   
      IF(IERR.NE.0) RETURN                                                      
      CALL PROSCA(MCHPO1,MCHPO2,MLMOTX,MLMOTY,IRET)                             
      CALL ECROBJ('CHPOINT ',IRET)                                              
      RETURN                                                                    
  20  CONTINUE                                                                  
C                                                                               
C     CAS DE DEUX CHAMELEMS                                                      
C                                                                 
      CALL LIROBJ('MCHAML ',IPCHE1,0,IRETOU)                                   
      IF(IRETOU.EQ.0) GOTO 30                                                   
      CALL LIROBJ('MCHAML ',IPCHE2,1,IRETOU)                                   
      CALL LIROBJ('LISTMOTS',MLMOTX,1,IRETOU)                                   
      CALL LIROBJ('LISTMOTS',MLMOTY,1,IRETOU)                                   
      IF(IERR.NE.0) RETURN                                                      
      CALL SCACHA(IPCHE1,IPCHE2,MLMOTX,MLMOTY,IRET)                             
      CALL ECROBJ('MCHAML',IRET)                                              
      RETURN 
 30   CONTINUE       
      CALL LIRTAB('VECTEUR',MTAB1,0,IRETOU)                                     
      IF(IRETOU.EQ.0) GO TO 40                                                  
      CALL LIRTAB('VECTEUR',MTAB2,1,IRETOU)                                     
      IF(IERR.NE.0) RETURN                                                      
*  ON FAIT LE PRODUIT SCALAIRE DE TOUS LES REELS ISOINDICES                     
      SEGACT MTAB1,MTAB2                                                        
      SCAL=0.D0                                                                 
      DO 100 I=1,MTAB1.MLOTAB                                                   
       CAUX1=MTAB1.MTABTV(I)                                                    
       IAUX1=MTAB1.MTABIV(I)                                                    
       XAUX1=MTAB1.RMTABV(I)                                                    
       CAUX2=MTAB1.MTABTI(I)                                                    
       IAUX2=MTAB1.MTABII(I)                                                    
       XAUX2=MTAB1.RMTABI(I)                                                    
       IF (CAUX1.EQ.'FLOTTANT') THEN                                            
        VAL1=XAUX1                                                              
       ELSEIF (CAUX1.EQ.'ENTIER  ') THEN                                        
        VAL1=IAUX1                                                              
       ELSE                                                                     
        GOTO 100                                                                
       ENDIF                                                                    
       DO 110 J=1,MTAB2.MLOTAB                                                  
        IF (MTAB2.MTABTI(J).NE.CAUX2) GOTO 110                                  
        IF (CAUX2.EQ.'FLOTTANT') THEN                                           
          IF (MTAB2.RMTABI(J).NE.XAUX2) GOTO 110                                
        ELSE                                                                    
          IF (MTAB2.MTABII(J).NE.IAUX2) GOTO 110                                
        ENDIF                                                                   
        IF (MTAB2.MTABTV(J).EQ.'FLOTTANT') THEN                                 
         VAL2=MTAB2.RMTABV(J)                                                   
        ELSEIF (MTAB2.MTABTV(J).EQ.'ENTIER  ') THEN                             
         VAL2=MTAB2.MTABIV(J)                                                   
        ELSE                                                                    
         GOTO 100                                                               
        ENDIF                                                                   
        SCAL=SCAL+VAL1*VAL2                                                     
 110   CONTINUE                                                                 
 100  CONTINUE                                                                  
      CALL ECRREE(SCAL)                                                         
      SEGDES MTAB1,MTAB2                                                        
      RETURN                                                                    
                                                                             
                                                                             
C    PAS D OPERANDE CORRECTE TROUVE                                             
C                                                                               
 40   CALL QUETYP(MOTERR(1:8),0,IRETOU)                                         
      IF(IRETOU.NE.0) THEN                                                      
         CALL ERREUR (39)                                                       
      ELSE                                                                      
         CALL ERREUR(533)                                                       
      ENDIF                                                                     
      RETURN                                                                    
      END