Télécharger la plaquette Cast3M


fr en

Télécharger fusebo.eso

Retour à la liste

Numérotation des lignes : 

fusebo

  1. C FUSEBO    SOURCE    CB215821  19/08/20    21:17:59     10287          
  2.  
  3. C    CE SOUS-PROGRAMME L'OPERATION "ET" SUR UN maillage pas beau
  4. C   ( qui ne respecte pas la partition par type)pour le rendre beau.
  5. C   On ne s'occupe pas des references
  6. C    IPT1:  en entree  IPT3:  en sortie
  7. C
  8.       SUBROUTINE FUSEBO(IPT1,IPT3)
  9.       IMPLICIT INTEGER(I-N)
  10.  
  11. -INC PPARAM
  12. -INC CCOPTIO
  13. -INC CCGEOME
  14. -INC SMELEME
  15.       SEGMENT ISO1(NBSOU1)
  16.       SEGMENT ISO2(NBSOU1)
  17.       segment iso3(nbsou1)
  18.       SEGACT IPT1
  19.       NBSOU1= IPT1.LISOUS(/1)
  20. *      write(6,*) ' entree dans fusebo  nbsou1 ' , nbsou1
  21.       segact ipt1
  22.       SEGINI ISO1,ISO2,iso3
  23.       DO 350 I=1,NBSOU1
  24.  350  ISO1(I)=IPT1.LISOUS(I)
  25.       ity=0
  26.       nbref=0
  27.       nbsous=0
  28.       DO 310 I1=1,NBSOU1
  29.       IPT1=ISO1(I1)
  30.       if(IPT1.EQ.0) go to 310
  31.       ity = 1 + ity
  32.       ias = 1
  33.       iso3(ias)=ipt1
  34.       segact ipt1
  35.       nbnn = ipt1.num(/1)
  36.       nbelem = ipt1.num(/2)
  37.       do 330 i2 = i1+1, nbsou1
  38.       IPT2=ISO1(I2)
  39.       IF (IPT2.EQ.0) GOTO 330
  40.       IPT2=ISO1(I2)
  41.       IF (IPT2.EQ.0) GOTO 330
  42.       SEGACT IPT2
  43.       IF (IPT1.ITYPEL.NE.IPT2.ITYPEL) GOTO 340
  44.       IF (IPT1.NUM(/1).NE.IPT2.NUM(/1)) GOTO 340
  45.       ias = ias+1
  46.       iso3(ias)= ipt2
  47.       iso1(i2)=0
  48.       nbelem = nbelem + ipt2.num(/2)
  49.   340 continue
  50.   330 continue
  51.       if(ias.eq.1) then
  52.         iso2(ity) = ipt1
  53.       else
  54.         segini meleme
  55.         idec=0
  56.         itypel = ipt1.itypel
  57.         DO 311 I2=1,ias
  58.           IPT1=ISO3(I2)
  59.           segact ipt1
  60.           do 351 nbe=1,ipt1.num(/2)
  61.           do 352 nbn=1,nbnn
  62.             num(nbn,idec+nbe)=ipt1.num(nbn,nbe)
  63.   352     continue
  64.   351     continue
  65.          do 353 nbe=1,ipt1.num(/2)
  66.   353    icolor(idec+nbe)=ipt1.icolor(nbe)
  67.           idec = idec + ipt1.num(/2)
  68.   311   continue
  69.         iso2(ity)=meleme
  70.       endif
  71.  310  CONTINUE
  72.       if( ity.eq.1) then
  73.         ipt3 = iso2(1)
  74.       else
  75.         NBREF=0
  76.         NBNN=0
  77.         NBELEM=0
  78.         nbsous = ity
  79.         SEGINI IPT3
  80.         DO 111 I=1,NBSOUs
  81.         IPT3.LISOUS(I)=ISO2(I)
  82.  111    CONTINUE
  83.       endif
  84.       SEGSUP ISO1,ISO2,iso3
  85.  1020 RETURN
  86.       END
  87.  
  88.  
  89.  

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