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

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