Sources Esope | Cast3M

vch2
C VCH2      SOURCE    CB215821  20/11/25    13:42:10     10792          
C VCH1      SOURCE    PV        15/02/19    21:16:14     8406
      SUBROUTINE VCH2 (MMATRX,MVECTX,ISOLU,KRIGI)
 
C
C  **** A PARTIR D UN OBJET DE TYPE MATRICE TRANSFORME UN VECTEUR EN
C  **** CHPOIN DE TYPE SECOND MEMBRE
 
C  **** KRIGI EST LE POINTEUR DE LA RIGIDITE.SERT A SAVOIRE SI LA GEOM
C  **** EXISTE DEJA.
C
      IMPLICIT INTEGER(I-N)
-INC SMMATRI
-INC SMCHPOI
-INC SMELEME
-INC PPARAM
-INC CCOPTIO
-INC SMVECTD
-INC SMRIGID
-INC TMTRAV
C
      IF(IIMPI.EQ.3) WRITE(IOIMP,3000) MMATRX,MVECTX
 3000 FORMAT('   OPERATEUR VCH1 : POINTEUR DE LA MATRICE=',I5,
     1                        '   POINTEUR DU VECTEUR=',I5)
C
C  ****  ACTIVATION DES SEGMENTS
C
      MRIGID=KRIGI
      SEGACT,MRIGID
      IMGEOQ=IMGEO1
 
      MMATRI=MMATRX
      SEGACT,MMATRI
      MILIGN=IILIGN
      SEGACT,MILIGN
      INC=IPNO(/1)
      SEGDES,MILIGN
      MINCPO=IINCPO
      SEGACT,MINCPO
      MIMIK=IIMIK
      SEGACT,MIMIK
      MHARK=IHARK
      SEGACT,MHARK
      NNIN=IMIK(/2)
      midua=iidua
      segact midua
      MVECTD=MVECTX
      SEGACT MVECTD
C
C  ****  CREATION D'UN SEGMENT DE TYPE MCHPOI(VOIR SMCHPOI)
C
 
      if( ivecri.eq.0) then
      NND=VECTBB(/1)
      MELEME=IGEOMA
      SEGACT,MELEME
      NNNOE=NUM(/2)
      SEGINI,MTRAV
      DO 40 ITYU=1,NNNOE
      IGEO(ITYU)=NUM(1,ITYU)
   40 CONTINUE
      SEGDES,MELEME
      DO    ITYU=1,NNIN
       NHAR(ITYU)=IHAR(ITYU)
       INCO(ITYU)=IMIK(ITYU)
      ENDDO
      DO  I=1,NNNOE
      DO  J=1,NNIN
      IK=INCPO(J,I)
      IF(IK.EQ.0)  GO TO 23
      IBIN(J,I)=ik
      BB(J,I)=VECTBB(IK)
   23 CONTINUE
      ENDDO
      ENDDO
       segact mrigid*mod
       ichoa=ichole
       if(ichole.eq.0) then
         ichole = mmatri
       endif
       CALL CRECH3(MTRAV,ISOLU,nnd,mrigid)
       ichole=ichoa
       SEGSUP,MTRAV
      else
       lvecri=ivecri
       CALL CRECH2(ISOLU,mvectx,lvecri,2)
      endif
 
      SEGDES,MINCPO
      SEGDES,MIMIK
      segdes midua
      SEGDES,MMATRI
      SEGDES,MHARK
*      SEGDES MVECTD
      SEGDES,MRIGID
      IF(IIMPI.EQ.3) WRITE(IOIMP,3001) ISOLU
 3001 FORMAT('  SUBROUTINE VCH1 : POINTEUR DE L'' OBJET CHPOINT=',I5)
      RETURN
      END