Download medtra.eso

Back to the list

   1 : C MEDTRA    SOURCE    CHAT      10/12/21    21:15:15     6831           
   2 :       subroutine medtra(meleme,icle)
   3 :       implicit real*8(a-h,o-z)
   4 :       implicit integer (i-n)
   5 : *
   6 : * icle=1 passage de la numerotation Castem à Med
   7 : * icle=2 pasage de la numerotation Med à Castem
   8 : * icle on supprime le segment meleme
   9 : * on cree un nouveau segment
  10 : -INC CCOPTIO
  11 : -INC SMELEME
  12 : -INC CCGEOME
  13 :       dimension iper(54 )
  14 :       data iper/3,5,2,4,6  ,3,5,7,2,4,6,8,  
  15 :      $ 3,5,7,13,15,17,19,2,4,6,8,14,16,18,20,9,10,11,12,
  16 :      $ 3,5,10,12,14,2,4,6,11,13,15,7,8,9,
  17 :      $ 3,5,10,2,4,6,7,8,9/  
  18 :       ia=itypel
  19 :       if(kdegre(itypel).ne.3) return
  20 : 
  21 :       nn= num(/1)
  22 :       ipo=-1
  23 :       segini,ipt1=meleme
  24 :       if(itypel.eq.6) then
  25 :         ipo=0
  26 :       elseif(itypel.eq.10) then
  27 :         ipo=5
  28 :       elseif(itypel.eq.15) then
  29 :         ipo=12
  30 :       elseif(itypel.eq.17) then
  31 :         ipo=31
  32 :       elseif(itypel.eq.24) then
  33 :         ipo=45
  34 :       endif
  35 :       if(ipo.eq.-1) return
  36 :       segini,ipt1=meleme
  37 :       if(icle.eq.1) then
  38 :         do ib=1,num(/2)
  39 :           do ia = 1,nn-1
  40 :             ipt1.num(ia+1,ib)=num(iper(ipo+ia),ib)
  41 :           enddo
  42 :         enddo
  43 :         segdes meleme
  44 :         meleme=ipt1
  45 :       elseif(icle.eq.2) then
  46 :         do ib=1,num(/2)
  47 :           do ia = 1,nn-1
  48 :             ipt1.num(iper(ipo+ia),ib)=num(ia+1,ib)
  49 :           enddo
  50 :         enddo
  51 :         segsup meleme
  52 :         meleme=ipt1
  53 :       endif      
  54 :       return
  55 :       end
  56 :  

© Cast3M 2003 - All rights reserved.
Disclaimer