Télécharger chaco1.eso

Retour à la liste

Numérotation des lignes :

  1. C CHACO1 SOURCE PV 09/03/12 21:16:40 6325
  2. SUBROUTINE CHACO1(IPSONO,IPSON1,IPSON2,IEP,IPGEOM,IPINTE,IPCHEQ,
  3. . IPCHE1,IPCHE2)
  4. IMPLICIT INTEGER(I-N)
  5. IMPLICIT REAL*8(A-H,O-Z)
  6. ************************************************************************
  7. *
  8. * C H A C O 1
  9. * -----------
  10. *
  11. * FONCTION:
  12. * ---------
  13. * CAS DES SOURCES VOLUMIQUES
  14. * COQUES SEGMENT AXISYMETRIQUE ET TRIANGLE
  15. *
  16. * MODULES UTILISES:
  17. * -----------------
  18. *
  19. -INC CCOPTIO
  20. -INC CCREEL
  21. -INC SMCHAML
  22. -INC SMELEME
  23. -INC SMINTE
  24. -INC SMCOORD
  25. *
  26. * PARAMETRES: (E)=ENTREE (S)=SORTIE (+ = CONTENU DANS UN COMMUN)
  27. * -----------
  28. *
  29. * IPSONO (E) POINTEURS SUR DES SEGMENTS MELVAL CONTENANT LES
  30. * IPSON1 SOURCES
  31. * IPSON2
  32. * IEP (E) POINTEUR SUR UN SEGMENT MELVAL COTENANT LES EPAISSEUR
  33. * IPGEOM (E) POINTEUR SUR UN OBJET MAILLAGE ELEMENTAIRE
  34. * IPINTE (E) POINTEUR SUR UN SEGMENT MINTE CONTENANT LES
  35. * CARACTERISTIQUES D'INTEGRATION
  36. * +IDIM (E) VOIR CCOPTIO
  37. * +XPI (E) VOIR CCREEL
  38. * IPCHEQ (S) POINTEURS SUR DES SEGMENTS MELVAL CONTENANT LES
  39. * IPCHE1 CHALEURS NODALES EQUIVALENTES
  40. * IPCHE2
  41. *
  42. * VARIABLES:
  43. * ----------
  44. *
  45. * XE(3,NBPTEL) = COORDONNEES DES ELEMENTS DANS LE REPERE GLOBAL
  46. * SURF = SURFACE ELEMENTAIRE AU POINT DE GAUSS
  47. * A ET S = TABLEAUX DE TRAVAIL
  48. *
  49. REAL*8 S(6)
  50. SEGMENT,MMAT1
  51. REAL*8 XE(3,NBPTEL),A(NBPTEL,NBPTEL),SHP(6,NBPTEL),AA(NBE,NBE)
  52. ENDSEGMENT
  53. *
  54. * CONSTANTES:
  55. * -----------
  56. *
  57. PARAMETER ( O1=1.D0 )
  58. PARAMETER ( O2=2.D0,O30=30.D0,O8=8.D0,O15=15.D0)
  59. *
  60. * AUTEUR, DATE DE CREATION:
  61. * -------------------------
  62. *
  63. * P. DOWLATYARI JUIN 90 ADAPTATION DE CHAMAS
  64. *
  65. * LANGAGE:
  66. * --------
  67. *
  68. * ESOPE + FORTRAN77
  69. *
  70. ************************************************************************
  71. *
  72. * ON RECUPERE LES VALEURS DES SOURCES
  73. *
  74. MELVA1=IPSONO
  75. SEGACT,MELVA1
  76. NBPTE1=MELVA1.VELCHE(/1)
  77. NEL1=MELVA1.VELCHE(/2)
  78. MELVA2=IPSON1
  79. SEGACT,MELVA2
  80. MELVA3=IPSON2
  81. SEGACT,MELVA3
  82. *
  83. * ON RECUPERE LES CARACTERISTIQUES D'INTEGRATION
  84. *
  85. MINTE=IPINTE
  86. SEGACT,MINTE
  87. NBPGAU=POIGAU(/1)
  88. NBNO=SHPTOT(/2)
  89. *
  90. * ON RECUPERE UN DES MAILLAGES ELEMENTAIRES DE L'ENVELOPPE
  91. *
  92. MELEME=IPGEOM
  93. SEGACT,MELEME
  94. NBPTEL=NUM(/1)
  95. NEL=NUM(/2)
  96. *
  97. * INITIALISATION DES MELVALS QUI CONTIENDRA LES CHALEURS EQUIVALENTE
  98. *
  99. N1PTEL=NBPTEL
  100. N1EL=NEL
  101. N2PTEL=0
  102. N2EL=0
  103. NBE=3*NBPTEL
  104. SEGINI,MELVAL
  105. IPCHEQ=MELVAL
  106. SEGINI,MELVA4
  107. IPCHE1=MELVA4
  108. SEGINI,MELVA5
  109. IPCHE2=MELVA5
  110. SEGINI,MMAT1
  111. MELVA6=IEP
  112. SEGACT,MELVA6
  113. *
  114. * BOUCLE SUR LES ELEMENTS
  115. *
  116. DO 10 IEL=1,NEL
  117. *
  118. * ON CHERCHE LES COORDONNEES DES NOEUDS DANS LE REPERE GLOBAL
  119. *
  120. CALL DOXE(XCOOR,IDIM,NBPTEL,NUM,IEL,XE)
  121. *
  122. * BOUCLE SUR LES POINTS DE GAUSS
  123. *
  124. CALL ZERO(A,NBPTEL,NBPTEL)
  125. DO 40 IGAU=1,NBPGAU
  126. AXIS=O1
  127. IF (NBNO.EQ.2) THEN
  128. *
  129. * CALCUL DE LA LONGUEUR ( POUR L'ELEMENT BARRE )
  130. *
  131. DLX=XZERO
  132. DLY=XZERO
  133. DO 400 INOE=1,NBPTEL
  134. DLX=DLX+SHPTOT(2,INOE,IGAU)*XE(1,INOE)
  135. DLY=DLY+SHPTOT(2,INOE,IGAU)*XE(2,INOE)
  136. 400 CONTINUE
  137. * END DO
  138. SURF=SQRT(DLX**2+DLY**2)
  139. ELSE
  140. *
  141. * CALCUL DE LA SURFACE ELEMENTAIRE AU POINT DE GAUSS CONSIDERE
  142. *
  143. SURFX=XZERO
  144. SURFY=XZERO
  145. SURFZ=XZERO
  146. DO 21 I=1,6
  147. S(I)=XZERO
  148. 21 CONTINUE
  149. * END DO
  150. DO 30 INOE=1,NBPTEL
  151. S(1)=S(1)+SHPTOT(2,INOE,IGAU)*XE(2,INOE)
  152. S(2)=S(2)+SHPTOT(3,INOE,IGAU)*XE(3,INOE)
  153. S(3)=S(3)+SHPTOT(3,INOE,IGAU)*XE(2,INOE)
  154. S(4)=S(4)+SHPTOT(2,INOE,IGAU)*XE(3,INOE)
  155. S(5)=S(5)+SHPTOT(3,INOE,IGAU)*XE(1,INOE)
  156. S(6)=S(6)+SHPTOT(2,INOE,IGAU)*XE(1,INOE)
  157. 30 CONTINUE
  158. * END DO
  159. SURFX=S(1)*S(2)-S(3)*S(4)
  160. SURFY=S(4)*S(5)-S(2)*S(6)
  161. SURFZ=S(6)*S(3)-S(5)*S(1)
  162. SURF=SQRT(SURFX**2+SURFY**2+SURFZ**2)
  163. ENDIF
  164. IF (IFOMOD.EQ.0) THEN
  165. *
  166. * CAS DES ELEMENTS AXISYMETRIQUES
  167. *
  168. DO 41 NP=1,NBPTEL
  169. SHP(1,NP)=SHPTOT(1,NP,IGAU)
  170. SHP(2,NP)=SHPTOT(2,NP,IGAU)
  171. SHP(3,NP)=SHPTOT(3,NP,IGAU)
  172. 41 CONTINUE
  173. * END DO
  174. CALL DISTRR(XE,SHP,NBPTEL,RR)
  175. AXIS=XPI*RR*O2
  176. ENDIF
  177. DO 50 INO1=1,NBPTEL
  178. DO 60 INO2=1,NBPTEL
  179. A(INO1,INO2)=A(INO1,INO2)+SHPTOT(1,INO1,IGAU)*
  180. 1 SHPTOT(1,INO2,IGAU)*POIGAU(IGAU)*AXIS*SURF
  181. 60 CONTINUE
  182. * END DO
  183. 50 CONTINUE
  184. * END DO
  185. 40 CONTINUE
  186. * END DO
  187. *
  188. * RECUPERATION DE L'EPAISSEUR
  189. *
  190. EP=0.D0
  191. IEMN=MIN(IEL,MELVA6.VELCHE(/2))
  192. DO 45 INO=1,NBNO
  193. INMN=MIN(INO,MELVA6.VELCHE(/1))
  194. EP=MELVA6.VELCHE(INMN,IEMN)+EP
  195. 45 CONTINUE
  196. EP=EP/NBNO
  197. *
  198. * INTEGRATION ANALYTIQUE SUR EPAISSEUR
  199. *
  200. C1=(O2*EP)/O15
  201. C2=EP/O15
  202. C3=-EP/O30
  203. C4=(O8*EP)/O15
  204. C5=EP/O15
  205. C6=(O2*EP)/O15
  206. *
  207. DO 80 J=1,NBPTEL
  208. DO 80 I=1,NBPTEL
  209. AA(I,J)=C1*A(I,J)
  210. 80 CONTINUE
  211. *
  212. *
  213. DO 90 J=1,NBPTEL
  214. DO 90 I=1,NBPTEL
  215. II=I+NBPTEL
  216. AA(II,J)=C2*A(I,J)
  217. AA(J,II)=AA(II,J)
  218. 90 CONTINUE
  219. *
  220. DO 100 J=1,NBPTEL
  221. DO 100 I=1,NBPTEL
  222. II=I+2*NBPTEL
  223. AA(II,J)=C3*A(I,J)
  224. AA(J,II)=AA(II,J)
  225. 100 CONTINUE
  226. *
  227. DO 110 J=1,NBPTEL
  228. JJ=J+NBPTEL
  229. DO 110 I=1,NBPTEL
  230. II=I+NBPTEL
  231. AA(II,JJ)=C4*A(I,J)
  232. 110 CONTINUE
  233. *
  234. DO 120 J=1,NBPTEL
  235. JJ=J+NBPTEL
  236. DO 120 I=1,NBPTEL
  237. II=I+2*NBPTEL
  238. AA(II,JJ)=C5*A(I,J)
  239. AA(JJ,II)=AA(II,JJ)
  240. 120 CONTINUE
  241. *
  242. DO 130 J=1,NBPTEL
  243. JJ=J+2*NBPTEL
  244. DO 130 I=1,NBPTEL
  245. II=I+2*NBPTEL
  246. AA(II,JJ)=C6*A(I,J)
  247. 130 CONTINUE
  248. *
  249. * (INTEGRAL DE HTH)*VALEURS NODALES DES SOURCES
  250. *
  251. IEMIN=MIN(NEL1,IEL)
  252. DO 70 INO3=1,NBE
  253. DO 70 INO4=1,NBE
  254. IF(INO3.LE.NBPTEL)THEN
  255. IF(INO4.LE.NBPTEL)THEN
  256. INMIN=MIN(NBPTE1,INO4)
  257. VELCHE(INO3,IEL)=VELCHE(INO3,IEL)+MELVA1.VELCHE(INMIN,IEMIN)*
  258. 1 AA(INO4,INO3)
  259. ELSEIF(INO4.GT.NBPTEL.AND.INO4.LE.(2*NBPTEL))THEN
  260. INO5=INO4-NBPTEL
  261. INMIN=MIN(NBPTE1,INO5)
  262. VELCHE(INO3,IEL)=VELCHE(INO3,IEL)+MELVA2.VELCHE(INMIN,IEMIN)*
  263. 1 AA(INO4,INO3)
  264. ELSE
  265. INO5=INO4-2*NBPTEL
  266. INMIN=MIN(NBPTE1,INO5)
  267. VELCHE(INO3,IEL)=VELCHE(INO3,IEL)+MELVA3.VELCHE(INMIN,IEMIN)*
  268. 1 AA(INO4,INO3)
  269. ENDIF
  270. ELSEIF(INO3.GT.NBPTEL.AND.INO3.LE.(2*NBPTEL))THEN
  271. INO6=INO3 - NBPTEL
  272. IF(INO4.LE.NBPTEL)THEN
  273. INMIN=MIN(NBPTE1,INO4)
  274. MELVA4.VELCHE(INO6,IEL)=MELVA4.VELCHE(INO6,IEL)+
  275. 1 MELVA1.VELCHE(INMIN,IEMIN)*AA(INO4,INO3)
  276. ELSEIF(INO4.GT.NBPTEL.AND.INO4.LE.(2*NBPTEL))THEN
  277. INO5=INO4-NBPTEL
  278. INMIN=MIN(NBPTE1,INO5)
  279. MELVA4.VELCHE(INO6,IEL)=MELVA4.VELCHE(INO6,IEL)+
  280. 1 MELVA2.VELCHE(INMIN,IEMIN)*AA(INO4,INO3)
  281. ELSE
  282. INO5=INO4-2*NBPTEL
  283. INMIN=MIN(NBPTE1,INO5)
  284. MELVA4.VELCHE(INO6,IEL)=MELVA4.VELCHE(INO6,IEL)+
  285. 1 MELVA3.VELCHE(INMIN,IEMIN)*AA(INO4,INO3)
  286. ENDIF
  287. ELSE
  288. INO6=INO3 -2*NBPTEL
  289. IF(INO4.LE.NBPTEL)THEN
  290. INMIN=MIN(NBPTE1,INO4)
  291. MELVA5.VELCHE(INO6,IEL)=MELVA5.VELCHE(INO6,IEL)+
  292. 1 MELVA1.VELCHE(INMIN,IEMIN)*AA(INO4,INO3)
  293. ELSEIF(INO4.GT.NBPTEL.AND.INO4.LE.(2*NBPTEL))THEN
  294. INO5=INO4-NBPTEL
  295. INMIN=MIN(NBPTE1,INO5)
  296. MELVA5.VELCHE(INO6,IEL)=MELVA5.VELCHE(INO6,IEL)+
  297. 1 MELVA2.VELCHE(INMIN,IEMIN)*AA(INO4,INO3)
  298. ELSE
  299. INO5=INO4-2*NBPTEL
  300. INMIN=MIN(NBPTE1,INO5)
  301. MELVA5.VELCHE(INO6,IEL)=MELVA5.VELCHE(INO6,IEL)+
  302. 1 MELVA3.VELCHE(INMIN,IEMIN)*AA(INO4,INO3)
  303. ENDIF
  304. ENDIF
  305. 70 CONTINUE
  306. * END DO
  307. 10 CONTINUE
  308. * END DO
  309. *
  310. SEGSUP,MMAT1
  311. SEGDES,MELEME,MELVA1,MINTE,MELVA2 ,MELVA6
  312. SEGDES,MELVA3,MELVAL,MELVA4,MELVA5
  313. *
  314. END
  315.  
  316.  
  317.  
  318.  
  319.  
  320.  
  321.  

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