Télécharger kcha0.eso

Retour à la liste

Numérotation des lignes :

  1. C KCHA0 SOURCE CHAT 05/01/13 00:52:35 5004
  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. -INC CCOPTIO
  40. -INC SMELEME
  41. -INC SMCHPOI
  42. -INC SMCOORD
  43. -INC TMTRAV
  44. C
  45. SEGMENT ICCPR
  46. INTEGER ICPR(NNGOT)
  47. ENDSEGMENT
  48. C
  49. C- Transforme le maillage en POI1 si maillage quelconque
  50. C- Le maillage POI1 de pointeur IPT1 est actif au retour de CHANGE
  51. C
  52. IPT1 = IPSG
  53. SEGACT IPT1
  54. C PPw NBSOUS = LISOUS(/1)
  55. NBSOUS = IPT1.LISOUS(/1)
  56. C PPw IF ((NBSOUS.NE.0).OR.(ITYPEL.NE.1)) THEN
  57. IF ((NBSOUS.NE.0).OR.(IPT1.ITYPEL.NE.1)) THEN
  58.  
  59. CALL CHANGE(IPT1,1)
  60. IF (IERR.NE.0) RETURN
  61. ENDIF
  62. C
  63. C - Création du tableau ICPR pour le maillage IPT1
  64. C
  65. NNGOT = XCOOR(/1)/(IDIM+1)
  66. SEGINI ICCPR
  67. C
  68. NNNOE = IPT1.NUM(/2)
  69. IK = 0
  70. DO 10 I2=1,NNNOE
  71. K = IPT1.NUM(1,I2)
  72. IF (ICPR(K).EQ.0) THEN
  73. IK = IK + 1
  74. ICPR(K) = IK
  75. ENDIF
  76. 10 CONTINUE
  77. SEGDES IPT1
  78. C
  79. C - Récupération du nombre de composantes de ICHP1
  80. C
  81. MCHPOI = ICHP1
  82. SEGACT MCHPOI
  83. NSOUPO = IPCHP(/1)
  84. NNIN = 0
  85. DO 20 I=1,NSOUPO
  86. MSOUPO = IPCHP(I)
  87. SEGACT MSOUPO
  88. NNIN = NNIN + NOCOMP(/2)
  89. 20 CONTINUE
  90. C
  91. C - Création et remplissage de MTRAV
  92. C - Balayage des partitions de ICHP1, utilisation du tableau ICPR
  93. C - Extraction des composantes uniquement contenues dans NOMTOT
  94. C - si NBCOMP.NE.0
  95. C
  96. SEGINI MTRAV
  97. C
  98. C - Nombre de composantes véritablement dans MTRAV :
  99. C
  100. NBIN = 0
  101. C
  102. DO 30 I=1,NSOUPO
  103. MSOUPO = IPCHP(I)
  104. NC = NOCOMP(/2)
  105. MPOVAL = IPOVAL
  106. SEGACT MPOVAL
  107. MELEME = IGEOC
  108. SEGACT MELEME
  109. NBELEM = NUM(/2)
  110. DO 50 ICOMP=1,NC
  111. IF (NBCOMP.NE.0) THEN
  112. CALL PLACE(NOMTOT,NBCOMP,IPEXT,NOCOMP(ICOMP))
  113. ENDIF
  114. IF ((NBCOMP.EQ.0).OR.(IPEXT.NE.0)) THEN
  115. CALL PLACE(INCO,NBIN,IPOS,NOCOMP(ICOMP))
  116. IF ((IPOS.EQ.0).OR.(NHAR(IPOS).NE.NOHARM(ICOMP))) THEN
  117. NBIN = NBIN + 1
  118. INCO(NBIN) = NOCOMP(ICOMP)
  119. NHAR(NBIN) = NOHARM(ICOMP)
  120. IPOS = NBIN
  121. ENDIF
  122. DO 40 J=1,NBELEM
  123. K = NUM(1,J)
  124. IK = ICPR(K)
  125. IF (IK.NE.0) THEN
  126. IGEO(IK) = K
  127. IBIN(IPOS,IK) = 1
  128. BB(IPOS,IK) = VPOCHA(J,ICOMP)
  129. ENDIF
  130. 40 CONTINUE
  131. ENDIF
  132.  
  133. 50 CONTINUE
  134. SEGDES MELEME
  135. SEGDES MPOVAL
  136. SEGDES MSOUPO
  137. 30 CONTINUE
  138. SEGDES MCHPOI
  139.  
  140. C
  141. NNIN = NBIN
  142. SEGADJ MTRAV
  143. C
  144. C - Test si toutes les composantes que l'on voulait extraire sont
  145. C - bien dans le segment de travail
  146. C
  147. DO 60 I=1,NBCOMP
  148. CALL PLACE(INCO,NNIN,IPEXT,NOMTOT(I))
  149. IF (IPEXT.EQ.0) THEN
  150. MOTERR(1:4) = NOMTOT(I)
  151. CALL ERREUR(197)
  152. SEGDES MTRAV,ICCPR
  153. RETURN
  154. ENDIF
  155. 60 CONTINUE
  156.  
  157. SEGDES MTRAV
  158. SEGDES ICCPR
  159. C
  160. END
  161.  
  162.  
  163.  
  164.  

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