1 : C DISJ SOURCE CHAT 11/10/27 22:15:01 7180 2 : subroutine disj (ipt1,icpr,ijfam,nomg) 3 : implicit real*8(a-h,o-z) 4 : implicit integer (i-n) 5 : * on a des familles et un objet ipt1 qui sera un groupe, 6 : * on modifie si besoin les pour avoir le nouveaux groupe 7 : -INC CCOPTIO 8 : -INC SMCOORD 9 : -INC SMELEME 10 : character*8 nomg 11 : segment icpr(ino) 12 : segment ijfam 13 : * ifam pointeur sur un meleme, inogro pointeur sur un nomgro 14 : integer ifam(jg),inogro(jg),nfam 15 : endsegment 16 : segment nomgro 17 : * nogrou contient les noms des groupes qui inclus la famille 18 : character*8 nogrou(kg) 19 : integer noco 20 : endsegment 21 : pointeur nomgr1.nomgro,nomgr2.nomgro 22 : segact ipt1 23 : ipt5=0 24 : ipt4=0 25 : ipt3=0 26 : * write(6,*) ' traitement de ' , nomg, ' nfam ' , nfam 27 : if( nfam.eq.0) then 28 : * c'est la premiere fois, on declare famille tous les lisous de l'objet ipt1 29 : do i=1,max(1,ipt1.lisous(/1)) 30 : if(ipt1.lisous(/1) .ne. 0) then 31 : ipt8=ipt1.lisous(i) 32 : else 33 : ipt8=ipt1 34 : endif 35 : segini,ipt9=ipt8 36 : if( nfam.ge.ifam(/1)) then 37 : jg=ifam(/1)+200 38 : segadj ijfam 39 : endif 40 : nfam=nfam+1 41 : * write(6,*) ' creation premiere famille ', ipt9,nomg 42 : ifam(nfam)=ipt9 43 : kg=10 44 : segini nomgro 45 : inogro(nfam)=nomgro 46 : noco=1 47 : nogrou(1)=nomg 48 : enddo 49 : return 50 : endif 51 : * il faut tester si intersection avec d autres familles 52 : do 1 i=1,max(1,ipt1.lisous(/1)) 53 : if( ipt1.lisous(/1).ne.0) then 54 : ipt6=ipt1.lisous(i) 55 : segact ipt6 56 : else 57 : ipt6=ipt1 58 : endif 59 : do 2 j=1,nfam 60 : ipt7=ifam(j) 61 : segact ipt7 62 : * write(6,*) ' disj envoi ipt6,ipt7 ', ipt6,ipt7 63 : if( ipt6.itypel.ne.ipt7.itypel) go to 2 63 : call disjo(ipt6,ipt7,meleme,ipt8,ipt9,icpr) 64 : * write(6,*) ' meleme ipt8 ipt9 ' , meleme, ipt8, ipt9 65 : if( meleme.eq.0) go to 2 66 : * il existe une intersection 67 : if(ipt9.eq.0.and.IPT8.EQ.0) then 68 : * les deux objets sont superposes on ajoute le nom dans la famille on a fini 69 : * pour ipt6 70 : nomgro=inogro(j) 71 : noco=noco+1 72 : if(noco.gt.nogrou(/2)) then 73 : kg=nogrou(/2)+10 74 : segadj nomgro 75 : endif 76 : nogrou(noco)=nomg 77 : go to 1 78 : elseif(ipt8.eq.0) then 79 : ifam(j)=ipt9 80 : nomgro=inogro(j) 81 : noco=noco+1 82 : if(noco.gt.nogrou(/2)) then 83 : kg=nogrou(/2)+10 84 : segadj nomgro 85 : endif 86 : nogrou(noco)=nomg 87 : nfam=nfam+1 88 : * write(6,*) 'Acreation nouvelle famille ' ,nfam ,meleme 89 : if( nfam.gt.ifam(/1)) then 90 : jg=ifam(/1)+200 91 : segadj ijfam 92 : endif 93 : ifam(nfam)=meleme 94 : nomgr1=inogro(j) 95 : segini,nomgro=nomgr1 96 : inogro(nfam)=nomgro 97 : noco=noco+1 98 : if(noco.gt.nogrou(/2)) then 99 : kg=nogrou(/2)+10 100 : segadj nomgro 101 : endif 102 : nogrou(noco)=nomg 103 : elseif(ipt9.eq.0)then 104 : nomgro=inogro(j) 105 : noco=noco+1 106 : if(noco.gt.nogrou(/2)) then 107 : kg=nogrou(/2)+10 108 : segadj nomgro 109 : endif 110 : nogrou(noco)=nomg 111 : ipt6=ipt8 112 : else 113 : * aucun n'est nul meleme ipt8,ipt9 114 : ipt6=ipt8 115 : ifam(j)=ipt9 116 : nfam=nfam+1 117 : * write(6,*) 'Bcreation nouvelle famille ' ,nfam ,meleme 118 : if( nfam.gt.ifam(/1)) then 119 : jg=ifam(/1)+200 120 : segadj ijfam 121 : endif 122 : ifam(nfam)=meleme 123 : nomgr1=inogro(j) 124 : segini,nomgro=nomgr1 125 : inogro(nfam)=nomgro 126 : noco=noco+1 127 : if(noco.gt.nogrou(/2)) then 128 : kg=nogrou(/2)+10 129 : segadj nomgro 130 : endif 131 : nogrou(noco)=nomg 132 : endif 133 : 2 Continue 134 : nfam=nfam+1 135 : if( nfam.gt.ifam(/1)) then 136 : jg=ifam(/1)+200 137 : segadj ijfam 138 : endif 139 : * write(6,*) 'Ccreation nouvelle famille ' ,nfam ,ipt6 140 : ifam(nfam)=ipt6 141 : kg=10 142 : segini nomgro 143 : inogro(nfam)=nomgro 144 : noco=1 145 : nogrou(1)=nomg 146 : 1 Continue 147 : return 148 : end 149 : 150 : 151 :
© Cast3M 2003 - All rights reserved.
Disclaimer