Télécharger extr11.eso

Retour à la liste

Numérotation des lignes :

  1. C EXTR11 SOURCE CB215821 17/06/06 21:15:03 9448
  2. SUBROUTINE EXTR11(MCHPOI,MLMOTS)
  3. IMPLICIT INTEGER(I-N)
  4. IMPLICIT REAL*8(A-H,O-Z)
  5. C-----------------------------------------------------------------------
  6. C
  7. C E X T R 1 1
  8. C -----------
  9. C
  10. C FONCTION:
  11. C ---------
  12. C
  13. C EXTRAIT LES COMPOSANTES DU CHPOINT "ICHP" ET LES RANGE DANS
  14. C UN LISTMOTS MLMOTS
  15. C
  16. C MODULES UTILISES:
  17. C -----------------
  18. C
  19. -INC SMCHPOI
  20. -INC SMLMOTS
  21. C
  22. C PARAMETRES: (E)=ENTREE (S)=SORTIE (+ = CONTENU DANS UN COMMUN)
  23. C -----------
  24. C
  25. C MCHPOI (E) POINTEUR SUR LE CHPOINT
  26. C MLMOTS (S) POINTEUR SUR LE LISTMOTS
  27. C
  28. C-----------------------------------------------------------------------
  29.  
  30. SEGACT MCHPOI
  31. JGN =4
  32. JGM =0
  33. INCJGM=10
  34. SEGINI,MLMOTS
  35. NSOUPO=IPCHP(/1)
  36.  
  37. IF (NSOUPO.EQ.0) GOTO 90
  38.  
  39. DO 10 I=1,NSOUPO
  40. MSOUPO=IPCHP(I)
  41. SEGACT,MSOUPO
  42. 10 CONTINUE
  43.  
  44. MSOUPO=IPCHP(1)
  45. JGM=NOCOMP(/2)
  46. SEGADJ,MLMOTS
  47. DO 20 I=1,JGM
  48. MOTS(I)=NOCOMP(I)
  49. 20 CONTINUE
  50. SEGDES,MSOUPO
  51.  
  52. NBCOMP=JGM
  53. IF (NSOUPO.GT.1) THEN
  54. DO 30 I=2,NSOUPO
  55. MSOUPO=IPCHP(I)
  56. DO 40 K=1,NOCOMP(/2)
  57. DO 50 J=1,NBCOMP
  58. IF (MOTS(J).EQ.NOCOMP(K)) GOTO 40
  59. 50 CONTINUE
  60. NBCOMP = NBCOMP + 1
  61. IF (NBCOMP .GT. JGM)THEN
  62. JGM=JGM+INCJGM
  63. INCJGM = INCJGM * 2
  64. SEGADJ,MLMOTS
  65. ENDIF
  66. MOTS(NBCOMP)=NOCOMP(K)
  67. 40 CONTINUE
  68. SEGDES,MSOUPO
  69. 30 CONTINUE
  70. ENDIF
  71.  
  72. IF (NBCOMP .NE. JGM)THEN
  73. JGM=NBCOMP
  74. SEGADJ,MLMOTS
  75. ENDIF
  76.  
  77. 90 SEGDES MLMOTS,MCHPOI
  78. RETURN
  79. END
  80.  
  81.  
  82.  

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