Télécharger extr35.eso

Retour à la liste

Numérotation des lignes :

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

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