Télécharger extr35.eso

Retour à la liste

Numérotation des lignes :

  1. C EXTR35 SOURCE CB215821 19/03/18 21:15:14 10161
  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 IPT(0)
  29. *
  30. IPLSTM=0
  31. JGN=4
  32. JGM=0
  33. MMODEL=IPMODL
  34. SEGACT MMODEL
  35. NSOUS=KMODEL(/1)
  36. *
  37. MCHELM=IPCHE1
  38. SEGACT MCHELM
  39. *
  40. SEGINI,IPT
  41. ITAIL = 0
  42. DO 100 ISOUS=1,NSOUS
  43. IMODEL=KMODEL(ISOUS)
  44. SEGACT IMODEL
  45. IPMAIL=IMAMOD
  46. *
  47. DO 200 IA=1,ICHAML(/1)
  48. IF (IMACHE(IA).EQ.IPMAIL.AND.CONCHE(IA).EQ.CONMOD) GOTO 300
  49. 200 CONTINUE
  50. *
  51. * Pas de sous zone dans le MCHAML qui corresponde au MMODEL
  52. *
  53. CALL ERREUR(472)
  54. SEGSUP,IPT
  55. RETURN
  56. *
  57. 300 CONTINUE
  58. IPT(**)=IA
  59. ITAIL = ITAIL + 1
  60. 100 CONTINUE
  61. SEGINI MLMOTS
  62. IPLSTM=MLMOTS
  63. *
  64. DO 40 K=1,ITAIL
  65. IA = ipt(k)
  66. if (conche(IA)(1:4).eq.' ') call erreur (-328)
  67. if (jgm.gt.0) then
  68. DO 50 J=1,JGM
  69. IF (MLMOTS.MOTS(J).EQ.CONCHE(K)(1:4)) GOTO 40
  70. 50 CONTINUE
  71. JGM=JGM+1
  72. SEGADJ MLMOTS
  73. else
  74. jgm = 1
  75. segadj mlmots
  76. endif
  77. MLMOTS.MOTS(JGM)=CONCHE(IA)(1:4)
  78. 40 CONTINUE
  79.  
  80. END
  81.  
  82.  

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