Esope source files

   1 : C PRLIST    SOURCE    FANDEUR   10/12/14    21:18:52     6812           
   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 : 
  30 :       DATA LISMO / 'MOT     ','ENTIER  ','FLOTTANT','LOGIQUE ',
  31 :      $             'MAILLAGE','LISTENTI','POINT   ','LISTREEL',
  32 :      $             'CHPOINT ','RIGIDITE','TEXTE   ','STRUCTUR',
  33 :      $             'ATTACHE ','SOLUTION','BASEMODA','--------',
  34 :      $             '--------','VECTDOUB','LISTMOTS','DEFORME ',
  35 :      $             'LISTCHPO','CHARGEME','EVOLUTIO','--------',
  36 :      $             'VECTEUR ','TABLE   ','PROCEDUR','ELEMSTRU',
  37 :      $             'BLOQSTRU','MCHAML  ','MMODEL  ','ANNULE  ',
  38 :      $             'NUAGE   ','MATRIK  ','OBJET   ','ESCLAVE ' /
  39 : 
  40 :       INTEXT=1
  41 :       JENTET=0
  42 : 
  43 : C - Pour les objets ESCLAVE
  44 : *     LODESL = .TRUE.
  44 :       CALL LIROBJ('PROCEDUR',IRET,0,IRETOU)
  45 : *     LODESL = .FALSE.
  46 :       IF (IRETOU.NE.0) THEN
  46 :         CALL ECPROC
  47 :         RETURN
  48 :       ENDIF
  49 :  1100 CONTINUE
  50 : C - Pour les objets ESCLAVE
  51 : *     LODESL = .TRUE.
  51 :       CALL QUETYP(ICHA ,0,IRETOU)
  52 : *     LODESL = .FALSE.
  53 :       INTEXT=0
  54 :       IF (IRETOU.EQ.1) GOTO 1002
  55 :       IF (IERR.NE.0) RETURN
  56 : C  REPERTOIRE  COMPLET DETOUS LES OBJETS
  57 :       ICHA=' '
  57 :       CALL REPER(ICHA)
  58 :       RETURN
  59 :  1002 CONTINUE
  60 :       DO 1000 IPPL = 1,NMO
  61 :       IF(LISMO(IPPL).EQ.ICHA) GOTO 1001
  62 :  1000 CONTINUE
  63 :       MOTERR(1:8)=ICHA
  63 :       CALL ERREUR (387)
  64 :       RETURN
  65 : 
  66 :  1001 CONTINUE
  67 :       IF (IPPL.GT.4) GOTO 1005
  68 :       GOTO (10,20,30,40),IPPL
  69 : 
  70 :  10   CONTINUE
  70 :       CALL LIRCHA(IMO,1,IRETOU)
  71 :       IF( IMO(1:1).EQ.'*') THEN
  71 :          CALL LIRCHA(ICHA,1,IRETOU)
  72 :          IF(IERR.NE.0) RETURN
  72 :          CALL REPER(ICHA)
  73 :          RETURN
  74 :       ENDIF
  75 :       IF(IMO(1:4).eq.'RESU') then
  76 :         JENTET=1
  77 :         GO TO 1100
  78 :       ENDIF
  79 : C  LISTE D'UN MOT
  80 :       INTERR(1)=IRETOU
  81 :       MOTERR=IMO
  81 :       CALL ERREUR(-2)
  82 :       GOTO 50000
  83 : C  LISTE D'UN ENTIER
  84 :  20   CONTINUE
  84 :       CALL LIRENT(IRET,1,IRETOU)
  85 :       INTERR(1)=IRET
  85 :       CALL ERREUR(-3)
  86 :       GOTO 50000
  87 : C  LISTE D'UN ENTIER
  88 :  30   CONTINUE
  88 :       CALL LIRREE(REEL,1,IRETOU)
  89 :       REAERR(1)=REEL
  89 :       CALL ERREUR(-4)
  90 :       GOTO 50000
  91 : C  LISTE D'UN LOGIQUE
  92 :  40   CONTINUE
  92 :       CALL LIRLOG(IR,1,IRETOU)
  93 :       IF(IR) THEN
  94 :        MOTERR(1:4)='VRAI'
  94 :        CALL ERREUR(-5)
  95 :       ELSE
  96 :        MOTERR(1:4)='FAUX'
  96 :        CALL ERREUR(-5)
  97 :       ENDIF
  98 :       GOTO 50000
  99 : 
 100 : C -   pour les objets ESCLAVE
 101 :  1005 CONTINUE
 102 :       IF ( IPPL .NE. 36 ) GO TO 1006
 103 : *     LODESL = .TRUE.
 103 :       CALL LIROBJ(ICHA,IRET,1,IRETOU)
 104 : *     LODESL = .FALSE.
 105 :       MESRES = IRET
 106 :       SEGACT MESRES
 107 :       IF ( LOREMP )  WRITE(ioimp,*) 'objet ESCLAVE, ????'
 108 :       WRITE(ioimp,*) ' objet ESCLAVE '
 109 :       SEGDES MESRES
 110 :       GOTO 50000
 111 : 
 112 :  1006 CONTINUE
 113 :       IPP=IPPL-4
 113 :       CALL LIROBJ(ICHA,IRET,1,IRETOU)
 114 :       IF (IERR.NE.0) GOTO 50000
 115 :       GOTO ( 50, 60, 70, 80, 90,100,110,120,130,140,150,160,170,180,
 116 :      .      190,200,210,220,230,240,250,260,270,280,290,300,310,320,
 117 :      .      330,340,350),IPP
 118 : 
 119 :  50   CONTINUE
 119 :       CALL ECMAIL(IRET,JENTET)
 120 :       GOTO 50000
 121 :  60   CONTINUE
 122 :       MLENTI=IRET
 123 :       SEGACT MLENTI
 124 :       N1=LECT(/1)
 125 : C  LISTE D'UN LISTENTI
 126 :       INTERR(1)=N1
 127 :       INTERR(2)=MLENTI
 127 :       CALL ERREUR(-6)
 128 :       if(jentet.eq.1) n1 = min ( n1, 10)
 129 :       IF(N1.NE.0) WRITE(IOIMP,62)(LECT(J),J=1,N1)
 130 :  62   FORMAT((20I6))
 131 :       SEGDES MLENTI
 132 :       GOTO 50000
 133 : C  LISTE D'UN POINT
 134 :  70   CONTINUE
 135 :       SEGACT MCOORD
 136 :       IB=IRET
 137 :       ID=(IDIM+1)*(IB-1)
 138 :       INTERR(1)=IB
 139 :       REAERR(1)=XCOOR(ID+1)
 140 :       REAERR(2)=XCOOR(ID+2)
 141 :       IF (IDIM.EQ.1) THEN
 141 :         CALL ERREUR(-339)
 142 :       ELSE
 143 :         REAERR(3)=XCOOR(ID+3)
 143 :         IF (IDIM.EQ.2) CALL ERREUR(-7)
 144 :         IF (IDIM.EQ.3) THEN
 145 :           REAERR(4)=XCOOR(ID+4)
 145 :           CALL ERREUR(-8)
 146 :         ENDIF
 147 :       ENDIF
 148 :       RETURN
 149 :  80   CONTINUE
 150 :       MLREEL=IRET
 151 :       SEGACT MLREEL
 152 :       N1=PROG(/1)
 153 :       INTERR(1)=N1
 154 :       INTERR(2)=MLREEL
 154 :       CALL ERREUR(-9)
 155 :       if(jentet.eq.1) n1 = min ( n1, 10)
 156 :       IF(N1.NE.0) WRITE(IOIMP,82)(PROG(J),J=1,N1)
 157 :  82   FORMAT(10(1X,1PG12.5))
 158 :       SEGDES MLREEL
 159 :       GO TO 50000
 160 :  90   CONTINUE
 160 :       CALL ECCHPO(IRET,jentet)
 161 :       GO TO 50000
 162 :  100  CONTINUE
 162 :       CALL PRRIGI(IRET,jentet)
 163 :       GO TO 50000
 164 :  110  CONTINUE
 165 :       MTEXTE=IRET
 166 :       SEGACT MTEXTE
 167 :       INTERR(1)=NCART
 167 :       CALL ERREUR (-10)
 168 :       IF(NCART.NE.0) WRITE(IOIMP,111) MTEXT
 169 :   111 FORMAT(5X,A72)
 170 :       SEGDES MTEXTE
 171 :       INTEXT=1
 172 :       GO TO 50000
 173 :  120  CONTINUE
 173 :       CALL ECSTRU(IRET)
 174 :       GO TO 50000
 175 :  130  CONTINUE
 175 :       CALL ECMATT(IRET,jentet)
 176 :       GO TO 50000
 177 :  140  CONTINUE
 177 :       CALL ECSOLU(IRET,jentet)
 178 :       GO TO 50000
 179 :  150  CONTINUE
 179 :       CALL ECBASE(IRET)
 180 :       GO TO 50000
 181 :  160  CONTINUE
 182 : C...  INUTILISE
 183 :       GOTO 50000
 184 :  170  CONTINUE
 185 : C...  INUTILISE
 186 :       GOTO 50000
 187 :  180  CONTINUE
 187 :       CALL PRVECT(IRET,jentet)
 188 :       GO TO 50000
 189 :  190  CONTINUE
 189 :       CALL ECLMOT(IRET)
 190 :       GOTO 50000
 191 :  200  CONTINUE
 192 :       MDEFOR=IRET
 193 :       SEGACT MDEFOR
 194 :       NDEF=AMPL(/1)
 195 :       INTERR(1)=NDEF
 195 :       CALL ERREUR(-11)
 196 :       WRITE (IOIMP,201) (AMPL(I),IELDEF(I),ICHDEF(I),MTVECT(I),
 197 :      * NCOUL(JCOUL(I)),MDCHP(I),MDCHEL(I),MDMODE(I),I=1,NDEF)
 198 :  201  FORMAT(1X,G12.5,4X,I8,I8,I8,2X,A6,3X,I8,4X,I8,I8)
 199 :       SEGDES MDEFOR
 200 :       GOTO 50000
 201 :  210  CONTINUE
 201 :       CALL ECLCHP(IRET,jentet)
 202 :       GOTO 50000
 203 :  220  CONTINUE
 203 :       CALL ECCHAR(IRET,jentet)
 204 :       GOTO 50000
 205 :  230  CONTINUE
 205 :       CALL ECEVOL(IRET,jentet)
 206 :       GOTO 50000
 207 :  240  CONTINUE
 208 : C...  INUTILISE
 209 :       GOTO 50000
 210 :  250  CONTINUE
 211 :       MVECTE=IRET
 212 :       SEGACT MVECTE
 213 :       NVEC=AMPF(/1)
 214 :       ID=NOCOVE(/3)
 215 :       INTERR(1)=NVEC
 215 :       CALL ERREUR(-12)
 216 :       DO i=1,NVEC
 217 :         WRITE(IOIMP,251) AMPF(i),ICHPO(i),
 218 :      &                   NCOUL(MAX(0,MIN(NBCOUL-1,NOCOUL(i)))),
 219 :      &                   (NOCOVE(i,j),j=1,ID)
 220 :       ENDDO
 221 :  251  FORMAT(2X,G12.5,3X,I8,3X,A4,6X,A4,4X,A4,4X,A4)
 222 :       SEGDES MVECTE
 223 :       GOTO 50000
 224 :  260  CONTINUE
 224 :       CALL ECTABL(IRET)
 225 :       GOTO 50000
 226 :  270  CONTINUE
 226 :       CALL ECPROC
 226 : *  PAS DE CALL REFUS DANS CE CAS
 227 :       RETURN
 228 :  280  CONTINUE
 228 :       CALL PRELST(IRET)
 229 :       GOTO 50000
 230 :  290  CONTINUE
 230 :       CALL PRCLST(IRET)
 231 :       GOTO 50000
 232 :  300  CONTINUE
 232 :       CALL ZPCHEL(IRET,jentet)
 233 :       GOTO 50000
 234 :  310  CONTINUE
 234 :       CALL ZPMODE(IRET)
 235 :       GOTO 50000
 236 :  320  CONTINUE
 236 :       CALL ERREUR(-256)
 237 :       GOTO 50000
 238 :  330  CONTINUE
 238 :       CALL ECNUAG(IRET)
 239 :       GOTO 50000
 240 :  340  CONTINUE
 240 :       CALL ECMATK(IRET)
 241 :       GOTO 50000
 241 :  350  CALL ECTABL(-IRET)
 242 : C*    GOTO 50000
 243 : 
 243 : 

Warning:  preg_replace(): Unknown modifier '7' in C:\xampp\htdocs\cast3m_kit_local_fr_en_2014\sources.php on line 147

 244 : 50000 CONTINUE
 245 : 
 246 :       RETURN
 247 :       END
 248 : 
 249 :