Télécharger la plaquette Cast3M


fr en

Télécharger ajouel.eso

Retour à la liste

Numérotation des lignes : 

ajouel

  1. C AJOUEL    SOURCE    CB215821  17/07/25    21:15:03     9519           
  2. C
  3.       SUBROUTINE AJOUEL(NODE,NBNODE,ityp1,IMELE,IEL)
  4. C--------------------------------------------------------------
  5. C
  6. C FONCTION :
  7. C     Verifie l'existence d'un element (defini par ses noeuds)
  8. C     en tenant compte de l'eventuelle permutation des noeuds
  9. C     et Ajoute cet element au maillage si non existence
  10. C
  11. C NODE  : ENTREE  : Tableau des noeudsde dimension NBNODE
  12. C ityp1 : ENTREE  : ITYPEL (type d'element)
  13. C IMELE : E/S   :  Pointeur vers MELEME (actif et modifiable en E/S)
  14. C IEL : ENTREE  :  Numero de l element qu'on propose de créer
  15. C IEL : SORTIE  :  Numero de l element effectivement créé ou retrouvé
  16. C
  17. C APPELE PAR : INTGEO
  18. C
  19. C CREATION : BP 2012/09/11
  20. C
  21. C--------------------------------------------------------------
  22.       IMPLICIT INTEGER(I-N)
  23.       IMPLICIT REAL*8(A-H,O-Z)
  24.       INTEGER NODE(NBNODE)
  25.       SEGMENT IVU(NBNODE)
  26. C
  27.  
  28. -INC PPARAM
  29. -INC CCOPTIO
  30. -INC SMELEME
  31.  
  32. c       write(ioimp,fmt="('ajouel(',I5,I5,I3,I3,I7,I3)")
  33. c      &NODE(1),NODE(2),NBNODE,ityp1,IMELE,IEL
  34.  
  35. C--------------------------------------------------------------
  36. C     PRELIMINAIRES et initialisation
  37.  
  38.       SEGINI,IVU
  39. c     on commence par le 1er noeud a cherche
  40.       inode=1
  41.       nono = NODE(inode)
  42.  
  43. C--------------------------------------------------------------
  44. C     ON RECHERCHE LE POINT (idem ELIM)
  45.  
  46. c     maillage a verifier (actif et modifiable en entrée)
  47.       IPT1   = IMELE
  48. c     segact,IPT1
  49.  
  50.       NBSOUS = IPT1.LISOUS(/1)
  51. c     dans le cas d un meleme complexe,
  52. c==== il faut boucler sur les differents type d elements ====
  53.       DO 100 ISOUS=1,max(1,NBSOUS)
  54.  
  55.         if (NBSOUS.ne.0)  then
  56.           MELEME=IPT1.LISOUS(isous)
  57. c           segact,meleme
  58.         else
  59.           MELEME=IPT1
  60.         endif
  61.  
  62.         if(ITYPEL.ne.ityp1) goto 100
  63.         NBNN = NUM(/1)
  64.         NBEL = NUM(/2)
  65. C ici MELEME est un maillage simple (NSOUS = 0)
  66.         NBSOUS = LISOUS(/1)
  67.         NBREF  = LISREF(/1)
  68. c         write(ioimp,*) 'ajouel: on a trouvé le bon itypel=',ityp1
  69. c      &  ,' associe au maillage de dim=',NBNN,NBEL
  70.  
  71.         if(NBNN.ne.NBNODE) then
  72. c         goto 100
  73. c         write(ioimp,*)'ajouel: ITYPEL et nombre de noeuds incompatibles'
  74.           call erreur(21)
  75.         endif
  76. c       on a le bon nombre de noeuds :
  77. c       on cherche si l element fourni existe deja
  78.  
  79. c         write(ioimp,*)'ajouel: on cherche le ',inode,'ieme noeud=',nono
  80.  
  81.  
  82. c       boucle sur les element du maillage
  83.         DO 71 J=1,NBEL
  84.  
  85. c         on remet a zero si IVU a bougé
  86.           if(inode.gt.1) then
  87.             do iii=1,(inode-1)
  88.               IVU(iii)=0
  89.             enddo
  90. c           on commence par le 1er noeud
  91.             inode=1
  92.             nono = NODE(inode)
  93.           endif
  94.  
  95. c         boucle sur les noeuds
  96.  72       I=0
  97.  73       I=I+1
  98.             ii=NUM(I,J)
  99. c             write(ioimp,*) 'on teste ',ii,' =element NUM(',I,J,')'
  100.             IF(ii.eq.0) GOTO 71
  101. c           on a trouvé nono !
  102.             IF(ii.eq.nono) THEN
  103. c               write(ioimp,*) 'on a trouvé ',ii,' element NUM(',I,J,')'
  104.               IVU(inode)=I
  105.               if(inode.eq.NBNODE) goto 700
  106. c             si on n a pas fini on continue dans cet element
  107.               inode = inode +1
  108.               nono = NODE(inode)
  109.               goto 72
  110.             ENDIF
  111. c           si on a fini de boucler sur les noeuds => element suivant
  112.             if(I.eq.NBNN) goto 71
  113.             goto 73
  114.  
  115.  71     CONTINUE
  116.  
  117.  
  118. C--------------------------------------------------------------
  119. c       si élément non trouvé on le crée à la IEL ieme place
  120.         if(NBEL.lt.IEL) then
  121.           NBELEM=IEL
  122. C ici MELEME est un maillage simple (NSOUS = 0)
  123.           NBSOUS = LISOUS(/1)
  124.           NBREF  = LISREF(/1)
  125.           segadj,MELEME
  126.         endif
  127.         if(NUM(1,IEL).ne.0) then
  128.           write(ioimp,*) 'ajouel : on écrase un élément existant !'
  129.         endif
  130.         do inode=1,NBNODE
  131.           NUM(inode,IEL)=NODE(inode)
  132.         enddo
  133.         SEGSUP,IVU
  134.         RETURN
  135.  
  136. C--------------------------------------------------------------
  137. c       on a trouvé l element deja existant
  138.  700    CONTINUE
  139.         IEL = J
  140. c         write(ioimp,*) 'on a trouvé l element deja existant ',IEL
  141.  
  142.  
  143.  100  CONTINUE
  144. c==== fin de boucle sur les differents type d elements ====
  145.  
  146.       SEGSUP,IVU
  147.       RETURN
  148.  
  149.       END
  150.  
  151.  
  152.  
  153.  

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