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  23/02/16    21:15:04     11598          
  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.  
  59.       IPLAC = 0
  60.       CALL PLACE(LTYPOB,NTYPOB,IPLAC,CTYP)
  61.  
  62. C-------------------------- CAS DU LISTOBJE ---------------------------C
  63.  
  64.       IF (IPLAC.NE.0) THEN
  65.  
  66.         NOBJ = MLOTAB
  67.         SEGINI,MLOBJE
  68.         TYPOBJ(1:8) = CTYP
  69.  
  70.  
  71. C       BOUCLE DE LECTURE DES OBJETS
  72.         NOBLU = 0
  73.         DO 1 IND1=1,MLOTAB
  74.  
  75. C         IND2 : indice de la table apres ORDON2
  76.           IND2  = MLENT1.LECT(IND1)
  77.  
  78. C         TYPE DE L'INDICE : PAS ENTIER => ON ITERE
  79. c         write(6,*) 'IND2,(MTABTI(IND2)=',IND2,MTABTI(IND2)
  80.           IF (MTABTI(IND2)(1:8).NE.'ENTIER  ') GOTO 1
  81.  
  82. C         VERIFICATION DU TYPE de L'OBJET CONTENU EN INDICE
  83.           CTYP = MTABTV(IND2)
  84. c         write(6,*) 'CTYP=',CTYP
  85.           IF (CTYP.NE.TYPOBJ) THEN
  86.             MOTERR(1:8) = CTYP
  87.             CALL ERREUR(39)
  88.             RETURN
  89.           ENDIF
  90.  
  91. C         AJOUT A LA LISTE
  92.           NOBLU = NOBLU + 1
  93.           LISOBJ(NOBLU) = MTABIV(IND2)
  94.  
  95.  1      CONTINUE
  96.  
  97. C       Ecriture du resultat 
  98.         NOBJ = NOBLU
  99.         SEGADJ, MLOBJE
  100.         CALL ECROBJ('LISTOBJE',MLOBJE)
  101.  
  102.       ENDIF
  103.  
  104.       RETURN
  105.       END
  106.  
  107.  
  108.  
  109.  

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