Esope source files

   1 : C EXACHP    SOURCE    PV        13/04/11    21:15:46     7755           
   2 :       SUBROUTINE EXACHP (ICOLAC,ITLACC,M1,M2,IIICHA)                            
   3 : C----------------------------------------------------------------------         
   4 : C                                                                               
   5 : C  BUT:  REMPLIT LES PILES A PARTIR DE L EXAMEN DES CHPOINTS                    
   6 : C        SI IIICHA =1 ON  CHANGE  LES POINTEURS----                             
   7 : C                                                                               
   8 : C     ENTREE ITLACC POINTEUR DE LA PILE EXAMINEE                                
   9 : C            ICOLAC POINTEUR SUR LE CHAPEAU DES PILES                           
  10 : C            M1     @REMIER INDICE D EXAMEN DANS LA PILE                        
  11 : C            M2     DERNIER INDICE                                              
  12 : C            IIICHA =1 ON CHANGE LES POINTEURS                                  
  13 : C----------------------------------------------------------------               
  14 : C   APPELE PAR EXPIL                                                            
  15 : C   APPELLE AJOUN                                                               
  16 : C                                                                               
  17 : C=======================================================================        
  18 : C  TABLEAU KCOLA :                                                              
  19 : C    1  MELEME  2 CHPOIN  3 MRIGID  4 MCHAFF  5 MCHELM  6                       
  20 : C    7          8 MSOLUT  9 MSTRUC 10        11 MAFFEC 12 MSOSTU                
  21 : C   13  IMATRI 14 MJONCT 15 MATTAC 16 MMATRI 17 MDEFOR 18 MLREEL                
  22 : C   19  MLENTI 20 MCHARG 21 MODELE 22 MEVOLL 23 MSUPER                          
  23 : C=======================================================================        
  24 : C                                                                               
  25 :       IMPLICIT INTEGER(I-N)
  26 :       IMPLICIT REAL*8(A-H,O-Z)                                                  
  27 :       logical ooovp1
  28 : -INC SMCHPOI                                                                    
  29 : -INC CCOPTIO                                                                    
  30 : -INC TMCOLAC          
  31 :       ICO1=KCOLA(1)
  32 :       ILISSE=ILISSG
  33 :       SEGACT ILISSE*MOD                                                         
  34 :       DO 604 IEL=M1,m2
  35 :       MCHPOI=ITLAC(IEL)                                                         
  36 :       IF (MCHPOI.EQ.0) GO TO 604                                                
  37 :       if (.NOT.ooovp1(mchpoi)) goto 610
  38 :       SEGACT MCHPOI                                                             
  39 :       IJK=IPCHP(/1)                                                             
  40 :       IF (IJK.EQ.0) GO TO 606                                                   
  41 :       if (ijk.gt.1000) GOTO 610
  42 :       DO 605 I=1,IJK                                                            
  43 :       MSOUPO=IPCHP(I)                                                           
  44 :       IF (MSOUPO.EQ.0) GO TO 610
  45 :       if (.NOT.ooovp1(msoupo)) goto 610
  46 :       SEGACT MSOUPO*MOD
  47 :       IVA=IGEOC                                                                 
  48 : *  compression des meleme si possible
  49 :         if (iva.gt.0) then
  49 :          call chleha(0,iva,ivas,ico1)
  50 :          if (ivas.ne.0) then
  51 :           iva=ivas
  52 :           igeoc = iva
  52 : **        call ecchpo(mchpoi,1)
  53 :           segact mchpoi
  54 :           SEGACT MSOUPO*MOD
  55 :          endif
  56 :         endif
  57 :       IF (IVA.GT.0) THEN                                                        
  57 :          CALL AJOUN(ICO1,IVA,ILISSE,1)                                                   
  58 :                               IF(IIICHA.EQ.1) IGEOC =-IVA                       
  59 :       ENDIF                                                                     
  60 :       SEGDES MSOUPO                                                             
  61 :  605  CONTINUE                                                                  
  62 :  606  SEGDES MCHPOI                                                             
  63 :       goto 604
  64 :  610  continue
  65 : *  chpoint invalide. On le supprime de la pile
  66 :        moterr(1:8)='CHPOINT'
  67 :        interr(1)=itlac(iel)
  67 :        call erreur(861)
  68 :        itlac(iel)=0
  69 :  604  CONTINUE                                                                  
  70 :       RETURN                                                                    
  71 : C     ************                                                              
  72 :       END                                                                       
  73 :  
  74 :  
  75 :  
  76 :  
  77 :  
  78 :  
  79 :  
  80 :  
  81 :  
  82 :  
  83 :