Download restme.eso

Back to the list

   1 : C RESTME    SOURCE    CHAT      05/01/13    02:54:00     5004           
   2 :       SUBROUTINE RESTME  (ITLACC,IMAX1,ICOLAC,IDEB)                                         
   3 :       IMPLICIT INTEGER(I-N)
   4 :       IMPLICIT REAL*8 (A-H,O-Z)                                                 
   5 : C=======================================================================        
   6 : C   RESTAURATION DES POINTEURS                                                  
   7 : C                                                                               
   8 : C   APPELE PAR RESTPI                                                           
   9 : C   APPELLE : ERREUR                                                            
  10 : C=======================================================================        
  11 : C    1  MELEME  2 CHPOIN  3 MRIGID  4 MCHAFF  5 MCHELM  6 MCLSTR                
  12 : C    7  MELSTR  8 MSOLUT  9 MSTRUC 10        11 MAFFEC 12 MSOSTU                
  13 : C   13  IMATRI 14 MJONCT 15 MATTAC 16 MMATRI 17 MDEFOR 18 MLREEL                
  14 : C   19  MLENTI 20 MCHARG 21 MODELE 22 MEVOLL 23 MSUPER                          
  15 : C=======================================================================        
  16 : -INC CCOPTIO                                                                    
  17 : -INC SMELEME
  18 : -INC TMCOLAC                                                                                 
  19 : C=======================================================================        
  20 : C                      A EXAMINER.                                              
  21 : C                    APRES, CONTIENTPOUR CHAQUE PILE LE NBRE D'OBJETS A         
  22 : C                    SORTIR                                                     
  23 : C=======================================================================        
  24 : C                                                                               
  25 : C                                                                               
  26 : C                                                                               
  27 : C****** BOUCLE SUR LES FILES DE SORTIE IFILE=1,NITLAC******************         
  28 : C                                                                               
  29 : C     ****************************** MELEME ****************************        
  30 :       ITLAC1=KCOLA(32)
  31 :  6001 CONTINUE                                                                  
  32 :       DO 20 I=IDEB,IMAX1                                                           
  33 :       MELEME=ITLAC(I)                                                           
  34 :       IF (MELEME.EQ.0) GO TO 20                                                 
  35 :       SEGACT MELEME*MOD
  36 :       IF (LISOUS(/1).EQ.0) GOTO 21                                              
  37 :       DO 1003 J=1,LISOUS(/1)                                                    
  38 :       LISOUS(J)=ITLAC(LISOUS(J))                                                
  39 :  1003 CONTINUE                                                                  
  40 :   21  CONTINUE                                                                  
  41 :       IF (LISREF(/1).EQ.0) GOTO 25                                              
  42 :       DO 1004 J=1,LISREF(/1)                                                    
  43 :       LISREF(J)=ITLAC(LISREF(J))                                                
  44 :  1004 CONTINUE                                                                  
  45 :   25  CONTINUE
  46 :       IF(NUM(/2).EQ.0) GO TO  60
  47 :       IF(IONIVE.GT.9) THEN
  48 :         DO 61 K2=1,NUM(/2)
  49 :         DO 61 K1=1,NUM(/1)
  50 :           NUM(K1,K2) = ITLAC1.ITLAC(NUM(K1,K2))
  51 :   61    CONTINUE
  52 :       ENDIF
  53 :   60  CONTINUE                                                                 
  54 :       SEGDES MELEME                                                             
  55 :   20  CONTINUE                                                                  
  56 :       GOTO 1098                                                                 
  57 : C***********************************************************************        
  58 :  1098 CONTINUE                                                                  
  59 : C*********************************************************************          
  60 : C                                                                               
  61 :       RETURN                                                                    
  62 :       END                                                                       
  63 :  
  64 :  
  65 :  
  66 :  
  67 :  
  68 :  
  69 :  

© Cast3M 2003 - All rights reserved.
Disclaimer