Esope source files

   1 : C KDOM3A    SOURCE    CHAT      05/01/13    00:54:00     5004           
   2 :       SUBROUTINE KDOM3A(MTAB,IPT1)
   3 : C
   4 : C************************************************************************
   5 : C
   6 : C PROJET            :  CASTEM 2000
   7 : C
   8 : C NOM               :  KDOM3A
   9 : C                      
   9 : C DESCRIPTION       :  Subroutine called by KDOM2A
  10 : C                      Axial-symmetric case, SEG3
  11 : C                      We compute 
  12 : C                      MTAB . 'XXVOLUM'
  13 : C                      MTAB . 'CENTRE'
  14 : C                      and we change the position for the central points
  15 : C                      of MELEMQ
  16 : C     
  17 : C LANGAGE           :  FORTRAN 77 + ESOPE 2000 (avec estensions CISI)
  18 : C      
  19 : C AUTEUR            :  A. BECCANTINI, DRN/DMT/SEMT/LTMF                        
  20 : C
  21 : C************************************************************************
  22 : C
  23 : C INPUT/OUTPUT      : MTAB   : domaine table
  24 : C                     IPT1   : elementary QUAF mesh of SEG3
  25 : C
  26 : C************************************************************************
  27 : C
  28 : C Created the 24/02/04
  29 : C
  30 : C**** Variables de COOPTIO
  31 : C
  32 : C      INTEGER IPLLB, IERPER, IERMAX, IERR, INTERR
  33 : C     &     ,IOTER,   IOLEC,  IOIMP,     IOCAR,  IOACQ
  34 : C     &     ,IOPER,   IOSGB,  IOGRA,     IOSAU,  IORES
  35 : C     &     ,IECHO,   IIMPI,  IOSPI
  36 : C     &     ,IDIM,    IFICLE, IPREFI     
  37 : CC     &     ,MCOORD
  38 : C     &     ,IFOMOD, NIFOUR, IFOUR, NSDPGE, IONIVE
  39 : C     &     ,NGMAXY, IZROSF, ISOTYP, IOSCR,LTEXLU
  40 : C     &     ,NORINC,NORVAL,NORIND,NORVAD
  41 : C     &     ,NUCROU, IPSAUV, IREFOR, ISAFOR
  42 : C
  43 : C     
  44 :       IMPLICIT INTEGER(I-N)
  45 : -INC CCOPTIO
  46 : -INC SMCOORD
  47 : -INC SMELEME
  48 : -INC SMLMOTS
  49 : -INC SMCHPOI
  50 :       INTEGER MTAB, NBEL,NBELEM, NBSOUS, NBREF, NBNN, IELEM, JGN, JGM
  51 :      &     , NN1, NN2, NN3, IEL, IGEOM
  52 :       POINTEUR MELMAI.MELEME, MELCEN.MELEME
  53 :       REAL*8 X1, Y1, X3, Y3, VOLU, X2, Y2
  54 :       CHARACTER*8 TYPI
  55 : C
  56 :       NBEL=IPT1.NUM(/2)
  57 : C
  58 : C**** 'MAILLAGE'
  59 : C     'CENTRE' (with bad positions)
  60 : C
  61 : C     Initialisation 
  62 : C
  63 :       NBELEM=NBEL
  64 :       NBSOUS=0
  65 :       NBREF=0
  66 :       NBNN=2
  67 :       SEGINI MELMAI
  68 :       MELMAI.ITYPEL=2
  69 : C
  70 :       NBELEM=NBEL
  71 :       NBNN=1
  72 :       NBSOUS=0
  73 :       NBREF=0
  74 :       SEGINI MELCEN
  75 :       MELCEN.ITYPEL=1
  76 : C
  77 : C**** Filling
  78 : C
  79 :       DO IELEM=1,NBELEM,1
  80 :          MELMAI.NUM(1,IELEM)=IPT1.NUM(1,IELEM)
  81 :          MELMAI.NUM(2,IELEM)=IPT1.NUM(3,IELEM)
  82 :          MELMAI.ICOLOR(IELEM)=IPT1.ICOLOR(IELEM)
  83 :          MELCEN.NUM(1,IELEM)=IPT1.NUM(2,IELEM)
  84 :          MELCEN.ICOLOR(IELEM)=IPT1.ICOLOR(IELEM)
  85 :       ENDDO
  85 :       CALL ECMO(MTAB,'MAILLAGE','MAILLAGE',MELMAI)
  85 :       CALL ECMO(MTAB,'CENTRE','MAILLAGE',MELCEN)
  86 :       SEGDES MELCEN
  87 :       SEGDES MELMAI
  88 : C
  89 : C**** Volume
  90 : C
  91 :       TYPI='CENTRE  '
  92 :       JGN=4
  93 :       JGM=1
  94 :       SEGINI MLMOTS
  95 :       MLMOTS.MOTS(1)='SCAL'
  95 :       CALL KRCHP1(TYPI,MELCEN,MCHPOI,MLMOTS)
  96 :       IF(IERR.NE.0) GOTO 9999
  97 :       SEGSUP MLMOTS
  97 :       CALL ECMO(MTAB,'XXVOLUM','CHPOINT',MCHPOI)
  98 :       IF(IERR.NE.0) GOTO 9999
  98 :       CALL LICHT(MCHPOI,MPOVAL,TYPI,IGEOM)
  99 :       IF(IERR.NE.0) GOTO 9999
 100 : C     SEGACT MPOVAL
 101 : C
 102 : C
 103 :       DO IEL=1,NBEL,1
 104 : C
 105 :          NN1=IPT1.NUM(1,IEL)
 106 :          NN2=IPT1.NUM(2,IEL)
 107 :          NN3=IPT1.NUM(3,IEL)
 108 :          X1=XCOOR((NN1-1)*(IDIM+1)+1)
 109 :          Y1=XCOOR((NN1-1)*(IDIM+1)+2)
 110 :          X3=XCOOR((NN3-1)*(IDIM+1)+1)
 111 :          Y3=XCOOR((NN3-1)*(IDIM+1)+2)
 112 : C
 112 :          CALL KDOM3B(X1,Y1,X3,Y3,VOLU,X2,Y2)
 113 : C
 114 :          MPOVAL.VPOCHA(IEL,1)=VOLU
 115 : C
 116 : C
 117 :          XCOOR((NN2-1)*(IDIM+1)+1)=X2
 118 :          XCOOR((NN2-1)*(IDIM+1)+2)=Y2
 119 : C
 120 :       ENDDO
 121 : C     
 122 :       SEGDES MPOVAL
 123 : C      
 124 :  9999 RETURN
 125 : C     
 126 :       END
 127 :  
 128 :  
 129 :