Sources Esope | Cast3M

etalch
C ETALCH    SOURCE    CB215821  26/08/24    21:16:31     12622          
      SUBROUTINE ETALCH(MCHPOI,IINC,ICPR,ICONTR,MVA,IPB,NPR2,ICODE)
C
C=======================================================================
C  CE SUBROUTINE ETALE LE CHPOINT DANS LE TABLEAU MVA
C
C  ***** ENTREES *****
C  IINC       : LISTE DES COMPOSANTES DU TABLEAU
C  ICPR(I)=KI : LE NOEUD I EST LE KI^IEME POINT DU TABLEAU MVA
C  si ICODE=1, ON VERIFIE QUE LES POINTS DE MCHPOI MUNIS DE LEUR
C              COMPOSANTES (indice K) SONT CONTENUS DANS MVA,
C              C.A.D. QUE MCONTR(K,KI)=1 POUR CES POINTS
C
C  ***** SORTIES *****
C  LES VALEURS DE MVA DANS LE CHPOINT
C  EVENTUELLEMENT IPB LE TABLEAU DE CORRESPONDANCE DES POINTS
C  IPB(I)=IK  LE IEME POINT DU CHPOINT EST A LA PLACE IK DANS MVA
C  NPR2 = NOMBRE DE POINTS TOTAL DU MCHPOI
C
C  ATTENTION : SEGACT MVA,IPB ET MISE A ZERO DE CES 2 TABLEAUX AVANT
C              UTILISATION.
C=======================================================================
      IMPLICIT INTEGER(I-N)
 
-INC PPARAM
-INC CCOPTIO
-INC SMCHPOI
-INC SMELEME
      SEGMENT ICPR(nbpts)
      SEGMENT IINC
       CHARACTER*(LOCOMP) CIINC(0)
      ENDSEGMENT
      SEGMENT/MVA/(VA(NNI1,IPR1)*D),MVA1.MVA
      SEGMENT/ICONTR/(MCONTR(NNI1,IPR1))
      SEGMENT IPB(IPR1)
 
C---- Activation des segments utiles ----
 
      NNI1=VA(/1)
      IPR1=VA(/2)
      NPR2=0
 
C---- Mise a 0 de VA et de IPB----
 
      DO 5001 J=1,IPR1
      DO 1 K=1,NNI1
        VA(K,J)=0.D0
 1    CONTINUE
 5001 CONTINUE
C
      IF(IPB.EQ.0) GOTO 2
      DO 3 J=1,IPR1
        IPB(J)=0
 3    CONTINUE
 2    CONTINUE
 
C---- Boucle sur les zones du CHPOINT ----
 
      NSOUP=IPCHP(/1)
      DO 60 ISOUP=1,NSOUP
 
        MSOUPO=IPCHP(ISOUP)
        MELEME=IGEOC
        N2=NUM(/2)
        MPOVAL=IPOVAL
 
C  ---- Boucle sur les composantes du CHPOINT ----
 
        DO 61 J=1,NOCOMP(/2)
 
          DO 62 K=1,NNI1
            IF(NOCOMP(J).EQ.CIINC(K)) GOTO 63
 62       CONTINUE
c         si on n'a pas trouvé la J eme composante dans CIINC,
c      -> on essaie la prochaine
          IF(ICODE.EQ.0) GOTO 61
c      -> ou erreur
          WRITE(IOIMP,*) 'NOCOMP(',J,')=',NOCOMP(J),'n existe pas dans:'
          WRITE(IOIMP,*) 'CIINC=',(CIINC(iou),iou=1,NNI1)
          IJ=1
          GOTO 66
c         J eme composante dans CIINC(K)
 63       CONTINUE
 
          IF(IPB.NE.0) GOTO 65
 
c       - si IPB n'existe pas, on verifie que MCONTR=1 et on remplit VA
          DO 64 IJ=1,N2
            KI=ICPR(NUM(1,IJ))
            IF(KI.EQ.0) THEN
              IF(ICODE.EQ.0) GOTO 64
              WRITE(IOIMP,*) IJ,'ieme NOEUD #',NUM(1,IJ),'n existe pas',
     &        ' dans l ICPR'
              GOTO 66
            ENDIF
            IF(MCONTR(K,KI).NE.1) THEN
              IF(ICODE.EQ.0) GOTO 64
              GOTO 66
            ENDIF
            VA(K,KI)=VPOCHA(IJ,J)
 64       CONTINUE
          GOTO 61
 
c       - si IPB existe, on le remplit aussi
 65       CONTINUE
c         boucle 74 = copie de la boucle 64 avec remplissage de IPB en +
          DO 74 IJ=1,N2
            KI=ICPR(NUM(1,IJ))
            IF(KI.EQ.0) THEN
              IF(ICODE.EQ.0) GOTO 74
              WRITE(IOIMP,*) IJ,'ieme NOEUD #',NUM(1,IJ),'n existe pas',
     &        ' dans l ICPR'
              GOTO 66
            ENDIF
            IF(MCONTR(K,KI).NE.1) THEN
              IF(ICODE.EQ.0) GOTO 74
              GOTO 66
            ENDIF
            IF(J.EQ.1) IPB(NPR2+IJ)=KI
            VA(K,KI)=VPOCHA(IJ,J)
 74       CONTINUE
          GOTO 61
 
c       - ERREUR -
 66       CONTINUE
          MOTERR=NOCOMP(J)
          INTERR(1)=NUM(1,IJ)
          CALL ERREUR(140)
C         INCOMPATIBILITE ENTRE LES POINTS ET COMPOSANTES DES 2 CHPOINTS
          GOTO 5000
 
 61     CONTINUE
C  ---- Fin de Boucle sur les comosantes du CHPOINT ----
        NPR2=NPR2+N2
 
 60   CONTINUE
C---- Fin de Boucle sur les zones du CHPOINT ----
C
C---- DesActivation des segments utiles et return ----
 5000 CONTINUE
      END