Esope source files

   1 : C CRECH2    SOURCE    CHAT      09/10/12    21:15:01     6526           
   2 :       SUBROUTINE CRECH2(KCHPOI,mvectx,mvecri,icle)                                    
   3 : *
   4 : * cree uun cpoint à partir d'un vecteur issu d'une resolution
   5 : * a partir des info stockees dans mvecri (qui lui meme est rempli par 
   6 : * crech3
   7 : * 
   8 : * si ICLE=1 on fait un vecteur primal ;  si =2 un dual                                                                   
   9 :       IMPLICIT INTEGER(I-N)
  10 :       IMPLICIT REAL*8(A-H,O-Z)
  11 : -INC CCOPTIO                                                                    
  12 : -INC SMCHPOI                                                      
  13 : -INC SMVECTD
  14 : -INC TMVECRIG                                                                                                                                                                                                     
  15 :       SEGACT,mvecri                                                                                                
  16 :       NSOUPO= MELZON(/1)
  17 :       NAT=1                                                                 
  18 :       SEGINI,MCHPOI                                                             
  19 :       IFOPOI=IFOMOD                                                             
  20 :       MTYPOI='        '
  21 :       MOCHDE='                                 '
  22 : C                                                                               
  23 : C  ****  ON VA FABRIQUER LES SEGMENTS MSOUPO POUR LES REMPLIR IL FAUT           
  24 : C  **** CONNAITRE LES INCONNUES DU SOUS CHAMPS ET L'OBJET GEOMETRIQUE           
  25 : C  ****  SUPPORT                                                                
  26 : C                                                                               
  27 :       DO 100 I=1,NSOUPO                                                         
  28 : C                                                                               
  29 : C  **** ON CHERCHE D'ABORD LA LISTE DES INCONNUES A PARTIR DE LA                
  30 : C  **** VALEUR DE IBINN ET ON REMPLIT NOCOMP                                    
  31 : C                                                                               
  32 :       nc= NUMNOM(i)  
  33 :       n=numnoe(i)                                        
  34 :       SEGINI,MSOUPO                                                             
  35 :       IPCHP(I)=MSOUPO                                                           
  36 :       IB=0                                                                      
  37 :       DO 14 J=1,NC 
  38 :       IF(ICLE.EQ.1)NOCOMP(J)= NAMINC(I,j)
  39 :       IF(ICLE.EQ.2)NOCOMP(J)= NAMDUA(I,j)                                                             
  40 :       NOHARM(J)=NUMHAR(I,J)                                                   
  41 :    14 CONTINUE                                                 
  42 : C                                                                               
  43 : C  ****  ON CHERCHE COMBIEN DE NOEUD DANS L'OBJET MELEME,ON LE CREE             
  44 : C                                                                               
  45 :                                                             
  46 :                                                                   
  47 :       SEGINI,MPOVAL                                                             
  48 :       IGEOC=melzon(I)
  49 :       ipoval=mpoval                                                            
  50 :  100  CONTINUE
  51 : * remplissage des vpocha
  52 :       mvectd=mvectx
  53 :       segact mvectd
  54 :       do ia=1,vectbb(/1)
  55 :         izo= NUMZON(ia)
  56 :         msoupo=ipchp(izo)
  57 :         mpoval=ipoval
  58 :         i=NUNOLO(ia)
  59 :         j=NUINLO(ia)
  60 :         vpocha(i,j)=vectbb(ia)
  61 :       enddo
  62 : * desactivation du chpoint
  63 :       do ia= 1,ipchp(/1)
  64 :         msoupo=ipchp(ia)
  65 :         mpoval=ipoval
  66 :         segdes mpoval
  67 :         segdes msoupo
  68 :       enddo
  69 :                                                                   
  70 :                                                           
  71 :       SEGDES,mvecri                                                             
  72 :       KCHPOI=MCHPOI                                                             
  73 :       SEGDES,MCHPOI                                                           
  74 :       RETURN                                                                    
  75 :       END                                                                       
  76 :  
  77 :