Télécharger la plaquette Cast3M


fr en

Télécharger disj.eso

Retour à la liste

Numérotation des lignes : 

disj

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

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