Sources Esope | Cast3M

crech2
C CRECH2    SOURCE    CB215821  25/04/23    21:15:08     12247          
      SUBROUTINE CRECH2(KCHPOI,mvectx,mvecri,icle)
*
* cree uun cpoint à partir d'un vecteur issu d'une resolution
* a partir des info stockees dans mvecri (qui lui meme est rempli par
* crech3
*
* si ICLE=1 on fait un vecteur primal ;  si =2 un dual
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)
 
-INC PPARAM
-INC CCOPTIO
-INC SMCHPOI
-INC SMCOORD
-INC SMVECTD
-INC TMVECRIG
      SEGACT,mvecri
      NSOUPO= MELZON(/1)
      NAT=1
      SEGINI,MCHPOI
      IFOPOI=IFOUR
      MTYPOI='        '
      MOCHDE='                                 '
C
C  ****  ON VA FABRIQUER LES SEGMENTS MSOUPO POUR LES REMPLIR IL FAUT
C  **** CONNAITRE LES INCONNUES DU SOUS CHAMPS ET L'OBJET GEOMETRIQUE
C  ****  SUPPORT
C
      DO 100 I=1,NSOUPO
C
C  **** ON CHERCHE D'ABORD LA LISTE DES INCONNUES A PARTIR DE LA
C  **** VALEUR DE IBINN ET ON REMPLIT NOCOMP
C
      nc= NUMNOM(i)
      n=numnoe(i)
      SEGINI,MSOUPO
      IPCHP(I)=MSOUPO
      IB=0
      DO 14 J=1,NC
      IF(ICLE.EQ.1)NOCOMP(J)= NAMINC(I,j)
      IF(ICLE.EQ.2)NOCOMP(J)= NAMDUA(I,j)
      NOHARM(J)=NUMHAR(I,J)
   14 CONTINUE
C
C  ****  ON CHERCHE COMBIEN DE NOEUD DANS L'OBJET MELEME,ON LE CREE
C
 
 
      SEGINI,MPOVAL
      IGEOC=melzon(I)
      ipoval=mpoval
 100  CONTINUE
* remplissage des vpocha
      mvectd=mvectx
      segact mvectd
      do ia=1,vectbb(/1)
        izo= NUMZON(ia)
        msoupo=ipchp(izo)
        mpoval=ipoval
        i=NUNOLO(ia)
        j=NUINLO(ia)
        vpocha(i,j)=vectbb(ia)
      enddo
* desactivation du chpoint
      do ia= 1,ipchp(/1)
        msoupo=ipchp(ia)
        mpoval=ipoval
        segdes mpoval
        segdes msoupo
      enddo
 
 
      SEGDES,mvecri
      KCHPOI=MCHPOI
      SEGDES,MCHPOI
      RETURN
      END