Télécharger la plaquette Cast3M


fr en

Télécharger prrayo.eso

Retour à la liste

Numérotation des lignes : 

prrayo

  1. C PRRAYO    SOURCE    CB215821  24/04/12    21:17:00     11897          
  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.  
  14. -INC PPARAM
  15. -INC CCOPTIO
  16. -INC SMCHAML
  17. -INC SMMODEL
  18. -INC SMTABLE
  19.       logical bool
  20.       character*8 tapind,tapobj,lchar,lchar2
  21.       character*16 lchar3
  22.       segment jtrav
  23.         integer itrav(m)
  24.       endsegment
  25.  
  26.       lchar='        '
  27.       bool =.FALSE.
  28.       ION  =0
  29.       IND  =0
  30.       XVA  =0.D0
  31.  
  32.       call lirobj( 'MMODEL',mmodel,1,iretou)
  33.       if(ierr.ne.0) return
  34.       segact mmodel
  35.       m=kmodel(/1)
  36.       segini jtrav
  37.       segini mtab1
  38.       ib=0
  39.       do 1 i=1,m
  40.         if(itrav(i).ne.0) go to 1
  41.         segini mtable
  42.         ib=ib+1
  43.         tapind='ENTIER'
  44.         tapobj='TABLE'
  45.         call ecctab(mtab1,tapind,ib,xva,lchar,bool,ion,
  46.      $              tapobj,ion,xva,lchar,bool,mtable)
  47.         imodel= kmodel(i)
  48.         segact imodel
  49.         n1 = m
  50.         segini mmode2
  51.         mmode2.kmodel(1)=imodel
  52.         ia=1
  53.         lchar='MODELE'
  54.         tapind='MOT'
  55.         tapobj='MMODEL'
  56.         call ecctab(mtable,tapind,ind,xva,lchar,bool,ion,
  57.      $              tapobj,ion,xva,lchar,bool,mmode2)
  58.         lchar3=matmod(3)
  59.         lchar2='TYPE'
  60.         tapobj='MOT'
  61.         call ecctab(mtable,tapind,ind,xva,lchar2,bool,ion,
  62.      $              tapobj,ion,xva,lchar3,bool,ion)
  63.         segdes mtable
  64.         do 2 io=i+1,m
  65.              imode2=kmodel(io)
  66.              segact imode2
  67.              if( conmod.eq.imode2.conmod) then
  68.                itrav(io)=1
  69.                ia=ia+1
  70.                mmode2.kmodel(ia)=imode2
  71.              endif
  72.              segdes imode2
  73.     2   continue
  74.         if( ia.ne.M) then
  75.            n1=ia
  76.            segadj mmode2
  77. *           call zpmode (mmode2,0)
  78.         endif
  79.         segdes mmode2
  80.         segdes imodel
  81.     1 continue
  82.       segdes mmodel
  83.       segdes mtab1
  84.       segsup jtrav
  85.       call ecrobj('TABLE',mtab1)
  86.       return
  87.       end
  88.  
  89.  
  90.  
  91.  
  92.  
  93.  
  94.  
  95.  

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