C ENVSPE    SOURCE    CHAT      05/01/12    23:41:02     5004           
      SUBROUTINE ENVSPE                                                         
************************************************************************        
*                                                                               
*                             E N V S P E                                       
*                             -----------                                       
*                                                                               
*     SOUS-PROGRAMME ASSOCIE A L'OPERATEUR "ENVELOPPE"                          
*                                                                               
* FONCTION:                                                                     
* ---------                                                                     
*                                                                               
*     CREER LE SPECTRE ENVELOPPE D'UNE SERIE DE SPECTRES D'OSCILLATEURS.        
*                                                                               
*     CET OPERATEUR EST TRES ATTACHE A LA NOTION DE SPECTRE CAR IL              
*     UTILISE L'INTERPOLATION LINEAIRE OU LOGARITHMIQUE DE FACON BIEN           
*     SPECIFIQUE.                                                               
*                                                                               
* PHRASE D'APPEL (EN GIBIANE):                                                  
* ----------------------------                                                  
*                                                                               
*     ENVLOP  =  'ENVELOPPE'  LIST_SPO  ;                                       
*                                                                               
* OPERANDES ET RESULTATS:                                                       
* -----------------------                                                       
*                                                                               
*     LIST_SPO  (TABLE)     CONTIENT LES DIFFERENTS SPECTRES                    
*     --------              D'OSCILLATEUR (PAS FORCEMENT DEFINIS AUX            
*                           MEMES FREQUENCES, NI POUR LES MEMES                 
*                           AMORTISSEMENTS):                                    
*       LIST_SPO I 'SPECTRE        = OBJET "EVOLUTIO" REPRESENTANT LE           
*                                    I-EME "SPO".                               
*       LIST_SPO I 'AMORTISSEMENT' = OBJET "LISTREEL" DONNANT LES               
*                                    AMORTISSEMENTS POUR CHAQUE COURBE          
*                                    DE L'OBJET "EVOLUTIO" NUMERO "I".          
*                                                                               
*     ENVLOP    (TABLE)     CONTIENT LE SPECTRE ENVELOPPE:                      
*     ------                                                                    
*       LIST_SPO 'SPECTRE'         = OBJET "EVOLUTIO" REPRESENTANT LE           
*                                    SPECTRE.                                   
*       LIST_SPO 'AMORTISSEMENT'   = OBJET "LISTREEL" DONNANT LES               
*                                    AMORTISSEMENTS POUR CHAQUE COURBE          
*                                    DE L'OBJET "EVOLUTIO".                     
*                                                                               
* MODULES UTILISES:                                                             
* -----------------                                                             
*                                                                               
      IMPLICIT INTEGER(I-N)
-INC CCOPTIO                                                                    
-INC SMTABLE                                                                    
*                                                                               
* VARIABLES:                                                                    
* ----------                                                                    
*                                                                               
*     IPEVOL = SPECTRES D'OSCILLATEUR (OBJETS "EVOLUTIO").                      
*              EN DERNIERE POSITION, ENVELOPPE.                                 
*     IPAMOR = VALEURS DES AMORTISSEMENTS DE CHAQUE SPECTRE (OBJETS             
*              "LISTREEL").                                                     
*                                                                               
      REAL*8 X,XVALRE                                                           
      CHARACTER*1 C                                                             
      CHARACTER*8 TYPOBJ,CHARRE                                                 
      LOGICAL L,LOGIN,LOGRE                                                     
      SEGMENT,MSPECT                                                            
         INTEGER IPEVOL(NBSPEC+1),IPAMOR(NBSPEC+1)                              
      ENDSEGMENT                                                                
*                                                                               
* AUTEUR, DATE DE CREATION:                                                     
* -------------------------                                                     
*                                                                               
*     PASCAL MANIGOT     13 SEPTEMBRE 1988                                      
*                                                                               
* LANGAGE:                                                                      
* --------                                                                      
*                                                                               
*     ESOPE + FORTRAN77 + EXTENSION: DECLARATION "REAL*8".                      
*                                                                               
************************************************************************        
*                                                                               
      CALL LIROBJ ('TABLE   ',ISPEC,1,IRETOU)                                   
      IF (IERR .NE. 0) RETURN                                                   
*                                                                               
*     NOMBRE DE SPECTRES D'OSCILLATEURS FOURNI:                                 
      CALL DIMEN7 (ISPEC,  NBSPEC)                                              
      IF (NBSPEC .LE. 0) THEN                                                   
         CALL ERREUR (215)                                                      
         RETURN                                                                 
      END IF                                                                    
*                                                                               
*     LA TABLE EST SUPPOSEE ETRE INDICEE PAR DES ENTIERS, A PARTIR DE 1.        
*     ... CE QUE L'ON VA VERIFIER TOUT DE SUITE, EN MEME TEMPS QUE L'ON         
*     RANGE LES SPECTRES SOUS UNE FORME INFORMATIQUEMENT PLUS PRATIQUE.         
*                                                                               
      SEGINI,MSPECT                                                             
*                                                                               
      DO 100 IB=1,NBSPEC                                                        
         TYPOBJ = 'TABLE   '                                                    
         CALL ACCTAB(ISPEC,'ENTIER  ',IB,0.D0,C,LOGIN ,0,TYPOBJ,                
     C    IVALRE,XVALRE,CHARRE,LOGRE,ICOUR)                                     
         IF (TYPOBJ.NE.'TABLE   ') THEN                                         
           MOTERR(1:8)=TYPOBJ(1:8)                                              
           CALL ERREUR(39)                                                      
         ENDIF                                                                  
         IF (IERR .NE. 0) RETURN                                                
         TYPOBJ = 'EVOLUTIO'                                                    
         CALL ACCTAB(ICOUR,'MOT     ',0,0.D0,'SPECTRE',LOGIN ,0,TYPOBJ,         
     C    IVALRE,XVALRE,CHARRE,LOGRE,IPTR)                                      
         IF (TYPOBJ.NE.'EVOLUTIO') THEN                                         
           MOTERR(1:8)=TYPOBJ(1:8)                                              
           CALL ERREUR(39)                                                      
         ENDIF                                                                  
         IF (IERR .NE. 0) RETURN                                                
         IPEVOL(IB) = IPTR                                                      
         TYPOBJ = 'LISTREEL'                                                    
         CALL ACCTAB(ICOUR,'MOT     ',0,0.D0,'AMORTISSEMENT',LOGIN ,0,          
     C    TYPOBJ,IVALRE,XVALRE,CHARRE,LOGRE,IPTR)                               
         IF (TYPOBJ.NE.'LISTREEL') THEN                                         
           MOTERR(1:8)=TYPOBJ(1:8)                                              
           CALL ERREUR(39)                                                      
         ENDIF                                                                  
         IF (IERR .NE. 0) RETURN                                                
         IPAMOR(IB) = IPTR                                                      
  100    CONTINUE                                                               
*     END DO                                                                    
*                                                                               
*     CREATION DU SPECTRE ENVELOPPE:                                            
      CALL ENVSP1 (MSPECT)                                                      
      IF (IERR .NE. 0) RETURN                                                   
*                                                                               
      CALL CRTABL(MTABLE)                                                       
      SEGACT,MSPECT                                                             
      IPEV0L = IPEVOL(NBSPEC+1)                                                 
      CALL ECCTAB (MTABLE,'MOT     ',I,X,'SPECTRE',L,I,                         
     &                    'EVOLUTIO',I,X,C,L,IPEV0L)                            
      IPAM0R = IPAMOR(NBSPEC+1)                                                 
      CALL ECCTAB (MTABLE,'MOT     ',I,X,'AMORTISSEMENT',L,I,                   
     &                    'LISTREEL',I,X,C,L,IPAM0R)                            
*                                                                               
      SEGSUP,MSPECT                                                             
      SEGDES,MTABLE                                                             
*                                                                               
*     ECRITURE DU SPECTRE ENVELOPPE:                                            
      CALL ECROBJ ('TABLE   ',MTABLE)                                           
*                                                                               
      END