Télécharger extr15.eso

Retour à la liste

Numérotation des lignes :

extr15
  1. C EXTR15 SOURCE CB215821 20/11/04 21:17:06 10766
  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.  
  24. -INC PPARAM
  25. -INC CCOPTIO
  26. -INC SMCHAML
  27. -INC SMMODEL
  28. -INC SMLMOTS
  29. *
  30. SEGMENT MTR1(0)
  31. *
  32. IPLSTM=0
  33. JGN=LOCOMP
  34. JGM=0
  35. MMODEL=IPMODL
  36. NSOUS=KMODEL(/1)
  37. *
  38. MCHELM=IPCHE1
  39. *
  40. SEGINI MTR1
  41. *
  42. DO 100 ISOUS=1,NSOUS
  43. IMODEL=KMODEL(ISOUS)
  44. IPMAIL=IMAMOD
  45. *
  46. DO 200 IA=1,ICHAML(/1)
  47. IF (IMACHE(IA).EQ.IPMAIL.AND.CONCHE(IA).EQ.CONMOD) GOTO 300
  48. 200 CONTINUE
  49. *
  50. * Pas de sous zone dans le MCHAML qui corresponde au MMODEL
  51. *
  52. CALL ERREUR(472)
  53. SEGSUP MTR1
  54. GOTO 555
  55. *
  56. 300 CONTINUE
  57. MCHAML=ICHAML(IA)
  58. NCOMP=NOMCHE(/2)
  59. JGM=JGM+NCOMP
  60. MTR1(**)=IA
  61. 100 CONTINUE
  62. SEGINI MLMOTS
  63. IPLSTM=MLMOTS
  64. *
  65. IMEM=0
  66. DO 150 ISOUS=1,MTR1(/1)
  67. MCHAML=ICHAML(MTR1(ISOUS))
  68. NCOMP=NOMCHE(/2)
  69. *
  70. DO 400 ICOMP=IMEM+1,IMEM+NCOMP
  71. MOTS(ICOMP)=NOMCHE(ICOMP-IMEM)
  72. 400 CONTINUE
  73. IMEM=IMEM+NCOMP
  74. 150 CONTINUE
  75. *
  76. 555 CONTINUE
  77. RETURN
  78. END
  79.  
  80.  

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