Télécharger extrai.eso

Retour à la liste

Numérotation des lignes :

extrai
  1. C EXTRAI SOURCE JK148537 23/11/20 21:15:05 11790
  2. SUBROUTINE EXTRAI
  3. ************************************************************************
  4. * NOM : EXTRAI
  5. * DESCRIPTION : OPERATION D'EXTRACTION POUR DIFFERENTS TYPES D'OBJETS
  6. ************************************************************************
  7. * HISTORIQUE : 5/12/1985 : PASCAL MANIGOT : creation de la subroutine
  8. * HISTORIQUE : MODIFIE EN SEPTEMBRE 1994
  9. * HISTORIQUE : MODIFIE EN AVRIL 2015 PAR CB215821
  10. * ==> Extraire le MAILLAGE d'un MMODEL vide renvoie
  11. * un MAILLAGE vide au lieu d'une GEMAT ERROR
  12. * ==> Extraire un constituant d'un MMODEL vide
  13. * renvoie une erreur au lieu d'une GEMAT ERROR
  14. * HISTORIQUE : MODIFIE EN JANVIER 2016 PAR JCARDO
  15. * ==> ajout de la syntaxe EXTR LCHPO1 "VALE" ...
  16. * ==> extention du IF/ELSEIF/ENDIF principal a
  17. * tous les objets
  18. * ==> amelioration de la lisibilite de la subroutine
  19. ************************************************************************
  20. IMPLICIT INTEGER(I-N)
  21. IMPLICIT REAL*8(A-H,O-Z)
  22.  
  23.  
  24. -INC PPARAM
  25. -INC CCOPTIO
  26. -INC CCGEOME
  27. -INC CCHAMP
  28.  
  29. -INC SMSUPER
  30. -INC SMRIGID
  31. -INC SMELEME
  32. -INC SMCHPOI
  33. -INC SMBASEM
  34. -INC SMTABLE
  35. -INC SMDEFOR
  36. -INC SMMODEL
  37. -INC SMEVOLL
  38. -INC SMLREEL
  39. -INC SMLENTI
  40. -INC SMLMOTS
  41. -INC SMLCHPO
  42. -INC SMNUAGE
  43. -INC SMLOBJE
  44. -INC SMCHAML
  45.  
  46. SEGMENT LIMODE(0)
  47.  
  48. PARAMETER (NBFORM=100 , NBCHGT=10)
  49. PARAMETER (NLOMAX=5,NMOC=24)
  50. CHARACTER*4 MNLOCA(NLOMAX)
  51. CHARACTER*4 CAMPL(1), MOOPT(7), NOMU(3), LMOSU(5), MOTBAS(5),
  52. & NUMO(5), MCHGT(NBCHGT), CMOC(NMOC), CFROT(1)
  53. CHARACTER*16 MOFORM(NBFORM)
  54. CHARACTER*4 MOT_4
  55. CHARACTER*(LOCOMP) CMOT,MOT1,MOT2,MOCOMP
  56. CHARACTER*8 MOT_8,CTYP,CTYP1
  57. CHARACTER*(LOCHAI) CTEXTL,CTEXT
  58. LOGICAL LTELQ, LAG,BORINF,MINI,IMFRO,ZHARM
  59. C
  60. DATA LMOSU /'RIGI','ELEM','RIGT','MASS','BLOQ'/
  61. DATA NOMU /'NOMU','MULT','UNIL'/
  62. DATA MOOPT /'MAIL','RIGI','SYME','ANTI','CONT','COMP','DIAG'/
  63. DATA MOTBAS/'RIGI','MASS','MODE','STAT','PSMO'/
  64. DATA CAMPL /'AMPL'/
  65. DATA NUMO /'INFE','SUPE','MINI','MAXI','ENTR'/
  66. DATA CMOC /'MAIL','ZONE','FORM','CONS','ELEM','GEOM','CONT',
  67. $ 'DEFO','DEPL','FORC','GRAD','GRAF','MATE','CONP',
  68. $ 'TEMP','VARI','PARA','DEIN','COMP','OBJE','NON_',
  69. $ 'NLOC','PHAS','CENT'/
  70. DATA CFROT /'FROT'/
  71. DATA MCHGT /'CHAR','CHAM','TRAJ','EVOL','VITE','COMP',
  72. & 'LIE ','LIBR','LOBJ','LREE'/
  73.  
  74. XVAL1=0.D0
  75. MOT_4=' '
  76. MINI =.FALSE.
  77. ILO =0
  78. IOBIN=0
  79. IVALRE=0
  80. C
  81. CALL QUETYP(CTYP,0,IRETOU)
  82. IF (IRETOU.EQ.0) THEN
  83. CALL ERREUR(533)
  84. RETURN
  85. ENDIF
  86.  
  87.  
  88. * +-------------------------------------------------------------------+
  89. * | |
  90. * | M O T |
  91. * | |
  92. * +-------------------------------------------------------------------+
  93. IF (CTYP.EQ.'MOT ') THEN
  94. CALL LIRCHA(CTEXTL,1,LONMOT)
  95. IF (IERR.NE.0) RETURN
  96.  
  97. * ============================
  98. * EXTRACTION D'UNE SOUS-CHAINE
  99. * ============================
  100. CALL QUETYP(CTYP1,0,IRETOU)
  101. IF (IRETOU.NE.0) THEN
  102. IF (CTYP1.EQ.'ENTIER'.OR.CTYP1.EQ.'LISTENTI') THEN
  103. CALL SOUCHA(CTEXTL,LONMOT,CTYP1)
  104. RETURN
  105. ENDIF
  106. ENDIF
  107.  
  108. * ========================================================
  109. * CREATION D'UNE TABLE CONTENANT LES OBJETS DE TYPE CTEXTL
  110. * ========================================================
  111. MOT_8=CTEXTL(1:8)
  112. CALL REPERT(MOT_8,IA)
  113. M=IA
  114. SEGINI MTABLE
  115. MLOTAB=0
  116. DO 7765 I=1,IA
  117. IF(MOT_8.EQ.'FLOTTANT' ) THEN
  118. CALL LIRREE(XVAL,1,IRETOU)
  119. ELSEIF(MOT_8.EQ.'LOGIQUE ') THEN
  120. CALL LIRLOG(LAG,1,IRETOU)
  121. ELSEIF (MOT_8.EQ.'ENTIER ') THEN
  122. CALL LIRENT(IVAL,1,IRETOU)
  123. ELSEIF(MOT_8.EQ.'MOT ') THEN
  124. CALL LIRCHA(CTEXT,1,IRETOU)
  125. ELSE
  126. CALL LIROBJ(MOT_8,IVAL,1,IRETOU)
  127. ENDIF
  128. CALL ECCTAB(MTABLE,'ENTIER ',I,XVAL1,MOT_4,MINI,ILO,
  129. $ MOT_8,IVAL,XVAL,CTEXT(1:IRETOU),LAG,IVAL)
  130. 7765 CONTINUE
  131. SEGDES MTABLE
  132. CALL ECROBJ('TABLE ',MTABLE)
  133. RETURN
  134.  
  135.  
  136. * +-------------------------------------------------------------------+
  137. * | |
  138. * | D E F O R M E E |
  139. * | |
  140. * +-------------------------------------------------------------------+
  141. ELSEIF (CTYP.EQ.'DEFORME ') THEN
  142. CALL LIROBJ('DEFORME ',MDEFOR,1,IRETOU)
  143. IF(IERR.NE.0) RETURN
  144. CALL LIRMOT(CAMPL,1,IRET,1)
  145. IF(IERR.NE.0) RETURN
  146. SEGACT MDEFOR
  147. IF (AMPL(/1).NE.1) THEN
  148. CALL ERREUR(475)
  149. ELSE
  150. AMP=AMPL(1)
  151. CALL ECRREE(AMP)
  152. ENDIF
  153. RETURN
  154.  
  155.  
  156. * +-------------------------------------------------------------------+
  157. * | |
  158. * | B A S E M O D A |
  159. * | |
  160. * +-------------------------------------------------------------------+
  161. ELSEIF (CTYP.EQ.'BASEMODA') THEN
  162. CALL LIROBJ('BASEMODA',IPBASE,1,IRETOU)
  163. IF(IERR.NE.0) RETURN
  164. CALL LIRMOT(MOTBAS,5,IRET,1)
  165. IF(IERR.NE.0) RETURN
  166. MOT_4=MOTBAS(IRET)
  167. CALL EXTRA7(IPBASE,MOT_4,IPTR)
  168. IF(IERR.NE.0) RETURN
  169. IF (IRET.LE.2) THEN
  170. CALL ECROBJ('RIGIDITE',IPTR)
  171. ELSE
  172. CALL ECROBJ('SOLUTION',IPTR)
  173. ENDIF
  174. RETURN
  175.  
  176.  
  177. * +-------------------------------------------------------------------+
  178. * | |
  179. * | E V O L U T I O N |
  180. * | |
  181. * +-------------------------------------------------------------------+
  182. ELSEIF (CTYP.EQ.'EVOLUTIO') THEN
  183. CALL LIROBJ('EVOLUTIO',IBOLL,1,IRETOU)
  184. CALL ACTOBJ('EVOLUTIO',IBOLL,1)
  185. IF(IERR.NE.0) RETURN
  186. CALL EXTRA6 (IBOLL)
  187. RETURN
  188.  
  189.  
  190. * +-------------------------------------------------------------------+
  191. * | |
  192. * | S U P E R E L E |
  193. * | |
  194. * +-------------------------------------------------------------------+
  195. ELSEIF (CTYP.EQ.'SUPERELE') THEN
  196. CALL LIROBJ ('SUPERELE',MSUPER,1,IRETOU)
  197. IF (IERR.NE.0) RETURN
  198. CALL LIRMOT(LMOSU,5,IRET,1)
  199. IF (IERR.NE.0) RETURN
  200. SEGACT MSUPER
  201.  
  202. * ==============
  203. * MOT-CLE "RIGI"
  204. * ==============
  205. IF (IRET.EQ.1) THEN
  206. IPTR=MSURAI
  207. CALL ECROBJ('RIGIDITE',IPTR)
  208.  
  209. * ==============
  210. * MOT-CLE "ELEM"
  211. * ==============
  212. ELSEIF (IRET.EQ.2) THEN
  213. IPTR=MSUPEL
  214. CALL ECROBJ('MAILLAGE',IPTR)
  215.  
  216. * ==============
  217. * MOT-CLE "RIGT"
  218. * ==============
  219. ELSEIF (IRET.EQ.3) THEN
  220. IPTR=MRIGTO
  221. CALL ECROBJ('RIGIDITE',IPTR)
  222.  
  223. * ==============
  224. * MOT-CLE "MASS"
  225. * ==============
  226. ELSEIF (IRET.EQ.4) THEN
  227. IPTR=MSUMAS
  228. CALL ECROBJ('RIGIDITE',IPTR)
  229.  
  230. * ==============
  231. * MOT-CLE "BLOQ"
  232. * ==============
  233. ELSEIF (IRET.EQ.5) THEN
  234. NRIGEL=MBLOQU
  235. RI1=MRIGTO
  236. SEGACT,RI1
  237. SEGINI,MRIGID
  238. MTYMAT=RI1.MTYMAT
  239. DO 1 IE1=1,NRIGEL
  240. COERIG(IE1)=RI1.COERIG(IE1)
  241. DO 11 IE2=1,8
  242. IRIGEL(IE2,IE1)=RI1.IRIGEL(IE2,IE1)
  243. 11 CONTINUE
  244. 1 CONTINUE
  245. SEGACT,MRIGID
  246. CALL ECROBJ('RIGIDITE',MRIGID)
  247. ENDIF
  248. RETURN
  249.  
  250.  
  251. * +-------------------------------------------------------------------+
  252. * | |
  253. * | M A T R I K |
  254. * | |
  255. * +-------------------------------------------------------------------+
  256. ELSEIF (CTYP.EQ.'MATRIK') THEN
  257. CALL LIROBJ ('MATRIK',IBOGID,1,IRETOU)
  258. IF (IERR.NE.0) RETURN
  259. CALL LIRMOT(MOOPT,7,IRET,0)
  260.  
  261. * ====================================================
  262. * EXTRACTION D'UNE SOUS-MATRICE DE COMPOSANTES DONNEES
  263. * ====================================================
  264. IF (IRET.EQ.0) THEN
  265. CALL LIROBJ('LISTMOTS',MLMOT1,0,IRETLM)
  266. IF (IRETLM.EQ.1) THEN
  267. CALL LIROBJ('LISTMOTS',MLMOT2,1,IRET)
  268. IF (IERR.NE.0) RETURN
  269. ELSE
  270. CALL LIRCHA(MOT1,1,IRET)
  271. IF (IERR.NE.0) RETURN
  272. CALL LIRCHA(MOT2,1,IRET)
  273. IF (IERR.NE.0) RETURN
  274. JGN=4
  275. JGM=1
  276. SEGINI MLMOT1,MLMOT2
  277. MLMOT1.MOTS(1)=MOT1
  278. MLMOT2.MOTS(1)=MOT2
  279. ENDIF
  280. CALL EXINCK(IBOGID,MLMOT1,MLMOT2,IOUT,IMPR,IRET)
  281. IF (IRETLM.NE.1) SEGSUP MLMOT1,MLMOT2
  282. IF (IERR.NE.0) RETURN
  283. CALL ECROBJ('MATRIK',IOUT)
  284. RETURN
  285.  
  286. * ============================================
  287. * MOT-CLE "DIAG" => EXTRACTION DE LA DIAGONALE
  288. * ============================================
  289. ELSEIF (IRET.EQ.7) THEN
  290. CALL ECROBJ('MATRIK',IBOGID)
  291. CALL EXDIAG(1)
  292. RETURN
  293.  
  294. * =======================================================
  295. * MOT-CLE "COMP => EXTRACTION DE LA LISTE DES COMPOSANTES
  296. * =======================================================
  297. ELSEIF(IRET.EQ.6) THEN
  298. CALL LIRCHA(CMOT,0,ICDUAL)
  299. IF (ICDUAL.NE.0) THEN
  300. IF (CMOT.NE.'DUAL') THEN
  301. MOTERR=CMOT
  302. CALL ERREUR(7)
  303. RETURN
  304. ENDIF
  305. ENDIF
  306. CALL EXTR26(IBOGID,ICDUAL,IPLSTM)
  307. CALL ECROBJ('LISTMOTS',IPLSTM)
  308. RETURN
  309. ELSE
  310. MOTERR=MOOPT(IRET)
  311. CALL ERREUR(7)
  312. RETURN
  313. ENDIF
  314.  
  315.  
  316. * +-------------------------------------------------------------------+
  317. * | |
  318. * | R I G I D I T E |
  319. * | |
  320. * +-------------------------------------------------------------------+
  321. ELSEIF (CTYP.EQ.'RIGIDITE') THEN
  322. CALL LIROBJ ('RIGIDITE',IBOGID,1,IRETOU)
  323. IF (IERR.NE.0) RETURN
  324. CALL LIRMOT(MOOPT,7,IRET,0)
  325.  
  326. * ====================================================
  327. * EXTRACTION D'UNE SOUS-MATRICE DE COMPOSANTES DONNEES
  328. * ====================================================
  329. IF (IRET.EQ.0) THEN
  330. CALL LIROBJ('LISTMOTS',MLMOT1,0,IRETLM)
  331. IF (IRETLM.EQ.1) THEN
  332. CALL LIROBJ('LISTMOTS',MLMOT2,1,IRET)
  333. IF (IERR.NE.0) RETURN
  334. ELSE
  335. CALL LIRCHA(MOT1,1,IRET)
  336. IF (IERR.NE.0) RETURN
  337. CALL LIRCHA(MOT2,1,IRET)
  338. IF (IERR.NE.0) RETURN
  339. JGN=4
  340. JGM=1
  341. SEGINI MLMOT1,MLMOT2
  342. MLMOT1.MOTS(1)=MOT1
  343. MLMOT2.MOTS(1)=MOT2
  344. ENDIF
  345. CALL EXINCR(IBOGID,MLMOT1,MLMOT2,IOUT)
  346. IF (IRETLM.NE.1) SEGSUP MLMOT1,MLMOT2
  347. IF (IERR.NE.0) RETURN
  348. CALL ECROBJ('RIGIDITE',IOUT)
  349. RETURN
  350.  
  351. * ============================================
  352. * MOT-CLE "DIAG" => EXTRACTION DE LA DIAGONALE
  353. * ============================================
  354. ELSEIF (IRET.EQ.7) THEN
  355. CALL EXDIAR(IBOGID,ICHP)
  356. IF (IERR.NE.0) RETURN
  357. CALL ACTOBJ('CHPOINT ',ICHP,1)
  358. CALL ECROBJ('CHPOINT ',ICHP)
  359. RETURN
  360.  
  361. * ========================================================
  362. * MOT-CLE "COMP" => EXTRACTION DE LA LISTE DES COMPOSANTES
  363. * ========================================================
  364. ELSEIF(IRET.EQ.6) THEN
  365. CALL LIRCHA(CMOT,0,ICDUAL)
  366. IF (ICDUAL.NE.0) THEN
  367. IF (CMOT.NE.'DUAL') THEN
  368. MOTERR=CMOT
  369. CALL ERREUR(7)
  370. RETURN
  371. ENDIF
  372. ENDIF
  373. CALL EXTR16(IBOGID,ICDUAL,IPLSTM)
  374. CALL ECROBJ('LISTMOTS',IPLSTM)
  375. RETURN
  376.  
  377. * ====================================
  378. * MOT-CLE "CONT" => APPUIS UNILATERAUX
  379. * ====================================
  380. ELSEIF(IRET.EQ.5) THEN
  381. MRIGID=IBOGID
  382. SEGACT MRIGID
  383. ISOPE= ISUPEQ
  384. IF(ISUPEQ.EQ.0) CALL CRTABL(ISOPE)
  385. MTABLE=ISOPE
  386. SEGDES MTABLE
  387. CALL ECROBJ('TABLE ',ISOPE)
  388. RETURN
  389.  
  390. * ==============================================================
  391. * MOTS-CLES "SYME" OU "ANTI" => SOUS-MATRICES (ANTI-)SYMETRIQUES
  392. * ==============================================================
  393. ELSEIF (IRET.EQ.3 .OR. IRET.EQ.4) THEN
  394. CALL EXTR13(IBOGID,IRET)
  395. RETURN
  396. ENDIF
  397.  
  398.  
  399. * =============================================================
  400. * MOTS-CLES "MAIL" OU "RIGI" => SOUS-MAILLAGES OU SOUS-MATRICES
  401. * =============================================================
  402. ICO=0
  403. IMO=3
  404. IF(IRET.EQ.2) THEN
  405. ICO=1
  406. IMO=2
  407. ENDIF
  408. CALL LIRMOT(NOMU,IMO,IMUL,ICO)
  409. IF(IERR.NE.0) RETURN
  410.  
  411. * ************************************************
  412. * MATRICE AVEC SEULEMENT LES MULT. DE LAGRANGE OU
  413. * AVEC TOUT SAUF LES MULT. DE LAGRANGE
  414. * ************************************************
  415. IF (IRET.EQ.2) THEN
  416. CALL SEPA(IBOGID,IMUL)
  417. CALL ECROBJ('RIGIDITE',IBOGID)
  418. RETURN
  419. ENDIF
  420.  
  421. * ********************************************************
  422. * MAILLAGE PARTIEL
  423. * "NOMU" => TOUT SAUF LES MULT. DE LAGRANGE
  424. * "MULT" => TOUS LES MULT. DE LAGRANGE
  425. * "UNIL" => SEULEMENT LES MULT. ASSOCIES AUX COND. UNIL.
  426. * ********************************************************
  427. IF (IMUL.NE.0) THEN
  428. CALL POIRIG(IBOGID,IMUL)
  429. RETURN
  430. ENDIF
  431.  
  432. * ****************
  433. * MAILLAGE COMPLET
  434. * ****************
  435. IF (IERR.NE.0) RETURN
  436. MRIGID=IBOGID
  437. SEGACT MRIGID
  438. NBSOUS=IRIGEL(/2)
  439. IF (NBSOUS.EQ.0) THEN
  440. NBNN=0
  441. NBELEM=0
  442. NBREF=0
  443. SEGINI MELEME
  444. SEGACT,MELEME
  445. CALL ECROBJ ('MAILLAGE',MELEME)
  446. RETURN
  447. ENDIF
  448. IPP1 = IRIGEL(1,1)
  449. IF(NBSOUS.GT.1) THEN
  450. NBREF=0
  451. NBNN=0
  452. NBELEM=0
  453. SEGINI IPT4
  454. KT4 = 1
  455. IPT4.LISOUS(KT4) = IPP1
  456. DO 1130 I=1,NBSOUS
  457. DO 1129 JJ = 1,KT4
  458. IF (IRIGEL(1,I).EQ.IPT4.LISOUS(JJ)) GOTO 1130
  459. 1129 CONTINUE
  460. KT4 = KT4 + 1
  461. IPT4.LISOUS(KT4)=IRIGEL(1,I)
  462. 1130 CONTINUE
  463. NBSOUS = KT4
  464. SEGADJ IPT4
  465. CALL FUSEBO (IPT4,IPP1)
  466. ENDIF
  467. CALL ACTOBJ('MAILLAGE',IPP1,1)
  468. CALL ECROBJ('MAILLAGE',IPP1)
  469. RETURN
  470.  
  471.  
  472. * +-------------------------------------------------------------------+
  473. * | |
  474. * | C H P O I N T |
  475. * | |
  476. * +-------------------------------------------------------------------+
  477. ELSEIF (CTYP.EQ.'CHPOINT') THEN
  478. CALL LIROBJ('CHPOINT ',IBOPOI,1,IRETOU)
  479. IF (IERR.NE.0) RETURN
  480. CALL ACTOBJ('CHPOINT ',IBOPOI,1)
  481. IF (IERR.NE.0) RETURN
  482. CALL LIRCHA(CMOT,1,IRETOU)
  483. IF (IERR.NE.0) RETURN
  484. MOT_4=CMOT
  485.  
  486. * =====================================
  487. * MOT-CLE "TITR" => EXTRACTION DU TITRE
  488. * =====================================
  489. IF (MOT_4.EQ.'TITR') THEN
  490. MCHPOI = IBOPOI
  491. CTEXT = MOCHDE
  492. ILON = LEN(CTEXT)
  493. DO 100 I = ILON,1,-1
  494. IF (CTEXT(I:I).NE.' ') THEN
  495. NLON = I
  496. GOTO 102
  497. ENDIF
  498. 100 CONTINUE
  499. NLON = 1
  500. 102 CONTINUE
  501. CALL ECRCHA(CTEXT(1:NLON))
  502. RETURN
  503.  
  504. * =========================================
  505. * MOT-CLE "NATU" => EXTRACTION DE LA NATURE
  506. * =========================================
  507. ELSEIF (MOT_4.EQ.'NATU') THEN
  508. MCHPOI = IBOPOI
  509. INAT = JATTRI(1)
  510. IF (INAT.EQ.0) CTEXT(1:11) = 'INDETERMINE'
  511. IF (INAT.EQ.1) CTEXT(1:11) = 'DIFFUS '
  512. IF (INAT.EQ.2) CTEXT(1:11) = 'DISCRET '
  513. CALL ECRCHA(CTEXT(1:11))
  514. RETURN
  515.  
  516. * ===================================================
  517. * MOT-CLE "MAIL" => EXTRACTION DU SUPPORT GEOMETRIQUE
  518. * ===================================================
  519. ELSEIF (MOT_4 .EQ.'MAIL') THEN
  520. IMUL=0
  521. CALL LIRMOT(NOMU,1,IMUL,0)
  522. MCHPOI=IBOPOI
  523. NBSOUS=IPCHP(/1)
  524. IPP1=0
  525. DO 1140 I=1,NBSOUS
  526. MSOUPO=IPCHP(I)
  527. IF(NOCOMP(1).EQ.'LX '.AND.IMUL.EQ.1) GOTO 1140
  528. IF (IPP1.EQ.0) THEN
  529. IPP1= IGEOC
  530. ELSE
  531. IPP2=IGEOC
  532. ltelq=.false.
  533. CALL FUSE (IPP1,IPP2,IRET,ltelq)
  534. IPP1=IRET
  535. ENDIF
  536. 1140 CONTINUE
  537. IF(IPP1.EQ.0) THEN
  538. C Creation Maillage vide
  539. NBELEM=0
  540. NBNN=0
  541. NBREF=0
  542. NBSOUS=0
  543. SEGINI MELEME
  544. ITYPEL = 1
  545. IPP1 = MELEME
  546. ENDIF
  547. CALL ACTOBJ('MAILLAGE',IPP1,1)
  548. CALL ECROBJ('MAILLAGE',IPP1)
  549. RETURN
  550.  
  551. * ========================================================
  552. * MOT-CLE "COMP" => EXTRACTION DE LA LISTE DES COMPOSANTES
  553. * ========================================================
  554. ELSEIF (MOT_4 .EQ.'COMP') THEN
  555. CALL EXTR11(IBOPOI,KLISTM)
  556. CALL ECROBJ('LISTMOTS',KLISTM)
  557. RETURN
  558.  
  559. * ====================================
  560. * MOT-CLE "TYPE" => EXTRACTION DU TYPE
  561. * ====================================
  562. ELSEIF (MOT_4.EQ.'TYPE') THEN
  563. MCHPOI = IBOPOI
  564. MOT_8 = MTYPOI
  565. CALL ECRCHA(MOT_8(1:8))
  566. RETURN
  567.  
  568. * ============================================================
  569. * MOT-CLE "VALE" => EXTRACTION DES VALEURS EN PLUSIEURS POINTS
  570. * ET POUR PLUSIEURS COMPOSANTES
  571. * ============================================================
  572. ELSEIF (MOT_4.EQ.'VALE') THEN
  573. *
  574. * LISTE DES COMPOSANTES (OBJET MOT OU LISTMOTS)
  575. CALL LIROBJ('LISTMOTS',MLMOTS,0,IRETOU)
  576. IF (IRETOU.EQ.1) THEN
  577. SEGACT,MLMOTS
  578.  
  579. ELSE
  580. CALL LIRCHA(MOCOMP,0,IRETOU)
  581. IF (IRETOU.GT.0) THEN
  582. JGN=LOCOMP
  583. JGM=1
  584. SEGINI,MLMOTS
  585. MOTS(1)=MOCOMP
  586. SEGACT,MLMOTS
  587. ENDIF
  588. ENDIF
  589. *
  590. * LISTE DES NOEUDS (OBJET POINT OU MAILLAGE DE POI1)
  591. CALL LIROBJ('MAILLAGE',MELEME,0,IRETOU)
  592. IF (IRETOU.EQ.1) THEN
  593. CALL ACTOBJ('MAILLAGE',MELEME,1)
  594. ELSE
  595. CALL LIROBJ('POINT',IPOINT,0,IRETOU)
  596. IF (IRETOU.NE.0) THEN
  597. CALL CRELEM(IPOINT)
  598. MELEME=IPOINT
  599. ENDIF
  600. ENDIF
  601. *
  602. * MOT-CLE 'NOID'
  603. IVID=0
  604. CALL LIRCHA(MOT_4,0,IRETOU)
  605. IF (IRETOU.NE.0) THEN
  606. IF (MOT_4.EQ.'NOID') THEN
  607. IVID=1
  608. ELSE
  609. MOTERR(1:4)=MOT_4
  610. MOTERR(5:40)='NOID'
  611. CALL ERREUR(1052)
  612. RETURN
  613. ENDIF
  614. ENDIF
  615. *
  616. * APPEL A EXTR23
  617. CALL EXTR23(IBOPOI,MLMOTS,MELEME,MLREEL,IVID)
  618. IF (IERR.NE.0) RETURN
  619. SEGACT,MLREEL
  620. CALL ECROBJ('LISTREEL',MLREEL)
  621. RETURN
  622.  
  623. * ===========================================================
  624. * PAS DE MOT CLE : CMOT = NOM DE COMPOSANTE
  625. * EXTRACTION DE LA VALEUR EN UN POINT D'UNE COMPOSANTE DONNEE
  626. * ===========================================================
  627. ELSE
  628. CALL LIROBJ('POINT ',MPOINT,1,IRETOU)
  629. IF (IRETOU.EQ.0) THEN
  630. MOTERR(1:8)='POINT'
  631. CALL ERREUR(37)
  632. RETURN
  633. ENDIF
  634. c lecture facultative de l'harmonique de Fourier
  635. CALL LIRENT(NHARM,0,IRET)
  636. ZHARM=IRET.EQ.1
  637. CALL EXTRA9(IBOPOI,MPOINT,CMOT,NHARM,ZHARM,XFLOT,IRET)
  638. CALL ECRREE(XFLOT)
  639. RETURN
  640. ENDIF
  641.  
  642.  
  643.  
  644. * +-------------------------------------------------------------------+
  645. * | |
  646. * | M C H A M L |
  647. * | |
  648. * +-------------------------------------------------------------------+
  649. ELSEIF (CTYP.EQ.'MCHAML') THEN
  650. CALL LIROBJ('MCHAML ',IPCHE1,1,IRET)
  651. CALL ACTOBJ('MCHAML ',IPCHE1,1)
  652. IF (IERR.NE.0) RETURN
  653. C
  654. CALL LIRCHA(CMOT,1,IRET0)
  655. IF (IERR.NE.0) RETURN
  656. MOT_4=CMOT
  657.  
  658.  
  659. * ================================================
  660. * MOTS-CLES "DEVA" OU "COVA" => NOMS DES VARIABLES
  661. * ================================================
  662. IF (MOT_4.EQ.'DEVA' .OR. MOT_4.EQ.'COVA') THEN
  663. CALL EXCHA1(IPCHE1,ILISR,MOT_4)
  664. IF (ILISR.NE.0) THEN
  665. CALL ACTOBJ('LISTMOTS',ILISR,1)
  666. CALL ECROBJ('LISTMOTS',ILISR)
  667. ENDIF
  668. RETURN
  669.  
  670. * =================================
  671. * MOT-CLE "NBZO" => NOMBRE DE ZONES
  672. * =================================
  673. ELSEIF (MOT_4.EQ.'NBZO') THEN
  674. CALL EXTR18(IPCHE1,NBZONE)
  675. if (ierr.ne.0) return
  676. CALL ECRENT(NBZONE)
  677. RETURN
  678.  
  679. * =====================================================
  680. * MOT-CLE "COMP" => EXTRACTION DES NOMS DES COMPOSANTES
  681. * =====================================================
  682. ELSEIF (MOT_4.EQ.'COMP' ) THEN
  683. CALL LIROBJ('MMODEL',IPMODL,0,IRETM)
  684. C
  685. C RECHERCHE DES NOMS DES COMPOSANTES APPARTENANT
  686. C A LA ZONE DU MODELE
  687. IF (IRETM.NE.0) THEN
  688. CALL ACTOBJ('MMODEL',IPMODL,1)
  689. CALL EXTR15(IPMODL,IPCHE1,IPLSTM)
  690. IF (IPLSTM.NE.0) CALL ECROBJ('LISTMOTS',IPLSTM)
  691. RETURN
  692. C
  693. C RECHERCHE DES NOMS DE TOUTES LES COMPOSANTES
  694. ELSE
  695. CALL EXTR17(IPCHE1,IPLSTM)
  696. CALL ECROBJ('LISTMOTS',IPLSTM)
  697. RETURN
  698. ENDIF
  699.  
  700. * ======================================================
  701. * MOT-CLE "CONS" => EXTRACTION DES NOMS DES CONSTITUANTS
  702. * ======================================================
  703. ELSEIF(MOT_4.EQ.'CONS' ) THEN
  704. CALL LIROBJ('MMODEL',IPMODL,0,IRETM)
  705. C
  706. C RECHERCHE DES NOMS DES CONSTITUANTS APPARTENANT
  707. C A LA ZONE DU MODELE
  708. IF (IRETM.NE.0) THEN
  709. CALL ACTOBJ('MMODEL',IPMODL,1)
  710. CALL EXTR35(IPMODL,IPCHE1,IPLSTM)
  711. IF (IPLSTM.NE.0) CALL ECROBJ('LISTMOTS',IPLSTM)
  712. RETURN
  713. C
  714. C RECHERCHE DES NOMS DE TOUs LES constituants
  715. ELSE
  716. CALL EXTR37(IPCHE1,IPLSTM)
  717. CALL ECROBJ('LISTMOTS',IPLSTM)
  718. RETURN
  719. ENDIF
  720.  
  721. * =========================================================
  722. * EXTRACTION DE LA VALEUR, DU TITRE, DU TYPE OU DU MAILLAGE
  723. * =========================================================
  724. ELSE
  725. IF (MOT_4.NE.'TITR'.AND.MOT_4.NE.'TYPE'.AND.
  726. & MOT_4.NE.'MAIL') THEN
  727. CALL LIRENT(IENT1,1,IRET1)
  728. IF(IRET1.EQ.0) RETURN
  729. CALL LIRENT(IENT2,1,IRET2)
  730. IF(IRET2.EQ.0) RETURN
  731. CALL LIRENT(IENT3,1,IRET3)
  732. IF(IRET3.EQ.0) RETURN
  733. ENDIF
  734. CALL EXTR14(IPCHE1,IENT1,IENT2,IENT3,CMOT)
  735. RETURN
  736. ENDIF
  737.  
  738.  
  739. * +-------------------------------------------------------------------+
  740. * | |
  741. * | M M O D E L |
  742. * | |
  743. * +-------------------------------------------------------------------+
  744. ELSEIF (CTYP.EQ.'MMODEL') THEN
  745. CALL LIROBJ('MMODEL',IPMODL,1,IRET)
  746. CALL ACTOBJ('MMODEL',IPMODL,1)
  747. IF (IERR.NE.0) RETURN
  748. CALL LIRMOT(CMOC,NMOC,IRET,1)
  749. IF(IERR.NE.0) RETURN
  750. CMOT =CMOC(IRET)
  751. MOT_4 =CMOT
  752.  
  753. C Extension du MMODEL en cas de modele de MELANGE
  754. CALL MODETE(IPMODL,MMODEL,IMELAN)
  755. NSOUS=MMODEL.KMODEL(/1)
  756.  
  757. IF (MOT_4.EQ.'MAIL') THEN
  758. IMFRO=.FALSE.
  759. CALL LIRMOT(CFROT,1,IRET,0)
  760. IF (IRET.EQ.1) THEN
  761. IMFRO=.TRUE.
  762. ENDIF
  763. IPP1=0
  764. ltelq=.false.
  765. DO 1116 I=1,NSOUS
  766. IMODEL= KMODEL(I)
  767. IF (IMFRO) THEN
  768. NMATT=MATMOD(/2)
  769. CALL PLACE(MATMOD,NMATT,IPLAC,'FROTTANT')
  770. if(iplac.eq.0) goto 1116
  771. ENDIF
  772. IPP2 = IMAMOD
  773. IF (ipp1.eq.0) then
  774. ipp1=ipp2
  775. ELSE
  776. CALL FUSE (IPP1,IPP2,IRET,ltelq)
  777. IPP1=IRET
  778. ENDIF
  779. 1116 CONTINUE
  780.  
  781. IF(IPP1.EQ.0) THEN
  782. C Cas du resultat vide ==> MAILLAGE VIDE
  783. NBELEM = 0
  784. NBNN = NBNNE(ILCOUR)
  785. NBREF = 0
  786. NBSOUS = 0
  787. SEGINI,MELEME
  788. ITYPEL = ILCOUR
  789. IPP1 = MELEME
  790. ENDIF
  791. CALL ACTOBJ('MAILLAGE',IPP1,1)
  792. CALL ECROBJ('MAILLAGE',IPP1)
  793. RETURN
  794.  
  795. ELSEIF (MOT_4.eq.'COMP') THEN
  796. CALL LIRCHA(MOFORM(1),1,iretou)
  797. if(ierr.ne.0) return
  798. N1=0
  799. SEGINI,MMODE1
  800. DO 5497 I=1,NSOUS
  801. IMODEL=KMODEL(I)
  802. DO IB=1,MATMOD(/2)
  803. IF( MATMOD(IB) .EQ. MOFORM(1) ) GOTO 5498
  804. ENDDO
  805. GOTO 5497
  806. 5498 CONTINUE
  807. N1=N1+1
  808. MMODE1.KMODEL(**)=KMODEL(I)
  809. 5497 CONTINUE
  810.  
  811. IF(N1.GE.0.AND.N1.LT.NSOUS) THEN
  812. SEGADJ,MMODE1
  813.  
  814. ELSEIF(N1.EQ.NSOUS)THEN
  815. C Pas la peine de creer un autre MMODEL
  816. SEGSUP,MMODE1
  817. MMODE1=MMODEL
  818.  
  819. ELSE
  820. CALL ERREUR(5)
  821. ENDIF
  822.  
  823. CALL ACTOBJ('MMODEL ',MMODE1,1)
  824. CALL ECROBJ('MMODEL ',MMODE1)
  825. RETURN
  826.  
  827. ELSEIF(MOT_4.EQ.'OBJE') THEN
  828. if(NSOUS.ne.1) then
  829. WRITE(IOIMP,*) ' Dans extrai.eso : '
  830. WRITE(IOIMP,*) ' ce n est pas un modele elementaire'
  831. WRITE(IOIMP,*) ' it is not an elementary model'
  832. call erreur(19)
  833. return
  834. endif
  835. imodel=kmodel(1)
  836. iob=ivamod(/1)
  837. do io=iob,1,-1
  838. ctyp=tymode(io)
  839. if( ctyp.eq.'ENTIER') then
  840. call ecrent(ivamod(io))
  841. else
  842. ipoin1=ivamod(io)
  843. call ecrobj(ctyp,ipoin1)
  844. endif
  845. enddo
  846. return
  847.  
  848. ELSEIF (MOT_4.EQ.'ZONE') THEN
  849. M=NSOUS*2
  850. N1 = 1
  851. SEGINI MTABLE
  852. IF(NSOUS.NE.0) THEN
  853. DO 128 IOK=1,NSOUS
  854. IMODEL=KMODEL(IOK)
  855. NFOR=FORMOD(/2)
  856. C CAS DARCY OU NAVIER ON OUBLIE LA TABLE DE PRECONDITIONNEMENT
  857. CALL PLACE (FORMOD,NFOR,IDARC,'DARCY')
  858. CALL PLACE (FORMOD,NFOR,IEULE,'EULER')
  859. CALL PLACE (FORMOD,NFOR,INAVI,'NAVIER_STOKES')
  860. IF((IDARC.NE.0).OR.(INAVI.NE.0).OR.(IEULE.NE.0))THEN
  861. SEGINI,IMODE1= IMODEL
  862. IMODE1.INFMOD(2)=0
  863. IMODEL=IMODE1
  864. ENDIF
  865. SEGINI MMODE1
  866. MMODE1.KMODEL(1) = IMODEL
  867. IPP1= MMODE1
  868. IPP2=IMAMOD
  869. IVALI1=IOK*2 -1
  870. IVALI2=IOK*2
  871. CALL ECCTAB(MTABLE,'ENTIER ',IVALI1,XFLOT,MOT_8,LAG,
  872. $ IOBIN,'MMODEL ',IVALRE,XFLOT,MOT_8,LAG,IPP1)
  873. CALL ECCTAB(MTABLE,'ENTIER ',IVALI2,XFLOT,MOT_8,LAG,
  874. $ IOBIN,'MAILLAGE',IVALRE,XFLOT,MOT_8,LAG,IPP2)
  875. 128 CONTINUE
  876. ENDIF
  877. CALL ECROBJ('TABLE ',MTABLE)
  878. RETURN
  879.  
  880. ELSEIF (MOT_4.EQ.'FORM'.OR.MOT_4.EQ.'CONS'.OR.MOT_4.EQ.'ELEM'
  881. & .OR. MOT_4.EQ.'MATE'.OR.MOT_4.EQ.'NON_'
  882. & .OR.MOT_4.EQ.'PHAS') THEN
  883. INFOR=1
  884. IF (MOT_4.EQ.'MATE'.OR.MOT_4.EQ.'PHAS') THEN
  885. IPASS=0
  886. ICOND=0
  887. 1191 CALL LIRCHA(MOFORM(INFOR),ICOND,IRETO)
  888. IF (IERR.NE.0) RETURN
  889. IPASS=IPASS+1
  890. IF (IRETO.EQ.0.AND.IPASS.EQ.1) THEN
  891. CALL NOVARD(MMODEL,MOT_4)
  892. RETURN
  893. ENDIF
  894. IF (IRETO.NE.0) THEN
  895. INFOR=INFOR+1
  896. IF (INFOR.GT.NBFORM) THEN
  897. CALL ERREUR(5)
  898. RETURN
  899. ENDIF
  900. GOTO 1191
  901. ENDIF
  902. ELSE
  903. ICOND=1
  904. 1192 CALL LIRCHA(MOFORM(INFOR),ICOND,IRETO)
  905. IF (IERR.NE.0) RETURN
  906. ICOND=0
  907. IF (IRETO.NE.0) THEN
  908. INFOR=INFOR+1
  909. IF (INFOR.GT.NBFORM) THEN
  910. CALL ERREUR(5)
  911. RETURN
  912. ENDIF
  913. GOTO 1192
  914. ENDIF
  915. ENDIF
  916. INFOR=INFOR-1
  917. C
  918. JGN=4
  919. JGM=0
  920. SEGINI MLMOTS
  921. MLNONL=MLMOTS
  922. C
  923. MMODE1=MMODEL
  924.  
  925. IF (NSOUS .EQ. 0) THEN
  926. C TRAITEMENT DES SOUS-MODELES VIDES dont on veut extraire une sous
  927. C partie
  928. CALL ECROBJ('MMODEL ',IPMODL)
  929. RETURN
  930.  
  931. ELSE
  932. N1=NSOUS
  933. SEGINI,MMODEL
  934. IPP1=MMODEL
  935. NZON=0
  936. IMECAF=0
  937. DO 1119 I=1,NSOUS
  938. IMODEL=MMODE1.KMODEL(I)
  939. IF(MOT_4.EQ.'FORM') THEN
  940. NFOR=FORMOD(/2)
  941.  
  942. IF(NFOR.NE.INFOR) GOTO 1119
  943. IF(NFOR.EQ.1) THEN
  944. IF(MOFORM(1).NE.FORMOD(1)) GOTO 1119
  945. ELSEIF(NFOR.EQ.2) THEN
  946. IF(((MOFORM(1).NE.FORMOD(1)).AND.(MOFORM(2).NE.
  947. $ FORMOD(2))).AND.((MOFORM(1).NE.FORMOD(2)).AND.
  948. $ (MOFORM(2).NE.FORMOD(1))))GOTO 1119
  949. ELSE
  950. GOTO 1118
  951. ENDIF
  952. ELSEIF (MOT_4.EQ.'CONS') THEN
  953. DO 425 IJ=1,INFOR
  954. C on enleve les espaces au debut et a la fin
  955. idim0=LEN(MOFORM(IJ))
  956. idim1=CONMOD(/1)
  957. ideb0=0
  958. ifin0=0
  959. ideb1=0
  960. ifin1=0
  961. DO ii=1,idim0
  962. IF(ideb0.EQ.0.AND.MOFORM(IJ)(ii:ii).NE.' ')
  963. $ ideb0=ii
  964. IF(ifin0.EQ.0.AND.
  965. & MOFORM(IJ)(idim0-ii+1:idim0-ii+1).NE.' ')
  966. & ifin0=idim0-ii+1
  967. ENDDO
  968. DO ii=1,idim1
  969. IF(ideb1.EQ.0.AND.CONMOD(ii:ii).NE.' ') ideb1=ii
  970. IF(ifin1.EQ.0.AND.
  971. & CONMOD(idim1-ii+1:idim1-ii+1).NE.' ')
  972. & ifin1=idim1-ii+1
  973. ENDDO
  974. C print *,'Limites : ',ideb0,ifin0,' / ',ideb1,ifin1
  975. IF(MOFORM(IJ)(ideb0:ifin0).EQ.CONMOD(ideb1:ifin1))
  976. & GOTO 429
  977. 425 CONTINUE
  978. GOTO 1119
  979. ELSEIF (MOT_4.EQ.'ELEM') THEN
  980. DO 426 IJ=1,INFOR
  981. IF(MOFORM(IJ)(1:4).EQ.NOMTP(NEFMOD)) GOTO 429
  982. 426 CONTINUE
  983. GOTO 1119
  984. ELSEIF(MOT_4.EQ.'MATE') THEN
  985. NMAT=MATMOD(/2)
  986. DO 427 IJ=1,INFOR
  987. DO 4275 JJ=1,NMAT
  988. IF(MATMOD(JJ).EQ.MOFORM(IJ)) GOTO 429
  989. 4275 CONTINUE
  990. 427 CONTINUE
  991. GOTO 1119
  992. ELSEIF(MOT_4.EQ.'NON_') THEN
  993. MN3=INFMOD(/1)
  994. IF(MN3.LE.12) GOTO 1119
  995. INLOC=-1*INFMOD(13)
  996. IF(INLOC.EQ.0) GOTO 1119
  997. CALL MODNLO(MNLOCA,NLODIM)
  998. DO 428 IJ=1,INFOR
  999. IF(MNLOCA(INLOC).EQ.MOFORM(IJ)(1:4)) GOTO 429
  1000. 428 CONTINUE
  1001. GOTO 1119
  1002. ELSEIF(MOT_4.EQ.'PHAS'
  1003. & .AND.CONMOD.NE.' ') THEN
  1004. DO 430 IJ=1,INFOR
  1005. IF(CONMOD(17:24).EQ.MOFORM(IJ)(1:8)) GOTO 429
  1006. 430 CONTINUE
  1007. GOTO 1119
  1008. ENDIF
  1009. C on vient ici pour prendre les sous modeles
  1010. 429 CONTINUE
  1011. NZON=NZON+1
  1012. NFOR=FORMOD(/2)
  1013.  
  1014. C CAS DARCY OU NAVIER ON OUBLIE LA TABLE DE PRECONDITIONNEMENT
  1015. CALL PLACE (FORMOD,NFOR,IDARC,'DARCY')
  1016. CALL PLACE (FORMOD,NFOR,IEULE,'EULER')
  1017. CALL PLACE (FORMOD,NFOR,INAVI,'NAVIER_STOKES')
  1018. IF((IDARC.NE.0).OR.(INAVI.NE.0).OR.(IEULE.NE.0))THEN
  1019. IMECAF=1
  1020. SEGINI,IMODE1=IMODEL
  1021. IMODE1.INFMOD(2)=0
  1022. IMODEL=IMODE1
  1023. ENDIF
  1024.  
  1025. KMODEL(NZON)=IMODEL
  1026. 1119 CONTINUE
  1027. ENDIF
  1028. C
  1029. IF(NZON.EQ.0) GOTO 1118
  1030.  
  1031. IF(NZON.EQ.NSOUS .AND. IMECAF.EQ.0) THEN
  1032. C Le SOUS-MODELE demande est le MODELE d'origine
  1033. CALL ECROBJ('MMODEL ',IPMODL)
  1034.  
  1035. ELSE
  1036. IF(NZON.NE.NSOUS)THEN
  1037. N1=NZON
  1038. SEGADJ,MMODEL
  1039. ENDIF
  1040. CALL ACTOBJ('MMODEL ',IPP1,1)
  1041. CALL ECROBJ('MMODEL ',IPP1)
  1042. ENDIF
  1043. RETURN
  1044.  
  1045. 1118 CONTINUE
  1046. CALL ERREUR(610)
  1047. RETURN
  1048.  
  1049. ELSEIF (IRET.GE.6.AND.IRET.LE.18.AND.IRET.NE.13) THEN
  1050. CALL NOVARD(MMODEL,MOT_4)
  1051. RETURN
  1052.  
  1053. ELSEIF (IRET.EQ.22) THEN
  1054. JGN=4
  1055. JGM=0
  1056. SEGINI MLMOTS
  1057. MLNONL=MLMOTS
  1058. C
  1059. MMODE1=MMODEL
  1060. NSOUS=MMODE1.KMODEL(/1)
  1061. C
  1062. C TRAITEMENT DES SOUS-MODELES VIDES dont on veut extraire une sous
  1063. C partie
  1064. IF (NSOUS .EQ. 0) THEN
  1065. SEGACT,MLMOTS
  1066. CALL ECROBJ('LISTMOTS',MLMOTS)
  1067. RETURN
  1068. ELSE
  1069. DO 1122 I=1,NSOUS
  1070. IMODEL=MMODE1.KMODEL(I)
  1071. NFOR=FORMOD(/2)
  1072. IF(NFOR.GE.1) THEN
  1073. IF (FORMOD(1).NE.'MECANIQUE'.AND.
  1074. & FORMOD(1).NE.'POREUX') GOTO 1123
  1075. MN3=INFMOD(/1)
  1076. IF(MN3.LE.12) GOTO 1123
  1077. INONL=INFMOD(14)
  1078. IF(INONL.EQ.0) GOTO 1123
  1079. MLMOT1=INONL
  1080. SEGACT MLMOT1
  1081. NMONL=MLMOT1.MOTS(/2)
  1082. IF(NMONL.EQ.0)GOTO 1123
  1083. IF(JGM.EQ.0) THEN
  1084. JGM=NMONL
  1085. SEGADJ,MLMOTS
  1086. DO IJ=1,NMONL
  1087. MOTS(IJ)=MLMOT1.MOTS(IJ)
  1088. ENDDO
  1089. ELSE
  1090. DO IJ=1,NMONL
  1091. CALL PLACE(MOTS,JGM,IPLA,MLMOT1.MOTS(IJ))
  1092. IF(IPLA.EQ.0) THEN
  1093. JGM=JGM+1
  1094. SEGADJ,MLMOTS
  1095. MOTS(JGM)=MLMOT1.MOTS(IPLA)
  1096. ENDIF
  1097. ENDDO
  1098. ENDIF
  1099. 1123 CONTINUE
  1100. ENDIF
  1101. 1122 CONTINUE
  1102. SEGACT,MLMOTS
  1103. CALL ECROBJ('LISTMOTS',MLMOTS)
  1104. RETURN
  1105. ENDIF
  1106. *
  1107. ELSE IF (MOT_4.eq.'CENT') THEN
  1108. * pour NAVIER-STOKE NLIN, extrai les POINTS CENTRES
  1109. ipma = 0
  1110. c
  1111. L1 = 8
  1112. n1 = 1
  1113. segini mmode1
  1114. n3 = 6
  1115. segini mchel1
  1116. n2 = 1
  1117. segini mcham1
  1118. mchel1.ichaml(1) = mcham1
  1119. ipmons = mmode1
  1120. ipchns = mchel1
  1121. do is = 1,nsous
  1122. imodel = kmodel(is)
  1123. if (formod(1).eq.'NAVIER_STOKES'.and.matmod(1).eq.'NLIN')
  1124. & then
  1125. mmode1.kmodel(1) = imodel
  1126. call go2nli(ipmons,ipchns,ipres,5)
  1127. if (ierr.ne.0 ) return
  1128. endif
  1129. if (ipma.eq.0) then
  1130. ipma = ipres
  1131. else
  1132. call fuse(ipma,ipres,ip3,.true.)
  1133. if (ierr.ne.0) return
  1134. ipma = ip3
  1135. endif
  1136. enddo
  1137. segsup mchel1, mcham1, mmode1
  1138. if (IPMA.GT.0) then
  1139. call ecrobj('MAILLAGE',ipma)
  1140. return
  1141. else
  1142. call erreur(21)
  1143. return
  1144. endif
  1145. ELSE
  1146. MOTERR=MOT_4
  1147. CALL ERREUR(7)
  1148. RETURN
  1149. ENDIF
  1150.  
  1151.  
  1152. * +-------------------------------------------------------------------+
  1153. * | |
  1154. * | C H A R G E M E N T |
  1155. * | |
  1156. * +-------------------------------------------------------------------+
  1157. ELSEIF (CTYP.EQ.'CHARGEME') THEN
  1158. CALL LIROBJ('CHARGEME',ICHAR,1,IRET)
  1159. IF (IERR.NE.0) RETURN
  1160. C
  1161. CMOT = ' '
  1162. ICHGT = 0
  1163. LCHGT = 0
  1164. IEC = 1
  1165. CALL LIROBJ('LISTMOTS',LCHGT,0,IRET)
  1166. IF (IERR.NE.0) RETURN
  1167. IF (IRET.EQ.0) THEN
  1168. CALL LIRCHA(CMOT,1,IRETOU)
  1169. IF (IERR.NE.0) RETURN
  1170. CALL PLACE(MCHGT,NBCHGT,ICHGT,CMOT)
  1171. IF ((ICHGT.GE.1 .AND. ICHGT.LE.5) .OR. ICHGT.GE.9) THEN
  1172. CALL LIRENT(IEC,0,IRETOU)
  1173. IF (IERR.NE.0) RETURN
  1174. IF (IRETOU.EQ.0) IEC = 1
  1175. ELSEIF (ICHGT.EQ.0) THEN
  1176. CALL LIRCHA(MOT_4,0,IRETOU)
  1177. IF (IRETOU.NE.0) THEN
  1178. IF (MOT_4.EQ.'TABL') THEN
  1179. ICHGT=-1
  1180. ELSE
  1181. CALL REFUS
  1182. ENDIF
  1183. ENDIF
  1184. ENDIF
  1185. ENDIF
  1186. C
  1187. CALL EXTR20(ICHAR,CMOT,ICHGT,LCHGT,IEC,IOBJ1,CTYP1,IOBJ2,MOT_8)
  1188. C
  1189. IF (IOBJ1.NE.0) CALL ECROBJ(CTYP1,IOBJ1)
  1190. IF (IOBJ2.NE.0) CALL ECROBJ(MOT_8,IOBJ2)
  1191. RETURN
  1192.  
  1193.  
  1194. * +-------------------------------------------------------------------+
  1195. * | |
  1196. * | L I S T C H P O |
  1197. * | |
  1198. * +-------------------------------------------------------------------+
  1199. ELSEIF (CTYP.EQ.'LISTCHPO') THEN
  1200. CALL LIROBJ('LISTCHPO',ILCHP1,1,IRET)
  1201. IF (IERR.NE.0) RETURN
  1202. CALL QUETYP(CTYP1,0,IRETOU)
  1203. IF (IRETOU.EQ.0) THEN
  1204. CALL ERREUR(533)
  1205. RETURN
  1206. ENDIF
  1207.  
  1208. MLCHP1 = ILCHP1
  1209. SEGACT , MLCHP1
  1210. LONCHP = MLCHP1.ICHPOI(/1)
  1211.  
  1212. * ===============================
  1213. * EXTRACTION DE PLUSIEURS INDICES
  1214. * ===============================
  1215. IF (CTYP1.EQ.'LISTENTI') THEN
  1216. CALL LIROBJ('LISTENTI',ILENT,1,IRET)
  1217. IF (IERR.NE.0) RETURN
  1218. MLENTI = ILENT
  1219. SEGACT,MLENTI
  1220. JG = LECT(/1)
  1221. N1=JG
  1222. SEGINI,MLCHP2
  1223. ILCHP2= MLCHP2
  1224. DO 1211 I=1 , JG
  1225. IF (( LECT(I) .GT. LONCHP ) .OR. ( LECT(I) .LT. 1 )) THEN
  1226. INTERR(1) = LECT(I)
  1227. CALL ERREUR(620)
  1228. ENDIF
  1229. MLCHP2.ICHPOI(I) = MLCHP1.ICHPOI(LECT(I))
  1230. 1211 CONTINUE
  1231. CALL ACTOBJ ('LISTCHPO',ILCHP2,0)
  1232. CALL ECROBJ ('LISTCHPO',ILCHP2)
  1233. RETURN
  1234.  
  1235. * ===========================
  1236. * EXTRACTION D'UN SEUL INDICE
  1237. * ===========================
  1238. ELSEIF (CTYP1.EQ.'ENTIER') THEN
  1239. CALL LIRENT(ILENT,1,IRETOU)
  1240. IF (IERR.NE.0) RETURN
  1241. IF (ILENT.GT.LONCHP .OR. ILENT.LT.1 ) THEN
  1242. INTERR(1)=ILENT
  1243. CALL ERREUR(620)
  1244. ENDIF
  1245. ILCHPO = MLCHP1.ICHPOI(ILENT)
  1246. CALL ACTOBJ('CHPOINT ',ILCHPO,1)
  1247. CALL ECROBJ('CHPOINT ',ILCHPO)
  1248. RETURN
  1249.  
  1250. * ====================================================
  1251. * MOT-CLE "VALE" => EXTRACTION DES VALEURS EN UN POINT
  1252. * ====================================================
  1253. ELSEIF (CTYP1.EQ.'MOT') THEN
  1254. CALL LIRCHA(CMOT,1,IRETOU)
  1255. IF (IERR.NE.0) RETURN
  1256. IF (CMOT.NE.'VALE') THEN
  1257. MOTERR = 'VALE'
  1258. CALL ERREUR(396)
  1259. RETURN
  1260. ENDIF
  1261. CALL LIROBJ('LISTMOTS',MLMOTS,0,IRETOU)
  1262. IF (IRETOU.EQ.0) THEN
  1263. CALL LIRCHA(MOCOMP,0,IRETOU)
  1264. IF (IRETOU.GT.0) THEN
  1265. JGN=LOCOMP
  1266. JGM=1
  1267. SEGINI,MLMOTS
  1268. MOTS(1)=MOCOMP
  1269. ENDIF
  1270. ENDIF
  1271. CALL LIROBJ('POINT',MPOINT,1,IRETOU)
  1272. IF (IERR.NE.0) RETURN
  1273. CALL EXTR24(MLCHP1,MLMOTS,MPOINT,MLREEL)
  1274. IF (IERR.NE.0) RETURN
  1275. SEGACT,MLREEL
  1276. CALL ECROBJ('LISTREEL',MLREEL)
  1277. RETURN
  1278.  
  1279. * SYNTAXE INCORRECTE
  1280. ELSE
  1281. MOTERR(1:40) = 'ENTIER LISTENTI"VALE"'
  1282. CALL ERREUR(471)
  1283. RETURN
  1284. ENDIF
  1285.  
  1286.  
  1287. * +-------------------------------------------------------------------+
  1288. * | |
  1289. * | N U A G E |
  1290. * | |
  1291. * +-------------------------------------------------------------------+
  1292. ELSEIF (CTYP.EQ.'NUAGE') THEN
  1293. CALL LIROBJ('NUAGE ',IPOINT,1,IRET)
  1294. CALL ACTOBJ('NUAGE ',IPOINT,1)
  1295. IF (IERR.NE.0) RETURN
  1296.  
  1297. MNUAGE=IPOINT
  1298. CALL LIRMOT(NUMO,5,INU1,0)
  1299. IF (INU1.EQ.0) THEN
  1300. CALL LIRCHA(CTYP1,1,IRETOU)
  1301. IF (IERR.NE.0) THEN
  1302. RETURN
  1303. ENDIF
  1304. CALL LIRMOT(NUMO,5,INU1,0)
  1305. IF (INU1.EQ.0) THEN
  1306. IF (CTYP1.EQ.'COMP ') THEN
  1307. IPROG = 1
  1308. ELSE
  1309. IPOSI = 0
  1310. DO 1250 I=1,NUANOM(/2)
  1311. IF (NUANOM(I).EQ.CTYP1) IPOSI=I
  1312. 1250 CONTINUE
  1313. IF (IPOSI.EQ.0) THEN
  1314. MOTERR(1:8) = CTYP1
  1315. C TYP1 n'est pas un nom de variable du NUAGE
  1316. CALL ERREUR(672)
  1317. RETURN
  1318. ENDIF
  1319. IPROG = 2
  1320. ENDIF
  1321. ELSE
  1322. IPOSI = 0
  1323. DO 1251 I=1,NUANOM(/2)
  1324. IF (NUANOM(I).EQ.CTYP1) IPOSI=I
  1325. 1251 CONTINUE
  1326. IF (IPOSI.EQ.0) THEN
  1327. MOTERR(1:8) = CTYP1
  1328. C TYP1 n'est pas un nom de variable du NUAGE
  1329. CALL ERREUR(672)
  1330. RETURN
  1331. ENDIF
  1332. IPROG = 3
  1333. ENDIF
  1334. ELSE
  1335. CALL LIRCHA(CTYP1,1,IRETOU)
  1336. IF (IERR.NE.0) RETURN
  1337. IPOSI = 0
  1338. DO 1252 I=1,NUANOM(/2)
  1339. IF (NUANOM(I).EQ.CTYP1) IPOSI=I
  1340. 1252 CONTINUE
  1341. IF (IPOSI.EQ.0) THEN
  1342. MOTERR= CTYP1
  1343. C TYP1 n'est pas un nom de variable du NUAGE
  1344. CALL ERREUR(672)
  1345. RETURN
  1346. ELSE
  1347. IPROG = 3
  1348. ENDIF
  1349. ENDIF
  1350.  
  1351. C-------------- Lecture eventuelle des FLOTTANTS -------------
  1352. IF ((IPROG.EQ.3).AND.(INU1.NE.3).AND.(INU1.NE.4)) THEN
  1353. IF ((INU1.EQ.1).OR.(INU1.EQ.2)) THEN
  1354. CALL LIRREE(XVAL1,0,IRETOU)
  1355. IF (IRETOU.EQ.0) THEN
  1356. C Il manque la valeur de la composante reelle
  1357. CALL ERREUR(668)
  1358. RETURN
  1359. ENDIF
  1360. ELSE
  1361. CALL LIRREE(XVAL1,0,IRETO1)
  1362. CALL LIRREE(XVAL2,0,IRETO2)
  1363. IF ((IRETO1.EQ.0).OR.(IRETO2.EQ.0)) THEN
  1364. C Il faut specifier deux valeurs reelles
  1365. CALL ERREUR(673)
  1366. RETURN
  1367. ENDIF
  1368. ENDIF
  1369. ENDIF
  1370.  
  1371. C--------- Cas de l'extraction des noms des composantes du NUAGE -------
  1372. IF (IPROG.EQ.1) THEN
  1373. CALL EXTR19(IPOINT,IPLSTM)
  1374. IF (IPLSTM.NE.0) THEN
  1375. CALL ECROBJ('LISTMOTS',IPLSTM)
  1376. ENDIF
  1377.  
  1378. C----Cas de l'extraction de l'objet correspondant a une composante ---
  1379. C----------------- donnee d'un NUAGE "colonne" -----------------------
  1380.  
  1381. ELSEIF (IPROG.EQ.2) THEN
  1382. CALL EXTR51(IPOINT,IPOSI)
  1383.  
  1384. C---------------------------- Autres cas ------------------------------
  1385. ELSEIF (IPROG.EQ.3) THEN
  1386. IF (INU1.EQ.1) THEN
  1387. BORINF=.TRUE.
  1388. CALL EXTR50(IPOINT,BORINF,XVAL1,IPOSI)
  1389. ELSEIF (INU1.EQ.2) THEN
  1390. BORINF=.FALSE.
  1391. CALL EXTR50(IPOINT,BORINF,XVAL1,IPOSI)
  1392. ELSEIF (INU1.EQ.3) THEN
  1393. MINI =.TRUE.
  1394. CALL EXTR52(IPOINT,MINI,IPOSI)
  1395. ELSEIF (INU1.EQ.4) THEN
  1396. MINI =.FALSE.
  1397. CALL EXTR52(IPOINT,MINI,IPOSI)
  1398. ELSEIF (INU1.EQ.5) THEN
  1399. CALL EXTR53(IPOINT,XVAL1,XVAL2,IPOSI)
  1400. ELSE
  1401. CALL ERREUR(21)
  1402. RETURN
  1403. ENDIF
  1404.  
  1405. C---------------------------- Cas non prevus ---------------------------
  1406. ELSE
  1407. CALL ERREUR(21)
  1408. RETURN
  1409. ENDIF
  1410. RETURN
  1411.  
  1412.  
  1413. * +-------------------------------------------------------------------+
  1414. * | |
  1415. * | L I S T O B J E |
  1416. * | |
  1417. * +-------------------------------------------------------------------+
  1418. ELSEIF (CTYP.EQ.'LISTOBJE') THEN
  1419. CALL LIROBJ('LISTOBJE',ILOBJ,1,IRET)
  1420. IF (IERR.NE.0) RETURN
  1421.  
  1422. C EXTRACTION DU TYPE DES OBJETS DE LA LISTE
  1423. CALL LIRCHA(CTEXT,0,IRET)
  1424. IF (IRET.NE.0) THEN
  1425. IF (CTEXT(1:4).EQ.'TYPE') THEN
  1426. MLOBJE = ILOBJ
  1427. SEGACT,MLOBJE
  1428. CTYP = TYPOBJ
  1429. CALL ECRCHA(CTYP)
  1430. RETURN
  1431. ENDIF
  1432. ENDIF
  1433.  
  1434. C EXTRACTION D'UN OBJET DE LA LISTE
  1435. CALL LIRENT(I1,1,IRET)
  1436. IF (IERR.NE.0) RETURN
  1437. IF (I1.LE.0) THEN
  1438. CALL ERREUR(21)
  1439. RETURN
  1440. ENDIF
  1441. MLOBJE = ILOBJ
  1442. SEGACT,MLOBJE
  1443. NOBJ = LISOBJ(/1)
  1444. IF (I1.GT.NOBJ) THEN
  1445. INTERR = I1
  1446. CALL ERREUR(620)
  1447. RETURN
  1448. ENDIF
  1449. IP1 = LISOBJ(I1)
  1450. CTYP = TYPOBJ
  1451. CALL ECROBJ(CTYP,IP1)
  1452. RETURN
  1453.  
  1454.  
  1455. C FIN IF(CTYP...
  1456. ENDIF
  1457.  
  1458.  
  1459. ***********************************************************************
  1460. * ON TRAITE LES LISTENTI, LISTREEL ET LISTMOTS SEPAREMENT POUR *
  1461. * POUVOIR TOLERER L'INVERSION DES DEUX ARGUMENTS (LA LISTE PRINCIPALE *
  1462. * ET L'INDICE/LA LISTE D'INDICES) *
  1463. ***********************************************************************
  1464.  
  1465.  
  1466. * +-------------------------------------------------------------------+
  1467. * | |
  1468. * | L I S T M O T S |
  1469. * | |
  1470. * +-------------------------------------------------------------------+
  1471. 10 CONTINUE
  1472. CALL LIROBJ('LISTMOTS',ILMOT1,0,IRET)
  1473. IF (IRET.EQ.0) GOTO 20
  1474.  
  1475. MLMOT1 = ILMOT1
  1476. SEGACT , MLMOT1
  1477. LONMOT = MLMOT1.MOTS(/2)
  1478. JGN = MLMOT1.MOTS(/1)
  1479.  
  1480. * ===============================
  1481. * EXTRACTION DE PLUSIEURS INDICES
  1482. * ===============================
  1483. CALL LIROBJ('LISTENTI',ILENT,0,IRET)
  1484. IF ( IRET .EQ. 1 ) THEN
  1485. MLENTI = ILENT
  1486. SEGACT , MLENTI
  1487. JGM = LECT(/1)
  1488. SEGINI , MLMOT2
  1489. ILMOT2= MLMOT2
  1490. DO 1221 I=1 , JGM
  1491. I_EXTR =LECT(I)
  1492. IF (( I_EXTR .GT. LONMOT ) .OR. ( I_EXTR .LT. 1 )) THEN
  1493. INTERR(1) = I_EXTR
  1494. CALL ERREUR(620)
  1495. ENDIF
  1496. MLMOT2.MOTS(I) = MLMOT1.MOTS(I_EXTR)
  1497. 1221 CONTINUE
  1498. SEGACT , MLMOT2
  1499. CALL ECROBJ ('LISTMOTS',ILMOT2)
  1500. RETURN
  1501.  
  1502. * ===========================
  1503. * EXTRACTION D'UN SEUL INDICE
  1504. * ===========================
  1505. ELSE
  1506. CALL LIRENT (ILENT,1,IRETOU)
  1507. IF (IERR .NE. 0) RETURN
  1508. IF (ILENT.GT.LONMOT .OR. ILENT.LT.1 ) THEN
  1509. INTERR(1)=ILENT
  1510. CALL ERREUR(620)
  1511. ELSE
  1512. CTEXT = MLMOT1.MOTS(ILENT)
  1513. ENDIF
  1514. CALL ECRCHA(CTEXT(1:JGN))
  1515. RETURN
  1516. ENDIF
  1517.  
  1518.  
  1519. * +-------------------------------------------------------------------+
  1520. * | |
  1521. * | L I S T R E E L |
  1522. * | |
  1523. * +-------------------------------------------------------------------+
  1524. 20 CONTINUE
  1525. CALL LIROBJ('LISTREEL',ILREE1,0,IRET)
  1526. IF (IRET.EQ.0) GOTO 30
  1527.  
  1528. MLREE1 = ILREE1
  1529. SEGACT , MLREE1
  1530. LONREE = MLREE1.PROG(/1)
  1531.  
  1532. * ===============================
  1533. * EXTRACTION DE PLUSIEURS INDICES
  1534. * ===============================
  1535. CALL LIROBJ('LISTENTI',ILENT,0,IRET)
  1536. IF ( IRET .EQ. 1 ) THEN
  1537. MLENTI = ILENT
  1538. SEGACT , MLENTI
  1539. JG = LECT(/1)
  1540. SEGINI , MLREE2
  1541. ILREE2= MLREE2
  1542. DO 1231 I=1 , JG
  1543. I_EXTR =LECT(I)
  1544. IF (( I_EXTR .GT. LONREE ) .OR. ( I_EXTR .LT. 1 )) THEN
  1545. INTERR(1) = I_EXTR
  1546. CALL ERREUR(620)
  1547. RETURN
  1548. ENDIF
  1549. MLREE2.PROG(I) = MLREE1.PROG(I_EXTR)
  1550. 1231 CONTINUE
  1551. SEGACT , MLREE2
  1552. CALL ECROBJ ('LISTREEL',ILREE2)
  1553. RETURN
  1554.  
  1555. * ===========================
  1556. * EXTRACTION D'UN SEUL INDICE
  1557. * ===========================
  1558. ELSE
  1559. CALL LIRENT (ILENT,1,IRETOU)
  1560. IF (IERR .NE. 0) RETURN
  1561. IF (ILENT.GT.LONREE .OR. ILENT.LT.1 ) THEN
  1562. INTERR(1)=ILENT
  1563. CALL ERREUR(620)
  1564. ELSE
  1565. REELDP = MLREE1.PROG(ILENT)
  1566. ENDIF
  1567. CALL ECRREE(REELDP)
  1568. RETURN
  1569. ENDIF
  1570. 124 CONTINUE
  1571.  
  1572.  
  1573. * +-------------------------------------------------------------------+
  1574. * | |
  1575. * | L I S T E N T I |
  1576. * | |
  1577. * +-------------------------------------------------------------------+
  1578. 30 CONTINUE
  1579. CALL LIROBJ('LISTENTI',ILENT1,0,IRET)
  1580. IF (IRET.EQ.0) GOTO 999
  1581.  
  1582. MLENT1 = ILENT1
  1583. SEGACT , MLENT1
  1584. LONENT = MLENT1.LECT(/1)
  1585.  
  1586. * ===============================
  1587. * EXTRACTION DE PLUSIEURS INDICES
  1588. * ===============================
  1589. CALL LIROBJ('LISTENTI',ILENT2,0,IRET)
  1590. IF ( IRET .EQ. 1 ) THEN
  1591. MLENT2 = ILENT2
  1592. SEGACT , MLENT2
  1593. JG = MLENT2.LECT(/1)
  1594. SEGINI , MLENT3
  1595. ILENT3= MLENT3
  1596. DO 1241 I=1 , JG
  1597. I_EXTR =MLENT2.LECT(I)
  1598. IF (I_EXTR.GT.LONENT.OR.I_EXTR.LT.1) THEN
  1599. INTERR(1) = I_EXTR
  1600. CALL ERREUR(620)
  1601. ENDIF
  1602. MLENT3.LECT(I) = MLENT1.LECT(I_EXTR)
  1603. 1241 CONTINUE
  1604. SEGACT , MLENT3
  1605. CALL ECROBJ ('LISTENTI',ILENT3)
  1606. RETURN
  1607.  
  1608. * ===========================
  1609. * EXTRACTION D'UN SEUL INDICE
  1610. * ===========================
  1611. ELSE
  1612. CALL LIRENT (ILENT,1,IRETOU)
  1613. IF (IERR .NE. 0) RETURN
  1614. IF (ILENT.GT.LONENT .OR. ILENT.LT.1 ) THEN
  1615. INTERR(1)=ILENT
  1616. CALL ERREUR(620)
  1617. ELSE
  1618. INTEGR = MLENT1.LECT(ILENT)
  1619. ENDIF
  1620. CALL ECRENT(INTEGR)
  1621. RETURN
  1622. ENDIF
  1623.  
  1624.  
  1625. * +-------------------------------------------------------------------+
  1626. * | E R R E U R : P A S D ' O B J E T C O M P A T I B L E |
  1627. * +-------------------------------------------------------------------+
  1628. 999 CONTINUE
  1629. CALL ERREUR(676)
  1630.  
  1631. END
  1632.  
  1633.  
  1634.  

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