Download fcar8.eso

Back to the list

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

© Cast3M 2003 - All rights reserved.
Disclaimer