Télécharger ffmcha.eso

Retour à la liste

Numérotation des lignes :

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

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