Télécharger lektab.eso

Retour à la liste

Numérotation des lignes :

  1. C LEKTAB SOURCE CB215821 19/08/20 21:19:16 10287
  2. SUBROUTINE LEKTAB(MTB,NOMI,IPOINT)
  3. C---------------------------------------------------------------------
  4. C Ce sous-programme recherche dans la table MTABLE l'indice NOMI.
  5. C NOMI doit se trouver dans la liste LISTS. Le soustype de la table
  6. C est controlé par l'opérateur appelé.
  7. C
  8. C Si l'objet trouvé à l'indice NOMI est du bon type, son pointeur
  9. C IPOINT est renvoyé au sous-programme appelant.
  10. C Sinon, il est calculé et placé à l'indice NOMI de la table MTABLE
  11. C et son pointeur IPOINT est renvoyé au sous-programme appelant.
  12. C---------------------------------------------------------------------
  13. C
  14. C---------------------------
  15. C Paramètres Entrée/Sortie :
  16. C---------------------------
  17. C
  18. C E/ MTABLE : Pointeur de la table contenant l'information cherchée
  19. C E/ NOMI : Indice de la table où on cherche une donnée
  20. C /S IPOINT : Pointeur sur l'objet trouvé ou ajouté à l'indice NOMI
  21. C En cas de problème IPOINT est nul.
  22. C
  23. C---------------------------------------------------------------------
  24. IMPLICIT INTEGER(I-N)
  25. IMPLICIT REAL*8 (A-H,O-Z)
  26. -INC CCOPTIO
  27. -INC CCGEOME
  28. -INC SMELEME
  29. POINTEUR MELEMQ.MELEME
  30. -INC SMMODEL
  31. -INC SMTABLE
  32. POINTEUR IPTR.MTABLE,MTABM.MTABLE
  33. CHARACTER*8 MOTYP,TYPOBJ
  34. CHARACTER*72 ICHAI,CHARRE
  35. LOGICAL IRETL,IBOOL,LOGRE,VLOGI
  36. REAL*8 XRET,XVALRE
  37. *
  38. CHARACTER*(*) NOMI
  39. CHARACTER*8 NOMC,NOMDOM
  40. PARAMETER (NBO=60)
  41. CHARACTER*8 LISTS(NBO),TYPE,NOM,MIND,MINDS,TYPI,MNEFMD
  42. DATA LISTS/'MATESI ','XXVOLUM ','XXCOTE ','XXDIAME ','XXDIEMIN',
  43. & 'MATC ','XXPSOML ','INCO ','KIZG ','KOPT ',
  44. & 'PASDETPS','DOMAINE ','DOMZ ','EQEX ','EQPR ',
  45. & 'XXDIAGSI','KIZG1 ','KIZD ','SOMMET ','CENTRE ',
  46. & 'FACE ','FACEL ','FACEP ','XXNORMAF','XXSURFAC',
  47. & 'MAILLAGE','CETR&FAC','MATRIS ','ELTFA ','XXNORMAE',
  48. & 'KIZA ','ARGS ','SOMCEN ','CESOCE ','NORMALEV',
  49. & 'OENVELOP','XXMSOMME','MATEEF ','ELKONV ','XXDIAGFA',
  50. & 'M1BULLE ','CENTREP0','ELTP1NC ','CENTREP1','VOLUMAC ',
  51. & 'MACRO ','QUADRATI','MACRO1 ','XXDXDY ','MSOMMET ',
  52. & 'MMAIL ','MLGVNIMP','MLGVTIMP','ENVELOPP','FACEL2 ',
  53. & 'QUAF ','XXCTREP1','XXCTREP0','MAILFACE','ARETE '/
  54. C
  55. C- Initialisations
  56. C
  57. C write(6,*)'DEBUT LEKTAB MTB,NOMI=',MTB,NOMI
  58. MTABLE = ABS(MTB)
  59.  
  60. CALL ECRCHA('INEFMD ')
  61. CALL ECROBJ('TABLE',MTABLE)
  62. CALL EXIS
  63. CALL LIRLOG(VLOGI,1,IRET)
  64. IF(IRET.EQ.0)THEN
  65. write(6,*)'LEKTAB : Pb avec INEFMD'
  66. go to 5000
  67. ENDIF
  68. IF(VLOGI)THEN
  69. TYPE=' '
  70. CALL ACMO(MTABLE,'INEFMD ',TYPE,INEFMD)
  71. IF(TYPE.EQ.'MOT')THEN
  72. CALL ACMM(MTABLE,'INEFMD ',MNEFMD)
  73. IF(MNEFMD.EQ.'LINE')THEN
  74. INEFMD=1
  75. ELSEIF(MNEFMD.EQ.'MACRO')THEN
  76. INEFMD=2
  77. ELSEIF(MNEFMD.EQ.'QUAF ')THEN
  78. INEFMD=3
  79. ELSEIF(MNEFMD.EQ.'LINB ')THEN
  80. INEFMD=4
  81. ELSEIF(MNEFMD.EQ.'ISOQ ')THEN
  82. INEFMD=5
  83. ELSE
  84. INEFMD=0
  85. ENDIF
  86. ELSEIF(TYPE.EQ.'ENTIER')THEN
  87. CALL ACME(MTABLE,'INEFMD ',INEFMD)
  88. ELSE
  89. write(6,*)'LEKTAB : Pb avec INEFMD'
  90. GO TO 5000
  91. ENDIF
  92. ELSE
  93. INEFMD=0
  94. ENDIF
  95.  
  96. KECR=0
  97. IF(MTB.LT.0)KECR=1
  98. NOM = NOMI
  99. IPOINT = 0
  100. I211 = 0
  101. I221 = 0
  102. I231 = 0
  103. I241 = 0
  104. I251 = 0
  105. I271 = 0
  106. I291 = 0
  107. I301 = 0
  108. I331 = 0
  109. I341 = 0
  110. I371 = 0
  111. I391 = 0
  112. I501 = 0
  113. I511 = 0
  114. I1201 = 0
  115. I541 = 0
  116. I542 = 0
  117. I551 = 0
  118. I591 = 0
  119. C
  120. C- Détermination du cas à traiter et ventilation
  121. C
  122. CG SEGACT MTABLE
  123. CALL ACMM(MTABLE,'SOUSTYPE',TYPE)
  124. IPREC=0
  125. ISTOK=0
  126. IF (TYPE.EQ.'DOMAINE ') THEN
  127. c
  128. c traitement special pour le cas ou PRECONDI n'existait pas
  129. c
  130. ICHAI(1:8)='PRECONDI'
  131. MOTYP='MOT'
  132. TYPOBJ=' '
  133. CALL ACCTAB(MTABLE,MOTYP,IVAL,XRET,ICHAI(1:8),IBOOL
  134. $ ,IOBJ,TYPOBJ,IVALRE,XVALRE,CHARRE,LOGRE,IOBRE)
  135. IRETL=.TRUE.
  136. IF(TYPOBJ.EQ.' ') IRETL = .FALSE.
  137. IF(.NOT.IRETL)CALL ECME(MTABLE,'PRECONDI',1)
  138. CALL ACME(MTABLE,'PRECONDI',IPREC)
  139. ENDIF
  140. ISTOK=IPREC
  141.  
  142.  
  143. CALL OPTLI(IP,LISTS,NOM,NBO)
  144. C write(6,*)' LEKTAB NOM=',nom
  145. IF (IP.EQ.0) THEN
  146. IF (NOM(1:4).EQ.'ARGS') THEN
  147. IP = 32
  148. ELSE
  149. C Indice %m1:8 : N'est pas un indice de table reconnu
  150. MOTERR(1:8) = NOM
  151. CALL ERREUR(791)
  152. RETURN
  153. ENDIF
  154. ENDIF
  155. C write(6,*)' LEKTAB IP=',IP, ' NOMI==========',NOMI
  156. GOTO ( 10, 20, 30, 40, 50, 60, 70, 80, 90,100
  157. & ,110,120,130,140,150,160,170,180,190,200
  158. & ,210,220,230,240,250,260,270,280,290,300
  159. & ,310,320,330,340,350,360,370,380,390,400
  160. & ,410,420,430,440,450,460,470,480,490,500
  161. & ,510,520,530,540,550,560,570,580,590,600),IP
  162. C
  163. C Si PRECONDI = 0 (IPREC=0) On recaclcule systématiquement les numéros
  164. C suivant : 10 20 30 40 50 60 70 160 240 250 300 350 360 370 380 400
  165. C 450 490
  166. C
  167. C-*DOMAINE.'MATESI'
  168. C
  169. 10 CONTINUE
  170. TYPE = ' '
  171. CALL ACMO(MTABLE,'MATESI',TYPE,MATRIK)
  172. IF (TYPE.NE.'MATRIK '.OR.IPREC.EQ.0) THEN
  173. CALL ECROBJ('TABLE',MTABLE)
  174. CALL HRSI
  175. TYPE='MATRIK'
  176. CALL LIROBJ(TYPE,MATRIK,1,IRET)
  177. IF (IRET.EQ.0) GOTO 5000
  178. IF(ISTOK.EQ.1)CALL ECMO(MTABLE,'MATESI','MATRIK',MATRIK)
  179. ENDIF
  180. IPOINT = MATRIK
  181. IF(KECR.EQ.1)CALL ECROBJ('MATRIK',MATRIK)
  182. RETURN
  183. C
  184. C-*DOMAINE.'XXVOLUM' : CHPO CENTRE contenant le volume des éléments
  185. C
  186. 20 CONTINUE
  187. TYPE = ' '
  188. CALL ACMO(MTABLE,'XXVOLUM ',TYPE,MCHPOI)
  189. IF (TYPE.NE.'CHPOINT '.OR.IPREC.EQ.0) THEN
  190. C write(6,*) 'On ne trouve pas XXVOLUM -> On le calcule'
  191. TYPE=' '
  192. CALL ACMO(MTABLE,'CENTRE',TYPE,MELEMC)
  193. CALL ACMO(MTABLE,'MAILLAGE',TYPE,MELEME)
  194. CALL KVOL(MELEME,MELEMC,'CENTRE',MCHPOI)
  195. IF(ISTOK.EQ.1)CALL ECMO(MTABLE,'XXVOLUM ','CHPOINT ',MCHPOI)
  196. ENDIF
  197. IPOINT = MCHPOI
  198. IF(KECR.EQ.1)CALL ECROBJ('CHPOINT ',MCHPOI)
  199. C write(6,*) 'Retour XXVOLUM : MTABLE=',MTABLE
  200. RETURN
  201. C
  202. C-*DOMAINE.'XXCOTE'
  203. C
  204. 30 CONTINUE
  205. TYPE=' '
  206. CALL ACMO(MTABLE,'XXCOTE',TYPE,MCHPOI)
  207. IF (TYPE.NE.'CHPOINT '.OR.IPREC.EQ.0) THEN
  208. C write(6,*) 'On ne trouve pas XXCOTE -> On le calcule'
  209. CALL ECROBJ('TABLE ',MTABLE)
  210. CALL KCOT
  211. TYPE = 'CHPOINT '
  212. CALL LIROBJ(TYPE,MCHPOI,1,IRET)
  213. IF (IRET.EQ.0) GOTO 5000
  214. IF(ISTOK.EQ.1)CALL ECMO(MTABLE,'XXCOTE','CHPOINT ',MCHPOI)
  215. ENDIF
  216. IPOINT = MCHPOI
  217. IF(KECR.EQ.1)CALL ECROBJ('CHPOINT ',MCHPOI)
  218. C write(6,*) 'Retour XXCOTE : MTABLE=',MTABLE
  219. RETURN
  220. C
  221. C-*DOMAINE.'XXDIAME'
  222. C
  223. 40 CONTINUE
  224. TYPE = ' '
  225. CALL ACMO(MTABLE,'XXDIAME ',TYPE,MCHPOI)
  226. IF (TYPE.NE.'CHPOINT '.OR.IPREC.EQ.0) THEN
  227. C write(6,*) 'On ne trouve pas XXDIAME -> On le calcule'
  228. CALL ECROBJ('TABLE ',MTABLE)
  229. CALL KDME
  230. TYPE = 'CHPOINT '
  231. CALL LIROBJ(TYPE,MCHPOI,1,IRET)
  232. IF (IRET.EQ.0) GOTO 5000
  233. IF(ISTOK.EQ.1)CALL ECMO(MTABLE,'XXDIAME','CHPOINT ',MCHPOI)
  234. ENDIF
  235. IPOINT = MCHPOI
  236. IF(KECR.EQ.1)CALL ECROBJ('CHPOINT ',MCHPOI)
  237. C write(6,*) 'Retour XXDIAME : MTABLE=',MTABLE
  238. RETURN
  239. C
  240. C-*DOMAINE.'XXDIEMIN'
  241. C
  242. 50 CONTINUE
  243. TYPE = ' '
  244. CALL ACMO(MTABLE,'XXDIEMIN',TYPE,MCHPOI)
  245. IF (TYPE.NE.'CHPOINT '.OR.IPREC.EQ.0) THEN
  246. C write(6,*) 'On ne trouve pas XXDIEMIN -> On le calcule'
  247. CALL ECROBJ('TABLE ',MTABLE)
  248. CALL KDMI
  249. TYPE = 'CHPOINT '
  250. CALL LIROBJ(TYPE,MCHPOI,1,IRET)
  251. IF (IRET.EQ.0) GOTO 5000
  252. IF(ISTOK.EQ.1)CALL ECMO(MTABLE,'XXDIEMIN','CHPOINT ',MCHPOI)
  253. ENDIF
  254. IPOINT = MCHPOI
  255. IF(KECR.EQ.1)CALL ECROBJ('CHPOINT ',MCHPOI)
  256. C write(6,*) 'Retour XXDIEMIN : MTABLE=',MTABLE
  257. RETURN
  258. C
  259. C-*????.'MATC'
  260. C
  261. 60 CONTINUE
  262. TYPE = ' '
  263. CALL ACMO(MTABLE,'MATC',TYPE,MATRAK)
  264. IF (TYPE.NE.'MATRAK '.OR.IPREC.EQ.0) THEN
  265. c? IF (TYPE.NE.'MATRAK ') THEN
  266. CALL KMEC(MTABLE,MATRAK)
  267. IF (MATRAK.EQ.0) GOTO 5000
  268. IF(ISTOK.EQ.1)CALL ECMO(MTABLE,'MATC','MATRAK',MATRAK)
  269. ENDIF
  270. IPOINT = MATRAK
  271. IF(KECR.EQ.1)CALL ECROBJ('MATRAK',MATRAK)
  272. RETURN
  273. C
  274. C-*DOMAINE.'XXPSOML' : MCHAML, intégrale des fonctions tests par élément
  275. C
  276. 70 CONTINUE
  277. CALL ACMM(MTABLE,'SOUSTYPE',TYPE)
  278. IF (TYPE.NE.'DOMAINE ') GOTO 5010
  279. TYPE = ' '
  280. CALL ACMO(MTABLE,'XXPSOML',TYPE,ICHE)
  281. IF (TYPE.NE.'MCHAML '.OR.IPREC.EQ.0) THEN
  282. CALL ECROBJ('TABLE',MTABLE)
  283. CALL KPSOML
  284. TYPE = 'MCHAML'
  285. CALL LIROBJ(TYPE,ICHE,1,IRET)
  286. IF (IRET.EQ.0) GOTO 5000
  287. IF(ISTOK.EQ.1)CALL ECMO(MTABLE,'XXPSOML','MCHAML',ICHE)
  288. ENDIF
  289. IPOINT = ICHE
  290. IF(KECR.EQ.1)CALL ECROBJ('MCHAML ',ICHE)
  291. RETURN
  292. C
  293. C- ????-INCO : TABLE de sous-type INCO
  294. C
  295. 80 CONTINUE
  296. MIND = LISTS(8)
  297. MINDS = LISTS(8)
  298. GOTO 1000
  299. C
  300. C- ????-KIZG : TABLE de sous-type KIZG
  301. C
  302. 90 CONTINUE
  303. MIND = LISTS(9)
  304. MINDS = LISTS(9)
  305. GOTO 1000
  306. C
  307. C- ????-KOPT : TABLE de sous-type KOPT
  308. C
  309. 100 CONTINUE
  310. MIND = LISTS(10)
  311. MINDS = LISTS(10)
  312. GOTO 1000
  313. C
  314. C- ????-PASDETPS : TABLE de sous-type PASDETPS
  315. C
  316. 110 CONTINUE
  317. MIND = LISTS(11)
  318. MINDS = LISTS(11)
  319. GOTO 1000
  320. C
  321. C- ????-DOMAINE : TABLE de sous-type DOMAINE
  322. C
  323. 120 CONTINUE
  324. MIND = LISTS(12)
  325. MINDS = LISTS(12)
  326. GOTO 1000
  327. C
  328. C- ????-DOMZ : TABLE de sous-type DOMAINE
  329. C
  330. 130 CONTINUE
  331. MIND = LISTS(13)
  332. MINDS = LISTS(12)
  333. GOTO 1000
  334. C
  335. C- ????-EQEX : TABLE de sous-type EQEX
  336. C
  337. 140 CONTINUE
  338. MIND = LISTS(14)
  339. MINDS = LISTS(14)
  340. GOTO 1000
  341. C
  342. C- ????-EQPR : TABLE de sous-type EQPR
  343. C
  344. 150 CONTINUE
  345. MIND = LISTS(15)
  346. MINDS = LISTS(15)
  347. GOTO 1000
  348. C
  349. C-*DOMAINE.'XXDIAGSI'
  350. C
  351. 160 CONTINUE
  352. TYPE = ' '
  353. CALL ACMO(MTABLE,'XXDIAGSI',TYPE,MCHPOI)
  354. IF (TYPE.NE.'CHPOINT '.OR.IPREC.EQ.0) THEN
  355. C write(6,*) 'On ne trouve pas XXDIAGSI -> On le calcule'
  356. CALL ECROBJ('TABLE ',MTABLE)
  357. CALL CADGSI
  358. TYPE = 'CHPOINT '
  359. CALL LIROBJ(TYPE,MCHPOI,1,IRET)
  360. IF (IRET.EQ.0) GOTO 5000
  361. IF(ISTOK.EQ.1) CALL ECMO(MTABLE,'XXDIAGSI','CHPOINT ',MCHPOI)
  362. ENDIF
  363. IPOINT = MCHPOI
  364. IF(KECR.EQ.1)CALL ECROBJ('CHPOINT ',MCHPOI)
  365. C write(6,*) 'Retour XXDIAGSI : MTABLE=',MTABLE
  366. RETURN
  367. C
  368. C- ????-KIZG1 : TABLE de sous-type KIZG1
  369. C
  370. 170 CONTINUE
  371. MIND = LISTS(17)
  372. MINDS = LISTS(17)
  373. GOTO 1000
  374. C
  375. C- ????-KIZD : TABLE de sous-type KIZD
  376. C
  377. 180 CONTINUE
  378. MIND = LISTS(18)
  379. MINDS = LISTS(18)
  380. GOTO 1000
  381. C
  382. C- DOMAINE.'SOMMET' : MELEME de POI1 contenant les sommets du maillage
  383. C
  384. 190 CONTINUE
  385. CALL ACMM(MTABLE,'SOUSTYPE',TYPE)
  386. IF (TYPE.NE.'DOMAINE ') GOTO 5010
  387. TYPE = ' '
  388. CALL ACMO(MTABLE,'SOMMET',TYPE,MELEM1)
  389. IF (TYPE.NE.'MAILLAGE') THEN
  390. TYPE = ' '
  391. CALL ACMO(MTABLE,'MAILLAGE',TYPE,MELEME)
  392. IF (TYPE.NE.'MAILLAGE') GOTO 5000
  393. CALL ECRCHA('POI1')
  394. CALL ECROBJ('MAILLAGE',MELEME)
  395. CALL PRCHAN
  396. CALL LIROBJ('MAILLAGE',MELEM1,1,IRET)
  397. IF (IRET.EQ.0) GOTO 5000
  398. CALL ECMO(MTABLE,'SOMMET','MAILLAGE',MELEM1)
  399. ENDIF
  400. IPOINT = MELEM1
  401. IF(KECR.EQ.1)CALL ECROBJ('MAILLAGE',MELEM1)
  402. RETURN
  403. C
  404. C- DOMAINE.'CENTRE' : MELEME de POI1 contenant les centres du maillage
  405. C
  406. 200 CONTINUE
  407. CALL ACMM(MTABLE,'SOUSTYPE',TYPE)
  408. IF (TYPE.NE.'DOMAINE ') GOTO 5010
  409. TYPE = ' '
  410. CALL ACMO(MTABLE,'CENTRE',TYPE,MELEMC)
  411. IF (TYPE.NE.'MAILLAGE') THEN
  412. TYPE = ' '
  413. CALL ACMO(MTABLE,'MAILLAGE',TYPE,MELEME)
  414. IF (TYPE.NE.'MAILLAGE') GOTO 5000
  415. CALL ECROBJ('MAILLAGE',MELEME)
  416. CALL CRECTR
  417. CALL LIROBJ('MAILLAGE',MELEMC,1,IRET)
  418. IF (IRET.EQ.0) GOTO 5000
  419. CALL ECMO(MTABLE,'CENTRE','MAILLAGE',MELEMC)
  420. ENDIF
  421. IPOINT = MELEMC
  422. IF(KECR.EQ.1)CALL ECROBJ('MAILLAGE',MELEMC)
  423. RETURN
  424. C
  425. C- DOMAINE.'FACE' : MELEME de POI1 contenant les faces du maillage
  426. C
  427. 210 CONTINUE
  428. CALL ACMM(MTABLE,'SOUSTYPE',TYPE)
  429. IF (TYPE.NE.'DOMAINE ') GOTO 5010
  430. TYPE = ' '
  431. CALL ACMO(MTABLE,'FACE',TYPE,MELEF1)
  432. IF (TYPE.NE.'MAILLAGE') THEN
  433. I211 = 1
  434. GOTO 1100
  435. ENDIF
  436. 211 CONTINUE
  437. IPOINT = MELEF1
  438. IF(KECR.EQ.1)CALL ECROBJ('MAILLAGE',MELEF1)
  439. RETURN
  440. C
  441. C- DOMAINE.'FACEL' : MELEME des connectivités centre-face-centre
  442. C
  443. 220 CONTINUE
  444. CALL ACMM(MTABLE,'SOUSTYPE',TYPE)
  445. IF (TYPE.NE.'DOMAINE ') GOTO 5010
  446. TYPE = ' '
  447. CALL ACMO(MTABLE,'FACEL',TYPE,MELEMF)
  448. IF (TYPE.NE.'MAILLAGE') THEN
  449. I221 = 1
  450. GOTO 1100
  451. ENDIF
  452. 221 CONTINUE
  453. IPOINT = MELEMF
  454. IF(KECR.EQ.1)CALL ECROBJ('MAILLAGE',MELEMF)
  455. RETURN
  456. C
  457. C- DOMAINE.'FACEP' : MELEME des connectivités sommet-face-sommet
  458. C
  459. 230 CONTINUE
  460. CALL ACMM(MTABLE,'SOUSTYPE',TYPE)
  461. IF (TYPE.NE.'DOMAINE ') GOTO 5010
  462. TYPE = ' '
  463. CALL ACMO(MTABLE,'FACEP',TYPE,MELEMP)
  464. IF (TYPE.NE.'MAILLAGE') THEN
  465. I231 = 1
  466. GOTO 1100
  467. ENDIF
  468. 231 CONTINUE
  469. IPOINT = MELEMP
  470. IF(KECR.EQ.1)CALL ECROBJ('MAILLAGE',MELEMP)
  471. RETURN
  472. C
  473. C-*DOMAINE.'XXNORMAE' : CHPO FACE contenant la normale choisie à la face
  474. C
  475. 240 CONTINUE
  476. CALL ACMM(MTABLE,'SOUSTYPE',TYPE)
  477. IF (TYPE.NE.'DOMAINE ') GOTO 5010
  478. TYPE = ' '
  479. CALL ACMO(MTABLE,'XXNORMAF',TYPE,ICHPV)
  480.  
  481. IF (TYPE.NE.'CHPOINT '.OR.IPREC.EQ.0)THEN
  482. I241 = 1
  483. GOTO 1200
  484. ENDIF
  485. 241 CONTINUE
  486. IPOINT = ICHPV
  487. IF(KECR.EQ.1)CALL ECROBJ('CHPOINT ',ICHPV)
  488. RETURN
  489. C
  490. C-*DOMAINE.'XXSURFAC' : CHPO FACE contenant l'aire de la face
  491. C
  492. 250 CONTINUE
  493. CALL ACMM(MTABLE,'SOUSTYPE',TYPE)
  494. IF (TYPE.NE.'DOMAINE ') GOTO 5010
  495. TYPE = ' '
  496. CALL ACMO(MTABLE,'XXSURFAC',TYPE,ICHP)
  497. IF (TYPE.NE.'CHPOINT '.OR.IPREC.EQ.0) THEN
  498. I251 = 1
  499. GOTO 1200
  500. ENDIF
  501. 251 CONTINUE
  502. IPOINT = ICHP
  503. IF(KECR.EQ.1)CALL ECROBJ('CHPOINT ',ICHP)
  504. RETURN
  505. C
  506. C- DOMAINE.'MAILLAGE' : Maillage géométrique du domaine considéré
  507. C
  508. 260 CONTINUE
  509. CALL ACMM(MTABLE,'SOUSTYPE',TYPE)
  510. IF (TYPE.NE.'DOMAINE ') GOTO 5010
  511. TYPE=' '
  512. CALL ACMO(MTABLE,'MAILLAGE',TYPE,MELEME)
  513. IF (TYPE.NE.'MAILLAGE') THEN
  514. C Indice %m1:8 : Objet de type %m9:16 incorrect
  515.  
  516. MOTERR(1:8) = NOM
  517. MOTERR(9:16) = TYPE
  518. CALL ERREUR(787)
  519. RETURN
  520. ENDIF
  521. IPOINT = MELEME
  522. IF(KECR.EQ.1)CALL ECROBJ('MAILLAGE',MELEME)
  523. RETURN
  524. C
  525. C- DOMAINE.'CETR&FAC' : Inutilisé (à verifier) -> renvoie 'CENTRE'
  526. C
  527. 270 CONTINUE
  528. CALL ACMM(MTABLE,'SOUSTYPE',TYPE)
  529. IF (TYPE.NE.'DOMAINE ') GOTO 5010
  530. TYPE = ' '
  531. CALL ACMO(MTABLE,'CENTRE',TYPE,MELEMK)
  532. IF (TYPE.NE.'MAILLAGE') THEN
  533. I271 = 1
  534. GOTO 1100
  535. ENDIF
  536. 271 CONTINUE
  537. IPOINT = MELEMK
  538. IF(KECR.EQ.1)CALL ECROBJ('MAILLAGE',MELEMK)
  539. RETURN
  540. C
  541. C- ????.'MATRIS'
  542. C
  543. 280 CONTINUE
  544. TYPE = ' '
  545. CALL ACMO(MTABLE,'MATRIS',TYPE,MTABM)
  546. IF (TYPE.NE.'TABLE ') THEN
  547. IMPR=1
  548. CALL ECRENT(IMPR)
  549. CALL ECRCHA('IMPR')
  550. CALL ECROBJ('TABLE',MTABLE)
  551. CALL PROGCS
  552. CALL LIROBJ('TABLE',MTABM,1,IRET)
  553. IF (IRET.EQ.0) GOTO 5000
  554. CALL ECMO(MTABLE,'MATRIS','TABLE',MTABM)
  555. ENDIF
  556. IPOINT = MTABM
  557. IF(KECR.EQ.1)CALL ECROBJ('TABLE',MTABM)
  558. RETURN
  559. C
  560. C- DOMAINE.'ELTFA' : MELEME connectivite face par élément (Hdiv)
  561. C
  562. 290 CONTINUE
  563. CALL ACMM(MTABLE,'SOUSTYPE',TYPE)
  564. IF (TYPE.NE.'DOMAINE ') GOTO 5010
  565. TYPE = ' '
  566. CALL ACMO(MTABLE,'ELTFA',TYPE,MELAF)
  567. IF (TYPE.NE.'MAILLAGE') THEN
  568. I291 = 1
  569. GOTO 1100
  570. ENDIF
  571. 291 CONTINUE
  572. IPOINT = MELAF
  573. IF(KECR.EQ.1)CALL ECROBJ('MAILLAGE',MELAF)
  574. RETURN
  575. C
  576. C-*DOMAINE.'XXNORMAE' : MCHAML d'orientation des normales
  577. C
  578. 300 CONTINUE
  579. CALL ACMM(MTABLE,'SOUSTYPE',TYPE)
  580. IF (TYPE.NE.'DOMAINE ') GOTO 5010
  581. TYPE = ' '
  582. CALL ACMO(MTABLE,'XXNORMAE',TYPE,ICHE)
  583. IF (TYPE.NE.'MCHAML '.OR.IPREC.EQ.0) THEN
  584. I301 = 1
  585. GOTO 1200
  586. ENDIF
  587. 301 CONTINUE
  588. IPOINT = ICHE
  589. IF(KECR.EQ.1)CALL ECROBJ('MCHAML ',ICHE)
  590. RETURN
  591. C
  592. C- ????.'KIZA' : TABLE de sous-type KIZA
  593. C
  594. 310 CONTINUE
  595. MIND=LISTS(31)
  596. MINDS=LISTS(31)
  597. GOTO 1000
  598. C
  599. C- ????.'ARGS...' : CHPO
  600. C
  601. 320 CONTINUE
  602. TYPE = ' '
  603. CALL ACMO(MTABLE,NOM,TYPE,MCHP)
  604. IF (TYPE.NE.'CHPOINT ') THEN
  605. NC = 10
  606. CALL COCHPT(NC,MCHP)
  607. IF(ISTOK.EQ.1)CALL ECMO(MTABLE,NOM,'CHPOINT',MCHP)
  608. ENDIF
  609. IPOINT = MCHP
  610. IF(KECR.EQ.1)CALL ECROBJ('CHPOINT',MCHP)
  611. RETURN
  612. C
  613. C- DOMAINE.'SOMCEN'
  614. C Cet indice contient un maillage de connectivités sommet-centre
  615. C Il est constitué d'éléments de type POLY :
  616. C - le premier noeud est le sommet considéré ;
  617. C - les noeuds suivants sont les centres des éléments
  618. C contenant le sommet considéré.
  619. C
  620. 330 CONTINUE
  621. CALL ACMM(MTABLE,'SOUSTYPE',TYPE)
  622. IF (TYPE.NE.'DOMAINE ') GOTO 5010
  623. TYPE = ' '
  624. * CALL ACMO(MTABLE,'MMAIL',TYPE,MMELEM)
  625. CALL ACMO(MTABLE,'MAILLAGE',TYPE,MMELEM)
  626. IF (TYPE.NE.'MAILLAGE') THEN
  627. C Indice %m1:8 : Objet de type %m9:16 incorrect
  628.  
  629. MOTERR(1:8) = NOM
  630. MOTERR(9:16) = TYPE
  631. CALL ERREUR(787)
  632. RETURN
  633. ENDIF
  634. * IF (TYPE.NE.'MAILLAGE') THEN
  635. * I331 = 1
  636. * GOTO 1300
  637. * ENDIF
  638. 331 CONTINUE
  639. TYPE = ' '
  640. CALL ACMO(MTABLE,'SOMCEN',TYPE,MSOCEN)
  641. IF (TYPE.NE.'MAILLAGE') THEN
  642. TYPE = 'MAILLAGE'
  643. CALL ACMO(MTABLE,'CENTRE',TYPE,MELCEN)
  644. * CALL ACMO(MTABLE,'MSOMMET',TYPE,MMLEMS)
  645. CALL ACMO(MTABLE,'SOMMET',TYPE,MMLEMS)
  646. CALL POIELE(MMELEM,MMLEMS,MELCEN,MSOCEN)
  647. CALL ECMO(MTABLE,'SOMCEN','MAILLAGE',MSOCEN)
  648. ENDIF
  649. IPOINT = MSOCEN
  650. IF(KECR.EQ.1)CALL ECROBJ('MAILLAGE',MSOCEN)
  651. RETURN
  652. C
  653. C- DOMAINE.'CESOCE'
  654. C cet indice contient un maillage de connectivités
  655. C centre-(sommet)-centre.
  656. C Il est constitué d'éléments de type POLY :
  657. C - le premier noeud est le centre de l'élément considéré ;
  658. C - les noeuds suivants sont les centres des éléments
  659. C ayant au moins un sommet commun avec l'élément considéré.
  660. C
  661. 340 CONTINUE
  662. CALL ACMM(MTABLE,'SOUSTYPE',TYPE)
  663. IF (TYPE.NE.'DOMAINE ') GOTO 5010
  664. TYPE=' '
  665. * CALL ACMO(MTABLE,'MMAIL',TYPE,MMELEM)
  666. CALL ACMO(MTABLE,'MAILLAGE',TYPE,MMELEM)
  667. IF (TYPE.NE.'MAILLAGE') THEN
  668. C Indice %m1:8 : Objet de type %m9:16 incorrect
  669.  
  670. MOTERR(1:8) = NOM
  671. MOTERR(9:16) = TYPE
  672. CALL ERREUR(787)
  673. RETURN
  674. ENDIF
  675. * IF (TYPE.NE.'MAILLAGE') THEN
  676. * I341 = 1
  677. * GOTO 1300
  678. * ENDIF
  679. 341 CONTINUE
  680. TYPE = ' '
  681. CALL ACMO(MTABLE,'CESOCE',TYPE,MSOCEN)
  682. IF (TYPE.NE.'MAILLAGE') THEN
  683. TYPE = 'MAILLAGE'
  684. CALL ACMO(MTABLE,'CENTRE',TYPE,MELCEN)
  685. * CALL ACMO(MTABLE,'MSOMMET',TYPE,MMLEMS)
  686. CALL ACMO(MTABLE,'SOMMET',TYPE,MMLEMS)
  687. CALL ELPOEL(MMELEM,MMLEMS,MELCEN,MCESOC)
  688. CALL ECMO(MTABLE,'CESOCE','MAILLAGE',MCESOC)
  689. ENDIF
  690. IPOINT = MCESOC
  691. IF(KECR.EQ.1)CALL ECROBJ('MAILLAGE',MCESOC)
  692. RETURN
  693. C
  694. C-*NORMALEV
  695. C
  696. 350 CONTINUE
  697. TYPE = ' '
  698. CALL ACMO(MTABLE,'NORMALEV',TYPE,MNORM)
  699. 351 CONTINUE
  700. IF (TYPE.NE.'MAILLAGE'.OR.IPREC.EQ.0) THEN
  701. TYPE = 'MAILLAGE'
  702. CALL ACMO(MTABLE,'QUAF',TYPE,MELEMQ)
  703. C petite verification
  704. SEGACT MELEMQ
  705. ICONF=1
  706. DO 62486 L=1,MAX(1,MELEMQ.LISOUS(/1))
  707. IPT1=MELEMQ
  708. IF(MELEMQ.LISOUS(/1).NE.0)IPT1=MELEMQ.LISOUS(L)
  709. SEGACT IPT1
  710. IF(IDIM.EQ.2.AND.NOMS(IPT1.ITYPEL).NE.'SEG3')THEN
  711. ICONF=0
  712. ENDIF
  713. IF(IDIM.EQ.3.AND.NOMS(IPT1.ITYPEL).NE.'TRI7'
  714. & .AND.NOMS(IPT1.ITYPEL).NE.'QUA9')THEN
  715. ICONF=0
  716. ENDIF
  717. 62486 CONTINUE
  718.  
  719. IF(ICONF.EQ.0)THEN
  720. TYPE=' '
  721. CALL ACMO(MTABLE,'ENVELOPP',TYPE,MENVEL)
  722. IF(TYPE.NE.'MAILLAGE')THEN
  723. CALL MENVLP(MELEMQ,MENVEL,MCHPOI,IRET)
  724. IF (IRET.EQ.0) GOTO 5000
  725. IF(ISTOK.EQ.1)CALL ECMO(MTABLE,'ENVELOPP','MAILLAGE',MENVEL)
  726. IF(ISTOK.EQ.1)CALL ECMO(MTABLE,'OENVELOP','CHPOINT',MCHPOI)
  727. IF(KECR.EQ.1.AND.NOMI.EQ.'ENVELOPP')
  728. & CALL ECROBJ('MAILLAGE',MENVEL)
  729. IF(KECR.EQ.1.AND.NOMI.EQ.'OENVELOP')CALL ECROBJ('CHPOINT',MCHPOI)
  730. ENDIF
  731. CALL ACME(MTABLE,'INEFMD',INEFMD)
  732. CALL ACMF(MTABLE,'TOLER',TOLER)
  733. CALL ACMM(MTABLE,'NOMDOM',NOMDOM)
  734. MACRO=0
  735. MTABI=0
  736. CALL KKDOM(MENVEL,MACRO,TOLER,NOMDOM,MTABI,MTABD,INEFMD)
  737. CALL ACMO(MTABD,'MAILLAGE',TYPE,MELEME)
  738. CALL ACMO(MTABD,'SOMMET',TYPE,MELEMS)
  739. ELSE
  740. CALL ACMO(MTABLE,'MAILLAGE',TYPE,MELEME)
  741. CALL ACMO(MTABLE,'SOMMET',TYPE,MELEMS)
  742. ENDIF
  743.  
  744. CALL NORMNO(MELEME,MELEMS,MNORM,IRET)
  745. IF (IRET.EQ.0) THEN
  746. C Indice %m1:8 : Objet de type %m9:16 incorrect
  747.  
  748. MOTERR(1:8) = 'NORMALEV'
  749. MOTERR(9:16) = TYPE
  750. CALL ERREUR(787)
  751. RETURN
  752. ENDIF
  753. ENDIF
  754. IF(ISTOK.EQ.1)CALL ECMO(MTABLE,'NORMALEV','CHPOINT',MNORM)
  755. IPOINT=MNORM
  756. IF(NOM.EQ.'OENVELOP')IPOINT=MCHPOI
  757. IF(KECR.EQ.1.AND.NOMI.EQ.'NORMALEV')CALL ECROBJ('CHPOINT',MNORM)
  758. IF(KECR.EQ.1.AND.NOMI.EQ.'OENVELOP')CALL ECROBJ('CHPOINT',MCHPOI)
  759.  
  760. RETURN
  761. C
  762. C-*OENVELOP
  763. C
  764. 360 CONTINUE
  765. CALL ACMM(MTABLE,'SOUSTYPE',TYPE)
  766. IF (TYPE.NE.'DOMAINE ') GOTO 5010
  767. TYPE=' '
  768. CALL ACMO(MTABLE,'OENVELOP',TYPE,MCHPOI)
  769. IF (TYPE.NE.'CHPOINT'.OR.IPREC.EQ.0)THEN
  770. TYPE=' '
  771. GO TO 351
  772. ENDIF
  773. IPOINT = MCHPOI
  774. IF(KECR.EQ.1)CALL ECROBJ('MAILLAGE',MELEME)
  775. RETURN
  776. C
  777. C-*DOMAINE.'XXMSOMME'
  778. C
  779. 370 CONTINUE
  780. TYPE = ' '
  781. CALL ACMO(MTABLE,'XXMSOMME',TYPE,MCHPOI)
  782. IF (TYPE.NE.'CHPOINT '.OR.IPREC.EQ.0) THEN
  783. C write(6,*) 'On ne trouve pas XXDIAGSI -> On le calcule'
  784. CALL ACMO(MTABLE,'MMAIL ',TYPE,MELEME)
  785. IF (TYPE.NE.'MAILLAGE') THEN
  786. I371 = 1
  787. GOTO 1300
  788. ENDIF
  789. CALL ECRCHA('MSOMMET')
  790. CALL ECROBJ('TABLE ',MTABLE)
  791. CALL CADGSI
  792. TYPE = 'CHPOINT '
  793. CALL LIROBJ(TYPE,MCHPOI,1,IRET)
  794. IF (IRET.EQ.0) GOTO 5000
  795. IF(ISTOK.EQ.1)CALL ECMO(MTABLE,'XXMSOMME','CHPOINT ',MCHPOI)
  796. ENDIF
  797. IPOINT = MCHPOI
  798. IF(KECR.EQ.1)CALL ECROBJ('CHPOINT ',MCHPOI)
  799. C write(6,*) 'Retour XXDIAGSI : MTABLE=',MTABLE
  800. RETURN
  801. C /\
  802. C-*DOMAINE.'MATEEF' : En chantier /! \ /
  803. C / <-/
  804. 380 CONTINUE
  805. CALL ACMM(MTABLE,'SOUSTYPE',TYPE)
  806. IF (TYPE.NE.'DOMAINE ') GOTO 5010
  807. TYPE=' '
  808. CALL ACMO(MTABLE,'MATEEF',TYPE,MATRIK)
  809. IF (TYPE.NE.'MATRIK '.OR.IPREC.EQ.0) THEN
  810. CALL ECROBJ('TABLE',MTABLE)
  811. C CALL HREF
  812. MOTERR(1:27) = ' LEKTAB : HREF hors service'
  813. CALL ERREUR(-301)
  814. TYPE='MATRIK'
  815. CALL LIROBJ(TYPE,MATRIK,1,IRET)
  816. IF (IRET.EQ.0) GOTO 5000
  817. IF(ISTOK.EQ.1)CALL ECMO(MTABLE,'MATEEF','MATRIK',MATRIK)
  818. ENDIF
  819. IPOINT = MATRIK
  820. IF(KECR.EQ.1)CALL ECROBJ('MATRIK',MATRIK)
  821. RETURN
  822. C
  823. C- DOMAINE.'ELKONV'
  824. C
  825. 390 CONTINUE
  826. CALL ACMM(MTABLE,'SOUSTYPE',TYPE)
  827. IF (TYPE.NE.'DOMAINE ') GOTO 5010
  828. TYPE = ' '
  829. CALL ACMO(MTABLE,'FACEL',TYPE,MELEMF)
  830. IF (TYPE.NE.'MAILLAGE') THEN
  831. C write(6,*)' LEKTAB FACEL n existe pas on le cree '
  832. I391 = 1
  833. GOTO 1100
  834. ENDIF
  835. C write(6,*)' LEKTAB FACEL existe '
  836. 391 CONTINUE
  837. TYPE = ' '
  838. CALL ACMO(MTABLE,'ELKONV',TYPE,MKONV)
  839. IF (TYPE.NE.'MAILLAGE') THEN
  840. TYPI = 'MAILLAGE'
  841. CALL ACMO(MTABLE,'FACE',TYPI,MELEF1)
  842. CALL ACMO(MTABLE,'FACEL',TYPI,MELEMF)
  843. CALL ACMO(MTABLE,'CENTRE',TYPI,MELEMK)
  844. CALL ACMO(MTABLE,'ELTFA',TYPI,MELAF)
  845. C write(6,*)' melef1,melemf,melemk,melaf='
  846. C & ,melef1,melemf,melemk,melaf
  847. CALL ELKONV(MELAF,MELEMF,MELEF1,MELEMK,MKONV)
  848. CALL ECMO(MTABLE,'ELKONV','MAILLAGE',MKONV)
  849. ENDIF
  850. IPOINT = MKONV
  851. IF(KECR.EQ.1)CALL ECROBJ('MAILLAGE',MKONV)
  852. RETURN
  853. C
  854. C-*DOMAINE.'XXDIAGFA'
  855. C
  856. 400 CONTINUE
  857. TYPE=' '
  858. CALL ACMO(MTABLE,'XXDIAGFA',TYPE,MCHPOI)
  859. IF(TYPE.NE.'CHPOINT '.OR.IPREC.EQ.0)THEN
  860. C write(6,*)' On a pas trouve XXDIAGFA On le calcule '
  861. CALL ECROBJ('TABLE ',MTABLE)
  862. CALL CADGFA
  863. TYPE='CHPOINT '
  864. CALL LIROBJ(TYPE,MCHPOI,1,IRET)
  865. IF (IRET.EQ.0) GOTO 5000
  866. IF(ISTOK.EQ.1)CALL ECMO(MTABLE,'XXDIAGFA','CHPOINT ',MCHPOI)
  867. ENDIF
  868. IPOINT = MCHPOI
  869. IF(KECR.EQ.1)CALL ECROBJ('CHPOINT ',MCHPOI)
  870. C write(6,*)' retour XXDIAGFA : MTABLE=',MTABLE
  871. RETURN
  872. C
  873. C- ????.'M1BULLE' : En chantier
  874. C
  875. 410 CONTINUE
  876. TYPE = ' '
  877. CALL ACMO(MTABLE,'M1BULLE',TYPE,IPOINT)
  878. IF(TYPE.NE.'MAILLAGE')THEN
  879. C write(6,*)' On a pas trouve M1BULLE On le calcule '
  880. CALL ACMO(MTABLE,'MAILLAGE',TYPI,MELEME)
  881. CALL ACMO(MTABLE,'CENTRE',TYPI,MELEMC)
  882. CALL GENMCT(MELEME,MELEMC,IPOINT)
  883. CALL ECMO(MTABLE,'M1BULLE','MAILLAGE',IPOINT)
  884. IF(KECR.EQ.1)CALL ECROBJ('MAILLAGE',IPOINT)
  885. ENDIF
  886. RETURN
  887. C
  888. C- DOMAINE.'CENTREP0'
  889. C
  890. 420 CONTINUE
  891. TYPE = ' '
  892. CALL ACMO(MTABLE,'CENTREP0',TYPE,IPOINT)
  893. IF (TYPE.NE.'MAILLAGE') THEN
  894. CALL KCTRP0(MTABLE,IPOINT)
  895. ENDIF
  896. IF(KECR.EQ.1)CALL ECROBJ('MAILLAGE',IPOINT)
  897. RETURN
  898. C
  899. C- DOMAINE.'ELTP1NC '
  900. C
  901. 430 CONTINUE
  902. IF(INEFMD.EQ.0.OR.INEFMD.EQ.1.OR.INEFMD.EQ.4)GO TO 5000
  903. TYPE=' '
  904. CALL ACMO(MTABLE,'ELTP1NC ',TYPE,IPOINT)
  905. IF (TYPE.NE.'MAILLAGE') THEN
  906. CALL KCTRP1(MTABLE,IPOINT,2)
  907. ENDIF
  908. IF(KECR.EQ.1)CALL ECROBJ('MAILLAGE',IPOINT)
  909. RETURN
  910. C
  911. C- DOMAINE.'CENTREP1'
  912. C
  913. 440 CONTINUE
  914. IF(INEFMD.EQ.0.OR.INEFMD.EQ.1.OR.INEFMD.EQ.4)GO TO 5000
  915. TYPE=' '
  916. CALL ACMO(MTABLE,'CENTREP1',TYPE,IPOINT)
  917. IF (TYPE.NE.'MAILLAGE') THEN
  918. CALL KCTRP1(MTABLE,IPOINT,1)
  919. ENDIF
  920. IF(KECR.EQ.1)CALL ECROBJ('MAILLAGE',IPOINT)
  921. RETURN
  922. C
  923. C-*DOMAINE.'VOLUMAC '
  924. C
  925. 450 CONTINUE
  926. TYPE=' '
  927. CALL ACMO(MTABLE,'VOLUMAC ',TYPE,IPOINT)
  928. IF(IPOINT.NE.0)RETURN
  929.  
  930. TYPE=' '
  931. CALL ACMO(MTABLE,'MACRO',TYPE,MELEME)
  932. IF(MELEME.EQ.0)THEN
  933. C Indice %m1:8 : Objet de type %m9:16 incorrect
  934.  
  935. MOTERR(1:8) = 'VOLUMAC '
  936. MOTERR(9:16) = 'NONMACRO'
  937. CALL ERREUR(787)
  938. RETURN
  939. ENDIF
  940.  
  941. TYPE=' '
  942. CALL ACMO(MTABLE,'MACRO1',TYPE,MELEME)
  943. IF (TYPE.NE.'MAILLAGE') THEN
  944. CALL KMACRO(MACRO,MELEME,MTABLE)
  945. RETURN
  946. ENDIF
  947. TYPE = ' '
  948. CALL ACMO(MTABLE,'CENTREP0',TYPE,MELEMQ)
  949. IF (TYPE.NE.'MAILLAGE') THEN
  950. CALL KCTRP0(MTABLE,MELEMQ)
  951. RETURN
  952. ENDIF
  953.  
  954. CALL KVOL(MELEME,MELEMQ,'CENTREP0',IPOINT)
  955. IF(ISTOK.EQ.1)CALL ECMO(MTABLE,'VOLUMAC ','CHPOINT ',IPOINT)
  956. IF(KECR.EQ.1)CALL ECROBJ('CHPOINT ',IPOINT)
  957. RETURN
  958.  
  959. C
  960. C- DOMAINE.'MACRO '
  961. C
  962. 460 CONTINUE
  963. TYPE=' '
  964. CALL ACMO(MTABLE,'MACRO',TYPE,MELEME)
  965. IPOINT = MELEME
  966. IF(KECR.EQ.1)CALL ECROBJ('MAILLAGE',MELEME)
  967. RETURN
  968. C
  969. C- DOMAINE.'QUADRATI'
  970. C
  971. 470 CONTINUE
  972. TYPE=' '
  973. CALL ACMO(MTABLE,'QUADRATI',TYPE,MELEME)
  974. IPOINT = MELEME
  975. IF(KECR.EQ.1)CALL ECROBJ('MAILLAGE',MELEME)
  976. RETURN
  977. C
  978. C- DOMAINE.'MACRO1'
  979. C
  980. 480 CONTINUE
  981. TYPE=' '
  982. CALL ACMO(MTABLE,'MACRO1',TYPE,MELEME)
  983. IF (TYPE.NE.'MAILLAGE') THEN
  984. TYPE=' '
  985. CALL ACMO(MTABLE,'MACRO',TYPE,MACRO)
  986. IF(TYPE.NE.'MAILLAGE')THEN
  987. TYPE=' '
  988. CALL ACMO(MTABLE,'MAILLAGE',TYPE,IPOINT)
  989. RETURN
  990. ELSE
  991. CALL KMACRO(MACRO,IPOINT,MTABLE)
  992. RETURN
  993. ENDIF
  994. ENDIF
  995.  
  996. IPOINT = MELEME
  997. IF(KECR.EQ.1)CALL ECROBJ('MAILLAGE',MELEME)
  998. RETURN
  999. C
  1000. C-*????.'XXDXDY' : En chantier
  1001. C
  1002. 490 CONTINUE
  1003. TYPE = ' '
  1004. CALL ACMO(MTABLE,'XXDXDY',TYPE,MCHPOI)
  1005. C write(6,*)' ACMO XXDXDY : MTABLE=',MTABLE
  1006. IF (TYPE.NE.'CHPOINT '.OR.IPREC.EQ.0) THEN
  1007. C write(6,*)' On a pas trouve XXDXDY On le calcule '
  1008. CALL ECROBJ('TABLE ',MTABLE)
  1009. C write(6,*)' ECROBJ XXDXDY : MTABLE=',MTABLE
  1010. CALL KDXDY
  1011. TYPE = 'CHPOINT '
  1012. CALL LIROBJ(TYPE,MCHPOI,1,IRET)
  1013. IF (IRET.EQ.0) GOTO 5000
  1014. IF(ISTOK.EQ.1)CALL ECMO(MTABLE,'XXDXDY','CHPOINT ',MCHPOI)
  1015. ENDIF
  1016. IPOINT = MCHPOI
  1017. IF(KECR.EQ.1)CALL ECROBJ('CHPOINT ',MCHPOI)
  1018. C write(6,*)' retour XXDXDY : MTABLE=',MTABLE
  1019. RETURN
  1020. C
  1021. C- DOMAINE.'MSOMMET'
  1022. C
  1023. 500 CONTINUE
  1024. CALL ACMM(MTABLE,'SOUSTYPE',TYPE)
  1025. IF (TYPE.NE.'DOMAINE ') GOTO 5010
  1026. TYPE=' '
  1027. CALL ACMO(MTABLE,'MSOMMET ',TYPE,MMLEMS)
  1028. IF(TYPE.NE.'MAILLAGE')THEN
  1029. I501 = 1
  1030. GO TO 1300
  1031. ENDIF
  1032. 501 CONTINUE
  1033. IPOINT = MMLEMS
  1034. IF(KECR.EQ.1)CALL ECROBJ('MAILLAGE',MMLEMS)
  1035. RETURN
  1036. C
  1037. C- DOMAINE.'MMAIL '
  1038. C
  1039. 510 CONTINUE
  1040. CALL ACMM(MTABLE,'SOUSTYPE',TYPE)
  1041. IF (TYPE.NE.'DOMAINE ') GOTO 5010
  1042. TYPE=' '
  1043. CALL ACMO(MTABLE,'MMAIL ',TYPE,MMELEM)
  1044. IF(TYPE.NE.'MAILLAGE')THEN
  1045. I511 = 1
  1046. GOTO 1300
  1047. ENDIF
  1048. 511 CONTINUE
  1049. IPOINT = MMELEM
  1050. IF(KECR.EQ.1)CALL ECROBJ('MAILLAGE',MMELEM)
  1051. RETURN
  1052. C
  1053. C- DOMAINE.'MLGVNIMP'
  1054. C
  1055. 520 CONTINUE
  1056. CALL ACMM(MTABLE,'SOUSTYPE',TYPE)
  1057. IF (TYPE.NE.'DOMAINE ') GOTO 5010
  1058. TYPE=' '
  1059. CALL ACMO(MTABLE,'MLGVNIMP',TYPE,MELETI)
  1060.  
  1061. IF(TYPE.EQ.'MAILLAGE')THEN
  1062. IPOINT = MELETI
  1063. IF(KECR.EQ.1)CALL ECROBJ('MAILLAGE',MELETI)
  1064. RETURN
  1065. ELSE
  1066. TYPE=' '
  1067. CALL ACMO(MTABLE,'SOMMET',TYPE,MELEME)
  1068. IF (TYPE.NE.'MAILLAGE') GO TO 5000
  1069. CALL MEULTI(MELEME,MELETI,TYPE)
  1070. IF (TYPE.NE.'MAILLAGE') THEN
  1071. C Indice %m1:8 : Objet de type %m9:16 incorrect
  1072.  
  1073. MOTERR(1:8) = NOM
  1074. MOTERR(9:16) = TYPE
  1075. CALL ERREUR(787)
  1076. RETURN
  1077. ENDIF
  1078. CALL ECMO(MTABLE,'MLGVNIMP','MAILLAGE',MELETI)
  1079. IPOINT = MELETI
  1080. IF(KECR.EQ.1)CALL ECROBJ('MAILLAGE',MELETI)
  1081. RETURN
  1082. ENDIF
  1083. C
  1084. C- DOMAINE.'MLGVTIMP'
  1085. C
  1086. 530 CONTINUE
  1087. CALL ACMM(MTABLE,'SOUSTYPE',TYPE)
  1088. IF (TYPE.NE.'DOMAINE ') GOTO 5010
  1089. TYPE=' '
  1090. CALL ACMO(MTABLE,'MLGVTIMP',TYPE,MELETI)
  1091.  
  1092. IF(TYPE.EQ.'MAILLAGE')THEN
  1093. IPOINT = MELETI
  1094. IF(KECR.EQ.1)CALL ECROBJ('MAILLAGE',MELETI)
  1095. RETURN
  1096. ELSE
  1097. TYPE=' '
  1098. CALL ACMO(MTABLE,'SOMMET',TYPE,MELEME)
  1099. IF (TYPE.NE.'MAILLAGE') GO TO 5000
  1100. CALL MEULTI(MELEME,MELETI,TYPE)
  1101. IF (TYPE.NE.'MAILLAGE') THEN
  1102. C Indice %m1:8 : Objet de type %m9:16 incorrect
  1103.  
  1104. MOTERR(1:8) = NOM
  1105. MOTERR(9:16) = TYPE
  1106. CALL ERREUR(787)
  1107. RETURN
  1108. ENDIF
  1109. CALL ECMO(MTABLE,'MLGVTIMP','MAILLAGE',MELETI)
  1110. IPOINT = MELETI
  1111. IF(KECR.EQ.1)CALL ECROBJ('MAILLAGE',MELETI)
  1112. RETURN
  1113. ENDIF
  1114. C
  1115. C- DOMAINE.'ENVELOPP'
  1116. C
  1117. 540 CONTINUE
  1118. CALL ACMM(MTABLE,'SOUSTYPE',TYPE)
  1119. IF (TYPE.NE.'DOMAINE ') GOTO 5010
  1120. TYPE=' '
  1121. CALL ACMO(MTABLE,'ENVELOPP',TYPE,MENVEL)
  1122.  
  1123. IF(TYPE.EQ.'MAILLAGE')THEN
  1124. IPOINT = MENVEL
  1125. IF(KECR.EQ.1)CALL ECROBJ('MAILLAGE',MENVEL)
  1126. RETURN
  1127. ELSE
  1128. TYPE = ' '
  1129. C CALL ACMO(MTABLE,'FACEP',TYPE,MELEMP)
  1130. CALL ACMO(MTABLE,'FACEL2',TYPE,MELEF2)
  1131. IF (TYPE.NE.'MAILLAGE') THEN
  1132. I541 = 1
  1133. GOTO 1100
  1134. ENDIF
  1135. ENDIF
  1136. 541 CONTINUE
  1137. TYPE = ' '
  1138. CALL ACMO(MTABLE,'QUAF',TYPE,MELEMQ)
  1139. 542 CONTINUE
  1140. CALL MENVLP(MELEMQ,MENVEL,MCHPOI,IRET)
  1141. IF (IRET.EQ.0) GOTO 5000
  1142. IF(ISTOK.EQ.1)CALL ECMO(MTABLE,'ENVELOPP','MAILLAGE',MENVEL)
  1143. IF(ISTOK.EQ.1)CALL ECMO(MTABLE,'OENVELOP','CHPOINT',MCHPOI)
  1144. IPOINT = MENVEL
  1145. IF(KECR.EQ.1.AND.NOMI.EQ.'ENVELOPP')
  1146. & CALL ECROBJ('MAILLAGE',MENVEL)
  1147. RETURN
  1148. C
  1149. C- DOMAINE.'FACEL2' : MELEME connectivite face -> centre (partitionne)
  1150. C rgt partitionne
  1151. 550 CONTINUE
  1152. CALL ACMM(MTABLE,'SOUSTYPE',TYPE)
  1153. IF (TYPE.NE.'DOMAINE ') GOTO 5010
  1154. TYPE = ' '
  1155. CALL ACMO(MTABLE,'FACEL2',TYPE,MELEF2)
  1156. IF (TYPE.NE.'MAILLAGE') THEN
  1157. I551 = 1
  1158. GOTO 1100
  1159. ENDIF
  1160. 551 CONTINUE
  1161. IPOINT = MELEF2
  1162. IF(KECR.EQ.1)CALL ECROBJ('MAILLAGE',MELEF2)
  1163. RETURN
  1164. C
  1165. C- DOMAINE.'QUAF ' : Maillage QUAF du domaine considéré
  1166. C
  1167. 560 CONTINUE
  1168. CALL ACMM(MTABLE,'SOUSTYPE',TYPE)
  1169. IF (TYPE.NE.'DOMAINE ') GOTO 5010
  1170. TYPE=' '
  1171. CALL ACMO(MTABLE,'QUAF ',TYPE,MELEME)
  1172. IF (TYPE.NE.'MAILLAGE') THEN
  1173. C Indice %m1:8 : Objet de type %m9:16 incorrect
  1174.  
  1175. MOTERR(1:8) = NOM
  1176. MOTERR(9:16) = TYPE
  1177. CALL ERREUR(787)
  1178. RETURN
  1179. ENDIF
  1180. IPOINT = MELEME
  1181. IF(KECR.EQ.1)CALL ECROBJ('MAILLAGE',MELEME)
  1182. RETURN
  1183. C
  1184. C- DOMAINE.'XXCTREP1'
  1185. C
  1186. 570 CONTINUE
  1187. TYPE = ' '
  1188. CALL ACMO(MTABLE,'XXCTREP1',TYPE,MCHPOI)
  1189. IF (TYPE.NE.'CHPOINT ') THEN
  1190. CALL ECRCHA('CENTREP1')
  1191. CALL ECROBJ('TABLE ',MTABLE)
  1192. CALL CADGSI
  1193. TYPE = 'CHPOINT '
  1194. CALL LIROBJ(TYPE,MCHPOI,1,IRET)
  1195. IF (IRET.EQ.0) GOTO 5000
  1196. IF(ISTOK.EQ.1)CALL ECMO(MTABLE,'XXCTREP1','CHPOINT ',MCHPOI)
  1197. ENDIF
  1198. IPOINT = MCHPOI
  1199. IF(KECR.EQ.1)CALL ECROBJ('CHPOINT ',MCHPOI)
  1200. C write(6,*) 'Retour XXDIAGSI : MTABLE=',MTABLE
  1201. RETURN
  1202. C
  1203. C- DOMAINE.'XXCTREP0'
  1204. C
  1205. 580 CONTINUE
  1206. TYPE = ' '
  1207. CALL ACMO(MTABLE,'XXCTREP0',TYPE,MCHPOI)
  1208. IF (TYPE.NE.'CHPOINT ') THEN
  1209. TYPE = ' '
  1210. CALL ACMO(MTABLE,'XXVOLUM ',TYPE,MCHPOI)
  1211. IF (TYPE.NE.'CHPOINT ') THEN
  1212. write(6,*) 'On ne trouve pas XXVOLUM -> On le calcule'
  1213. TYPE=' '
  1214. CALL ACMO(MTABLE,'CENTRE',TYPE,MELEMC)
  1215. CALL ACMO(MTABLE,'MAILLAGE',TYPE,MELEME)
  1216. CALL KVOL(MELEME,MELEMC,'CENTRE',MCHPOI)
  1217. IF(ISTOK.EQ.1)CALL ECMO(MTABLE,'XXCTREP0','CHPOINT ',MCHPOI)
  1218. IF(ISTOK.EQ.1)CALL ECMO(MTABLE,'XXVOLUM ','CHPOINT ',MCHPOI)
  1219. ENDIF
  1220. ENDIF
  1221. IPOINT = MCHPOI
  1222. IF(KECR.EQ.1)CALL ECROBJ('CHPOINT ',MCHPOI)
  1223. RETURN
  1224. C
  1225. C- DOMAINE.'MAILFACE' : MELEME des elements face
  1226. C
  1227. 590 CONTINUE
  1228. CALL ACMM(MTABLE,'SOUSTYPE',TYPE)
  1229. IF (TYPE.NE.'DOMAINE ') GOTO 5010
  1230. TYPE = ' '
  1231. CALL ACMO(MTABLE,'MAILFACE',TYPE,MFF2)
  1232. IF (TYPE.NE.'MAILLAGE') THEN
  1233. I591 = 1
  1234. GOTO 1100
  1235. ENDIF
  1236. 591 CONTINUE
  1237. IPOINT = MFF2
  1238. IF(KECR.EQ.1)CALL ECROBJ('MAILLAGE',MFF2)
  1239. RETURN
  1240. C
  1241. C- DOMAINE.'ARETE ' : MELEME des éléments arêtes
  1242. C
  1243. 600 CONTINUE
  1244. CALL ACMM(MTABLE,'SOUSTYPE',TYPE)
  1245. IF (TYPE.NE.'DOMAINE ') GOTO 5010
  1246. TYPE = ' '
  1247. CALL ACMO(MTABLE,'QUAF ',TYPE,MELEME)
  1248. IF (TYPE.NE.'MAILLAGE') THEN
  1249. C Indice %m1:8 : Objet de type %m9:16 incorrect
  1250.  
  1251. MOTERR(1:8) = NOM
  1252. MOTERR(9:16) = TYPE
  1253. CALL ERREUR(787)
  1254. RETURN
  1255. ENDIF
  1256. TYPE = ' '
  1257. CALL ACMO(MTABLE,'ARETE ',TYPE,MARET)
  1258. IF (TYPE.NE.'MAILLAGE') THEN
  1259. CALL ECROBJ('MAILLAGE',MELEME)
  1260. CALL CHANLG
  1261. CALL LIROBJ('MAILLAGE',MARET,1,IRETOU)
  1262. IF (IRETOU.NE.1) THEN
  1263. C Indice %m1:8 : Objet de type %m9:16 incorrect
  1264.  
  1265. MOTERR(1:8) = 'ARETE'
  1266. MOTERR(9:16) = 'MAILLAGE'
  1267. CALL ERREUR(787)
  1268. RETURN
  1269. ENDIF
  1270. ENDIF
  1271. IPOINT = MARET
  1272. IF(KECR.EQ.1)CALL ECROBJ('MAILLAGE',MARET)
  1273. RETURN
  1274. C
  1275. C- Emplacement libre
  1276. C
  1277. 610 CONTINUE
  1278. IPOINT = 0
  1279. RETURN
  1280. C
  1281. C
  1282. C---------------------------------------------------------
  1283. C Traitement commun à plusieures options et mise en facteur
  1284. C---------------------------------------------------------
  1285. C
  1286. C
  1287. C- Recherche à l'indice mot MIND d'une table de sous-type MINDS
  1288. C- ATTENTION : ERREUR NON GERE POUR L'INSTANT : Si IPTR.EQ.0 5000
  1289. C
  1290. 1000 CONTINUE
  1291. TYPE = ' '
  1292. CALL ACMO(MTABLE,MIND,TYPE,IPTR)
  1293. IF (TYPE.EQ.'TABLE ') THEN
  1294. TYPE = ' '
  1295. CALL ACMM(IPTR,'SOUSTYPE',TYPE)
  1296. IF (TYPE.EQ.MINDS) THEN
  1297. IPOINT = IPTR
  1298. ENDIF
  1299. ELSE IF(TYPE.EQ.'MMODEL')THEN
  1300. CALL LEKMOD(IPTR,IPOINT,INEFMD)
  1301. IF(IPOINT.EQ.0)RETURN
  1302. ENDIF
  1303. RETURN
  1304. C
  1305. C- Construction des indices 'FACE', 'FACEP', 'FACEL', 'CENTRE', 'ELTFA', 'FACEL2'
  1306. C- d'une table de sous-type 'DOMAINE' utilisé pour certaines options
  1307. C
  1308. 1100 CONTINUE
  1309. TYPE = ' '
  1310. CALL ACMO(MTABLE,'MAILLAGE',TYPE,MELEME)
  1311. IF (TYPE.NE.'MAILLAGE') GOTO 5000
  1312.  
  1313. NOMC=' '
  1314. CALL TQ2CF(MELEME,MELEMQ,MELEMK,
  1315. & MELEF1,MELAF,MELEMP,MELEMF,MELEF2,MFF2,NOMC,IKR)
  1316. IF(IKR.EQ.1)IQUAD=1
  1317.  
  1318. IF(IQUAD.EQ.1)THEN
  1319. CALL ECMO(MTABLE,'QUADRATIQUE','MAILLAGE',MELEME)
  1320. CALL ECMO(MTABLE,'MAILLAGE','MAILLAGE',MELEMQ)
  1321. ENDIF
  1322.  
  1323. CALL ECMO(MTABLE,'FACE','MAILLAGE',MELEF1)
  1324. CALL ECMO(MTABLE,'FACEL','MAILLAGE',MELEMF)
  1325. CALL ECMO(MTABLE,'FACEL2','MAILLAGE',MELEF2)
  1326. CALL ECMO(MTABLE,'FACEP','MAILLAGE',MELEMP)
  1327. CALL ECMO(MTABLE,'CENTRE','MAILLAGE',MELEMK)
  1328. CALL ECMO(MTABLE,'ELTFA','MAILLAGE',MELAF)
  1329. CALL ECMO(MTABLE,'MAILFACE','MAILLAGE',MFF2)
  1330.  
  1331. IF (I211 .EQ.1) GOTO 211
  1332. IF (I221 .EQ.1) GOTO 221
  1333. IF (I231 .EQ.1) GOTO 231
  1334. IF (I271 .EQ.1) GOTO 271
  1335. IF (I291 .EQ.1) GOTO 291
  1336. IF (I391 .EQ.1) GOTO 391
  1337. IF (I541 .EQ.1) GOTO 541
  1338. IF (I551 .EQ.1) GOTO 551
  1339. IF (I1201.EQ.1) GOTO 1201
  1340. IF (I591 .EQ.1) GOTO 591
  1341. C
  1342. C- Construction des indices 'XXNORMAE', 'XXSURFAC' et 'XXNORMAF'
  1343. C- d'une table de sous-type 'DOMAINE' utilisé pour certaines options
  1344. C
  1345. 1200 CONTINUE
  1346. TYPE = ' '
  1347. CALL ACMO(MTABLE,'FACE',TYPE,MELEME)
  1348. IF (TYPE.NE.'MAILLAGE') THEN
  1349. I1201 = 1
  1350. GOTO 1100
  1351. ENDIF
  1352. 1201 CONTINUE
  1353. CALL KNRF(MTABLE,ICHE,ICHPV,ICHP)
  1354. IF(ISTOK.EQ.1)THEN
  1355. CALL ECMO(MTABLE,'XXNORMAE','MCHAML ',ICHE)
  1356. CALL ECMO(MTABLE,'XXSURFAC','CHPOINT ',ICHP)
  1357. CALL ECMO(MTABLE,'XXNORMAF','CHPOINT ',ICHPV)
  1358. ENDIF
  1359.  
  1360. IF (I241.EQ.1) GOTO 241
  1361. IF (I251.EQ.1) GOTO 251
  1362. IF (I301.EQ.1) GOTO 301
  1363. IF (I542.EQ.1) GOTO 542
  1364. C
  1365. C Construction des indices 'MSOMMET' et 'MMAIL' d'une table
  1366. C de sous-types 'DOMAINE'.
  1367. C A l'indice 'MSOMMET', on trouve le maillage des "vrais"
  1368. C sommets (les sommets géométriques des éléments), par
  1369. C opposition à l'indice 'SOMMET' qui est le spg des inconnues
  1370. C définies dans l'espace L2.
  1371. C A l'indice 'MMAIL' qui lui correspond, on trouve le maillage
  1372. C des "vrais" éléments (les éléments géométriques :
  1373. C ils ont le type le plus simple pour un forme
  1374. C géométrique donnée (ex. TRI3, PYR5, CUB8...))
  1375. C par opposition à l'indice 'MAILLAGE' qui contient
  1376. C éventuellement des éléments avec plus de points qui sont les
  1377. C spg des différentes inconnues.
  1378. C spg=support géométrique.
  1379. C
  1380. 1300 CONTINUE
  1381. TYPE=' '
  1382. CALL ACMO(MTABLE,'QUAF ',TYPE,MELEME)
  1383. IF (TYPE.NE.'MAILLAGE') GO TO 5000
  1384. CALL MSOMET(MELEME,MMELEM,MMLEMS,TYPE)
  1385. IF (TYPE.NE.'MAILLAGE') THEN
  1386. C Indice %m1:8 : Objet de type %m9:16 incorrect
  1387.  
  1388. MOTERR(1:8) = NOM
  1389. MOTERR(9:16) = TYPE
  1390. CALL ERREUR(787)
  1391. RETURN
  1392. ENDIF
  1393. CALL ECMO(MTABLE,'MMAIL ','MAILLAGE',MMELEM)
  1394. CALL ECMO(MTABLE,'MSOMMET ','MAILLAGE',MMLEMS)
  1395.  
  1396. IF (I331.EQ.1) GOTO 331
  1397. IF (I341.EQ.1) GOTO 341
  1398. IF (I371.EQ.1) GOTO 370
  1399. IF (I501.EQ.1) GOTO 501
  1400. IF (I511.EQ.1) GOTO 511
  1401. C
  1402. C----------------------------------------
  1403. C Erreur détectée : traitement impossible
  1404. C----------------------------------------
  1405. C
  1406. 5000 CONTINUE
  1407. C Indice %m1:8 : Problème de données détecté dans lektab
  1408.  
  1409. IPOINT = 0
  1410. MOTERR(1:8) = NOM
  1411. CALL ERREUR(792)
  1412. RETURN
  1413. 5010 CONTINUE
  1414. C Indice %m1:8 : La table n'est pas de sous-type %m9:16
  1415.  
  1416. IPOINT = 0
  1417. MOTERR(1:8) = NOM
  1418. MOTERR(9:16) = 'DOMAINE '
  1419. CALL ERREUR(790)
  1420. RETURN
  1421. C
  1422. END
  1423.  
  1424.  
  1425.  
  1426.  
  1427.  
  1428.  
  1429.  
  1430.  
  1431.  
  1432.  
  1433.  
  1434.  
  1435.  
  1436.  
  1437.  
  1438.  
  1439.  
  1440.  
  1441.  
  1442.  
  1443.  
  1444.  
  1445.  
  1446.  
  1447.  
  1448.  
  1449.  
  1450.  
  1451.  
  1452.  
  1453.  
  1454.  
  1455.  
  1456.  
  1457.  
  1458.  

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