Sources Esope | Cast3M

chv2
C CHV2      SOURCE    MB234859  26/06/25    21:15:06     12580          
      SUBROUTINE CHV2(MMATRX,ISECO,MVECTX,NOID)
C
C  **** SUBROUTINE QUI A PARTIR D UN OBJET DE TYPE MATRICE ET D UN
C  **** CHPOINT FABRIQUE UN VECTEUR SECOND MEMBRE
C  **** LE CHPOIN EST DE TYPE SECOND MEMBRE
C
      IMPLICIT INTEGER(I-N)
-INC SMMATRI
-INC SMCHPOI
-INC SMELEME
 
-INC PPARAM
-INC CCOPTIO
-INC SMVECTD
-INC SMCOORD
      SEGMENT,ICPR(nbpts)
      SEGMENT,ICOR(NC1)
C
      IF(IIMPI.EQ.3) WRITE(IOIMP,1000) MMATRX,ISECO
 1000 FORMAT('  SUBROUTINE CHV2 : POINTEUR DE LA MATRICE=',I5,
     1                        '   POINTEUR DE L''OBJET CHPOINT=',I5)
C
C  ****  ACTIVATION DES SEGMENTS
C
      MMATRI=MMATRX
      SEGACT,MMATRI
 
      MILIGN=IILIGN
      SEGACT,MILIGN
      INC=IPNO(/1)
      SEGINI,MVECTD
 
      MIDUA=IIDUA
      SEGACT,MIDUA
      IDU=IDUA(/2)
 
      MHARK=IHARK
      MINCPO=IINCPO
C
C     Matrices non symetriques
      IF (IILIGS.NE.0) THEN
        MHARK=IHARDU
        MINCPO=IDUAPO
      ENDIF
C
      SEGACT,MHARK
      SEGACT,MINCPO
 
      MELEME=IGEOMA
      SEGACT,MELEME
      N2=NUM(/2)
      SEGDES,MILIGN
 
      MCHPOI=ISECO
      SEGACT MCHPOI
      NSOUPO=IPCHP(/1)
C
C  **** DANS ICPR ON COMPTE LES POINTS DE MELEME
C
      SEGINI ICPR
      DO 25 I=1,N2
      ICPR(NUM(1,I))=I
 25   CONTINUE
C
C
C  ****  FABRICATION D'UN VECTEUR SECOND MEMBRE DANS MVECTD
C  ****  ON VERIFIE QUE TOUTES LES COMPOSANTES DU VECTEUR EXISTENT DANS
C  ****  LA MATRICE  SI NOID=0 .
C
      DO 1 I=1,NSOUPO
        MSOUPO=IPCHP(I)
        SEGACT,MSOUPO
        IPT1=IGEOC
        SEGACT,IPT1
        NC=NOCOMP(/2)
        NC1=NC
        SEGINI,ICOR
        DO     KKIL = 1,NC1
          ICOR(KKIL)=0
        ENDDO
 
        DO 11 KI=1,NC
          DO 10 J=1,IDU
            IF(NOCOMP(KI).NE.IDUA(J)) GO TO 10
            if (ifour.eq.1) then
              IF(NOHARM(KI).NE.IHAR(J)) GO TO 10
            endif
            ICOR(KI)=J
            GO TO 11
   10     CONTINUE
   11   CONTINUE
 
        MPOVAL=IPOVAL
        SEGACT,MPOVAL
        N=VPOCHA(/1)
        DO 20 J=1,N
          K=ICPR(IPT1.NUM(1,J))
          IF(K.NE.0) GO TO 4
          IF(NOID.EQ.1) GO TO 20
C
C  ****  LE NUMERO DU NOEUD DU VECTEUR N'EXISTAIT PAS DANS LA MATRICE
C
          ITYP=53
          INTERR(1) = IPT1.NUM(1,J)
          CALL ERREUR (ITYP)
          RETURN
 
    4     CONTINUE
 
          DO 2 LI=1,NC
            KKIL=ICOR(LI)
            IF (KKIL.EQ.0) GOTO 55
            KI=INCPO(KKIL,K)
            IF(KI.NE.0)  GO TO 6
  55        CONTINUE
            IF(NOID.EQ.1) GO TO 2
C
C  ****  LE TYPE D'INCONNUE N'EXISTAIT PAS DANS LA MATRICE
C
            ITYP      = 54
            MOTERR    = NOCOMP(LI)
            INTERR(1) = NOHARM (LI)
            INTERR(2) = IPT1.NUM(1,J)
            CALL ERREUR(ITYP)
            RETURN
 
    6       CONTINUE
            VECTBB(KI)=VPOCHA(J,LI)
    2     CONTINUE
   20   CONTINUE
        SEGDES,MPOVAL
        SEGDES,MSOUPO
        SEGSUP,ICOR
        SEGDES,IPT1
    1 CONTINUE
 
      SEGSUP ICPR
      SEGDES,MELEME
      SEGDES,MCHPOI
      SEGDES MMATRI
      SEGDES,MIDUA
      SEGDES,MHARK
      SEGDES,MINCPO
      MVECTX=MVECTD
C
      IF(IIMPI.EQ.3) WRITE(IOIMP,1002)MVECTD
 1002 FORMAT('  SUBROUTINE CHV2 : POINTEUR DU VECTEUR =',I5)
*      SEGDES MVECTD
      RETURN
      END