Télécharger prlist.eso

Retour à la liste

Numérotation des lignes :

  1. C PRLIST SOURCE BP208322 16/11/18 21:20:12 9177
  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=36)
  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.  
  41. JENTET=0
  42.  
  43. C - Pour les objets ESCLAVE
  44. * LODESL = .TRUE.
  45. CALL LIROBJ('PROCEDUR',IRET,0,IRETOU)
  46. * LODESL = .FALSE.
  47. IF (IRETOU.NE.0) THEN
  48. CALL ECPROC
  49. RETURN
  50. ENDIF
  51. 1100 CONTINUE
  52. C - Pour les objets ESCLAVE
  53. * LODESL = .TRUE.
  54. CALL QUETYP(ICHA ,0,IRETOU)
  55. * LODESL = .FALSE.
  56. IF (IRETOU.EQ.1) GOTO 1002
  57. IF (IERR.NE.0) RETURN
  58. C REPERTOIRE COMPLET DETOUS LES OBJETS
  59. ICHA=' '
  60. CALL REPER(ICHA)
  61. RETURN
  62. 1002 CONTINUE
  63. DO 1000 IPPL = 1,NMO
  64. IF(LISMO(IPPL).EQ.ICHA) GOTO 1001
  65. 1000 CONTINUE
  66. MOTERR(1:8)=ICHA
  67. CALL ERREUR (387)
  68. RETURN
  69.  
  70. 1001 CONTINUE
  71. IF (IPPL.GT.4) GOTO 1005
  72. GOTO (10,20,30,40),IPPL
  73.  
  74. 10 CONTINUE
  75. CALL LIRCHA(IMO,1,IRETOU)
  76. IF( IMO(1:1).EQ.'*') THEN
  77. CALL LIRCHA(ICHA,1,IRETOU)
  78. IF(IERR.NE.0) RETURN
  79. CALL REPER(ICHA)
  80. RETURN
  81. ENDIF
  82. IF(IMO(1:4).eq.'RESU') then
  83. JENTET=1
  84. GO TO 1100
  85. ENDIF
  86.  
  87. C LISTE D'UN MOT
  88. INTERR(1)=IRETOU
  89. MOTERR=IMO
  90. CALL ERREUR(-2)
  91. GOTO 50000
  92.  
  93. C LISTE D'UN ENTIER
  94. 20 CONTINUE
  95. CALL LIRENT(IRET,1,IRETOU)
  96. INTERR(1)=IRET
  97. CALL ERREUR(-3)
  98. GOTO 50000
  99.  
  100. C LISTE D'UN REEL (FLOTTANT)
  101. 30 CONTINUE
  102. CALL LIRREE(REEL,1,IRETOU)
  103. REAERR(1)=REEL
  104. CALL ERREUR(-4)
  105. GOTO 50000
  106.  
  107. C LISTE D'UN LOGIQUE
  108. 40 CONTINUE
  109. CALL LIRLOG(IR,1,IRETOU)
  110. IF(IR) THEN
  111. MOTERR(1:4)='VRAI'
  112. CALL ERREUR(-5)
  113. ELSE
  114. MOTERR(1:4)='FAUX'
  115. CALL ERREUR(-5)
  116. ENDIF
  117. GOTO 50000
  118.  
  119. C - pour les objets ESCLAVE
  120. 1005 CONTINUE
  121. IF ( IPPL .NE. 36 ) GO TO 1006
  122. * LODESL = .TRUE.
  123. CALL LIROBJ(ICHA,IRET,1,IRETOU)
  124. * LODESL = .FALSE.
  125. MESRES = IRET
  126. SEGACT MESRES
  127. IF ( LOREMP ) WRITE(ioimp,*) 'objet ESCLAVE, ????'
  128. WRITE(ioimp,*) ' objet ESCLAVE '
  129. SEGDES MESRES
  130. GOTO 50000
  131.  
  132. 1006 CONTINUE
  133. IPP=IPPL-4
  134. CALL LIROBJ(ICHA,IRET,1,IRETOU)
  135. IF (IERR.NE.0) GOTO 50000
  136. GOTO ( 50, 60, 70, 80, 90,100,110,120,130,140,150,160,170,180,
  137. . 190,200,210,220,230,240,250,260,270,280,290,300,310,320,
  138. . 330,340,350),IPP
  139.  
  140. 50 CONTINUE
  141. CALL ECMAIL(IRET,JENTET)
  142. GOTO 50000
  143.  
  144. C LISTE D'UN LISTENTI
  145. 60 CONTINUE
  146. MLENTI=IRET
  147. SEGACT MLENTI
  148. N1=LECT(/1)
  149. INTERR(1)=N1
  150. INTERR(2)=MLENTI
  151. CALL ERREUR(-6)
  152. if(jentet.eq.1) n1 = min ( n1, 10)
  153. c IF(N1.NE.0) WRITE(IOIMP,62)(LECT(J),J=1,N1)
  154. c 62 FORMAT((20I6))
  155. cbp : on lit eventuellement nombre de colonne avant retour a la ligne :
  156. NMAX=20
  157. CALL LIRENT(IMAX,0,IRETOU)
  158. if(IRETOU.NE.0) NMAX=IMAX
  159. WRITE(TITI,FMT='("(",I3,"(I6))")') NMAX
  160. IF(N1.NE.0) WRITE(IOIMP,TITI)(LECT(J),J=1,N1)
  161. SEGDES MLENTI
  162. GOTO 50000
  163.  
  164. C LISTE D'UN POINT
  165. 70 CONTINUE
  166. SEGACT MCOORD
  167. IB=IRET
  168. ID=(IDIM+1)*(IB-1)
  169. INTERR(1)=IB
  170. REAERR(1)=XCOOR(ID+1)
  171. REAERR(2)=XCOOR(ID+2)
  172. IF (IDIM.EQ.1) THEN
  173. CALL ERREUR(-339)
  174. ELSE
  175. REAERR(3)=XCOOR(ID+3)
  176. IF (IDIM.EQ.2) CALL ERREUR(-7)
  177. IF (IDIM.EQ.3) THEN
  178. REAERR(4)=XCOOR(ID+4)
  179. CALL ERREUR(-8)
  180. ENDIF
  181. ENDIF
  182. RETURN
  183.  
  184. C LISTE D'UN LISTREEL
  185. 80 CONTINUE
  186. MLREEL=IRET
  187. SEGACT MLREEL
  188. N1=PROG(/1)
  189. INTERR(1)=N1
  190. INTERR(2)=MLREEL
  191. CALL ERREUR(-9)
  192. if(jentet.eq.1) n1 = min ( n1, 10)
  193. c IF(N1.NE.0) WRITE(IOIMP,82)(PROG(J),J=1,N1)
  194. c 82 FORMAT(10(1X,1PG12.5))
  195. cbp : on lit eventuellement nombre de colonne avant retour a la ligne :
  196. NMAX=10
  197. CALL LIRENT(IMAX,0,IRETOU)
  198. if(IRETOU.NE.0) NMAX=IMAX
  199. WRITE(TITI,FMT='("(",I3,"(1X,1PG12.5))")') NMAX
  200. IF(N1.NE.0) WRITE(IOIMP,TITI)(PROG(J),J=1,N1)
  201. SEGDES MLREEL
  202. GO TO 50000
  203.  
  204. C LISTE D'UN CHPOINT
  205. 90 CONTINUE
  206. CALL ECCHPO(IRET,jentet)
  207. GO TO 50000
  208.  
  209. C LISTE D'UNE RIGIDITE
  210. 100 CONTINUE
  211. CALL PRRIGI(IRET,jentet)
  212. GO TO 50000
  213.  
  214. C LISTE D'UN OBJET TEXTE
  215. 110 CONTINUE
  216. MTEXTE=IRET
  217. SEGACT MTEXTE
  218. INTERR(1)=NCART
  219. CALL ERREUR (-10)
  220. IF(NCART.NE.0) WRITE(IOIMP,111) MTEXT
  221. 111 FORMAT(5X,A72)
  222. SEGDES MTEXTE
  223. GO TO 50000
  224.  
  225. 120 CONTINUE
  226. CALL ECSTRU(IRET)
  227. GO TO 50000
  228.  
  229. 130 CONTINUE
  230. CALL ECMATT(IRET,jentet)
  231. GO TO 50000
  232.  
  233. 140 CONTINUE
  234. CALL ECSOLU(IRET,jentet)
  235. GO TO 50000
  236.  
  237. 150 CONTINUE
  238. CALL ECBASE(IRET)
  239. GO TO 50000
  240.  
  241. 160 CONTINUE
  242. C... INUTILISE
  243. GOTO 50000
  244. 170 CONTINUE
  245. C... INUTILISE
  246. GOTO 50000
  247.  
  248. C LISTE D'UN VECT DOUB
  249. 180 CONTINUE
  250. CALL PRVECT(IRET,jentet)
  251. GO TO 50000
  252.  
  253. C LISTE D'UN LISTMOTS
  254. 190 CONTINUE
  255. CALL ECLMOT(IRET)
  256. GOTO 50000
  257.  
  258. C LISTE D'UNE DEFORMEE
  259. 200 CONTINUE
  260. MDEFOR=IRET
  261. SEGACT MDEFOR
  262. NDEF=AMPL(/1)
  263. INTERR(1)=NDEF
  264. CALL ERREUR(-11)
  265. WRITE (IOIMP,201) (AMPL(I),IELDEF(I),ICHDEF(I),MTVECT(I),
  266. * NCOUL(JCOUL(I)),MDCHP(I),MDCHEL(I),MDMODE(I),I=1,NDEF)
  267. 201 FORMAT(1X,G12.5,4X,I8,I8,I8,2X,A6,3X,I8,4X,I8,I8)
  268. SEGDES MDEFOR
  269. GOTO 50000
  270.  
  271. C LISTE D'UNE LISTCHPO
  272. 210 CONTINUE
  273. CALL ECLCHP(IRET,jentet)
  274. GOTO 50000
  275.  
  276. C LISTE D'UN CHARGEMENT
  277. 220 CONTINUE
  278. CALL ECCHAR(IRET,jentet)
  279. GOTO 50000
  280.  
  281. C LISTE D'UNE EVOLUTION
  282. 230 CONTINUE
  283. CALL ECEVOL(IRET,jentet)
  284. GOTO 50000
  285.  
  286. 240 CONTINUE
  287. C... INUTILISE
  288. GOTO 50000
  289.  
  290. C LISTE D'UN VECTEUR
  291. 250 CONTINUE
  292. MVECTE=IRET
  293. SEGACT MVECTE
  294. NVEC=AMPF(/1)
  295. ID=NOCOVE(/3)
  296. INTERR(1)=NVEC
  297. CALL ERREUR(-12)
  298. DO i=1,NVEC
  299. WRITE(IOIMP,251) AMPF(i),ICHPO(i),
  300. & NCOUL(MAX(0,MIN(NBCOUL-1,NOCOUL(i)))),
  301. & (NOCOVE(i,j),j=1,ID)
  302. ENDDO
  303. 251 FORMAT(2X,G12.5,3X,I8,3X,A4,6X,A4,4X,A4,4X,A4)
  304. SEGDES MVECTE
  305. GOTO 50000
  306.  
  307. C LISTE D'UNE TABLE
  308. 260 CONTINUE
  309. CALL ECTABL(IRET)
  310. GOTO 50000
  311.  
  312. C LISTE D'UNE PROCEDURE
  313. 270 CONTINUE
  314. CALL ECPROC
  315. * PAS DE CALL REFUS DANS CE CAS
  316. RETURN
  317.  
  318. 280 CONTINUE
  319. CALL PRELST(IRET)
  320. GOTO 50000
  321.  
  322. 290 CONTINUE
  323. CALL PRCLST(IRET)
  324. GOTO 50000
  325.  
  326. C LISTE D'UN MCHAML
  327. 300 CONTINUE
  328. CALL ZPCHEL(IRET,jentet)
  329. GOTO 50000
  330.  
  331. C LISTE D'UN MMODELE
  332. 310 CONTINUE
  333. CALL ZPMODE(IRET)
  334. GOTO 50000
  335.  
  336. 320 CONTINUE
  337. CALL ERREUR(-256)
  338. GOTO 50000
  339.  
  340. C LISTE D'UN NUAGE
  341. 330 CONTINUE
  342. CALL ECNUAG(IRET)
  343. GOTO 50000
  344.  
  345. 340 CONTINUE
  346. CALL ECMATK(IRET)
  347. GOTO 50000
  348.  
  349. 350 CALL ECTABL(-IRET)
  350. C* GOTO 50000
  351.  
  352. *50000 CALL REFUS SUPPRESSION DU REFUS LE 26/7/90 MILL (ACCORD PV)
  353. 50000 CONTINUE
  354.  
  355. RETURN
  356. END
  357.  
  358.  
  359.  
  360.  
  361.  
  362.  

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