Télécharger part.eso

Retour à la liste

Numérotation des lignes :

  1. C PART SOURCE CB215821 19/07/31 21:15:52 10277
  2. ************************************************************************
  3. * NOM : PART
  4. * DESCRIPTION : Partitionne un maillage ou un modele
  5. ************************************************************************
  6. * APPELE PAR : pilot.eso
  7. ************************************************************************
  8. * ENTREES :: aucune
  9. * SORTIES :: aucune
  10. ************************************************************************
  11. * SYNTAXE (GIBIANE) :
  12. *
  13. * TABL1 = PART ('NESC') | 'OPTI' MAIL1 (ENTI1) ;
  14. * |
  15. * | 'ARLE' | MAIL1 | ENTI1 ;
  16. * | | MODL1 |
  17. * |
  18. * | 'CONN' MAIL1 ;
  19. * |
  20. * | 'SEPA' MAIL1 SEPA1 (SEPA2 ...) ;
  21. *
  22. * avec SEPAi = | 'FACE'
  23. * | 'LIGN'
  24. * | 'MAIL' MAIL2
  25. * | 'ANGL' (FLOT2) ('TELQ')
  26. *
  27. ************************************************************************
  28. SUBROUTINE PART
  29.  
  30. IMPLICIT INTEGER(I-N)
  31. IMPLICIT REAL*8 (A-H,O-Z)
  32.  
  33.  
  34. -INC PPARAM
  35. -INC CCOPTIO
  36. -INC CCREEL
  37. -INC CCASSIS
  38.  
  39. SEGMENT IPOS(0)
  40. SEGMENT ICPR(0)
  41. SEGMENT IADJ(0)
  42. SEGMENT JADJC(0)
  43.  
  44. PARAMETER(NMOT1=5,NMOT2=4,NMOT3=1)
  45. CHARACTER*4 LMOT1(NMOT1),LMOT2(NMOT2),LMOT3(NMOT3)
  46. DATA LMOT1/'NESC','OPTI','ARLE','CONN','SEPA'/
  47. DATA LMOT2/'LIGN','FACE','MAIL','ANGL'/
  48. DATA LMOT3/'TELQ'/
  49.  
  50.  
  51. * +---------------------------------------------------------------+
  52. * | L E C T U R E D E S A R G U M E N T S C O M M U N S |
  53. * +---------------------------------------------------------------+
  54.  
  55. * LECTURE DU MOT-CLE PRINCIPAL (OU DU MOT-CLE 'ESCL' SI PRESENT)
  56. * ==============================================================
  57. KESCL=1
  58. KPRIN=0
  59. KQUOI=0
  60. DO 10 I=1,2
  61. CALL LIRMOT(LMOT1,NMOT1,IMOT1,0)
  62. IF (IMOT1.EQ.0) GOTO 20
  63. IF (IMOT1.EQ.1) THEN
  64. KESCL=0
  65. GOTO 10
  66. ENDIF
  67. IF (KPRIN.GT.0) THEN
  68. MOTERR(1:16)='MOT '//LMOT1(IMOT1)
  69. CALL ERREUR(11)
  70. RETURN
  71. ENDIF
  72. KPRIN=1
  73. KQUOI=IMOT1-1
  74. 10 CONTINUE
  75. 20 CONTINUE
  76. IF (KQUOI.EQ.0) THEN
  77. CALL ERREUR(498)
  78. RETURN
  79. ENDIF
  80.  
  81. * LECTURE DE L'OBJET A PARTITIONNER
  82. * =================================
  83. CALL LIROBJ('MAILLAGE',MEL1,0,KMELEM)
  84. IF (KMELEM.EQ.0) THEN
  85. CALL LIROBJ('MMODEL ',IPMODL,0,KMMODE)
  86. IF (KMMODE.EQ.0) THEN
  87. MOTERR(1:40)='MAILLAGEMODELE'
  88. CALL ERREUR(471)
  89. RETURN
  90. ENDIF
  91. CALL ACTOBJ('MMODEL ',IPMODL,1)
  92. ENDIF
  93.  
  94. * LECTURE DES PARAMETRES SPECIFIQUES DIRECTEMENT DANS LA SECTION
  95. * DEDIEE CI-DESSOUS
  96. * ==============================================================
  97. GOTO(100,200,300,400),KQUOI
  98.  
  99.  
  100.  
  101. * +---------------------------------------------------------------+
  102. * | O P T I O N ' O P T I ' |
  103. * +---------------------------------------------------------------+
  104.  
  105. 100 CONTINUE
  106.  
  107. * NOMBRE DE ZONES DANS LA PARTITION (CE DOIT ETRE UNE PUISSANCE
  108. * ENTIERE POSITIVE DE 2)
  109. * =============================================================
  110. CALL LIRENT(NBZONE,0,IRETOU)
  111. IF (IRETOU.NE.0) THEN
  112. * On verifie la validite de la valeur specifiee
  113. NBZON=MAX(1,NBZONE)
  114. NB=(LOG(FLOAT(NBZON))/LOG(2.))+1.E-6
  115. IF (2**NB.NE.NBZONE) THEN
  116. INTERR(1)=NBZONE
  117. CALL ERREUR(36)
  118. RETURN
  119. ENDIF
  120. ELSE
  121. * Par defaut, c'est celle qui est directement superieure au
  122. * nombre d'assistants
  123. NBZONE=MAX(1,NBESC)
  124. NB=(LOG(FLOAT(NBZONE))/LOG(2.))+1.E-6
  125. NBZONE=2**NB
  126. ENDIF
  127.  
  128. * PARTITION D'UN MAILLAGE
  129. * =======================
  130. IF (KMELEM.NE.0) THEN
  131. * On reprend ce qui est fait dans la renumerotation en N-D
  132. * (Nested Dissection)
  133. CALL PART2(MEL1,IPOS,NB,ICPR,IADJ,JADJC)
  134. * WRITE(IOIMP,*) ' apres part2 ierr ',ierr
  135. c NODES=IPOS(/1)/3
  136. CALL PART4(MEL1,IPOS,ICPR,NB,ITAB,IADJ,JADJC,KESCL)
  137. * WRITE(IOIMP,*) ' apres part4 ierr ',ierr
  138.  
  139. * PARTITION D'UN MODELE
  140. * =====================
  141. ELSE
  142. WRITE(IOIMP,*) 'MMODEL non implemente pour l''option OPTI'
  143. CALL ERREUR(251)
  144. RETURN
  145.  
  146. ENDIF
  147. GOTO 1000
  148.  
  149.  
  150. * +---------------------------------------------------------------+
  151. * | O P T I O N ' A R L E ' |
  152. * +---------------------------------------------------------------+
  153.  
  154. 200 CONTINUE
  155.  
  156. * NOMBRE DE ZONES DANS LA PARTITION
  157. * =================================
  158. CALL LIRENT(NZO,1,IRETOU)
  159. IF (IERR.NE.0) RETURN
  160. IF (NZO.LT.1) THEN
  161. INTERR(1)=NZO
  162. CALL ERREUR(36)
  163. RETURN
  164. ENDIF
  165. * NBZONE=MAX(1,NBESC)
  166. * NZO=MIN(NZO,NBZONE)
  167.  
  168. * PARTITION D'UN MAILLAGE
  169. * =======================
  170. IF (KMELEM.NE.0) THEN
  171. CALL PART5(MEL1,ITAB,NZO,KESCL)
  172.  
  173. * PARTITION D'UN MODELE
  174. * =====================
  175. ELSE
  176. CALL PART6(NZO,IPMODL,ITAB,IRET,KESCL)
  177. IF (IRET.NE.0) RETURN
  178.  
  179. ENDIF
  180. GOTO 1000
  181.  
  182.  
  183. * +---------------------------------------------------------------+
  184. * | O P T I O N ' C O N N ' |
  185. * +---------------------------------------------------------------+
  186.  
  187. 300 CONTINUE
  188.  
  189. * PARTITION D'UN MAILLAGE
  190. * =======================
  191. IF (KMELEM.NE.0) THEN
  192. CALL PART7(MEL1,0,0,0,0,0,0.D0,0,ITAB,KESCL)
  193. IF (IERR.NE.0) RETURN
  194.  
  195. * PARTITION D'UN MODELE
  196. * =====================
  197. ELSE
  198. WRITE(IOIMP,*) 'MMODEL non implemente pour l''option CONN'
  199. CALL ERREUR(251)
  200. RETURN
  201. ENDIF
  202. GOTO 1000
  203.  
  204.  
  205. * +---------------------------------------------------------------+
  206. * | O P T I O N ' S E P A ' |
  207. * +---------------------------------------------------------------+
  208.  
  209. 400 CONTINUE
  210.  
  211. * LECTURE D'UNE OU PLUSIEURS OPTIONS DE SEPARATION
  212. * ================================================
  213. KLI=0
  214. KFA=0
  215. KMA=0
  216. KAN=0
  217.  
  218. MEL2=0
  219. CANGL=0.D0
  220.  
  221. 401 CONTINUE
  222. CALL LIRMOT(LMOT2,NMOT2,IMOT2,0)
  223. IF (IMOT2.EQ.0) GOTO 402
  224.  
  225. * SEPARATEUR 'LIGN'
  226. IF (IMOT2.EQ.1) THEN
  227. KLI=1
  228.  
  229. * SEPARATEUR 'FACE'
  230. ELSEIF (IMOT2.EQ.2) THEN
  231. KFA=1
  232.  
  233. * SEPARATEUR 'MAIL'
  234. ELSEIF (IMOT2.EQ.3) THEN
  235. IF (KMA.EQ.1) THEN
  236. CALL ERREUR(717)
  237. RETURN
  238. ENDIF
  239. KMA=1
  240.  
  241. * Lecture du maillage faisant office de separation
  242. CALL LIROBJ('MAILLAGE',MEL2,0,IRET)
  243. IF (IRET.EQ.0) THEN
  244. MOTERR(1:4)='MAIL'
  245. CALL ERREUR(166)
  246. RETURN
  247. ENDIF
  248.  
  249. * SEPARATEUR 'ANGL'
  250. ELSEIF (IMOT2.EQ.4) THEN
  251. IF (KAN.EQ.1) THEN
  252. CALL ERREUR(717)
  253. RETURN
  254. ENDIF
  255. KAN=1
  256.  
  257. * Lecture de l'angle seuil
  258. CALL LIRREE(XANGL,0,IRET)
  259. IF (IRET.EQ.0) XANGL=20.D0
  260. CANGL=COS(XANGL*XPI/180.D0)
  261.  
  262. * Lecture du mot-cle 'TELQ' si present
  263. CALL LIRMOT(LMOT3,NMOT3,IMOT3,0)
  264.  
  265. ENDIF
  266.  
  267. GOTO 401
  268.  
  269. 402 CONTINUE
  270.  
  271. * PARTITION D'UN MAILLAGE
  272. * =======================
  273. IF (KMELEM.NE.0) THEN
  274. CALL PART7(MEL1,KLI,KFA,KMA,MEL2,KAN,CANGL,IMOT3,ITAB,KESCL)
  275. IF (IERR.NE.0) RETURN
  276.  
  277.  
  278. * PARTITION D'UN MODELE
  279. * =====================
  280. ELSE
  281. WRITE(IOIMP,*) 'MMODEL non implemente pour l''option SEPA'
  282. CALL ERREUR(251)
  283. RETURN
  284. ENDIF
  285. GOTO 1000
  286.  
  287.  
  288. * +---------------------------------------------------------------+
  289. * | F I N D E L A S U B R O U T I N E |
  290. * +---------------------------------------------------------------+
  291.  
  292. 1000 CONTINUE
  293.  
  294. * WRITE(IOIMP,*) ' avant ECROBJitab ierr ',itab,ierr
  295. CALL ECROBJ('TABLE',ITAB)
  296.  
  297. END
  298.  
  299.  
  300.  

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