Télécharger conne1.eso

Retour à la liste

Numérotation des lignes :

  1. C CONNE1 SOURCE AM 17/09/25 21:15:00 9566
  2. SUBROUTINE CONNE1(IPMODL,XLONG,IXLONG,CONSTI,ICLE,JPT1,JPT2,JPT3,
  3. > IPCHCO,IRET)
  4. C_______________________________________________________________________
  5. C
  6. C CALCUL DES CONNECTIVITES APPELE PAR CONNEC
  7. C
  8. C Entrees:
  9. C ________
  10. C
  11. C IPMODL Pointeur sur un objet MMODEL
  12. C XLONG Longeur caracteristique
  13. C IXLONG Champ de longeur caracteristique
  14. C CONSTI nom du constituant
  15. C ICLE mode de modification du maillage pour le calcul
  16. C (1=NORM, 3=POIN, 4=DROI, 5=PLAN, 2=TRAN)
  17. C JPT1|
  18. C JPT2| pointeurs eventuels sur des objets de type point
  19. C JPT3|
  20. C
  21. C
  22. C Sorties:
  23. C ________
  24. C
  25. C IPCHCO Pointeur sur un MCHAML de Connectivite
  26. C de composantes obligatoires ...
  27. C
  28. C 'NLAR': Non local Longueur cARacteristique
  29. C 'PMOD': Pointeur sur un MMODEL contenant
  30. C l'ensemble des IMODEL accessibles
  31. C pour la sous zone
  32. C 'NPNI': Non local Pointeur Numero Imodel de nmod
  33. C 'NPLI': Non local Pointeur LIstenti
  34. C
  35. C ... et eventuellement
  36. C
  37. C 'POT1': Point ou vecteur de construction de symetrie
  38. C (POIN, DROI, PLAN, TRAN)
  39. C 'POT2': Point de construction de symetrie (DROI)
  40. C 'DISP': Distance pour calcul de symetrie PLAN (PLAN)
  41. C
  42. C IRET 1 ou 0 suivant succes ou pas
  43. C
  44. C Appele par: CONNEC
  45. C -----------
  46. C
  47. C Appel a:
  48. C --------
  49. C
  50. C LOADPO : lecture d'un point (pointeur --> x(3))
  51. C NORPLA : calcul de l'eq. canonique d'un plan passant par 3 pts
  52. C ADJUPO : ajout d'un point dans la pile des points (x(3) --> pointeur)
  53. C NORDRO : calcul du vect. dir. norme de la droite passant par 2 pts
  54. C DISYPT : distance a un point
  55. C DISYDR : distance a une droite
  56. C DISYPL : distance a un plan
  57. C TRTRVE : point translate
  58. C TRSYPT : point symetrique par rapport a un point
  59. C TRSYDR : point symetrique par rapport a une droite
  60. C TRSYPL : point symetrique par rapport a un plan
  61. C ELQUOI, DOXE, DTSHAM
  62. C
  63. C AUTEUR P.PEGON 22/10/92 d'apres C. LA BORDERIE d'apres P.PEGON
  64. C_______________________________________________________________________
  65. C
  66. IMPLICIT INTEGER(I-N)
  67. IMPLICIT REAL*8(A-H,O-Z)
  68. CHARACTER*16 CONSTI
  69. DIMENSION PT1(3),PT2(3),PT3(3)
  70. C
  71. -INC SMMODEL
  72. -INC CCOPTIO
  73. -INC SMELEME
  74. -INC SMCOORD
  75. -INC SMCHAML
  76. -INC SMLENTI
  77. C
  78. SEGMENT,INFO
  79. INTEGER INFELL(JG)
  80. ENDSEGMENT
  81. C
  82. SEGMENT,WRK1
  83. REAL*8 XE(3,NBNN)
  84. ENDSEGMENT
  85. C
  86. SEGMENT,WRK2
  87. REAL*8 XEJ(3,NBNJ)
  88. ENDSEGMENT
  89. C
  90. POINTEUR IPMAIL.MELEME
  91. POINTEUR MLNUEL.MLENTI
  92. POINTEUR MLNIMO.MLENTI
  93. C
  94. CHARACTER*(NCONCH) CONM
  95. PARAMETER ( NINF=3 )
  96. INTEGER INFOS(NINF)
  97. SEGMENT NOTYPE
  98. CHARACTER*16 TYPE(NBTYPE)
  99. ENDSEGMENT
  100. *
  101. SEGMENT MPTVAL
  102. INTEGER IPOS(NS) ,NSOF(NS)
  103. INTEGER IVAL(NCOSOU)
  104. CHARACTER*16 TYVAL(NCOSOU)
  105. ENDSEGMENT
  106. C
  107. DATA XMULTL/1.5/
  108. C
  109. C LECTURE DES POINTS
  110. C
  111. CALL LOADPO(JPT1,PT1)
  112. CALL LOADPO(JPT2,PT2)
  113. CALL LOADPO(JPT3,PT3)
  114. C
  115. C CALCUL DE LA NORMALE NORMEE ET DE LA DISTANCE POUR LE CAS
  116. C DU PLAN, ET AJOUT DU POINT A LA PILE
  117. C
  118. IF(ICLE.EQ.5)THEN
  119. CALL NORPLA(PT1,PT2,PT3,PT1,D)
  120. CALL ADJUPO(PT1,JPT1)
  121. ENDIF
  122. C
  123. C CALCUL DU VECTEUR DIRECTEUR NORME DANS LE CAS DE LA DROITE
  124. C ET AJOUT DU POINT A LA PILE
  125. C
  126. IF(ICLE.EQ.4)THEN
  127. CALL NORDRO(PT1,PT2,PT2)
  128. CALL ADJUPO(PT2,JPT2)
  129. ENDIF
  130. C
  131. IRET=1
  132. C
  133. C____________________________________________________________________
  134. C
  135. C PREPARATIONS DE LA LONGUEUR CARACTERISTIQUE
  136. C____________________________________________________________________
  137. C
  138. IF(IXLONG.NE.0)THEN
  139. C
  140. INFOS(1)=0
  141. INFOS(2)=0
  142. INFOS(3)=NIFOUR
  143. C
  144. NBROBL=1
  145. NBRFAC=0
  146. SEGINI NOMID
  147. NOMLAR=NOMID
  148. LESOBL(1)='LCAR'
  149. NBTYPE=1
  150. SEGINI NOTYPE
  151. MOTYPE=NOTYPE
  152. TYPE(1)='REAL*8'
  153. ELSE
  154. XLONG2=(XMULTL*XLONG)**2
  155. ENDIF
  156. C
  157. C ACTIVATION DU MODELE
  158. C
  159. MMODEL=IPMODL
  160. SEGACT,MMODEL
  161. NSOUS=KMODEL(/1)
  162. C
  163. C ACTIVATION DES ZONES ELEMENTAIRES DU MAILLAGE
  164. C
  165. DO 1 ISOUS=1,NSOUS
  166. IMODEL=KMODEL(ISOUS)
  167. SEGACT,IMODEL
  168. IPMAIL=IMAMOD
  169. SEGACT,IPMAIL
  170. 1 CONTINUE
  171. C
  172. C CREATION DU MCHELM
  173. C
  174. N1=NSOUS
  175. L1=22
  176. N3=6
  177. SEGINI,MCHELM
  178. IPCHCO=MCHELM
  179. TITCHE='CONNECTIVITE NON LOCAL'
  180. IFOCHE=IFOUR
  181. C____________________________________________________________________
  182. C
  183. C DEBUT DE LA BOUCLE SUR LES DIFFERENTES ZONES
  184. C____________________________________________________________________
  185. C
  186. DO 500 ISOUS=1,NSOUS
  187. IMODEL=KMODEL(ISOUS)
  188. IPMAIL=IMAMOD
  189. CONCHE(ISOUS)=CONSTI
  190. CONM =CONMOD
  191. NBEL =IPMAIL.NUM(/2)
  192. NBNN =IPMAIL.NUM(/1)
  193. C____________________________________________________________________
  194. C
  195. C INFORMATION SUR L'ELEMENT FINI
  196. C____________________________________________________________________
  197. C
  198. MELE=IPMAIL.ITYPEL
  199. IF(infmod(/1).lt.7) then
  200. CALL ELQUOI(MELE,0,5,IPINF,IMODEL)
  201. IF (IERR.NE.0) THEN
  202. GOTO 9999
  203. ENDIF
  204. INFO=IPINF
  205. MINTE=INFELL(11)
  206. segsup INFO
  207. ELSE
  208. minte=infmod(7)
  209. ENDIF
  210. C
  211. C COMPLEMENT MCHELM
  212. C
  213. IMACHE(ISOUS)=IPMAIL
  214. C
  215. INFCHE(ISOUS,1)=0
  216. INFCHE(ISOUS,2)=0
  217. INFCHE(ISOUS,3)=NIFOUR
  218. INFCHE(ISOUS,4)=MINTE
  219. INFCHE(ISOUS,5)=0
  220. INFCHE(ISOUS,6)=5
  221. C____________________________________________________________________
  222. C
  223. C KOMCHA DANS LE CAS DU CHAMP DE LONGUEUR CHARAC
  224. C____________________________________________________________________
  225. C
  226. IF(IXLONG.NE.0)THEN
  227. CALL KOMCHA(IXLONG,IPMAIL,CONM,NOMLAR,MOTYPE,1,INFOS,3,IVALAR)
  228. IF (IERR.NE.0) THEN
  229. NOMID=NOMLAR
  230. NOTYPE=MOTYPE
  231. SEGSUP,NOMID,NOTYPE
  232. GOTO 9999
  233. ENDIF
  234. ENDIF
  235. C
  236. C____________________________________________________________________
  237. C
  238. C TAILLE DES MELVAL A ALLOUER ET ALLOCATION
  239. C____________________________________________________________________
  240. C
  241. C
  242. C CREATION DU MCHAML DE LA SOUS ZONE
  243. C
  244. IF(ICLE.EQ.1)N2=4
  245. IF(ICLE.EQ.2.OR.ICLE.EQ.3)N2=5
  246. IF(ICLE.EQ.4.OR.ICLE.EQ.5)N2=6
  247. SEGINI,MCHAML
  248. ICHAML(ISOUS)=MCHAML
  249. C
  250. C CREATION DU PREMIER MELVAL
  251. C
  252. C 'NLAR' : DONNE LA LONGUEUR CARACTERISTIQUE
  253. C
  254. C CE MELVAL EST CONSTANT DANS CHAQUE SS_ZONE
  255. C
  256. NOMCHE(1)='NLAR'
  257. TYPCHE(1)='REAL*8'
  258. N2PTEL=0
  259. N2EL=0
  260. C
  261. IF(IXLONG.NE.0)THEN
  262. MPTVAL=IVALAR
  263. MELVAL=IVAL(1)
  264. SEGINI,MELVA1=MELVAL
  265. IELVAL(1)=MELVA1
  266. CALL DTMVAL(IVALAR,2)
  267. ELSE
  268. C
  269. N1PTEL=1
  270. N1EL=1
  271. SEGINI,MELVAL
  272. IELVAL(1)=MELVAL
  273. VELCHE(1,1)=XLONG
  274. C
  275. ENDIF
  276. C
  277. C
  278. C CREATION DU DEUXIEME MELVAL
  279. C
  280. C 'PMOD' : POINTE SUR UN MODELE INDIQUANT LES ZONES GEOMETRIQUE
  281. C
  282. C CE MELVAL EST CONSTANT DANS CHAQUE SS_ZONE
  283. C
  284. N1PTEL=0
  285. N1EL=0
  286. N2PTEL=1
  287. N2EL=1
  288. NOMCHE(2)='PMOD'
  289. TYPCHE(2)='POINTEURMMODEL '
  290. SEGINI MELVAL
  291. IELVAL(2)=MELVAL
  292. IELCHE(1,1)=MMODEL
  293. C
  294. C
  295. C 'NPNI' : POINTE SUR UN LISTENTI CONTENANT LE NUMERO DE IMODEL
  296. C ACCESSIBLE POUR CHAQUE ELEMENT
  297. C 'NPLI' : POINTE SUR UN LISTENTI CONTENANT UNE LINKED LISTE
  298. C DES ELEMENTS ACCESSIBLES SUR CHAQUE ZONES
  299. C
  300. C
  301. N1EL=0
  302. N1PTEL=0
  303. N2PTEL=1
  304. N2EL=NBEL
  305. NOMCHE(3)='NPNI'
  306. TYPCHE(3)='POINTEURLISTENTI'
  307. SEGINI,MELVAL
  308. IELVAL(3)=MELVAL
  309. NOMCHE(4)='NPLI'
  310. TYPCHE(4)='POINTEURLISTENTI'
  311. SEGINI,MELVAL
  312. IELVAL(4)=MELVAL
  313. C
  314. C
  315. C 'POT1' : POINTE SUR UN OBJET DE TYPE POINT
  316. C
  317. C CE MELVAL EST CONSTANT DANS CHAQUE SS_ZONE
  318. C
  319. IF(ICLE.NE.1)THEN
  320. N1PTEL=0
  321. N1EL=0
  322. N2PTEL=1
  323. N2EL=1
  324. NOMCHE(5)='POT1'
  325. TYPCHE(5)='POINTEURPOINT '
  326. SEGINI MELVAL
  327. IELVAL(5)=MELVAL
  328. IELCHE(1,1)=JPT1
  329. ENDIF
  330. C
  331. C
  332. C 'POT2' : POINTE SUR UN OBJET DE TYPE POINT
  333. C
  334. C CE MELVAL EST CONSTANT DANS CHAQUE SS_ZONE
  335. C
  336. IF(ICLE.EQ.4)THEN
  337. N1PTEL=0
  338. N1EL=0
  339. N2PTEL=1
  340. N2EL=1
  341. NOMCHE(6)='POT2'
  342. TYPCHE(6)='POINTEURPOINT '
  343. SEGINI MELVAL
  344. IELVAL(6)=MELVAL
  345. IELCHE(1,1)=JPT2
  346. ENDIF
  347. C
  348. C 'DISP' : DONNE LA DISTANCE AU PLAN
  349. C
  350. C CE MELVAL EST CONSTANT DANS CHAQUE SS_ZONE
  351. C
  352. IF(ICLE.EQ.5)THEN
  353. N2PTEL=0
  354. N2EL=0
  355. N1PTEL=1
  356. N1EL=1
  357. NOMCHE(6)='DISP'
  358. TYPCHE(6)='REAL*8'
  359. SEGINI,MELVAL
  360. IELVAL(6)=MELVAL
  361. VELCHE(1,1)=D
  362. ENDIF
  363. C
  364. C____________________________________________________________________
  365. C
  366. C BOUCLE SUR LES ELEMENTS DE LA SS ZONE
  367. C____________________________________________________________________
  368. C
  369. SEGINI,WRK1
  370. DO 499 IB=1,NBEL
  371. C
  372. C ON CHERCHE LA LONGUEUR MAX SUR L'ELEMENT
  373. C
  374. IF(IXLONG.NE.0)THEN
  375. MELVAL=IELVAL(1)
  376. XLONGM=0.D0
  377. NBGLAR=VELCHE(/1)
  378. DO IGAU=1,NBGLAR
  379. XLONGM=MAX(XLONGM,VELCHE(IGAU,MIN(IB,VELCHE(/2))))
  380. ENDDO
  381. XLONG2=(XMULTL*XLONGM)**2
  382. ENDIF
  383. C
  384. C ON CHERCHE LES COORDONNEES DES NOEUDS DE L ELEMENT IB
  385. C
  386. CALL DOXE(XCOOR,IDIM,NBNN,IPMAIL.NUM,IB,XE)
  387. C
  388. C SI L'ELEMENT EST A PLUS DE XLONG D'UNE SYMETRIE IL
  389. C N'Y A PAS DE CONNECTIVITE POSSIBLE
  390. C
  391. XXL2M=0.D0
  392. IF(ICLE.EQ.3)CALL DISYPT(XE,NBNN,PT1, XXL2M)
  393. IF(ICLE.EQ.4)CALL DISYDR(XE,NBNN,PT1,PT2, XXL2M)
  394. IF(ICLE.EQ.5)CALL DISYPL(XE,NBNN,PT1,D , XXL2M)
  395. IF(XXL2M.GE.XLONG2)THEN
  396. MELVAL=IELVAL(3)
  397. IELCHE(1,IB)=0
  398. MELVAL=IELVAL(4)
  399. IELCHE(1,IB)=0
  400. ELSE
  401. C
  402. C CREATION DU PREMIER LISTENTI
  403. C
  404. JG=0
  405. SEGINI MLNIMO
  406. MELVAL=IELVAL(3)
  407. IELCHE(1,IB)=MLNIMO
  408. C
  409. C CREATION DU DDUXIEME LISTENTI
  410. C
  411. JG=0
  412. SEGINI,MLENTI
  413. MELVAL=IELVAL(4)
  414. IELCHE(1,IB)=MLENTI
  415. C____________________________________________________________________
  416. C
  417. C DEBUT DE LA BOUCLE SUR LES DIFFERENTES ZONES ACCESSIBLES
  418. C____________________________________________________________________
  419. C
  420. DO 450 ISOUSJ=1,NSOUS
  421. IMODE1=KMODEL(ISOUSJ)
  422. IPT1=IMODE1.IMAMOD
  423. NBELEJ=IPT1.NUM(/2)
  424. NBNJ =IPT1.NUM(/1)
  425. * PV faux et non utilisé MINTE =INFCHE(4,ISOUSJ)
  426. C____________________________________________________________________
  427. C
  428. C BOUCLE SUR LES ELEMENTS DE LA SS ZONE
  429. C____________________________________________________________________
  430. C
  431. SEGINI,WRK2
  432. JG=0
  433. SEGINI,MLNUEL
  434. DO 449 IBJ=1,NBELEJ
  435. C
  436. C ON CHERCHE LES COORDONNEES DES NOEUDS DE L ELEMENT IBJ(ISOUSJ)
  437. C
  438. CALL DOXE(XCOOR,IDIM,NBNJ,IPT1.NUM,IBJ,XEJ)
  439. C
  440. C ON TRANSFORME CES COORDONNEES EN FONCTION DES SYMETRIE OU DE LA
  441. C TRANSLATION
  442. C
  443. IF(ICLE.EQ.2)CALL TRTRVE(XEJ,NBNJ,PT1 )
  444. IF(ICLE.EQ.3)CALL TRSYPT(XEJ,NBNJ,PT1 )
  445. IF(ICLE.EQ.4)CALL TRSYDR(XEJ,NBNJ,PT1,PT2)
  446. IF(ICLE.EQ.5)CALL TRSYPL(XEJ,NBNJ,PT1,D )
  447.  
  448. C
  449. C ON CHERCHE SI UN DES NOEUDS DE XE SE TROUVE A MOINS DE
  450. C XLONG DE L'UN DES NOEUDS DE XEJ
  451. C
  452. DO 4 IE1=1,NBNN
  453. DO 4 IE2=1,NBNJ
  454. XXLON2=0.D0
  455. DO 3 IE3=1,IDIM
  456. XXLON2=XXLON2+(XE(IE3,IE1)-XEJ(IE3,IE2))**2
  457. 3 CONTINUE
  458. IF(XXLON2.LT.XLONG2)GOTO 6
  459. 4 CONTINUE
  460. GOTO 449
  461. C
  462. C SI C'EST VRAI, ON NOTE LE NUMERO DE L'ELEMENT DANS MLNUEL
  463. C
  464. 6 JG=JG+1
  465. SEGADJ,MLNUEL
  466. MLNUEL.LECT(JG)=IBJ
  467. 449 CONTINUE
  468. C
  469. C NOMBRE D'ELEMENTS ACCESSIBLES
  470. C
  471. NELEAC=JG
  472. SEGSUP,WRK2
  473. C
  474. C SI MLNUEL N'EST PAS VIDE, ON INFORME MLNIMO ET MLENTI
  475. C
  476. IF(NELEAC.GT.0)THEN
  477. NSZA=MLNIMO.LECT(/1)
  478. JG=NSZA+1
  479. SEGADJ,MLNIMO
  480. MLNIMO.LECT(JG)=ISOUSJ
  481. JG1=LECT(/1)
  482. JG=JG1+NELEAC+1
  483. SEGADJ,MLENTI
  484. LECT(JG1+1)=NELEAC
  485. DO IELEAC=1,NELEAC
  486. IG1=JG1+1+IELEAC
  487. LECT(IG1)=MLNUEL.LECT(IELEAC)
  488. C print*,'elemnt acc',lect(ig1)
  489. END DO
  490. ENDIF
  491. SEGSUP,MLNUEL
  492. 450 CONTINUE
  493. C
  494. C ON VERIFIE LA PRESENCE DE CONNECTIVITE ET ON MET EVENTUELLEMENT
  495. C LES POINTEURS A ZERO
  496. C
  497. NSZA=MLNIMO.LECT(/1)
  498. IF(NSZA.EQ.0)THEN
  499. SEGSUP,MLNIMO,MLENTI
  500. MELVAL=IELVAL(3)
  501. IELCHE(1,IB)=0
  502. MELVAL=IELVAL(4)
  503. IELCHE(1,IB)=0
  504. ELSE
  505. SEGDES,MLNIMO
  506. SEGDES,MLENTI
  507. ENDIF
  508. ENDIF
  509. C
  510. 499 CONTINUE
  511. SEGSUP,WRK1
  512. C____________________________________________________________________
  513. C
  514. C DESACTIVATION DES SEGMENTS PROPRES A LA ZONE GEOMETRIQUE ISOUS
  515. C____________________________________________________________________
  516. C
  517. * INFO=IPINF
  518. * SEGSUP,INFO
  519. MELVAL=IELVAL(1)
  520. SEGDES,MELVAL
  521. MELVAL=IELVAL(2)
  522. SEGDES,MELVAL
  523. MELVAL=IELVAL(3)
  524. SEGDES,MELVAL
  525. MELVAL=IELVAL(4)
  526. SEGDES,MELVAL
  527. SEGDES,MCHAML
  528. 500 CONTINUE
  529. C____________________________________________________________________
  530. C
  531. C DESACTIVATION DES CHAMPS GLOBAUX
  532. C____________________________________________________________________
  533. C
  534. SEGDES,MCHELM
  535. C
  536. DO 8 IE1=1,NSOUS
  537. IMODEL=KMODEL(IE1)
  538. IPMAIL=IMAMOD
  539. C PRINT*,IE1,IMODEL,IPMAIL
  540. SEGDES,IMODEL
  541. SEGDES,IPMAIL
  542. 8 CONTINUE
  543. SEGDES,MMODEL
  544. C
  545. IF(IXLONG.NE.0)THEN
  546. NOMID=NOMLAR
  547. NOTYPE=MOTYPE
  548. SEGSUP,NOMID,NOTYPE
  549. ENDIF
  550. C
  551. RETURN
  552. C____________________________________________________________________
  553. C
  554. C ERREUR DANS UNE SOUS ZONE, DESACTIVATION ET RETOUR
  555. C____________________________________________________________________
  556. C
  557. 9999 CONTINUE
  558. IF(ISOUS.GT.1)THEN
  559. DO 9991 IE1=1,ISOUS
  560. CALL DTSHAM(ICHAML(IE1))
  561. 9991 CONTINUE
  562. ENDIF
  563. SEGSUP,MCHELM
  564. IPCHCO=0
  565. IRET=0
  566. C
  567. DO 10 IE1=1,NSOUS
  568. IMODEL=KMODEL(IE1)
  569. IPMAIL=IMAMOD
  570. SEGDES,IPMAIL,IMODEL
  571. 10 CONTINUE
  572. SEGDES,MMODEL
  573. RETURN
  574. END
  575.  
  576.  
  577.  
  578.  
  579.  
  580.  
  581.  
  582.  
  583.  
  584.  
  585.  
  586.  
  587.  
  588.  
  589.  

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