Download fcub20.eso

Back to the list

   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