Télécharger ffmcha.eso

Retour à la liste

Numérotation des lignes :

ffmcha
  1. C FFMCHA SOURCE CB215821 20/11/04 21:17:22 10766
  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.  
  41. -INC PPARAM
  42. -INC CCOPTIO
  43. -INC SMCHAML
  44. -INC SMELEME
  45. -INC SMMODEL
  46. C
  47. C ___________________________________________________________
  48. C FACTEURS DE FORME stockage sous forme matricielle
  49. C NNBEL1 = NOMBRE DE LIGNES + 1
  50. C NBEL2 = NOMBRE DE COLONNES
  51. C LFACT(NNBEL1) POINTE SUR LE TABLEAU DES SURFACES
  52. C
  53. SEGMENT IFACFO
  54. INTEGER LFACT(NNBEL1)
  55. ENDSEGMENT
  56. SEGMENT LFAC
  57. REAL*8 FACT(NBEL2)
  58. ENDSEGMENT
  59. C
  60. POINTEUR PSUR.LFAC, PLIG.LFAC, PLIGI.LFAC, PLIGS.LFAC
  61. POINTEUR MATR.IFACFO
  62. C ___________________________________________________________
  63. C Stockage d'informations concernant le type des éléments des maillages
  64. SEGMENT ,INFOEL
  65. LOGICAL KCOQ(N1),KQUAD(N1)
  66. ENDSEGMENT
  67. C ___________________________________________________________
  68. C
  69. POINTEUR MYMOD.MMODEL
  70. POINTEUR ISSM.MELEME
  71. POINTEUR ICHFAC.MCHELM , ICPEL.MCHELM
  72. POINTEUR MELVA7.MELVAL
  73. LOGICAL ICOQ
  74. LOGICAL LTEST1, LTEST2, LTEST3
  75. C_________________________________________________________________
  76. C
  77. C STRUCTURE DU CHAMELEM
  78. C
  79. C MELVA3 : segment MELVAL , surface
  80. C -----1 : segment -----L partie haute du CHAMELEM
  81. C -----4 : segment -----L partie haute du CHAMELEM
  82. C
  83. C CAS DES ELEMENTS COQ pour la partie haute
  84. C -- Partie 'haute' du CHAMELEM : boucle A --
  85. C MELVA1 : segment MELVAL , côté SUPE
  86. C MELVA2 : segment MELVAL , côté INFE
  87. C -- Partie 'basse' du CHAMELEM : boucle B --
  88. C MCHEL4 : segment MCHELM , côté SUPE
  89. C MCHEL5 : segment MCHELM , côté INFE
  90. C MCHAM4 : segment MCHAML , côté SUPE
  91. C MCHAM5 : segment MCHAML , côté INFE
  92. C CAS DES ÉLÉMENTS COQ pour la partie basse
  93. C MELVA4 : segment MELVAL , côté SUPE , relié à MCHAM4
  94. C MELVA5 : segment MELVAL , côté INFE , relié à MCHAM4
  95. C MELVA6 : segment MELVAL , côté SUPE , relié à MCHAM5
  96. C MELVA7 : segment MELVAL , côté INFE , relié à MCHAM5
  97. C sinon
  98. C MELVA4 : segment MELVAL , relié à MCHAM4
  99. C MELVA6 : segment MELVAL , relié à MCHAM5
  100. C -----
  101. C_________________________________________________________________
  102. C
  103. C NOTATIONS :
  104. C
  105. C eA : élément de la boucle A (partie haute)
  106. C eB : élément de la boucle B (partie basse )
  107. C eA+,eB+ : côté SUPE de l'élément
  108. C eA-,eB- : côté INFE de l'élément
  109. C_________________________________________________________________
  110. C
  111. IF(IIMPI.GE.2) THEN
  112. WRITE (6,*) 'On est dans ffmcha'
  113. ENDIF
  114. C
  115. IF (INFOEL.EQ.0) THEN
  116. ICOQ = .FALSE.
  117. ELSE
  118. ICOQ = .TRUE.
  119. ENDIF
  120. C
  121. SEGACT MYMOD
  122. C
  123. C On construit l'information maillage du CHAMELEM
  124. L1 = 22
  125. N3 = 6
  126. N1 = MYMOD.KMODEL(/1)
  127. IF (N1.EQ.0) THEN
  128. CALL ERREUR(21)
  129. RETURN
  130. ENDIF
  131. C
  132. SEGINI ,ICPEL
  133.  
  134. C IF (LTITR.EQ.1) THEN
  135. C ICPEL.TITCHE = 'FACTEURS DE FORME '
  136. C ELSE
  137. ICPEL.TITCHE = 'MATRICE DE RAYONNEMENT'
  138. C ENDIF
  139.  
  140. IF (IFOMOD.NE.0) THEN
  141. IF (IDIM.EQ.3) THEN
  142. ICPEL.IFOCHE = 2
  143. ELSE
  144. ICPEL.IFOCHE = -1
  145. ENDIF
  146. ELSE
  147. ICPEL.IFOCHE = 0
  148. ENDIF
  149. DO I=1,N1
  150. IMODE1 = MYMOD.KMODEL(I)
  151. SEGACT IMODE1
  152. ICPEL.IMACHE(I) = IMODE1.IMAMOD
  153. ICPEL.CONCHE(I) = IMODE1.CONMOD
  154. ENDDO
  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. N1EL = NBELA
  192. N1PTEL = 1
  193. N2EL = 0
  194. N2PTEL = 0
  195. SEGINI MELVA3
  196. N1EL = 0
  197. N1PTEL = 0
  198. N2EL = NBELA
  199. N2PTEL = 1
  200. C
  201. LTEST1=.FALSE.
  202. IF(ICOQ) THEN
  203. IF(KCOQ(NSMA)) LTEST1=.TRUE.
  204. ENDIF
  205. IF (LTEST1) THEN
  206. C
  207. C Cas des COQ pour la partie haute
  208. N2 = 3
  209. SEGINI ,MCHAM1
  210. ICHFAC.ICHAML(NSMA) = MCHAM1
  211. SEGINI ,MELVA1,MELVA2
  212. MCHAM1.NOMCHE(1) = 'SUPE'
  213. MCHAM1.TYPCHE(1) = 'POINTEURMCHAML'
  214. MCHAM1.IELVAL(1) = MELVA1
  215. MCHAM1.NOMCHE(2) = 'INFE'
  216. MCHAM1.TYPCHE(2) = 'POINTEURMCHAML'
  217. MCHAM1.IELVAL(2) = MELVA2
  218. MCHAM1.NOMCHE(3) = 'SURF'
  219. MCHAM1.TYPCHE(3) = 'REAL*8'
  220. MCHAM1.IELVAL(3) = MELVA3
  221.  
  222. C ----------------------------------------------
  223. DO NELMA=1,NBELA
  224. C On boucle sur les éléments du sous-champs NSMA
  225. C
  226. C
  227. NUMA = NUMA + 1
  228. MELVA3.VELCHE(1,NELMA) = PSUR.FACT(NUMA)
  229. PLIGI = MATR.LFACT(NUMA)
  230. NUMA = NUMA + 1
  231. MELVA3.VELCHE(1,NELMA) = PSUR.FACT(NUMA)
  232. PLIGS = MATR.LFACT(NUMA)
  233. SEGACT ,PLIGI,PLIGS
  234. SEGINI ,MCHEL4=ICPEL
  235. MELVA1.IELCHE(1,NELMA) = MCHEL4
  236. SEGINI ,MCHEL5=ICPEL
  237. MELVA2.IELCHE(1,NELMA) = MCHEL5
  238. NUMB = 0
  239. C
  240. C --------------------------------------------
  241. DO NSMB=1,N1
  242. C On boucle sur les sous-champs
  243. C
  244. ISSM = ICHFAC.IMACHE(NSMB)
  245. SEGACT ISSM
  246. C NBPTB = ISSM.NUM(/1)
  247. NBELB = ISSM.NUM(/2)
  248. N1EL = NBELB
  249. N1PTEL = 1
  250. N2EL = 0
  251. N2PTEL = 0
  252. C
  253. LTEST2 = .FALSE.
  254. IF(ICOQ) THEN
  255. IF(KCOQ(NSMB)) LTEST2 = .TRUE.
  256. ENDIF
  257. IF (LTEST2) THEN
  258. C
  259. C Cas des COQ pour la partie basse
  260. N2 = 2
  261. SEGINI ,MCHAM4,MCHAM5
  262. MCHEL4.ICHAML(NSMB) = MCHAM4
  263. MCHEL5.ICHAML(NSMB) = MCHAM5
  264. C
  265. SEGINI ,MELVA4,MELVA5
  266. MCHAM4.NOMCHE(1) = 'SUPE'
  267. MCHAM4.TYPCHE(1) = 'REAL*8'
  268. MCHAM4.IELVAL(1) = MELVA4
  269. MCHAM4.NOMCHE(2) = 'INFE'
  270. MCHAM4.TYPCHE(2) = 'REAL*8'
  271. MCHAM4.IELVAL(2) = MELVA5
  272.  
  273. SEGINI ,MELVA6,MELVA7
  274. MCHAM5.NOMCHE(1) = 'SUPE'
  275. MCHAM5.TYPCHE(1) = 'REAL*8'
  276. MCHAM5.IELVAL(1) = MELVA6
  277. MCHAM5.NOMCHE(2) = 'INFE'
  278. MCHAM5.TYPCHE(2) = 'REAL*8'
  279. MCHAM5.IELVAL(2) = MELVA7
  280. C
  281. C ---------------------------------------
  282. DO NELMB=1,NBELB
  283. C On boucle sur les éléments du sous-champs NSMB
  284. C
  285. C On copie la donnée facteur de forme
  286. NUMB = NUMB + 1
  287. C FF(eA+,eB+)
  288. MELVA4.VELCHE(1,NELMB) = PLIGI.FACT(NUMB)
  289. C FF(eA-,eB+)
  290. MELVA6.VELCHE(1,NELMB) = PLIGS.FACT(NUMB)
  291. NUMB = NUMB + 1
  292. C FF(eA+,eB-)
  293. MELVA5.VELCHE(1,NELMB) = PLIGI.FACT(NUMB)
  294. C FF(eA-,eB-)
  295. MELVA7.VELCHE(1,NELMB) = PLIGS.FACT(NUMB)
  296. C
  297. ENDDO
  298. C fin NELMB ----------------------------
  299. C
  300. C
  301. ELSE
  302. C
  303. C Partie basse : pas d'éléments COQ
  304. N2 = 1
  305. SEGINI MCHAM4,MCHAM5
  306. MCHEL4.ICHAML(NSMB) = MCHAM4
  307. MCHEL5.ICHAML(NSMB) = MCHAM5
  308. SEGINI ,MELVA4,MELVA5
  309. MCHAM4.NOMCHE(1) = 'MIDL'
  310. MCHAM4.TYPCHE(1) = 'REAL*8'
  311. MCHAM4.IELVAL(1) = MELVA4
  312. MCHAM5.NOMCHE(1) = 'MIDL'
  313. MCHAM5.TYPCHE(1) = 'REAL*8'
  314. MCHAM5.IELVAL(1) = MELVA5
  315. C
  316. C ---------------------------------------
  317. DO NELMB=1,NBELB
  318. C On boucle sur les éléments du sous-champs NSMB
  319. C
  320. C On copie la donnée facteur de forme
  321. NUMB = NUMB + 1
  322. C FF(eA+,eB)
  323. MELVA4.VELCHE(1,NELMB) = PLIGI.FACT(NUMB)
  324. C FF(eA-,eB)
  325. MELVA5.VELCHE(1,NELMB) = PLIGS.FACT(NUMB)
  326. C
  327. ENDDO
  328. C fin NELMB -----------------------------
  329. C
  330. C
  331. ENDIF
  332. C
  333. C
  334. ENDDO
  335. C fin NSMB -------------------------------------
  336. C
  337. SEGDES ,PLIGI,PLIGS
  338. C
  339. ENDDO
  340. C fin NELMA ---------------------------------------
  341. C
  342. C
  343. ELSE
  344. C
  345. C Partie haute : pas d'éléments COQ
  346. SEGINI ,MELVA1
  347. N2 = 2
  348. SEGINI MCHAM1
  349. ICHFAC.ICHAML(NSMA) = MCHAM1
  350. MCHAM1.NOMCHE(1) = 'MIDL'
  351. MCHAM1.TYPCHE(1) = 'POINTEURMCHAML'
  352. MCHAM1.IELVAL(1) = MELVA1
  353. MCHAM1.NOMCHE(2) = 'SURF'
  354. MCHAM1.TYPCHE(2) = 'REAL*8'
  355. MCHAM1.IELVAL(2) = MELVA3
  356. C
  357. C ----------------------------------------------
  358. DO NELMA=1,NBELA
  359. C On boucle sur les éléments du sous-champs NSMA
  360. C
  361. C
  362. NUMA = NUMA + 1
  363. MELVA3.VELCHE(1,NELMA) = PSUR.FACT(NUMA)
  364. PLIG = MATR.LFACT(NUMA)
  365. SEGACT PLIG
  366. SEGINI ,MCHEL4=ICPEL
  367. MELVA1.IELCHE(1,NELMA) = MCHEL4
  368. NUMB = 0
  369. C
  370. C --------------------------------------------
  371. DO NSMB=1,N1
  372. C On boucle sur les sous-champs
  373. C
  374. ISSM = ICHFAC.IMACHE(NSMB)
  375. SEGACT ISSM
  376. C NBPTB = ISSM.NUM(/1)
  377. NBELB = ISSM.NUM(/2)
  378. N1EL = NBELB
  379. N1PTEL = 1
  380. N2EL = 0
  381. N2PTEL = 0
  382. C
  383. LTEST3 = .FALSE.
  384. IF(ICOQ) THEN
  385. IF(KCOQ(NSMB)) LTEST3 = .TRUE.
  386. ENDIF
  387. IF (LTEST3) THEN
  388.  
  389. C
  390. C Cas des COQ pour la partie basse
  391. N2 = 2
  392. SEGINI ,MCHAM4
  393. MCHEL4.ICHAML(NSMB) = MCHAM4
  394. SEGINI ,MELVA4,MELVA5
  395. MCHAM4.NOMCHE(1) = 'SUPE'
  396. MCHAM4.TYPCHE(1) = 'REAL*8'
  397. MCHAM4.IELVAL(1) = MELVA4
  398. MCHAM4.NOMCHE(2) = 'INFE'
  399. MCHAM4.TYPCHE(2) = 'REAL*8'
  400. MCHAM4.IELVAL(2) = MELVA5
  401. C
  402. C ---------------------------------------
  403. DO NELMB=1,NBELB
  404. C On boucle sur les éléments du sous-champs NSMB
  405. C
  406. C On copie la donnée facteur de forme
  407. NUMB = NUMB + 1
  408. C FF(eA,eB+)
  409. MELVA4.VELCHE(1,NELMB) = PLIG.FACT(NUMB)
  410. NUMB = NUMB + 1
  411. C FF(eA,eB-)
  412. MELVA5.VELCHE(1,NELMB) = PLIG.FACT(NUMB)
  413. C
  414. ENDDO
  415. C fin NELMB -----------------------------
  416. C
  417. C
  418. ELSE
  419. C
  420. C Partie basse : pas d'éléments COQ
  421. N2 = 1
  422. SEGINI MCHAM4
  423. MCHEL4.ICHAML(NSMB) = MCHAM4
  424. SEGINI ,MELVA4
  425. MCHAM4.NOMCHE(1) = 'MIDL'
  426. MCHAM4.TYPCHE(1) = 'REAL*8'
  427. MCHAM4.IELVAL(1) = MELVA4
  428. C
  429. C ---------------------------------------
  430. DO NELMB=1,NBELB
  431. C On boucle sur les éléments du sous-champs NSMB
  432. C
  433. C On copie la donnée facteur de forme
  434. NUMB = NUMB + 1
  435. C FF(eA,eB)
  436. MELVA4.VELCHE(1,NELMB) = PLIG.FACT(NUMB)
  437. C
  438. ENDDO
  439. C fin NELMB -----------------------------
  440. C
  441. C
  442. ENDIF
  443. C
  444. C
  445. ENDDO
  446. C fin NSMB -------------------------------------
  447. C
  448. SEGDES ,PLIG
  449. C
  450. ENDDO
  451. C fin NELMA ---------------------------------------
  452. C
  453. C
  454. ENDIF
  455. C
  456. ENDDO
  457. C fin NSMA ----------------------------------------------
  458. C
  459. C
  460. SEGDES MATR , PSUR
  461. SEGSUP ICPEL
  462. C
  463. IF (ICOQ) SEGDES INFOEL
  464. C
  465. IF (NUMA.NE.NBEL2) THEN
  466. CALL ERREUR(21)
  467. C WRITE (6,*) 'Le maillage et la matrice portent sur un nombre'
  468. C # ,' différent d éléments .'
  469. ENDIF
  470.  
  471. END
  472.  
  473.  
  474.  
  475.  

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