Esope source files

   1 : C PRFORM    SOURCE    CHAT      12/06/07    21:15:52     7389           
   2 :       subroutine prform
   3 :       implicit real*8(a-h,o-z)
   4 :       implicit integer(i-n)
   5 : -INC CCOPTIO
   6 : -INC SMMODEL
   7 : -INC SMCHAML
   8 :       segment itrav(nmod)
   8 :       call lirobj('MMODEL',mmodel,1,iretou)
   9 :       if(ierr.ne.0) return
   9 :       call lirobj('MCHAML',mchelm,1,iretou)
  10 :       if(ierr.ne.0) return
  11 :       segact mmodel
  12 :       nmod=kmodel(/1)
  13 :       segini itrav
  14 :       iresu=0
  15 :       do io=1,nmod
  16 :         if(itrav(io).eq.0) then
  17 :           n1=nmod
  18 :          imodel=kmodel(io)
  19 :          segact imodel
  20 :          itrav(io)=1
  21 :          segini mmode2
  22 :          ia=1
  23 :          mmode2.kmodel(ia)=imodel
  24 :          do 1 iy=io+1,kmodel(/1)
  25 :             if(itrav(iy).ne.0) go to 1  
  26 :             imode2=kmodel(iy)
  27 :             segact imode2     
  28 :             if(conmod.eq.imode2.conmod) then
  29 :               itrav(iy)=1
  30 :               ia=ia+1
  31 :               mmode2.kmodel(ia)=imode2
  32 :             endif
  33 :     1    continue
  34 :          n1=ia
  35 :          if( n1.ne.mmode2.kmodel(/1)) segadj mmode2
  35 :          call reduaf ( mchelm,mmode2,mchel2,1,iretr,kerre)
  36 :          if( iretr.ne.1) then
  36 :            call erreur (kerre)
  37 :            return
  38 :          endif
  38 :          call fform1(mmode2,mchel2,ifact)
  39 :          if(iresu.eq.0) then
  40 :             iresu=ifact
  41 :          else
  41 :             call fuschl(iresu,ifact,ires)
  42 :             iresu=ires
  43 :          endif
  44 :           segsup mmode2
  45 :         endif
  46 :       enddo  
  47 :       segsup itrav 
  47 :       if( iresu.ne.0)call ecrobj('MCHAML',iresu) 
  48 :       return
  49 :       end      
  50 :