Télécharger part.eso

Retour à la liste

Numérotation des lignes :

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

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