Télécharger la plaquette Cast3M


fr en

Télécharger excoc2.eso

Retour à la liste

Numérotation des lignes : 

excoc2

  1. C EXCOC2    SOURCE    CB215821  20/11/04    21:16:53     10766          
  2.       SUBROUTINE EXCOC2(IPCH1,LMOT1,IPCH2,LMOT2,IVID)
  3. C-----------------------------------------------------------------------
  4. C     EXTRACTION D UNE LISTE DE COMPOSANTES D UN MCHAML
  5. C
  6. C ENTREE
  7. C     IPCH1= POINTEUR SUR UN MCHAML
  8. C     LMOT1= LISTE DES NOMS DES COMPOSANTES A EXTRAIRE
  9. C     LMOT2= LISTE DES NOUVEAUX NOMS UNE FOIS EXTRAITS
  10. C     IVID = 1 SI ON A LU LE MOT 'NOID', 0 SINON
  11. C
  12. C SORTIE
  13. C     IPCH2= POINTEUR SUR LE MCHAML CONTENANT LES COMPOSANTES EXTRAITES
  14. C-----------------------------------------------------------------------
  15.       IMPLICIT INTEGER(I-N)
  16.       IMPLICIT REAL*8(A-H,O-Z)
  17.  
  18. -INC SMCHAML
  19. -INC PPARAM
  20. -INC CCOPTIO
  21. -INC SMLMOTS
  22.  
  23.       CHARACTER*(LOCOMP) LEMOT,MOLIST
  24.  
  25.       MLMOTS=LMOT1
  26.       MLMOT2=LMOT2
  27.  
  28.       JGN   =MLMOTS.MOTS(/1)
  29.       JGM   =MLMOTS.MOTS(/2)
  30.  
  31.  
  32.       MCHELM=IPCH1
  33.  
  34.       SEGINI,MCHEL1=MCHELM
  35.       IPCH2 =MCHEL1
  36.  
  37.       N1ori =MCHEL1.ICHAML(/1)
  38.       N3    =MCHEL1.INFCHE(/2)
  39.  
  40. C     BOUCLE SUR MCHAML
  41.       N1loc=0
  42.       DO 100 IN1=1,N1ori
  43.         MCHAML=MCHEL1.ICHAML(IN1)
  44.         SEGINI,MCHAM1=MCHAML
  45.         N2ori =MCHAM1.IELVAL(/1)
  46.  
  47. C       BOUCLE SUR MELVAL
  48.         N2loc=0
  49.         DO 110 IN2=1,N2ori
  50.           LEMOT=MCHAML.NOMCHE(IN2)
  51.  
  52. C         BOUCLE SUR MLMOTS
  53.           DO 150 IMO=1,JGM
  54.             MOLIST=MOTS(IMO)
  55.             IF (MOLIST.EQ.LEMOT) THEN
  56.               N2loc = N2loc + 1
  57.               MCHAM1.NOMCHE(N2loc)=MLMOT2.MOTS(IMO)
  58.               MCHAM1.TYPCHE(N2loc)=MCHAML.TYPCHE(iN2)
  59.               MCHAM1.IELVAL(N2loc)=MCHAML.IELVAL(iN2)
  60.               GOTO 110
  61.             ENDIF
  62.  150      CONTINUE
  63.  110    CONTINUE
  64.  
  65.         IF (N2loc .EQ. 0) THEN
  66.           SEGSUP,MCHAM1
  67.           GOTO 100
  68.  
  69.         ELSE
  70.           N1loc = N1loc + 1
  71.           MCHEL1.ICHAML(N1loc)=MCHAM1
  72.           MCHEL1.CONCHE(N1loc)=MCHELM.CONCHE(IN1)
  73.           MCHEL1.IMACHE(N1loc)=MCHELM.IMACHE(IN1)
  74.           DO IN3=1,N3
  75.             MCHEL1.INFCHE(N1loc,IN3)=MCHELM.INFCHE(IN1,IN3)
  76.           ENDDO
  77.  
  78.           IF (N2loc .NE. N2ori) THEN
  79.             N2=N2loc
  80.             SEGADJ,MCHAM1
  81.           ENDIF
  82.         ENDIF
  83.  100  CONTINUE
  84.  
  85.       IF    (N1loc.EQ.0 .AND. IVID.NE.1) THEN
  86.         MOTERR(1:8)=MLMOTS.MOTS(1)
  87.         CALL ERREUR(236)
  88.         RETURN
  89.       ELSEIF(N1loc .NE. N1ori) THEN
  90.         N1 = N1loc
  91.         L1 = MCHEL1.TITCHE(/1)
  92.         SEGADJ,MCHEL1
  93.       ENDIF
  94.  
  95.       END
  96.  
  97.  

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