1 : C FCUB20 SOURCE CHAT 05/01/12 23:57:41 5004 2 : C 3 : C 4 : C 5 : SUBROUTINE FCUB20(ITYPE,INDONN,IRESUL,NBRESU) 6 : C ********************************************************************** 7 : C OBJET FCUB20 : RENVOI LES INFO SUR LE CUB20 8 : C EN ENTREE : 9 : C ITYPE : TYPE DES INFORMATION SOUHAITEES 10 : C INDONN : DONNEES POUR LA REQUETE FORMULEE 11 : C EN SORTIE : 12 : C IRESUL : TABLEAU D'ENTIER CONTENANT LE RESULTAT 13 : C NBRESU : NOMBRE D'INFORMATION CONTENU DANS IRESUL 14 : C 15 : C ********************************************************************** 16 : IMPLICIT INTEGER(I-N) 17 : INTEGER ITYPE,INDONN(*),IRESUL(*),NBRESU 18 : C 19 : C 20 : INTEGER INDMIN,INDMAX,I 21 : C ========================== 22 : C ------------- DESCRIPTION DE L'ELEMENT -------------------- 23 : C ========================== 24 : INTEGER NSOAR,NNOAR,NSOFA,NNOFA,NSOVO,NNOVO,NNOTOT 25 : PARAMETER ( NSOAR = 24, NNOAR = 25, NSOFA = 31, NNOFA = 1, 26 : > NSOVO = 8, NNOVO = 1, NNOTOT = 12 ) 27 : INTEGER ISOAR(NSOAR),INOAR(NNOAR),ISOFA(NSOFA),INOFA(NNOFA) 28 : INTEGER ISOVO(NSOVO),INOVO(NNOVO),INOTOT(NNOTOT) 29 : DATA ISOAR / 1,3,3,5,5,7,7,1,1,13,3,15,5,17,7,19,13,15, 30 : > 15,17,17,19,19,13 / 31 : DATA INOAR /14,15,16,17,18,19,20,21,22,23,24,25,26, 32 : > 2,4,6,8,9,10,11,12,14,16,18,20/ 33 : DATA ISOFA / 7,11,15,19,23,27,31, 34 : > 1,3,5,7, 1,13,15,3, 3,15,17,5, 35 : > 5,17,19,7, 7,19,13,1, 13,19,17,15 / 36 : 37 : DATA INOFA / 0 / 38 : DATA ISOVO / 1,3,5,7,13,15,17,19 / 39 : DATA INOVO / 0 / 40 : DATA INOTOT /2,4,6,8,9,10,11,12,14,16,18,20 / 41 : C ------------------------------------------------------------ 42 : C 43 : GOTO(10,20,30,40,50,60,70,80,90) ITYPE 44 : 1 NBRESU = 0 45 : GOTO 9999 46 : C 47 : C ============================================================ 48 : C 1 : LES INDICES DES NOEUDS MILIEU DES SOMMETS (D'UNE ARETE) 49 : C ============================================================ 50 : 10 CONTINUE 51 : INDMIN = MIN(INDONN(1),INDONN(2)) 52 : INDMAX = MAX(INDONN(1),INDONN(2)) 53 : NBRESU = 1 54 : IF( INDMAX.LE.8 )THEN 54 : CALL ELSN2D( INDMIN,INDMAX,8,IRESUL ) 55 : GOTO 9999 56 : ENDIF 57 : IF( INDMIN.GE.13)THEN 57 : CALL ELSN2D( INDMIN-12,INDMAX-12,8,IRESUL ) 58 : IRESUL(1) = IRESUL(1) + 12 59 : GOTO 9999 60 : ENDIF 61 : IRESUL(1) = 9 + INDMIN / 2 62 : GOTO 9999 63 : C 64 : C ============================================================ 65 : C 2 : LES INDICES DES SOMMETS D'UNE ARETE 66 : C ============================================================ 67 : 20 CONTINUE 68 : NBRESU = NSOAR 69 : DO 21 I=1,NBRESU 70 : IRESUL(I) = ISOAR(I) 71 : 21 CONTINUE 72 : GOTO 9999 73 : C 74 : C ============================================================ 75 : C 3 : LES INDICES DES NOEUDS MILIEU D'UNE ARETE 76 : C ============================================================ 77 : 30 CONTINUE 78 : NBRESU = NNOAR 79 : DO 31 I=1,NBRESU 80 : IRESUL(I) = INOAR(I) 81 : 31 CONTINUE 82 : GOTO 9999 83 : C 84 : C ============================================================ 85 : C 4 : LES INDICES DES NOEUDS MILIEU DES SOMMETS (D'UNE FACE) 86 : C ============================================================ 87 : 40 CONTINUE 88 : NBRESU = 0 89 : GOTO 9999 90 : C 91 : C ============================================================ 92 : C 5 : LES INDICES DES SOMMETS D'UNE FACE 93 : C ============================================================ 94 : 50 CONTINUE 95 : NBRESU = NNOAR 96 : DO 51 I=1,NBRESU 97 : IRESUL(I) = ISOFA(I) 98 : 51 CONTINUE 99 : GOTO 9999 100 : C 101 : C ============================================================ 102 : C 6 : LES INDICES DES NOEUDS MILIEU D'UNE FACE 103 : C ============================================================ 104 : 60 CONTINUE 105 : NBRESU = NNOFA 106 : DO 61 I=1,NBRESU 107 : IRESUL(I) = INOFA(I) 108 : 61 CONTINUE 109 : GOTO 9999 110 : C 111 : C ============================================================ 112 : C 7 : LES INDICES DES NOEUDS DU VOLUME 113 : C ============================================================ 114 : 70 CONTINUE 115 : NBRESU = NNOVO 116 : DO 71 I=1,NBRESU 117 : IRESUL(I) = INOVO(I) 118 : 71 CONTINUE 119 : GOTO 9999 120 : C 121 : C ============================================================ 122 : C 8 : LES INDICES DES SOMMETS 123 : C ============================================================ 124 : 80 CONTINUE 125 : NBRESU = NSOVO 126 : DO 81 I=1,NBRESU 127 : IRESUL(I) = ISOVO(I) 128 : 81 CONTINUE 129 : GOTO 9999 130 : C 131 : C ============================================================ 132 : C 9 : LES INDICES DES NOEUDS 133 : C ============================================================ 134 : 90 CONTINUE 135 : NBRESU = NNOTOT 136 : DO 91 I=1,NBRESU 137 : IRESUL(I) = INOTOT(I) 138 : 91 CONTINUE 139 : GOTO 9999 140 : C 141 : 9999 END 142 : 143 :
© Cast3M 2003 - All rights reserved.
Disclaimer