Télécharger champo.eso

Retour à la liste

Numérotation des lignes :

  1. C CHAMPO SOURCE PV 09/03/12 21:16:53 6325
  2. SUBROUTINE CHAMPO(IPCHAM,IMOY,IPCHPO,IRET)
  3. C=======================================================================
  4. C
  5. C TRANSFORME UN MCHAML EN CHPOINT
  6. C
  7. C
  8. C ATTENTION LES COMPOSANTES DE IPCHAM NE DOIVENT PAS ETRE ' '
  9. C ( DES MOT BLANCS )
  10. C
  11. C ENTREES
  12. C
  13. C IPCHAM=Pointeur sur un MCHAML
  14. C IMOY =1 si moyenne sur les elements, 0 si somme
  15. C
  16. C SORTIES
  17. C
  18. C IPCHPO=Pointeur sur un CHPOINT
  19. C IRET=1 OU 0 suivant succes ou non
  20. C Message d'erreur imprime si IRET=0
  21. C
  22. C
  23. C=======================================================================
  24. IMPLICIT INTEGER(I-N)
  25. IMPLICIT REAL*8(A-H,O-Z)
  26. -INC SMCHAML
  27. -INC SMCHPOI
  28. -INC SMELEME
  29. -INC SMCOORD
  30. -INC CCOPTIO
  31. -INC TMTRAV
  32. *
  33. SEGMENT ICPR(XCOOR(/1)/(IDIM+1))
  34. SEGMENT MTRA1
  35. CHARACTER*4 ICOMP(0)
  36. ENDSEGMENT
  37. SEGMENT MTRA2
  38. INTEGER MHAR(0)
  39. ENDSEGMENT
  40. C POUR LE CHAPEAU DU CHPOINT
  41. JFLAG=0
  42. IF (IMOY.GE.10) THEN
  43. JFLAG=1
  44. IMOY=IMOY-10
  45. ENDIF
  46. *
  47. * ACTIVATION DU MCHAML
  48. *
  49. IRET=1
  50. MCHELM=IPCHAM
  51. SEGACT MCHELM
  52. * COMME ON UTILISE INFCHE(??,3) ON S'ASSURE QU'IL EXISTE BIEN
  53. L1=TITCHE(/1)
  54. N1=INFCHE(/1)
  55. N3=MAX(INFCHE(/2),3)
  56. IF (N3.NE.INFCHE(/2)) SEGADJ MCHELM
  57. IFACHE=IFOCHE
  58. NSOUS =ICHAML(/1)
  59. C-----------------------------------------------------------------------
  60. C
  61. C BOUCLE SUR LES SOUS REFERENCES DU CHAMELEM
  62. C MISE EN PLACE DES NOMS DE COMPOSANTES DANS ICOMP
  63. C
  64. C-----------------------------------------------------------------------
  65. SEGINI MTRA1,MTRA2
  66. SEGINI ICPR
  67. NNNOE=0
  68. *
  69. * BOUCLE SUR LES SOUS ZONES
  70. *
  71. DO 100 ISOUS=1,NSOUS
  72. *
  73. * ACTIVATION DU MELEME
  74. *
  75. MELEME = IMACHE(ISOUS)
  76. MCHAML = ICHAML(ISOUS)
  77. SEGACT MCHAML
  78. * activation des melval
  79. DO ID=1,IELVAL(/1)
  80. MELVAL=IELVAL(ID)
  81. SEGACT MELVAL
  82. ENDDO
  83. *
  84. * RECOPIE DES NOMS DE COMPOSANTES
  85. *
  86. DO 110 IB=1,NOMCHE(/2)
  87. DO 120 IC=1,ICOMP(/2)
  88. IF(ICOMP(IC).EQ.NOMCHE(IB)(1:4)
  89. 1 .AND.MHAR(IC).EQ.INFCHE(ISOUS,3)) GOTO 110
  90. 120 CONTINUE
  91. ICOMP(**)=NOMCHE(IB)(1:4)
  92. MHAR(**) =INFCHE(ISOUS,3)
  93. 110 CONTINUE
  94. *
  95. * RECUPERATION DES NUMEROS DE NOEUDS
  96. *
  97. SEGACT MELEME
  98. DO 111 IOP = 1,NUM(/1'#41;
  99. DO 111 JOP= 1,NUM(/2)
  100. IPT= NUM(IOP,JOP)
  101. IF(ICPR(IPT).EQ.0) THEN
  102. NNNOE=NNNOE+1
  103. ICPR(IPT)=NNNOE
  104. ENDIF
  105. 111 CONTINUE
  106. 100 CONTINUE
  107. *
  108. NNIN=ICOMP(/2)
  109. SEGINI MTRAV
  110. DO 112 IOP=1,NNIN
  111. INCO(IOP)=ICOMP(IOP)
  112. NHAR(IOP)=MHAR(IOP)
  113. 112 CONTINUE
  114. C
  115. C INITIALISATION DE CC STOCKANT LES VALEURS DU CHPOINT
  116. C
  117. C
  118. C
  119. C-----------------------------------------------------------------------
  120. C
  121. C BOUCLE SUR LES SOUS REFERENCES DU CHAMP PAR ELEMENT
  122. C
  123. C-----------------------------------------------------------------------
  124. DO 300 ISOUS=1,NSOUS
  125. *
  126. MELEME=IMACHE(ISOUS)
  127. MCHAML=ICHAML(ISOUS)
  128. NCP=NOMCHE(/2)
  129. C
  130. NBNN =NUM(/1)
  131. NBELEM=NUM(/2)
  132. C
  133. C BOUCLE SUR LES COMPOSANTES LES ELEMENTS ET LES NOEUDS
  134. C
  135. DO 320 IB=1,NBELEM
  136. DO 320 IC=1,NBNN
  137. C
  138. C REPERAGE D UN POINT
  139. IPT=ICPR(NUM(IC,IB))
  140. DO 330 ID=1,NCP
  141. DO 330 IE=1,NNIN
  142. *
  143. MELVAL=IELVAL(ID)
  144. NBPTEL=VELCHE(/1)
  145. NEL =VELCHE(/2)
  146. IBMN=MIN(IB,NEL)
  147. IGMN=MIN(IC,NBPTEL)
  148. *
  149. IF(NOMCHE(ID)(1:4).NE.ICOMP(IE)
  150. 1 .OR.INFCHE(ISOUS,3).NE.MHAR(IE)) GOTO 330
  151. BVALT=0.
  152. *
  153. IF (JFLAG.EQ.1) THEN
  154. DO 331 ICEL=1,NBPTEL
  155. C
  156. C ADDITION DANS BB POUR LES MCHAML AUX NOEUDS
  157. C
  158. BVALT=BVALT+VELCHE(ICEL,IBMN)
  159. 331 CONTINUE
  160. BVALT=BVALT/NBPTEL
  161. BB(IE,IPT)=BB(IE,IPT)+BVALT
  162. ELSE
  163. BB(IE,IPT)=BB(IE,IPT)+VELCHE(IGMN,IBMN)
  164. ENDIF
  165. IBIN(IE,IPT)=IBIN(IE,IPT)+1
  166. 330 CONTINUE
  167. *
  168. IGEO(IPT)=NUM(IC,IB)
  169. 320 CONTINUE
  170. * desactivation des melval
  171. DO ID=1,IELVAL(/1)
  172. MELVAL=IELVAL(ID)
  173. SEGDES MELVAL
  174. ENDDO
  175. SEGDES MCHAML
  176. 300 CONTINUE
  177. *
  178. DO 341 ISOUS=1,NSOUS
  179. MELEME=IMACHE(ISOUS)
  180. SEGDES MELEME
  181. 341 CONTINUE
  182. *
  183. IF (IMOY.EQ.1) THEN
  184. DO 340 IPT=1,NNNOE
  185. DO 340 IE=1,NNIN
  186. IF (IBIN(IE,IPT).NE.0) THEN
  187. BB(IE,IPT)=BB(IE,IPT)/IBIN(IE,IPT)
  188. ELSE
  189. BB(IE,IPT)=0.
  190. ENDIF
  191. 340 CONTINUE
  192. ENDIF
  193. *
  194. CALL CRECHP(MTRAV,IPCHPO)
  195. SEGSUP MTRAV,ICPR,MTRA1,MTRA2
  196. MCHPOI=IPCHPO
  197. SEGACT MCHPOI*MOD
  198. IFOPOI=IFACHE
  199. MTYPOI=TITCHE
  200. IF ( IMOY .EQ. 0) THEN
  201. * on somme les participations des elements: discret
  202. JATTRI(1) = 2
  203. ELSE
  204. * on prend la moyenne entre les éléments: diffus
  205. JATTRI(1) = 1
  206. ENDIF
  207. SEGDES MCHPOI
  208. SEGDES MCHELM
  209. RETURN
  210. END
  211.  
  212.  
  213.  
  214.  
  215.  
  216.  

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