1 : C ELCCNO SOURCE CHAT 06/03/29 21:19:49 5360 2 : C 3 : C 4 : SUBROUTINE ELCCNO(ICODE,IDE,ITRNO2,NBNMX2,NBE, 5 : > ITRNOE,NBNMAX,ITRTRI,NBCMAX, 6 : > ITVL,NITMAX, 7 : > COORD,IDIMC,NBCOOR,NBCOMX,iarr) 8 : C ***************************************************************** 9 : C OBJET ELCCNO : CALCUL LES NOEUDS MILIEU (MANQUANT) D'UN MAILLAGE 10 : C 11 : C EN ENTREE : 12 : C ---------- LE MAILLAGE A REMPLIR ----------------------- 13 : C ICODE : CODE DES ELEMENTS DE ITRNOE 14 : C ITRNOE : NOEUDS DES ELEMENTS (AVEC NOEUDS MILIEU) 15 : C IFARSN : FONCTION QUI RENVOI LES SOMMETS D'UNE ARETE (ELARSN) 16 : C IFCCPO : FONCTION QUI CALCUL LES POINTS MILIEU 17 : C ---------- LE MAILLAGE SANS NOEUDS --------------------- 18 : C ITRNOE : IDEM ITRNO2 (SANS NOEUDS MILIEU) 19 : C ITRTRI : TABLEAU DES ELEMENTS VOISINS 20 : C NBNMAX : NOMBRE DE NOEUDS D'UN ELEMENT 21 : C NBE : NOMBRE D'ELEMENTS = NBE2 22 : C ----------TABLEAU DE TRAVAIL --------------------------- 23 : C ITVL : TABLEAU D'ENTIERS 24 : C NITMAX : TAILLE DE ITVL 25 : C ----------TABLEAU DE TRAVAIL --------------------------- 26 : C COORD : TABLEAU DES COORDONNEES 27 : C IDIMC : DIMENSION DE L'ESPACE 28 : C NBCOOR : NOMBRE DE POINTS DANS COORD 29 : C 30 : C EN SORTIE : 31 : C ITRNOE : NOEUDS DES ELEMENTS AVEC NOEUDS MILIEU 32 : C iarr : CODE D'ERREUR 33 : C ***************************************************************** 34 : IMPLICIT INTEGER(I-N) 35 : INTEGER ICODE,IDE,ITRNO2(*),NBNMX2,NBE 36 : INTEGER ITRNOE(*),NBNMAX,ITRTRI(*),NBCMAX 37 : INTEGER ITVL(*),NITMAX 38 : REAL*8 COORD(*) 39 : INTEGER IDIMC,NBCOOR,NBCOMX,iarr 40 : C 41 : C 42 : INTEGER IEL,NBAR,INDAR,INDSO(2),INDNO(1),NBNO,NUMSO(2),NUMNO,INO 43 : INTEGER NOETRI,NOEMAX 44 : REAL*8 XYZ(3) 45 : INTEGER INTSO(24),INTNO(100),I,NBSOM,NBNOE 46 : INTEGER NBS 47 : C 47 : CALL ELSOVO(ICODE,INTNO,NBSOM,NBNOE,iarr) 48 : C WRITE(6,*) 'ICODE, NBSOM =',ICODE,NBSOM 49 : IF( iarr.NE.0 )THEN 49 : CALL DSERRE(1,iarr,'ELCCNO ',' APPEL ELSOVO') 50 : GOTO 9999 51 : ENDIF 51 : CALL STNBAR(IDE,NBSOM,NBAR) 52 : C 52 : CALL ELARSN(ICODE,INTSO,INTNO,NBNO,iarr) 53 : IF( iarr.NE.0 )THEN 53 : CALL DSERRE(1,iarr,'ELCCNO ',' APPEL ELARSN') 54 : GOTO 9999 55 : ENDIF 56 : C 57 : C WRITE(6,*) 'IDE,NBNMAX,NBARETE = ',IDE,NBNMAX,NBAR 58 : C 59 : DO 200 IEL=1,NBE 60 : C WRITE(6,*) '===========================================' 61 : C WRITE(6,*) ' ELEMENT ',IEL 62 : C WRITE(6,*) '===========================================' 63 : DO 100 INDAR=1,NBAR 64 : C 65 : C ================================= 66 : C ---- EXTRACTION DES ARETES ---- 67 : C ================================= 68 : C 69 : C ---- INDICES RELATIFS ---- 70 : C 71 : INDSO(1) = INTSO((INDAR-1)*2+1) 72 : INDSO(2) = INTSO((INDAR-1)*2+2) 73 : NBNO = INTNO(INDAR+1)-INTNO(INDAR) 74 : DO 5 I=1,NBNO 75 : INDNO(I) = INTNO(INTNO(INDAR-1+I)) 76 : 5 CONTINUE 77 : C 78 : C WRITE(6,*) INDAR,' ARETE DE (S1,S2,N)', 79 : C > INDSO(1),INDSO(2),INDNO(1) 80 : C 81 : C ---- NUMERO ABSOLUS DANS ITRNO1 ------ 82 : NUMSO(1) = ITRNO2((IEL-1)*NBNMX2+INDSO(1)) 83 : NUMSO(2) = ITRNO2((IEL-1)*NBNMX2+INDSO(2)) 84 : DO 10 INO=1,NBNO 85 : NUMNO = ITRNO2((IEL-1)*NBNMX2+INDNO(INO)) 86 : IF( NUMNO.EQ. 0 )THEN 87 : C ================================== 88 : C ---- CALCUL DES NOEUDS MILIEU ---- 89 : C ================================== 89 : CALL ELCCPO(COORD((NUMSO(1)-1)*IDIMC+1), 90 : > COORD((NUMSO(2)-1)*IDIMC+1),IDIMC, 91 : > ICODE,INDAR,INO,NBNO,XYZ,iarr) 92 : NOEMAX = 0 92 : CALL S0AJNO(XYZ,COORD,IDIMC,NBCOOR,NBCOMX, 93 : > NOETRI,NOEMAX,NUMNO,iarr) 94 : C WRITE(6,*) 'NOEUD CREE = ',NUMNO 95 : NBS = 2 95 : CALL NOAJAR(NUMSO,IEL,NBS,NUMNO,NBNO, 96 : > ICODE,IDE,ITRNO2,NBNMX2,NBE, 97 : > ITRNOE,NBNMAX,ITRTRI,NBCMAX, 98 : > ITVL,NITMAX,iarr) 99 : C ELSE 100 : C WRITE(6,*) 'ENTRE ',NUMSO(1),NUMSO(2), 101 : C > 'LE NOEUD EXISTE DEJA ',NUMNO 102 : ENDIF 103 : 10 CONTINUE 104 : 105 : 100 CONTINUE 106 : 200 CONTINUE 107 : C 108 : 9999 END 109 : 110 : 111 :
© Cast3M 2003 - All rights reserved.
Disclaimer