Esope source files

   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 :