Esope source files

   1 : C UTILIS    SOURCE    FANDEUR   11/08/10    21:15:30     7075           
   2 :       SUBROUTINE UTILIS
   3 :       IMPLICIT INTEGER(I-N)
   4 : -INC CCOPTIO
   5 :       external long
   6 :       SEGMENT IINDE
   7 :        INTEGER INDEX(NINDE)
   8 :        CHARACTER*8 INDIX(NINDE)
   9 :       ENDSEGMENT 
  10 :       CHARACTER*4 MDIR(2)                                            
  11 :       CHARACTER*80 ITEXT                                                        
  12 :       CHARACTER*4 IDOL                                                          
  13 :       CHARACTER*8 FNAME
  14 :       DATA IDOL/'$$$$'/ 
  15 :       DATA MDIR /'NOTI','PROC'/
  15 :       CALL LIRMOT (MDIR,2,IRET,1)
  16 :       IF(IERR.NE.0) RETURN
  17 :       IF(IRET.EQ.1) THEN
  18 :          FNAME='UTILNOTI'
  19 :          IOUT=37
  20 :       ELSEIF (IRET.EQ.2) THEN
  21 :          FNAME='UTILPROC'
  22 :          IOUT=36
  23 :       ENDIF
  23 :       CALL LIRCHA(ITEXT,1,IRETOU)
  24 :       IF(IERR.NE.0) RETURN
  25 :       L=LONG(ITEXT)
  26 :       OPEN(UNIT=39,ACCESS='SEQUENTIAL',STATUS='OLD',
  27 :      # FILE=ITEXT(1:L),IOSTAT=IOS,ERR=2000,FORM='FORMATTED')                                                                         
  28 : *  destruction du fichier cible puis reouverture
  29 :       CLOSE (UNIT=IOUT,STATUS='DELETE')
  30 :       OPEN(UNIT=IOUT,ACCESS='DIRECT',FORM='FORMATTED',RECL=80,
  31 :      #  FILE=FNAME,STATUS='NEW')
  32 :       NINDE=500                                                       
  33 :       SEGINI IINDE                                                             
  34 :       I=1                                                                       
  35 :       J=0                                                                       
  36 :       WRITE(IOUT,REC=1,FMT=300)1,1
  37 :    10 CONTINUE                                                                  
  38 :       READ(39,101,END=20)ITEXT                                                  
  39 :       I=I+1                                                                     
  40 :       WRITE(IOUT,REC=I,FMT=101)ITEXT                                              
  41 :       IF(ITEXT(1:4).NE.IDOL)GO TO 10                                            
  42 :       J=J+1
  43 :       IF(J.GT.NINDE) THEN
  44 :         NINDE=NINDE+NINDE
  45 :         SEGADJ IINDE
  46 :       ENDIF                                                                     
  47 :       INDIX(J)=ITEXT(6:13)                                                      
  48 :       INDEX(J)=I                                                                
  49 :       GO TO 10                                                                  
  50 :    20 CONTINUE
  51 :       CLOSE(UNIT=39)                                                                  
  52 :       I=I+1                                                                     
  53 :       IND1=I                                                                    
  54 :       DO 21 K=J+1,J+4                                                           
  55 :       INDIX(K)='        '                                                       
  56 :    21 CONTINUE                                                                  
  57 :       DO 30 K=1,J,5                                                             
  58 :       WRITE(IOUT,REC=I,FMT=200)(INDIX(K+L-1),INDEX(K+L-1),L=1,5)                  
  59 :       I=I+1                                                                     
  60 :    30 CONTINUE                                                                  
  61 :       IND2=I-1                                                                  
  62 :       WRITE(IOUT,REC=1,FMT=300)IND1,IND2
  63 :       CLOSE(UNIT=IOUT) 
  64 :       SEGSUP IINDE                                         
  65 : *      CLOSE(UNIT=IOUT,STATUS='KEEP')                                                                                        
  66 :       RETURN                                                                        
  67 :   101 FORMAT(A80)                                                               
  68 :   200 FORMAT(5(A8,I6))
  69 :   300 FORMAT(2I6,68X)
  70 : 
  71 :  2000 CONTINUE
  72 :       MOTERR=ITEXT(1:L)
  73 :       INTERR(1)=IOS
  73 :       CALL ERREUR(599)
  74 : 
  75 :       RETURN                                                       
  76 :       END                                                                       
  77 : 
  78 :