Esope source files

   1 : C INTVA6    SOURCE    CHAT      05/01/13    00:41:57     5004           
   2 :       SUBROUTINE INTVA6 (NONVID)                                                
   3 : ************************************************************************        
   4 : *                                                                               
   5 : *                             I N T V A 6                                       
   6 : *                             -----------                                       
   7 : *                                                                               
   8 : * FONCTION:                                                                     
   9 : * ---------                                                                     
  10 : *                                                                               
  11 : *     ON A LA PARTITION D'INTERVALLE:                                           
  12 : *        ( ... , W(N-2), W2A, W2B)                                              
  13 : *     ON CREE LA PARTITION D'INTERVALLE:                                        
  14 : *        ( ... , W(N-2), W2A)                                                   
  15 : *                                                                               
  16 : *     "W(N-2)" PREND LE ROLE DE "W2A", "W2A" CELUI DE "W2B" ET                  
  17 : *     L'INTERVALLE EST REDUIT.                                                  
  18 : *                                                                               
  19 : * MODE D'APPEL:                                                                 
  20 : * -------------                                                                 
  21 : *                                                                               
  21 : *     CALL INTVA6 (NONVID)                                                      
  22 : *                                                                               
  23 : * PARAMETRES:   (E)=ENTREE   (S)=SORTIE                                         
  24 : * -----------                                                                   
  25 : *                                                                               
  26 : *     NONVID  LOGIQUE   (S)  = .TRUE. SI L'INTERVALLE RESULTANT EST             
  27 : *                            NON VIDE,                                          
  28 : *                            = .FALSE. SINON.                                   
  29 : *                                                                               
  30 : *     VOIR EGALEMENT LE COMMUN "CINTVA" DANS LE SOUS-PROGRAMME "INTVA2".        
  31 : *                                                                               
  32 : * SOUS-PROGRAMMES APPELES:                                                      
  33 : * ------------------------                                                      
  34 : *                                                                               
  35 : *     ENLEV1, ENLEV2, EXTRA1, EXTRA2, DTLENT, DTLREE.                           
  36 : *                                                                               
  37 : * AUTEUR, DATE DE CREATION:                                                     
  38 : * -------------------------                                                     
  39 : *                                                                               
  40 : *     PASCAL MANIGOT     24 DECEMBRE 1984                                       
  41 : *                                                                               
  42 : * LANGAGE:                                                                      
  43 : * --------                                                                      
  44 : *                                                                               
  45 : *     FORTRAN77                                                                 
  46 : *                                                                               
  47 : ************************************************************************        
  48 : *                                                                               
  49 :       IMPLICIT INTEGER(I-N)
  50 :       IMPLICIT REAL*8 (A-H,O-Z)                                                 
  51 : -INC CCOPTIO                                                                    
  52 : *                                                                               
  53 : *     REGROUPEMENT DES INFORMATIONS SUR LA SUITE DE PULSATIONS AU CARRE:        
  54 :       COMMON/CINTVA/IMULTP,IPW2,W2A,W2I,W2B,NBW2,IPNUM,NUMW2A,NUMW2I,           
  55 :      &      NUMW2B  ,IUN                                                        
  56 : *                                                                               
  57 :       LOGICAL NONVID                                                            
  58 : *                                                                               
  58 :       CALL ENLEV1 (IPW2,NBW2,  IPOINT)                                          
  59 :       IF (IERR .NE. 0) RETURN                                                   
  59 :       CALL DTLREE (IPW2)                                                        
  60 :       IPW2 = IPOINT                                                             
  61 : *                                                                               
  61 :       CALL ENLEV2 (IPNUM,NBW2,  IPOINT)                                         
  62 :       IF (IERR .NE. 0) RETURN                                                   
  62 :       CALL DTLENT (IPNUM)                                                       
  63 :       IPNUM = IPOINT                                                            
  64 : *                                                                               
  65 :       NBW2 = NBW2 - 1                                                           
  66 : *                                                                               
  67 :       IF (NBW2 .LT. 2) THEN                                                     
  68 : *                                                                               
  69 :          NONVID = .FALSE.                                                       
  70 : *                                                                               
  71 :       ELSE                                                                      
  72 : *                                                                               
  73 :          NONVID = .TRUE.                                                        
  74 :          W2B = W2A                                                              
  75 :          NUMW2B = NUMW2A                                                        
  76 : *                                                                               
  77 :          NBW2M1 = NBW2 - 1                                                      
  77 :          CALL EXTRA1 (IPW2,NBW2M1,  W2A)                                        
  78 :          IF (IERR .NE. 0) RETURN                                                
  78 :          CALL EXTRA2 (IPNUM,NBW2M1,  NUMW2A)                                    
  79 :          IF (IERR .NE. 0) RETURN                                                
  80 : *                                                                               
  81 :       END IF                                                                    
  82 : *                                                                               
  83 :       END                                                                       
  84 :