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    GOUNAND   26/07/06    21:15:09     12593          
  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.      $             'CONFIGUR','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,2)
  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 ACTOBJ('MAILLAGE',IRET, 2)
  157.       CALL ECMAIL(IRET,JENTET)
  158.       GOTO 50000
  159.  
  160. C  LISTE D'UN LISTENTI
  161. C  ===================
  162.  60   CONTINUE
  163.       MLENTI=IRET
  164.       SEGACT MLENTI
  165.       N1=LECT(/1)
  166.       INTERR(1)=N1
  167.       INTERR(2)=MLENTI
  168.       CALL ERREUR(-6)
  169.       if(jentet.eq.1) n1 = min ( n1, 10)
  170. c       IF(N1.NE.0) WRITE(IOIMP,62)(LECT(J),J=1,N1)
  171. c  62   FORMAT((20I6))
  172. cbp : on lit eventuellement nombre de colonne avant retour a la ligne :
  173.       NMAX=20
  174.       CALL LIRENT(IMAX,0,IRETOU)
  175.       if(IRETOU.NE.0) NMAX=MIN(IMAX,999)
  176.       WRITE(TITI,FMT='("(",I3,"(I8))")') NMAX
  177.       IF(N1.NE.0) WRITE(IOIMP,TITI)(LECT(J),J=1,N1)
  178.       SEGDES MLENTI
  179.       GOTO 50000
  180.  
  181. C  LISTE D'UN POINT
  182. C  ================
  183.  70   CONTINUE
  184.       SEGACT MCOORD
  185.       IB=IRET
  186.       ID=(IDIM+1)*(IB-1)
  187.       INTERR(1)=IB
  188.       REAERR(1)=XCOOR(ID+1)
  189.       REAERR(2)=XCOOR(ID+2)
  190.       IF (IDIM.EQ.1) THEN
  191.         CALL ERREUR(-339)
  192.       ELSE
  193.         REAERR(3)=XCOOR(ID+3)
  194.         IF (IDIM.EQ.2) CALL ERREUR(-7)
  195.         IF (IDIM.EQ.3) THEN
  196.           REAERR(4)=XCOOR(ID+4)
  197.           CALL ERREUR(-8)
  198.         ENDIF
  199.       ENDIF
  200.       RETURN
  201.  
  202. C  LISTE D'UN LISTREEL
  203. C  ===================
  204.  80   CONTINUE
  205.       CALL ECLRE1(IRET,JENTET)
  206.       GO TO 50000
  207.  
  208. C  LISTE D'UN CHPOINT
  209. C  ==================
  210.  90   CONTINUE
  211.       CALL ECCHPO(IRET,jentet)
  212.       GO TO 50000
  213.  
  214. C  LISTE D'UNE RIGIDITE
  215. C  ====================
  216.  100  CONTINUE
  217.       CALL PRRIGI(IRET,jentet)
  218.       GO TO 50000
  219.  
  220. C  LISTE D'UN OBJET TEXTE
  221. C  ======================
  222.  110  CONTINUE
  223.       MTEXTE=IRET
  224.       SEGACT MTEXTE
  225.       INTERR(1)=NCART
  226.       CALL ERREUR (-10)
  227.       IF(NCART.NE.0) WRITE(IOIMP,111) MTEXT
  228.   111 FORMAT(5X,A72)
  229.       SEGDES MTEXTE
  231.       GO TO 50000
  232.  
  233. C  LISTE D'UN OBJET STRUCTURE
  234. C  ==========================
  235.  120  CONTINUE
  236.       CALL ECSTRU(IRET)
  237.       GO TO 50000
  238.  
  239. C  LISTE D'UN OBJET ATTACHE
  240. C  ========================
  241.  130  CONTINUE
  242.       CALL ECMATT(IRET,jentet)
  243.       GO TO 50000
  244.  
  245. C  LISTE D'UN OBJET SOLUTION
  246. C  =========================
  247.  140  CONTINUE
  248.       CALL ECSOLU(IRET,jentet)
  249.       GO TO 50000
  250.  
  251. C  LISTE D'UN OBJET BASEMODA
  252. C  =========================
  253.  150  CONTINUE
  254.       CALL ECBASE(IRET)
  255.       GO TO 50000
  256.  
  257. C  LISTE D'UN OBJET LISTOBJE
  258. C  =========================
  259.  160  CONTINUE
  260.       CALL ECLOBJ(IRET,JENTET)
  261.       GOTO 50000
  262.  
  263. C  LISTE D'UN OBJET CONFIGUR
  264. C  =========================
  265.  170  CONTINUE
  266.       MCOORD=IRET
  267.       SEGACT,MCOORD
  268.       NNOEUD=XCOOR(/1)/(IDIM+1)
  269.       IROTA=MROTA
  270.       SEGDES,MCOORD
  271.       INTERR(1)=IRET
  272.       INTERR(2)=NNOEUD
  273.       INTERR(3)=IROTA
  274.       CALL ERREUR(-390)
  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 ACTOBJ('MCHAML  ',IRET, 2)
  372.       CALL ZPCHEL(IRET,jentet)
  373.       GOTO 50000
  374.  
  375. C  LISTE D'UN MMODEL
  376. C  =================
  377.  310  CONTINUE
  378.       CALL ZPMODE(IRET)
  379.       GOTO 50000
  380.  
  381. C  CAS D'UN OBJET DE TYPE ANNULE
  382. C  =============================
  383.  320  CONTINUE
  384.       CALL ERREUR(-256)
  385.       GOTO 50000
  386.  
  387. C  LISTE D'UN NUAGE
  388. C  ================
  389.  330  CONTINUE
  390.       CALL ECNUAG(IRET)
  391.       GOTO 50000
  392.  
  393. C  LISTE D'UN MATRIK
  394. C  =================
  395.  340  CONTINUE
  396.       CALL ECMATK(IRET)
  397.       GOTO 50000
  398.  
  399. C  LISTE D'UN OBJET (DE TYPE = OBJET)
  400. C  ==================================
  401.  350  CALL ECTABL(-IRET)
  402.       GOTO 50000
  403.  
  404. C  LISTE D'UN OBJET ESCLAVE
  405. C  ========================
  406.  360  CONTINUE
  407. *     modif LODESL pour les objets ESCLAVE
  408. *     LODESL = .TRUE.
  409.       CALL LIROBJ(ICHA,IRET,1,IRETOU)
  410. *     LODESL = .FALSE.
  411.       MESRES = IRET
  412.       SEGACT MESRES
  413.       IF ( LOREMP )  WRITE(ioimp,*) 'objet ESCLAVE, ????'
  414.       WRITE(ioimp,*) ' objet ESCLAVE '
  415.       SEGDES MESRES
  416.       GOTO 50000
  417.  
  418. C  LISTE D'UN OBJET ANNOTATION
  419. C  ===========================
  420.  370  CALL ECANNO(IRET)
  421.       GOTO 50000
  422.  
  423. 50000 CONTINUE
  424.  
  425.       RETURN
  426.       END
  427.  
  428.  

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