Sources Esope | Cast3M

chvns
C CHVNS     SOURCE    CB215821  20/11/25    13:19:43     10792          
      SUBROUTINE CHVNS(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
C ... ceux dépendant de MMATRI ...
 
      MMATRI=MMATRX
      SEGACT,MMATRI
 
      MILIGN=IILIGN
      SEGACT,MILIGN
      INC=IPNO(/1)
      SEGDES,MILIGN
C ... La taille de MVECTD est INC ...
      SEGINI,MVECTD
 
      MIDUA=IIDUA
      SEGACT,MIDUA
      IDU=IDUA(/2)
 
      MHARK=IHARDU
      SEGACT,MHARK
 
      MINCPO=IDUAPO
      SEGACT,MINCPO
 
      MELEME=IGEOMA
      SEGACT,MELEME
      N2=NUM(/2)
 
C ... ceux dépendant de MCHPOI ...
 
      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)
C    ... NC1 = taille de ICOR ...
         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(NOHARM(KI).NE.IHAR(J)) GO TO 10
C  ... dans ICOR on met la correspondance entre les composantes du champ
C      et les variables duales de la matrice, s'il y a un zero, alors !!! ...
               ICOR(KI)=J
               GO TO 11
   10       CONTINUE
   11    CONTINUE
 
         MPOVAL=IPOVAL
         SEGACT,MPOVAL
C    ... N = nombre de valeurs de chaque composante (=> noeuds) ...
         N=VPOCHA(/1)
         DO 20 J=1,N
C       ... K = n° d'ordre du noeud examiné dans la rigidité, 0 => !!! ...
            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
ccc  40        CONTINUE
            DO 2 LI=1,NC
C          ... KKIL = n° local dans la matrice de la composante LI ...
               KKIL=ICOR(LI)
               IF (KKIL.EQ.0) GOTO 55
 
C          ... KI = n° global du DDL dual ...
               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
         SEGSUP,ICOR
 
    1 CONTINUE
 
      SEGSUP ICPR
      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