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