Télécharger raye1.eso

Retour à la liste

Numérotation des lignes :

  1. C RAYE1 SOURCE CHAT 12/06/07 21:15:55 7389
  2. SUBROUTINE RAYE1(ICHFAC, INFOEL, MATR)
  3.  
  4. C **********************************************************
  5. C **** SUBROUTINE D'INTERFACAGE CHAMELEM --> MATRICE ****
  6. C **** POUR LES FACTEURS DE FORME ****
  7. C **** ****
  8. C **** En entree : ICHFAC matrice des facteurs de ****
  9. C **** de type CHAMELEM ****
  10. C **** INFOEL segment qui contient la ****
  11. C **** structure COQ ou QUAdratique de la ****
  12. C **** zone étudiée ****
  13. C **** ****
  14. C **** En sortie : MATR matrice des facteurs de forme ****
  15. C **** exploitable par le programme ****
  16. C **** de calcul RAYE3.ESO ****
  17. C **** ****
  18. C **********************************************************
  19.  
  20. IMPLICIT INTEGER(I-N)
  21. IMPLICIT REAL*8 (A-H,O-Z)
  22.  
  23. -INC SMCHAML
  24. -INC SMELEME
  25. -INC CCOPTIO
  26.  
  27. C **********************************************************
  28. C **** Declaration de la structure des facteurs ****
  29. C **** de forme ****
  30. C **********************************************************
  31.  
  32. SEGMENT IFACFO
  33. INTEGER LFACT(NBEL1)
  34. ENDSEGMENT
  35. SEGMENT LFAC
  36. REAL*8 FACT(NBEL2)
  37. ENDSEGMENT
  38.  
  39. SEGMENT INFOEL
  40. LOGICAL KCOQ(N1), KQUAD(N1)
  41. ENDSEGMENT
  42.  
  43. C **********************************************************
  44. C **** Declaration des variables du probleme ****
  45. C **********************************************************
  46.  
  47. POINTEUR PSUR.LFAC, PLIGI.LFAC, PLIGS.LFAC, PLIG.LFAC
  48. POINTEUR MATR.IFACFO
  49.  
  50. POINTEUR ISSM.MELEME
  51. POINTEUR ICHFAC.MCHELM
  52. POINTEUR IMCHFA.MCHAML
  53. POINTEUR ISURF.MELVAL
  54.  
  55. C **** Cas des elements COQ en haut ****
  56.  
  57. POINTEUR IFFAS.MELVAL, IFFAI.MELVAL
  58. POINTEUR ISSCHI.MCHELM, ISSCHS.MCHELM
  59. POINTEUR ICHFBI.MCHAML, ICHFBS.MCHAML
  60.  
  61. C **** Cas des elements COQ en haut et en bas ****
  62.  
  63. POINTEUR IFFBII.MELVAL, IFFBIS.MELVAL
  64. POINTEUR IFFBSI.MELVAL, IFFBSS.MELVAL
  65.  
  66. C **** Cas des elements COQ en haut seulement ****
  67.  
  68. POINTEUR IFFBIM.MELVAL, IFFBSM.MELVAL
  69.  
  70.  
  71.  
  72.  
  73. C **** Pas d'elements COQ en haut ****
  74.  
  75. POINTEUR IFFA.MELVAL
  76. POINTEUR ISSCH.MCHELM
  77. POINTEUR ICHFB.MCHAML
  78.  
  79. C **** Cas des elements COQ en bas seulement ****
  80.  
  81. POINTEUR IFFBI.MELVAL, IFFBS.MELVAL
  82.  
  83. C **** Cas ou il n'y a pas d'elements COQ ****
  84.  
  85. POINTEUR IFFB.MELVAL
  86.  
  87. C **********************************************************
  88. C **** Recherche de la position du pointeur donnant ****
  89. C **** les surfaces des elements ****
  90. C **********************************************************
  91.  
  92. IF (IIMPI.GE.4) WRITE(6,*) 'DEBUT DE RAYE1.ESO'
  93.  
  94. SEGACT ICHFAC
  95. NBS = ICHFAC.IMACHE(/1)
  96. C **** NBS designe le nombre de sous maillages de type ****
  97. C **** tri3, qua4 ... ****
  98.  
  99. SEGACT INFOEL
  100. NBEL = 0
  101. DO 10 I = 1, NBS
  102. ISSM = ICHFAC.IMACHE(I)
  103. SEGACT ISSM
  104. NBEL = NBEL + ISSM.NUM(/2)
  105. IF (KCOQ(I)) THEN
  106. C **** S'il y a des elements COQ, on rajoute ****
  107. C **** une ligne. ****
  108. NBEL = NBEL + ISSM.NUM(/2)
  109. ENDIF
  110.  
  111. SEGDES ISSM
  112. 10 CONTINUE
  113. SEGDES INFOEL
  114.  
  115. C **** NBEL designe le nombre total d'elements sur la ****
  116. C **** frontiere du maillage ****
  117.  
  118. NBEL1 = NBEL + 1
  119. C **** On rajoute une dimension a la matrice MATR pour ****
  120. C **** stocker la ligne donnant la surface des elements****
  121. C **** On a donc une matrice de taille NBEL*(NBEL+1) ****
  122.  
  123. SEGINI MATR
  124.  
  125. C **********************************************************
  126. C **** Interface CHAMELEM --> MATRICE ****
  127. C **********************************************************
  128.  
  129. C **********************************************************
  130. C **** PASSAGE DES VALEURS DES SURFACES ****
  131. C **** On calcule d'abord la dimension du vecteur PSUR ****
  132. C **** Theoriquement, on doit trouver Nbel. Par ****
  133. C **** precaution, on le verifie. ****
  134. C **********************************************************
  135.  
  136. SEGACT INFOEL
  137. NBEL2 = 0
  138.  
  139. DO 20 NSMA = 1, NBS
  140. IMCHFA = ICHFAC.ICHAML(NSMA)
  141. meleme=ichfac.imache(NSMA)
  142. segact meleme
  143. nbela= num(/2)
  144. SEGACT IMCHFA
  145. IF (KCOQ(NSMA)) then
  146. nbela=nbela*2
  147. ISURF = IMCHFA.IELVAL(3)
  148.  
  149. else
  150. ISURF = IMCHFA.IELVAL(2)
  151. endif
  152. SEGDES IMCHFA
  153. nbel2=nbel2+nbela
  154. 20 continue
  155. C **********************************************************
  156. C **** Si on a des elements COQ ****
  157. C **********************************************************
  158. * SEGACT IMCHFA
  159. * ISURF = IMCHFA.IELVAL(3)
  160. * SEGDES IMCHFA
  161. *
  162. * SEGACT ISURF
  163. * NBELA = ISURF.VELCHE(/2)
  164. C Rajout du doublement des surfaces
  165. * NBELA = NBELA + NBELA
  166. * SEGDES ISURF
  167. *
  168. C SI KCOQ(NSMA) = FALSE
  169. * ELSE
  170. *
  171. C **********************************************************
  172. C **** Si on n'a pas d'elements COQ ****
  173. C **********************************************************
  174. *
  175. * SEGACT IMCHFA
  176. * ISURF = IMCHFA.IELVAL(2)
  177. * SEGDES IMCHFA
  178. *
  179. * SEGACT ISURF
  180. * NBELA = ISURF.VELCHE(/2)
  181. * SEGDES ISURF
  182. *
  183. * ENDIF
  184. *
  185. * NBEL2 = NBEL2 + NBELA
  186. *
  187. * 20 CONTINUE
  188. IF (IIMPI.GE.4.AND.NBEL.NE.NBEL2) THEN
  189. WRITE(6,*) 'Dimensions incompatibles'
  190. ENDIF
  191.  
  192. SEGINI PSUR
  193.  
  194. K = 0
  195.  
  196. C **** Apres avoir verifie les dimensions, on passe ****
  197. C **** les valeurs dans le vecteur PSUR. ****
  198.  
  199. DO 30 NSMA = 1, NBS
  200. IMCHFA = ICHFAC.ICHAML(NSMA)
  201. meleme= ICHFAC.imache(nsma)
  202.  
  203. IF (KCOQ(NSMA)) THEN
  204.  
  205. C **********************************************************
  206. C **** Si on a des elements COQ ****
  207. C **********************************************************
  208.  
  209. SEGACT IMCHFA
  210. ISURF = IMCHFA.IELVAL(3)
  211. SEGDES IMCHFA
  212. SEGACT ISURF
  213. NBELA = ISURF.VELCHE(/2)
  214.  
  215. DO 40 I = 1, Num(/2)
  216. K = K + 1
  217. ima= min ( i,nbela)
  218. PSUR.FACT(K) = ISURF.VELCHE(1,Ima)
  219. K = K + 1
  220. ima= min ( i,nbela)
  221. PSUR.FACT(K) = ISURF.VELCHE(1,Ima)
  222. IF (IIMPI.GE.4) THEN
  223. WRITE(6,*) 'SURF = ', ISURF.VELCHE(1,Ima)
  224. ENDIF
  225. 40 CONTINUE
  226. SEGDES ISURF
  227.  
  228. C SI KCOQ(NSMA) = FALSE
  229. ELSE
  230.  
  231. C **********************************************************
  232. C **** Si on n'a pas d'elements COQ ****
  233. C **********************************************************
  234.  
  235. SEGACT IMCHFA
  236. ISURF = IMCHFA.IELVAL(2)
  237. SEGDES IMCHFA
  238.  
  239. SEGACT ISURF
  240. NBELA = ISURF.VELCHE(/2)
  241. DO 45 I = 1, Num(/2)
  242. K = K + 1
  243. ima= min( i,nbela)
  244. PSUR.FACT(K) = ISURF.VELCHE(1,Ima)
  245. IF (IIMPI.GE.4) THEN
  246. WRITE(6,*) 'SURF 2= ', ISURF.VELCHE(1,Ima)
  247. ENDIF
  248. 45 CONTINUE
  249. SEGDES ISURF
  250. ENDIF
  251.  
  252. 30 CONTINUE
  253.  
  254. C **** Le vecteur PSUR est de dimension K et est place ****
  255. C **** en derniere ligne de MATR. ****
  256.  
  257. IF (IIMPI.GE.4.AND.K.NE.NBEL2) THEN
  258. WRITE(6,*) 'K = ',K ,'NBEL2 = ', NBEL2
  259. WRITE(6,*) 'Ces deux nombres doivent etre egaux'
  260. ENDIF
  261.  
  262. MATR.LFACT(NBEL1) = PSUR
  263.  
  264. SEGDES PSUR
  265.  
  266. C **********************************************************
  267. C **** PASSAGE DES VALEURS DES FACTEURS DE FORME ****
  268. C **********************************************************
  269.  
  270. C **********************************************************
  271. C **** On se positionne d'abord dans un sous-domaine ****
  272. C **********************************************************
  273.  
  274. I = 0
  275.  
  276. C **** I designe l'indice de la ligne I de la matrice ****
  277. C **** MATR. ****
  278.  
  279. DO 50 NSMA = 1, NBS
  280. IMCHFA = ICHFAC.ICHAML(NSMA)
  281.  
  282. IF (IIMPI.GE.4) THEN
  283. WRITE(6,*) 'DIM INFOEL =', INFOEL.KCOQ(/1)
  284. WRITE(6,*) 'KCOQ = ', KCOQ(NSMA)
  285. ENDIF
  286.  
  287. IF (KCOQ(NSMA)) THEN
  288.  
  289. C **********************************************************
  290. C **** Si on a des elements COQ dans la partie sup ****
  291. C **********************************************************
  292.  
  293. SEGACT IMCHFA
  294. IFFAS = IMCHFA.IELVAL(1)
  295. IFFAI = IMCHFA.IELVAL(2)
  296. SEGDES IMCHFA
  297.  
  298. SEGACT IFFAS, IFFAI
  299. NBELA = IFFAS.IELCHE(/2)
  300.  
  301. IF (IIMPI.GE.4) THEN
  302. WRITE(6,*) 'NBELA = ',NBELA
  303. ENDIF
  304.  
  305. C **** NBELA designe le nombre d'elements du sous ****
  306. C **** domaine d'indice NSMA. ****
  307.  
  308. C **********************************************************
  309. C **** Puis, on pointe sur les numeros des elements du ****
  310. C **** maillage ****
  311. C **********************************************************
  312.  
  313. DO 60 NELMA = 1, NBELA
  314. I = I + 1
  315. ISSCHS = IFFAS.IELCHE(1,NELMA)
  316. ISSCHI = IFFAI.IELCHE(1,NELMA)
  317.  
  318. SEGINI PLIGI, PLIGS
  319. SEGACT ISSCHS
  320. NBS2 = ISSCHS.ICHAML(/1)
  321.  
  322. SEGACT ISSCHI
  323. NBS3 = ISSCHI.ICHAML(/1)
  324. IF (NBS2.NE.NBS3) THEN
  325. WRITE(6,*) 'Erreur de dimension'
  326. ENDIF
  327.  
  328. J = 0
  329.  
  330. C **** J designe l'indice de la colonne J de la ****
  331. C **** matrice MATR. ****
  332.  
  333. DO 70 NSMB = 1, NBS2
  334. IF (KCOQ(NSMB)) THEN
  335.  
  336. C **** S'il y a des elements COQ dans la partie inf ****
  337.  
  338. ICHFBI = ISSCHI.ICHAML(NSMB)
  339. ICHFBS = ISSCHS.ICHAML(NSMB)
  340.  
  341. SEGACT ICHFBI
  342. IFFBII = ICHFBI.IELVAL(1)
  343. IFFBIS = ICHFBI.IELVAL(2)
  344. SEGDES ICHFBI
  345.  
  346. SEGACT ICHFBS
  347.  
  348. IFFBSI = ICHFBS.IELVAL(1)
  349. IFFBSS = ICHFBS.IELVAL(2)
  350. SEGDES ICHFBS
  351.  
  352. SEGACT IFFBII, IFFBIS
  353. SEGACT IFFBSI, IFFBSS
  354. NBELB = IFFBSI.VELCHE(/2)
  355. C **********************************************************
  356. C **** Et enfin, on pointe sur une surface de ce ****
  357. C **** deuxieme domaine. ****
  358. C **********************************************************
  359.  
  360. DO 80 NELB = 1, NBELB
  361. J = J + 1
  362. PLIGI.FACT(J) = IFFBIS.VELCHE(1,NELB)
  363. PLIGS.FACT(J) = IFFBSS.VELCHE(1,NELB)
  364. J = J + 1
  365. PLIGI.FACT(J) = IFFBII.VELCHE(1,NELB)
  366. PLIGS.FACT(J) = IFFBSI.VELCHE(1,NELB)
  367. 80 CONTINUE
  368.  
  369. SEGDES IFFBII, IFFBIS
  370. SEGDES IFFBSI, IFFBSS
  371.  
  372. C **** On a boucle sur tous les elements du sous ****
  373. C **** maillage d'indice NSMB. ****
  374.  
  375.  
  376. C **** si KCOQ(NSMB) = FALSE ****
  377.  
  378. ELSE
  379.  
  380. C **** S'il n'y a pas d'elements COQ dans la partie inf****
  381.  
  382. ICHFBI = ISSCHI.ICHAML(NSMB)
  383. ICHFBS = ISSCHS.ICHAML(NSMB)
  384.  
  385. SEGACT ICHFBI
  386. IFFBIM = ICHFBI.IELVAL(1)
  387. SEGDES ICHFBI
  388.  
  389. SEGACT ICHFBS
  390. IFFBSM = ICHFBS.IELVAL(1)
  391. SEGDES ICHFBS
  392.  
  393.  
  394. SEGACT IFFBSM, IFFBIM
  395. NBELB = IFFBSM.VELCHE(/2)
  396. DO 90 NELB = 1, NBELB
  397. J = J + 1
  398. PLIGI.FACT(J) = IFFBIM.VELCHE(1,NELB)
  399. PLIGS.FACT(J) = IFFBSM.VELCHE(1,NELB)
  400. 90 CONTINUE
  401.  
  402. SEGDES IFFBIM, IFFBSM
  403.  
  404. ENDIF
  405.  
  406. 70 CONTINUE
  407.  
  408. C **** Test de verification ****
  409.  
  410. IF (IIMPI.GE.4) THEN
  411. WRITE(6,*) 'Dimension du vecteur fforme =',J
  412. ENDIF
  413.  
  414. C **** On a boucle sur tous les sous maillages. ****
  415.  
  416. SEGDES ISSCHS, ISSCHI
  417.  
  418. MATR.LFACT(I) = PLIGS
  419. I = I + 1
  420. MATR.LFACT(I) = PLIGI
  421.  
  422. SEGDES PLIGI, PLIGS
  423.  
  424. 60 CONTINUE
  425.  
  426. SEGDES IFFAI, IFFAS
  427.  
  428. C **** si KCOQ(NSMA) = FALSE ****
  429.  
  430. ELSE
  431.  
  432. IF (IIMPI.GE.4) THEN
  433. WRITE(6,*) 'il n''y a pas d''elements COQ en haut'
  434. ENDIF
  435.  
  436. C **********************************************************
  437. C **** SI ON N'A PAS D'ELEMENTS COQ DANS LA PARTIE SUP ****
  438. C **********************************************************
  439.  
  440. SEGACT IMCHFA
  441. IFFA = IMCHFA.IELVAL(1)
  442. SEGDES IMCHFA
  443.  
  444. SEGACT IFFA
  445. NBELA = IFFA.IELCHE(/2)
  446.  
  447. IF (IIMPI.GE.4) THEN
  448. WRITE(6,*) 'NBELA = ',NBELA
  449. ENDIF
  450.  
  451. C **** NBELA designe le nombre d'elements du sous ****
  452. C **** domaine d'indice NSMA. ****
  453.  
  454. C **********************************************************
  455. C **** Puis, on pointe sur les numeros des elements du ****
  456. C **** maillage ****
  457. C **********************************************************
  458.  
  459. DO 160 NELMA = 1, NBELA
  460. I = I + 1
  461. ISSCH = IFFA.IELCHE(1,NELMA)
  462.  
  463. SEGINI PLIG
  464.  
  465. SEGACT ISSCH
  466. J = 0
  467.  
  468. C **** J designe l'indice de la colonne J de la ****
  469. C **** matrice MATR. ****
  470.  
  471. NBS2 = ISSCH.ICHAML(/1)
  472.  
  473. C **** Theoriquement, NBS2 = NBS. ****
  474.  
  475. IF (IIMPI.GE.4.AND.NBS.NE.NBS2) THEN
  476. WRITE(6,*) 'Probleme de dimension'
  477. ENDIF
  478.  
  479. DO 170 NSMB = 1, NBS2
  480. ICHFB = ISSCH.ICHAML(NSMB)
  481.  
  482. IF (KCOQ(NSMB)) THEN
  483.  
  484. C **** S'il y a des elements COQ dans la partie inf ****
  485.  
  486. SEGACT ICHFB
  487. IFFBI = ICHFB.IELVAL(1)
  488. IFFBS = ICHFB.IELVAL(2)
  489. SEGDES ICHFB
  490.  
  491. SEGACT IFFBI
  492. NBELB = IFFBI.VELCHE(/2)
  493. SEGACT IFFBS
  494. DO 180 NELB = 1, NBELB
  495. J = J + 1
  496. PLIG.FACT(J) = IFFBS.VELCHE(1,NELB)
  497. J = J + 1
  498. PLIG.FACT(J) = IFFBI.VELCHE(1,NELB)
  499. 180 CONTINUE
  500.  
  501. SEGDES IFFBI, IFFBS
  502.  
  503. C **** On a boucle sur tous les elements du sous ****
  504. C **** maillage d'indice NSMB. ****
  505.  
  506. C **** si KCOQ(NSMB) = FALSE ****
  507.  
  508. ELSE
  509.  
  510. C **** S'il n'y a pas d'elements COQ dans la partie inf****
  511.  
  512. SEGACT ICHFB
  513. IFFB = ICHFB.IELVAL(1)
  514. SEGDES ICHFB
  515.  
  516. SEGACT IFFB
  517. NBELB = IFFB.VELCHE(/2)
  518. DO 190 NELB = 1, NBELB
  519. J = J + 1
  520. PLIG.FACT(J) = IFFB.VELCHE(1,NELB)
  521. 190 CONTINUE
  522.  
  523. SEGDES IFFB
  524.  
  525. ENDIF
  526.  
  527. 170 CONTINUE
  528.  
  529. C **** Test de verification ****
  530.  
  531. IF (J.NE.NBEL2) THEN
  532. WRITE(6,*) 'Erreur de dimension'
  533. ENDIF
  534.  
  535. C **** On a boucle sur tous les sous maillages. ****
  536.  
  537. SEGDES ISSCH
  538. MATR.LFACT(I) = PLIG
  539. SEGDES PLIG
  540.  
  541. 160 CONTINUE
  542.  
  543.  
  544. C **** On a boucle sur tous les elements du sous ****
  545. C **** maillage d'indice NSMA. ****
  546.  
  547. SEGDES IFFA
  548. ENDIF
  549.  
  550. 50 CONTINUE
  551.  
  552. C **** Test de verification ****
  553.  
  554. IF (IIMPI.GE.4.AND.I.NE.NBEL2) THEN
  555. WRITE(6,*) 'Erreur de dimension'
  556. ENDIF
  557.  
  558. C **** On a boucle sur tous les sous maillages. ****
  559.  
  560. C **********************************************************
  561. C **** Desactivation des segments inutiles ****
  562. C **********************************************************
  563.  
  564.  
  565. SEGDES MATR, INFOEL
  566. SEGDES ICHFAC
  567.  
  568. SEGDES IMCHFA
  569.  
  570. IF (IIMPI.GE.4) WRITE(6,*) 'FIN DE RAYE1.ESO OK'
  571.  
  572. RETURN
  573. END
  574.  
  575.  
  576.  
  577.  
  578.  

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