Télécharger chaco2.eso

Retour à la liste

Numérotation des lignes :

  1. C CHACO2 SOURCE PV 09/03/12 21:16:41 6325
  2. SUBROUTINE CHACO2(IPSONO,IPSON1,IPSON2,IEP,IPGEOM,IPINTE,
  3. . IPINT1,IPCHEQ,IPCHE1,IPCHE2)
  4. IMPLICIT INTEGER(I-N)
  5. IMPLICIT REAL*8(A-H,O-Z)
  6. ************************************************************************
  7. *
  8. * C H A C O 2
  9. * -----------
  10. *
  11. * FONCTION:
  12. * ---------
  13. * CAS DES SOURCES VOLUMIQUES
  14. * COQ6 COQ8 ET COQ4
  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. * IPINT1 (E) POINTEUR SUR UN SEGMENT MINTE CONTENANT LES
  37. * LES VALEURS DE FONCTION DE FORME AUX NOEUD
  38. * +IDIM (E) VOIR CCOPTIO
  39. * +XPI (E) VOIR CCREEL
  40. * IPCHEQ (S) POINTEURS SUR DES SEGMENTS MELVAL CONTENANT LES
  41. * IPCHE1 CHALEURS NODALES EQUIVALENTES
  42. * IPCHE2
  43. *
  44. * VARIABLES:
  45. * ----------
  46. *
  47. * XE(3,NBPTEL) = COORDONNEES DES ELEMENTS DANS LE REPERE GLOBAL
  48. * DJAC = DETERMINANT DU JACOBIEN EN UN POINT DE GAUSS
  49. * A ET A1 = TABLEAUX DE TRAVAIL
  50. *
  51. *
  52. REAL*8 XJ(3,3)
  53. SEGMENT,MMAT1
  54. REAL*8 XE(3,NBPTEL),A(NBE,NBE),FORME(NBNO),A1(NBNO,NBNO)
  55. REAL*8 EXC(NBNO),EPAI(NBNO),TXR(3,3,NBNO)
  56. ENDSEGMENT
  57. *
  58. * CONSTANTES:
  59. * -----------
  60. *
  61. PARAMETER ( O1=1.D0,O2=2.D0)
  62. DATA X577/.577350269189626D0/
  63. *
  64. * AUTEUR, DATE DE CREATION:
  65. * -------------------------
  66. *
  67. * P. DOWLATYARI AOUT 90
  68. *
  69. * LANGAGE:
  70. * --------
  71. *
  72. * ESOPE + FORTRAN77
  73. *
  74. ************************************************************************
  75. *
  76. * ON RECUPERE LES VALEURS DES SOURCES
  77. *
  78. MELVA1=IPSONO
  79. SEGACT,MELVA1
  80. NBPTE1=MELVA1.VELCHE(/1)
  81. NEL1=MELVA1.VELCHE(/2)
  82. MELVA2=IPSON1
  83. SEGACT,MELVA2
  84. MELVA3=IPSON2
  85. SEGACT,MELVA3
  86. *
  87. * ON RECUPERE LES CARACTERISTIQUES D'INTEGRATION
  88. *
  89. MINTE=IPINTE
  90. SEGACT,MINTE
  91. NBPGAU=POIGAU(/1)
  92. NBNO=SHPTOT(/2)
  93. MINTE1 = IPINT1
  94. SEGACT,MINTE1
  95. *
  96. * ON RECUPERE UN DES MAILLAGES ELEMENTAIRES DE L'ENVELOPPE
  97. *
  98. MELEME=IPGEOM
  99. SEGACT,MELEME
  100. NBPTEL=NUM(/1)
  101. NEL=NUM(/2)
  102. *
  103. * INITIALISATION DES MELVALS QUI CONTIENDRA LES CHALEURS EQUIVALENTE
  104. *
  105. N1PTEL=NBPTEL
  106. N1EL=NEL
  107. N2PTEL=0
  108. N2EL=0
  109. NBE=3*NBPTEL
  110. SEGINI,MELVAL
  111. IPCHEQ=MELVAL
  112. SEGINI,MELVA4
  113. IPCHE1=MELVA4
  114. SEGINI,MELVA5
  115. IPCHE2=MELVA5
  116. SEGINI,MMAT1
  117. CALL ZERO(EXC,NBNO,1)
  118. MELVA6=IEP
  119. SEGACT,MELVA6
  120. *
  121. * BOUCLE SUR LES ELEMENTS
  122. *
  123. DO 10 IEL=1,NEL
  124. *
  125. * ON CHERCHE LES COORDONNEES DES NOEUDS DANS LE REPERE GLOBAL
  126. *
  127. CALL DOXE(XCOOR,IDIM,NBPTEL,NUM,IEL,XE)
  128. *
  129. * CALCUL DES AXES LOCAUX AUX NOEUDS DE L'ELEMENT
  130. *
  131. CALL CQ8LOC(XE,NBPTEL,MINTE1.SHPTOT,TXR,IRR)
  132. *
  133. IF(IRR.EQ.0)THEN
  134. *
  135. * EHEC DANS LE CALCUL DES AXES LOCAUX
  136. *
  137. CALL ERREUR (515)
  138. SEGSUP,MMAT1,MELVAL,MELVA4,MELVA5
  139. SEGDES,MELEME,MELVA1,MINTE,MELVA2,MELVA6
  140. SEGDES,MINTE1,MELVA3
  141. RETURN
  142. ENDIF
  143. *
  144. *
  145. * ON CREE LE TABLEAU DES EPAISSEURS
  146. *
  147. IBMN=MIN(IEL,MELVA6.VELCHE(/2))
  148. DO 5 INO = 1,NBNO
  149. INMN=MIN(INO,MELVA6.VELCHE(/1))
  150. EPAI(INO) =MELVA6.VELCHE(INMN,IBMN)
  151. 5 CONTINUE
  152. *
  153. CALL ZERO (A,NBE,NBE)
  154. *
  155. * BOUCLE SUR LES POINTS DE GAUSS
  156. *
  157. *
  158. DO 40 IGAU = 1, NBPGAU
  159. *
  160. CALL ZERO (A1,NBNO,NBNO)
  161. *
  162. E3=DZEGAU(IGAU)
  163. *
  164. *
  165. * CALCUL DU JACABIEN
  166. *
  167. CALL CQ8JCE (IGAU,NBPTEL,E3,XE,EPAI,EXC,TXR,SHPTOT,
  168. . XJ,DJAC,IRR)
  169. *
  170. IF(IRR.LT.0)THEN
  171. *
  172. * JACOBIEN NUL DANS L'ELEMENT IEL
  173. *
  174. INTERR(1)=IEL
  175. CALL ERREUR (405)
  176. SEGSUP,MMAT1,MELVAL,MELVA4,MELVA5
  177. SEGDES,MELEME,MELVA1,MINTE,MELVA2,MELVA6
  178. SEGDES,MINTE1,MELVA3
  179. RETURN
  180. ENDIF
  181. *
  182. * CALCUL DE FORME (TRANSPOSEE)*FORME CONCERNANT LA SURFACE
  183. * MOYENNE
  184. DO 50 INO=1,NBNO
  185. FORME(INO)=SHPTOT(1,INO,IGAU)
  186. 50 CONTINUE
  187. *
  188. DJAC = DJAC*POIGAU(IGAU)
  189. *
  190. CALL NTNST (FORME,DJAC,NBNO,1,A1)
  191. *
  192. * ON AJOUTE L'EFFET DE L'EPAISSEUR
  193. *
  194. C1=(E3/O2)*(E3-O1)
  195. C2=O1-E3*E3
  196. C3=(E3/O2)*(E3+O1)
  197. *
  198. DO 60 I=1,NBE
  199. DO 60 J=1,NBE
  200. IF(I.LE.NBNO)THEN
  201. II=I
  202. IF(J.LE.NBNO)THEN
  203. JJ=J
  204. FACT=C1*C1
  205. ELSEIF(J.GT.NBNO.AND.J.LE.(2*NBNO))THEN
  206. JJ=J-NBNO
  207. FACT=C1*C2
  208. ELSE
  209. JJ=J-2*NBNO
  210. FACT=C1*C3
  211. ENDIF
  212. ELSEIF(I.GT.NBNO.AND.I.LE.(2*NBNO))THEN
  213. II=I-NBNO
  214. IF(J.LE.NBNO)THEN
  215. JJ=J
  216. FACT=C2*C1
  217. ELSEIF(J.GT.NBNO.AND.J.LE.(2*NBNO))THEN
  218. JJ=J-NBNO
  219. FACT=C2*C2
  220. ELSE
  221. JJ=J-2*NBNO
  222. FACT=C2*C3
  223. ENDIF
  224. ELSE
  225. II=I-2*NBNO
  226. IF(J.LE.NBNO)THEN
  227. JJ=J
  228. FACT=C3*C1
  229. ELSEIF(J.GT.NBNO.AND.J.LE.(2*NBNO))THEN
  230. JJ=J-NBNO
  231. FACT=C3*C2
  232. ELSE
  233. JJ=J-2*NBNO
  234. FACT=C3*C3
  235. ENDIF
  236. ENDIF
  237. A(I,J)=A(I,J)+FACT*A1(II,JJ)
  238. 60 CONTINUE
  239. * FIN DE BOUCLE SUR LES POINTS D'INTEGRATION
  240. 40 CONTINUE
  241. *
  242. * (INTEGRAL DE HTH)*VALEURS NODALES DES SOURCES
  243. *
  244. IEMIN=MIN(NEL1,IEL)
  245. DO 70 INO3=1,NBE
  246. DO 70 INO4=1,NBE
  247. IF(INO3.LE.NBPTEL)THEN
  248. IF(INO4.LE.NBPTEL)THEN
  249. INMIN=MIN(NBPTE1,INO4)
  250. VELCHE(INO3,IEL)=VELCHE(INO3,IEL)+MELVA1.VELCHE(INMIN,IEMIN)*
  251. 1 A(INO4,INO3)
  252. ELSEIF(INO4.GT.NBPTEL.AND.INO4.LE.(2*NBPTEL))THEN
  253. INO5=INO4-NBPTEL
  254. INMIN=MIN(NBPTE1,INO5)
  255. VELCHE(INO3,IEL)=VELCHE(INO3,IEL)+MELVA2.VELCHE(INMIN,IEMIN)*
  256. 1 A(INO4,INO3)
  257. ELSE
  258. INO5=INO4-2*NBPTEL
  259. INMIN=MIN(NBPTE1,INO5)
  260. VELCHE(INO3,IEL)=VELCHE(INO3,IEL)+MELVA3.VELCHE(INMIN,IEMIN)*
  261. 1 A(INO4,INO3)
  262. ENDIF
  263. ELSEIF(INO3.GT.NBPTEL.AND.INO3.LE.(2*NBPTEL))THEN
  264. INO6=INO3 - NBPTEL
  265. IF(INO4.LE.NBPTEL)THEN
  266. INMIN=MIN(NBPTE1,INO4)
  267. MELVA4.VELCHE(INO6,IEL)=MELVA4.VELCHE(INO6,IEL)+
  268. 1 MELVA1.VELCHE(INMIN,IEMIN)*A(INO4,INO3)
  269. ELSEIF(INO4.GT.NBPTEL.AND.INO4.LE.(2*NBPTEL))THEN
  270. INO5=INO4-NBPTEL
  271. INMIN=MIN(NBPTE1,INO5)
  272. MELVA4.VELCHE(INO6,IEL)=MELVA4.VELCHE(INO6,IEL)+
  273. 1 MELVA2.VELCHE(INMIN,IEMIN)*A(INO4,INO3)
  274. ELSE
  275. INO5=INO4-2*NBPTEL
  276. INMIN=MIN(NBPTE1,INO5)
  277. MELVA4.VELCHE(INO6,IEL)=MELVA4.VELCHE(INO6,IEL)+
  278. 1 MELVA3.VELCHE(INMIN,IEMIN)*A(INO4,INO3)
  279. ENDIF
  280. ELSE
  281. INO6=INO3 -2*NBPTEL
  282. IF(INO4.LE.NBPTEL)THEN
  283. INMIN=MIN(NBPTE1,INO4)
  284. MELVA5.VELCHE(INO6,IEL)=MELVA5.VELCHE(INO6,IEL)+
  285. 1 MELVA1.VELCHE(INMIN,IEMIN)*A(INO4,INO3)
  286. ELSEIF(INO4.GT.NBPTEL.AND.INO4.LE.(2*NBPTEL))THEN
  287. INO5=INO4-NBPTEL
  288. INMIN=MIN(NBPTE1,INO5)
  289. MELVA5.VELCHE(INO6,IEL)=MELVA5.VELCHE(INO6,IEL)+
  290. 1 MELVA2.VELCHE(INMIN,IEMIN)*A(INO4,INO3)
  291. ELSE
  292. INO5=INO4-2*NBPTEL
  293. INMIN=MIN(NBPTE1,INO5)
  294. MELVA5.VELCHE(INO6,IEL)=MELVA5.VELCHE(INO6,IEL)+
  295. 1 MELVA3.VELCHE(INMIN,IEMIN)*A(INO4,INO3)
  296. ENDIF
  297. ENDIF
  298. 70 CONTINUE
  299. * END DO
  300. 10 CONTINUE
  301. * END DO
  302. *
  303. SEGSUP,MMAT1
  304. SEGDES,MELEME,MELVA1,MINTE,MELVA2,melva6
  305. SEGDES,MELVA3,MELVAL,MELVA4,MELVA5,MINTE1
  306. *
  307. END
  308.  
  309.  
  310.  
  311.  
  312.  
  313.  
  314.  

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