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.  
  27. -INC PPARAM
  28. -INC CCOPTIO
  29. -INC CCGEOME
  30. -INC SMELEME
  31. POINTEUR MELEMQ.MELEME
  32. -INC SMMODEL
  33. -INC SMTABLE
  34. POINTEUR IPTR.MTABLE,MTABM.MTABLE
  35. CHARACTER*8 MOTYP,TYPOBJ
  36. CHARACTER*72 ICHAI,CHARRE
  37. LOGICAL IRETL,IBOOL,LOGRE,VLOGI
  38. REAL*8 XRET,XVALRE
  39. *
  40. CHARACTER*(*) NOMI
  41. CHARACTER*8 NOMC,NOMDOM
  42. PARAMETER (NBO=60)
  43. CHARACTER*8 LISTS(NBO),TYPE,NOM,MIND,MINDS,TYPI,MNEFMD
  44. DATA LISTS/'MATESI ','XXVOLUM ','XXCOTE ','XXDIAME ','XXDIEMIN',
  45. & 'MATC ','XXPSOML ','INCO ','KIZG ','KOPT ',
  46. & 'PASDETPS','DOMAINE ','DOMZ ','EQEX ','EQPR ',
  47. & 'XXDIAGSI','KIZG1 ','KIZD ','SOMMET ','CENTRE ',
  48. & 'FACE ','FACEL ','FACEP ','XXNORMAF','XXSURFAC',
  49. & 'MAILLAGE','CETR&FAC','MATRIS ','ELTFA ','XXNORMAE',
  50. & 'KIZA ','ARGS ','SOMCEN ','CESOCE ','NORMALEV',
  51. & 'OENVELOP','XXMSOMME','MATEEF ','ELKONV ','XXDIAGFA',
  52. & 'M1BULLE ','CENTREP0','ELTP1NC ','CENTREP1','VOLUMAC ',
  53. & 'MACRO ','QUADRATI','MACRO1 ','XXDXDY ','MSOMMET ',
  54. & 'MMAIL ','MLGVNIMP','MLGVTIMP','ENVELOPP','FACEL2 ',
  55. & 'QUAF ','XXCTREP1','XXCTREP0','MAILFACE','ARETE '/
  56. C
  57. C- Initialisations
  58. C
  59. C write(6,*)'DEBUT LEKTAB MTB,NOMI=',MTB,NOMI
  60. MTABLE = ABS(MTB)
  61.  
  62. CALL ECRCHA('INEFMD ')
  63. CALL ECROBJ('TABLE',MTABLE)
  64. CALL EXIS
  65. CALL LIRLOG(VLOGI,1,IRET)
  66. IF(IRET.EQ.0)THEN
  67. write(6,*)'LEKTAB : Pb avec INEFMD'
  68. go to 5000
  69. ENDIF
  70. IF(VLOGI)THEN
  71. TYPE=' '
  72. CALL ACMO(MTABLE,'INEFMD ',TYPE,INEFMD)
  73. IF(TYPE.EQ.'MOT')THEN
  74. CALL ACMM(MTABLE,'INEFMD ',MNEFMD)
  75. IF(MNEFMD.EQ.'LINE')THEN
  76. INEFMD=1
  77. ELSEIF(MNEFMD.EQ.'MACRO')THEN
  78. INEFMD=2
  79. ELSEIF(MNEFMD.EQ.'QUAF ')THEN
  80. INEFMD=3
  81. ELSEIF(MNEFMD.EQ.'LINB ')THEN
  82. INEFMD=4
  83. ELSEIF(MNEFMD.EQ.'ISOQ ')THEN
  84. INEFMD=5
  85. ELSE
  86. INEFMD=0
  87. ENDIF
  88. ELSEIF(TYPE.EQ.'ENTIER')THEN
  89. CALL ACME(MTABLE,'INEFMD ',INEFMD)
  90. ELSE
  91. write(6,*)'LEKTAB : Pb avec INEFMD'
  92. GO TO 5000
  93. ENDIF
  94. ELSE
  95. INEFMD=0
  96. ENDIF
  97.  
  98. KECR=0
  99. IF(MTB.LT.0)KECR=1
  100. NOM = NOMI
  101. IPOINT = 0
  102. I211 = 0
  103. I221 = 0
  104. I231 = 0
  105. I241 = 0
  106. I251 = 0
  107. I271 = 0
  108. I291 = 0
  109. I301 = 0
  110. I331 = 0
  111. I341 = 0
  112. I371 = 0
  113. I391 = 0
  114. I501 = 0
  115. I511 = 0
  116. I1201 = 0
  117. I541 = 0
  118. I542 = 0
  119. I551 = 0
  120. I591 = 0
  121. C
  122. C- Détermination du cas à traiter et ventilation
  123. C
  124. CG SEGACT MTABLE
  125. CALL ACMM(MTABLE,'SOUSTYPE',TYPE)
  126. IPREC=0
  127. ISTOK=0
  128. IF (TYPE.EQ.'DOMAINE ') THEN
  129. c
  130. c traitement special pour le cas ou PRECONDI n'existait pas
  131. c
  132. ICHAI(1:8)='PRECONDI'
  133. MOTYP='MOT'
  134. TYPOBJ=' '
  135. CALL ACCTAB(MTABLE,MOTYP,IVAL,XRET,ICHAI(1:8),IBOOL
  136. $ ,IOBJ,TYPOBJ,IVALRE,XVALRE,CHARRE,LOGRE,IOBRE)
  137. IRETL=.TRUE.
  138. IF(TYPOBJ.EQ.' ') IRETL = .FALSE.
  139. IF(.NOT.IRETL)CALL ECME(MTABLE,'PRECONDI',1)
  140. CALL ACME(MTABLE,'PRECONDI',IPREC)
  141. ENDIF
  142. ISTOK=IPREC
  143.  
  144.  
  145. CALL OPTLI(IP,LISTS,NOM,NBO)
  146. C write(6,*)' LEKTAB NOM=',nom
  147. IF (IP.EQ.0) THEN
  148. IF (NOM(1:4).EQ.'ARGS') THEN
  149. IP = 32
  150. ELSE
  151. C Indice %m1:8 : N'est pas un indice de table reconnu
  152. MOTERR(1:8) = NOM
  153. CALL ERREUR(791)
  154. RETURN
  155. ENDIF
  156. ENDIF
  157. C write(6,*)' LEKTAB IP=',IP, ' NOMI==========',NOMI
  158. GOTO ( 10, 20, 30, 40, 50, 60, 70, 80, 90,100
  159. & ,110,120,130,140,150,160,170,180,190,200
  160. & ,210,220,230,240,250,260,270,280,290,300
  161. & ,310,320,330,340,350,360,370,380,390,400
  162. & ,410,420,430,440,450,460,470,480,490,500
  163. & ,510,520,530,540,550,560,570,580,590,600),IP
  164. C
  165. C Si PRECONDI = 0 (IPREC=0) On recaclcule systématiquement les numéros
  166. C suivant : 10 20 30 40 50 60 70 160 240 250 300 350 360 370 380 400
  167. C 450 490
  168. C
  169. C-*DOMAINE.'MATESI'
  170. C
  171. 10 CONTINUE
  172. TYPE = ' '
  173. CALL ACMO(MTABLE,'MATESI',TYPE,MATRIK)
  174. IF (TYPE.NE.'MATRIK '.OR.IPREC.EQ.0) THEN
  175. CALL ECROBJ('TABLE',MTABLE)
  176. CALL HRSI
  177. TYPE='MATRIK'
  178. CALL LIROBJ(TYPE,MATRIK,1,IRET)
  179. IF (IRET.EQ.0) GOTO 5000
  180. IF(ISTOK.EQ.1)CALL ECMO(MTABLE,'MATESI','MATRIK',MATRIK)
  181. ENDIF
  182. IPOINT = MATRIK
  183. IF(KECR.EQ.1)CALL ECROBJ('MATRIK',MATRIK)
  184. RETURN
  185. C
  186. C-*DOMAINE.'XXVOLUM' : CHPO CENTRE contenant le volume des éléments
  187. C
  188. 20 CONTINUE
  189. TYPE = ' '
  190. CALL ACMO(MTABLE,'XXVOLUM ',TYPE,MCHPOI)
  191. IF (TYPE.NE.'CHPOINT '.OR.IPREC.EQ.0) THEN
  192. C write(6,*) 'On ne trouve pas XXVOLUM -> On le calcule'
  193. TYPE=' '
  194. CALL ACMO(MTABLE,'CENTRE',TYPE,MELEMC)
  195. CALL ACMO(MTABLE,'MAILLAGE',TYPE,MELEME)
  196. CALL KVOL(MELEME,MELEMC,'CENTRE',MCHPOI)
  197. IF(ISTOK.EQ.1)CALL ECMO(MTABLE,'XXVOLUM ','CHPOINT ',MCHPOI)
  198. ENDIF
  199. IPOINT = MCHPOI
  200. IF(KECR.EQ.1)CALL ECROBJ('CHPOINT ',MCHPOI)
  201. C write(6,*) 'Retour XXVOLUM : MTABLE=',MTABLE
  202. RETURN
  203. C
  204. C-*DOMAINE.'XXCOTE'
  205. C
  206. 30 CONTINUE
  207. TYPE=' '
  208. CALL ACMO(MTABLE,'XXCOTE',TYPE,MCHPOI)
  209. IF (TYPE.NE.'CHPOINT '.OR.IPREC.EQ.0) THEN
  210. C write(6,*) 'On ne trouve pas XXCOTE -> On le calcule'
  211. CALL ECROBJ('TABLE ',MTABLE)
  212. CALL KCOT
  213. TYPE = 'CHPOINT '
  214. CALL LIROBJ(TYPE,MCHPOI,1,IRET)
  215. IF (IRET.EQ.0) GOTO 5000
  216. IF(ISTOK.EQ.1)CALL ECMO(MTABLE,'XXCOTE','CHPOINT ',MCHPOI)
  217. ENDIF
  218. IPOINT = MCHPOI
  219. IF(KECR.EQ.1)CALL ECROBJ('CHPOINT ',MCHPOI)
  220. C write(6,*) 'Retour XXCOTE : MTABLE=',MTABLE
  221. RETURN
  222. C
  223. C-*DOMAINE.'XXDIAME'
  224. C
  225. 40 CONTINUE
  226. TYPE = ' '
  227. CALL ACMO(MTABLE,'XXDIAME ',TYPE,MCHPOI)
  228. IF (TYPE.NE.'CHPOINT '.OR.IPREC.EQ.0) THEN
  229. C write(6,*) 'On ne trouve pas XXDIAME -> On le calcule'
  230. CALL ECROBJ('TABLE ',MTABLE)
  231. CALL KDME
  232. TYPE = 'CHPOINT '
  233. CALL LIROBJ(TYPE,MCHPOI,1,IRET)
  234. IF (IRET.EQ.0) GOTO 5000
  235. IF(ISTOK.EQ.1)CALL ECMO(MTABLE,'XXDIAME','CHPOINT ',MCHPOI)
  236. ENDIF
  237. IPOINT = MCHPOI
  238. IF(KECR.EQ.1)CALL ECROBJ('CHPOINT ',MCHPOI)
  239. C write(6,*) 'Retour XXDIAME : MTABLE=',MTABLE
  240. RETURN
  241. C
  242. C-*DOMAINE.'XXDIEMIN'
  243. C
  244. 50 CONTINUE
  245. TYPE = ' '
  246. CALL ACMO(MTABLE,'XXDIEMIN',TYPE,MCHPOI)
  247. IF (TYPE.NE.'CHPOINT '.OR.IPREC.EQ.0) THEN
  248. C write(6,*) 'On ne trouve pas XXDIEMIN -> On le calcule'
  249. CALL ECROBJ('TABLE ',MTABLE)
  250. CALL KDMI
  251. TYPE = 'CHPOINT '
  252. CALL LIROBJ(TYPE,MCHPOI,1,IRET)
  253. IF (IRET.EQ.0) GOTO 5000
  254. IF(ISTOK.EQ.1)CALL ECMO(MTABLE,'XXDIEMIN','CHPOINT ',MCHPOI)
  255. ENDIF
  256. IPOINT = MCHPOI
  257. IF(KECR.EQ.1)CALL ECROBJ('CHPOINT ',MCHPOI)
  258. C write(6,*) 'Retour XXDIEMIN : MTABLE=',MTABLE
  259. RETURN
  260. C
  261. C-*????.'MATC'
  262. C
  263. 60 CONTINUE
  264. TYPE = ' '
  265. CALL ACMO(MTABLE,'MATC',TYPE,MATRAK)
  266. IF (TYPE.NE.'MATRAK '.OR.IPREC.EQ.0) THEN
  267. c? IF (TYPE.NE.'MATRAK ') THEN
  268. CALL KMEC(MTABLE,MATRAK)
  269. IF (MATRAK.EQ.0) GOTO 5000
  270. IF(ISTOK.EQ.1)CALL ECMO(MTABLE,'MATC','MATRAK',MATRAK)
  271. ENDIF
  272. IPOINT = MATRAK
  273. IF(KECR.EQ.1)CALL ECROBJ('MATRAK',MATRAK)
  274. RETURN
  275. C
  276. C-*DOMAINE.'XXPSOML' : MCHAML, intégrale des fonctions tests par élément
  277. C
  278. 70 CONTINUE
  279. CALL ACMM(MTABLE,'SOUSTYPE',TYPE)
  280. IF (TYPE.NE.'DOMAINE ') GOTO 5010
  281. TYPE = ' '
  282. CALL ACMO(MTABLE,'XXPSOML',TYPE,ICHE)
  283. IF (TYPE.NE.'MCHAML '.OR.IPREC.EQ.0) THEN
  284. CALL ECROBJ('TABLE',MTABLE)
  285. CALL KPSOML
  286. TYPE = 'MCHAML'
  287. CALL LIROBJ(TYPE,ICHE,1,IRET)
  288. IF (IRET.EQ.0) GOTO 5000
  289. IF(ISTOK.EQ.1)CALL ECMO(MTABLE,'XXPSOML','MCHAML',ICHE)
  290. ENDIF
  291. IPOINT = ICHE
  292. IF(KECR.EQ.1)CALL ECROBJ('MCHAML ',ICHE)
  293. RETURN
  294. C
  295. C- ????-INCO : TABLE de sous-type INCO
  296. C
  297. 80 CONTINUE
  298. MIND = LISTS(8)
  299. MINDS = LISTS(8)
  300. GOTO 1000
  301. C
  302. C- ????-KIZG : TABLE de sous-type KIZG
  303. C
  304. 90 CONTINUE
  305. MIND = LISTS(9)
  306. MINDS = LISTS(9)
  307. GOTO 1000
  308. C
  309. C- ????-KOPT : TABLE de sous-type KOPT
  310. C
  311. 100 CONTINUE
  312. MIND = LISTS(10)
  313. MINDS = LISTS(10)
  314. GOTO 1000
  315. C
  316. C- ????-PASDETPS : TABLE de sous-type PASDETPS
  317. C
  318. 110 CONTINUE
  319. MIND = LISTS(11)
  320. MINDS = LISTS(11)
  321. GOTO 1000
  322. C
  323. C- ????-DOMAINE : TABLE de sous-type DOMAINE
  324. C
  325. 120 CONTINUE
  326. MIND = LISTS(12)
  327. MINDS = LISTS(12)
  328. GOTO 1000
  329. C
  330. C- ????-DOMZ : TABLE de sous-type DOMAINE
  331. C
  332. 130 CONTINUE
  333. MIND = LISTS(13)
  334. MINDS = LISTS(12)
  335. GOTO 1000
  336. C
  337. C- ????-EQEX : TABLE de sous-type EQEX
  338. C
  339. 140 CONTINUE
  340. MIND = LISTS(14)
  341. MINDS = LISTS(14)
  342. GOTO 1000
  343. C
  344. C- ????-EQPR : TABLE de sous-type EQPR
  345. C
  346. 150 CONTINUE
  347. MIND = LISTS(15)
  348. MINDS = LISTS(15)
  349. GOTO 1000
  350. C
  351. C-*DOMAINE.'XXDIAGSI'
  352. C
  353. 160 CONTINUE
  354. TYPE = ' '
  355. CALL ACMO(MTABLE,'XXDIAGSI',TYPE,MCHPOI)
  356. IF (TYPE.NE.'CHPOINT '.OR.IPREC.EQ.0) THEN
  357. C write(6,*) 'On ne trouve pas XXDIAGSI -> On le calcule'
  358. CALL ECROBJ('TABLE ',MTABLE)
  359. CALL CADGSI
  360. TYPE = 'CHPOINT '
  361. CALL LIROBJ(TYPE,MCHPOI,1,IRET)
  362. IF (IRET.EQ.0) GOTO 5000
  363. IF(ISTOK.EQ.1) CALL ECMO(MTABLE,'XXDIAGSI','CHPOINT ',MCHPOI)
  364. ENDIF
  365. IPOINT = MCHPOI
  366. IF(KECR.EQ.1)CALL ECROBJ('CHPOINT ',MCHPOI)
  367. C write(6,*) 'Retour XXDIAGSI : MTABLE=',MTABLE
  368. RETURN
  369. C
  370. C- ????-KIZG1 : TABLE de sous-type KIZG1
  371. C
  372. 170 CONTINUE
  373. MIND = LISTS(17)
  374. MINDS = LISTS(17)
  375. GOTO 1000
  376. C
  377. C- ????-KIZD : TABLE de sous-type KIZD
  378. C
  379. 180 CONTINUE
  380. MIND = LISTS(18)
  381. MINDS = LISTS(18)
  382. GOTO 1000
  383. C
  384. C- DOMAINE.'SOMMET' : MELEME de POI1 contenant les sommets du maillage
  385. C
  386. 190 CONTINUE
  387. CALL ACMM(MTABLE,'SOUSTYPE',TYPE)
  388. IF (TYPE.NE.'DOMAINE ') GOTO 5010
  389. TYPE = ' '
  390. CALL ACMO(MTABLE,'SOMMET',TYPE,MELEM1)
  391. IF (TYPE.NE.'MAILLAGE') THEN
  392. TYPE = ' '
  393. CALL ACMO(MTABLE,'MAILLAGE',TYPE,MELEME)
  394. IF (TYPE.NE.'MAILLAGE') GOTO 5000
  395. CALL ECRCHA('POI1')
  396. CALL ECROBJ('MAILLAGE',MELEME)
  397. CALL PRCHAN
  398. CALL LIROBJ('MAILLAGE',MELEM1,1,IRET)
  399. IF (IRET.EQ.0) GOTO 5000
  400. CALL ECMO(MTABLE,'SOMMET','MAILLAGE',MELEM1)
  401. ENDIF
  402. IPOINT = MELEM1
  403. IF(KECR.EQ.1)CALL ECROBJ('MAILLAGE',MELEM1)
  404. RETURN
  405. C
  406. C- DOMAINE.'CENTRE' : MELEME de POI1 contenant les centres du maillage
  407. C
  408. 200 CONTINUE
  409. CALL ACMM(MTABLE,'SOUSTYPE',TYPE)
  410. IF (TYPE.NE.'DOMAINE ') GOTO 5010
  411. TYPE = ' '
  412. CALL ACMO(MTABLE,'CENTRE',TYPE,MELEMC)
  413. IF (TYPE.NE.'MAILLAGE') THEN
  414. TYPE = ' '
  415. CALL ACMO(MTABLE,'MAILLAGE',TYPE,MELEME)
  416. IF (TYPE.NE.'MAILLAGE') GOTO 5000
  417. CALL ECROBJ('MAILLAGE',MELEME)
  418. CALL CRECTR
  419. CALL LIROBJ('MAILLAGE',MELEMC,1,IRET)
  420. IF (IRET.EQ.0) GOTO 5000
  421. CALL ECMO(MTABLE,'CENTRE','MAILLAGE',MELEMC)
  422. ENDIF
  423. IPOINT = MELEMC
  424. IF(KECR.EQ.1)CALL ECROBJ('MAILLAGE',MELEMC)
  425. RETURN
  426. C
  427. C- DOMAINE.'FACE' : MELEME de POI1 contenant les faces du maillage
  428. C
  429. 210 CONTINUE
  430. CALL ACMM(MTABLE,'SOUSTYPE',TYPE)
  431. IF (TYPE.NE.'DOMAINE ') GOTO 5010
  432. TYPE = ' '
  433. CALL ACMO(MTABLE,'FACE',TYPE,MELEF1)
  434. IF (TYPE.NE.'MAILLAGE') THEN
  435. I211 = 1
  436. GOTO 1100
  437. ENDIF
  438. 211 CONTINUE
  439. IPOINT = MELEF1
  440. IF(KECR.EQ.1)CALL ECROBJ('MAILLAGE',MELEF1)
  441. RETURN
  442. C
  443. C- DOMAINE.'FACEL' : MELEME des connectivités centre-face-centre
  444. C
  445. 220 CONTINUE
  446. CALL ACMM(MTABLE,'SOUSTYPE',TYPE)
  447. IF (TYPE.NE.'DOMAINE ') GOTO 5010
  448. TYPE = ' '
  449. CALL ACMO(MTABLE,'FACEL',TYPE,MELEMF)
  450. IF (TYPE.NE.'MAILLAGE') THEN
  451. I221 = 1
  452. GOTO 1100
  453. ENDIF
  454. 221 CONTINUE
  455. IPOINT = MELEMF
  456. IF(KECR.EQ.1)CALL ECROBJ('MAILLAGE',MELEMF)
  457. RETURN
  458. C
  459. C- DOMAINE.'FACEP' : MELEME des connectivités sommet-face-sommet
  460. C
  461. 230 CONTINUE
  462. CALL ACMM(MTABLE,'SOUSTYPE',TYPE)
  463. IF (TYPE.NE.'DOMAINE ') GOTO 5010
  464. TYPE = ' '
  465. CALL ACMO(MTABLE,'FACEP',TYPE,MELEMP)
  466. IF (TYPE.NE.'MAILLAGE') THEN
  467. I231 = 1
  468. GOTO 1100
  469. ENDIF
  470. 231 CONTINUE
  471. IPOINT = MELEMP
  472. IF(KECR.EQ.1)CALL ECROBJ('MAILLAGE',MELEMP)
  473. RETURN
  474. C
  475. C-*DOMAINE.'XXNORMAE' : CHPO FACE contenant la normale choisie à la face
  476. C
  477. 240 CONTINUE
  478. CALL ACMM(MTABLE,'SOUSTYPE',TYPE)
  479. IF (TYPE.NE.'DOMAINE ') GOTO 5010
  480. TYPE = ' '
  481. CALL ACMO(MTABLE,'XXNORMAF',TYPE,ICHPV)
  482.  
  483. IF (TYPE.NE.'CHPOINT '.OR.IPREC.EQ.0)THEN
  484. I241 = 1
  485. GOTO 1200
  486. ENDIF
  487. 241 CONTINUE
  488. IPOINT = ICHPV
  489. IF(KECR.EQ.1)CALL ECROBJ('CHPOINT ',ICHPV)
  490. RETURN
  491. C
  492. C-*DOMAINE.'XXSURFAC' : CHPO FACE contenant l'aire de la face
  493. C
  494. 250 CONTINUE
  495. CALL ACMM(MTABLE,'SOUSTYPE',TYPE)
  496. IF (TYPE.NE.'DOMAINE ') GOTO 5010
  497. TYPE = ' '
  498. CALL ACMO(MTABLE,'XXSURFAC',TYPE,ICHP)
  499. IF (TYPE.NE.'CHPOINT '.OR.IPREC.EQ.0) THEN
  500. I251 = 1
  501. GOTO 1200
  502. ENDIF
  503. 251 CONTINUE
  504. IPOINT = ICHP
  505. IF(KECR.EQ.1)CALL ECROBJ('CHPOINT ',ICHP)
  506. RETURN
  507. C
  508. C- DOMAINE.'MAILLAGE' : Maillage géométrique du domaine considéré
  509. C
  510. 260 CONTINUE
  511. CALL ACMM(MTABLE,'SOUSTYPE',TYPE)
  512. IF (TYPE.NE.'DOMAINE ') GOTO 5010
  513. TYPE=' '
  514. CALL ACMO(MTABLE,'MAILLAGE',TYPE,MELEME)
  515. IF (TYPE.NE.'MAILLAGE') THEN
  516. C Indice %m1:8 : Objet de type %m9:16 incorrect
  517.  
  518. MOTERR(1:8) = NOM
  519. MOTERR(9:16) = TYPE
  520. CALL ERREUR(787)
  521. RETURN
  522. ENDIF
  523. IPOINT = MELEME
  524. IF(KECR.EQ.1)CALL ECROBJ('MAILLAGE',MELEME)
  525. RETURN
  526. C
  527. C- DOMAINE.'CETR&FAC' : Inutilisé (à verifier) -> renvoie 'CENTRE'
  528. C
  529. 270 CONTINUE
  530. CALL ACMM(MTABLE,'SOUSTYPE',TYPE)
  531. IF (TYPE.NE.'DOMAINE ') GOTO 5010
  532. TYPE = ' '
  533. CALL ACMO(MTABLE,'CENTRE',TYPE,MELEMK)
  534. IF (TYPE.NE.'MAILLAGE') THEN
  535. I271 = 1
  536. GOTO 1100
  537. ENDIF
  538. 271 CONTINUE
  539. IPOINT = MELEMK
  540. IF(KECR.EQ.1)CALL ECROBJ('MAILLAGE',MELEMK)
  541. RETURN
  542. C
  543. C- ????.'MATRIS'
  544. C
  545. 280 CONTINUE
  546. TYPE = ' '
  547. CALL ACMO(MTABLE,'MATRIS',TYPE,MTABM)
  548. IF (TYPE.NE.'TABLE ') THEN
  549. IMPR=1
  550. CALL ECRENT(IMPR)
  551. CALL ECRCHA('IMPR')
  552. CALL ECROBJ('TABLE',MTABLE)
  553. CALL PROGCS
  554. CALL LIROBJ('TABLE',MTABM,1,IRET)
  555. IF (IRET.EQ.0) GOTO 5000
  556. CALL ECMO(MTABLE,'MATRIS','TABLE',MTABM)
  557. ENDIF
  558. IPOINT = MTABM
  559. IF(KECR.EQ.1)CALL ECROBJ('TABLE',MTABM)
  560. RETURN
  561. C
  562. C- DOMAINE.'ELTFA' : MELEME connectivite face par élément (Hdiv)
  563. C
  564. 290 CONTINUE
  565. CALL ACMM(MTABLE,'SOUSTYPE',TYPE)
  566. IF (TYPE.NE.'DOMAINE ') GOTO 5010
  567. TYPE = ' '
  568. CALL ACMO(MTABLE,'ELTFA',TYPE,MELAF)
  569. IF (TYPE.NE.'MAILLAGE') THEN
  570. I291 = 1
  571. GOTO 1100
  572. ENDIF
  573. 291 CONTINUE
  574. IPOINT = MELAF
  575. IF(KECR.EQ.1)CALL ECROBJ('MAILLAGE',MELAF)
  576. RETURN
  577. C
  578. C-*DOMAINE.'XXNORMAE' : MCHAML d'orientation des normales
  579. C
  580. 300 CONTINUE
  581. CALL ACMM(MTABLE,'SOUSTYPE',TYPE)
  582. IF (TYPE.NE.'DOMAINE ') GOTO 5010
  583. TYPE = ' '
  584. CALL ACMO(MTABLE,'XXNORMAE',TYPE,ICHE)
  585. IF (TYPE.NE.'MCHAML '.OR.IPREC.EQ.0) THEN
  586. I301 = 1
  587. GOTO 1200
  588. ENDIF
  589. 301 CONTINUE
  590. IPOINT = ICHE
  591. IF(KECR.EQ.1)CALL ECROBJ('MCHAML ',ICHE)
  592. RETURN
  593. C
  594. C- ????.'KIZA' : TABLE de sous-type KIZA
  595. C
  596. 310 CONTINUE
  597. MIND=LISTS(31)
  598. MINDS=LISTS(31)
  599. GOTO 1000
  600. C
  601. C- ????.'ARGS...' : CHPO
  602. C
  603. 320 CONTINUE
  604. TYPE = ' '
  605. CALL ACMO(MTABLE,NOM,TYPE,MCHP)
  606. IF (TYPE.NE.'CHPOINT ') THEN
  607. NC = 10
  608. CALL COCHPT(NC,MCHP)
  609. IF(ISTOK.EQ.1)CALL ECMO(MTABLE,NOM,'CHPOINT',MCHP)
  610. ENDIF
  611. IPOINT = MCHP
  612. IF(KECR.EQ.1)CALL ECROBJ('CHPOINT',MCHP)
  613. RETURN
  614. C
  615. C- DOMAINE.'SOMCEN'
  616. C Cet indice contient un maillage de connectivités sommet-centre
  617. C Il est constitué d'éléments de type POLY :
  618. C - le premier noeud est le sommet considéré ;
  619. C - les noeuds suivants sont les centres des éléments
  620. C contenant le sommet considéré.
  621. C
  622. 330 CONTINUE
  623. CALL ACMM(MTABLE,'SOUSTYPE',TYPE)
  624. IF (TYPE.NE.'DOMAINE ') GOTO 5010
  625. TYPE = ' '
  626. * CALL ACMO(MTABLE,'MMAIL',TYPE,MMELEM)
  627. CALL ACMO(MTABLE,'MAILLAGE',TYPE,MMELEM)
  628. IF (TYPE.NE.'MAILLAGE') THEN
  629. C Indice %m1:8 : Objet de type %m9:16 incorrect
  630.  
  631. MOTERR(1:8) = NOM
  632. MOTERR(9:16) = TYPE
  633. CALL ERREUR(787)
  634. RETURN
  635. ENDIF
  636. * IF (TYPE.NE.'MAILLAGE') THEN
  637. * I331 = 1
  638. * GOTO 1300
  639. * ENDIF
  640. 331 CONTINUE
  641. TYPE = ' '
  642. CALL ACMO(MTABLE,'SOMCEN',TYPE,MSOCEN)
  643. IF (TYPE.NE.'MAILLAGE') THEN
  644. TYPE = 'MAILLAGE'
  645. CALL ACMO(MTABLE,'CENTRE',TYPE,MELCEN)
  646. * CALL ACMO(MTABLE,'MSOMMET',TYPE,MMLEMS)
  647. CALL ACMO(MTABLE,'SOMMET',TYPE,MMLEMS)
  648. CALL POIELE(MMELEM,MMLEMS,MELCEN,MSOCEN)
  649. CALL ECMO(MTABLE,'SOMCEN','MAILLAGE',MSOCEN)
  650. ENDIF
  651. IPOINT = MSOCEN
  652. IF(KECR.EQ.1)CALL ECROBJ('MAILLAGE',MSOCEN)
  653. RETURN
  654. C
  655. C- DOMAINE.'CESOCE'
  656. C cet indice contient un maillage de connectivités
  657. C centre-(sommet)-centre.
  658. C Il est constitué d'éléments de type POLY :
  659. C - le premier noeud est le centre de l'élément considéré ;
  660. C - les noeuds suivants sont les centres des éléments
  661. C ayant au moins un sommet commun avec l'élément considéré.
  662. C
  663. 340 CONTINUE
  664. CALL ACMM(MTABLE,'SOUSTYPE',TYPE)
  665. IF (TYPE.NE.'DOMAINE ') GOTO 5010
  666. TYPE=' '
  667. * CALL ACMO(MTABLE,'MMAIL',TYPE,MMELEM)
  668. CALL ACMO(MTABLE,'MAILLAGE',TYPE,MMELEM)
  669. IF (TYPE.NE.'MAILLAGE') THEN
  670. C Indice %m1:8 : Objet de type %m9:16 incorrect
  671.  
  672. MOTERR(1:8) = NOM
  673. MOTERR(9:16) = TYPE
  674. CALL ERREUR(787)
  675. RETURN
  676. ENDIF
  677. * IF (TYPE.NE.'MAILLAGE') THEN
  678. * I341 = 1
  679. * GOTO 1300
  680. * ENDIF
  681. 341 CONTINUE
  682. TYPE = ' '
  683. CALL ACMO(MTABLE,'CESOCE',TYPE,MSOCEN)
  684. IF (TYPE.NE.'MAILLAGE') THEN
  685. TYPE = 'MAILLAGE'
  686. CALL ACMO(MTABLE,'CENTRE',TYPE,MELCEN)
  687. * CALL ACMO(MTABLE,'MSOMMET',TYPE,MMLEMS)
  688. CALL ACMO(MTABLE,'SOMMET',TYPE,MMLEMS)
  689. CALL ELPOEL(MMELEM,MMLEMS,MELCEN,MCESOC)
  690. CALL ECMO(MTABLE,'CESOCE','MAILLAGE',MCESOC)
  691. ENDIF
  692. IPOINT = MCESOC
  693. IF(KECR.EQ.1)CALL ECROBJ('MAILLAGE',MCESOC)
  694. RETURN
  695. C
  696. C-*NORMALEV
  697. C
  698. 350 CONTINUE
  699. TYPE = ' '
  700. CALL ACMO(MTABLE,'NORMALEV',TYPE,MNORM)
  701. 351 CONTINUE
  702. IF (TYPE.NE.'MAILLAGE'.OR.IPREC.EQ.0) THEN
  703. TYPE = 'MAILLAGE'
  704. CALL ACMO(MTABLE,'QUAF',TYPE,MELEMQ)
  705. C petite verification
  706. SEGACT MELEMQ
  707. ICONF=1
  708. DO 62486 L=1,MAX(1,MELEMQ.LISOUS(/1))
  709. IPT1=MELEMQ
  710. IF(MELEMQ.LISOUS(/1).NE.0)IPT1=MELEMQ.LISOUS(L)
  711. SEGACT IPT1
  712. IF(IDIM.EQ.2.AND.NOMS(IPT1.ITYPEL).NE.'SEG3')THEN
  713. ICONF=0
  714. ENDIF
  715. IF(IDIM.EQ.3.AND.NOMS(IPT1.ITYPEL).NE.'TRI7'
  716. & .AND.NOMS(IPT1.ITYPEL).NE.'QUA9')THEN
  717. ICONF=0
  718. ENDIF
  719. 62486 CONTINUE
  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.  
  1460.  

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