Télécharger champo.eso

Retour à la liste

Numérotation des lignes :

  1. C CHAMPO SOURCE CB215821 18/09/27 21:15:08 9936
  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.  
  41. C Pour de l'optimisation
  42. CHARACTER*4 MO4a,MO4b
  43.  
  44.  
  45. C POUR LE CHAPEAU DU CHPOINT
  46. JFLAG=0
  47. IF (IMOY.GE.10) THEN
  48. JFLAG=1
  49. IMOY=IMOY-10
  50. ENDIF
  51. *
  52. * ACTIVATION DU MCHAML
  53. *
  54. IRET=1
  55. MCHELM=IPCHAM
  56. SEGACT MCHELM
  57. * COMME ON UTILISE INFCHE(??,3) ON S'ASSURE QU'IL EXISTE BIEN
  58. L1=TITCHE(/1)
  59. N1=INFCHE(/1)
  60. N3=MAX(INFCHE(/2),3)
  61. IF (N3.NE.INFCHE(/2)) SEGADJ MCHELM
  62. IFACHE=IFOCHE
  63. NSOUS =ICHAML(/1)
  64. C-----------------------------------------------------------------------
  65. C
  66. C BOUCLE SUR LES SOUS REFERENCES DU CHAMELEM
  67. C MISE EN PLACE DES NOMS DE COMPOSANTES DANS ICOMP
  68. C
  69. C-----------------------------------------------------------------------
  70. SEGINI MTRA1,MTRA2
  71. SEGINI ICPR
  72. NNNOE=0
  73. *
  74. * BOUCLE SUR LES SOUS ZONES
  75. *
  76. DO 100 ISOUS=1,NSOUS
  77. *
  78. * ACTIVATION DU MELEME
  79. *
  80. IVACHE = INFCHE(ISOUS,3)
  81. MELEME = IMACHE(ISOUS)
  82. MCHAML = ICHAML(ISOUS)
  83. SEGACT MCHAML
  84. * activation des melval
  85. DO ID=1,IELVAL(/1)
  86. MELVAL=IELVAL(ID)
  87. SEGACT MELVAL
  88. ENDDO
  89. *
  90. * RECOPIE DES NOMS DE COMPOSANTES
  91. *
  92. DO 110 IB=1,NOMCHE(/2)
  93. MO4a = NOMCHE(IB)(1:4)
  94. DO 120 IC=1,ICOMP(/2)
  95. MO4b=ICOMP(IC)
  96. IF(MO4a.EQ.MO4b .AND. MHAR(IC).EQ.IVACHE) GOTO 110
  97. 120 CONTINUE
  98. ICOMP(**)=MO4a
  99. MHAR(**) =IVACHE
  100. 110 CONTINUE
  101. *
  102. * RECUPERATION DES NUMEROS DE NOEUDS
  103. *
  104. SEGACT MELEME
  105. DO 111 IOP = 1,NUM(/1)
  106. DO 111 JOP= 1,NUM(/2)
  107. IPT= NUM(IOP,JOP)
  108. IF(ICPR(IPT).EQ.0) THEN
  109. NNNOE=NNNOE+1
  110. ICPR(IPT)=NNNOE
  111. ENDIF
  112. 111 CONTINUE
  113. 100 CONTINUE
  114. *
  115. NNIN=ICOMP(/2)
  116. SEGINI MTRAV
  117. DO 112 IOP=1,NNIN
  118. INCO(IOP)=ICOMP(IOP)
  119. NHAR(IOP)=MHAR(IOP)
  120. 112 CONTINUE
  121. C
  122. C INITIALISATION DE CC STOCKANT LES VALEURS DU CHPOINT
  123. C
  124. C
  125. C
  126. C-----------------------------------------------------------------------
  127. C
  128. C BOUCLE SUR LES SOUS REFERENCES DU CHAMP PAR ELEMENT
  129. C
  130. C-----------------------------------------------------------------------
  131. DO 300 ISOUS=1,NSOUS
  132. *
  133. IVACHE=INFCHE(ISOUS,3)
  134. MELEME=IMACHE(ISOUS)
  135. MCHAML=ICHAML(ISOUS)
  136. NCP=NOMCHE(/2)
  137. C
  138. NBNN =NUM(/1)
  139. NBELEM=NUM(/2)
  140. C
  141. C BOUCLE SUR LES COMPOSANTES LES ELEMENTS ET LES NOEUDS
  142. C
  143. DO 320 IB=1,NBELEM
  144. DO 320 IC=1,NBNN
  145. C
  146. C REPERAGE D UN POINT
  147. IPT=ICPR(NUM(IC,IB))
  148. DO 330 ID=1,NCP
  149. MELVAL=IELVAL(ID)
  150. NBPTEL=VELCHE(/1)
  151. NEL =VELCHE(/2)
  152. IBMN=MIN(IB,NEL)
  153. IGMN=MIN(IC,NBPTEL)
  154. MO4a=NOMCHE(ID)(1:4)
  155. DO 330 IE=1,NNIN
  156. MO4b=ICOMP(IE)
  157. IF(MO4a.NE.MO4b .OR. IVACHE.NE.MHAR(IE)) GOTO 330
  158. BVALT=0.D0
  159. *
  160. IF (JFLAG.EQ.1) THEN
  161. DO 331 ICEL=1,NBPTEL
  162. C
  163. C ADDITION DANS BB POUR LES MCHAML AUX NOEUDS
  164. C
  165. BVALT=BVALT+VELCHE(ICEL,IBMN)
  166. 331 CONTINUE
  167. BVALT=BVALT/NBPTEL
  168. BB(IE,IPT)=BB(IE,IPT)+BVALT
  169. ELSE
  170. BB(IE,IPT)=BB(IE,IPT)+VELCHE(IGMN,IBMN)
  171. ENDIF
  172. IBIN(IE,IPT)=IBIN(IE,IPT)+1
  173. 330 CONTINUE
  174. *
  175. IGEO(IPT)=NUM(IC,IB)
  176. 320 CONTINUE
  177. C desactivation des melval
  178. C DO ID=1,IELVAL(/1)
  179. C MELVAL=IELVAL(ID)
  180. C SEGDES MELVAL
  181. C ENDDO
  182. C SEGDES MCHAML
  183. 300 CONTINUE
  184. *
  185. C DO 341 ISOUS=1,NSOUS
  186. C MELEME=IMACHE(ISOUS)
  187. C SEGDES MELEME
  188. C 341 CONTINUE
  189. *
  190. IF (IMOY.EQ.1) THEN
  191. DO 340 IPT=1,NNNOE
  192. DO 340 IE=1,NNIN
  193. IF (IBIN(IE,IPT).NE.0) THEN
  194. BB(IE,IPT)=BB(IE,IPT)/IBIN(IE,IPT)
  195. ELSE
  196. BB(IE,IPT)=0.
  197. ENDIF
  198. 340 CONTINUE
  199. ENDIF
  200. *
  201. CALL CRECHP(MTRAV,IPCHPO)
  202. SEGSUP MTRAV,ICPR,MTRA1,MTRA2
  203. MCHPOI=IPCHPO
  204. IFOPOI=IFACHE
  205. MTYPOI=TITCHE
  206. IF ( IMOY .EQ. 0) THEN
  207. * on somme les participations des elements: discret
  208. JATTRI(1) = 2
  209. ELSE
  210. * on prend la moyenne entre les éléments: diffus
  211. JATTRI(1) = 1
  212. ENDIF
  213. C SEGDES MCHELM,MCHPOI
  214. RETURN
  215. END
  216.  
  217.  
  218.  

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