Télécharger result.eso

Retour à la liste

Numérotation des lignes :

  1. C RESULT SOURCE GOUNAND 13/08/01 21:15:11 7810
  2. SUBROUTINE RESULT(ICHPO1,ICHPOR)
  3. C====================================================================
  4. C
  5. C CALCULE LA RESULTANTE D UN CHAMP PAR POINT
  6. C
  7. C ENTREES
  8. C ICHPO1 = UN CHAMP PAR POINT ARBITRAIRE
  9. C SORTIES
  10. C ICHPOR = CHAMP PAR POINT RESULTANT
  11. C QUI A LES CARACTERISTIQUES SUIVANTES
  12. C NSOUPO=1 IGEOC=1ER POINT DU CHAMP DONNE
  13. C
  14. C ATTENTION : DANS L IMMEDIAT CET OPERATEUR SE CONTENTE DE
  15. C SOMMER LES VALEURS SUR LES DIFFERENTES COMPOSANTES
  16. C
  17. C CODE JACQUELINE BROCHARD AVRIL 85
  18. C corrections pour prendre en compte divers types
  19. C de chpoints vide S. GOUNAND JUILLET 2013
  20. C=====================================================================
  21. IMPLICIT INTEGER(I-N)
  22. IMPLICIT REAL*8(A-H,O-Z)
  23. -INC SMCHPOI
  24. -INC SMELEME
  25. -INC CCOPTIO
  26. SEGMENT SICOMP
  27. CHARACTER*4 ICOMP(0)
  28. ENDSEGMENT
  29. SEGMENT IHARM(0)
  30. C
  31. C STOCKENT LES NOMS DES COMPOSANTES ET LES HARMONIQUES
  32. C
  33. MCHPO1=ICHPO1
  34. SEGACT MCHPO1
  35. NSOUP1=MCHPO1.IPCHP(/1)
  36. C
  37. C ON INITIALISE LE CHPOINT RESULTANT
  38. C
  39. NSOUPO=MIN(1,NSOUP1)
  40. NAT=MAX(1,MCHPO1.JATTRI(/1))
  41. SEGINI MCHPOI
  42. C
  43. C INITIALISATION DES TITRES DU CHPOINT RESULTANT ET DU IFOPOI
  44. C
  45. MTYPOI=MCHPO1.MTYPOI
  46. MOCHDE=MCHPO1.MOCHDE
  47. IFOPOI=MCHPO1.IFOPOI
  48. DO 111 NATI=1,NAT
  49. JATTRI(NATI)=MCHPO1.JATTRI(NATI)
  50. 111 CONTINUE
  51. JATTRI(1)=2
  52. * le champ par point resultant est de nature discrete (DEGAY)
  53. ICHPOR=MCHPOI
  54. IF (NSOUP1.GT.0) THEN
  55. C
  56. C ON RECUPERE LES NOMS DES COMPOSANTES ET ON LES MET DANS ICOMP
  57. C ON CHERCHE EGALEMENT LE NUMERO DU PREMIER NOEUD NON NUL DANS LES
  58. C IGEOC
  59. C
  60. INODE=0
  61. SEGINI SICOMP,IHARM
  62. * gounand Les deux lignes suivantes sont inutiles et potentiellement
  63. * dangereuses si NC=0
  64. * ICOMP(**)=MSOUP1.NOCOMP(1)
  65. * IHARM(**)=MSOUP1.NOHARM(1)
  66. DO 100 IA=1,NSOUP1
  67. MSOUP1=MCHPO1.IPCHP(IA)
  68. SEGACT MSOUP1
  69. NC1=MSOUP1.NOCOMP(/2)
  70. DO 120 IB=1,NC1
  71. DO 140 IC=1,ICOMP(/2)
  72. IF (ICOMP(IC).EQ.MSOUP1.NOCOMP(IB)
  73. S .AND.IHARM(IC).EQ.MSOUP1.NOHARM(IB)) GOTO 120
  74. 140 CONTINUE
  75. ICOMP(**)=MSOUP1.NOCOMP(IB)
  76. IHARM(**)=MSOUP1.NOHARM(IB)
  77. 120 CONTINUE
  78. IPT1=MSOUP1.IGEOC
  79. IF (IPT1.GT.0.AND.INODE.EQ.0) THEN
  80. SEGACT IPT1
  81. NBL=IPT1.NUM(/2)
  82. IF (NBL.GT.0) INODE=IPT1.NUM(1,1)
  83. SEGDES IPT1
  84. ENDIF
  85. SEGDES MSOUP1
  86. 100 CONTINUE
  87. NC=ICOMP(/2)
  88. IF (NC.EQ.0) THEN
  89. * On n'a pas trouvé de composantes => CHPO VIDE
  90. NSOUPO=0
  91. SEGADJ MCHPOI
  92. ELSE
  93. SEGINI MSOUPO
  94. IPCHP(1)=MSOUPO
  95. C
  96. C REMPLISSAGE DES NOMS DE COMPOSANTES ET DES HARMONIQUES
  97. C
  98. DO 210 I=1,NC
  99. NOCOMP(I)=ICOMP(I)
  100. NOHARM(I)=IHARM(I)
  101. 210 CONTINUE
  102. C
  103. C CREATION DU SUPPORT GEOMETRIQUE DU CHPOINT RESULTANT
  104. C
  105. NBNN=1
  106. NBELEM=1
  107. * On n'a pas trouvé de noeuds => CHPO VIDE + noms de composantes
  108. * + IGEOC vide + IPOVAL vide
  109. * On est un peu trop gentil
  110. IF (INODE.EQ.0) NBELEM=0
  111. NBSOUS=0
  112. NBREF=0
  113. SEGINI MELEME
  114. ITYPEL=1
  115. IF (INODE.NE.0) NUM(1,1)=INODE
  116. SEGDES MELEME
  117. IGEOC=MELEME
  118. C
  119. C CREATION DES VALEURS DU CHPOINT RESULTANT
  120. C
  121. N=1
  122. IF (INODE.EQ.0) N=0
  123. SEGINI MPOVAL
  124. IPOVAL=MPOVAL
  125. IF (INODE.GT.0) THEN
  126. C
  127. C BOUCLE SUR LES SOUS PAQUETS DU CHPOINT ARGUMMENT
  128. C
  129. DO 200 IA=1,NSOUP1
  130. MSOUP1=MCHPO1.IPCHP(IA)
  131. SEGACT MSOUP1
  132. NC1=MSOUP1.NOCOMP(/2)
  133. MPOVA1=MSOUP1.IPOVAL
  134. SEGACT MPOVA1
  135. C
  136. C ON CHERCHE LE NOM DE LA COMPOSANTE
  137. C
  138. N1=MPOVA1.VPOCHA(/1)
  139. DO 220 IB=1,NC1
  140. DO 240 IC=1,NC
  141. IF (ICOMP(IC).EQ.MSOUP1.NOCOMP(IB)
  142. S .AND.IHARM(IC).EQ.MSOUP1.NOHARM(IB))
  143. $ GOTO 260
  144. 240 CONTINUE
  145. 260 CONTINUE
  146. C
  147. C ET ON ADDITIONNE
  148. C
  149. DO 280 ID=1,N1
  150. VPOCHA(1,IC)=VPOCHA(1,IC)+
  151. $ MPOVA1.VPOCHA(ID,IB)
  152. 280 CONTINUE
  153. 220 CONTINUE
  154. SEGDES MPOVA1
  155. SEGDES MSOUP1
  156. 200 CONTINUE
  157. ENDIF
  158. SEGDES MPOVAL
  159. SEGDES MSOUPO
  160. ENDIF
  161. C
  162. C SUPPRESSION DES SEGMENTS DE TRAVAIL
  163. C
  164. SEGSUP SICOMP,IHARM
  165. ENDIF
  166. SEGDES MCHPOI
  167. SEGDES MCHPO1
  168. RETURN
  169. END
  170.  
  171.  
  172.  
  173.  
  174.  
  175.  

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