Esope source files

   1 : C PAQLIG    SOURCE    CHAT      07/10/29    21:25:25     5940           
   2 :         SUBROUTINE PAQLIG(II,JJ)
   3 :       IMPLICIT INTEGER(I-N)
   4 :         IMPLICIT REAL*8(A-H,O-Z)
   5 : *
   6 : *  ii est un meleme de seg2 ou de seg3. on chzerche a reconstituer chaque ligne
   7 : * en sortie jj est un pointeur sur PAQUET qui contient la liste consecutive
   8 : * des noeuds formant une ligne, chaque ligne est séparé par un zero
   9 : C
  10 : -INC SMELEME
  11 : -INC CCGEOME
  12 : -INC CCOPTIO
  13 : -INC SMCOORD
  14 : C       
  15 :         INTEGER II,JJ,ITE,NELEM,IPOIT,N1,N2
  16 :         SEGMENT ICPR(XCOOR(/1)/(IDIM+1))
  17 :         SEGMENT JCPR(XCOOR(/1)/(IDIM+1))
  18 :         SEGMENT KON(ITE,nkon)
  19 :         segment ivoi(ite)
  20 :         SEGMENT IDCP(ITE)
  21 :         SEGMENT PAQUET
  22 :            INTEGER LIGNE(NELEM)
  23 :         ENDSEGMENT      
  24 :         
  25 :         
  26 :         MELEME=II
  27 :         SEGACT MELEME
  28 :         SEGINI ICPR,JCPR
  29 :         ITE=0
  30 :         nkon=2
  31 :         IF (LISOUS(/1).NE.0) THEN
  31 :            CALL ERREUR(16)
  32 :            RETURN
  33 :         ENDIF
  34 :         K=ITYPEL
  35 :         IF (K.NE.KDEGRE(K)) THEN
  35 :            CALL ERREUR(16)
  36 :            RETURN
  37 :         ENDIF
  38 :         DO 1 J=1,K,K-1
  39 :            DO 2 L=1,NUM(/2)
  40 :               IPOIT=NUM(J,L)
  41 :                JCPR(IPOIT)=JCPR(IPOIT)+1
  42 :                nkon=max(nkon,jcpr(ipoit))
  43 :               IF (JCPR(IPOIT).EQ.3) then
  44 :                      interr(1)=ipoit
  44 :                         CALL ERREUR(-336)
  45 :               ENDIF
  46 :                IF( icpr(ipoit).eq.0) then
  47 :                     ITE=ITE+1
  48 :                     ICPR(IPOIT)=ITE
  49 :               ENDIF
  50 :    2       CONTINUE
  51 :    1    CONTINUE
  52 : *        write(6,*) ' ite nkon',ite,nkon
  53 :         nelem=ite*nkon
  54 : c Création du vecteur de connexions
  55 : c initialisation
  56 :         SEGINI KON,ivoi,paquet
  57 : C Remplissage 
  58 :         DO 4 L=1,NUM(/2)
  59 :            N1=ICPR(NUM(1,L))
  60 :            N2=ICPR(NUM(K,L))
  61 :            ivoi(n1)=ivoi(n1)+1
  62 :            ivoi(n2)=ivoi(n2)+1
  63 :            KON(N1,ivoi(n1))=N2
  64 :            KON(N2,ivoi(n2))=n1
  65 :    4    CONTINUE         
  66 :         SEGDES MELEME
  67 :         SEGINI IDCP       
  68 :         DO 5 I=1,ICPR(/1)
  69 :            IF (ICPR(I).EQ.0) GOTO 5
  70 :               IDCP(ICPR(I))=I
  71 :   5     CONTINUE
  72 :         SEGSUP ICPR ,jcpr
  73 : C
  74 : C Création d'un vecteur contenant les paquets de lignes
  75 :       SEGINI PAQUET
  76 :       J=0
  77 : *      write(6,*) ' longueur du tableau' , ivoi(/1)
  78 : *      write(6,*) ( ivoi(iou),iou=1,ivoi(/1))
  79 :  100  continue
  80 : * on cherche un point de depart
  81 :       do 10 ip=1,ite
  82 :       if(mod(ivoi(ip),2).eq.1) go to 7 
  83 :    10 continue 
  84 : *  il n'y en a pas ...  fin
  85 :       go to 6
  86 :     7 ipd=ip
  87 : *      write(6,*) ' point de depart ' , idcp(ip)
  88 :       j=j+1
  89 :       ligne(j)= idcp(ipd)
  90 :   70  ipn=kon(ipd,ivoi(ipd))
  91 :       ivoi(ipd)=ivoi(ipd)-1
  92 : * mise a jour de kon et ivoi pour le nouveau point ipn
  93 :       do 8 io=1,ivoi(ipn)
  94 :         if(kon(ipn,io).eq.ipd) go to 9
  95 :    8  continue
  95 :       call erreur(5)
  96 :       segsup idcp,ivoi,kon
  97 :       return
  98 :    9  continue
  99 :       if(io.eq.ivoi(ipn)) then
 100 :          ivoi(ipn)=ivoi(ipn)-1
 101 :       else
 102 :          do 11 iu=io+1,ivoi(ipn)
 103 :   11     kon(ipn,iu-1)=kon(ipn,iu)
 104 :          ivoi(ipn)=ivoi(ipn)-1
 105 :       endif
 106 :       j=j+1
 107 :       ligne(j)=idcp(ipn)
 108 :       ipd=ipn
 109 :       if(ivoi(ipd).eq.0) then
 110 :         j=j+1
 111 :         ligne(j)=0
 112 :         go to 100  
 113 :       endif
 114 :       go to 70
 115 :    6  continue 
 116 :       nelem =j
 117 :       segsup idcp, ivoi,kon
 118 :       segadj paquet
 119 :       jj=paquet
 120 :       return
 121 :       end  
 122 : 
 123 : 
 124 : 
 125 : 
 126 : 
 127 : 
 128 : 
 129 : 
 130 : 
 131 : 
 132 :  
 133 :  
 134 :  
 135 :