Télécharger lektab.eso

Retour à la liste

Numérotation des lignes :

  1. C LEKTAB SOURCE BP208322 16/11/18 21:18:42 9177
  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. SEGDES IPT1
  718. 62486 CONTINUE
  719. SEGDES MELEMQ
  720.  
  721. IF(ICONF.EQ.0)THEN
  722. TYPE=' '
  723. CALL ACMO(MTABLE,'ENVELOPP',TYPE,MENVEL)
  724. IF(TYPE.NE.'MAILLAGE')THEN
  725. CALL MENVLP(MELEMQ,MENVEL,MCHPOI,IRET)
  726. IF (IRET.EQ.0) GOTO 5000
  727. IF(ISTOK.EQ.1)CALL ECMO(MTABLE,'ENVELOPP','MAILLAGE',MENVEL)
  728. IF(ISTOK.EQ.1)CALL ECMO(MTABLE,'OENVELOP','CHPOINT',MCHPOI)
  729. IF(KECR.EQ.1.AND.NOMI.EQ.'ENVELOPP')
  730. & CALL ECROBJ('MAILLAGE',MENVEL)
  731. IF(KECR.EQ.1.AND.NOMI.EQ.'OENVELOP')CALL ECROBJ('CHPOINT',MCHPOI)
  732. ENDIF
  733. CALL ACME(MTABLE,'INEFMD',INEFMD)
  734. CALL ACMF(MTABLE,'TOLER',TOLER)
  735. CALL ACMM(MTABLE,'NOMDOM',NOMDOM)
  736. MACRO=0
  737. MTABI=0
  738. CALL KKDOM(MENVEL,MACRO,TOLER,NOMDOM,MTABI,MTABD,INEFMD)
  739. CALL ACMO(MTABD,'MAILLAGE',TYPE,MELEME)
  740. CALL ACMO(MTABD,'SOMMET',TYPE,MELEMS)
  741. ELSE
  742. CALL ACMO(MTABLE,'MAILLAGE',TYPE,MELEME)
  743. CALL ACMO(MTABLE,'SOMMET',TYPE,MELEMS)
  744. ENDIF
  745.  
  746. CALL NORMNO(MELEME,MELEMS,MNORM,IRET)
  747. IF (IRET.EQ.0) THEN
  748. C Indice %m1:8 : Objet de type %m9:16 incorrect
  749.  
  750. MOTERR(1:8) = 'NORMALEV'
  751. MOTERR(9:16) = TYPE
  752. CALL ERREUR(787)
  753. RETURN
  754. ENDIF
  755. ENDIF
  756. IF(ISTOK.EQ.1)CALL ECMO(MTABLE,'NORMALEV','CHPOINT',MNORM)
  757. IPOINT=MNORM
  758. IF(NOM.EQ.'OENVELOP')IPOINT=MCHPOI
  759. IF(KECR.EQ.1.AND.NOMI.EQ.'NORMALEV')CALL ECROBJ('CHPOINT',MNORM)
  760. IF(KECR.EQ.1.AND.NOMI.EQ.'OENVELOP')CALL ECROBJ('CHPOINT',MCHPOI)
  761.  
  762. RETURN
  763. C
  764. C-*OENVELOP
  765. C
  766. 360 CONTINUE
  767. CALL ACMM(MTABLE,'SOUSTYPE',TYPE)
  768. IF (TYPE.NE.'DOMAINE ') GOTO 5010
  769. TYPE=' '
  770. CALL ACMO(MTABLE,'OENVELOP',TYPE,MCHPOI)
  771. IF (TYPE.NE.'CHPOINT'.OR.IPREC.EQ.0)THEN
  772. TYPE=' '
  773. GO TO 351
  774. ENDIF
  775. IPOINT = MCHPOI
  776. IF(KECR.EQ.1)CALL ECROBJ('MAILLAGE',MELEME)
  777. RETURN
  778. C
  779. C-*DOMAINE.'XXMSOMME'
  780. C
  781. 370 CONTINUE
  782. TYPE = ' '
  783. CALL ACMO(MTABLE,'XXMSOMME',TYPE,MCHPOI)
  784. IF (TYPE.NE.'CHPOINT '.OR.IPREC.EQ.0) THEN
  785. C write(6,*) 'On ne trouve pas XXDIAGSI -> On le calcule'
  786. CALL ACMO(MTABLE,'MMAIL ',TYPE,MELEME)
  787. IF (TYPE.NE.'MAILLAGE') THEN
  788. I371 = 1
  789. GOTO 1300
  790. ENDIF
  791. CALL ECRCHA('MSOMMET')
  792. CALL ECROBJ('TABLE ',MTABLE)
  793. CALL CADGSI
  794. TYPE = 'CHPOINT '
  795. CALL LIROBJ(TYPE,MCHPOI,1,IRET)
  796. IF (IRET.EQ.0) GOTO 5000
  797. IF(ISTOK.EQ.1)CALL ECMO(MTABLE,'XXMSOMME','CHPOINT ',MCHPOI)
  798. ENDIF
  799. IPOINT = MCHPOI
  800. IF(KECR.EQ.1)CALL ECROBJ('CHPOINT ',MCHPOI)
  801. C write(6,*) 'Retour XXDIAGSI : MTABLE=',MTABLE
  802. RETURN
  803. C /\
  804. C-*DOMAINE.'MATEEF' : En chantier /! \ /
  805. C / <-/
  806. 380 CONTINUE
  807. CALL ACMM(MTABLE,'SOUSTYPE',TYPE)
  808. IF (TYPE.NE.'DOMAINE ') GOTO 5010
  809. TYPE=' '
  810. CALL ACMO(MTABLE,'MATEEF',TYPE,MATRIK)
  811. IF (TYPE.NE.'MATRIK '.OR.IPREC.EQ.0) THEN
  812. CALL ECROBJ('TABLE',MTABLE)
  813. C CALL HREF
  814. MOTERR(1:27) = ' LEKTAB : HREF hors service'
  815. CALL ERREUR(-301)
  816. TYPE='MATRIK'
  817. CALL LIROBJ(TYPE,MATRIK,1,IRET)
  818. IF (IRET.EQ.0) GOTO 5000
  819. IF(ISTOK.EQ.1)CALL ECMO(MTABLE,'MATEEF','MATRIK',MATRIK)
  820. ENDIF
  821. IPOINT = MATRIK
  822. IF(KECR.EQ.1)CALL ECROBJ('MATRIK',MATRIK)
  823. RETURN
  824. C
  825. C- DOMAINE.'ELKONV'
  826. C
  827. 390 CONTINUE
  828. CALL ACMM(MTABLE,'SOUSTYPE',TYPE)
  829. IF (TYPE.NE.'DOMAINE ') GOTO 5010
  830. TYPE = ' '
  831. CALL ACMO(MTABLE,'FACEL',TYPE,MELEMF)
  832. IF (TYPE.NE.'MAILLAGE') THEN
  833. C write(6,*)' LEKTAB FACEL n existe pas on le cree '
  834. I391 = 1
  835. GOTO 1100
  836. ENDIF
  837. C write(6,*)' LEKTAB FACEL existe '
  838. 391 CONTINUE
  839. TYPE = ' '
  840. CALL ACMO(MTABLE,'ELKONV',TYPE,MKONV)
  841. IF (TYPE.NE.'MAILLAGE') THEN
  842. TYPI = 'MAILLAGE'
  843. CALL ACMO(MTABLE,'FACE',TYPI,MELEF1)
  844. CALL ACMO(MTABLE,'FACEL',TYPI,MELEMF)
  845. CALL ACMO(MTABLE,'CENTRE',TYPI,MELEMK)
  846. CALL ACMO(MTABLE,'ELTFA',TYPI,MELAF)
  847. C write(6,*)' melef1,melemf,melemk,melaf='
  848. C & ,melef1,melemf,melemk,melaf
  849. CALL ELKONV(MELAF,MELEMF,MELEF1,MELEMK,MKONV)
  850. CALL ECMO(MTABLE,'ELKONV','MAILLAGE',MKONV)
  851. ENDIF
  852. IPOINT = MKONV
  853. IF(KECR.EQ.1)CALL ECROBJ('MAILLAGE',MKONV)
  854. RETURN
  855. C
  856. C-*DOMAINE.'XXDIAGFA'
  857. C
  858. 400 CONTINUE
  859. TYPE=' '
  860. CALL ACMO(MTABLE,'XXDIAGFA',TYPE,MCHPOI)
  861. IF(TYPE.NE.'CHPOINT '.OR.IPREC.EQ.0)THEN
  862. C write(6,*)' On a pas trouve XXDIAGFA On le calcule '
  863. CALL ECROBJ('TABLE ',MTABLE)
  864. CALL CADGFA
  865. TYPE='CHPOINT '
  866. CALL LIROBJ(TYPE,MCHPOI,1,IRET)
  867. IF (IRET.EQ.0) GOTO 5000
  868. IF(ISTOK.EQ.1)CALL ECMO(MTABLE,'XXDIAGFA','CHPOINT ',MCHPOI)
  869. ENDIF
  870. IPOINT = MCHPOI
  871. IF(KECR.EQ.1)CALL ECROBJ('CHPOINT ',MCHPOI)
  872. C write(6,*)' retour XXDIAGFA : MTABLE=',MTABLE
  873. RETURN
  874. C
  875. C- ????.'M1BULLE' : En chantier
  876. C
  877. 410 CONTINUE
  878. TYPE = ' '
  879. CALL ACMO(MTABLE,'M1BULLE',TYPE,IPOINT)
  880. IF(TYPE.NE.'MAILLAGE')THEN
  881. C write(6,*)' On a pas trouve M1BULLE On le calcule '
  882. CALL ACMO(MTABLE,'MAILLAGE',TYPI,MELEME)
  883. CALL ACMO(MTABLE,'CENTRE',TYPI,MELEMC)
  884. CALL GENMCT(MELEME,MELEMC,IPOINT)
  885. CALL ECMO(MTABLE,'M1BULLE','MAILLAGE',IPOINT)
  886. IF(KECR.EQ.1)CALL ECROBJ('MAILLAGE',IPOINT)
  887. ENDIF
  888. RETURN
  889. C
  890. C- DOMAINE.'CENTREP0'
  891. C
  892. 420 CONTINUE
  893. TYPE = ' '
  894. CALL ACMO(MTABLE,'CENTREP0',TYPE,IPOINT)
  895. IF (TYPE.NE.'MAILLAGE') THEN
  896. CALL KCTRP0(MTABLE,IPOINT)
  897. ENDIF
  898. IF(KECR.EQ.1)CALL ECROBJ('MAILLAGE',IPOINT)
  899. RETURN
  900. C
  901. C- DOMAINE.'ELTP1NC '
  902. C
  903. 430 CONTINUE
  904. IF(INEFMD.EQ.0.OR.INEFMD.EQ.1.OR.INEFMD.EQ.4)GO TO 5000
  905. TYPE=' '
  906. CALL ACMO(MTABLE,'ELTP1NC ',TYPE,IPOINT)
  907. IF (TYPE.NE.'MAILLAGE') THEN
  908. CALL KCTRP1(MTABLE,IPOINT,2)
  909. ENDIF
  910. IF(KECR.EQ.1)CALL ECROBJ('MAILLAGE',IPOINT)
  911. RETURN
  912. C
  913. C- DOMAINE.'CENTREP1'
  914. C
  915. 440 CONTINUE
  916. IF(INEFMD.EQ.0.OR.INEFMD.EQ.1.OR.INEFMD.EQ.4)GO TO 5000
  917. TYPE=' '
  918. CALL ACMO(MTABLE,'CENTREP1',TYPE,IPOINT)
  919. IF (TYPE.NE.'MAILLAGE') THEN
  920. CALL KCTRP1(MTABLE,IPOINT,1)
  921. ENDIF
  922. IF(KECR.EQ.1)CALL ECROBJ('MAILLAGE',IPOINT)
  923. RETURN
  924. C
  925. C-*DOMAINE.'VOLUMAC '
  926. C
  927. 450 CONTINUE
  928. TYPE=' '
  929. CALL ACMO(MTABLE,'VOLUMAC ',TYPE,IPOINT)
  930. IF(IPOINT.NE.0)RETURN
  931.  
  932. TYPE=' '
  933. CALL ACMO(MTABLE,'MACRO',TYPE,MELEME)
  934. IF(MELEME.EQ.0)THEN
  935. C Indice %m1:8 : Objet de type %m9:16 incorrect
  936.  
  937. MOTERR(1:8) = 'VOLUMAC '
  938. MOTERR(9:16) = 'NONMACRO'
  939. CALL ERREUR(787)
  940. RETURN
  941. ENDIF
  942.  
  943. TYPE=' '
  944. CALL ACMO(MTABLE,'MACRO1',TYPE,MELEME)
  945. IF (TYPE.NE.'MAILLAGE') THEN
  946. CALL KMACRO(MACRO,MELEME,MTABLE)
  947. RETURN
  948. ENDIF
  949. TYPE = ' '
  950. CALL ACMO(MTABLE,'CENTREP0',TYPE,MELEMQ)
  951. IF (TYPE.NE.'MAILLAGE') THEN
  952. CALL KCTRP0(MTABLE,MELEMQ)
  953. RETURN
  954. ENDIF
  955.  
  956. CALL KVOL(MELEME,MELEMQ,'CENTREP0',IPOINT)
  957. IF(ISTOK.EQ.1)CALL ECMO(MTABLE,'VOLUMAC ','CHPOINT ',IPOINT)
  958. IF(KECR.EQ.1)CALL ECROBJ('CHPOINT ',IPOINT)
  959. RETURN
  960.  
  961. C
  962. C- DOMAINE.'MACRO '
  963. C
  964. 460 CONTINUE
  965. TYPE=' '
  966. CALL ACMO(MTABLE,'MACRO',TYPE,MELEME)
  967. IPOINT = MELEME
  968. IF(KECR.EQ.1)CALL ECROBJ('MAILLAGE',MELEME)
  969. RETURN
  970. C
  971. C- DOMAINE.'QUADRATI'
  972. C
  973. 470 CONTINUE
  974. TYPE=' '
  975. CALL ACMO(MTABLE,'QUADRATI',TYPE,MELEME)
  976. IPOINT = MELEME
  977. IF(KECR.EQ.1)CALL ECROBJ('MAILLAGE',MELEME)
  978. RETURN
  979. C
  980. C- DOMAINE.'MACRO1'
  981. C
  982. 480 CONTINUE
  983. TYPE=' '
  984. CALL ACMO(MTABLE,'MACRO1',TYPE,MELEME)
  985. IF (TYPE.NE.'MAILLAGE') THEN
  986. TYPE=' '
  987. CALL ACMO(MTABLE,'MACRO',TYPE,MACRO)
  988. IF(TYPE.NE.'MAILLAGE')THEN
  989. TYPE=' '
  990. CALL ACMO(MTABLE,'MAILLAGE',TYPE,IPOINT)
  991. RETURN
  992. ELSE
  993. CALL KMACRO(MACRO,IPOINT,MTABLE)
  994. RETURN
  995. ENDIF
  996. ENDIF
  997.  
  998. IPOINT = MELEME
  999. IF(KECR.EQ.1)CALL ECROBJ('MAILLAGE',MELEME)
  1000. RETURN
  1001. C
  1002. C-*????.'XXDXDY' : En chantier
  1003. C
  1004. 490 CONTINUE
  1005. TYPE = ' '
  1006. CALL ACMO(MTABLE,'XXDXDY',TYPE,MCHPOI)
  1007. C write(6,*)' ACMO XXDXDY : MTABLE=',MTABLE
  1008. IF (TYPE.NE.'CHPOINT '.OR.IPREC.EQ.0) THEN
  1009. C write(6,*)' On a pas trouve XXDXDY On le calcule '
  1010. CALL ECROBJ('TABLE ',MTABLE)
  1011. C write(6,*)' ECROBJ XXDXDY : MTABLE=',MTABLE
  1012. CALL KDXDY
  1013. TYPE = 'CHPOINT '
  1014. CALL LIROBJ(TYPE,MCHPOI,1,IRET)
  1015. IF (IRET.EQ.0) GOTO 5000
  1016. IF(ISTOK.EQ.1)CALL ECMO(MTABLE,'XXDXDY','CHPOINT ',MCHPOI)
  1017. ENDIF
  1018. IPOINT = MCHPOI
  1019. IF(KECR.EQ.1)CALL ECROBJ('CHPOINT ',MCHPOI)
  1020. C write(6,*)' retour XXDXDY : MTABLE=',MTABLE
  1021. RETURN
  1022. C
  1023. C- DOMAINE.'MSOMMET'
  1024. C
  1025. 500 CONTINUE
  1026. CALL ACMM(MTABLE,'SOUSTYPE',TYPE)
  1027. IF (TYPE.NE.'DOMAINE ') GOTO 5010
  1028. TYPE=' '
  1029. CALL ACMO(MTABLE,'MSOMMET ',TYPE,MMLEMS)
  1030. IF(TYPE.NE.'MAILLAGE')THEN
  1031. I501 = 1
  1032. GO TO 1300
  1033. ENDIF
  1034. 501 CONTINUE
  1035. IPOINT = MMLEMS
  1036. IF(KECR.EQ.1)CALL ECROBJ('MAILLAGE',MMLEMS)
  1037. RETURN
  1038. C
  1039. C- DOMAINE.'MMAIL '
  1040. C
  1041. 510 CONTINUE
  1042. CALL ACMM(MTABLE,'SOUSTYPE',TYPE)
  1043. IF (TYPE.NE.'DOMAINE ') GOTO 5010
  1044. TYPE=' '
  1045. CALL ACMO(MTABLE,'MMAIL ',TYPE,MMELEM)
  1046. IF(TYPE.NE.'MAILLAGE')THEN
  1047. I511 = 1
  1048. GOTO 1300
  1049. ENDIF
  1050. 511 CONTINUE
  1051. IPOINT = MMELEM
  1052. IF(KECR.EQ.1)CALL ECROBJ('MAILLAGE',MMELEM)
  1053. RETURN
  1054. C
  1055. C- DOMAINE.'MLGVNIMP'
  1056. C
  1057. 520 CONTINUE
  1058. CALL ACMM(MTABLE,'SOUSTYPE',TYPE)
  1059. IF (TYPE.NE.'DOMAINE ') GOTO 5010
  1060. TYPE=' '
  1061. CALL ACMO(MTABLE,'MLGVNIMP',TYPE,MELETI)
  1062.  
  1063. IF(TYPE.EQ.'MAILLAGE')THEN
  1064. IPOINT = MELETI
  1065. IF(KECR.EQ.1)CALL ECROBJ('MAILLAGE',MELETI)
  1066. RETURN
  1067. ELSE
  1068. TYPE=' '
  1069. CALL ACMO(MTABLE,'SOMMET',TYPE,MELEME)
  1070. IF (TYPE.NE.'MAILLAGE') GO TO 5000
  1071. CALL MEULTI(MELEME,MELETI,TYPE)
  1072. IF (TYPE.NE.'MAILLAGE') THEN
  1073. C Indice %m1:8 : Objet de type %m9:16 incorrect
  1074.  
  1075. MOTERR(1:8) = NOM
  1076. MOTERR(9:16) = TYPE
  1077. CALL ERREUR(787)
  1078. RETURN
  1079. ENDIF
  1080. CALL ECMO(MTABLE,'MLGVNIMP','MAILLAGE',MELETI)
  1081. IPOINT = MELETI
  1082. IF(KECR.EQ.1)CALL ECROBJ('MAILLAGE',MELETI)
  1083. RETURN
  1084. ENDIF
  1085. C
  1086. C- DOMAINE.'MLGVTIMP'
  1087. C
  1088. 530 CONTINUE
  1089. CALL ACMM(MTABLE,'SOUSTYPE',TYPE)
  1090. IF (TYPE.NE.'DOMAINE ') GOTO 5010
  1091. TYPE=' '
  1092. CALL ACMO(MTABLE,'MLGVTIMP',TYPE,MELETI)
  1093.  
  1094. IF(TYPE.EQ.'MAILLAGE')THEN
  1095. IPOINT = MELETI
  1096. IF(KECR.EQ.1)CALL ECROBJ('MAILLAGE',MELETI)
  1097. RETURN
  1098. ELSE
  1099. TYPE=' '
  1100. CALL ACMO(MTABLE,'SOMMET',TYPE,MELEME)
  1101. IF (TYPE.NE.'MAILLAGE') GO TO 5000
  1102. CALL MEULTI(MELEME,MELETI,TYPE)
  1103. IF (TYPE.NE.'MAILLAGE') THEN
  1104. C Indice %m1:8 : Objet de type %m9:16 incorrect
  1105.  
  1106. MOTERR(1:8) = NOM
  1107. MOTERR(9:16) = TYPE
  1108. CALL ERREUR(787)
  1109. RETURN
  1110. ENDIF
  1111. CALL ECMO(MTABLE,'MLGVTIMP','MAILLAGE',MELETI)
  1112. IPOINT = MELETI
  1113. IF(KECR.EQ.1)CALL ECROBJ('MAILLAGE',MELETI)
  1114. RETURN
  1115. ENDIF
  1116. C
  1117. C- DOMAINE.'ENVELOPP'
  1118. C
  1119. 540 CONTINUE
  1120. CALL ACMM(MTABLE,'SOUSTYPE',TYPE)
  1121. IF (TYPE.NE.'DOMAINE ') GOTO 5010
  1122. TYPE=' '
  1123. CALL ACMO(MTABLE,'ENVELOPP',TYPE,MENVEL)
  1124.  
  1125. IF(TYPE.EQ.'MAILLAGE')THEN
  1126. IPOINT = MENVEL
  1127. IF(KECR.EQ.1)CALL ECROBJ('MAILLAGE',MENVEL)
  1128. RETURN
  1129. ELSE
  1130. TYPE = ' '
  1131. C CALL ACMO(MTABLE,'FACEP',TYPE,MELEMP)
  1132. CALL ACMO(MTABLE,'FACEL2',TYPE,MELEF2)
  1133. IF (TYPE.NE.'MAILLAGE') THEN
  1134. I541 = 1
  1135. GOTO 1100
  1136. ENDIF
  1137. ENDIF
  1138. 541 CONTINUE
  1139. TYPE = ' '
  1140. CALL ACMO(MTABLE,'QUAF',TYPE,MELEMQ)
  1141. 542 CONTINUE
  1142. CALL MENVLP(MELEMQ,MENVEL,MCHPOI,IRET)
  1143. IF (IRET.EQ.0) GOTO 5000
  1144. IF(ISTOK.EQ.1)CALL ECMO(MTABLE,'ENVELOPP','MAILLAGE',MENVEL)
  1145. IF(ISTOK.EQ.1)CALL ECMO(MTABLE,'OENVELOP','CHPOINT',MCHPOI)
  1146. IPOINT = MENVEL
  1147. IF(KECR.EQ.1.AND.NOMI.EQ.'ENVELOPP')
  1148. & CALL ECROBJ('MAILLAGE',MENVEL)
  1149. RETURN
  1150. C
  1151. C- DOMAINE.'FACEL2' : MELEME connectivite face -> centre (partitionne)
  1152. C rgt partitionne
  1153. 550 CONTINUE
  1154. CALL ACMM(MTABLE,'SOUSTYPE',TYPE)
  1155. IF (TYPE.NE.'DOMAINE ') GOTO 5010
  1156. TYPE = ' '
  1157. CALL ACMO(MTABLE,'FACEL2',TYPE,MELEF2)
  1158. IF (TYPE.NE.'MAILLAGE') THEN
  1159. I551 = 1
  1160. GOTO 1100
  1161. ENDIF
  1162. 551 CONTINUE
  1163. IPOINT = MELEF2
  1164. IF(KECR.EQ.1)CALL ECROBJ('MAILLAGE',MELEF2)
  1165. RETURN
  1166. C
  1167. C- DOMAINE.'QUAF ' : Maillage QUAF du domaine considéré
  1168. C
  1169. 560 CONTINUE
  1170. CALL ACMM(MTABLE,'SOUSTYPE',TYPE)
  1171. IF (TYPE.NE.'DOMAINE ') GOTO 5010
  1172. TYPE=' '
  1173. CALL ACMO(MTABLE,'QUAF ',TYPE,MELEME)
  1174. IF (TYPE.NE.'MAILLAGE') THEN
  1175. C Indice %m1:8 : Objet de type %m9:16 incorrect
  1176.  
  1177. MOTERR(1:8) = NOM
  1178. MOTERR(9:16) = TYPE
  1179. CALL ERREUR(787)
  1180. RETURN
  1181. ENDIF
  1182. IPOINT = MELEME
  1183. IF(KECR.EQ.1)CALL ECROBJ('MAILLAGE',MELEME)
  1184. RETURN
  1185. C
  1186. C- DOMAINE.'XXCTREP1'
  1187. C
  1188. 570 CONTINUE
  1189. TYPE = ' '
  1190. CALL ACMO(MTABLE,'XXCTREP1',TYPE,MCHPOI)
  1191. IF (TYPE.NE.'CHPOINT ') THEN
  1192. CALL ECRCHA('CENTREP1')
  1193. CALL ECROBJ('TABLE ',MTABLE)
  1194. CALL CADGSI
  1195. TYPE = 'CHPOINT '
  1196. CALL LIROBJ(TYPE,MCHPOI,1,IRET)
  1197. IF (IRET.EQ.0) GOTO 5000
  1198. IF(ISTOK.EQ.1)CALL ECMO(MTABLE,'XXCTREP1','CHPOINT ',MCHPOI)
  1199. ENDIF
  1200. IPOINT = MCHPOI
  1201. IF(KECR.EQ.1)CALL ECROBJ('CHPOINT ',MCHPOI)
  1202. C write(6,*) 'Retour XXDIAGSI : MTABLE=',MTABLE
  1203. RETURN
  1204. C
  1205. C- DOMAINE.'XXCTREP0'
  1206. C
  1207. 580 CONTINUE
  1208. TYPE = ' '
  1209. CALL ACMO(MTABLE,'XXCTREP0',TYPE,MCHPOI)
  1210. IF (TYPE.NE.'CHPOINT ') THEN
  1211. TYPE = ' '
  1212. CALL ACMO(MTABLE,'XXVOLUM ',TYPE,MCHPOI)
  1213. IF (TYPE.NE.'CHPOINT ') THEN
  1214. write(6,*) 'On ne trouve pas XXVOLUM -> On le calcule'
  1215. TYPE=' '
  1216. CALL ACMO(MTABLE,'CENTRE',TYPE,MELEMC)
  1217. CALL ACMO(MTABLE,'MAILLAGE',TYPE,MELEME)
  1218. CALL KVOL(MELEME,MELEMC,'CENTRE',MCHPOI)
  1219. IF(ISTOK.EQ.1)CALL ECMO(MTABLE,'XXCTREP0','CHPOINT ',MCHPOI)
  1220. IF(ISTOK.EQ.1)CALL ECMO(MTABLE,'XXVOLUM ','CHPOINT ',MCHPOI)
  1221. ENDIF
  1222. ENDIF
  1223. IPOINT = MCHPOI
  1224. IF(KECR.EQ.1)CALL ECROBJ('CHPOINT ',MCHPOI)
  1225. RETURN
  1226. C
  1227. C- DOMAINE.'MAILFACE' : MELEME des elements face
  1228. C
  1229. 590 CONTINUE
  1230. CALL ACMM(MTABLE,'SOUSTYPE',TYPE)
  1231. IF (TYPE.NE.'DOMAINE ') GOTO 5010
  1232. TYPE = ' '
  1233. CALL ACMO(MTABLE,'MAILFACE',TYPE,MFF2)
  1234. IF (TYPE.NE.'MAILLAGE') THEN
  1235. I591 = 1
  1236. GOTO 1100
  1237. ENDIF
  1238. 591 CONTINUE
  1239. IPOINT = MFF2
  1240. IF(KECR.EQ.1)CALL ECROBJ('MAILLAGE',MFF2)
  1241. RETURN
  1242. C
  1243. C- DOMAINE.'ARETE ' : MELEME des éléments arêtes
  1244. C
  1245. 600 CONTINUE
  1246. CALL ACMM(MTABLE,'SOUSTYPE',TYPE)
  1247. IF (TYPE.NE.'DOMAINE ') GOTO 5010
  1248. TYPE = ' '
  1249. CALL ACMO(MTABLE,'QUAF ',TYPE,MELEME)
  1250. IF (TYPE.NE.'MAILLAGE') THEN
  1251. C Indice %m1:8 : Objet de type %m9:16 incorrect
  1252.  
  1253. MOTERR(1:8) = NOM
  1254. MOTERR(9:16) = TYPE
  1255. CALL ERREUR(787)
  1256. RETURN
  1257. ENDIF
  1258. TYPE = ' '
  1259. CALL ACMO(MTABLE,'ARETE ',TYPE,MARET)
  1260. IF (TYPE.NE.'MAILLAGE') THEN
  1261. CALL ECROBJ('MAILLAGE',MELEME)
  1262. CALL CHANLG
  1263. CALL LIROBJ('MAILLAGE',MARET,1,IRETOU)
  1264. IF (IRETOU.NE.1) THEN
  1265. C Indice %m1:8 : Objet de type %m9:16 incorrect
  1266.  
  1267. MOTERR(1:8) = 'ARETE'
  1268. MOTERR(9:16) = 'MAILLAGE'
  1269. CALL ERREUR(787)
  1270. RETURN
  1271. ENDIF
  1272. ENDIF
  1273. IPOINT = MARET
  1274. IF(KECR.EQ.1)CALL ECROBJ('MAILLAGE',MARET)
  1275. RETURN
  1276. C
  1277. C- Emplacement libre
  1278. C
  1279. 610 CONTINUE
  1280. IPOINT = 0
  1281. RETURN
  1282. C
  1283. C
  1284. C---------------------------------------------------------
  1285. C Traitement commun à plusieures options et mise en facteur
  1286. C---------------------------------------------------------
  1287. C
  1288. C
  1289. C- Recherche à l'indice mot MIND d'une table de sous-type MINDS
  1290. C- ATTENTION : ERREUR NON GERE POUR L'INSTANT : Si IPTR.EQ.0 5000
  1291. C
  1292. 1000 CONTINUE
  1293. TYPE = ' '
  1294. CALL ACMO(MTABLE,MIND,TYPE,IPTR)
  1295. IF (TYPE.EQ.'TABLE ') THEN
  1296. TYPE = ' '
  1297. CALL ACMM(IPTR,'SOUSTYPE',TYPE)
  1298. IF (TYPE.EQ.MINDS) THEN
  1299. IPOINT = IPTR
  1300. ENDIF
  1301. ELSE IF(TYPE.EQ.'MMODEL')THEN
  1302. CALL LEKMOD(IPTR,IPOINT,INEFMD)
  1303. IF(IPOINT.EQ.0)RETURN
  1304. ENDIF
  1305. RETURN
  1306. C
  1307. C- Construction des indices 'FACE', 'FACEP', 'FACEL', 'CENTRE', 'ELTFA', 'FACEL2'
  1308. C- d'une table de sous-type 'DOMAINE' utilisé pour certaines options
  1309. C
  1310. 1100 CONTINUE
  1311. TYPE = ' '
  1312. CALL ACMO(MTABLE,'MAILLAGE',TYPE,MELEME)
  1313. IF (TYPE.NE.'MAILLAGE') GOTO 5000
  1314.  
  1315. NOMC=' '
  1316. CALL TQ2CF(MELEME,MELEMQ,MELEMK,
  1317. & MELEF1,MELAF,MELEMP,MELEMF,MELEF2,MFF2,NOMC,IKR)
  1318. IF(IKR.EQ.1)IQUAD=1
  1319.  
  1320. IF(IQUAD.EQ.1)THEN
  1321. CALL ECMO(MTABLE,'QUADRATIQUE','MAILLAGE',MELEME)
  1322. CALL ECMO(MTABLE,'MAILLAGE','MAILLAGE',MELEMQ)
  1323. ENDIF
  1324.  
  1325. CALL ECMO(MTABLE,'FACE','MAILLAGE',MELEF1)
  1326. CALL ECMO(MTABLE,'FACEL','MAILLAGE',MELEMF)
  1327. CALL ECMO(MTABLE,'FACEL2','MAILLAGE',MELEF2)
  1328. CALL ECMO(MTABLE,'FACEP','MAILLAGE',MELEMP)
  1329. CALL ECMO(MTABLE,'CENTRE','MAILLAGE',MELEMK)
  1330. CALL ECMO(MTABLE,'ELTFA','MAILLAGE',MELAF)
  1331. CALL ECMO(MTABLE,'MAILFACE','MAILLAGE',MFF2)
  1332.  
  1333. IF (I211 .EQ.1) GOTO 211
  1334. IF (I221 .EQ.1) GOTO 221
  1335. IF (I231 .EQ.1) GOTO 231
  1336. IF (I271 .EQ.1) GOTO 271
  1337. IF (I291 .EQ.1) GOTO 291
  1338. IF (I391 .EQ.1) GOTO 391
  1339. IF (I541 .EQ.1) GOTO 541
  1340. IF (I551 .EQ.1) GOTO 551
  1341. IF (I1201.EQ.1) GOTO 1201
  1342. IF (I591 .EQ.1) GOTO 591
  1343. C
  1344. C- Construction des indices 'XXNORMAE', 'XXSURFAC' et 'XXNORMAF'
  1345. C- d'une table de sous-type 'DOMAINE' utilisé pour certaines options
  1346. C
  1347. 1200 CONTINUE
  1348. TYPE = ' '
  1349. CALL ACMO(MTABLE,'FACE',TYPE,MELEME)
  1350. IF (TYPE.NE.'MAILLAGE') THEN
  1351. I1201 = 1
  1352. GOTO 1100
  1353. ENDIF
  1354. 1201 CONTINUE
  1355. CALL KNRF(MTABLE,ICHE,ICHPV,ICHP)
  1356. IF(ISTOK.EQ.1)THEN
  1357. CALL ECMO(MTABLE,'XXNORMAE','MCHAML ',ICHE)
  1358. CALL ECMO(MTABLE,'XXSURFAC','CHPOINT ',ICHP)
  1359. CALL ECMO(MTABLE,'XXNORMAF','CHPOINT ',ICHPV)
  1360. ENDIF
  1361.  
  1362. IF (I241.EQ.1) GOTO 241
  1363. IF (I251.EQ.1) GOTO 251
  1364. IF (I301.EQ.1) GOTO 301
  1365. IF (I542.EQ.1) GOTO 542
  1366. C
  1367. C Construction des indices 'MSOMMET' et 'MMAIL' d'une table
  1368. C de sous-types 'DOMAINE'.
  1369. C A l'indice 'MSOMMET', on trouve le maillage des "vrais"
  1370. C sommets (les sommets géométriques des éléments), par
  1371. C opposition à l'indice 'SOMMET' qui est le spg des inconnues
  1372. C définies dans l'espace L2.
  1373. C A l'indice 'MMAIL' qui lui correspond, on trouve le maillage
  1374. C des "vrais" éléments (les éléments géométriques :
  1375. C ils ont le type le plus simple pour un forme
  1376. C géométrique donnée (ex. TRI3, PYR5, CUB8...))
  1377. C par opposition à l'indice 'MAILLAGE' qui contient
  1378. C éventuellement des éléments avec plus de points qui sont les
  1379. C spg des différentes inconnues.
  1380. C spg=support géométrique.
  1381. C
  1382. 1300 CONTINUE
  1383. TYPE=' '
  1384. CALL ACMO(MTABLE,'QUAF ',TYPE,MELEME)
  1385. IF (TYPE.NE.'MAILLAGE') GO TO 5000
  1386. CALL MSOMET(MELEME,MMELEM,MMLEMS,TYPE)
  1387. IF (TYPE.NE.'MAILLAGE') THEN
  1388. C Indice %m1:8 : Objet de type %m9:16 incorrect
  1389.  
  1390. MOTERR(1:8) = NOM
  1391. MOTERR(9:16) = TYPE
  1392. CALL ERREUR(787)
  1393. RETURN
  1394. ENDIF
  1395. CALL ECMO(MTABLE,'MMAIL ','MAILLAGE',MMELEM)
  1396. CALL ECMO(MTABLE,'MSOMMET ','MAILLAGE',MMLEMS)
  1397.  
  1398. IF (I331.EQ.1) GOTO 331
  1399. IF (I341.EQ.1) GOTO 341
  1400. IF (I371.EQ.1) GOTO 370
  1401. IF (I501.EQ.1) GOTO 501
  1402. IF (I511.EQ.1) GOTO 511
  1403. C
  1404. C----------------------------------------
  1405. C Erreur détectée : traitement impossible
  1406. C----------------------------------------
  1407. C
  1408. 5000 CONTINUE
  1409. C Indice %m1:8 : Problème de données détecté dans lektab
  1410.  
  1411. IPOINT = 0
  1412. MOTERR(1:8) = NOM
  1413. CALL ERREUR(792)
  1414. RETURN
  1415. 5010 CONTINUE
  1416. C Indice %m1:8 : La table n'est pas de sous-type %m9:16
  1417.  
  1418. IPOINT = 0
  1419. MOTERR(1:8) = NOM
  1420. MOTERR(9:16) = 'DOMAINE '
  1421. CALL ERREUR(790)
  1422. RETURN
  1423. C
  1424. END
  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.  
  1459.  

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