Télécharger kcha0.eso

Retour à la liste

Numérotation des lignes :

  1. C KCHA0 SOURCE PV 20/03/30 21:20:21 10567
  2. SUBROUTINE KCHA0(ICHP1,IPSG,NBCOMP,NOMTOT,MTRAV,ICCPR)
  3. C-----------------------------------------------------------------------
  4. C Création du segment de travail MTRAV (et du segment de redirection)
  5. C associé au champoint ICHP1 sur le maillage de référence IPSG.
  6. C Le segment de travail contient au plus les composantes contenues
  7. C dans le tableau NOMTOT (si NBCOMP est différent de 0) .
  8. C-----------------------------------------------------------------------
  9. C
  10. C---------------------------
  11. C Parametres Entree/Sortie :
  12. C---------------------------
  13. C
  14. C E/ ICHP1 : Champoint
  15. C E/ IPSG : Maillage de référence, en général de type POI1
  16. C E/ NBCOMP : Nombre de composantes à extraire (toutes NBCOMP = 0)
  17. C E/ NOMTOT : Tableau des noms des composantes à extraire
  18. C S/ MTRAV : Segment de travail
  19. C S/ ICCPR : Segment de redirection (ICPR inverse de IGEO dans MTRAV)
  20. C
  21. C-------------------------------------
  22. C Tableaux du segment de redirection :
  23. C-------------------------------------
  24. C
  25. C ICPR(I)=J : Le noeud I a le numero J dans le MELEME des faces
  26. C NNGOT : Nombre de noeuds total du domaine
  27. C
  28. C-----------------------------------------------------------------------
  29. C
  30. C Langage : ESOPE + FORTRAN77
  31. C
  32. C Auteurs : L. DADA
  33. C
  34. C-----------------------------------------------------------------------
  35. IMPLICIT INTEGER(I-N)
  36. IMPLICIT REAL*8 (A-H,O-Z)
  37. CHARACTER*4 NOMTOT(*)
  38. C
  39.  
  40. -INC PPARAM
  41. -INC CCOPTIO
  42. -INC SMELEME
  43. -INC SMCHPOI
  44. -INC SMCOORD
  45. -INC TMTRAV
  46. C
  47. SEGMENT ICCPR
  48. INTEGER ICPR(NNGOT)
  49. ENDSEGMENT
  50. C
  51. C- Transforme le maillage en POI1 si maillage quelconque
  52. C- Le maillage POI1 de pointeur IPT1 est actif au retour de CHANGE
  53. C
  54. IPT1 = IPSG
  55. SEGACT IPT1
  56. C PPw NBSOUS = LISOUS(/1)
  57. NBSOUS = IPT1.LISOUS(/1)
  58. C PPw IF ((NBSOUS.NE.0).OR.(ITYPEL.NE.1)) THEN
  59. IF ((NBSOUS.NE.0).OR.(IPT1.ITYPEL.NE.1)) THEN
  60.  
  61. CALL CHANGE(IPT1,1)
  62. IF (IERR.NE.0) RETURN
  63. ENDIF
  64. C
  65. C - Création du tableau ICPR pour le maillage IPT1
  66. C
  67. NNGOT = nbpts
  68. SEGINI ICCPR
  69. C
  70. NNNOE = IPT1.NUM(/2)
  71. IK = 0
  72. DO 10 I2=1,NNNOE
  73. K = IPT1.NUM(1,I2)
  74. IF (ICPR(K).EQ.0) THEN
  75. IK = IK + 1
  76. ICPR(K) = IK
  77. ENDIF
  78. 10 CONTINUE
  79. SEGDES IPT1
  80. C
  81. C - Récupération du nombre de composantes de ICHP1
  82. C
  83. MCHPOI = ICHP1
  84. SEGACT MCHPOI
  85. NSOUPO = IPCHP(/1)
  86. NNIN = 0
  87. DO 20 I=1,NSOUPO
  88. MSOUPO = IPCHP(I)
  89. SEGACT MSOUPO
  90. NNIN = NNIN + NOCOMP(/2)
  91. 20 CONTINUE
  92. C
  93. C - Création et remplissage de MTRAV
  94. C - Balayage des partitions de ICHP1, utilisation du tableau ICPR
  95. C - Extraction des composantes uniquement contenues dans NOMTOT
  96. C - si NBCOMP.NE.0
  97. C
  98. SEGINI MTRAV
  99. C
  100. C - Nombre de composantes véritablement dans MTRAV :
  101. C
  102. NBIN = 0
  103. C
  104. DO 30 I=1,NSOUPO
  105. MSOUPO = IPCHP(I)
  106. NC = NOCOMP(/2)
  107. MPOVAL = IPOVAL
  108. SEGACT MPOVAL
  109. MELEME = IGEOC
  110. SEGACT MELEME
  111. NBELEM = NUM(/2)
  112. DO 50 ICOMP=1,NC
  113. IF (NBCOMP.NE.0) THEN
  114. CALL PLACE(NOMTOT,NBCOMP,IPEXT,NOCOMP(ICOMP))
  115. ENDIF
  116. IF ((NBCOMP.EQ.0).OR.(IPEXT.NE.0)) THEN
  117. CALL PLACE(INCO,NBIN,IPOS,NOCOMP(ICOMP))
  118. IF ((IPOS.EQ.0).OR.(NHAR(IPOS).NE.NOHARM(ICOMP))) THEN
  119. NBIN = NBIN + 1
  120. INCO(NBIN) = NOCOMP(ICOMP)
  121. NHAR(NBIN) = NOHARM(ICOMP)
  122. IPOS = NBIN
  123. ENDIF
  124. DO 40 J=1,NBELEM
  125. K = NUM(1,J)
  126. IK = ICPR(K)
  127. IF (IK.NE.0) THEN
  128. IGEO(IK) = K
  129. IBIN(IPOS,IK) = 1
  130. BB(IPOS,IK) = VPOCHA(J,ICOMP)
  131. ENDIF
  132. 40 CONTINUE
  133. ENDIF
  134.  
  135. 50 CONTINUE
  136. SEGDES MELEME
  137. SEGDES MPOVAL
  138. SEGDES MSOUPO
  139. 30 CONTINUE
  140. SEGDES MCHPOI
  141.  
  142. C
  143. NNIN = NBIN
  144. SEGADJ MTRAV
  145. C
  146. C - Test si toutes les composantes que l'on voulait extraire sont
  147. C - bien dans le segment de travail
  148. C
  149. DO 60 I=1,NBCOMP
  150. CALL PLACE(INCO,NNIN,IPEXT,NOMTOT(I))
  151. IF (IPEXT.EQ.0) THEN
  152. MOTERR(1:4) = NOMTOT(I)
  153. CALL ERREUR(197)
  154. SEGDES MTRAV,ICCPR
  155. RETURN
  156. ENDIF
  157. 60 CONTINUE
  158.  
  159. SEGDES MTRAV
  160. SEGDES ICCPR
  161. C
  162. END
  163.  
  164.  
  165.  
  166.  
  167.  

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