Télécharger part5.eso

Retour à la liste

Numérotation des lignes :

  1. C PART5 SOURCE PV 18/11/19 21:15:20 9995
  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. LOGICAL BTHRD
  33.  
  34. C Decompte du nombre d'elements dans le MELEME
  35. SEGACT MELEME
  36.  
  37. inn=0
  38. NBS = lisous(/1)
  39. NBSM=MAX(1,NBS)
  40. if(NBS.eq.0) then
  41. C MELEME SIMPLE
  42. inn = num(/2)
  43.  
  44. else
  45. C MELEME COMPLEXE
  46. do ia=1,NBS
  47. IPT2=lisous(ia)
  48. SEGACT,IPT2
  49. inn=inn + IPT2.num(/2)
  50. enddo
  51. endif
  52.  
  53.  
  54. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  55. C SI moins d'elements que de ZONES
  56. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  57. if(inn .LT. nbzon) NBZON=INN
  58.  
  59. NBZONE=NBZON
  60. M=NBZON
  61. IF (KESCL.GT.0) M=M+2
  62. SEGINI,MTABLE
  63. ITAB=MTABLE
  64. IF (KESCL.GT.0) THEN
  65. CALL ECCTAB(ITAB,'MOT',0,0.D0,'SOUSTYPE',.TRUE.,0
  66. & ,'MOT',0,0.D0,'ESCLAVE' ,.TRUE.,0)
  67. CALL ECCTAB(ITAB,'MOT',0,0.D0,'CREATEUR',.TRUE.,0,
  68. & 'MOT',0,0.D0,'PART' ,.TRUE.,0)
  69.  
  70. ENDIF
  71.  
  72. SEGINI,SSREF
  73. C Initialisations et Dimensionnement des MELEME
  74. DO 10 IZ=1,MAX(1,NBZON)
  75. C Creation des MELEME COMPLEXE
  76. nbnn=0
  77. nbelem=0
  78. nbref=0
  79. nbsous=NBSM
  80. SEGINI,IPT4
  81.  
  82. IPT2=MELEME
  83. JA=0
  84. JSOUS(IZ) = 0
  85. DO 20 isous=1,NBSM
  86. if (NBS .NE. 0) THEN
  87. IPT2=lisous(isous)
  88. endif
  89.  
  90. C Dimentionnement des MELEME SIMPLES a 1 element pres
  91. nbelem =(IPT2.num(/2) / nbzon) + 1
  92. nbnn = IPT2.num(/1)
  93. nbsous =0
  94. nbref =0
  95. SEGINI,IPT5
  96. IPT5.ITYPEL = IPT2.ITYPEL
  97.  
  98. C jf=0
  99. JA = JA + IPT2.num(/2)
  100.  
  101. C Sauvegarde des Tableaux pour la suite
  102. JSOUS(IZ) = JSOUS(IZ) + 1
  103. IPT4.LISOUS(ISOUS)=IPT5
  104. IMELE(IZ) = IPT4
  105. ISREF(IZ,isous) = 1
  106. 20 CONTINUE
  107. 10 CONTINUE
  108.  
  109. C Le MELEME en entree est parcouru et ses elements sont repartis dans les
  110. C bonnes ZONES
  111. IPT2=MELEME
  112. JA=0
  113. DO 30 isous=1,NBSM
  114. if (NBS .NE. 0) THEN
  115. IPT2=lisous(isous)
  116. endif
  117.  
  118. C Remise a zero du nombre d'elements pour cette Sous Ref
  119. DO IZ=1,MAX(1,NBZON)
  120. NBELE(IZ) = 0
  121. ENDDO
  122.  
  123. C On remplit ici le COMMON pour le travail en parallele
  124. NBNN = IPT2.num(/1)
  125. NBELEM = IPT2.num(/2)
  126. NBTHR = MIN(NBELEM,NBTHRS)
  127.  
  128. ITH = 0
  129. IF (NBESC .NE. 0) ith=oothrd
  130.  
  131. IF ((NBTHR .LE. 1) .OR. (NBTHRS .EQ. 1) .OR. (ITH .GT. 0)) THEN
  132. ITH = 1
  133. BTHRD = .FALSE.
  134. ELSE
  135. BTHRD = .TRUE.
  136. CALL THREADII
  137. ENDIF
  138.  
  139. IF (BTHRD) THEN
  140. DO ith=2,NBTHR
  141. CALL THREADID(ith,part5i)
  142. ENDDO
  143. CALL part5i(1)
  144.  
  145. C Attente de la fin de tous les threads en cours de travail
  146. DO ith=2,NBTHR
  147. CALL THREADIF(ith)
  148. ENDDO
  149.  
  150. C On libère les Threads
  151. CALL THREADIS
  152.  
  153. ELSE
  154. CALL part5i(1)
  155. ENDIF
  156.  
  157. JA = JA + IPT2.num(/2)
  158.  
  159. C Ajustement des MELEME SIMPLE pour toutes les ZONES si besoin
  160. DO IZ=1,MAX(1,NBZON)
  161. IPT4 = IMELE(IZ)
  162. IPT5 = IPT4.LISOUS(ISOUS)
  163.  
  164. IF(NBELE(IZ) .EQ. 0) THEN
  165. ISREF(IZ,ISOUS) = 0
  166. JSOUS(IZ) = JSOUS(IZ) - 1
  167. SEGSUP,IPT5
  168.  
  169. ELSEIF(NBELE(IZ) .EQ. (IPT5.NUM(/2) - 1) )THEN
  170. nbnn = IPT5.NUM(/1)
  171. nbelem = NBELE(IZ)
  172. nbref = 0
  173. nbsous = 0
  174. SEGADJ,IPT5
  175. SEGDES,IPT5
  176.  
  177. ELSE
  178. SEGDES,IPT5
  179.  
  180. ENDIF
  181.  
  182. ENDDO
  183.  
  184. 30 CONTINUE
  185.  
  186.  
  187. C Boucle Finale pour remplir la TABLE resultat
  188. DO 70 IZ=1,MAX(1,NBZON)
  189. C Recuperation du MELEME COMPLEXE
  190. IPT4 = IMELE(IZ)
  191.  
  192. C Retassement du MELEME COMPLEXE IPT4 et Ajustement si necessaire
  193. ISACT = 0
  194. nbsous = JSOUS(IZ)
  195. IF (nbsous .NE. NBSM) THEN
  196. DO ISOUS=1,NBSM
  197. IF( ISREF(IZ,ISOUS) .EQ. 1 )THEN
  198. ISACT = ISACT + 1
  199. IPT4.LISOUS(ISACT)=IPT4.LISOUS(ISOUS)
  200. ENDIF
  201. ENDDO
  202.  
  203. nbref = 0
  204. nbnn = 0
  205. nbelem = 0
  206. SEGADJ,IPT4
  207. ENDIF
  208.  
  209. C Reclassement en MELEME SIMPLE si une seule Sous-Zone
  210. if (nbsous .eq. 1) then
  211. IPT5=IPT4.LISOUS(1)
  212. SEGSUP,IPT4
  213. IPT4=IPT5
  214.  
  215. else
  216. SEGDES,IPT4
  217.  
  218. endif
  219.  
  220. CALL ECCTAB(ITAB,'ENTIER',IZ ,0.D0 ,' ',.TRUE.,
  221. & 0 ,'MAILLAGE',0,0.D0,' ',.TRUE.,IPT4)
  222.  
  223. 70 CONTINUE
  224.  
  225. IF(NBS .GT. 0) THEN
  226. C MELEME COMPLEXE
  227. DO ia = 1,NBS
  228. IPT2=lisous(ia)
  229. SEGDES,IPT2
  230. ENDDO
  231. ENDIF
  232.  
  233. SEGDES,MELEME,MTABLE
  234. SEGSUP,SSREF
  235. RETURN
  236.  
  237. END
  238.  
  239.  
  240.  
  241.  
  242.  
  243.  
  244.  
  245.  
  246.  
  247.  
  248.  

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