Télécharger ajouel.eso

Retour à la liste

Numérotation des lignes :

  1. C AJOUEL SOURCE FANDEUR 13/01/29 21:15:01 7683
  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. INTEGER IVU(NBNODE)
  26. C
  27. -INC CCOPTIO
  28. -INC SMELEME
  29.  
  30. c write(ioimp,fmt="('ajouel(',I5,I5,I3,I3,I7,I3)")
  31. c &NODE(1),NODE(2),NBNODE,ityp1,IMELE,IEL
  32.  
  33. C--------------------------------------------------------------
  34. C PRELIMINAIRES et initialisation
  35. do iii=1,NBNODE
  36. IVU(iii)=0
  37. enddo
  38. c on commence par le 1er noeud a cherche
  39. inode=1
  40. nono = NODE(inode)
  41.  
  42. C--------------------------------------------------------------
  43. C ON RECHERCHE LE POINT (idem ELIM)
  44.  
  45. c maillage a verifier (actif et modifiable en entrée)
  46. IPT1 = IMELE
  47. c segact,IPT1
  48.  
  49. NBSOUS = IPT1.LISOUS(/1)
  50. c dans le cas d un meleme complexe,
  51. c==== il faut boucler sur les differents type d elements ====
  52. DO 100 ISOUS=1,max(1,NBSOUS)
  53.  
  54. if (NBSOUS.ne.0) then
  55. MELEME=IPT1.LISOUS(isous)
  56. c segact,meleme
  57. else
  58. MELEME=IPT1
  59. endif
  60.  
  61. if(ITYPEL.ne.ityp1) goto 100
  62. NBNN = NUM(/1)
  63. NBEL = NUM(/2)
  64. C ici MELEME est un maillage simple (NSOUS = 0)
  65. NBSOUS = LISOUS(/1)
  66. NBREF = LISREF(/1)
  67. c write(ioimp,*) 'ajouel: on a trouvé le bon itypel=',ityp1
  68. c & ,' associe au maillage de dim=',NBNN,NBEL
  69.  
  70. if(NBNN.ne.NBNODE) then
  71. c goto 100
  72. c write(ioimp,*)'ajouel: ITYPEL et nombre de noeuds incompatibles'
  73. call erreur(21)
  74. endif
  75. c on a le bon nombre de noeuds :
  76. c on cherche si l element fourni existe deja
  77.  
  78. c write(ioimp,*)'ajouel: on cherche le ',inode,'ieme noeud=',nono
  79.  
  80.  
  81. c boucle sur les element du maillage
  82. DO 71 J=1,NBEL
  83.  
  84. c on remet a zero si IVU a bougé
  85. if(inode.gt.1) then
  86. do iii=1,(inode-1)
  87. IVU(iii)=0
  88. enddo
  89. c on commence par le 1er noeud
  90. inode=1
  91. nono = NODE(inode)
  92. endif
  93.  
  94. c boucle sur les noeuds
  95. 72 I=0
  96. 73 I=I+1
  97. ii=NUM(I,J)
  98. c write(ioimp,*) 'on teste ',ii,' =element NUM(',I,J,')'
  99. IF(ii.eq.0) GOTO 71
  100. c on a trouvé nono !
  101. IF(ii.eq.nono) THEN
  102. c write(ioimp,*) 'on a trouvé ',ii,' element NUM(',I,J,')'
  103. IVU(inode)=I
  104. if(inode.eq.NBNODE) goto 700
  105. c si on n a pas fini on continue dans cet element
  106. inode = inode +1
  107. nono = NODE(inode)
  108. goto 72
  109. ENDIF
  110. c si on a fini de boucler sur les noeuds => element suivant
  111. if(I.eq.NBNN) goto 71
  112. goto 73
  113.  
  114. 71 CONTINUE
  115.  
  116.  
  117. C--------------------------------------------------------------
  118. c si élément non trouvé on le crée à la IEL ieme place
  119. if(NBEL.lt.IEL) then
  120. NBELEM=IEL
  121. C ici MELEME est un maillage simple (NSOUS = 0)
  122. NBSOUS = LISOUS(/1)
  123. NBREF = LISREF(/1)
  124. segadj,MELEME
  125. endif
  126. if(NUM(1,IEL).ne.0) then
  127. write(ioimp,*) 'ajouel : on écrase un élément existant !'
  128. endif
  129. do inode=1,NBNODE
  130. NUM(inode,IEL)=NODE(inode)
  131. enddo
  132.  
  133. RETURN
  134.  
  135. C--------------------------------------------------------------
  136. c on a trouvé l element deja existant
  137. 700 CONTINUE
  138. IEL = J
  139. c write(ioimp,*) 'on a trouvé l element deja existant ',IEL
  140.  
  141.  
  142. 100 CONTINUE
  143. c==== fin de boucle sur les differents type d elements ====
  144.  
  145. RETURN
  146.  
  147. END
  148.  
  149.  
  150.  

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