Télécharger extr35.eso

Retour à la liste

Numérotation des lignes :

  1. C EXTR35 SOURCE CHAT 11/03/16 21:21:45 6902
  2. SUBROUTINE EXTR35(IPMODL,IPCHE1,IPLSTM)
  3. *_____________________________________________________________________
  4. *
  5. * Extrait les constituants 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. IPT(**)=IA
  61. SEGDES IMODEL
  62. 100 CONTINUE
  63. SEGINI MLMOTS
  64. IPLSTM=MLMOTS
  65. *
  66. DO 40 K=1,IPT(/1)
  67. if (conche(ipt(k))(1:4).eq.' ') call erreur (-328)
  68. if (jgm.gt.0) then
  69. DO 50 J=1,JGM
  70. IF (MOTS(J).EQ.CONCHE(K)(1:4)) GOTO 40
  71. 50 CONTINUE
  72. JGM=JGM+1
  73. SEGADJ MLMOTS
  74. MOTS(JGM)=CONCHE(ipt(k))(1:4)
  75. else
  76. jgm = 1
  77. segadj mlmots
  78. mots(jgm) = conche(ipt(k))(1:4)
  79. endif
  80. 40 CONTINUE
  81.  
  82. SEGDES MMODEL
  83. SEGDES MCHELM
  84. RETURN
  85. *
  86. 555 CONTINUE
  87. SEGDES IMODEL
  88. SEGDES MMODEL
  89. SEGDES MCHELM
  90. RETURN
  91. END
  92.  
  93.  
  94.  
  95.  
  96.  
  97.  
  98.  
  99.  
  100.  
  101.  

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