C POSCHA    SOURCE    CHAT      06/03/16    21:23:27     5336           
      SUBROUTINE POSCHA(NAM,IPOSCH)                                 
      IMPLICIT INTEGER(I-N)
-INC CCOPTIO                                                        
-INC CCNOYAU
-INC CCASSIS                                                        
      CHARACTER*(*)NAM 
      if(nbesc.ne.0) segact ipiloc*mod
      IL=LEN(NAM)  
      IO=IPCHAR(/1)
      IA=0   
      DO 56 I=1,IL
      IA = IA + ICHAR(NAM(I:I))
   56 CONTINUE 
*      write(6,fmt='(''nam io lmncha ia'',a8,3i6)')nam,io,LMNCHA,ia 
      DO 1 II=LMNCHA,1,-1  
      IF( IPHCOD(II).NE.IA) GO TO 1                                 
      ID=IPCHAR(II)                                                 
      IFI=IPCHAR(II+1)                                              
      IF(IFI-ID.NE.IL) GO TO 1                                      
      IF(NAM.NE.ICHARA(ID:IFI-1)) GO TO 1                           
      GO TO 2                                                       
   1  CONTINUE                                                      
  10  CONTINUE 
      LMNCHA=LMNCHA+1                                               
      M1=IPCHAR(LMNCHA)                                             
      M=M1+IL 
*      write(6,*) ' lmncha ' , lmncha , ' ipchar(/1))' , ipchar(/1) 
      IF(LMNCHA+1.GT.IPCHAR(/1) .or. M.GT.ICHARA(/1)) THEN 
         lmxx=xiflot(/1)
         lmll=iplogi(/1)
         lmmm=ichara(/1)
         if(M.gt.ichara(/1)) lmmm= m+1000
         lmcc= ipchar(/1)                                          
         if(LMNCHA+1.GT.lmcc) LMcc=LMNCHA+200  
*         write(6,*) ' lmxx,lmcc,lmmm,lmll',lmxx,lmcc,lmmm,lmll     
         SEGADJ IPILOC                                              
      ENDIF 
*      write(6,*) ' lmncha ' , lmncha,' m ',m                       
      IPCHAR(LMNCHA+1)=M                                            
      ICHARA(M1:M1+IL-1)=NAM
      IPHCOD(LMNCHA)=IA                                      
      II=LMNCHA                                                     
   2  CONTINUE                 
      IPOSCH=II 
      if(nbesc.ne.0) segdes ipiloc
*      write(6,fmt='('' sortie poscha '',i8)') iposch               
      RETURN                                                        
      END