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    PV090527  25/01/07    14:42:35     12115          
  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. -INC SMCOORD
  23.  
  24.       CHARACTER*(LOCOMP) LEMOT,MOLIST
  25.  
  26.       MLMOTS=LMOT1
  27.       MLMOT2=LMOT2
  28.  
  29.       JGN   =MLMOTS.MOTS(/1)
  30.       JGM   =MLMOTS.MOTS(/2)
  31.  
  32.  
  33.       MCHELM=IPCH1
  34.  
  35.       SEGINI,MCHEL1=MCHELM
  36.       IPCH2 =MCHEL1
  37.  
  38.       N1ori =MCHEL1.ICHAML(/1)
  39.       N3    =MCHEL1.INFCHE(/2)
  40.  
  41. C     BOUCLE SUR MCHAML
  42.       N1loc=0
  43.       DO 100 IN1=1,N1ori
  44.         MCHAML=MCHEL1.ICHAML(IN1)
  45.         SEGINI,MCHAM1=MCHAML
  46.         N2ori =MCHAM1.IELVAL(/1)
  47.  
  48. C       BOUCLE SUR MELVAL
  49.         N2loc=0
  50.         DO 110 IN2=1,N2ori
  51.           LEMOT=MCHAML.NOMCHE(IN2)
  52.  
  53. C         BOUCLE SUR MLMOTS
  54.           DO 150 IMO=1,JGM
  55.             MOLIST=MOTS(IMO)
  56.             IF (MOLIST.EQ.LEMOT) THEN
  57.               N2loc = N2loc + 1
  58.               MCHAM1.NOMCHE(N2loc)=MLMOT2.MOTS(IMO)
  59.               MCHAM1.TYPCHE(N2loc)=MCHAML.TYPCHE(iN2)
  60.               MCHAM1.IELVAL(N2loc)=MCHAML.IELVAL(iN2)
  61.               GOTO 110
  62.             ENDIF
  63.  150      CONTINUE
  64.  110    CONTINUE
  65.  
  66.         IF (N2loc .EQ. 0) THEN
  67.           SEGSUP,MCHAM1
  68.           GOTO 100
  69.  
  70.         ELSE
  71.           N1loc = N1loc + 1
  72.           MCHEL1.ICHAML(N1loc)=MCHAM1
  73.           MCHEL1.CONCHE(N1loc)=MCHELM.CONCHE(IN1)
  74.           MCHEL1.IMACHE(N1loc)=MCHELM.IMACHE(IN1)
  75.           DO IN3=1,N3
  76.             MCHEL1.INFCHE(N1loc,IN3)=MCHELM.INFCHE(IN1,IN3)
  77.           ENDDO
  78.  
  79.           IF (N2loc .NE. N2ori) THEN
  80.             N2=N2loc
  81.             SEGADJ,MCHAM1
  82.           ENDIF
  83.         ENDIF
  84.  100  CONTINUE
  85.  
  86.       IF    (N1loc.EQ.0 .AND. IVID.NE.1) THEN
  87.         MOTERR(1:8)=MLMOTS.MOTS(1)
  88.         CALL ERREUR(236)
  89.         RETURN
  90.       ELSEIF(N1loc .NE. N1ori) THEN
  91.         N1 = N1loc
  92.         L1 = MCHEL1.TITCHE(/1)
  93.         SEGADJ,MCHEL1
  94.       ENDIF
  95.  
  96.       END
  97.  
  98.  
  99.  

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