Sources Esope | Cast3M

etalpr
C ETALPR    SOURCE    CB215821  20/11/25    13:28:09     10792          
      SUBROUTINE ETALPR(MCHPOI,IINC,ICPR,ICONTR)
C=======================================================================
C     CE SUBROUTINE REMPLIT ICPR ,IINC ET ICONTR
C     ICPR(K)=IK  : LE POINT K EST A LA POSITION IK DANS MCHPOI
C     IINC(I) EST LA IEME COMPOSANTE DE MCHPOI(TOUTES LES COMPOSANTES
C     DANS IINC SONT DIFFERENTES)
C     MCONTR(I,J)=1 VEUT DIRE QUE LA IEME COMPOSANTE DANS IINC EXISTE
C     POUR LE IK IEME POINT (TEL QUE ICPR(K)=IK) DANS MCHPOI
C
C     ATTENTION SEGINI ICPR. SEGINI IINC. SEGINI ICONTR
C=======================================================================
      IMPLICIT INTEGER(I-N)
-INC SMCHPOI
 
-INC PPARAM
-INC CCOPTIO
-INC SMELEME
-INC SMCOORD
      SEGMENT ICPR(nbpts)
      SEGMENT IINC
       CHARACTER*(LOCOMP) CIINC(0)
      ENDSEGMENT
      SEGMENT /ICONTR/(MCONTR(NNI1,IPR1))
C
      SEGINI ICPR
      NSOUPO=IPCHP(/1)
      IK=0
      MSOUPO=IPCHP(1)
      SEGINI IINC
      CIINC(**)=NOCOMP(1)
      ININC=1
 
      DO 101 ISOU=1,NSOUPO
      MSOUPO=IPCHP(ISOU)
      MELEME=IGEOC
      N2=NUM(/2)
      DO 102 I2=1,N2
      K=NUM(1,I2)
      IK=IK+1
      ICPR(K)=IK
 102  CONTINUE
      DO 106 I2=1,NOCOMP(/2)
      DO 107 IJ=1,ININC
      IF(CIINC(IJ).EQ.NOCOMP(I2)) GO TO 106
 107  CONTINUE
      CIINC(**)=NOCOMP(I2)
      ININC=ININC+1
 106  CONTINUE 
 101  CONTINUE
 
      NNI1=CIINC(/2)
      IPR1=IK
      SEGINI ICONTR
      DO 201 ISOU=1,NSOUPO
      MSOUPO=IPCHP(ISOU)
      MELEME=IGEOC
      N2=NUM(/2)
      NC=NOCOMP(/2)
      DO 202 J=1,NC
      DO 203 K=1,NNI1
      IF(NOCOMP(J).EQ.CIINC(K)) GO TO 204
 203  CONTINUE
 204  CONTINUE
      DO 205 I2=1,N2
      KI=ICPR(NUM(1,I2))
      MCONTR(K,KI)=1
 205  CONTINUE
 202  CONTINUE
 201  CONTINUE
      END