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