Télécharger isova1.eso

Retour à la liste

Numérotation des lignes :

  1. C ISOVA1 SOURCE BP208322 16/11/18 21:17:54 9177
  2. SUBROUTINE ISOVA1(MCHELM,XISO,XTOL,IOPT,MELEME)
  3. IMPLICIT REAL*8 (A-H,O-Z)
  4. IMPLICIT INTEGER (I-N)
  5. C***********************************************************************
  6. C NOM : ISOVA1
  7. C DESCRIPTION : Construit le maillage d'une isovaleur d'un champ par
  8. C éléments
  9. C
  10. * IOPT=-1 EGIN
  11. * IOPT=0 EGAL (par défaut)
  12. * IOPT=1 EGSU
  13. C
  14. C
  15. C LANGAGE : ESOPE
  16. C AUTEUR : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF)
  17. C mél : gounand@semt2.smts.cea.fr
  18. C***********************************************************************
  19. C VERSION : v1, 17/12/2008, version initiale
  20. C HISTORIQUE : v1, 17/12/2008, création
  21. C HISTORIQUE : 30/07/2014, sg: ajout des options EGIN EGSU
  22. C ne pas créer de noeuds et d'éléments en multiples
  23. C exemplaires.
  24. C
  25. C
  26. C HISTORIQUE :
  27. C***********************************************************************
  28. -INC CCOPTIO
  29. -INC CCGEOME
  30. -INC CCREEL
  31. -INC SMCOORD
  32. -INC SMELEME
  33. -INC SMCHAML
  34. -INC SMLENTI
  35. *
  36. * Segments ajustables 1D contenant les noeuds des éléments créés ainsi
  37. * que leur couleur
  38. * ELEM(1) contient des POI1
  39. * ELEM(2) contient des SEG2
  40. * ELEM(3) contient des TRI3
  41. * ELEM(4) contient des TET4
  42. * ELEM(5) contient des PYR5
  43. * ELEM(6) contient des PRI6
  44. * ELEM(7) contient des QUA4
  45. *
  46. PARAMETER (NTYEL=7)
  47. SEGMENT ELEMS
  48. POINTEUR ELEM(NTYEL).MLENTI
  49. ENDSEGMENT
  50. SEGMENT MELEMS
  51. POINTEUR IPT(NTYEL).MELEME
  52. ENDSEGMENT
  53. *
  54. * Pile des nouveaux noeuds
  55. SEGMENT NEWNOD
  56. INTEGER NNOD
  57. INTEGER NOEINF(MAXNOD)
  58. INTEGER NOESUP(MAXNOD)
  59. REAL*8 COEINF(MAXNOD)
  60. ENDSEGMENT
  61. *
  62. segment newnum(nnod)
  63. *
  64. SEGMENT ICPR(XCOOR(/1)/(IDIM+1))
  65. segment inode(ino)
  66. segment jelnum(imaxel,ino)
  67. segment kelnum(imaxel,ino)
  68. segment xelnum(imaxel,ino)
  69. *
  70. CHARACTER*8 MCHA
  71. INTEGER IMPR,IRET
  72. LOGICAL LFOUND
  73. *
  74. INTEGER ITYPL(NTYEL)
  75. DATA ITYPL/1,2,4,23,25,16,8/
  76. *
  77. * Executable statements
  78. *
  79. IMPR=0
  80. IF (IMPR.GT.2) WRITE(IOIMP,*) 'Entrée dans isova1.eso'
  81. *
  82. * Initialisation des objets possiblement créés et de la pile
  83. * des nouveaux noeuds
  84. *
  85. SEGINI ELEMS
  86. DO ITYEL=1,NTYEL
  87. JG=0
  88. SEGINI MLENTI
  89. ELEM(ITYEL)=MLENTI
  90. ENDDO
  91. MAXNOD=0
  92. SEGINI NEWNOD
  93. *
  94. * Parcours du CHAMELEM
  95. *
  96. SEGACT MCHELM
  97. N1=IMACHE(/1)
  98. DO I1=1,N1
  99. ITYCHA=INFCHE(I1,6)
  100. IF (ITYCHA.NE.1) THEN
  101. MOTERR(1:16)='NOEUDS '
  102. * 291 2
  103. *Pas de MCHAML de type %m1:16 trouvé
  104. CALL ERREUR(291)
  105. RETURN
  106. ENDIF
  107. MELEME=IMACHE(I1)
  108. SEGACT MELEME
  109. MCHAML=ICHAML(I1)
  110. SEGACT MCHAML
  111. CALL ISOVA2(MELEME,MCHAML,XISO,XTOL,IOPT,NEWNOD,ELEMS,ITYPL)
  112. IF (IERR.NE.0) RETURN
  113. SEGDES MCHAML
  114. SEGDES MELEME
  115. ENDDO
  116. SEGDES MCHELM
  117. *
  118. * La pile NEWNOD contient généralement des noeuds géométriquement
  119. * confondus : on les élimine. Puis, on incrémente le segment MCOORD
  120. * avec le nouveaux noeuds non géométriquement confondus
  121. * et on met à jour les piles d'éléments.
  122. *
  123. CALL ISOVA5(NEWNOD,ELEMS,ITYPL)
  124. IF (IERR.NE.0) RETURN
  125. *
  126. * Les piles d'éléments peuvent contenir des informations redondantes :
  127. * - dans une pile d'éléments, plusieurs fois le même
  128. * - dans la pile des POI1, des noeuds déjà présents dans les piles
  129. * de SEG2, TRI3, TET4, PYR5, PRI6, QUA4
  130. * - dans la pile des SEG2, des segments déjà présents dans les piles
  131. * de TRI3, TET4, PYR5, PRI6, QUA4
  132. * - dans la pile des TRI3, des faces dèjà présentes dans la pile des
  133. * TET4
  134. * On réduit les piles de manière adéquate.
  135. *
  136. CALL ISOVA6(ELEMS,ITYPL)
  137. IF (IERR.NE.0) RETURN
  138. *
  139. * Transformation des segments ajustables en MELEME
  140. *
  141. SEGINI MELEMS
  142. NSOUT=0
  143. NBSOUS=0
  144. NBREF=0
  145. DO ITYEL=1,NTYEL
  146. MLENTI=ELEM(ITYEL)
  147. JG=LECT(/1)
  148. IF (JG.GT.0) THEN
  149. NSOUT=NSOUT+1
  150. ITYP=ITYPL(ITYEL)
  151. NBNN=NBNNE(ITYP)
  152. NBNN1=NBNN+1
  153. NBELEM=JG/NBNN1
  154. SEGINI MELEME
  155. ITYPEL=ITYP
  156. DO IELEM=1,NBELEM
  157. DO INN=1,NBNN
  158. NUM(INN,IELEM)=LECT((IELEM-1)*NBNN1+INN)
  159. ENDDO
  160. ICOLOR(IELEM)=LECT(IELEM*NBNN1)
  161. ENDDO
  162. SEGDES MELEME
  163. MELEMS.IPT(ITYEL)=MELEME
  164. ENDIF
  165. SEGSUP MLENTI
  166. ENDDO
  167. SEGSUP ELEMS
  168. *
  169. IF (NSOUT.EQ.1) THEN
  170. DO ITYEL=1,NTYEL
  171. IPT1=IPT(ITYEL)
  172. IF (IPT1.NE.0) THEN
  173. MELEME=IPT1
  174. ENDIF
  175. ENDDO
  176. ELSE
  177. * Traite aussi le cas maillage vide (NSOUT=0)
  178. NBNN=0
  179. NBELEM=0
  180. NBREF=0
  181. NBSOUS=NSOUT
  182. NBREF=0
  183. SEGINI MELEME
  184. ISOUS=0
  185. DO ITYEL=1,NTYEL
  186. IPT1=IPT(ITYEL)
  187. IF (IPT1.NE.0) THEN
  188. ISOUS=ISOUS+1
  189. LISOUS(ISOUS)=IPT1
  190. ENDIF
  191. ENDDO
  192. SEGDES MELEME
  193. ENDIF
  194. SEGSUP MELEMS
  195. RETURN
  196. *
  197. * End of subroutine ISOVA1
  198. *
  199. END
  200.  
  201.  
  202.  
  203.  
  204.  
  205.  
  206.  
  207.  

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