Télécharger extr35.eso

Retour à la liste

Numérotation des lignes :

extr35
  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.  
  24. -INC PPARAM
  25. -INC CCOPTIO
  26. -INC SMCHAML
  27. -INC SMMODEL
  28. -INC SMLMOTS
  29. *
  30. SEGMENT IPT(0)
  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,IPT
  43. ITAIL = 0
  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,IPT
  57. RETURN
  58. *
  59. 300 CONTINUE
  60. IPT(**)=IA
  61. ITAIL = ITAIL + 1
  62. 100 CONTINUE
  63. SEGINI MLMOTS
  64. IPLSTM=MLMOTS
  65. *
  66. DO 40 K=1,ITAIL
  67. IA = ipt(k)
  68. if (conche(IA)(1:4).eq.' ') call erreur (-328)
  69. if (jgm.gt.0) then
  70. DO 50 J=1,JGM
  71. IF (MLMOTS.MOTS(J).EQ.CONCHE(K)(1:4)) GOTO 40
  72. 50 CONTINUE
  73. JGM=JGM+1
  74. SEGADJ MLMOTS
  75. else
  76. jgm = 1
  77. segadj mlmots
  78. endif
  79. MLMOTS.MOTS(JGM)=CONCHE(IA)(1:4)
  80. 40 CONTINUE
  81.  
  82. END
  83.  
  84.  

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