Télécharger chaco2.eso

Retour à la liste

Numérotation des lignes :

  1. C CHACO2 SOURCE PASCAL 19/11/19 21:15:01 10384
  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. RETURN
  140. ENDIF
  141. *
  142. *
  143. * ON CREE LE TABLEAU DES EPAISSEURS
  144. *
  145. IBMN=MIN(IEL,MELVA6.VELCHE(/2))
  146. DO 5 INO = 1,NBNO
  147. INMN=MIN(INO,MELVA6.VELCHE(/1))
  148. EPAI(INO) =MELVA6.VELCHE(INMN,IBMN)
  149. 5 CONTINUE
  150. *
  151. CALL ZERO (A,NBE,NBE)
  152. *
  153. * BOUCLE SUR LES POINTS DE GAUSS
  154. *
  155. *
  156. DO 40 IGAU = 1, NBPGAU
  157. *
  158. CALL ZERO (A1,NBNO,NBNO)
  159. *
  160. E3=DZEGAU(IGAU)
  161. *
  162. *
  163. * CALCUL DU JACABIEN
  164. *
  165. CALL CQ8JCE (IGAU,NBPTEL,E3,XE,EPAI,EXC,TXR,SHPTOT,
  166. . XJ,DJAC,IRR)
  167. *
  168. IF(IRR.LT.0)THEN
  169. *
  170. * JACOBIEN NUL DANS L'ELEMENT IEL
  171. *
  172. INTERR(1)=IEL
  173. CALL ERREUR (405)
  174. SEGSUP,MMAT1,MELVAL,MELVA4,MELVA5
  175. RETURN
  176. ENDIF
  177. *
  178. * CALCUL DE FORME (TRANSPOSEE)*FORME CONCERNANT LA SURFACE
  179. * MOYENNE
  180. DO 50 INO=1,NBNO
  181. FORME(INO)=SHPTOT(1,INO,IGAU)
  182. 50 CONTINUE
  183. *
  184. DJAC = DJAC*POIGAU(IGAU)
  185. *
  186. CALL NTNST (FORME,DJAC,NBNO,1,A1)
  187. *
  188. * ON AJOUTE L'EFFET DE L'EPAISSEUR
  189. *
  190. C1=(E3/O2)*(E3-O1)
  191. C2=O1-E3*E3
  192. C3=(E3/O2)*(E3+O1)
  193. *
  194. DO 60 I=1,NBE
  195. DO 61 J=1,NBE
  196. IF(I.LE.NBNO)THEN
  197. II=I
  198. IF(J.LE.NBNO)THEN
  199. JJ=J
  200. FACT=C1*C1
  201. ELSEIF(J.GT.NBNO.AND.J.LE.(2*NBNO))THEN
  202. JJ=J-NBNO
  203. FACT=C1*C2
  204. ELSE
  205. JJ=J-2*NBNO
  206. FACT=C1*C3
  207. ENDIF
  208. ELSEIF(I.GT.NBNO.AND.I.LE.(2*NBNO))THEN
  209. II=I-NBNO
  210. IF(J.LE.NBNO)THEN
  211. JJ=J
  212. FACT=C2*C1
  213. ELSEIF(J.GT.NBNO.AND.J.LE.(2*NBNO))THEN
  214. JJ=J-NBNO
  215. FACT=C2*C2
  216. ELSE
  217. JJ=J-2*NBNO
  218. FACT=C2*C3
  219. ENDIF
  220. ELSE
  221. II=I-2*NBNO
  222. IF(J.LE.NBNO)THEN
  223. JJ=J
  224. FACT=C3*C1
  225. ELSEIF(J.GT.NBNO.AND.J.LE.(2*NBNO))THEN
  226. JJ=J-NBNO
  227. FACT=C3*C2
  228. ELSE
  229. JJ=J-2*NBNO
  230. FACT=C3*C3
  231. ENDIF
  232. ENDIF
  233. A(I,J)=A(I,J)+FACT*A1(II,JJ)
  234. 61 CONTINUE
  235. 60 CONTINUE
  236. * FIN DE BOUCLE SUR LES POINTS D'INTEGRATION
  237. 40 CONTINUE
  238. *
  239. * (INTEGRAL DE HTH)*VALEURS NODALES DES SOURCES
  240. *
  241. IEMIN=MIN(NEL1,IEL)
  242. DO 70 INO3=1,NBE
  243. DO 71 INO4=1,NBE
  244. IF(INO3.LE.NBPTEL)THEN
  245. IF(INO4.LE.NBPTEL)THEN
  246. INMIN=MIN(NBPTE1,INO4)
  247. VELCHE(INO3,IEL)=VELCHE(INO3,IEL)+MELVA1.VELCHE(INMIN,IEMIN)*
  248. 1 A(INO4,INO3)
  249. ELSEIF(INO4.GT.NBPTEL.AND.INO4.LE.(2*NBPTEL))THEN
  250. INO5=INO4-NBPTEL
  251. INMIN=MIN(NBPTE1,INO5)
  252. VELCHE(INO3,IEL)=VELCHE(INO3,IEL)+MELVA2.VELCHE(INMIN,IEMIN)*
  253. 1 A(INO4,INO3)
  254. ELSE
  255. INO5=INO4-2*NBPTEL
  256. INMIN=MIN(NBPTE1,INO5)
  257. VELCHE(INO3,IEL)=VELCHE(INO3,IEL)+MELVA3.VELCHE(INMIN,IEMIN)*
  258. 1 A(INO4,INO3)
  259. ENDIF
  260. ELSEIF(INO3.GT.NBPTEL.AND.INO3.LE.(2*NBPTEL))THEN
  261. INO6=INO3 - NBPTEL
  262. IF(INO4.LE.NBPTEL)THEN
  263. INMIN=MIN(NBPTE1,INO4)
  264. MELVA4.VELCHE(INO6,IEL)=MELVA4.VELCHE(INO6,IEL)+
  265. 1 MELVA1.VELCHE(INMIN,IEMIN)*A(INO4,INO3)
  266. ELSEIF(INO4.GT.NBPTEL.AND.INO4.LE.(2*NBPTEL))THEN
  267. INO5=INO4-NBPTEL
  268. INMIN=MIN(NBPTE1,INO5)
  269. MELVA4.VELCHE(INO6,IEL)=MELVA4.VELCHE(INO6,IEL)+
  270. 1 MELVA2.VELCHE(INMIN,IEMIN)*A(INO4,INO3)
  271. ELSE
  272. INO5=INO4-2*NBPTEL
  273. INMIN=MIN(NBPTE1,INO5)
  274. MELVA4.VELCHE(INO6,IEL)=MELVA4.VELCHE(INO6,IEL)+
  275. 1 MELVA3.VELCHE(INMIN,IEMIN)*A(INO4,INO3)
  276. ENDIF
  277. ELSE
  278. INO6=INO3 -2*NBPTEL
  279. IF(INO4.LE.NBPTEL)THEN
  280. INMIN=MIN(NBPTE1,INO4)
  281. MELVA5.VELCHE(INO6,IEL)=MELVA5.VELCHE(INO6,IEL)+
  282. 1 MELVA1.VELCHE(INMIN,IEMIN)*A(INO4,INO3)
  283. ELSEIF(INO4.GT.NBPTEL.AND.INO4.LE.(2*NBPTEL))THEN
  284. INO5=INO4-NBPTEL
  285. INMIN=MIN(NBPTE1,INO5)
  286. MELVA5.VELCHE(INO6,IEL)=MELVA5.VELCHE(INO6,IEL)+
  287. 1 MELVA2.VELCHE(INMIN,IEMIN)*A(INO4,INO3)
  288. ELSE
  289. INO5=INO4-2*NBPTEL
  290. INMIN=MIN(NBPTE1,INO5)
  291. MELVA5.VELCHE(INO6,IEL)=MELVA5.VELCHE(INO6,IEL)+
  292. 1 MELVA3.VELCHE(INMIN,IEMIN)*A(INO4,INO3)
  293. ENDIF
  294. ENDIF
  295. 71 CONTINUE
  296. 70 CONTINUE
  297. * END DO
  298. 10 CONTINUE
  299. * END DO
  300. *
  301. SEGSUP,MMAT1
  302. END
  303.  
  304.  
  305.  
  306.  

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