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

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