Télécharger la plaquette Cast3M


fr en

Télécharger muchp2.eso

Retour à la liste

Numérotation des lignes : 

muchp2

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

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