Télécharger numop1.eso

Retour à la liste

Numérotation des lignes :

  1. C NUMOP1 SOURCE CHAT 05/01/13 02:03:25 5004
  2. C RACINE DE LA NUMEROTATION POUR LA SORTIE SUR FAC
  3. C
  4. C methode utilisee: NESTED DISSECTION & MULTIFRONTALE
  5.  
  6. C ce programme decompose un domaine d'etude par elements finis
  7. C et utilise ensuite la methode multifrontale.
  8.  
  9.  
  10. SUBROUTINE NUMOP1(MELEME,ICPR,NODES)
  11. IMPLICIT INTEGER(I-N)
  12. -INC SMELEME
  13. -INC SMCOORD
  14. -INC CCOPTIO
  15.  
  16. SEGMENT JMEM(NODES+1),JMEMN(NODES+1)
  17. C JMEM et JMEMN contiennent le nombre d'elements auquel appartient
  18. C un noeud
  19.  
  20. SEGMENT JNT(NODES),NUMERO(NODES)
  21. C JNT contient la nouvelle numerotation
  22.  
  23. SEGMENT ICPR(XCOOR(/1)/(IDIM+1))
  24. C ICPR au debut contient l'ancienne numerotation,
  25. C a la fin la nouvelle.
  26.  
  27. SEGMENT IADJ(NODES+1),IVOIS(0)
  28. SEGMENT NPVOIS(2*NBENS),NVOIS(0)
  29. C IADJ(i) pointe sur IVOIS qui contient les voisins de i entre
  30. C IADJ(i) et IADJ(i+1)-1
  31.  
  32. SEGMENT LAGRAN(NB)
  33. C contient les noeud de lagrange et les noeuds les suivant directement
  34. C cf element de type 22
  35. SEGMENT INVLAG(NB1)
  36.  
  37. SEGMENT BOOLEEN
  38. LOGICAL BOOL(NODES)
  39. ENDSEGMENT
  40. C BOOL(i) = true si le noeud i a etait deja memtioner dans la liste
  41. C des voisin IVOIS
  42.  
  43. SEGMENT IMEMOIR(NBV)
  44. C contient les element appartenant a chaque noeud,sous forme de liste,
  45. C au premier, puis au second, etc...
  46.  
  47. INTEGER ELEM
  48. C nom d'un element
  49.  
  50. INTEGER N,NBENS
  51.  
  52. SEGMENT MASQUE
  53. LOGICAL MASQ(NODES)
  54. ENDSEGMENT
  55. C MASQ(X)=.TRUE. si le noeud X n'a pas ete renumerote;
  56. C .FALSE. si il l'a ete.
  57.  
  58. INTEGER DIM,DIMSEP
  59. C DIM= nombre de noeuds renumerotes.
  60.  
  61. INTEGER PIVOT
  62. C PIVOT est le noeud utile a la division du domaine.
  63.  
  64. SEGMENT IPOS(NODES*2)
  65. C est le vecteur contenant la numerotation dans les deux sens,de 1 a NODES
  66. C puis de NODES+1 a 2* NODES, cf la subroutine SEPAR
  67.  
  68. SEGMENT ICOMPT(NODES),IORDRE(2*NBENS)
  69.  
  70.  
  71.  
  72. C initialisation
  73. C*******************************
  74.  
  75.  
  76.  
  77. IENORM=2000000000
  78. C norme d'erreur.
  79.  
  80. NODES=XCOOR(/1)/(IDIM+1)
  81. SEGACT ICPR*MOD
  82. SEGACT MELEME
  83. C icpr: numero des noeuds.
  84. C meleme: objet de maillage (cf assem2.eso)
  85.  
  86. DO 10 I=1,ICPR(/1)
  87. 10 ICPR(I)=0
  88.  
  89. IPT1=MELEME
  90. IKOU=0
  91. NBV=0
  92. NB1=0
  93. NB2=0
  94.  
  95. DO 100 IO=1,MAX(1,LISOUS(/1))
  96. IF (LISOUS(/1).NE.0) THEN
  97. IPT1=LISOUS(IO)
  98. SEGACT IPT1
  99. ENDIF
  100. C on cree la numerotation des noeuds.
  101. C 'nb noeuds/element'=IPT1.NUM(/1)
  102. C 'nb element'=IPT1.NUM(/2)
  103. IF(IPT1.ITYPEL.EQ.22) THEN
  104. NB1=NB1+IPT1.NUM(/2)
  105. NB2=MAX(NB2,IPT1.NUM(/1))
  106. C NB1= nbre d'elements de type 22.
  107. C NB2=nbre de noeuds/element maximum parmi
  108. C les elements de type 22.
  109. ENDIF
  110. DO 150 I=1,IPT1.NUM(/1)
  111. DO 150 J=1,IPT1.NUM(/2)
  112. IJ=IPT1.NUM(I,J)
  113. C IJ est le Ieme noeud du Jeme element.
  114. IF (ICPR(IJ).NE.0) GOTO 150
  115. C s'il est deja numerote, on ne fait rien.
  116. IKOU=IKOU+1
  117. ICPR(IJ)=IKOU
  118. 150 CONTINUE
  119. NODES=IKOU
  120. C NODES= nbre de noeuds.
  121. 100 CONTINUE
  122.  
  123. NB=NB2*NB1
  124. C NB= dimension(LAGRAN).
  125.  
  126. C***** initalisation des segments*********
  127.  
  128. SEGINI IADJ,IVOIS,JMEM,JMEMN,LAGRAN
  129. SEGINI BOOLEEN,JNT
  130.  
  131. DO 20 I=1,NODES+1
  132. IADJ(I)=0
  133. JMEM(I)=0
  134. JMEMN(I)=0
  135. 20 CONTINUE
  136. C******************************************
  137.  
  138.  
  139.  
  140. IPT1=MELEME
  141. NGRAND=0
  142. IADJ(1)=1
  143. INC=0
  144.  
  145.  
  146. DO 200 IO=1,MAX(1,LISOUS(/1))
  147.  
  148. IF (LISOUS(/1).NE.0) THEN
  149. IPT1=LISOUS(IO)
  150. ENDIF
  151.  
  152. DO 210 J=1,IPT1.NUM(/2)
  153.  
  154. IF(IPT1.ITYPEL.EQ.22) THEN
  155. DO 220 I=1,IPT1.NUM(/1)
  156. C chaque element de type 22 a au plus NB2 noeuds.
  157. LAGRAN(INC*NB2+I)=ICPR(IPT1.NUM(I,J))
  158. C les noeuds de l'elements de type 22
  159. C sont ranges dans le vecteur LAGRAN.
  160. 220 CONTINUE
  161. DO 225 I=IPT1.NUM(/1)+1,NB2
  162. LAGRAN(INC*NB2+I)=0
  163. C comme on a alloue la place memeoire maximale,
  164. C on remplit les cases restantes avec des 0.
  165. 225 CONTINUE
  166. INC=INC+1
  167. C INC=le nbre d'elements de type 22.
  168. ENDIF
  169.  
  170. DO 230 I=1,IPT1.NUM(/1)
  171. IJ=ICPR(IPT1.NUM(I,J))+1
  172. JMEM(IJ)=JMEM(IJ)+1
  173. C JMEM(I+1): nb elements auquel le noeud I appartient
  174. 230 CONTINUE
  175.  
  176. 210 CONTINUE
  177.  
  178. NGRAND=MAX(NGRAND,IPT1.NUM(/2))
  179.  
  180. 200 CONTINUE
  181.  
  182.  
  183.  
  184. NGRAND=NGRAND+1
  185. JMEM(1)=1
  186. DO 30 I=1,NODES
  187. JMEM(I+1)=JMEM(I)+JMEM(I+1)
  188. C JMEM(I+1)=indice de depart des elements
  189. C auxquels le noeud I appartient.
  190. 30 CONTINUE
  191. NBV=JMEM(NODES+1)
  192. C NBV= dimension de IMEMOIR.
  193. SEGINI IMEMOIR
  194.  
  195.  
  196. IPT1=MELEME
  197.  
  198. IMATOT=LISOUS(/1)*(NGRAND+1)
  199. IF(IMATOT.GT.IENORM) THEN
  200. CALL ERREUR(382)
  201. RETURN
  202. ENDIF
  203.  
  204.  
  205.  
  206. DO 300 IO=1,MAX(1,LISOUS(/1))
  207. IF (LISOUS(/1).NE.0) THEN
  208. IPT1=LISOUS(IO)
  209. ENDIF
  210. DO 350 I=1,IPT1.NUM(/1)
  211. DO 350 J=1,IPT1.NUM(/2)
  212. JMEMN(ICPR(IPT1.NUM(I,J))+1)=JMEMN(ICPR(IPT1.NUM(I,J))+1)+1
  213. IMEMOIR(JMEM(ICPR(IPT1.NUM(I,J)))+
  214. & JMEMN(ICPR(IPT1.NUM(I,J))+1)-1)=J+IO*NGRAND
  215. C on range dans IMEMOIR tous les elements des sous-objets
  216. C IO auxquels appartient le noeud ICPR(IPT1.NUM(I,J)).
  217. C On connait pour chaque element, le sous-objet auquel
  218. C il appartient.
  219. 350 CONTINUE
  220. 300 CONTINUE
  221.  
  222.  
  223. DO 400 I=1,NODES
  224. IADJ(I+1)=IADJ(I)
  225. DO 410 J=1,NODES
  226. BOOL(J)=.FALSE.
  227. 410 CONTINUE
  228. DO 420 J=JMEM(I),JMEM(I+1)-1
  229. ELEM=IMEMOIR(J)
  230. C ELEM=element auquel appartient le noeud I.
  231.  
  232. IPT1=MELEME
  233. IF (LISOUS(/1).NE.0) IPT1=LISOUS(ELEM/NGRAND)
  234. ELEM=MOD(ELEM,NGRAND)
  235. DO 430 K=1,IPT1.NUM(/1)
  236. C k representatif du nb de noeuds par elements.
  237. IK=ICPR(IPT1.NUM(K,ELEM))
  238. IF ((I.NE.IK).AND.
  239. & (.NOT.(BOOL(IK)))) THEN
  240. C si i n'est pas egal a un des nouveaux numeros des noeuds
  241. C de l'element ELEM et si il n'appartient pas deja a l'ens des
  242. C voisins du noeud i(jadjc(i)),alors on le rajoute.
  243. C IVOIS(IADJ(I+1))=IK
  244. IVOIS(**)=IK
  245. IADJ(I+1)=IADJ(I+1)+1
  246. BOOL(IK)=.TRUE.
  247. ENDIF
  248. 430 CONTINUE
  249.  
  250.  
  251. 420 CONTINUE
  252. 400 CONTINUE
  253.  
  254. SEGSUP JMEM,JMEMN,BOOLEEN
  255. SEGSUP IMEMOIR
  256.  
  257.  
  258. C affectation
  259. C************************
  260.  
  261.  
  262. N=NODES
  263. SEGINI IPOS,MASQUE
  264.  
  265. DO 50 I=1,N
  266. MASQ(I)=.TRUE.
  267. IPOS(I)=0
  268. IPOS(NODES+I)=0
  269. 50 CONTINUE
  270. C initialement, les noeuds ne sont pas masques,ont donc
  271. C une position nulle.
  272.  
  273. DIM=0
  274. C le nombre de noeuds renumerotes DIM est initialement egal a zero.
  275.  
  276.  
  277. C ****************************************
  278. C boucle principale
  279. MPOS=0
  280. DO 500 I=1,N
  281.  
  282. 550 IF(.NOT.MASQ(I)) GOTO 500
  283. C si le noeud a ete renumerote, on passe au suivant.
  284.  
  285. PIVOT=I
  286. C sinon, il devient PIVOT.
  287.  
  288. CALL SEPAR(IADJ,IVOIS,PIVOT,MASQUE,DIMSEP,N,IPOS,NODES)
  289. C separe le domaine d'etude en 2 parties.
  290. C on decrit le domaine d'etude a partir du pivot et on cherche la
  291. C longueur maximale en decrivant les voisins de pivot, et leurs
  292. C voisins... jusqu'a rencontrer un voisin masque. On cree alors
  293. C une nouvelle separation.
  294. C les noeuds masques delimitent la separation du domaine.
  295.  
  296. DIM=DIM+DIMSEP
  297.  
  298. N=N-DIMSEP
  299.  
  300. IF (DIM.GE.NODES) GOTO 600
  301. C si tous les noeuds ont une position non nulle,on arrete.
  302.  
  303. GOTO 550
  304.  
  305. 500 CONTINUE
  306.  
  307. 600 SEGSUP MASQUE
  308. SEGINI NUMERO
  309.  
  310. CALL PREPA(IPOS,NPVOIS,NVOIS,NBENS,NUMERO,NODES,IADJ,IVOIS)
  311. C procedure donnant une nouvelle gestion de donnees.
  312. C NBENS= nbre d'ensembles.
  313. C un ensemble est compose de noeuds ayant meme NUMERO.
  314. C NPVOIS(I,2)-NPVOIS(I,1)-1=nbre d'ensemble voisins a l'ensemble I.
  315. C NVOIS(J), pour J compris entre NPVOIS(I,1) et NPVOIS(I,2)-1,
  316. C contient les ensembles voisins de I.
  317.  
  318. CALL MINDEG(NPVOIS,NVOIS,NBENS,IORDRE)
  319. C on recherche l'ensemble de minimum degre.
  320. C on le numerote et on recommence.
  321.  
  322. CALL SORTID(IADJ,IVOIS,IORDRE,NUMERO,NODES,NBENS,JNT)
  323. C JNT(I) est le nouveau numero du NOEUD I.
  324.  
  325. SEGSUP IORDRE
  326.  
  327. C******************************************************
  328. C insertion des lagrangiens.
  329. C******************************************************
  330. C principe: on cherche le premier noeud auquel s'applique les 2
  331. C coefficients de lagrange, on les insere de part et d'autre de
  332. C ce noeud dans la numerotation.
  333.  
  334. DO 1 I=1,NODES
  335. IPOS(JNT(I))=I
  336. 1 CONTINUE
  337.  
  338. IF(NB2.NE.0) THEN
  339. N=NB/NB2
  340. ELSE
  341. N=0
  342. ENDIF
  343.  
  344. DO 700 I=1,NODES
  345. NOEUD=IPOS(I)
  346. IF (NOEUD.EQ.0) GOTO 700
  347. DO 750 J=0,N-1
  348. IF(NOEUD.EQ.LAGRAN(J*NB2+1)) THEN
  349. IPOS(NODES+NOEUD)=0
  350. GOTO 700
  351. ENDIF
  352.  
  353. IF(NOEUD.EQ.LAGRAN(J*NB2+2)) THEN
  354. IPOS(NODES+NOEUD)=0
  355. GOTO 700
  356. ENDIF
  357. 750 CONTINUE
  358. IPOS(NODES+NOEUD)=I-NORME
  359. C IPOS(NODES+NOEUD)= numero d'elimination obtenu en tenant
  360. C compte des lagrangiens.
  361.  
  362. 700 CONTINUE
  363.  
  364. NCOMPT=0
  365. NORM=0
  366. SEGINI ICOMPT,INVLAG
  367.  
  368. DO 800 I=1,NODES
  369.  
  370. NOEUD=IPOS(I)
  371. C NOEUD =Ieme noeud elimine.
  372.  
  373. IF(IPOS(NODES+NOEUD).EQ.0) GOTO 800
  374.  
  375. ICOMPT(NOEUD)=0
  376.  
  377. DO 850 J=0,NB1-1
  378. IF(LAGRAN(J*NB2+1).NE.0) THEN
  379. K=3
  380. 855 IF((K.LE.NB2).AND.(LAGRAN(J*NB2+K).NE.0)) THEN
  381.  
  382. IF(NOEUD.EQ.LAGRAN(J*NB2+K)) THEN
  383.  
  384. INVLAG(ICOMPT(NOEUD)+1)=J
  385. C INVLAG mémorise l'élément de type 22.
  386.  
  387. C on change le numero d'élimination de noeud,
  388. C en insérant de part et d'autre les coef de lagrange.
  389.  
  390. JNT(LAGRAN(J*NB2+1))=
  391. & IPOS(NOEUD+NODES)+NORM-ICOMPT(NOEUD)
  392.  
  393. LAGRAN(J*NB2+1)=0
  394. C permet de savoir si le lagrangien a ete insere.
  395.  
  396. NORM=NORM+1
  397. JNT(NOEUD)=
  398. & IPOS(NODES+NOEUD)+NORM-ICOMPT(NOEUD)
  399. C renumerotation de noeud.
  400.  
  401. DO 852 IJ=1,ICOMPT(NOEUD)
  402. IL=INVLAG(IJ)
  403. JNT(LAGRAN(IL*NB2+2))=JNT(LAGRAN(IL*NB2+2))+1
  404. 852 CONTINUE
  405.  
  406. NORM=NORM+1
  407. JNT(LAGRAN(J*NB2+2))=IPOS(NODES+NOEUD)+NORM
  408. ICOMPT(NOEUD)=ICOMPT(NOEUD)+1
  409. GOTO 850
  410. ELSE
  411. K=K+1
  412. GOTO 855
  413. ENDIF
  414.  
  415. ENDIF
  416.  
  417. ENDIF
  418.  
  419. 850 CONTINUE
  420.  
  421. IF(ICOMPT(NOEUD).EQ.0) THEN
  422. JNT(NOEUD)=IPOS(NODES+NOEUD)+NORM
  423. ENDIF
  424.  
  425. 800 CONTINUE
  426.  
  427. SEGSUP INVLAG
  428. C******************************************************************
  429. DO 860 I=1,XCOOR(/1)/(IDIM+1)
  430. IF(ICPR(I).NE.0) THEN
  431. ICPR(I)=JNT(ICPR(I))
  432. C numerotation finale.
  433. ENDIF
  434. 860 CONTINUE
  435.  
  436. SEGSUP IADJ,IVOIS,JNT,IPOS,ICOMPT,NUMERO
  437. SEGSUP LAGRAN,NPVOIS,NVOIS
  438.  
  439. RETURN
  440. END
  441.  
  442.  
  443.  

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