Télécharger champo.eso

Retour à la liste

Numérotation des lignes :

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

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