Esope source files

   1 : C CHMLST    SOURCE    CHAT      05/01/12    21:59:28     5004           
   2 :       SUBROUTINE CHMLST(MCHPOI,MLIDX,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 IDX
   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 SMLENTI
  15 : -INC CCOPTIO
  16 :       SEGMENT IPTIDX
  17 :              INTEGER ITDX(NXDIM)
  18 :       ENDSEGMENT
  19 :       SEGMENT ITBID
  20 :              INTEGER IBID(NXDIM)
  21 :       ENDSEGMENT
  22 :       MLENTI=MLIDX
  23 :       SEGACT MCHPOI
  24 :       MSOUPO=IPCHP(1)
  25 :       SEGACT MSOUPO
  26 :       NXDIM=LECT(/1)
  27 :       SEGINI IPTIDX
  28 :       SEGINI ITBID
  28 :       CALL INITI(ITDX,NXDIM,0)
  28 :       CALL RSETI(IBID,LECT,NXDIM)
  29 :       NC=NOCOMP(/2)
  30 :       DO 50 I=1,NC
  31 :           READ(NOCOMP(I),100)NLL
  32 :   100 FORMAT(1X,I3)
  33 : C         WRITE(6,*)'COMPOSANTE ',NLL
  34 :           DO 20 J=1,NXDIM
  35 :               IF(NLL.EQ.IBID(J))THEN
  36 :                   ITDX(J)=I
  37 :                   IBID(J)=0
  38 :                   GO TO 30
  39 :               ENDIF
  40 :    20     CONTINUE
  41 :           MOTERR(1:4)=NOCOMP(I)
  41 :           CALL ERREUR(197)
  42 :           RETURN
  43 :    30     CONTINUE
  44 :    50 CONTINUE
  45 :       DO 60 J=1,NXDIM
  46 :           IF(ITDX(J).EQ.0)THEN
  47 :              WRITE(MOTERR(1:4),110)LECT(J)
  47 :              CALL ERREUR(77)
  48 :              RETURN
  49 :           ENDIF
  50 :    60 CONTINUE
  51 :   110 FORMAT('X',I3.3)
  52 :       MPOVAL=IPOVAL
  53 :       SEGACT MPOVAL
  54 :       JPOVAL= IPOVAL
  55 :       SEGDES MSOUPO,MCHPOI
  56 :       SEGSUP ITBID
  57 : C     write(6,*)' ITDX ',(itdx(j),j=1,nxdim)
  58 :       RETURN
  59 :       END
  60 :  
  61 :