Télécharger extr15.eso

Retour à la liste

Numérotation des lignes :

  1. C EXTR15 SOURCE CHAT 11/03/16 21:21:44 6902
  2. SUBROUTINE EXTR15(IPMODL,IPCHE1,IPLSTM)
  3. *_____________________________________________________________________
  4. *
  5. * Extrait les composantes d'un MCHAML
  6. *
  7. * Entrees :
  8. * ---------
  9. *
  10. * IPMODL Pointeur sur un MMODEL
  11. * IPCHE1 Pointeur sur un MCHAML
  12. *
  13. * Sortie :
  14. * --------
  15. * IPLSTM Pointeur sur un LISTMOTS
  16. *
  17. * JM CAMPENON le 07/91
  18. *_____________________________________________________________________
  19. *
  20. IMPLICIT INTEGER(I-N)
  21. IMPLICIT REAL*8(A-H,O-Z)
  22. *
  23. -INC CCOPTIO
  24. -INC SMCHAML
  25. -INC SMMODEL
  26. -INC SMLMOTS
  27. *
  28. SEGMENT MTR1
  29. INTEGER IPT(0)
  30. ENDSEGMENT
  31. *
  32. IPLSTM=0
  33. JGN=4
  34. JGM=0
  35. MMODEL=IPMODL
  36. SEGACT MMODEL
  37. NSOUS=KMODEL(/1)
  38. *
  39. MCHELM=IPCHE1
  40. SEGACT MCHELM
  41. *
  42. SEGINI MTR1
  43. *
  44. DO 100 ISOUS=1,NSOUS
  45. IMODEL=KMODEL(ISOUS)
  46. SEGACT IMODEL
  47. IPMAIL=IMAMOD
  48. *
  49. DO 200 IA=1,ICHAML(/1)
  50. IF (IMACHE(IA).EQ.IPMAIL.AND.CONCHE(IA).EQ.CONMOD) GOTO 300
  51. 200 CONTINUE
  52. *
  53. * Pas de sous zone dans le MCHAML qui corresponde au MMODEL
  54. *
  55. CALL ERREUR(472)
  56. SEGSUP MTR1
  57. GOTO 555
  58. *
  59. 300 CONTINUE
  60. MCHAML=ICHAML(IA)
  61. SEGACT MCHAML
  62. NCOMP=NOMCHE(/2)
  63. JGM=JGM+NCOMP
  64. IPT(**)=IA
  65. 100 CONTINUE
  66. SEGINI MLMOTS
  67. IPLSTM=MLMOTS
  68. *
  69. IMEM=0
  70. DO 150 ISOUS=1,IPT(/1)
  71. MCHAML=ICHAML(IPT(ISOUS))
  72. NCOMP=NOMCHE(/2)
  73. *
  74. DO 400 ICOMP=IMEM+1,IMEM+NCOMP
  75. MOTS(ICOMP)=NOMCHE(ICOMP-IMEM)
  76. 400 CONTINUE
  77. IMEM=IMEM+NCOMP
  78. SEGDES MCHAML
  79. 150 CONTINUE
  80. *
  81. 555 CONTINUE
  82. SEGDES IMODEL
  83. SEGDES MMODEL
  84. SEGDES MCHELM
  85. RETURN
  86. END
  87.  
  88.  
  89.  
  90.  
  91.  
  92.  
  93.  
  94.  

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