Sources Esope | Cast3M

avsmel
C AVSMEL    SOURCE    BP208322  16/11/18    21:15:13     9177           
 
      SUBROUTINE AVSMEL(MAILLA,IDECAL,NUMMAT,IEQUIV,IPTMIN)
 
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
C  But : Sortie vers AVS (UCD ASCII) d'un maillage
C        (MELEME) élémentaire
C
C  Paramètres : MAILLA - pointeur vers le MELEME (entrée)
C               IDECAL - décalage des numéros d'éléments (entrée & sortie)
C               NUMMAT - numéro du matériau du maillage (entrée)
C# FA7902 corrections tableau conversion elements PR15 TE10
C#MC 03/12/98
C#   NUMMAT n'est plus utilise, il est dans la plupart des cas redondant avec
C#   le type de l'element. On prefere sortir le numero de la couleur (+1 pour
C#   ne pas commencer a 0)
C
C               IEQUIV - segment décrivant la conversion des numéros des noeuds
C               IPTMIN - numéro du premier noeud dans IEQUIV
C
C  Auteur : Michel Bulik
C           Novembre 1994
C
C  Appelé par : SORAVS
C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
 
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)
 
 
-INC PPARAM
-INC CCOPTIO
-INC CCGEOME
 
-INC SMELEME
 
C ... Dans cette subroutine je ne touche pas à IEQUIV, on
C     s'en occupe dans LIRAVS ...
      SEGMENT IEQUIV
         INTEGER LEQUIV(IECART)
      END SEGMENT
 
C ... Tableaux de conversion de connectivités (IC&lt;nom_élément>) ...
C*      DIMENSION ICPOI1( 1)
      DIMENSION ICSEG2( 2)
      DIMENSION ICSEG3( 3)
      DIMENSION ICTRI3( 3)
      DIMENSION ICTRI6( 6)
      DIMENSION ICQUA4( 4)
      DIMENSION ICQUA8( 8)
      DIMENSION ICCUB8( 8)
      DIMENSION ICCU20(20)
      DIMENSION ICPRI6( 6)
      DIMENSION ICPR15(15)
      DIMENSION ICTET4( 4)
      DIMENSION ICTE10(10)
      DIMENSION ICPYR5( 5)
      DIMENSION ICPY13(13)
 
C*      DATA ICPOI1 / 1/
      DATA ICSEG2 / 1, 2/
      DATA ICSEG3 / 1, 3, 2/
      DATA ICTRI3 / 1, 2, 3/
      DATA ICTRI6 / 1, 3, 5, 2, 4, 6/
      DATA ICQUA4 / 1, 2, 3, 4/
      DATA ICQUA8 / 1, 3, 5, 7, 2, 4, 6, 8/
      DATA ICCUB8 / 1, 2, 3, 4, 5, 6, 7, 8/
      DATA ICCU20 / 1, 3, 5, 7,13,15,17,19, 2, 4,
     &              6, 8,14,16,18,20, 9,10,11,12/
      DATA ICPRI6 / 1, 2, 3, 4, 5, 6/
      DATA ICPR15 / 1, 3, 5,10,12,14, 2, 4, 6,11,
     &             13,15, 7, 8, 9/
      DATA ICTET4 / 1, 2, 3, 4/
      DATA ICTE10 / 1, 3, 5,10, 2, 6, 7, 4, 9, 8/
      DATA ICPYR5 / 5, 1, 2, 3, 4/
      DATA ICPY13 /13, 1, 3, 5, 7, 9,10,11,12, 2,
     &              4, 6, 8/
 
      MELEME=MAILLA
      SEGACT MELEME
      NBELEM=NUM(/2)
      IF(NBELEM.EQ.0) GOTO 9000
      NBNN=NUM(/1)
 
      IF(ITYPEL.EQ.1) THEN
         DO 3030 J=1,NBELEM
            WRITE(IOPER,5001) IDECAL+J,ICOLOR(J)+1,
     &                      LEQUIV(NUM(1,J)-IPTMIN+1)
C*     &                      LEQUIV(NUM(ICPOI1(1),J)-IPTMIN+1)
 3030    CONTINUE
      ELSE IF(ITYPEL.EQ.2) THEN
         DO 3040 J=1,NBELEM
            WRITE(IOPER,5002) IDECAL+J,ICOLOR(J)+1,
     &                     (LEQUIV(NUM(ICSEG2(K),J)-IPTMIN+1),K=1,NBNN)
 3040    CONTINUE
      ELSE IF (ITYPEL.EQ.3) THEN
         DO 3050 J=1,NBELEM
            WRITE(IOPER,5003) IDECAL+J,ICOLOR(J)+1,
     &                     (LEQUIV(NUM(ICSEG3(K),J)-IPTMIN+1),K=1,NBNN)
 3050    CONTINUE
      ELSE IF (ITYPEL.EQ.4) THEN
         DO 3060 J=1,NBELEM
            WRITE(IOPER,5004) IDECAL+J,ICOLOR(J)+1,
     &                     (LEQUIV(NUM(ICTRI3(K),J)-IPTMIN+1),K=1,NBNN)
 3060    CONTINUE
      ELSE IF (ITYPEL.EQ.6) THEN
         DO 3070 J=1,NBELEM
            WRITE(IOPER,5006) IDECAL+J,ICOLOR(J)+1,
     &                     (LEQUIV(NUM(ICTRI6(K),J)-IPTMIN+1),K=1,NBNN)
 3070    CONTINUE
      ELSE IF (ITYPEL.EQ.8) THEN
         DO 3080 J=1,NBELEM
            WRITE(IOPER,5008) IDECAL+J,ICOLOR(J)+1,
     &                     (LEQUIV(NUM(ICQUA4(K),J)-IPTMIN+1),K=1,NBNN)
 3080    CONTINUE
      ELSE IF (ITYPEL.EQ.10) THEN
         DO 3090 J=1,NBELEM
            WRITE(IOPER,5010) IDECAL+J,ICOLOR(J)+1,
     &                     (LEQUIV(NUM(ICQUA8(K),J)-IPTMIN+1),K=1,NBNN)
 3090    CONTINUE
      ELSE IF (ITYPEL.EQ.14) THEN
         DO 3100 J=1,NBELEM
            WRITE(IOPER,5014) IDECAL+J,ICOLOR(J)+1,
     &                     (LEQUIV(NUM(ICCUB8(K),J)-IPTMIN+1),K=1,NBNN)
 3100    CONTINUE
      ELSE IF (ITYPEL.EQ.15) THEN
         DO 3110 J=1,NBELEM
            WRITE(IOPER,5015) IDECAL+J,ICOLOR(J)+1,
     &                     (LEQUIV(NUM(ICCU20(K),J)-IPTMIN+1),K=1,NBNN)
 3110    CONTINUE
      ELSE IF (ITYPEL.EQ.16) THEN
         DO 3120 J=1,NBELEM
            WRITE(IOPER,5016) IDECAL+J,ICOLOR(J)+1,
     &                     (LEQUIV(NUM(ICPRI6(K),J)-IPTMIN+1),K=1,NBNN)
 3120    CONTINUE
      ELSE IF (ITYPEL.EQ.17) THEN
         DO 3130 J=1,NBELEM
            WRITE(IOPER,5017) IDECAL+J,ICOLOR(J)+1,
     &                     (LEQUIV(NUM(ICPR15(K),J)-IPTMIN+1),K=1,NBNN)
 3130    CONTINUE
      ELSE IF (ITYPEL.EQ.23) THEN
         DO 3140 J=1,NBELEM
            WRITE(IOPER,5023) IDECAL+J,ICOLOR(J)+1,
     &                     (LEQUIV(NUM(ICTET4(K),J)-IPTMIN+1),K=1,NBNN)
 3140    CONTINUE
      ELSE IF (ITYPEL.EQ.24) THEN
         DO 3150 J=1,NBELEM
            WRITE(IOPER,5024) IDECAL+J,ICOLOR(J)+1,
     &                     (LEQUIV(NUM(ICTE10(K),J)-IPTMIN+1),K=1,NBNN)
 3150    CONTINUE
      ELSE IF (ITYPEL.EQ.25) THEN
         DO 3160 J=1,NBELEM
            WRITE(IOPER,5025) IDECAL+J,ICOLOR(J)+1,
     &                     (LEQUIV(NUM(ICPYR5(K),J)-IPTMIN+1),K=1,NBNN)
 3160    CONTINUE
      ELSE IF (ITYPEL.EQ.26) THEN
         DO 3170 J=1,NBELEM
            WRITE(IOPER,5026) IDECAL+J,ICOLOR(J)+1,
     &                     (LEQUIV(NUM(ICPY13(K),J)-IPTMIN+1),K=1,NBNN)
 3170    CONTINUE
      ELSE
         MOTERR(1:4)=NOMS(ITYPEL)
         CALL ERREUR(701)
      ENDIF
 
 9000 CONTINUE
C ... Dans le cas d'un ITYPEL inconnu j'incrémente quand même IDECAL,
C     ceci laissera un "trou" dans le fichier AVS et permettra (je
C     l'espère) trouver l'erreur plus facilement ...
      IDECAL=IDECAL+NBELEM
 
      SEGDES MELEME
 
      RETURN
C ... Format 50?? correspond à 5000+ITYPEL ...
 5001 FORMAT(I11,I3,'    pt',1I11)
 5002 FORMAT(I11,I3,'  line',2I11)
 5003 FORMAT(I11,I3,'  line',3I11)
 5004 FORMAT(I11,I3,'   tri',3I11)
 5006 FORMAT(I11,I3,'   tri',6I11)
 5008 FORMAT(I11,I3,'  quad',4I11)
 5010 FORMAT(I11,I3,'  quad',8I11)
 5014 FORMAT(I11,I3,'   hex',8I11)
 5015 FORMAT(I11,I3,'   hex',20I11)
 5016 FORMAT(I11,I3,' prism',6I11)
 5017 FORMAT(I11,I3,' prism',15I11)
 5023 FORMAT(I11,I3,'   tet',4I11)
 5024 FORMAT(I11,I3,'   tet',10I11)
 5025 FORMAT(I11,I3,'   pyr',5I11)
 5026 FORMAT(I11,I3,'   pyr',13I11)
 
      END