Télécharger excoc2.eso

Retour à la liste

Numérotation des lignes :

  1. C EXCOC2 SOURCE CB215821 17/10/12 21:15:16 9589
  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. CHARACTER*8 LEMOT,LEMOT2
  19. CHARACTER*4 MOT4
  20.  
  21. -INC SMCHAML
  22. -INC CCOPTIO
  23. -INC SMLMOTS
  24.  
  25. LEMOT =' '
  26. LEMOT2=' '
  27. MLMOTS=LMOT1
  28. MLMOT2=LMOT2
  29.  
  30. JGM=MLMOTS.MOTS(/2)
  31.  
  32. MCHELM=IPCH1
  33. SEGINI,MCHEL1=MCHELM
  34. IPCH2=MCHEL1
  35.  
  36. N1ori=MCHEL1.ICHAML(/1)
  37. N3 =MCHEL1.INFCHE(/2)
  38.  
  39. C BOUCLE SUR MCHAML
  40. N1loc=0
  41. DO 100 IN1=1,N1ori
  42. MCHAML=MCHEL1.ICHAML(IN1)
  43. SEGINI,MCHAM1=MCHAML
  44. N2ori=MCHAM1.IELVAL(/1)
  45.  
  46. C BOUCLE SUR MELVAL
  47. N2loc=0
  48. DO 110 IN2=1,N2ori
  49. LEMOT=MCHAM1.NOMCHE(IN2)
  50. LEMOT2=LEMOT
  51.  
  52. C BOUCLE SUR MLMOTS
  53. DO 150 IMO=1,JGM
  54. IF (MOTS(IMO).EQ.LEMOT(1:4)) THEN
  55. N2loc = N2loc + 1
  56. MOT4 = MLMOT2.MOTS(IMO)(1:4)
  57. LEMOT2(1:4)=MOT4
  58. MCHAM1.NOMCHE(N2loc)=LEMOT2
  59. MCHAM1.TYPCHE(N2loc)=MCHAM1.TYPCHE(iN2)
  60. MCHAM1.IELVAL(N2loc)=MCHAM1.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)=MCHEL1.CONCHE(IN1)
  74. MCHEL1.IMACHE(N1loc)=MCHEL1.IMACHE(IN1)
  75. DO IN3=1,N3
  76. MCHEL1.INFCHE(N1loc,IN3)=MCHEL1.INFCHE(IN1,IN3)
  77. ENDDO
  78.  
  79. IF (N2loc .NE. N2ori) THEN
  80. N2=N2loc
  81. SEGADJ,MCHAM1
  82. ENDIF
  83. ENDIF
  84. SEGDES,MCHAM1
  85. 100 CONTINUE
  86.  
  87. IF (N1loc.EQ.0 .AND. IVID.NE.1) THEN
  88. MOTERR(1:4)=MLMOTS.MOTS(1)
  89. CALL ERREUR(236)
  90. RETURN
  91. ELSEIF (N1loc .NE. N1ori) THEN
  92. N1 = N1loc
  93. L1 = MCHEL1.TITCHE(/1)
  94. SEGADJ,MCHEL1
  95. ENDIF
  96. SEGDES,MCHEL1
  97.  
  98. RETURN
  99. END
  100.  
  101.  
  102.  

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