Télécharger la plaquette Cast3M


fr en

Télécharger enucom.eso

Retour à la liste

Numérotation des lignes : 

enucom

  1. C ENUCOM    SOURCE    SP204843  26/02/03    21:15:15     12461          
  2.       SUBROUTINE ENUCOM
  3. *---------------------------------------------------------------------
  4. *
  5. *     OPTION 'COMP' 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. -INC PPARAM
  14. -INC CCOPTIO
  15. -INC SMLOBJE
  16. -INC SMLMOTS
  17.  
  18.       CHARACTER*8 CTYP
  19.       CHARACTER*(LOCOMP) MOT
  20.  
  21. C---------------------------------
  22. C     LECTURE DES CHAMPS
  23. C---------------------------------
  24.  
  25.       CALL QUETYP(CTYP,1,IRET)
  26.       IF (IERR.NE.0) RETURN
  27.  
  28.       IK = 0
  29.       CALL PLAMO8(LTYPOB,NTYPOB,IPLA,CTYP)
  30.       IF (IPLA.EQ.0) THEN
  31.         CALL ERREUR(1138)
  32.         RETURN
  33.       ELSEIF (IPLA.EQ.30) THEN
  34.         IK = 1 
  35.       ELSEIF (IPLA.EQ.9) THEN
  36.         IK = 2 
  37.       ELSE
  38.         CALL ERREUR(21)
  39.         RETURN
  40.       ENDIF
  41.       CALL LIROBJ(CTYP,IPOBJ,1,IRET)
  42.       IF (IERR.NE.0) RETURN
  43.       CALL ACTOBJ(CTYP,IPOBJ,1)
  44.       IF (IERR.NE.0) RETURN
  45.  
  46. C---------------------------------
  47. C     EXTRACTION DES NOMS DE COMPOSANTE
  48. C---------------------------------
  49.  
  50.       IF (IK.EQ.1) THEN
  51.         CALL EXTR17(IPOBJ,IPLMO)
  52.         IF (IERR.NE.0) RETURN
  53.       ELSEIF (IK.EQ.2) THEN
  54.         CALL EXTR11(IPOBJ,IPLMO)
  55.         IF (IERR.NE.0) RETURN
  56.       ELSE
  57.         CALL ERREUR(5)
  58.         RETURN
  59.       ENDIF
  60.  
  61. C---------------------------------
  62. C     DEFINITION DU LISTOBJE
  63. C---------------------------------
  64.       MLMOTS = IPLMO
  65.       SEGACT,MLMOTS
  66.       NOBJ = MOTS(/2)
  67.       NREE = 0
  68.       SEGINI,MLOBJE
  69.       TYPOBJ = CTYP
  70.  
  71. C     BOUCLE SUR LES COMPOSANTES 
  72.       IF (NOBJ.GT.0) THEN
  73.  
  74. C       CAS D'UN MCHAML
  75.         IF (IK.EQ.1) THEN
  76.           DO ICP=1,NOBJ
  77.             MOT = MOTS(ICP)
  78.             CALL EXCOC1(IPOBJ,MOT,IPCH2,MOT,0)
  79.             IF (IERR.NE.0) RETURN
  80.             LISOBJ(ICP) = IPCH2
  81.             CALL ACTOBJ('MCHAML  ',IPCH2,1)
  82.           ENDDO
  83.  
  84. C       CAS D'UN CHPOINT
  85.         ELSE
  86.           IF (IFOUR.EQ.1) then
  87.             NIF1 = NIFOUR
  88.             NIF2 = NIFOUR
  89.           ELSE
  90.             NIF1 = 0
  91.             NIF2 = 0
  92.           ENDIF
  93.           DO ICP=1,NOBJ
  94.             MOT = MOTS(ICP)
  95.             CALL EXCOPP(IPOBJ,MOT,NIF1,IPCH2,MOT,NIF2,0)
  96.             IF (IERR.NE.0) RETURN
  97.             LISOBJ(ICP) = IPCH2
  98.             CALL ACTOBJ('CHPOINT ',IPCH2,1)
  99.           ENDDO
  100.         ENDIF
  101.  
  102.       ENDIF
  103.  
  104. C---------------------------------
  105. C     ECRITURE DU RESULTAT 
  106. C---------------------------------
  107.       SEGACT, MLOBJE*NOMOD
  108.       CALL ECROBJ('LISTOBJE',MLOBJE)
  109.  
  110.       RETURN
  111.       END
  112.  
  113.  
  114.  
  115.  
  116.  
  117.  
  118.  

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