Télécharger vide.eso

Retour à la liste

Numérotation des lignes :

vide
  1. C VIDE SOURCE PASCAL 22/06/10 21:15:07 11377
  2. C***********************************************************************
  3. C NOM : VIDE
  4. C DESCRIPTION : Crée des objets vides de types/sous-types donnés
  5. C***********************************************************************
  6. C HISTORIQUE : 13/03/2012 : JCARDO : création de l'opérateur
  7. C HISTORIQUE : 17/04/2012 : JCARDO : ajout de SMDEFOR et SMVECTE
  8. C HISTORIQUE : 12/10/2012 : JCARDO : ajout de SMCHARG
  9. C***********************************************************************
  10. C Prière de PRENDRE LE TEMPS DE COMPLÉTER LES COMMENTAIRES
  11. C en cas de modification de ce sous-programme afin de faciliter
  12. C la maintenance !
  13. C***********************************************************************
  14. C APPELÉ PAR : pilot.eso
  15. C***********************************************************************
  16. C ENTRÉES :: aucune
  17. C SORTIES :: aucune
  18. C***********************************************************************
  19. C SYNTAXE (GIBIANE) : VOIR NOTICE
  20. C
  21. C OBJ1,...,OBJn = VIDE [GROUPE1,...,GROUPEn]
  22. C
  23. C ou TAB1 = VIDE ('TABULER' ( |LENTI1| ) ) [GROUPE1,...,GROUPEn]
  24. C |LREEL1|
  25. C |LMOTS1|
  26. C
  27. C
  28. C avec GROUPEi de la forme : MOTAi(/MOTBi)(*ENTIi)
  29. C
  30. C***********************************************************************
  31. SUBROUTINE VIDE
  32.  
  33. IMPLICIT INTEGER(I-N)
  34. IMPLICIT REAL*8(A-H,O-Z)
  35.  
  36. -INC CCGEOME
  37.  
  38. -INC PPARAM
  39. -INC CCOPTIO
  40.  
  41. -INC SMELEME
  42. -INC SMCHPOI
  43. -INC SMCHAML
  44. -INC SMMODEL
  45. -INC SMRIGID
  46. -INC SMEVOLL
  47. -INC SMLENTI
  48. -INC SMLREEL
  49. -INC SMLMOTS
  50. -INC SMLCHPO
  51. -INC SMTABLE
  52. -INC SMDEFOR
  53. -INC SMVECTE
  54. -INC SMCHARG
  55. -INC SMNUAGE
  56. -INC SMANNOT
  57. -INC SMLOBJE
  58.  
  59. LOGICAL LOG1
  60. CHARACTER*20 MARG
  61. CHARACTER*8 CHAI,TYIN,TYOB,CTYP
  62. CHARACTER*4 CHAA
  63.  
  64. CHARACTER*4 MSPE(2)
  65. DATA MSPE/'* ','/ '/
  66.  
  67. PARAMETER (LMTYP=17)
  68. CHARACTER*8 MTYP(LMTYP)
  69. DATA MTYP/'MAILLAGE',
  70. . 'CHPOINT ',
  71. . 'MCHAML ',
  72. . 'MMODEL ',
  73. . 'RIGIDITE',
  74. . 'EVOLUTIO',
  75. . 'LISTENTI',
  76. . 'LISTREEL',
  77. . 'LISTMOTS',
  78. . 'LISTCHPO',
  79. . 'TABLE ',
  80. . 'DEFORME ',
  81. . 'VECTEUR ',
  82. . 'CHARGEME',
  83. . 'NUAGE ',
  84. . 'ANNOTATI',
  85. . 'LISTOBJE'/
  86.  
  87. CHARACTER*4 MNAT(2)
  88. DATA MNAT/'DIFF','DISC'/
  89.  
  90.  
  91. C On crée le segment IPSORT pour que l'ordre des objets en sortie
  92. C corresponde bien à celui des arguments en entrée (ordre inverse)
  93. C => MOINS UTILE POUR L'OPTION 'TABULER' (MAIS QUAND MÊME UTILISÉ)
  94. SEGMENT IPSORT
  95. INTEGER IPOOBJ(NOBJ)
  96. CHARACTER*8 MTYPOB(NOBJ)
  97. ENDSEGMENT
  98.  
  99.  
  100. C BRANCHEMENT 2e SYNTAXE :
  101. C Test type argument : si pas MOT => 2e syntaxe
  102. CALL QUETYP(CTYP,0,IRETOU)
  103. C write(6,*) 'CTYP =',CTYP
  104. IF (IRETOU.EQ.0) THEN
  105. CALL ERREUR(533)
  106. RETURN
  107. ENDIF
  108. CALL PLACE(MTYP,LMTYP,ITYP,CTYP)
  109. C write(6,*) 'ITYP =',ITYP
  110. IF (ITYP.NE.0) GOTO 1000
  111.  
  112.  
  113. C----------------------------------------------------------------------C
  114. C CREATION D'UN OBJET VIDE C
  115. C----------------------------------------------------------------------C
  116. C
  117. C NOBJ = nombre d'objets vides créés au total par cette subroutine
  118. NOBJ=0
  119. SEGINI IPSORT
  120.  
  121.  
  122.  
  123. C **************************************************************
  124. C DÉTERMINATION DU MODE D'ÉCRITURE EN SORTIE
  125. C **************************************************************
  126. C
  127. C Deux possibilités pour sortir les résultats :
  128. C
  129. C - Option 'TABU' => les objets sont placés dans une table dont
  130. C les indices peuvent être choisis soit par
  131. C l'utilisateur, soit automatiquement
  132. C
  133. C ITAB | IRET | TYIN
  134. C ---------+----------------+---------------
  135. C 1 | 0 | ENTIER
  136. C 2 | -> LISTENTI | ENTIER
  137. C 3 | -> LISTREEL | FLOTTANT
  138. C 4 | -> LISTMOTS | MOT
  139. C
  140. C - Par défaut => on sort les objets séparément
  141. C
  142. CALL LIRCHA(CHAA,1,LCHTA)
  143.  
  144. C =============
  145. C OPTION 'TABU'
  146. C =============
  147. IF (CHAA.EQ.'TABU') THEN
  148. ITAB=1
  149. TYIN='ENTIER '
  150.  
  151. C L'utilisateur a-t-il transmis une liste d'indices ?
  152. CHAI=' '
  153. CALL LIRABJ(CHAI,IRET,0,IRETOU)
  154. IF (IRETOU.EQ.1) THEN
  155.  
  156. C => OUI : objet LISTENTI, LISTREEL ou LISTMOTS
  157. IF (CHAI.EQ.'LISTENTI') THEN
  158. ITAB=2
  159. TYIN='ENTIER '
  160. MLENT1=IRET
  161. SEGACT MLENT1
  162. ELSEIF (CHAI.EQ.'LISTREEL') THEN
  163. ITAB=3
  164. TYIN='FLOTTANT'
  165. MLREE1=IRET
  166. SEGACT MLREE1
  167. ELSEIF (CHAI.EQ.'LISTMOTS') THEN
  168. ITAB=4
  169. TYIN='MOT '
  170. MLMOT1=IRET
  171. SEGACT MLMOT1
  172.  
  173. C => NON : autres objets
  174. ELSEIF (CHAI.EQ.'MOT') THEN
  175. CALL REFUS
  176. ELSE
  177. C ERREUR CRITIQUE 39 (On ne veut pas d'objet de type %m1:8)
  178. MOTERR(1:8)=CHAI
  179. CALL ERREUR(39)
  180. WRITE(IOIMP,*) '(l''option TABU requiert ',
  181. & 'éventuellement un objet de type ',
  182. & 'LISTENTI, LISTREEL ou LISTMOTS)'
  183. ENDIF
  184.  
  185. ENDIF
  186.  
  187. C =================
  188. C OPTION PAR DÉFAUT
  189. C =================
  190. ELSE
  191. ITAB=0
  192.  
  193. C Le MOT qu'on a lu n'était pas censé être lu maintenant...
  194. CALL REFUS
  195. ENDIF
  196.  
  197.  
  198.  
  199.  
  200.  
  201.  
  202. C **************************************************************
  203. C LECTURE DU TYPE D'OBJET VIDE À CRÉER
  204. C **************************************************************
  205. C
  206. C On cherche des triplets de la forme ITYP[/MARG][*NLIR]
  207. C (l'ordre des options * et / est indifférent)
  208. C
  209. C - ITYP correspond au type d'objet à créer (position dans MTYP)
  210. C - MARG contient parfois le sous-type (par défaut = ' ')
  211. C - NLIR indique le nombre d'objets à créer (par défaut = 1)
  212. C
  213.  
  214. NLIR=0
  215. ICOD=1
  216. C (ICOD permet d'obliger l'utilisateur à entrer au moins un MOT)
  217.  
  218.  
  219. 1 IF (NLIR.EQ.0) THEN
  220.  
  221. C Lecture du type d'objet à créer. Si aucun => fin subroutine
  222. CALL LIRCHA(CHAI,ICOD,LCHAI)
  223. IF (LCHAI.EQ.0) GOTO 999
  224.  
  225. C On vérifie que ce type d'objet est prévu dans MTYP
  226. CALL OPTLI(ITYP,MTYP,CHAI,LMTYP)
  227. IF (ITYP.EQ.0) THEN
  228. C ERREUR CRITIQUE 9 (Objet inconnu %m1:8)
  229. MOTERR(1:8)=CHAI
  230. CALL ERREUR(9)
  231. WRITE(IOIMP,*) '(on ne sait pas créer ce type',
  232. & ' d''objet vide)'
  233. RETURN
  234. ENDIF
  235.  
  236. C On a trouvé un MOT correct.
  237. NLIR=1
  238.  
  239. C On cherche les éventuels caractères * ou /
  240. IARG=0
  241. MARG=' '
  242. ISPA=0
  243. DO 2 J=1,2
  244. CALL LIRMOT(MSPE,2,ISPE,0)
  245. IF (ISPE.EQ.0) GOTO 2
  246. C (Rmq: LIRMOT appelle REFUS si aucun mot ne correspond)
  247.  
  248. IF (ISPA.EQ.ISPE) THEN
  249. C ERREUR CRITIQUE 880 (Syntaxe incorrecte, voir notice)
  250. CALL ERREUR(880)
  251. CHAI=MSPE(ISPE)
  252. WRITE(IOIMP,*) '(le caractère spécial ',CHAI(1:1),
  253. & ' apparait 2 fois)'
  254. RETURN
  255. ENDIF
  256.  
  257. C Caractère * trouvé => mise à jour de NLIR
  258. IF (ISPE.EQ.1) THEN
  259. CALL LIRENT(NLIR,1,IRET)
  260. C Caractère / trouvé => mise à jour de MARG
  261. ELSE IF (ISPE.EQ.2) THEN
  262. IARG=1
  263. CALL LIRCHA(MARG,1,LMARG)
  264. ENDIF
  265.  
  266. ISPA=ISPE
  267. 2 CONTINUE
  268. ENDIF
  269.  
  270.  
  271. C **************************************************************
  272. C INITIALISATION D'UN SEGMENT VIDE POUR LE TYPE D'OBJET DÉSIRÉ
  273. C **************************************************************
  274.  
  275. GOTO (10,20,30,40,50,60,70,80,90,100,110,120,130,140,150,160,170),
  276. & ITYP
  277.  
  278.  
  279. C ===============================
  280. C Objet MAILLAGE
  281. C ===============================
  282. C => MARG correspond au type d'élément (variable ITYPEL)
  283.  
  284. 10 ITEL=ILCOUR
  285. IF (IARG.EQ.1) THEN
  286. CALL CHRMOT(NOMS,100,MARG(1:4),ITEL)
  287. IF (ITEL.EQ.0) THEN
  288. C ERREUR CRITIQUE 16 (Type d'élément incorrect)
  289. CALL ERREUR(16)
  290. WRITE(IOIMP,*) '(le nom ',MARG(1:4),
  291. & ' ne correspond à aucun élément connu)'
  292. RETURN
  293. ENDIF
  294. ENDIF
  295.  
  296. NBELEM=0
  297. NBSOUS=0
  298. NBREF=0
  299. NBNN=NBNNE(ITEL)
  300. IF (NOMS(ITEL).EQ.'POLY') THEN
  301. NBNN = 14
  302. ELSE IF (NOMS(ITEL).EQ.'MULT') THEN
  303. NBNN = 9999
  304. ENDIF
  305.  
  306. SEGINI MELEME
  307. ITYPEL=ITEL
  308.  
  309. IOBJ=MELEME
  310. GOTO 900
  311.  
  312.  
  313. C ===============================
  314. C Objet CHPOINT
  315. C ===============================
  316. C => MARG donne la nature du champ par points (variable JATTRI(1))
  317.  
  318. 20 NAT=1
  319. NSOUPO=0
  320.  
  321. IJAT1 = 0
  322. IF (IARG.EQ.1) THEN
  323. CALL CHRMOT(MNAT,2,MARG(1:4),IJAT1)
  324. IF (IJAT1.EQ.0) THEN
  325. C ERREUR CRITIQUE 881 (Syntaxe incorrecte : on attend %m1:30)
  326. MOTERR(1:30)='soit DISCRET, soit DIFFUS '
  327. CALL ERREUR(881)
  328. WRITE(IOIMP,*) '(le mot ',MARG(1:LMARG),' ne désigne pas',
  329. & ' une nature valide)'
  330. RETURN
  331. ENDIF
  332. ENDIF
  333.  
  334. C Creation du CHPOINT + Definition du Type, Titre et Attribut du CHPOINT
  335. SEGINI,MCHPOI
  336. IFOPOI=IFOUR
  337. MTYPOI = ' '
  338. MOCHDE = 'CHPOINT CREE PAR VIDE'
  339. JATTRI(1)= IJAT1
  340.  
  341. IOBJ = MCHPOI
  342. GOTO 900
  343.  
  344.  
  345. C ===============================
  346. C Objet MCHAML
  347. C ===============================
  348. C => MARG n'est pas utilisé
  349.  
  350. 30 N1=0
  351. N3=0
  352. L1=8
  353.  
  354. SEGINI MCHELM
  355. IFOCHE=IFOMOD
  356. TITCHE=' '
  357.  
  358. IOBJ=MCHELM
  359. GOTO 900
  360.  
  361.  
  362. C ===============================
  363. C Objet MMODEL
  364. C ===============================
  365. C => MARG n'est pas utilisé
  366.  
  367. 40 N1=0
  368.  
  369. SEGINI MMODEL
  370.  
  371. IOBJ=MMODEL
  372. GOTO 900
  373.  
  374.  
  375. C ===============================
  376. C Objet RIGIDITE
  377. C ===============================
  378. C => MARG indique le type de matrice (variable MTYMAT)
  379.  
  380. 50 NRIGEL=0
  381.  
  382. SEGINI MRIGID
  383. MTYMAT=MARG(1:8)
  384. IFORIG=IFOUR
  385.  
  386. IOBJ=MRIGID
  387. GOTO 900
  388.  
  389.  
  390. C ===============================
  391. C Objet EVOLUTIO
  392. C ===============================
  393. C => MARG indique le type d evolution (REEL ou COMPLEXE)
  394.  
  395. 60 N=0
  396.  
  397. SEGINI MEVOLL
  398. ITYEVO=MARG(1:8)
  399. IEVTEX=' '
  400. C write(ioimp,*) 'ITYEVO=', ITYEVO
  401.  
  402. IOBJ=MEVOLL
  403. GOTO 900
  404.  
  405.  
  406. C ===============================
  407. C Objet LISTENTI
  408. C ===============================
  409. C => MARG n'est pas utilisé
  410.  
  411. 70 JG=0
  412.  
  413. SEGINI MLENTI
  414.  
  415. IOBJ=MLENTI
  416. GOTO 900
  417.  
  418.  
  419. C ===============================
  420. C Objet LISTREEL
  421. C ===============================
  422. C => MARG n'est pas utilisé
  423.  
  424. 80 JG=0
  425.  
  426. SEGINI MLREEL
  427.  
  428. IOBJ=MLREEL
  429. GOTO 900
  430.  
  431.  
  432. C ===============================
  433. C Objet LISTMOTS
  434. C ===============================
  435. C => MARG n'est pas utilisé
  436.  
  437. 90 JGN=4
  438. JGM=0
  439.  
  440. SEGINI MLMOTS
  441.  
  442. IOBJ=MLMOTS
  443. GOTO 900
  444.  
  445.  
  446. C ===============================
  447. C Objet LISTCHPO
  448. C ===============================
  449. C => MARG n'est pas utilisé
  450.  
  451. 100 N1=0
  452.  
  453. SEGINI MLCHPO
  454.  
  455. IOBJ=MLCHPO
  456. GOTO 900
  457.  
  458.  
  459. C ===============================
  460. C Objet TABLE
  461. C ===============================
  462. C => MARG donne le sous-type de la table (indice 'SOUSTYPE')
  463.  
  464. 110 M=0
  465.  
  466. SEGINI MTABLE
  467. IF (IARG.EQ.1) THEN
  468. CALL ECCTAB(MTABLE,'MOT',0,0.D0,'SOUSTYPE',.TRUE.,0,
  469. & 'MOT',0,0.D0,MARG(1:8) ,.TRUE.,0)
  470. ENDIF
  471.  
  472. IOBJ=MTABLE
  473. GOTO 900
  474.  
  475.  
  476. C ===============================
  477. C Objet DEFORME
  478. C ===============================
  479. C => MARG n'est pas utilisé
  480.  
  481. 120 NDEF=0
  482.  
  483. SEGINI MDEFOR
  484.  
  485. IOBJ=MDEFOR
  486. GOTO 900
  487.  
  488.  
  489. C ===============================
  490. C Objet VECTEUR
  491. C ===============================
  492. C => MARG n'est pas utilisé
  493.  
  494. 130 NVEC=0
  495. ID=0
  496.  
  497. SEGINI MVECTE
  498.  
  499. IOBJ=MVECTE
  500. GOTO 900
  501.  
  502.  
  503. C ===============================
  504. C Objet CHARGEME
  505. C ===============================
  506. C => MARG n'est pas utilisé
  507.  
  508. 140 N=0
  509.  
  510. SEGINI MCHARG
  511.  
  512. IOBJ=MCHARG
  513. GOTO 900
  514.  
  515.  
  516. C ===============================
  517. C Objet NUAGE
  518. C ===============================
  519. C => MARG n'est pas utilisé
  520.  
  521. 150 NVAR =0
  522. NBCOUP=0
  523.  
  524. SEGINI MNUAGE
  525.  
  526. IOBJ=MNUAGE
  527. GOTO 900
  528.  
  529.  
  530. C ===============================
  531. C Objet ANNOTATI
  532. C ===============================
  533. C => MARG n'est pas utilisé
  534.  
  535. 160 NBANNO=0
  536.  
  537. SEGINI,MANNOT
  538.  
  539. IOBJ=MANNOT
  540. GOTO 900
  541.  
  542.  
  543. C ===============================
  544. C Objet LISTOBJE
  545. C ===============================
  546. C => MARG n'est pas utilisé
  547.  
  548. 170 NOBJ = 0
  549.  
  550. SEGINI,MLOBJE
  551. TYPOBJ = ' '
  552.  
  553. IOBJ=MLOBJE
  554. GOTO 900
  555.  
  556.  
  557.  
  558.  
  559. C **************************************************************
  560. C FIN DE LA CRÉATION D'UN OBJET
  561. C **************************************************************
  562.  
  563. 900 CONTINUE
  564.  
  565. C S'il y avait plusieurs objets de même type à créer, en voilà un de moins
  566. NLIR=NLIR-1
  567.  
  568. C On mémorise son pointeur et son type dans le segment IPSORT
  569. NOBJ=NOBJ+1
  570. SEGADJ IPSORT
  571. IPOOBJ(NOBJ)=IOBJ
  572. MTYPOB(NOBJ)=MTYP(ITYP)
  573.  
  574. C On remonte là-haut pour voir s'il y a d'autres objets à créer
  575. C (cette fois, ce ne sera plus obligatoire)
  576. ICOD=0
  577. GOTO 1
  578.  
  579.  
  580.  
  581.  
  582.  
  583. C **************************************************************
  584. C FIN DE LA SUBROUTINE
  585. C **************************************************************
  586. C
  587. C On écrit sur la sortie les objets stockés dans IPSORT :
  588. C - Option 'TABU' => les objets sont placés dans une table
  589. C - Par défaut => on sort les objets séparément
  590. C
  591.  
  592. 999 CONTINUE
  593.  
  594. C =============================================
  595. C SORTIE SOUS FORME DE PLUSIEURS OBJETS SÉPARÉS
  596. C =============================================
  597. IF (ITAB.EQ.0) THEN
  598. * Il faut inverser l'ordre pour ECROBJ
  599. DO IA=1,NOBJ
  600. IB=NOBJ-IA+1
  601. IPOO=IPOOBJ(IB)
  602. TYOB=MTYPOB(IB)
  603. CALL ACTOBJ(TYOB,IPOO,1)
  604. CALL ECROBJ(TYOB,IPOO)
  605. ENDDO
  606.  
  607.  
  608. C =====================================
  609. C SORTIE SOUS FORME D'UNE TABLE INDICÉE
  610. C =====================================
  611. C Si l'objet LISTENTI/LISTREEL/LISTMOTS définissant les indices à
  612. C utiliser est trop court, les indices manquants seront des entiers
  613. C correspondant à l'ordre de création de l'objet
  614. ELSE
  615. M=NOBJ
  616. SEGINI MTAB1
  617.  
  618. CHAI=' '
  619. IVAL=0
  620. XVAL=0.D0
  621.  
  622. LONGLI=NOBJ
  623. IF (ITAB.EQ.2) LONGLI=MLENT1.LECT(/1)
  624. IF (ITAB.EQ.3) LONGLI=MLREE1.PROG(/1)
  625. IF (ITAB.EQ.4) LONGLI=MLMOT1.MOTS(/2)
  626.  
  627. DO IA=1,NOBJ
  628. IF (IA.GT.LONGLI) THEN
  629. C L'objet LIST**** est trop petit, on change de mode
  630. C d'indexation
  631. ITAB=1
  632. TYIN='ENTIER '
  633. ENDIF
  634.  
  635. IF (ITAB.EQ.1) IVAL=IA
  636. IF (ITAB.EQ.2) IVAL=MLENT1.LECT(IA)
  637. IF (ITAB.EQ.3) XVAL=MLREE1.PROG(IA)
  638. IF (ITAB.EQ.4) CHAI(1:4)=MLMOT1.MOTS(IA)
  639.  
  640. IPOO=IPOOBJ(IA)
  641. TYOB=MTYPOB(IA)
  642. CALL ECCTAB(MTAB1,TYIN,IVAL,XVAL,CHAI,.TRUE.,0,
  643. & TYOB,0 ,0.D0,' ' ,.TRUE.,IPOO)
  644. ENDDO
  645.  
  646. SEGDES MTAB1
  647. CALL ECROBJ('TABLE',MTAB1)
  648. ENDIF
  649.  
  650. SEGSUP IPSORT
  651. GOTO 1099
  652.  
  653. C----------------------------------------------------------------------C
  654. C TEST SI OBJET VIDE C
  655. C----------------------------------------------------------------------C
  656. 1000 CONTINUE
  657.  
  658. GOTO (1010,1020,1030,1040,1050,1060,1070,1080,1090,
  659. . 1100,1110,1120,1130,1140,1150,1160,1170),ITYP
  660.  
  661. C---- MAILLAGE VIDE ?
  662. 1010 CONTINUE
  663.  
  664. CALL LIROBJ('MAILLAGE',IPOBJ1,1,IRETOU)
  665. IF (IERR.NE.0) RETURN
  666. CALL ACTOBJ('MAILLAGE',IPOBJ1,1)
  667. IF (IERR.NE.0) RETURN
  668.  
  669. MELEME = IPOBJ1
  670. LOG1 = NUM(/2).EQ.0.AND.LISOUS(/1).EQ.0
  671. CALL ECRLOG(LOG1)
  672.  
  673. GOTO 1099
  674.  
  675. C---- CHPOINT VIDE ?
  676. 1020 CONTINUE
  677.  
  678. CALL LIROBJ('CHPOINT ',IPOBJ1,1,IRETOU)
  679. IF (IERR.NE.0) RETURN
  680. CALL ACTOBJ('CHPOINT ',IPOBJ1,1)
  681. IF (IERR.NE.0) RETURN
  682.  
  683. MCHPOI = IPOBJ1
  684. LOG1 = IPCHP(/1).EQ.0
  685. CALL ECRLOG(LOG1)
  686.  
  687. GOTO 1099
  688.  
  689. C---- MCHAML VIDE ?
  690. 1030 CONTINUE
  691.  
  692. CALL LIROBJ('MCHAML ',IPOBJ1,1,IRETOU)
  693. IF (IERR.NE.0) RETURN
  694. CALL ACTOBJ('MCHAML ',IPOBJ1,1)
  695. IF (IERR.NE.0) RETURN
  696.  
  697. MCHELM = IPOBJ1
  698. LOG1 = IMACHE(/1).EQ.0
  699. CALL ECRLOG(LOG1)
  700.  
  701. GOTO 1099
  702.  
  703. C---- MMODEL VIDE ?
  704. 1040 CONTINUE
  705.  
  706. CALL LIROBJ('MMODEL ',IPOBJ1,1,IRETOU)
  707. IF (IERR.NE.0) RETURN
  708. CALL ACTOBJ('MMODEL ',IPOBJ1,1)
  709. IF (IERR.NE.0) RETURN
  710.  
  711. MMODEL = IPOBJ1
  712. LOG1 = KMODEL(/1).EQ.0
  713. CALL ECRLOG(LOG1)
  714.  
  715. GOTO 1099
  716.  
  717. C---- RIGIDITE VIDE ?
  718. 1050 CONTINUE
  719.  
  720. CALL LIROBJ('RIGIDITE',IPOBJ1,1,IRETOU)
  721. IF (IERR.NE.0) RETURN
  722.  
  723. MRIGID = IPOBJ1
  724. SEGACT, MRIGID
  725. LOG1 = IRIGEL(/2).EQ.0
  726. CALL ECRLOG(LOG1)
  727.  
  728. GOTO 1099
  729.  
  730. C---- EVOLUTIO VIDE ?
  731. 1060 CONTINUE
  732.  
  733. CALL LIROBJ('EVOLUTIO',IPOBJ1,1,IRETOU)
  734. IF (IERR.NE.0) RETURN
  735. CALL ACTOBJ('EVOLUTIO',IPOBJ1,1)
  736. IF (IERR.NE.0) RETURN
  737.  
  738. MEVOLL = IPOBJ1
  739. LOG1 = IEVOLL(/1).EQ.0
  740. CALL ECRLOG(LOG1)
  741.  
  742. GOTO 1099
  743.  
  744. C---- LISTENTI VIDE ?
  745. 1070 CONTINUE
  746.  
  747. CALL LIROBJ('LISTENTI',IPOBJ1,1,IRETOU)
  748. IF (IERR.NE.0) RETURN
  749. CALL ACTOBJ('LISTENTI',IPOBJ1,1)
  750. IF (IERR.NE.0) RETURN
  751.  
  752. MLENTI = IPOBJ1
  753. LOG1 = LECT(/1).EQ.0
  754. CALL ECRLOG(LOG1)
  755.  
  756. GOTO 1099
  757.  
  758. C---- LISTREEL VIDE ?
  759. 1080 CONTINUE
  760.  
  761. CALL LIROBJ('LISTREEL',IPOBJ1,1,IRETOU)
  762. IF (IERR.NE.0) RETURN
  763. CALL ACTOBJ('LISTREEL',IPOBJ1,1)
  764. IF (IERR.NE.0) RETURN
  765.  
  766. MLREEL = IPOBJ1
  767. LOG1 = PROG(/1).EQ.0
  768. CALL ECRLOG(LOG1)
  769.  
  770. GOTO 1099
  771.  
  772. C---- LISTMOTS VIDE ?
  773. 1090 CONTINUE
  774.  
  775. CALL LIROBJ('LISTMOTS',IPOBJ1,1,IRETOU)
  776. IF (IERR.NE.0) RETURN
  777. CALL ACTOBJ('LISTMOTS',IPOBJ1,1)
  778. IF (IERR.NE.0) RETURN
  779.  
  780. MLMOTS = IPOBJ1
  781. LOG1 = MOTS(/2).EQ.0
  782. CALL ECRLOG(LOG1)
  783.  
  784. GOTO 1099
  785.  
  786. C---- LISTCHPO VIDE ?
  787. 1100 CONTINUE
  788.  
  789. CALL LIROBJ('LISTCHPO',IPOBJ1,1,IRETOU)
  790. IF (IERR.NE.0) RETURN
  791. CALL ACTOBJ('LISTCHPO',IPOBJ1,1)
  792. IF (IERR.NE.0) RETURN
  793.  
  794. MLCHPO = IPOBJ1
  795. LOG1 = ICHPOI(/1).EQ.0
  796. CALL ECRLOG(LOG1)
  797.  
  798. GOTO 1099
  799.  
  800. C---- TABLE VIDE ?
  801. 1110 CONTINUE
  802.  
  803. CALL LIROBJ('TABLE ',IPOBJ1,1,IRETOU)
  804. IF (IERR.NE.0) RETURN
  805.  
  806. MTABLE = IPOBJ1
  807. SEGACT, MTABLE
  808. LOG1 = MLOTAB.EQ.0
  809. CALL ECRLOG(LOG1)
  810.  
  811. GOTO 1099
  812.  
  813. C---- DEFORME VIDE ?
  814. 1120 CONTINUE
  815.  
  816. CALL LIROBJ('DEFORME ',IPOBJ1,1,IRETOU)
  817. IF (IERR.NE.0) RETURN
  818.  
  819. MDEFOR = IPOBJ1
  820. SEGACT, MDEFOR
  821. LOG1 = AMPL(/1).EQ.0
  822. CALL ECRLOG(LOG1)
  823.  
  824. GOTO 1099
  825.  
  826. C---- VECTEUR VIDE ?
  827. 1130 CONTINUE
  828.  
  829. CALL LIROBJ('VECTEUR ',IPOBJ1,1,IRETOU)
  830. IF (IERR.NE.0) RETURN
  831.  
  832. MVECTE = IPOBJ1
  833. SEGACT, MVECTE
  834. LOG1 = IGEOV(/1).EQ.0
  835. CALL ECRLOG(LOG1)
  836.  
  837. GOTO 1099
  838.  
  839. C---- CHARGEME VIDE ?
  840. 1140 CONTINUE
  841.  
  842. CALL LIROBJ('CHARGEME',IPOBJ1,1,IRETOU)
  843. IF (IERR.NE.0) RETURN
  844. CALL ACTOBJ('CHARGEME',IPOBJ1,1)
  845. IF (IERR.NE.0) RETURN
  846.  
  847. MCHARG = IPOBJ1
  848. LOG1 = KCHARG(/1).EQ.0
  849. CALL ECRLOG(LOG1)
  850.  
  851. GOTO 1099
  852.  
  853. C---- NUAGE VIDE ?
  854. 1150 CONTINUE
  855.  
  856. CALL LIROBJ('NUAGE ',IPOBJ1,1,IRETOU)
  857. IF (IERR.NE.0) RETURN
  858. CALL ACTOBJ('NUAGE ',IPOBJ1,1)
  859. IF (IERR.NE.0) RETURN
  860.  
  861. MNUAGE = IPOBJ1
  862. LOG1 = NUAPOI(/1).EQ.0
  863. CALL ECRLOG(LOG1)
  864.  
  865. GOTO 1099
  866.  
  867. C---- ANNOTATI VIDE ?
  868. 1160 CONTINUE
  869.  
  870. CALL LIROBJ('ANNOTATI',IPOBJ1,1,IRETOU)
  871. IF (IERR.NE.0) RETURN
  872.  
  873. MANNOT = IPOBJ1
  874. SEGACT,MANNOT
  875. LOG1 = ICLAS(/1).EQ.0
  876. CALL ECRLOG(LOG1)
  877.  
  878. GOTO 1099
  879.  
  880. C---- LISTOBJE VIDE ?
  881. 1170 CONTINUE
  882.  
  883. CALL LIROBJ('LISTOBJE',IPOBJ1,1,IRETOU)
  884. IF (IERR.NE.0) RETURN
  885.  
  886. MLOBJE = IPOBJ1
  887. SEGACT,MLOBJE
  888. LOG1 = LISOBJ(/1).EQ.0
  889. CALL ECRLOG(LOG1)
  890.  
  891.  
  892. 1099 CONTINUE
  893. RETURN
  894. END
  895.  
  896.  
  897.  
  898.  

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