Télécharger la plaquette Cast3M


fr en

Télécharger enutab.eso

Retour à la liste

Numérotation des lignes : 

enutab

  1. C ENUTAB    SOURCE    SP204843  26/02/03    21:15:18     12461          
  2.       SUBROUTINE ENUTAB
  3. *---------------------------------------------------------------------
  4. *
  5. *     OPTION TABLE OPERATEUR ENUMERER
  6. *
  7. *     SYNTAXE : voir notice ENUM
  8. * 
  9. *--------------------------------------------------------------------
  10.       IMPLICIT INTEGER(I-N)
  11.       IMPLICIT REAL*8(A-H,O-Z)
  12.  
  13.       PARAMETER   (NMOCLE = 1)
  14.       CHARACTER*8 CTYP
  15.       LOGICAL     LCROI,LABSO
  16.  
  17. -INC PPARAM
  18. -INC CCOPTIO
  19. -INC SMLOBJE
  20. -INC SMTABLE
  21. -INC SMLENTI
  22.  
  23. C---------------------------------
  24. C     LECTURE DE LA TABLE
  25. C---------------------------------
  26.       CALL LIROBJ('TABLE   ',ITAB1,1,IRET)
  27.       IF (IERR.NE.0) RETURN
  28.  
  29. c     write(6,*) 'ITAB1=',ITAB1
  30.  
  31. C---------------------------------
  32. C     LISTE INDICES ENTIERS DE LA TABLE
  33. C---------------------------------
  34.       MTABLE = ITAB1
  35.       SEGACT, MTABLE
  36.       JG = MLOTAB
  37.       SEGINI, MLENTI, MLENT1
  38.       DO 10 I1=1,MLOTAB
  39.         IF (MTABTI(I1).EQ.'ENTIER  ') THEN
  40.           LECT(I1) = MTABII(I1)
  41.           CTYP     = MTABTV(I1)
  42.         ENDIF
  43.  10   CONTINUE
  44.  
  45. c     write(6,*) 'MLENTI,MLENT1,CTYP=',MLENTI,MLENT1,CTYP
  46.  
  47. C---------------------------------
  48. C     VERIFICATION LISTE INDICES ENTIER
  49. C     EST CORRECTEMENT ORONNEE
  50. C---------------------------------
  51.       LCROI = .true.
  52.       LABSO = .false.
  53.       CALL ORDON2(MLENTI,LCROI,LABSO,MLENT1)
  54.       IF (IERR.NE.0) RETURN
  55.       SEGACT,MLENT1
  56.  
  57. c     write(6,*) 'MLENT1.lect(/1)=',MLENT1.LECT(/1)
  58.       CALL PLAMO8(LTYPOB,NTYPOB,IPLA,CTYP)
  59.       IF (IPLA.EQ.0) THEN
  60.         CALL ERREUR(1138)
  61.         RETURN
  62.       ENDIF
  63.  
  64. C-------------------------- CAS DU LISTOBJE ---------------------------C
  65.  
  66.       NOBJ = 0
  67.       NREE = 0
  68.       IF (IPLA.EQ.2) NOBJ = MLOTAB
  69.       IF (IPLA.EQ.3) NREE = MLOTAB
  70.       IF (IPLA.GE.4) NOBJ = MLOTAB
  71.       SEGINI,MLOBJE
  72.       TYPOBJ(1:8) = CTYP
  73.  
  74. C     BOUCLE DE LECTURE DES OBJETS
  75.       NOBLU = 0
  76.       DO 1 IND1=1,MLOTAB
  77.  
  78. C       IND2 : indice de la table apres ORDON2
  79.         IND2  = MLENT1.LECT(IND1)
  80.  
  81. C       TYPE DE L'INDICE : PAS ENTIER => ON ITERE
  82. c       write(6,*) 'IND2,(MTABTI(IND2)=',IND2,MTABTI(IND2)
  83.         IF (MTABTI(IND2)(1:8).NE.'ENTIER  ') GOTO 1
  84.  
  85. C       VERIFICATION DU TYPE de L'OBJET CONTENU EN INDICE
  86.         CTYP = MTABTV(IND2)
  87. c       write(6,*) 'CTYP=',CTYP
  88.         IF (CTYP.NE.TYPOBJ) THEN
  89.           MOTERR(1:8) = CTYP
  90.           CALL ERREUR(39)
  91.           RETURN
  92.         ENDIF
  93.  
  94. C       AJOUT A LA LISTE
  95.         NOBLU = NOBLU + 1
  96.         IF (IPLA.EQ.2) LISOBJ(NOBLU) = MTABIV(IND2)
  97.         IF (IPLA.EQ.3) RLIREE(NOBLU) = RMTABV(IND2)
  98.         IF (IPLA.GE.4) LISOBJ(NOBLU) = MTABIV(IND2)
  99.  
  100.  1      CONTINUE
  101.  
  102. C     Ecriture du resultat 
  103.       IF (IPLA.EQ.2) NOBJ = NOBLU
  104.       IF (IPLA.EQ.3) NREE = NOBLU
  105.       IF (IPLA.GE.4) NOBJ = NOBLU
  106.       SEGADJ, MLOBJE
  107.       SEGACT, MLOBJE*NOMOD
  108.       CALL ECROBJ('LISTOBJE',MLOBJE)
  109.  
  110.       RETURN
  111.       END
  112.  
  113.  
  114.  
  115.  
  116.  

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