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

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