Télécharger extr23.eso

Retour à la liste

Numérotation des lignes :

  1. C EXTR23 SOURCE BP208322 17/04/18 21:15:05 9396
  2. ************************************************************************
  3. * NOM : extr23
  4. * DESCRIPTION : Extrait les valeurs d'un CHPOINT a une composante pour
  5. * les mettre dans un LISTREEL
  6. ************************************************************************
  7. * HISTORIQUE : 12/12/2012 : JCARDO : création de la subroutine
  8. * HISTORIQUE : 13/12/2012 : JCARDO : nouvel argument MLMOTS contenant
  9. * la liste des composantes à sortir
  10. * HISTORIQUE : 31/05/2016 : JCARDO : nouvel argument IVID permettant
  11. * d'ignorer l'erreur quand une
  12. * composante n'existe pas
  13. * HISTORIQUE :
  14. ************************************************************************
  15. * Prière de PRENDRE LE TEMPS DE COMPLÉTER LES COMMENTAIRES
  16. * en cas de modification de ce sous-programme afin de faciliter
  17. * la maintenance !
  18. ************************************************************************
  19. * APPELÉ PAR : extrai.eso
  20. ************************************************************************
  21. * ENTRÉES :: aucune
  22. * SORTIES :: aucune
  23. ************************************************************************
  24. * SYNTAXE (GIBIANE) :
  25. *
  26. * LREEL1 = EXTR CHPO1 'VALE' (MOT1|LMOT1) (POIN1|MAIL1) ('NOID') ;
  27. *
  28. ************************************************************************
  29. SUBROUTINE EXTR23(ICHPOI,MLMOTS,MELEME,MLREEL,IVID)
  30. *
  31. IMPLICIT INTEGER(I-N)
  32. IMPLICIT REAL*8(A-H,O-Z)
  33. *
  34. -INC CCOPTIO
  35. -INC SMCHPOI
  36. -INC SMELEME
  37. -INC SMLREEL
  38. -INC SMLMOTS
  39. *
  40. CHARACTER*4 MCO
  41. *
  42. *
  43. * Création de la liste de réels renvoyée en sortie
  44. JG=0
  45. SEGINI,MLREEL
  46. *
  47. ************************************************************************
  48. * G E S T I O N D E S C O M P O S A N T E S M U L T I P L E S
  49. ************************************************************************
  50. *
  51. * a) SI L'ON N'A PAS FOURNI DE LISTE DE COMPOSANTES
  52. * => on verifie que le CHPOINT ne contient qu'une seule composante
  53. * =============================================================
  54. IF (MLMOTS.NE.0) GOTO 50
  55. MCHPOI=ICHPOI
  56. SEGACT,MCHPOI
  57. NSOUPO=IPCHP(/1)
  58. IF (NSOUPO.EQ.0) GOTO 1000
  59. * /!\ on suppose que la partition est bien faite,
  60. * c'est-à-dire 1 SOUPO = 1 liste de composante unique)
  61. IF (NSOUPO.GT.1) GOTO 9
  62. MSOUPO=IPCHP(1)
  63. SEGACT,MSOUPO
  64. NBCOMP=NOCOMP(/2)
  65. IF (NBCOMP.GT.1) GOTO 9
  66. GOTO 100
  67. *
  68. * (ERREUR 761 => "L'objet %m1:8 ayant au moins %i1 composantes,
  69. * precisez le nom de la composante a traiter.")
  70. 9 MOTERR(1:8)='CHPOINT'
  71. INTERR(1)=NBCOMP
  72. CALL ERREUR(761)
  73. RETURN
  74. *
  75. *
  76. * b) SI ON A SPECIFIE LA LISTE DES COMPOSANTES A SORTIR
  77. * => on appelle EXCOPP pour faire le travail
  78. * ==================================================
  79. 50 SEGACT,MLMOTS
  80. ICO=0
  81. NCO=MOTS(/2)
  82. * (label 51 = boucle sur les composantes)
  83. 51 CONTINUE
  84. IF (ICO.EQ.NCO) GOTO 1000
  85. ICO=ICO+1
  86. MCO=MOTS(ICO)
  87. CALL EXCOPP(ICHPOI,MCO,NIFOUR,MCHPOI,MCO,NIFOUR,IVID)
  88. IF (IERR.NE.0) RETURN
  89. SEGACT,MCHPOI
  90. NSOUPO=IPCHP(/1)
  91. IF (NSOUPO.GT.1) THEN
  92. MOTERR(1:8)='EXTR23'
  93. CALL ERREUR(1039)
  94. RETURN
  95. ENDIF
  96. *
  97. *
  98. *
  99. ************************************************************************
  100. * G E S T I O N D E L ' O R D R E D U L I S T R E E L
  101. ************************************************************************
  102. *
  103. * a) UN MELEME A ETE FOURNI POUR SPECIFIER L'ORDRE DE SORTIE
  104. * =======================================================
  105. *
  106. 100 CONTINUE
  107. IF (MELEME.EQ.0) GOTO 200
  108. *
  109. * On vérifie qu'il est composé uniquement de POI1
  110. SEGACT,MELEME
  111. IF (LISOUS(/1).GT.0.OR.ITYPEL.NE.1) THEN
  112. MOTERR(1:8)='MAILLAGE'
  113. MOTERR(9:24)='POI1'
  114. CALL ERREUR(1025)
  115. RETURN
  116. ENDIF
  117. *
  118. * Agrandissement du LISTREEL
  119. NP1=NUM(/2)
  120. JG=JG+NP1
  121. SEGADJ,MLREEL
  122. *
  123. * Remplissage du LISTREEL selon l'ordre demandé
  124. IF (NSOUPO.EQ.0) GOTO 950
  125. MSOUPO=IPCHP(1)
  126. SEGACT,MSOUPO
  127. IPT1=IGEOC
  128. MPOVAL=IPOVAL
  129. SEGACT,IPT1,MPOVAL
  130. NP2=IPT1.NUM(/2)
  131. DO 150 I2=1,NP2
  132. DO I3=1,NP1
  133. IF (IPT1.NUM(1,I2).EQ.NUM(1,I3)) THEN
  134. PROG(JG-NP1+I3)=VPOCHA(I2,1)
  135. GOTO 150
  136. ENDIF
  137. ENDDO
  138. 150 CONTINUE
  139. *
  140. SEGDES,MPOVAL,IPT1,MELEME
  141. GOTO 950
  142. *
  143. *
  144. * b) ON NE S'INTERESSE PAS A L'ORDRE DE SORTIE
  145. * => Remplissage du LISTREEL dans l'ordre du VPOCHA
  146. * =================================================
  147. *
  148. 200 CONTINUE
  149. *
  150. IF (NSOUPO.EQ.0) GOTO 950
  151. MSOUPO=IPCHP(1)
  152. SEGACT,MSOUPO
  153. MPOVAL=IPOVAL
  154. SEGACT,MPOVAL
  155. NP2=VPOCHA(/1)
  156. JG=JG+NP2
  157. SEGADJ,MLREEL
  158. DO I2=1,NP2
  159. PROG(JG-NP2+I2)=VPOCHA(I2,1)
  160. ENDDO
  161. *
  162. SEGDES,MPOVAL
  163. *
  164. *
  165. *
  166. 950 CONTINUE
  167. IF (MLMOTS.NE.0) THEN
  168. CALL DTCHPO(MCHPOI)
  169. GOTO 51
  170. ELSE
  171. SEGDES,MSOUPO
  172. ENDIF
  173. *
  174. *
  175. 1000 CONTINUE
  176. IF (MLMOTS.EQ.0) THEN
  177. SEGDES,MCHPOI
  178. ELSE
  179. SEGDES,MLMOTS
  180. ENDIF
  181. SEGDES,MLREEL
  182. *
  183. *
  184. RETURN
  185. *
  186. END
  187. *
  188.  
  189.  
  190.  
  191.  
  192.  

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