Télécharger prlist.eso

Retour à la liste

Numérotation des lignes :

  1. C PRLIST SOURCE JC220346 19/12/31 21:15:07 10442
  2.  
  3. C DONNE LA LISTE DES OBJETS EN MEMOIRE
  4. C SUIVI D'UN OBJET DONNE DES INFORMATIONS SUR LUI
  5. C 09/2003 : Affichage point si IDIM = 1 (GOTO 70)
  6. C 10/2003 : Affichage modele pour IDIM = 1 (GOTO
  7.  
  8. SUBROUTINE PRLIST
  9.  
  10. IMPLICIT INTEGER(I-N)
  11. IMPLICIT REAL*8(A-H,O-Z)
  12.  
  13. -INC CCNOYAU
  14.  
  15. -INC PPARAM
  16. -INC CCOPTIO
  17. -INC CCGEOME
  18. -INC SMLENTI
  19. -INC SMLREEL
  20. -INC SMCOORD
  21. -INC SMTEXTE
  22. -INC SMDEFOR
  23. -INC SMVECTE
  24. -INC CCASSIS
  25.  
  26. PARAMETER (NMO=37)
  27. LOGICAL IR
  28. CHARACTER*512 IMO
  29. CHARACTER*(8) ICHA
  30. CHARACTER*(8) LISMO(NMO)
  31. CHARACTER*24 TITI
  32.  
  33. DATA LISMO / 'MOT ','ENTIER ','FLOTTANT','LOGIQUE ',
  34. $ 'MAILLAGE','LISTENTI','POINT ','LISTREEL',
  35. $ 'CHPOINT ','RIGIDITE','TEXTE ','STRUCTUR',
  36. $ 'ATTACHE ','SOLUTION','BASEMODA','--------',
  37. $ '--------','VECTDOUB','LISTMOTS','DEFORME ',
  38. $ 'LISTCHPO','CHARGEME','EVOLUTIO','--------',
  39. $ 'VECTEUR ','TABLE ','PROCEDUR','ELEMSTRU',
  40. $ 'BLOQSTRU','MCHAML ','MMODEL ','ANNULE ',
  41. $ 'NUAGE ','MATRIK ','OBJET ','ESCLAVE ',
  42. $ 'ANNOTATI'/
  43.  
  44. JENTET=0
  45.  
  46.  
  47. 1100 CONTINUE
  48.  
  49.  
  50. c * modif LODESL pour les objets ESCLAVE
  51. c * LODESL = .TRUE.
  52. c CALL LIROBJ('PROCEDUR',IRET,0,IRETOU)
  53. c * LODESL = .FALSE.
  54. c IF (IRETOU.NE.0) THEN
  55. c CALL ECPROC
  56. c RETURN
  57. c ENDIF
  58.  
  59. * modif LODESL pour les objets ESCLAVE
  60. * LODESL = .TRUE.
  61. CALL QUETYP(ICHA,0,IRETOU)
  62. * LODESL = .FALSE.
  63. IF (IERR.NE.0) RETURN
  64.  
  65. * LISTE DE TOUS LES OBJETS NOMMES...
  66. * ==================================
  67. IF (IRETOU.NE.1) THEN
  68. ICHA=' '
  69. CALL REPER(ICHA)
  70. RETURN
  71. ENDIF
  72.  
  73. * ...OU BIEN AIGUILLAGE VERS LE TYPE D'OBJET DETECTE PAR QUETYP
  74. * =============================================================
  75. DO 1000 IPPL=1,NMO
  76. IF(LISMO(IPPL).EQ.ICHA) GOTO 1001
  77. 1000 CONTINUE
  78. MOTERR(1:8) = ICHA
  79. CALL ERREUR(387)
  80. RETURN
  81. 1001 CONTINUE
  82.  
  83. C MOT, ENTIER, FLOTTANT et LOGIQUE sont traites a part, comme d'habitude
  84. IF (IPPL.GT.4) GOTO 1005
  85. GOTO (10,20,30,40),IPPL
  86.  
  87. C LISTE D'UN MOT
  88. C ==============
  89. 10 CONTINUE
  90. CALL LIRCHA(IMO,1,IRETOU)
  91.  
  92. * ***********************************
  93. * CAS PARTICULIER 1 : ON VEUT LISTER TOUS LES OBJETS D'UN TYPE DONNE
  94. IF(IMO(1:1).EQ.'*') THEN
  95. CALL LIRCHA(ICHA,1,IRETOU)
  96. IF (IERR.NE.0) RETURN
  97. CALL REPER(ICHA)
  98. RETURN
  99. ENDIF
  100. * CAS PARTICULIER 2 : ON INDIQUE QU'ON VEUT UN LISTING RESUME
  101. IF (IMO(1:4).EQ.'RESU') THEN
  102. JENTET = 1
  103. GOTO 1100
  104. ENDIF
  105. * ***********************************
  106.  
  107. INTERR(1)=IRETOU
  108. MOTERR=IMO
  109. CALL ERREUR(-2)
  110. GOTO 50000
  111.  
  112. C LISTE D'UN ENTIER
  113. C =================
  114. 20 CONTINUE
  115. CALL LIRENT(IRET,1,IRETOU)
  116. INTERR(1)=IRET
  117. CALL ERREUR(-3)
  118. GOTO 50000
  119.  
  120. C LISTE D'UN FLOTTANT
  121. C ===================
  122. 30 CONTINUE
  123. CALL LIRREE(REEL,1,IRETOU)
  124. REAERR(1)=REEL
  125. CALL ERREUR(-4)
  126. GOTO 50000
  127.  
  128. C LISTE D'UN LOGIQUE
  129. C ==================
  130. 40 CONTINUE
  131. CALL LIRLOG(IR,1,IRETOU)
  132. IF(IR) THEN
  133. MOTERR(1:4)='VRAI'
  134. CALL ERREUR(-5)
  135. ELSE
  136. MOTERR(1:4)='FAUX'
  137. CALL ERREUR(-5)
  138. ENDIF
  139. GOTO 50000
  140.  
  141. C on traite enfin tous les autres types d'objet
  142. 1005 CONTINUE
  143. IPP=IPPL-4
  144. CALL LIROBJ(ICHA,IRET,1,IRETOU)
  145. IF (IERR.NE.0) GOTO 50000
  146. GOTO ( 50, 60, 70, 80, 90,100,110,120,130,140,150,160,170,180,
  147. . 190,200,210,220,230,240,250,260,270,280,290,300,310,320,
  148. . 330,340,350,360,370),IPP
  149.  
  150. C LISTE D'UN MAILLAGE
  151. C ===================
  152. 50 CONTINUE
  153. CALL ECMAIL(IRET,JENTET)
  154. GOTO 50000
  155.  
  156. C LISTE D'UN LISTENTI
  157. C ===================
  158. 60 CONTINUE
  159. MLENTI=IRET
  160. SEGACT MLENTI
  161. N1=LECT(/1)
  162. INTERR(1)=N1
  163. INTERR(2)=MLENTI
  164. CALL ERREUR(-6)
  165. if(jentet.eq.1) n1 = min ( n1, 10)
  166. c IF(N1.NE.0) WRITE(IOIMP,62)(LECT(J),J=1,N1)
  167. c 62 FORMAT((20I6))
  168. cbp : on lit eventuellement nombre de colonne avant retour a la ligne :
  169. NMAX=20
  170. CALL LIRENT(IMAX,0,IRETOU)
  171. if(IRETOU.NE.0) NMAX=IMAX
  172. WRITE(TITI,FMT='("(",I3,"(I6))")') NMAX
  173. IF(N1.NE.0) WRITE(IOIMP,TITI)(LECT(J),J=1,N1)
  174. SEGDES MLENTI
  175. GOTO 50000
  176.  
  177. C LISTE D'UN POINT
  178. C ================
  179. 70 CONTINUE
  180. SEGACT MCOORD
  181. IB=IRET
  182. ID=(IDIM+1)*(IB-1)
  183. INTERR(1)=IB
  184. REAERR(1)=XCOOR(ID+1)
  185. REAERR(2)=XCOOR(ID+2)
  186. IF (IDIM.EQ.1) THEN
  187. CALL ERREUR(-339)
  188. ELSE
  189. REAERR(3)=XCOOR(ID+3)
  190. IF (IDIM.EQ.2) CALL ERREUR(-7)
  191. IF (IDIM.EQ.3) THEN
  192. REAERR(4)=XCOOR(ID+4)
  193. CALL ERREUR(-8)
  194. ENDIF
  195. ENDIF
  196. RETURN
  197.  
  198. C LISTE D'UN LISTREEL
  199. C ===================
  200. 80 CONTINUE
  201. MLREEL=IRET
  202. SEGACT MLREEL
  203. N1=PROG(/1)
  204. INTERR(1)=N1
  205. INTERR(2)=MLREEL
  206. CALL ERREUR(-9)
  207. if(jentet.eq.1) n1 = min ( n1, 10)
  208. c IF(N1.NE.0) WRITE(IOIMP,82)(PROG(J),J=1,N1)
  209. c 82 FORMAT(10(1X,1PG12.5))
  210. cbp : on lit eventuellement nombre de colonne avant retour a la ligne :
  211. NMAX=10
  212. CALL LIRENT(IMAX,0,IRETOU)
  213. if(IRETOU.NE.0) NMAX=IMAX
  214. WRITE(TITI,FMT='("(",I3,"(1X,1PG12.5))")') NMAX
  215. IF(N1.NE.0) WRITE(IOIMP,TITI)(PROG(J),J=1,N1)
  216. SEGDES MLREEL
  217. GO TO 50000
  218.  
  219. C LISTE D'UN CHPOINT
  220. C ==================
  221. 90 CONTINUE
  222. CALL ECCHPO(IRET,jentet)
  223. GO TO 50000
  224.  
  225. C LISTE D'UNE RIGIDITE
  226. C ====================
  227. 100 CONTINUE
  228. CALL PRRIGI(IRET,jentet)
  229. GO TO 50000
  230.  
  231. C LISTE D'UN OBJET TEXTE
  232. C ======================
  233. 110 CONTINUE
  234. MTEXTE=IRET
  235. SEGACT MTEXTE
  236. INTERR(1)=NCART
  237. CALL ERREUR (-10)
  238. IF(NCART.NE.0) WRITE(IOIMP,111) MTEXT
  239. 111 FORMAT(5X,A72)
  240. SEGDES MTEXTE
  241. GO TO 50000
  242.  
  243. C LISTE D'UN OBJET STRUCTURE
  244. C ==========================
  245. 120 CONTINUE
  246. CALL ECSTRU(IRET)
  247. GO TO 50000
  248.  
  249. C LISTE D'UN OBJET ATTACHE
  250. C ========================
  251. 130 CONTINUE
  252. CALL ECMATT(IRET,jentet)
  253. GO TO 50000
  254.  
  255. C LISTE D'UN OBJET SOLUTION
  256. C =========================
  257. 140 CONTINUE
  258. CALL ECSOLU(IRET,jentet)
  259. GO TO 50000
  260.  
  261. C LISTE D'UN OBJET BASEMODA
  262. C =========================
  263. 150 CONTINUE
  264. CALL ECBASE(IRET)
  265. GO TO 50000
  266.  
  267. C ... INUTILISE
  268. C =============
  269. 160 CONTINUE
  270. GOTO 50000
  271.  
  272. C ... INUTILISE
  273. C =============
  274. 170 CONTINUE
  275. GOTO 50000
  276.  
  277. C LISTE D'UN VECTDOUB
  278. C ===================
  279. 180 CONTINUE
  280. CALL PRVECT(IRET,jentet)
  281. GO TO 50000
  282.  
  283. C LISTE D'UN LISTMOTS
  284. C ===================
  285. 190 CONTINUE
  286. CALL ECLMOT(IRET)
  287. GOTO 50000
  288.  
  289. C LISTE D'UNE DEFORMEE
  290. C ====================
  291. 200 CONTINUE
  292. MDEFOR=IRET
  293. SEGACT MDEFOR
  294. NDEF=AMPL(/1)
  295. INTERR(1)=NDEF
  296. CALL ERREUR(-11)
  297. WRITE (IOIMP,201) (AMPL(I),IELDEF(I),ICHDEF(I),MTVECT(I),
  298. * NCOUL(JCOUL(I)),MDCHP(I),MDCHEL(I),MDMODE(I),I=1,NDEF)
  299. 201 FORMAT(1X,G12.5,4X,I8,I8,I8,2X,A6,3X,I8,4X,I8,I8)
  300. SEGDES MDEFOR
  301. GOTO 50000
  302.  
  303. C LISTE D'UNE LISTCHPO
  304. C ====================
  305. 210 CONTINUE
  306. CALL ECLCHP(IRET,jentet)
  307. GOTO 50000
  308.  
  309. C LISTE D'UN CHARGEMENT
  310. C =====================
  311. 220 CONTINUE
  312. CALL ECCHAR(IRET,jentet)
  313. GOTO 50000
  314.  
  315. C LISTE D'UNE EVOLUTION
  316. C =====================
  317. 230 CONTINUE
  318. CALL ECEVOL(IRET,jentet)
  319. GOTO 50000
  320.  
  321. C ... INUTILISE
  322. C =============
  323. 240 CONTINUE
  324. GOTO 50000
  325.  
  326. C LISTE D'UN VECTEUR
  327. C ==================
  328. 250 CONTINUE
  329. MVECTE=IRET
  330. SEGACT MVECTE
  331. NVEC=AMPF(/1)
  332. ID=NOCOVE(/3)
  333. INTERR(1)=NVEC
  334. CALL ERREUR(-12)
  335. DO i=1,NVEC
  336. WRITE(IOIMP,251) AMPF(i),ICHPO(i),
  337. & NCOUL(MAX(0,MIN(NBCOUL-1,NOCOUL(i)))),
  338. & (NOCOVE(i,j),j=1,ID)
  339. ENDDO
  340. 251 FORMAT(2X,G12.5,3X,I8,3X,A4,6X,A4,4X,A4,4X,A4)
  341. SEGDES MVECTE
  342. GOTO 50000
  343.  
  344. C LISTE D'UNE TABLE
  345. C =================
  346. 260 CONTINUE
  347. CALL ECTABL(IRET)
  348. GOTO 50000
  349.  
  350. C LISTE D'UNE PROCEDURE
  351. C =====================
  352. 270 CONTINUE
  353. CALL ECPROC
  354. RETURN
  355.  
  356. C LISTE D'UN OBJET ELEMSTRU
  357. C =========================
  358. 280 CONTINUE
  359. CALL PRELST(IRET)
  360. GOTO 50000
  361.  
  362. C LISTE D'UN OBJET BLOQSTRU
  363. C =========================
  364. 290 CONTINUE
  365. CALL PRCLST(IRET)
  366. GOTO 50000
  367.  
  368. C LISTE D'UN MCHAML
  369. C =================
  370. 300 CONTINUE
  371. CALL ZPCHEL(IRET,jentet)
  372. GOTO 50000
  373.  
  374. C LISTE D'UN MMODEL
  375. C =================
  376. 310 CONTINUE
  377. CALL ZPMODE(IRET)
  378. GOTO 50000
  379.  
  380. C CAS D'UN OBJET DE TYPE ANNULE
  381. C =============================
  382. 320 CONTINUE
  383. CALL ERREUR(-256)
  384. GOTO 50000
  385.  
  386. C LISTE D'UN NUAGE
  387. C ================
  388. 330 CONTINUE
  389. CALL ECNUAG(IRET)
  390. GOTO 50000
  391.  
  392. C LISTE D'UN MATRIK
  393. C =================
  394. 340 CONTINUE
  395. CALL ECMATK(IRET)
  396. GOTO 50000
  397.  
  398. C LISTE D'UN OBJET (DE TYPE = OBJET)
  399. C ==================================
  400. 350 CALL ECTABL(-IRET)
  401. GOTO 50000
  402.  
  403. C LISTE D'UN OBJET ESCLAVE
  404. C ========================
  405. 360 CONTINUE
  406. * modif LODESL pour les objets ESCLAVE
  407. * LODESL = .TRUE.
  408. CALL LIROBJ(ICHA,IRET,1,IRETOU)
  409. * LODESL = .FALSE.
  410. MESRES = IRET
  411. SEGACT MESRES
  412. IF ( LOREMP ) WRITE(ioimp,*) 'objet ESCLAVE, ????'
  413. WRITE(ioimp,*) ' objet ESCLAVE '
  414. SEGDES MESRES
  415. GOTO 50000
  416.  
  417. C LISTE D'UN OBJET ANNOTATION
  418. C ===========================
  419. 370 CALL ECANNO(IRET)
  420. GOTO 50000
  421.  
  422. 50000 CONTINUE
  423.  
  424. RETURN
  425. END
  426.  
  427.  
  428.  
  429.  
  430.  
  431.  
  432.  
  433.  

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