Sources Esope | Cast3M

chmlst
C CHMLST    SOURCE    CB215821  20/11/25    13:19:31     10792          
      SUBROUTINE CHMLST(MCHPOI,MLIDX,IPTIDX,JPOVAL)
      IMPLICIT INTEGER(I-N)
        IMPLICIT REAL*8 (A-H,O-Z)
C------------------------------------------------------------------
C
C       CORRESPONDANCE ENTRE LES COMPOSANTES D' UN CHPOINT ET LES IDX
C         JPOVAL POINTEUR DU TABLEAU DE VALEURS DU CHPOINT
C
C     On cherche si toutes les composantes du chpoint correspondent
C      a un identificateur et réciproquement .On vérifie l'unicité
C------------------------------------------------------------------
-INC SMCHPOI
-INC SMLENTI
 
-INC PPARAM
-INC CCOPTIO
      SEGMENT IPTIDX
             INTEGER ITDX(NXDIM)
      ENDSEGMENT
      SEGMENT ITBID
             INTEGER IBID(NXDIM)
      ENDSEGMENT
      MLENTI=MLIDX
      SEGACT MCHPOI
      MSOUPO=IPCHP(1)
      SEGACT MSOUPO
      NXDIM=LECT(/1)
      SEGINI IPTIDX
      SEGINI ITBID
      CALL INITI(ITDX,NXDIM,0)
      CALL RSETI(IBID,LECT,NXDIM)
      NC=NOCOMP(/2)
      DO 50 I=1,NC
          READ(NOCOMP(I),100)NLL
  100 FORMAT(1X,I3)
C         WRITE(6,*)'COMPOSANTE ',NLL
          DO 20 J=1,NXDIM
              IF(NLL.EQ.IBID(J))THEN
                  ITDX(J)=I
                  IBID(J)=0
                  GO TO 30
              ENDIF
   20     CONTINUE
          MOTERR=NOCOMP(I)
          CALL ERREUR(197)
          RETURN
   30     CONTINUE
   50 CONTINUE
      DO 60 J=1,NXDIM
          IF(ITDX(J).EQ.0)THEN
             WRITE(MOTERR(1:LOCOMP),110)LECT(J)
             CALL ERREUR(77)
             RETURN
          ENDIF
   60 CONTINUE
  110 FORMAT('X',I3.3)
      MPOVAL=IPOVAL
      SEGACT MPOVAL
      JPOVAL= IPOVAL
      SEGSUP ITBID
C     write(6,*)' ITDX ',(itdx(j),j=1,nxdim)
      RETURN
      END