C PAQLIG SOURCE CHAT 07/10/29 21:25:25 5940 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 CCOPTIO -INC SMCOORD C INTEGER II,JJ,ITE,NELEM,IPOIT,N1,N2 SEGMENT ICPR(XCOOR(/1)/(IDIM+1)) SEGMENT JCPR(XCOOR(/1)/(IDIM+1)) 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