Télécharger muchp2.eso

Retour à la liste

Numérotation des lignes :

  1. C MUCHP2 SOURCE CHAT 05/01/13 01:54:22 5004
  2. SUBROUTINE MUCHP2(MCHPOI,MLMOTS,MCORES,JCHACO,KCHACO,IHARNUM,NMIN)
  3. c=======================================================================
  4. c
  5. c appelé par muchp2
  6. c sert à determiner si il existe des zones à fusionner
  7. c
  8. c=======================================================================
  9. IMPLICIT INTEGER(I-N)
  10. IMPLICIT REAL*8(A-H,O-Z)
  11. -INC SMCHPOI
  12. -INC SMELEME
  13. -inc SMLMOTS
  14. * ENTREE
  15. * ce segment contient les numéro des différents harmoniques trouvées
  16. * et l'inversion du tableau
  17. SEGMENT NUMHAR(NHAR)
  18. SEGMENT IHARNUM(NVHAR)
  19. * SORTIE
  20. * ces segment servent au moment de l'assemblage du nouveau chpoint
  21. * celui stocke le nombre de sous zone du nouveau chpoint
  22. SEGMENT JCHACO(4,NSOUP1)
  23. * indice 1 kcomp , 2 khar , 3 nombre de pts , 4 nbre de composante
  24. * kchaco donne l'adresse dans jchaco de la sous zone
  25. SEGMENT KCHACO(NSOUPO)
  26. *
  27. SEGMENT MCORES
  28. * correspondence comp listmot comp sous zone
  29. * numero dans la sous zone de la composante si elle existe
  30. INTEGER ICOR3(NCOMP1,NSOUPO)
  31. * indice 1 contient sum 2**i si i présent
  32. * indice 2 contient le nombre de composantes
  33. INTEGER KCOMP(2,NSOUPO)
  34. INTEGER KHARM(NSOUPO)
  35. ENDSEGMENT
  36. *
  37. * EXECUTABLE
  38. *
  39. * première partie on remplis mcores pour chaque sous zone
  40. * et on calcul kcomp et kharm pour les comparaison
  41. *
  42. NCOMP1 = MOTS(/2)
  43. NSOUPO = IPCHP(/1)
  44. SEGINI MCORES
  45. DO 120 I=1,NSOUPO
  46. MSOUPO = IPCHP(I)
  47. NC = NOHARM(/1)
  48. NC1 = 0
  49. * boucle sur les composantes
  50. DO 110 J=1,NCOMP1
  51. * ICOR3(J,I)=0
  52. * boucle sur les composantes du chpoints
  53. DO 100 K=1,NC
  54. IF(MOTS(J).EQ.NOCOMP(K)) THEN
  55. ICOR3(J,I)=K
  56. KCOMP(1,I)=KCOMP(1,I) + 2**J
  57. KCOMP(2,I)=KCOMP(2,I) + 1
  58. IHA = IHARNUM(NOHARM(K)-NMIN+1)
  59. KHARM(I)=KHARM(I) + 2**IHA
  60. GOTO 110
  61. ENDIF
  62. 100 CONTINUE
  63. 110 CONTINUE
  64. 120 CONTINUE
  65.  
  66. *
  67. * deuxieme partie on rempli jchaco et kchaco
  68. *
  69. NSOUP1 = NSOUPO
  70. SEGINI JCHACO,KCHACO
  71. NSOUP1=0
  72. DO 140 I=1,NSOUPO
  73. MSOUPO = IPCHP(I)
  74. MELEME = IGEOC
  75. SEGACT MELEME
  76. DO 130 J=1,NSOUP1
  77. IF(KCOMP(1,I).EQ.JCHACO(1,J).AND.KHARM(I).EQ.JCHACO(2,J))THEN
  78. KCHACO(I)=J
  79. JCHACO(3,J)=JCHACO(3,J)+NUM(/2)
  80. GOTO 140
  81. ENDIF
  82. 130 CONTINUE
  83. NSOUP1=NSOUP1+1
  84. JCHACO(1,NSOUP1)=KCOMP(1,I)
  85. JCHACO(2,NSOUP1)=KHARM(I)
  86. JCHACO(3,NSOUP1)=NUM(/2)
  87. JCHACO(4,NSOUP1)=KCOMP(2,I)
  88. KCHACO(I)=NSOUP1
  89. SEGDES MELEME
  90. 140 CONTINUE
  91. SEGADJ JCHACO
  92. RETURN
  93. END
  94.  
  95.  
  96.  

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