Télécharger champo.eso

Retour à la liste

Numérotation des lignes :

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

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