Télécharger la plaquette Cast3M


fr en

Télécharger reper.eso

Retour à la liste

Numérotation des lignes : 

reper

  1. C REPER     SOURCE    PASCAL    22/04/14    21:15:04     11341          
  2.       SUBROUTINE REPER(IRR)
  3.       IMPLICIT INTEGER(I-N)
  4.       SEGMENT MTOT
  5.        CHARACTER*(8) MTY(0)
  6.       ENDSEGMENT
  7. -INC CCNOYAU
  8.  
  9. -INC PPARAM
  10. -INC CCOPTIO
  11. -INC TMLNOMS
  12.       CHARACTER*(*) IRR
  13.       CHARACTER*(4) COPT
  14.       CHARACTER*(8) CTYP
  15.       CHARACTER*(LONOM) CNOM
  16.       CHARACTER*11 MYFMT
  17.       EXTERNAL LONG
  18.       SEGINI MTOT
  19.  
  20.       IOPT = 0
  21. C
  22. C     UN TYPE A ETE FOURNI => ON VERIFIE QU'IL EXISTE AU MOINS UN OBJET
  23. C                             DE CE TYPE EN MEMOIRE
  24.       IF(IRR.NE.'        ') THEN
  25.          CALL LIRCHA(COPT,0,IOPT)
  26.          IF (IERR.NE.0) RETURN
  27.          MTY(**)=IRR
  28.          DO 11 I=1,LMNNOM
  29.            IF(INOOB2(I).EQ.IRR) GOTO 10
  30.    11    CONTINUE
  31.          MOTERR(1:8)=MTY(1)
  32.          CALL ERREUR(-14)
  33.          SEGSUP MTOT
  34.          RETURN
  35.       ENDIF
  36. C
  37. C     SINON, ON DRESSE LA LISTE DES TYPES DE TOUS LES OBJETS EN MEMOIRE
  38.       DO 1 I=1,LMNNOM
  39.         DO 2 J=1,MTY(/2)
  40.           IF(INOOB2(I).EQ.MTY(J)) GO TO 1
  41.     2   CONTINUE
  42.         IF(INOOB2(I).EQ.'        ') GO TO 1
  43.         MTY(**)=INOOB2(I)
  44.     1 CONTINUE
  45.       IF(MTY(/2).EQ.0) THEN
  46.         CALL ERREUR (26)
  47.         SEGSUP MTOT
  48.         RETURN
  49.       ENDIF
  50. C
  51. C     POUR CHAQUE TYPE GIBIANE A LISTER, ON CHERCHE LES OBJETS NOMMES
  52. C     PUIS ON LES AFFICHE AU FORMAT ADAPTE (SELON LE NOM LE PLUS LONG)
  53.    10 CONTINUE
  54.       DO 3 II=1,MTY(/2)
  55.         CTYP=MTY(II)
  56.         CALL REPLIS(CTYP,MLNOMS)
  57.         IF (IOPT.NE.0) THEN
  58.           CALL NOMOPT(CTYP,MLNOMS,COPT,MLNOM1)
  59.           IF (IERR.NE.0) RETURN
  60.           MLNOMS = MLNOM1
  61.         ENDIF
  62.         SEGACT MLNOMS
  63.         IF(LINOMS(/2).EQ.0) GO TO 4
  64.         MOTERR(1:8)=CTYP
  65.         CALL ERREUR(-15)
  66.         CALL AFINOM(MLNOMS,LMAX)
  67.    4    CONTINUE
  68.         SEGSUP MLNOMS
  69.    3  CONTINUE
  70. C
  71.       SEGSUP MTOT
  72.       RETURN
  73.       END
  74.  
  75.  
  76.  
  77.  

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