[updated 8.Sep.2008]

Qui appelle xsterm ?

      SUBROUTINE XSTERM (SOUH,NMTRM1,NVTRM1,NMTRM2,NVTRM2
     &                  ,TYRESU,RESULT,CESULT)

  Auteur : D.Martin (Novembre 1990)  
  Derniere modification : D.Martin (30 Decembre 1999)
  Version 1.0.1
   
  Produit scalaire ou hermitien de deux vecteurs de meme numerotation
   
 -- Arguments d'entree -- 
  SOUH   SOUH(1:1)='S' pour produit scalaire, 'H' pour produit hermitien  
  NMTRM1 nom du premier vecteur
  NVTRM1 son niveau
  NMTRM2 nom du second vecteur 
  NVTRM2 son niveau
 -- Arguments de sortie --
  TYRESU type du resultat (variable CHARACTER contenant 'REEL' ou 'COMPLEXE')  
  RESULT resultat dans le cas reel
  CESULT resultat dans le cas complexe

      CHARACTER*(*) SOUH,NMTRM1,NMTRM2,TYRESU 
      INTEGER       NVTRM1,NVTRM2
      REAL          RESULT
      COMPLEX       CESULT
   
      INCLUDE 'ALLOC'
 
      CHARACTER     TYPINT*4,UPPERC*1
      INTEGER       INTTYP
      CHARACTER     ERCODE*120
      INTEGER       LGTRM1,MCTRM1,ITYPT1,NCATR1
     &             ,LGTRM2,MCTRM2,ITYPT2,NCATR2
      COMMON/FORMAH/ERCODE

      CALL PRFXMJ (1,'*XsTerm*')
 
      CALL TBRR2  (ERCODE,NMTRM1,NVTRM1,LGTRM1,NMTRM2,NVTRM2,LGTRM2)
      IF (LGTRM1.NE.LGTRM2) GOTO 99990  
      CALL TBAR2  (ERCODE,NMTRM1,NVTRM1,MCTRM1,NMTRM2,NVTRM2,MCTRM2)
      CALL TBTYPE (NMTRM1,NVTRM1,ITYPT1)
      CALL TBTYPE (NMTRM2,NVTRM2,ITYPT2)
 
      ERCODE(1:1)=UPPERC (SOUH)                                         !utilite
      IF (ERCODE(1:1).EQ.'S') THEN
         CALL TSCALT (LGTRM1,TYPINT(ITYPT1),MCTRM1,RST,CST
     &                      ,TYPINT(ITYPT2),MCTRM2,RST,CST,CESULT)      !utilite
      ELSEIF (ERCODE(1:1).EQ.'H') THEN
         CALL THERMT (LGTRM1,TYPINT(ITYPT1),MCTRM1,RST,CST
     &                      ,TYPINT(ITYPT2),MCTRM2,RST,CST,CESULT)      !utilite
      ENDIF
      TYRESU='COMPLEXE'
      IF (ITYPT1.EQ.ITYPT2.AND.ITYPT1.EQ.INTTYP ('REEL')) THEN          !utilite
         TYRESU='REEL' 
         RESULT=REAL (CESULT)
      ENDIF
      CALL TBSAVE (NMTRM1,NVTRM1)
      CALL TBSAVE (NMTRM2,NVTRM2)
      CALL PRFXMJ (-1,'*XsTerm*')  
      RETURN

99990 CALL PRNTRM (NMTRM1,NVTRM1,ERCODE,NCATR1)
      CALL PRNTRM (NMTRM2,NVTRM2,ERCODE(NCATR1+1:),NCATR2)
      CALL BAISE  ('Incompatibilite des longueurs de termes lors du' 
     &//' produit scalaire des tableaux '
     &//ERCODE(1:NCATR1)//' et '//ERCODE(NCATR1+1:NCATR1+NCATR2))
                                                                    END !XsTerm

xsterm est appelé dans (4 procédures)