Télécharger part2.eso

Retour à la liste

Numérotation des lignes :

  1. C PART2 SOURCE PV 20/03/30 21:21:57 10567
  2. C partition de domaine
  3. C
  4. C methode utilisee: Monte Carlo avec fonction de cout
  5. C dérivé de numop2
  6. C
  7. SUBROUTINE PART2(MELEME,IPOS,NB,ICPR,IADJ,JADJC)
  8. IMPLICIT INTEGER(I-N)
  9. -INC SMELEME
  10. -INC SMCOORD
  11.  
  12. -INC PPARAM
  13. -INC CCOPTIO
  14. -INC CCASSIS
  15.  
  16.  
  17. SEGMENT JMEM(NODES+1),JMEMN(NODES+1)
  18. C JMEM et JMEMN contiennent le nombre d'element auquel appartient un noeud
  19.  
  20. SEGMENT JNT(NODES)
  21. C JNT contient la nouvelle numerotation
  22.  
  23. SEGMENT ICPR(nbpts)
  24. C ICPR au debut contient l'ancienne numerotation ,
  25. C a la fin la nouvelle.
  26.  
  27. SEGMENT IADJ(NODES+1)
  28. SEGMENT JADJC(0)
  29. C IADJ(i) pointe sur JADJC qui contient les voisins de i entre
  30. C IADJ(i) et IADJ(i+1)-1
  31.  
  32. SEGMENT BOOLEEN
  33. LOGICAL BOOL(NODES)
  34. ENDSEGMENT
  35. C BOOL(i) = true si le noeud i a ete deja mentionne dans la liste
  36. C des voisins JADJC.
  37.  
  38. SEGMENT IMEMOIR(NBV),LMEMOIR(NBV)
  39. C contient les elements appartenant a chaque noeud,sous forme de liste.
  40.  
  41. INTEGER ELEM
  42. C nom d'un element
  43.  
  44. INTEGER N
  45.  
  46.  
  47. SEGMENT MASQUE
  48. LOGICAL MASQ(NODES)
  49. ENDSEGMENT
  50. C MASQ(X)=.TRUE. si le noeud X n'a pas ete renumerote;
  51. C .FALSE. si il l'a ete.
  52.  
  53. INTEGER DIM,DIMSEP
  54. C DIM= nombre de noeuds renumerotes.
  55.  
  56. INTEGER PIVOT
  57. C PIVOT est le noeud utile a la division du domaine.
  58.  
  59. SEGMENT IPOS(NODES*3)
  60. C est le vecteur contenant le numero de zone et le poid de la zone a NODES
  61. C puis de NODES+1 a 2* NODES, cf la subroutine SEPAR
  62. C
  63. C segments utilisés dans sepa2
  64. C
  65. SEGMENT NRELONG(NODES*nbthr)
  66. C NRELONG contient pour chaque noeud sa profondeur.
  67.  
  68. SEGMENT NOELON(NODES*nbthr)
  69. SEGMENT NOEL2(NODES)
  70. SEGMENT LONDIM(NODES*nbthr)
  71. C NOELON contient les noeuds de profondeur LONG.
  72. C DIMLON= dimension de NOELON.
  73. c
  74. C**********************************
  75.  
  76. C debut du program
  77.  
  78. C**********************************
  79.  
  80.  
  81.  
  82. C initialisation
  83. C*******************************
  84. IUN=1
  85. IENORM=2000000000
  86. C norme d'erreur
  87. SEGINI ICPR
  88. NODES=ICPR(/1)
  89. SEGACT MELEME
  90. C icpr: numero des noeuds.
  91.  
  92. IPT1=MELEME
  93. IKOU=0
  94. NBV=0
  95. NB1=0
  96. NB2=0
  97.  
  98. DO 100 IO=1,MAX(1,LISOUS(/1))
  99. IF (LISOUS(/1).GT.0) THEN
  100. IPT1=LISOUS(IO)
  101. SEGACT IPT1
  102. ENDIF
  103. C on cree la numerotation des noeuds.
  104. C 'nb noeuds/element'=IPT1.NUM(/1)
  105. C 'nb element'=IPT1.NUM(/2)
  106. IF(IPT1.ITYPEL.EQ.22) THEN
  107. NB1=NB1+IPT1.NUM(/2)
  108. NB2=MAX(NB2,IPT1.NUM(/1))
  109. C NB1= nbre d'éléments de type 22.
  110. C NB2=nbre de noeuds/élément maximum parmi
  111. C les éléments de type 22.
  112. ENDIF
  113. DO 150 J=1,IPT1.NUM(/2)
  114. DO 150 I=1,IPT1.NUM(/1)
  115. IJ=IPT1.NUM(I,J)
  116. C IJ est le Ième noeud du Jème élément.
  117. IF (ICPR(IJ).EQ.0) THEN
  118. C s'il est déjà numéroté, on ne fait rien.
  119. IKOU=IKOU+1
  120. ICPR(IJ)=IKOU
  121. ENDIF
  122. 150 CONTINUE
  123. 100 CONTINUE
  124.  
  125. NODES=IKOU
  126.  
  127. C***** initalisation des segments*********
  128.  
  129. SEGINI IADJ,JADJC,JMEM,JMEMN
  130. SEGINI BOOLEEN,JNT
  131.  
  132. DO 20 I=1,NODES+1
  133. IADJ(I)=0
  134. JMEM(I)=0
  135. JMEMN(I)=0
  136. 20 CONTINUE
  137.  
  138. C******************************************
  139.  
  140. IPT1=MELEME
  141. NGRAND=0
  142. IADJ(1)=1
  143. INC=0
  144. DO 200 IO=1,MAX(1,LISOUS(/1))
  145.  
  146. IF (LISOUS(/1).NE.0) THEN
  147. IPT1=LISOUS(IO)
  148. ENDIF
  149.  
  150. DO 210 J=1,IPT1.NUM(/2)
  151.  
  152. DO 230 I=1,IPT1.NUM(/1)
  153. IJ=ICPR(IPT1.NUM(I,J))+1
  154. JMEM(IJ)=JMEM(IJ)+1
  155. C JMEM(I+1): nb elements auquel le noeud I appartient
  156. 230 CONTINUE
  157. 210 CONTINUE
  158. NGRAND=MAX(NGRAND,IPT1.NUM(/2))
  159.  
  160. 200 CONTINUE
  161.  
  162. NGRAND=NGRAND+1
  163.  
  164. JMEM(1)=1
  165. DO 30 I=1,NODES
  166. JMEM(I+1)=JMEM(I)+JMEM(I+1)
  167. C JMEM(I+1)=indice de depart des elements
  168. C auxquels le noeud I appartient.
  169. 30 CONTINUE
  170. NBV=JMEM(NODES+1)
  171. C NBV= dimension de IMEMOIR.
  172. SEGINI IMEMOIR,LMEMOIR
  173.  
  174.  
  175.  
  176. IPT1=MELEME
  177.  
  178. DO 300 IO=1,MAX(1,LISOUS(/1))
  179. IF (LISOUS(/1).NE.0) THEN
  180. IPT1=LISOUS(IO)
  181. ENDIF
  182. DO 350 J=1,IPT1.NUM(/2)
  183. DO 350 I=1,IPT1.NUM(/1)
  184. IJ=ICPR(IPT1.NUM(I,J))
  185. JMEMN(IJ+1)=JMEMN(IJ+1)+1
  186. IMEMOIR(JMEM(IJ)+JMEMN(IJ+1)-1)=J
  187. LMEMOIR(JMEM(IJ)+JMEMN(IJ+1)-1)=IO
  188. C on range dans IMEMOIR tous les elements des sous-objets
  189. C IO auxquels appartient le noeud ICPR(IPT1.NUM(I,J)).
  190. C On connait pour chaque element, le sous-objet auquel
  191. C il appartient.
  192. 350 CONTINUE
  193. 300 CONTINUE
  194.  
  195. DO 410 J=1,NODES
  196. BOOL(J)=.FALSE.
  197. 410 CONTINUE
  198. DO 400 I=1,NODES
  199. IADJ(I+1)=IADJ(I)
  200. DO 420 J=JMEM(I),JMEM(I+1)-1
  201. ELEM=IMEMOIR(J)
  202. C ELEM=element auquel appartient le noeud I.
  203.  
  204. IPT1=MELEME
  205. IF (LISOUS(/1).NE.0) IPT1=LISOUS(LMEMOIR(J))
  206. DO 430 K=1,IPT1.NUM(/1)
  207. C k representatif du nb de noeuds par elements.
  208. IK=ICPR(IPT1.NUM(K,ELEM))
  209. IF ((I.NE.IK).AND.
  210. & (.NOT.(BOOL(IK)))) THEN
  211. C si i n'est pas egal a un des nouveaux numeros des noeuds
  212. C de l'element ELEM et si il n'appartient pas deja a l'ens des
  213. C voisins du noeud i(jadjc(i)),alors on le rajoute.
  214. C JADJC(IADJ(I+1))=IK
  215. JADJC(**)=IK
  216. IADJ(I+1)=IADJ(I+1)+1
  217. BOOL(IK)=.TRUE.
  218. ENDIF
  219. 430 CONTINUE
  220. 420 CONTINUE
  221. * remise a faux de bool
  222. DO 412 J=IADJ(I),IADJ(I+1)-1
  223. IK=JADJC(J)
  224. BOOL(IK)=.FALSE.
  225. 412 CONTINUE
  226. 400 CONTINUE
  227.  
  228. SEGSUP JMEM,JMEMN,IMEMOIR,LMEMOIR,BOOLEEN
  229.  
  230.  
  231.  
  232. C**************************************************************************
  233.  
  234.  
  235. C affectation
  236. C************************
  237.  
  238.  
  239. SEGINI IPOS,MASQUE
  240. IPOSMAX=0
  241.  
  242. DO 50 I=1,NODES
  243. MASQ(I)=.TRUE.
  244. IPOS(I)=0
  245. IPOS(NODES+I)=0
  246. IPOS(2*NODES+I)=0
  247. 50 CONTINUE
  248. C initialement, les noeuds ne sont pas masques,ont donc
  249. C une position nulle.
  250.  
  251. DIM=0
  252. C le nombre de noeuds renumerotes DIM est initialement egal a zero.
  253.  
  254.  
  255. C ****************************************
  256. C boucle principale
  257. NS=NODES
  258.  
  259. nbthr=max(1,nbthrs)
  260. nbthr=min(64,nbthr)
  261. if (nbthr.gt.1) call threadii
  262. SEGINI NRELONG,NOELON,noel2,londim
  263. ** write (6,*) ' avant appel sepa2 '
  264. DO 500 I=1,NODES
  265. 550 IF (ipos(i+2*nodes).eq.nb) masq(i)=.false.
  266. ** write (6,*) ' part2 i ipos nb ',i,ipos(i+2*nodes),nb
  267. IF(.NOT.MASQ(I)) GOTO 500
  268. C si le noeud est masque alors ne rien faire: il est deja
  269. C renumerote. On passe au noeud suivant.
  270.  
  271. PIVOT=I
  272. CALL SEPA2(IADJ,JADJC,PIVOT,MASQUE,DIMSEP,NS,
  273. > IPOS,NODES,IPOSMAX,nrelong,noelon,noel2,
  274. > londim,nbthr,IUN)
  275. C separe le domaine d'etude en 2 parties.
  276. C on decrit le domaine d'etude a partir du pivot et on cherche la
  277. C longueur maximale en decrivant les voisins de pivot, et leurs
  278. C voisins... jusqu'a rencontrer un voisin masque. On cree alors
  279. C une nouvelle separation.
  280. C les noeuds masques delimitent la separation du domaine.
  281. do ii=1,nodes
  282. IF (ipos(ii+2*nodes).eq.nb) masq(ii)=.false.
  283. enddo
  284.  
  285. DIM=DIM+DIMSEP
  286. NS=NS-DIMSEP
  287. C la dimension de noeuds renumerotes est augmente de DIMSEP.
  288. C Celle de noeuds a renumeroter est diminue de DIMSEP.
  289.  
  290. ***** IF (DIM.GE.NODES) GOTO 600
  291. C si tous les noeuds ont ete renumerotes, on arrete.
  292.  
  293. GOTO 550
  294.  
  295. 500 CONTINUE
  296. ** write (6,*) ' apres appel sepa2 '
  297.  
  298. SEGSUP NRELONG,NOELON,noel2,londim
  299. if (nbthr.gt.1) call threadis
  300.  
  301.  
  302. 600 SEGSUP MASQUE
  303. *
  304. * CALL SORTI2(IPOS,JNT,NODES)
  305. ** write (6,*) ' apres sorti2 '
  306.  
  307. SEGSUP JNT
  308.  
  309.  
  310. RETURN
  311. END
  312.  
  313.  
  314.  
  315.  
  316.  
  317.  
  318.  
  319.  
  320.  
  321.  
  322.  
  323.  
  324.  
  325.  
  326.  
  327.  
  328.  

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