Télécharger quepoi.eso

Retour à la liste

Numérotation des lignes :

  1. C QUEPOI SOURCE PV 13/04/16 21:15:22 7765
  2. SUBROUTINE QUEPOI(ICHP1,IPSG,INDIC,NBCOMP,NOMTOT)
  3. C-----------------------------------------------------------------------
  4. C On teste le champoint ICHP1 afin de vérifier :
  5. C 1) qu'il est non partitionné
  6. C 2) qu'il a le bon nombre de composantes et/ou les bonnes composantes
  7. C 3) que son support géométrique est IPSG
  8. C Si INDIC vaut 1 en entrée, on modifie, si besoin, l'ordonnencement
  9. C des infos du CHPO afin d'imposer le SPG de pointeur IPSG. Si INDIC
  10. C vaut 0, des supports différents générent INDIC=-4 mais on n'imprime
  11. C pas de message d'erreur.
  12. C-----------------------------------------------------------------------
  13. C
  14. C---------------------------
  15. C Parametres Entree/Sortie :
  16. C---------------------------
  17. C
  18. C E/ ICHP1 : Champoint à tester
  19. C E/ IPSG : Maillage de référence, en général de type POI1
  20. C E/S INDIC : En entrée,
  21. C 0 On ne fait que vérifier le support géométrique,
  22. C 1 On impose le pointeur du support géométrique.
  23. C En sortie,
  24. C -4 si les spgs sont différents (points différents),
  25. C -3 si le nom des composantes sont incorrects,
  26. C -2 si le nombre de composantes est incorrect,
  27. C -1 si le champoint est partitionné,
  28. C 0 si les spgs sont identiques,
  29. C 1 si les points sont identiques.
  30. C E/S NBCOMP : En entrée,
  31. C >0 si on teste le nombre de compoantes,
  32. C 0 si on veut recuperer les noms de composantes,
  33. C -1 si on ne veut faire aucun test.
  34. C En sortie,
  35. C nombre de composantes du CHPO.
  36. C E/S NOMTOT : En entrée,
  37. C noms des composantes à tester (si NBCOMP > 0),
  38. C remplir NOMTOT(1)=' ' dans l'appelant sinon.
  39. C En sortie,
  40. C noms des composantes du CHPO (si NBCOMP = 0),
  41. C non rempli sinon.
  42. C
  43. C-----------------------------------------------------------------------
  44. C ATTENTION: TOUJOURS initialiser NOMTOT(dim) dans le prg appelant
  45. C (dim=1 si NBCOMP=0, dim=NBCOMP sinon)
  46. C-----------------------------------------------------------------------
  47. C
  48. C Langage : ESOPE + FORTRAN77
  49. C
  50. C Auteurs : F.AURIOL 09/93
  51. C
  52. C-----------------------------------------------------------------------
  53. IMPLICIT INTEGER(I-N)
  54. IMPLICIT REAL*8 (A-H,O-Z)
  55. CHARACTER*4 NOMTOT(*)
  56. C
  57. -INC CCOPTIO
  58. -INC SMELEME
  59. -INC SMCHPOI
  60. -INC SMCOORD
  61. SEGMENT IBEXIS
  62. INTEGER IEXIS(NBPTS)
  63. ENDSEGMENT
  64. C
  65. ININI = INDIC
  66. C
  67. C- Test si le CHPO est partitionné
  68. C
  69. MCHPOI = ICHP1
  70. SEGACT MCHPOI
  71. NSOUPO = IPCHP(/1)
  72. IF (NSOUPO.NE.1) THEN
  73. INDIC = -1
  74. MOTERR(1:8) = 'CHAMPOIN'
  75. CALL ERREUR(132)
  76. SEGDES MCHPOI
  77. RETURN
  78. ENDIF
  79. C
  80. C- Test/Récupération du nom des composantes
  81. C
  82. MSOUPO = IPCHP(1)
  83. SEGDES MCHPOI
  84. SEGACT MSOUPO
  85. NBCOM1 = NBCOMP
  86. NBCOMP = NOCOMP(/2)
  87. IF (NBCOM1.GT.-1) THEN
  88. IF (NBCOM1.EQ.0) THEN
  89. DO 5 ICOMP=1,NBCOMP
  90. NOMTOT(ICOMP) = NOCOMP(ICOMP)
  91. 5 CONTINUE
  92. ELSE
  93. IF (NBCOM1.NE.NBCOMP) THEN
  94. INDIC = -2
  95. MOTERR(1:8) = ' QUEPOI '
  96. MOTERR(9:16) = 'CHAMPOIN'
  97. INTERR(1) = NBCOM1
  98. INTERR(2) = NBCOMP
  99. CALL ERREUR(699)
  100. SEGDES MSOUPO
  101. RETURN
  102. ENDIF
  103. IF (NOMTOT(1).NE.' ') THEN
  104. DO 10 ICOMP=1,NBCOMP
  105. CALL PLACE(NOMTOT,NBCOMP,IPOS,NOCOMP(ICOMP))
  106. IF (IPOS.EQ.0) THEN
  107. INDIC = -3
  108. MOTERR(1:4) = NOCOMP(ICOMP)
  109. CALL ERREUR(197)
  110. SEGDES MSOUPO
  111. RETURN
  112. ENDIF
  113. 10 CONTINUE
  114. ENDIF
  115. ENDIF
  116. ENDIF
  117. C
  118. C- Récupération des infos du MSOUPO utilisées
  119. C
  120. IPT2 = IGEOC
  121. MPOVAL = IPOVAL
  122. SEGDES MSOUPO
  123. C
  124. C- Transforme le maillage en POI1 si maillage quelconque
  125. C- Le maillage POI1 de pointeur IPT1 est actif au retour de CHANGE
  126. C
  127. MELEME = IPSG
  128. SEGACT MELEME
  129. IPT1 = MELEME
  130. NBSOUS = LISOUS(/1)
  131. IF ((NBSOUS.NE.0).OR.(ITYPEL.NE.1)) THEN
  132. CALL CHANGE(IPT1,1)
  133. IF (IERR.NE.0) RETURN
  134. ENDIF
  135. C
  136. C- Si égalité des pointeurs INDIC=0
  137. C
  138. IF (IPT2.EQ.IPT1) THEN
  139. INDIC = 0
  140. SEGDES IPT1
  141. RETURN
  142. ENDIF
  143. C
  144. C- Dans le cas d'un MELEME de POI1 création d'un CHPO de support
  145. C- géométrique le POI1 en question.
  146. C
  147. IF (ININI.EQ.1) THEN
  148. N = IPT1.NUM(/2)
  149. NC = NBCOMP
  150. SEGINI MPOVA1
  151. ENDIF
  152. C
  153. C- Recherche si les points du MELEME de type POI1 sont dans le CHPO
  154. C- et ordonnencement si INDIC=1
  155. C
  156. NUMPT1 = IPT1.NUM(/2)
  157. SEGACT IPT2
  158. NUMPT2 = IPT2.NUM(/2)
  159. IF (NUMPT1.NE.NUMPT2) GOTO 110
  160. NBPTS=XCOOR(/1)/(IDIM+1)
  161. SEGINI IBEXIS
  162. DO 20 IEL=1,NBPTS
  163. IEXIS(IEL)=0
  164. 20 CONTINUE
  165. DO 30 IEL=1,NUMPT1
  166. NOE = IPT1.NUM(1,IEL)
  167. IEXIS(NOE)=IEL
  168. 30 CONTINUE
  169. IF (ININI.NE.1) THEN
  170. DO 15 IP=1,NUMPT2
  171. NOE=IPT2.NUM(1,IP)
  172. IF(IEXIS(NOE).EQ.0)GO TO 110
  173. 15 CONTINUE
  174. ELSE
  175. SEGACT MPOVAL
  176. DO 60 IP=1,NUMPT2
  177. NOE=IPT2.NUM(1,IP)
  178. IEL=IEXIS(NOE)
  179. IF(IEL.EQ.0)GO TO 110
  180. DO 50 NC1=1,NC
  181. MPOVA1.VPOCHA(IEL,NC1) = VPOCHA(IP,NC1)
  182. 50 CONTINUE
  183. 60 CONTINUE
  184. ENDIF
  185. SEGSUP IBEXIS
  186. C
  187. C- Traitement si points identiques
  188. C
  189. IF (ININI.EQ.1) THEN
  190. segact mpoval*mod
  191. DO 100 IEL=1,NUMPT1
  192. DO 90 NC1=1,NC
  193. VPOCHA(IEL,NC1) = MPOVA1.VPOCHA(IEL,NC1)
  194. 90 CONTINUE
  195. 100 CONTINUE
  196. SEGDES MPOVAL
  197. SEGSUP MPOVA1
  198. SEGACT MSOUPO*MOD
  199. IGEOC = IPT1
  200. SEGDES MSOUPO
  201. ENDIF
  202. INDIC = 1
  203. GOTO 120
  204. C
  205. C- Traitement si supports géométriques différents
  206. C
  207. 110 CONTINUE
  208. INDIC = -4
  209. IF (ININI.EQ.1) THEN
  210. SEGSUP MPOVA1
  211. MOTERR(1:8) = 'CHAMPOIN'
  212. MOTERR(9:16) = 'MAILLAGE'
  213. INTERR(1) = 1
  214. CALL ERREUR(698)
  215. ENDIF
  216. C
  217. C- Ménage
  218. C
  219. 120 CONTINUE
  220. SEGDES IPT2
  221. SEGDES IPT1
  222. *
  223. RETURN
  224. END
  225.  
  226.  
  227.  
  228.  
  229.  
  230.  

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