Esope source files

   1 : C CHMMST    SOURCE    CHAT      05/01/12    21:59:36     5004           
   2 :       SUBROUTINE CHMmST(MCHPOI,Mmsolu,IPtidx,JPOVAL)
   3 :       IMPLICIT INTEGER(I-N)
   4 :         IMPLICIT REAL*8 (A-H,O-Z)
   5 : C------------------------------------------------------------------
   6 : C
   7 : C       CORRESPONDANCE ENTRE LES COMPOSANTES D' UN CHPOINT ET LES  ???
   8 : C         JPOVAL POINTEUR DU TABLEAU DE VALEURS DU CHPOINT
   9 : C
  10 : C     On cherche si toutes les composantes du chpoint correspondent
  11 : C      a un identificateur et réciproquement .On vérifie l'unicité
  12 : C------------------------------------------------------------------
  13 : -INC SMCHPOI
  14 : -INC SMLMOTS
  15 : -INC CCOPTIO
  16 :       SEGMENT IPTIDX
  17 :              INTEGER ITDX(NXDIM)
  18 :       ENDSEGMENT
  19 :       SEGMENT ITBID
  20 :              INTEGER IBID(NXDIM)
  21 :       ENDSEGMENT
  22 :       MLmots=Mmsolu
  23 :       SEGACT MCHPOI
  24 :       MSOUPO=IPCHP(1)
  25 :       SEGACT MSOUPO
  26 :       NXDIM=mots(/2)
  27 :       SEGINI IPTIDX
  28 :       SEGINI ITBID
  28 :       CALL INITI(ITDX,NXDIM,0)
  28 :       CALL initi(IBID,NXDIM,1)
  29 :       NC=NOCOMP(/2)
  30 : *     write(6,*)' mots ',(mots(ik),ik=1,nxdim)
  31 : *     write(6,*)' comp ',(nocomp(ik),ik=1,nxdim)
  32 : 
  33 :       DO 50 I=1,NC
  34 : c
  35 : c
  36 : C         WRITE(6,*)'COMPOSANTE ',NLL
  37 :           DO 20 J=1,NXDIM
  38 :               IF(nocomp(i).eq.mots(j))then
  39 :                   ITDX(J)=I
  40 :                   IBID(J)=0
  41 : *                  write(6,*)' i j ',i,j
  42 :                   GO TO 30
  43 :               ENDIF
  44 :    20     CONTINUE
  45 :           MOTERR(1:4)=NOCOMP(I)
  45 :           CALL ERREUR(197)
  46 :           RETURN
  47 :    30     CONTINUE
  48 :    50 CONTINUE
  49 :       DO 60 J=1,NXDIM
  50 :           IF(ITDX(J).EQ.0)THEN
  51 :              WRITE(MOTERR(1:4),110)mots(J)
  51 :              CALL ERREUR(77)
  52 :              RETURN
  53 :           ENDIF
  54 :    60 CONTINUE
  55 :   110 FORMAT('X',I3.3)
  56 :       MPOVAL=IPOVAL
  57 :       SEGACT MPOVAL
  58 :       JPOVAL= IPOVAL
  59 :       SEGDES MSOUPO,MCHPOI
  60 :       SEGSUP ITBID
  61 : *     write(6,*)' ITDX ',(itdx(j),j=1,nxdim)
  62 :       RETURN
  63 :       END
  64 :  
  65 :  
  66 :