Download prrayo.eso

Back to the list

   1 : C PRRAYO    SOURCE    CHAT      12/06/07    21:15:53     7389           
   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 :       segment  jtrav
  20 :         integer itrav(m)
  21 :       endsegment
  21 :       call lirobj( 'MMODEL',mmodel,1,iretou)
  22 :       if(ierr.ne.0) return
  23 :       segact mmodel
  24 :       m=kmodel(/1)
  25 :       segini jtrav
  26 :       segini mtab1
  27 :       ib=0      
  28 :       do 1 i=1,m
  29 :         if(itrav(i).ne.0) go to 1
  30 :         segini mtable
  31 :         ib=ib+1
  32 :         tapind='ENTIER'
  33 :         tapobj='TABLE'
  33 :         call ecctab(mtab1,tapind,ib,xva,lchar,bool,ion,
  34 :      $              tapobj,ion,xva,lchar,bool,mtable)
  35 :         imodel= kmodel(i)
  36 :         segact imodel
  37 :         n1 = m
  38 :         segini mmode2
  39 :         mmode2.kmodel(1)=imodel
  40 :         ia=1
  41 :         lchar='MODELE'
  42 :         tapind='MOT'
  43 :         tapobj='MMODEL'
  43 :         call ecctab(mtable,tapind,ind,xva,lchar,bool,ion,
  44 :      $              tapobj,ion,xva,lchar,bool,mmode2)
  45 :         lchar=matmod(3)
  46 :         lchar2='TYPE'
  47 :         tapobj='MOT'
  47 :         call ecctab(mtable,tapind,ind,xva,lchar2,bool,ion,
  48 :      $              tapobj,ion,xva,lchar,bool,ion)
  49 :         segdes mtable
  50 :         do 2 io=i+1,m
  51 :              imode2=kmodel(io)
  52 :              segact imode2
  53 :              if( conmod.eq.imode2.conmod) then
  54 :                itrav(io)=1
  55 :                ia=ia+1
  56 :                mmode2.kmodel(ia)=imode2    
  57 :              endif
  58 :              segdes imode2
  59 :     2   continue
  60 :         if( ia.ne.M) then
  61 :            n1=ia
  62 :            segadj mmode2
  62 : *           call zpmode (mmode2,0)
  63 :         endif
  64 :         segdes mmode2
  65 :         segdes imodel
  66 :     1 continue
  67 :       segdes mmodel
  68 :       segdes mtab1
  69 :       segsup jtrav
  69 :       call ecrobj('TABLE',mtab1)
  70 :       return
  71 :       end
  72 :            
  73 :               
  74 :            
  75 :  

© Cast3M 2003 - All rights reserved.
Disclaimer