1 : C SORIEN SOURCE CHAT 06/03/29 21:34:32 5360 2 : C 3 : C 4 : SUBROUTINE SORIEN(IDE,ITRNOE,NBNMAX,ITRTRI,NBCMAX,NBE, 5 : > ITVL,NBITL,ITRAMA,NCC,iarr) 6 : C ***************************************************************** 7 : C OBJET : ORIENTE UN MAILLAGE 8 : C LES ELEMENTS DE CHAQUE COMPOSANTE CONNEXE SONT ORIENTES 9 : C DE LA MEME FACON 10 : C EN ENTREE: 11 : C IDE : (1..3) DIMENSION DES ELEMENTS 12 : C ITRNOE: LES NOEUDS DES ELEMENTS 13 : C NBNMAX : (2..8) NOMBRE DE NOEUDS MAXIMUM DES ELEMENTS 14 : C ITRTRI: LES VOISINS DES ELEMENTS 15 : C NBCMAX : (2..6) NOMBRE DE COTES MAXIMUM DES ELEMENTS 16 : C NBE : NOMBRE D'ELEMENTS DU MAILLAGE 17 : C ITVL,NBITL : TABLEAU DE TRAVAIL NBITL < (NBCMAX+1)*NBE 18 : C ITRAMA : " " " " DE TAILLE = NBE 19 : C EN SORTIE: 20 : C ITRNOE: MIS A JOUR 21 : C ITRTRI: MIS A JOUR 22 : C NCC : NOMBRE DE COMPOSANTES CONNEXES 23 : C iarr : CODE D'ERREUR 0 => OK 24 : C -1 => DONNEES INCOHERENTES 25 : C -2 => TABLEAU ITVL EST TROP PETIT 26 : C CONDITION D'APPLICATION : ARETE, TRIANGLE, QUADRANGLE, TETRA 27 : C ***************************************************************** 28 : IMPLICIT INTEGER(I-N) 29 : INTEGER IDE,ITRNOE(*),NBNMAX,ITRTRI(*),NBCMAX,NBE 30 : INTEGER ITVL(*),NBITL,ITRAMA(*),NCC,iarr 31 : C 32 : DIMENSION ITT(7) 33 : EXTERNAL SFAIDE 34 : INTEGER SFAIDE 35 : INTEGER I,J,ITT,NBTRA,IP,IM,NOP,II,N1,N2 36 : C 37 : NCC = 0 38 : IF( NBE.EQ. 0 )GOTO 9999 39 : IF( NBE.LT. 0 )THEN 40 : iarr = -1 41 : GOTO 9999 42 : ENDIF 43 : IF( (NBCMAX+1).GT.NBITL )THEN 44 : iarr = -2 45 : GO TO 9999 46 : ENDIF 47 : C 48 : C INITIALISATION 49 : C -------------- 50 : DO 10 I=1,NBE 51 : ITRAMA(I) = 0 52 : 10 CONTINUE 53 : C 54 : C ON BOUCLE SUR LES COMPOSANTES CONNEXES 55 : C --------------------------------------- 56 : C 57 : DO 70 I=1,NBE 58 : IF( ITRAMA(I) .EQ. 0 )THEN 59 : NCC = NCC + 1 60 : ITVL(1) = I 61 : DO 20 J=1,NBCMAX 62 : ITVL(J+1) = ITRTRI((I-1)*NBCMAX+J) 63 : 20 CONTINUE 64 : ITRAMA(I) = 1 65 : NBTRA = NBCMAX+1 66 : C 67 : C ON BOUCLE TANTQUE ITVL N'EST PAS VIDE 68 : C ---------------------------------------- 69 : C 70 : C TRANSFERT DU PERE TT(N+1) ET DE SES N VOISINS 71 : C --------------------------------------------- 72 : 30 DO 40 J=1,NBCMAX+1 73 : ITT(J) = ITVL(NBTRA-J+1) 74 : 40 CONTINUE 75 : NBTRA = NBTRA-(NBCMAX+1) 76 : C 77 : C TRAITEMENT DES N VOISINS 78 : C ------------------------ 79 : DO 60 J=1,NBCMAX 80 : IF(( ITT(J) .NE. 0 ) .AND. (ITRAMA(ITT(J)) .NE. 1 )) THEN 81 : N1 = NBNMAX 82 : N2 = NBNMAX 83 : IF((NBNMAX.EQ.4).AND.(IDE.EQ.2))THEN 84 : C --- CAS D'UN MAILLAGE MIXTE QUADRANGLES, TRIANGLES-- 85 : IF(ITRNOE((ITT(J)-1)*NBNMAX+4).EQ.0)N1= 3 86 : IF(ITRNOE((ITT(NBCMAX+1)-1)*NBNMAX+4).EQ.0)N2= 3 87 : ENDIF 88 : NOP=SFAIDE(ITRNOE((ITT(J)-1)*NBNMAX+1), 89 : > ITRNOE((ITT(NBCMAX+1)-1)*NBNMAX+1),N1,N2,IDE,IM,IP) 90 : C IL Y A UN BUG 91 : C ------------- 92 : IF( NOP .EQ. 0 )THEN 93 : iarr = -1 94 : GO TO 9999 95 : ENDIF 96 : IF( NOP .LT. 0 ) THEN 96 : CALL SINVOR(IM,N1,IDE,ITRNOE((ITT(J)-1)*NBNMAX+1), 97 : > ITRTRI((ITT(J)-1)*NBCMAX+1)) 98 : ENDIF 99 : C SES VOISINS SERONT A TRAITER 100 : C ---------------------------- 101 : IF( (NBTRA+NBCMAX+1).GT.NBITL )THEN 102 : iarr = -2 103 : GO TO 9999 104 : ENDIF 105 : ITVL(NBTRA+1) = ITT(J) 106 : DO 50 II=1,NBCMAX 107 : ITVL(NBTRA+II+1) = ITRTRI(((ITT(J)-1)*NBCMAX)+II) 108 : 50 CONTINUE 109 : NBTRA = NBTRA + (NBCMAX+1) 110 : ITRAMA(ITT(J)) = 1 111 : ENDIF 112 : 60 CONTINUE 113 : IF( NBTRA .GT. NBITL )THEN 114 : iarr = -2 115 : GO TO 9999 116 : ENDIF 117 : IF( NBTRA .NE. 0 )GO TO 30 118 : ENDIF 119 : 70 CONTINUE 120 : 9999 END 121 : 122 : 123 :
© Cast3M 2003 - All rights reserved.
Disclaimer