Sources Esope | Cast3M

paqlig
C PAQLIG    SOURCE    PV        20/03/30    21:21:55     10567          
        SUBROUTINE PAQLIG(II,JJ)
      IMPLICIT INTEGER(I-N)
        IMPLICIT REAL*8(A-H,O-Z)
*
*  ii est un meleme de seg2 ou de seg3. on chzerche a reconstituer chaque ligne
* en sortie jj est un pointeur sur PAQUET qui contient la liste consecutive
* des noeuds formant une ligne, chaque ligne est séparé par un zero
C
-INC SMELEME
-INC CCGEOME
 
-INC PPARAM
-INC CCOPTIO
-INC SMCOORD
C
        INTEGER II,JJ,ITE,NELEM,IPOIT,N1,N2
        SEGMENT ICPR(nbpts)
        SEGMENT JCPR(nbpts)
        SEGMENT KON(ITE,nkon)
        segment ivoi(ite)
        SEGMENT IDCP(ITE)
        SEGMENT PAQUET
           INTEGER LIGNE(NELEM)
        ENDSEGMENT
 
 
        MELEME=II
        SEGACT MELEME
        SEGINI ICPR,JCPR
        ITE=0
        nkon=2
        IF (LISOUS(/1).NE.0) THEN
           CALL ERREUR(16)
           RETURN
        ENDIF
        K=ITYPEL
        IF (K.NE.KDEGRE(K)) THEN
           CALL ERREUR(16)
           RETURN
        ENDIF
        DO 1 J=1,K,K-1
           DO 2 L=1,NUM(/2)
              IPOIT=NUM(J,L)
               JCPR(IPOIT)=JCPR(IPOIT)+1
               nkon=max(nkon,jcpr(ipoit))
              IF (JCPR(IPOIT).EQ.3) then
                     interr(1)=ipoit
                        CALL ERREUR(-336)
              ENDIF
               IF( icpr(ipoit).eq.0) then
                    ITE=ITE+1
                    ICPR(IPOIT)=ITE
              ENDIF
   2       CONTINUE
   1    CONTINUE
*        write(6,*) ' ite nkon',ite,nkon
        nelem=ite*nkon
c Création du vecteur de connexions
c initialisation
        SEGINI KON,ivoi,paquet
C Remplissage
        DO 4 L=1,NUM(/2)
           N1=ICPR(NUM(1,L))
           N2=ICPR(NUM(K,L))
           ivoi(n1)=ivoi(n1)+1
           ivoi(n2)=ivoi(n2)+1
           KON(N1,ivoi(n1))=N2
           KON(N2,ivoi(n2))=n1
   4    CONTINUE
        SEGDES MELEME
        SEGINI IDCP
        DO 5 I=1,ICPR(/1)
           IF (ICPR(I).EQ.0) GOTO 5
              IDCP(ICPR(I))=I
  5     CONTINUE
        SEGSUP ICPR ,jcpr
C
C Création d'un vecteur contenant les paquets de lignes
      SEGINI PAQUET
      J=0
*      write(6,*) ' longueur du tableau' , ivoi(/1)
*      write(6,*) ( ivoi(iou),iou=1,ivoi(/1))
 100  continue
* on cherche un point de depart
      do 10 ip=1,ite
      if(mod(ivoi(ip),2).eq.1) go to 7
   10 continue
*  il n'y en a pas ...  fin
      go to 6
    7 ipd=ip
*      write(6,*) ' point de depart ' , idcp(ip)
      j=j+1
      ligne(j)= idcp(ipd)
  70  ipn=kon(ipd,ivoi(ipd))
      ivoi(ipd)=ivoi(ipd)-1
* mise a jour de kon et ivoi pour le nouveau point ipn
      do 8 io=1,ivoi(ipn)
        if(kon(ipn,io).eq.ipd) go to 9
   8  continue
      call erreur(5)
      segsup idcp,ivoi,kon
      return
   9  continue
      if(io.eq.ivoi(ipn)) then
         ivoi(ipn)=ivoi(ipn)-1
      else
         do 11 iu=io+1,ivoi(ipn)
  11     kon(ipn,iu-1)=kon(ipn,iu)
         ivoi(ipn)=ivoi(ipn)-1
      endif
      j=j+1
      ligne(j)=idcp(ipn)
      ipd=ipn
      if(ivoi(ipd).eq.0) then
        j=j+1
        ligne(j)=0
        go to 100
      endif
      go to 70
   6  continue
      nelem =j
      segsup idcp, ivoi,kon
      segadj paquet
      jj=paquet
      return
      end