Télécharger ffmcha.eso

Retour à la liste

Numérotation des lignes :

  1. C FFMCHA SOURCE CHAT 11/03/16 21:22:19 6902
  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. IF (LTITR.EQ.1) THEN
  133. ICPEL.TITCHE = 'FACTEURS DE FORME '
  134. ELSE
  135. ICPEL.TITCHE = 'MATRICE DE RAYONNEMENT'
  136. 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. SEGDES IMODE1
  152. ENDDO
  153. SEGDES ICPEL
  154. SEGDES MYMOD
  155. C
  156. C------------------------------------------------------------
  157. C
  158. C
  159. C On récupère le nombre total d'éléments .
  160. C On vérifiera que le maillage et la matrice
  161. C portent sur le même nombre d'éléments .
  162. SEGACT MATR
  163. NNBEL1 = MATR.LFACT(/1)
  164. NBEL2 = NNBEL1 - 1
  165. PSUR = MATR.LFACT(NNBEL1)
  166. SEGACT PSUR
  167. C
  168. SEGINI ,ICHFAC=ICPEL
  169. NUMA = 0
  170. C
  171. IF (ICOQ) SEGACT INFOEL
  172. C Pour les tests avenirs , on sait que FORTRAN évalue la partie
  173. C gauche d'une expression booléenne avant la partie droite ,
  174. C et donc :
  175. C dans le cas d'un .AND. si la partie gauche est fausse
  176. C la partie droite ne sera pas évaluée .
  177. C ... La remarque ci-dessus s'est avérée fausse dans le cas de
  178. C certains compilateurs (DEC Alpha OSF ), d'où l'introduction des
  179. C variables logiques LTEST1, LTEST2 et LTEST3 qui permettent de se
  180. C passer de cette hypothèse (MB & LB 13/03/96) ...
  181.  
  182. C
  183. C -----------------------------------------------------
  184. DO NSMA=1,N1
  185. C On boucle sur les sous-champs
  186. C
  187. ISSM = ICHFAC.IMACHE(NSMA)
  188. SEGACT ISSM
  189. C NBPTA = ISSM.NUM(/1)
  190. NBELA = ISSM.NUM(/2)
  191. SEGDES ISSM
  192. N1EL = NBELA
  193. N1PTEL = 1
  194. N2EL = 0
  195. N2PTEL = 0
  196. SEGINI MELVA3
  197. N1EL = 0
  198. N1PTEL = 0
  199. N2EL = NBELA
  200. N2PTEL = 1
  201. C
  202. LTEST1=.FALSE.
  203. IF(ICOQ) THEN
  204. IF(KCOQ(NSMA)) LTEST1=.TRUE.
  205. ENDIF
  206. IF (LTEST1) THEN
  207. C
  208. C Cas des COQ pour la partie haute
  209. N2 = 3
  210. SEGINI ,MCHAM1
  211. ICHFAC.ICHAML(NSMA) = MCHAM1
  212. SEGINI ,MELVA1,MELVA2
  213. MCHAM1.NOMCHE(1) = 'SUPE'
  214. MCHAM1.TYPCHE(1) = 'POINTEURMCHAML'
  215. MCHAM1.IELVAL(1) = MELVA1
  216. MCHAM1.NOMCHE(2) = 'INFE'
  217. MCHAM1.TYPCHE(2) = 'POINTEURMCHAML'
  218. MCHAM1.IELVAL(2) = MELVA2
  219. MCHAM1.NOMCHE(3) = 'SURF'
  220. MCHAM1.TYPCHE(3) = 'REAL*8'
  221. MCHAM1.IELVAL(3) = MELVA3
  222. SEGDES MCHAM1
  223.  
  224. C ----------------------------------------------
  225. DO NELMA=1,NBELA
  226. C On boucle sur les éléments du sous-champs NSMA
  227. C
  228. C
  229. NUMA = NUMA + 1
  230. MELVA3.VELCHE(1,NELMA) = PSUR.FACT(NUMA)
  231. PLIGI = MATR.LFACT(NUMA)
  232. NUMA = NUMA + 1
  233. MELVA3.VELCHE(1,NELMA) = PSUR.FACT(NUMA)
  234. PLIGS = MATR.LFACT(NUMA)
  235. SEGACT ,PLIGI,PLIGS
  236. SEGINI ,MCHEL4=ICPEL
  237. MELVA1.IELCHE(1,NELMA) = MCHEL4
  238. SEGINI ,MCHEL5=ICPEL
  239. MELVA2.IELCHE(1,NELMA) = MCHEL5
  240. NUMB = 0
  241. C
  242. C --------------------------------------------
  243. DO NSMB=1,N1
  244. C On boucle sur les sous-champs
  245. C
  246. ISSM = ICHFAC.IMACHE(NSMB)
  247. SEGACT ISSM
  248. C NBPTB = ISSM.NUM(/1)
  249. NBELB = ISSM.NUM(/2)
  250. N1EL = NBELB
  251. N1PTEL = 1
  252. N2EL = 0
  253. N2PTEL = 0
  254. SEGDES ISSM
  255. C
  256. LTEST2 = .FALSE.
  257. IF(ICOQ) THEN
  258. IF(KCOQ(NSMB)) LTEST2 = .TRUE.
  259. ENDIF
  260. IF (LTEST2) THEN
  261. C
  262. C Cas des COQ pour la partie basse
  263. N2 = 2
  264. SEGINI ,MCHAM4,MCHAM5
  265. MCHEL4.ICHAML(NSMB) = MCHAM4
  266. MCHEL5.ICHAML(NSMB) = MCHAM5
  267. C
  268. SEGINI ,MELVA4,MELVA5
  269. MCHAM4.NOMCHE(1) = 'SUPE'
  270. MCHAM4.TYPCHE(1) = 'REAL*8'
  271. MCHAM4.IELVAL(1) = MELVA4
  272. MCHAM4.NOMCHE(2) = 'INFE'
  273. MCHAM4.TYPCHE(2) = 'REAL*8'
  274. MCHAM4.IELVAL(2) = MELVA5
  275. SEGDES ,MCHAM4
  276. SEGINI ,MELVA6,MELVA7
  277. MCHAM5.NOMCHE(1) = 'SUPE'
  278. MCHAM5.TYPCHE(1) = 'REAL*8'
  279. MCHAM5.IELVAL(1) = MELVA6
  280. MCHAM5.NOMCHE(2) = 'INFE'
  281. MCHAM5.TYPCHE(2) = 'REAL*8'
  282. MCHAM5.IELVAL(2) = MELVA7
  283. SEGDES ,MCHAM5
  284. C
  285. C ---------------------------------------
  286. DO NELMB=1,NBELB
  287. C On boucle sur les éléments du sous-champs NSMB
  288. C
  289. C On copie la donnée facteur de forme
  290. NUMB = NUMB + 1
  291. C FF(eA+,eB+)
  292. MELVA4.VELCHE(1,NELMB) = PLIGI.FACT(NUMB)
  293. C FF(eA-,eB+)
  294. MELVA6.VELCHE(1,NELMB) = PLIGS.FACT(NUMB)
  295. NUMB = NUMB + 1
  296. C FF(eA+,eB-)
  297. MELVA5.VELCHE(1,NELMB) = PLIGI.FACT(NUMB)
  298. C FF(eA-,eB-)
  299. MELVA7.VELCHE(1,NELMB) = PLIGS.FACT(NUMB)
  300. C
  301. ENDDO
  302. C fin NELMB ----------------------------
  303. C
  304. SEGDES ,MELVA4,MELVA5,MELVA6,MELVA7
  305. C
  306. ELSE
  307. C
  308. C Partie basse : pas d'éléments COQ
  309. N2 = 1
  310. SEGINI MCHAM4,MCHAM5
  311. MCHEL4.ICHAML(NSMB) = MCHAM4
  312. MCHEL5.ICHAML(NSMB) = MCHAM5
  313. SEGINI ,MELVA4,MELVA5
  314. MCHAM4.NOMCHE(1) = 'MIDL'
  315. MCHAM4.TYPCHE(1) = 'REAL*8'
  316. MCHAM4.IELVAL(1) = MELVA4
  317. MCHAM5.NOMCHE(1) = 'MIDL'
  318. MCHAM5.TYPCHE(1) = 'REAL*8'
  319. MCHAM5.IELVAL(1) = MELVA5
  320. SEGDES MCHAM4,MCHAM5
  321. C
  322. C ---------------------------------------
  323. DO NELMB=1,NBELB
  324. C On boucle sur les éléments du sous-champs NSMB
  325. C
  326. C On copie la donnée facteur de forme
  327. NUMB = NUMB + 1
  328. C FF(eA+,eB)
  329. MELVA4.VELCHE(1,NELMB) = PLIGI.FACT(NUMB)
  330. C FF(eA-,eB)
  331. MELVA5.VELCHE(1,NELMB) = PLIGS.FACT(NUMB)
  332. C
  333. ENDDO
  334. C fin NELMB -----------------------------
  335. C
  336. SEGDES ,MELVA4,MELVA5
  337. C
  338. ENDIF
  339. C
  340. C
  341. ENDDO
  342. C fin NSMB -------------------------------------
  343. C
  344. SEGDES ,MCHEL4,MCHEL5
  345. SEGDES ,PLIGI,PLIGS
  346. C
  347. ENDDO
  348. C fin NELMA ---------------------------------------
  349. C
  350. SEGDES ,MELVA1,MELVA2,MELVA3
  351. C
  352. ELSE
  353. C
  354. C Partie haute : pas d'éléments COQ
  355. SEGINI ,MELVA1
  356. N2 = 2
  357. SEGINI MCHAM1
  358. ICHFAC.ICHAML(NSMA) = MCHAM1
  359. MCHAM1.NOMCHE(1) = 'MIDL'
  360. MCHAM1.TYPCHE(1) = 'POINTEURMCHAML'
  361. MCHAM1.IELVAL(1) = MELVA1
  362. MCHAM1.NOMCHE(2) = 'SURF'
  363. MCHAM1.TYPCHE(2) = 'REAL*8'
  364. MCHAM1.IELVAL(2) = MELVA3
  365. SEGDES ,MCHAM1
  366. C
  367. C ----------------------------------------------
  368. DO NELMA=1,NBELA
  369. C On boucle sur les éléments du sous-champs NSMA
  370. C
  371. C
  372. NUMA = NUMA + 1
  373. MELVA3.VELCHE(1,NELMA) = PSUR.FACT(NUMA)
  374. PLIG = MATR.LFACT(NUMA)
  375. SEGACT PLIG
  376. SEGINI ,MCHEL4=ICPEL
  377. MELVA1.IELCHE(1,NELMA) = MCHEL4
  378. NUMB = 0
  379. C
  380. C --------------------------------------------
  381. DO NSMB=1,N1
  382. C On boucle sur les sous-champs
  383. C
  384. ISSM = ICHFAC.IMACHE(NSMB)
  385. SEGACT ISSM
  386. C NBPTB = ISSM.NUM(/1)
  387. NBELB = ISSM.NUM(/2)
  388. N1EL = NBELB
  389. N1PTEL = 1
  390. N2EL = 0
  391. N2PTEL = 0
  392. SEGDES ISSM
  393. C
  394. LTEST3 = .FALSE.
  395. IF(ICOQ) THEN
  396. IF(KCOQ(NSMB)) LTEST3 = .TRUE.
  397. ENDIF
  398. IF (LTEST3) THEN
  399.  
  400. C
  401. C Cas des COQ pour la partie basse
  402. N2 = 2
  403. SEGINI ,MCHAM4
  404. MCHEL4.ICHAML(NSMB) = MCHAM4
  405. SEGINI ,MELVA4,MELVA5
  406. MCHAM4.NOMCHE(1) = 'SUPE'
  407. MCHAM4.TYPCHE(1) = 'REAL*8'
  408. MCHAM4.IELVAL(1) = MELVA4
  409. MCHAM4.NOMCHE(2) = 'INFE'
  410. MCHAM4.TYPCHE(2) = 'REAL*8'
  411. MCHAM4.IELVAL(2) = MELVA5
  412. SEGDES ,MCHAM4
  413. C
  414. C ---------------------------------------
  415. DO NELMB=1,NBELB
  416. C On boucle sur les éléments du sous-champs NSMB
  417. C
  418. C On copie la donnée facteur de forme
  419. NUMB = NUMB + 1
  420. C FF(eA,eB+)
  421. MELVA4.VELCHE(1,NELMB) = PLIG.FACT(NUMB)
  422. NUMB = NUMB + 1
  423. C FF(eA,eB-)
  424. MELVA5.VELCHE(1,NELMB) = PLIG.FACT(NUMB)
  425. C
  426. ENDDO
  427. C fin NELMB -----------------------------
  428. C
  429. SEGDES ,MELVA4,MELVA5
  430. C
  431. ELSE
  432. C
  433. C Partie basse : pas d'éléments COQ
  434. N2 = 1
  435. SEGINI MCHAM4
  436. MCHEL4.ICHAML(NSMB) = MCHAM4
  437. SEGINI ,MELVA4
  438. MCHAM4.NOMCHE(1) = 'MIDL'
  439. MCHAM4.TYPCHE(1) = 'REAL*8'
  440. MCHAM4.IELVAL(1) = MELVA4
  441. SEGDES MCHAM4
  442. C
  443. C ---------------------------------------
  444. DO NELMB=1,NBELB
  445. C On boucle sur les éléments du sous-champs NSMB
  446. C
  447. C On copie la donnée facteur de forme
  448. NUMB = NUMB + 1
  449. C FF(eA,eB)
  450. MELVA4.VELCHE(1,NELMB) = PLIG.FACT(NUMB)
  451. C
  452. ENDDO
  453. C fin NELMB -----------------------------
  454. C
  455. SEGDES ,MELVA4
  456. C
  457. ENDIF
  458. C
  459. C
  460. ENDDO
  461. C fin NSMB -------------------------------------
  462. C
  463. SEGDES ,MCHEL4
  464. SEGDES ,PLIG
  465. C
  466. ENDDO
  467. C fin NELMA ---------------------------------------
  468. C
  469. SEGDES ,MELVA1,MELVA3
  470. C
  471. ENDIF
  472. C
  473. ENDDO
  474. C fin NSMA ----------------------------------------------
  475. C
  476. C
  477. SEGDES ICHFAC
  478. SEGDES MATR , PSUR
  479. SEGSUP ICPEL
  480. C
  481. IF (ICOQ) SEGDES INFOEL
  482. C
  483. IF (NUMA.NE.NBEL2) THEN
  484. CALL ERREUR(21)
  485. C WRITE (6,*) 'Le maillage et la matrice portent sur un nombre'
  486. C # ,' différent d éléments .'
  487. ENDIF
  488. C
  489. RETURN
  490. END
  491.  
  492.  
  493.  
  494.  
  495.  
  496.  
  497.  
  498.  
  499.  
  500.  

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