C PRLIST SOURCE SP204843 25/03/17 21:15:05 12205 C DONNE LA LISTE DES OBJETS EN MEMOIRE C SUIVI D'UN OBJET DONNE DES INFORMATIONS SUR LUI C 09/2003 : Affichage point si IDIM = 1 (GOTO 70) C 10/2003 : Affichage modele pour IDIM = 1 (GOTO SUBROUTINE PRLIST IMPLICIT INTEGER(I-N) IMPLICIT REAL*8(A-H,O-Z) -INC CCNOYAU -INC PPARAM -INC CCOPTIO -INC CCGEOME -INC SMLENTI -INC SMLREEL -INC SMCOORD -INC SMTEXTE -INC SMDEFOR -INC SMVECTE -INC CCASSIS PARAMETER (NMO=37) LOGICAL IR CHARACTER*(LOCHAI) IMO CHARACTER*(8) ICHA CHARACTER*(8) LISMO(NMO) CHARACTER*24 TITI DATA LISMO / 'MOT ','ENTIER ','FLOTTANT','LOGIQUE ', $ 'MAILLAGE','LISTENTI','POINT ','LISTREEL', $ 'CHPOINT ','RIGIDITE','TEXTE ','STRUCTUR', $ 'ATTACHE ','SOLUTION','BASEMODA','LISTOBJE', $ 'CONFIGUR','VECTDOUB','LISTMOTS','DEFORME ', $ 'LISTCHPO','CHARGEME','EVOLUTIO','--------', $ 'VECTEUR ','TABLE ','PROCEDUR','ELEMSTRU', $ 'BLOQSTRU','MCHAML ','MMODEL ','ANNULE ', $ 'NUAGE ','MATRIK ','OBJET ','ESCLAVE ', $ 'ANNOTATI'/ INTEXT=1 JENTET=0 1100 CONTINUE c * modif LODESL pour les objets ESCLAVE c * LODESL = .TRUE. c CALL LIROBJ('PROCEDUR',IRET,0,IRETOU) c * LODESL = .FALSE. c IF (IRETOU.NE.0) THEN c CALL ECPROC c RETURN c ENDIF * modif LODESL pour les objets ESCLAVE * LODESL = .TRUE. CALL QUETYP(ICHA,0,IRETOU) * LODESL = .FALSE. INTEXT=0 IF (IERR.NE.0) RETURN * LISTE DE TOUS LES OBJETS NOMMES... * ================================== IF (IRETOU.NE.1) THEN ICHA=' ' CALL REPER(ICHA) RETURN ENDIF * ...OU BIEN AIGUILLAGE VERS LE TYPE D'OBJET DETECTE PAR QUETYP * ============================================================= DO 1000 IPPL=1,NMO IF(LISMO(IPPL).EQ.ICHA) GOTO 1001 1000 CONTINUE MOTERR(1:8) = ICHA CALL ERREUR(387) RETURN 1001 CONTINUE C MOT, ENTIER, FLOTTANT et LOGIQUE sont traites a part, comme d'habitude IF (IPPL.GT.4) GOTO 1005 GOTO (10,20,30,40),IPPL C LISTE D'UN MOT C ============== 10 CONTINUE CALL LIRCHA(IMO,1,IRETOU) * *********************************** * CAS PARTICULIER 1 : ON VEUT LISTER TOUS LES OBJETS D'UN TYPE DONNE IF(IMO(1:1).EQ.'*') THEN CALL LIRCHA(ICHA,1,IRETOU) IF (IERR.NE.0) RETURN CALL REPER(ICHA) RETURN ENDIF * CAS PARTICULIER 2 : ON INDIQUE QU'ON VEUT UN LISTING RESUME IF (IMO(1:4).EQ.'RESU') THEN JENTET = 1 GOTO 1100 ENDIF * *********************************** INTERR(1)=IRETOU MOTERR=IMO CALL ERREUR(-2) GOTO 50000 C LISTE D'UN ENTIER C ================= 20 CONTINUE CALL LIRENT(IRET,1,IRETOU) INTERR(1)=IRET CALL ERREUR(-3) GOTO 50000 C LISTE D'UN FLOTTANT C =================== 30 CONTINUE CALL LIRREE(REEL,1,IRETOU) REAERR(1)=REEL CALL ERREUR(-4) GOTO 50000 C LISTE D'UN LOGIQUE C ================== 40 CONTINUE CALL LIRLOG(IR,1,IRETOU) IF(IR) THEN MOTERR(1:4)='VRAI' CALL ERREUR(-5) ELSE MOTERR(1:4)='FAUX' CALL ERREUR(-5) ENDIF GOTO 50000 C on traite enfin tous les autres types d'objet 1005 CONTINUE IPP=IPPL-4 CALL LIROBJ(ICHA,IRET,1,IRETOU) CALL ACTOBJ(ICHA,IRET,2) IF (IERR.NE.0) GOTO 50000 GOTO ( 50, 60, 70, 80, 90,100,110,120,130,140,150,160,170,180, . 190,200,210,220,230,240,250,260,270,280,290,300,310,320, . 330,340,350,360,370),IPP C LISTE D'UN MAILLAGE C =================== 50 CONTINUE CALL ECMAIL(IRET,JENTET) GOTO 50000 C LISTE D'UN LISTENTI C =================== 60 CONTINUE MLENTI=IRET SEGACT MLENTI N1=LECT(/1) INTERR(1)=N1 INTERR(2)=MLENTI CALL ERREUR(-6) if(jentet.eq.1) n1 = min ( n1, 10) c IF(N1.NE.0) WRITE(IOIMP,62)(LECT(J),J=1,N1) c 62 FORMAT((20I6)) cbp : on lit eventuellement nombre de colonne avant retour a la ligne : NMAX=20 CALL LIRENT(IMAX,0,IRETOU) if(IRETOU.NE.0) NMAX=MIN(IMAX,999) WRITE(TITI,FMT='("(",I3,"(I8))")') NMAX IF(N1.NE.0) WRITE(IOIMP,TITI)(LECT(J),J=1,N1) SEGDES MLENTI GOTO 50000 C LISTE D'UN POINT C ================ 70 CONTINUE SEGACT MCOORD IB=IRET ID=(IDIM+1)*(IB-1) INTERR(1)=IB REAERR(1)=XCOOR(ID+1) REAERR(2)=XCOOR(ID+2) IF (IDIM.EQ.1) THEN CALL ERREUR(-339) ELSE REAERR(3)=XCOOR(ID+3) IF (IDIM.EQ.2) CALL ERREUR(-7) IF (IDIM.EQ.3) THEN REAERR(4)=XCOOR(ID+4) CALL ERREUR(-8) ENDIF ENDIF RETURN C LISTE D'UN LISTREEL C =================== 80 CONTINUE CALL ECLRE1(IRET,JENTET) GO TO 50000 C LISTE D'UN CHPOINT C ================== 90 CONTINUE CALL ECCHPO(IRET,jentet) GO TO 50000 C LISTE D'UNE RIGIDITE C ==================== 100 CONTINUE CALL PRRIGI(IRET,jentet) GO TO 50000 C LISTE D'UN OBJET TEXTE C ====================== 110 CONTINUE MTEXTE=IRET SEGACT MTEXTE INTERR(1)=NCART CALL ERREUR (-10) IF(NCART.NE.0) WRITE(IOIMP,111) MTEXT 111 FORMAT(5X,A72) SEGDES MTEXTE INTEXT=1 GO TO 50000 C LISTE D'UN OBJET STRUCTURE C ========================== 120 CONTINUE CALL ECSTRU(IRET) GO TO 50000 C LISTE D'UN OBJET ATTACHE C ======================== 130 CONTINUE CALL ECMATT(IRET,jentet) GO TO 50000 C LISTE D'UN OBJET SOLUTION C ========================= 140 CONTINUE CALL ECSOLU(IRET,jentet) GO TO 50000 C LISTE D'UN OBJET BASEMODA C ========================= 150 CONTINUE CALL ECBASE(IRET) GO TO 50000 C LISTE D'UN OBJET LISTOBJE C ========================= 160 CONTINUE CALL ECLOBJ(IRET,JENTET) GOTO 50000 C LISTE D'UN OBJET CONFIGUR C ========================= 170 CONTINUE MCOORD=IRET SEGACT,MCOORD NNOEUD=XCOOR(/1)/(IDIM+1) IROTA=MROTA SEGDES,MCOORD INTERR(1)=IRET INTERR(2)=NNOEUD INTERR(3)=IROTA CALL ERREUR(-390) GOTO 50000 C LISTE D'UN VECTDOUB C =================== 180 CONTINUE CALL PRVECT(IRET,jentet) GO TO 50000 C LISTE D'UN LISTMOTS C =================== 190 CONTINUE CALL ECLMOT(IRET) GOTO 50000 C LISTE D'UNE DEFORMEE C ==================== 200 CONTINUE MDEFOR=IRET SEGACT MDEFOR NDEF=AMPL(/1) INTERR(1)=NDEF CALL ERREUR(-11) WRITE (IOIMP,201) (AMPL(I),IELDEF(I),ICHDEF(I),MTVECT(I), * NCOUL(JCOUL(I)),MDCHP(I),MDCHEL(I),MDMODE(I),I=1,NDEF) 201 FORMAT(1X,G12.5,4X,I8,I8,I8,2X,A6,3X,I8,4X,I8,I8) SEGDES MDEFOR GOTO 50000 C LISTE D'UNE LISTCHPO C ==================== 210 CONTINUE CALL ECLCHP(IRET,jentet) GOTO 50000 C LISTE D'UN CHARGEMENT C ===================== 220 CONTINUE CALL ECCHAR(IRET,jentet) GOTO 50000 C LISTE D'UNE EVOLUTION C ===================== 230 CONTINUE CALL ECEVOL(IRET,jentet) GOTO 50000 C ... INUTILISE C ============= 240 CONTINUE GOTO 50000 C LISTE D'UN VECTEUR C ================== 250 CONTINUE MVECTE=IRET SEGACT MVECTE NVEC=AMPF(/1) ID=NOCOVE(/3) INTERR(1)=NVEC CALL ERREUR(-12) DO i=1,NVEC WRITE(IOIMP,251) AMPF(i),ICHPO(i), & NCOUL(MAX(0,MIN(NBCOUL-1,NOCOUL(i)))), & (NOCOVE(i,j),j=1,ID) ENDDO 251 FORMAT(2X,G12.5,3X,I8,3X,A4,6X,A4,4X,A4,4X,A4) SEGDES MVECTE GOTO 50000 C LISTE D'UNE TABLE C ================= 260 CONTINUE CALL ECTABL(IRET) GOTO 50000 C LISTE D'UNE PROCEDURE C ===================== 270 CONTINUE CALL ECPROC RETURN C LISTE D'UN OBJET ELEMSTRU C ========================= 280 CONTINUE CALL PRELST(IRET) GOTO 50000 C LISTE D'UN OBJET BLOQSTRU C ========================= 290 CONTINUE CALL PRCLST(IRET) GOTO 50000 C LISTE D'UN MCHAML C ================= 300 CONTINUE CALL ZPCHEL(IRET,jentet) GOTO 50000 C LISTE D'UN MMODEL C ================= 310 CONTINUE CALL ZPMODE(IRET) GOTO 50000 C CAS D'UN OBJET DE TYPE ANNULE C ============================= 320 CONTINUE CALL ERREUR(-256) GOTO 50000 C LISTE D'UN NUAGE C ================ 330 CONTINUE CALL ECNUAG(IRET) GOTO 50000 C LISTE D'UN MATRIK C ================= 340 CONTINUE CALL ECMATK(IRET) GOTO 50000 C LISTE D'UN OBJET (DE TYPE = OBJET) C ================================== 350 CALL ECTABL(-IRET) GOTO 50000 C LISTE D'UN OBJET ESCLAVE C ======================== 360 CONTINUE * modif LODESL pour les objets ESCLAVE * LODESL = .TRUE. CALL LIROBJ(ICHA,IRET,1,IRETOU) * LODESL = .FALSE. MESRES = IRET SEGACT MESRES IF ( LOREMP ) WRITE(ioimp,*) 'objet ESCLAVE, ????' WRITE(ioimp,*) ' objet ESCLAVE ' SEGDES MESRES GOTO 50000 C LISTE D'UN OBJET ANNOTATION C =========================== 370 CALL ECANNO(IRET) GOTO 50000 50000 CONTINUE RETURN END