C PRRAYE    SOURCE    CHAT      12/06/07    21:15:52     7389           
      subroutine prraye
      implicit real*8(a-h,o-z)
      implicit integer(i-n)
-INC CCOPTIO
-INC SMMODEL
-INC SMCHAML
      segment itrav(nmod)
      call lirobj('MMODEL',mmodel,1,iretou)
      if(ierr.ne.0) return
      call lirobj('MCHAML',mchel1,1,iretou)
      if(ierr.ne.0) return
      call lirobj('MCHAML',mchel2,1,iretou)
      if(ierr.ne.0) return
      mchel3=0
      call lirobj('MCHAML',mchel3,0,iretou)
      if( mchel3.ne.0) then
         kmatr=0
         call lirree(xval,0,iret)
         if( iret.eq.1) then
           errj= xval
         else
           errj=1.d-10
         endif
       endif  
      segact mmodel
      nmod=kmodel(/1)
      segini itrav
      iresu=0
      do io=1,nmod
        if(itrav(io).eq.0) then
          n1=nmod
         imodel=kmodel(io)
         segact imodel
         itrav(io)=1
         segini mmode2
         ia=1
         mmode2.kmodel(ia)=imodel
         do 1 iy=io+1,kmodel(/1)
            if(itrav(iy).ne.0) go to 1  
            imode2=kmodel(iy)
            segact imode2     
            if(conmod.eq.imode2.conmod) then
              itrav(iy)=1
              ia=ia+1
              mmode2.kmodel(ia)=imode2
            endif
    1    continue
         n1=ia
         if( n1.ne.mmode2.kmodel(/1)) segadj mmode2
         call reduaf ( mchel1,mmode2,mche1r,1,iretr,kerre)
         if( iretr.ne.1) then
           call erreur (kerre)
           return
         endif
         call reduaf ( mchel2,mmode2,mche2r,1,iretr,kerre)
         if( iretr.ne.1) then
           call erreur (kerre)
           return
         endif
         mche3r=mchel3
         if( mchel3.ne.0) then
           call reduaf ( mchel3,mmode2,mche3r,1,iretr,kerre)
         endif
         call rayen(mmode2,mche1r,mche2r,mche3r,errj,ifact)
         if(iresu.eq.0) then
            iresu=ifact
         else
            call fuschl(iresu,ifact,ires)
            iresu=ires
         endif
          segsup mmode2
        endif
      enddo  
      segsup itrav 
      
      if( iresu.ne.0)call ecrobj('MCHAML',iresu) 
      return
      end