C SOSOLF    SOURCE    FANDEUR   10/12/14    21:19:50     6812           
      SUBROUTINE SOSOLF(ICOLAC,MSOLUT,IFORM)                                    
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)                                                  
C=======================================================================        
C CE SUBROUTINE ECRIT  SUR LE FICHIER IOSAU UN OBJET MSOLUT                     
C      APPELE PAR WRPIL                                                         
C      APPELLE : SOPAPF ECDIFE  ECDIFR                                          
C      ECRIT PAR FARVACQUE - REPRIS PAR LENA                                    
C=======================================================================        
C                                                                               
       DIMENSION ILENA(10)                                                      
-INC CCOPTIO                                                                    
-INC SMELEME                                                                    
-INC SMCHPOI                                                                    
-INC SMSOLUT                                                                    
-INC TMCOLAC                                                                    

      SEGMENT/ITBBE1/( ITABE1(NN))                                              
      SEGMENT/ITBBE2/( ITABE2(NN))                                              
      SEGMENT/ITBBE3/(ITABE3(L3,N3))                                            
      SEGMENT/ITAB/(TAB(N1),ITABB(N2))                                          
C                                                                               
 8000 FORMAT(16I5)                                                              
 8001 FORMAT(16(1X,A4))                                                         
 8002 FORMAT(1P,6E13.6)                                                         
 8003 FORMAT(' ENREGISTREMENT DE TYPE',I4)                                      
 8004 FORMAT(' PILE NUMERO',I4,' NBRE OBJETS NOMMES',I4,' NBRE OBJETS',         
     1 I4)                                                                      
C                                                                               
      SEGACT ICOLAC                                                             
      ILENA(1)=0                                                                
      ILENA(2)=0                                                                
      ILENA(3)=0                                                                
      IF (MSOLUT.EQ.0) GO TO 10                                                 
      ITLAC1=KCOLA(1)                                                           
C                                                                               
      SEGACT MSOLUT                                                             
      NIPO=MSOLIS(/1)                                                           
      NIPO1=NIPO-4                                                              
      L3=3                                                                      
C     WRITE(IOSAU,8000)NIPO1,MSOLIS(3),L3                                       
      ILENA(1) = NIPO1                                                          
      ILENA(2) = MSOLIS(3)                                                      
      ILENA(3) = L3                                                             
   10 NTOTO=3                                                                   
      CALL ECDIFE  (IOSAU,NTOTO,ILENA(1),IFORM)                                 
      IF (MSOLUT.EQ.0) GO TO 11                                                 
C     WRITE(IOSAU,8001) ITYSOL(1),ITYSOL(2)                                     
      NTOTO=2                                                                   
      READ (ITYSOL,FMT='(2A4)') ILENA(1),ILENA(2)                               
      CALL ECDIFM  (IOSAU,NTOTO,ILENA,IFORM)                                    
      IF(MSOLIS(3).EQ.0) GOTO 1808                                              
CCC   IVA=MSOLIS(3)                                                             
CCC   MSOLIS(3)=ITLAC1.ITLAC(IVA)                                               
 1808 CONTINUE                                                                  
      NN=2*NIPO1                                                                
      SEGINI ITBBE1                                                             
      NN=2*NIPO1+1                                                              
      SEGINI ITBBE2                                                             
      ITABE2(1)=0                                                               
      DO 1803 II=5,NIPO                                                         
      III=II-4                                                                  
      IF(MSOLIS(II).EQ.0) GOTO 1820                                             
      MSOLEN=MSOLIS(II)                                                         
      SEGACT MSOLEN                                                             
      NPAS=ISOLEN(/1)                                                           
      DO 1801 I=1,ISOLEN(/1)                                                    
      IF(ISOLEN(I).EQ.0) GOTO 1801                                              
      IIVA=ISOLEN(I)                                                            
      GOTO 1802                                                                 
 1801 CONTINUE                                                                  
 1802 ISOLIT=MSOLIT(II)                                                         
      IF(ISOLIT.NE.2) GOTO 1805                                                 
C     CHPOINT +++++++++++++                                                     
      MCHPOI=IIVA                                                               
      ITLAC2=KCOLA(2)                                                           
      L=ITLAC2.ITLAC(/1)                                                        
      DO 1856 I=1,L                                                             
      IF(ITLAC2.ITLAC(I).NE.MCHPOI) GOTO 1856                                   
      IVA=I                                                                     
      GOTO 1857                                                                 
 1856 CONTINUE                                                                  
 1857 CONTINUE                                                                  
      SEGACT MCHPOI                                                             
      NSOU=IPCHP(/1)                                                            
      ITABE2(III+1)=ITABE2(III)+NSOU                                            
      ITABE1(2*III)=IVA                                                         
      ITABE1(2*III-1)=ISOLIT                                                    
      SEGDES MCHPOI                                                             
      SEGDES MSOLEN                                                             
      GOTO 1803                                                                 
 1805 IF(ISOLIT.NE.5) GOTO 1806                                                 
      WRITE(IOIMP,*) 'SOSOLF : CAS ISOLIT=5 N ETANT PLUS UTILISE'
      SEGDES MSOLEN                                                             
      GOTO 1803                                                                 
 1806 CONTINUE                                                                  
C                                                                               
 1820 ITABE1(2*III)=0                                                           
      ITABE1(2*III-1)=0                                                         
      ITABE2(III+1)=ITABE2(III)                                                 
 1803 CONTINUE                                                                  
C     ITABE3(L3,N3) ON CALCULE TOUTES LES LONGUEURS                             
C     DES TABLEAUX A LIRE                                                       
      N3=ITABE2(NIPO1+1)                                                        
      SEGINI ITBBE3                                                             
      DO 1840 III=1,NIPO1                                                       
      IF(ITABE1(2*III).EQ.0) GOTO 1840                                          
      ISOLIT=ITABE1(2*III-1)                                                    
      IF(ISOLIT.NE.2) GOTO 1842                                                 
C     MCHPOI +++++++++++++++                                                    
      ITLAC2=KCOLA(2)                                                           
      MCHPOI=ITLAC2.ITLAC(ITABE1(2*III))                                        
      SEGACT MCHPOI                                                             
      DO 1850 ISOU=1,IPCHP(/1)                                                  
      MSOUPO=IPCHP(ISOU)                                                        
      SEGACT MSOUPO                                                             
      MPOVAL=IPOVAL                                                             
      SEGACT MPOVAL                                                             
      J=ITABE2(III)+ISOU                                                        
      ITABE3(1,J)=VPOCHA(/1)                                                    
      ITABE3(2,J)=VPOCHA(/2)                                                    
      SEGDES MPOVAL,MSOUPO                                                      
 1850 CONTINUE                                                                  
      SEGDES MCHPOI                                                             
      GOTO 1840                                                                 
 1842 IF(ISOLIT.NE.5) GOTO 1843                                                 
      WRITE(IOIMP,*) 'SOSOLF : CAS ISOLIT=5 N ETANT PLUS UTILISE'
      GOTO 1840                                                                 
 1843 CONTINUE                                                                  
 1840 CONTINUE                                                                  
      L=2*NIPO1                                                                 
      CALL ECDIFE(IOSAU,L,ITABE1,IFORM)                                         
      L=NIPO1+1                                                                 
      CALL ECDIFE(IOSAU,L,ITABE2,IFORM)                                         
      L=L3*N3                                                                   
      CALL ECDIFE(IOSAU,L,ITABE3,IFORM)                                         
      SEGSUP ITBBE3                                                             
      SEGSUP ITBBE1                                                             
      N1=7                                                                      
      N2=4+NIPO1                                                                
      SEGINI ITAB                                                               
      DO 1830 IPAS=1,NPAS                                                       
      CALL SOPAPF(MSOLUT,IPAS,ITAB,ITBBE2,IFORM)                                
 1830 CONTINUE                                                                  
      SEGSUP ITBBE2,ITAB                                                        
      SEGDES MSOLUT                                                             
      IQUOI=6                                                                   
C     WRITE(IOSAU,8003)IQUOI                                                    
      CALL ECDES (IOSAU,IQUOI,IFORM)                                            
  11  RETURN                                                                    
      END