Télécharger prrayo.eso

Retour à la liste

Numérotation des lignes :

  1. C PRRAYO SOURCE CB215821 16/04/15 21:15:38 8907
  2. subroutine prrayo
  3. implicit integer (I-N)
  4. implicit real*8 ( a-h,o-z)
  5. *
  6. * avec une certaine honte, on rebricole les modeles de rayonnement pour les
  7. * presenter, dans pasapas, de la meme facon qu'avant c'est à dire avec des tables
  8. *
  9. * La particularité du rayonnement est( que c'est un probleme non local et que
  10. * lorsdu traitement d'un sous modèles il faut connaitre les autres sous modèles
  11. * formant la cavité
  12. *
  13. -INC CCOPTIO
  14. -INC SMCHAML
  15. -INC SMMODEL
  16. -INC SMTABLE
  17. logical bool
  18. character*8 tapind,tapobj,lchar,lchar2
  19. character*16 lchar3
  20. segment jtrav
  21. integer itrav(m)
  22. endsegment
  23.  
  24. lchar=' '
  25. bool =.FALSE.
  26. ION =0
  27. IND =0
  28. XVA =0.D0
  29.  
  30. call lirobj( 'MMODEL',mmodel,1,iretou)
  31. if(ierr.ne.0) return
  32. segact mmodel
  33. m=kmodel(/1)
  34. segini jtrav
  35. segini mtab1
  36. ib=0
  37. do 1 i=1,m
  38. if(itrav(i).ne.0) go to 1
  39. segini mtable
  40. ib=ib+1
  41. tapind='ENTIER'
  42. tapobj='TABLE'
  43. call ecctab(mtab1,tapind,ib,xva,lchar,bool,ion,
  44. $ tapobj,ion,xva,lchar,bool,mtable)
  45. imodel= kmodel(i)
  46. segact imodel
  47. n1 = m
  48. segini mmode2
  49. mmode2.kmodel(1)=imodel
  50. ia=1
  51. lchar='MODELE'
  52. tapind='MOT'
  53. tapobj='MMODEL'
  54. call ecctab(mtable,tapind,ind,xva,lchar,bool,ion,
  55. $ tapobj,ion,xva,lchar,bool,mmode2)
  56. lchar3=matmod(3)
  57. lchar2='TYPE'
  58. tapobj='MOT'
  59. call ecctab(mtable,tapind,ind,xva,lchar2,bool,ion,
  60. $ tapobj,ion,xva,lchar3,bool,ion)
  61. segdes mtable
  62. do 2 io=i+1,m
  63. imode2=kmodel(io)
  64. segact imode2
  65. if( conmod.eq.imode2.conmod) then
  66. itrav(io)=1
  67. ia=ia+1
  68. mmode2.kmodel(ia)=imode2
  69. endif
  70. segdes imode2
  71. 2 continue
  72. if( ia.ne.M) then
  73. n1=ia
  74. segadj mmode2
  75. * call zpmode (mmode2,0)
  76. endif
  77. segdes mmode2
  78. segdes imodel
  79. 1 continue
  80. segdes mmodel
  81. segdes mtab1
  82. segsup jtrav
  83. call ecrobj('TABLE',mtab1)
  84. return
  85. end
  86.  
  87.  
  88.  
  89.  
  90.  
  91.  
  92.  

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