C PROCPN    SOURCE    CHAT      11/05/04    21:17:53     6963           
      SUBROUTINE PROCPN(IAREA,IRET) 
      IMPLICIT INTEGER(I-N)
-INC CCOPTIO                                            
      SAVE LINDEX,ISTAT,IULEPR,ISTAT2                                                        
      CHARACTER*(*) IAREA,IRET                                                  
      DIMENSION INDEX (6)                                                       
      DIMENSION NAME(2)                                                         
      CHARACTER*8 INDIX (6) 
      SEGMENT MUTIL
           CHARACTER*8 MNOM(LLON),MDOUB(LLON) 
      ENDSEGMENT 
      MUTIL=0
      IJKL=0
      IDEJA=0                                       
      ISTAT=1                                                                   
      READ(34,REC=1,FMT=100,IOSTAT=IOSTAT)IND1,IND2
      if (iostat.ne.0) goto 1000
      LLON=(IND2-IND1+1 )*5
      SEGINI MUTIL
      ISTAT=0                                                                                                                                    
      DO 1 I=IND1,IND2                                                          
      READ(34,REC=I,FMT=101,IOSTAT=IOSTAT)(INDIX(K),INDEX(K),K=1,5)
      if (iostat.ne.0) goto 9998
      DO 2 K=1,5 
      IJKL=IJKL+1
      MNOM(IJKL)=INDIX(K)                                                             
      if(indix(k).ne.'        ')then
         CALL NOMOBJ('PROCEDUR',INDIX(K),-INDEX(K))  
*         write(6,*) ' nomobj 1 de la procedur ' , indix(k)   
      endif                               
   2  CONTINUE                                                                  
   1  CONTINUE 
      ISTAT2=1 
      READ(36,REC=1,FMT=100,IOSTAT=IOSTAT)IND1,IND2
      if (iostat.ne.0) goto 9998
      ISTAT2=0                                                                      
      DO 3 I=IND1,IND2                                                          
      READ(36,REC=I,FMT=101,IOSTAT=IOSTAT)(INDIX(K),INDEX(K),K=1,5)
      if (iostat.ne.0) goto 9998
      DO 4 K=1,5
      IF(INDIX(K).EQ.' ' ) GO TO 4 
      DO 40 LIOP=1,IJKL      
      IF(MNOM(LIOP).EQ.INDIX(K)) THEN
          IDEJA=IDEJA+1
          MDOUB(IDEJA)=INDIX(K)
          GO TO 41
      ENDIF
   40 CONTINUE
   41 CONTINUE
      IQQ = -(INDEX(K)+1000000) 
      if( indix(k).ne.' ') then
*         write(6,*) ' nomobj 2 de la procedur ' , indix(k)                                                                   
         CALL NOMOBJ('PROCEDUR',INDIX(K),IQQ)
      endif                                
   4  CONTINUE                                                                  
   3  CONTINUE 
      IF(IDEJA.NE.0) THEN 
         CALL ERREUR (-302) 
         DO 42 IKL = 1,IDEJA,4
         MOTERR=' '
         IFI=MIN(IKL+3,IDEJA)-IKL +1
         DO 43 ILK=1,IFI 
         MOTERR((ILK-1)*9+2:ILK*9)=MDOUB(IKL-1+ILK)
   43    CONTINUE
         WRITE(IOIMP,*) MOTERR(1:40)
   42    CONTINUE
      ENDIF                                                                              
      IRET='9999'
 9998 CONTINUE
      IF(MUTIL.NE.0) SEGSUP MUTIL                                                               
 1000 RETURN                                                                    
      ENTRY PROCPO(JINDEX,IRET)                                                 
      IRET='0'                                                                  
      IF (ISTAT*ISTAT2.EQ.1) RETURN
      IULEPR=34
      LINDEX=JINDEX+1       
      IF(JINDEX.GT.1000000) THEN
        IULEPR=36                                              
        LINDEX=JINDEX+1 -1000000
      ENDIF                                                       
      IRET='9999'                                                              
      RETURN                                                                    
      ENTRY PROCLI(IAREA,IRET)                                                  
      IRET='9999'                                                               
      IF (ISTAT*ISTAT2.EQ.1) RETURN                                                    
      IRET='0'                                                                 
      READ(IULEPR,REC=LINDEX,FMT=102,IOSTAT=IOSTAT)IAREA
      if (iostat.ne.0) goto 1000
      IF(IAREA(1:4).EQ.'$$$$')IRET='9999'                                       
      LINDEX=LINDEX+1                                                           
      RETURN                                                                    
      ENTRY PROCL2(IAREA,IRET)                                                  
      IRET='0' 
      IF(ISTAT2.NE.0) go to 12
      READ(36,REC=1,FMT=100,IOSTAT=IOSTAT)IND1,IND2
      if (iostat.ne.0) goto 1000
      DO 110 I=IND1,IND2                                                         
      READ(36,REC=I,FMT=101,IOSTAT=IOSTAT)(INDIX(K),INDEX(K),K=1,5)
      if (iostat.ne.0) goto 1000
      DO 220 K=1,5                                                               
      IF(INDIX(K).EQ.IAREA(1:8)) THEN                                           
      IRET='9998'                                                               
      LINDEX=INDEX(K)+1
      IULEPR=36                                                              
      GO TO 10                                                                  
      ENDIF 
  220 CONTINUE                                                                  
  110 CONTINUE   
  12  CONTINUE                                                                       
      IF (ISTAT.NE.0) return                                        
      READ(34,REC=1,FMT=100,IOSTAT=IOSTAT)IND1,IND2
      if (iostat.ne.0) goto 1000
      DO 11 I=IND1,IND2                                                         
      READ(34,REC=I,FMT=101,IOSTAT=IOSTAT)(INDIX(K),INDEX(K),K=1,5)
      if (iostat.ne.0) goto 1000
      DO 22 K=1,5                                                               
      IF(INDIX(K).EQ.IAREA(1:8)) THEN                                           
      IRET='9999'                                                               
      LINDEX=INDEX(K)+1 
      IULEPR=34                                                        
      GO TO 10                                                                  
      ENDIF                                                                     
  22  CONTINUE                                                                  
  11  CONTINUE                                                                                                                                 
  10  RETURN                                                                    
  100 FORMAT (2I6)                                                              
  101 FORMAT(5(A8,I6))                                                          
  102 FORMAT(A72)                                                               
      END