Télécharger part2.eso

Retour à la liste

Numérotation des lignes :

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

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