1 : C NOAJAR SOURCE CHAT 06/03/29 21:28:07 5360 2 : C 3 : C 4 : SUBROUTINE NOAJAR(NUMSO,IEL,NBS,NUMNO,NBNO, 5 : > ICODE,IDE,ITRNO2,NBNMX2,NBE2, 6 : > ITRNOE,NBNMAX,ITRTRI,NBCMAX, 7 : > ITVL,NITMAX,iarr) 8 : C ***************************************************************** 9 : C OBJET NOAJAR : AJOUTE DES NOEUDS SUR UNE ARETE 10 : C 11 : C EN ENTREE : 12 : C ---------- NOEUD A AJOUTER ----------------------- 13 : C NUMSO(1): SOMMET ORIGINE DE L'ARETE 14 : C NUMSO(2): SOMMET EXTREMITE DE L'ARETE 15 : C IEL : UN ELEMENT INCIDENT A NUMSO1 ET/OU NUMSO2 16 : C NBS : NOMBRE DE SOMMET QUE IEL CONTIENT (1 OU 2) 17 : C NUMNO : LES NUMEROS DES NOEUDS A AJOUTER 18 : C NBNO : LE NOMBRE DE NOEUD A AJOUTER 19 : C ---------- LE MAILLAGE A REMPLIR ----------------------- 20 : C ICODE : CODE DES ELEMENTS DE ITRNO2 21 : C ITRNO2 : NOEUDS DES ELEMENTS (A REMPLIR) 22 : C NBNMX2 : NOMBRE DE NOEUDS D'UN ELEMENT 23 : C NBE2 : NOMBRE D'ELEMENTS 24 : C ---------- LE MAILLAGE SANS NOEUDS --------------------- 25 : C ITRNOE : IDEM ITRNO2 (SANS NOEUDS MILIEU) 26 : C ITRTRI : TABLEAU DES ELEMENTS VOISINS 27 : C NBNMAX : NOMBRE DE NOEUDS D'UN ELEMENT 28 : C NBE : NOMBRE D'ELEMENTS = NBE2 29 : C ----------TABLEAU DE TRAVAIL --------------------------- 30 : C ITVL : TABLEAU D'ENTIERS 31 : C NITMAX : TAILLE DE ITVL 32 : C 33 : C EN SORTIE : 34 : C ITRNO2 : NOEUDS DES ELEMENTS AVEC NOEUDS MILIEU 35 : C iarr : CODE D'ERREUR 36 : C ***************************************************************** 37 : IMPLICIT INTEGER(I-N) 38 : INTEGER NUMSO(*),IEL,NBS,NUMNO(*),NBNO 39 : INTEGER ICODE,IDE,ITRNO2(*),NBNMX2,NBE2 40 : INTEGER ITRNOE(*),NBNMAX,ITRTRI(*),NBCMAX 41 : INTEGER ITVL(*),NITMAX 42 : INTEGER iarr 43 : C 44 : INTEGER NBNAR 45 : INTEGER NBNOCO,NBCONN 46 : INTEGER IEL2,INDSO2(2),INO,INDNO(1),I,NBNO2 47 : C 48 : C ================================== 49 : C ---- RECHERCHE DES ARETES DANS ITRNOE ---- 50 : C ================================== 51 : NBNAR = 2 51 : CALL TTCONN(NBNAR,NUMSO,IEL,NBS,ITRNOE,NBNMAX,ITRTRI,NBCMAX, 52 : > ITVL,NBCONN,NITMAX,NBNOCO,iarr) 53 : IF( NBNOCO.LT.NBNAR )THEN 54 : iarr = -1 54 : CALL DSERRE(1,iarr,'NOAJAR ',' APPEL TTCON') 55 : C PRINT *,' ON A PERDU L ARETE : ',(NUMSO(INO),INO=1,NBNAR) 56 : C PRINT *,' NBNOCO = : ',NBNOCO 57 : C PRINT *,' NBCONN = : ',NBCONN 58 : C PRINT *,' NITMAX = : ',NITMAX 59 : C PRINT *,' iarr = : ',iarr 60 : GOTO 9999 61 : ENDIF 62 : C PRINT *,NBCONN,' ELEMENT(S) SUR L ARETE (', 63 : C > NUMSO(1),NUMSO(2),') = ', 64 : C > (ITVL(INO),INO=1,NBCONN) 65 : C 66 : DO 100 I=1,NBCONN 67 : C 68 : C ---- POUR CHAQUE ELEMENT IL FAUT RETROUVER L'INDICE DU NOEUD ---- 69 : C 70 : IEL2 = ITVL(I) 71 : C ---- NUMERO ABSOLU DANS ITRNO2 ------ 72 : INDSO2(1) = 0 73 : INDSO2(2) = 0 74 : DO 20 INO=1,NBNMX2 75 : IF( ITRNO2((IEL2-1)*NBNMX2+INO).EQ.NUMSO(1)) 76 : > INDSO2(1) = INO 77 : IF( ITRNO2((IEL2-1)*NBNMX2+INO).EQ.NUMSO(2)) 78 : > INDSO2(2) = INO 79 : 20 CONTINUE 80 : C ---- NUMERO RELATIFS ------ 80 : CALL ELSNAR(ICODE,INDSO2,INDNO,NBNO2,iarr) 81 : IF((INDNO(1).GT.20).OR.(INDNO(1).LT.1))THEN 82 : iarr = -1 82 : CALL DSERRE(1,iarr,'NOAJAR ',' APPEL ELSNAR') 83 : C PRINT *,'INDSO2,INDNO ',INDSO2(1),INDSO2(2),INDNO(1) 84 : GOTO 9999 85 : ENDIF 86 : IF( iarr.NE.0 )THEN 86 : CALL DSERRE(1,iarr,'NOAJAR ',' APPEL ELSNAR') 87 : GOTO 9999 88 : ENDIF 89 : IF( NBNO.NE.NBNO2 )THEN 90 : iarr = -1 91 : C PRINT *,'NBNO != NBNO2 ',NBNO,NBNO2 91 : CALL DSERRE(1,iarr,'NOAJAR ',' NOMBRE DE NOEUD SUR L ARETE') 92 : GOTO 9999 93 : ENDIF 94 : DO 30 INO=1,NBNO2 95 : C PRINT *,'ON AJOUTE LE NOEUD ',NUMNO(INO), 96 : C > ' A L ELEMENT ',IEL2, 97 : C > ' EN POSITION : ',INDNO(INO) 98 : ITRNO2((IEL2-1)*NBNMX2+INDNO(INO)) = NUMNO(INO) 99 : 30 CONTINUE 100 : 100 CONTINUE 101 : C 102 : 9999 END 103 : 104 : 105 :
© Cast3M 2003 - All rights reserved.
Disclaimer