Télécharger prform.eso

Retour à la liste

Numérotation des lignes :

  1. C PRFORM SOURCE CB215821 16/09/30 21:15:20 9105
  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)
  9. call lirobj('MMODEL',mmodel,1,iretou)
  10. if(ierr.ne.0) return
  11. call lirobj('MCHAML',mchel1,1,iretou)
  12. if(ierr.ne.0) return
  13.  
  14. call reduaf ( mchel1,mmodel,mchel2,1,iretr,kerre)
  15. if( iretr.ne.1) then
  16. call erreur (kerre)
  17. return
  18. endif
  19.  
  20. segact mmodel
  21. nmod=kmodel(/1)
  22.  
  23. segini itrav
  24. iresu=0
  25. do io=1,nmod
  26. if(itrav(io).eq.0) then
  27. n1=nmod
  28. imodel=kmodel(io)
  29. segact imodel
  30. itrav(io)=1
  31. segini mmode2
  32. ia=1
  33. mmode2.kmodel(ia)=imodel
  34. do 1 iy=io+1,kmodel(/1)
  35. if(itrav(iy).ne.0) go to 1
  36. imode2=kmodel(iy)
  37. segact imode2
  38. if(conmod.eq.imode2.conmod) then
  39. itrav(iy)=1
  40. ia=ia+1
  41. mmode2.kmodel(ia)=imode2
  42. endif
  43. 1 continue
  44. n1=ia
  45. if( n1.ne.mmode2.kmodel(/1)) segadj mmode2
  46. call fform1(mmode2,mchel2,ifact)
  47. if(iresu.eq.0) then
  48. iresu=ifact
  49. else
  50. call fuschl(iresu,ifact,ires)
  51. iresu=ires
  52. endif
  53. segsup mmode2
  54. endif
  55. enddo
  56. segsup itrav
  57. if( iresu.ne.0)call ecrobj('MCHAML',iresu)
  58. return
  59. end
  60.  
  61.  
  62.  

© Cast3M 2003 - Tous droits réservés.
Mentions légales