Télécharger champo.eso

Retour à la liste

Numérotation des lignes :

  1. C CHAMPO SOURCE PV 20/04/03 21:15:16 10571
  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 PPARAM
  31. -INC CCOPTIO
  32. -INC TMTRAV
  33. *
  34. SEGMENT ICPR(nbpts)
  35. SEGMENT MTRA1
  36. CHARACTER*4 ICOMP(0)
  37. ENDSEGMENT
  38. SEGMENT MTRA2
  39. INTEGER MHAR(0)
  40. ENDSEGMENT
  41.  
  42. C Pour de l'optimisation
  43. CHARACTER*4 MO4a,MO4b
  44.  
  45.  
  46. C POUR LE CHAPEAU DU CHPOINT
  47. JFLAG=0
  48. IF (IMOY.GE.10) THEN
  49. JFLAG=1
  50. IMOY=IMOY-10
  51. ENDIF
  52. *
  53. * ACTIVATION DU MCHAML
  54. *
  55. IRET=1
  56. MCHELM=IPCHAM
  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. CALL oooprl(1)
  71. SEGINI MTRA1,MTRA2,ICPR
  72. CALL oooprl(0)
  73. NNNOE=0
  74. *
  75. * BOUCLE SUR LES SOUS ZONES
  76. *
  77. DO 100 ISOUS=1,NSOUS
  78. *
  79. * ACTIVATION DU MELEME
  80. *
  81. IVACHE = INFCHE(ISOUS,3)
  82. MELEME = IMACHE(ISOUS)
  83. MCHAML = ICHAML(ISOUS)
  84. *
  85. * RECOPIE DES NOMS DE COMPOSANTES
  86. *
  87. DO 110 IB=1,NOMCHE(/2)
  88. MO4a = NOMCHE(IB)(1:4)
  89. DO 120 IC=1,ICOMP(/2)
  90. MO4b=ICOMP(IC)
  91. IF(MO4a.EQ.MO4b .AND. MHAR(IC).EQ.IVACHE) GOTO 110
  92. 120 CONTINUE
  93. ICOMP(**)=MO4a
  94. MHAR(**) =IVACHE
  95. 110 CONTINUE
  96. *
  97. * RECUPERATION DES NUMEROS DE NOEUDS
  98. *
  99. DO 111 JOP= 1,NUM(/2)
  100. DO 113 IOP = 1,NUM(/1)
  101. IPT= NUM(IOP,JOP)
  102. IF(ICPR(IPT).EQ.0) THEN
  103. NNNOE=NNNOE+1
  104. ICPR(IPT)=NNNOE
  105. ENDIF
  106. 113 CONTINUE
  107. 111 CONTINUE
  108. 100 CONTINUE
  109. *
  110. NNIN=ICOMP(/2)
  111. SEGINI MTRAV
  112. DO 112 IOP=1,NNIN
  113. INCO(IOP)=ICOMP(IOP)
  114. NHAR(IOP)=MHAR(IOP)
  115. 112 CONTINUE
  116. C
  117. C INITIALISATION DE CC STOCKANT LES VALEURS DU CHPOINT
  118. C
  119. C
  120. C
  121. C-----------------------------------------------------------------------
  122. C
  123. C BOUCLE SUR LES SOUS REFERENCES DU CHAMP PAR ELEMENT
  124. C
  125. C-----------------------------------------------------------------------
  126. DO 300 ISOUS=1,NSOUS
  127. *
  128. IVACHE=INFCHE(ISOUS,3)
  129. MELEME=IMACHE(ISOUS)
  130. MCHAML=ICHAML(ISOUS)
  131. NCP=NOMCHE(/2)
  132. C
  133. NBNN =NUM(/1)
  134. NBELEM=NUM(/2)
  135. C
  136. C BOUCLE SUR LES COMPOSANTES LES ELEMENTS ET LES NOEUDS
  137. C
  138. DO 320 IB=1,NBELEM
  139. DO 320 IC=1,NBNN
  140. C
  141. C REPERAGE D UN POINT
  142. IPT=ICPR(NUM(IC,IB))
  143. DO 330 ID=1,NCP
  144. MELVAL=IELVAL(ID)
  145. NBPTEL=VELCHE(/1)
  146. NEL =VELCHE(/2)
  147. IBMN=MIN(IB,NEL)
  148. IGMN=MIN(IC,NBPTEL)
  149. MO4a=NOMCHE(ID)(1:4)
  150. DO 330 IE=1,NNIN
  151. MO4b=ICOMP(IE)
  152. IF(MO4a.NE.MO4b .OR. IVACHE.NE.MHAR(IE)) GOTO 330
  153. BVALT=0.D0
  154. *
  155. IF (JFLAG.EQ.1) THEN
  156. DO 331 ICEL=1,NBPTEL
  157. C
  158. C ADDITION DANS BB POUR LES MCHAML AUX NOEUDS
  159. C
  160. BVALT=BVALT+VELCHE(ICEL,IBMN)
  161. 331 CONTINUE
  162. BVALT=BVALT/NBPTEL
  163. BB(IE,IPT)=BB(IE,IPT)+BVALT
  164. ELSE
  165. BB(IE,IPT)=BB(IE,IPT)+VELCHE(IGMN,IBMN)
  166. ENDIF
  167. IBIN(IE,IPT)=IBIN(IE,IPT)+1
  168. 330 CONTINUE
  169. *
  170. IGEO(IPT)=NUM(IC,IB)
  171. 320 CONTINUE
  172. 300 CONTINUE
  173. *
  174. *
  175. IF (IMOY.EQ.1) THEN
  176. DO 340 IPT=1,NNNOE
  177. DO 340 IE=1,NNIN
  178. IF (IBIN(IE,IPT).NE.0) THEN
  179. BB(IE,IPT)=BB(IE,IPT)/IBIN(IE,IPT)
  180. ELSE
  181. BB(IE,IPT)=0.
  182. ENDIF
  183. 340 CONTINUE
  184. ENDIF
  185. *
  186. CALL CRECHP(MTRAV,IPCHPO)
  187. SEGSUP MTRAV,ICPR,MTRA1,MTRA2
  188. MCHPOI=IPCHPO
  189. IFOPOI=IFACHE
  190. MTYPOI=TITCHE
  191. IF ( IMOY .EQ. 0) THEN
  192. * on somme les participations des elements: discret
  193. JATTRI(1) = 2
  194. ELSE
  195. * on prend la moyenne entre les éléments: diffus
  196. JATTRI(1) = 1
  197. ENDIF
  198.  
  199. END
  200.  
  201.  
  202.  
  203.  
  204.  
  205.  

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