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