Télécharger part5.eso

Retour à la liste

Numérotation des lignes :

  1. C PART5 SOURCE JC220346 16/11/21 21:15:03 9192
  2. C partitionne un MELEME dans ITAB en fonction de NBZON
  3. C
  4. SUBROUTINE PART5(MELEME,ITAB,NBZON,KESCL)
  5. C
  6. IMPLICIT INTEGER(I-N)
  7. IMPLICIT REAL*8 (A-H,O-Z)
  8.  
  9.  
  10. -INC SMELEME
  11. -INC CCOPTIO
  12. -INC SMTABLE
  13. -INC CCASSIS
  14.  
  15.  
  16. SEGMENT SSREF
  17. C ISREF : Tableau indiquant si la sous-zone contient ou non des elements
  18. C IMELE : Tableau avec les references des MELEME COMPLEXES de chaque ZONE
  19. C NBELE : Tableau avec le nombre d'elements du type en cours par ZONE
  20. C JSOUS : Tableau avec le nombre de Sous Ref par ZONE
  21. INTEGER ISREF(NBZON,NBSM)
  22. INTEGER IMELE(NBZON)
  23. INTEGER NBELE(NBZON)
  24. INTEGER JSOUS(NBZON)
  25. ENDSEGMENT
  26.  
  27.  
  28. C Declaration du COMMON pour le travail en parallele
  29. COMMON/part5c/NBTHR,SSREF,JA,IPT2,NBNN,NBELEM,ISOUS,NBZONE
  30.  
  31. EXTERNAL part5i
  32.  
  33. C Decompte du nombre d'elements dans le MELEME
  34. SEGACT MELEME
  35.  
  36. inn=0
  37. NBS = lisous(/1)
  38. NBSM=MAX(1,NBS)
  39. if(NBS.eq.0) then
  40. C MELEME SIMPLE
  41. inn = num(/2)
  42.  
  43. else
  44. C MELEME COMPLEXE
  45. do ia=1,NBS
  46. IPT2=lisous(ia)
  47. SEGACT,IPT2
  48. inn=inn + IPT2.num(/2)
  49. enddo
  50. endif
  51.  
  52.  
  53. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  54. C SI moins d'elements que de ZONES
  55. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  56. if(inn .LT. nbzon) NBZON=INN
  57.  
  58. NBZONE=NBZON
  59. M=NBZON
  60. IF (KESCL.GT.0) M=M+2
  61. SEGINI,MTABLE
  62. ITAB=MTABLE
  63. IF (KESCL.GT.0) THEN
  64. CALL ECCTAB(ITAB,'MOT',0,0.D0,'SOUSTYPE',.TRUE.,0
  65. & ,'MOT',0,0.D0,'ESCLAVE' ,.TRUE.,0)
  66. CALL ECCTAB(ITAB,'MOT',0,0.D0,'CREATEUR',.TRUE.,0,
  67. & 'MOT',0,0.D0,'PART' ,.TRUE.,0)
  68.  
  69. ENDIF
  70.  
  71. IF (NBTHRS .GT. 1) THEN
  72. ITHRD = 1
  73. CALL THREADII
  74. ELSE
  75. ITHRD = 0
  76. ENDIF
  77.  
  78. SEGINI,SSREF
  79. C Initialisations et Dimensionnement des MELEME
  80. DO 10 IZ=1,MAX(1,NBZON)
  81. C Creation des MELEME COMPLEXE
  82. nbnn=0
  83. nbelem=0
  84. nbref=0
  85. nbsous=NBSM
  86. SEGINI,IPT4
  87.  
  88. IPT2=MELEME
  89. JA=0
  90. JSOUS(IZ) = 0
  91. DO 20 isous=1,NBSM
  92. if (NBS .NE. 0) THEN
  93. IPT2=lisous(isous)
  94. endif
  95.  
  96. C Dimentionnement des MELEME SIMPLES a 1 element pres
  97. nbelem =(IPT2.num(/2) / nbzon) + 1
  98. nbnn = IPT2.num(/1)
  99. nbsous =0
  100. nbref =0
  101. SEGINI,IPT5
  102. IPT5.ITYPEL = IPT2.ITYPEL
  103.  
  104. C jf=0
  105. JA = JA + IPT2.num(/2)
  106.  
  107. C Sauvegarde des Tableaux pour la suite
  108. JSOUS(IZ) = JSOUS(IZ) + 1
  109. IPT4.LISOUS(ISOUS)=IPT5
  110. IMELE(IZ) = IPT4
  111. ISREF(IZ,isous) = 1
  112. 20 CONTINUE
  113. 10 CONTINUE
  114.  
  115. C Le MELEME en entree est parcouru et ses elements sont repartis dans les
  116. C bonnes ZONES
  117. IPT2=MELEME
  118. JA=0
  119. DO 30 isous=1,NBSM
  120. if (NBS .NE. 0) THEN
  121. IPT2=lisous(isous)
  122. endif
  123.  
  124. C Remise a zero du nombre d'elements pour cette Sous Ref
  125. DO IZ=1,MAX(1,NBZON)
  126. NBELE(IZ) = 0
  127. ENDDO
  128.  
  129. C On remplit ici le COMMON pour le travail en parallele
  130. NBNN = IPT2.num(/1)
  131. NBELEM = IPT2.num(/2)
  132. NBTHR = MIN(NBELEM,NBTHRS)
  133.  
  134. IF ((NBTHR .GT. 1) .AND. (ITHRD .EQ. 1)) THEN
  135. DO ith=2,NBTHR
  136. CALL THREADID(ith,part5i)
  137. ENDDO
  138. CALL part5i(1)
  139.  
  140. DO ith=2,NBTHR
  141. CALL THREADIF(ith)
  142. ENDDO
  143. C En multithread il peut y avoir n'importe quoi dans OOV(1)
  144. OOV(1) = 0
  145.  
  146. ELSE
  147. CALL part5i(1)
  148. ENDIF
  149.  
  150. JA = JA + IPT2.num(/2)
  151.  
  152. C Ajustement des MELEME SIMPLE pour toutes les ZONES si besoin
  153. DO IZ=1,MAX(1,NBZON)
  154. IPT4 = IMELE(IZ)
  155. IPT5 = IPT4.LISOUS(ISOUS)
  156.  
  157. IF(NBELE(IZ) .EQ. 0) THEN
  158. ISREF(IZ,ISOUS) = 0
  159. JSOUS(IZ) = JSOUS(IZ) - 1
  160. SEGSUP,IPT5
  161.  
  162. ELSEIF(NBELE(IZ) .EQ. (IPT5.NUM(/2) - 1) )THEN
  163. nbnn = IPT5.NUM(/1)
  164. nbelem = NBELE(IZ)
  165. nbref = 0
  166. nbsous = 0
  167. SEGADJ,IPT5
  168. SEGDES,IPT5
  169.  
  170. ELSE
  171. SEGDES,IPT5
  172.  
  173. ENDIF
  174.  
  175. ENDDO
  176.  
  177. 30 CONTINUE
  178.  
  179.  
  180. C Boucle Finale pour remplir la TABLE resultat
  181. DO 70 IZ=1,MAX(1,NBZON)
  182. C Recuperation du MELEME COMPLEXE
  183. IPT4 = IMELE(IZ)
  184.  
  185. C Retassement du MELEME COMPLEXE IPT4 et Ajustement si necessaire
  186. ISACT = 0
  187. nbsous = JSOUS(IZ)
  188. IF (nbsous .NE. NBSM) THEN
  189. DO ISOUS=1,NBSM
  190. IF( ISREF(IZ,ISOUS) .EQ. 1 )THEN
  191. ISACT = ISACT + 1
  192. IPT4.LISOUS(ISACT)=IPT4.LISOUS(ISOUS)
  193. ENDIF
  194. ENDDO
  195.  
  196. nbref = 0
  197. nbnn = 0
  198. nbelem = 0
  199. SEGADJ,IPT4
  200. ENDIF
  201.  
  202. C Reclassement en MELEME SIMPLE si une seule Sous-Zone
  203. if (nbsous .eq. 1) then
  204. IPT5=IPT4.LISOUS(1)
  205. SEGSUP,IPT4
  206. IPT4=IPT5
  207.  
  208. else
  209. SEGDES,IPT4
  210.  
  211. endif
  212.  
  213. CALL ECCTAB(ITAB,'ENTIER',IZ ,0.D0 ,' ',.TRUE.,
  214. & 0 ,'MAILLAGE',0,0.D0,' ',.TRUE.,IPT4)
  215.  
  216. 70 CONTINUE
  217.  
  218. IF (ITHRD .EQ. 1) CALL THREADIS
  219.  
  220. IF(NBS .GT. 0) THEN
  221. C MELEME COMPLEXE
  222. DO ia = 1,NBS
  223. IPT2=lisous(ia)
  224. SEGDES,IPT2
  225. ENDDO
  226. ENDIF
  227.  
  228. SEGDES,MELEME,MTABLE
  229. SEGSUP,SSREF
  230. RETURN
  231.  
  232. END
  233.  
  234.  
  235.  
  236.  
  237.  

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