Télécharger ffmcha.eso

Retour à la liste

Numérotation des lignes :

  1. C FFMCHA SOURCE PASCAL 17/08/02 21:15:03 9500
  2. SUBROUTINE FFMCHA(MYMOD,INFOEL,MATR,ICHFAC,LTITR)
  3. C
  4. C
  5. C_________________________________________________________________
  6. C NOM : InterFace Matrice->CHAmp par éléments
  7. C_________________________________________________________________
  8. C OBJET :
  9. C INTERFACE INTERVENANT EN THERMIQUE (RAYONNEMENT)
  10. C_________________________________________________________________
  11. C FONCTION :
  12. C PERMET DE PASSER D'UN MODELE (+ segment INFOEL)
  13. C ET DE LA MATRICE CONTENANT LES FACTEURS DE FORME
  14. C AU CHAMELEME CORRESPONDANT
  15. C_________________________________________________________________
  16. C OPERANDES :
  17. C
  18. C en entrée :
  19. C MYMOD (MMODEL) MODELE SUR LEQUEL REPOSE MATR
  20. C INFOEL INFORMATIONS SUR LE TYPE DES ELEMENTS
  21. C !!!!! si on ne doit pas tenir compte du cas des
  22. C éléments COQ , ce pointeur doit être mis à 0 .
  23. C MATR (IFACFO) MATRICE CONTENANT LES FACTEURS DE FORME
  24. C OU LA MATRICE DE RAYONNEMENT
  25. C !!!!! chaque élément COQ donne lieu à 2 fois plus
  26. C de facteurs de forme qu'un élément normal .
  27. C de facteurs de forme qu'un élément normal .
  28. C LTITR entier definissant le titre du MCHAML
  29. C 'FACTEURS DE FORME '
  30. C ou 'MATRICE DE RAYONNEMENT'
  31. C en sortie :
  32. C ICHFAC (MCHELM) CHAMELEM CONTENANT LES FACTEURS DE FORME
  33. C
  34. C_________________________________________________________________
  35. C
  36. C
  37. IMPLICIT INTEGER(I-N)
  38. IMPLICIT REAL*8 (A-H,O-Z)
  39. C
  40. -INC CCOPTIO
  41. -INC SMCHAML
  42. -INC SMELEME
  43. -INC SMMODEL
  44. C
  45. C ___________________________________________________________
  46. C FACTEURS DE FORME stockage sous forme matricielle
  47. C NNBEL1 = NOMBRE DE LIGNES + 1
  48. C NBEL2 = NOMBRE DE COLONNES
  49. C LFACT(NNBEL1) POINTE SUR LE TABLEAU DES SURFACES
  50. C
  51. SEGMENT IFACFO
  52. INTEGER LFACT(NNBEL1)
  53. ENDSEGMENT
  54. SEGMENT LFAC
  55. REAL*8 FACT(NBEL2)
  56. ENDSEGMENT
  57. C
  58. POINTEUR PSUR.LFAC, PLIG.LFAC, PLIGI.LFAC, PLIGS.LFAC
  59. POINTEUR MATR.IFACFO
  60. C ___________________________________________________________
  61. C Stockage d'informations concernant le type des éléments des maillages
  62. SEGMENT ,INFOEL
  63. LOGICAL KCOQ(N1),KQUAD(N1)
  64. ENDSEGMENT
  65. C ___________________________________________________________
  66. C
  67. POINTEUR MYMOD.MMODEL
  68. POINTEUR ISSM.MELEME
  69. POINTEUR ICHFAC.MCHELM , ICPEL.MCHELM
  70. POINTEUR MELVA7.MELVAL
  71. LOGICAL ICOQ
  72. LOGICAL LTEST1, LTEST2, LTEST3
  73. C_________________________________________________________________
  74. C
  75. C STRUCTURE DU CHAMELEM
  76. C
  77. C MELVA3 : segment MELVAL , surface
  78. C -----1 : segment -----L partie haute du CHAMELEM
  79. C -----4 : segment -----L partie haute du CHAMELEM
  80. C
  81. C CAS DES ELEMENTS COQ pour la partie haute
  82. C -- Partie 'haute' du CHAMELEM : boucle A --
  83. C MELVA1 : segment MELVAL , côté SUPE
  84. C MELVA2 : segment MELVAL , côté INFE
  85. C -- Partie 'basse' du CHAMELEM : boucle B --
  86. C MCHEL4 : segment MCHELM , côté SUPE
  87. C MCHEL5 : segment MCHELM , côté INFE
  88. C MCHAM4 : segment MCHAML , côté SUPE
  89. C MCHAM5 : segment MCHAML , côté INFE
  90. C CAS DES ÉLÉMENTS COQ pour la partie basse
  91. C MELVA4 : segment MELVAL , côté SUPE , relié à MCHAM4
  92. C MELVA5 : segment MELVAL , côté INFE , relié à MCHAM4
  93. C MELVA6 : segment MELVAL , côté SUPE , relié à MCHAM5
  94. C MELVA7 : segment MELVAL , côté INFE , relié à MCHAM5
  95. C sinon
  96. C MELVA4 : segment MELVAL , relié à MCHAM4
  97. C MELVA6 : segment MELVAL , relié à MCHAM5
  98. C -----
  99. C_________________________________________________________________
  100. C
  101. C NOTATIONS :
  102. C
  103. C eA : élément de la boucle A (partie haute)
  104. C eB : élément de la boucle B (partie basse )
  105. C eA+,eB+ : côté SUPE de l'élément
  106. C eA-,eB- : côté INFE de l'élément
  107. C_________________________________________________________________
  108. C
  109. IF(IIMPI.GE.2) THEN
  110. WRITE (6,*) 'On est dans ffmcha'
  111. ENDIF
  112. C
  113. IF (INFOEL.EQ.0) THEN
  114. ICOQ = .FALSE.
  115. ELSE
  116. ICOQ = .TRUE.
  117. ENDIF
  118. C
  119. SEGACT MYMOD
  120. C
  121. C On construit l'information maillage du CHAMELEM
  122. L1 = 22
  123. N3 = 6
  124. N1 = MYMOD.KMODEL(/1)
  125. IF (N1.EQ.0) THEN
  126. CALL ERREUR(21)
  127. RETURN
  128. ENDIF
  129. C
  130. SEGINI ,ICPEL
  131.  
  132. C IF (LTITR.EQ.1) THEN
  133. C ICPEL.TITCHE = 'FACTEURS DE FORME '
  134. C ELSE
  135. ICPEL.TITCHE = 'MATRICE DE RAYONNEMENT'
  136. C ENDIF
  137.  
  138. IF (IFOMOD.NE.0) THEN
  139. IF (IDIM.EQ.3) THEN
  140. ICPEL.IFOCHE = 2
  141. ELSE
  142. ICPEL.IFOCHE = -1
  143. ENDIF
  144. ELSE
  145. ICPEL.IFOCHE = 0
  146. ENDIF
  147. DO I=1,N1
  148. IMODE1 = MYMOD.KMODEL(I)
  149. SEGACT IMODE1
  150. ICPEL.IMACHE(I) = IMODE1.IMAMOD
  151. ICPEL.CONCHE(I) = IMODE1.CONMOD
  152. SEGDES IMODE1
  153. ENDDO
  154. SEGDES ICPEL
  155. SEGDES MYMOD
  156. C
  157. C------------------------------------------------------------
  158. C
  159. C
  160. C On récupère le nombre total d'éléments .
  161. C On vérifiera que le maillage et la matrice
  162. C portent sur le même nombre d'éléments .
  163. SEGACT MATR
  164. NNBEL1 = MATR.LFACT(/1)
  165. NBEL2 = NNBEL1 - 1
  166. PSUR = MATR.LFACT(NNBEL1)
  167. SEGACT PSUR
  168. C
  169. SEGINI ,ICHFAC=ICPEL
  170. NUMA = 0
  171. C
  172. IF (ICOQ) SEGACT INFOEL
  173. C Pour les tests avenirs , on sait que FORTRAN évalue la partie
  174. C gauche d'une expression booléenne avant la partie droite ,
  175. C et donc :
  176. C dans le cas d'un .AND. si la partie gauche est fausse
  177. C la partie droite ne sera pas évaluée .
  178. C ... La remarque ci-dessus s'est avérée fausse dans le cas de
  179. C certains compilateurs (DEC Alpha OSF ), d'où l'introduction des
  180. C variables logiques LTEST1, LTEST2 et LTEST3 qui permettent de se
  181. C passer de cette hypothèse (MB & LB 13/03/96) ...
  182.  
  183. C
  184. C -----------------------------------------------------
  185. DO NSMA=1,N1
  186. C On boucle sur les sous-champs
  187. C
  188. ISSM = ICHFAC.IMACHE(NSMA)
  189. SEGACT ISSM
  190. C NBPTA = ISSM.NUM(/1)
  191. NBELA = ISSM.NUM(/2)
  192. SEGDES ISSM
  193. N1EL = NBELA
  194. N1PTEL = 1
  195. N2EL = 0
  196. N2PTEL = 0
  197. SEGINI MELVA3
  198. N1EL = 0
  199. N1PTEL = 0
  200. N2EL = NBELA
  201. N2PTEL = 1
  202. C
  203. LTEST1=.FALSE.
  204. IF(ICOQ) THEN
  205. IF(KCOQ(NSMA)) LTEST1=.TRUE.
  206. ENDIF
  207. IF (LTEST1) THEN
  208. C
  209. C Cas des COQ pour la partie haute
  210. N2 = 3
  211. SEGINI ,MCHAM1
  212. ICHFAC.ICHAML(NSMA) = MCHAM1
  213. SEGINI ,MELVA1,MELVA2
  214. MCHAM1.NOMCHE(1) = 'SUPE'
  215. MCHAM1.TYPCHE(1) = 'POINTEURMCHAML'
  216. MCHAM1.IELVAL(1) = MELVA1
  217. MCHAM1.NOMCHE(2) = 'INFE'
  218. MCHAM1.TYPCHE(2) = 'POINTEURMCHAML'
  219. MCHAM1.IELVAL(2) = MELVA2
  220. MCHAM1.NOMCHE(3) = 'SURF'
  221. MCHAM1.TYPCHE(3) = 'REAL*8'
  222. MCHAM1.IELVAL(3) = MELVA3
  223. SEGDES MCHAM1
  224.  
  225. C ----------------------------------------------
  226. DO NELMA=1,NBELA
  227. C On boucle sur les éléments du sous-champs NSMA
  228. C
  229. C
  230. NUMA = NUMA + 1
  231. MELVA3.VELCHE(1,NELMA) = PSUR.FACT(NUMA)
  232. PLIGI = MATR.LFACT(NUMA)
  233. NUMA = NUMA + 1
  234. MELVA3.VELCHE(1,NELMA) = PSUR.FACT(NUMA)
  235. PLIGS = MATR.LFACT(NUMA)
  236. SEGACT ,PLIGI,PLIGS
  237. SEGINI ,MCHEL4=ICPEL
  238. MELVA1.IELCHE(1,NELMA) = MCHEL4
  239. SEGINI ,MCHEL5=ICPEL
  240. MELVA2.IELCHE(1,NELMA) = MCHEL5
  241. NUMB = 0
  242. C
  243. C --------------------------------------------
  244. DO NSMB=1,N1
  245. C On boucle sur les sous-champs
  246. C
  247. ISSM = ICHFAC.IMACHE(NSMB)
  248. SEGACT ISSM
  249. C NBPTB = ISSM.NUM(/1)
  250. NBELB = ISSM.NUM(/2)
  251. N1EL = NBELB
  252. N1PTEL = 1
  253. N2EL = 0
  254. N2PTEL = 0
  255. SEGDES ISSM
  256. C
  257. LTEST2 = .FALSE.
  258. IF(ICOQ) THEN
  259. IF(KCOQ(NSMB)) LTEST2 = .TRUE.
  260. ENDIF
  261. IF (LTEST2) THEN
  262. C
  263. C Cas des COQ pour la partie basse
  264. N2 = 2
  265. SEGINI ,MCHAM4,MCHAM5
  266. MCHEL4.ICHAML(NSMB) = MCHAM4
  267. MCHEL5.ICHAML(NSMB) = MCHAM5
  268. C
  269. SEGINI ,MELVA4,MELVA5
  270. MCHAM4.NOMCHE(1) = 'SUPE'
  271. MCHAM4.TYPCHE(1) = 'REAL*8'
  272. MCHAM4.IELVAL(1) = MELVA4
  273. MCHAM4.NOMCHE(2) = 'INFE'
  274. MCHAM4.TYPCHE(2) = 'REAL*8'
  275. MCHAM4.IELVAL(2) = MELVA5
  276. SEGDES ,MCHAM4
  277. SEGINI ,MELVA6,MELVA7
  278. MCHAM5.NOMCHE(1) = 'SUPE'
  279. MCHAM5.TYPCHE(1) = 'REAL*8'
  280. MCHAM5.IELVAL(1) = MELVA6
  281. MCHAM5.NOMCHE(2) = 'INFE'
  282. MCHAM5.TYPCHE(2) = 'REAL*8'
  283. MCHAM5.IELVAL(2) = MELVA7
  284. SEGDES ,MCHAM5
  285. C
  286. C ---------------------------------------
  287. DO NELMB=1,NBELB
  288. C On boucle sur les éléments du sous-champs NSMB
  289. C
  290. C On copie la donnée facteur de forme
  291. NUMB = NUMB + 1
  292. C FF(eA+,eB+)
  293. MELVA4.VELCHE(1,NELMB) = PLIGI.FACT(NUMB)
  294. C FF(eA-,eB+)
  295. MELVA6.VELCHE(1,NELMB) = PLIGS.FACT(NUMB)
  296. NUMB = NUMB + 1
  297. C FF(eA+,eB-)
  298. MELVA5.VELCHE(1,NELMB) = PLIGI.FACT(NUMB)
  299. C FF(eA-,eB-)
  300. MELVA7.VELCHE(1,NELMB) = PLIGS.FACT(NUMB)
  301. C
  302. ENDDO
  303. C fin NELMB ----------------------------
  304. C
  305. SEGDES ,MELVA4,MELVA5,MELVA6,MELVA7
  306. C
  307. ELSE
  308. C
  309. C Partie basse : pas d'éléments COQ
  310. N2 = 1
  311. SEGINI MCHAM4,MCHAM5
  312. MCHEL4.ICHAML(NSMB) = MCHAM4
  313. MCHEL5.ICHAML(NSMB) = MCHAM5
  314. SEGINI ,MELVA4,MELVA5
  315. MCHAM4.NOMCHE(1) = 'MIDL'
  316. MCHAM4.TYPCHE(1) = 'REAL*8'
  317. MCHAM4.IELVAL(1) = MELVA4
  318. MCHAM5.NOMCHE(1) = 'MIDL'
  319. MCHAM5.TYPCHE(1) = 'REAL*8'
  320. MCHAM5.IELVAL(1) = MELVA5
  321. SEGDES MCHAM4,MCHAM5
  322. C
  323. C ---------------------------------------
  324. DO NELMB=1,NBELB
  325. C On boucle sur les éléments du sous-champs NSMB
  326. C
  327. C On copie la donnée facteur de forme
  328. NUMB = NUMB + 1
  329. C FF(eA+,eB)
  330. MELVA4.VELCHE(1,NELMB) = PLIGI.FACT(NUMB)
  331. C FF(eA-,eB)
  332. MELVA5.VELCHE(1,NELMB) = PLIGS.FACT(NUMB)
  333. C
  334. ENDDO
  335. C fin NELMB -----------------------------
  336. C
  337. SEGDES ,MELVA4,MELVA5
  338. C
  339. ENDIF
  340. C
  341. C
  342. ENDDO
  343. C fin NSMB -------------------------------------
  344. C
  345. SEGDES ,MCHEL4,MCHEL5
  346. SEGDES ,PLIGI,PLIGS
  347. C
  348. ENDDO
  349. C fin NELMA ---------------------------------------
  350. C
  351. SEGDES ,MELVA1,MELVA2,MELVA3
  352. C
  353. ELSE
  354. C
  355. C Partie haute : pas d'éléments COQ
  356. SEGINI ,MELVA1
  357. N2 = 2
  358. SEGINI MCHAM1
  359. ICHFAC.ICHAML(NSMA) = MCHAM1
  360. MCHAM1.NOMCHE(1) = 'MIDL'
  361. MCHAM1.TYPCHE(1) = 'POINTEURMCHAML'
  362. MCHAM1.IELVAL(1) = MELVA1
  363. MCHAM1.NOMCHE(2) = 'SURF'
  364. MCHAM1.TYPCHE(2) = 'REAL*8'
  365. MCHAM1.IELVAL(2) = MELVA3
  366. SEGDES ,MCHAM1
  367. C
  368. C ----------------------------------------------
  369. DO NELMA=1,NBELA
  370. C On boucle sur les éléments du sous-champs NSMA
  371. C
  372. C
  373. NUMA = NUMA + 1
  374. MELVA3.VELCHE(1,NELMA) = PSUR.FACT(NUMA)
  375. PLIG = MATR.LFACT(NUMA)
  376. SEGACT PLIG
  377. SEGINI ,MCHEL4=ICPEL
  378. MELVA1.IELCHE(1,NELMA) = MCHEL4
  379. NUMB = 0
  380. C
  381. C --------------------------------------------
  382. DO NSMB=1,N1
  383. C On boucle sur les sous-champs
  384. C
  385. ISSM = ICHFAC.IMACHE(NSMB)
  386. SEGACT ISSM
  387. C NBPTB = ISSM.NUM(/1)
  388. NBELB = ISSM.NUM(/2)
  389. N1EL = NBELB
  390. N1PTEL = 1
  391. N2EL = 0
  392. N2PTEL = 0
  393. SEGDES ISSM
  394. C
  395. LTEST3 = .FALSE.
  396. IF(ICOQ) THEN
  397. IF(KCOQ(NSMB)) LTEST3 = .TRUE.
  398. ENDIF
  399. IF (LTEST3) THEN
  400.  
  401. C
  402. C Cas des COQ pour la partie basse
  403. N2 = 2
  404. SEGINI ,MCHAM4
  405. MCHEL4.ICHAML(NSMB) = MCHAM4
  406. SEGINI ,MELVA4,MELVA5
  407. MCHAM4.NOMCHE(1) = 'SUPE'
  408. MCHAM4.TYPCHE(1) = 'REAL*8'
  409. MCHAM4.IELVAL(1) = MELVA4
  410. MCHAM4.NOMCHE(2) = 'INFE'
  411. MCHAM4.TYPCHE(2) = 'REAL*8'
  412. MCHAM4.IELVAL(2) = MELVA5
  413. SEGDES ,MCHAM4
  414. C
  415. C ---------------------------------------
  416. DO NELMB=1,NBELB
  417. C On boucle sur les éléments du sous-champs NSMB
  418. C
  419. C On copie la donnée facteur de forme
  420. NUMB = NUMB + 1
  421. C FF(eA,eB+)
  422. MELVA4.VELCHE(1,NELMB) = PLIG.FACT(NUMB)
  423. NUMB = NUMB + 1
  424. C FF(eA,eB-)
  425. MELVA5.VELCHE(1,NELMB) = PLIG.FACT(NUMB)
  426. C
  427. ENDDO
  428. C fin NELMB -----------------------------
  429. C
  430. SEGDES ,MELVA4,MELVA5
  431. C
  432. ELSE
  433. C
  434. C Partie basse : pas d'éléments COQ
  435. N2 = 1
  436. SEGINI MCHAM4
  437. MCHEL4.ICHAML(NSMB) = MCHAM4
  438. SEGINI ,MELVA4
  439. MCHAM4.NOMCHE(1) = 'MIDL'
  440. MCHAM4.TYPCHE(1) = 'REAL*8'
  441. MCHAM4.IELVAL(1) = MELVA4
  442. SEGDES MCHAM4
  443. C
  444. C ---------------------------------------
  445. DO NELMB=1,NBELB
  446. C On boucle sur les éléments du sous-champs NSMB
  447. C
  448. C On copie la donnée facteur de forme
  449. NUMB = NUMB + 1
  450. C FF(eA,eB)
  451. MELVA4.VELCHE(1,NELMB) = PLIG.FACT(NUMB)
  452. C
  453. ENDDO
  454. C fin NELMB -----------------------------
  455. C
  456. SEGDES ,MELVA4
  457. C
  458. ENDIF
  459. C
  460. C
  461. ENDDO
  462. C fin NSMB -------------------------------------
  463. C
  464. SEGDES ,MCHEL4
  465. SEGDES ,PLIG
  466. C
  467. ENDDO
  468. C fin NELMA ---------------------------------------
  469. C
  470. SEGDES ,MELVA1,MELVA3
  471. C
  472. ENDIF
  473. C
  474. ENDDO
  475. C fin NSMA ----------------------------------------------
  476. C
  477. C
  478. SEGDES ICHFAC
  479. SEGDES MATR , PSUR
  480. SEGSUP ICPEL
  481. C
  482. IF (ICOQ) SEGDES INFOEL
  483. C
  484. IF (NUMA.NE.NBEL2) THEN
  485. CALL ERREUR(21)
  486. C WRITE (6,*) 'Le maillage et la matrice portent sur un nombre'
  487. C # ,' différent d éléments .'
  488. ENDIF
  489. C
  490. RETURN
  491. END
  492.  
  493.  
  494.  
  495.  
  496.  
  497.  
  498.  
  499.  
  500.  
  501.  
  502.  

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