Esope source files

   1 : C ISOVA1    SOURCE    PV        09/03/12    21:25:33     6325           
   2 :       SUBROUTINE ISOVA1(MCHELM,XISO,XTOL,MELEME)
   3 :       IMPLICIT REAL*8 (A-H,O-Z)
   4 :       IMPLICIT INTEGER (I-N)
   5 : C***********************************************************************
   6 : C NOM         : ISOVA1
   7 : C DESCRIPTION : Construit le maillage d'une isovaleur d'un champ par 
   8 : C               éléments
   9 : C
  10 : C
  11 : C
  12 : C LANGAGE     : ESOPE
  13 : C AUTEUR      : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF)
  14 : C               mél : gounand@semt2.smts.cea.fr
  15 : C***********************************************************************
  16 : C VERSION    : v1, 17/12/2008, version initiale
  17 : C HISTORIQUE : v1, 17/12/2008, création
  18 : C HISTORIQUE :
  19 : C HISTORIQUE :
  20 : C***********************************************************************
  21 : -INC CCOPTIO
  22 : -INC CCGEOME
  23 : -INC CCREEL
  24 : -INC SMCOORD
  25 : -INC SMELEME
  26 : -INC SMCHAML
  27 : -INC SMLENTI
  28 : *
  29 : * Segments ajustables 1D contenant les noeuds des éléments créés ainsi
  30 : * que leur couleur 
  31 : * ELEM(1) contient des POI1
  32 : * ELEM(2) contient des SEG2
  33 : * ELEM(3) contient des TRI3
  34 : * ELEM(4) contient des TET4
  35 : * ELEM(5) contient des QUA4
  36 : *
  37 :       PARAMETER (NTYEL=5)
  38 :       SEGMENT ELEMS
  39 :       POINTEUR ELEM(NTYEL).MLENTI
  40 :       ENDSEGMENT
  41 :       SEGMENT MELEMS
  42 :       POINTEUR IPT(NTYEL).MELEME
  43 :       ENDSEGMENT
  44 : *
  45 :       CHARACTER*8 MCHA
  46 :       INTEGER IMPR,IRET
  47 : *
  48 :       INTEGER ITYPL(NTYEL)
  49 :       DATA ITYPL/1,2,4,23,8/
  50 : *     
  51 : * Executable statements
  52 : *
  53 :       IMPR=0
  54 :       IF (IMPR.GT.2) WRITE(IOIMP,*) 'Entrée dans isova1.eso' 
  55 : *
  56 : * Initialisation des objets possiblement créés
  57 : *
  58 :       SEGACT MCOORD*MOD
  59 :       SEGINI ELEMS
  60 :       DO ITYEL=1,NTYEL
  61 :          JG=0
  62 :          SEGINI MLENTI
  63 :          ELEM(ITYEL)=MLENTI
  64 :       ENDDO
  65 : *
  66 : * Parcours du CHAMELEM
  67 : *
  68 :       SEGACT MCHELM
  69 :       N1=IMACHE(/1)
  70 :       DO I1=1,N1
  71 :          ITYCHA=INFCHE(I1,6)
  72 :          IF (ITYCHA.NE.1) THEN
  73 :             MOTERR(1:16)='NOEUDS         '
  74 : * 291 2
  75 : *Pas de MCHAML de type %m1:16 trouvé
  75 :             CALL ERREUR(291)
  76 :             RETURN
  77 :          ENDIF
  78 :          MELEME=IMACHE(I1)
  79 :          SEGACT MELEME
  80 :          MCHAML=ICHAML(I1)
  81 :          SEGACT MCHAML
  81 :          CALL ISOVA2(MELEME,MCHAML,XISO,XTOL,ELEMS)
  82 :          SEGDES MCHAML
  83 :          SEGDES MELEME
  84 :       ENDDO
  85 :       SEGDES MCHELM
  86 :       SEGACT MCOORD
  87 : *
  88 : * Transformation des segments ajustables en MELEME
  89 : *
  90 :       SEGINI MELEMS
  91 :       NSOUT=0
  92 :       NBSOUS=0
  93 :       NBREF=0
  94 :       DO ITYEL=1,NTYEL
  95 :          MLENTI=ELEM(ITYEL)
  96 :          JG=LECT(/1)
  97 :          IF (JG.GT.0) THEN
  98 :             NSOUT=NSOUT+1
  99 :             ITYP=ITYPL(ITYEL)
 100 :             NBNN=NBNNE(ITYP)
 101 :             NBNN1=NBNN+1
 102 :             NBELEM=JG/NBNN1
 103 :             SEGINI MELEME
 104 :             ITYPEL=ITYP
 105 :             DO IELEM=1,NBELEM
 106 :                DO INN=1,NBNN
 107 :                   NUM(INN,IELEM)=LECT((IELEM-1)*NBNN1+INN)
 108 :                ENDDO
 109 :                ICOLOR(IELEM)=LECT(IELEM*NBNN1)
 110 :             ENDDO
 111 :             SEGDES MELEME
 112 :             MELEMS.IPT(ITYEL)=MELEME
 113 :          ENDIF
 114 :          SEGSUP MLENTI
 115 :       ENDDO
 116 :       SEGSUP ELEMS
 117 : *
 118 :       IF (NSOUT.EQ.1) THEN
 119 :          DO ITYEL=1,NTYEL
 120 :             IPT1=IPT(ITYEL)
 121 :             IF (IPT1.NE.0) THEN
 122 :                MELEME=IPT1
 123 :             ENDIF
 124 :          ENDDO
 125 :       ELSE
 126 :          NBNN=0
 127 :          NBREF=0
 128 :          NBSOUS=NSOUT
 129 :          NBREF=0
 130 :          SEGINI MELEME
 131 :          ISOUS=0
 132 :          DO ITYEL=1,NTYEL
 133 :             IPT1=IPT(ITYEL)
 134 :             IF (IPT1.NE.0) THEN
 135 :                ISOUS=ISOUS+1
 136 :                LISOUS(ISOUS)=IPT1
 137 :             ENDIF
 138 :          ENDDO
 139 :          SEGDES MELEME
 140 :       ENDIF
 141 :       SEGSUP MELEMS
 142 :       RETURN
 143 : *
 144 : * End of subroutine ISOVA1
 145 : *
 146 :       END
 147 : 
 148 :  
 149 :