Télécharger la plaquette Cast3M


fr en

Télécharger prlist.eso

Retour à la liste

Numérotation des lignes : 

prlist

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

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