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    SP204843  25/03/17    21:15:05     12205          
  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 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=MIN(IMAX,999)
  175.       WRITE(TITI,FMT='("(",I3,"(I8))")') 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  LISTE D'UN OBJET CONFIGUR
  263. C  =========================
  264.  170  CONTINUE
  265.       MCOORD=IRET
  266.       SEGACT,MCOORD
  267.       NNOEUD=XCOOR(/1)/(IDIM+1)
  268.       IROTA=MROTA
  269.       SEGDES,MCOORD
  270.       INTERR(1)=IRET
  271.       INTERR(2)=NNOEUD
  272.       INTERR(3)=IROTA
  273.       CALL ERREUR(-390)
  274.       GOTO 50000
  275.  
  276. C  LISTE D'UN VECTDOUB
  277. C  ===================
  278.  180  CONTINUE
  279.       CALL PRVECT(IRET,jentet)
  280.       GO TO 50000
  281.  
  282. C  LISTE D'UN LISTMOTS
  283. C  ===================
  284.  190  CONTINUE
  285.       CALL ECLMOT(IRET)
  286.       GOTO 50000
  287.  
  288. C  LISTE D'UNE DEFORMEE
  289. C  ====================
  290.  200  CONTINUE
  291.       MDEFOR=IRET
  292.       SEGACT MDEFOR
  293.       NDEF=AMPL(/1)
  294.       INTERR(1)=NDEF
  295.       CALL ERREUR(-11)
  296.       WRITE (IOIMP,201) (AMPL(I),IELDEF(I),ICHDEF(I),MTVECT(I),
  297.      * NCOUL(JCOUL(I)),MDCHP(I),MDCHEL(I),MDMODE(I),I=1,NDEF)
  298.  201  FORMAT(1X,G12.5,4X,I8,I8,I8,2X,A6,3X,I8,4X,I8,I8)
  299.       SEGDES MDEFOR
  300.       GOTO 50000
  301.  
  302. C  LISTE D'UNE LISTCHPO
  303. C  ====================
  304.  210  CONTINUE
  305.       CALL ECLCHP(IRET,jentet)
  306.       GOTO 50000
  307.  
  308. C  LISTE D'UN CHARGEMENT
  309. C  =====================
  310.  220  CONTINUE
  311.       CALL ECCHAR(IRET,jentet)
  312.       GOTO 50000
  313.  
  314. C  LISTE D'UNE EVOLUTION
  315. C  =====================
  316.  230  CONTINUE
  317.       CALL ECEVOL(IRET,jentet)
  318.       GOTO 50000
  319.  
  320. C  ... INUTILISE
  321. C  =============
  322.  240  CONTINUE
  323.       GOTO 50000
  324.  
  325. C  LISTE D'UN VECTEUR
  326. C  ==================
  327.  250  CONTINUE
  328.       MVECTE=IRET
  329.       SEGACT MVECTE
  330.       NVEC=AMPF(/1)
  331.       ID=NOCOVE(/3)
  332.       INTERR(1)=NVEC
  333.       CALL ERREUR(-12)
  334.       DO i=1,NVEC
  335.         WRITE(IOIMP,251) AMPF(i),ICHPO(i),
  336.      &                   NCOUL(MAX(0,MIN(NBCOUL-1,NOCOUL(i)))),
  337.      &                   (NOCOVE(i,j),j=1,ID)
  338.       ENDDO
  339.  251  FORMAT(2X,G12.5,3X,I8,3X,A4,6X,A4,4X,A4,4X,A4)
  340.       SEGDES MVECTE
  341.       GOTO 50000
  342.  
  343. C  LISTE D'UNE TABLE
  344. C  =================
  345.  260  CONTINUE
  346.       CALL ECTABL(IRET)
  347.       GOTO 50000
  348.  
  349. C  LISTE D'UNE PROCEDURE
  350. C  =====================
  351.  270  CONTINUE
  352.       CALL ECPROC
  353.       RETURN
  354.  
  355. C  LISTE D'UN OBJET ELEMSTRU
  356. C  =========================
  357.  280  CONTINUE
  358.       CALL PRELST(IRET)
  359.       GOTO 50000
  360.  
  361. C  LISTE D'UN OBJET BLOQSTRU
  362. C  =========================
  363.  290  CONTINUE
  364.       CALL PRCLST(IRET)
  365.       GOTO 50000
  366.  
  367. C  LISTE D'UN MCHAML
  368. C  =================
  369.  300  CONTINUE
  370.       CALL ZPCHEL(IRET,jentet)
  371.       GOTO 50000
  372.  
  373. C  LISTE D'UN MMODEL
  374. C  =================
  375.  310  CONTINUE
  376.       CALL ZPMODE(IRET)
  377.       GOTO 50000
  378.  
  379. C  CAS D'UN OBJET DE TYPE ANNULE
  380. C  =============================
  381.  320  CONTINUE
  382.       CALL ERREUR(-256)
  383.       GOTO 50000
  384.  
  385. C  LISTE D'UN NUAGE
  386. C  ================
  387.  330  CONTINUE
  388.       CALL ECNUAG(IRET)
  389.       GOTO 50000
  390.  
  391. C  LISTE D'UN MATRIK
  392. C  =================
  393.  340  CONTINUE
  394.       CALL ECMATK(IRET)
  395.       GOTO 50000
  396.  
  397. C  LISTE D'UN OBJET (DE TYPE = OBJET)
  398. C  ==================================
  399.  350  CALL ECTABL(-IRET)
  400.       GOTO 50000
  401.  
  402. C  LISTE D'UN OBJET ESCLAVE
  403. C  ========================
  404.  360  CONTINUE     
  405. *     modif LODESL pour les objets ESCLAVE
  406. *     LODESL = .TRUE.
  407.       CALL LIROBJ(ICHA,IRET,1,IRETOU)
  408. *     LODESL = .FALSE.
  409.       MESRES = IRET
  410.       SEGACT MESRES
  411.       IF ( LOREMP )  WRITE(ioimp,*) 'objet ESCLAVE, ????'
  412.       WRITE(ioimp,*) ' objet ESCLAVE '
  413.       SEGDES MESRES
  414.       GOTO 50000
  415.  
  416. C  LISTE D'UN OBJET ANNOTATION
  417. C  ===========================
  418.  370  CALL ECANNO(IRET)
  419.       GOTO 50000
  420.  
  421. 50000 CONTINUE
  422.  
  423.       RETURN
  424.       END
  425.  
  426.  
  427.  

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