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

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